如何用R中的蒙特卡罗方法近似[x ^ 4 * sin(x)] / [exp(1)^(x / 5)](0到+ Inf)的积分?
我想做的是
set.seed(666)
func1 <- function(x)
{
(x^4 * sin(x))/exp(1)^(x/5)
}
n <- 1000000
x <- rexp(n, 0.2)
f <- func1(x)
E <- mean(f)
但是E的结果不正确
答案 0 :(得分:2)
如果要从指数中采样,则不应在函数中再次使用它。
来自代码
set.seed(32345)
func <- function(x) { (x^4 * sin(x)) }
n <- 10000000
x <- rexp(n, 0.2)
f <- func(x)
E <- mean(f)
我得到了答案
[1] 13.06643
更新
它波动很大,波动很大。
根据Mathematica的说法,最好不要先从正确的答案开始 4453125/371293 = 11.9936。
我从转换了积分
I =∫dx exp(-x / 5)x 4 sin(x)
使用替换y=x/5
I = 5 5 Γ(5)∫dy exp(-y)y 5-1 /Γ(5)sin(5 * y)
除了sin(5*y)
以外的所有内容都是标准化的伽玛分布,我们将使用它进行采样,而sin(5*y)
将成为我们计算平均值的函数。
并使用以下技巧和大量样本:我拆分了正值和负值的计算。如果您的答案波动不定且值相互抵消,则将很有帮助。我也进行了批量计算。 5的伽马函数仅为4! (部分)
代码
set.seed(32345)
N <- 10000000 # number of samples per batch
NN <- 640 # number of batches
pos <- rep(0, NN) # positive values
neg <- rep(0, NN) # negative values
for(k in 1:NN) { # loop over batches
y <- rgamma(N, shape=5, scale=1)
f <- sin(5.0 * y)
pnf <- ifelse(f > 0.0, f, 0.0)
pos[k] <- mean(pnf)
pnf <- ifelse(f < 0.0, -f, 0.0)
neg[k] <- mean(pnf)
print(k)
}
mean(pos)
sd(pos)/sqrt(NN)
mean(neg)
sd(neg)/sqrt(NN)
5*5*5*5*5*4*3*2*(mean(pos) - mean(neg))
输出
> mean(pos)
[1] 0.3183912
> sd(pos)/sqrt(NN)
[1] 4.749269e-06
>
> mean(neg)
[1] 0.3182223
> sd(neg)/sqrt(NN)
[1] 5.087734e-06
>
> 5*5*5*5*5*4*3*2*(mean(pos) - mean(neg))
[1] 12.67078
您会看到我们确实计算了两个非常接近的值的差,这就是为什么很难获得收敛的原因。在我的Xeon工作站上进行计算花费了超过20分钟的时间。
并且使用不同的seed = 12345
> mean(pos)
[1] 0.3183917
> sd(pos)/sqrt(NN)
[1] 4.835424e-06
>
> mean(neg)
[1] 0.3182268
> sd(neg)/sqrt(NN)
[1] 4.633129e-06
>
> 5*5*5*5*5*4*3*2*(mean(pos) - mean(neg))
[1] 12.36735
答案 1 :(得分:1)
在下文中,我故意不设置随机种子。
正如我在评论中提到的,关于堆栈溢出的蒙特卡洛集成至少有两个介绍性问答:
众所周知,蒙特卡洛积分的收敛速度为O(1 / sqrt(N))
,其中N
是样本量,O()
是大O符号。但是, big O 背后的常数对于某些功能可能非常大,因此实际收敛速度可能会慢得多。
您的函数至少可以通过两种方式定义:
## direct definition
f <- function (x) x^4 * sin(x) * exp(-x/5)
## using gamma distribution; see ?rgamma
g <- function (x) sin(x) * 5 ^ 5 * gamma(5) * dgamma(x, 5, 1/5)
curve(f, from = 0, to = 100)
curve(g, add = TRUE, col = 2)
第一问与答解释了如何使用均匀分布的样本计算蒙特卡洛积分。您的函数f
或g
在x = 200
之外几乎为零,因此[0, +Inf)
上的集成实际上是[0, 200]
上的。以下函数将为您返回积分及其标准错误:
MCI1 <- function (n) {
x <- runif(n, 0, 200)
y <- 200 * f(x)
c(mean.default(y), sqrt(var(y) / n))
}
另一种方法是通过重要性抽样,如第二个问与答中所述。这里,伽马分布用作提案分布(如本·博克建议)。
MCI2 <- function (n) {
x <- rgamma(n, 5, 0.2)
y <- sin(x) * 75000
c(mean.default(y), sqrt(var(y) / n))
}
现在让我们检查收敛速度。
n <- seq(1000, by = 5000, length = 100)
tail(n)
#[1] 471000 476000 481000 486000 491000 496000
b1 <- sapply(n, MCI1)
b2 <- sapply(n, MCI2)
对于统一抽样,我们有
par(mfrow = c(1, 2))
plot(b1[1, ], main = "estimate")
plot(b1[2, ], main = "standard error")
b1[, (ncol(b1) - 5):ncol(b1)]
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 115.1243 239.9631 55.57149 -325.8631 -140.3745 78.61126
#[2,] 181.0025 179.9988 178.99367 178.2152 177.2193 175.31446
对于伽马采样,我们有
par(mfrow = c(1, 2))
plot(b2[1, ], main = "estimate")
plot(b2[2, ], main = "standard error")
b2[, (ncol(b2) - 5):ncol(b2)]
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] -100.70344 -150.71536 24.40841 -49.58032 169.85385 122.81731
#[2,] 77.22445 76.85013 76.53198 76.03692 75.69819 75.25755
无论采用哪种方法,请注意标准误差有多大(与估算本身相比)以及减小的速度有多慢。
使用数字积分要容易得多(对于单变量函数的积分不足为奇):
integrate(f, 0, 200)
#11.99356 with absolute error < 0.0012
## trapezoidal rule
200 * mean.default(f(seq(0, 200, length = 10000)))
#[1] 11.99236
在梯形法则中,即使仅获取1e + 4个均匀间隔的采样点,积分也足够接近真实情况。
备注
如果我们在一个更严格的领域内进行集成,那么蒙特卡罗集成的工作量将减少。从f
或g
的图中,我们看到这是一个振荡函数。实际上,它与x轴相交的周期为pi
。让我们考虑一下[lower, upper]
上的集成。
MCI3 <- function (n, lower, upper) {
x <- runif(n, lower, upper)
y <- (upper - lower) * f(x)
c(mean.default(y), sqrt(var(y) / n))
}
a1 <- sapply(n, MCI3, lower = 0, upper = pi)
a2 <- sapply(n, MCI3, lower = pi, upper = 2 * pi)
a3 <- sapply(n, MCI3, lower = 2 * pi, upper = 3 * pi)
a4 <- sapply(n, MCI3, lower = 3 * pi, upper = 4 * pi)
a1[, (ncol(a1) - 5):ncol(a1)]
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 17.04658711 16.97935808 17.01094302 17.02117843 16.96935285 16.99552898
#[2,] 0.02407643 0.02390894 0.02379678 0.02368683 0.02354298 0.02342799
a2[, (ncol(a2) - 5):ncol(a2)]
# [,1] [,2] [,3] [,4] [,5]
#[1,] -406.5646843 -404.9633321 -405.4300941 -405.4799659 -405.8337416
#[2,] 0.3476975 0.3463621 0.3442497 0.3425202 0.3409073
# [,6]
#[1,] -405.8628741
#[2,] 0.3390045
a3[, (ncol(a3) - 5):ncol(a3)]
# [,1] [,2] [,3] [,4] [,5] [,6]
#[1,] 1591.539911 1592.280780 1594.307951 1591.375340 1593.171500 1591.648529
#[2,] 1.197469 1.190251 1.183095 1.177079 1.172049 1.165667
a4[, (ncol(a4) - 5):ncol(a4)]
# [,1] [,2] [,3] [,4] [,5]
#[1,] -3235.561677 -3239.147235 -3241.532097 -3238.421556 -3238.667702
#[2,] 2.336684 2.321283 2.311647 2.300856 2.286624
# [,6]
#[1,] -3237.043068
#[2,] 2.279032