http://qs321.pair.com?node_id=554383


in reply to possible combinations in sequence

An alternative:

use Algorithm::Loops qw( NestedLoops ); my $source = 'horse:cow:dog:cat'; my @parts = split(/:/, $source); my $iter = NestedLoops( [ [ 0..$#parts ], ( sub { [ $_+1..$#parts ] } ) x $#parts, ], { OnlyWhen => 1 }, ); my @s; print(join(':', map $parts[$_], @s), "\n") while @s = $iter->();

Update: Even better:

my $source = 'horse:cow:dog:cat'; my @parts = split(/:/, $source); for my $comb (1..2**@parts-1) { my $s = join ':', map $parts[$_], grep $comb & (1<<$_), 0..$#parts; print("$s\n"); }

Update: Neat, and even faster:

my $source = 'horse:cow:dog:cat'; local $_ = ":$source:"; my $parts = tr/:/:/ - 1; my $re = '(?{ "" })' . '(:[^:]*)(?=:)(?{ $^R . $^N })' . '(?:.*(:[^:]*)(?=:)(?{ $^R . $^N })' x ($parts-1) . ')?' x ($parts-1) . '(?{ push @rv, substr($^R, 1) })' . '(?!)'; { use re 'eval'; $re = qr/$re/; } local our @rv; /$re/; print "$_\n" foreach @rv;