; lost boarding pass
(define range
(case-lambda
((stop) (range 0 stop (if (negative? stop) -1 1)))
((start stop) (range start stop (if (< start stop) 1 -1)))
((start stop step)
(let ((le? (if (negative? step) >= <=)))
(let loop ((x start) (xs (list)))
(if (le? stop x) (reverse xs)
(loop (+ x step) (cons x xs))))))
(else (error 'range "too many arguments"))))
(define rand ; knuth random number generator with shuffle box
(let* ((a 69069) (c 1234567) (m 4294967296) (k 32)
(seed 19380110) ; Happy Birthday DEK!
(next (lambda ()
(set! seed (modulo (+ (* a seed) c) m)) seed))
(init (lambda (seed) (let ((box (make-vector k)))
(do ((j 0 (+ j 1))) ((= j k) box)
(vector-set! box j (next))))))
(box (init seed)))
(lambda args
(when (pair? args)
(set! seed (modulo (car args) m)) (set! box (init seed)))
(let* ((j (quotient (* k seed) m)) (n (vector-ref box j)))
(set! seed (next)) (vector-set! box j seed) (/ n m)))))
(define (fortune xs)
(let loop ((n 1) (x #f) (xs xs))
(cond ((null? xs) x)
((< (rand) (/ n))
(loop (+ n 1) (car xs) (cdr xs)))
(else (loop (+ n 1) x (cdr xs))))))
(define (board n)
(let loop ((pax 0) (free (range n)) (seated (list)))
(cond ((= pax n) seated) ; return in reverse order
((or (= pax 0) (not (member pax free)))
(let ((seat (fortune free)))
(loop (+ pax 1) (remove seat free) (cons seat seated))))
(else (loop (+ pax 1) (remove pax free) (cons pax seated))))))
(define (sim n)
(let loop ((n n) (own-seat 0))
(if (zero? n) own-seat
(if (= (car (board 100)) 99)
(loop (- n 1) (+ own-seat 1))
(loop (- n 1) own-seat)))))
(display (board 10)) (newline)
(display (board 10)) (newline)
(display (board 10)) (newline)
(display (board 10)) (newline)
(display (sim 100)) (newline)