#a review and, if possible, meta-analysis of QRP survey data
rm(list=ls())
library(xlsx)
library(ggplot2)
library(plyr)
library(dplyr)
library(grid)
library(gridExtra)
library(agricolae)#for median test
library(cowplot)

#write.csv(dfRaw, "QRPdataCleanFinal.csv")
df<-read.xlsx("QRPdataClean_final.xlsx", 1, stringsAsFactors=FALSE, na.strings=c("NA", ""))
goodCols<-c(
  "originalRowOrder", "studyTitle", "studyID", "coder",
  "disciplineCat", "domainCat",
  "countryCat", "continentCat",
  "careerLevelCat", 
  "targetSampleSizeCorr", "actualSampleSizeCorr", #"samplingMethodCat", nothing here
  "distributionMethodCat", "administrationMethodCat", 
  "outcomeScaleCat", "recallPeriod",
  "QRPdescription", "QRParea",
  "QRPmod", "QRPcat",
  "percOnceOrMore", "notes", "added.notes", #"percOrN.Never", "percOrN.NA",
  "QRParea_R1", "QRParea_R2", "QRParea_R3", 
  "QRPmod_R1", "QRPmod_R2", "QRPmod_R3", 
  "QRPcat_R1", "QRPcat_R2", "QRPcat_R3", "IRRround", 
  "Rater", "Disagreement.QRParea", "Disagreement.QRPmod",
  "Disagreement.QRPcat", "QRParea_moderated",
  "QRPmod_moderated", "QRPcat_moderated"   
  )
df<-df[df$Included==1,goodCols]
#rm(dfRaw)
df$coder<-factor(df$coder, ordered=FALSE)
df$Rater<-factor(df$Rater, ordered = FALSE)


##### compute interrater reliability for each type
#install.packages("icr")
library(icr)
?icr::krippalpha()
#function to calculate
iffCalc<-function(df){
  m_area <- rbind(
    R1 = as.character(df$QRParea_R1),
    R2 = as.character(df$QRParea_R2),
    R3 = as.character(df$QRParea_R3)
  )
  alpha_area <- krippalpha(
    data = m_area,
    metric = "nominal"
  )
  #alpha_area$alpha
  m_mod <- rbind(
    R1 = as.character(df$QRPmod_R1),
    R2 = as.character(df$QRPmod_R2),
    R3 = as.character(df$QPRmod_R3)
  )
  alpha_mod <- krippalpha(
    data = m_mod,
    metric = "nominal"
  )
  #alpha_misrep$alpha
  m_qrpcat <- rbind(
    R1 = as.character(df$QRPcat_R1),
    R2 = as.character(df$QRPcat_R2),
    R3 = as.character(df$QRPcat_R3)
  )
  alpha_qrpcat <- krippalpha(
    data = m_qrpcat,
    metric = "nominal"
  )
  #alpha_qrpcat$alpha
  # Combine everything into one table
  results <- data.frame(
    Variable = c("QRParea", "QRPmod", "QRPcat"),
    Kripp_alpha = c(alpha_area$alpha, alpha_mod$alpha, alpha_qrpcat$alpha)
  )
  # Print nicely
  print(results)
}

#select data and irr round
dfirr1<-subset(df, IRRround==1)
iffCalc(dfirr1)
dfirr2<-subset(df, IRRround==2)
iffCalc(dfirr2)
###second round has high IRR, especially for QRP cat
##Pairwise alphas
##area
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRParea_R1), 
               R2 = as.character(dfirr2$QRParea_R2)),
  metric = "nominal"
)$alpha
#0.64
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRParea_R1), 
               R3 = as.character(dfirr2$QRParea_R3)),
  metric = "nominal"
)$alpha
#0.65
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRParea_R3), 
               R3 = as.character(dfirr2$QRParea_R2)),
  metric = "nominal"
)$alpha
#0.45
##modality
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRPmod_R1), 
               R2 = as.character(dfirr2$QRPmod_R2)),
  metric = "nominal"
)$alpha
#0.65
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRPmod_R1), 
               R3 = as.character(dfirr2$QRPmod_R3)),
  metric = "nominal"
)$alpha
#0.61
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRPmod_R3), 
               R3 = as.character(dfirr2$QRPmod_R2)),
  metric = "nominal"
)$alpha
#0.50
##type
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRPcat_R1), 
               R2 = as.character(dfirr2$QRPcat_R2)),
  metric = "nominal"
)$alpha
#0.91
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRPcat_R1), 
               R3 = as.character(dfirr2$QRPcat_R3)),
  metric = "nominal"
)$alpha
#0.77
krippalpha(
  data = rbind(R1 = as.character(dfirr2$QRPcat_R3), 
               R3 = as.character(dfirr2$QRPcat_R2)),
  metric = "nominal"
)$alpha
#0.77

