我有一组来自真实数据的xy对,我想用双变量正态分布建模,由两个正态分布X和Y组成。我想计算参数,这样我就可以重新创建分布而不必使用原始源数据,因为它太昂贵(一百万行)。
目前,我正在使用以下方式成功绘制此数据:
hexbinplot(x~y, data=xyPairs, xbins=16)
我想我需要估算以下参数:
然后用:
指定双变量法线是否有一个包在R?
中执行此操作我查看了很多软件包,但大多数软件包都可以帮助您模拟随机数据的双变量,而不是帮助您创建一个模拟实际数据的双变量正态分布。
如果您想了解更多详情,请与我们联系。
答案 0 :(得分:8)
好的,让我们从一些事实开始:
mu
和sigma^2
的最大似然估计值与样本类似物相对应。有关如何在单变量情况下获得分析解决方案的示例,请参阅here。这使我们得出结论,您可以通过以下方式估算这些参数。首先,让我生成一些示例数据:
n <- 10000
set.seed(123) #for reproducible results
dat <- MASS::mvrnorm(n=n,
mu=c(5, 10),
Sigma= matrix(c(1,0.5,0.5,2), byrow=T, ncol=2)
)
在这里,我选择mu1
和mu2
分别为5和10。此外,sigma1^2
等于1,rho*sigma1*sigma2
等于0.5,sigma2^2
等于2.请注意,自rho * sigma1 * sigma2 = 0.5
起,我们就有rho = 0.5/sqrt(1*2) = 0.35
使用已知(分析)最大似然估计
现在,让我们首先从数据中估算参数mu1
和mu2
。在这里,我使用每个变量的样本均值,因为事实1确保我不需要担心依赖性。也就是说,我可以忽略它们是双变量正常的,因为边际分布具有相同的参数,并且我碰巧知道在单变量情况下这些参数的MLE是样本均值。
> colMeans(dat)
[1] 5.006143 9.993642
我们发现这非常接近我们在生成数据时先前指定的真实值。
现在,让我们估算x1
和x2
:
> apply(dat, 2, var)
[1] 0.9956085 2.0008649
此外,这非常接近真实的价值观。到目前为止,这种方法似乎运作良好。 :)
现在,剩下的就是rho
:请注意,方差协方差矩阵的非对角线上的条目是rho*sigma1*sigma2 = rho * 1 * sqrt(2)
,我将其定义为0.5。因此,rho = 0.35
。
现在,让我们看看样本相关性。样本相关性已经标准化了协方差,因此我们不需要手动除以sqrt(2)
来获得相关系数。
> cor(dat)
[,1] [,2]
[1,] 1.0000000 0.3481344
[2,] 0.3481344 1.0000000
再次非常接近先前指定的true参数。请注意,人们可能会争辩说后者在小样本中存在偏差,我们可以进行修正。有关讨论,请参阅Wikipedia文章。如果你想这样做,你只需将最后一个词与n/(n-1)
相乘。对于样本大小,例如n=10000
,它通常不会产生很大的差异。
现在,我在这做了什么?我知道这些量的分析最大似然估计是怎样的,我刚用它们来估计这些参数。如果您不知道解决方案的分析方式,您会怎么做?原则上,您知道似然函数。你有数据。您可以将似然函数写为参数的函数,然后使用许多可用优化器中的一个来查找最大化样本可能性的参数值。这将是直接的ML方法。请参阅here。
所以,让我们试一试。
以数字方式最大化可能性
上述程序使用了我们能够分析地获得最大似然估计的事实。也就是说,我们通过取似然函数的导数,将其设置为零,并求解未知量,找到了这些量的闭式解。但是,我们也可以使用计算机以数字方式查找值,如果您无法找到易处理的分析解决方案,这可能会派上用场。我们来试试吧。
首先,由于我们要最大化函数,所以让我们使用内置函数optim
。 optim
要求我提供一个带有初始起始值的参数向量,以及一个以参数向量作为参数的函数。该函数应该返回一个最大化或最小化的值。
此功能将是样本可能性。给定大小为n
的iid样本,样本似然性是所有n
个体似然(即概率密度函数)的乘积。大型产品的数值优化是可能的,但人们通常采用对数将产品转化为总和。为了获得可能性,只需盯着双变量正态分布的单独pdf,你会发现样本可能性可以写为
-n*(log(sig1) + log(sig2) + 0.5*log(1-rho^2)) -
0.5/(1-rho^2)*( sum((x1-mu1)^2)/sig1^2 +
sum((x2-mu2)^2)/sig2^2 -
2*rho*sum((x1-mu1)*(x2-mu2))/(sig1*sig2) )
该函数最大化其参数。由于optim
要求我提供一个参数向量,我使用包装器并将最大化问题设置如下:
wrap <- function(parms, dat){
mymu1 = parms[1]
mymu2 = parms[2]
mysig1 = parms[3]
mysig2 = parms[4]
myrho = parms[5]
myx1 <- dat[,1]
myx2 <- dat[,2]
n = length(myx1)
f <- function(x1=myx1, x2=myx2, mu1=mymu1, mu2=mymu2, sig1=mysig1, sig2=mysig2, rho=myrho){
-n*(log(sig1) + log(sig2) + 0.5*log(1-rho^2)) - 0.5/(1-rho^2)*(
sum((x1-mu1)^2)/sig1^2 + sum((x2-mu2)^2)/sig2^2 - 2*rho*sum((x1-mu1)*(x2-mu2))/(sig1*sig2)
)
}
f(x1=myx1, x2=myx2, mu1=mymu1, mu2=mymu2, sig1=mysig1, sig2=mysig2, rho=myrho)
}
我对optim
的电话如下:
eps <- eps <- .Machine$double.eps # get a small value for bounding the paramter space to avoid things such as log(0).
numML <- optim(rep(0.5,5), wrap, dat=dat,
method="L-BFGS-B",
lower = c(-Inf, -Inf, eps, eps, -1+eps),
upper = c(Inf, Inf, 100, 100, 1-eps),
control = list(fnscale=-1))
此处,rep(0.5,5)
提供了起始值,wrap
高于函数,lower
和upper
是参数的边界,fnscale
参数确保我们正在最大化功能。结果,我得到:
numML$par
[1] 5.0061398 9.9936433 0.9977539 1.4144453 0.3481296
请注意,这些元素对应mu1
,mu2
,sig1
,sig2
和rho
。如果您对sig1
和sig2
进行平方,则会看到我们重新创建了最初提供的差异。所以,它似乎工作。 :)