The Minimum Break with Raku

by Arne Sommer

The Minimum Break with Raku

[77] Published 13. June 2020.

This is my response to the Perl Weekly Challenge #064.

Challenge #064.1: Minimum Sum Path

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.

Examples
[ 1 2 3 ]
[ 4 5 6 ]
[ 7 8 9 ]
The minimum sum path looks like this: 
1→2→3
    ↓
    6
    ↓
    9
Thus, your script could output: 21 ( 1 → 2 → 3 → 6 → 9 )

The only problem here is deciding how the program should get hold of the matrix. There are 3 obvious ways that I can think of:

  • On the command line (e.g. "[1 2 3]\n[4 5 6]\n[7 8 9]\n" with embedded newlines, if we are to take the challenge at face value)
  • In a file, specified on the command line
  • On STDIN (typically piped from another program, but interactively works as well)

I have chosen to support them all.

File: misupa (partial) 
multi MAIN (:$verbose)                                              # [1]
{
  MAIN(lines().join, :$verbose); 
}

multi MAIN ($file where $file.IO.e, :$verbose)                      # [2]
{
  MAIN($file.IO.lines().join, :$verbose);
}

multi MAIN (Str $string is copy where ! $string.IO.e, :$verbose)    # [3]
{
  ... 
}

Multiple dispatch (where multi is shorthand for multi sub, with three candidates for the entry point; the magical MAIN procedure.

[1] This version has no positional arguments. It assumes that the input comes on STDIN, and uses lines to read it. Then it merges the lines into a single string, and passes the string on to the third candidate (see [3]).

[2] This version has a filename as argument. It reads the content of the file (without the newlines), merges them into a single string (again without the newlines), and passes the string on to the third candidate (see [3]).

[3] This is the version that is used internally by the first two (see [1] and [2]), and if we specify the string on the command line. Note the where clause to ensure that the string is not a filename, as this candidate would have happily taken over for the second candidate if we had dropped it. The actual content of this procedure will be shown later.

See docs.raku.org/language/create-cli#index-entry-MAIN for more information about the special MAIN procedure.

See docs.raku.org/syntax/multi for information about multi.

See docs.raku.org/routine/lines for information about lines.

Before presenting the rest of the program, here is some examples showing the different ways of specifying the matrix.

Here is a file with the matrix given in the challenge:

File: matrix-3x3.txt 
[ 1 2 3 ]
[ 4 5 6 ]
[ 7 8 9 ]

Then we can run it: 

$ raku misupa "[1 2 3]\n[4 5 6]\n[7 8 9]\n"
21 ( 1 → 2 → 3 → 6 → 9 )

$ raku misupa "[1 2 3][4 5 6][7 8 9]"
21 ( 1 → 2 → 3 → 6 → 9 )

$ raku misupa matrix-3x3.txt 
21 ( 1 → 2 → 3 → 6 → 9 )

$ cat matrix-3x3.txt | raku misupa
21 ( 1 → 2 → 3 → 6 → 9 )

$ raku misupa
[1 2 3]
[4 5 6]
[7 8 9]
^D
21 ( 1 → 2 → 3 → 6 → 9 )

The first has embedded newlines, and the second one shows that we can skip them if we want to. The third one specifes the filename of the matrix, the fourth gets the file piped from STDIN, and the fifth one waits for the user to enter it (row by row, terminated with Control-D).

The following code builds up the matrix, which is a two dimensional array. We add one row at a time.

File: misupa (partial) 
multi MAIN (Str $string is copy where ! $string.IO.e, :$verbose)   # [1]
{
  subset PositiveIntZero of Int where * >= 0;                      # [2]
  
  my @matrix;                                                      # [3]

  while $string ~~ /"[" (.*?) "]" (.*)/                            # [4]
  {
    $string = $1.Str.trim;                                         # [5]

    say ":: Row: $0" if $verbose;

    my @values = $0.words>>.Int;                                   # [6]
    die "Illegal value in row $0" unless all(@values) ~~ PositiveIntZero;
                                                                   # [7]
    @matrix.push: @values;                                         # [8]
  }

[1] is copy on a procedure argument so that we can change the value (see [5]). They are read only by default. The negated where clause ensures that the argument is not a filename.

[2] A custom type with subset which we will use (in [6]) to ensure that the values in the matrix are legal.

[3] The variable holding the matrix.

[4] The rows in the matrix are enclosed in brackets ([ and ]), according to the challenge. As long as there are (at least) a pair of them (and note the non-greedy regex quantifier (the ?) so that it matches the first on only);

[5] • Place the rest of the line (after the first row has been removed) back in the variable, ready for the next iteration. trim removes any leading and trailing space characters (including newlines). The .Str call coerces the match object to a string, but as we apply trim on it (which will itself coerce it to a string if it is not) we could have skipped it here. But it is a good idea to be careful with match objects.

[6] Split the row (a string) into separate values. Note the words will give you strings, so we have to coerce the values to integers manually (as we want them to be integers; see [7]). This is done with the hyper method call operator && that operates on every element in the array. Any non-integers in the input will cause an exception (and program termination), which is fine.

[7] I use an all junction to ensure that all the values in the array satisfies the type. This works, as we coerced the strings to integers (in [6]).

[8] Add the row to the matrix.

See docs.raku.org/language/operators#index-entry-methodop_>>. for more information about the hyper method call operator >>..

See docs.raku.org/routine/all for more information about all, and docs.raku.org/type/Junction for more information about Junctions.

File: misupa (partial) 
  my @path = ();                                                      # [9]
  my $best = Inf;                                                     # [10]
  my $last_row = @matrix.elems - 1;                                   # [11]
  my $last_col = @matrix[0].elems -1;                                 # [12]

  die "Not the same length on the rows" unless [==] @matrix>>.elems;  # [13]

[9] We store the best part (so far) in this array.

[10] The value (sum of the nodes) of the best part (so far). We are going to clear out the path whenever we find a better (lower) value.

[11] The index of the last row, as I need that later on to check that we are on course. (Note that I could have used end instead of elems -1.)

[12] Ditto, for the columns. Or rather, the first column only.

[13] Check that all the rows have the same number of elements (columns). The hyper method call operator >>. gives us the number of elements in each row, as a list. Then we apply the Reduction Metaoperator [] on that list to reduce it to a single value. The operator, which logically is inserted between each value is ==, so we end up with checking that all the values are (numerically) equal - and thus that all the rows have the same length.

See https://docs.raku.org/routine/elems for more information about elems.

See https://docs.raku.org/routine/end for more information about end.

See docs.raku.org/language/operators#Reduction_metaoperators for more information about Reduction metaoperators.

File: misupa (partial) 
  traverse((@matrix[0;0],), 0, 0);               # [14]

  for @path -> @current                          # [15]
  {
    say "$best ( { @current.join(" → ") } )";    # [16]
  }

[14] This recursive call does all the work. The first value is a list of values in the path so far. Initially this is only the upper left corner (or rather, the value). We need a list (a list with one value, but still a list), and we get that by slapping on a , (a comma), the list operator after the value. Parens (( and )) will not do you any good, as they will only group the values - and not generate a list.

[15] For each value, as we can have several paths with the same sum. I'll get to this later.

[16] Print the values with the requested arrow between them.

See docs.raku.org/routine/, for more information about the list operator ,.

File: misupa (the rest) 
  sub traverse (@my-path, $x, $y)                     # [17]
  {
    if $x == $last_row && $y == $last_col             # [18]
    {
      my $sum = @my-path.sum;                         # [19]
      say ":: At the end with sum $sum and path: @my-path[]" if $verbose;
      ( $best = $sum; @path = () ) if $sum < $best;   # [20]
      @path.push: @my-path if $sum == $best;          # [21]
      return;                                         # [22]
    }

    say ":: Currently at pos: [$x,$y] with path: @my-path[]" if $verbose;
  
    if $x < $last_row                                 # [23]
    {
      my @new-path = @my-path;                        # [24]
      @new-path.push: @matrix[$x+1;$y];               # [24a]
      traverse(@new-path, $x+1, $y);                  # [25]
    }
    if $y < $last_col                                 # [26]
    {
      my @new-path = @my-path;                        # [27]
      @new-path.push: @matrix[$x;$y+1];               # [27a]
      traverse(@new-path, $x, $y+1);                  # [28]
    }
  }
}

[17] The recursive procedure. The first argument is the path so far (just the values, not the actual positions), followed by the x and y coordinates of the current poisition.

[18] Have we arrived at the lower right corner?

[19] • Get the sum of the values of the path that got us here.

[20] • Is the sum lower than what we had before? If so set the new value and clean out the old path.

[21] • Add the current path to the list of paths, if it has the lowest sum.

[22] • We are done with this recursion.

[23] Are there more rows?

[24] • Get a copy of the path, and add the new position.

[25] • Recursive call with the new position.

[26] Are there more columns?

[27] • Get a copy of the path, and add the new position.

[28] • Recursive call with the new position.

Feel free to take a short break now...

We can have several solutions, as I said above: 

$ raku misupa "[1 2 3]\n[2 9 4]\n[3 4 5]\n"
15 ( 1 → 2 → 3 → 4 → 5 )
15 ( 1 → 2 → 3 → 4 → 5 )

$ raku misupa --verbose "[1 2 3]\n[2 9 4]\n[3 4 5]\n"
:: Row: 1 2 3
:: Row: 2 9 4
:: Row: 3 4 5
:: Currently at pos: [0,0] with path: 1
:: Currently at pos: [1,0] with path: 1 2
:: Currently at pos: [2,0] with path: 1 2 3
:: Currently at pos: [2,1] with path: 1 2 3 4
:: At the end with sum 15 and path: 1 2 3 4 5
:: Currently at pos: [1,1] with path: 1 2 9
:: Currently at pos: [2,1] with path: 1 2 9 4
:: At the end with sum 21 and path: 1 2 9 4 5
:: Currently at pos: [1,2] with path: 1 2 9 4
:: At the end with sum 21 and path: 1 2 9 4 5
:: Currently at pos: [0,1] with path: 1 2
:: Currently at pos: [1,1] with path: 1 2 9
:: Currently at pos: [2,1] with path: 1 2 9 4
:: At the end with sum 21 and path: 1 2 9 4 5
:: Currently at pos: [1,2] with path: 1 2 9 4
:: At the end with sum 21 and path: 1 2 9 4 5
:: Currently at pos: [0,2] with path: 1 2 3
:: Currently at pos: [1,2] with path: 1 2 3 4
:: At the end with sum 15 and path: 1 2 3 4 5
15 ( 1 → 2 → 3 → 4 → 5 )
15 ( 1 → 2 → 3 → 4 → 5 )

The values are identical, so it is hard to deduce the actual path if we wanted to.

This one is even worse: 

$ raku misupa "[1 2 3]\n[2 1 2]\n[1 2 3]\n"
9 ( 1 → 2 → 1 → 2 → 3 )
9 ( 1 → 2 → 1 → 2 → 3 )
9 ( 1 → 2 → 1 → 2 → 3 )
9 ( 1 → 2 → 1 → 2 → 3 )
9 ( 1 → 2 → 1 → 2 → 3 )

Here it is as a graph with the 5 different paths marked:

It is easy(ish) to fix the arrows (in the program) so that they show the actual direction. The challenge didn't ask for it, so it must be enabled with a new command line option «--arrows».

I'll show the result first: 

$ raku misupa-direction --arrows matrix-3x3.txt 
21 ( 1 → 2 → 3 ↓ 6 ↓ 9 )

$ raku misupa-direction --arrows "[1 2 3]\n[2 1 2]\n[1 2 3]\n"
9 (1 ↓ 2 ↓ 1 → 2 → 3)
9 (1 ↓ 2 → 1 ↓ 2 → 3)
9 (1 ↓ 2 → 1 → 2 ↓ 3)
9 (1 → 2 ↓ 1 ↓ 2 → 3)
9 (1 → 2 ↓ 1 → 2 ↓ 3)

Note the down arrow when we go down.

Then the program:

File: misupa-direction (with the changes highlighted) 
multi MAIN (:$verbose, :$arrows)                         # [1]
{
  MAIN(lines().join, :$verbose, :$arrows);               # [1]
}

multi MAIN ($file where $file.IO.e, :$verbose, :$arrows) # [1]
{
  MAIN($file.IO.lines().join, :$verbose, :$arrows);      # [1]
}

multi MAIN (Str $string is copy where ! $string.IO.e, :$verbose, :$arrows)
{                                                        # [1]
  subset PositiveIntZero of Int where * >= 0;
  
  my @matrix;

  while $string ~~ /"[" (.*?) "]" (.*)/
  {
    $string = $1.Str.trim;

    say ":: Row: $0" if $verbose;

    my @values = $0.words>>.Int;
    die "Illegal value in row $0" unless all(@values) ~~ PositiveIntZero;

    @matrix.push: @values;
  }

  my @path     = ();
  my @arrows   = ();                                      # [4]
  my $best     = Inf;
  my $last_row = @matrix.elems - 1;
  my $last_col = @matrix[0].elems -1;

  die "Not the same length on the rows" unless [==] @matrix>>.elems;

  traverse((@matrix[0;0],), 0, 0, "");

  if $arrows
  {
    for ^@path -> $index
    {
      say "$best ({ (roundrobin @(@path[$index]),        # [6]
                     @arrows[$index].comb).flat })";
    }
  }
  else
  {
    for @path -> @current
    {
      say "$best ( { @current.join(" → ") } )";
    }
  }
  
  sub traverse (@my-path, $x, $y , $arrows)
  {
    if $x == $last_row && $y == $last_col
    {
      my $sum = @my-path.sum;
      say ":: At the end with sum $sum and path: @my-path[]" if $verbose;
      ( $best = $sum; @path = (); @arrows = () ) if $sum < $best;
      ( @path.push: @my-path; @arrows.push: $arrows) if $sum == $best;
      return;                                            # [5]
    }

    say ":: Currently at pos: [$x,$y] with path: @my-path[]" if $verbose;
  
    if $x < $last_row
    {
      my @new-path = @my-path;
      @new-path.push: @matrix[$x+1;$y];
      traverse(@new-path, $x+1, $y, $arrows ~  "↓");     # [2]
    }
    if $y < $last_col
    {
      my @new-path = @my-path;
      @new-path.push: @matrix[$x;$y+1];
      traverse(@new-path, $x, $y+1, $arrows ~ "→");     # [3]
    }
  }
}

