--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Tree.Binary.Static
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Several types of Binary trees.
--
--------------------------------------------------------------------------------
module HGeometry.Tree.Binary.Static
  ( BinLeafTree(..)
  , node
  , asBalancedBinLeafTree
  , foldUp, foldUpData

  , zipExactWith
  , toRoseTree
  , drawTree

  , BinaryTree(..)
  , asBalancedBinTree
  , access
  , foldBinaryUp
  , toRoseTree'
  , drawTree'
  ) where

import           Control.DeepSeq
import           Data.Bifunctor.Apply
import qualified Data.Functor.Apply as Apply
import           Data.Maybe (mapMaybe)
import           Data.Semigroup.Foldable
import           Data.Semigroup.Traversable
import qualified Data.Tree as Tree
import qualified Data.Vector as V
import           GHC.Generics (Generic)
import           HGeometry.Algorithms.DivideAndConquer
import           HGeometry.Foldable.Util
import           HGeometry.Measured.Class
import           HGeometry.Measured.Size
import           HGeometry.Tree.Util (TreeNode(..))

--------------------------------------------------------------------------------

-- | 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
$cshowsPrec :: forall v a. (Show a, Show v) => Int -> BinLeafTree v a -> ShowS
showsPrec :: Int -> BinLeafTree v a -> ShowS
$cshow :: forall v a. (Show a, Show v) => BinLeafTree v a -> String
show :: BinLeafTree v a -> String
$cshowList :: forall v a. (Show a, Show v) => [BinLeafTree v a] -> ShowS
showList :: [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]
$creadsPrec :: forall v a. (Read a, Read v) => Int -> ReadS (BinLeafTree v a)
readsPrec :: Int -> ReadS (BinLeafTree v a)
$creadList :: forall v a. (Read a, Read v) => ReadS [BinLeafTree v a]
readList :: ReadS [BinLeafTree v a]
$creadPrec :: forall v a. (Read a, Read v) => ReadPrec (BinLeafTree v a)
readPrec :: ReadPrec (BinLeafTree v a)
$creadListPrec :: forall v a. (Read a, Read v) => ReadPrec [BinLeafTree v a]
readListPrec :: ReadPrec [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
$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
/= :: 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
$ccompare :: forall v a.
(Ord a, Ord v) =>
BinLeafTree v a -> BinLeafTree v a -> Ordering
compare :: BinLeafTree v a -> BinLeafTree v a -> Ordering
$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
>= :: BinLeafTree v a -> BinLeafTree v a -> Bool
$cmax :: 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
$cmin :: 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
Ord,(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
$cfrom :: forall v a x. BinLeafTree v a -> Rep (BinLeafTree v a) x
from :: forall x. BinLeafTree v a -> Rep (BinLeafTree v a) x
$cto :: forall v a x. Rep (BinLeafTree v a) x -> BinLeafTree v a
to :: forall x. Rep (BinLeafTree v a) x -> BinLeafTree v a
Generic,(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
$cfmap :: forall v a b. (a -> b) -> BinLeafTree v a -> BinLeafTree v b
fmap :: forall a b. (a -> b) -> BinLeafTree v a -> BinLeafTree v b
$c<$ :: forall v a b. a -> BinLeafTree v b -> BinLeafTree v a
<$ :: forall a b. a -> BinLeafTree v b -> BinLeafTree v a
Functor,(forall m. Monoid m => BinLeafTree v m -> m)
-> (forall m a. Monoid m => (a -> m) -> BinLeafTree v a -> m)
-> (forall m a. Monoid m => (a -> m) -> BinLeafTree v a -> m)
-> (forall a b. (a -> b -> b) -> b -> BinLeafTree v a -> b)
-> (forall a b. (a -> b -> b) -> b -> BinLeafTree v a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinLeafTree v a -> b)
-> (forall b a. (b -> a -> b) -> b -> BinLeafTree v a -> b)
-> (forall a. (a -> a -> a) -> BinLeafTree v a -> a)
-> (forall a. (a -> a -> a) -> BinLeafTree v a -> a)
-> (forall a. BinLeafTree v a -> [a])
-> (forall a. BinLeafTree v a -> Bool)
-> (forall a. BinLeafTree v a -> Int)
-> (forall a. Eq a => a -> BinLeafTree v a -> Bool)
-> (forall a. Ord a => BinLeafTree v a -> a)
-> (forall a. Ord a => BinLeafTree v a -> a)
-> (forall a. Num a => BinLeafTree v a -> a)
-> (forall a. Num a => BinLeafTree v a -> a)
-> Foldable (BinLeafTree v)
forall a. Eq a => a -> BinLeafTree v a -> Bool
forall a. Num a => BinLeafTree v a -> a
forall a. Ord a => BinLeafTree v a -> a
forall m. Monoid m => BinLeafTree v m -> m
forall a. BinLeafTree v a -> Bool
forall a. BinLeafTree v a -> Int
forall a. BinLeafTree v a -> [a]
forall a. (a -> a -> a) -> BinLeafTree v a -> a
forall v a. Eq a => a -> BinLeafTree v a -> Bool
forall v a. Num a => BinLeafTree v a -> a
forall v a. Ord a => BinLeafTree v a -> a
forall v m. Monoid m => BinLeafTree v m -> m
forall m a. Monoid m => (a -> m) -> BinLeafTree v a -> m
forall v a. BinLeafTree v a -> Bool
forall v a. BinLeafTree v a -> Int
forall v a. BinLeafTree v a -> [a]
forall b a. (b -> a -> b) -> b -> BinLeafTree v a -> b
forall a b. (a -> b -> b) -> b -> BinLeafTree v a -> b
forall v a. (a -> a -> a) -> BinLeafTree v a -> a
forall v m a. Monoid m => (a -> m) -> BinLeafTree v a -> m
forall v b a. (b -> a -> b) -> b -> BinLeafTree v a -> b
forall v a b. (a -> b -> b) -> b -> BinLeafTree v 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
$cfold :: forall v m. Monoid m => BinLeafTree v m -> m
fold :: forall m. Monoid m => BinLeafTree v m -> m
$cfoldMap :: forall v m a. Monoid m => (a -> m) -> BinLeafTree v a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> BinLeafTree v a -> m
$cfoldMap' :: forall v m a. Monoid m => (a -> m) -> BinLeafTree v a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> BinLeafTree v a -> m
$cfoldr :: forall v a b. (a -> b -> b) -> b -> BinLeafTree v a -> b
foldr :: forall a b. (a -> b -> b) -> b -> BinLeafTree v a -> b
$cfoldr' :: forall v a b. (a -> b -> b) -> b -> BinLeafTree v a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> BinLeafTree v a -> b
$cfoldl :: forall v b a. (b -> a -> b) -> b -> BinLeafTree v a -> b
foldl :: forall b a. (b -> a -> b) -> b -> BinLeafTree v a -> b
$cfoldl' :: forall v b a. (b -> a -> b) -> b -> BinLeafTree v a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> BinLeafTree v a -> b
$cfoldr1 :: forall v a. (a -> a -> a) -> BinLeafTree v a -> a
foldr1 :: forall a. (a -> a -> a) -> BinLeafTree v a -> a
$cfoldl1 :: forall v a. (a -> a -> a) -> BinLeafTree v a -> a
foldl1 :: forall a. (a -> a -> a) -> BinLeafTree v a -> a
$ctoList :: forall v a. BinLeafTree v a -> [a]
toList :: forall a. BinLeafTree v a -> [a]
$cnull :: forall v a. BinLeafTree v a -> Bool
null :: forall a. BinLeafTree v a -> Bool
$clength :: forall v a. BinLeafTree v a -> Int
length :: forall a. BinLeafTree v a -> Int
$celem :: forall v a. Eq a => a -> BinLeafTree v a -> Bool
elem :: forall a. Eq a => a -> BinLeafTree v a -> Bool
$cmaximum :: forall v a. Ord a => BinLeafTree v a -> a
maximum :: forall a. Ord a => BinLeafTree v a -> a
$cminimum :: forall v a. Ord a => BinLeafTree v a -> a
minimum :: forall a. Ord a => BinLeafTree v a -> a
$csum :: forall v a. Num a => BinLeafTree v a -> a
sum :: forall a. Num a => BinLeafTree v a -> a
$cproduct :: forall v a. Num a => BinLeafTree v a -> a
product :: forall a. Num a => BinLeafTree v a -> a
Foldable,Functor (BinLeafTree v)
Foldable (BinLeafTree v)
(Functor (BinLeafTree v), Foldable (BinLeafTree v)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    BinLeafTree v (f a) -> f (BinLeafTree v a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> BinLeafTree v a -> m (BinLeafTree v b))
-> (forall (m :: * -> *) a.
    Monad m =>
    BinLeafTree v (m a) -> m (BinLeafTree v a))
-> Traversable (BinLeafTree v)
forall v. Functor (BinLeafTree v)
forall v. Foldable (BinLeafTree v)
forall v (m :: * -> *) a.
Monad m =>
BinLeafTree v (m a) -> m (BinLeafTree v a)
forall v (f :: * -> *) a.
Applicative f =>
BinLeafTree v (f a) -> f (BinLeafTree v a)
forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinLeafTree v a -> m (BinLeafTree v b)
forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinLeafTree v a -> f (BinLeafTree v 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 =>
BinLeafTree v (m a) -> m (BinLeafTree v a)
forall (f :: * -> *) a.
Applicative f =>
BinLeafTree v (f a) -> f (BinLeafTree v a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinLeafTree v a -> m (BinLeafTree v b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b)
$ctraverse :: forall v (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b)
$csequenceA :: forall v (f :: * -> *) a.
Applicative f =>
BinLeafTree v (f a) -> f (BinLeafTree v a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
BinLeafTree v (f a) -> f (BinLeafTree v a)
$cmapM :: forall v (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinLeafTree v a -> m (BinLeafTree v b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinLeafTree v a -> m (BinLeafTree v b)
$csequence :: forall v (m :: * -> *) a.
Monad m =>
BinLeafTree v (m a) -> m (BinLeafTree v a)
sequence :: forall (m :: * -> *) a.
Monad m =>
BinLeafTree v (m a) -> m (BinLeafTree v a)
Traversable)

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

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


instance Bifunctor BinLeafTree where
  bimap :: forall a b c d.
(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 a b c d.
(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 a b c d.
(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)

-- | Get the measure of a subtree
getMeasure :: Measured f a => BinLeafTree (f a) a -> f a
getMeasure :: forall (f :: * -> *) a. Measured f a => BinLeafTree (f a) a -> f a
getMeasure = \case
  Leaf a
x     -> a -> f a
forall (f :: * -> *) a. Measured f a => a -> f a
measure a
x
  Node BinLeafTree (f a) a
_ f a
v BinLeafTree (f a) a
_ -> f a
v

instance Foldable1 (BinLeafTree v) where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> BinLeafTree v a -> m
foldMap1 a -> m
f = \case
    Leaf a
x     -> a -> m
f a
x
    Node BinLeafTree v a
l v
_ BinLeafTree v a
r -> (a -> m) -> BinLeafTree v a -> m
forall m a. Semigroup m => (a -> m) -> BinLeafTree v a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f BinLeafTree v a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> BinLeafTree v a -> m
forall m a. Semigroup m => (a -> m) -> BinLeafTree v a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f BinLeafTree v a
r

instance Traversable1 (BinLeafTree v) where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> BinLeafTree v a -> f (BinLeafTree v b)
traverse1 a -> f b
f = BinLeafTree v a -> f (BinLeafTree v b)
go
    where
      go :: BinLeafTree v a -> f (BinLeafTree v b)
go = \case
        Leaf a
x     -> 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
x
        Node BinLeafTree v a
l v
v BinLeafTree v a
r -> (\BinLeafTree v b
l' BinLeafTree v b
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
l' v
v BinLeafTree v b
r') (BinLeafTree v b -> BinLeafTree v b -> BinLeafTree v b)
-> f (BinLeafTree v b) -> f (BinLeafTree v b -> BinLeafTree v b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinLeafTree v a -> f (BinLeafTree v b)
go BinLeafTree v a
l f (BinLeafTree v b -> BinLeafTree v b)
-> f (BinLeafTree v b) -> f (BinLeafTree v b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
Apply.<.> BinLeafTree v a -> f (BinLeafTree v b)
go BinLeafTree v a
r

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

-- | Create a balanced tree, i.e. a tree of height \(O(\log n)\) with the
-- elements in the leaves.
--
-- \(O(n)\) time.
asBalancedBinLeafTree :: Foldable1 f => f a -> BinLeafTree (Count a) a
asBalancedBinLeafTree :: forall (f :: * -> *) a.
Foldable1 f =>
f a -> BinLeafTree (Count a) a
asBalancedBinLeafTree = (a -> BinLeafTree (Count a) a) -> f a -> BinLeafTree (Count a) a
forall (f :: * -> *) s a.
(Foldable1 f, Semigroup s) =>
(a -> s) -> f a -> s
divideAndConquer1 a -> BinLeafTree (Count a) a
forall v a. a -> BinLeafTree v a
Leaf
-- -- 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 :: forall b v a.
(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 :: forall w v a.
(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 :: 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
_ 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 :: forall v a. BinLeafTree v a -> Tree (TreeNode v a)
toRoseTree (Leaf a
x)     = TreeNode v a -> [Tree (TreeNode v a)] -> Tree (TreeNode v a)
forall a. a -> [Tree 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 -> [Tree (TreeNode v a)] -> Tree (TreeNode v a)
forall a. a -> [Tree 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] -> [Tree (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 :: forall v a. (Show v, Show a) => 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 a b. (a -> b) -> Tree a -> Tree b
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
$cshowsPrec :: forall a. Show a => Int -> BinaryTree a -> ShowS
showsPrec :: Int -> BinaryTree a -> ShowS
$cshow :: forall a. Show a => BinaryTree a -> String
show :: BinaryTree a -> String
$cshowList :: forall a. Show a => [BinaryTree a] -> ShowS
showList :: [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
$creadsPrec :: forall a. Read a => Int -> ReadS (BinaryTree a)
readsPrec :: Int -> ReadS (BinaryTree a)
$creadList :: forall a. Read a => ReadS [BinaryTree a]
readList :: ReadS [BinaryTree a]
$creadPrec :: forall a. Read a => ReadPrec (BinaryTree a)
readPrec :: ReadPrec (BinaryTree a)
$creadListPrec :: forall a. Read a => ReadPrec [BinaryTree a]
readListPrec :: ReadPrec [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
$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
/= :: 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
$ccompare :: forall a. Ord a => BinaryTree a -> BinaryTree a -> Ordering
compare :: BinaryTree a -> BinaryTree a -> Ordering
$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
>= :: BinaryTree a -> BinaryTree a -> Bool
$cmax :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
max :: BinaryTree a -> BinaryTree a -> BinaryTree a
$cmin :: forall a. Ord a => BinaryTree a -> BinaryTree a -> BinaryTree a
min :: BinaryTree a -> BinaryTree a -> BinaryTree a
Ord,(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
$cfmap :: forall a b. (a -> b) -> BinaryTree a -> BinaryTree b
fmap :: forall a b. (a -> b) -> BinaryTree a -> BinaryTree b
$c<$ :: forall a b. a -> BinaryTree b -> BinaryTree a
<$ :: forall a b. a -> BinaryTree b -> BinaryTree a
Functor,(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
$cfold :: forall m. Monoid m => BinaryTree m -> m
fold :: forall m. Monoid m => BinaryTree m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> BinaryTree a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> BinaryTree a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> BinaryTree a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> BinaryTree a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> BinaryTree a -> b
foldr :: forall a b. (a -> b -> b) -> b -> BinaryTree a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> BinaryTree a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> BinaryTree a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> BinaryTree a -> b
foldl :: forall b a. (b -> a -> b) -> b -> BinaryTree a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> BinaryTree a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> BinaryTree a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> BinaryTree a -> a
foldr1 :: forall a. (a -> a -> a) -> BinaryTree a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> BinaryTree a -> a
foldl1 :: forall a. (a -> a -> a) -> BinaryTree a -> a
$ctoList :: forall a. BinaryTree a -> [a]
toList :: forall a. BinaryTree a -> [a]
$cnull :: forall a. BinaryTree a -> Bool
null :: forall a. BinaryTree a -> Bool
$clength :: forall a. BinaryTree a -> Int
length :: forall a. BinaryTree a -> Int
$celem :: forall a. Eq a => a -> BinaryTree a -> Bool
elem :: forall a. Eq a => a -> BinaryTree a -> Bool
$cmaximum :: forall a. Ord a => BinaryTree a -> a
maximum :: forall a. Ord a => BinaryTree a -> a
$cminimum :: forall a. Ord a => BinaryTree a -> a
minimum :: forall a. Ord a => BinaryTree a -> a
$csum :: forall a. Num a => BinaryTree a -> a
sum :: forall a. Num a => BinaryTree a -> a
$cproduct :: forall a. Num a => BinaryTree a -> a
product :: forall a. Num a => BinaryTree a -> a
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
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)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinaryTree a -> f (BinaryTree b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BinaryTree a -> f (BinaryTree b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
BinaryTree (f a) -> f (BinaryTree a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
BinaryTree (f a) -> f (BinaryTree a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinaryTree a -> m (BinaryTree b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> BinaryTree a -> m (BinaryTree b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
BinaryTree (m a) -> m (BinaryTree a)
sequence :: forall (m :: * -> *) a.
Monad m =>
BinaryTree (m a) -> m (BinaryTree a)
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
$cfrom :: forall a x. BinaryTree a -> Rep (BinaryTree a) x
from :: forall x. BinaryTree a -> Rep (BinaryTree a) x
$cto :: forall a x. Rep (BinaryTree a) x -> BinaryTree a
to :: forall x. Rep (BinaryTree a) x -> BinaryTree a
Generic)
instance NFData a => NFData (BinaryTree a)


-- | Get the element stored at the root, if it exists
access                  :: BinaryTree a -> Maybe a
access :: forall a. 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 :: forall f a. Foldable f => f a -> BinaryTree a
asBalancedBinTree :: forall (f :: * -> *) a. Foldable f => f a -> BinaryTree a
asBalancedBinTree = Vector a -> BinaryTree a
forall {a}. Vector a -> BinaryTree a
mkTree (Vector a -> BinaryTree a)
-> (f a -> Vector a) -> f a -> BinaryTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) (g :: * -> *) a.
(HasFromFoldable f, Foldable g) =>
g a -> f a
fromFoldable @V.Vector
  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 :: forall b a.
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' :: forall a. 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 -> [Tree a] -> Tree a
forall a. a -> [Tree a] -> Tree a
Tree.Node a
v ([Tree a] -> Tree a) -> [Tree a] -> Tree a
forall a b. (a -> b) -> a -> b
$ (BinaryTree a -> Maybe (Tree a)) -> [BinaryTree a] -> [Tree 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' :: forall a. Show a => 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 a b. (a -> b) -> Tree a -> Tree b
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'