AI-NeuralNet-Kohonen-Demo-RGB
view release on metacpan or search on metacpan
-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.
( run in 0.851 second using v1.01-cache-2.11-cpan-39bf76dae61 )