in reply to Re^2: Simple Matching
in thread Simple Matching

It's only getting compiled once, just as if it was outside of eval, so what's the problem?

If you wanted to reuse the counter, make a sub if it: 

$counters{$_} = eval "sub { \$_[0] =~ tr/\Q$_\E// }";

[download]

Replies are listed 'Best First'.
Re^4: Simple Matching
by rnroot (Initiate) on Sep 28, 2009 at 06:11 UTC
    Thanks again, Putting the eval into Method 2 below is (much) slower than any other match (as noted by BrowserUK). Brute force (Method 3) is significantly faster than either 1 or 2, but does not let me loop through an array to check match counts. I have tried "grep -c" within perl and it works, but is not as fast as brute force. Is there a faster way? After 15+ years of Perl I have not needed to worry about cutting edge optimizing (in Perl) ... ergo my ignorance. Thanks for help again. 
    my $flush = 0;
my @suits = ( "D", "S", "C", "H" );
my $long_hand = ("2H 3D 4C 5S 5H)";

# Method 1:  43 microseconds
#    (My initial code ... seemed slow ... ergo benchmark)
foreach ( @suits ) {
    @m = ( $long_hand =~ m/$_/g );
    $flush = 1 if  ($#m eq 4 );
}

# Method 2: 126 microseconds (definitely bottleneck)
foreach ( @suits ) {
    my $count = ( eval "\$long_hand =~ tr/$_//" );
    $flush = 1 if  ($count eq 5 );
}

#Method 3: accounts for only 3(!) microseconds of code
# Ugly but functional for very few patterns to check
# BUT what if I had 10k patterns to check
$flush = 1 if ( $long_hand =~ tr/D// eq 5);
$flush = 1 if ( $long_hand =~ tr/S// eq 5);
$flush = 1 if ( $long_hand =~ tr/C// eq 5);
$flush = 1 if ( $long_hand =~ tr/H// eq 5);

    [download]
[reply]
[d/l]
      How does this compare speed-wise: 
      >perl -wMstrict -le
"my @suits = qw(D S C H);
 my $suits = join '', @suits;
 my $flush = qr{ ([$suits]) (?: [^$suits]+ \1){4} }xms;
 print $_, $_ =~ $flush ? ' flush' : ' nope'
   for '2H 3D 4C 5S 5H', '1H 2H 3H 4H 5H';
"
2H 3D 4C 5S 5H nope
1H 2H 3H 4H 5H flush

      [download]
      Update: Might be faster if possessive: 
      >perl -wMstrict -le
"my @suits = qw(D S C H);
 my $suits = join '', @suits;
 my $flush = qr{ ([$suits]) (?: (?> [^$suits]+) \1){4} }xms;
 print $_, $_ =~ $flush ? ' flush' : ' nope'
   for '2H 3D 4C 5S 5H', '1H 2H 3H 4H 5H';
"
2H 3D 4C 5S 5H nope
1H 2H 3H 4H 5H flush

      [download]
      5.10 has possessive modifier: 
      >perl -wMstrict -le
"my @suits = qw(D S C H);
 my $suits = join '', @suits;
 my $flush = qr{ ([$suits]) (?: [^$suits]++ \1){4} }xms;
 print $_, $_ =~ $flush ? ' flush' : ' nope'
   for '2H 3D 4C 5S 5H', '1H 2H 3H 4H 5H';
"
2H 3D 4C 5S 5H nope
1H 2H 3H 4H 5H flush

      [download]
      Bugfix: Changed  (?> [^$suits])+ to  (?> [^$suits]+) per ikegami Re^6: Simple Matching.
[reply]
[d/l]
[select]
        (?>[^$suits]) is the same as [^$suits]. The + should be inside the (?>).

        Captures are slow, so it would be faster to build a regex without captures I also generalised some of the matching. Input validation is not a goal here. 

        m{
    ^
    .
    (?: D (?: . .D ){4}
    |   S (?: . .S ){4}
    |   C (?: . .C ){4}
    |   H (?: . .H ){4}
    )
    \z
}xs;

        [download]

        Or maybe even 

        m{
    ^
    .
    (?: D..D..D..D..D
    |   S..S..S..S..S
    |   C..C..C..C..C
    |   H..H..H..H..H
    )
    \z
}xs;

        [download]
        built it manually here, but it can be built dynamically.

        Update: That last regex pattern gives me an idea: 

        my $masked = $_ & "\x00\xFF \x00\xFF \x00\xFF \x00\xFF \x00\xFF";
(  $masked eq "\x00D \x00D \x00D \x00D \x00D"
|| $masked eq "\x00S \x00S \x00S \x00S \x00S"
|| $masked eq "\x00C \x00C \x00C \x00C \x00C"
|| $masked eq "\x00H \x00H \x00H \x00H \x00H"
)

        [download]

        Of course, if the input format was a number, it would be even faster: 

        sub build {
    return
        ( $_[0] << (16*4 + 2*5 ) ) +
        ( $_[1] << (16*4 + 2*4 ) ) +
        ( $_[2] << (16*3 + 2*4 ) ) +
        ( $_[3] << (16*3 + 2*3 ) ) +
        ( $_[4] << (16*2 + 2*3 ) ) +
        ( $_[5] << (16*2 + 2*2 ) ) +
        ( $_[6] << (16*1 + 2*2 ) ) +
        ( $_[7] << (16*1 + 2*1 ) ) +
        ( $_[8] << (16*0 + 2*1 ) ) +
        ( $_[9] << (16*0 + 2*0 ) );
}

use constant {
    SUITS_MASK => build(0,3, 0,3, 0,3, 0,3, 0,3),
    ALL_D      => build(0,0, 0,0, 0,0, 0,0, 0,0),
    ALL_S      => build(0,1, 0,1, 0,1, 0,1, 0,1),
    ALL_C      => build(0,2, 0,2, 0,2, 0,2, 0,2),
    ALL_H      => build(0,3, 0,3, 0,3, 0,3, 0,3),
};

my $suits = $_ & SUITS_MASK;
(  $suits == ALL_D
|| $suits == ALL_S
|| $suits == ALL_C
|| $suits == ALL_H
)

        [download]
[reply]
[d/l]
[select]

      It is a simple fact of life that if you can hard code a lookup table, it will be faster than building it on-the-fly, or choosing one conditionally.

      If you need best possible speed--and that is a big if--then the choice to store 10,000 lookup tables is a speed -v- memory trade-off that you might choose to make.

      If youreally need absolute best speed, then C or assembler are your only choices. But the surprising thing about Perl--the redeeming feature for all it faults--is that it rarely make you make that choice. Beyond the realms of either highly algorithmically complex; or no-alternative, cpu intensive--Perl's quirks, irregularities and non-orthogonality's are tailored--by experience and practice, over orthodoxy and dogma--to produce best possible results in best possible time.....

      with the proviso--and it is a big one--that you are not afraid to consider perfectionism, passe; correctness. contrived; elitism, irrelevant; and practicality paramount. Beyond the rarefied atmospheres of academic and dogmatic perfection, code that works for the common case. today; is far preferable to either perfection tomorrow.

      Strive for perfection; but don't exclude a solution today, for perfection tomorrow. Tomorrow rarely (I'm pragmatic; "never" is not a part of my vocabulary :) ever comes.

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]

In Section Seekers of Perl Wisdom