view release on metacpan or  search on metacpan

t/min_heap.t  view on Meta::CPAN

my @expect= sort { $a<=>$b } @n;
my @got;
push @got, min_heap_shift(@n) while @n;
is("@got","@expect","and everything looks as expected at the end");


my @res;
foreach my $tuple (@test_tuples) {
    my $num_agents= $tuple->[0];
    my $num_jobs= $tuple->[1];

    my $agent_id= "AA";
    my @agents= map { $agent_id++ } 1 .. $num_agents;
    my $job_id= 1;
    my @jobs= map { $job_id++ } 1 .. $num_jobs;

    my %agent_array;
    my @arrays1;
    my @arrays2;
    my @sequence1;
    my @sequence2;
    foreach my $agent_id (@agents) {
        my @agent_jobs1;
        my @agent_jobs2;
        foreach my $job (@jobs) {
            my $j= bless [ int(rand(1000)), $job_id++ ], "OloadAry";
            push @agent_jobs1, $j;
            push @agent_jobs2, $j;

        }
        push @arrays1, bless \@agent_jobs1, "OloadAry";
        push @arrays2, bless \@agent_jobs2, "OloadAry";
        $agent_array{0+ $arrays1[-1]}= $agent_id;
        $agent_array{0+ $arrays2[-1]}= $agent_id;

    }

    my $min_heap_elapsed= 0 - time();
    {
        my $constructed_count;
        for (@arrays1) {
            min_heapify(@$_);
        }
        min_heapify(@arrays1);
        my %taken;
        while (@arrays1) {
            while (@arrays1 and $taken{$arrays1[0][0][1]}) {
                # note do { } means the condition fires after the statement
                do { min_heap_shift(@{$arrays1[0]}) } 
                    while (@{$arrays1[0]} and $taken{$arrays1[0][0][1]});

                if (@{$arrays1[0]}) {
                    min_heap_adjust_top(@arrays1);
                } else {
                    min_heap_shift(@arrays1);
                }
            }
            last unless @arrays1;

            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.