If @x can become huge (by generating all combinations with glob), another variant is - to try to match against multicated string, joined (or prepended) by some separator, which "blocks" backtracking to previous strings. In this case, all combinations will be tested, unless to use FAIL somewhere in a middle of search. In my opinion, this approach is not truly 'regex-like', because here a simple hash for counting occurrences is used.
#!/usr/bin/perl
# https://www.perlmonks.org/?node_id=1226058
use warnings;
use re 'eval';
$\ = $/;
for my $tc (
[ 'abc', 1 ],
[ 'abc', 2 ],
[ 'abc', 3 ],
){
my( $string, $times ) = @{ $tc };
$_ = ( ',' . reverse $string ) x ( $times * length $string );
print;
my @permutations;
my %occ;
my $re =
', \w*(\w)\w*
(?:
(?{ $occ{ $^N } ++ })
|
(?{ $occ{ $^N } -- })
(*F)
)
' x ( $times * length $string );
;
/
$re
$
(??{ ( grep $_ != $times, values %occ ) ? '(*F)' : '' })
(?{ push @permutations,
join '',
grep length,
$1, $2, $3,
$4, $5, $6,
$7, $8, $9,
})
(*F)
/x;
print for
@permutations,
~~ @permutations
;
}
Almost the same code, except that I don't use '$1, $2, $3, $4, ...', but rather use a variable for saving current permutation string:
#!/usr/bin/perl
# https://www.perlmonks.org/?node_id=1226058
use warnings;
use re 'eval';
$\ = $/;
for my $tc (
[ 'abc', 1 ],
[ 'abc', 2 ],
[ 'abc', 3 ],
){
my( $string, $times ) = @{ $tc };
$_ = ( ',' . reverse $string ) x ( $times * length $string );
print;
my @permutations;
my %occ;
my $current = '';
my $re =
', \w*(\w)\w*
(?:
(?{ $occ{ $^N } ++ })
(?{ $current .= $^N })
|
(?{ $occ{ $^N } -- })
(?{ chop $current })
(*F)
)
' x ( $times * length $string );
;
/
$re
$
(??{ ( grep $_ != $times, values %occ ) ? '(*F)' : '' })
(?{ push @permutations,
$current,
})
(*F)
/x;
print for
@permutations,
~~ @permutations,
;
}
And if I won't to check if my current generating permutation is bad, I include that test '
(??{ ( grep $_ > $times, values %occ ) ? "(*F)" : "" })' inside '$re'. Maybe in some cases it can save searching time:
my $re =
', \w*(\w)\w*
(?:
(?{ $occ{ $^N } ++ })
|
(?{ $occ{ $^N } -- })
(*F)
)
(??{ ( grep $_ > $times, values %occ ) ? "(*F)" : "" })
' x ( $times * length $string );
;