[1] We store the directions (arrows) the same way as we have stored the values, and then pass them along with every recursive call. But we can use a single string (instead of an array as done with the values) to make it simpler.

[2] Add are going down, so add a down arrow.

[3] Add are going to the right, so add a right arrow.

[4] We can have several solutions, so we store the arrow strings in an array, just as we do with the path (the line above).

[5] On the lines above, we do the same with the arrows as we did with the path; clear it if we got a new lower value, and add the current value to the list.

[6] We are using roundrobin to print the arrows between the values, as it merges two lists (with one value from each, each time).

See docs.raku.org/routine/roundrobin for more information about the roundrobin function.

Let us try with a matrix with nothing but zeroes, 6 rows with 5 columns of them:

File: matrix-zero.txt 
[ 0 0 0 0 0 ]
[ 0 0 0 0 0 ]
[ 0 0 0 0 0 ]
[ 0 0 0 0 0 ]
[ 0 0 0 0 0 ]
[ 0 0 0 0 0 ]

$ raku misupa-direction --arrows matrix-zero.txt
0 (0 ↓ 0 ↓ 0 ↓ 0 ↓ 0 ↓ 0 → 0 → 0 → 0 → 0)
0 (0 ↓ 0 ↓ 0 ↓ 0 ↓ 0 → 0 ↓ 0 → 0 → 0 → 0)
0 (0 ↓ 0 ↓ 0 ↓ 0 ↓ 0 → 0 → 0 ↓ 0 → 0 → 0)
0 (0 ↓ 0 ↓ 0 ↓ 0 ↓ 0 → 0 → 0 → 0 ↓ 0 → 0)
...
0 (0 → 0 → 0 → 0 → 0 ↓ 0 ↓ 0 ↓ 0 ↓ 0 ↓ 0)

