keymon has asked for the wisdom of the Perl Monks concerning the following question:

Monks, I am writing a script that will perform a (specified on the command line) set of one or more operations on an input stream of rows of numbers (except the first column, which is the row ID). For example: if the input is
1 0 0 0 1 1 1 2 2
2 1 2 0 1 0 0 0 1
3 2 3 4 5 6 0 1 2
and the operation is "power" (2^x), then the output would be:
1 1 1 1 2 2 2 4 4
2 2 4 1 2 1 1 1 2
3 4 8 16 32 64 1 2 4
Operations can be "power", "log2", "loge", "log10", "round", etc. They can be specified multiple times too.
I would like to dynamically build a subroutine that called the specified subs in the right order.

Here is what I came up with; is there a better (more efficient, cuter, whatever) way to do this? (What am I thinking; obviously there are better ways to do this, after all, this is Perl!!) 

use Getopt::Long;
 
sub power { return exp( $_[0] ) }
sub log2  { return log( $_[0] )/log(2.0) }
sub loge  { return log( $_[0] ) }
sub log10 { return log( $_[0] )/log(10.0) }
sub round {
        my $n = shift;
        return int($n + 0.5) if ($n >= 0);
        return int($n - 0.5);
}
sub trunc { return int($_[0]) }
sub f1    { return sprintf "%.1f", $_[0] }
sub f2    { return sprintf "%.2f", $_[0] }
sub f3    { return sprintf "%.3f", $_[0] }
sub f4    { return sprintf "%.4f", $_[0] }
sub f5    { return sprintf "%.5f", $_[0] }
 
sub closure {
    my($sub, $arg) = @_;
    return sub { $sub->( &$arg ) }
}
 
my %opts = map { $_ => 1 }  qw( power log2 loge log10 round trunc f1 f
+2 f3 f4 f5 );
 
my $func = sub { return shift };
 
while (my $arg = pop(@ARGV) ) {
        $arg =~ s/^\-+//;
        if (defined ($opts{$arg})) {
                $func = closure( eval '\&' . $arg , $func );
        } else {
                print STDERR "Unknown arg: $arg\n";
        }
}
 
while (<STDIN> ) {
        chop;
        my @in = split;
        print shift(@in), " ";
        print join(" ", map { $func->($_) } @in), "\n";
}

[download]

Replies are listed 'Best First'.
Re: Dynamic function chains?
by broquaint (Abbot) on Sep 15, 2004 at 12:48 UTC
    Just put the functions in a package and call them dynamically e.g 
    {
  package My::Maths;

  sub power { return exp( $_[0] ) }
  sub log2  { return log( $_[0] )/log(2.0) }
  sub loge  { return log( $_[0] ) }
  sub log10 { return log( $_[0] )/log(10.0) }
  sub round {
          my $n = shift;
          return int($n + 0.5) if ($n >= 0);
          return int($n - 0.5);
  }
  sub trunc { return int($_[0]) }
  sub f1    { return sprintf "%.1f", $_[0] }
  sub f2    { return sprintf "%.2f", $_[0] }
  sub f3    { return sprintf "%.3f", $_[0] }
  sub f4    { return sprintf "%.4f", $_[0] }
  sub f5    { return sprintf "%.5f", $_[0] }
}

my $name = shift
  or die "Usage: $0 FUNC\n";

die "$0: unknown function method\n"
  unless my $func = My::Maths->can($method);
 
while (<STDIN> ) {
        chomp;
        my @in = split;
        print shift(@in), " ";
        print join(" ", map &$func($_), @in), "\n";
}

    [download]
    HTH

    _________
    broquaint

[reply]
[d/l]
Re: Dynamic function chains?
by Eimi Metamorphoumai (Deacon) on Sep 15, 2004 at 13:13 UTC
    First of all, exp isn't the same as 2^x (it's e^x). (Found that when I tested the code.) 
    #!/usr/bin/perl
use strict;
use warnings;

my %opts = (
    power => sub { exp( $_[0] )},
    log2  => sub { log( $_[0] )/log(2.0) },
    loge  => sub { log( $_[0] ) },
    log10 => sub { log( $_[0] )/log(10.0) },
    round => sub { int($_[0] + ($_[0] <=> 0)*0.5) },
    trunc => sub { int $_[0] },
    f1    => sub { sprintf "%.1f", $_[0] },
    f2    => sub { sprintf "%.2f", $_[0] },
    f3    => sub { sprintf "%.3f", $_[0] },
    f4    => sub { sprintf "%.4f", $_[0] },
    f5    => sub { sprintf "%.5f", $_[0] },
);                                                              

