diff --git a/src/DCB.hs b/src/DCB.hs index 4c2578e..a32769d 100644 --- a/src/DCB.hs +++ b/src/DCB.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-} -{-# LANGUAGE TypeSynonymInstances, TypeOperators #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- -- Module : DCB @@ -16,6 +17,7 @@ ----------------------------------------------------------------------------- module DCB where +import Util import Prelude hiding ((++)) import qualified Prelude ((++)) @@ -27,6 +29,7 @@ import qualified Data.Array.Repa as A import Data.Array.Repa.Index import Data.Either import Data.Int +import Data.Maybe import qualified Data.Vector.Unboxed as V import Debug.Trace @@ -81,8 +84,10 @@ testReq = 3 ::Int -- | 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 -> Graph -> [Graph] -expand adj attr g = undefined -- addablePoints -> for each: addPoint -> filterLayer +expand :: Adj -> Attr -> Density -> MaxDivergence -> Int -> Graph -> [Graph] +expand adj attr d div req g@(ind,_,_) = catMaybes $ map + (addPoint adj attr d div req g) + (V.toList $ V.findIndices (==True) $ A.toUnboxed $ addablePoints adj g) --TODO: Haddoc! --Was macht der Int? @@ -171,19 +176,22 @@ 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 Int8 -addablePoints adj (ind,_,_) = A.computeS $ - A.traverse - adj - reduceDim - (foldOr ind) +addablePoints :: Adj -> Graph -> Vector A.U Bool +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))] + 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 + True -> False + _ -> (foldl1 (+) [lookup (ind :. i) | i <- (map fromIntegral (A.toList indlist))]) > 0 + + - \ No newline at end of file diff --git a/src/Util.hs b/src/Util.hs index b516866..628cf86 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -10,11 +10,31 @@ flip2 = flip -- | Move third argument to first place flip3 :: (a -> b -> c -> d) -> c -> a -> b -> d -flip3 f c a b = f a b c +flip3 fun c a b = fun a b c -- | Move fourth argument to first place flip4 :: (a -> b -> c -> d -> e) -> d -> a -> b -> c -> e -flip4 f d a b c = f a b c d +flip4 fun d a b c = fun a b c d + +-- | Move fifth argument to first place +flip5 :: (a -> b -> c -> d -> e -> f) -> e -> a -> b -> c -> d -> f +flip5 fun e a b c d = fun a b c d e + +-- | Move sixth argument to first place +flip6 :: (a -> b -> c -> d -> e -> f -> g) -> f -> a -> b -> c -> d -> e -> g +flip6 fun f a b c d e = fun a b c d e f + +-- | Move seventh argument to first place +flip7 :: (a -> b -> c -> d -> e -> f -> g -> h) -> g -> a -> b -> c -> d -> e -> f -> h +flip7 fun g a b c d e f = fun a b c d e f g + +-- | Move eighths argument to first place +flip8 :: (a -> b -> c -> d -> e -> f -> g -> h -> i) -> h -> a -> b -> c -> d -> e -> f -> g -> i +flip8 fun h a b c d e f g = fun a b c d e f g h + +-- | Move ninths argument to first place +flip9 :: (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> i -> a -> b -> c -> d -> e -> f -> g -> h -> j +flip9 fun i a b c d e f g h = fun a b c d e f g h i -- | Move first argument to last place (for style uniformity)