2016-11-part-1

2016/11/1.pl

@@ -0,0 +1,100 @@
+use 5.20.0;
+
+use JSON 'to_json';
+use List::AllUtils qw/ all min part uniq pairgrep any /;
+
+my %state = (
+    E => 1,
+    TG => 1,
+    TM => 1,
+    PG => 1,
+    SG => 1,
+    PM => 2,
+    SM => 2,
+    WG => 3,
+    WM => 3,
+    RG => 3,
+    RM => 3,
+);
+
+sub freeze { to_json( { @_ }, { canonical => 1 } ) }
+
+my %history = (
+    0 => freeze(%state),
+);
+
+use DDP;
+p %history;
+
+my @next = ( [ 0, %state ] );
+
+while( my $n = shift @next ) {
+    search( @$n );
+}
+
+sub search {
+    my( $steps, %state ) = @_;
+
+    say "size: ", scalar @next;
+    say $steps;
+#    p $steps;
+#    p %state;
+
+    if( all { $_ == 4 } values %state ) {
+        say "woohoo, found it: $steps";
+        die;
+    }
+
+    my $f = freeze(%state);
+
+    if( $history{$f}++ ) {
+        return say "seen it";
+    }
+
+    if( britzle(%state) ) {
+#        say "we fried something";
+        return;
+    }
+
+
+    my $level = $state{E};
+    my @things = grep { $_ ne 'E' and $state{$_} == $level } keys %state;
+
+    for my $thing ( @things ) {
+        for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) {
+            push @next, [
+                $steps + 1,
+                %state,
+                E => $next_level,
+                $thing => $next_level,
+            ];
+        }
+    }
+
+    if ( @things >=2 ) {
+        use Algorithm::Combinatorics qw(combinations);
+        my $combs = combinations( \@things, 2 );
+        while( my $c = $combs->next ) {
+            for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) {
+                push @next, [
+                    $steps + 1,
+                    %state,
+                    map { $_ => $next_level } 'E', @$c
+                ];
+            }
+        }
+    }
+
+}
+
+sub britzle {
+    my %state = @_;
+
+    my @danger = grep { $state{$_} != $state{ s/M$/G/r } } grep { /.M/ } keys %state;
+
+    for my $level ( uniq map { $state{$_} } @danger ) {
+        return 1 if pairgrep { $a =~ /G$/ and $b == $level } %state;
+    }
+
+    return 0;
+}

2016/11/2.pl

@@ -0,0 +1,104 @@
+use 5.20.0;
+
+use JSON 'to_json';
+use List::AllUtils qw/ all min part uniq pairgrep any /;
+
+my %state = (
+    E => 1,
+    EG => 1,
+    DG => 1,
+    DM => 1,
+    EM => 1,
+    TG => 1,
+    TM => 1,
+    PG => 1,
+    SG => 1,
+    PM => 2,
+    SM => 2,
+    WG => 3,
+    WM => 3,
+    RG => 3,
+    RM => 3,
+);
+
+sub freeze { to_json( { @_ }, { canonical => 1 } ) }
+
+my %history = (
+    0 => freeze(%state),
+);
+
+use DDP;
+p %history;
+
+my @next = ( [ 0, %state ] );
+
+while( my $n = shift @next ) {
+    search( @$n );
+}
+
+sub search {
+    my( $steps, %state ) = @_;
+
+    say "size: ", scalar @next;
+    say $steps;
+#    p $steps;
+#    p %state;
+
+    if( all { $_ == 4 } values %state ) {
+        say "woohoo, found it: $steps";
+        die;
+    }
+
+    my $f = freeze(%state);
+
+    if( $history{$f}++ ) {
+        return say "seen it";
+    }
+
+    if( britzle(%state) ) {
+#        say "we fried something";
+        return;
+    }
+
+
+    my $level = $state{E};
+    my @things = grep { $_ ne 'E' and $state{$_} == $level } keys %state;
+
+    for my $thing ( @things ) {
+        for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) {
+            push @next, [
+                $steps + 1,
+                %state,
+                E => $next_level,
+                $thing => $next_level,
+            ];
+        }
+    }
+
+    if ( @things >=2 ) {
+        use Algorithm::Combinatorics qw(combinations);
+        my $combs = combinations( \@things, 2 );
+        while( my $c = $combs->next ) {
+            for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) {
+                push @next, [
+                    $steps + 1,
+                    %state,
+                    map { $_ => $next_level } 'E', @$c
+                ];
+            }
+        }
+    }
+
+}
+
+sub britzle {
+    my %state = @_;
+
+    my @danger = grep { $state{$_} != $state{ s/M$/G/r } } grep { /.M/ } keys %state;
+
+    for my $level ( uniq map { $state{$_} } @danger ) {
+        return 1 if pairgrep { $a =~ /G$/ and $b == $level } %state;
+    }
+
+    return 0;
+}

2016/11/input.txt

@@ -0,0 +1,4 @@
+The first floor contains a thulium generator, a thulium-compatible microchip, a plutonium generator, and a strontium generator.
+The second floor contains a plutonium-compatible microchip and a strontium-compatible microchip.
+The third floor contains a promethium generator, a promethium-compatible microchip, a ruthenium generator, and a ruthenium-compatible microchip.
+The fourth floor contains nothing relevant.