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

expanded), restricted DCB module export to reasonable functions

src/DCB/DCB.hs

@@ -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,8 +105,7 @@ 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
+                                        mapMaybe (addPoint adj attr d div req g)
-                                                        (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
@@ -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

src/Main.hs

@@ -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'.
 --

src/Util.hs

@@ -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)