;; ----------------------------------
;;               John Paxton
;;                 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)
 )
)

;; ------- EXAMPLE CLASS DEFINITION ---------------

(defclass example ()
 (
  (classification :accessor classification :initarg :classification)
  (data :accessor data :initarg :data)
 )
)

;; ----------------------------------
;; Both "zero" and "rand" are possible
;; perceptron weight initialization functions
;; ----------------------------------

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

;; ----------------------------------
;; initialize
;; ----------------------------------
;; p: a perceptron
;; size: the number of input nodes 
;; alpha: the learning constant
;; fn: the initialization function
;; ---------------------------------
;; Creates a perceptron with 1 output node
;; ---------------------------------


(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 
;; ---------------------------------
;; p: a perceptron
;; misclassified: a possibly misclassified example
;; ---------------------------------
;; Print the percepton
;; ---------------------------------

(defmethod print-perceptron ((p perceptron) &optional (misclassified nil))
  (dotimes (i (length (weights p)))
    (format t "~6,2f " (aref (weights p) i))
  )

  (if misclassified
    (format t " <--> ~a ~a~%" (data misclassified) (classification misclassified))
    (format t "~%")
  )
)

;; ---------------------------------
;; classify
;; ---------------------------------
;; p: a perceptron
;; example: an example to classify
;; ---------------------------------
;; Classify the example with the perceptron.
;; ---------------------------------

(defmethod classify ((p perceptron) example)

  (do*
   (
    (sum 0)                                
    (position 0 (+ 1 position))
    (whats-left example (rest whats-left))
    (component (first whats-left) (first whats-left))
   )
   ((null whats-left) (if (> sum 0) 1 -1))
     (setf sum (+ sum (* (aref (weights p) position) component)))
  ) 
)

;; ---------------------------------
;; learn
;; ---------------------------------
;; p: a perceptron
;; example: the example to learn
;; correct-classification: the correct classification
;;            of the example
;; ---------------------------------
;; Update the perceptron weights
;; ---------------------------------

(defmethod learn ((p perceptron) example correct-classification)
  (do*
   (
    (i 0 (+ i 1))
    (data example (rest data))
    (datum (first data) (first data))
   )
   ((null data))
     (setf (aref (weights p) i) (+ (aref (weights p) i)
	     (* correct-classification (alpha p) datum)))
  )
)

;; ---------------------------------
;; train
;; ---------------------------------
;; p: a perceptron
;; examples: classified examples
;; ---------------------------------
;; Train the perceptron until it perfectly
;; classifies the examples
;; ---------------------------------

(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 (= (classification example) (classify p (data example))))
	   (setf done nil)
	   (learn p (data example) (classification example)))
       )
     ) ; dolist
  ) ; do
  (print-perceptron p nil)
)

;; ---------------------------------
;; demonstrate
;; ---------------------------------
;; examples: classified examples to learn
;; alpha: learning rate
;; initialization-function: how to initialize the perceptron weights
;; ---------------------------------
;; A high level driver function.  It creates a perceptron and
;; then trains it on the "examples".
;; ---------------------------------

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

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

;; ---------------------------------

(demonstrate 
  (list 
    (make-instance 'example :classification 1 :data '(1 1 1))
  ) 1 #'zero
)

(demonstrate 
  (list 
    (make-instance 'example :classification 1 :data '(1 1 1))
  ) .1 #'rand
)

(demonstrate    ;; 2 input or
  (list 
    (make-instance 'example :classification 1 :data '(1 1 1))
    (make-instance 'example :classification 1 :data '(1 1 -1))
    (make-instance 'example :classification 1 :data '(1 -1 1))
    (make-instance 'example :classification -1 :data '(1 -1 -1))
  ) 1 #'zero
)

(demonstrate    ;; 2 input and 
  (list 
    (make-instance 'example :classification 1 :data '(1 1 1))
    (make-instance 'example :classification -1 :data '(1 1 -1))
    (make-instance 'example :classification -1 :data '(1 -1 1))
    (make-instance 'example :classification -1 :data '(1 -1 -1))
  ) 1 #'zero
)