# Advent of Code: Day 21 - Dirac Dice

@aoc2021 @programming clojure ~6 minutes read

As it seems, when there are neither any problems to solve outside of the submarine nor inside of it, the computer still wants to give us some trouble! This time, though it is just a mere desire to play a game with us.

The game is simple, we have a circular board with 10 spaces. We throw dice three times and move our pawn amount of rolls added together. The score is initially zero, and each time we step on a certain space, we add this space to the score.

As a practice game, a computer offers us deterministic dice, which always roll in increasing order from 1 to 100. And each player rolls three times, which means that the first one will roll `1`, `2`, and `3`, moving forward by `6` places. The second player will roll `4`, `5`, and `6`, and move forward by `15` places. The game ends when the first player reaches `1000` or more points.

Let’s start by parsing an input:

``````day20> (ns day21
(:require [clojure.string :as str]
[aoc-commons :refer [parse-long]]))
nil
day21> (defn read-input []
(reduce #(let [[_ player pos] (re-find #".*(\d+).*(\d+)" %2)
player (parse-long player)
pos (parse-long pos)]
(assoc %1 player
{:pos pos
:score 0}))
(sorted-map)
(->> "inputs/day21"
slurp
str/split-lines)))
{1 {:pos 3, :score 0}, 2 {:pos 4, :score 0}}
``````

I’m kinda lazy right now, so this code, while ugly, works for me. It returns a sorted map of players, which we will iterate. I’m using a map as it is easier to update than a vector, and the order is deterministic. Now we can jump into solving part one.

First thing we need to do is to form the infinite sequence of rolls:

``````day21> (set! *print-length* 10)
10
day21> (map (partial apply +) (partition 3 (cycle (range 1 101))))
(6 15 24 33 42 51 60 69 78 87 ...)
``````

I’m generating a sequence of numbers from 1 to 100 and then using the `cycle` function, to make this sequence repeat infinitely. Next, we partition it into groups of three, and add each one, effectively changing the game so there’s only one roll per player. Now we can just reduce this sequence, by switching players.

``````day21> (defn step [[throws players turns] [i player]]
(let [pos (inc (mod (+ (:pos player) (dec (first turns))) 10))
score (+ (:score player) pos)]
((if (>= score 1000)
reduced
identity)
[(+ throws 3)
(update players i
assoc
:pos pos
:score score)
(rest turns)])))
#'day21/step
``````

This is a reducing function, that accepts the current amount of throws, players map, and sequence of turns as its first argument. As the second argument, it accepts a player. We simply calculate a new position, and score, and check if the score is greater than `1000`. If it is we use `reduced` to terminate the `reduce`, and return the final result. Now we only need to `loop` until any player wins:

``````day21> (defn part-1 [input]
(loop [throws 0
rolls (map (partial apply +) (partition 3 (cycle (range 1 101))))
players input]
(let [[throws players turns] (reduce step [throws players rolls] players)]
(if (some #(>= (:score (second %)) 1000) players)
(* throws (apply min (map (comp :score second) players)))
(recur throws
turns
players)))))
#'day21/part-1
995904
``````

This was easy, but I suspect that the next part will be about something like computing the most optimal winning sequence of rolls or computing all possible games. So such a plain approach probably will not work.

## Part two

Part two puts a twist on the game by changing the dice to Dirac dice. This dice, when rolled, splits the universe to all possible outcomes of a single roll. Since this dice has three sides it means that on each roll there are three new universes, in each of which the result is `1`, `2`, and `3` respectively.

The game still plays by rolling three times per player, which means on each turn the universe splits into 27 universes. The task mentions that player one wins in `444356092776315` universes, so there’s no way we’ll be able to calculate all of that by brute force.

On the other hand, we can. If you know what the Fibonacci sequence is, you may also know that there are two ways of doing it - by using iteration and with recursion. Recursive approach is quite simple:

``````day21> (defn fib [n]
(if (or (= n 0) (= n 1))
1
(+' (fib (- n 1)) (fib (- n 2)))))
#'day21/fib
day21> (fib 4)
5
day21> (map fib (range 10))
(1 1 2 3 5 8 13 21 34 55)
day21> (time (fib 42))
"Elapsed time: 7221.764838 msecs"
433494437
``````

The problem with this approach is that it splits into two branches on each number, and each branch re-computes the result over and over again:

``````                       .------------ fib 5 ------------.
/                                 \
.---- fib 4 ----.                    .- fib 3 -.
/                 \                  /           \
.- fib 3 -.            fib 2            fib 2         fib 1
/           \          /     \          /     \          |
fib 2         fib 1    fib 1   fib 0    fib 1   fib 0       1
/     \          |        |       |        |       |
fib1    fib 0       1        1       1        1       1
|       |
1       1
``````

As can be seen, `fib 2` is computed `3` times, `fib 1` is computed `1` times, and so on. For bigger numbers, this tree becomes very wide. But there’s an easy fix for that - we can memoize function calls, and cut this tree to a single branch:

``````               fib 5
/     \
fib 4    memo
/     \
fib 3     memo
/     \
fib 2     memo
/     \
fib1    fib 0
|       |
1       1
``````

Now, all duplicate branches are computed from memoized values. Sure, this uses more memory, but makes this variant very efficient:

``````day21> (def fib
(memoize
(fn [n]
(if (or (= n 0) (= n 1))
1
(+' (fib (- n 1)) (fib (- n 2)))))))
#'day21/fib
day21> (time (fib 42))
"Elapsed time: 1.176521 msecs"
433494437
day21> (time (fib 200))
"Elapsed time: 1.449005 msecs"
453973694165307953197296969697410619233826N
``````

This will be our strategy for the second part. We’ll write the task as if we really were to play all games, but we’ll just memoize already played ones and cut the tree.

``````day21> (def play
(memoize
(fn [players turn]
(loop [[roll & rolls] (for [a [1 2 3] b [1 2 3] c [1 2 3]] [a b c])
wins {}]
(if roll
(let [roll (apply + roll)
p (players turn)
pos (inc (mod (+ (:pos p) (dec roll)) 10))
score (+ (:score p) pos)]
(if (> score 20)
(recur rolls (update wins turn (fnil inc 0)))
(let [players (update players turn assoc :pos pos :score score)
wins' (play players
(inc (mod turn (count players))))]
(recur rolls (merge-with + wins wins')))))
wins)))))
#'day21/play
``````

I use `for` to compute a sequence of rolls for each of 27 universes. And wins are stored in the `wins` table, where each player has their own score. If the game is won we just return new `wins` state, and go into the next game. If the game isn’t won we go into parallel universes, and that’s where memoization comes into play. Since we memoize players with their states, and a turn, we know for sure if we’ve played some game, as the game’s result is memoized.

The turns are cycled between players, meaning on each call of `play` we increase the player’s number until there are no more players, e.g. `1`, `2`, `1`, `2`. This will work with more players, even though there are no more players in the task.

Now we only need to determine who wins more:

``````day21> (defn part-2 [input]
(apply max (vals (play input 1))))
#'day21/part-2