CARPS Reproducibility Report
articleID <- "16-11-2014_PS" # insert the article ID code here e.g., "10-3-2015_PS"
reportType <- 'final'
pilotNames <- "Yochai Shavit, Kari Leibowitz" # 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 <- "Tom Hardwicke" # 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 <- 360 # insert the pilot's estimated time to complete (in minutes, fine to approximate) e.g., 120
copilotTTC <- 30 # insert the co- pilot's estimated time to complete (in minutes, fine to approximate) e.g., 120
pilotStartDate <- as.Date("11/1/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("04/22/19", 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("04/22/19", 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:
Price and Wolfers attempted to replicate the findings reported in Roskes, Sligte, Shalvi, & DeDreu (2011), that when their team is behind, goalkeepers tend to jump to their right side during penalty kicks, thus exhibiting a right-oriented bias resulting from approach motivation.
In the current article, the authors recorded data on 240 penalty kicks taken during penalty kick shoot-outs of matches in the UEFA champions league’s final games and the Copa America soccer competitions, between the years 1984 and 2011. For each penalty kick the following information was coded by three independent observers: The keeper’s team position during the kick (leading, tied, or behind), the direction of the penalty taker’s shot (left, middle, or right), the direction in which the goalkeeper dove (left, middle, or right), and the outcome of the shot (score, save, or off-target). Coders were in general agreement with one another (agreed on 93% of penalty kicks and consensus was achieved for the remaining 7%).
Target outcomes:
In Table 1, we provide the main results using both Roskes et al.’s data and the new data that we collected. The earlier study revealed a greater propensity for the goalkeepers to dive to the right when their team was behind (70.8%) versus when their team was tied or ahead (49.0% and 46.3%, respectively). Our new data show a smaller difference based on the game situation (65.6% when their team was behind, 56.0% when tied, 55.6% when ahead), and none of these percentages are statistically significantly different from each other.
Figure 1. Price & Wolfers descriptive table
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(car)
library(pander)# 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
df=read_dta("data/price_wolfers.dta")Step 3: Tidy data
#First- retain only the variables that were recorded: direction of shot, direction of dive, what was the result of the kick and what was the score at the time.
df_tidy=df%>%select(id=id,team_pos=keeper_score, new_pos=new_score, shot_dir=directionshot, dive_dir=directiondive, rslt=result2, score=score)
#data structure
#str(df_tidy) #-> all of these are charachters. should be changed to factors
df_tidy$id=as.factor(df_tidy$id)
df_tidy$team_pos=as.factor(df_tidy$team_pos)
df_tidy$new_pos=as.factor(df_tidy$new_pos)
df_tidy$shot_dir=as.factor(df_tidy$shot_dir)
df_tidy$dive_dir=as.factor(df_tidy$dive_dir)
df_tidy$rslt=as.factor(df_tidy$rslt)
df_tidy$score=as.factor(df_tidy$score)
#Second- recode values of 'team_pos' to match what is reported in table 1
df_tidy$team_pos=recode(df_tidy$team_pos, "'a_behind'='1.Behind'; 'atie'='2.Tie'; 'z_ahead'='3.Ahead'")Step 4: Run analysis
Pre-processing
#set an object for number of shots in each position condition (team_pos and pos_new)
n_behind_old=sum(df_tidy$team_pos=="1.Behind")
n_tie_old=sum(df_tidy$team_pos=="2.Tie")
n_ahead_old=sum(df_tidy$team_pos=="3.Ahead")
n_behind_new=sum(df_tidy$new_pos=='behind')
n_not_new=sum(df_tidy$new_pos=='not behind')
#Recode shot_direction to reflect the direction from the goalie's perspective (rather than that of the penalty-taker's shot)
df_tidy$shot_dir_rv=recode(df_tidy$shot_dir, "'right'='left'; 'center'='center'; 'left'='right'")Descriptive statistics
#first- count the number of cases in each 'pos' condition
pos_old=table(df_tidy$team_pos)
pos_new=table(df_tidy$new_pos)At first, we wanted to make sure that we can get the same number of “behind”, “tie”, and “ahead” cases in the Roskes et al. coding scheme, and the same number of “behind” and “not behind” cases in the new coding scheme.
| 1.Behind | 2.Tie | 3.Ahead |
|---|---|---|
| 32 | 118 | 90 |
| behind | not behind |
|---|---|
| 72 | 168 |
As can be seen from the tables above- the counts are the same as those reported in Price & Wolfers’ table 1 in both cases.
Report:
reportObject <- reproCheck(reportedValue = '32', obtainedValue = pos_old[1], valueType = 'n')## [1] "MATCH for n. The reported value (32) and the obtained value (32) differed by 0%. Note that the obtained value was rounded to 0 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '118', obtainedValue = pos_old[2], valueType = 'n')## [1] "MATCH for n. The reported value (118) and the obtained value (118) differed by 0%. Note that the obtained value was rounded to 0 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '90', obtainedValue = pos_old[3], valueType = 'n')## [1] "MATCH for n. The reported value (90) and the obtained value (90) differed by 0%. Note that the obtained value was rounded to 0 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '72', obtainedValue = pos_new[1], valueType = 'n')## [1] "MATCH for n. The reported value (72) and the obtained value (72) differed by 0%. Note that the obtained value was rounded to 0 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '168', obtainedValue = pos_new[2], valueType = 'n')## [1] "MATCH for n. The reported value (168) and the obtained value (168) differed by 0%. Note that the obtained value was rounded to 0 decimal places to match the reported value."#Now- get the percent values
old_pos=df_tidy%>%group_by(team_pos)%>%summarise(dive_right=sum(dive_dir=='right'), dive_left=sum(dive_dir=='left'), shot_goalie_right=sum(shot_dir_rv=='right'), shot_goalie_left=sum(shot_dir_rv=='left'))%>%ungroup()
old_pos$dive_right[1]=round(((old_pos$dive_right[1]/n_behind_old)*100),1)
old_pos$dive_right[2]=round(((old_pos$dive_right[2]/n_tie_old)*100),1)
old_pos$dive_right[3]=round(((old_pos$dive_right[3]/n_ahead_old)*100),1)
old_pos$dive_left[1]=round(((old_pos$dive_left[1]/n_behind_old)*100),1)
old_pos$dive_left[2]=round(((old_pos$dive_left[2]/n_tie_old)*100),1)
old_pos$dive_left[3]=round(((old_pos$dive_left[3]/n_ahead_old)*100),1)
old_pos$shot_goalie_right[1]=round(((old_pos$shot_goalie_right[1]/n_behind_old)*100),1)
old_pos$shot_goalie_right[2]=round(((old_pos$shot_goalie_right[2]/n_tie_old)*100),1)
old_pos$shot_goalie_right[3]=round(((old_pos$shot_goalie_right[3]/n_ahead_old)*100),1)
old_pos$shot_goalie_left[1]=round(((old_pos$shot_goalie_left[1]/n_behind_old)*100),1)
old_pos$shot_goalie_left[2]=round(((old_pos$shot_goalie_left[2]/n_tie_old)*100),1)
old_pos$shot_goalie_left[3]=round(((old_pos$shot_goalie_left[3]/n_ahead_old)*100),1)All seem to match. Record:
reportObject <- reproCheck(reportedValue = '65.6', obtainedValue = old_pos %>% filter(team_pos == "1.Behind") %>% pull(dive_right), valueType = 'n')## [1] "MATCH for n. The reported value (65.6) and the obtained value (65.6) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '56.0', obtainedValue = old_pos %>% filter(team_pos == "2.Tie") %>% pull(dive_right), valueType = 'n')## [1] "MINOR_ERROR for n. The reported value (56) and the obtained value (55.9) differed by 0.18%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '55.6', obtainedValue = old_pos %>% filter(team_pos == "3.Ahead") %>% pull(dive_right), valueType = 'n')## [1] "MATCH for n. The reported value (55.6) and the obtained value (55.6) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '25.0', obtainedValue = old_pos %>% filter(team_pos == "1.Behind") %>% pull(dive_left), valueType = 'n')## [1] "MATCH for n. The reported value (25) and the obtained value (25) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '39.8', obtainedValue = old_pos %>% filter(team_pos == "2.Tie") %>% pull(dive_left), valueType = 'n')## [1] "MATCH for n. The reported value (39.8) and the obtained value (39.8) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '32.2', obtainedValue = old_pos %>% filter(team_pos == "3.Ahead") %>% pull(dive_left), valueType = 'n')## [1] "MATCH for n. The reported value (32.2) and the obtained value (32.2) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '53.1', obtainedValue = old_pos %>% filter(team_pos == "1.Behind") %>% pull(shot_goalie_right), valueType = 'n')## [1] "MATCH for n. The reported value (53.1) and the obtained value (53.1) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '48.3', obtainedValue = old_pos %>% filter(team_pos == "2.Tie") %>% pull(shot_goalie_right), valueType = 'n')## [1] "MATCH for n. The reported value (48.3) and the obtained value (48.3) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '37.8', obtainedValue = old_pos %>% filter(team_pos == "3.Ahead") %>% pull(shot_goalie_right), valueType = 'n')## [1] "MATCH for n. The reported value (37.8) and the obtained value (37.8) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '37.5', obtainedValue = old_pos %>% filter(team_pos == "1.Behind") %>% pull(shot_goalie_left), valueType = 'n')## [1] "MATCH for n. The reported value (37.5) and the obtained value (37.5) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '41.5', obtainedValue = old_pos %>% filter(team_pos == "2.Tie") %>% pull(shot_goalie_left), valueType = 'n')## [1] "MATCH for n. The reported value (41.5) and the obtained value (41.5) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '42.2', obtainedValue = old_pos %>% filter(team_pos == "3.Ahead") %>% pull(shot_goalie_left), valueType = 'n')## [1] "MATCH for n. The reported value (42.2) and the obtained value (42.2) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."#Next- do the same with the new coding
new_pos=df_tidy%>%group_by(new_pos)%>%summarise(dive_right=sum(dive_dir=='right'), dive_left=sum(dive_dir=='left'), shot_goalie_right=sum(shot_dir_rv=='right'), shot_goalie_left=sum(shot_dir_rv=='left'))%>%ungroup()
new_pos$dive_right[1]=round(((new_pos$dive_right[1]/n_behind_new)*100),1)
new_pos$dive_right[2]=round(((new_pos$dive_right[2]/n_not_new)*100),1)
new_pos$dive_left[1]=round(((new_pos$dive_left[1]/n_behind_new)*100),1)
new_pos$dive_left[2]=round(((new_pos$dive_left[2]/n_not_new)*100),1)
new_pos$shot_goalie_right[1]=round(((new_pos$shot_goalie_right[1]/n_behind_new)*100),1)
new_pos$shot_goalie_right[2]=round(((new_pos$shot_goalie_right[2]/n_not_new)*100),1)
new_pos$shot_goalie_left[1]=round(((new_pos$shot_goalie_left[1]/n_behind_new)*100),1)
new_pos$shot_goalie_left[2]=round(((new_pos$shot_goalie_left[2]/n_not_new)*100),1)All seems to match.
reportObject <- reproCheck(reportedValue = '62.5', obtainedValue = new_pos %>% filter(new_pos == "behind") %>% pull(dive_right), valueType = 'n')## [1] "MATCH for n. The reported value (62.5) and the obtained value (62.5) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '54.8', obtainedValue = new_pos %>% filter(new_pos == "not behind") %>% pull(dive_right), valueType = 'n')## [1] "MATCH for n. The reported value (54.8) and the obtained value (54.8) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '30.6', obtainedValue = new_pos %>% filter(new_pos == "behind") %>% pull(dive_left), valueType = 'n')## [1] "MATCH for n. The reported value (30.6) and the obtained value (30.6) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '36.9', obtainedValue = new_pos %>% filter(new_pos == "not behind") %>% pull(dive_left), valueType = 'n')## [1] "MATCH for n. The reported value (36.9) and the obtained value (36.9) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '50', obtainedValue = new_pos %>% filter(new_pos == "behind") %>% pull(shot_goalie_right), valueType = 'n')## [1] "MATCH for n. The reported value (50) and the obtained value (50) differed by 0%. Note that the obtained value was rounded to 0 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '42.9', obtainedValue = new_pos %>% filter(new_pos == "not behind") %>% pull(shot_goalie_right), valueType = 'n')## [1] "MATCH for n. The reported value (42.9) and the obtained value (42.9) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '40.3', obtainedValue = new_pos %>% filter(new_pos == "behind") %>% pull(shot_goalie_left), valueType = 'n')## [1] "MATCH for n. The reported value (40.3) and the obtained value (40.3) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '41.7', obtainedValue = new_pos %>% filter(new_pos == "not behind") %>% pull(shot_goalie_left), valueType = 'n')## [1] "MATCH for n. The reported value (41.7) and the obtained value (41.7) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."Next, we attempted to replicate the values in the last two columns of table 1, in row sets 2 & 4 (percent of successful shots when the goalie dove left/ right in each of the “team-position” coding schemes).
##Old coding
#count cases of keepers' dives
dir_dive_by_teampos=table(df_tidy$dive_dir, df_tidy$team_pos) #-> table with counts
#pull values from table
n_left_b_old=dir_dive_by_teampos[2,1]
n_left_t_old=dir_dive_by_teampos[2,2]
n_left_a_old=dir_dive_by_teampos[2,3]
n_right_b_old=dir_dive_by_teampos[3,1]
n_right_t_old=dir_dive_by_teampos[3,2]
n_right_a_old=dir_dive_by_teampos[3,3]
# Old coding successful shots by direction of dive and team position-count
old_suc=df_tidy%>%filter(dive_dir=="right" | dive_dir=="left")%>%group_by(team_pos, dive_dir)%>%summarise(suc_count=sum(rslt=='goal'))%>%ungroup()
#Recode into percetenge of dives in that direction
old_suc$suc_count[1]=round(((old_suc$suc_count[1]/n_left_b_old)*100),1)
old_suc$suc_count[2]=round(((old_suc$suc_count[2]/n_right_b_old)*100),1)
old_suc$suc_count[3]=round(((old_suc$suc_count[3]/n_left_t_old)*100),1)
old_suc$suc_count[4]=round(((old_suc$suc_count[4]/n_right_t_old)*100),1)
old_suc$suc_count[5]=round(((old_suc$suc_count[5]/n_left_a_old)*100),1)
old_suc$suc_count[6]=round(((old_suc$suc_count[6]/n_right_a_old)*100),1)No differences. Report:
reportObject <- reproCheck(reportedValue = '100', obtainedValue = old_suc %>% filter(team_pos == "1.Behind", dive_dir == "left") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (100) and the obtained value (100) differed by 0%. Note that the obtained value was rounded to 0 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '85.7', obtainedValue = old_suc %>% filter(team_pos == "1.Behind", dive_dir == "right") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (85.7) and the obtained value (85.7) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '72.3', obtainedValue = old_suc %>% filter(team_pos == "2.Tie", dive_dir == "left") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (72.3) and the obtained value (72.3) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '68.2', obtainedValue = old_suc %>% filter(team_pos == "2.Tie", dive_dir == "right") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (68.2) and the obtained value (68.2) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '65.5', obtainedValue = old_suc %>% filter(team_pos == "3.Ahead", dive_dir == "left") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (65.5) and the obtained value (65.5) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '78.0', obtainedValue = old_suc %>% filter(team_pos == "3.Ahead", dive_dir == "right") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (78) and the obtained value (78) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."##New coding
#count cases of keepers' dives
dir_dive_by_newpos=table(df_tidy$dive_dir, df_tidy$new_pos) #-> table with counts
#pull values from table
n_left_b_new=dir_dive_by_newpos[2,1]
n_left_not_new=dir_dive_by_newpos[2,2]
n_right_b_new=dir_dive_by_newpos[3,1]
n_right_not_new=dir_dive_by_newpos[3,2]
# New coding scheme successful shots by direction of dive and team position-count
new_suc=df_tidy%>%filter(dive_dir=="right" | dive_dir=="left")%>%group_by(new_pos, dive_dir)%>%summarise(suc_count=sum(rslt=='goal'))%>%ungroup()
#Recode into percetenge of dives in that direction
new_suc$suc_count[1]=round(((new_suc$suc_count[1]/n_left_b_new)*100),1)
new_suc$suc_count[2]=round(((new_suc$suc_count[2]/n_right_b_new)*100),1)
new_suc$suc_count[3]=round(((new_suc$suc_count[3]/n_left_not_new)*100),1)
new_suc$suc_count[4]=round(((new_suc$suc_count[4]/n_right_not_new)*100),1)reportObject <- reproCheck(reportedValue = '77.3', obtainedValue = new_suc %>% filter(new_pos == "behind", dive_dir == "left") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (77.3) and the obtained value (77.3) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '75.6', obtainedValue = new_suc %>% filter(new_pos == "behind", dive_dir == "right") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (75.6) and the obtained value (75.6) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '71.0', obtainedValue = new_suc %>% filter(new_pos == "not behind", dive_dir == "left") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (71) and the obtained value (71) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."reportObject <- reproCheck(reportedValue = '73.9', obtainedValue = new_suc %>% filter(new_pos == "not behind", dive_dir == "right") %>% pull(suc_count), valueType = 'n')## [1] "MATCH for n. The reported value (73.9) and the obtained value (73.9) differed by 0%. Note that the obtained value was rounded to 1 decimal places to match the reported value."Inferential statistics
The statistical tests employed were not actually explicitly stated in Price & Wolfers’ article, however, we made an educated guess that they were chi-squared tests given the context.
# recreate the table of count of dive directions by team position (old coding)
old_pos=df_tidy%>%group_by(team_pos)%>%summarise(dive_right=sum(dive_dir=='right'), dive_left=sum(dive_dir=='left'), shot_goalie_right=sum(shot_dir_rv=='right'), shot_goalie_left=sum(shot_dir_rv=='left'))%>%ungroup()
#number of dives to the right for each of the conditions
dives_right_behind=old_pos$dive_right[1]
dives_right_tied=old_pos$dive_right[2]
dives_right_ahead=old_pos$dive_right[3]
# prop.test for dives to the right when the team was behind vs. when the score was tied
bVt=prop.test(x=c(dives_right_behind, dives_right_tied), n=c(n_behind_old, n_tie_old), alternative = "greater", correct = F)
bVa=prop.test(x=c(dives_right_behind, dives_right_ahead), n=c(n_behind_old, n_ahead_old), alternative = "greater", correct = F)
tVa=prop.test(x=c(dives_right_tied, dives_right_ahead), n=c(n_tie_old, n_ahead_old), alternative = "greater", correct = F)As can be seen in more detail in the tables below, we also did not find any significant difference between the percentege of dives to the right when the goalkeeper’s team was behind, tied, or ahead.
| Test statistic | df | P value | Alternative hypothesis | prop 1 | prop 2 |
|---|---|---|---|---|---|
| 0.971 | 1 | 0.1622 | greater | 0.656 | 0.559 |
| Test statistic | df | P value | Alternative hypothesis | prop 1 | prop 2 |
|---|---|---|---|---|---|
| 0.984 | 1 | 0.1606 | greater | 0.656 | 0.556 |
| Test statistic | df | P value | Alternative hypothesis | prop 1 | prop 2 |
|---|---|---|---|---|---|
| 0.00294 | 1 | 0.4784 | greater | 0.559 | 0.556 |
Step 5: Conclusion
We were able to successfull reproduce all target outcomes. It was necessary for us to make an ‘educated guess’ about the statistical test that was employed.
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 <- NA # 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("MATCH", "MINOR_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-11
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date lib
## abind 1.4-5 2016-07-21 [1]
## 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]
## car * 3.0-7 2020-03-11 [1]
## carData * 3.0-3 2019-11-16 [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]
## curl 4.3 2019-12-02 [1]
## data.table 1.12.8 2019-12-09 [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]
## forcats * 0.5.0 2020-03-01 [1]
## foreign 0.8-78 2020-04-13 [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]
## glue 1.4.0 2020-04-03 [1]
## gtable 0.3.0 2019-03-25 [1]
## haven * 2.2.0 2019-11-08 [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]
## lattice 0.20-41 2020-04-02 [1]
## lifecycle 0.2.0 2020-03-06 [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]
## openxlsx 4.1.4 2019-12-06 [1]
## pander * 0.6.3 2018-11-06 [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]
## rio 0.5.16 2018-11-26 [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]
## zip 2.0.4 2019-09-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)
## 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)
## CRAN (R 4.0.0)
## CRAN (R 4.0.0)
##
## [1] /Library/Frameworks/R.framework/Versions/4.0/Resources/library