sub results from the CPAN

AI-Termites


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;

lib/AI/Termites.pm view on Meta::CPAN

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

lib/AI/Termites.pm view on Meta::CPAN

Klopfer and Mitchel Resnick
(L<http://education.mit.edu/starlogo/adventures/>).

In this version, termites can move in a n-dimensional boxed space, and
are not limited to integer coordinates.

Also, the way they decide when to pick or leave wood are customizable,
allowing to investigate how changing the rules affects the emergent
behaviors.

The module implements several termite subspecies (subclasses):

=over 4

=item LoginquitasPostulo

This termites subspecie measures the distance to the nearest piece of
wood.

=item NemusNidor

This termite smells the wood.

=item PeractioBaro

This termite is pretty simple and all that can see is if there is or
not some piece of wood in the vecinity.

lib/AI/Termites/LoginquitasPostulo.pm view on Meta::CPAN

package AI::Termites::LoginquitasPostulo;

use strict;
use warnings;

use Math::Vector::Real;
use Math::Vector::Real::kdTree;

use parent 'AI::Termites';

sub before_termites_action {
    my $self = shift;
    my @ixs = grep !$self->{wood}[$_]{taken}, 0..$#{$self->{wood}};
    $self->{kdtree_ixs} = \@ixs;
    $self->{kdtree} = Math::Vector::Real::kdTree->new(map $_->{pos}, @{$self->{wood}}[@ixs]);
}

sub termite_take_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    my $wood_ix = $self->{kdtree}->find_nearest_neighbor($pos, $near);
    if (defined $wood_ix) {
        my ($next_ix, $d) = $self->{kdtree}->find_nearest_neighbor($pos, $near, $wood_ix);
        if (not defined $next_ix or rand($near) < $d) {
            return $self->{kdtree_ixs}[$wood_ix];
        }
    }
    undef
}

sub termite_leave_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    my ($wood_ix, $d) = $self->{kdtree}->find_nearest_neighbor($pos, $near);
    if (defined $wood_ix and rand($near) > $d) {
        return 1;
    }
    undef;
}

lib/AI/Termites/NemusNidor.pm view on Meta::CPAN

use 5.010;
use strict;
use warnings;

use Math::Vector::Real;
use Math::Vector::Real::kdTree;
use Math::Vector::Real::MultiNormalMixture;

use parent 'AI::Termites';

sub before_termites_action {
    my $self = shift;
    my @ixs = grep !$self->{wood}[$_]{taken}, 0..$#{$self->{wood}};
    $self->{kdtree_ixs} = \@ixs;
    $self->{kdtree} = Math::Vector::Real::kdTree->new(map $_->{pos}, @{$self->{wood}}[@ixs]);
    my $sigma = $self->{near}**(-2) * log(2);
    # print "sigma: $sigma\n";
    my $mnm = Math::Vector::Real::MultiNormalMixture->new(mu => [map $_->{pos}, @{$self->{wood}}[@ixs]],
                                                          sigma => $sigma);
    $self->{mnm} = $mnm;
    $self->{mnm_max} = $mnm->max_density_estimation;
}

sub termite_take_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    my $wood_ix = $self->{kdtree}->find_nearest_neighbor($pos, $near);
    if (defined $wood_ix) {
        my @near = $self->{kdtree}->find_in_ball($pos, $near * 3, $wood_ix);
        my $density = $self->{mnm}->density_portion($pos, @near);
        my $max = $self->{mnm_max};
        $self->{mnm_max} = $max = $density if $density > $max;
        # printf "take  -> max: %6g, density: %6g. ratio: %02.7f\n", $max, $density, $density/$max * 100;
        return $self->{kdtree_ixs}[$wood_ix] if $density < rand($max);
    }
    undef
}

sub termite_leave_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    my @near = $self->{kdtree}->find_in_ball($pos, $near * 3);
    my $density = $self->{mnm}->density_portion($pos, @near);
    my $max = $self->{mnm_max};
    $self->{mnm_max} = $max = $density if $density > $max;
    # printf "leave -> max: %6g, density: %6g. ratio: %02.7f\n", $max, $density, $density/$max * 100;
    return 1 if $density > rand($max);
    undef;

