debugging.. split Module in more files
This commit is contained in:
parent
56d6d29f3a
commit
f70e73f0d4
12
hgraph.cabal
12
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
|
||||
|
@ -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)
|
||||
$A.traverse nodes id (\f sh -> fromIntegral $adj!(ix2 (f sh) newNode))
|
||||
neighbourSlice = A.traverse
|
||||
(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
|
65
src/DCB/IO.hs
Normal file
65
src/DCB/IO.hs
Normal file
@ -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
|
||||
]
|
||||
|
41
src/DCB/Structures.hs
Normal file
41
src/DCB/Structures.hs
Normal file
@ -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')
|
||||
|
||||
|
71
src/Main.hs
71
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 $ (step graph_ adj attr dens omega delta) ++
|
||||
(step (step graph_ adj attr dens omega delta) 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)
|
||||
-- ++ (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
|
||||
|
12
src/Util.hs
12
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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user