The R Project SVN R

/*
 *  Mathlib : A C Library of Special Functions
 *  Copyright (C) 1998    Ross Ihaka
 *  Copyright (C) 2000-2013 The R Core Team
 *  Copyright (C) 2005-6  The R Foundation
 *
 *  This version is based on a suggestion by Morten Welinder.
 *
 *  This program 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.
 *
 *  This program 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 this program; if not, a copy is available at
 *  https://www.R-project.org/Licenses/
 *
 *  DESCRIPTION
 *
 *  The quantile function of the Cauchy distribution.
 */

#include "nmath.h"
#include "dpq.h"

double qcauchy(double p, double location, double scale,
           int lower_tail, int log_p)
{
#ifdef IEEE_754
    if (ISNAN(p) || ISNAN(location) || ISNAN(scale))
    return p + location + scale;
#endif
    R_Q_P01_check(p);
    if (scale <= 0 || !R_FINITE(scale)) {
    if (scale == 0) return location;
    /* else */ ML_WARN_return_NAN;
    }

#define my_INF location + (lower_tail ? scale : -scale) * ML_POSINF
    if (log_p) {
    if (p > -1) {
        /* when ep := exp(p),
         * tan(pi*ep)= -tan(pi*(-ep))= -tan(pi*(-ep)+pi) = -tan(pi*(1-ep)) =
         *       = -tan(pi*(-expm1(p))
         * for p ~ 0, exp(p) ~ 1, tan(~0) may be better than tan(~pi).
         */
        if (p == 0.) /* needed, since 1/tan(-0) = -Inf  for some arch. */
        return my_INF;
        lower_tail = !lower_tail;
        p = -expm1(p);
    } else
        p = exp(p);
    } else {
    if (p > 0.5) {
        if (p == 1.)
        return my_INF;
        p = 1 - p;
        lower_tail = !lower_tail;
    }
    }

    if (p == 0.5) return location; // avoid 1/Inf below
    if (p == 0.) return location + (lower_tail ? scale : -scale) * ML_NEGINF; // p = 1. is handled above
    return location + (lower_tail ? -scale : scale) / tanpi(p);
    /*  -1/tan(pi * p) = -cot(pi * p) = tan(pi * (p - 1/2))  */
}