# based on C code
 #   BSD License
 #   Copyright 2004 <strick> Henry Strickland <@yak.net>
 # which was based on C code
 #   Copyright 2004 <cicero> Bobby


if [llength [info commands p7proc]] {
        set Compiling true
} else {
        set Compiling false
        source testing.tcl
}



if $Compiling {


  p7class  Avl  { 
		(tcl)key	
		(tcl)value

		(int)height

		(Avl)left	
		(Avl)right	
		(Avl)up
  }


  p7proc (int)AvlBalance { (Avl)right (Avl)left } {
	# helper function to caclulate balance factor

	if ( left==null && right==null ) { return null }

	if ( left==null ) { return (right.height) }

	if ( right==null ) { return (0 - left.height) }

	return ( right.height - left.height )
  }

  p7proc (void)AvlReheight { (Avl)this } {
	if (!this) {return}
	set (int)hl ( left ? left.height+1 : 0 )
	set (int)hr ( right ? right.height+1 : 0 )
	set height ( (hl>hr) ? hl : hr )
  }


  p7proc (Avl)AvlLeftRotate { (Avl)head } {

	# Performs a left rotation on the root node that is passed in and returns
	# the new root node for the subtree.

	set (Avl)tmp1 (head.right)
	if (!tmp1) {return head}

	set (Avl)tmp2  (head.right.left)

	set head.right.left (head)
	set head.right (tmp2)

	set tmp1.up (head.up)
	set head.up (tmp1)
	if (tmp2) {set tmp2.up (head)}

	set head (tmp1)

	AvlReheight (head.left)
	AvlReheight (head.right)
	AvlReheight (head)
	
	return $head
  }


  p7proc (Avl)AvlRightRotate { (Avl)head } {

	# Performs a Right rotation on the root node that is passed in and returns
	# the new root node for the subtree.
	# This function must update the
	# balance factors for the nodes involved.

	set (Avl)tmp1 (head.left)
	if (!tmp1) {return head}

	set (Avl)tmp2  (head.left.right)

	set head.left.right (head)
	set head.left (tmp2)

	set tmp1.up (head.up)
	set head.up (tmp1)
	if (tmp2) {set tmp2.up (head)}

	set head (tmp1)

	AvlReheight (head.left)
	AvlReheight (head.right)
	AvlReheight (head)
	
	return $head
  }

  p7proc (Avl)AvlLeftRightRotate { (Avl)head } {

	# Performs a left right rotation on the root node that is passed in and
	# returns the new root node for the subtree.  This function must update
	# the balance factor of the nodes involved.

	set head.left [AvlLeftRotate (head.left)]
	set head [AvlRightRotate (head)]
	return (head)
  }


  p7proc (Avl)AvlRightLeftRotate { (Avl)head } {

	# Performs a right right rotation on the root node that is passed in and
	# returns the new root node for the subtree.  This function must update
	# the balance factor of the nodes involved.

	set head.right [AvlRightRotate (head.right)]
	set head [AvlLeftRotate (head)]
	return (head)
  }

  p7proc (void)AvlFree { (Avl)this } {

	# Since there are up links, we must at least set those to null
	# to break circularities

	set up null
	set key {}
	set value {}

	if (left) { AvlFree (left) } 
	set left null

	if (right) { AvlFree (right) } 
	set right null

  }

  p7proc (Avl)AvlAdd { (Avl)this (tcl)_key (tcl)_value } {

	if ( ! this ) {
		new (Avl)p
		set p.key (_key)
		set p.value (_value)
		return (p)
	}

	if ( _key lt key ) {
		set left [AvlAdd $left $_key $_value]
		set left.up $this
	} elseif ( _key gt key ) {
		set right [AvlAdd $right $_key $_value]
		set right.up $this
	} else {
		set value $_value
	}

	AvlReheight (left)
	AvlReheight (right)
	AvlReheight (this)

	set (Avl)z $this 
	set (int)b [AvlBalance $right $left]
	if (b > 1) {
		if ([AvlBalance $right.right $right.left] > 0) {
			set z [AvlLeftRotate $this]
		} else {
			set z [AvlRightLeftRotate $this]
		}
	} elseif (b < -1) {
		if ([AvlBalance $left.right $left.left] < 0) {
			set z [AvlRightRotate $this]
		} else {
			set z [AvlLeftRightRotate $this]
		}
	}

	AvlReheight (z.left)
	AvlReheight (z.right)
	AvlReheight (z)
	set z
  }

  p7proc (Avl)AvlFind { (Avl)this (tcl)_key } {
	if (!this) {return null}
	if (_key eq key) {
		return $this
	} elseif (_key lt key) {
		return [AvlFind $left $_key]
	} else {
		return [AvlFind $right $_key]
	}
  }

  p7proc (Avl)AvlClosest { (Avl)this (tcl)_key } {
	if (!this) {return null}
	if (_key eq key) {
		return $this
	} elseif (_key lt key) {
		return (left ? [AvlClosest $left $_key] : this)
	} else {
		return (right ? [AvlClosest $right $_key] : this)
	}
  }

  p7proc (void)AvlDebugPrint { (Avl)this (int)n (tcl)fd } {
	if (!this) {return}

	AvlDebugPrint $left (n+1) $fd

	::puts $fd [ ::list $n $key $height ]

	#::puts $fd "[::string repeat {- } $n] $key $height"

	AvlDebugPrint $right (n+1) $fd
  }

  p7proc (Avl)AvlNext { (Avl)p } {
	if (p) {
		if (p.right) {
			set p (p.right)
			# after going right, go all the way left
			while (p.left) {
				set p (p.left)
			}
		} else {
			# go up
			set (Avl)q (p)
			set p (p.up)
			while (p && p.right==q) {
				set q (p)
				set p (p.up)
			}
		}
	}
	return (p)
  }

  p7proc (Avl)AvlPrev { (Avl)p } {
	if (p) {
		if (p.left) {
			set p (p.left)
			# after going left, go all the way right
			while (p.right) {
				set p (p.right)
			}
		} else {
			# go up
			set (Avl)q (p)
			set p (p.up)
			while (p && p.left==q) {
				set q (p)
				set p (p.up)
			}
		}
	}
	return (p)
  }




  p7proc (tcl)AvlWalk { (Avl)this } {
	if (!this) {return {}}

	::concat [AvlWalk $left] [::list $key $value] [AvlWalk $right]
  }

  p7proc (tcl)AvlKey { (Avl)this } { set key }
  p7proc (tcl)AvlValue { (Avl)this } { set value }

} else { # Not Compiling


	set numbers { one 1 two 2 three 3 four 4 five 5 six 6 seven 7 eight 8 nine 9 ten 10 }
	set a {}
	foreach {k v} $numbers {
		set a [AvlAdd $a $k $v]
	}
	array set NUMBERS $numbers
	foreach k [lsort [array names NUMBERS]] {
		lappend expected $k $NUMBERS($k)
	}
	
	AvlDebugPrint $a 0 stdout
	puts [AvlWalk $a]

	AssertEq $expected {AvlWalk $a}

	AssertEq three {AvlKey [AvlFind $a three]}
	AssertEq 3 {AvlValue [AvlFind $a three]}

	AssertEq {} {AvlFind $a NOTaNUMBER}

	AssertEq nine {AvlKey [ AvlClosest $a oar ]}
	AssertEq seven {AvlKey [ AvlClosest $a oooh ]}

	# test AvlNext to traverse the tree
	set x [AvlFind $a eight]
	foreach k [lsort [array names NUMBERS]] {
		AssertEq $k {AvlKey $x}
		set x [AvlNext $x]
	}
	AssertEq {} {set x}

	# test AvlPrev to traverse the tree
	set x [AvlFind $a two]
	foreach k [lsort -decreasing [array names NUMBERS]] {
		AssertEq $k {AvlKey $x}
		set x [AvlPrev $x]
	}
	AssertEq {} {set x}


} ;#endif