Walking task only 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(dplyr)
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(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)
library(knitr)
# Accuracy metrics
walkingPilot <- read_excel("WalkingPilotConditions.xlsx", sheet = 2)
## New names:
## • `` -> `...4`
## • `` -> `...9`
## • `` -> `...10`
## • `` -> `...12`
## • `` -> `...13`
walkingPilot <- walkingPilot %>%
mutate(condition = case_when(
grepl("short", walkingPilot$`VP/Speed`, ignore.case = TRUE) ~ "short",
grepl("normal", walkingPilot$`VP/Speed`, ignore.case = TRUE) ~ "normal",
grepl("long", walkingPilot$`VP/Speed`, ignore.case = TRUE) ~ "long",
TRUE ~ NA_character_
))
walkingPilot$condition <- factor(walkingPilot$condition, levels = c("short", "normal", "long"))
walkingPilot <- walkingPilot %>% select( "VP/Speed", '0.8', '0.9', '1', condition)
walkingPilot <- na.omit(walkingPilot)
# removing outliers (VPs: 5 (highest acc: 24%) + 7 highest acc: 43%)
walkingPilot <- walkingPilot %>% filter(!grepl("^5|^7", `VP/Speed`))
# long format transformation
walkingPilot_long <- walkingPilot %>%
rename(
ID = 1,
Speed_0.8 = 2,
Speed_0.9 = 3,
Speed_1.0 = 4,
Condition = 5
) %>%
pivot_longer(
cols = starts_with("Speed_"),
names_to = "Speed",
values_to = "Accuracy") %>%
mutate(
Speed = as.numeric(str_remove(Speed, "Speed_")),
Condition = as.factor(Condition)
)
plot_walking_pilot_conditions <- walkingPilot_long %>%
group_by(Speed, Condition) %>%
summarise(mean_acc = mean(Accuracy, na.rm = TRUE),
se = sd(Accuracy, na.rm = TRUE)/sqrt(n())) %>%
ggplot(aes(x = factor(Speed), y = mean_acc, fill = Condition)) +
geom_col(position = position_dodge(0.8), width = 0.7) +
geom_errorbar(aes(ymin = mean_acc - se, ymax = mean_acc + se),
width = 0.2, position = position_dodge(0.8)) +
labs(x = "Treadmill Speed in (m/s)",
y = "Mean Accuracy in (%)",
fill = "Step Distance") +
scale_color_discrete(labels = c(
"short" = "Short",
"normal" = "Normal",
"long" = "Long"
)) +
theme_minimal()
## `summarise()` has grouped output by 'Speed'. You can override using the
## `.groups` argument.
summary_table <- walkingPilot_long %>%
group_by(Speed, Condition) %>%
summarise(
mean_acc = mean(Accuracy, na.rm = TRUE),
sd = sd(Accuracy, na.rm = TRUE),
n = sum(!is.na(Accuracy)),
se = sd / sqrt(n),
.groups = "drop"
)
print(summary_table)
## # A tibble: 9 × 6
## Speed Condition mean_acc sd n se
## <dbl> <fct> <dbl> <dbl> <int> <dbl>
## 1 0.8 short 71.6 21.1 8 7.47
## 2 0.8 normal 75.4 10.6 8 3.74
## 3 0.8 long 69.1 19.9 8 7.04
## 4 0.9 short 58.7 19.8 8 6.99
## 5 0.9 normal 63.7 16.1 8 5.71
## 6 0.9 long 62.2 12.9 8 4.57
## 7 1 short 44.0 21.0 8 7.41
## 8 1 normal 45.3 18.0 8 6.36
## 9 1 long 57.9 14.9 8 5.26
# clearing up IDs to match across different conditions
walkingPilot_long <- walkingPilot_long %>%
mutate(ID = sub("_.*", "", ID))
str(walkingPilot_long)
## tibble [72 × 4] (S3: tbl_df/tbl/data.frame)
## $ ID : chr [1:72] "1" "1" "1" "1" ...
## $ Condition: Factor w/ 3 levels "short","normal",..: 1 1 1 2 2 2 3 3 3 1 ...
## $ Speed : num [1:72] 0.8 0.9 1 0.8 0.9 1 0.8 0.9 1 0.8 ...
## $ Accuracy : num [1:72] 91 85.6 48.8 87.6 85.1 ...
walkingPilot_long$Speed <- as.factor(walkingPilot_long$Speed)
walkingPilot_long$ID <- as.factor(walkingPilot_long$ID)
# linear mixed model
single_task_model <- lmer(Accuracy ~ Speed * Condition + (1|ID), data = walkingPilot_long, REML = FALSE)
Anova(single_task_model) # Speed significantly affected performance
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: Accuracy
## Chisq Df Pr(>Chisq)
## Speed 52.252 2 4.504e-12 ***
## Condition 2.576 2 0.2758
## Speed:Condition 7.421 4 0.1152
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#summary(single_task_model)
single_task_emmeans <- emmeans(single_task_model, pairwise ~ Speed * Condition)
print(single_task_emmeans)
## $emmeans
## Speed Condition emmean SE df lower.CL upper.CL
## 0.8 short 71.6 6.19 24.2 58.8 84.3
## 0.9 short 58.7 6.19 24.2 45.9 71.5
## 1 short 44.0 6.19 24.2 31.2 56.7
## 0.8 normal 75.4 6.19 24.2 62.7 88.2
## 0.9 normal 63.7 6.19 24.2 51.0 76.5
## 1 normal 45.3 6.19 24.2 32.6 58.1
## 0.8 long 69.1 6.19 24.2 56.3 81.9
## 0.9 long 62.2 6.19 24.2 49.5 75.0
## 1 long 57.9 6.19 24.2 45.1 70.7
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df t.ratio p.value
## Speed0.8 short - Speed0.9 short 12.870 5.89 73.1 2.185 0.4262
## Speed0.8 short - Speed1 short 27.608 5.89 73.1 4.687 0.0004
## Speed0.8 short - Speed0.8 normal -3.857 5.89 73.1 -0.655 0.9992
## Speed0.8 short - Speed0.9 normal 7.835 5.89 73.1 1.330 0.9189
## Speed0.8 short - Speed1 normal 26.242 5.89 73.1 4.455 0.0009
## Speed0.8 short - Speed0.8 long 2.491 5.89 73.1 0.423 1.0000
## Speed0.8 short - Speed0.9 long 9.328 5.89 73.1 1.584 0.8105
## Speed0.8 short - Speed1 long 13.679 5.89 73.1 2.322 0.3428
## Speed0.9 short - Speed1 short 14.738 5.89 73.1 2.502 0.2483
## Speed0.9 short - Speed0.8 normal -16.727 5.89 73.1 -2.840 0.1216
## Speed0.9 short - Speed0.9 normal -5.035 5.89 73.1 -0.855 0.9946
## Speed0.9 short - Speed1 normal 13.373 5.89 73.1 2.270 0.3734
## Speed0.9 short - Speed0.8 long -10.379 5.89 73.1 -1.762 0.7063
## Speed0.9 short - Speed0.9 long -3.542 5.89 73.1 -0.601 0.9996
## Speed0.9 short - Speed1 long 0.809 5.89 73.1 0.137 1.0000
## Speed1 short - Speed0.8 normal -31.465 5.89 73.1 -5.342 <.0001
## Speed1 short - Speed0.9 normal -19.773 5.89 73.1 -3.357 0.0322
## Speed1 short - Speed1 normal -1.365 5.89 73.1 -0.232 1.0000
## Speed1 short - Speed0.8 long -25.116 5.89 73.1 -4.264 0.0018
## Speed1 short - Speed0.9 long -18.280 5.89 73.1 -3.103 0.0638
## Speed1 short - Speed1 long -13.929 5.89 73.1 -2.365 0.3189
## Speed0.8 normal - Speed0.9 normal 11.693 5.89 73.1 1.985 0.5585
## Speed0.8 normal - Speed1 normal 30.100 5.89 73.1 5.110 0.0001
## Speed0.8 normal - Speed0.8 long 6.349 5.89 73.1 1.078 0.9757
## Speed0.8 normal - Speed0.9 long 13.185 5.89 73.1 2.238 0.3928
## Speed0.8 normal - Speed1 long 17.536 5.89 73.1 2.977 0.0877
## Speed0.9 normal - Speed1 normal 18.407 5.89 73.1 3.125 0.0604
## Speed0.9 normal - Speed0.8 long -5.344 5.89 73.1 -0.907 0.9919
## Speed0.9 normal - Speed0.9 long 1.492 5.89 73.1 0.253 1.0000
## Speed0.9 normal - Speed1 long 5.844 5.89 73.1 0.992 0.9855
## Speed1 normal - Speed0.8 long -23.751 5.89 73.1 -4.032 0.0040
## Speed1 normal - Speed0.9 long -16.915 5.89 73.1 -2.872 0.1129
## Speed1 normal - Speed1 long -12.564 5.89 73.1 -2.133 0.4597
## Speed0.8 long - Speed0.9 long 6.836 5.89 73.1 1.161 0.9621
## Speed0.8 long - Speed1 long 11.188 5.89 73.1 1.899 0.6164
## Speed0.9 long - Speed1 long 4.351 5.89 73.1 0.739 0.9980
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 9 estimates
single_task_effects <- allEffects(single_task_model)
single_task_effects_model <- as.data.frame(single_task_effects[[1]])
single_task_plot <- ggplot(single_task_effects_model, aes(x = Speed, y = fit, color = Condition, linetype = Condition)) +
geom_path(aes(group = Condition), size = 1) +
geom_point(size = 3) +
scale_color_manual(values = c("short" = "green", "normal" = "tomato", "long" = "blue")) +
scale_linetype_manual(values = c("short" = "dashed", "normal" = "solid", "long" = "dashed")) +
scale_x_discrete(labels = c("1" = "1.0")) +
ylab("Mean Accuracy 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(single_task_plot)
# Subjective ratings
NASA_pilot <- read_excel("ReStoWa_WalkingPilot_NASA-TLX.xlsx", n_max = 10)
## New names:
## • `` -> `...1`
NASA_pilot <- NASA_pilot %>% rename(VP = ...1)
# remove outliers to keep consistent with performance data
NASA_pilot <- NASA_pilot %>% filter(VP != "pilot_05", VP != "pilot_07")
# replace NAs with average score 10 to keep pilot_06
NASA_pilot <- NASA_pilot %>%
mutate(across(everything(), ~ replace_na(.x, 10)))
# summarise per walking speed
NASA_pilot <- NASA_pilot %>%
mutate(short_0.8 = rowMeans(select(., starts_with("short_0.8")), na.rm = TRUE),
normal_0.8 = rowMeans(select(., starts_with("normal_0.8")), na.rm = TRUE),
long_0.8 = rowMeans(select(., starts_with("long_0.8")), na.rm = TRUE),
short_0.9 = rowMeans(select(., starts_with("short_0.9")), na.rm = TRUE),
normal_0.9 = rowMeans(select(., starts_with("normal_0.9")), na.rm = TRUE),
long_0.9 = rowMeans(select(., starts_with("long_0.9")), na.rm = TRUE),
short_1.0 = rowMeans(select(., starts_with("short_1.0")), na.rm = TRUE),
normal_1.0 = rowMeans(select(., starts_with("normal_1.0")), na.rm = TRUE),
long_1.0 = rowMeans(select(., starts_with("long_1.0")), na.rm = TRUE)
)
NASA_pilot <- NASA_pilot %>%
rename(ID = VP)
NASA_TLX_long <- NASA_pilot %>%
pivot_longer(cols = -ID,
names_to = c("Condition", "Speed"),
names_sep = "_",
values_to = "nasa_score"
)
## Warning: Expected 2 pieces. Additional pieces discarded in 63 rows [1, 2, 3, 4, 5, 6, 7,
## 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, ...].
str(NASA_TLX_long)
## tibble [600 × 4] (S3: tbl_df/tbl/data.frame)
## $ ID : chr [1:600] "pilot_01" "pilot_01" "pilot_01" "pilot_01" ...
## $ Condition : chr [1:600] "short" "short" "short" "short" ...
## $ Speed : chr [1:600] "0.8" "0.8" "0.8" "0.8" ...
## $ nasa_score: num [1:600] 13 12 15 17 11 4 12 14 13 13 ...
NASA_TLX_long <- NASA_TLX_long %>%
mutate(Condition = as.factor(Condition),
Speed = as.factor(Speed))
NASA_TLX_long$Condition <- factor(NASA_TLX_long$Condition, levels = c("short", "normal", "long"))
str(NASA_TLX_long)
## tibble [600 × 4] (S3: tbl_df/tbl/data.frame)
## $ ID : chr [1:600] "pilot_01" "pilot_01" "pilot_01" "pilot_01" ...
## $ Condition : Factor w/ 3 levels "short","normal",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Speed : Factor w/ 6 levels "0.8","0.9","1",..: 1 1 1 1 1 1 1 2 2 2 ...
## $ nasa_score: num [1:600] 13 12 15 17 11 4 12 14 13 13 ...
# nasa model
nasa_model <- lmer(nasa_score ~ Speed * Condition + (1|ID), data = NASA_TLX_long, REML = FALSE)
Anova(nasa_model)
## Analysis of Deviance Table (Type II Wald chisquare tests)
##
## Response: nasa_score
## Chisq Df Pr(>Chisq)
## Speed 47.1746 2 5.704e-11 ***
## Condition 149.4709 2 < 2.2e-16 ***
## Speed:Condition 4.0005 4 0.4059
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(nasa_model)
## Linear mixed model fit by maximum likelihood ['lmerMod']
## Formula: nasa_score ~ Speed * Condition + (1 | ID)
## Data: NASA_TLX_long
##
## AIC BIC logLik -2*log(L) df.resid
## 2974.7 3022.6 -1476.3 2952.7 565
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.8411 -0.5943 0.0689 0.6264 3.2130
##
## Random effects:
## Groups Name Variance Std.Dev.
## ID (Intercept) 5.331 2.309
## Residual 9.359 3.059
## Number of obs: 576, groups: ID, 8
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) 11.9821 0.9015 13.292
## Speed0.9 -0.4107 0.5408 -0.759
## Speed1.0 1.9286 0.5408 3.566
## Conditionnormal -3.5357 0.5408 -6.538
## Conditionlong -2.9286 0.5408 -5.415
## Speed0.9:Conditionnormal 0.7143 0.7648 0.934
## Speed1.0:Conditionnormal -0.4643 0.7648 -0.607
## Speed0.9:Conditionlong -0.3750 0.7648 -0.490
## Speed1.0:Conditionlong -0.2500 0.7648 -0.327
##
## Correlation of Fixed Effects:
## (Intr) Spd0.9 Spd1.0 Cndtnn Cndtnl Spd0.9:Cndtnn Spd1.0:Cndtnn
## Speed0.9 -0.300
## Speed1.0 -0.300 0.500
## Conditnnrml -0.300 0.500 0.500
## Conditinlng -0.300 0.500 0.500 0.500
## Spd0.9:Cndtnn 0.212 -0.707 -0.354 -0.707 -0.354
## Spd1.0:Cndtnn 0.212 -0.354 -0.707 -0.707 -0.354 0.500
## Spd0.9:Cndtnl 0.212 -0.707 -0.354 -0.354 -0.707 0.500 0.250
## Spd1.0:Cndtnl 0.212 -0.354 -0.707 -0.354 -0.707 0.250 0.500
## Spd0.9:Cndtnl
## Speed0.9
## Speed1.0
## Conditnnrml
## Conditinlng
## Spd0.9:Cndtnn
## Spd1.0:Cndtnn
## Spd0.9:Cndtnl
## Spd1.0:Cndtnl 0.500
single_task_emmeans_nasa <- emmeans(nasa_model, pairwise ~ Speed * Condition)
print(single_task_emmeans_nasa) # significant short vs normal, short vs long
## $emmeans
## Speed Condition emmean SE df lower.CL upper.CL
## 0.8 short 11.98 0.955 12.9 9.92 14.0
## 0.9 short 11.57 0.955 12.9 9.51 13.6
## 1.0 short 13.91 0.955 12.9 11.85 16.0
## 0.8 normal 8.45 0.955 12.9 6.38 10.5
## 0.9 normal 8.75 0.955 12.9 6.69 10.8
## 1.0 normal 9.91 0.955 12.9 7.85 12.0
## 0.8 long 9.05 0.955 12.9 6.99 11.1
## 0.9 long 8.27 0.955 12.9 6.20 10.3
## 1.0 long 10.73 0.955 12.9 8.67 12.8
##
## Degrees-of-freedom method: kenward-roger
## Confidence level used: 0.95
##
## $contrasts
## contrast estimate SE df t.ratio p.value
## Speed0.8 short - Speed0.9 short 0.411 0.545 576 0.754 0.9979
## Speed0.8 short - Speed1.0 short -1.929 0.545 576 -3.541 0.0127
## Speed0.8 short - Speed0.8 normal 3.536 0.545 576 6.492 <.0001
## Speed0.8 short - Speed0.9 normal 3.232 0.545 576 5.934 <.0001
## Speed0.8 short - Speed1.0 normal 2.071 0.545 576 3.803 0.0050
## Speed0.8 short - Speed0.8 long 2.929 0.545 576 5.377 <.0001
## Speed0.8 short - Speed0.9 long 3.714 0.545 576 6.819 <.0001
## Speed0.8 short - Speed1.0 long 1.250 0.545 576 2.295 0.3468
## Speed0.9 short - Speed1.0 short -2.339 0.545 576 -4.295 0.0007
## Speed0.9 short - Speed0.8 normal 3.125 0.545 576 5.737 <.0001
## Speed0.9 short - Speed0.9 normal 2.821 0.545 576 5.180 <.0001
## Speed0.9 short - Speed1.0 normal 1.661 0.545 576 3.049 0.0603
## Speed0.9 short - Speed0.8 long 2.518 0.545 576 4.623 0.0002
## Speed0.9 short - Speed0.9 long 3.304 0.545 576 6.065 <.0001
## Speed0.9 short - Speed1.0 long 0.839 0.545 576 1.541 0.8357
## Speed1.0 short - Speed0.8 normal 5.464 0.545 576 10.032 <.0001
## Speed1.0 short - Speed0.9 normal 5.161 0.545 576 9.475 <.0001
## Speed1.0 short - Speed1.0 normal 4.000 0.545 576 7.344 <.0001
## Speed1.0 short - Speed0.8 long 4.857 0.545 576 8.918 <.0001
## Speed1.0 short - Speed0.9 long 5.643 0.545 576 10.360 <.0001
## Speed1.0 short - Speed1.0 long 3.179 0.545 576 5.836 <.0001
## Speed0.8 normal - Speed0.9 normal -0.304 0.545 576 -0.557 0.9998
## Speed0.8 normal - Speed1.0 normal -1.464 0.545 576 -2.688 0.1542
## Speed0.8 normal - Speed0.8 long -0.607 0.545 576 -1.115 0.9720
## Speed0.8 normal - Speed0.9 long 0.179 0.545 576 0.328 1.0000
## Speed0.8 normal - Speed1.0 long -2.286 0.545 576 -4.197 0.0010
## Speed0.9 normal - Speed1.0 normal -1.161 0.545 576 -2.131 0.4530
## Speed0.9 normal - Speed0.8 long -0.304 0.545 576 -0.557 0.9998
## Speed0.9 normal - Speed0.9 long 0.482 0.545 576 0.885 0.9937
## Speed0.9 normal - Speed1.0 long -1.982 0.545 576 -3.639 0.0090
## Speed1.0 normal - Speed0.8 long 0.857 0.545 576 1.574 0.8189
## Speed1.0 normal - Speed0.9 long 1.643 0.545 576 3.016 0.0661
## Speed1.0 normal - Speed1.0 long -0.821 0.545 576 -1.508 0.8517
## Speed0.8 long - Speed0.9 long 0.786 0.545 576 1.443 0.8808
## Speed0.8 long - Speed1.0 long -1.679 0.545 576 -3.082 0.0548
## Speed0.9 long - Speed1.0 long -2.464 0.545 576 -4.524 0.0003
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 9 estimates
nasa_effects <- allEffects(nasa_model)
nasa_effects_model <- as.data.frame(nasa_effects[[1]])
nasa_effects_plot <- ggplot(nasa_effects_model, aes(x = Condition, y = fit)) +
geom_point(aes(color = Condition), size = 3) +
geom_errorbar(aes(ymin = fit - se, ymax = fit + se, color = Condition, width = 0.5), size = 1) +
scale_color_manual(values = c("short" = "green", "normal" = "tomato", "long" = "blue")) +
ylab("Mean NASA-TLX score (1–20)") +
xlab("Step Distance for 0.8 m/s")
plot(nasa_effects_plot)
combined_plot <- single_task_plot + nasa_effects_plot + plot_layout(ncol = 2) +
plot_annotation(tag_levels = "A", tag_suffix = ")")
ggsave("../../ReStoWa/MasterThesis/Graphs/single_task_walking.jpg", combined_plot, width = 11, height = 4, dpi = 300)