File Coverage

lib/Astro/Montenbruck/Ephemeris.pm
Criterion Covered Total %
statement 77 82 93.9
branch 5 8 62.5
condition 6 6 100.0
subroutine 19 20 95.0
pod 2 2 100.0
total 109 118 92.3


line stmt bran cond sub pod time code
1              
2             package Astro::Montenbruck::Ephemeris;
3              
4 4     4   88795 use 5.22.0;
  4         20  
5 4     4   18 use strict;
  4         7  
  4         85  
6 4     4   16 use warnings;
  4         7  
  4         109  
7 4     4   17 no warnings qw/experimental/;
  4         6  
  4         160  
8 4     4   465 use Readonly;
  4         3344  
  4         175  
9 4     4   1761 use Module::Load;
  4         3961  
  4         21  
10 4     4   811 use Memoize;
  4         2076  
  4         193  
11             memoize qw/_create_constructor/;
12              
13 4     4   20 use Exporter qw/import/;
  4         9  
  4         296  
14              
15             our %EXPORT_TAGS = (
16             all => [ qw/iterator find_positions/ ],
17             );
18             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} }, );
19             our $VERSION = 0.03;
20              
21 4     4   461 use Math::Trig qw/deg2rad/;
  4         13267  
  4         202  
22 4     4   23 use List::Util qw/any/;
  4         9  
  4         193  
23 4     4   429 use Astro::Montenbruck::Ephemeris::Planet qw/:ids/;
  4         7  
  4         539  
24 4     4   384 use Astro::Montenbruck::NutEqu qw/mean2true/;
  4         7  
  4         152  
25 4     4   20 use Astro::Montenbruck::MathUtils qw/diff_angle/;
  4         8  
  4         2653  
