;;;; Copyright 2002, Jonathan Bachrach.  See file TERMS.
;;;; Originally by Kevin Mitchell and Seth LaForge
;;;; A 29-bit parallel LFSR seeded by simple LCG, based on Sedgewick.

(use goo)
(use goo/boot)
(use goo/system)

(df default-random-seed (=> <int>) (time))

(dv $recent-size 54)

(dc <random> (<any>))
  (dp! recent (<random> => <vec>) (fill (fab <vec> $recent-size) 0))
  (dp! recent-index (<random> => <int>) 0)

;; 16 bits (almost) of lame-o pseudo-randomness
;; Taken from Table 16.1, Applied Cryptography 2nd ed.
(df lcg-rand (prev|<int> => <int>)
  (mod (+ (* prev 171) 11213) 53125))

(dm fab-random-from (seed|<int> => <random>)
  (def r    (new <random>))
  (def a    (recent r))
  ;; Ensure that there's at least one 1 in each LFSR:
  (set (elt a 0) $max-int)
  (rep loop ((j 1) (prev (mod (abs seed) 32768)))
    (when (< j $recent-size)
      (def v1 (lcg-rand prev))
      (def v2 (lcg-rand v1))
      ;; Fill a[j] with 29 random bits as LFSR seed.
      (set (elt a j) (+ (mod v1 32768) (* (mod v2 16384) 32768)))
      (loop (+ j 1) v2)))
  ;; Make sure the history is full of our stuff to deal with bad seed:
  (for ((j (range 0 <= (* 4 $recent-size))))
    (random-29 r))
  r)

(dm fab-random (=> <random>)
  (fab-random-from (default-random-seed)))

(df random-29 (r|<random> => <int>)
  (def ri|<int> (mod (+ (recent-index r) 1) $recent-size))
  (def a (recent r))
  (set (recent-index r) ri)
  (loc ((tap ((bit <int>) => <int>)
          (elt a (mod (+ ri (- $recent-size bit)) $recent-size))))
    ;; We're using primitive polynomial x^54 + x^8 + x^6 + x^3 + x^0, 
    ;; so we tap bits 54, 8, 6, and 3.  Bits in recent are
    ;; stored in reverse order, so the index of bit n is 
    ;; (ri - n) % 54 = (ri + (54 - n)) % 54.
    (set (elt a ri) (^ (^ (tap 54) (tap 8)) (^ (tap 6) (tap 3))))))

(dv $default-random (fab-random))

(dm random (range|<int> => <int>)
  (random-using range $default-random))

(dm random-using (range|<int> r|<random> => <int>)
  (if (= range 0)
      0
      (let ((M     $max-int)
            (limit (- M (mod (+ (- M range) 1) range))))
        (loc ((find-good-value (=> <int>)
                (def value (random-29 r))
                (if (<= value limit)
                    value
                    (find-good-value))))
          (mod (find-good-value) range)))))

(dm random-unit (=> <flo>)
  (random-unit-using $default-random))

(dm random-unit-using (r|<random> => <flo>)
  (def max 1000000)
  (/ (as <flo> (random-using (+ max 1) r)) (as <flo> max)))

(export
  fab-random
  random
  random-using
  random-unit
  random-unit-using)
