# Advent of Code 2023 - Day 17

Fairly straightforward Dijkstra’s algorithm

``````import AOC

aoc 2023, 17 do
def compute(input, candidates) do
{{max_row, max_col}, items} = Grid.parse(input)
heat_map =
items
|> Enum.map(fn {coord, number} -> {coord, String.to_integer(number)} end)
|> Map.new
Heap.new()
|> Heap.push({0, [{{0,0}, :east}]})
|> Heap.push({0, [{{0,0}, :south}]})
|> search({max_row-1, max_col-1}, heat_map, MapSet.new, candidates)
end

def p1(input), do: compute(input, &candidates_simple/1)
def p2(input), do: compute(input, &candidates_ultra/1)

def search(heap, {row_t, col_t} = target, heat_map, seen, candidates) do
{{cost, last_3}, heap} = Heap.pop(heap)
row_col = last_3 |> hd |> elem(0)
cond do
row_col == target -> cost
MapSet.member?(seen, last_3) -> search(heap, target, heat_map, seen, candidates)
true ->
seen = MapSet.put(seen, last_3)
last_3
|> then(candidates)
|> Enum.filter(fn [{{row, col}, _} | _] -> 0 <= row and row <= row_t and 0 <= col and col <= col_t end)
|> Enum.reduce(heap, fn last_3, heap -> Heap.push(heap, {cost+heat_map[last_3 |> hd |> elem(0)], last_3}) end)
|> search(target, heat_map, seen, candidates)
end
end

def candidates_simple([x, _, _]), do: [[go(:left, x)], [go(:right, x)]]
def candidates_simple([x | rest]), do: [[go(:straight, x), x | rest], [go(:left, x)], [go(:right, x)]]

def candidates_ultra(moves) do
cond do
length(moves) < 4 -> [[go(:straight, hd(moves)) | moves]]
length(moves) == 10 -> [[go(:left, hd(moves))], [go(:right, hd(moves))]]
true -> [[go(:straight, hd(moves)) | moves], [go(:left, hd(moves))], [go(:right, hd(moves))]]
end
end

@spec go(any(), {{any(), any()}, any()}) :: {{any(), any()}, :east | :north | :south | :west}
def go(which_way, {row_col, dir}), do: next(row_col, dirs()[dir][which_way])

def dirs() do
%{west:  %{left: :south, straight: :west, right: :north},
north: %{left: :west, straight: :north, right: :east},
east:  %{left: :south, straight: :east, right: :north},
south: %{left: :east, straight: :south, right: :west}}
end

def next({row, col}, :west), do: {{row, col-1}, :west}
def next({row, col}, :east), do: {{row, col+1}, :east}
def next({row, col}, :north), do: {{row-1, col}, :north}
def next({row, col}, :south), do: {{row+1, col}, :south}
end
``````
1 Like

Dijkstra’s algorithm using `gb_sets` as priority queue. It solves both parts in 2.7 seconds on my computer.

EDIT:

I realized that all elements inserted into the `gb_sets` are guaranteed to be unique, which means that it is safe to use `gb_sets:insert/2` instead of `gb_sets:add/2`. That reduces the time for my solution from 2.7 seconds to 2.2 seconds.

3 Likes

Also used Dijkstra, but through libgraph. It turns out that creating graphs this big in it incurs a massive overhead, 50 seconds for part one and 130 seconds for part two (num_vertices: 39763, num_edges 529036). Well, TIL. The Dijkstra itself is then fast.
For me the interesting part was to realise that I can enforce the direction changes by having “two layers” of the grid, with top-to-bottom ony vertical direction arrows, and bottom-to-top only horizontal direction arrows.

code
``````Mix.install([{:libgraph, "~> 0.16.0"}])

defmodule Main do
def run() do
get_input()
|> Enum.map(&String.to_charlist/1)
# |> solve(1,3) # part1
|> solve(4,10)  # part2
end

def get_input() do
# "testinput17"
"input17"
|> String.trim()
|> String.split("\n")
end

def mkgrid(ls) do
for {row, r} <- Enum.with_index(ls),
{val, c} <- Enum.with_index(row),
into: %{},
do: {{r,c}, val-?0}
end

def calc_weight_straight({fr,fc},{tr,tc},grid) do
(for r <- fr..tr, c <- fc..tc, do: grid[{r,c}])
|> Enum.sum() |> Kernel.-(grid[{fr,fc}])
end

