CARPS Reproducibility Report
articleID <- "6-7-2014_PS" # insert the article ID code here e.g., "10-3-2015_PS"
reportType <- 'final'
pilotNames <- "Dawn Finzi, Kiara Sanchez" # insert the pilot's name here e.g., "Tom Hardwicke". If there are multiple pilots enter both names in a character string e.g., "Tom Hardwicke, Bob Dylan"
copilotNames <- "Ben Peloquin" # insert the co-pilot's name here e.g., "Michael Frank". If there are multiple co-pilots enter both names in a character string e.g., "Tom Hardwicke, Bob Dylan"
pilotTTC <- 180 # insert the pilot's estimated time to complete (in minutes, fine to approximate) e.g., 120
copilotTTC <- 160 # insert the co- pilot's estimated time to complete (in minutes, fine to approximate) e.g., 120
pilotStartDate <- as.Date("11/02/17", format = "%m/%d/%y") # insert the pilot's start date in US format e.g., as.Date("01/25/18", format = "%m/%d/%y")
copilotStartDate <- as.Date("06/13/18", format = "%m/%d/%y") # insert the co-pilot's start date in US format e.g., as.Date("01/25/18", format = "%m/%d/%y")
completionDate <- as.Date("06/20/18", format = "%m/%d/%y") # copilot insert the date of final report completion (after any necessary rounds of author assistance) in US format e.g., as.Date("01/25/18", format = "%m/%d/%y")Methods summary:
Researchers recruited 202 volunteers at a subway station in Toronto, Ontario, Canada. Half of the sample was traveling East, while the other half was traveling West. In a 2 (orientation: toward, away from) X 4 (station: Spadina, St. George, Bloor-Yonge, Sherbourne) design, each participant was randomly asked to estimate how far one of the four stations felt to them (1= very close, 7= very far). Authors conducted a 2 X 4 ANOVA on distance estimates, and then tested differences in distance estimates between East and West-bound groups for each individual station.
Target outcomes:
We carried out a 2 (orientation: toward, away from) × 4 (station: Spadina, St. George, Bloor-Yonge, Sherbourne) analysis of variance (ANOVA) on closeness ratings, which revealed no main effect of orientation, F < 1, and a main effect of station, F(3, 194) = 24.10, p < .001, ηp 2 = .27. This main effect was qualified by the predicted interaction between orientation and station, F(3, 194) = 16.28, p < .001, ηp2 = .20. We decomposed this interaction by the subjective-distance ratings between participants traveling east and west for each of the four subway stations. Westbound participants rated the stations to the west of Bay Street as closer than did eastbound participants; this effect was obtained for both the station one stop to the west (St. George, p < .001, ηp2 = .28) and the station two stops to the west (Spadina, p = .001, ηp2 = .20). The opposite pattern held true for stations to the east of Bay Street. Eastbound participants rated the stations to the east of Bay Street as closer than did westbound participants; this effect was obtained for both the station one stop to the east (Bloor-Yonge, p = .053, ηp2 = .08) and the station two stops to the east (Sherbourne, p < .001, ηp2 = .24). Figure 1 summarizes these results.
Step 1: Load packages
library(tidyverse) # for data munging
library(knitr) # for kable table formating
library(haven) # import and export 'SPSS', 'Stata' and 'SAS' Files
library(readxl) # import excel files
library(ReproReports) # custom report functions
library(lsr)
library(ggthemes)# Prepare report object. This will be updated automatically by the reproCheck function each time values are compared.
reportObject <- data.frame(dummyRow = TRUE,
reportedValue = NA,
obtainedValue = NA,
valueType = NA,
percentageError = NA,
comparisonOutcome = NA, eyeballCheck = NA)Step 2: Load data
d <- read_excel ("data/S1_Subway.xlsx")Step 3: Tidy data
Data already in tidy format.
Step 4: Run analysis
Pre-processing
# make variables factors
d$DIRECTION <- as.factor(d$DIRECTION)
d$STN_NAME<- as.factor(d$STN_NAME)
# subset dataframes for individual tests
BY <- subset(d, STN_NAME == "B-Y")
SHER <- subset(d, STN_NAME == "SHER")
SPAD <-subset(d, STN_NAME == "SPAD")
STG<- subset(d, STN_NAME == "STG")Descriptive statistics
Reproducing fig1:
d %>%
mutate(STN_NAME=factor(STN_NAME, levels=c("SPAD", "STG", "B-Y", "SHER"))) %>%
group_by(STN_NAME, DIRECTION) %>%
summarise(mean_distance=mean(DISTANCE),
sd_distance=sd(DISTANCE),
n=n(),
y_min=mean_distance-qnorm(0.975)*sd_distance/sqrt(n),
y_max=mean_distance+qnorm(0.975)*sd_distance/sqrt(n)) %>%
ggplot(aes(x=STN_NAME, y=mean_distance, col=DIRECTION)) +
geom_point() +
geom_errorbar(aes(ymin=y_min, ymax=y_max), width=0.05) +
geom_path(aes(group=DIRECTION)) +
ylab("Subjective Distance") +
xlab("Station") +
ylim(0, 5) +
theme_classic() +
ggtitle("Reproducing Fig1") +
theme(plot.title = element_text(hjust = 0.5)) 
# Eyeball checks from reproduced fig1
spadinaWest <- 2.6
spadinaEast <- 3.5
stgeorgeWest <- 1.8
stgeorgeEast <- 2.9
byWest <- 2
byEast <- 1.7
sherWest <- 4
sherEast <- 2.5
Figure1 from paper
# spadina west
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=spadinaWest,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."# spadina east
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=spadinaEast,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."# st george west
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=stgeorgeWest,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."# st george east
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=stgeorgeEast,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."# bloor-yonge west
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=byWest,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."# bloor-yonge east
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=byEast,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."# sherbourne west
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=sherWest,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."# sherbourne east
reportObject <- reproCheck(reportedValue="figure",
obtainedValue=sherEast,
valueType = 'mean',
eyeballCheck=TRUE)## [1] "MATCH for mean. Eyeball comparison only."Inferential statistics
# 2 (DIRECTION) X 4 (STATION) ANOVA
t1 <- aov(DISTANCE ~ DIRECTION * STN_NAME, data=d)
t1_summary <- summary(t1)
t1_summary## Df Sum Sq Mean Sq F value Pr(>F)
## DIRECTION 1 0.71 0.713 0.664 0.416
## STN_NAME 3 75.16 25.053 23.349 6.01e-13 ***
## DIRECTION:STN_NAME 3 52.41 17.471 16.283 1.77e-09 ***
## Residuals 194 208.15 1.073
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Test main effect of orientation
reportObject <- reproCheck(reportedValue="<1",
obtainedValue=t1_summary[[1]]$`F value`[1],
valueType = 'F',
eyeballCheck=TRUE)## [1] "MATCH for F. Eyeball comparison only."# Test main effect of station
reportObject <- reproCheck(reportedValue="24.10",
obtainedValue=t1_summary[[1]]$`F value`[2],
valueType = 'F')## [1] "MINOR_ERROR for F. The reported value (24.1) and the obtained value (23.35) differed by 3.11%. Note that the obtained value was rounded to 2 decimal places to match the reported value."# Test interaction between orientation and station
reportObject <- reproCheck(reportedValue="16.28",
obtainedValue=t1_summary[[1]]$`F value`[3],
valueType='F')## [1] "MATCH for F. The reported value (16.28) and the obtained value (16.28) differed by 0%. Note that the obtained value was rounded to 2 decimal places to match the reported value."eta2 <- etaSquared(t1)
kable(eta2, caption="Partial eta squared")| eta.sq | eta.sq.part | |
|---|---|---|
| DIRECTION | 0.0011960 | 0.0019293 |
| STN_NAME | 0.2233935 | 0.2652841 |
| DIRECTION:STN_NAME | 0.1557894 | 0.2011516 |
station_p_eta2 <- eta2[5]
interaction_p_eta2 <- eta2[6]
# Test main effect of station
reportObject <- reproCheck(reportedValue = "0.27", obtainedValue = station_p_eta2, valueType = 'other') # eta squared## [1] "MATCH for other. The reported value (0.27) and the obtained value (0.27) differed by 0%. Note that the obtained value was rounded to 2 decimal places to match the reported value."# Test interaction between orientation and station
reportObject <- reproCheck(reportedValue = "0.20", obtainedValue = interaction_p_eta2, valueType = 'other') # eta squared## [1] "MATCH for other. The reported value (0.2) and the obtained value (0.2) differed by 0%. Note that the obtained value was rounded to 2 decimal places to match the reported value."Station-specific analyses
St. George
#St. George
t2 <- aov(DISTANCE ~ DIRECTION, data=STG)
t2_summary <- summary(t2); t2_summary## Df Sum Sq Mean Sq F value Pr(>F)
## DIRECTION 1 16.25 16.252 18.79 7.23e-05 ***
## Residuals 49 42.38 0.865
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etaSQ_t2 <- etaSquared(t2); etaSQ_t2## eta.sq eta.sq.part
## DIRECTION 0.2772092 0.2772092Spadina
#Spadina
t3 <- aov(DISTANCE ~ DIRECTION, data=SPAD)
t3_summary <- summary(t3); t3_summary## Df Sum Sq Mean Sq F value Pr(>F)
## DIRECTION 1 13.10 13.100 11.97 0.00113 **
## Residuals 49 53.64 1.095
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etaSQ_t3 = etaSquared(t3); etaSQ_t3 ## eta.sq eta.sq.part
## DIRECTION 0.1962763 0.1962763Bloor-Yonge
#Bloor-Yonge
t4 <- aov(DISTANCE ~ DIRECTION, data=BY)
t4_summary <- summary(t4); t4_summary## Df Sum Sq Mean Sq F value Pr(>F)
## DIRECTION 1 4.16 4.157 3.945 0.0528 .
## Residuals 47 49.52 1.054
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etaSQ_t4 = etaSquared(t4); etaSQ_t4## eta.sq eta.sq.part
## DIRECTION 0.0774451 0.0774451Sherbourne
#Sherbourne
t5 <- aov(DISTANCE ~ DIRECTION, data=SHER)
t5_summary <- summary(t5); t5_summary## Df Sum Sq Mean Sq F value Pr(>F)
## DIRECTION 1 19.31 19.306 15.11 0.000305 ***
## Residuals 49 62.62 1.278
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1etaSQ_t5 = etaSquared(t5); etaSQ_t5 ## eta.sq eta.sq.part
## DIRECTION 0.2356667 0.2356667Run station reproChecks
## [1] "MATCH for p. Eyeball comparison only."
## [1] "MATCH for other. The reported value (0.28) and the obtained value (0.28) differed by 0%. Note that the obtained value was rounded to 2 decimal places to match the reported value."
## [1] "MATCH for p. The reported value (0.001) and the obtained value (0.001) differed by 0%. Note that the obtained value was rounded to 3 decimal places to match the reported value."
## [1] "MATCH for other. The reported value (0.2) and the obtained value (0.2) differed by 0%. Note that the obtained value was rounded to 2 decimal places to match the reported value."
## [1] "MATCH for p. The reported value (0.053) and the obtained value (0.053) differed by 0%. Note that the obtained value was rounded to 3 decimal places to match the reported value."
## [1] "MATCH for other. The reported value (0.08) and the obtained value (0.08) differed by 0%. Note that the obtained value was rounded to 2 decimal places to match the reported value."
## [1] "MATCH for p. Eyeball comparison only."
## [1] "MATCH for other. The reported value (0.24) and the obtained value (0.24) differed by 0%. Note that the obtained value was rounded to 2 decimal places to match the reported value."Step 5: Conclusion
We were able to successfully reproduce all target outcomes.
Author_Assistance = FALSE # was author assistance provided? (if so, enter TRUE)
Insufficient_Information_Errors <- 0 # how many discrete insufficient information issues did you encounter?
# Assess the causal locus (discrete reproducibility issues) of any reproducibility errors. Note that there doesn't necessarily have to be a one-to-one correspondance between discrete reproducibility issues and reproducibility errors. For example, it could be that the original article neglects to mention that a Greenhouse-Geisser correct was applied to ANOVA outcomes. This might result in multiple reproducibility errors, but there is a single causal locus (discrete reproducibility issue).
locus_typo <- NA # how many discrete issues did you encounter that related to typographical errors?
locus_specification <- NA # how many discrete issues did you encounter that related to incomplete, incorrect, or unclear specification of the original analyses?
locus_analysis <- NA # how many discrete issues did you encounter that related to errors in the authors' original analyses?
locus_data <- NA # how many discrete issues did you encounter that related to errors in the data files shared by the authors?
locus_unidentified <- NA # how many discrete issues were there for which you could not identify the cause
# How many of the above issues were resolved through author assistance?
locus_typo_resolved <- NA # how many discrete issues did you encounter that related to typographical errors?
locus_specification_resolved <- NA # how many discrete issues did you encounter that related to incomplete, incorrect, or unclear specification of the original analyses?
locus_analysis_resolved <- NA # how many discrete issues did you encounter that related to errors in the authors' original analyses?
locus_data_resolved <- NA # how many discrete issues did you encounter that related to errors in the data files shared by the authors?
locus_unidentified_resolved <- NA # how many discrete issues were there for which you could not identify the cause
Affects_Conclusion <- FALSE # Do any reproducibility issues encounter appear to affect the conclusions made in the original article? This is a subjective judgement, but you should taking into account multiple factors, such as the presence/absence of decision errors, the number of target outcomes that could not be reproduced, the type of outcomes that could or could not be reproduced, the difference in magnitude of effect sizes, and the predictions of the specific hypothesis under scrutiny.reportObject <- reportObject %>%
filter(dummyRow == FALSE) %>% # remove the dummy row
select(-dummyRow) %>% # remove dummy row designation
mutate(articleID = articleID) %>% # add the articleID
select(articleID, everything()) # make articleID first column
# decide on final outcome
if(any(reportObject$comparisonOutcome %in% c("MAJOR_ERROR", "DECISION_ERROR")) | Insufficient_Information_Errors > 0){
finalOutcome <- "Failure without author assistance"
if(Author_Assistance == T){
finalOutcome <- "Failure despite author assistance"
}
}else{
finalOutcome <- "Success without author assistance"
if(Author_Assistance == T){
finalOutcome <- "Success with author assistance"
}
}
# collate report extra details
reportExtras <- data.frame(articleID, pilotNames, copilotNames, pilotTTC, copilotTTC, pilotStartDate, copilotStartDate, completionDate, Author_Assistance, finalOutcome, Insufficient_Information_Errors, locus_typo, locus_specification, locus_analysis, locus_data, locus_unidentified, locus_typo_resolved, locus_specification_resolved, locus_analysis_resolved, locus_data_resolved, locus_unidentified_resolved)
# save report objects
if(reportType == "pilot"){
write_csv(reportObject, "pilotReportDetailed.csv")
write_csv(reportExtras, "pilotReportExtras.csv")
}
if(reportType == "final"){
write_csv(reportObject, "finalReportDetailed.csv")
write_csv(reportExtras, "finalReportExtras.csv")
}Session information
devtools::session_info()## ─ Session info ───────────────────────────────────────────────────────────────
## setting value
## version R version 4.0.0 (2020-04-24)
## os macOS Catalina 10.15.4
## system x86_64, darwin17.0
## ui X11
## language (EN)
## collate en_US.UTF-8
## ctype en_US.UTF-8
## tz Europe/London
## date 2020-05-13
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date lib
## assertthat 0.2.1 2019-03-21 [1]
## backports 1.1.6 2020-04-05 [1]
## broom 0.5.6 2020-04-20 [1]
## callr 3.4.3 2020-03-28 [1]
## cellranger 1.1.0 2016-07-27 [1]
## cli 2.0.2 2020-02-28 [1]
## colorspace 1.4-1 2019-03-18 [1]
## crayon 1.3.4 2017-09-16 [1]
## DBI 1.1.0 2019-12-15 [1]
## dbplyr 1.4.3 2020-04-19 [1]
## desc 1.2.0 2018-05-01 [1]
## devtools 2.3.0 2020-04-10 [1]
## digest 0.6.25 2020-02-23 [1]
## dplyr * 0.8.5 2020-03-07 [1]
## ellipsis 0.3.0 2019-09-20 [1]
## evaluate 0.14 2019-05-28 [1]
## fansi 0.4.1 2020-01-08 [1]
## farver 2.0.3 2020-01-16 [1]
## forcats * 0.5.0 2020-03-01 [1]
## fs 1.4.1 2020-04-04 [1]
## generics 0.0.2 2018-11-29 [1]
## ggplot2 * 3.3.0 2020-03-05 [1]
## ggthemes * 4.2.0 2019-05-13 [1]
## glue 1.4.0 2020-04-03 [1]
## gtable 0.3.0 2019-03-25 [1]
## haven * 2.2.0 2019-11-08 [1]
## highr 0.8 2019-03-20 [1]
## hms 0.5.3 2020-01-08 [1]
## htmltools 0.4.0 2019-10-04 [1]
## httr 1.4.1 2019-08-05 [1]
## jsonlite 1.6.1 2020-02-02 [1]
## knitr * 1.28 2020-02-06 [1]
## labeling 0.3 2014-08-23 [1]
## lattice 0.20-41 2020-04-02 [1]
## lifecycle 0.2.0 2020-03-06 [1]
## lsr * 0.5 2015-03-02 [1]
## lubridate 1.7.8 2020-04-06 [1]
## magrittr 1.5 2014-11-22 [1]
## memoise 1.1.0 2017-04-21 [1]
## modelr 0.1.7 2020-04-30 [1]
## munsell 0.5.0 2018-06-12 [1]
## nlme 3.1-147 2020-04-13 [1]
## pillar 1.4.4 2020-05-05 [1]
## pkgbuild 1.0.7 2020-04-25 [1]
## pkgconfig 2.0.3 2019-09-22 [1]
## pkgload 1.0.2 2018-10-29 [1]
## prettyunits 1.1.1 2020-01-24 [1]
## processx 3.4.2 2020-02-09 [1]
## ps 1.3.2 2020-02-13 [1]
## purrr * 0.3.4 2020-04-17 [1]
## R6 2.4.1 2019-11-12 [1]
## Rcpp 1.0.4.6 2020-04-09 [1]
## readr * 1.3.1 2018-12-21 [1]
## readxl * 1.3.1 2019-03-13 [1]
## remotes 2.1.1 2020-02-15 [1]
## reprex 0.3.0 2019-05-16 [1]
## ReproReports * 0.1 2020-05-06 [1]
## rlang 0.4.6 2020-05-02 [1]
## rmarkdown 2.1 2020-01-20 [1]
## rprojroot 1.3-2 2018-01-03 [1]
## rstudioapi 0.11 2020-02-07 [1]
## rvest 0.3.5 2019-11-08 [1]
## scales 1.1.0 2019-11-18 [1]
## sessioninfo 1.1.1 2018-11-05 [1]
## stringi 1.4.6 2020-02-17 [1]
## stringr * 1.4.0 2019-02-10 [1]
## testthat 2.3.2 2020-03-02 [1]
## tibble * 3.0.1 2020-04-20 [1]
## tidyr * 1.0.2 2020-01-24 [1]
## tidyselect 1.0.0 2020-01-27 [1]
## tidyverse * 1.3.0 2019-11-21 [1]
## usethis 1.6.1 2020-04-29 [1]
## vctrs 0.2.4 2020-03-10 [1]
## withr 2.2.0 2020-04-20 [1]
## xfun 0.13 2020-04-13 [1]
## xml2 1.3.2 2020-04-23 [1]
## yaml 2.2.1 2020-02-01 [1]
## source
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## Github (METRICS-CARPS/CARPSreports@3277f85)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
##
## [1] /Library/Frameworks/R.framework/Versions/4.0/Resources/library