Overview
This document runs the preregistered analyses on the full Study 1
dataset. Because the pilot data were collected on the same live survey
link, pilot responses are excluded before applying the preregistered
exclusion criteria. Numeric and text exports of the same data are merged
so that categorical variables (e.g., platforms used, relationship
framing, demographics) show readable labels rather than numeric codes,
while all scale items used for scoring retain their numeric values.
# install.packages(c("qualtRics", "dplyr", "tidyr", "purrr", "broom"))
library(qualtRics)
library(dplyr)
library(tidyr)
library(purrr)
library(broom)
0. Import data
Three files are used here:
study1_numeric.csv — full data, numeric response values
(used for all scale scoring and exclusion logic)study1_text.csv — full data, choice-text response
values (used only for the categorical/demographic variables listed
below)small_pilot.csv — pilot data, used only to identify
which ResponseIds to exclude from the full dataset
num <- read_survey("~/Google drive/My Drive/YEAR 2/PROJECTS/SANDRA/AI Companionship/Cold Turkey Study/Expectations/Data/study1_numeric.csv")
txt <- read_survey("~/Google drive/My Drive/YEAR 2/PROJECTS/SANDRA/AI Companionship/Cold Turkey Study/Expectations/Data/study1_text.csv")
pilot <- read_survey("~/Google drive/My Drive/YEAR 2/PROJECTS/SANDRA/AI Companionship/Cold Turkey Study/Expectations/Data/small_pilot.csv")
cat("Full numeric N (raw):", nrow(num), "\n")
## Full numeric N (raw): 776
cat("Full text N (raw):", nrow(txt), "\n")
## Full text N (raw): 776
cat("Pilot N (raw):", nrow(pilot), "\n")
## Pilot N (raw): 50
1. Remove pilot participants
The pilot ran on the same live survey link, so pilot responses are
present within the full data export (matched by ResponseId)
and must be removed before the full-sample analysis.
pilot_ids <- pilot$ResponseId
num <- num %>% filter(!(ResponseId %in% pilot_ids))
txt <- txt %>% filter(!(ResponseId %in% pilot_ids))
cat("N after removing pilot overlap:", nrow(num), "\n")
## N after removing pilot overlap: 731
2. Remove preview / test responses (already deleted from Qualtrics
but double checking)
num <- num %>% filter(DistributionChannel != "preview")
txt <- txt %>% filter(DistributionChannel != "preview")
cat("N after removing preview responses:", nrow(num), "\n")
## N after removing preview responses: 731
3. Merge numeric + text data
The following categorical/demographic variables are replaced with
their text-labeled values (from txt), since numeric codes
aren’t meaningful on their own for these fields (e.g., platform
selections, relationship framing, demographics). All scale items used
for construct scoring, and all variables used in the exclusion criteria,
are left as numeric (from num).
categorical_vars <- c(
"ai_purposes", "companion_frequency", "platforms", "most_platform",
"relation", "gender", "race", "ses", "employment", "edu", "overall_poli",
"rel_status", "have_child", "live_alone", "prior_dis_occurrence",
"companion_def_use", "unsure_followup", "def_frequency"
)
txt_subset <- txt %>% select(ResponseId, all_of(categorical_vars))
clean_full <- num %>%
select(-all_of(categorical_vars)) %>%
left_join(txt_subset, by = "ResponseId")
4. Preregistered exclusion criteria (Section 6)
Participants are excluded if they do not pass a standard
attention-check, Qualtrics’ bot detection software, a hidden-text bot
detection item, 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 = 2Q_RecaptchaScore — Qualtrics’ built-in
bot detection (reCAPTCHA v3); excluded if score < 0.5Q_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.
clean_full <- clean_full %>%
mutate(
attn_bots_clean = tolower(trimws(attn_bots)),
reached_survey = !is.na(consent),
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,
!is.na(attn_bots),
!is_duplicate,
!fails_recaptcha
)
cat("Final analytic N after exclusions:", nrow(clean_full), "\n")
## Final analytic N after exclusions: 214
5. Sample characteristics
A quick look at the merged text-labeled variables, now that the
analytic sample is finalized.
clean_full %>% count(gender, sort = TRUE) %>% knitr::kable()
| Female |
129 |
| Male |
80 |
| Non-binary |
3 |
| Other |
1 |
| NA |
1 |
clean_full %>% count(most_platform, sort = TRUE) %>% knitr::kable()
| ChatGPT |
130 |
| Google Gemini |
29 |
| Character.AI |
18 |
| Other |
14 |
| Replika |
12 |
| Claude |
5 |
| Microsoft Copilot |
5 |
| Snapchat My AI |
1 |
clean_full %>% count(rel_status, sort = TRUE) %>% knitr::kable()
| Married or in a domestic partnership |
88 |
| Single |
72 |
| In a relationship, but not married |
33 |
| Divorced |
14 |
| Separated |
3 |
| Widowed |
3 |
| NA |
1 |
6. 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_full <- clean_full %>%
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_full[[paste0(construct, "_retro")]] <- rowMeans(clean_full[, r_cols], na.rm = FALSE)
clean_full[[paste0(construct, "_forecast")]] <- rowMeans(clean_full[, f_cols], na.rm = FALSE)
clean_full[[paste0(construct, "_diff")]] <- clean_full[[paste0(construct, "_forecast")]] -
clean_full[[paste0(construct, "_retro")]]
}
7. Primary analysis (Section 5)
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_full[[paste0(construct, "_retro")]]
forecast <- clean_full[[paste0(construct, "_forecast")]]
diff <- clean_full[[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 |
214 |
0.379 |
3.611 |
213 |
0.000 |
0.247 |
0.001 |
| depression |
214 |
0.077 |
0.760 |
213 |
0.448 |
0.052 |
0.448 |
| anxiety |
214 |
0.166 |
1.655 |
213 |
0.099 |
0.113 |
0.149 |
| stress |
214 |
0.100 |
0.969 |
213 |
0.333 |
0.066 |
0.375 |
| happiness |
214 |
-0.745 |
-7.798 |
213 |
0.000 |
-0.533 |
0.000 |
| life_satisfaction |
214 |
-0.341 |
-4.225 |
213 |
0.000 |
-0.289 |
0.000 |
| self_esteem |
214 |
-0.138 |
-1.841 |
213 |
0.067 |
-0.126 |
0.121 |
| irq |
214 |
0.474 |
5.802 |
213 |
0.000 |
0.397 |
0.000 |
| connectedness |
214 |
0.107 |
1.290 |
213 |
0.199 |
0.088 |
0.255 |
8. Secondary analysis (Section 8, part 1)
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_full[[diff_col]] ~ clean_full[[predictor]])
coefs <- tidy(model)
slope_row <- coefs[coefs$term == "clean_full[[predictor]]", ]
tibble(
construct = construct,
predictor = predictor,
n = sum(!is.na(clean_full[[diff_col]]) & !is.na(clean_full[[predictor]])),
estimate = slope_row$estimate,
se = slope_row$std.error,
p = slope_row$p.value
)
})
})
knitr::kable(secondary_results, digits = 3)
| loneliness |
f_difficult |
214 |
0.488 |
0.075 |
0.000 |
| loneliness |
f_miss |
214 |
0.588 |
0.084 |
0.000 |
| depression |
f_difficult |
214 |
0.469 |
0.073 |
0.000 |
| depression |
f_miss |
214 |
0.557 |
0.082 |
0.000 |
| anxiety |
f_difficult |
214 |
0.479 |
0.072 |
0.000 |
| anxiety |
f_miss |
214 |
0.577 |
0.080 |
0.000 |
| stress |
f_difficult |
214 |
0.359 |
0.078 |
0.000 |
| stress |
f_miss |
214 |
0.418 |
0.088 |
0.000 |
| happiness |
f_difficult |
214 |
-0.397 |
0.070 |
0.000 |
| happiness |
f_miss |
214 |
-0.541 |
0.077 |
0.000 |
| life_satisfaction |
f_difficult |
214 |
-0.291 |
0.060 |
0.000 |
| life_satisfaction |
f_miss |
214 |
-0.370 |
0.067 |
0.000 |
| self_esteem |
f_difficult |
214 |
-0.323 |
0.055 |
0.000 |
| self_esteem |
f_miss |
214 |
-0.388 |
0.061 |
0.000 |
| irq |
f_difficult |
214 |
-0.064 |
0.064 |
0.316 |
| irq |
f_miss |
214 |
-0.055 |
0.073 |
0.447 |
| connectedness |
f_difficult |
214 |
-0.197 |
0.064 |
0.002 |
| connectedness |
f_miss |
214 |
-0.288 |
0.072 |
0.000 |
9. Exploratory: Interaction Patterns
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_full[[r_col]]
forecast <- clean_full[[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 |
214 |
-0.037 |
-0.606 |
213 |
0.545 |
-0.041 |
| online |
214 |
0.206 |
3.724 |
213 |
0.000 |
0.255 |
| alone |
214 |
0.047 |
0.780 |
213 |
0.436 |
0.053 |