How to find all possible subtrees of a binary tree in Haskell?

Question

I need to find all possible subtrees in a binary tree:

allSubtrees :: BinaryT a -> [BinaryT a]
allSubtrees = undefined

and the tree is:

data BinaryT a =
    Empty
  | Node (BinaryT a) a (BinaryT a)
  deriving (Eq, Show)

I'm new to Haskell and I know there's no while ⁄ for loop in Haskell. Haskell is all about recursion. My question is, how to get all the possible subtrees of a tree without infinite recursion?

Empty is a subtree. Do you need it listed once for every occurrence in the tree? — Sassa NF, Aug 29 '13 at 21:52
actually, Haskell is all about [Corecursion](https://en.wikipedia.org/wiki/Corecursion) as well. to prevent infinite recursion the solution here must be a [corecursive queue breadth-first traversal of a tree](https://en.wikipedia.org/wiki/Corecursion#corecursive_queue_breadth-first_tree_traversal). — Will Ness, Aug 31 '13 at 09:05

score 6 · Answer 1 · answered Aug 29 '13 at 21:09

bheklilr gave you an answer to one interpretation of your question, but this is what I would tell you as a beginner who would benefit from working through the problem yourself:

First make sure you've clearly defined what you want your function to do. I'm assuming you want it to work like tails.

Then think declaratively, where your =-sign means "is", and write two statements. The first should read "allSubtrees of the Empty tree is ..." (this is your base case):

allSubtrees Empty = ...

Then your recursive case, reading "allSubtrees of a Node is ...":

allSubtrees (Node l a r) = ...something combining the subTrees of l and the subtrees of r

If you can't wrap your head around this, try just writing a recursive function that works correctly for Node Empty 1 Empty, and then generalize it.

score 3 · Answer 2 · answered Aug 29 '13 at 21:08

3

Uniplate is your friend, here:

{-# LANGUAGE DeriveDataTypeable #-}

import Data.Generics.Uniplate.Data (universe)
import Data.Data (Data)
import Data.Typeable (Typeable)

data BinaryT a =
   Empty
   | Node (BinaryT a) a (BinaryT a)
deriving (Eq, Show, Typeable, Data)


allSubtrees :: (Data a, Typeable a) => BinaryT a -> [BinaryT a]
allSubtrees = universe

answered Aug 29 '13 at 21:08

cliffordbeshers

59
2

@jtobin: see also a `geniplate` example in my answer – nponeccop Aug 30 '13 at 15:26

nponeccop · Answer 3 · 2013-08-30T15:34:30.480

Since Uniplate demonstration is already there, here is an implementation using recursion-schemes library for completeness sake:

{-# LANGUAGE DeriveFunctor, TypeFamilies #-}
import Data.Functor.Foldable

data BinaryT a 
    = Empty
    | Node (BinaryT a) a (BinaryT a)
    deriving (Eq, Show)

data BinaryTBase a b 
    = BaseEmpty 
    | BaseNode b a b
    deriving (Functor)

type instance Base (BinaryT a) = BinaryTBase a

instance Foldable (BinaryT b) where
    project Empty = BaseEmpty
    project (Node a b c) = BaseNode a b c 

instance Unfoldable (BinaryT b) where
    embed BaseEmpty = Empty
    embed (BaseNode a b c) = Node a b c 

allSubtrees :: BinaryT a -> [BinaryT a]     
allSubtrees = para phi where
    phi BaseEmpty = []
    phi (BaseNode (l, ll) v (r, rr)) = ll ++ rr ++ [Node r v l]

The base functor boilerplate is large, but relatively unsurprising and may save you effort in long run as it's once per type.

And here is yet another implementation using geniplate library:

{-# LANGUAGE TemplateHaskell #-}
import Data.Generics.Geniplate

data BinaryT a =
    Empty
  | Node (BinaryT a) a (BinaryT a)
  deriving (Eq, Show)

allSubTrees :: BinaryT a -> [BinaryT a]
allSubTrees = $(genUniverseBi 'allSubTrees)

And here is a shortened version of @bheklilr explicitly recursive approach which one probably expects from a newcomer (I used (++) for symmetry):

allSubTrees3 :: BinaryT a -> [BinaryT a]
allSubTrees3 Empty = []
allSubTrees3 this @ (Node left _ right) = [this] ++ leftSubs ++ rightSubs where
    leftSubs = allSubTrees3 left
    rightSubs = allSubTrees3 right

Note that it lists the root but doesn't list empty subtrees, but it's easily changeable.

I wonder what are advantages and disadvantages of different approaches. Is uniplate somehow more or less type safe then other approaches?

Note that recursion-schemes approach is both concise (if you need many different traversals for one type) and flexible (you have full control over traversal order, whether to include empty subtrees etc). One disadvantage is that type of para and other schemes is too general to allow type inference, so a type signature is often needed to disambiguate.

geniplate seems to be less intrusive than uniplate, as there's no need to put deriving clauses.

score 2 · Answer 4 · answered Aug 29 '13 at 21:00

2

You can use recursion pretty easily to solve this problem. Probably easier than you could using loops.

allSubTrees :: BinaryT a -> [BinaryT a]
allSubTrees Empty = []
allSubTrees (Node Empty n Empty) = []
allSubTrees (Node Empty n right) = right : allSubTrees right
allSubTrees (Node left n Empty) = left : allSubTrees left
allSubTrees (Node left n right) = left : right : leftSubs ++ rightSubs
    where
        leftSubs = allSubTrees left
        rightSubs = allSubTrees right

answered Aug 29 '13 at 21:00

bheklilr

53,530
6
107
163

does this list the root? – Sassa NF Aug 29 '13 at 21:53
@SassaNF Nope. But if you want it to, I'll let you figure that out yourself =P – bheklilr Aug 29 '13 at 22:01

score 1 · Answer 5 · answered Aug 30 '13 at 07:40

1

In addition to nponeccop's solution, here is breadth-first walk of the tree (not possible with paramorphism; co-recursion is required, really):

{-# LANGUAGE DeriveFunctor, TypeFamilies #-}
import Data.Functor.Foldable

data BinaryT a 
    = Empty
    | Node (BinaryT a) a (BinaryT a)
    deriving (Eq, Show)

allSubtrees :: BinaryT a -> [BinaryT a]
allSubtrees t = ana phi [t] where
    phi [] = Nil
    phi (Empty:t) = Cons Empty t
    phi (n@(Node l v r):t) = Cons n (t++(l:[r]))

main = print $ allSubtrees $ 
       Node (Node Empty "a" Empty) "b" (Node (Node Empty "c" Empty) "d" Empty)

answered Aug 30 '13 at 07:40

Sassa NF

5,306
15
22

`[Node r v l] ++ ll ++ rr` in my code generates the same `badc` traversal order as your anamorphism. – nponeccop Aug 30 '13 at 15:24
@nponeccop I don't think so. ll++rr will add the whole left subtree, then the whole right subtree, won't it? Anamorphism picks the top node of the subtree first, then adds the branches to the tail. Check out how Empty are positioned in your and my case; that is indicative of differences in the order when those nodes are not Empty. (Your case doesn't add Empty to the list of subtrees, which may or may not be a bug - depending on the interpretation of the task - but suppose you did add Empty) – Sassa NF Aug 30 '13 at 15:42

How to find all possible subtrees of a binary tree in Haskell?

5 Answers5