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
| [reply] [d/l] [select] |
great!
thank you, it worked.
| [reply] |
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]);
}
}
| [reply] [d/l] |