in reply to Re: Simple add and multiply subroutines
in thread Simple add and multiply subroutines

use List::Util qw( reduce );

my %ops = (
    add => sub { reduce { $a + $b } @_ },
    multiply => sub { reduce { $a * $b } @_ },
    # etc ...
);

my $op = shift or die "You must specify an operation followed by numbe
+rs.\n";
die "Non-numeric input.\n" if grep /\D/, @ARGV;
die "Invalid operation.\n" unless exists $ops{$op};

print "$op (@ARGV)= ". $ops->(@ARGV) . "\n";

[download]
Except, even that's too much repetition. 
use List::Util qw( reduce );

my %ops = (
    add => '+',
    multiply => '*',
    # etc ...
);

%ops = map {
    $_ => eval q(sub { reduce { $a ) . $ops{$_} . q( $b } @_ })
} keys %ops;

# And so forth.

[download]
Learn CPAN, young padawan. It is rare that someone hasn't already solved at least part of whatever it is you're looking at. Writing core Perl for more than 50% of a program is a sign of "I don't know CPAN," not brilliance.

Update: Fixed typo s/op/ops/ inside eval.

My criteria for good software:
  1. Does it work?
  2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

Replies are listed 'Best First'.
Re^3: Simple add and multiply subroutines
by NetWallah (Canon) on Apr 13, 2008 at 16:52 UTC
    Brilliant!(++) ( Except for a small typo: s/\$op/\$ops/ , inside the "eval").

    Education never stops.

    Update:Code Re-written incorporating dragonchild and mr_mischief's ideas: 

    #!/usr/bin/perl -w
use strict;
use List::Util qw( reduce );

# Definition Syntax: <verb> <operation>;   <operation> can be SIMPLE, 
+as in "+"
#   COMPLEX ops are defined by arrayref, and contain an array of <term
+s>.
#   <complex-op> = [<simple-op>,<pre-code>,<post-code>,<last-code>]  (
+all ,<*-code> is optional)
#   <*-code> can use pre-defined vars: ($a,$b)=@_[0,1];  $count=scalar
+ @_; $result=result


my %ops = ( qw|add + subtract - multiply * divide / power ** |,
             qw|greater > lesser < |,
                 #OP  ,Pre,Post,LAST
    xor      => ["&&",'$a=~$a'],
    all      => ["&&",'', '1 : 0'], 
    none     => ["||",'', '1 : 0', '!$result'], 
    any      => ["||",'', '1 : 0'],
    min      => ["<",'', '$a: $b'],
    max      => [">",'', '$a: $b'],
    mean     => ["+",'','','$result /=$count'],
    geomean  => ["*",'','','$result ** (1/$count)' ], 
    equal    => ["-",'','0:$b', '$result &&=1'], 
);

sub op_JIT_compile{
   my $op = shift;
   return if ref $ops{$op} eq 'CODE'; # Optimize for "Already compiled
+"
   my $opval = $ops{$op};
   # Complex case first - Handle "pre,post" op requirements.
   if (ref $opval eq 'ARRAY'){ # Allow for "pre", "post", and "last" o
+peratons 
         ##  Avoid "undef",s by passing in extra "?'s at end.      
      my ($realop,$pre,$post,$last) = (@$opval,('') x 4); 
      my $post_ternary = $post eq '' ? '' : qq|?$post|; 
      my $eval_this_sub = q|sub { ($a,$b) = my @F=@_; my $count=scalar
+ @F;| . 
                                      q|;my $result= reduce {|
                                                  . $pre . 
                                                   q|; $a | 
                                                  .  $realop  .
                                                  q| $b| 
                                                  . $post_ternary . 
                                                  q| } @F ;|
                                        . $last .
                                      q| }|;
      #print qq[$op = $eval_this_sub\n\tOPS(realop,pre,post,last;)=$re
+alop,$pre,$post,$last;\n];                            
       $ops{$op} = eval $eval_this_sub;
       return;
   }
   # This is the "simple" operator case ..
    $ops{$op} = eval q| sub { reduce { $a | .  $opval  . q| $b } @_ }|
+;
}
 

my $op = lc shift or die "You must specify an operation followed by nu
+mbers.\n";
die "Non-numeric input. $_\n" if grep /\[^-]?\D/, @ARGV;
die "Invalid operation ($op).\n" unless exists $ops{$op};
op_JIT_compile($op);
print "$op (@ARGV)= ". $ops{$op}->(@ARGV) . "\n";

    [download]
    Note that the eval used is a string eval, using only program variables (no user-supplied data). This eval can be performed ahead of time, or JIT (as programmed). The eval is performed only once per function-name. Specifically, it would NOT be performed every time the user provides input (if the program had an input loop).

    Thanks to dragonchild, and mr_mischief for making this interesting/educational.

         "As you get older three things happen. The first is your memory goes, and I can't remember the other two... " - Sir Norman Wisdom

[reply]
[d/l]

In Section Seekers of Perl Wisdom