AvlTree 3.0 → 3.1
raw patch · 12 files changed
+444/−491 lines, 12 filesdep −containersdep ~COrderingPVP ok
version bump matches the API change (PVP)
Dependencies removed: containers
Dependency ranges changed: COrdering
API changes (from Hackage documentation)
- Data.Tree.AVL: avl2Map :: AVL (key, val) -> Map key val
- Data.Tree.AVL: avl2Set :: AVL a -> Set a
- Data.Tree.AVL: genSortAscending :: (e -> e -> COrdering e) -> [e] -> [e]
- Data.Tree.AVL: genSortDescending :: (e -> e -> COrdering e) -> [e] -> [e]
- Data.Tree.AVL: map2AVL :: Map key val -> AVL (key, val)
- Data.Tree.AVL: set2AVL :: Set a -> AVL a
+ Data.Tree.AVL: EmptyBP :: !!Int# -> BinPath a
+ Data.Tree.AVL: FullBP :: !!Int# -> a -> BinPath a
+ Data.Tree.AVL: data BinPath a
+ Data.Tree.AVL: deletePath :: Int# -> AVL e -> AVL e
+ Data.Tree.AVL: genFindPath :: (e -> Ordering) -> AVL e -> Int#
+ Data.Tree.AVL: genOpenPath :: (e -> Ordering) -> AVL e -> BinPath e
+ Data.Tree.AVL: genOpenPathWith :: (e -> COrdering a) -> AVL e -> BinPath a
+ Data.Tree.AVL: insertPath :: Int# -> e -> AVL e -> AVL e
+ Data.Tree.AVL: readPath :: Int# -> AVL e -> e
+ Data.Tree.AVL: writePath :: Int# -> e -> AVL e -> AVL e
Files
- AvlTree.cabal +8/−8
- CHANGELOG +7/−3
- Data/Tree/AVL.hs +7/−53
- Data/Tree/AVL/BinPath.hs +377/−0
- Data/Tree/AVL/Delete.hs +1/−1
- Data/Tree/AVL/Internals/BinPath.hs +0/−376
- Data/Tree/AVL/Internals/DelUtils.hs +1/−1
- Data/Tree/AVL/List.hs +0/−27
- Data/Tree/AVL/Push.hs +1/−1
- Data/Tree/AVL/Write.hs +1/−1
- Data/Tree/AVL/Zipper.hs +1/−1
- Data/Tree/AVLX.hs +40/−19
AvlTree.cabal view
@@ -1,31 +1,31 @@ Name: AvlTree-Version: 3.0+Version: 3.1 Cabal-Version: >= 1.2 Build-Type: Simple License: BSD3 License-File: LICENSE Copyright: (c) Adrian Hey 2004-2008 Author: Adrian Hey-Maintainer: http://homepages.nildram.co.uk/~ahey/em.png+Maintainer: Stability: Stable-Homepage: http://www.haskell.org/haskellwiki/AvlTree+Homepage: Package-Url: Synopsis: Balanced binary trees using the AVL algorithm.-Description: A comprehensive library and efficient implementation of AVL trees. The raw AVL+Description: A comprehensive and efficient implementation of AVL trees. The raw AVL API has been designed with efficiency and generality in mind, not elagance or safety. It contains all the stuff you really don't want to write yourself if you can avoid it. This library may be useful for rolling your own Sets, Maps, Sequences,- Queues (for example).+ Queues (for example). This package is no longer actively maintained and will be+ tagged as such as soon as Hackage has this feature. Category: Data Structures Tested-With: GHC == 6.8.2, GHC == 6.8.1 Data-Files: Extra-Source-Files: AUTHORS, CHANGELOG, MasterTable.txt, Test/Test.hs, include/ghcdefs.h, include/h98defs.h Extra-Tmp-Files:-Author: Adrian Hey Library Buildable: True- Build-Depends: base, containers, COrdering >= 2.1+ Build-Depends: base, COrdering >= 2.2 Exposed-Modules: Data.Tree.AVL, Data.Tree.AVL.Test.AllTests, Data.Tree.AVL.Test.Counter@@ -42,8 +42,8 @@ Data.Tree.AVL.Types, Data.Tree.AVL.Write, Data.Tree.AVL.Zipper,+ Data.Tree.AVL.BinPath, Data.Tree.AVL.Test.Utils,- Data.Tree.AVL.Internals.BinPath, Data.Tree.AVL.Internals.DelUtils, Data.Tree.AVL.Internals.HAVL, Data.Tree.AVL.Internals.HJoin,
CHANGELOG view
@@ -9,6 +9,10 @@ * Eq and Ord Instances now based on strict structural equality (derived) * Exposed height related functions - - - +3.1 (Final release) +------------------- +* Exposed BinPath primitives. +* Removed AVL tree based sorts. +* Removed Data.Map/Set conversions. This eliminates the containers package dependency. +* Removed link to Haskell wiki homepage as this will never be done. +* Removed link to maintainer email.
Data/Tree/AVL.hs view
@@ -36,15 +36,6 @@ ----------------------------------------------------------------------------- module Data.Tree.AVL (module Data.Tree.AVL.Types,-- -- * Conversion utilities-- -- ** Conversion between /sorted/ AVL trees and Data.Set- set2AVL,avl2Set,-- -- ** Conversion between /sorted/ AVL trees of (key,value) pairs and Data.Map- map2AVL,avl2Map,- module Data.Tree.AVL.Size, module Data.Tree.AVL.Height, module Data.Tree.AVL.Read,@@ -62,13 +53,15 @@ -- * Tree parameter utilities. minElements,maxElements,++ -- * Low level Binary Path utilities.+ -- | This is the low level (unsafe) API used by the 'BAVL' type.+ BinPath(..),genFindPath,genOpenPath,genOpenPathWith,readPath,writePath,insertPath,deletePath,+ ) where import Prelude -- so haddock finds the symbols there -import qualified Data.Set as BaseSet-import qualified Data.Map as BaseMap- import Data.Tree.AVL.Types hiding (E,N,P,Z) import Data.Tree.AVL.Size import Data.Tree.AVL.Height@@ -82,53 +75,14 @@ import Data.Tree.AVL.Set import Data.Tree.AVL.Zipper import Data.Tree.AVL.Test.Utils(isBalanced,isSorted,isSortedOK,minElements,maxElements)+import Data.Tree.AVL.BinPath(BinPath(..),genFindPath,genOpenPath,genOpenPathWith,readPath,writePath,insertPath)+import Data.Tree.AVL.Internals.DelUtils(deletePath) #if __GLASGOW_HASKELL__ > 604 import Data.Traversable instance Traversable AVL where traverse = traverseAVL #endif---- | Convert a 'Data.Set.Set' (from the base package Data.Set module) to a sorted AVL tree.--- Elements and element ordering are preserved (ascending order is left to right).------ Complexity: O(n)-set2AVL :: BaseSet.Set a -> AVL a-set2AVL set = asTreeLenL (BaseSet.size set) (BaseSet.toAscList set)---- | Convert a /sorted/ AVL tree to a 'Data.Set.Set' (from the base package Data.Set module).--- Elements and element ordering are preserved.------ Complexity: O(n)-avl2Set :: AVL a -> BaseSet.Set a-avl2Set avl = BaseSet.fromDistinctAscList (asListL avl)---- | Convert a 'Data.Map.Map' to a sorted (by key) AVL tree.--- Elements and element ordering are preserved (ascending order is left to right).------ Complexity: O(n)-map2AVL :: BaseMap.Map key val -> AVL (key,val)-map2AVL mp = asTreeLenL (BaseMap.size mp) (BaseMap.toAscList mp)---- | Convert a /sorted/ (by key) AVL tree to a 'Data.Map.Map' (from the base package Data.Map module).--- Elements and element ordering are preserved.------ Complexity: O(n)-avl2Map :: AVL (key,val) -> BaseMap.Map key val-avl2Map avl = BaseMap.fromDistinctAscList (asListL avl)--{- Not any more!--- | Eq is based on equality of the lists produced by 'asListL'. This definition has been placed here--- to avoid introducing cyclic dependency between Types.hs and List.hs-instance Eq e => Eq (AVL e) where- x == y = (size x == size y) && (asListL x == asListL y) -- Compare sizes first as this will usually resolve it---- | Ordering is based on ordering of the lists produced by 'asListL'. This definition has been placed here--- to avoid introducing cyclic dependency between Types.hs and List.hs-instance Ord e => Ord (AVL e) where- x `compare` y = asListL x `compare` asListL y--}- -- | Show is based on showing the list produced by 'asListL'. This definition has been placed here -- to avoid introducing cyclic dependency between Types.hs and List.hs
+ Data/Tree/AVL/BinPath.hs view
@@ -0,0 +1,377 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Data.Tree.AVL.Internals.BinPath+-- Copyright : (c) Adrian Hey 2005+-- License : BSD3+--+-- Maintainer : http://homepages.nildram.co.uk/~ahey/em.png+-- Stability : stable+-- Portability : portable+--+-- This module provides a cheap but extremely limited and dangerous alternative+-- to using the Zipper. A BinPath provides a way of finding a particular element+-- in an AVL tree again without doing any comparisons. But a BinPath is ONLY VALID+-- IF THE TREE SHAPE DOES NOT CHANGE.+--+-- See the BAVL type in Data.Tree.AVL.Zipper module for a safer wrapper round these+-- functions.+-----------------------------------------------------------------------------+module Data.Tree.AVL.BinPath+ (BinPath(..),genFindPath,genOpenPath,genOpenPathWith,readPath,writePath,insertPath,+ -- These are used by deletePath, which currently resides in Data.Tree.AVL.Internals.DelUtils+ sel,goL,goR,+ ) where+-- N.B. The deletePath function should really be here too, but has been put+-- in Data.Tree.AVL.Internals.DelUtils instead because deletion is a tangled web of circular+-- depencency.++import Data.Tree.AVL.Types(AVL(..))+import Data.COrdering++#if __GLASGOW_HASKELL__+import GHC.Base+#include "ghcdefs.h"++-- Test path LSB+bit0 :: Int# -> Bool+{-# INLINE bit0 #-}+bit0 p = word2Int# (and# (int2Word# p) (int2Word# 1#)) ==# 1#++-- A pseudo comparison..+-- N.B. If the path was bit reversed, this could be a straight comparison.??+sel :: Int# -> Ordering+{-# INLINE sel #-}+sel p = if p ==# 0# then EQ+ else if bit0 p then LT -- Left if Bit 0 == 1+ else GT -- Right if Bit 0 == 0+++-- Modify path for entering left subtree+goL :: Int# -> Int#+{-# INLINE goL #-}+goL p = iShiftRL# p 1#++-- Modify path for entering right subtree+goR :: Int# -> Int#+{-# INLINE goR #-}+goR p = iShiftRL# (p -# 1#) 1#++#else+#include "h98defs.h"+import Data.Bits((.&.),shiftL)++-- A pseudo comparison..+-- N.B. If the path was bit reversed, this could be a straight comparison.??+sel :: Int -> Ordering+{-# INLINE sel #-}+sel p = if p == 0 then EQ+ else if bit0 p then LT -- Left if Bit 0 == 1+ else GT -- Right if Bit 0 == 0+bit0 :: Int -> Bool+{-# INLINE bit0 #-}+bit0 p = (p .&. 1) == 1++-- Modify path for entering left subtree+goL :: Int -> Int+{-# INLINE goL #-}+goL p = shiftL p 1++-- Modify path for entering right subtree+goR :: Int -> Int+{-# INLINE goR #-}+goR p = shiftL (p-1) 1+#endif++-- | A BinPath is full if the search succeeded, empty otherwise.+data BinPath a = FullBP {-# UNPACK #-} !UINT a -- Found+ | EmptyBP {-# UNPACK #-} !UINT -- Not Found++{-------------------------------------------------------------------------------------------+ Notes:+--------------------------------------------------------------------------------------------+The Binary paths are based on an indexing scheme that:+ 1- Uniquely identifies each tree node+ 2- Provides a simple algorithm for path generation.+ 3- Provides a simple algorithm to locate a node in the tree, given it's path.++Imagine an infinite Binary Tree, with nodes indexed as follows:++ _____00_____ <- d=1+ / \+ _01_ _02_ <- d=2+ / \ / \+ 03 05 04 06 <- d=4+ / \ / \ / \ / \+ 07 11 09 13 08 12 10 14 <- d=8+ <-------- More Layers ------->++To generate the node index (path) as we move down the tree we..+ 1- Initialise index (i) to 0, and a parameter (d) to 1+ 2- If we've arrived where we want, output i.+ 3- Either Move left: i <- i+d, d <- 2d, goto 2+ or Move right: i <- i+2d, d <- 2d, goto 2++To find a node, given its index (path) i, we..+ 1- If i=0 then stop, we've arrived.+ 2- If i is odd then move left , i <- (i-1)>>1, goto 1 -- (i-1)>>1 = i>>1 if i is odd+ else move right, i <- (i-1)>>1, goto 1 -- (i-1)>>1 = (i>>1)-1 if i is even+Examples:+ i=05: (left ,i<-2):(right,i<-0):(stop)+ i=12: (right,i<-5):(left ,i<-2):(right,i<-0):(stop)++See also: pathTree in Data.Tree.AVL.Test.Utils for recursive implementation of the indexing scheme.+--------------------------------------------------------------------------------------------}++-- | Find the path to a AVL tree element, returns -1 (invalid path) if element not found+--+-- Complexity: O(log n)+genFindPath :: (e -> Ordering) -> AVL e -> UINT+-- ?? What about strictness if UINT is boxed (i.e. non-ghc)?+genFindPath c t = find L(1) L(0) t where+ find _ _ E = L(-1)+ find d i (N l e r) = find' d i l e r+ find d i (Z l e r) = find' d i l e r+ find d i (P l e r) = find' d i l e r+ find' d i l e r = case c e of+ LT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d ) l+ EQ -> i+ GT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d_) r -- d_ = 2d++-- | Get the BinPath of an element using the supplied selector.+--+-- Complexity: O(log n)+genOpenPath :: (e -> Ordering) -> AVL e -> BinPath e+genOpenPath c t = find L(1) L(0) t where+ find _ i E = EmptyBP i+ find d i (N l e r) = find' d i l e r+ find d i (Z l e r) = find' d i l e r+ find d i (P l e r) = find' d i l e r+ find' d i l e r = case c e of+ LT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d ) l+ EQ -> FullBP i e+ GT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d_) r -- d_ = 2d++-- | Get the BinPath of an element using the supplied (combining) selector.+--+-- Complexity: O(log n)+genOpenPathWith :: (e -> COrdering a) -> AVL e -> BinPath a+genOpenPathWith c t = find L(1) L(0) t where+ find _ i E = EmptyBP i+ find d i (N l e r) = find' d i l e r+ find d i (Z l e r) = find' d i l e r+ find d i (P l e r) = find' d i l e r+ find' d i l e r = case c e of+ Lt -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d ) l+ Eq a -> FullBP i a+ Gt -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d_) r -- d_ = 2d++-- | Overwrite a tree element. Assumes the path bits were extracted from 'FullBP' constructor.+-- Raises an error if the path leads to an empty tree.+--+-- N.B This operation does not change tree shape (no insertion occurs).+--+-- Complexity: O(log n)+writePath :: UINT -> e -> AVL e -> AVL e+writePath i0 e' t = wp i0 t where+ wp L(0) E = error "writePath: Bug0" -- Needed to force strictness in path+ wp L(0) (N l _ r) = N l e' r+ wp L(0) (Z l _ r) = Z l e' r+ wp L(0) (P l _ r) = P l e' r+ wp _ E = error "writePath: Bug1"+ wp i (N l e r) = if bit0 i then let l' = wp (goL i) l in l' `seq` N l' e r+ else let r' = wp (goR i) r in r' `seq` N l e r'+ wp i (Z l e r) = if bit0 i then let l' = wp (goL i) l in l' `seq` Z l' e r+ else let r' = wp (goR i) r in r' `seq` Z l e r'+ wp i (P l e r) = if bit0 i then let l' = wp (goL i) l in l' `seq` P l' e r+ else let r' = wp (goR i) r in r' `seq` P l e r'++-- | Read a tree element. Assumes the path bits were extracted from 'FullBP' constructor.+-- Raises an error if the path leads to an empty tree.+--+-- Complexity: O(log n)+readPath :: UINT -> AVL e -> e+readPath L(0) E = error "readPath: Bug0" -- Needed to force strictness in path+readPath L(0) (N _ e _) = e+readPath L(0) (Z _ e _) = e+readPath L(0) (P _ e _) = e+readPath _ E = error "readPath: Bug1"+readPath i (N l _ r) = readPath_ i l r+readPath i (Z l _ r) = readPath_ i l r+readPath i (P l _ r) = readPath_ i l r+readPath_ :: UINT -> AVL e -> AVL e -> e+readPath_ i l r = if bit0 i then readPath (goL i) l+ else readPath (goR i) r++-- | Inserts a new tree element. Assumes the path bits were extracted from a 'EmptyBP' constructor.+-- This function replaces the first Empty node it encounters with the supplied value, regardless+-- of the current path bits (which are not checked). DO NOT USE THIS FOR REPLACING ELEMENTS ALREADY+-- PRESENT IN THE TREE (use 'writePath' for this).+--+-- Complexity: O(log n)+insertPath :: UINT -> e -> AVL e -> AVL e+insertPath i0 e0 t = put i0 t where+ ----------------------------- LEVEL 0 ---------------------------------+ -- put --+ -----------------------------------------------------------------------+ put _ E = Z E e0 E+ put i (N l e r) = putN i l e r+ put i (Z l e r) = putZ i l e r+ put i (P l e r) = putP i l e r++ ----------------------------- LEVEL 1 ---------------------------------+ -- putN, putZ, putP --+ -----------------------------------------------------------------------+ -- Put in (N l e r), BF=-1 , (never returns P)+ putN i l e r = if bit0 i then putNL i l e r -- put in L subtree+ else putNR i l e r -- put in R subtree++ -- Put in (Z l e r), BF= 0+ putZ i l e r = if bit0 i then putZL i l e r -- put in L subtree+ else putZR i l e r -- put in R subtree++ -- Put in (P l e r), BF=+1 , (never returns N)+ putP i l e r = if bit0 i then putPL i l e r -- put in L subtree+ else putPR i l e r -- put in R subtree++ ----------------------------- LEVEL 2 ---------------------------------+ -- putNL, putZL, putPL --+ -- putNR, putZR, putPR --+ -----------------------------------------------------------------------++ -- (putNL l e r): Put in L subtree of (N l e r), BF=-1 (Never requires rebalancing) , (never returns P)+ {-# INLINE putNL #-}+ putNL _ E e r = Z (Z E e0 E) e r -- L subtree empty, H:0->1, parent BF:-1-> 0+ putNL i (N ll le lr) e r = let l' = putN (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:-1->-1+ in l' `seq` N l' e r+ putNL i (P ll le lr) e r = let l' = putP (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:-1->-1+ in l' `seq` N l' e r+ putNL i (Z ll le lr) e r = let l' = putZ (goL i) ll le lr -- L subtree BF= 0, so need to look for changes+ in case l' of+ E -> error "insertPath: Bug0" -- impossible+ Z _ _ _ -> N l' e r -- L subtree BF:0-> 0, H:h->h , parent BF:-1->-1+ _ -> Z l' e r -- L subtree BF:0->+/-1, H:h->h+1, parent BF:-1-> 0++ -- (putZL l e r): Put in L subtree of (Z l e r), BF= 0 (Never requires rebalancing) , (never returns N)+ {-# INLINE putZL #-}+ putZL _ E e r = P (Z E e0 E) e r -- L subtree H:0->1, parent BF: 0->+1+ putZL i (N ll le lr) e r = let l' = putN (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF: 0-> 0+ in l' `seq` Z l' e r+ putZL i (P ll le lr) e r = let l' = putP (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF: 0-> 0+ in l' `seq` Z l' e r+ putZL i (Z ll le lr) e r = let l' = putZ (goL i) ll le lr -- L subtree BF= 0, so need to look for changes+ in case l' of+ E -> error "insertPath: Bug1" -- impossible+ Z _ _ _ -> Z l' e r -- L subtree BF: 0-> 0, H:h->h , parent BF: 0-> 0+ _ -> P l' e r -- L subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->+1++ -- (putZR l e r): Put in R subtree of (Z l e r), BF= 0 (Never requires rebalancing) , (never returns P)+ {-# INLINE putZR #-}+ putZR _ l e E = N l e (Z E e0 E) -- R subtree H:0->1, parent BF: 0->-1+ putZR i l e (N rl re rr) = let r' = putN (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF: 0-> 0+ in r' `seq` Z l e r'+ putZR i l e (P rl re rr) = let r' = putP (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF: 0-> 0+ in r' `seq` Z l e r'+ putZR i l e (Z rl re rr) = let r' = putZ (goR i) rl re rr -- R subtree BF= 0, so need to look for changes+ in case r' of+ E -> error "insertPath: Bug2" -- impossible+ Z _ _ _ -> Z l e r' -- R subtree BF: 0-> 0, H:h->h , parent BF: 0-> 0+ _ -> N l e r' -- R subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->-1++ -- (putPR l e r): Put in R subtree of (P l e r), BF=+1 (Never requires rebalancing) , (never returns N)+ {-# INLINE putPR #-}+ putPR _ l e E = Z l e (Z E e0 E) -- R subtree empty, H:0->1, parent BF:+1-> 0+ putPR i l e (N rl re rr) = let r' = putN (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:+1->+1+ in r' `seq` P l e r'+ putPR i l e (P rl re rr) = let r' = putP (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:+1->+1+ in r' `seq` P l e r'+ putPR i l e (Z rl re rr) = let r' = putZ (goR i) rl re rr -- R subtree BF= 0, so need to look for changes+ in case r' of+ E -> error "insertPath: Bug3" -- impossible+ Z _ _ _ -> P l e r' -- R subtree BF:0-> 0, H:h->h , parent BF:+1->+1+ _ -> Z l e r' -- R subtree BF:0->+/-1, H:h->h+1, parent BF:+1-> 0++ -------- These 2 cases (NR and PL) may need rebalancing if they go to LEVEL 3 ---------++ -- (putNR l e r): Put in R subtree of (N l e r), BF=-1 , (never returns P)+ {-# INLINE putNR #-}+ putNR _ _ _ E = error "insertPath: Bug4" -- impossible if BF=-1+ putNR i l e (N rl re rr) = let r' = putN (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:-1->-1+ in r' `seq` N l e r'+ putNR i l e (P rl re rr) = let r' = putP (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:-1->-1+ in r' `seq` N l e r'+ putNR i l e (Z rl re rr) = let i' = goR i in if bit0 i' then putNRL i' l e rl re rr -- RL (never returns P)+ else putNRR i' l e rl re rr -- RR (never returns P)++ -- (putPL l e r): Put in L subtree of (P l e r), BF=+1 , (never returns N)+ {-# INLINE putPL #-}+ putPL _ E _ _ = error "insertPath: Bug5" -- impossible if BF=+1+ putPL i (N ll le lr) e r = let l' = putN (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:+1->+1+ in l' `seq` P l' e r+ putPL i (P ll le lr) e r = let l' = putP (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:+1->+1+ in l' `seq` P l' e r+ putPL i (Z ll le lr) e r = let i' = goL i in if bit0 i' then putPLL i' ll le lr e r -- LL (never returns N)+ else putPLR i' ll le lr e r -- LR (never returns N)++ ----------------------------- LEVEL 3 ---------------------------------+ -- putNRR, putPLL --+ -- putNRL, putPLR --+ -----------------------------------------------------------------------++ -- (putNRR l e rl re rr): Put in RR subtree of (N l e (Z rl re rr)) , (never returns P)+ {-# INLINE putNRR #-}+ putNRR _ l e rl re E = Z (Z l e rl) re (Z E e0 E) -- l and rl must also be E, special CASE RR!!+ putNRR i l e rl re (N rrl rre rrr) = let rr' = putN (goR i) rrl rre rrr -- RR subtree BF<>0, H:h->h, so no change+ in rr' `seq` N l e (Z rl re rr')+ putNRR i l e rl re (P rrl rre rrr) = let rr' = putP (goR i) rrl rre rrr -- RR subtree BF<>0, H:h->h, so no change+ in rr' `seq` N l e (Z rl re rr')+ putNRR i l e rl re (Z rrl rre rrr) = let rr' = putZ (goR i) rrl rre rrr -- RR subtree BF= 0, so need to look for changes+ in case rr' of+ E -> error "insertPath: Bug6" -- impossible+ Z _ _ _ -> N l e (Z rl re rr') -- RR subtree BF: 0-> 0, H:h->h, so no change+ _ -> Z (Z l e rl) re rr' -- RR subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE RR !!++ -- (putPLL ll le lr e r): Put in LL subtree of (P (Z ll le lr) e r) , (never returns N)+ {-# INLINE putPLL #-}+ putPLL _ E le lr e r = Z (Z E e0 E) le (Z lr e r) -- r and lr must also be E, special CASE LL!!+ putPLL i (N lll lle llr) le lr e r = let ll' = putN (goL i) lll lle llr -- LL subtree BF<>0, H:h->h, so no change+ in ll' `seq` P (Z ll' le lr) e r+ putPLL i (P lll lle llr) le lr e r = let ll' = putP (goL i) lll lle llr -- LL subtree BF<>0, H:h->h, so no change+ in ll' `seq` P (Z ll' le lr) e r+ putPLL i (Z lll lle llr) le lr e r = let ll' = putZ (goL i) lll lle llr -- LL subtree BF= 0, so need to look for changes+ in case ll' of+ E -> error "insertPath: Bug7" -- impossible+ Z _ _ _ -> P (Z ll' le lr) e r -- LL subtree BF: 0-> 0, H:h->h, so no change+ _ -> Z ll' le (Z lr e r) -- LL subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE LL !!++ -- (putNRL l e rl re rr): Put in RL subtree of (N l e (Z rl re rr)) , (never returns P)+ {-# INLINE putNRL #-}+ putNRL _ l e E re rr = Z (Z l e E) e0 (Z E re rr) -- l and rr must also be E, special CASE LR !!+ putNRL i l e (N rll rle rlr) re rr = let rl' = putN (goL i) rll rle rlr -- RL subtree BF<>0, H:h->h, so no change+ in rl' `seq` N l e (Z rl' re rr)+ putNRL i l e (P rll rle rlr) re rr = let rl' = putP (goL i) rll rle rlr -- RL subtree BF<>0, H:h->h, so no change+ in rl' `seq` N l e (Z rl' re rr)+ putNRL i l e (Z rll rle rlr) re rr = let rl' = putZ (goL i) rll rle rlr -- RL subtree BF= 0, so need to look for changes+ in case rl' of+ E -> error "insertPath: Bug8" -- impossible+ Z _ _ _ -> N l e (Z rl' re rr) -- RL subtree BF: 0-> 0, H:h->h, so no change+ N rll' rle' rlr' -> Z (P l e rll') rle' (Z rlr' re rr) -- RL subtree BF: 0->-1, SO.. CASE RL(1) !!+ P rll' rle' rlr' -> Z (Z l e rll') rle' (N rlr' re rr) -- RL subtree BF: 0->+1, SO.. CASE RL(2) !!++ -- (putPLR ll le lr e r): Put in LR subtree of (P (Z ll le lr) e r) , (never returns N)+ {-# INLINE putPLR #-}+ putPLR _ ll le E e r = Z (Z ll le E) e0 (Z E e r) -- r and ll must also be E, special CASE LR !!+ putPLR i ll le (N lrl lre lrr) e r = let lr' = putN (goR i) lrl lre lrr -- LR subtree BF<>0, H:h->h, so no change+ in lr' `seq` P (Z ll le lr') e r+ putPLR i ll le (P lrl lre lrr) e r = let lr' = putP (goR i) lrl lre lrr -- LR subtree BF<>0, H:h->h, so no change+ in lr' `seq` P (Z ll le lr') e r+ putPLR i ll le (Z lrl lre lrr) e r = let lr' = putZ (goR i) lrl lre lrr -- LR subtree BF= 0, so need to look for changes+ in case lr' of+ E -> error "insertPath: Bug9" -- impossible+ Z _ _ _ -> P (Z ll le lr') e r -- LR subtree BF: 0-> 0, H:h->h, so no change+ N lrl' lre' lrr' -> Z (P ll le lrl') lre' (Z lrr' e r) -- LR subtree BF: 0->-1, SO.. CASE LR(2) !!+ P lrl' lre' lrr' -> Z (Z ll le lrl') lre' (N lrr' e r) -- LR subtree BF: 0->+1, SO.. CASE LR(1) !!+-----------------------------------------------------------------------+----------------------- insertPath Ends Here --------------------------+-----------------------------------------------------------------------+
Data/Tree/AVL/Delete.hs view
@@ -32,7 +32,7 @@ import Data.COrdering import Data.Tree.AVL.Types(AVL(..))-import Data.Tree.AVL.Internals.BinPath(BinPath(..),genFindPath,genOpenPathWith,writePath)+import Data.Tree.AVL.BinPath(BinPath(..),genFindPath,genOpenPathWith,writePath) import Data.Tree.AVL.Internals.DelUtils (-- Deleting Utilities
− Data/Tree/AVL/Internals/BinPath.hs
@@ -1,376 +0,0 @@-{-# OPTIONS_GHC -fglasgow-exts #-}--------------------------------------------------------------------------------- |--- Module : Data.Tree.AVL.Internals.BinPath--- Copyright : (c) Adrian Hey 2005--- License : BSD3------ Maintainer : http://homepages.nildram.co.uk/~ahey/em.png--- Stability : stable--- Portability : portable------ This module provides a cheap but extremely limited and dangerous alternative--- to using the Zipper, hence it's for INTERNAL USE ONLY. A BinPath provides--- a way of finding a particular element in an AVL tree again without doing--- any comparisons. But a BinPath is ONLY VALID IF THE TREE SHAPE DOES NOT--- CHANGE.-------------------------------------------------------------------------------module Data.Tree.AVL.Internals.BinPath- (BinPath(..),genFindPath,genOpenPath,genOpenPathWith,readPath,writePath,insertPath,- -- These are used by deletePath, which currently resides in Data.Tree.AVL.Internals.DelUtils- sel,goL,goR,- ) where--- N.B. The deletePath function should really be here too, but has been put--- in Data.Tree.AVL.Internals.DelUtils instead because deletion is a tangled web of circular--- depencency.--import Data.Tree.AVL.Types(AVL(..))-import Data.COrdering--#if __GLASGOW_HASKELL__-import GHC.Base-#include "ghcdefs.h"---- Test path LSB-bit0 :: Int# -> Bool-{-# INLINE bit0 #-}-bit0 p = word2Int# (and# (int2Word# p) (int2Word# 1#)) ==# 1#---- A pseudo comparison..--- N.B. If the path was bit reversed, this could be a straight comparison.??-sel :: Int# -> Ordering-{-# INLINE sel #-}-sel p = if p ==# 0# then EQ- else if bit0 p then LT -- Left if Bit 0 == 1- else GT -- Right if Bit 0 == 0----- Modify path for entering left subtree-goL :: Int# -> Int#-{-# INLINE goL #-}-goL p = iShiftRL# p 1#---- Modify path for entering right subtree-goR :: Int# -> Int#-{-# INLINE goR #-}-goR p = iShiftRL# (p -# 1#) 1#--#else-#include "h98defs.h"-import Data.Bits((.&.),shiftL)---- A pseudo comparison..--- N.B. If the path was bit reversed, this could be a straight comparison.??-sel :: Int -> Ordering-{-# INLINE sel #-}-sel p = if p == 0 then EQ- else if bit0 p then LT -- Left if Bit 0 == 1- else GT -- Right if Bit 0 == 0-bit0 :: Int -> Bool-{-# INLINE bit0 #-}-bit0 p = (p .&. 1) == 1---- Modify path for entering left subtree-goL :: Int -> Int-{-# INLINE goL #-}-goL p = shiftL p 1---- Modify path for entering right subtree-goR :: Int -> Int-{-# INLINE goR #-}-goR p = shiftL (p-1) 1-#endif---- | Int fields are search /depth/ and /path bits/ respecively. The /path bits/ consist of a--- a string of /depth/ bits, left justified. MSB of 0 means go left, MSB of 1 means go right.-data BinPath a = FullBP {-# UNPACK #-} !UINT a -- Found- | EmptyBP {-# UNPACK #-} !UINT -- Not Found--{-------------------------------------------------------------------------------------------- Notes:----------------------------------------------------------------------------------------------The Binary paths are based on an indexing scheme that:- 1- Uniquely identifies each tree node- 2- Provides a simple algorithm for path generation.- 3- Provides a simple algorithm to locate a node in the tree, given it's path.--Imagine an infinite Binary Tree, with nodes indexed as follows:-- _____00_____ <- d=1- / \- _01_ _02_ <- d=2- / \ / \- 03 05 04 06 <- d=4- / \ / \ / \ / \- 07 11 09 13 08 12 10 14 <- d=8- <-------- More Layers ------->--To generate the node index (path) as we move down the tree we..- 1- Initialise index (i) to 0, and a parameter (d) to 1- 2- If we've arrived where we want, output i.- 3- Either Move left: i <- i+d, d <- 2d, goto 2- or Move right: i <- i+2d, d <- 2d, goto 2--To find a node, given its index (path) i, we..- 1- If i=0 then stop, we've arrived.- 2- If i is odd then move left , i <- (i-1)>>1, goto 1 -- (i-1)>>1 = i>>1 if i is odd- else move right, i <- (i-1)>>1, goto 1 -- (i-1)>>1 = (i>>1)-1 if i is even-Examples:- i=05: (left ,i<-2):(right,i<-0):(stop)- i=12: (right,i<-5):(left ,i<-2):(right,i<-0):(stop)--See also: pathTree in Data.Tree.AVL.Test.Utils for recursive implementation of the indexing scheme.---------------------------------------------------------------------------------------------}---- | Find the path to a AVL tree element, returns -1 (invalid path) if element not found------ Complexity: O(log n)-genFindPath :: (e -> Ordering) -> AVL e -> UINT--- ?? What about strictness if UINT is boxed (i.e. non-ghc)?-genFindPath c t = find L(1) L(0) t where- find _ _ E = L(-1)- find d i (N l e r) = find' d i l e r- find d i (Z l e r) = find' d i l e r- find d i (P l e r) = find' d i l e r- find' d i l e r = case c e of- LT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d ) l- EQ -> i- GT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d_) r -- d_ = 2d---- | Get the BinPath of an element using the supplied selector.------ Complexity: O(log n)-genOpenPath :: (e -> Ordering) -> AVL e -> BinPath e-genOpenPath c t = find L(1) L(0) t where- find _ i E = EmptyBP i- find d i (N l e r) = find' d i l e r- find d i (Z l e r) = find' d i l e r- find d i (P l e r) = find' d i l e r- find' d i l e r = case c e of- LT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d ) l- EQ -> FullBP i e- GT -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d_) r -- d_ = 2d---- | Get the BinPath of an element using the supplied (combining) selector.------ Complexity: O(log n)-genOpenPathWith :: (e -> COrdering a) -> AVL e -> BinPath a-genOpenPathWith c t = find L(1) L(0) t where- find _ i E = EmptyBP i- find d i (N l e r) = find' d i l e r- find d i (Z l e r) = find' d i l e r- find d i (P l e r) = find' d i l e r- find' d i l e r = case c e of- Lt -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d ) l- Eq a -> FullBP i a- Gt -> let d_ = ADDINT(d,d) in find d_ ADDINT(i,d_) r -- d_ = 2d---- | Overwrite a tree element. Assumes the path bits were extracted from 'FullBP' constructor.--- Raises an error if the path leads to an empty tree.------ N.B This operation does not change tree shape (no insertion occurs).------ Complexity: O(log n)-writePath :: UINT -> e -> AVL e -> AVL e-writePath i0 e' t = wp i0 t where- wp L(0) E = error "writePath: Bug0" -- Needed to force strictness in path- wp L(0) (N l _ r) = N l e' r- wp L(0) (Z l _ r) = Z l e' r- wp L(0) (P l _ r) = P l e' r- wp _ E = error "writePath: Bug1"- wp i (N l e r) = if bit0 i then let l' = wp (goL i) l in l' `seq` N l' e r- else let r' = wp (goR i) r in r' `seq` N l e r'- wp i (Z l e r) = if bit0 i then let l' = wp (goL i) l in l' `seq` Z l' e r- else let r' = wp (goR i) r in r' `seq` Z l e r'- wp i (P l e r) = if bit0 i then let l' = wp (goL i) l in l' `seq` P l' e r- else let r' = wp (goR i) r in r' `seq` P l e r'---- | Read a tree element. Assumes the path bits were extracted from 'FullBP' constructor.--- Raises an error if the path leads to an empty tree.------ Complexity: O(log n)-readPath :: UINT -> AVL e -> e-readPath L(0) E = error "readPath: Bug0" -- Needed to force strictness in path-readPath L(0) (N _ e _) = e-readPath L(0) (Z _ e _) = e-readPath L(0) (P _ e _) = e-readPath _ E = error "readPath: Bug1"-readPath i (N l _ r) = readPath_ i l r-readPath i (Z l _ r) = readPath_ i l r-readPath i (P l _ r) = readPath_ i l r-readPath_ :: UINT -> AVL e -> AVL e -> e-readPath_ i l r = if bit0 i then readPath (goL i) l- else readPath (goR i) r---- | Inserts a new tree element. Assumes the path bits were extracted from a 'EmptyBP' constructor.--- This function replaces the first Empty node it encounters with the supplied value, regardless--- of the current path bits (which are not checked). DO NOT USE THIS FOR REPLACING ELEMENTS ALREADY--- PRESENT IN THE TREE (use 'writePath' for this).------ Complexity: O(log n)-insertPath :: UINT -> e -> AVL e -> AVL e-insertPath i0 e0 t = put i0 t where- ----------------------------- LEVEL 0 ---------------------------------- -- put --- ------------------------------------------------------------------------ put _ E = Z E e0 E- put i (N l e r) = putN i l e r- put i (Z l e r) = putZ i l e r- put i (P l e r) = putP i l e r-- ----------------------------- LEVEL 1 ---------------------------------- -- putN, putZ, putP --- ------------------------------------------------------------------------ -- Put in (N l e r), BF=-1 , (never returns P)- putN i l e r = if bit0 i then putNL i l e r -- put in L subtree- else putNR i l e r -- put in R subtree-- -- Put in (Z l e r), BF= 0- putZ i l e r = if bit0 i then putZL i l e r -- put in L subtree- else putZR i l e r -- put in R subtree-- -- Put in (P l e r), BF=+1 , (never returns N)- putP i l e r = if bit0 i then putPL i l e r -- put in L subtree- else putPR i l e r -- put in R subtree-- ----------------------------- LEVEL 2 ---------------------------------- -- putNL, putZL, putPL --- -- putNR, putZR, putPR --- ------------------------------------------------------------------------- -- (putNL l e r): Put in L subtree of (N l e r), BF=-1 (Never requires rebalancing) , (never returns P)- {-# INLINE putNL #-}- putNL _ E e r = Z (Z E e0 E) e r -- L subtree empty, H:0->1, parent BF:-1-> 0- putNL i (N ll le lr) e r = let l' = putN (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:-1->-1- in l' `seq` N l' e r- putNL i (P ll le lr) e r = let l' = putP (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:-1->-1- in l' `seq` N l' e r- putNL i (Z ll le lr) e r = let l' = putZ (goL i) ll le lr -- L subtree BF= 0, so need to look for changes- in case l' of- E -> error "insertPath: Bug0" -- impossible- Z _ _ _ -> N l' e r -- L subtree BF:0-> 0, H:h->h , parent BF:-1->-1- _ -> Z l' e r -- L subtree BF:0->+/-1, H:h->h+1, parent BF:-1-> 0-- -- (putZL l e r): Put in L subtree of (Z l e r), BF= 0 (Never requires rebalancing) , (never returns N)- {-# INLINE putZL #-}- putZL _ E e r = P (Z E e0 E) e r -- L subtree H:0->1, parent BF: 0->+1- putZL i (N ll le lr) e r = let l' = putN (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF: 0-> 0- in l' `seq` Z l' e r- putZL i (P ll le lr) e r = let l' = putP (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF: 0-> 0- in l' `seq` Z l' e r- putZL i (Z ll le lr) e r = let l' = putZ (goL i) ll le lr -- L subtree BF= 0, so need to look for changes- in case l' of- E -> error "insertPath: Bug1" -- impossible- Z _ _ _ -> Z l' e r -- L subtree BF: 0-> 0, H:h->h , parent BF: 0-> 0- _ -> P l' e r -- L subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->+1-- -- (putZR l e r): Put in R subtree of (Z l e r), BF= 0 (Never requires rebalancing) , (never returns P)- {-# INLINE putZR #-}- putZR _ l e E = N l e (Z E e0 E) -- R subtree H:0->1, parent BF: 0->-1- putZR i l e (N rl re rr) = let r' = putN (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF: 0-> 0- in r' `seq` Z l e r'- putZR i l e (P rl re rr) = let r' = putP (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF: 0-> 0- in r' `seq` Z l e r'- putZR i l e (Z rl re rr) = let r' = putZ (goR i) rl re rr -- R subtree BF= 0, so need to look for changes- in case r' of- E -> error "insertPath: Bug2" -- impossible- Z _ _ _ -> Z l e r' -- R subtree BF: 0-> 0, H:h->h , parent BF: 0-> 0- _ -> N l e r' -- R subtree BF: 0->+/-1, H:h->h+1, parent BF: 0->-1-- -- (putPR l e r): Put in R subtree of (P l e r), BF=+1 (Never requires rebalancing) , (never returns N)- {-# INLINE putPR #-}- putPR _ l e E = Z l e (Z E e0 E) -- R subtree empty, H:0->1, parent BF:+1-> 0- putPR i l e (N rl re rr) = let r' = putN (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:+1->+1- in r' `seq` P l e r'- putPR i l e (P rl re rr) = let r' = putP (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:+1->+1- in r' `seq` P l e r'- putPR i l e (Z rl re rr) = let r' = putZ (goR i) rl re rr -- R subtree BF= 0, so need to look for changes- in case r' of- E -> error "insertPath: Bug3" -- impossible- Z _ _ _ -> P l e r' -- R subtree BF:0-> 0, H:h->h , parent BF:+1->+1- _ -> Z l e r' -- R subtree BF:0->+/-1, H:h->h+1, parent BF:+1-> 0-- -------- These 2 cases (NR and PL) may need rebalancing if they go to LEVEL 3 ----------- -- (putNR l e r): Put in R subtree of (N l e r), BF=-1 , (never returns P)- {-# INLINE putNR #-}- putNR _ _ _ E = error "insertPath: Bug4" -- impossible if BF=-1- putNR i l e (N rl re rr) = let r' = putN (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:-1->-1- in r' `seq` N l e r'- putNR i l e (P rl re rr) = let r' = putP (goR i) rl re rr -- R subtree BF<>0, H:h->h, parent BF:-1->-1- in r' `seq` N l e r'- putNR i l e (Z rl re rr) = let i' = goR i in if bit0 i' then putNRL i' l e rl re rr -- RL (never returns P)- else putNRR i' l e rl re rr -- RR (never returns P)-- -- (putPL l e r): Put in L subtree of (P l e r), BF=+1 , (never returns N)- {-# INLINE putPL #-}- putPL _ E _ _ = error "insertPath: Bug5" -- impossible if BF=+1- putPL i (N ll le lr) e r = let l' = putN (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:+1->+1- in l' `seq` P l' e r- putPL i (P ll le lr) e r = let l' = putP (goL i) ll le lr -- L subtree BF<>0, H:h->h, parent BF:+1->+1- in l' `seq` P l' e r- putPL i (Z ll le lr) e r = let i' = goL i in if bit0 i' then putPLL i' ll le lr e r -- LL (never returns N)- else putPLR i' ll le lr e r -- LR (never returns N)-- ----------------------------- LEVEL 3 ---------------------------------- -- putNRR, putPLL --- -- putNRL, putPLR --- ------------------------------------------------------------------------- -- (putNRR l e rl re rr): Put in RR subtree of (N l e (Z rl re rr)) , (never returns P)- {-# INLINE putNRR #-}- putNRR _ l e rl re E = Z (Z l e rl) re (Z E e0 E) -- l and rl must also be E, special CASE RR!!- putNRR i l e rl re (N rrl rre rrr) = let rr' = putN (goR i) rrl rre rrr -- RR subtree BF<>0, H:h->h, so no change- in rr' `seq` N l e (Z rl re rr')- putNRR i l e rl re (P rrl rre rrr) = let rr' = putP (goR i) rrl rre rrr -- RR subtree BF<>0, H:h->h, so no change- in rr' `seq` N l e (Z rl re rr')- putNRR i l e rl re (Z rrl rre rrr) = let rr' = putZ (goR i) rrl rre rrr -- RR subtree BF= 0, so need to look for changes- in case rr' of- E -> error "insertPath: Bug6" -- impossible- Z _ _ _ -> N l e (Z rl re rr') -- RR subtree BF: 0-> 0, H:h->h, so no change- _ -> Z (Z l e rl) re rr' -- RR subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE RR !!-- -- (putPLL ll le lr e r): Put in LL subtree of (P (Z ll le lr) e r) , (never returns N)- {-# INLINE putPLL #-}- putPLL _ E le lr e r = Z (Z E e0 E) le (Z lr e r) -- r and lr must also be E, special CASE LL!!- putPLL i (N lll lle llr) le lr e r = let ll' = putN (goL i) lll lle llr -- LL subtree BF<>0, H:h->h, so no change- in ll' `seq` P (Z ll' le lr) e r- putPLL i (P lll lle llr) le lr e r = let ll' = putP (goL i) lll lle llr -- LL subtree BF<>0, H:h->h, so no change- in ll' `seq` P (Z ll' le lr) e r- putPLL i (Z lll lle llr) le lr e r = let ll' = putZ (goL i) lll lle llr -- LL subtree BF= 0, so need to look for changes- in case ll' of- E -> error "insertPath: Bug7" -- impossible- Z _ _ _ -> P (Z ll' le lr) e r -- LL subtree BF: 0-> 0, H:h->h, so no change- _ -> Z ll' le (Z lr e r) -- LL subtree BF: 0->+/-1, H:h->h+1, parent BF:-1->-2, CASE LL !!-- -- (putNRL l e rl re rr): Put in RL subtree of (N l e (Z rl re rr)) , (never returns P)- {-# INLINE putNRL #-}- putNRL _ l e E re rr = Z (Z l e E) e0 (Z E re rr) -- l and rr must also be E, special CASE LR !!- putNRL i l e (N rll rle rlr) re rr = let rl' = putN (goL i) rll rle rlr -- RL subtree BF<>0, H:h->h, so no change- in rl' `seq` N l e (Z rl' re rr)- putNRL i l e (P rll rle rlr) re rr = let rl' = putP (goL i) rll rle rlr -- RL subtree BF<>0, H:h->h, so no change- in rl' `seq` N l e (Z rl' re rr)- putNRL i l e (Z rll rle rlr) re rr = let rl' = putZ (goL i) rll rle rlr -- RL subtree BF= 0, so need to look for changes- in case rl' of- E -> error "insertPath: Bug8" -- impossible- Z _ _ _ -> N l e (Z rl' re rr) -- RL subtree BF: 0-> 0, H:h->h, so no change- N rll' rle' rlr' -> Z (P l e rll') rle' (Z rlr' re rr) -- RL subtree BF: 0->-1, SO.. CASE RL(1) !!- P rll' rle' rlr' -> Z (Z l e rll') rle' (N rlr' re rr) -- RL subtree BF: 0->+1, SO.. CASE RL(2) !!-- -- (putPLR ll le lr e r): Put in LR subtree of (P (Z ll le lr) e r) , (never returns N)- {-# INLINE putPLR #-}- putPLR _ ll le E e r = Z (Z ll le E) e0 (Z E e r) -- r and ll must also be E, special CASE LR !!- putPLR i ll le (N lrl lre lrr) e r = let lr' = putN (goR i) lrl lre lrr -- LR subtree BF<>0, H:h->h, so no change- in lr' `seq` P (Z ll le lr') e r- putPLR i ll le (P lrl lre lrr) e r = let lr' = putP (goR i) lrl lre lrr -- LR subtree BF<>0, H:h->h, so no change- in lr' `seq` P (Z ll le lr') e r- putPLR i ll le (Z lrl lre lrr) e r = let lr' = putZ (goR i) lrl lre lrr -- LR subtree BF= 0, so need to look for changes- in case lr' of- E -> error "insertPath: Bug9" -- impossible- Z _ _ _ -> P (Z ll le lr') e r -- LR subtree BF: 0-> 0, H:h->h, so no change- N lrl' lre' lrr' -> Z (P ll le lrl') lre' (Z lrr' e r) -- LR subtree BF: 0->-1, SO.. CASE LR(2) !!- P lrl' lre' lrr' -> Z (Z ll le lrl') lre' (N lrr' e r) -- LR subtree BF: 0->+1, SO.. CASE LR(1) !!------------------------------------------------------------------------------------------------ insertPath Ends Here ---------------------------------------------------------------------------------------------------
Data/Tree/AVL/Internals/DelUtils.hs view
@@ -31,7 +31,7 @@ ) where import Data.Tree.AVL.Types(AVL(..))-import Data.Tree.AVL.Internals.BinPath(sel,goL,goR)+import Data.Tree.AVL.BinPath(sel,goL,goR) #ifdef __GLASGOW_HASKELL__ import GHC.Base
Data/Tree/AVL/List.hs view
@@ -57,12 +57,6 @@ -- the minimum possible height. flatten, flatReverse,flatMap,flatMap',-- -- * AVL tree based sorting of Lists- -- | Nothing to do with AVL trees really. But using AVL trees do give an O(n.(log n)) sort- -- algorithm for free, so here it is. These functions all consume the entire- -- input list to construct a sorted AVL tree and then read the elements out as a list (lazily).- genSortAscending,genSortDescending, ) where import Prelude -- so haddock finds the symbols there@@ -832,25 +826,4 @@ genPushList :: (e -> e -> COrdering e) -> AVL e -> [e] -> AVL e genPushList c avl = foldl' addElem avl where addElem t e = genPush (c e) e t---- | Uses the supplied combining comparison to sort list elements into ascending order.--- Multiple occurences of the same element are eliminated (they are combined in some way).------ @'genSortAscending' c = 'asListL' . 'genAsTree' c@------ Complexity: O(n.(log n))-{-# INLINE genSortAscending #-}-genSortAscending :: (e -> e -> COrdering e) -> [e] -> [e]-genSortAscending c = asListL . genAsTree c---- | Uses the supplied combining comparison to sort list elements into descending order.--- Multiple occurences of the same element are eliminated (they are combined in some way).------ @'genSortDescending' c = 'asListR' . 'genAsTree' c@------ Complexity: O(n.(log n))-{-# INLINE genSortDescending #-}-genSortDescending :: (e -> e -> COrdering e) -> [e] -> [e]-genSortDescending c = asListR . genAsTree c-
Data/Tree/AVL/Push.hs view
@@ -23,7 +23,7 @@ import Data.COrdering import Data.Tree.AVL.Types(AVL(..))-import Data.Tree.AVL.Internals.BinPath(BinPath(..),genOpenPathWith,writePath,insertPath)+import Data.Tree.AVL.BinPath(BinPath(..),genOpenPathWith,writePath,insertPath) {------------------------------------------------------------------------------------------------------------------------------ -------------------------------------- Notes about Insertion and Rebalancing -------------------------------------------------
Data/Tree/AVL/Write.hs view
@@ -26,7 +26,7 @@ import Data.COrdering import Data.Tree.AVL.Types(AVL(..))-import Data.Tree.AVL.Internals.BinPath(BinPath(..),genOpenPathWith,writePath)+import Data.Tree.AVL.BinPath(BinPath(..),genOpenPathWith,writePath) --------------------------------------------------------------------------- -- writeL, tryWriteL --
Data/Tree/AVL/Zipper.hs view
@@ -115,7 +115,7 @@ import Data.Tree.AVL.Internals.DelUtils(deletePath,popRN,popRZ,popRP,popLN,popLZ,popLP) import Data.Tree.AVL.Internals.HJoin(spliceH,joinH) import Data.Tree.AVL.Internals.HPush(pushHL,pushHR)-import Data.Tree.AVL.Internals.BinPath(BinPath(..),genOpenPath,writePath,insertPath,sel,goL,goR)+import Data.Tree.AVL.BinPath(BinPath(..),genOpenPath,writePath,insertPath,sel,goL,goR) #ifdef __GLASGOW_HASKELL__ import GHC.Base
Data/Tree/AVLX.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Tree.AVLX@@ -12,29 +13,49 @@ -- Not for general consumption. ----------------------------------------------------------------------------- module Data.Tree.AVLX-(module Data.Tree.AVL -- The normal user AVL API--- + Normally Hidden Modules-,module Data.Tree.AVL.Internals.DelUtils-,module Data.Tree.AVL.Internals.HPush-,module Data.Tree.AVL.Internals.HSet-,module Data.Tree.AVL.Internals.HAVL-,module Data.Tree.AVL.Internals.HJoin-,module Data.Tree.AVL.Internals.BinPath-,module Data.Tree.AVL.Test.Utils-,module Data.Tree.AVL.Test.Counter-,AVL(..)+(module Data.Tree.AVL,+ module Data.Tree.AVL.Delete,+ module Data.Tree.AVL.Join,+ module Data.Tree.AVL.List,+ module Data.Tree.AVL.Push,+ module Data.Tree.AVL.Read,+ module Data.Tree.AVL.Set,+ module Data.Tree.AVL.Size,+ module Data.Tree.AVL.Height,+ module Data.Tree.AVL.Split,+ module Data.Tree.AVL.Types,+ module Data.Tree.AVL.Write,+ module Data.Tree.AVL.Zipper,+ module Data.Tree.AVL.BinPath,+ module Data.Tree.AVL.Internals.DelUtils,+ module Data.Tree.AVL.Internals.HAVL,+ module Data.Tree.AVL.Internals.HJoin,+ module Data.Tree.AVL.Internals.HPush,+ module Data.Tree.AVL.Internals.HSet,+ module Data.Tree.AVL.Test.Counter,+ module Data.Tree.AVL.Test.Utils, ) where --import Data.Tree.AVL hiding (AVL)-import Data.Tree.AVL.Types(AVL(..)) -- We want constructors exposed-+import Data.Tree.AVL+import Data.Tree.AVL.Delete+import Data.Tree.AVL.Join+import Data.Tree.AVL.List+import Data.Tree.AVL.Push+import Data.Tree.AVL.Read+import Data.Tree.AVL.Set+import Data.Tree.AVL.Size+import Data.Tree.AVL.Height+import Data.Tree.AVL.Split+import Data.Tree.AVL.Types+import Data.Tree.AVL.Write+import Data.Tree.AVL.Zipper+import Data.Tree.AVL.BinPath import Data.Tree.AVL.Internals.DelUtils-import Data.Tree.AVL.Internals.HPush-import Data.Tree.AVL.Internals.HSet import Data.Tree.AVL.Internals.HAVL import Data.Tree.AVL.Internals.HJoin-import Data.Tree.AVL.Internals.BinPath-import Data.Tree.AVL.Test.Utils hiding (isBalanced,isSorted,isSortedOK,minElements,maxElements)+import Data.Tree.AVL.Internals.HPush+import Data.Tree.AVL.Internals.HSet import Data.Tree.AVL.Test.Counter+import Data.Tree.AVL.Test.Utils+