debugging.. split Module in more files

hgraph.cabal

@@ -26,8 +26,10 @@ executable hgraph
     buildable: True
     hs-source-dirs: src
     other-modules: 
-                   DCB,
+                   Util,
-                   Util
+                   DCB.DCB,
+                   DCB.Structures,
+                   DCB.IO
     ghc-options: -eventlog -Odph -rtsopts -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -optlo-O3
     extensions:    
                    BangPatterns, 
@@ -43,4 +45,8 @@ test-suite test-hgraph
     cpp-options: -DMAIN_FUNCTION=testMain
     hs-source-dirs: src
     ghc-options: -threaded -rtsopts -eventlog
-    other-modules: Util
+    other-modules: 
+                   Util,
+                   DCB.Structures,
+                   DCB.DCB,
+                   DCB.IO

src/DCB/DCB.hs

@@ -13,14 +13,15 @@
 -- Portability :
 --
 -- |
---
+--DCB.DCB---------------------------------------------------------------------------
------------------------------------------------------------------------------
 
-module DCB where
+module DCB.DCB where
 import           Util
+import           DCB.Structures
+import           DCB.IO
 
 import           Prelude               hiding ((++))
-import qualified Prelude               ((++))
+import qualified Prelude               as P ((++))
 
 import           Control.Monad.Par
 import           Data.Array.Repa       ((:.) (..), Array, (!), (*^), (++), (+^),
@@ -33,36 +34,8 @@ import qualified Data.List             as L
 import           Data.Maybe
 import qualified Data.Vector.Unboxed   as V
 import           Debug.Trace
+import qualified Data.ByteString.Char8          as B
 
--- | a one-dimensional array
-type Vector r e = Array r DIM1 e
--- | a two-dimensional array
-type Matrix r e = Array r DIM2 e
-
--- | A 'Matrix' of attribute values assigned to a graph’s nodes.
---   Each row contains the corresponding node’s attribute values.
-type Attr  = Matrix A.U Double
--- | Adjacency-Matrix
-type Adj   = Matrix A.U Int8
-
--- | Matrix storing the extent of a 'Graph'’s constraints fulfillment.
---   It stores the minimum (zeroth column) and maximum (first column) value of all
---   the 'Graph'’s nodes per attribute.
---   The 'Vector' stores values of @1@ if the bounds are within the allowed range
---   ragarding the corresponding attribute, or @0@ if not.
-type Constraints = (Vector A.U Int, Matrix A.U Double)
--- | A 'Vector' of weights indicating how much divergence is allowed in which dimension.
---   Each dimension represents an attribute.
-type MaxDivergence = Vector A.U Double
--- | A graph’s density.
-type Density = Double
-
--- | consists of a 'Vector' denoting which columns of the 'Matrix' represents which originating
---   column in the global adjancency-matrix, a 'Matrix' of 'Constraints' and a scalar denoting the graph’s 'Density'
-type Graph = (Vector A.U Int, Constraints, Density)
-
-instance Ord Graph where
-        (nodes, _, _) `compare` (nodes', _, _) = (A.size $ A.extent nodes) `compare` (A.size $ A.extent nodes')
 
 
 
@@ -93,13 +66,13 @@ testReq = 3 ::Int
 --TODO: Do we have to filter?
 
 step :: [Graph] -> Adj -> Attr -> Density -> MaxDivergence -> Int -> [Graph]
-step gs a b c d e = filterLayer $ concat $ map (expand a b c d e ) gs
+step gs@((ind,_,_):_) a b c d e = trace ("step from " P.++ show (A.extent ind) ) $ filterLayer $ concat $ map (expand a b c d e ) gs
 
 
 -- | calculates all possible additions to one Graph, yielding a list of valid expansions
 --   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,_,_) = catMaybes $ map
+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)
 
