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