view release on metacpan or  search on metacpan

t/random.t  view on Meta::CPAN

# -*- Mode: Perl -*-
# Copyright 2002 by Mats Kindahl. All rights reserved. 
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself. 

package Node;

use fields qw(_children _number);
use strict;

my $Number = 0;

sub new ($@) {
    my($class,@children) = @_;
    my $self = { _children => [@children],
		 _number => ++$Number };
    bless $self,$class;
}

sub children {
    my($self) = @_;

    return @{$self->{_children}};
}

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

sub naive_nca ($$) {
    my($self,$a,$b) = @_;

    # This is one of the nodes that should give the NCA: return a
    # defined value
    if ($self == $a or $self == $b) {
	return $self;
    }

    my $result = undef;

    foreach my $c ($self->children()) {
	my $x = $c->naive_nca($a,$b);
	if (defined $x) {
	    if (defined $result) { 
		# We have two children that are defined: the NCA is $self
		$result = $self;
	    } else {
		# This node is either below or above the NCA: 
		# - we return the NCA, if we are above the NCA
		# - we return a defined value, if we are below the NCA
		$result = $x;
	    }
	} 
    }
    return $result;
}

package main;

# Testcase to test if the naive version and this implementation of NCA
# agree.

use Test;
my @cases;

BEGIN {
    @cases = ([4711, 10], [1919, 50], [1111, 57],
	      [1234, 11], [4321, 33], [2222, 113]);
    plan tests => 1+@cases, todo => [];
}

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