为什么嵌套的R函数无法将现有对象识别为参数？

Question

我尝试运行一系列三个嵌套函数。我想将最内层函数的默认参数指定为从最外层函数传递的列表对象中的元素。由于这有点难以解释，我创建了一个可重复使用的示例，它使用与我的原始代码相同的参数和对象。请原谅代码的数量，但我想尽可能使这个例子尽可能接近原始。

函数CreateBirthDates正在引发该问题。这四个参数都是列表对象sim内的所有元素（例如，sim$agents$input）。我给第一个函数wrapper调用sim，然后再次调用第二个函数UpdateAgentStates。在UpdateAgentStates内，我想使用sim内的其他对象（例如，sim$agents$birth_day）修改sim$agents$input。由于这些其他论点总是相同的，我想“硬连线”它们。但是如果我运行wrapper函数，CreateBirthDates不能识别sim，因此无法指定默认参数。

我创建了替代版本CreateBirthDates： CreateBirthDates_with_sim。这包括sim作为参数。用包装函数运行这个函数是可行的！

这看起来像一个“这是一种方式的R - 作品”的问题，但我不完全明白为什么。我想提高我的基本编程技能，所以任何建议或意见将不胜感激！

非常感谢你， 爪哇下面

见代码：

# 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

还有使用另一个全局函数中的全局函数，并定义另一个函数中的一个函数之间的差异。在第一个例子为inner_func范围是全球环境和SIM卡未在全球环境中存在的（即不唯一的变量是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 

但是，如果我们定义里面outer_func的inner_func，那么你将得到你期待的行为：

t1 <- 1 

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

outer_func(t1) 
[1] 2