sub\s results from the CPAN

sub\s

AI-NeuralNet-Kohonen

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;
}

( run in 0.785 second using v1.01-cache-2.11-cpan-a5abf4f5562 )