##データの読み込み (フォルダとファイル名を変更) #setwd("W:/HP/meta_analysis/R/") #csvファイルの入っているフォルダを設定する dat <- read.table("http://blue.zero.jp/yokumura/R/publication_process_duration.csv", sep=",", header=T, na.strings="") #-----------------------------# ##以下は,必要に応じて変更 #-----------------------------# source("http://blue.zero.jp/yokumura/R/testtheory/ctt.txt") dat <- dat[!is.na(dat$journal) & !is.na(dat$sub_first),] ##雑誌名または投稿日が欠損であれば,当該データは欠損 tmp <- NA for(i in 4:ncol(dat)){ x <- strptime(dat[,i], format="%Y/%m/%d") tmp <- data.frame(tmp, x) } tmp <- tmp[,-1] tmp <- data.frame(dat[, 1:3], tmp) names(tmp) <- names(dat) tmp <- tmp[order(tmp$sub_first, decreasing=F),] ##投稿した日順に並べる ##時間差 attach(tmp) ##textで描画する日数 time1 <- difftime(ref_first, sub_first,units="days") #1回目審査期間 time2 <- difftime(sub_second, ref_first,units="days") #1回目修正期間 time3 <- difftime(ref_second, sub_second,units="days") #2回目審査期間 time4 <- difftime(sub_third, ref_second,units="days") #2回目修正期間 time5 <- difftime(ref_third, sub_third,units="days") #3回目審査期間 time6a <- difftime(publish, ref_first, units="days") #最終投稿から印刷日までの期間 time6b <- difftime(publish, sub_second, units="days") #最終投稿から印刷日までの期間 time6c <- difftime(publish, ref_second, units="days") #最終投稿から印刷日までの期間 time6d <- difftime(publish, sub_third, units="days") #最終投稿から印刷日までの期間 time6e <- difftime(publish, ref_third, units="days") #最終投稿から印刷日までの期間 time6 <- data.frame(time6a, time6b,time6c,time6d,time6e) x <- apply(!is.na(time6), 1, sum) y <- rep(NA, length(x)) for(i in 1:length(x)){ if(x[i] != 0){ y[i] <- time6[i, x[i]] } } time6 <- y time7 <- difftime(publish, sub_first,units="days") #初回投稿から印刷日までの期間 ##グラフで描画する基準値からの時間 ref.time <- sub_first[1] time_a <- difftime(sub_first, ref.time, unit="days") time_b <- difftime(ref_first, ref.time, unit="days") time_c <- difftime(sub_second, ref.time, unit="days") time_d <- difftime(ref_second, ref.time, unit="days") time_e <- difftime(sub_third, ref.time, unit="days") time_f <- difftime(ref_third, ref.time, unit="days") time_g0 <- data.frame(time_b, time_c, time_d, time_e, time_f) x <- apply(!is.na(time_g0), 1, sum) y <- rep(NA, length(x)) for(i in 1:length(x)){ if(x[i] != 0){ y[i] <- time_g0[i, x[i]] } } time_g0 <- y time_g1 <- difftime(publish, ref.time, unit="days") detach(tmp) ##図 my.ylim <- c(1, nrow(tmp)) my.y <- (my.ylim[2]:my.ylim[1])+.5 my.cex <- .6 my.x.max <- max(c(time_a, time_b, time_c, time_d, time_e, time_f, time_g1), na.rm=T) my.x.min <- -my.x.max/6 #この数字を変更することで、x軸の最小値を決定する main1.num <- formatted(mean(as.numeric(time1), na.rm=T), digits=1) #平均査読期間 main2.num <- formatted(mean(as.numeric(time2), na.rm=T), digits=1) #平均修正期間 main3.num <- formatted(mean(time6, na.rm=T), digits=1) #平均印刷期間 main4.num <- formatted(mean(as.numeric(time7), na.rm=T), digits=1) #平均全体期間 my.legend <- c(paste("査読期間 (第1回目): ", main1.num, " ", sep=""), paste("修正期間 (第1回目): ", main2.num, " ", sep=""), paste("印刷期間: ", main3.num, " ", sep=""), paste("全体期間: ", main4.num, " ", sep="")) windows(w=12) par(mar=c(5.1, 10.5, 2.1, 1.1)) #余白の設定など適当に変更する plot(time_a, my.y, ylim=c(my.ylim[1], my.ylim[2]+1), xlim=c(my.x.min, my.x.max), yaxt="n", xlab="日数", ylab="") legend(x=par()$usr[1], y = par()$usr[3], my.legend, yjust=0, y.intersp=1, x.intersp=0) arrows(x0=time_a, x1=time_b, y0=my.y, y1=my.y, length=.15, code=2, angle=90, col="red", lwd=2) #第1回目審査期間 arrows(x1=time_c, x0=time_b, y0=my.y, y1=my.y, length=.15, code=0, angle=90, col="blue", lwd=2) #第1回目修正期間 arrows(x0=time_d, x1=time_c, y0=my.y, y1=my.y, length=.15, code=2, angle=90, col="red", lwd=2) #第2回目審査期間 arrows(x1=time_e, x0=time_d, y0=my.y, y1=my.y, length=.15, code=0, angle=90, col="blue", lwd=2) #第2回目修正期間 arrows(x0=time_f, x1=time_e, y0=my.y, y1=my.y, length=.15, code=2, angle=90, col="red", lwd=2) #第3回目審査期間 arrows(x0=time_g0, x1=time_g1, y0=my.y, y1=my.y, length=.15, code=2, angle=90, col="yellow", lwd=2) #最終稿から印刷日までの期間 text((time_b - time_a)/2 + time_a, my.y, time1, pos=3, cex=my.cex) text((time_c - time_b)/2 + time_b, my.y, time2, pos=3, cex=my.cex) text((time_d - time_c)/2 + time_c, my.y, time3, pos=3, cex=my.cex) text((time_e - time_d)/2 + time_d, my.y, time4, pos=3, cex=my.cex) text((time_f - time_e)/2 + time_e, my.y, time5, pos=3, cex=my.cex) text((time_g1 - time_g0)/2 + time_g0, my.y, time6, pos=3, cex=my.cex) text((time_g1 - time_a)/2 + time_a, my.y, time7, pos=1, font=2) text(time_a, my.y, tmp$sub_first, pos=2) my.y.lab <- paste(tmp$journal, " (",tmp$n_reject, ")", sep="") my.cut <- 28 my.y.lab[(nchar(my.y.lab) >= my.cut)] <- paste(substr(my.y.lab[(nchar(my.y.lab) >= my.cut)], 1, my.cut), " \n ", substr(my.y.lab[(nchar(my.y.lab) >= my.cut)], my.cut+1, 1000), sep="") axis(2, my.y, my.y.lab, las=1, cex.axis=.7) ##印刷用 dev.copy(pdf, family="Japan1", file="publication_process_duration.pdf", w=12) dev.off() graphics.off()