Question

用户定义函数（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)

我对用户定义的功能相当新，所以如果那就是问题所在，那么任何建议都会受到重视。另外，如果有一种方法可以使函数或代码更有效（我不熟悉的软件包），那也是最受欢迎的。

Answer 1

问题是apply会将FROM转换为矩阵。比较：

> dist.func(FROM[1,])
$p05
[1] 14939.76
$MIN
[1] 14422.21
$AVG
[1] 19795.44
$N
[1] 6

> dist.func(as.matrix(FROM)[1,])
$p05
[1] 1400
$MIN
[1] 1e-10
$AVG
[1] 179500
$N
[1] 8

> apply(FROM, 1, dist.func)[[1]]
$p05
[1] 1400
$MIN
[1] 1e-10
$AVG
[1] 179500
$N
[1] 8

Answer 2

lapply提供正确的输出

  my.list<-as.list(1:nrow(FROM))

k- lapply(my.list,function(i)dist.func(FROM[i,])
kk<-do.call(rbind,k) # convert to data.frame

sapply(my.list,function(i)dist.func(FROM[i,]))
    [,1]     [,2]     [,3] [,4] [,5]
p05 14939.76 16242.64 NA   NA   NA  
MIN 14422.21 16000    NA   NA   NA  
AVG 19795.44 21179.25 NA   NA   NA  
N   6        6        0    0    0

R用户定义的函数单独工作，但与apply一起使用时返回不正确的值

2 个答案: