diff --git a/DCEsim.Rproj b/DCEsim.Rproj index 69fafd4b6dddad27500cfc67efb9fb16e86a96bd..4ce180b303bff6d22799093f340d9322c550d458 100644 --- a/DCEsim.Rproj +++ b/DCEsim.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: b4471ba3-d3d6-48a1-a26a-00c2bdd34cf7 RestoreWorkspace: No SaveWorkspace: No diff --git a/R/sim_choice.R b/R/sim_choice.R index 1a9d8825f38e7f6aa9741629b718e64a6b99385e..f7d88906e0049ba1d67776dfb832947bead01292 100644 --- a/R/sim_choice.R +++ b/R/sim_choice.R @@ -108,15 +108,40 @@ designs_all <- list() } - transform_util2 <- function() { - - mnl_U <-paste(purrr::map_chr(ut[[1]],as.character,keep.source.attr = TRUE),collapse = "",";") %>% - stringr::str_replace_all(setNames(paste0("@", names(bcoefficients)), paste0("\\b", names(bcoefficients), "\\b"))) %>% - stringr::str_replace_all(setNames(paste0("$", names(datadet)), paste0("\\b", names(datadet), "\\b"))) %>% - stringr::str_replace_all( c( "priors\\[\"" = "" , "\"\\]" = "" , "~" = "=", "\\." = "_" , "V_"="U_")) +transform_util2 <- function() { + # Filter relevant database variables + relevant_database_vars <- setdiff(names(database), c("V_1", "V_2", "U_1", "U_2", "CHOICE")) + + mnl_U <- paste( + purrr::map_chr(ut[[1]], as.character, keep.source.attr = TRUE), + collapse = "", + ";" + ) %>% + # Replace coefficients with exact matches + stringr::str_replace_all(setNames( + paste0("@", names(bcoefficients)), + paste0("(?<![._a-zA-Z0-9])", names(bcoefficients), "(?![._a-zA-Z0-9-])") + )) %>% + # General transformations + stringr::str_replace_all(c( + `priors\\["` = "", + `"\\]` = "", + `~` = "=", + `\\.` = "_", + `V_` = "U_" + )) %>% + # Replace only relevant database variables + stringr::str_replace_all(setNames( + paste0("$", relevant_database_vars), + paste0("(?<![._a-zA-Z0-9])", relevant_database_vars, "(?![._a-zA-Z0-9-])") + )) %>% + # Clean up duplicate symbols + stringr::str_replace_all(c(`@@` = "@", "\\$\\$" = "$")) + + return(mnl_U) +} - } diff --git a/R/simulate_choices.R b/R/simulate_choices.R index 2fc9a092c07a686e98fbc8ab5fcb96d9a259dcce..6931481cb4fbdc2cd2df77e7c222fd7076316483 100644 --- a/R/simulate_choices.R +++ b/R/simulate_choices.R @@ -82,7 +82,7 @@ simulate_choices <- function(data, utility, setspp, destype, bcoefficients, deci ## add random component and calculate total utility data<- data %>% - dplyr::rename_with(~ stringr::str_replace(.,pattern = "\\.","_"), tidyr::everything()) %>% + dplyr::rename_with(~ stringr::str_replace_all(.,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(.))])