具有条件距离的平均 xy 点答案

【问题标题】：Average xy points with conditional distance具有条件距离的平均 xy 点
【发布时间】：2016-07-27 14:09:53
【问题描述】：

我有点的 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）

这是我的 data.frame 的 dput

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

【问题讨论】：

标签： r coordinates distance euclidean-distance distance-matrix

【解决方案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)

【讨论】：

它没有做我需要的。你的应用调用的昏暗是 2,16，我的预期输出应该是 4,2
检查我的编辑，在 dist 矩阵的结果中有一个转换问题。如果您希望收到 3-6 和 6-3（相同的结果）作为两个不同的数字，那么您应该删除 & upper.tri(...)
我认为我们越来越近了，但还不是很接近，请查看我的更新

【解决方案2】：

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

# 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) 
}

【讨论】：