R中的嵌套函数-问题-

问题描述

我正在使用正在使用的功能来编辑我的问题。我有两个函数：第一个函数进行计算（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,3),1),C= c(0,rep(1,0),D= c(0,4)),E= c(1,stringsAsFactors=FALSE)
data_R

data_D <- data.frame(
  IDd = c(seq(1,8)),BTD = c("A",A=c(rep(0,5),B=c(rep(0,6),C=c(rep(1,7),D=rep(1,8),E=c(rep(0,2),fg=c(rep(0.0025,each=2),rep(0.00125,rep(0.0011,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],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,threshold){ 
  D = as.matrix(D)
  R = as.matrix(R)
  diff.mat = do.call(rbind,lapply(1:nrow(R),function(x) mismatch.i(D,x,threshold)))
  diff.mat = as.data.frame(diff.mat)
  return(diff.mat)
}

这是运行函数的一个例子

mis.i = mismatch.i(data_D[,c(1,3:7)],data_R[,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[,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,threshold) { 
  D = as.data.frame(D)
  R = as.data.frame(R)
  mismatch.i = function(D,threshold) {
    dif = purrr::map2_df(D[-1],`-`)
    dif[dif<0] = 0
    dif$mismatch=rowSums(dif)
    dif = cbind(ID = D[1],dif)
    dif = dif[which(dif$mismatch <= threshold),]
    return(list=dif[c(1,ncol(dif))])
  }
  diff.mat = do.call(rbind,mismatch.i(x)))
  diff.mat = as.data.frame(diff.mat)
  return(diff.mat)
}
mis.test(data_D[,4)
#  Error in mismatch.i(x) : object 'x' not found

我希望能够使用data_R中的1个条目或整个数据帧来运行此功能。如果我运行mis.test(data_D[,data_R[1,4)，我将得到mis.i的结果；如果我运行mis.test(data_D[,4)，我将得到mis.whole的结果。希望一切都清楚，在此先感谢您的帮助。

解决方法

您的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,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],1],dif)
    dif = dif[which(dif$mismatch <= threshold),]
    return(list=dif[c(1,2,ncol(dif))])
  }
  diff.mat = do.call(rbind,function(x) mismatch.i(x)))
  diff.mat = as.data.frame(diff.mat)
  return(diff.mat)
}

nested-function r r