source: trunk/Mars/mbase/MMath.cc@ 11014

Last change on this file since 11014 was 10166, checked in by tbretz, 14 years ago
Removed the old obsolete cvs header line.
File size: 25.7 KB
Line 
1/* ======================================================================== *\
2!
3! *
4! * This file is part of MARS, the MAGIC Analysis and Reconstruction
5! * Software. It is distributed to you in the hope that it can be a useful
6! * and timesaving tool in analysing Data of imaging Cerenkov telescopes.
7! * It is distributed WITHOUT ANY WARRANTY.
8! *
9! * Permission to use, copy, modify and distribute this software and its
10! * documentation for any purpose is hereby granted without fee,
11! * provided that the above copyright notice appear in all copies and
12! * that both that copyright notice and this permission notice appear
13! * in supporting documentation. It is provided "as is" without express
14! * or implied warranty.
15! *
16!
17!
18! Author(s): Thomas Bretz 3/2004 <mailto:tbretz@astro.uni-wuerzburg.de>
19!
20! Copyright: MAGIC Software Development, 2000-2009
21!
22!
23\* ======================================================================== */
24
25/////////////////////////////////////////////////////////////////////////////
26//
27// MMath
28//
29// Mars - Math package (eg Significances, etc)
30//
31/////////////////////////////////////////////////////////////////////////////
32#include "MMath.h"
33
34#include <stdlib.h> // atof (Ubuntu 8.10)
35
36#ifndef ROOT_TVector2
37#include <TVector2.h>
38#endif
39
40#ifndef ROOT_TVector3
41#include <TVector3.h>
42#endif
43
44#ifndef ROOT_TArrayD
45#include <TArrayD.h>
46#endif
47
48#ifndef ROOT_TComplex
49#include <TComplex.h>
50#endif
51
52#ifndef ROOT_TRandom
53#include <TRandom.h> // gRandom in RndmExp
54#endif
55
56#include "MString.h"
57
58//NamespaceImp(MMath);
59
60// --------------------------------------------------------------------------
61//
62// Calculate Significance as
63// significance = (s-b)/sqrt(s+k*k*b) mit k=s/b
64//
65// s: total number of events in signal region
66// b: number of background events in signal region
67//
68Double_t MMath::Significance(Double_t s, Double_t b)
69{
70 const Double_t k = b==0 ? 0 : s/b;
71 const Double_t f = s+k*k*b;
72
73 return f==0 ? 0 : (s-b)/TMath::Sqrt(f);
74}
75
76// --------------------------------------------------------------------------
77//
78// Symmetrized significance - this is somehow analog to
79// SignificanceLiMaSigned
80//
81// Returns Significance(s,b) if s>b otherwise -Significance(b, s);
82//
83Double_t MMath::SignificanceSym(Double_t s, Double_t b)
84{
85 return s>b ? Significance(s, b) : -Significance(b, s);
86}
87
88// --------------------------------------------------------------------------
89//
90// calculates the significance according to Li & Ma
91// ApJ 272 (1983) 317, Formula 17
92//
93// s // s: number of on events
94// b // b: number of off events
95// alpha = t_on/t_off; // t: observation time
96//
97// The significance has the same (positive!) value for s>b and b>s.
98//
99// Returns -1 if s<0 or b<0 or alpha<0 or the argument of sqrt<0
100//
101// Here is some eMail written by Daniel Mazin about the meaning of the arguments:
102//
103// > Ok. Here is my understanding:
104// > According to Li&Ma paper (correctly cited in MMath.cc) alpha is the
105// > scaling factor. The mathematics behind the formula 17 (and/or 9) implies
106// > exactly this. If you scale OFF to ON first (using time or using any other
107// > method), then you cannot use formula 17 (9) anymore. You can just try
108// > the formula before scaling (alpha!=1) and after scaling (alpha=1), you
109// > will see the result will be different.
110//
111// > Here are less mathematical arguments:
112//
113// > 1) the better background determination you have (smaller alpha) the more
114// > significant is your excess, thus your analysis is more sensitive. If you
115// > normalize OFF to ON first, you loose this sensitivity.
116//
117// > 2) the normalization OFF to ON has an error, which naturally depends on
118// > the OFF and ON. This error is propagating to the significance of your
119// > excess if you use the Li&Ma formula 17 correctly. But if you normalize
120// > first and use then alpha=1, the error gets lost completely, you loose
121// > somehow the criteria of goodness of the normalization.
122//
123Double_t MMath::SignificanceLiMa(Double_t s, Double_t b, Double_t alpha)
124{
125 const Double_t sum = s+b;
126
127 if (s<0 || b<0 || alpha<=0)
128 return -1;
129
130 const Double_t l = s==0 ? 0 : s*TMath::Log(s/sum*(alpha+1)/alpha);
131 const Double_t m = b==0 ? 0 : b*TMath::Log(b/sum*(alpha+1) );
132
133 return l+m<0 ? -1 : TMath::Sqrt((l+m)*2);
134}
135
136/*
137Double_t MMath::SignificanceLiMaErr(Double_t s, Double_t b, Double_t alpha)
138{
139 Double_t S = SignificanceLiMa(s, b, alpha);
140 if (S<0)
141 return -1;
142
143 const Double_t sum = s+b;
144
145
146 Double_t l = TMath::Log(s/sum*(alpha+1)/alpha)/TMath::Sqrt(2*S);
147 Double_t m = TMath::Log(s/sum*(alpha+1)/alpha)/TMath::Sqrt(2*S);
148
149
150 const Double_t sum = s+b;
151
152 if (s<0 || b<0 || alpha<=0)
153 return -1;
154
155 const Double_t l = s==0 ? 0 : s*TMath::Log(s/sum*(alpha+1)/alpha);
156 const Double_t m = b==0 ? 0 : b*TMath::Log(b/sum*(alpha+1) );
157
158 return l+m<0 ? -1 : TMath::Sqrt((l+m)*2);
159}
160*/
161
162// --------------------------------------------------------------------------
163//
164// Calculates MMath::SignificanceLiMa(s, b, alpha). Returns 0 if the
165// calculation has failed. Otherwise the Li/Ma significance which was
166// calculated. If s<b a negative value is returned.
167//
168Double_t MMath::SignificanceLiMaSigned(Double_t s, Double_t b, Double_t alpha)
169{
170 const Double_t sig = SignificanceLiMa(s, b, alpha);
171 if (sig<=0)
172 return 0;
173
174 return TMath::Sign(sig, s-alpha*b);
175}
176
177// --------------------------------------------------------------------------
178//
179// Return Li/Ma (5) for the error of the excess, under the assumption that
180// the existance of a signal is already known. (basically signal/error
181// calculated by error propagation)
182//
183Double_t MMath::SignificanceExc(Double_t s, Double_t b, Double_t alpha)
184{
185 const Double_t error = ErrorExc(s, b, alpha);
186 if (error==0)
187 return 0;
188
189 const Double_t Ns = s - alpha*b;
190
191 return Ns/error;
192}
193
194// --------------------------------------------------------------------------
195//
196// Calculate the error of s-alpha*b by error propagation
197//
198Double_t MMath::ErrorExc(Double_t s, Double_t b, Double_t alpha)
199{
200 const Double_t sN = s + alpha*alpha*b;
201 return sN<0 ? 0 : TMath::Sqrt(sN);
202}
203
204// --------------------------------------------------------------------------
205//
206// Returns: 2/(sigma*sqrt(2))*integral[0,x](exp(-(x-mu)^2/(2*sigma^2)))
207//
208Double_t MMath::GaussProb(Double_t x, Double_t sigma, Double_t mean)
209{
210 if (x<mean)
211 return 0;
212
213 static const Double_t sqrt2 = TMath::Sqrt(2.);
214
215 const Double_t rc = TMath::Erf((x-mean)/(sigma*sqrt2));
216
217 if (rc<0)
218 return 0;
219 if (rc>1)
220 return 1;
221
222 return rc;
223}
224
225// ------------------------------------------------------------------------
226//
227// Return the "median" (at 68.3%) value of the distribution of
228// abs(a[i]-Median)
229//
230template <class Size, class Element>
231Double_t MMath::MedianDevImp(Size n, const Element *a, Double_t &med)
232{
233 static const Double_t prob = 0.682689477208650697; //MMath::GaussProb(1.0);
234
235 // Sanity check
236 if (n <= 0 || !a)
237 return 0;
238
239 // Get median of distribution
240 med = TMath::Median(n, a);
241
242 // Create the abs(a[i]-med) distribution
243 Double_t arr[n];
244 for (int i=0; i<n; i++)
245 arr[i] = (Double_t)TMath::Abs(Double_t(a[i])-med);
246
247 //return TMath::Median(n, arr)/0.67449896936; //MMath::GaussProb(x)=0.5
248
249 // Define where to divide (floor because the highest possible is n-1)
250 const Size div = TMath::FloorNint(Double_t(n)*prob);
251
252 // Calculate result
253 Double_t dev = TMath::KOrdStat(n, arr, div);
254 if (n%2 == 0)
255 {
256 dev += TMath::KOrdStat(n, arr, div-1);
257 dev /= 2;
258 }
259
260 return dev;
261}
262
263// ------------------------------------------------------------------------
264//
265// Return the "median" (at 68.3%) value of the distribution of
266// abs(a[i]-Median)
267//
268Double_t MMath::MedianDev(Long64_t n, const Short_t *a, Double_t &med)
269{
270 return MedianDevImp(n, a, med);
271}
272
273// ------------------------------------------------------------------------
274//
275// Return the "median" (at 68.3%) value of the distribution of
276// abs(a[i]-Median)
277//
278Double_t MMath::MedianDev(Long64_t n, const Int_t *a, Double_t &med)
279{
280 return MedianDevImp(n, a, med);
281}
282
283// ------------------------------------------------------------------------
284//
285// Return the "median" (at 68.3%) value of the distribution of
286// abs(a[i]-Median)
287//
288Double_t MMath::MedianDev(Long64_t n, const Float_t *a, Double_t &med)
289{
290 return MedianDevImp(n, a, med);
291}
292
293// ------------------------------------------------------------------------
294//
295// Return the "median" (at 68.3%) value of the distribution of
296// abs(a[i]-Median)
297//
298Double_t MMath::MedianDev(Long64_t n, const Double_t *a, Double_t &med)
299{
300 return MedianDevImp(n, a, med);
301}
302
303// ------------------------------------------------------------------------
304//
305// Return the "median" (at 68.3%) value of the distribution of
306// abs(a[i]-Median)
307//
308Double_t MMath::MedianDev(Long64_t n, const Long_t *a, Double_t &med)
309{
310 return MedianDevImp(n, a, med);
311}
312
313// ------------------------------------------------------------------------
314//
315// Return the "median" (at 68.3%) value of the distribution of
316// abs(a[i]-Median)
317//
318Double_t MMath::MedianDev(Long64_t n, const Long64_t *a, Double_t &med)
319{
320 return MedianDevImp(n, a, med);
321}
322
323Double_t MMath::MedianDev(Long64_t n, const Short_t *a) { Double_t med; return MedianDevImp(n, a, med); }
324Double_t MMath::MedianDev(Long64_t n, const Int_t *a) { Double_t med; return MedianDevImp(n, a, med); }
325Double_t MMath::MedianDev(Long64_t n, const Float_t *a) { Double_t med; return MedianDevImp(n, a, med); }
326Double_t MMath::MedianDev(Long64_t n, const Double_t *a) { Double_t med; return MedianDevImp(n, a, med); }
327Double_t MMath::MedianDev(Long64_t n, const Long_t *a) { Double_t med; return MedianDevImp(n, a, med); }
328Double_t MMath::MedianDev(Long64_t n, const Long64_t *a) { Double_t med; return MedianDevImp(n, a, med); }
329
330// ------------------------------------------------------------------------
331//
332// Re-sort an array. Intsead of returning an index (like TMath::Sort)
333// the array contents are sorted.
334//
335template <class Size, class Element> void MMath::ReSortImp(Size n, Element *a, Bool_t down)
336{
337 Element *cpy = new Element[n];
338 Size *pos = new Size[n];
339
340 memcpy(cpy, a, n*sizeof(Element));
341
342 TMath::Sort(n, a, pos, down);
343
344 Size *idx = pos;
345
346 for (Element *ptr=a; ptr<a+n; ptr++)
347 *ptr = cpy[*idx++];
348
349 delete [] cpy;
350 delete [] pos;
351}
352
353void MMath::ReSort(Long64_t n, Short_t *a, Bool_t down) { ReSortImp(n, a, down); }
354void MMath::ReSort(Long64_t n, Int_t *a, Bool_t down) { ReSortImp(n, a, down); }
355void MMath::ReSort(Long64_t n, Float_t *a, Bool_t down) { ReSortImp(n, a, down); }
356void MMath::ReSort(Long64_t n, Double_t *a, Bool_t down) { ReSortImp(n, a, down); }
357
358// --------------------------------------------------------------------------
359//
360// This function reduces the precision to roughly 0.5% of a Float_t by
361// changing its bit-pattern (Be carefull, in rare cases this function must
362// be adapted to different machines!). This is usefull to enforce better
363// compression by eg. gzip.
364//
365void MMath::ReducePrecision(Float_t &val)
366{
367 UInt_t &f = (UInt_t&)val;
368
369 f += 0x00004000;
370 f &= 0xffff8000;
371}
372
373// -------------------------------------------------------------------------
374//
375// Quadratic interpolation
376//
377// calculate the parameters of a parabula such that
378// y(i) = a + b*x(i) + c*x(i)^2
379//
380// If the determinant==0 an empty TVector3 is returned.
381//
382TVector3 MMath::GetParab(const TVector3 &x, const TVector3 &y)
383{
384 const Double_t x1 = x(0);
385 const Double_t x2 = x(1);
386 const Double_t x3 = x(2);
387
388 const Double_t y1 = y(0);
389 const Double_t y2 = y(1);
390 const Double_t y3 = y(2);
391
392 const double det =
393 + x2*x3*x3 + x1*x2*x2 + x3*x1*x1
394 - x2*x1*x1 - x3*x2*x2 - x1*x3*x3;
395
396
397 if (det==0)
398 return TVector3();
399
400 const double det1 = 1.0/det;
401
402 const double ai11 = x2*x3*x3 - x3*x2*x2;
403 const double ai12 = x3*x1*x1 - x1*x3*x3;
404 const double ai13 = x1*x2*x2 - x2*x1*x1;
405
406 const double ai21 = x2*x2 - x3*x3;
407 const double ai22 = x3*x3 - x1*x1;
408 const double ai23 = x1*x1 - x2*x2;
409
410 const double ai31 = x3 - x2;
411 const double ai32 = x1 - x3;
412 const double ai33 = x2 - x1;
413
414 return TVector3((ai11*y1 + ai12*y2 + ai13*y3) * det1,
415 (ai21*y1 + ai22*y2 + ai23*y3) * det1,
416 (ai31*y1 + ai32*y2 + ai33*y3) * det1);
417}
418
419// --------------------------------------------------------------------------
420//
421// Interpolate the points with x-coordinates vx and y-coordinates vy
422// by a parabola (second order polynomial) and return the value at x.
423//
424Double_t MMath::InterpolParabLin(const TVector3 &vx, const TVector3 &vy, Double_t x)
425{
426 const TVector3 c = GetParab(vx, vy);
427 return c(0) + c(1)*x + c(2)*x*x;
428}
429
430// --------------------------------------------------------------------------
431//
432// Interpolate the points with x-coordinates vx=(-1,0,1) and
433// y-coordinates vy by a parabola (second order polynomial) and return
434// the value at x.
435//
436Double_t MMath::InterpolParabLin(const TVector3 &vy, Double_t x)
437{
438 const TVector3 c(vy(1), (vy(2)-vy(0))/2, vy(0)/2 - vy(1) + vy(2)/2);
439 return c(0) + c(1)*x + c(2)*x*x;
440}
441
442Double_t MMath::InterpolParabLog(const TVector3 &vx, const TVector3 &vy, Double_t x)
443{
444 const Double_t l0 = TMath::Log10(vx(0));
445 const Double_t l1 = TMath::Log10(vx(1));
446 const Double_t l2 = TMath::Log10(vx(2));
447
448 const TVector3 vx0(l0, l1, l2);
449 return InterpolParabLin(vx0, vy, TMath::Log10(x));
450}
451
452Double_t MMath::InterpolParabCos(const TVector3 &vx, const TVector3 &vy, Double_t x)
453{
454 const Double_t l0 = TMath::Cos(vx(0));
455 const Double_t l1 = TMath::Cos(vx(1));
456 const Double_t l2 = TMath::Cos(vx(2));
457
458 const TVector3 vx0(l0, l1, l2);
459 return InterpolParabLin(vx0, vy, TMath::Cos(x));
460}
461
462// --------------------------------------------------------------------------
463//
464// Analytically calculated result of a least square fit of:
465// y = A*e^(B*x)
466// Equal weights
467//
468// It returns TArrayD(2) = { A, B };
469//
470// see: http://mathworld.wolfram.com/LeastSquaresFittingExponential.html
471//
472TArrayD MMath::LeastSqFitExpW1(Int_t n, Double_t *x, Double_t *y)
473{
474 Double_t sumxsqy = 0;
475 Double_t sumylny = 0;
476 Double_t sumxy = 0;
477 Double_t sumy = 0;
478 Double_t sumxylny = 0;
479 for (int i=0; i<n; i++)
480 {
481 sumylny += y[i]*TMath::Log(y[i]);
482 sumxy += x[i]*y[i];
483 sumxsqy += x[i]*x[i]*y[i];
484 sumxylny += x[i]*y[i]*TMath::Log(y[i]);
485 sumy += y[i];
486 }
487
488 const Double_t dev = sumy*sumxsqy - sumxy*sumxy;
489
490 const Double_t a = (sumxsqy*sumylny - sumxy*sumxylny)/dev;
491 const Double_t b = (sumy*sumxylny - sumxy*sumylny)/dev;
492
493 TArrayD rc(2);
494 rc[0] = TMath::Exp(a);
495 rc[1] = b;
496 return rc;
497}
498
499// --------------------------------------------------------------------------
500//
501// Analytically calculated result of a least square fit of:
502// y = A*e^(B*x)
503// Greater weights to smaller values
504//
505// It returns TArrayD(2) = { A, B };
506//
507// see: http://mathworld.wolfram.com/LeastSquaresFittingExponential.html
508//
509TArrayD MMath::LeastSqFitExp(Int_t n, Double_t *x, Double_t *y)
510{
511 // -------- Greater weights to smaller values ---------
512 Double_t sumlny = 0;
513 Double_t sumxlny = 0;
514 Double_t sumxsq = 0;
515 Double_t sumx = 0;
516 for (int i=0; i<n; i++)
517 {
518 sumlny += TMath::Log(y[i]);
519 sumxlny += x[i]*TMath::Log(y[i]);
520
521 sumxsq += x[i]*x[i];
522 sumx += x[i];
523 }
524
525 const Double_t dev = n*sumxsq-sumx*sumx;
526
527 const Double_t a = (sumlny*sumxsq - sumx*sumxlny)/dev;
528 const Double_t b = (n*sumxlny - sumx*sumlny)/dev;
529
530 TArrayD rc(2);
531 rc[0] = TMath::Exp(a);
532 rc[1] = b;
533 return rc;
534}
535
536// --------------------------------------------------------------------------
537//
538// Analytically calculated result of a least square fit of:
539// y = A+B*ln(x)
540//
541// It returns TArrayD(2) = { A, B };
542//
543// see: http://mathworld.wolfram.com/LeastSquaresFittingLogarithmic.html
544//
545TArrayD MMath::LeastSqFitLog(Int_t n, Double_t *x, Double_t *y)
546{
547 Double_t sumylnx = 0;
548 Double_t sumy = 0;
549 Double_t sumlnx = 0;
550 Double_t sumlnxsq = 0;
551 for (int i=0; i<n; i++)
552 {
553 sumylnx += y[i]*TMath::Log(x[i]);
554 sumy += y[i];
555 sumlnx += TMath::Log(x[i]);
556 sumlnxsq += TMath::Log(x[i])*TMath::Log(x[i]);
557 }
558
559 const Double_t b = (n*sumylnx-sumy*sumlnx)/(n*sumlnxsq-sumlnx*sumlnx);
560 const Double_t a = (sumy-b*sumlnx)/n;
561
562 TArrayD rc(2);
563 rc[0] = a;
564 rc[1] = b;
565 return rc;
566}
567
568// --------------------------------------------------------------------------
569//
570// Analytically calculated result of a least square fit of:
571// y = A*x^B
572//
573// It returns TArrayD(2) = { A, B };
574//
575// see: http://mathworld.wolfram.com/LeastSquaresFittingPowerLaw.html
576//
577TArrayD MMath::LeastSqFitPowerLaw(Int_t n, Double_t *x, Double_t *y)
578{
579 Double_t sumlnxlny = 0;
580 Double_t sumlnx = 0;
581 Double_t sumlny = 0;
582 Double_t sumlnxsq = 0;
583 for (int i=0; i<n; i++)
584 {
585 sumlnxlny += TMath::Log(x[i])*TMath::Log(y[i]);
586 sumlnx += TMath::Log(x[i]);
587 sumlny += TMath::Log(y[i]);
588 sumlnxsq += TMath::Log(x[i])*TMath::Log(x[i]);
589 }
590
591 const Double_t b = (n*sumlnxlny-sumlnx*sumlny)/(n*sumlnxsq-sumlnx*sumlnx);
592 const Double_t a = (sumlny-b*sumlnx)/n;
593
594 TArrayD rc(2);
595 rc[0] = TMath::Exp(a);
596 rc[1] = b;
597 return rc;
598}
599
600// --------------------------------------------------------------------------
601//
602// Calculate the intersection of two lines defined by (x1;y1) and (x2;x2)
603// Returns the intersection point.
604//
605// It is assumed that the lines intersect. If there is no intersection
606// TVector2() is returned (which is not destinguishable from
607// TVector2(0,0) if the intersection is at the coordinate source)
608//
609// Formula from: http://mathworld.wolfram.com/Line-LineIntersection.html
610//
611TVector2 MMath::GetIntersectionPoint(const TVector2 &x1, const TVector2 &y1, const TVector2 &x2, const TVector2 &y2)
612{
613 TMatrix d(2,2);
614 d[0][0] = x1.X()-y1.X();
615 d[0][1] = x2.X()-y2.X();
616 d[1][0] = x1.Y()-y1.Y();
617 d[1][1] = x2.Y()-y2.Y();
618
619 const Double_t denom = d.Determinant();
620 if (denom==0)
621 return TVector2();
622
623 TMatrix l1(2,2);
624 TMatrix l2(2,2);
625
626 l1[0][0] = x1.X();
627 l1[0][1] = y1.X();
628 l2[0][0] = x2.X();
629 l2[0][1] = y2.X();
630
631 l1[1][0] = x1.Y();
632 l1[1][1] = y1.Y();
633 l2[1][0] = x2.Y();
634 l2[1][1] = y2.Y();
635
636 TMatrix a(2,2);
637 a[0][0] = l1.Determinant();
638 a[0][1] = l2.Determinant();
639 a[1][0] = x1.X()-y1.X();
640 a[1][1] = x2.X()-y2.X();
641
642 const Double_t X = a.Determinant()/denom;
643
644 a[1][0] = x1.Y()-y1.Y();
645 a[1][1] = x2.Y()-y2.Y();
646
647 const Double_t Y = a.Determinant()/denom;
648
649 return TVector2(X, Y);
650}
651
652// --------------------------------------------------------------------------
653//
654// Solves: x^2 + ax + b = 0;
655// Return number of solutions returned as x1, x2
656//
657Int_t MMath::SolvePol2(Double_t a, Double_t b, Double_t &x1, Double_t &x2)
658{
659 const Double_t r = a*a - 4*b;
660 if (r<0)
661 return 0;
662
663 if (r==0)
664 {
665 x1 = x2 = -a/2;
666 return 1;
667 }
668
669 const Double_t s = TMath::Sqrt(r);
670
671 x1 = (-a+s)/2;
672 x2 = (-a-s)/2;
673
674 return 2;
675}
676
677// --------------------------------------------------------------------------
678//
679// This is a helper function making the execution of SolverPol3 a bit faster
680//
681static inline Double_t ReMul(const TComplex &c1, const TComplex &th)
682{
683 const TComplex c2 = TComplex::Cos(th/3.);
684 return c1.Re() * c2.Re() - c1.Im() * c2.Im();
685}
686
687// --------------------------------------------------------------------------
688//
689// Solves: x^3 + ax^2 + bx + c = 0;
690// Return number of the real solutions, returned as z1, z2, z3
691//
692// Algorithm adapted from http://home.att.net/~srschmitt/cubizen.heml
693// Which is based on the solution given in
694// http://mathworld.wolfram.com/CubicEquation.html
695//
696// -------------------------------------------------------------------------
697//
698// Exact solutions of cubic polynomial equations
699// by Stephen R. Schmitt Algorithm
700//
701// An exact solution of the cubic polynomial equation:
702//
703// x^3 + a*x^2 + b*x + c = 0
704//
705// was first published by Gerolamo Cardano (1501-1576) in his treatise,
706// Ars Magna. He did not discoverer of the solution; a professor of
707// mathematics at the University of Bologna named Scipione del Ferro (ca.
708// 1465-1526) is credited as the first to find an exact solution. In the
709// years since, several improvements to the original solution have been
710// discovered. Zeno source code
711//
712// http://home.att.net/~srschmitt/cubizen.html
713//
714// % compute real or complex roots of cubic polynomial
715// function cubic( var z1, z2, z3 : real, a, b, c : real ) : real
716//
717// var Q, R, D, S, T : real
718// var im, th : real
719//
720// Q := (3*b - a^2)/9
721// R := (9*b*a - 27*c - 2*a^3)/54
722// D := Q^3 + R^2 % polynomial discriminant
723//
724// if (D >= 0) then % complex or duplicate roots
725//
726// S := sgn(R + sqrt(D))*abs(R + sqrt(D))^(1/3)
727// T := sgn(R - sqrt(D))*abs(R - sqrt(D))^(1/3)
728//
729// z1 := -a/3 + (S + T) % real root
730// z2 := -a/3 - (S + T)/2 % real part of complex root
731// z3 := -a/3 - (S + T)/2 % real part of complex root
732// im := abs(sqrt(3)*(S - T)/2) % complex part of root pair
733//
734// else % distinct real roots
735//
736// th := arccos(R/sqrt( -Q^3))
737//
738// z1 := 2*sqrt(-Q)*cos(th/3) - a/3
739// z2 := 2*sqrt(-Q)*cos((th + 2*pi)/3) - a/3
740// z3 := 2*sqrt(-Q)*cos((th + 4*pi)/3) - a/3
741// im := 0
742//
743// end if
744//
745// return im % imaginary part
746//
747// end function
748//
749// see also http://en.wikipedia.org/wiki/Cubic_equation
750//
751Int_t MMath::SolvePol3(Double_t a, Double_t b, Double_t c,
752 Double_t &x1, Double_t &x2, Double_t &x3)
753{
754 // Double_t coeff[4] = { 1, a, b, c };
755 // return TMath::RootsCubic(coeff, x1, x2, x3) ? 1 : 3;
756
757 const Double_t Q = (a*a - 3*b)/9;
758 const Double_t R = (9*b*a - 27*c - 2*a*a*a)/54;
759 const Double_t D = R*R - Q*Q*Q; // polynomial discriminant
760
761 // ----- The single-real / duplicate-roots solution -----
762
763 // D<0: three real roots
764 // D>0: one real root
765 // D==0: maximum two real roots (two identical roots)
766
767 // R==0: only one unique root
768 // R!=0: two roots
769
770 if (D==0)
771 {
772 const Double_t r = MMath::Sqrt3(R);
773
774 x1 = r - a/3.; // real root
775 if (R==0)
776 return 1;
777
778 x2 = 2*r - a/3.; // real root
779 return 2;
780 }
781
782 if (D>0) // complex or duplicate roots
783 {
784 const Double_t sqrtd = TMath::Sqrt(D);
785
786 const Double_t A = TMath::Sign(1., R)*MMath::Sqrt3(TMath::Abs(R)+sqrtd);
787
788 // The case A==0 cannot happen. This would imply D==0
789 // if (A==0)
790 // {
791 // x1 = -a/3;
792 // return 1;
793 // }
794
795 x1 = (A+Q/A)-a/3;
796
797 //const Double_t S = MMath::Sqrt3(R + sqrtd);
798 //const Double_t T = MMath::Sqrt3(R - sqrtd);
799 //x1 = (S+T) - a/3.; // real root
800
801 return 1;
802
803 //z2 = (S + T)/2 - a/3.; // real part of complex root
804 //z3 = (S + T)/2 - a/3.; // real part of complex root
805 //im = fabs(sqrt(3)*(S - T)/2) // complex part of root pair
806 }
807
808 // ----- The general solution with three roots ---
809
810 if (Q==0)
811 return 0;
812
813 if (Q>0) // This is here for speed reasons
814 {
815 const Double_t sqrtq = TMath::Sqrt(Q);
816 const Double_t rq = R/TMath::Abs(Q);
817
818 const Double_t t = TMath::ACos(rq/sqrtq)/3;
819
820 static const Double_t sqrt3 = TMath::Sqrt(3.);
821
822 const Double_t sn = TMath::Sin(t)*sqrt3;
823 const Double_t cs = TMath::Cos(t);
824
825 x1 = 2*sqrtq * cs - a/3;
826 x2 = -sqrtq * (sn + cs) - a/3;
827 x3 = sqrtq * (sn - cs) - a/3;
828
829 /* --- Easier to understand but slower ---
830 const Double_t th1 = TMath::ACos(rq/sqrtq);
831 const Double_t th2 = th1 + TMath::TwoPi();
832 const Double_t th3 = th2 + TMath::TwoPi();
833
834 x1 = 2.*sqrtq * TMath::Cos(th1/3.) - a/3.;
835 x2 = 2.*sqrtq * TMath::Cos(th2/3.) - a/3.;
836 x3 = 2.*sqrtq * TMath::Cos(th3/3.) - a/3.;
837 */
838 return 3;
839 }
840
841 const TComplex sqrtq = TComplex::Sqrt(Q);
842 const Double_t rq = R/TMath::Abs(Q);
843
844 const TComplex th1 = TComplex::ACos(rq/sqrtq);
845 const TComplex th2 = th1 + TMath::TwoPi();
846 const TComplex th3 = th2 + TMath::TwoPi();
847
848 // For ReMul, see bove
849 x1 = ReMul(2.*sqrtq, th1) - a/3.;
850 x2 = ReMul(2.*sqrtq, th2) - a/3.;
851 x3 = ReMul(2.*sqrtq, th3) - a/3.;
852
853 return 3;
854}
855
856// --------------------------------------------------------------------------
857//
858// Format a value and its error corresponding to the rules (note
859// this won't work if the error is more then eight orders smaller than
860// the value)
861//
862void MMath::Format(Double_t &v, Double_t &e)
863{
864 // Valid digits
865 Int_t i = TMath::FloorNint(TMath::Log10(v))-TMath::FloorNint(TMath::Log10(e));
866
867 // Check if error starts with 1 or 2. In this case use one
868 // more valid digit
869 TString error = MString::Format("%.0e", e);
870 if (error[0]=='1' || error[0]=='2')
871 {
872 i++;
873 error = MString::Format("%.1e", e);
874 }
875
876 const TString fmt = MString::Format("%%.%de", i);
877
878 v = MString::Format(fmt.Data(), v).Atof();
879 e = error.Atof();
880}
881
882Double_t MMath::RndmExp(Double_t tau)
883{
884 // returns an exponential deviate.
885 //
886 // exp( -t/tau )
887
888 const Double_t x = gRandom->Rndm(); // uniform on ] 0, 1 ]
889
890 return -tau * TMath::Log(x); // convert to exponential distribution
891}
Note: See TracBrowser for help on using the repository browser.