RogerBW's Blog

I’ve been doing the Perl Weekly Challenges. The latest involved searching for paths through a grid and breaking a word into tokens.

Given an m × n matrix with non-negative integers, write a script to find a path from top left to bottom right which minimizes the sum of all numbers along its path. You can only move either down or right at any point in time.

Another week, another breadth-first search with a FIFO buffer. Each buffer entry consists of the x,y coordinates of the current/next position, followed by the trail to date..

my @l=([0,0]);

my $s;
my @p;

while (@l) {
  my $t=shift @l;
  my @xy=splice @{$t},0,2;

Add to the trail the value of the current cell.

  push @{$t},$in[$xy[0]][$xy[1]];

If this is the bottom right cell…

  if ($t->[-1] == $in[-1][-1]) {

Here's the big inefficiency; I could keep the sum-to-date in that buffer too rather than calculating the whole thing each time.

    my $sa=sum(@{$t});

But if that sum is less than the lowest sum found so far (or we haven't found one yet), set the lowest sum to this, and log the trail. (We only need one lowest-value trail, not all of them.)

    if (!defined $s || $sa < $s) {
      $s=$sa;
      @p=@{$t};
    }
  }

In any case, if (x+1,y) lies inside the array, try that later.

  if ($xy[0] < $#in && $xy[1] <= $#{$in[$xy[0]+1]}) {
    push @l,[$xy[0]+1,$xy[1],@{$t}];
  }

If (x,y+1) lies inside the array, try that later too.

  if ($xy[1] < $#{$in[$xy[0]]}) {
    push @l,[$xy[0],$xy[1]+1,@{$t}];
  }
}

Then print the output in the desired form.

binmode STDOUT,':utf8';
print "$s ( ".join(' → ',@p)." )\n";

I decided to beat Raku until it behaved.

my @l=((0,0),);

my $s='';
my @p;

while (@l) {

For once, flat seems to be enough.

  my @t=(shift @l).flat;
  my @xy=splice @t,0,2;
  push @t,@in[@xy[0]][@xy[1]];

This is of course a much cleaner syntax than $in[-1][-1] that we used in Perl.

  if (@t[@t.end] == @in[@in.end][@in[@in.end].end]) {
    my $sa=sum(@t);
    if ($s eq '' || $sa < $s) {
      $s=$sa;
      @p=@t;
    }
  }

And the maps get the array-squashing job done.

  if (@xy[0] < @in.end && @xy[1] <= @in[@xy[0]+1].end) {
    push @l,(@xy[0]+1,@xy[1],map {$_},@t);
  }
  if (@xy[1] < @in[@xy[0]].end) {
    push @l,(@xy[0],@xy[1]+1,map {$_},@t);
  }
}

say "$s ( " ~ join(' → ',@p) ~ " )";

You are given a string $S and an array of words @W.

Write a script to find out if $S can be split into sequence of one or more words as in the given @W.

Print the all the words if found otherwise print 0.

There's no word-splitting here, just an attempt to construct the longer string from the shorter ones. And guess what, it's another breadth-first search with a FIFO buffer.

my $sl=length($S);

my @l;
my $done=0;

while (!$done) {
  my $c=[];
  if (@l) {
    $c=shift @l;
  }

$c is the list of words used thus far; $cc is their concatenation.

  my $cc=join('',@{$c});
  foreach my $wc (@W) {

$ccw is the concatenation of $cc with the candidate word, and $ccwl is its length.

    my $ccw=$cc.$wc;
    my $ccwl=length($ccw);

So if $ccw is longer than the source string, it can be discarded. If it's exactly the same length and it matches, we have a solution. If it's shorter and it matches, add this sequence to the buffer for later extension.

    if ($ccwl <= $sl) {
      if (index($S,$ccw)==0) {
        push @l,[@{$c},$wc];
        if ($ccwl == $sl) {
          $done=1;
          last;
        }
      }
    }
  }
  unless (@l) {
    last;
  }
}

The solution is in the last entry in @l.

if (@l) {
  print join(', ',map {'"' . $_ . '"'} @{$l[-1]}),"\n";
} else {
  print "0\n";
}

Raku needs a bit more tweaking… chars instead of length, mostly, but also a two-stage test of index (because it now returns Nil rather than -1 when there's no match, which generates a warning if you use it in a numeric comparison)

    if ($ccwl <= $sl) {
      with index($S,$ccw) -> $i {

And then there's a whole intermediate variable needed in order to get the right structure pushed into the buffer.

        if ($i==0) {
          my @q=@c;
          push @q,$wc;
          push @l,@q;
          if ($ccwl == $sl) {
            $done=1;
            last;
          }
        }

The more Raku I write, the more I realise there is basically no project in which I'd choose to use it rather than any other language I know. The neat bits of syntax, while very neat indeed, are not for me sufficient compensation for the loss of CPAN when moving from Perl, and it's dog-slow to boot.