changed calculation to only return maximum DCB (those that cannot be

expanded), restricted DCB module export to reasonable functions
This commit is contained in:
tpajenka 2014-03-16 18:26:45 +01:00
parent 5360e972fe
commit 77f8447cc4
3 changed files with 40 additions and 8 deletions

View File

@ -16,7 +16,7 @@
-- |
--DCB.DCB---------------------------------------------------------------------------
module DCB.DCB where
module DCB.DCB (preprocess, maxDCB, step, expand, addPoint, addablePoints, filterLayer) where
import Util
import DCB.Structures
import DCB.IO
@ -42,7 +42,6 @@ import qualified Data.ByteString.Char8 as B
testAdj :: Adj
testAdj = A.fromListUnboxed (ix2 10 10) [0,1,1,1,0,0,1,0,0,1,{----}1,0,0,0,1,0,1,1,0,0,
1,0,0,1,0,0,0,1,0,1,{----}1,0,1,0,1,1,1,0,0,0,
@ -74,7 +73,22 @@ instance (A.Shape sh, V.Unbox e) => NFData (Array A.U sh e) where
rnf a = ()
{-# INLINE rnf #-}
--TODO: Do we have to filter?
-- | Calculates all maximum DCB. A maximum DCB is a densely connected bicluster that cannot be
-- expanded by any additional node without breaking the constraints.
--
-- This function does return the seed graphs themselves if they cannot be expanded.
maxDCB :: [Graph] -> Adj -> Attr -> Density -> MaxDivergence -> Int -> [Graph]
maxDCB [] _ _ _ _ _ = []
maxDCB gs adj attr dens maxDiv minHit =
let next = L.map (expand adj attr dens maxDiv minHit) gs +|| (parBuffer 1000 rdeepseq)
(maximal, expandable) = part (\_ rem -> rem == []) (zip gs next)
expandable' = filterLayer $ concat expandable
-- Divide solutions into expandable solutions and maximum solutions. Expandable solutions
-- yield a result via the 'expand' function.
in maxDCB expandable' adj attr dens maxDiv minHit L.++ maximal
-- append maximum solutions of prospective function calls and maximum solutions of this iteration
-- | creates a step in iteration.
-- Basically calls expand for every Graph left in our List of interesting Graphs
@ -83,6 +97,7 @@ step :: [Graph] -> Adj -> Attr -> Density -> MaxDivergence -> Int -> [Graph]
step gs@((ind,_,_):_) a b c d e = traceEvent ("step from " P.++ show (A.extent ind) ) $
filterLayer $ concat $ map (expand a b c d e ) gs
+|| (parBuffer 1000 rdeepseq)
-- TODO: remove @((ind,_,_):_) for exhaustive pattern
@ -90,9 +105,8 @@ step gs@((ind,_,_):_) a b c d e = traceEvent ("step from " P.++ show (A.extent i
-- i.e. constraint a == Just Constraints for all returned Graphs
expand :: Adj -> Attr -> Density -> MaxDivergence -> Int -> Graph -> [Graph]
expand adj attr d div req g@(ind,_,_) = --trace ("expanding graph "P.++ B.unpack (outputGraph [g]))
catMaybes $ map
(addPoint adj attr d div req g)
(V.toList $ V.findIndices (==True) $ A.toUnboxed $ addablePoints adj g)
mapMaybe (addPoint adj attr d div req g)
(V.toList $ V.findIndices (==True) $ A.toUnboxed $ addablePoints adj g)
-- | Creates an adjacency matrix from the given adjacency matrix where all
-- edges are removed whose belonging nodes cannot fulfill the passed constraints.
@ -139,7 +153,7 @@ constraintInit :: Attr -> MaxDivergence -> Int -- ^ required number of consisten
-> Maybe Constraints
constraintInit ! attr ! div req i j =
let
! (Z:._:.nAttr) = A.extent attr
(Z:._:.nAttr) = A.extent attr
fConstr (Z:.a:.c) =
case c of
0 -> min (attr!(ix2 i a)) (attr!(ix2 j a))
@ -198,7 +212,7 @@ updateDensity adj nodes newNode dens =
let
neighbourSlice = A.map (\n -> fromIntegral $adj!(A.ix2 newNode n)) nodes
neighbours = A.foldAllS (+) (0::Int) ({- trace (show $ A.computeUnboxedS neighbourSlice)-} neighbourSlice)
! (Z:.n') = A.extent nodes
(Z:.n') = A.extent nodes
! n = fromIntegral n'
newdens = (dens * ((n)*(n-1)) / 2 + fromIntegral neighbours) * 2 / ((n+1)*(n))
in newdens

View File

@ -158,12 +158,18 @@ doCalculation adj attr p =
outputGraph $ L.sort $ doAll graph_ adj_ attr dens omega delta
]
where
-- don't print out seeds
doAll [] _ _ _ _ _ = []
doAll gs a b c d e = maxDCB (step gs a b c d e) a b c d e
{-- commented out: all solutions, not only maximum DCB
-- don't print out seeds
doAll [] _ _ _ _ _ = []
doAll gs a b c d e = doAll' (step gs a b c d e) a b c d e
-- but everything in the following recursive calls
doAll' [] _ _ _ _ _ = []
doAll' gs a b c d e = gs ++ doAll' (step gs a b c d e) a b c d e
--}
-- | gets the length of the 'Left a'.
--

View File

@ -136,3 +136,15 @@ isLeft a = case a of Left _ -> True; _ -> False
-- | Tests whether an 'Either' type is 'Right'.
isRight :: Either a b -> Bool
isRight = not . isLeft
-- | The 'part' function takes a predicate and a list of tuples and returns
-- the pair of lists of left elements which do and right elements which do not satisfy the
-- predicate, respectively; i.e.,
--
-- > part (\a b -> elem a b) [(1, [1, 3]), (2, [3, 4]), (0, [0, 5])] == ([1, 0], [[3, 4]])
part :: (a -> b -> Bool) -> [(a, b)] -> ([a], [b])
part p xs = foldr (select p) ([], []) xs
where
select :: (a -> b -> Bool) -> (a, b) -> ([a], [b]) -> ([a], [b])
select p (t,f) ~(ts,fs) | p t f = (t:ts,fs)
| otherwise = (ts, f:fs)