We get 126 different paths, so I have abridged the output.

Testing it with lots of different matrices manually isn't much fun. But we can have the program make random matrices for us:

File: misupa-random (changes only) 
multi MAIN ("random", :$verbose, :$arrows, :$cols = 3, :$rows = 3,
                      :$low = 0, :$high = 9)
{
  my $matrix;
  $matrix ~= "[ { ($low .. $high).pick($cols).join(" ") } ]" for ^$rows;

  say "Matrix: $matrix";

  MAIN($matrix, :$verbose, :$arrows);
}

All we have to do is add another multi MAIN candidate. Specify the string «random» on the command line to get this candidate. It supports additional named arguments:

  • --cols - the numer of columns, with 3 as default value
  • --rows - the numer of rows, with 3 as default value
  • --low - the lowest value to choose from, with 0 as default value.
  • --high - the highest value to choose from, with 9 as default value
Note the missing check for legal values. This is generally bad, but illegal values will crash the program later on. And that is ok.

Running it: 

$ raku misupa-random --arrows random
Matrix: [ 8 9 6 ][ 3 4 9 ][ 9 4 2 ]
21 (8 ↓ 3 → 4 ↓ 4 → 2)

$ raku misupa-random --cols=10 random
Matrix: [ 2 9 5 3 4 8 0 7 1 6 ][ 4 1 0 9 8 5 6 3 7 2 ][ 7 4 9 6 2 1 5 3 0 8 ]
41 ( 2 → 4 → 1 → 0 → 9 → 6 → 2 → 1 → 5 → 3 → 0 → 8 )
41 ( 2 → 4 → 1 → 0 → 9 → 6 → 2 → 1 → 5 → 3 → 0 → 8 )

