Advent of Code 2023 - Day 17

Learning Questions & Discussions Coding Challenges
,
1

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
2

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
3

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"
    |> File.read!()
    |> 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

  def cond_add_edge(g,{fr,fc,fl},{tr,tc,tl},grid) do
    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
    |> Graph.add_edge(@st,{0,0,:t},weight: 1)
    |> Graph.add_edge(@st,{0,0,:b},weight: 1)
    |> Graph.add_edge({rmax,cmax,:t},@ed,weight: 1)
    |> Graph.add_edge({rmax,cmax,:b},@ed,weight: 1)
  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
4

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
5

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
6

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

1 Like
7

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
8

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
9

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

1 Like
10

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
11

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: