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