Perl6: 解 work-break-ii

word-break-ii 是一則在 leetcode 上的題目。這題目對於實做搜尋引擎的人是有些實用的，並不是只是頭腦體操而己。

這題目內文及範列摘要如下：

Given a non-empty string s and a dictionary wordDict containing a list of non-empty words, add spaces in s to construct a sentence where each word is a valid dictionary word. Return all such possible sentences.

Example 1:
Input:
s = "catsanddog"
wordDict = ["cat", "cats", "and", "sand", "dog"]
Output:
[
  "cats and dog",
  "cat sand dog"
]

之所以說這題目有實際用途，是因為使用者在輸入英文時不一定會好好地把字與字用空白 隔開，此演算法可以為 tokenizer 的一部份。另外就是這演算法幾乎可直接用於進行中 文分詞。

輸入會是一個字串 $s，與一個陣列 @wordDict。陣列的內容是字典。解完後的答案也要是陣列。

sub word-break-ii (Str $s, @wordDict) returns Array

我所思得的做法大致上是由 $s 的尾端向前搜。首先針對字串 $s 的每一個位置找出 所有結尾於此的單字、逐個向前「接龍」。途中若接龍接完了，則表示找到一組解答。或 者途中被發現不可能接得下去，則要避免去進行無謂的深度搜尋。

題目要求所有的解答，所以需要將所有選項找完為止。選用的搜尋演算法為 BFS，但想來 DFS 應該也行。此外，於進行搜尋演算之前，先建出一個索引 @choices 。對於字串的 每個位置 $i，去記住所有於位置 $i 出現的單字列表。

事後重新想過一輪，覺得應該也可以由前方開始向後搜。或許日後再撰文筆記。

完整程式碼如下：

sub word-break-ii (Str $s, @wordDict) returns Array {
    my @choices = (1..$s.chars).map({ Array.new });
    loop (my $i = 0; $i < $s.chars; $i++) {
        my $sx = $s.substr(0, $i+1);
        for @wordDict.grep({ $sx.ends-with($_) }) -> $w {
            my $j = $i - $w.chars;
            if ($j == -1) || ($j >= 0 && @choices[$j].elems > 0) {
                @choices[$i].push($w);
            }
        }
    }

    my @stash;
    for @choices.tail.values -> $w {
        @stash.push( ($s.chars- 1 - $w.chars) => [$w] );
    }

    my @ans;
    while @stash.elems > 0 {
        my $it = @stash.shift();
        my $i = $it.key;
        my @ansx = $it.value;

        if ($i == -1) {
            @ans.push( @ansx.join(" ")  )
        } else {
            for @choices[$i].values -> $w {
                @stash.push( ($i - $w.chars)  => [$w].append(@ansx) );
            }
        }
    }

    return @ans;
}

leetcode 並不直接支援 perl6 ，因此無法簡單地去測試這段程式碼是否能過關。但至少以 下幾項範例的測試結果看來都是正確的：

say word-break-ii( "cat", ["cat", "cats", "and", "sand", "dog"]).perl;
say word-break-ii( "catsanddog", ["cat", "cats", "and", "sand", "dog"]).perl;
say word-break-ii( "pineapplepenapple", ["pen", "pine", "pineapple", "apple", "pie"] ).perl;
say word-break-ii( "catsandog", ["cats", "dog", "sand", "and", "cat"]).perl;