AVL tree

From Rosetta Code
Revision as of 21:42, 4 May 2014 by rosettacode>Bjb322 (Added Agda implementation of AVL trees (insert only))
AVL tree is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
This page uses content from Wikipedia. The original article was at AVL tree. The list of authors can be seen in the page history. As with Rosetta Code, the text of Wikipedia is available under the GNU FDL. (See links for details on variance)

In computer science, an AVL tree is a self-balancing binary search tree. In an AVL tree, the heights of the two child subtrees of any node differ by at most one; if at any time they differ by more than one, rebalancing is done to restore this property. Lookup, insertion, and deletion all take O(log n) time in both the average and worst cases, where n is the number of nodes in the tree prior to the operation. Insertions and deletions may require the tree to be rebalanced by one or more tree rotations.

AVL trees are often compared with red-black trees because they support the same set of operations and because red-black trees also take O(log n) time for the basic operations. Because AVL trees are more rigidly balanced, they are faster than red-black trees for lookup-intensive applications. Similar to red-black trees, AVL trees are height-balanced, but in general not weight-balanced nor μ-balanced; that is, sibling nodes can have hugely differing numbers of descendants.

Task: Implement an AVL tree in the language of choice and provide at least basic operations.

Agda

This implementation uses the type system to enforce the height invariants, though not the BST invariants <lang agda> module Avl where

-- The Peano naturals data Nat : Set where

z : Nat
s : Nat -> Nat

-- An AVL tree's type is indexed by a natural. -- Avl N is the type of AVL trees of depth N. There arj 3 different -- node constructors: -- Left: The left subtree is one level deeper than the right -- Balanced: The subtrees have the same depth -- Right: The right Subtree is one level deeper than the left -- Since the AVL invariant is that the depths of a node's subtrees -- always differ by at most 1, this perfectly encodes the AVL depth invariant. data Avl : Nat -> Set where

 Empty : Avl z
 Left : {X : Nat} -> Nat -> Avl (s X) -> Avl X -> Avl (s (s X))
 Balanced : {X : Nat} -> Nat -> Avl X -> Avl X -> Avl (s X)
 Right : {X : Nat} -> Nat -> Avl X -> Avl (s X) -> Avl (s (s X))

-- A wrapper type that hides the AVL tree invariant. This is the interface -- exposed to the user. data Tree : Set where

 avl : {N : Nat} -> Avl N -> Tree

-- Comparison result data Ord : Set where

 Less : Ord
 Equal : Ord
 Greater : Ord

-- Comparison function cmp : Nat -> Nat -> Ord cmp z (s X) = Less cmp z z = Equal cmp (s X) z = Greater cmp (s X) (s Y) = cmp X Y

-- Insertions can either leave the depth the same or -- increase it by one. Encode this in the type. data InsertResult : Nat -> Set where

 Same : {X : Nat} -> Avl X -> InsertResult X
 Bigger : {X : Nat} -> Avl (s X) -> InsertResult X

-- If the left subtree is 2 levels deeper than the right, rotate to the right. -- balance-left X L R means X is the root, L is the left subtree and R is the right. balance-left : {N : Nat} -> Nat -> Avl (s (s N)) -> Avl N -> InsertResult (s (s N)) balance-left X (Right Y A (Balanced Z B C)) D = Same (Balanced Z (Balanced X A B) (Balanced Y C D)) balance-left X (Right Y A (Left Z B C)) D = Same (Balanced Z (Balanced X A B) (Right Y C D)) balance-left X (Right Y A (Right Z B C)) D = Same (Balanced Z (Left X A B) (Balanced Y C D)) balance-left X (Left Y (Balanced Z A B) C) D = Same (Balanced Z (Balanced X A B) (Balanced Y C D)) balance-left X (Left Y (Left Z A B) C) D = Same (Balanced Z (Left X A B) (Balanced Y C D)) balance-left X (Left Y (Right Z A B) C) D = Same (Balanced Z (Right X A B) (Balanced Y C D)) balance-left X (Balanced Y (Balanced Z A B) C) D = Bigger (Right Z (Balanced X A B) (Left Y C D)) balance-left X (Balanced Y (Left Z A B) C) D = Bigger (Right Z (Left X A B) (Left Y C D)) balance-left X (Balanced Y (Right Z A B) C) D = Bigger (Right Z (Right X A B) (Left Y C D))

