1 /*
2 
3  HyPhy - Hypothesis Testing Using Phylogenies.
4 
5  Copyright (C) 1997-now
6  Core Developers:
7  Sergei L Kosakovsky Pond (sergeilkp@icloud.com)
8  Art FY Poon    (apoon42@uwo.ca)
9  Steven Weaver (sweaver@temple.edu)
10 
11  Module Developers:
12  Lance Hepler (nlhepler@gmail.com)
13  Martin Smith (martin.audacis@gmail.com)
14 
15  Significant contributions from:
16  Spencer V Muse (muse@stat.ncsu.edu)
17  Simon DW Frost (sdf22@cam.ac.uk)
18 
19  Permission is hereby granted, free of charge, to any person obtaining a
20  copy of this software and associated documentation files (the
21  "Software"), to deal in the Software without restriction, including
22  without limitation the rights to use, copy, modify, merge, publish,
23  distribute, sublicense, and/or sell copies of the Software, and to
24  permit persons to whom the Software is furnished to do so, subject to
25  the following conditions:
26 
27  The above copyright notice and this permission notice shall be included
28  in all copies or substantial portions of the Software.
29 
30  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
31  OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
32  MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
33  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
34  CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
35  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
36  SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
37 
38  */
39 
40 #include <math.h>
41 #include <float.h>
42 #include <limits.h>
43 #include <stdio.h>
44 #include "string.h"
45 #include "time.h"
46 
47 #include "mersenne_twister.h"
48 #include "constant.h"
49 
50 //SW: This should be just helper functions
51 #include "parser.h"
52 #include "global_things.h"
53 
54 using namespace hy_global;
55 
56 _Formula *chi2 = nil,
57          *derchi2 = nil;
58 
59 
60 extern hyFloat tolerance;
61 
62 long                        lastMatrixDeclared = -1,
63                             expressionsParsed = 0;
64 
65 unsigned char               _Constant::preallocated_buffer [_HY_CONSTANT_PREALLOCATE_SLOTS*sizeof (_Constant)];
66 _SimpleList                 _Constant::free_slots;
67 
68 //___________________________________________________________________________________________
gaussDeviate(void)69 hyFloat  gaussDeviate (void) {
70   /*
71    Use Box-Muller transform to generate random deviates from Gaussian distribution with
72    zero mean and unit variance (Numerical Recipes).
73    */
74 
75   static int      iset = 0;
76   static double   gset;
77   double          fac, rsq, v1, v2;
78 
79   if (iset == 0) {
80     do {
81       v1 = 2.0 * genrand_real2() - 1.0;   // uniform random number on (0,1), i.e. no endpoints
82       v2 = 2.0 * genrand_real2() - 1.0;
83       rsq = v1*v1 + v2*v2;
84     } while (rsq >= 1.0 || rsq == 0.0);
85 
86     fac = sqrt(-2.0 * log(rsq)/rsq);
87     gset = v1 * fac;
88     iset = 1;           // set flag to indicate second deviate available
89 
90     return (hyFloat) (v2 * fac);
91   } else {
92     iset = 0;
93     return (hyFloat) gset;       // use second deviate
94   }
95 }
96 
97 
98 //__________________________________________________________________________________________________________
exponDeviate(void)99 hyFloat  exponDeviate (void) {
100   return -log(1.0-genrand_real2());   // uniform random number on interval (0,1]
101 }
102 
103 
104 //__________________________________________________________________________________________________________
gammaDeviate(hyFloat a,hyFloat scale)105 hyFloat  gammaDeviate (hyFloat a, hyFloat scale) {
106 
107   /* -----------------------------------------
108    GS algorithm from GNU GPL rgamma.c
109    *  Mathlib : A C Library of Special Functions
110    *  Copyright (C) 1998 Ross Ihaka
111    *  Copyright (C) 2000--2008 The R Development Core Team
112 
113    * Ziggurat algorithm from Marsaglia and Tsang (2000) "A Simple Method
114    *  for Generating Gamma Variables" ACM Trans Math Soft 26(3) 363-372
115    ----------------------------------------- */
116 
117   const static double exp_m1 = 0.36787944117144232159;    /* exp(-1) = 1/e */
118 
119   double              e, x, p;
120 
121   if (a < 0.0) {
122     ReportWarning ("NaN in gammaDeviate()");
123     return 0.;
124   } else if (a == 0.0) {
125     return 0.;
126   } else if (a < 1.0) {   // GS algorithm for parameters 0 < a < 1
127     if(a == 0) {
128       return 0.;
129     }
130 
131     e = 1.0 + exp_m1 * a;
132 
133     while (1) {
134       p = e * genrand_real2();    // should be uniform random number on open interval (0,1)
135                                   // but genrand_real3 scoping (baseobj.cpp) is insufficient
136       if (p >= 1.0) {
137         x = -log((e - p) / a);
138         if (exponDeviate() >= (1.0 - a) * log(x)) {
139           break;
140         }
141       } else {
142         x = exp(log(p) / a);
143         if (exponDeviate() >= x) {
144           break;
145         }
146       }
147     }
148 
149     return x*scale;
150   }
151 
152   else if (a == 1.0) {
153     return exponDeviate() * scale;
154   }
155 
156   else {  // a > 1., Ziggurat algorithm
157     double  x, v, u,
158     d   = a - 1./3.,
159     c = 1. / sqrt(9.*d);
160 
161     for (;;) {
162       do {
163         x = gaussDeviate();
164         v = 1. + c * x;
165       } while (v <= 0.);
166 
167       v = v * v * v;
168       u = genrand_real2();
169 
170       if (u < 1. - 0.0331 * (x*x)*(x*x) ) {
171         return (d * v * scale);
172       }
173 
174       if ( log(u) < 0.5*x*x + d*(1.-v+log(v)) ) {
175         return (d * v * scale);
176       }
177     }
178   }
179 }
180 
181 
182 
183 //__________________________________________________________________________________
chisqDeviate(double df)184 hyFloat  chisqDeviate (double df) {
185   if (df < 0.0) {
186     HandleApplicationError (_String("ERROR in chisqDeviate(): require positive degrees of freedom"));
187     return HY_INVALID_RETURN_VALUE;
188   }
189 
190   return gammaDeviate(df/2.0, 2.0);   // chi-square distribution is special case of gamma
191 }
192 
193 
194 
195 //__________________________________________________________________________________
196 
197 
_gamma(hyFloat alpha)198 hyFloat _gamma (hyFloat alpha) {
199     hyFloat static gammaCoeff [7] = {
200         2.50662827463100050,
201         190.9551718944012,
202         -216.8366818451899,
203         60.19441758801798,
204         -3.087513097785903,
205         0.003029460875352382,
206         -0.00001345152485367085
207     };
208 
209     hyFloat theV = alpha >=1.0? alpha : 2.-alpha,
210     result = gammaCoeff[0],
211     temp = theV;
212 
213     for (int i = 1; i < 7; ++i , temp += 1.) {
214         result += gammaCoeff[i] / temp;
215     }
216 
217     temp = theV + 4.5;
218     result *= exp(-temp+log(temp)*(theV-.5));
219 
220     if (alpha >= 1.0) {
221         return result;
222     }
223     temp = pi_const * (1-alpha);
224     return temp / result / sin (temp);
225 }
226 
227 //__________________________________________________________________________________
228 
229 
_ln_gamma(hyFloat alpha)230 hyFloat _ln_gamma (hyFloat alpha) {
231     // obtained from Numerical Recipes in C, p. 214 by afyp, February 7, 2007
232 
233     if (alpha <= 0.) {
234         return NAN;
235     }
236 
237     hyFloat static lngammaCoeff [6] = {
238         76.18009172947146,
239         -86.50532032941677,
240         24.01409824083091,
241         -1.231739572450155,
242         0.1208650973866179e-2,
243         -0.5395239384953e-5
244     };
245 
246     static hyFloat lookUpTable [20] = {   0.       ,  0.       ,  0.6931472,  1.7917595,  3.1780538,
247       4.7874917,  6.5792512,  8.5251614, 10.6046029, 12.8018275,
248       15.1044126, 17.5023078, 19.9872145, 22.5521639, 25.1912212,
249       27.8992714, 30.6718601, 33.5050735, 36.3954452, 39.3398842
250     };
251 
252     if (alpha <= 20. && floor (alpha) == alpha) {
253       return lookUpTable [(long) alpha - 1];
254     }
255 
256 
257     hyFloat  x, y, tmp, ser;
258 
259     y = x = alpha;
260     tmp = x + 5.5;
261     tmp -= (x+0.5) * log(tmp);
262 
263     ser = 1.000000000190015 +
264           lngammaCoeff[0] / (y + 1.) +
265           lngammaCoeff[1] / (y + 2.) +
266           lngammaCoeff[2] / (y + 3.) +
267           lngammaCoeff[3] / (y + 4.) +
268           lngammaCoeff[4] / (y + 5.) +
269           lngammaCoeff[5] / (y + 6.);
270 
271     /*
272     for (int j = 0; j < 6 ; ++j ) {
273         ser += lngammaCoeff[j] / ( y += 1. );
274     }
275     */
276 
277     return -tmp + log(2.506628274631005*ser/x);
278 
279 
280 }
281 
282 //__________________________________________________________________________________
283 
_ibeta(hyFloat x,hyFloat a,hyFloat b)284 hyFloat _ibeta (hyFloat x, hyFloat a, hyFloat b) {
285     // check ranges
286     if (x > 0. && x < 1.) { // in range
287 
288 
289         hyFloat  aa,
290         c,
291         d,
292         del,
293         h,
294         qab,
295         qam,
296         qap,
297         FPMIN = 1e-100;
298 
299 
300         bool        swap = false;
301 
302 
303         if (x >= (a+1.)/(a+b+2.)) {
304             swap = true;
305             c = b;
306             b = a;
307             a = c;
308             x = 1. - x;
309         }
310 
311         qab = a+b;
312         qap = a+1.;
313         qam = a-1.;
314         c   = 1.;
315         d   = 1. - qab*x/qap;
316         if  ((d<FPMIN)&&(d>-FPMIN)) {
317             d = FPMIN;
318         }
319         d   = 1./d;
320         h   = d;
321 
322         for (int m=1; m<100; m++) {
323             hyFloat m2 = 2*m;
324             aa = m*(b-m)*x / ((qam+m2)*(a+m2));
325             d = 1.+aa*d;
326             if  ((d<FPMIN)&&(d>-FPMIN)) {
327                 d = FPMIN;
328             }
329             c = 1.+aa/c;
330             if  ((c<FPMIN)&&(c>-FPMIN)) {
331                 c = FPMIN;
332             }
333             d = 1./d;
334             h*= d*c;
335             aa = -(a+m)*(qab+m)*x/((a+m2)*(qap+m2));
336             d = 1.+aa*d;
337             if  ((d<FPMIN)&&(d>-FPMIN)) {
338                 d = FPMIN;
339             }
340             c = 1.+aa/c;
341             if  ((c<FPMIN)&&(c>-FPMIN)) {
342                 c = FPMIN;
343             }
344             d = 1./d;
345             del = d*c;
346             h*= del;
347             del -= 1.;
348             if  ((del<1.e-14)&&(del>-1.e-14))   {
349                 break;
350             }
351         }
352 
353         c = exp (a*log(x)+b*log(1.-x)+_ln_gamma(a+b)-_ln_gamma(a)-_ln_gamma(b));
354 
355         if (swap) {
356             return 1.-c*h/a;
357         } else {
358             return c*h/a;
359         }
360     }
361 
362 
363     if (x <= 0.) {
364         if ( x < 0.) {
365             ReportWarning (_String ("IBeta is defined for x in [0,1]. Had x = ") & x);
366         }
367         return 0.;
368     }
369 
370     if ( x > 1.) {
371         ReportWarning (_String ("IBeta is defined for x in [0,1]. Had x = ") & x);
372     }
373 
374     return 1.;
375 }
376 
377 //__________________________________________________________________________________
378 
_igamma(hyFloat a,hyFloat x)379 hyFloat _igamma (hyFloat a, hyFloat x) {
380     hyFloat sum = 0.;
381     if (x>1e25) {
382         x=1.e25;
383     } else if (x<0.) {
384         HandleApplicationError ("The domain of x is {x>0} for IGamma (a,x)");
385         return 0.0;
386     } else if (x==0.0) {
387         return 0.0;
388     }
389 
390 
391     hyFloat gamma = _gamma (a);
392 
393     if (x <= a + 1.) {
394         // use the series representation
395         // IGamma (a,x)=exp(-x) x^a \sum_{n=0}^{\infty} \frac{\Gamma((a)}{\Gamma(a+1+n)} x^n
396 
397         hyFloat term = 1.0/a, den = a+1.;
398 
399         for (int count = 0; fabs (term) >= fabs (sum) * kMachineEpsilon && count < 500; ++ count) {
400             sum+=term;
401             term*=x/den;
402             den += 1.0;
403         }
404 
405         return sum * exp (-x + a * log (x)) / gamma;
406 
407     }
408     // use the continue fraction representation
409     // IGamma (a,x)=exp(-x) x^a 1/x+/1-a/1+/1/x+/2-a/1+/2/x+...
410 
411     hyFloat lastTerm = 0., a0 = 1.0, a1 = x, b0 = 0.0, b1 = 1.0, factor = 1.0, an, ana, anf;
412 for (int count = 1; count<500; ++count) {
413         an = count;
414         ana = an - a;
415         a0 = (a1+a0*ana)*factor;
416         b0 = (b1+b0*ana)*factor;
417         anf = an*factor;
418         a1  = x*a0+anf*a1;
419         b1  = x*b0+anf*b1;
420         if (a1!=0.0) {
421             factor=1.0/a1;
422             sum = b1*factor;
423             if (fabs(sum-lastTerm)/sum < kMachineEpsilon) {
424                 break;
425             }
426             lastTerm = sum;
427         }
428     }
429 
430     return 1.0 - sum * exp (-x + a * log (x)) / gamma;
431 
432 }
433 
434 //__________________________________________________________________________________
_Constant(hyFloat value)435 _Constant::_Constant (hyFloat value) {
436     theValue = value;
437 }
438 //__________________________________________________________________________________
439 
Initialize(bool)440 void _Constant::Initialize (bool) {
441     BaseObj::Initialize();
442     theValue = 0.;
443 }
444 //__________________________________________________________________________________
445 
Duplicate(BaseRefConst c)446 void _Constant::Duplicate (BaseRefConst c) {
447     BaseObj::Initialize();
448     theValue = ((_Constant const*)c)->theValue;
449 }
450 
451 //__________________________________________________________________________________
452 
makeDynamic(void) const453 BaseRef _Constant::makeDynamic (void) const{
454     _Constant * res = new _Constant;
455     res->Duplicate(this);
456     return res;
457 }
458 
459 //__________________________________________________________________________________
operator new(size_t size)460 void * _Constant::operator new (size_t size) {
461     if (_Constant::free_slots.nonempty()) {
462         _Constant * result = ((_Constant*)_Constant::preallocated_buffer)+_Constant::free_slots.Pop();
463         return result;
464     }
465     return ::operator new (size);
466 }
467 
468 //__________________________________________________________________________________
operator delete(void * p)469 void  _Constant::operator delete (void * p) {
470     _Constant * cp = (_Constant*)p,
471               * cpp = (_Constant*)_Constant::preallocated_buffer;
472     if (cp >= cpp &&  cp < (cpp + _HY_CONSTANT_PREALLOCATE_SLOTS)) {
473         free_slots << long (cp - cpp);
474     } else {
475         ::operator delete (p);
476     }
477 }
478 
479 //__________________________________________________________________________________
480 
_Constant(_String & s)481 _Constant::_Constant (_String& s) {
482     theValue = s.to_float();
483 }
484 
485 //__________________________________________________________________________________
_Constant(void)486 _Constant::_Constant (void) : theValue(0.0) {
487 }
488 
489 //__________________________________________________________________________________
490 //_Constant::~_Constant (void)  {
491 //}
492 
493 //__________________________________________________________________________________
Value(void)494 hyFloat    _Constant::Value (void) {
495     return theValue;
496 }
497 //__________________________________________________________________________________
toStr(unsigned long)498 BaseRef _Constant::toStr(unsigned long) {
499     return parameterToString(Value());
500 }
501 
502 //__________________________________________________________________________________
Add(HBLObjectRef theObj,HBLObjectRef cache)503 HBLObjectRef _Constant::Add (HBLObjectRef theObj, HBLObjectRef cache) {
504     if (theObj->ObjectClass() == STRING) {
505         return _returnConstantOrUseCache (theValue+((_FString*)theObj)->get_str().to_float(), cache);
506     }
507     return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {return a + b;}, cache);
508 }
509 
510 //__________________________________________________________________________________
Sub(HBLObjectRef theObj,HBLObjectRef cache)511 HBLObjectRef _Constant::Sub (HBLObjectRef theObj, HBLObjectRef cache) {
512     return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {return a - b;}, cache);
513 }
514 
515 //__________________________________________________________________________________
Minus(HBLObjectRef cache)516 HBLObjectRef _Constant::Minus (HBLObjectRef cache) {
517     return     _returnConstantOrUseCache (-Value(), cache);
518 }
519 
520 //__________________________________________________________________________________
Sum(HBLObjectRef cache)521 HBLObjectRef _Constant::Sum (HBLObjectRef cache) {
522     return     _returnConstantOrUseCache (Value(), cache);
523 }
524 
525 //__________________________________________________________________________________
Mult(HBLObjectRef theObj,HBLObjectRef cache)526 HBLObjectRef _Constant::Mult (HBLObjectRef theObj, HBLObjectRef cache) {
527     return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {return a * b;}, cache);
528 }
529 //__________________________________________________________________________________
Div(HBLObjectRef theObj,HBLObjectRef cache)530 HBLObjectRef _Constant::Div (HBLObjectRef theObj,  HBLObjectRef cache) {
531     return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {return a / b;}, cache);
532 }
533 
534 //__________________________________________________________________________________
lDiv(HBLObjectRef theObj,HBLObjectRef cache)535 HBLObjectRef _Constant::lDiv (HBLObjectRef theObj, HBLObjectRef cache) { // %
536     return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {
537             long       denom = b;
538             return     denom != 0L ? (long(a) % denom): a;
539     }, cache);
540 }
541 //__________________________________________________________________________________
longDiv(HBLObjectRef theObj,HBLObjectRef cache)542 HBLObjectRef _Constant::longDiv (HBLObjectRef theObj, HBLObjectRef cache)  {// div
543     return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {
544         long       denom = b;
545         return     denom != 0L ? (long(a) / denom): 0.0;
546     }, cache);
547 }
548 //__________________________________________________________________________________
Raise(HBLObjectRef theObj,HBLObjectRef cache)549 HBLObjectRef _Constant::Raise (HBLObjectRef theObj, HBLObjectRef cache) {
550     return _check_type_and_compute (theObj, [] (hyFloat base, hyFloat expon) -> hyFloat {
551         if (base>0.0) {
552             if (expon == 1.) {
553                 return base;
554             }
555             return    exp (log(base)*(expon));
556         } else {
557             if (base<0.0) {
558                 if (CheckEqual (expon, (long)expon)) {
559                     return ((((long)expon)%2)?-1:1)*exp (log(-base)*(expon));
560                 } else {
561                     HandleApplicationError("An invalid base/exponent pair passed to ^");
562                 }
563             }
564 
565             if (expon != 0.0)
566                 return     0.0;
567             else
568                 return     1.0;
569         }
570     }, cache);
571 }
572 
573 //__________________________________________________________________________________
Random(HBLObjectRef upperB,HBLObjectRef cache)574 HBLObjectRef _Constant::Random (HBLObjectRef upperB, HBLObjectRef cache) {
575     return _check_type_and_compute (upperB, [] (hyFloat l, hyFloat u) -> hyFloat {
576         hyFloat r = l;
577         if (u>l) {
578             r = l + (u-l) * genrand_real1();
579         }
580         return r;
581     }, cache);
582 }
583 
584 //__________________________________________________________________________________
Equal(HBLObjectRef theObj)585 bool     _Constant::Equal (HBLObjectRef theObj) {
586     return theValue==((_Constant*)theObj)->theValue;
587 }
588 
589 //__________________________________________________________________________________
Abs(HBLObjectRef cache)590 HBLObjectRef _Constant::Abs (HBLObjectRef cache) {
591     return     _returnConstantOrUseCache(fabs(theValue), cache);
592 }
593 
594 //__________________________________________________________________________________
Sin(HBLObjectRef cache)595 HBLObjectRef _Constant::Sin (HBLObjectRef cache){
596     return     _returnConstantOrUseCache(sin(theValue), cache);
597 }
598 
599 //__________________________________________________________________________________
Cos(HBLObjectRef cache)600 HBLObjectRef _Constant::Cos (HBLObjectRef cache){
601     return     _returnConstantOrUseCache(cos(theValue) , cache);
602 }
603 
604 //__________________________________________________________________________________
Tan(HBLObjectRef cache)605 HBLObjectRef _Constant::Tan (HBLObjectRef cache){
606     return     _returnConstantOrUseCache(tan(theValue) , cache);
607 }
608 
609 //__________________________________________________________________________________
Exp(HBLObjectRef cache)610 HBLObjectRef _Constant::Exp (HBLObjectRef cache){
611     return     _returnConstantOrUseCache(exp(theValue) , cache);
612 }
613 
614 //__________________________________________________________________________________
FormatNumberString(HBLObjectRef p,HBLObjectRef p2,HBLObjectRef cache)615 HBLObjectRef _Constant::FormatNumberString (HBLObjectRef p, HBLObjectRef p2, HBLObjectRef cache) {
616     long       a1 = p->Value(),
617                a2 = p2->Value();
618 
619     char       format[32],
620                buffer[256];
621 
622 #ifdef     __USE_LONG_DOUBLE__
623     if (a1>=0 && a2>=0) {
624         if (a1>0) {
625             snprintf    (format,32, "%%%ld.%ldLf",(long)a1,(long)a2);
626         } else {
627             snprintf    (format,32,"%%.%ldLf",(long)a2);
628         }
629     } else if (a1>=0) {
630         snprintf    (format,32,"%%%ldLf",(long)a1);
631     } else if (a2>=0) {
632         snprintf    (format,32,"%%.%ldLf",(long)a2);
633     } else {
634         snprintf    (format,32,"%%Lg");
635     }
636 #else
637     if (a1>=0 && a2>=0) {
638         if (a1>0) {
639             snprintf    (format,32, "%%%ld.%ldf",(long)a1,(long)a2);
640         } else {
641             snprintf    (format,32, "%%.%ldf",(long)a2);
642         }
643     } else if (a1>=0) {
644         snprintf    (format,32, "%%%ldf",(long)a1);
645     } else if (a2>=0) {
646         snprintf    (format,32, "%%.%ldf",(long)a2);
647     } else {
648         snprintf    (format,32, "%%g");
649     }
650 
651 #endif
652     snprintf    (buffer,256, format,Value());
653     return _returnStringOrUseCache(buffer, cache);
654 }
655 //__________________________________________________________________________________
Log(HBLObjectRef cache)656 HBLObjectRef _Constant::Log (HBLObjectRef cache) {
657     return     _returnConstantOrUseCache(log(theValue), cache);
658 }
659 //__________________________________________________________________________________
Sqrt(HBLObjectRef cache)660 HBLObjectRef _Constant::Sqrt (HBLObjectRef cache) {
661     return     _returnConstantOrUseCache(sqrt (theValue), cache);
662 }
663 //__________________________________________________________________________________
Arctan(HBLObjectRef cache)664 HBLObjectRef _Constant::Arctan (HBLObjectRef cache) {
665     return     _returnConstantOrUseCache(atan (theValue), cache);
666 }
667 //__________________________________________________________________________________
Gamma(HBLObjectRef cache)668 HBLObjectRef _Constant::Gamma (HBLObjectRef cache) {
669     return     _returnConstantOrUseCache(_gamma (theValue), cache);
670 }
671 //__________________________________________________________________________________
LnGamma(HBLObjectRef cache)672 HBLObjectRef _Constant::LnGamma (HBLObjectRef cache) {
673     return     _returnConstantOrUseCache(_ln_gamma (theValue), cache);
674 }
675 
676 //__________________________________________________________________________________
Beta(HBLObjectRef arg,HBLObjectRef cache)677 HBLObjectRef _Constant::Beta (HBLObjectRef arg,HBLObjectRef cache) {
678     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat {
679         return exp (_ln_gamma (a) + _ln_gamma (b) - _ln_gamma (a + b));
680     }, cache);
681 }
682 
683 //__________________________________________________________________________________
IBeta(HBLObjectRef arg1,HBLObjectRef arg2,HBLObjectRef cache)684 HBLObjectRef _Constant::IBeta (HBLObjectRef arg1, HBLObjectRef arg2,HBLObjectRef cache) {
685     return _check_type_and_compute_3 (arg1, arg2, [] (hyFloat a, hyFloat b, hyFloat c) -> hyFloat {
686         return _ibeta(a,b,c);
687     },cache);
688 }
689 
690 
691 //__________________________________________________________________________________
IGamma(HBLObjectRef arg,HBLObjectRef cache)692 HBLObjectRef _Constant::IGamma (HBLObjectRef arg, HBLObjectRef cache) {
693     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat { return _igamma(a, b);}, cache);
694 }
695 
696 //__________________________________________________________________________________
Erf(HBLObjectRef cache)697 HBLObjectRef _Constant::Erf (HBLObjectRef cache) {
698     hyFloat ig = _igamma (0.5, theValue * theValue);
699     if (theValue < 0.) {
700         ig = -ig;
701     }
702     return _returnConstantOrUseCache (ig, cache);
703 }
704 
705 //__________________________________________________________________________________
ZCDF(HBLObjectRef cache)706 HBLObjectRef _Constant::ZCDF (HBLObjectRef cache) {
707     hyFloat ig = _igamma (0.5, theValue * theValue * 0.5);
708 
709     if (theValue > 0.) {
710         return _returnConstantOrUseCache (0.5 * (ig + 1.), cache);
711     }
712     return _returnConstantOrUseCache (0.5 * ( 1. - ig), cache);
713 }
714 
715 //__________________________________________________________________________________
Time(HBLObjectRef cache)716 HBLObjectRef _Constant::Time (HBLObjectRef cache) {
717     //_Constant * result = new _Constant;
718     if (theValue<1.0) {
719         return  _returnConstantOrUseCache (((hyFloat)clock()/CLOCKS_PER_SEC), cache);
720     } else {
721         time_t tt;
722         return  _returnConstantOrUseCache  ((hyFloat)time(&tt), cache);
723     }
724     //return     result;
725 }
726 
727 
728 //__________________________________________________________________________________
Less(HBLObjectRef theObj,HBLObjectRef cache)729 HBLObjectRef _Constant::Less (HBLObjectRef theObj, HBLObjectRef cache) {
730    return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {return a < b;}, cache);
731 }
732 
733 //__________________________________________________________________________________
Greater(HBLObjectRef theObj,HBLObjectRef cache)734 HBLObjectRef _Constant::Greater (HBLObjectRef theObj, HBLObjectRef cache) {
735     return _check_type_and_compute (theObj, [] (hyFloat a, hyFloat b) -> hyFloat {return a > b;}, cache);
736 }
737 
738 //__________________________________________________________________________________
GammaDist(HBLObjectRef alpha,HBLObjectRef beta,HBLObjectRef cache)739 HBLObjectRef _Constant::GammaDist (HBLObjectRef alpha, HBLObjectRef beta, HBLObjectRef cache) {
740     return _check_type_and_compute_3 (alpha, beta, [] (hyFloat x, hyFloat a, hyFloat b) -> hyFloat {
741         hyFloat gamma_dist = exp(a * log(b) -b*x +(a-1.)*log(x));
742         return gamma_dist / _gamma (a);
743     }, cache);
744 }
745 
746 //__________________________________________________________________________________
CGammaDist(HBLObjectRef alpha,HBLObjectRef beta,HBLObjectRef cache)747 HBLObjectRef _Constant::CGammaDist (HBLObjectRef alpha, HBLObjectRef beta, HBLObjectRef cache) {
748     return _check_type_and_compute_3 (alpha, beta, [] (hyFloat x, hyFloat a, hyFloat b) -> hyFloat {
749         return _igamma (a, b * x);
750     }, cache);
751 }
752 
753 //__________________________________________________________________________________
CChi2(HBLObjectRef n,HBLObjectRef cache)754 HBLObjectRef _Constant::CChi2 (HBLObjectRef n, HBLObjectRef cache) {
755 // chi^2 n d.f. probability up to x
756     return _check_type_and_compute (n, [] (hyFloat x, hyFloat b) -> hyFloat {
757         if (x < 0.0 || b <= 0.) {
758             ReportWarning ("CChi2(x,n) only makes sense for both arguments positive");
759             return 0.0;
760         }
761         return _igamma( b*0.5 , x * 0.5);
762     }, cache);
763 }
764 
765 //__________________________________________________________________________________
InvChi2(HBLObjectRef n,HBLObjectRef cache)766 HBLObjectRef _Constant::InvChi2 (HBLObjectRef n, HBLObjectRef cache) {
767 // chi^2 n d.f. probability up to x
768     if (!chi2) {
769         chi2 = new _Formula (_String ("IGamma(") &  kNVariableName & "," & kXVariableName & ")", nil);
770         derchi2 = new _Formula (kXVariableName & "^(" & kNVariableName & "-1)/Gamma(" & kNVariableName & ")/Exp(" & kXVariableName & ")",nil);
771     }
772     hyFloat half_n = ((_Constant*)n)->theValue*.5;
773     if (theValue<0. || half_n < 0.|| theValue> 1.0) {
774         ReportWarning ("InvChi2(x,n) is defined for n > 0, and x in [0,1]");
775         return _returnConstantOrUseCache(0., cache);
776     }
777 
778     _Constant* result = new _Constant (half_n);
779     hy_n_variable->SetValue (result, true, true, NULL);
780     result->SetValue(chi2->Newton(*derchi2,theValue,1e-25,1.e100,hy_x_variable)*2);
781     return result;
782 }
783 
784 //__________________________________________________________________________________
LessEq(HBLObjectRef arg,HBLObjectRef cache)785 HBLObjectRef _Constant::LessEq (HBLObjectRef arg, HBLObjectRef cache) {
786     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat { return a <= b;}, cache);
787 }
788 
789 //__________________________________________________________________________________
GreaterEq(HBLObjectRef arg,HBLObjectRef cache)790 HBLObjectRef _Constant::GreaterEq (HBLObjectRef arg, HBLObjectRef cache) {
791     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat { return a >= b;}, cache);
792 }
793 //__________________________________________________________________________________
AreEqual(HBLObjectRef arg,HBLObjectRef cache)794 HBLObjectRef _Constant::AreEqual (HBLObjectRef arg, HBLObjectRef cache) {
795     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat {
796         if (a==0.0) {
797             return b==0.0;
798         }
799         return fabs ((a-b)/a)<tolerance;
800     }, cache);
801 }
802 //__________________________________________________________________________________
NotEqual(HBLObjectRef arg,HBLObjectRef cache)803 HBLObjectRef _Constant::NotEqual (HBLObjectRef arg, HBLObjectRef cache) {
804     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat {
805         if (a==0.0) {
806             return b!=0.0;
807         }
808 
809         return fabs ((a-b)/a)>=tolerance;
810     }, cache);
811 }
812 //__________________________________________________________________________________
LAnd(HBLObjectRef arg,HBLObjectRef cache)813 HBLObjectRef _Constant::LAnd (HBLObjectRef arg, HBLObjectRef cache) {
814     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat {
815         return long (a) && long (b);
816     }, cache);
817 }
818 //__________________________________________________________________________________
LOr(HBLObjectRef arg,HBLObjectRef cache)819 HBLObjectRef _Constant::LOr (HBLObjectRef arg,HBLObjectRef cache) {
820 return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat {
821     return long (a) || long (b);
822 }, cache);
823 }
824 
825 //__________________________________________________________________________________
LNot(HBLObjectRef cache)826 HBLObjectRef _Constant::LNot (HBLObjectRef cache) {
827     return _returnConstantOrUseCache(CheckEqual(theValue, 0.0), cache);
828 }
829 
830 //__________________________________________________________________________________
Min(HBLObjectRef arg,HBLObjectRef cache)831 HBLObjectRef _Constant::Min (HBLObjectRef arg, HBLObjectRef cache) {
832     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat {
833         return a < b ? a : b;
834     }, cache);
835 }
836 
837 //__________________________________________________________________________________
Max(HBLObjectRef arg,HBLObjectRef cache)838 HBLObjectRef _Constant::Max (HBLObjectRef arg, HBLObjectRef cache) {
839     return _check_type_and_compute (arg, [] (hyFloat a, hyFloat b) -> hyFloat {
840         return a > b ? a : b;
841     }, cache);
842 }
843