Hey, no fair changing the rules in the middle...
#!/usr/bin/perl
use strict; # https://perlmonks.org/?node_id=11114231
use warnings;
my ($startrow, $startcol, $destrow, $destcol);
my @m;
my @visited;
my $maxrow;
my $maxcol;
my $maxscore;
my $minlength;
my $best;
for my $SIZE ( 2, 3 ) # add in 1024 and be prepared to wai
+t :)
{
# srand 42; # uncomment for the specified problem
+grid
my $W = $SIZE;
my $H = $SIZE;
my $maxscore = 10;
my $Grid = [];
for my $row ( 0 .. $H - 1 )
{
$Grid->[$row] = [(0)x$W];
for my $col ( 0 .. $W - 1 )
{
$Grid->[$row]->[$col] = $maxscore - int(rand(2*$maxscore+1))
}
}
# now add a highscore to stand out for just 1 cell in each column
my $highscore = 21;
for my $row ( 0 .. $H - 1 )
{
$Grid->[$row]->[int(rand($W))] = $highscore;
}
for my $row ( 0 .. $H-1 )
{
printf "%4d" x $W . "\n", @{ $Grid->[$row] };
}
print "\n";
($startrow, $startcol, $destrow, $destcol) = (0, 0, $H-1, $W-1);
@m = @$Grid;
@visited = ();
$maxrow = $W-1;
$maxcol = $H-1;
$maxscore = undef;
$minlength = undef;
$best = undef;
$visited[$startrow][$startcol] = 1;
try( $startrow, $startcol, $m[$startrow][$startcol] );
$best or die "no best found";
# print "\n$best\n\n";
my @best = split ' ', $best;
my @values;
print "best path:\n";
for ( my $i = 0; $i < @best - 4; $i += 3 )
{
print directions(@best[$i .. $i+5]), ' ';
# push @values, $m[$best[$i]][$best[$i+1]];
push @values, $best[$i+2] eq '00' ? '00' : $m[$best[$i]][$best[$i+
+1]];
}
print "\n= ";
print join '+', @values, $m[$best[-3]][$best[-2]];
print "\n= $best[-1]\n\n";
}
sub try
{
my ($row, $col, $score) = @_[-3 .. -1];
# print "$row $col $score\n";
if( $row == $destrow && $col == $destcol )
{
if( $maxscore )
{
if( $score > $maxscore or
$score == $maxscore and $minlength > @_)
{
$maxscore = $score;
$minlength = @_;
$best = "@_";
}
}
else
{
$maxscore = $score;
$minlength = @_;
$best = "@_";
}
return;
}
for my $r ( 0 .. $maxrow )
{
if( ++$visited[$r][$col] == 1 )
{
# if( $m[$r][$col] >= 0 ||
# $r == $destrow && $col == $destcol )
{
if( $r < $row - 1 )
{
my @slide = map {($_, $col, '00') } reverse $r + 1 .. $row -
+ 1;
try( @_, @slide, $r, $col, $score + $m[$r][$col] );
}
elsif( $r > $row + 1 )
{
my @slide = map {($_, $col, '00') } $row + 1 .. $r - 1;
try( @_, @slide, $r, $col, $score + $m[$r][$col] );
}
else
{
try( @_, $r, $col, $score + $m[$r][$col] );
}
}
}
--$visited[$r][$col];
}
for my $c ( 0 .. $maxcol )
{
if( ++$visited[$row][$c] == 1 )
{
# if( $m[$row][$c] >= 0 ||
# $row == $destrow && $c == $destcol )
{
if( $c < $col - 1 )
{
my @slide = map {($row, $_, '00') } reverse $c + 1 .. $col -
+ 1;
try( @_, @slide, $row, $c, $score + $m[$row][$c] );
}
elsif( $c > $col + 1 )
{
my @slide = map {($row, $_, '00') } $col + 1 .. $c - 1;
try( @_, @slide, $row, $c, $score + $m[$row][$c] );
}
else
{
try( @_, $row, $c, $score + $m[$row][$c] );
}
}
}
--$visited[$row][$c];
}
}
sub directions
{
my ($rowfrom, $colfrom, $fromscore, $rowto, $colto, $toscore) = @_;
return +($rowfrom != $rowto ?
$rowfrom < $rowto ? 'down' : 'up' :
$colfrom < $colto ? 'right' : 'left') .
($toscore eq '00' ? '-slide' : '');
}
Sample Output:
21 -8
5 21
best path:
down right
= 21+5+21
= 47
3 21 -6
9 21 10
-7 7 21
best path:
down right-slide right left up down-slide down right
= 3+9+00+10+21+21+00+7+21
= 92
For a size of 1024 x 1024, run time is estimated to be either
the twelfth of never, or
three days after the heat death of the universe,
whichever comes last.