TL;DR

On with Advent of Code puzzle 24 from 2022: these elves can be…

I’m always happy when I can use Astar.raku and, believe it or not, this was one of those occasions.

Of course, this is only one tiny part, where the really challenging part is about finding a proper representation that can be fed to the A* module.

Field representation

Let’s start with the representation of the field. I called this class Field1, anticipating some need for a different representation for part 2, only to discover that it was OK for both with little modifications.

Let’s start with the member variables:

class Field1 {
   has $!size-x is built;
   has $!size-y is built;
   has @!layers is built;
   has @!permutations;
   has @!state-at;
   has $!period;
   has @!adjacents-for;

The field itself is kept as an array, with all rows put… in a row. Each possible “movement” will then be encoded as a specfici @!permutation over the array.

Each blizzard points in a single direction and is basically independent of other blizzards. It makes sense to separate blizzards going in the four directions into separate @!layers, so that the movement permutation applied to each layer is always the same and only depending on the (unchanging) direction.

Each direction is necessarily periodic; the overall structure has a $!period that is equal to the minimum common multiple of the two periods in the two directions. This allows us caching the different possible @!state-at different times, to reuse them after the period has been used (in case of need).

Last, member variable @!adjacents-for lets us pre-compute all adjacent positions for each field position, taking into account the topology and assuming that:

• the starting position is in slot 0
• the final position is in the last slot.

This are the functions to calculate the different permutations for moving the field in the different directions:

sub l-perm ($x, $y) { (^$y).map({ (|(1..^$x), 0) «+» $_ * $x }).flat }
sub r-perm ($x, $y) { (^$y).map({ ($x - 1, |^($x - 1)) «+» $_ * $x }).flat }
sub u-perm ($x, $y) { |($x..($x * $y - 1)), |^$x }
sub d-perm ($x, $y) { |(^$x «+» ($x * $y - $x)), |^($x * $y - $x) }

Next, we take a look at the initialization functions. I still have to get a real hang of it, but I thought that I can fake it until I make it, right? So I’m defining create as a surrogate submethod for creating a new object (instead of new) and a TWEAK to do the actual initialization from the inside of the object itself.

   submethod create ($lines) {
      my $size-x = $lines[0].chars - 2;
      my $size-y = $lines.elems - 2;
      my @array = $lines[1 .. $size-y].join('').subst('#', '', :g).comb;
      my @layers = '<>^v'.comb.map({ True, |(@array «ne» $_), True });
      return Field1.new(:$size-x, :$size-y, :@layers);
   }
   submethod TWEAK {
      @!permutations  = (&l-perm, &r-perm, &u-perm, &d-perm).map: -> &inner {
         (0, |(&inner($!size-x, $!size-y) «+» 1), 1 + $!size-x * $!size-y)
      }

      my ($A, $B) = $!size-x, $!size-y;
      ($A, $B) = $B % $A, $A while $A;       # GCD
      $!period = $!size-x * $!size-y div $B; # LCM

      @!state-at.push: self!squash;

      my $inner = $!size-x * $!size-y;
      @!adjacents-for.push: [0, 1];
      for 1 .. $inner -> $p {
         my @adjacents = $p; # wait
         @adjacents.push: $p - 1 if ($p - 1) % $!size-x; # left, consider 1-offset
         @adjacents.push: $p + 1 if $p % $!size-x;       # right
         @adjacents.push: $p - $!size-x if $p > $!size-x; # up
         @adjacents.push: $p + $!size-x if $p + $!size-x <= $inner; # down
         @!adjacents-for.push: @adjacents;
      }
      @!adjacents-for[1].push: 0; # for going back...
      @!adjacents-for[$inner].push: $inner + 1;
      @!adjacents-for.push: [ $inner + 1, $inner ]; # for going back...

      #for @!adjacents-for.kv -> $i, $v { say "$i. ($v)" }
      say "period is $!period";
   }

The squash method allows merging the different layers together and can be expressed very synthetically thanks to hyperoperators. Each slot is forced into a boolean value, indicating whether the specific location is a good candidate for hosting the moving people or not. Method stringify is a helper for debugging.

   method !squash { @!layers.reduce({ $^a «&» $^b })».so }

