pqc/external/flint-2.4.3/double_extras/lambertw.c

/*=============================================================================

    This file is part of FLINT.

    FLINT is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    FLINT is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with FLINT; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA

=============================================================================*/
/******************************************************************************

   Copyright (C) 2012 Fredrik Johansson

******************************************************************************/

#include "double_extras.h"

#define POLY(p, x) d_polyval((p), sizeof(p) / sizeof(double), (x))

static const double pol1[4] = {
    0.2278634396856248853716, 0.6685854654191353381433,
    0.4670475452404395343887, 0.061184972065242761167 };

static const double pol2[5] = {
    0.2278636537503804204913, 0.8964421845409468074626,
    1.0217927151592500702475, 0.34513102625055769873401,
    0.020801230123523916719604 };

static const double pol3[6] = {
    0.00005767860320327097931, 0.029896654795890461899563,
    0.0378739044968912982585405, 0.00971957088414193124615358,
    0.000488576886695502361566636, 1.150549466178344373015667e-6 };

static const double pol4[5] = {
    0.030306172539339585635388, 0.066596680780796068408204,
    0.035483738872057375987452, 0.00506436278851840340711316,
    0.0001465263028844943142786722 };

static const double pol5[6] = {
    0.00048233868073637531461, 0.004268700087824343609188,
    0.00127714949974214706149789, 0.0000799706171559085390983949,
    1.186347211803672341928371e-6, 2.943454067276155504308283e-9 };

static const double pol6[6] = {
    0.00553288881087242781512, 0.0043904877060733941697614,
    0.00069354549834088964895342, 0.0000288257440032545960408328,
    3.01054066921000066105342e-7, 4.94316029290773314755549e-10 };

static const double pol7[4] = {
    -0.93011683587619427070, -2.9702322028603227386,
    -2.0759083419960793148, -0.042485660005713612806 };

static const double pol8[4] = {
    0.93011683587619458392, 4.3654074566738568022,
    6.1437079650412473506, 2.4613195056093927345 };

static const double pol9[11] = {
    -1.0000000000000000000, 2.3316439815971242034,
    -1.8121878856393634902, 1.9366311144923597554,
    -2.3535512018816145168, 3.0668589010506319129,
    -4.1753356002581771389, 5.8580237298747741488,
    -8.4010322175239773710, 12.250753501314460424,
    -18.100697012472442755 };

static const double pol10[6] = {
    -5.1972986075163593071, -37.478686466672907613,
    -96.155193004929291698, -102.23856988136744607,
    -37.181958033133170210, -0.48504976999675644134 };

static const double pol11[6] = {
    5.1972986074950082685, 45.274634378414741754, 150.20768172029114131,
    233.88699813222871981, 167.13313463159765859, 42.171248374042409414 };


/* avoid overflows in the formula when x is close to 2^EMAX */
#define RESCALE 1.1102230246251565404e-16

static double
halley(double x, double w)
{
    double t, u, v;

    /* exp() does not overflow, since w is an underestimate
        when the asymptotic series is used */
    t = exp(w) * RESCALE;
    u = 2*w + 2;
    v = w*t - x * RESCALE;
    t = w - u*v / (u*t*(w+1) - (w+2)*v);

    return t;
}

/* this should be exactly 6627126856707895 * 2^(-54) ~=
   0.36787944117144228, which
   is the most negative double in the domain */
#define ONE_OVER_E ldexp(6627126856707895.0, -54)

/* difference from -1/e */
#define CORRECTION 4.3082397558469466e-17

double
d_lambertw(double x)
{
    double t, u, w;

    if (x == 0.0 || x != x || x == D_INF)
        return x;

    if (x < 0.0)
    {
        /* complex result */
        if (x < -ONE_OVER_E)
            return D_NAN;
        /* close to zero */
        else if (x > -1e-9)
            return x - x * x;
        /* close to the singularity at -1/e */
        else if (x + ONE_OVER_E < 0.0003)
            return POLY(pol9, sqrt((x + ONE_OVER_E) + CORRECTION));

        /* otherwise get initial value for Halley iteration */
        if (x + ONE_OVER_E < 0.04)
            w = POLY(pol9, sqrt((x + ONE_OVER_E) + CORRECTION));
        else
            w = x * (1.0 + x * POLY(pol10, x) / POLY(pol11, x));
    }
    else
    {
        /* close to zero */
        if (x <= 0.03125)
        {
            if (x < 1e-9)
                return x - x * x;
            else
                return x * (1.0 + x * POLY(pol7, x) / POLY(pol8, x));
        }

        /* get initial value for Halley iteration  */
        if (x <= 1.0)
            w = x * POLY(pol1, x) / POLY(pol2, x);
        else if (x <= 6.0)
            w = POLY(pol3, x) / POLY(pol4, x);
        else if (x <= 40.0)
            w = POLY(pol5, x) / POLY(pol6, x);
        else
        {
            /* asymptotic series */
            t = log(x);
            u = log(t);
            w = (2*t*t*t - 2*(1+(t-1)*t)*u + u*u)/(2*t*t);
            /* one extra refinement */
            if (x < 1e15)
                w = halley(x, w);
        }
    }

    return halley(x, w);
}