day 21 part 2, got it!

I was overwriting created states in new-states while I should have been
cumulating.

21-dirac-dice/code.scm

@@ -10,61 +10,48 @@
 	     (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))))))
+	(values player-1 player-2)))))
 
+; returns a lambda that yields increasing numbers from 1 to 100, then repeating back from 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)) ; each player pair is (position . score)
-	(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))
+; play a game of dirac with a magic deterministic dice that always yields increasing values
+; returned value is multiplication of dice roll count and final score of opponent
+(define (play-deterministic position-1 position-2 win-score)
+  (let [(dice (deterministic-dice))]
+    ; we subtract one from position so that we can just use "mod 10" to wrap around
+    (let repeat [(player-1 (cons (- position-1 1) 0)) ; each player pair is (position . score)
+		 (player-2 (cons (- position-2 1) 0)) 
+		 (rolls 3)]
+      (let* [(new-position (mod (+ (car player-1) (dice) (dice) (dice)) 10))
+	     ; add 1 to account for off by 1 positions
+	     (new-score (+ new-position (cdr player-1) 1))]
+	(if (>= new-score win-score)
+	  (* (cdr player-2) rolls)
+	  ; swap players in next iteration
+	  (repeat player-2 (cons new-position new-score) (+ 3 rolls)))))))
 
+; state of an universe playing dirac, two players pawn position with their scores
 (define-record-type state
   (fields
-    (mutable position-1)
+    ; positions are 0..9 instead of input's 1..10
+    ; so we can just mod 10 while incrementing position
+    (mutable position-1) 
     (mutable score-1)
     (mutable position-2) 
     (mutable score-2)))
 
+(define (state-copy state)
+  (make-state
+    (state-position-1 state)
+    (state-score-1 state)
+    (state-position-2 state)
+    (state-score-2 state)))
+
 (define (state-equal? l r)
   (and (equal? (state-position-1 l) (state-position-1 r))
        (equal? (state-position-2 l) (state-position-2 r))
@@ -74,8 +61,8 @@
 (define (state-hash state)
   (+ (state-position-1 state)
      (* 6700417 (+ (state-position-2 state)
-	      (* 6700417 (+ (state-score-1 state)
-		       (* 6700417 (state-score-2 state))))))))
+		   (* 6700417 (+ (state-score-1 state)
+				 (* 6700417 (state-score-2 state))))))))
 
 (define (make-state-hashtable)
   (make-hashtable state-hash state-equal?))
@@ -87,10 +74,8 @@
 (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
+; sum and amount of permutations of 3 3-sided dice
+(define dirac-dice
   '((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)
@@ -99,67 +84,54 @@
     (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)))
+; roll dice creating as many necessary universes in the process
+; returns amount of wins obtained with this call and new states
+(define (dirac-roll win-score states player)
+  (let-values [((get-position get-score set-position! set-score!)
+		(if (= player 1) 
+		  (values state-position-1 state-score-1
+			  state-position-1-set! state-score-1-set!)
+		  (values state-position-2 state-score-2
+			  state-position-2-set! state-score-2-set!)))]
+    (let [(additional-wins 0)
+	  (new-states (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 win-score)
+		    (set! additional-wins (+ additional-wins universes))
+		    (let [(new-state (state-copy state))]
+		      (set-position! new-state new-position)
+		      (set-score! new-state new-score)
+		      (hashtable-set! new-states new-state 
+				      (+ universes (hashtable-ref new-states new-state 0)))))))
+	      states)))
+	dirac-dice)
+      (values additional-wins new-states))))
 
-(define (print-states states)
-  (hashtable-for-each
-    (lambda (state amount)
-      (printf "~20a : ~a~%" state amount))
-    states))
-
-(define (play-dirac 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 ()
-      (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)))))
+; play dirac dice starting from given positions up until the given score
+; returned value is maximum number of wins for any of the two players
+(define (play-dirac position-1 position-2 win-score)
+  (let [(init-state (make-state-hashtable))]
+    (hashtable-set! init-state (make-state (- position-1 1) 0 (- position-2 1) 0) 1)
+    ; "states" tracks the amount of universes currently using a given state
+    (let repeat [(states init-state) (player-1-wins 0) (player-2-wins 0) (player 1)]
+      (let-values [((additional-wins new-states)
+		    (dirac-roll win-score states player))]
+	(set! player-1-wins (+ player-1-wins additional-wins))
+	(if (hashtable-empty? new-states) ; have all universes finished playing?
+	  (max player-1-wins player-2-wins)
+	  ; swap players in next iteration
+	  (repeat new-states player-2-wins player-1-wins (- 1 player)))))))
 
 (let-values [((position-1 position-2) (read-starting-positions "input"))]
   (printf "part 1:~% Rolls * Opponent Score = ~a~%"
-	  (play-deterministic position-1 position-2))
+	  (play-deterministic position-1 position-2 1000))
   (printf "part 2:~% Max Winning Universes: ~a~%"
-	  (play-dirac position-1 position-2)))
+	  (play-dirac position-1 position-2 21)))