Bot Data Randomization Check

This report checks whether the bot-generated data were allocated evenly across treatment arms and whether a small set of demographics is balanced across treatments. In this export, the treatment variable is c_0001.

library(tidyverse)
library(knitr)

options(dplyr.summarise.inform = FALSE)

data_file <- "data_project_1092096_2026_03_16.csv"
analysis_year <- as.integer(format(Sys.Date(), "%Y"))

raw_data <- readr::read_delim(
  file = data_file,
  delim = ";",
  na = c("", "-66", "-77", "-99"),
  trim_ws = TRUE,
  show_col_types = FALSE
)

flow_data <- readr::read_delim(
  file = data_file,
  delim = ";",
  na = "",
  trim_ws = TRUE,
  col_types = readr::cols(.default = readr::col_character()),
  show_col_types = FALSE
)

analysis_data <- raw_data %>%
  mutate(
    treatment_id = readr::parse_integer(as.character(c_0001)),
    treatment = factor(
      treatment_id,
      levels = 1:4,
      labels = c("Arm 1", "Arm 2", "Arm 3", "Arm 4")
    ),
    gender = case_when(
      v_71 == 1 ~ "Male",
      v_71 == 2 ~ "Female",
      v_71 == 3 ~ "Diverse",
      v_71 == 88 ~ NA_character_,
      TRUE ~ NA_character_
    ),
    age_source = readr::parse_double(as.character(v_74)),
    age_raw = case_when(
      dplyr::between(age_source, 18, 100) ~ age_source,
      dplyr::between(age_source, 1900, analysis_year) ~ analysis_year - age_source,
      TRUE ~ NA_real_
    ),
    age = case_when(
      dplyr::between(age_raw, 18, 100) ~ age_raw,
      TRUE ~ NA_real_
    )
  ) %>%
  filter(!is.na(treatment))

Treatment Assignment Check

assignment_counts <- analysis_data %>%
  count(treatment, name = "n") %>%
  mutate(share = n / sum(n))

assignment_test <- chisq.test(
  x = assignment_counts$n,
  p = rep(1 / nrow(assignment_counts), nrow(assignment_counts))
)

assignment_counts %>%
  mutate(share = scales::percent(share, accuracy = 0.1)) %>%
  kable(col.names = c("Treatment", "N", "Share"))

Treatment	N	Share
Arm 1	203	26.6%
Arm 2	204	26.8%
Arm 3	173	22.7%
Arm 4	182	23.9%

tibble(
  test = "Chi-square goodness-of-fit for equal treatment assignment",
  statistic = unname(assignment_test$statistic),
  df = unname(assignment_test$parameter),
  p_value = assignment_test$p.value
) %>%
  mutate(
    statistic = round(statistic, 3),
    p_value = round(p_value, 4)
  ) %>%
  kable()

test	statistic	df	p_value
Chi-square goodness-of-fit for equal treatment assignment	3.764	3	0.2881

assignment_counts %>%
  ggplot(aes(x = treatment, y = n, fill = treatment)) +
  geom_col(width = 0.7, show.legend = FALSE) +
  geom_text(aes(label = n), vjust = -0.4, size = 4) +
  labs(
    title = "Treatment Assignment Counts",
    x = NULL,
    y = "Number of cases"
  ) +
  theme_minimal(base_size = 12)

Gender Balance Across Treatments

gender_counts <- analysis_data %>%
  filter(!is.na(gender)) %>%
  count(treatment, gender, name = "n") %>%
  group_by(treatment) %>%
  mutate(share_within_treatment = n / sum(n)) %>%
  ungroup()

gender_test <- analysis_data %>%
  filter(!is.na(gender)) %>%
  with(chisq.test(table(treatment, gender)))

gender_counts %>%
  mutate(share_within_treatment = scales::percent(share_within_treatment, accuracy = 0.1)) %>%
  kable(col.names = c("Treatment", "Gender", "N", "Within-treatment share"))

