LISP
;;; This is one of the example programs from the textbook:
;;;
;;; Artificial Intelligence:
;;; Structures and strategies for complex problem solving
;;;
;;; by George F. Luger and William A. Stubblefield
;;;
;;; These programs are copyrighted by Benjamin/Cummings Publishers.
;;;
;;; We offer them for use, free of charge, for educational purposes only.
;;;
;;; Disclaimer: These programs are provided with no warranty whatsoever as to
;;; their correctness, reliability, or any other property. We have written
;;; them for specific educational purposes, and have made no effort
;;; to produce commercial quality computer programs. Please do not expect
;;; more of them then we have intended.
;;;
;;; This file defines the ID3 algorithm presented in chapter 14 of the
;;; text.
;;;
;;; For a set of example data, along with instructions for its use,
;;; see the file credit.lisp
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Data structure definitions
(defstruct property
name ; the name of the property
test ; an evaluable function of 1 argument,
; returns a property value
values) ; a list of all possible values returned by the test
(defstruct example-frame
instances ; A list of objects of known classification
properties ; A list of properties of objects in the domain.
; These will be used to define the tree
classifier ; A property that classifies objects in instances.
; The values of the classifier will be the eaves of the tree
size ; The number of objects in instances
information) ; The information content of instances
(defstruct partition
test-name ; the name of the property used to partition the examples
test ; a test function
components ; an alist of (property-value . example-frame) pairs
info-gain) ; information gain across all components of the partition
(defstruct decision-tree
test-name ; the name of the property used to select a branch
test ; an evaluable function, returns a property value used to select a branch
branches) ; an a-list of branches, indexed by the values of test
(defstruct leaf
value)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to construct a decision tree using the ID3 algorithm
(defun build-tree (training-frame)
(cond
; Case 1: Empty example set. Create leaf with no classification
((zerop (example-frame-size training-frame))
(make-leaf :value "unable to classify: no examples"))
; Case 2: All properties used. Create leaf with all remaining classes (may be ambiguous)
((null (example-frame-properties training-frame))
(make-leaf :value (list-classes training-frame)))
; Case 3: All instances of same class. Create a leaf
((zerop (example-frame-information training-frame))
(make-leaf :value (funcall
(property-test (example-frame-classifier training-frame))
(car (example-frame-instances training-frame)))))
; Case 4: Choose test for root of tree & recursively build subtrees
(t (let ((part (choose-partition (gen-partitions training-frame))))
(make-decision-tree
:test-name (partition-test-name part)
:test (partition-test part)
:branches (mapcar #'(lambda (x)
(cons (car x) (build-tree (cdr x))))
(partition-components part)))))))
; Generate all different partitions of an example frame
(defun gen-partitions (training-frame)
(mapcar #'(lambda (x) (partition training-frame x))
(example-frame-properties training-frame)))
; Partition takes an example frame and a property;
; It partitions the example frame on that property
; and returns an instance of a partition structure,
; where partition-components is an a-list of (property-value . example-frame) pairs
;
; It also computes the information gain and other statistics
; for each component of the partition
(defun partition (root-frame property)
; Initialize parts to to an a-list of empty example frames
; indexed by the values of property
(let ((parts (mapcar #'(lambda (x) (cons x (make-example-frame)))
(property-values property))))
; partition examples on property, placing each example in the appropriate
; example frame in parts
(dolist (instance (example-frame-instances root-frame))
(push instance (example-frame-instances
(cdr (assoc (funcall (property-test property) instance)
parts)))))
; complete information in each component of the partition
(mapcar #'(lambda (x)
(let ((frame (cdr x)))
(setf (example-frame-properties frame)
(remove property (example-frame-properties root-frame)))
(setf (example-frame-classifier frame)
(example-frame-classifier root-frame))
(setf (example-frame-size frame)
(list-length (example-frame-instances frame)))
(setf (example-frame-information frame)
(compute-information
(example-frame-instances frame)
(example-frame-classifier root-frame)))))
parts)
; return an instance of a partition
(make-partition
:test-name (property-name property)
:test (property-test property)
:components parts
:info-gain (compute-info-gain root-frame parts))))
; Choose partition takes a list of candidate partitions and chooses
; The one with the highest information gain
(defun choose-partition (candidates)
(cond ((null candidates) nil)
((= (list-length candidates) 1)
(car candidates))
(t (let ((best (choose-partition (cdr candidates))))
(if (> (partition-info-gain (car candidates))
(partition-info-gain best))
(car candidates)
best)))))
; Lists all the classes in the instances of a training frame
(defun list-classes (training-frame)
; Eliminate those potential classifications not present
; in the instances of training frame
(do
((classes (property-values (example-frame-classifier training-frame))
(cdr classes))
(classifier (property-test (example-frame-classifier training-frame)))
classes-present)
((null classes) classes-present)
(if (member (car classes) (example-frame-instances training-frame)
:test #'(lambda (x y) (equal x (funcall classifier y))))
(setf classes-present (cons (car classes) classes-present)))))
; compute the information gain of a partition
; by subtracting the weighted average of the information
; in the children from the information in
; the original set of instances.
(defun compute-info-gain (root parts)
(- (example-frame-information root)
(sum #'(lambda (x) (* (example-frame-information (cdr x))
(/ (example-frame-size (cdr x))
(example-frame-size root))))
parts)))
; sum takes the sum of applying f to all numbers in list-of-numbers
(defun sum (f list-of-numbers)
(apply '+ (mapcar f list-of-numbers)))
; Computes the information content of a list of examples using a classifier.
(defun compute-information (examples classifier)
(let ((class-count
(mapcar #'(lambda (x) (cons x 0)) (property-values classifier)))
(size 0))
; count number of instances in each class
(dolist (instance examples)
(incf size)
(incf (cdr (assoc (funcall (property-test classifier) instance)
class-count))))
;compute information content of examples
(sum #'(lambda (x) (if (= (cdr x) 0) 0
(* -1
(/ (cdr x) size)
(log (/ (cdr x) size) 2))))
class-count)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;; Classifies an instance using a decision tree
(defun classify (instance tree)
(if (leaf-p tree)
(leaf-value tree)
(classify instance
(cdr (assoc (funcall (decision-tree-test tree) instance)
(decision-tree-branches tree))))))
Close Window