-- |
-- Copyright   :  (c) Adrian Hey 2004,2005
-- License     :  BSD3
--
-- AVL tree height related utilities.
--
-- The functions defined here are not exported by the main Data.Tree.AVL module
-- because they violate the policy for AVL tree equality used elsewhere in this library.
-- You need to import this module explicitly if you want to use any of these functions.
{-# OPTIONS_HADDOCK hide #-}
module Data.Tree.AVL.Height
        (-- * AVL tree height utilities.
         height,addHeight,compareHeight,
        ) where

import Data.Tree.AVL.Internals.Types(AVL(..))

import GHC.Base
#include "ghcdefs.h"

-- | Determine the height of an AVL tree.
--
-- Complexity: O(log n)
{-# INLINE height #-}
height :: AVL e -> UINT
height :: forall e. AVL e -> Int#
height AVL e
t = Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight L(0AVL e
) t

-- | Adds the height of a tree to the first argument.
--
-- Complexity: O(log n)
addHeight :: UINT -> AVL e -> UINT
addHeight :: forall e. Int# -> AVL e -> Int#
addHeight Int#
h  AVL e
E        = Int#
h
addHeight Int#
h (N AVL e
l e
_ AVL e
_) = Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight INCINT2(h) l
addHeight Int#
h (Z AVL e
l e
_ AVL e
_) = Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight INCINT1(h) l
addHeight Int#
h (P AVL e
_ e
_ AVL e
r) = Int# -> AVL e -> Int#
forall e. Int# -> AVL e -> Int#
addHeight INCINT2(h) r

-- | A fast algorithm for comparing the heights of two trees. This algorithm avoids the need
-- to compute the heights of both trees and should offer better performance if the trees differ
-- significantly in height. But if you need the heights anyway it will be quicker to just evaluate
-- them both and compare the results.
--
-- Complexity: O(log n), where n is the size of the smaller of the two trees.
compareHeight :: AVL a -> AVL b -> Ordering
compareHeight :: forall a b. AVL a -> AVL b -> Ordering
compareHeight = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch L(0) where                       -- d = hA-hB
 ch :: UINT -> AVL a -> AVL b -> Ordering
 ch :: forall a b. Int# -> AVL a -> AVL b -> Ordering
ch Int#
d  AVL a
E           AVL b
E          = Int# -> Int# -> Ordering
COMPAREUINT Int#
d L(0)
 ch Int#
d  AVL a
E          (N AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL b -> Ordering
forall {e}. Int# -> AVL e -> Ordering
chA DECINT2(d) l1
 ch Int#
d  AVL a
E          (Z AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL b -> Ordering
forall {e}. Int# -> AVL e -> Ordering
chA DECINT1(d) l1
 ch Int#
d  AVL a
E          (P AVL b
_  b
_ AVL b
r1) = Int# -> AVL b -> Ordering
forall {e}. Int# -> AVL e -> Ordering
chA DECINT2(d) r1
 ch Int#
d (N AVL a
l0 a
_ AVL a
_ )  AVL b
E          = Int# -> AVL a -> Ordering
forall {e}. Int# -> AVL e -> Ordering
chB INCINT2(d) l0
 ch Int#
d (N AVL a
l0 a
_ AVL a
_ ) (N AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch          Int#
d  AVL a
l0 AVL b
l1
 ch Int#
d (N AVL a
l0 a
_ AVL a
_ ) (Z AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch  INCINT1(d) l0 l1
 ch Int#
d (N AVL a
l0 a
_ AVL a
_ ) (P AVL b
_  b
_ AVL b
r1) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch          Int#
d  AVL a
l0 AVL b
r1
 ch Int#
d (Z AVL a
l0 a
_ AVL a
_ )  AVL b
E          = Int# -> AVL a -> Ordering
forall {e}. Int# -> AVL e -> Ordering
chB INCINT1(d) l0
 ch Int#
d (Z AVL a
l0 a
_ AVL a
_ ) (N AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch  DECINT1(d) l0 l1
 ch Int#
d (Z AVL a
l0 a
_ AVL a
_ ) (Z AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch          Int#
d  AVL a
l0 AVL b
l1
 ch Int#
d (Z AVL a
l0 a
_ AVL a
_ ) (P AVL b
_  b
_ AVL b
r1) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch  DECINT1(d) l0 r1
 ch Int#
d (P AVL a
_  a
_ AVL a
r0)  AVL b
E          = Int# -> AVL a -> Ordering
forall {e}. Int# -> AVL e -> Ordering
chB INCINT2(d) r0
 ch Int#
d (P AVL a
_  a
_ AVL a
r0) (N AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch          Int#
d  AVL a
r0 AVL b
l1
 ch Int#
d (P AVL a
_  a
_ AVL a
r0) (Z AVL b
l1 b
_ AVL b
_ ) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch  INCINT1(d) r0 l1
 ch Int#
d (P AVL a
_  a
_ AVL a
r0) (P AVL b
_  b
_ AVL b
r1) = Int# -> AVL a -> AVL b -> Ordering
forall a b. Int# -> AVL a -> AVL b -> Ordering
ch          Int#
d  AVL a
r0 AVL b
r1
 -- Tree A ended first, continue with Tree B until hA-hB<0, or Tree B ends
 chA :: Int# -> AVL e -> Ordering
chA Int#
d AVL e
tB = case Int# -> Int# -> Ordering
COMPAREUINT Int#
d L(0) of
            Ordering
LT ->             Ordering
LT
            Ordering
EQ -> case AVL e
tB of
                  AVL e
E        -> Ordering
EQ
                  AVL e
_        -> Ordering
LT
            Ordering
GT -> case AVL e
tB of
                  AVL e
E        -> Ordering
GT
                  N AVL e
l e
_ AVL e
_  -> Int# -> AVL e -> Ordering
chA DECINT2(d) l
                  Z AVL e
l e
_ AVL e
_  -> Int# -> AVL e -> Ordering
chA DECINT1(d) l
                  P AVL e
_ e
_ AVL e
r  -> Int# -> AVL e -> Ordering
chA DECINT2(d) r
 -- Tree B ended first, continue with Tree A until hA-hB>0, or Tree A ends
 chB :: Int# -> AVL e -> Ordering
chB Int#
d AVL e
tA = case Int# -> Int# -> Ordering
COMPAREUINT Int#
d L(0) of
            Ordering
GT ->             Ordering
GT
            Ordering
EQ -> case AVL e
tA of
                  AVL e
E        -> Ordering
EQ
                  AVL e
_        -> Ordering
GT
            Ordering
LT -> case AVL e
tA of
                  AVL e
E        -> Ordering
LT
                  N AVL e
l e
_ AVL e
_  -> Int# -> AVL e -> Ordering
chB INCINT2(d) l
                  Z AVL e
l e
_ AVL e
_  -> Int# -> AVL e -> Ordering
chB INCINT1(d) l
                  P AVL e
_ e
_ AVL e
r  -> Int# -> AVL e -> Ordering
chB INCINT2(d) r