implemented more untested stuff

This commit is contained in:
Nicole Dresselhaus 2013-12-03 01:39:24 +01:00
parent 03be3b4b5b
commit 61d0868b0d
2 changed files with 42 additions and 14 deletions

View File

@ -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

View File

@ -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)