nub -> ordNub (O(n^2) -> O(n log n))

- included submodule with different approaches to perform nub in
  various surroundings. DOES NOT NEED TO BE COMPILED
- copied nubOrdBy to Util

hgraph.cabal

@@ -22,7 +22,8 @@ executable hgraph
                    text -any,
                    transformers >=0.3.0,
                    vector >=0.7,
-                   mtl >=2.1 && <3
+                   mtl >=2.1 && <3,
+                   containers >=0.5.0 && <0.6
     main-is: Main.hs
     buildable: True
     hs-source-dirs: src
@@ -37,9 +38,11 @@ executable hgraph
                    DoAndIfThenElse
  
 test-suite test-hgraph
-    build-depends: QuickCheck -any, Stream -any, accelerate -any,
+    build-depends: 
+                   QuickCheck -any, Stream -any, accelerate -any,
                    base -any, bytestring -any, deepseq -any, ghc -any,
-                   monad-par >=0.3.4, parallel -any, repa >=3.2, text -any
+                   monad-par >=0.3.4, parallel -any, repa >=3.2, text -any,
+                   containers >=0.5.0 && <0.6
     type: exitcode-stdio-1.0
     main-is: Main.hs
     buildable: True

src/DCB/DCB.hs

@@ -25,7 +25,7 @@ import           Prelude                        hiding ((++))
 import qualified Prelude                        as P ((++))
 
 import           Control.Monad.Par              
-import           Control.Parallel.Strategies
+import           Control.Parallel.Strategies    hiding (parMap)
 import           Control.Monad.Identity
 import           Control.DeepSeq
 import           Data.Array.Repa                ((:.) (..), Array, (!), (*^), (++), (+^),
@@ -37,7 +37,7 @@ import           Data.Int
 import qualified Data.List                      as L
 import           Data.Maybe
 import qualified Data.Vector.Unboxed            as V
---import           Debug.Trace
+import           Debug.Trace
 import qualified Data.ByteString.Char8          as B
 
 
@@ -77,9 +77,9 @@ instance (A.Shape sh, V.Unbox e) => NFData (Array A.U sh e) where
 --TODO: Do we have to filter?
 
 step :: [Graph] -> Adj -> Attr -> Density -> MaxDivergence -> Int -> [Graph]
-step gs@((ind,_,_):_) a b c d e = --trace ("step from " P.++ show (A.extent ind) ) $ 
+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 75 rdeepseq)
+                                                        +|| (parBuffer 1000 rdeepseq)
                                                                  
 
 
@@ -103,15 +103,16 @@ preprocess :: Adj           -- ^ original adjacency matrix
            -> (Adj, [Graph])
 preprocess adj attr div req =
     let
-        ! (Z:.nNodes:._) = A.extent adj
+        (Z:.nNodes:._) = A.extent adj
-        ! results = map (initGraph attr div req) [(i, j) | i <- [0..(nNodes-1)], j <- [(i+1)..(nNodes-1)], adj!(ix2 i j) /= 0]
+        results = map (initGraph attr div req) [(i, j) | i <- [0..(nNodes-1)], j <- [(i+1)..(nNodes-1)], adj!(ix2 i j) /= 0]
-                      +|| (parBuffer 25 rdeepseq) 
+                       -- +|| (parBuffer 25 rdeepseq) 
-        ! finalGraphs = lefts results
+        finalGraphs = lefts results
-        ! mask = A.fromUnboxed (A.extent adj) $V.replicate (nNodes*nNodes) False V.//
+        mask = A.fromUnboxed (A.extent adj) $V.replicate (nNodes*nNodes) False V.//
                 ((map (\(i,j) -> (i*nNodes + (mod j nNodes), True)) $rights results)
                 P.++ (map (\(i,j) -> (j*nNodes + (mod i nNodes), True)) $rights results))
