;;;; ID3.LISP
;;;;     Quinlan's ID3 Algorithm for constructing decision trees
;;;;     for learning from examples.
;;;;     (See article by Quinlan in ML 1:1, 1986 or Mitchell's Decision Tree chapter.)

;;;; Copyright (C) 1988, 1989, 1995 by Jude William Shavlik.
;;;;         This program may be freely copied, used, or 
;;;;         modified provided that this copyright notice 
;;;;         is included in each copy of this code and parts thereof.

;;;; This implementation of ID3 produces decision trees descriminating positive
;;;; and negative instances.  Instances are represented by simple nominal features.
;;;; A keyword rather than a positional representation is used.  See the file
;;;; FIGS.DATA for an example.  Useful example-building programs are contained
;;;; in BUILD-EXAMPLES.LISP.   RUN-ID3 provides a nice user interface.
;;;; Use MEASURE-CORRECTNESS to estimate the effectiveness of ID3.

;;;; Make sure the proper lisp is being used.
(unless (member "AW" (mapcar #'package-name (list-all-packages)) :test #'EQUAL)
  (error "You must use lispAW, not lisp.  
         (/p/course/cs540-shavlik/public/agent-world/lispAW)"))

;;;; Some lines in this file are longer than 80 characters.
;;;; You may wish to use "enscript -rG -fCourier7 -Plaser ID3.LISP" to print.
;;;; (At UW-Madison only, you can use: "print -landscape -Plaser ID3.LISP")

;;; ---------------------------------------------------------------------------
;;;                     Global variables used by ID3.
;;; ---------------------------------------------------------------------------

(defvar *trace-id3*        t "Produces a trace of operation if set.")
(defvar *current-tree*   nil "The most recently learned decision tree.")


;;; ---------------------------------------------------------------------------
;;;                        The Main Functions
;;; ---------------------------------------------------------------------------
(defun id3 (examples possible-features splitting-function
		     &optional (majority-class-of-parent '-))
  "A simple version of Quinlan's ID3 Program - see Machine Learning 1:1, 1986.
   Numeric feature values, noisy data, and missing values are not handled."
 ;;; This function produces a decision tree that classifies the examples 
 ;;; provided, using these features.  The splitting function determines
 ;;; which feature should be used to split a collection of + and - examples.
 ;;; If all the examples are of the same type, a leaf node is returned.
  
 ;;; The resulting decision tree is a list of the form 
 ;;;     (feature (value1 subtree1) (value2 subtree2) ... ) 
 ;;;  or (decision  #-of-examples-in-training-set-located-here)
 ;;; In the first case, depending on the value of feature, another decision
 ;;; tree must be traversed to make a decision.  In the second case, a
 ;;; decision is recorded, along with the number of examples from the
 ;;; training set that would be placed at this node.
  
 ;;;  See RUN-ID3 for a nice user interface to this function.
  
 ;;;  It is assumed that every example has a valid value for each feature.
 ;;;  The function VALIDATE-EXAMPLES can be used to pre-process examples. 
  
  (cond ((null examples)  ; No more examples, an "undecided" node.
	 (list majority-class-of-parent 0)) ;Use the majority class at the parent node.
	((all-positive? examples) `(+ , (length examples)))
	((all-negative? examples) `(- , (length examples)))
	((null possible-features) ;Used all the features, yet not all same class.
	 (error "Out of features - inconsistent data:~% ~A" examples))
	(t (let* ((chosen-feature 
		   (choose-feature examples possible-features splitting-function))
		  (remaining-features (remove chosen-feature possible-features))
		  (current-majority-class (if (> (count-positives examples)
						 (count-negatives examples))
					      '+ '-))) ;used to fill `NULL' nodes
	     (cons chosen-feature 
		   (mapcar #'(lambda (value)
			       (list value 
				     (id3 (collect-examples-with-this-value 
					   examples chosen-feature value)
					  remaining-features
					  splitting-function
					  current-majority-class)))
			   (get-base-values chosen-feature)))))))

(defun choose-feature (examples features splitting-function)
  "Choose an feature to split these examples into sub-groups.
   The method of doing so is specified by the third argument."
  (case splitting-function
    (random      (choose-random features)) ; make an arbitrary choice
    (least-values   nil) ; choose the one with the least possible values - TO BE WRITTEN
    (most-values    nil) ; choose the feature with the most - TO BE WRITTEN 
    (max-gain       nil) ; use Quinlan's gain measure (pg. 90) to choose - TO BE WRITTEN
    (max-gain-ratio nil) ; use Quinlan's gain ratio measure (pg. 102) to choose - TO BE WRITTEN
    (otherwise (error "ERROR - unknown splitting function."))
    ))

(defun make-decision (example &optional (decision-tree *current-tree*) )
  "Use this decision tree to classify this unclassified instance."
  ;;     - TO BE WRITTEN
  (warning 'make-decision) ;Delete this line when you write this function.
  '-)

;;; ---------------------------------------------------------------------------
;;;                  Some useful utility functions.
;;; ---------------------------------------------------------------------------

(defun run-id3 (&optional (examples *train-examples*) (splitting-function 'random)
			  (examples-file "CATEGORIZED.DATA")
			  (report-tree? *trace-id3*) 
			  &aux start-time)
  "Check these examples for correctness, build a decision tree, then 
   draw the tree (if requested) and, finally, report some statistics about it."
  (when (null examples) 
    (format t "~%~%Constructing the test set ... ")
    (build-example-lists examples-file)
    (format t " ~D training examples produced." (length *train-examples*))
    (setf examples *train-examples*))
  (format t "~%~%Building Decision Tree ...")
  (if (validate-examples examples)
      (progn (setf start-time (get-internal-run-time))
	     (setf *current-tree* (id3 examples *all-features* splitting-function))
	     (format t " finished in ~,3F sec.~%" 
		     (convert-to-sec (- (get-internal-run-time) start-time)))
	     (if report-tree? (print-decision-tree))
	     (let ( (interior-nodes (count-interior-nodes *current-tree*))
		    (leaf-nodes     (count-leaf-nodes *current-tree*)))
	       (format t "~%~%Tree size=~A    interior nodes=~A  leaf-nodes=~A~%" 
		       (+ interior-nodes leaf-nodes) interior-nodes leaf-nodes))
	     (format t "   positive leaves=~A  negative leaves=~A  undecided leaves=~A ~%~%"
		     (count-matching-leaves *current-tree* '+)
		     (count-matching-leaves *current-tree* '-)
		     (count-matching-leaves *current-tree* '?))
	     (measure-correctness 'make-decision *trace-ID3* *test-examples*))
    (format t "~%~% RUN ABORTED DUE TO ERRONEOUS TRAINING DATA.~%~%")))

(defun print-decision-tree (&optional (tree *current-tree*) (indent 0))
  "Draw this decision tree, using indentation to indicate levels."
  (cond ((leaf-node? tree) (format t " ~A (~A)" (first tree) (second tree)))
        (t (mapc #'(lambda (sub-tree) 
		     (format t "~%")
		     (dotimes (i (floor (/ indent 3))) (format t "|  "))
		     (format t "~A=~A:" (first tree) (first sub-tree))
		     (print-decision-tree (second sub-tree) (+ indent 3)))
                 (rest tree))))
  nil)

(defun count-interior-nodes (tree)
  "Count the interior (non-leaf) nodes in this tree."
  (if (leaf-node? tree) 0
    (1+ (reduce  #'+ (mapcar #'(lambda (arc) (count-interior-nodes (second arc)))
			     (rest tree))))))

(defun count-leaf-nodes (tree) 
  "Count the leaf nodes in this tree."
  (if (leaf-node? tree) 1
    (reduce #'+ (mapcar #'(lambda (arc) (count-leaf-nodes (second arc))) 
			(rest tree)))))

(defun count-matching-leaves (tree match)
  "Count the number of leaf nodes in this tree that match the second argument."
  (cond ((leaf-node? tree) (if (eq (first tree) match) 1 0))
        ((atom tree) 0)
        (t (+ (count-matching-leaves (first tree) match)
              (count-matching-leaves (rest  tree) match)))))

(defun leaf-node? (x)
  "Determine if this is a leaf node."
  (and (consp x) (member (first x) '(+ - ?))))