Overview
This document runs the preregistered analyses on the Study 1 pilot
data. Sections are labeled to match the preregistration’s section
numbers. An additional Exploratory: Interaction
Patterns section is included at the end, covering the
in-person/online/alone analysis that is not part of the confirmatory
preregistered analyses but is still of interest for the pilot check.
# install.packages(c("qualtRics", "dplyr", "tidyr", "purrr", "broom"))
library(qualtRics)
library(dplyr)
library(tidyr)
library(purrr)
library(broom)
0. Import data
qualtRics::read_survey() expects the standard 3-row
Qualtrics CSV export (variable names / question text / ImportId JSON)
and returns one row per response with columns already appropriately
typed.
raw <- read_survey("~/Google drive/My Drive/YEAR 2/PROJECTS/SANDRA/AI Companionship/Cold Turkey Study/Expectations/Data/small_pilot.csv")
cat("Raw N (all rows, including previews/tests):", nrow(raw), "\n")
## Raw N (all rows, including previews/tests): 50
1. Remove preview / test responses
DistributionChannel == "preview" flags responses
generated by researchers testing the survey (e.g., via the Qualtrics
preview link), not real participants, and is dropped before applying the
preregistered exclusion criteria.
raw <- raw %>% filter(DistributionChannel != "preview")
cat("N after removing preview responses:", nrow(raw), "\n")
## N after removing preview responses: 48
2. Preregistered exclusion criteria (Section 6)
Participants are excluded if they do not pass a standard
attention-check, Qualtrics’ bot detection software, and/or Qualtrics’
duplicate-response detection, and/or if they complete the survey in less
than 1 minute. Operationalized as:
attn — instructional manipulation
check (“Please select ‘Somewhat disagree’”); correct response = 2attn_bots — hidden-text bot trap
(“What is your favorite animal?” with an invisible instruction telling
careless/scripted respondents to type “14285733” instead of answering
the visible question); fails if the response contains that string. This
is a second attention-check item, distinct from Qualtrics’ bot detection
software below.Q_RecaptchaScore — Qualtrics’ built-in
bot detection (reCAPTCHA v3); scores range from 0 (likely bot) to 1
(likely human). Excluded if score < 0.5 (Google’s default recommended
threshold).Q_DuplicateRespondent — Qualtrics’
built-in duplicate-response detection; excluded if flagged
TRUEDuration (in seconds) < 60 —
excluded as too fast to answer thoughtfully
Respondents screened out as ineligible before reaching the
substantive survey blocks (and therefore missing all well-being data)
are dropped as part of this step as well, since they were never part of
the analytic sample to begin with.
clean <- raw %>%
mutate(
attn_bots_clean = tolower(trimws(attn_bots)),
fails_bot_trap = grepl("14285733", attn_bots_clean, fixed = TRUE),
reached_survey = !is.na(r_depression_1),
is_duplicate = ifelse(is.na(Q_DuplicateRespondent), FALSE, Q_DuplicateRespondent),
fails_recaptcha = Q_RecaptchaScore < 0.5
) %>%
filter(
reached_survey,
`Duration (in seconds)` >= 60,
attn == 2,
!fails_bot_trap,
!is.na(attn_bots),
!is_duplicate,
!fails_recaptcha
)
cat("Final analytic N after exclusions:", nrow(clean), "\n")
## Final analytic N after exclusions: 12
3. Construct scores (Section 3)
Reverse-score the two “(R)” items, then average the two items per
construct to form a construct-level score (range 1-7), separately for
the Retrospective (Block A, r_) and Forecasted (Block B,
f_) item sets.
reverse_7pt <- function(x) 8 - x
clean <- clean %>%
mutate(
r_rse_1R = reverse_7pt(r_rse_1R),
f_rse_1R = reverse_7pt(f_rse_1R),
r_connect_1R = reverse_7pt(r_connect_1R),
f_connect_1R = reverse_7pt(f_connect_1R)
)
construct_items <- list(
loneliness = list(r = c("r_loneliness_1", "r_loneliness_2"),
f = c("f_loneliness_1", "f_loneliness_2")),
depression = list(r = c("r_depression_1", "r_depression_2"),
f = c("f_depression_1", "f_depression_2")),
anxiety = list(r = c("r_anxiety_1", "r_anxiety_2"),
f = c("f_anxiety_1", "f_anxiety_2")),
stress = list(r = c("r_stress_1", "r_stress_2"),
f = c("f_stress_1", "f_stress_2")),
happiness = list(r = c("r_happiness_1", "r_happiness_2"),
f = c("f_happiness_1", "f_happiness_2")),
life_satisfaction = list(r = c("r_swl_1", "r_swl_2"),
f = c("f_swl_1", "f_swl_2")),
self_esteem = list(r = c("r_rse_1R", "r_rse_2"),
f = c("f_rse_1R", "f_rse_2")),
irq = list(r = c("r_IRQ_1", "r_IRQ_2"),
f = c("f_IRQ_1", "f_IRQ_2")),
connectedness = list(r = c("r_connect_1R", "r_connect_2"),
f = c("f_connect_1R", "f_connect_2"))
)
for (construct in names(construct_items)) {
r_cols <- construct_items[[construct]]$r
f_cols <- construct_items[[construct]]$f
clean[[paste0(construct, "_retro")]] <- rowMeans(clean[, r_cols], na.rm = FALSE)
clean[[paste0(construct, "_forecast")]] <- rowMeans(clean[, f_cols], na.rm = FALSE)
clean[[paste0(construct, "_diff")]] <- clean[[paste0(construct, "_forecast")]] -
clean[[paste0(construct, "_retro")]]
}
4. Primary analysis (Section 5)
For each of the nine outcomes, we compare forecasted scores (Block B)
with retrospective scores (Block A) using paired-samples t-tests,
calculate difference scores as Forecasted − Retrospective, and report
mean differences and effect sizes. Benjamini-Hochberg FDR correction (q
= .05) is applied across the nine tests as a single family.
cohens_dz <- function(diff) mean(diff, na.rm = TRUE) / sd(diff, na.rm = TRUE)
primary_results <- map_dfr(names(construct_items), function(construct) {
retro <- clean[[paste0(construct, "_retro")]]
forecast <- clean[[paste0(construct, "_forecast")]]
diff <- clean[[paste0(construct, "_diff")]]
test <- t.test(forecast, retro, paired = TRUE)
tibble(
construct = construct,
n = sum(!is.na(diff)),
mean_diff = mean(diff, na.rm = TRUE),
t = unname(test$statistic),
df = unname(test$parameter),
p = test$p.value,
dz = cohens_dz(diff)
)
}) %>%
mutate(q_BH = p.adjust(p, method = "BH"))
knitr::kable(primary_results, digits = 3)
| loneliness |
12 |
1.167 |
2.461 |
11 |
0.032 |
0.710 |
0.142 |
| depression |
12 |
0.958 |
2.130 |
11 |
0.057 |
0.615 |
0.168 |
| anxiety |
12 |
0.750 |
1.358 |
11 |
0.202 |
0.392 |
0.227 |
| stress |
12 |
1.000 |
1.970 |
11 |
0.074 |
0.569 |
0.168 |
| happiness |
12 |
-1.417 |
-2.976 |
11 |
0.013 |
-0.859 |
0.114 |
| life_satisfaction |
12 |
-0.708 |
-1.468 |
11 |
0.170 |
-0.424 |
0.219 |
| self_esteem |
12 |
-0.375 |
-1.567 |
11 |
0.145 |
-0.452 |
0.219 |
| irq |
12 |
0.333 |
0.763 |
11 |
0.461 |
0.220 |
0.461 |
| connectedness |
12 |
-0.417 |
-1.520 |
11 |
0.157 |
-0.439 |
0.219 |
5. Secondary analysis (Section 8, part 1)
We test whether participants’ expectations about abstaining from
their AI companion — forecasted difficulty and forecasted missing —
predict their forecasted-minus-retrospective difference scores across
the nine constructs. Run as separate simple regressions (one predictor
per model) for each construct; unadjusted p-values, no FDR correction
for this secondary section.
secondary_predictors <- c("f_difficult", "f_miss")
secondary_results <- map_dfr(names(construct_items), function(construct) {
diff_col <- paste0(construct, "_diff")
map_dfr(secondary_predictors, function(predictor) {
model <- lm(clean[[diff_col]] ~ clean[[predictor]])
coefs <- tidy(model)
slope_row <- coefs[coefs$term == "clean[[predictor]]", ]
tibble(
construct = construct,
predictor = predictor,
n = sum(!is.na(clean[[diff_col]]) & !is.na(clean[[predictor]])),
estimate = slope_row$estimate,
se = slope_row$std.error,
p = slope_row$p.value
)
})
})
knitr::kable(secondary_results, digits = 3)
| loneliness |
f_difficult |
12 |
-0.211 |
0.479 |
0.670 |
| loneliness |
f_miss |
12 |
0.610 |
0.375 |
0.135 |
| depression |
f_difficult |
12 |
0.882 |
0.365 |
0.036 |
| depression |
f_miss |
12 |
0.890 |
0.285 |
0.011 |
| anxiety |
f_difficult |
12 |
0.829 |
0.499 |
0.128 |
| anxiety |
f_miss |
12 |
0.870 |
0.407 |
0.058 |
| stress |
f_difficult |
12 |
0.789 |
0.454 |
0.113 |
| stress |
f_miss |
12 |
0.900 |
0.351 |
0.028 |
| happiness |
f_difficult |
12 |
-0.697 |
0.433 |
0.138 |
| happiness |
f_miss |
12 |
-0.790 |
0.342 |
0.044 |
| life_satisfaction |
f_difficult |
12 |
-0.526 |
0.464 |
0.283 |
| life_satisfaction |
f_miss |
12 |
-0.620 |
0.382 |
0.136 |
| self_esteem |
f_difficult |
12 |
-0.355 |
0.217 |
0.133 |
| self_esteem |
f_miss |
12 |
-0.450 |
0.159 |
0.018 |
| irq |
f_difficult |
12 |
0.487 |
0.418 |
0.272 |
| irq |
f_miss |
12 |
0.050 |
0.388 |
0.900 |
| connectedness |
f_difficult |
12 |
-0.224 |
0.271 |
0.428 |
| connectedness |
f_miss |
12 |
-0.250 |
0.231 |
0.304 |
6. Exploratory: Interaction Patterns
Not part of the confirmatory preregistered analyses, but included
here for the pilot check. For each of the three interaction variables
(in-person, online, alone), we compare forecasted scores with
retrospective scores using paired-samples t-tests and report mean
differences and effect sizes. No FDR correction applied.
interaction_vars <- c(interaction = "interaction", online = "online", alone = "alone")
interaction_results <- map_dfr(names(interaction_vars), function(label) {
var <- interaction_vars[[label]]
r_col <- paste0("r_", var)
f_col <- paste0("f_", var)
retro <- clean[[r_col]]
forecast <- clean[[f_col]]
diff <- forecast - retro
test <- t.test(forecast, retro, paired = TRUE)
tibble(
variable = label,
n = sum(!is.na(diff)),
mean_diff = mean(diff, na.rm = TRUE),
t = unname(test$statistic),
df = unname(test$parameter),
p = test$p.value,
dz = cohens_dz(diff)
)
})
knitr::kable(interaction_results, digits = 3)
| interaction |
12 |
-0.083 |
-0.432 |
11 |
0.674 |
-0.125 |
| online |
12 |
0.167 |
1.000 |
11 |
0.339 |
0.289 |
| alone |
12 |
0.083 |
0.290 |
11 |
0.777 |
0.084 |
7. Save cleaned data + results (optional)
write.csv(clean, "clean_pilot_data.csv", row.names = FALSE)
write.csv(primary_results, "primary_results.csv", row.names = FALSE)
write.csv(secondary_results, "secondary_results.csv", row.names = FALSE)
write.csv(interaction_results, "interaction_results.csv", row.names = FALSE)