if {tr,tc} in Map.keys(grid) do
wt = calc_weight_straight({fr,fc},{tr,tc},grid)
Graph.add_edge(g, {fr,fc,fl}, {tr,tc,tl}, weight: wt)
else g end
end

@st {-1,-1,:t}
@ed {200,200,:t}

def mkgraph(grid,mn,mx) do
rmax = Map.keys(grid) |> Enum.map(&elem(&1,0)) |> Enum.max()
cmax = Map.keys(grid) |> Enum.map(&elem(&1,1)) |> Enum.max()
for {r,c} <- Map.keys(grid), reduce: Graph.new(type: :directed) do
g ->
mn..mx |> Enum.reduce(g, fn d, gacc ->
gacc |> cond_add_edge({r,c,:t}, {r+d,c,:b}, grid)
|> cond_add_edge({r,c,:t}, {r-d,c,:b}, grid)
|> cond_add_edge({r,c,:b}, {r,c+d,:t}, grid)
|> cond_add_edge({r,c,:b}, {r,c-d,:t}, grid)
end)
end
end

def path_length([a,b|rest],g,sum) do
wt = g |> Graph.edge(a,b) |> Map.get(:weight,0)
path_length([b|rest], g, sum+wt)
end
def path_length([_vtx],_g,sum), do: sum

def solve(ls,mn,mx) do
grid = ls |> mkgrid()
gr = grid |> mkgraph(mn,mx)
Graph.get_shortest_path(gr,@st,@ed)
|> path_length(gr,0)
|> Kernel.-(2)
end
end

:timer.tc(&Main.run/0)
|> IO.inspect(charlists: :as_lists)
``````

I should probably try to rewrite this with just digraph to see how it compares, although digraph does not do edge weights directly.

(sorry, hit the wrong “reply” button…)

2 Likes

A bad solution today after a long night and a day in my home town, not much time to do better, but I might try gb_sets if it can fit in my implementation without changing much.

Edit: yay! Indeed it is much faster. And correct.

``````defmodule AdventOfCode.Y23.Day17 do
alias AoC.Input, warn: false
alias AoC.Grid, warn: false

def read_file(file, _part) do
Input.stream!(file, trim: true)
end

def parse_input(input, _part) do
input |> Grid.parse_stream(fn x -> {:ok, String.to_integer(x)} end)
end

def part_one(problem), do: solve(problem, :part_one)
def part_two(problem), do: solve(problem, :part_two)

defp solve(grid, part) do
target_xy = {Grid.max_x(grid), Grid.max_y(grid)}

start_poses =
:gb_sets.from_list([
{0, {0, 0}, {:e, 0}},
{0, {0, 0}, {:s, 0}}
])

find_target(start_poses, target_xy, %{}, grid, part)
end

defp find_target(open, target_xy, seen, grid, part) do
case :gb_sets.take_smallest(open) do
{{cost, ^target_xy, _}, _} -> cost
{node, open} -> discover_node(node, open, target_xy, seen, grid, part)
end
end

defp discover_node(node, open, target_xy, seen, grid, part) do
next_poses = next_poses(node, grid, part)

{next_poses, seen} =
Enum.flat_map_reduce(next_poses, seen, fn {_, xy, dc} = node, seen ->
key = {xy, dc}

if Map.has_key?(seen, key) do
{[], seen}
else
{[node], Map.put(seen, key, true)}
end
end)

open = Enum.reduce(next_poses, open, &:gb_sets.add/2)
find_target(open, target_xy, seen, grid, part)
end

# -- Next positions for part two --------------------------------------------

defp next_poses({cost, xy, {dir, count}}, grid, :part_two) do
can_continue? = count <= 9
can_turn? = count >= 4

poses =
if can_continue? do
xy_cont = Grid.translate(xy, dir)

case Map.fetch(grid, xy_cont) do
{:ok, add_cost} -> [{cost + add_cost, xy_cont, {dir, count + 1}}]
:error -> []
end
else
[]
end

if can_turn? do
left_dir = turn_left(dir)
right_dir = turn_right(dir)
left_xy = Grid.translate(xy, left_dir)
right_xy = Grid.translate(xy, right_dir)

poses =
case Map.fetch(grid, left_xy) do
{:ok, add_cost} -> [{cost + add_cost, left_xy, {left_dir, 1}} | poses]
:error -> poses
end

poses =
case Map.fetch(grid, right_xy) do
{:ok, add_cost} -> [{cost + add_cost, right_xy, {right_dir, 1}} | poses]
:error -> poses
end

poses
else
poses
end
end

