implemented more untested stuff
This commit is contained in:
parent
03be3b4b5b
commit
61d0868b0d
32
src/DCB.hs
32
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
|
||||
|
||||
|
||||
|
||||
|
||||
|
24
src/Util.hs
24
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)
|
||||
|
Loading…
Reference in New Issue
Block a user