From ba294ed612efcf0757e0c4691a726c136d514c22 Mon Sep 17 00:00:00 2001
From: Julian Sagebiel <julian.sagebiel@idiv.de>
Date: Thu, 2 Jan 2025 11:23:37 +0100
Subject: [PATCH] adapted lookup function to savely pass becoeff to next
functions
---
R/sim_choice.R | 2 +-
R/utils.R | 38 +++++++++++++++++++++++---------------
2 files changed, 24 insertions(+), 16 deletions(-)
diff --git a/R/sim_choice.R b/R/sim_choice.R
index 1bf1576..46ab34d 100644
--- a/R/sim_choice.R
+++ b/R/sim_choice.R
@@ -25,7 +25,7 @@ sim_choice <- function(designfile, no_sim = 10, respondents = 330, u ,designtype
bcoeff <- bcoeff_result$bcoeff
bcoeff_lookup <- bcoeff_result$bcoeff_lookup
-browser()
+
u <- purrr::map(u, function(utility_group) {
purrr::map(utility_group, function(utility) {
# Convert the RHS of the formula to a single string
diff --git a/R/utils.R b/R/utils.R
index 2fc4054..c616c71 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -113,22 +113,30 @@ make_md <- function(f=file){
#'
#' @keywords internal
modify_bcoeff_names <- function(bcoeff) {
- # Check if bcoeff names need modification
- if (any(grepl("[._]", names(bcoeff)))) {
- # Create a lookup table
- bcoeff_lookup <- tibble::tibble(
- original = names(bcoeff),
- modified = stringr::str_replace_all(names(bcoeff), "[._]", "")
- )
-
- # Modify the names in the original bcoeff
- names(bcoeff) <- bcoeff_lookup$modified
+ # Check if bcoeff already has a lookup table attribute
+ if (!is.null(attr(bcoeff, "bcoeff_lookup"))) {
+ message("bcoeff_lookup already exists; skipping modification.")
+ # Retrieve the existing lookup table
+ bcoeff_lookup <- attr(bcoeff, "bcoeff_lookup")
} else {
- # No modification needed; create a trivial lookup table
- bcoeff_lookup <- tibble::tibble(
- original = names(bcoeff),
- modified = names(bcoeff)
- )
+ # Check if bcoeff names need modification
+ if (any(grepl("[._]", names(bcoeff)))) {
+ # Create a lookup table
+ bcoeff_lookup <- tibble::tibble(
+ original = names(bcoeff),
+ modified = stringr::str_replace_all(names(bcoeff), "[._]", "")
+ )
+ # Modify the names in the original bcoeff
+ names(bcoeff) <- bcoeff_lookup$modified
+ } else {
+ # No modification needed; create a trivial lookup table
+ bcoeff_lookup <- tibble::tibble(
+ original = names(bcoeff),
+ modified = names(bcoeff)
+ )
+ }
+ # Attach the lookup table as an attribute to bcoeff
+ attr(bcoeff, "bcoeff_lookup") <- bcoeff_lookup
}
# Return both modified bcoeff and lookup table
--
GitLab