blob: 426f58b1113af42506ea9b732ea5c60140785c21 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
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)))))))))
|