File Coverage

blib/lib/AI/NeuralNet/Kohonen.pm

Criterion	Covered	Total	%
statement	159	259	61.3
branch	59	122	48.3
condition	13	44	29.5
subroutine	18	27	66.6
pod	0	13	0.0
total	249	465	53.5

line

stmt

bran

cond

sub

pod

time

code

package AI::NeuralNet::Kohonen;

1464

use vars qw/$VERSION/;

$VERSION = 0.142; # 08 August 2006 test lost input file

=head1 NAME

AI::NeuralNet::Kohonen - Kohonen's Self-organising Maps

=cut

use strict;

use warnings;

use Carp qw/croak cluck confess/;

100

893

use AI::NeuralNet::Kohonen::Node;

868

use AI::NeuralNet::Kohonen::Input;

4107

=head1 SYNOPSIS

$_ = AI::NeuralNet::Kohonen->new(

map_dim_x => 39,

map_dim_y => 19,

epochs => 100,

table =>

1 0 0 red

0 1 0 yellow

0 0 1 blue

0 1 1 cyan

1 1 0 yellow

1 .5 0 orange

1 .5 1 pink"

);

$_->train;

$_->save_file('mydata.txt');

exit;

=head1 DESCRIPTION

An illustrative implimentation of Kohonen's Self-organising Feature Maps (SOMs)

in Perl. It's not fast - it's illustrative. In fact, it's slow: but it is illustrative....

Have a look at L for an example of

visualisation of the map.

I'll maybe add some more text here later.

=head1 DEPENDENCIES

AI::NeuralNet::Kohonen::Node

AI::NeuralNet::Kohonen::Input

=head1 EXPORTS

None

=head1 CONSTRUCTOR new

Instantiates object fields:

=over 4

=item input_file

A I training file to load. This does not prevent

other input methods (C, C) being processed, but

it does over-ride any specifications (C) which may

have been explicitly handed to the constructor.

See also C.

