File Coverage

blib/lib/Math/Geometry/Multidimensional.pm
Criterion Covered Total %
statement 12 62 19.3
branch 0 14 0.0
condition 0 22 0.0
subroutine 4 10 40.0
pod 6 6 100.0
total 22 114 19.3


line stmt bran cond sub pod time code
1             package Math::Geometry::Multidimensional;
2              
3 1     1   35364 use 5.006;
  1         4  
  1         60  
4 1     1   6 use strict;
  1         2  
  1         46  
5 1     1   5 use warnings FATAL => 'all';
  1         13  
  1         48  
6 1     1   6 use Carp;
  1         2  
  1         873  
7             require Exporter;
8             our @ISA = qw/Exporter/;
9             our @EXPORT_OK = qw/distanceToLineN diagonalComponentsN diagonalDistancesFromOriginN/;
10              
11             =head1 NAME
12              
13             Math::Geometry::Multidimensional - geometrical functions in n-dimensions
14              
15             =head1 VERSION
16              
17             Version 0.02
18              
19             =cut
20              
21             our $VERSION = '0.02';
22              
23              
24             =head1 SYNOPSIS
25              
26             This module has a bunch of functions that work in mulitiple dimensions,
27             e.g. distance of a point from a line in n-dimensions.
28              
29             use Math::Geometry::Multidimensional qw/distanceToLineN/;
30             # parametric:
31             my $distance = distanceToLineN($point, $gradients, $intersect);
32             # symmetric:
33             my $distance = distanceToLineP($point, $denominators, $constants);
34            
35              
36             =head1 EXPORT
37              
38             =over
39              
40             =item distanceToLineN
41              
42             =item diagonalComponentsN
43              
44             =item diagonalDistancesFromOriginN
45              
46             =back
47              
48             =head1 SUBROUTINES/METHODS
49              
50             =head2 distanceToLineN
51              
52             We have a line with symmetric form:
53              
54             (x+a)/m = (y+b)/n = (z+c)/p ...
55              
56             @M is the list of denominators and @C is the list of constants.
57              
58             For a point $P,
59              
60             distanceToLineN($P,\@M,\@C)
61              
62             returns the distance to the closest point on the line... in n-dimensions.
63              
64             =cut
65              
66             sub distanceToLineN {
67 0     0 1   my ($P,$M,$C) = @_;
68 0           my $n = @$P;
69 0           my $t = 0;
70 0           my $d = 0;
71 0           foreach my $i(0..$n-1){
72 0           my ($p,$m,$c) = map {$_->[$i]} ($P,$M,$C);
  0            
73 0   0       $p ||= 0; # default value is zero for missing values
74 0           $t += ($m * ($p + $c));
75 0           $d += ($m**2);
76             }
77 0           $t /= $d;
78              
79 0           my $sos = 0;
80 0           my $Q = []; # orthogonal point on line
81 0           foreach my $i(0..$n-1){
82 0           my ($p,$m,$c) = map {$_->[$i]} ($P,$M,$C);
  0            
83 0   0       $p ||= 0;# default value is zero for missing values
84 0           my $q += $m * $t -$c;
85 0           push @$Q, $q;
86 0           $sos += ($p-$q)**2; # add squared vector component
87             }
88 0           return (sqrt($sos), $Q);
89             }
90              
91             =head2 lineFromTwoPoints
92              
93             =cut
94              
95 0     0 1   sub lineFromTwoPoints {
96             }
97              
98             =head2 diagonalDistanceFromOriginN
99              
100             This is the distance along the y=z=x=... line from any point to the origin.
101             First we find the closest point on y=z=x=... from our point, which happens
102             to be the average of the coordinates, e.g. if the point is (10,8) then the
103             closest point on y=z is 9,9. If the point is (9,8,4) then the closest point
104             on z=y=x is (7,7,7). If the point is (2,3,4,7) then the closest point on
105             z=y=x=w is (4,4,4,4). Why?
106              
107             For P(u,v,w) and L: (x+a)/k = (y+b)/l = (z+c)/m = t
108              
109             we know that x=kt-a ; y=lt-b ; z=my-c
110              
111             so k(kt-a) + l(lt-b) + m(mt-c) = kkt-ka + llt-lb + mmt-mc = ku+lv+mw
112             OR
113             t(kk+ll+mm) = k(u+a)+l(v+b)+m(w+c)
114             so
115             t = (k(u+a)+l(v+b)+m(w+c)) / (kk+ll+mm)
116              
117             BUT, if a=b=c=0 and k=l=m=1, then:
118              
119             t = (x+y+z)/(3)
120              
121             in general, t is the average of the coordinates.
122              
123             then, x' = kt-a, and if k is 1 and a is 0, then x' is t.
124              
125             P' is (t,t,t)
126             so the distance to P' from the origin is sqrt(3 t^2)
127             or sqrt( 3 * ((x+y+z)/3)^2)
128             or sqrt( 3 * (x+y+z)^2 / 9 )
129             or sqrt( (x+y+z)^2 / 3)
130             or (x+y+z)/sqrt(3)
131             or SUM(coords)/sqrt(n)
132              
133             Does that make sense?
134              
135             =cut
136              
137             sub diagonalDistanceFromOriginN {
138 0     0 1   my ($P) = @_;
139 0           my $sum = 0;
140 0           $sum += $_ foreach @$P;
141 0           return $sum / sqrt(@$P);
142             }
143              
144             =head2 diagonalDistancesFromOriginN
145              
146             Acts on columns rather than an individual point...
147             give it column number, row number and list of columns.
148              
149             my $arrayref = diagonalDistancesFromOriginN ($k,$n,@cols)
150              
151             =cut
152              
153             sub diagonalDistancesFromOriginN {
154 0     0 1   my ($k,$n,@cols) = @_;
155 0           my $k1 = $k-1;
156 0           my $sk = sqrt($k);
157 0           my @D = ();
158 0           my $count = 0;
159 0           my $sum;
160 0           foreach my $i(0..$n-1){
161 0           $sum = 0;
162 0           foreach (0..$k1){
163 0 0 0       if(defined $cols[$_]->[$i] && $cols[$_]->[$i] ne ''){
164 0           $sum += $cols[$_]->[$i];
165 0           $count++;
166             }
167             }
168 0 0         push @D, $count ? $sum / $sk : '';
169             }
170 0           return \@D;
171             }
172              
173             =head2 diagonalComponentsN
174              
175             Here, we are basically rotating all the data so that the "y-axis" or whatever
176             you want to call the left-most co-ordinate now lies diagonally through the data.
177              
178             =cut
179              
180             sub diagonalComponentsN {
181 0     0 1   my ($Y, $X) = @_;
182 0 0         croak "Y and X are different lengths"
183             unless @$Y == @$X;
184 0           return [map {
185 0           my ($y,$x) = ($Y->[$_], $X->[$_]);
186 0 0 0       if((! defined $x || $x eq '') && (! defined $y || $y eq '')){
      0        
      0        
187 0           $x = 'skip';
188             }
189 0 0 0       $y = 0 unless defined $y && $y ne '';
190 0 0 0       $x = 0 unless defined $x && $x ne '';
191 0 0         $x eq 'skip'
192             ? ''
193             : ($y - $x)/sqrt(2)
194             } (0..$#$Y)];
195             }
196              
197             =head2 distanceFromDiagonalN
198              
199             As above, we know that the point P' on the diagonal closest to our point P
200             has the average coordinates of point P. And the distance
201             PP' (x-x', y-y', z-z') is the root of the sum of the squares. So
202              
203             so, if x' = t, which is (x+y+z)/3 ...
204              
205             PP' = sqrt( (x - x/3 - y/3 - z/3)^2 + (y - x/3 - y/3 - z/3)^2
206             + (z + x/3 + y/3 + z/3)^2 )
207              
208             = sqrt( x^2 (2/3) + y^2 (2/3) + z^2 (2/3) + 2xy + 2xz + 2yz )
209              
210             this is not implemented yet.
211              
212             =cut
213              
214 0     0 1   sub distanceFromDiagonalN {
215             }
216              
217             =head1 AUTHOR
218              
219             Jimi Wills, C<< >>
220              
221             =head1 BUGS
222              
223             Please report any bugs or feature requests to C, or through
224             the web interface at L. I will be notified, and then you'll
225             automatically be notified of progress on your bug as I make changes.
226              
227              
228              
229              
230             =head1 SUPPORT
231              
232             You can find documentation for this module with the perldoc command.
233              
234             perldoc Math::Geometry::Multidimensional
235              
236              
237             You can also look for information at:
238              
239             =over 4
240              
241             =item * RT: CPAN's request tracker (report bugs here)
242              
243             L
244              
245             =item * AnnoCPAN: Annotated CPAN documentation
246              
247             L
248              
249             =item * CPAN Ratings
250              
251             L
252              
253             =item * Search CPAN
254              
255             L
256              
257             =back
258              
259              
260             =head1 ACKNOWLEDGEMENTS
261              
262              
263             =head1 LICENSE AND COPYRIGHT
264              
265             Copyright 2013 Jimi Wills.
266              
267             This program is free software; you can redistribute it and/or modify it
268             under the terms of the the Artistic License (2.0). You may obtain a
269             copy of the full license at:
270              
271             L
272              
273             Any use, modification, and distribution of the Standard or Modified
274             Versions is governed by this Artistic License. By using, modifying or
275             distributing the Package, you accept this license. Do not use, modify,
276             or distribute the Package, if you do not accept this license.
277              
278             If your Modified Version has been derived from a Modified Version made
279             by someone other than you, you are nevertheless required to ensure that
280             your Modified Version complies with the requirements of this license.
281              
282             This license does not grant you the right to use any trademark, service
283             mark, tradename, or logo of the Copyright Holder.
284              
285             This license includes the non-exclusive, worldwide, free-of-charge
286             patent license to make, have made, use, offer to sell, sell, import and
287             otherwise transfer the Package with respect to any patent claims
288             licensable by the Copyright Holder that are necessarily infringed by the
289             Package. If you institute patent litigation (including a cross-claim or
290             counterclaim) against any party alleging that the Package constitutes
291             direct or contributory patent infringement, then this Artistic License
292             to you shall terminate on the date that such litigation is filed.
293              
294             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
295             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
296             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
297             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
298             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
299             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
300             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
301             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
302              
303              
304             =cut
305              
306             1; # End of Math::Geometry::Multidimensional