R 中的嵌套函数 - 问题 -

Question

我正在使用我正在使用的功能编辑我的问题。我有两个函数：第一个函数进行计算（两个数据集之间的差异，但仅针对第一个数据集中的一个条目），第二个函数对整个数据集 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)
}

R 中的嵌套函数 - 问题 -

Nested functions in R - Issues-

r

nested-function