处理带有日期的轴在twoord.plot中(删除轴3)

时间:2017-03-02 14:46:11

标签: r date plot plotrix

我正在尝试在x轴上使用不同日期的ly并计算ry的{​​{1}}和百分比,我想删除轴3或更改其颜色。设置axes = F不起作用,xaxt = 'n'也不起作用。

事实上,axes = FALSE给了我这个错误消息:

  

plot.default(lx, ly, xlim = xlim, ylim = lylim, xlab = xlab,中的错误:     正式参数"axes"与多个实际参数相匹配

这里给出的解决方案:

Remove all axis values and labels in twoord plot对我的rxlx不起作用。

这是我正在使用的类似代码:

set.seed(123)
library(plotrix)
twoord.plot(
  lx = seq(as.Date("2016-01-01"), as.Date("2017-01-01"), by = "days"),
  ly = round(runif(367) * 6),
  rx = seq(as.Date("2016-05-09"), as.Date("2017-01-12"), by = "days"),
  ry = sort(rnorm(249, 60, 10)),
  lylim = range(round(runif(367) * 6)) + c(0, 10), 
  rylim = range(sort(rnorm(249, 60, 10))) + c(-35, 10), 
  ylab.at = mean(round(runif(367) * 6)),
  rylab.at = mean(sort(rnorm(249, 60, 10))),
  rylab = "Percentages %", ylab = "No. of x",
  type = c("l", "l"), lcol = "skyblue4", rcol = "chocolate1" ,
  xtickpos = as.numeric(seq(as.Date("2016-01-01"), as.Date("2017-01-01"), by = "months")),
  xticklab = seq(as.Date("2016-01-01"), as.Date("2017-01-01"), by = "months"))

关于如何做到这一点的任何想法?提前致谢! :)

1 个答案:

答案 0 :(得分:1)

