2016-07-27 107 views
1

我有點的xy座標,我想利用平均點的距離。我的數據被命名爲qq,我獲得使用dist作用距離矩陣帶條件距離的平均xy點數

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") 

UPDATE

使用一些提供修改代碼的,我得到了2分,我需要在3-4的地方,3-6地方更換。這意味着我的觀點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 

回答

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的矩陣。

UPDATE

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

這不是我所需要的。暗淡的申請電話是2,16,我的預期輸出應該是4,2 –

+0

檢查我的編輯,在dist矩陣的結果中存在投射問題。如果您希望獲得3-6和6-3(相同的結果)作爲兩個不同的數字,那麼您應該刪除'&upper.tri(...)' – Adam

+0

我認爲我們正在接近但並不完全在那裏,檢查我的更新 –

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掉下來,因爲他們現在意味着什麼我已經刪除了原始點並添加了新的點。我仍然樂於採取更好的方式來做到這一點,並檢查一切是否正確。

UPDATE

我做這可能是更有益的是使事情變得逐步的,讓你與閾發揮的功能。

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