Task — Word break

You are given a string, $str, and list of words, @words. Write a script to return true or false depending on whether the given string can be segmented into a space separated sequence of one or more words from the given list.

Examples

Example 1
Input: $str = 'weeklychallenge', 
   @words = ("challenge", "weekly")
Output: true

Example 2
Input: $str = "perlrakuperl", 
   @words = ("raku", "perl")
Output: true

Example 3
Input: $str = "sonsanddaughters", 
   @words = ("sons", "sand", "daughters")
Output: false

Analysis

My initial thought was a two-liner:

$str ==~ s|$_|| for @words;
say qq[Output: ] $str ? 'true' : 'false';

That is, try deleting each word from $str and if it ends up empty the answer is true.

But that won't always work. Consider:

$str = 'starspan', @words = ('stars', 'star', 'span')

My code would delete 'stars', leaving 'pan', and 'pan' isn't in @words so it returns 'false'. But of course, there is a solution: first delete 'star' and then 'span'. So my revised solution considers all possible permutations of @words before giving a 'false' answer:

$str ==~ s|$_|| for (all permutations of @words);
say qq[Output: ] $str ? 'true' : 'false';

But it's still not right. Consider:

$str = 'rapelku', @words = ('perl', 'raku')

My solution up to this point would delete 'perl', leaving 'raku', and then delete 'raku' and return 'true'. But that doesn't meet the challenge definition: it couldn't result in a string 'perl raku' or 'raku perl'. So to fix that, the substitution has to be:

$str ==~ s|$_| | for (all permutations of @words);
say qq[Output: ] $str =~ m|^ *$| ? 'true' : 'false';

So now, deleting 'perl' will leave 'ra ku', and that won't match 'raku', so it will correctly return 'false'.

Try it 

Try running the script with any input:

Your $str =

example: eggsausage

Your @words =

example: eggs, sausage, egg

⤡

#!/usr/bin/perl

# Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

use v5.26;    # The Weekly Challenge - 2024-11-11
use utf8;     # Week 295 - task 1 - Word break
use warnings; # Peter Campbell Smith
binmode STDOUT, ':utf8';
use Algorithm::Combinatorics 'permutations';

word_break('onethreetwo', 'one', 'two', 'three');
word_break('sixfiveseven', 'four', 'five', 'six');
word_break('housessionwarduous', 'house', 'session', 'onward', 'arduous');
word_break('starspan', 'stars', 'star', 'span');
word_break('abcde', 'abc', 'cd', 'ab', 'bcde', 'e'); 
word_break('perakurl', 'perl', 'raku');
word_break('singsingsing', 'sing');

sub word_break {
    
    my ($str, @words, $iter, $next, $strx, $word);
    
    # initialise
    $str = shift;
    @words = @_;
    say qq[\nInput:  \$str = '$str', \@words = ('] . join(q[', '], @words) . q[')];

    # try the words in any order
    $iter = permutations(\@words);
    
    # loop over perms
    while ($next = $iter->next) {
        $strx = $str;
        
        # delete any occurrence of each word
        for $word (@$next) {
            $strx =~ s|$word| |;
            
            # solution exists if string is just spaces
            if ($strx =~ m|^ *$|) {
                say q[Output: true];
                return;
            }
        }
    }
    
    # no solution found
    say q[Output: false];
}

Output

Input:  $str = 'onethreetwo', 
   @words = ('one', 'two', 'three')
Output: true

Input:  $str = 'sixfiveseven', 
   @words = ('four', 'five', 'six')
Output: false

Input:  $str = 'housessionwarduous', 
   @words = ('house', 'session', 'onward', 'arduous')
Output: false

Input:  $str = 'starspan', 
   @words = ('stars', 'star', 'span')
Output: true

Input:  $str = 'abcde', 
   @words = ('abc', 'cd', 'ab', 'bcde', 'e')
Output: true

Input:  $str = 'perakurl', 
   @words = ('perl', 'raku')
Output: false

Input:  $str = 'singsingsing', 
   @words = ('sing')
Output: false