library(tidyverse)
library(afex)
library(car)
library(emmeans)
library(ggplot2)
library(psych)
data <- read.csv('/Users/sophiajaletfasihi/Desktop/Psychologie /6. /Empirische Forschung /Instagram /Daten /resultssurvey211595r.csv')
data <- data[!is.na(data$G03Q34), ]
data$id <- 1:nrow(data)
numeric_vars <- c(
"Q1before.SQ001.", "Q1before.SQ002.",
"Q2before.SQ001.", "Q2before.SQ002.",
"Q3before.SQ001.", "Q3before.SQ002.",
"Q4before.SQ001.", "Q4before.SQ002.",
"Q1after.SQ001.", "Q1after.SQ002.",
"Q2after.SQ001.", "Q2after.SQ002.",
"Q3after.SQ001.", "Q3after.SQ002.",
"Q4after.SQ001.", "Q4after.SQ002."
)
for(v in numeric_vars){
data[[v]] <- as.numeric(gsub("[^0-9.]", "", data[[v]]))
}
data$randomization <- factor(
data$randomization,
levels = c(1, 2),
labels = c("Low evocative", "High evocative")
)
Frequency and intensity were first combined for each item. Then, an overall inspiration score was calculated separately for T1 and T2.
data$v_pre_1 <- rowMeans(data[, c("Q1before.SQ001.", "Q1before.SQ002.")], na.rm = TRUE)
data$v_pre_2 <- rowMeans(data[, c("Q2before.SQ001.", "Q2before.SQ002.")], na.rm = TRUE)
data$v_pre_3 <- rowMeans(data[, c("Q3before.SQ001.", "Q3before.SQ002.")], na.rm = TRUE)
data$v_pre_4 <- rowMeans(data[, c("Q4before.SQ001.", "Q4before.SQ002.")], na.rm = TRUE)
data$v_pre <- rowMeans(data[, c(
"v_pre_1",
"v_pre_2",
"v_pre_3",
"v_pre_4"
)], na.rm = TRUE)
data$v_post_1 <- rowMeans(data[, c("Q1after.SQ001.", "Q1after.SQ002.")], na.rm = TRUE)
data$v_post_2 <- rowMeans(data[, c("Q2after.SQ001.", "Q2after.SQ002.")], na.rm = TRUE)
data$v_post_3 <- rowMeans(data[, c("Q3after.SQ001.", "Q3after.SQ002.")], na.rm = TRUE)
data$v_post_4 <- rowMeans(data[, c("Q4after.SQ001.", "Q4after.SQ002.")], na.rm = TRUE)
data$v_post <- rowMeans(data[, c(
"v_post_1",
"v_post_2",
"v_post_3",
"v_post_4"
)], na.rm = TRUE)
alpha(data[, c(
"v_pre_1",
"v_pre_2",
"v_pre_3",
"v_pre_4"
)])
## Number of categories should be increased in order to count frequencies.
##
## Reliability analysis
## Call: alpha(x = data[, c("v_pre_1", "v_pre_2", "v_pre_3", "v_pre_4")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.88 0.88 0.85 0.64 7 0.021 5 0.92 0.61
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.83 0.88 0.91
## Duhachek 0.83 0.88 0.92
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## v_pre_1 0.84 0.84 0.78 0.63 5.1 0.030 0.00711 0.62
## v_pre_2 0.87 0.87 0.83 0.68 6.5 0.024 0.00696 0.71
## v_pre_3 0.85 0.85 0.80 0.66 5.7 0.027 0.00660 0.62
## v_pre_4 0.80 0.80 0.73 0.58 4.1 0.036 0.00076 0.59
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## v_pre_1 90 0.86 0.86 0.80 0.75 4.9 1.0
## v_pre_2 90 0.80 0.81 0.70 0.66 5.1 1.0
## v_pre_3 90 0.84 0.84 0.76 0.71 5.0 1.1
## v_pre_4 90 0.91 0.91 0.88 0.82 4.8 1.2
alpha(data[, c(
"v_post_1",
"v_post_2",
"v_post_3",
"v_post_4"
)])
## Number of categories should be increased in order to count frequencies.
##
## Reliability analysis
## Call: alpha(x = data[, c("v_post_1", "v_post_2", "v_post_3", "v_post_4")])
##
## raw_alpha std.alpha G6(smc) average_r S/N ase mean sd median_r
## 0.89 0.89 0.88 0.68 8.4 0.019 4.8 0.95 0.67
##
## 95% confidence boundaries
## lower alpha upper
## Feldt 0.85 0.89 0.92
## Duhachek 0.85 0.89 0.93
##
## Reliability if an item is dropped:
## raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## v_post_1 0.85 0.85 0.80 0.66 5.8 0.027 0.0025 0.64
## v_post_2 0.86 0.86 0.81 0.67 6.2 0.025 0.0038 0.70
## v_post_3 0.87 0.88 0.84 0.70 7.2 0.023 0.0070 0.70
## v_post_4 0.86 0.86 0.82 0.68 6.3 0.027 0.0098 0.64
##
## Item statistics
## n raw.r std.r r.cor r.drop mean sd
## v_post_1 90 0.88 0.89 0.85 0.79 4.7 1.08
## v_post_2 90 0.86 0.87 0.83 0.77 4.9 0.96
## v_post_3 90 0.86 0.85 0.77 0.73 4.8 1.15
## v_post_4 90 0.88 0.87 0.82 0.77 4.7 1.18
The internal consistency of the inspiration scale was high at both measurement points. Cronbach’s alpha was α = .88 at T1 and α = .89 at T2.
data_long <- data %>%
select(id, randomization, v_pre, v_post) %>%
pivot_longer(
cols = c(v_pre, v_post),
names_to = "time",
values_to = "value"
)
data_long$time <- factor(
data_long$time,
levels = c("v_pre", "v_post"),
labels = c("T1", "T2")
)
descriptives <- data_long %>%
group_by(randomization, time) %>%
summarise(
n = n(),
mean = mean(value, na.rm = TRUE),
sd = sd(value, na.rm = TRUE),
.groups = "drop"
)
descriptives
## # A tibble: 4 × 5
## randomization time n mean sd
## <fct> <fct> <int> <dbl> <dbl>
## 1 Low evocative T1 37 5.01 0.909
## 2 Low evocative T2 37 4.62 1.10
## 3 High evocative T1 53 4.91 0.930
## 4 High evocative T2 53 4.87 0.820
The descriptive statistics showed that both groups had similar inspiration scores at baseline. In the low-evocative condition, inspiration decreased from T1 to T2, whereas inspiration in the high-evocative condition remained relatively stable.
lineplot <- ggplot(data_long,
aes(x = time,
y = value,
color = randomization,
group = randomization)) +
stat_summary(fun = mean,
geom = "line",
linewidth = 1.2) +
stat_summary(fun = mean,
geom = "point",
size = 3) +
labs(
title = "Inspiration Scores Over Time",
x = "Time",
y = "Inspiration Score",
color = "Condition"
) +
theme_minimal()
lineplot
boxplot <- ggplot(data_long,
aes(x = time,
y = value,
fill = randomization)) +
geom_boxplot() +
labs(
title = "Distribution of Inspiration Scores",
x = "Time",
y = "Inspiration Score",
fill = "Condition"
) +
theme_minimal()
boxplot
ggplot(data_long,
aes(x = time,
y = value,
group = id,
color = randomization)) +
geom_line(alpha = 0.3) +
stat_summary(aes(group = randomization),
fun = mean,
geom = "line",
linewidth = 1.5) +
labs(
title = "Individual Changes Over Time",
x = "Time",
y = "Inspiration Score",
color = "Condition"
) +
theme_minimal()
anova_model <- aov_ez(
id = "id",
dv = "value",
data = data_long,
within = "time",
between = "randomization"
)
## Contrasts set to contr.sum for the following variables: randomization
anova_model
## Anova Table (Type 3 tests)
##
## Response: value
## Effect df MSE F ges p.value
## 1 randomization 1, 88 1.55 0.16 .002 .694
## 2 time 1, 88 0.19 10.67 ** .013 .002
## 3 randomization:time 1, 88 0.19 7.10 ** .009 .009
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '+' 0.1 ' ' 1
The main effect of condition was not significant, F(1, 88) = 0.16, p = .694, ges = .002. This indicates that the two conditions did not differ overall in their inspiration scores.
There was a significant main effect of time, F(1, 88) = 10.67, p = .002, ges = .013, indicating that inspiration scores changed over time.
Most importantly, the interaction between time and condition was significant, F(1, 88) = 7.10, p = .009, ges = .009. This indicates that the change in inspiration over time differed between the low- and high-evocative conditions.
res <- residuals(anova_model$lm)
shapiro.test(res)
##
## Shapiro-Wilk normality test
##
## data: res
## W = 0.99121, p-value = 0.3403
The Shapiro-Wilk test was not significant, W = 0.99, p = .340, indicating that the residuals did not significantly deviate from normality.
qqnorm(res)
qqline(res)
Levene’s tests were conducted separately for T1 and T2.
leveneTest(
value ~ randomization,
data = subset(data_long, time == "T1")
)
## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 1 0.086 0.7701
## 88
leveneTest(
value ~ randomization,
data = subset(data_long, time == "T2")
)
## Levene's Test for Homogeneity of Variance (center = median)
## Df F value Pr(>F)
## group 1 1.8948 0.1722
## 88
Both Levene’s tests were non-significant, indicating that the assumption of homogeneity of variance was met at both time points.
emm_groups <- emmeans(
anova_model,
~ randomization | time
)
pairs(emm_groups)
## time = T1:
## contrast estimate SE df t.ratio p.value
## Low evocative - High evocative 0.103 0.197 88 0.522 0.6027
##
## time = T2:
## contrast estimate SE df t.ratio p.value
## Low evocative - High evocative -0.252 0.202 88 -1.245 0.2166
The post-hoc comparisons showed no significant difference between the conditions at T1, p = .603. This suggests that the two groups were comparable before the manipulation.
At T2, the difference between the low-evocative and high-evocative conditions was also not significant, p = .217.
emm_time <- emmeans(
anova_model,
~ time | randomization
)
pairs(emm_time)
## randomization = Low evocative:
## contrast estimate SE df t.ratio p.value
## T1 - T2 0.3953 0.1020 88 3.864 0.0002
##
## randomization = High evocative:
## contrast estimate SE df t.ratio p.value
## T1 - T2 0.0401 0.0855 88 0.469 0.6402
Within the low-evocative condition, inspiration significantly decreased from T1 to T2, p = .0002. In contrast, within the high-evocative condition, inspiration did not significantly change over time, p = .640.
ggsave("lineplot_inspiration.png",
plot = lineplot,
width = 7,
height = 5,
dpi = 300)
ggsave("boxplot_inspiration.png",
plot = boxplot,
width = 7,
height = 5,
dpi = 300)
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)
## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.