AI-Termites

 view release on metacpan or  search on metacpan

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

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/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,