https://wiki.haskell.org/index.php?title=99_questions/Solutions/83&feed=atom&action=history
99 questions/Solutions/83 - Revision history
2015-08-31T15:47:40Z
Revision history for this page on the wiki
MediaWiki 1.19.14+dfsg-1
https://wiki.haskell.org/index.php?title=99_questions/Solutions/83&diff=57138&oldid=prev
Vict: created page w/ working solution
2013-11-22T19:43:34Z
<p>created page w/ working solution</p>
<p><b>New page</b></p><div>(**) Construct all spanning trees<br />
<br />
Write a predicate s_tree(Graph,Tree) to construct (by backtracking) all spanning trees of a given graph.<br />
<br />
Here is a working solution that generates all possible subgraphs, then filters out those that meet the criteria for a spanning tree:<br />
<br />
<haskell><br />
data Graph a = Graph [a] [(a, a)]<br />
deriving (Show, Eq)<br />
<br />
k4 = Graph ['a', 'b', 'c', 'd']<br />
[('a', 'b'), ('b', 'c'), ('c', 'd'), ('d', 'a'), ('a', 'c'), ('b', 'd')]<br />
<br />
paths' :: (Eq a) => a -> a -> [(a, a)] -> [[a]]<br />
paths' a b xs | a == b = [[a]]<br />
| otherwise = concat [map (a :) $ paths' d b $ [x | x <- xs, x /= (c, d)]<br />
| (c, d) <- xs, c == a] ++ <br />
concat [map (a :) $ paths' c b $ [x | x <- xs, x /= (c, d)]<br />
| (c, d) <- xs, d == a]<br />
<br />
cycle' :: (Eq a) => a -> [(a, a)] -> [[a]]<br />
cycle' a xs = [a : path | e <- xs, fst e == a, path <- paths' (snd e) a [x | x <- xs, x /= e]] ++<br />
[a : path | e <- xs, snd e == a, path <- paths' (fst e) a [x | x <- xs, x /= e]]<br />
<br />
spantree :: (Eq a) => Graph a -> [Graph a]<br />
spantree (Graph xs ys) = filter (connected) $ filter (not . cycles) $ filter (nodes) alltrees<br />
where<br />
alltrees = [Graph (ns edges) edges | edges <- foldr acc [[]] ys]<br />
acc e es = es ++ (map (e:) es)<br />
ns e = foldr (\x xs -> if x `elem` xs then xs else x:xs) <br />
[] $ concat $ map (\(a, b) -> [a, b]) e<br />
nodes (Graph xs' ys') = length xs == length xs'<br />
cycles (Graph xs' ys') = any ((/=) 0 . length . flip cycle' ys') xs'<br />
connected (Graph (x':xs') ys') = not $ any (null) [paths' x' y' ys' | y' <- xs']<br />
</haskell></div>
Vict