2019/35.pl

   1 #!/usr/bin/perl -w
   2
   3 use v5.36;
   4 use Data::Dumper;
   5 use Array::Heap;
   6 use feature 'multidimensional';
   7
   8 my @map = map { chomp; [ split // ] } <>;
   9
  10 my %pos_of;
  11 for my $y (0 .. $#map) {
  12         for my $x (0 .. $#{ $map[0]}) {
  13                 my $c = $map[$y][$x];
  14                 next if $c !~ /[a-z@]/;
  15                 $pos_of{$c} = [ $x, $y ];
  16         }
  17 }
  18
  19 my $nkeys = keys %pos_of;
  20 say "nkeys = $nkeys";
  21
  22 $; = ';';
  23
  24 my $best;
  25
  26 my $min_dist = 1_000_000;
  27
  28 my %min_cost;
  29 my @q0;
  30 sub walk {
  31         my ($cost, @opened) = @_;
  32
  33         my %opened = map { $_ => 1 } @opened;
  34
  35         my $key = $opened[0] . join('', sort @opened);
  36
  37         if (defined $min_cost{$key} && $min_cost{$key} <= $cost) {
  38                 return;
  39         }
  40
  41         $min_cost{$key} = $cost;
  42
  43         say "walk $min_dist $cost - $key ", length $key;
  44         if ($nkeys + 1 == length $key) {
  45                 say "Found!";
  46                 exit 1;
  47         }
  48
  49         my $p = $pos_of{$opened[0]};
  50         my @q = [ @$p, $cost ];
  51
  52         my %seen;
  53         $seen{$p->[0],$p->[1]} = 1;
  54
  55         my %dist;
  56
  57         while (my $pos = shift @q) {
  58                 my ($x, $y, $steps) = @$pos;
  59
  60                 my $v = $map[$y][$x];
  61                 next if $v eq '#';
  62                 if ($v =~ /[a-z]/ && !$opened{$v}) {
  63                         $dist{$v} //= $steps;
  64                         # say "opened=". scalar @opened;
  65                         $min_dist = $steps if $min_dist > $steps
  66                                 && @opened == keys %pos_of;
  67                         push_heap @q0, [ $steps, $v, @opened ];
  68                 }
  69                 if ($v =~ /[A-Z]/) {
  70                         next if !$opened{lc($v)};
  71                 }
  72
  73                 for my ($dx, $dy) (1, 0, 0, 1, -1, 0, 0, -1) {
  74                         my ($nx, $ny) = ($x + $dx, $y + $dy);
  75                         next if $seen{$nx,$ny}++;
  76                         push @q, [ $nx, $ny, $steps+1 ]
  77                                 if $steps + 1 < $min_dist;
  78                 }
  79         }
  80 }
  81
  82 push_heap @q0, [0, '@'];
  83 while (@q0) {
  84         my $elem = pop_heap @q0;
  85         walk(@$elem);
  86 }
  87
  88 say $min_dist;