###we then recoded the rest a second time independently
##final variables were moderated
df$QRPareaF<-factor(df$QRParea_moderated, ordered = FALSE)
df$QRPmodF<-factor(df$QRPmod_moderated, ordered=TRUE, levels=c("omit", "add", "modify", "other"), labels=c("omission", "addition", "modification", "other"))
df$QRPcatF<-factor(df$QRPcat_moderated, ordered = FALSE)
df$QRPamF<-factor(paste(df$QRPareaF, df$QRPmodF, sep = " "), ordered = FALSE)

####### VARIABLE PREPARATION
df$disciplineCat<-factor(df$disciplineCat, ordered=FALSE)
df$domainCat<-factor(df$domainCat, ordered=TRUE, levels=c("mixed", "biological", "social"), labels = c("multidisc.", "biological", "social"))
df$countryCat<-factor(df$countryCat, ordered=FALSE)
df$countryCat<-relevel(df$countryCat, ref="USA")
df$continentCat<-factor(df$continentCat, ordered=TRUE, levels=c("mixed", "America", "Europe", "Oceania"), labels=c("other/multi.", "America", "Europe", "other/multi."))
df$careerLevelCat3<-factor(df$careerLevel, ordered=TRUE, levels=c("UG student", "MSc student", "PhD student", "researcher", "mixed"), labels = c("pre-PhD", "pre-PhD",  "pre-PhD", "post-PhD", "all levels"))
df$distributionMethodCat<-factor(df$distributionMethodCat, ordered=FALSE)
df$administrationMethodCat<-factor(df$administrationMethodCat, ordered=FALSE)
df$outcomeScaleCat<-factor(df$outcomeScaleCat, ordered=FALSE)
df$outcomeScaleCatBinary<-df$outcomeScaleCat=="2"
df$recallPeriod<-factor(df$recallPeriod, ordered=FALSE)
df$percOnceOrMore<-as.numeric(df$percOnceOrMore)
df$percOnceOrMore[is.na(df$percOnceOrMore)]<-0
df$actualSampleSizeCorr<-as.numeric(df$actualSampleSizeCorr)
df$targetSampleSizeCorr<-as.numeric(df$targetSampleSizeCorr)
df$stErr<-sqrt( ((df$percOnceOrMore/100)*(1-df$percOnceOrMore/100))/df$actualSampleSizeCorr)

df$prop<-df$percOnceOrMore/100+10^(-5)
df$logit<-log((df$prop)/(1-df$prop))
df$stErrLogit<-sqrt((1/(df$actualSampleSizeCorr*df$prop))+(1/(df$actualSampleSizeCorr*(1-df$prop))))
df$logitWeight<-df$actualSampleSizeCorr*df$prop*(1-df$prop)

##calculate media, mean etc. for the categories
# initial classification
df<-ddply(df, .(QRPareaF), mutate,
          median_a=median(percOnceOrMore), 
          rangeSize_a = max(percOnceOrMore, na.rm=TRUE)-min(percOnceOrMore, na.rm = TRUE),
          mean_a=mean(percOnceOrMore, na.rm = TRUE),
          sd_a=sd(logitWeight, na.rm = TRUE),
          weightedMean_a=100*exp(weighted.mean(logit, logitWeight))/(1+exp(weighted.mean(logit, logitWeight))),
          k_a=length(percOnceOrMore),
          totN_a=sum(actualSampleSizeCorr, na.rm = TRUE))
df<-ddply(df, .(QRPmodF), mutate,
          median_m=median(percOnceOrMore), 
          rangeSize_m = max(percOnceOrMore, na.rm=TRUE)-min(percOnceOrMore, na.rm = TRUE),
          mean_m=mean(percOnceOrMore, na.rm = TRUE),
          sd_m=sd(logitWeight, na.rm = TRUE),
          weightedMean_m=100*exp(weighted.mean(logit, logitWeight))/(1+exp(weighted.mean(logit, logitWeight))),
          k_m=length(percOnceOrMore),
          totN_m=sum(actualSampleSizeCorr, na.rm = TRUE))
