---
title: "Deep dive 2 — Full Analysis"
author: "Gian Luca Liehner"
date: "`r format(Sys.Date(), '%B %d, %Y')`"
format:
html:
toc: true
toc-location: left
editor: source
---
```{r setup}
#| message: false
#| echo: false
knitr::opts_chunk$set(cache = TRUE, message = TRUE)
# Packages
# Loading packages
library(haven) # Read SPSS labeled data
library(tidyverse) # Data manipulation
library(questionr) # Frequency tables
library(kableExtra) # Nice kable tables
library(janitor) # Make databases look nice
library(careless) # Longstrings
library(psych) # Scale manipulation
library(Hmisc) # Social data manipulation
library(corrplot) # Correlation plots
library(ggcorrplot) # Better correlation plots
library(likert) # Visualising likert scales
library(lubridate) # Date manipulation
library(likert) # Building likert tables
library(factoextra) # Clustering
library(NbClust) # Fancy clustering
library(emmeans) # Posthoc-tests
# theme setup
theme_dissertation <- function () {
theme_minimal(base_size=12) +
theme(
panel.background = element_blank(),
legend.background = element_rect(fill="transparent", colour=NA),
legend.key = element_rect(fill="transparent", colour=NA),
text=element_text(size=12, family="Gill Sans"),
plot.background = element_rect(fill = "transparent", color = NA),
axis.title.y = element_text(margin = margin(t = 0, r = 20, b = 0, l = 0), size = 12),
axis.title.x = element_text(margin = margin(t = 10, r = 0, b = 0, l = 0), size = 12),
plot.title = element_text(margin=margin(0,0,10,0)),
legend.margin=margin(l = 10,),
#panel.grid.major = element_line(colour = "#565555", size = .25)
plot.caption = element_text(size=8, color = "#333333", face = "italic"),
plot.subtitle = element_text(size=8, color = "#333333")
)
}
# Little helper function
sec_to_mmss <- function(x) {
x <- round(x) # round to nearest second
mins <- x %/% 60
secs <- x %% 60
sprintf("%02d:%02d", mins, secs)
}
# Colours
colours_dis <- c(
deep_teal = "#006D77",
seafoam_mist = "#83C5BE",
steel_blue = "#457B9D",
ice_blue = "#A8DADC",
raspberry_red = "#EF476F",
pastel_rose = "#FFB4C8",
buttercream = "#FFF3B0",
soft_gold = "#FDE68A",
mint_pastel = "#C7E9C0", # minty pastel green
fresh_mint = "#74C69D",
sherbet_orange = "#FFD8A8", # soft orange sherbet
warm_apricot = "#FBBF77",
ivory_paper = "#FDFCF7", # warm creamy white (like paper ivory)
linen_cream = "#F4EFEA", # linen cream
gentle_greige = "#E8E6E1", # gentle greige (grey–beige)
cool_slate = "#C6C8CA", # cool slate
mid_slate_grey = "#9FA3A9", # mid slate grey
dusk_slate = "#6E7582",
deep_slate = "#2F3E46" # deeper slate, not pure black
)
```
# Loading data
```{r load_data}
raw_data <- read_spss("data/raw_data_2021-03-08.sav")
n = raw_data %>% tally()
```
### Renaming all variables to snake case and removing unnecessary varibale
```{r renaming}
data <- clean_names(raw_data, "snake")
data <- data %>% select(
-status,
-ip_address,
-recipient_last_name,
-recipient_first_name,
-recipient_email,
-external_reference
)
names(data) %>% kable() %>% scroll_box(height = "300px")
```
# Cleaning data
## Removing incompletes
```{r completed}
data <- data %>% filter(finished == 1)
# Double checking with the progress variable
data <- data %>% filter(progress == 100)
```
Dropped cases `r data %>% tally()-n`
`r n <- data %>% tally()`
## NA in demographics
Rows were removed if the following variables contained missing data
* `alter`
* `geschlecht`
* `ausbildung`
* `taetigkeit`
* `berufsrichtung`
* `medPersonal`
```{r na_demographics}
data <- data %>% drop_na(c(alter, geschlecht, ausbildung, taetigkeit, berufsrichtung, med_personal))
```
Dropped cases `r data %>% tally()-n`
`r n <- data %>% tally()`
## Filtering out minors
```{r minors}
data <- data %>% filter(!alter < 18)
```
Dropped cases `r data %>% tally()-n`
`r n <- data %>% tally()`
## Removing speeders
```{r speeder}
median_completion_time <- median(data$duration_in_seconds)
data <- data %>% filter(!duration_in_seconds < median_completion_time/2)
```
Median completion time: `r sec_to_mmss(median_completion_time)`
Cut off: `r sec_to_mmss(median_completion_time/2)`
Dropped cases `r data %>% tally()-n`
`r n <- data %>% tally()`
## Longstring analysis
```{r longstring}
# Hypochondria
data %>% select(starts_with("hypochondrie")) %>% longstring() -> data$hypochondrie_ls
data %>% filter(!hypochondrie_ls == 7)-> data
# Interpersonal trust
data %>% select(starts_with("kusiv")) %>% longstring() -> data$kusiv3_ls
data %>% filter(!kusiv3_ls == 3)-> data
# Locus of control
data %>% select(starts_with("kontroll")) %>% longstring() -> data$kontrollueberzeugung_ls
data %>% filter(!kontrollueberzeugung_ls == 4)-> data
# BDWS
data %>% select(starts_with("dangerous_world")) %>% longstring() -> data$dangerous_world_ls
data %>% filter(!dangerous_world_ls == 10)-> data
# Sensitivity to threat
data %>% select(starts_with("sensitivity")) %>% longstring() -> data$sensitivity_threat_ls
data %>% filter(!sensitivity_threat_ls == 5) -> data
```
Dropped cases `r data %>% tally()-n`
`r n <- data %>% tally()`
## Calculating Mahalanobis Distance (D) and flag potential outliers.
```{r mahad}
mahad_analysis <- data %>% select(hypochondrie_1:sensitivity_threat_5) %>%
mahad(plot = TRUE, flag = TRUE, confidence = 0.99, na.rm = TRUE)
data$mahad_num <- mahad_analysis$d_sq
data$mahad_flag <- mahad_analysis$flagged
data$mahad_flag %>% freq() %>% kable()
data <- data %>% filter(mahad_flag == FALSE)
```
Dropped cases `r data %>% tally()-n`
`r n <- data %>% tally()`
---
**Final N** = `r data %>% tally()`
# Internal consistency analysis
## Hypochondrie
```{r hypochondria}
#| echo: false
hypochondrie_items <- data %>% select(starts_with("hypochondrie"))
hypochondrie_keys <- list(hypochondrie_scores = c("hypochondrie_1", "hypochondrie_2", "hypochondrie_3", "hypochondrie_4", "hypochondrie_5", "hypochondrie_6", "hypochondrie_7"))
hypochondrie_scores <- psych::scoreItems(hypochondrie_keys, hypochondrie_items, min = 1, max = 6)
data <- data %>% bind_cols(hypochondrie_scores$scores %>% as_tibble())
hypochondrie_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average **hypochondria** score ", digits = 2) %>% kable_material()
```
The reliability of the scale *hypochondria* is **`r round(hypochondrie_scores$alpha,2)`**
## Interpersonal trust
```{r kusiv}
#| echo: false
kusiv3_items <- data %>% select(starts_with("kusiv3"))
kusiv3_keys <- list(kusiv3_scores = c("kusiv3_1", "-kusiv3_2", "kusiv3_3"))
kusiv3_scores <- psych::scoreItems(kusiv3_keys, kusiv3_items, min = 1, max = 6)
data <- data %>% bind_cols(kusiv3_scores$scores %>% as_tibble())
kusiv3_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average **interpersonal trust** score ", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *interpersonal trust* is **`r round(kusiv3_scores$alpha,2)`**
## Risk
```{r risk}
#| echo: false
data$risikobereitschaft_1 %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average **risk disposition** score ", digits = 2, row.names = FALSE) %>% kable_material()
```
## Locus of control
```{r control}
#| echo: false
control_items <- data %>% select(starts_with("kontrollueberzeugung"))
control_keys <- list(control_scores = c("kontrollueberzeugung_1", "kontrollueberzeugung_2", "-kontrollueberzeugung_3", "-kontrollueberzeugung_4"))
control_scores <- psych::scoreItems(control_keys, control_items, min = 1, max = 6)
data <- data %>% bind_cols(control_scores$scores %>% as_tibble())
control_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average **locus of control** score ", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *control* is **`r round(control_scores$alpha,2)`**
## Believe in a dangerous world
```{r bdws}
#| echo: false
dangerous_world_items <- data %>% select(starts_with("dangerous_world"))
dangerous_world_keys <- list(dangerous_world_scores = c("-dangerous_world_1", "dangerous_world_2", "dangerous_world_3", "-dangerous_world_4" , "-dangerous_world_5", "dangerous_world_6", "-dangerous_world_7", "dangerous_world_8", "-dangerous_world_9", "dangerous_world_10"))
dangerous_world_scores <- psych::scoreItems(dangerous_world_keys, dangerous_world_items, min = 1, max = 6)
data <- data %>% bind_cols(dangerous_world_scores$scores %>% as_tibble())
dangerous_world_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average **believe in a dangerous world** (BDWS) score ", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *believe in a dangerous world* is **`r round(dangerous_world_scores$alpha,2)`**
## Sensitivity to threat
```{r sensitivity}
#| echo: false
sensitivity_threat_items <- data %>% select(starts_with("sensitivity_threat"))
sensitivity_threat_keys <- list(sensitivity_threat_scores = c("sensitivity_threat_1", "-sensitivity_threat_2", "-sensitivity_threat_3", "sensitivity_threat_4" , "-sensitivity_threat_5"))
sensitivity_threat_scores <- psych::scoreItems(sensitivity_threat_keys, sensitivity_threat_items, min = 1, max = 6)
data <- data %>% bind_cols(sensitivity_threat_scores$scores %>% as_tibble())
sensitivity_threat_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average **sensitivity to threat** score ", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *sensitivity to threat* is **`r round(sensitivity_threat_scores$alpha,2)`**
# Sample description
## Age
```{r age}
#| echo: false
psych::describe(data$alter, fast = TRUE) %>% kable(caption = "Descriptives for age", digits = 2, row.names = FALSE) %>% kable_material()
data %>%
ggplot +
aes(alter) +
geom_histogram(binwidth = 1, fill=colours_dis[1], color=colours_dis[2]) +
geom_density(aes(y = ..density..*nrow(data)), color=colours_dis[2]) +
geom_vline(xintercept = mean(data$alter), linetype="dotted", color = colours_dis[5], size=1.5) +
labs(x="Age", title = "Age histrogram", y="Absolute count", caption = "Blue dotted line represents mean, and pink solid line represents density") +
theme_dissertation()
```
## Gender
```{r gender}
#| echo: false
questionr::freq(data$geschlecht, sort = "dec") %>% kable(caption = "Frequency table for gender", digits = 2) %>% kable_material()
```
## Education
```{r education}
#| echo: false
questionr::freq(data$ausbildung, sort = "dec") %>% kable(caption = "Frequency table for education", digits = 2) %>% kable_material()
```
## Employment status
```{r employment}
#| echo: false
questionr::freq(data$taetigkeit, sort = "dec") %>% kable(caption = "Frequency table for employment", digits = 2) %>% kable_material()
```
## Job type
```{r job_type}
#| echo: false
questionr::freq(data$berufsrichtung, sort = "dec") %>% kable(caption = "Frequency table for type of employment", digits = 2) %>% kable_material()
```
## Employment in health sector
```{r medical_employment}
#| echo: false
questionr::freq(data$med_personal, sort = "dec") %>% kable(caption = "Are you working in medicine?", digits = 2) %>% kable_material()
```
## Place of residency
```{r residency}
#| echo: false
questionr::freq(data$wohnort, sort = "dec") %>% kable(caption = "Ich wohne in...", digits = 2) %>% kable_material()
```
## Health status
### General health status
```{r health}
gesundheit_1 <- questionr::freq(data$gesundheit_1)$`%`[1]
gesundheit_2 <- questionr::freq(data$gesundheit_2)$`%`[1]
gesundheit_3 <- questionr::freq(data$gesundheit_3)$`%`[1]
gesundheit_4 <- questionr::freq(data$gesundheit_4)$`%`[1]
```
Percentage of people feeling **healthy**: `r gesundheit_1`%
Percentage of people feeling **momentarily ill**: `r gesundheit_2`%
Percentage of people feeling **chronically ill**: `r gesundheit_3`%
Percentage of people feeling **momentarily & chronically ill**: `r gesundheit_4`%
***Note:*** *These values need to be checked in their validity*
### COVID-19 Infection
```{r covid_19}
questionr::freq(data$covid19, sort = "dec") %>% kable(caption = "Sind oder waren Sie mit Covid-19 infiziert?", digits = 2) %>% kable_material()
```
### Risk group
```{r risk_group}
risikogruppe_1 <- questionr::freq(data$risikogruppe_1)$`%`[1]
risikogruppe_2 <- questionr::freq(data$risikogruppe_2)$`%`[1]
risikogruppe_3 <- questionr::freq(data$risikogruppe_3)$`%`[1]
risikogruppe_4 <- questionr::freq(data$risikogruppe_4)$`%`[1]
```
Percentatage of people that **don't belong** to risk group: `r risikogruppe_1`%
Percentatage of people that **belong** to risk group: `r risikogruppe_2`%
Percentatage of people that **lives** with a person who belongs to risk group: `r risikogruppe_3`%
Percentatage of people that **take care** of a person that belongs to risk group: `r risikogruppe_4`%
# Results
## AI Experience
```{r knowledge}
#| echo: false
questionr::freq(data$erfahrung_ki, sort = "dec") %>% kable(caption = "Erfahrung mit KI", digits = 2) %>% kable_material()
knowledge <-questionr::freq(data$erfahrung_ki)
knowledge$group <- row.names(knowledge)
knowledge <- knowledge %>% rename("score" = "%")
knowledge %>%
ggplot +
aes(x="", y=score, fill=group)+
geom_bar(width = 1, stat = "identity") +
labs(fill="What is your knowledge of AI", y="Frequency", title = "Knowledge about AI", subtitle = "N = 174") +
scale_fill_manual(values=c("#006d77", "#ffb4c8", "#74C69D","#FBBF77", "#ef476f" )) +
theme_dissertation()+
theme(axis.title.x=element_blank())
```
## Trust in AI
```{r trust_ai}
#| echo: false
trust_ai_items <- data %>% select(starts_with("vertrauen_ki"))
trust_ai_keys <- list(trust_ai_scores = c("vertrauen_ki_1", "-vertrauen_ki_2", "vertrauen_ki_3", "-vertrauen_ki_4" , "-vertrauen_ki_5"))
trust_ai_scores <- psych::scoreItems(trust_ai_keys, trust_ai_items, min = 1, max = 6)
data <- data %>% bind_cols(trust_ai_scores$scores %>% as_tibble())
trust_ai_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average **trust in AI** score ", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *trust in AI* is **`r round(trust_ai_scores$alpha,2)`**
# Descriptives
## Use intention scores
```{r use_intention_s1}
#| echo: false
use_intention_s1_items <- data %>% select(starts_with("bereitschaft_s1"))
use_intention_s1_keys <- list(use_intention_s1_scores = c(
"bereitschaft_s1_1",
"bereitschaft_s1_2",
"bereitschaft_s1_3",
"-bereitschaft_s1_4",
"bereitschaft_s1_5",
"bereitschaft_s1_6",
"-bereitschaft_s1_7",
"bereitschaft_s1_8"))
use_intention_s1_scores <- psych::scoreItems(use_intention_s1_keys, use_intention_s1_items, min = 1, max = 6)
data <- data %>% bind_cols(use_intention_s1_scores$scores %>% as_tibble())
use_intention_s1_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average use intention score for diagnosis and treatment", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *use intention* in AI for *diagnosis and treatment* is **`r round(use_intention_s1_scores$alpha,2)`**
```{r use_intention_s2}
#| echo: false
use_intention_s2_items <- data %>% select(starts_with("bereitschaft_s2"))
use_intention_s2_keys <- list(use_intention_s2_scores = c(
"bereitschaft_s2_1",
"bereitschaft_s2_2",
"bereitschaft_s2_3",
"-bereitschaft_s2_4",
"bereitschaft_s2_5",
"bereitschaft_s2_6",
"-bereitschaft_s2_7",
"bereitschaft_s2_8"))
use_intention_s2_scores <- psych::scoreItems(use_intention_s2_keys, use_intention_s2_items, min = 1, max = 6)
data <- data %>% bind_cols(use_intention_s2_scores$scores %>% as_tibble())
use_intention_s2_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average use intention score for diagnosis and treatment", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *use intention* in AI for *prevention* is **`r round(use_intention_s2_scores$alpha,2)`**
## Trust scores
```{r trust_s1}
#| echo: false
trust_s1_items <- data %>% select(starts_with("vertrauen_s1"))
trust_s1_keys <- list(trust_s1_scores = c(
"vertrauen_s1_1",
"-vertrauen_s1_2",
"vertrauen_s1_3",
"-vertrauen_s1_4",
"-vertrauen_s1_5"
))
trust_s1_scores <- psych::scoreItems(trust_s1_keys, trust_s1_items, min = 1, max = 6)
data <- data %>% bind_cols(trust_s1_scores$scores %>% as_tibble())
trust_s1_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average use intention score for diagnosis and treatment", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *trust* in AI for *diagnosis and treatment* is **`r round(trust_s1_scores$alpha,2)`**
```{r trust_s2}
#| echo: false
trust_s2_items <- data %>% select(starts_with("vertrauen_s2"))
trust_s2_keys <- list(trust_s2_scores = c(
"vertrauen_s2_1",
"-vertrauen_s2_2",
"vertrauen_s2_3",
"-vertrauen_s2_4",
"-vertrauen_s2_5"
))
trust_s2_scores <- psych::scoreItems(trust_s2_keys, trust_s2_items, min = 1, max = 6)
data <- data %>% bind_cols(trust_s2_scores$scores %>% as_tibble())
trust_s2_scores$scores %>% psych::describe(fast = TRUE, ranges = FALSE) %>% kable(caption = "Average use intention score for diagnosis and treatment", digits = 2, row.names = FALSE) %>% kable_material()
```
The reliability of the scale *trust* in AI for *prevention and monitoring* is **`r round(trust_s2_scores$alpha,2)`**
# H1 - Multivariate Analysis of varience
## Step 1: demographics
```{r h1_step_1}
model_h1_step_1_s1 <- manova(cbind(use_intention_s1_scores, trust_s1_scores) ~ alter + geschlecht, data=data)
summary(model_h1_step_1_s1)
model_h1_step_1_s2 <- manova(cbind(use_intention_s2_scores, trust_s2_scores) ~ alter + geschlecht, data=data)
summary(model_h1_step_1_s2)
```
### Step 2: Demographics and personality traits
```{r h1_step_2}
model_h1_step_2_s1 <- manova(cbind(use_intention_s1_scores, trust_s1_scores) ~ alter + geschlecht + hypochondrie_scores + dangerous_world_scores + sensitivity_threat_scores + risikobereitschaft_1 + kusiv3_scores + control_scores, data=data)
summary(model_h1_step_2_s1)
model_h1_step_2_s2 <- manova(cbind(use_intention_s2_scores, trust_s2_scores) ~ alter + geschlecht + hypochondrie_scores + dangerous_world_scores + sensitivity_threat_scores + risikobereitschaft_1 + kusiv3_scores + control_scores, data=data)
summary(model_h1_step_2_s2)
```
### Model comparison
```{r model_comparison}
anova(model_h1_step_1_s1, model_h1_step_2_s1)
anova(model_h1_step_1_s2, model_h1_step_2_s2)
```
# H2 - Clustering
In this section we cluster based on:
- Believe in a dangerous world `dangerous_world_scores`
- Sensitivity to threat `sensitivity_threat_scores`
- Disposition to risk `risikobereitschaft_1`
- Interpersonal trust `kusiv3_scores`
```{r echo=FALSE}
# Choosing with which variables to cluster
clustering_variables <- data %>% select(dangerous_world_scores, sensitivity_threat_scores, risikobereitschaft_1, kusiv3_scores)
# Generating distance variables
distance_matrix <- dist(clustering_variables, method = "euclidean")
# Cluster
cluster_analysis <- hclust(distance_matrix, "ward.D2")
# Plot dendogram
fviz_dend(cluster_analysis, cex = 0.1, lwd = 0.4, rect = TRUE,
main = "Clustering dendogram",
k = 3,
k_colors = c("#006d77", "#ef476f", "#74C69D"),
color_labels_by_k = TRUE,
ggtheme = theme_dissertation(),
)
```
## Deeper analysis
```{r echo=FALSE}
cluster_analysis_detail <- NbClust(clustering_variables, distance = "euclidean", min.nc = 2, max.nc = 8, method = "complete", index = "all")
```
```{r echo=FALSE}
data$cluster <- cutree(cluster_analysis, k=3)
```
## Cluster description
### Cluster distribution
```{r echo=FALSE}
questionr::freq(data$cluster) %>% kable(caption = "Cluster distribution in dataset") %>% kable_material()
```
### Descriptive statistics by cluster
```{r}
psych::describe.by(x = data %>% select(kusiv3_scores, sensitivity_threat_scores, risikobereitschaft_1, dangerous_world_scores), group = data$cluster, mat = TRUE, fast=TRUE) %>% kable(caption = "Descriptive statistics for the various clusters", digits=2) %>% kable_material()
```
## Descriptives
```{r descriptives_h2}
psych::describe.by(x = data %>% select(use_intention_s1_scores, use_intention_s2_scores, trust_s1_scores, trust_s2_scores), group = data$cluster, mat = TRUE, fast=TRUE) %>% kable(caption = "Descriptive statistics for the various clusters", digits=2) %>% kable_material()
```
## Inference
### Use Intention
```{r use_intention_anova}
pivot_longer(data, cols = c(use_intention_s1_scores,use_intention_s2_scores), names_to = "scenario", values_to = "use_intention_score") %>% select(response_id, use_intention_score, scenario, cluster) %>% mutate(cluster = as.factor(cluster)) %>% mutate(scenario = ifelse(scenario == "use_intention_s1_scores", "diagnostic", "prevention")) %>% mutate(scenario = as.factor(scenario))-> use_intention_scores_all
pivot_longer(data, cols = c(trust_s1_scores, trust_s2_scores), names_to = "scenario", values_to = "trust_score") %>% select(response_id, trust_score, scenario, cluster) %>% mutate(cluster = as.factor(cluster)) %>% mutate(scenario = ifelse(scenario == "trust_s1_scores", "diagnostic", "prevention")) %>% mutate(scenario = as.factor(scenario)) -> trust_scores_all
left_join(use_intention_scores_all, trust_scores_all) %>% mutate(response_id = as.factor(response_id)) -> data_h2
use_intention_anova <- aov(use_intention_score ~ scenario * cluster + Error(response_id/scenario), data = data_h2)
summary(use_intention_anova)
ui_s1_aov <- aov(trust_s2_scores ~ as.factor(cluster), data=data)
pairs(emmeans(ui_s1_aov, ~ cluster), adjust = "bonferroni")
cluster_post_hoc <- emmeans(use_intention_anova, ~ cluster)
pairs(cluster_post_hoc, adjust = "bonferroni")
```
### Trust
```{r trust-anova}
trust_anova <- aov(trust_score ~ scenario * cluster + Error(response_id/scenario), data = data_h2)
summary(trust_anova)
cluster_post_hoc <- emmeans(trust_anova, ~ cluster)
pairs(cluster_post_hoc, adjust = "bonferroni")
```
# H3 - Human Factors
## Individual risk level
**-> No significant difference found for risk group!**
```{r risk_level}
data %>% mutate(risikogruppe_1 = replace_na(risikogruppe_1,0)) %>% mutate(risk_group = ifelse(risikogruppe_1 == 1, "not risk patient", "risk patient")) -> data
pivot_longer(data, cols = c(use_intention_s1_scores,use_intention_s2_scores), names_to = "scenario", values_to = "use_intention_score") %>% select(response_id, use_intention_score, scenario, risk_group) %>% mutate(scenario = ifelse(scenario == "use_intention_s1_scores", "diagnostic", "prevention")) %>% mutate(scenario = as.factor(scenario)) %>% mutate(risk_group = as.factor(risk_group))-> use_intention_scores_h3
pivot_longer(data, cols = c(trust_s1_scores, trust_s2_scores), names_to = "scenario", values_to = "trust_score") %>% select(response_id, trust_score, scenario, risk_group) %>% mutate(scenario = ifelse(scenario == "trust_s1_scores", "diagnostic", "prevention")) %>% mutate(scenario = as.factor(scenario)) %>% mutate(risk_group = as.factor(risk_group))-> trust_scores_h3
risk_group_anova <- aov(use_intention_score ~ scenario * risk_group + Error(response_id/scenario), data = use_intention_scores_h3)
summary(risk_group_anova)
risk_group_anova <- aov(trust_score ~ scenario * risk_group + Error(response_id/scenario), data = trust_scores_h3)
summary(risk_group_anova)
```
## Health status
**-> No significant difference found for risk group!**
```{r health-status}
#| echo: false
data %>% mutate(gesundheit = ifelse(gesundheit_3 == 1, "chronisch", "nicht krank")) %>% mutate(gesundheit = as.factor(gesundheit)) %>% mutate(gesundheit = replace_na(gesundheit, "nicht krank")) -> data
```
# H4 - Model continuation
## scenario 1
```{r h4_regression_s1}
data %>% mutate(erfahrung_ki_collapsed = ifelse(erfahrung_ki == 1, 0, 1)) %>% mutate(erfahrung_ki_collapsed = as.factor(erfahrung_ki_collapsed)) -> data
model_h4_step_3_s1 <- manova(cbind(use_intention_s1_scores, trust_s1_scores) ~ alter + geschlecht + hypochondrie_scores + dangerous_world_scores + sensitivity_threat_scores + risikobereitschaft_1 + kusiv3_scores + control_scores + erfahrung_ki_collapsed + trust_ai_scores, data=data)
summary(model_h4_step_3_s1)
```
## Scenario 2
```{r h4_regression_s2}
model_h4_step_3_s2 <- manova(cbind(use_intention_s2_scores, trust_s2_scores) ~ alter + geschlecht + hypochondrie_scores + dangerous_world_scores + sensitivity_threat_scores + risikobereitschaft_1 + kusiv3_scores + control_scores + erfahrung_ki_collapsed + trust_ai_scores, data=data)
summary(model_h4_step_3_s2)
```
## Model comparison
```{r model_comparison_step_3}
anova(model_h1_step_2_s1, model_h4_step_3_s1)
anova(model_h1_step_2_s2, model_h4_step_3_s2)
anova(model_h1_step_1_s1, model_h4_step_3_s1)
anova(model_h1_step_1_s2, model_h4_step_3_s2)
```
# Data visualisation
```{r data_visualisation}
left_join(pivot_longer(data, cols = c(trust_s1_scores, trust_s2_scores), names_to = "Scenario", values_to = "Trust score") %>% select(response_id, Scenario, `Trust score`) %>% mutate(Scenario = ifelse(Scenario == "trust_s1_scores", "Diagnostic & Treatment", "Prevention & Monitoring")),pivot_longer(data, cols = c(use_intention_s1_scores, use_intention_s2_scores), names_to = "Scenario", values_to = "Use intention score") %>% select(response_id, Scenario, `Use intention score`) %>% mutate(Scenario = ifelse(Scenario == "use_intention_s1_scores", "Diagnostic & Treatment", "Prevention & Monitoring"))) -> plot_data
plot_data %>% pivot_longer(cols=c(`Use intention score`,`Trust score`), names_to = "Variable", values_to = "Score") -> plot_data
mean_data <- plot_data %>%
group_by(Variable, Scenario) %>%
summarise(
mean_score = mean(Score, na.rm = TRUE),
.groups = "drop"
)
plot_data %>%
ggplot(
aes(x = Variable, y = Score, fill = Scenario)
) +
geom_violin(
position = "identity", # <-- overlap instead of dodge
alpha = 0.5,
trim = FALSE
) +
# (Optional) a little boxplot in the middle
geom_boxplot(
width = 0.15,
position = position_dodge(width = .2),
outlier.size = 0.7,
alpha = 0.5
) +
stat_summary(
fun = mean,
geom = "crossbar",
width = 0.1, # length of the horizontal bar
colour = "#ef476f",
fatten = 0.5,
position = position_dodge(width = 0.6)
) +
# mean label next to the line
geom_text(
data = mean_data,
aes(
x = Variable,
y = mean_score,
label = round(mean_score, 2),
group = Scenario
),
position = position_dodge(width = 1),
hjust = 0.55, # move text slightly to the right of the line
vjust = 0.5,
size = 3,
colour = "#2F3E46"
) +
# CI bars for the mean
stat_summary(
fun.data = mean_cl_normal, # mean +/- normal-theory CI
geom = "errorbar",
width = 0.15,
size = .1,
position = position_dodge(width = 0.6),
colour = "#ef476f"
) +
labs(
x = NULL,
y = "Score",
fill = NULL
) +
scale_fill_manual(values = c("#457b9d", "#FBBF77")) +
guides(fill = guide_legend(override.aes = list(colour = NA, linetype = 0))) +
theme_dissertation()+
theme(
panel.grid.minor = element_blank(),
axis.title.x = element_blank(),
legend.position = "top",
text = element_text(family = "Futura")
)
ggsave("exports/sting_ray_plots.png", width = 14, height = 9, units = "cm", scale = 1.25)
ggsave("exports/sting_ray_plots.svg", width = 14, height = 9, units = "cm", scale = 1.25)
```
```{r export}
data %>% select(response_id, trust_s1_scores, trust_s2_scores, med_personal) %>% write_csv("exports/expample_data.csv")
write_csv(plot_data, "exports/plot_data.csv")
left_join(pivot_longer(data, cols = c(trust_s1_scores, trust_s2_scores), names_to = "Scenario", values_to = "Trust score") %>% select(response_id, Scenario, `Trust score`) %>% mutate(Scenario = ifelse(Scenario == "trust_s1_scores", "Diagnostic & Treatment", "Prevention & Monitoring")),pivot_longer(data, cols = c(use_intention_s1_scores, use_intention_s2_scores), names_to = "Scenario", values_to = "Use intention score") %>% select(response_id, Scenario, `Use intention score`) %>% mutate(Scenario = ifelse(Scenario == "use_intention_s1_scores", "Diagnostic & Treatment", "Prevention & Monitoring"))) -> multi_set
write_csv(multi_set, "exports/multiset.csv")
```