R 模拟来自（非标准）密度函数的数据

我想模拟来自非标准密度函数的数据。我已经找到了以下链接。然而，这会产生奇怪的结果。不知何故，这种累积密度函数cdf不起作用。从某些值来看，它给出了非常奇怪的结果。例如，请查看以下代码：

density=function(x)(25*200.7341^25/x^26*exp(-(200.7341/x)^25))
cdf<-function(x) integrate(density,1,x)[[1]]

cdf(9701)
[1] 1

cdf(9702)
[1] 6.33897e-05

---

所以我的问题是，如何创建一个好的CDF函数？或者更直接地说，如何模拟PDF中的数据？

如果积分间隔非常大， 密度的峰值很难找到：积分很容易忽略它， 并且认为你积分的函数几乎处处为零

如果你知道峰值在哪里，你可以把积分分成三部分： 高峰前后

# Density
A <- 200.7341
f <- function(x) 25*A^25 / x^26 * exp( -(A/x)^25 )
a <- 150
b <- 400

# Numeric integration
F1 <- function(x) {
  if( x < a )      integrate(f, 1, x)[[1]] 
  else if( x < b ) integrate(f, 1, a)[[1]] + integrate(f, a, x)[[1]] 
  else             integrate(f, 1, a)[[1]] + integrate(f, a, b)[[1]] + integrate(f, b, x)[[1]] 
}

# Compare with the actual values
F2 <- function(x) exp( -(A/x)^25 )
F1(200); F2(200)
F1(1e4); F2(1e4)
F1(1e5); F2(1e5) # Imprecise if b is too low...

检查间隔是否足够大后，可以删除前后间隔：它们的贡献为零

F1 <- function(x) {
  if( x < a )      0
  else if( x < b ) integrate(f, a, x)[[1]] 
  else             1
}

---

当我玩你的CDF时，很快发现大部分的动作都是在180到350之间的x，我通过绘制该范围内的密度来证实这一点

我很确定，x=9702时的结果反映了计算的数值不稳定性，当涉及25次方和26次方时。如果你不信任你的CDF或者它不是可逆的，另一个基于pdf的选项是。您应该能够使用一个最小值为180、最大值约为300、模式约为200的简单三角形作为边界函数gx，并按照Wikipedia上描述的算法获得相当好的结果

---

一般来说，如果反转不适用于任意分布，那么您的其他选择是1基于pdf的接受/拒绝相对于边界函数，2组合您可以将分布解构为更容易生成的组件，并使用条件概率选择适当的组件，或3个特殊技巧-是否存在卷积或参数化给出分布等价性的情况，例如，N0,1^2=卡方1，卡方k=k独立卡方1之和，exp2=卡方2，等等。。。。请参阅非均匀随机变量生成，以全面处理您的选项。

正如@pjs所指出的，我们可以使用wiki查看详细信息

下面是此方法的一个实现

最重要的一步是找到一个分布g，我们可以从中取样，并从中存在M，使得所有点的M*g>f

f <- function(x) (25 * 200.7341^25 / x^26 * exp(-(200.7341/x)^25))
g <- function(x) dnorm(x, mean = 200.7341, sd = 40)
M <- 5
curve(f, 0, 500)
curve(M * g(x), 0, 500, add = TRUE, lty = "dashed")

现在，我们可以执行算法了

set.seed(42)
k <- 1
count <- 0
res <- vector(mode = "numeric", length = 1000)
while(k < 1001) {
          z <- rnorm(n = 1, mean = 200.7341, sd = 40)
          R <- f(z) / (M * g(z))
          if (R > runif(1)) {
              res[k] <- z
              k  <- k + 1
          }
          count <- count + 1
    }

(accept_rate <- (k / count) * 100)
## [1] 19.7086

require(MASS) ## for truehist
truehist(res)
curve(f, 0, 250, add = TRUE)

---

接受率不高。您可以尝试找到更好的信封函数或使用Metropolis Hasting算法。

谢谢！这工作做得很好！虽然确实有点慢，但这对于我想要做的事情来说是非常好的。我需要正确的括号来让它工作：R感谢你的评论@Rottmann，我修复了错误并添加了一个种子以保证再现性。再次感谢