(uiop:define-package :binry-hop/util
(:export #:make-rectified-polynomial
#:bit-to-sign
#:sign-to-bit
#:b2s
#:s2b
#:make-reread-stream
#:diff-diff-signs
#:make-re/write-stream)
(:nicknames :hop-util))
(in-package :binry-hop/util)
(defun make-rectified-polynomial (n) "
(make-rect-poly 3) ->
lambda (x) rectified (expt x 3)
"
(lambda (x)
(cond ((<= x 0) '0) ((< 0 x) (expt x n))
(t (error "unknown condition")))))
(defun bit-to-sign (bit) "
(bit-to-sign 0) -> -1, 1 otherwise.
"
(cond ((zerop bit) (values '-1))
((not (zerop bit)) (values '1) )
(t (error "unknown condition"))))
(defun b2s (b) "bit-to-sign" (bit-to-sign b))
(defun sign-to-bit (sign) "
(sign-to-bit -1) -> 0, 1 otherwise.
"
(cond ((minusp sign) (values '0))
((not (minusp sign)) (values '1))
(t (error "unknown condition"))))
(defun s2b (s) "sign-to-bit" (sign-to-bit s))
(defun make-reread-stream (file-stream
&optional (restart-from :start)) "
A utility lambda for READing until EOF (= nil) repeatedly
open and close the stream yourself.
(values (read enclosed-stream nil nil) loopedp)
loopedp is T iff returned to restart-from"
(lambda () (let ((memory (read file-stream nil nil)))
(cond (memory (values (list memory nil)))
((not (equal (file-position file-stream)
(file-length file-stream)))
(values '(nil nil)))
((equal (file-position file-stream) (file-length file-stream))
(values (list nil
(file-position file-stream restart-from))))
(t (error "unknown condition"))))))
(defun diff-diff-signs (idx bit-array-1 bit-array-2 polynomial) "
matching bit-array-1's bit at idx for bit-array-2"
(loop for a across bit-array-1
for b across bit-array-2
for count from 0
for signed-ab = (* (b2s a) (b2s b))
summing (cond ((= count idx) (* +1 (b2s b)))
((not (= count idx)) signed-ab))
into plusp-idx-sum
summing (cond ((= count idx) (* -1 (b2s b)))
((not (= count idx)) signed-ab))
into minusp-idx-sum finally (return
(mapcar polynomial (list plusp-idx-sum minusp-idx-sum)))))))
(defun make-re/write-stream (stream max-len) "
of (stream array-eg) closure util for re/writing memory arrays "
(lambda (&key seek peek memory length write) (typecase seek
((integer 0 *) (file-position stream (* (1+ max-len) seek)))
(array (file-position stream 0) (loop for memory = (read stream)
while (not (= (file-position stream) (file-length stream)))
when (equalp seek memory) return
(let ((pos (truncate (file-position stream) (1+ max-len))))
(file-position stream (* pos (1+ max-len)))))))
(cond (length (values (truncate (file-length stream) max-len)))
(peek (values (read-line stream nil nil) (file-position stream)))
(write (let ((string (format nil "~s~{~a~}" memory
(loop repeat (- max-len (+ (length memory) 2 (if memory 0 1)))
collect #\space))))
(format write "~a" string) (terpri write)))
(seek (file-position stream)) (t '(&key seek length peek write)))))
Response:
text/plain