{-# Language DeriveFunctor#-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.BinaryTree
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Several types of Binary trees.
--
--------------------------------------------------------------------------------
module Data.BinaryTree where

import           Algorithms.DivideAndConquer
import           Control.DeepSeq
import           Data.Bifunctor.Apply
import           Data.List.NonEmpty (NonEmpty)
import           Data.Maybe (mapMaybe)
import           Data.Measured.Class
import           Data.Measured.Size
import           Data.Semigroup.Foldable
import qualified Data.Tree as Tree
import           Data.Tree.Util (TreeNode(..))
import qualified Data.Vector as V
import           GHC.Generics (Generic)
import           Test.QuickCheck
--------------------------------------------------------------------------------

-- | Binary tree that stores its values (of type a) in the leaves. Internal
-- nodes store something of type v.
data BinLeafTree v a = Leaf !a
                     | Node (BinLeafTree v a) !v (BinLeafTree v a)
                     deriving (Int -> BinLeafTree v a -> ShowS
[BinLeafTree v a] -> ShowS
BinLeafTree v a -> String
(Int -> BinLeafTree v a -> ShowS)
-> (BinLeafTree v a -> String)
-> ([BinLeafTree v a] -> ShowS)
-> Show (BinLeafTree v a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall v a. (Show a, Show v) => Int -> BinLeafTree v a -> ShowS
forall v a. (Show a, Show v) => [BinLeafTree v a] -> ShowS
forall v a. (Show a, Show v) => BinLeafTree v a -> String
showList :: [BinLeafTree v a] -> ShowS
$cshowList :: forall v a. (Show a, Show v) => [BinLeafTree v a] -> ShowS
show :: BinLeafTree v a -> String
$cshow :: forall v a. (Show a, Show v) => BinLeafTree v a -> String
showsPrec :: Int -> BinLeafTree v a -> ShowS
$cshowsPrec :: forall v a. (Show a, Show v) => Int -> BinLeafTree v a -> ShowS
Show,ReadPrec [BinLeafTree v a]
ReadPrec (BinLeafTree v a)
Int -> ReadS (BinLeafTree v a)
ReadS [BinLeafTree v a]
(Int -> ReadS (BinLeafTree v a))
-> ReadS [BinLeafTree v a]
-> ReadPrec (BinLeafTree v a)
-> ReadPrec [BinLeafTree v a]
-> Read (BinLeafTree v a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall v a. (Read a, Read v) => ReadPrec [BinLeafTree v a]
forall v a. (Read a, Read v) => ReadPrec (BinLeafTree v a)
forall v a. (Read a, Read v) => Int -> ReadS (BinLeafTree v a)
forall v a. (Read a, Read v) => ReadS [BinLeafTree v a]
readListPrec :: ReadPrec [BinLeafTree v a]
$creadListPrec :: forall v a. (Read a, Read v) => ReadPrec [BinLeafTree v a]
readPrec :: ReadPrec (BinLeafTree v a)
$creadPrec :: forall v a. (Read a, Read v) => ReadPrec (BinLeafTree v a)
readList :: ReadS [BinLeafTree v a]
$creadList :: forall v a. (Read a, Read v) => ReadS [BinLeafTree v a]
readsPrec :: Int -> ReadS (BinLeafTree v a)
$creadsPrec :: forall v a. (Read a, Read v) => Int -> ReadS (BinLeafTree v a)
Read,BinLeafTree v a -> BinLeafTree v a -> Bool
(BinLeafTree v a -> BinLeafTree v a -> Bool)
-> (BinLeafTree v a -> BinLeafTree v a -> Bool)
-> Eq (BinLeafTree v a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v a.
(Eq a, Eq v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
/= :: BinLeafTree v a -> BinLeafTree v a -> Bool
$c/= :: forall v a.
(Eq a, Eq v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
== :: BinLeafTree v a -> BinLeafTree v a -> Bool
$c== :: forall v a.
(Eq a, Eq v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
Eq,Eq (BinLeafTree v a)
Eq (BinLeafTree v a)
-> (BinLeafTree v a -> BinLeafTree v a -> Ordering)
-> (BinLeafTree v a -> BinLeafTree v a -> Bool)
-> (BinLeafTree v a -> BinLeafTree v a -> Bool)
-> (BinLeafTree v a -> BinLeafTree v a -> Bool)
-> (BinLeafTree v a -> BinLeafTree v a -> Bool)
-> (BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a)
-> (BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a)
-> Ord (BinLeafTree v a)
BinLeafTree v a -> BinLeafTree v a -> Bool
BinLeafTree v a -> BinLeafTree v a -> Ordering
BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v a. (Ord a, Ord v) => Eq (BinLeafTree v a)
forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Ordering
forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
min :: BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
$cmin :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
max :: BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
$cmax :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
>= :: BinLeafTree v a -> BinLeafTree v a -> Bool
$c>= :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
> :: BinLeafTree v a -> BinLeafTree v a -> Bool
$c> :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
<= :: BinLeafTree v a -> BinLeafTree v a -> Bool
$c<= :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
< :: BinLeafTree v a -> BinLeafTree v a -> Bool
$c< :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Bool
compare :: BinLeafTree v a -> BinLeafTree v a -> Ordering
$ccompare :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Ordering
$cp1Ord :: forall v a. (Ord a, Ord v) => Eq (BinLeafTree v a)
Ord,a -> BinLeafTree v b -> BinLeafTree v a
(a -> b) -> BinLeafTree v a -> BinLeafTree v b
(forall a b. (a -> b) -> BinLeafTree v a -> BinLeafTree v b)
-> (forall a b. a -> BinLeafTree v b -> BinLeafTree v a)
-> Functor (BinLeafTree v)
forall a b. a -> BinLeafTree v b -> BinLeafTree v a
forall a b. (a -> b) -> BinLeafTree v a -> BinLeafTree v b
forall v a b. a -> BinLeafTree v b -> BinLeafTree v a
forall v a b. (a -> b) -> BinLeafTree v a -> BinLeafTree v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BinLeafTree v b -> BinLeafTree v a
$c<$ :: forall v a b. a -> BinLeafTree v b -> BinLeafTree v a
fmap :: (a -> b) -> BinLeafTree v a -> BinLeafTree v b
$cfmap :: forall v a b. (a -> b) -> BinLeafTree v a -> BinLeafTree v b
Functor,(forall x. BinLeafTree v a -> Rep (BinLeafTree v a) x)
-> (forall x. Rep (BinLeafTree v a) x -> BinLeafTree v a)
-> Generic (BinLeafTree v a)
forall x. Rep (BinLeafTree v a) x -> BinLeafTree v a
forall x. BinLeafTree v a -> Rep (BinLeafTree v a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v a x. Rep (BinLeafTree v a) x -> BinLeafTree v a
forall v a x. BinLeafTree v a -> Rep (BinLeafTree v a) x
$cto :: forall v a x. Rep (BinLeafTree v a) x -> BinLeafTree v a
$cfrom :: forall v a x. BinLeafTree v a -> Rep (BinLeafTree v a) x
Generic)

instance (NFData v, NFData a) => NFData (BinLeafTree v a)

-- | smart constructor
node     :: Measured v a => BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
node :: BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
node BinLeafTree v a
l BinLeafTree v a
r = BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node BinLeafTree v a
l (BinLeafTree v a -> v
forall v a. Measured v a => a -> v
measure BinLeafTree v a
l v -> v -> v
forall a. Semigroup a => a -> a -> a
<> BinLeafTree v a -> v
forall v a. Measured v a => a -> v
measure BinLeafTree v a
r) BinLeafTree v a
r


instance Bifunctor BinLeafTree where
  bimap :: (a -> b) -> (c -> d) -> BinLeafTree a c -> BinLeafTree b d
bimap a -> b
f c -> d
g = \case
    Leaf c
x     -> d -> BinLeafTree b d
forall v a. a -> BinLeafTree v a
Leaf (d -> BinLeafTree b d) -> d -> BinLeafTree b d
forall a b. (a -> b) -> a -> b
$ c -> d
g c
x
    Node BinLeafTree a c
l a
k BinLeafTree a c
r -> BinLeafTree b d -> b -> BinLeafTree b d -> BinLeafTree b d
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node ((a -> b) -> (c -> d) -> BinLeafTree a c -> BinLeafTree b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g BinLeafTree a c
l) (a -> b
f a
k) ((a -> b) -> (c -> d) -> BinLeafTree a c -> BinLeafTree b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g BinLeafTree a c
r)

instance Measured v a => Measured v (BinLeafTree v a) where
  measure :: BinLeafTree v a -> v
measure (Leaf a
x)     = a -> v
forall v a. Measured v a => a -> v
measure a
x
  measure (Node BinLeafTree v a
_ v
v BinLeafTree v a
_) = v
v


instance Foldable (BinLeafTree v) where
  foldMap :: (a -> m) -> BinLeafTree v a -> m
foldMap a -> m
f (Leaf a
a)     = a -> m
f a
a
  foldMap a -> m
f (Node BinLeafTree v a
l v
_ BinLeafTree v a
r) = (a -> m) -> BinLeafTree v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f BinLeafTree v a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> BinLeafTree v a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f BinLeafTree v a
r

instance Foldable1 (BinLeafTree v)

instance Traversable (BinLeafTree v) where
  traverse :: (a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b)
traverse a -> f b
f (Leaf a
a)     = b -> BinLeafTree v b
forall v a. a -> BinLeafTree v a
Leaf (b -> BinLeafTree v b) -> f b -> f (BinLeafTree v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a
  traverse a -> f b
f (Node BinLeafTree v a
l v
v BinLeafTree v a
r) = BinLeafTree v b -> v -> BinLeafTree v b -> BinLeafTree v b
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node (BinLeafTree v b -> v -> BinLeafTree v b -> BinLeafTree v b)
-> f (BinLeafTree v b)
-> f (v -> BinLeafTree v b -> BinLeafTree v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f BinLeafTree v a
l f (v -> BinLeafTree v b -> BinLeafTree v b)
-> f v -> f (BinLeafTree v b -> BinLeafTree v b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> v -> f v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
v f (BinLeafTree v b -> BinLeafTree v b)
-> f (BinLeafTree v b) -> f (BinLeafTree v b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f BinLeafTree v a
r

instance Measured v a => Semigroup (BinLeafTree v a) where
  BinLeafTree v a
l <> :: BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
<> BinLeafTree v a
r = BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
forall v a.
Measured v a =>
BinLeafTree v a -> BinLeafTree v a -> BinLeafTree v a
node BinLeafTree v a
l BinLeafTree v a
r

instance (Arbitrary a, Arbitrary v) => Arbitrary (BinLeafTree v a) where
  arbitrary :: Gen (BinLeafTree v a)
arbitrary = (Int -> Gen (BinLeafTree v a)) -> Gen (BinLeafTree v a)
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen (BinLeafTree v a)
forall a a v.
(Ord a, Num a, Random a, Arbitrary a, Arbitrary v) =>
a -> Gen (BinLeafTree v a)
f
    where f :: a -> Gen (BinLeafTree v a)
f a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0    = a -> BinLeafTree v a
forall v a. a -> BinLeafTree v a
Leaf (a -> BinLeafTree v a) -> Gen a -> Gen (BinLeafTree v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary
              | Bool
otherwise = do
                              a
l <- (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
0,a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1)
                              BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node (BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a)
-> Gen (BinLeafTree v a)
-> Gen (v -> BinLeafTree v a -> BinLeafTree v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Gen (BinLeafTree v a)
f a
l Gen (v -> BinLeafTree v a -> BinLeafTree v a)
-> Gen v -> Gen (BinLeafTree v a -> BinLeafTree v a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen v
forall a. Arbitrary a => Gen a
arbitrary Gen (BinLeafTree v a -> BinLeafTree v a)
-> Gen (BinLeafTree v a) -> Gen (BinLeafTree v a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Gen (BinLeafTree v a)
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
la -> a -> a
forall a. Num a => a -> a -> a
-a
1)

-- | Create a balanced tree, i.e. a tree of height \(O(\log n)\) with the
-- elements in the leaves.
--
-- \(O(n)\) time.
asBalancedBinLeafTree :: NonEmpty a -> BinLeafTree Size (Elem a)
asBalancedBinLeafTree :: NonEmpty a -> BinLeafTree Size (Elem a)
asBalancedBinLeafTree = (a -> BinLeafTree Size (Elem a))
-> NonEmpty a -> BinLeafTree Size (Elem a)
forall (f :: * -> *) s a.
(Foldable1 f, Semigroup s) =>
(a -> s) -> f a -> s
divideAndConquer1 (Elem a -> BinLeafTree Size (Elem a)
forall v a. a -> BinLeafTree v a
Leaf (Elem a -> BinLeafTree Size (Elem a))
-> (a -> Elem a) -> a -> BinLeafTree Size (Elem a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Elem a
forall a. a -> Elem a
Elem)
-- -- the implementation below produces slightly less high trees, but runs in
-- -- \(O(n \log n)\) time, as on every level it traverses the list passed down.
-- asBalancedBinLeafTree ys = asBLT (length ys') ys' where ys' = toList ys

--     asBLT _ [x] = Leaf (Elem x)
--     asBLT n xs  = let h       = n `div` 2
--                       (ls,rs) = splitAt h xs
--                   in node (asBLT h ls) (asBLT (n-h) rs)

-- | Given a function to combine internal nodes into b's and leafs into b's,
-- traverse the tree bottom up, and combine everything into one b.
foldUp                  :: (b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
foldUp :: (b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
foldUp b -> v -> b -> b
_ a -> b
g (Leaf a
x)     = a -> b
g a
x
foldUp b -> v -> b -> b
f a -> b
g (Node BinLeafTree v a
l v
x BinLeafTree v a
r) = b -> v -> b -> b
f ((b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
forall b v a.
(b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
foldUp b -> v -> b -> b
f a -> b
g BinLeafTree v a
l) v
x ((b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
forall b v a.
(b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
foldUp b -> v -> b -> b
f a -> b
g BinLeafTree v a
r)


-- | Traverses the tree bottom up, recomputing the assocated values.
foldUpData     :: (w -> v -> w -> w) -> (a -> w) -> BinLeafTree v a -> BinLeafTree w a
foldUpData :: (w -> v -> w -> w)
-> (a -> w) -> BinLeafTree v a -> BinLeafTree w a
foldUpData w -> v -> w -> w
f a -> w
g = (BinLeafTree w a -> v -> BinLeafTree w a -> BinLeafTree w a)
-> (a -> BinLeafTree w a) -> BinLeafTree v a -> BinLeafTree w a
forall b v a.
(b -> v -> b -> b) -> (a -> b) -> BinLeafTree v a -> b
foldUp BinLeafTree w a -> v -> BinLeafTree w a -> BinLeafTree w a
f' a -> BinLeafTree w a
forall v a. a -> BinLeafTree v a
Leaf
  where
    f' :: BinLeafTree w a -> v -> BinLeafTree w a -> BinLeafTree w a
f' BinLeafTree w a
l v
v BinLeafTree w a
r = BinLeafTree w a -> w -> BinLeafTree w a -> BinLeafTree w a
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node BinLeafTree w a
l (w -> v -> w -> w
f (BinLeafTree w a -> w
access' BinLeafTree w a
l) v
v (BinLeafTree w a -> w
access' BinLeafTree w a
r)) BinLeafTree w a
r

    access' :: BinLeafTree w a -> w
access' (Leaf a
x)     = a -> w
g a
x
    access' (Node BinLeafTree w a
_ w
v BinLeafTree w a
_) = w
v

-- | Takes two trees, that have the same structure, and uses the provided
-- functions to "zip" them together
zipExactWith                                  :: (u -> v -> w)
                                              -> (a -> b -> c)
                                              -> BinLeafTree u a
                                              -> BinLeafTree v b
                                              -> BinLeafTree w c
zipExactWith :: (u -> v -> w)
-> (a -> b -> c)
-> BinLeafTree u a
-> BinLeafTree v b
-> BinLeafTree w c
zipExactWith u -> v -> w
_ a -> b -> c
g (Leaf a
x)     (Leaf b
y)        = c -> BinLeafTree w c
forall v a. a -> BinLeafTree v a
Leaf (a
x a -> b -> c
`g` b
y)
zipExactWith u -> v -> w
f a -> b -> c
g (Node BinLeafTree u a
l u
m BinLeafTree u a
r) (Node BinLeafTree v b
l' v
m' BinLeafTree v b
r') = BinLeafTree w c -> w -> BinLeafTree w c -> BinLeafTree w c
forall v a.
BinLeafTree v a -> v -> BinLeafTree v a -> BinLeafTree v a
Node ((u -> v -> w)
-> (a -> b -> c)
-> BinLeafTree u a
-> BinLeafTree v b
-> BinLeafTree w c
forall u v w a b c.
(u -> v -> w)
-> (a -> b -> c)
-> BinLeafTree u a
-> BinLeafTree v b
-> BinLeafTree w c
zipExactWith u -> v -> w
f a -> b -> c
g BinLeafTree u a
l BinLeafTree v b
l')
                                                     (u
m u -> v -> w
`f` v
m')
                                                     ((u -> v -> w)
-> (a -> b -> c)
-> BinLeafTree u a
-> BinLeafTree v b
-> BinLeafTree w c
forall u v w a b c.
(u -> v -> w)
-> (a -> b -> c)
-> BinLeafTree u a
-> BinLeafTree v b
-> BinLeafTree w c
zipExactWith u -> v -> w
f a -> b -> c
g BinLeafTree u a
r BinLeafTree v b
r')
zipExactWith u -> v -> w
_ a -> b -> c
_ BinLeafTree u a
_            BinLeafTree v b
_               =
    String -> BinLeafTree w c
forall a. HasCallStack => String -> a
error String
"zipExactWith: tree structures not the same "



--------------------------------------------------------------------------------
-- * Converting into a Data.Tree

-- | \( O(n) \) Convert binary tree to a rose tree, aka 'Tree.Tree'.
toRoseTree              :: BinLeafTree v a -> Tree.Tree (TreeNode v a)
toRoseTree :: BinLeafTree v a -> Tree (TreeNode v a)
toRoseTree (Leaf a
x)     = TreeNode v a -> Forest (TreeNode v a) -> Tree (TreeNode v a)
forall a. a -> Forest a -> Tree a
Tree.Node (a -> TreeNode v a
forall v a. a -> TreeNode v a
LeafNode a
x) []
toRoseTree (Node BinLeafTree v a
l v
v BinLeafTree v a
r) = TreeNode v a -> Forest (TreeNode v a) -> Tree (TreeNode v a)
forall a. a -> Forest a -> Tree a
Tree.Node (v -> TreeNode v a
forall v a. v -> TreeNode v a
InternalNode v
v) ((BinLeafTree v a -> Tree (TreeNode v a))
-> [BinLeafTree v a] -> Forest (TreeNode v a)
forall a b. (a -> b) -> [a] -> [b]
map BinLeafTree v a -> Tree (TreeNode v a)
forall v a. BinLeafTree v a -> Tree (TreeNode v a)
toRoseTree [BinLeafTree v a
l,BinLeafTree v a
r])

-- | 2-dimensional ASCII drawing of a tree.
drawTree :: (Show v, Show a) => BinLeafTree v a -> String
drawTree :: BinLeafTree v a -> String
drawTree = Tree String -> String
Tree.drawTree (Tree String -> String)
-> (BinLeafTree v a -> Tree String) -> BinLeafTree v a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TreeNode v a -> String) -> Tree (TreeNode v a) -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreeNode v a -> String
forall a. Show a => a -> String
show (Tree (TreeNode v a) -> Tree String)
-> (BinLeafTree v a -> Tree (TreeNode v a))
-> BinLeafTree v a
-> Tree String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinLeafTree v a -> Tree (TreeNode v a)
forall v a. BinLeafTree v a -> Tree (TreeNode v a)
toRoseTree

--------------------------------------------------------------------------------
-- * Internal Node Tree

-- | Binary tree in which we store the values of type a in internal nodes.
data BinaryTree a = Nil
                  | Internal (BinaryTree a) !a (BinaryTree a)
                  deriving (Int -> BinaryTree a -> ShowS
[BinaryTree a] -> ShowS
BinaryTree a -> String
(Int -> BinaryTree a -> ShowS)
-> (BinaryTree a -> String)
-> ([BinaryTree a] -> ShowS)
-> Show (BinaryTree a)
forall a. Show a => Int -> BinaryTree a -> ShowS
forall a. Show a => [BinaryTree a] -> ShowS
forall a. Show a => BinaryTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryTree a] -> ShowS
$cshowList :: forall a. Show a => [BinaryTree a] -> ShowS
show :: BinaryTree a -> String
$cshow :: forall a. Show a => BinaryTree a -> String
showsPrec :: Int -> BinaryTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BinaryTree a -> ShowS
Show,ReadPrec [BinaryTree a]
ReadPrec (BinaryTree a)
Int -> ReadS (BinaryTree a)
ReadS [BinaryTree a]
(Int -> ReadS (BinaryTree a))
-> ReadS [BinaryTree a]
-> ReadPrec (BinaryTree a)
-> ReadPrec [BinaryTree a]
-> Read (BinaryTree a)
forall a. Read a => ReadPrec [BinaryTree a]
forall a. Read a => ReadPrec (BinaryTree a)
forall a. Read a => Int -> ReadS (BinaryTree a)
forall a. Read a => ReadS [BinaryTree a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinaryTree a]
$creadListPrec :: forall a. Read a => ReadPrec [BinaryTree a]
readPrec :: ReadPrec (BinaryTree a)
$creadPrec :: forall a. Read a => ReadPrec (BinaryTree a)
readList :: ReadS [BinaryTree a]
$creadList :: forall a. Read a => ReadS [BinaryTree a]
readsPrec :: Int -> ReadS (BinaryTree a)
$creadsPrec :: forall a. Read a => Int -> ReadS (BinaryTree a)
Read,BinaryTree a -> BinaryTree a -> Bool
(BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool) -> Eq (BinaryTree a)
forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryTree a -> BinaryTree a -> Bool
$c/= :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
== :: BinaryTree a -> BinaryTree a -> Bool
$c== :: forall a. Eq a => BinaryTree a -> BinaryTree a -> Bool
Eq,Eq (BinaryTree a)
Eq (BinaryTree a)
-> (BinaryTree a -> BinaryTree a -> Ordering)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> Bool)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> (BinaryTree a -> BinaryTree a -> BinaryTree a)
-> Ord (BinaryTree a)
BinaryTree a -> BinaryTree a -> Bool
BinaryTree a -> BinaryTree a -> Ordering
BinaryTree a -> BinaryTree a -> BinaryTree a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (BinaryTree a)
forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
min :: BinaryTree a -> BinaryTree a -> BinaryTree a
$cmin :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
max :: BinaryTree a -> BinaryTree a -> BinaryTree a
$cmax :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
>= :: BinaryTree a -> BinaryTree a -> Bool
$c>= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
> :: BinaryTree a -> BinaryTree a -> Bool
$c> :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
<= :: BinaryTree a -> BinaryTree a -> Bool
$c<= :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
< :: BinaryTree a -> BinaryTree a -> Bool
$c< :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Bool
compare :: BinaryTree a -> BinaryTree a -> Ordering
$ccompare :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (BinaryTree a)
Ord,a -> BinaryTree b -> BinaryTree a
(a -> b) -> BinaryTree a -> BinaryTree b
(forall a b. (a -> b) -> BinaryTree a -> BinaryTree b)
-> (forall a b. a -> BinaryTree b -> BinaryTree a)
-> Functor BinaryTree
forall a b. a -> BinaryTree b -> BinaryTree a
forall a b. (a -> b) -> BinaryTree a -> BinaryTree b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BinaryTree b -> BinaryTree a
$c<$ :: forall a b. a -> BinaryTree b -> BinaryTree a
fmap :: (a -> b) -> BinaryTree a -> BinaryTree b
$cfmap :: forall a b. (a -> b) -> BinaryTree a -> BinaryTree b
Functor,BinaryTree a -> Bool
(a -> m) -> BinaryTree a -> m
(a -> b -> b) -> b -> BinaryTree a -> b
(forall m. Monoid m => BinaryTree m -> m)
-> (forall m a. Monoid m => (a -> m) -> BinaryTree a -> m)
-> (forall m a. Monoid m => (a -> m) -> BinaryTree a -> m)
-> (forall a b. (a -> b -> b) -> b -> BinaryTree a -> b)
-> (forall a b. (a -> b -> b) -> b -> BinaryTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinaryTree a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinaryTree a -> b)
-> (forall a. (a -> a -> a) -> BinaryTree a -> a)
-> (forall a. (a -> a -> a) -> BinaryTree a -> a)
-> (forall a. BinaryTree a -> [a])
-> (forall a. BinaryTree a -> Bool)
-> (forall a. BinaryTree a -> Int)
-> (forall a. Eq a => a -> BinaryTree a -> Bool)
-> (forall a. Ord a => BinaryTree a -> a)
-> (forall a. Ord a => BinaryTree a -> a)
-> (forall a. Num a => BinaryTree a -> a)
-> (forall a. Num a => BinaryTree a -> a)
-> Foldable BinaryTree
forall a. Eq a => a -> BinaryTree a -> Bool
forall a. Num a => BinaryTree a -> a
forall a. Ord a => BinaryTree a -> a
forall m. Monoid m => BinaryTree m -> m
forall a. BinaryTree a -> Bool
forall a. BinaryTree a -> Int
forall a. BinaryTree a -> [a]
forall a. (a -> a -> a) -> BinaryTree a -> a
forall m a. Monoid m => (a -> m) -> BinaryTree a -> m
forall b a. (b -> a -> b) -> b -> BinaryTree a -> b
forall a b. (a -> b -> b) -> b -> BinaryTree a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: BinaryTree a -> a
$cproduct :: forall a. Num a => BinaryTree a -> a
sum :: BinaryTree a -> a
$csum :: forall a. Num a => BinaryTree a -> a
minimum :: BinaryTree a -> a
$cminimum :: forall a. Ord a => BinaryTree a -> a
maximum :: BinaryTree a -> a
$cmaximum :: forall a. Ord a => BinaryTree a -> a
elem :: a -> BinaryTree a -> Bool
$celem :: forall a. Eq a => a -> BinaryTree a -> Bool
length :: BinaryTree a -> Int
$clength :: forall a. BinaryTree a -> Int
null :: BinaryTree a -> Bool
$cnull :: forall a. BinaryTree a -> Bool
toList :: BinaryTree a -> [a]
$ctoList :: forall a. BinaryTree a -> [a]
foldl1 :: (a -> a -> a) -> BinaryTree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> BinaryTree a -> a
foldr1 :: (a -> a -> a) -> BinaryTree a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> BinaryTree a -> a
foldl' :: (b -> a -> b) -> b -> BinaryTree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> BinaryTree a -> b
foldl :: (b -> a -> b) -> b -> BinaryTree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> BinaryTree a -> b
foldr' :: (a -> b -> b) -> b -> BinaryTree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> BinaryTree a -> b
foldr :: (a -> b -> b) -> b -> BinaryTree a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> BinaryTree a -> b
foldMap' :: (a -> m) -> BinaryTree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> BinaryTree a -> m
foldMap :: (a -> m) -> BinaryTree a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> BinaryTree a -> m
fold :: BinaryTree m -> m
$cfold :: forall m. Monoid m => BinaryTree m -> m
Foldable,Functor BinaryTree
Foldable BinaryTree
Functor BinaryTree
-> Foldable BinaryTree
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> BinaryTree a -> f (BinaryTree b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    BinaryTree (f a) -> f (BinaryTree a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> BinaryTree a -> m (BinaryTree b))
-> (forall (m :: * -> *) a.
    Monad m =>
    BinaryTree (m a) -> m (BinaryTree a))
-> Traversable BinaryTree
(a -> f b) -> BinaryTree a -> f (BinaryTree b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
BinaryTree (m a) -> m (BinaryTree a)
forall (f :: * -> *) a.
Applicative f =>
BinaryTree (f a) -> f (BinaryTree a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinaryTree a -> m (BinaryTree b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinaryTree a -> f (BinaryTree b)
sequence :: BinaryTree (m a) -> m (BinaryTree a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
BinaryTree (m a) -> m (BinaryTree a)
mapM :: (a -> m b) -> BinaryTree a -> m (BinaryTree b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinaryTree a -> m (BinaryTree b)
sequenceA :: BinaryTree (f a) -> f (BinaryTree a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
BinaryTree (f a) -> f (BinaryTree a)
traverse :: (a -> f b) -> BinaryTree a -> f (BinaryTree b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinaryTree a -> f (BinaryTree b)
$cp2Traversable :: Foldable BinaryTree
$cp1Traversable :: Functor BinaryTree
Traversable,(forall x. BinaryTree a -> Rep (BinaryTree a) x)
-> (forall x. Rep (BinaryTree a) x -> BinaryTree a)
-> Generic (BinaryTree a)
forall x. Rep (BinaryTree a) x -> BinaryTree a
forall x. BinaryTree a -> Rep (BinaryTree a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BinaryTree a) x -> BinaryTree a
forall a x. BinaryTree a -> Rep (BinaryTree a) x
$cto :: forall a x. Rep (BinaryTree a) x -> BinaryTree a
$cfrom :: forall a x. BinaryTree a -> Rep (BinaryTree a) x
Generic)
instance NFData a => NFData (BinaryTree a)

instance Arbitrary a => Arbitrary (BinaryTree a) where
  arbitrary :: Gen (BinaryTree a)
arbitrary = (Int -> Gen (BinaryTree a)) -> Gen (BinaryTree a)
forall a. (Int -> Gen a) -> Gen a
sized Int -> Gen (BinaryTree a)
forall a a.
(Ord a, Num a, Random a, Arbitrary a) =>
a -> Gen (BinaryTree a)
f
    where f :: a -> Gen (BinaryTree a)
f a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0    = BinaryTree a -> Gen (BinaryTree a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BinaryTree a
forall a. BinaryTree a
Nil
              | Bool
otherwise = do
                              a
l <- (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
choose (a
0,a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1)
                              BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal (BinaryTree a -> a -> BinaryTree a -> BinaryTree a)
-> Gen (BinaryTree a) -> Gen (a -> BinaryTree a -> BinaryTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Gen (BinaryTree a)
f a
l Gen (a -> BinaryTree a -> BinaryTree a)
-> Gen a -> Gen (BinaryTree a -> BinaryTree a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
forall a. Arbitrary a => Gen a
arbitrary Gen (BinaryTree a -> BinaryTree a)
-> Gen (BinaryTree a) -> Gen (BinaryTree a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Gen (BinaryTree a)
f (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
la -> a -> a
forall a. Num a => a -> a -> a
-a
1)

-- | Get the element stored at the root, if it exists
access                  :: BinaryTree a -> Maybe a
access :: BinaryTree a -> Maybe a
access BinaryTree a
Nil              = Maybe a
forall a. Maybe a
Nothing
access (Internal BinaryTree a
_ a
x BinaryTree a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

-- | Create a balanced binary tree.
--
-- running time: \(O(n)\)
asBalancedBinTree :: [a] -> BinaryTree a
asBalancedBinTree :: [a] -> BinaryTree a
asBalancedBinTree = Vector a -> BinaryTree a
forall a. Vector a -> BinaryTree a
mkTree (Vector a -> BinaryTree a)
-> ([a] -> Vector a) -> [a] -> BinaryTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Vector a
forall a. [a] -> Vector a
V.fromList
  where
    mkTree :: Vector a -> BinaryTree a
mkTree Vector a
v = let n :: Int
n = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
v
                   h :: Int
h = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
                   x :: a
x = Vector a
v Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! Int
h
               in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then BinaryTree a
forall a. BinaryTree a
Nil
                            else BinaryTree a -> a -> BinaryTree a -> BinaryTree a
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal (Vector a -> BinaryTree a
mkTree (Vector a -> BinaryTree a) -> Vector a -> BinaryTree a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice Int
0 Int
h Vector a
v) a
x
                                          (Vector a -> BinaryTree a
mkTree (Vector a -> BinaryTree a) -> Vector a -> BinaryTree a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector a -> Vector a
forall a. Int -> Int -> Vector a -> Vector a
V.slice (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Vector a
v)

-- | Fold function for folding over a binary tree.
foldBinaryUp                      :: b -> (a -> b -> b -> b)
                                  -> BinaryTree a -> BinaryTree (a,b)
foldBinaryUp :: b -> (a -> b -> b -> b) -> BinaryTree a -> BinaryTree (a, b)
foldBinaryUp b
_ a -> b -> b -> b
_ BinaryTree a
Nil              = BinaryTree (a, b)
forall a. BinaryTree a
Nil
foldBinaryUp b
e a -> b -> b -> b
f (Internal BinaryTree a
l a
x BinaryTree a
r) = let l' :: BinaryTree (a, b)
l' = b -> (a -> b -> b -> b) -> BinaryTree a -> BinaryTree (a, b)
forall b a.
b -> (a -> b -> b -> b) -> BinaryTree a -> BinaryTree (a, b)
foldBinaryUp b
e a -> b -> b -> b
f BinaryTree a
l
                                        r' :: BinaryTree (a, b)
r' = b -> (a -> b -> b -> b) -> BinaryTree a -> BinaryTree (a, b)
forall b a.
b -> (a -> b -> b -> b) -> BinaryTree a -> BinaryTree (a, b)
foldBinaryUp b
e a -> b -> b -> b
f BinaryTree a
r
                                        g :: BinaryTree (a, b) -> b
g  = b -> ((a, b) -> b) -> Maybe (a, b) -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
e (a, b) -> b
forall a b. (a, b) -> b
snd (Maybe (a, b) -> b)
-> (BinaryTree (a, b) -> Maybe (a, b)) -> BinaryTree (a, b) -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryTree (a, b) -> Maybe (a, b)
forall a. BinaryTree a -> Maybe a
access
                                        b :: b
b  = a -> b -> b -> b
f a
x (BinaryTree (a, b) -> b
g BinaryTree (a, b)
l') (BinaryTree (a, b) -> b
g BinaryTree (a, b)
r')
                                    in BinaryTree (a, b)
-> (a, b) -> BinaryTree (a, b) -> BinaryTree (a, b)
forall a. BinaryTree a -> a -> BinaryTree a -> BinaryTree a
Internal BinaryTree (a, b)
l' (a
x,b
b) BinaryTree (a, b)
r'

-- | Convert a @BinaryTree@ into a RoseTree
toRoseTree'                  :: BinaryTree a -> Maybe (Tree.Tree a)
toRoseTree' :: BinaryTree a -> Maybe (Tree a)
toRoseTree' BinaryTree a
Nil              = Maybe (Tree a)
forall a. Maybe a
Nothing
toRoseTree' (Internal BinaryTree a
l a
v BinaryTree a
r) = Tree a -> Maybe (Tree a)
forall a. a -> Maybe a
Just (Tree a -> Maybe (Tree a)) -> Tree a -> Maybe (Tree a)
forall a b. (a -> b) -> a -> b
$ a -> Forest a -> Tree a
forall a. a -> Forest a -> Tree a
Tree.Node a
v (Forest a -> Tree a) -> Forest a -> Tree a
forall a b. (a -> b) -> a -> b
$ (BinaryTree a -> Maybe (Tree a)) -> [BinaryTree a] -> Forest a
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe BinaryTree a -> Maybe (Tree a)
forall a. BinaryTree a -> Maybe (Tree a)
toRoseTree' [BinaryTree a
l,BinaryTree a
r]

-- | Draw a binary tree.
drawTree' :: Show a => BinaryTree a -> String
drawTree' :: BinaryTree a -> String
drawTree' = String -> (Tree a -> String) -> Maybe (Tree a) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"Nil" (Tree String -> String
Tree.drawTree (Tree String -> String)
-> (Tree a -> Tree String) -> Tree a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String) -> Tree a -> Tree String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> String
forall a. Show a => a -> String
show) (Maybe (Tree a) -> String)
-> (BinaryTree a -> Maybe (Tree a)) -> BinaryTree a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryTree a -> Maybe (Tree a)
forall a. BinaryTree a -> Maybe (Tree a)
toRoseTree'