Data preparation

---

The following scripts can be used to replicate the data-set for the preregistered Experiment 3 of Dederichs et al. (2025). It may also be obtained by downloading: Download conjoint_trial.Rda

---

1 Getting started

To copy the code, click the button in the upper right corner of the code-chunks.

1.1 Clean up

rm(list = ls())
gc()

1.2 general custom functions

• fpackage.check: Check if packages are installed (and install if not) in R
• fsave: Function to save data with time stamp in correct directory
• fload: Function to load R-objects under new names
• fshowdf: Print objects (tibble / data.frame) nicely on screen in .Rmd
• ftheme: pretty ggplot2 theme

fpackage.check <- function(packages) {
    lapply(packages, FUN = function(x) {
        if (!require(x, character.only = TRUE)) {
            install.packages(x, dependencies = TRUE)
            library(x, character.only = TRUE)
        }
    })
}

fsave <- function(x, file, location = "./data/processed/", ...) {
    if (!dir.exists(location))
        dir.create(location)
    datename <- substr(gsub("[:-]", "", Sys.time()), 1, 8)
    totalname <- paste(location, datename, file, sep = "")
    print(paste("SAVED: ", totalname, sep = ""))
    save(x, file = totalname)
}


fload <- function(fileName) {
    load(fileName)
    get(ls()[ls() != "fileName"])
}


fshowdf <- function(x, ...) {
    knitr::kable(x, digits = 2, "html", ...) %>%
        kableExtra::kable_styling(bootstrap_options = c("striped", "hover")) %>%
        kableExtra::scroll_box(width = "100%", height = "300px")
}

ftheme <- function() {
    # download font at https://fonts.google.com/specimen/Jost/
    theme_minimal(base_family = "Jost") + theme(panel.grid.minor = element_blank(), plot.title = element_text(family = "Jost",
        face = "bold"), axis.title = element_text(family = "Jost Medium"), axis.title.x = element_text(hjust = 0),
        axis.title.y = element_text(hjust = 1), strip.text = element_text(family = "Jost", face = "bold",
            size = rel(0.75), hjust = 0), strip.background = element_rect(fill = "grey90", color = NA),
        legend.position = "bottom")
}

1.3 Necessary packages

• tidyverse: data wrangling
• haven: read and write various data formats
• sjlabelled: work with labelled (SPSS) data

packages = c("tidyverse", "haven", "sjlabelled")
fpackage.check(packages)
rm(packages)

---

2 Download data files

The data of our survey module will be available at a later date through DANS Data Station SSH, but parts of the data needed for replication can be retrieved by downloading: Download public_trial.Rda.

Download the data-file and put it in the ./data/ folder. But first, make a ./data/ folder:

ifelse(!dir.exists("data"), dir.create("data"), FALSE)

---

3 Import data

Import and unlabel the downloaded data of wave 3 of the TRIAL survey.

df <- fload("./data/public_trial.Rda")
df <- sjlabelled::unlabel(df, verbose = FALSE)

---

4 wrangling data

#make respondent id 
df$id <- 1:nrow(df)

#interaction variables: educational level and migration/cultural background of ego
df$education <- ifelse(!is.na(df$V79.x), df$V79.x, df$V79.y)
df$tert_educ <- ifelse(df$education %in% c(6,7), 1, 0)
df$migration <- ifelse(df$ETNICITEIT %in% c(2, 3), 1, 0) 
df$migration_nw <- ifelse(df$ETNICITEIT == 3, 1, ifelse(df$ETNICITEIT == 1, 0 , NA)) # non-western only vs dutch background

#current club/team composition
#Note: in the course of wave 3, a number of respondents were excluded from questions regarding the current club/team due to routing errors. This issue was rectified in a  follow-up questionnaire. For respondents who provided a response during wave 3, that response is considered. In cases where no response was obtained during wave 3, the follow-up questionnaire responses are taken
df$percent_migrant_club <- ifelse(!is.na(df$V122_1), df$V122_1, df$V122_1_extra)
df$percent_migrant_team <- ifelse(!is.na(df$V122_2), df$V122_2, df$V122_2_extra)
df$percent_migrant_buurt <- df$V122_3
df$percent_migrant_straat <- df$V122_4

df$percent_terteduc_club <- ifelse(!is.na(df$V123_1), df$V123_1, df$V123_1_extra)
df$percent_terteduc_team <- ifelse(!is.na(df$V123_2), df$V123_2, df$V123_2_extra)
df$percent_terteduc_buurt <- df$V123_3
df$percent_terteduc_straat <- df$V123_4