hack twoord.plot函数。以下是制作所有轴标签black的示例(创建绘图时使用twoord.plot2而不是twoord.plot。如果你想完全删除轴,只需注释(在行之前添加#)第88-90行(For ly)和第123-125行(ry)。我在下面的函数中为它们留下了笔记。

twoord.plot2 = function (lx, ly, rx, ry, data = NULL, main = "", xlim = NULL, 
    lylim = NULL, rylim = NULL, mar = c(5, 4, 4, 4), lcol = 1, 
    rcol = 2, xlab = "", lytickpos = NA, ylab = "", ylab.at = NA, 
    rytickpos = NA, rylab = "", rylab.at = NA, lpch = 1, rpch = 2, 
    type = "b", xtickpos = NULL, xticklab = NULL, halfwidth = 0.4, 
    axislab.cex = 1, do.first = NULL, ...) 
{
    if (!is.null(data)) {
        ly <- unlist(data[ly])
        ry <- unlist(data[ry])
        if (missing(lx)) 
            lx <- 1:length(ly)
        else lx <- unlist(data[lx])
        if (missing(rx)) 
            rx <- 1:length(ry)
        else rx <- unlist(data[rx])
    }
    if (missing(lx)) 
        lx <- 1:length(ly)
    if (missing(ry)) {
        if (missing(rx)) {
            rx <- 1:length(ry)
            ry <- ly
            ly <- lx
            lx <- 1:length(ly)
        }
        else {
            ry <- rx
            rx <- 1:length(ry)
        }
    }
    oldmar <- par("mar")
    par(mar = mar)
    if (is.null(xlim)) 
        xlim <- range(c(lx, rx))
    if (missing(lx)) 
        lx <- 1:length(ly)
    if (is.null(lylim)) {
        lylim <- range(ly, na.rm = TRUE)
        lyspan <- diff(lylim)
        if (lyspan == 0) 
            lyspan <- lylim[1]
        lylim[2] <- lylim[2] + lyspan * 0.04
        if (lylim[1] != 0) 
            lylim[1] <- lylim[1] - lyspan * 0.04
    }
    if (length(type) < 2) 
        type <- rep(type, 2)
    if (match(type[1], "bar", 0)) {
        oldcex <- par(cex = axislab.cex)
        plot(lx, ly, xlim = xlim, ylim = lylim, xlab = xlab, 
            ylab = "", yaxs = "i", type = "n", main = "", axes = FALSE, 
            ...)
        par(oldcex)
        if (!is.null(do.first)) 
            eval(parse(text = do.first))
        ybottom <- par("usr")[3]
        if (lylim[1] < 0) 
            abline(h = 0, lty = 2)
        rect(lx - halfwidth, ifelse(ly < 0, ly, ybottom), lx + 
            halfwidth, ifelse(ly > 0, ly, 0), col = lcol)
    }
    else {
        oldcex <- par(cex = axislab.cex)
        plot(lx, ly, xlim = xlim, ylim = lylim, xlab = xlab, 
            ylab = "", yaxs = "i", type = "n", main = "", axes = FALSE, 
            ...)
        par(oldcex)
        if (!is.null(do.first)) 
            eval(parse(text = do.first))
        points(lx, ly, col = lcol, pch = lpch, type = type[1], 
            ...)
    }
    title(main = main)
    xylim <- par("usr")
    box()
    if (is.null(xticklab)) 
        axis(1, cex.axis = axislab.cex)
    else {
        if (is.null(xtickpos)) 
            xtickpos <- 1:length(xticklab)
        axis(1, at = xtickpos, labels = xticklab, cex.axis = axislab.cex)
    }
    if (is.na(lytickpos[1])) 
        lytickpos <- pretty(ly)
    if (is.na(ylab.at)) 
        ylab.at <- mean(lytickpos)
    color.axis(2, at = lytickpos, axlab = ylab, axlab.at = ylab.at, #LINE 88
        col = "black", cex.axis = axislab.cex, #col = ifelse(is.na(lcol), 1, lcol), cex.axis = axislab.cex, 
        cex = axislab.cex) #LINE 90
    if (is.null(rylim)) {
        rylim <- range(ry, na.rm = TRUE)
        ryspan <- diff(rylim)
        if (ryspan == 0) 
            ryspan <- rylim[1]
        rylim[2] <- rylim[2] + ryspan * 0.04
        if (rylim[1] != 0) 
            rylim[1] <- rylim[1] - ryspan * 0.04
    }
    ymult <- diff(lylim)/diff(rylim)
    yoff <- lylim[1] - rylim[1] * ymult
    if (match(type[2], "bar", 0)) {
        if (rylim[1] < 0) 
            abline("h", 0)
        rect(rx - halfwidth, ifelse(ry < 0, ry, rylim[1] * ymult + 
            yoff), rx + halfwidth, ifelse(ry > 0, ry * ymult + 
            yoff, 0), col = rcol)
    }
    else points(rx, ry * ymult + yoff, col = rcol, pch = rpch, 
        type = type[2], ...)
    if (is.na(rytickpos[1])) 
        rylabels <- pretty(rylim)
    else rylabels <- rytickpos
    if (min(rylabels) < rylim[1]) 
        rylabels <- rylabels[rylabels >= rylim[1]]
    if (max(rylabels) > rylim[2]) 
        rylabels <- rylabels[rylabels <= rylim[2]]
    axat <- rylabels * ymult + yoff
    if (is.na(rylab.at)) 
        rylab.at <- mean(rytickpos)
    if (!is.na(rylab.at)) 
        rylab.at <- rylab.at * ymult + yoff
    color.axis(4, at = axat, labels = rylabels, axlab = rylab, #LINE 123
        axlab.at = rylab.at, col = "black", #axlab.at = rylab.at, col = ifelse(is.na(rcol), 1, rcol), 
        cex.axis = axislab.cex, cex = axislab.cex) #LINE 125
    par(mar = oldmar, new = FALSE, col.axis = "black")
}