path: root/binry-hop.lisp

(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)))))))))