# -- Next positions for part one --------------------------------------------

defp next_poses({cost, xy, {dir, count}}, grid, :part_one) do
can_continue? = count < 3

poses =
if can_continue? do
xy_cont = Grid.translate(xy, dir)

case Map.fetch(grid, xy_cont) do
{:ok, add_cost} -> [{cost + add_cost, xy_cont, {dir, count + 1}}]
:error -> []
end
else
[]
end

left_dir = turn_left(dir)
right_dir = turn_right(dir)
left_xy = Grid.translate(xy, left_dir)
right_xy = Grid.translate(xy, right_dir)

poses =
case Map.fetch(grid, left_xy) do
{:ok, add_cost} -> [{cost + add_cost, left_xy, {left_dir, 1}} | poses]
:error -> poses
end

poses =
case Map.fetch(grid, right_xy) do
{:ok, add_cost} -> [{cost + add_cost, right_xy, {right_dir, 1}} | poses]
:error -> poses
end

poses
end

defp turn_left(:e), do: :n
defp turn_left(:n), do: :w
defp turn_left(:w), do: :s
defp turn_left(:s), do: :e

defp turn_right(:e), do: :s
defp turn_right(:s), do: :w
defp turn_right(:w), do: :n
defp turn_right(:n), do: :e
end
``````
1 Like

First time coding Dijkstra’s path finding algorithm by hand in a functional programming language. I was struggling to implement Fibonacci heap and failed in the end, so I thought “do I really need decrease-key?” And that led to this solution:

``````defmodule AoC2023.Day17 do
@spec part1(%{coord => loss}) :: total_loss
when coord: {i :: non_neg_integer(), j :: non_neg_integer()},
loss: pos_integer(),
total_loss: pos_integer()
def part1(grid) do
{dest, _} = Enum.max(grid)

:gb_sets.empty()
|> enqueue({grid[{0, 1}], {{0, 1}, {0, 1, 1}}})
|> enqueue({grid[{1, 0}], {{1, 0}, {1, 0, 1}}})
|> total_loss_p1(
grid,
dest,
MapSet.new([
{{0, 1}, {0, 1, 1}},
{{1, 0}, {1, 0, 1}}
])
)
end

@spec part2(%{coord => loss}) :: total_loss
when coord: {i :: non_neg_integer(), j :: non_neg_integer()},
loss: pos_integer(),
total_loss: pos_integer()
def part2(grid) do
{dest, _} = Enum.max(grid)

:gb_sets.empty()
|> enqueue({grid[{0, 1}], {{0, 1}, {0, 1, 1}}})
|> enqueue({grid[{1, 0}], {{1, 0}, {1, 0, 1}}})
|> total_loss_p2(
grid,
dest,
MapSet.new([
{{0, 1}, {0, 1, 1}},
{{1, 0}, {1, 0, 1}}
])
)
end

defp total_loss_p1(pq, grid, {max_i, max_j} = dest, seen) do
case :gb_sets.take_smallest(pq) do
{{loss, {{^max_i, ^max_j}, _}}, _pq} ->
loss

{{loss, {{i, j}, {di, dj, steps}}}, pq} ->
{i2, j2} = {i + dj, j - di}
pds = {{i2, j2}, {dj, -di, 1}}

{pq, seen} =
if i2 in 0..max_i and j2 in 0..max_j and pds not in seen do
{enqueue(pq, {grid[{i2, j2}] + loss, pds}), MapSet.put(seen, pds)}
else
{pq, seen}
end

{i2, j2} = {i - dj, j + di}
pds = {{i2, j2}, {-dj, di, 1}}

{pq, seen} =
if i2 in 0..max_i and j2 in 0..max_j and pds not in seen do
{enqueue(pq, {grid[{i2, j2}] + loss, pds}), MapSet.put(seen, pds)}
else
{pq, seen}
end

{i2, j2} = {i + di, j + dj}
pds = {{i2, j2}, {di, dj, steps + 1}}

{pq, seen} =
if steps < 3 and i2 in 0..max_i and j2 in 0..max_j and pds not in seen do
{enqueue(pq, {grid[{i2, j2}] + loss, pds}), MapSet.put(seen, pds)}
else
{pq, seen}
end

total_loss_p1(pq, grid, dest, seen)
end
end

defp total_loss_p2(pq, grid, {max_i, max_j} = dest, seen) do
case :gb_sets.take_smallest(pq) do
{{loss, {{^max_i, ^max_j}, {_, _, steps}}}, _pq} when steps >= 4 ->
loss

