fork download
  1. ; the 37% rule
  2.  
  3. (define (take n xs)
  4. (let loop ((n n) (xs xs) (ys '()))
  5. (if (or (zero? n) (null? xs))
  6. (reverse ys)
  7. (loop (- n 1) (cdr xs)
  8. (cons (car xs) ys)))))
  9.  
  10. (define (drop n xs)
  11. (let loop ((n n) (xs xs))
  12. (if (or (zero? n) (null? xs)) xs
  13. (loop (- n 1) (cdr xs)))))
  14.  
  15. (define (range . args)
  16. (case (length args)
  17. ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  18. ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  19. ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  20. (let loop ((x(car args)) (xs '()))
  21. (if (le? (cadr args) x)
  22. (reverse xs)
  23. (loop (+ x (caddr args)) (cons x xs))))))
  24. (else (error 'range "unrecognized arguments"))))
  25.  
  26. (define random
  27. (let ((a 16807) (m 2147483647) (seed 20180921))
  28. (lambda args (if (pair? args) (set! seed (modulo (car args) m)))
  29. (set! seed (modulo (* a seed) m)) (/ seed m))))
  30.  
  31. (define (randint n)
  32. (round (* (random) n)))
  33.  
  34. (define (shuffle x)
  35. (do ((v (list->vector x)) (n (length x) (- n 1)))
  36. ((zero? n) (vector->list v))
  37. (let* ((r (randint n)) (t (vector-ref v r)))
  38. (vector-set! v r (vector-ref v (- n 1)))
  39. (vector-set! v (- n 1) t))))
  40.  
  41. (define (37percent n)
  42. (let* ((candidates (shuffle (range n)))
  43. (size (round (* 37/100 n)))
  44. (cutoff (apply max (take size candidates))))
  45. (display candidates) (display " ")
  46. (let loop ((cs (drop size candidates)) (prev #f))
  47. (cond ((null? cs) prev)
  48. ((< cutoff (car cs)) (car cs))
  49. (else (loop (cdr cs) (car cs)))))))
  50.  
  51. (display (37percent 20)) (newline)
Success #stdin #stdout 0.02s 50592KB
stdin
Standard input is empty
stdout
(9 13 2 12 4 17 15 0 7 11 5 18 3 10 16 8 1 6 14 19) 18