#!/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
;
}
####
#!/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,
;
}
##
##
my $re =
', \w*(\w)\w*
(?:
(?{ $occ{ $^N } ++ })
|
(?{ $occ{ $^N } -- })
(*F)
)
(??{ ( grep $_ > $times, values %occ ) ? "(*F)" : "" })
' x ( $times * length $string );
;