R 双重求和代码的奇怪输出

我试图编写一个代码来计算以下两个方程：

到目前为止，我有以下代码：

set.seed(123)
a = rnorm(100, 0, 0.02)
b = rnorm(100, 0, 0.03)
c = rnorm(100, 0, 0.04)
dt = cbind(a, b, c)
wg = runif(ncol(dt))
wg = wg/sum(wg)
wg = round(wg, digits = 3)

options(scipen = 999)
cv = cov(dt)
VARs = diag(cv)
cr = cor(dt)
length(wg)

sum_1 = 0
for (i in 1 : length(wg) ) {
  for (j in min(i+1, length(wg)) ) {
    sum_1 = sum_1 + 2 * wg[i] * wg[j] * cr[i, j]
  }}
rho_1 = sum_1/(1 - sum(wg^2))

sum_2 = 0
for (i in 1 : length(wg) ) {
  for (j in min(i+1, length(wg)) ) {
    sum_2 = sum_2 + 2 * wg[i] * wg[j] * sqrt(VARs[i]) * sqrt(VARs[j])
  }}

PV = t(wg) %*% cv %*% wg
ss = sum(wg^2 * VARs)
rho_2 = (PV - ss)/sum_2

rhos = c(rho_1, rho_2)
rhos

[1]  1.388473356 -0.004104948

我原以为这两个人会靠得很近。我想我的代码可能有错误。如果有人能验证代码，我将不胜感激

谢谢

多亏了李哲源 在李哲远的代码中，我模拟了这两个相关度量的100次观测，它们看起来确实很接近：

---

麻烦的求和的矢量化能力

第一个方程式：

# double summation in numerator (including multiplier 2)
diag(cr) <- 0
double_sum.1 <- c(crossprod(wg, cr %*% wg))

# single summation in denominator
single_sum.1 <- c(crossprod(wg))

# result
double_sum.1 / (1 - single_sum.1)

dcv <- sqrt(diag(cv))

# single summation in numerator
single_sum.2 <- c(crossprod(wg * dcv))

# double summation in denominator (including multiplier 2)
double_sum.2 <- sum(tcrossprod(wg * dcv)) - single_sum.2

# result
PV <- c(crossprod(wg, cv %*% wg))
(PV - single_sum.2) / double_sum.2

---

评论 在我看来，这两个方程的结果并不接近

为了了解这一点，我们现在在您的示例中使用真协方差矩阵和真相关矩阵。由于您生成了3组独立的正态样本，因此它们将具有对角协方差矩阵和恒等式相关矩阵：

dcv <- c(0.02, 0.03, 0.04)
cr <- diag(3)

---

这怎么可能是零呢？

我的意思是这两个应该很接近。但目前情况并非如此。现在必须测试，如果他们真的像作者所说的那样接近。哟，他们足够接近了。编辑了这篇文章。似乎没有什么错，这只是两种不同的方法。我想就这样了：）我的老板现在会高兴的：））

dcv <- c(0.02, 0.03, 0.04)
cr <- diag(3)

sum_i (1 - w_i) ^ 2 * sigma_i^2