Next: Example Previous: Parameters That Can Affect
Perceptron Code

;;;; PERCEPTRON is a simple system for learning from examples which uses the
;;;; one-layer net learning procedure to adjust a set of weights on a single
;;;; linear threshold unit until all of the training examples are correctly
;;;; classified. The perceptron convergence theorem assures that the system
;;;; will halt if the examples are linearly separable but if not the system
;;;; may not halt.  The file BINARY-ENCODER contains the functions needed
;;;; for converting feature vector examples to bit strings
;;;; To run on multi-category problems like SOYBEAN-DATA, after loading the data
;;;; you must encode instances of all categories into bit strings using
;;;; ENCODE-CATEGORY-INSTANCES (e.g. (encode-category-instances soybean-cat
;;;; and then partition encoded examples into training and test sets using
;;;; SEPARATE-INSTANCES and then use PERCEPTRON-CATEGORIES to do the
;;;; learning and TEST-CATEGORIES to test the learned perceptron.

;;;; Uses functions defined in the files: BINARY-ENCODER and TESTER

;;;; 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 *trace-perceptron* t)       ; produces trace of weight updates if T.
(defvar *perceptron* nil)           ; Stores the final learned perceptron.
(defvar *domains*)                  ; List of domains (possible value list) for
                                    ; each feature
(defvar *eta* 1)                    ; Learning rate

(setf testor '((- (0 0))           ; Logical OR
               (+ (0 1))
	       (+ (1 0))
	       (+ (1 1))))

(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))))

(setf test3 '((- (0 0))           ; Logical AND
              (- (0 1))
	      (- (1 0))
	      (+ (1 1))))

(defmacro trace-print (test-var &rest format-form)
  ;; Print using the format string only is test-var is nonNIL
  `(if ,test-var
       (format t ,@format-form)))

(defun perceptron (examples &optional (threshold 0))
  (let* ((num-features (length (second (first examples))))
         (weights (make-array (list num-features)    ; define weight vector
                              :element-type 'number
                              :initial-element 0))   ; weights initialized to 0
         (all-correct nil) (i 0) (trial-num 0))
    (when *trace-perceptron* (print-perceptron weights threshold))
    (loop (if all-correct (return nil))  ; Loop until all examples are correctly
          (setf all-correct t)           ; classified.
          (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 -
                       (trace-print *trace-perceptron*
                          "~%~%Classifies ~A wrong" example)
                       (setf all-correct nil)
                       (incf threshold *eta*)   ; 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) (- *eta*))
                           (trace-print *trace-perceptron*
                                "~%Decrementing weight for feature ~A" (- i 1)))
                         (incf i)))
                      (t (trace-print *trace-perceptron*
                          "~%~%Classifies ~A right" example)))
                (cond ((eq (first example) '+)  ; If network says - but its +
                       (trace-print *trace-perceptron*
                          "~%~%Classifies ~A wrong" example)
                       (setf all-correct nil)
                       (incf threshold (- *eta*)) ; 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) *eta*)
                           (trace-print *trace-perceptron*
                                "~%Incrementing weight for feature ~A" (+ i 1))) 
                        (incf i)))
                      (t (trace-print *trace-perceptron*
                            "~%~%Classifies ~A right" example)))))
          (incf trial-num)                  ; Keep track of the number of trials
          (when *trace-perceptron* (print-perceptron weights threshold)))
    (format t "~%Trials: ~A" trial-num)
    (unless *trace-perceptron* (print-perceptron weights threshold))
    (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))