in reply to reduce like iterators

Hi LanX,

map{} will pass on undef's, but grep{} needs undef to tell whether something passed the filter. But you can stack any number of maps and greps together, which is how I came up with a workaround for it, using two maps and a grep.

The first map{}, reading from the bottom up, simply marks duplicates in-a-row (as opposed to any dupes at all) by changing them to 'aardvark'. Undef's and zeroes go through without problem. The second map{} changes actual undefined elements to the text 'undef'. Change these as suits your algorithm. The grep{} is where the duplicates/aardvarks are finally removed.

It seems to work, accommodating undefined values, while still being simple enough to use in a one-liner, and uses array refs so it doesn't pass whole lists back and forth.

use strict;

my @orig = ( qw(a a b b c 0 c d d u u), 
            (undef, undef, 'blink', 'blink'), 
             qw(0 0 v v w w a a a b b b c c c)
            );
my @list;
nodupes (\@orig, \@list);
print join ' ', @list, "\n";

sub nodupes {
    my ($ar1, $ar2) = @_;
    my $p;
    push @$ar2, grep{$_ ne 'aardvark'} 
                map{defined $_ ? $_ : 'undef'} 
                map { $p ne $_ ? $p = $_ : 'aardvark' } 
         @$ar1;
}
__END__

Prints --> a b c 0 c d u undef blink 0 v w a b c

[download]
And the one-liner -- actually broken up for easier viewing: 
perl -e "@list = grep{$_ ne 'aardvark'} 
                 map{defined $_ ? $_ : 'undef'} 
                 map{$p ne $_ ? $p = $_ : 'aardvark'} 
        (qw(a a b b c 0 c u u), (undef, undef), qw(0 0 v v w w)); 
print join ' ', @list;"

Prints --> a b c 0 c u undef 0 v w

[download]

I hope you find this interesting/useful.

--marmot

UPDATE: I was thinking about this some more, and realized I had made it waaaay too complicated. The nodupes() below pretty much is a one-liner, and accomodates 0, "0", and undef just fine. And nodupes() can be used inline with other maps and greps. In the end, the grep was the only thing needed.

use strict;
sub nodupes {
    my $p;
    return grep{ $_ ne '~~' } map { $p ne $_ ? $p = $_ : '~~'  } @_;
}

my @orig = ( qw(a a b b c 0 c d d u u),
            (undef, undef, 'blink', 'blink'),
             qw(0 0 v v "0" "0" "0" w w a a a b b b c c c)
            );

my @new = nodupes @orig;
print join ' ', @new, "\n";

__END__
Prints --> a b c 0 c d u  blink 0 v "0" w a b c
                        ^^
     There's an undef between these two spaces.

[download]

Replies are listed 'Best First'.
Re^2: reduce like iterators
by Anonymous Monk on Jan 12, 2011 at 15:52 UTC
    Any reason not to just do: 
    my $p;
my @new = grep { $p = $_ or 1 if $p ne $_ } @orig;

    [download]
    ?
[reply]
[d/l]
      Ummm....because I didn't think of that? :-) Thanks! You just expanded my understanding of what you can do with grep.

      --marmot

[reply]
      Try @orig starting with undef.

      Also see the OP for the "semi-predicate problem" discussion.

      If this seems too theoretical for you, consider the practical task to do of a run-length encoding of sparsely set arrays. (undef is a real value)

      Cheers Rolf

[reply]
[d/l]
[select]

        Good point about the initial value -- I forgot about that.

        It can be specially handled decently, though, something like:

        my @new = my $p = shift @orig;
push @new, grep { $p = $_ or 1 if $p ne $_ } @orig;

        [download]
[reply]
[d/l]

        Shoot! I totally get the semi-predicate problem, and you stated the problem clearly in the OP, but I thought I had a brainwave and rewrote my UPDATED code, which had actually accounted for the problem.

        So anyway, I re-read the entire thread and I sort of get why you'd want, say, a $^PRE special variable. But it is so trivial, I don't see why you'd bother. You are simply dealing with a list in pairwise fashion, using a previous value to evaluate a current value. Eliminating adjacent dupes is trivial...

            @new = map { $p ne $_ ? $p = $_ : () } @orig;

        [download]
        except for an initial undefined value, but only because $p is initially undefined. So you define it and it works. And it's easy to remember. 
            $p = 'supercalifragilistic';
    @new = map  { $p ne $_ ? $p = $_ : () } @orig;

        [download]
        You could define a uniq_adj function... 
            use strict;
    sub uniq_adj {
        my $p = 'supercalifragilistic';
        return map  { $p ne $_ ? $p = $_ : () } @_;
    }

    my @orig = (undef, undef, qw(a a b b c 0 c d d u u 0 0 "0" "0" '0'
+ '0'));
    my @new = uniq_adj @orig;

    print "'", join ("' '", @new), "'\n";
    __END__
    Prints --> '' 'a' 'b' 'c' '0' 'c' 'd' 'u' '0' '"0"' ''0''

        [download]

        I printed with single quotes to show where undef's are being printed. Note that 0, "0", and '0' are preserved. It's very generalizable. I predefined $p, but isn't that less work than having Perl do it through a built-in? I read through the entire thread again and it seems to fit the bill. Is this kind of what you're looking for?

        Regardless, cheers!

        --marmot
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom