CR2RE Pipeline Reference Manual 1.6.2
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/*-----------------------------------------------------------------------------
29 Includes
30 -----------------------------------------------------------------------------*/
31
32#ifdef HAVE_CONFIG_H
33#include <config.h>
34#endif
35
36#include "irplib_polynomial.h"
37
38/* IRPLIB_SWAP_DOUBLE: */
39#include "irplib_utils.h"
40
41#include <assert.h>
42#include <math.h>
43/* DBL_MAX: */
44#include <float.h>
45
46/*----------------------------------------------------------------------------*/
52/*----------------------------------------------------------------------------*/
55/*-----------------------------------------------------------------------------
56 Static functions
57 -----------------------------------------------------------------------------*/
58
59static double irplib_polynomial_eval_2_max(double, double, double, cpl_boolean,
60 double, double);
61
62static double irplib_polynomial_eval_3_max(double, double, double, double,
63 cpl_boolean, double, double, double);
64
65
66static cpl_boolean irplib_polynomial_solve_1d_2(double, double, double,
67 double *, double *);
68static cpl_boolean irplib_polynomial_solve_1d_3(double, double, double, double,
69 double *, double *, double *,
70 cpl_boolean *,
71 cpl_boolean *);
72
73static void irplib_polynomial_solve_1d_31(double, double, double *, double *,
74 double *, cpl_boolean *);
75
76static void irplib_polynomial_solve_1d_32(double, double, double, double *,
77 double *, double *, cpl_boolean *);
78
79static void irplib_polynomial_solve_1d_3r(double, double, double, double,
80 double *, double *, double *);
81
82static void irplib_polynomial_solve_1d_3c(double, double, double,
83 double, double, double,
84 double *, double *, double *,
85 cpl_boolean *, cpl_boolean *);
86
87static cpl_error_code irplib_polynomial_solve_1d_4(double, double, double,
88 double, double, cpl_size *,
89 double *, double *,
90 double *, double *);
91
92static cpl_error_code irplib_polynomial_solve_1d_zero(cpl_polynomial *,
93 cpl_vector *,
94 cpl_size *)
95 CPL_ATTR_NONNULL;
96
97static cpl_error_code irplib_polynomial_solve_1d_nonzero(cpl_polynomial *,
98 cpl_vector *,
99 cpl_size *)
100 CPL_ATTR_NONNULL;
101
102static cpl_error_code irplib_polynomial_divide_1d_root(cpl_polynomial *, double,
103 double *);
104
105static cpl_error_code irplib_polynomial_solve_1d_guess(const cpl_polynomial *,
106 double *)
107 CPL_ATTR_NONNULL;
108
109#ifdef IRPLIB_POLYNOMIAL_GUESS_ANASOL
110static double irplib_polynomial_depress_1d(cpl_polynomial *);
111#endif
112
113/*-----------------------------------------------------------------------------
114 Function codes
115 -----------------------------------------------------------------------------*/
116
117/*----------------------------------------------------------------------------*/
143/*----------------------------------------------------------------------------*/
144cpl_error_code irplib_polynomial_solve_1d_all(const cpl_polynomial * self,
145 cpl_vector * roots,
146 cpl_size * preal)
147{
148
149 cpl_error_code error;
150 const cpl_size degree = cpl_polynomial_get_degree(self);
151 cpl_polynomial * p;
152
153 cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
154 cpl_ensure_code(roots != NULL, CPL_ERROR_NULL_INPUT);
155 cpl_ensure_code(preal != NULL, CPL_ERROR_NULL_INPUT);
156 cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
157 CPL_ERROR_INVALID_TYPE);
158 cpl_ensure_code(degree > 0, CPL_ERROR_DATA_NOT_FOUND);
159 cpl_ensure_code(degree == cpl_vector_get_size(roots),
160 CPL_ERROR_INCOMPATIBLE_INPUT);
161
162 *preal = 0;
163
164 p = cpl_polynomial_duplicate(self);
165
166 error = irplib_polynomial_solve_1d_zero(p, roots, preal);
167
168 if (!error && *preal < degree) {
169 /* There are non-zero roots */
170
171 /* Whether roots need sorting (no need w. up to 4 non-zero roots) */
172 const cpl_boolean dosort = *preal > 0 || degree - *preal > 4;
173
174 assert(cpl_polynomial_get_degree(p) + *preal == degree);
175
176 error = irplib_polynomial_solve_1d_nonzero(p, roots, preal);
177
178 if (!error && dosort) {
179 cpl_vector * reals = cpl_vector_wrap(*preal,
180 cpl_vector_get_data(roots));
181 cpl_vector_sort(reals, CPL_SORT_ASCENDING);
182 (void)cpl_vector_unwrap(reals);
183 }
184 }
185
186 cpl_polynomial_delete(p);
187
188 return error ? cpl_error_set_where(cpl_func) : CPL_ERROR_NONE;
189
190}
191
192/*----------------------------------------------------------------------------*/
205/*----------------------------------------------------------------------------*/
206static cpl_error_code irplib_polynomial_solve_1d_zero(cpl_polynomial * self,
207 cpl_vector * roots,
208 cpl_size * preal)
209{
210 cpl_size nzero;
211 const cpl_size degree = cpl_polynomial_get_degree(self);
212
213 /* Count number of zero-value roots */
214 for (nzero = 0; nzero < degree; nzero++) {
215 if (cpl_polynomial_get_coeff(self, &nzero) != 0.0) break;
216 }
217
218 if (nzero > 0) {
219 cpl_size i = 0;
220 for (; i <= degree - nzero; i++) {
221 const cpl_size icopy = i + nzero;
222 const double value = cpl_polynomial_get_coeff(self, &icopy);
223
224 if (cpl_polynomial_set_coeff(self, &i, value))
225 return cpl_error_set_where(cpl_func);
226 }
227 for (; i <= degree; i++) {
228 if (cpl_polynomial_set_coeff(self, &i, 0.0))
229 return cpl_error_set_where(cpl_func);
230 cpl_vector_set(roots, (*preal)++, 0.0);
231 }
232 }
233
234 return CPL_ERROR_NONE;
235
236}
237
240/*----------------------------------------------------------------------------*/
253/*----------------------------------------------------------------------------*/
254static cpl_error_code irplib_polynomial_solve_1d_nonzero(cpl_polynomial * self,
255 cpl_vector * roots,
256 cpl_size * preal)
257{
258 cpl_error_code error = CPL_ERROR_NONE;
259 const cpl_size ncoeffs = 1 + cpl_polynomial_get_degree(self);
260
261
262 cpl_ensure_code(ncoeffs > 1, CPL_ERROR_DATA_NOT_FOUND);
263 cpl_ensure_code(*preal >= 0, CPL_ERROR_ILLEGAL_INPUT);
264 cpl_ensure_code(ncoeffs + *preal == 1+cpl_vector_get_size(roots),
265 CPL_ERROR_INCOMPATIBLE_INPUT);
266
267 switch (ncoeffs) {
268
269 case 2 : {
270 const cpl_size i1 = 1;
271 const cpl_size i0 = 0;
272 const double p1 = cpl_polynomial_get_coeff(self, &i1);
273 const double p0 = cpl_polynomial_get_coeff(self, &i0);
274
275 assert( p1 != 0.0 );
276
277 cpl_vector_set(roots, (*preal)++, -p0/p1);
278 break;
279 }
280 case 3 : {
281 const cpl_size i2 = 2;
282 const cpl_size i1 = 1;
283 const cpl_size i0 = 0;
284 const double p2 = cpl_polynomial_get_coeff(self, &i2);
285 const double p1 = cpl_polynomial_get_coeff(self, &i1);
286 const double p0 = cpl_polynomial_get_coeff(self, &i0);
287 double x1, x2;
288
289 assert( p2 != 0.0 );
290
291 if (irplib_polynomial_solve_1d_2(p2, p1, p0, &x1, &x2)) {
292 /* This is the complex root in the upper imaginary half-plane */
293 cpl_vector_set(roots, (*preal) , x1);
294 cpl_vector_set(roots, (*preal)+1, x2);
295 } else {
296 cpl_vector_set(roots, (*preal)++, x1);
297 cpl_vector_set(roots, (*preal)++, x2);
298 }
299 break;
300 }
301 case 4 : {
302 const cpl_size i3 = 3;
303 const cpl_size i2 = 2;
304 const cpl_size i1 = 1;
305 const cpl_size i0 = 0;
306 const double p3 = cpl_polynomial_get_coeff(self, &i3);
307 const double p2 = cpl_polynomial_get_coeff(self, &i2);
308 const double p1 = cpl_polynomial_get_coeff(self, &i1);
309 const double p0 = cpl_polynomial_get_coeff(self, &i0);
310 double x1, x2, x3;
311
312 assert( p3 != 0.0 );
313
314 if (irplib_polynomial_solve_1d_3(p3, p2, p1, p0, &x1, &x2, &x3,
315 NULL, NULL)) {
316 cpl_vector_set(roots, (*preal)++, x1);
317 /* This is the complex root in the upper imaginary half-plane */
318 cpl_vector_set(roots, (*preal) , x2);
319 cpl_vector_set(roots, (*preal)+1, x3);
320 } else {
321 cpl_vector_set(roots, (*preal)++, x1);
322 cpl_vector_set(roots, (*preal)++, x2);
323 cpl_vector_set(roots, (*preal)++, x3);
324 }
325 break;
326 }
327 case 5 : {
328 const cpl_size i4 = 4;
329 const cpl_size i3 = 3;
330 const cpl_size i2 = 2;
331 const cpl_size i1 = 1;
332 const cpl_size i0 = 0;
333 const double p4 = cpl_polynomial_get_coeff(self, &i4);
334 const double p3 = cpl_polynomial_get_coeff(self, &i3);
335 const double p2 = cpl_polynomial_get_coeff(self, &i2);
336 const double p1 = cpl_polynomial_get_coeff(self, &i1);
337 const double p0 = cpl_polynomial_get_coeff(self, &i0);
338 double x1, x2, x3, x4;
339 cpl_size nreal;
340
341 assert( p4 != 0.0 );
342
343 error = irplib_polynomial_solve_1d_4(p4, p3, p2, p1, p0, &nreal,
344 &x1, &x2, &x3, &x4);
345 if (!error) {
346 cpl_vector_set(roots, (*preal) , x1);
347 cpl_vector_set(roots, (*preal)+1, x2);
348 cpl_vector_set(roots, (*preal)+2, x3);
349 cpl_vector_set(roots, (*preal)+3, x4);
350
351 *preal += nreal;
352 }
353 break;
354 }
355
356 default: {
357
358 /* Try to reduce the problem by finding a single root */
359 double root = 0.0;
360
361 error = irplib_polynomial_solve_1d_guess(self, &root);
362
363 if (!error) {
364
365 cpl_vector_set(roots, (*preal)++, root);
366
367 irplib_polynomial_divide_1d_root(self, root, NULL);
368
369 error = irplib_polynomial_solve_1d_nonzero(self, roots, preal);
370
371 }
372
373 break;
374 }
375 }
376
377 return error ? cpl_error_set_where(cpl_func) : CPL_ERROR_NONE;
378}
379
380/*----------------------------------------------------------------------------*/
390/*----------------------------------------------------------------------------*/
391static
392cpl_error_code irplib_polynomial_solve_1d_guess(const cpl_polynomial * self,
393 double * proot)
394{
395 cpl_errorstate prestate = cpl_errorstate_get();
396 cpl_error_code error = CPL_ERROR_NONE;
397 const cpl_size degree = cpl_polynomial_get_degree(self);
398 const cpl_size ncand = 5; /* 2 is enough for current guessing strategy */
399 double rcand[ncand]; /* Stack with first guesses to try */
400 cpl_size icand = 0;
401 size_t ipos = 0, ineg = 0;
402 double rpos[1], rneg[1];
403 cpl_boolean do_bisect = CPL_FALSE;
404 cpl_size itry;
405
406
407 /* If the derivative at the first guess happens to be zero, then
408 the first guess is no good, so try a few different ones. */
409
410 for (itry = 0; ; itry++) {
411 switch (itry) {
412 case 0: {
413 /* Try the arithmetic mean of the roots */
414 const double pn0 = cpl_polynomial_get_coeff(self, &degree);
415 const cpl_size n1 = degree-1;
416 const double pn1 = cpl_polynomial_get_coeff(self, &n1);
417 double rmean;
418
419 assert( pn0 != 0.0 );
420
421 rmean = -pn1 / (pn0 * (double)degree);
422
423 rcand[icand++] = rmean;
424
425 break;
426 }
427
428 case 1: {
429 /* Try the geometric mean of the roots */
430 const cpl_size i0 = 0;
431 const double c0 = cpl_polynomial_get_coeff(self, &i0);
432 double rmean;
433
434 assert( c0 != 0.0 );
435
436 rmean = pow(fabs(c0), 1.0/(double)degree);
437
438 rcand[icand++] = rmean;
439
440 break;
441 }
442
443 case 2: {
444 /* Try to get starting guesses with opposite sign residuals */
445 const cpl_size i0 = 0;
446 const double c0 = cpl_polynomial_get_coeff(self, &i0);
447 const double pn0 = cpl_polynomial_get_coeff(self, &degree);
448 const cpl_size n1 = degree-1;
449 const double pn1 = cpl_polynomial_get_coeff(self, &n1);
450 double rmean;
451
452 assert( pn0 != 0.0 );
453
454 rmean = -pn1 / (pn0 * (double)degree);
455
456 rcand[icand++] = rmean + c0;
457 rcand[icand++] = rmean - c0;
458
459 break;
460 }
461
462#ifdef IRPLIB_POLYNOMIAL_GUESS_ANASOL
463 case 3: {
464
465 /* Try an analytical solution to a (shifted) monomial */
466 cpl_polynomial * copy = cpl_polynomial_duplicate(self);
467 const cpl_size i0 = 0;
468 const double rmean = irplib_polynomial_depress_1d(copy);
469 const double c0 = cpl_polynomial_get_coeff(copy, &i0);
470 const double radius = pow(fabs(c0), 1.0/(double)degree);
471
472 rcand[icand++] = rmean + radius;
473 if (radius != 0.0) /* Should always be true */
474 rcand[icand++] = rmean - radius;
475
476 cpl_polynomial_delete(copy);
477
478 break;
479 }
480#endif
481
482 default:
483 /* From here on only first guesses increasingly refined via
484 bisection are tried */
485 if (ipos > 0 && ineg > 0) {
486 rcand[icand++] = 0.5 * (rpos[0] + rneg[0]);
487 do_bisect = CPL_TRUE;
488 }
489 break;
490 }
491
492 if (icand > 0) {
493 double grad;
494 double root = rcand[--icand];
495 const double resid = cpl_polynomial_eval_1d(self, root, &grad);
496
497#ifdef IRPLIB_POLYNOMIAL_DEBUG
498 if (itry > 0)
499 cpl_msg_warning(cpl_func, "RETRY(%d)=%g, degree=%d, r=%g, d=%g",
500 (int)itry, root, (int)degree, resid, grad);
501#endif
502
503 error = cpl_polynomial_solve_1d(self, root, proot, 1);
504 if (!error) {
505 cpl_errorstate_set(prestate);
506 break;
507 }
508
509 if (do_bisect) {
510 *(resid > 0.0 ? rpos : rneg) = root;
511 } else {
512 /* Try to collect first guess with residuals with opposite signs */
513 if (resid > 0.0) {
514 if (ipos == 0) rpos[ipos++] = root;
515 } else if (ineg == 0) {
516 rneg[ineg++] = root;
517 }
518
519 if (ipos == 0 || ineg == 0) {
520 const double resid2 = cpl_polynomial_eval_1d(self, *proot,
521 &grad);
522 if (resid2 > 0.0) {
523 if (ipos == 0) rpos[ipos++] = *proot;
524 } else if (ineg == 0) {
525 rneg[ineg++] = *proot;
526 }
527 }
528 }
529
530 } else {
531 break;
532 }
533 }
534
535 return error ? cpl_error_set_where(cpl_func) : CPL_ERROR_NONE;
536}
537
538/*----------------------------------------------------------------------------*/
552/*----------------------------------------------------------------------------*/
553static cpl_boolean irplib_polynomial_solve_1d_2(double p2, double p1, double p0,
554 double * px1,
555 double * px2) {
556
557 const double sqrtD = sqrt(p1 * p1 < 4.0 * p2 * p0
558 ? 4.0 * p2 * p0 - p1 * p1
559 : p1 * p1 - 4.0 * p2 * p0);
560 cpl_boolean is_complex = CPL_FALSE;
561 double x1 = -0.5 * p1 / p2; /* Double root */
562 double x2;
563
564 /* Compute residual, assuming D == 0 */
565 double res0 = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x1);
566 double res;
567
568 assert(px1 != NULL );
569 assert(px2 != NULL );
570
571 *px2 = *px1 = x1;
572
573 /* Compute residual, assuming D > 0 */
574
575 /* x1 is the root with largest absolute value */
576 if (p1 > 0.0) {
577 x1 = -0.5 * (p1 + sqrtD);
578 } else {
579 x1 = -0.5 * (p1 - sqrtD);
580 }
581 /* Compute smaller root via division to avoid
582 loss of precision due to cancellation */
583 x2 = p0 / x1;
584 x1 /= p2; /* Scale x1 with leading coefficient */
585
586 res = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x2);
587
588 if (res < res0) {
589 res0 = res;
590 if (x2 > x1) {
591 *px1 = x1;
592 *px2 = x2;
593 } else {
594 *px1 = x2;
595 *px2 = x1;
596 }
597 }
598
599 /* Compute residual, assuming D < 0 */
600
601 x1 = -0.5 * p1 / p2; /* Real part of complex root */
602 x2 = 0.5 * sqrtD / fabs(p2); /* Positive, imaginary part of root */
603
604 res = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_TRUE, x1, x2);
605
606 if (res < res0) {
607 *px1 = x1;
608 *px2 = x2;
609 is_complex = CPL_TRUE;
610 }
611
612 return is_complex;
613
614}
615
616
617/*----------------------------------------------------------------------------*/
630/*----------------------------------------------------------------------------*/
631static double irplib_polynomial_eval_2_max(double p2, double p1, double p0,
632 cpl_boolean is_c,
633 double x1, double x2)
634{
635 double res;
636
637 if (is_c) {
638 res = fabs(p0 + x1 * (p1 + x1 * p2) - p2 * x2 * x2);
639 } else {
640 const double r1 = fabs(p0 + x1 * (p1 + x1 * p2));
641 const double r2 = fabs(p0 + x2 * (p1 + x2 * p2));
642
643 res = r1 > r2 ? r1 : r2;
644 }
645
646 return res;
647}
648
649
650/*----------------------------------------------------------------------------*/
665/*----------------------------------------------------------------------------*/
666static double irplib_polynomial_eval_3_max(double p3, double p2,
667 double p1, double p0,
668 cpl_boolean is_c,
669 double x1, double x2, double x3)
670{
671 const double r1 = fabs(p0 + x1 * (p1 + x1 * (p2 + x1 * p3)));
672 double res;
673
674 if (is_c) {
675 const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3))
676 - x3 * x3 * ( 3.0 * p3 * x2 + p2));
677
678 res = r1 > r2 ? r1 : r2;
679 } else {
680 const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3)));
681 const double r3 = fabs(p0 + x3 * (p1 + x3 * (p2 + x3 * p3)));
682 res = r1 > r2 ? (r1 > r3 ? r1 : r3) : (r2 > r3 ? r2 : r3);
683 }
684
685 /* cpl_msg_info(cpl_func, "%d: %g (%g)", __LINE__, res, r1); */
686
687 return res;
688}
689
690
691/*----------------------------------------------------------------------------*/
710/*----------------------------------------------------------------------------*/
711static cpl_boolean irplib_polynomial_solve_1d_3(double p3, double p2, double p1,
712 double p0,
713 double * px1,
714 double * px2,
715 double * px3,
716 cpl_boolean * pdbl1,
717 cpl_boolean * pdbl2) {
718 cpl_boolean is_complex = CPL_FALSE;
719 const double a = p2/p3;
720 const double b = p1/p3;
721 const double c = p0/p3;
722
723 const double q = (a * a - 3.0 * b);
724 const double r = (a * (2.0 * a * a - 9.0 * b) + 27.0 * c);
725
726 const double Q = q / 9.0;
727 const double R = r / 54.0;
728
729 const double Q3 = Q * Q * Q;
730 const double R2 = R * R;
731
732 double x1 = DBL_MAX; /* Fix (false) uninit warning */
733 double x2 = DBL_MAX; /* Fix (false) uninit warning */
734 double x3 = DBL_MAX; /* Fix (false) uninit warning */
735 double xx1 = DBL_MAX; /* Fix (false) uninit warning */
736 double xx2 = DBL_MAX; /* Fix (false) uninit warning */
737 double xx3 = DBL_MAX; /* Fix (false) uninit warning */
738
739 double res = DBL_MAX;
740 cpl_boolean is_first = CPL_TRUE;
741
742 cpl_boolean dbl2;
743
744
745 assert(px1 != NULL );
746
747 if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
748 if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
749
750 dbl2 = CPL_FALSE;
751
752 /*
753 All branches (for which the roots are defined) are evaluated, and
754 the branch with the smallest maximum-residual is chosen.
755 When two maximum-residual are identical, preference is given to
756 the purely real solution and if necessary to the solution with a
757 double root.
758 */
759
760 if ((R2 >= Q3 && R != 0.0) || R2 > Q3) {
761
762 cpl_boolean is_c = CPL_FALSE;
763 double resx;
764
765 irplib_polynomial_solve_1d_3c(a, c, Q, Q3, R, R2, &x1, &x2, &x3,
766 &is_c, &dbl2);
767
768
769 res = resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, is_c,
770 x1, x2, x3);
771
772 is_first = CPL_FALSE;
773
774 if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
775 if (!is_c && pdbl2 != NULL) *pdbl2 = dbl2;
776 is_complex = is_c;
777
778 }
779
780 if (Q > 0.0 && fabs(R / (Q * sqrt(Q))) <= 1.0) {
781 double resx;
782
783 /* this test is actually R2 < Q3, written in a form suitable
784 for exact computation with integers */
785
786 /* assert( Q > 0.0 ); */
787
788 irplib_polynomial_solve_1d_3r(a, c, Q, R, &xx1, &xx2, &xx3);
789
790 resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
791 xx1, xx2, xx3);
792
793 if (is_first || (dbl2 ? resx < res : resx <= res)) {
794 is_first = CPL_FALSE;
795 res = resx;
796 x1 = xx1;
797 x2 = xx2;
798 x3 = xx3;
799 if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
800 if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
801 is_complex = CPL_FALSE;
802 }
803 }
804
805 if (Q >= 0) {
806 cpl_boolean dbl1 = CPL_FALSE;
807 double resx;
808
809
810 irplib_polynomial_solve_1d_32(a, c, Q, &xx1, &xx2, &xx3, &dbl2);
811
812 resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
813 xx1, xx2, xx3);
814 /*
815 cpl_msg_info(cpl_func, "%d: %g = %g - %g (%u)", __LINE__,
816 res - resx, res, resx, is_complex);
817 */
818
819 if (is_first || resx <= res) {
820 /* is_first = CPL_FALSE; */
821 res = resx;
822 x1 = xx1;
823 x2 = xx2;
824 x3 = xx3;
825 if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
826 if (pdbl2 != NULL) *pdbl2 = dbl2;
827 is_complex = CPL_FALSE;
828 }
829
830
831 /* This branch also covers the case where the depressed cubic
832 polynomial has zero as triple root (i.e. Q == R == 0) */
833
834 irplib_polynomial_solve_1d_31(a, Q, &xx1, &xx2, &xx3, &dbl1);
835
836 resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
837 xx1, xx2, xx3);
838
839 if (resx <= res) {
840 /* is_first = CPL_FALSE; */
841 /*res = resx;*/
842 x1 = xx1;
843 x2 = xx2;
844 x3 = xx3;
845 if (pdbl1 != NULL) *pdbl1 = dbl1;
846 if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
847 is_complex = CPL_FALSE;
848 }
849
850 }
851
852 if (px2 != NULL && px3 != NULL) {
853 *px1 = x1;
854 *px2 = x2;
855 *px3 = x3;
856 } else if (is_complex) {
857 *px1 = x1;
858 } else {
859 *px1 = x3;
860 }
861
862 return is_complex;
863}
864
865/*----------------------------------------------------------------------------*/
879/*----------------------------------------------------------------------------*/
880static void irplib_polynomial_solve_1d_31(double a, double Q,
881 double * px1, double * px2,
882 double * px3, cpl_boolean * pdbl1)
883{
884
885 const double sqrtQ = sqrt (Q);
886
887 double x1, x2, x3;
888
889 x2 = x1 = -sqrtQ - a / 3.0;
890 x3 = 2.0 * sqrtQ - a / 3.0;
891 if (pdbl1 != NULL) *pdbl1 = CPL_TRUE;
892
893 *px1 = x1;
894 *px2 = x2;
895 *px3 = x3;
896
897 return;
898}
899
900/*----------------------------------------------------------------------------*/
915/*----------------------------------------------------------------------------*/
916static void irplib_polynomial_solve_1d_32(double a, double c, double Q,
917 double * px1, double * px2,
918 double * px3, cpl_boolean * pdbl2)
919{
920
921 const double sqrtQ = sqrt (Q);
922
923 double x1 = DBL_MAX;
924 double x2 = DBL_MAX;
925 double x3 = DBL_MAX;
926
927 if (a > 0.0) {
928 /* a and sqrt(Q) have same sign - or Q is zero */
929 x1 = -2.0 * sqrtQ - a / 3.0;
930 /* FIXME: Two small roots with opposite signs may
931 end up here, with the sign lost for one of them */
932 x3 = x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
933 if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
934 } else if (a < 0.0) {
935 /* a and sqrt(Q) have opposite signs - or Q is zero */
936 x3 = x2 = sqrtQ - a / 3.0;
937 x1 = -c / (x2 * x2);
938 if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
939 } else {
940 x1 = -2.0 * sqrtQ;
941 x3 = x2 = sqrtQ;
942 if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
943 }
944
945 *px1 = x1;
946 *px2 = x2;
947 *px3 = x3;
948
949 return;
950}
951
952/*----------------------------------------------------------------------------*/
972/*----------------------------------------------------------------------------*/
973static void irplib_polynomial_solve_1d_3c(double a, double c,
974 double Q, double Q3,
975 double R, double R2,
976 double * px1,
977 double * px2, double * px3,
978 cpl_boolean * pis_c,
979 cpl_boolean * pdbl2)
980{
981
982 /* Due to finite precision some double roots may be missed, and
983 will be considered to be a pair of complex roots z = x +/-
984 epsilon i close to the real axis. */
985
986 /* Another case: A double root, which is small relative to the
987 last root, may cause this branch to be taken - with the
988 imaginary part eventually being truncated to zero. */
989
990 const double sgnR = (R >= 0 ? 1.0 : -1.0);
991 const double A = -sgnR * pow (fabs (R) + sqrt (R2 - Q3), 1.0 / 3.0);
992 const double B = Q / A;
993
994 double x1 = DBL_MAX;
995 double x2 = DBL_MAX;
996 double x3 = DBL_MAX;
997 cpl_boolean is_complex = CPL_FALSE;
998
999 if (( A > -B && a > 0.0) || (A < -B && a < 0.0)) {
1000 /* A+B has same sign as a */
1001
1002 /* Real part of complex conjugate */
1003 x2 = -0.5 * (A + B) - a / 3.0; /* No cancellation */
1004 /* Positive, imaginary part of complex conjugate */
1005 x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
1006
1007 x1 = -c / (x2 * x2 + x3 * x3);
1008 } else {
1009 /* A+B and a have opposite signs - or exactly one is zero */
1010 x1 = A + B - a / 3.0;
1011 /* Positive, imaginary part of complex conjugate */
1012 x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
1013
1014 if (x3 > 0.0) {
1015 /* Real part of complex conjugate */
1016 x2 = -0.5 * (A + B) - a / 3.0; /* FIXME: Cancellation */
1017 } else {
1018
1019 x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
1020 x3 = 0.0;
1021 }
1022 }
1023
1024 if (x3 > 0.0) {
1025 is_complex = CPL_TRUE;
1026 } else {
1027 /* Whoaa, the imaginary part was truncated to zero
1028 - return a real, double root */
1029 x3 = x2;
1030 if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
1031 }
1032
1033 *px1 = x1;
1034 *px2 = x2;
1035 *px3 = x3;
1036 *pis_c = is_complex;
1037
1038 return;
1039}
1040
1041/*----------------------------------------------------------------------------*/
1056/*----------------------------------------------------------------------------*/
1057static 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 } else {
1092 /* FIXME: Cancellation may still effect x2, especially
1093 if x2, x3 is (almost) a double root, i.e.
1094 if theta is close to zero. */
1095 x2 = TR2 - a / 3.0;
1096
1097 x3 = -c / ( x1 * x2 );
1098 }
1099 } else if (a < 0.0) {
1100 x3 = TR3 - a / 3.0;
1101 if (TR2 < 0.0 && (TR1 + TR2) > 2.0 * a) {
1102 x1 = TR1 - a / 3.0;
1103 x2 = -c / ( x1 * x3 );
1104 } else {
1105 x2 = TR2 - a / 3.0;
1106 x1 = -c / ( x2 * x3 );
1107 }
1108 } else {
1109 x1 = TR1;
1110 x2 = TR2;
1111 x3 = TR3;
1112 }
1113
1114 assert(x1 < x3);
1115
1116 if (x1 > x2) {
1117 /* In absence of round-off:
1118 theta == PI: x1 == x2,
1119 theta < PI: x1 < x2,
1120
1121 The only way x1 could exceed x2 would be due to round-off when
1122 theta is close to PI */
1123
1124 x1 = x2 = 0.5 * ( x1 + x2 );
1125 } else if (x2 > x3) {
1126 /* In absence of round-off:
1127 theta == 0: x2 == x3,
1128 theta > 0: x2 < x3,
1129
1130 For small theta:
1131 Round-off can cause x2 to become greater than x3 */
1132
1133 x3 = x2 = 0.5 * ( x2 + x3 );
1134 }
1135
1136 *px1 = x1;
1137 *px2 = x2;
1138 *px3 = x3;
1139
1140 return;
1141}
1142
1143/*----------------------------------------------------------------------------*/
1161/*----------------------------------------------------------------------------*/
1162static cpl_error_code irplib_polynomial_solve_1d_4(double p4, double p3,
1163 double p2, double p1,
1164 double p0, cpl_size * preal,
1165 double * px1, double * px2,
1166 double * px3, double * px4)
1167{
1168
1169 /* Construct the monic, depressed quartic using Horners scheme on 1 / p4 */
1170 const double a = (p2 - 0.375 * p3 * p3 / p4) / p4;
1171 const double b = (p1 - 0.5 * (p2 - 0.25 * p3 * p3 / p4 ) * p3 / p4 ) / p4;
1172 const double c =
1173 (p0 - 0.25 * (p1 - 0.25 * (p2 - 0.1875 * p3 * p3 / p4 ) * p3 / p4
1174 ) * p3 / p4 ) / p4;
1175
1176 double x1 = DBL_MAX; /* Fix (false) uninit warning */
1177 double x2 = DBL_MAX; /* Fix (false) uninit warning */
1178 double x3 = DBL_MAX; /* Fix (false) uninit warning */
1179 double x4 = DBL_MAX; /* Fix (false) uninit warning */
1180
1181 assert(preal != NULL );
1182 assert(px1 != NULL );
1183 assert(px2 != NULL );
1184 assert(px3 != NULL );
1185 assert(px4 != NULL );
1186
1187 *preal = 4;
1188
1189 if (c == 0.0) {
1190 /* The depressed quartic has zero as root */
1191 /* Since the sum of the roots is zero, at least one is negative
1192 and at least one is positive - unless they are all zero */
1193 cpl_boolean dbl1, dbl2;
1194 const cpl_boolean is_real =
1195 !irplib_polynomial_solve_1d_3(1.0, 0.0, a, b, &x1, &x3, &x4,
1196 &dbl1, &dbl2);
1197
1198 x1 -= 0.25 * p3 / p4;
1199 x2 = -0.25 * p3 / p4;
1200 x3 -= 0.25 * p3 / p4;
1201 if (is_real) {
1202
1203 if (dbl2) {
1204 x4 = x3;
1205 assert( x1 <= x2);
1206 assert( x2 <= x3);
1207 } else {
1208 x4 -= 0.25 * p3 / p4;
1209 /* Need (only) a guarded swap of x2, x3 */
1210 if (x2 > x3) {
1211 IRPLIB_SWAP_DOUBLE(x2, x3);
1212 }
1213 if (dbl1) {
1214 assert( x1 <= x2); /* The cubic may have 0 as triple root */
1215 assert( x2 <= x3);
1216 assert( x2 <= x4);
1217 } else {
1218 assert( x1 < x2);
1219 assert( x2 < x4);
1220 }
1221 }
1222 } else {
1223 *preal = 2;
1224
1225 if (x1 > x2) {
1226 assert( x3 <= x2 ); /* Don't swap a complex root */
1227
1228 IRPLIB_SWAP_DOUBLE(x1, x2);
1229 } else {
1230 assert( x3 >= x2 );
1231 }
1232 }
1233
1234 } else if (b == 0.0) {
1235 /* The monic, depressed quartic is a monic, biquadratic equation */
1236 double u1, u2;
1237 const cpl_boolean is_complex = irplib_polynomial_solve_1d_2(1.0, a, c,
1238 &u1, &u2);
1239
1240 if (is_complex) {
1241 /* All four roots are conjugate, complex */
1242 const double norm = sqrt(u1*u1 + u2*u2);
1243 const double v1 = sqrt(0.5*(norm+u1));
1244 const double v2 = u2 / sqrt(2.0*(norm+u1));
1245
1246
1247 x1 = -0.25 * p3 / p4 - v1;
1248 x3 = -0.25 * p3 / p4 + v1;
1249
1250 x4 = x2 = v2;
1251
1252 *preal = 0;
1253
1254 } else if (u1 >= 0.0) {
1255 /* All four roots are real */
1256 const double sv1 = sqrt(u1);
1257 const double sv2 = sqrt(u2);
1258
1259
1260 *preal = 4;
1261
1262 x1 = -0.25 * p3 / p4 - sv2;
1263 x2 = -0.25 * p3 / p4 - sv1;
1264 x3 = -0.25 * p3 / p4 + sv1;
1265 x4 = -0.25 * p3 / p4 + sv2;
1266 } else if (u2 < 0.0) {
1267 /* All four roots are conjugate, complex */
1268 const double sv1 = sqrt(-u2);
1269 const double sv2 = sqrt(-u1);
1270
1271
1272 *preal = 0;
1273
1274 x1 = x3 = -0.25 * p3 / p4;
1275
1276 x2 = sv1;
1277 x4 = sv2;
1278 } else {
1279 /* Two roots are real, two roots are conjugate, complex */
1280 const double sv1 = sqrt(-u1);
1281 const double sv2 = sqrt(u2);
1282
1283
1284 *preal = 2;
1285
1286 x1 = -0.25 * p3 / p4 - sv2;
1287 x2 = -0.25 * p3 / p4 + sv2;
1288
1289 x3 = -0.25 * p3 / p4;
1290 x4 = sv1;
1291 }
1292 } else {
1293 /* Need a root from the nested, monic cubic */
1294 const double q2 = -a;
1295 const double q1 = -4.0 * c;
1296 const double q0 = 4.0 * a * c - b * b;
1297 double u1, sqrtd, sqrtrd;
1298 double z1, z2, z3, z4;
1299
1300 cpl_boolean is_complex1, is_complex2;
1301
1302 /* Largest cubic root ensures real square roots when solving the
1303 quartic equation */
1304 (void)irplib_polynomial_solve_1d_3(1.0, q2, q1, q0, &u1, NULL, NULL,
1305 NULL, NULL);
1306
1307
1308 assert( u1 > a );
1309
1310 sqrtd = sqrt(u1 - a);
1311
1312 sqrtrd = 0.5 * b/sqrtd;
1313
1314 is_complex1 = irplib_polynomial_solve_1d_2(1.0, sqrtd, 0.5*u1 - sqrtrd,
1315 &z1, &z2);
1316
1317 is_complex2 = irplib_polynomial_solve_1d_2(1.0, -sqrtd, 0.5*u1 + sqrtrd,
1318 &z3, &z4);
1319
1320 z1 -= 0.25 * p3 / p4;
1321 z3 -= 0.25 * p3 / p4;
1322 if (!is_complex1) z2 -= 0.25 * p3 / p4;
1323 if (!is_complex2) z4 -= 0.25 * p3 / p4;
1324
1325 if (!is_complex1 && is_complex2) {
1326 *preal = 2;
1327 x1 = z1;
1328 x2 = z2;
1329 x3 = z3;
1330 x4 = z4;
1331 } else if (is_complex1 && !is_complex2) {
1332 *preal = 2;
1333 x1 = z3;
1334 x2 = z4;
1335 x3 = z1;
1336 x4 = z2;
1337 } else if (is_complex1 && is_complex2) {
1338 *preal = 0;
1339
1340 if (z1 < z3 || (z1 == z3 && z2 <= z4)) {
1341 x1 = z1;
1342 x2 = z2;
1343 x3 = z3;
1344 x4 = z4;
1345 } else {
1346 x1 = z3;
1347 x2 = z4;
1348 x3 = z1;
1349 x4 = z2;
1350 }
1351 } else {
1352 *preal = 4;
1353
1354 if (z3 >= z2) {
1355 x1 = z1;
1356 x2 = z2;
1357 x3 = z3;
1358 x4 = z4;
1359 } else if (z4 <= z1) {
1360 x1 = z3;
1361 x2 = z4;
1362 x3 = z1;
1363 x4 = z2;
1364 } else if (z2 > z4) {
1365 x1 = z3;
1366 x2 = z1;
1367 x3 = z4;
1368 x4 = z2;
1369 } else {
1370 x1 = z1;
1371 x2 = z3;
1372 x3 = z2;
1373 x4 = z4;
1374 }
1375 }
1376 }
1377
1378 *px1 = x1;
1379 *px2 = x2;
1380 *px3 = x3;
1381 *px4 = x4;
1382
1383 return CPL_ERROR_NONE;
1384}
1385
1386#ifdef IRPLIB_POLYNOMIAL_GUESS_ANASOL
1387/*----------------------------------------------------------------------------*/
1395/*----------------------------------------------------------------------------*/
1396static double irplib_polynomial_depress_1d(cpl_polynomial * self)
1397{
1398
1399 const cpl_size degree = cpl_polynomial_get_degree(self);
1400 const cpl_size nc1 = degree - 1;
1401 const double an = cpl_polynomial_get_coeff(self, &degree);
1402 const double an1 = cpl_polynomial_get_coeff(self, &nc1);
1403 const double rmean = an != 0.0 ? -an1/(an * (double)degree) : 0.0;
1404
1405
1406 cpl_ensure(degree > 0, CPL_ERROR_DATA_NOT_FOUND, 0.0);
1407
1408 assert( an != 0.0 );
1409
1410 if (rmean != 0.0) {
1411
1412 cpl_polynomial_shift_1d(self, 0, rmean);
1413
1414 }
1415
1416 /* Divide polynomial by leading coefficient */
1417 for (cpl_size i = 0; i < nc1; i++) {
1418 const double ai = cpl_polynomial_get_coeff(self, &i) / an;
1419 cpl_polynomial_set_coeff(self, &i, ai);
1420 }
1421
1422 cpl_polynomial_set_coeff(self, &nc1, 0.0); /* Ensure exact values */
1423 cpl_polynomial_set_coeff(self, &degree, 1.0); /* Ensure exact values */
1424
1425 return rmean;
1426}
1427#endif
1428
1429/*----------------------------------------------------------------------------*/
1444/*----------------------------------------------------------------------------*/
1445static
1446cpl_error_code irplib_polynomial_divide_1d_root(cpl_polynomial * p, double r,
1447 double * pres)
1448{
1449
1450 const cpl_size n = cpl_polynomial_get_degree(p);
1451 double sum;
1452 cpl_size i;
1453
1454
1455 cpl_ensure_code(p != NULL, CPL_ERROR_NULL_INPUT);
1456 cpl_ensure_code(n > 0, CPL_ERROR_DATA_NOT_FOUND);
1457
1458 sum = cpl_polynomial_get_coeff(p, &n);
1459 cpl_polynomial_set_coeff(p, &n, 0.0);
1460
1461 for (i = n-1; i >= 0; i--) {
1462 const double coeff = cpl_polynomial_get_coeff(p, &i);
1463
1464 cpl_polynomial_set_coeff(p, &i, sum);
1465
1466 sum = coeff + r * sum;
1467
1468 }
1469
1470 if (pres != NULL) *pres = sum;
1471
1472 return CPL_ERROR_NONE;
1473}