;;;; 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)           ; Stores the final learned perceptron.

(setf test1 '((+ (0 1 0))           ; Simple testing example
              (+ (1 0 1))
              (+ (1 1 1))
              (- (0 0 1))))

(setf test2 '((- (0 0))             ; Infamous XOR example
              (+ (0 1))
              (+ (1 0))
              (- (1 1))))



(defun perceptron (examples &optional (threshold 0))
  (let* ((num-features (length (second (first examples))))
         (weights (make-array (list num-features)    ; define weight vector
                              :initial-element 0))   ; weights initalized to 0
         (all-correct nil) (i 0) (trial-num 0))
    (print-perceptron weights threshold)
    (do ()                   ; Loop until all examples are correctly classified
	(all-correct nil)
        (setf all-correct t)
        (dolist (example examples)     ; Each trial look at all examples
            (if (compute-perceptron-output (second example) weights threshold)
                (cond ((eq (first example) `-)  ; If network says + but its -
                       (format t "~%~%Classifies ~A wrong" example)
                       (setf all-correct nil)
                       (incf threshold 1)   ; Then increase threshold to
                                            ; make + classification harder
                       ;; and decrement weights for features present in example
                       (setf i 0)
                       (dolist (feature-value (second example))
                         (when (eq feature-value 1)
                           (incf (aref weights i) -1))
                         (incf i)))
                      (t (format t "~%~%Classifies ~A right" example)))
                (cond ((eq (first example) '+)  ; If network says - but its +
                       (format t "~%~%Classifies ~A wrong" example)
                       (setf all-correct nil)
                       (incf threshold -1)    ; Then decrease threshold to
                                              ; make + classification easier
                       ;; and increment weights for features present in example
                       (setf i 0)
                       (dolist (feature-value (second example))
                         (when (eq feature-value 1)
                           (incf (aref weights i) 1))
                         (incf i)))
                      (t (format t "~%~%Classifies ~A right" example)))))
         (incf trial-num)                  ; Keep track of the number of trials
         (print-perceptron weights threshold))
    (format t "~%Trials: ~A" trial-num)
    (setf *perceptron* (list weights threshold)))) ; Return the final perceptron


(defun compute-perceptron-output (feature-values weights threshold)
  ;;; Determine value of perceptron for the given input. Return T or NIL
  ;;; instead of 0 or 1 to simply tests

  (let ((sum 0) (i 0))
    ;; Simply sum the weight*input for all of the features
    ;; and return T if greater than threshold.
    (dolist (feature-value feature-values)
      (when (eq feature-value 1)
        (incf sum (aref weights i)))
      (incf i))
    (> sum threshold)))


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

  (format t "~%~%Weights:")
  (dotimes (i (length weights))
    (format t " ~A" (aref weights i)))
  (format t "~%Threshold: ~A" threshold))