Question

我想制作一个带有误差条的水平圆点图，带有一个log x轴。

我已经探索了一些选项，并且从包Hmisc中得到了最接近我想要的errbar。但我不想为每个数据点标记y轴。我尝试添加yaxt="n"，但这似乎没有改变它。

有什么建议可以压制这个吗？或者实现这种点图的替代方法？提前谢谢。

使用mtcars数据集的示例代码：

mtcars$model <-as.factor(rownames(mtcars))
mtcars$model <- reorder(mtcars$model, mtcars$mpg)

plot(mtcars$model, mtcars$mpg, type="n",yaxt="n")

with (
  data = mtcars,
  expr = errbar(mtcars$model, mtcars$mpg,mtcars$mpg-mtcars$drat,mtcars$mpg+mtcars$drat,log='x', add=T, pch=16, cap=.5,xlab="MPG", yaxt="n")
 )

（我第一次就Stack Overflow问了一个问题，所以希望我已经添加了所需的所有信息）

由于

Answer 1

似乎这是你可以用基础绘图原语轻松构建的东西。有了数据

x<-mtcars$mpg
x1<-mtcars$mpg-mtcars$drat
x2<-mtcars$mpg+mtcars$drat
y<-seq_along(x)

你可以绘制

par(mar=c(5,2,3,2)+0.1)
plot(c(x1,x2), c(y,y), type="n", axes=F, log="x", xlab="", ylab="")
segments(x1, y, x2, y)
points(x, y, pch=20)
axis(1)

这导致

Answer 2

隔离axis(2, ... )函数并以命名参数为条件：

myerrbar <- 
 function (x, y, yplus, yminus, cap = 0.015, main = NULL, sub = NULL, 
    xlab = as.character(substitute(x)), ylab = if (is.factor(x) || 
        is.character(x)) "" else as.character(substitute(y)), 
    add = FALSE, lty = 1, type = "p", ylim = NULL, lwd = 1, pch = 16, 
    errbar.col = par("fg"), Type = rep(1, length(y)), ..., yax=TRUE) 
{
    if (is.null(ylim)) 
        ylim <- range(y[Type == 1], yplus[Type == 1], yminus[Type == 
            1], na.rm = TRUE)
    if (is.factor(x) || is.character(x)) {
        x <- as.character(x)
        n <- length(x)
        t1 <- Type == 1
        t2 <- Type == 2
        n1 <- sum(t1)
        n2 <- sum(t2)
        omai <- par("mai")
        mai <- omai
        mai[2] <- max(strwidth(x, "inches")) + 0.25
        par(mai = mai)
        on.exit(par(mai = omai))
        plot(NA, NA, xlab = ylab, ylab = "", xlim = ylim, ylim = c(1, 
            n + 1), axes = FALSE, ...)
        axis(1)
        w <- if (any(t2)) 
            n1 + (1:n2) + 1
        else numeric(0)
        if (yax) {axis(2, at = c(seq.int(length.out = n1), w), labels = c(x[t1], 
            x[t2]), las = 1, adj = 1)}
           points(y[t1], seq.int(length.out = n1), pch = pch, type = type, 
            ...)
           segments(yplus[t1], seq.int(length.out = n1), yminus[t1], 
            seq.int(length.out = n1), lwd = lwd, lty = lty, col = errbar.col)
           if (any(Type == 2)) {
            abline(h = n1 + 1, lty = 2, ...)
            offset <- mean(y[t1]) - mean(y[t2])
            if (min(yminus[t2]) < 0 & max(yplus[t2]) > 0) 
                lines(c(0, 0) + offset, c(n1 + 1, par("usr")[4]), 
                  lty = 2, ...)
            points(y[t2] + offset, w, pch = pch, type = type, 
                ...)
            segments(yminus[t2] + offset, w, yplus[t2] + offset, 
                w, lwd = lwd, lty = lty, col = errbar.col)
            at <- pretty(range(y[t2], yplus[t2], yminus[t2]))
            axis(side = 3, at = at + offset, labels = format(round(at, 
                6)))
        }
        return(invisible())
    }
    if (add) 
        points(x, y, pch = pch, type = type, ...)
    else plot(x, y, ylim = ylim, xlab = xlab, ylab = ylab, pch = pch, 
        type = type, ...)
    xcoord <- par()$usr[1:2]
    smidge <- cap * (xcoord[2] - xcoord[1])/2
    segments(x, yminus, x, yplus, lty = lty, lwd = lwd, col = errbar.col)
    if (par()$xlog) {
        xstart <- x * 10^(-smidge)
        xend <- x * 10^(smidge)
    }
    else {
        xstart <- x - smidge
        xend <- x + smidge
    }
    segments(xstart, yminus, xend, yminus, lwd = lwd, lty = lty, 
        col = errbar.col)
    segments(xstart, yplus, xend, yplus, lwd = lwd, lty = lty, 
        col = errbar.col)
    return(invisible())
}

忽略警告：

myexpr = myerrbar(mtcars$model, mtcars$mpg,mtcars$mpg-mtcars$drat,mtcars$mpg+mtcars$drat,log='x', pch=16, cap=.5,xlab="MPG", yax=FALSE)

如果您要为每个文件提供数据框的名称，则无需with。

抑制R Hmisc errbar

2 个答案: