128 lines
4.0 KiB
Scheme
128 lines
4.0 KiB
Scheme
(load "../common.scm")
|
|
|
|
(define (read-starting-positions filename)
|
|
(call-with-input-file
|
|
filename
|
|
(lambda (file)
|
|
(let* [(player-1 (begin
|
|
(get-string-n file (string-length "Player 1 starting position: "))
|
|
(get-number file)))
|
|
(player-2 (begin
|
|
(get-string-n file (string-length "Player 2 starting position: "))
|
|
(get-number file)))]
|
|
; subtracting one to play with a board numbered 0..9 instead of 1..10, just easier
|
|
(values (- player-1 1) (- player-2 1))))))
|
|
|
|
(define (deterministic-dice)
|
|
(let [(value -1)]
|
|
(lambda ()
|
|
(set! value (mod (+ value 1) 100))
|
|
(+ value 1))))
|
|
|
|
(define (roll! position-score dice)
|
|
(set-car! position-score (mod (+ (car position-score) (dice) (dice) (dice)) 10))
|
|
(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))
|
|
(player-2 (cons position-2 0))
|
|
(dice (deterministic-dice))
|
|
(rolls 0)]
|
|
(let loop ()
|
|
(roll! player-1 dice)
|
|
(set! rolls (+ rolls 3))
|
|
(if (>= (cdr player-1) 1000)
|
|
(* (cdr player-2) rolls)
|
|
(begin
|
|
(roll! player-2 dice)
|
|
(set! rolls (+ rolls 3))
|
|
(if (>= (cdr player-1) 1000)
|
|
(* (cdr player-1) rolls)
|
|
(loop)))))))
|
|
|
|
(define (dirac-dice outcome)
|
|
(let [(next outcome)]
|
|
(lambda ()
|
|
(if (null? next)
|
|
#f
|
|
(let [(value (car next))]
|
|
(set! next (cdr next))
|
|
value)))))
|
|
|
|
(define (vector-sum vec start end)
|
|
(vector-fold
|
|
(lambda (i a x)
|
|
(if (and (>= i start)
|
|
(< i end))
|
|
(+ a x)
|
|
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 (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 (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)
|
|
(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))
|
|
(loop)))))
|
|
|
|
(let-values [((position-1 position-2) (read-starting-positions "input"))]
|
|
(printf "part 1:~% Rolls * Opponent Score = ~a~%"
|
|
(play-deterministic position-1 position-2))
|
|
(printf "part 2:~% Max Winning Universes: ~a~%"
|
|
(play-dirac position-1 position-2)))
|