Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

Mini-Tutorial: Working with Odd/Even Elements

by ikegami (Pope)
on Jul 09, 2009 at 17:48 UTC ( #778636=perlmeditation: print w/ replies, xml ) Need Help??

Filter out every second value of a list

Filter out every second value of a list, starting with the first

my $t = 1; grep { $t^=1 } LIST
my $t = 1; grep { $t = 1-$t } LIST
my $t = 1; grep { ++$t % 2 } LIST
map { $_%2 ? $ARRAY[$_] : () } 0..$#ARRAY

Example:

>perl -le"$t=1; print grep { $t^=1 } qw( a b c d e );" bd
>perl -le"$t=1; print grep { $t = 1-$t } qw( a b c d e );" bd
>perl -le"$t=1; print grep { ++$t % 2 } qw( a b c d e );" bd
>perl -le"@a = qw( a b c d e ); print map { $_%2 ? $a[$_] : () } 0..$# +a;" bd

Filter out every second value of a list, starting with the second

my $t = 0; grep { $t^=1 } LIST
my $t = 0; grep { $t=1-$t } LIST
my $t = 0; grep { ++$t % 2 } LIST
map { $_%2 ? () : $ARRAY[$_] } 0..$#ARRAY

Example:

>perl -le"$t=0; print grep { $t^=1 } qw( a b c d e );" ace
>perl -le"$t=1; print grep { $t = 1-$t } qw( a b c d e );" ace
>perl -le"$t=0; print grep { ++$t % 2 } qw( a b c d e );" bd
>perl -le"@a = qw( a b c d e ); print map { $_%2 ? () : $a[$_] } 0..$# +a;" ace

Transform a list based on odd/even-ness of index

my $t = 1; map { ($t^=1) ? EXPR_FOR_ODD : EXPR_FOR_EVEN } LIST
my $t = 1; map { ($t = 1-$t) ? EXPR_FOR_ODD : EXPR_FOR_EVEN } LIST
my $t = 1; map { (++$t % 2) ? EXPR_FOR_ODD : EXPR_FOR_EVEN } LIST
map { $_%2 ? EXPR_FOR_ODD : EXPR_FOR_EVEN } 0..$#ARRAY

Example:

>perl -le"$t=1; print map { ($t^=1) ? uc : lc } qw( a b c d e );" aBcDe
>perl -le"$t=1; print map { ($t=1-$t) ? uc : lc } qw( a b c d e );" aBcDe
>perl -le"$t=1; print map { (++$t % 2) ? uc : lc } qw( a b c d e );" aBcDe
>perl -le"@a = qw( a b c d e ); print map { $_%2 ? uc($a[$_]) : lc($a[ +$_]) } 0..$#a;" aBcDe

Usage note

None of the above are particularly self-explanatory, so a comment is in order if they their use if not obvious from the context.

Update: Added % solution as an alternative
Update: Added 1- solution as an alternative

Comment on Mini-Tutorial: Working with Odd/Even Elements
Select or Download Code
Re: Mini-Tutorial: Working with Odd/Even Elements
by lostjimmy (Chaplain) on Jul 09, 2009 at 18:08 UTC
    I love the simplicity and terseness of the grep filters. I don't think I ever would have thought of that. Of course, knowing my colleagues, this expression would cause some confusion for the maintainers...
Re: Mini-Tutorial: Working with Odd/Even Elements
by Anonymous Monk on Jul 09, 2009 at 18:44 UTC
    my $t = 0; grep { $t^=1 } LIST
    using the XOR operator in XOR-equal is bordering on line-noise. This seems to have a low likely hood of being understood on the first pass by the next person to see it. (This next person had to go check perlop). That said, I'm totally using it the next time I play golf.

    Mixing both of your two forms we get these nice options:

    my $t = 0; #even elements #my $t= 1; #odd elements grep { $t++ % 2 } LIST
    my $t = 0; map { $t++ %2 ? $_ : () } LIST
    Am I wrong to expect people to be more familiar with '%' than with '^'?

      my $t = 0; grep { $t^=1 } LIST
      ... That said, I'm totally using it the next time I play golf.
      No. In golf, the --$| magical flip-flop is shorter. For example:
      grep--$|,LIST

Re: Mini-Tutorial: Working with Odd/Even Elements
by moritz (Cardinal) on Jul 09, 2009 at 18:45 UTC
    my $t = 1; grep { $t^=1 } LIST

    If you're on perl-5.10 or newer, you can also use a state variable inside the block, and thus not "tainting" the outer scope:

    use 5.010; say grep { state $t = 1; $t ^= 1} <a b c d>; # prints: bd
      $ perl -wE 'say grep {state $t ^= 1} qw[a b c d]' ac $
        oops...
        $ perl -de 1 ... DB<1> use 5.010; sub a { grep { state $t ^= 1 } @_ } DB<2> x a(1..5) 0 1 1 3 2 5 DB<3> x a(1..5) 0 2 1 4
      That's not very useful outside of one-liners since it'll remember the state from the previous loop pass or function call.
Re: Mini-Tutorial: Working with Odd/Even Elements
by spazm (Monk) on Jul 09, 2009 at 18:46 UTC
    my $t = 0; grep { $t^=1 } LIST
    using the XOR operator in XOR-equal is bordering on line-noise. This seems to have a low likely hood of being understood on the first pass by the next person to see it. (This next person had to go check perlop). That said, I'm totally using it the next time I play golf.

    Mixing both of your two forms we get these nice options:

    my $t = 0; #even elements #my $t= 1; #odd elements grep { $t++ % 2 } LIST
    my $t = 0; map { $t++ %2 ? $_ : () } LIST
    Am I wrong to expect people to be more familiar with '%' than with '^'?
Re: Mini-Tutorial: Working with Odd/Even Elements
by duelafn (Priest) on Jul 09, 2009 at 23:19 UTC

    One of my favorite subs:

    sub map_pairs(&@) { my $f = shift; my @res; no strict 'refs'; no warnings 'once'; my $caller = caller; local(*{$caller."::a"}) = \my $a; local(*{$caller."::b"}) = \my $b; push @res, $f->($a,$b) while ($a, $b) = splice @_, 0, 2; return @res; }

    gives:

    map_pairs { $a } qw/a b c d/; # ac map_pairs { $b } qw/a b c d/; # bd map_pairs { uc($a),lc($b) } qw/a b c d/; # AbCd

    But, yes, this very much crosses the line out of "one-liner" land

    Good Day,
        Dean

      I was surprised by the lack of such a function in List::MoreUtils recently. There is natatime, but it returns an iterator rather than using a callback.

      I wonder how much speed you'd gain by replacing $f->($a,$b) with &$f. Another advanced feature for the collection!

      It would be a nice bonus if you $a and $b were aliases to the args like with map.

      sub map_pairs(&@) { my $cb = shift; my $caller = caller(); my $ap = do { no strict 'refs'; \*{$caller.'::a'} }; my $bp = do { no strict 'refs'; \*{$caller.'::b'} }; local *$ap; local *$bp; my @res; while (@_) { *$ap = \shift; *$bp = \shift; push @res, &$cb; } return @res; }

        Actually, I like passing the arguments so that I can do things like this: (sum doesn't know to look at $a and $b)

        use List::Util qw/sum/; say for map_pairs \&sum, 1..10;

        I do like the aliasing bonus, but it seems to not work on hash keys:

        use YAML; my @array = ( foo_name => " Bob Smiley ", foo_age => " 32" ); map_pairs { $a =~ s/foo_//; s/^\s+//, s/\s+$// for $b; } @array; print Dump \@array; my %hash = ( foo_name => " Bob Smiley ", foo_age => " 32" ); map_pairs { $a =~ s/foo_//; s/^\s+//, s/\s+$// for $b; } %hash; print Dump \%hash;

        outputs

        --- - name - Bob Smiley - age - 32 --- foo_age: 32 foo_name: Bob Smiley

        Good Day,
            Dean

        Too golfy or arcane? (fixed now)
        sub map_pairs(&@) { my $fn = shift; my $pkg = $main::{caller().'::'}; map { @{$pkg}{qw(a b)} = \(@_[0,1]); $fn->(shift, shift); } (0..$#_/2); } package Smarter; our($a, $b) = qw(orig value); my @arr = qw(a b c d); print main::map_pairs {$_[0] = uc($a); print "[$a $_[1]]\n"; $a} @arr; print "\n"; print "Now @arr\n"; print "\n$a $b\n";
        I like being able to avoid sym refs and all the globbage. The interesting thing to note is that I seem to get a magical localization of my variables.

        Caution: Contents may have been coded under pressure.
      local(*{$caller."::a"}) = \my $a; local(*{$caller."::b"}) = \my $b;
      Does this technique depend on the default "automatic declaration" of $a and $b as package-vars? (it's meant for sort {...})

      In other words: using $c for map_triples wouldn't be as easy..(?)

      Cheers Rolf

        It will be a problem if you are running under strict. However, if the caller sets up $c as a package variable it will work.

        sub map_triples(&@) { my $f = shift; my @res; no strict 'refs'; my $caller = caller; local(*{$caller."::a"}) = \my $a; local(*{$caller."::b"}) = \my $b; local(*{$caller."::c"}) = \my $c; push @res, $f->($a,$b,$c) while ($a, $b, $c) = splice @_, 0, 3; return @res; } use 5.010; use warnings; use strict; our $c; say for map_triples { $a + $b + $c } 1..12;

        Good Day,
            Dean

      Update: figured it out (simulthanks to Ikegami). Gotta reference the right package. Corrected solution:
      sub map_pairs(&@) { my $fn = shift; my $pkg = caller; map { my $idx = $_ * 2; no strict 'refs'; my ($a, $b) = local (${$pkg.'::a'}, ${$pkg.'::b'}) = (@_[$idx,$idx+1]); $fn->($a, $b); } (0..$#_/2); }
      Previous, erroneous solution follows.

      I think you made this harder than it needs to be. Isn't this equivalent?

      sub map_pairs(&@) { my $fn = shift; map { my $idx = $_ * 2; local ($a, $b) = @_[$idx,$idx+1]; $fn->($a, $b); } (0..$#_/2); }

      Caution: Contents may have been coded under pressure.

        That won't work if the callback was compiled into a different package than map_pairs. The parent's code fixes this (assuming the callback is always compiled into the same package as the caller).

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://778636]
Approved by Corion
Front-paged by Arunbear
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (7)
As of 2014-08-23 15:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (174 votes), past polls