df<-ddply(df, .(QRPareaF, QRPmodF), mutate, OAMareaCat = paste(QRPareaF, QRPmodF, sep="-"),
          median_oam=median(percOnceOrMore), 
          rangeSize_oam = max(percOnceOrMore, na.rm=TRUE)-min(percOnceOrMore, na.rm = TRUE),
          mean_oam=mean(percOnceOrMore, na.rm = TRUE),
          sd_oam=sd(logitWeight, na.rm = TRUE),
          weightedMean_oam=100*exp(weighted.mean(logit, logitWeight))/(1+exp(weighted.mean(logit, logitWeight))),
          k_oam=length(percOnceOrMore),
          totN_oam=sum(actualSampleSizeCorr, na.rm = TRUE))
df<-ddply(df, .(QRPamF), mutate,
          median_com=median(percOnceOrMore),
          rangeSize_com = max(percOnceOrMore, na.rm=TRUE)-min(percOnceOrMore, na.rm = TRUE),
          mean_com=mean(percOnceOrMore, na.rm = TRUE),
          sd_com=sd(logitWeight, na.rm = TRUE),
          weightedMean_com=100*exp(weighted.mean(logit, logitWeight))/(1+exp(weighted.mean(logit, logitWeight))),
          k_com=length(percOnceOrMore), totN=sum(actualSampleSizeCorr, na.rm = TRUE))
df<-ddply(df, .(QRPcatF), mutate,
          median=median(percOnceOrMore), 
          rangeSize = max(percOnceOrMore, na.rm=TRUE)-min(percOnceOrMore, na.rm = TRUE),
          mean=mean(percOnceOrMore, na.rm = TRUE),
          sd=sd(logitWeight, na.rm = TRUE),
          weightedMean=100*exp(weighted.mean(logit, logitWeight))/(1+exp(weighted.mean(logit, logitWeight))),
          k=length(percOnceOrMore), totN=sum(actualSampleSizeCorr, na.rm = TRUE))

df$aboveMedian<-df$percOnceOrMore>df$median
df$respRate<-100*df$actualSampleSizeCorr/df$targetSampleSizeCorr
df$respRateLogit<-log(df$respRate/(100-df$respRate))

#split within-study samples
df$studySample<-factor(paste(df$studyID, df$careerLevelCat, sep="-"))
#subset with only one sample per study, to be conservative in statistical tests
dfs<-df[!is.element(df$studySample, c("12-mixed", "12-student", "25-mixed")),]

#########################RESULTS
#descriptives
#total number of data
length(df$QRPcatF)#296
#total number of studies
length(levels(as.factor(df$studyID)))#20
#total number of samples
length(levels(df$studySample))#23
#descriptives table
df$sampleID<-factor(paste(df$studyID, df$careerLevelCat))
dfTab<-df[!duplicated(df$sampleID),c(
  "studyID", "countryCat", "disciplineCat", "careerLevelCat", "actualSampleSizeCorr"
)]
idNames<-data.frame(names=c("Felaefel 2018", "Makel 2021", "Ferraro ", "Artino 2019", "Morian 2023", "John 2012", "Isbell 2022",
                            "Rajah-Kanagasabai ", "Gopalakrishna 2022", "Braun 2012", "Bakker 2021", "Swift 2022", "Agnoli 2017",
                            "Kaiser 2022", "Chin 2023", "Fraser 2018", "Fiedler 2016", "Pupvac 2017", "Ljubenkovic 2021", "Motyl 2017"),
                    ids = c(1, 3, 4, 7, 12, 16, 17, 19, 20, 21, 23, 25, 26, 27, 28, 29, 30, 34, 37, 41))#for use in table 2
dfTab<-dfTab[order(dfTab$studyID),]
dfTab["First aut."]<-c("Felaefel", "Makel", "Ferraro", "Artino", rep("Moran", 3), "John", "Isbell",
                       "Rajah-Kanagasabai", "Gopalakrishna", "Braun", "Bakker", rep("Swift", 2), "Agnoli",
                       "Kaiser", "Chin", "Fraser", "Fiedler", "Pupovac", "Ljubenkovic", "Motyl")#study names
dfTab["year"]<-c("2018", "2021", "2022", "2019", rep("2023", 3), "2012", "2022",
                       "2015", "2022", "2012", "2021", rep("2022", 2), "2017",
                       "2022", "2023", "2018", "2016", "2017", "2021", "2017")#study names
dfTab$ref<-"TBD"
dfTab<-dfTab[,c("studyID", "First aut.", "year", "countryCat", "disciplineCat", "careerLevelCat", "actualSampleSizeCorr", "ref")]
names(dfTab)<-c("studyID", "First aut.", "Year", "Country", "Discpline", "Career level", "N", "Ref.")
dfTabOrd<-dfTab[order(dfTab$Year),names(dfTab)[-1]]
write.csv(dfTabOrd, "Table1.csv", row.names = FALSE)

################# FIGURES AND ANALYSES
textSize<-8
axisTextSize<-22
axisTitleSize<-22
titSize<-26
subTitSize<-22
noteSize<-6
pointSize<-4
textAngle <- 60

getMT<-function(x, data=df){
  mt<-Median.test(data[,"percOnceOrMore"], data[,x])
  ifelse(mt$statistics[3]<0.0001, pval<-"P<0.001",pval<-paste("P=", round(mt$statistics[3],3), sep=""))
  return(paste(paste("Chisq=", round(mt$statistics[1],2), sep=""),",", pval))
}

#overall averages by QRP
df$QRPoMedian_a<-factor(df$QRPareaF, ordered = TRUE, levels(reorder(df$QRPareaF, df$median_a, decreasing = TRUE)))
df$QRPoMean_a<-factor(df$QRPareaF, ordered = TRUE, levels(reorder(df$QRPareaF, df$mean_a, decreasing = TRUE)))
df$QRPoMeanW_a<-factor(df$QRPareaF, ordered = TRUE, levels(reorder(df$QRPareaF, df$weightedMean_a, decreasing = TRUE)))
df$QRPoRange_a<-factor(df$QRPareaF, ordered = TRUE, levels(reorder(df$QRPareaF, df$rangeSize_a, decreasing = TRUE)))
df$QRPoSd_a<-factor(df$QRPareaF, ordered = TRUE, levels(reorder(df$QRPareaF, df$sd_a, decreasing = TRUE)))

#kLabs<-paste0("(", df$k, ")")
kLabs_a<-df$k_a
pAllmedian_a<-
  ggplot(df, aes(QRPoMedian_a, percOnceOrMore))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = textAngle, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
  geom_text(data=df, mapping=aes(label= kLabs_a), y=-3, stat="unique", size=textSize)+ylim(-5, 80)+
  labs(title="Ranking of QRP by area", y="reports engaging once or more (%)")+
  annotate("text", x=7.5, y=80, label=getMT("QRPamF", df), size=noteSize)

df$QRPoMedian_m<-factor(df$QRPmodF, ordered = TRUE, levels(reorder(df$QRPmodF, df$median_m, decreasing = TRUE)))
df$QRPoMean_m<-factor(df$QRPmodF, ordered = TRUE, levels(reorder(df$QRPmodF, df$mean_m, decreasing = TRUE)))
df$QRPoMeanW_m<-factor(df$QRPmodF, ordered = TRUE, levels(reorder(df$QRPmodF, df$weightedMean_m, decreasing = TRUE)))
df$QRPoRange_m<-factor(df$QRPmodF, ordered = TRUE, levels(reorder(df$QRPmodF, df$rangeSize_m, decreasing = TRUE)))
df$QRPoSd_m<-factor(df$QRPmodF, ordered = TRUE, levels(reorder(df$QRPmodF, df$sd_m, decreasing = TRUE)))

#kLabs<-paste0("(", df$k, ")")
kLabs_m<-df$k_m
pAllmedian_m<-
  ggplot(df, aes(QRPoMedian_m, percOnceOrMore))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = textAngle, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
  geom_text(data=df, mapping=aes(label= kLabs_m), y=-3, stat="unique", size=textSize)+ylim(-5, 80)+
  labs(title="Ranking of QRP by area", y="reports engaging once or more (%)")+
  annotate("text", x=2.5, y=80, label=getMT("QRPmodF", df), size=noteSize)


#overall averages by QRP
df$QRPoMedian_com<-factor(df$QRPamF, ordered = TRUE, levels(reorder(df$QRPamF, df$median_com, decreasing = TRUE)))
df$QRPoMean_com<-factor(df$QRPamF, ordered = TRUE, levels(reorder(df$QRPamF, df$mean_com, decreasing = TRUE)))
df$QRPoMeanW_com<-factor(df$QRPamF, ordered = TRUE, levels(reorder(df$QRPamF, df$weightedMean_com, decreasing = TRUE)))
df$QRPoRange_com<-factor(df$QRPamF, ordered = TRUE, levels(reorder(df$QRPamF, df$rangeSize_com, decreasing = TRUE)))
df$QRPoSd_com<-factor(df$QRPamF, ordered = TRUE, levels(reorder(df$QRPamF, df$sd_com, decreasing = TRUE)))


#kLabs<-paste0("(", df$k, ")")
kLabs_com<-df$k_com
pAllmedian_com<-
  ggplot(df, aes(QRPoMedian_com, percOnceOrMore))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = textAngle, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
  geom_text(data=df, mapping=aes(label= kLabs_com), y=-3, stat="unique", size=textSize)+ylim(-5, 80)+
  labs(title="Ranking of QRP by modality and area", y="reports engaging once or more (%)")+
  annotate("text", x=15, y=80, label=getMT("QRPamF", df), size=noteSize)

top_row    <- plot_grid(pAllmedian_a, pAllmedian_m, labels = c("a", "b"), ncol = 2)
bottom_row <- plot_grid(pAllmedian_com, labels = "c", ncol = 1)

tiff("Fig1.tiff", width = 1800, height = 1400)
plot_grid(top_row, bottom_row, ncol = 1, rel_heights = c(1, 1))
dev.off()


########## table with QRP type definition
#table with raw data
QRPdefsTab<-df[!duplicated(df$QRPdescription),c("QRPdescription", "QRPareaF", "QRPmodF", "QRPcatF", "studyID")]
QRPdefsTab<-QRPdefsTab[order(QRPdefsTab$QRPcatF, QRPdefsTab$QRPareaF, QRPdefsTab$QRPmodF),]
QRPdefsTabExamples<-QRPdefsTab[!duplicated(cbind(QRPdefsTab$QRPcatF, QRPdefsTab$QRPareaF, QRPdefsTab$QRPmodF)),]
for(i in 1:length(QRPdefsTabExamples$studyID)){#replace study ids with study names
  QRPdefsTabExamples$studyID[i]<-idNames$names[idNames$ids==QRPdefsTabExamples$studyID[i]]
}
names(QRPdefsTab)<-c("Phrasing example", "QRP area", "QRP modality", "QRP type", "Reference")
names(QRPdefsTabExamples)<-names(QRPdefsTab)
write.csv(QRPdefsTab, "Table2all.csv", row.names = FALSE)
write.csv(QRPdefsTabExamples, "Table2uniques.csv", row.names = FALSE)

######### Figure 2
#overall averages by QRP
df$QRPoMedian<-factor(df$QRPcatF, ordered = TRUE, levels(reorder(df$QRPcatF, df$median, decreasing = TRUE)))
df$QRPoMean<-factor(df$QRPcatF, ordered = TRUE, levels(reorder(df$QRPcatF, df$mean, decreasing = TRUE)))
df$QRPoMeanW<-factor(df$QRPcatF, ordered = TRUE, levels(reorder(df$QRPcatF, df$weightedMean, decreasing = TRUE)))
df$QRPoRange<-factor(df$QRPcatF, ordered = TRUE, levels(reorder(df$QRPcatF, df$rangeSize, decreasing = TRUE)))
df$QRPoSd<-factor(df$QRPcatF, ordered = TRUE, levels(reorder(df$QRPcatF, df$sd, decreasing = TRUE)))


#kLabs<-paste0("(", df$k, ")")
kLabs<-df$k
kLabs[(df$QRPcatF=="other" & df$QRPareaF!="results")|(df$QRPcatF=="appropriate ideas" & df$QRPareaF!="peerReview")|(df$QRPcatF=="self-plagiarism" & df$QRPareaF=="publication")|(df$QRPcatF=="sponsorPressure"&df$QRPareaF=="results")]<-NA
pAllmedian<-
  ggplot(df, aes(QRPoMedian, percOnceOrMore))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = textAngle, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
  geom_text(data=df, mapping=aes(label= kLabs), y=-3, stat="unique", size=textSize)+ylim(-5, 80)+
  labs(title="Ranking of QRP types by admission frequency", y="reports engaging once or more (%)")+
  annotate("text", x=15, y=80, label=getMT("QRPareaF", df), size=noteSize)

getMT("QRPcatF")#"Chisq=99.08" "P<0.001"

tiff("Fig2.tiff", width = 1200, height = 600)
pAllmedian
dev.off()

#alternative orderings:
med<-seq(1:length(levels(df$QRPoMedian)))
mea<-match(levels(df$QRPoMean), levels(df$QRPoMedian))
cor.test(med, mea, method = "spearman")#0.94
meaw<-match(levels(df$QRPoMean), levels(df$QRPoMeanW))
cor.test(med, meaw, method = "spearman")#0.83

#### results by subsetted data 
##### Survey characteristics
pDis<-
  ggplot(df, aes(distributionMethodCat, percOnceOrMore, fill=distributionMethodCat))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize), legend.position = "bottom", plot.margin = unit(c(1,0,1,0), "cm"))+
  labs(title="Mode of survey distribution", y="")+
  scale_fill_discrete(name = "Mode:")+
  annotate("text", x=2, y=95, label=getMT("distributionMethodCat", df), size=noteSize)+ylim(0,95)+
  stat_summary(fun.y=median, fun.ymax = "length", geom = "text", aes(label=..ymax..), vjust=-1/2, size=textSize) 

