2022/44.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.36;
   4 use strict;
   5
   6 local $/ = "\n\n";
   7 my @map = map { chomp; [ split // ] } split /\n/, scalar <>;
   8 my $ymax = $#map;
   9
  10 local $/ = "\n";
  11 chomp (my $list = <>);
  12
  13 my $dir = 0;
  14 my $dim;
  15 my ($x, $y) = (0, 0);
  16 $x++ while $map[$y][$x] eq ' ';
  17
  18 my %face_ndir = (
  19         A => [ 1, 1, 1, 3],
  20         B => [ 0, 0, 0, 0],
  21         C => [ 0, 1, 2, 3],
  22         D => [ 2, 2, 2, 2],
  23         E => [ 3, 1, 3, 3],
  24         F => [ 2, 1, 0, 3],
  25 );
  26 my %face_next = (
  27         A => [ qw(D C B F) ],
  28         B => [ qw(C E F A) ],
  29         C => [ qw(D E B A) ],
  30         D => [ qw(F E C A) ],
  31         E => [ qw(D F B C) ],
  32         F => [ qw(D A B E) ],
  33 );
  34
  35 my %face_of;
  36 my %face_dir;
  37 if ($Y::AoC::Task::in_test) {
  38         $dim = 4;
  39         %face_of = (
  40                 '20' => 'A',
  41                 '11' => 'B',
  42                 '21' => 'C',
  43                 '32' => 'D',
  44                 '22' => 'E',
  45                 '01' => 'F',
  46         );
  47         %face_dir = (
  48                 A => 0,
  49                 B => 0,
  50                 C => 0,
  51                 D => 1,
  52                 E => 0,
  53                 F => 2,
  54         );
  55 } else {
  56         $dim = 50;
  57         %face_of = (
  58                 '10' => 'A',
  59                 '02' => 'B',
  60                 '11' => 'C',
  61                 '20' => 'D',
  62                 '12' => 'E',
  63                 '03' => 'F',
  64         );
  65         %face_dir = (
  66                 A => 0,
  67                 B => 3,
  68                 C => 0,
  69                 D => 3,
  70                 E => 0,
  71                 F => 1,
  72         );
  73 }
  74
  75
  76 my %pos_of = reverse %face_of;
  77 sub pos_of($face) {
  78         return map { $dim * $_ } split //, $pos_of{$face};
  79 }
  80
  81 sub face_of($x, $y) {
  82         return undef if $x < 0 || $y < 0;
  83         my $fx = int($x/$dim);
  84         my $fy = int($y/$dim);
  85         return $face_of{"$fx$fy"};
  86 }
  87
  88 sub move($sx, $sy, $dir) {
  89         my $f1 = face_of($sx, $sy);
  90         my ($dx, $dy) = ($sx, $sy);
  91         if ($dir == 0) {
  92                 $dx++;
  93         } elsif ($dir == 1) {
  94                 $dy++;
  95         } elsif ($dir == 2) {
  96                 $dx--;
  97         } elsif ($dir == 3) {
  98                 $dy--;
  99         }
 100         my $f2 = face_of($dx, $dy);
 101         if (defined($f2) && $f2 eq $f1) {
 102                 return ($dx, $dy, $dir);
 103         }
 104         my $ndir;
 105         say "moving from $f1 $dir";
 106         my $rdir = ($dir - $face_dir{$f1}) % 4;
 107         say "rdir = $rdir";
 108         $f2 = $face_next{$f1}[$rdir];
 109         my $rdir2 = $face_ndir{$f1}[$rdir];
 110         say "rdir2 = $rdir";
 111         $ndir = ($rdir2 + $face_dir{$f2}) % 4;
 112         my ($nx, $ny) = ($dx % $dim, $dy % $dim);
 113         my $rot = ($ndir - $dir) % 4;
 114         say "$sx,$sy $nx,$ny $f1 -> $f2 r$rot $dir -> $ndir";
 115         while ($rot--) {
 116                 # ($nx, $ny) = ($ny, (-$nx % $dim));
 117                 ($nx, $ny) = ((($dim-1-$ny) % $dim), $nx);
 118                 say "rot -> $nx,$ny";
 119         }
 120         say " -> $nx $ny $ndir";
 121         my ($ox, $oy) = pos_of($f2);
 122         $nx += $ox;
 123         $ny += $oy;
 124         say " -> $nx $ny";
 125         say "FACE $sx,$sy,$dir $f1 -> $nx,$ny,$ndir $f2";
 126         die if $map[$ny][$nx] eq ' ';
 127         return ($nx, $ny, $ndir);
 128 }
 129
 130 while (length $list) {
 131         $list =~ s/^(\d+|[LR])//;
 132         my $move = $1;
 133         say "$x $y $dir $move";
 134         if ($move =~ /\d+/) {
 135                 while ($move) {
 136                         my ($dx, $dy, $ddir) = move($x, $y, $dir);
 137                         last if $map[$dy][$dx] eq '#';
 138                         $x = $dx; $y = $dy; $dir = $ddir;
 139                         say "   $x $y $dir $move";
 140                         $move--;
 141                 }
 142         } elsif ($move eq 'L') {
 143                 $dir = 3 if --$dir < 0;
 144         } elsif ($move eq 'R') {
 145                 $dir = 0 if ++$dir > 3;
 146         }
 147 }
 148
 149 say 1000*($y+1) + 4*($x+1) + $dir;