view release on metacpan or  search on metacpan

lib/AI/NeuralNet/Kohonen/Visual.pm  view on Meta::CPAN

			0 1 1 cyan
			1 1 0 yellow
			1 .5 0 orange
			1 .5 1 pink",
	);
	$net->train;
	$net->plot_map;
	$net->main_loop;

	exit;


=head1 DESCRIPTION

Provides TK-based visualisation routines for C<AI::NueralNet::Kohonen>.
Replaces the earlier C<AI::NeuralNet::Kohonen::Demo::RGB>.

This is a sub-class of C<AI::NeuralNet::Kohonen>
that impliments extra methods to make use of TK.

This moudle is itself intended to be sub-classed by you,
where you provide a version of the method C<get_colour_for>:
see L<METHOD get_colour_for> and L<SYNOPSIS> for details.


=head1 CONSTRUCTOR (new)

The following paramter fields are added to the base module's fields:

=over 4

=item display

Set to C<hex> for display as a unified distance matrix, rather than
as the default plain grid;

=item display_scale

Set with a factor to effect the size of the display.

=item show_bmu

Show the current BMU during training.

=item show_training

Display updates during training.

=item label_bmu

=item label_all

Displays labels...

=item MainLoop

Calls TK's C<MainLoop> at the end of training.

=item missing_colour

When selecting a colour using L<METHOD get_colour_for>,
every node weight holding the value of C<missing_mask>
will be given the value of this paramter. If this paramter
is not defined, the default is 0.

=back

=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/;



=head1 METHOD train

Over-rides the base class to provide TK displays of the map.

=cut

sub train { my ($self,$epochs) = (shift,shift);
	$epochs = $self->{epochs} unless defined $epochs;
	$self->{display_scale} = 10 if not defined 	$self->{display_scale};

	&{$self->{train_start}} if exists $self->{train_start};

	$self->prepare_display if not defined $self->{_mw} or ref $self->{_mw} ne 'MainWindow';

	# Replaces Tk's MainLoop
    for (0..$self->{epochs}) {
		if ($self->{_quit_flag}) {
			$self->{_mw}->destroy;
			$self->{_mw} = undef;
			return;
		}
		$self->{t}++;				# Measure 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);

			if (exists $self->{show_training}){
				if ($self->{show_bmu}){
					$self->plot_map(bmu_x=>$bmu->[1],bmu_y=>$bmu->[2]);
				} else {
					$self->plot_map;
				}
				$self->{_label_txt} = sprintf("Epoch: %04d",$self->{t})."  "
				. "Learning: $self->{l}  "
				. sprintf("BMU: %02d,%02d",$bmu->[1],$bmu->[2])."  "
				.( exists $target->{class}? "Target: [$target->{class}]  " : "")
				;
				$self->{_canvas}->update;
				$self->{_label}->update;
				DoOneEvent(DONT_WAIT);		# be kind and process XEvents if they arise
			}
		}

		$self->_decay_learning_rate;
 		&{$self->{epoch_end}} if exists $self->{epoch_end};
	}

	$self->{_label_txt} = "Did $self->{t} epochs: ";
	$self->{_label_txt} .= "now smoothed." if $self->{smoothing};
	$_->smooth if $self->{smooth};
	$self->plot_map if $self->{MainLoop};
	&{$self->{train_end}} if exists $self->{train_end};
	MainLoop if $self->{MainLoop};

	return 1;
}

=head1 METHOD get_colour_for

This method is intended to be sub-classed.

Currently it only operates on the first three elements
of a weight vector, turning them into RGB values.

It returns the a TK colour for a node at position C<x>,C<y> in the
C<map> paramter.

Accepts: C<x> and C<y> co-ordinates in the map.

=cut

sub get_colour_for { my ($self,$x,$y) = (shift,shift,shift);
	my $_0 = $self->{map}->[$x]->[$y]->{weight}->[0];
	$_0 = $self->{missing_colour} || 0 if $_0 eq $self->{missing_mask};
	my $_1 = $self->{map}->[$x]->[$y]->{weight}->[1];
	$_1 = $self->{missing_colour} || 0 if $_1 eq $self->{missing_mask};
	my $_2 = $self->{map}->[$x]->[$y]->{weight}->[2];
	$_2 = $self->{missing_colour} || 0 if $_2 eq $self->{missing_mask};
	return sprintf("#%02x%02x%02x",
		(int (255 * $_0)),
		(int (255 * $_1)),
		(int (255 * $_2)),