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.

Example 2 below shows that words may be repeated.

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

The basis of my solution is to try to match each of the @words against the start of $string.

If there is a match, the word plus a space is appended to a provisional true answer. If the whole string has not been matched, a new $string is formed from the unmatched part of $string and the process is continued recursively.

If there is no unmatched part, ie the string has been fully split into words, the result is output as true.

If at any point the remaining string does not match any of the words, a false answer is returned.

This is a complete rewrite as my submitted solution was based on a misunderstanding of the requirement.

Try it 

#!/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 Encode;

my (@words, $true);

word_break('onethreetwo', ['three', 'one', 'two']);
word_break('onethreetwoone', ['four', 'three', 'one', 'two']);
word_break('starspan', ['stars', 'star', 'span']);
word_break('singsingsing', ['sing']);
word_break('paper', 
   ['p', 'pa', 'pap' ,'pape', 'aper', 'per', 'er', 'r']);

sub word_break {
    
    my ($string);
    
    # initialise
    ($string, @words) = ($_[0], @{$_[1]});
    say qq[\nInput:  \$string = '$string', \@words = ('] . 
        join(q[', '], @words) . q[')];
    
    # start recursion
    $true = 0;
    wb($string, ''); 
    say qq[Output: false] unless $true;
}

sub wb {
    
    my ($s, $w, $explain);
    
    # initialise
    return if $true;
    ($s, $explain) = @_;
    
    # loop over words
    for $w (@words) {
        
        # is $w at the start of the remaining $string?
        if ($s =~ m|^$w\s*(.*)|) {
            
            # yes - add to explanation
            $explain .= qq[$w ];
            
            # there is still more of $string
            if ($1) {
                wb($1, $explain . '');
                
            # no, all matched from @words
            } else {
                say qq[Output: true - '] . 
                    substr($explain, 0, -1) . q['];
                $true = 1;
                return;
            }
        }
    }
}

22 lines of code

Output from script

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

Input:  $string = 'onethreetwoone', @words = ('four', 'three', 'one',
   'two')
Output: true - 'one three two one'

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

Input:  $string = 'singsingsing', @words = ('sing')
Output: true - 'sing sing sing'

Input:  $string = 'paper', @words = ('p', 'pa', 'pap', 'pape', 'aper',
   'per', 'er', 'r')
Output: true - 'p aper'