(defvar *delta* 0.5) (defvar *crad* 8.0) (defvar *terr* 1.0) (defvar *corel* (make-hash-table)) (defun sub (x y) (when (eql (length x) (length y)) (mapcar #'- x y))) (defun distance (x y) (when (eql (length x) (length y)) (sqrt (reduce #'+ (mapcar #'(lambda (z) (* z z)) (sub x y)))))) (defun init (numonodes numodims max min) (let ((what nil)) (loop repeat numonodes collect (loop repeat numodims collect (- (+ (random (+ max min)) 1) min) into x finally (push x what))) what)) (defvar *samples* (init 1000 3 255 0)) (defvar *nodes* (init 50 3 255 0)) (defun getnearest (n &key (nodes *nodes*) (samples *samples*)) (let ((small 999999999) (element nil)) (loop for m from 0 to (- (length nodes) 1) when (< (distance (elt nodes m) (elt samples n)) small) do (progn (setf small (distance (elt nodes m) (elt samples n))) (setf element m))) element)) (defun difference (x y) (when (eql (length x) (length y)) (mapcar #'- x y))) (defun add (x y) (mapcar #'+ x y)) (defun mull (x y) (mapcar #'(lambda (z) (* x z)) y)) (defun Nkernel (x &optional (radius *crad*)) (let ((diff (- radius x))) (if (> diff 0.0) (/ diff radius) 0.0))) (defun learn () (loop for n from 0 to (- (length *samples*) 1) do (let ((tsample (elt *samples* n)) (closestindex (getnearest n)) (nearestnode (elt *nodes* closestindex))) (loop for k from 0 to (- (length *nodes*) 1) do (let* ((nnode (elt *nodes* k)) (tNk (Nkernel (abs (- closestindex k))))) (when (> tNk 0.0) (setf (elt *nodes* k) (add nnode (mull (* *delta* tNk) (difference tsample nnode)))))))))) (defun totaldiff (x y) (if (eql (length x) (length y)) (reduce #'+ (mapcar #'distance x y)) 999999.9)) (defun train () (let ((tdiff 999999.9) (oldnodes (copy-tree *nodes*))) (loop do (learn) do (setf tdiff (totaldiff oldnodes *nodes*)) do (setf oldnodes (copy-tree *nodes*)) do (print tdiff) do (setf *crad* (* *crad* 0.5)) do (setf *delta* (* *delta* 0.9)) when (< tdiff *terr*) do (loop-finish) (print tdiff))) *nodes*) (defun reset () (progn (setf *nodes* nil) (setf *samples* nil))) (defun thisis (sample symbol) (setf (gethash (getnearest 0 :samples (list sample)) *corel*) symbol)) (defun whatis (sample) (let ((num (gethash (getnearest 0 :samples (list sample)) *corel*))) (if (eql num nil) (progn (print "I dont know this yet please declare: ") (thisis (elt *nodes* (getnearest 0 :samples (list sample))) (read))) (with-output-to-string (s) (format s "This is ~A" num))))) (defvar *colors* '( (( 34 0 0) red) ((128 0 0) red) ((200 0 0) red) (( 0 34 0) green) (( 0 128 0) green) (( 0 200 0) green) (( 0 0 34) blue) (( 0 0 128) blue) (( 0 0 200) blue))) (defun buildtable (&optional (table *nodes*)) (dolist (x table) (thisis x (progn (print (with-output-to-string (s) (format s "Which color is this? R: ~A G: ~A B: ~A" (round (elt x 0)) (round (elt x 1)) (round (elt x 2))))) (read)))))