2

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

我对用户定义的函数相当陌生，所以如果这就是问题所在，任何建议都将不胜感激。此外，如果有一种方法可以使函数或代码更有效（我不熟悉的包），那也将是最受欢迎的。

4

2 回答 2

4

问题是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
于 2013-10-09T14:25:38.910 回答
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
于 2013-10-08T23:17:47.710 回答