简体   繁体   中英

How can I avoid this use of "eval" in Perl?

I have code like this:

my @e = ( '($i,$j, $k,$l)',  '($i,$k, $j,$l)',  '($i,$l, $j,$k)',
          '($j,$k, $i,$l)',  '($j,$l, $i,$k)',  '($k,$l, $i,$j)'
        );
#
# Assign various sets of values to $i,$j,$k,$l
#
        foreach ( @e ) {
          my ($a,$b, $c,$d) = eval $_;
#
# Do calculations based on the values of $a,$b,$c,$d
#

It all works as I intended. But it feels clumsy to use eval like this. I feel there must be a better way of looping over those six permutations of the four values. I've tried various ways, but found nothing that worked, so I fell back on using eval.

I might go with subs.

my @e = (
   sub { @_[ 0,1, 2,3 ] },
   sub { @_[ 0,2, 1,3 ] },
   sub { @_[ 0,3, 1,2 ] },
   sub { @_[ 1,2, 0,3 ] },
   sub { @_[ 1,3, 0,2 ] },
   sub { @_[ 2,3, 0,1 ] },
);

...

for (@e) {
   my ( $a,$b, $c,$d ) = $_->($i, $j, $k, $l);
   ...
}

If the values were already in an array, the above simplifies to the following:

my @e = (
   [ 0,1, 2,3 ],
   [ 0,2, 1,3 ],
   [ 0,3, 1,2 ],
   [ 1,2, 0,3 ],
   [ 1,3, 0,2 ],
   [ 2,3, 0,1 ],
);

...

for (@e) {
   my ( $a,$b, $c,$d ) = @v[$_];
   ...
}

If we were dealing with more values, I'd consider a programmatic approach to generating the pair mutations, but I can't think of something simple enough to be worthwhile.

Do not reinvent the wheel. To loop through all permutations of an array, use any of the Perl modules written for this purpose, such as Algorithm::Permute (this is pointed out in the comment by Håkon Hægland).

For example:

use Algorithm::Permute;
use feature qw( say );

my $perm = new Algorithm::Permute([$i, $j, $k, $l]);

while (@permutation = $perm->next) {
   say join "\t", @permutation;
}

I do not know what exactly you want to achieve, but this might help you:

my @e = ( [$i,$j, $k,$l],  [$i,$k, $j,$l],  [$i,$l, $j,$k],
          [$j,$k, $i,$l],  [$j,$l, $i,$k],  [$k,$l, $i,$j]
        );

...

foreach (@e) {
    my ($a,$b, $c,$d) = @$_;
    ...

@e is now an array of array references. In the foreach loop $_ contains always one of the array references and @$_ dereferences it, resulting in the array.

This has a slightly different semantics because $i , $j , $k and $l will be evaluated only once when @e is assigned. This may be ok, but it can be a problem in your application.

If you need your original behaviour, you can do it using a slightly more complicated solution:

my @e = ( [\$i,\$j, \$k,\$l],  [\$i,\$k, \$j,\$l],  [\$i,\$l, \$j,\$k],
          [\$j,\$k, \$i,\$l],  [\$j,\$l, \$i,\$k],  [\$k,\$l, \$i,\$j]
        );

...

foreach (@e) {
    my ($a,$b, $c,$d) = map {$$_} @$_;
    ...

This means, @e holds references on the variables and they will be dereferenced by map {$$_} .

By the way, you should consider to make a sub out of the body of the foreach loop.

As I seem to be able to glean from the comments, is that the values of $i $j $k $l change during the foreach loop, and you need to use their current value. Which is the reason for the somewhat insane eval() solution.

Other people have suggested solutions that you have not accepted, so maybe this is what you need. As Donat says in his answer, you can make a sub of the foreach loop. This way you can run the foreach loop without the intermediate storage in the @e array. Of course, this would rely on altering global variables inside the sub, which generally is a bad thing.

do_foreach($i, $j, $k, $l);
do_foreach($i, $k, $j, $l);
do_foreach($i, $l, $j, $k);
...etc

sub do_foreach {
    my ($a, $b, $c, $d) = @_;
    ... do stuff
}

I suspect that your problems come from a poor design decision elsewhere in your code else that it might benefit from resolving. But it is hard to tell with the information given.

If you indeed want to process only those permutation referred in your sample code, then why not do it as following (square numbers for permutations)?

NOTE: please clarify you problem in more details and white minimal code sample which could be run (do not forget about use strict; use warnings -- two magic lines which assist to avoid many pitfalls)

use strict;
use warnings;
use feature 'say';

my($i,$j,$k,$l) = (1..4);

my @e = ( [$i,$j, $k,$l],  [$i,$k, $j,$l],  [$i,$l, $j,$k],
          [$j,$k, $i,$l],  [$j,$l, $i,$k],  [$k,$l, $i,$j]
        );
        
do_work($_) for @e;

sub do_work {
    my $aref = shift;
    
    my @square = map { $_*$_ } @{$aref};
    
    say join "\t", @square;
}

Output

1       4       9       16
1       9       4       16
1       16      4       9
4       9       1       16
4       16      1       9
9       16      1       4

I am not sure why you have only 6 permutations. Please study the following piece of code for compliance with your problem.

use strict;
use warnings;
use feature 'say';

my @array = qw/a b c d/;

my $result = mutate(\@array);

say join "\t", @{$_} for @{$result};

sub mutate {
    my $aref = shift;
    my @data = @{$aref};
    my @ret;
    
    for ( 1..scalar @data ) {
        my($c,@block) = @data;
        for ( 1..scalar @block ) {
            push @ret,[$c,@block];
            my $t = pop @block;
            unshift @block, $t;
        }
        @data = (@block,$c);
    }
    
    return \@ret;
}

Output

a       b       c       d
a       d       b       c
a       c       d       b
b       c       d       a
b       a       c       d
b       d       a       c
c       d       a       b
c       b       d       a
c       a       b       d
d       a       b       c
d       c       a       b
d       b       c       a

Other sample for my @array = qw/ab c de/;

a       b       c       d       e
a       e       b       c       d
a       d       e       b       c
a       c       d       e       b
b       c       d       e       a
b       a       c       d       e
b       e       a       c       d
b       d       e       a       c
c       d       e       a       b
c       b       d       e       a
c       a       b       d       e
c       e       a       b       d
d       e       a       b       c
d       c       e       a       b
d       b       c       e       a
d       a       b       c       e
e       a       b       c       d
e       d       a       b       c
e       c       d       a       b
e       b       c       d       a

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM