in reply to How to replace greedy alternation?

Another way to find out the order:
my $test_string="1b22a3d3c";

my @ordered;
push(@ordered, $1) while $test_string =~ /([abcd])/cg;

pos($test_string) = 0; # reset m//cg offset

[download]

Update: Used capture as per ikegami's reply.

Update #2: This may be better:
my %seen;
my @order = grep { !$seen{$_}++ } $test_string =~ /([abcd])/g;

[download]

Replies are listed 'Best First'.
Re^2: How to replace greedy alternation?
by ikegami (Patriarch) on Jan 28, 2009 at 05:35 UTC

    $& imposes a needless slowdown on all regexp in your process that aren't already slowed down by captures. Use a capture instead.

    Your solution assumes none of the four patterns will match twice.

[reply]
[d/l]
Re^2: How to replace greedy alternation?
by Anonymous Monk on Jan 28, 2009 at 06:07 UTC
    TMTOW to find the order: 
    my $test = "1b22a3d3cccccccba866.afgg";

(my $ordered = $test) =~ tr/abcd//cd;

print $ordered, "\n";   # badcccccccbaa

    [download]
[reply]
[d/l]

      Indeed, getting rid of the clutter first, and then remove all but the first instance of each letter:

        sub reduc {
    my ($s) = @_ ;

    $s =~ tr/abcd//cd ;
    1 while $s =~ s/(.).*?\K\1+//g ;

    return $s ;
  } ;

  print reduc('1b22a7b3d3ccaacccbcccacccddcceqcc11oabepd'), "\n" ;
                     # badc
  print reduc('1b22w7b3d3ccsqcccbccc2cccddcceqcc11o9bepd'), "\n" ;
                     # bdc

      [download]
      I imagine a more cunning monk can improve the reduction step -- though the amount of work it does obviously depends on how many repeated letters need to be removed.

[reply]
[d/l]
        This may or may not be an improvement, but it only takes one pass through the regex: 
        #!/usr/bin/perl

use strict;
use warnings;

# If all four chars are present, returns them in first-seen order.
# If any of the four are not present, returns an empty string.
sub four_or_nothing {
    my $str = shift;

    my @in_order = ($str =~ m{ 
        ([abcd]) 
        .*?
        (?!\1)([abcd]) 
        .*?
        (?!\1|\2)([abcd]) 
        .*? 
        (?!\1|\2|\3)([abcd])
    }x);

    return join("", @in_order);
}

foreach my $case (
    '1b22a7b3d3ccaacbcaccddeqcc11oabepd',
    '1b22w7b3d3ccsqcbc2ccddeqcc11o9bepd',
) {
    printf qq{%s: "%s"\n}, $case, four_or_nothing($case);
}

__DATA__
1b22a7b3d3ccaacbcaccddeqcc11oabepd: "badc"
1b22w7b3d3ccsqcbc2ccddeqcc11o9bepd: ""

        [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom