From 0285f426921326be2f4c5840ed469454c6479789 Mon Sep 17 00:00:00 2001
From: screwtape <screwtape@sdf.org>
Date: Thu, 11 May 2023 09:37:43 +0000
Subject: hopfield net closure maker

---
 binry-hop.asd  |  3 +++
 binry-hop.lisp | 38 ++++++++++++++++++++++++++++++++++++++
 packages.lisp  |  1 +
 3 files changed, 42 insertions(+)
 create mode 100644 binry-hop.asd
 create mode 100644 binry-hop.lisp
 create mode 100644 packages.lisp

diff --git a/binry-hop.asd b/binry-hop.asd
new file mode 100644
index 0000000..3707709
--- /dev/null
+++ b/binry-hop.asd
@@ -0,0 +1,3 @@
+(defsystem "binry-hop"
+    :components ((:file "packages")
+		 (:file "binry-hop" :depends-on ("packages"))))
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)))))))))
diff --git a/packages.lisp b/packages.lisp
new file mode 100644
index 0000000..c685cb3
--- /dev/null
+++ b/packages.lisp
@@ -0,0 +1 @@
+(defpackage "binry-hop" (:use :cl) (:nicknames :hop))
-- 
cgit 1.4.1-2-gfad0