my $func = sub {$_[0]};
for my $arg (reverse @ARGV){
    if (defined $opts{$arg}){
        my $localfunc = $func;
        $func = sub {$opts{$arg}->($localfunc->($_[0]))};
    } else {
        print STDERR "Unknown arg: $arg\n";
    }
}

while (<> ) {
        chomp;
        my @in = split;
        print shift(@in), " ";
        print join(" ", map { $func->($_) } @in), "\n";
}

    [download]
[reply]
[d/l]
[select]
      First of all, exp isn't the same as 2^x (it's e^x). (Found that when I tested the code.)

      My bad! I was trying to keep the output simple.

      I like the usage of a hash to store the subs, and also the cute (and much less verbose) &round.
      Thanks!

[reply]
Re: Dynamic function chains?
by tmoertel (Chaplain) on Sep 15, 2004 at 16:52 UTC
    I would take a functional-programming approach. First, I would put the desired mathematical operators in a hash that maps each operator's command-line form to the function that performs the operation: 
      sub printN($)   { my $format = shift; sub { sprintf $format, @_ } }

  my %functions = (
      -power => sub { exp( $_[0] )},
      -log2  => sub { log( $_[0] )/log(2.0) },
      -loge  => sub { log( $_[0] ) },
      -log10 => sub { log( $_[0] )/log(10.0) },
      -round => sub { int($_[0] + ($_[0] <=> 0)*0.5) },
      -trunc => sub { int $_[0] },
      -f1    => printN "%.1f",
      -f2    => printN "%.2f",
      -f3    => printN "%.3f",
      -f4    => printN "%.4f",
      -f5    => printN "%.5f",
  );

    [download]
    (I used a helper function to build the printf functions for me.)

    Second, I would parse the command line to extract, in order, the operators to be performed: 

      my @func_pipeline = grep {$_} map {$functions{"$_"}} @ARGV;
  @ARGV = grep {!$functions{"$_"}} @ARGV;

    [download]

    At this point, @func_pipeline contains the functions corresponding to the operators we want to apply. I would then use function composition to glue the functions together, to result in a single function that performs the entire pipeline: 

      sub compose($$) { my ($f, $g) = @_;   sub { $f->( $g->(@_) ) }    }
  sub id          { @_ }; # identity function

  my $composite_fn = reduce {compose($a,$b)} @func_pipeline, \&id;

    [download]
    (The above uses the ever-handy reduce from List::Util.)

    Finally, I would apply the composite function to each word of input, line by line: 

      print join ' ', map $composite_fn->($_), split while <>;

    [download]
    That's it. Putting it all together into a program, gives this: 
      #!/usr/bin/perl -l

  use strict;
  use List::Util qw( reduce );

  sub printN($)   { my $format = shift; sub { sprintf $format, @_ } }
  sub compose($$) { my ($f, $g) = @_;   sub { $f->( $g->(@_) ) }    }
  sub id          { @_ }; # identity function

  my %functions = (
      -power => sub { exp( $_[0] )},
      -log2  => sub { log( $_[0] )/log(2.0) },
      -loge  => sub { log( $_[0] ) },
      -log10 => sub { log( $_[0] )/log(10.0) },
      -round => sub { int($_[0] + ($_[0] <=> 0)*0.5) },
      -trunc => sub { int $_[0] },
      -f1    => printN "%.1f",
      -f2    => printN "%.2f",
      -f3    => printN "%.3f",
      -f4    => printN "%.4f",
      -f5    => printN "%.5f",
  );   

  my @func_pipeline = grep {$_} map {$functions{"$_"}} @ARGV;
  @ARGV = grep {!$functions{"$_"}} @ARGV;
  my $composite_fn = reduce {compose($a,$b)} @func_pipeline, \&id;
  print join ' ', map $composite_fn->($_), split while <>;

    [download]
    As an example, let's print (with 4-digit precision) the result of "powering" the numbers 1 2 3: 
      $ echo 1 2 3 | ./calc-pipeline -f4 -power
  2.7183 7.3891 20.0855

    [download]
    There you have it!

    Cheers,
    Tom

    Tom Moertel : Blog / Talks / LectroTest / PXSL / Coffee / Movie Rating Decoder

[reply]
[d/l]
[select]
Re: Dynamic function chains?
by BrowserUk (Patriarch) on Sep 15, 2004 at 13:16 UTC

    Your function outputs don't quite match your expected results, but I left them for you to sort out (apart from round which was a bit verbose :). 

    #! perl -lw
use strict;

