Drezil/hgraph
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

implemented step. Something is wrong with the 2nd expansion.. 1 Graph wont get created due to some constraint..

Browse Source
This commit is contained in:
Nicole Dresselhaus 2013-12-03 02:44:22 +01:00
parent 1241394c3e
commit 56d6d29f3a
2 changed files with 31 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src/DCB.hs
View File

@ -29,6 +29,7 @@ import qualified Data.Array.Repa as A
import Data.Array.Repa.Index import Data.Array.Repa.Index
import Data.Either import Data.Either
import Data.Int import Data.Int
import qualified Data.List as L
import Data.Maybe import Data.Maybe
import qualified Data.Vector.Unboxed as V import qualified Data.Vector.Unboxed as V
import Debug.Trace import Debug.Trace
@ -89,6 +90,12 @@ testDensity = 0.7::Density;
testReq = 3 ::Int 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
-- | calculates all possible additions to one Graph, yielding a list of valid expansions -- | calculates all possible additions to one Graph, yielding a list of valid expansions
-- i.e. constraint a == Just Constraints for all returned Graphs -- i.e. constraint a == Just Constraints for all returned Graphs
expand :: Adj -> Attr -> Density -> MaxDivergence -> Int -> Graph -> [Graph] expand :: Adj -> Attr -> Density -> MaxDivergence -> Int -> Graph -> [Graph]
@ -102,10 +109,10 @@ expand adj attr d div req g@(ind,_,_) = catMaybes $ map
-- returned as a 'Graph'. -- returned as a 'Graph'.
preprocess :: Adj -- ^ original adjacency matrix preprocess :: Adj -- ^ original adjacency matrix
-> Attr -- ^ table of the node’s attributes -> Attr -- ^ table of the node’s attributes
-> MaxDivergence -- ^ maximum allowed ranges of the node’s attribute -> MaxDivergence -- ^ maximum allowed ranges of the node’s attribute
-- values to be considered as consistent -- values to be considered as consistent
-> Int -- ^ required number of consistent attributes -> Int -- ^ required number of consistent attributes
-> (Adj, [Graph]) -> (Adj, [Graph])
preprocess adj attr div req = preprocess adj attr div req =
let let
(Z:.nNodes:._) = A.extent adj (Z:.nNodes:._) = A.extent adj
@ -153,8 +160,11 @@ constraintInit attr div req i j =
in if nrHit >= req then Just (A.computeS fulfill, constr) else Nothing in if nrHit >= req then Just (A.computeS fulfill, constr) else Nothing
-- | removes all duplicate graphs -- | removes all duplicate graphs
filterLayer :: Vector A.U Graph -> Vector A.U Graph filterLayer :: [Graph] -> [Graph]
filterLayer gs = undefined -- TODO filterLayer gs = L.nubBy filter gs
where
filter :: Graph -> Graph -> Bool
filter (ind,_,_) (ind',_,_) = and [V.any (==i) (A.toUnboxed ind) | i <- A.toList ind']
-- | Checks whether a given base 'Graph' can be extended by a single node and -- | Checks whether a given base 'Graph' can be extended by a single node and
-- the resulting 'Graph' still satisfies the given attribute constraints. -- the resulting 'Graph' still satisfies the given attribute constraints.
@ -209,7 +219,7 @@ addPoint adj attr d div req g@(nodes, _, dens) n =
case constr of case constr of
Nothing -> Nothing Nothing -> Nothing
(Just c) -> (Just c) ->
case dens >= d of case densNew >= d of
True -> Just (A.computeS $nodes ++ A.fromListUnboxed (ix1 1) [n], c, densNew) True -> Just (A.computeS $nodes ++ A.fromListUnboxed (ix1 1) [n], c, densNew)
False -> Nothing False -> Nothing

16
src/Main.hs
View File

@ -117,12 +117,24 @@ emptyLine a
-- TODO: implement calculation -- TODO: implement calculation
--doCalculation :: Matrix Int -> B.ByteString --doCalculation :: Matrix Int -> B.ByteString
doCalculation adj attr = doCalculation adj attr =
let (adj_, graph_) = preprocess adj attr {--0.8--} (A.fromListUnboxed (ix1 3) [0.5,0.5,0.5]) 2 in let
dens = 0.7
omega = (A.fromListUnboxed (ix1 3) [0.5,0.5,0.5])
delta = 2
(adj_, graph_) = preprocess adj attr {--0.8--} omega delta
in
B.concat $ B.concat $
[ [
outputArray $ trace ("After: "++ show (sumAllS adj_)++"\n") adj_, outputArray $ trace ("After: "++ show (sumAllS adj_)++"\n") adj_,
outputGraph graph_ 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 [] _ _ _ _ _ = []
doAll gs a b c d e = doAll' (step gs a b c d e) a b c d e
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 -- | creates a default-formatted output with \",\" in between elements
-- and \"\\n\" in between dimensions -- and \"\\n\" in between dimensions