объединение выходных данных функций внутри вложенной функции в R

#r #merge #output #nested-function

#r #слияние #вывод #вложенная функция

Вопрос:

У меня есть 2 функции, каждая из которых выдает разные выходные данные, я пытался создать новую функцию, которая объединяет 2 выходных данных этих функций, но продолжает получать сообщение об ошибке, в котором говорится, что объект не найден, я понимаю, что как только я выйду из любой из своих функций (внутри общей функции),основная функция не распознает эти объекты. Я не знаю, как сделать эти выходные данные узнаваемыми в глобальной среде для основной функции. Вот код

 #############################################################################
#############################################################################
# 1. datasets 
IDr= c(seq(1,5))
BTR=c("A","B","AB","O","O")
data_R=data.frame(IDr,BTR,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
  IDr BTR A B C D E
1   1   A 0 0 0 0 1
2   2   B 1 0 1 1 1
3   3  AB 0 0 1 1 0
4   4   O 0 0 1 1 1
5   5   O 0 1 0 1 0


IDd= c(seq(1,8))
BTD= c("A","B","AB","O","AB","AB","O","O")
fg= c(rep(0.0025, each=2),rep(0.00125, each=2),rep(0.0011, each=2),rep(0.0015, each=2))
data_D=data.frame(IDd,BTD,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,stringsAsFactors=FALSE)

  data_D
  IDd BTD A B C D E      fg
1   1   A 0 0 1 1 0 0.00250
2   2   B 0 0 1 1 0 0.00250
3   3  AB 0 0 1 1 0 0.00125
4   4   O 0 0 1 1 0 0.00125
5   5  AB 0 0 1 1 0 0.00110
6   6  AB 1 0 1 1 1 0.00110
7   7   O 1 1 1 1 1 0.00150
8   8   O 1 1 0 1 0 0.00150
############################################################################
############################################################################
# fist function
# calulate the frequency of repeated set (A:E) using fg 
freq<- function(df, Vars,col.interest){
  col.interest=as.data.frame(col.interest)
  resultat1= df  %>% 
    group_by(across(all_of(Vars))) %>%
    dplyr::summarise(count = n(), frequency.epi = sum(fg), .groups = 'drop')
  res=merge(resultat1,col.interest,all=TRUE)
  res_final=cbind(df[1:2],res)
  return(res_final)
  
}

dfreq= freq(data_D,colnames(data_D)[3:7],data_D[3:7])
dfreq
  IDd BTD A B C D E count frequency.epi
1   1   A 0 0 1 1 0     5        0.0086
2   2   B 0 0 1 1 0     5        0.0086
3   3  AB 0 0 1 1 0     5        0.0086
4   4   O 0 0 1 1 0     5        0.0086
5   5  AB 0 0 1 1 0     5        0.0086
6   6  AB 1 0 1 1 1     1        0.0011
7   7   O 1 1 0 1 0     1        0.0015
8   8   O 1 1 1 1 1     1        0.0015
###############################################################
# the second function that was corrected by @MrFlic 
 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],IDr=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)
}
# if i want mis.test for 1 person 
mis_one=mis.test(data_D[,c(1,3:7)],data_R[1,c(1,3:7)],2)
mis_one
  IDd IDr mismatch
1   1   1        2
2   2   1        2
3   3   1        2
4   4   1        2
5   5   1        2

# what i want to do in the main function is this step (for example using these exact outputs)
merge(mis_one,dfreq,by="IDd") # this was executed outside to show the expected output
# this is the output expected that i want if i run the main function 

  IDd IDr mismatch BTD A B C D E count frequency.epi
1   1   1        2   A 0 0 1 1 0     5        0.0086
2   2   1        2   B 0 0 1 1 0     5        0.0086
3   3   1        2  AB 0 0 1 1 0     5        0.0086
4   4   1        2   O 0 0 1 1 0     5        0.0086
5   5   1        2  AB 0 0 1 1 0     5        0.0086

  

Вот основная функция со многими ошибками

 test.merge=function(D,DF,R,threshold,Vars,col.interest){
  R=as.data.frame(R)
  D=as.data.frame(D)
  DF=as.data.frame(DF)
  col.interest=as.data.frame(col.interest)
  # remark1: Here i know i repeated the same arguments because i did not know what to set in order to do the calculation
  freq.epi<- function( Vars,col.interest){
    resultat1= DF  %>% 
      group_by(across(all_of(Vars))) %>%
      dplyr::summarise(count = n(), frequency.epi = sum(fg), .groups = 'drop')
    res=merge(resultat1,col.interest,all=TRUE)
    res_final=cbind(DF[1:2],res)
    return(res_final)
    
  }
  # same as remark1 for the arguments
  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],IDr=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)
  }
  # i dont know how to make diff.mat and res_final visible for test.merge
  # i am trying to merge the two outputs res_final and diff.mat by the IDd
  tab=merge(diff.mat,res_final,by="IDd")
  return(tab)
  
}

