DETMON Pipeline Reference Manual  1.2.4
irplib_polynomial.c
1 /* $Id: irplib_polynomial.c,v 1.35 2013/01/29 08:43:33 jtaylor Exp $
2  *
3  * This file is part of the ESO Common Pipeline Library
4  * Copyright (C) 2001-2004 European Southern Observatory
5  *
6  * This program is free software; you can redistribute it and/or modify
7  * it under the terms of the GNU General Public License as published by
8  * the Free Software Foundation; either version 2 of the License, or
9  * (at your option) any later version.
10  *
11  * This program is distributed in the hope that it will be useful,
12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14  * GNU General Public License for more details.
15  *
16  * You should have received a copy of the GNU General Public License
17  * along with this program; if not, write to the Free Software
18  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
19  */
20 
21 /*
22  * $Author: jtaylor $
23  * $Date: 2013/01/29 08:43:33 $
24  * $Revision: 1.35 $
25  * $Name: detmon-1_2_4 $
26  */
27 
28 #ifdef HAVE_CONFIG_H
29 #include <config.h>
30 #endif
31 
32 /*-----------------------------------------------------------------------------
33  Includes
34  -----------------------------------------------------------------------------*/
35 
36 #include "irplib_polynomial.h"
37 #include <assert.h>
38 #include <math.h>
39 /* DBL_MAX: */
40 #include <float.h>
41 
42 /*----------------------------------------------------------------------------*/
48 /*----------------------------------------------------------------------------*/
51 /*-----------------------------------------------------------------------------
52  Macro definitions
53  -----------------------------------------------------------------------------*/
54 
55 #define IRPLIB_SWAP(a,b) { const double t=(a);(a)=(b);(b)=t; }
56 
57 #if 0
58 #define irplib_trace() cpl_msg_info(cpl_func, "%d: Trace", __LINE__)
59 #else
60 #define irplib_trace() /* Trace */
61 #endif
62 
63 /*-----------------------------------------------------------------------------
64  Static functions
65  -----------------------------------------------------------------------------*/
66 
67 static double irplib_polynomial_eval_2_max(double, double, double, cpl_boolean,
68  double, double);
69 
70 static double irplib_polynomial_eval_3_max(double, double, double, double,
71  cpl_boolean, double, double, double);
72 
73 
74 static cpl_boolean irplib_polynomial_solve_1d_2(double, double, double,
75  double *, double *);
76 static cpl_boolean irplib_polynomial_solve_1d_3(double, double, double, double,
77  double *, double *, double *,
78  cpl_boolean *,
79  cpl_boolean *);
80 
81 static void irplib_polynomial_solve_1d_31(double, double, double *, double *,
82  double *, cpl_boolean *);
83 
84 static void irplib_polynomial_solve_1d_32(double, double, double, double *,
85  double *, double *, cpl_boolean *);
86 
87 static void irplib_polynomial_solve_1d_3r(double, double, double, double,
88  double *, double *, double *);
89 
90 static void irplib_polynomial_solve_1d_3c(double, double, double,
91  double, double, double,
92  double *, double *, double *,
93  cpl_boolean *, cpl_boolean *);
94 
95 static cpl_error_code irplib_polynomial_solve_1d_4(double, double, double,
96  double, double, cpl_size *,
97  double *, double *,
98  double *, double *);
99 
100 static cpl_error_code irplib_polynomial_solve_1d_nonzero(cpl_polynomial *,
101  cpl_vector *,
102  cpl_size *);
103 
104 static cpl_error_code irplib_polynomial_divide_1d_root(cpl_polynomial *, double,
105  double *);
106 
107 #ifdef IPRLIB_POLYNOMIAL_USE_MONOMIAL_ROOT
108 static double irplib_polynomial_depress_1d(cpl_polynomial *);
109 #endif
110 
111 /*-----------------------------------------------------------------------------
112  Function codes
113  -----------------------------------------------------------------------------*/
114 
115 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE > CPL_VERSION(5, 92, 0)
116 #else
117 
118 /*----------------------------------------------------------------------------*/
133 /*----------------------------------------------------------------------------*/
134 cpl_error_code irplib_polynomial_add(cpl_polynomial * self,
135  const cpl_polynomial * first,
136  const cpl_polynomial * second)
137 {
138  cpl_size degree0 = cpl_polynomial_get_degree(self);
139  const cpl_size degree1 = cpl_polynomial_get_degree(first);
140  const cpl_size degree2 = cpl_polynomial_get_degree(second);
141  const cpl_size maxdeg = degree1 > degree2 ? degree1 : degree2;
142 
143 
144  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
145  cpl_ensure_code(first != NULL, CPL_ERROR_NULL_INPUT);
146  cpl_ensure_code(second != NULL, CPL_ERROR_NULL_INPUT);
147 
148  cpl_ensure_code(cpl_polynomial_get_dimension(self) ==
149  cpl_polynomial_get_dimension(first),
150  CPL_ERROR_INCOMPATIBLE_INPUT);
151  cpl_ensure_code(cpl_polynomial_get_dimension(self) ==
152  cpl_polynomial_get_dimension(second),
153  CPL_ERROR_INCOMPATIBLE_INPUT);
154 
155  /* FIXME: */
156  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
157  CPL_ERROR_UNSUPPORTED_MODE);
158 
159  if (degree0 < maxdeg) {
160  degree0 = maxdeg;
161  } else {
162  /* Reset coefficients in self as needed */
163  for (; degree0 > maxdeg; degree0--) {
164  cpl_polynomial_set_coeff(self, &degree0, 0.0);
165  }
166  }
167 
168  /* assert( degree0 == maxdeg ); */
169 
170  for (; degree0 >= 0; degree0--) {
171  const double val1 = cpl_polynomial_get_coeff(first, &degree0);
172  const double val2 = cpl_polynomial_get_coeff(second, &degree0);
173  cpl_polynomial_set_coeff(self, &degree0, val1 + val2);
174  }
175 
176  return CPL_ERROR_NONE;
177 }
178 
179 /*----------------------------------------------------------------------------*/
194 /*----------------------------------------------------------------------------*/
195 cpl_error_code irplib_polynomial_subtract(cpl_polynomial * self,
196  const cpl_polynomial * first,
197  const cpl_polynomial * second)
198 {
199  cpl_size degree0 = cpl_polynomial_get_degree(self);
200  const cpl_size degree1 = cpl_polynomial_get_degree(first);
201  const cpl_size degree2 = cpl_polynomial_get_degree(second);
202  const cpl_size maxdeg = degree1 > degree2 ? degree1 : degree2;
203 
204 
205  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
206  cpl_ensure_code(first != NULL, CPL_ERROR_NULL_INPUT);
207  cpl_ensure_code(second != NULL, CPL_ERROR_NULL_INPUT);
208 
209  cpl_ensure_code(cpl_polynomial_get_dimension(self) ==
210  cpl_polynomial_get_dimension(first),
211  CPL_ERROR_INCOMPATIBLE_INPUT);
212  cpl_ensure_code(cpl_polynomial_get_dimension(self) ==
213  cpl_polynomial_get_dimension(second),
214  CPL_ERROR_INCOMPATIBLE_INPUT);
215 
216  /* FIXME: */
217  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
218  CPL_ERROR_UNSUPPORTED_MODE);
219 
220  if (degree0 < maxdeg) {
221  degree0 = maxdeg;
222  } else {
223  /* Reset coefficients in self as needed */
224  for (; degree0 > maxdeg; degree0--) {
225  cpl_polynomial_set_coeff(self, &degree0, 0.0);
226  }
227  }
228 
229  /* assert( degree0 == maxdeg ); */
230 
231  for (; degree0 >= 0; degree0--) {
232  const double val1 = cpl_polynomial_get_coeff(first, &degree0);
233  const double val2 = cpl_polynomial_get_coeff(second, &degree0);
234  cpl_polynomial_set_coeff(self, &degree0, val1 - val2);
235  }
236 
237  return CPL_ERROR_NONE;
238 }
239 
240 /*----------------------------------------------------------------------------*/
252 /*----------------------------------------------------------------------------*/
253 cpl_error_code irplib_polynomial_multiply_scalar(cpl_polynomial * self,
254  const cpl_polynomial * other,
255  double factor)
256 {
257 
258  const cpl_size maxdeg = cpl_polynomial_get_degree(other);
259  const cpl_size zerodeg = cpl_polynomial_get_degree(self);
260  cpl_size degree;
261 
262  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
263  cpl_ensure_code(other != NULL, CPL_ERROR_NULL_INPUT);
264 
265  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
266  CPL_ERROR_UNSUPPORTED_MODE);
267  cpl_ensure_code(cpl_polynomial_get_dimension(other) == 1,
268  CPL_ERROR_UNSUPPORTED_MODE);
269 
270  for (degree = 0; degree <= maxdeg; degree++) {
271  const double val = factor * cpl_polynomial_get_coeff(other, &degree);
272  cpl_polynomial_set_coeff(self, &degree, val);
273  }
274 
275  /* Reset coefficients in self as needed */
276  for (; degree <= zerodeg; degree++) {
277  cpl_polynomial_set_coeff(self, &zerodeg, 0.0);
278  }
279 
280  return CPL_ERROR_NONE;
281 }
282 #endif
283 /*----------------------------------------------------------------------------*/
309 /*----------------------------------------------------------------------------*/
310 cpl_error_code irplib_polynomial_solve_1d_all(const cpl_polynomial * self,
311  cpl_vector * roots,
312  cpl_size * preal)
313 {
314 
315  cpl_error_code error = CPL_ERROR_NONE;
316  cpl_polynomial * p;
317 
318  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
319  cpl_ensure_code(roots != NULL, CPL_ERROR_NULL_INPUT);
320  cpl_ensure_code(preal != NULL, CPL_ERROR_NULL_INPUT);
321  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
322  CPL_ERROR_INVALID_TYPE);
323  cpl_ensure_code(cpl_polynomial_get_degree(self) > 0,
324  CPL_ERROR_DATA_NOT_FOUND);
325  cpl_ensure_code(cpl_polynomial_get_degree(self) ==
326  cpl_vector_get_size(roots), CPL_ERROR_INCOMPATIBLE_INPUT);
327 
328  *preal = 0;
329 
330  p = cpl_polynomial_duplicate(self);
331 
332  error = irplib_polynomial_solve_1d_nonzero(p, roots, preal);
333 
334  cpl_polynomial_delete(p);
335 
336  return error;
337 
338 }
339 
342 /*----------------------------------------------------------------------------*/
368 /*----------------------------------------------------------------------------*/
369 static cpl_error_code irplib_polynomial_solve_1d_nonzero(cpl_polynomial * self,
370  cpl_vector * roots,
371  cpl_size * preal)
372 {
373  cpl_error_code error = CPL_ERROR_NONE;
374  const cpl_size ncoeffs = 1 + cpl_polynomial_get_degree(self);
375 
376  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
377  cpl_ensure_code(roots != NULL, CPL_ERROR_NULL_INPUT);
378  cpl_ensure_code(preal != NULL, CPL_ERROR_NULL_INPUT);
379  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
380  CPL_ERROR_INVALID_TYPE);
381  cpl_ensure_code(ncoeffs > 1, CPL_ERROR_DATA_NOT_FOUND);
382  cpl_ensure_code(*preal >= 0, CPL_ERROR_ILLEGAL_INPUT);
383  cpl_ensure_code(ncoeffs + *preal == 1+cpl_vector_get_size(roots),
384  CPL_ERROR_INCOMPATIBLE_INPUT);
385 
386  switch (ncoeffs) {
387 
388  case 2 : {
389  const cpl_size i1 = 1;
390  const cpl_size i0 = 0;
391  const double p1 = cpl_polynomial_get_coeff(self, &i1);
392  const double p0 = cpl_polynomial_get_coeff(self, &i0);
393 
394  cpl_vector_set(roots, (*preal)++, -p0/p1);
395  break;
396  }
397  case 3 : {
398  const cpl_size i2 = 2;
399  const cpl_size i1 = 1;
400  const cpl_size i0 = 0;
401  const double p2 = cpl_polynomial_get_coeff(self, &i2);
402  const double p1 = cpl_polynomial_get_coeff(self, &i1);
403  const double p0 = cpl_polynomial_get_coeff(self, &i0);
404  double x1, x2;
405 
406  if (irplib_polynomial_solve_1d_2(p2, p1, p0, &x1, &x2)) {
407  /* This is the complex root in the upper imaginary half-plane */
408  cpl_vector_set(roots, (*preal) , x1);
409  cpl_vector_set(roots, (*preal)+1, x2);
410  } else {
411  cpl_vector_set(roots, (*preal)++, x1);
412  cpl_vector_set(roots, (*preal)++, x2);
413  }
414  break;
415  }
416  case 4 : {
417  const cpl_size i3 = 3;
418  const cpl_size i2 = 2;
419  const cpl_size i1 = 1;
420  const cpl_size i0 = 0;
421  const double p3 = cpl_polynomial_get_coeff(self, &i3);
422  const double p2 = cpl_polynomial_get_coeff(self, &i2);
423  const double p1 = cpl_polynomial_get_coeff(self, &i1);
424  const double p0 = cpl_polynomial_get_coeff(self, &i0);
425  double x1, x2, x3;
426 
427  if (irplib_polynomial_solve_1d_3(p3, p2, p1, p0, &x1, &x2, &x3,
428  NULL, NULL)) {
429  cpl_vector_set(roots, (*preal)++, x1);
430  /* This is the complex root in the upper imaginary half-plane */
431  cpl_vector_set(roots, (*preal) , x2);
432  cpl_vector_set(roots, (*preal)+1, x3);
433  } else {
434  cpl_vector_set(roots, (*preal)++, x1);
435  cpl_vector_set(roots, (*preal)++, x2);
436  cpl_vector_set(roots, (*preal)++, x3);
437  }
438  break;
439  }
440  case 5 : {
441  const cpl_size i4 = 4;
442  const cpl_size i3 = 3;
443  const cpl_size i2 = 2;
444  const cpl_size i1 = 1;
445  const cpl_size i0 = 0;
446  const double p4 = cpl_polynomial_get_coeff(self, &i4);
447  const double p3 = cpl_polynomial_get_coeff(self, &i3);
448  const double p2 = cpl_polynomial_get_coeff(self, &i2);
449  const double p1 = cpl_polynomial_get_coeff(self, &i1);
450  const double p0 = cpl_polynomial_get_coeff(self, &i0);
451  double x1, x2, x3, x4;
452  cpl_size nreal;
453 
454  error = irplib_polynomial_solve_1d_4(p4, p3, p2, p1, p0, &nreal,
455  &x1, &x2, &x3, &x4);
456  if (!error) {
457  cpl_vector_set(roots, (*preal) , x1);
458  cpl_vector_set(roots, (*preal)+1, x2);
459  cpl_vector_set(roots, (*preal)+2, x3);
460  cpl_vector_set(roots, (*preal)+3, x4);
461 
462  *preal += nreal;
463  }
464  break;
465  }
466 
467  default: {
468 
469  /* Try to reduce the problem by finding a single root */
470 #ifndef IPRLIB_POLYNOMIAL_USE_MONOMIAL_ROOT
471  const cpl_size n0 = ncoeffs-1;
472  const double pn0 = cpl_polynomial_get_coeff(self, &n0);
473  const cpl_size n1 = ncoeffs-2;
474  const double pn1 = cpl_polynomial_get_coeff(self, &n1);
475  /* First guess of root is the root average.
476  FIXME: May need refinement, e.g. via bisection */
477  const double rmean = -pn1 / (pn0 * n0);
478  double root = rmean;
479 #else
480  /* Try an analytical solution to a (shifted) monomial */
481  cpl_polynomial * copy = cpl_polynomial_duplicate(self);
482  const cpl_size i0 = 0;
483  const double rmean = irplib_polynomial_depress_1d(copy);
484  const double c0 = cpl_polynomial_get_coeff(copy, &i0);
485  double root = rmean + ((n0&1) && c0 < 0.0 ? -1.0 : 1.0)
486  * pow(fabs(c0), 1.0/n0);
487 
488  cpl_polynomial_delete(copy);
489 #endif
490 
491  error = cpl_polynomial_solve_1d(self, root, &root, 1);
492 
493  if (!error) {
494 
495  cpl_vector_set(roots, (*preal)++, root);
496 
497  irplib_polynomial_divide_1d_root(self, root, NULL);
498 
499  error = irplib_polynomial_solve_1d_nonzero(self, roots, preal);
500 
501  if (!error && *preal > 1) {
502  /* Sort the real roots */
503 
504  /* FIXME: Assumes that all roots found so far are real */
505 
506  cpl_vector * reals = cpl_vector_wrap(*preal,
507  cpl_vector_get_data(roots));
508  cpl_vector_sort(reals, 1);
509  (void)cpl_vector_unwrap(reals);
510  }
511  }
512  break;
513  }
514  }
515 
516  return error;
517 }
518 
519 /*----------------------------------------------------------------------------*/
531 /*----------------------------------------------------------------------------*/
532 static cpl_boolean irplib_polynomial_solve_1d_2(double p2, double p1, double p0,
533  double * px1,
534  double * px2) {
535 
536  const double sqrtD = sqrt(fabs(p1 * p1 - 4.0 * p2 * p0));
537  cpl_boolean is_complex = CPL_FALSE;
538  double x1 = -0.5 * p1 / p2; /* Double root */
539  double x2;
540 
541  /* Compute residual, assuming D == 0 */
542  double res0 = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x1);
543  double res;
544 
545  assert(px1 != NULL );
546  assert(px2 != NULL );
547 
548  *px2 = *px1 = x1;
549 
550  /* Compute residual, assuming D > 0 */
551 
552  /* x1 is the root with largest absolute value */
553  if (p1 > 0.0) {
554  x1 = -0.5 * (p1 + sqrtD);
555  irplib_trace(); /* OK */
556  } else {
557  x1 = -0.5 * (p1 - sqrtD);
558  irplib_trace(); /* OK */
559  }
560  /* Compute smaller root via division to avoid
561  loss of precision due to cancellation */
562  x2 = p0 / x1;
563  x1 /= p2; /* Scale x1 with leading coefficient */
564 
565  res = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x2);
566 
567  if (res < res0) {
568  res0 = res;
569  if (x2 > x1) {
570  *px1 = x1;
571  *px2 = x2;
572  irplib_trace(); /* OK */
573  } else {
574  *px1 = x2;
575  *px2 = x1;
576  irplib_trace(); /* OK */
577  }
578  }
579 
580  /* Compute residual, assuming D < 0 */
581 
582  x1 = -0.5 * p1 / p2; /* Real part of complex root */
583  x2 = 0.5 * sqrtD / fabs(p2); /* Positive, imaginary part of root */
584 
585  res = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_TRUE, x1, x2);
586 
587  if (res < res0) {
588  *px1 = x1;
589  *px2 = x2;
590  is_complex = CPL_TRUE;
591  irplib_trace(); /* OK */
592  }
593 
594  return is_complex;
595 
596 }
597 
598 
599 /*----------------------------------------------------------------------------*/
612 /*----------------------------------------------------------------------------*/
613 static double irplib_polynomial_eval_2_max(double p2, double p1, double p0,
614  cpl_boolean is_c,
615  double x1, double x2)
616 {
617  double res;
618 
619  if (is_c) {
620  res = fabs(p0 + x1 * (p1 + x1 * p2) - p2 * x2 * x2);
621  irplib_trace(); /* OK */
622  } else {
623  const double r1 = fabs(p0 + x1 * (p1 + x1 * p2));
624  const double r2 = fabs(p0 + x2 * (p1 + x2 * p2));
625 
626  res = r1 > r2 ? r1 : r2;
627  irplib_trace(); /* OK */
628  }
629 
630  return res;
631 }
632 
633 
634 /*----------------------------------------------------------------------------*/
649 /*----------------------------------------------------------------------------*/
650 static double irplib_polynomial_eval_3_max(double p3, double p2,
651  double p1, double p0,
652  cpl_boolean is_c,
653  double x1, double x2, double x3)
654 {
655  const double r1 = fabs(p0 + x1 * (p1 + x1 * (p2 + x1 * p3)));
656  double res;
657 
658  if (is_c) {
659  const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3))
660  - x3 * x3 * ( 3.0 * p3 * x2 + p2));
661 
662  res = r1 > r2 ? r1 : r2;
663  irplib_trace(); /* OK */
664  } else {
665  const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3)));
666  const double r3 = fabs(p0 + x3 * (p1 + x3 * (p2 + x3 * p3)));
667  res = r1 > r2 ? (r1 > r3 ? r1 : r3) : (r2 > r3 ? r2 : r3);
668  irplib_trace(); /* OK */
669  }
670 
671  /* cpl_msg_info(cpl_func, "%d: %g (%g)", __LINE__, res, r1); */
672 
673  return res;
674 }
675 
676 
677 /*----------------------------------------------------------------------------*/
696 /*----------------------------------------------------------------------------*/
697 static cpl_boolean irplib_polynomial_solve_1d_3(double p3, double p2, double p1,
698  double p0,
699  double * px1,
700  double * px2,
701  double * px3,
702  cpl_boolean * pdbl1,
703  cpl_boolean * pdbl2) {
704  cpl_boolean is_complex = CPL_FALSE;
705  const double a = p2/p3;
706  const double b = p1/p3;
707  const double c = p0/p3;
708 
709  const double q = (a * a - 3.0 * b);
710  const double r = (a * (2.0 * a * a - 9.0 * b) + 27.0 * c);
711 
712  const double Q = q / 9.0;
713  const double R = r / 54.0;
714 
715  const double Q3 = Q * Q * Q;
716  const double R2 = R * R;
717 
718  double x1 = DBL_MAX; /* Fix (false) uninit warning */
719  double x2 = DBL_MAX; /* Fix (false) uninit warning */
720  double x3 = DBL_MAX; /* Fix (false) uninit warning */
721  double xx1 = DBL_MAX; /* Fix (false) uninit warning */
722  double xx2 = DBL_MAX; /* Fix (false) uninit warning */
723  double xx3 = DBL_MAX; /* Fix (false) uninit warning */
724 
725  double resx = DBL_MAX;
726  double res = DBL_MAX;
727  cpl_boolean is_first = CPL_TRUE;
728 
729  cpl_boolean dbl2;
730 
731 
732  assert(px1 != NULL );
733 
734  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
735  if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
736 
737  dbl2 = CPL_FALSE;
738 
739  /*
740  All branches (for which the roots are defined) are evaluated, and
741  the branch with the smallest maximum-residual is chosen.
742  When two maximum-residual are identical, preference is given to
743  the purely real solution and if necessary to the solution with a
744  double root.
745  */
746 
747  if ((R2 >= Q3 && R != 0.0) || R2 > Q3) {
748 
749  cpl_boolean is_c = CPL_FALSE;
750 
751  irplib_polynomial_solve_1d_3c(a, c, Q, Q3, R, R2, &x1, &x2, &x3,
752  &is_c, &dbl2);
753 
754 
755  res = resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, is_c,
756  x1, x2, x3);
757 
758  is_first = CPL_FALSE;
759 
760  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
761  if (!is_c && pdbl2 != NULL) *pdbl2 = dbl2;
762  is_complex = is_c;
763  irplib_trace(); /* OK */
764 
765  }
766 
767  if (Q > 0.0 && fabs(R / (Q * sqrt(Q))) <= 1.0) {
768 
769  /* this test is actually R2 < Q3, written in a form suitable
770  for exact computation with integers */
771 
772  /* assert( Q > 0.0 ); */
773 
774  irplib_polynomial_solve_1d_3r(a, c, Q, R, &xx1, &xx2, &xx3);
775 
776  resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
777  xx1, xx2, xx3);
778 
779  if (is_first || (dbl2 ? resx < res : resx <= res)) {
780  is_first = CPL_FALSE;
781  res = resx;
782  x1 = xx1;
783  x2 = xx2;
784  x3 = xx3;
785  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
786  if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
787  is_complex = CPL_FALSE;
788  irplib_trace(); /* OK */
789  }
790  }
791 
792  if (Q >= 0) {
793  cpl_boolean dbl1 = CPL_FALSE;
794 
795 
796  irplib_polynomial_solve_1d_32(a, c, Q, &xx1, &xx2, &xx3, &dbl2);
797 
798  resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
799  xx1, xx2, xx3);
800  /*
801  cpl_msg_info(cpl_func, "%d: %g = %g - %g (%u)", __LINE__,
802  res - resx, res, resx, is_complex);
803  */
804 
805  if (is_first || resx <= res) {
806  is_first = CPL_FALSE;
807  res = resx;
808  x1 = xx1;
809  x2 = xx2;
810  x3 = xx3;
811  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
812  if (pdbl2 != NULL) *pdbl2 = dbl2;
813  is_complex = CPL_FALSE;
814  irplib_trace(); /* OK */
815  }
816 
817 
818  /* This branch also covers the case where the depressed cubic
819  polynomial has zero as triple root (i.e. Q == R == 0) */
820 
821  irplib_polynomial_solve_1d_31(a, Q, &xx1, &xx2, &xx3, &dbl1);
822 
823  resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
824  xx1, xx2, xx3);
825 
826  if (resx <= res) {
827  is_first = CPL_FALSE;
828  res = resx;
829  x1 = xx1;
830  x2 = xx2;
831  x3 = xx3;
832  if (pdbl1 != NULL) *pdbl1 = dbl1;
833  if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
834  is_complex = CPL_FALSE;
835  irplib_trace(); /* OK */
836  }
837 
838  }
839 
840  if (px2 != NULL && px3 != NULL) {
841  *px1 = x1;
842  *px2 = x2;
843  *px3 = x3;
844  irplib_trace(); /* OK */
845  } else if (is_complex) {
846  *px1 = x1;
847  irplib_trace(); /* OK */
848  } else {
849  *px1 = x3;
850  irplib_trace(); /* OK */
851  }
852 
853  return is_complex;
854 }
855 
856 /*----------------------------------------------------------------------------*/
870 /*----------------------------------------------------------------------------*/
871 static void irplib_polynomial_solve_1d_31(double a, double Q,
872  double * px1, double * px2,
873  double * px3, cpl_boolean * pdbl1)
874 {
875 
876  const double sqrtQ = sqrt (Q);
877 
878  double x1, x2, x3;
879 
880  x2 = x1 = -sqrtQ - a / 3.0;
881  x3 = 2.0 * sqrtQ - a / 3.0;
882  if (pdbl1 != NULL) *pdbl1 = CPL_TRUE;
883 
884  *px1 = x1;
885  *px2 = x2;
886  *px3 = x3;
887 
888  irplib_trace(); /* OK */
889  return;
890 }
891 
892 /*----------------------------------------------------------------------------*/
907 /*----------------------------------------------------------------------------*/
908 static void irplib_polynomial_solve_1d_32(double a, double c, double Q,
909  double * px1, double * px2,
910  double * px3, cpl_boolean * pdbl2)
911 {
912 
913  const double sqrtQ = sqrt (Q);
914 
915  double x1 = DBL_MAX;
916  double x2 = DBL_MAX;
917  double x3 = DBL_MAX;
918 
919  if (a > 0.0) {
920  /* a and sqrt(Q) have same sign - or Q is zero */
921  x1 = -2.0 * sqrtQ - a / 3.0;
922  /* FIXME: Two small roots with opposite signs may
923  end up here, with the sign lost for one of them */
924  x3 = x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
925  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
926  irplib_trace(); /* OK */
927  } else if (a < 0.0) {
928  /* a and sqrt(Q) have opposite signs - or Q is zero */
929  x3 = x2 = sqrtQ - a / 3.0;
930  x1 = -c / (x2 * x2);
931  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
932  irplib_trace(); /* OK */
933  } else {
934  x1 = -2.0 * sqrtQ;
935  x3 = x2 = sqrtQ;
936  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
937  irplib_trace(); /* OK */
938  }
939 
940  *px1 = x1;
941  *px2 = x2;
942  *px3 = x3;
943 
944  return;
945 }
946 
947 /*----------------------------------------------------------------------------*/
967 /*----------------------------------------------------------------------------*/
968 static void irplib_polynomial_solve_1d_3c(double a, double c,
969  double Q, double Q3,
970  double R, double R2,
971  double * px1,
972  double * px2, double * px3,
973  cpl_boolean * pis_c,
974  cpl_boolean * pdbl2)
975 {
976 
977  /* Due to finite precision some double roots may be missed, and
978  will be considered to be a pair of complex roots z = x +/-
979  epsilon i close to the real axis. */
980 
981  /* Another case: A double root, which is small relative to the
982  last root, may cause this branch to be taken - with the
983  imaginary part eventually being truncated to zero. */
984 
985  const double sgnR = (R >= 0 ? 1.0 : -1.0);
986  const double A = -sgnR * pow (fabs (R) + sqrt (R2 - Q3), 1.0 / 3.0);
987  const double B = Q / A;
988 
989  double x1 = DBL_MAX;
990  double x2 = DBL_MAX;
991  double x3 = DBL_MAX;
992  cpl_boolean is_complex = CPL_FALSE;
993 
994  if (( A > -B && a > 0.0) || (A < -B && a < 0.0)) {
995  /* A+B has same sign as a */
996 
997  /* Real part of complex conjugate */
998  x2 = -0.5 * (A + B) - a / 3.0; /* No cancellation */
999  /* Positive, imaginary part of complex conjugate */
1000  x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
1001 
1002  x1 = -c / (x2 * x2 + x3 * x3);
1003  irplib_trace(); /* OK */
1004  } else {
1005  /* A+B and a have opposite signs - or exactly one is zero */
1006  x1 = A + B - a / 3.0;
1007  /* Positive, imaginary part of complex conjugate */
1008  x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
1009 
1010  if (x3 > 0.0) {
1011  /* Real part of complex conjugate */
1012  x2 = -0.5 * (A + B) - a / 3.0; /* FIXME: Cancellation */
1013  irplib_trace(); /* OK */
1014  } else {
1015 
1016  x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
1017  x3 = 0.0;
1018  irplib_trace(); /* OK */
1019  }
1020  }
1021 
1022  if (x3 > 0.0) {
1023  is_complex = CPL_TRUE;
1024  irplib_trace(); /* OK */
1025  } else {
1026  /* Whoaa, the imaginary part was truncated to zero
1027  - return a real, double root */
1028  x3 = x2;
1029  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
1030  irplib_trace(); /* OK */
1031  }
1032 
1033  *px1 = x1;
1034  *px2 = x2;
1035  *px3 = x3;
1036  *pis_c = is_complex;
1037 
1038  return;
1039 }
1040 
1041 /*----------------------------------------------------------------------------*/
1056 /*----------------------------------------------------------------------------*/
1057 static void irplib_polynomial_solve_1d_3r(double a, double c,
1058  double Q, double R,
1059  double * px1,
1060  double * px2, double * px3)
1061 {
1062 
1063  const double sqrtQ = sqrt(Q);
1064  const double theta = acos (R / (Q * sqrtQ)); /* theta in range [0; pi] */
1065 
1066  /* -1.0 <= cos((theta + CPL_MATH_2PI) / 3.0) <= -0.5
1067  -0.5 <= cos((theta - CPL_MATH_2PI) / 3.0) <= 0.5
1068  0.5 <= cos((theta ) / 3.0) <= 1.0 */
1069 
1070 #define TR1 (-2.0 * sqrtQ * cos( theta / 3.0))
1071 #define TR2 (-2.0 * sqrtQ * cos((theta - CPL_MATH_2PI) / 3.0))
1072 #define TR3 (-2.0 * sqrtQ * cos((theta + CPL_MATH_2PI) / 3.0))
1073 
1074  /* TR1 < TR2 < TR3, except when theta == 0, then TR2 == TR3 */
1075 
1076  /* The three roots must be transformed back via subtraction with a/3.
1077  To prevent loss of precision due to cancellation, the root which
1078  is closest to a/3 is computed using the relation
1079  p3 * x1 * x2 * x3 = -p0 */
1080 
1081  double x1 = DBL_MAX;
1082  double x2 = DBL_MAX;
1083  double x3 = DBL_MAX;
1084 
1085  if (a > 0.0) {
1086  x1 = TR1 - a / 3.0;
1087  if (TR2 > 0.0 && (TR2 + TR3) > 2.0 * a) {
1088  /* FIXME: Cancellation may still effect x3 ? */
1089  x3 = TR3 - a / 3.0;
1090  x2 = -c / ( x1 * x3 );
1091  irplib_trace(); /* OK */
1092  } else {
1093  /* FIXME: Cancellation may still effect x2, especially
1094  if x2, x3 is (almost) a double root, i.e.
1095  if theta is close to zero. */
1096  x2 = TR2 - a / 3.0;
1097 
1098  x3 = -c / ( x1 * x2 );
1099  irplib_trace(); /* OK */
1100  }
1101  } else if (a < 0.0) {
1102  x3 = TR3 - a / 3.0;
1103  if (TR2 < 0.0 && (TR1 + TR2) > 2.0 * a) {
1104  x1 = TR1 - a / 3.0;
1105  x2 = -c / ( x1 * x3 );
1106  irplib_trace(); /* OK */
1107  } else {
1108  x2 = TR2 - a / 3.0;
1109  x1 = -c / ( x2 * x3 );
1110  irplib_trace(); /* OK */
1111  }
1112  } else {
1113  x1 = TR1;
1114  x2 = TR2;
1115  x3 = TR3;
1116  irplib_trace(); /* OK */
1117  }
1118 
1119  assert(x1 < x3);
1120 
1121  if (x1 > x2) {
1122  /* In absence of round-off:
1123  theta == PI: x1 == x2,
1124  theta < PI: x1 < x2,
1125 
1126  The only way x1 could exceed x2 would be due to round-off when
1127  theta is close to PI */
1128 
1129  x1 = x2 = 0.5 * ( x1 + x2 );
1130  irplib_trace(); /* OK, tested only for x1 == x2 */
1131  } else if (x2 > x3) {
1132  /* In absence of round-off:
1133  theta == 0: x2 == x3,
1134  theta > 0: x2 < x3,
1135 
1136  For small theta:
1137  Round-off can cause x2 to become greater than x3 */
1138 
1139  x3 = x2 = 0.5 * ( x2 + x3 );
1140  irplib_trace(); /* OK */
1141  }
1142 
1143  *px1 = x1;
1144  *px2 = x2;
1145  *px3 = x3;
1146 
1147  return;
1148 }
1149 
1150 /*----------------------------------------------------------------------------*/
1168 /*----------------------------------------------------------------------------*/
1169 static cpl_error_code irplib_polynomial_solve_1d_4(double p4, double p3,
1170  double p2, double p1,
1171  double p0, cpl_size * preal,
1172  double * px1, double * px2,
1173  double * px3, double * px4)
1174 {
1175 
1176  /* Construct the monic, depressed quartic using Horners scheme on 1 / p4 */
1177  const double a = (p2 - 0.375 * p3 * p3 / p4) / p4;
1178  const double b = (p1 - 0.5 * (p2 - 0.25 * p3 * p3 / p4 ) * p3 / p4 ) / p4;
1179  const double c =
1180  (p0 - 0.25 * (p1 - 0.25 * (p2 - 0.1875 * p3 * p3 / p4 ) * p3 / p4
1181  ) * p3 / p4 ) / p4;
1182 
1183  double x1 = DBL_MAX; /* Fix (false) uninit warning */
1184  double x2 = DBL_MAX; /* Fix (false) uninit warning */
1185  double x3 = DBL_MAX; /* Fix (false) uninit warning */
1186  double x4 = DBL_MAX; /* Fix (false) uninit warning */
1187 
1188  assert(preal != NULL );
1189  assert(px1 != NULL );
1190  assert(px2 != NULL );
1191  assert(px3 != NULL );
1192  assert(px4 != NULL );
1193 
1194  *preal = 4;
1195 
1196  if (c == 0.0) {
1197  /* The depressed quartic has zero as root */
1198  /* Since the sum of the roots is zero, at least one is negative
1199  and at least one is positive - unless they are all zero */
1200  cpl_boolean dbl1, dbl2;
1201  const cpl_boolean is_real =
1202  !irplib_polynomial_solve_1d_3(1.0, 0.0, a, b, &x1, &x3, &x4,
1203  &dbl1, &dbl2);
1204 
1205  x1 -= 0.25 * p3 / p4;
1206  x2 = -0.25 * p3 / p4;
1207  x3 -= 0.25 * p3 / p4;
1208  if (is_real) {
1209 
1210  if (dbl2) {
1211  x4 = x3;
1212  assert( x1 <= x2);
1213  assert( x2 <= x3);
1214  } else {
1215  x4 -= 0.25 * p3 / p4;
1216  /* Need (only) a guarded swap of x2, x3 */
1217  if (x2 > x3) {
1218  IRPLIB_SWAP(x2, x3);
1219  }
1220  if (dbl1) {
1221  assert( x1 <= x2); /* The cubic may have 0 as triple root */
1222  assert( x2 <= x3);
1223  assert( x2 <= x4);
1224  } else {
1225  assert( x1 < x2);
1226  assert( x2 < x4);
1227  }
1228  }
1229  } else {
1230  *preal = 2;
1231 
1232  if (x1 > x2) {
1233  assert( x3 <= x2 ); /* Don't swap a complex root */
1234 
1235  IRPLIB_SWAP(x1, x2);
1236  } else {
1237  assert( x3 >= x2 );
1238  }
1239  }
1240 
1241  } else if (b == 0.0) {
1242  /* The monic, depressed quartic is a monic, biquadratic equation */
1243  double u1, u2;
1244  const cpl_boolean is_complex = irplib_polynomial_solve_1d_2(1.0, a, c,
1245  &u1, &u2);
1246 
1247  if (is_complex) {
1248  /* All four roots are conjugate, complex */
1249  const double norm = sqrt(u1*u1 + u2*u2);
1250  const double v1 = sqrt(0.5*(norm+u1));
1251  const double v2 = u2 / sqrt(2.0*(norm+u1));
1252 
1253 
1254  x1 = -0.25 * p3 / p4 - v1;
1255  x3 = -0.25 * p3 / p4 + v1;
1256 
1257  x4 = x2 = v2;
1258 
1259  *preal = 0;
1260 
1261  } else if (u1 >= 0.0) {
1262  /* All four roots are real */
1263  const double sv1 = sqrt(u1);
1264  const double sv2 = sqrt(u2);
1265 
1266 
1267  *preal = 4;
1268 
1269  x1 = -0.25 * p3 / p4 - sv2;
1270  x2 = -0.25 * p3 / p4 - sv1;
1271  x3 = -0.25 * p3 / p4 + sv1;
1272  x4 = -0.25 * p3 / p4 + sv2;
1273  } else if (u2 < 0.0) {
1274  /* All four roots are conjugate, complex */
1275  const double sv1 = sqrt(-u2);
1276  const double sv2 = sqrt(-u1);
1277 
1278 
1279  *preal = 0;
1280 
1281  x1 = x3 = -0.25 * p3 / p4;
1282 
1283  x2 = sv1;
1284  x4 = sv2;
1285  } else {
1286  /* Two roots are real, two roots are conjugate, complex */
1287  const double sv1 = sqrt(-u1);
1288  const double sv2 = sqrt(u2);
1289 
1290 
1291  *preal = 2;
1292 
1293  x1 = -0.25 * p3 / p4 - sv2;
1294  x2 = -0.25 * p3 / p4 + sv2;
1295 
1296  x3 = -0.25 * p3 / p4;
1297  x4 = sv1;
1298  }
1299  } else {
1300  /* Need a root from the nested, monic cubic */
1301  const double q2 = -a;
1302  const double q1 = -4.0 * c;
1303  const double q0 = 4.0 * a * c - b * b;
1304  double u1, sqrtd, sqrtrd;
1305  double z1, z2, z3, z4;
1306 
1307  cpl_boolean is_complex1, is_complex2;
1308 
1309  /* Largest cubic root ensures real square roots when solving the
1310  quartic equation */
1311  (void)irplib_polynomial_solve_1d_3(1.0, q2, q1, q0, &u1, NULL, NULL,
1312  NULL, NULL);
1313 
1314 
1315  assert( u1 > a );
1316 
1317  sqrtd = sqrt(u1 - a);
1318 
1319  sqrtrd = 0.5 * b/sqrtd;
1320 
1321  is_complex1 = irplib_polynomial_solve_1d_2(1.0, sqrtd, 0.5*u1 - sqrtrd,
1322  &z1, &z2);
1323 
1324  is_complex2 = irplib_polynomial_solve_1d_2(1.0, -sqrtd, 0.5*u1 + sqrtrd,
1325  &z3, &z4);
1326 
1327  z1 -= 0.25 * p3 / p4;
1328  z3 -= 0.25 * p3 / p4;
1329  if (!is_complex1) z2 -= 0.25 * p3 / p4;
1330  if (!is_complex2) z4 -= 0.25 * p3 / p4;
1331 
1332  if (!is_complex1 && is_complex2) {
1333  *preal = 2;
1334  x1 = z1;
1335  x2 = z2;
1336  x3 = z3;
1337  x4 = z4;
1338  } else if (is_complex1 && !is_complex2) {
1339  *preal = 2;
1340  x1 = z3;
1341  x2 = z4;
1342  x3 = z1;
1343  x4 = z2;
1344  } else if (is_complex1 && is_complex2) {
1345  *preal = 0;
1346 
1347  if (z1 < z3 || (z1 == z3 && z2 <= z4)) {
1348  x1 = z1;
1349  x2 = z2;
1350  x3 = z3;
1351  x4 = z4;
1352  } else {
1353  x1 = z3;
1354  x2 = z4;
1355  x3 = z1;
1356  x4 = z2;
1357  }
1358  } else {
1359  *preal = 4;
1360 
1361  if (z3 >= z2) {
1362  x1 = z1;
1363  x2 = z2;
1364  x3 = z3;
1365  x4 = z4;
1366  } else if (z4 <= z1) {
1367  x1 = z3;
1368  x2 = z4;
1369  x3 = z1;
1370  x4 = z2;
1371  } else if (z2 > z4) {
1372  x1 = z3;
1373  x2 = z1;
1374  x3 = z4;
1375  x4 = z2;
1376  } else {
1377  x1 = z1;
1378  x2 = z3;
1379  x3 = z2;
1380  x4 = z4;
1381  }
1382  }
1383  }
1384 
1385  *px1 = x1;
1386  *px2 = x2;
1387  *px3 = x3;
1388  *px4 = x4;
1389 
1390  return CPL_ERROR_NONE;
1391 }
1392 
1393 #ifdef IPRLIB_POLYNOMIAL_USE_MONOMIAL_ROOT
1394 /*----------------------------------------------------------------------------*/
1402 /*----------------------------------------------------------------------------*/
1403 static double irplib_polynomial_depress_1d(cpl_polynomial * self)
1404 {
1405 
1406  const cpl_size degree = cpl_polynomial_get_degree(self);
1407  const cpl_size nc1 = degree - 1;
1408  const double an = cpl_polynomial_get_coeff(self, &degree);
1409  const double an1 = cpl_polynomial_get_coeff(self, &nc1);
1410  double rmean;
1411  cpl_size i;
1412 
1413 
1414  cpl_ensure(degree > 0, CPL_ERROR_DATA_NOT_FOUND, 0.0);
1415 
1416  assert( an != 0.0 );
1417 
1418  rmean = -an1/(an * (double)degree);
1419 
1420  if (rmean != 0.0) {
1421 
1422  cpl_polynomial_shift_1d(self, 0, rmean);
1423 
1424  cpl_polynomial_set_coeff(self, &nc1, 0.0); /* Round-off... */
1425 
1426  }
1427 
1428  /* Set leading coefficient to one. */
1429  for (i = 0; i < degree-1; i++) {
1430  const double ai = cpl_polynomial_get_coeff(self, &i) / an;
1431  cpl_polynomial_set_coeff(self, &i, ai);
1432  }
1433 
1434  cpl_polynomial_set_coeff(self, &degree, 1.0); /* Round-off... */
1435 
1436  return rmean;
1437 }
1438 #endif
1439 
1440 /*----------------------------------------------------------------------------*/
1455 /*----------------------------------------------------------------------------*/
1456 static
1457 cpl_error_code irplib_polynomial_divide_1d_root(cpl_polynomial * p, double r,
1458  double * pres)
1459 {
1460 
1461  const cpl_size n = cpl_polynomial_get_degree(p);
1462  double sum;
1463  cpl_size i;
1464 
1465 
1466  cpl_ensure_code(p != NULL, CPL_ERROR_NULL_INPUT);
1467  cpl_ensure_code(cpl_polynomial_get_dimension(p) == 1,
1468  CPL_ERROR_INVALID_TYPE);
1469  cpl_ensure_code(n > 0, CPL_ERROR_DATA_NOT_FOUND);
1470 
1471  sum = cpl_polynomial_get_coeff(p, &n);
1472  cpl_polynomial_set_coeff(p, &n, 0.0);
1473 
1474  for (i = n-1; i >= 0; i--) {
1475  const double coeff = cpl_polynomial_get_coeff(p, &i);
1476 
1477  cpl_polynomial_set_coeff(p, &i, sum);
1478 
1479  sum = coeff + r * sum;
1480 
1481  }
1482 
1483  if (pres != NULL) *pres = sum;
1484 
1485  return CPL_ERROR_NONE;
1486 }