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