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

AI-NeuralNet-SOM documentation Contained in the AI-NeuralNet-SOM distribution.

Index

Code Index:

NAME

Top

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

SYNOPSIS

Top

  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;

DESCRIPTION

Top

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 (http://en.wikipedia.org/wiki/Torus).

INTERFACE

Top

It exposes the same interface as the base class.

SEE ALSO

Top

AI::NeuralNet::SOM::Rect

AUTHOR

Top

Robert Barta, <rho@devc.at>

COPYRIGHT AND LICENSE

Top

Copyright (C) 2007 by Robert Barta

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.8.8 or, at your option, any later version of Perl 5 you may have available.

AI-NeuralNet-SOM documentation Contained in the AI-NeuralNet-SOM distribution. 
package AI::NeuralNet::SOM::Torus;

use strict;
use warnings;

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


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;
	}
    }
    return \@neighbors;
}


our $VERSION = '0.01';

1;

__END__