NACO Pipeline Reference Manual  4.4.0
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: not supported by cvs2svn $
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 /*----------------------------------------------------------------------------*/
141 /*----------------------------------------------------------------------------*/
142 cpl_error_code irplib_polynomial_solve_1d_all(const cpl_polynomial * self,
143  cpl_vector * roots,
144  cpl_size * preal)
145 {
146 
147  cpl_error_code error = CPL_ERROR_NONE;
148  cpl_polynomial * p;
149 
150  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
151  cpl_ensure_code(roots != NULL, CPL_ERROR_NULL_INPUT);
152  cpl_ensure_code(preal != NULL, CPL_ERROR_NULL_INPUT);
153  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
154  CPL_ERROR_INVALID_TYPE);
155  cpl_ensure_code(cpl_polynomial_get_degree(self) > 0,
156  CPL_ERROR_DATA_NOT_FOUND);
157  cpl_ensure_code(cpl_polynomial_get_degree(self) ==
158  cpl_vector_get_size(roots), CPL_ERROR_INCOMPATIBLE_INPUT);
159 
160  *preal = 0;
161 
162  p = cpl_polynomial_duplicate(self);
163 
164  error = irplib_polynomial_solve_1d_nonzero(p, roots, preal);
165 
166  cpl_polynomial_delete(p);
167 
168  return error;
169 
170 }
171 
174 /*----------------------------------------------------------------------------*/
201 /*----------------------------------------------------------------------------*/
202 static cpl_error_code irplib_polynomial_solve_1d_nonzero(cpl_polynomial * self,
203  cpl_vector * roots,
204  cpl_size * preal)
205 {
206  cpl_error_code error = CPL_ERROR_NONE;
207  const cpl_size ncoeffs = 1 + cpl_polynomial_get_degree(self);
208 
209  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
210  cpl_ensure_code(roots != NULL, CPL_ERROR_NULL_INPUT);
211  cpl_ensure_code(preal != NULL, CPL_ERROR_NULL_INPUT);
212  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
213  CPL_ERROR_INVALID_TYPE);
214  cpl_ensure_code(ncoeffs > 1, CPL_ERROR_DATA_NOT_FOUND);
215  cpl_ensure_code(*preal >= 0, CPL_ERROR_ILLEGAL_INPUT);
216  cpl_ensure_code(ncoeffs + *preal == 1+cpl_vector_get_size(roots),
217  CPL_ERROR_INCOMPATIBLE_INPUT);
218 
219  switch (ncoeffs) {
220 
221  case 2 : {
222  const cpl_size i1 = 1;
223  const cpl_size i0 = 0;
224  const double p1 = cpl_polynomial_get_coeff(self, &i1);
225  const double p0 = cpl_polynomial_get_coeff(self, &i0);
226 
227  cpl_vector_set(roots, (*preal)++, -p0/p1);
228  break;
229  }
230  case 3 : {
231  const cpl_size i2 = 2;
232  const cpl_size i1 = 1;
233  const cpl_size i0 = 0;
234  const double p2 = cpl_polynomial_get_coeff(self, &i2);
235  const double p1 = cpl_polynomial_get_coeff(self, &i1);
236  const double p0 = cpl_polynomial_get_coeff(self, &i0);
237  double x1, x2;
238 
239  if (irplib_polynomial_solve_1d_2(p2, p1, p0, &x1, &x2)) {
240  /* This is the complex root in the upper imaginary half-plane */
241  cpl_vector_set(roots, (*preal) , x1);
242  cpl_vector_set(roots, (*preal)+1, x2);
243  } else {
244  cpl_vector_set(roots, (*preal)++, x1);
245  cpl_vector_set(roots, (*preal)++, x2);
246  }
247  break;
248  }
249  case 4 : {
250  const cpl_size i3 = 3;
251  const cpl_size i2 = 2;
252  const cpl_size i1 = 1;
253  const cpl_size i0 = 0;
254  const double p3 = cpl_polynomial_get_coeff(self, &i3);
255  const double p2 = cpl_polynomial_get_coeff(self, &i2);
256  const double p1 = cpl_polynomial_get_coeff(self, &i1);
257  const double p0 = cpl_polynomial_get_coeff(self, &i0);
258  double x1, x2, x3;
259 
260  if (irplib_polynomial_solve_1d_3(p3, p2, p1, p0, &x1, &x2, &x3,
261  NULL, NULL)) {
262  cpl_vector_set(roots, (*preal)++, x1);
263  /* This is the complex root in the upper imaginary half-plane */
264  cpl_vector_set(roots, (*preal) , x2);
265  cpl_vector_set(roots, (*preal)+1, x3);
266  } else {
267  cpl_vector_set(roots, (*preal)++, x1);
268  cpl_vector_set(roots, (*preal)++, x2);
269  cpl_vector_set(roots, (*preal)++, x3);
270  }
271  break;
272  }
273  case 5 : {
274  const cpl_size i4 = 4;
275  const cpl_size i3 = 3;
276  const cpl_size i2 = 2;
277  const cpl_size i1 = 1;
278  const cpl_size i0 = 0;
279  const double p4 = cpl_polynomial_get_coeff(self, &i4);
280  const double p3 = cpl_polynomial_get_coeff(self, &i3);
281  const double p2 = cpl_polynomial_get_coeff(self, &i2);
282  const double p1 = cpl_polynomial_get_coeff(self, &i1);
283  const double p0 = cpl_polynomial_get_coeff(self, &i0);
284  double x1, x2, x3, x4;
285  cpl_size nreal;
286 
287  error = irplib_polynomial_solve_1d_4(p4, p3, p2, p1, p0, &nreal,
288  &x1, &x2, &x3, &x4);
289  if (!error) {
290  cpl_vector_set(roots, (*preal) , x1);
291  cpl_vector_set(roots, (*preal)+1, x2);
292  cpl_vector_set(roots, (*preal)+2, x3);
293  cpl_vector_set(roots, (*preal)+3, x4);
294 
295  *preal += nreal;
296  }
297  break;
298  }
299 
300  default: {
301 
302  /* Try to reduce the problem by finding a single root */
303 #ifndef IPRLIB_POLYNOMIAL_USE_MONOMIAL_ROOT
304  const cpl_size n0 = ncoeffs-1;
305  const double pn0 = cpl_polynomial_get_coeff(self, &n0);
306  const cpl_size n1 = ncoeffs-2;
307  const double pn1 = cpl_polynomial_get_coeff(self, &n1);
308  /* First guess of root is the root average.
309  FIXME: May need refinement, e.g. via bisection */
310  const double rmean = -pn1 / (pn0 * n0);
311  double root = rmean;
312 #else
313  /* Try an analytical solution to a (shifted) monomial */
314  cpl_polynomial * copy = cpl_polynomial_duplicate(self);
315  const cpl_size i0 = 0;
316  const double rmean = irplib_polynomial_depress_1d(copy);
317  const double c0 = cpl_polynomial_get_coeff(copy, &i0);
318  double root = rmean + ((n0&1) && c0 < 0.0 ? -1.0 : 1.0)
319  * pow(fabs(c0), 1.0/n0);
320 
321  cpl_polynomial_delete(copy);
322 #endif
323 
324  error = cpl_polynomial_solve_1d(self, root, &root, 1);
325 
326  if (!error) {
327 
328  cpl_vector_set(roots, (*preal)++, root);
329 
330  irplib_polynomial_divide_1d_root(self, root, NULL);
331 
332  error = irplib_polynomial_solve_1d_nonzero(self, roots, preal);
333 
334  if (!error && *preal > 1) {
335  /* Sort the real roots */
336 
337  /* FIXME: Assumes that all roots found so far are real */
338 
339  cpl_vector * reals = cpl_vector_wrap(*preal,
340  cpl_vector_get_data(roots));
341  cpl_vector_sort(reals, 1);
342  (void)cpl_vector_unwrap(reals);
343  }
344  }
345  break;
346  }
347  }
348 
349  return error;
350 }
351 
352 /*----------------------------------------------------------------------------*/
364 /*----------------------------------------------------------------------------*/
365 static cpl_boolean irplib_polynomial_solve_1d_2(double p2, double p1, double p0,
366  double * px1,
367  double * px2) {
368 
369  const double sqrtD = sqrt(fabs(p1 * p1 - 4.0 * p2 * p0));
370  cpl_boolean is_complex = CPL_FALSE;
371  double x1 = -0.5 * p1 / p2; /* Double root */
372  double x2;
373 
374  /* Compute residual, assuming D == 0 */
375  double res0 = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x1);
376  double res;
377 
378  assert(px1 != NULL );
379  assert(px2 != NULL );
380 
381  *px2 = *px1 = x1;
382 
383  /* Compute residual, assuming D > 0 */
384 
385  /* x1 is the root with largest absolute value */
386  if (p1 > 0.0) {
387  x1 = -0.5 * (p1 + sqrtD);
388  irplib_trace(); /* OK */
389  } else {
390  x1 = -0.5 * (p1 - sqrtD);
391  irplib_trace(); /* OK */
392  }
393  /* Compute smaller root via division to avoid
394  loss of precision due to cancellation */
395  x2 = p0 / x1;
396  x1 /= p2; /* Scale x1 with leading coefficient */
397 
398  res = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x2);
399 
400  if (res < res0) {
401  res0 = res;
402  if (x2 > x1) {
403  *px1 = x1;
404  *px2 = x2;
405  irplib_trace(); /* OK */
406  } else {
407  *px1 = x2;
408  *px2 = x1;
409  irplib_trace(); /* OK */
410  }
411  }
412 
413  /* Compute residual, assuming D < 0 */
414 
415  x1 = -0.5 * p1 / p2; /* Real part of complex root */
416  x2 = 0.5 * sqrtD / fabs(p2); /* Positive, imaginary part of root */
417 
418  res = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_TRUE, x1, x2);
419 
420  if (res < res0) {
421  *px1 = x1;
422  *px2 = x2;
423  is_complex = CPL_TRUE;
424  irplib_trace(); /* OK */
425  }
426 
427  return is_complex;
428 
429 }
430 
431 
432 /*----------------------------------------------------------------------------*/
445 /*----------------------------------------------------------------------------*/
446 static double irplib_polynomial_eval_2_max(double p2, double p1, double p0,
447  cpl_boolean is_c,
448  double x1, double x2)
449 {
450  double res;
451 
452  if (is_c) {
453  res = fabs(p0 + x1 * (p1 + x1 * p2) - p2 * x2 * x2);
454  irplib_trace(); /* OK */
455  } else {
456  const double r1 = fabs(p0 + x1 * (p1 + x1 * p2));
457  const double r2 = fabs(p0 + x2 * (p1 + x2 * p2));
458 
459  res = r1 > r2 ? r1 : r2;
460  irplib_trace(); /* OK */
461  }
462 
463  return res;
464 }
465 
466 
467 /*----------------------------------------------------------------------------*/
482 /*----------------------------------------------------------------------------*/
483 static double irplib_polynomial_eval_3_max(double p3, double p2,
484  double p1, double p0,
485  cpl_boolean is_c,
486  double x1, double x2, double x3)
487 {
488  const double r1 = fabs(p0 + x1 * (p1 + x1 * (p2 + x1 * p3)));
489  double res;
490 
491  if (is_c) {
492  const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3))
493  - x3 * x3 * ( 3.0 * p3 * x2 + p2));
494 
495  res = r1 > r2 ? r1 : r2;
496  irplib_trace(); /* OK */
497  } else {
498  const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3)));
499  const double r3 = fabs(p0 + x3 * (p1 + x3 * (p2 + x3 * p3)));
500  res = r1 > r2 ? (r1 > r3 ? r1 : r3) : (r2 > r3 ? r2 : r3);
501  irplib_trace(); /* OK */
502  }
503 
504  /* cpl_msg_info(cpl_func, "%d: %g (%g)", __LINE__, res, r1); */
505 
506  return res;
507 }
508 
509 
510 /*----------------------------------------------------------------------------*/
529 /*----------------------------------------------------------------------------*/
530 static cpl_boolean irplib_polynomial_solve_1d_3(double p3, double p2, double p1,
531  double p0,
532  double * px1,
533  double * px2,
534  double * px3,
535  cpl_boolean * pdbl1,
536  cpl_boolean * pdbl2) {
537  cpl_boolean is_complex = CPL_FALSE;
538  const double a = p2/p3;
539  const double b = p1/p3;
540  const double c = p0/p3;
541 
542  const double q = (a * a - 3.0 * b);
543  const double r = (a * (2.0 * a * a - 9.0 * b) + 27.0 * c);
544 
545  const double Q = q / 9.0;
546  const double R = r / 54.0;
547 
548  const double Q3 = Q * Q * Q;
549  const double R2 = R * R;
550 
551  double x1 = DBL_MAX; /* Fix (false) uninit warning */
552  double x2 = DBL_MAX; /* Fix (false) uninit warning */
553  double x3 = DBL_MAX; /* Fix (false) uninit warning */
554  double xx1 = DBL_MAX; /* Fix (false) uninit warning */
555  double xx2 = DBL_MAX; /* Fix (false) uninit warning */
556  double xx3 = DBL_MAX; /* Fix (false) uninit warning */
557 
558  double resx = DBL_MAX;
559  double res = DBL_MAX;
560  cpl_boolean is_first = CPL_TRUE;
561 
562  cpl_boolean dbl2;
563 
564 
565  assert(px1 != NULL );
566 
567  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
568  if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
569 
570  dbl2 = CPL_FALSE;
571 
572  /*
573  All branches (for which the roots are defined) are evaluated, and
574  the branch with the smallest maximum-residual is chosen.
575  When two maximum-residual are identical, preference is given to
576  the purely real solution and if necessary to the solution with a
577  double root.
578  */
579 
580  if ((R2 >= Q3 && R != 0.0) || R2 > Q3) {
581 
582  cpl_boolean is_c = CPL_FALSE;
583 
584  irplib_polynomial_solve_1d_3c(a, c, Q, Q3, R, R2, &x1, &x2, &x3,
585  &is_c, &dbl2);
586 
587 
588  res = resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, is_c,
589  x1, x2, x3);
590 
591  is_first = CPL_FALSE;
592 
593  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
594  if (!is_c && pdbl2 != NULL) *pdbl2 = dbl2;
595  is_complex = is_c;
596  irplib_trace(); /* OK */
597 
598  }
599 
600  if (Q > 0.0 && fabs(R / (Q * sqrt(Q))) <= 1.0) {
601 
602  /* this test is actually R2 < Q3, written in a form suitable
603  for exact computation with integers */
604 
605  /* assert( Q > 0.0 ); */
606 
607  irplib_polynomial_solve_1d_3r(a, c, Q, R, &xx1, &xx2, &xx3);
608 
609  resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
610  xx1, xx2, xx3);
611 
612  if (is_first || (dbl2 ? resx < res : resx <= res)) {
613  is_first = CPL_FALSE;
614  res = resx;
615  x1 = xx1;
616  x2 = xx2;
617  x3 = xx3;
618  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
619  if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
620  is_complex = CPL_FALSE;
621  irplib_trace(); /* OK */
622  }
623  }
624 
625  if (Q >= 0) {
626  cpl_boolean dbl1 = CPL_FALSE;
627 
628 
629  irplib_polynomial_solve_1d_32(a, c, Q, &xx1, &xx2, &xx3, &dbl2);
630 
631  resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
632  xx1, xx2, xx3);
633  /*
634  cpl_msg_info(cpl_func, "%d: %g = %g - %g (%u)", __LINE__,
635  res - resx, res, resx, is_complex);
636  */
637 
638  if (is_first || resx <= res) {
639  is_first = CPL_FALSE;
640  res = resx;
641  x1 = xx1;
642  x2 = xx2;
643  x3 = xx3;
644  if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
645  if (pdbl2 != NULL) *pdbl2 = dbl2;
646  is_complex = CPL_FALSE;
647  irplib_trace(); /* OK */
648  }
649 
650 
651  /* This branch also covers the case where the depressed cubic
652  polynomial has zero as triple root (i.e. Q == R == 0) */
653 
654  irplib_polynomial_solve_1d_31(a, Q, &xx1, &xx2, &xx3, &dbl1);
655 
656  resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
657  xx1, xx2, xx3);
658 
659  if (resx <= res) {
660  is_first = CPL_FALSE;
661  res = resx;
662  x1 = xx1;
663  x2 = xx2;
664  x3 = xx3;
665  if (pdbl1 != NULL) *pdbl1 = dbl1;
666  if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
667  is_complex = CPL_FALSE;
668  irplib_trace(); /* OK */
669  }
670 
671  }
672 
673  if (px2 != NULL && px3 != NULL) {
674  *px1 = x1;
675  *px2 = x2;
676  *px3 = x3;
677  irplib_trace(); /* OK */
678  } else if (is_complex) {
679  *px1 = x1;
680  irplib_trace(); /* OK */
681  } else {
682  *px1 = x3;
683  irplib_trace(); /* OK */
684  }
685 
686  return is_complex;
687 }
688 
689 /*----------------------------------------------------------------------------*/
703 /*----------------------------------------------------------------------------*/
704 static void irplib_polynomial_solve_1d_31(double a, double Q,
705  double * px1, double * px2,
706  double * px3, cpl_boolean * pdbl1)
707 {
708 
709  const double sqrtQ = sqrt (Q);
710 
711  double x1, x2, x3;
712 
713  x2 = x1 = -sqrtQ - a / 3.0;
714  x3 = 2.0 * sqrtQ - a / 3.0;
715  if (pdbl1 != NULL) *pdbl1 = CPL_TRUE;
716 
717  *px1 = x1;
718  *px2 = x2;
719  *px3 = x3;
720 
721  irplib_trace(); /* OK */
722  return;
723 }
724 
725 /*----------------------------------------------------------------------------*/
740 /*----------------------------------------------------------------------------*/
741 static void irplib_polynomial_solve_1d_32(double a, double c, double Q,
742  double * px1, double * px2,
743  double * px3, cpl_boolean * pdbl2)
744 {
745 
746  const double sqrtQ = sqrt (Q);
747 
748  double x1 = DBL_MAX;
749  double x2 = DBL_MAX;
750  double x3 = DBL_MAX;
751 
752  if (a > 0.0) {
753  /* a and sqrt(Q) have same sign - or Q is zero */
754  x1 = -2.0 * sqrtQ - a / 3.0;
755  /* FIXME: Two small roots with opposite signs may
756  end up here, with the sign lost for one of them */
757  x3 = x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
758  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
759  irplib_trace(); /* OK */
760  } else if (a < 0.0) {
761  /* a and sqrt(Q) have opposite signs - or Q is zero */
762  x3 = x2 = sqrtQ - a / 3.0;
763  x1 = -c / (x2 * x2);
764  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
765  irplib_trace(); /* OK */
766  } else {
767  x1 = -2.0 * sqrtQ;
768  x3 = x2 = sqrtQ;
769  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
770  irplib_trace(); /* OK */
771  }
772 
773  *px1 = x1;
774  *px2 = x2;
775  *px3 = x3;
776 
777  return;
778 }
779 
780 /*----------------------------------------------------------------------------*/
800 /*----------------------------------------------------------------------------*/
801 static void irplib_polynomial_solve_1d_3c(double a, double c,
802  double Q, double Q3,
803  double R, double R2,
804  double * px1,
805  double * px2, double * px3,
806  cpl_boolean * pis_c,
807  cpl_boolean * pdbl2)
808 {
809 
810  /* Due to finite precision some double roots may be missed, and
811  will be considered to be a pair of complex roots z = x +/-
812  epsilon i close to the real axis. */
813 
814  /* Another case: A double root, which is small relative to the
815  last root, may cause this branch to be taken - with the
816  imaginary part eventually being truncated to zero. */
817 
818  const double sgnR = (R >= 0 ? 1.0 : -1.0);
819  const double A = -sgnR * pow (fabs (R) + sqrt (R2 - Q3), 1.0 / 3.0);
820  const double B = Q / A;
821 
822  double x1 = DBL_MAX;
823  double x2 = DBL_MAX;
824  double x3 = DBL_MAX;
825  cpl_boolean is_complex = CPL_FALSE;
826 
827  if (( A > -B && a > 0.0) || (A < -B && a < 0.0)) {
828  /* A+B has same sign as a */
829 
830  /* Real part of complex conjugate */
831  x2 = -0.5 * (A + B) - a / 3.0; /* No cancellation */
832  /* Positive, imaginary part of complex conjugate */
833  x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
834 
835  x1 = -c / (x2 * x2 + x3 * x3);
836  irplib_trace(); /* OK */
837  } else {
838  /* A+B and a have opposite signs - or exactly one is zero */
839  x1 = A + B - a / 3.0;
840  /* Positive, imaginary part of complex conjugate */
841  x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
842 
843  if (x3 > 0.0) {
844  /* Real part of complex conjugate */
845  x2 = -0.5 * (A + B) - a / 3.0; /* FIXME: Cancellation */
846  irplib_trace(); /* OK */
847  } else {
848 
849  x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
850  x3 = 0.0;
851  irplib_trace(); /* OK */
852  }
853  }
854 
855  if (x3 > 0.0) {
856  is_complex = CPL_TRUE;
857  irplib_trace(); /* OK */
858  } else {
859  /* Whoaa, the imaginary part was truncated to zero
860  - return a real, double root */
861  x3 = x2;
862  if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
863  irplib_trace(); /* OK */
864  }
865 
866  *px1 = x1;
867  *px2 = x2;
868  *px3 = x3;
869  *pis_c = is_complex;
870 
871  return;
872 }
873 
874 /*----------------------------------------------------------------------------*/
889 /*----------------------------------------------------------------------------*/
890 static void irplib_polynomial_solve_1d_3r(double a, double c,
891  double Q, double R,
892  double * px1,
893  double * px2, double * px3)
894 {
895 
896  const double sqrtQ = sqrt(Q);
897  const double theta = acos (R / (Q * sqrtQ)); /* theta in range [0; pi] */
898 
899  /* -1.0 <= cos((theta + CPL_MATH_2PI) / 3.0) <= -0.5
900  -0.5 <= cos((theta - CPL_MATH_2PI) / 3.0) <= 0.5
901  0.5 <= cos((theta ) / 3.0) <= 1.0 */
902 
903 #define TR1 (-2.0 * sqrtQ * cos( theta / 3.0))
904 #define TR2 (-2.0 * sqrtQ * cos((theta - CPL_MATH_2PI) / 3.0))
905 #define TR3 (-2.0 * sqrtQ * cos((theta + CPL_MATH_2PI) / 3.0))
906 
907  /* TR1 < TR2 < TR3, except when theta == 0, then TR2 == TR3 */
908 
909  /* The three roots must be transformed back via subtraction with a/3.
910  To prevent loss of precision due to cancellation, the root which
911  is closest to a/3 is computed using the relation
912  p3 * x1 * x2 * x3 = -p0 */
913 
914  double x1 = DBL_MAX;
915  double x2 = DBL_MAX;
916  double x3 = DBL_MAX;
917 
918  if (a > 0.0) {
919  x1 = TR1 - a / 3.0;
920  if (TR2 > 0.0 && (TR2 + TR3) > 2.0 * a) {
921  /* FIXME: Cancellation may still effect x3 ? */
922  x3 = TR3 - a / 3.0;
923  x2 = -c / ( x1 * x3 );
924  irplib_trace(); /* OK */
925  } else {
926  /* FIXME: Cancellation may still effect x2, especially
927  if x2, x3 is (almost) a double root, i.e.
928  if theta is close to zero. */
929  x2 = TR2 - a / 3.0;
930 
931  x3 = -c / ( x1 * x2 );
932  irplib_trace(); /* OK */
933  }
934  } else if (a < 0.0) {
935  x3 = TR3 - a / 3.0;
936  if (TR2 < 0.0 && (TR1 + TR2) > 2.0 * a) {
937  x1 = TR1 - a / 3.0;
938  x2 = -c / ( x1 * x3 );
939  irplib_trace(); /* OK */
940  } else {
941  x2 = TR2 - a / 3.0;
942  x1 = -c / ( x2 * x3 );
943  irplib_trace(); /* OK */
944  }
945  } else {
946  x1 = TR1;
947  x2 = TR2;
948  x3 = TR3;
949  irplib_trace(); /* OK */
950  }
951 
952  assert(x1 < x3);
953 
954  if (x1 > x2) {
955  /* In absence of round-off:
956  theta == PI: x1 == x2,
957  theta < PI: x1 < x2,
958 
959  The only way x1 could exceed x2 would be due to round-off when
960  theta is close to PI */
961 
962  x1 = x2 = 0.5 * ( x1 + x2 );
963  irplib_trace(); /* OK, tested only for x1 == x2 */
964  } else if (x2 > x3) {
965  /* In absence of round-off:
966  theta == 0: x2 == x3,
967  theta > 0: x2 < x3,
968 
969  For small theta:
970  Round-off can cause x2 to become greater than x3 */
971 
972  x3 = x2 = 0.5 * ( x2 + x3 );
973  irplib_trace(); /* OK */
974  }
975 
976  *px1 = x1;
977  *px2 = x2;
978  *px3 = x3;
979 
980  return;
981 }
982 
983 /*----------------------------------------------------------------------------*/
1001 /*----------------------------------------------------------------------------*/
1002 static cpl_error_code irplib_polynomial_solve_1d_4(double p4, double p3,
1003  double p2, double p1,
1004  double p0, cpl_size * preal,
1005  double * px1, double * px2,
1006  double * px3, double * px4)
1007 {
1008 
1009  /* Construct the monic, depressed quartic using Horners scheme on 1 / p4 */
1010  const double a = (p2 - 0.375 * p3 * p3 / p4) / p4;
1011  const double b = (p1 - 0.5 * (p2 - 0.25 * p3 * p3 / p4 ) * p3 / p4 ) / p4;
1012  const double c =
1013  (p0 - 0.25 * (p1 - 0.25 * (p2 - 0.1875 * p3 * p3 / p4 ) * p3 / p4
1014  ) * p3 / p4 ) / p4;
1015 
1016  double x1 = DBL_MAX; /* Fix (false) uninit warning */
1017  double x2 = DBL_MAX; /* Fix (false) uninit warning */
1018  double x3 = DBL_MAX; /* Fix (false) uninit warning */
1019  double x4 = DBL_MAX; /* Fix (false) uninit warning */
1020 
1021  assert(preal != NULL );
1022  assert(px1 != NULL );
1023  assert(px2 != NULL );
1024  assert(px3 != NULL );
1025  assert(px4 != NULL );
1026 
1027  *preal = 4;
1028 
1029  if (c == 0.0) {
1030  /* The depressed quartic has zero as root */
1031  /* Since the sum of the roots is zero, at least one is negative
1032  and at least one is positive - unless they are all zero */
1033  cpl_boolean dbl1, dbl2;
1034  const cpl_boolean is_real =
1035  !irplib_polynomial_solve_1d_3(1.0, 0.0, a, b, &x1, &x3, &x4,
1036  &dbl1, &dbl2);
1037 
1038  x1 -= 0.25 * p3 / p4;
1039  x2 = -0.25 * p3 / p4;
1040  x3 -= 0.25 * p3 / p4;
1041  if (is_real) {
1042 
1043  if (dbl2) {
1044  x4 = x3;
1045  assert( x1 <= x2);
1046  assert( x2 <= x3);
1047  } else {
1048  x4 -= 0.25 * p3 / p4;
1049  /* Need (only) a guarded swap of x2, x3 */
1050  if (x2 > x3) {
1051  IRPLIB_SWAP(x2, x3);
1052  }
1053  if (dbl1) {
1054  assert( x1 <= x2); /* The cubic may have 0 as triple root */
1055  assert( x2 <= x3);
1056  assert( x2 <= x4);
1057  } else {
1058  assert( x1 < x2);
1059  assert( x2 < x4);
1060  }
1061  }
1062  } else {
1063  *preal = 2;
1064 
1065  if (x1 > x2) {
1066  assert( x3 <= x2 ); /* Don't swap a complex root */
1067 
1068  IRPLIB_SWAP(x1, x2);
1069  } else {
1070  assert( x3 >= x2 );
1071  }
1072  }
1073 
1074  } else if (b == 0.0) {
1075  /* The monic, depressed quartic is a monic, biquadratic equation */
1076  double u1, u2;
1077  const cpl_boolean is_complex = irplib_polynomial_solve_1d_2(1.0, a, c,
1078  &u1, &u2);
1079 
1080  if (is_complex) {
1081  /* All four roots are conjugate, complex */
1082  const double norm = sqrt(u1*u1 + u2*u2);
1083  const double v1 = sqrt(0.5*(norm+u1));
1084  const double v2 = u2 / sqrt(2.0*(norm+u1));
1085 
1086 
1087  x1 = -0.25 * p3 / p4 - v1;
1088  x3 = -0.25 * p3 / p4 + v1;
1089 
1090  x4 = x2 = v2;
1091 
1092  *preal = 0;
1093 
1094  } else if (u1 >= 0.0) {
1095  /* All four roots are real */
1096  const double sv1 = sqrt(u1);
1097  const double sv2 = sqrt(u2);
1098 
1099 
1100  *preal = 4;
1101 
1102  x1 = -0.25 * p3 / p4 - sv2;
1103  x2 = -0.25 * p3 / p4 - sv1;
1104  x3 = -0.25 * p3 / p4 + sv1;
1105  x4 = -0.25 * p3 / p4 + sv2;
1106  } else if (u2 < 0.0) {
1107  /* All four roots are conjugate, complex */
1108  const double sv1 = sqrt(-u2);
1109  const double sv2 = sqrt(-u1);
1110 
1111 
1112  *preal = 0;
1113 
1114  x1 = x3 = -0.25 * p3 / p4;
1115 
1116  x2 = sv1;
1117  x4 = sv2;
1118  } else {
1119  /* Two roots are real, two roots are conjugate, complex */
1120  const double sv1 = sqrt(-u1);
1121  const double sv2 = sqrt(u2);
1122 
1123 
1124  *preal = 2;
1125 
1126  x1 = -0.25 * p3 / p4 - sv2;
1127  x2 = -0.25 * p3 / p4 + sv2;
1128 
1129  x3 = -0.25 * p3 / p4;
1130  x4 = sv1;
1131  }
1132  } else {
1133  /* Need a root from the nested, monic cubic */
1134  const double q2 = -a;
1135  const double q1 = -4.0 * c;
1136  const double q0 = 4.0 * a * c - b * b;
1137  double u1, sqrtd, sqrtrd;
1138  double z1, z2, z3, z4;
1139 
1140  cpl_boolean is_complex1, is_complex2;
1141 
1142  /* Largest cubic root ensures real square roots when solving the
1143  quartic equation */
1144  (void)irplib_polynomial_solve_1d_3(1.0, q2, q1, q0, &u1, NULL, NULL,
1145  NULL, NULL);
1146 
1147 
1148  assert( u1 > a );
1149 
1150  sqrtd = sqrt(u1 - a);
1151 
1152  sqrtrd = 0.5 * b/sqrtd;
1153 
1154  is_complex1 = irplib_polynomial_solve_1d_2(1.0, sqrtd, 0.5*u1 - sqrtrd,
1155  &z1, &z2);
1156 
1157  is_complex2 = irplib_polynomial_solve_1d_2(1.0, -sqrtd, 0.5*u1 + sqrtrd,
1158  &z3, &z4);
1159 
1160  z1 -= 0.25 * p3 / p4;
1161  z3 -= 0.25 * p3 / p4;
1162  if (!is_complex1) z2 -= 0.25 * p3 / p4;
1163  if (!is_complex2) z4 -= 0.25 * p3 / p4;
1164 
1165  if (!is_complex1 && is_complex2) {
1166  *preal = 2;
1167  x1 = z1;
1168  x2 = z2;
1169  x3 = z3;
1170  x4 = z4;
1171  } else if (is_complex1 && !is_complex2) {
1172  *preal = 2;
1173  x1 = z3;
1174  x2 = z4;
1175  x3 = z1;
1176  x4 = z2;
1177  } else if (is_complex1 && is_complex2) {
1178  *preal = 0;
1179 
1180  if (z1 < z3 || (z1 == z3 && z2 <= z4)) {
1181  x1 = z1;
1182  x2 = z2;
1183  x3 = z3;
1184  x4 = z4;
1185  } else {
1186  x1 = z3;
1187  x2 = z4;
1188  x3 = z1;
1189  x4 = z2;
1190  }
1191  } else {
1192  *preal = 4;
1193 
1194  if (z3 >= z2) {
1195  x1 = z1;
1196  x2 = z2;
1197  x3 = z3;
1198  x4 = z4;
1199  } else if (z4 <= z1) {
1200  x1 = z3;
1201  x2 = z4;
1202  x3 = z1;
1203  x4 = z2;
1204  } else if (z2 > z4) {
1205  x1 = z3;
1206  x2 = z1;
1207  x3 = z4;
1208  x4 = z2;
1209  } else {
1210  x1 = z1;
1211  x2 = z3;
1212  x3 = z2;
1213  x4 = z4;
1214  }
1215  }
1216  }
1217 
1218  *px1 = x1;
1219  *px2 = x2;
1220  *px3 = x3;
1221  *px4 = x4;
1222 
1223  return CPL_ERROR_NONE;
1224 }
1225 
1226 #ifdef IPRLIB_POLYNOMIAL_USE_MONOMIAL_ROOT
1227 /*----------------------------------------------------------------------------*/
1235 /*----------------------------------------------------------------------------*/
1236 static double irplib_polynomial_depress_1d(cpl_polynomial * self)
1237 {
1238 
1239  const cpl_size degree = cpl_polynomial_get_degree(self);
1240  const cpl_size nc1 = degree - 1;
1241  const double an = cpl_polynomial_get_coeff(self, &degree);
1242  const double an1 = cpl_polynomial_get_coeff(self, &nc1);
1243  double rmean;
1244  cpl_size i;
1245 
1246 
1247  cpl_ensure(degree > 0, CPL_ERROR_DATA_NOT_FOUND, 0.0);
1248 
1249  assert( an != 0.0 );
1250 
1251  rmean = -an1/(an * (double)degree);
1252 
1253  if (rmean != 0.0) {
1254 
1255  cpl_polynomial_shift_1d(self, 0, rmean);
1256 
1257  cpl_polynomial_set_coeff(self, &nc1, 0.0); /* Round-off... */
1258 
1259  }
1260 
1261  /* Set leading coefficient to one. */
1262  for (i = 0; i < degree-1; i++) {
1263  const double ai = cpl_polynomial_get_coeff(self, &i) / an;
1264  cpl_polynomial_set_coeff(self, &i, ai);
1265  }
1266 
1267  cpl_polynomial_set_coeff(self, &degree, 1.0); /* Round-off... */
1268 
1269  return rmean;
1270 }
1271 #endif
1272 
1273 /*----------------------------------------------------------------------------*/
1288 /*----------------------------------------------------------------------------*/
1289 static
1290 cpl_error_code irplib_polynomial_divide_1d_root(cpl_polynomial * p, double r,
1291  double * pres)
1292 {
1293 
1294  const cpl_size n = cpl_polynomial_get_degree(p);
1295  double sum;
1296  cpl_size i;
1297 
1298 
1299  cpl_ensure_code(p != NULL, CPL_ERROR_NULL_INPUT);
1300  cpl_ensure_code(cpl_polynomial_get_dimension(p) == 1,
1301  CPL_ERROR_INVALID_TYPE);
1302  cpl_ensure_code(n > 0, CPL_ERROR_DATA_NOT_FOUND);
1303 
1304  sum = cpl_polynomial_get_coeff(p, &n);
1305  cpl_polynomial_set_coeff(p, &n, 0.0);
1306 
1307  for (i = n-1; i >= 0; i--) {
1308  const double coeff = cpl_polynomial_get_coeff(p, &i);
1309 
1310  cpl_polynomial_set_coeff(p, &i, sum);
1311 
1312  sum = coeff + r * sum;
1313 
1314  }
1315 
1316  if (pres != NULL) *pres = sum;
1317 
1318  return CPL_ERROR_NONE;
1319 }
cpl_error_code irplib_polynomial_solve_1d_all(const cpl_polynomial *self, cpl_vector *roots, cpl_size *preal)
Compute all n roots of p(x) = 0, where p(x) is of degree n, n > 0.
static double irplib_polynomial_eval_2_max(double, double, double, cpl_boolean, double, double)
Find the max residual on a 2nd degree 1D-polynomial on the roots.
static double irplib_polynomial_eval_3_max(double, double, double, double, cpl_boolean, double, double, double)
Find the max residual on a 3rd degree 1D-polynomial on the roots.