df$inv_sportclub <- ifelse(df$V7a_1 == 1, 1, 0)

#to long format

#each list element contains the choices for each set:
#thus, reistijd.list[[3]][2] is the level of the travel time attribute of club 2 in choice-set 3.

reistijd.list <- list(
  c("Reistijd_A1", "Reistijd_A2"),
  c("Reistijd_B1", "Reistijd_B2"),
  c("Reistijd_C1", "Reistijd_C2")
)

frequentie.list <- list(
  c("Trainningsfrequentie_A1", "Trainningsfrequentie_A2"),
  c("Trainningsfrequentie_B1", "Trainningsfrequentie_B2"),
  c("Trainningsfrequentie_C1", "Trainningsfrequentie_C2")
)

webpagina.list <- list(
  c("Webpagina_A1", "Webpagina_A2"),
  c("Webpagina_B1", "Webpagina_B2"),
  c("Webpagina_C1", "Webpagina_C2")
)

bekenden.list <- list(
  c("Bekenden_A1", "Bekenden_A2"),
  c("Bekenden_B1", "Bekenden_B2"),
  c("Bekenden_C1", "Bekenden_C2")
)

clubopleiding.list  <- list(
  c("Clubleden_opleiding_A1", "Clubleden_opleiding_A2"),
  c("Clubleden_opleiding_B1", "Clubleden_opleiding_B2"),
  c("Clubleden_opleiding_C1", "Clubleden_opleiding_C2")
)

clubmigratie.list  <- list(
  c("Clubleden_migratieachtergrond_A1", "Clubleden_migratieachtergrond_A2"),
  c("Clubleden_migratieachtergrond_B1", "Clubleden_migratieachtergrond_B2"),
  c("Clubleden_migratieachtergrond_C1", "Clubleden_migratieachtergrond_C2")
)

teamopleiding.list  <- list(
  c("Trainingsgroep_opleiding_A1", "Trainingsgroep_opleiding_A2"),
  c("Trainingsgroep_opleiding_B1", "Trainingsgroep_opleiding_B2"),
  c("Trainingsgroep_opleiding_C1", "Trainingsgroep_opleiding_C2")
)

teammigratie.list  <- list(
  c("Trainingsgroep_migratieachtergrond_A1", "Trainingsgroep_migratieachtergrond_A2"),
  c("Trainingsgroep_migratieachtergrond_B1", "Trainingsgroep_migratieachtergrond_B2"),
  c("Trainingsgroep_migratieachtergrond_C1", "Trainingsgroep_migratieachtergrond_C2")
)

chosen <- c("V107_1", "V107_2", "V107_3")

for (set in 1:3) {

  # to long format
  
  for (choice in 1:2) {
    
    data <- as.data.frame(df)
    data$set <- set
    data$options <- choice
    data$traveltime <- data[, names(data) == reistijd.list[[set]][choice]]
    data$trainfreq <- data[, names(data) == frequentie.list[[set]][choice]]
    data$webpage <- data[, names(data) == webpagina.list[[set]][choice]]
    data$acquaintances <- data[, names(data) == bekenden.list[[set]][choice]]
    data$educ_club <- data[, names(data) == clubopleiding.list[[set]][choice]]
    data$educ_team <- data[, names(data) == teamopleiding.list[[set]][choice]]
    data$migrant_club <- data[, names(data) == clubmigratie.list[[set]][choice]]
    data$migrant_team <- data[, names(data) == teammigratie.list[[set]][choice]]
    data$chosen <- data[, names(data) == chosen[set]]
    
    data <- data[, names(data) %in% c("id", "tert_educ", "migration", "migration_nw", "LEEFTIJD", "GESLACHT2", "inv_sportclub", "percent_migrant_club", "percent_migrant_team", "percent_migrant_buurt", "percent_migrant_straat", "percent_terteduc_club", "percent_terteduc_team", "percent_terteduc_buurt", "percent_terteduc_straat", "set", "options", "traveltime", "trainfreq", "webpage", "acquaintances", "educ_club", "educ_team", "migrant_club", "migrant_team", "chosen")]
    
    if(set == 1 & choice == 1) {
      df_long <- data
    } else {
      df_long <- rbind(df_long, data)
    }
  }
}

# reorder
df_long <- df_long[order(df_long$id, df_long$set, df_long$options), ]

# define the choice
df_long$choice <- (df_long$chosen == c(1, 2)[df_long$options])