Treatment	Gender	N	Within-treatment share
Arm 1	Diverse	52	29.7%
Arm 1	Female	64	36.6%
Arm 1	Male	59	33.7%
Arm 2	Diverse	54	36.5%
Arm 2	Female	43	29.1%
Arm 2	Male	51	34.5%
Arm 3	Diverse	40	31.0%
Arm 3	Female	44	34.1%
Arm 3	Male	45	34.9%
Arm 4	Diverse	58	40.0%
Arm 4	Female	45	31.0%
Arm 4	Male	42	29.0%

tibble(
  test = "Chi-square test of gender by treatment",
  statistic = unname(gender_test$statistic),
  df = unname(gender_test$parameter),
  p_value = gender_test$p.value
) %>%
  mutate(
    statistic = round(statistic, 3),
    p_value = round(p_value, 4)
  ) %>%
  kable()

test	statistic	df	p_value
Chi-square test of gender by treatment	5.641	6	0.4646

gender_counts %>%
  ggplot(aes(x = treatment, y = share_within_treatment, fill = gender)) +
  geom_col(position = "fill", width = 0.7) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(
    title = "Gender Composition by Treatment",
    x = NULL,
    y = "Share within treatment",
    fill = "Gender"
  ) +
  theme_minimal(base_size = 12)

Age Balance Across Treatments

age_summary <- analysis_data %>%
  group_by(treatment) %>%
  summarise(
    n_age = sum(!is.na(age)),
    mean_age = mean(age, na.rm = TRUE),
    sd_age = sd(age, na.rm = TRUE),
    median_age = median(age, na.rm = TRUE),
    min_age = min(age, na.rm = TRUE),
    max_age = max(age, na.rm = TRUE)
  )

age_model <- analysis_data %>%
  filter(!is.na(age)) %>%
  aov(age ~ treatment, data = .)

age_anova <- summary(age_model)[[1]]

age_test_results <- tibble(
  term = rownames(age_anova),
  df = age_anova[, "Df"],
  sum_sq = age_anova[, "Sum Sq"],
  mean_sq = age_anova[, "Mean Sq"],
  statistic = age_anova[, "F value"],
  p_value = age_anova[, "Pr(>F)"]
)

age_summary %>%
  mutate(
    mean_age = round(mean_age, 2),
    sd_age = round(sd_age, 2),
    median_age = round(median_age, 2)
  ) %>%
  kable(col.names = c("Treatment", "N with age", "Mean age", "SD", "Median", "Min", "Max"))

Treatment	N with age	Mean age	SD	Median	Min	Max
Arm 1	164	60.41	24.40	59.5	18	100
Arm 2	163	59.80	23.04	61.0	19	100
Arm 3	141	56.04	25.10	54.0	18	100
Arm 4	151	59.79	24.14	59.0	18	100

age_test_results %>%
  mutate(
    across(c(sum_sq, mean_sq, statistic, p_value), ~ round(.x, 4))
  ) %>%
  kable(col.names = c("Term", "Df", "Sum Sq", "Mean Sq", "F", "p-value"))

Term	Df	Sum Sq	Mean Sq	F	p-value
treatment	3	1757.182	585.7275	1.0042	0.3904
Residuals	615	358713.405	583.2738	NA	NA

analysis_data %>%
  filter(!is.na(age)) %>%
  ggplot(aes(x = treatment, y = age, fill = treatment)) +
  geom_boxplot(show.legend = FALSE, alpha = 0.8) +
  labs(
    title = "Age by Treatment",
    x = NULL,
    y = "Age"
  ) +
  theme_minimal(base_size = 12)

Manipulation Check Across Arms

The codebook identifies v_57 as the manipulation-check item: “Worum ging es in dem Text hauptsaechlich?” In these data, treatment 1 has no valid v_57 responses, so the response-distribution test is run across arms 2 to 4.

mnpltn_data <- analysis_data %>%
  mutate(
    mnpltnchck = case_when(
      v_57 == 1 ~ "Facts about kindergartens in Duisburg",
      v_57 == 2 ~ "Experiences of a Duisburg family with childcare",
      v_57 == 3 ~ "Role of taxpayers in financing kindergarten places",
      v_57 == 4 ~ "Daily routine in kindergartens in Duisburg",
      v_57 == 5 ~ "Quality of kindergarten care in Duisburg",
      TRUE ~ NA_character_
    )
  )

