Skip to content
Snippets Groups Projects
Code owners
Assign users and groups as approvers for specific file changes. Learn more.
sim_choice.R 2.70 KiB
sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1]] ,destype) {


  require("tictoc")
  require("readr")
  require("psych")
  require("dplyr")
  require("evd")
  require("tidyr")
  require("kableExtra")
  require("gridExtra")
  require("stringr")
  require("mixl")
  require("furrr")
  require("purrr")
  require("ggplot2")
  require("formula.tools")
  require("rlang")


  estimate_sim <- function(run=1) {         #start loop

    cat("This is Run number ", run)

    database <- simulate_choices(datadet, utility = utils, setspp=setpp )


    cat("This is the utility functions \n" , mnl_U)

    model<-mixl::estimate(model_spec,start_values = est, availabilities = availabilities, data= database,)

    return(model)

  }

  mnl_U <-paste(map_chr(utils,as.character,keep.source.attr = TRUE),collapse = "",";") %>%
    str_replace_all( c( "priors\\[\"" = "" , "\"\\]" = "" ,  "~" = "=", "\\." = "_" , " b" = " @b"  , "V_"="U_", " alt"="$alt"))

  cat("mixl \n")
  cat(mnl_U)

  cat("\n Simulation \n")

  print(u)


  designs_all <- list()


  design<- readdesign(design = designfile)

  if (!exists("design$Block")) design$Block=1

  nsets<-nrow(design)
  nblocks<-max(design$Block)
  setpp <- nsets/nblocks      # Choice Sets per respondent; in this 'no blocks' design everyone sees all 24 sets

  replications <- respondents/nblocks

  datadet<- design %>%
    arrange(Block,Choice.situation) %>%
    slice(rep(row_number(), replications)) %>%    ## replicate design according to number of replications
    mutate(ID = rep(1:respondents, each=setpp)) %>%  # create Respondent ID.
    relocate(ID,`Choice.situation`) %>%
    as.data.frame()

  database <- simulate_choices(data=datadet, utility = utils, setspp = setpp)

  model_spec <- mixl::specify_model(mnl_U, database, disable_multicore=F)
  est=setNames(rep(0,length(model_spec$beta_names)), model_spec$beta_names)


  availabilities <- mixl::generate_default_availabilities(
    database, model_spec$num_utility_functions)


  output<- 1:no_sim %>% map(estimate_sim)




  coefs<-map(1:length(output),~summary(output[[.]])[["coefTable"]][c(1,8)]  %>%
               tibble::rownames_to_column() %>%
               pivot_wider(names_from = rowname, values_from = c(est, rob_pval0)) ) %>%
    bind_rows(.id = "run")

  output[["summary"]] <-psych::describe(coefs[,-1], fast = TRUE)

  output[["coefs"]] <-coefs

  pvals <- output[["coefs"]] %>% dplyr::select(starts_with("rob_pval0"))

  output[["power"]] <- 100*table(apply(pvals,1,  function(x) all(x<0.05)))/nrow(pvals)


  output[["metainfo"]] <- c(Path = designfile, NoSim = no_sim, NoResp =respondents)


  print(kable(output[["summary"]],digits = 2, format = "rst"))


  print(output[["power"]])


  return(output)


}