AI-NeuralNet-SOM
view release on metacpan or search on metacpan
Revision history for Perl extension AI::NeuralNet::SOM.
0.07 Sat May 24 08:53:26 CEST 2008
- fix: Hexa::initialize: corner case when @data is empty not handled (tom fawcett)
0.06 Fri May 23 10:23:29 CEST 2008
- fix: label '0' in label method (tom fawcett)
- fix: value '0' in value method (rho)
0.05 Mi 16. Jan 20:58:19 CET 2008
- improvement of documentation
- training now holds sigma and l constant during an epoch, but applies ALL vectors (exactly once)
0.04 17. Jun CEST 2007
- added labels get/set
- added mean_error function
0.03 Do 14. Jun 21:07:54 CEST 2007
- added output_dim method
- added ::Torus subclass of ::Rect
0.02 Sa 9. Jun 17:55:23 CEST 2007
- split ::SOM.pm into ::SOM::Rect and ::SOM::Hexa
- added more features for initialization
- factored out vector computation into ::SOM::Utils
0.01 Wed Jun 6 01:08:34 2007
- original version; created by h2xs 1.23 with options
-n AI::NeuralNet::SOM -X --use-new-tests
- first stab on things
Makefile.PL view on Meta::CPAN
use 5.008008;
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'AI::NeuralNet::SOM',
VERSION_FROM => 'lib/AI/NeuralNet/SOM.pm',
PREREQ_PM => {},
NORECURS => 1,
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/AI/NeuralNet/SOM.pm', # retrieve abstract from module
AUTHOR => 'Robert Barta <rho@devc.at>') : ()),
);
package MY;
sub depend {
return <<MAKE
inject:
mcpani --add --module AI::NeuralNet::SOM --authorid DRRHO --modversion \$(VERSION) --file AI-NeuralNet-SOM-\$(VERSION).tar.gz
sudo mcpani --inject
debian:
(cd /usr/local/share/packages ; rm -rf libai-neuralnet-som-perl* AI-NeuralNet-SOM* ; dh-make-perl --cpan-mirror file:/usr/local/share/minicpan --build -cpan AI::NeuralNet::SOM )
upload:
cpan-upload-http AI-NeuralNet-SOM-\${VERSION}.tar.gz
MAKE
}
================
Yet another implementation of Kohonen's SOMs (self organizing maps):
multidimensional vector samples in, 2-dimensional out, clusters become
visible. Nice.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
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.
examples/eigenvector_initialization.pl view on Meta::CPAN
my @vs = ([ 3, 2, 4 ], [ -1, -1, -1 ], [ 0, 4, -3]);
my $dim = 3;
#my @vs = ([1,-0.5], [0,1]);
#my $dim = 2;
my $epsilon = 0.001;
my $epochs = 400;
{ # random initialisation
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => $dim);
$nn->initialize; # random
my @mes = $nn->train ($epochs, @vs);
warn "random: length until error is < $epsilon ". scalar (grep { $_ >= $epsilon } @mes);
}
{ # constant initialisation
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => $dim);
$nn->initialize ($vs[-1]);
my @mes = $nn->train ($epochs, @vs);
warn "constant: length until error is < $epsilon ". scalar (grep { $_ >= $epsilon } @mes);
}
{ # eigenvector initialisation
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => $dim);
my @training_vectors; # find these training vectors
{ # and prime them with this eigenvector stuff;
use PDL;
my $A = pdl \@vs;
while ($A->getdim(0) < $A->getdim(1)) { # make the beast quadratic
$A = append ($A, zeroes (1)); # by padding zeroes
}
my ($E, $e) = eigens_sym $A;
# print $E;
# print $e;
my @es = list $e; # eigenvalues
# warn "es : ".Dumper \@es;
my @es_desc = sort { $b <=> $a } @es; # eigenvalues sorted desc
# warn "desc: ".Dumper \@es_desc;
my @es_idx = map { _find_num ($_, \@es) } @es_desc; # eigenvalue indices sorted by eigenvalue (desc)
# warn "idx: ".Dumper \@es_idx;
sub _find_num {
my $v = shift;
my $l = shift;
for my $i (0..$#$l) {
return $i if $v == $l->[$i];
}
return undef;
}
for (@es_idx) { # from the highest values downwards, take the index
push @training_vectors, [ list $E->dice($_) ] ; # get the corresponding vector
}
}
$nn->initialize (@training_vectors[0..0]); # take only the biggest ones (the eigenvalues are big, actually)
#warn $nn->as_string;
my @mes = $nn->train ($epochs, @vs);
warn "eigen: length until error is < $epsilon ". scalar (grep { $_ >= $epsilon } @mes);
}
__END__
examples/load_save.pl view on Meta::CPAN
use strict;
use Data::Dumper;
use AI::NeuralNet::SOM::Rect;
{
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
$nn->initialize;
$nn->train (400, ([ 3, 2, 4 ], [ -1, -1, -1 ], [ 0, 4, -3]));
# now we freeze the thing
use Storable;
store $nn, '/tmp/somnia';
# and forget it
}
{ # get it back, get it back
my $nn = retrieve('/tmp/somnia');
warn Dumper $nn;
# ....
}
__END__
use AI::NeuralNet::SOM::Rect;
#my @vs = ([1,-0.5], [0,1]);
#my $dim = 2;
my $epsilon = 0.001;
$nn->initialize; # random
my @mes = $nn->train ($epochs, @vs);
warn "random: length until error is < $epsilon ". scalar (grep { $_ >= $epsilon } @mes);
}
{ # constant initialisation
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => $dim);
$nn->initialize ($vs[-1]);
my @mes = $nn->train ($epochs, @vs);
warn "constant: length until error is < $epsilon ". scalar (grep { $_ >= $epsilon } @mes);
}
{ # eigenvector initialisation
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => $dim);
my @training_vectors; # find these training vectors
{ # and prime them with this eigenvector stuff;
use PDL;
my $A = pdl \@vs;
while ($A->getdim(0) < $A->getdim(1)) { # make the beast quadratic
$A = append ($A, zeroes (1)); # by padding zeroes
}
my ($E, $e) = eigens_sym $A;
# print $E;
# print $e;
my @es = list $e; # eigenvalues
# warn "es : ".Dumper \@es;
my @es_desc = sort { $b <=> $a } @es; # eigenvalues sorted desc
# warn "desc: ".Dumper \@es_desc;
my @es_idx = map { _find_num ($_, \@es) } @es_desc; # eigenvalue indices sorted by eigenvalue (desc)
# warn "idx: ".Dumper \@es_idx;
sub _find_num {
my $v = shift;
my $l = shift;
for my $i (0..$#$l) {
return $i if $v == $l->[$i];
}
return undef;
}
for (@es_idx) { # from the highest values downwards, take the index
push @training_vectors, [ list $E->dice($_) ] ; # get the corresponding vector
}
}
$nn->initialize (@training_vectors[0..0]); # take only the biggest ones (the eigenvalues are big, actually)
#warn $nn->as_string;
my @mes = $nn->train ($epochs, @vs);
warn "eigen: length until error is < $epsilon ". scalar (grep { $_ >= $epsilon } @mes);
}
__END__
lib/AI/NeuralNet/SOM.pm view on Meta::CPAN
use Data::Dumper;
=pod
=head1 NAME
AI::NeuralNet::SOM - Perl extension for Kohonen Maps
=head1 SYNOPSIS
use AI::NeuralNet::SOM::Rect;
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
$nn->initialize;
$nn->train (30,
[ 3, 2, 4 ],
[ -1, -1, -1 ],
[ 0, 4, -3]);
my @mes = $nn->train (30, ...); # learn about the smallest errors
# during training
print $nn->as_data; # dump the raw data
print $nn->as_string; # prepare a somehow formatted string
use AI::NeuralNet::SOM::Torus;
# similar to above
use AI::NeuralNet::SOM::Hexa;
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 6,
input_dim => 4);
$nn->initialize ( [ 0, 0, 0, 0 ] ); # all get this value
$nn->value (3, 2, [ 1, 1, 1, 1 ]); # change value for a neuron
print $nn->value (3, 2);
$nn->label (3, 2, 'Danger'); # add a label to the neuron
print $nn->label (3, 2);
=head1 DESCRIPTION
This package is a stripped down implementation of the Kohonen Maps
(self organizing maps). It is B<NOT> meant as demonstration or for use
together with some visualisation software. And while it is not (yet)
optimized for speed, some consideration has been given that it is not
overly slow.
lib/AI/NeuralNet/SOM.pm view on Meta::CPAN
value will be narrowed down, so that the learning radius impacts less and less neurons.
B<NOTE>: Do not choose C<1> as the C<log> function is used on this value.
=back
Subclasses will (re)define some of these parameters and add others:
Example:
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
=cut
sub new { die; }
=pod
=head2 Methods
=over
lib/AI/NeuralNet/SOM.pm view on Meta::CPAN
how this is done:
=over
=item providing data vectors
If you provide a list of vectors, these will be used in turn to seed the neurons. If the list is
shorter than the number of neurons, the list will be started over. That way it is trivial to
zero everything:
$nn->initialize ( [ 0, 0, 0 ] );
=item providing no data
Then all vectors will get randomized values (in the range [ -0.5 .. 0.5 ]).
=item using eigenvectors (see L</HOWTOS>)
=back
=item I<train>
lib/AI/NeuralNet/SOM.pm view on Meta::CPAN
The training uses the list of sample vectors to make the network learn. Each vector is simply a
reference to an array of values.
The C<epoch> parameter controls how many vectors are processed. The vectors are B<NOT> used in
sequence, but picked randomly from the list. For this reason it is wise to run several epochs,
not just one. But within one epoch B<all> vectors are visited exactly once.
Example:
$nn->train (30,
[ 3, 2, 4 ],
[ -1, -1, -1 ],
[ 0, 4, -3]);
=cut
sub train {
my $self = shift;
my $epochs = shift || 1;
die "no data to learn" unless @_;
$self->{LAMBDA} = $epochs / log ($self->{_Sigma0}); # educated guess?
my @mes = (); # this will contain the errors during the epochs
for my $epoch (1..$epochs) {
$self->{T} = $epoch;
my $sigma = $self->{_Sigma0} * exp ( - $self->{T} / $self->{LAMBDA} ); # compute current radius
my $l = $self->{_L0} * exp ( - $self->{T} / $epochs ); # current learning rate
my @veggies = @_; # make a local copy, that will be destroyed in the loop
while (@veggies) {
my $sample = splice @veggies, int (rand (scalar @veggies) ), 1; # find (and take out)
my @bmu = $self->bmu ($sample); # find the best matching unit
push @mes, $bmu[2] if wantarray;
my $neighbors = $self->neighbors ($sigma, @bmu); # find its neighbors
map { _adjust ($self, $l, $sigma, $_, $sample) } @$neighbors; # bend them like Beckham
}
}
return @mes;
}
sub _adjust { # http://www.ai-junkie.com/ann/som/som4.html
my $self = shift;
my $l = shift; # the learning rate
my $sigma = shift; # the current radius
my $unit = shift; # which unit to change
my ($x, $y, $d) = @$unit; # it contains the distance
my $v = shift; # the vector which makes the impact
my $w = $self->{map}->[$x]->[$y]; # find the data behind the unit
my $theta = exp ( - ($d ** 2) / (2 * $sigma ** 2)); # gaussian impact (using distance and current radius)
foreach my $i (0 .. $#$w) { # adjusting values
$w->[$i] = $w->[$i] + $theta * $l * ( $v->[$i] - $w->[$i] );
}
}
=pod
=item I<bmu>
(I<$x>, I<$y>, I<$distance>) = I<$nn>->bmu (I<$vector>)
This method finds the I<best matching unit>, i.e. that neuron which is closest to the vector passed
in. The method returns the coordinates and the actual distance.
lib/AI/NeuralNet/SOM.pm view on Meta::CPAN
=item I<mean_error>
I<$me> = I<$nn>->mean_error (I<@vectors>)
This method takes a number of vectors and produces the I<mean distance>, i.e. the average I<error>
which the SOM makes when finding the C<bmu>s for the vectors. At least one vector must be passed in.
Obviously, the longer you let your SOM be trained, the smaller the error should become.
=cut
sub mean_error {
my $self = shift;
my $error = 0;
map { $error += $_ } # then add them all up
map { ( $self->bmu($_) )[2] } # then find the distance
@_; # take all data vectors
return ($error / scalar @_); # return the mean value
}
=pod
=item I<neighbors>
I<$ns> = I<$nn>->neighbors (I<$sigma>, I<$x>, I<$y>)
Finds all neighbors of (X, Y) with a distance smaller than SIGMA. Returns a list reference of (X, Y,
distance) triples.
lib/AI/NeuralNet/SOM.pm view on Meta::CPAN
=item I<output_dim> (read-only)
I<$dim> = I<$nn>->output_dim
Returns the output dimensions of the map as passed in at constructor time.
=cut
sub output_dim {
my $self = shift;
return $self->{output_dim};
}
=pod
=item I<radius> (read-only)
I<$radius> = I<$nn>->radius
Returns the I<radius> of the map. Different topologies interpret this differently.
=item I<map>
I<$m> = I<$nn>->map
This method returns a reference to the map data. See the appropriate subclass of the data
representation.
=cut
sub map {
my $self = shift;
return $self->{map};
}
=pod
=item I<value>
I<$val> = I<$nn>->value (I<$x>, I<$y>)
I<$nn>->value (I<$x>, I<$y>, I<$val>)
Set or get the current vector value for a particular neuron. The neuron is addressed via its
coordinates.
=cut
sub value {
my $self = shift;
my ($x, $y) = (shift, shift);
my $v = shift;
return defined $v ? $self->{map}->[$x]->[$y] = $v : $self->{map}->[$x]->[$y];
}
=pod
=item I<label>
I<$label> = I<$nn>->label (I<$x>, I<$y>)
I<$nn>->label (I<$x>, I<$y>, I<$label>)
Set or get the label for a particular neuron. The neuron is addressed via its coordinates.
The label can be anything, it is just attached to the position.
=cut
sub label {
my $self = shift;
my ($x, $y) = (shift, shift);
my $l = shift;
return defined $l ? $self->{labels}->[$x]->[$y] = $l : $self->{labels}->[$x]->[$y];
}
=pod
=item I<as_string>
print I<$nn>->as_string
This methods creates a pretty-print version of the current vectors.
lib/AI/NeuralNet/SOM.pm view on Meta::CPAN
=cut
our $VERSION = '0.07';
1;
__END__
sub bmu {
my $self = shift;
my $sample = shift;
my $closest; # [x,y, distance] value and co-ords of closest match
foreach my $coor ($self->_get_coordinates) { # generate all coord pairs, not overly happy with that
my ($x, $y) = @$coor;
my $distance = _vector_distance ($self->{map}->[$x]->[$y], $sample); # || Vi - Sample ||
$closest = [0, 0, $distance] unless $closest;
$closest = [$x, $y, $distance] if $distance < $closest->[2];
}
return @$closest;
}
lib/AI/NeuralNet/SOM/Hexa.pm view on Meta::CPAN
use AI::NeuralNet::SOM::Utils;
=pod
=head1 NAME
AI::NeuralNet::SOM::Hexa - Perl extension for Kohonen Maps (hexagonal topology)
=head1 SYNOPSIS
use AI::NeuralNet::SOM::Hexa;
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 6,
input_dim => 3);
# ... see also base class AI::NeuralNet::SOM
=head1 INTERFACE
=head2 Constructor
The constructor takes the following arguments (additionally to those in the base class):
=over
=item C<output_dim> : (mandatory, no default)
A positive, non-zero number specifying the diameter of the hexagonal. C<1> creates one with a single
hexagon, C<2> one with 4, C<3> one with 9. The number plays the role of a diameter.
=back
Example:
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 6,
input_dim => 3);
=cut
sub new {
my $class = shift;
my %options = @_;
my $self = bless { %options }, $class;
if ($self->{output_dim} > 0) {
$self->{_D} = $self->{output_dim};
} else {
die "output dimension must be positive integer";
}
if ($self->{input_dim} > 0) {
$self->{_Z} = $self->{input_dim};
} else {
die "input dimension must be positive integer";
}
$self->{_R} = $self->{_D} / 2;
$self->{_Sigma0} = $options{sigma0} || $self->{_R}; # impact distance, start value
$self->{_L0} = $options{learning_rate} || 0.1; # learning rate, start value
return $self;
}
=pod
=head2 Methods
=over
=item I<radius>
Returns the radius (half the diameter).
=cut
sub radius {
my $self = shift;
return $self->{_R};
}
=pod
=item I<diameter>
Returns the diameter (= dimension) of the hexagon.
=cut
sub diameter {
my $self = shift;
return $self->{_D};
}
=pod
=cut
sub initialize {
my $self = shift;
my @data = @_;
our $i = 0;
my $get_from_stream = sub {
$i = 0 if $i > $#data;
return [ @{ $data[$i++] } ]; # cloning !
} if @data;
$get_from_stream ||= sub {
return [ map { rand( 1 ) - 0.5 } 1..$self->{_Z} ];
};
for my $x (0 .. $self->{_D}-1) {
for my $y (0 .. $self->{_D}-1) {
$self->{map}->[$x]->[$y] = &$get_from_stream;
}
}
}
sub bmu {
my $self = shift;
my $sample = shift;
my $closest; # [x,y, distance] value and co-ords of closest match
for my $x (0 .. $self->{_D}-1) {
for my $y (0 .. $self->{_D}-1){
my $distance = AI::NeuralNet::SOM::Utils::vector_distance ($self->{map}->[$x]->[$y], $sample); # || Vi - Sample ||
#warn "distance to $x, $y : $distance";
$closest = [0, 0, $distance] unless $closest;
$closest = [$x, $y, $distance] if $distance < $closest->[2];
}
}
return @$closest;
}
sub neighbors { # http://www.ai-junkie.com/ann/som/som3.html
my $self = shift;
my $sigma = shift;
my $X = shift;
my $Y = shift;
my @neighbors;
for my $x (0 .. $self->{_D}-1) {
for my $y (0 .. $self->{_D}-1){
my $distance = _hexa_distance ($X, $Y, $x, $y);
##warn "$X, $Y, $x, $y: distance: $distance";
next if $distance > $sigma;
push @neighbors, [ $x, $y, $distance ]; # we keep the distances
}
}
return \@neighbors;
}
sub _hexa_distance {
my ($x1, $y1) = (shift, shift); # one point
my ($x2, $y2) = (shift, shift); # another
($x1, $y1, $x2, $y2) = ($x2, $y2, $x1, $y1) # swapping
if ( $x1+$y1 > $x2+$y2 );
my $dx = $x2 - $x1;
my $dy = $y2 - $y1;
if ($dx < 0 || $dy < 0) {
return abs ($dx) + abs ($dy);
} else {
return $dx < $dy ? $dy : $dx;
}
}
=pod
=item I<map>
I<$m> = I<$nn>->map
This method returns the 2-dimensional array of vectors in the grid (as a reference to an array of
references to arrays of vectors).
Example:
my $m = $nn->map;
for my $x (0 .. $nn->diameter -1) {
for my $y (0 .. $nn->diameter -1){
warn "vector at $x, $y: ". Dumper $m->[$x]->[$y];
}
}
This array represents a hexagon like this (ASCII drawing is so cool):
<0,0>
<0,1> <1,0>
<0,2> <1,1> <2,0>
<0,3> <1,2> <2,1> <3,0>
...............................
=item I<as_string>
Not implemented.
=cut
## TODO: pretty printing of this as hexagon ?
sub as_string { die "not implemented"; }
lib/AI/NeuralNet/SOM/Hexa.pm view on Meta::CPAN
our $VERSION = '0.02';
1;
__END__
sub _get_coordinates {
my $self = shift;
my $D1 = $self->{_D}-1;
my $t;
return map { $t = $_ ; map { [ $t, $_ ] } (0 .. $D1) } (0 .. $D1)
}
sqrt ( ($x - $X) ** 2 + ($y - $Y) ** 2 );
lib/AI/NeuralNet/SOM/Rect.pm view on Meta::CPAN
use AI::NeuralNet::SOM::Utils;
=pod
=head1 NAME
AI::NeuralNet::SOM::Rect - Perl extension for Kohonen Maps (rectangular topology)
=head1 SYNOPSIS
use AI::NeuralNet::SOM::Rect;
my $nn = new AI::NeuralNet::SOM::Rect (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 INTERFACE
=head2 Constructor
The constructor takes the following arguments (additionally to those in the base class):
=over
=item C<output_dim> : (mandatory, no default)
A string of the form "3x4" defining the X and the Y dimensions.
=back
Example:
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
=cut
sub new {
my $class = shift;
my %options = @_;
my $self = bless { %options }, $class;
if ($self->{output_dim} =~ /(\d+)x(\d+)/) {
$self->{_X} = $1 and $self->{_Y} = $2;
} else {
die "output dimension does not have format MxN";
}
if ($self->{input_dim} > 0) {
$self->{_Z} = $self->{input_dim};
} else {
die "input dimension must be positive integer";
}
($self->{_R}) = map { $_ / 2 } sort {$b <= $a } ($self->{_X}, $self->{_Y}); # radius
$self->{_Sigma0} = $options{sigma0} || $self->{_R}; # impact distance, start value
$self->{_L0} = $options{learning_rate} || 0.1; # learning rate, start value
return $self;
}
=pod
=head2 Methods
=cut
sub initialize {
my $self = shift;
my @data = @_;
our $i = 0;
my $get_from_stream = sub {
$i = 0 if $i > $#data;
return [ @{ $data[$i++] } ]; # cloning !
} if @data;
$get_from_stream ||= sub {
return [ map { rand( 1 ) - 0.5 } 1..$self->{_Z} ];
};
for my $x (0 .. $self->{_X}-1) {
for my $y (0 .. $self->{_Y}-1) {
$self->{map}->[$x]->[$y] = &$get_from_stream;
}
}
}
sub bmu {
my $self = shift;
my $sample = shift;
my $closest; # [x,y, distance] value and co-ords of closest match
for my $x (0 .. $self->{_X}-1) {
for my $y (0 .. $self->{_Y}-1){
my $distance = AI::NeuralNet::SOM::Utils::vector_distance ($self->{map}->[$x]->[$y], $sample); # || Vi - Sample ||
#warn "distance to $x, $y : $distance";
$closest = [0, 0, $distance] unless $closest;
$closest = [$x, $y, $distance] if $distance < $closest->[2];
}
}
return @$closest;
}
sub neighbors { # http://www.ai-junkie.com/ann/som/som3.html
my $self = shift;
my $sigma = shift;
my $X = shift;
my $Y = shift;
my @neighbors;
for my $x (0 .. $self->{_X}-1) {
for my $y (0 .. $self->{_Y}-1){
my $distance = sqrt ( ($x - $X) * ($x - $X) + ($y - $Y) * ($y - $Y) );
next if $distance > $sigma;
push @neighbors, [ $x, $y, $distance ]; # we keep the distances
}
}
return \@neighbors;
}
=pod
=cut
sub radius {
my $self = shift;
return $self->{_R};
}
=pod
=over
=item I<map>
I<$m> = I<$nn>->map
This method returns the 2-dimensional array of vectors in the grid (as a reference to an array of
references to arrays of vectors). The representation of the 2-dimensional array is straightforward.
Example:
my $m = $nn->map;
for my $x (0 .. 5) {
for my $y (0 .. 4){
warn "vector at $x, $y: ". Dumper $m->[$x]->[$y];
}
}
=cut
sub as_string {
my $self = shift;
my $s = '';
$s .= " ";
for my $y (0 .. $self->{_Y}-1){
$s .= sprintf (" %02d ",$y);
}
$s .= sprintf "\n","-"x107,"\n";
my $dim = scalar @{ $self->{map}->[0]->[0] };
for my $x (0 .. $self->{_X}-1) {
for my $w ( 0 .. $dim-1 ){
$s .= sprintf ("%02d | ",$x);
for my $y (0 .. $self->{_Y}-1){
$s .= sprintf ("% 2.2f ", $self->{map}->[$x]->[$y]->[$w]);
}
$s .= sprintf "\n";
}
$s .= sprintf "\n";
}
return $s;
}
=pod
=item I<as_data>
print I<$nn>->as_data
This methods creates a string containing the raw vector data, row by
row. This can be fed into gnuplot, for instance.
=cut
sub as_data {
my $self = shift;
my $s = '';
my $dim = scalar @{ $self->{map}->[0]->[0] };
for my $x (0 .. $self->{_X}-1) {
for my $y (0 .. $self->{_Y}-1){
for my $w ( 0 .. $dim-1 ){
$s .= sprintf ("\t%f", $self->{map}->[$x]->[$y]->[$w]);
}
$s .= sprintf "\n";
}
}
return $s;
}
=pod
=back
=head1 SEE ALSO
L<http://www.ai-junkie.com/ann/som/som1.html>
lib/AI/NeuralNet/SOM/Torus.pm view on Meta::CPAN
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;
}
}
return \@neighbors;
}
=pod
=head1 SEE ALSO
L<AI::NeuralNet::SOM::Rect>
=head1 AUTHOR
lib/AI/NeuralNet/SOM/Utils.pm view on Meta::CPAN
package AI::NeuralNet::SOM::Utils;
sub vector_distance {
my ($V, $W) = (shift,shift);
# __________________
# / n-1 2
# Distance = / E ( V - W )
# \/ 0 i i
#
#warn "bef dist ".Dumper ($V, $W);
my $d2 = 0;
map { $d2 += $_ }
map { $_ * $_ }
map { $V->[$_] - $W->[$_] }
(0 .. $#$W);
#warn "d2 $d2";
return sqrt($d2);
}
1;
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
BEGIN { use_ok('AI::NeuralNet::SOM::Hexa') };
######
use Data::Dumper;
{
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 6,
input_dim => 3);
ok ($nn->isa ('AI::NeuralNet::SOM::Hexa'), 'class');
is ($nn->{_R}, 3, 'R');
is ($nn->radius, 3, 'radius');
}
{
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 2,
input_dim => 3);
$nn->initialize ( [ 0, 0, 1 ], [ 0, 1, 0 ] );
my $d = $nn->diameter;
for my $x (0 .. $d-1) {
for my $y (0 .. $d-1) {
ok (eq_array ($nn->{map}->[$x]->[$y],
$y == 0 ? [ 0, 0, 1 ] : [ 0, 1, 0 ]), 'value init');
}
}
# warn Dumper $nn;
}
{
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 2,
input_dim => 3);
$nn->initialize;
foreach my $x (0 .. $nn->diameter -1) {
foreach my $y (0 .. $nn->diameter -1 ) {
ok ( (!grep { $_ > 0.5 || $_ < -0.5 } @{ $nn->value ( $x, $y ) }) , "$x, $y: random vectors in [-0.5, 0.5]");
}
}
}
{
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 2,
input_dim => 3);
$nn->initialize ( [ 0, 0, 1 ] );
ok (eq_array ($nn->bmu ([ 1, 1, 1 ]),
[ 1, 1, 0 ]), 'bmu');
}
{
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 6,
input_dim => 3);
# warn Dumper $nn;
ok (eq_array ( $nn->neighbors (1, 3, 2),
[
[2, 1, 1 ],
[2, 2, 1 ],
[3, 1, 1 ],
[3, 2, 0 ],
[3, 3, 1 ],
[4, 2, 1 ],
[4, 3, 1 ]
]), 'neighbors 6+1');
ok (eq_array ( $nn->neighbors (1, 0, 0),
[
[0, 0, 0 ],
[0, 1, 1 ],
[1, 0, 1 ],
[1, 1, 1 ],
]), 'neighbors 3+1');
ok (eq_array ( $nn->neighbors (0, 3, 3),
[
[3, 3, 0 ],
]), 'neighbors 0+1');
}
{
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 3,
input_dim => 3,
sigma0 => 4); # make change network-wide
$nn->initialize ( [ 0, -1, 1 ] );
$nn->train (100, [ 1, 1, 1 ]);
# warn Dumper $nn;
foreach my $x (0 .. $nn->diameter -1) {
foreach my $y (0 .. $nn->diameter -1 ) {
ok ( (! grep { $_ < 0.9 } @{ $nn->value ( $x, $y ) }) , "$x, $y: vector above 0.9");
}
}
}
{
my $nn = new AI::NeuralNet::SOM::Hexa (output_dim => 3,
input_dim => 3);
$nn->initialize ( [ 0, -1, -1 ] );
$nn->train (100, [ 1, 1, 1 ]);
my ($x, $y) = $nn->bmu ([ 1, 1, 1 ]) ;
ok (eq_array ([ $x, $y ],
[ 0, 0 ]), 'bmu after training');
# warn Dumper $nn;
}
__END__
#== TESTS =====================================================================
use strict;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
my @PODs = qw(
lib/AI/NeuralNet/SOM.pm
lib/AI/NeuralNet/SOM/Rect.pm
lib/AI/NeuralNet/SOM/Hexa.pm
lib/AI/NeuralNet/SOM/Torus.pm
);
plan tests => scalar @PODs;
map {
pod_file_ok ( $_, "$_ pod ok" )
} @PODs;
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
BEGIN { use_ok('AI::NeuralNet::SOM::Rect') };
######
use Data::Dumper;
{
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
ok ($nn->isa ('AI::NeuralNet::SOM::Rect'), 'class');
is ($nn->{_X}, 5, 'X');
is ($nn->{_Y}, 6, 'Y');
is ($nn->{_Z}, 3, 'Z');
is ($nn->radius, 2.5, 'radius');
is ($nn->output_dim, "5x6", 'output dim');
}
{
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
$nn->initialize;
# print Dumper $nn;
# exit;
my @vs = ([ 3, 2, 4 ], [ -1, -1, -1 ], [ 0, 4, -3]);
$nn->train (400, @vs);
foreach my $v (@vs) {
ok (_find ($v, $nn->map), 'found learned vector '. join (",", @$v));
}
sub _find {
my $v = shift;
my $m = shift;
use AI::NeuralNet::SOM::Utils;
foreach my $x ( 0 .. 4 ) {
foreach my $y ( 0 .. 5 ) {
return 1 if AI::NeuralNet::SOM::Utils::vector_distance ($m->[$x]->[$y], $v) < 0.01;
}
}
return 0;
}
ok ($nn->as_string, 'pretty print');
ok ($nn->as_data, 'raw format');
# print $nn->as_string;
}
{
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
$nn->initialize;
foreach my $x (0 .. 5 -1) {
foreach my $y (0 .. 6 -1 ) {
ok ( (!grep { $_ > 0.5 || $_ < -0.5 } @{ $nn->value ( $x, $y ) }) , "$x, $y: random vectors in [-0.5, 0.5]");
}
}
}
__END__
# randomized pick
@vectors = ...;
my $get = sub {
return @vectors [ int (rand (scalar @vectors) ) ];
}
$nn->train ($get);
# take exactly 500, round robin, in order
our $i = 0;
my $get = sub {
return undef unless $i < 500;
return @vectors [ $i++ % scalar @vectors ];
}
# Change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
BEGIN { use_ok('AI::NeuralNet::SOM') };
######
use Data::Dumper;
{
use AI::NeuralNet::SOM::Rect; # any non-abstract subclass should do
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3,
);
$nn->value ( 1, 1, [ 1, 1, 1 ] );
ok (eq_array ($nn->value ( 1, 1),
[ 1, 1, 1 ]), 'value set/get');
$nn->label ( 1, 1, 'rumsti' );
is ($nn->label ( 1, 1), 'rumsti', 'label set/get');
is ($nn->label ( 1, 0), undef, 'label set/get');
}
{
my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
input_dim => 3);
$nn->initialize;
my @vs = ([ 3, 2, 4 ], [ -1, -1, -1 ], [ 0, 4, -3]);
my $me = $nn->mean_error (@vs);
for (1 .. 40) {
$nn->train (50, @vs);
ok ($me >= $nn->mean_error (@vs), 'mean error getting smaller');
$me = $nn->mean_error (@vs);
# warn $me;
}
foreach (1..3) {
my @mes = $nn->train (20, @vs);
is (scalar @mes, 3 * 20, 'errors while training, nr');
ok ((!grep { $_ > 10 * $me } @mes), 'errors while training, none significantly bigger');
}
}
__END__
# randomized pick
@vectors = ...;
my $get = sub {
return @vectors [ int (rand (scalar @vectors) ) ];
}
$nn->train ($get);
# take exactly 500, round robin, in order
our $i = 0;
my $get = sub {
return undef unless $i < 500;
return @vectors [ $i++ % scalar @vectors ];
}
# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More qw(no_plan);
BEGIN { use_ok('AI::NeuralNet::SOM::Torus') };
######
use Data::Dumper;
{
my $nn = new AI::NeuralNet::SOM::Torus (output_dim => "5x6",
input_dim => 3);
ok ($nn->isa ('AI::NeuralNet::SOM::Torus'), 'class');
is ($nn->{_X}, 5, 'X');
is ($nn->{_Y}, 6, 'Y');
is ($nn->{_Z}, 3, 'Z');
is ($nn->radius, 2.5, 'radius');
is ($nn->output_dim, "5x6", 'output dim');
}
{
my $nn = new AI::NeuralNet::SOM::Torus (output_dim => "5x6",
input_dim => 3);
ok (eq_set ( $nn->neighbors (1, 0, 0),
[
[ 0, 0, '0' ],
[ 0, 1, '1' ],
[ 0, 5, '1' ],
[ 1, 0, '1' ],
[ 4, 0, '1' ]
]), 'neighbors 4+1');
ok (eq_set ( $nn->neighbors (1, 3, 2),
[
[ 2, 2, '1' ],
[ 3, 1, '1' ],
[ 3, 2, '0' ],
[ 3, 3, '1' ],
[ 4, 2, '1' ]
]), 'neighbors 4+1');
}
{
my $nn = new AI::NeuralNet::SOM::Torus (output_dim => "5x6",
input_dim => 3);
$nn->initialize;
# print Dumper $nn;
# exit;
my @vs = ([ 3, 2, 4 ], [ -1, -1, -1 ], [ 0, 4, -3]);
$nn->train (400, @vs);
foreach my $v (@vs) {
ok (_find ($v, $nn->map), 'found learned vector '. join (",", @$v));
}
sub _find {
my $v = shift;
my $m = shift;
use AI::NeuralNet::SOM::Utils;
foreach my $x ( 0 .. 4 ) {
foreach my $y ( 0 .. 5 ) {
return 1 if AI::NeuralNet::SOM::Utils::vector_distance ($m->[$x]->[$y], $v) < 0.01;
}
}
return 0;
}
ok ($nn->as_string, 'pretty print');
ok ($nn->as_data, 'raw format');
# print $nn->as_string;
}
__END__
# randomized pick
@vectors = ...;
my $get = sub {
return @vectors [ int (rand (scalar @vectors) ) ];
}
$nn->train ($get);
# take exactly 500, round robin, in order
our $i = 0;
my $get = sub {
return undef unless $i < 500;
return @vectors [ $i++ % scalar @vectors ];
}
( run in 0.340 second using v1.01-cache-2.11-cpan-4d50c553e7e )