82
83							=item table
84
85							The contents of a file of the format that could be supplied to
86							the C field.
87
88							=item input_names
89
90							A name for each dimension of the input vectors.
91
92							=item map_dim_x
93
94							=item map_dim_y
95
96							The dimensions of the feature map to create - defaults to a toy 19.
97							(note: this is Perl indexing, starting at zero).
98
99							=item epochs
100
101							Number of epochs to run for (see L).
102							Minimum number is C<1>.
103
104							=item learning_rate
105
106							The initial learning rate.
107
108							=item train_start
109
110							Reference to code to call at the begining of training.
111
112							=item epoch_start
113
114							Reference to code to call at the begining of every epoch
115							(such as a colour calibration routine).
116
117							=item epoch_end
118
119							Reference to code to call at the end of every epoch
120							(such as a display routine).
121
122							=item train_end
123
124							Reference to code to call at the end of training.
125
126							=item targeting
127
128							If undefined, random targets are chosen; otherwise
129							they're iterated over. Just for experimental purposes.
130
131							=item smoothing
132
133							The amount of smoothing to apply by default when C
134							is applied (see L).
135
136							=item neighbour_factor
137
138							When working out the size of the neighbourhood of influence,
139							the average of the dimensions of the map are divided by this variable,
140							before the exponential function is applied: the default value is 2.5,
141							but you may with to use 2 or 4.
142
143							=item missing_mask
144
145							Used to signify data is missing in an input vector. Defaults
146							to C.
147
148							=back
149
150							Private fields:
151
152							=over 4
153
154							=item time_constant
155
156							The number of iterations (epochs) to be completed, over the log of the map radius.
157
158							=item t
159
160							The current epoch, or moment in time.
161
162							=item l
163
164							The current learning rate.
165
166							=item map_dim_a
167
168							Average of the map dimensions.
169
170							=back
171
172							=cut
173
174							sub new {
175	4			4	0	4300	my $class = shift;
176	4					17	my %args = @_;
177	4					15	my $self = bless \%args,$class;
178
179	4	50				24	$self->{missing_mask} = 'x' unless defined $self->{missing_mask};
180	4	100				16	$self->_process_table if defined $self->{table}; # Creates {input}
181	4	50				12	$self->load_input($self->{input_file}) if defined $self->{input_file}; # Creates {input}
182	4	100				14	if (not defined $self->{input}){
183	1					228	cluck "No {input} supplied!";
184	1					16	return undef;
185							}
186
187	3	100				11	$self->{map_dim_x} = 19 unless defined $self->{map_dim_x};
188	3	100				12	$self->{map_dim_y} = 19 unless defined $self->{map_dim_y};
189							# Legacy from...yesterday
190	3	50				11	if ($self->{map_dim}){
191	0					0	$self->{map_dim_x} = $self->{map_dim_y} = $self->{map_dim}
192							}
193	3	50	33			42	if (not defined $self->{map_dim_x} or $self->{map_dim_x}==0
			33
			33
194							or not defined $self->{map_dim_y} or $self->{map_dim_y}==0){
195	0					0	confess "No map dimensions in the input!";
196							}
197	3	100				603	if ($self->{map_dim_x}>$self->{map_dim_y}){
198	1					5	$self->{map_dim_a} = $self->{map_dim_y} + (($self->{map_dim_x}-$self->{map_dim_y})/2)
199							} else {
200	2					14	$self->{map_dim_a} = $self->{map_dim_x} + (($self->{map_dim_y}-$self->{map_dim_x})/2)
201							}
202	3	50				13	$self->{neighbour_factor} = 2.5 unless $self->{neighbour_factor};
203	3	100				14	$self->{epochs} = 99 unless defined $self->{epochs};
204	3	50				9	$self->{epochs} = 1 if $self->{epochs}<1;
205	3	50				49	$self->{time_constant} = $self->{epochs} / log($self->{map_dim_a}) unless $self->{time_constant}; # to base 10?
206	3	50				10	$self->{learning_rate} = 0.5 unless $self->{learning_rate};
207	3					6	$self->{l} = $self->{learning_rate};
208	3	50				9	if (not $self->{weight_dim}){
209	0					0	cluck "{weight_dim} not set";
210	0					0	return undef;
211							}
212	3					952	$self->randomise_map;
213	3					17	return $self;
214							}
215
216
217
218
219							=head1 METHOD randomise_map
220
221							Populates the C with nodes that contain random real nubmers.
222
223							See L.
224
225							=cut
226
227	3			3	0	7	sub randomise_map { my $self=shift;
228	3	50				9	confess "{weight_dim} not set" unless $self->{weight_dim};
229	3	50				7	confess "{map_dim_x} not set" unless $self->{map_dim_x};
230	3	50				8	confess "{map_dim_y} not set" unless $self->{map_dim_y};
231	3					9	for my $x (0..$self->{map_dim_x}){
232	46					420	$self->{map}->[$x] = [];
233	46					83	for my $y (0..$self->{map_dim_y}){
234	796					3290	$self->{map}->[$x]->[$y] = new AI::NeuralNet::Kohonen::Node(
235							dim => $self->{weight_dim},
236							missing_mask => $self->{missing_mask},
237							);
238							}
239							}
240							}
241
242
243							=head1 METHOD clear_map
244
245							As L but sets all C nodes to
246							either the value supplied as the only paramter, or C.
247
248							=cut
249
250	0			0	0	0	sub clear_map { my $self=shift;
251	0	0				0	confess "{weight_dim} not set" unless $self->{weight_dim};
252	0	0				0	confess "{map_dim_x} not set" unless $self->{map_dim_x};
253	0	0				0	confess "{map_dim_y} not set" unless $self->{map_dim_y};
254	0		0			0	my $val = shift \|\| $self->{missing_mask};
255	0					0	my $w = [];
256	0					0	foreach (0..$self->{weight_dim}){
257	0					0	push @$w, $val;
258							}
259	0					0	for my $x (0..$self->{map_dim_x}){
260	0					0	$self->{map}->[$x] = [];
261	0					0	for my $y (0..$self->{map_dim_y}){
262	0					0	$self->{map}->[$x]->[$y] = new AI::NeuralNet::Kohonen::Node(
263							weight => $w,
264							dim => $self->{weight_dim},
265							missing_mask => $self->{missing_mask},
266							);
267							}
268							}
269							}
270
271
272
273
274							=head1 METHOD train
275
276							Optionally accepts a parameter that is the number of epochs
277							for which to train: the default is the value in the C field.
278
279							An epoch is composed of A number of generations, the number being
280							the total number of input vectors.
281
282							For every generation, iterates:
283
284							=over 4
285
286							=item 1
287
288							selects a target from the input array (see L);
289
290							=item 2
291
292							finds the best-matching unit (see L);
293
294							=item 3
295
296							adjusts the neighbours of the BMU (see L);
297
298							=back
299
300							At the end of every generation, the learning rate is decayed
301							(see L).
302
303							See C for details of applicable callbacks.
304
305							Returns a true value.
306
307							=cut
308
309	1			1	0	3778	sub train { my ($self,$epochs) = (shift,shift);
310	1	50				8	$epochs = $self->{epochs} unless defined $epochs;
311	1	50				4	&{$self->{train_start}} if exists $self->{train_start};
	0					0
312	1					4	for my $epoch (1..$epochs){
313	2					128	$self->{t} = $epoch;
314	2	50				10	&{$self->{epoch_start}} if exists $self->{epoch_start};
	0					0
315	2					5	for (0..$#{$self->{input}}){
	2					8
316	6					23	my $target = $self->_select_target;
317	6					57	my $bmu = $self->find_bmu($target);
318	6					33	$self->_adjust_neighbours_of($bmu,$target);
319							}
320	2					10	$self->_decay_learning_rate;
321	2	50				24	&{$self->{epoch_end}} if exists $self->{epoch_end};
	2					11
322							}
323	1	50				91	&{$self->{train_end}} if $self->{train_end};
	1					5
324	1					372	return 1;
325							}
326
327
328							=head1 METHOD find_bmu
329
330							For a specific taraget, finds the Best Matching Unit in the map
331							and return the x/y index.
332
333							Accepts: a reference to an array that is the target.
334
335							Returns: a reference to an array that is the BMU (and should
336							perhaps be abstracted as an object in its own right), indexed as follows:
337
338							=over 4
339
340							=item 0
341
342							euclidean distance from the supplied target
343
344							=item 1, 2
345
346							I and I co-ordinate in the map
347
348							=back
349
350							See L,
351							and L,
352
353							=cut
354
355
356	14			14	0	28	sub find_bmu { my ($self,$target) = (shift,shift);
357	14					29	my $closest = []; # [value, x,y] value and co-ords of closest match
358	14					34	for my $x (0..$self->{map_dim_x}){
359	210					388	for my $y (0..$self->{map_dim_y}){
360	2310					8280	my $distance = $self->{map}->[$x]->[$y]->distance_from( $target );
361	2310	100	100			8028	$closest = [$distance,0,0] if $x==0 and $y==0;
362	2310	100				6256	$closest = [$distance,$x,$y] if $distance < $closest->[0];
363							}
364							}
365	14					44	return $closest;
366							}
367
368							=head1 METHOD get_weight_at
369
370							Returns a reference to the weight array at the supplied I,I
371							co-ordinates.
372
373							Accepts: I,I co-ordinates, each a scalar.
374
375							Returns: reference to an array that is the weight of the node, or
376							C on failure.
377
378							=cut
379
380	0			0	0	0	sub get_weight_at { my ($self,$x,$y) = (shift,shift,shift);
381	0	0	0			0	return undef if $x<0 or $y<0 or $x>$self->{map_dim_x} or $y>$self->{map_dim_y};
			0
			0
382	0					0	return $self->{map}->[$x]->[$y]->{weight};
383							}
384
385
386
387							=head1 METHOD get_results
388
389							Finds and returns the results for all input vectors in the supplied
390							reference to an array of arrays,
391							placing the values in the C field (array reference),
392							and, returning it either as an array or as it is, depending on
393							the calling context
394
395							If no array reference of input vectors is supplied, will use
396							the values in the C field.
397
398							Individual results are in the array format as described in
399							L.
400
401							See L, and L.
402
403							=cut
404
405	4			4	0	2992	sub get_results { my ($self,$targets)=(shift,shift);
406	4					10	$self->{results} = [];
407	4	100				28	if (not defined $targets){
		50
408	1					3	$targets = $self->{input};
409							} elsif (not $targets eq $self->{input}){
410	3					9	foreach (@$targets){
411	5	100				19	next if ref $_ eq 'AI::NeuralNet::Kohonen::Input';
412	4					18	$_ = new AI::NeuralNet::Kohonen::Input(values=>$_);
413							}
414							}
415	4					6	foreach my $target (@{ $targets}){
	4					10
416	8					24	$_ = $self->find_bmu($target);
417	8		100			66	push @$_, $target->{class}\|\|"?";
418	8					12	push @{$self->{results}}, $_;
	8					28
419							}
420							# Make it a scalar if it's a scalar
421							# if ($#{$self->{results}} == 0){
422							# $self->{results} = @{$self->{results}}[0];
423							# }
424	4	50				16	return wantarray? @{$self->{results}} : $self->{results};
	4					29
425							}
426
427
428							=head1 METHOD map_results
429
430							Clears the C and fills it with the results.
431
432							The sole paramter is passed to the L.
433							L is then called, and the results
434							returned fed into the object field C.
435
436							This may change, as it seems misleading to re-use that field.
437
438							=cut
439
440	0			0	0	0	sub map_results { my $self=shift;
441
442							}
443
444
445							=head1 METHOD dump
446
447							Print the current weight values to the screen.
448
449							=cut
450
451	0			0	0	0	sub dump { my $self=shift;
452	0					0	print " ";
453	0					0	for my $x (0..$self->{map_dim_x}){
454	0					0	printf (" %02d ",$x);
455							}
456	0					0	print"\n","-"x107,"\n";
457	0					0	for my $x (0..$self->{map_dim_x}){
458	0					0	for my $w (0..$self->{weight_dim}){
459	0					0	printf ("%02d \| ",$x);
460	0					0	for my $y (0..$self->{map_dim_y}){
461	0					0	printf("%.2f ", $self->{map}->[$x]->[$y]->{weight}->[$w]);
462							}
463	0					0	print "\n";
464							}
465	0					0	print "\n";
466							}
467							}
468
469							=head1 METHOD smooth
470
471							Perform gaussian smoothing upon the map.
472
473							Accepts: the length of the side of the square gaussian mask to apply.
474							If not supplied, uses the value in the field C; if that is
475							empty, uses the square root of the average of the map dimensions
476							(C).
477
478							Returns: a true value.
479
480							=cut
481
482	0			0	0	0	sub smooth { my ($self,$smooth) = (shift,shift);
483	0	0	0			0	$smooth = $self->{smoothing} if not $smooth and defined $self->{smoothing};
484	0	0				0	return unless $smooth;
485	0					0	$smooth = int( sqrt $self->{map_dim_a} );
486	0					0	my $mask = _make_gaussian_mask($smooth);
487
488							# For every weight at every point
489	0					0	for my $x (0..$self->{map_dim_x}){
490	0					0	for my $y (0..$self->{map_dim_y}){
491	0					0	for my $w (0..$self->{weight_dim}){
492							# Apply the mask
493	0					0	for my $mx (0..$smooth){
494	0					0	for my $my (0..$smooth){
495	0					0	$self->{map}->[$x]->[$y]->{weight}->[$w] *= $mask->[$mx]->[$my];
496							}
497							}
498							}
499							}
500							}
501	0					0	return 1;
502							}
503
504
505
506							=head1 METHOD load_input
507
508							Loads a SOM_PAK-format file of input vectors.
509
510							This method is automatically accessed if the constructor is supplied
511							with an C field.
512
513							Requires: a path to a file.
514
515							Returns C on failure.
516
517							See L.
518
519							=cut
520
521	0			0	0	0	sub load_input { my ($self,$path) = (shift,shift);
522	0					0	local *IN;
523	0	0				0	if (not open IN,$path){
524	0					0	warn "Could not open file <$path>: $!";
525	0					0	return undef;
526							}
527	0					0	@_ = ;
528	0					0	close IN;
529	0					0	$self->_process_input_text(\@_);
530	0					0	return 1;
531							}
532
533
534							=head1 METHOD save_file
535
536							Saves the map file in I format (see L)
537							at the path specified in the first argument.
538
539							Return C on failure, a true value on success.
540
541							=cut
542
543	0			0	0	0	sub save_file { my ($self,$path) = (shift,shift);
544	0					0	local *OUT;
545	0	0				0	if (not open OUT,">$path"){
546	0					0	warn "Could not open file for writing <$path>: $!";
547	0					0	return undef;
548							}
549							#- Dimensionality of the vectors (integer, compulsory).
550	0					0	print OUT ($self->{weight_dim}+1)," "; # Perl indexing
551							#- Topology type, either hexa or rect (string, optional, case-sensitive).
552	0	0				0	if (not defined $self->{display}){
553	0					0	print OUT "rect ";
554							} else { # $self->{display} eq 'hex'
555	0					0	print OUT "hexa ";
556							}
557							#- Map dimension in x-direction (integer, optional).
558	0					0	print OUT $self->{map_dim_x}." ";
559							#- Map dimension in y-direction (integer, optional).
560	0					0	print OUT $self->{map_dim_y}." ";
561							#- Neighborhood type, either bubble or gaussian (string, optional, case-sen- sitive).
562	0					0	print OUT "gaussian ";
563							# End of header
564	0					0	print OUT "\n";
565
566							# Format input data
567	0					0	foreach (@{$self->{input}}){
	0					0
568	0					0	print OUT join("\t",@{$_->{values}});
	0					0
569	0	0				0	if ($_->{class}){
570	0					0	print OUT " $_->{class} " ;
571							}
572	0					0	print OUT "\n";
573							}
574							# EOF
575	0					0	print OUT chr 26;
576	0					0	close OUT;
577	0					0	return 1;
578							}
579
580
581							#
582							# Process ASCII from table field or input file
583							# Accepts: ASCII as array or array ref
584							#
585	1			1		3	sub _process_input_text { my ($self) = (shift);
586	1	50				4	if (not defined $_[1]){
587	1	50				4	if (ref $_[0] eq 'ARRAY'){
588	0					0	@_ = @{$_[0]};
	0					0
589							} else {
590	1					10	@_ = split/[\n\r\f]+/,$_[0];
591							}
592							}
593	1					4	chomp @_;
594	1					5	my @specs = split/\s+/,(shift @_);
595							#- Dimensionality of the vectors (integer, compulsory).
596	1					4	$self->{weight_dim} = shift @specs;
597	1					3	$self->{weight_dim}--; # Perl indexing
598							#- Topology type, either hexa or rect (string, optional, case-sensitive).
599	1					2	my $display = shift @specs;
600	1	50	33			12	if (not defined $display and exists $self->{display}){
		50
		0
		0
601							# Intentionally blank
602							} elsif (not defined $display){
603	1					4	$self->{display} = undef;
604							} elsif ($display eq 'hexa'){
605	0					0	$self->{display} = 'hex'
606							} elsif ($display eq 'rect'){
607	0					0	$self->{display} = undef;
608							}
609							#- Map dimension in x-direction (integer, optional).
610	1					3	$_ = shift @specs;
611	1	50				4	$self->{map_dim_x} = $_ if defined $_;
612							#- Map dimension in y-direction (integer, optional).
613	1					1	$_ = shift @specs;
614	1	50				4	$self->{map_dim_y} = $_ if defined $_;
615							#- Neighborhood type, either bubble or gaussian (string, optional, case-sen- sitive).
616							# not implimented
617
618							# Format input data
619	1					3	foreach (@_){
620	3					8	$self->_add_input_from_str($_);
621							}
622	1					4	return 1;
623							}
624
625
626							=head1 PRIVATE METHOD _select_target
627
628							Return a random target from the training set in the C field,
629							unless the C field is defined, when the targets are
630							iterated over.
631
632							=cut
633
634	6			6		11	sub _select_target { my $self=shift;
635	6	50				62	if (not $self->{targeting}){
636	6					31	return $self->{input}->[
637	6					12	(int rand(scalar @{$self->{input}}))
638							];
639							}
640							else {
641	0					0	$self->{tar}++;
642	0	0				0	if ($self->{tar}>$#{ $self->{input} }){
	0					0
643	0					0	$self->{tar} = 0;
644							}
645	0					0	return $self->{input}->[$self->{tar}];
646							}
647							}
648
649
650							=head1 PRIVATE METHOD _adjust_neighbours_of
651
652							Accepts: a reference to an array containing
653							the distance of the BMU from the target, as well
654							as the x and y co-ordinates of the BMU in the map;
655							a reference to the target, which is an
656							C object.
657
658							Returns: true.
659
660							=head2 FINDING THE NEIGHBOURS OF THE BMU
661
662							( t )
663							sigma(t) = sigma(0) exp ( - ------ )
664							( lambda )
665
666							Where C is the width of the map at any stage
667							in time (C), and C is a time constant.
668
669							Lambda is our field C.
670
671							The map radius is naturally just half the map width.
672
673							=head2 ADJUSTING THE NEIGHBOURS OF THE BMU
674
675							W(t+1) = W(t) + THETA(t) L(t)( V(t)-W(t) )
676
677							Where C is the learning rate, C the target vector,
678							and C the weight. THETA(t) represents the influence
679							of distance from the BMU upon a node's learning, and
680							is calculated by the C class - see
681							L.
682
683							=cut
684
685	6			6		14	sub _adjust_neighbours_of { my ($self,$bmu,$target) = (shift,shift,shift);
686	6					71	my $neighbour_radius = int (
687							($self->{map_dim_a}/$self->{neighbour_factor}) * exp(- $self->{t} / $self->{time_constant})
688							);
689
690							# Distance from co-ord vector (0,0) as integer
691							# Basically map_width * y + x
692	6					20	my $centre = ($self->{map_dim_a}*$bmu->[2])+$bmu->[1];
693							# Set the class of the BMU
694	6					30	$self->{map}->[ $bmu->[1] ]->[ $bmu->[2] ]->{class} = $target->{class};
695
696	6					22	for my $x ($bmu->[1]-$neighbour_radius .. $bmu->[1]+$neighbour_radius){
697	12	50	33			67	next if $x<0 or $x>$self->{map_dim_x}; # Ignore those not mappable
698	12					32	for my $y ($bmu->[2]-$neighbour_radius .. $bmu->[2]+$neighbour_radius){
699	30	50	33			174	next if $y<0 or $y>$self->{map_dim_y}; # Ignore those not mappable
700							# Skip node if it is out of the circle of influence
701							next if (
702	30	100				127	(($bmu->[1] - $x) * ($bmu->[1] - $x)) + (($bmu->[2] - $y) * ($bmu->[2] - $y))
703							) > ($neighbour_radius * $neighbour_radius);
704
705							# Adjust the weight
706	18					36	for my $w (0..$self->{weight_dim}){
707	54	50				293	next if $target->{values}->[$w] eq $self->{map}->[$x]->[$y]->{missing_mask};
708	54					99	my $weight = \$self->{map}->[$x]->[$y]->{weight}->[$w];
709	54					250	$$weight = $$weight + (
710							$self->{map}->[$x]->[$y]->distance_effect($bmu->[0], $neighbour_radius)
711							* ( $self->{l} * ($target->{values}->[$w] - $$weight) )
712							);
713							}
714							}
715							}
716							}
717
718
719							=head1 PRIVATE METHOD _decay_learning_rate
720
721							Performs a gaussian decay upon the learning rate (our C field).
722
723							( t )
724							L(t) = L exp ( - ------ )
725							0 ( lambda )
726
727							=cut
728
729	2			2		5	sub _decay_learning_rate { my $self=shift;
730	2					9	$self->{l} = (
731							$self->{learning_rate} * exp(- $self->{t} / $self->{time_constant})
732							);
733							}
734
735
736							=head1 PRIVATE FUNCTION _make_gaussian_mask
737
738							Accepts: size of mask.
739
740							Returns: reference to a 2d array that is the mask.
741
742							=cut
743
744	0			0		0	sub _make_gaussian_mask { my ($smooth) = (shift);
745	0					0	my $f = 4; # Cut-off threshold
746	0					0	my $g_mask_2d = [];
747	0					0	for my $x (0..$smooth){
748	0					0	$g_mask_2d->[$x] = [];
749	0					0	for my $y (0..$smooth){
750	0					0	$g_mask_2d->[$x]->[$y] =
751							_gauss_weight( $x-($smooth/2), $smooth/$f)
752							* _gauss_weight( $y-($smooth/2), $smooth/$f );
753							}
754							}
755	0					0	return $g_mask_2d;
756							}
757
758							=head1 PRIVATE FUNCTION _gauss_weight
759
760							Accepts: two paramters: the first, C, gives the distance from the mask centre,
761							the second, C, specifies the width of the mask.
762
763							Returns the gaussian weight.
764
765							See also L<_decay_learning_rate>.
766
767							=cut
768
769	0			0		0	sub _gauss_weight { my ($r, $sigma) = (shift,shift);
770	0					0	return exp( -($r*2) / (2 $sigma**2) );
771							}
772
773
774							=head1 PUBLIC METHOD quantise_error
775
776							Returns the quantise error for either the supplied points,
777							or those in the C field.
778
779							=cut
780
781
782	1			1	0	30	sub quantise_error { my ($self,$targets) = (shift,shift);
783	1					3	my $qerror=0;
784	1	50				6	if (not defined $targets){
785	0					0	$targets = $self->{input};
786							} else {
787	1					4	foreach (@$targets){
788	1	50	33			13	if (not ref $_ or ref $_ ne 'ARRAY'){
789	0					0	croak "Supplied target parameter should be an array of arrays!"
790							}
791	1					10	$_ = new AI::NeuralNet::Kohonen::Input(values=>$_);
792							}
793							}
794
795							# Recieves an array of ONE element,
796							# should be an array of an array of elements
797	1					5	my @bmu = $self->get_results($targets);
798
799							# Check input and output dims are the same
800	1	50				3	if ($#{$self->{map}->[0]->[1]->{weight}} != $targets->[0]->{dim}){
	1					8
801	0					0	confess "target input and map dimensions differ";
802							}
803
804	1					4	for my $i (0..$#bmu){
805	1					5	foreach my $w (0..$self->{weight_dim}){
806	3					14	$qerror += $targets->[$i]->{values}->[$w]
807							- $self->{map}->[$bmu[$i]->[1]]->[$bmu[$i]->[2]]->{weight}->[$w];
808							}
809							}
810	1					4	$qerror /= scalar @$targets;
811	1					8	return $qerror;
812							}
813
814
815							=head1 PRIVATE METHOD _add_input_from_str
816
817							Adds to the C field an input vector in SOM_PAK-format
818							whitespace-delimited ASCII.
819
820							Returns C on failure to add an item (perhaps because
821							the data passed was a comment, or the C flag was
822							not set); a true value on success.
823
824							=cut
825
826	3			3		5	sub _add_input_from_str { my ($self) = (shift);
827	3					4	$_ = shift;
828	3					4	s/#.*$//g;
829	3	50	33			19	return undef if /^$/ or not defined $self->{weight_dim};
830	3					11	my @i = split /\s+/,$_;
831	3	50				10	return undef if $#i < $self->{weight_dim}; # catch bad lines
832							# 'x' in files signifies unknown: we prefer undef?
833							# @i[0..$self->{weight_dim}] = map{
834							# $_ eq 'x'? undef:$_
835							# } @i[0..$self->{weight_dim}];
836	3					16	my %args = (
837							dim => $self->{weight_dim},
838							values => [ @i[0..$self->{weight_dim}] ],
839							);
840	3	50				14	$args{class} = $i[$self->{weight_dim}+1] if $i[$self->{weight_dim}+1];
841	3	50				9	$args{enhance} = $i[$self->{weight_dim}+1] if $i[$self->{weight_dim}+2];
842	3	50				8	$args{fixed} = $i[$self->{weight_dim}+1] if $i[$self->{weight_dim}+3];
843	3					4	push @{$self->{input}}, new AI::NeuralNet::Kohonen::Input(%args);
	3					17
844
845	3					12	return 1;
846							}
847
848
849							#
850							# Processes the 'table' paramter to the constructor
851							#
852	1			1		2	sub _process_table { my $self = shift;
853	1					6	$_ = $self->_process_input_text( $self->{table} );
854	1					3	undef $self->{table};
855	1					2	return $_;
856							}
857
858
859							__END__