view release on metacpan or  search on metacpan

t/09_rank_pushsort_binsearch.t  view on Meta::CPAN

#perl Makefile.PL;make;          perl -Iblib/lib t/09_rank_pushsort_binsearch.t
#perl Makefile.PL;make;ATDEBUG=1 perl -Iblib/lib t/09_rank_pushsort_binsearch.t
use lib '.'; BEGIN{require 't/common.pl'}
use Test::More tests => 62;

my @a=(1,10,20,50,70,90,120,130);
testsearch(1,@a);

@a=(1..20);    testsearch(1,@a);
@a=(1..1000);  testsearch(0,@a);
@a=(1..2000);  testsearch(0,@a);
@a=(1..4000);  testsearch(0,@a);
#@a=(1..8000);  testsearch(0,@a);
#@a=(1..16000); testsearch(0,@a);

sub testsearch {
  my $deb=shift;
  my @a=@_;
  deb "----------\nArrsize: ".@a."\n";
  $deb and deb serialize(\@a,'a');

  my $time=time_fp;
  my @steps;
  my $ok=1;
  for(@a){
    my($res,$steps)=(binsearch($_,\@a),$Acme::Tools::Binsearch_steps);
    $ok=0 if $a[$res] !=$_;
    push @steps,$steps;
    #print "$_: ".binsearch($_,@a) ,"  steps=$steps\n";
  }
  ok($ok);
  $time=time_fp()-$time;
  print "Time: $time sek\n";
  print "Time pr search: ".($time/@a)." sek/search\n";
  print "Time pr step:   ".($time/sum(@steps))." sek/step\n";
  print "Steps:   sum = ".sum(@steps)."   avg = ".avg(@steps)."   min = ".min(@steps)."   max = ".max(@steps)."\n";
  if($deb){my %ant;$ant{$_}++ for @steps; print "Searches with $_ steps: $ant{$_}\n" for sort {$a<=>$b} keys %ant}
}

my $bs;
ok( binsearch(1,[1,2,5])==0 );
ok( binsearch(2,[1,2,5])==1 );
ok( binsearch(5,[1,2,5])==2 );
ok( ($bs=binsearch(6,[1,2,5],1))==2.5, "after $bs");
ok( ($bs=binsearch(3,[1,2,5],1))==1.5, $bs);
ok( ($bs=binsearch(1.4,[1,2,5],1))==0.5, $bs);
ok( ($bs=binsearch(0,[1,2,5],1))==-0.5,"before $bs");

my $cmpsub=sub{$_[0] <=> $_[1]};
ok( binsearch(1,[1,2,5],0,$cmpsub)==0 );
ok( binsearch(2,[1,2,5],0,$cmpsub)==1 );
ok( binsearch(5,[1,2,5],0,$cmpsub)==2 );
ok( ($bs=binsearch(6,[1,2,5],1,$cmpsub))==2.5, "after $bs");
ok( ($bs=binsearch(3,[1,2,5],1,$cmpsub))==1.5, $bs);
ok( ($bs=binsearch(1.4,[1,2,5],1,$cmpsub))==0.5, $bs);
ok( ($bs=binsearch(0,[1,2,5],1,$cmpsub))==-0.5,"before $bs");

ok( binsearch(10,[20,15,10,5],undef,sub{$_[1]<=>$_[0]}) == 2);       # 2 search arrays sorted numerically in opposite order
ok( binsearch("c",["a","b","c","d"],undef,sub{$_[0]cmp$_[1]}) == 2); # 2 search arrays sorted alphanumerically
ok( binsearchstr("b",["a","b","c","d"]) == 1);                       # 1 search arrays sorted alphanumerically

my @data=( map {  {num=>$_,sqrt=>sqrt($_), square=>$_**2}  } grep !($_%7), 1..10000  );
my($i1,$i2) = ( binsearch( {num=>8883}, \@data, undef, sub {$_[0]{num} <=> $_[1]{num}} ),