hopfield net closure maker HEAD master

1 files changed, 38 insertions, 0 deletions

diff --git a/binry-hop.lisp b/binry-hop.lisp
new file mode 100644
index 0000000..426f58b
--- /dev/null
+++ b/binry-hop.lisp
@@ -0,0 +1,38 @@
+(in-package "binry-hop")
+
+(defun closure-hop-net (number-bits)
+  (let ((potential (make-array number-bits :element-type '(integer 0 1)))
+	(memories (list))
+	(formatting-output "Potential: ~s~%Memories:~%~{~s~%~}"))
+    (labels ((rect-poly-2 (x) (if (< x 0) 0 (expt x 2)))
+	     (b2s (x) (expt -1 (1+ x)))
+	     (signed-idx (sgn memory idx)
+	       (rect-poly-2
+		(+ (* sgn (b2s (aref memory idx)))
+		   (loop for pot across potential
+			 for mem across memory
+			 for count from 0
+			 summing
+			 (cond
+			   ((= count idx) 0)
+			   (t (* (b2s mem) (b2s pot))))))))
+	     (local-update (idx)
+	       (setf
+		(aref potential idx)
+		(if
+		 (minusp
+		  (loop for memory in memories
+			summing
+			(- (signed-idx +1 memory idx)
+			   (signed-idx -1 memory idx))))
+		 0 1))))
+      (lambda (&key push-memory pop-memory format update set-potential)
+	(cond
+	  (set-potential (setf potential set-potential))
+	  (push-memory (push push-memory memories))
+	  (pop-memory (pop memories))
+	  (format (when (stringp format) (setf formatting-output format))
+		  (format nil formatting-output potential memories))
+	  (update (if (numberp update) (local-update update)
+		      (loop for idx below (length potential)
+			    do (local-update idx)))))))))