mnpltn_missing <- mnpltn_data %>%
  group_by(treatment) %>%
  summarise(
    n_total = n(),
    n_answered = sum(!is.na(mnpltnchck)),
    n_missing = sum(is.na(mnpltnchck))
  )

mnpltn_counts <- mnpltn_data %>%
  filter(!is.na(mnpltnchck)) %>%
  count(treatment, mnpltnchck, name = "n") %>%
  group_by(treatment) %>%
  mutate(share_within_treatment = n / sum(n)) %>%
  ungroup()

mnpltn_test <- mnpltn_data %>%
  filter(!is.na(mnpltnchck), treatment != "Arm 1") %>%
  mutate(treatment = forcats::fct_drop(treatment)) %>%
  with(chisq.test(table(treatment, mnpltnchck)))

mnpltn_missing %>%
  kable(col.names = c("Treatment", "Total", "Answered", "Missing"))

Treatment	Total	Answered	Missing
Arm 1	203	0	203
Arm 2	204	204	0
Arm 3	173	173	0
Arm 4	182	182	0

mnpltn_counts %>%
  mutate(share_within_treatment = scales::percent(share_within_treatment, accuracy = 0.1)) %>%
  kable(col.names = c("Treatment", "Response", "N", "Within-treatment share"))

Treatment	Response	N	Within-treatment share
Arm 2	Daily routine in kindergartens in Duisburg	45	22.1%
Arm 2	Experiences of a Duisburg family with childcare	42	20.6%
Arm 2	Facts about kindergartens in Duisburg	39	19.1%
Arm 2	Quality of kindergarten care in Duisburg	39	19.1%
Arm 2	Role of taxpayers in financing kindergarten places	39	19.1%
Arm 3	Daily routine in kindergartens in Duisburg	36	20.8%
Arm 3	Experiences of a Duisburg family with childcare	32	18.5%
Arm 3	Facts about kindergartens in Duisburg	33	19.1%
Arm 3	Quality of kindergarten care in Duisburg	30	17.3%
Arm 3	Role of taxpayers in financing kindergarten places	42	24.3%
Arm 4	Daily routine in kindergartens in Duisburg	33	18.1%
Arm 4	Experiences of a Duisburg family with childcare	42	23.1%
Arm 4	Facts about kindergartens in Duisburg	34	18.7%
Arm 4	Quality of kindergarten care in Duisburg	34	18.7%
Arm 4	Role of taxpayers in financing kindergarten places	39	21.4%

tibble(
  test = "Chi-square test of manipulation-check responses by treatment (Arms 2-4)",
  statistic = unname(mnpltn_test$statistic),
  df = unname(mnpltn_test$parameter),
  p_value = mnpltn_test$p.value
) %>%
  mutate(
    statistic = round(statistic, 3),
    p_value = round(p_value, 4)
  ) %>%
  kable()

test	statistic	df	p_value
Chi-square test of manipulation-check responses by treatment (Arms 2-4)	2.992	8	0.9349

mnpltn_counts %>%
  ggplot(aes(x = treatment, y = share_within_treatment, fill = mnpltnchck)) +
  geom_col(position = "fill", width = 0.7) +
  scale_y_continuous(labels = scales::percent_format()) +
  labs(
    title = "Manipulation-Check Responses by Treatment",
    x = NULL,
    y = "Share within treatment",
    fill = "Response"
  ) +
  theme_minimal(base_size = 12)

Flow Consistency Checks

The codebook contains several explicit filter pages. Those make good sanity checks for whether the bot export follows the intended survey routing. The checks below use the raw export so that skip codes like -77, -66, and -99 are preserved.

timestamp_shown <- function(x) !is.na(x) & x != "" & x != "0" & x != "-77"
response_present <- function(x) !is.na(x) & x != "" & x != "-77"

