adventofcode/2016/11/1.pl

72 lines
1.6 KiB
Perl
Raw Normal View History

2018-02-09 15:01:01 +00:00
use 5.20.0;
use JSON 'to_json';
2018-02-09 20:01:54 +00:00
use List::AllUtils qw/ all any uniq min part uniq pairgrep any max /;
2018-02-09 15:01:01 +00:00
my %state = (
E => 1,
2018-02-09 20:01:54 +00:00
HM => 1,
LM => 1,
HG => 2,
LG => 3,
2018-02-09 15:01:01 +00:00
);
sub freeze { to_json( { @_ }, { canonical => 1 } ) }
use DDP;
2018-02-09 20:01:54 +00:00
my $max = 1E99;
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
search( 0, \%state, freeze(%state) );
say $max;
2018-02-09 15:01:01 +00:00
sub search {
2018-02-09 20:01:54 +00:00
my( $steps, $state, @history ) = @_;
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
say "steps: ", $steps;
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
if( all { $_ == 4 } values %$state ) {
$max = min $max, $steps;
say "woohoo, found it: $steps, $max";
return;
2018-02-09 15:01:01 +00:00
}
2018-02-09 20:01:54 +00:00
return if $steps + 1 >= $max;
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
my $level = $state->{E};
my @things = grep { $_ ne 'E' and $state->{$_} == $level } keys %$state;
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
use Algorithm::Combinatorics qw(combinations);
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
$steps++;
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
for my $group (2,1) {
next if @things < $group;
2018-02-09 15:01:01 +00:00
2018-02-09 20:01:54 +00:00
my $combs = combinations( \@things, $group );
2018-02-09 15:01:01 +00:00
while( my $c = $combs->next ) {
2018-02-09 20:01:54 +00:00
I: for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) {
my %new_state = ( %$state, map { $_ => $next_level } 'E', @$c );
my $f = freeze(%new_state);
if ( any { $_ eq $f } @history ) { next I };
if ( britzle(%new_state) ) { next I; };
search( $steps, \%new_state, $f, @history )
2018-02-09 15:01:01 +00:00
}
}
}
}
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;
}