;; ----------------------------------
;;               John Paxton
;;             October 25, 2004
;;                 CS 436
;;               perceptron.l
;; ----------------------------------
;; The contents of this file demonstrate
;; the concept of a perceptron.
;; ----------------------------------

;; ------- PERCEPTRON CLASS DEFINITION ------------

(defclass perceptron ()
 (
  (weights :accessor weights)
  (alpha :accessor alpha)
 )
)

;; ------- Weight Initialization Functions --------

(defun zero () 0)
(defun rand () (- 1 (* 2 (random 1.0))))

;; ------- Initialize Method ----------------------

(defmethod initialize ((p perceptron) size alpha fn)
  (setf (alpha p) alpha)
  (setf (weights p) (make-array size))
  (dotimes (i size)
    (setf (aref (weights p) i) (funcall fn))
  )
)

;; ------- Print-Perceptron Method ----------------

(defmethod print-perceptron ((p perceptron) next-example)
  (dotimes (i (length (weights p)))
    (format t "~6,2f " (aref (weights p) i))
  )
  (format t " <--> ~a~%" next-example)
)

;; ------- Classify Method ------------------------

(defmethod classify ((p perceptron) example)
 (let
   ((sum 0))

   (dotimes (i (length example))
     (setf sum (+ sum (* (aref (weights p) i) (nth i example))))
   )

   (if (> sum 0) 1 -1)
 )
)

;; ------- Learn Method ---------------------------

(defmethod learn ((p perceptron) example multiplier)
  (dotimes (i (length example))
    (setf (aref (weights p) i) 
          (+ (aref (weights p) i) 
	     (* multiplier (alpha p) (nth i example))))
   )
)

;; ------- Train Method ---------------------------

(defmethod train ((p perceptron) examples)
  (print-perceptron p nil)
  (do
   ((done nil))
   (done)
     (setf done t)
     (dolist (example examples)
       (print-perceptron p example)
       (cond
         ((not (= (first example) (classify p (second example))))
	   (setf done nil)
	   (learn p (second example) (first example)))
       )
     ) ; dolist
  ) ; do
  (print-perceptron p nil)
)

;; ------- Demonstrate Function --------------------

(defun demonstrate ( examples alpha initialize-function )
  (let
    ((my-perceptron (make-instance 'perceptron)))

    (format t "~%~%-------------------~%~%")
    (initialize my-perceptron (length (second (first examples)))
              alpha initialize-function)
    (train my-perceptron examples)
  )
)

(demonstrate '((1 (1 1 1))) 1 #'zero)

(demonstrate '((1 (1 1 1))) .1 #'rand)

;; 2-input or

(demonstrate '((1 (1 1 1))(1 (1 1 -1))(1 (1 -1 1))(-1 (1 -1 -1))) 1 #'zero)

;; 2-input and

(demonstrate '((1 (1 1 1))(-1 (1 1 -1))(-1 (1 -1 1))(-1 (1 -1 -1))) 1 #'zero)

;; 2-input xor

; (demonstrate '((-1 (1 1 1))(1 (1 1 -1))(1 (1 -1 1))(-1 (1 -1 -1))) 1 #'zero)

(demonstrate '((1 (-1 1 -1 1 -1))(-1 (-1 1 1 -1 -1))  (-1 (1 -1 1 -1 -1))(-1 (1 -1 -1 1 -1))) 1 #'rand)