irplib_polynomial.c

00001 /* $Id: irplib_polynomial.c,v 1.20 2008/03/25 10:10:18 llundin Exp $
00002  *
00003  * This file is part of the ESO Common Pipeline Library
00004  * Copyright (C) 2001-2004 European Southern Observatory
00005  *
00006  * This program is free software; you can redistribute it and/or modify
00007  * it under the terms of the GNU General Public License as published by
00008  * the Free Software Foundation; either version 2 of the License, or
00009  * (at your option) any later version.
00010  *
00011  * This program is distributed in the hope that it will be useful,
00012  * but WITHOUT ANY WARRANTY; without even the implied warranty of
00013  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00014  * GNU General Public License for more details.
00015  *
00016  * You should have received a copy of the GNU General Public License
00017  * along with this program; if not, write to the Free Software
00018  * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00019  */
00020 
00021 /*
00022  * $Author: llundin $
00023  * $Date: 2008/03/25 10:10:18 $
00024  * $Revision: 1.20 $
00025  * $Name: uves-3_9_0 $
00026  */
00027 
00028 #ifdef HAVE_CONFIG_H
00029 #include <config.h>
00030 #endif
00031 
00032 /*-----------------------------------------------------------------------------
00033                                    Includes
00034  -----------------------------------------------------------------------------*/
00035 
00036 #include "irplib_polynomial.h"
00037 #include <assert.h>
00038 #include <math.h>
00039 /* DBL_MAX: */
00040 #include <float.h>
00041 
00042 /*----------------------------------------------------------------------------*/
00048 /*----------------------------------------------------------------------------*/
00051 /*-----------------------------------------------------------------------------
00052                                    Macro definitions
00053  -----------------------------------------------------------------------------*/
00054 
00055 #define IRPLIB_SWAP(a,b) { const double t=(a);(a)=(b);(b)=t; }
00056 
00057 #if 0
00058 #define irplib_trace() cpl_msg_info(cpl_func, "%d: Trace", __LINE__)
00059 #else
00060 #define irplib_trace() /* Trace */
00061 #endif
00062 
00063 
00064 /*-----------------------------------------------------------------------------
00065                                    Static functions
00066  -----------------------------------------------------------------------------*/
00067 
00068 static double irplib_polynomial_eval_2_max(double, double, double, cpl_boolean,
00069                                            double, double);
00070 
00071 static double irplib_polynomial_eval_3_max(double, double, double, double,
00072                                            cpl_boolean, double, double, double);
00073 
00074 
00075 static cpl_boolean irplib_polynomial_solve_1d_2(double, double, double,
00076                                                 double *, double *);
00077 static cpl_boolean irplib_polynomial_solve_1d_3(double, double, double, double,
00078                                                 double *, double *, double *,
00079                                                 cpl_boolean *,
00080                                                 cpl_boolean *);
00081 
00082 static void irplib_polynomial_solve_1d_31(double, double, double *, double *,
00083                                           double *, cpl_boolean *);
00084 
00085 static void irplib_polynomial_solve_1d_32(double, double, double, double *,
00086                                           double *, double *, cpl_boolean *);
00087 
00088 static void irplib_polynomial_solve_1d_3r(double, double, double, double,
00089                                           double *, double *, double *);
00090 
00091 static void irplib_polynomial_solve_1d_3c(double, double, double,
00092                                           double, double, double,
00093                                           double *, double *, double *,
00094                                           cpl_boolean *, cpl_boolean *);
00095 
00096 static cpl_error_code irplib_polynomial_solve_1d_4(double, double, double,
00097                                                    double, double, int *,
00098                                                    double *, double *,
00099                                                    double *, double *);
00100 
00101 static cpl_error_code irplib_polynomial_solve_1d_nonzero(cpl_polynomial *,
00102                                                          cpl_vector *,
00103                                                          int *);
00104 
00105 /*-----------------------------------------------------------------------------
00106                               Function codes
00107  -----------------------------------------------------------------------------*/
00108 
00109 
00110 /*----------------------------------------------------------------------------*/
00135 /*----------------------------------------------------------------------------*/
00136 cpl_error_code irplib_polynomial_solve_1d_all(const cpl_polynomial * self,
00137                                               cpl_vector * roots, int * preal)
00138 {
00139 
00140     cpl_error_code error = CPL_ERROR_NONE;
00141     cpl_polynomial * p;
00142 
00143     cpl_ensure_code(self  != NULL, CPL_ERROR_NULL_INPUT);
00144     cpl_ensure_code(roots != NULL, CPL_ERROR_NULL_INPUT);
00145     cpl_ensure_code(preal != NULL, CPL_ERROR_NULL_INPUT);
00146     cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
00147                     CPL_ERROR_INVALID_TYPE);
00148     cpl_ensure_code(cpl_polynomial_get_degree(self) > 0,
00149                     CPL_ERROR_DATA_NOT_FOUND);
00150     cpl_ensure_code(cpl_polynomial_get_degree(self) ==
00151                     cpl_vector_get_size(roots), CPL_ERROR_INCOMPATIBLE_INPUT);
00152 
00153     *preal = 0;
00154 
00155     p = cpl_polynomial_duplicate(self);
00156 
00157     error = irplib_polynomial_solve_1d_nonzero(p, roots, preal);
00158 
00159     cpl_polynomial_delete(p);
00160 
00161     return error;
00162 
00163 }
00164 
00167 /*----------------------------------------------------------------------------*/
00194 /*----------------------------------------------------------------------------*/
00195 static cpl_error_code irplib_polynomial_solve_1d_nonzero(cpl_polynomial * self,
00196                                                          cpl_vector * roots,
00197                                                          int * preal)
00198 {
00199     cpl_error_code error = CPL_ERROR_NONE;
00200     const int ncoeffs = 1 + cpl_polynomial_get_degree(self);
00201 
00202     cpl_ensure_code(self  != NULL,  CPL_ERROR_NULL_INPUT);
00203     cpl_ensure_code(roots != NULL,  CPL_ERROR_NULL_INPUT);
00204     cpl_ensure_code(preal != NULL,  CPL_ERROR_NULL_INPUT);
00205     cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
00206                     CPL_ERROR_INVALID_TYPE);
00207     cpl_ensure_code(ncoeffs   > 1,  CPL_ERROR_DATA_NOT_FOUND);
00208     cpl_ensure_code(*preal >= 0,    CPL_ERROR_ILLEGAL_INPUT);
00209     cpl_ensure_code(ncoeffs + *preal == 1+cpl_vector_get_size(roots),
00210                     CPL_ERROR_INCOMPATIBLE_INPUT);
00211 
00212     switch (ncoeffs) {
00213 
00214     case 2 : {
00215         const int i1 = 1;
00216         const double p1 = cpl_polynomial_get_coeff(self, &i1);
00217         const int i0 = 0;
00218         const double p0 = cpl_polynomial_get_coeff(self, &i0);
00219 
00220         cpl_vector_set(roots, (*preal)++, -p0/p1);
00221         break;
00222     }
00223     case 3 : {
00224         const int i2 = 2;
00225         const int i1 = 1;
00226         const int i0 = 0;
00227         const double p2 = cpl_polynomial_get_coeff(self, &i2);
00228         const double p1 = cpl_polynomial_get_coeff(self, &i1);
00229         const double p0 = cpl_polynomial_get_coeff(self, &i0);
00230         double x1, x2;
00231 
00232         if (irplib_polynomial_solve_1d_2(p2, p1, p0, &x1, &x2)) {
00233             /* This is the complex root in the upper imaginary half-plane */
00234             cpl_vector_set(roots, (*preal)  , x1);
00235             cpl_vector_set(roots, (*preal)+1, x2);
00236         } else {
00237             cpl_vector_set(roots, (*preal)++, x1);
00238             cpl_vector_set(roots, (*preal)++, x2);
00239         }
00240         break;
00241     }
00242     case 4 : {
00243         const int i3 = 3;
00244         const int i2 = 2;
00245         const int i1 = 1;
00246         const int i0 = 0;
00247         const double p3 = cpl_polynomial_get_coeff(self, &i3);
00248         const double p2 = cpl_polynomial_get_coeff(self, &i2);
00249         const double p1 = cpl_polynomial_get_coeff(self, &i1);
00250         const double p0 = cpl_polynomial_get_coeff(self, &i0);
00251         double x1, x2, x3;
00252 
00253         if (irplib_polynomial_solve_1d_3(p3, p2, p1, p0, &x1, &x2, &x3,
00254                                          NULL, NULL)) {
00255             cpl_vector_set(roots, (*preal)++, x1);
00256             /* This is the complex root in the upper imaginary half-plane */
00257             cpl_vector_set(roots, (*preal)  , x2);
00258             cpl_vector_set(roots, (*preal)+1, x3);
00259         } else {
00260             cpl_vector_set(roots, (*preal)++, x1);
00261             cpl_vector_set(roots, (*preal)++, x2);
00262             cpl_vector_set(roots, (*preal)++, x3);
00263         }
00264         break;
00265     }
00266     case 5 : {
00267         const int i4 = 4;
00268         const int i3 = 3;
00269         const int i2 = 2;
00270         const int i1 = 1;
00271         const int i0 = 0;
00272         const double p4 = cpl_polynomial_get_coeff(self, &i4);
00273         const double p3 = cpl_polynomial_get_coeff(self, &i3);
00274         const double p2 = cpl_polynomial_get_coeff(self, &i2);
00275         const double p1 = cpl_polynomial_get_coeff(self, &i1);
00276         const double p0 = cpl_polynomial_get_coeff(self, &i0);
00277         double x1, x2, x3, x4;
00278         int nreal;
00279 
00280         error = irplib_polynomial_solve_1d_4(p4, p3, p2, p1, p0, &nreal,
00281                                              &x1, &x2, &x3, &x4);
00282         if (!error) {
00283             cpl_vector_set(roots, (*preal)  , x1);
00284             cpl_vector_set(roots, (*preal)+1, x2);
00285             cpl_vector_set(roots, (*preal)+2, x3);
00286             cpl_vector_set(roots, (*preal)+3, x4);
00287 
00288             *preal += nreal;
00289         }
00290         break;
00291     }
00292 
00293     default: {
00294         error = cpl_error_set(cpl_func, CPL_ERROR_UNSUPPORTED_MODE);
00295         break;
00296     }
00297     }
00298 
00299     return error;
00300 }
00301 
00302 /*----------------------------------------------------------------------------*/
00314 /*----------------------------------------------------------------------------*/
00315 static cpl_boolean irplib_polynomial_solve_1d_2(double p2, double p1, double p0,
00316                                                 double * px1,
00317                                                 double * px2) {
00318 
00319     const double sqrtD = sqrt(fabs(p1 * p1 - 4.0 * p2 * p0));
00320     cpl_boolean is_complex = CPL_FALSE;
00321     double x1 = -0.5 * p1 / p2; /* Double root */
00322     double x2;
00323 
00324     /* Compute residual, assuming D == 0 */
00325     double res0 = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x1);
00326     double res;
00327 
00328     assert(px1 != NULL );
00329     assert(px2 != NULL );
00330 
00331     *px2 = *px1 = x1;
00332 
00333     /* Compute residual, assuming D > 0 */
00334 
00335     /* x1 is the root with largest absolute value */
00336     if (p1 > 0.0) {
00337         x1 = -0.5 * (p1 + sqrtD);
00338         irplib_trace(); /* OK */
00339     } else {
00340         x1 = -0.5 * (p1 - sqrtD);
00341         irplib_trace(); /* OK */
00342     }
00343     /* Compute smaller root via division to avoid
00344        loss of precision due to cancellation */
00345     x2 = p0 / x1;
00346     x1 /= p2; /* Scale x1 with leading coefficient */
00347 
00348     res = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_FALSE, x1, x2);
00349 
00350     if (res < res0) {
00351         res0 = res;
00352         if (x2 > x1) {
00353             *px1 = x1;
00354             *px2 = x2;
00355             irplib_trace(); /* OK */
00356         } else {
00357             *px1 = x2;
00358             *px2 = x1;
00359             irplib_trace(); /* OK */
00360         }
00361     }
00362 
00363     /* Compute residual, assuming D < 0 */
00364 
00365     x1 = -0.5 * p1 / p2;          /* Real part of complex root */
00366     x2 =  0.5 * sqrtD / fabs(p2); /* Positive, imaginary part of root */
00367 
00368     res  = irplib_polynomial_eval_2_max(p2, p1, p0, CPL_TRUE,  x1, x2);
00369 
00370     if (res < res0) {
00371         *px1 = x1;
00372         *px2 = x2;
00373         is_complex = CPL_TRUE;
00374         irplib_trace(); /* OK */
00375     }
00376 
00377     return is_complex;
00378 
00379 }
00380 
00381 
00382 /*----------------------------------------------------------------------------*/
00395 /*----------------------------------------------------------------------------*/
00396 static double irplib_polynomial_eval_2_max(double p2, double p1, double p0,
00397                                            cpl_boolean is_c,
00398                                            double x1, double x2)
00399 {
00400     double res;
00401 
00402     if (is_c) {
00403         res = fabs(p0 + x1 * (p1 + x1 * p2) - p2 * x2 * x2);
00404         irplib_trace(); /* OK */
00405     } else {
00406         const double r1 = fabs(p0 + x1 * (p1 + x1 * p2));
00407         const double r2 = fabs(p0 + x2 * (p1 + x2 * p2));
00408 
00409         res = r1 > r2 ? r1 : r2;
00410         irplib_trace(); /* OK */
00411     }
00412 
00413     return res;
00414 }
00415 
00416 
00417 /*----------------------------------------------------------------------------*/
00432 /*----------------------------------------------------------------------------*/
00433 static double irplib_polynomial_eval_3_max(double p3, double p2,
00434                                            double p1, double p0,
00435                                            cpl_boolean is_c,
00436                                            double x1, double x2, double x3)
00437 {
00438     const double r1 = fabs(p0 + x1 * (p1 + x1 * (p2 + x1 * p3)));
00439     double res;
00440 
00441     if (is_c) {
00442         const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3))
00443                                - x3 * x3 * ( 3.0 * p3 * x2 + p2));
00444 
00445         res = r1 > r2 ? r1 : r2;
00446         irplib_trace(); /* OK */
00447     } else {
00448         const double r2 = fabs(p0 + x2 * (p1 + x2 * (p2 + x2 * p3)));
00449         const double r3 = fabs(p0 + x3 * (p1 + x3 * (p2 + x3 * p3)));
00450         res = r1 > r2 ? (r1 > r3 ? r1 : r3) : (r2 > r3 ? r2 : r3);
00451         irplib_trace(); /* OK */
00452     }
00453 
00454     /* cpl_msg_info(cpl_func, "%d: %g", __LINE__, res); */
00455 
00456     return res;
00457 }
00458 
00459 
00460 /*----------------------------------------------------------------------------*/
00479 /*----------------------------------------------------------------------------*/
00480 static cpl_boolean irplib_polynomial_solve_1d_3(double p3, double p2, double p1,
00481                                                 double p0,
00482                                                 double * px1,
00483                                                 double * px2,
00484                                                 double * px3,
00485                                                 cpl_boolean * pdbl1,
00486                                                 cpl_boolean * pdbl2) {
00487     cpl_boolean is_complex = CPL_FALSE;
00488     const double a = p2/p3;
00489     const double b = p1/p3;
00490     const double c = p0/p3;
00491 
00492     const double q = (a * a - 3.0 * b);
00493     const double r = (a * (2.0 * a * a - 9.0 * b) + 27.0 * c);
00494 
00495     const double Q = q / 9.0;
00496     const double R = r / 54.0;
00497 
00498     const double Q3 = Q * Q * Q;
00499     const double R2 = R * R;
00500 
00501     double x1 = DBL_MAX; /* Fix (false) uninit warning */
00502     double x2 = DBL_MAX; /* Fix (false) uninit warning */
00503     double x3 = DBL_MAX; /* Fix (false) uninit warning */
00504     double xx1 = DBL_MAX; /* Fix (false) uninit warning */
00505     double xx2 = DBL_MAX; /* Fix (false) uninit warning */
00506     double xx3 = DBL_MAX; /* Fix (false) uninit warning */
00507 
00508     double resx = DBL_MAX;
00509     double res  = DBL_MAX;
00510     cpl_boolean is_first = CPL_TRUE;
00511 
00512     cpl_boolean dbl2;
00513 
00514 
00515     assert(px1 != NULL );
00516 
00517     if (pdbl1 != NULL) *pdbl1 = CPL_FALSE;
00518     if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
00519 
00520     dbl2 = CPL_FALSE;
00521 
00522     if (Q > 0.0 && fabs(R / (Q * sqrt(Q))) <= 1.0) {
00523 
00524         /* this test is actually R2 < Q3, written in a form suitable
00525            for exact computation with integers */
00526 
00527         /* assert( Q > 0.0 ); */
00528 
00529         is_first = CPL_FALSE;
00530 
00531         irplib_polynomial_solve_1d_3r(a, c, Q, R, &xx1, &xx2, &xx3);
00532 
00533         res = resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
00534                                                   xx1, xx2, xx3);
00535         x1 = xx1;
00536         x2 = xx2;
00537         x3 = xx3;
00538     }
00539 
00540     if ((R2 >= Q3 && R != 0.0) || R2 > Q3) {
00541 
00542         cpl_boolean is_c = CPL_FALSE;
00543 
00544         irplib_polynomial_solve_1d_3c(a, c, Q, Q3, R, R2, &xx1, &xx2, &xx3,
00545                                       &is_c, &dbl2);
00546 
00547 
00548         resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, is_c,
00549                                             xx1, xx2, xx3);
00550 
00551         if (is_first || resx < res) {
00552             is_first = CPL_FALSE;
00553             res = resx;
00554             x1 = xx1;
00555             x2 = xx2;
00556             x3 = xx3;
00557             if (pdbl2 != NULL) *pdbl2 = dbl2;
00558             is_complex = is_c;
00559             irplib_trace(); /* OK */
00560         }
00561    
00562     }
00563 
00564     if (Q >= 0) {
00565         cpl_boolean dbl1 = CPL_FALSE;
00566 
00567 
00568         irplib_polynomial_solve_1d_32(a, c, Q, &xx1, &xx2, &xx3, &dbl2);
00569 
00570         resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
00571                                             xx1, xx2, xx3);
00572 
00573         if (is_first || resx < res) {
00574             is_first = CPL_FALSE;
00575             res = resx;
00576             x1 = xx1;
00577             x2 = xx2;
00578             x3 = xx3;
00579             if (pdbl2 != NULL) *pdbl2 = dbl2;
00580             is_complex = CPL_FALSE;
00581             irplib_trace(); /* OK */
00582         }
00583 
00584 
00585         /* This branch also covers the case where the depressed cubic
00586            polynomial has zero as triple root (i.e. Q == R == 0) */
00587 
00588         irplib_polynomial_solve_1d_31(a, Q, &xx1, &xx2, &xx3, &dbl1);
00589 
00590         resx = irplib_polynomial_eval_3_max(p3, p2, p1, p0, CPL_FALSE,
00591                                             xx1, xx2, xx3);
00592 
00593         if (resx < res) {
00594             is_first = CPL_FALSE;
00595             res = resx;
00596             x1 = xx1;
00597             x2 = xx2;
00598             x3 = xx3;
00599             if (pdbl1 != NULL) *pdbl1 = dbl1;
00600             if (pdbl2 != NULL) *pdbl2 = CPL_FALSE;
00601             is_complex = CPL_FALSE;
00602             irplib_trace(); /* OK */
00603         }
00604 
00605     }
00606 
00607     if (px2 != NULL && px3 != NULL) {
00608         *px1 = x1;
00609         *px2 = x2;
00610         *px3 = x3;
00611         irplib_trace(); /* OK */
00612     } else if (is_complex) {
00613         *px1 = x1;
00614         irplib_trace(); /* OK */
00615     } else {
00616         *px1 = x3;
00617         irplib_trace(); /* OK */
00618     }
00619 
00620     return is_complex;
00621 }
00622 
00623 /*----------------------------------------------------------------------------*/
00637 /*----------------------------------------------------------------------------*/
00638 static void irplib_polynomial_solve_1d_31(double a, double Q,
00639                                           double * px1, double * px2,
00640                                           double * px3, cpl_boolean * pdbl1)
00641 {
00642 
00643     const double sqrtQ = sqrt (Q);
00644 
00645     double x1, x2, x3;
00646 
00647     x2 = x1 = -sqrtQ - a / 3.0;
00648     x3 = 2.0 * sqrtQ - a / 3.0;
00649     if (pdbl1 != NULL) *pdbl1 = CPL_TRUE;
00650 
00651     *px1 = x1;
00652     *px2 = x2;
00653     *px3 = x3;
00654 
00655     irplib_trace(); /* OK */
00656     return;
00657 }
00658 
00659 /*----------------------------------------------------------------------------*/
00674 /*----------------------------------------------------------------------------*/
00675 static void irplib_polynomial_solve_1d_32(double a, double c, double Q,
00676                                           double * px1, double * px2,
00677                                           double * px3, cpl_boolean * pdbl2)
00678 {
00679 
00680     const double sqrtQ = sqrt (Q);
00681 
00682     double x1 = DBL_MAX;
00683     double x2 = DBL_MAX;
00684     double x3 = DBL_MAX;
00685 
00686     if (a > 0.0) {
00687         /* a and sqrt(Q) have same sign - or Q is zero */
00688         x1 = -2.0 * sqrtQ - a / 3.0;
00689         /* FIXME: Two small roots with opposite signs may
00690            end up here, with the sign lost for one of them */
00691         x3 = x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
00692         if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
00693         irplib_trace(); /* OK */
00694     } else if (a < 0.0) {
00695         /* a and sqrt(Q) have opposite signs - or Q is zero */
00696         x3 = x2 = sqrtQ - a / 3.0;
00697         x1 = -c / (x2 * x2);
00698         if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
00699         irplib_trace(); /* OK */
00700     } else {
00701         x1 = -2.0 * sqrtQ;
00702         x3 = x2 = sqrtQ;
00703         if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
00704         irplib_trace(); /* OK */
00705     }
00706 
00707     *px1 = x1;
00708     *px2 = x2;
00709     *px3 = x3;
00710 
00711     return;
00712 }
00713 
00714 /*----------------------------------------------------------------------------*/
00734 /*----------------------------------------------------------------------------*/
00735 static void irplib_polynomial_solve_1d_3c(double a, double c,
00736                                           double Q, double Q3,
00737                                           double R, double R2,
00738                                           double * px1,
00739                                           double * px2, double * px3,
00740                                           cpl_boolean * pis_c,
00741                                           cpl_boolean * pdbl2)
00742 {
00743 
00744     /* Due to finite precision some double roots may be missed, and
00745        will be considered to be a pair of complex roots z = x +/-
00746        epsilon i close to the real axis. */
00747 
00748     /* Another case: A double root, which is small relative to the
00749        last root, may cause this branch to be taken - with the
00750        imaginary part eventually being truncated to zero. */
00751 
00752     const double sgnR = (R >= 0 ? 1.0 : -1.0);
00753     const double A = -sgnR * pow (fabs (R) + sqrt (R2 - Q3), 1.0 / 3.0);
00754     const double B = Q / A;
00755 
00756     double x1 = DBL_MAX;
00757     double x2 = DBL_MAX;
00758     double x3 = DBL_MAX;
00759     cpl_boolean is_complex = CPL_FALSE;
00760 
00761     if (( A > -B && a > 0.0) || (A < -B && a < 0.0)) {
00762         /* A+B has same sign as a */
00763 
00764         /* Real part of complex conjugate */
00765         x2 = -0.5 * (A + B) - a / 3.0; /* No cancellation */
00766         /* Positive, imaginary part of complex conjugate */
00767         x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
00768 
00769         x1 = -c / (x2 * x2 + x3 * x3);
00770         irplib_trace(); /* OK */
00771     } else {
00772         /* A+B and a have opposite signs - or exactly one is zero */
00773         x1 = A + B - a / 3.0;
00774         /* Positive, imaginary part of complex conjugate */
00775         x3 = 0.5 * CPL_MATH_SQRT3 * fabs(A - B);
00776 
00777         if (x3 > 0.0) {
00778             /* Real part of complex conjugate */
00779             x2 = -0.5 * (A + B) - a / 3.0; /* FIXME: Cancellation */
00780             irplib_trace(); /* OK */
00781         } else {
00782 
00783             x2 = -a < x1 ? -sqrt(fabs(c / x1)) : sqrt(fabs(c / x1));
00784             x2 = -0.5 * (A + B) - a / 3.0; /* FIXME: Cancellation */
00785             x3 = 0.0;
00786             irplib_trace(); /* OK */
00787         }
00788     }
00789 
00790     if (x3 > 0.0) {
00791         is_complex = CPL_TRUE;
00792         irplib_trace(); /* OK */
00793     } else {
00794         /* Whoaa, the imaginary part was truncated to zero
00795            - return a real, double root */
00796         x3 = x2;
00797         if (pdbl2 != NULL) *pdbl2 = CPL_TRUE;
00798         irplib_trace(); /* OK */
00799     }
00800 
00801     *px1 = x1;
00802     *px2 = x2;
00803     *px3 = x3;
00804     *pis_c = is_complex;
00805 
00806     return;
00807 }
00808 
00809 /*----------------------------------------------------------------------------*/
00824 /*----------------------------------------------------------------------------*/
00825 static void irplib_polynomial_solve_1d_3r(double a, double c,
00826                                           double Q, double R,
00827                                           double * px1,
00828                                           double * px2, double * px3)
00829 {
00830 
00831     const double sqrtQ = sqrt(Q);
00832     const double theta = acos (R / (Q * sqrtQ)); /* theta in range [0; pi] */
00833 
00834     /* -1.0 <= cos((theta + CPL_MATH_2PI) / 3.0) <= -0.5
00835        -0.5 <= cos((theta - CPL_MATH_2PI) / 3.0) <=  0.5
00836         0.5 <= cos((theta                  ) / 3.0) <=  1.0 */
00837 
00838 #define TR1 (-2.0 * sqrtQ * cos( theta                    / 3.0))
00839 #define TR2 (-2.0 * sqrtQ * cos((theta - CPL_MATH_2PI) / 3.0))
00840 #define TR3 (-2.0 * sqrtQ * cos((theta + CPL_MATH_2PI) / 3.0))
00841 
00842     /* TR1 < TR2 < TR3, except when theta == 0, then TR2 == TR3 */
00843 
00844     /* The three roots must be transformed back via subtraction with a/3.
00845        To prevent loss of precision due to cancellation, the root which
00846        is closest to a/3 is computed using the relation
00847        p3 * x1 * x2 * x3 = -p0 */
00848 
00849     double x1 = DBL_MAX;
00850     double x2 = DBL_MAX;
00851     double x3 = DBL_MAX;
00852 
00853     if (a > 0.0) {
00854         x1 = TR1 - a / 3.0;
00855         if (TR2 > 0.0 && (TR2 + TR3) > 2.0 * a) {
00856             /* FIXME: Cancellation may still effect x3 ? */
00857             x3 = TR3 - a / 3.0;
00858             x2 = -c / ( x1 * x3 );
00859             irplib_trace(); /* OK */
00860         } else {
00861             /* FIXME: Cancellation may still effect x2, especially
00862                if x2, x3 is (almost) a double root, i.e.
00863                if theta is close to zero. */
00864             x2 = TR2 - a / 3.0;
00865  
00866             x3 = -c / ( x1 * x2 );
00867             irplib_trace(); /* OK */
00868         }
00869     } else if (a < 0.0) {
00870         x3 = TR3 - a / 3.0;
00871         if (TR2 < 0.0 && (TR1 + TR2) > 2.0 * a) {
00872             x1 = TR1 - a / 3.0;
00873             x2 = -c / ( x1 * x3 );
00874             irplib_trace(); /* OK */
00875         } else {
00876             x2 = TR2 - a / 3.0;
00877             x1 = -c / ( x2 * x3 );
00878             irplib_trace(); /* OK */
00879         }
00880     } else {
00881         x1 = TR1;
00882         x2 = TR2;
00883         x3 = TR3;
00884         irplib_trace(); /* OK */
00885     }
00886 
00887     assert(x1 < x3);
00888 
00889     if (x1 > x2) {
00890         /* In absence of round-off:
00891            theta == PI: x1 == x2,
00892            theta  < PI: x1 <  x2,
00893 
00894            The only way x1 could exceed x2 would be due to round-off when
00895            theta is close to PI */
00896      
00897         x1 = x2 = 0.5 * ( x1 + x2 );
00898         irplib_trace(); /* OK, tested only for x1 == x2 */
00899     } else if (x2 > x3) {
00900         /* In absence of round-off:
00901            theta == 0: x2 == x3,
00902            theta  > 0: x2 <  x3,
00903 
00904            For small theta:
00905            Round-off can cause x2 to become greater than x3 */
00906      
00907         x3 = x2 = 0.5 * ( x2 + x3 );
00908         irplib_trace(); /* OK */
00909     }
00910 
00911     *px1 = x1;
00912     *px2 = x2;
00913     *px3 = x3;
00914 
00915     return;
00916 }
00917 
00918 /*----------------------------------------------------------------------------*/
00936 /*----------------------------------------------------------------------------*/
00937 static cpl_error_code irplib_polynomial_solve_1d_4(double p4, double p3,
00938                                                    double p2, double p1,
00939                                                    double p0, int * preal,
00940                                                    double * px1, double * px2,
00941                                                    double * px3, double * px4)
00942 {
00943 
00944     /* Construct the monic, depressed quartic using Horners scheme on 1 / p4 */
00945     const double a = (p2 - 0.375 * p3 * p3 / p4) / p4;
00946     const double b = (p1 - 0.5 * (p2 - 0.25 * p3 * p3 / p4 ) * p3 / p4 ) / p4;
00947     const double c =
00948         (p0 - 0.25 * (p1 - 0.25 * (p2 - 0.1875 * p3 * p3 / p4 ) * p3 / p4
00949                       ) * p3 / p4 ) / p4;
00950 
00951     double x1 = DBL_MAX; /* Fix (false) uninit warning */
00952     double x2 = DBL_MAX; /* Fix (false) uninit warning */
00953     double x3 = DBL_MAX; /* Fix (false) uninit warning */
00954     double x4 = DBL_MAX; /* Fix (false) uninit warning */
00955 
00956     assert(preal != NULL );
00957     assert(px1   != NULL );
00958     assert(px2   != NULL );
00959     assert(px3   != NULL );
00960     assert(px4   != NULL );
00961 
00962     *preal = 4;
00963 
00964     if (c == 0.0) {
00965         /* The depressed quartic has zero as root */
00966         /* Since the sum of the roots is zero, at least one is negative
00967            and at least one is positive - unless they are all zero */
00968         cpl_boolean dbl1, dbl2;
00969         const cpl_boolean is_real =
00970             !irplib_polynomial_solve_1d_3(1.0, 0.0, a, b, &x1, &x3, &x4,
00971                                           &dbl1, &dbl2);
00972 
00973         x1 -= 0.25 * p3 / p4;
00974         x2 = -0.25 * p3 / p4;
00975         x3 -= 0.25 * p3 / p4;
00976         if (is_real) {
00977 
00978             if (dbl2) {
00979                 x4 = x3;
00980                 assert( x1 <= x2);
00981                 assert( x2 <= x3);
00982             } else {
00983                 x4 -= 0.25 * p3 / p4;
00984                 /* Need (only) a guarded swap of x2, x3 */
00985                 if (x2 > x3) {
00986                     IRPLIB_SWAP(x2, x3);
00987                 }
00988                 if (dbl1) {
00989                     assert( x1 <= x2); /* The cubic may have 0 as triple root */
00990                     assert( x2 <= x3);
00991                     assert( x2 <= x4);
00992                 } else {
00993                     assert( x1 < x2);
00994                     assert( x2 < x4);
00995                 }
00996             }
00997         } else {
00998             *preal = 2;
00999 
01000             if (x1 > x2) {
01001                 assert( x3 <= x2 ); /* Don't swap a complex root */
01002 
01003                 IRPLIB_SWAP(x1, x2);
01004             } else {
01005                 assert( x3 >= x2 );
01006             }
01007         }
01008 
01009     } else if (b == 0.0) {
01010         /* The monic, depressed quartic is a monic, biquadratic equation */
01011         double u1, u2;
01012         const cpl_boolean is_complex = irplib_polynomial_solve_1d_2(1.0, a, c,
01013                                                                     &u1, &u2);
01014 
01015         if (is_complex) {
01016             /* All four roots are conjugate, complex */
01017             const double norm = sqrt(u1*u1 + u2*u2);
01018             const double   v1 = sqrt(0.5*(norm+u1));
01019             const double   v2 = u2 / sqrt(2.0*(norm+u1));
01020 
01021 
01022             x1 = -0.25 * p3 / p4 - v1;
01023             x3 = -0.25 * p3 / p4 + v1;
01024 
01025             x4 = x2 = v2;
01026 
01027             *preal = 0;
01028 
01029         } else if (u1 >= 0.0) {
01030             /* All four roots are real */
01031             const double sv1 = sqrt(u1);
01032             const double sv2 = sqrt(u2);
01033 
01034 
01035             *preal = 4;
01036 
01037             x1 = -0.25 * p3 / p4 - sv2;
01038             x2 = -0.25 * p3 / p4 - sv1;
01039             x3 = -0.25 * p3 / p4 + sv1;
01040             x4 = -0.25 * p3 / p4 + sv2;
01041         } else if (u2 < 0.0) {
01042             /* All four roots are conjugate, complex */
01043             const double sv1 = sqrt(-u2);
01044             const double sv2 = sqrt(-u1);
01045 
01046 
01047             *preal = 0;
01048 
01049             x1 = x3 = -0.25 * p3 / p4;
01050 
01051             x2 = sv1;
01052             x4 = sv2;
01053         } else {
01054             /* Two roots are real, two roots are conjugate, complex */
01055             const double sv1 = sqrt(-u1);
01056             const double sv2 = sqrt(u2);
01057 
01058 
01059             *preal = 2;
01060 
01061             x1 = -0.25 * p3 / p4 - sv2;
01062             x2 = -0.25 * p3 / p4 + sv2;
01063 
01064             x3 = -0.25 * p3 / p4;
01065             x4 = sv1;
01066         }
01067     } else {
01068         /* Need a root from the nested, monic cubic */
01069         const double q2 = -a;
01070         const double q1 = -4.0 * c;
01071         const double q0 = 4.0 * a * c - b * b;
01072         double u1, sqrtd, sqrtrd;
01073         double z1, z2, z3, z4;
01074 
01075         cpl_boolean is_complex1, is_complex2;
01076 
01077         /* Largest cubic root ensures real square roots when solving the
01078            quartic equation */
01079         (void)irplib_polynomial_solve_1d_3(1.0, q2, q1, q0, &u1, NULL, NULL,
01080                                            NULL, NULL);
01081 
01082 
01083         assert( u1 > a );
01084 
01085         sqrtd = sqrt(u1 - a);
01086 
01087         sqrtrd = 0.5 * b/sqrtd;
01088 
01089         is_complex1 = irplib_polynomial_solve_1d_2(1.0,  sqrtd, 0.5*u1 - sqrtrd,
01090                                                    &z1, &z2);
01091 
01092         is_complex2 = irplib_polynomial_solve_1d_2(1.0, -sqrtd, 0.5*u1 + sqrtrd,
01093                                                    &z3, &z4);
01094 
01095         z1 -= 0.25 * p3 / p4;
01096         z3 -= 0.25 * p3 / p4;
01097         if (!is_complex1) z2 -= 0.25 * p3 / p4;
01098         if (!is_complex2) z4 -= 0.25 * p3 / p4;
01099 
01100         if (!is_complex1 && is_complex2) {
01101             *preal = 2;
01102             x1 = z1;
01103             x2 = z2;
01104             x3 = z3;
01105             x4 = z4;
01106         } else if (is_complex1 && !is_complex2) {
01107             *preal = 2;
01108             x1 = z3;
01109             x2 = z4;
01110             x3 = z1;
01111             x4 = z2;
01112         } else if (is_complex1 && is_complex2) {
01113             *preal = 0;
01114 
01115             if (z1 < z3 || (z1 == z3 && z2 <= z4)) {
01116                 x1 = z1;
01117                 x2 = z2;
01118                 x3 = z3;
01119                 x4 = z4;
01120             } else {
01121                 x1 = z3;
01122                 x2 = z4;
01123                 x3 = z1;
01124                 x4 = z2;
01125             }
01126         } else {
01127             *preal = 4;
01128 
01129             if (z3 >= z2) {
01130                 x1 = z1;
01131                 x2 = z2;
01132                 x3 = z3;
01133                 x4 = z4;
01134             } else if (z4 <= z1) {
01135                 x1 = z3;
01136                 x2 = z4;
01137                 x3 = z1;
01138                 x4 = z2;
01139             } else if (z2 > z4) {
01140                 x1 = z3;
01141                 x2 = z1;
01142                 x3 = z4;
01143                 x4 = z2;
01144             } else {
01145                 x1 = z1;
01146                 x2 = z3;
01147                 x3 = z2;
01148                 x4 = z4;
01149             }
01150         }
01151     }
01152 
01153     *px1 = x1;
01154     *px2 = x2;
01155     *px3 = x3;
01156     *px4 = x4;
01157 
01158     return CPL_ERROR_NONE;
01159 }
01160 
01161 #if 0
01162 /*----------------------------------------------------------------------------*/
01170 /*----------------------------------------------------------------------------*/
01171 static double irplib_polynomial_depress_1d(cpl_polynomial * self)
01172 {
01173 
01174     const int    degree = cpl_polynomial_get_degree(self);
01175     const int    nc1    = degree - 1;
01176     const double an     = cpl_polynomial_get_coeff(self, &degree);
01177     const double an1    = cpl_polynomial_get_coeff(self, &nc1);
01178     double       rmean;
01179     int          i;
01180 
01181 
01182     cpl_ensure(degree > 0,   CPL_ERROR_DATA_NOT_FOUND, 0.0);
01183 
01184     assert( an != 0.0 );
01185 
01186     rmean = -an1/(an * (double)degree);
01187 
01188     if (rmean != 0.0) {
01189 
01190         cpl_polynomial_shift_1d(self, rmean);
01191 
01192         cpl_polynomial_set_coeff(self, &nc1, 0.0); /* Round-off... */
01193 
01194     }
01195 
01196     /* Set leading coefficient to one. */
01197     for (i = 0; i < degree-1; i++) {
01198         const double ai = cpl_polynomial_get_coeff(self, &i) / an;
01199         cpl_polynomial_set_coeff(self, &i, ai);
01200     }
01201 
01202     cpl_polynomial_set_coeff(self, &degree, 1.0); /* Round-off... */
01203 
01204     return rmean;
01205 }
01206 #endif

Generated on Fri Apr 18 14:11:41 2008 for UVES Pipeline Reference Manual by  doxygen 1.5.1