-- Symmetric with balance-left balance-right : {N : Nat} -> Nat -> Avl N -> Avl (s (s N)) -> InsertResult (s (s N)) balance-right X A (Left Y (Left Z B C) D) = Same (Balanced Z (Balanced X A B) (Right Y C D)) balance-right X A (Left Y (Balanced Z B C) D) = Same(Balanced Z (Balanced X A B) (Balanced Y C D)) balance-right X A (Left Y (Right Z B C) D) = Same(Balanced Z (Left X A B) (Balanced Y C D)) balance-right X A (Balanced Z B (Left Y C D)) = Bigger(Left Z (Right X A B) (Left Y C D)) balance-right X A (Balanced Z B (Balanced Y C D)) = Bigger (Left Z (Right X A B) (Balanced Y C D)) balance-right X A (Balanced Z B (Right Y C D)) = Bigger (Left Z (Right X A B) (Right Y C D)) balance-right X A (Right Z B (Left Y C D)) = Same (Balanced Z (Balanced X A B) (Left Y C D)) balance-right X A (Right Z B (Balanced Y C D)) = Same (Balanced Z (Balanced X A B) (Balanced Y C D)) balance-right X A (Right Z B (Right Y C D)) = Same (Balanced Z (Balanced X A B) (Right Y C D))

-- insert' T N does all the work of inserting the element N into the tree T. insert' : {N : Nat} -> Avl N -> Nat -> InsertResult N insert' Empty N = Bigger (Balanced N Empty Empty) insert' (Left Y L R) X with cmp X Y insert' (Left Y L R) X | Less with insert' L X insert' (Left Y L R) X | Less | Same L' = Same (Left Y L' R) insert' (Left Y L R) X | Less | Bigger L' = balance-left Y L' R insert' (Left Y L R) X | Equal = Same (Left Y L R) insert' (Left Y L R) X | Greater with insert' R X insert' (Left Y L R) X | Greater | Same R' = Same (Left Y L R') insert' (Left Y L R) X | Greater | Bigger R' = Same (Balanced Y L R') insert' (Balanced Y L R) X with cmp X Y insert' (Balanced Y L R) X | Less with insert' L X insert' (Balanced Y L R) X | Less | Same L' = Same (Balanced Y L' R) insert' (Balanced Y L R) X | Less | Bigger L' = Bigger (Left Y L' R) insert' (Balanced Y L R) X | Equal = Same (Balanced Y L R) insert' (Balanced Y L R) X | Greater with insert' R X insert' (Balanced Y L R) X | Greater | Same R' = Same (Balanced Y L R') insert' (Balanced Y L R) X | Greater | Bigger R' = Bigger (Right Y L R') insert' (Right Y L R) X with cmp X Y insert' (Right Y L R) X | Less with insert' L X insert' (Right Y L R) X | Less | Same L' = Same (Right Y L' R) insert' (Right Y L R) X | Less | Bigger L' = Same (Balanced Y L' R) insert' (Right Y L R) X | Equal = Same (Right Y L R) insert' (Right Y L R) X | Greater with insert' R X insert' (Right Y L R) X | Greater | Same R' = Same (Right Y L R') insert' (Right Y L R) X | Greater | Bigger R' = balance-right Y L R'

-- Wrapper around insert' to use the depth-agnostic type Tree. insert : Tree -> Nat -> Tree insert (avl T) X with insert' T X ... | Same T' = avl T' ... | Bigger T' = avl T' </lang>

Scheme

Pure functional version. Explanative article in Russian, written by Swizard.

Tcl

Note that in general, you would not normally write a tree directly in Tcl when writing code that required an = map, but would rather use either an array variable or a dictionary value (which are internally implemented using a high-performance hash table engine).

Works with: Tcl version 8.6

<lang tcl>package require TclOO

namespace eval AVL {

