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 FlexibleInstances #-}
|
||||||
{-# LANGUAGE OverlappingInstances #-}
|
{-# LANGUAGE OverlappingInstances #-}
|
||||||
{-# LANGUAGE TypeSynonymInstances, TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
--
|
--
|
||||||
-- Module : DCB
|
-- Module : DCB
|
||||||
@ -16,6 +17,7 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module DCB where
|
module DCB where
|
||||||
|
import Util
|
||||||
|
|
||||||
import Prelude hiding ((++))
|
import Prelude hiding ((++))
|
||||||
import qualified Prelude ((++))
|
import qualified Prelude ((++))
|
||||||
@ -27,6 +29,7 @@ import qualified Data.Array.Repa as A
|
|||||||
import Data.Array.Repa.Index
|
import Data.Array.Repa.Index
|
||||||
import Data.Either
|
import Data.Either
|
||||||
import Data.Int
|
import Data.Int
|
||||||
|
import Data.Maybe
|
||||||
import qualified Data.Vector.Unboxed as V
|
import qualified Data.Vector.Unboxed as V
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
|
||||||
@ -81,8 +84,10 @@ testReq = 3 ::Int
|
|||||||
|
|
||||||
-- | calculates all possible additions to one Graph, yielding a list of valid expansions
|
-- | calculates all possible additions to one Graph, yielding a list of valid expansions
|
||||||
-- i.e. constraint a == Just Constraints for all returned Graphs
|
-- i.e. constraint a == Just Constraints for all returned Graphs
|
||||||
expand :: Adj -> Attr -> Graph -> [Graph]
|
expand :: Adj -> Attr -> Density -> MaxDivergence -> Int -> Graph -> [Graph]
|
||||||
expand adj attr g = undefined -- addablePoints -> for each: addPoint -> filterLayer
|
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!
|
--TODO: Haddoc!
|
||||||
--Was macht der Int?
|
--Was macht der Int?
|
||||||
@ -171,19 +176,22 @@ addPoint adj attr d div req g@(nodes, _, dens) n =
|
|||||||
False -> Nothing
|
False -> Nothing
|
||||||
|
|
||||||
-- | yields all valid addititons (=neighbours) to a Graph
|
-- | yields all valid addititons (=neighbours) to a Graph
|
||||||
addablePoints :: Adj -> Graph -> Vector A.U Int8
|
addablePoints :: Adj -> Graph -> Vector A.U Bool
|
||||||
addablePoints adj (ind,_,_) = A.computeS $
|
addablePoints adj (ind,_,_) = A.computeS $
|
||||||
A.traverse
|
(A.traverse
|
||||||
adj
|
adj
|
||||||
reduceDim
|
reduceDim
|
||||||
(foldOr ind)
|
(foldOr ind))
|
||||||
where
|
where
|
||||||
|
|
||||||
reduceDim :: (A.Shape sh, Integral a) => (sh :. a) -> sh
|
reduceDim :: (A.Shape sh, Integral a) => (sh :. a) -> sh
|
||||||
reduceDim (a :. b) = a --A.shapeOfList $ tail $ A.listOfShape a
|
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 :: (A.Shape sh') => Vector A.U Int -> ((sh' :. Int :. Int) -> Int8) -> (sh' :. Int) -> Bool
|
||||||
foldOr indlist lookup ind = foldl1 (+) [lookup (ind :. i) | i <- (map fromIntegral (A.toList indlist))]
|
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
|
-- | Move third argument to first place
|
||||||
flip3 :: (a -> b -> c -> d) -> c -> a -> b -> d
|
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
|
-- | Move fourth argument to first place
|
||||||
flip4 :: (a -> b -> c -> d -> e) -> d -> a -> b -> c -> e
|
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)
|
-- | Move first argument to last place (for style uniformity)
|
||||||
|
Loading…
Reference in New Issue
Block a user