# 99 questions/Solutions/83

### From HaskellWiki

(**) Construct all spanning trees

Write a predicate s_tree(Graph,Tree) to construct (by backtracking) all spanning trees of a given graph.

Here is a working solution that generates all possible subgraphs, then filters out those that meet the criteria for a spanning tree:

data Graph a = Graph [a] [(a, a)] deriving (Show, Eq) k4 = Graph ['a', 'b', 'c', 'd'] [('a', 'b'), ('b', 'c'), ('c', 'd'), ('d', 'a'), ('a', 'c'), ('b', 'd')] paths' :: (Eq a) => a -> a -> [(a, a)] -> [[a]] paths' a b xs | a == b = [[a]] | otherwise = concat [map (a :) $ paths' d b $ [x | x <- xs, x /= (c, d)] | (c, d) <- xs, c == a] ++ concat [map (a :) $ paths' c b $ [x | x <- xs, x /= (c, d)] | (c, d) <- xs, d == a] cycle' :: (Eq a) => a -> [(a, a)] -> [[a]] cycle' a xs = [a : path | e <- xs, fst e == a, path <- paths' (snd e) a [x | x <- xs, x /= e]] ++ [a : path | e <- xs, snd e == a, path <- paths' (fst e) a [x | x <- xs, x /= e]] spantree :: (Eq a) => Graph a -> [Graph a] spantree (Graph xs ys) = filter (connected) $ filter (not . cycles) $ filter (nodes) alltrees where alltrees = [Graph (ns edges) edges | edges <- foldr acc [[]] ys] acc e es = es ++ (map (e:) es) ns e = foldr (\x xs -> if x `elem` xs then xs else x:xs) [] $ concat $ map (\(a, b) -> [a, b]) e nodes (Graph xs' ys') = length xs == length xs' cycles (Graph xs' ys') = any ((/=) 0 . length . flip cycle' ys') xs' connected (Graph (x':xs') ys') = not $ any (null) [paths' x' y' ys' | y' <- xs']