/[ascend]/trunk/base/generic/compiler/func.c
ViewVC logotype

Contents of /trunk/base/generic/compiler/func.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 823 - (show annotations) (download) (as text)
Thu Aug 17 15:50:42 2006 UTC (14 years, 1 month ago) by johnpye
File MIME type: text/x-csrc
File size: 21902 byte(s)
Fixed a big with incorrect evaluation of 'arctan' in 'SAFE' evaluation mode.
NOT YET TESTED.
1 /*
2 * Function Module
3 * by Tom Epperly
4 * Created: 8/11/1990
5 * Version: $Revision: 1.18 $
6 * Version control file: $RCSfile: func.c,v $
7 * Date last modified: $Date: 2001/01/31 22:23:53 $
8 * Last modified by: $Author: ballan $
9 *
10 * This file is part of the Ascend Language Interpreter.
11 *
12 * Copyright (C) 1990, 1993, 1994 Thomas Guthrie Epperly
13 *
14 * The Ascend Language Interpreter is free software; you can redistribute
15 * it and/or modify it under the terms of the GNU General Public License as
16 * published by the Free Software Foundation; either version 2 of the
17 * License, or (at your option) any later version.
18 *
19 * The Ascend Language Interpreter is distributed in hope that it will be
20 * useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
21 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
22 * General Public License for more details.
23 *
24 * You should have received a copy of the GNU General Public License
25 * along with the program; if not, write to the Free Software Foundation,
26 * Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the file named
27 * COPYING.
28 *
29 */
30
31 #include<math.h>
32 #include <utilities/ascConfig.h>
33 #include "compiler.h"
34 #include "fractions.h"
35 #include "dimen.h"
36 #include "functype.h"
37 #include "safe.h"
38 #include "func.h"
39
40 #ifndef M_PI
41 #define M_PI F_PI
42 #endif
43 #ifndef M_LOG10E
44 #define M_LOG10E F_LOG10_COEF
45 #endif
46
47 #ifndef NULL
48 #define NULL 0L
49 #endif
50
51 #ifndef lint
52 static CONST char FunctionEvalRCSid[]="$Id: func.c,v 1.18 2001/01/31 22:23:53 ballan Exp $";
53 #endif
54
55
56 double g_lnm_epsilon = 1.0e-8;
57
58
59 #if defined(__WIN32__) || defined(_WIN32) || defined(WIN32)
60 double cbrt(register double d)
61 {
62 return pow(d,(double)0.3333333333333333333333);
63 }
64 #endif
65
66 int ascnintF(register double d)
67 {
68 return ((d)>=0.0 ? (int)floor((d) + 0.5) : -(int)floor(0.5 - (d)));
69 }
70
71
72 double dln(register double d)
73 {
74 return 1.0/d;
75 }
76
77 double dln2(register double d)
78 {
79 return -1.0/(d*d);
80 }
81
82
83 double lnm(register double d)
84 {
85 return (d>g_lnm_epsilon?log(d):d/g_lnm_epsilon + (log(g_lnm_epsilon) -1));
86
87 }
88
89 double dlnm(register double d)
90 {
91 return ( d>g_lnm_epsilon ? (double)1.0/d : 1/g_lnm_epsilon);
92 }
93
94 double dlnm2(register double d)
95 {
96 return (d>g_lnm_epsilon ? (double)-1.0/(d*d) : (double)0.0);
97 }
98
99 double dlog10(register double d)
100 {
101 return M_LOG10E/d;
102 }
103
104 double dlog102(register double d)
105 {
106 return -M_LOG10E/(d*d);
107 }
108
109 double dcos(register double d)
110 {
111 return -sin(d);
112 }
113
114 double dcos2(register double d)
115 {
116 return -cos(d);
117 }
118
119 double dtan(register double d)
120 {
121 register double t;
122 t=cos(d);
123 return 1.0/(t*t);
124 }
125
126 double dtan2(register double d)
127 {
128 register double t;
129 t=cos(d);
130 return ldexp(tan(d)/(t*t),1);
131 }
132
133 double sqr(register double d)
134 {
135 return d*d;
136 }
137
138 double dsqr(register double d)
139 {
140 return ldexp(d,1);
141 }
142
143 double dsqr2(register double d)
144 {
145 (void)d; /* stop gcc whine about unused parameter */
146 return 2.0;
147 }
148
149 double hold(double d)
150 {
151 return d;
152 }
153
154 double dsqrt(register double d)
155 {
156 return 1.0/(ldexp(sqrt(d),1));
157 }
158
159 double dsqrt2(register double d)
160 {
161 return -1.0/ldexp(sqrt(d)*d,2);
162 }
163
164 double dfabs(register double d)
165 {
166 return ((d > 0.0) ? 1.0 : ((d<0.0 ) ? -1 : 0));
167 }
168
169 double dfabs2(register double d)
170 {
171 (void)d; /* stop gcc whine about unused parameter */
172 return 0.0;
173 }
174
175 double dhold(double d)
176 {
177 (void)d; /* stop gcc whine about unused parameter */
178 return 0;
179 }
180
181 /* The next 4 are new */
182 double asc_ipow(register double d, int i) {
183 unsigned negative = 0;
184 negative = (i<0);
185 if (negative) i = (-i);
186 if (d==0 && i!=0) return 0.0;
187 switch (i) {
188 case 0: return 1.0; /* a^0 = 1, for a==0 pow is undefined. */
189 case 1: break;
190 case 2: d *= d; break;
191 case 3: d = d*d*d; break;
192 case 4: d = d*d*d*d;break;
193 case 5: d = d*d*d*d*d; break;
194 case 6: d = d*d*d*d*d*d; break;
195 case 7: d = d*d*d*d*d*d*d; break;
196 case 8: d = d*d*d*d*d*d*d*d; break;
197 case 9: d = d*d*d*d*d*d*d*d*d; break;
198 default:
199 {
200 register double res;
201 res = d;
202 for (--i; i > 0; i--) res *= d;
203 d = res;
204 }
205 break;
206 }
207 return (!negative ? d : 1.0/d);
208 }
209
210 /*
211 * Note that the following derivative functions do not
212 * set calc_ok to FALSE in the event of errors. This
213 * checking is done in the solver so we are baisicaly
214 * double checking now -> this should be fixed
215 */
216
217 double asc_d1ipow(double d, int i) {
218 if (d == 0 && i <= 1) {
219 FPRINTF(stderr,"ERROR:\t(calc) calc_ipow_D1\n");
220 FPRINTF(stderr,
221 "\t1st derivative, %g raised to %d <= 1 power undefined.\n",
222 d,i);
223 FPRINTF(stderr,"\tReturning %g.\n",0.0);
224 return(0.0);
225 }
226 return( i * asc_ipow(d,i-1));
227 }
228
229 double asc_d2ipow(double d, int i) {
230 if (d == 0 && i <= 2) {
231 FPRINTF(stderr,"ERROR:\t(calc) calc_ipow_D2\n");
232 FPRINTF(stderr,
233 "\t2nd derivative, %g raised to %d <= 2 power undefined.\n",
234 d,i);
235 FPRINTF(stderr,"\tReturning %g.\n",0.0);
236 return(0.0);
237 }
238 return( i * (i - 1) * asc_ipow(d,i-2));
239 }
240
241
242 double cube(register double d)
243 {
244 return d*d*d;
245 }
246 double dcube(register double d)
247 {
248 return 3.0*d*d;
249 }
250 double dcube2(register double d)
251 {
252 return 6.0*d;
253 }
254
255 double dcbrt(register double d)
256 {
257 register double c;
258 c=cbrt(d);
259 return (double)0.3333333333333333/(c*c);
260 }
261
262 double dcbrt2(register double d)
263 {
264 register double c;
265 c=cbrt(d);
266 return (double)-0.2222222222222222/pow(c,5.0);
267 }
268
269 double dasin(register double d)
270 {
271 return 1.0/sqrt(1.0-d*d);
272 }
273
274 double dasin2(register double d)
275 {
276 register double c;
277 c=1.0-d*d;
278 return d/(c*sqrt(c));
279 }
280
281 double dacos(register double d)
282 {
283 return -1.0/sqrt(1-d*d);
284 }
285
286 double dacos2(register double d)
287 {
288 register double c;
289 c=1.0-d*d;
290 return -d/(c*sqrt(c));
291 }
292
293 double datan(register double d)
294 {
295 return 1.0/(1.0+d*d);
296 }
297
298 double datan2(register double d)
299 {
300 return -ldexp(d/(1.0+d*d),1);
301 }
302
303 #ifdef HAVE_ERF
304 double derf(register double d)
305 {
306 return ldexp(exp(-(d*d))/sqrt(M_PI),1);
307 }
308
309 double derf2(register double d)
310 {
311 return -ldexp(d*exp(-(d*d))/sqrt(M_PI),2);
312 }
313 #endif /* HAVE_ERF */
314
315 double dtanh(register double d)
316 {
317 register double c;
318 c = cosh(d);
319 c = 1/(c*c);
320 return c;
321 }
322
323 double dtanh2(register double d)
324 {
325 register double c;
326 c = cosh(d);
327 return -ldexp(tanh(d),1)/(c*c);
328 }
329
330 double arcsinh(register double d)
331 {
332 return log(d+sqrt(d*d+1.0));
333 }
334
335 double darcsinh(register double d)
336 {
337 return 1.0/sqrt(d*d+1.0);
338 }
339
340 double darcsinh2(register double d)
341 {
342 register double c;
343 c=d*d+1.0;
344 return -d/sqrt(c*c*c);
345 }
346
347 double arccosh(register double d)
348 {
349 return log(d+sqrt(d*d-1.0));
350 }
351
352 double darccosh(register double d)
353 {
354 return 1.0/sqrt(d*d-1.0);
355 }
356
357 double darccosh2(register double d)
358 {
359 register double c;
360 c=d*d-1.0;
361 return -d/sqrt(c*c*c);
362 }
363
364 double arctanh(register double d)
365 {
366 return ldexp( log((d+1.0)/(1.0-d)) ,-1);
367 /* an alternative, more expensive but perhaps less exception prone
368 * coding of arctanh is:
369 * return log(sqrt((d+1.0)/(1.0-d)));
370 * which for d near -1 will be less likely to underflow and send 0
371 * to the log function. Until otherwise noted we are running the
372 * cheap version.
373 */
374 }
375
376 double darctanh(register double d)
377 {
378 return 1.0/(1-d*d);
379 }
380
381 double darctanh2(register double d)
382 {
383 register double c;
384 c=1.0-d*d;
385 return ldexp( d/(c*c) ,1);
386 }
387
388 #ifdef CHRIS_FUNC
389 void ExpSlope(unsigned long int nvar,
390 struct Interval *center, struct Interval *range,
391 struct Interval *slope)
392 {
393 *center = ExpInterval(*center);
394 *range = ExpInterval(*range);
395 while (nvar--){
396 *slope = MulIntervals(*range,*slope);
397 slope++;
398 }
399 }
400
401 void LnSlope(unsigned long int nvar,
402 struct Interval *center, struct Interval *range,
403 struct Interval *slope)
404 {
405 while(nvar--){
406 *slope = DivIntervals(*slope,*range);
407 slope++;
408 }
409 *center = LnInterval(*center);
410 *range = LnInterval(*range);
411 }
412
413 void LogSlope(unsigned long int nvar,
414 struct Interval *center, struct Interval *range,
415 struct Interval *slope)
416 {
417 struct Interval temp;
418 temp = MulIntervals(CreateThin(M_LN10),*range);
419 while(nvar--){
420 *slope = DivIntervals(*slope,temp);
421 slope++;
422 }
423 *center = LogInterval(*center);
424 *range = LogInterval(*range);
425 }
426
427 void SqrSlope(unsigned long int nvar,
428 struct Interval *center, struct Interval *range,
429 struct Interval *slope)
430 {
431 struct Interval temp;
432 temp = AddIntervals(*center,*range);
433 while(nvar--){
434 *slope = MulIntervals(temp,*slope);
435 slope++;
436 }
437 *center = SqrInterval(*center);
438 *range = SqrInterval(*range);
439 }
440
441 void SqrtSlope(unsigned long int nvar,
442 struct Interval *center, struct Interval *range,
443 struct Interval *slope)
444 {
445 struct Interval temp;
446 *center = SqrtInterval(*center);
447 *range = SqrtInterval(*range);
448 temp = AddIntervals(*center,*range);
449 while(nvar--){
450 *slope = DivIntervals(*slope,temp);
451 slope++;
452 }
453 }
454
455 #ifdef HAVE_ERF
456 void ErfSlope(unsigned long int nvar,
457 struct Interval *center, struct Interval *range,
458 struct Interval *slope)
459 {
460 struct Interval temp;
461 temp =
462 DivIntervals(MulIntervals(CreateThinInteger(2l),
463 ExpInterval(NegInterval(SqrInterval(*range)))),
464 SqrtInterval(CreateThin(M_PI)));
465 while(nvar--){
466 *slope =
467 MulIntervals(temp,*slope);
468 slope++;
469 }
470 *center = ErfInterval(*center);
471 *range = ErfInterval(*range);
472 }
473
474 struct Interval ErfDeriv(struct Interval i)
475 {
476 return
477 DivIntervals(MulIntervals(CreateThinInteger(2l),
478 ExpInterval(NegInterval(SqrInterval(i)))),
479 SqrtInterval(CreateThin(M_PI)));
480 }
481 #endif /* HAVE_ERF */
482
483 struct Interval LnDeriv(struct Interval i)
484 {
485 return DivIntervals(CreateThinInteger(1L),i);
486 }
487
488 struct Interval LogDeriv(struct Interval i)
489 {
490 return DivIntervals(CreateThin(M_LOG10E),i);
491 }
492
493 struct Interval SqrDeriv(struct Interval i)
494 {
495 return MulIntervals(CreateThinInteger(2L),i);
496 }
497
498 struct Interval SqrtDeriv(struct Interval i)
499 {
500 return DivIntervals(CreateThinInteger(1L),
501 MulIntervals(CreateThinInteger(2L),
502 SqrtInterval(i)));
503 }
504
505 double MinOfRange(double lower, double upper)
506 {
507 return lower;
508 }
509
510 double MaxOfRange(double lower, double upper)
511 {
512 return upper;
513 }
514
515 double ArgMinSqr(double lower, double upper)
516 {
517 if (upper < 0.0) return upper;
518 if (lower > 0.0) return lower;
519 return 0.0;
520 }
521
522 double ArgMaxSqr(double lower, double upper)
523 {
524 return (ABS(lower)>ABS(upper))?lower:upper;
525 }
526
527 double ConvexOfSqr(double x, double lower, double upper,
528 double (*value) (/* ??? */))
529 {
530 return x*x;
531 }
532
533 double ConvexDOfSqr(double x, double lower, double upper,
534 double (*value) (/* ??? */))
535 {
536 return 2*x;
537 }
538
539 double ConcaveOfSqr(double x, double lower, double upper,
540 double (*value) (/* ??? */))
541 {
542 return (lower+upper)*x-lower*upper;
543 }
544
545 double ConcaveDOfSqr(double x, double lower, double upper,
546 double (*value) (/* ??? */))
547 {
548 return lower+upper;
549 }
550
551 double ConvexOfExp(double x, double lower, double upper,
552 double (*value) (/* ??? */))
553 {
554 return exp(x);
555 }
556
557 double ConcaveOfLn(double x, double lower, double upper,
558 double (*value) (/* ??? */))
559 {
560 return log(x);
561 }
562
563 double ConcaveDOfLn(double x, double lower, double upper,
564 double (*value) (/* ??? */))
565 {
566 return 1.0/x;
567 }
568
569 double ConcaveOfLog(double x, double lower, double upper,
570 double (*value) (/* ??? */))
571 {
572 return log10(x);
573 }
574
575 double ConcaveDOfLog(double x, double lower, double upper,
576 double (*value) (/* ??? */))
577 {
578 return M_LOG10E/x;
579 }
580
581 double ConcaveOfSqrt(double x, double lower, double upper,
582 double (*value) (/* ??? */))
583 {
584 return sqrt(x);
585 }
586
587 double ConcaveDOfSqrt(double x, double lower, double upper,
588 double (*value) (/* ??? */))
589 {
590 return 0.5/sqrt(x);
591 }
592
593 double Interpolate(double x, double lower, double upper,
594 double (*value) (/* ??? */))
595 {
596 register double vl,vu;
597 vl = (*value)(lower);
598 vu = (*value)(upper);
599 return ((vu-vl)*x+upper*vl-lower*vu)/(upper-lower);
600 }
601
602 double InterpolateD(double x, double lower, double upper,
603 double (*value) (/* ??? */))
604 {
605 return ((*value)(upper)-(*value)(lower))/(upper-lower);
606 }
607
608 #endif
609
610 struct Func g_exp_f = {
611 "exp",
612 "exp",
613 "exp",
614 "exp",
615 F_EXP,
616 exp,
617 exp,
618 exp,
619 safe_exp_D0,
620 safe_exp_D1,
621 safe_exp_D2,
622 #ifdef CHRIS_FUNC
623 ExpInterval,
624 ExpSlope,
625 ExpInterval,
626 MinOfRange,
627 MaxOfRange,
628 ConvexOfExp,
629 ConvexOfExp,
630 Interpolate,
631 InterpolateD
632 #endif
633 };
634
635 struct Func g_ln_f = {
636 "ln",
637 "log",
638 "dln",
639 "dln2",
640 F_LN,
641 log,
642 dln,
643 dln2,
644 safe_ln_D0,
645 safe_ln_D1,
646 safe_ln_D2,
647 #ifdef CHRIS_FUNC
648 LnInterval,
649 LnSlope,
650 LnDeriv,
651 MinOfRange,
652 MaxOfRange,
653 Interpolate,
654 InterpolateD,
655 ConcaveOfLn,
656 ConcaveDOfLn
657 #endif
658 };
659
660 struct Func g_lnm_f = {
661 "lnm",
662 "lnm",
663 "dlnm",
664 "dlnm2",
665 F_LNM,
666 lnm,
667 dlnm,
668 dlnm2,
669 safe_lnm_D0,
670 safe_lnm_D1,
671 safe_lnm_D2,
672 #ifdef CHRIS_FUNC
673 NULL,
674 NULL,
675 NULL,
676 NULL,
677 NULL,
678 NULL,
679 NULL,
680 NULL,
681 NULL
682 #endif
683 };
684
685 struct Func g_log10_f = {
686 "log10",
687 "log10",
688 "dlog10",
689 "dlog102",
690 F_LOG10,
691 log10,
692 dlog10,
693 dlog102,
694 safe_log10_D0,
695 safe_log10_D1,
696 safe_log10_D2,
697 #ifdef CHRIS_FUNC
698 Log10Interval,
699 Log10Slope,
700 Log10Deriv,
701 MinOfRange,
702 MaxOfRange,
703 Interpolate,
704 InterpolateD,
705 ConcaveOfLog10,
706 ConcaveDOfLog10
707 #endif
708 };
709
710 struct Func g_sin_f = {
711 "sin",
712 "sin",
713 "cos",
714 "dcos",
715 F_SIN,
716 sin,
717 cos,
718 dcos,
719 safe_sin_D0,
720 safe_sin_D1,
721 safe_sin_D2,
722 #ifdef CHRIS_FUNC
723 NULL,
724 NULL,
725 NULL,
726 NULL,
727 NULL,
728 NULL,
729 NULL,
730 NULL,
731 NULL
732 #endif
733 };
734
735 struct Func g_cos_f = {
736 "cos",
737 "cos",
738 "dcos",
739 "dcos2",
740 F_COS,
741 cos,
742 dcos,
743 dcos2,
744 safe_cos_D0,
745 safe_cos_D1,
746 safe_cos_D2,
747 #ifdef CHRIS_FUNC
748 NULL,
749 NULL,
750 NULL,
751 NULL,
752 NULL,
753 NULL,
754 NULL,
755 NULL,
756 NULL
757 #endif
758 };
759
760 struct Func g_tan_f = {
761 "tan",
762 "tan",
763 "dtan",
764 "dtan2",
765 F_TAN,
766 tan,
767 dtan,
768 dtan2,
769 safe_tan_D0,
770 safe_tan_D1,
771 safe_tan_D2,
772 #ifdef CHRIS_FUNC
773 NULL,
774 NULL,
775 NULL,
776 NULL,
777 NULL,
778 NULL,
779 NULL,
780 NULL,
781 NULL
782 #endif
783 };
784
785 struct Func g_sqr_f = {
786 "sqr",
787 "sqr",
788 "dsqr",
789 "dsqr2",
790 F_SQR,
791 sqr,
792 dsqr,
793 dsqr2,
794 safe_sqr_D0,
795 safe_sqr_D1,
796 safe_sqr_D2,
797 #ifdef CHRIS_FUNC
798 SqrInterval,
799 SqrSlope,
800 SqrDeriv,
801 ArgMinSqr,
802 ArgMaxSqr,
803 ConvexOfSqr,
804 ConvexDOfSqr,
805 ConcaveOfSqr,
806 ConcaveDOfSqr
807 #endif
808 };
809
810 struct Func g_sqrt_f = {
811 "sqrt",
812 "sqrt",
813 "dsqrt",
814 "dsqrt2",
815 F_SQRT,
816 sqrt,
817 dsqrt,
818 dsqrt2,
819 safe_sqrt_D0,
820 safe_sqrt_D1,
821 safe_sqrt_D2,
822 #ifdef CHRIS_FUNC
823 SqrtInterval,
824 SqrtSlope,
825 SqrtDeriv,
826 MinOfRange,
827 MaxOfRange,
828 Interpolate,
829 InterpolateD,
830 ConcaveOfSqrt,
831 ConcaveDOfSqrt
832 #endif
833 };
834
835 struct Func g_abs_f = {
836 "abs",
837 "fabs",
838 "dfabs",
839 "dfabs2",
840 F_ABS,
841 fabs,
842 dfabs,
843 dfabs2,
844 safe_fabs_D0,
845 safe_fabs_D1,
846 safe_fabs_D2,
847 #ifdef CHRIS_FUNC
848 NULL,
849 NULL,
850 NULL,
851 NULL,
852 NULL,
853 NULL,
854 NULL,
855 NULL,
856 NULL
857 #endif
858 };
859
860 struct Func g_hold_f = {
861 "hold",
862 "hold",
863 "dhold",
864 "dhold2",
865 F_HOLD,
866 hold,
867 dhold,
868 dhold2,
869 safe_hold_D0,
870 safe_hold_D1,
871 safe_hold_D2,
872 #ifdef CHRIS_FUNC
873 NULL,
874 NULL,
875 NULL,
876 NULL,
877 NULL,
878 NULL,
879 NULL,
880 NULL,
881 NULL
882 #endif
883 };
884
885 struct Func g_arcsin_f = {
886 "arcsin",
887 "asin",
888 "dasin",
889 "dasin2",
890 F_ARCSIN,
891 asin,
892 dasin,
893 dasin2,
894 safe_arcsin_D0,
895 safe_arcsin_D1,
896 safe_arcsin_D2,
897 #ifdef CHRIS_FUNC
898 NULL,
899 NULL,
900 NULL,
901 NULL,
902 NULL,
903 NULL,
904 NULL,
905 NULL,
906 NULL
907 #endif
908 };
909
910 struct Func g_arccos_f = {
911 "arccos",
912 "acos",
913 "dacos",
914 "dacos2",
915 F_ARCCOS,
916 acos,
917 dacos,
918 dacos2,
919 safe_arccos_D0,
920 safe_arccos_D1,
921 safe_arccos_D2,
922 #ifdef CHRIS_FUNC
923 NULL,
924 NULL,
925 NULL,
926 NULL,
927 NULL,
928 NULL,
929 NULL,
930 NULL,
931 NULL
932 #endif
933 };
934
935 struct Func g_arctan_f = {
936 "arctan",
937 "atan",
938 "datan",
939 "datan2",
940 F_ARCTAN,
941 atan,
942 datan,
943 datan2,
944 safe_arctan_D0,
945 safe_arctan_D1,
946 safe_arctan_D2,
947 #ifdef CHRIS_FUNC
948 NULL,
949 NULL,
950 NULL,
951 NULL,
952 NULL,
953 NULL,
954 NULL,
955 NULL,
956 NULL
957 #endif
958 };
959
960 #ifdef HAVE_ERF
961 struct Func g_erf_f = {
962 "erf",
963 "erf",
964 "derf",
965 "derf2",
966 F_ERF,
967 erf,
968 derf,
969 derf2,
970 safe_erf_D0,
971 safe_erf_D1,
972 safe_erf_D2,
973 #ifdef CHRIS_FUNC
974 ErfInterval,
975 ErfSlope,
976 ErfDeriv
977 #endif
978 };
979 #endif /* HAVE_ERF */
980
981 struct Func g_sinh_f = {
982 "sinh",
983 "sinh",
984 "cosh",
985 "sinh",
986 F_SINH,
987 sinh,
988 cosh,
989 sinh,
990 safe_sinh_D0,
991 safe_sinh_D1,
992 safe_sinh_D2,
993 #ifdef CHRIS_FUNC
994 NULL,
995 NULL,
996 NULL,
997 NULL,
998 NULL,
999 NULL,
1000 NULL,
1001 NULL,
1002 NULL
1003 #endif
1004 };
1005
1006 struct Func g_cosh_f = {
1007 "cosh",
1008 "cosh",
1009 "sinh",
1010 "cosh",
1011 F_COSH,
1012 cosh,
1013 sinh,
1014 cosh,
1015 safe_cosh_D0,
1016 safe_cosh_D1,
1017 safe_cosh_D2,
1018 #ifdef CHRIS_FUNC
1019 NULL,
1020 NULL,
1021 NULL,
1022 NULL,
1023 NULL,
1024 NULL,
1025 NULL,
1026 NULL,
1027 NULL
1028 #endif
1029 };
1030
1031 struct Func g_tanh_f = {
1032 "tanh",
1033 "tanh",
1034 "dtanh",
1035 "dtanh2",
1036 F_TANH,
1037 tanh,
1038 dtanh,
1039 dtanh2,
1040 safe_tanh_D0,
1041 safe_tanh_D1,
1042 safe_tanh_D2,
1043 #ifdef CHRIS_FUNC
1044 NULL,
1045 NULL,
1046 NULL,
1047 NULL,
1048 NULL,
1049 NULL,
1050 NULL,
1051 NULL,
1052 NULL
1053 #endif
1054 };
1055
1056 struct Func g_arcsinh_f = {
1057 "arcsinh",
1058 "arcsinh",
1059 "darcsinh",
1060 "darcsinh2",
1061 F_ARCSINH,
1062 arcsinh,
1063 darcsinh,
1064 darcsinh2,
1065 safe_arcsinh_D0,
1066 safe_arcsinh_D1,
1067 safe_arcsinh_D2,
1068 #ifdef CHRIS_FUNC
1069 NULL,
1070 NULL,
1071 NULL,
1072 NULL,
1073 NULL,
1074 NULL,
1075 NULL,
1076 NULL,
1077 NULL
1078 #endif
1079 };
1080
1081 struct Func g_arccosh_f = {
1082 "arccosh",
1083 "arccosh",
1084 "darccosh",
1085 "darccosh2",
1086 F_ARCCOSH,
1087 arccosh,
1088 darccosh,
1089 darccosh2,
1090 safe_arccosh_D0,
1091 safe_arccosh_D1,
1092 safe_arccosh_D2,
1093 #ifdef CHRIS_FUNC
1094 NULL,
1095 NULL,
1096 NULL,
1097 NULL,
1098 NULL,
1099 NULL,
1100 NULL,
1101 NULL,
1102 NULL
1103 #endif
1104 };
1105
1106 struct Func g_arctanh_f = {
1107 "arctanh",
1108 "arctanh",
1109 "darctanh",
1110 "darctanh2",
1111 F_ARCTANH,
1112 arctanh,
1113 darctanh,
1114 darctanh2,
1115 safe_arctanh_D0,
1116 safe_arctanh_D1,
1117 safe_arctanh_D2,
1118 #ifdef CHRIS_FUNC
1119 NULL,
1120 NULL,
1121 NULL,
1122 NULL,
1123 NULL,
1124 NULL,
1125 NULL,
1126 NULL,
1127 NULL
1128 #endif
1129 };
1130
1131 struct Func g_cube_f = {
1132 "cube",
1133 "cube",
1134 "dcube",
1135 "dcube2",
1136 F_CUBE,
1137 cube,
1138 dcube,
1139 dcube2,
1140 safe_cube,
1141 safe_cube_D1,
1142 safe_cube_D2,
1143 #ifdef CHRIS_FUNC
1144 NULL,
1145 NULL,
1146 NULL,
1147 NULL,
1148 NULL,
1149 NULL,
1150 NULL,
1151 NULL,
1152 NULL
1153 #endif
1154 };
1155
1156 struct Func g_cbrt_f = {
1157 "cbrt",
1158 "cbrt",
1159 "dcbrt",
1160 "dcbrt2",
1161 F_CBRT,
1162 cbrt,
1163 dcbrt,
1164 dcbrt2,
1165 safe_cbrt_D0,
1166 safe_cbrt_D1,
1167 safe_cbrt_D2,
1168 #ifdef CHRIS_FUNC
1169 NULL,
1170 NULL,
1171 NULL,
1172 NULL,
1173 NULL,
1174 NULL,
1175 NULL,
1176 NULL,
1177 NULL
1178 #endif
1179 };
1180
1181
1182 struct Func *g_func_list[]={
1183 &g_log10_f,
1184 &g_ln_f,
1185 &g_exp_f,
1186 &g_sin_f,
1187 &g_cos_f,
1188 &g_tan_f,
1189 &g_sqr_f,
1190 &g_sqrt_f,
1191 &g_arcsin_f,
1192 &g_arccos_f,
1193 &g_arctan_f,
1194 #ifdef HAVE_ERF
1195 &g_erf_f,
1196 #endif /* HAVE_ERF */
1197 &g_lnm_f,
1198 &g_sinh_f,
1199 &g_cosh_f,
1200 &g_tanh_f,
1201 &g_arcsinh_f,
1202 &g_arccosh_f,
1203 &g_arctanh_f,
1204 &g_cube_f,
1205 &g_cbrt_f,
1206 &g_abs_f,
1207 &g_hold_f,
1208 NULL /* must be last */
1209 };
1210
1211 CONST struct Func *LookupFunc(CONST char *name)
1212 {
1213 unsigned f=0;
1214 while(g_func_list[f]!=NULL){
1215 if(strcmp(g_func_list[f]->name,name)==0)
1216 return g_func_list[f];
1217 f++;
1218 }
1219 return NULL;
1220 }
1221
1222 CONST struct Func *LookupFuncById(enum Func_enum id)
1223 {
1224 unsigned f=0;
1225 while(g_func_list[f]!=NULL){
1226 if (g_func_list[f]->id==id)
1227 return g_func_list[f];
1228 f++;
1229 }
1230 return NULL;
1231 }
1232
1233 CONST char *FuncName(CONST struct Func *f)
1234 {
1235 return f->name;
1236 }
1237
1238 CONST char *FuncCName(CONST struct Func *f)
1239 {
1240 return f->cname;
1241 }
1242
1243 CONST char *FuncDeriv1CName(CONST struct Func *f)
1244 {
1245 return f->deriv1cname;
1246 }
1247
1248 CONST char *FuncDeriv2CName(CONST struct Func *f)
1249 {
1250 return f->deriv2cname;
1251 }
1252
1253 enum Func_enum FuncId(CONST struct Func *f)
1254 {
1255 return f->id;
1256 }
1257
1258 CONST dim_type *FuncDimens(CONST struct Func *f)
1259 {
1260 if (!f) return Dimensionless();
1261 switch (FuncId(f)) {
1262 case F_LOG10:
1263 case F_LN:
1264 case F_EXP:
1265 #ifdef HAVE_ERF
1266 case F_ERF:
1267 #endif /* HAVE_ERF */
1268 case F_LNM:
1269 case F_ARCSIN:
1270 case F_ARCCOS:
1271 case F_ARCTAN:
1272 case F_SINH:
1273 case F_COSH:
1274 case F_TANH:
1275 case F_ARCSINH:
1276 case F_ARCCOSH:
1277 case F_ARCTANH:
1278 return Dimensionless();
1279 case F_SQR:
1280 case F_SQRT:
1281 case F_CUBE:
1282 case F_CBRT:
1283 case F_ABS:
1284 case F_HOLD:
1285 return WildDimension();
1286 case F_SIN:
1287 case F_COS:
1288 case F_TAN:
1289 return TrigDimension();
1290 default: return Dimensionless();
1291 }
1292 }
1293
1294 double FuncEval(CONST struct Func *f, double d)
1295 {
1296 return (*(f->value))(d);
1297 }
1298
1299 double FuncEvalSafe(CONST struct Func *f, double d,enum safe_err *not_safe)
1300 {
1301 return (*(f->safevalue))(d,not_safe);
1302 }
1303
1304 double FuncDeriv(CONST struct Func *f, double d)
1305 {
1306 return (*(f->deriv))(d);
1307 }
1308
1309 double FuncDerivSafe(CONST struct Func *f, double d,enum safe_err *not_safe)
1310 {
1311 return (*(f->safederiv))(d,not_safe);
1312 }
1313
1314 double FuncDeriv2(CONST struct Func *f, double d)
1315 {
1316 return (*(f->deriv2))(d);
1317 }
1318
1319 double FuncDeriv2Safe(CONST struct Func *f, double d,enum safe_err *not_safe)
1320 {
1321 return (*(f->safederiv2))(d,not_safe);
1322 }
1323
1324 #ifdef CHRIS_FUNC
1325 struct Interval FuncRange(CONST struct Func *f, struct Interval u)
1326 {
1327 return (*(f->ivalue))(u);
1328 }
1329
1330 void FuncSlope(CONST struct Func *f, unsigned long int nvar,
1331 struct Interval *center, struct Interval *range,
1332 struct Interval *slope)
1333 {
1334 (*(f->slope))(nvar,center,range,slope);
1335 }
1336
1337 struct Interval FuncIDeriv(CONST struct Func *f, struct Interval i)
1338 {
1339 return (*(f->ideriv))(i);
1340 }
1341
1342 double ArgMin(CONST struct Func *f, double lower, double upper)
1343 {
1344 return (*(f->tmin))(lower,upper);
1345 }
1346
1347 double ArgMax(CONST struct Func *f, double lower, double upper)
1348 {
1349 return (*(f->tmax))(lower,upper);
1350 }
1351
1352 double ConvexEnv(CONST struct Func *f, double x, double lower, double upper)
1353 {
1354 assert((x>=lower)&&(x<=upper));
1355 return (*(f->e))(x,lower,upper,f->value);
1356 }
1357
1358 double ConvexEnvDeriv(CONST struct Func *f, double x,
1359 double lower, double upper)
1360 {
1361 assert((x>=lower)&&(x<=upper));
1362 return (*(f->ed))(x,lower,upper,f->value);
1363 }
1364
1365 double ConcaveEnv(CONST struct Func *f, double x, double lower, double upper)
1366 {
1367 assert((x>=lower)&&(x<=upper));
1368 return (*(f->E))(x,lower,upper,f->value);
1369 }
1370
1371 double ConcaveEnvDeriv(CONST struct Func *f, double x,
1372 double lower, double upper)
1373 {
1374 assert((x>=lower)&&(x<=upper));
1375 return (*(f->Ed))(x,lower,upper,f->value);
1376 }
1377 #endif

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22