#lang scheme
(require "common.ss")

;; Simulates a normal D20 roll as specified by the rules of
;; "Das Schwarze Auge".
(define d20
  (make-dice 20 #f))

(provide d20)

;; Simulates a DSA attribute test.
;; Params:
;;   attribute = The value of the attribute.
;;   generator = The PRNG to use.
;; Returns:
;;   A test result with the simulated D20 dice roll as its value.
(define (simulate-test/attribute attribute [generator (current-pseudo-random-generator)])
  (let ([result (d20 generator)])
    (make-test-result (<= result (max 1 (min attribute 19)))
                      (case result
                        [(1 20)
                         #t]
                        [else
                         #f])
                      result)))

;; Determines the statistical properties of a DSA attribute test.
;; Params:
;;   attribute = The value of the attribute.
;; Returns:
;;   Test statistics with the expected result of the D20 dice roll
;;   as its expectation.
(define (analyze-test/attribute attribute)
  (make-test-statistics (* 1/20 (max 1 (min attribute 19)))
                        2/20
                        21/2))

(provide/contract [simulate-test/attribute (->* (exact-integer?)
                                                (pseudo-random-generator?)
                                                test-result?)]
                  [analyze-test/attribute (-> exact-integer?
                                              test-statistics?)])

;; Simulates a DSA talent test.
;; Params:
;;   attribute-0 = The first base attribute of the talent.
;;   attribute-1 = The second base attribute of the talent.
;;   attribute-2 = The third base attribute of the talent.
;;   talent      = The value of the talent.
;;   generator   = The PRNG to use.
;; Returns:
;;   A test result with the remaining talent points not used
;;   in the test as its value.
(define (simulate-test/talent attribute-0 attribute-1 attribute-2 talent [generator (current-pseudo-random-generator)])
  (let* ([result-0 (simulate-test/attribute (+ attribute-0 talent))]
         [result-1 (simulate-test/attribute (+ attribute-1 talent))]
         [result-2 (simulate-test/attribute (+ attribute-2 talent))]
         [remaining-talent (- talent
                              (max (- (test-result-value result-0) attribute-0) 0)
                              (max (- (test-result-value result-1) attribute-1) 0)
                              (max (- (test-result-value result-2) attribute-2) 0))])
    (make-test-result (and (test-result-successful? result-0)
                           (test-result-successful? result-1)
                           (test-result-successful? result-2)
                           (or (<= talent 0)
                               (>= remaining-talent 0)))
                      (and (test-result-critical? result-0)
                           (test-result-critical? result-1)
                           (test-result-critical? result-2))
                      remaining-talent)))

;; Determines the statistical properties of a DSA talent test.
;; Params:
;;   attribute-0 = The first base attribute of the talent.
;;   attribute-1 = The second base attribute of the talent.
;;   attribute-2 = The third base attribute of the talent.
;;   talent      = The value of the talent.
;; Returns:
;;   Test statistics with the expected remaining talent points
;;   not used in the test as its expectation.
(define (analyze-test/talent attribute-0 attribute-1 attribute-2 talent)
  (let-values ([(probability expectation) (for*/fold ([success 0] [expectation 0]) ([result-0 (in-range 1 21)]
                                                                                    [result-1 (in-range 1 21)]
                                                                                    [result-2 (in-range 1 21)])
                                            (let ([remaining-talent (- talent
                                                                       (max (- result-0 attribute-0) 0)
                                                                       (max (- result-1 attribute-1) 0)
                                                                       (max (- result-2 attribute-2) 0))])
                                              (values (if (and (<= result-0 (max 1 (min (+ attribute-0 talent) 19)))
                                                               (<= result-1 (max 1 (min (+ attribute-1 talent) 19)))
                                                               (<= result-2 (max 1 (min (+ attribute-2 talent) 19)))
                                                               (or (<= talent 0)
                                                                   (>= remaining-talent 0)))
                                                          (+ success 1/8000)
                                                          success)
                                                      (+ expectation (* 1/8000 remaining-talent)))))])
    (make-test-statistics probability 2/8000 expectation)))

(provide/contract [simulate-test/talent (->* (exact-integer? exact-integer? exact-integer?
                                              exact-integer?)
                                             (pseudo-random-generator?)
                                             test-result?)]
                  [analyze-test/talent (-> exact-integer? exact-integer? exact-integer?
                                           exact-integer?
                                           test-statistics?)])