about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorscrewtape <screwtape@sdf.org>2023-05-11 09:37:43 +0000
committerscrewtape <screwtape@sdf.org>2023-05-11 09:37:43 +0000
commit0285f426921326be2f4c5840ed469454c6479789 (patch)
treea8f3890162e741fc3c48c4509c38bb58b42a8087
parentd0c8da6985d1fd8a0d9e9a2a89c4a504b79f73d3 (diff)
downloadcl-binry-hop-master.tar.gz
hopfield net closure maker HEAD master
-rw-r--r--binry-hop.asd3
-rw-r--r--binry-hop.lisp38
-rw-r--r--packages.lisp1
3 files changed, 42 insertions, 0 deletions
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))