26              
27             Readonly our $DAY_IN_CENT => 1 / 36525;
28              
29             # Factory function. Loads given class and returns function that wraps
30             # its constructor.
31             #
32             # Example:
33             # my $f = _create_constructor('Astro::Montenbruck::Ephemeris::Planets::Sun');
34             # my $sun = $f->(); # instantiate the object
35             # my @pos = $sun->position($t); # calculate coordinates for the moment $t
36             sub _create_constructor {
37             my $pkg = shift;
38             load $pkg;
39             sub { $pkg->new(@_) }
40             }
41              
42             # shortcut for _create_constructor
43             sub _construct {
44 935     935   10231 _create_constructor(join('::', qw/Astro Montenbruck Ephemeris/, @_))
45             }
46              
47              
48             sub _iterator {
49 680     680   1092 my $t = shift;
50 680         983 my $ids_ref = shift;
51 680         948 my @items = @{$ids_ref};
  680         1442  
52 680         1446 my %arg = @_;
53              
54              
55 680         1598 my $sun = _construct('Planet', $SU)->();
56 680         2018 my @sun_pos = $sun->sunpos($t);
57 680         9738 my $sun_lbr = {
58             l => deg2rad($sun_pos[0]),
59             b => deg2rad($sun_pos[1]),
60             r => $sun_pos[2]
61             };
62              
63 680         9555 my $nut_func = mean2true($t);
64              
65             # Calculate required position. Sun's coordinates are calculated only once.
66             my $get_position = sub {
67 696     696   1111 my $id = shift;
68 696         1105 given ($id) {
69 696         1533 when ($SU) {
70             return [
71 441         3031 $sun->apparent($t, \@sun_pos, $nut_func)
72             ]
73             }
74 255         1797 when ($MO) {
75 219         1243 my $moo = _construct('Planet', $id)->();
76             return [
77 219         899 $moo->apparent([$moo->moonpos($t)], $nut_func)
78             ]
79             }
80 36         144 default {
81 36         68 my $pla = _construct('Planet', $id)->();
82 36         106 my @lbr = $pla->heliocentric($t);
83             # planets
84             return [
85 36         171 $pla->apparent($t, \@lbr, $sun_lbr, $nut_func)
86             ]
87             }
88             }
89 680         2545 };
90              
91             sub {
92 702 100   702   24973 NEXT:
93             return unless @items; # no more items, stop iteration
94 698         1315 my $id = shift @items;
95 698 100 100     3150 goto NEXT if $id eq $PL && ($t < -1.1 || $t > 1.0);
      100        
96 696         4495 [ $id, $get_position->($id) ]
97             }
98 680         2651 }
99              
100              
101             sub iterator {
102 680     680 1 13855 my $t = shift;
103 680         966 my $ids_ref = shift;
104 680         1891 my %arg = (with_motion => 0, @_);
105              
106 680         2233 my $iter_1 = _iterator($t, $ids_ref, %arg);
107 680 50       3504 return $iter_1 unless $arg{with_motion};
108              
109             # to calculate mean daily motion, we need another iterator, for the next day
110 0         0 my $iter_2 = _iterator($t + $DAY_IN_CENT, $ids_ref, %arg);
111              
112             return sub {
113 0 0   0   0 my $res = $iter_1->() or return;
114 0         0 $res->[2] = diff_angle($res->[1]->[0], $iter_2->()->[1]->[0]);
115 0         0 $res
116             }
117 0         0 }
118              
119             sub find_positions {
120 1     1 1 5396 my $t = shift;
121 1         2 my $ids_ref = shift;
122 1         2 my $callback = shift;
123              
124 1         3 my $iter = iterator($t, $ids_ref, @_);
125 1         3 while ( my $res = $iter->() ) {
126 10         163 my ($id, $pos, $motion) = @$res;
127 10         23 $callback->( $id, @$pos, $motion );
128             }
129             }
130              
131              
132             1;
133             __END__
134              
135             =pod
136              
137             =encoding UTF-8
138              
139             =head1 NAME
140              
141             Astro::Montenbruck::Ephemeris - calculate planetary positions.
142              
143             =head1 SYNOPSIS
144              
145             =head2 Iterator interface
146              
147             use Astro::Montenbruck::Ephemeris::Planet qw/@PLANETS/;
148             use Astro::Montenbruck::Ephemeris qw/iterator/;
149             use Data::Dumper;
150              
151             my $jd = 2458630.5; # Standard Julian date for May 27, 2019, 00:00 UTC.
152             my $t = ($jd - 2451545) / 36525; # Convert Julian date to centuries since epoch 2000.0
153             # for better accuracy, convert $t to Ephemeris (Dynamic) time.
154             my $iter = iterator( $t, \@PLANETS ); # get iterator function for Sun. Moon and the planets.
155              
156             while ( my $result = $iter->() ) {
157             my ($id, $co) = @$result;
158             print $id, "\n", Dumper($co), "\n"; # geocentric longitude, latitude and distance from Earth
159             }
160              
161             =head2 Callback interface
162              
163             use Astro::Montenbruck::Ephemeris::Planet qw/@PLANETS/;
164             use Astro::Montenbruck::Ephemeris qw/find_positions/;
165              
166             my $jd = 2458630.5; # Standard Julian date for May 27, 2019, 00:00 UTC.
167             my $t = ($jd - 2451545) / 36525; # Convert Julian date to centuries since epoch 2000.0
168             # for better accuracy, convert $t to Ephemeris (Dynamic) time.
169              
170             find_positions($t, \@PLANETS, sub {
171             my ($id, $lambda, $beta, $delta) = @_;
172             say "$id $lambda, $beta, $delta";
173             })
174              
175              
176             =head1 DESCRIPTION
177              
178             Calculates apparent geocentric ecliptic coordinates of the Sun, the Moon, and
179             the 8 planets. Algorithms are based on I<"Astronomy on the Personal Computer">
180             by O.Montenbruck and Th.Pfleger. The results are supposed to be precise enough
181             for amateur's purposes:
182              
183             "The errors in the fundamental routines for determining the coordinates
184             of the Sun, the Moon, and the planets amount to about 1″-3″."
185              
186             -- Introduction to the 4-th edition, p.2.
187              
188             You may use one of two interfaces: iterator and callback.
189              
190             The coordinates are referred to the I<true equinox of date> and contain corrections
191             for I<precession>, I<nutation>, I<aberration> and I<light-time>.
192              
193             =head2 Implementation details
194              
195             This module is implemented as a "factory". User may not need all the planets
196             at once, so each class is loaded lazily, by demand.
197              
198             =head2 Mean daily motion
199              
200             To calculate mean daily motion along with the celestial coordinates, use
201             C<with_motion> option:
202              
203             iterator( $t, \@PLANETS, with_motion => 1 );
204             # Or:
205             find_positions($t, \@PLANETS, $callback, with_motion => 1);
206              
207             That will slow down the program.
208              
209             =head2 Pluto
210              
211             Pluto's position is calculated only between years B<1890> and B<2100>.
212             See L<Astro::Montenbruck::Ephemeris::Planet::Pluto>.
213              
214             =head2 Universal Time vs Ephemeris Time
215              
216             For better accuracy the time must be given in I<Ephemeris Time (ET)>. To convert
217             I<UT> to I<ET>, use C<delta_t> function from L<Astro::Montenbruck::Time::DeltaT> module.
218              
219             =head1 SUBROUTINES
220              
221             =head2 iterator($t, $ids, %options)
222              
223             Returns iterator function, which, on its turn, when called returns either C<undef>,
224             when exhausted, or arrayref, containing:
225              
226             =over
227              
228             =item *
229              
230             identifier of the celestial body, a string
231              
232             =item *
233              
234             arrayref, containing ecliptic coordinates: I<longitude> (arc-degrees),
235             I<latitude> (arc-degrees) and distance from Earth (AU).
236              
237             =item * mean daily motion, double, if C<with_motion> option is I<true>
238              
239             =back
240              
241             =head3 Positional Arguments
242              
243             =over
244              
245             =item *
246              
247             B<$t> — time in centuries since epoch 2000.0; for better precision UTC should be
248             converted to Ephemeris time, see L</Universal Time vs Ephemeris Time>.
249              
250             =item *
251              
252             B<$ids> — reference to an array of ids of celestial bodies to be calculated.
253              
254             =back
255              
256             =head3 Options
257              
258             =over
259              
260             =item *
261              
262             B<with_motion> — optional flag; when set to I<true>, there is additional B<motion>
263             field in the result; I<false> by default.
264              
265             =back
266              
267             =head2 find_positions($t, $ids, $callback, %options)
268              
269             The arguments and options are the same as for the L<iterator|/iterator($t, $ids, %options)>,
270             except the third argument, which is a B<callback function>, called on each iteration:
271              
272             $callback->($id, $lambda, $beta, $delta [, $daily_motion])
273              
274             I<$lambda>, I<$beta>, I<$delta> are ecliptic coordinates: I<longitude> (arc-degrees),
275             I<latitude> (arc-degrees) and distance from Earth (AU). The fifth argument,
276             I<$daily_motion> is defined only when C<with_motion> option is on; it is the
277             mean daily motion (arc-degrees).
278              
279              
280             =head1 AUTHOR
281              
282             Sergey Krushinsky, C<< <krushi at cpan.org> >>
283              
284             =head1 COPYRIGHT AND LICENSE
285              
286             Copyright (C) 2010-2022 by Sergey Krushinsky
287              
288             This library is free software; you can redistribute it and/or modify
289             it under the same terms as Perl itself.
290              
291             =cut