AI-NeuralNet-Kohonen-Demo-RGB
view release on metacpan or search on metacpan
Revision history for Perl extension AI::NeuralNet::Kohonen::Demo::RGB.
0.011 Thu Mar 13 18:21:37 2003
Added unified distance matrix display.
0.01 Thu Mar 13 12:21:37 2003
- original version; created by h2xs 1.21 with options
-X -n AI::NeuralNet::Kohonen::Demo::RGB
Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'AI::NeuralNet::Kohonen::Demo::RGB',
'VERSION_FROM' => 'RGB.pm', # finds $VERSION
'PREREQ_PM' => {
AI::NeuralNet::Kohonen => 0.11,
Tk => 0.1,
Tk::Canvas => 0.1,
Tk::Label => 0.1,
},
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'RGB.pm', # retrieve abstract from module
AUTHOR => 'Lee Goddard <lgoddard@cpan.org>') : ()),
);
AI/NeuralNet/Kohonen/Demo/RGB version 0.01
==========================================
use AI::NeuralNet::Kohonen::Demo::RGB;
$_ = AI::NeuralNet::Kohonen::Demo::RGB->new(
map_dim => 39,
epochs => 9,
table => "R G B"
."1 0 0"
."0 1 0"
."0 0 1",
);
$_->train;
exit;
A sub-class of "AI::NeuralNet::Kohonen" that Impliments extra methods
for make use of TK in a very slow demonstration of how a SOM can
classify RGB colours. See the SYNOPSIS manpage.
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
This module requires these other modules and libraries:
AI::NeuralNet::Kohonen
Tk
Tk::Canvas
Tk::Label
SEE ALSO
See the AI::NeuralNet::Kohonen manpage; the AI::NeuralNet::Kohonen::Node
manpage;
AUTHOR AND COYRIGHT
This implimentation Copyright (C) Lee Goddard, 2003. All Rights
Reserved.
Available under the same terms as Perl itself.
package AI::NeuralNet::Kohonen::Demo::RGB;
use vars qw/$VERSION/;
$VERSION = 0.123; # 13 March 2003; using smoothing
=head1 NAME
AI::NeuralNet::Kohonen::Demo::RGB - Colour-based demo
=head1 SYNOPSIS
use AI::NeuralNet::Kohonen::Demo::RGB;
$_ = AI::NeuralNet::Kohonen::Demo::RGB->new(
display_scale => 20,
display => 'hex',
map_dim => 39,
epochs => 9,
table => "R G B"
."1 0 0"
."0 1 0"
."0 0 1",
);
$_->train;
exit;
=head1 DESCRIPTION
A sub-class of C<AI::NeuralNet::Kohonen>
that impliments extra methods to make use of TK
in a very slow demonstration of how a SOM can collapse
a three dimensional space (RGB colour values) into a
two dimensional space (the display). See L<SYNOPSIS>.
The only things added are two new fields to supply to the
constructor - set C<display> to C<hex> for display as
a unified distance matrix, rather than plain grid; set
C<display_scale> for the size of the display.
=cut
use strict;
use warnings;
use Carp qw/cluck carp confess croak/;
use base "AI::NeuralNet::Kohonen";
use Tk;
use Tk::Canvas;
use Tk::Label;
use Tk qw/DoOneEvent DONT_WAIT/;
#
# Used only by &tk_train
#
sub tk_show { my $self=shift;
for my $x (0..$self->{map_dim_x}){
for my $y (0..$self->{map_dim_y}){
my $colour = sprintf("#%02x%02x%02x",
(int (255 * $self->{map}->[$x]->[$y]->{weight}->[0])),
(int (255 * $self->{map}->[$x]->[$y]->{weight}->[1])),
(int (255 * $self->{map}->[$x]->[$y]->{weight}->[2])),
);
if ($self->{display} and $self->{display} eq 'hex'){
my $xo = ($y % 2) * ($self->{display_scale}/2);
my $yo = 0;
$self->{c}->create(
polygon => [
$xo + ((1+$x)*$self->{display_scale} ),
$yo + ((1+$y)*$self->{display_scale} ),
# polygon only:
$xo + ((1+$x)*($self->{display_scale})+($self->{display_scale}/2) ),
$yo + ((1+$y)*($self->{display_scale})-($self->{display_scale}/2) ),
#
$xo + ((1+$x)*($self->{display_scale})+$self->{display_scale} ),
$yo + ((1+$y)*$self->{display_scale} ),
$xo + ((1+$x)*($self->{display_scale})+$self->{display_scale} ),
$yo + ((1+$y)*($self->{display_scale})+($self->{display_scale}/2) ),
# Polygon only:
$xo + ((1+$x)*($self->{display_scale})+($self->{display_scale}/2) ),
$yo + ((1+$y)*($self->{display_scale})+($self->{display_scale}) ),
#
$xo + ((1+$x)*$self->{display_scale} ),
$yo + ((1+$y)*($self->{display_scale})+($self->{display_scale}/2) ),
],
-outline => "black",
-fill => $colour,
);
}
else {
$self->{c}->create(
rectangle => [
(1+$x)*$self->{display_scale} ,
(1+$y)*$self->{display_scale} ,
(1+$x)*($self->{display_scale})+$self->{display_scale} ,
(1+$y)*($self->{display_scale})+$self->{display_scale}
],
-outline => "black",
-fill => $colour,
);
}
}
}
return 1;
}
=head1 METHOD train
Over-rides the base class to provide TK displays of the map
=cut
sub train { my ($self,$epochs) = (shift,shift);
my $label_txt;
$epochs = $self->{epochs} unless defined $epochs;
$self->{display_scale} = 10 if not defined $self->{display_scale};
$self->{mw} = MainWindow->new(
-width => 200+($self->{map_dim_x} * $self->{display_scale}),
-height => 200+($self->{map_dim_y} * $self->{display_scale}),
);
my $quit_flag = 0;
my $quit_code = sub {$quit_flag = 1};
$self->{mw}->protocol('WM_DELETE_WINDOW' => $quit_code);
$self->{c} = $self->{mw}->Canvas(
-width => 50+($self->{map_dim_x} * $self->{display_scale}),
-height => 50+($self->{map_dim_y} * $self->{display_scale}),
-relief => 'ridge',
-border => 5,
);
$self->{c}->pack(-side=>'top');
my $l = $self->{mw}->Label(-text => ' ',-textvariable=>\$label_txt);
$l->pack(-side=>'left');
# Replaces Tk's MainLoop
for (0..$self->{epochs}) {
if ($quit_flag) {
$self->{mw}->destroy;
return;
}
$self->{t}++; # Measure epoch
my $target = $self->_select_target;
my $bmu = $self->find_bmu($target);
$self->_adjust_neighbours_of($bmu,$target);
$self->_decay_learning_rate;
$self->tk_show;
$label_txt = sprintf("Epoch: %04d",$self->{t})." "
. "Learning: $self->{l} "
. sprintf("BMU: %02d,%02d",$bmu->[1],$bmu->[2])." "
. "Target: [".join(",",@$target)."] "
;
$self->{c}->update;
$l->update;
DoOneEvent(DONT_WAIT); # be kind and process XEvents if they arise
}
$label_txt = "Did $self->{t} epochs: now smoothed by "
.($self->{smoothing}? $self->{smoothing} : "default amount");
$_->smooth;
# MainLoop;
return 1;
}
1;
__END__
=head1 SEE ALSO
See
L<AI::NeuralNet::Kohonen>;
L<AI::NeuralNet::Kohonen::Node>;
=head1 AUTHOR AND COYRIGHT
This implimentation Copyright (C) Lee Goddard, 2003.
All Rights Reserved.
Available under the same terms as Perl itself.
package RGB_test;
use lib "../../../..";
use Test;
BEGIN { plan test => 12}
use AI::NeuralNet::Kohonen::Demo::RGB;
ok(1,1);
$_ = new AI::NeuralNet::Kohonen;
ok ($_,undef);
$_ = new AI::NeuralNet::Kohonen::Demo::RGB(
input => [
[1,2,3]
],
);
ok( ref $_->{input}, 'ARRAY');
ok( $_->{input}->[0]->[0],1);
ok( $_->{input}->[0]->[1],2);
ok( $_->{input}->[0]->[2],3);
$_ = AI::NeuralNet::Kohonen::Demo::RGB->new(
map_dim => 39,
epochs => 3,
table=>
"R G B
1 0 0
0 1 0
0 0 1
",
);
ok( ref $_->{input}, 'ARRAY');
ok( $_->{input}->[0]->[0],1);
ok( $_->{input}->[0]->[1],0);
ok( $_->{input}->[0]->[2],0);
ok( $_->{weight_dim}, 2);
$_->train;
$_ = AI::NeuralNet::Kohonen::Demo::RGB->new(
display_scale => 10,
display => 'hex',
map_dim => 39,
epochs => 9,
table=>
"R G B
1 0 0
0 1 0
0 0 1
",
);
ok( ref $_->{input}, 'ARRAY');
ok( $_->{input}->[0]->[0],1);
ok( $_->{input}->[0]->[1],0);
ok( $_->{input}->[0]->[2],0);
ok( $_->{weight_dim}, 2);
$_->train;
ok(1,1);
__END__
( run in 0.266 second using v1.01-cache-2.11-cpan-4d50c553e7e )