我有点的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对对为1点,3-6对为另一对(丢弃以前的3,4和6点)。
这是我的dput of 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中消失,这两个点应该附加在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发布于 2016-07-27 14:18:39
如果我正确理解问题的话,我认为这应该是为你做的。
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结构的矩阵,包含由阈值决定的“远”点的平均值。
更新
qq <- qq[-unique(c(pairs)),]
qq <- rbind(qq,result)发布于 2016-07-27 15:16:06
好的,所以我能够合并策略并解决这个问题,但不是以一种奇特的方式。
# 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.75row.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)
}https://stackoverflow.com/questions/38615382
复制相似问题