$ raku misupa-random --cols=4 --rows=2 --arrows random
Matrix: [ 5 1 8 9 ][ 0 3 1 5 ]
14 (5 ↓ 0 → 3 → 1 → 5)

$ raku misupa-random --cols=4 --rows=2 --high=100 --arrows random
Matrix: [ 75 63 32 36 ][ 37 72 25 27 ]
222 (75 → 63 → 32 ↓ 25 → 27)

I skipped the «--arrow» argument in the second one, and the result (quite by chance) was a matrix where we have two solutions. We can run it again manually to see where the two paths diverge: 

$ raku misupa-direction --arrows "[ 2 9 5 3 4 8 0 7 1 6 ][ 4 1 0 9 8 5 6 3 7 2 ][ 7 4 9 6 2 1 5 3 0 8 ]"
41 (2 ↓ 4 → 1 → 0 ↓ 9 → 6 → 2 → 1 → 5 → 3 → 0 → 8)
41 (2 ↓ 4 → 1 → 0 → 9 ↓ 6 → 2 → 1 → 5 → 3 → 0 → 8)

Challenge #064.2: Word Break

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.

Example 1:
Input:

$S = "perlweeklychallenge"
@W = ("weekly", "challenge", "perl")

Output:

"perl", "weekly", "challenge"
Example 2:
Input:

