rm(list=ls()) # Load packages library(tidyverse) library(tidylog) # Read in Data and choice cards load("Data/01_renaming.RData") choice_cards <- readxl::read_excel("Data/Choice_Cards.xlsx", sheet=2) ## QE1a - QE30 choices # Transform choice variables variable_names <- c("QE1a", paste0("QE", 2:30)) char_to_numeric <- function(x) as.numeric(recode(x, A1 = "1", A2 = "2", A3 = "3")) data_choice <- data %>% mutate(across(all_of(variable_names), ~ char_to_numeric(.))) # Reshape data to long format such that every choice set is one row data_choice <- data_choice %>% pivot_longer(cols = all_of(variable_names), names_to = "cset", values_to = "choice") data_choice <- data_choice %>% mutate(cset = as.numeric(gsub("\\D", "", cset))) # Remove not available choice set for each respondents data_choice <- data_choice %>% filter(!is.na(choice)) # Create status quo values # Values for the new row new_row <- c(0, 1, 1, NA, 3) choice_cards_sq <- do.call(rbind, lapply(unique(choice_cards$cset), function(cset_value) { subset_df <- choice_cards[choice_cards$cset == cset_value, ] if (nrow(subset_df) == 2) { new_row[4] <- cset_value # Set cset in the new row rbind(subset_df, new_row) } else { subset_df } })) choice_cards_sq <- choice_cards_sq %>% arrange(cset) # Merge survey data with choice cards data_choice_merged <- left_join(data_choice, choice_cards_sq, by="cset") data_choice_merged <- data_choice_merged %>% mutate(Q27W123 = as.numeric(recode(Q27W123, A1 = "1", A2 = "2", A3 = "3", A4= "4", A5 ="5"))) # Create individual attribute levels and status quo variables data_choice_merged <- data_choice_merged %>% mutate(Rent = (Q07W123 + Q08W123)*Miete, WalkingDistance = Q22S01W123 *Erreichbarkeit, Naturalness = case_when(Naturnähe == 0 ~ Q27W123, TRUE ~ Naturnähe), Rent_SQ = Q07W123 + Q08W123, WalkingDistance_SQ = Q22S01W123, Naturalness_SQ = Q27W123) # Remove unnecessary variables data_choice_merged <- data_choice_merged %>% select(-Naturnähe, -Erreichbarkeit, -Miete) # Reshape data for apollo use database <- pivot_wider(data_choice_merged, names_from = alt, values_from = c("Rent", "WalkingDistance", "Naturalness")) database <- database %>% arrange(X.U.FEFF.id) # Recode treatment variables database <- database %>% mutate(T01W3 = as.numeric(recode(T01W3, AO02 = "0", AO01 = "1")), T02W3 = as.numeric(recode(T02W3, A1 = "1", A2 = "0")), T03W3 = as.numeric(recode(T03W3, AO02 = "0", AO01 = "1"))) # Create New Treatment Groups database <- database %>% mutate(Treatment_new = case_when( T01W3 == 1 ~ 1, # group 1 watched video T01W3 == 0 ~ 2, # group 1 no video T02W3 == 0 ~ 3, # group 2 no information T02W3 == 1 & T03W3 == 0 ~ 4, # group 2 information no video T02W3 == 1 & T03W3 == 1 ~ 5, # group 2 information and video Treatment == 3 ~ 6, # group 3 no treatment TRUE ~ NA_real_), Treatment_name = case_when( Treatment_new == 1 ~ 'Video 1', Treatment_new == 2 ~ 'No Video 1', Treatment_new == 3 ~ 'No Info 2', Treatment_new == 4 ~ 'No Video 2', Treatment_new == 5 ~ 'Video 2', Treatment_new == 6 ~ 'No Treatment 3', TRUE ~ NA_character_ )) # Only keep DCE relevant variables database_full <- database %>% rename(id = "X.U.FEFF.id") save(database_full, file="Data/database_full.RData") database <- database %>% select(X.U.FEFF.id, Treatment, Treatment_new, choice, starts_with(c("Rent", "WalkingDistance", "Naturalness"))) %>% rename(id = "X.U.FEFF.id") save(database, file="Data/database.RData")