/src/r-source/src/nmath/plogis.c
Line | Count | Source |
1 | | /* |
2 | | * R : A Computer Language for Statistical Data Analysis |
3 | | * Copyright (C) 2000--2020 The R Core Team |
4 | | * Copyright (C) 1995, 1996 Robert Gentleman and Ross Ihaka |
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, a copy is available at |
18 | | * https://www.R-project.org/Licenses/ |
19 | | */ |
20 | | #include "nmath.h" |
21 | | #include "dpq.h" |
22 | | |
23 | | /* Compute log(1 + exp(x)) without overflow (and fast for x > 18) |
24 | | For the two cutoffs, consider in R |
25 | | curve(log1p(exp(x)) - x, 33.1, 33.5, n=2^10) |
26 | | curve(x+exp(-x) - log1p(exp(x)), 15, 25, n=2^11) |
27 | | */ |
28 | 0 | double log1pexp(double x) { |
29 | 0 | if(x <= 18.) return log1p(exp(x)); |
30 | 0 | if(x > 33.3) return x; |
31 | | // else: 18.0 < x <= 33.3 : |
32 | 0 | return x + exp(-x); |
33 | 0 | } |
34 | | |
35 | | // API. For now, continue using macro R_Log1_Exp() in our own code. |
36 | 0 | double log1mexp(double x) { return R_Log1_Exp(-x); } |
37 | | |
38 | | double plogis(double x, double location, double scale, |
39 | | int lower_tail, int log_p) |
40 | 0 | { |
41 | 0 | #ifdef IEEE_754 |
42 | 0 | if (ISNAN(x) || ISNAN(location) || ISNAN(scale)) |
43 | 0 | return x + location + scale; |
44 | 0 | #endif |
45 | 0 | if (scale <= 0.0) ML_WARN_return_NAN; |
46 | |
|
47 | 0 | x = (x - location) / scale; |
48 | 0 | if (ISNAN(x)) ML_WARN_return_NAN; |
49 | 0 | R_P_bounds_Inf_01(x); |
50 | |
|
51 | 0 | if(log_p) { |
52 | | // log(1 / (1 + exp( +- x ))) = -log(1 + exp( +- x)) |
53 | 0 | return -log1pexp(lower_tail ? -x : x); |
54 | 0 | } else { |
55 | 0 | return 1 / (1 + exp(lower_tail ? -x : x)); |
56 | 0 | } |
57 | 0 | } |
58 | | |