R中的嵌套函数-问题-

Question

我正在使用我正在使用的功能编辑我的问题。我有两个函数：第一个进行计算（2 个数据集之间的差异，但仅针对第一个数据集中的一个条目），第二个对整个数据集 1 进行计算。我想创建一个可以给我的新函数选择是否对一个条目或整个数据框进行计算。

# Sample Data
data_R <- data.frame(
  IDr= c(seq(1,5)),
  BTR= c("A","B","AB","O","O"),
  A= c(0,1,rep(0,3)),
  B= c(0,rep(0,3),1),
  C= c(0,rep(1,3),0),
  D= c(0,rep(1,4)),
  E= c(1,1,0,rep(1,1),0),stringsAsFactors=FALSE)
data_R

data_D <- data.frame(
  IDd = c(seq(1,8)),
  BTD = c("A","B","AB","O","AB","AB","O","O"),
  A=c(rep(0,5),1,1,1),
  B=c(rep(0,6),1,1),
  C=c(rep(1,7),0),
  D=rep(1,8),
  E=c(rep(0,5),rep(1,2),0),
  fg=c(rep(0.0025, each=2),rep(0.00125, each=2),rep(0.0011, each=2),rep(0.0015, each=2)),
  stringsAsFactors=FALSE)
data_D

这里是函数

# first function 
# difference for one patient
mismatch.i = function(D, R, i, threshold) {
  D = as.data.frame(D)
  R = as.data.frame(R)
  dif = purrr::map2_df(D[-1], R[i,-1], `-`)
  dif[dif<0] = 0
  dif$mismatch=rowSums(dif)
  dif = cbind(ID = D[1],R[i,1], dif)
  dif = dif[which(dif$mismatch <= threshold),]
  return(list=dif[c(1,2,ncol(dif))])
}

# the second function
# difference for the whole data frame data_R
mismtach.matrice <- function(D,R,threshold){ 
  D = as.matrix(D)
  R = as.matrix(R)
  diff.mat = do.call(rbind, lapply(1:nrow(R), function(x) mismatch.i(D,R,x,threshold)))
  diff.mat = as.data.frame(diff.mat)
  return(diff.mat)
}

这是一个运行函数的示例

mis.i = mismatch.i(data_D[,c(1,3:7)], data_R[,c(1,3:7)], 1, 4)
mis.i
  IDd R[i, 1] mismatch
1   1       1        2
2   2       1        2
3   3       1        2
4   4       1        2
5   5       1        2
6   6       1        3
7   7       1        4
8   8       1        3


mis.whole = mismtach.matrice(data_D[,c(1,3:7)], data_R[,c(1,3:7)], 4)
mis.whole
    IDd R[i, 1] mismatch
1    1       1        2
2    2       1        2
3    3       1        2
4    4       1        2
5    5       1        2
6    6       1        3
7    7       1        4
8    8       1        3
9    1       2        0
10   2       2        0
11   3       2        0
12   4       2        0
13   5       2        0
14   6       2        0
15   7       2        1
16   8       2        1
17   1       3        0
18   2       3        0
19   3       3        0
20   4       3        0
21   5       3        0
22   6       3        2
23   7       3        3
24   8       3        2
25   1       4        0
26   2       4        0
27   3       4        0
28   4       4        0
29   5       4        0
30   6       4        1
31   7       4        2
32   8       4        2
33   1       5        1
34   2       5        1
35   3       5        1
36   4       5        1
37   5       5        1
38   6       5        3
39   7       5        3
40   8       5        1

我试图在第二个函数中包含第一个函数，这就是我所做的，但我得到了一个错误，因为显然我不明白嵌套函数是如何工作的。

# in this main function D, R and Threshold should remain as arguments
mis.test = function(D, R, threshold) { 
  D = as.data.frame(D)
  R = as.data.frame(R)
  mismatch.i = function(D, R, i, threshold) {
    dif = purrr::map2_df(D[-1], R[i,-1], `-`)
    dif[dif<0] = 0
    dif$mismatch=rowSums(dif)
    dif = cbind(ID = D[1],R[i,1], dif)
    dif = dif[which(dif$mismatch <= threshold),]
    return(list=dif[c(1,2,ncol(dif))])
  }
  diff.mat = do.call(rbind, lapply(1:nrow(R), mismatch.i(x)))
  diff.mat = as.data.frame(diff.mat)
  return(diff.mat)
}
mis.test(data_D[,c(1,3:7)],data_R[,c(1,3:7)],4)
#  Error in mismatch.i(x) : object 'x' not found

我希望能够使用 data_R 中的 1 个条目或整个数据帧来运行此函数。如果我运行mis.test(data_D[,c(1,3:7)],data_R[1,c(1,3:7)],4)，我将得到mis.i 的结果，如果我运行mis.test(data_D[,c(1,3:7)],data_R[,c(1,3:7)],4)，我将得到mis.whole 的结果。我希望它很清楚，提前感谢您的帮助。

Answer 1

您的lapply 有点不对劲。你需要传入一个函数。现在您正在尝试调用mismatch.i(x) 并且x 没有在任何地方定义。另外，您还定义了 mismatch.i 以具有您未传递的其他参数。它应该看起来像

diff.mat = do.call(rbind, lapply(1:nrow(R), function(x) mismatch.i(D, R, x, threshold)))

这里我们清楚地做了一个lapply 可以调用的函数，并将x 的值传递给i= 参数，并传递值的结果。

因为它是一个嵌套函数，你也可以从内部函数中去掉多余的参数（因为它们永远不会改变）所以你可以这样做

mis.test = function(D, R, threshold) { 
  D = as.data.frame(D)
  R = as.data.frame(R)
  mismatch.i = function(i) {
    dif = purrr::map2_df(D[-1], R[i,-1], `-`)
    dif[dif<0] = 0
    dif$mismatch=rowSums(dif)
    dif = cbind(ID = D[1],R[i,1], dif)
    dif = dif[which(dif$mismatch <= threshold),]
    return(list=dif[c(1,2,ncol(dif))])
  }
  diff.mat = do.call(rbind, lapply(1:nrow(R), function(x) mismatch.i(x)))
  diff.mat = as.data.frame(diff.mat)
  return(diff.mat)
}