Re: Matching permutations with regex

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
            ;
        
        }
[download]

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,
            ;
        
        }
[download]

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 );
            ;
[download]

Comment on Re: Matching permutations with regex Select or Download Code

Replies are listed 'Best First'.
Re^2: Matching permutations with regex by QM (Parson) on Nov 22, 2018 at 09:32 UTC
I had the regex terms backwards. And the `glob` was just for testing purposes -- I wasn't trying to generate permutations, but to match one permutation of a known string. -QM -- Quantum Mechanics: The dreams stuff is made of	[reply] [d/l]