Algorithm-Tree-NCA

 view release on metacpan or  search on metacpan

t/basic.t  view on Meta::CPAN


    push(@$listref, $self);
    foreach my $c ($self->children()) {
	$c->make_preorder_list($listref);
    }
}


sub display {
    my($self,$indent) = @_;
    print ' ' x (2*$indent), $self->{_nca_number}, "\n";
    foreach my $c ($self->children()) {
	$c->display($indent+1);
    }
}

# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

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

# change 'tests => 1' to 'tests => last_test_to_print';

package main;

use Test;
BEGIN { plan tests => 4, todo => [] };

use Algorithm::Tree::NCA;
ok(1); # If we made it this far, we're ok.

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

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

my $Tree = Node->new(Node->new(Node->new(),
			       Node->new()),
		     Node->new(Node->new(),
			       Node->new(),
			       Node->new(Node->new(),
					 Node->new())));

# Matrix with precomputed values of the NCA for each pair of nodes in
# the tree above. Observe that node number 0 is never used.
my $NCA = [[(undef) x 11],
           [undef, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1],  # Node 1
           [undef, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1],  # Node 2
           [undef, 1, 2, 3, 2, 1, 1, 1, 1, 1, 1],  # Node 3
           [undef, 1, 2, 2, 4, 1, 1, 1, 1, 1, 1],  # Node 4
           [undef, 1, 1, 1, 1, 5, 5, 5, 5, 5, 5],  # Node 5
           [undef, 1, 1, 1, 1, 5, 6, 5, 5, 5, 5],  # Node 6
           [undef, 1, 1, 1, 1, 5, 5, 7, 5, 5, 5],  # Node 7
           [undef, 1, 1, 1, 1, 5, 5, 5, 8, 8, 8],  # Node 8
           [undef, 1, 1, 1, 1, 5, 5, 5, 8, 9, 8],  # Node 9
           [undef, 1, 1, 1, 1, 5, 5, 5, 8, 8,10]]; # Node 10
ok(1);

{
    my $nca = new Algorithm::Tree::NCA;
    $nca->preprocess($Tree);

    my $bad = 0;
    my @Nodes;
    $Tree->make_preorder_list(\@Nodes);

    foreach my $x (@Nodes) {
	foreach my $y (@Nodes) {
	    my $xn = $nca->_data($x)->{_number};
	    my $yn = $nca->_data($y)->{_number};
	    my $p = $nca->nca($x,$y);
	    my $pn = $nca->_data($p)->{_number};
	    if ($NCA->[$xn]->[$yn] != $pn) {
		++$bad;
	    }
	}
    }
    ok($bad,0,"Failed $bad cases");
}

{
    my $nca = new Algorithm::Tree::NCA
	-tree => $Tree;

    my $bad = 0;
    my @Nodes;
    $Tree->make_preorder_list(\@Nodes);

    foreach my $x (@Nodes) {
	foreach my $y (@Nodes) {
	    my $xn = $nca->_data($x)->{_number};
	    my $yn = $nca->_data($y)->{_number};
	    my $p = $nca->nca($x,$y);
	    my $pn = $nca->_data($p)->{_number};
	    if ($NCA->[$xn]->[$yn] != $pn) {
		++$bad;
	    }
	}
    }
    ok($bad,0,"Failed $bad cases");
}



( run in 1.018 second using v1.01-cache-2.11-cpan-e1769b4cff6 )