daniel/advent-of-code-2021
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

day 21 part 2, WIP getting closer

Browse Source
This commit is contained in:
Daniel Borges
2021-12-22 14:58:04 +01:00
parent 4ed9b57aa9
commit db000226d7
1 changed files with 95 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

152
21-dirac-dice/code.scm
View File

@@ -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"))]