File Coverage

lib/Astro/Montenbruck/MathUtils.pm
Criterion Covered Total %
statement 132 137 96.3
branch 24 30 80.0
condition 4 5 80.0
subroutine 27 29 93.1
pod 19 19 100.0
total 206 220 93.6


line stmt bran cond sub pod time code
1             package Astro::Montenbruck::MathUtils;
2              
3 10     10   710464 use 5.22.0;
  10         51  
4 10     10   65 use feature qw/signatures/;
  10         24  
  10         1402  
5 10     10   71 no warnings qw/experimental::signatures/;
  10         23  
  10         396  
6             # The line below disables wrong perlcritic warnings
7             ## no critic qw/Subroutines::ProhibitSubroutinePrototypes/
8              
9 10     10   60 use Exporter qw/import/;
  10         20  
  10         382  
10 10     10   63 use POSIX qw (floor ceil acos modf fmod);
  10         22  
  10         75  
11 10     10   11522 use List::Util qw/any reduce/;
  10         32  
  10         735  
12              
13 10     10   3755 use Math::Trig qw/:pi :radial deg2rad rad2deg/;
  10         95387  
  10         1962  
14 10     10   110 use constant { ARCS => 3600.0 * 180.0 / pi };
  10         23  
  10         13793  
15              
16             our %EXPORT_TAGS = (
17             all => [
18             qw/frac frac360 dms hms zdms ddd polynome sine
19             reduce_deg reduce_rad to_range opposite_deg opposite_rad
20             angle_s angle_c angle_c_rad diff_angle polar cart
21             ARCS/
22             ],
23             );
24             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25             our $VERSION = 0.02;
26              
27 12075     12075 1 24849 sub frac($x) { ( modf($x) )[0] }
  12075         16160  
  12075         15074  
  12075         30917  
28              
29 0     0 1 0 sub frac360($x) { frac($x) * 360 }
  0         0  
  0         0  
  0         0  
30              
31 45     45 1 2573 sub dms ( $x, $places = 3 ) {
  45         59  
  45         64  
  45         58  
32 45 100       131 return $x if $places == 1;
33              
34 29         89 my ( $f, $i ) = modf($x);
35 29 50 66     113 $f = -$f if $i != 0 && $f < 0;
36              
37 29         70 ( $i, dms( $f * 60, $places - 1 ) );
38             }
39              
40 0     0 1 0 sub hms { dms @_ }
41              
42 12     12 1 12360 sub zdms($x) {
  12         23  
  12         15  
43 12         24 my ( $d, $m, $s ) = dms($x);
44 12         37 my $z = int( $d / 30 );
45 12         28 $d %= 30;
46              
47 12         37 $z, $d, $m, $s;
48             }
49              
50 108     108 1 8537 sub ddd(@args) {
  108         234  
  108         175  
51 108     235   756 my $b = any { $_ < 0 } @args;
  235         486  
52 108 100       451 my $sgn = $b ? -1 : 1;
53 108   100     321 my ( $d, $m, $s ) = map { abs( $args[$_] || 0 ) } ( 0 .. 2 );
  324         1192  
54 108         1070 return $sgn * ( $d + ( $m + $s / 60.0 ) / 60.0 );
55             }
56              
57 90     90 1 3551 sub polynome ( $t, @terms ) {
  90         146  
  90         208  
  90         162  
58 90     188   821 reduce { $a * $t + $b } reverse @terms;
  188         826  
59             }
60              
61 5     5 1 5367 sub to_range ( $x, $limit ) {
  5         9  
  5         9  
  5         9  
62 5         24 $x = fmod( $x, $limit );
63 5 50       22 $x < 0 ? $x + $limit : $x;
64             }
65              
66             #sub reduce_deg($x) { to_range( $x, 360 ) }
67              
68 863     863 1 3776 sub reduce_deg($x) {
  863         1312  
  863         1214  
69 863         1610 my $res = Math::Trig::deg2deg($x);
70 863 100       5776 $res < 0 ? $res + 360 : $res;
71             }
72              
73             #sub reduce_rad($x) { to_range( $x, pi2 ) }
74              
75 1139     1139 1 7446 sub reduce_rad($x) {
  1139         1718  
  1139         1627  
76 1139         2585 my $res = Math::Trig::rad2rad($x);
77 1139 100       9989 $res < 0 ? $res + pi2 : $res;
78             }
79              
80 3991     3991 1 9199 sub sine($x) { sin( pi2 * frac($x) ) }
  3991         5142  
  3991         4860  
  3991         5969  
