1 files changed, 89 insertions(+), 0 deletions(-)

A src/aoc2021/day21.clj

@@ 0,0 1,89 @@
+; --- Day 21: Dirac Dice ---
+; https://adventofcode.com/2021/day/21
+
+(ns aoc2021.day21
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [clojure.pprint :refer [pprint cl-format]]))
+
+(defn part1 [positions]
+  ; decrement position by 1 so 0..9 can be used for player position
+  (let [players (mapv (fn [pos] {:pos (dec pos) :score 0}) positions)]
+    (loop [players players player-index 0 dice-value 6 count 0]
+      (let [{pos :pos score :score} (nth players player-index)]
+        (let [count (+ count 3) ; 3 throws per round
+              pos (mod (+ pos dice-value) 10)
+              score (+ score (inc pos)) ; inc because position is decremented
+              dice-value (+ dice-value 9)
+              player {:pos pos :score score}
+              players (assoc players player-index player)
+              next-index (mod (inc player-index) 2)]
+          (if (>= score 1000)
+            (let [loser (nth players next-index)]
+              (* (:score loser) count))
+            (recur players next-index dice-value count)))))))
+
+(defn start-universe [[^long pos1 ^long pos2]]
+  {:pos1 (dec pos1)
+   :score1 0
+   :pos2 (dec pos2)
+   :score2 0
+   :player :p1})
+
+(defn move [universe count]
+  (case (:player universe)
+    :p1 (let [pos1 (mod (+ (:pos1 universe) count) 10)
+              score1 (+ (:score1 universe) (inc pos1))]
+          (merge universe {:pos1 pos1
+                           :score1 score1
+                           :player :p2}))
+    :p2 (let [pos2 (mod (+ (:pos2 universe) count) 10)
+              score2 (+ (:score2 universe) (inc pos2))]
+          (merge universe {:pos2 pos2
+                           :score2 score2
+                           :player :p1}))))
+
+; taken all possible permutations of 3 dice rolls, in 1 universe the sum of 3
+; rolls will be 3, in 3 universes it will be 4, etc...
+(defn step [[universe ^long count]]
+  {(move universe 3) (* count 1)
+   (move universe 4) (* count 3)
+   (move universe 5) (* count 6)
+   (move universe 6) (* count 7)
+   (move universe 7) (* count 6)
+   (move universe 8) (* count 3)
+   (move universe 9) (* count 1)})
+
+(defn step-all [universes]
+  (->> universes
+       (map step)
+       (apply concat)
+       (reduce
+         (fn [acc [universe count]]
+          (update acc universe #(if (nil? %1) count (+ %1 count))))
+         {})))
+
+(defn count-wins [universes]
+  (reduce
+    (fn [[p1wins p2wins unwon] [universe count]]
+      (cond
+        (>= (:score1 universe) 21) [(+ p1wins count) p2wins unwon]
+        (>= (:score2 universe) 21) [p1wins (+ p2wins count) unwon]
+        true [p1wins p2wins (conj unwon [universe count])]))
+    [0 0 []]
+    universes))
+
+(defn part2 [positions]
+  (loop [universes [[(start-universe positions) 1]]
+         p1wins 0
+         p2wins 0]
+    (println (count universes) p1wins p2wins)
+    (if (empty? universes)
+      (max p1wins p2wins)
+      (let [[p1wins' p2wins' unwon-universes] (count-wins (step-all universes))]
+        (recur unwon-universes (+ p1wins p1wins') (+ p2wins p2wins'))))))
+
+(defn main []
+  (let [positions [9 10]]
+    (println (str "Part 1: " (time (part1 positions))))
+    (println (str "Part 2: " (time (part2 positions))))))