From c30509e56c32c3719ddacfc40bb715f9d56945a2 Mon Sep 17 00:00:00 2001 From: James Steele Date: Mon, 12 Jan 2026 09:39:08 +0000 Subject: [PATCH 1/3] Update 15-researchintegrity.qmd Added meta-analytic estimates of the proportions from QRP surveys --- 15-researchintegrity.qmd | 72 +++++++++++++++++++++++++++++++++++++++- 1 file changed, 71 insertions(+), 1 deletion(-) diff --git a/15-researchintegrity.qmd b/15-researchintegrity.qmd index 3eb4d569..678bfe7f 100644 --- a/15-researchintegrity.qmd +++ b/15-researchintegrity.qmd @@ -36,7 +36,7 @@ Many researchers selectively publish only those results or analyses with signifi Researchers also flexibly analyse their data by selectively reporting conditions, measures, covariates, and a host of other data analytic strategies that inflate the Type 1 error rate, and increase the probability of obtaining a statistically significant result. Preregistration has been an important step of increasing the transparency of data-driven choices in the analyses reported in scientific articles, and allows researchers to evaluate whether any deviations from the statistical analysis plan decrease the severity of the test, or increase it [@lakens_value_2019]. With increasing awareness of the problematic nature of these practices, hopefully we will see a strong decline in their occurrence, and researchers will learn correct approaches to maintain some flexibility in their analyses (for example by replacing optional stopping by [sequential analysis](#sec-sequential). @wigboldus_encourage_2016 make the important distinction between questionable research practices, and questionable reporting practices. Whenever in doubt, transparently reporting the decisions you made while analyzing data should give researchers all the information they need to evaluate the reported results. ```{r, fig-qrp, echo = FALSE, fig.height = 12} -#| fig-cap: "Self-admittance of engaging in a questionable research practices at least once from 14 surveys among a variety of samples of researchers." +#| fig-cap: "Self-admittance of engaging in a questionable research practices at least once from 14 surveys among a variety of samples of researchers (red vertical line denotes the pooled estimate from meta-analysis of the logit transformed proportions across surveys)." john <- c(45.8, 63.4, 27.7, NA, 55.9, 38.2, NA, NA, 27, 22, 3, 0.6) fiedler <- c(42, 34, 24, NA, 33, 40, NA, NA, 47, 22, 3, 3) #retrieved using get data graph digitizer as data are not shared beyond the graph @@ -62,6 +62,68 @@ long <- reshape2::melt(df, id.vars = c("labels")) long$labels <- as.factor(long$labels) long = subset(long, !is.na(value)) +sample_size <- data.frame( + variable = as.factor(c( + "john", + "agnoli", + "motyl", + "rabelo", + "fraser_eco", + "fraser_evo", + "makel", + "bakker", + "chin", + "fiedler", + "moran", + "swift", + "latan", + "garciagarzon", + "brachem" + )), + n = c( + 2155, + 277, + 1414, + 232, + 494, + 313, + 1488, + 1166, + 1612, + 1138, + 425, + 164, + 472, + 131, # Not cited in chapter except in figure but assume this paper -https://doi.org/10.1007/s12144-022-02797-6 + 1398 # Not cited in chapter except in figure but assume this paper - https://doi.org/10.5281/zenodo.3561440 + ) +) + +long <- dplyr::left_join(long, sample_size, by = "variable") + +# logit transformation proportions +long$prop <- long$value/100 +long$prop_logit <- log(long$prop / (1 - long$prop)) +long$prop_logit_vi <- 1 / (4*long$n) + + +# meta-analyse proportions +long <- subset(long, !is.na(prop_logit) & !is.infinite(prop_logit) & !is.na(prop_logit_vi)) + +meta <- metafor::rma.mv(yi = prop_logit, V = prop_logit_vi, + data=long, + mods = ~ 0 + labels, + method="REML") + +# get meta-analysis estimates +meta_tidy <- broom::tidy(meta) + +meta_tidy$labels <- stringr::str_remove(meta_tidy$term, "labels") + +# inverse logit transformation back to proportion scale +meta_tidy$prop_estimate <- plogis(meta_tidy$estimate) +meta_tidy$prop_lower <- plogis(meta_tidy$estimate - meta_tidy$std.error * 1.96) # note, intervals very narrow so only point estimate plotted +meta_tidy$prop_upper <- plogis(meta_tidy$estimate + meta_tidy$std.error * 1.96) # note, intervals very narrow so only point estimate plotted # ggplot(long, aes(x = labels, y = value, fill = variable)) + # geom_bar(stat = "identity", colour = "black", width = 0.8, position = position_dodge2(.8, preserve = "total")) + @@ -77,6 +139,14 @@ long = subset(long, !is.na(value)) ggplot(long, aes(x = variable, y = value, fill = variable)) + coord_flip() + geom_bar(stat = "identity", colour = "black", width = 0.8, position = position_dodge(.8, preserve = "single")) + +geom_hline( + data = meta_tidy, + aes(yintercept = prop_estimate*100), + linewidth = 0.8, + colour = "red", + alpha = 0.5, + inherit.aes = FALSE + ) + theme(plot.margin = margin(0, 0, 0, 0, "cm"), plot.background = element_rect(fill = backgroundcolor), panel.background = element_rect(fill = backgroundcolor), legend.background = element_rect(fill= backgroundcolor), legend.direction = "horizontal", legend.position = "bottom", axis.title = element_text(size = 13), axis.text.x = element_text(size = 10), axis.text.y = element_text(size = 20), panel.grid.major.x = element_line(linewidth = .1, color = "black"), axis.ticks.x = element_blank()) + ggtitle("Self-admittance rates of engaging in QRP's at least once") + scale_fill_manual(values = c("#000000", "#88CCEE", "#CC6677", "#DDCC77", "#117733", "#332288", "#AA4499", "#E69F00", "#44AA99", "#999933", "#882255", "#661100", "#6699CC", "#888888", "#ffffff"), From ed9920c3c67ed12dd4008a8f491e88294d4c07df Mon Sep 17 00:00:00 2001 From: James Steele Date: Mon, 12 Jan 2026 13:18:19 +0000 Subject: [PATCH 2/3] Update 15-researchintegrity.qmd oops - wrong logit transformation variance calculation and in my haste missed specifying the variance structure on the model. Now updated with correct spec and also interval estimates on the plots. --- 15-researchintegrity.qmd | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/15-researchintegrity.qmd b/15-researchintegrity.qmd index 678bfe7f..d91c9577 100644 --- a/15-researchintegrity.qmd +++ b/15-researchintegrity.qmd @@ -36,7 +36,7 @@ Many researchers selectively publish only those results or analyses with signifi Researchers also flexibly analyse their data by selectively reporting conditions, measures, covariates, and a host of other data analytic strategies that inflate the Type 1 error rate, and increase the probability of obtaining a statistically significant result. Preregistration has been an important step of increasing the transparency of data-driven choices in the analyses reported in scientific articles, and allows researchers to evaluate whether any deviations from the statistical analysis plan decrease the severity of the test, or increase it [@lakens_value_2019]. With increasing awareness of the problematic nature of these practices, hopefully we will see a strong decline in their occurrence, and researchers will learn correct approaches to maintain some flexibility in their analyses (for example by replacing optional stopping by [sequential analysis](#sec-sequential). @wigboldus_encourage_2016 make the important distinction between questionable research practices, and questionable reporting practices. Whenever in doubt, transparently reporting the decisions you made while analyzing data should give researchers all the information they need to evaluate the reported results. ```{r, fig-qrp, echo = FALSE, fig.height = 12} -#| fig-cap: "Self-admittance of engaging in a questionable research practices at least once from 14 surveys among a variety of samples of researchers (red vertical line denotes the pooled estimate from meta-analysis of the logit transformed proportions across surveys)." +#| fig-cap: "Self-admittance of engaging in a questionable research practices at least once from 14 surveys among a variety of samples of researchers (red vertical line denotes the pooled estimate and band the 95% confidence interval from meta-analysis of the logit transformed proportions across surveys)." john <- c(45.8, 63.4, 27.7, NA, 55.9, 38.2, NA, NA, 27, 22, 3, 0.6) fiedler <- c(42, 34, 24, NA, 33, 40, NA, NA, 47, 22, 3, 3) #retrieved using get data graph digitizer as data are not shared beyond the graph @@ -104,16 +104,17 @@ long <- dplyr::left_join(long, sample_size, by = "variable") # logit transformation proportions long$prop <- long$value/100 long$prop_logit <- log(long$prop / (1 - long$prop)) -long$prop_logit_vi <- 1 / (4*long$n) +long$prop_logit_vi <- 1 / ((long$n * long$prop) * (1 - long$prop)) # meta-analyse proportions long <- subset(long, !is.na(prop_logit) & !is.infinite(prop_logit) & !is.na(prop_logit_vi)) -meta <- metafor::rma.mv(yi = prop_logit, V = prop_logit_vi, - data=long, - mods = ~ 0 + labels, - method="REML") +meta <- metafor::rma.mv(yi = prop_logit, V = prop_logit_vi, + random = ~ 1 | variable, + data=long, + mods = ~ 0 + labels, + method="REML") # get meta-analysis estimates meta_tidy <- broom::tidy(meta) @@ -139,7 +140,14 @@ meta_tidy$prop_upper <- plogis(meta_tidy$estimate + meta_tidy$std.error * 1.96) ggplot(long, aes(x = variable, y = value, fill = variable)) + coord_flip() + geom_bar(stat = "identity", colour = "black", width = 0.8, position = position_dodge(.8, preserve = "single")) + -geom_hline( +geom_rect( + data = meta_tidy, + aes(ymin = prop_lower*100, ymax=prop_upper*100, xmin = -Inf, xmax = Inf), + fill = "red", + alpha = 0.25, + inherit.aes = FALSE + ) + + geom_hline( data = meta_tidy, aes(yintercept = prop_estimate*100), linewidth = 0.8, From d23ff46e6e8d66d62777eb9e966cd3a152fa8db4 Mon Sep 17 00:00:00 2001 From: James Steele Date: Mon, 12 Jan 2026 13:41:59 +0000 Subject: [PATCH 3/3] Update 15-researchintegrity.qmd sigh... last edit to add nested random intercept for each estimate --- 15-researchintegrity.qmd | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/15-researchintegrity.qmd b/15-researchintegrity.qmd index d91c9577..1a80e7cc 100644 --- a/15-researchintegrity.qmd +++ b/15-researchintegrity.qmd @@ -109,9 +109,10 @@ long$prop_logit_vi <- 1 / ((long$n * long$prop) * (1 - long$prop)) # meta-analyse proportions long <- subset(long, !is.na(prop_logit) & !is.infinite(prop_logit) & !is.na(prop_logit_vi)) +long$effect <- 1:nrow(long) meta <- metafor::rma.mv(yi = prop_logit, V = prop_logit_vi, - random = ~ 1 | variable, + random = ~ 1 | variable/effect, data=long, mods = ~ 0 + labels, method="REML")