Load packages + set working directory
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(readxl)
library(dplyr)
library(tidyr)
library(lme4)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
library(lmerTest)
##
## Attaching package: 'lmerTest'
##
## The following object is masked from 'package:lme4':
##
## lmer
##
## The following object is masked from 'package:stats':
##
## step
library(emmeans)
## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
library(car)
## Loading required package: carData
## Registered S3 method overwritten by 'car':
## method from
## na.action.merMod lme4
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## some
library(ggplot2)
library(ez)
library(psychReport)
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))
Reading questionnaire data:
This includes only the demographic questions, consent form and
debrief questions - not the actual experimental questions.
questionnaire <- read_xlsx("data_exp_274822-v35 2/data_exp_274822-v35_questionnaires.xlsx")
Data wrangling
Selecting relevant columns for questionnaire
questionnaire_filtered <- questionnaire %>%
select(`Participant Private ID`, Question, Response)
filtering debrief test question to see if any participants failed
the debrief test
debrief_test <- questionnaire_filtered %>%
filter(Question == "What were you asked to do in this study?")
No participants failed the debrief test!
Reading task data - this includes all the experimental questions,
including attention checks
tasks <- read_xlsx("data_exp_274822-v35 2/data_exp_274822-v35_tasks.xlsx")
Selecting only the relevant columns for in the task data set
tasks_filtered <- tasks %>%
select(`Participant Private ID`, Display, Response, Correct, `Object Name`, `Spreadsheet: FileName`, `Spreadsheet: InfluencerType`) %>%
mutate(Correct = as.numeric(Correct))
tasks_filtered_wide <- tasks_filtered %>%
pivot_wider(
id_cols = `Participant Private ID`,
names_from = Display,
values_from = Response
)
## Warning: Values from `Response` are not uniquely identified; output will contain
## list-cols.
## • Use `values_fn = list` to suppress this warning.
## • Use `values_fn = {summary_fun}` to summarise duplicates.
## • Use the following dplyr code to identify duplicates.
## {data} |>
## dplyr::summarise(n = dplyr::n(), .by = c(`Participant Private ID`, Display))
## |>
## dplyr::filter(n > 1L)
Filtering out all N/As from Response column to remove all erroneous
responses.
The data set includes ‘responses’ for the image stimuli as N/A, which
is erroneous data
tasks_filtered_clean <- tasks_filtered %>%
filter(!is.na(Response))
Creating separate data frames for each display to filter out N/As
individually - each display corresponds to either the Instagram task,
the isolated faces task, or the attention checks in each of these
trials.
instagram <- tasks_filtered_clean %>%
filter(Display == "Instagram Profiles Trial")
attention_check_instagram <- tasks_filtered_clean %>%
filter(Display == "Attention Check")
isolated <- tasks_filtered_clean %>%
filter(Display == "Isolated Images Trial")
attention_check_isolated <- tasks_filtered_clean %>%
filter(Display == "Attention Check Isolated")
Combining all data frames back into one
all_tasks_clean <- bind_rows(instagram, attention_check_instagram, isolated, attention_check_isolated)
Figuring out who did not meet attention check requirements
attention_check_score <- all_tasks_clean %>%
filter(Display %in% c("Attention Check", "Attention Check Isolated")) %>%
group_by(`Participant Private ID`) %>%
summarise(attention_check_score = sum(Correct, na.rm = TRUE))
Excluding participants who did not meet attention check
requirements
all_tasks_clean <- bind_rows(instagram, attention_check_instagram, isolated, attention_check_isolated, attention_check_score) %>%
mutate(attention_check_score = as.numeric(attention_check_score)) %>%
group_by(`Participant Private ID`) %>%
filter(max(attention_check_score, na.rm = TRUE) >= 6) %>%
ungroup()
Removing attention check and attention check scores rows for
analysis
all_tasks_analysis <- all_tasks_clean %>%
filter(Display %in% c("Instagram Profiles Trial", "Isolated Images Trial"))
Added condition column to data set to track what type of stimuli
corresponded to each response
all_tasks_analysis <- all_tasks_analysis %>%
mutate(
condition = case_when(
str_detect(`Spreadsheet: FileName`, "t70") ~ "High Truncation AI t70",
str_detect(`Spreadsheet: FileName`, "t30") ~ "Low Truncation AI t30",
str_detect(`Spreadsheet: FileName`, "chat") ~ "Real Edited",
str_detect(`Spreadsheet: FileName`, "og") ~ "Real Unedited",
TRUE ~ "Other"
),
real_or_ai = case_when(
str_detect(`Spreadsheet: FileName`, "A") ~ "AI",
str_detect(`Spreadsheet: FileName`, "R") ~ "Real",
TRUE ~ "Other"
),
Response = as.numeric(Response))
Final line - changing Response to numeric value as it was originally
a character
Another way to exclude participants - manually
excluded_ids <- c(16368687, 16368758)
all_tasks_analysis <- all_tasks_analysis %>%
filter(!`Participant Private ID` %in% excluded_ids)
All_tasks_analysis data frame is ready for analysis!
Creating new dataframe with only trustworthiness question and not
the questions about online behaviours (which were only presented in the
Instagram)
trustworthiness_rating_analysis = all_tasks_analysis %>%
filter(`Object Name` == "Trustworthiness Scale")
Added follower_count column to denote high and low follower count
Instagram stimuli
trustworthiness_rating_analysis <- trustworthiness_rating_analysis %>%
mutate(
follower_count = case_when(
str_detect(`Spreadsheet: FileName`, "_h") ~ "High follower count",
str_detect(`Spreadsheet: FileName`, "_l") ~ "Low follower count",
TRUE ~ "Other"
))
Descriptive analysis
Descriptives for RQ1 - Are AI faces more trustworthy than Real
faces
Descriptive statistics for each condition
descriptives <- trustworthiness_rating_analysis %>%
group_by(real_or_ai, Display) %>%
summarise(
mean_trust = mean(Response, na.rm = TRUE),
sd_trust = sd(Response, na.rm = TRUE),
n = sum(!is.na(Response)),
se = sd_trust / sqrt(n),
ci = qt(0.975, df = n - 1) * se,
.groups = "drop"
)
descriptives
## # A tibble: 4 × 7
## real_or_ai Display mean_trust sd_trust n se ci
## <chr> <chr> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Instagram Profiles Trial 3.99 1.40 980 0.0447 0.0877
## 2 AI Isolated Images Trial 4.53 1.45 980 0.0464 0.0910
## 3 Real Instagram Profiles Trial 3.79 1.44 980 0.0461 0.0904
## 4 Real Isolated Images Trial 4.07 1.43 980 0.0458 0.0899
Calculating mean and standard deviation for real/AI main effect
aggregate(Response ~ real_or_ai, data = trustworthiness_rating_analysis, FUN = mean)
## real_or_ai Response
## 1 AI 4.257143
## 2 Real 3.934694
aggregate(Response ~ real_or_ai, data = trustworthiness_rating_analysis, FUN = sd)
## real_or_ai Response
## 1 AI 1.450282
## 2 Real 1.444505
Calculating mean and standard deviation for isolated/Instagram main
effect
aggregate(Response ~ Display, data = trustworthiness_rating_analysis, FUN = mean)
## Display Response
## 1 Instagram Profiles Trial 3.891327
## 2 Isolated Images Trial 4.300510
aggregate(Response ~ Display, data = trustworthiness_rating_analysis, FUN = sd)
## Display Response
## 1 Instagram Profiles Trial 1.423541
## 2 Isolated Images Trial 1.460034
Filtering for only Instagram condition to get follower count
descriptives
follower_trustworthiness <- trustworthiness_rating_analysis %>%
filter(Display == "Instagram Profiles Trial")
Descriptives for follower count and trustworthiness
aggregate(Response ~ follower_count, data = follower_trustworthiness, FUN = mean)
## follower_count Response
## 1 High follower count 3.915306
## 2 Low follower count 3.867347
aggregate(Response ~ follower_count, data = follower_trustworthiness, FUN = sd)
## follower_count Response
## 1 High follower count 1.439970
## 2 Low follower count 1.407246
Descriptives for RQ3 What is the effect of truncation on
trustworthiness for AI faces
AI truncation descriptives
ai_truncation_descriptives <- trustworthiness_rating_analysis %>%
filter(real_or_ai == "AI") %>%
group_by(condition) %>%
summarise(
mean_trust = mean(Response, na.rm = TRUE),
sd_trust = sd(Response, na.rm = TRUE),
n = sum(!is.na(Response)),
se = sd_trust / sqrt(n),
ci = qt(0.975, df = n - 1) * se,
.groups = "drop"
)
ai_truncation_descriptives
## # A tibble: 2 × 6
## condition mean_trust sd_trust n se ci
## <chr> <dbl> <dbl> <int> <dbl> <dbl>
## 1 High Truncation AI t70 4.04 1.45 980 0.0463 0.0909
## 2 Low Truncation AI t30 4.47 1.42 980 0.0453 0.0889
Descriptive statistics (age) - N = 98
excluded_ids <- c(16368687, 16368758)
age_data <- questionnaire %>%
select(`Participant Private ID`, Question, Response) %>%
filter(Question == "Please enter your age in years.") %>%
filter(!`Participant Private ID` %in% excluded_ids) %>%
distinct(`Participant Private ID`, .keep_all = TRUE) %>%
mutate(age = as.numeric(Response))
age_data %>%
summarise(
n = sum(!is.na(age)),
mean = mean(age, na.rm = TRUE),
sd = sd(age, na.rm = TRUE),
min = min(age, na.rm = TRUE),
max = max(age, na.rm = TRUE)
)
## # A tibble: 1 × 5
## n mean sd min max
## <int> <dbl> <dbl> <dbl> <dbl>
## 1 98 37.7 11.7 18 63
Descriptive statistics - Gender
gender <- questionnaire %>%
select(`Participant Private ID`, Question, Response) %>%
filter(Question == "How would you describe your gender?") %>%
filter(!`Participant Private ID` %in% excluded_ids) %>%
distinct(`Participant Private ID`, .keep_all = TRUE) %>%
mutate(Response = factor(as.numeric(Response),
levels = 1:5,
labels = c("Man/male", "Woman/female", "Non-binary",
"Prefer not to answer", "I use a different term")))
gender %>%
count(Response, .drop = FALSE)
## # A tibble: 5 × 2
## Response n
## <fct> <int>
## 1 Man/male 54
## 2 Woman/female 43
## 3 Non-binary 1
## 4 Prefer not to answer 0
## 5 I use a different term 0
Descriptive statistics (Instagram use) - adding all the ns up = 98 -
makes sense as we have excluded two participants
excluded_ids <- c(16368687, 16368758)
social_media_use <- questionnaire %>%
select(`Participant Private ID`, Question, Response) %>%
filter(Question == "How often do you use social media platforms such as Instagram, TikTok, Facebook, X/Twitter, or similar platforms?") %>%
filter(!`Participant Private ID` %in% excluded_ids) %>%
distinct(`Participant Private ID`, .keep_all = TRUE) %>%
mutate(Response = factor(as.numeric(Response),
levels = 1:6,
labels = c("Never", "Less than once a week", "1-2 days per week",
"3-5 days per week", "Daily", "Multiple times per day")))
social_media_use %>%
count(Response, .drop = FALSE)
## # A tibble: 6 × 2
## Response n
## <fct> <int>
## 1 Never 0
## 2 Less than once a week 3
## 3 1-2 days per week 5
## 4 3-5 days per week 8
## 5 Daily 31
## 6 Multiple times per day 51
Ethnicity descriptives - IMPORTANT NOTE. PEOPLE CAN SELECT MULTIPLE
OPTIONS
excluded_ids <- c(16368687, 16368758)
ethnicity <- questionnaire_filtered %>%
select(`Participant Private ID`, Question, Response) %>%
filter(Question == "What is your family background with respect to ethnicity? You may select more than one option.")
Checking how many people chose ‘other’ - which prompts them with
their own response, adding a 9th row
ethnicity %>%
count(`Participant Private ID`, sort = TRUE) %>%
count(n)
## Storing counts in `nn`, as `n` already present in input
## ℹ Use `name = "new_name"` to pick a new name.
## # A tibble: 2 × 2
## n nn
## <int> <int>
## 1 8 87
## 2 9 13
Row 1 - Aboriginal, row 2 - European… etc. you can see by the lines
of code what each line corresponds to
How many people are Aboriginal? - 1
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice_head(n = 1) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 99
## 2 What is your family background with respect to ethnicity? You … 1 1
How many people are European? - 65
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice(2) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 35
## 2 What is your family background with respect to ethnicity? You … 1 65
How many people are East Asian? - 3
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice(3) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 97
## 2 What is your family background with respect to ethnicity? You … 1 3
How many people are South Asian? - 4
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice(4) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 96
## 2 What is your family background with respect to ethnicity? You … 1 4
How many people are Southeast Asian? - 10
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice(5) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 90
## 2 What is your family background with respect to ethnicity? You … 1 10
How many people are Middle Eastern/North African? - 3
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice(6) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 97
## 2 What is your family background with respect to ethnicity? You … 1 3
How many people Prefer not to say? - 4
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice(7) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 96
## 2 What is your family background with respect to ethnicity? You … 1 4
How many people are ‘other’ - 13
ethnicity %>%
group_by(`Participant Private ID`) %>%
slice(8) %>%
ungroup() %>%
count(Question, Response)
## # A tibble: 2 × 3
## Question Response n
## <chr> <chr> <int>
## 1 What is your family background with respect to ethnicity? You … 0 87
## 2 What is your family background with respect to ethnicity? You … 1 13
Note for us: THE TOTAL AFTER ADDING EVERYTHING UP IS 103 > 98.
THIS IS FINE BECAUSE PEOPLE CAN SELECT MORE THAN ONE OPTION
Main replication and extension analysis:
Two-way ANOVA - are AI faces more trustworthy than real faces
(replication)? and does it differ for isolated and Instagram
(extension)?
Defining factors for ANOVA
trustworthiness_rating_analysis <- trustworthiness_rating_analysis %>%
mutate(
real_or_ai = as.factor(real_or_ai),
Display = as.factor(Display)
)
Running ANOVA1. We are using the ezANOVA function because the the
default for base R is independent samples, adn this function works
better for paired samples (James’ suggestion).
Before we could run the ANOVA, R was having trouble reading the
participant column because of the spaces, so we had to change the object
name to something R-friendly.
names(trustworthiness_rating_analysis)[
names(trustworthiness_rating_analysis) == grep("Participant", names(trustworthiness_rating_analysis), value = TRUE)] = "participant_id"
Now, running ANOVA1:
ANOVA_1.EZ <- ezANOVA(data = trustworthiness_rating_analysis, dv = .(Response),
wid = .(`participant_id`),
within = .(real_or_ai, Display),
detailed = TRUE, type = 3, return_aov = TRUE)
## Warning: Converting "participant_id" to factor for ANOVA.
## Warning: Collapsing data to cell means. *IF* the requested effects are a subset
## of the full design, you must use the "within_full" argument, else results may
## be inaccurate.
aovDispTable(ANOVA_1.EZ)
## ══════════════════════════════════════ ANOVA:ANOVA_1.EZ ═════════════════════════════════════
## Effect DFn DFd SSn SSd F p
## (Intercept) 1 97 6576.406531 200.993469 3173.79184 6.480393e-76
## real_or_ai 1 97 10.189388 20.170612 49.00053 3.337766e-10
## Display 1 97 16.408265 55.741735 28.55314 6.032430e-07
## real_or_ai:Display 1 97 1.645816 9.244184 17.26969 6.992446e-05
## p<.05 ges
## * 0.958302711
## * 0.034384183
## * 0.054231754
## * 0.005718694
## ─────────────────────────────────────────────────────────────────────────────────────────────
Follow-up tests for significant main effects.
Simple effect, paired samples t-test for real faces and
Instagram/isolated
real_filtered_data <- trustworthiness_rating_analysis %>%
filter(real_or_ai == "Real")
real_mean_display_trustworthiness_analysis <- real_filtered_data %>%
group_by(participant_id, Display) %>%
summarise(mean_response_per_participant = mean(Response, na.rm = TRUE)) %>%
pivot_wider(names_from = Display, values_from = mean_response_per_participant)
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by participant_id and Display.
## ℹ Output is grouped by participant_id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(participant_id, Display))` for per-operation grouping
## (`?dplyr::dplyr_by`) instead.
t1_ANOVA1 <- t.test(
real_mean_display_trustworthiness_analysis$`Instagram Profiles Trial`,
real_mean_display_trustworthiness_analysis$`Isolated Images Trial`,
paired = TRUE)
Simple effect, paired samples t-test for AI faces and
Instagram/isolated
ai_filtered_data <- trustworthiness_rating_analysis %>%
filter(real_or_ai == "AI")
ai_mean_display_trustworthiness_analysis <- ai_filtered_data %>%
group_by(participant_id, Display) %>%
summarise(mean_response_per_participant = mean(Response, na.rm = TRUE)) %>%
pivot_wider(names_from = Display, values_from = mean_response_per_participant)
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by participant_id and Display.
## ℹ Output is grouped by participant_id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(participant_id, Display))` for per-operation grouping
## (`?dplyr::dplyr_by`) instead.
t2_ANOVA1 <- t.test(
ai_mean_display_trustworthiness_analysis$`Instagram Profiles Trial`,
ai_mean_display_trustworthiness_analysis$`Isolated Images Trial`,
paired = TRUE)
Simple effect, paired samples t-test for Instagram trial and AI/real
faces
instagram_filtered_data <- trustworthiness_rating_analysis %>%
filter(Display == "Instagram Profiles Trial")
instagram_mean_display_trustworthiness_analysis <- instagram_filtered_data %>%
group_by(participant_id, real_or_ai) %>%
summarise(mean_response_per_participant = mean(Response, na.rm = TRUE)) %>%
pivot_wider(names_from = real_or_ai, values_from = mean_response_per_participant)
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by participant_id and real_or_ai.
## ℹ Output is grouped by participant_id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(participant_id, real_or_ai))` for per-operation
## grouping (`?dplyr::dplyr_by`) instead.
t3_ANOVA1 <- t.test(
instagram_mean_display_trustworthiness_analysis$`Real`,
instagram_mean_display_trustworthiness_analysis$`AI`,
paired = TRUE)
Simple effect, paired samples t-test for isolated trial and AI/real
faces
isolated_filtered_data <- trustworthiness_rating_analysis %>%
filter(Display == "Isolated Images Trial")
isolated_mean_display_trustworthiness_analysis <- isolated_filtered_data %>%
group_by(participant_id, real_or_ai) %>%
summarise(mean_response_per_participant = mean(Response, na.rm = TRUE)) %>%
pivot_wider(names_from = real_or_ai, values_from = mean_response_per_participant)
## `summarise()` has regrouped the output.
## ℹ Summaries were computed grouped by participant_id and real_or_ai.
## ℹ Output is grouped by participant_id.
## ℹ Use `summarise(.groups = "drop_last")` to silence this message.
## ℹ Use `summarise(.by = c(participant_id, real_or_ai))` for per-operation
## grouping (`?dplyr::dplyr_by`) instead.
t4_ANOVA1 <- t.test(
isolated_mean_display_trustworthiness_analysis$`Real`,
isolated_mean_display_trustworthiness_analysis$`AI`,
paired = TRUE)
making Bonferroni adjustments to p-values
p_adjustment <- c(
t1_ANOVA1$p.value,
t2_ANOVA1$p.value,
t3_ANOVA1$p.value,
t4_ANOVA1$p.value
)
p.adjust(p_adjustment, method = "bonferroni")
## [1] 7.283087e-03 1.988361e-09 1.911213e-04 1.168133e-09
Extended research question 1 - t-test for real edited and real
unedited as paired-samples t-test
Calculation of one mean per participant per condition - new
dataframe
real_participant_means <- trustworthiness_rating_analysis %>%
filter(real_or_ai == "Real") %>%
group_by(`participant_id`, condition) %>%
summarise(
mean_response = mean(Response, na.rm = TRUE),
.groups = "drop"
) %>%
pivot_wider(
names_from = condition,
values_from = mean_response
) %>%
mutate(
difference = `Real Edited` - `Real Unedited`
)
Checking to see distribution
par(mfrow = c(1, 2))
hist(
real_participant_means$difference,
main = "Difference Scores",
xlab = "Edited minus Unedited"
)
qqnorm(real_participant_means$difference)
qqline(real_participant_means$difference)
par(mfrow = c(1, 1))
shapiro.test(real_participant_means$difference)
##
## Shapiro-Wilk normality test
##
## data: real_participant_means$difference
## W = 0.98151, p-value = 0.184
Points roughly follow q-q plot, histogram looks okay and Shapiro test
shows that p>0.05 –> can assume normality
t-test for real edited and real unedited stimuli
t.test
## function (x, ...)
## UseMethod("t.test")
## <bytecode: 0x8718f2708>
## <environment: namespace:stats>
realedits_t_test <- t.test(
x = real_participant_means$'Real Edited',
y = real_participant_means$'Real Unedited',
paired = TRUE
)
realedits_t_test
##
## Paired t-test
##
## data: real_participant_means$"Real Edited" and real_participant_means$"Real Unedited"
## t = 1.2326, df = 97, p-value = 0.2207
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## -0.04857138 0.20775505
## sample estimates:
## mean difference
## 0.07959184
Extended research question 2 - t-test for truncation as paired
samples t-test
t-test for truncation 30 and truncation 70 as paired-samples
t-test
Calculate one mean per participant at each truncation level
ai_participant_means <- trustworthiness_rating_analysis %>%
filter(real_or_ai == "AI") %>%
group_by(`participant_id`, condition) %>%
summarise(
mean_response = mean(Response, na.rm = TRUE),
.groups = "drop"
) %>%
pivot_wider(
names_from = condition,
values_from = mean_response
) %>%
mutate(
difference = `High Truncation AI t70` - `Low Truncation AI t30`
)
Checking to see distribution
par(mfrow = c(1, 2))
hist(
ai_participant_means$difference,
main = "Difference Scores",
xlab = "t70 minus t30"
)
qqnorm(ai_participant_means$difference)
qqline(ai_participant_means$difference)
par(mfrow = c(1, 1))
shapiro.test(ai_participant_means$difference)
##
## Shapiro-Wilk normality test
##
## data: ai_participant_means$difference
## W = 0.97009, p-value = 0.02467
Points roughly follow q-q plot, histogram looks negatively skewed and
shapiro test shows that p<0.05 –> may be mild non-normality but
our sample size is 98.
Using Wilcoxon signed rank test for sensitivity
wilcox.test(
ai_participant_means$'High Truncation AI t70',
ai_participant_means$'Low Truncation AI t30',
paired = TRUE,
exact = FALSE
)
##
## Wilcoxon signed rank test with continuity correction
##
## data: ai_participant_means$"High Truncation AI t70" and ai_participant_means$"Low Truncation AI t30"
## V = 448.5, p-value = 3.992e-12
## alternative hypothesis: true location shift is not equal to 0
t test for the two truncation levels
t.test
## function (x, ...)
## UseMethod("t.test")
## <bytecode: 0x8718f2708>
## <environment: namespace:stats>
truncation_t_test <- t.test(
x = ai_participant_means$'High Truncation AI t70',
y = ai_participant_means$'Low Truncation AI t30',
paired = TRUE
)
truncation_t_test
##
## Paired t-test
##
## data: ai_participant_means$"High Truncation AI t70" and ai_participant_means$"Low Truncation AI t30"
## t = -9.3953, df = 97, p-value = 2.713e-15
## alternative hypothesis: true mean difference is not equal to 0
## 95 percent confidence interval:
## -0.5191059 -0.3380369
## sample estimates:
## mean difference
## -0.4285714
Extended research question 3 - two-way ANOVA - Does follower count
affect trustworthiness?
Defining factors before running ANOVA
trustworthiness_rating_analysis <- trustworthiness_rating_analysis %>%
mutate(
follower_count = as.factor(follower_count)
)
Filtering for only the instagram task - as that is where the
follower count condition applies
instagram_data_all_tasks <- trustworthiness_rating_analysis %>%
filter(Display == "Instagram Profiles Trial")
names(instagram_data_all_tasks)[
names(instagram_data_all_tasks) == grep("Participant", names(instagram_data_all_tasks), value = TRUE)] = "participant_id"
Running ANOVA2 (follower count ANOVA)
ANOVA_2.EZ <- ezANOVA(data = instagram_data_all_tasks, dv = .(Response),
wid = .(`participant_id`),
within = .(real_or_ai, follower_count),
detailed = TRUE, type = 3, return_aov = TRUE)
## Warning: Converting "participant_id" to factor for ANOVA.
## Warning: You have removed one or more levels from variable "follower_count".
## Refactoring for ANOVA.
## Warning: Collapsing data to cell means. *IF* the requested effects are a subset
## of the full design, you must use the "within_full" argument, else results may
## be inaccurate.
aovDispTable(ANOVA_2.EZ)
## ═══════════════════════════════════════════ ANOVA:ANOVA_2.EZ ══════════════════════════════════════════
## Effect DFn DFd SSn SSd F
## (Intercept) 1 97 5935.8294898 316.80051 1.817470e+03
## real_or_ai 1 97 3.6450000 19.50500 1.812689e+01
## follower_count 1 97 0.2254082 35.04459 6.239077e-01
## real_or_ai:follower_count 1 97 0.0050000 23.54500 2.059885e-02
## p p<.05 ges
## 1.251884e-64 * 9.376224e-01
## 4.778034e-05 * 9.145880e-03
## 4.315255e-01 5.704795e-04
## 8.861749e-01 1.266143e-05
## ───────────────────────────────────────────────────────────────────────────────────────────────────────
Not conducting any follow-up t-tests for ANOVA2 as there was no
significant interaction - and the only significant main effect was
real/AI, for which we have already conducted t-tests.
Checking for balancing
trustworthiness_rating_analysis %>%
count(real_or_ai, Display)
## # A tibble: 4 × 3
## real_or_ai Display n
## <fct> <fct> <int>
## 1 AI Instagram Profiles Trial 980
## 2 AI Isolated Images Trial 980
## 3 Real Instagram Profiles Trial 980
## 4 Real Isolated Images Trial 980
Extended research question 4 - do trustworthiness and AI/real faces
predict online behaviours?
Changing dataframe to wide for regression model
instagram_analysis_wide = all_tasks_analysis %>%
pivot_wider(names_from = `Object Name`, values_from = Response) %>%
mutate(`Participant Private ID` = factor(`Participant Private ID`), real_or_ai = factor(real_or_ai), `Trustworthiness Scale` = scale(`Trustworthiness Scale`, center = TRUE, scale = FALSE)) %>%
filter(`Display` == "Instagram Profiles Trial")
Creating linear fixed-effects regression model
model = lmer(
`Follow Request Answer` ~ real_or_ai * `Trustworthiness Scale` + (1 | `Participant Private ID`),
data = instagram_analysis_wide, REML = TRUE
)
summary(model)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: `Follow Request Answer` ~ real_or_ai * `Trustworthiness Scale` +
## (1 | `Participant Private ID`)
## Data: instagram_analysis_wide
##
## REML criterion at convergence: 6101.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6499 -0.5882 -0.0513 0.6005 4.2208
##
## Random effects:
## Groups Name Variance Std.Dev.
## Participant Private ID (Intercept) 0.9837 0.9918
## Residual 1.1303 1.0631
## Number of obs: 1960, groups: Participant Private ID, 98
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 3.18087 0.10583 107.97297 30.056
## real_or_aiReal -0.13705 0.04869 1859.95706 -2.815
## `Trustworthiness Scale` 0.64387 0.02805 1926.85617 22.956
## real_or_aiReal:`Trustworthiness Scale` -0.05762 0.03426 1864.43428 -1.682
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## real_or_aiReal 0.00493 **
## `Trustworthiness Scale` < 2e-16 ***
## real_or_aiReal:`Trustworthiness Scale` 0.09275 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) rl_r_R `TScl`
## real_or_aRl -0.225
## `TrstwrScl` 0.029 -0.025
## rl_r_R:`TS` -0.018 0.140 -0.644
Follow Request regression - do trustworthiness and AI/real faces
predict purchase intention?
model1 = lmer(
`Follow Request Answer` ~ real_or_ai * `Trustworthiness Scale` + (1 | `Participant Private ID`),
data = instagram_analysis_wide, REML = TRUE
)
summary(model1)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: `Follow Request Answer` ~ real_or_ai * `Trustworthiness Scale` +
## (1 | `Participant Private ID`)
## Data: instagram_analysis_wide
##
## REML criterion at convergence: 6101.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.6499 -0.5882 -0.0513 0.6005 4.2208
##
## Random effects:
## Groups Name Variance Std.Dev.
## Participant Private ID (Intercept) 0.9837 0.9918
## Residual 1.1303 1.0631
## Number of obs: 1960, groups: Participant Private ID, 98
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 3.18087 0.10583 107.97297 30.056
## real_or_aiReal -0.13705 0.04869 1859.95706 -2.815
## `Trustworthiness Scale` 0.64387 0.02805 1926.85617 22.956
## real_or_aiReal:`Trustworthiness Scale` -0.05762 0.03426 1864.43428 -1.682
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## real_or_aiReal 0.00493 **
## `Trustworthiness Scale` < 2e-16 ***
## real_or_aiReal:`Trustworthiness Scale` 0.09275 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) rl_r_R `TScl`
## real_or_aRl -0.225
## `TrstwrScl` 0.029 -0.025
## rl_r_R:`TS` -0.018 0.140 -0.644
Product Answer regression - do trustworthiness and AI/real faces
predict purchase intention?
model2 = lmer(
`Product Answer` ~ real_or_ai * `Trustworthiness Scale` + (1 | `Participant Private ID`),
data = instagram_analysis_wide, REML = TRUE
)
summary(model2)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: `Product Answer` ~ real_or_ai * `Trustworthiness Scale` + (1 |
## `Participant Private ID`)
## Data: instagram_analysis_wide
##
## REML criterion at convergence: 5166.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9537 -0.6056 -0.0394 0.5586 4.9657
##
## Random effects:
## Groups Name Variance Std.Dev.
## Participant Private ID (Intercept) 1.0224 1.0111
## Residual 0.6831 0.8265
## Number of obs: 1960, groups: Participant Private ID, 98
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 2.64087 0.10552 103.34555 25.027
## real_or_aiReal -0.03840 0.03785 1859.47251 -1.014
## `Trustworthiness Scale` 0.47221 0.02191 1904.40496 21.556
## real_or_aiReal:`Trustworthiness Scale` -0.01653 0.02664 1862.14893 -0.621
## Pr(>|t|)
## (Intercept) <2e-16 ***
## real_or_aiReal 0.310
## `Trustworthiness Scale` <2e-16 ***
## real_or_aiReal:`Trustworthiness Scale` 0.535
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) rl_r_R `TScl`
## real_or_aRl -0.175
## `TrstwrScl` 0.022 -0.024
## rl_r_R:`TS` -0.014 0.140 -0.642
Plots for RQ1 - Are AI faces more trustworthy than Real faces?
Interaction for AI vs Real
ggplot(
descriptives,
aes(
x = real_or_ai,
y = mean_trust,
group = Display,
linetype = Display,
shape = Display
)
) +
geom_line(
linewidth = 0.9
) +
geom_point(
size = 3.5
) +
geom_errorbar(
aes(
ymin = mean_trust - ci,
ymax = mean_trust + ci
),
width = 0.08
) +
scale_y_continuous(
limits = c(1, 7),
breaks = 1:7
) +
labs(
x = "Face type",
y = "Mean trustworthiness rating",
linetype = "Presentation condition",
shape = "Presentation condition"
) +
theme_classic()
Plots for RQ3: What is the effect of truncation on trustworthiness
for AI faces?
Truncation levels on AI trustworthiness ratings
AI truncation column graph
ggplot(
ai_truncation_descriptives,
aes(
x = condition,
y = mean_trust,
fill = condition
)
) +
geom_col(
width = 0.60
) +
geom_errorbar(
aes(
ymin = mean_trust - ci,
ymax = mean_trust + ci
),
width = 0.12
) +
scale_y_continuous(
limits = c(0, 7),
breaks = 0:7
) +
labs(
x = "Truncation condition",
y = "Mean trustworthiness rating"
) +
guides(fill = "none") +
theme_classic()
