transform_dce.R

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")