;;; -*- Mode: Lisp -*-
;;;
;;; $Header: /home/gene/library/website/docsrc/amo/RCS/bst.lisp,v 395.1 2008/04/20 17:25:45 gene Exp $
;;;
;;; Copyright (c) 2005 Gene Michael Stover.  All rights reserved.
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU Lesser General Public License as
;;; published by the Free Software Foundation; either version 2 of the
;;; License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU Lesser General Public License for more details.
;;;
;;; You should have received a copy of the GNU Lesser General Public
;;; License along with this program; if not, write to the Free Software
;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301
;;; USA
;;;

(defpackage "BST"
  (:use "COMMON-LISP"))
(import 'cybertiggyr-test:deftest)

(export 'bst-equalfn)
(export 'bst-left)
(export 'bst-lessfn)
(export 'bst-right)
(export 'bst-value)
(export 'copy-bst)
(export 'insert)
(export 'make-bst)
(export 'xmember)

;;;
;;; Binary Search Trees
;;; We need these for some of the exercises.
;;;

(defstruct bst
  value
  left
  right
  lessfn
  equalfn)

;;
;; This technique is comparison functions, with XLT, XEQ, XGT, &
;; XGE, sure is ugly.  I've thought of alternatives, some of which
;; are less ugly in some ways, but none of which are less ugly in
;; all ways.  And No, creating a class with a "less" method & an
;; "equal" method is no better because it forces the class's
;; implementor to decide how instaces will be compared.  *If* that
;; lack of flexibility suits your application, it's clean, but if
;; you need to compare instances in different ways at different
;; times (in different collections), it buys you nothing.
;;

(defun lt (x node)
  "Return true if & only if X's bst-value is less than the bst-value in NODE."
  (declare (type tree node))
  (let ((fn (bst-lessfn node)))
    (declare (type function fn))
    (funcall fn x (bst-value node))))

(defun eq (x node)
  "Return true if & oly if X's bst-value is equal to the bst-value in NODE."
  (declare (type tree node))
  (let ((fn (bst-equalfn node)))
    (declare (type function fn))
    (funcall fn x (bst-value node))))

(defun gt (x node)
  "Return true if & only if X's bst-value is greater than NODE's bst-value."
  (not (lt x node) (xeq x node)))

(defun ge (x node)
  "Return true if & only if... Greater than or Equal to."
  (not (lt x node)))

(defun xmember (x tree)
  (cond ((null tree) nil)
	((xlt x tree) (xmember x (bst-left tree)))
	((xgt x tree) (xmember x (bst-right tree)))
	(t)))

(defun insert (x tree)
  (cond ((endp tree) (make-bst :bst-value x :less nil :bst-right nil
				:bst-lessfn (bst-lessfn tree)
				:bst-equalfn (bst-equalfn tree)))
	((xlt x tree) (make-bst :bst-value (bst-value tree)
				 :bst-left (insert x (bst-left tree))
				 :bst-right (bst-right tree)
				 :bst-lessfn (bst-lessfn tree)
				 :bst-equalfn (bst-equalfn tree)))
	((xgt x tree) (make-bst :bst-value (bst-value tree)
				 :bst-left (bst-left tree)
				 :bst-right (insert x (bst-right tree))
				 :bst-lessfn (bst-lessfn tree)
				 :bst-equalfn (bst-equalfn tree)))
	(t tree)))

(deftest test0000 ()
  "Null test.  Always succeeds."
  'test0000)

(deftest test0010 ()
  "Test that we can create an empty tree without crashing.  It's not
really an empty tree because a true empty tree is NIL."
  (make-bst)
  'test0010)

(deftest test0050 ()
  "Test that INSERT into an empty tree does not crash."
  (insert 42 ()))

;;; --- end of file ---