{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE ScopedTypeVariables #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.BTree
-- Copyright   :  (c) Highlander Paiva 2022
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  hvpaiva@icloud.com
-- Stability   :  experimental
-- Portability :  portable
--
-- The BTree type, and associated operations.
--
-- This module allows you to use a
-- BTree to store a set of values, and to efficiently lookup values in the set.
-- The BTree is a balanced tree, which means that the tree is more efficient
-- than a conventional binary tree.
--
-- Most of BTree operations are performed in O(log n) time.
--
-----------------------------------------------------------------------------

module Data.BTree (
             -- * BTree type
               BTree

             -- * Constructors
             , empty
             , singleton
             , fromList

             -- * Operations
             , insert
             , delete
             , search
             , height
             , levels

             -- * Traversals to list
             , preorder
             , inorder
             , postorder

             -- * Drawing
             , draw
) where

import           Control.Applicative ()
import           Data.Foldable       (find)
import           Data.Function       (on)
import qualified Data.List           as L
import           Data.Maybe          ()
import           Data.Monoid         ()
import           Data.Traversable    ()

-- $setup
-- Allow the use of some BTree functions in doctests.
-- >>> import Data.BTree

{-
-- just for testing
import Test.QuickCheck
-}

{-|

The 'BTree' type represents a tree using the b-tree algorithm.

A @'BTree' a@ is a self-balancing tree as its nodes are /traversed in-order/. The
node is a set of elements pointing to its children, and a leaf has no children and nothing in itself.

This implementation uses a order 3 'BTree', this means:

    * /{one, two}/ elements per node and /{two, three}/ subtrees.

    * A leaf contains nothing.

    * Every leaf is equidistant from the root.

    * Subtrees must have the same height.

    * Data are ordered left to right.

@

             4              <-- (3) root
         \/      \\
        2       6           <-- (2) internal nodes
       \/ \\     / \\
      1   3   5   7         <-- (1) internal nodes
     \/ \\ \/ \\ \/ \\ \/ \\
    .  ..  ..  ..   .       <-- (0) leafs
@


The complexity of the operations:

+------------+---------------+---------------+
| Algorithm  |  Medium Case  |   Worst Case  |
+============+===============+===============+
| Search     | O(log n)      | O(log n)      |
+------------+---------------+---------------+
| Insert     | O(log n)      | O(log n)      |
+------------+---------------+---------------+
| Delete     | O(log n)      | O(log n)      |
+------------+---------------+---------------+

==== __Examples __

A @'BTree' 'Int'@ may be represented as:

>>> let t = fromList [1,2,3,4,5,6,7]
>>> t
"(((. 1 .) 2 (. 3 .)) 4 ((. 5 .) 6 (. 7 .)))"

>>> let n = insert 8 t
>>> n
"(((. 1 .) 2 (. 3 .)) 4 ((. 5 .) 6 (. 7 . 8 .)))"

@since 1.0.0
-}
data BTree a where
  BTree :: Tree n a -> BTree a

-- | A Natural Number datatype.
--   It represents either a __Zero__ or the __Successor__ of another natural number.
--
--   @since 1.0.0
data Natural
  = Z
  | Succ Natural

-- | A 'BTree' Node.
--   The node can have either /two or tree branches/, having /one or two elements/ on it, respectively.
--   The @n@ represents the height of the Node and the @a@ the actual element.
--
--   @since 1.0.0
data Node n a
  = Subtree (Tree n a) a (Tree n a)
  | Subtree' (Tree n a) a (Tree n a) a (Tree n a)

-- | A 'BTree'. This is an internal implementation, clients will use @'BTree' a@ instead.
--
--   It can have a Leaf or a Branch.
--   A leaf is a 'BTree' with Zero in height and no elements.
--   A branch is a representation of a Node to another 'BTree' with a successor height.
--   The @n@ represents the height of the 'BTree' and the @a@ the actual elements on it.
--
--   @since 1.0.0
data Tree n a where
  Branch :: Node n a -> Tree ('Succ n) a
  Leaf :: Tree 'Z a

-- | The insertion Keep type.
--   It represents the insertion of an element into a 'BTree'.
--   The insertion can be done in two ways:
--   * Keep: The node keeps the element in itself.
--   * Push: Overflow occurs and the element is pushed to the parent.
--
--   Note: This is a function that gets a internal 'BTree' and converts to its
--   polimorphic representation of Tree.
--
--   The @t@ represents the polimorphic representation of Tree, the @n@ represents the height of the 'BTree'
--   and the @a@ the actual element.
--   This prevents the needs of the internal 'BTree' beeing parsed earlyer than when presented to the client.
--
--   @since 1.0.0
type Keep t n a = Tree n a -> t

-- | The insertion Push type.
--   It represents the insertion of an element into a 'BTree'.
--   The insertion can be done in two ways:
--   * Keep: The node keeps the element in itself.
--   * Push: Overflow occurs and the element is pushed to the parent.
--
--   Note: This is a function that gets a internal 'BTree' and converts to its
--   polimorphic representation of Tree.
--
--   The @t@ represents the polimorphic representation of Tree, the @n@ represents the height of the 'BTree'
--   and the @a@ the actual element.
--   This prevents the needs of the internal 'BTree' beeing parsed earlyer than when presented to the client.
--
--   @since 1.0.0
type Push t n a = Tree n a -> a -> Tree n a -> t

-- | Inserts an element into a 'BTree'.
--
--   Inserts the element into the 'BTree' in inorder fashion.
--
--   +------------+---------------+---------------+
--   | Algorithm  |  Medium Case  |   Worst Case  |
--   +============+===============+===============+
--   | Insert     | O(log n)      | O(log n)      |
--   +------------+---------------+---------------+
--
--   >>> let t = insert 1 empty
--   >>> t
--   "(. 1 .)"
--
--   >>> let n = insert 2 t
--   >>> n
--   "(. 1 . 2 .)"
--
--   @since 1.0.0
insert :: forall a. Ord a => a -> BTree a -> BTree a
insert :: forall a. Ord a => a -> BTree a -> BTree a
insert a
x (BTree Tree n a
tree) = Tree n a -> Keep (BTree a) n a -> Push (BTree a) n a -> BTree a
forall (n :: Natural) t. Tree n a -> Keep t n a -> Push t n a -> t
insert' Tree n a
tree Keep (BTree a) n a
forall (n :: Natural) a. Tree n a -> BTree a
BTree (Push (BTree a) n a -> BTree a) -> Push (BTree a) n a -> BTree a
forall a b. (a -> b) -> a -> b
$ \Tree n a
a a
b Tree n a
c -> Tree ('Succ n) a -> BTree a
forall (n :: Natural) a. Tree n a -> BTree a
BTree (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a a
b Tree n a
c)
    where
      insert' :: forall n t. Tree n a -> Keep t n a -> Push t n a -> t
      insert' :: forall (n :: Natural) t. Tree n a -> Keep t n a -> Push t n a -> t
insert' Tree n a
Leaf = \Keep t n a
_ Push t n a
push -> Push t n a
push Tree n a
forall a. Tree 'Z a
Leaf a
x Tree n a
forall a. Tree 'Z a
Leaf -- insert in a leaf is always a overflow, so it pushes.
      insert' (Branch Node n a
n) = Node n a -> Keep t n a -> Push t n a -> t
forall (p :: Natural) (m :: Natural).
('Succ p ~ m) =>
Node p a -> Keep t m a -> Push t m a -> t
i Node n a
n
        where
          i :: forall p m. ('Succ p ~ m) => Node p a -> Keep t m a -> Push t m a -> t
          i :: forall (p :: Natural) (m :: Natural).
('Succ p ~ m) =>
Node p a -> Keep t m a -> Push t m a -> t
i (Subtree' Tree p a
a a
b Tree p a
c a
d Tree p a
e) Keep t m a
keep Push t m a
push = a -> a -> a -> t -> t -> t -> t -> t -> t
forall a p. Ord a => a -> a -> a -> p -> p -> p -> p -> p -> p
select' a
x a
b a
d t
xltb t
xeqb t
xbtw t
xeqd t
xgtd
            where
              Keep t m a
_ = Keep t m a
keep :: Tree m a -> t
              Push t m a
_ = Push t m a
push :: Tree m a -> a -> Tree m a -> t
              xltb :: t
xltb = Tree p a -> Keep t p a -> Push t p a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Push t n a -> t
insert' Tree p a
a (\Tree p a
k -> Keep t m a
keep (Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
k a
b Tree p a
c a
d Tree p a
e)) (\Tree p a
p a
q Tree p a
r -> Push t m a
push (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
p a
q Tree p a
r) a
b (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
c a
d Tree p a
e))
              xeqb :: t
xeqb = Keep t m a
keep (Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
a a
x Tree p a
c a
d Tree p a
e)
              xbtw :: t
xbtw = Tree p a -> Keep t p a -> Push t p a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Push t n a -> t
insert' Tree p a
c (\Tree p a
k -> Keep t m a
keep (Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
a a
b Tree p a
k a
d Tree p a
e)) (\Tree p a
p a
q Tree p a
r -> Push t m a
push (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
a a
b Tree p a
p) a
q (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
r a
d Tree p a
e))
              xeqd :: t
xeqd = Keep t m a
keep (Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
a a
b Tree p a
c a
x Tree p a
e)
              xgtd :: t
xgtd = Tree p a -> Keep t p a -> Push t p a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Push t n a -> t
insert' Tree p a
e (Keep t m a
keep Keep t m a -> (Tree p a -> Tree m a) -> Keep t p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
a a
b Tree p a
c a
d) (\Tree p a
p a
q Tree p a
r -> Push t m a
push (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
a a
b Tree p a
c) a
d (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
p a
q Tree p a
r))
          i (Subtree Tree p a
a a
b Tree p a
c) Keep t m a
keep Push t m a
_ = a -> a -> t -> t -> t -> t
forall a p. Ord a => a -> a -> p -> p -> p -> p
select a
x a
b t
xltb t
xeqb t
xgtb
            where
              xltb :: t
xltb = Tree p a -> Keep t p a -> Push t p a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Push t n a -> t
insert' Tree p a
a (\Tree p a
k -> Keep t m a
keep (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
k a
b Tree p a
c)) (\Tree p a
p a
q Tree p a
r -> Keep t m a
keep (Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
p a
q Tree p a
r a
b Tree p a
c))
              xgtb :: t
xgtb = Tree p a -> Keep t p a -> Push t p a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Push t n a -> t
insert' Tree p a
c (Keep t m a
keep Keep t m a -> (Tree p a -> Tree m a) -> Keep t p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
a a
b) (\Tree p a
p a
q Tree p a
r -> Keep t m a
keep (Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
a a
b Tree p a
p a
q Tree p a
r))
              xeqb :: t
xeqb = Keep t m a
keep (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
a a
x Tree p a
c)

-- | The deletion Pull type.
--   It represents the action of pull an element to an upper branch when underflow, and merging the nodes
--   if needed.
--
--   Note: This is a function that takes a Shrunk type and converts it to the
--   polimorphic representation of Tree, merging it nodes and pulling up the elements if underflow.
--
--   The @t@ represents the polimorphic representation of Tree, the @n@ represents the height of the 'BTree'
--   and the @a@ the actual element.
--   This prevents the needs of the internal 'BTree' beeing parsed earlyer than when presented to the client.
--
--   @since 1.0.0
type Pull t n a = Shrunk n a -> t

-- | The Shrunk type.
--   Represents the action when two nodes are merged into one. It's a "partial" type,
--   meaning that it's not a full representation of a merged Node, but the argument
--   for the Pull when the Node is fully merged.
--   The @n@ represents the height of the 'BTree' and the @a@ the actual element.
--
--   @since 1.0.0
data Shrunk (n :: Natural) a where
  H :: Tree n a -> Shrunk ('Succ n) a

-- | Delete an element from a 'BTree'.
--
--   +------------+---------------+---------------+
--   | Algorithm  |  Medium Case  |   Worst Case  |
--   +============+===============+===============+
--   | Delete     | O(log n)      | O(log n)      |
--   +------------+---------------+---------------+
--
--   >>> let t = fromList [1,2,3,4,5,6,7]
--   >>> let n = delete 3 t
--   >>> n
--   "((. 1 . 2 .) 4 (. 5 .) 6 (. 7 .))"
--
--   @since 1.0.0
delete :: forall a. Ord a => a -> BTree a -> BTree a
delete :: forall a. Ord a => a -> BTree a -> BTree a
delete a
x (BTree Tree n a
tree) = Tree n a -> Keep (BTree a) n a -> Pull (BTree a) n a -> BTree a
forall (n :: Natural) t. Tree n a -> Keep t n a -> Pull t n a -> t
find' Tree n a
tree Keep (BTree a) n a
forall (n :: Natural) a. Tree n a -> BTree a
BTree Pull (BTree a) n a
forall (n :: Natural). Shrunk n a -> BTree a
shrink
  where
    shrink :: forall n. Shrunk n a -> BTree a
    shrink :: forall (n :: Natural). Shrunk n a -> BTree a
shrink (H Tree n a
t) = Tree n a -> BTree a
forall (n :: Natural) a. Tree n a -> BTree a
BTree Tree n a
t

    find' :: forall n t. Tree n a -> Keep t n a -> Pull t n a -> t
    find' :: forall (n :: Natural) t. Tree n a -> Keep t n a -> Pull t n a -> t
find' Tree n a
Leaf Keep t n a
keep Pull t n a
_ = Keep t n a
keep Tree n a
forall a. Tree 'Z a
Leaf
    find' (Branch (Subtree Tree n a
a a
b Tree n a
c)) Keep t n a
keep Pull t n a
pull = a -> a -> t -> t -> t -> t
forall a p. Ord a => a -> a -> p -> p -> p -> p
select a
x a
b t
xltb t
xeqb t
xgtb
      where
        xltb, xeqb, xgtb :: t
        xltb :: t
xltb = Tree n a -> Keep t n a -> Pull t n a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Pull t n a -> t
find' Tree n a
a (\Tree n a
k -> Keep t n a
keep (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
k a
b Tree n a
c)) (\Shrunk n a
p -> Shrunk n a -> a -> Keep t n a
forall (p :: Natural).
('Succ p ~ n) =>
Shrunk p a -> a -> Tree p a -> t
mrgl Shrunk n a
p a
b Tree n a
c)
        xgtb :: t
xgtb = Tree n a -> Keep t n a -> Pull t n a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Pull t n a -> t
find' Tree n a
c (Keep t n a
keep Keep t n a -> (Tree n a -> Tree n a) -> Keep t n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a a
b) (Keep t ('Succ n) a
-> Pull t ('Succ n) a -> Tree n a -> a -> Pull t n a
forall (p :: Natural) t.
Keep t ('Succ p) a
-> Pull t ('Succ p) a -> Tree p a -> a -> Shrunk p a -> t
mrg2r Keep t n a
Keep t ('Succ n) a
keep Pull t n a
Pull t ('Succ n) a
pull Tree n a
a a
b)
        xeqb :: t
xeqb = Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
forall (n :: Natural) t.
Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
replace Tree n a
a (\Tree n a
k a
r -> Keep t n a
keep (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
k a
r Tree n a
c)) (\Shrunk n a
p a
r -> Shrunk n a -> a -> Keep t n a
forall (p :: Natural).
('Succ p ~ n) =>
Shrunk p a -> a -> Tree p a -> t
mrgl Shrunk n a
p a
r Tree n a
c) (Pull t n a
pull (Tree n a -> Shrunk ('Succ n) a
forall (n :: Natural) a. Tree n a -> Shrunk ('Succ n) a
H Tree n a
a))

        mrgl :: forall p. ('Succ p ~ n) => Shrunk p a -> a -> Tree p a -> t
        mrgl :: forall (p :: Natural).
('Succ p ~ n) =>
Shrunk p a -> a -> Tree p a -> t
mrgl (H Tree n a
a') a
b' (Branch (Subtree Tree n a
c' a
d Tree n a
e)) = Pull t n a
pull (Tree ('Succ n) a -> Shrunk ('Succ ('Succ n)) a
forall (n :: Natural) a. Tree n a -> Shrunk ('Succ n) a
H (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a' a
b' Tree n a
Tree n a
c' a
d Tree n a
Tree n a
e))
        mrgl (H Tree n a
a') a
b' (Branch (Subtree' Tree n a
c' a
d Tree n a
e a
f Tree n a
g)) = Keep t n a
keep (Tree ('Succ n) a
-> a -> Tree ('Succ n) a -> Tree ('Succ ('Succ n)) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a' a
b' Tree n a
Tree n a
c') a
d (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
Tree n a
e a
f Tree n a
Tree n a
g))
    find' (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) Keep t n a
keep Pull t n a
_ = a -> a -> a -> t -> t -> t -> t -> t -> t
forall a p. Ord a => a -> a -> a -> p -> p -> p -> p -> p -> p
select' a
x a
b a
d t
xltb t
xeqb t
xbtw t
xeqd t
xgtd
      where
        xltb :: t
xltb = Tree n a -> Keep t n a -> Pull t n a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Pull t n a -> t
find' Tree n a
a (\Tree n a
k -> Keep t n a
keep (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
k a
b Tree n a
c a
d Tree n a
e)) (\Shrunk n a
p -> Shrunk n a -> a -> Tree n a -> a -> Keep t n a
mrgl Shrunk n a
p a
b Tree n a
c a
d Tree n a
e)
        xbtw :: t
xbtw = Tree n a -> Keep t n a -> Pull t n a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Pull t n a -> t
find' Tree n a
c (\Tree n a
k -> Keep t n a
keep (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a a
b Tree n a
k a
d Tree n a
e)) (\Shrunk n a
p -> Tree n a -> a -> Shrunk n a -> a -> Keep t n a
mrgm Tree n a
a a
b Shrunk n a
p a
d Tree n a
e)
        xgtd :: t
xgtd = Tree n a -> Keep t n a -> Pull t n a -> t
forall (n :: Natural) t. Tree n a -> Keep t n a -> Pull t n a -> t
find' Tree n a
e (Keep t n a
keep Keep t n a -> (Tree n a -> Tree n a) -> Keep t n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a a
b Tree n a
c a
d) (Keep t ('Succ n) a -> Tree n a -> a -> Tree n a -> a -> Pull t n a
forall (p :: Natural) t.
Keep t ('Succ p) a
-> Tree p a -> a -> Tree p a -> a -> Shrunk p a -> t
mrg3r Keep t n a
Keep t ('Succ n) a
keep Tree n a
a a
b Tree n a
c a
d)
        xeqb :: t
xeqb = Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
forall (n :: Natural) t.
Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
replace Tree n a
a (\Tree n a
k a
r -> Keep t n a
keep (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
k a
r Tree n a
c a
d Tree n a
e)) (\Shrunk n a
p a
r -> Shrunk n a -> a -> Tree n a -> a -> Keep t n a
mrgl Shrunk n a
p a
r Tree n a
c a
d Tree n a
e) (Keep t n a
keep (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
c a
d Tree n a
e))
        xeqd :: t
xeqd = Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
forall (n :: Natural) t.
Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
replace Tree n a
c (\Tree n a
k a
r -> Keep t n a
keep (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a a
b Tree n a
k a
r Tree n a
e)) (\Shrunk n a
p a
r -> Tree n a -> a -> Shrunk n a -> a -> Keep t n a
mrgm Tree n a
a a
b Shrunk n a
p a
r Tree n a
e) (Keep t n a
keep (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a a
b Tree n a
c))

        mrgl :: Shrunk n a -> a -> Tree n a -> a -> Keep t n a
mrgl (H Tree n a
a') a
b' (Branch (Subtree' Tree n a
c' a
d' Tree n a
e' a
f Tree n a
g)) a
h Tree n a
i = Keep t n a
keep (Tree ('Succ n) a
-> a
-> Tree ('Succ n) a
-> a
-> Tree ('Succ n) a
-> Tree ('Succ ('Succ n)) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a' a
b' Tree n a
Tree n a
c') a
d' (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
Tree n a
e' a
f Tree n a
Tree n a
g) a
h Tree n a
Tree ('Succ n) a
i)
        mrgl (H Tree n a
a') a
b' (Branch (Subtree Tree n a
c' a
d' Tree n a
e')) a
f Tree n a
g = Keep t n a
keep (Tree ('Succ n) a
-> a -> Tree ('Succ n) a -> Tree ('Succ ('Succ n)) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a' a
b' Tree n a
Tree n a
c' a
d' Tree n a
Tree n a
e') a
f Tree n a
Tree ('Succ n) a
g)

        mrgm :: Tree n a -> a -> Shrunk n a -> a -> Keep t n a
mrgm Tree n a
a' a
b' (H Tree n a
c') a
d' (Branch (Subtree' Tree n a
e' a
f Tree n a
g a
h Tree n a
i)) = Keep t n a
keep (Tree ('Succ n) a
-> a
-> Tree ('Succ n) a
-> a
-> Tree ('Succ n) a
-> Tree ('Succ ('Succ n)) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
Tree ('Succ n) a
a' a
b' (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
c' a
d' Tree n a
Tree n a
e') a
f (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
Tree n a
g a
h Tree n a
Tree n a
i))
        mrgm Tree n a
a' a
b' (H Tree n a
c') a
d' (Branch (Subtree Tree n a
e' a
f Tree n a
g)) = Keep t n a
keep (Tree ('Succ n) a
-> a -> Tree ('Succ n) a -> Tree ('Succ ('Succ n)) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
Tree ('Succ n) a
a' a
b' (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
c' a
d' Tree n a
Tree n a
e' a
f Tree n a
Tree n a
g))

    replace :: forall n t. Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
    replace :: forall (n :: Natural) t.
Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
replace Tree n a
Leaf Keep (a -> t) n a
_ Pull (a -> t) n a
_ t
leaf = t
leaf
    replace (Branch (Subtree Tree n a
a a
b Tree n a
c)) Keep (a -> t) n a
keep Pull (a -> t) n a
pull t
_
      = Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
forall (n :: Natural) t.
Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
replace Tree n a
c (Keep (a -> t) n a
keep Keep (a -> t) n a -> (Tree n a -> Tree n a) -> Keep (a -> t) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a a
b) (Keep (a -> t) ('Succ n) a
-> Pull (a -> t) ('Succ n) a -> Tree n a -> a -> Pull (a -> t) n a
forall (p :: Natural) t.
Keep t ('Succ p) a
-> Pull t ('Succ p) a -> Tree p a -> a -> Shrunk p a -> t
mrg2r Keep (a -> t) n a
Keep (a -> t) ('Succ n) a
keep Pull (a -> t) n a
Pull (a -> t) ('Succ n) a
pull Tree n a
a a
b) (Pull (a -> t) n a
pull (Tree n a -> Shrunk ('Succ n) a
forall (n :: Natural) a. Tree n a -> Shrunk ('Succ n) a
H Tree n a
a) a
b)
    replace (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) Keep (a -> t) n a
keep Pull (a -> t) n a
_ t
_ =
      Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
forall (n :: Natural) t.
Tree n a -> Keep (a -> t) n a -> Pull (a -> t) n a -> t -> t
replace Tree n a
e (Keep (a -> t) n a
keep Keep (a -> t) n a -> (Tree n a -> Tree n a) -> Keep (a -> t) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a a
b Tree n a
c a
d) (Keep (a -> t) ('Succ n) a
-> Tree n a -> a -> Tree n a -> a -> Pull (a -> t) n a
forall (p :: Natural) t.
Keep t ('Succ p) a
-> Tree p a -> a -> Tree p a -> a -> Shrunk p a -> t
mrg3r Keep (a -> t) n a
Keep (a -> t) ('Succ n) a
keep Tree n a
a a
b Tree n a
c a
d) (Keep (a -> t) n a
keep (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a a
b Tree n a
c) a
d)

    mrg2r :: forall p t. Keep t ('Succ p) a -> Pull t ('Succ p) a -> Tree p a -> a -> Shrunk p a -> t
    mrg2r :: forall (p :: Natural) t.
Keep t ('Succ p) a
-> Pull t ('Succ p) a -> Tree p a -> a -> Shrunk p a -> t
mrg2r Keep t ('Succ p) a
_ Pull t ('Succ p) a
pull (Branch (Subtree Tree n a
a a
b Tree n a
c)) a
d (H Tree n a
e) = Pull t ('Succ p) a
pull (Tree p a -> Shrunk ('Succ p) a
forall (n :: Natural) a. Tree n a -> Shrunk ('Succ n) a
H (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a a
b Tree n a
c a
d Tree n a
Tree n a
e))
    mrg2r Keep t ('Succ p) a
keep Pull t ('Succ p) a
_ (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) a
f (H Tree n a
g) = Keep t ('Succ p) a
keep (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a a
b Tree n a
c) a
d (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
e a
f Tree n a
Tree n a
g))

    mrg3r :: forall p t. Keep t ('Succ p) a -> Tree p a -> a -> Tree p a -> a -> Shrunk p a -> t
    mrg3r :: forall (p :: Natural) t.
Keep t ('Succ p) a
-> Tree p a -> a -> Tree p a -> a -> Shrunk p a -> t
mrg3r Keep t ('Succ p) a
keep Tree p a
a a
b (Branch (Subtree' Tree n a
c a
d Tree n a
e a
f Tree n a
g)) a
h (H Tree n a
i) = Keep t ('Succ p) a
keep (Tree p a -> a -> Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree p a
a a
b (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
c a
d Tree n a
e) a
f (Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
g a
h Tree n a
Tree n a
i))
    mrg3r Keep t ('Succ p) a
keep Tree p a
a a
b (Branch (Subtree Tree n a
c a
d Tree n a
e)) a
f (H Tree n a
g) = Keep t ('Succ p) a
keep (Tree p a -> a -> Tree p a -> Tree ('Succ p) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree p a
a a
b (Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
c a
d Tree n a
e a
f Tree n a
Tree n a
g))

-- | Search an element in a 'BTree'. It will return a [Maybe](https://hackage.haskell.org/package/base-4.16.2.0/docs/Prelude.html#t:Maybe).
--
--   +------------+---------------+---------------+
--   | Algorithm  |  Medium Case  |   Worst Case  |
--   +============+===============+===============+
--   | Search     | O(log n)      | O(log n)      |
--   +------------+---------------+---------------+
--
--   >>> let t = fromList [1,2,3,4,5]
--
--   >>> search 3 t
--   Just 3
--
--   >>> search 6 t
--   Nothing
--
--   @since 1.0.0
search :: forall a. Ord a => a -> BTree a -> Maybe a
search :: forall a. Ord a => a -> BTree a -> Maybe a
search a
x = (a -> Bool) -> BTree a -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x)

-- | A empty 'BTree'. It consists of a single leaf.
--
-- It may be used to construct a new 'BTree' by inserting elements into it.
--
--   >>> let t = empty
--   >>> t
--   "."
--
--   >>> let n = insert 1 t
--   >>> n
--   "(. 1 .)"
--
--   >>> let j = insert 2 empty
--   >>> j
--   "(. 2 .)"
--
--   @since 1.0.0
empty :: BTree a
empty :: forall a. BTree a
empty = Tree 'Z a -> BTree a
forall (n :: Natural) a. Tree n a -> BTree a
BTree Tree 'Z a
forall a. Tree 'Z a
Leaf

-- | Creates a singleton 'BTree' from a single element.
--
--   >>> let t = singleton 1
--   >>> t
--   "(. 1 .)"
--
--   @since 1.0.0
singleton :: Ord a => a -> BTree a
singleton :: forall a. Ord a => a -> BTree a
singleton a
x = a -> BTree a -> BTree a
forall a. Ord a => a -> BTree a -> BTree a
insert a
x BTree a
forall a. BTree a
empty

-- | Creates a 'BTree' from a list.
--
--   >>> let t = fromList [1,2,3,4,5,6,7]
--   >>> t
--   "(((. 1 .) 2 (. 3 .)) 4 ((. 5 .) 6 (. 7 .)))"
--
--   @since 1.0.0
fromList :: Ord a => [a] -> BTree a
fromList :: forall a. Ord a => [a] -> BTree a
fromList = (BTree a -> a -> BTree a) -> BTree a -> [a] -> BTree a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' ((a -> BTree a -> BTree a) -> BTree a -> a -> BTree a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> BTree a -> BTree a
forall a. Ord a => a -> BTree a -> BTree a
insert) BTree a
forall a. BTree a
empty

-- | Return the 'BTree' as a list in a in-order traversal.
--
-- The __in-order__ traversal runs through the elements of the 'BTree' in the following order:
--
--      (1) The left subtree.
--
--      (2) The root element.
--
--      (3) The right subtree.
--
--   /@Note:@ The in-order traversal is the default traversal for the 'BTree', and is used to return as list./
--
--   A 'BTree' of @[1, 2, 3, 4, 5, 6, 7]@ is represented as:
--
-- @
--             4
--         \/      \\
--        2       6
--       \/ \\     \/ \\
--      1   3   5   7
--     \/ \\ \/ \\ \/ \\ \/ \\
--    .  ..  ..  ..   .
--
-- @
--
--   >>> inorder (fromList [1,2,3,4,5,6,7])
--   [1,2,3,4,5,6,7]
--
--   @since 1.0.0
inorder :: forall a. BTree a -> [a]
inorder :: forall a. BTree a -> [a]
inorder (BTree Tree n a
tree) = Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pre Tree n a
tree
  where
    pre :: Tree n a -> [a]
    pre :: forall (n :: Natural). Tree n a -> [a]
pre (Branch (Subtree Tree n a
a a
b Tree n a
c))      = Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pre Tree n a
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
b] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pre Tree n a
c
    pre (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pre Tree n a
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
b] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pre Tree n a
c [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
d] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pre Tree n a
e
    pre Tree n a
Leaf                          = []

-- | Return the 'BTree' as a list in a post-order traversal.
--
-- The __post-order__ traversal runs through the elements of the 'BTree' in the following order:
--
--      (1) The left subtree.
--
--      (2) The right subtree.
--
--      (3) The root element.
--
--   A 'BTree' of @[1, 2, 3, 4, 5, 6, 7]@ is represented as:
--
-- @
--             4
--         \/      \\
--        2       6
--       \/ \\     \/ \\
--      1   3   5   7
--     \/ \\ \/ \\ \/ \\ \/ \\
--    .  ..  ..  ..   .
-- @
--
--   >>> postorder (fromList [1,2,3,4,5,6,7])
--   [1,3,2,5,7,6,4]
--
--   @since 1.0.0
postorder :: forall a. BTree a -> [a]
postorder :: forall a. BTree a -> [a]
postorder (BTree Tree n a
tree) = Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pos Tree n a
tree
  where
    pos :: Tree n a -> [a]
    pos :: forall (n :: Natural). Tree n a -> [a]
pos (Branch (Subtree Tree n a
a a
b Tree n a
c))      = Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pos Tree n a
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pos Tree n a
c [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
b]
    pos (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pos Tree n a
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pos Tree n a
c [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
pos Tree n a
e [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
b] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
d]
    pos Tree n a
Leaf                          = []

-- | Return the 'BTree' as a list in a pre-order traversal.
--
-- The __pre-order__ traversal runs through the elements of the 'BTree' in the following order:
--
--      (1) The root element.
--
--      (2) The left subtree.
--
--      (3) The right subtree.
--
--   A 'BTree' of @[1, 2, 3, 4, 5, 6, 7]@ is represented as:
--
-- @
--             4
--         \/      \\
--        2       6
--       \/ \\     \/ \\
--      1   3   5   7
--     \/ \\ \/ \\ \/ \\ \/ \\
--    .  ..  ..  ..   .
-- @
--
--   >>> preorder (fromList [1,2,3,4,5,6,7])
--   [4,2,1,3,6,5,7]
--
--   @since 1.0.0
preorder :: forall a. BTree a -> [a]
preorder :: forall a. BTree a -> [a]
preorder (BTree Tree n a
tree) = Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
ino Tree n a
tree
  where
    ino :: Tree n a -> [a]
    ino :: forall (n :: Natural). Tree n a -> [a]
ino (Branch (Subtree Tree n a
a a
b Tree n a
c))      = [a
b] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
ino Tree n a
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
ino Tree n a
c
    ino (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = [a
b] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
d] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
ino Tree n a
a [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
ino Tree n a
c [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Tree n a -> [a]
forall (n :: Natural). Tree n a -> [a]
ino Tree n a
e
    ino Tree n a
Leaf                          = []

-- | The height of the 'BTree'.
--
-- Represents the number of levels in the 'BTree'.
--
-- @
--             4             <-- height 3
--         \/      \\
--        2       6          <-- height 2
--       \/ \\     \/ \\
--      1   3   5   7        <-- height 1
--     \/ \\ \/ \\ \/ \\ \/ \\
--    .  ..  ..  ..   .      <-- height 0
-- @
--
--   >>> height (fromList [1,2,3,4,5,6,7])
--   3
--
--   @since 1.0.0
height :: forall a. BTree a -> Int
height :: forall a. BTree a -> Int
height (BTree Tree n a
tree) = Tree n a -> Int
forall (n :: Natural). Tree n a -> Int
height' Tree n a
tree
  where
    height' :: Tree n a -> Int
    height' :: forall (n :: Natural). Tree n a -> Int
height' (Branch (Subtree Tree n a
a a
_ Tree n a
_))      = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree n a -> Int
forall (n :: Natural). Tree n a -> Int
height' Tree n a
a        -- As thet are equidistant, the height of a subtree is always the same as the others.
    height' (Branch (Subtree' Tree n a
a a
_ Tree n a
_ a
_ Tree n a
_)) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Tree n a -> Int
forall (n :: Natural). Tree n a -> Int
height' Tree n a
a   -- So we only need to check it once.
    height' Tree n a
Leaf                          = Int
0

-- | Draws the 'BTree'.
--
-- The output is a string of the form:
--
--      * Each Leaf is represented by a \' . \'
--
--      * Each Node is represented as /(left, value, right)/ where left and right are the left and right subtrees.
--
--   So, the current list @[1, 2, 3, 4, 5, 6, 7]@ will be represented as:
--
--   @"(((. 1 .) 2 (. 3 .)) 4 ((. 5 .) 6 (. 7 .)))"@
--
--   Which is an inline representation of the 'BTree'.
--
-- ==== __Examples __
--
--   >>> draw (fromList [1,2,3,4,5,6,7])
--   "(((. 1 .) 2 (. 3 .)) 4 ((. 5 .) 6 (. 7 .)))"
--
--   @since 1.0.0
draw :: forall a. Show a => BTree a -> String
draw :: forall a. Show a => BTree a -> String
draw (BTree Tree n a
tree) = Tree n a -> String
forall (n :: Natural). Tree n a -> String
draw' Tree n a
tree
  where
    draw' :: Tree n a -> String
    draw' :: forall (n :: Natural). Tree n a -> String
draw' (Branch (Subtree Tree n a
a a
b Tree n a
c)) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tree n a -> String
forall (n :: Natural). Tree n a -> String
draw' Tree n a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tree n a -> String
forall (n :: Natural). Tree n a -> String
draw' Tree n a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    draw' (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = String
"(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tree n a -> String
forall (n :: Natural). Tree n a -> String
draw' Tree n a
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tree n a -> String
forall (n :: Natural). Tree n a -> String
draw' Tree n a
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Tree n a -> String
forall (n :: Natural). Tree n a -> String
draw' Tree n a
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    draw' Tree n a
Leaf = String
"."

-- | Return the 'BTree' as a list of lists, grouped by hights.
--
-- It will start by the root level and then go down to the branches.
--
-- @
--
--   a
--  / \\    => [[a], [b,c]]
-- b   c
-- @
--
--   >>> levels (fromList [1,2,3,4,5,6,7])
--   [[4],[2,6],[1,3,5,7]]
--
--   @since 1.0.0
levels :: forall a. Ord a => BTree a -> [[a]]
levels :: forall a. Ord a => BTree a -> [[a]]
levels (BTree Tree n a
tree) = ([(Int, a)] -> [a]) -> [[(Int, a)]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, a) -> a) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int, a) -> a
forall a b. (a, b) -> b
snd) ([[(Int, a)]] -> [[a]]) -> [[(Int, a)]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> (Int, a) -> Bool) -> [(Int, a)] -> [[(Int, a)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((Int, a) -> Int) -> (Int, a) -> (Int, a) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, a) -> Int
forall a b. (a, b) -> a
fst) ([(Int, a)] -> [[(Int, a)]]) -> [(Int, a)] -> [[(Int, a)]]
forall a b. (a -> b) -> a -> b
$ [(Int, a)] -> [(Int, a)]
forall a. Ord a => [a] -> [a]
L.sort ([(Int, a)] -> [(Int, a)]) -> [(Int, a)] -> [(Int, a)]
forall a b. (a -> b) -> a -> b
$ Int -> Tree n a -> [(Int, a)]
forall (n :: Natural). Int -> Tree n a -> [(Int, a)]
levels' Int
0 Tree n a
tree
  where
    levels' :: Int -> Tree n a -> [(Int, a)]
    levels' :: forall (n :: Natural). Int -> Tree n a -> [(Int, a)]
levels' Int
_ Tree n a
Leaf = []
    levels' Int
n (Branch (Subtree Tree n a
a a
b Tree n a
c)) = Int -> Tree n a -> [(Int, a)]
forall (n :: Natural). Int -> Tree n a -> [(Int, a)]
levels' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Tree n a
a [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
++ [(Int
n, a
b)] [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
++ Int -> Tree n a -> [(Int, a)]
forall (n :: Natural). Int -> Tree n a -> [(Int, a)]
levels' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Tree n a
c
    levels' Int
n (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = Int -> Tree n a -> [(Int, a)]
forall (n :: Natural). Int -> Tree n a -> [(Int, a)]
levels' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Tree n a
a [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
++ [(Int
n, a
b)] [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
++ Int -> Tree n a -> [(Int, a)]
forall (n :: Natural). Int -> Tree n a -> [(Int, a)]
levels' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Tree n a
c [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
++ [(Int
n, a
d)] [(Int, a)] -> [(Int, a)] -> [(Int, a)]
forall a. [a] -> [a] -> [a]
++ Int -> Tree n a -> [(Int, a)]
forall (n :: Natural). Int -> Tree n a -> [(Int, a)]
levels' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Tree n a
e

fmapT :: (a -> b) -> BTree a -> BTree b
fmapT :: forall a b. (a -> b) -> BTree a -> BTree b
fmapT a -> b
f (BTree Tree n a
tree) = Tree n b -> BTree b
forall (n :: Natural) a. Tree n a -> BTree a
BTree (Tree n b -> BTree b) -> Tree n b -> BTree b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Tree n a -> Tree n b
forall a b (n :: Natural). (a -> b) -> Tree n a -> Tree n b
fmap' a -> b
f Tree n a
tree
  where
    fmap' :: (a -> b) -> Tree n a -> Tree n b
    fmap' :: forall a b (n :: Natural). (a -> b) -> Tree n a -> Tree n b
fmap' a -> b
f' (Branch (Subtree Tree n a
a a
b Tree n a
c)) = Node n b -> Tree ('Succ n) b
forall (n :: Natural) a. Node n a -> Tree ('Succ n) a
Branch (Tree n b -> b -> Tree n b -> Node n b
forall (n :: Natural) a. Tree n a -> a -> Tree n a -> Node n a
Subtree ((a -> b) -> Tree n a -> Tree n b
forall a b (n :: Natural). (a -> b) -> Tree n a -> Tree n b
fmap' a -> b
f' Tree n a
a) (a -> b
f' a
b) ((a -> b) -> Tree n a -> Tree n b
forall a b (n :: Natural). (a -> b) -> Tree n a -> Tree n b
fmap' a -> b
f' Tree n a
c))
    fmap' a -> b
f' (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = Node n b -> Tree ('Succ n) b
forall (n :: Natural) a. Node n a -> Tree ('Succ n) a
Branch (Tree n b -> b -> Tree n b -> b -> Tree n b -> Node n b
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Node n a
Subtree' ((a -> b) -> Tree n a -> Tree n b
forall a b (n :: Natural). (a -> b) -> Tree n a -> Tree n b
fmap' a -> b
f' Tree n a
a) (a -> b
f' a
b) ((a -> b) -> Tree n a -> Tree n b
forall a b (n :: Natural). (a -> b) -> Tree n a -> Tree n b
fmap' a -> b
f' Tree n a
c) (a -> b
f' a
d) ((a -> b) -> Tree n a -> Tree n b
forall a b (n :: Natural). (a -> b) -> Tree n a -> Tree n b
fmap' a -> b
f' Tree n a
e))
    fmap' a -> b
_ Tree n a
Leaf = Tree n b
forall a. Tree 'Z a
Leaf

foldMapT :: forall m a. Monoid m => (a -> m) -> BTree a -> m
foldMapT :: forall m a. Monoid m => (a -> m) -> BTree a -> m
foldMapT a -> m
f (BTree Tree n a
t) = Tree n a -> m
forall (n :: Natural). Tree n a -> m
fm Tree n a
t
  where
      fm :: forall n. Tree n a -> m
      fm :: forall (n :: Natural). Tree n a -> m
fm (Branch (Subtree Tree n a
a a
b Tree n a
c))      = Tree n a -> m
forall (n :: Natural). Tree n a -> m
fm Tree n a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
b m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Tree n a -> m
forall (n :: Natural). Tree n a -> m
fm Tree n a
c
      fm (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = Tree n a -> m
forall (n :: Natural). Tree n a -> m
fm Tree n a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
b m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Tree n a -> m
forall (n :: Natural). Tree n a -> m
fm Tree n a
c m -> m -> m
forall a. Semigroup a => a -> a -> a
<> a -> m
f a
d m -> m -> m
forall a. Semigroup a => a -> a -> a
<> Tree n a -> m
forall (n :: Natural). Tree n a -> m
fm Tree n a
e
      fm Tree n a
Leaf                          = m
forall a. Monoid a => a
mempty

instance Functor BTree where fmap :: forall a b. (a -> b) -> BTree a -> BTree b
fmap = (a -> b) -> BTree a -> BTree b
forall a b. (a -> b) -> BTree a -> BTree b
fmapT

instance Foldable BTree where foldMap :: forall m a. Monoid m => (a -> m) -> BTree a -> m
foldMap = (a -> m) -> BTree a -> m
forall m a. Monoid m => (a -> m) -> BTree a -> m
foldMapT
-- | The default 'Traversable' instance is implemented in a in-order traversal.
--
--   >>> let incOdd n = if odd n then Just $ n + 1 else Nothing
--   >>> traverse incOdd $ fromList [1,3,5,7,9]
--   Just ("((. 2 .) 4 (. 6 .) 8 (. 10 .))")
instance Traversable BTree where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> BTree a -> f (BTree b)
traverse a -> f b
f (BTree Tree n a
tree) = Tree n b -> BTree b
forall (n :: Natural) a. Tree n a -> BTree a
BTree (Tree n b -> BTree b) -> f (Tree n b) -> f (BTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Tree n a -> f (Tree n b)
forall (n :: Natural) a b (f :: * -> *).
Applicative f =>
(a -> f b) -> Tree n a -> f (Tree n b)
traverse' a -> f b
f Tree n a
tree
    where
      traverse' :: forall n a b f. Applicative f => (a -> f b) -> Tree n a -> f (Tree n b)
      traverse' :: forall (n :: Natural) a b (f :: * -> *).
Applicative f =>
(a -> f b) -> Tree n a -> f (Tree n b)
traverse' a -> f b
f' (Branch (Subtree Tree n a
a a
b Tree n a
c)) = Node n b -> Tree n b
forall (n :: Natural) a. Node n a -> Tree ('Succ n) a
Branch (Node n b -> Tree n b) -> f (Node n b) -> f (Tree n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree n b -> b -> Tree n b -> Node n b
forall (n :: Natural) a. Tree n a -> a -> Tree n a -> Node n a
Subtree (Tree n b -> b -> Tree n b -> Node n b)
-> f (Tree n b) -> f (b -> Tree n b -> Node n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Tree n a -> f (Tree n b)
forall (n :: Natural) a b (f :: * -> *).
Applicative f =>
(a -> f b) -> Tree n a -> f (Tree n b)
traverse' a -> f b
f' Tree n a
a f (b -> Tree n b -> Node n b) -> f b -> f (Tree n b -> Node n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f' a
b f (Tree n b -> Node n b) -> f (Tree n b) -> f (Node n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Tree n a -> f (Tree n b)
forall (n :: Natural) a b (f :: * -> *).
Applicative f =>
(a -> f b) -> Tree n a -> f (Tree n b)
traverse' a -> f b
f' Tree n a
c)
      traverse' a -> f b
f' (Branch (Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)) = Node n b -> Tree n b
forall (n :: Natural) a. Node n a -> Tree ('Succ n) a
Branch (Node n b -> Tree n b) -> f (Node n b) -> f (Tree n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tree n b -> b -> Tree n b -> b -> Tree n b -> Node n b
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Node n a
Subtree' (Tree n b -> b -> Tree n b -> b -> Tree n b -> Node n b)
-> f (Tree n b) -> f (b -> Tree n b -> b -> Tree n b -> Node n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Tree n a -> f (Tree n b)
forall (n :: Natural) a b (f :: * -> *).
Applicative f =>
(a -> f b) -> Tree n a -> f (Tree n b)
traverse' a -> f b
f' Tree n a
a f (b -> Tree n b -> b -> Tree n b -> Node n b)
-> f b -> f (Tree n b -> b -> Tree n b -> Node n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f' a
b f (Tree n b -> b -> Tree n b -> Node n b)
-> f (Tree n b) -> f (b -> Tree n b -> Node n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Tree n a -> f (Tree n b)
forall (n :: Natural) a b (f :: * -> *).
Applicative f =>
(a -> f b) -> Tree n a -> f (Tree n b)
traverse' a -> f b
f' Tree n a
c f (b -> Tree n b -> Node n b) -> f b -> f (Tree n b -> Node n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f' a
d f (Tree n b -> Node n b) -> f (Tree n b) -> f (Node n b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Tree n a -> f (Tree n b)
forall (n :: Natural) a b (f :: * -> *).
Applicative f =>
(a -> f b) -> Tree n a -> f (Tree n b)
traverse' a -> f b
f' Tree n a
e)
      traverse' a -> f b
_ Tree n a
Leaf = Tree n b -> f (Tree n b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tree n b
forall a. Tree 'Z a
Leaf

instance Show a => Show (BTree a) where
  showsPrec :: Int -> BTree a -> String -> String
showsPrec Int
n BTree a
t = Bool -> (String -> String) -> String -> String
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) ((String -> String) -> String -> String)
-> (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. Show a => a -> String -> String
shows (BTree a -> String
forall a. Show a => BTree a -> String
draw BTree a
t)

-- | Utility function to select the correct element given a comparison of two other elements.
select :: Ord a => a -> a -> p -> p -> p -> p
select :: forall a p. Ord a => a -> a -> p -> p -> p -> p
select a
x a
y p
lt p
eq p
gt = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
y of { Ordering
LT -> p
lt; Ordering
EQ -> p
eq; Ordering
GT -> p
gt }

-- | Utility function to select the correct element given a comparison of three other elements.
select' :: Ord a => a -> a -> a -> p -> p -> p -> p -> p -> p
select' :: forall a p. Ord a => a -> a -> a -> p -> p -> p -> p -> p -> p
select' a
x a
y a
z p
xlty p
xeqy p
xbtw p
xeqz p
xgtz = a -> a -> p -> p -> p -> p
forall a p. Ord a => a -> a -> p -> p -> p -> p
select a
x a
y p
xlty p
xeqy (a -> a -> p -> p -> p -> p
forall a p. Ord a => a -> a -> p -> p -> p -> p
select a
x a
z p
xbtw p
xeqz p
xgtz)

-- | A branch constructor. Convenient method for creating a branch with a single element and two subtrees.
branch :: Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch :: forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch Tree n a
a a
b Tree n a
c = Node n a -> Tree ('Succ n) a
forall (n :: Natural) a. Node n a -> Tree ('Succ n) a
Branch (Tree n a -> a -> Tree n a -> Node n a
forall (n :: Natural) a. Tree n a -> a -> Tree n a -> Node n a
Subtree Tree n a
a a
b Tree n a
c)

-- | A branch constructor. Convenient method for creating a branch with a two elements and three subtrees.
branch' :: Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' :: forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Tree ('Succ n) a
branch' Tree n a
a a
b Tree n a
c a
d Tree n a
e = Node n a -> Tree ('Succ n) a
forall (n :: Natural) a. Node n a -> Tree ('Succ n) a
Branch (Tree n a -> a -> Tree n a -> a -> Tree n a -> Node n a
forall (n :: Natural) a.
Tree n a -> a -> Tree n a -> a -> Tree n a -> Node n a
Subtree' Tree n a
a a
b Tree n a
c a
d Tree n a
e)