;;; *********************************************************************
;;; Susan Fox
;;; December 27, 2000

;;; Memory here is a decision tree where each interior node has
;;; a procedure which returns a number between 0 and N, where the node
;;; has N+1 children.  Leaves are actual cases


;;; This requires the Case ADT
(if (not (top-level-bound? 'CASE.SSLOADED))
    (load "case.ss"))


(define MEMORY.SSLOADED #t)


;;; Then there is a Node ADT and finally a Memory tree ADT


;;; *********************************************************************
;;; Node ADT

;;; A node is a list whose first element is either an index
;;; or the keyword 'leaf if the node is a leaf

;;; make-node makes what will ultimately be an interior node
;;; It takes an incomplete index , a value N which tells how many children
;;; the node has, and then N children.  If some children are
;;; not yet specified, they should be given as an empty tree
;;;
(define make-node
  (lambda (match-index n . kids)
    (if (not (= (length kids) n))
	(error 'make-node "Improper number of children given to node")
	(cons match-index kids))))


;;; make-leaf takes a case and returns a leaf node wrapping it
;;;
(define make-leaf
  (lambda cases
    (cons 'leaf cases)))


;;; leaf? takes a node and return true if it is a leaf
;;;
(define leaf?
  (lambda (node)
    (eq? (car node) 'leaf)))


;;; ith-child takes a node and an integer and returns the ith
;;; child of the node
;;;
(define ith-child
  (lambda (node i)
    (if (leaf? node)
	(error 'ith-child "No children of a leaf node")
	(list-ref (cdr node) i))))


;;; num-kids takes a node and returns the number of childre
;;;
(define num-kids
  (lambda (node)
    (if (leaf? node)
	0
	(length (cdr node)))))


;;; add-case takes a leaf node and a case and adds the case to
;;; the cases at that leaf
;;;
(define add-case!
  (lambda (node case)
    (if (not (leaf? node))
	(error 'add-case! "Must add cases to leaves")
	(set-cdr! case (cons node (cdr case))))))


;;; add-child! takes an interior node, a integer i, and a
;;; new child node, and mutates the interior node to have
;;; the new child at the ith position.  It prints a warning
;;; if there is already a child node at that position
;;;
(define add-child!
  (lambda (node i new-kid)
    (if (leaf? node)
	(error 'add-child! "Must add nodes to interior nodes")
	(begin
	  (if (not (empty-tree? (ith-child node i)))
	      (printf "Warning!  Adding a child where one exists already!~n"))
	  (set-car! (list-at-i i (cdr node)) new-kid)))))



;;; node-index takes a node, and returns the index at that
;;; node, which specifies the features required of cases that in the
;;; tree.  It returns #f if the node is not an interior node
;;;
(define node-index
  (lambda (node)
    (if (leaf? node)
	#f
	(car node))))


;;; node-children takes an interior node and returns the children
;;; subtrees of that node in a list
;;;
(define node-children
  (lambda (node)
    (if (leaf? node)
	#f
	(cdr node))))


;;; get-cases takes a leaf node and returns the list of cases
;;; at that node.  It returns #f if the node is not an interior ndoe
;;;
(define get-cases
  (lambda (node)
    (if (leaf? node)
	(cdr node)
	#f)))


;;; *********************************************************************
;;; Tree ADT

;;; Actually, most of the tree operations are defined in the Node part
;;; but the key idea here is the lookup operation, and adding a
;;; case to the tree, and splitting a leaf into interior node and
;;; children

;;; In selecting cases we must choose a cut-off for acceptability...
;;; Initially we'll just pick the midpoint of the range
;;;
(define Match-Cutoff (average Min-Score Max-Score))
  


;;; make-empty-tree just makes a placeholder empty tree
;;;
(define make-empty-tree
  (lambda ()
    '(empty-tree)))


;;; empty-tree? returns #t if passed an empty tree
;;;
(define empty-tree?
  (lambda (node)
    (equal? node '(empty-tree))))



;;; insert-case takes a case and a tree (a node), and finds the appropriate
;;; leaf to which to add the case.  If it is not a leaf, then we
;;; calculate the case's match to each child, and pick the minimum one
;;; to search further
;;;
(define insert-case!
  (lambda (case tree)
    (if (leaf? tree)
	(add-case! tree case)
	(letrec
	    ([pick-kid
	       (lambda (kids best-kid best-val)
		 (cond
		   [(null? kids)
		    (insert-case! case best-kid)]
		   [(not best-kid)
		    (pick-kid (cdr kids) (car kids)
		      (match? (index-of case) (node-index (car kids))))]
		   [else
		     (let ([m-val (match? (index-of case)
				    (node-index (car kids)))])
		       (if (< m-val best-val)
			   (pick-kid (cdr kids) (car kids) m-val)
			   (pick-kid (cdr kids) best-kid best-val)))]))])
	  (pick-kid (node-children node) #f #f)))))



;;; lookup-cases takes an index and a decision tree and returns all
;;; the cases in the matching leaf of the decision tree
;;; (NOTE:  this procedure may change to permit partial matching
;;;  at a later point, for now the decision tree will be used to
;;;  discriminate between altogether bad matches and half-decent
;;;  ones)
;;;
(define lookup-cases
  (lambda (index tree)
    (letrec
	([lookup-kids
	   (lambda (kids)
	     (cond
	       [(null? kids) '()]
	       [(empty-tree? (car kids))  (lookup-kids (cdr kids))]
	       [(leaf? (car kids)) (get-cases (car kids))]
	       [(< (match? index (node-index (car kids)))
		  Match-Cutoff)
		(append (lookup-cases index (car kids))
		  (lookup-kids (cdr kids)))]
	       [else (lookup-kids (cdr kids))]))])
      (lookup-kids (node-children tree)))))