   # Class for the overall tree; manages real public API
   oo::class create Tree {

variable root nil class constructor Template:NodeClass AVL::Node { set class [oo::class create Node [list superclass $nodeClass]]

# Create a nil instance to act as a leaf sentinel set nil [my NewNode ""] set root [$nil ref]

# Make nil be special oo::objdefine $nil { method height {} {return 0} method key {} {error "no key possible"} method value {} {error "no value possible"} method destroy {} { # Do nothing (doesn't prohibit destruction entirely) } method print {indent increment} { # Do nothing } } }

# How to actually manufacture a new node method NewNode {key} { if {![info exists nil]} {set nil ""} $class new $key $nil [list [namespace current]::my NewNode] }

# Create a new node in the tree and return it method insert {key} { set node [my NewNode $key] if {$root eq $nil} { set root $node } else { $root insert $node } return $node }

# Find the node for a particular key method lookup {key} { for {set node $root} {$node ne $nil} {} { if {[$node key] == $key} { return $node } elseif {[$node key] > $key} { set node [$node left] } else { set node [$node right] } } error "no such node" }

# Print a tree out, one node per line method print {{indent 0} {increment 1}} { $root print $indent $increment return }

   }
   # Class of an individual node; may be subclassed
   oo::class create Node {

variable key value left right 0 refcount newNode constructor {n nil instanceFactory} { set newNode $instanceFactory set 0 [expr {$nil eq "" ? [self] : $nil}] set key $n set value {} set left [set right $0] set refcount 0 } method ref {} { incr refcount return [self] } method destroy {} { if {[incr refcount -1] < 1} next } method New {key value} { set n [{*}$newNode $key] $n setValue $value return $n }

# Getters method key {} {return $key} method value {} {return $value} method left {} {return $left} method right {args} {return $right}

# Setters method setValue {newValue} { set value $newValue } method setLeft {node} { # Non-trivial because of reference management $node ref $left destroy set left $node return } method setRight {node} { # Non-trivial because of reference management $node ref $right destroy set right $node return }

# Print a node and its descendents method print {indent increment} { puts [format "%s%s => %s" [string repeat " " $indent] $key $value] incr indent $increment $left print $indent $increment $right print $indent $increment }

method height {} { return [expr {max([$left height], [$right height]) + 1}] } method balanceFactor {} { expr {[$left height] - [$right height]} }

method insert {node} { # Simple insertion if {$key > [$node key]} { if {$left eq $0} { my setLeft $node } else { $left insert $node } } else { if {$right eq $0} { my setRight $node } else { $right insert $node } }

# Rebalance this node if {[my balanceFactor] > 1} { if {[$left balanceFactor] < 0} { $left rotateLeft } my rotateRight } elseif {[my balanceFactor] < -1} { if {[$right balanceFactor] > 0} { $right rotateRight } my rotateLeft } }

# AVL Rotations method rotateLeft {} { set new [my New $key $value] set key [$right key] set value [$right value] $new setLeft $left $new setRight [$right left] my setLeft $new my setRight [$right right] }

method rotateRight {} { set new [my New $key $value] set key [$left key] set value [$left value] $new setLeft [$left right] $new setRight $right my setLeft [$left left] my setRight $new }

   }

}</lang> Demonstrating: <lang tcl># Create an AVL tree AVL::Tree create tree

  1. Populate it with some semi-random data

for {set i 33} {$i < 127} {incr i} {

   [tree insert $i] setValue \

[string repeat [format %c $i] [expr {1+int(rand()*5)}]] }

  1. Print it out

tree print

  1. Look up a few values in the tree

for {set i 0} {$i < 10} {incr i} {

   set k [expr {33+int((127-33)*rand())}]
   puts $k=>[[tree lookup $k] value]

}

  1. Destroy the tree and all its nodes

tree destroy</lang>

Output:
64 => @@@
 48 => 000
  40 => (((((
   36 => $
    34 => """
     33 => !!
     35 => #####
    38 => &&&
     37 => %
     39 => ''''
   44 => ,
    42 => **
     41 => )))
     43 => +++++
    46 => .
     45 => --
     47 => ////
  56 => 888
   52 => 444
    50 => 22222
     49 => 1111
     51 => 333
    54 => 6
     53 => 555
     55 => 77
   60 => <<<<
    58 => ::::
     57 => 99999
     59 => ;
    62 => >>>
     61 => ===
     63 => ??
 96 => ``
  80 => PPPPP
   72 => HHHH
    68 => DDD
     66 => BBBB
      65 => A
      67 => CCC
     70 => FFF
      69 => EEEE
      71 => GGG
    76 => LL
     74 => JJ
      73 => III
      75 => KKKK
     78 => N
      77 => MMMMM
      79 => OOOOO
   88 => XXX
    84 => TTTT
     82 => R
      81 => QQQQ
      83 => SSSS
     86 => V
      85 => UUU
      87 => WWW
    92 => \\\
     90 => Z
      89 => YYYYY
      91 => [
     94 => ^^^^^
      93 => ]]]]
      95 => _____
  112 => pppp
   104 => hh
    100 => d
     98 => bb
      97 => aaa
      99 => cccc
     102 => ff
      101 => eeee
      103 => gggg
    108 => lll
     106 => j
      105 => iii
      107 => kkkkk
     110 => nn
      109 => m
      111 => o
   120 => x
    116 => ttt
     114 => rrrrr
      113 => qqqqq
      115 => s
     118 => vvv
      117 => uuuu
      119 => wwww
    124 => ||||
     122 => zzzz
      121 => y
      123 => {{{
     125 => }}}}
      126 => ~~~~
53=>555
55=>77
60=><<<<
100=>d
99=>cccc
93=>]]]]
57=>99999
56=>888
47=>////
39=>''''