Code owners
Assign users and groups as approvers for specific file changes. Learn more.
simulate_choices.R 3.16 KiB
#' Simulate choices based on a dataframe with a design
#'
#' @param data a dataframe that includes a design repeated for the number of observations
#' @param utility a list with the utility functions, one utility function for each alternatives
#' @param setspp an integer, the number of choice sets per person
#' @param destype Is it a design created with ngene or with spdesign. Ngene desings should be stored as the standard .ngd output. spdesign should be the spdesign object design$design
#' @return a dataframe that includes simulated choices and a design
#' @export
#'
#' @examples \dontrun{simulate_choices(datadet, ut,setspp)}
simulate_choices <- function(data, utility, setspp, destype, bcoefficients) { #the part in dataset that needs to be repeated in each run
### unpack the bcoeff list so variables are accessible
for (key in names(bcoefficients)) {
assign(key, bcoefficients[[key]])
}
by_formula <- function(equation){ #used to take formulas as inputs in simulation utility function
# //! cur_data_all may get deprecated in favor of pick
dplyr::pick(dplyr::everything()) |>
#cur_data_all() |>
dplyr::transmute(!!formula.tools::lhs(equation) := !!formula.tools::rhs(equation) )
}
# Here one can add additional case-specific data
cat(" \n does sou_gis exist: ", exists("sou_gis"), "\n")
if (exists("sou_gis") && is.function(sou_gis)) {
sou_gis()
cat("\n source of gis has been done \n")
}
if(!exists("manipulations")) manipulations=list() ## If no user input on further data manipulations
n=seq_along(1:length(utility[[1]])) # number of utility functions
cat("\n dataset final_set exists: ",exists("final_set"), "\n")
if(exists("final_set")) data = dplyr::left_join(data,final_set, by = "ID")
cat("\n decisiongroups exists: " ,exists("decisiongroups"))
if(exists("decisiongroups")) { ### create a new variable to classify decision groups.
data = dplyr::mutate(data,group = as.numeric(cut(dplyr::row_number(),
breaks = decisiongroups * dplyr::n(),
labels = seq_along(decisiongroups[-length(decisiongroups)]),
include.lowest = TRUE)))
print(table(data$group))
} else {
data$group=1
}
data<- data %>%
dplyr::group_by(ID) %>%
dplyr::mutate(!!! manipulations)
subsets<- split(data,data$group)
subsets <- purrr::map2(.x = seq_along(utility),.y = subsets,
~ dplyr::mutate(.y,purrr::map_dfc(utility[[.x]],by_formula)))
data <-dplyr::bind_rows(subsets)
data<- data %>%
dplyr::rename_with(~ stringr::str_replace(.,pattern = "\\.","_"), tidyr::everything()) %>%
dplyr::mutate(dplyr::across(.cols=n,.fns = ~ evd::rgumbel(setspp,loc=0, scale=1), .names = "{'e'}_{n}" ),
dplyr::across(dplyr::starts_with("V_"), .names = "{'U'}_{n}") + dplyr::across(dplyr::starts_with("e_")) ) %>% dplyr::ungroup() %>%
dplyr::mutate(CHOICE=max.col(.[,grep("U_",names(.))])
) %>%
as.data.frame()
cat("\n data has been made \n")
cat("\n First few observations \n ")
print(utils::head(data))
cat("\n \n ")
return(data)
}