lib/AI/Termites/PeractioBaro.pm view on Meta::CPAN


use 5.010;
use strict;
use warnings;

use Math::Vector::Real;
use Math::Vector::Real::kdTree;

use parent 'AI::Termites';

sub before_termites_action {
    my $self = shift;
    my @ixs = grep !$self->{wood}[$_]{taken}, 0..$#{$self->{wood}};
    # say '@ixs: ', scalar @ixs;
    $self->{kdtree_ixs} = \@ixs;
    $self->{kdtree} = Math::Vector::Real::kdTree->new(map $_->{pos}, @{$self->{wood}}[@ixs]);
}

sub termite_take_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    my $wood_ix = $self->{kdtree}->find_nearest_neighbor($pos, $near);
    if (defined $wood_ix) {
        # say "one near $pos, $near";
        my $second = $self->{kdtree}->find_nearest_neighbor($pos, $near, $wood_ix);
        return $self->{kdtree_ixs}[$wood_ix] unless defined $second;
        # say "two near $wood_ix - $second";
    }
    undef
}

sub termite_leave_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    return defined $self->{kdtree}->find_nearest_neighbor($pos, $near);
    undef;
}

1;

lib/AI/Termites/VicinusOccurro.pm view on Meta::CPAN

use warnings;

use Math::Vector::Real;
use Math::Vector::Real::kdTree;
use Math::nSphere qw(nsphere_volumen);

use parent 'AI::Termites';

my $nlog2 = -log 2;

sub before_termites_action {
    my $self = shift;
    my @ixs = grep !$self->{wood}[$_]{taken}, 0..$#{$self->{wood}};
    $self->{kdtree_ixs} = \@ixs;
    $self->{kdtree} = Math::Vector::Real::kdTree->new(map $_->{pos}, @{$self->{wood}}[@ixs]);
    # print "dim: $self->{dim}, near: $self->{near}, density: $self->{wood_density}\n";
    $self->{alpha} = $nlog2/(nsphere_volumen($self->{dim} - 1, $self->{near}) * $self->{wood_density});



}

sub termite_take_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    my $wood_ix = $self->{kdtree}->find_nearest_neighbor($pos, $near);
    if (defined $wood_ix) {
        my $count = $self->{kdtree}->find_in_ball($pos, $near, $wood_ix);
        if (exp($self->{alpha} * $count) > rand) {
            return $self->{kdtree_ixs}[$wood_ix];
        }
    }
    undef
}

sub termite_leave_wood_p {
    my ($self, $termite) = @_;
    my $pos = $termite->{pos};
    my $near = $self->{near};
    my $count = $self->{kdtree}->find_in_ball($pos, $near);
    if (exp($self->{alpha} * $count) < rand) {
        return 1;
    }
    undef;
}

samples/termites.pl view on Meta::CPAN

                         "near=s"       => \$near,
                         "one-of=i"     => \$one_of,
                         "width=i"      => \$width,
                         "dim=i"        => \$dim,
                         "taken"        => \$taken,
                         "output=s"     => \$output,
                         "truecolor"    => \$truecolor,
                         "top=i"          => \$top,
                       );

sub scl {
    my $p = shift;
    @{$width * $p}[0, 1];
}

sub sscl {
    my $s = shift;
    $width * $s;
}

$| = 1;

my $class = "AI::Termites::$specie";
eval "require $class; 1" or die "unable to load $class: $@";

my $ters = $class->new(dim => $dim, world_size => $world,

samples/termites.pl view on Meta::CPAN

=item --dim N

Number of dimensions of the world. Defaults to 2.

=item --world-size SIZE

The size of the world box, Defaults to 1.

=item --specie NAME

The name of the artificial termite subspecie to simulate.

The currently accepted ones are C<LoginquitasPostulo>, C<NemusNidor>,
C<VicinusOcurro> and C<PeractioBaro>.

=item --wood N

Piezes of wood in the simulated world.

=item --termites N

( run in 1.047 second using v1.01-cache-2.11-cpan-88abd93f124 )