;; -*- Scheme -*-
;;
;; $Id: avl-tree02.scm,v 1.1 1998/03/16 07:57:14 foner Exp $

;;------------

(require 'avl-tree::height)
(require 'avl-tree::make)
(require 'avl-tree::left)
(require 'avl-tree::right)

;;------------

(define avl-tree::max
  (lambda (a b)
    (+ (if (> a b) a b) 1)))

(define avl-tree::combine
  (lambda (left-tree a middle-tree c right-tree)
    (let ((left-tree-height (avl-tree::height left-tree))
	  (middle-tree-height (avl-tree::height middle-tree))
	  (right-tree-height (avl-tree::height right-tree)))
      (cond
       ((and (> middle-tree-height left-tree-height)
	     (> middle-tree-height right-tree-height))
	 (avl-tree::make
	   (avl-tree::make
	     left-tree
	     a
	     (+ 1 left-tree-height)
	     (avl-tree::left middle-tree))
	   (avl-tree::data middle-tree)
	   (+ 2 left-tree-height)
	   (avl-tree::make
	     (avl-tree::right middle-tree)
	     c
	     (+ 1 right-tree-height)
	     right-tree)))
       ((and (>= left-tree-height middle-tree-height)
	     (>= left-tree-height right-tree-height))
	 (let* ((middle-right-max
		  (avl-tree::max middle-tree-height right-tree-height))
		(left-middle-right-max
		  (avl-tree::max middle-right-max left-tree-height)))
	   (avl-tree::make
	     left-tree
	     a
	     left-middle-right-max
	     (avl-tree::make middle-tree c middle-right-max right-tree))))
       (else
	 (let* ((left-middle-max
		 (avl-tree::max left-tree-height middle-tree-height))
		(left-middle-right-max
		 (avl-tree::max left-middle-max right-tree-height)))
	   (avl-tree::make
	     (avl-tree::make left-tree a left-middle-max middle-tree)
	     c
	     left-middle-right-max
	     right-tree)))))))

;;-------------
;exports avl-tree::combine

;; eof
