R/zytlineplot.R

In jaspershen/zhangyt: SXTerrorbar

zytlineplot <- function(replicate = 1,
                     cex.axis1 = 1.5,
                     cex.lab1 = 1.8,
                     lwd1 = 2,
                     width1 = 8,
                     height1 = 6,
                     ylab1 = "Platelet (% of baseline)",
                     xlab1 = "Time-Points",
                     class.name = c("0 mg/lg", "10 mg/lg", "50 mg/lg"),
                     pch1 = c(19, 15, 17, 18, 2),
                     col1 = c("palegreen", "royalblue", "firebrick1", "purple", "black"),
                     lty1 = c(1,2,3,4,5,6,7),
                     legend.position = "topleft",
                     ylimit = c(0.7, 1.3)) {
#设置路径
library(xlsx)
options(warn = -1)
data <- read.xlsx("data.xlsx", stringsAsFactors = F, sheetIndex = 1)
rownames(data) <- data[,1]
data <- data[,-1]

data1 <- lapply(SXTsplit(1:ncol(data), n = replicate), function(x) {data[,x]})

if (replicate != 1) {
  data.sd <- lapply(data1, function(x) {apply(x, 1, sd)})
  data1 <- lapply(data1, function(x) {apply(x, 1, mean)})
}

ymin <- ylimit[1] * min(unlist(lapply(data1, min)))
ymax <- ylimit[2] * max(unlist(lapply(data1, max)))

pdf("zyt.pdf", width = width1, height = height1)
par(mar= c(5,5,4,2))
plot(as.numeric(data1[[1]]), type = "o",
     ylim = c(ymin, ymax), xaxt = "n",
     xlab = xlab1, lwd = lwd1,
     cex.lab = cex.lab1, cex.axis = cex.axis1,
     ylab = ylab1,
     col = col1[1],
     pch = pch1[1],
     lty = lty1[1])

if (replicate != 1) {
SXTerrorbar(x = c(1:nrow(data)), y = data1[[1]], upper = data.sd[[1]], lwd = 1)
}

axis(side = 1, at = c(1:nrow(data)),
     labels = rownames(data),
     cex.axis = cex.axis1)

for (i in 2:length(data1)) {
  points(as.numeric(data1[[i]]),
         type = "o",
         pch = pch1[i],
         lwd = lwd1,
         lty = lty1[i],
         col = col1[i])
  if (replicate != 1) {
    SXTerrorbar(x = c(1:nrow(data)),
                y = data1[[i]],
                upper = data.sd[[i]],
                lwd = 1)
  }

}


legend(legend.position,
       legend = class.name,
       lty = lty1[1:ncol(data)],
       lwd = lwd1,
       pch = pch1[1:ncol(data)],
       bty = "n",
       pt.cex = 1.5,
       cex = 1.5,
       col = col1[1:ncol(data)])
dev.off()
}


SXTsplit <- function(x, n) {
  y <- list()
  part <- length(x)/n
  for (i in 1:part) {
    y[[i]] <- x[1:n]
    x <- x[-c(1:n)]
  }
  return(y)
}

SXTerrorbar <- function(x, y, upper, lower=upper, length=0.1,...){
  if(length(x) != length(y) | length(y) !=length(lower) | length(lower) != length(upper))
    stop("vectors must be same length")
  arrows(x,y+upper, x, y-lower, angle=90, code=3, length=length, ...)
}