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

Question

我有两个向量x和w。向量CCD_ 3是具有与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）（请参阅?diff），然后只返回这些值的加权值：

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"

（我会让你修改它，这样你就可以随心所欲地存储输出了。）