It’s advent of code in clojure. Have some milk and cookies: 🍪🥛🍪🍪
╔══════════════════════════════════════════════════════╗ ║ //////////////////////////\_________________________ ║ ╚══════════════════════════════════════════════════════╝ .--'~ ~ ~| .-' * \ / '-. 1 ** .--'~ ,* ~ | | >o< \_\_\|_/__/ | 2 ** .---': ~ '(~), ~| | >@>O< o-_/.()__------| 3 ** |#..@'. ~ " ' ~ | |>O>o<@< \____ .'| 4 ** |_.~._#'.. ~ ~ *| | _| |_ ..\_\_ ..'* | 5 * | ||| @@ @'''...| |... .' '.'''../..| 6 ** |@~~~@@@@@###@ | |/\ ''. | | -/ :| 7 ** |~~..--. _____ | |* /~\ '.| | - / .'| 8 * '---' | | | | | | 9 |------- | | /\ .'| |'''~~~~~| 10 ** |.......|| |/\ ..' | | . . | 11 * | - - | |''':::::| | . .| 12 * | | | | | | 13 |...'..''| |.. :::::| |..|\..''| 14 * |. ''. | |. .:::::| |──┬┴┴┴┬─| 15 * | | | | | | 16 | | | | | | 17 | | | | | | 18 | ~ ..' | |: '. | |─┘├┬┬┬┴─| 19 * | | | '. .' | 20 .------' '------. | '' | 21 | .---_ '------'_ .~' | |. |\|\ / \ /~ >@<<*<O| 22 ** |/ / /\|| | )/~\ | |___|\|________>O>>o>>o| 23 ** | | | | 24 | | '-. .-' 25
(ns user
(:require [clojure.string :as string]
[lib.aoc :refer [get-input]]))
Day 1: Historian Hysteria
Part 1
(let [nums (map Integer/parseInt (string/split (get-input "1") #"(\n| )"))
list1 (sort (take-nth 2 nums))
list2 (sort (take-nth 2 (drop 1 nums)))]
(->> (interleave list1 list2)
(partition 2)
(map (partial apply -))
(map abs)
(apply +)))
Bonus: uiua
# Uiua 0.14.0-dev.5
&fras "1.txt"
/+≡⌵-⊢⟜⊣≡⍆⍉⊜(⊜⋕⊸≠@ )⊸≠@\n
Part 2
(let [nums (map Integer/parseInt (string/split (get-input "1") #"(\n| )"))
list1 (take-nth 2 nums)
list2 (take-nth 2 (drop 1 nums))
freqs (frequencies list2)]
(->> list1
(map (fn [n] (* n (or (get freqs n) 0))))
(apply +)))
Day 2: Red-Nosed Reports
Part 1
(let [levels (string/split-lines (get-input "2"))
levels (map #(map Integer/parseInt (string/split % #" ")) levels)]
(->> levels
(remove (fn [level]
;; increasing/decreasing, set cast for same floor case
(not (or (= (sort > (set level)) level)
(= (sort < (set level)) level)))))
(remove (fn [level]
(->> (partition 2 1 level)
(map (fn [[cur next]]
(<= 1 (abs (- cur next)) 3)))
(some false?))))
(count)))
Part 2
(defn valid-level? [level]
(and
;; increasing/decreasing
(or (= (sort > (set level)) level)
(= (sort < (set level)) level))
;; floor transition in range
(not (->> (partition 2 1 level)
(map (fn [[cur next]]
(<= 1 (abs (- cur next)) 3)))
(some false?)))))
;; https://stackoverflow.com/a/24553906
(defn drop-nth [n coll]
(keep-indexed #(if (not= %1 n) %2) coll))
(let [levels (string/split-lines (get-input "2"))
levels (map #(map Integer/parseInt (string/split % #" ")) levels)]
(->> levels
(filter (fn [level]
(or (valid-level? level) ; already valid?
;; dampener time
(some valid-level?
(map #(drop-nth % level)
(-> level count range))))))
(count)))
Day 3: Mull It Over
Part 1
(->> (get-input "3")
(re-seq #"mul\((\d{1,3}),(\d{1,3})\)")
(map (fn [[_ x y]] (* (parse-long x) (parse-long y))))
(apply +))
Part 2
(->> (get-input "3")
(re-seq #"(mul|do|don't)\(((\d{1,3}),(\d{1,3}))?\)")
(reduce (fn [state [_ op _ x y]]
(condp = op
"do" (assoc state :enabled? true)
"don't" (assoc state :enabled? false)
"mul" (if (:enabled? state)
(update state :sum (partial + (* (parse-long x) (parse-long y))))
state)))
{:enabled? true
:sum 0})
:sum)
Day 4: Ceres Search
Part 1
(let [input (string/split-lines (get-input "4"))
dirs (for [x [-1 0 1]
y [-1 0 1]]
[x y])
look (fn [[x y]] (-> input (get x []) (get y nil)))
move (fn [[x y] [xx yy]] [(+ x xx) (+ y yy)])
peek (fn [coord dir] (map look (reductions move coord (repeat 3 dir))))]
(->> (for [x (range (count (first input)))
y (range (count input))
:when (= (look [x y]) \X)]
(for [dir dirs]
(= (peek [x y] dir)
(seq "XMAS"))))
(flatten)
(filter true?)
(count)))
Part 2
(let [input (string/split-lines (get-input "4"))
h (count input)
w (count (first input))
corner1 [[-1 -1] [1 1]]
corner2 [[-1 1] [1 -1]]
move (fn [[x y] [xx yy]] [(+ x xx) (+ y yy)])
look (fn [[x y]] (-> input (get x []) (get y nil)))]
(->> (for [x (range w)
y (range h)
:when (= (look [x y]) \A)]
(and (= (set "SM") (set (map #(-> % (move [x y]) look) corner1)))
(= (set "SM") (set (map #(-> % (move [x y]) look) corner2)))))
(filter true?)
(count)))
Day 5: Print Queue
Part 1
;; I should do this better later lmao
(let [[rules manuals] (string/split (get-input "5") #"\n\n")
middle (fn [v] (nth v (quot (count v) 2)))
rules (map (fn [rule]
(let [[a b] (string/split rule #"\|")]
[[a b] (re-pattern (format ".*%s(?!.*%s).*" b a))]))
(string/split-lines rules))]
(->> (string/split-lines manuals)
(filter (fn [manual] (every? (fn [[[a b] rule]]
(if (and (string/includes? manual a)
(string/includes? manual b))
(re-matches rule manual)
true)) rules)))
(map #(string/split % #","))
(map middle)
(map parse-long)
(reduce +)))
Part 2
(defn swap-vals [a b coll]
(let [ai (.indexOf coll a)
bi (.indexOf coll b)]
(-> coll
(update ai (constantly b))
(update bi (constantly a)))))
(let [[rules manuals] (string/split (get-input "5") #"\n\n")
middle (fn [v] (nth v (quot (count v) 2)))
rules (map (fn [rule]
(let [[a b] (mapv parse-long (re-seq #"[0-9]+" rule))]
[[a b]
;; check if matches
(fn [manual]
(< (.indexOf manual a)
(.indexOf manual b)))]))
(string/split-lines rules))
passes-rule? (fn [manual [[a b] check]]
(if (and ((set manual) a)
((set manual) b))
(check manual)
true))
manual-good? (fn [manual] (every? #(passes-rule? manual %) rules))]
(->> (string/split-lines manuals)
(map #(mapv parse-long (string/split % #",")))
(remove manual-good?)
(map (fn [manual]
(loop [manual manual]
(if (manual-good? manual)
manual
(let [bad-rule (first (filter (complement (partial passes-rule? manual)) rules))
[[a b] _] bad-rule]
(recur (swap-vals a b manual)))))))
(map middle)
(reduce +)))
Day 6: Guard Gallivant
Part 1
(let [input (string/split-lines (get-input "6"))
look (fn [[x y]] (-> input (get y []) (get x nil)))
;; ugh
position (loop [x 0 y 0]
(if-let [found-x (->> (get input y)
(keep-indexed (fn [i c] (when ((set (seq "<>^v")) c) i)))
(first))]
[found-x y]
(recur x (inc y))))
dirs [[0 -1] [1 0] [0 1] [-1 0]]]
(loop [dir (string/index-of "^>v<" (look position))
position position
seen #{position}]
(let [[x y] position
[x- y-] (get dirs (mod dir (count dirs)))
next [(+ x x-) (+ y y-)]]
(condp = (look next)
nil (inc (count seen)) ;***!
\# (recur (inc dir) position seen)
(recur dir next (conj seen position))))))
Part 2
(def board
(let [input (string/split-lines (get-input "6"))
look (fn [[x y]] (-> input (get y []) (get x nil)))]
(-> (reduce (fn [state coord]
(condp = (look coord)
\. (update state :blanks conj coord)
\# (update state :blocks conj coord)
(update state :position (constantly [coord (string/index-of "^>v<" (look coord))]))))
{:blocks #{} :blanks #{} :position nil}
(for [x (range (count (first input)))
y (range (count input))]
[x y]))
(assoc :width (count (first input)))
(assoc :height (count input)))))
(defn check-board [new-block]
(let [blocks (conj (:blocks board) new-block)
dirs [[0 -1] [1 0] [0 1] [-1 0]]]
(loop [ref (:position board)
seen #{}]
(let [[position dir-index] ref
dir-index (mod dir-index (count dirs))
[x y] position
[x- y-] (get dirs dir-index)
next [(+ x x-) (+ y y-)]
within-board? (and (<= 0 (first next) (:width board))
(<= 0 (second next) (:height board)))]
(cond
(seen ref) true
(not within-board?) nil
(blocks next) (recur [position (inc dir-index)] (conj seen ref))
:else (recur [next dir-index] (conj seen ref)))))) )
(count (remove nil? (pmap check-board (:blanks board))))
Day 7: Bridge Repair
Part 1
(require '[clojure.math.combinatorics :as combo])
;; eg [[1 2 3] [- *]]
(defn solve [nums ops]
(loop [current (first nums)
nums (drop 1 nums)
ops ops]
;; (prn nums ops)
(if (= [] ops)
current
(let [[num & rest-nums] nums
[op & rest-ops] ops]
(recur (op current num) (vec rest-nums) (vec rest-ops))))))
(let [input (->> (string/split-lines (get-input "7"))
(map (fn [line] (keep parse-long (string/split line #":| ")))))]
(->> input
(filter (fn [[answer & inputs]]
(some (fn [ops] (= answer (solve inputs ops)))
(combo/permuted-combinations
(flatten (repeat (dec (count inputs)) [+ *]))
(dec (count inputs))))))
(map first)
(reduce +)))
Part 2
todo: this one is slow (~10s) - I think it’s the speed of our concat-op, can we use math instead?
(require '[clojure.math.combinatorics :as combo])
;; eg [[1 2 3] [- *]]
(defn solve [nums ops]
(loop [current (first nums)
nums (drop 1 nums)
ops ops]
;; (prn nums ops)
(if (= [] ops)
current
(let [[num & rest-nums] nums
[op & rest-ops] ops]
(recur (op current num) (vec rest-nums) (vec rest-ops))))))
(defn concat-op [n1 n2]
(parse-long (str n1 n2)))
(let [input (->> (string/split-lines (get-input "7"))
(map (fn [line] (keep parse-long (string/split line #":| ")))))]
(->> input
(filter (fn [[answer & inputs]]
(some (fn [ops] (= answer (solve inputs ops)))
(combo/permuted-combinations
(flatten (repeat (dec (count inputs)) [+ * concat-op]))
(dec (count inputs))))))
(map first)
(reduce +)))
Day 8: Resonant Collinearity
Part 1
(require '[clojure.math.combinatorics :as combo])
(let [input (string/split-lines (get-input "8"))
w (count (first input))
h (count input)
look (fn [[x y]] (-> input (get y []) (get x nil)))
within? (fn [[x y]] (and (<= 0 x (dec w)) (<= 0 y (dec h))))
antinodes (fn [coords]
(let [[[x1 y1] [x2 y2]] coords
distance (Math/round
(Math/sqrt (+ (* (- x2 x1) (- x2 x1))
(* (- y2 y1) (- y2 y1)))))]
;; port of https://stackoverflow.com/a/7741655
[[(+ x2 (* distance (/ (- x2 x1) distance)))
(+ y2 (* distance (/ (- y2 y1) distance)))]
[(- x1 (* distance (/ (- x2 x1) distance)))
(- y1 (* distance (/ (- y2 y1) distance)))]]
))
antennae (atom {})
;; oof
_ (doseq [x (range w)
y (range h)
:when (not (or (= (look [x y]) \.)
(= (look [x y]) \#)))]
(swap! antennae update (look [x y]) #(conj % [x y])))]
(->> @antennae
(mapcat (fn [[_ coords]]
(->> (combo/combinations coords 2)
(mapcat (fn [coords] (filter within? (antinodes coords)))))))
(set)
(count)
;; debug print
;; (reduce (fn [grid anti-coord] (update-in grid (reverse anti-coord) (constantly \#)))
;; (mapv (comp vec seq) input))
;; (map (partial apply str))
;; (string/join "\n")
;; (println)
))
Part 2
(require '[clojure.math.combinatorics :as combo])
(require '[lib.grid :as grid])
(let [g (grid/parse (get-input "8"))
antennae (->> (grid/points g (not (= \. (grid/look g [x y]))))
(group-by (fn [[x y]] (grid/look g [x y]))))
pairs (mapcat (fn [[_ coords]]
(combo/combinations coords 2))
antennae)]
(->> pairs
(mapcat (fn [pair]
(let [diff (apply map - pair)]
;; branch out both directions, concat
(concat
(loop [results #{}
place (first pair)]
(if-not (grid/within? g place)
results
(recur (conj results place)
(map - place diff))))
(loop [results #{}
place (first pair)]
(if-not (grid/within? g place)
results
(recur (conj results place)
(map + place diff))))))))
(set)
(count)))
Day 9: Disk Fragmenter
Part 1
;; in progress
;; naive
;; [[id count][nil count]....]
;; [[id count][nil count]....]
(defn read-disk-sum [input-key]
(loop [nums (map Integer/parseInt (re-seq #"\d" (get-input input-key)))
id 0
block? true
index 0
result []]
(if (empty? nums)
result
(recur (drop 1 nums)
(if block? id (inc id))
(not block?)
(+ index )
(inc index)
(if block? (conj result [index (first nums)]) result)
#_(conj result
(if block?
(repeat (first nums) id)
[[(first nums)]]
)
;; (repeat (first nums) (if block? id nil))
)
;; (conj result [(if block? id nil) (first nums)])
))))
(#'user/read-empty "9_example")
(defn read-disk [input-key]
(loop [nums (map Integer/parseInt (re-seq #"\d" (get-input input-key)))
id 0
block? true
result []]
(if (empty? nums)
result
(recur (drop 1 nums)
(if block? id (inc id))
(not block?)
(concat result
(if block?
(repeat (first nums) id)
[[(first nums)]]
)
;; (repeat (first nums) (if block? id nil))
)
;; (conj result [(if block? id nil) (first nums)])
))))
(defn balance [disk]
)
(defn checksum [disk]
(reduce
)
)
(count
(let)
(read-disk "9_example")
[[0 2] [9 5]
;; [nil 1]
[1 3]
[nil 3] [2 1] [nil 3] [3 3] [nil 1] [4 2] [nil 1] [5 4] [nil 1] [6 4] [nil 1] [7 3] [nil 1] [8 4] [nil 0] [9 2]]
)
;; spent some time thinking about a clever way to check
(let [disk (read-disk "9")
length (count (filter number? disk))
]
(->> (loop [disk disk]
(if (= (count (first (split-with number? disk))) length)
disk
(let [[p1 p2] (split-with number? disk)]
(recur (concat p1 (list (last p2)) (->> p2 (drop 1) (drop-last 1)))))))
;; (apply str)
(reduce (fn [[i sum] id]
[(inc i) (+ sum (* i id))])
[0 0])
(second)
)
;; input
)
;;***
Day 10: Hoof It
Part 1 and 2
(def grid (->> (get-input "10")
(string/split-lines)
(map (partial re-seq #"\d"))
(map (fn [row] (map Integer/parseInt row)))))
(defn look [[x y]] (-> grid (nth y []) (nth x nil)))
(defn peaks [coord]
(let [looking-at (look coord)]
(if (= looking-at 9)
(apply str coord)
(remove nil?
(for [dir [[0 1] [0 -1] [-1 0] [1 0]]]
(let [next (map + coord dir)]
(when (= (inc looking-at) (look next))
(peaks next))))))))
(->> (for [x (range (count (first grid)))
y (range (count grid))
:when (= 0 (look [x y]))]
[x y])
(map (fn [zero-coord]
(->> (peaks zero-coord)
(flatten)
((juxt distinct identity))
(map count))))
(apply map +))
Day 11: Plutonian Pebbles
Part 1
(defn step [n]
(cond (zero? n) [1]
(even? (-> n str count))
(let [c (-> n str count (/ 2))]
(map (comp Integer/parseInt (partial apply str))
(split-at c (str n))))
:else [(* n 2024)]))
(count
(reduce
(fn [acc _] (mapcat step acc))
(map Integer/parseInt (re-seq #"\d+" (get-input "11")))
(range 25)))
Part 2
;; in progress
;;***: memoize with frequencies
(defn step [n]
(if (zero? n)
[1]
(let [length (inc (int (Math/log10 n)))]
(if-not (even? length)
[(* n 2024)]
[(int (Math/floor (/ n (Math/pow 10 (/ length 2)))))
(int (Math/floor (mod n (Math/pow 10 (/ length 2)))))]))))
(defn step-times [times n]
(if (zero? times)
1
(if (zero? n)
(recur (dec times) 1)
(let [length (inc (int (Math/log10 n)))]
(if-not (even? length)
(recur (dec times) (* n 2024))
(+ (step-times (dec times) (int (Math/floor (/ n (Math/pow 10 (/ length 2))))))
(step-times (dec times) (int (Math/floor (mod n (Math/pow 10 (/ length 2))))))))))))
(def step-times-memo (memoize step-times))
(step-times 2 10)
(apply +
(map (partial step-times-memo 75)
(map Integer/parseInt (re-seq #"\d+" (get-input "11")))
;; (count (step-times 75 (list 773)))
;; ((773) (79858) (0) (71) (213357) (2937) (1) (3998391))
)
;; (step-times 25 [0])
)
(def step-memo (memoize step))
(count
(reduce
(fn [acc _] (mapcat step-memo acc))
(map Integer/parseInt (re-seq #"\d+" (get-input "11")))
(range 75))))
Day 12: Garden Groups
Part 1
;; note: initially tried to shove zipper in here, not the move
(require '[clojure.set :as set])
(require '[lib.grid :as grid])
(defn read-region [grid coord]
(let [char (grid/look grid coord)]
(loop [seen #{}
to-check [coord]]
(if (empty? to-check)
seen
(let [at (peek to-check)]
(recur (conj seen at)
(->> (grid/neighbors grid at 2468 char)
(remove seen)
(apply conj (pop to-check)))))))))
(defn perimeter [points]
;; claude gave me a logic pointer here
;; todo: grid-library this
(->> points
(map (fn [point]
(apply + (for [dir [[0 1] [0 -1] [1 0] [-1 0]]]
(if (points (mapv + dir point))
0 1)))))
(reduce +)))
(defn score-region [r]
(* (count r)
(perimeter r)))
(let [grid (grid/parse (get-input "12"))]
(->> (loop [points (set (grid/points grid))
regions []]
(if (empty? points)
regions
(let [new-region (read-region grid (first points))]
;; (prn (count points) (first points) new-region)
(recur (set/difference points new-region)
(conj regions new-region)))))
(map score-region)
(reduce +)))
Part 2
;; in progress
(require '[clojure.set :as set])
(require '[lib.grid :as grid])
(defn read-region [grid coord]
(let [char (grid/look grid coord)]
(loop [seen #{}
to-check [coord]]
(if (empty? to-check)
seen
(let [at (peek to-check)]
(recur (conj seen at)
(->> (grid/neighbors grid at 2468 char)
(remove seen)
(apply conj (pop to-check)))))))))
(defn sides [points]
;; todo
)
;; 8
(sides (read-region (grid/parse (get-input "12_example")) [2 1]))
(defn score-region [r]
(* (count r)
(sides r)))
;; looking for price: 80
(let [grid (grid/parse (get-input "12_example"))]
(->> (loop [points (set (grid/points grid))
regions []]
(if (empty? points)
regions
(let [new-region (read-region grid (first points))]
;; (prn (count points) (first points) new-region)
(recur (set/difference points new-region)
(conj regions new-region)))))
(map score-region)
(reduce +)))
Day 13: Claw Contraption
Part 1
(get-input "n")
;; in progress
Day 14: Restroom Redoubt
Part 1
(let [[w h] [101 103]
wrap (fn [[x y]] [(mod x w) (mod y h)])
simulate (fn [times [coord velocity]]
(reduce (fn [c _] (wrap (mapv + c velocity)))
coord (range times)))
robots (->> (get-input "14")
(string/split-lines)
(map (partial re-seq #"-?\d+"))
(map (partial map parse-long))
(map (fn [[x y vx vy]] [[x y] [vx vy]])))
quadrant-bots (fn [[x y w h] coords]
(filter (fn [[xx yy]]
(and (<= x xx (dec (+ x w)))
(<= y yy (dec (+ y h)))))
coords))
quadrants (let [w (/ (dec w) 2)
h (/ (dec h) 2)]
[[0 0 w h]
[(inc w) 0 w h]
[0 (inc h) w h]
[(inc w) (inc h) w h]])]
(let [results (map (partial simulate 100) robots)]
;; visual:
(-> (grid/make w h)
(grid/gmap (constantly 0))
(grid/gupdate inc results)
(grid/gmap (fn [at] (if (zero? at) \. at)))
(grid/gprint))
(->> quadrants
(map (fn [quadrant]
(quadrant-bots quadrant results)) )
(map count)
(reduce *))))
Part 2
(require '[lib.grid :as grid])
(let [[w h] [101 103]
wrap (fn [[x y]] [(mod x w) (mod y h)])
step (fn [[coord velocity lined]]
(let [new-place (wrap (mapv + coord velocity))]
[new-place velocity]))
robots (->> (get-input "14")
(string/split-lines)
(map (partial re-seq #"-?\d+"))
(map (partial map parse-long))
(map (fn [[x y vx vy]] [[x y] [vx vy]])))
;; used to find one point at top of tree
tree? (fn [robots]
(every? (set (map first robots))
[[51 0]
[50 1] [52 1]]))
show (fn [robots] (-> (grid/make w h)
(grid/gassoc \+ (map first robots))
(grid/gprint)))]
(loop [times 1
robots robots]
(if (or (= times 3000)
(tree? robots))
(do (show robots)
times)
(recur (inc times) (map step robots)))))
Part 1
(require '[lib.grid :as grid])
(defn ->dir [c]
(condp = c
\> [1 0]
\< [-1 0]
\^ [0 -1]
\v [0 1]))
(defn shift [grid coord1 coord2]
(-> grid
(grid/gassoc (grid/look grid coord2) [coord1])
(grid/gassoc (grid/look grid coord1) [coord2])))
;; https://stackoverflow.com/a/30928487
(defn take-while+
[pred coll]
(lazy-seq
(when-let [[f & r] (seq coll)]
(if (pred f)
(cons f (take-while+ pred r))
[f]))))
(defn dir-look [grid pos dir]
(->> pos
(iterate (fn [coord] (mapv + coord (->dir dir))))
(take-while+ (fn [c] (not (#{\# \.} (grid/look grid c)))))))
(defn blocked? [grid pos dir]
(every? (fn [c] (#{\@ \O \#} (grid/look grid c)))
(dir-look grid pos dir)))
(defn move [grid coords]
(reduce (fn [g pair]
(apply shift g pair))
grid
(reverse (partition 2 1 coords))))
(let [[grid moves] (string/split (get-input "15") #"\n\n")
moves (map first (re-seq #"[v^<>]" moves))
grid (grid/parse grid)]
;; one move
#_(-> grid
(dir-look position \v)
(->> (move grid))
(grid/gprint))
(println "starting!")
(as-> grid it
(reduce (fn [g dir]
(let [pos (first (grid/points g (= \@ (grid/look g [x y]))))]
(if (blocked? g pos dir) g
(-> g
(dir-look pos dir)
(->> (move g))))))
it moves)
(grid/points it (= \O (grid/look it [x y])))
(map (fn [[x y]] (+ x (* 100 y))) it)
(reduce + it)))
Part 2
;; in progress
(require '[lib.grid :as grid])
(require '[clojure.zip :as zip])
(defn ->dir [c]
(condp = c
\> [1 0]
\< [-1 0]
\^ [0 -1]
\v [0 1]))
;; will only apply in the v^ case
(defn box-zipper [grid coord dir]
(zip/zipper
;; branch? is a fn that, given a node, returns true if can have children, even if it currently doesn't.
(fn [node] (and node (grid/look-relative grid node dir #{\[ \]})))
;; children is a fn that, given a branch node, returns a seq of its children.
(fn [node] (condp = (grid/look-relative grid node dir)
\[ (map first (grid/neighbors grid node 23))
\] (map first (grid/neighbors grid node 12))))
;; make-node is a fn that, given an existing node and a seq of children, returns a new branch node with the supplied children.
(fn [node _] node)
;; root is the root node.
coord))
(defn read-zipper [z]
;; return nodes of a zipper
(->> z
(iterate zip/next)
(take-while+ #(not (zip/end? %)))
(keep zip/node)
(distinct)))
(defn read-boxes [grid coord dir]
(->> (if (grid/look grid coord \[) 56 45)
(grid/neighbors grid coord)
(map first)
(mapcat (fn [c] (read-zipper (box-zipper grid c dir))))
(distinct)))
(defn can-move? [grid boxes up?]
;; takes in box points
(let [last-row (first (sort (if up? < >) (map second boxes)))
]
last-row
)
(group)
)
(can-move?
'([2 2] [2 1] [3 1] [3 2])
true
)
(read-boxes
(grid/parse
"......
..[]..
..[].."
)
[2 2]
(->dir \^)
)
;; https://stackoverflow.com/a/30928487
(defn take-while+
[pred coll]
(lazy-seq
(when-let [[f & r] (seq coll)]
(if (pred f)
(cons f (take-while+ pred r))
[f]))))
(defn dir-look [grid pos dir]
(->> pos
(iterate (fn [coord] (mapv + coord (->dir dir))))
(take-while+ (fn [c] (not (# (grid/look grid c)))))))
(defn blocked? [grid pos dir]
(every? (fn [c] (#{\@ \O \#} (grid/look grid c)))
(dir-look grid pos dir)))
(defn move [grid coords]
(reduce (fn [g pair]
(apply shift g pair))
grid
(reverse (partition 2 1 coords))))
(let [[grid moves] (string/split (get-input "15") #"\n\n")
moves (map first (re-seq #"[v^<>]" moves))
grid (grid/parse grid)]
;; one move
#_(-> grid
(dir-look position \v)
(->> (move grid))
(grid/gprint))
(println "starting!")
(as-> grid it
(reduce (fn [g dir]
(let [pos (first (grid/points g (= \@ (grid/look g [x y]))))]
(if (blocked? g pos dir) g
(-> g
(dir-look pos dir)
(->> (move g))))))
it moves)
(grid/points it (= \O (grid/look it [x y])))
(map (fn [[x y]] (+ x (* 100 y))) it)
(reduce + it)))
Day 16: Reindeer Maze
Part 1
;; in progress
(require '[clojure.zip :as zip])
(require '[clojure.set :as set])
(require '[lib.grid :as grid])
(let [grid (grid/parse (get-input "16_example"))
start (first (grid/points grid (= \S (grid/look g [x y]))))]
(->>
(loop [path [start]
to-check (into [] (grid/neighbors grid start 2468 \.))
times 500
]
(prn path "-" to-check)
(if (zero? times)
path
(if (empty? to-check)
path
(let [at (peek to-check)
looking-at (grid/look grid at)]
(if (= looking-at \E)
path
(recur (conj path at)
(->> (grid/neighbors grid at 2468 \.)
(remove (set path))
(apply conj (pop to-check)))
(dec times))
)
))
)
;; (grid/look )
)
(grid/gupdate grid (constantly \+))
(grid/gprint))
)
#_(loop [
;; at start
path []
to-check [start]
times 500]
(if (zero? times)
nil
(if (empty? to-check)
path
(let [at (peek to-check)]
;; (run! clojure.pprint/pprint ["path" path "check" to-check "at" at])
(println "--")
;; (grid/gprint (grid/gupdate grid (constantly \+) path))
(if (grid/look grid at \E)
path
(recur (conj path
at
;; (peek to-check)
)
(apply conj (pop to-check)
(->> (grid/neighbors grid at 2468 \.)
(remove (set path))))
(dec times)
))))))
#_(loop [looking-at [[start []]]
visited #{}]
(when (peek looking-at)
(let [[pos path] (peek looking-at)]
(prn visited)
(if (grid/look grid pos \E)
path
(recur (apply conj (pop looking-at)
(->> (grid/neighbors grid pos 2468 \.)
(remove visited)
(map (fn [new] [new (conj path pos)]))))
(conj visited pos)))))
)
Part 1
(get-input "17")
;; in progress
Part 1
(get-input "18_example")
;; in progress
Part 1
(defn prefix-match [word parts]
;; (prn word parts)
(if (string/blank? word) true
(first
(filter (fn [s]
(and (string/starts-with? word s)
(prefix-match (subs word (count s)) parts)))
parts))))
(let [[towels _ & targets] (string/split-lines (get-input "19"))
towels (string/split towels #", ")]
(->> targets
(keep (fn [target] (prefix-match target towels)))
(count)))
Part 2
;; in progress
(let [[towels _ & targets] (string/split-lines (get-input "19"))
towels (string/split towels #", ")]
(def towels towels)
(def targets targets))
(defn solve [word]
(if (string/blank? word)
;; (apply str trail)
1
(->> towels
(filter (partial string/starts-with? word))
(map (fn [maybe]
(solve (subs word (count maybe)))))
(reduce +))))
(def solve-memo (memoize solve))
(->> targets
(map solve-memo)
;; (map flatten)
;; (map count)
(reduce +))
Day 22: Monkey Market
Part 1
(defn mix-and-prune [secret-number val]
(mod (bit-xor val secret-number) 16777216))
(defn next-number [n]
(let [one (mix-and-prune (* n 64) n)
two (mix-and-prune one (int (Math/floor (/ one 32))))
three (mix-and-prune two (* two 2048))]
three))
(->> (mapv parse-long (string/split-lines (get-input "22")))
(map (fn [input]
(last (take 2001 (iterate next-number input)))))
(reduce +))
Part 2
(defn mix-and-prune [secret-number val]
(mod (bit-xor val secret-number) 16777216))
(defn next-number [n]
(let [one (mix-and-prune n (* n 64))
two (mix-and-prune one (int (Math/floor (/ one 32))))
three (mix-and-prune two (* two 2048))]
three))
;; build [[number [1 2 3 4] price]]
(defn stats [initial-secret]
(reverse
(let [price (fn [n] (Character/digit (last (str n)) 10))]
(reduce
(fn [acc next-secret]
(let [[last-secret history last-price] (first acc)
price-diff (- (price next-secret) (price last-secret))]
(conj acc [next-secret
(vec (take-last 4 (conj history price-diff)))
(+ last-price price-diff)])))
(list [initial-secret [] (price initial-secret)])
(drop 1 (take 2001 (iterate next-number initial-secret)))))))
(defn check-profit [all-stats freq]
(->> all-stats
(map (fn [s] (or (->> s
(filter #(= freq (second %)))
(first)
(last))
0)))
(reduce +)))
(let [all-stats (pmap stats (mapv parse-long (string/split-lines (get-input "22"))))
patterns (->> all-stats
(mapcat (fn [s]
(->> s
(drop 4)
(map second))))
(frequencies)
(sort-by val >)
;; assumption that it will appear in top 50 most seen patterns
(take 50)
(map first))]
(->> patterns
(pmap (fn [pattern]
[pattern (check-profit all-stats pattern)]))
(sort-by second >)
(first)
(second)))
Day 23: LAN Party
Part 1
(require '[clojure.math.combinatorics :as combo])
(let [pairs (map #(string/split % #"-") (string/split-lines (get-input "23")))
connections (reduce (fn [acc [a b]]
(-> acc
(update a conj b)
(update b conj a)))
{} pairs)]
(->> connections
(filter (fn [[k v]] (string/starts-with? k "t")))
(mapcat (fn [[t-comp friends]]
(->> (combo/combinations friends 2)
(filter (fn [[f1 f2]]
((set (get connections f1))
f2)))
(map (partial concat [t-comp])))))
(map set)
(distinct)
(count)))
Part 2
(require '[clojure.math.combinatorics :as combo])
(let [pairs (map #(string/split % #"-") (string/split-lines (get-input "23")))
connections (reduce (fn [acc [a b]]
(-> acc
(update a conj b)
(update b conj a)))
{} pairs)
connections (into {} (map (fn [[k v]] [k (set v)]) connections))]
(->> connections
(map (fn [[connected friends]]
(->> (combo/subsets (into [] friends))
(reverse) ; largest first
(filter (fn [friends-subset]
;; all connected to each other?
(every? (fn [friend]
(every? #((get connections %) friend)
(remove #(= % friend) friends-subset)))
friends-subset)))
(first)
(set)
(set/union #{connected}))))
(sort-by count >)
(first)
(sort)
(string/join ",")))
Part 1
;; an "op" is eg [:z00 [:x00 :y00 bit-and]]
(defn process-ops [registers ops]
(loop [registers registers
ops ops]
(if (empty? ops)
registers
(let [chosen-op (->> ops
(filter (fn [[_ [a1 a2 _]]]
(and (get registers a1)
(get registers a2))))
first)
[dest [a1 a2 op]] chosen-op]
(recur (assoc registers dest (op (get registers a1)
(get registers a2)))
(remove #(= % chosen-op) ops))))))
(let [[registers ops] (string/split (get-input "24") #"\n\n")
;; create [:z00 [:x00 :y00 bit-and]]
ops (->> (string/split-lines ops)
(map (partial re-seq #"[^ ]+"))
(map (fn [[arg1 op arg2 _ dest]]
[(keyword dest)
[(keyword arg1)
(keyword arg2)
(condp = op
"AND" bit-and
"OR" bit-or
"XOR" bit-xor)]])))
registers (->> registers
(string/split-lines)
(map #(string/split % #": "))
(map (fn [[k v]]
{(keyword k)
(parse-long v)}))
(into {}))
unknown (->> ops
;; [:z00 [:x00 :y00 bit-and]]
(mapcat (fn [[dest [a1 a2 _]]] [dest a1 a2]))
(distinct)
(remove (set (keys registers)))
(map (fn [register] {register nil}))
(into {}))
registers (merge unknown registers)
binary-string (->> (process-ops registers ops)
(filter (fn [[k v]]
(string/starts-with? (name k) "z")))
(sort-by first)
(reverse)
(map second)
(apply str))]
(Long/parseLong binary-string 2))
Part 2
(require '[clojure.math.combinatorics :as combo])
(defn parse [input-name]
(let [[registers wires] (string/split (get-input input-name) #"\n\n")
;; create [:z00 [:x00 :y00 bit-and]]
wires (->> (string/split-lines wires)
(map (partial re-seq #"[^ ]+"))
(map (fn [[arg1 op arg2 _ dest]]
[(keyword dest)
[(keyword arg1)
(keyword arg2)
(condp = op
"AND" bit-and
"OR" bit-or
"XOR" bit-xor)]])))
registers (->> registers
(string/split-lines)
(map #(string/split % #": "))
(map (fn [[k v]]
{(keyword k)
(parse-long v)}))
(into {}))
unknown (->> wires
;; [:z00 [:x00 :y00 bit-and]]
(mapcat (fn [[dest [a1 a2 _]]] [dest a1 a2]))
(distinct)
(remove (set (keys registers)))
(map (fn [register] {register nil}))
(into {}))
registers (merge unknown registers)]
[registers wires]))
(defn process-wires [registers wires]
(loop [registers registers
wires wires]
(if (empty? wires)
registers
(let [chosen-op (->> wires
(filter (fn [[_ [a1 a2 _]]]
(and (get registers a1)
(get registers a2))))
first)
[dest [a1 a2 op]] chosen-op]
(recur (assoc registers dest (op (get registers a1)
(get registers a2)))
(remove #(= % chosen-op) wires))))))
(defn get-num [prefix registers]
(Long/parseLong
(->> registers
(filter (fn [[k v]]
(string/starts-with? (name k) prefix)))
(sort-by first)
(reverse)
(map second)
(apply str))
2))
(defn valid? [registers]
(= (get-num "z" registers)
(bit-and (get-num "x" registers)
(get-num "y" registers))))
(defn switch [wires swaps]
;; pain. should've made wires a map
(reduce
(fn [acc [a b]]
(map (fn [wire]
(condp = (first wire)
a [a (second (first (filter (fn [[dest & _]] (= dest b)) wires)))]
b [b (second (first (filter (fn [[dest & _]] (= dest a)) wires)))]
wire))
acc))
wires swaps))
(let [[registers wires] (parse "24_big")
;; wires (switch wires [[:z00 :z02]])
swaps (as-> wires it
(map first it)
(combo/combinations it 8)
(mapcat (fn [to-swap]
(map (partial partition 2)
(combo/permutations to-swap))) it))]
(reduce (fn [acc to-swap]
(prn to-swap)
(prn wires)
(prn (switch wires to-swap))
(prn "---")
(if (valid? (process-wires registers (switch wires to-swap)))
(reduced to-swap)
acc))
registers
swaps)
;; (switch wires (first swaps))
;; (get-num "z" (process-wires registers wires))
;; wires
)
(first
(combo/subsets
(map set (combo/combinations [0 1 3 4 5 6 7 8] 2))
;; :min 4
;; :max 4
)
)
(combo/combinations 2)
[0 1]
[3 4]
[5 6]
[7 8]
(map (partial partition 2)
(combo/permutations (range 8)))
(map set )
(->>
(combo/subsets (range 8))
(filter (fn [s] (= 8 (count s))))
)
((0 1) (0 2) (0 3) (1 2) (1 3) (2 3))