; rule 30 rng
(define (cycle xs) (set-cdr! (last-pair xs) xs) xs)
(define (last-pair xs)
(if (null? (cdr xs)) xs
(last-pair (cdr xs))))
(define (digits n . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((n n) (d '()))
(if (zero? n) d
(loop (quotient n b)
(cons (modulo n b) d))))))
(define (undigits ds . args)
(let ((b (if (null? args) 10 (car args))))
(let loop ((ds ds) (n 0))
(if (null? ds) n
(loop (cdr ds) (+ (* n b) (car ds)))))))
(define size (* 7 43))
(define result (quotient size 2))
(define state (make-vector size 0))
(define rule30 #(0 1 1 1 1 0 0 0))
(define (step)
(let ((next (make-vector size 0)))
(do ((i 0 (+ i 1))) ((= i size))
(vector-set! next i
(vector-ref rule30
(+ (* 4 (if (zero? i)
(vector-ref state (- size 1))
(vector-ref state (- i 1))))
(* 2 (vector-ref state i))
(if (= i (- size 1))
(vector-ref state 0)
(vector-ref state (+ i 1)))))))
(set! state next)
(vector-ref state result)))
(define (get n)
(let loop ((n n) (xs '()))
(if (zero? n)
(undigits (reverse xs) 2)
(loop (- n 1) (cons (step) xs)))))
(define block 43)
(define (init-state . xs)
(set! state (make-vector size 0))
(do ((i (- block 1) (+ i block))
(xs (cycle xs) (cdr xs)))
((< size i))
(do ((j i (- j 1))
(ds (reverse (digits (car xs) 2)) (cdr ds)))
((null? ds))
(vector-set! state j (car ds))))
(do ((i 0 (+ i 1))) ((< (* size size (/ block)) i))
(step)))
(define (pass n str)
(let loop ((ss (string->list str)) (sum 0))
(if (null? ss) sum
(loop (cdr ss)
(modulo (+ sum (* sum 256)
(char->integer (car ss)))
(expt 2 n))))))
(init-state 0)
(vector-set! state result 1)
(display (get 32)) (newline)
(init-state (pass block "Programming Praxis"))
(time (do ((i 0 (+ i 1))) ((= i 50))
(do ((j 0 (+ j 1))) ((= j 20))
(display (get 8)) (display " "))
(newline)))