diff --git a/src/DCB.hs b/src/DCB.hs index bdd82f2..44d6be0 100644 --- a/src/DCB.hs +++ b/src/DCB.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE TypeSynonymInstances, TypeOperators #-} ----------------------------------------------------------------------------- -- -- Module : DCB @@ -39,14 +39,14 @@ type Matrix r e = Array r DIM2 e -- Each row contains the corresponding node’s attribute values. type Attr = Matrix A.U Double -- | Adjacency-Matrix -type Adj = Matrix A.U Int16 +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 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. -- Each dimension represents an attribute. type MaxDivergence = Vector A.U Double @@ -166,7 +166,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 - 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 nrHit = A.foldAllS (+) (0::Int) $A.map fromIntegral fulfillNew in if nrHit >= req then Just (A.computeS fulfillNew, constrNew) else Nothing @@ -209,5 +209,19 @@ addPoint adj attr d div req g@(nodes, _, dens) n = False -> Nothing -- | yields all valid addititons (=neighbours) to a Graph -addablePoints :: Adj -> Graph -> Vector A.U Int -addablePoints adj g = undefined --TODO +addablePoints :: Adj -> Graph -> Vector A.U Int8 +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))] + + + diff --git a/src/Main.hs b/src/Main.hs index a568731..197933d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -107,7 +107,7 @@ createAttr (!input) = createAttr' (T.split (=='\t') input) (Left []) Left rs -> Left (this : rs) _ -> next)) --- | checks if a given Text is empty ("", whitespaces) +-- | checks if a given Text is empty (Empty String, whitespaces) emptyLine :: T.Text -> Bool emptyLine a | T.null a = True