;;;; Copyright (c) 1988 by Raymond Joseph Mooney. 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.


(defvar *perceptron* nil)
(defvar *weights* nil)
(defvar *coef* nil)
(defvar *input* nil)
(defvar *output* nil)


(defun init (numnodes numexamples)
   (setf *weights* (make-array numnodes
		    :initial-element 0))
   (setf *coef* (make-array numnodes))            ; Define concept to be learned
   (dotimes (i numnodes)
      (setf (aref *coef* i) (random 3)))
                                                  ; Define input examples
   (setf *input* (make-array (list numexamples numnodes)
		  :element-type 'integer))
		    ; You will need to use type single-float on the CM simulator
   (dotimes (i numexamples)
      (dotimes (j numnodes)
	 (setf (aref *input* i j) (random 2))))
   (setf *output* (random numnodes)))


(defun perceptron (numnodes numexamples &optional (threshold 0))
  (let* ((all-correct nil) (trial-num 0) (actual nil) (desired nil))
    (init numnodes numexamples)
    (print-perceptron numnodes threshold)
    (do ()                   ; Loop until all examples are correctly classified
	(all-correct nil)
        (setf all-correct t)
        (dotimes (i numexamples)     ; Each trial look at all examples
	   (setf actual (compute-perceptron-output i numnodes threshold))
	   (setf desired (compute-desired-output i numnodes))
           (cond ((and actual (not desired))    ; false positive
                  (format t "~%~%Classifies ~A false positive" i)
		  (dotimes (j numnodes)
		     (format t " ~a" (aref *input* i j)))
		  (print-perceptron numnodes threshold)
                  (setf all-correct nil)
                  (incf threshold 1)   ; Then increase threshold to
                                       ; make + classification harder
                       ;; and decrement weights for features present in example
		  (dotimes (j numnodes)
		     (if (equal (aref *input* i j) 1)
			(incf (aref *weights* j) -1))))
                 ((and (not actual) desired)    ; false negative
                  (format t "~%~%Classifies ~A false negative" i)
		  (dotimes (j numnodes)
		     (format t " ~a" (aref *input* i j)))
		  (print-perceptron numnodes threshold)
                  (setf all-correct nil)
                  (incf threshold -1)   ; Then increase threshold to
                                        ; make + classification harder
                       ;; and decrement weights for features present in example
		  (dotimes (j numnodes)
		     (if (equal (aref *input* i j) 1)
			(incf (aref *weights* j) 1))))
                 (t (format t "~%~%Classifies ~A right" i)
		    (dotimes (j numnodes)
		       (format t " ~a" (aref *input* i j)))
		    (print-perceptron numnodes threshold))))
         (incf trial-num)                  ; Keep track of the number of trials
         (print-perceptron numnodes threshold))
    (format t "~%Trials: ~A" trial-num)
				           ; Return the final perceptron
    (setf *perceptron* (list *weights* threshold))))


(defun compute-perceptron-output (i numnodes threshold)
  ;;; Determine value of perceptron for the given input. Return T or NIL
  ;;; instead of 0 or 1 to simplify tests

  (let ((sum 0))
    ;; Simply sum the weight*input for all of the features
    ;; and return T if greater than threshold.
    (dotimes (j numnodes)
      (when (equal (aref *input* i j) 1)
        (incf sum (aref *weights* j))))
    (> sum threshold)))


(defun print-perceptron (numnodes threshold)
  ;; Printout the current weight vector and threshold

  (format t "~%~%Weights:")
  (dotimes (i numnodes)
     (format t " ~a" (aref *weights* i)))
  (format t "~%Threshold: ~a   Output: ~a" threshold *output*)
  (format t "~%Coefficients:")
  (dotimes (i numnodes)
     (format t " ~a" (aref *coef* i))))


(defun compute-desired-output (i numnodes)
   (let ((output 0))
      (dotimes (j numnodes)
	 (incf output (* (aref *input* i j) (aref *coef* j))))
      (>= output *output*)))