Zip
Zip

Reputation: 859

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

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 whilefor loop in Haskell. Haskell is all about recursion. My question is, how to get all the possible subtrees of a tree without infinite recursion?

Upvotes: 4

Views: 2127

Answers (5)

nponeccop
nponeccop

Reputation: 13677

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.

Upvotes: 3

Sassa NF
Sassa NF

Reputation: 5406

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)

Upvotes: 1

jberryman
jberryman

Reputation: 16645

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.

Upvotes: 6

cliffordbeshers
cliffordbeshers

Reputation: 59

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

Upvotes: 3

bheklilr
bheklilr

Reputation: 54068

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

Upvotes: 2

Related Questions