Pourquoi une fonction R imbriquée ne reconnaît-elle pas un objet existant en tant qu'argument?

Question

J'ai une série de trois fonctions imbriquées que j'essaie de lancer. Je voudrais spécifier les arguments par défaut de la fonction la plus interne en tant qu'éléments dans un objet de liste qui est passé de la fonction la plus externe. Comme c'est un peu difficile à expliquer, j'ai créé un exemple reproductible qui utilise les mêmes arguments et objets que mon code original. S'il vous plaît pardonner la quantité de code mais je voulais faire cet exemple aussi proche de l'original que possible.

La fonction CreateBirthDates est à l'origine du problème. Les quatre arguments sont tous des éléments de l'objet de liste sim (par exemple, sim$agents$input). J'appelle sim à la première fonction, wrapper, puis encore à la deuxième fonction, UpdateAgentStates. Au sein de UpdateAgentStates, je voudrais modifier sim$agents$input en utilisant les autres objets au sein de sim (par exemple, sim$agents$birth_day). Puisque ces autres arguments sont toujours les mêmes, je voudrais les "câbler". Mais si j'exécute la fonction wrapper, CreateBirthDates ne reconnaît pas sim et ne peut donc pas spécifier les arguments par défaut. J'ai créé des versions alternatives de CreateBirthDates: CreateBirthDates_with_sim. Cela inclut sim comme argument. L'exécution de cette fonction avec la fonction wrapper fonctionne!

Cela ressemble à un problème de type "c'est-à-dire-les-R-travaux" mais je ne comprends pas pourquoi. J'aimerais améliorer mes compétences de base en programmation afin que toute suggestion ou commentaire soit le plus apprécié!

Merci beaucoup, Javan

code Voir ci-dessous:

# Create some example data and load the package lubridate ----- 
    library(lubridate) 

    t1 <- list("agents"=list("input"=data.frame(id=seq(1:5),class=rep("Male",5),age=rep(6,5))), 
     "pars"=list("global"=list("input_age_period"="years", 
            "birth_day"="01Sep", 
            "sim_start"=as.POSIXct("2000-10-01")))) 

    # Specify the original functions ------- 

    wrapper <- function(sim,use_sim=FALSE){ 

     if(use_sim==FALSE){ 
UpdateAgentStates(agent_states = NULL,sim=sim,init=TRUE) 
     } else { 
UpdateAgentStates_with_sim(agent_states = NULL,sim=sim,init=TRUE) 
     } 
    } 

    UpdateAgentStates <- function(agent_states = NULL, 
    sim = sim, 
    init = FALSE 
    ) { 
     if (init == TRUE) { 
input <- sim$agents$input 
input <- CreateBirthDate(input) 
sim$input <- input 
return(sim) 
     } 
    } 

    UpdateAgentStates_with_sim <- function(agent_states = NULL, 
          sim = sim, 
          init = FALSE 
    ) { 
     if (init == TRUE) { 
input <- sim$agents$input 
input <- CreateBirthDate_with_sim(input, sim=sim) 
sim$input <- input 
return(sim) 
     } 
    } 

    CreateBirthDate <- 
    function(input = sim$agents$input, 
    input_age_period = sim$pars$global$input_age_period, 
    birth_day = sim$pars$global$birth_day, 
    starting_day = sim$pars$global$sim_start 
    ){ 

     # Only proceed if there is no birth_date column 
     if(is.null(input$birth_date)){ 
# Loop through each row in the input 
for(a in 1:nrow(input)){ 
    # Is the age_period a year? 
    if(input_age_period == "year" || input_age_period == "years") { 
    # Determine the first sim_start date after the birth_day 
    one_year <- as.period(1, "year") 
    s0 <- as.Date(starting_day - (one_year*input$age[a])) 
    # Set the format of the birth_day 
    birth_day_format <- guess_formats(birth_day,"dm") 
    birth_day_format <- paste(birth_day_format,"%Y",sep="") 
    # Determine the first birth_day after s0 
    s1 <- as.Date(paste(birth_day,year(s0),sep=""), format=birth_day_format) 
    if(length(s1)>1){ 
     s1 <- s1[-(which(is.na(s1)))] 
    } 
    if(s0 >= s1) { 
     input$birth_date[a] <- as.character(s1) 
    } else { 
     input$birth_date[a] <- as.character(s1-one_year) 
    } 
    } else { 
    # If age period is not a year 
    age_period_unit <- as.period(1, input_age_period) 
    input$birth_date[a] <- as.character(starting_day - 
              (age_period_unit*input$age[a])) 
    } 
} 
     } 
     # Convert birth_date to a POSIXct object 
     # input$birth_date <- as.POSIXct(input$birth_date, tz = 
     # tz(sim$pars$global$sim_start)) 
     return(input) 
    } 

    # Specify the modified functions ------- 

    CreateBirthDate_with_sim <- 
     function(input = sim$agents$input, 
     input_age_period = sim$pars$global$input_age_period, 
     birth_day = sim$pars$global$birth_day, 
     starting_day = sim$pars$global$sim_start, sim=sim 
     ){ 

# Only proceed if there is no birth_date column 
if(is.null(input$birth_date)){ 
    # Loop through each row in the input 
    for(a in 1:nrow(input)){ 
    # Is the age_period a year? 
    if(input_age_period == "year" || input_age_period == "years") { 
     # Determine the first sim_start date after the birth_day 
     one_year <- as.period(1, "year") 
     s0 <- as.Date(starting_day - (one_year*input$age[a])) 
     # Set the format of the birth_day 
     birth_day_format <- guess_formats(birth_day,"dm") 
     birth_day_format <- paste(birth_day_format,"%Y",sep="") 
     # Determine the first birth_day after s0 
     s1 <- as.Date(paste(birth_day,year(s0),sep=""), format=birth_day_format) 
     if(length(s1)>1){ 
     s1 <- s1[-(which(is.na(s1)))] 
     } 
     if(s0 >= s1) { 
     input$birth_date[a] <- as.character(s1) 
     } else { 
     input$birth_date[a] <- as.character(s1-one_year) 
     } 
    } else { 
     # If age period is not a year 
     age_period_unit <- as.period(1, input_age_period) 
     input$birth_date[a] <- as.character(starting_day - 
              (age_period_unit*input$age[a])) 
    } 
    } 
     } 
     # Convert birth_date to a POSIXct object 
     # input$birth_date <- as.POSIXct(input$birth_date, tz = 
     # tz(sim$pars$global$sim_start)) 
     return(input) 
     } 

    # Try running the wrapper function ------------- 

    # Original version, doesn't work 
    wrapper(t1, use_sim = FALSE) 

    # But if I add an argument for sim to CreateBirthDate 
    wrapper(t1, use_sim = TRUE) 

Answer 1

Il y a une différence entre l'utilisation d'une fonction globale dans une autre fonction globale et la définition d'une fonction dans une autre fonction. Dans ce premier exemple le champ d'inner_func est l'environnement mondial et sim n'existe pas dans l'environnement mondial (les seules variables qui ne sont t1):

t1 <- 1 

inner_func <- function() { 
    final <- sim*2 
    return(final) 
} 

outer_func <- function(sim = w){ inner_func() } 

outer_func(t1) 

Error in inner_func() : object 'sim' not found 

Toutefois, si nous définissons la inner_func intérieur de outer_func alors vous aurez Obtenez le comportement que vous attendez:

t1 <- 1 

outer_func <- function(sim = w){ 
    inner_func <- function() { 
    final <- sim*2 
    return(final) 
    } 
    inner_func() 
} 

outer_func(t1) 
[1] 2