2022/36.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.36;
   4 use strict;
   5 use experimental 'multidimensional';
   6
   7 my @cubes = sort { $a->[0] <=> $b->[0] } map { [ /(\d+)/g ] } <>;
   8 my %cubes = map { join(',', @$_) => 1 } @cubes;
   9
  10 my @q = ([ @{$cubes[0]}, 0, -1 ]);
  11 my %seen;
  12 while (@q) {
  13         my $face = shift @q;
  14         next if $seen{join(',', @$face)}++;
  15
  16         for my $axis (0 .. 2) {
  17                 next if $axis == $face->[3];
  18                 for my $dir (-1, 1) {
  19                         my @neigh = @{$face}[0 .. 2];
  20                         $neigh[$axis] += $dir;
  21                         $neigh[$face->[3]] += $face->[4];
  22                         # say "upper? @neigh";
  23                         if ($cubes{join(',',@neigh)}) {
  24                                 push @q, [ @neigh, $axis, -$dir ];
  25                                 # say "upper cube at @{$q[-1]}";
  26                                 next;
  27                         }
  28
  29                         $neigh[$face->[3]] -= $face->[4];
  30                         # say "side? @neigh";
  31                         if ($cubes{join(',',@neigh)}) {
  32                                 push @q, [ @neigh, $face->[3], $face->[4] ];
  33                                 # say "side cube at @{$q[-1]}";
  34                                 next;
  35                         }
  36
  37                         $neigh[$axis] -= $dir;
  38                         push @q, [ @neigh, $axis, $dir ];
  39                         # say "this cube at @{$q[-1]}";
  40                 }
  41         }
  42 }
  43
  44 say scalar keys %seen;