view release on metacpan or search on metacpan
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
The current learning rate.
=item map_dim_a
Average of the map dimensions.
=back
=cut
sub new {
my $class = shift;
my %args = @_;
my $self = bless \%args,$class;
$self->{missing_mask} = 'x' unless defined $self->{missing_mask};
$self->_process_table if defined $self->{table}; # Creates {input}
$self->load_input($self->{input_file}) if defined $self->{input_file}; # Creates {input}
if (not defined $self->{input}){
cluck "No {input} supplied!";
return undef;
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
=head1 METHOD randomise_map
Populates the C<map> with nodes that contain random real nubmers.
See L<AI::NerualNet::Kohonen::Node/CONSTRUCTOR new>.
=cut
sub randomise_map { my $self=shift;
confess "{weight_dim} not set" unless $self->{weight_dim};
confess "{map_dim_x} not set" unless $self->{map_dim_x};
confess "{map_dim_y} not set" unless $self->{map_dim_y};
for my $x (0..$self->{map_dim_x}){
$self->{map}->[$x] = [];
for my $y (0..$self->{map_dim_y}){
$self->{map}->[$x]->[$y] = new AI::NeuralNet::Kohonen::Node(
dim => $self->{weight_dim},
missing_mask => $self->{missing_mask},
);
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
}
=head1 METHOD clear_map
As L<METHOD randomise_map> but sets all C<map> nodes to
either the value supplied as the only paramter, or C<undef>.
=cut
sub clear_map { my $self=shift;
confess "{weight_dim} not set" unless $self->{weight_dim};
confess "{map_dim_x} not set" unless $self->{map_dim_x};
confess "{map_dim_y} not set" unless $self->{map_dim_y};
my $val = shift || $self->{missing_mask};
my $w = [];
foreach (0..$self->{weight_dim}){
push @$w, $val;
}
for my $x (0..$self->{map_dim_x}){
$self->{map}->[$x] = [];
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
At the end of every generation, the learning rate is decayed
(see L</PRIVATE METHOD _decay_learning_rate>).
See C<CONSTRUCTOR new> for details of applicable callbacks.
Returns a true value.
=cut
sub train { my ($self,$epochs) = (shift,shift);
$epochs = $self->{epochs} unless defined $epochs;
&{$self->{train_start}} if exists $self->{train_start};
for my $epoch (1..$epochs){
$self->{t} = $epoch;
&{$self->{epoch_start}} if exists $self->{epoch_start};
for (0..$#{$self->{input}}){
my $target = $self->_select_target;
my $bmu = $self->find_bmu($target);
$self->_adjust_neighbours_of($bmu,$target);
}
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
I<x> and I<y> co-ordinate in the map
=back
See L</METHOD get_weight_at>,
and L<AI::NeuralNet::Kohonen::Node/distance_from>,
=cut
sub find_bmu { my ($self,$target) = (shift,shift);
my $closest = []; # [value, x,y] value and co-ords of closest match
for my $x (0..$self->{map_dim_x}){
for my $y (0..$self->{map_dim_y}){
my $distance = $self->{map}->[$x]->[$y]->distance_from( $target );
$closest = [$distance,0,0] if $x==0 and $y==0;
$closest = [$distance,$x,$y] if $distance < $closest->[0];
}
}
return $closest;
}
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
Returns a reference to the weight array at the supplied I<x>,I<y>
co-ordinates.
Accepts: I<x>,I<y> co-ordinates, each a scalar.
Returns: reference to an array that is the weight of the node, or
C<undef> on failure.
=cut
sub get_weight_at { my ($self,$x,$y) = (shift,shift,shift);
return undef if $x<0 or $y<0 or $x>$self->{map_dim_x} or $y>$self->{map_dim_y};
return $self->{map}->[$x]->[$y]->{weight};
}
=head1 METHOD get_results
Finds and returns the results for all input vectors in the supplied
reference to an array of arrays,
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
If no array reference of input vectors is supplied, will use
the values in the C<input> field.
Individual results are in the array format as described in
L<METHOD find_bmu>.
See L<METHOD find_bmu>, and L</METHOD get_weight_at>.
=cut
sub get_results { my ($self,$targets)=(shift,shift);
$self->{results} = [];
if (not defined $targets){
$targets = $self->{input};
} elsif (not $targets eq $self->{input}){
foreach (@$targets){
next if ref $_ eq 'AI::NeuralNet::Kohonen::Input';
$_ = new AI::NeuralNet::Kohonen::Input(values=>$_);
}
}
foreach my $target (@{ $targets}){
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
Clears the C<map> and fills it with the results.
The sole paramter is passed to the L<METHOD clear_map>.
L<METHOD get_results> is then called, and the results
returned fed into the object field C<map>.
This may change, as it seems misleading to re-use that field.
=cut
sub map_results { my $self=shift;
}
=head1 METHOD dump
Print the current weight values to the screen.
=cut
sub dump { my $self=shift;
print " ";
for my $x (0..$self->{map_dim_x}){
printf (" %02d ",$x);
}
print"\n","-"x107,"\n";
for my $x (0..$self->{map_dim_x}){
for my $w (0..$self->{weight_dim}){
printf ("%02d | ",$x);
for my $y (0..$self->{map_dim_y}){
printf("%.2f ", $self->{map}->[$x]->[$y]->{weight}->[$w]);
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
Accepts: the length of the side of the square gaussian mask to apply.
If not supplied, uses the value in the field C<smoothing>; if that is
empty, uses the square root of the average of the map dimensions
(C<map_dim_a>).
Returns: a true value.
=cut
sub smooth { my ($self,$smooth) = (shift,shift);
$smooth = $self->{smoothing} if not $smooth and defined $self->{smoothing};
return unless $smooth;
$smooth = int( sqrt $self->{map_dim_a} );
my $mask = _make_gaussian_mask($smooth);
# For every weight at every point
for my $x (0..$self->{map_dim_x}){
for my $y (0..$self->{map_dim_y}){
for my $w (0..$self->{weight_dim}){
# Apply the mask
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
with an C<input_file> field.
Requires: a path to a file.
Returns C<undef> on failure.
See L</FILE FORMAT>.
=cut
sub load_input { my ($self,$path) = (shift,shift);
local *IN;
if (not open IN,$path){
warn "Could not open file <$path>: $!";
return undef;
}
@_ = <IN>;
close IN;
$self->_process_input_text(\@_);
return 1;
}
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
=head1 METHOD save_file
Saves the map file in I<SOM_PAK> format (see L<METHOD load_input>)
at the path specified in the first argument.
Return C<undef> on failure, a true value on success.
=cut
sub save_file { my ($self,$path) = (shift,shift);
local *OUT;
if (not open OUT,">$path"){
warn "Could not open file for writing <$path>: $!";
return undef;
}
#- Dimensionality of the vectors (integer, compulsory).
print OUT ($self->{weight_dim}+1)," "; # Perl indexing
#- Topology type, either hexa or rect (string, optional, case-sensitive).
if (not defined $self->{display}){
print OUT "rect ";
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
print OUT chr 26;
close OUT;
return 1;
}
#
# Process ASCII from table field or input file
# Accepts: ASCII as array or array ref
#
sub _process_input_text { my ($self) = (shift);
if (not defined $_[1]){
if (ref $_[0] eq 'ARRAY'){
@_ = @{$_[0]};
} else {
@_ = split/[\n\r\f]+/,$_[0];
}
}
chomp @_;
my @specs = split/\s+/,(shift @_);
#- Dimensionality of the vectors (integer, compulsory).
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
=head1 PRIVATE METHOD _select_target
Return a random target from the training set in the C<input> field,
unless the C<targeting> field is defined, when the targets are
iterated over.
=cut
sub _select_target { my $self=shift;
if (not $self->{targeting}){
return $self->{input}->[
(int rand(scalar @{$self->{input}}))
];
}
else {
$self->{tar}++;
if ($self->{tar}>$#{ $self->{input} }){
$self->{tar} = 0;
}
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
W(t+1) = W(t) + THETA(t) L(t)( V(t)-W(t) )
Where C<L> is the learning rate, C<V> the target vector,
and C<W> the weight. THETA(t) represents the influence
of distance from the BMU upon a node's learning, and
is calculated by the C<Node> class - see
L<AI::NeuralNet::Kohonen::Node/distance_effect>.
=cut
sub _adjust_neighbours_of { my ($self,$bmu,$target) = (shift,shift,shift);
my $neighbour_radius = int (
($self->{map_dim_a}/$self->{neighbour_factor}) * exp(- $self->{t} / $self->{time_constant})
);
# Distance from co-ord vector (0,0) as integer
# Basically map_width * y + x
my $centre = ($self->{map_dim_a}*$bmu->[2])+$bmu->[1];
# Set the class of the BMU
$self->{map}->[ $bmu->[1] ]->[ $bmu->[2] ]->{class} = $target->{class};
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
=head1 PRIVATE METHOD _decay_learning_rate
Performs a gaussian decay upon the learning rate (our C<l> field).
( t )
L(t) = L exp ( - ------ )
0 ( lambda )
=cut
sub _decay_learning_rate { my $self=shift;
$self->{l} = (
$self->{learning_rate} * exp(- $self->{t} / $self->{time_constant})
);
}
=head1 PRIVATE FUNCTION _make_gaussian_mask
Accepts: size of mask.
Returns: reference to a 2d array that is the mask.
=cut
sub _make_gaussian_mask { my ($smooth) = (shift);
my $f = 4; # Cut-off threshold
my $g_mask_2d = [];
for my $x (0..$smooth){
$g_mask_2d->[$x] = [];
for my $y (0..$smooth){
$g_mask_2d->[$x]->[$y] =
_gauss_weight( $x-($smooth/2), $smooth/$f)
* _gauss_weight( $y-($smooth/2), $smooth/$f );
}
}
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
Accepts: two paramters: the first, C<r>, gives the distance from the mask centre,
the second, C<sigma>, specifies the width of the mask.
Returns the gaussian weight.
See also L<_decay_learning_rate>.
=cut
sub _gauss_weight { my ($r, $sigma) = (shift,shift);
return exp( -($r**2) / (2 * $sigma**2) );
}
=head1 PUBLIC METHOD quantise_error
Returns the quantise error for either the supplied points,
or those in the C<input> field.
=cut
sub quantise_error { my ($self,$targets) = (shift,shift);
my $qerror=0;
if (not defined $targets){
$targets = $self->{input};
} else {
foreach (@$targets){
if (not ref $_ or ref $_ ne 'ARRAY'){
croak "Supplied target parameter should be an array of arrays!"
}
$_ = new AI::NeuralNet::Kohonen::Input(values=>$_);
}
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
Adds to the C<input> field an input vector in SOM_PAK-format
whitespace-delimited ASCII.
Returns C<undef> on failure to add an item (perhaps because
the data passed was a comment, or the C<weight_dim> flag was
not set); a true value on success.
=cut
sub _add_input_from_str { my ($self) = (shift);
$_ = shift;
s/#.*$//g;
return undef if /^$/ or not defined $self->{weight_dim};
my @i = split /\s+/,$_;
return undef if $#i < $self->{weight_dim}; # catch bad lines
# 'x' in files signifies unknown: we prefer undef?
# @i[0..$self->{weight_dim}] = map{
# $_ eq 'x'? undef:$_
# } @i[0..$self->{weight_dim}];
my %args = (
lib/AI/NeuralNet/Kohonen.pm view on Meta::CPAN
$args{fixed} = $i[$self->{weight_dim}+1] if $i[$self->{weight_dim}+3];
push @{$self->{input}}, new AI::NeuralNet::Kohonen::Input(%args);
return 1;
}
#
# Processes the 'table' paramter to the constructor
#
sub _process_table { my $self = shift;
$_ = $self->_process_input_text( $self->{table} );
undef $self->{table};
return $_;
}
__END__
1;
=head1 FILE FORMAT
lib/AI/NeuralNet/Kohonen/Input.pm view on Meta::CPAN
with unknown values having the value C<undef>.
=item class
Optional class label string for this input vector.
=back
=cut
sub new {
my $class = shift;
my %args = @_;
my $self = bless \%args,$class;
if (not defined $self->{values}){
if (not defined $self->{dim}){
cluck "No {dim} or {weight}!";
return undef;
}
$self->{values} = [];
} elsif (not ref $self->{values}){
lib/AI/NeuralNet/Kohonen/Node.pm view on Meta::CPAN
The values of the vector. Use C<x> for unknown values.
=item missing_mask
Used to donate missing input in the node. Default is C<x>.
=back
=cut
sub new {
my $class = shift;
my %args = @_;
my $self = bless \%args,$class;
$self->{missing_mask} = 'x' unless defined $self->{missing_mask};
if (not defined $self->{weight}){
if (not defined $self->{dim}){
cluck "No {dim} or {weight}!";
return undef;
}
$self->{weight} = [];
lib/AI/NeuralNet/Kohonen/Node.pm view on Meta::CPAN
__________________
/ i=n 2
Distance = / E ( V - W )
\/ i=0 i i
Where C<V> is the current input vector, and
C<W> is this node's weight vector.
=cut
sub distance_from { my ($self,$target) = (shift,shift);
if (not defined $target or not ref $target or ref $target ne 'AI::NeuralNet::Kohonen::Input'){
cluck "distance_from requires a target ::Input object!";
return undef;
}
if ($#{$target->{values}} != $self->{dim}){
croak "distance_from requires the target's {value} field dim match its own {dim}!\n"
."(".($#{$target->{values}})." v {".$self->{dim}."} ) ";
}
my $distance = 0;
for (my $i=0; $i<=$self->{dim}; ++$i){
lib/AI/NeuralNet/Kohonen/Node.pm view on Meta::CPAN
Where C<distance> is the distance of the node from the BMU,
and C<sigma> is the width of the neighbourhood as calculated
elsewhere (see L<AI::NeuralNet::Kohonen/FINDING THE NEIGHBOURS OF THE BMU>). THETA also
decays over time.
The time C<t> is always that of the calling object, and is not referenced here.
=cut
sub distance_effect { my ($self,$distance,$sigma) = (shift,shift,shift);
confess "Wrong args" unless defined $distance and defined $sigma;
return exp (-($distance*$distance) / 2 * ($sigma*$sigma))
}
1;
__END__
=head1 SEE ALSO
t/AI-NeuralNet-Kohonen.t view on Meta::CPAN
my $input = new AI::NeuralNet::Kohonen::Input(
dim => 2,
values => [1,0,0],
);
is( sprintf("%.2f",$node->distance_from($input)), 1.19);
$net = AI::NeuralNet::Kohonen->new(
map_dim_x => 14,
map_dim_y => 10,
epoch_end => sub {print"."},
train_end => sub {print"\n"},
epochs => 2,
table =>
"3
1 0 0 red
0 1 0 green
0 0 1 blue
",
);
isa_ok( $net->{input}, 'ARRAY');
isa_ok( $net->{input}->[0],'AI::NeuralNet::Kohonen::Input');
t/AI-NeuralNet-Kohonen.t view on Meta::CPAN
}
SKIP: {
skip 'Lost the input file',9;
# Input file tests\n";
$net = AI::NeuralNet::Kohonen->new(
epochs => 0,
input_file => $dir.'ex.dat',
epoch_end => sub {print"."},
train_end => sub {print"\n"},
);
isa_ok( $net,'AI::NeuralNet::Kohonen');
isa_ok( $net->{input}, 'ARRAY');
is( scalar @{$net->{input}}, 3840);
is( $net->{map_dim_x}, 19);
is ($net->{input}->[$#{$net->{input}}]->{values}->[4], 406.918518);
is( ref $net->{input}->[$#{$net->{input}}]->{values}, 'ARRAY');
diag "Training on a big file: this is SLOW, sorry\n";
is($net->train,1);
my $filename = substr(time,0,8);
ok($net->save_file($filename),"Saved file as ".$filename);
ok(unlink($filename),'Unlinked test file '.$filename);
}
sub BAIL_OUT {
diag "BAIL_OUT:",@_? @_ : "";
exit;
}