2016/22.pl

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use v5.16;
   5
   6 my %items;
   7 while (<>) {
   8         while (/(\w+) gener/g) {
   9                 $items{"G$1"} = $.;
  10         }
  11         while (/(\w+)-compat/g) {
  12                 $items{"M$1"} = $.;
  13         }
  14 }
  15
  16 if (1) {
  17 $items{Gelerium} = 1;
  18 $items{Melerium} = 1;
  19 $items{Gdilithium} = 1;
  20 $items{Mdilithium} = 1;
  21 }
  22
  23 my @q = ([ 0, 0, 1, \%items ]);
  24
  25 sub valid_f {
  26         my ($f, $itm) = @_;
  27         my %g_cur = map { substr($_, 1) => 1 }
  28                 grep { $_ =~ /^G/ && $itm->{$_} == $f } keys %$itm;
  29         return 1 if !keys %g_cur;
  30         for my $c (grep { $_ =~ /^M/ && $itm->{$_} == $f } keys %$itm) {
  31                 return undef if !$g_cur{ substr($c, 1) };
  32         }
  33         return 1;
  34 }
  35
  36 my @sorted = sort keys %items;
  37 my %seen;
  38
  39 use Array::Heap;
  40
  41 my $prev_w = 0;
  42 ENTRY:
  43 while (@q) {
  44         my $entry = pop_heap @q;
  45         my ($w, $steps, $floor, $itm) = @$entry;
  46
  47         my $key = join('', $floor, map { $itm->{$_} } @sorted);
  48         say "$w $steps $key" if $w != $prev_w;
  49         $prev_w = $w;
  50         next if $seen{$key}++;
  51
  52         if (!grep { $itm->{$_} != 4 } keys %$itm) {
  53                 say "$steps";
  54                 last;
  55         }
  56
  57         for my $nf ($floor+1, $floor-1) {
  58                 next if $nf < 1 || $nf > 4;
  59                 for my $i (0 .. $#sorted) {
  60                         my $itm_i = $sorted[$i];
  61                         next if $itm->{$itm_i} != $floor;
  62                         next if $floor == 4 && $itm_i =~ /\AM/;
  63                         for my $j ($i .. $#sorted) {
  64                                 my $itm_j = $sorted[$j];
  65                                 next if $itm->{$itm_j} != $floor;
  66                                 next if $floor == 4 && $itm_i ne $itm_j;
  67                                 next if $itm_i =~ /\AG/ && $itm_j =~ /\AM/
  68                                         && substr($itm_i, 1) ne substr($itm_j, 1);
  69                                 my %nitm = %$itm;
  70                                 # say "moving $itm_i $itm_j from $floor to $nf steps $steps+1";
  71                                 $nitm{$itm_i} = $nf;
  72                                 $nitm{$itm_j} = $nf;
  73                                 next if !valid_f($nf, \%nitm);
  74                                 next if !valid_f($floor, \%nitm);
  75                                 my $nw = 2*$steps;
  76                                 $nw += 4 - $nitm{$_} for keys %nitm;
  77                                 push_heap @q, [ $nw, $steps+1, $nf, \%nitm ];
  78                         }
  79                 }
  80         }
  81 }
  82
  83
  84
  85
  86