Question

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

Answer 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类似结构的矩阵，其中包含的点的平均值为＆＃34; far＆＃34;彼此远离彼此决定。

<强>更新

qq <- qq[-unique(c(pairs)),]
qq <- rbind(qq,result)

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

具有条件距离的平均xy点

2 个答案: