in reply to round-robin on varying sequence

Try this. It does it in 1 pass and creates only 1 temporary list as opposed to 2 half passes, 3 temporary lists (5 if you count the ranges inside the slices), and 2 temporary arrays, so I think it should work out to be faster.

I realise that I am omitting the lists used to create the hashes, but we both use one, so that balances out.

I've been trying to benchmark the two variations, but for reasons I haven't yet fathomed, I have yet to succeed. I'll update if I do.

sub remove_item { my ($i, %del) = (0); @del{@_} = undef; @items = grep { $i++ and !exists $del{$_} and $index -= ($i < $ind +ex) } @items; }

Update:I got the benchmarking to go.

#! perl -sw use strict; use Benchmark; my @i = qw( a b c x d e f a g h i j k l z m n o p q r t s t b u v w x +y z ); my @dups = qw( x a z t b ); my $index = 13; my @items = @i; sub remove_item { my %del = map { $_ => 1 } @_; my @part_1 = grep { !exists $del{$_} } @items[0..$index]; my @part_2 = grep { !exists $del{$_} } @items[$index+1..$#items]; $index = $#part_1; @items = (@part_1, @part_2); } sub remove_items { my ($i, %del) = (0); @del{@_} = undef; @items = grep { $i++ and !exists $del{$_} and $index -= ($i < $ind +ex) } @items; } print "@dups\n"; @items = @i; $index = 13; print "$index: $items[$index] : @items\n"; remove_item @dups; print "$index: $items[$index] : @items\n"; print $/ x 2; print "@dups\n"; @items = @i; $index=13; print "$index: $items[$index] : @items\n"; remove_item @dups; print "$index: $items[$index] : @items\n"; print $/ x 2; Benchmark::cmpthese( 1000, { mine => sub { @items = @i; $index=13; remove_items @dups; }, yours => sub { @items = @i; $index=13; remove_item @dups; }, }); __DATA__ # Output C:\test>195796 x a z t b 13: l : a b c x d e f a g h i j k l z m n o p q r t s t b u v w x y z 9: l : c d e f g h i j k l m n o p q r s u v w y x a z t b 13: l : a b c x d e f a g h i j k l z m n o p q r t s t b u v w x y z 9: l : c d e f g h i j k l m n o p q r s u v w y Benchmark: timing 1000 iterations of mine, yours... mine: 0 wallclock secs ( 0.51 usr + 0.00 sys = 0.51 CPU) @ 19 +60.78/s (n=1000) yours: 1 wallclock secs ( 0.64 usr + 0.00 sys = 0.64 CPU) @ 15 +62.50/s (n=1000) Rate yours mine yours 1562/s -- -20% mine 1961/s 25% -- C:\test>

I agree that this isn't the way I would tackle the overall problem, but I enjoyed playing with it!


Well It's better than the Abottoire, but Yorkshire!

Replies are listed 'Best First'.
Re: Re: round-robin on varying sequence
by dpuu (Chaplain) on Sep 07, 2002 at 21:32 UTC
    Yes, that's faster. But it doesn't work (consider not removing elements when $index=0). When I fixed youre code, it became slower -- though it may be possible to optimize it again:
    # the fix: @items = grep { my $keep = !exists $del{$_}; $i++; $index -= ($i < $index) unless $keep; $keep } @items; # the results Benchmark: timing 100000 iterations of BrowserUk, dpuu... BrowserUk: 13 wallclock secs (13.72 usr + 0.00 sys = 13.72 CPU) @ 72 +88.63/s (n=100000) dpuu: 10 wallclock secs ( 9.88 usr + 0.00 sys = 9.88 CPU) @ 10 +117.36/s (n=100000) Rate BrowserUk dpuu dpuu 10117/s 39% -- BrowserUk 7289/s -- -28%
    To provide fair comparison, here are the results I got running your original benchmark on my system (note the increased iteration count -- my system is 5X faster):
    Benchmark: timing 100000 iterations of BrowserUk, dpuu... BrowserUk: 10 wallclock secs ( 9.26 usr + 0.00 sys = 9.26 CPU) @ 10 +795.64/s (n=100000) dpuu: 10 wallclock secs ( 9.87 usr + 0.01 sys = 9.88 CPU) @ 10 +118.39/s (n=100000) Rate dpuu BrowserUk dpuu 10118/s -- -6% BrowserUk 10796/s 7% --
    in constrast to your +25/-20%. --Dave

    Update: The required optimization is this twisted expression:

    @items = grep { ++$i && !exists $del{$_} || ($index -= $i-1 <= $index) + && 0 } @items;

      Your right. My code, both my offered solution and my benchmark, are deficient. I'll keep my excuses and offer a revised solution, which I believe I have fully verified for compatability with the results of your original.

      The code below runs the remove_item(s) subs against the test data for all possible $index values and compares the results against each other (yours and mine). It also benchmarks each for all input criteria and the results are that my new version now averages a tad under a third (32.9%) faster across all situations.

      I hope you find this useful.

      sub remove_items { my ($i, %del) = (0); @del{@_} = undef; @items = grep { !exists $del{$_} and ++$i or $index -= ($i <= $index), 0 } @items; }

      The code for the full verification and the benchmark result (on my poor li'l 233MHz :) are below

        Yep, that seems to work now. But I had to stare at that expression for a while to understand why it is correct! It seems to be equivalent to:
        grep { exists $del{$_} ? ($index -= $i <= $index) && 0 : ++$i } @items
        Interestingly, the ?: version is as fast as yours; but the same logic written as if/else is much slower. Thx. --Dave

        Update: added my ?: simplification, then saw BrowserUk's reply.