{{loss, {{i, j}, {di, dj, steps}}}, pq} ->
{i2, j2} = {i + dj, j - di}
pds = {{i2, j2}, {dj, -di, 1}}

{pq, seen} =
if steps >= 4 and i2 in 0..max_i and j2 in 0..max_j and pds not in seen do
{enqueue(pq, {grid[{i2, j2}] + loss, pds}), MapSet.put(seen, pds)}
else
{pq, seen}
end

{i2, j2} = {i - dj, j + di}
pds = {{i2, j2}, {-dj, di, 1}}

{pq, seen} =
if steps >= 4 and i2 in 0..max_i and j2 in 0..max_j and pds not in seen do
{enqueue(pq, {grid[{i2, j2}] + loss, pds}), MapSet.put(seen, pds)}
else
{pq, seen}
end

{i2, j2} = {i + di, j + dj}
pds = {{i2, j2}, {di, dj, steps + 1}}

{pq, seen} =
if steps < 10 and i2 in 0..max_i and j2 in 0..max_j and pds not in seen do
{enqueue(pq, {grid[{i2, j2}] + loss, pds}), MapSet.put(seen, pds)}
else
{pq, seen}
end

total_loss_p2(pq, grid, dest, seen)
end
end

defp enqueue(pq, item) do
:gb_sets.insert(item, pq)
end
end
``````
1 Like

I would not call it “fairly straightforward”. I found it quite difficult. I used `PriorityQueue` from `:libgraph`.

1 Like

Reading the source code of `libgraph` truly is an amazing way of learning graphs.
I remember that it used to use a pairing heap as the priority queue, now it uses `:gb_trees`.

1 Like

Took me a while to implement Dijkstra’s Algorithm and then I got stuck because I was hung up on using x-y coordinates for the distance/previous keys. I rewrote it as a depth-first search and ran it on my desktop computer with 16GB of RAM to find the answer to part 1 in about 10 minutes! I tried the same approach for part 2, but the program consumed all of my RAM + lots of paging to disk. I restarted it a few times with the best result from the previous iteration, but it never found the answer. I eventually went back to my original implementation and finally figured out the trick. This was a nice dive into the Erlang docs to learn about `:gb_sets`.

Part 1
``````defmodule Part1 do
def parse(input) do
for line <- String.split(input, "\n", trim: true) do
for char <- String.graphemes(line) do
String.to_integer(char)
end
end
end

def print(map, path) do
for {line, y1} <- Enum.with_index(map) do
for {loss, x1} <- Enum.with_index(line) do
index = Enum.find_index(path, fn pos -> pos == {y1, x1} end)

char =
if index != nil and index > 0 do
{y0, x0} = Enum.at(path, index - 1)
dy = y1 - y0
dx = x1 - x0

case {dy, dx} do
{1, 0} -> "v"
{0, 1} -> ">"
{-1, 0} -> "^"
{0, -1} -> "<"
end
else
Integer.to_string(loss)
end

IO.write(char)
end

IO.puts("")
end
end

def total_loss(map, path) do
path
|> Enum.drop(1)
|> Enum.map(fn {y, x} -> map |> Enum.at(y) |> Enum.at(x) end)
|> Enum.sum()
end

def reconstruct(prev, state), do: reconstruct(prev, state, [])
def reconstruct(_, nil, path), do: path

def reconstruct(prev, {pos, _, _} = state, path),
do: reconstruct(prev, prev[state], [pos | path])

@deltas [{1, 0}, {0, 1}, {-1, 0}, {0, -1}]

def search(map) do
goal = length(map) - 1
start = {0, 0}
dist = %{{start, nil, 0} => 0}
prev = %{}
state = {0, 0, start, nil}
queue = :gb_sets.empty()
queue = :gb_sets.insert(state, queue)
search(map, goal, dist, prev, queue)
end

def search(map, goal, dist, prev, queue) do
{curr_loss, curr_rep, {curr_y, curr_x} = curr_pos, curr_delta} =
curr_state = :gb_sets.smallest(queue)

queue = :gb_sets.delete(curr_state, queue)

