Stan  2.5.0
probability, sampling & optimization
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Pages
scaled_inv_chi_square.hpp
Go to the documentation of this file.
1 #ifndef STAN__PROB__DISTRIBUTIONS__UNIVARIATE__CONTINUOUS__SCALED_INV_CHI_SQUARE_HPP
2 #define STAN__PROB__DISTRIBUTIONS__UNIVARIATE__CONTINUOUS__SCALED_INV_CHI_SQUARE_HPP
3 
4 #include <boost/random/chi_squared_distribution.hpp>
5 #include <boost/random/variate_generator.hpp>
6 
13 #include <stan/meta/traits.hpp>
14 #include <stan/prob/constants.hpp>
15 #include <stan/prob/traits.hpp>
17 
18 namespace stan {
19 
20  namespace prob {
21 
41  template <bool propto,
42  typename T_y, typename T_dof, typename T_scale>
43  typename return_type<T_y,T_dof,T_scale>::type
44  scaled_inv_chi_square_log(const T_y& y, const T_dof& nu, const T_scale& s) {
45  static const char* function
46  = "stan::prob::scaled_inv_chi_square_log(%1%)";
47 
52 
53  // check if any vectors are zero length
54  if (!(stan::length(y)
55  && stan::length(nu)
56  && stan::length(s)))
57  return 0.0;
58 
59  double logp(0.0);
60  check_not_nan(function, y, "Random variable", &logp);
61  check_positive_finite(function, nu, "Degrees of freedom parameter",
62  &logp);
63  check_positive_finite(function, s, "Scale parameter", &logp);
64  check_consistent_sizes(function,
65  y,nu,s,
66  "Random variable",
67  "Degrees of freedom parameter",
68  "Scale parameter",
69  &logp);
70 
71  // check if no variables are involved and prop-to
73  return 0.0;
74 
75  VectorView<const T_y> y_vec(y);
76  VectorView<const T_dof> nu_vec(nu);
78  size_t N = max_size(y, nu, s);
79 
80  for (size_t n = 0; n < N; n++) {
81  if (value_of(y_vec[n]) <= 0)
82  return LOG_ZERO;
83  }
84 
85  using boost::math::lgamma;
88  using stan::math::square;
89 
91  is_vector<T_dof>::value> half_nu(length(nu));
92  for (size_t i = 0; i < length(nu); i++)
94  half_nu[i] = 0.5 * value_of(nu_vec[i]);
95 
97  is_vector<T_y>::value> log_y(length(y));
98  for (size_t i = 0; i < length(y); i++)
100  log_y[i] = log(value_of(y_vec[i]));
101 
103  is_vector<T_y>::value> inv_y(length(y));
104  for (size_t i = 0; i < length(y); i++)
106  inv_y[i] = 1.0 / value_of(y_vec[i]);
107 
110  for (size_t i = 0; i < length(s); i++)
112  log_s[i] = log(value_of(s_vec[i]));
113 
115  is_vector<T_dof>::value> log_half_nu(length(nu));
117  is_vector<T_dof>::value> lgamma_half_nu(length(nu));
119  is_vector<T_dof>::value> digamma_half_nu_over_two(length(nu));
120  for (size_t i = 0; i < length(nu); i++) {
122  lgamma_half_nu[i] = lgamma(half_nu[i]);
124  log_half_nu[i] = log(half_nu[i]);
126  digamma_half_nu_over_two[i] = digamma(half_nu[i]) * 0.5;
127  }
128 
130  operands_and_partials(y, nu, s);
131  for (size_t n = 0; n < N; n++) {
132  const double s_dbl = value_of(s_vec[n]);
133  const double nu_dbl = value_of(nu_vec[n]);
135  logp += half_nu[n] * log_half_nu[n] - lgamma_half_nu[n];
137  logp += nu_dbl * log_s[n];
139  logp -= (half_nu[n]+1.0) * log_y[n];
141  logp -= half_nu[n] * s_dbl*s_dbl * inv_y[n];
142 
144  operands_and_partials.d_x1[n]
145  += -(half_nu[n] + 1.0) * inv_y[n]
146  + half_nu[n] * s_dbl*s_dbl * inv_y[n]*inv_y[n];
147  }
149  operands_and_partials.d_x2[n]
150  += 0.5 * log_half_nu[n] + 0.5
151  - digamma_half_nu_over_two[n]
152  + log_s[n]
153  - 0.5 * log_y[n]
154  - 0.5* s_dbl*s_dbl * inv_y[n];
155  }
157  operands_and_partials.d_x3[n]
158  += nu_dbl / s_dbl - nu_dbl * inv_y[n] * s_dbl;
159  }
160  }
161  return operands_and_partials.to_var(logp);
162  }
163 
164  template <typename T_y, typename T_dof, typename T_scale>
165  inline
167  scaled_inv_chi_square_log(const T_y& y, const T_dof& nu, const T_scale& s) {
168  return scaled_inv_chi_square_log<false>(y,nu,s);
169  }
170 
185  template <typename T_y, typename T_dof, typename T_scale>
187  scaled_inv_chi_square_cdf(const T_y& y, const T_dof& nu,
188  const T_scale& s) {
189  // Size checks
190  if (!(stan::length(y) && stan::length(nu) && stan::length(s)))
191  return 1.0;
192 
193  static const char* function
194  = "stan::prob::scaled_inv_chi_square_cdf(%1%)";
195 
200  using stan::math::value_of;
201 
202  double P(1.0);
203 
204  check_not_nan(function, y, "Random variable", &P);
205  check_nonnegative(function, y, "Random variable", &P);
206  check_positive_finite(function, nu, "Degrees of freedom parameter", &P);
207  check_positive_finite(function, s, "Scale parameter", &P);
208  check_consistent_sizes(function, y, nu, s,
209  "Random variable",
210  "Degrees of freedom parameter",
211  "Scale parameter",
212  &P);
213 
214  // Wrap arguments in vectors
215  VectorView<const T_y> y_vec(y);
216  VectorView<const T_dof> nu_vec(nu);
217  VectorView<const T_scale> s_vec(s);
218  size_t N = max_size(y, nu, s);
219 
221  operands_and_partials(y, nu, s);
222 
223  // Explicit return for extreme values
224  // The gradients are technically ill-defined, but treated as zero
225 
226  for (size_t i = 0; i < stan::length(y); i++) {
227  if (value_of(y_vec[i]) == 0)
228  return operands_and_partials.to_var(0.0);
229  }
230 
231  // Compute CDF and its gradients
232  using boost::math::gamma_p_derivative;
233  using boost::math::gamma_q;
234  using boost::math::digamma;
235  using boost::math::tgamma;
236 
237  // Cache a few expensive function calls if nu is a parameter
239  is_vector<T_dof>::value> gamma_vec(stan::length(nu));
241  is_vector<T_dof>::value> digamma_vec(stan::length(nu));
242 
244  for (size_t i = 0; i < stan::length(nu); i++) {
245  const double half_nu_dbl = 0.5 * value_of(nu_vec[i]);
246  gamma_vec[i] = tgamma(half_nu_dbl);
247  digamma_vec[i] = digamma(half_nu_dbl);
248  }
249  }
250 
251  // Compute vectorized CDF and gradient
252  for (size_t n = 0; n < N; n++) {
253 
254  // Explicit results for extreme values
255  // The gradients are technically ill-defined, but treated as zero
256  if (value_of(y_vec[n]) == std::numeric_limits<double>::infinity()) {
257  continue;
258  }
259 
260  // Pull out values
261  const double y_dbl = value_of(y_vec[n]);
262  const double y_inv_dbl = 1.0 / y_dbl;
263  const double half_nu_dbl = 0.5 * value_of(nu_vec[n]);
264  const double s_dbl = value_of(s_vec[n]);
265  const double half_s2_overx_dbl = 0.5 * s_dbl * s_dbl * y_inv_dbl;
266  const double half_nu_s2_overx_dbl
267  = 2.0 * half_nu_dbl * half_s2_overx_dbl;
268 
269  // Compute
270  const double Pn = gamma_q(half_nu_dbl, half_nu_s2_overx_dbl);
271 
272  P *= Pn;
273 
275  operands_and_partials.d_x1[n]
276  += half_nu_s2_overx_dbl * y_inv_dbl
277  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) / Pn;
278 
280  operands_and_partials.d_x2[n]
281  += (0.5 * stan::math::gradRegIncGamma(half_nu_dbl,
282  half_nu_s2_overx_dbl,
283  gamma_vec[n], digamma_vec[n])
284  - half_s2_overx_dbl
285  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) )
286  / Pn;
287 
289  operands_and_partials.d_x3[n]
290  += - 2.0 * half_nu_dbl * s_dbl * y_inv_dbl
291  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) / Pn;
292 
293  }
294 
296  for(size_t n = 0; n < stan::length(y); ++n)
297  operands_and_partials.d_x1[n] *= P;
299  for(size_t n = 0; n < stan::length(nu); ++n)
300  operands_and_partials.d_x2[n] *= P;
302  for(size_t n = 0; n < stan::length(s); ++n)
303  operands_and_partials.d_x3[n] *= P;
304 
305  return operands_and_partials.to_var(P);
306  }
307 
308  template <typename T_y, typename T_dof, typename T_scale>
310  scaled_inv_chi_square_cdf_log(const T_y& y, const T_dof& nu,
311  const T_scale& s) {
312  // Size checks
313  if (!(stan::length(y) && stan::length(nu) && stan::length(s)))
314  return 0.0;
315 
316  static const char* function
317  = "stan::prob::scaled_inv_chi_square_cdf_log(%1%)";
318 
323  using stan::math::value_of;
324 
325  double P(0.0);
326 
327  check_not_nan(function, y, "Random variable", &P);
328  check_nonnegative(function, y, "Random variable", &P);
329  check_positive_finite(function, nu, "Degrees of freedom parameter", &P);
330  check_positive_finite(function, s, "Scale parameter", &P);
331  check_consistent_sizes(function, y, nu, s,
332  "Random variable",
333  "Degrees of freedom parameter",
334  "Scale parameter",
335  &P);
336 
337  // Wrap arguments in vectors
338  VectorView<const T_y> y_vec(y);
339  VectorView<const T_dof> nu_vec(nu);
340  VectorView<const T_scale> s_vec(s);
341  size_t N = max_size(y, nu, s);
342 
344  operands_and_partials(y, nu, s);
345 
346  // Explicit return for extreme values
347  // The gradients are technically ill-defined, but treated as zero
348  for (size_t i = 0; i < stan::length(y); i++) {
349  if (value_of(y_vec[i]) == 0)
350  return operands_and_partials.to_var(stan::math::negative_infinity());
351  }
352 
353  // Compute cdf_log and its gradients
354  using boost::math::gamma_p_derivative;
355  using boost::math::gamma_q;
356  using boost::math::digamma;
357  using boost::math::tgamma;
358 
359  // Cache a few expensive function calls if nu is a parameter
361  is_vector<T_dof>::value> gamma_vec(stan::length(nu));
363  is_vector<T_dof>::value> digamma_vec(stan::length(nu));
364 
366  for (size_t i = 0; i < stan::length(nu); i++) {
367  const double half_nu_dbl = 0.5 * value_of(nu_vec[i]);
368  gamma_vec[i] = tgamma(half_nu_dbl);
369  digamma_vec[i] = digamma(half_nu_dbl);
370  }
371  }
372 
373  // Compute vectorized cdf_log and gradient
374  for (size_t n = 0; n < N; n++) {
375 
376  // Explicit results for extreme values
377  // The gradients are technically ill-defined, but treated as zero
378  if (value_of(y_vec[n]) == std::numeric_limits<double>::infinity()) {
379  continue;
380  }
381 
382  // Pull out values
383  const double y_dbl = value_of(y_vec[n]);
384  const double y_inv_dbl = 1.0 / y_dbl;
385  const double half_nu_dbl = 0.5 * value_of(nu_vec[n]);
386  const double s_dbl = value_of(s_vec[n]);
387  const double half_s2_overx_dbl = 0.5 * s_dbl * s_dbl * y_inv_dbl;
388  const double half_nu_s2_overx_dbl
389  = 2.0 * half_nu_dbl * half_s2_overx_dbl;
390 
391  // Compute
392  const double Pn = gamma_q(half_nu_dbl, half_nu_s2_overx_dbl);
393 
394  P += log(Pn);
395 
397  operands_and_partials.d_x1[n]
398  += half_nu_s2_overx_dbl * y_inv_dbl
399  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) / Pn;
401  operands_and_partials.d_x2[n]
402  += (0.5 * stan::math::gradRegIncGamma(half_nu_dbl,
403  half_nu_s2_overx_dbl,
404  gamma_vec[n], digamma_vec[n])
405  - half_s2_overx_dbl
406  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) )
407  / Pn;
409  operands_and_partials.d_x3[n]
410  += - 2.0 * half_nu_dbl * s_dbl * y_inv_dbl
411  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) / Pn;
412  }
413 
414  return operands_and_partials.to_var(P);
415  }
416 
417  template <typename T_y, typename T_dof, typename T_scale>
419  scaled_inv_chi_square_ccdf_log(const T_y& y, const T_dof& nu,
420  const T_scale& s) {
421  // Size checks
422  if (!(stan::length(y) && stan::length(nu) && stan::length(s)))
423  return 0.0;
424 
425  static const char* function
426  = "stan::prob::scaled_inv_chi_square_ccdf_log(%1%)";
427 
432  using stan::math::value_of;
433 
434  double P(0.0);
435 
436  check_not_nan(function, y, "Random variable", &P);
437  check_nonnegative(function, y, "Random variable", &P);
438  check_positive_finite(function, nu, "Degrees of freedom parameter", &P);
439  check_positive_finite(function, s, "Scale parameter", &P);
440  check_consistent_sizes(function, y, nu, s,
441  "Random variable",
442  "Degrees of freedom parameter",
443  "Scale parameter",
444  &P);
445 
446  // Wrap arguments in vectors
447  VectorView<const T_y> y_vec(y);
448  VectorView<const T_dof> nu_vec(nu);
449  VectorView<const T_scale> s_vec(s);
450  size_t N = max_size(y, nu, s);
451 
453  operands_and_partials(y, nu, s);
454 
455  // Explicit return for extreme values
456  // The gradients are technically ill-defined, but treated as zero
457  for (size_t i = 0; i < stan::length(y); i++) {
458  if (value_of(y_vec[i]) == 0)
459  return operands_and_partials.to_var(0.0);
460  }
461 
462  // Compute cdf_log and its gradients
463  using boost::math::gamma_p_derivative;
464  using boost::math::gamma_q;
465  using boost::math::digamma;
466  using boost::math::tgamma;
467 
468  // Cache a few expensive function calls if nu is a parameter
470  is_vector<T_dof>::value> gamma_vec(stan::length(nu));
472  is_vector<T_dof>::value> digamma_vec(stan::length(nu));
473 
475  for (size_t i = 0; i < stan::length(nu); i++) {
476  const double half_nu_dbl = 0.5 * value_of(nu_vec[i]);
477  gamma_vec[i] = tgamma(half_nu_dbl);
478  digamma_vec[i] = digamma(half_nu_dbl);
479  }
480  }
481 
482  // Compute vectorized cdf_log and gradient
483  for (size_t n = 0; n < N; n++) {
484 
485  // Explicit results for extreme values
486  // The gradients are technically ill-defined, but treated as zero
487  if (value_of(y_vec[n]) == std::numeric_limits<double>::infinity()) {
488  return operands_and_partials.to_var(stan::math::negative_infinity());
489  }
490 
491  // Pull out values
492  const double y_dbl = value_of(y_vec[n]);
493  const double y_inv_dbl = 1.0 / y_dbl;
494  const double half_nu_dbl = 0.5 * value_of(nu_vec[n]);
495  const double s_dbl = value_of(s_vec[n]);
496  const double half_s2_overx_dbl = 0.5 * s_dbl * s_dbl * y_inv_dbl;
497  const double half_nu_s2_overx_dbl
498  = 2.0 * half_nu_dbl * half_s2_overx_dbl;
499 
500  // Compute
501  const double Pn = 1.0 - gamma_q(half_nu_dbl, half_nu_s2_overx_dbl);
502 
503  P += log(Pn);
504 
506  operands_and_partials.d_x1[n]
507  -= half_nu_s2_overx_dbl * y_inv_dbl
508  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) / Pn;
510  operands_and_partials.d_x2[n]
511  -= (0.5 * stan::math::gradRegIncGamma(half_nu_dbl,
512  half_nu_s2_overx_dbl,
513  gamma_vec[n], digamma_vec[n])
514  - half_s2_overx_dbl
515  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) )
516  / Pn;
518  operands_and_partials.d_x3[n]
519  += 2.0 * half_nu_dbl * s_dbl * y_inv_dbl
520  * gamma_p_derivative(half_nu_dbl, half_nu_s2_overx_dbl) / Pn;
521  }
522 
523  return operands_and_partials.to_var(P);
524  }
525 
526  template <class RNG>
527  inline double
528  scaled_inv_chi_square_rng(const double nu,
529  const double s,
530  RNG& rng) {
531  using boost::variate_generator;
532  using boost::random::chi_squared_distribution;
533 
534  static const char* function
535  = "stan::prob::scaled_inv_chi_square_rng(%1%)";
536 
538 
539  check_positive_finite(function, nu, "Degrees of freedom parameter",
540  (double*)0);
541  check_positive_finite(function, s, "Scale parameter", (double*)0);
542 
543  variate_generator<RNG&, chi_squared_distribution<> >
544  chi_square_rng(rng, chi_squared_distribution<>(nu));
545  return nu * s / chi_square_rng();
546  }
547  }
548 }
549 #endif
550 
T square(const T x)
Return the square of the specified argument.
Definition: square.hpp:22
fvar< T > tgamma(const fvar< T > &x)
Definition: tgamma.hpp:15
T_return_type to_var(double logp)
bool check_positive_finite(const char *function, const T_y &y, const char *name, T_result *result)
boost::math::tools::promote_args< T_a, T_b >::type multiply_log(const T_a a, const T_b b)
Calculated the value of the first argument times log of the second argument while behaving properly w...
size_t length(const T &)
Definition: traits.hpp:159
DoubleVectorView allocates double values to be used as intermediate values.
Definition: traits.hpp:358
T value_of(const fvar< T > &v)
Return the value of the specified variable.
Definition: value_of.hpp:16
return_type< T_y, T_dof, T_scale >::type scaled_inv_chi_square_ccdf_log(const T_y &y, const T_dof &nu, const T_scale &s)
fvar< T > lgamma(const fvar< T > &x)
Definition: lgamma.hpp:15
A variable implementation that stores operands and derivatives with respect to the variable...
boost::math::tools::promote_args< typename scalar_type< T1 >::type, typename scalar_type< T2 >::type, typename scalar_type< T3 >::type, typename scalar_type< T4 >::type, typename scalar_type< T5 >::type, typename scalar_type< T6 >::type >::type type
Definition: traits.hpp:406
Metaprogram to determine if a type has a base scalar type that can be assigned to type double...
Definition: traits.hpp:57
double value_of(const T x)
Return the value of the specified scalar argument converted to a double value.
Definition: value_of.hpp:24
Template metaprogram to calculate whether a summand needs to be included in a proportional (log) prob...
Definition: traits.hpp:35
fvar< T > gamma_q(const fvar< T > &x1, const fvar< T > &x2)
Definition: gamma_q.hpp:15
return_type< T_y, T_dof, T_scale >::type scaled_inv_chi_square_cdf(const T_y &y, const T_dof &nu, const T_scale &s)
The CDF of a scaled inverse chi-squared density for y with the specified degrees of freedom parameter...
VectorView< double *, is_vector< T2 >::value, is_constant_struct< T2 >::value > d_x2
return_type< T_y, T_dof, T_scale >::type scaled_inv_chi_square_log(const T_y &y, const T_dof &nu, const T_scale &s)
The log of a scaled inverse chi-squared density for y with the specified degrees of freedom parameter...
double gradRegIncGamma(double a, double z, double g, double dig, double precision=1e-6)
bool check_nonnegative(const char *function, const T_y &y, const char *name, T_result *result)
bool check_consistent_sizes(const char *function, const T1 &x1, const T2 &x2, const char *name1, const char *name2, T_result *result)
size_t max_size(const T1 &x1, const T2 &x2)
Definition: traits.hpp:191
return_type< T_y, T_dof, T_scale >::type scaled_inv_chi_square_cdf_log(const T_y &y, const T_dof &nu, const T_scale &s)
bool check_not_nan(const char *function, const T_y &y, const char *name, T_result *result)
Checks if the variable y is nan.
fvar< T > digamma(const fvar< T > &x)
Definition: digamma.hpp:16
VectorView< double *, is_vector< T1 >::value, is_constant_struct< T1 >::value > d_x1
VectorView< double *, is_vector< T3 >::value, is_constant_struct< T3 >::value > d_x3
fvar< T > log(const fvar< T > &x)
Definition: log.hpp:15
double scaled_inv_chi_square_rng(const double nu, const double s, RNG &rng)
VectorView is a template metaprogram that takes its argument and allows it to be used like a vector...
Definition: traits.hpp:275
double negative_infinity()
Return negative infinity.
Definition: constants.hpp:123
double chi_square_rng(const double nu, RNG &rng)
Definition: chi_square.hpp:442

     [ Stan Home Page ] © 2011–2014, Stan Development Team.