File Coverage

blib/lib/AI/NeuralNet/SOM/Rect.pm
Criterion Covered Total %
statement 86 91 94.5
branch 10 16 62.5
condition 4 7 57.1
subroutine 13 14 92.8
pod 6 7 85.7
total 119 135 88.1


line stmt bran cond sub pod time code
1             package AI::NeuralNet::SOM::Rect;
2              
3 3     3   47065 use strict;
  3         6  
  3         119  
4 3     3   17 use warnings;
  3         5  
  3         128  
5              
6 3     3   1721 use Data::Dumper;
  3         17034  
  3         277  
7 3     3   19 use base qw(AI::NeuralNet::SOM);
  3         6  
  3         1713  
8 3     3   2896 use AI::NeuralNet::SOM::Utils;
  3         7  
  3         5158  
9              
10             =pod
11              
12             =head1 NAME
13              
14             AI::NeuralNet::SOM::Rect - Perl extension for Kohonen Maps (rectangular topology)
15              
16             =head1 SYNOPSIS
17              
18             use AI::NeuralNet::SOM::Rect;
19             my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
20             input_dim => 3);
21             $nn->initialize;
22             $nn->train (30,
23             [ 3, 2, 4 ],
24             [ -1, -1, -1 ],
25             [ 0, 4, -3]);
26              
27             print $nn->as_data;
28              
29             =head1 INTERFACE
30              
31             =head2 Constructor
32              
33             The constructor takes the following arguments (additionally to those in the base class):
34              
35             =over
36              
37             =item C : (mandatory, no default)
38              
39             A string of the form "3x4" defining the X and the Y dimensions.
40              
41             =back
42              
43             Example:
44              
45             my $nn = new AI::NeuralNet::SOM::Rect (output_dim => "5x6",
46             input_dim => 3);
47              
48             =cut
49              
50             sub new {
51 8     8 0 2831 my $class = shift;
52 8         34 my %options = @_;
53 8         41 my $self = bless { %options }, $class;
54              
55 8 50       71 if ($self->{output_dim} =~ /(\d+)x(\d+)/) {
56 8 50       57 $self->{_X} = $1 and $self->{_Y} = $2;
57             } else {
58 0         0 die "output dimension does not have format MxN";
59             }
60 8 50       20 if ($self->{input_dim} > 0) {
61 8         23 $self->{_Z} = $self->{input_dim};
62             } else {
63 0         0 die "input dimension must be positive integer";
64             }
65              
66              
67 8         40 ($self->{_R}) = map { $_ / 2 } sort {$b <= $a } ($self->{_X}, $self->{_Y}); # radius
  16         44  
  8         43  
68 8   33     53 $self->{_Sigma0} = $options{sigma0} || $self->{_R}; # impact distance, start value
69 8   50     52 $self->{_L0} = $options{learning_rate} || 0.1; # learning rate, start value
70 8         29 return $self;
71             }
72              
73             =pod
74              
75             =head2 Methods
76              
77             =cut
78              
79             sub initialize {
80 4     4 1 25 my $self = shift;
81 4         8 my @data = @_;
82              
83 4         8 our $i = 0;
84             my $get_from_stream = sub {
85 0 0   0   0 $i = 0 if $i > $#data;
86 0         0 return [ @{ $data[$i++] } ]; # cloning !
  0         0  
87 4 50       34 } if @data;
88             $get_from_stream ||= sub {
89 120     120   169 return [ map { rand( 1 ) - 0.5 } 1..$self->{_Z} ];
  360         878  
90 4   100     40 };
91              
92 4         15 for my $x (0 .. $self->{_X}-1) {
93 20         35 for my $y (0 .. $self->{_Y}-1) {
94 120         174 $self->{map}->[$x]->[$y] = &$get_from_stream;
95             }
96             }
97             }
98              
99             sub bmu {
100 8823     8823 1 11338 my $self = shift;
101 8823         9203 my $sample = shift;
102              
103 8823         16183 my $closest; # [x,y, distance] value and co-ords of closest match
104 8823         18273 for my $x (0 .. $self->{_X}-1) {
105 44115         117915 for my $y (0 .. $self->{_Y}-1){
106 264690         792365 my $distance = AI::NeuralNet::SOM::Utils::vector_distance ($self->{map}->[$x]->[$y], $sample); # || Vi - Sample ||
107             #warn "distance to $x, $y : $distance";
108 264690 100       572325 $closest = [0, 0, $distance] unless $closest;
109 264690 100       819904 $closest = [$x, $y, $distance] if $distance < $closest->[2];
110             }
111             }
112 8823         40228 return @$closest;
113             }
114              
115              
116             sub neighbors { # http://www.ai-junkie.com/ann/som/som3.html
117 7380     7380 1 9800 my $self = shift;
118 7380         8122 my $sigma = shift;
119 7380         7710 my $X = shift;
120 7380         7575 my $Y = shift;
121              
122 7380         7216 my @neighbors;
123 7380         17574 for my $x (0 .. $self->{_X}-1) {
124 36900         76893 for my $y (0 .. $self->{_Y}-1){
125 221400         388221 my $distance = sqrt ( ($x - $X) * ($x - $X) + ($y - $Y) * ($y - $Y) );
126 221400 100       468259 next if $distance > $sigma;
127 45998         137299 push @neighbors, [ $x, $y, $distance ]; # we keep the distances
128             }
129             }
130 7380         25118 return \@neighbors;
131             }
132              
133             =pod
134              
135             =cut
136              
137             sub radius {
138 2     2 1 3266 my $self = shift;
139 2         10 return $self->{_R};
140             }
141              
142             =pod
143              
144             =over
145              
146             =item I
147              
148             I<$m> = I<$nn>->map
149              
150             This method returns the 2-dimensional array of vectors in the grid (as a reference to an array of
151             references to arrays of vectors). The representation of the 2-dimensional array is straightforward.
152              
153             Example:
154              
155             my $m = $nn->map;
156             for my $x (0 .. 5) {
157             for my $y (0 .. 4){
158             warn "vector at $x, $y: ". Dumper $m->[$x]->[$y];
159             }
160             }
161              
162             =cut
163              
164             sub as_string {
165 2     2 1 1070 my $self = shift;
166 2         5 my $s = '';
167              
168 2         7 $s .= " ";
169 2         10 for my $y (0 .. $self->{_Y}-1){
170 12         40 $s .= sprintf (" %02d ",$y);
171             }
172 2         6 $s .= sprintf "\n","-"x107,"\n";
173            
174 2         4 my $dim = scalar @{ $self->{map}->[0]->[0] };
  2         10  
175            
176 2         9 for my $x (0 .. $self->{_X}-1) {
177 10         48 for my $w ( 0 .. $dim-1 ){
178 30         56 $s .= sprintf ("%02d | ",$x);
179 30         64 for my $y (0 .. $self->{_Y}-1){
180 180         716 $s .= sprintf ("% 2.2f ", $self->{map}->[$x]->[$y]->[$w]);
181             }
182 30         58 $s .= sprintf "\n";
183             }
184 10         20 $s .= sprintf "\n";
185             }
186 2         22 return $s;
187             }
188              
189             =pod
190              
191             =item I
192              
193             print I<$nn>->as_data
194              
195             This methods creates a string containing the raw vector data, row by
196             row. This can be fed into gnuplot, for instance.
197              
198             =cut
199              
200             sub as_data {
201 2     2 1 4 my $self = shift;
202 2         6 my $s = '';
203              
204 2         5 my $dim = scalar @{ $self->{map}->[0]->[0] };
  2         7  
205 2         11 for my $x (0 .. $self->{_X}-1) {
206 10         18 for my $y (0 .. $self->{_Y}-1){
207 60         73 for my $w ( 0 .. $dim-1 ){
208 180         526 $s .= sprintf ("\t%f", $self->{map}->[$x]->[$y]->[$w]);
209             }
210 60         83 $s .= sprintf "\n";
211             }
212             }
213 2         22 return $s;
214             }
215              
216             =pod
217              
218             =back
219              
220              
221             =head1 SEE ALSO
222              
223             L
224              
225             =head1 AUTHOR
226              
227             Robert Barta, Erho@devc.atE
228              
229             =head1 COPYRIGHT AND LICENSE
230              
231             Copyright (C) 2007 by Robert Barta
232              
233             This library is free software; you can redistribute it and/or modify
234             it under the same terms as Perl itself, either Perl version 5.8.8 or,
235             at your option, any later version of Perl 5 you may have available.
236              
237             =cut
238              
239             our $VERSION = '0.02';
240              
241             1;
242              
243             __END__