81              
82 4     4 1 5245 sub opposite_deg($x) { reduce_deg( $x + 180 ) }
  4         8  
  4         7  
  4         11  
83              
84 4     4 1 1919 sub opposite_rad($x) { reduce_rad( $x + pi ) }
  4         7  
  4         6  
  4         14  
85              
86 4     4 1 7423 sub angle_c ( $a, $b ) {
  4         9  
  4         7  
  4         6  
87 4         9 my $x = abs( $a - $b );
88 4 50       13 $x > 180 ? 360 - $x : $x;
89             }
90              
91 4     4 1 1994 sub angle_c_rad ( $a, $b ) {
  4         9  
  4         6  
  4         7  
92 4         9 my $x = abs( $a - $b );
93 4 50       14 $x > pi ? pi2 - $x : $x;
94             }
95              
96             sub angle_s {
97 1     1 1 2450 my ( $x1, $y1, $x2, $y2 ) = map { deg2rad $_ } @_;
  4         30  
98 1         32 rad2deg(
99             acos( sin($y1) * sin($y2) + cos($y1) * cos($y2) * cos( $x1 - $x2 ) ) );
100             }
101              
102 179     179 1 3423 sub diff_angle($a, $b, $mode = 'degrees') {
  179         258  
  179         234  
  179         261  
  179         224  
103 179         297 my $m = lc $mode;
104 179 50       425 my $whole = $m eq 'degrees' ? 360
    100          
105             : $m eq 'radians' ? pi2
106             : undef;
107 179 50       335 die "Expected 'degrees' or 'radians' mode" unless $whole;
108 179 100       299 my $half = $m eq 'degrees' ? 180 : pi;
109 179 100       379 my $x = $b < $a ? $b + $whole : $b;
110 179         242 $x -= $a;
111 179 100       375 return $x - $whole if $x > $half;
112 130         269 return $x;
113             }
114              
115              
116 1     1 1 4710 sub cart( $r, $theta, $phi ) {
  1         3  
  1         2  
  1         2  
  1         2  
117 1         4 my $rcst = $r * cos($theta);
118 1         7 $rcst * cos($phi), $rcst * sin($phi), $r * sin($theta);
119             }
120              
121             # in previous versions was named 'polar'
122 46     46 1 7760 sub polar ( $x, $y, $z ) {
  46         86  
  46         66  
  46         59  
  46         73  
123 46         96 my $rho = $x * $x + $y * $y;
124 46         86 my $r = sqrt( $rho + $z * $z );
125 46         139 my $phi = atan2( $y, $x );
126 46 100       147 $phi += pi2 if $phi < 0;
127 46         69 $rho = sqrt($rho);
128 46         100 my $theta = atan2( $z, $rho );
129 46         148 $r, $theta, $phi;
130             }
131              
132              
133             1; # End of Astro::Montenbruck::Core::MathUtils
134              
135             __END__
136              
137             =pod
138              
139             =encoding UTF-8
140              
141             =head1 NAME
142              
143             Astro::Montenbruck::Core::MathUtils - Core mathematical routines used by AstroScript modules.
144              
145             =head1 VERSION
146              
147             Version 0.01
148              
149              
150             =head1 SYNOPSIS
151              
152             use Astro::Montenbruck::Core::MathUtils qw/dms/;
153              
154             my ($d, $m, $s) = dms(55.75); # (55, 45, 0)
155             ...
156              
157             =head1 EXPORT
158              
159             =over
160              
161             =item * L</frac($x)>
162              
163             =item * L</frac360($x)>
164              
165             =item * L</dms($x)>
166              
167             =item * L</hms($x)>
168              
169             =item * L</zdms($x)>
170              
171             =item * L</ddd($deg[, $min[, $sec]])>
172              
173             =item * L</polynome($t, @terms)>
174              
175             =item * L</to_range($x, $range)>
176              
177             =item * L</reduce_deg($x)>
178              
179             =item * L</reduce_rad($x)>
180              
181             =item * L</opposite_deg($x)>
182              
183             =item * L</opposite_rad($x)>
184              
185             =item * L</angle_c($x, $y)>
186              
187             =item * L</angle_c_rad($x, $y)>
188              
189             =item * L</angle_c_rad($x, $y)>
190              
191             =item * L</angle_s($x1, $y1, $x2, $y2)>
192              
193             =item * L</diff_angle($a, $b, $mode='degrees')>
194              
195             =item * L</diff_angle($a, $b, $mode='degrees')>
196              
197             =item * L</cart($r, $theta, $phi)>
198              
199             =item * L</polar($x, $y, $z)>
200              
201             =back
202              
203              
204             =head1 SUBROUTINES
205              
206              
207             =head2 frac($x)
208              
209             Fractional part of a decimal number.
210              
211              
212             =head2 frac360($x)
213              
214             Range function, similar to L<to_range($x, $range)>, used with polinomial function for better accuracy.
215              
216              
217             =head2 dms($x)
218              
219             Given decimal hours (or degrees), return nearest hours (or degrees), int,
220             minutes, int, and seconds, float.
221              
222             =head3 Positional arguments:
223              
224             =over
225              
226             =item * decimal value, 0..360 for angular mode, 0..24 for time
227              
228             =back
229              
230             =head3 Named arguments:
231              
232             =over
233              
234             =item * B<places> (optional) amount of required sexadecimal values to be returned (1-3);
235             default = 3 (degrees/hours, minutes, seconds)
236              
237             =back
238              
239             =head3 Returns:
240              
241             =over
242              
243             =item * array of degrees (int), minutes (int), seconds (float)
244              
245             =back
246              
247              
248             =head2 hms($x)
249              
250             Alias for L</dms>
251              
252             =head2 zdms($x)
253              
254             Converts decimal degrees to zodiac sign number (zero based), zodiac degrees, minutes and seconds.
255              
256             =head3 Positional arguments:
257              
258             =over
259              
260             =item * decimal value, 0..360 for angular mode, 0..24 for time
261              
262             =back
263              
264             =head3 Returns:
265              
266             =over
267              
268             =item * array of zodiac sign (0-11), degrees (int), minutes (int), seconds (float)
269              
270             =back
271              
272              
273             =head2 ddd($deg[, $min[, $sec]])
274              
275             Converts sexadecimal values to decimal.
276              
277             =head3 Arguments
278              
279             =over
280              
281             1 to 3 sexadecimal values, such as: degrees, minutes and
282             seconds, or degrees and minutes, or just degrees:
283              
284             =over
285              
286             =item * C<ddd(11)>
287              
288             =item * C<ddd(11, 46)>
289              
290             =item * C<ddd(11, 46, 20)>
291              
292             =back
293              
294             If any non-zero argument is negative, the result is negative.
295              
296             =over
297              
298             =item * C<ddd(-11, 46, 0) = -11.766666666666667>
299              
300             =item * C<ddd(11, -46, 0) = 11.766666666666667>
301              
302             =back
303              
304             Negative sign in wrong position is ignored.
305              
306             =back
307              
308             =head3 Returns:
309              
310             =over
311              
312             =item * decimal (degrees or hours)
313              
314             =back
315              
316              
317             =head2 polynome($t, @terms)
318              
319             Calculates polynome: $a1 + $a2*$t + $a3*$t*$t + $a4*$t*$t*$t...
320              
321             =head3 Arguments
322              
323             =over
324              
325             =item * $t coefficient, in astronomical routines usually time in centuries
326              
327             =item * any number of decimal values
328              
329             =back
330              
331             =head3 Returns:
332              
333             =over
334              
335             =item * decimal number
336              
337             =back
338              
339              
340              
341             =head2 to_range($x, $range)
342              
343             Reduces $x to 0 >= $x < $range
344              
345             =head3 Arguments
346              
347             =over
348              
349             =item * number to reduce
350              
351             =item * limit (non-inclusive), e.g: 360 for degrees, 24 for hours
352              
353             =back
354              
355             =head3 Returns
356              
357             =over
358              
359             =item * number
360              
361             =back
362              
363              
364              
365             =head2 reduce_deg($x)
366              
367             Reduces $x to 0 >= $x < 360
368              
369              
370             =head2 reduce_rad($x)
371              
372             Reduces $x to 0 >= $x < pi2
373              
374             =head2 opposite_deg($x)
375              
376             Returns opposite degree.
377              
378              
379             =head2 opposite_rad($x)
380              
381             Returns opposite radian.
382              
383             =head2 angle_c($x, $y)
384              
385             Calculate shortest arc in dergees between $x and $y.
386              
387             =head2 angle_c_rad($x, $y)
388              
389             Calculates shortest arc in radians between $x and $y.
390              
391             =head2 angle_s($x1, $y1, $x2, $y2)
392              
393             Calculates arc between 2 points on a sphera.
394             Expected arguments: 2 pairs of coordinates (X, Y) of the 2 points.
395              
396             The coordinates may be ecliptic, equatorial or horizontal.
397              
398             =head2 diff_angle($a, $b, $mode='degrees')
399              
400             Return angle C<$b - $a>, accounting for circular values.
401              
402             Parameters $a and $b should be in the range 0..pi*2 or 0..360, depending on
403             optional B<$mode> argument. The result will be in the range I<-pi..pi> or I<-180..180>.
404             This allows us to directly compare angles which cross through 0:
405             I<359 degress... 0 degrees... 1 degree...> etc.
406              
407             =head3 Positional Arguments
408              
409             =over
410              
411             =item * B<$a> first angle, in radians or degrees
412              
413             =item * B<$b> second angle, in radians or degrees
414              
415             =back
416              
417             =head3 Named Arguments
418              
419             =over
420              
421             =item * B<$mode> C<"degrees"> (default) or C<"radians">, case insensitive.
422              
423             =back
424              
425              
426             =head2 sine($x)
427              
428             Calculate sin(phi); phi in units of 1 revolution = 360 degrees
429              
430             =head2 cart($r, $theta, $phi)
431              
432             Conversion of polar coordinates (r,theta,phi) into certesian (x,y,z).
433              
434             =head3 Arguments
435              
436             =over
437              
438             =item * B<$r>, distance from the origin;
439              
440             =item * B<$theta> (in radians) corresponding to [-90 deg, +90 deg];
441              
442             =item * B<$phi> (in radians) corresponding to [-360 deg, +360 deg])
443              
444             =back
445              
446             =head3 Returns
447              
448             Rectangular coordinates:
449              
450             =over
451              
452             =item * B<$x>, X
453              
454             =item * B<$y>, Y
455              
456             =item * B<$z>, Z
457              
458              
459             =back
460              
461             =head2 polar($x, $y, $z)
462              
463             Conversion of cartesian coordinates (x,y,z) into polar (r,theta,phi).
464              
465             =head3 Arguments
466              
467             =over
468              
469             =item * B<$x>, X
470              
471             =item * B<$y>, Y
472              
473             =item * B<$z>, Z
474              
475             =back
476              
477             =head3 Returns
478              
479             Spherical coordinates:
480              
481             =over
482              
483             =item * B<$r>, distance from the origin;
484              
485             =item * B<$theta> (in radians) corresponding to [-90 deg, +90 deg];
486              
487             =item * B<$phi> (in radians) corresponding to [-360 deg, +360 deg])
488              
489             =back
490              
491              
492             =head1 AUTHOR
493              
494             Sergey Krushinsky, C<< <krushi at cpan.org> >>
495              
496             =head1 COPYRIGHT & LICENSE
497              
498             Copyright 2009-2019 Sergey Krushinsky.
499              
500             This library is free software; you can redistribute it and/or modify
501             it under the same terms as Perl itself.