1 /*
2 * qtrans - transcendental functions for real numbers
3 *
4 * Copyright (C) 1999-2007,2021 David I. Bell and Ernest Bowen
5 *
6 * Primary author: David I. Bell
7 *
8 * Calc is open software; you can redistribute it and/or modify it under
9 * the terms of the version 2.1 of the GNU Lesser General Public License
10 * as published by the Free Software Foundation.
11 *
12 * Calc is distributed in the hope that it will be useful, but WITHOUT
13 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
14 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General
15 * Public License for more details.
16 *
17 * A copy of version 2.1 of the GNU Lesser General Public License is
18 * distributed with calc under the filename COPYING-LGPL. You should have
19 * received a copy with calc; if not, write to Free Software Foundation, Inc.
20 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
21 *
22 * Under source code control: 1990/02/15 01:48:22
23 * File existed as early as: before 1990
24 *
25 * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/
26 */
27
28 /*
29 * Transcendental functions for real numbers.
30 * These are sin, cos, exp, ln, power, cosh, sinh.
31 */
32
33
34 #include "qmath.h"
35
36
37 #include "banned.h" /* include after system header <> includes */
38
39
40 HALF _qlgenum_[] = { 36744 };
41 HALF _qlgeden_[] = { 25469 };
42 NUMBER _qlge_ = { { _qlgenum_, 1, 0 }, { _qlgeden_, 1, 0 }, 1, NULL };
43
44 /*
45 * cache the natural logarithm of 10
46 */
47 STATIC NUMBER *ln_10 = NULL;
48 STATIC NUMBER *ln_10_epsilon = NULL;
49
50 /*
51 * cache pi
52 *
53 * pivalue[LAST_PI_EPSILON] - last epsilon used to calculate pi
54 * pivalue[LAST_PI_VALUE] - last calculated pi
55 * given pivalue[LAST_PI_EPSILON] epsilon
56 * pivalue[LAST_PI_DIV_180_EPSILON] - last epsilon used to calculate pi/180
57 * pivalue[LAST_PI_DIV_180_VALUE] - last calculated pi/180 given
58 * pivalue[LAST_PI_DIV_180_EPSILON] epsilon
59 * pivalue[LAST_PI_DIV_200_EPSILON] - last epsilon used to calculate pi/200
60 * pivalue[LAST_PI_DIV_200_VALUE] - last calculated pi/200 given
61 * pivalue[LAST_PI_DIV_200_EPSILON] epsilon
62 */
63 enum pi_cache {
64 LAST_PI_EPSILON = 0,
65 LAST_PI_VALUE,
66 LAST_PI_DIV_180_EPSILON,
67 LAST_PI_DIV_180_VALUE,
68 LAST_PI_DIV_200_EPSILON,
69 LAST_PI_DIV_200_VALUE,
70 PI_CACHE_LEN /* must be last */
71 };
72 STATIC NUMBER *pivalue[PI_CACHE_LEN] = {
73 NULL, /* LAST_PI_EPSILON */
74 NULL, /* LAST_PI_VALUE */
75 NULL, /* LAST_PI_DIV_180_EPSILON */
76 NULL, /* LAST_PI_DIV_180_VALUE */
77 NULL, /* LAST_PI_DIV_200_EPSILON */
78 NULL, /* LAST_PI_DIV_200_VALUE */
79 };
80
81 /*
82 * other static function declarations
83 */
84 STATIC NUMBER *qexprel(NUMBER *q, long bitnum);
85
86 /*
87 * Evaluate and store in specified locations the sin and cos of a given
88 * number to accuracy corresponding to a specified number of binary digits.
89 */
90 void
qsincos(NUMBER * q,long bitnum,NUMBER ** vs,NUMBER ** vc)91 qsincos(NUMBER *q, long bitnum, NUMBER **vs, NUMBER **vc)
92 {
93 long n, m, k, h, s, t, d;
94 NUMBER *qtmp1, *qtmp2;
95 ZVALUE X, cossum, sinsum, mul, ztmp1, ztmp2, ztmp3;
96
97 qtmp1 = qqabs(q);
98 h = qilog2(qtmp1);
99 qfree(qtmp1);
100 k = bitnum + h + 1;
101 if (k < 0) {
102 *vs = qlink(&_qzero_);
103 *vc = qlink(&_qone_);
104 return;
105 }
106 s = k;
107 if (k) {
108 do {
109 t = s;
110 s = (s + k/s)/2;
111 }
112 while (t > s);
113 } /* s is int(sqrt(k)) */
114 s++;
115 if (s < -h)
116 s = -h;
117 n = h + s; /* n is number of squaring that will be required */
118 m = bitnum + n;
119 while (s > 0) { /* increasing m by ilog2(s) */
120 s >>= 1;
121 m++;
122 } /* m is working number of bits */
123 qtmp1 = qscale(q, m - n);
124 zquo(qtmp1->num, qtmp1->den, &X, 24);
125 qfree(qtmp1);
126 if (ziszero(X)) {
127 zfree(X);
128 *vs = qlink(&_qzero_);
129 *vc = qlink(&_qone_);
130 return;
131 }
132 zbitvalue(m, &cossum);
133 zcopy(X, &sinsum);
134 zcopy(X, &mul);
135 d = 1;
136 for (;;) {
137 X.sign = !X.sign;
138 zmul(X, mul, &ztmp1);
139 zfree(X);
140 zshift(ztmp1, -m, &ztmp2);
141 zfree(ztmp1);
142 zdivi(ztmp2, ++d, &X);
143 zfree(ztmp2);
144 if (ziszero(X))
145 break;
146 zadd(cossum, X, &ztmp1);
147 zfree(cossum);
148 cossum = ztmp1;
149 zmul(X, mul, &ztmp1);
150 zfree(X);
151 zshift(ztmp1, -m, &ztmp2);
152 zfree(ztmp1);
153 zdivi(ztmp2, ++d, &X);
154 zfree(ztmp2);
155 if (ziszero(X))
156 break;
157 zadd(sinsum, X, &ztmp1);
158 zfree(sinsum);
159 sinsum = ztmp1;
160 }
161 zfree(X);
162 zfree(mul);
163 while (n-- > 0) {
164 zsquare(cossum, &ztmp1);
165 zsquare(sinsum, &ztmp2);
166 zsub(ztmp1, ztmp2, &ztmp3);
167 zfree(ztmp1);
168 zfree(ztmp2);
169 zmul(cossum, sinsum, &ztmp1);
170 zfree(cossum);
171 zfree(sinsum);
172 zshift(ztmp3, -m, &cossum);
173 zfree(ztmp3);
174 zshift(ztmp1, 1 - m, &sinsum);
175 zfree(ztmp1);
176 }
177 h = zlowbit(cossum);
178 qtmp1 = qalloc();
179 if (m > h) {
180 zshift(cossum, -h, &qtmp1->num);
181 zbitvalue(m - h, &qtmp1->den);
182 } else {
183 zshift(cossum, - m, &qtmp1->num);
184 }
185 zfree(cossum);
186 *vc = qtmp1;
187 h = zlowbit(sinsum);
188 qtmp2 = qalloc();
189 if (m > h) {
190 zshift(sinsum, -h, &qtmp2->num);
191 zbitvalue(m - h, &qtmp2->den);
192 } else {
193 zshift(sinsum, -m, &qtmp2->num);
194 }
195 zfree(sinsum);
196 *vs = qtmp2;
197 return;
198 }
199
200 /*
201 * Calculate the cosine of a number to a near multiple of epsilon.
202 * This calls qsincos() and discards the value of sin.
203 */
204 NUMBER *
qcos(NUMBER * q,NUMBER * epsilon)205 qcos(NUMBER *q, NUMBER *epsilon)
206 {
207 NUMBER *sin, *cos, *res;
208 long n;
209
210 if (qiszero(epsilon)) {
211 math_error("Zero epsilon value for cosine");
212 /*NOTREACHED*/
213 }
214 if (qiszero(q))
215 return qlink(&_qone_);
216 n = -qilog2(epsilon);
217 if (n < 0)
218 return qlink(&_qzero_);
219 qsincos(q, n + 2, &sin, &cos);
220 qfree(sin);
221 res = qmappr(cos, epsilon, 24);
222 qfree(cos);
223 return res;
224 }
225
226
227
228 /*
229 * This calls qsincos() and discards the value of cos.
230 */
231 NUMBER *
qsin(NUMBER * q,NUMBER * epsilon)232 qsin(NUMBER *q, NUMBER *epsilon)
233 {
234 NUMBER *sin, *cos, *res;
235 long n;
236
237 if (qiszero(epsilon)) {
238 math_error("Zero epsilon value for sine");
239 /*NOTREACHED*/
240 }
241 n = -qilog2(epsilon);
242 if (qiszero(q) || n < 0)
243 return qlink(&_qzero_);
244 qsincos(q, n + 2, &sin, &cos);
245 qfree(cos);
246 res = qmappr(sin, epsilon, 24);
247 qfree(sin);
248 return res;
249 }
250
251
252 /*
253 * Calculate the tangent function.
254 */
255 NUMBER *
qtan(NUMBER * q,NUMBER * epsilon)256 qtan(NUMBER *q, NUMBER *epsilon)
257 {
258 NUMBER *sin, *cos, *tan, *res;
259 long n, k, m;
260
261 if (qiszero(epsilon)) {
262 math_error("Zero epsilon value for tangent");
263 /*NOTREACHED*/
264 }
265 if (qiszero(q))
266 return qlink(q);
267 n = qilog2(epsilon);
268 k = (n > 0) ? 4 + n/2 : 4;
269 for (;;) {
270 qsincos(q, 2 * k - n, &sin, &cos);
271 if (qiszero(cos)) {
272 qfree(sin);
273 qfree(cos);
274 k = 2 * k - n + 4;
275 continue;
276 }
277 m = -qilog2(cos);
278 if (m < k)
279 break;
280 qfree(sin);
281 qfree(cos);
282 k = m + 1;
283 }
284 tan = qqdiv(sin, cos);
285 qfree(sin);
286 qfree(cos);
287 res = qmappr(tan, epsilon, 24);
288 qfree(tan);
289 return res;
290 }
291
292
293 /*
294 * Calculate the cotangent function.
295 */
296 NUMBER *
qcot(NUMBER * q,NUMBER * epsilon)297 qcot(NUMBER *q, NUMBER *epsilon)
298 {
299 NUMBER *sin, *cos, *cot, *res;
300 long n, k, m;
301
302 if (qiszero(epsilon)) {
303 math_error("Zero epsilon value for cotangent");
304 /*NOTREACHED*/
305 }
306 if (qiszero(q)) {
307 math_error("Zero argument for cotangent");
308 /*NOTREACHED*/
309 }
310 k = -qilog2(q);
311 n = qilog2(epsilon);
312 if (k < 0)
313 k = (n > 0) ? n/2 : 0;
314 k += 4;
315 for (;;) {
316 qsincos(q, 2 * k - n, &sin, &cos);
317 if (qiszero(sin)) {
318 qfree(sin);
319 qfree(cos);
320 k = 2 * k - n + 4;
321 continue;
322 }
323 m = -qilog2(sin);
324 if (m < k)
325 break;
326 qfree(sin);
327 qfree(cos);
328 k = m + 1;
329 }
330 cot = qqdiv(cos, sin);
331 qfree(sin);
332 qfree(cos);
333 res = qmappr(cot, epsilon, 24);
334 qfree(cot);
335 return res;
336 }
337
338
339 /*
340 * Calculate the secant function.
341 */
342 NUMBER *
qsec(NUMBER * q,NUMBER * epsilon)343 qsec(NUMBER *q, NUMBER *epsilon)
344 {
345 NUMBER *sin, *cos, *sec, *res;
346 long n, k, m;
347
348 if (qiszero(epsilon)) {
349 math_error("Zero epsilon value for secant");
350 /*NOTREACHED*/
351 }
352 if (qiszero(q))
353 return qlink(&_qone_);
354 n = qilog2(epsilon);
355 k = (n > 0) ? 4 + n/2 : 4;
356 for (;;) {
357 qsincos(q, 2 * k - n, &sin, &cos);
358 qfree(sin);
359 if (qiszero(cos)) {
360 qfree(cos);
361 k = 2 * k - n + 4;
362 continue;
363 }
364 m = -qilog2(cos);
365 if (m < k)
366 break;
367 qfree(cos);
368 k = m + 1;
369 }
370 sec = qinv(cos);
371 qfree(cos);
372 res = qmappr(sec, epsilon, 24);
373 qfree(sec);
374 return res;
375 }
376
377
378 /*
379 * Calculate the cosecant function.
380 */
381 NUMBER *
qcsc(NUMBER * q,NUMBER * epsilon)382 qcsc(NUMBER *q, NUMBER *epsilon)
383 {
384 NUMBER *sin, *cos, *csc, *res;
385 long n, k, m;
386
387 if (qiszero(epsilon)) {
388 math_error("Zero epsilon value for cosecant");
389 /*NOTREACHED*/
390 }
391 if (qiszero(q)) {
392 math_error("Zero argument for cosecant");
393 /*NOTREACHED*/
394 }
395 k = -qilog2(q);
396 n = qilog2(epsilon);
397 if (k < 0)
398 k = (n > 0) ? n/2 : 0;
399 k += 4;
400 for (;;) {
401 qsincos(q, 2 * k - n, &sin, &cos);
402 qfree(cos);
403 if (qiszero(sin)) {
404 qfree(sin);
405 k = 2 * k - n + 4;
406 continue;
407 }
408 m = -qilog2(sin);
409 if (m < k)
410 break;
411 qfree(sin);
412 k = m + 1;
413 }
414 csc = qinv(sin);
415 qfree(sin);
416 res = qmappr(csc, epsilon, 24);
417 qfree(csc);
418 return res;
419 }
420 /*
421 * Calculate the arcsine function.
422 * The result is in the range -pi/2 to pi/2.
423 */
424 NUMBER *
qasin(NUMBER * q,NUMBER * epsilon)425 qasin(NUMBER *q, NUMBER *epsilon)
426 {
427 NUMBER *qtmp1, *qtmp2, *epsilon1;
428 ZVALUE ztmp;
429 BOOL neg;
430 FLAG r;
431
432 if (qiszero(epsilon)) {
433 math_error("Zero epsilon value for asin");
434 /*NOTREACHED*/
435 }
436 if (qiszero(q))
437 return qlink(&_qzero_);
438 ztmp = q->num;
439 neg = ztmp.sign;
440 ztmp.sign = 0;
441 r = zrel(ztmp, q->den);
442 if (r > 0)
443 return NULL;
444 if (r == 0) {
445 epsilon1 = qscale(epsilon, 1L);
446 qtmp2 = qpi(epsilon1);
447 qtmp1 = qscale(qtmp2, -1L);
448 } else {
449 epsilon1 = qscale(epsilon, -2L);
450 qtmp1 = qalloc();
451 zsquare(q->num, &qtmp1->num);
452 zsquare(q->den, &ztmp);
453 zsub(ztmp, qtmp1->num, &qtmp1->den);
454 zfree(ztmp);
455 qtmp2 = qsqrt(qtmp1, epsilon1, 24);
456 qfree(qtmp1);
457 qtmp1 = qatan(qtmp2, epsilon);
458 }
459 qfree(qtmp2);
460 qfree(epsilon1);
461 if (neg) {
462 qtmp2 = qneg(qtmp1);
463 qfree(qtmp1);
464 return(qtmp2);
465 }
466 return qtmp1;
467 }
468
469
470
471 /*
472 * Calculate the acos function.
473 * The result is in the range 0 to pi.
474 */
475 NUMBER *
qacos(NUMBER * q,NUMBER * epsilon)476 qacos(NUMBER *q, NUMBER *epsilon)
477 {
478 NUMBER *q1, *q2, *epsilon1;
479 ZVALUE z;
480
481 if (qiszero(epsilon)) {
482 math_error("Zero epsilon value for acos");
483 /*NOTREACHED*/
484 }
485 if (qisone(q))
486 return qlink(&_qzero_);
487 if (qisnegone(q))
488 return qpi(epsilon);
489
490 z = q->num;
491 z.sign = 0;
492 if (zrel(z, q->den) > 0)
493 return NULL;
494 epsilon1 = qscale(epsilon, -3L); /* ??? */
495 q1 = qalloc();
496 zsub(q->den, q->num, &q1->num);
497 zadd(q->den, q->num, &q1->den);
498 q2 = qsqrt(q1, epsilon1, 24L);
499 qfree(q1);
500 qfree(epsilon1);
501 epsilon1 = qscale(epsilon, -1L);
502 q1 = qatan(q2, epsilon1);
503 qfree(epsilon1);
504 qfree(q2);
505 q2 = qscale(q1, 1L);
506 qfree(q1)
507 return q2;
508 }
509
510
511 /*
512 * Calculate the arctangent function to the nearest or next to nearest
513 * multiple of epsilon. Algorithm uses
514 * atan(x) = 2 * atan(x/(1 + sqrt(1+x^2)))
515 * to reduce x to a small value and then
516 * atan(x) = x - x^3/3 + ...
517 */
518 NUMBER *
qatan(NUMBER * q,NUMBER * epsilon)519 qatan(NUMBER *q, NUMBER *epsilon)
520 {
521 long m, k, i;
522 FULL d;
523 ZVALUE X, D, DD, sum, mul, term, ztmp1, ztmp2;
524 NUMBER *qtmp, *res;
525 BOOL sign;
526
527 if (qiszero(epsilon)) {
528 math_error("Zero epsilon value for arctangent");
529 /*NOTREACHED*/
530 }
531 if (qiszero(q))
532 return qlink(&_qzero_);
533 m = 12 - qilog2(epsilon);
534 /* 4 bits for 4 doublings; 8 for rounding */
535 if (m < 8)
536 m = 8; /* m is number of working binary digits */
537 qtmp = qscale(q, m);
538 zquo(qtmp->num, qtmp->den, &X, 24);
539 qfree(qtmp);
540 zbitvalue(m, &D); /* q has become X/D */
541 zsquare(D, &DD);
542 i = 4; /* maybe this should be larger */
543 while (i-- > 0 && !ziszero(X)) {
544 zsquare(X, &ztmp1);
545 zadd(ztmp1, DD, &ztmp2);
546 zfree(ztmp1);
547 zsqrt(ztmp2, &ztmp1, 24L);
548 zfree(ztmp2);
549 zadd(ztmp1, D, &ztmp2);
550 zfree(ztmp1);
551 zshift(X, m, &ztmp1);
552 zfree(X);
553 zquo(ztmp1, ztmp2, &X, 24L);
554 zfree(ztmp1);
555 zfree(ztmp2);
556 }
557 zfree(DD);
558 zfree(D);
559 if (ziszero(X)) {
560 zfree(X);
561 return qlink(&_qzero_);
562 }
563 zcopy(X, &sum);
564 zsquare(X, &ztmp1);
565 zshift(ztmp1, -m, &mul);
566 zfree(ztmp1);
567 d = 3;
568 sign = !X.sign;
569 for (;;) {
570 if (d > BASE) {
571 math_error("Too many terms required for atan");
572 /*NOTREACHED*/
573 }
574 zmul(X, mul, &ztmp1);
575 zfree(X);
576 zshift(ztmp1, -m, &X); /* X now (original X)^d */
577 zfree(ztmp1);
578 zdivi(X, d, &term);
579 if (ziszero(term)) {
580 zfree(term);
581 break;
582 }
583 term.sign = sign;
584 zadd(sum, term, &ztmp1);
585 zfree(sum);
586 zfree(term);
587 sum = ztmp1;
588 sign = !sign;
589 d += 2;
590 }
591 zfree(mul);
592 zfree(X);
593 qtmp = qalloc();
594 k = zlowbit(sum);
595 if (k) {
596 zshift(sum, -k, &qtmp->num);
597 zfree(sum);
598 } else {
599 qtmp->num = sum;
600 }
601 zbitvalue(m - 4 - k, &qtmp->den);
602 res = qmappr(qtmp, epsilon, 24L);
603 qfree(qtmp);
604 return res;
605 }
606
607 /*
608 * Inverse secant function
609 */
610 NUMBER *
qasec(NUMBER * q,NUMBER * epsilon)611 qasec(NUMBER *q, NUMBER *epsilon)
612 {
613 NUMBER *tmp, *res;
614
615 tmp = qinv(q);
616 res = qacos(tmp, epsilon);
617 qfree(tmp);
618 return res;
619 }
620
621
622 /*
623 * Inverse cosecant function
624 */
625 NUMBER *
qacsc(NUMBER * q,NUMBER * epsilon)626 qacsc(NUMBER *q, NUMBER *epsilon)
627 {
628 NUMBER *tmp, *res;
629
630 tmp = qinv(q);
631 res = qasin(tmp, epsilon);
632 qfree(tmp);
633 return res;
634 }
635
636
637 /*
638 * Inverse cotangent function
639 */
640 NUMBER *
qacot(NUMBER * q,NUMBER * epsilon)641 qacot(NUMBER *q, NUMBER *epsilon)
642 {
643 NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
644
645 if (qiszero(epsilon)) {
646 math_error("Zero epsilon for acot");
647 /*NOTREACHED*/
648 }
649 if (qiszero(q)) {
650 epsilon1 = qscale(epsilon, 1L);
651 tmp1 = qpi(epsilon1);
652 qfree(epsilon1);
653 tmp2 = qscale(tmp1, -1L);
654 qfree(tmp1);
655 return tmp2;
656 }
657 tmp1 = qinv(q);
658 if (!qisneg(q)) {
659 tmp2 = qatan(tmp1, epsilon);
660 qfree(tmp1);
661 return tmp2;
662 }
663 epsilon1 = qscale(epsilon, -2L);
664 tmp2 = qatan(tmp1, epsilon1);
665 qfree(tmp1);
666 tmp1 = qpi(epsilon1);
667 qfree(epsilon1);
668 tmp3 = qqadd(tmp1, tmp2);
669 qfree(tmp1);
670 qfree(tmp2);
671 tmp1 = qmappr(tmp3, epsilon, 24L);
672 qfree(tmp3);
673 return tmp1;
674 }
675
676
677 /*
678 * Calculate the angle which is determined by the point (x,y).
679 * This is the same as atan(y/x) for positive x, but is continuous
680 * except for y = 0, x <= 0. By convention, y is the first argument.
681 * For all x, y, -pi < atan2 <= pi. For example, qatan2(1, -1) = 3/4 * pi.
682 */
683 NUMBER *
qatan2(NUMBER * qy,NUMBER * qx,NUMBER * epsilon)684 qatan2(NUMBER *qy, NUMBER *qx, NUMBER *epsilon)
685 {
686 NUMBER *tmp1, *tmp2, *tmp3, *epsilon2;
687
688 if (qiszero(epsilon)) {
689 math_error("Zero epsilon value for atan2");
690 /*NOTREACHED*/
691 }
692 if (qiszero(qy) && qiszero(qx)) {
693 /* conform to 4.3BSD ANSI/IEEE 754-1985 math lib */
694 return qlink(&_qzero_);
695 }
696 /*
697 * If the point is on the negative real axis, then the answer is pi.
698 */
699 if (qiszero(qy) && qisneg(qx))
700 return qpi(epsilon);
701 /*
702 * If the point is in the right half plane, then use the normal atan.
703 */
704 if (!qisneg(qx) && !qiszero(qx)) {
705 if (qiszero(qy))
706 return qlink(&_qzero_);
707 tmp1 = qqdiv(qy, qx);
708 tmp2 = qatan(tmp1, epsilon);
709 qfree(tmp1);
710 return tmp2;
711 }
712 /*
713 * The point is in the left half plane (x <= 0) with nonzero y.
714 * Calculate the angle by using the formula:
715 * atan2(y,x) = 2 * atan(sgn(y) * sqrt((x/y)^2 + 1) - x/y).
716 */
717 epsilon2 = qscale(epsilon, -4L);
718 tmp1 = qqdiv(qx, qy);
719 tmp2 = qsquare(tmp1);
720 tmp3 = qqadd(tmp2, &_qone_);
721 qfree(tmp2);
722 tmp2 = qsqrt(tmp3, epsilon2, 24L | (qy->num.sign * 64));
723 qfree(tmp3);
724 tmp3 = qsub(tmp2, tmp1);
725 qfree(tmp2);
726 qfree(tmp1);
727 qfree(epsilon2);
728 epsilon2 = qscale(epsilon, -1L);
729 tmp1 = qatan(tmp3, epsilon2);
730 qfree(epsilon2);
731 qfree(tmp3);
732 tmp2 = qscale(tmp1, 1L);
733 qfree(tmp1);
734 return tmp2;
735 }
736
737
738 /*
739 * Calculate the value of pi to within the required epsilon.
740 * This uses the following formula which only needs integer calculations
741 * except for the final operation:
742 * pi = 1 / SUMOF(comb(2 * N, N) ^ 3 * (42 * N + 5) / 2 ^ (12 * N + 4)),
743 * where the summation runs from N=0. This formula gives about 6 bits of
744 * accuracy per term. Since the denominator for each term is a power of two,
745 * we can simply use shifts to sum the terms. The combinatorial numbers
746 * in the formula are calculated recursively using the formula:
747 * comb(2*(N+1), N+1) = 2 * comb(2 * N, N) * (2 * N + 1) / N.
748 */
749 NUMBER *
qpi(NUMBER * epsilon)750 qpi(NUMBER *epsilon)
751 {
752 ZVALUE comb; /* current combinatorial value */
753 ZVALUE sum; /* current sum */
754 ZVALUE tmp1, tmp2;
755 NUMBER *r, *t1, qtmp;
756 long shift; /* current shift of result */
757 long N; /* current term number */
758 long bits; /* needed number of bits of precision */
759 long t;
760
761 /* firewall */
762 if (qiszero(epsilon)) {
763 math_error("zero epsilon value for pi");
764 /*NOTREACHED*/
765 }
766
767 /* use pi cache if epsilon marches, else flush if needed */
768 if (pivalue[LAST_PI_EPSILON] != NULL &&
769 pivalue[LAST_PI_VALUE] != NULL &&
770 epsilon == pivalue[LAST_PI_EPSILON]) {
771 return qlink(pivalue[LAST_PI_VALUE]);
772 }
773 if (pivalue[LAST_PI_EPSILON] != NULL) {
774 qfree(pivalue[LAST_PI_EPSILON]);
775 }
776 if (pivalue[LAST_PI_VALUE] != NULL) {
777 qfree(pivalue[LAST_PI_VALUE]);
778 }
779
780 bits = -qilog2(epsilon) + 4;
781 if (bits < 4)
782 bits = 4;
783 comb = _one_;
784 itoz(5L, &sum);
785 N = 0;
786 shift = 4;
787 do {
788 t = 1 + (++N & 0x1);
789 (void) zdivi(comb, N / (3 - t), &tmp1);
790 zfree(comb);
791 zmuli(tmp1, t * (2 * N - 1), &comb);
792 zfree(tmp1);
793 zsquare(comb, &tmp1);
794 zmul(comb, tmp1, &tmp2);
795 zfree(tmp1);
796 zmuli(tmp2, 42 * N + 5, &tmp1);
797 zfree(tmp2);
798 zshift(sum, 12L, &tmp2);
799 zfree(sum);
800 zadd(tmp1, tmp2, &sum);
801 t = zhighbit(tmp1);
802 zfree(tmp1);
803 zfree(tmp2);
804 shift += 12;
805 } while ((shift - t) < bits);
806 zfree(comb);
807 qtmp.num = _one_;
808 qtmp.den = sum;
809 t1 = qscale(&qtmp, shift);
810 zfree(sum);
811 r = qmappr(t1, epsilon, 24L);
812 qfree(t1);
813 pivalue[LAST_PI_EPSILON] = qlink(epsilon);
814 pivalue[LAST_PI_VALUE] = qlink(r);
815 return r;
816 }
817
818
819 /*
820 * qpidiv180 - calculate pi / 180
821 *
822 * This function returns pi/180 as used to covert between radians and degrees.
823 */
824 NUMBER *
qpidiv180(NUMBER * epsilon)825 qpidiv180(NUMBER *epsilon)
826 {
827 NUMBER *pi, *pidiv180;
828
829 /* firewall */
830 if (qiszero(epsilon)) {
831 math_error("zero epsilon value for qpidiv180");
832 /*NOTREACHED*/
833 }
834
835 /* use pi/180 cache if epsilon marches, else flush if needed */
836 if (pivalue[LAST_PI_DIV_180_EPSILON] != NULL &&
837 pivalue[LAST_PI_DIV_180_VALUE] != NULL &&
838 epsilon == pivalue[LAST_PI_DIV_180_EPSILON]) {
839 return qlink(pivalue[LAST_PI_DIV_180_VALUE]);
840 }
841 if (pivalue[LAST_PI_DIV_180_EPSILON] != NULL) {
842 qfree(pivalue[LAST_PI_DIV_180_EPSILON]);
843 }
844 if (pivalue[LAST_PI_DIV_180_VALUE] != NULL) {
845 qfree(pivalue[LAST_PI_DIV_180_VALUE]);
846 }
847
848 /* let qpi() returned cached pi or calculate new as needed */
849 pi = qpi(epsilon);
850
851 /* calculate pi/180 */
852 pidiv180 = qdivi(pi, 180);
853
854 /* cache epsilon and pi/180 */
855 pivalue[LAST_PI_DIV_180_EPSILON] = qlink(epsilon);
856 pivalue[LAST_PI_DIV_180_VALUE] = qlink(pidiv180);
857
858 /* return pi/180 */
859 return pidiv180;
860 }
861
862
863 /*
864 * qpidiv200 - calculate pi / 200
865 *
866 * This function returns pi/200 as used to covert between radians and gradians.
867 */
868 NUMBER *
qpidiv200(NUMBER * epsilon)869 qpidiv200(NUMBER *epsilon)
870 {
871 NUMBER *pi, *pidiv200;
872
873 /* firewall */
874 if (qiszero(epsilon)) {
875 math_error("zero epsilon value for qpidiv200");
876 /*NOTREACHED*/
877 }
878
879 /* use pi/200 cache if epsilon marches, else flush if needed */
880 if (pivalue[LAST_PI_DIV_200_EPSILON] != NULL &&
881 pivalue[LAST_PI_DIV_200_VALUE] != NULL &&
882 epsilon == pivalue[LAST_PI_DIV_200_EPSILON]) {
883 return qlink(pivalue[LAST_PI_DIV_200_VALUE]);
884 }
885 if (pivalue[LAST_PI_DIV_200_EPSILON] != NULL) {
886 qfree(pivalue[LAST_PI_DIV_200_EPSILON]);
887 }
888 if (pivalue[LAST_PI_DIV_200_VALUE] != NULL) {
889 qfree(pivalue[LAST_PI_DIV_200_VALUE]);
890 }
891
892 /* let qpi() returned cached pi or calculate new as needed */
893 pi = qpi(epsilon);
894
895 /* calculate pi/200 */
896 pidiv200 = qdivi(pi, 200);
897
898 /* cache epsilon and pi/200 */
899 pivalue[LAST_PI_DIV_200_EPSILON] = qlink(epsilon);
900 pivalue[LAST_PI_DIV_200_VALUE] = qlink(pidiv200);
901
902 /* return pi/200 */
903 return pidiv200;
904 }
905
906
907 /*
908 * Calculate the exponential function to the nearest or next to nearest
909 * multiple of the positive number epsilon.
910 */
911 NUMBER *
qexp(NUMBER * q,NUMBER * epsilon)912 qexp(NUMBER *q, NUMBER *epsilon)
913 {
914 long m, n;
915 NUMBER *tmp1, *tmp2;
916
917 if (qiszero(epsilon)) {
918 math_error("Zero epsilon value for exp");
919 /*NOTREACHED*/
920 }
921 if (qiszero(q))
922 return qlink(&_qone_);
923 tmp1 = qmul(q, &_qlge_);
924 m = qtoi(tmp1); /* exp(q) < 2^(m+1) or m == MAXLONG */
925 qfree(tmp1);
926
927 if (m > (1 << 30))
928 return NULL;
929
930 n = qilog2(epsilon); /* 2^n <= epsilon < 2^(n+1) */
931 if (m < n)
932 return qlink(&_qzero_);
933 tmp1 = qqabs(q);
934 tmp2 = qexprel(tmp1, m - n + 1);
935 qfree(tmp1);
936 if (tmp2 == NULL)
937 return NULL;
938 if (qisneg(q)) {
939 tmp1 = qinv(tmp2);
940 qfree(tmp2);
941 tmp2 = tmp1;
942 }
943 tmp1 = qmappr(tmp2, epsilon, 24L);
944 qfree(tmp2);
945 return tmp1;
946 }
947
948
949 /*
950 * Calculate the exponential function with relative error corresponding
951 * to a specified number of significant bits
952 * Requires *q >= 0, bitnum >= 0.
953 * This returns NULL if more than 2^30 working bits would be required.
954 */
955 S_FUNC NUMBER *
qexprel(NUMBER * q,long bitnum)956 qexprel(NUMBER *q, long bitnum)
957 {
958 long n, m, k, h, s, t, d;
959 NUMBER *qtmp1;
960 ZVALUE X, B, sum, term, ztmp1, ztmp2;
961
962 h = qilog2(q);
963 k = bitnum + h + 1;
964 if (k < 0)
965 return qlink(&_qone_);
966 s = k;
967 if (k) {
968 do {
969 t = s;
970 s = (s + k/s)/2;
971 }
972 while (t > s);
973 } /* s is int(sqrt(k)) */
974 s++;
975 if (s < -h)
976 s = -h;
977 n = h + s; /* n is number of squarings that will be required */
978 m = bitnum + n;
979 if (m > (1 << 30))
980 return NULL;
981 while (s > 0) { /* increasing m by ilog2(s) */
982 s >>= 1;
983 m++;
984 } /* m is working number of bits */
985 qtmp1 = qscale(q, m - n);
986 zquo(qtmp1->num, qtmp1->den, &X, 24);
987 qfree(qtmp1);
988 if (ziszero(X)) {
989 zfree(X);
990 return qlink(&_qone_);
991 }
992 zbitvalue(m, &sum);
993 zcopy(X, &term);
994 d = 1;
995 do {
996 zadd(sum, term, &ztmp1);
997 zfree(sum);
998 sum = ztmp1;
999 zmul(term, X, &ztmp1);
1000 zfree(term);
1001 zshift(ztmp1, -m, &ztmp2);
1002 zfree(ztmp1);
1003 zdivi(ztmp2, ++d, &term);
1004 zfree(ztmp2);
1005 }
1006 while (!ziszero(term));
1007 zfree(term);
1008 zfree(X);
1009 k = 0;
1010 zbitvalue(2 * m + 1, &B);
1011 while (n-- > 0) {
1012 k *= 2;
1013 zsquare(sum, &ztmp1);
1014 zfree(sum);
1015 if (zrel(ztmp1, B) >= 0) {
1016 zshift(ztmp1, -m - 1, &sum);
1017 k++;
1018 } else {
1019 zshift(ztmp1, -m, &sum);
1020 }
1021 zfree(ztmp1);
1022 }
1023 zfree(B);
1024 h = zlowbit(sum);
1025 qtmp1 = qalloc();
1026 if (m > h + k) {
1027 zshift(sum, -h, &qtmp1->num);
1028 zbitvalue(m - h - k, &qtmp1->den);
1029 }
1030 else
1031 zshift(sum, k - m, &qtmp1->num);
1032 zfree(sum);
1033 return qtmp1;
1034 }
1035
1036
1037 /*
1038 * Calculate the natural logarithm of a number accurate to the specified
1039 * positive epsilon.
1040 */
1041 NUMBER *
qln(NUMBER * q,NUMBER * epsilon)1042 qln(NUMBER *q, NUMBER *epsilon)
1043 {
1044 long m, n, k, h, d;
1045 ZVALUE term, sum, mul, pow, X, D, B, ztmp;
1046 NUMBER *qtmp, *res;
1047 BOOL neg;
1048
1049 if (qiszero(q) || qiszero(epsilon)) {
1050 math_error("logarithm of 0");
1051 /*NOTREACHED*/
1052 }
1053 if (qisunit(q))
1054 return qlink(&_qzero_);
1055 q = qqabs(q); /* Ignore sign of q */
1056 neg = (zrel(q->num, q->den) < 0);
1057 if (neg) {
1058 qtmp = qinv(q);
1059 qfree(q);
1060 q = qtmp;
1061 }
1062 k = qilog2(q);
1063 m = -qilog2(epsilon); /* m will be number of working bits */
1064 if (m < 0)
1065 m = 0;
1066 h = k;
1067 while (h > 0) {
1068 h /= 2;
1069 m++; /* Add 1 for each sqrt until X < 2 */
1070 }
1071 m += 18; /* 8 more sqrts, 8 for rounding, 2 for epsilon/4 */
1072 qtmp = qscale(q, m - k);
1073 zquo(qtmp->num, qtmp->den, &X, 24L);
1074 qfree(q);
1075 qfree(qtmp);
1076
1077 zbitvalue(m, &D); /* Now "q" = X/D */
1078 zbitvalue(m - 8, &ztmp);
1079 zadd(D, ztmp, &B); /* Will take sqrts until X <= B */
1080 zfree(ztmp);
1081
1082 n = 1; /* n is to count 1 + number of sqrts */
1083
1084 while (k > 0 || zrel(X, B) > 0) {
1085 n++;
1086 zshift(X, m + (k & 1), &ztmp);
1087 zfree(X);
1088 zsqrt(ztmp, &X, 24);
1089 zfree(ztmp)
1090 k /= 2;
1091 }
1092 zfree(B);
1093 zsub(X, D, &pow); /* pow, mul used as tmps */
1094 zadd(X, D, &mul);
1095 zfree(X);
1096 zfree(D);
1097 zshift(pow, m, &ztmp);
1098 zfree(pow);
1099 zquo(ztmp, mul, &pow, 24); /* pow now (X - D)/(X + D) */
1100 zfree(ztmp);
1101 zfree(mul);
1102
1103 zcopy(pow, &sum); /* pow is first term of sum */
1104 zsquare(pow, &ztmp);
1105 zshift(ztmp, -m, &mul); /* mul is now multiplier for powers */
1106 zfree(ztmp);
1107
1108 d = 1;
1109 for (;;) {
1110 zmul(pow, mul, &ztmp);
1111 zfree(pow);
1112 zshift(ztmp, -m, &pow);
1113 zfree(ztmp);
1114 d += 2;
1115 zdivi(pow, d, &term); /* Round down div should be round off */
1116 if (ziszero(term)) {
1117 zfree(term);
1118 break;
1119 }
1120 zadd(sum, term, &ztmp);
1121 zfree(term);
1122 zfree(sum);
1123 sum = ztmp;
1124 }
1125 zfree(pow);
1126 zfree(mul);
1127 qtmp = qalloc(); /* qtmp is to be 2^n * sum / 2^m */
1128 k = zlowbit(sum);
1129 sum.sign = neg;
1130 if (k + n >= m) {
1131 zshift(sum, n - m, &qtmp->num);
1132 zfree(sum);
1133 } else {
1134 if (k) {
1135 zshift(sum, -k, &qtmp->num);
1136 zfree(sum);
1137 } else {
1138 qtmp->num = sum;
1139 }
1140 zbitvalue(m - k - n, &qtmp->den);
1141 }
1142 res = qmappr(qtmp, epsilon, 24L);
1143 qfree(qtmp);
1144 return res;
1145 }
1146
1147
1148 /*
1149 * Calculate the base 10 logarithm
1150 *
1151 * log(q) = ln(q) / ln(10)
1152 */
1153 NUMBER *
qlog(NUMBER * q,NUMBER * epsilon)1154 qlog(NUMBER *q, NUMBER *epsilon)
1155 {
1156 int need_new_ln_10 = TRUE; /* FALSE => use cached ln_10 value */
1157 NUMBER *ln_q; /* ln(x) */
1158 NUMBER *ret; /* base 10 logarithm of x */
1159
1160 /* firewall */
1161 if (qiszero(q) || qiszero(epsilon)) {
1162 math_error("logarithm of 0");
1163 /*NOTREACHED*/
1164 }
1165
1166 /*
1167 * shortcut for small integer powers of 10
1168 */
1169 if (qisint(q) && qispos(q) && !zge8192b(q->num) && ziseven(q->num)) {
1170 BOOL is_10_power; /* TRUE ==> q is a power of 10 */
1171 long ilog_10; /* integer log base 10 */
1172
1173 /* try for a quick small power of 10 log */
1174 ilog_10 = zlog10(q->num, &is_10_power );
1175 if (is_10_power == TRUE) {
1176 /* is small power of 10, return log */
1177 return itoq(ilog_10);
1178 }
1179 /* q is an even integer that is not a power of 10 */
1180 }
1181
1182 /*
1183 * compute ln(c) first
1184 */
1185 ln_q = qln(q, epsilon);
1186 /* log(1) == 0 */
1187 if (qiszero(ln_q)) {
1188 return ln_q;
1189 }
1190
1191 /*
1192 * save epsilon for ln(10) if needed
1193 */
1194 if (ln_10_epsilon == NULL) {
1195 /* first time call */
1196 ln_10_epsilon = qcopy(epsilon);
1197 } else if (qcmp(ln_10_epsilon, epsilon) == TRUE) {
1198 /* replaced cached value with epsilon arg */
1199 qfree(ln_10_epsilon);
1200 ln_10_epsilon = qcopy(epsilon);
1201 } else if (ln_10 != NULL) {
1202 /* the previously computed ln(2) is OK to use */
1203 need_new_ln_10 = FALSE;
1204 }
1205
1206 /*
1207 * compute ln(10) if needed
1208 */
1209 if (need_new_ln_10 == TRUE) {
1210 if (ln_10 != NULL) {
1211 qfree(ln_10);
1212 }
1213 ln_10 = qln(&_qten_, ln_10_epsilon);
1214 }
1215
1216 /*
1217 * return ln(q) / ln(10)
1218 */
1219 ret = qqdiv(ln_q, ln_10);
1220 qfree(ln_q);
1221 return ret;
1222 }
1223
1224
1225 /*
1226 * Calculate the result of raising one number to the power of another.
1227 * The result is calculated to the nearest or next to nearest multiple of
1228 * epsilon.
1229 */
1230 NUMBER *
qpower(NUMBER * q1,NUMBER * q2,NUMBER * epsilon)1231 qpower(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
1232 {
1233 NUMBER *tmp1, *tmp2, *epsilon2;
1234 NUMBER *q1tmp, *q2tmp;
1235 long m, n;
1236
1237 if (qiszero(epsilon)) {
1238 math_error("Zero epsilon for power");
1239 /*NOTREACHED*/
1240 }
1241 if (qiszero(q1) && qisneg(q2)) {
1242 math_error("Negative power of zero");
1243 /*NOTREACHED*/
1244 }
1245 if (qiszero(q2) || qisone(q1))
1246 return qlink(&_qone_);
1247 if (qiszero(q1))
1248 return qlink(&_qzero_);
1249 if (qisneg(q1)) {
1250 math_error("Negative base for qpower");
1251 /*NOTREACHED*/
1252 }
1253 if (qisone(q2))
1254 return qmappr(q1, epsilon, 24);
1255 if (zrel(q1->num, q1->den) < 0) {
1256 q1tmp = qinv(q1);
1257 q2tmp = qneg(q2);
1258 } else {
1259 q1tmp = qlink(q1);
1260 q2tmp = qlink(q2);
1261 }
1262 if (qisone(q2tmp)) {
1263 qfree(q2tmp);
1264 q2tmp = qmappr(q1tmp, epsilon, 24);
1265 qfree(q1tmp);
1266 return q2tmp;
1267 }
1268 m = qilog2(q1tmp);
1269 n = qilog2(epsilon);
1270 if (qisneg(q2tmp)) {
1271 if (m > 0) {
1272 tmp1 = itoq(m);
1273 tmp2 = qmul(tmp1, q2tmp);
1274 m = qtoi(tmp2);
1275 } else {
1276 tmp1 = qdec(q1tmp);
1277 tmp2 = qqdiv(tmp1, q1tmp);
1278 qfree(tmp1);
1279 tmp1 = qmul(tmp2, q2tmp);
1280 qfree(tmp2);
1281 tmp2 = qmul(tmp1, &_qlge_);
1282 m = qtoi(tmp2);
1283 }
1284 } else {
1285 if (m > 0) {
1286 tmp1 = itoq(m + 1);
1287 tmp2 = qmul(tmp1, q2tmp);
1288 m = qtoi(tmp2);
1289 } else {
1290 tmp1 = qdec(q1tmp);
1291 tmp2 = qmul(tmp1, q2tmp);
1292 qfree(tmp1);
1293 tmp1 = qmul(tmp2, &_qlge_);
1294 m = qtoi(tmp1);
1295 }
1296 }
1297 qfree(tmp1);
1298 qfree(tmp2);
1299 if (m > (1 << 30)) {
1300 qfree(q1tmp);
1301 qfree(q2tmp);
1302 return NULL;
1303 }
1304 m += 1;
1305 if (m < n) {
1306 qfree(q1tmp);
1307 qfree(q2tmp);
1308 return qlink(&_qzero_);
1309 }
1310 tmp1 = qqdiv(epsilon, q2tmp);
1311 tmp2 = qscale(tmp1, -m - 4);
1312 epsilon2 = qqabs(tmp2);
1313 qfree(tmp1);
1314 qfree(tmp2);
1315 tmp1 = qln(q1tmp, epsilon2);
1316 qfree(epsilon2);
1317 tmp2 = qmul(tmp1, q2tmp);
1318 qfree(tmp1);
1319 qfree(q1tmp);
1320 qfree(q2tmp);
1321 if (qisneg(tmp2)) {
1322 tmp1 = qneg(tmp2);
1323 qfree(tmp2);
1324 tmp2 = qexprel(tmp1, m - n + 3);
1325 if (tmp2 == NULL) {
1326 qfree(tmp1);
1327 return NULL;
1328 }
1329 qfree(tmp1);
1330 tmp1 = qinv(tmp2);
1331 } else {
1332 tmp1 = qexprel(tmp2, m - n + 3) ;
1333 if (tmp1 == NULL) {
1334 qfree(tmp2);
1335 return NULL;
1336 }
1337 }
1338 qfree(tmp2);
1339 tmp2 = qmappr(tmp1, epsilon, 24L);
1340 qfree(tmp1);
1341 return tmp2;
1342 }
1343
1344
1345 /*
1346 * Calculate the K-th root of a number to within the specified accuracy.
1347 */
1348 NUMBER *
qroot(NUMBER * q1,NUMBER * q2,NUMBER * epsilon)1349 qroot(NUMBER *q1, NUMBER *q2, NUMBER *epsilon)
1350 {
1351 NUMBER *tmp1, *tmp2;
1352 int neg;
1353
1354 if (qiszero(epsilon)) {
1355 math_error("Zero epsilon for root");
1356 /*NOTREACHED*/
1357 }
1358 if (qisneg(q2) || qiszero(q2) || qisfrac(q2)) {
1359 math_error("Taking bad root of number");
1360 /*NOTREACHED*/
1361 }
1362 if (qiszero(q1) || qisone(q1) || qisone(q2))
1363 return qlink(q1);
1364 if (qistwo(q2))
1365 return qsqrt(q1, epsilon, 24L);
1366 neg = qisneg(q1);
1367 if (neg) {
1368 if (ziseven(q2->num)) {
1369 math_error("Taking even root of negative number");
1370 /*NOTREACHED*/
1371 }
1372 q1 = qqabs(q1);
1373 }
1374 tmp2 = qinv(q2);
1375 tmp1 = qpower(q1, tmp2, epsilon);
1376 qfree(tmp2);
1377 if (tmp1 == NULL)
1378 return NULL;
1379 if (neg) {
1380 tmp2 = qneg(tmp1);
1381 qfree(tmp1);
1382 tmp1 = tmp2;
1383 }
1384 return tmp1;
1385 }
1386
1387
1388 /* Calculate the hyperbolic cosine function to the nearest or next to
1389 * nearest multiple of epsilon.
1390 * This is calculated using cosh(x) = (exp(x) + 1/exp(x))/2;
1391 */
1392 NUMBER *
qcosh(NUMBER * q,NUMBER * epsilon)1393 qcosh(NUMBER *q, NUMBER *epsilon)
1394 {
1395 NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
1396
1397 epsilon1 = qscale(epsilon, -2);
1398 tmp1 = qqabs(q);
1399 tmp2 = qexp(tmp1, epsilon1);
1400 qfree(tmp1);
1401 qfree(epsilon1);
1402 if (tmp2 == NULL)
1403 return NULL;
1404 tmp1 = qinv(tmp2);
1405 tmp3 = qqadd(tmp1, tmp2);
1406 qfree(tmp1)
1407 qfree(tmp2)
1408 tmp1 = qscale(tmp3, -1);
1409 qfree(tmp3);
1410 tmp2 = qmappr(tmp1, epsilon, 24L);
1411 qfree(tmp1);
1412 return tmp2;
1413 }
1414
1415
1416 /*
1417 * Calculate the hyperbolic sine to the nearest or next to nearest
1418 * multiple of epsilon.
1419 * This is calculated using sinh(x) = (exp(x) - 1/exp(x))/2.
1420 */
1421 NUMBER *
qsinh(NUMBER * q,NUMBER * epsilon)1422 qsinh(NUMBER *q, NUMBER *epsilon)
1423 {
1424 NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
1425
1426 if (qiszero(q))
1427 return qlink(&_qzero_);
1428 epsilon1 = qscale(epsilon, -3);
1429 tmp1 = qqabs(q);
1430 tmp2 = qexp(tmp1, epsilon1);
1431 qfree(tmp1);
1432 qfree(epsilon1);
1433 if (tmp2 == NULL)
1434 return NULL;
1435 tmp1 = qinv(tmp2);
1436 tmp3 = qispos(q) ? qsub(tmp2, tmp1) : qsub(tmp1, tmp2);
1437 qfree(tmp1)
1438 qfree(tmp2)
1439 tmp1 = qscale(tmp3, -1);
1440 qfree(tmp3);
1441 tmp2 = qmappr(tmp1, epsilon, 24L);
1442 qfree(tmp1);
1443 return tmp2;
1444 }
1445
1446
1447 /*
1448 * Calculate the hyperbolic tangent to the nearest or next to nearest
1449 * multiple of epsilon.
1450 * This is calculated using the formulae:
1451 * tanh(x) = 1 or -1 for very large abs(x)
1452 * tanh(x) = (+ or -)(1 - 2 * exp(2 * x)) for large abx(x)
1453 * tanh(x) = (exp(2*x) - 1)/(exp(2*x) + 1) otherwise
1454 */
1455 NUMBER *
qtanh(NUMBER * q,NUMBER * epsilon)1456 qtanh(NUMBER *q, NUMBER *epsilon)
1457 {
1458 NUMBER *tmp1, *tmp2, *tmp3;
1459 long n, m;
1460
1461 n = qilog2(epsilon);
1462 if (n > 0 || qiszero(q))
1463 return qlink(&_qzero_);
1464 n = -n;
1465 tmp1 = qqabs(q);
1466 tmp2 = qmul(tmp1, &_qlge_);
1467 m = qtoi(tmp2); /* exp(|q|) < 2^(m+1) or m == MAXLONG */
1468 qfree(tmp2);
1469 if (m > 1 + n/2) {
1470 qfree(tmp1);
1471 return q->num.sign ? qlink(&_qnegone_) : qlink(&_qone_);
1472 }
1473 tmp2 = qscale(tmp1, 1);
1474 qfree(tmp1);
1475 tmp1 = qexprel(tmp2, 2 + n);
1476 qfree(tmp2);
1477 if (m > 1 + n/4) {
1478 tmp2 = qqdiv(&_qtwo_, tmp1);
1479 qfree(tmp1);
1480 tmp1 = qsub(&_qone_, tmp2);
1481 qfree(tmp2);
1482 } else {
1483 tmp2 = qdec(tmp1);
1484 tmp3 = qinc(tmp1);
1485 qfree(tmp1);
1486 tmp1 = qqdiv(tmp2, tmp3);
1487 qfree(tmp2);
1488 qfree(tmp3);
1489 }
1490 tmp2 = qmappr(tmp1, epsilon, 24L);
1491 qfree(tmp1);
1492 if (qisneg(q)) {
1493 tmp1 = qneg(tmp2);
1494 qfree(tmp2);
1495 return tmp1;
1496 }
1497 return tmp2;
1498 }
1499
1500
1501 /*
1502 * Hyperbolic cotangent.
1503 * Calculated using coth(x) = 1 + 2/(exp(2*x) - 1)
1504 */
1505 NUMBER *
qcoth(NUMBER * q,NUMBER * epsilon)1506 qcoth(NUMBER *q, NUMBER *epsilon)
1507 {
1508 NUMBER *tmp1, *tmp2, *res;
1509 long n, k;
1510
1511 if (qiszero(epsilon)) {
1512 math_error("Zero epsilon value for coth");
1513 /*NOTREACHED*/
1514 }
1515 if (qiszero(q)) {
1516 math_error("Zero argument for coth");
1517 /*NOTREACHED*/
1518 }
1519 tmp1 = qscale(q, 1);
1520 tmp2 = qqabs(tmp1);
1521 qfree(tmp1);
1522 k = qilog2(tmp2);
1523 n = qilog2(epsilon);
1524 if (k > 0) {
1525 tmp1 = qmul(&_qlge_, tmp2);
1526 k = qtoi(tmp1);
1527 qfree(tmp1);
1528 } else {
1529 k = 2 * k;
1530 }
1531 k = 4 - k - n;
1532 if (k < 4)
1533 k = 4;
1534 tmp1 = qexprel(tmp2, k);
1535 qfree(tmp2);
1536 tmp2 = qdec(tmp1);
1537 qfree(tmp1);
1538 if (qiszero(tmp2)) {
1539 math_error("This should not happen ????");
1540 /*NOTREACHED*/
1541 }
1542 tmp1 = qinv(tmp2);
1543 qfree(tmp2);
1544 tmp2 = qscale(tmp1, 1);
1545 qfree(tmp1);
1546 tmp1 = qinc(tmp2);
1547 qfree(tmp2);
1548 if (qisneg(q)) {
1549 tmp2 = qneg(tmp1);
1550 qfree(tmp1);
1551 tmp1 = tmp2;
1552 }
1553 res = qmappr(tmp1, epsilon, 24L);
1554 qfree(tmp1);
1555 return res;
1556 }
1557
1558
1559 NUMBER *
qsech(NUMBER * q,NUMBER * epsilon)1560 qsech(NUMBER *q, NUMBER *epsilon)
1561 {
1562 NUMBER *tmp1, *tmp2, *tmp3, *res;
1563 long n, k;
1564
1565 if (qiszero(epsilon)) {
1566 math_error("Zero epsilon value for sech");
1567 /*NOTREACHED*/
1568 }
1569 if (qiszero(q))
1570 return qlink(&_qone_);
1571
1572 tmp1 = qqabs(q);
1573 k = 0;
1574 if (zrel(tmp1->num, tmp1->den) >= 0) {
1575 tmp2 = qmul(&_qlge_, tmp1);
1576 k = qtoi(tmp2);
1577 qfree(tmp2);
1578 }
1579 n = qilog2(epsilon);
1580 if (k + n > 1) {
1581 qfree(tmp1);
1582 return qlink(&_qzero_);
1583 }
1584 tmp2 = qexprel(tmp1, 4 - k - n);
1585 qfree(tmp1);
1586 tmp1 = qinv(tmp2);
1587 tmp3 = qqadd(tmp1, tmp2);
1588 qfree(tmp1);
1589 qfree(tmp2);
1590 tmp1 = qinv(tmp3);
1591 qfree(tmp3);
1592 tmp2 = qscale(tmp1, 1);
1593 qfree(tmp1);
1594 res = qmappr(tmp2, epsilon, 24L);
1595 qfree(tmp2);
1596 return res;
1597 }
1598
1599
1600 NUMBER *
qcsch(NUMBER * q,NUMBER * epsilon)1601 qcsch(NUMBER *q, NUMBER *epsilon)
1602 {
1603 NUMBER *tmp1, *tmp2, *tmp3, *res;
1604 long n, k;
1605
1606 if (qiszero(epsilon)) {
1607 math_error("Zero epsilon value for csch");
1608 /*NOTREACHED*/
1609 }
1610 if (qiszero(q)) {
1611 math_error("Zero argument for csch");
1612 /*NOTREACHED*/
1613 }
1614
1615 n = qilog2(epsilon);
1616 tmp1 = qqabs(q);
1617 if (zrel(tmp1->num, tmp1->den) >= 0) {
1618 tmp2 = qmul(&_qlge_, tmp1);
1619 k = qtoi(tmp2);
1620 qfree(tmp2);
1621 } else {
1622 k = 2 * qilog2(tmp1);
1623 }
1624 if (k + n >= 1) {
1625 qfree(tmp1);
1626 return qlink(&_qzero_);
1627 }
1628 tmp2 = qexprel(tmp1, 4 - k - n);
1629 qfree(tmp1);
1630 tmp1 = qinv(tmp2);
1631 if (qisneg(q))
1632 tmp3 = qsub(tmp1, tmp2);
1633 else
1634 tmp3 = qsub(tmp2, tmp1);
1635 qfree(tmp1);
1636 qfree(tmp2);
1637 tmp1 = qinv(tmp3);
1638 qfree(tmp3)
1639 tmp2 = qscale(tmp1, 1);
1640 qfree(tmp1);
1641 res = qmappr(tmp2, epsilon, 24L);
1642 qfree(tmp2);
1643 return res;
1644 }
1645
1646
1647 /*
1648 * Compute the hyperbolic arccosine within the specified accuracy.
1649 * This is calculated using the formula:
1650 * acosh(x) = ln(x + sqrt(x^2 - 1)).
1651 */
1652 NUMBER *
qacosh(NUMBER * q,NUMBER * epsilon)1653 qacosh(NUMBER *q, NUMBER *epsilon)
1654 {
1655 NUMBER *tmp1, *tmp2, *epsilon1;
1656 long n;
1657
1658 if (qiszero(epsilon)) {
1659 math_error("Zero epsilon value for acosh");
1660 /*NOTREACHED*/
1661 }
1662 if (qisone(q))
1663 return qlink(&_qzero_);
1664 if (zrel(q->num, q->den) < 0)
1665 return NULL;
1666 n = qilog2(epsilon);
1667 epsilon1 = qbitvalue(n - 3);
1668 tmp1 = qsquare(q);
1669 tmp2 = qdec(tmp1);
1670 qfree(tmp1);
1671 tmp1 = qsqrt(tmp2, epsilon1, 24L);
1672 qfree(tmp2);
1673 tmp2 = qqadd(tmp1, q);
1674 qfree(tmp1);
1675 tmp1 = qln(tmp2, epsilon1);
1676 qfree(tmp2);
1677 qfree(epsilon1);
1678 tmp2 = qmappr(tmp1, epsilon, 24L);
1679 qfree(tmp1);
1680 return tmp2;
1681 }
1682
1683
1684 /*
1685 * Compute the hyperbolic arcsine within the specified accuracy.
1686 * This is calculated using the formula:
1687 * asinh(x) = ln(x + sqrt(x^2 + 1)).
1688 */
1689 NUMBER *
qasinh(NUMBER * q,NUMBER * epsilon)1690 qasinh(NUMBER *q, NUMBER *epsilon)
1691 {
1692 NUMBER *tmp1, *tmp2, *epsilon1;
1693 long n;
1694 BOOL neg;
1695
1696 if (qiszero(epsilon)) {
1697 math_error("Zero epsilon value for asinh");
1698 /*NOTREACHED*/
1699 }
1700 if (qiszero(q))
1701 return qlink(&_qzero_);
1702 neg = qisneg(q);
1703 q = qqabs(q);
1704 n = qilog2(epsilon);
1705 epsilon1 = qbitvalue(n - 3);
1706 tmp1 = qsquare(q);
1707 tmp2 = qinc(tmp1);
1708 qfree(tmp1);
1709 tmp1 = qsqrt(tmp2, epsilon1, 24L);
1710 qfree(tmp2);
1711 tmp2 = qqadd(tmp1, q);
1712 qfree(tmp1);
1713 tmp1 = qln(tmp2, epsilon1);
1714 qfree(tmp2);
1715 qfree(q);
1716 qfree(epsilon1);
1717 tmp2 = qmappr(tmp1, epsilon, 24L);
1718 if (neg) {
1719 tmp1 = qneg(tmp2);
1720 qfree(tmp2);
1721 return tmp1;
1722 }
1723 return tmp2;
1724 }
1725
1726
1727 /*
1728 * Compute the hyperbolic arctangent within the specified accuracy.
1729 * This is calculated using the formula:
1730 * atanh(x) = ln((1 + x) / (1 - x)) / 2.
1731 */
1732 NUMBER *
qatanh(NUMBER * q,NUMBER * epsilon)1733 qatanh(NUMBER *q, NUMBER *epsilon)
1734 {
1735 NUMBER *tmp1, *tmp2, *tmp3, *epsilon1;
1736 ZVALUE z;
1737
1738 if (qiszero(epsilon)) {
1739 math_error("Zero epsilon value for atanh");
1740 /*NOTREACHED*/
1741 }
1742 if (qiszero(q))
1743 return qlink(&_qzero_);
1744 z = q->num;
1745 z.sign = 0;
1746 if (zrel(z, q->den) >= 0)
1747 return NULL;
1748 tmp1 = qinc(q);
1749 tmp2 = qsub(&_qone_, q);
1750 tmp3 = qqdiv(tmp1, tmp2);
1751 qfree(tmp1);
1752 qfree(tmp2);
1753 epsilon1 = qscale(epsilon, 1L);
1754 tmp1 = qln(tmp3, epsilon1);
1755 qfree(tmp3);
1756 tmp2 = qscale(tmp1, -1L);
1757 qfree(tmp1);
1758 qfree(epsilon1);
1759 return tmp2;
1760 }
1761
1762
1763 /*
1764 * Inverse hyperbolic secant function
1765 */
1766 NUMBER *
qasech(NUMBER * q,NUMBER * epsilon)1767 qasech(NUMBER *q, NUMBER *epsilon)
1768 {
1769 NUMBER *tmp, *res;
1770
1771 tmp = qinv(q);
1772 res = qacosh(tmp, epsilon);
1773 qfree(tmp);
1774 return res;
1775 }
1776
1777
1778 /*
1779 * Inverse hyperbolic cosecant function
1780 */
1781 NUMBER *
qacsch(NUMBER * q,NUMBER * epsilon)1782 qacsch(NUMBER *q, NUMBER *epsilon)
1783 {
1784 NUMBER *tmp, *res;
1785
1786 tmp = qinv(q);
1787 res = qasinh(tmp, epsilon);
1788 qfree(tmp);
1789 return res;
1790 }
1791
1792
1793 /*
1794 * Inverse hyperbolic cotangent function
1795 */
1796 NUMBER *
qacoth(NUMBER * q,NUMBER * epsilon)1797 qacoth(NUMBER *q, NUMBER *epsilon)
1798 {
1799 NUMBER *tmp, *res;
1800
1801 tmp = qinv(q);
1802 res = qatanh(tmp, epsilon);
1803 qfree(tmp);
1804 return res;
1805 }
1806