在 R 中评估非常大的阶乘
Eval very large factorial in R
我需要集成一个在表达式中有阶乘的函数。但是,如果您尝试评估阶乘,当 n > 170 时,R returns Inf.
我发现有很多包可以让您计算非常大的数字,但是,它们总是 returns 来自 class 的对象,我无法集成。积分的最终结果总是一个小数。
这是我的代码:
integrand <- function(n, i, x) {
(factorial(n) / (factorial(i - 1) * factorial(n - i))) *
x^(i - 1) * (1 - x)^(n - i)
}
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
integrate(integrand,
lower = lower, upper = upper, n = n, i = i,
stop.on.error = FALSE)$value
}
forder <- Vectorize(forder, "x")
##------------------------------------------------------------------------------
## Some example
y <- sort(rpois(100, 1))
## Works fine
forder(ppois, y, 170, 10, lambda = 1)
## Does not work
forder(ppois, y, 171, 10, lambda = 1)
##------------------------------------------------------------------------------
将 integrand
更改为使用对数,这两个调用都有效。我还 post 函数 @StéphaneLaurent 关于使用 choose/lchoose
和 pbeta/beta
函数的想法。
integrand <- function(n, i, x) {
y <- lfactorial(n) - lfactorial(i - 1) - lfactorial(n - i) +
(i - 1)*log(x) + log(1 - x)*(n - i)
exp(y)
}
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
integrate(integrand,
lower = lower, upper = upper, n = n, i = i,
stop.on.error = FALSE)$value
}
forder <- Vectorize(forder, "x")
integrandSL <- function(n, i, x) {
y <- log(i) + lchoose(n, i) + (i - 1)*log(x) + log(1 - x)*(n - i)
exp(y)
}
forderSL <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
integrate(integrandSL,
lower = lower, upper = upper, n = n, i = i,
stop.on.error = FALSE)$value
}
forderSL <- Vectorize(forderSL, "x")
forderSL2 <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
lg <- log(i) + lchoose(n, i) +
log(pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)) + lbeta(i, n-i+1)
exp(lg)
}
现在是测试。所有结果都是all.equal
.
##-------------------------------------------------
set.seed(1234)
y <- sort(rpois(100, 1))
res_170 <- forder(ppois, y, 170, 10, lambda = 1)
res_171 <- forder(ppois, y, 171, 10, lambda = 1)
resSL_170 <- forderSL(ppois, y, 170, 10, lambda = 1)
resSL_171 <- forderSL(ppois, y, 171, 10, lambda = 1)
resSL2_170 <- forderSL2(ppois, y, 170, 10, lambda = 1)
resSL2_171 <- forderSL2(ppois, y, 171, 10, lambda = 1)
all.equal(res_170, resSL_170) # TRUE
all.equal(res_170, resSL2_170) # TRUE
all.equal(res_171, resSL_171) # TRUE
all.equal(res_171, resSL2_171) # TRUE
正如我在评论中所说,您可以将 (factorial(n) / (factorial(i - 1) * factorial(n - i)))
替换为 i*choose(n, i)
。这两个数量相等,但 choose(n,i)
允许更高的值 n
。
或者您可以使用 pbeta
函数而不是进行数值积分:
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
i*choose(n, i) * (pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)) * beta(i, n-i+1)
}
更好的是,使用对数:
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
lg <- log(i) + lchoose(n, i) +
log(pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)) + lbeta(i, n-i+1)
exp(lg)
}
编辑
我没有注意到这种简化:i*choose(n, i) * beta(i, n-i+1) = 1
。所以你可以简单地做:
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)
}
我需要集成一个在表达式中有阶乘的函数。但是,如果您尝试评估阶乘,当 n > 170 时,R returns Inf.
我发现有很多包可以让您计算非常大的数字,但是,它们总是 returns 来自 class 的对象,我无法集成。积分的最终结果总是一个小数。
这是我的代码:
integrand <- function(n, i, x) {
(factorial(n) / (factorial(i - 1) * factorial(n - i))) *
x^(i - 1) * (1 - x)^(n - i)
}
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
integrate(integrand,
lower = lower, upper = upper, n = n, i = i,
stop.on.error = FALSE)$value
}
forder <- Vectorize(forder, "x")
##------------------------------------------------------------------------------
## Some example
y <- sort(rpois(100, 1))
## Works fine
forder(ppois, y, 170, 10, lambda = 1)
## Does not work
forder(ppois, y, 171, 10, lambda = 1)
##------------------------------------------------------------------------------
将 integrand
更改为使用对数,这两个调用都有效。我还 post 函数 @StéphaneLaurent 关于使用 choose/lchoose
和 pbeta/beta
函数的想法。
integrand <- function(n, i, x) {
y <- lfactorial(n) - lfactorial(i - 1) - lfactorial(n - i) +
(i - 1)*log(x) + log(1 - x)*(n - i)
exp(y)
}
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
integrate(integrand,
lower = lower, upper = upper, n = n, i = i,
stop.on.error = FALSE)$value
}
forder <- Vectorize(forder, "x")
integrandSL <- function(n, i, x) {
y <- log(i) + lchoose(n, i) + (i - 1)*log(x) + log(1 - x)*(n - i)
exp(y)
}
forderSL <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
integrate(integrandSL,
lower = lower, upper = upper, n = n, i = i,
stop.on.error = FALSE)$value
}
forderSL <- Vectorize(forderSL, "x")
forderSL2 <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
lg <- log(i) + lchoose(n, i) +
log(pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)) + lbeta(i, n-i+1)
exp(lg)
}
现在是测试。所有结果都是all.equal
.
##-------------------------------------------------
set.seed(1234)
y <- sort(rpois(100, 1))
res_170 <- forder(ppois, y, 170, 10, lambda = 1)
res_171 <- forder(ppois, y, 171, 10, lambda = 1)
resSL_170 <- forderSL(ppois, y, 170, 10, lambda = 1)
resSL_171 <- forderSL(ppois, y, 171, 10, lambda = 1)
resSL2_170 <- forderSL2(ppois, y, 170, 10, lambda = 1)
resSL2_171 <- forderSL2(ppois, y, 171, 10, lambda = 1)
all.equal(res_170, resSL_170) # TRUE
all.equal(res_170, resSL2_170) # TRUE
all.equal(res_171, resSL_171) # TRUE
all.equal(res_171, resSL2_171) # TRUE
正如我在评论中所说,您可以将 (factorial(n) / (factorial(i - 1) * factorial(n - i)))
替换为 i*choose(n, i)
。这两个数量相等,但 choose(n,i)
允许更高的值 n
。
或者您可以使用 pbeta
函数而不是进行数值积分:
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
i*choose(n, i) * (pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)) * beta(i, n-i+1)
}
更好的是,使用对数:
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
lg <- log(i) + lchoose(n, i) +
log(pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)) + lbeta(i, n-i+1)
exp(lg)
}
编辑
我没有注意到这种简化:i*choose(n, i) * beta(i, n-i+1) = 1
。所以你可以简单地做:
forder <- function(Fx, x, n, i, ...) {
lower <- sapply(x - 1, Fx, ...)
upper <- sapply(x, Fx, ...)
pbeta(upper, i, n-i+1) - pbeta(lower, i, n-i+1)
}