example.scm 2.0 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788
  1. (import (except (rnrs base) error map)
  2. (only (guile)
  3. lambda* λ
  4. simple-format
  5. error
  6. even?
  7. odd?)
  8. ;; SRFI 1: list procedures
  9. (srfi srfi-1)
  10. ;; SRFI-27 for random number utilities
  11. (srfi srfi-27)
  12. ;; SRFI 43: vectors
  13. (srfi srfi-43)
  14. ;; SRFI 69: hash tables
  15. (srfi srfi-69)
  16. (ice-9 pretty-print)
  17. (ice-9 match)
  18. ;; purely functional data structures
  19. (pfds sets)
  20. (random-utils)
  21. (statistics))
  22. (define who-died?
  23. (λ (events)
  24. (let ([index (list-index (λ (event) (= event 1)) events)])
  25. (cond
  26. [(= (remainder index 2) 0)
  27. 'player1]
  28. [else ;; 2
  29. 'player2]))))
  30. (define rng (make-random-integer-generator))
  31. (define generated
  32. (do-n-times
  33. (λ ()
  34. (generate-random-list 6
  35. (alist->hash-table
  36. '((0 . 5) (1 . 1)))
  37. #:rng rng))
  38. 1000))
  39. ;; (generate-random-list 6
  40. ;; (alist->hash-table
  41. ;; '((0 . 5) (1 . 1)))
  42. ;; #:rng rng)
  43. ;; (pretty-print generated)
  44. (pretty-print
  45. (hash-table->alist
  46. (count-things generated
  47. (λ (events)
  48. (list-index (λ (event) (= event 1)) events))
  49. (λ (events) 1)
  50. 0)))
  51. (pretty-print
  52. (hash-table->alist
  53. (count-things generated
  54. (λ (events)
  55. (if (even? (list-index (λ (event) (= event 1)) events))
  56. 'even
  57. 'odd))
  58. (λ (events) 1)
  59. 0)))
  60. (pretty-print
  61. (hash-table->alist
  62. (count-things generated
  63. who-died?
  64. (λ (events) 1)
  65. 0)))
  66. ;; (pretty-print
  67. ;; (hash-table->alist
  68. ;; (count-things (do-n-times (λ () (rng 2))
  69. ;; 1000)
  70. ;; (λ (n) n)
  71. ;; (λ (n) 1)
  72. ;; 0)))