@@ -120,7 +93,7 @@ preprocess adj attr div req =
         finalGraphs = lefts results
         mask = A.fromUnboxed (A.extent adj) $V.replicate (nNodes*nNodes) False V.//
                 ((map (\(i,j) -> (i*nNodes + (mod j nNodes), True)) $rights results)
-                Prelude.++ (map (\(i,j) -> (j*nNodes + (mod i nNodes), True)) $rights results))
+                P.++ (map (\(i,j) -> (j*nNodes + (mod i nNodes), True)) $rights results))
         adj' = A.computeS $A.fromFunction (A.extent adj) (\sh -> if mask!sh then 0 else adj!sh)
     in (adj', finalGraphs)
 
@@ -181,6 +154,7 @@ constraint attr div req (_, (fulfill, constr), _) newNode =
                  0 -> min (f sh) (attr!sh)
                  1 -> max (f sh) (attr!sh)
         constrNew = A.computeUnboxedS $A.traverse constr id updateConstr
+        --TODO: filfillNew is bogus..   
         fulfillNew = A.zipWith (\i b -> if i == 1 && b then 1::Int else 0::Int) fulfill
                 $A.zipWith (\thediv dist -> abs dist <= thediv) div $A.foldS (-) 0 constrNew
         nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew
@@ -194,11 +168,32 @@ updateDensity :: Adj            -- ^ global adjacency matrix of all nodes
               -> Density        -- ^ new density of expanded graph
 updateDensity adj nodes newNode dens =
     let
-        neighbours = A.foldAllS (+) (0::Int)
+        neighbourSlice = A.traverse 
-                $A.traverse nodes id (\f sh -> fromIntegral $adj!(ix2 (f sh) newNode))
+                                    (A.slice (A.map fromIntegral adj) (A.Any :. newNode)) -- Array
+                                    id                                                    -- same Size
+                                    (\f sh@(_ :. i) -> 
+                                        if V.any (==i) (A.toUnboxed nodes) then --if connected to graph
+                                                (f sh)                          --return connection
+                                        else
+                                                0)                              --never connect to nodes not extisting
+        neighbours = A.foldAllS (+) (0::Int) (trace (show $ A.computeUnboxedS neighbourSlice) neighbourSlice)
+                
+                {- A.traverse adj (reduceDim) (\f (Z :. i) -> 
+                                if not $ V.any (==i) $ A.toUnboxed nodes then
+                                        fromIntegral $adj!(ix2 i newNode) 
+                                   else
+                                        0)-}
         (Z:.n') = A.extent nodes
         n = fromIntegral n'
-    in (dens * (n*(n+1)) / 2 + fromIntegral neighbours) * 2 / ((n+1)*(n+2))
+        newdens = (dens * (n*(n+1)) / 2 + fromIntegral neighbours) * 2 / ((n+1)*(n+2)) 
+    in newdens
+        + trace (
+                (show dens) P.++ " ("P.++(show (dens * (n*(n+1)) / 2)) P.++"/"P.++ (show ((n*(n+1))/(2::Double))) P.++ ") -> "
+                P.++ (show newdens) P.++ " ("P.++(show (newdens * ((n+2)*(n+1)) / 2)) P.++"/"P.++ (show (((n+2)*(n+1))/(2::Double))) P.++ ") \n"
+                P.++ (show newNode) 
+                P.++ " -> " 
+                P.++ (show neighbours)) 
+                0
 
 
 -- | Checks a 'Graph' expansion with a single node regarding both the attribute constraints
@@ -223,6 +218,9 @@ addPoint adj attr d div req g@(nodes, _, dens) n =
                      True  -> Just (A.computeS $nodes ++ A.fromListUnboxed (ix1 1) [n], c, densNew)
                      False -> Nothing
 
+reduceDim :: (A.Shape sh, Integral a) => (sh :. a) -> sh
+reduceDim (a :. b) = a --A.shapeOfList $ tail $ A.listOfShape a
+
 -- | yields all valid addititons (=neighbours) to a Graph
 addablePoints :: Adj -> Graph -> Vector A.U Bool
 addablePoints adj (ind,_,_) = A.computeS $
@@ -232,8 +230,6 @@ addablePoints adj (ind,_,_) = A.computeS $
                                                 (foldOr ind))
            where
 
-                reduceDim :: (A.Shape sh, Integral a) => (sh :. a) -> sh
-                reduceDim (a :. b) = a --A.shapeOfList $ tail $ A.listOfShape a
 
                 foldOr :: (A.Shape sh') => Vector A.U Int -> ((sh' :. Int :. Int) -> Int8) -> (sh' :. Int) -> Bool
                 foldOr indlist lookup ind@(a :. pos) = case V.any (== pos) $ A.toUnboxed indlist of

src/DCB/IO.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+module DCB.IO where
+
+import           Control.Parallel.Strategies
+import           Data.Array.Repa              as A hiding ((++))
+import           Data.Array.Repa.Repr.Unboxed
+import           Data.Array.Repa.Repr.Vector
+import           Data.ByteString.Char8        (ByteString)
+import qualified Data.ByteString.Char8        as B
+import qualified Data.List                    as L
+import qualified Data.Vector.Unboxed          as V
+import           DCB.Structures
+import           Util
+
+
+
+-- | creates a default-formatted output with \",\" in between elements
+--   and \"\\n\" in between dimensions
+--
+--   calls '_outputArray' with preset properties
+outputArray :: (Unbox a, Show a) => Array U DIM2 a -> B.ByteString
+outputArray a = _outputArray a "\t" "\n"
+
+-- | creates a formatted output from a DIM2 repa-Array
+--
+--   * First String is the between-element-separator
+--
+--   * Second String is the between-dimensions-separator
+_outputArray :: (Unbox a, Show a) => Array U DIM2 a -> String -> String -> B.ByteString
+_outputArray a itt lt = B.concat $
+                                (B.pack $ "Matrix "++(show $ listOfShape $ extent a)++ "\n")
+                                : (L.map B.pack (_outputArray' (extent a) a itt lt))
+        where
+        _outputArray' :: (Unbox a, Show a) => DIM2 -> Array U DIM2 a -> String -> String -> [String]
+        _outputArray' shape@(Z :. si :. sj) a itt lt = [(_outputArray'' shape i 0 a itt) ++ lt | i <- [0..(si - 1)]]
+
+        _outputArray'' :: (Unbox a, Show a) => DIM2 -> Int -> Int -> Array U DIM2 a -> String -> String
+        _outputArray'' shape@(Z :. si :. sj) i j a itt
+                        | sj-1 == j = show (a!(ix2 i j))  -- no "," for last one..
+                        | otherwise = show (a!(ix2 i j)) ++ itt ++ (_outputArray'' shape i (j+1) a itt)
+
+outputGraph :: [Graph] -> B.ByteString
+outputGraph gs = B.concat $ L.map (flipto3 _outputGraph "," "\n") (L.sort gs)
+                                        +|| (parBuffer 25 rseq) --run parallel
+
+_outputGraph :: Graph -> String -> String -> B.ByteString
+_outputGraph (indices, (constdim, constmat), dens) itt lt =
+                                    let
+                                            plt = B.pack lt
+                                            pitt = B.pack itt
+                                    in
+                                        B.concat $
+                                        [
+                                                (B.pack $ "Density: " ++ lt ++ show dens),
+                                                plt,
+                                                (B.pack $ "Indices used:" ++ lt ++ V.foldl (appendS itt) "" (toUnboxed indices)),
+                                                plt,
+                                                (B.pack $ "Attribute-Dimensions satisfied:" ++ lt ++ V.foldl (appendS itt) "" (toUnboxed constdim)),
+                                                plt,
+                                                outputArray $ computeS $ transpose constmat,
+                                                plt,
+                                                plt
+                                        ]
+

src/DCB/Structures.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+module DCB.Structures where
+
+import           Data.Array.Repa as A hiding ((++))
+import           Data.Int
+import           Util
+
+
+-- | a one-dimensional array
+type Vector r e = Array r DIM1 e
+-- | a two-dimensional array
+type Matrix r e = Array r DIM2 e
+
+-- | A 'Matrix' of attribute values assigned to a graph’s nodes.
+--   Each row contains the corresponding node’s attribute values.
+type Attr  = Matrix A.U Double
+-- | Adjacency-Matrix
+type Adj   = Matrix A.U Int8
+
+-- | Matrix storing the extent of a 'Graph'’s constraints fulfillment.
+--   It stores the minimum (zeroth column) and maximum (first column) value of all
+--   the 'Graph'’s nodes per attribute.
+--   The 'Vector' stores values of @1@ if the bounds are within the allowed range
+--   ragarding the corresponding attribute, or @0@ if not.
+type Constraints = (Vector A.U Int, Matrix A.U Double)
+-- | A 'Vector' of weights indicating how much divergence is allowed in which dimension.
+--   Each dimension represents an attribute.
+type MaxDivergence = Vector A.U Double
+-- | A graph’s density.
+type Density = Double
+
+-- | consists of a 'Vector' denoting which columns of the 'Matrix' represents which originating
+--   column in the global adjancency-matrix, a 'Matrix' of 'Constraints' and a scalar denoting the graph’s 'Density'
+type Graph = (Vector A.U Int, Constraints, Density)
+
+instance Ord Graph where
+        (nodes, _, _) `compare` (nodes', _, _) = (A.size $ A.extent nodes) `compare` (A.size $ A.extent nodes')
+
+

src/Main.hs

@@ -17,9 +17,10 @@
 --
 -----------------------------------------------------------------------------
 
-module Main where
+module DCB.DCBn where
 
-import           DCB
+import           DCB.DCB
+import           DCB.IO
 import           Util
 
 import           Control.DeepSeq
@@ -118,7 +119,7 @@ emptyLine a
 --doCalculation :: Matrix Int -> B.ByteString
 doCalculation adj attr =
         let
-                dens = 0.7
+                dens = 0.75
                 omega = (A.fromListUnboxed (ix1 3) [0.5,0.5,0.5])
                 delta = 2
                 (adj_, graph_) = preprocess adj attr {--0.8--} omega delta
@@ -126,9 +127,9 @@ doCalculation adj attr =
                 B.concat $
                         [
                                 outputArray $ trace ("After: "++ show (sumAllS adj_)++"\n") adj_,
-                                outputGraph $ L.sort $ doAll graph_ adj attr dens omega delta,
+                                outputGraph $ L.sort $ doAll graph_ adj_ attr dens omega delta
-                                outputGraph $ L.sort $ (step graph_ adj attr dens omega delta) ++ 
+--                                outputGraph $ L.sort $ (step graph_ adj attr dens omega delta)
-                                                        (step (step graph_ adj attr dens omega delta) adj attr dens omega delta)
+--                                                       ++ (step (step graph_ adj attr dens omega delta) adj attr dens omega delta)
                         ]
                 where
                         doAll [] _ _ _ _ _ = []
@@ -136,57 +137,6 @@ doCalculation adj attr =
                         doAll' [] _ _ _ _ _ = []
                         doAll' gs a b c d e = gs ++ doAll' (step gs a b c d e) a b c d e
 
--- | creates a default-formatted output with \",\" in between elements
---   and \"\\n\" in between dimensions
---
---   calls '_outputArray' with preset properties
-outputArray :: (Unbox a, Show a) => Array U DIM2 a -> B.ByteString
-outputArray a = _outputArray a "\t" "\n"
-
--- | creates a formatted output from a DIM2 repa-Array
---
---   * First String is the between-element-separator
---
---   * Second String is the between-dimensions-separator
-_outputArray :: (Unbox a, Show a) => Array U DIM2 a -> String -> String -> B.ByteString
-_outputArray a itt lt = B.concat $
-                                (B.pack $ "Matrix "++(show $ listOfShape $ extent a)++ "\n")
-                                : (L.map B.pack (_outputArray' (extent a) a itt lt))
-        where
-        _outputArray' :: (Unbox a, Show a) => DIM2 -> Array U DIM2 a -> String -> String -> [String]
-        _outputArray' shape@(Z :. si :. sj) a itt lt = [(_outputArray'' shape i 0 a itt) ++ lt | i <- [0..(si - 1)]]
-
-        _outputArray'' :: (Unbox a, Show a) => DIM2 -> Int -> Int -> Array U DIM2 a -> String -> String
-        _outputArray'' shape@(Z :. si :. sj) i j a itt
-                        | sj-1 == j = show (a!(ix2 i j))  -- no "," for last one..
-                        | otherwise = show (a!(ix2 i j)) ++ itt ++ (_outputArray'' shape i (j+1) a itt)
-
-outputGraph :: [Graph] -> B.ByteString
-outputGraph gs = B.concat $ L.map (flipto3 _outputGraph "," "\n") (L.sort gs)
-                                        +|| (parBuffer 25 rseq) --run parallel
-
-_outputGraph :: Graph -> String -> String -> B.ByteString
-_outputGraph (indices, (constdim, constmat), dens) itt lt =
-                                    let
-                                            plt = B.pack lt
-                                            pitt = B.pack itt
-                                    in
-                                        B.concat $
-                                        [
-                                                (B.pack $ "Density: " ++ lt ++ show dens),
-                                                plt,
-                                                (B.pack $ "Indices used:" ++ lt ++ V.foldl (appendS itt) "" (toUnboxed indices)),
-                                                plt,
-                                                (B.pack $ "Attribute-Dimensions satisfied:" ++ lt ++ V.foldl (appendS itt) "" (toUnboxed constdim)),
-                                                plt,
-                                                outputArray $ computeS $ transpose constmat,
-                                                plt,
-                                                plt
-                                        ]
-
-appendS :: (Show a) => String -> String -> a -> String
-appendS sep a b = (a ++ show b) ++ sep
-
 -- | gets the length of the Left a.
 --
 --   0 if Left a empty or no valid constructor.
@@ -212,13 +162,6 @@ showHelp = do
                            "\n"
                 exitSuccess
 
-infixl 1 +||
-
--- | short for a `using` b. We don't need brackets this way and are able to comment out parallelism.
-(+||) :: a -> Strategy a -> a
-a +|| b = a `using` b
-
-
 -- | checks if the submitted Text is empty. If not it will be printed out and the program aborts
 checkError :: T.Text -> IO ()
 checkError a

src/Util.hs

@@ -1,5 +1,7 @@
 module Util where
 
+import           Control.Parallel.Strategies
+
 -- | Move first argument to first place (for style uniformity)
 flip1 :: (a -> b) -> (a -> b)
 flip1 = id
@@ -72,3 +74,13 @@ flipto8 fun b c d e f g h a = fun a b c d e f g h
 -- | Move first argument to last (ninth) place
 flipto9 :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> b -> c -> d -> e -> f -> g -> h -> i -> a -> j
 flipto9 fun b c d e f g h i a = fun a b c d e f g h i
+
+infixl 1 +||
+
+-- | short for a `using` b. We don't need brackets this way and are able to comment out parallelism.
+(+||) :: a -> Strategy a -> a
+a +|| b = a `using` b
+
+appendS :: (Show a) => String -> String -> a -> String
+appendS sep a b = (a ++ show b) ++ sep
+