Skip to content

Instantly share code, notes, and snippets.

@steveharoz
Created May 28, 2020 11:32
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save steveharoz/d63d66527b654a839b055939642d9feb to your computer and use it in GitHub Desktop.
Save steveharoz/d63d66527b654a839b055939642d9feb to your computer and use it in GitHub Desktop.
VR research - correlation between female participant proportion vs simulator sickness
library(tidyverse)
# Mind the Gap:The Underrepresentation of Female Participants and Authors in Virtual Reality Research
# Tabitha C. Peck,Laura E. Sockol, and Sarah M. Hancock
# Table 3
data = read_csv(
"Study,N,CohensD,CI.Low,CI.Hi,p,SAMD,FemaleParticipants
Arafat et al. [4],16,0.42,0.19,0.65,<.001,−.07,81%
Ariza et al. [5],18,0.12,-0.09,0.33,0.263,−.68,22%
Bolling et al. [9],12,3.5,2.82,4.17,<.001,4.771,33%
Bolte & Lappe [10],10,0.45,0.16,0.74,0.002,−.01,50%
Bruder et al. [16],15,0.32,0.09,0.55,0.007,−.26,13%
Bruder et al. [17],16,0.32,0.1,0.55,0.005,−.26,69%
Freitag et al. User Study [27],54,0.48,0.35,0.6,<.001,0.07,17%
Hayashi et al. Experiment 1 [31],16,1.06,0.79,1.34,<.001,1.15,44%
Kim et al. [40],15,0.09,-0.13,0.32,0.418,−.66,0%
Kruse et al. [43],20,0.34,0.14,0.54,0.001,−.25,35%
Langbehn et al. Confirmatory Study [44],15,0.19,-0.03,0.42,0.096,−.48,13%
Latoschik et al. EP3 [45],45,-0.05,-0.18,0.08,0.458,−1.61,71%
Lee et al. [47],26,0.1,-0.07,0.27,0.263,−.88,46%
MacQuarrie & Steed [53],31,0.39,0.23,0.56,<.001,−.18,58%
Roth et al. [68],125,0.14,0.07,0.22,<.001,−1.56,33%
Schatzschneider et al. [71],21,1.37,1.1,1.63,<.001,2.01,38%
Schmitz et al. Experiment 3 [72],9,0.06,-0.23,0.36,0.67,−.52,22%
Soyka et al. [75],50,0.16,0.03,0.28,0.013,−1.02,50%
\"Wang, Wu et al. [81]\",16,0.61,0.37,0.85,<.001,0.29,25%
\"Wang, Zhao et al. [82]\",32,0.68,0.51,0.86,<.001,0.62,19%
Zhang et al. Study 1 [87],15,0.46,0.22,0.7,<.001,0.01,13%
Zhang et al. Study 2 [87],15,0.42,0.18,0.65,0.001,−.08,27%")
# fix rounding of proportions
data = data %>% mutate(WomenProportion = as.numeric(gsub("[\\%,]", "", FemaleParticipants)) / 100)
data = data %>% mutate(WomenN = round(N * WomenProportion), WomenProportion = WomenN / N)
# weighted correlation
iterate = function() {
# sample with replacement
temp = data %>% sample_n(n(), replace = T)
# weighted correlation
temp = cov.wt(temp %>% select(CohensD, WomenProportion), temp$N)$cov
# scale covariance matrix to correlation matrix
temp = cov2cor(V = temp)
# return the correlation
temp[1,2]
}
# bootstrap
boot_samples = replicate(10000, iterate(), simplify = T)
CI95 = boot_samples %>%
quantile(c(0.025, 0.975)) %>%
round(3) %>%
paste(collapse = ", ")
ggplot(tibble(Correlation = boot_samples)) +
aes(x = Correlation) +
geom_histogram() +
geom_vline(color = "red", xintercept = 0) +
theme_minimal(20) +
labs(title = paste0("Correlation 95% CI: [", CI95, "]"))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment