Dual task pilot
# IfADO ReStoWa Dual Task Pilot analysis
# Dual task pilot
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.2.3
## Warning: package 'tidyr' was built under R version 4.2.3
## Warning: package 'readr' was built under R version 4.2.3
## Warning: package 'dplyr' was built under R version 4.2.3
## Warning: package 'stringr' was built under R version 4.2.3
## Warning: package 'forcats' was built under R version 4.2.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── 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(lme4)
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
##
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
library(car)
## Loading required package: carData
##
## Attaching package: 'car'
##
## The following object is masked from 'package:dplyr':
##
## recode
##
## The following object is masked from 'package:purrr':
##
## some
library(dplyr)
library(emmeans)
## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'
library(effects)
## Warning: package 'effects' was built under R version 4.2.3
## lattice theme set by effectsTheme()
## See ?effectsTheme for details.
library(patchwork)
# nasa and performance measures
nasa <- read_excel("ReStoWa_DTPilot_surveys.xlsx", sheet = 4)
performance <- read_excel("ReStoWa_DTPilot_performance.xlsx", sheet = 2)
## New names:
## • `` -> `...10`
## • `` -> `...11`
## • `` -> `...12`
## • `` -> `...13`
# data cleaning
# remove comments and left over columns
# performance data cleaning
performance <- performance %>% select(1:7) %>% slice(1:18)
performance <- performance %>% filter(!str_starts(Round, "6"))
performance <- performance %>%
mutate(ID = as.numeric(str_sub(Round, 1, 1))) %>%
select(-Round)
str(performance)
## tibble [16 × 7] (S3: tbl_df/tbl/data.frame)
## $ 0,8_motor: chr [1:16] "72" "54.7" "48.57" "52.51" ...
## $ 0,8_cog : chr [1:16] "44" "58.56" "51.35" "48.65" ...
## $ 0,9_motor: chr [1:16] "54.79" "39.03" "19.37" "38.229999999999997" ...
## $ 0,9_cog : chr [1:16] "60.36" "63.06" "51.35" "47.75" ...
## $ 1,0_motor: chr [1:16] "39.1" "39.5" "19.87" "18.23" ...
## $ 1,0_cog : chr [1:16] "59.46" "55.86" "54.05" "45.05" ...
## $ ID : num [1:16] 1 1 2 2 3 3 4 4 5 5 ...
performance <- performance %>%
mutate(across(-ID, as.numeric))
performance$ID <- as.factor(performance$ID)
performance <- performance %>%
rowwise() %>%
mutate(
mean_0.8 = mean(c_across(c(`0,8_motor`, `0,8_cog`)), na.rm = TRUE),
mean_0.9 = mean(c_across(c(`0,9_motor`, `0,9_cog`)), na.rm = TRUE),
mean_1.0 = mean(c_across(c(`1,0_motor`, `1,0_cog`)), na.rm = TRUE)
) %>%
ungroup()
performance_long <- performance %>%
select(ID, starts_with("mean_")) %>%
pivot_longer(
cols = starts_with("mean_"),
names_to = "Speed",
names_prefix = "mean_",
values_to = "Accuracy"
) %>%
mutate(Speed = as.numeric(Speed))
# performance models
str(performance_long)
## tibble [48 × 3] (S3: tbl_df/tbl/data.frame)
## $ ID : Factor w/ 8 levels "1","2","3","4",..: 1 1 1 1 1 1 2 2 2 2 ...
## $ Speed : num [1:48] 0.8 0.9 1 0.8 0.9 1 0.8 0.9 1 0.8 ...
## $ Accuracy: num [1:48] 58 57.6 49.3 56.6 51 ...
performance_long$Speed <- as.factor(performance_long$Speed)
perf_model <- lmer(Accuracy ~ Speed + (1|ID), data = performance_long, REML = FALSE)
Anova(perf_model)
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: Accuracy
## Chisq Df Pr(>Chisq)
## Speed 83.615 2 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#summary(single_task_model)
perf_emmeans <- emmeans(perf_model, pairwise ~ Speed)
print(perf_emmeans)
## $emmeans
## Speed emmean SE df lower.CL upper.CL
## 0.8 57.1 2.83 11.2 50.9 63.3
## 0.9 48.2 2.83 11.2 42.0 54.4
## 1 44.4 2.83 11.2 38.2 50.6
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df t.ratio p.value
## Speed0.8 - Speed0.9 8.9 1.46 42.1 6.087 <.0001
## Speed0.8 - Speed1 12.7 1.46 42.1 8.682 <.0001
## Speed0.9 - Speed1 3.8 1.46 42.1 2.595 0.0340
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 3 estimates
perf_effects <- allEffects(perf_model)
perf_effects_model <- as.data.frame(perf_effects[[1]])
perf_effects_plot <- ggplot(perf_effects_model, aes(x = Speed, y = fit)) +
geom_errorbar(aes(ymin = fit - se, ymax = fit + se, color = Speed, width = 0.5), size = 1) +
geom_point(aes(colour = Speed), size = 3) +
scale_color_manual(values = c("0.8" = "green", "0.9" = "tomato", "1" = "blue")) +
scale_x_discrete(labels = c("0,8" = "0.8", "0,9" = "0.9", "1" = "1.0")) +
ylab("Mean Accuracy across both Tasks in (%)") +
xlab("Treadmill Speeds in (m/s)")
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
plot(perf_effects_plot)
# nasa cleaning
nasa <- nasa %>% filter(ID != 6)
nasa <- nasa %>%
rowwise() %>%
mutate(
mean_0.8 = mean(c_across(starts_with("0.8_")), na.rm = TRUE),
mean_0.9 = mean(c_across(starts_with("0.9_")), na.rm = TRUE),
mean_1.0 = mean(c_across(starts_with("1.0_")), na.rm = TRUE)
) %>%
ungroup()
str(nasa)
## tibble [16 × 25] (S3: tbl_df/tbl/data.frame)
## $ ID : num [1:16] 1 1 2 2 3 3 4 4 5 5 ...
## $ 0.8_1 : num [1:16] 16 19 16 15 16 16 7 5 12 12 ...
## $ 0.8_2 : num [1:16] 13 17 12 16 17 16 1 1 16 12 ...
## $ 0.8_3 : num [1:16] 17 17 15 10 12 11 4 5 13 11 ...
## $ 0.8_4 : num [1:16] 10 16 9 14 11 9 5 7 10 13 ...
## $ 0.8_5 : num [1:16] 15 20 18 16 14 14 7 4 16 15 ...
## $ 0.8_6 : num [1:16] 12 17 18 10 13 13 4 4 8 13 ...
## $ 0.8_7 : num [1:16] 9 14 16 14 16 17 2 3 18 18 ...
## $ 0.9_1 : num [1:16] 15 18 18 16 17 16 12 6 14 13 ...
## $ 0.9_2 : num [1:16] 15 16 18 18 15 17 1 1 12 16 ...
## $ 0.9_3 : num [1:16] 13 16 14 8 16 12 10 7 11 13 ...
## $ 0.9_4 : num [1:16] 12 18 9 12 14 7 9 8 17 12 ...
## $ 0.9_5 : num [1:16] 14 19 16 12 16 15 6 7 14 14 ...
## $ 0.9_6 : num [1:16] 10 16 18 12 13 11 6 5 14 13 ...
## $ 0.9_7 : num [1:16] 14 13 16 14 13 14 4 5 14 15 ...
## $ 1.0_1 : num [1:16] 17 17 18 16 12 14 8 6 14 14 ...
## $ 1.0_2 : num [1:16] 17 17 18 16 14 14 1 1 9 15 ...
## $ 1.0_3 : num [1:16] 17 19 14 10 11 11 5 6 5 12 ...
## $ 1.0_4 : num [1:16] 15 17 8 10 11 10 6 8 11 14 ...
## $ 1.0_5 : num [1:16] 18 17 14 16 15 15 10 8 14 15 ...
## $ 1.0_6 : num [1:16] 16 15 16 18 13 11 5 7 10 12 ...
## $ 1.0_7 : num [1:16] 12 13 18 16 11 13 6 5 18 17 ...
## $ mean_0.8: num [1:16] 13.1 17.1 14.9 13.6 14.1 ...
## $ mean_0.9: num [1:16] 13.3 16.6 15.6 13.1 14.9 ...
## $ mean_1.0: num [1:16] 16 16.4 15.1 14.6 12.4 ...
nasa <- nasa %>%
mutate(
ID = as.factor(ID)
)
nasa_long <- nasa %>%
pivot_longer(
cols = starts_with("mean_"),
names_to = c("Speed"),
names_prefix = "mean_",
values_to = "nasa_score"
)
# nasa linear mixed models
nasa_model <- lmer(nasa_score ~ Speed + (1|ID), data = nasa_long, REML = FALSE)
Anova(nasa_model)
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: nasa_score
## Chisq Df Pr(>Chisq)
## Speed 0.5423 2 0.7625
#summary(single_task_model)
nasa_emmeans <- emmeans(nasa_model, pairwise ~ Speed)
print(nasa_emmeans)
## $emmeans
## Speed emmean SE df lower.CL upper.CL
## 0.8 11.0 1.37 10.4 7.98 14.1
## 0.9 11.4 1.37 10.4 8.34 14.4
## 1.0 11.4 1.37 10.4 8.34 14.4
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df t.ratio p.value
## Speed0.8 - Speed0.9 -0.357 0.575 42.1 -0.622 0.8091
## Speed0.8 - Speed1.0 -0.357 0.575 42.1 -0.622 0.8091
## Speed0.9 - Speed1.0 0.000 0.575 42.1 0.000 1.0000
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 3 estimates
nasa_effects <- allEffects(nasa_model)
nasa_effects_model <- as.data.frame(nasa_effects[[1]])
nasa_effects_plot <- ggplot(nasa_effects_model, aes(x = Speed, y = fit, color = Speed)) +
geom_point(size = 3) +
geom_errorbar(aes(ymin = fit - se, ymax = fit + se), width = 0.5, size = 1.5) +
scale_color_manual(values = c("0.8" = "green", "0.9" = "tomato", "1.0" = "blue")) +
ylab("Mean NASA-TLX score (1–20)") +
xlab("Treadmill Speed in (m/s)") +
theme_minimal()
plot(nasa_effects_plot)
# merge into single plot with performance on the left and nasa on the right
combined_plot <- perf_effects_plot + nasa_effects_plot + plot_layout(ncol = 2) +
plot_annotation(tag_levels = "A", tag_suffix = ")")
combined_plot
ggsave("../../ReStoWa/MasterThesis/Graphs/dualt_task_pilot.jpg", combined_plot, width = 11, height = 4, dpi = 300)