;;; Contains stuff for setting up and running tests for multi-category learning tasks
;;; like soybean disease diagnosis. In comments, *-CATEGORIES refers to the system
;;; dependent function of this form (e.g. ID3-CATEGORIES) *-CATEGORIES for each
;;; domain should set the variable *INSTANCE-TESTER* to define the tester for that
;;; system.

(defvar *instance-tester* nil)

(defun separate-instances (categories num-learn-instances &optional num-test-instances)
  ;;; Separates a list of instances for a set of categories into learning and testing
  ;;; instances to facilitate experimentation in preparation for using *-CATEGORIES
  ;;; and TEST-CATEGORIES.  The variable categories should be bound to a list of
  ;;; category names whose values are a list of instances of that category. The first
  ;;; num-learn-instances of these instances are stored on the LEARN-INSTANCES property
  ;;; to be used for learning and the rest are stored on TEST-INSTANCES for testing.
  
  (dolist (category categories)
    (setf (get category 'learn-instances) 
	  (subseq (eval category) 0 num-learn-instances))
    (if num-test-instances
	(setf (get category 'test-instances)
	  (subseq (eval category) (- (length (eval category)) num-test-instances)))
	(setf (get category 'test-instances)
	  (subseq (eval category) num-learn-instances)))))


(defun test-categories (categories &optional learn-instances?)
  ;;; To be used after *-CATEGORIES in order to test the generalizations learned 
  ;;; on a  set of new instances stored under the TEST-INSTANCES property of each category
  ;;; name in categories.  Reports % correct for each category and overall % correct.

  (let ((percent-sum 0)(percent 0))
    (dolist (category categories)
      (format t "~%~%Testing ~A instances" category)
      (let ((answers (mapcar #'(lambda (instance)
				 (funcall *instance-tester* instance categories))
			     (get category (if learn-instances?
					       'learn-instances
					       'test-instances))))
	    (count 0))
	(format t "~%~A" answers)
	(dolist (answer answers) (if (and (eq (first answer) category)(null (rest answer)))
				     (incf count)))
	(setf percent (* 100 (/ count (length answers))))
	(incf percent-sum percent)
	(format t "~%Percent correct: ~,2F" percent)))
    (format t "~%~%Total percent correct: ~,2F" (/ percent-sum (length categories)))))