$S = "perlandraku"
@W = ("python", "ruby", "haskell")

Output:

0 as none matching word found

I'll start with a program that satisfies the challenge, and discuss what may be missing afterwards.

The very first program is short (and thus, neat). But it does not satisfy the challenge, as it doesn't print 0 if it failed to find a match.

File: word-break-short 
sub MAIN ($string, *@words where @words.elems > 0)  # [1]
{
  for @words.permutations -> @candidate             # [2]
  {
    say @candidate.map({ "\"$_\"" }).join(", ") if @candidate.join eq $string;
  }                                                 # [3]
}

[1] The first argument is the string, and the rest are the words, gobbled up in an array with a slurpy *@. It allows for zero values, so we attach a where clause to ensure at least one argument (or word).

[2] For all possible permutations if the words,

[3] • print the words if they are identical to the string. The challenge wanted the words in quotes, as a comma separated list, so we oblige.

Running it: 

$ raku word-break-short perlweeklychallenge weekly challenge perl
"perl", "weekly", "challenge"

$ raku word-break-short perlandraku python ruby haskell

So a longer program is in order, with verbose mode added while we are at it:

File: word-break 
sub MAIN ($string, *@words where @words.elems > 0, :$verbose)
{
  my $match = 0;                                               # [1]
  for @words.permutations -> @candidate
  {
    my $wordlist = @candidate.map({ "\"$_\"" }).join(", ");
    say ": $wordlist" if $verbose;
    if @candidate.join eq $string
    {
      say $wordlist;
      $match++;                                               # [1a]
    }
  }
  say "0" unless $match;                                      # [1b]
}

