2016-11
This commit is contained in:
parent
ea99991108
commit
4bbacd7687
89
2016/11/1.pl
89
2016/11/1.pl
@ -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 ) {
|
use Algorithm::Combinatorics qw(combinations);
|
||||||
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 ) {
|
$steps++;
|
||||||
use Algorithm::Combinatorics qw(combinations);
|
|
||||||
my $combs = combinations( \@things, 2 );
|
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
73
2016/11/2.pl
@ -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 ) {
|
use Algorithm::Combinatorics qw(combinations);
|
||||||
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 ) {
|
$steps++;
|
||||||
use Algorithm::Combinatorics qw(combinations);
|
|
||||||
my $combs = combinations( \@things, 2 );
|
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 )
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
Loading…
Reference in New Issue
Block a user