Как я могу получить медиану всех измерений на определенном расстоянии?

Question

Возможно, есть лучший способ, но поскольку я новичок в R и у меня уже установлен код IDW, я пытаюсь получить медиану всех точек в пределах 2000 метров, изменив код IDW, установив весовую мощность (idp) вблизи нуля, поэтому более близкие точки взвешены так же, как и дальние.

Я предполагаю, что он говорит NA, когда я запускаю код ниже с maxdist = 2000, потому что у некоторых точек нет соседей в пределах 2000 метров. Самый маленький maxdist, с которым я могу работать, составляет ~ 40 000, даже если я установил nmin на ноль.

Есть ли способ сказать, чтобы игнорировать точки без соседей в пределах 2000 метров, или кто-то знает лучший способ сделать это?

Вот мой код:

library(gstat) 
clean3145 = read.csv("clean3145.csv") 

#Set up the k-fold validation 
set.seed(88) 
groups <- sample(1:5, nrow(clean3145), replace=TRUE) 

#res=result=R=Pearson's correlation between predicted and actual arsenic concentration 
MEDres<- rep(NA, 5) 

r <- list() 
for (k in 1:5) { 
    print(k) 
    flush.console() 
    train <- clean3145[groups!=k, ] 
    test <- clean3145[groups==k, ] 

    med <- gstat(formula = As1~1, locations = ~UTMNM+UTMEM, data=train, nmin=0, maxdist=40000, set=list(idp = .01)) 
    medpred <- predict(med, test)$var1.pred 
    MEDres[k] <- cor(test$As1, medpred) 

    } 

#Show the mean correlation for the 5 different training-test dataset pairs in K-fold validation 
mean(MEDres) 

Спасибо за вашу помощь!

Answer 1

Я не могу видеть, как ваш код помогает ответить на ваш первоначальный вопрос, но для местных медиан я хотел бы попробовать

library(sp) 
demo(meuse, ask = FALSE) 
library(gstat) 
x = krige(zinc~1, meuse, meuse.grid, maxdist = 1000, set = list(method = "med")) 

Если окрестность не содержит никаких данных, вы можете определить его по числу ближайших точек , nmax, и в этом случае, конечно, расстояние больше не контролируется.

Answer 2

Thanks Edzer!

Я сохраню это для справок в будущем. Мы получили его на работу таким образом, с критериями глубины тоже (я пытаюсь оценить мышьяк в подземных водах):

#Load required packages and data 
library(raster) 
depth = read.csv("depth.csv") 

Настройка проверки к-складка, убедившись, что та же случайная выборка выбирается каждый раз, когда для сопоставимость

set.seed(88) 
groups <- sample(1:5, nrow(depth), replace=TRUE) 

Вычислить средний мышьяк концентрация всех обучения (TRN) скважин в пределах определенного расстояния точки (PD) тест (TST) скважин, использующих UTM востоке и в Северной координаты в метрах (UTMEM, UTMNM). Игнорировать или «удалить» пробные скважины, которые не имеют соседей в пределах 148 метров (PD> 148 = NA, na.rm = TRUE)

computeMed <- function(trn, tst) { 
    pd <- pointDistance(trn[ , c('UTMEM', 'UTMNM')], tst[ , c('UTMEM','UTMNM')], lonlat=FALSE) 
    pd[pd > 148] <- NA 

    as <- trn$As1 
    as <- matrix(rep(as, ncol(pd)), ncol=ncol(pd)) 
    aspd <- as * (pd >= 0) 
    apply(aspd, 2, median, na.rm=TRUE) 

    } 

Compute медианы, на этот раз с критериями глубины (например, если тест хорошо рядом Fallon (Tcan2car = 1 = скважины от Траки канала до Carson бассейна и downgradient) и глубиной более 40 м, только дают медиана соседей, которые также> 40 м в глубину)

r <- rd <- list() 
Fallon <- FALSE 
for (k in 1:5) { 
    print(k) 
    flush.console() 
    depth$deep <- TRUE 
    depth$deep[depth$Depth_m < 40] <- FALSE 
    if (Fallon) { 
    d <- depth[depth$Tcan2car==1] 
    } else { 
    d <- depth 
    } 
    train <- d[groups!=k, ] 
    test <- d[groups==k, ] 

    p <- computeMed(train,test) 
    r[[k]] <- cbind(k=k, prd=p, obs=test$As1) 


    pdeep <- computeMed(train[train$deep,],test[test$deep,]) 
    pshallow <- computeMed(train[!train$deep,],test[!test$deep,]) 


    rd[[k]] <- cbind(k=k, prd=c(pdeep, pshallow), obs=test$As1[c(which(test$deep), which(!test$deep))]) 

} 

Показать среднее R Пирсона корреляция для 5 различных пар данных набора тестовых тестов в проверке K-fold. cr и r относятся к корреляциям, основанным только на расстоянии. crd и rd также включают критерии глубины

cr <- sapply(r, function(x) {x <- na.omit(x); cor(x[,2:3])[2]}) 
cr 
mean(cr) 

crd <- sapply(rd, function(x) {x <- na.omit(x); cor(x[,2:3])[2]}) 
crd 
mean(crd)