pAdmin<-
  ggplot(df, aes(administrationMethodCat, percOnceOrMore, fill=administrationMethodCat))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize), legend.position = "bottom", plot.margin = unit(c(1,0,1,0), "cm"))+
  labs(title="Mode of survey administration", y="")+
  scale_fill_discrete(name = "Mode:")+
  annotate("text", x=1.5, y=95, label=getMT("administrationMethodCat", df), size=noteSize)+ylim(0,95)+
  stat_summary(fun.y=median, fun.ymax = "length", geom = "text", aes(label=..ymax..), vjust=-1/2, size=textSize) 

pRec<-
  ggplot(df, aes(recallPeriod, percOnceOrMore, fill=recallPeriod))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize), legend.position = "bottom", plot.margin = unit(c(1,0,1,0), "cm"))+
  labs(title="Recall period", y="")+
  scale_fill_discrete(name = "Period:")+
  annotate("text", x=1.5, y=95, label=getMT("recallPeriod", df), size=noteSize)+ylim(0,95)+
  stat_summary(fun.y=median, fun.ymax = "length", geom = "text", aes(label=..ymax..), vjust=-1/2, size=textSize) 

pSc<-
  ggplot(df, aes(outcomeScaleCat, percOnceOrMore, fill=outcomeScaleCat))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize), legend.position = "bottom", plot.margin = unit(c(1,0,1,0), "cm"))+
  labs(title="Outcome scale range", y="")+
  scale_fill_discrete(name = "Scale:")+
  annotate("text", x=3.5, y=95, label=getMT("outcomeScaleCat", df), size=noteSize)+ylim(0,95)+
  stat_summary(fun.y=median, fun.ymax = "length", geom = "text", aes(label=..ymax..), vjust=-1/2, size=textSize) 

lmr<-summary(with(dfs,glm(I(percOnceOrMore/100)~actualSampleSizeCorr, family="binomial")))$coefficients
pSample<-
  ggplot(df, aes(actualSampleSizeCorr, percOnceOrMore))+geom_point(aes(col=as.factor(studyID)))+scale_y_log10()+scale_x_log10()+
  geom_smooth(method = "lm")+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.position = "none", plot.margin = unit(c(1,0,1,0), "cm"))+
  labs(title="Sample size", y="")+
  scale_fill_discrete(name = "Level")+
  annotate("text", x=1200, y=1, label=paste(paste("z=", round(lmr[6],2), sep=""), paste("P=", round(lmr[8],3))), size=noteSize)

lmrr<-summary(with(dfs,glm(I(percOnceOrMore/100)~respRate+actualSampleSizeCorr, family="binomial")))$coefficients
pResponse<-
  ggplot(df, aes(respRate, percOnceOrMore))+geom_point(aes(col=as.factor(studyID)))+scale_y_log10()+scale_x_log10()+
  geom_smooth(method = "lm")+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.position = "none", plot.margin = unit(c(1,0,1,0), "cm"))+
  labs(title="Response rate", y="")+
  scale_fill_discrete(name = "Level")+
  annotate("text", x=50, y=1, label=paste(paste("z=", round(lmrr[8],2), sep=""), paste("P=", round(lmrr[11],3))), size=noteSize)

tit5<-textGrob(label="Admission frequency of QRP, by survey characteristics", gp=gpar(fontsize=titSize, vjust = 0.5))
tit5y<-textGrob(label="reports engaging once or more (%, log scale)", gp=gpar(fontsize=axisTextSize, vjust = 0.5), rot=90)
bl<-grid.arrange(pDis, pAdmin, pRec, pSc, pSample, pResponse, layout_matrix=rbind(c(1,2),c(3,4),c(5,6)))
bl2<-grid.arrange(tit5y, bl, layout_matrix=rbind(c(1,2)), widths=c(1,15))

tiff("Fig3.tiff", width = 1800, height = 1400)
grid.arrange(tit5, bl2, layout_matrix=rbind(c(1),c(2)), heights=c(1,9))
dev.off()


