view release on metacpan or  search on metacpan

t/min_heap.t  view on Meta::CPAN

plan tests => (@test_tuples * 3)+15;
my @n= reverse 1..10;
my $top;

$top= min_heapify(@n);
is($n[0],1,"min_heapify works");
is($top,1,"... and top looks ok");

$top= min_heap_push(@n,0);
is($n[0],0,"min_heap_push works");
is($top,0,"... and top looks ok");

$top= min_heap_push(@n,0.5);
is($n[0],0,"min_heap_push works");
is($top,0,"... and top looks ok");

$top= min_heap_shift(@n);
is($n[0],0.5,"min_heap_shift works");
is($top,0,"... and top looks ok");

$n[5]=-1;
$top= min_heap_adjust_item(@n,5);
is($n[0],-1,"min_heap_adjust_item works");
is($top,-1,"... and top looks ok");

$n[5]=1000;
$top= min_heap_adjust_item(@n,5);
is($n[0],-1,"min_heap_adjust_item works");
is($top,-1,"... and top looks ok");

$n[0]= 100;
$top= min_heap_adjust_top(@n);
is($n[0],0.5,"min_heap_adjust_top works");
is($top,0.5,"... and top looks ok");

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;
        }
    }