R中网格上的高效Montecarlo模拟

我正在运行多项式逻辑的蒙特卡罗模拟。因此，我有一个生成数据和估计模型的函数。此外，我想在一个值网格上生成不同的数据集。特别是，改变个体n.indiv的数量和每个个体n.choices的答案数量

到目前为止，我已经设法解决了这个问题，但在某一点上，我陷入了一个嵌套的for循环结构，在网格上搜索可能的个人数n.indivu列表和每个个人n.choices列表的答案数。最后，我非常担心在可能值的组合上运行双for循环结构的最后一位代码的使用效率。也许有一种矢量化的方法可以做到这一点，我是不是错过了

最后，这主要是一个风格的问题，我设法得到了一个包含模型的多个对象，这些模型来自于网格搜索和信息名称的组合，但是如果我能将所有模型都折叠到一个列表中，那也太好了，但是对于当前的结构，我不确定如何做到这一点。提前谢谢你

1个生成数据和估计模型的函数

2对可能的数据组合进行网格搜索

---

可以使用purrr包的map2函数进行矢量化：

---

结果将是您的函数输出列表。

Hi@SteveM，感谢您的解决方案，我认为它有一个错误，因为在运行它时，我在seq.default1，n.choices中收到以下错误消息error:object'n.choices'not found Called from:seq.default1，n。choices@AAG. 我包括了传递给map2的v1、v2矢量输出。我想你想要的是详尽的一对。代码中的no.no.choices变量。结果方程完全替换了for循环。我认为应该有某种错误，因为当我从我的行集合运行你的代码位时。seed777从我的示例开始，我得到了我向你提到的错误。请尝试在新会话中使用空工作区运行它，以检查我提到的内容。map2行中还缺少一个括号。添加了缺少的括号。我没有运行你所有的代码。我只是推荐了一个矢量化的解决方案来消除for循环。您对模拟代码块中不同值的迭代应替换为map2块。所以你这么做了，但没用？很抱歉出现任何混乱。是的，当运行整个代码时，删除您在for循环中提到的块并添加您的部分。我得到了声明的错误。我认为问题是因为我的函数mlogit_sim_data需要在全局环境中定义变量n.choices和'n.indiv'，因为它是一个函数。。。作用因此，通过矢量化，您提出这两个变量在过程中会丢失。

library(dplyr)
library(VGAM)
library(mlogit)

#function that generates the data and estimates the model.
mlogit_sim_data <- function(...){
  
  # generating number of (n.alter) X (n.choices)
  df <- data.frame(id= rep(seq(1,n.choices ),n.alter ))
  
  # id per individual
  df <- df %>%
    group_by(id) %>%
    mutate(altern = sequence(n()))%>%
    arrange(id)
  
  #Repeated scheme for each individual + id_ind
  df <- cbind(df[rep(1:nrow(df), n.indiv), ], id_ind = rep(1:n.indiv, each = nrow(df)))
  
  ## creating attributes
  df<- df %>%
    mutate(
      x1=rlnorm(n.indiv*n.alter),
      x2=rlnorm(n.indiv*n.alter),
    )%>%
    group_by(altern) %>%
    mutate(
      id_choice = sequence(n()))%>%
    group_by(id_ind) %>%
    mutate(
      z1 = rpois(1,lambda = 25),
      z2 = rlnorm(1,meanlog = 5, sdlog  = 0.5),
      z3 = ifelse(runif(1, min = 0 , max = 1) > 0.5 , 1 , 0)
    )
  
  # Observed utility
  df$V1 <- with(df,  b1  * x1 +   b2 * x2 )
  
  #### Generate Response Variable ####
  fn_choice_generator <- function(V){
    U <- V + rgumbel(length(V), 0, 1)
    1L * (U == max(U))
  }
  
  # Using fn_choice_generator to generate 'choice' columns 
  df <-  df %>%
    group_by(id_choice) %>%
    mutate(across(starts_with("V"), 
                  fn_choice_generator, .names = "choice_{.col}")) %>% # generating choice(s)
    select(-starts_with("V")) %>% ##drop V variables.
    select(-c(id,id_ind))
  
  
  tryCatch(
    {
      model_result <- mlogit(choice_V1 ~ 0 +  x1 + x2 |1  ,
                                                  data = df,
                                                  idx = c("id_choice", "altern"))
      return(model_result)
    },
    error = function(e){
      return(NA)
    }
  )
  
}

#List with the values that varies in the simulation
  #number of individuals
  n.indiv_list <- c(1, 15, 100, 500 ) 
  #number of choice situations
  n.choices_list <- c(1, 2, 4, 8, 10)  

# Values that remains constant across simulations 
  #set number of alternatives
  n.alter   <- 3    

## Real parameters
b1 <- 1
b2 <- 2

#Number of reps
nreps <- 10 
#Set seed
set.seed(777)

#iteration over different values in the simulation 
for(i in n.indiv_list) {
  for(j in n.choices_list) {
    n.indiv <- i
    n.choices <- j
    assign(paste0("m_ind_", i, "_choices_", j), lapply(X   = 1:nreps, FUN = mlogit_sim_data))
  }
}

library(tidyverse)

n.indiv_list <- c(1, 15, 100, 500 ) 
#number of choice situations
n.choices_list <- c(1, 2, 4, 8, 10)
l1 <- length(n.indiv_list)
l2 <- length(n.choices_list)
v1 <- rep(n.indiv_list, each = l2)
v2 <- rep(n.choices_list, l1)  #v1, v2 generate all pairs
> v1
 [1]   1   1   1   1   1  15  15  15  15  15 100 100 100 100 100 500 500 500 500 500
> v2
 [1]  1  2  4  8 10  1  2  4  8 10  1  2  4  8 10  1  2  4  8 10
    
result <- map2(v1, v2, function(v1, v2) assign(paste0("m_ind_", v1, "_choices_", v2), lapply(X   = 1:nreps, FUN = mlogit_sim_data)))