This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate CPAN release of version.pm 0.9905
[perl5.git] / cpan / Math-Complex / t / Trig.t
1 #!./perl 
2
3 #
4 # Regression tests for the Math::Trig package
5 #
6 # The tests here are quite modest as the Math::Complex tests exercise
7 # these interfaces quite vigorously.
8
9 # -- Jarkko Hietaniemi, April 1997
10
11 use Test::More tests => 153;
12
13 use Math::Trig 1.18;
14 use Math::Trig 1.18 qw(:pi Inf);
15
16 my $pip2 = pi / 2;
17
18 use strict;
19
20 our($x, $y, $z);
21
22 my $eps = 1e-11;
23
24 if ($^O eq 'unicos') { # See lib/Math/Complex.pm and t/lib/complex.t.
25     $eps = 1e-10;
26 }
27
28 sub near ($$;$) {
29     my $e = defined $_[2] ? $_[2] : $eps;
30     my $d = $_[1] ? abs($_[0]/$_[1] - 1) : abs($_[0]);
31     print "# near? $_[0] $_[1] : $d : $e\n";
32     $_[1] ? ($d < $e) : abs($_[0]) < $e;
33 }
34
35 print "# Sanity checks\n";
36
37 ok(near(sin(1), 0.841470984807897));
38 ok(near(cos(1), 0.54030230586814));
39 ok(near(tan(1), 1.5574077246549));
40
41 ok(near(sec(1), 1.85081571768093));
42 ok(near(csc(1), 1.18839510577812));
43 ok(near(cot(1), 0.642092615934331));
44
45 ok(near(asin(1), 1.5707963267949));
46 ok(near(acos(1), 0));
47 ok(near(atan(1), 0.785398163397448));
48
49 ok(near(asec(1), 0));
50 ok(near(acsc(1), 1.5707963267949));
51 ok(near(acot(1), 0.785398163397448));
52
53 ok(near(sinh(1), 1.1752011936438));
54 ok(near(cosh(1), 1.54308063481524));
55 ok(near(tanh(1), 0.761594155955765));
56
57 ok(near(sech(1), 0.648054273663885));
58 ok(near(csch(1), 0.850918128239322));
59 ok(near(coth(1), 1.31303528549933));
60
61 ok(near(asinh(1), 0.881373587019543));
62 ok(near(acosh(1), 0));
63 ok(near(atanh(0.9), 1.47221948958322)); # atanh(1.0) would be an error.
64
65 ok(near(asech(0.9), 0.467145308103262));
66 ok(near(acsch(2), 0.481211825059603));
67 ok(near(acoth(2), 0.549306144334055));
68
69 print "# Basics\n";
70
71 $x = 0.9;
72 ok(near(tan($x), sin($x) / cos($x)));
73
74 ok(near(sinh(2), 3.62686040784702));
75
76 ok(near(acsch(0.1), 2.99822295029797));
77
78 $x = asin(2);
79 is(ref $x, 'Math::Complex');
80
81 # avoid using Math::Complex here
82 $x =~ /^([^-]+)(-[^i]+)i$/;
83 ($y, $z) = ($1, $2);
84 ok(near($y,  1.5707963267949));
85 ok(near($z, -1.31695789692482));
86
87 ok(near(deg2rad(90), pi/2));
88
89 ok(near(rad2deg(pi), 180));
90
91 use Math::Trig ':radial';
92
93 {
94     my ($r,$t,$z) = cartesian_to_cylindrical(1,1,1);
95
96     ok(near($r, sqrt(2)));
97     ok(near($t, deg2rad(45)));
98     ok(near($z, 1));
99
100     ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
101
102     ok(near($x, 1));
103     ok(near($y, 1));
104     ok(near($z, 1));
105
106     ($r,$t,$z) = cartesian_to_cylindrical(1,1,0);
107
108     ok(near($r, sqrt(2)));
109     ok(near($t, deg2rad(45)));
110     ok(near($z, 0));
111
112     ($x,$y,$z) = cylindrical_to_cartesian($r, $t, $z);
113
114     ok(near($x, 1));
115     ok(near($y, 1));
116     ok(near($z, 0));
117 }
118
119 {
120     my ($r,$t,$f) = cartesian_to_spherical(1,1,1);
121
122     ok(near($r, sqrt(3)));
123     ok(near($t, deg2rad(45)));
124     ok(near($f, atan2(sqrt(2), 1)));
125
126     ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
127
128     ok(near($x, 1));
129     ok(near($y, 1));
130     ok(near($z, 1));
131        
132     ($r,$t,$f) = cartesian_to_spherical(1,1,0);
133
134     ok(near($r, sqrt(2)));
135     ok(near($t, deg2rad(45)));
136     ok(near($f, deg2rad(90)));
137
138     ($x,$y,$z) = spherical_to_cartesian($r, $t, $f);
139
140     ok(near($x, 1));
141     ok(near($y, 1));
142     ok(near($z, 0));
143 }
144
145 {
146     my ($r,$t,$z) = cylindrical_to_spherical(spherical_to_cylindrical(1,1,1));
147
148     ok(near($r, 1));
149     ok(near($t, 1));
150     ok(near($z, 1));
151
152     ($r,$t,$z) = spherical_to_cylindrical(cylindrical_to_spherical(1,1,1));
153
154     ok(near($r, 1));
155     ok(near($t, 1));
156     ok(near($z, 1));
157 }
158
159 {
160     use Math::Trig 'great_circle_distance';
161
162     ok(near(great_circle_distance(0, 0, 0, pi/2), pi/2));
163
164     ok(near(great_circle_distance(0, 0, pi, pi), pi));
165
166     # London to Tokyo.
167     my @L = (deg2rad(-0.5),  deg2rad(90 - 51.3));
168     my @T = (deg2rad(139.8), deg2rad(90 - 35.7));
169
170     my $km = great_circle_distance(@L, @T, 6378);
171
172     ok(near($km, 9605.26637021388));
173 }
174
175 {
176     my $R2D = 57.295779513082320876798154814169;
177
178     sub frac { $_[0] - int($_[0]) }
179
180     my $lotta_radians = deg2rad(1E+20, 1);
181     ok(near($lotta_radians,  1E+20/$R2D));
182
183     my $negat_degrees = rad2deg(-1E20, 1);
184     ok(near($negat_degrees, -1E+20*$R2D));
185
186     my $posit_degrees = rad2deg(-10000, 1);
187     ok(near($posit_degrees, -10000*$R2D));
188 }
189
190 {
191     use Math::Trig 'great_circle_direction';
192
193     ok(near(great_circle_direction(0, 0, 0, pi/2), pi));
194
195 # Retired test: Relies on atan2(0, 0), which is not portable.
196 #       ok(near(great_circle_direction(0, 0, pi, pi), -pi()/2));
197
198     my @London  = (deg2rad(  -0.167), deg2rad(90 - 51.3));
199     my @Tokyo   = (deg2rad( 139.5),   deg2rad(90 - 35.7));
200     my @Berlin  = (deg2rad ( 13.417), deg2rad(90 - 52.533));
201     my @Paris   = (deg2rad (  2.333), deg2rad(90 - 48.867));
202
203     ok(near(rad2deg(great_circle_direction(@London, @Tokyo)),
204             31.791945393073));
205
206     ok(near(rad2deg(great_circle_direction(@Tokyo, @London)),
207             336.069766430326));
208
209     ok(near(rad2deg(great_circle_direction(@Berlin, @Paris)),
210             246.800348034667));
211     
212     ok(near(rad2deg(great_circle_direction(@Paris, @Berlin)),
213             58.2079877553156));
214
215     use Math::Trig 'great_circle_bearing';
216
217     ok(near(rad2deg(great_circle_bearing(@Paris, @Berlin)),
218             58.2079877553156));
219
220     use Math::Trig 'great_circle_waypoint';
221     use Math::Trig 'great_circle_midpoint';
222
223     my ($lon, $lat);
224
225     ($lon, $lat) = great_circle_waypoint(@London, @Tokyo, 0.0);
226
227     ok(near($lon, $London[0]));
228
229     ok(near($lat, $London[1]));
230
231     ($lon, $lat) = great_circle_waypoint(@London, @Tokyo, 1.0);
232
233     ok(near($lon, $Tokyo[0]));
234
235     ok(near($lat, $Tokyo[1]));
236
237     ($lon, $lat) = great_circle_waypoint(@London, @Tokyo, 0.5);
238
239     ok(near($lon, 1.55609593577679)); # 89.16 E
240
241     ok(near($lat, 0.36783532946162)); # 68.93 N
242
243     ($lon, $lat) = great_circle_midpoint(@London, @Tokyo);
244
245     ok(near($lon, 1.55609593577679)); # 89.16 E
246
247     ok(near($lat, 0.367835329461615)); # 68.93 N
248
249     ($lon, $lat) = great_circle_waypoint(@London, @Tokyo, 0.25);
250
251     ok(near($lon, 0.516073562850837)); # 29.57 E
252
253     ok(near($lat, 0.400231313403387)); # 67.07 N
254
255     ($lon, $lat) = great_circle_waypoint(@London, @Tokyo, 0.75);
256
257     ok(near($lon, 2.17494903805952)); # 124.62 E
258
259     ok(near($lat, 0.617809294053591)); # 54.60 N
260
261     use Math::Trig 'great_circle_destination';
262
263     my $dir1 = great_circle_direction(@London, @Tokyo);
264     my $dst1 = great_circle_distance(@London,  @Tokyo);
265
266     ($lon, $lat) = great_circle_destination(@London, $dir1, $dst1);
267
268     ok(near($lon, $Tokyo[0]));
269
270     ok(near($lat, $pip2 - $Tokyo[1]));
271
272     my $dir2 = great_circle_direction(@Tokyo, @London);
273     my $dst2 = great_circle_distance(@Tokyo,  @London);
274
275     ($lon, $lat) = great_circle_destination(@Tokyo, $dir2, $dst2);
276
277     ok(near($lon, $London[0]));
278
279     ok(near($lat, $pip2 - $London[1]));
280
281     my $dir3 = (great_circle_destination(@London, $dir1, $dst1))[2];
282
283     ok(near($dir3, 2.69379263839118)); # about 154.343 deg
284
285     my $dir4 = (great_circle_destination(@Tokyo,  $dir2, $dst2))[2];
286
287     ok(near($dir4, 3.6993902625701)); # about 211.959 deg
288
289     ok(near($dst1, $dst2));
290 }
291
292 print "# Infinity\n";
293
294 my $BigDouble = 1e40;
295
296 # E.g. netbsd-alpha core dumps on Inf arith without this.
297 local $SIG{FPE} = sub { };
298
299 ok(Inf() > $BigDouble);  # This passes in netbsd-alpha.
300 ok(Inf() + $BigDouble > $BigDouble); # This coredumps in netbsd-alpha.
301 ok(Inf() + $BigDouble == Inf());
302 ok(Inf() - $BigDouble > $BigDouble);
303 ok(Inf() - $BigDouble == Inf());
304 ok(Inf() * $BigDouble > $BigDouble);
305 ok(Inf() * $BigDouble == Inf());
306 ok(Inf() / $BigDouble > $BigDouble);
307 ok(Inf() / $BigDouble == Inf());
308
309 ok(-Inf() < -$BigDouble);
310 ok(-Inf() + $BigDouble < $BigDouble);
311 ok(-Inf() + $BigDouble == -Inf());
312 ok(-Inf() - $BigDouble < -$BigDouble);
313 ok(-Inf() - $BigDouble == -Inf());
314 ok(-Inf() * $BigDouble < -$BigDouble);
315 ok(-Inf() * $BigDouble == -Inf());
316 ok(-Inf() / $BigDouble < -$BigDouble);
317 ok(-Inf() / $BigDouble == -Inf());
318
319 print "# sinh/sech/cosh/csch/tanh/coth unto infinity\n";
320
321 ok(near(sinh(100), 1.3441e+43, 1e-3));
322 ok(near(sech(100), 7.4402e-44, 1e-3));
323 ok(near(cosh(100), 1.3441e+43, 1e-3));
324 ok(near(csch(100), 7.4402e-44, 1e-3));
325 ok(near(tanh(100), 1));
326 ok(near(coth(100), 1));
327
328 ok(near(sinh(-100), -1.3441e+43, 1e-3));
329 ok(near(sech(-100),  7.4402e-44, 1e-3));
330 ok(near(cosh(-100),  1.3441e+43, 1e-3));
331 ok(near(csch(-100), -7.4402e-44, 1e-3));
332 ok(near(tanh(-100), -1));
333 ok(near(coth(-100), -1));
334
335 cmp_ok(sinh(1e5), '==', Inf());
336 cmp_ok(sech(1e5), '==', 0);
337 cmp_ok(cosh(1e5), '==', Inf());
338 cmp_ok(csch(1e5), '==', 0);
339 cmp_ok(tanh(1e5), '==', 1);
340 cmp_ok(coth(1e5), '==', 1);
341
342 cmp_ok(sinh(-1e5), '==', -Inf());
343 cmp_ok(sech(-1e5), '==', 0);
344 cmp_ok(cosh(-1e5), '==', Inf());
345 cmp_ok(csch(-1e5), '==', 0);
346 cmp_ok(tanh(-1e5), '==', -1);
347 cmp_ok(coth(-1e5), '==', -1);
348
349 print "# great_circle_distance with small angles\n";
350
351 for my $e (qw(1e-2 1e-3 1e-4 1e-5)) {
352     # Can't assume == 0 because of floating point fuzz,
353     # but let's hope for at least < $e.
354     cmp_ok(great_circle_distance(0, $e, 0, $e), '<', $e);
355 }
356
357 print "# asin_real, acos_real\n";
358
359 is(acos_real(-2.0), pi);
360 is(acos_real(-1.0), pi);
361 is(acos_real(-0.5), acos(-0.5));
362 is(acos_real( 0.0), acos( 0.0));
363 is(acos_real( 0.5), acos( 0.5));
364 is(acos_real( 1.0), 0);
365 is(acos_real( 2.0), 0);
366
367 is(asin_real(-2.0), -&pip2);
368 is(asin_real(-1.0), -&pip2);
369 is(asin_real(-0.5), asin(-0.5));
370 is(asin_real( 0.0), asin( 0.0));
371 is(asin_real( 0.5), asin( 0.5));
372 is(asin_real( 1.0),  pip2);
373 is(asin_real( 2.0),  pip2);
374
375 # eof