[go: up one dir, main page]

File: beta.c

package info (click to toggle)
r-cran-actuar 3.3-5-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,960 kB
  • sloc: ansic: 7,899; makefile: 18; sh: 13
file content (58 lines) | stat: -rw-r--r-- 1,467 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
/*  actuar: Actuarial Functions and Heavy Tailed Distributions
 *
 *  Functions to calculate raw and limited moments for the Beta
 *  distribution. See ../R/BetaMoments.R for details.
 *
 *  AUTHOR: Vincent Goulet <vincent.goulet@act.ulaval.ca>
 */

#include <R.h>
#include <Rmath.h>
#include "locale.h"
#include "dpq.h"

double mbeta(double order, double shape1, double shape2, int give_log)
{
#ifdef IEEE_754
    if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2))
	return order + shape1 + shape2;
#endif
    if (!R_FINITE(shape1) ||
        !R_FINITE(shape2) ||
        !R_FINITE(order)  ||
        shape1 <= 0.0 ||
        shape2 <= 0.0)
        return R_NaN;

    if (order <= -shape1)
	return R_PosInf;

    return beta(shape1 + order, shape2) / beta(shape1, shape2);
}

double levbeta(double limit, double shape1, double shape2, double order,
                int give_log)
{
#ifdef IEEE_754
    if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(order))
	return limit + shape1 + shape2 + order;
#endif
    if (!R_FINITE(shape1) ||
        !R_FINITE(shape2) ||
        !R_FINITE(order) ||
        shape1 <= 0.0 ||
        shape2 <= 0.0)
        return R_NaN;

    if (order <= -shape1)
	return R_PosInf;

    if (limit <= 0.0)
        return 0.0;

    double tmp = order + shape1;

    return beta(tmp, shape2) / beta(shape1, shape2) *
        pbeta(limit, tmp, shape2, 1, 0) +
        ACT_DLIM__0(limit, order) * pbeta(limit, shape1, shape2, 0, 0);
}