{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
module Data.Tree.AVL.Unsafe
( emptyAVL,
insertAVL,
lookupAVL,
deleteAVL,
)
where
import Data.Kind (Type)
import Prelude
( Int,
Maybe (Just, Nothing),
Ordering (EQ, GT, LT),
Show,
compare,
max,
($),
(+),
(-),
)
data Node :: Type -> Type where
Node :: Show a => Int -> a -> Node a
deriving stock instance Show (Node a)
data AVL :: Type -> Type where
E :: AVL a
F :: AVL a -> Node a -> AVL a -> AVL a
deriving stock (Int -> AVL a -> ShowS
[AVL a] -> ShowS
AVL a -> String
(Int -> AVL a -> ShowS)
-> (AVL a -> String) -> ([AVL a] -> ShowS) -> Show (AVL a)
forall a. Int -> AVL a -> ShowS
forall a. [AVL a] -> ShowS
forall a. AVL a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AVL a] -> ShowS
$cshowList :: forall a. [AVL a] -> ShowS
show :: AVL a -> String
$cshow :: forall a. AVL a -> String
showsPrec :: Int -> AVL a -> ShowS
$cshowsPrec :: forall a. Int -> AVL a -> ShowS
Show)
data AlmostAVL :: Type -> Type where
FF :: AVL a -> Node a -> AVL a -> AlmostAVL a
deriving stock (Int -> AlmostAVL a -> ShowS
[AlmostAVL a] -> ShowS
AlmostAVL a -> String
(Int -> AlmostAVL a -> ShowS)
-> (AlmostAVL a -> String)
-> ([AlmostAVL a] -> ShowS)
-> Show (AlmostAVL a)
forall a. Int -> AlmostAVL a -> ShowS
forall a. [AlmostAVL a] -> ShowS
forall a. AlmostAVL a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AlmostAVL a] -> ShowS
$cshowList :: forall a. [AlmostAVL a] -> ShowS
show :: AlmostAVL a -> String
$cshow :: forall a. AlmostAVL a -> String
showsPrec :: Int -> AlmostAVL a -> ShowS
$cshowsPrec :: forall a. Int -> AlmostAVL a -> ShowS
Show)
emptyAVL :: AVL a
emptyAVL :: forall a. AVL a
emptyAVL = AVL a
forall a. AVL a
E
height :: AVL a -> Int
height :: forall a. AVL a -> Int
height AVL a
E = Int
0
height (F AVL a
l Node a
_ AVL a
r) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (AVL a -> Int
forall a. AVL a -> Int
height AVL a
l) (AVL a -> Int
forall a. AVL a -> Int
height AVL a
r)
data US = LeftUnbalanced | RightUnbalanced | NotUnbalanced
unbalancedState :: Int -> Int -> US
unbalancedState :: Int -> Int -> US
unbalancedState Int
0 Int
0 = US
NotUnbalanced
unbalancedState Int
1 Int
0 = US
NotUnbalanced
unbalancedState Int
0 Int
1 = US
NotUnbalanced
unbalancedState Int
2 Int
0 = US
LeftUnbalanced
unbalancedState Int
0 Int
2 = US
RightUnbalanced
unbalancedState Int
h1 Int
h2 = Int -> Int -> US
unbalancedState (Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
h2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
data BS = LeftHeavy | RightHeavy | Balanced
balancedState :: Int -> Int -> BS
balancedState :: Int -> Int -> BS
balancedState Int
0 Int
0 = BS
Balanced
balancedState Int
1 Int
0 = BS
LeftHeavy
balancedState Int
0 Int
1 = BS
RightHeavy
balancedState Int
h1 Int
h2 = Int -> Int -> BS
balancedState (Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
h2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
balance :: AlmostAVL a -> AVL a
balance :: forall a. AlmostAVL a -> AVL a
balance t :: AlmostAVL a
t@(FF AVL a
l Node a
_ AVL a
r) = AlmostAVL a -> US -> AVL a
forall a. AlmostAVL a -> US -> AVL a
balance' AlmostAVL a
t (Int -> Int -> US
unbalancedState (AVL a -> Int
forall a. AVL a -> Int
height AVL a
l) (AVL a -> Int
forall a. AVL a -> Int
height AVL a
r))
balance' :: AlmostAVL a -> US -> AVL a
balance' :: forall a. AlmostAVL a -> US -> AVL a
balance' (FF AVL a
l Node a
n AVL a
r) US
NotUnbalanced = AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
l Node a
n AVL a
r
balance' t :: AlmostAVL a
t@(FF (F AVL a
ll Node a
_ AVL a
lr) Node a
_ AVL a
_) US
LeftUnbalanced =
AlmostAVL a -> US -> BS -> AVL a
forall a. AlmostAVL a -> US -> BS -> AVL a
rotate AlmostAVL a
t US
LeftUnbalanced (BS -> AVL a) -> BS -> AVL a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BS
balancedState (AVL a -> Int
forall a. AVL a -> Int
height AVL a
ll) (AVL a -> Int
forall a. AVL a -> Int
height AVL a
lr)
balance' t :: AlmostAVL a
t@(FF AVL a
_ Node a
_ (F AVL a
rl Node a
_ AVL a
rr)) US
RightUnbalanced =
AlmostAVL a -> US -> BS -> AVL a
forall a. AlmostAVL a -> US -> BS -> AVL a
rotate AlmostAVL a
t US
RightUnbalanced (BS -> AVL a) -> BS -> AVL a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> BS
balancedState (AVL a -> Int
forall a. AVL a -> Int
height AVL a
rl) (AVL a -> Int
forall a. AVL a -> Int
height AVL a
rr)
rotate :: AlmostAVL a -> US -> BS -> AVL a
rotate :: forall a. AlmostAVL a -> US -> BS -> AVL a
rotate (FF (F AVL a
ll Node a
lnode AVL a
lr) Node a
node AVL a
r) US
LeftUnbalanced BS
LeftHeavy = AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
ll Node a
lnode (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
lr Node a
node AVL a
r)
rotate (FF (F AVL a
ll Node a
lnode AVL a
lr) Node a
node AVL a
r) US
LeftUnbalanced BS
Balanced = AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
ll Node a
lnode (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
lr Node a
node AVL a
r)
rotate (FF AVL a
l Node a
node (F AVL a
rl Node a
rnode AVL a
rr)) US
RightUnbalanced BS
RightHeavy = AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
l Node a
node AVL a
rl) Node a
rnode AVL a
rr
rotate (FF AVL a
l Node a
node (F AVL a
rl Node a
rnode AVL a
rr)) US
RightUnbalanced BS
Balanced = AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
l Node a
node AVL a
rl) Node a
rnode AVL a
rr
rotate (FF (F AVL a
ll Node a
lnode (F AVL a
lrl Node a
lrnode AVL a
lrr)) Node a
node AVL a
r) US
LeftUnbalanced BS
RightHeavy =
AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
ll Node a
lnode AVL a
lrl) Node a
lrnode (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
lrr Node a
node AVL a
r)
rotate (FF AVL a
l Node a
node (F (F AVL a
rll Node a
rlnode AVL a
rlr) Node a
rnode AVL a
rr)) US
RightUnbalanced BS
LeftHeavy =
AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
l Node a
node AVL a
rll) Node a
rlnode (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
rlr Node a
rnode AVL a
rr)
insertAVL :: Show a => Int -> a -> AVL a -> AVL a
insertAVL :: forall a. Show a => Int -> a -> AVL a -> AVL a
insertAVL Int
x a
v AVL a
E = AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
forall a. AVL a
E (Int -> a -> Node a
forall a. Show a => Int -> a -> Node a
Node Int
x a
v) AVL a
forall a. AVL a
E
insertAVL Int
x' a
v' t :: AVL a
t@(F AVL a
_ (Node Int
x a
_) AVL a
_) = Node a -> AVL a -> Ordering -> AVL a
forall a. Node a -> AVL a -> Ordering -> AVL a
insertAVL' (Int -> a -> Node a
forall a. Show a => Int -> a -> Node a
Node Int
x' a
v') AVL a
t (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x' Int
x)
insertAVL' :: Node a -> AVL a -> Ordering -> AVL a
insertAVL' :: forall a. Node a -> AVL a -> Ordering -> AVL a
insertAVL' Node a
node (F AVL a
l Node a
_ AVL a
r) Ordering
EQ = AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
l Node a
node AVL a
r
insertAVL' Node a
n' (F AVL a
E Node a
n AVL a
r) Ordering
LT = AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
forall a. AVL a
E Node a
n' AVL a
forall a. AVL a
E) Node a
n AVL a
r)
insertAVL' n' :: Node a
n'@(Node Int
x a
_) (F l :: AVL a
l@(F AVL a
_ (Node Int
ln a
_) AVL a
_) Node a
n AVL a
r) Ordering
LT =
AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AlmostAVL a -> AVL a) -> AlmostAVL a -> AVL a
forall a b. (a -> b) -> a -> b
$ AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF (Node a -> AVL a -> Ordering -> AVL a
forall a. Node a -> AVL a -> Ordering -> AVL a
insertAVL' Node a
n' AVL a
l (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
ln)) Node a
n AVL a
r
insertAVL' Node a
n' (F AVL a
l Node a
n AVL a
E) Ordering
GT = AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF AVL a
l Node a
n (AVL a -> Node a -> AVL a -> AVL a
forall a. AVL a -> Node a -> AVL a -> AVL a
F AVL a
forall a. AVL a
E Node a
n' AVL a
forall a. AVL a
E))
insertAVL' n' :: Node a
n'@(Node Int
x a
_) (F AVL a
l Node a
n r :: AVL a
r@(F AVL a
_ (Node Int
rn a
_) AVL a
_)) Ordering
GT =
AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AlmostAVL a -> AVL a) -> AlmostAVL a -> AVL a
forall a b. (a -> b) -> a -> b
$ AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF AVL a
l Node a
n (Node a -> AVL a -> Ordering -> AVL a
forall a. Node a -> AVL a -> Ordering -> AVL a
insertAVL' Node a
n' AVL a
r (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
rn))
lookupAVL :: Int -> AVL a -> Maybe a
lookupAVL :: forall a. Int -> AVL a -> Maybe a
lookupAVL Int
_ AVL a
E = Maybe a
forall a. Maybe a
Nothing
lookupAVL Int
x t :: AVL a
t@(F AVL a
_ (Node Int
n a
_) AVL a
_) = Int -> AVL a -> Ordering -> Maybe a
forall a. Int -> AVL a -> Ordering -> Maybe a
lookupAVL' Int
x AVL a
t (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
n)
lookupAVL' :: Int -> AVL a -> Ordering -> Maybe a
lookupAVL' :: forall a. Int -> AVL a -> Ordering -> Maybe a
lookupAVL' Int
_ AVL a
E Ordering
_ = Maybe a
forall a. Maybe a
Nothing
lookupAVL' Int
_ (F AVL a
_ (Node Int
_ a
a) AVL a
_) Ordering
EQ = a -> Maybe a
forall a. a -> Maybe a
Just a
a
lookupAVL' Int
_ (F AVL a
E Node a
_ AVL a
_) Ordering
LT = Maybe a
forall a. Maybe a
Nothing
lookupAVL' Int
_ (F AVL a
_ Node a
_ AVL a
E) Ordering
GT = Maybe a
forall a. Maybe a
Nothing
lookupAVL' Int
x (F l :: AVL a
l@(F AVL a
_ (Node Int
ln a
_) AVL a
_) Node a
_ AVL a
_) Ordering
LT = Int -> AVL a -> Ordering -> Maybe a
forall a. Int -> AVL a -> Ordering -> Maybe a
lookupAVL' Int
x AVL a
l (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
ln)
lookupAVL' Int
x (F AVL a
_ Node a
_ r :: AVL a
r@(F AVL a
_ (Node Int
rn a
_) AVL a
_)) Ordering
GT = Int -> AVL a -> Ordering -> Maybe a
forall a. Int -> AVL a -> Ordering -> Maybe a
lookupAVL' Int
x AVL a
r (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
rn)
maxKeyDelete :: AVL a -> AVL a
maxKeyDelete :: forall a. AVL a -> AVL a
maxKeyDelete AVL a
E = AVL a
forall a. AVL a
E
maxKeyDelete (F AVL a
l Node a
_ AVL a
E) = AVL a
l
maxKeyDelete (F AVL a
l Node a
node r :: AVL a
r@F {}) =
AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AlmostAVL a -> AVL a) -> AlmostAVL a -> AVL a
forall a b. (a -> b) -> a -> b
$ AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF AVL a
l Node a
node (AVL a -> AVL a
forall a. AVL a -> AVL a
maxKeyDelete AVL a
r)
maxNode :: AVL a -> Maybe (Node a)
maxNode :: forall a. AVL a -> Maybe (Node a)
maxNode AVL a
E = Maybe (Node a)
forall a. Maybe a
Nothing
maxNode (F AVL a
_ Node a
node AVL a
E) = Node a -> Maybe (Node a)
forall a. a -> Maybe a
Just Node a
node
maxNode (F AVL a
_ (Node Int
_ a
_) r :: AVL a
r@F {}) = AVL a -> Maybe (Node a)
forall a. AVL a -> Maybe (Node a)
maxNode AVL a
r
deleteAVL :: Int -> AVL a -> AVL a
deleteAVL :: forall a. Int -> AVL a -> AVL a
deleteAVL Int
_ AVL a
E = AVL a
forall a. AVL a
E
deleteAVL Int
x t :: AVL a
t@(F AVL a
_ (Node Int
n a
_) AVL a
_) = Int -> AVL a -> Ordering -> AVL a
forall a. Int -> AVL a -> Ordering -> AVL a
deleteAVL' Int
x AVL a
t (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
n)
deleteAVL' :: Int -> AVL a -> Ordering -> AVL a
deleteAVL' :: forall a. Int -> AVL a -> Ordering -> AVL a
deleteAVL' Int
_ (F AVL a
E Node a
_ AVL a
E) Ordering
EQ = AVL a
forall a. AVL a
E
deleteAVL' Int
_ (F AVL a
E Node a
_ r :: AVL a
r@F {}) Ordering
EQ = AVL a
r
deleteAVL' Int
_ (F l :: AVL a
l@F {} Node a
_ AVL a
E) Ordering
EQ = AVL a
l
deleteAVL' Int
_ (F l :: AVL a
l@F {} Node a
_ r :: AVL a
r@F {}) Ordering
EQ =
AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AlmostAVL a -> AVL a) -> AlmostAVL a -> AVL a
forall a b. (a -> b) -> a -> b
$ AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF (AVL a -> AVL a
forall a. AVL a -> AVL a
maxKeyDelete AVL a
l) Node a
mNode AVL a
r
where
Just Node a
mNode = AVL a -> Maybe (Node a)
forall a. AVL a -> Maybe (Node a)
maxNode AVL a
l
deleteAVL' Int
_ t :: AVL a
t@(F AVL a
E Node a
_ AVL a
_) Ordering
LT = AVL a
t
deleteAVL' Int
x (F l :: AVL a
l@(F AVL a
_ (Node Int
ln a
_) AVL a
_) Node a
node AVL a
r) Ordering
LT =
AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AlmostAVL a -> AVL a) -> AlmostAVL a -> AVL a
forall a b. (a -> b) -> a -> b
$ AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF (Int -> AVL a -> Ordering -> AVL a
forall a. Int -> AVL a -> Ordering -> AVL a
deleteAVL' Int
x AVL a
l (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
ln)) Node a
node AVL a
r
deleteAVL' Int
_ t :: AVL a
t@(F AVL a
_ Node a
_ AVL a
E) Ordering
GT = AVL a
t
deleteAVL' Int
x (F AVL a
l Node a
node r :: AVL a
r@(F AVL a
_ (Node Int
rn a
_) AVL a
_)) Ordering
GT =
AlmostAVL a -> AVL a
forall a. AlmostAVL a -> AVL a
balance (AlmostAVL a -> AVL a) -> AlmostAVL a -> AVL a
forall a b. (a -> b) -> a -> b
$ AVL a -> Node a -> AVL a -> AlmostAVL a
forall a. AVL a -> Node a -> AVL a -> AlmostAVL a
FF AVL a
l Node a
node (Int -> AVL a -> Ordering -> AVL a
forall a. Int -> AVL a -> Ordering -> AVL a
deleteAVL' Int
x AVL a
r (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
rn))