view release on metacpan or  search on metacpan

t/min_heap.t  view on Meta::CPAN

            my $best_ary= min_heap_shift(@arrays1);
            my $best_item= $best_ary->[0];
            my $job_id= $best_item->[1];
            my $agent= $agent_array{0+$best_ary};
            my $score= $best_item->[0];
            $taken{$job_id}++;
            push @sequence1, "$agent:$job_id";
        }
    }
    $min_heap_elapsed += time();
    my $min_heap_comparisons= OloadAry::reset_called_count();
    
    my $sort_elapsed= 0 - time();
    {
        @$_= sort { $a <=> $b } @$_ for @arrays2;
        @arrays2= sort { $a <=> $b } @arrays2;
        #die Data::Dumper::Dumper(\@arrays2);
        my %taken;
        while (@arrays2) {
            my $best_ary= shift @arrays2;
            last if !@$best_ary;
            my $best_item= shift @$best_ary;
            my $agent= $agent_array{0+$best_ary};
            my $score= $best_item->[0];
            my $job_id= $best_item->[1];
            push @sequence2, "$agent:$job_id";
            $taken{$job_id}++;
            foreach my $ary (@arrays2) {
                shift @$ary while @$ary and $taken{$ary->[0][1]};
            }
            @arrays2= sort { $a <=> $b } grep { 0+@$_ } @arrays2;
        }
    }
    $sort_elapsed += time();
    my $sort_comparisons= OloadAry::reset_called_count();
    my $worst_min_heap_comparisons= ($num_agents * (2*$num_jobs)) 
                              + (2*$num_agents) 
                              + ($num_agents * log2($num_agents)) 
                              + ($num_agents * log2($num_jobs));
    my $worst_sort_comparisons= $num_agents * $num_jobs * log2($num_jobs);
    push @res,[
        $num_jobs, $num_agents, 
        
        $min_heap_elapsed * 1000, 
        $min_heap_comparisons, 
        $worst_min_heap_comparisons,

        $sort_elapsed * 1000, 
        $sort_comparisons, 
        $worst_sort_comparisons, 
        
        $min_heap_comparisons / $sort_comparisons * 100,
        
    ];
    cmp_ok($min_heap_comparisons,"<",$sort_comparisons,"(a=$num_agents j=$num_jobs) min_heap took less comparisons");
    cmp_ok($min_heap_elapsed*1000,"<",$sort_elapsed*1000,"(a=$num_agents j=$num_jobs) min_heap took less time");
    is("@sequence1","@sequence2","(a=$num_agents j=$num_jobs) got same results");
}

my @title= qw(j a stook scmp a*j*log2(j) htook hcmp a2j+2a+a*log2(a)+a*log2(j) pct );
my $smax_len= length $title[4];
my $hmax_len= length $title[-2];
!$ENV{HARNESS_ACTIVE} && diag join "\n", 
    sprintf("%4s %4s | %7sms %8s %${smax_len}s | %7sms %8s %${hmax_len}s | %5s |",@title),
    map { sprintf("%4d %4d | %7.0fms %8d %${smax_len}.0f | %7.0fms %8d %${hmax_len}.0f | %5.2s |",@$_) } @res;




#########################

# Insert your test code below, the Test::More module is use()ed here so read
# its man page ( perldoc Test::More ) for help writing this test script.