高度平衡树 -- AVL 树

Scheme 的表达, 优雅.

#lang scheme

( define nil '() )
( define ( root tree )( car tree ) )
( define ( left-tree tree )( cadr tree ) )
( define ( right-tree tree )( caddr tree ) )
( define ( height tree )
   ( cond [ ( null? tree ) 0 ]
          [ else ( cadddr tree ) ] ) )

( define ( make-leaf elem )( list elem nil nil 1 ) )

( define ( make-avl-tree root left right )
   ( list root left right ( + 1 ( max ( height left )
                                      ( height right ) ) ) ) )

( define ( contains-elem?

elem tree )
   ( cond [ ( null? tree ) false ]
          [ ( = elem ( root tree ) ) true ]
          [ ( < elem ( root tree ) )
            ( contains-elem?

elem ( left-tree tree ) ) ]
          [ ( > elem ( root tree ) )
            ( contains-elem? elem ( right-tree tree ) ) ] ) )

( define ( rotate-left-left tree )
   ( cond [ ( null? tree ) tree ]
          [ else ( make-avl-tree ( root ( left-tree tree ) )
                                 ( left-tree ( left-tree tree ) )
                                 ( make-avl-tree ( root tree )
                                                 ( right-tree ( left-tree tree ) )
                                                 ( right-tree tree ) )  ) ] ) )

( define ( rotate-right-right tree )
   ( cond [ ( null? tree ) tree ]
          [ else ( make-avl-tree ( root ( right-tree tree ) )
                                 ( make-avl-tree ( root tree )
                                                 ( left-tree tree )
                                                 ( left-tree ( right-tree tree ) ) ) 
                                 ( right-tree ( right-tree tree ) ) ) ] ) )

( define ( rotate-right-left tree )
   ( cond [ ( null?

tree ) tree ]
          [ else ( make-avl-tree ( left-tree ( right-tree tree ) )
                                 ( make-avl-tree ( root tree )
                                                 ( left-tree tree )
                                                 ( left-tree ( left-tree ( right-tree tree ) ) ) )
                                 ( make-avl-tree ( root ( right-tree tree ) )
                                                 ( right-tree ( left-tree ( right-tree tree ) ) )
                                                 ( right-tree ( right-tree tree ) ) ) ) ] ) )

( define ( rotate-left-right tree )
   ( cond [ ( null?

tree ) tree ]
          [ else ( make-avl-tree ( root ( right-tree ( left-tree tree ) ) )
                                 ( make-avl-tree ( root ( left-tree tree ) )
                                                 ( left-tree ( left-tree tree ) )
                                                 ( left-tree ( right-tree ( left-tree tree ) ) ) )
                                 ( make-avl-tree ( root tree )
                                                 ( right-tree ( right-tree ( left-tree tree ) ) )
                                                 ( right-tree tree ) ) ) ] ) )

( define ( balance-avl-tree tree )
   ( define ( factor tree )
      ( - ( height ( right-tree tree ) )
          ( height ( left-tree tree ) ) ) )
   ( let ( [ f ( factor tree ) ] )
      ( cond [ ( = f 2 )
               ( cond [ ( < ( factor ( right-tree tree ) ) 0 )
                        ( rotate-right-left tree ) ]
                      [ else ( rotate-right-right tree ) ] ) ]
             [ ( = f -2 )
               ( cond [ ( > ( factor ( left-tree tree ) ) 0 )
                        ( rotate-left-right tree ) ]
                      [ else ( rotate-left-left tree ) ] ) ]
             [ else tree ] ) ) )

( define ( insert-elem elem tree )
   ( define ( insert-in-son elem tree )
      ( cond [ ( null? tree )
               ( make-leaf elem ) ]
             [ ( < elem ( root tree ) )
               ( let* ( [ newLeftTree ( insert-in-son elem ( left-tree tree ) ) ]
                        [ newAVLTree ( make-avl-tree ( root tree )
                                                     newLeftTree
                                                     ( right-tree tree ) ) ] )
                  ( balance-avl-tree newAVLTree ) ) ]
             [ ( > elem ( root tree ) )
               ( let* ( [ newRightTree ( insert-in-son elem ( right-tree tree ) ) ]
                        [ newAVLTree ( make-avl-tree ( root tree )
                                                     ( left-tree tree )
                                                     newRightTree ) ] )
                  ( balance-avl-tree newAVLTree ) ) ]
             [ else tree ] ) )
   ( cond [ ( contains-elem? elem tree ) tree ]
          [ else ( insert-in-son elem tree ) ] ) )

( define ( delete-elem elem tree )
   ( define ( delete-left-most tree )
      ( cond [ ( left-empty? tree ) tree ]
             [ else ( let* ( [ leftMost ( delete-left-most ( left-tree tree ) ) ]
                             [ newRightTree ( make-avl-tree ( root tree )
                                                            ( right-tree leftMost )
                                                            ( right-tree tree ) ) ] )
                       ( make-avl-tree ( root leftMost )
                                       nil
                                       ( balance-avl-tree newRightTree ) ) ) ] ) )
   ( define ( delete-in-son elem tree )
      ( cond [ ( < elem ( root tree ) )
               ( let* ( [ newLeftTree ( delete-in-son elem ( left-tree tree ) ) ]
                        [ newAVLTree ( make-avl-tree ( root tree )
                                                     newLeftTree
                                                     ( right-tree tree ) ) ] )
                  ( balance-avl-tree newAVLTree ) ) ]
             [ ( > elem ( root tree ) )
               ( let* ( [ newRightTree ( delete-in-son elem ( right-tree tree ) ) ]
                        [ newAVLTree ( make-avl-tree ( root tree )
                                                     ( left-tree tree )
                                                     newRightTree ) ] )
                  ( balance-avl-tree newAVLTree ) ) ]
             [ ( = elem ( root tree ) )
               ( cond [ ( and ( right-empty? tree )
                              ( left-empty? tree ) )
                        nil ]
                      [ ( right-empty? tree )
                        ( left-tree tree ) ]
                      [ ( left-empty? tree )
                        ( right-tree tree ) ]
                      [ else ( let ( [ leftMost ( delete-left-most ( right-tree tree ) ) ] )
                                ( make-avl-tree ( root leftMost )
                                                ( left-tree tree )
                                                ( right-tree leftMost ) ) ) ] ) ] ) )
   ( define ( left-empty? tree )( null?

( left-tree tree ) ) )
   ( define ( right-empty? tree )( null?

( right-tree tree ) ) )
   ( cond [ ( contains-elem?

elem tree )
            ( delete-in-son elem tree ) ]
          [ else tree ] ) )

( define ( list->avl elems )
   ( define ( iter elems tree )
      ( cond [ ( null?

elems ) tree ]
             [ else ( iter ( cdr elems ) 
                           ( insert-elem ( car elems ) tree ) ) ] ) )
   ( cond [ ( null? elems ) '() ]
          [ else ( let( [ avl ( make-leaf ( car elems ) ) ] )

                    ( iter ( cdr elems ) avl ) ) ] ) )