Пользовательская функция (dist.func) запускается и обеспечивает правильный вывод, когда я использую ее в одной строке данных, но не обеспечивает правильный вывод (все еще выполняется), когда я встраиваю ее в команду apply(). В этом случае я хочу вычислить по строкам.
Приносим извинения за включенные сложные образцы данных, но значения должны находиться в пределах порогового значения, чтобы возвращать значимые выходные данные, и это самый простой способ гарантировать, что это произойдет.
library(fields)
Функция по существу измеряет координаты XY (евклидово расстояние с помощью команды rdist()), но сначала она берет подмножество данных, сохраняя только те строки данных «TO», которые попадают в заданное сходство (евклидово расстояние между первым и вторые главные компоненты, PC1 и PC2).
Это делает выборочные данные:
# This data is the reference points to measure FROM
FROM <- data.frame(X=c(-4187500,-4183500,-4155500,-4179500,-2883500),
Y=c(10092500,10084500,10020500,10012500,9232500),
PC1=c(-0.525,-0.506,-1.146,-0.733,-1.160),
PC2=c(3.606,3.609,4.114,3.681,0.882))
# This data is the destination points to measure TO
TO <- data.frame(X=c(-4207500,-4183500,-4203500,-4187500,-2827500,-4203500,-4199500,-4183500,-4195500,-4191500),
Y=c(10100500,10100500,10096500,10092500,10092500,10088500,10084500,10084500,10072500,10064500),
PC1=c(-0.371,0.447,-0.344,-0.026,-0.652,-0.460,-0.313,0.010,-0.293,-0.319 ),
PC2=c(3.149,4.619,3.318,3.885,0.407,3.164,3.300,3.892,3.226,3.337))
# This is the threshold of the data similarity match (distance between PC1 and PC2 in both data sets)
threshold <- 0.5
Вот моя определяемая пользователем функция (с объяснением каждой строки):
dist.func <- function(REF){
# Calculate the similarity (PC1 and PC2 distance) to all points in the destination
# Select only those under the threshold
bt <- as.matrix(TO[(rdist(REF[3:4],TO[3:4])[1,]<threshold)==T,c("X","Y")])
# Calculate the number of points under the threshold (the "sample size")
# If there are no points uder the threshold, the SS is set to zero (otherwise 'NA' kills the loop)
ss <- ifelse(nrow(bt)>=50, 50 ,nrow(bt))
# If/else to deal with SS=0
if (nrow(bt)>0) {
# Calculate the euclidian distance between the reference point and all points under the threshold
# This calculates the distances, sorts them in ascending order, and trims to the sample size
dst <- rdist(REF[1:2],bt)[1,][order(rdist(REF[1:2],bt)[1,])][1:ss]
} else {
dst <- c(NA)
}
# Report (in a list or table or whatever) the summary stats for the distances
list(
p05=ifelse(nrow(bt)==0, NA, quantile(dst,0.05)),
MIN=ifelse(nrow(bt)==0, NA, min(dst)),
AVG=ifelse(nrow(bt)==0, NA, mean(dst)),
N=ifelse(nrow(bt)==0, 0, nrow(bt)))
}
А вот тест с одной строкой данных FROM (работает) и встроен в команду apply() (не возвращает правильные значения):
# Using the function on a single line of data returns correct values for the given line
dist.func(FROM[1,])
# Embedding the function into apply() returns incorrect outputs
# I'm committed to using apply() here (or some variant) to avoid a for() loop by rows
apply(FROM, 1, dist.func)
Я новичок в пользовательских функциях, поэтому любые предложения будут оценены, если проблема в этом. Кроме того, если есть способ сделать функцию или код в целом более эффективным (пакет, с которым я не знаком), это также было бы очень кстати.
