in reply to Re^2: combining array items to match a certain string
in thread combining array items to match a certain string

salutations, GrandFather,

the algorithm works well, but there is a small problem: if we try to segmentate:
cowboycatdogcat
it won't work, because it won't segmentate as, for example:
cow-boy-cat-dog-cat
because "cat" and "cat" are repeated morphemes, even if the array itself has the items "cowboy cow boy cat do dog cat" with "cat" repeated. how can we solve it? thank you in advance.

Replies are listed 'Best First'.
Re^4: combining array items to match a certain string
by GrandFather (Saint) on Dec 23, 2007 at 19:24 UTC

    Just adding an extra cat to the bag doesn't do the trick because the grep removes both cats when the first one is used. The code needs to be reworked so that we know how many of each part there are and so that they are removed one at a time. Consider:

    use strict; use warnings; my $target = "cowboycatdogcat"; my @partsList = qw(cow boy cat dog cat); my %partsLu; ++$partsLu{$_} for @partsList; search ($target, {%partsLu}, []); sub search { my ($target, $partsLu, $used) = @_; unless (length $target) { print join ("-", @$used), "\n"; return; } for my $part (keys %$partsLu) { next unless 0 == index $target, $part; my $remainder = substr $target, length $part; delete $partsLu->{$part} unless --$partsLu->{$part}; search ($remainder, {%$partsLu}, [@$used, $part]); } }

    Prints:

    cow-boy-cat-dog-cat

    Perl is environmentally friendly - it saves trees

      great!

      thank you, it worked.
      just for information, we are using a slightly modified version of the search code, which divides the words in commas and excludes similar outputs with doubled commas to divide the words, and, also, it puts the output in an @input array instead of printing it:
      sub search { my ($target, $partsLu, $used) = @_; unless (length $target) { $v = join (",", @$used); if (substr($v, 0, 1) eq "," or $v =~ /,,/) {} else { push(@input, join (",", @$used))}; return; } for my $part (keys %$partsLu) { next unless 0 == index $target, $part; my $remainder = substr $target, length $part; delete $partsLu->{$part} unless --$partsLu->{$part}; search ($remainder, {%$partsLu}, [@$used, $part]); } }