test.merge(data_D[,c(1,3:7)],data_D,data_R[1,c(1,3:7)],2,colnames(data_D)[3:7],data_D[3:7])
# Error in merge(diff.mat, res_final, by = "IDd") : 
# object 'diff.mat' not found
  

Я не знаю, есть ли другие способы использования выходных данных функций внутри основной функции. Заранее благодарим вас за помощь

Комментарии:

1. mis.test и freq.epi не вызываются. Вы должны вызвать их где-нибудь внутри test.merge .

2. @Rui Я вызываю их в merge ? нравится это merge(mis.test,freq.epi) ?

3. @Rui вы имеете в виду, что перед merge шагом я могу вызвать их так, например: a=mis.test и b=freq.epi и тогда merge ... ? прошу прощения за мой глупый вопрос, но я не знаю, где их вызывать

Ответ №1:

Почему вы хотите объединить все функции в одну? Я бы посоветовал хранить их отдельно и записывать test.merge только для объединения данных с 2 выходов.

 freq<- function(df, Vars,col.interest){
  col.interest=as.data.frame(col.interest)
  resultat1= df  %>% 
    group_by(across(all_of(Vars))) %>%
    dplyr::summarise(count = n(), frequency.epi = sum(fg), .groups = 'drop')
  res=merge(resultat1,col.interest,all=TRUE)
  res_final=cbind(df[1:2],res)
  return(res_final)
  
}

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],IDr=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)
}

test.merge = function(x, y) {
  merge(x,y,by="IDd")
}
test.merge(mis.test(data_D[,c(1,3:7)],data_R[1,c(1,3:7)],2), 
           freq(data_D,colnames(data_D)[3:7],data_D[3:7]))

#  IDd IDr mismatch BTD A B C D E count frequency.epi
#1   1   1        2   A 0 0 1 1 0     5        0.0086
#2   2   1        2   B 0 0 1 1 0     5        0.0086
#3   3   1        2  AB 0 0 1 1 0     5        0.0086
#4   4   1        2   O 0 0 1 1 0     5        0.0086
#5   5   1        2  AB 0 0 1 1 0     5        0.0086
  

И вот исправление вашего исходного кода.

 test.merge=function(D,R,threshold,DF, Vars,col.interest){
  R=as.data.frame(R)
  D=as.data.frame(D)
  DF=as.data.frame(DF)
  col.interest=as.data.frame(col.interest)
 
  freq.epi<- function(DF, Vars,col.interest){
    resultat1= DF  %>% 
      group_by(across(all_of(Vars))) %>%
      dplyr::summarise(count = n(), frequency.epi = sum(fg), .groups = 'drop')
    res=merge(resultat1,col.interest,all=TRUE)
    res_final=cbind(DF[1:2],res)
    return(res_final)
    
  }
  # same as remark1 for the arguments
  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],IDr=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)
  }
  
  tab=merge(mis.test(D, R, threshold),freq.epi(DF, Vars, col.interest),by="IDd")
  return(tab)
  
}

test.merge(data_D[,c(1,3:7)],data_R[1,c(1,3:7)],2,data_D, colnames(data_D)[3:7],data_D[3:7])
  

Я уверен, что это можно было бы оптимизировать и написать лучшим способом (как предложено в 1-й части), но поскольку я не знаю общей картины здесь, я оставлю это OP.

Комментарии:

1. На самом деле @Ronak я просто не думал об этом (глупо!). Я сделаю это по-вашему, как было предложено, чтобы это было легко и просто. Но я все еще хочу знать, есть ли способ использовать выходные данные функций внутри общей функции (возможно, для другого простого примера). Потому что у меня есть много похожих функций, которые я должен объединить, и я не знаю, лучший ли это способ сделать это для всех из них. Есть идеи? Спасибо

2. @Janet Извините, я пропустил сообщение. Я не уверен, понимаю ли я, но, может быть, вы можете вызывать mis.test и freq функционировать внутри основной функции?

3. мой вопрос в том, что вместо создания новой функции test.merge , где я могу вызвать выходные данные (в моем случае diff.mat и res_final ). вы имеете в виду вызов mis.test и freq прямо перед шагом merge в основной функции? Не могли бы вы, @Ronak, объяснить это на примере?

4. Спасибо @Ronak за обновление, теперь я понимаю, как я могу использовать эти выходные данные. Я ценю это.