3 import qualified Data.Set as S
4 import qualified Data.Map as M
7 import Control.Monad.State
9 data G a = Node a (G a) (G a)
13 type LoopCheck a = S.Set a
16 {- Actually i am not sure about the cata and algebra definition.
18 - ** check: http://dl.acm.org/citation.cfm?id=128035
21 -- Represents an acumulator
22 type TreeAlgebra a r = (a -> r, r -> r -> r)
24 foldG :: TreeAlgebra a r -> r -> G a -> r
25 foldG (f,g) s (Leaf val) = g (f val) s
26 foldG (f,g) s (Node val l r) = g (f val) $ g (foldG (f,g) s l) (foldG (f,g) s r)
28 printG = foldG ((: []), (++)) []
30 loopCheck :: (Ord k) => G a -> (G a -> k) -> State (LoopCheck k) Bool
31 loopCheck g f = do state <- get
32 return $ S.member (f g) state
34 addNode :: (Ord k) => k -> State (LoopCheck k) ()
35 addNode k = do s <- get
39 foldGM :: (Ord k) => TreeAlgebra a r -> (G a -> k) -> r -> G a -> State (LoopCheck k) r
40 foldGM _ _ s Nil = return s
41 foldGM (f,g) c s k@(Leaf val) = loopCheck k c >>= \p -> if p then return s else return $ g (f val) s
42 foldGM (f,g) c s k@(Node val l r) = loopCheck k c >>= \p -> if p then return s else continue
43 where t = foldGM (f,g) c s
45 continue = do addNode $ c k
48 return $ self $ g left right
50 -- Generates a node from a list of children.
51 packNodes :: [G a] -> a -> G a
52 packNodes (x:y:[]) e = Node e x y -- full binary
53 packNodes (x:[] ) e = Node e x Nil -- unary
54 packNodes [] e = Leaf e -- leaf
56 -- Generates a cyclic datastructure given edges and nodes
57 -- TODO: remove lists with maps in inputs
58 toG :: (Ord k,Show k) => ([r] -> a -> r) -> [(k,[k])] -> k -> [(k, a)] -> Maybe r
59 toG g xs start pls = let nodeTable = M.fromList pls
60 payload s = case M.lookup s nodeTable of
62 Nothing -> error "edge with no corresponding node"
64 conn = M.fromList $ map (
65 \(f,ts) -> let pl t = node f (payload t) t
67 in (f, g succ (payload f))
70 node f p t = case M.lookup t conn of
73 -> error $ "illformed edge/node list in toG" ++ (show t)
74 in M.lookup start conn
78 testG = [(0,[1,2]),(1,[3]),(2,[0]),(3,[])]
79 nodeLoads :: [(Int,String)]
80 nodeLoads = [(0,"a"),(1,"b"),(2,"c"),(3,"d")]