yanick/adventofcode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

2016-11

Browse Source
This commit is contained in:
Yanick Champoux 2018-02-09 15:01:54 -05:00
parent ea99991108
commit 4bbacd7687
2 changed files with 55 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
2016/11/1.pl
View File

@ -1,86 +1,57 @@
use 5.20.0; use 5.20.0;
use JSON 'to_json'; use JSON 'to_json';
use List::AllUtils qw/ all min part uniq pairgrep any /; use List::AllUtils qw/ all any uniq min part uniq pairgrep any max /;
my %state = ( my %state = (
E => 1, E => 1,
TG => 1, HM => 1,
TM => 1, LM => 1,
PG => 1, HG => 2,
SG => 1, LG => 3,
PM => 2,
SM => 2,
WG => 3,
WM => 3,
RG => 3,
RM => 3,
); );
sub freeze { to_json( { @_ }, { canonical => 1 } ) } sub freeze { to_json( { @_ }, { canonical => 1 } ) }
my %history = (
0 => freeze(%state),
);
use DDP; use DDP;
p %history;
my @next = ( [ 0, %state ] ); my $max = 1E99;
while( my $n = shift @next ) { search( 0, \%state, freeze(%state) );
search( @$n );
} say $max;
sub search { sub search {
my( $steps, %state ) = @_; my( $steps, $state, @history ) = @_;
say "size: ", scalar @next; say "steps: ", $steps;
say $steps;
# p $steps;
# p %state;
if( all { $_ == 4 } values %state ) { if( all { $_ == 4 } values %$state ) {
say "woohoo, found it: $steps"; $max = min $max, $steps;
die; say "woohoo, found it: $steps, $max";
}
my $f = freeze(%state);
if( $history{$f}++ ) {
return say "seen it";
}
if( britzle(%state) ) {
# say "we fried something";
return; return;
} }
return if $steps + 1 >= $max;
my $level = $state{E}; my $level = $state->{E};
my @things = grep { $_ ne 'E' and $state{$_} == $level } keys %state; 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); use Algorithm::Combinatorics qw(combinations);
my $combs = combinations( \@things, 2 );
$steps++;
for my $group (2,1) {
next if @things < $group;
my $combs = combinations( \@things, $group );
while( my $c = $combs->next ) { while( my $c = $combs->next ) {
for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) { I: for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) {
push @next, [ my %new_state = ( %$state, map { $_ => $next_level } 'E', @$c );
$steps + 1, my $f = freeze(%new_state);
%state, if ( any { $_ eq $f } @history ) { next I };
map { $_ => $next_level } 'E', @$c if ( britzle(%new_state) ) { next I; };
]; search( $steps, \%new_state, $f, @history )
} }
} }
} }

73
2016/11/2.pl
View File

@ -23,68 +23,45 @@ my %state = (
sub freeze { to_json( { @_ }, { canonical => 1 } ) } sub freeze { to_json( { @_ }, { canonical => 1 } ) }
my %history = (
0 => freeze(%state),
);
use DDP; use DDP;
p %history;
my @next = ( [ 0, %state ] ); my $max = 55;
while( my $n = shift @next ) { search( 0, \%state, freeze(%state) );
search( @$n );
} say $max;
sub search { sub search {
my( $steps, %state ) = @_; my( $steps, $state, @history ) = @_;
say "size: ", scalar @next; # say "steps: ", $steps;
say $steps;
# p $steps;
# p %state;
if( all { $_ == 4 } values %state ) { if( all { $_ == 4 } values %$state ) {
say "woohoo, found it: $steps"; $max = min $max, $steps;
die; say "woohoo, found it: $steps, $max";
}
my $f = freeze(%state);
if( $history{$f}++ ) {
return say "seen it";
}
if( britzle(%state) ) {
# say "we fried something";
return; return;
} }
return if $steps + 1 >= $max;
my $level = $state{E}; my $level = $state->{E};
my @things = grep { $_ ne 'E' and $state{$_} == $level } keys %state; 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); use Algorithm::Combinatorics qw(combinations);
my $combs = combinations( \@things, 2 );
$steps++;
for my $group (2,1) {
next if @things < $group;
my $combs = combinations( \@things, $group );
while( my $c = $combs->next ) { while( my $c = $combs->next ) {
for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) { I: for my $next_level ( grep { $_ >= 1 and $_ <= 4 } $level + 1, $level - 1 ) {
push @next, [ my %new_state = ( %$state, map { $_ => $next_level } 'E', @$c );
$steps + 1, my $f = freeze(%new_state);
%state, if ( any { $_ eq $f } @history ) { next I };
map { $_ => $next_level } 'E', @$c if ( britzle(%new_state) ) { next I; };
]; search( $steps, \%new_state, $f, @history )
} }
} }
} }