use Quantum::Superpositions; 
...
if($_->{Action} eq any( qw(GetAll Make MakeOnly) )) {
    $_->{Suppress} = 1;
}
[download]

_________
broquaint

my %actions = (
  GetAll => 0x001,
  Make => 0x010,
  MakeOnly => 0x100,
  ...
);

$_->{Suppress} = 0x001 
  if ($_->{Action} & ( $actions{GetAll} | $actions{Make} | $actions{Ma
+keOnly} );
[download]

~Particle *accelerates*

I fail to see how that's supposed to work. $_ -> {Action} is either "GetAll","Make" or "MakeOnly", and not some bitpattern.

But using a hash leads to one solution:

my %match = map {$_ => 1} qw /GetAll Make MakeOnly/;
...
$_ -> {Suppress} = 1 if $match {$_ -> {Action}};
[download]

Abigail

for (@tabs) {
    $_->{Suppress} ||= $_->{Action} =~ /^(GetAll|Make|MakeOnly)$/;
}
[download]

Alan

my %defaults = (GetAll => 1, Make => 1, MakeOnly => 1);
for (@tabs) {
  $_->{Suppress} = $defaults{$_->{Action}} if exists $defaults{$_->{Ac
+tion}};
}
[download]

$_->{Suppress} = $defaults{NewAction} if $->{Suppress} == $defaults{Ol
+dAction}
[download]

10000 trials of abigail (781.550ms total), 78us/trial
10000 trials of broquaint (92.195s total), 9.220ms/trial
10000 trials of esper (676.783ms total), 67us/trial
10000 trials of ferrency (548.917ms total), 54us/trial
10000 trials of george_sherston1 (655.936ms total), 65us/trial
10000 trials of george_sherston2 (852.485ms total), 85us/trial
10000 trials of george_sherston3 (712.300ms total), 71us/trial
10000 trials of samtregar (1.303s total), 130us/trial
[download]

#! /usr/bin/perl -w
use strict;
use lib '/home/httpd/lib';

use Benchmark::Timer;
use Quantum::Superpositions; 

my %methods = (
    george_sherston1 => \&m1,
    george_sherston2 => \&m2,
    george_sherston3 => \&m3,
    broquaint => \&m4,
    abigail => \&m5,
    ferrency => \&m6,
    esper => \&m7,
    samtregar => \&m8,
);

my @tabs = (
    {
        Action => 'GetAll',
        Suppress => 0,
    },
    {
        Action => 'Make',
        Suppress => 0,
    },
    {
        Action => 'MakeOnly',
        Suppress => 0,
    },
    {
        Action => 'foo',
        Suppress => 0,
    },
    {
        Action => 'bar',
        Suppress => 0,
    },
    {
        Action => 'baz',
        Suppress => 0,
    },
    {
        Action => 'goom',
        Suppress => 0,
    },
    {
        Action => 'gomp',
        Suppress => 0,
    },
);

for my $m (sort keys %methods) {
    my $t = Benchmark::Timer->new(skip => 1);
    for(0 .. 10000) {
        $t->start($m);
        $methods{$m}->();
        $t->stop;
    }
    $t->report;
}
        
sub m1 {
    for (@tabs) {
        if (
            $_->{Action} eq 'GetAll' or
            $_->{Action} eq 'Make' or 
            $_->{Action} eq 'MakeOnly'
        ) {
            $_->{Suppress} = 1;
        }
    }
}
    
sub m2 {
    for my $hash (@tabs) {
        if (grep {$hash->{Action} eq $_} qw/
            GetAll
            Make
            MakeOnly
        /) {
            $hash->{Suppress} = 1;
        }
    }
}
    
sub m3 {
    for (@tabs) {
        if ($_->{Action} =~ /(^GetAll$)|(^Make$)|(MakeOnly$)/) {
            $_->{Suppress} = 1;
        }
    }
}
    
sub m4 {
    for (@tabs) {
        if($_->{Action} eq any( qw(GetAll Make MakeOnly) )) {
            $_->{Suppress} = 1;
        }
    }
}
    
sub m5 {
    my %match = map {$_ => 1} qw /GetAll Make MakeOnly/;
    for (@tabs) {
        $_-> {Suppress} = 1 if $match {$_-> {Action}};
    }
}
    
sub m6 {
    for (@tabs) {
        $_->{Suppress} ||= $_->{Action} =~ /^(GetAll|Make|MakeOnly)$/;
    }
}
    
sub m7 {
    my %defaults = (GetAll => 1, Make => 1, MakeOnly => 1);
    for (@tabs) {
      $_->{Suppress} = $defaults{$_->{Action}} if exists $defaults{$_-
+>{Action}};
    }
}
    
sub m8 {
    my %suppress = map { $_ => 1 } qw(GetAll Make MakeOnly);
    for (@tabs) {
       $_->{Suppress} = 1 if exists $suppress{$_};
    }
}
[download]

Your benchmark is flawed. m5, m7 and m8 use a hash so that you can do part of the work only *once*. Setting up the hash each time you are doing tests defeats its purpose.

Of course, if all you are doing in your program is performing this test once, for the 8 entries in @tabs you shouldn't bother. Optimizing is only useful for hot spots in your code, things you either do many times, or things that are very costly. Trivial checks that will only be done 8 times in your code aren't worth to be optimized.

Abigail

Yes, you're quite right - if I were going to use those conditionals more than a few times in any given script I'd set up the hashes once only and spread the overhead. This was more about satisfying my curiosity than about optimisation - in the spirit of that curiosity, here are the results with any hashes involved set once only:

10000 trials of abigail (494.672ms total), 49us/trial
10000 trials of broquaint (93.071s total), 9.307ms/trial
10000 trials of esper (533.643ms total), 53us/trial
10000 trials of ferrency (547.466ms total), 54us/trial
10000 trials of george_sherston1 (654.023ms total), 65us/trial
10000 trials of george_sherston2 (837.320ms total), 83us/trial
10000 trials of george_sherston3 (715.834ms total), 71us/trial
10000 trials of samtregar (1.022s total), 102us/trial
[download]



§ George Sherston

... where Action in ("GetAll", "Make", "MakeOnly" )
[download]

if( in( $Action, "GetAll", "Make", "MakeOnly" ) ) {
... }
sub in {
...
}
[download]

Your in looks like it might have a for loop inside it. Here's one way to write that up.

sub in {
  my ($coderef)= shift(@_);
  my ($match)= shift(@_);
  my (@vals)= @_;

  for ( @vals ) { $coderef->($match) if /$match/ }
}
[download]

Notice I had to toss in an extra parameter- a reference to a subroutine.

Another way to write this up is


sub in {
  my ($coderef)= shift(@_);
  my ($match)= shift(@_);
  my %dispatch = map { $_ => $coderef } @_;

  if ( exists $dispatch{$match} ) {
    $dispatch->($match);
  }
}
[download]

Shrug, it's another way, I guess.

What do you think?
I think that I can't look at your sub 'in' without either thinking, "Hey, this has a for loop inside it", or "Hey, this probably uses a dispatch table." :)

#!/usr/bin/perl

use strict;
use warnings;

sub in_dispatch {
  my ($coderef)= shift(@_);
  my ($match)= shift(@_);
  my %dispatch = map { $_ => $coderef } @_;

  if ( exists $dispatch{$match} ) {
    $dispatch{$match}->($match);
  }
}

sub in_array {
  my ($coderef)= shift(@_);
  my ($match)= shift(@_);
  my (@vals)= @_;

  for ( @vals ) { $coderef->($match) if /$match/ }
}

my $code = sub { my ($pal)= shift(@_);
                 print "Hello $pal!\n" ;
               };

my @pals = qw(Dick Jane Spot Samuel);
in_dispatch($code, 'George', @pals);  # no output
in_dispatch($code, 'Jane', @pals);    # Hello Jane!

in_list($code, 'Dick', @pals);      # Hello Dick!
in_list($code, 'Rover', @pals);     # no output
[download]

But before you go using this for any life support systems, make sure you don't mind how both subs handle 'Sam' as the item to test ;)

Update Added #! line

blyman
setenv EXINIT 'set noai ts=2'

my %suppress = map { $_ => 1 } qw(GetAll Make MakeOnly);
for (@tabs) {
   $_->{Suppress} = 1 if exists $suppress{$_};
}
[download]

It's easy to read, fast and short.

-sam

use Switch;
 
   switch ($val) {
 
       case 1          { print "number 1" }
       case "a"        { print "string a" }
       case [1..10,42] { print "number in list" }
       case (@array)   { print "number in list" }
       case /\w+/      { print "pattern" }
       case qr/\w+/    { print "pattern" }
       case (%hash)    { print "entry in hash" }
       case (\%hash)   { print "entry in hash" }
       case (\&sub)    { print "arg to subroutine" }
       else            { print "previous case not true" }
    }
[download]