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

implemented addablePoints.. not tested, but type-checked :p

Browse Source
This commit is contained in:
Nicole Dresselhaus 2013-12-03 00:22:51 +01:00
parent 03a34eac8e
commit 03be3b4b5b
2 changed files with 21 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/DCB.hs
View File

@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances, TypeOperators #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- --
-- Module : DCB -- Module : DCB
@ -35,12 +35,12 @@ type Matrix r e = Array r DIM2 e
type Attr = Matrix A.U Double type Attr = Matrix A.U Double
-- | Adjacency-Matrix -- | Adjacency-Matrix
type Adj = Matrix A.U Int16 type Adj = Matrix A.U Int8
-- | Matrix of constraints -- | Matrix of constraints
--TODO: Haddoc! --TODO: Haddoc!
type Constraints = (Vector A.U Int16, Matrix A.U Double) type Constraints = (Vector A.U Int, Matrix A.U Double)
-- | A vector of weights indicating how much divergence is allowed in which dimension -- | A vector of weights indicating how much divergence is allowed in which dimension
type MaxDivergence = Vector A.U Double type MaxDivergence = Vector A.U Double
-- | Make this special Scalar explicitly visible -- | Make this special Scalar explicitly visible
@ -140,7 +140,7 @@ constraint attr div req (_, (fulfill, constr), _) newNode =
0 -> min (f sh) (attr!sh) 0 -> min (f sh) (attr!sh)
1 -> max (f sh) (attr!sh) 1 -> max (f sh) (attr!sh)
constrNew = A.computeUnboxedS $A.traverse constr id updateConstr constrNew = A.computeUnboxedS $A.traverse constr id updateConstr
fulfillNew = A.zipWith (\i b -> if i == 1 && b then 1::Int16 else 0::Int16) fulfill 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 $A.zipWith (\thediv dist -> abs dist <= thediv) div $A.foldS (-) 0 constrNew
nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew
in if nrHit >= req then Just (A.computeS fulfillNew, constrNew) else Nothing in if nrHit >= req then Just (A.computeS fulfillNew, constrNew) else Nothing
@ -171,5 +171,19 @@ addPoint adj attr d div req g@(nodes, _, dens) n =
False -> Nothing False -> Nothing
-- | yields all valid addititons (=neighbours) to a Graph -- | yields all valid addititons (=neighbours) to a Graph
addablePoints :: Adj -> Graph -> Vector A.U Int addablePoints :: Adj -> Graph -> Vector A.U Int8
addablePoints adj g = undefined --TODO addablePoints adj (ind,_,_) = A.computeS $
A.traverse
adj
reduceDim
(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', Num a) => Vector A.U Int -> ((sh' :. Int) -> a) -> sh' -> a
foldOr indlist lookup ind = foldl1 (+) [lookup (ind :. i) | i <- (map fromIntegral (A.toList indlist))]

2
src/Main.hs
View File

@ -107,7 +107,7 @@ createAttr (!input) = createAttr' (T.split (=='\t') input) (Left [])
Left rs -> Left (this : rs) Left rs -> Left (this : rs)
_ -> next)) _ -> next))
-- | checks if a given Text is empty ("", whitespaces) -- | checks if a given Text is empty (Empty String, whitespaces)
emptyLine :: T.Text -> Bool emptyLine :: T.Text -> Bool
emptyLine a emptyLine a
| T.null a = True | T.null a = True