#function to select subsamples with >1 data point (QRP) in each subtype
dfsf<-function(x, levs=2, data=df, minK=1){
  if(levs==3){
    QRPcatSelect<-levels(data$QRPcatF)[table(data$QRPcatF, data[,x])[,1]>minK & table(data$QRPcatF, data[,x])[,2]>minK & table(data$QRPcatF, data[,x])[,3]>minK]
  }else if(levs==4){
    QRPcatSelect<-levels(data$QRPcatF)[table(data$QRPcatF, data[,x])[,1]>minK & table(data$QRPcatF, data[,x])[,2]>minK & table(data$QRPcatF, data[,x])[,3]>minK & table(data$QRPcatF, data[,x])[,4]>minK]
  }else{
    QRPcatSelect<-levels(data$QRPcatF)[table(data$QRPcatF, data[,x])[,1]>minK & table(data$QRPcatF, data[,x])[,2]>minK]
  }
  return(subset(data, is.element(QRPcatF, QRPcatSelect)))
}
makeSub<-function(x, levs=2){
  res<-dfsf(x, levs)
  res$QRPcatF<-droplevels(res$QRPcatF)
  res$QRPoMedian<-factor(res$QRPcatF, ordered = TRUE, levels(reorder(res$QRPcatF, res$median, decreasing = TRUE)))
  return(res)
}

addNpos<-function(data, catName, shift=4){
  return(as.numeric(data[,"QRPoMedian"])+(as.numeric(data[,catName])-2)/shift)
}

dfCareer<-makeSub("careerLevelCat3", 3)
dfCareer$kLabsPos<-addNpos(dfCareer, "careerLevelCat3")
pCareer<-
  ggplot(dfCareer, aes(QRPoMedian, percOnceOrMore, fill=careerLevelCat3))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = titSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
  labs(title="Career level", y="")+
  scale_fill_discrete(name = "Level")+
  annotate("text", x=5, y=70, label=getMT("careerLevelCat3", dfCareer), size=noteSize)+
  stat_summary(fun.y=median, fun.ymax = "length", geom = "text", aes(x=kLabsPos, label=..ymax..), vjust=-1/2, size=textSize) 
#differences by discipline
dfDomain<-makeSub("domainCat", 3)
dfDomain$kLabsPos<-addNpos(dfDomain, "domainCat", 4)
pDomain<-
  ggplot(dfDomain, aes(QRPoMedian, percOnceOrMore, fill=domainCat))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = subTitSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
  labs(title="Disciplinary domain", y="")+
  scale_fill_discrete(name = "Domain")+
  annotate("text", x=2.5, y=55, label=getMT("domainCat", data=dfDomain), size=noteSize)+
  stat_summary(fun.y=median, fun.ymax = "length", geom = "text", aes(x=kLabsPos, label=..ymax..), vjust=-1/2, size=textSize) 

#differences by continent
dfCont<-makeSub("continentCat", 3)
dfCont$kLabsPos<-addNpos(dfCont, "continentCat", 4)
pCont<-
  ggplot(dfCont, aes(QRPoMedian, percOnceOrMore, fill=continentCat))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 30, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = subTitSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
  labs(title="Geographical location", y="")+
  scale_fill_discrete(name = "Location")+
  annotate("text", x=5, y=70, label=getMT("continentCat", dfCont), size=noteSize)+
  stat_summary(fun.y=median, fun.ymax = "length", geom = "text", aes(x=kLabsPos, label=..ymax..), vjust=-1/2, size=textSize) 

tit3<-textGrob(label="Admission frequency of QRP, by survey participant characteristics", gp=gpar(fontsize=titSize, vjust = 0.5))
tit3y<-textGrob(label="reports engaging once or more (%)", gp=gpar(fontsize=axisTextSize, vjust = 0.5), rot=90)
bl1<-grid.arrange(pCareer, pDomain, pCont, tit3y, ncol=2,layout_matrix=rbind(c(4,1),c(4,2),c(4,3)), heights=c(4,4,4), widths=c(1,15))

tiff("Fig4.tiff", width = 1800, height = 1200)
grid.arrange(tit3, bl1, ncol=1, layout_matrix=rbind(c(1),c(2)), heights=c(1,8))
dev.off()

### more conservative ranking
dfprePhDs<-subset(df, careerLevelCat3=="pre-PhD")
dfprePhDs<-ddply(dfprePhDs, .(QRPcatF), mutate,
          median=median(percOnceOrMore),
          k=length(percOnceOrMore), totN=sum(actualSampleSizeCorr, na.rm = TRUE))
kLabsdfprePhDs<-dfprePhDs$k
kLabsdfprePhDs[(dfprePhDs$QRPcatF=="appropriate ideas" & dfprePhDs$QRPareaF!="peerReview")]<-NA

