diff --git a/21-dirac-dice/code.scm b/21-dirac-dice/code.scm index c876326..3dfea0a 100644 --- a/21-dirac-dice/code.scm +++ b/21-dirac-dice/code.scm @@ -24,7 +24,7 @@ (set-cdr! position-score (+ (car position-score) (cdr position-score) 1))) (define (play-deterministic position-1 position-2) - (let [(player-1 (cons position-1 0)) + (let [(player-1 (cons position-1 0)) ; each player pair is (position . score) (player-2 (cons position-2 0)) (dice (deterministic-dice)) (rolls 0)] @@ -58,66 +58,104 @@ a)) 0 vec)) -;;; TODO: handle not playing if opponent already won -;;; not loose winning games in the process x_x -(define (dirac-roll! ongoings) - (let [(new (make-vector 220 0))] - ; keep the ones that already won - (vector-copy! new 210 ongoings 210) ; this should keep winning games, why do I loose some? - ; for each possible combination of 3 rolls of 3-sided dice - (for-each - (lambda (dice-1) - (for-each - (lambda (dice-2) - (for-each - (lambda (dice-3) - ; increase scores of ongoing games - (vector-for-each - (lambda (index ongoing) - (when (and (> ongoing 0) (< index 210)) - (let* [(position (mod index 10)) - (score (div index 10)) - (new-position (mod (+ position dice-1 dice-2 dice-3) 10)) - (new-score (min 21 (+ score new-position 1))) - (new-index (+ new-position (* new-score 10)))] - (vector-set! new new-index - (+ ongoing (vector-ref new new-index)))))) - ongoings)) - '(1 2 3))) - '(1 2 3))) - '(1 2 3)) - (vector-copy! ongoings 0 new))) +(define-record-type state + (fields + (mutable position-1) + (mutable score-1) + (mutable position-2) + (mutable score-2))) -(define (print-ongoing vec) - (vector-for-each - (lambda (index ongoing) - (when (> ongoing 0) - (printf " ~12a games with score ~a at position ~a~%" - ongoing (div index 10) (+ (mod index 10) 1)))) - vec)) +(define (state-equal? l r) + (and (equal? (state-position-1 l) (state-position-1 r)) + (equal? (state-position-2 l) (state-position-2 r)) + (equal? (state-score-1 l) (state-score-1 r)) + (equal? (state-score-2 l) (state-score-2 r)))) + +(define (state-hash state) + (+ (state-position-1 state) + (* 6700417 (+ (state-position-2 state) + (* 6700417 (+ (state-score-1 state) + (* 6700417 (state-score-2 state)))))))) + +(define (make-state-hashtable) + (make-hashtable state-hash state-equal?)) + +(define (hashtable-for-each proc ht) + (let-values [((k v) (hashtable-entries ht))] + (vector-for-each (lambda (i k v) (proc k v)) k v))) + +(define (hashtable-empty? ht) + (= (hashtable-size ht) 0)) + +; list of possible values obtained by summing 3 rolls of "3 sided dice" +; car is summed value of the 3 dice +; cdr is how many permutations give that sum +(define 3d3-outcomes + '((3 . 1) ; (1 1 1) + (4 . 3) ; (1 1 2) (1 2 1) (2 1 1) + (5 . 6) ; (1 1 3) (1 2 2) (1 3 1) (2 1 2) (2 2 1) (3 1 1) + (6 . 7) ; (1 2 3) (1 3 2) (2 1 3) (2 2 2) (2 3 1) (3 1 2) (3 2 1) + (7 . 6) ; (1 3 3) (2 2 3) (2 3 2) (3 1 3) (3 2 2) (3 3 1) + (8 . 3) ; (2 3 3) (3 2 3) (3 3 2) + (9 . 1))) ; (3 3 3) + +(define (dirac-roll! states get-position get-score new-state) + (let [(wins 0) + (new (make-state-hashtable))] + (for-each + (lambda (outcome) + (let [(sum (car outcome)) + (permutations (cdr outcome))] + (hashtable-for-each + (lambda (state amount) + (let* [(new-position (mod (+ (get-position state) sum) 10)) + (new-score (+ (get-score state) new-position 1)) + (universes (* amount permutations))] + (if (>= new-score 21) + (set! wins (+ wins universes)) + (hashtable-set! new (new-state new-position new-score state) universes)))) + states))) + 3d3-outcomes) + (values wins new))) + +(define (print-states states) + (hashtable-for-each + (lambda (state amount) + (printf "~20a : ~a~%" state amount)) + states)) (define (play-dirac position-1 position-2) - ; the vectors track the number of games going on at given position and score, - ; where position = index % 10 and score = index / 10 - ; 10 because there are 10 positions on board - ; max score is 21 so 22 entries total accounting for starting zero - ; => 10 * 22 = 220 entries - (let [(player-1 (make-vector 220 0)) - (player-2 (make-vector 220 0))] - (vector-set! player-1 position-1 1) - (vector-set! player-2 position-2 1) - (printf "Player 1 starting at ~a, player 2 at ~a~%" position-1 position-2) + ; "states" tracks the amount of universes currently using a given state + (printf "Player 1 starting at ~a, player 2 at ~a~%" position-1 position-2) + (let [(states (make-state-hashtable)) + (wins-1 0) + (wins-2 0)] + (hashtable-set! states (make-state position-1 0 position-2 0) 1) (let loop () - (set! wins-1 (dirac-roll! player-1)) - (set! wins-2 (dirac-roll! player-2)) - (printf "P1:~%") (print-ongoing player-1) - (printf "P2:~%") (print-ongoing player-2) - ; compute how many games are still going (not reached 21) - (if (= (+ (vector-sum player-1 0 210) (vector-sum player-2 0 210)) 0) - ; sum how many winning games (the ones that reached 21) - ; and return biggest - (max (vector-sum player-1 210 220) - (vector-sum player-2 210 220)) + (let-values [((wins new-states) + (dirac-roll! states state-position-1 state-score-1 + (lambda (new-position new-score old-state) + (make-state + new-position new-score + (state-position-2 old-state) (state-score-2 old-state)))))] + ;(printf "P1:~%") + ;(print-states new-states) + (set! wins-1 (+ wins-1 wins)) + (printf "P1 wins: ~10a => ~a~%" wins wins-1) + (set! states new-states)) + (let-values [((wins new-states) + (dirac-roll! states state-position-2 state-score-2 + (lambda (new-position new-score old-state) + (make-state + (state-position-1 old-state) (state-score-1 old-state) + new-position new-score))))] + ;(printf "P2:~%") + ;(print-states new-states) + (set! wins-2 (+ wins-2 wins)) + (printf "P2 wins: ~10a => ~a~%" wins wins-2) + (set! states new-states)) + (if (hashtable-empty? states) + (max wins-1 wins-2) (loop))))) (let-values [((position-1 position-2) (read-starting-positions "input"))]