조건부 거리가있는 평균 xy 점

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) 여기

가 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

의 나는 3-4 장소 3-6 장소에서 교체 할 필요가 2 포인트를 획득. 이것은 내가 문제를 정확하게 이해하고 있다면, 이것은 당신을 위해 그것을해야한다고 생각 3, 4, 6은 전분기에서 사라 할 것이다이 두 지점이

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 유사한 구조의 매트릭스. 그들은 지금 아무 의미도 없기 때문에

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

Answer 2

나는이 문제를 전략을 병합하고 해결 할 수 있었다, 그래서 좋아하지만 멋진 방법으로 UPDATE는

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