1

我有点的 xy 坐标，我想利用距离来平均点。我的数据被命名，我使用函数qq获得距离矩阵dist

qq
       X      Y
2 4237.5 4411.5
3 4326.5 4444.5
4 4382.0 4418.0
5 4204.0 4487.5
6 4338.5 4515.0

mydist = as.matrix(dist(qq))

          2         3         4        5         6
2   0.00000  94.92102 144.64612  83.0557 144.61414
3  94.92102   0.00000  61.50203 129.8278  71.51398
4 144.64612  61.50203   0.00000 191.0870 106.30734
5  83.05570 129.82777 191.08702   0.0000 137.28256
6 144.61414  71.51398 106.30734 137.2826   0.00000

我想要做的是对更接近某个阈值的点进行平均，对于这个例子，我们可以使用 80。唯一低于该限制的成对距离是 3-4 和 3-6。问题是如何回到原始矩阵和平均 xy 坐标以使 3-4 对一个点和 3-6 对另一个点（丢弃以前的点 3,4 和 6）

这dput是我的data.frame

dput(qq)
structure(list(X = c(4237.5, 4326.5, 4382, 4204, 4338.5), Y = c(4411.5, 
4444.5, 4418, 4487.5, 4515)), .Names = c("X", "Y"), row.names = 2:6, class = "data.frame")

更新

使用一些提供的修改代码，我得到了需要在 3-4 位置和 3-6 位置替换的 2 点。这意味着我的第 3 点和第 4 点和第 6 点将不得不从 qq 中消失，这两个点应该附加到它上面

pairs <- which(as.matrix(dist(qq)) < 80 & upper.tri(as.matrix(dist(qq))), arr.ind = T)
t(apply(pairs,1,function(i) apply(qq[i,],2,mean)))
        X       Y
3 4354.25 4431.25
3 4332.50 4479.75
4

2 回答 2

1

如果我正确理解问题，我认为这应该为你做。

pairs <- which(as.matrix(y) > 140 & upper.tri(as.matrix(y)), arr.ind = T)
result <- apply(pairs,1,function(i) apply(qq[i,],2,mean))

#optionally, I think this is the form you will want it in.
result <- data.frame(t(result))

它将是一个与 qq 结构相似的矩阵，其中包含由 thresh 确定的彼此“远离”的点的平均值。

更新

qq <- qq[-unique(c(pairs)),]
qq <- rbind(qq,result)
于 2016-07-27T14:18:39.810 回答
0

好的，所以我能够合并策略并解决问题，但不是以一种奇特的方式

# Search pairs less than threshold
pairs <- which(as.matrix(dist(qq)) < 80 & upper.tri(as.matrix(dist(qq))), arr.ind = T)

# Get the row numbers for subsetting the original matrix 
indx=unique(c(pairs[,1],pairs[,2]))

# Get result dataframe
out = data.frame(rbind(qq[-indx,],t(apply(pairs,1,function(i) apply(qq[i,],2,mean)))),row.names=NULL)

dim(out)
[1] 4 2

out
        X       Y
1 4237.50 4411.50
2 4204.00 4487.50
3 4354.25 4431.25
4 4332.50 4479.75

row.names 被删除，因为它们现在没有任何意义，因为我已经删除了原始点并添加了新点。我仍然愿意接受更好的方法来做到这一点，并检查一切是否正确。

更新

我制作了一个功能，它可能比逐步制作更有用，让你玩阈值。

distance_fix = function(dataframe,threshold){


  mydist = as.matrix(dist(dataframe))

  # Which pairs in the upper triangle are below threshold 
  pairs <- which(mydist < threshold & upper.tri(mydist), arr.ind = T)

  # Get the row numbers for subsetting the original matrix 
  indx=unique(c(pairs))

  # Get result dataframe
  out = data.frame(rbind(dataframe[-indx,],t(apply(pairs,1,function(i) apply(dataframe[i,],2,mean)))),row.names=NULL)

 return(out) 
}
于 2016-07-27T15:16:06.970 回答