1. Setup

library(tidyverse)
library(afex)
library(car)
library(emmeans)
library(ggplot2)
library(psych)

2. Import Data

data <- read.csv('/Users/sophiajaletfasihi/Desktop/Psychologie /6. /Empirische Forschung /Instagram /Daten /resultssurvey211595r.csv')

3. Data Cleaning

data <- data[!is.na(data$G03Q34), ]

data$id <- 1:nrow(data)

4. Convert Variables to Numeric Format

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]]))
}

5. Condition Variable

data$randomization <- factor(
  data$randomization,
  levels = c(1, 2),
  labels = c("Low evocative", "High evocative")
)

6. Compute Inspiration Scores

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)

7. Reliability Analysis

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.

8. Long Format Data

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")
)

9. Descriptive Statistics

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.

10. Visualisations

10.1 Mean Inspiration Scores Over Time

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

10.2 Distribution of Inspiration Scores

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

10.3 Individual Changes Over Time

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()

11. Mixed ANOVA

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.

12. Assumption Checks

12.1 Normality of Residuals

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)

12.2 Homogeneity of Variance

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.

13. Post-hoc Tests

13.1 Group Differences at Each Time Point

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.

13.2 Time Differences Within Each Condition

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.

14. Save Plots

ggsave("lineplot_inspiration.png",
       plot = lineplot,
       width = 7,
       height = 5,
       dpi = 300)

ggsave("boxplot_inspiration.png",
       plot = boxplot,
       width = 7,
       height = 5,
       dpi = 300)

R Markdown

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

Including Plots

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.