diff --git a/stan/math/opencl/kernel_generator/elt_function_cl.hpp b/stan/math/opencl/kernel_generator/elt_function_cl.hpp index df349a7b483..d69ac0457de 100644 --- a/stan/math/opencl/kernel_generator/elt_function_cl.hpp +++ b/stan/math/opencl/kernel_generator/elt_function_cl.hpp @@ -7,6 +7,7 @@ #include #include #include +#include #include #include #include @@ -313,17 +314,19 @@ ADD_UNARY_FUNCTION_WITH_INCLUDES(inv_logit, opencl_kernels::inv_logit_device_function) ADD_UNARY_FUNCTION_WITH_INCLUDES(logit, opencl_kernels::log1m_device_function, opencl_kernels::logit_device_function) -ADD_UNARY_FUNCTION_WITH_INCLUDES(Phi, opencl_kernels::phi_device_function) +ADD_UNARY_FUNCTION_WITH_INCLUDES(Phi, opencl_kernels::erfcx_device_function, + opencl_kernels::phi_device_function) ADD_UNARY_FUNCTION_WITH_INCLUDES(Phi_approx, opencl_kernels::inv_logit_device_function, opencl_kernels::phi_approx_device_function) ADD_UNARY_FUNCTION_WITH_INCLUDES( - std_normal_lcdf_scaled_impl, + std_normal_lcdf_impl, opencl_kernels::erfcx_device_function, opencl_kernels::std_normal_lcdf_device_function) ADD_UNARY_FUNCTION_WITH_INCLUDES( - std_normal_lcdf_dscaled_impl, + std_normal_lcdf_derivative, opencl_kernels::erfcx_device_function, opencl_kernels::std_normal_lcdf_device_function) ADD_UNARY_FUNCTION_WITH_INCLUDES(inv_Phi, opencl_kernels::log1m_device_function, + opencl_kernels::erfcx_device_function, opencl_kernels::phi_device_function, opencl_kernels::inv_phi_device_function) ADD_UNARY_FUNCTION_WITH_INCLUDES( @@ -355,6 +358,32 @@ ADD_BINARY_FUNCTION_WITH_INCLUDES(copysign) ADD_BINARY_FUNCTION_WITH_INCLUDES( erfcx_derivative, stan::math::opencl_kernels::erfcx_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lcdf_value, + stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lcdf_d_z, stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lcdf_d_v, stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lcdf_d_s, stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lccdf_value, + stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lccdf_d_z, stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lccdf_d_v, stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) +ADD_BINARY_FUNCTION_WITH_INCLUDES( + exp_mod_normal_lccdf_d_s, stan::math::opencl_kernels::erfcx_device_function, + stan::math::opencl_kernels::exp_mod_normal_lcdf_device_function) ADD_BINARY_FUNCTION_WITH_INCLUDES( beta, stan::math::opencl_kernels::beta_device_function) ADD_BINARY_FUNCTION_WITH_INCLUDES( diff --git a/stan/math/opencl/kernels/device_functions/Phi.hpp b/stan/math/opencl/kernels/device_functions/Phi.hpp index 0db9aa2167b..e57891b77f2 100644 --- a/stan/math/opencl/kernels/device_functions/Phi.hpp +++ b/stan/math/opencl/kernels/device_functions/Phi.hpp @@ -21,15 +21,31 @@ static constexpr const char* phi_device_function * @return Phi(x) */ inline double Phi(double x) { - if (x < -37.5) { - return 0; - } else if (x < -5.0) { - return 0.5 * erfc(-M_SQRT1_2 * x); - } else if (x > 8.25) { - return 1; - } else { - return 0.5 * (1.0 + erf(M_SQRT1_2 * x)); + // erfcx_cody_middle and erfcx_cody_tail come from the erfcx + // device function, which the registration includes first. + const double u = M_SQRT1_2 * x; + const double a = fabs(u); + if (a < 0.46875) { + const double s = u * u; + const double num + = (((1.85777706184603153e-1 * s + 3.16112374387056560) * s + + 1.13864154151050156e2) + * s + + 3.77485237685302021e2) + * s + + 3.20937758913846947e3; + const double den + = (((s + 2.36012909523441209e1) * s + 2.44024637934444173e2) + * s + + 1.28261652607737228e3) + * s + + 2.84423683343917062e3; + return 0.5 + 0.5 * (u * num / den); } + const double tail + = 0.5 * exp(-(0.5 * x) * x) + * (a >= 4.0 ? erfcx_cody_tail(a) : erfcx_cody_middle(a)); + return x < 0.0 ? tail : 1.0 - tail; } // \cond ) "\n#endif\n"; // NOLINT diff --git a/stan/math/opencl/kernels/device_functions/exp_mod_normal_lcdf.hpp b/stan/math/opencl/kernels/device_functions/exp_mod_normal_lcdf.hpp new file mode 100644 index 00000000000..7243bd43ed5 --- /dev/null +++ b/stan/math/opencl/kernels/device_functions/exp_mod_normal_lcdf.hpp @@ -0,0 +1,405 @@ +#ifndef STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_EXP_MOD_NORMAL_LCDF_HPP +#define STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_EXP_MOD_NORMAL_LCDF_HPP +#ifdef STAN_OPENCL + +#include +#include + +namespace stan { +namespace math { +namespace opencl_kernels { +// \cond +static constexpr const char* exp_mod_normal_lcdf_device_function + = "\n" + "#ifndef STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_EXP_MOD_NORMAL_LCDF\n" + "#define " + "STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_EXP_MOD_NORMAL_" + "LCDF\n" STRINGIFY( + // \endcond + /** \ingroup opencl_kernels + * For x >= 4, erfcx(x) = (1 + h(x)) / (sqrt(pi) x). + * + * Mirrors stan/math/prim/prob/exp_mod_normal_lcdf.hpp, which + * documents the formulas; the two must be kept in step. The + * erfcx functions come from the erfcx device function, which the + * registration includes first. + * + * @param x argument, x >= 4 + * @return h(x) + */ + double exp_mod_normal_erfcx_h(double x) { + const double w = 1.0 / (x * x); + return 1.7724538509055160273 * w * erfcx_tail_correction(w); + } + + /** \ingroup opencl_kernels + * h(y) - h(x) for x, y >= 4, with y - x = delta given exactly, + * from the divided differences of the tail polynomials. + * + * @param x lower argument + * @param y upper argument + * @param delta y - x + * @return h(y) - h(x) + */ + double exp_mod_normal_erfcx_h_diff(double x, double y, double delta) { + const double tp[6] + = {0.000658749161529837803157, 0.0160837851487422766278, + 0.125781726111229246204, 0.360344899949804439429, + 0.305326634961232344035, 0.0163153871373020978498}; + const double tq[6] + = {-0.00233520497626869185443, -0.0605183413124413191178, + -0.527905102951428412248, -1.87295284992346047209, + -2.56852019228982242072, -1.0}; + const double w0 = 1.0 / (x * x); + const double w1 = 1.0 / (y * y); + const double dw = -(delta * w0) * ((y + x) * w1); + double a0 = 0.0; + double q0 = 0.0; + double q1 = 0.0; + double dd_a = 0.0; + double dd_q = 0.0; + double pw0 = 1.0; + double pw1 = 1.0; + double sum_k = 0.0; + for (int k = 0; k < 6; ++k) { + q0 += tq[k] * pw0; + q1 += tq[k] * pw1; + if (k > 0) { + dd_q += tq[k] * sum_k; + } + sum_k = sum_k * w0 + pw1; + a0 += tp[k] * pw0 * w0; + dd_a += tp[k] * sum_k; + pw0 *= w0; + pw1 *= w1; + } + return 1.7724538509055160273 * dw * (dd_a * q0 - a0 * dd_q) + / (q1 * q0); + } + + /** \ingroup opencl_kernels + * log1p(x) / x, 1 at x == 0. + * + * @param x argument + * @return log1p(x) / x + */ + double exp_mod_normal_log1p_over_x(double x) { + return x == 0.0 ? 1.0 : log1p(x) / x; + } + + /** \ingroup opencl_kernels + * Whether the partials of log F need d erfcx(hi) / delta. + * + * @param delta erfcx(lo) - erfcx(hi) + * @param hi upper argument + * @return nonzero if 1 / delta or erfcx'(hi) is out of range + */ + int exp_mod_normal_use_ratio(double delta, double hi) { + return !(delta > 1e-300 && hi < 1e150); + } + + /** \ingroup opencl_kernels + * erfcx'(t) / erfcx(t); -1 / t above t = 1e150. + * + * @param t argument + * @param e_t erfcx(t) + * @return erfcx'(t) / erfcx(t) + */ + double exp_mod_normal_erfcx_log_slope(double t, double e_t) { + return t > 1e150 ? -1.0 / t : erfcx_derivative(t, e_t) / e_t; + } + + /** \ingroup opencl_kernels + * erfcx(lo) - erfcx(hi) for hi - lo = d > 0 with d given exactly, + * its log, and d erfcx(hi) / delta where + * exp_mod_normal_use_ratio holds or the difference is close. + * + * @param lo lower argument + * @param hi upper argument + * @param d hi - lo + * @param e_lo erfcx(lo) + * @param e_hi erfcx(hi) + * @param upper_exact nonzero if hi is the exact end + * @param[out] log_delta log of the result + * @param[out] ratio d erfcx(hi) / delta, or 0 where not needed + * @return erfcx(lo) - erfcx(hi) + */ + double exp_mod_normal_erfcx_diff( + double lo, double hi, double d, double e_lo, double e_hi, + int upper_exact, double* log_delta, double* ratio) { + *ratio = 0.0; + if (e_hi < 0.99 * e_lo) { + const double delta = e_lo - e_hi; + *log_delta = log(delta); + if (exp_mod_normal_use_ratio(delta, hi)) { + *ratio = d * (e_hi / delta); + } + return delta; + } + if (lo >= 4.0) { + const double x_end = upper_exact ? -d / hi : d / lo; + const double l_ratio_x = -exp_mod_normal_log1p_over_x(x_end) + / (upper_exact ? hi : lo); + const double h_per_d = exp_mod_normal_erfcx_h_diff(lo, hi, 1.0) + / (1.0 + exp_mod_normal_erfcx_h(lo)); + const double l_total + = l_ratio_x + + h_per_d * exp_mod_normal_log1p_over_x(d * h_per_d); + const double log_r = d * l_total; + const double em = log_r == 0.0 ? 1.0 : expm1(log_r) / log_r; + const double one_minus_r_over_d = -l_total * em; + *log_delta = log(e_lo) + log(d) + log(one_minus_r_over_d); + *ratio = exp(log_r) / one_minus_r_over_d; + return e_lo * (d * one_minus_r_over_d); + } + const double m = upper_exact ? hi - 0.5 * d : lo + 0.5 * d; + double e_km1 = erfcx(m); + double e_k = erfcx_derivative(m, e_km1); + double odd[4]; + odd[0] = e_k; + for (int k = 1; k < 7; ++k) { + const double e_kp1 = 2.0 * m * e_k + 2.0 * k * e_km1; + e_km1 = e_k; + e_k = e_kp1; + if (k % 2 == 0) { + odd[k / 2] = e_k; + } + } + const double h = 0.5 * d; + const double h2 = h * h; + const double neg_s + = -(odd[0] + + h2 + * (odd[1] / 6.0 + + h2 * (odd[2] / 120.0 + h2 * odd[3] / 5040.0))); + *log_delta = log(d) + log(neg_s); + *ratio = e_hi / neg_s; + return d * neg_s; + } + + /** \ingroup opencl_kernels + * log(1 - x) for 0 <= x < 1. + * + * @param x argument + * @return log(1 - x) + */ + double exp_mod_normal_log1m(double x) { + return x < 1e-17 ? -x : log1p(-x); + } + + /** \ingroup opencl_kernels + * The output `which` from F = g Delta, Delta = E(u) - E(t), + * t >= 0, F <= 1/2. + * + * @return value (which = 0) or partial in z, v, sigma d/dsigma + */ + double exp_mod_normal_lcdf_from_delta( + double u, double t, double v, double log_g, double e_t, + double delta, double log_delta, double ratio, int upper, + int which) { + double value; + double scale; + if (upper) { + const double g = exp(log_g); + const double f = g * delta; + value = exp_mod_normal_log1m(f); + scale = -g / (1.0 - f); + } else { + value = log_g + log_delta; + scale = 1.0 / delta; + } + if (which == 0) { + return value; + } + if (!upper && exp_mod_normal_use_ratio(delta, t)) { + // the partials of log F from p = d E(t) / Delta and + // s = E'(t) / E(t) + const double s = exp_mod_normal_erfcx_log_slope(t, e_t); + if (which == 1) { + return M_SQRT2 * ratio; + } + if (which == 2) { + return -(s * ratio) / v; + } + return ratio * (2.0 * u - s); + } + const double de_t = erfcx_derivative(t, e_t); + if (which == 1) { + return scale * v * e_t; + } + if (which == 2) { + return -scale * de_t * M_SQRT1_2; + } + return scale * v * M_SQRT2 * (u * e_t - 0.5 * de_t); + } + + /** \ingroup opencl_kernels + * The log ccdf where P = Phi(-z) + b is near underflow. + * + * @return value (which = 0) or partial in z, v, sigma d/dsigma + */ + double exp_mod_normal_lccdf_tiny( + double z, double v, double u, double t, double log_g, + double log_b, double e_t, double e_mu, double e_mt, int which) { + const double log_b_t + = t >= 0.0 ? log_g + log(e_t) + : log_b + log1p(-0.5 * exp(-t * t) * e_mt); + const double log_q = log_g + log(e_mu); + const double log_p + = fmax(log_q, log_b_t) + log1p(exp(-fabs(log_q - log_b_t))); + if (which == 0) { + return log_p; + } + const double b_p = exp(log_b_t - log_p); + if (which == 1) { + return -v * b_p; + } + const double g_p = exp(log_g - log_p); + if (t >= 0.0) { + const double de_t = erfcx_derivative(t, e_t); + if (which == 2) { + return g_p * de_t * M_SQRT1_2; + } + return -v * g_p * M_SQRT2 * (u * e_t - 0.5 * de_t); + } + const double phi_p = g_p * M_SQRT2 * M_2_SQRTPI * 0.5; + if (which == 2) { + return -(phi_p - (v - z) * b_p); + } + return -v * (phi_p - v * b_p); + } + + /** \ingroup opencl_kernels + * The log cdf (upper = 0) or log ccdf (upper = 1) of the + * exponentially modified normal at z = (y - mu) / sigma and + * v = lambda sigma, or one of its partials with respect to z, v + * and sigma d/dsigma at fixed y, mu and lambda. + * + * @param z standardized argument + * @param v lambda sigma + * @param upper nonzero for the log ccdf + * @param which 0: value, 1: d/dz, 2: d/dv, 3: sigma d/dsigma + * @return the selected output + */ + double exp_mod_normal_lcdf_part(double z, double v, int upper, + int which) { + const double u = -z * M_SQRT1_2; + const double d = v * M_SQRT1_2; + const double t = u + d; + const double log_g = -M_LN2 - (0.5 * z) * z; + double log_delta; + double ratio; + if (z <= 0.0) { + const double e_t = erfcx(t); + const double delta = exp_mod_normal_erfcx_diff( + u, t, d, erfcx(u), e_t, 0, &log_delta, &ratio); + return exp_mod_normal_lcdf_from_delta( + u, t, v, log_g, e_t, delta, log_delta, ratio, upper, which); + } + const double log_b = d * (2.0 * u + d); + if (t < -6.5 && log_b < -0.2877) { + if (upper) { + return which == 0 + ? log_b + : which == 1 ? -v : which == 2 ? v - z : v * v; + } + const double b = exp(log_b); + if (which == 0) { + return exp_mod_normal_log1m(b); + } + const double r = b / (1.0 - b); + return which == 1 ? v * r : which == 2 ? (z - v) * r : -v * v * r; + } + const double g = exp(log_g); + const double e_mu = erfcx(-u); + const double q = g * e_mu; + double e_t = 0.0; + double e_mt = 0.0; + double b; + if (t >= 0.0) { + e_t = erfcx(t); + b = g * e_t; + } else { + e_mt = erfcx(-t); + b = exp(log_b) - g * e_mt; + } + const double p = q + b; + const int small_f = p > 0.75; + if (small_f && t >= 0.0) { + const double delta = exp_mod_normal_erfcx_diff( + u, t, d, erfcx(u), e_t, 0, &log_delta, &ratio); + return exp_mod_normal_lcdf_from_delta( + u, t, v, log_g, e_t, delta, log_delta, ratio, upper, which); + } + // the partial of F selected by which + double f_x = 0.0; + if (which == 1) { + f_x = v * b; + } else if (which > 1) { + if (t >= 0.0) { + const double de_t = erfcx_derivative(t, e_t); + f_x = which == 2 ? -g * de_t * M_SQRT1_2 + : v * g * M_SQRT2 * (u * e_t - 0.5 * de_t); + } else { + const double phi = g * M_SQRT2 * M_2_SQRTPI * 0.5; + f_x = which == 2 ? phi - (v - z) * b : v * (phi - v * b); + } + } + if (small_f) { + const double delta = exp_mod_normal_erfcx_diff( + -t, -u, d, e_mt, e_mu, 1, &log_delta, &ratio); + const double f = -expm1(log_b) + g * delta; + if (!upper) { + return which == 0 ? log(f) : f_x / f; + } + return which == 0 ? log1p(-f) : -f_x / (1.0 - f); + } + if (!upper) { + const double f = 1.0 - p; + if (which == 0) { + return p < 0.25 ? exp_mod_normal_log1m(p) : log(f); + } + return f_x / f; + } + if (p > 1e-300) { + return which == 0 ? log(p) : -f_x / p; + } + return exp_mod_normal_lccdf_tiny(z, v, u, t, log_g, log_b, e_t, + e_mu, e_mt, which); + } + + /** \ingroup opencl_kernels + * Value and partials of the log cdf, one output per function. + */ + double exp_mod_normal_lcdf_value(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 0, 0); + } double exp_mod_normal_lcdf_d_z(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 0, 1); + } double exp_mod_normal_lcdf_d_v(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 0, 2); + } double exp_mod_normal_lcdf_d_s(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 0, 3); + } + + /** \ingroup opencl_kernels + * Value and partials of the log ccdf, one output per function. + */ + double exp_mod_normal_lccdf_value(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 1, 0); + } double exp_mod_normal_lccdf_d_z(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 1, 1); + } double exp_mod_normal_lccdf_d_v(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 1, 2); + } double exp_mod_normal_lccdf_d_s(double z, double v) { + return exp_mod_normal_lcdf_part(z, v, 1, 3); + } + // \cond + ) "\n#endif\n"; // NOLINT +// \endcond + +} // namespace opencl_kernels +} // namespace math +} // namespace stan + +#endif +#endif diff --git a/stan/math/opencl/kernels/device_functions/std_normal_lcdf.hpp b/stan/math/opencl/kernels/device_functions/std_normal_lcdf.hpp index c48ce98acea..5934432358f 100644 --- a/stan/math/opencl/kernels/device_functions/std_normal_lcdf.hpp +++ b/stan/math/opencl/kernels/device_functions/std_normal_lcdf.hpp @@ -14,151 +14,53 @@ static constexpr const char* std_normal_lcdf_device_function "#ifndef STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_STD_NORMAL_LCDF\n" "#define " "STAN_MATH_OPENCL_KERNELS_DEVICE_FUNCTIONS_STD_NORMAL_LCDF\n" STRINGIFY( - /** \ingroup opencl_kernels - * Return the log standard normal cumulative distribution function - * evaluated from the scaled input `x / sqrt(2)`. - * - * @param scaled_y input scaled by `1 / sqrt(2)` - * @return log(Phi(x)) - */ - inline double std_normal_lcdf_scaled_impl(double scaled_y) { - double lcdf_n; - if (scaled_y > 0.0) { - // CDF(x) = 1/2 + 1/2 erf(x) = 1 - 1/2 erfc(x) - lcdf_n = log1p(-0.5 * erfc(scaled_y)); - if (isnan(lcdf_n)) { - lcdf_n = 0; - } - } else if (scaled_y > -4.0) { - // CDF(x) = 1/2 - 1/2 erf(-x) = 1/2 erfc(-x) - lcdf_n = log(erfc(-scaled_y)) - M_LN2; - } else if (10.0 * log(fabs(scaled_y)) < log(DBL_MAX)) { - // Need direct approximation once erfc(-x) underflows. - const double x2 = scaled_y * scaled_y; - const double x4 = pow(scaled_y, 4); - const double x6 = pow(scaled_y, 6); - const double x8 = pow(scaled_y, 8); - const double x10 = pow(scaled_y, 10); - const double temp_p = 0.000658749161529837803157 - + 0.0160837851487422766278 / x2 - + 0.125781726111229246204 / x4 - + 0.360344899949804439429 / x6 - + 0.305326634961232344035 / x8 - + 0.0163153871373020978498 / x10; - const double temp_q - = -0.00233520497626869185443 - 0.0605183413124413191178 / x2 - - 0.527905102951428412248 / x4 - 1.87295284992346047209 / x6 - - 2.56852019228982242072 / x8 - 1.0 / x10; - lcdf_n = log(0.5 * M_2_SQRTPI + (temp_p / temp_q) / x2) - M_LN2 - - log(-scaled_y) - x2; - } else { - lcdf_n = -INFINITY; - } - return lcdf_n; + // The erfcx pieces come from the erfcx device function, which the + // registration includes first. + inline double std_normal_lcdf_tail_correction(double r) { + return erfcx_tail_correction(r) / (0.5 * M_2_SQRTPI); } - /** \ingroup opencl_kernels - * Return the derivative of log standard normal cumulative - * distribution function with respect to the scaled input - * `x / sqrt(2)`. - * - * @param scaled_y input scaled by `1 / sqrt(2)` - * @return d / d(scaled_y) log(Phi(x)) - */ - inline double std_normal_lcdf_dscaled_impl(double scaled_y) { - double dnlcdf = 0.0; - double t = 0.0; - double t2 = 0.0; - double t4 = 0.0; - const double x2 = scaled_y * scaled_y; + /** erfcx(x) = exp(x^2) erfc(x) for x >= 0.46875. */ + inline double std_normal_erfcx(double x) { + return x >= 4.0 ? erfcx_cody_tail(x) : erfcx_cody_middle(x); + } - if (scaled_y > 2.9) { - t = 1.0 / (1.0 + 0.3275911 * scaled_y); - t2 = t * t; - t4 = pow(t, 4); - // A&S 7.1.26 keeps exp(-x2) in the numerator, as R's pnorm - // does; refs in stan/math/prim/prob/std_normal_lcdf.hpp - const double exp_m_x2 = exp(-x2); - dnlcdf - = 0.5 * M_2_SQRTPI * exp_m_x2 - / (1.0 - - exp_m_x2 - * (0.254829592 - 0.284496736 * t + 1.421413741 * t2 - - 1.453152027 * t2 * t + 1.061405429 * t4)); - } else if (scaled_y > 2.5) { - t = scaled_y - 2.7; - t2 = t * t; - t4 = pow(t, 4); - dnlcdf = 0.0003849882382 - 0.002079084702 * t - + 0.005229340880 * t2 - 0.008029540137 * t2 * t - + 0.008232190507 * t4 - 0.005692364250 * t4 * t - + 0.002399496363 * pow(t, 6); - } else if (scaled_y > 2.1) { - t = scaled_y - 2.3; - t2 = t * t; - t4 = pow(t, 4); - dnlcdf = 0.002846135439 - 0.01310032351 * t + 0.02732189391 * t2 - - 0.03326906904 * t2 * t + 0.02482478940 * t4 - - 0.009883071924 * t4 * t - 0.0002771362254 * pow(t, 6); - } else if (scaled_y > 1.5) { - t = scaled_y - 1.85; - t2 = t * t; - t4 = pow(t, 4); - dnlcdf = 0.01849212058 - 0.06876280470 * t + 0.1099906382 * t2 - - 0.09274533184 * t2 * t + 0.03543327418 * t4 - + 0.005644855518 * t4 * t - 0.01111434424 * pow(t, 6); - } else if (scaled_y > 0.8) { - t = scaled_y - 1.15; - t2 = t * t; - t4 = pow(t, 4); - dnlcdf = 0.1585747034 - 0.3898677543 * t + 0.3515963775 * t2 - - 0.09748053605 * t2 * t - 0.04347986191 * t4 - + 0.02182506378 * t4 * t + 0.01074751427 * pow(t, 6); - } else if (scaled_y > 0.1) { - t = scaled_y - 0.45; - t2 = t * t; - t4 = pow(t, 4); - dnlcdf = 0.6245634904 - 0.9521866949 * t + 0.3986215682 * t2 - + 0.04700850676 * t2 * t - 0.03478651979 * t4 - - 0.01772675404 * t4 * t + 0.0006577254811 * pow(t, 6); - } else if (scaled_y < -29.0) { - // asymptotic Mills ratio, DLMF 7.12.1; grows linearly as - // -2*scaled_y, same 1/x^2 series shape as R's pnorm uses - const double inv_x2 = 1.0 / x2; - dnlcdf - = -2.0 * scaled_y - / (1.0 - + inv_x2 * (-0.5 + inv_x2 * (0.75 + inv_x2 * -1.875))); - } else if (10.0 * log(fabs(scaled_y)) < log(DBL_MAX)) { - t = 1.0 / (1.0 - 0.3275911 * scaled_y); - t2 = t * t; - t4 = pow(t, 4); - dnlcdf - = M_2_SQRTPI - / (0.254829592 * t - 0.284496736 * t2 + 1.421413741 * t2 * t - - 1.453152027 * t4 + 1.061405429 * t4 * t); - if (scaled_y < -17.0) { - dnlcdf += 0.0001263257217272 * x2 * scaled_y - + 0.0123586859488623 * x2 - - 0.0860505264736028 * scaled_y - 1.252783383752970; - } else if (scaled_y < -7.0) { - dnlcdf += 0.000471585349920831 * x2 * scaled_y - + 0.0296839305424034 * x2 - + 0.207402143352332 * scaled_y + 0.425316974683324; - } else if (scaled_y < -3.9) { - dnlcdf += -0.0006972280656443 * x2 * scaled_y - + 0.0068218494628567 * x2 - + 0.0585761964460277 * scaled_y + 0.1034397670201370; - } else if (scaled_y < -2.1) { - dnlcdf += -0.0018742199480885 * x2 * scaled_y - - 0.0097119598291202 * x2 - - 0.0170137970924080 * scaled_y - 0.0100428567412041; - } - } else { - dnlcdf = INFINITY; + /** Log Phi(x), with the original, unscaled argument. */ + inline double std_normal_lcdf_impl(double x) { + if (x <= -4.0 * M_SQRT2) { + const double r = 2.0 / (x * x); + return -(0.5 * x) * x - log(-x) - 0.91893853320467274178 + + log1p(r * std_normal_lcdf_tail_correction(r)); + } + const double s = fabs(x) * M_SQRT1_2; + if (s < 0.46875) { + // Phi(x) = exp(-x^2 / 2) erfcx(-x / sqrt(2)) / 2. + return -M_LN2 - (0.5 * x) * x + log(erfcx_small(-x * M_SQRT1_2)); + } + const double erfcx_s = std_normal_erfcx(s); + if (x < 0.0) { + return -(0.5 * x) * x - M_LN2 + log(erfcx_s); } + return log1p(-0.5 * exp(-(0.5 * x) * x) * erfcx_s); + } - return dnlcdf; + /** Slope phi(x) / Phi(x) in the original units. */ + inline double std_normal_lcdf_derivative(double x) { + if (x <= -4.0 * M_SQRT2) { + const double r = 2.0 / (x * x); + return -x / (1.0 + r * std_normal_lcdf_tail_correction(r)); + } + const double s = fabs(x) * M_SQRT1_2; + if (s < 0.46875) { + return (0.5 * M_SQRT2 * M_2_SQRTPI) / erfcx_small(-x * M_SQRT1_2); + } + const double erfcx_s = std_normal_erfcx(s); + if (x < 0.0) { + return (0.5 * M_SQRT2 * M_2_SQRTPI) / erfcx_s; + } + const double density = exp(-(0.5 * x) * x); + return (0.5 * M_SQRT1_2 * M_2_SQRTPI) * density + / (1.0 - 0.5 * density * erfcx_s); }) "\n#endif\n"; // NOLINT // \endcond diff --git a/stan/math/opencl/prim/exp_mod_normal_cdf.hpp b/stan/math/opencl/prim/exp_mod_normal_cdf.hpp index 9510340e2fa..9b2d4b40efb 100644 --- a/stan/math/opencl/prim/exp_mod_normal_cdf.hpp +++ b/stan/math/opencl/prim/exp_mod_normal_cdf.hpp @@ -3,30 +3,12 @@ #ifdef STAN_OPENCL #include -#include -#include -#include -#include -#include -#include +#include +#include namespace stan { namespace math { -/** \ingroup opencl - * Returns the double exponential cumulative density function. Given - * containers of matching sizes, returns the product of probabilities. - * - * @tparam T_y_cl type of scalar outcome - * @tparam T_loc_cl type of location - * @tparam T_scale_cl type of scale - * @tparam T_inv_scale_cl type of inverse scale - * @param y (Sequence of) scalar(s). - * @param mu (Sequence of) location(s). - * @param sigma (Sequence of) scale(s). - * @param lambda (Sequence of) inverse scale(s). - * @return The log of the product of densities. - */ template exp_mod_normal_cdf(const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma, const T_inv_scale_cl& lambda) { - static constexpr const char* function = "exp_mod_normal_cdf(OpenCL)"; - using T_partials_return - = partials_return_t; - using std::isfinite; - using std::isnan; - - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma); - const size_t N = max_size(y, mu, sigma); - if (N == 0) { - return 1.0; - } - - const auto& y_col = as_column_vector_or_scalar(y); - const auto& mu_col = as_column_vector_or_scalar(mu); - const auto& sigma_col = as_column_vector_or_scalar(sigma); - const auto& lambda_col = as_column_vector_or_scalar(lambda); - - const auto& y_val = value_of(y_col); - const auto& mu_val = value_of(mu_col); - const auto& sigma_val = value_of(sigma_col); - const auto& lambda_val = value_of(lambda_col); - - auto check_y_not_nan - = check_cl(function, "Random variable", y_val, "not NaN"); - auto y_not_nan_expr = !isnan(y_val); - auto check_mu_finite - = check_cl(function, "Location parameter", mu_val, "finite"); - auto mu_finite_expr = isfinite(mu_val); - auto check_sigma_positive_finite - = check_cl(function, "Scale parameter", sigma_val, "positive finite"); - auto sigma_positive_finite_expr = 0 < sigma_val && isfinite(sigma_val); - auto check_lambda_positive_finite - = check_cl(function, "Inv_cale parameter", lambda_val, "positive finite"); - auto lambda_positive_finite_expr = 0 < lambda_val && isfinite(lambda_val); - - auto any_y_neg_inf = colwise_max(cast(y_val == NEGATIVE_INFTY)); - auto inv_sigma = elt_divide(1.0, sigma_val); - auto diff = y_val - mu_val; - auto v = elt_multiply(lambda_val, sigma_val); - auto scaled_diff = elt_multiply(diff, inv_sigma * INV_SQRT_TWO); - auto scaled_diff_diff = scaled_diff - v * INV_SQRT_TWO; - auto erf_calc = 0.5 * (1.0 + erf(scaled_diff_diff)); - auto exp_term = exp(0.5 * square(v) - elt_multiply(lambda_val, diff)); - auto cdf_n = 0.5 + 0.5 * erf(scaled_diff) - elt_multiply(exp_term, erf_calc); - auto cdf_expr = colwise_prod(cdf_n); - - auto exp_term_2 = exp(-square(scaled_diff_diff)); - auto deriv_1 = elt_multiply(elt_multiply(lambda_val, exp_term), erf_calc); - auto deriv_2 = INV_SQRT_TWO_PI - * elt_multiply(elt_multiply(exp_term, exp_term_2), inv_sigma); - auto deriv_3 - = INV_SQRT_TWO_PI * elt_multiply(exp(-square(scaled_diff)), inv_sigma); - auto mu_deriv1 = elt_divide(deriv_2 - deriv_1 - deriv_3, cdf_n); - auto sigma_deriv1 = elt_divide( - -elt_multiply(deriv_1 - deriv_2, v) - + elt_multiply(deriv_3 - deriv_2, scaled_diff) * SQRT_TWO, - cdf_n); - auto lambda_deriv1 = elt_divide( - elt_multiply( - exp_term, - INV_SQRT_TWO_PI * elt_multiply(sigma_val, exp_term_2) - - elt_multiply(elt_multiply(v, sigma_val) - diff, erf_calc)), - cdf_n); - - matrix_cl any_y_neg_inf_cl; - matrix_cl cdf_cl; - matrix_cl y_deriv_cl; - matrix_cl mu_deriv_cl; - matrix_cl sigma_deriv_cl; - matrix_cl lambda_deriv_cl; - - results(check_y_not_nan, check_mu_finite, check_sigma_positive_finite, - check_lambda_positive_finite, any_y_neg_inf_cl, cdf_cl, y_deriv_cl, - mu_deriv_cl, sigma_deriv_cl, lambda_deriv_cl) - = expressions(y_not_nan_expr, mu_finite_expr, sigma_positive_finite_expr, - lambda_positive_finite_expr, any_y_neg_inf, cdf_expr, - calc_if>(cdf_n), - calc_if>(mu_deriv1), - calc_if>(sigma_deriv1), - calc_if>(lambda_deriv1)); - - if (from_matrix_cl(any_y_neg_inf_cl).maxCoeff()) { - return 0.0; - } - - T_partials_return cdf = (from_matrix_cl(cdf_cl)).prod(); - - auto ops_partials - = make_partials_propagator(y_col, mu_col, sigma_col, lambda_col); - if constexpr (is_any_autodiff_v) { - auto mu_deriv = elt_multiply( - static_select::value>(0, mu_deriv_cl), - cdf); - auto y_deriv = -mu_deriv; - auto sigma_deriv = elt_multiply( - static_select>(0, sigma_deriv_cl), cdf); - auto lambda_deriv = elt_multiply( - static_select>(0, lambda_deriv_cl), cdf); - - results(y_deriv_cl, mu_deriv_cl, sigma_deriv_cl, lambda_deriv_cl) - = expressions(calc_if>(y_deriv), - calc_if>(mu_deriv), - calc_if>(sigma_deriv), - calc_if>(lambda_deriv)); - - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = std::move(y_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = std::move(mu_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = std::move(sigma_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<3>(ops_partials) = std::move(lambda_deriv_cl); - } - } - return ops_partials.build(cdf); + return exp(internal::exp_mod_normal_lcdf_opencl_impl( + "exp_mod_normal_cdf(OpenCL)", y, mu, sigma, lambda)); } } // namespace math diff --git a/stan/math/opencl/prim/exp_mod_normal_lccdf.hpp b/stan/math/opencl/prim/exp_mod_normal_lccdf.hpp index 8f250a0d40f..a91b980e698 100644 --- a/stan/math/opencl/prim/exp_mod_normal_lccdf.hpp +++ b/stan/math/opencl/prim/exp_mod_normal_lccdf.hpp @@ -3,31 +3,11 @@ #ifdef STAN_OPENCL #include -#include -#include -#include -#include -#include -#include +#include namespace stan { namespace math { -/** \ingroup opencl - * Returns the exp mod normal log complementary cumulative density - * function. Given containers of matching sizes, returns the log sum of - * probabilities. - * - * @tparam T_y_cl type of scalar outcome - * @tparam T_loc_cl type of location - * @tparam T_scale_cl type of scale - * @tparam T_inv_scale_cl type of inverse scale - * @param y (Sequence of) scalar(s). - * @param mu (Sequence of) location(s). - * @param sigma (Sequence of) scale(s). - * @param lambda (Sequence of) inverse scale(s). - * @return The log of the product of densities. - */ template exp_mod_normal_lccdf(const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma, const T_inv_scale_cl& lambda) { - static constexpr const char* function = "exp_mod_normal_lccdf(OpenCL)"; - using T_partials_return - = partials_return_t; - using std::isfinite; - using std::isnan; - - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma); - const size_t N = max_size(y, mu, sigma); - if (N == 0) { - return 0.0; - } - - const auto& y_col = as_column_vector_or_scalar(y); - const auto& mu_col = as_column_vector_or_scalar(mu); - const auto& sigma_col = as_column_vector_or_scalar(sigma); - const auto& lambda_col = as_column_vector_or_scalar(lambda); - - const auto& y_val = value_of(y_col); - const auto& mu_val = value_of(mu_col); - const auto& sigma_val = value_of(sigma_col); - const auto& lambda_val = value_of(lambda_col); - - auto check_y_not_nan - = check_cl(function, "Random variable", y_val, "not NaN"); - auto y_not_nan_expr = !isnan(y_val); - auto check_mu_finite - = check_cl(function, "Location parameter", mu_val, "finite"); - auto mu_finite_expr = isfinite(mu_val); - auto check_sigma_positive_finite - = check_cl(function, "Scale parameter", sigma_val, "positive finite"); - auto sigma_positive_finite_expr = 0 < sigma_val && isfinite(sigma_val); - auto check_lambda_positive_finite - = check_cl(function, "Inv_cale parameter", lambda_val, "positive finite"); - auto lambda_positive_finite_expr = 0 < lambda_val && isfinite(lambda_val); - - auto any_y_neg_inf = colwise_max(cast(y_val == NEGATIVE_INFTY)); - auto any_y_pos_inf = colwise_max(cast(y_val == INFTY)); - auto inv_sigma = elt_divide(1.0, sigma_val); - auto diff = y_val - mu_val; - auto scaled_diff = elt_multiply(diff, inv_sigma * INV_SQRT_TWO); - auto v = elt_multiply(lambda_val, sigma_val); - auto scaled_diff_diff = scaled_diff - v * INV_SQRT_TWO; - auto erf_calc = 0.5 * (1.0 + erf(scaled_diff_diff)); - auto exp_term = exp(0.5 * square(v) - elt_multiply(lambda_val, diff)); - auto ccdf_n = 0.5 - 0.5 * erf(scaled_diff) + elt_multiply(exp_term, erf_calc); - auto ccdf_log_expr = colwise_sum(log(ccdf_n)); - - auto exp_term_2 = exp(-square(scaled_diff_diff)); - auto deriv_1 = elt_multiply(elt_multiply(lambda_val, exp_term), erf_calc); - auto deriv_2 = INV_SQRT_TWO_PI - * elt_multiply(elt_multiply(exp_term, exp_term_2), inv_sigma); - auto deriv_3 - = INV_SQRT_TWO_PI * elt_multiply(exp(-square(scaled_diff)), inv_sigma); - auto mu_deriv = elt_divide(deriv_1 - deriv_2 + deriv_3, ccdf_n); - auto y_deriv = -mu_deriv; - auto sigma_deriv = elt_divide( - elt_multiply(deriv_1 - deriv_2, v) - + elt_multiply(deriv_3 - deriv_2, scaled_diff) * SQRT_TWO, - ccdf_n); - auto lambda_deriv = elt_divide( - elt_multiply(exp_term, - elt_multiply(elt_multiply(v, sigma_val) - diff, erf_calc) - - INV_SQRT_TWO_PI * elt_multiply(sigma_val, exp_term_2)), - ccdf_n); - - matrix_cl any_y_neg_inf_cl; - matrix_cl any_y_pos_inf_cl; - matrix_cl ccdf_log_cl; - matrix_cl mu_deriv_cl; - matrix_cl y_deriv_cl; - matrix_cl sigma_deriv_cl; - matrix_cl lambda_deriv_cl; - - results(check_y_not_nan, check_mu_finite, check_sigma_positive_finite, - check_lambda_positive_finite, any_y_neg_inf_cl, any_y_pos_inf_cl, - ccdf_log_cl, y_deriv_cl, mu_deriv_cl, sigma_deriv_cl, lambda_deriv_cl) - = expressions(y_not_nan_expr, mu_finite_expr, sigma_positive_finite_expr, - lambda_positive_finite_expr, any_y_neg_inf, any_y_pos_inf, - ccdf_log_expr, calc_if>(y_deriv), - calc_if>(mu_deriv), - calc_if>(sigma_deriv), - calc_if>(lambda_deriv)); - - if (from_matrix_cl(any_y_pos_inf_cl).maxCoeff()) { - return NEGATIVE_INFTY; - } - - if (from_matrix_cl(any_y_neg_inf_cl).maxCoeff()) { - return 0.0; - } - - T_partials_return ccdf_log = (from_matrix_cl(ccdf_log_cl)).sum(); - - auto ops_partials - = make_partials_propagator(y_col, mu_col, sigma_col, lambda_col); - - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = std::move(y_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = std::move(mu_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = std::move(sigma_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<3>(ops_partials) = std::move(lambda_deriv_cl); - } - return ops_partials.build(ccdf_log); + return internal::exp_mod_normal_lcdf_opencl_impl( + "exp_mod_normal_lccdf(OpenCL)", y, mu, sigma, lambda); } } // namespace math diff --git a/stan/math/opencl/prim/exp_mod_normal_lcdf.hpp b/stan/math/opencl/prim/exp_mod_normal_lcdf.hpp index 14f67b9e5f3..dbfd4015e1e 100644 --- a/stan/math/opencl/prim/exp_mod_normal_lcdf.hpp +++ b/stan/math/opencl/prim/exp_mod_normal_lcdf.hpp @@ -8,45 +8,26 @@ #include #include #include -#include #include namespace stan { namespace math { +namespace internal { -/** \ingroup opencl - * Returns the exp mod normal log cumulative density - * function. Given containers of matching sizes, returns the log sum of - * probabilities. - * - * @tparam T_y_cl type of scalar outcome - * @tparam T_loc_cl type of location - * @tparam T_scale_cl type of scale - * @tparam T_inv_scale_cl type of inverse scale - * @param y (Sequence of) scalar(s). - * @param mu (Sequence of) location(s). - * @param sigma (Sequence of) scale(s). - * @param lambda (Sequence of) inverse scale(s). - * @return The log of the product of densities. - */ -template * = nullptr, - require_any_not_stan_scalar_t* = nullptr> +/** The algorithm of the prim exp_mod_normal_lcdf_impl, on the device. */ +template inline return_type_t -exp_mod_normal_lcdf(const T_y_cl& y, const T_loc_cl& mu, - const T_scale_cl& sigma, const T_inv_scale_cl& lambda) { - static constexpr const char* function = "exp_mod_normal_lcdf(OpenCL)"; - using T_partials_return - = partials_return_t; +exp_mod_normal_lcdf_opencl_impl(const char* function, const T_y_cl& y, + const T_loc_cl& mu, const T_scale_cl& sigma, + const T_inv_scale_cl& lambda) { using std::isfinite; using std::isnan; check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma); - const size_t N = max_size(y, mu, sigma); + mu, "Scale parameter", sigma, "Inv_scale parameter", + lambda); + const size_t N = max_size(y, mu, sigma, lambda); if (N == 0) { return 0.0; } @@ -70,89 +51,55 @@ exp_mod_normal_lcdf(const T_y_cl& y, const T_loc_cl& mu, auto check_sigma_positive_finite = check_cl(function, "Scale parameter", sigma_val, "positive finite"); auto sigma_positive_finite_expr = 0 < sigma_val && isfinite(sigma_val); - auto check_lambda_positive_finite - = check_cl(function, "Inv_cale parameter", lambda_val, "positive finite"); + auto check_lambda_positive_finite = check_cl(function, "Inv_scale parameter", + lambda_val, "positive finite"); auto lambda_positive_finite_expr = 0 < lambda_val && isfinite(lambda_val); auto any_y_neg_inf = colwise_max(cast(y_val == NEGATIVE_INFTY)); auto any_y_pos_inf = colwise_max(cast(y_val == INFTY)); - auto sigma_inv = elt_divide(1.0, sigma_val); - auto diff = y_val - mu_val; - auto scaled_diff = elt_multiply(diff * INV_SQRT_TWO, sigma_inv); + auto z = elt_divide(y_val - mu_val, sigma_val); auto v = elt_multiply(lambda_val, sigma_val); - auto scaled_diff_diff = scaled_diff - v * INV_SQRT_TWO; - auto cdf_term_1 = 0.5 + 0.5 * erf(scaled_diff); - auto cdf_term_2_phi = 0.5 * (1.0 + erf(scaled_diff_diff)); - auto log_exp_term = 0.5 * square(v) - elt_multiply(lambda_val, diff); - auto exp_term = exp(log_exp_term); - auto cdf_term_2 = elt_multiply(exp_term, cdf_term_2_phi); - auto cdf_n = cdf_term_1 - cdf_term_2; - auto use_stable = cdf_n <= 0.0 || !isfinite(cdf_n); - - auto exp_term_2 = exp(-square(scaled_diff_diff)); - auto deriv_1 - = elt_multiply(elt_multiply(lambda_val, exp_term), cdf_term_2_phi); - auto deriv_2 = INV_SQRT_TWO_PI - * elt_multiply(elt_multiply(exp_term, exp_term_2), sigma_inv); - auto deriv_3 - = INV_SQRT_TWO_PI * elt_multiply(exp(-square(scaled_diff)), sigma_inv); - auto direct_cdf_log = log(cdf_n); - auto direct_y_deriv = elt_divide(deriv_1 - deriv_2 + deriv_3, cdf_n); - auto direct_mu_deriv = -direct_y_deriv; - auto direct_sigma_deriv = -elt_divide( - elt_multiply(deriv_1 - deriv_2, v) - + elt_multiply(deriv_3 - deriv_2, scaled_diff) * SQRT_TWO, - cdf_n); - auto direct_lambda_deriv = elt_divide( - elt_multiply(exp_term, - INV_SQRT_TWO_PI * elt_multiply(sigma_val, exp_term_2) - - elt_multiply(elt_multiply(v, sigma_val) - diff, - cdf_term_2_phi)), - cdf_n); - - auto log_cdf_term_1 = std_normal_lcdf_scaled_impl(scaled_diff); - auto dlog_cdf_term_1 = std_normal_lcdf_dscaled_impl(scaled_diff); - auto log_cdf_term_2_phi = std_normal_lcdf_scaled_impl(scaled_diff_diff); - auto dlog_cdf_term_2_phi = std_normal_lcdf_dscaled_impl(scaled_diff_diff); - auto log_cdf_term_2 = log_exp_term + log_cdf_term_2_phi; - auto log_cdf_n = log_diff_exp(log_cdf_term_1, log_cdf_term_2); - auto cdf_term_1_weight = exp(log_cdf_term_1 - log_cdf_n); - auto cdf_term_2_weight = exp(log_cdf_term_2 - log_cdf_n); - auto scaled_diff_deriv - = elt_multiply(dlog_cdf_term_1, sigma_inv * INV_SQRT_TWO); - auto scaled_diff_diff_deriv - = elt_multiply(dlog_cdf_term_2_phi, sigma_inv * INV_SQRT_TWO); - auto stable_y_deriv - = elt_multiply(cdf_term_1_weight, scaled_diff_deriv) - - elt_multiply(cdf_term_2_weight, -lambda_val + scaled_diff_diff_deriv); - auto stable_mu_deriv = -stable_y_deriv; - auto stable_sigma_deriv - = elt_multiply(cdf_term_1_weight, - -elt_multiply(dlog_cdf_term_1, - elt_multiply(scaled_diff, sigma_inv))) - - elt_multiply( - cdf_term_2_weight, - elt_multiply(lambda_val, v) - - elt_multiply( - dlog_cdf_term_2_phi, - elt_multiply(scaled_diff + v * INV_SQRT_TWO, sigma_inv))); - auto stable_lambda_deriv = -elt_multiply( - cdf_term_2_weight, - elt_multiply(v, sigma_val) - diff - - elt_multiply(dlog_cdf_term_2_phi, sigma_val * INV_SQRT_TWO)); - auto cdf_log_expr - = colwise_sum(select(use_stable, log_cdf_n, direct_cdf_log)); - auto y_deriv = select(use_stable, stable_y_deriv, direct_y_deriv); - auto mu_deriv = select(use_stable, stable_mu_deriv, direct_mu_deriv); - auto sigma_deriv = select(use_stable, stable_sigma_deriv, direct_sigma_deriv); - auto lambda_deriv - = select(use_stable, stable_lambda_deriv, direct_lambda_deriv); + // Value and partials with respect to z, v and sigma d/dsigma at fixed y, + // mu and lambda. The four device functions share one implementation. + auto lp = [&]() { + if constexpr (upper) { + return exp_mod_normal_lccdf_value(z, v); + } else { + return exp_mod_normal_lcdf_value(z, v); + } + }(); + auto d_z = [&]() { + if constexpr (upper) { + return exp_mod_normal_lccdf_d_z(z, v); + } else { + return exp_mod_normal_lcdf_d_z(z, v); + } + }(); + auto d_v = [&]() { + if constexpr (upper) { + return exp_mod_normal_lccdf_d_v(z, v); + } else { + return exp_mod_normal_lcdf_d_v(z, v); + } + }(); + auto d_s = [&]() { + if constexpr (upper) { + return exp_mod_normal_lccdf_d_s(z, v); + } else { + return exp_mod_normal_lcdf_d_s(z, v); + } + }(); + auto cdf_log_expr = colwise_sum(lp); + auto y_deriv = elt_divide(d_z, sigma_val); + auto mu_deriv = -y_deriv; + auto sigma_deriv = elt_divide(d_s, sigma_val); + auto lambda_deriv = elt_multiply(d_v, sigma_val); matrix_cl any_y_neg_inf_cl; matrix_cl any_y_pos_inf_cl; matrix_cl cdf_log_cl; - matrix_cl mu_deriv_cl; matrix_cl y_deriv_cl; + matrix_cl mu_deriv_cl; matrix_cl sigma_deriv_cl; matrix_cl lambda_deriv_cl; @@ -166,15 +113,14 @@ exp_mod_normal_lcdf(const T_y_cl& y, const T_loc_cl& mu, calc_if>(sigma_deriv), calc_if>(lambda_deriv)); - if (from_matrix_cl(any_y_pos_inf_cl).maxCoeff()) { - return 0.0; - } - if (from_matrix_cl(any_y_neg_inf_cl).maxCoeff()) { - return NEGATIVE_INFTY; + return upper ? 0.0 : NEGATIVE_INFTY; + } + if (from_matrix_cl(any_y_pos_inf_cl).maxCoeff()) { + return upper ? NEGATIVE_INFTY : 0.0; } - T_partials_return cdf_log = (from_matrix_cl(cdf_log_cl)).sum(); + double cdf_log = sum(from_matrix_cl(cdf_log_cl)); auto ops_partials = make_partials_propagator(y_col, mu_col, sigma_col, lambda_col); @@ -194,6 +140,21 @@ exp_mod_normal_lcdf(const T_y_cl& y, const T_loc_cl& mu, return ops_partials.build(cdf_log); } +} // namespace internal + +template * = nullptr, + require_any_not_stan_scalar_t* = nullptr> +inline return_type_t +exp_mod_normal_lcdf(const T_y_cl& y, const T_loc_cl& mu, + const T_scale_cl& sigma, const T_inv_scale_cl& lambda) { + return internal::exp_mod_normal_lcdf_opencl_impl( + "exp_mod_normal_lcdf(OpenCL)", y, mu, sigma, lambda); +} + } // namespace math } // namespace stan #endif diff --git a/stan/math/opencl/prim/exp_mod_normal_lpdf.hpp b/stan/math/opencl/prim/exp_mod_normal_lpdf.hpp index 00bb0440cf8..378341c0351 100644 --- a/stan/math/opencl/prim/exp_mod_normal_lpdf.hpp +++ b/stan/math/opencl/prim/exp_mod_normal_lpdf.hpp @@ -40,8 +40,6 @@ inline return_type_t exp_mod_normal_lpdf(const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma, const T_inv_scale_cl& lambda) { static constexpr const char* function = "exp_mod_normal_lpdf(OpenCL)"; - using T_partials_return - = partials_return_t; using std::isfinite; using std::isnan; @@ -52,8 +50,9 @@ exp_mod_normal_lpdf(const T_y_cl& y, const T_loc_cl& mu, if (N == 0) { return 0.0; } - if (!include_summand::value) { + if constexpr (propto + && !is_any_autodiff_v) { return 0.0; } @@ -81,33 +80,29 @@ exp_mod_normal_lpdf(const T_y_cl& y, const T_loc_cl& mu, auto lambda_positive_finite_expr = isfinite(lambda_val) && lambda_val > 0; auto inv_sigma_expr = elt_divide(1.0, sigma_val); - auto sigma_sq_expr = elt_multiply(sigma_val, sigma_val); + auto sigma_sq_expr = square(sigma_val); auto lambda_sigma_sq_expr = elt_multiply(lambda_val, sigma_sq_expr); auto mu_minus_y_expr = mu_val - y_val; - auto inner_term_expr = elt_multiply(mu_minus_y_expr + lambda_sigma_sq_expr, - INV_SQRT_TWO * inv_sigma_expr); - auto erfc_calc_expr = erfc(inner_term_expr); + // log(erfc(t) / 2) = log Phi(-sqrt(2) t) cancels the log(1/2) constant. + auto z_expr + = -elt_multiply(mu_minus_y_expr + lambda_sigma_sq_expr, inv_sigma_expr); auto logp1_expr = elt_multiply(lambda_val, mu_minus_y_expr + 0.5 * lambda_sigma_sq_expr) - + log(erfc_calc_expr); - auto logp_expr = colwise_sum( - static_select::value>( + + math::std_normal_lcdf_impl(z_expr); + auto logp_expr + = colwise_sum(static_select<(!propto || is_autodiff_v)>( logp1_expr + log(lambda_val), logp1_expr)); - auto deriv_logerfc_expr - = elt_divide(-SQRT_TWO_OVER_SQRT_PI - * exp(-elt_multiply(inner_term_expr, inner_term_expr)), - erfc_calc_expr); - auto deriv_expr - = lambda_val + elt_multiply(deriv_logerfc_expr, inv_sigma_expr); + auto slope_expr = std_normal_lcdf_derivative(z_expr); + auto deriv_expr = lambda_val - elt_multiply(slope_expr, inv_sigma_expr); auto deriv_sigma_expr - = elt_multiply(sigma_val, elt_multiply(lambda_val, lambda_val)) - + elt_multiply( - deriv_logerfc_expr, - (lambda_val - elt_divide(mu_minus_y_expr, sigma_sq_expr))); + = elt_multiply(sigma_val, square(lambda_val)) + - elt_multiply( + slope_expr, + lambda_val - elt_multiply(mu_minus_y_expr, square(inv_sigma_expr))); auto deriv_lambda_expr = elt_divide(1.0, lambda_val) + lambda_sigma_sq_expr + mu_minus_y_expr - + elt_multiply(deriv_logerfc_expr, sigma_val); + - elt_multiply(slope_expr, sigma_val); matrix_cl logp_cl; matrix_cl y_deriv_cl; @@ -125,11 +120,6 @@ exp_mod_normal_lpdf(const T_y_cl& y, const T_loc_cl& mu, calc_if>(deriv_sigma_expr), calc_if>(deriv_lambda_expr)); - T_partials_return logp = sum(from_matrix_cl(logp_cl)); - if constexpr (include_summand::value) { - logp -= LOG_TWO * N; - } - auto ops_partials = make_partials_propagator(y_col, mu_col, sigma_col, lambda_col); if constexpr (is_autodiff_v) { @@ -144,7 +134,7 @@ exp_mod_normal_lpdf(const T_y_cl& y, const T_loc_cl& mu, if constexpr (is_autodiff_v) { partials<3>(ops_partials) = std::move(lambda_deriv_cl); } - return ops_partials.build(logp); + return ops_partials.build(sum(from_matrix_cl(logp_cl))); } } // namespace math diff --git a/stan/math/opencl/prim/lognormal_cdf.hpp b/stan/math/opencl/prim/lognormal_cdf.hpp index 19781c96639..6217b1d17da 100644 --- a/stan/math/opencl/prim/lognormal_cdf.hpp +++ b/stan/math/opencl/prim/lognormal_cdf.hpp @@ -3,29 +3,12 @@ #ifdef STAN_OPENCL #include -#include -#include -#include -#include -#include -#include +#include +#include namespace stan { namespace math { -/** \ingroup opencl - * Returns the loghormal cumulative distribution function for the given - * location, and scale. If given containers of matching sizes - * returns the product of probabilities. - * - * @tparam T_y_cl type of scalar outcome - * @tparam T_loc_cl type of location - * @tparam T_scale_cl type of scale - * @param y (Sequence of) scalar(s). - * @param mu (Sequence of) location(s). - * @param sigma (Sequence of) scale(s). - * @return The log of the product of densities. - */ template < typename T_y_cl, typename T_loc_cl, typename T_scale_cl, require_all_prim_or_rev_kernel_expression_t* = nullptr> inline return_type_t lognormal_cdf( const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma) { - static constexpr const char* function = "lognormal_cdf(OpenCL)"; - using T_partials_return = partials_return_t; - using std::isfinite; - using std::isnan; - - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma); - const size_t N = max_size(y, mu, sigma); - if (N == 0) { - return 1.0; - } - - const auto& y_col = as_column_vector_or_scalar(y); - const auto& mu_col = as_column_vector_or_scalar(mu); - const auto& sigma_col = as_column_vector_or_scalar(sigma); - - const auto& y_val = value_of(y_col); - const auto& mu_val = value_of(mu_col); - const auto& sigma_val = value_of(sigma_col); - - auto check_y_nonnegative - = check_cl(function, "Random variable", y_val, "nonnegative"); - auto y_nonnegative_expr = 0.0 <= y_val; - auto check_mu_finite - = check_cl(function, "Location parameter", mu_val, "finite"); - auto mu_finite_expr = isfinite(mu_val); - auto check_sigma_positive_finite - = check_cl(function, "Scale parameter", sigma_val, "positive finite"); - auto sigma_positive_finite_expr = 0 < sigma_val && isfinite(sigma_val); - - auto any_y_zero = colwise_max(cast(y_val == 0.0)); - auto log_y = log(y_val); - auto scaled_diff = elt_divide(log_y - mu_val, sigma_val * SQRT_TWO); - auto erfc_m_diff = erfc(-scaled_diff); - auto cdf_n = 0.5 * erfc_m_diff; - auto cdf_expr = colwise_prod(cdf_n); - auto mu_deriv_tmp - = -INV_SQRT_TWO_PI - * elt_divide(exp(-square(scaled_diff)), elt_multiply(sigma_val, cdf_n)); - auto y_deriv_tmp = elt_divide(-mu_deriv_tmp, y_val); - auto sigma_deriv_tmp = elt_multiply(mu_deriv_tmp, scaled_diff * SQRT_TWO); - - matrix_cl any_y_zero_cl; - matrix_cl cdf_cl; - matrix_cl mu_deriv_cl; - matrix_cl y_deriv_cl; - matrix_cl sigma_deriv_cl; - - results(check_y_nonnegative, check_mu_finite, check_sigma_positive_finite, - any_y_zero_cl, cdf_cl, y_deriv_cl, mu_deriv_cl, sigma_deriv_cl) - = expressions(y_nonnegative_expr, mu_finite_expr, - sigma_positive_finite_expr, any_y_zero, cdf_expr, - calc_if>(y_deriv_tmp), - calc_if>(mu_deriv_tmp), - calc_if>(sigma_deriv_tmp)); - - if (from_matrix_cl(any_y_zero_cl).maxCoeff()) { - return 0.0; - } - - T_partials_return cdf = (from_matrix_cl(cdf_cl)).prod(); - - auto mu_deriv = mu_deriv_cl * cdf; - auto y_deriv = y_deriv_cl * cdf; - auto sigma_deriv = sigma_deriv_cl * cdf; - - results(mu_deriv_cl, y_deriv_cl, sigma_deriv_cl) - = expressions(calc_if>(mu_deriv), - calc_if>(y_deriv), - calc_if>(sigma_deriv)); - - auto ops_partials = make_partials_propagator(y_col, mu_col, sigma_col); - - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = std::move(y_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = std::move(mu_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = std::move(sigma_deriv_cl); - } - return ops_partials.build(cdf); + return exp(internal::lognormal_lcdf_opencl_impl( + "lognormal_cdf(OpenCL)", y, mu, sigma)); } } // namespace math diff --git a/stan/math/opencl/prim/lognormal_lccdf.hpp b/stan/math/opencl/prim/lognormal_lccdf.hpp index af407a42967..76a0a1d58dd 100644 --- a/stan/math/opencl/prim/lognormal_lccdf.hpp +++ b/stan/math/opencl/prim/lognormal_lccdf.hpp @@ -3,29 +3,11 @@ #ifdef STAN_OPENCL #include -#include -#include -#include -#include -#include -#include +#include namespace stan { namespace math { -/** \ingroup opencl - * Returns the lognormal log complementary cumulative distribution function - * for the given location, and scale. If given containers of matching sizes - * returns the log sum of probabilities. - * - * @tparam T_y_cl type of scalar outcome - * @tparam T_loc_cl type of location - * @tparam T_scale_cl type of scale - * @param y (Sequence of) scalar(s). - * @param mu (Sequence of) location(s). - * @param sigma (Sequence of) scale(s). - * @return The log of the product of densities. - */ template < typename T_y_cl, typename T_loc_cl, typename T_scale_cl, require_all_prim_or_rev_kernel_expression_t* = nullptr> inline return_type_t lognormal_lccdf( const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma) { - static constexpr const char* function = "lognormal_lccdf(OpenCL)"; - using T_partials_return = partials_return_t; - using std::isfinite; - using std::isnan; - - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma); - const size_t N = max_size(y, mu, sigma); - if (N == 0) { - return 0.0; - } - - const auto& y_col = as_column_vector_or_scalar(y); - const auto& mu_col = as_column_vector_or_scalar(mu); - const auto& sigma_col = as_column_vector_or_scalar(sigma); - - const auto& y_val = value_of(y_col); - const auto& mu_val = value_of(mu_col); - const auto& sigma_val = value_of(sigma_col); - - auto check_y_nonnegative - = check_cl(function, "Random variable", y_val, "nonnegative"); - auto y_nonnegative = 0.0 <= y_val; - auto check_mu_finite - = check_cl(function, "Location parameter", mu_val, "finite"); - auto mu_finite_expr = isfinite(mu_val); - auto check_sigma_positive_finite - = check_cl(function, "Scale parameter", sigma_val, "positive finite"); - auto sigma_positive_finite_expr = 0 < sigma_val && isfinite(sigma_val); - - auto any_y_zero = colwise_max(cast(y_val == 0.0)); - auto log_y = log(y_val); - auto scaled_diff = elt_divide(log_y - mu_val, sigma_val * SQRT_TWO); - auto erfc_calc = erfc(scaled_diff); - auto lccdf_expr = colwise_sum(log(erfc_calc)); - auto mu_deriv = elt_divide(SQRT_TWO_OVER_SQRT_PI * exp(-square(scaled_diff)), - elt_multiply(sigma_val, erfc_calc)); - auto y_deriv = elt_divide(mu_deriv, -y_val); - auto sigma_deriv = elt_multiply(mu_deriv, scaled_diff * SQRT_TWO); - - matrix_cl any_y_zero_cl; - matrix_cl lccdf_cl; - matrix_cl y_deriv_cl; - matrix_cl mu_deriv_cl; - matrix_cl sigma_deriv_cl; - - results(check_y_nonnegative, check_mu_finite, check_sigma_positive_finite, - any_y_zero_cl, lccdf_cl, y_deriv_cl, mu_deriv_cl, sigma_deriv_cl) - = expressions(y_nonnegative, mu_finite_expr, sigma_positive_finite_expr, - any_y_zero, lccdf_expr, - calc_if>(y_deriv), - calc_if>(mu_deriv), - calc_if>(sigma_deriv)); - - if (from_matrix_cl(any_y_zero_cl).maxCoeff()) { - return 0.0; - } - - T_partials_return lccdf = N * LOG_HALF + sum(from_matrix_cl(lccdf_cl)); - - auto ops_partials = make_partials_propagator(y_col, mu_col, sigma_col); - - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = std::move(y_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = std::move(mu_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = std::move(sigma_deriv_cl); - } - return ops_partials.build(lccdf); + return internal::lognormal_lcdf_opencl_impl("lognormal_lccdf(OpenCL)", + y, mu, sigma); } } // namespace math diff --git a/stan/math/opencl/prim/lognormal_lcdf.hpp b/stan/math/opencl/prim/lognormal_lcdf.hpp index 3f977a24e0a..31d79939311 100644 --- a/stan/math/opencl/prim/lognormal_lcdf.hpp +++ b/stan/math/opencl/prim/lognormal_lcdf.hpp @@ -12,29 +12,13 @@ namespace stan { namespace math { +namespace internal { -/** \ingroup opencl - * Returns the lognormal log cumulative distribution function - * for the given location, and scale. If given containers of matching sizes - * returns the log sum of probabilities. - * - * @tparam T_y_cl type of scalar outcome - * @tparam T_loc_cl type of location - * @tparam T_scale_cl type of scale - * @param y (Sequence of) scalar(s). - * @param mu (Sequence of) location(s). - * @param sigma (Sequence of) scale(s). - * @return The log of the product of densities. - */ -template < - typename T_y_cl, typename T_loc_cl, typename T_scale_cl, - require_all_prim_or_rev_kernel_expression_t* = nullptr, - require_any_not_stan_scalar_t* = nullptr> -inline return_type_t lognormal_lcdf( - const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma) { - static constexpr const char* function = "lognormal_lcdf(OpenCL)"; - using T_partials_return = partials_return_t; +template +inline return_type_t lognormal_lcdf_opencl_impl( + const char* function, const T_y_cl& y, const T_loc_cl& mu, + const T_scale_cl& sigma) { + constexpr double sign = reflect ? -1.0 : 1.0; using std::isfinite; using std::isnan; @@ -64,14 +48,13 @@ inline return_type_t lognormal_lcdf( auto sigma_positive_finite_expr = 0 < sigma_val && isfinite(sigma_val); auto any_y_zero = colwise_max(cast(y_val == 0.0)); - auto log_y = log(y_val); - auto scaled_diff = elt_divide(log_y - mu_val, sigma_val * SQRT_TWO); - auto erfc_calc = erfc(-scaled_diff); - auto lcdf_expr = colwise_sum(log(erfc_calc)); - auto mu_deriv = elt_divide(-SQRT_TWO_OVER_SQRT_PI * exp(-square(scaled_diff)), - elt_multiply(sigma_val, erfc_calc)); - auto y_deriv = elt_divide(mu_deriv, -y_val); - auto sigma_deriv = elt_multiply(mu_deriv, scaled_diff * SQRT_TWO); + auto z = sign * elt_divide(log(y_val) - mu_val, sigma_val); + auto lcdf_expr = colwise_sum(math::std_normal_lcdf_impl(z)); + auto slope = std_normal_lcdf_derivative(z); + auto scaled_slope = elt_divide(slope, sigma_val); + auto y_deriv = sign * elt_divide(scaled_slope, y_val); + auto mu_deriv = -sign * scaled_slope; + auto sigma_deriv = select(slope == 0, 0.0, -elt_multiply(scaled_slope, z)); matrix_cl any_y_zero_cl; matrix_cl lcdf_cl; @@ -88,10 +71,10 @@ inline return_type_t lognormal_lcdf( calc_if>(sigma_deriv)); if (from_matrix_cl(any_y_zero_cl).maxCoeff()) { - return NEGATIVE_INFTY; + return reflect ? 0.0 : NEGATIVE_INFTY; } - T_partials_return lcdf = N * LOG_HALF + sum(from_matrix_cl(lcdf_cl)); + double lcdf = sum(from_matrix_cl(lcdf_cl)); auto ops_partials = make_partials_propagator(y_col, mu_col, sigma_col); @@ -107,6 +90,19 @@ inline return_type_t lognormal_lcdf( return ops_partials.build(lcdf); } +} // namespace internal + +template < + typename T_y_cl, typename T_loc_cl, typename T_scale_cl, + require_all_prim_or_rev_kernel_expression_t* = nullptr, + require_any_not_stan_scalar_t* = nullptr> +inline return_type_t lognormal_lcdf( + const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma) { + return internal::lognormal_lcdf_opencl_impl("lognormal_lcdf(OpenCL)", + y, mu, sigma); +} + } // namespace math } // namespace stan #endif diff --git a/stan/math/opencl/prim/normal_cdf.hpp b/stan/math/opencl/prim/normal_cdf.hpp index 2e764e8eb81..50130de43e2 100644 --- a/stan/math/opencl/prim/normal_cdf.hpp +++ b/stan/math/opencl/prim/normal_cdf.hpp @@ -3,20 +3,16 @@ #ifdef STAN_OPENCL #include -#include -#include -#include -#include -#include -#include +#include +#include namespace stan { namespace math { /** \ingroup opencl * Returns the normal cumulative distribution function for the given - * location, and scale. If given containers of matching sizes - * returns the product of probabilities. + * location and scale. If given containers of matching sizes, returns the + * product of probabilities. * * @tparam T_y_cl type of scalar outcome * @tparam T_loc_cl type of location @@ -24,7 +20,7 @@ namespace math { * @param y (Sequence of) scalar(s). * @param mu (Sequence of) location(s). * @param sigma (Sequence of) scale(s). - * @return The log of the product of densities. + * @return The product of cumulative probabilities. */ template < typename T_y_cl, typename T_loc_cl, typename T_scale_cl, @@ -32,85 +28,10 @@ template < T_scale_cl>* = nullptr, require_any_not_stan_scalar_t* = nullptr> inline return_type_t normal_cdf( - const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma) { - static constexpr const char* function = "normal_cdf(OpenCL)"; - using T_partials_return = partials_return_t; - using std::isfinite; - using std::isnan; - - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma); - const size_t N = max_size(y, mu, sigma); - if (N == 0) { - return 1.0; - } - - const auto& y_col = as_column_vector_or_scalar(y); - const auto& mu_col = as_column_vector_or_scalar(mu); - const auto& sigma_col = as_column_vector_or_scalar(sigma); - - const auto& y_val = value_of(y_col); - const auto& mu_val = value_of(mu_col); - const auto& sigma_val = value_of(sigma_col); - - auto check_y_not_nan - = check_cl(function, "Random variable", y_val, "not NaN"); - auto y_not_nan_expr = !isnan(y_val); - auto check_mu_finite - = check_cl(function, "Location parameter", mu_val, "finite"); - auto mu_finite_expr = isfinite(mu_val); - auto check_sigma_positive - = check_cl(function, "Scale parameter", sigma_val, "positive"); - auto sigma_positive_expr = 0 < sigma_val; - - auto scaled_diff = elt_divide(y_val - mu_val, sigma_val * SQRT_TWO); - auto cdf_n = select( - scaled_diff < -37.5 * INV_SQRT_TWO, 0.0, - select(scaled_diff < -5.0 * INV_SQRT_TWO, 0.5 * erfc(-scaled_diff), - select(scaled_diff > 8.25 * INV_SQRT_TWO, 1.0, - 0.5 * (1.0 + erf(scaled_diff))))); - auto cdf_expr = colwise_prod(cdf_n); - auto mu_deriv_tmp = select(scaled_diff < -37.5 * INV_SQRT_TWO, 0.0, - INV_SQRT_TWO_PI - * elt_divide(exp(-square(scaled_diff)), - elt_multiply(cdf_n, sigma_val))); - auto sigma_deriv_tmp = elt_multiply(mu_deriv_tmp, scaled_diff); - - matrix_cl cdf_cl; - matrix_cl mu_deriv_cl; - matrix_cl y_deriv_cl; - matrix_cl sigma_deriv_cl; - - results(check_y_not_nan, check_mu_finite, check_sigma_positive, cdf_cl, - mu_deriv_cl, sigma_deriv_cl) - = expressions(y_not_nan_expr, mu_finite_expr, sigma_positive_expr, - cdf_expr, - calc_if>(mu_deriv_tmp), - calc_if>(sigma_deriv_tmp)); - - T_partials_return cdf = (from_matrix_cl(cdf_cl)).prod(); - - auto y_deriv = elt_multiply(mu_deriv_cl, cdf); - auto mu_deriv = -y_deriv; - auto sigma_deriv = elt_multiply(sigma_deriv_cl, -SQRT_TWO * cdf); - - results(mu_deriv_cl, y_deriv_cl, sigma_deriv_cl) - = expressions(calc_if>(mu_deriv), - calc_if>(y_deriv), - calc_if>(sigma_deriv)); - - auto ops_partials = make_partials_propagator(y_col, mu_col, sigma_col); - - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = std::move(y_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = std::move(mu_deriv_cl); - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = std::move(sigma_deriv_cl); - } - return ops_partials.build(cdf); + T_y_cl&& y, T_loc_cl&& mu, T_scale_cl&& sigma) { + return exp(internal::normal_lcdf_opencl_impl( + "normal_cdf(OpenCL)", std::forward(y), std::forward(mu), + std::forward(sigma))); } } // namespace math diff --git a/stan/math/opencl/prim/normal_lccdf.hpp b/stan/math/opencl/prim/normal_lccdf.hpp index 25f4f6ed0d8..1cf87ed28e8 100644 --- a/stan/math/opencl/prim/normal_lccdf.hpp +++ b/stan/math/opencl/prim/normal_lccdf.hpp @@ -6,31 +6,17 @@ namespace stan { namespace math { -namespace internal { -constexpr char normal_lccdf_opencl_func[] = "normal_lccdf(OpenCL)"; -} // namespace internal -/** \ingroup opencl - * Returns the normal log complementary cumulative distribution function - * for the given location, and scale. If given containers of matching sizes - * returns the log sum of probabilities. - * - * @tparam T_y_cl type of scalar outcome - * @tparam T_loc_cl type of location - * @tparam T_scale_cl type of scale - * @param y (Sequence of) scalar(s). - * @param mu (Sequence of) location(s). - * @param sigma (Sequence of) scale(s). - * @return The log of the product of densities. - */ template < typename T_y_cl, typename T_loc_cl, typename T_scale_cl, require_all_prim_or_rev_kernel_expression_t* = nullptr, require_any_not_stan_scalar_t* = nullptr> inline return_type_t normal_lccdf( - const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma) { - return normal_lcdf(-y, -mu, sigma); + T_y_cl&& y, T_loc_cl&& mu, T_scale_cl&& sigma) { + return internal::normal_lcdf_opencl_impl( + "normal_lccdf(OpenCL)", std::forward(y), + std::forward(mu), std::forward(sigma)); } } // namespace math diff --git a/stan/math/opencl/prim/normal_lcdf.hpp b/stan/math/opencl/prim/normal_lcdf.hpp index 187eda05866..b540905b9f4 100644 --- a/stan/math/opencl/prim/normal_lcdf.hpp +++ b/stan/math/opencl/prim/normal_lcdf.hpp @@ -13,189 +13,12 @@ namespace stan { namespace math { namespace internal { -constexpr char normal_lcdf_opencl_func[] = "normal_lcdf(OpenCL)"; -const char opencl_normal_lcdf_impl[] = STRINGIFY( - double x2 = normal_lcdf_scaled_diff * normal_lcdf_scaled_diff; - double normal_lcdf_n = 0; - // Rigorous numerical approximations are applied here to deal with values - // of |normal_lcdf_scaled_diff|>>0. This is needed to deal with rare - // base-rate logistic regression problems where it is useful to use an - // alternative link function instead. - // - // use erfc() instead of erf() in order to retain precision - // since for x>0 erfc()->0 - if (normal_lcdf_scaled_diff > 0.0) { - // CDF(x) = 1/2 + 1/2erf(x) = 1 - 1/2erfc(x) - normal_lcdf_n = log1p(-0.5 * erfc(normal_lcdf_scaled_diff)); - if (isnan(normal_lcdf_n)) { - normal_lcdf_n = 0; - } - } else if (normal_lcdf_scaled_diff > -4.0) { - // CDF(x) = 1/2 - 1/2erf(-x) = 1/2erfc(-x) - normal_lcdf_n = log(erfc(-normal_lcdf_scaled_diff)) - M_LN2; - } else if (10.0 * log(fabs(normal_lcdf_scaled_diff)) < log(DBL_MAX)) { - // entering territory where erfc(-x)~0 - // need to use direct numerical approximation of normal_lcdf_n instead - // the following based on W. J. Cody, Math. Comp. 23(107):631-638 (1969) - // CDF(x) = 1/2erfc(-x) - double x4 = pow(normal_lcdf_scaled_diff, 4); - double x6 = pow(normal_lcdf_scaled_diff, 6); - double x8 = pow(normal_lcdf_scaled_diff, 8); - double x10 = pow(normal_lcdf_scaled_diff, 10); - double temp_p - = 0.000658749161529837803157 + 0.0160837851487422766278 / x2 - + 0.125781726111229246204 / x4 + 0.360344899949804439429 / x6 - + 0.305326634961232344035 / x8 + 0.0163153871373020978498 / x10; - double temp_q = -0.00233520497626869185443 - 0.0605183413124413191178 / x2 - - 0.527905102951428412248 / x4 - - 1.87295284992346047209 / x6 - - 2.56852019228982242072 / x8 - 1.0 / x10; - normal_lcdf_n = -M_LN2 + log(0.5 * M_2_SQRTPI + (temp_p / temp_q) / x2) - - log(-normal_lcdf_scaled_diff) - x2; - } else { - // normal_lcdf_scaled_diff^10 term will overflow - normal_lcdf_n = -INFINITY; - }); -// NOLINTBEGIN -const char opencl_normal_lcdf_ldncdf_impl[] = STRINGIFY( - double normal_ldncdf = 0.0; double t = 0.0; double t2 = 0.0; - double t4 = 0.0; double normal_lcdf_exp_m_x2 = 0.0; - double normal_lcdf_inv_x2 = 0.0; - // calculate using piecewise function - // (due to instability / inaccuracy in the various approximations) - if (normal_lcdf_deriv_scaled_diff > 2.9) { - // approximation derived from Abramowitz and Stegun (1964) 7.1.26 - t = 1.0 / (1.0 + 0.3275911 * normal_lcdf_deriv_scaled_diff); - t2 = t * t; - t4 = pow(t, 4); - // A&S 7.1.26 keeps exp(-x2) in the numerator, as R's pnorm do_del - // does; refs in stan/math/prim/prob/normal_lcdf.hpp - normal_lcdf_exp_m_x2 = exp(-x2); - normal_ldncdf - = 0.5 * M_2_SQRTPI * normal_lcdf_exp_m_x2 - / (1.0 - - normal_lcdf_exp_m_x2 - * (0.254829592 - 0.284496736 * t + 1.421413741 * t2 - - 1.453152027 * t2 * t + 1.061405429 * t4)); - } else if (normal_lcdf_deriv_scaled_diff > 2.5) { - // in the trouble area where all of the standard numerical - // approximations are unstable - bridge the gap using Taylor - // expansions of the analytic function - // use Taylor expansion centred around x=2.7 - t = normal_lcdf_deriv_scaled_diff - 2.7; - t2 = t * t; - t4 = pow(t, 4); - normal_ldncdf = 0.0003849882382 - 0.002079084702 * t + 0.005229340880 * t2 - - 0.008029540137 * t2 * t + 0.008232190507 * t4 - - 0.005692364250 * t4 * t + 0.002399496363 * pow(t, 6); - } else if (normal_lcdf_deriv_scaled_diff > 2.1) { - // use Taylor expansion centred around x=2.3 - t = normal_lcdf_deriv_scaled_diff - 2.3; - t2 = t * t; - t4 = pow(t, 4); - normal_ldncdf = 0.002846135439 - 0.01310032351 * t + 0.02732189391 * t2 - - 0.03326906904 * t2 * t + 0.02482478940 * t4 - - 0.009883071924 * t4 * t - 0.0002771362254 * pow(t, 6); - } else if (normal_lcdf_deriv_scaled_diff > 1.5) { - // use Taylor expansion centred around x=1.85 - t = normal_lcdf_deriv_scaled_diff - 1.85; - t2 = t * t; - t4 = pow(t, 4); - normal_ldncdf = 0.01849212058 - 0.06876280470 * t + 0.1099906382 * t2 - - 0.09274533184 * t2 * t + 0.03543327418 * t4 - + 0.005644855518 * t4 * t - 0.01111434424 * pow(t, 6); - } else if (normal_lcdf_deriv_scaled_diff > 0.8) { - // use Taylor expansion centred around x=1.15 - t = normal_lcdf_deriv_scaled_diff - 1.15; - t2 = t * t; - t4 = pow(t, 4); - normal_ldncdf = 0.1585747034 - 0.3898677543 * t + 0.3515963775 * t2 - - 0.09748053605 * t2 * t - 0.04347986191 * t4 - + 0.02182506378 * t4 * t + 0.01074751427 * pow(t, 6); - } else if (normal_lcdf_deriv_scaled_diff > 0.1) { - // use Taylor expansion centred around x=0.45 - t = normal_lcdf_deriv_scaled_diff - 0.45; - t2 = t * t; - t4 = pow(t, 4); - normal_ldncdf = 0.6245634904 - 0.9521866949 * t + 0.3986215682 * t2 - + 0.04700850676 * t2 * t - 0.03478651979 * t4 - - 0.01772675404 * t4 * t + 0.0006577254811 * pow(t, 6); - } else if (normal_lcdf_deriv_scaled_diff < -29.0) { - // asymptotic Mills ratio, DLMF 7.12.1; grows linearly as -2*scaled_diff, - // so no quadratic fit can track it. Same 1/x^2 series shape as R's pnorm - normal_lcdf_inv_x2 = 1.0 / x2; - normal_ldncdf - = -2.0 * normal_lcdf_deriv_scaled_diff - / (1.0 - + normal_lcdf_inv_x2 - * (-0.5 - + normal_lcdf_inv_x2 - * (0.75 + normal_lcdf_inv_x2 * -1.875))); - } else if (10.0 * log(fabs(normal_lcdf_deriv_scaled_diff)) < log(DBL_MAX)) { - // approximation derived from Abramowitz and Stegun (1964) 7.1.26 - // use fact that erf(x)=-erf(-x) - // Abramowitz and Stegun define this for -inf* = nullptr, - require_any_not_stan_scalar_t* = nullptr> -inline return_type_t normal_lcdf( - const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma) { - static constexpr const char* function = func; +template +inline return_type_t normal_lcdf_opencl_impl( + const char* function, const T_y_cl& y, const T_loc_cl& mu, + const T_scale_cl& sigma) { + constexpr double sign = reflect ? -1.0 : 1.0; using std::isfinite; using std::isnan; @@ -224,22 +47,13 @@ inline return_type_t normal_lcdf( = check_cl(function, "Scale parameter", sigma_val, "positive"); auto sigma_positive_expr = 0 < sigma_val; - auto scaled_diff = elt_divide(y_val - mu_val, sigma_val * SQRT_TWO); - - auto sigma_sqrt2 = sigma_val * SQRT_TWO; - - auto lcdf_n = opencl_code( - std::make_tuple("normal_lcdf_scaled_diff"), scaled_diff) - .template output("normal_lcdf_n"); - auto lcdf_expr = colwise_sum(lcdf_n); - - auto ldncdf - = opencl_code( - std::make_tuple("normal_lcdf_deriv_scaled_diff"), scaled_diff) - .template output("normal_ldncdf"); - auto y_deriv = elt_divide(ldncdf, sigma_sqrt2); + auto z = sign * elt_divide(y_val - mu_val, sigma_val); + auto lcdf_expr = colwise_sum(math::std_normal_lcdf_impl(z)); + auto slope = std_normal_lcdf_derivative(z); + auto scaled_slope = elt_divide(slope, sigma_val); + auto y_deriv = sign * scaled_slope; auto mu_deriv = -y_deriv; - auto sigma_deriv = -elt_divide(elt_multiply(ldncdf, scaled_diff), sigma_val); + auto sigma_deriv = select(slope == 0, 0.0, -elt_multiply(scaled_slope, z)); matrix_cl lcdf_cl; matrix_cl y_deriv_cl; @@ -269,6 +83,33 @@ inline return_type_t normal_lcdf( return ops_partials.build(lcdf); } +} // namespace internal + +/** \ingroup opencl + * Returns the normal log cumulative distribution function for the given + * location and scale. If given containers of matching sizes, returns the + * sum of log probabilities. + * + * @tparam T_y_cl type of scalar outcome + * @tparam T_loc_cl type of location + * @tparam T_scale_cl type of scale + * @param y (Sequence of) scalar(s). + * @param mu (Sequence of) location(s). + * @param sigma (Sequence of) scale(s). + * @return The log of the product of cumulative probabilities. + */ +template < + typename T_y_cl, typename T_loc_cl, typename T_scale_cl, + require_all_prim_or_rev_kernel_expression_t* = nullptr, + require_any_not_stan_scalar_t* = nullptr> +inline return_type_t normal_lcdf( + T_y_cl&& y, T_loc_cl&& mu, T_scale_cl&& sigma) { + return internal::normal_lcdf_opencl_impl( + "normal_lcdf(OpenCL)", std::forward(y), + std::forward(mu), std::forward(sigma)); +} + } // namespace math } // namespace stan #endif diff --git a/stan/math/opencl/prim/skew_normal_lpdf.hpp b/stan/math/opencl/prim/skew_normal_lpdf.hpp index 8a02bd379be..c9ede074014 100644 --- a/stan/math/opencl/prim/skew_normal_lpdf.hpp +++ b/stan/math/opencl/prim/skew_normal_lpdf.hpp @@ -43,8 +43,6 @@ inline return_type_t skew_normal_lpdf( const T_y_cl& y, const T_loc_cl& mu, const T_scale_cl& sigma, const T_shape_cl& alpha) { static constexpr const char* function = "skew_normal_lpdf(OpenCL)"; - using T_partials_return - = partials_return_t; using std::isfinite; using std::isnan; @@ -55,8 +53,9 @@ inline return_type_t skew_normal_lpdf( if (N == 0) { return 0.0; } - if (!include_summand::value) { + if constexpr (propto + && !is_any_autodiff_v) { return 0.0; } @@ -85,23 +84,18 @@ inline return_type_t skew_normal_lpdf( auto inv_sigma = elt_divide(1., sigma_val); auto y_minus_mu_over_sigma = elt_multiply((y_val - mu_val), inv_sigma); - auto log_erfc_alpha_z = log( - erfc(elt_multiply(alpha_val, y_minus_mu_over_sigma) * -INV_SQRT_TWO)); + auto alpha_z = elt_multiply(alpha_val, y_minus_mu_over_sigma); + auto log_erfc_alpha_z = LOG_TWO + std_normal_lcdf_impl(alpha_z); auto logp1 = log_erfc_alpha_z; - auto logp2 = static_select::value>( + auto logp2 = static_select<(!propto || is_autodiff_v)>( logp1 - log(sigma_val), logp1); auto logp_expr = colwise_sum( - static_select< - include_summand::value>( - logp2 - - elt_multiply(y_minus_mu_over_sigma, y_minus_mu_over_sigma) - * 0.5, - logp2)); + static_select<(!propto + || is_any_autodiff_v)>( + logp2 - 0.5 * square(y_minus_mu_over_sigma), logp2)); - auto scaled = elt_multiply(alpha_val, y_minus_mu_over_sigma) * INV_SQRT_TWO; - auto deriv_logerf = SQRT_TWO_OVER_SQRT_PI - * exp(-elt_multiply(scaled, scaled) - log_erfc_alpha_z); + auto deriv_logerf = std_normal_lcdf_derivative(alpha_z); auto y_loc_deriv = elt_multiply( y_minus_mu_over_sigma - elt_multiply(deriv_logerf, alpha_val), inv_sigma); auto sigma_deriv @@ -127,12 +121,6 @@ inline return_type_t skew_normal_lpdf( calc_if>(sigma_deriv), calc_if>(alpha_deriv)); - T_partials_return logp = sum(from_matrix_cl(logp_cl)); - - if constexpr (include_summand::value) { - logp -= HALF_LOG_TWO_PI * N; - } - auto ops_partials = make_partials_propagator(y_col, mu_col, sigma_col, alpha_col); @@ -148,7 +136,12 @@ inline return_type_t skew_normal_lpdf( if constexpr (is_autodiff_v) { partials<3>(ops_partials) = std::move(alpha_deriv_cl); } - return ops_partials.build(logp); + auto logp = sum(from_matrix_cl(logp_cl)); + if constexpr (!propto) { + return ops_partials.build(std::move(logp) - HALF_LOG_TWO_PI * N); + } else { + return ops_partials.build(std::move(logp)); + } } } // namespace math diff --git a/stan/math/opencl/prim/std_normal_cdf.hpp b/stan/math/opencl/prim/std_normal_cdf.hpp index 5a0cd0c1316..684293a979d 100644 --- a/stan/math/opencl/prim/std_normal_cdf.hpp +++ b/stan/math/opencl/prim/std_normal_cdf.hpp @@ -3,68 +3,26 @@ #ifdef STAN_OPENCL #include -#include -#include -#include -#include -#include -#include +#include +#include namespace stan { namespace math { /** \ingroup opencl - * Returns the standard normal cumulative distribution function. + * Returns the standard normal cumulative distribution function. If given a + * container, returns the product of probabilities. * * @tparam T_y_cl type of scalar outcome * @param y (Sequence of) scalar(s). - * @return The log of the product of densities. + * @return The product of cumulative probabilities. */ template * = nullptr, require_any_not_stan_scalar_t* = nullptr> -inline return_type_t std_normal_cdf(const T_y_cl& y) { - static constexpr const char* function = "std_normal_cdf(OpenCL)"; - using T_partials_return = partials_return_t; - using std::isfinite; - using std::isnan; - - const size_t N = math::size(y); - if (N == 0) { - return 1.0; - } - - const auto& y_col = as_column_vector_or_scalar(y); - const auto& y_val = value_of(y_col); - - auto check_y_not_nan - = check_cl(function, "Random variable", y_val, "not NaN"); - auto y_not_nan_expr = !isnan(y_val); - - auto scaled_y = y_val * INV_SQRT_TWO; - auto cdf_n - = select(y_val < -37.5, 0.0, - select(y_val < -5.0, 0.5 * erfc(-scaled_y), - select(y_val > 8.25, 1.0, 0.5 * (1.0 + erf(scaled_y))))); - auto cdf_expr = colwise_prod(cdf_n); - auto y_deriv1 - = select(y_val < -37.5, 0.0, - INV_SQRT_TWO_PI * elt_divide(exp(-square(scaled_y)), cdf_n)); - - matrix_cl cdf_cl; - matrix_cl y_deriv_cl; - - results(check_y_not_nan, cdf_cl, y_deriv_cl) = expressions( - y_not_nan_expr, cdf_expr, calc_if>(y_deriv1)); - - T_partials_return cdf = (from_matrix_cl(cdf_cl)).prod(); - - auto ops_partials = make_partials_propagator(y_col); - - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = y_deriv_cl * cdf; - } - return ops_partials.build(cdf); +inline return_type_t std_normal_cdf(T_y_cl&& y) { + return exp(internal::std_normal_lcdf_opencl_impl( + "std_normal_cdf(OpenCL)", std::forward(y))); } } // namespace math diff --git a/stan/math/opencl/prim/std_normal_lccdf.hpp b/stan/math/opencl/prim/std_normal_lccdf.hpp index 0804d5d9ad6..5eb3a1cf439 100644 --- a/stan/math/opencl/prim/std_normal_lccdf.hpp +++ b/stan/math/opencl/prim/std_normal_lccdf.hpp @@ -6,23 +6,13 @@ namespace stan { namespace math { -namespace internal { -constexpr char std_normal_lccdf_opencl_func[] = "std_normal_lccdf(OpenCL)"; -} // namespace internal -/** \ingroup opencl - * Returns the log standard normal complementary cumulative distribution - * function. - * - * @tparam T_y_cl type of scalar outcome - * @param y (Sequence of) scalar(s). - * @return The log of the product of densities. - */ template * = nullptr, require_any_not_stan_scalar_t* = nullptr> inline return_type_t std_normal_lccdf(const T_y_cl& y) { - return std_normal_lcdf(-y); + return internal::std_normal_lcdf_opencl_impl("std_normal_lccdf(OpenCL)", + y); } } // namespace math diff --git a/stan/math/opencl/prim/std_normal_lcdf.hpp b/stan/math/opencl/prim/std_normal_lcdf.hpp index 463b59b6f49..fe3c2afc504 100644 --- a/stan/math/opencl/prim/std_normal_lcdf.hpp +++ b/stan/math/opencl/prim/std_normal_lcdf.hpp @@ -14,41 +14,28 @@ namespace stan { namespace math { namespace internal { -constexpr char std_normal_lcdf_opencl_func[] = "std_normal_lcdf(OpenCL)"; -} // namespace internal -/** \ingroup opencl - * Returns the log standard normal complementary cumulative distribution - * function. - * - * @tparam T_y_cl type of scalar outcome - * @param y (Sequence of) scalar(s). - * @return The log of the product of densities. - */ -template * = nullptr, - require_any_not_stan_scalar_t* = nullptr> -inline return_type_t std_normal_lcdf(const T_y_cl& y) { - static constexpr const char* function = func; +template +inline return_type_t std_normal_lcdf_opencl_impl(const char* function, + T_y_cl&& y) { + constexpr double sign = reflect ? -1.0 : 1.0; using std::isfinite; using std::isnan; const size_t N = math::size(y); if (N == 0) { - return 1.0; + return 0.0; } - const auto& y_col = as_column_vector_or_scalar(y); - const auto& y_val = value_of(y_col); + decltype(auto) y_col = as_column_vector_or_scalar(std::forward(y)); + decltype(auto) y_val = value_of(y_col); auto check_y_not_nan = check_cl(function, "Random variable", y_val, "not NaN"); auto y_not_nan_expr = !isnan(y_val); - auto scaled_y = y_val * INV_SQRT_TWO; - auto lcdf_expr = colwise_sum(std_normal_lcdf_scaled_impl(scaled_y)); - auto dnlcdf = std_normal_lcdf_dscaled_impl(scaled_y); - auto y_deriv = dnlcdf * INV_SQRT_TWO; + auto z = sign * y_val; + auto lcdf_expr = colwise_sum(math::std_normal_lcdf_impl(z)); + auto y_deriv = sign * std_normal_lcdf_derivative(z); matrix_cl lcdf_cl; matrix_cl y_deriv_cl; @@ -66,6 +53,24 @@ inline return_type_t std_normal_lcdf(const T_y_cl& y) { return ops_partials.build(lcdf); } +} // namespace internal + +/** \ingroup opencl + * Returns the log standard normal cumulative distribution + * function. + * + * @tparam T_y_cl type of scalar outcome + * @param y (Sequence of) scalar(s). + * @return The log of the product of cumulative probabilities. + */ +template * = nullptr, + require_any_not_stan_scalar_t* = nullptr> +inline return_type_t std_normal_lcdf(T_y_cl&& y) { + return internal::std_normal_lcdf_opencl_impl("std_normal_lcdf(OpenCL)", + std::forward(y)); +} + } // namespace math } // namespace stan #endif diff --git a/stan/math/prim/fun/Phi.hpp b/stan/math/prim/fun/Phi.hpp index 0ae82a61755..a2046d655b1 100644 --- a/stan/math/prim/fun/Phi.hpp +++ b/stan/math/prim/fun/Phi.hpp @@ -4,13 +4,38 @@ #include #include #include -#include -#include -#include +#include #include +#include namespace stan { namespace math { +namespace internal { + +/** + * erf(u) for |u| < 0.46875: the first Cody (1969) rational, no exp. + * + * @tparam T scalar type + * @param u argument, |u| < 0.46875 + * @return erf(u) + */ +template +inline T erf_cody_small(const T& u) { + const T s = u * u; + const T num = (((1.85777706184603153e-1 * s + 3.16112374387056560) * s + + 1.13864154151050156e2) + * s + + 3.77485237685302021e2) + * s + + 3.20937758913846947e3; + const T den = (((s + 2.36012909523441209e1) * s + 2.44024637934444173e2) * s + + 1.28261652607737228e3) + * s + + 2.84423683343917062e3; + return u * num / den; +} + +} // namespace internal /** * The unit normal cumulative distribution function. @@ -24,22 +49,26 @@ namespace math { * This function can be used to implement the inverse link function * for probit regression. * - * Phi will underflow to 0 below -37.5 and overflow to 1 above 8 + * With `u = x / sqrt(2)`: `0.5 + 0.5 * erf(u)` for `|u| < 0.46875`, where + * `Phi` is near 1/2; otherwise `0.5 * exp(-x^2 / 2) * erfcx(|u|)` for + * `x < 0` and one minus it for `x > 0`. No branch cancels, and only `exp` + * comes from the C library. `-(0.5 * x) * x` rounds once, so the lower tail + * keeps its relative accuracy down to underflow. * * @param x Argument. * @return Probability random sample is less than or equal to argument. */ inline double Phi(double x) { check_not_nan("Phi", "x", x); - if (x < -37.5) { - return 0; - } else if (x < -5.0) { - return 0.5 * erfc(-INV_SQRT_TWO * x); - } else if (x > 8.25) { - return 1; - } else { - return 0.5 * (1.0 + erf(INV_SQRT_TWO * x)); + const double u = INV_SQRT_TWO * x; + const double a = std::fabs(u); + if (a < 0.46875) { + return 0.5 + 0.5 * internal::erf_cody_small(u); } + const double tail = 0.5 * std::exp(-(0.5 * x) * x) + * (a >= 4.0 ? internal::erfcx_cody_tail(a) + : internal::erfcx_cody_middle(a)); + return x < 0 ? tail : 1.0 - tail; } /** diff --git a/stan/math/prim/fun/as_column_vector_or_scalar.hpp b/stan/math/prim/fun/as_column_vector_or_scalar.hpp index 1e5cfd6de2b..582c3bacb1b 100644 --- a/stan/math/prim/fun/as_column_vector_or_scalar.hpp +++ b/stan/math/prim/fun/as_column_vector_or_scalar.hpp @@ -41,8 +41,12 @@ internal::empty_broadcast_array& as_column_vector_or_scalar( * @return Same vector. */ template * = nullptr> -inline T&& as_column_vector_or_scalar(T&& a) { - return std::forward(a); +inline decltype(auto) as_column_vector_or_scalar(T&& a) { + if constexpr (std::is_rvalue_reference_v) { + return T(std::forward(a)); + } else { + return std::forward(a); + } } /** diff --git a/stan/math/prim/fun/as_value_array_or_scalar.hpp b/stan/math/prim/fun/as_value_array_or_scalar.hpp index f47585d54c6..40436f478a4 100644 --- a/stan/math/prim/fun/as_value_array_or_scalar.hpp +++ b/stan/math/prim/fun/as_value_array_or_scalar.hpp @@ -18,7 +18,7 @@ namespace math { * @return Same value. */ template -inline auto as_value_array_or_scalar(T&& v) { +inline decltype(auto) as_value_array_or_scalar(T&& v) { return value_of(as_array_or_scalar(std::forward(v))); } diff --git a/stan/math/prim/fun/as_value_column_array_or_scalar.hpp b/stan/math/prim/fun/as_value_column_array_or_scalar.hpp index 247bdad5a03..3ada393688b 100644 --- a/stan/math/prim/fun/as_value_column_array_or_scalar.hpp +++ b/stan/math/prim/fun/as_value_column_array_or_scalar.hpp @@ -19,7 +19,7 @@ namespace math { * @return the scalar. */ template -inline auto as_value_column_array_or_scalar(T&& a) { +inline decltype(auto) as_value_column_array_or_scalar(T&& a) { return value_of( as_array_or_scalar(as_column_vector_or_scalar(std::forward(a)))); } diff --git a/stan/math/prim/fun/erfcx.hpp b/stan/math/prim/fun/erfcx.hpp index 6d01dd8d7e4..f14b4d3c011 100644 --- a/stan/math/prim/fun/erfcx.hpp +++ b/stan/math/prim/fun/erfcx.hpp @@ -83,23 +83,42 @@ inline T erfcx_paired_horner(const std::array& c, const T& y, } /** - * Cody (1969) third-interval rational, valid for `x >= 4`. + * Numerator and denominator of the Cody (1969) third-interval rational, + * valid for `x >= 4`. * * `erfcx(x) = (INV_SQRT_PI + u * C(u)) / x` with `u = 1 / x^2` and `C` the * Cody correction. `u * C(u)` is formed from the coefficients in `x^2`, so - * `1 / x^2` is never formed. + * `1 / x^2` is never formed, and the sum is put over the common denominator + * `x^3 Q(x^2)` so the quotient takes one division. Below + * `erfcx_tail_leading_only` that denominator is at most about `2^351`. * + * @tparam T scalar type * @param x argument, `x >= 4` - * @return scaled complementary error function + * @return numerator and denominator of `erfcx(x)` */ -inline double erfcx_cody_tail(double x) { +template +inline std::pair erfcx_cody_tail_fraction(const T& x) { if (x > erfcx_tail_leading_only) { - return INV_SQRT_PI / x; + return {T(INV_SQRT_PI), x}; } - const double s = x * x; + const T s = x * x; const auto pq = erfcx_tail_polynomials( erfcx_tail_p.cbegin(), erfcx_tail_q.cbegin(), s); - return (INV_SQRT_PI + pq.first / (s * pq.second)) / x; + const T s_q = s * pq.second; + return {INV_SQRT_PI * s_q + pq.first, x * s_q}; +} + +/** + * Cody (1969) third-interval rational, valid for `x >= 4`. + * + * @tparam T scalar type + * @param x argument, `x >= 4` + * @return scaled complementary error function + */ +template +inline T erfcx_cody_tail(const T& x) { + const auto pq = erfcx_cody_tail_fraction(x); + return pq.first / pq.second; } /** @@ -144,19 +163,35 @@ inline T erfcx_derivative(const T& x, const T& value) { } /** - * Cody (1969) second-interval rational, valid for `0.46875 <= x <= 4`. + * Numerator and denominator of the Cody (1969) second-interval rational, + * valid for `0.46875 <= x <= 4`. * * Cody writes this interval as `erfc(x) = exp(-x*x) * R(x)`, so `erfcx` * is `R(x)` with the exponential cancelled analytically: no `exp` and no * `erfc` call. * + * @tparam T scalar type + * @param y argument, `0.46875 <= y <= 4` + * @return numerator and denominator of `erfcx(y)` + */ +template +inline std::pair erfcx_cody_middle_fraction(const T& y) { + const T y2 = y * y; + return {erfcx_paired_horner(erfcx_middle_p, y, y2), + erfcx_paired_horner(erfcx_middle_q, y, y2)}; +} + +/** + * Cody (1969) second-interval rational, valid for `0.46875 <= x <= 4`. + * + * @tparam T scalar type * @param y argument, `0.46875 <= y <= 4` * @return scaled complementary error function */ -inline double erfcx_cody_middle(double y) { - const double y2 = y * y; - return erfcx_paired_horner(erfcx_middle_p, y, y2) - / erfcx_paired_horner(erfcx_middle_q, y, y2); +template +inline T erfcx_cody_middle(const T& y) { + const auto pq = erfcx_cody_middle_fraction(y); + return pq.first / pq.second; } /** @@ -170,10 +205,12 @@ inline double erfcx_cody_middle(double y) { * Evaluated by Estrin's method: four independent degree-3 blocks are * combined in `x^4` and `x^8`. * + * @tparam T scalar type * @param x argument, `|x| < 0.46875` * @return scaled complementary error function */ -inline double erfcx_small(double x) { +template +inline T erfcx_small(const T& x) { static constexpr std::array c{1.0, -1.12837916709551256, 1.0, @@ -193,15 +230,15 @@ inline double erfcx_small(double x) { 2.46655529768908249e-05, -9.35890030086883823e-06, 3.05977060678449757e-06}; - const double x2 = x * x; - const double x4 = x2 * x2; - const double x8 = x4 * x4; - std::array quad; + const T x2 = x * x; + const T x4 = x2 * x2; + const T x8 = x4 * x4; + std::array quad; for (int i = 0; i < 4; ++i) { const int j = 4 * i + 2; quad[i] = (c[j] + c[j + 1] * x) + (c[j + 2] + c[j + 3] * x) * x2; } - const double rest + const T rest = (quad[0] + quad[1] * x4) + (quad[2] + quad[3] * x4 + c[18] * x8) * x8; return (c[0] + c[1] * x) + x2 * rest; } diff --git a/stan/math/prim/fun/eval.hpp b/stan/math/prim/fun/eval.hpp index cc7f6718daf..f59631a7d52 100644 --- a/stan/math/prim/fun/eval.hpp +++ b/stan/math/prim/fun/eval.hpp @@ -17,8 +17,12 @@ namespace math { **/ template , plain_type_t>* = nullptr> -inline T eval(T&& arg) { - return std::forward(arg); +inline decltype(auto) eval(T&& arg) { + if constexpr (std::is_rvalue_reference_v) { + return T(std::forward(arg)); + } else { + return std::forward(arg); + } } /** @@ -31,8 +35,8 @@ inline T eval(T&& arg) { **/ template , plain_type_t>* = nullptr> -inline decltype(auto) eval(const T& arg) { - return arg.eval(); +inline decltype(auto) eval(T&& arg) { + return std::forward(arg).eval(); } } // namespace math diff --git a/stan/math/prim/fun/log1p.hpp b/stan/math/prim/fun/log1p.hpp index 5ff607fdebe..fa189b4599b 100644 --- a/stan/math/prim/fun/log1p.hpp +++ b/stan/math/prim/fun/log1p.hpp @@ -5,7 +5,9 @@ #include #include #include +#include #include +#include #include namespace stan { @@ -79,11 +81,43 @@ struct log1p_fun { template * = nullptr, require_container_t* = nullptr, + require_not_container_st* = nullptr, require_not_var_matrix_t* = nullptr> inline auto log1p(T&& x) { return apply_scalar_unary::apply(std::forward(x)); } +/** + * Version of `log1p()` for containers of floating point values that uses + * Eigen's vectorized `log1p`. As in the scalar version, NaN passes through + * and any value below -1 throws. + * + * @tparam T type of container + * @param x container + * @return Elementwise log1p of members of container. + * @throw std::domain_error If any value is less than -1. + */ +template * = nullptr, + require_container_st* = nullptr> +inline auto log1p(T&& x) { + return apply_vector_unary::apply(std::forward(x), [](auto&& v) { + return make_holder( + [](const auto& v_ref) { + // Not check_greater_or_equal on the container: it rejects NaN. + if ((v_ref.array() < -1.0).any()) { + for (Eigen::Index i = 0; i < v_ref.size(); ++i) { + if (v_ref.coeff(i) < -1.0) { + check_greater_or_equal("log1p", "x", v_ref.coeff(i), -1.0); + } + } + } + return v_ref.array().log1p(); + }, + to_ref(std::forward(v))); + }); +} + } // namespace math } // namespace stan diff --git a/stan/math/prim/fun/std_normal_lcdf_impl.hpp b/stan/math/prim/fun/std_normal_lcdf_impl.hpp new file mode 100644 index 00000000000..ac4d2b1eae0 --- /dev/null +++ b/stan/math/prim/fun/std_normal_lcdf_impl.hpp @@ -0,0 +1,314 @@ +#ifndef STAN_MATH_PRIM_FUN_STD_NORMAL_LCDF_IMPL_HPP +#define STAN_MATH_PRIM_FUN_STD_NORMAL_LCDF_IMPL_HPP + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +namespace stan { +namespace math { +namespace internal { + +// The erfcx pieces (Cody 1969 rationals and the small-argument polynomial) +// come from erfcx.hpp. + +/** Tail factor in inv_x_sq = 1/x^2: + * erfcx(x) = (1 + inv_x_sq * correction) / (sqrt(pi) x). + */ +template +inline auto std_normal_tail_correction(const T& inv_x_sq) { + // The arrays ascend in 1/x^2; reversed, they are Horner order. + const auto pq = erfcx_tail_polynomials( + erfcx_tail_p.crbegin(), erfcx_tail_q.crbegin(), inv_x_sq); + return (pq.first / pq.second) * SQRT_PI; +} + +/** Scalar log Phi(z) and its slope phi(z) / Phi(z). + * For z < 0.46875 sqrt(2) both come from erfcx with no exp; larger z needs + * one exp for the complement. Infinite z gives -inf/0 values and inf/0 + * slopes. + * For autodiff types the lower tail keeps log1p, inv_x_sq = 2 (1/neg_z)^2 and + * neg_z / (1 + tail_term) so nested autodiff neither overflows nor loses the + * 2 / neg_z^3 third derivative; doubles take the z < 0 branch there, with one + * log and no log1p. The z > 40 return keeps derivatives finite when x^2 + * overflows. + */ +template * = nullptr> +inline auto std_normal_lcdf_value_grad(const T& z_in) { + using T_return = return_type_t; + const auto z = z_in; + if (z > 8.5) { + if (z > 40) { + if constexpr (calc_grad) { + return std::pair{0, 0}; + } else { + return T_return(0); + } + } + // Past z = 8.3, tail < 2^-54, so log1p(-tail) == -tail and 1 - tail == 1 + // exactly; 8.5 leaves a margin. Nesting the z > 40 check here keeps + // smaller z to one comparison. + const auto pq = erfcx_cody_tail_fraction(z * INV_SQRT_TWO); + const auto density = exp(-(0.5 * z) * z); + const auto tail = 0.5 * density * (pq.first / pq.second); + if constexpr (calc_grad) { + return std::pair{-tail, INV_SQRT_TWO_PI * density}; + } else { + return T_return(-tail); + } + } + if constexpr (!std::is_arithmetic_v) { + if (z <= -4 * SQRT_TWO) { + const auto neg_z = -z; + const auto inv_x_sq = 2 * square(inv(neg_z)); + const auto tail_term = inv_x_sq * std_normal_tail_correction(inv_x_sq); + const auto value + = -(0.5 * z) * z - HALF_LOG_TWO_PI - log(neg_z) + log1p(tail_term); + if constexpr (calc_grad) { + return std::pair{value, neg_z / (1.0 + tail_term)}; + } else { + return T_return(value); + } + } + } + // Not abs(z) for autodiff types: its tangent is 0 at z == 0, which the + // slope needs. For doubles fabs avoids a branch on the sign of z, which + // mispredicts when the signs are mixed. + T x; + if constexpr (std::is_arithmetic_v) { + x = std::fabs(z) * INV_SQRT_TWO; + } else { + x = (z < 0 ? -z : z) * INV_SQRT_TWO; + } + if (x < 0.46875) { + // Phi(z) = exp(-z^2 / 2) erfcx(-z / sqrt(2)) / 2 for either sign. + const auto erfcx_neg = erfcx_small(-z * INV_SQRT_TWO); + const auto value = LOG_HALF - (0.5 * z) * z + log(erfcx_neg); + if constexpr (calc_grad) { + return std::pair{value, + SQRT_TWO_OVER_SQRT_PI / erfcx_neg}; + } else { + return T_return(value); + } + } + // The slope divides by the denominator over the numerator rather than by + // erfcx_x, so its division does not wait on the one forming erfcx_x. + const auto erfcx_pq + = x >= 4 ? erfcx_cody_tail_fraction(x) : erfcx_cody_middle_fraction(x); + const auto erfcx_x = erfcx_pq.first / erfcx_pq.second; + if (z < 0) { + const auto value = -(0.5 * z) * z + LOG_HALF + log(erfcx_x); + if constexpr (calc_grad) { + return std::pair{ + value, SQRT_TWO_OVER_SQRT_PI * erfcx_pq.second / erfcx_pq.first}; + } else { + return T_return(value); + } + } + const auto density = exp(-(0.5 * z) * z); + const auto tail = 0.5 * density * erfcx_x; + // Not log1m(tail): its domain check costs ~3 ns per element here. + const auto value = log1p(-tail); + if constexpr (calc_grad) { + return std::pair{ + value, INV_SQRT_TWO_PI * density / (1.0 - tail)}; + } else { + return T_return(value); + } +} + +/** + * Elementwise values and slopes; only the values when the gradient is off. + * One pass over values, which holds z on entry and log Phi(z) on return. + */ +template * = nullptr> +inline auto std_normal_lcdf_value_grad(T&& z) { + using T_return = return_type_t>; + using Array = Eigen::Array; + Array values(std::forward(z)); + const Eigen::Index N = values.size(); + // coeff and coeffRef: i is in range, and operator[]'s range assert costs + // about 20 instructions per element. + if constexpr (calc_grad) { + Array slopes(N); + for (Eigen::Index i = 0; i < N; ++i) { + auto [value, grad] = std_normal_lcdf_value_grad(values.coeff(i)); + values.coeffRef(i) = value; + slopes.coeffRef(i) = grad; + } + return std::make_pair(std::move(values), std::move(slopes)); + } else { + for (Eigen::Index i = 0; i < N; ++i) { + values.coeffRef(i) = std_normal_lcdf_value_grad(values.coeff(i)); + } + return values; + } +} + +/** Scalar Phi(z) and the ratio phi(z) / Phi(z), without a log and without + * the C-library erf and erfc. With u = z / sqrt(2) and + * g = exp(-z^2 / 2) / 2: + * - |u| < 0.46875: Phi = (1 + erf(u)) / 2, ratio = sqrt(2 / pi) / erfcx(-u); + * - z < 0: Phi = g erfcx(-u), ratio = sqrt(2 / pi) / erfcx(-u); + * - z > 0: Phi = 1 - g erfcx(u) (no cancellation, Phi >= 1/2), + * ratio = sqrt(2 / pi) g / Phi. + * The values equal those of Phi(double). At z = -infinity erfcx(-u) is 0; + * the ratio is then 0, as the cdf is. + */ +template * = nullptr> +inline auto std_normal_cdf_value_ratio(const T& z) { + using T_return = return_type_t; + const T_return u = INV_SQRT_TWO * z; + // Not abs(u): its autodiff tangent is 0 at u == 0. + const T_return a = u < 0 ? T_return(-u) : u; + if (a < 0.46875) { + const T_return cdf = 0.5 + 0.5 * erf_cody_small(u); + if constexpr (calc_grad) { + return std::pair{ + cdf, SQRT_TWO_OVER_SQRT_PI / erfcx_small(T_return(-u))}; + } else { + return cdf; + } + } + const T_return g = 0.5 * exp(-(0.5 * z) * z); + const T_return c = a >= 4 ? erfcx_cody_tail(a) : erfcx_cody_middle(a); + if (z < 0) { + const T_return cdf = g * c; + if constexpr (calc_grad) { + return std::pair{ + cdf, c > 0 ? T_return(SQRT_TWO_OVER_SQRT_PI / c) : T_return(0)}; + } else { + return cdf; + } + } + const T_return cdf = 1.0 - g * c; + if constexpr (calc_grad) { + return std::pair{cdf, SQRT_TWO_OVER_SQRT_PI * g / cdf}; + } else { + return cdf; + } +} + +/** Elementwise Phi and ratios; only Phi when the gradient is off. + * For doubles g = exp(-z^2 / 2) / 2 comes from one vectorized exp over the + * array before the loop, which is cheaper than a libm call per element. + * Above |z| = 37.5 that exp loses relative accuracy as Phi or g goes + * subnormal, so those elements take the libm exp. Elsewhere the values can + * differ from Phi(double) in the last bit. + */ +template * = nullptr> +inline auto std_normal_cdf_value_ratio(T&& z) { + using T_return = return_type_t>; + using Array = Eigen::Array; + Array values(std::forward(z)); + if constexpr (std::is_arithmetic_v) { + const Eigen::Index N = values.size(); + // Skipped when every |u| < 0.46875; the test matches the loop's. + Array gs; + if (!((INV_SQRT_TWO * values).abs() < 0.46875).all()) { + gs = 0.5 * exp(-0.5 * values.square()); + } + Array ratios(calc_grad ? N : 0); + // coeff and coeffRef: i is in range, and operator[]'s range assert costs + // about 20 instructions per element. + for (Eigen::Index i = 0; i < N; ++i) { + const double z_i = values.coeff(i); + const double u = INV_SQRT_TWO * z_i; + const double a = std::fabs(u); + if (a < 0.46875) { + values.coeffRef(i) = 0.5 + 0.5 * erf_cody_small(u); + if constexpr (calc_grad) { + ratios.coeffRef(i) = SQRT_TWO_OVER_SQRT_PI / erfcx_small(-u); + } + continue; + } + // |u| > 26.5 is |z| > 37.5. + const double g = a > 26.5 ? 0.5 * exp(-(0.5 * z_i) * z_i) : gs.coeff(i); + // The ratios divide by the numerator p or by q - g p rather than by + // c = p / q, so their division does not wait on the one forming c. + const auto pq = a >= 4 ? erfcx_cody_tail_fraction(a) + : erfcx_cody_middle_fraction(a); + const double c = pq.first / pq.second; + if (z_i < 0) { + values.coeffRef(i) = g * c; + if constexpr (calc_grad) { + ratios.coeffRef(i) + = c > 0 ? SQRT_TWO_OVER_SQRT_PI * pq.second / pq.first : 0.0; + } + } else { + values.coeffRef(i) = 1.0 - g * c; + if constexpr (calc_grad) { + // Above z = 38.6 g is 0 and so is the ratio; at infinity q is too. + ratios.coeffRef(i) = g > 0 ? SQRT_TWO_OVER_SQRT_PI * g * pq.second + / (pq.second - g * pq.first) + : 0.0; + } + } + } + if constexpr (calc_grad) { + return std::make_pair(std::move(values), std::move(ratios)); + } else { + return values; + } + } else if constexpr (calc_grad) { + Array ratios(values.size()); + for (Eigen::Index i = 0; i < values.size(); ++i) { + auto [value, ratio] = std_normal_cdf_value_ratio(values[i]); + values[i] = value; + ratios[i] = ratio; + } + return std::make_pair(std::move(values), std::move(ratios)); + } else { + for (Eigen::Index i = 0; i < values.size(); ++i) { + values[i] = std_normal_cdf_value_ratio(values[i]); + } + return values; + } +} + +/** Log of the standard normal cdf, or of its complement when `reflect` is + * set: the input is negated so no negated autodiff operands are built. + */ +template +inline return_type_t std_normal_lcdf_impl(const char* function, T_y&& y) { + using T_y_ref = ref_type_if_not_constant_t; + constexpr double sign = reflect ? -1.0 : 1.0; + T_y_ref y_ref = std::forward(y); + // to_ref evaluates an expression argument once for the check and kernel. + decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); + check_not_nan(function, "Random variable", y_val); + + if (size_zero(y_ref)) { + return 0; + } + if constexpr (is_autodiff_v) { + const auto [values, slopes] + = std_normal_lcdf_value_grad(sign * y_val); + auto ops_partials = make_partials_propagator(y_ref); + partials<0>(ops_partials) = sign * slopes; + return ops_partials.build(sum(values)); + } else { + const auto values = std_normal_lcdf_value_grad(sign * y_val); + return sum(values); + } +} + +} // namespace internal +} // namespace math +} // namespace stan +#endif diff --git a/stan/math/prim/meta/ref_type.hpp b/stan/math/prim/meta/ref_type.hpp index 538370c997b..0dc1da27295 100644 --- a/stan/math/prim/meta/ref_type.hpp +++ b/stan/math/prim/meta/ref_type.hpp @@ -48,8 +48,11 @@ struct ref_type_if< template struct ref_type_if> { - using type = - typename ref_type_if::Base>::type; + using T_base = typename std::decay_t::Base; + // Keep rvalues by value so a temporary is not referenced after it dies. + using type = typename ref_type_if< + Condition, std::conditional_t::value, + T_base&&, T_base>>::type; }; template diff --git a/stan/math/prim/prob.hpp b/stan/math/prim/prob.hpp index 4fae64c1ace..b1719dba772 100644 --- a/stan/math/prim/prob.hpp +++ b/stan/math/prim/prob.hpp @@ -86,6 +86,7 @@ #include #include #include +#include #include #include #include diff --git a/stan/math/prim/prob/exp_mod_normal_ccdf_log.hpp b/stan/math/prim/prob/exp_mod_normal_ccdf_log.hpp index c5a84309029..b41a39b3825 100644 --- a/stan/math/prim/prob/exp_mod_normal_ccdf_log.hpp +++ b/stan/math/prim/prob/exp_mod_normal_ccdf_log.hpp @@ -14,8 +14,7 @@ template inline return_type_t exp_mod_normal_ccdf_log( const T_y& y, const T_loc& mu, const T_scale& sigma, const T_inv_scale& lambda) { - return exp_mod_normal_lccdf(y, mu, sigma, - lambda); + return exp_mod_normal_lccdf(y, mu, sigma, lambda); } } // namespace math diff --git a/stan/math/prim/prob/exp_mod_normal_cdf.hpp b/stan/math/prim/prob/exp_mod_normal_cdf.hpp index baf9a5fd25f..be459e028c9 100644 --- a/stan/math/prim/prob/exp_mod_normal_cdf.hpp +++ b/stan/math/prim/prob/exp_mod_normal_cdf.hpp @@ -2,23 +2,7 @@ #define STAN_MATH_PRIM_PROB_EXP_MOD_NORMAL_CDF_HPP #include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include +#include namespace stan { namespace math { @@ -27,116 +11,10 @@ template * = nullptr> inline return_type_t exp_mod_normal_cdf( - const T_y& y, const T_loc& mu, const T_scale& sigma, - const T_inv_scale& lambda) { - using T_partials_return = partials_return_t; - using T_y_ref = ref_type_if_not_constant_t; - using T_mu_ref = ref_type_if_not_constant_t; - using T_sigma_ref = ref_type_if_not_constant_t; - using T_lambda_ref = ref_type_if_not_constant_t; - static constexpr const char* function = "exp_mod_normal_cdf"; - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma, "Inv_scale parameter", - lambda); - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - T_lambda_ref lambda_ref = lambda; - - decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); - decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); - decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); - decltype(auto) lambda_val - = to_ref(as_value_column_array_or_scalar(lambda_ref)); - - check_not_nan(function, "Random variable", y_val); - check_finite(function, "Location parameter", mu_val); - check_positive_finite(function, "Scale parameter", sigma_val); - check_positive_finite(function, "Inv_scale parameter", lambda_val); - - if (size_zero(y, mu, sigma, lambda)) { - return 1.0; - } - - auto ops_partials - = make_partials_propagator(y_ref, mu_ref, sigma_ref, lambda_ref); - - if constexpr (is_vector::value) { - if ((y_val == NEGATIVE_INFTY).any()) { - return ops_partials.build(0.0); - } - } else { - if (y_val == NEGATIVE_INFTY) { - return ops_partials.build(0.0); - } - } - - const auto& inv_sigma - = to_ref_if>(inv(sigma_val)); - const auto& diff = to_ref(y_val - mu_val); - const auto& v = to_ref(lambda_val * sigma_val); - const auto& scaled_diff = to_ref(diff * INV_SQRT_TWO * inv_sigma); - const auto& scaled_diff_diff - = to_ref_if>( - scaled_diff - v * INV_SQRT_TWO); - const auto& erf_calc = to_ref(0.5 * (1 + erf(scaled_diff_diff))); - - const auto& exp_term - = to_ref_if>( - exp(0.5 * square(v) - lambda_val * diff)); - const auto& cdf_n - = to_ref(0.5 + 0.5 * erf(scaled_diff) - exp_term * erf_calc); - - T_partials_return cdf(1.0); - if constexpr (is_vector::value) { - cdf = cdf_n.prod(); - } else { - cdf = cdf_n; - } - - if constexpr (is_any_autodiff_v) { - const auto& exp_term_2 = to_ref_if<( - is_any_autodiff_v && is_autodiff_v)>( - exp(-square(scaled_diff_diff))); - if constexpr (is_any_autodiff_v) { - constexpr bool need_deriv_refs - = is_any_autodiff_v && is_autodiff_v; - const auto& deriv_1 - = to_ref_if(lambda_val * exp_term * erf_calc); - const auto& deriv_2 = to_ref_if( - INV_SQRT_TWO_PI * exp_term * exp_term_2 * inv_sigma); - const auto& sq_scaled_diff = square(scaled_diff); - const auto& exp_m_sq_scaled_diff = exp(-sq_scaled_diff); - const auto& deriv_3 = to_ref_if( - INV_SQRT_TWO_PI * exp_m_sq_scaled_diff * inv_sigma); - if constexpr (is_any_autodiff_v) { - const auto& deriv - = to_ref_if<(is_autodiff_v && is_autodiff_v)>( - cdf * (deriv_1 - deriv_2 + deriv_3) / cdf_n); - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = deriv; - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = -deriv; - } - } - if constexpr (is_autodiff_v) { - edge<2>(ops_partials).partials_ - = -cdf - * ((deriv_1 - deriv_2) * v - + (deriv_3 - deriv_2) * scaled_diff * SQRT_TWO) - / cdf_n; - } - } - if constexpr (is_autodiff_v) { - edge<3>(ops_partials).partials_ - = cdf * exp_term - * (INV_SQRT_TWO_PI * sigma_val * exp_term_2 - - (v * sigma_val - diff) * erf_calc) - / cdf_n; - } - } - return ops_partials.build(cdf); + T_y&& y, T_loc&& mu, T_scale&& sigma, T_inv_scale&& lambda) { + return internal::exp_mod_normal_lcdf_impl( + "exp_mod_normal_cdf", std::forward(y), std::forward(mu), + std::forward(sigma), std::forward(lambda)); } } // namespace math diff --git a/stan/math/prim/prob/exp_mod_normal_cdf_log.hpp b/stan/math/prim/prob/exp_mod_normal_cdf_log.hpp index 4908971ad37..1c59046db7e 100644 --- a/stan/math/prim/prob/exp_mod_normal_cdf_log.hpp +++ b/stan/math/prim/prob/exp_mod_normal_cdf_log.hpp @@ -14,8 +14,7 @@ template inline return_type_t exp_mod_normal_cdf_log( const T_y& y, const T_loc& mu, const T_scale& sigma, const T_inv_scale& lambda) { - return exp_mod_normal_lcdf(y, mu, sigma, - lambda); + return exp_mod_normal_lcdf(y, mu, sigma, lambda); } } // namespace math diff --git a/stan/math/prim/prob/exp_mod_normal_check_args.hpp b/stan/math/prim/prob/exp_mod_normal_check_args.hpp new file mode 100644 index 00000000000..ea4dc9873c0 --- /dev/null +++ b/stan/math/prim/prob/exp_mod_normal_check_args.hpp @@ -0,0 +1,75 @@ +#ifndef STAN_MATH_PRIM_PROB_EXP_MOD_NORMAL_CHECK_ARGS_HPP +#define STAN_MATH_PRIM_PROB_EXP_MOD_NORMAL_CHECK_ARGS_HPP + +#include +#include +#include +#include +#include +#include +#include +#include +#include + +namespace stan { +namespace math { +namespace internal { + +/** + * Checks the exponentially modified normal arguments in one branch-free pass + * over the elements: y is not nan, mu is finite, and sigma and lambda are + * positive and finite. The elementwise checks only run when that pass fails, + * so they throw the same errors in the same order. + * + * @tparam T_y type of the random variable values + * @tparam T_mu type of the location parameter values + * @tparam T_sigma type of the scale parameter values + * @tparam T_lambda type of the inverse scale parameter values + * @param function name of the calling function, for error messages + * @param y random variable values + * @param mu location parameter values + * @param sigma scale parameter values + * @param lambda inverse scale parameter values + * @return whether any element of y is infinite + * @throw std::domain_error if any argument fails its check + */ +template +inline bool exp_mod_normal_check_args(const char* function, const T_y& y, + const T_mu& mu, const T_sigma& sigma, + const T_lambda& lambda) { + bool good = true; + bool y_inf = false; + // With an empty container a scalar argument would be indexed past the + // empty one, so the elementwise checks handle that case. + if (!size_zero(y, mu, sigma, lambda)) { + scalar_seq_view y_vec(y); + scalar_seq_view mu_vec(mu); + scalar_seq_view sigma_vec(sigma); + scalar_seq_view lambda_vec(lambda); + const std::size_t N = max_size(y, mu, sigma, lambda); + for (std::size_t n = 0; n < N; ++n) { + const double y_n = value_of_rec(y_vec[n]); + const double mu_n = value_of_rec(mu_vec[n]); + const double sigma_n = value_of_rec(sigma_vec[n]); + const double lambda_n = value_of_rec(lambda_vec[n]); + good &= !std::isnan(y_n) & std::isfinite(mu_n) & (sigma_n > 0) + & std::isfinite(sigma_n) & (lambda_n > 0) + & std::isfinite(lambda_n); + y_inf |= std::fabs(y_n) == INFTY; + } + } else { + good = false; + } + if (unlikely(!good)) { + check_not_nan(function, "Random variable", y); + check_finite(function, "Location parameter", mu); + check_positive_finite(function, "Scale parameter", sigma); + check_positive_finite(function, "Inv_scale parameter", lambda); + } + return y_inf; +} + +} // namespace internal +} // namespace math +} // namespace stan +#endif diff --git a/stan/math/prim/prob/exp_mod_normal_lccdf.hpp b/stan/math/prim/prob/exp_mod_normal_lccdf.hpp index 2e5901704e0..28c542098fd 100644 --- a/stan/math/prim/prob/exp_mod_normal_lccdf.hpp +++ b/stan/math/prim/prob/exp_mod_normal_lccdf.hpp @@ -2,25 +2,7 @@ #define STAN_MATH_PRIM_PROB_EXP_MOD_NORMAL_LCCDF_HPP #include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include +#include namespace stan { namespace math { @@ -29,108 +11,10 @@ template * = nullptr> inline return_type_t exp_mod_normal_lccdf( - const T_y& y, const T_loc& mu, const T_scale& sigma, - const T_inv_scale& lambda) { - using T_partials_return = partials_return_t; - using T_y_ref = ref_type_if_not_constant_t; - using T_mu_ref = ref_type_if_not_constant_t; - using T_sigma_ref = ref_type_if_not_constant_t; - using T_lambda_ref = ref_type_if_not_constant_t; - static constexpr const char* function = "exp_mod_normal_lccdf"; - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma, "Inv_scale parameter", - lambda); - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - T_lambda_ref lambda_ref = lambda; - - decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); - decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); - decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); - decltype(auto) lambda_val - = to_ref(as_value_column_array_or_scalar(lambda_ref)); - - check_not_nan(function, "Random variable", y_val); - check_finite(function, "Location parameter", mu_val); - check_positive_finite(function, "Scale parameter", sigma_val); - check_positive_finite(function, "Inv_scale parameter", lambda_val); - - if (size_zero(y, mu, sigma, lambda)) { - return 0; - } - - auto ops_partials - = make_partials_propagator(y_ref, mu_ref, sigma_ref, lambda_ref); - - scalar_seq_view y_vec(y_val); - for (size_t n = 0, size_y = stan::math::size(y); n < size_y; n++) { - if (is_inf(y_vec[n])) { - return ops_partials.build(y_vec[n] > 0 ? negative_infinity() : 0); - } - } - - const auto& inv_sigma - = to_ref_if>(inv(sigma_val)); - const auto& diff = to_ref(y_val - mu_val); - const auto& v = to_ref(lambda_val * sigma_val); - const auto& scaled_diff = to_ref(diff * INV_SQRT_TWO * inv_sigma); - const auto& scaled_diff_diff - = to_ref_if>( - scaled_diff - v * INV_SQRT_TWO); - const auto& erf_calc = to_ref(0.5 * (1 + erf(scaled_diff_diff))); - - const auto& exp_term - = to_ref_if>( - exp(0.5 * square(v) - lambda_val * diff)); - const auto& ccdf_n - = to_ref(0.5 - 0.5 * erf(scaled_diff) + exp_term * erf_calc); - - T_partials_return ccdf_log = sum(log(ccdf_n)); - - if constexpr (is_any_autodiff_v) { - const auto& exp_term_2 = to_ref_if<( - is_any_autodiff_v && is_autodiff_v)>( - exp(-square(scaled_diff_diff))); - if constexpr (is_any_autodiff_v) { - constexpr bool need_deriv_refs - = is_any_autodiff_v && is_autodiff_v; - const auto& deriv_1 - = to_ref_if(lambda_val * exp_term * erf_calc); - const auto& deriv_2 = to_ref_if( - INV_SQRT_TWO_PI * exp_term * exp_term_2 * inv_sigma); - const auto& sq_scaled_diff = square(scaled_diff); - const auto& exp_m_sq_scaled_diff = exp(-sq_scaled_diff); - const auto& deriv_3 = to_ref_if( - INV_SQRT_TWO_PI * exp_m_sq_scaled_diff * inv_sigma); - if constexpr (is_any_autodiff_v) { - const auto& deriv - = to_ref_if<(is_autodiff_v && is_autodiff_v)>( - (deriv_1 - deriv_2 + deriv_3) / ccdf_n); - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = -deriv; - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = deriv; - } - } - if constexpr (is_autodiff_v) { - edge<2>(ops_partials).partials_ - = ((deriv_1 - deriv_2) * v - + (deriv_3 - deriv_2) * scaled_diff * SQRT_TWO) - / ccdf_n; - } - } - if constexpr (is_autodiff_v) { - edge<3>(ops_partials).partials_ - = exp_term - * ((v * sigma_val - diff) * erf_calc - - INV_SQRT_TWO_PI * sigma_val * exp_term_2) - / ccdf_n; - } - } - - return ops_partials.build(ccdf_log); + T_y&& y, T_loc&& mu, T_scale&& sigma, T_inv_scale&& lambda) { + return internal::exp_mod_normal_lcdf_impl( + "exp_mod_normal_lccdf", std::forward(y), std::forward(mu), + std::forward(sigma), std::forward(lambda)); } } // namespace math diff --git a/stan/math/prim/prob/exp_mod_normal_lcdf.hpp b/stan/math/prim/prob/exp_mod_normal_lcdf.hpp index d5222619469..065089c8596 100644 --- a/stan/math/prim/prob/exp_mod_normal_lcdf.hpp +++ b/stan/math/prim/prob/exp_mod_normal_lcdf.hpp @@ -3,133 +3,566 @@ #include #include -#include -#include +#include #include #include -#include +#include #include +#include #include -#include #include +#include +#include #include #include #include #include -#include #include -#include #include -#include +#include +#include +#include namespace stan { namespace math { +namespace internal { -template * = nullptr> -inline return_type_t exp_mod_normal_lcdf( - const T_y& y, const T_loc& mu, const T_scale& sigma, - const T_inv_scale& lambda) { - using T_partials_return = partials_return_t; +/** + * For x >= 4, erfcx(x) = (1 + h(x)) / (sqrt(pi) x) with the Cody tail + * rational: h = sqrt(pi) w P(w) / Q(w), w = 1 / x^2. + */ +template +inline T exp_mod_normal_erfcx_h(const T& x) { + const T w = inv(x * x); + const auto pq = erfcx_tail_polynomials( + erfcx_tail_p.crbegin(), erfcx_tail_q.crbegin(), w); + return SQRT_PI * w * pq.first / pq.second; +} + +/** + * h(y) - h(x) for x, y >= 4, with y - x = delta given exactly. The difference + * of the rational A(w) / Q(w), A(w) = w P(w), is written as + * (w1 - w0) [DD_A Q(w0) - A(w0) DD_Q] / (Q(w1) Q(w0)) with the divided + * differences DD of the polynomials, so nothing cancels. + */ +template +inline T exp_mod_normal_erfcx_h_diff(const T& x, const T& y, const T& delta) { + const T w0 = inv(x * x); + const T w1 = inv(y * y); + // Grouped so that no factor overflows: delta * (y + x) overflows for + // x above about 1e154, where w0 and w1 are 0. + const T dw = -(delta * w0) * ((y + x) * w1); + // Powers w1^j w0^(k-1-j) summed over j, for k = 1..6. + T a0 = 0, q0 = 0, q1 = 0, dd_a = 0, dd_q = 0; + T pw0 = 1, pw1 = 1, sum_k = 0; // sum_k = sum_{j 0) { + dd_q += erfcx_tail_q[k] * sum_k; + } + sum_k = sum_k * w0 + pw1; // now the sum for power k + 1 + a0 += erfcx_tail_p[k] * pw0 * w0; + dd_a += erfcx_tail_p[k] * sum_k; + pw0 *= w0; + pw1 *= w1; + } + return SQRT_PI * dw * (dd_a * q0 - a0 * dd_q) / (q1 * q0); +} + +/** + * erfcx(lo) - erfcx(hi), and its log when need_log is set, for hi - lo = d > 0 + * with d given exactly; e_lo and e_hi are erfcx(lo) and erfcx(hi). The end + * that is not computed from the other one is named by upper_exact; the + * difference never uses a rounded hi - lo. + * - erfcx(hi) / erfcx(lo) < 0.99: the direct difference; + * - else for lo >= 4: the Cody tail form, + * erfcx(hi) / erfcx(lo) = (lo / hi) (1 + h(hi)) / (1 + h(lo)); + * - otherwise: the midpoint series in the odd derivatives, from + * E^(k+1) = 2 m E^(k) + 2 k E^(k-1). + */ +template +struct exp_mod_normal_erfcx_diff_result { + T delta; + T log_delta; + // d erfcx(hi) / delta from the close cases when need_ratio is set, else 0: + // finite where delta underflows and 1 / delta overflows. + T d_e_hi_over_delta; +}; + +/** log1p(x) / x, 1 at x == 0. */ +template +inline T exp_mod_normal_log1p_over_x(const T& x) { + return x == 0 ? T(1) : T(log1p(x) / x); +} + +/** The cases with erfcx(hi) / erfcx(lo) >= 0.99; rare unless d is small. */ +template +STAN_COLD_PATH exp_mod_normal_erfcx_diff_result +exp_mod_normal_erfcx_diff_close(const T& lo, const T& hi, const T& d, + const T& e_lo, const T& e_hi) { + if (lo >= 4) { + // log r = log(erfcx(hi) / erfcx(lo)) = d L, with L formed from + // log1p(x) / x factors so that it stays finite when d / lo underflows. + const T x_end = upper_exact ? T(-d / hi) : T(d / lo); + const T l_ratio_x = upper_exact + ? T(-exp_mod_normal_log1p_over_x(x_end) / hi) + : T(-exp_mod_normal_log1p_over_x(x_end) / lo); + const T h_per_d = exp_mod_normal_erfcx_h_diff(lo, hi, T(1.0)) + / (1 + exp_mod_normal_erfcx_h(lo)); + // h_diff is linear in its delta argument. + const T h_term = d * h_per_d; + const T l_total = l_ratio_x + h_per_d * exp_mod_normal_log1p_over_x(h_term); + const T log_r = d * l_total; + // (1 - r) / d = -L expm1(log r) / log r + const T em = log_r == 0 ? T(1) : T(expm1(log_r) / log_r); + const T one_minus_r_over_d = -l_total * em; + const T one_minus_r = d * one_minus_r_over_d; + exp_mod_normal_erfcx_diff_result res{e_lo * one_minus_r, 0, 0}; + if constexpr (need_log) { + // Separate logs: the product can underflow for a very small d. + res.log_delta = log(e_lo) + log(d) + log(one_minus_r_over_d); + } + if constexpr (need_ratio) { + // d e_hi / (e_lo (1 - r)) = r / ((1 - r) / d) + res.d_e_hi_over_delta = exp(log_r) / one_minus_r_over_d; + } + return res; + } + const T m = upper_exact ? T(hi - 0.5 * d) : T(lo + 0.5 * d); + T e_km1 = erfcx(m); + T e_k = erfcx_derivative(m, e_km1); + // odd[j] = E^(2j+1)(m) + T odd[4]; + odd[0] = e_k; + for (int k = 1; k < 7; ++k) { + const T e_kp1 = 2 * m * e_k + 2 * k * e_km1; + e_km1 = e_k; + e_k = e_kp1; + if (k % 2 == 0) { + odd[k / 2] = e_k; + } + } + const T h = 0.5 * d; + const T h2 = h * h; + // delta = -d s with s > 0 for every d + const T neg_s = -( + odd[0] + h2 * (odd[1] / 6 + h2 * (odd[2] / 120 + h2 * odd[3] / 5040))); + exp_mod_normal_erfcx_diff_result res{d * neg_s, 0, 0}; + if constexpr (need_log) { + res.log_delta = log(d) + log(neg_s); + } + if constexpr (need_ratio) { + res.d_e_hi_over_delta = e_hi / neg_s; + } + return res; +} + +/** + * Whether the partials of log F need the ratio d erfcx(hi) / delta: 1 / delta + * overflows below delta = 1e-300 (deep lower tail, or a tiny v), and + * erfcx'(hi) underflows above hi = 1e150. + */ +template +inline bool exp_mod_normal_use_ratio(const T& delta, const T& hi) { + return !(delta > 1e-300 && hi < 1e150); +} + +/** + * erfcx'(t) / erfcx(t). Above t = 1e150, where erfcx' underflows, the ratio + * is -1 / t to working precision. + */ +template +inline T exp_mod_normal_erfcx_log_slope(const T& t, const T& e_t) { + return t > 1e150 ? T(-inv(t)) : T(erfcx_derivative(t, e_t) / e_t); +} + +template +inline exp_mod_normal_erfcx_diff_result exp_mod_normal_erfcx_diff( + const T& lo, const T& hi, const T& d, const T& e_lo, const T& e_hi) { + if (e_hi < 0.99 * e_lo) { + const T delta = e_lo - e_hi; + exp_mod_normal_erfcx_diff_result res{delta, 0, 0}; + if constexpr (need_log) { + res.log_delta = log(delta); + } + // d_e_hi_over_delta stays 0: here delta >= 0.01 erfcx(lo), and the + // partials form the ratio from delta where they need it. + return res; + } + return exp_mod_normal_erfcx_diff_close( + lo, hi, d, e_lo, e_hi); +} + +/** + * log(1 - x) for 0 <= x < 1. Below 1e-17 the result is -x, as the next term + * x^2 / 2 is below the rounding error. + */ +template +inline T exp_mod_normal_log1m(const T& x) { + return x < 1e-17 ? T(-x) : T(log1p(-x)); +} + +/** + * The log cdf (or the log ccdf when upper is set) of the exponentially + * modified normal and its partials with respect to z, v and sigma d/dsigma at + * fixed y, mu and lambda; z = (y - mu) / sigma, v = lambda sigma. + */ +template +struct exp_mod_normal_lcdf_terms { + T value; + T d_z; + T d_v; + T d_s; +}; + +/** + * The terms from F = g Delta, Delta = E(u) - E(t) with t >= 0, for F <= 1/2. + * The partials of F are g times (v E(t), -E'(t) / sqrt 2, + * v sqrt 2 (u E(t) - E'(t) / 2)). The log cdf divides them by F, the log ccdf + * by -(1 - F). The log ccdf needs no log of Delta, and the cdf (log_value + * unset) takes F = g Delta itself. + * Where 1 / Delta overflows or E'(t) underflows (exp_mod_normal_use_ratio), + * the partials of log F come from p = d E(t) / Delta and s = E'(t) / E(t) + * with d = v / sqrt 2: (sqrt 2 p, -s p / v, p (2 u - s)). + */ +/** + * The partials of log F (value field unset) from p = d E(t) / Delta and + * s = E'(t) / E(t), for where exp_mod_normal_use_ratio holds. + */ +template +STAN_COLD_PATH exp_mod_normal_lcdf_terms +exp_mod_normal_lcdf_partials_from_ratio( + const T& u, const T& t, const T& v, const T& e_t, + const exp_mod_normal_erfcx_diff_result& dl) { + // The direct difference leaves the ratio 0; there delta is not small + // against erfcx(u), so d e_t / delta has no overflow. + const T p = dl.d_e_hi_over_delta > 0 ? dl.d_e_hi_over_delta + : T(v * INV_SQRT_TWO * (e_t / dl.delta)); + const T s = exp_mod_normal_erfcx_log_slope(t, e_t); + return {0, SQRT_TWO * p, -(s * p) / v, p * (2 * u - s)}; +} + +template +inline exp_mod_normal_lcdf_terms exp_mod_normal_lcdf_from_delta( + const T& u, const T& t, const T& v, const T& log_g, const T& e_t, + const exp_mod_normal_erfcx_diff_result& dl) { + exp_mod_normal_lcdf_terms r{0, 0, 0, 0}; + if constexpr (upper) { + const T g = exp(log_g); + const T f = g * dl.delta; + r.value = exp_mod_normal_log1m(f); + if constexpr (calc_grad) { + const T scale = -g / (1 - f); + const T de_t = erfcx_derivative(t, e_t); + r.d_z = scale * v * e_t; + r.d_v = -scale * de_t * INV_SQRT_TWO; + r.d_s = scale * v * SQRT_TWO * (u * e_t - 0.5 * de_t); + } + return r; + } + if constexpr (log_value) { + r.value = log_g + dl.log_delta; + } else { + r.value = exp(log_g) * dl.delta; + } + if constexpr (calc_grad) { + const T scale = inv(dl.delta); + const T de_t = erfcx_derivative(t, e_t); + r.d_z = scale * v * e_t; + r.d_v = -scale * de_t * INV_SQRT_TWO; + r.d_s = scale * v * SQRT_TWO * (u * e_t - 0.5 * de_t); + if (unlikely(exp_mod_normal_use_ratio(dl.delta, t))) { + const auto q = exp_mod_normal_lcdf_partials_from_ratio(u, t, v, e_t, dl); + r.d_z = q.d_z; + r.d_v = q.d_v; + r.d_s = q.d_s; + } + } + return r; +} + +/** + * The log ccdf where P = Phi(-z) + b is near underflow (z near 38 and above), + * from the logs of the terms. For t < 0, b = exp(d (2u + d)) (1 - Phi(v - z)) + * with Phi(v - z) < 1/2. + */ +template +STAN_COLD_PATH exp_mod_normal_lcdf_terms exp_mod_normal_lccdf_tiny( + const T& z, const T& v, const T& u, const T& t, const T& log_g, + const T& log_b, const T& e_t, const T& e_mu, const T& e_mt) { + const T log_b_t = t >= 0 ? T(log_g + log(e_t)) + : T(log_b + log1p(-0.5 * exp(-t * t) * e_mt)); + const T log_p = log_sum_exp(T(log_g + log(e_mu)), log_b_t); + if constexpr (calc_grad) { + const T b_p = exp(log_b_t - log_p); + const T g_p = exp(log_g - log_p); + if (t >= 0) { + const T de_t = erfcx_derivative(t, e_t); + return {log_p, -v * b_p, g_p * de_t * INV_SQRT_TWO, + -v * g_p * SQRT_TWO * (u * e_t - 0.5 * de_t)}; + } + const T phi_p = g_p * SQRT_TWO_OVER_SQRT_PI; + return {log_p, -v * b_p, -(phi_p - (v - z) * b_p), -v * (phi_p - v * b_p)}; + } else { + return {log_p, 0, 0, 0}; + } +} + +/** + * With u = -z / sqrt 2, d = v / sqrt 2, t = u + d, E = erfcx and + * g = exp(-z^2 / 2) / 2: + * Phi(z) = g E(u), b = exp(v^2 / 2 - v z) Phi(z - v) = g E(t), + * F = Phi(z) - b = g (E(u) - E(t)), P = 1 - F = Phi(-z) + b, + * F_z = v b, F_v = phi(z) - (v - z) b = -g E'(t) / sqrt 2, + * sigma F_sigma = -z F_z + v F_v = v (phi(z) - v b) + * = v g sqrt 2 (u E(t) - E'(t) / 2). + * The z^2 / 2 terms cancel analytically, so the tails need no difference of + * large logs. For t < 0, b = exp(d (2u + d)) - g E(-t), as + * E(t) = 2 exp(t^2) - E(-t). For z <= 0 (then F <= 1/2), and for z > 0 with + * F < 1/4: F = g (E(u) - E(t)), or for t < 0, + * F = -expm1(d (2u + d)) + g (E(-t) - E(-u)) with both terms positive. + * Otherwise F = 1 - P with P = Phi(-z) + b. + * With log_value unset (the cdf, lower tail only) the value is F itself and + * the partials are still those of log F. + */ +template +inline exp_mod_normal_lcdf_terms exp_mod_normal_lcdf_kernel(const T& z, + const T& v) { + static_assert(log_value || !upper, "the ccdf has no plain value kernel"); + constexpr bool need_log = !upper && log_value; + constexpr bool need_ratio = calc_grad && !upper; + const T u = -z * INV_SQRT_TWO; + const T d = v * INV_SQRT_TWO; + const T t = u + d; + const T log_g = LOG_HALF - (0.5 * z) * z; + if (z <= 0) { + // F <= Phi(z) <= 1/2. + const T e_t = erfcx(t); + const auto dl = exp_mod_normal_erfcx_diff( + u, t, d, T(erfcx(u)), e_t); + return exp_mod_normal_lcdf_from_delta( + u, t, v, log_g, e_t, dl); + } + const T log_b = d * (2 * u + d); + if (t < -6.5 && log_b < -0.2877) { + // Phi(-z), Phi(v - z) and phi(z) are below 3e-19 of b = exp(d (2u + d)), + // and b < 3/4: P = b, and the partials of F are b (v, z - v, -v^2). + if constexpr (upper) { + return {log_b, -v, v - z, v * v}; + } else { + const T b = exp(log_b); + const T r = b / (1 - b); + return {log_value ? exp_mod_normal_log1m(b) : T(1 - b), v * r, + (z - v) * r, -v * v * r}; + } + } + const T g = exp(log_g); + const T e_mu = erfcx(-u); + const T q = g * e_mu; + T e_t = 0; + T e_mt = 0; + T b; + if (t >= 0) { + e_t = erfcx(t); + b = g * e_t; + } else { + e_mt = erfcx(-t); + b = exp(log_b) - g * e_mt; + } + const T p = q + b; + // F < 1/4: 1 - p would lose digits. + const bool small_f = p > 0.75; + if (small_f && t >= 0) { + const auto dl = exp_mod_normal_erfcx_diff( + u, t, d, T(erfcx(u)), e_t); + return exp_mod_normal_lcdf_from_delta( + u, t, v, log_g, e_t, dl); + } + // The partials of F: f_z, f_v, f_s. + T f_z = 0; + T f_v = 0; + T f_s = 0; + if constexpr (calc_grad) { + f_z = v * b; + if (t >= 0) { + const T de_t = erfcx_derivative(t, e_t); + f_v = -g * de_t * INV_SQRT_TWO; + f_s = v * g * SQRT_TWO * (u * e_t - 0.5 * de_t); + } else { + const T phi = g * SQRT_TWO_OVER_SQRT_PI; + f_v = phi - (v - z) * b; + f_s = v * (phi - v * b); + } + } + if (small_f) { + // t < 0: F = -expm1(d (2u + d)) + g (E(-t) - E(-u)). + const auto dl + = exp_mod_normal_erfcx_diff(T(-t), T(-u), d, e_mt, e_mu); + const T f = -expm1(log_b) + g * dl.delta; + if constexpr (!upper) { + return {log_value ? T(log(f)) : f, f_z / f, f_v / f, f_s / f}; + } else { + const T one_m_f = 1 - f; + return {log1p(-f), -f_z / one_m_f, -f_v / one_m_f, -f_s / one_m_f}; + } + } + // F >= 1/4: F = 1 - p loses at most 2 bits. + if constexpr (!upper) { + // log1p only where log F is small: for p >= 1/4, |log F| >= 0.29. + const T f = 1 - p; + if constexpr (!log_value) { + return {f, f_z / f, f_v / f, f_s / f}; + } + return {p < 0.25 ? exp_mod_normal_log1m(p) : T(log(f)), f_z / f, f_v / f, + f_s / f}; + } else { + if (p > 1e-300) { + return {log(p), -f_z / p, -f_v / p, -f_s / p}; + } + return exp_mod_normal_lccdf_tiny(z, v, u, t, log_g, log_b, e_t, + e_mu, e_mt); + } +} + +/** + * log F, or log(1 - F) when upper is set, summed over the elements. With + * log_value unset the result is the product of the F, the cdf, with no log + * or exp of each element. + */ +template +inline return_type_t exp_mod_normal_lcdf_impl( + const char* function, T_y&& y, T_loc&& mu, T_scale&& sigma, + T_inv_scale&& lambda) { + using T_partials = partials_return_t; using T_y_ref = ref_type_if_not_constant_t; using T_mu_ref = ref_type_if_not_constant_t; using T_sigma_ref = ref_type_if_not_constant_t; using T_lambda_ref = ref_type_if_not_constant_t; - static constexpr const char* function = "exp_mod_normal_lcdf"; + constexpr bool any_autodiff + = is_any_autodiff_v; check_consistent_sizes(function, "Random variable", y, "Location parameter", mu, "Scale parameter", sigma, "Inv_scale parameter", lambda); - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - T_lambda_ref lambda_ref = lambda; - + T_y_ref y_ref = std::forward(y); + T_mu_ref mu_ref = std::forward(mu); + T_sigma_ref sigma_ref = std::forward(sigma); + T_lambda_ref lambda_ref = std::forward(lambda); + // to_ref only reduces compile memory by evaluating expression arguments. decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); decltype(auto) lambda_val = to_ref(as_value_column_array_or_scalar(lambda_ref)); + const bool y_inf = exp_mod_normal_check_args(function, y_val, mu_val, + sigma_val, lambda_val); - check_not_nan(function, "Random variable", y_val); - check_finite(function, "Location parameter", mu_val); - check_positive_finite(function, "Scale parameter", sigma_val); - check_positive_finite(function, "Inv_scale parameter", lambda_val); - - if (size_zero(y, mu, sigma, lambda)) { - return 0; + // The cdf of no elements is 1 and F is 0 or 1 at y = -inf or inf. + constexpr double zero_value = log_value ? NEGATIVE_INFTY : 0.0; + constexpr double one_value = log_value ? 0.0 : 1.0; + if (size_zero(y_ref, mu_ref, sigma_ref, lambda_ref)) { + return one_value; + } else if (unlikely(y_inf)) { + if (any(y_val == NEGATIVE_INFTY)) { + return upper ? 0.0 : zero_value; + } + return upper ? NEGATIVE_INFTY : one_value; } + scalar_seq_view> y_vec(y_val); + scalar_seq_view> mu_vec(mu_val); + scalar_seq_view> sigma_vec(sigma_val); + scalar_seq_view> lambda_vec(lambda_val); + const std::size_t N = max_size(y_ref, mu_ref, sigma_ref, lambda_ref); auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref, lambda_ref); - - scalar_seq_view y_vec(y_val); - for (size_t n = 0, size_y = stan::math::size(y); n < size_y; n++) { - if (is_inf(y_vec[n])) { - return ops_partials.build(y_vec[n] < 0 ? negative_infinity() : 0); - } - } - - const auto& inv_sigma - = to_ref_if>(inv(sigma_val)); - const auto& diff = to_ref(y_val - mu_val); - const auto& v = to_ref(lambda_val * sigma_val); - const auto& scaled_diff = to_ref(diff * INV_SQRT_TWO * inv_sigma); - const auto& scaled_diff_diff - = to_ref_if>( - scaled_diff - v * INV_SQRT_TWO); - const auto& erf_calc = to_ref(0.5 * (1 + erf(scaled_diff_diff))); - - const auto& exp_term - = to_ref_if>( - exp(0.5 * square(v) - lambda_val * diff)); - const auto& cdf_n - = to_ref(0.5 + 0.5 * erf(scaled_diff) - exp_term * erf_calc); - - T_partials_return cdf_log = sum(log(cdf_n)); - - if constexpr (is_any_autodiff_v) { - const auto& exp_term_2 = to_ref_if<( - is_any_autodiff_v && is_autodiff_v)>( - exp(-square(scaled_diff_diff))); - if constexpr (is_any_autodiff_v) { - constexpr bool need_deriv_refs - = is_any_autodiff_v && is_autodiff_v; - const auto& deriv_1 - = to_ref_if(lambda_val * exp_term * erf_calc); - const auto& deriv_2 = to_ref_if( - INV_SQRT_TWO_PI * exp_term * exp_term_2 * inv_sigma); - const auto& sq_scaled_diff = square(scaled_diff); - const auto& exp_m_sq_scaled_diff = exp(-sq_scaled_diff); - const auto& deriv_3 = to_ref_if( - INV_SQRT_TWO_PI * exp_m_sq_scaled_diff * inv_sigma); - if constexpr (is_any_autodiff_v) { - const auto& deriv - = to_ref_if<(is_autodiff_v && is_autodiff_v)>( - (deriv_1 - deriv_2 + deriv_3) / cdf_n); - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = deriv; - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = -deriv; - } + T_partials lp = one_value; + for (std::size_t n = 0; n < N; ++n) { + const T_partials sigma_n = sigma_vec[n]; + const T_partials z = (y_vec[n] - mu_vec[n]) / sigma_n; + const T_partials v = lambda_vec[n] * sigma_n; + const auto r + = exp_mod_normal_lcdf_kernel(z, v); + if constexpr (log_value) { + lp += r.value; + } else { + lp *= r.value; + } + if constexpr (is_autodiff_v) { + partials<0>(ops_partials)[n] += r.d_z / sigma_n; + } + if constexpr (is_autodiff_v) { + partials<1>(ops_partials)[n] -= r.d_z / sigma_n; + } + if constexpr (is_autodiff_v) { + partials<2>(ops_partials)[n] += r.d_s / sigma_n; + } + if constexpr (is_autodiff_v) { + partials<3>(ops_partials)[n] += r.d_v * sigma_n; + } + } + if constexpr (!log_value) { + // A cdf that underflows to 0 has zero partials; the partials of log F + // can be infinite there. + if (unlikely(lp == 0)) { + return make_partials_propagator(y_ref, mu_ref, sigma_ref, lambda_ref) + .build(0.0); + } + // The partials so far are those of log F; those of the cdf scale by it. + if constexpr (is_autodiff_v) { + for (std::size_t n = 0; n < stan::math::size(y_ref); ++n) { + partials<0>(ops_partials)[n] *= lp; + } + } + if constexpr (is_autodiff_v) { + for (std::size_t n = 0; n < stan::math::size(mu_ref); ++n) { + partials<1>(ops_partials)[n] *= lp; } - if constexpr (is_autodiff_v) { - edge<2>(ops_partials).partials_ - = -((deriv_1 - deriv_2) * v - + (deriv_3 - deriv_2) * scaled_diff * SQRT_TWO) - / cdf_n; + } + if constexpr (is_autodiff_v) { + for (std::size_t n = 0; n < stan::math::size(sigma_ref); ++n) { + partials<2>(ops_partials)[n] *= lp; } } if constexpr (is_autodiff_v) { - edge<3>(ops_partials).partials_ - = exp_term - * (INV_SQRT_TWO_PI * sigma_val * exp_term_2 - - (v * sigma_val - diff) * erf_calc) - / cdf_n; + for (std::size_t n = 0; n < stan::math::size(lambda_ref); ++n) { + partials<3>(ops_partials)[n] *= lp; + } } } - return ops_partials.build(cdf_log); + return ops_partials.build(lp); +} + +} // namespace internal + +/** \ingroup prob_dists + * Returns the log of the exponentially modified normal cumulative + * distribution function at y, given location mu, scale sigma and inverse + * scale lambda. Vectorized arguments give the sum over the elements. + * + * @tparam T_y type of the random variable + * @tparam T_loc type of the location parameter + * @tparam T_scale type of the scale parameter + * @tparam T_inv_scale type of the inverse scale parameter + * @param y random variable + * @param mu location parameter + * @param sigma scale parameter + * @param lambda inverse scale parameter + * @return log of the cumulative distribution function + * @throw std::domain_error if y is nan, mu is infinite, or sigma or lambda is + * not positive and finite + * @throw std::invalid_argument if container sizes mismatch + */ +template * = nullptr> +inline return_type_t exp_mod_normal_lcdf( + T_y&& y, T_loc&& mu, T_scale&& sigma, T_inv_scale&& lambda) { + return internal::exp_mod_normal_lcdf_impl( + "exp_mod_normal_lcdf", std::forward(y), std::forward(mu), + std::forward(sigma), std::forward(lambda)); } } // namespace math diff --git a/stan/math/prim/prob/exp_mod_normal_lpdf.hpp b/stan/math/prim/prob/exp_mod_normal_lpdf.hpp index cb3374ddc1b..b95ccef1954 100644 --- a/stan/math/prim/prob/exp_mod_normal_lpdf.hpp +++ b/stan/math/prim/prob/exp_mod_normal_lpdf.hpp @@ -7,17 +7,18 @@ #include #include #include -#include #include #include #include -#include #include #include #include #include #include +#include +#include #include +#include namespace stan { namespace math { @@ -27,21 +28,21 @@ template * = nullptr> inline return_type_t exp_mod_normal_lpdf( - const T_y& y, const T_loc& mu, const T_scale& sigma, - const T_inv_scale& lambda) { - using T_partials_return = partials_return_t; + T_y&& y, T_loc&& mu, T_scale&& sigma, T_inv_scale&& lambda) { using T_y_ref = ref_type_if_not_constant_t; using T_mu_ref = ref_type_if_not_constant_t; using T_sigma_ref = ref_type_if_not_constant_t; using T_lambda_ref = ref_type_if_not_constant_t; static constexpr const char* function = "exp_mod_normal_lpdf"; + constexpr bool any_autodiff + = is_any_autodiff_v; check_consistent_sizes(function, "Random variable", y, "Location parameter", mu, "Scale parameter", sigma, "Inv_scale parameter", lambda); - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - T_lambda_ref lambda_ref = lambda; + T_y_ref y_ref = std::forward(y); + T_mu_ref mu_ref = std::forward(mu); + T_sigma_ref sigma_ref = std::forward(sigma); + T_lambda_ref lambda_ref = std::forward(lambda); decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); @@ -49,54 +50,33 @@ inline return_type_t exp_mod_normal_lpdf( decltype(auto) lambda_val = to_ref(as_value_column_array_or_scalar(lambda_ref)); - check_not_nan(function, "Random variable", y_val); - check_finite(function, "Location parameter", mu_val); - check_positive_finite(function, "Scale parameter", sigma_val); - check_positive_finite(function, "Inv_scale parameter", lambda_val); + internal::exp_mod_normal_check_args(function, y_val, mu_val, sigma_val, + lambda_val); - if (size_zero(y, mu, sigma, lambda)) { + if (size_zero(y_ref, mu_ref, sigma_ref, lambda_ref)) { return 0.0; } - if constexpr (!include_summand::value) { + if constexpr (propto + && !is_any_autodiff_v) { return 0.0; } - const auto& inv_sigma - = to_ref_if>(inv(sigma_val)); - const auto& sigma_sq = to_ref_if>(square(sigma_val)); - const auto& lambda_sigma_sq = to_ref(lambda_val * sigma_sq); - const auto& mu_minus_y = to_ref(mu_val - y_val); - const auto& inner_term - = to_ref_if>( - (mu_minus_y + lambda_sigma_sq) * INV_SQRT_TWO * inv_sigma); - const auto& erfc_calc = to_ref(erfc(inner_term)); + auto inv_sigma = inv(sigma_val); + auto sigma_sq = square(sigma_val); + auto lambda_sigma_sq = lambda_val * sigma_sq; + auto mu_minus_y = mu_val - y_val; + // log(erfc(t) / 2) = log Phi(-sqrt(2) t) cancels the log(1/2) constant. + auto z = -(mu_minus_y + lambda_sigma_sq) * inv_sigma; - size_t N = max_size(y, mu, sigma, lambda); - T_partials_return logp(0.0); - if constexpr (include_summand::value) { - logp -= LOG_TWO * N; - } - if constexpr (include_summand::value) { - logp += sum(log(lambda_val)) * N / math::size(lambda); - } - const auto& log_erfc_calc = log(erfc_calc); - logp - += sum(lambda_val * (mu_minus_y + 0.5 * lambda_sigma_sq) + log_erfc_calc); - - auto ops_partials - = make_partials_propagator(y_ref, mu_ref, sigma_ref, lambda_ref); - - if constexpr (is_any_autodiff_v) { - const auto& exp_m_sq_inner_term = exp(-square(inner_term)); - const auto& deriv_logerfc = to_ref_if< - is_any_autodiff_v< - T_y, - T_loc> + is_autodiff_v + is_autodiff_v >= 2>( - -SQRT_TWO_OVER_SQRT_PI * exp_m_sq_inner_term / erfc_calc); + auto log_density = lambda_val * (mu_minus_y + 0.5 * lambda_sigma_sq); + if constexpr (any_autodiff) { + const auto [values, slopes] = internal::std_normal_lcdf_value_grad(z); + auto ops_partials + = make_partials_propagator(y_ref, mu_ref, sigma_ref, lambda_ref); if constexpr (is_any_autodiff_v) { + // Evaluated once when both y and mu need it. const auto& deriv = to_ref_if>( - lambda_val + deriv_logerfc * inv_sigma); + lambda_val - slopes * inv_sigma); if constexpr (is_autodiff_v) { partials<0>(ops_partials) = -deriv; } @@ -107,22 +87,36 @@ inline return_type_t exp_mod_normal_lpdf( if constexpr (is_autodiff_v) { edge<2>(ops_partials).partials_ = sigma_val * square(lambda_val) - + deriv_logerfc * (lambda_val - mu_minus_y / sigma_sq); + - slopes * (lambda_val - mu_minus_y * square(inv_sigma)); } if constexpr (is_autodiff_v) { - partials<3>(ops_partials) = inv(lambda_val) + lambda_sigma_sq + mu_minus_y - + deriv_logerfc * sigma_val; + partials<3>(ops_partials) + = inv(lambda_val) + lambda_sigma_sq + mu_minus_y - slopes * sigma_val; + } + // A scalar lambda broadcasts over the N elements of values, so one sum + // counts log(lambda) N times. + if constexpr (!propto || is_autodiff_v) { + return ops_partials.build( + sum(std::move(log_density) + values + log(lambda_val))); + } else { + return ops_partials.build(sum(std::move(log_density) + values)); + } + } else { + const auto values = internal::std_normal_lcdf_value_grad(z); + if constexpr (!propto) { + return sum(std::move(log_density) + values + log(lambda_val)); + } else { + return sum(std::move(log_density) + values); } } - - return ops_partials.build(logp); } template inline return_type_t exp_mod_normal_lpdf( - const T_y& y, const T_loc& mu, const T_scale& sigma, - const T_inv_scale& lambda) { - return exp_mod_normal_lpdf(y, mu, sigma, lambda); + T_y&& y, T_loc&& mu, T_scale&& sigma, T_inv_scale&& lambda) { + return exp_mod_normal_lpdf( + std::forward(y), std::forward(mu), + std::forward(sigma), std::forward(lambda)); } } // namespace math diff --git a/stan/math/prim/prob/lognormal_ccdf_log.hpp b/stan/math/prim/prob/lognormal_ccdf_log.hpp index 04288340b21..42c411375d8 100644 --- a/stan/math/prim/prob/lognormal_ccdf_log.hpp +++ b/stan/math/prim/prob/lognormal_ccdf_log.hpp @@ -11,9 +11,11 @@ namespace math { * @deprecated use lognormal_lccdf */ template -inline return_type_t lognormal_ccdf_log( - const T_y& y, const T_loc& mu, const T_scale& sigma) { - return lognormal_lccdf(y, mu, sigma); +inline return_type_t lognormal_ccdf_log(T_y&& y, + T_loc&& mu, + T_scale&& sigma) { + return lognormal_lccdf(std::forward(y), std::forward(mu), + std::forward(sigma)); } } // namespace math diff --git a/stan/math/prim/prob/lognormal_cdf.hpp b/stan/math/prim/prob/lognormal_cdf.hpp index f739cc98acb..8ff06e7649d 100644 --- a/stan/math/prim/prob/lognormal_cdf.hpp +++ b/stan/math/prim/prob/lognormal_cdf.hpp @@ -3,85 +3,86 @@ #include #include -#include -#include +#include #include -#include -#include -#include -#include +#include +#include #include -#include -#include +#include #include +#include #include -#include #include -#include namespace stan { namespace math { +/** \ingroup prob_dists + * The lognormal cumulative distribution function. Each factor is + * `0.5 * erfc(-z / sqrt(2))` with `z = (log(y) - mu) / sigma`, which has no + * cancellation for either sign; the partials are the cdf times + * `phi(z) / Phi(z)`. + * + * @tparam T_y type of y + * @tparam T_loc type of location parameter + * @tparam T_scale type of scale parameter + * @param y A scalar variate. + * @param mu The location of the lognormal distribution. + * @param sigma The scale of the lognormal distribution. + * @return The lognormal cdf evaluated at the specified arguments. + */ template * = nullptr> -inline return_type_t lognormal_cdf(const T_y& y, - const T_loc& mu, - const T_scale& sigma) { - using T_partials_return = partials_return_t; +inline return_type_t lognormal_cdf(T_y&& y, T_loc&& mu, + T_scale&& sigma) { using T_y_ref = ref_type_if_not_constant_t; using T_mu_ref = ref_type_if_not_constant_t; using T_sigma_ref = ref_type_if_not_constant_t; static constexpr const char* function = "lognormal_cdf"; - - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - + check_consistent_sizes(function, "Random variable", y, "Location parameter", + mu, "Scale parameter", sigma); + T_y_ref y_ref = std::forward(y); + T_mu_ref mu_ref = std::forward(mu); + T_sigma_ref sigma_ref = std::forward(sigma); + // to_ref only reduces compile memory by evaluating expression arguments. decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); - check_nonnegative(function, "Random variable", y_val); check_finite(function, "Location parameter", mu_val); check_positive_finite(function, "Scale parameter", sigma_val); - if (size_zero(y, mu, sigma)) { + if (size_zero(y_ref, mu_ref, sigma_ref)) { return 1.0; } auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref); - - if (sum(promote_scalar(y_val == 0))) { + if (any(y_val == 0)) { return ops_partials.build(0.0); } - const auto& log_y = log(y_val); - const auto& scaled_diff = to_ref_if>( - (log_y - mu_val) / (sigma_val * SQRT_TWO)); - const auto& erfc_m_diff = erfc(-scaled_diff); - const auto& cdf_n - = to_ref_if>(0.5 * erfc_m_diff); - - T_partials_return cdf = prod(cdf_n); - + // Evaluated once: the sigma partial reads z again, and a lazy z would + // compute the log a second time. + auto z = eval((log(y_val) - mu_val) / sigma_val); if constexpr (is_any_autodiff_v) { - const auto& exp_m_sq_diff = exp(-scaled_diff * scaled_diff); - const auto& rep_deriv = to_ref_if< - is_autodiff_v< - T_y> + is_autodiff_v + is_autodiff_v >= 2>( - -cdf * INV_SQRT_TWO_PI * exp_m_sq_diff / (sigma_val * cdf_n)); + const auto [values, ratios] = internal::std_normal_cdf_value_ratio(z); + const auto cdf = prod(values); + auto scaled = eval(cdf * ratios / sigma_val); if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = -rep_deriv / y_val; + partials<0>(ops_partials) = scaled / y_val; } if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = rep_deriv; + partials<1>(ops_partials) = -scaled; } if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = rep_deriv * scaled_diff * SQRT_TWO; + // The infinite endpoint has a zero partial, not 0 * infinity. + partials<2>(ops_partials) = select(scaled == 0, 0.0, -scaled * z); } + return ops_partials.build(cdf); + } else { + return prod(internal::std_normal_cdf_value_ratio(std::move(z))); } - return ops_partials.build(cdf); } } // namespace math diff --git a/stan/math/prim/prob/lognormal_cdf_log.hpp b/stan/math/prim/prob/lognormal_cdf_log.hpp index effbc38c8ec..e1f5554dc75 100644 --- a/stan/math/prim/prob/lognormal_cdf_log.hpp +++ b/stan/math/prim/prob/lognormal_cdf_log.hpp @@ -11,9 +11,10 @@ namespace math { * @deprecated use lognormal_lcdf */ template -inline return_type_t lognormal_cdf_log( - const T_y& y, const T_loc& mu, const T_scale& sigma) { - return lognormal_lcdf(y, mu, sigma); +inline return_type_t lognormal_cdf_log(T_y&& y, T_loc&& mu, + T_scale&& sigma) { + return lognormal_lcdf(std::forward(y), std::forward(mu), + std::forward(sigma)); } } // namespace math diff --git a/stan/math/prim/prob/lognormal_lccdf.hpp b/stan/math/prim/prob/lognormal_lccdf.hpp index 39391bedb0f..4b10aa06d12 100644 --- a/stan/math/prim/prob/lognormal_lccdf.hpp +++ b/stan/math/prim/prob/lognormal_lccdf.hpp @@ -2,22 +2,7 @@ #define STAN_MATH_PRIM_PROB_LOGNORMAL_LCCDF_HPP #include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include +#include namespace stan { namespace math { @@ -25,62 +10,11 @@ namespace math { template * = nullptr> -inline return_type_t lognormal_lccdf( - const T_y& y, const T_loc& mu, const T_scale& sigma) { - using T_partials_return = partials_return_t; - using T_y_ref = ref_type_if_not_constant_t; - using T_mu_ref = ref_type_if_not_constant_t; - using T_sigma_ref = ref_type_if_not_constant_t; - static constexpr const char* function = "lognormal_lccdf"; - - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - - decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); - decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); - decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); - - check_nonnegative(function, "Random variable", y_val); - check_finite(function, "Location parameter", mu_val); - check_positive_finite(function, "Scale parameter", sigma_val); - - if (size_zero(y, mu, sigma)) { - return 0; - } - - auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref); - - if (sum(promote_scalar(y_val == 0))) { - return ops_partials.build(0.0); - } - - const auto& log_y = log(y_val); - const auto& scaled_diff = to_ref_if>( - (log_y - mu_val) / (sigma_val * SQRT_TWO)); - const auto& erfc_calc - = to_ref_if>(erfc(scaled_diff)); - - size_t N = max_size(y, mu, sigma); - T_partials_return ccdf_log = N * LOG_HALF + sum(log(erfc_calc)); - - if constexpr (is_any_autodiff_v) { - const auto& exp_m_sq_diff = exp(-scaled_diff * scaled_diff); - const auto& rep_deriv = to_ref_if< - is_autodiff_v< - T_y> + is_autodiff_v + is_autodiff_v >= 2>( - SQRT_TWO_OVER_SQRT_PI * exp_m_sq_diff / (sigma_val * erfc_calc)); - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = -rep_deriv / y_val; - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = rep_deriv; - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = rep_deriv * scaled_diff * SQRT_TWO; - } - } - return ops_partials.build(ccdf_log); +inline return_type_t lognormal_lccdf(T_y&& y, T_loc&& mu, + T_scale&& sigma) { + return internal::lognormal_lcdf_impl( + "lognormal_lccdf", std::forward(y), std::forward(mu), + std::forward(sigma)); } } // namespace math diff --git a/stan/math/prim/prob/lognormal_lcdf.hpp b/stan/math/prim/prob/lognormal_lcdf.hpp index 482f79885bd..46f1711c0c0 100644 --- a/stan/math/prim/prob/lognormal_lcdf.hpp +++ b/stan/math/prim/prob/lognormal_lcdf.hpp @@ -3,84 +3,86 @@ #include #include -#include -#include +#include #include #include -#include -#include +#include +#include #include -#include -#include -#include +#include #include +#include #include -#include #include -#include +#include namespace stan { namespace math { +namespace internal { -template * = nullptr> -inline return_type_t lognormal_lcdf(const T_y& y, - const T_loc& mu, - const T_scale& sigma) { - using T_partials_return = partials_return_t; +template +inline return_type_t lognormal_lcdf_impl( + const char* function, T_y&& y, T_loc&& mu, T_scale&& sigma) { using T_y_ref = ref_type_if_not_constant_t; using T_mu_ref = ref_type_if_not_constant_t; using T_sigma_ref = ref_type_if_not_constant_t; - static constexpr const char* function = "lognormal_lcdf"; - - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - + constexpr bool any_autodiff = is_any_autodiff_v; + constexpr double sign = reflect ? -1.0 : 1.0; + check_consistent_sizes(function, "Random variable", y, "Location parameter", + mu, "Scale parameter", sigma); + T_y_ref y_ref = std::forward(y); + T_mu_ref mu_ref = std::forward(mu); + T_sigma_ref sigma_ref = std::forward(sigma); + // to_ref only reduces compile memory by evaluating expression arguments. decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); - check_nonnegative(function, "Random variable", y_val); check_finite(function, "Location parameter", mu_val); check_positive_finite(function, "Scale parameter", sigma_val); - if (size_zero(y, mu, sigma)) { + if (size_zero(y_ref, mu_ref, sigma_ref)) { return 0; } auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref); - - if (sum(promote_scalar(y_val == 0))) { - return ops_partials.build(NEGATIVE_INFTY); + if (any(y_val == 0)) { + return ops_partials.build(reflect ? 0.0 : NEGATIVE_INFTY); } - const auto& log_y = log(y_val); - const auto& scaled_diff = to_ref_if>( - (log_y - mu_val) / (sigma_val * SQRT_TWO)); - const auto& erfc_calc - = to_ref_if>(erfc(-scaled_diff)); - size_t N = max_size(y, mu, sigma); - T_partials_return cdf_log = N * LOG_HALF + sum(log(erfc_calc)); - - if constexpr (is_any_autodiff_v) { - const auto& exp_m_sq_diff = exp(-scaled_diff * scaled_diff); - const auto& rep_deriv = to_ref_if< - is_autodiff_v< - T_y> + is_autodiff_v + is_autodiff_v >= 2>( - -SQRT_TWO_OVER_SQRT_PI * exp_m_sq_diff / (sigma_val * erfc_calc)); + // Evaluated once: the sigma partial reads z again, and a lazy z would + // compute the log a second time. z divides by sigma: 1 / sigma overflows + // for sigma below 1 / DBL_MAX, where y == exp(mu) would give 0 * inf. + auto z = eval(sign * (log(y_val) - mu_val) / sigma_val); + if constexpr (any_autodiff) { + const auto [values, slopes] = internal::std_normal_lcdf_value_grad(z); + auto scaled_slope = eval(slopes * inv(sigma_val)); if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = -rep_deriv / y_val; + partials<0>(ops_partials) = sign * scaled_slope / y_val; } if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = rep_deriv; + partials<1>(ops_partials) = -sign * scaled_slope; } if constexpr (is_autodiff_v) { - partials<2>(ops_partials) = rep_deriv * scaled_diff * SQRT_TWO; + partials<2>(ops_partials) + = select(scaled_slope == 0, 0.0, -scaled_slope * z); } + return ops_partials.build(sum(std::move(values))); + } else { + return sum(internal::std_normal_lcdf_value_grad(std::move(z))); } - return ops_partials.build(cdf_log); +} + +} // namespace internal + +template * = nullptr> +inline return_type_t lognormal_lcdf(T_y&& y, T_loc&& mu, + T_scale&& sigma) { + return internal::lognormal_lcdf_impl( + "lognormal_lcdf", std::forward(y), std::forward(mu), + std::forward(sigma)); } } // namespace math diff --git a/stan/math/prim/prob/neg_binomial_2_lpmf.hpp b/stan/math/prim/prob/neg_binomial_2_lpmf.hpp index b708d4ce3a9..ae64cf59815 100644 --- a/stan/math/prim/prob/neg_binomial_2_lpmf.hpp +++ b/stan/math/prim/prob/neg_binomial_2_lpmf.hpp @@ -6,6 +6,7 @@ #include #include #include +#include #include #include #include @@ -25,7 +26,6 @@ template * = nullptr> inline return_type_t neg_binomial_2_lpmf( const T_n& n, const T_location& mu, const T_precision& phi) { - using T_partials_return = partials_return_t; using std::log; using T_n_ref = ref_type_t; using T_mu_ref = ref_type_t; @@ -45,52 +45,54 @@ inline return_type_t neg_binomial_2_lpmf( if (size_zero(n, mu, phi)) { return 0.0; } - if constexpr (!include_summand::value) { + if constexpr (propto && !is_any_autodiff_v) { return 0.0; } - T_partials_return logp(0.0); - auto ops_partials = make_partials_propagator(mu_ref, phi_ref); - auto n_vec = as_array_or_scalar(as_column_vector_or_scalar(n_ref)); auto mu_vec = as_array_or_scalar(as_column_vector_or_scalar(mu_ref)); auto phi_vec = as_array_or_scalar(as_column_vector_or_scalar(phi_ref)); decltype(auto) mu_val = value_of(mu_vec); decltype(auto) phi_val = value_of(phi_vec); - auto log_phi = log(phi_val); auto mu_plus_phi = mu_val + phi_val; auto log_mu_plus_phi = log(mu_plus_phi); auto n_plus_phi = value_of(n_vec) + phi_val; - constexpr bool include_precision - = include_summand::value; - constexpr bool include_location = include_summand::value; - auto logp_calc = [&]() { - return -phi_val * (log1p(mu_val / phi_val)) - - value_of(n_vec) * log_mu_plus_phi; - }; - if constexpr (include_precision || include_location) { - if constexpr (include_precision && include_location) { - logp += sum(binomial_coefficient_log(n_plus_phi - 1, n_vec) - + multiply_log(n_vec, mu_val) + logp_calc()); - } else if constexpr (include_precision) { - logp - += sum(binomial_coefficient_log(n_plus_phi - 1, n_vec) + logp_calc()); - } else if constexpr (include_location) { - logp += sum(multiply_log(n_vec, mu_val) + logp_calc()); + if constexpr (is_any_autodiff_v) { + auto ops_partials = make_partials_propagator(mu_ref, phi_ref); + if constexpr (is_autodiff_v) { + partials<0>(ops_partials) + = n_vec / mu_val - (n_vec + phi_val) / mu_plus_phi; } + if constexpr (is_autodiff_v) { + auto log_phi = log(phi_val); + auto log_term = select(mu_val < phi_val, log1p(-mu_val / mu_plus_phi), + log_phi - log_mu_plus_phi); + partials<1>(ops_partials) = (mu_val - value_of(n_vec)) / mu_plus_phi + + log_term - digamma(phi_val) + + digamma(n_plus_phi); + } + if constexpr (!propto || is_all_autodiff_v) { + return ops_partials.build( + sum(binomial_coefficient_log(n_plus_phi - 1, n_vec) + + multiply_log(n_vec, mu_val) - phi_val * log1p(mu_val / phi_val) + - value_of(n_vec) * log_mu_plus_phi)); + } else if constexpr (is_autodiff_v) { + return ops_partials.build( + sum(binomial_coefficient_log(n_plus_phi - 1, n_vec) + - phi_val * log1p(mu_val / phi_val) + - value_of(n_vec) * log_mu_plus_phi)); + } else { + return ops_partials.build(sum(multiply_log(n_vec, mu_val) + - phi_val * log1p(mu_val / phi_val) + - value_of(n_vec) * log_mu_plus_phi)); + } + } else if constexpr (!propto) { + return sum(binomial_coefficient_log(n_plus_phi - 1, n_vec) + + multiply_log(n_vec, mu_val) - phi_val * log1p(mu_val / phi_val) + - value_of(n_vec) * log_mu_plus_phi); + } else { + return 0.0; } - if constexpr (is_autodiff_v) { - partials<0>(ops_partials) - = n_vec / mu_val - (n_vec + phi_val) / mu_plus_phi; - } - if constexpr (is_autodiff_v) { - auto log_term = select(mu_val < phi_val, log1p(-mu_val / mu_plus_phi), - log_phi - log_mu_plus_phi); - partials<1>(ops_partials) = (mu_val - value_of(n_vec)) / mu_plus_phi - + log_term - digamma(phi_val) - + digamma(n_plus_phi); - } - return ops_partials.build(logp); } template diff --git a/stan/math/prim/prob/normal_ccdf_log.hpp b/stan/math/prim/prob/normal_ccdf_log.hpp index d7df99b01dd..69b674ae862 100644 --- a/stan/math/prim/prob/normal_ccdf_log.hpp +++ b/stan/math/prim/prob/normal_ccdf_log.hpp @@ -11,9 +11,10 @@ namespace math { * @deprecated use normal_lccdf */ template -inline return_type_t normal_ccdf_log( - const T_y& y, const T_loc& mu, const T_scale& sigma) { - return normal_lccdf(y, mu, sigma); +inline return_type_t normal_ccdf_log(T_y&& y, T_loc&& mu, + T_scale&& sigma) { + return normal_lccdf(std::forward(y), std::forward(mu), + std::forward(sigma)); } } // namespace math diff --git a/stan/math/prim/prob/normal_cdf.hpp b/stan/math/prim/prob/normal_cdf.hpp index 5cb9bce6e0d..7a8dbe01c72 100644 --- a/stan/math/prim/prob/normal_cdf.hpp +++ b/stan/math/prim/prob/normal_cdf.hpp @@ -3,17 +3,14 @@ #include #include -#include -#include -#include -#include -#include -#include -#include +#include +#include +#include +#include #include -#include +#include +#include #include -#include namespace stan { namespace math { @@ -24,6 +21,10 @@ namespace math { * * \f$\Phi(x) = \frac{1}{\sqrt{2 \pi}} \int_{-\inf}^x e^{-t^2/2} dt\f$. * + * Each factor is `0.5 * erfc(-z / sqrt(2))` with `z = (y - mu) / sigma`, + * which has no cancellation for either sign; the partials are the cdf times + * `phi(z) / Phi(z)`. + * * @tparam T_y type of y * @tparam T_loc type of mean parameter * @tparam T_scale type of standard deviation parameter @@ -35,89 +36,49 @@ namespace math { template * = nullptr> -inline return_type_t normal_cdf(const T_y& y, - const T_loc& mu, - const T_scale& sigma) { - using T_partials_return = partials_return_t; - using std::exp; - using T_y_ref = ref_type_t; - using T_mu_ref = ref_type_t; - using T_sigma_ref = ref_type_t; +inline return_type_t normal_cdf(T_y&& y, T_loc&& mu, + T_scale&& sigma) { + using T_y_ref = ref_type_if_not_constant_t; + using T_mu_ref = ref_type_if_not_constant_t; + using T_sigma_ref = ref_type_if_not_constant_t; static constexpr const char* function = "normal_cdf"; check_consistent_sizes(function, "Random variable", y, "Location parameter", mu, "Scale parameter", sigma); - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - check_not_nan(function, "Random variable", y_ref); - check_finite(function, "Location parameter", mu_ref); - check_positive(function, "Scale parameter", sigma_ref); + T_y_ref y_ref = std::forward(y); + T_mu_ref mu_ref = std::forward(mu); + T_sigma_ref sigma_ref = std::forward(sigma); + // to_ref only reduces compile memory by evaluating expression arguments. + decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); + decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); + decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); + check_not_nan(function, "Random variable", y_val); + check_finite(function, "Location parameter", mu_val); + check_positive(function, "Scale parameter", sigma_val); - if (size_zero(y, mu, sigma)) { + if (size_zero(y_ref, mu_ref, sigma_ref)) { return 1.0; } - T_partials_return cdf(1.0); - auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref); - - scalar_seq_view y_vec(y_ref); - scalar_seq_view mu_vec(mu_ref); - scalar_seq_view sigma_vec(sigma_ref); - size_t N = max_size(y, mu, sigma); - - for (size_t n = 0; n < N; n++) { - const T_partials_return y_dbl = y_vec.val(n); - const T_partials_return mu_dbl = mu_vec.val(n); - const T_partials_return sigma_dbl = sigma_vec.val(n); - const T_partials_return scaled_diff - = (y_dbl - mu_dbl) / (sigma_dbl * SQRT_TWO); - T_partials_return cdf_n; - if (scaled_diff < -37.5 * INV_SQRT_TWO) { - cdf_n = 0.0; - } else if (scaled_diff < -5.0 * INV_SQRT_TWO) { - cdf_n = 0.5 * erfc(-scaled_diff); - } else if (scaled_diff > 8.25 * INV_SQRT_TWO) { - cdf_n = 1; - } else { - cdf_n = 0.5 * (1.0 + erf(scaled_diff)); + auto z = (y_val - mu_val) / sigma_val; + if constexpr (is_any_autodiff_v) { + const auto [values, ratios] = internal::std_normal_cdf_value_ratio(z); + const auto cdf = prod(values); + auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref); + auto scaled = eval(cdf * ratios / sigma_val); + if constexpr (is_autodiff_v) { + partials<0>(ops_partials) = scaled; } - - cdf *= cdf_n; - - if constexpr (is_any_autodiff_v) { - const T_partials_return rep_deriv - = (scaled_diff < -37.5 * INV_SQRT_TWO) - ? 0.0 - : INV_SQRT_TWO_PI * exp(-scaled_diff * scaled_diff) - / (cdf_n * sigma_dbl); - if constexpr (is_autodiff_v) { - partials<0>(ops_partials)[n] += rep_deriv; - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials)[n] -= rep_deriv; - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials)[n] -= rep_deriv * scaled_diff * SQRT_TWO; - } + if constexpr (is_autodiff_v) { + partials<1>(ops_partials) = -scaled; } - } - - if constexpr (is_autodiff_v) { - for (size_t n = 0; n < stan::math::size(y); ++n) { - partials<0>(ops_partials)[n] *= cdf; - } - } - if constexpr (is_autodiff_v) { - for (size_t n = 0; n < stan::math::size(mu); ++n) { - partials<1>(ops_partials)[n] *= cdf; - } - } - if constexpr (is_autodiff_v) { - for (size_t n = 0; n < stan::math::size(sigma); ++n) { - partials<2>(ops_partials)[n] *= cdf; + if constexpr (is_autodiff_v) { + // The infinite endpoints have a zero partial, not 0 * infinity. + partials<2>(ops_partials) = select(scaled == 0, 0.0, -scaled * z); } + return ops_partials.build(cdf); + } else { + return prod(internal::std_normal_cdf_value_ratio(std::move(z))); } - return ops_partials.build(cdf); } } // namespace math diff --git a/stan/math/prim/prob/normal_lccdf.hpp b/stan/math/prim/prob/normal_lccdf.hpp index cbdd074418c..b55cff0c53a 100644 --- a/stan/math/prim/prob/normal_lccdf.hpp +++ b/stan/math/prim/prob/normal_lccdf.hpp @@ -5,18 +5,15 @@ namespace stan { namespace math { -namespace internal { -constexpr char normal_lccdf_func[] = "normal_lccdf"; -} // namespace internal template * = nullptr> -inline return_type_t normal_lccdf(const T_y& y, - const T_loc& mu, - const T_scale& sigma) { - return normal_lcdf( - -as_array_or_scalar(y), -as_array_or_scalar(mu), sigma); +inline return_type_t normal_lccdf(T_y&& y, T_loc&& mu, + T_scale&& sigma) { + return internal::normal_lcdf_impl("normal_lccdf", std::forward(y), + std::forward(mu), + std::forward(sigma)); } } // namespace math diff --git a/stan/math/prim/prob/normal_lcdf.hpp b/stan/math/prim/prob/normal_lcdf.hpp index b7446c9fd82..b363dbad003 100644 --- a/stan/math/prim/prob/normal_lcdf.hpp +++ b/stan/math/prim/prob/normal_lcdf.hpp @@ -3,130 +3,82 @@ #include #include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include +#include +#include +#include +#include +#include +#include #include -#include -#include -#include #include -#include -#include +#include namespace stan { namespace math { namespace internal { -constexpr char normal_lcdf_func[] = "normal_lcdf"; + +/** Log of the normal cdf, or of its complement when `reflect` is set: the + * standardized value is negated so no negated autodiff operands are built. + */ +template +inline return_type_t normal_lcdf_impl(const char* function, + T_y&& y, T_loc&& mu, + T_scale&& sigma) { + using T_y_ref = ref_type_if_not_constant_t; + using T_mu_ref = ref_type_if_not_constant_t; + using T_sigma_ref = ref_type_if_not_constant_t; + constexpr bool any_autodiff = is_any_autodiff_v; + constexpr double sign = reflect ? -1.0 : 1.0; + check_consistent_sizes(function, "Random variable", y, "Location parameter", + mu, "Scale parameter", sigma); + T_y_ref y_ref = std::forward(y); + T_mu_ref mu_ref = std::forward(mu); + T_sigma_ref sigma_ref = std::forward(sigma); + // to_ref only reduces compile memory by evaluating expression arguments. + decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); + decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); + decltype(auto) sigma_val = to_ref(as_value_column_array_or_scalar(sigma_ref)); + check_not_nan(function, "Random variable", y_val); + check_finite(function, "Location parameter", mu_val); + check_positive(function, "Scale parameter", sigma_val); + + if (size_zero(y_ref, mu_ref, sigma_ref)) { + return 0; + } + + // z and scaled_slope are evaluated once: each is read more than once. z + // divides by sigma: 1 / sigma overflows for sigma below 1 / DBL_MAX, where + // y == mu would give 0 * inf. + auto z = eval(sign * (y_val - mu_val) / sigma_val); + if constexpr (any_autodiff) { + const auto [values, slopes] = internal::std_normal_lcdf_value_grad(z); + auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref); + auto scaled_slope = eval(slopes * inv(sigma_val)); + if constexpr (is_autodiff_v) { + partials<0>(ops_partials) = sign * scaled_slope; + } + if constexpr (is_autodiff_v) { + partials<1>(ops_partials) = -sign * scaled_slope; + } + if constexpr (is_autodiff_v) { + // The positive infinite endpoint has a zero slope, not 0 * infinity. + partials<2>(ops_partials) + = select(scaled_slope == 0, 0.0, -scaled_slope * z); + } + return ops_partials.build(sum(std::move(values))); + } else { + return sum(internal::std_normal_lcdf_value_grad(std::move(z))); + } +} + } // namespace internal /** \ingroup prob_dists * @brief Calculates the log of the cdf of the normal distribution * - * Tail branching follows three published results, and matches what other - * libraries do: - * - Abramowitz & Stegun (1964) 7.1.26 Page 299 gives - * `erf(x) = 1 - P(t) exp(-x^2)`, `t = 1/(1 + p x)`, with `exp(-x^2)` as a - * numerator factor: - * https://archive.org/details/handbookofmathem1964abra/page/298/mode/2up - * - Cody (1969), Math. Comp. 23:631-637, is the rational approximation used - * for the tail value: https://doi.org/10.1090/S0025-5718-1969-0247736-4 - * - Digital Library of Mathematical Functions (DLMF) 7.12.1 - * is the erfc asymptotic behind the far-tail Mills ratio: - * https://dlmf.nist.gov/7.12.E1 - * - * R's `pnorm` only ever forms the Gaussian factor in the numerator - * (the `do_del` macro), and switches to the Cody tail form at `y > M_SQRT_32`, - * i.e. `|x| > sqrt(32) ~= 5.657`. Since `scaled_diff = x / sqrt(2)`, that same - * crossover is `|scaled_diff| > sqrt(32)/sqrt(2) = 4` exactly, which is the - * cutoff used here for the cdf value. Measured by evaluating the - * `temp_p`/`temp_q` expression below against `log(erfc(-scaled_diff)/2)` at 60 - * significant digits, our Cody set holds to 8.6e-17 relative down to - * scaled_diff = -4 and degrades past about -3.52, so 4 sits just inside its - * range. This is the same as R's impl. - * https://github.com/wch/r-source/blob/trunk/src/nmath/pnorm.c - * SciPy's `log_ndtr` uses the identical `log1p(-erfc(t)/2)` upper branch with - * the same `t = x/sqrt(2)`, and needs no rational approximation or Taylor - * patches at all below `x = -1`, because `erfcx` never forms `exp(+t^2)`: - * https://github.com/scipy/xsf/blob/main/include/xsf/stats.h - * - * The interior cutoffs for the gradient are not from the literature. - * They were derived in stan-dev/math#1411 - * (Phil Clemson, Univ. of Liverpool, Nov 2019), fixing - * stan-dev/math#1284, which describes them as "original Taylor expansions - * that have been derived to bridge the gap where the numerical - * approximations are unstable". The author's account of how they were - * placed, from the review thread, was: "After playing around with the - * autodiff tester I found some regions where it was failing some of the - * tests, so I added some new approximations (Taylor expansions and fits of - * the residuals) to improve the accuracy." - * https://github.com/stan-dev/math/pull/1411 - * https://github.com/stan-dev/math/issues/1284 - * - * Each row of the chart below is one Taylor expansion around `scaled_diff`. - * `interval` is the range of `scaled_diff` it covers. - * `centre` is the point the series is expanded about. - * - * | interval | centre | half-width | - * |---|---|---| - * | (2.5, 2.9] | 2.7 | 0.200 | - * | (2.1, 2.5] | 2.3 | 0.200 | - * | (1.5, 2.1] | 1.85 | 0.300 | - * | (0.8, 1.5] | 1.15 | 0.350 | - * | (0.1, 0.8] | 0.45 | 0.350 | - * - * The cut points are not arbitrary. Each interval of `scaled_diff` is centred - * on its own Taylor point, which minimises the largest `|t|` the series has to - * cover. - * - * The second table below shows why each interval ends where it does: the - * series is accurate across its own range and falls apart just outside it, - * so the intervals cannot be widened to use fewer of them. - * - * Worst in-range comes from evaluating each Taylor polynomial as written - * against `(2/sqrt(pi)) * exp(-scaled_diff^2) / erfc(-scaled_diff)`, the exact - * derivative, at 60 significant digits. + * Uses the shared standard-normal kernel after standardization. See + * std_normal_lcdf_impl.hpp for the Cody approximations and their crossovers. * - * Columns below: - * `worst in-range`: The largest relative error of that branch's series over - * its own interval; - * `0.2 below lo`: The relative error the same series would give at `lo - 0.2`; - * `0.2 above hi`: The relative error the same series would give at `hi + 0.2`, - * i.e. what widening the interval either way would cost. - * - * | interval | worst in-range | 0.2 below lo | 0.2 above hi | - * |---|---|---|---| - * | (2.5, 2.9] | 3.27e-05 | 2.32e-05 | 1.61e-02 | - * | (2.1, 2.5] | 2.80e-05 | 3.25e-04 | 9.15e-03 | - * | (1.5, 2.1] | 2.30e-05 | 8.11e-05 | 3.77e-03 | - * | (0.8, 1.5] | 6.09e-05 | 9.29e-05 | 2.93e-03 | - * | (0.1, 0.8] | 7.61e-06 | 3.62e-05 | 2.82e-04 | - * - * The worst in-range error is uniformly 1e-5 to 6e-5, just inside the 1e-4 - * relative gradient tolerance `expect_ad` applies by default - * (`gradient_grad_` in test/unit/math/ad_tolerances.hpp; the 1e-8 there is - * `gradient_val_`, which bounds the value rather than the gradient), while - * widening an interval by 0.2 costs one to three orders of magnitude. That - * uniformity, not any published result, is the placement criterion. - * - * The `worst in-range` column is enforced: the branch_accuracy test in - * mix/prob/normal_cdf_log_test.cpp asserts every branch against - * 60-digit references at that error plus a small margin. - * - * The negative-tail residual corrections at `scaled_diff` of -2.1, -3.9, -7 and - * -17 are cubic fits of residuals from the same PR and likewise have no - * external source. The -29 cutoff below is justified by DLMF 7.12.1 - * - * @tparam func name reported by the error checks. Reflected distributions - * such as `normal_lccdf` delegate here and pass their own name so that - * exceptions name the function the user actually called. * @tparam T_y A vector or scalar type for the random variable. * @tparam T_loc A vector or scalar type for the location parameter. * @tparam T_scale A vector or scalar type for the scale parameter. @@ -136,216 +88,14 @@ constexpr char normal_lcdf_func[] = "normal_lcdf"; * @return The log of the normal cdf evaluated at the specified arguments. If * given containers, the log of the product of the cdfs. */ -template * = nullptr> -inline return_type_t normal_lcdf(const T_y& y, - const T_loc& mu, - const T_scale& sigma) { - using T_partials_return = partials_return_t; - using T_y_ref = ref_type_t; - using T_mu_ref = ref_type_t; - using T_sigma_ref = ref_type_t; - static constexpr const char* function = func; - check_consistent_sizes(function, "Random variable", y, "Location parameter", - mu, "Scale parameter", sigma); - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - check_not_nan(function, "Random variable", y_ref); - check_finite(function, "Location parameter", mu_ref); - check_positive(function, "Scale parameter", sigma_ref); - - if (size_zero(y, mu, sigma)) { - return 0; - } - - T_partials_return cdf_log(0.0); - auto ops_partials = make_partials_propagator(y_ref, mu_ref, sigma_ref); - - scalar_seq_view y_vec(y_ref); - scalar_seq_view mu_vec(mu_ref); - scalar_seq_view sigma_vec(sigma_ref); - size_t N = max_size(y, mu, sigma); - - for (size_t n = 0; n < N; n++) { - const T_partials_return y_dbl = y_vec.val(n); - const T_partials_return mu_dbl = mu_vec.val(n); - const T_partials_return sigma_dbl = sigma_vec.val(n); - - const T_partials_return scaled_diff - = (y_dbl - mu_dbl) / (sigma_dbl * SQRT_TWO); - - const T_partials_return x2 = square(scaled_diff); - - // Rigorous numerical approximations are applied here to deal with values - // of |scaled_diff|>>0. This is needed to deal with rare base-rate - // logistic regression problems where it is useful to use an alternative - // link function instead. - // - // use erfc() instead of erf() in order to retain precision - // since for x>0 erfc()->0 - if (scaled_diff > 0.0) { - // CDF(x) = 1/2 + 1/2erf(x) = 1 - 1/2erfc(x) - cdf_log += log1p(-0.5 * erfc(scaled_diff)); - if (!is_not_nan(cdf_log)) { - cdf_log = 0; - } - } else if (scaled_diff > -4.0) { - // CDF(x) = 1/2 - 1/2erf(-x) = 1/2erfc(-x); -4 is R pnorm's M_SQRT_32 - // Since we scale by sqrt(2), we use sqrt(32)/sqrt(2) = 4 - cdf_log += log(erfc(-scaled_diff)) + LOG_HALF; - } else if (10.0 * log(fabs(scaled_diff)) - < log(std::numeric_limits::max())) { - // entering territory where erfc(-x)~0 - // need to use direct numerical approximation of cdf_log instead - // the following based on W. J. Cody, Math. Comp. 23(107):631-638 (1969) - // CDF(x) = 1/2erfc(-x) - const T_partials_return x4 = pow(scaled_diff, 4); - const T_partials_return x6 = pow(scaled_diff, 6); - const T_partials_return x8 = pow(scaled_diff, 8); - const T_partials_return x10 = pow(scaled_diff, 10); - const T_partials_return temp_p - = 0.000658749161529837803157 + 0.0160837851487422766278 / x2 - + 0.125781726111229246204 / x4 + 0.360344899949804439429 / x6 - + 0.305326634961232344035 / x8 + 0.0163153871373020978498 / x10; - const T_partials_return temp_q - = -0.00233520497626869185443 - 0.0605183413124413191178 / x2 - - 0.527905102951428412248 / x4 - 1.87295284992346047209 / x6 - - 2.56852019228982242072 / x8 - 1.0 / x10; - cdf_log += LOG_HALF + log(INV_SQRT_PI + (temp_p / temp_q) / x2) - - log(-scaled_diff) - x2; - } else { - // scaled_diff^10 term will overflow - cdf_log = stan::math::negative_infinity(); - } - - if constexpr (is_any_autodiff_v) { - // compute partial derivatives - // based on analytic form given by: - // dln(CDF)/dx = exp(-x^2)/(sqrt(pi)*(1/2+erf(x)/2) - T_partials_return dncdf_log = 0.0; - T_partials_return t = 0.0; - T_partials_return t2 = 0.0; - T_partials_return t4 = 0.0; - - // calculate using piecewise function - // (due to instability / inaccuracy in the various approximations) - if (scaled_diff > 2.9) { - // approximation derived from Abramowitz and Stegun (1964) 7.1.26 - t = 1.0 / (1.0 + 0.3275911 * scaled_diff); - t2 = square(t); - t4 = pow(t, 4); - // A&S 7.1.26 puts exp(-x2) in the numerator; keep it there so it - // underflows to zero instead of overflowing inside a denominator - const T_partials_return exp_m_x2 = exp(-x2); - dncdf_log - = exp_m_x2 - / (SQRT_PI - * (1.0 - - exp_m_x2 - * (0.254829592 - 0.284496736 * t + 1.421413741 * t2 - - 1.453152027 * t2 * t + 1.061405429 * t4))); - } else if (scaled_diff > 2.5) { - // in the trouble area where all of the standard numerical - // approximations are unstable - bridge the gap using Taylor - // expansions of the analytic function - // use Taylor expansion centred around x=2.7 - t = scaled_diff - 2.7; - t2 = square(t); - t4 = pow(t, 4); - dncdf_log = 0.0003849882382 - 0.002079084702 * t + 0.005229340880 * t2 - - 0.008029540137 * t2 * t + 0.008232190507 * t4 - - 0.005692364250 * t4 * t + 0.002399496363 * pow(t, 6); - } else if (scaled_diff > 2.1) { - // use Taylor expansion centred around x=2.3 - t = scaled_diff - 2.3; - t2 = square(t); - t4 = pow(t, 4); - dncdf_log = 0.002846135439 - 0.01310032351 * t + 0.02732189391 * t2 - - 0.03326906904 * t2 * t + 0.02482478940 * t4 - - 0.009883071924 * t4 * t - 0.0002771362254 * pow(t, 6); - } else if (scaled_diff > 1.5) { - // use Taylor expansion centred around x=1.85 - t = scaled_diff - 1.85; - t2 = square(t); - t4 = pow(t, 4); - dncdf_log = 0.01849212058 - 0.06876280470 * t + 0.1099906382 * t2 - - 0.09274533184 * t2 * t + 0.03543327418 * t4 - + 0.005644855518 * t4 * t - 0.01111434424 * pow(t, 6); - } else if (scaled_diff > 0.8) { - // use Taylor expansion centred around x=1.15 - t = scaled_diff - 1.15; - t2 = square(t); - t4 = pow(t, 4); - dncdf_log = 0.1585747034 - 0.3898677543 * t + 0.3515963775 * t2 - - 0.09748053605 * t2 * t - 0.04347986191 * t4 - + 0.02182506378 * t4 * t + 0.01074751427 * pow(t, 6); - } else if (scaled_diff > 0.1) { - // use Taylor expansion centred around x=0.45 - t = scaled_diff - 0.45; - t2 = square(t); - t4 = pow(t, 4); - dncdf_log = 0.6245634904 - 0.9521866949 * t + 0.3986215682 * t2 - + 0.04700850676 * t2 * t - 0.03478651979 * t4 - - 0.01772675404 * t4 * t + 0.0006577254811 * pow(t, 6); - } else if (scaled_diff < -29.0) { - // asymptotic Mills ratio, DLMF 7.12.1: dncdf_log grows linearly as - // -2*scaled_diff, so no quadratic residual fit can track it - const T_partials_return inv_x2 = 1.0 / x2; - dncdf_log - = -2.0 * scaled_diff - / (1.0 + inv_x2 * (-0.5 + inv_x2 * (0.75 + inv_x2 * -1.875))); - } else if (10.0 * log(fabs(scaled_diff)) - < log(std::numeric_limits::max())) { - // approximation derived from Abramowitz and Stegun (1964) 7.1.26 - // use fact that erf(x)=-erf(-x) - // Abramowitz and Stegun define this for -inf) { - partials<0>(ops_partials)[n] += dncdf_log / sigma_sqrt2; - } - if constexpr (is_autodiff_v) { - partials<1>(ops_partials)[n] -= dncdf_log / sigma_sqrt2; - } - if constexpr (is_autodiff_v) { - partials<2>(ops_partials)[n] -= dncdf_log * scaled_diff / sigma_dbl; - } - } - } - return ops_partials.build(cdf_log); +inline return_type_t normal_lcdf(T_y&& y, T_loc&& mu, + T_scale&& sigma) { + return internal::normal_lcdf_impl("normal_lcdf", std::forward(y), + std::forward(mu), + std::forward(sigma)); } } // namespace math diff --git a/stan/math/prim/prob/skew_normal_lpdf.hpp b/stan/math/prim/prob/skew_normal_lpdf.hpp index 50ed5217858..3006e38eff3 100644 --- a/stan/math/prim/prob/skew_normal_lpdf.hpp +++ b/stan/math/prim/prob/skew_normal_lpdf.hpp @@ -7,17 +7,18 @@ #include #include #include -#include -#include -#include +#include +#include #include #include -#include #include +#include #include #include #include +#include #include +#include namespace stan { namespace math { @@ -27,20 +28,20 @@ template * = nullptr> inline return_type_t skew_normal_lpdf( - const T_y& y, const T_loc& mu, const T_scale& sigma, const T_shape& alpha) { - using T_partials_return = partials_return_t; + T_y&& y, T_loc&& mu, T_scale&& sigma, T_shape&& alpha) { using T_y_ref = ref_type_if_not_constant_t; using T_mu_ref = ref_type_if_not_constant_t; using T_sigma_ref = ref_type_if_not_constant_t; using T_alpha_ref = ref_type_if_not_constant_t; static constexpr const char* function = "skew_normal_lpdf"; + constexpr bool any_autodiff = is_any_autodiff_v; check_consistent_sizes(function, "Random variable", y, "Location parameter", mu, "Scale parameter", sigma, "Shape parameter", alpha); - T_y_ref y_ref = y; - T_mu_ref mu_ref = mu; - T_sigma_ref sigma_ref = sigma; - T_alpha_ref alpha_ref = alpha; + T_y_ref y_ref = std::forward(y); + T_mu_ref mu_ref = std::forward(mu); + T_sigma_ref sigma_ref = std::forward(sigma); + T_alpha_ref alpha_ref = std::forward(alpha); decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); decltype(auto) mu_val = to_ref(as_value_column_array_or_scalar(mu_ref)); @@ -52,74 +53,69 @@ inline return_type_t skew_normal_lpdf( check_finite(function, "Shape parameter", alpha_val); check_positive(function, "Scale parameter", sigma_val); - if (size_zero(y, mu, sigma, alpha)) { + if (size_zero(y_ref, mu_ref, sigma_ref, alpha_ref)) { return 0.0; } - if constexpr (!include_summand::value) { + if constexpr (propto && !is_any_autodiff_v) { return 0.0; } - auto ops_partials - = make_partials_propagator(y_ref, mu_ref, sigma_ref, alpha_ref); + auto inv_sigma = inv(sigma_val); + auto z = (y_val - mu_val) * inv_sigma; + auto az = alpha_val * z; - const auto& inv_sigma - = to_ref_if>(inv(sigma_val)); - const auto& y_minus_mu_over_sigma - = to_ref_if::value>( - (y_val - mu_val) * inv_sigma); - const auto& log_erfc_alpha_z - = to_ref_if>( - log(erfc(-alpha_val * y_minus_mu_over_sigma * INV_SQRT_TWO))); - - size_t N = max_size(y, mu, sigma, alpha); - T_partials_return logp = sum(log_erfc_alpha_z); - if constexpr (include_summand::value) { - logp -= HALF_LOG_TWO_PI * N; - } - if constexpr (include_summand::value) { - logp -= sum(log(sigma_val)) * N / math::size(sigma); - } - if constexpr (include_summand::value) { - logp -= sum(square(y_minus_mu_over_sigma)) * 0.5 * N - / max_size(y, mu, sigma); - } - - if constexpr (is_any_autodiff_v) { - const auto& sq = square(alpha_val * y_minus_mu_over_sigma * INV_SQRT_TWO); - const auto& ex = exp(-sq - log_erfc_alpha_z); - auto deriv_logerf = to_ref_if< - is_any_autodiff_v< - T_y, T_loc> + is_autodiff_v + is_autodiff_v >= 2>( - SQRT_TWO_OVER_SQRT_PI * ex); - if constexpr (is_any_autodiff_v) { - auto deriv_y_loc - = to_ref_if<(is_autodiff_v && is_autodiff_v)>( - (y_minus_mu_over_sigma - deriv_logerf * alpha_val) * inv_sigma); + size_t N = max_size(y_ref, mu_ref, sigma_ref, alpha_ref); + auto log_normalizer = N * (propto ? LOG_TWO : LOG_TWO - HALF_LOG_TWO_PI); + if constexpr (any_autodiff) { + const auto [values, slopes] + = internal::std_normal_lcdf_value_grad(az); + auto ops_partials + = make_partials_propagator(y_ref, mu_ref, sigma_ref, alpha_ref); + // The partials read z and score several times, so both are evaluated + // once; the value-only branch reads z twice and keeps it lazy. + auto z_eval = eval(z); + if constexpr (is_any_autodiff_v) { + auto score = eval((slopes * alpha_val - z_eval) * inv_sigma); if constexpr (is_autodiff_v) { - partials<0>(ops_partials) = -deriv_y_loc; + partials<0>(ops_partials) = score; } if constexpr (is_autodiff_v) { - partials<1>(ops_partials) = std::move(deriv_y_loc); + partials<1>(ops_partials) = -score; + } + if constexpr (is_autodiff_v) { + partials<2>(ops_partials) = -score * z_eval - inv_sigma; } - } - if constexpr (is_autodiff_v) { - edge<2>(ops_partials).partials_ - = ((y_minus_mu_over_sigma - deriv_logerf * alpha_val) - * y_minus_mu_over_sigma - - 1) - * inv_sigma; } if constexpr (is_autodiff_v) { - partials<3>(ops_partials) = deriv_logerf * y_minus_mu_over_sigma; + partials<3>(ops_partials) = slopes * z_eval; + } + // Scalar terms broadcast over the N elements of values, so one sum scales + // each term by N / size(term). + if constexpr (!propto || is_autodiff_v) { + return ops_partials.build( + sum(values - 0.5 * square(z_eval) - log(sigma_val)) + log_normalizer); + } else if constexpr (is_any_autodiff_v) { + return ops_partials.build(sum(values - 0.5 * square(z_eval)) + + log_normalizer); + } else { + return ops_partials.build(sum(values) + log_normalizer); + } + } else { + const auto values = internal::std_normal_lcdf_value_grad(az); + if constexpr (!propto) { + return sum(values - 0.5 * square(z) - log(sigma_val)) + log_normalizer; + } else { + return 0.0; } } - return ops_partials.build(logp); } template inline return_type_t skew_normal_lpdf( - const T_y& y, const T_loc& mu, const T_scale& sigma, const T_shape& alpha) { - return skew_normal_lpdf(y, mu, sigma, alpha); + T_y&& y, T_loc&& mu, T_scale&& sigma, T_shape&& alpha) { + return skew_normal_lpdf(std::forward(y), std::forward(mu), + std::forward(sigma), + std::forward(alpha)); } } // namespace math diff --git a/stan/math/prim/prob/std_normal_ccdf_log.hpp b/stan/math/prim/prob/std_normal_ccdf_log.hpp index 70db6c52fc3..3d8e1b05f8e 100644 --- a/stan/math/prim/prob/std_normal_ccdf_log.hpp +++ b/stan/math/prim/prob/std_normal_ccdf_log.hpp @@ -12,7 +12,7 @@ namespace math { */ template inline return_type_t std_normal_ccdf_log(const T_y& y) { - return std_normal_lccdf(y); + return std_normal_lccdf(y); } } // namespace math diff --git a/stan/math/prim/prob/std_normal_cdf.hpp b/stan/math/prim/prob/std_normal_cdf.hpp index 2fc86dc1d9f..345972574b5 100644 --- a/stan/math/prim/prob/std_normal_cdf.hpp +++ b/stan/math/prim/prob/std_normal_cdf.hpp @@ -3,16 +3,12 @@ #include #include -#include -#include -#include -#include -#include -#include +#include +#include #include -#include +#include +#include #include -#include namespace stan { namespace math { @@ -23,6 +19,9 @@ namespace math { * * \f$\Phi(x) = \frac{1}{\sqrt{2 \pi}} \int_{-\inf}^x e^{-t^2/2} dt\f$. * + * Each factor is `0.5 * erfc(-x / sqrt(2))`, which has no cancellation for + * either sign; the partials are the cdf times `phi(x) / Phi(x)`. + * * @tparam T_y type of y * @param y scalar variate * @return The standard normal cdf evaluated at the specified argument. @@ -30,58 +29,27 @@ namespace math { template < typename T_y, require_all_not_nonscalar_prim_or_rev_kernel_expression_t* = nullptr> -inline return_type_t std_normal_cdf(const T_y& y) { - using T_partials_return = partials_return_t; - using std::exp; - using T_y_ref = ref_type_t; +inline return_type_t std_normal_cdf(T_y&& y) { + using T_y_ref = ref_type_if_not_constant_t; static constexpr const char* function = "std_normal_cdf"; - T_y_ref y_ref = y; - check_not_nan(function, "Random variable", y_ref); + T_y_ref y_ref = std::forward(y); + // to_ref evaluates an expression argument once for the check and kernel. + decltype(auto) y_val = to_ref(as_value_column_array_or_scalar(y_ref)); + check_not_nan(function, "Random variable", y_val); - if (size_zero(y)) { + if (size_zero(y_ref)) { return 1.0; } - - T_partials_return cdf(1.0); - auto ops_partials = make_partials_propagator(y_ref); - - scalar_seq_view y_vec(y_ref); - size_t N = stan::math::size(y); - - for (size_t n = 0; n < N; n++) { - const T_partials_return y_dbl = y_vec.val(n); - const T_partials_return scaled_y = y_dbl * INV_SQRT_TWO; - T_partials_return cdf_n; - if (y_dbl < -37.5) { - cdf_n = 0.0; - } else if (y_dbl < -5.0) { - cdf_n = 0.5 * erfc(-scaled_y); - } else if (y_dbl > 8.25) { - cdf_n = 1; - } else { - cdf_n = 0.5 * (1.0 + erf(scaled_y)); - } - - cdf *= cdf_n; - - if constexpr (is_autodiff_v) { - const T_partials_return rep_deriv - = (y_dbl < -37.5) - ? 0.0 - : INV_SQRT_TWO_PI * exp(-scaled_y * scaled_y) / cdf_n; - if constexpr (is_autodiff_v) { - partials<0>(ops_partials)[n] += rep_deriv; - } - } - } - if constexpr (is_autodiff_v) { - for (size_t n = 0; n < N; ++n) { - partials<0>(ops_partials)[n] *= cdf; - } + const auto [values, ratios] + = internal::std_normal_cdf_value_ratio(y_val); + const auto cdf = prod(values); + auto ops_partials = make_partials_propagator(y_ref); + partials<0>(ops_partials) = cdf * ratios; + return ops_partials.build(cdf); + } else { + return prod(internal::std_normal_cdf_value_ratio(y_val)); } - - return ops_partials.build(cdf); } } // namespace math diff --git a/stan/math/prim/prob/std_normal_lccdf.hpp b/stan/math/prim/prob/std_normal_lccdf.hpp index baf52f18156..786cc1553ef 100644 --- a/stan/math/prim/prob/std_normal_lccdf.hpp +++ b/stan/math/prim/prob/std_normal_lccdf.hpp @@ -1,20 +1,17 @@ #ifndef STAN_MATH_PRIM_PROB_STD_NORMAL_LCCDF_HPP #define STAN_MATH_PRIM_PROB_STD_NORMAL_LCCDF_HPP -#include +#include namespace stan { namespace math { -namespace internal { -constexpr char std_normal_lccdf_func[] = "std_normal_lccdf"; -} // namespace internal template < typename T_y, require_all_not_nonscalar_prim_or_rev_kernel_expression_t* = nullptr> -inline return_type_t std_normal_lccdf(const T_y& y) { - return std_normal_lcdf( - -as_array_or_scalar(y)); +inline return_type_t std_normal_lccdf(T_y&& y) { + return internal::std_normal_lcdf_impl("std_normal_lccdf", + std::forward(y)); } } // namespace math diff --git a/stan/math/prim/prob/std_normal_lcdf.hpp b/stan/math/prim/prob/std_normal_lcdf.hpp index 738fe948765..421b5d09b5a 100644 --- a/stan/math/prim/prob/std_normal_lcdf.hpp +++ b/stan/math/prim/prob/std_normal_lcdf.hpp @@ -2,239 +2,29 @@ #define STAN_MATH_PRIM_PROB_STD_NORMAL_LCDF_HPP #include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include +#include +#include namespace stan { namespace math { -namespace internal { -constexpr char std_normal_lcdf_func[] = "std_normal_lcdf"; -} // namespace internal /** \ingroup prob_dists * @brief Calculates the log of the cdf of the standard normal distribution * - * The piecewise structure here is the same as `normal_lcdf`, and the - * cutoffs, their provenance and the measurements behind them are documented - * once, on that function. See prim/prob/normal_lcdf.hpp. That covers the - * A&S 7.1.26, Cody (1969) and DLMF 7.12.1 references, the R `pnorm` and - * SciPy `log_ndtr` cross-references, why the erfc/Cody crossover sits at 4, - * the stan-dev/math#1411 origin of the interior Taylor cutoffs, and the two - * cutoff tables. + * Shares the scalar value and slope calculation with normal_lcdf through + * std_normal_lcdf_impl.hpp. * - * Two differences apply when reading it here. The scaled variable is - * `scaled_y = y * INV_SQRT_TWO`, not `scaled_diff = (y - mu) / (sigma * - * SQRT_TWO)`; since `mu = 0` and `sigma = 1` the two coincide, so every - * cutoff value transfers unchanged. And the test that enforces the - * `worst in-range` column for this function is the branch_accuracy test in - * mix/prob/std_normal_cdf_log_test.cpp. - * - * @tparam func name reported by the error checks. Reflected distributions - * such as `std_normal_lccdf` delegate here and pass their own name so that - * exceptions name the function the user actually called. * @tparam T_y A vector or scalar type for the random variable. * @param y (Sequence of) scalar(s). * @return The log of the standard normal cdf evaluated at the specified * argument. If given a container, the log of the product of the cdfs. */ template < - const char* func = internal::std_normal_lcdf_func, typename T_y, + typename T_y, require_all_not_nonscalar_prim_or_rev_kernel_expression_t* = nullptr> -inline return_type_t std_normal_lcdf(const T_y& y) { - using T_partials_return = partials_return_t; - using std::exp; - using std::fabs; - using std::log; - using std::pow; - using T_y_ref = ref_type_t; - static constexpr const char* function = func; - T_y_ref y_ref = y; - check_not_nan(function, "Random variable", y_ref); - - if (size_zero(y)) { - return 0; - } - - T_partials_return lcdf(0.0); - auto ops_partials = make_partials_propagator(y_ref); - - scalar_seq_view y_vec(y_ref); - size_t N = stan::math::size(y); - - for (size_t n = 0; n < N; n++) { - const T_partials_return y_dbl = y_vec.val(n); - const T_partials_return scaled_y = y_dbl * INV_SQRT_TWO; - const T_partials_return x2 = square(scaled_y); - - // Rigorous numerical approximations are applied here to deal with values - // of |scaled_y|>>0. This is needed to deal with rare base-rate - // logistic regression problems where it is useful to use an alternative - // link function instead. - // - // use erfc() instead of erf() in order to retain precision - // since for x>0 erfc()->0 - if (scaled_y > 0.0) { - // CDF(x) = 1/2 + 1/2erf(x) = 1 - 1/2erfc(x) - lcdf += log1p(-0.5 * erfc(scaled_y)); - if (!is_not_nan(lcdf)) { - lcdf = 0; - } - } else if (scaled_y > -4.0) { - // CDF(x) = 1/2 - 1/2erf(-x) = 1/2erfc(-x); -4 is R pnorm's M_SQRT_32 - // crossover expressed in scaled_y, sqrt(32)/sqrt(2) - lcdf += log(erfc(-scaled_y)) + LOG_HALF; - } else if (10.0 * log(fabs(scaled_y)) - < log(std::numeric_limits::max())) { - // entering territory where erfc(-x)~0 - // need to use direct numerical approximation of lcdf instead - // the following based on W. J. Cody, Math. Comp. 23(107):631-638 (1969) - // CDF(x) = 1/2erfc(-x) - const T_partials_return x4 = pow(scaled_y, 4); - const T_partials_return x6 = pow(scaled_y, 6); - const T_partials_return x8 = pow(scaled_y, 8); - const T_partials_return x10 = pow(scaled_y, 10); - const T_partials_return temp_p - = 0.000658749161529837803157 + 0.0160837851487422766278 / x2 - + 0.125781726111229246204 / x4 + 0.360344899949804439429 / x6 - + 0.305326634961232344035 / x8 + 0.0163153871373020978498 / x10; - const T_partials_return temp_q - = -0.00233520497626869185443 - 0.0605183413124413191178 / x2 - - 0.527905102951428412248 / x4 - 1.87295284992346047209 / x6 - - 2.56852019228982242072 / x8 - 1.0 / x10; - lcdf += LOG_HALF + log(INV_SQRT_PI + (temp_p / temp_q) / x2) - - log(-scaled_y) - x2; - } else { - // scaled_y^10 term will overflow - lcdf = stan::math::negative_infinity(); - } - - if constexpr (is_autodiff_v) { - // compute partial derivatives - // based on analytic form given by: - // dln(CDF)/dx = exp(-x^2)/(sqrt(pi)*(1/2+erf(x)/2) - T_partials_return dnlcdf = 0.0; - T_partials_return t = 0.0; - T_partials_return t2 = 0.0; - T_partials_return t4 = 0.0; - - // calculate using piecewise function - // (due to instability / inaccuracy in the various approximations) - if (scaled_y > 2.9) { - // approximation derived from Abramowitz and Stegun (1964) 7.1.26 - t = 1.0 / (1.0 + 0.3275911 * scaled_y); - t2 = square(t); - t4 = pow(t, 4); - // A&S 7.1.26 puts exp(-x2) in the numerator; keep it there so it - // underflows to zero instead of overflowing inside a denominator - const T_partials_return exp_m_x2 = exp(-x2); - dnlcdf = INV_SQRT_PI * exp_m_x2 - / (1.0 - - exp_m_x2 - * (0.254829592 - 0.284496736 * t + 1.421413741 * t2 - - 1.453152027 * t2 * t + 1.061405429 * t4)); - } else if (scaled_y > 2.5) { - // in the trouble area where all of the standard numerical - // approximations are unstable - bridge the gap using Taylor - // expansions of the analytic function - // use Taylor expansion centred around x=2.7 - t = scaled_y - 2.7; - t2 = square(t); - t4 = pow(t, 4); - dnlcdf = 0.0003849882382 - 0.002079084702 * t + 0.005229340880 * t2 - - 0.008029540137 * t2 * t + 0.008232190507 * t4 - - 0.005692364250 * t4 * t + 0.002399496363 * pow(t, 6); - } else if (scaled_y > 2.1) { - // use Taylor expansion centred around x=2.3 - t = scaled_y - 2.3; - t2 = square(t); - t4 = pow(t, 4); - dnlcdf = 0.002846135439 - 0.01310032351 * t + 0.02732189391 * t2 - - 0.03326906904 * t2 * t + 0.02482478940 * t4 - - 0.009883071924 * t4 * t - 0.0002771362254 * pow(t, 6); - } else if (scaled_y > 1.5) { - // use Taylor expansion centred around x=1.85 - t = scaled_y - 1.85; - t2 = square(t); - t4 = pow(t, 4); - dnlcdf = 0.01849212058 - 0.06876280470 * t + 0.1099906382 * t2 - - 0.09274533184 * t2 * t + 0.03543327418 * t4 - + 0.005644855518 * t4 * t - 0.01111434424 * pow(t, 6); - } else if (scaled_y > 0.8) { - // use Taylor expansion centred around x=1.15 - t = scaled_y - 1.15; - t2 = square(t); - t4 = pow(t, 4); - dnlcdf = 0.1585747034 - 0.3898677543 * t + 0.3515963775 * t2 - - 0.09748053605 * t2 * t - 0.04347986191 * t4 - + 0.02182506378 * t4 * t + 0.01074751427 * pow(t, 6); - } else if (scaled_y > 0.1) { - // use Taylor expansion centred around x=0.45 - t = scaled_y - 0.45; - t2 = square(t); - t4 = pow(t, 4); - dnlcdf = 0.6245634904 - 0.9521866949 * t + 0.3986215682 * t2 - + 0.04700850676 * t2 * t - 0.03478651979 * t4 - - 0.01772675404 * t4 * t + 0.0006577254811 * pow(t, 6); - } else if (scaled_y < -29.0) { - // asymptotic Mills ratio, DLMF 7.12.1: dnlcdf grows linearly as - // -2*scaled_y, so no quadratic residual fit can track it - const T_partials_return inv_x2 = 1.0 / x2; - dnlcdf = -2.0 * scaled_y - / (1.0 + inv_x2 * (-0.5 + inv_x2 * (0.75 + inv_x2 * -1.875))); - } else if (10.0 * log(fabs(scaled_y)) - < log(std::numeric_limits::max())) { - // approximation derived from Abramowitz and Stegun (1964) 7.1.26 - // use fact that erf(x)=-erf(-x) - // Abramowitz and Stegun define this for -inf) { - partials<0>(ops_partials)[n] += dnlcdf * INV_SQRT_TWO; - } - } - } - - return ops_partials.build(lcdf); +inline return_type_t std_normal_lcdf(T_y&& y) { + return internal::std_normal_lcdf_impl("std_normal_lcdf", + std::forward(y)); } } // namespace math diff --git a/stan/math/rev/fun/Phi.hpp b/stan/math/rev/fun/Phi.hpp index 06f62cb885a..da9d473eb6a 100644 --- a/stan/math/rev/fun/Phi.hpp +++ b/stan/math/rev/fun/Phi.hpp @@ -23,9 +23,7 @@ namespace math { \f[ \mbox{Phi}(x) = \begin{cases} - 0 & \mbox{if } x < -37.5 \\ - \Phi(x) & \mbox{if } -37.5 \leq x \leq 8.25 \\ - 1 & \mbox{if } x > 8.25 \\[6pt] + \Phi(x) & \mbox{if } -\infty \leq x \leq \infty \\[6pt] \textrm{error} & \mbox{if } x = \textrm{NaN} \end{cases} \f] diff --git a/stan/math/rev/fun/as_array_or_scalar.hpp b/stan/math/rev/fun/as_array_or_scalar.hpp index fddebcad31d..957ef0092be 100644 --- a/stan/math/rev/fun/as_array_or_scalar.hpp +++ b/stan/math/rev/fun/as_array_or_scalar.hpp @@ -17,8 +17,12 @@ namespace math { * @return `var_value<>` with Matrix converted to an array. */ template * = nullptr> -inline auto as_array_or_scalar(T&& v) { - return v.array(); +inline decltype(auto) as_array_or_scalar(T&& v) { + if constexpr (is_eigen_array>::value) { + return std::decay_t(std::forward(v)); + } else { + return std::forward(v).array(); + } } } // namespace math diff --git a/test/unit/math/mix/prob/exp_mod_normal_ccdf_log_test.cpp b/test/unit/math/mix/prob/exp_mod_normal_ccdf_log_test.cpp new file mode 100644 index 00000000000..197f2bf4c13 --- /dev/null +++ b/test/unit/math/mix/prob/exp_mod_normal_ccdf_log_test.cpp @@ -0,0 +1,30 @@ +#include +#include + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_lccdf) { + auto f = [](const auto& p) { + return stan::math::exp_mod_normal_lccdf(p[0], p[1], p[2], p[3]); + }; + + for (double y : {-40.0, -10.0, -3.0, 0.3, 4.0, 60.0}) { + stan::test::expect_ad(f, Eigen::Vector4d(y, 0.1, 1.3, 0.7)); + } + stan::test::expect_ad( + [](const auto& mu, const auto& sigma, const auto& lambda) { + return stan::math::exp_mod_normal_lccdf(Eigen::Vector3d(-40, 0.3, 60), + mu, sigma, lambda); + }, + 0.1, 1.3, 0.7); +} + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_lccdf_tails_and_endpoints) { + using stan::math::exp_mod_normal_lccdf; + using stan::math::INFTY; + using stan::math::NEGATIVE_INFTY; + // MPFR references for mu = 0, sigma = 1, lambda = 1. + EXPECT_NEAR(-1.353310396e-10, exp_mod_normal_lccdf(-6.0, 0.0, 1.0, 1.0), + 1e-18); + EXPECT_FLOAT_EQ(-799.5, exp_mod_normal_lccdf(800.0, 0.0, 1.0, 1.0)); + EXPECT_EQ(0, exp_mod_normal_lccdf(NEGATIVE_INFTY, 0.0, 1.0, 1.0)); + EXPECT_EQ(NEGATIVE_INFTY, exp_mod_normal_lccdf(INFTY, 0.0, 1.0, 1.0)); +} diff --git a/test/unit/math/mix/prob/exp_mod_normal_cdf_log_test.cpp b/test/unit/math/mix/prob/exp_mod_normal_cdf_log_test.cpp new file mode 100644 index 00000000000..cd5f17cc747 --- /dev/null +++ b/test/unit/math/mix/prob/exp_mod_normal_cdf_log_test.cpp @@ -0,0 +1,38 @@ +#include +#include + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_lcdf) { + auto f = [](const auto& p) { + return stan::math::exp_mod_normal_lcdf(p[0], p[1], p[2], p[3]); + }; + + for (double y : {-10.0, -3.0, 0.3, 4.0, 60.0}) { + stan::test::expect_ad(f, Eigen::Vector4d(y, 0.1, 1.3, 0.7)); + } + // Deep lower tail: log_diff_exp of two ~-480 terms is ill-conditioned for + // the finite-difference third derivatives. + stan::test::ad_tolerances tols; + tols.grad_hessian_grad_hessian_ = 5e-2; + stan::test::expect_ad(tols, f, Eigen::Vector4d(-40, 0.1, 1.3, 0.7)); + stan::test::expect_ad( + tols, + [](const auto& mu, const auto& sigma, const auto& lambda) { + return stan::math::exp_mod_normal_lcdf(Eigen::Vector3d(-40, 0.3, 60), + mu, sigma, lambda); + }, + 0.1, 1.3, 0.7); +} + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_lcdf_tails_and_endpoints) { + using stan::math::exp_mod_normal_lcdf; + using stan::math::INFTY; + using stan::math::NEGATIVE_INFTY; + // MPFR references for mu = 0, sigma = 1, lambda = 1. + EXPECT_NEAR(-808.3232158, exp_mod_normal_lcdf(-40.0, 0.0, 1.0, 1.0), 1e-6); + EXPECT_NEAR(-55.64594635, exp_mod_normal_lcdf(-10.0, 0.0, 1.0, 1.0), 1e-7); + EXPECT_NEAR(-22.72329719, exp_mod_normal_lcdf(-6.0, 0.0, 1.0, 1.0), 1e-7); + EXPECT_NEAR(-1.443704555e-26, exp_mod_normal_lcdf(60.0, 0.0, 1.0, 1.0), + 1e-34); + EXPECT_EQ(NEGATIVE_INFTY, exp_mod_normal_lcdf(NEGATIVE_INFTY, 0.0, 1.0, 1.0)); + EXPECT_EQ(0, exp_mod_normal_lcdf(INFTY, 0.0, 1.0, 1.0)); +} diff --git a/test/unit/math/mix/prob/exp_mod_normal_cdf_test.cpp b/test/unit/math/mix/prob/exp_mod_normal_cdf_test.cpp new file mode 100644 index 00000000000..4b51b692f6c --- /dev/null +++ b/test/unit/math/mix/prob/exp_mod_normal_cdf_test.cpp @@ -0,0 +1,20 @@ +#include +#include + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_cdf) { + auto f = [](const auto& p) { + return stan::math::exp_mod_normal_cdf(p[0], p[1], p[2], p[3]); + }; + + for (double y : {-40.0, -10.0, -3.0, 0.3, 4.0, 60.0}) { + stan::test::expect_ad(f, Eigen::Vector4d(y, 0.1, 1.3, 0.7)); + } +} + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_cdf_endpoints) { + using stan::math::exp_mod_normal_cdf; + using stan::math::INFTY; + using stan::math::NEGATIVE_INFTY; + EXPECT_EQ(0, exp_mod_normal_cdf(NEGATIVE_INFTY, 0.0, 1.0, 1.0)); + EXPECT_EQ(1, exp_mod_normal_cdf(INFTY, 0.0, 1.0, 1.0)); +} diff --git a/test/unit/math/mix/prob/exp_mod_normal_test.cpp b/test/unit/math/mix/prob/exp_mod_normal_test.cpp new file mode 100644 index 00000000000..cc0f854d371 --- /dev/null +++ b/test/unit/math/mix/prob/exp_mod_normal_test.cpp @@ -0,0 +1,46 @@ +#include +#include + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_lpdf) { + auto f = [](const auto& p) { + return stan::math::exp_mod_normal_lpdf(p[0], p[1], p[2], p[3]); + }; + + for (double y : {-40.0, -10.0, -3.0, 0.3, 4.0, 10.0, 20.0, 39.0, 60.0}) { + stan::test::expect_ad(f, Eigen::Vector4d(y, 0.1, 1.3, 0.7)); + } + stan::test::expect_ad(f, Eigen::Vector4d(0, 0, 2, 20)); + stan::test::expect_ad( + [](const auto& mu, const auto& sigma, const auto& lambda) { + return stan::math::exp_mod_normal_lpdf(Eigen::Vector3d(-40, 0.3, 60), + mu, sigma, lambda); + }, + 0.1, 1.3, 0.7); +} + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_lpdf_vector_tails) { + // z = (y - mu) / sigma - lambda sigma runs from the deep lower tail to + // the positive tail. + Eigen::VectorXd lambda(5); + lambda << 0.05, 0.7, 2.5, 20, 40; + stan::test::expect_ad( + [](const auto& y, const auto& sigma, const auto& lambda) { + return stan::math::exp_mod_normal_lpdf(y, 0.1, sigma, lambda); + }, + 0.3, 1.3, lambda); + Eigen::VectorXd mu(4); + mu << -40, 0, 10, 39; + Eigen::VectorXd sigma(4); + sigma << 0.5, 1, 2, 3; + stan::test::expect_ad( + [](const auto& mu, const auto& sigma, const auto& lambda) { + return stan::math::exp_mod_normal_lpdf(0.3, mu, sigma, lambda); + }, + mu, sigma, 0.7); +} + +TEST_F(AgradRev, mathMixScalFun_exp_mod_normal_lpdf_large_lambda) { + // MPFR reference; erfc underflows here. + EXPECT_NEAR(-1.6127097401997972, + stan::math::exp_mod_normal_lpdf(0.0, 0.0, 2.0, 20.0), 1e-12); +} diff --git a/test/unit/math/mix/prob/lognormal_ccdf_log_test.cpp b/test/unit/math/mix/prob/lognormal_ccdf_log_test.cpp new file mode 100644 index 00000000000..fee332939c1 --- /dev/null +++ b/test/unit/math/mix/prob/lognormal_ccdf_log_test.cpp @@ -0,0 +1,24 @@ +#include +#include +#include + +TEST_F(AgradRev, mathMixScalFun_lognormal_lccdf) { + auto f = [](const auto& y, const auto& mu, const auto& sigma) { + return stan::math::lognormal_lccdf(y, mu, sigma); + }; + + stan::test::expect_ad(f, 2.0, 0.5, 1.5); + const Eigen::Vector3d y(1, std::exp(-50.0), std::exp(50.0)); + stan::test::expect_ad( + [&](const auto& mu, const auto& sigma) { + return stan::math::lognormal_lccdf(y, mu, sigma); + }, + 0.0, 1.0); +} + +TEST_F(AgradRev, mathMixScalFun_lognormal_lccdf_tail_and_endpoints) { + using stan::math::lognormal_lccdf; + EXPECT_NEAR(-1254.8313611394199, lognormal_lccdf(std::exp(50.0), 0.0, 1.0), + 2e-12); + EXPECT_EQ(0, lognormal_lccdf(0.0, 0.0, 1.0)); +} diff --git a/test/unit/math/mix/prob/lognormal_cdf_log_test.cpp b/test/unit/math/mix/prob/lognormal_cdf_log_test.cpp new file mode 100644 index 00000000000..b19b38f6dd3 --- /dev/null +++ b/test/unit/math/mix/prob/lognormal_cdf_log_test.cpp @@ -0,0 +1,36 @@ +#include +#include +#include + +TEST_F(AgradRev, mathMixScalFun_lognormal_lcdf) { + auto f = [](const auto& y, const auto& mu, const auto& sigma) { + return stan::math::lognormal_lcdf(y, mu, sigma); + }; + + stan::test::expect_ad(f, 2.0, 0.5, 1.5); + stan::test::expect_ad(f, 1.0, 50.0, 1.0); + const Eigen::Vector3d y(1, std::exp(-50.0), 2); + stan::test::expect_ad( + [&](const auto& mu, const auto& sigma) { + return stan::math::lognormal_lcdf(y, mu, sigma); + }, + 0.0, 1.0); +} + +TEST_F(AgradRev, mathMixScalFun_lognormal_lcdf_tail_and_endpoints) { + using stan::math::INFTY; + using stan::math::lognormal_lcdf; + using stan::math::NEGATIVE_INFTY; + using stan::math::var; + EXPECT_NEAR(-1254.8313611394199, lognormal_lcdf(std::exp(-50.0), 0.0, 1.0), + 2e-12); + EXPECT_EQ(NEGATIVE_INFTY, lognormal_lcdf(0.0, 0.0, 1.0)); + var sigma = 1; + auto lp = lognormal_lcdf(INFTY, 0.0, sigma); + lp.grad(); + EXPECT_EQ(0, lp.val()); + EXPECT_EQ(0, sigma.adj()); + EXPECT_THROW( + lognormal_lcdf(Eigen::VectorXd::Ones(2), Eigen::VectorXd::Ones(3), 1), + std::invalid_argument); +} diff --git a/test/unit/math/mix/prob/lognormal_cdf_test.cpp b/test/unit/math/mix/prob/lognormal_cdf_test.cpp new file mode 100644 index 00000000000..949129df6d9 --- /dev/null +++ b/test/unit/math/mix/prob/lognormal_cdf_test.cpp @@ -0,0 +1,25 @@ +#include +#include +#include + +TEST_F(AgradRev, mathMixScalFun_lognormal_cdf) { + auto f = [](const auto& y, const auto& mu, const auto& sigma) { + return stan::math::lognormal_cdf(y, mu, sigma); + }; + + stan::test::expect_ad(f, 2.0, 0.5, 1.5); + const Eigen::Vector3d y(1, std::exp(-50.0), std::exp(50.0)); + stan::test::expect_ad( + [&](const auto& mu, const auto& sigma) { + return stan::math::lognormal_cdf(y, mu, sigma); + }, + 0.0, 1.0); +} + +TEST_F(AgradRev, mathMixScalFun_lognormal_cdf_tail_and_endpoints) { + using stan::math::lognormal_cdf; + EXPECT_NEAR(1, + lognormal_cdf(std::exp(-20.0), 0.0, 1.0) / 2.7536241186062337e-89, + 1e-12); + EXPECT_EQ(0, lognormal_cdf(0.0, 0.0, 1.0)); +} diff --git a/test/unit/math/mix/prob/normal_ccdf_log_test.cpp b/test/unit/math/mix/prob/normal_ccdf_log_test.cpp index f0fce7c3630..ab3d40a44e1 100644 --- a/test/unit/math/mix/prob/normal_ccdf_log_test.cpp +++ b/test/unit/math/mix/prob/normal_ccdf_log_test.cpp @@ -52,3 +52,26 @@ TEST_F(AgradRev, mathMixScalFun_normal_lccdf_branch_accuracy) { normal_lcdf_tail_test::expect_branch_accuracy(normal_lccdf_mix_test::fn, normal_lccdf_mix_test::dir); } + +TEST_F(AgradRev, mathMixScalFun_normal_lccdf_varmat) { + using stan::math::var; + using stan::math::var_value; + Eigen::VectorXd y(3); + y << -1.5, 0.2, 3.0; + Eigen::Matrix y_mat = y; + var mu_mat = 0.5, sigma_mat = 1.2; + var lp_mat = stan::math::normal_lccdf(y_mat, mu_mat, sigma_mat); + lp_mat.grad(); + const Eigen::VectorXd y_adj = y_mat.adj(); + const double mu_adj = mu_mat.adj(), sigma_adj = sigma_mat.adj(); + stan::math::set_zero_all_adjoints(); + + var_value y_var(y); + var mu = 0.5, sigma = 1.2; + var lp = stan::math::normal_lccdf(y_var, mu, sigma); + lp.grad(); + EXPECT_DOUBLE_EQ(lp_mat.val(), lp.val()); + EXPECT_MATRIX_NEAR(y_adj, y_var.adj(), 1e-14); + EXPECT_DOUBLE_EQ(mu_adj, mu.adj()); + EXPECT_DOUBLE_EQ(sigma_adj, sigma.adj()); +} diff --git a/test/unit/math/mix/prob/normal_cdf_log_test.cpp b/test/unit/math/mix/prob/normal_cdf_log_test.cpp index b17a93685d5..3b7cd0f88e6 100644 --- a/test/unit/math/mix/prob/normal_cdf_log_test.cpp +++ b/test/unit/math/mix/prob/normal_cdf_log_test.cpp @@ -52,3 +52,16 @@ TEST_F(AgradRev, mathMixScalFun_normal_lcdf_branch_accuracy) { normal_lcdf_tail_test::expect_branch_accuracy(normal_lcdf_mix_test::fn, normal_lcdf_mix_test::dir); } + +TEST_F(AgradRev, mathMixScalFun_normal_lcdf_infinite_endpoints) { + using stan::math::INFTY; + using stan::math::NEGATIVE_INFTY; + using stan::math::normal_lcdf; + using stan::math::var; + EXPECT_EQ(0, normal_lcdf(INFTY, 0.0, 1.0)); + EXPECT_EQ(NEGATIVE_INFTY, normal_lcdf(NEGATIVE_INFTY, 0.0, 1.0)); + var sigma = 1; + auto lp = normal_lcdf(INFTY, 0.0, sigma); + lp.grad(); + EXPECT_EQ(0, sigma.adj()); +} diff --git a/test/unit/math/mix/prob/normal_lcdf_tail_test_helpers.hpp b/test/unit/math/mix/prob/normal_lcdf_tail_test_helpers.hpp index 4cadb205dd5..09b3c99a7d6 100644 --- a/test/unit/math/mix/prob/normal_lcdf_tail_test_helpers.hpp +++ b/test/unit/math/mix/prob/normal_lcdf_tail_test_helpers.hpp @@ -5,6 +5,7 @@ #include #include #include +#include /** * Shared checks for the tails of normal_lcdf, std_normal_lcdf and their @@ -18,11 +19,50 @@ * * References were evaluated at 60 significant digits from * `Phi(y) = erfc(-y/sqrt(2))/2` and `phi(y) = exp(-y^2/2)/sqrt(2 pi)`, then - * rounded to double. The cutoff tables they enforce are documented on - * stan::math::normal_lcdf in prim/prob/normal_lcdf.hpp. + * rounded to double. The historical approximation cutoffs are retained as + * regression inputs; the shared kernel now uses erfc and a Cody tail instead + * of the former Taylor expansions and residual fits. */ namespace normal_lcdf_tail_test { +template +void check_tail_derivatives(const F& f, double z, + const std::array& expected) { + using namespace stan::math; + const auto check = [&](double actual, size_t order) { + EXPECT_NEAR(expected[order], actual, 1e-12 * std::abs(expected[order])); + }; + { + nested_rev_autodiff nested; + fvar> x; + x.val_.val_ = z; + x.val_.d_ = 1; + x.d_.val_ = 1; + auto y = f(x); + y.d_.d_.grad(); + check(y.d_.val_.val(), 0); + check(y.d_.d_.val(), 1); + check(x.val_.val_.adj(), 2); + } + { + nested_rev_autodiff nested; + fvar x(z, 1); + auto y = f(x); + y.d_.grad(); + check(y.d_.val(), 0); + check(x.val_.adj(), 1); + } + fvar>> x; + x.val_.val_.val_ = z; + x.val_.val_.d_ = 1; + x.val_.d_.val_ = 1; + x.d_.val_.val_ = 1; + const auto y = f(x); + check(y.d_.val_.val_, 0); + check(y.d_.d_.val_, 1); + check(y.d_.d_.d_, 2); +} + /** Sign relating the function under test to normal_lcdf. */ struct orientation { static constexpr double lcdf = 1.0; @@ -69,7 +109,7 @@ void value_and_grad(const F& f, double y, double* value, double* grad) { /** * Five-term DLMF 7.12.1 asymptotic for d/dy log Phi(y), valid in the far lower - * tail. Independent of the four-term form the implementation uses. + * tail. Independent of the Cody rational approximation used by the kernel. */ inline double mills_dlogphi_dy(double y) { const double s = y / std::sqrt(2.0); @@ -80,18 +120,14 @@ inline double mills_dlogphi_dy(double y) { } /** - * expect_ad on both sides of every interior cutoff of the piecewise value and - * derivative, given in scaled units so they line up with the table in - * prim/prob/normal_lcdf.hpp. + * expect_ad on both sides of the historical value and derivative cutoffs, + * including the current Cody crossover at scaled input -4. * * The 0.01 offset keeps clear of `finite_diff_grad_hessian_auto`'s stencil, * which spans about `1.2e-5 * max(1, |y|)`, so neither side straddles a seam. * - * This pins that every branch is executed and is accurate where used. It - * cannot pin the cutoff location: adjacent branches agree to well within 1e-4 - * for about 0.1 either side of a seam, by construction. Mutation-checked -- - * re-centring the 1.85 series on 1.80 fails, shifting the 2.5 boundary to 2.4 - * does not, 2.75 does. + * Keep the former cutoffs as regression inputs even though the Taylor and + * residual-fit branches have been replaced by the shared normal kernel. */ template void expect_ad_across_cutoffs(const F& f, double dir) { @@ -118,45 +154,42 @@ void expect_ad_at_defect_inputs(const F& f, double dir) { } /** - * Per-branch derivative accuracy, each row at that branch's own measured worst - * in-range error plus a small margin. Per-branch rather than blanket because - * expect_ad's 1e-4 `gradient_grad_` leaves the (0.8, 1.5] branch only 1.6x. + * Derivative references at inputs covered by the former Taylor branches. + * The shared kernel should agree with these references to 12 digits. */ template void expect_branch_accuracy(const F& f, double dir) { struct branch_ref { double y; double d1; - double tol; }; - const branch_ref cases[] - = {// (2.5, 2.9], Taylor centre 2.7, measured worst 3.27e-05 - {3.5496760415564683, 0.0007326476540693806, 5e-5}, - {3.818376618407357, 0.00027222779390121885, 5e-5}, - {4.1012193308819755, 8.881828792625139e-05, 5e-5}, - // (2.1, 2.5], Taylor centre 2.3, measured worst 2.80e-05 - {2.9839906166072305, 0.004655923761682003, 4e-5}, - {3.2526911934581184, 0.00201252166907532, 4e-5}, - {3.5355339059327378, 0.0007702965121768906, 4e-5}, - // (1.5, 2.1], Taylor centre 1.85, measured worst 2.30e-05 - {2.135462479183374, 0.04148009614764338, 3e-5}, - {2.5455844122715714, 0.015709826784999336, 3e-5}, - {2.9698484809835, 0.004856449376114489, 3e-5}, - // (0.8, 1.5], Taylor centre 1.15, measured worst 6.09e-05 - {1.145512985522207, 0.236841175835376, 9e-5}, - {1.6263455967290592, 0.1121292480767062, 9e-5}, - {2.121320343559643, 0.042773100995777136, 9e-5}, - // (0.1, 0.8], Taylor centre 0.45, measured worst 7.61e-06 - {0.15556349186104046, 0.7015595130271106, 1e-5}, - {0.6363961030678928, 0.4416330793820557, 1e-5}, - {1.1313708498984762, 0.24150063210766093, 1e-5}}; + const branch_ref cases[] = {// (2.5, 2.9], Taylor centre 2.7 + {3.5496760415564683, 0.0007326476540693806}, + {3.818376618407357, 0.00027222779390121885}, + {4.1012193308819755, 8.881828792625139e-05}, + // (2.1, 2.5], Taylor centre 2.3 + {2.9839906166072305, 0.004655923761682003}, + {3.2526911934581184, 0.00201252166907532}, + {3.5355339059327378, 0.0007702965121768906}, + // (1.5, 2.1], Taylor centre 1.85 + {2.135462479183374, 0.04148009614764338}, + {2.5455844122715714, 0.015709826784999336}, + {2.9698484809835, 0.004856449376114489}, + // (0.8, 1.5], Taylor centre 1.15 + {1.145512985522207, 0.236841175835376}, + {1.6263455967290592, 0.1121292480767062}, + {2.121320343559643, 0.042773100995777136}, + // (0.1, 0.8], Taylor centre 0.45 + {0.15556349186104046, 0.7015595130271106}, + {0.6363961030678928, 0.4416330793820557}, + {1.1313708498984762, 0.24150063210766093}}; for (const branch_ref& c : cases) { const double y = dir * c.y; double value = 0; double grad = 0; value_and_grad(f, y, &value, &grad); - EXPECT_LT(std::fabs(grad / (dir * c.d1) - 1.0), c.tol) + EXPECT_LT(std::fabs(grad / (dir * c.d1) - 1.0), 1e-12) << "derivative branch drifted at y = " << y; } } @@ -222,7 +255,7 @@ void expect_derivatives_finite(const F& f) { /** * Far-tail value and gradient against 60-digit references, then a sweep * against the five-term Mills asymptotic over the region the implementation - * handles with its own four-term form. + * evaluates with its Cody rational approximation. */ template void expect_far_tail_gradient(const F& f, double dir) { diff --git a/test/unit/math/mix/prob/skew_normal_test.cpp b/test/unit/math/mix/prob/skew_normal_test.cpp new file mode 100644 index 00000000000..e2f6f66aac0 --- /dev/null +++ b/test/unit/math/mix/prob/skew_normal_test.cpp @@ -0,0 +1,52 @@ +#include +#include + +TEST_F(AgradRev, mathMixScalFun_skew_normal_lpdf) { + auto f = [](const auto& p) { + return stan::math::skew_normal_lpdf(p[0], p[1], p[2], p[3]); + }; + + stan::test::expect_ad(f, Eigen::Vector4d(0.3, 0.1, 1.2, 0.5)); + stan::test::expect_ad(f, Eigen::Vector4d(-50, 0, 1, 1)); + stan::test::expect_ad( + [](const auto& mu, const auto& sigma, const auto& alpha) { + return stan::math::skew_normal_lpdf(Eigen::Vector3d(-50, 0, 2), mu, + sigma, alpha); + }, + 0.1, 1.2, 0.5); +} + +TEST_F(AgradRev, mathMixScalFun_skew_normal_lpdf_vector_tails) { + // For alpha = +/-1, alpha z reaches the deep lower tail, crosses + // +/-4 sqrt(2) and passes 40. + Eigen::VectorXd y(6); + y << -1e3, -50, -5.7, 0, 5.7, 50; + for (double alpha : {-1.0, 1.0}) { + stan::test::expect_ad( + [&y](const auto& mu, const auto& sigma, const auto& alpha) { + return stan::math::skew_normal_lpdf(y, mu, sigma, alpha); + }, + 0.0, 1.0, alpha); + } + Eigen::VectorXd alpha(7); + alpha << -300, -30, -1, 0, 1, 30, 300; + stan::test::expect_ad( + [](const auto& y, const auto& sigma, const auto& alpha) { + return stan::math::skew_normal_lpdf(y, 0.1, sigma, alpha); + }, + 0.3, 1.2, alpha); + Eigen::VectorXd mu(4); + mu << -10, 0, 0.3, 8; + Eigen::VectorXd sigma(4); + sigma << 0.5, 1, 2, 3; + stan::test::expect_ad( + [](const auto& mu, const auto& sigma, const auto& alpha) { + return stan::math::skew_normal_lpdf(0.3, mu, sigma, alpha); + }, + mu, sigma, 4.0); +} + +TEST_F(AgradRev, mathMixScalFun_skew_normal_lpdf_tail) { + EXPECT_NEAR(-2505.0571524920647, + stan::math::skew_normal_lpdf(-50.0, 0.0, 1.0, 1.0), 4e-12); +} diff --git a/test/unit/math/mix/prob/std_normal_ccdf_log_test.cpp b/test/unit/math/mix/prob/std_normal_ccdf_log_test.cpp index e052be64810..04fdada6562 100644 --- a/test/unit/math/mix/prob/std_normal_ccdf_log_test.cpp +++ b/test/unit/math/mix/prob/std_normal_ccdf_log_test.cpp @@ -49,3 +49,21 @@ TEST_F(AgradRev, mathMixScalFun_std_normal_lccdf_branch_accuracy) { normal_lcdf_tail_test::expect_branch_accuracy(std_normal_lccdf_mix_test::fn, std_normal_lccdf_mix_test::dir); } + +TEST_F(AgradRev, mathMixScalFun_std_normal_lccdf_varmat) { + using stan::math::var; + using stan::math::var_value; + Eigen::VectorXd y(3); + y << -1.5, 0.2, 3.0; + Eigen::Matrix y_mat = y; + var lp_mat = stan::math::std_normal_lccdf(y_mat); + lp_mat.grad(); + const Eigen::VectorXd y_adj = y_mat.adj(); + stan::math::set_zero_all_adjoints(); + + var_value y_var(y); + var lp = stan::math::std_normal_lccdf(y_var); + lp.grad(); + EXPECT_DOUBLE_EQ(lp_mat.val(), lp.val()); + EXPECT_MATRIX_NEAR(y_adj, y_var.adj(), 1e-14); +} diff --git a/test/unit/math/mix/prob/std_normal_lcdf_impl_test.cpp b/test/unit/math/mix/prob/std_normal_lcdf_impl_test.cpp new file mode 100644 index 00000000000..177b16b8e08 --- /dev/null +++ b/test/unit/math/mix/prob/std_normal_lcdf_impl_test.cpp @@ -0,0 +1,55 @@ +#include +#include +#include +#include +#include + +using normal_lcdf_tail_test::check_tail_derivatives; + +TEST_F(AgradRev, std_normal_extreme_tail_derivatives) { + using namespace stan::math; + // High-precision references for L', L'', L''', where L(z)=log Phi(z). + // The last row uses L'(-a)~a, L''(-a)~-1, L'''(-a)~2/a^3. Larger |z| + // overflows the squared divisor in nested fvar division. + for (const auto& row : + {std::array{-1e4, 10000.000099999998, -0.9999999900000006, + 1.99999976000003e-12}, + {-1e8, 100000000.00000001, -0.9999999999999999, 1.9999999999999976e-24}, + {-1e10, 1e10, -1, 2e-30}}) { + SCOPED_TRACE(row[0]); + check_tail_derivatives([](const auto& z) { return std_normal_lcdf(z); }, + row[0], {row[1], row[2], row[3]}); + check_tail_derivatives( + [](const auto& z) { return normal_lcdf(z, 0.0, 1.0); }, row[0], + {row[1], row[2], row[3]}); + check_tail_derivatives([](const auto& z) { return std_normal_lccdf(z); }, + -row[0], {-row[1], row[2], -row[3]}); + check_tail_derivatives( + [](const auto& z) { return normal_lccdf(z, 0.0, 1.0); }, -row[0], + {-row[1], row[2], -row[3]}); + check_tail_derivatives( + [](const auto& z) { + return internal::std_normal_lcdf_value_grad(z); + }, + row[0], {row[1], row[2], row[3]}); + } +} + +TEST_F(AgradRev, std_normal_extreme_tail_vector_derivatives) { + using namespace stan::math; + const Eigen::Array z(-1e8, -1e10, -1e50, 0, 1e308); + const Eigen::Array expected(2e-24, 2e-30, 2e-150, + 0.21801361414499016, 0); + Eigen::Array>, 5, 1> x; + for (Eigen::Index i = 0; i < x.size(); ++i) { + x(i).val_.val_ = z(i); + x(i).val_.d_ = 1; + x(i).d_.val_ = 1; + } + auto y = std_normal_lcdf(x); + y.d_.d_.grad(); + for (Eigen::Index i = 0; i < x.size(); ++i) { + EXPECT_NEAR(expected(i), x(i).val_.val_.adj(), + 1e-12 * std::abs(expected(i))); + } +} diff --git a/test/unit/math/opencl/rev/exp_mod_normal_lcdf_reference_test.cpp b/test/unit/math/opencl/rev/exp_mod_normal_lcdf_reference_test.cpp new file mode 100644 index 00000000000..011b5a92ed7 --- /dev/null +++ b/test/unit/math/opencl/rev/exp_mod_normal_lcdf_reference_test.cpp @@ -0,0 +1,99 @@ +#ifdef STAN_OPENCL +#include +#include +#include +#include +#include +#include +#include +#include + +namespace exp_mod_normal_lcdf_reference_test { + +void expect_rel(double expected, double actual) { + EXPECT_NEAR(expected, actual, 1e-12 * std::fabs(expected)); +} + +// All reference rows as one call on the device, every argument a vector, so +// each element of each adjoint is one partial of one row. Upper selects the +// log ccdf. +template +void expect_device_matches_reference( + const std::vector>& rows) { + using stan::math::matrix_cl; + using stan::math::var; + using stan::math::var_value; + const int n = rows.size(); + Eigen::VectorXd args[4]; + for (auto& a : args) { + a.resize(n); + } + double value = 0; + double value_scale = 0; + for (int i = 0; i < n; ++i) { + for (int k = 0; k < 4; ++k) { + args[k][i] = rows[i][k]; + } + value += rows[i][Upper ? 9 : 4]; + value_scale += std::fabs(rows[i][Upper ? 9 : 4]); + } + var_value> y{matrix_cl(args[0])}; + var_value> mu{matrix_cl(args[1])}; + var_value> sigma{matrix_cl(args[2])}; + var_value> lambda{matrix_cl(args[3])}; + var lp = Upper ? stan::math::exp_mod_normal_lccdf(y, mu, sigma, lambda) + : stan::math::exp_mod_normal_lcdf(y, mu, sigma, lambda); + lp.grad(); + EXPECT_NEAR(value, lp.val(), 1e-12 * value_scale); + const Eigen::VectorXd adj[4] = {stan::math::from_matrix_cl(y.adj()), + stan::math::from_matrix_cl(mu.adj()), + stan::math::from_matrix_cl(sigma.adj()), + stan::math::from_matrix_cl(lambda.adj())}; + for (int i = 0; i < n; ++i) { + SCOPED_TRACE(i); + for (int k = 0; k < 4; ++k) { + expect_rel(rows[i][(Upper ? 10 : 5) + k], adj[k][i]); + } + } + stan::math::recover_memory(); +} + +// Each row alone, as double arguments on the device: the value only. +template +void expect_device_values_match_reference( + const std::vector>& rows) { + using stan::math::matrix_cl; + for (const auto& r : rows) { + Eigen::VectorXd y(1); + y << r[0]; + matrix_cl y_cl(y); + const double lp + = Upper ? stan::math::exp_mod_normal_lccdf(y_cl, r[1], r[2], r[3]) + : stan::math::exp_mod_normal_lcdf(y_cl, r[1], r[2], r[3]); + expect_rel(r[Upper ? 9 : 4], lp); + } +} + +TEST(ProbDistributionsExpModNormalLcdf, opencl_matches_reference) { + const auto& rows = stan::test::exp_mod_normal_lcdf_reference; + expect_device_matches_reference(rows); + expect_device_values_match_reference(rows); +} + +TEST(ProbDistributionsExpModNormalLccdf, opencl_matches_reference) { + const auto& rows = stan::test::exp_mod_normal_lcdf_reference; + expect_device_matches_reference(rows); + expect_device_values_match_reference(rows); +} + +// Deep lower tail: Delta below 1e-300, or erfcx'(t) underflows. +TEST(ProbDistributionsExpModNormalLcdf, opencl_matches_deep_tail_reference) { + const auto& rows = stan::test::exp_mod_normal_lcdf_deep_tail_reference; + expect_device_matches_reference(rows); + expect_device_values_match_reference(rows); + expect_device_matches_reference(rows); + expect_device_values_match_reference(rows); +} + +} // namespace exp_mod_normal_lcdf_reference_test +#endif diff --git a/test/unit/math/opencl/rev/lognormal_lcdf_test.cpp b/test/unit/math/opencl/rev/lognormal_lcdf_test.cpp index b3c9163b015..f5286f01b52 100644 --- a/test/unit/math/opencl/rev/lognormal_lcdf_test.cpp +++ b/test/unit/math/opencl/rev/lognormal_lcdf_test.cpp @@ -158,4 +158,13 @@ TEST(ProbDistributionsLognormalLcdf, opencl_matches_cpu_big) { lognormal_lcdf_functor, y.transpose().eval(), mu.transpose().eval(), sigma.transpose().eval()); } + +TEST(ProbDistributionsLognormalLcdf, normal_tail) { + for (double y0 : {std::exp(-50.0), 1.0, std::exp(50.0), stan::math::INFTY}) { + SCOPED_TRACE(y0); + const Eigen::VectorXd y = Eigen::VectorXd::Constant(1, y0); + stan::math::test::compare_cpu_opencl_prim_rev(lognormal_lcdf_functor, y, + 0.0, 1.0); + } +} #endif diff --git a/test/unit/math/opencl/rev/normal_lcdf_test.cpp b/test/unit/math/opencl/rev/normal_lcdf_test.cpp index e264c5e1d9c..6bfab52af83 100644 --- a/test/unit/math/opencl/rev/normal_lcdf_test.cpp +++ b/test/unit/math/opencl/rev/normal_lcdf_test.cpp @@ -79,6 +79,20 @@ TEST(ProbDistributionsNormalLcdf, opencl_matches_cpu_small) { sigma.transpose().eval()); } +TEST(ProbDistributionsNormalLcdf, opencl_matches_cpu_tail_branches) { + Eigen::VectorXd y(12); + y << -1e100, -40, -6, -4 * stan::math::SQRT_TWO, -1, 0, 0.3, 1, 4, 8, 40, + 1e100; + stan::math::test::compare_cpu_opencl_prim_rev(normal_lcdf_functor, y, 0.0, + 1.0); + // Check each value separately so the extreme tail cannot dominate the sum. + for (Eigen::Index i = 0; i < y.size(); ++i) { + SCOPED_TRACE(y[i]); + stan::math::test::compare_cpu_opencl_prim_rev( + normal_lcdf_functor, y.segment(i, 1).eval(), 0.0, 1.0); + } +} + TEST(ProbDistributionsNormalLcdf, opencl_broadcast_y) { int N = 3; diff --git a/test/unit/math/opencl/rev/skew_normal_lpdf_test.cpp b/test/unit/math/opencl/rev/skew_normal_lpdf_test.cpp index 4e60315ee71..de457f68407 100644 --- a/test/unit/math/opencl/rev/skew_normal_lpdf_test.cpp +++ b/test/unit/math/opencl/rev/skew_normal_lpdf_test.cpp @@ -230,4 +230,12 @@ TEST(ProbDistributionsSkewNormal, opencl_matches_cpu_big) { sigma.transpose().eval(), alpha.transpose().eval()); } +TEST(ProbDistributionsSkewNormal, normal_tail) { + for (double y0 : {-50.0, -6.0, 0.0, 50.0}) { + SCOPED_TRACE(y0); + const Eigen::VectorXd y = Eigen::VectorXd::Constant(1, y0); + stan::math::test::compare_cpu_opencl_prim_rev(skew_normal_lpdf_functor, y, + 0.0, 1.0, 1.0); + } +} #endif diff --git a/test/unit/math/opencl/rev/std_normal_lcdf_test.cpp b/test/unit/math/opencl/rev/std_normal_lcdf_test.cpp index 52f3562c6fe..c07a6ee16a9 100644 --- a/test/unit/math/opencl/rev/std_normal_lcdf_test.cpp +++ b/test/unit/math/opencl/rev/std_normal_lcdf_test.cpp @@ -46,4 +46,30 @@ TEST(ProbDistributionsStdNormalLcdf, opencl_matches_cpu_big) { stan::math::test::compare_cpu_opencl_prim_rev(std_normal_lcdf_functor, y.transpose().eval()); } + +TEST(ProbDistributionsStdNormalLcdf, opencl_matches_cpu_tail_branches) { + Eigen::VectorXd y(12); + y << -1e100, -40, -6, -4 * stan::math::SQRT_TWO, -1, 0, 0.3, 1, 4, 8, 40, + 1e100; + stan::math::test::compare_cpu_opencl_prim_rev(std_normal_lcdf_functor, y); + // Check each value separately so the extreme tail cannot dominate the sum. + for (Eigen::Index i = 0; i < y.size(); ++i) { + SCOPED_TRACE(y[i]); + stan::math::test::compare_cpu_opencl_prim_rev(std_normal_lcdf_functor, + y.segment(i, 1).eval()); + } +} + +TEST(ProbDistributionsStdNormalLcdf, empty_and_extreme_gradient) { + using namespace stan::math; + matrix_cl empty(Eigen::VectorXd(0)); + EXPECT_EQ(0, std_normal_lcdf(empty)); + EXPECT_EQ(0, std_normal_lccdf(empty)); + nested_rev_autodiff nested; + var_value> y( + to_matrix_cl(Eigen::VectorXd::Constant(1, -1.5e308))); + auto lp = std_normal_lcdf(y); + lp.grad(); + EXPECT_NEAR(1.5e308, from_matrix_cl(y.adj())(0, 0), 1.5e296); +} #endif diff --git a/test/unit/math/prim/fun/Phi_test.cpp b/test/unit/math/prim/fun/Phi_test.cpp index c43e260bf88..b97b498eba3 100644 --- a/test/unit/math/prim/fun/Phi_test.cpp +++ b/test/unit/math/prim/fun/Phi_test.cpp @@ -3,11 +3,10 @@ #include TEST(MathFunctions, Phi) { - EXPECT_EQ(0.5 + 0.5 * stan::math::erf(0.0), stan::math::Phi(0.0)); - EXPECT_FLOAT_EQ(0.5 + 0.5 * stan::math::erf(0.9 / std::sqrt(2.0)), - stan::math::Phi(0.9)); - EXPECT_EQ(0.5 + 0.5 * stan::math::erf(-5.0 / std::sqrt(2.0)), - stan::math::Phi(-5.0)); + EXPECT_NEAR(0.5, stan::math::Phi(0.0), 1e-16); + EXPECT_NEAR(0.81593987465324047, stan::math::Phi(0.9), 1e-15); + EXPECT_NEAR(1, stan::math::Phi(-5.0) / 2.8665157187919391e-07, 1e-14); + EXPECT_NEAR(1, stan::math::Phi(-3.0) / 0.0013498980316300946, 1e-14); } // tests calculating using R 3.0.2 Snow Leopard build (6558) diff --git a/test/unit/math/prim/prob/exp_mod_normal_ccdf_log_test.cpp b/test/unit/math/prim/prob/exp_mod_normal_ccdf_log_test.cpp index 5285b65e2d1..982cd9c1ef3 100644 --- a/test/unit/math/prim/prob/exp_mod_normal_ccdf_log_test.cpp +++ b/test/unit/math/prim/prob/exp_mod_normal_ccdf_log_test.cpp @@ -10,8 +10,7 @@ TEST(ProbExpModNormal, ccdf_log_matches_lccdf) { EXPECT_FLOAT_EQ((stan::math::exp_mod_normal_lccdf(y, mu, lambda, sigma)), (stan::math::exp_mod_normal_ccdf_log(y, mu, lambda, sigma))); EXPECT_FLOAT_EQ( - (stan::math::exp_mod_normal_lccdf( - y, mu, lambda, sigma)), + (stan::math::exp_mod_normal_lccdf(y, mu, lambda, sigma)), (stan::math::exp_mod_normal_ccdf_log( y, mu, lambda, sigma))); } diff --git a/test/unit/math/prim/prob/exp_mod_normal_cdf_log_test.cpp b/test/unit/math/prim/prob/exp_mod_normal_cdf_log_test.cpp index b57e3513258..35a191363a5 100644 --- a/test/unit/math/prim/prob/exp_mod_normal_cdf_log_test.cpp +++ b/test/unit/math/prim/prob/exp_mod_normal_cdf_log_test.cpp @@ -10,8 +10,7 @@ TEST(ProbExpModNormal, cdf_log_matches_lcdf) { EXPECT_FLOAT_EQ((stan::math::exp_mod_normal_lcdf(y, mu, lambda, sigma)), (stan::math::exp_mod_normal_cdf_log(y, mu, lambda, sigma))); EXPECT_FLOAT_EQ( - (stan::math::exp_mod_normal_lcdf( - y, mu, lambda, sigma)), + (stan::math::exp_mod_normal_lcdf(y, mu, lambda, sigma)), (stan::math::exp_mod_normal_cdf_log( y, mu, lambda, sigma))); } diff --git a/test/unit/math/prim/prob/exp_mod_normal_lpdf_test.cpp b/test/unit/math/prim/prob/exp_mod_normal_lpdf_test.cpp new file mode 100644 index 00000000000..d80f568f4f9 --- /dev/null +++ b/test/unit/math/prim/prob/exp_mod_normal_lpdf_test.cpp @@ -0,0 +1,133 @@ +#include +#include +#include +#include +#include +#include +#include + +namespace { +// log Phi(x) through erfc, accurate for x >= -37. +double log_Phi_ref(double x) { + return std::log(0.5 * std::erfc(-x / std::sqrt(2.0))); +} + +double exp_mod_normal_ref(double y, double mu, double sigma, double lambda) { + return std::log(lambda) + lambda * (mu - y + 0.5 * lambda * sigma * sigma) + + log_Phi_ref((y - mu) / sigma - lambda * sigma); +} + +void expect_near_rel(double expected, double actual) { + EXPECT_NEAR(expected, actual, 1e-12 * std::max(1.0, std::fabs(expected))); +} + +constexpr double mu = 0.1; +constexpr double sigma = 1.3; +constexpr double lambda = 0.7; + +// Values of y whose z = (y - mu) / sigma - lambda sigma crosses +// +/-4 sqrt(2) and +/-0.46875 sqrt(2) and reaches the positive tail. +std::vector branch_ys() { + std::vector y; + for (double z : {-30.0, -5.7, -5.6, -0.67, 0.0, 0.66, 5.6, 5.7, 20.0, 30.0}) { + y.push_back(mu + sigma * (z + lambda * sigma)); + } + return y; +} +} // namespace + +TEST(ProbDistributionsExpModNormal, lpdf_matches_closed_form_across_branches) { + using stan::math::exp_mod_normal_lpdf; + const auto y = branch_ys(); + double sum_ref = 0; + for (double y_i : y) { + const double ref = exp_mod_normal_ref(y_i, mu, sigma, lambda); + expect_near_rel(ref, exp_mod_normal_lpdf(y_i, mu, sigma, lambda)); + sum_ref += ref; + } + expect_near_rel(sum_ref, exp_mod_normal_lpdf(y, mu, sigma, lambda)); +} + +TEST(ProbDistributionsExpModNormal, lpdf_vector_lambda_broadcasts_scalars) { + using stan::math::exp_mod_normal_lpdf; + const std::vector lambdas{0.05, 0.7, 2.5, 10.0, 20.0}; + double sum_ref = 0; + for (double lambda_i : lambdas) { + sum_ref += exp_mod_normal_ref(0.3, mu, sigma, lambda_i); + } + expect_near_rel(sum_ref, exp_mod_normal_lpdf(0.3, mu, sigma, lambdas)); +} + +TEST(ProbDistributionsExpModNormal, lpdf_vector_mu_sigma) { + using stan::math::exp_mod_normal_lpdf; + const std::vector mus{-20.0, -1.0, 0.0, 2.0, 15.0}; + const std::vector sigmas{0.5, 1.0, 2.0, 3.0, 0.8}; + double sum_mu = 0; + double sum_both = 0; + for (size_t i = 0; i < mus.size(); ++i) { + sum_mu += exp_mod_normal_ref(0.3, mus[i], sigma, lambda); + sum_both += exp_mod_normal_ref(0.3, mus[i], sigmas[i], lambda); + } + expect_near_rel(sum_mu, exp_mod_normal_lpdf(0.3, mus, sigma, lambda)); + expect_near_rel(sum_both, exp_mod_normal_lpdf(0.3, mus, sigmas, lambda)); +} + +TEST(ProbDistributionsExpModNormal, lpdf_size_one_vector_matches_scalar) { + using stan::math::exp_mod_normal_lpdf; + const std::vector y{0.3}; + const Eigen::VectorXd lambda_vec = Eigen::VectorXd::Constant(1, lambda); + EXPECT_FLOAT_EQ(exp_mod_normal_lpdf(0.3, mu, sigma, lambda), + exp_mod_normal_lpdf(y, mu, sigma, lambda)); + EXPECT_FLOAT_EQ(exp_mod_normal_lpdf(0.3, mu, sigma, lambda), + exp_mod_normal_lpdf(y, mu, sigma, lambda_vec)); +} + +TEST(ProbDistributionsExpModNormal, lpdf_propto_and_empty_return_zero) { + using stan::math::exp_mod_normal_lpdf; + const std::vector y{-1.0, 0.3, 2.0}; + const std::vector empty; + EXPECT_EQ(0.0, exp_mod_normal_lpdf(y, mu, sigma, lambda)); + EXPECT_EQ(0.0, exp_mod_normal_lpdf(empty, mu, sigma, lambda)); + EXPECT_EQ(0.0, exp_mod_normal_lpdf(empty, mu, sigma, empty)); +} + +TEST(ProbDistributionsExpModNormal, lpdf_vector_errors) { + using stan::math::exp_mod_normal_lpdf; + const double nan = std::numeric_limits::quiet_NaN(); + const double inf = std::numeric_limits::infinity(); + const std::vector good{-1.0, 0.3, 2.0}; + + EXPECT_THROW(exp_mod_normal_lpdf(std::vector{-1.0, nan, 2.0}, mu, + sigma, lambda), + std::domain_error); + for (double bad : {nan, inf, -inf}) { + const std::vector bad_mu{-1.0, bad, 2.0}; + EXPECT_THROW(exp_mod_normal_lpdf(good, bad_mu, sigma, lambda), + std::domain_error); + } + for (double bad : {nan, 0.0, -1.0, inf, -inf}) { + const std::vector bad_vec{0.5, bad, 2.0}; + EXPECT_THROW(exp_mod_normal_lpdf(good, mu, bad_vec, lambda), + std::domain_error); + EXPECT_THROW(exp_mod_normal_lpdf(good, mu, sigma, bad_vec), + std::domain_error); + } + EXPECT_THROW(exp_mod_normal_lpdf(0.3, mu, inf, lambda), std::domain_error); + // The checks run before the empty-input return. + const std::vector empty; + EXPECT_THROW(exp_mod_normal_lpdf(empty, mu, sigma, -1.0), std::domain_error); +} + +TEST(ProbDistributionsExpModNormal, lpdf_inconsistent_sizes) { + using stan::math::exp_mod_normal_lpdf; + const std::vector three{-1.0, 0.3, 2.0}; + const std::vector two{0.5, 1.0}; + EXPECT_THROW(exp_mod_normal_lpdf(two, three, sigma, lambda), + std::invalid_argument); + EXPECT_THROW(exp_mod_normal_lpdf(three, two, sigma, lambda), + std::invalid_argument); + EXPECT_THROW(exp_mod_normal_lpdf(three, mu, two, lambda), + std::invalid_argument); + EXPECT_THROW(exp_mod_normal_lpdf(three, mu, sigma, two), + std::invalid_argument); +} diff --git a/test/unit/math/prim/prob/lognormal_ccdf_log_test.cpp b/test/unit/math/prim/prob/lognormal_ccdf_log_test.cpp index 1d532ad0e46..d53a72cb3e2 100644 --- a/test/unit/math/prim/prob/lognormal_ccdf_log_test.cpp +++ b/test/unit/math/prim/prob/lognormal_ccdf_log_test.cpp @@ -8,7 +8,4 @@ TEST(ProbLognormal, ccdf_log_matches_lccdf) { EXPECT_FLOAT_EQ((stan::math::lognormal_lccdf(y, mu, sigma)), (stan::math::lognormal_ccdf_log(y, mu, sigma))); - EXPECT_FLOAT_EQ( - (stan::math::lognormal_lccdf(y, mu, sigma)), - (stan::math::lognormal_ccdf_log(y, mu, sigma))); } diff --git a/test/unit/math/prim/prob/lognormal_cdf_log_test.cpp b/test/unit/math/prim/prob/lognormal_cdf_log_test.cpp index aba7f32370f..6bd5f3f648e 100644 --- a/test/unit/math/prim/prob/lognormal_cdf_log_test.cpp +++ b/test/unit/math/prim/prob/lognormal_cdf_log_test.cpp @@ -8,7 +8,6 @@ TEST(ProbLognormal, cdf_log_matches_lcdf) { EXPECT_FLOAT_EQ((stan::math::lognormal_lcdf(y, mu, sigma)), (stan::math::lognormal_cdf_log(y, mu, sigma))); - EXPECT_FLOAT_EQ( - (stan::math::lognormal_lcdf(y, mu, sigma)), - (stan::math::lognormal_cdf_log(y, mu, sigma))); + EXPECT_FLOAT_EQ((stan::math::lognormal_lcdf(y, mu, sigma)), + (stan::math::lognormal_cdf_log(y, mu, sigma))); } diff --git a/test/unit/math/prim/prob/normal_ccdf_log_test.cpp b/test/unit/math/prim/prob/normal_ccdf_log_test.cpp index 5bab9655a32..3b1a16fac22 100644 --- a/test/unit/math/prim/prob/normal_ccdf_log_test.cpp +++ b/test/unit/math/prim/prob/normal_ccdf_log_test.cpp @@ -8,9 +8,8 @@ TEST(ProbNormal, ccdf_log_matches_lccdf) { EXPECT_FLOAT_EQ((stan::math::normal_lccdf(y, mu, sigma)), (stan::math::normal_ccdf_log(y, mu, sigma))); - EXPECT_FLOAT_EQ( - (stan::math::normal_lccdf(y, mu, sigma)), - (stan::math::normal_ccdf_log(y, mu, sigma))); + EXPECT_FLOAT_EQ((stan::math::normal_lccdf(y, mu, sigma)), + (stan::math::normal_ccdf_log(y, mu, sigma))); } TEST(ProbNormal, lccdf_tail) { diff --git a/test/unit/math/prim/prob/normal_cdf_log_test.cpp b/test/unit/math/prim/prob/normal_cdf_log_test.cpp index fe8ab52090b..3d1679ff4b7 100644 --- a/test/unit/math/prim/prob/normal_cdf_log_test.cpp +++ b/test/unit/math/prim/prob/normal_cdf_log_test.cpp @@ -9,9 +9,8 @@ TEST(ProbNormal, cdf_log_matches_lcdf) { EXPECT_FLOAT_EQ((stan::math::normal_lcdf(y, mu, sigma)), (stan::math::normal_cdf_log(y, mu, sigma))); - EXPECT_FLOAT_EQ( - (stan::math::normal_lcdf(y, mu, sigma)), - (stan::math::normal_cdf_log(y, mu, sigma))); + EXPECT_FLOAT_EQ((stan::math::normal_lcdf(y, mu, sigma)), + (stan::math::normal_cdf_log(y, mu, sigma))); } TEST(ProbNormal, lcdf_tails) { diff --git a/test/unit/math/prim/prob/skew_normal_cdf_log_test.cpp b/test/unit/math/prim/prob/skew_normal_cdf_log_test.cpp index 3b41298445f..9ae330ed2dd 100644 --- a/test/unit/math/prim/prob/skew_normal_cdf_log_test.cpp +++ b/test/unit/math/prim/prob/skew_normal_cdf_log_test.cpp @@ -8,9 +8,6 @@ TEST(ProbSkewNormal, cdf_log_matches_lcdf) { EXPECT_FLOAT_EQ((stan::math::skew_normal_lcdf(y, mu, sigma, alpha)), (stan::math::skew_normal_cdf_log(y, mu, sigma, alpha))); - EXPECT_FLOAT_EQ( - (stan::math::skew_normal_lcdf( - y, mu, sigma, alpha)), - (stan::math::skew_normal_cdf_log( - y, mu, sigma, alpha))); + EXPECT_FLOAT_EQ((stan::math::skew_normal_lcdf(y, mu, sigma, alpha)), + (stan::math::skew_normal_cdf_log(y, mu, sigma, alpha))); } diff --git a/test/unit/math/prim/prob/skew_normal_lpdf_test.cpp b/test/unit/math/prim/prob/skew_normal_lpdf_test.cpp new file mode 100644 index 00000000000..a6953d7ffe4 --- /dev/null +++ b/test/unit/math/prim/prob/skew_normal_lpdf_test.cpp @@ -0,0 +1,124 @@ +#include +#include +#include +#include +#include +#include +#include + +namespace { +// log Phi(x) through erfc, accurate for x >= -37. +double log_Phi_ref(double x) { + return std::log(0.5 * std::erfc(-x / std::sqrt(2.0))); +} + +double skew_normal_ref(double y, double mu, double sigma, double alpha) { + const double z = (y - mu) / sigma; + return stan::math::LOG_TWO - stan::math::HALF_LOG_TWO_PI - std::log(sigma) + - 0.5 * z * z + log_Phi_ref(alpha * z); +} + +void expect_near_rel(double expected, double actual) { + EXPECT_NEAR(expected, actual, 1e-12 * std::max(1.0, std::fabs(expected))); +} + +// alpha * z for alpha = +/-1 crosses +/-4 sqrt(2) and +/-0.46875 sqrt(2). +const std::vector branch_points{-30.0, -5.7, -5.6, -0.67, 0.0, + 0.66, 5.6, 5.7, 20.0, 30.0}; +} // namespace + +TEST(ProbDistributionsSkewNormal, lpdf_matches_closed_form_across_branches) { + using stan::math::skew_normal_lpdf; + for (double alpha : {-1.0, 1.0}) { + double sum_ref = 0; + for (double y : branch_points) { + const double ref = skew_normal_ref(y, 0.0, 1.0, alpha); + expect_near_rel(ref, skew_normal_lpdf(y, 0.0, 1.0, alpha)); + sum_ref += ref; + } + expect_near_rel(sum_ref, skew_normal_lpdf(branch_points, 0.0, 1.0, alpha)); + } +} + +TEST(ProbDistributionsSkewNormal, lpdf_vector_alpha_broadcasts_scalars) { + using stan::math::skew_normal_lpdf; + // z = 1 is shared, so its quadratic and log(sigma) terms count N times. + double sum_ref = 0; + for (double alpha : branch_points) { + sum_ref += skew_normal_ref(1.3, 0.3, 1.0, alpha); + } + expect_near_rel(sum_ref, skew_normal_lpdf(1.3, 0.3, 1.0, branch_points)); +} + +TEST(ProbDistributionsSkewNormal, lpdf_zero_shape_is_normal) { + using stan::math::normal_lpdf; + using stan::math::skew_normal_lpdf; + const std::vector y{-2.0, 0.3, 4.0}; + const std::vector sigma{1e-8, 1.0, 1e8}; + expect_near_rel(normal_lpdf(y, 0.1, sigma), + skew_normal_lpdf(y, 0.1, sigma, 0.0)); +} + +TEST(ProbDistributionsSkewNormal, lpdf_large_shape_is_twice_normal) { + using stan::math::LOG_TWO; + using stan::math::normal_lpdf; + using stan::math::skew_normal_lpdf; + // alpha * z > 40, where Phi(alpha z) is 1. + const std::vector y{1.0, 2.0, 3.0}; + expect_near_rel(normal_lpdf(y, 0.0, 1.0) + 3 * LOG_TWO, + skew_normal_lpdf(y, 0.0, 1.0, 100.0)); +} + +TEST(ProbDistributionsSkewNormal, lpdf_size_one_vector_matches_scalar) { + using stan::math::skew_normal_lpdf; + const std::vector y{0.3}; + const Eigen::VectorXd alpha = Eigen::VectorXd::Constant(1, 0.5); + EXPECT_FLOAT_EQ(skew_normal_lpdf(0.3, 0.1, 1.2, 0.5), + skew_normal_lpdf(y, 0.1, 1.2, 0.5)); + EXPECT_FLOAT_EQ(skew_normal_lpdf(0.3, 0.1, 1.2, 0.5), + skew_normal_lpdf(y, 0.1, 1.2, alpha)); +} + +TEST(ProbDistributionsSkewNormal, lpdf_propto_and_empty_return_zero) { + using stan::math::skew_normal_lpdf; + const std::vector y{-1.0, 0.3, 2.0}; + const std::vector empty; + EXPECT_EQ(0.0, skew_normal_lpdf(y, 0.1, 1.2, 0.5)); + EXPECT_EQ(0.0, skew_normal_lpdf(empty, 0.1, 1.2, 0.5)); + EXPECT_EQ(0.0, skew_normal_lpdf(empty, 0.1, 1.2, empty)); +} + +TEST(ProbDistributionsSkewNormal, lpdf_vector_errors) { + using stan::math::skew_normal_lpdf; + const double nan = std::numeric_limits::quiet_NaN(); + const double inf = std::numeric_limits::infinity(); + const std::vector good{-1.0, 0.3, 2.0}; + const std::vector good_sigma{0.5, 1.0, 2.0}; + + EXPECT_THROW( + skew_normal_lpdf(std::vector{-1.0, nan, 2.0}, 0.1, 1.2, 0.5), + std::domain_error); + for (double bad : {nan, inf, -inf}) { + const std::vector bad_vec{-1.0, bad, 2.0}; + EXPECT_THROW(skew_normal_lpdf(good, bad_vec, 1.2, 0.5), std::domain_error); + EXPECT_THROW(skew_normal_lpdf(good, 0.1, 1.2, bad_vec), std::domain_error); + } + for (double bad : {nan, 0.0, -1.0, -inf}) { + const std::vector bad_sigma{0.5, bad, 2.0}; + EXPECT_THROW(skew_normal_lpdf(good, 0.1, bad_sigma, 0.5), + std::domain_error); + } + // The checks run before the empty-input return. + const std::vector empty; + EXPECT_THROW(skew_normal_lpdf(empty, 0.1, -1.0, 0.5), std::domain_error); +} + +TEST(ProbDistributionsSkewNormal, lpdf_inconsistent_sizes) { + using stan::math::skew_normal_lpdf; + const std::vector three{-1.0, 0.3, 2.0}; + const std::vector two{0.5, 1.0}; + EXPECT_THROW(skew_normal_lpdf(two, three, 1.2, 0.5), std::invalid_argument); + EXPECT_THROW(skew_normal_lpdf(three, two, 1.2, 0.5), std::invalid_argument); + EXPECT_THROW(skew_normal_lpdf(three, 0.1, two, 0.5), std::invalid_argument); + EXPECT_THROW(skew_normal_lpdf(three, 0.1, 1.2, two), std::invalid_argument); +} diff --git a/test/unit/math/prim/prob/std_normal_ccdf_log_test.cpp b/test/unit/math/prim/prob/std_normal_ccdf_log_test.cpp index a2e39eb25b3..3513d435105 100644 --- a/test/unit/math/prim/prob/std_normal_ccdf_log_test.cpp +++ b/test/unit/math/prim/prob/std_normal_ccdf_log_test.cpp @@ -6,8 +6,8 @@ TEST(ProbStdNormal, ccdf_log_matches_lccdf) { EXPECT_FLOAT_EQ((stan::math::std_normal_lccdf(y)), (stan::math::std_normal_ccdf_log(y))); - EXPECT_FLOAT_EQ((stan::math::std_normal_lccdf(y)), - (stan::math::std_normal_ccdf_log(y))); + EXPECT_FLOAT_EQ((stan::math::std_normal_lccdf(y)), + (stan::math::std_normal_ccdf_log(y))); } TEST(ProbStdNormal, lccdf_tail) { diff --git a/test/unit/math/prim/prob/std_normal_cdf_log_test.cpp b/test/unit/math/prim/prob/std_normal_cdf_log_test.cpp index 8181bd29c7f..be354d756d3 100644 --- a/test/unit/math/prim/prob/std_normal_cdf_log_test.cpp +++ b/test/unit/math/prim/prob/std_normal_cdf_log_test.cpp @@ -8,7 +8,7 @@ TEST(ProbStdNormal, cdf_log_matches_lcdf) { EXPECT_FLOAT_EQ((stan::math::std_normal_lcdf(y)), (stan::math::std_normal_cdf_log(y))); EXPECT_FLOAT_EQ((stan::math::std_normal_lcdf(y)), - (stan::math::std_normal_cdf_log(y))); + (stan::math::std_normal_cdf_log(y))); } TEST(ProbStdNormal, lcdf_tails) { diff --git a/test/unit/math/prim/prob/std_normal_lcdf_impl_test.cpp b/test/unit/math/prim/prob/std_normal_lcdf_impl_test.cpp new file mode 100644 index 00000000000..72ddf86b0da --- /dev/null +++ b/test/unit/math/prim/prob/std_normal_lcdf_impl_test.cpp @@ -0,0 +1,101 @@ +#include +#include +#include +#include + +TEST(ProbStdNormal, scalar_tail_kernel) { + // High-precision references: input, log Phi(input), and its slope. + static constexpr std::array cases[] + = {{-1e150, -4.9999999999999995e299, 1e150}, + {-30, -454.32124395634321, 30.033259667433676}, + {-6, -20.736768949974707, 6.1584826045445986}, + {-3, -6.607726221510349, 3.2830986549304364}, + {-1, -1.8410216450092636, 1.5251352761609811}, + {-0.6, -1.293703811614028, 1.2150257602375434}, + {-0.25, -0.9130617648111351, 0.9635539794164039}, + {0, -0.69314718055994529, 0.79788456080286541}, + {0.25, -0.5129840754094305, 0.6458393710168173}, + {0.6, -0.3205539719875189, 0.45914713661428674}, + {0.66, -0.29387040027781763, 0.4304740942312013}, + {0.67, -0.289589083101687, 0.42579407138081293}, + {1, -0.17275377902344988, 0.28759997093917838}, + {3, -0.0013508099647481938, 0.004437839042125664}, + {5.6568542494923797, -7.7086289798515121e-09, 4.4895039573954219e-08}, + {5.6568542494923806, -7.7086289798514724e-09, 4.4895039573953994e-08}, + {6, -9.865876455243758e-10, 6.0758828558176762e-09}, + {30, -4.9067139271481872e-198, 1.4736461348785476e-196}, + {1e8, 0, 0}, + {1e150, 0, 0}}; + for (const auto& row : cases) { + SCOPED_TRACE(row[0]); + const auto result + = stan::math::internal::std_normal_lcdf_value_grad(row[0]); + EXPECT_NEAR(row[1], result.first, 1e-12 * std::abs(row[1])); + EXPECT_NEAR(row[2], result.second, 1e-12 * std::abs(row[2])); + EXPECT_DOUBLE_EQ( + result.first, + stan::math::internal::std_normal_lcdf_value_grad(row[0])); + } +} + +TEST(ProbStdNormal, large_finite_log_density) { + EXPECT_TRUE(std::isfinite(stan::math::std_normal_lcdf(-1.5e154))); +} + +TEST(ProbStdNormal, vectorized_tail_kernel) { + using stan::math::internal::std_normal_lcdf_value_grad; + Eigen::ArrayXd z(25); + z << -1e308, -1e150, -50, -6, -4 * stan::math::SQRT_TWO, -5, -1, + -0.46875 * stan::math::SQRT_TWO, -0.01, 0, 0.01, + 0.46875 * stan::math::SQRT_TWO, 1, 3, 6, 20, 30, 37, 37.1, 38, 38.5, 40, + 50, 1e150, 1e308; + // Check both short and large inputs against the scalar kernel. + for (const Eigen::ArrayXd& zs : {z, Eigen::ArrayXd(z.replicate(8, 1))}) { + SCOPED_TRACE(zs.size()); + const auto result = std_normal_lcdf_value_grad(zs); + const auto values = std_normal_lcdf_value_grad(zs); + for (Eigen::Index i = 0; i < zs.size(); ++i) { + SCOPED_TRACE(zs[i]); + const auto scalar = std_normal_lcdf_value_grad(zs[i]); + if (std::isfinite(scalar.first)) { + EXPECT_NEAR(scalar.first, result.first[i], + std::abs(scalar.first) * 1e-12 + 1e-323); + } else { + EXPECT_EQ(scalar.first, result.first[i]); + } + EXPECT_EQ(result.first[i], values[i]); + EXPECT_NEAR(scalar.second, result.second[i], + std::abs(scalar.second) * 1e-12 + 1e-323); + } + } +} + +TEST(ProbStdNormal, integer_vectors) { + using stan::math::std_normal_lcdf; + const Eigen::Vector3i z(-1, 0, 1); + EXPECT_NEAR(std_normal_lcdf(z.cast().eval()), std_normal_lcdf(z), + 1e-14); + EXPECT_NEAR(std_normal_lcdf(z), std_normal_lcdf(std::vector{-1, 0, 1}), + 1e-14); +} + +TEST(ProbStdNormal, value_only_storage) { + using stan::math::internal::std_normal_lcdf_value_grad; + Eigen::ArrayXd z(3); + z << -1, 0, 1; + const Eigen::ArrayXd original = z; + const Eigen::ArrayXd expected = std_normal_lcdf_value_grad(z).first; + + EXPECT_TRUE(std_normal_lcdf_value_grad(z).isApprox(expected)); + EXPECT_TRUE((z == original).all()); + EXPECT_TRUE( + std_normal_lcdf_value_grad(z.segment(0, 3)).isApprox(expected)); + EXPECT_TRUE((z == original).all()); + EXPECT_TRUE(std_normal_lcdf_value_grad(z + 0).isApprox(expected)); + EXPECT_TRUE((z == original).all()); + + const auto* buffer = z.data(); + const auto values = std_normal_lcdf_value_grad(std::move(z)); + EXPECT_EQ(buffer, values.data()); + EXPECT_TRUE(values.isApprox(expected)); +} diff --git a/test/unit/math/rev/prob/exp_mod_normal_lcdf_reference.hpp b/test/unit/math/rev/prob/exp_mod_normal_lcdf_reference.hpp new file mode 100644 index 00000000000..4ea4b21e4e7 --- /dev/null +++ b/test/unit/math/rev/prob/exp_mod_normal_lcdf_reference.hpp @@ -0,0 +1,109 @@ +#ifndef TEST_UNIT_MATH_REV_PROB_EXP_MOD_NORMAL_LCDF_REFERENCE_HPP +#define TEST_UNIT_MATH_REV_PROB_EXP_MOD_NORMAL_LCDF_REFERENCE_HPP + +#include +#include + +namespace stan { +namespace test { +// Reference values from mpmath at 80 digits, with +// F = Phi(z) - exp(v^2 / 2 - v z) Phi(z - v), z = (y - mu) / sigma and +// v = lambda sigma. Columns: y, mu, sigma, lambda; log F and its partials +// with respect to y, mu, sigma and lambda; log(1 - F) and its partials. +// The rows cover each branch of the implementation. +inline const std::vector> exp_mod_normal_lcdf_reference{{ + // z <= 0, direct difference: z = -1, v = 1.7 + {-1.5, 0.5, 2.0, 0.85, -2.5490836701887667, 0.8755452641267648, + -0.8755452641267648, 1.1432630039167466, 0.6299240936234866, + -0.08137628111713817, -0.07422785337928106, 0.07422785337928106, + -0.09692469607876499, -0.053404335763491594}, + // z <= 0, midpoint series: z = -1, v = 1e-6 + {-1.5, 0.5, 2.0, 5e-07, -16.300632035812452, 0.9521355471592908, + -0.9521355471592908, 1.4521353210915628, 1999999.0957290884, + -8.331543638854072e-08, -7.932759191722472e-08, 7.932759191722472e-08, + -1.2098529301192842e-07, -0.1666308043788148}, + // z <= 0, Cody tail form: z = -30, v = 1e-6 + {-59.5, 0.5, 2.0, 5e-07, -471.54016435178534, 15.033223076531138, + -15.033223076531138, 451.49669227932264, 1999999.9335538482, + -1.6319566798727785e-205, -2.4533568819762596e-204, + 2.4533568819762596e-204, -7.368230429057049e-203, + -3.2639132513083157e-199}, + // far left tail: z = -100, v = 1 + {-199.5, 0.5, 2.0, 0.5, -5010.139526172664, 50.009947541308605, + -50.009947541308605, 5001.489805095543, 1.9802038587280042, 0.0, 0.0, 0.0, + 0.0, 0.0}, + // z <= 0, moderate: z = -5, v = 0.1 + {-9.5, 0.5, 2.0, 0.05, -19.06482415881871, 2.679431897194249, + -2.679431897194249, 13.888266173078359, 19.644267484284644, + -5.251121541564783e-09, -1.4070022591454212e-08, 1.4070022591454212e-08, + -7.292897386791672e-08, -1.0315443642582597e-07}, + // z > 0, F < 1/4, t >= 0: z = 0.5, v = 0.01 + {1.5, 0.5, 2.0, 0.005, -4.9724345517428326, 0.4941596821592839, + -0.4941596821592839, 0.24921076350058388, 198.51624183209034, + -0.00695036305228926, -0.003446552718616521, 0.003446552718616521, + -0.0017381386330392265, -1.3845659969389947}, + // z > 0, F < 1/4, t < 0: z = 3, v = 0.001 + {6.5, 0.5, 2.0, 0.0005, -5.810681422989987, 0.16619794005224212, + -0.16619794005224212, 0.0005735806865535214, 1996.6696033731193, + -0.0029998834044321133, -0.0004993230231757599, 0.0004993230231757599, + -1.723258677906029e-06, -5.998769312820743}, + // z > 0, F >= 1/4, t >= 0: z = 0.5, v = 2 + {1.5, 0.5, 2.0, 1.0, -0.6736158448547661, 0.3561766170060144, + -0.3561766170060144, -0.02184175933760607, 0.31249309833080224, + -0.713067601305028, -0.3705092754825071, 0.3705092754825071, + 0.022720678565216028, -0.3250679183520751}, + // z > 0, F >= 1/4, t < 0: z = 3, v = 1.7 + {6.5, 0.5, 2.0, 0.85, -0.02501835541577909, 0.020357367836960467, + -0.020357367836960467, -0.030745019415244202, 0.07135784493091106, + -3.7006286048107095, -0.8035610413609725, 0.8035610413609725, + 1.213590087669492, -2.8166894974433543}, + // z > 0, 1 - F = b only: z = 20, v = 1.7 + {40.5, 0.5, 2.0, 0.85, -7.27014615293453e-15, 6.179624229994373e-15, + -6.179624229994373e-15, -1.0505361190990435e-14, 2.660873491974048e-13, + -32.555, -0.85, 0.85, 1.4449999999999998, -36.6}, + // 1 - F near underflow, t < 0: z = 50, v = 45 + {100.5, 0.5, 2.0, 22.5, 0.0, 0.0, 0.0, 0.0, 0.0, -1237.500000256929, + -22.499999331243334, 22.499999331243334, 1012.4999364547524, + -10.00000267621461}, + // 1 - F near underflow, t >= 0: z = 40, v = 60 + {80.5, 0.5, 2.0, 30.0, 0.0, 0.0, 0.0, 0.0, 0.0, -803.5110696989861, + -19.987592570140734, 19.987592570140734, 798.5092587427804, + -0.06629627085659788}, + // large v: z = 0.5, v = 100 + {1.5, 0.5, 2.0, 50.0, -0.37407622385854067, 0.2571494282589769, + -0.2571494282589769, -0.1259908195927297, 0.0001033557814703496, + -1.1645100485850222, -0.5668479905802706, 0.5668479905802706, + 0.2777281808527882, -0.00022783257749388368}, +}}; + +// Deep lower tail, same columns, mpmath at 800 digits with E = erfcx from +// its asymptotic series: F = exp(-z^2 / 2) (E(u) - E(t)) / 2. Delta = +// E(u) - E(t) is below 1e-300 here, or erfcx'(t) underflows, while log F +// and its partials are finite. The log ccdf and its partials round to 0. +inline const std::vector> + exp_mod_normal_lcdf_deep_tail_reference{{ + // z = -1e5, v = 1e-300 + {-199999.5, 0.5, 2.0, 5e-301, -5000000714.720317, 50000.00001, + -50000.00001, 5000000001.5, 1.9999999999999998e+300, 0.0, 0.0, 0.0, + 0.0, 0.0}, + // z = -1e20, v = 1e-300 + {-2e+20, 0.5, 2.0, 5e-301, -5e+39, 5e+19, -5e+19, 5e+39, + 1.9999999999999998e+300, 0.0, 0.0, 0.0, 0.0, 0.0}, + // z = -1e100, v = 1e-300 + {-2e+100, 0.5, 2.0, 5e-301, -5e+199, 5e+99, -5e+99, 5e+199, + 1.9999999999999998e+300, 0.0, 0.0, 0.0, 0.0, 0.0}, + // z = -1e150, v = 1e-10 + {-2e+150, 0.5, 2.0, 5e-11, -4.9999999999999995e+299, 5e+149, -5e+149, + 4.9999999999999995e+299, 20000000000.0, 0.0, 0.0, 0.0, 0.0, 0.0}, + // z = -1e154, v = 0.1 + {-2e+154, 0.5, 2.0, 0.05, -5e+307, 5e+153, -5e+153, 5e+307, 20.0, 0.0, + 0.0, 0.0, 0.0, 0.0}, + // z = -1e154, v = 1 + {-2e+154, 0.5, 2.0, 0.5, -5e+307, 5e+153, -5e+153, 5e+307, 2.0, 0.0, + 0.0, 0.0, 0.0, 0.0}, + }}; + +} // namespace test +} // namespace stan + +#endif diff --git a/test/unit/math/rev/prob/exp_mod_normal_lcdf_test.cpp b/test/unit/math/rev/prob/exp_mod_normal_lcdf_test.cpp new file mode 100644 index 00000000000..5bc3455012e --- /dev/null +++ b/test/unit/math/rev/prob/exp_mod_normal_lcdf_test.cpp @@ -0,0 +1,183 @@ +#include +#include +#include +#include +#include +#include +#include + +namespace { +const auto& ref_rows = stan::test::exp_mod_normal_lcdf_reference; + +void expect_rel(double expected, double actual) { + EXPECT_NEAR(expected, actual, 1e-12 * std::fabs(expected)); +} + +// Kind 0: lcdf, 1: lccdf, 2: cdf. +template +struct emg_fun { + template + static auto f(const T_y& y, const T_mu& mu, const T_sigma& sigma, + const T_lambda& lambda) { + if constexpr (Kind == 0) { + return stan::math::exp_mod_normal_lcdf(y, mu, sigma, lambda); + } else if constexpr (Kind == 1) { + return stan::math::exp_mod_normal_lccdf(y, mu, sigma, lambda); + } else { + return stan::math::exp_mod_normal_cdf(y, mu, sigma, lambda); + } + } +}; + +// The reference value and the four partials of row r for Kind. +template +std::array expected(const std::array& r) { + std::array e; + const std::size_t k = Kind == 1 ? 9 : 4; + for (std::size_t i = 0; i < 5; ++i) { + e[i] = r[k + i]; + } + if (Kind == 2) { + e[0] = std::exp(r[4]); + for (std::size_t i = 1; i < 5; ++i) { + e[i] = e[0] * r[4 + i]; + } + } + return e; +} + +template +void expect_rows_match_reference( + const std::vector>& rows) { + using stan::math::var; + for (std::size_t n = 0; n < rows.size(); ++n) { + SCOPED_TRACE(n); + const auto& r = rows[n]; + const auto e = expected(r); + expect_rel(e[0], emg_fun::f(r[0], r[1], r[2], r[3])); + var y = r[0]; + var mu = r[1]; + var sigma = r[2]; + var lambda = r[3]; + var lp = emg_fun::f(y, mu, sigma, lambda); + lp.grad(); + expect_rel(e[0], lp.val()); + expect_rel(e[1], y.adj()); + expect_rel(e[2], mu.adj()); + expect_rel(e[3], sigma.adj()); + expect_rel(e[4], lambda.adj()); + stan::math::recover_memory(); + } +} + +// All rows in one vectorized call of the lcdf or the lccdf: y and lambda +// vary, mu and sigma are shared scalars. +template +void expect_vectorized_sum_matches_reference() { + using stan::math::var; + std::vector y; + std::vector lambda; + double value = 0; + double value_scale = 0; + double d_mu = 0; + double d_mu_scale = 0; + double d_sigma = 0; + double d_sigma_scale = 0; + for (const auto& r : ref_rows) { + const auto e = expected(r); + y.emplace_back(r[0]); + lambda.emplace_back(r[3]); + value += e[0]; + value_scale += std::fabs(e[0]); + d_mu += e[2]; + d_mu_scale += std::fabs(e[2]); + d_sigma += e[3]; + d_sigma_scale += std::fabs(e[3]); + } + var mu = ref_rows[0][1]; + var sigma = ref_rows[0][2]; + var lp = emg_fun::f(y, mu, sigma, lambda); + lp.grad(); + EXPECT_NEAR(value, lp.val(), 1e-12 * value_scale); + EXPECT_NEAR(d_mu, mu.adj(), 1e-12 * d_mu_scale); + EXPECT_NEAR(d_sigma, sigma.adj(), 1e-12 * d_sigma_scale); + for (std::size_t n = 0; n < ref_rows.size(); ++n) { + SCOPED_TRACE(n); + const auto e = expected(ref_rows[n]); + expect_rel(e[1], y[n].adj()); + expect_rel(e[4], lambda[n].adj()); + } +} +} // namespace + +TEST_F(AgradRev, ProbDistributionsExpModNormal_lcdf_reference) { + expect_rows_match_reference<0>(ref_rows); +} + +TEST_F(AgradRev, ProbDistributionsExpModNormal_lccdf_reference) { + expect_rows_match_reference<1>(ref_rows); +} + +TEST_F(AgradRev, ProbDistributionsExpModNormal_cdf_reference) { + expect_rows_match_reference<2>(ref_rows); +} + +TEST_F(AgradRev, ProbDistributionsExpModNormal_lcdf_vectorized_reference) { + expect_vectorized_sum_matches_reference<0>(); +} + +TEST_F(AgradRev, ProbDistributionsExpModNormal_lccdf_vectorized_reference) { + expect_vectorized_sum_matches_reference<1>(); +} + +TEST_F(AgradRev, ProbDistributionsExpModNormal_deep_tail_reference) { + const auto& rows = stan::test::exp_mod_normal_lcdf_deep_tail_reference; + expect_rows_match_reference<0>(rows); + expect_rows_match_reference<1>(rows); + expect_rows_match_reference<2>(rows); +} + +// Beyond z = -1.9e154, log F = -z^2 / 2 and its sigma partial overflow. The +// value is -inf (lcdf), 0 (lccdf) or 0 (cdf), never NaN; the other partials +// stay finite, and the cdf has zero partials. +TEST_F(AgradRev, ProbDistributionsExpModNormal_overflowing_tail) { + using stan::math::var; + for (double z : {-1e155, -1e200, -1e300}) { + for (double v : {1e-300, 1.0, 1e10}) { + SCOPED_TRACE(z); + SCOPED_TRACE(v); + { + var y = z, mu = 0.0, sigma = 1.0, lambda = v; + var lp = stan::math::exp_mod_normal_lcdf(y, mu, sigma, lambda); + lp.grad(); + EXPECT_EQ(lp.val(), stan::math::NEGATIVE_INFTY); + // d log F / dz = -z + v + O(1 / z) here + EXPECT_FLOAT_EQ(y.adj(), -z); + EXPECT_FLOAT_EQ(mu.adj(), z); + EXPECT_TRUE(std::isfinite(lambda.adj())); + stan::math::recover_memory(); + } + { + var y = z, mu = 0.0, sigma = 1.0, lambda = v; + var lp = stan::math::exp_mod_normal_lccdf(y, mu, sigma, lambda); + lp.grad(); + EXPECT_EQ(lp.val(), 0.0); + EXPECT_TRUE(std::isfinite(y.adj())); + EXPECT_TRUE(std::isfinite(sigma.adj())); + EXPECT_TRUE(std::isfinite(lambda.adj())); + stan::math::recover_memory(); + } + { + var y = z, mu = 0.0, sigma = 1.0, lambda = v; + var lp = stan::math::exp_mod_normal_cdf(y, mu, sigma, lambda); + lp.grad(); + EXPECT_EQ(lp.val(), 0.0); + EXPECT_EQ(y.adj(), 0.0); + EXPECT_EQ(mu.adj(), 0.0); + EXPECT_EQ(sigma.adj(), 0.0); + EXPECT_EQ(lambda.adj(), 0.0); + stan::math::recover_memory(); + } + } + } +} diff --git a/test/unit/math/rev/prob/exp_mod_normal_lpdf_test.cpp b/test/unit/math/rev/prob/exp_mod_normal_lpdf_test.cpp new file mode 100644 index 00000000000..7f56e149409 --- /dev/null +++ b/test/unit/math/rev/prob/exp_mod_normal_lpdf_test.cpp @@ -0,0 +1,60 @@ +#include +#include +#include +#include +#include + +namespace { +auto exp_mod_normal_propto + = [](const auto& y, const auto& mu, const auto& sigma, const auto& lambda) { + return stan::math::exp_mod_normal_lpdf(y, mu, sigma, lambda); + }; + +std::vector to_vars(const std::vector& x) { + return {x.begin(), x.end()}; +} + +// z = (y - mu) / sigma - lambda sigma spans the deep lower tail, the small +// branch, the positive tail and z > 40. +const std::vector y{-40.0, -2.0, 0.5, 3.0, 10.0, 60.0}; +const std::vector mu{0.1, 0.3, -0.4, 1.0, 0.0, -0.2}; +const std::vector sigma{1.3, 0.5, 1.2, 2.0, 0.9, 1.0}; +const std::vector lambda{0.7, 4.0, 1.0, 0.2, 0.5, 2.5}; +} // namespace + +TEST_F(AgradRev, ProbDistributionsExpModNormal_propto_vector_var) { + using stan::test::expect_propto_vectorized; + expect_propto_vectorized(exp_mod_normal_propto, to_vars(y), 0.1, 1.3, 0.7); + expect_propto_vectorized(exp_mod_normal_propto, 0.5, to_vars(mu), 1.3, 0.7); + expect_propto_vectorized(exp_mod_normal_propto, 0.5, 0.1, to_vars(sigma), + 0.7); + expect_propto_vectorized(exp_mod_normal_propto, 0.5, 0.1, 1.3, + to_vars(lambda)); + expect_propto_vectorized(exp_mod_normal_propto, to_vars(y), mu, + to_vars(sigma), 0.7); + expect_propto_vectorized(exp_mod_normal_propto, y, to_vars(mu), sigma, + to_vars(lambda)); +} + +TEST_F(AgradRev, ProbDistributionsExpModNormal_propto_scalar_var_broadcast) { + using stan::math::var; + using stan::test::expect_propto_vectorized; + // A scalar var is shared by every element, so log(lambda) counts N times. + expect_propto_vectorized(exp_mod_normal_propto, y, 0.1, 1.3, var(0.7)); + expect_propto_vectorized(exp_mod_normal_propto, y, mu, sigma, var(0.7)); + expect_propto_vectorized(exp_mod_normal_propto, var(0.5), 0.1, 1.3, lambda); + expect_propto_vectorized(exp_mod_normal_propto, 0.5, var(0.1), 1.3, lambda); + expect_propto_vectorized(exp_mod_normal_propto, y, mu, var(1.3), lambda); +} + +TEST_F(AgradRev, ProbDistributionsExpModNormal_propto_eigen) { + using stan::math::var; + using stan::test::expect_propto_vectorized; + Eigen::Matrix y_d(y.size()); + Eigen::Matrix lambda_v(lambda.size()); + for (size_t i = 0; i < y.size(); ++i) { + y_d(i) = y[i]; + lambda_v(i) = lambda[i]; + } + expect_propto_vectorized(exp_mod_normal_propto, y_d, var(0.1), 1.3, lambda_v); +} diff --git a/test/unit/math/rev/prob/expect_propto_vectorized.hpp b/test/unit/math/rev/prob/expect_propto_vectorized.hpp new file mode 100644 index 00000000000..b34578bcfc3 --- /dev/null +++ b/test/unit/math/rev/prob/expect_propto_vectorized.hpp @@ -0,0 +1,87 @@ +#ifndef TEST_UNIT_MATH_REV_PROB_EXPECT_PROPTO_VECTORIZED_HPP +#define TEST_UNIT_MATH_REV_PROB_EXPECT_PROPTO_VECTORIZED_HPP + +#include +#include +#include +#include +#include + +namespace stan { +namespace test { +namespace internal { + +template * = nullptr> +inline const T& propto_element(const T& x, size_t) { + return x; +} + +template * = nullptr> +inline const auto& propto_element(const T& x, size_t i) { + return x[i]; +} + +template * = nullptr> +inline void append_vars(std::vector& vars, const T& x) { + if constexpr (is_var::value) { + vars.push_back(x); + } +} + +template * = nullptr> +inline void append_vars(std::vector& vars, const T& x) { + for (size_t i = 0; i < static_cast(x.size()); ++i) { + append_vars(vars, x[i]); + } +} + +inline std::vector adjoints(const std::vector& vars) { + std::vector adj; + for (const auto& v : vars) { + adj.push_back(v.adj()); + } + return adj; +} + +} // namespace internal + +/** + * Expect a vectorized propto log density and its gradients to match the sum + * of the elementwise scalar calls. Scalar arguments are shared by every scalar + * call, so a scalar var's adjoint is summed over the elements, which checks + * how the vectorized call broadcasts it. + * + * @param f Functor calling the propto log density. + * @param args Scalars or std/Eigen vectors of double or var. + */ +template +void expect_propto_vectorized(const F& f, const Args&... args) { + std::vector vars; + (internal::append_vars(vars, args), ...); + ASSERT_FALSE(vars.empty()) << "propto needs an autodiff argument"; + const size_t N = stan::math::max_size(args...); + + stan::math::var lp = f(args...); + stan::math::var lp_scalars = 0; + for (size_t i = 0; i < N; ++i) { + lp_scalars += f(internal::propto_element(args, i)...); + } + const double tol = 1e-12 * std::max(1.0, std::fabs(lp_scalars.val())); + EXPECT_NEAR(lp_scalars.val(), lp.val(), tol); + + stan::math::set_zero_all_adjoints(); + lp.grad(); + const auto grad = internal::adjoints(vars); + stan::math::set_zero_all_adjoints(); + lp_scalars.grad(); + const auto grad_scalars = internal::adjoints(vars); + for (size_t i = 0; i < vars.size(); ++i) { + EXPECT_NEAR(grad_scalars[i], grad[i], + 1e-12 * std::max(1.0, std::fabs(grad_scalars[i]))) + << "gradient " << i; + } +} + +} // namespace test +} // namespace stan +#endif diff --git a/test/unit/math/rev/prob/normal_lcdf_small_sigma_test.cpp b/test/unit/math/rev/prob/normal_lcdf_small_sigma_test.cpp new file mode 100644 index 00000000000..6b623a7449d --- /dev/null +++ b/test/unit/math/rev/prob/normal_lcdf_small_sigma_test.cpp @@ -0,0 +1,81 @@ +#include +#include +#include +#include +#include + +// 1 / sigma overflows for sigma below 1 / DBL_MAX (about 5.6e-309). At the +// median the value is log(1/2) for every sigma, and the y and mu partials are +// +-phi(0) / Phi(0) / sigma, which overflows to +-inf for such sigma. The +// sigma partial is 0 where 1 / sigma is finite. + +namespace { + +template +void expect_median(const F& f, double y0, double sigma0, double sign) { + using stan::math::var; + var y = y0, mu = 0.0, sigma = sigma0; + var lp = f(y, mu, sigma); + lp.grad(); + EXPECT_DOUBLE_EQ(lp.val(), std::log(0.5)) << "sigma = " << sigma0; + // phi(0) / Phi(0) = sqrt(2 / pi) + const double slope = std::sqrt(2.0 / stan::math::pi()) / sigma0; + if (std::isfinite(slope)) { + EXPECT_NEAR(y.adj(), sign * slope, 1e-14 * slope); + EXPECT_NEAR(mu.adj(), -sign * slope, 1e-14 * slope); + EXPECT_EQ(sigma.adj(), 0.0) << "sigma = " << sigma0; + } else { + EXPECT_EQ(y.adj(), sign * std::numeric_limits::infinity()); + EXPECT_EQ(mu.adj(), -sign * std::numeric_limits::infinity()); + } + stan::math::recover_memory(); +} + +const std::vector sigmas{1.0, 1e-300, 1e-308, 1e-310, 4.9e-324}; + +} // namespace + +TEST(ProbNormalLcdf, median_with_subnormal_sigma) { + for (double s : sigmas) { + expect_median( + [](auto& y, auto& mu, auto& sigma) { + return stan::math::normal_lcdf(y, mu, sigma); + }, + 0.0, s, 1.0); + expect_median( + [](auto& y, auto& mu, auto& sigma) { + return stan::math::normal_lccdf(y, mu, sigma); + }, + 0.0, s, -1.0); + } +} + +TEST(ProbLognormalLcdf, median_with_subnormal_sigma) { + for (double s : sigmas) { + expect_median( + [](auto& y, auto& mu, auto& sigma) { + return stan::math::lognormal_lcdf(y, mu, sigma); + }, + 1.0, s, 1.0); + expect_median( + [](auto& y, auto& mu, auto& sigma) { + return stan::math::lognormal_lccdf(y, mu, sigma); + }, + 1.0, s, -1.0); + } +} + +TEST(ProbNormalLcdf, median_with_subnormal_sigma_vector) { + using stan::math::var; + Eigen::Matrix sigma(3); + sigma << 1.0, 1e-310, 2.0; + Eigen::Matrix y(3); + y << 0.0, 0.0, 1.0; + var lp = stan::math::normal_lcdf(y, 0.0, sigma); + lp.grad(); + const double expected + = 2 * std::log(0.5) + std::log(0.5 * std::erfc(-0.5 / std::sqrt(2.0))); + EXPECT_NEAR(lp.val(), expected, 1e-15); + EXPECT_TRUE(std::isfinite(sigma(2).adj())); + stan::math::recover_memory(); +} diff --git a/test/unit/math/rev/prob/skew_normal_lpdf_test.cpp b/test/unit/math/rev/prob/skew_normal_lpdf_test.cpp new file mode 100644 index 00000000000..629b4d31a12 --- /dev/null +++ b/test/unit/math/rev/prob/skew_normal_lpdf_test.cpp @@ -0,0 +1,58 @@ +#include +#include +#include +#include +#include + +namespace { +auto skew_normal_propto + = [](const auto& y, const auto& mu, const auto& sigma, const auto& alpha) { + return stan::math::skew_normal_lpdf(y, mu, sigma, alpha); + }; + +std::vector to_vars(const std::vector& x) { + return {x.begin(), x.end()}; +} + +// alpha * z spans the deep lower tail, the small branch and z > 40. +const std::vector y{-50.0, -2.0, 0.3, 1.5, 4.0, 50.0}; +const std::vector mu{0.1, -0.4, 0.6, 1.0, -1.0, 0.0}; +const std::vector sigma{1.0, 0.5, 1.2, 2.0, 0.9, 1.0}; +const std::vector alpha{1.0, -3.0, -0.5, 0.0, 2.5, -1.0}; +} // namespace + +TEST_F(AgradRev, ProbDistributionsSkewNormal_propto_vector_var) { + using stan::test::expect_propto_vectorized; + expect_propto_vectorized(skew_normal_propto, to_vars(y), 0.2, 1.3, 0.7); + expect_propto_vectorized(skew_normal_propto, 0.2, to_vars(mu), 1.3, 0.7); + expect_propto_vectorized(skew_normal_propto, 0.2, 0.1, to_vars(sigma), 0.7); + // z is a scalar, so only the broadcast log Phi(alpha z) terms remain. + expect_propto_vectorized(skew_normal_propto, 0.2, 0.1, 1.3, to_vars(alpha)); + expect_propto_vectorized(skew_normal_propto, to_vars(y), mu, to_vars(sigma), + 0.7); + expect_propto_vectorized(skew_normal_propto, y, to_vars(mu), sigma, + to_vars(alpha)); +} + +TEST_F(AgradRev, ProbDistributionsSkewNormal_propto_scalar_var_broadcast) { + using stan::math::var; + using stan::test::expect_propto_vectorized; + // A scalar var is shared by every element, so its terms count N times. + expect_propto_vectorized(skew_normal_propto, var(0.2), 0.1, 1.3, alpha); + expect_propto_vectorized(skew_normal_propto, 0.2, var(0.1), 1.3, alpha); + expect_propto_vectorized(skew_normal_propto, y, 0.1, var(1.3), 0.7); + expect_propto_vectorized(skew_normal_propto, y, mu, var(1.3), alpha); + expect_propto_vectorized(skew_normal_propto, y, mu, sigma, var(0.7)); +} + +TEST_F(AgradRev, ProbDistributionsSkewNormal_propto_eigen) { + using stan::math::var; + using stan::test::expect_propto_vectorized; + Eigen::Matrix y_v(y.size()); + Eigen::Matrix alpha_d(alpha.size()); + for (size_t i = 0; i < y.size(); ++i) { + y_v(i) = y[i]; + alpha_d(i) = alpha[i]; + } + expect_propto_vectorized(skew_normal_propto, y_v, 0.1, var(1.3), alpha_d); +}