if curr_y == goal and curr_x == goal do
reconstruct(prev, {curr_pos, curr_delta, curr_rep})
else
{dist, prev, queue} =
@deltas
|> Stream.map(fn {next_dy, next_dx} = next_delta ->
next_pos = {curr_y + next_dy, curr_x + next_dx}
next_rep = if next_delta == curr_delta, do: curr_rep + 1, else: 1
{next_pos, next_delta, next_rep}
end)
|> Stream.reject(fn {{next_y, next_x}, {next_dy, next_dx}, next_rep} ->
next_y < 0 or next_x < 0 or next_y > goal or next_x > goal or next_rep > 3 or
(curr_delta != nil and
{next_dy, next_dx} == {elem(curr_delta, 0) * -1, elem(curr_delta, 1) * -1})
end)
|> Enum.reduce(
{dist, prev, queue},
fn {{next_y, next_x} = next_pos, next_delta, next_rep}, {dist, prev, queue} ->
next_loss = curr_loss + (map |> Enum.at(next_y) |> Enum.at(next_x))

if next_loss >= dist[{next_pos, next_delta, next_rep}] do
{dist, prev, queue}
else
dist = Map.put(dist, {next_pos, next_delta, next_rep}, next_loss)

prev =
Map.put(prev, {next_pos, next_delta, next_rep}, {curr_pos, curr_delta, curr_rep})

next_state = {next_loss, next_rep, next_pos, next_delta}
queue = :gb_sets.insert(next_state, queue)

{dist, prev, queue}
end
end
)

search(map, goal, dist, prev, queue)
end
end
end

map = Part1.parse(input)
path = Part1.search(map)
Part1.print(map, path)
Part1.total_loss(map, path)
``````
Part 2
``````defmodule Part2 do
@deltas [{1, 0}, {0, 1}, {-1, 0}, {0, -1}]

def search(map) do
goal = {length(map) - 1, length(hd(map)) - 1}
start = {0, 0}
dist = %{{start, nil, 0} => 0}
prev = %{}
state = {0, 0, start, nil}
queue = :gb_sets.empty()
queue = :gb_sets.insert(state, queue)
search(map, goal, dist, prev, queue)
end

def search(map, {goal_y, goal_x} = goal, dist, prev, queue) do
{curr_loss, curr_rep, {curr_y, curr_x} = curr_pos, curr_delta} =
curr_state = :gb_sets.smallest(queue)

queue = :gb_sets.delete(curr_state, queue)

if curr_y == goal_y and curr_x == goal_x do
if curr_rep < 4 do
search(map, goal, dist, prev, queue)
else
Part1.reconstruct(prev, {curr_pos, curr_delta, curr_rep})
end
else
{dist, prev, queue} =
@deltas
|> Stream.map(fn {next_dy, next_dx} = next_delta ->
next_pos = {curr_y + next_dy, curr_x + next_dx}
next_rep = if next_delta == curr_delta, do: curr_rep + 1, else: 1
{next_pos, next_delta, next_rep}
end)
|> Stream.reject(fn {{next_y, next_x}, {next_dy, next_dx} = next_delta, next_rep} ->
case curr_delta do
nil ->
false

{curr_dy, curr_dx} ->
next_y < 0 or next_x < 0 or next_y > goal_y or next_x > goal_x or
(next_delta != curr_delta and curr_rep < 4) or
(next_delta == curr_delta and next_rep > 10) or
(next_dy == curr_dy * -1 and next_dx == curr_dx * -1)
end
end)
|> Enum.reduce(
{dist, prev, queue},
fn {{next_y, next_x} = next_pos, next_delta, next_rep}, {dist, prev, queue} ->
next_loss = curr_loss + (map |> Enum.at(next_y) |> Enum.at(next_x))

if next_loss >= dist[{next_pos, next_delta, next_rep}] do
{dist, prev, queue}
else
dist = Map.put(dist, {next_pos, next_delta, next_rep}, next_loss)

prev =
Map.put(prev, {next_pos, next_delta, next_rep}, {curr_pos, curr_delta, curr_rep})

next_state = {next_loss, next_rep, next_pos, next_delta}
queue = :gb_sets.insert(next_state, queue)

{dist, prev, queue}
end
end
)

search(map, goal, dist, prev, queue)
end
end
end

map = Part1.parse(input)
path = Part2.search(map)
Part1.print(map, path)
Part1.total_loss(map, path)
``````
2 Likes

You just inspired me to start the `Graph` section of my algorithm repository. Quite a readable code too! Thanks for sharing.

1 Like

Hat the same problem with `libgraph`. After building the graph via `Task.async_stream` it “only” took 13.0s for part 1 and 14.2s for part 2 in Livebook on my M2 Pro.

2 Likes

I implemented a priority queue with a decrease-key operation and hoped it would make my solution run faster, but it didn’t because the decrease-key operation was not called even once!

Here’s my code: