fork download
  1. ; lost boarding pass
  2.  
  3. (define range
  4. (case-lambda
  5. ((stop) (range 0 stop (if (negative? stop) -1 1)))
  6. ((start stop) (range start stop (if (< start stop) 1 -1)))
  7. ((start stop step)
  8. (let ((le? (if (negative? step) >= <=)))
  9. (let loop ((x start) (xs (list)))
  10. (if (le? stop x) (reverse xs)
  11. (loop (+ x step) (cons x xs))))))
  12. (else (error 'range "too many arguments"))))
  13.  
  14. (define rand ; knuth random number generator with shuffle box
  15. (let* ((a 69069) (c 1234567) (m 4294967296) (k 32)
  16. (seed 19380110) ; Happy Birthday DEK!
  17. (next (lambda ()
  18. (set! seed (modulo (+ (* a seed) c) m)) seed))
  19. (init (lambda (seed) (let ((box (make-vector k)))
  20. (do ((j 0 (+ j 1))) ((= j k) box)
  21. (vector-set! box j (next))))))
  22. (box (init seed)))
  23. (lambda args
  24. (when (pair? args)
  25. (set! seed (modulo (car args) m)) (set! box (init seed)))
  26. (let* ((j (quotient (* k seed) m)) (n (vector-ref box j)))
  27. (set! seed (next)) (vector-set! box j seed) (/ n m)))))
  28.  
  29. (define (fortune xs)
  30. (let loop ((n 1) (x #f) (xs xs))
  31. (cond ((null? xs) x)
  32. ((< (rand) (/ n))
  33. (loop (+ n 1) (car xs) (cdr xs)))
  34. (else (loop (+ n 1) x (cdr xs))))))
  35.  
  36. (define (board n)
  37. (let loop ((pax 0) (free (range n)) (seated (list)))
  38. (cond ((= pax n) seated) ; return in reverse order
  39. ((or (= pax 0) (not (member pax free)))
  40. (let ((seat (fortune free)))
  41. (loop (+ pax 1) (remove seat free) (cons seat seated))))
  42. (else (loop (+ pax 1) (remove pax free) (cons pax seated))))))
  43.  
  44. (define (sim n)
  45. (let loop ((n n) (own-seat 0))
  46. (if (zero? n) own-seat
  47. (if (= (car (board 100)) 99)
  48. (loop (- n 1) (+ own-seat 1))
  49. (loop (- n 1) own-seat)))))
  50.  
  51. (display (board 10)) (newline)
  52. (display (board 10)) (newline)
  53. (display (board 10)) (newline)
  54. (display (board 10)) (newline)
  55. (display (sim 100)) (newline)
Runtime error #stdin #stdout #stderr 0.01s 7860KB
stdin
Standard input is empty
stdout
Standard output is empty
stderr
Error: call of non-procedure: 9

	Call history:

	<eval>	  (vector-ref box j)
	<eval>	  (next)
	<eval>	  [next] (modulo (+ (* a seed) c) m)
	<eval>	  [next] (+ (* a seed) c)
	<eval>	  [next] (* a seed)
	<eval>	  (vector-set! box j seed)
	<eval>	  (/ n m)
	<eval>	  [fortune] (/ n)
	<eval>	  [fortune] (loop (+ n 1) (car xs) (cdr xs))
	<eval>	  [fortune] (+ n 1)
	<eval>	  [fortune] (car xs)
	<eval>	  [fortune] (cdr xs)
	<eval>	  [fortune] (null? xs)
	<eval>	  [board] (loop (+ pax 1) (remove seat free) (cons seat seated))
	<eval>	  [board] (+ pax 1)
	<eval>	  [board] (remove seat free)	<--