Fwd: complex subroutine arguments - correction

[Eric Mooshagian]

Correction, I meant  ||, not && ...

exclude => (responsetime <= 200) || (responsetime >= 1200) where responsetime refers to an array.

Thanks,
Eric

Begin forwarded message:

From: Eric Mooshagian <ericmooshag...@gmail.com>
Date: February 3, 2010 10:45:37 PM EST
To: beginners@perl.org
Subject: complex subroutine arguments

Dear All,

I have a few subroutines that I use to first build an index for several arrays and then, for example, take the mean for the index values. When I build the index I can exclude particular values in an array as follows:

my $index = defindex(
        exclude => ["0",\...@accuracy],
        valueof => [...@subject,\...@side,\...@valence],
);

This works fine, but only only for excluding single values like (e.g, "0"). What I would really like to do is pass an argument that includes comparators, for example, in pseudo code:

exclude => (responsetime <= 200) && (responsetime >= 1200) where responsetime refers to an array.

However, I have no idea how to do this using named parameters. Is there a strategy for passing such arguments to a subroutine?

Thank you,
Eric

My current code:

use strict;
use warnings;
use List::Util qw(sum);
use List::MoreUtils qw(indexes each_arrayref);

#sample data

my @subject = qw(Sub1 Sub1 Sub1 Sub1 Sub1 Sub1 Sub1 Sub1 Sub2 Sub2 Sub2 Sub2 Sub2 Sub2 Sub2 Sub2); my @side= qw(left left left left right right right right left left left left right right right right); my @updown= qw(up down down up up up down down up up down down up up down down); my @valence= qw(minus plus minus plus minus plus minus plus minus plus minus plus minus plus minus plus); my @responsetime= (999.4,233.1,456.1,763.55,241.1,742.67,223.78,555.89,664.91,157.11,748.12 , 848.13, 253.14, 623.15, 635.16, 423.17);

my @accuracy= qw(1 1 0 1 0 1 1 0 1 0 1 0 0 1 1 1);


###########################################
my $index = defindex(
        exclude => ["0",\...@accuracy],
        valueof => [...@subject,\...@side,\...@valence],
);

my @index = @$index;

getmean(\...@index,\...@responsetime);

######################################
#Code for the module

#define the index
sub defindex {
        my $i;
        my $j;
        my @combined;
        my @meshed;
        my @index;
        my @match;
        my $exclude_input;
        my @values;
        my $input;
        my @exclude_values;

        #Get the input arguments
        my (%options) = @_;
        $input = $options{valueof};
        $exclude_input = $options{exclude};
        
        #Put the inputs into arrays
        @values = @$input if $input || die "No input to defindex!\n";
        @exclude_values = @$exclude_input if $exclude_input;
        
        #Number of arguments for the index
        my $num_args = (scalar(@values));
        
        for my $i (0..($num_args-1)) {
                push(@combined,$values[$i]);
        }

        @meshed = mesh(@combined);
        
        #Get the indices of the excluded values
        my $exclude = exclude(@exclude_values);
        my @exclude_indices = @$exclude;
        
        $j=0;
        while (@meshed) {
        my $match = grep /^$j$/, @exclude_indices;
                unless ($match) {
                        $index[$j]= join('', splice(@meshed,0,$num_args));
                        $j++;
                } else  {
                        my $ignore = join('', splice(@meshed,0,$num_args));
                        $index[$j]= "_";
                        $j++;
                }

                undef my(@match);
        }
        
        my @filtered_idx = grep($_ ne "_",@index);
        return \...@filtered_idx;

} #end defindex


sub exclude {
        my @values;
        my @match_idx;
        my @uniq_idx;
        my $i;
        my $j;

        while (@_) {
                my ($key, $values_ref)=(shift, shift);
                @values = @$values_ref;         
                for ($i = 0; $i < @values; $i++) {
                        if ($values[$i] eq $key) {
                                push(@match_idx, $i);    # save the index
                        }
                }
        }
        
        #find the unique elements
                my %seen = ();
                foreach $j (@match_idx) {
                        @{$_} = split /\s/, $j;
                        push(@uniq_idx, $j) unless $seen{$j}++;
                } #foreach $a
                
        return \...@uniq_idx;

} #end exclude

# From Shlomi Fish
sub get_combos_from_kv {
        my ($keys, $values) = @_;

        my %combos;
        
        foreach my $i (0..$#$keys) {
                my $key = $keys ->[$i];
                my $value = $values ->[$i];

                push (@{$combos{$key}},$value);
        }
        
        return \%combos;
}

# get the mean by index
sub getmean {
        my @ke...@{$_[0]};
        my @valu...@{$_[1]};
        
        my $combos = get_combos_from_kv(\...@keys,\...@values);
        my %combos = %$combos;          #dereferenced
                
        print "ID\tMeans\n";
        my $key;
        my $mean;
        
                foreach $key (sort keys %combos) {
                        my $mean = 
(sum(@{$combos{$key}}))/(scalar(@{$combos{$key}}));
                        printf "$key\t%.3f\n", $mean;
                }
                        
        
} #end of getmean

#borrowed from the List::MoreUtils Module by Tassilo von Parseval sub mesh (\...@\@;\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\...@\@\@ \...@\@\@) {

   my $max = -1;
   $max < $#$_  &&  ($max = $#$_)  for @_;

   map { my $ix = $_; map $_->[$ix], @_; } 0..$max;
}