   method stringify ($n = Nil) {
      (
         gather {
            my $global = self.state-at($n // @!state-at.end);
            my $hborder = '-' x ($!size-x - 1);
            my @range = 1 .. $!size-x;
            take "+ {$hborder}+";
            for ^$!size-y {
               take '|' ~ $global[@range].map({ $_ ?? ' ' !! '#' }).join('') ~ '|';
               @range «+=» $!size-x;

            }
            take "+{$hborder} +";
         }
      ).join: "\n";
   }

As anticipated, the states at different points in time cycle periodically. The method state-at acts as a wrap around @!state-at to take advantage of this periodicity; it also takes care to add more states in the cache in case of need (using the while loop):

   method state-at ($n is copy) {
      $n %= $!period;
      while @!state-at.end < $n {
         @!layers[$_] = @!layers[$_][|@!permutations[$_]] for ^4;
         @!state-at.push: self!squash;
      }
      return @!state-at[$n];
   }

Last, we have three methods that will support our A* search more or less directly. Method target tells us the identifier of the target position, that is the last one. Method adjacents gives us the allowed adjacent positions at step $step starting from position $p, based on the specific state at the given $step.

   method target { $!size-x * $!size-y + 1 }
   method adjacents ($step, $p) {
      my $state = self.state-at($step);
      @!adjacents-for[$p].grep: { $state[$_] };
   }

Last, the manhattan method implements the calculation of the [Manhattan distance][] between two different positions $p and $q, taking into consideration the specific representation for the different positions.

   method manhattan ($p is copy, $q is copy) {
      my $value = 0;
      if $p == 0           { ++$value; ++$p }
      if $q == self.target { ++$value; --$q }
      --$p; --$q;
      return $value +
         (($p mod $!size-x) - ($q mod $!size-x)).abs + # delta-x
         (($p div $!size-x) - ($q div $!size-x)).abs;  # delta-y
   }
}

Part 1

With the Field1 at hand, we can now easily define the solution for part 1:

sub part1 ($inputs) {
   class Field1 { ... };
   class Astar { ... };
   my $field = Field1.create($inputs);

   # graph is defined with nodes as pairs [$step, $position]
   # distance between adjacent nodes is 1
   # heuristic is Manhattan
   my $target = $field.target;
   my $nav = Astar.new(
      identifier => -> $v { $v[1] == $target ?? 'TARGET' !! $v.join(',') },
      distance   => -> $v, $w { 1 },
      heuristic  => -> $v, $w { $field.manhattan($v[1], $w[1]) },
      successors => -> $v {
         my $position = $v[1];
         return if $position == $target; # avoid bothering
         my $step = $v[0] + 1;
         $field.adjacents($step, $position).map: { [$step, $_] };
      },
   );
   my @path = $nav.best-path((0, 0), (Nil, $target));
   return @path.end;
}

The A* class only requires a few functions, that rely upon what is provided by Field1. After calculating the optimal path in @path, the last index of this path is the same as the number of steps needed to complete the task.

Part 2

The second part of the challenge can be addressed easily with what we already have; it suffices to drive the search in the right way, keeping the state from previous iterations as we go.

sub part2 ($inputs, $start) {
   class Field1 { ... };
   class Astar { ... };
   my $field = Field1.create($inputs);

   # graph is defined with nodes as pairs [$step, $position]
   # distance between adjacent nodes is 1
   # heuristic is Manhattan
   my $target = 0;
   my $nav = Astar.new(
      identifier => -> $v { $v[1] == $target ?? 'TARGET' !! $v.join(',') },
      distance   => -> $v, $w { 1 },
      heuristic  => -> $v, $w { $field.manhattan($v[1], $w[1]) },
      successors => -> $v {
         my $position = $v[1];
         return if $position == $target; # avoid bothering
         my $step = $v[0] + 1;
         $field.adjacents($step, $position).map: { [$step, $_] };
      },
   );
   say "start at $start";
   my @return = $nav.best-path(($start, $field.target), (Nil, $target));

   $target = $field.target;
   my @go-again = $nav.best-path((@return[*-1][0], 0), (Nil, $target));

   #.say for @path;
   return @go-again[*-1][0];
}

We might spare some time and reuse the calculation from part 1, of course. Here we do something midway, by creating a new object but going ahead up to the $start state that we got from part 1.

Conclusion

This has been an interesting challenge. To some extent, the puzzle is like a tridimensional maze, where it’s only possible to move ahead in one of the dimensions (it’s time, after all!).

The computation of the program… takes some time. I suspect that my A* implementation can use a lot of optimizations, but to be honest I don’t know which!

Cheers everybody!