File Coverage

blib/lib/AI/Termites.pm

Criterion	Covered	Total	%
statement	21	85	24.7
branch	0	14	0.0
condition	0	19	0.0
subroutine	7	20	35.0
pod	0	13	0.0
total	28	151	18.5

package AI::Termites;

use 5.010;

our $VERSION = '0.02';

use strict;
use warnings;

use Math::Vector::Real;
use Math::Vector::Real::Random;

use List::Util;
use Carp;

sub new {
    my ($class, %opts) = @_;
    my ($dim, $box);
    $box = delete $opts{box};
    if (defined $box) {
	$box = V(@$box);
	$dim = @$box;
    }
    else {
	$dim = delete $opts{dim} // 3;
	my $size = delete $opts{world_size} // 1000;
	$box = Math::Vector::Real->cube($dim, $size);
    }

    my $box_vol = 1;
    $box_vol *= $_ for @$box;

    my $n_termites = delete $opts{n_termites} // 50;
    my $n_wood = delete $opts{n_wood} // 200;
    my $iterations = delete $opts{iterations} // 0;
    my $termite_speed = delete $opts{termite_speed} // abs($box)/10;
    my $near = delete $opts{near} // abs($box)/50;
    %opts and croak "unknown parameter(s) ". join(", ", keys %opts);

    my @wood;
    my @termites;

    my $self = { wood => \@wood,
		 termites => \@termites,
		 iteration => 0,
		 speed => $termite_speed,
		 box => $box,
                 box_vol => $box_vol,
                 wood_density => $n_wood/$box_vol,
                 near => $near,
                 inear2 => 1/($near * $near),
                 near_dim => $near ** $dim,
                 taken => 0,
		 dim => $dim };

    bless $self, $class;

    push @wood, $self->new_wood for (1..$n_wood);
    push @termites, $self->new_termite for (1..$n_termites);
    $self->iterate for (1..$iterations);
    $self;
}

sub dim { shift->{dim} }

sub box { shift->{box} }

sub new_wood {
    my $self = shift;
    my $wood = { pos => $self->{box}->random_in_box,
		 taken => 0 };
}

sub new_termite {
    my $self = shift;
    my $termite = { pos => $self->{box}->random_in_box };
}

sub iterate {
    my $self = shift;

    $self->before_termites_move;

    for my $term (@{$self->{termites}}) {
	$self->termite_move($term);
    }
    $self->before_termites_action;
    for my $term (@{$self->{termites}}) {
	$self->termite_action($term);
    }
    $self->after_termites_action;
}

sub termite_move {
    my ($self, $termite) = @_;
    $termite->{pos} = $self->{box}->wrap( $termite->{pos} +
					  Math::Vector::Real->random_normal($self->{dim},
									    $self->{speed}));
}

sub before_termites_move {}
sub before_termites_action {}
sub after_termites_action {}

sub termite_action {
    my ($self, $termite) = @_;
    if (defined $termite->{wood_ix}) {
        if ($self->termite_leave_wood_p($termite)) {
            $self->termite_leave_wood($termite);
        }
    }
    else {
        my $wood_ix = $self->termite_take_wood_p($termite);
        defined $wood_ix and $self->termite_take_wood($termite, $wood_ix);
    }
}

sub termite_take_wood {
    my ($self, $termite, $wood_ix) = @_;
    my $wood = $self->{wood}[$wood_ix];
    return if $wood->{taken};
    $wood->{taken} = 1;
    $self->{taken}++;
    # print "taken: $self->{taken}\n";
    defined $termite->{wood_ix} and die "termite is already carrying some wood";
    $termite->{wood_ix} = $wood_ix;
}

sub termite_leave_wood {
    my ($self, $termite) = @_;
    my $wood_ix = delete $termite->{wood_ix} //
	croak "termite can not leave wood because it is carrying nothing";
    $self->{taken}--;
    my $wood = $self->{wood}[$wood_ix];
    $wood->{taken} = 0;
    $wood->{pos}->set($termite->{pos});
}


1;
__END__