R中向量中对元素的加权平均值

Question

我有两个向量 x 和 w。向量w 是与 x 长度相同的权重数值向量。 我们如何获得向量x 中第一对元素的加权平均值，它们的差异很小（例如 tol= 1e-2），然后在下一次迭代中对下一对元素做同样的事情，直到没有对它们的差异小于 tol？例如，这些向量如下：

     x = c(0.0001560653, 0.0001591889, 0.0001599698, 0.0001607507, 0.0001623125,
           0.0001685597, 0.0002793819, 0.0006336307, 0.0092017241, 0.0092079042,
           0.0266525118, 0.0266889564, 0.0454923285, 0.0455676525, 0.0457005450)
     w = c(2.886814e+03, 1.565955e+04, 9.255762e-02, 7.353589e+02, 1.568933e+03,
           5.108046e+05, 6.942338e+05, 4.912165e+04, 9.257674e+00, 3.609918e+02,
           8.090436e-01, 1.072975e+00, 1.359145e+00, 9.828314e+00, 9.455688e+01)

我想找出x 的哪些对元素的差异最小，找到这对元素后，得到加权平均平均值。我尝试了这段代码，但这个代码没有给我结果。如何找到min(diff(x)) 的索引并检查它是否小于 tol？

        > min(diff(x))
        > which(min(diff(x)) < 1e-2)

Answer 1

如果您使用您提供的示例数据描述了手动计算结果的样子，那将非常有帮助。我不能说我完全确定我知道你想要什么，但这是在昏暗的灯光下的一个刺：

tol = 1e-2
sapply(which(diff(x) < tol), 
       function(i) x[i:(i+1)] %*% w[i:(i+1)] / sum(w[i:(i+1)]))

Answer 2

我对你想要什么也有点困惑，但是下面的代码会发现 x 的值仅比之前的值增加了最小量或更少 (1e-2)（参见 @ 987654322@)，然后仅返回这些值的加权值：

smallpair <- which(c(NA,diff(x)) < 1e-2)
x[smallpair]*w[smallpair]

Answer 3

首先，您可以对数据进行聚类并根据聚类之间的最大距离对其进行切割：

hc <- hclust(dist(x))
ct <- cutree(hc, h = 1e-2)
ct
# [1] 1 1 1 1 1 1 1 1 1 1 2 2 3 3 3

然后，根据集群划分您的x 和w：

x.groups <- split(x, ct)
x.groups
# $`1`
#  [1] 0.0001560653 0.0001591889 0.0001599698 0.0001607507 0.0001623125
#  [6] 0.0001685597 0.0002793819 0.0006336307 0.0092017241 0.0092079042
# 
# $`2`
# [1] 0.02665251 0.02668896
# 
# $`3`
# [1] 0.04549233 0.04556765 0.04570055

w.groups <- split(w, ct)
w.groups
# $`1`
#  [1] 2.886814e+03 1.565955e+04 9.255762e-02 7.353589e+02 1.568933e+03
#  [6] 5.108046e+05 6.942338e+05 4.912165e+04 9.257674e+00 3.609918e+02
# 
# $`2`
# [1] 0.8090436 1.0729750
# 
# $`3`
# [1]  1.359145  9.828314 94.556880

最后，您可以使用mapply 计算各组的加权平均值：

mapply(function(x, w) sum(x * w) / sum(w), x.groups, w.groups)
#           1           2           3 
# 0.000249265 0.026673290 0.045685517

编辑：现在很明显，您希望集群最多包含两个元素。可能有满足该要求的聚类算法，但您可以通过循环轻松地自己完成。这是一个粗略的版本：

d <- as.matrix(dist(x))
d[upper.tri(d, diag = TRUE)] <- Inf
d[d > 1e-2] <- Inf

while(any(is.finite(d))) {
   min.d <- which.min(d)
   idx   <- c(col(d)[min.d], row(d)[min.d])
   wavg  <- sum(x[idx] * w[idx]) / sum(w[idx])
   print(paste("idx", idx[1], "and", idx[2], "with wavg=", wavg))
   d[idx, ] <- Inf
   d[, idx] <- Inf
}
# [1] "idx 2 and 3 with wavg= 0.000159188904615574"
# [1] "idx 4 and 5 with wavg= 0.000161814089390641"
# [1] "idx 9 and 10 with wavg= 0.0092077496735115"
# [1] "idx 1 and 6 with wavg= 0.000168489484676445"
# [1] "idx 11 and 12 with wavg= 0.026673289567385"
# [1] "idx 13 and 14 with wavg= 0.0455585015178172"
# [1] "idx 7 and 8 with wavg= 0.00030279100471097"

（我会留给您修改它，以便您可以根据需要存储输出。）