As a perl/matlab user, i often need 'any' and 'all' functions. Here is my attempt to write subroutines in perl.

(silly) example:
$res=any { $a<$b } \@vec1, \@vec2;
will return 1 if any two matching elements of the array satisfy the condition in the block.

$res=all { $a<$b } \@vec1, \@vec2;
will return 1 if all pairs satisfy the condition.

(I'm sure there's a better/shorter way to write it and welcome any suggestions)


Thanks for the replies. (+an alterternative below) 
sub any (&$@)
{
    my $code = shift;
    local $A = shift;
    local $B = shift;
    while ((local $a=pop(@$A)) && (local $b=pop(@$B)) ) {
      return 1 if &$code($a,$b);
    }
    return 0;
}

sub all(&$@)
  {
    my $code = shift;
    local $A = shift;
    local $B = shift;
    while ((local $a=pop(@$A)) && (local $b=pop(@$B)) ) {
      return 0 unless &$code($a,$b);
    }
    return 1;
  }

# Some testing:
my @ar1 = 1..10;
my @ar2 = 2..11;

my $res= any { $a<$b } \@ar1, \@ar2;
print "res=$res ==1?\n";

$res= any { $a>$b } \@ar1, \@ar2;
print "res=$res ==0?\n";

$res= any { $a==$b } \@ar1, \@ar2;
print "res=$res ==0?\n";

@ar2=1..10;
$res= all { $a==$b } \@ar1, \@ar2;
print "res=$res ==1?\n";

[download]

Replies are listed 'Best First'.
Quantum::Superpositions (was RE: any-all)
by merlyn (Sage) on Sep 02, 2000 at 08:55 UTC
    Thus spoke fundflow:
    (silly) example: 
    $res1=any { $a<$b } \@vec1, \@vec2;

    [download]
    will return 1 if any two matching elements of the array satisfy the condition in the block. 
    $res2=all { $a<$b } \@vec1, \@vec2;

    [download]
    will return 1 if all pairs satisfy the condition.
    And using Damian Conway's new Quantum::Superpositions module, you can write these as: 
    use Quantum::Superpositions;
$res1 = any(@vec1) < any(@vec2);
$res2 = all(@vec1) < all(@vec2);

    [download]
    All praise "The Damian".

    -- Randal L. Schwartz, Perl hacker

[reply]
[d/l]
[select]
[reply]
[reply]
RE: any-all
by Adam (Vicar) on Sep 02, 2000 at 02:07 UTC
    This is interesting, but beware... you are abusing sort's magic $a and $b variables. Even strict wouldn't complain, but you could have problems if the $code includes a sort.

    Also don't use local there, use my. Its faster, and there is no reason to use local in this scenario.

[reply]
      Hmm.

      I'll add 'local' declaration to it.

      Thers little chance that someone will use sort there but who knows?
[reply]
        Its worse then that... your tests do the same amount of abuse. Have you considered doing this with a closure? 
        sub getAnyAll
{
    my $code = shift;
    my $Any = sub {
        my @A = @{$_[0]}; # I like to dereference early, it makes
        my @B = @{$_[1]}; # the rest of the code more readable.
        while( @A and @B )
        {
            return 1 if &$code( pop(@A), pop(@B) )
        }
        return 0 
    };

    my $All = sub {
        my @A = @{$_[0]};
        my @B = @{$_[1]};
        while( @A and @B )
        {
            return 0 unless &$code( pop(@A), pop(@B) )
        }
        return 1 
    };

    return ( $Any, $All );
}

        [download]
        that's untested, but gives you the idea. By the way... poping arrays passed by reference might not be such a good idea either...
[reply]
[d/l]

Back to Cool Uses for Perl