(in-package "binry-hop")
(defun closure-hop-net (number-bits)
(let ((potential (make-array number-bits :element-type '(integer 0 1)
:initial-contents (loop repeat number-bits collect '0)))
(memories (list))
(formatting-output "Potential: ~s~%Memories:~%~{~s~%~}"))
(labels ((rect-poly-2 (x) (if (< x 0) 0 (expt x 4)))
(b2s (x) (expt -1 (1+ x)))
(get-some (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))))))
(signed-idx (sgn memory idx some)
(rect-poly-2
(+ (* sgn (b2s (aref memory idx)))
some)))
(local-update (idx)
(setf
(aref potential idx)
(if
(minusp
(loop for memory in memories
for some = (get-some memory idx)
summing
(- (signed-idx +1 memory idx some)
(signed-idx -1 memory idx some))))
0 1))))
(lambda (&key push-memory pop-memory format-pot-mems update set-potential)
(cond
(set-potential
(loop for n below (length potential)
for s across set-potential
when s do (setf (aref potential n) s)))
(push-memory (push push-memory memories))
(pop-memory (pop memories))
(format-pot-mems
(if (stringp format-pot-mems)
(setf formatting-output format-pot-mems)
(format format-pot-mems
formatting-output potential memories)))
(update (if (numberp update) (local-update update)
(loop for idx below (length potential)
do (local-update idx)))))))))