-        ! adj' = runIdentity $ A.computeUnboxedP $A.fromFunction (A.extent adj) (\sh -> if mask!sh then 0 else adj!sh)
+        adj' = runIdentity $ A.computeUnboxedP $A.fromFunction (A.extent adj) (\sh -> if mask!sh then 0 else adj!sh)
     in (adj', finalGraphs)
+                     +|| parTuple2 rdeepseq rseq
 
 -- | Initializes a seed 'Graph' if it fulfills the constraints, returns the input nodes
 --   otherwise. It is assumed that the given nodes are connected.
@@ -137,12 +138,10 @@ constraintInit ! attr ! div req i j =
     let
         ! (Z:._:.nAttr) = A.extent attr
         fConstr (Z:.a:.c) =
-            let
+            case c of
-                ! col = A.slice attr (A.Any:.a)
-            in case c of
                     0 -> min (attr!(ix2 i a)) (attr!(ix2 j a))
                     1 -> max (attr!(ix2 i a)) (attr!(ix2 j a))
-        (constr, fulfill, nrHit) = runIdentity $
+        (!constr, !fulfill, !nrHit) = runIdentity $
                                        do
                                            ! constr <- return $ A.computeUnboxedS $A.fromFunction (ix2 nAttr 2) fConstr
                                            ! fulfill <- return $ A.computeUnboxedS $ A.zipWith (\thediv dist -> if abs dist <= thediv then 1 else 0) div
@@ -152,8 +151,12 @@ constraintInit ! attr ! div req i j =
     in if nrHit >= req then Just (fulfill, constr) else Nothing
 
 -- | removes all duplicate graphs
+
+-- nub has O(n^2) complexity.
+-- with this variant of ordNubBy we need a simple bucket-extractor (first function) obeying Ord
+-- and a second equality-check function for edge-cases (lin-search).
 filterLayer :: [Graph] -> [Graph]
-filterLayer gs = L.nubBy filter gs
+filterLayer gs = ordNubBy (\g@(ind,_,_) -> L.sort (A.toList ind)) filter gs
                 where
                         filter :: Graph -> Graph -> Bool
                         filter (ind,_,_) (ind',_,_) = and [V.any (==i) (A.toUnboxed ind) | i <- A.toList ind']
@@ -223,8 +226,8 @@ updateDensity adj nodes newNode dens =
                                         fromIntegral $adj!(ix2 i newNode) 
                                    else
                                         0)-}
-        (Z:.n') = A.extent nodes
+        ! (Z:.n') = A.extent nodes
-        n = fromIntegral n'
+        ! n = fromIntegral n'
         newdens = (dens * ((n)*(n-1)) / 2 + fromIntegral neighbours) * 2 / ((n+1)*(n)) 
     in newdens
         {-+ trace (

src/DCB/Structures.hs

@@ -47,7 +47,11 @@ instance Ord Graph where
                         s2 = (A.size $ A.extent nodes)
                 in
                         if s1 == s2 then
-                                (A.sumAllS const') `compare` (A.sumAllS const)
+                                let 
+                                        const1 = (A.sumAllS const')
+                                        const2 = (A.sumAllS const)
+                                in
+                                        const1 `compare` const2 
                         else
                                 s1 `compare` s2 
 

src/Util.hs

@@ -1,6 +1,8 @@
 module Util where
 
 import           Control.Parallel.Strategies
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 
 -- | Move first argument to first place (for style uniformity)
 flip1 :: (a -> b) -> (a -> b)
@@ -84,3 +86,19 @@ a +|| b = a `using` b
 appendS :: (Show a) => String -> String -> a -> String
 appendS sep a b = (a ++ show b) ++ sep
 
+-- When removing duplicates, the first function assigns the input to a bucket,
+-- the second function checks whether it is already in the bucket (linear search).
+ordNubBy :: (Ord b) => (a -> b) -> (a -> a -> Bool) -> [a] -> [a]
+ordNubBy p f l = go Map.empty l
+  where
+    go _ []     = []
+    go m (x:xs) = let b = p x in case b `Map.lookup` m of
+                    Nothing     -> x : go (Map.insert b [x] m) xs
+                    Just bucket
+                      | elem_by f x bucket -> go m xs
+                      | otherwise          -> x : go (Map.insert b (x:bucket) m) xs
+
+    -- From the Data.List source code.
+    elem_by :: (a -> a -> Bool) -> a -> [a] -> Bool
+    elem_by _  _ []     = False
+    elem_by eq y (x:xs) = y `eq` x || elem_by eq y xs