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'.

Another good show of recursion where it does the job every efficiently. Keep up the great work.

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];
}

14 lines of code

Output from script

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