[1] Keep track of the number word combination that match [1a], so that we can print the requested 0 if none were found [1b].

Running it: 

$ raku word-break perlweeklychallenge weekly challenge perl
"perl", "weekly", "challenge"

$ raku word-break perlandraku python ruby haskell
0

$ raku word-break --verbose perlweeklychallenge weekly challenge perl
: weekly | challenge | perl
: weekly | perl | challenge
: challenge | weekly | perl
: challenge | perl | weekly
: perl | weekly | challenge
"perl", "weekly", "challenge"
: perl | challenge | weekly

$ raku word-break --verbose perlandraku python ruby haskell
: "python", "ruby", "haskell"
: "python", "haskell", "ruby"
: "ruby", "python", "haskell"
: "ruby", "haskell", "python"
: "haskell", "python", "ruby"
: "haskell", "ruby", "python"
0

Note that the program allows several different matches, even without repeating the words: 

$ raku word-break abcXXabcXX abcXX abc XX
"abcXX", "abc", "XX"
"abc", "XX", "abcXX"


$ raku word-break --verbose abcXXabcXX abcXX abc XX
: "abcXX", "abc", "XX"
"abcXX", "abc", "XX"
: "abcXX", "XX", "abc"
: "abc", "abcXX", "XX"
: "abc", "XX", "abcXX"
"abc", "XX", "abcXX"
: "XX", "abcXX", "abc"
: "XX", "abc", "abcXX"

From «a» to «aaa»

The program I have presented assumes that every word in the word list appears in the string, and only one time. We should perhaps allow for words that are not there, or that appear more than once.

That is doable, by replacing permutations with combinations (and some additional code to handle the fallout).

The difference between permutations and combinations can be shown like this: 

> <a b c>.permutations
((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))

> <a b c>.combinations
(() (a) (b) (c) (a b) (a c) (b c) (a b c))

permutations is all about the different order of the values, whereas combinations is concerned about the presence of the value (and not the actual position). You'll get all the combinations, from zero elements up to all.

The empty list is a nuisance, but we can get rid of it by specifying the number of elements we want returned: 

> <a b c>.combinations(1..*)
((a) (b) (c) (a b) (a c) (b c) (a b c))

If the string is «aaa» we will not get any hits, as combinations doesn't give it. We can fix this duplicating the entire word list. E.g: 

