Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: column replacement evaluation on dataset

by tybalt89 (Monsignor)
on May 24, 2023 at 23:13 UTC ( [id://11152405]=note: print w/replies, xml ) Need Help??


in reply to column replacement evaluation on dataset

Two choices:

If you are not worried about 'eval' :

#!/usr/bin/perl use strict; use warnings; $SIG{__WARN__} = sub { die $@ }; for my $row ( { a => 1, b => 2, c => 3, d => 4 }, { a => 0, b => 2, c => 3, d => 4 }, { a => 0, b => 2, c => 2, d => 4 }, { a => 0, b => 2, c => 2, d => 3 }, ) { use Data::Dump 'dd'; dd 'row', $row; for my $test ( qw( a>0 a>1 a>2 a>3 d<=3 c>2&d>2 ) ) { use Data::Dump 'dd'; dd { $test => evaluateRow($test, $row) }; } print "\n"; } sub evaluateRow { my ($test, $row) = @_; return eval( $test =~ s(\b[a-z]+\b)( $row->{$&} // '')gier ) ? 1 : 0 +; }

If you are worried about 'eval' :

#!/usr/bin/perl use strict; use warnings; $SIG{__WARN__} = sub { die $@ }; for my $row ( { a => 1, b => 2, c => 3, d => 4 }, { a => 0, b => 2, c => 3, d => 4 }, { a => 0, b => 2, c => 2, d => 4 }, { a => 0, b => 2, c => 2, d => 3 }, ) { use Data::Dump 'dd'; dd 'row', $row; for my $test ( qw( a>0 a>1 a>2 a>3 d<=3 c>2&d>2 ) ) { use Data::Dump 'dd'; dd { $test => nonevalRow($test, $row) }; } print "\n"; } my $dictionary; sub error { die $_, s/\G.*//sr =~ tr/\t/ /cr, "^ $_[0] !\n" } sub want { /\G$_[1]/gc ? shift : error pop } sub nonevalRow { ( local $_, $dictionary ) = @_; $_ .= "\n"; return want(expr(0), "\n", 'Incomplete Parse'); } sub expr { /\G\h+/gc; my $value = /\G\d+/gc ? "$&" : /\G[a-z]\w*/gci ? $dictionary->{"$&"} // error("undefined variable + '$&' ") : /\G\(/gc ? want expr(0), qr/\)/, 'Missing Right Paren' : /\G\-/gc ? - expr(7) : # unary minus /\G\+/gc ? + expr(7) : # unary plus error 'Operand Expected'; $value = /\G\h+/gc ? $value : $_[0] <= 6 && /\G\*\*/gcx ? $value ** expr(6) : $_[0] <= 5 && /\G \* /gcx ? $value * expr(6) : $_[0] <= 5 && /\G \/ /gcx ? $value / expr(6) : $_[0] <= 4 && /\G \+ /gcx ? $value + expr(5) : $_[0] <= 4 && /\G \- /gcx ? $value - expr(5) : $_[0] <= 3 && /\G <=/gcx ? $value <= expr(4) ? 1 : 0 : $_[0] <= 3 && /\G >=/gcx ? $value >= expr(4) ? 1 : 0 : $_[0] <= 3 && /\G < /gcx ? $value < expr(4) ? 1 : 0 : $_[0] <= 3 && /\G > /gcx ? $value > expr(4) ? 1 : 0 : $_[0] <= 2 && /\G ==/gcx ? $value == expr(3) ? 1 : 0 : $_[0] <= 2 && /\G !=/gcx ? $value != expr(3) ? 1 : 0 : $_[0] <= 1 && /\G & /gcx ? $value & expr(2) : $_[0] <= 0 && /\G \|/gcx ? $value | expr(1) : return $value while 1; }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://11152405]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others goofing around in the Monastery: (3)
As of 2024-04-25 08:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found