dfprePhDs$QRPoMedian<-factor(dfprePhDs$QRPcatF, ordered = TRUE, levels(reorder(dfprePhDs$QRPcatF, dfprePhDs$median, decreasing = TRUE)))
prePhDs<-
  ggplot(dfprePhDs, aes(QRPoMedian, percOnceOrMore, fill=QRPareaF))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 50, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = subTitSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize) )+
    geom_text(data=dfprePhDs, mapping=aes(label= kLabsdfprePhDs), y=-3, stat="unique", size=textSize)+ylim(-5, 80)+
  labs(title="Undergraduate and graduate students", y="")+
    scale_fill_discrete(name = "QRP area")+
  annotate("text", x=18, y=70, label=getMT("QRPareaF", dfprePhDs), size=noteSize)

dfpostPhDs<-subset(df, careerLevelCat3=="post-PhD")
dfpostPhDs<-ddply(dfpostPhDs, .(QRPcatF), mutate,
                 median=median(percOnceOrMore),
                 k=length(percOnceOrMore), totN=sum(actualSampleSizeCorr, na.rm = TRUE))
kLabsdfpostPhDs<-dfpostPhDs$k
kLabsdfpostPhDs[(dfpostPhDs$QRPcatF=="other" & dfpostPhDs$QRPareaF!="results")|(dfpostPhDs$QRPcatF=="sponsorPressure" & dfpostPhDs$QRPareaF=="results")]<-NA
dfpostPhDs$QRPoMedian<-factor(dfpostPhDs$QRPcatF, ordered = TRUE, levels(reorder(dfpostPhDs$QRPcatF, dfpostPhDs$median, decreasing = TRUE)))
postPhDs<-
  ggplot(dfpostPhDs, aes(QRPoMedian, percOnceOrMore, fill=QRPareaF))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 50, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = subTitSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize), legend.position = "none")+
    geom_text(data=dfpostPhDs, mapping=aes(label= kLabsdfpostPhDs), y=-3, stat="unique", size=textSize)+ylim(-5, 80)+
  labs(title="Postdoctoral and above", y="")+
  scale_fill_discrete(name = "QRP area")+
  annotate("text", x=21, y=70, label=getMT("QRPareaF", dfpostPhDs), size=noteSize)

dfmPhDs<-subset(df, careerLevelCat3=="all levels")
dfmPhDs<-ddply(dfmPhDs, .(QRPcatF), mutate,
                  median=median(percOnceOrMore),
                  k=length(percOnceOrMore), totN=sum(actualSampleSizeCorr, na.rm = TRUE))
kLabsdfmPhDs<-dfmPhDs$k
kLabsdfmPhDs[(dfmPhDs$QRPcatF=="other" & dfmPhDs$QRPareaF!="results")|(dfmPhDs$QRPcatF=="appropriate ideas" & dfmPhDs$QRPareaF!="peerReview")|(dfmPhDs$QRPcatF=="self-plagiarism" & dfmPhDs$QRPareaF=="publication")|(dfmPhDs$QRPcatF=="sponsorPressure"&dfmPhDs$QRPareaF=="results")]<-NA
dfmPhDs$QRPoMedian<-factor(dfmPhDs$QRPcatF, ordered = TRUE, levels(reorder(dfmPhDs$QRPcatF, dfmPhDs$median, decreasing = TRUE)))
mPhDs<-
  ggplot(dfmPhDs, aes(QRPoMedian, percOnceOrMore, fill=QRPareaF))+geom_boxplot()+
  theme(axis.text.x = element_text(angle = 50, size=axisTextSize, hjust = 1, vjust=1), axis.title.x = element_blank(), axis.text.y = element_text(size=axisTextSize), axis.title.y = element_text(size=axisTitleSize), plot.title = element_text(size = subTitSize, hjust = 0.5), legend.text = element_text(size = axisTextSize), legend.title = element_text(size = axisTextSize), legend.position = "none" )+
    geom_text(data=dfmPhDs, mapping=aes(label= kLabsdfmPhDs), y=-3, stat="unique", size=textSize)+ylim(-5, 80)+
  labs(title="Samples with mixed career levels", y="")+
  scale_fill_discrete(name = "QRP area")+
  annotate("text", x=21, y=70, label=getMT("QRPareaF", dfmPhDs), size=noteSize)

tit4<-textGrob(label="Ranking of reported QRP, by survey participant career level", gp=gpar(fontsize=titSize, vjust = 0.5))
tit4y<-textGrob(label="reports engaging once or more (%)", gp=gpar(fontsize=axisTextSize, vjust = 0.5), rot=90)

tiff("Fig5.tiff", width = 1800, height = 1400)
grid.arrange(tit4, prePhDs, postPhDs, mPhDs, tit4y, layout_matrix=rbind(c(5,1),c(5,2),c(5,3), c(5,4)), heights=c(1,4,4,4), widths=c(1,15))
dev.off()