|
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";
}
|
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";
}
| [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";
}
| [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",
);
(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;
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;
(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 <>;
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 <>;
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
There you have it!
Cheers,
Tom
| [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
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
|
s/^\-+// for @ARGV;
$func = eval 'sub { ' . join(' ',reverse @ARGV) . '$_[0] }';
Dave. | [reply]
[d/l] |
Re: Dynamic function chains?
by Roy Johnson (Monsignor) on Sep 15, 2004 at 16:08 UTC
|
#!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 <>;
Update: changed from \w to \S.
Caution: Contents may have been coded under pressure.
| [reply]
[d/l]
[select] |
|
|