flow_checks <- tibble(
  check = c(
    "Manipulation check `v_57` skipped in Arm 1",
    "Empathy treatment page timing appears only in Arm 2",
    "Community treatment page timing appears only in Arm 3",
    "Thematic-prime treatment page timing appears only in Arm 4",
    "Empathy debrief timing appears only in Arm 2",
    "Fairness follow-up `v_66` skipped when `v_65 == 6`",
    "Country-culture follow-up `v_102` skipped when `v_99` is 4, 88, or 99",
    "Recontact page `v_135` to `v_137` skipped when `v_108 == 2`"
  ),
  expected = c(
    "No valid `v_57` answers in Arm 1",
    "No nonzero `rts7571736` outside Arm 2",
    "No nonzero `rts7576345` outside Arm 3",
    "No nonzero `rts7571738` outside Arm 4",
    "No nonzero `rts7601898` outside Arm 2",
    "No shown `v_66` when fairness1 is exactly 6",
    "No shown `v_102` when migration status says no roots / DK / refuse",
    "No shown recontact page when respondent declines recontact"
  ),
  violations = c(
    flow_data %>%
      filter(c_0001 == "1", !is.na(v_57), v_57 != "", v_57 != "-77") %>%
      nrow(),
    flow_data %>%
      filter(c_0001 %in% c("1", "3", "4"), timestamp_shown(rts7571736)) %>%
      nrow(),
    flow_data %>%
      filter(c_0001 %in% c("1", "2", "4"), timestamp_shown(rts7576345)) %>%
      nrow(),
    flow_data %>%
      filter(c_0001 %in% c("1", "2", "3"), timestamp_shown(rts7571738)) %>%
      nrow(),
    flow_data %>%
      filter(c_0001 %in% c("1", "3", "4"), timestamp_shown(rts7601898)) %>%
      nrow(),
    flow_data %>%
      filter(v_65 == "6", response_present(v_66)) %>%
      nrow(),
    flow_data %>%
      filter(v_99 %in% c("4", "88", "99"), response_present(v_102)) %>%
      nrow(),
    flow_data %>%
      filter(v_108 == "2", response_present(v_135) | response_present(v_137)) %>%
      nrow()
  )
) %>%
  mutate(result = if_else(violations == 0, "Pass", "Check"))

flow_checks %>%
  select(check, expected, violations, result) %>%
  kable()

check	expected	violations	result
Manipulation check v_57 skipped in Arm 1	No valid v_57 answers in Arm 1	0	Pass
Empathy treatment page timing appears only in Arm 2	No nonzero rts7571736 outside Arm 2	0	Pass
Community treatment page timing appears only in Arm 3	No nonzero rts7576345 outside Arm 3	0	Pass
Thematic-prime treatment page timing appears only in Arm 4	No nonzero rts7571738 outside Arm 4	0	Pass
Empathy debrief timing appears only in Arm 2	No nonzero rts7601898 outside Arm 2	0	Pass
Fairness follow-up v_66 skipped when v_65 == 6	No shown v_66 when fairness1 is exactly 6	0	Pass
Country-culture follow-up v_102 skipped when v_99 is 4, 88, or 99	No shown v_102 when migration status says no roots / DK / refuse	0	Pass
Recontact page v_135 to v_137 skipped when v_108 == 2	No shown recontact page when respondent declines recontact	0	Pass

timing_by_arm <- flow_data %>%
  filter(c_0001 %in% c("1", "2", "3", "4")) %>%
  group_by(c_0001) %>%
  summarise(
    empathy_timing = sum(timestamp_shown(rts7571736)),
    community_timing = sum(timestamp_shown(rts7576345)),
    thematic_timing = sum(timestamp_shown(rts7571738)),
    empathy_debrief_timing = sum(timestamp_shown(rts7601898)),
    .groups = "drop"
  ) %>%
  mutate(
    treatment = factor(as.integer(c_0001), levels = 1:4, labels = c("Arm 1", "Arm 2", "Arm 3", "Arm 4"))
  ) %>%
  select(treatment, empathy_timing, community_timing, thematic_timing, empathy_debrief_timing)

timing_by_arm %>%
  kable(col.names = c("Treatment", "Empathy page", "Community page", "Thematic page", "Empathy debrief"))

Treatment	Empathy page	Community page	Thematic page	Empathy debrief
Arm 1	0	0	0	0
Arm 2	68	0	0	162
Arm 3	0	72	0	0
Arm 4	0	0	57	0