The rest of Year 2016

[aoc.git] / 2016 / 22.pl

diff --git a/2016/22.pl b/2016/22.pl
new file mode 100755 (executable)
index 0000000..3fa4f22
--- /dev/null
+++ b/2016/22.pl
@@ -0,0 +1,86 @@
+#!/usr/bin/perl -w
+
+use strict;
+use v5.16;
+
+my %items;
+while (<>) {
+       while (/(\w+) gener/g) {
+               $items{"G$1"} = $.;
+       }
+       while (/(\w+)-compat/g) {
+               $items{"M$1"} = $.;
+       }
+}
+
+if (1) {
+$items{Gelerium} = 1;
+$items{Melerium} = 1;
+$items{Gdilithium} = 1;
+$items{Mdilithium} = 1;
+}
+
+my @q = ([ 0, 0, 1, \%items ]);
+
+sub valid_f {
+       my ($f, $itm) = @_;
+       my %g_cur = map { substr($_, 1) => 1 }
+               grep { $_ =~ /^G/ && $itm->{$_} == $f } keys %$itm;
+       return 1 if !keys %g_cur;
+       for my $c (grep { $_ =~ /^M/ && $itm->{$_} == $f } keys %$itm) {
+               return undef if !$g_cur{ substr($c, 1) };
+       }
+       return 1;
+}
+
+my @sorted = sort keys %items;
+my %seen;
+
+use Array::Heap;
+
+my $prev_w = 0;
+ENTRY:
+while (@q) {
+       my $entry = pop_heap @q;
+       my ($w, $steps, $floor, $itm) = @$entry;
+
+       my $key = join('', $floor, map { $itm->{$_} } @sorted);
+       say "$w $steps $key" if $w != $prev_w;
+       $prev_w = $w;
+       next if $seen{$key}++;
+
+       if (!grep { $itm->{$_} != 4 } keys %$itm) {
+               say "$steps";
+               last;
+       }
+
+       for my $nf ($floor+1, $floor-1) {
+               next if $nf < 1 || $nf > 4;
+               for my $i (0 .. $#sorted) {
+                       my $itm_i = $sorted[$i];
+                       next if $itm->{$itm_i} != $floor;
+                       next if $floor == 4 && $itm_i =~ /\AM/;
+                       for my $j ($i .. $#sorted) {
+                               my $itm_j = $sorted[$j];
+                               next if $itm->{$itm_j} != $floor;
+                               next if $floor == 4 && $itm_i ne $itm_j;
+                               next if $itm_i =~ /\AG/ && $itm_j =~ /\AM/
+                                       && substr($itm_i, 1) ne substr($itm_j, 1);
+                               my %nitm = %$itm;
+                               # say "moving $itm_i $itm_j from $floor to $nf steps $steps+1";
+                               $nitm{$itm_i} = $nf;
+                               $nitm{$itm_j} = $nf;
+                               next if !valid_f($nf, \%nitm);
+                               next if !valid_f($floor, \%nitm);
+                               my $nw = 2*$steps;
+                               $nw += 4 - $nitm{$_} for keys %nitm;
+                               push_heap @q, [ $nw, $steps+1, $nf, \%nitm ];
+                       }
+               }
+       }
+}
+
+
+
+
+