> <a a a b b b c c c>.combinations(1..*)
((a) (a) (a) (b) (b) (b) (c) (c) (c) (a a) (a a) (a b) (a b) ...

The word «aaa» has length 3, so we can stop the combinations with more than 3 values (as they will be too long) by using 3 instead of the *. The next issue is the myriad of duplicates, as duplicates in gives duplicates out. We can get rid of them with unique using the eqv operator for comparison, as the default behaviour is only capable of detecting scalar value uquality. 

> .combinations(1..3).unique(:with(&[eqv]))
((aaa) (aa) (a) (aaa aa) (aaa a) (aa a) (a a) (aaa aa a) (aaa a a) \
 (aa a a) (a a a))

If we only want combinations that gives us «aaa», we can grep them: 

> .combinations(1..3).unique(:with(&[eqv])).grep({ .join eq 'aaa' })
((aaa) (aa a) (a a a))

It should be obvious that (a aa) is missing. That is caused by combinations itself, unfortunately (in this case). It does not like duplicates. The next example shows how bad it can get, with only one three-element list starting with a c: (c c c). The rest are variations of already shown lists. 

> <a a a b b b c c c>.combinations(1..3).unique(:with(&[eqv]))
((a) (b) (c) (a a) (a b) (a c) (b b) (b c) (c c) (a a a) (a a b) \
 (a a c) (a b b) (a b c) (a c c) (b b b) (b b c) (b c c) (c c c))

Slapping on permutations for sublist with more than one element (and another unique call to get rid of the duplicates this gives us) fixes this: 

> my @a = <aaa aa a a a>.combinations(1..3).unique(:with(&[eqv]))
    .map({ .elems > 1 ?? .permutations !! $_ })
[(aaa) (aa) (a) ((aaa aa) (aa aaa)) ((aaa a) (a aaa)) ((aa a) (a aa))
 ((a a) (a a)) ((aaa aa a) (aaa a aa) (aa aaa a) (aa a aaa) (a aaa aa)
 (a aa aaa)) ((aaa a a) (aaa a a) (a aaa a) (a a aaa) (a aaa a) (a a aaa))
 ((aa a a) (aa a a) (a aa a) (a a aa) (a aa a) (a a aa)) ((a a a) (a a a)
 (a a a) (a a a) (a a a) (a a a))]

The permutations replaced the previous single value, but as a list (shown by the parens around them, marked with red). That doesn't work for us, as we need a list of list. But we can get rid of the extra list level by prepending the flattening operator | to the permutations: 

>  my @a = .combinations(1..3).unique(:with(&[eqv]))
  .map({ .elems > 1 ?? | .permutations !! $_ }).unique(:with(&[eqv]))
[(aaa) (aa) (a) (aaa aa) (aa aaa) (aaa a) (a aaa) (aa a) (a aa) (a a)
 (aaa aa a) (aaa a aa) (aa aaa a) (aa a aaa) (a aaa aa) (a aa aaa)
 (aaa a a) (a aaa a) (a a aaa) (aa a a) (a aa a) (a a aa) (a a a)]

See docs.raku.org/routine/| for more information about the Flattening Operator |.

And with that, we are finally done with the algorithm...

The rest of the program is trivial by comparison:

File: word-break-turbo 
sub MAIN ($string, *@words where @words.elems > 0, :$verbose)
{
  my $string-length = $string.chars;                           # [1]
  my $shortest-word = @words>>.chars.min;                      # [2]

  say ": SL: $string-length SW: $shortest-word" if $verbose;
  
  my @words2 = (@words xx $string-length div $shortest-word)   # [3]
       .flat.sort({ $^a.chars <=> $^b.chars || $^a cmp $^b }); # [4]

  say ": Words: @words2[]" if $verbose;

  my $match = 0;
  for @words2.combinations(1..3).unique(:with(&[eqv]))
      .map({ .elems > 1 ?? | .permutations !! $_ }).unique(:with(&[eqv]))
        -> @candidate                                          # [5]
  {
    my $wordlist = @candidate.map({ "\"$_\"" }).join(", ");

    say ": Candidate: $wordlist" if $verbose;
    if @candidate.join eq $string
    {
      say $wordlist;
      $match++;
    }
  }
  say "0" unless $match;
}

[1] The length of the string.

[2] The length of the shortest word.

[3] We use the List Repetition Operator xx to get a suitable number of copies of the original list of words. The number is: [1] divided by [2], so that we can build up the string with duplicates of the shortest word. (E.g. (a a a) gives us «aaa».)

[4] Sort it by the number of characters, then alphabetically, to make the list look nicer.

[5] I have already explained this, thankfully...

See docs.raku.org/routine/xx for more information about the List Repetition Operator xx.

Running it, to see that we got it right: 

$ raku word-break-turbo aaa a aa aaa b bb bbb
"aaa"
"a", "aa"
"aa", "a"
"a", "a", "a"

We can get the string «aaa» in four ways, as expected.

The examples given in the challenge still work: 

$ raku word-break-turbo perlandraku python ruby haskell
0

$ raku word-break-turbo perlweeklychallenge weekly challenge perl
"perl", "weekly", "challenge"

Looking good.

And that's it.

Links
 About me
 Keyword Index
Raku Courses
 Beginning Raku (book)
 RSS Feed
 Code (zip)