From 61d0868b0d42dc76e3f860c724ddb332f49f1e6a Mon Sep 17 00:00:00 2001
From: Stefan Dresselhaus <sdressel@techfak.uni-bielefeld.de>
Date: Tue, 3 Dec 2013 01:39:24 +0100
Subject: [PATCH] implemented more untested stuff

---
 src/DCB.hs  | 32 ++++++++++++++++++++------------
 src/Util.hs | 24 ++++++++++++++++++++++--
 2 files changed, 42 insertions(+), 14 deletions(-)

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)