Re: cull

In order to avoid expansion of array indices list, I wrote ...

use List::MoreUtils qw( firstidx );

sub cull_parv (&\@)
{
  my ( $test , $array ) = @_;

  my @culled;
  while ( -1 < ( my $i = firstidx { &$test } @$array ) )
  {
    push @culled , splice @$array , $i , 1 ;
  }
  return @culled;
}
[download]

...which seems to be speedier when the size of the array increases ...

#!/usr/local/bin/perl

use warnings; use strict;

use Benchmark qw( timethese cmpthese );

use List::MoreUtils qw( firstidx );

sub cull_tlm (&\@) ;
sub cull_parv (&\@) ;

my ( $res , $cmp , @x1 , @x2 , @y1 , @y2 );

for my $end  ( 5 , 10 , 20 , 50 , 100 , 1000 , 5000 , 1_000_000 )
{
  @x2 = @x1 = ( 0 .. $end );

  print "End is: $end\n";

  $res =
    timethese
    ( -15
    , {
        'tlm'  => sub { @y1 = cull_tlm  { $_ > $end -3 } @x1 }
      , 'parv' => sub { @y2 = cull_parv { $_ > $end -3 } @x2 }
      }
    );
  cmpthese( $res );

  print "\n";
}

exit;

sub cull_tlm (&\@) {
  my ( $test, $array ) = @_;
  my @culled;
  for my $i ( reverse 0 .. $#$array ) {
    local $_ = $array->[ $i ];
    unshift @culled, splice @$array, $i, 1 if $test->();
  }
  return @culled;
}

sub cull_parv (&\@)
{
  my ( $test , $array ) = @_;

  my @culled;
  while ( -1 < ( my $i = firstidx { &$test } @$array ) )
  {
    push @culled , splice @$array , $i , 1 ;
  }
  return @culled;
}
__END__
End is: 5
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 15 wallclock secs (15.73 usr +  0.04 sys = 15.77 CPU) @ 41
+632.52/s (n=656688)
       tlm: 16 wallclock secs (15.68 usr +  0.01 sys = 15.69 CPU) @ 41
+435.60/s (n=650021)
        Rate  tlm parv
tlm  41436/s   --  -0%
parv 41633/s   0%   --

End is: 10
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 17 wallclock secs (15.72 usr +  0.02 sys = 15.74 CPU) @ 30
+794.20/s (n=484768)
       tlm: 17 wallclock secs (15.70 usr +  0.02 sys = 15.71 CPU) @ 25
+612.16/s (n=402391)
        Rate  tlm parv
tlm  25612/s   -- -17%
parv 30794/s  20%   --

End is: 20
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 16 wallclock secs (15.77 usr +  0.04 sys = 15.80 CPU) @ 20
+255.38/s (n=320130)
       tlm: 16 wallclock secs (15.70 usr +  0.02 sys = 15.72 CPU) @ 14
+563.18/s (n=228915)
        Rate  tlm parv
tlm  14563/s   -- -28%
parv 20255/s  39%   --

End is: 50
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 16 wallclock secs (15.72 usr +  0.03 sys = 15.75 CPU) @ 10
+012.32/s (n=157694)
       tlm: 16 wallclock secs (15.72 usr +  0.02 sys = 15.73 CPU) @ 62
+97.10/s (n=99081)
        Rate  tlm parv
tlm   6297/s   -- -37%
parv 10012/s  59%   --

End is: 100
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 16 wallclock secs (15.77 usr +  0.04 sys = 15.81 CPU) @ 54
+28.55/s (n=85839)
       tlm: 16 wallclock secs (15.72 usr +  0.04 sys = 15.76 CPU) @ 32
+51.97/s (n=51244)
       Rate  tlm parv
tlm  3252/s   -- -40%
parv 5429/s  67%   --

End is: 1000
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 16 wallclock secs (15.65 usr +  0.04 sys = 15.69 CPU) @ 59
+0.15/s (n=9258)
       tlm: 16 wallclock secs (15.70 usr +  0.05 sys = 15.74 CPU) @ 33
+5.40/s (n=5280)
      Rate  tlm parv
tlm  335/s   -- -43%
parv 590/s  76%   --

End is: 5000
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 16 wallclock secs (15.93 usr +  0.04 sys = 15.97 CPU) @ 11
+8.67/s (n=1895)
       tlm: 16 wallclock secs (15.70 usr +  0.03 sys = 15.73 CPU) @ 66
+.89/s (n=1052)
       Rate  tlm parv
tlm  66.9/s   -- -44%
parv  119/s  77%   --

End is: 1000000
Benchmark: running parv, tlm for at least 15 CPU seconds...
      parv: 15 wallclock secs (15.05 usr +  0.03 sys = 15.08 CPU) @  0
+.60/s (n=9)
       tlm: 15 wallclock secs (15.05 usr +  0.05 sys = 15.10 CPU) @  0
+.33/s (n=5)
     s/iter  tlm parv
tlm    3.02   -- -45%
parv   1.68  80%   --
[download]

Comment on Re: cull Select or Download Code

Replies are listed 'Best First'.

Re^2: cull
by radiantmatrix (Parson) on Apr 10, 2007 at 16:52 UTC

Interesting. Before reading your comment, I came up with the solution below. The only differences are style (e.g. $code->() vs. &$code) that I refrain from building a return array if the context is void or scalar.

I guess TMTOWTDI leads to some random convergence at times. ;-)

use strict; use warnings;
use List::MoreUtils qw[firstidx];

sub cull (&\@) {
    my ($code, $array) = (shift, shift);
    my @matches;
    my $count;
    
    # let List::MoreUtils (fast!) find the items
    # splice() returns the items removed....
    while ( (my $idx = firstidx { $code->() } @$array) > -1 ) { 
        my $item = splice(@$array,$idx,1);
        wantarray ? push(@matches, $item) : $count++;
    }
    
    wantarray ? @matches : $count;
}

my @test = qw[how I wish I could remember pi easily];
my @new = cull { $_ eq 'I' } @test;

print join(':',@new), "\n";
print join(':',@test), "\n";
[download]

<–radiant.matrix–>
Ramblings and references
The Code that can be seen is not the true Code
I haven't found a problem yet that can't be solved by a well-placed trebuchet

[reply]
[d/l]
[select]


No such thing as a small change
	PerlMonks