view release on metacpan or  search on metacpan

t/min_heap.t  view on Meta::CPAN

# Before 'make install' is performed this script should be runnable with
# 'make test'. After 'make install' it should work as 'perl Algorithm-Heapify-XS.t'

#########################
use strict;
use warnings;

use Devel::Peek;
use Data::Dumper;

package OloadAry {
    use strict;
    use warnings;
    my $called= 0;
    use overload
        '<=>' => sub {
            $called++;
            my ($l,$r,$swap)= @_;
            ($l,$r)= ($r,$l) if $swap;
            if (ref($l) and ref($r)) {
                for my $i (0..$#$l) {
                    my $cmp= $r->[$i] <=> $l->[$i];
                    return $cmp if $cmp;
                }
                return 0;
            }
            ref($_) and $_= $_->[0]
                for $l, $r;
            return $r <=> $l;
        },
        fallback => 1,
    ;
    sub called_count { return $called }
    sub reset_called_count { my $old_called= $called; $called= 0; return $old_called; }
}

package main;
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More;
use Time::HiRes qw(time);
use Algorithm::Heapify::XS ':all';
sub log2 {return log($_[0])/log(2)} 
my @test_tuples= (
    grep { $ENV{HARNESS_ACTIVE} ? ($_->[0]<100 && $_->[1]<1000) : 1 }
    (
        [10, 500],[20, 500],[40, 500],[80, 500], [100, 500], [ 500, 500],
        [10,1000],[20,1000],[40,1000],[80,1000], [100,1000], [1000,1000],
    )
);
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];