# recode numeric levels, and make of class factor
df_long <- df_long %>% mutate(
  
  traveltime = case_when(
    traveltime == 1 ~ "travel time: 5 minutes",
    traveltime == 2 ~ "travel time: 15 minutes",
    traveltime == 3 ~ "travel time: 30 minutes"),
  
  trainfreq = case_when(
    trainfreq == 1 ~ "training frequency: once a week",
    trainfreq == 2 ~ "training frequency: more than once a week"),
  
  webpage = case_when(
    webpage == 1 ~ "webpage statement: 'exercising together is building friendships!'",
    webpage == 2 ~ "webpage statement: 'lift yourself to a higher level!'"),
  
  acquaintances = case_when(
    acquaintances == 1 ~ "acquaintances: multiple",
    acquaintances == 2 ~ "acquaintances: none"),
    
  educ_club = case_when(
    educ_club == 1 ~ "club members with tertiary education: a quarter (25%)",
    educ_club == 2 ~ "club members with tertiary education: half (50%)",
    educ_club == 3 ~ "club members with tertiary education: three quarters (75%)"),
  
  migrant_club = case_when(
    migrant_club == 1 ~ "club members with migration background: a few (5%)",
    migrant_club == 2 ~ "club members with migration background: minority (10%)",
    migrant_club == 3 ~ "club members with migration background: a quarter (25%)"),
    
  educ_team = case_when(
    educ_team == 1 ~ "contacts with tertiary education: minority (10%)",
    educ_team == 2 ~ "contacts with tertiary education: a quarter (25%)",
    educ_team == 3 ~ "contacts with tertiary education: half (50%)",
    educ_team == 4 ~ "contacts with tertiary education: three quarters (75%)",
    educ_team == 5 ~ "contacts with tertiary education: majority (90%)"),
    
  migrant_team = case_when(
    migrant_team == 1 ~ "contacts with migration background: none (0%)",
    migrant_team == 2 ~ "contacts with migration background: a few (5%)",
    migrant_team == 3 ~ "contacts with migration background: minority (10%)",
    migrant_team == 4 ~ "contacts with migration background: a quarter (25%)",      
    migrant_team == 5 ~ "contacts with migration background: half (50%)")
  )

row.names(df_long) <- 1:nrow(df_long)

#remove "chosen" and "options"
names(df_long)
df_long <- df_long[, -c(26, 17)]

#last, reorder attribute levels
df_long$traveltime <- factor(df_long$traveltime, levels = rev(c("travel time: 5 minutes", "travel time: 15 minutes", "travel time: 30 minutes")))
df_long$trainfreq <- factor(df_long$trainfreq, levels = rev(c("training frequency: once a week", "training frequency: more than once a week")))
df_long$webpage <- factor(df_long$webpage, levels = rev(c("webpage statement: 'exercising together is building friendships!'", "webpage statement: 'lift yourself to a higher level!'")))
df_long$acquaintances <- factor(df_long$acquaintances, levels = rev(c("acquaintances: none", "acquaintances: multiple")))
df_long$educ_club <- factor(df_long$educ_club, levels = rev(c("club members with tertiary education: a quarter (25%)", "club members with tertiary education: half (50%)", "club members with tertiary education: three quarters (75%)")))
df_long$migrant_club <- factor(df_long$migrant_club, levels = rev(c("club members with migration background: a few (5%)", "club members with migration background: minority (10%)", "club members with migration background: a quarter (25%)")))
df_long$educ_team <- factor(df_long$educ_team, levels = rev(c("contacts with tertiary education: minority (10%)", "contacts with tertiary education: a quarter (25%)", "contacts with tertiary education: half (50%)", "contacts with tertiary education: three quarters (75%)", "contacts with tertiary education: majority (90%)")))
df_long$migrant_team <- factor(df_long$migrant_team, levels = rev(c("contacts with migration background: none (0%)", "contacts with migration background: a few (5%)", "contacts with migration background: minority (10%)", "contacts with migration background: a quarter (25%)", "contacts with migration background: half (50%)")))

---

5 Save data

fsave(df_long, "conjoint_trial.Rda")

---

References

Dederichs, Kasimir, Rob Franken, Dingeman Wiertz, and Jochem Tolsma. 2025. “Ingroup Preferences, Segregation, and Intergroup Contact in Neighborhoods and Civic Organizations.” PNAS Nexus.

---

Copyright © Rob Franken / Kasimir Dederichs / Dingeman Wiertz / Jochem Tolsma