my %funcs = (
    power => sub { return exp( $_[0] ) },
    log2  => sub { return log( $_[0] )/log(2.0) },
    loge  => sub { return log( $_[0] ) },
    log10 => sub { return log( $_[0] )/log(10.0) },
    round => sub { return int( $_[0] + $_[ 0 ] < 0 ? -0.5 : 0.5 ) },
    trunc => sub { return int($_[0]) },
    f1    => sub { return sprintf "%.1f", $_[0] },
    f2    => sub { return sprintf "%.2f", $_[0] },
    f3    => sub { return sprintf "%.3f", $_[0] },
    f4    => sub { return sprintf "%.4f", $_[0] },
    f5    => sub { return sprintf "%.5f", $_[0] },
);

my @ops = map{ 
    m[^[-+](.*)] && exists $funcs{ $1 }
        ? $funcs{ $1 }
        : ()
}  @ARGV;
undef @ARGV;

while (<> ) {
    chop;
    my( $row, @in ) = split;
    print "$row ", join " ", map{ 
        my $val = $_;
        $val = $_->( $val ) for @ops;
        $val;
    } @in;
}

__END__
P:\test>perl 391141.pl -power
1 0 0 0 1 1 1 2 2
1 1 1 1 2.71828182845905 2.71828182845905 2.71828182845905 7.389056098
+93065 7.38905609893065
2 1 2 0 1 0 0 0 1
2 2.71828182845905 7.38905609893065 1 2.71828182845905 1 1 1 2.7182818
+2845905
3 2 3 4 5 6 0 1 2
3 7.38905609893065 20.0855369231877 54.5981500331442 148.413159102577 
+403.428793492735 1 2.71828182845905 7.38905609893065
^Z

P:\test>perl 391141.pl -power -trunc
1 0 0 0 1 1 1 2 2
1 1 1 1 2 2 2 7 7
2 1 2 0 1 0 0 0 1
2 2 7 1 2 1 1 1 2
3 2 3 4 5 6 0 1 2
3 7 20 54 148 403 1 2 7
^Z

    [download]
    Examine what is said, not who speaks.
    "Efficiency is intelligent laziness." -David Dunham
    "Think for yourself!" - Abigail
    "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
[reply]
[d/l]
      The output I showed should have been for "power2" (or "exp2").. my mistake.

      In your solution, you are not constructing a composite subroutine, but instead iterating over all of them in the loop:         $val = $_->( $val ) for @ops;

      Wouldn't a composite subroutine be more efficient?

      There's a trivial mistake in your solution in that it performs the operations in the reverse order (which is fixed by using 

      reverse @ARGV
      in the map statement).

      I was aiming to keep the order, because then if you want:
      f(g(h(x)))
      you can say:
      funcs.pl -f -g -h

[reply]
[d/l]
        Wouldn't a composite subroutine be more efficient?

        Generally, evaling at runtime is quite expensive. You'd have to benchmark to say for sure. I guess it depends upon how many time your going to call the composite sub. If your processing large datasets, the cost of eval may become insignificant.

        I usally avoid evaling stuff input from the command line, though ]broquaint]'s use of package->can() seems to avoid most of the risks that usually entails. I liked his solution a lot.

        Yes, I screwed up the order. reverse is the easiest solution.

        Examine what is said, not who speaks.
        "Efficiency is intelligent laziness." -David Dunham
        "Think for yourself!" - Abigail
        "Memory, processor, disk in that order on the hardware side. Algorithm, algorithm, algorithm on the code side." - tachyon
[reply]
Re: Dynamic function chains?
by dave_the_m (Monsignor) on Sep 15, 2004 at 12:38 UTC
    How about 
    s/^\-+// for @ARGV;
$func = eval 'sub { ' . join(' ',reverse @ARGV) . '$_[0] }';

    [download]

    Dave.

[reply]
[d/l]
Re: Dynamic function chains?
by Roy Johnson (Monsignor) on Sep 15, 2004 at 16:08 UTC
    Just another take: 
    #!perl
use strict;
# BrowserUK's function defs
my %funcs = (
    power => sub { return exp( $_[0] ) },
    log2  => sub { return log( $_[0] )/log(2.0) },
    loge  => sub { return log( $_[0] ) },
    log10 => sub { return log( $_[0] )/log(10.0) },
    round => sub { return int( $_[0] + $_[ 0 ] < 0 ? -0.5 : 0.5 ) },
    trunc => sub { return int($_[0]) },
    f1    => sub { return sprintf "%.1f", $_[0] },
    f2    => sub { return sprintf "%.2f", $_[0] },
    f3    => sub { return sprintf "%.3f", $_[0] },
    f4    => sub { return sprintf "%.4f", $_[0] },
    f5    => sub { return sprintf "%.5f", $_[0] },
);

my $A = shift;
my $chosen = $funcs{$A} or die "No such func $A\n";
s/(?<=\s)(\S+)/$chosen->($1)/ge, print while <>;

    [download]
    Update: changed from \w to \S.
    Caution: Contents may have been coded under pressure.
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom