view release on metacpan or  search on metacpan

lib/AI/NeuralNet/SOM/Torus.pm  view on Meta::CPAN

package AI::NeuralNet::SOM::Torus;

use strict;
use warnings;

use Data::Dumper;
use base qw(AI::NeuralNet::SOM::Rect);
use AI::NeuralNet::SOM::Utils;

=pod

=head1 NAME

AI::NeuralNet::SOM::Torus - Perl extension for Kohonen Maps (torus topology)

=head1 SYNOPSIS

  use AI::NeuralNet::SOM::Torus;
  my $nn = new AI::NeuralNet::SOM::Torus (output_dim => "5x6",
                                          input_dim  => 3);
  $nn->initialize;
  $nn->train (30, 
    [ 3, 2, 4 ], 
    [ -1, -1, -1 ],
    [ 0, 4, -3]);

  print $nn->as_data;

=head1 DESCRIPTION

This SOM is very similar to that with a rectangular topology, except that the rectangle is connected
on the top edge and the bottom edge to first form a cylinder; and that cylinder is then formed into
a torus by connecting the rectangle's left and right border (L<http://en.wikipedia.org/wiki/Torus>).

=head1 INTERFACE

It exposes the same interface as the base class.

=cut

sub neighbors {                                                               # http://www.ai-junkie.com/ann/som/som3.html
    my $self   = shift;
    my $sigma  = shift;
    my $sigma2 = $sigma * $sigma;          # need the square more often
    my $X      = shift;
    my $Y      = shift;

    my ($_X, $_Y) = ($self->{_X}, $self->{_Y});

    my @neighbors;
    for my $x (0 .. $self->{_X}-1) {
        for my $y (0 .. $self->{_Y}-1){                                                                # this is not overly elegant, or fast
	    my $distance2 = ($x       - $X) * ($x       - $X) + ($y       - $Y) * ($y       - $Y);     # take the node with its x,y coords
	    push @neighbors, [ $x, $y, sqrt($distance2) ] if $distance2 <= $sigma2;

	       $distance2 = ($x - $_X - $X) * ($x - $_X - $X) + ($y       - $Y) * ($y       - $Y);     # take the node transposed to left by _X
	    push @neighbors, [ $x, $y, sqrt ($distance2) ] if $distance2 <= $sigma2;

	       $distance2 = ($x + $_X - $X) * ($x + $_X - $X) + ($y       - $Y) * ($y       - $Y);     # transposed by _X to right
	    push @neighbors, [ $x, $y, sqrt ($distance2) ] if $distance2 <= $sigma2;

	       $distance2 = ($x       - $X) * ($x       - $X) + ($y - $_Y - $Y) * ($y - $_Y - $Y);     # same with _Y up
	    push @neighbors, [ $x, $y, sqrt ($distance2) ] if $distance2 <= $sigma2;

	       $distance2 = ($x       - $X) * ($x       - $X) + ($y + $_Y - $Y) * ($y + $_Y - $Y);     # and down
	    push @neighbors, [ $x, $y, sqrt ($distance2) ] if $distance2 <= $sigma2;