(defun check-perceptron (tr)
     (let (w)
	 (setf w (p tr)) 
	  (mapcar #'(lambda (x)  (dotproduct w (butlast x)))
			
               tr)))

(defun p (tr)
     (perc (mapcar #'(lambda (x) x 0.0) (butlast (first tr)))
	   tr))
(defun thresh (x) (If (> x 0.0) 1.0 0.0))

(defun perc (w tr)
   (let (winit)
      (setf  winit w) 
      (mapc  #'(lambda (x)
	 (print
	    (setf w
              (mapcar #'(lambda (wi xi)
	      (- wi
               (* xi  (- (thresh (dotproduct w (butlast x)))
                     (first (last x))))))
                     w (butlast x))))
            (terpri)
		    )
          tr)       
       (if (equal w winit) w
	   (perc w tr))))

(defun dotproduct (v1 v2)
     (apply #'+ (mapcar #'* v1 v2)))

(setf or '((0 0 -1 0)
           (0 1 -1 1)
	   (1 0 -1 1)
	   (1 1  -1 1)))

(setf xor '((0 0 -1 0)
            (0 1 -1 1)
	    (1 0 -1 1)
	    (1 1 -1 0)))

(setf xorp '((0 0 0 -1 0)
             (0 1 0 -1 1) 
	     (1 0 0 -1 1)
	     (1 1 1 -1 0)))


(setf and '((0 0 -1 0)
            (0 1 -1 0)
	    (1 0 -1 0) 
	    (1 1 -1 1)))

(setf maj3 '((0 0 0 -1 0)
             (0 0 1 -1 0)  
	     (0 1 0 -1 0)
	     (0 1 1 -1 1)
	     (1 0 0 -1 0)
	     (1 0 1 -1 1)
	     (1 1 0 -1 1)
	     (1 1 1 -1 1)))

(setf allergy
       '((-1 -1 -1 -1 -1 1.0)
	 (0  1  -1  1 -1  0.0)  
	 (-1 1  0   -1 -1 1.0)
         (1  -1 1   -1 -1 0.0)
         (-1 -1 1   1  -1 0.0)))

(setf parity4
          '((0 0 0 0 -1 1)
	    (0 0 0 1 -1 0)
	    (0 0 1 0 -1 0)
	    (0 0 1 1 -1 1)
	    (0 1 0 0  -1 0)
	    (0 1 0 1  -1 1)
	    (0 1 1 0  -1 1)
	    (0 1 1 1  -1 0)
           (1 0 0 0 -1 0)
	    (1 0 0 1 -1 1)
	    (1 0 1 0 -1 1)
	    (1 0 1 1 -1 0)
	    (1 1 0 0  -1 1)
	    (1 1 0 1  -1 0)
	    (1 1 1 0  -1 0)
	    (1 1 1 1  -1 1)))

(setf parity4s
          '((0 0 0 0 0 0   -1 1)
	    (0 0 0 1 1 0 -1 0)
	    (0 0 1 0 1 0  -1 0)
	    (0 0 1 1 2 0 -1 1)
	    (0 1 0 0 1 0  -1 0)
	    (0 1 0 1 2 0  -1 1)
	    (0 1 1 0 2 0   -1 1)
	    (0 1 1 1 3 0  -1 0)
           (1 0 0 0 1 0 -1 0)
	    (1 0 0 1 2 0 -1 1)
	    (1 0 1 0 2 0 -1 1)
	    (1 0 1 1 3 0 -1 0)
	    (1 1 0 0 2 0  -1 1)
	    (1 1 0 1 3 0  -1 0)
	    (1 1 1 0 3 0  -1 0)
	    (1 1 1 1 4 1 -1 1)))
	             
(setf  prob20-5
                 '((1 0 1 0 0 0 -1 1)
		   (1 0 1 1 0 0 -1 1)
		   (1 0 1 0 1 0 -1 1)
		   (1 1 0 0 1 1 -1 1)
		   (1 1 1 1 0 0 -1 1)
		   (1 0 0 0 1 1 -1 1)
		   (1 0 0 0 1 0 -1 0)
		   (0 1 1 1 0 1 -1 1)
		   (0 1 1 0 1 1 -1 0)
		   (0 0 0 1 1 0 -1 0)
		   (0 1 0 1 0 1 -1  0)
		   (0 0 0 1 0 1 -1 0)
		   (0 1 1 0 1 1 -1 0)
		   (0 1 1 1 0 0 -1 0)))