我有一系列的三个嵌套函数，我正在尝试运行。我想将最内层函数的默认参数指定为从最外层函数传递的列表对象中的元素。由于这有点难以解释，我创建了一个可重现的示例，该示例使用与原始代码相同的参数和对象。请原谅代码量，但我想使此示例尽可能接近原始示例。
函数CreateBirthDates导致问题。这四个参数都是列表对象sim中的元素(例如，sim$agents$input(。我将sim调用到第一个函数wrapper，然后再次调用第二个函数UpdateAgentStates。在UpdateAgentStates中，我想使用sim中的其他对象(例如，sim$agents$birth_day(修改sim$agents$input。由于这些其他论点总是相同的，我想"硬连线"它们。但是如果我运行wrapper函数，CreateBirthDates无法识别sim，因此无法指定默认参数。
我创建了CreateBirthDates的替代版本：CreateBirthDates_with_sim.这包括sim作为参数。使用包装器函数运行此函数有效！
这似乎是一个"这就是R-works"的问题，但我不完全明白为什么。我想提高我的基本编程技能，所以任何建议或意见将不胜感激！
谢谢 爪 哇
请参阅下面的代码：
# 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)
在另一个全局函数中使用全局函数与在另一个函数中定义函数是有区别的。在第一个示例中，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