帶有Y軸斷點和錯誤條的條形圖

Question

我正在嘗試使用錯誤欄y軸斷點創建一個條形圖。我知道plotrix軟件包的gap.plot可以做到這一點，但我不喜歡pot的外觀。我遵循的代碼HERE它是爲我工作，除了我不知道如何把錯誤欄。我的代碼是這樣的

# dataset: 
data=data.frame(CAx=c(120),CAp=c(32),CTAx=c(12),CTAp=c(4),MTAX=c(6),MTSAx=c(3)) 

lower=c(0,55) 
upper=c(95,140) 
y_outer=21 

lowspan=c(0,11) 
topspan=c(lowspan[2]+1,21) 

ylabel="y-axis value" 
xlabel="x-axis value" 
legendtext=c('C-Ax','C-Ap','CT-Ax','CT-Ap','MT-AX','MTS-Ax') 

cnvrt.coords <-function(x,y=NULL){ 
    xy <- xy.coords(x,y, recycle=TRUE) 
    cusr <- par('usr') 
    cplt <- par('plt') 
    plt <- list() 
    plt$x <- (xy$x-cusr[1])/(cusr[2]-cusr[1]) 
    plt$y <- (xy$y-cusr[3])/(cusr[4]-cusr[3]) 
    fig <- list() 
    fig$x <- plt$x*(cplt[2]-cplt[1])+cplt[1] 
    fig$y <- plt$y*(cplt[4]-cplt[3])+cplt[3] 
    return(list(fig=fig)) 
} 

subplot <- function(fun, x, y=NULL){ 
    old.par <- par(no.readonly=TRUE) 
    on.exit(par(old.par)) 
    xy <- xy.coords(x,y) 
    xy <- cnvrt.coords(xy)$fig 
    par(plt=c(xy$x,xy$y), new=TRUE) 
    fun 
    tmp.par <- par(no.readonly=TRUE) 
    return(invisible(tmp.par)) 
} 

plot(c(0,1),c(0,y_outer),type='n',axes=FALSE,ylab=ylabel,xlab='',lwd=7) 
subplot(barplot(as.matrix(data),col=heat.colors(2),ylim=lower,xpd=FALSE,las=3),x=c(0,1),y=lowspan) 

subplot(barplot(
as.matrix(data), 
col=heat.colors(2), 
ylim=upper, 
xpd=FALSE, 
names.arg=vector(mode="character",length=length(data))), 
x=c(0,1), 
y=topspan) 

lowertop=lowspan[2]+0.1  # Where to end the lower axis 
breakheight=0.5 # Height of the break 
upperbot=lowertop+breakheight # Where to start the upper axes 
markerheight=0.4 # Heightdifference for the break markers 
markerwidth=.04 # With of the break markers 
abline(h = 0, col = "black") 
lines(c(0,0),c(1,lowertop)) 
lines(c(markerwidth/-2,markerwidth/2),c(lowertop-   
markerheight/2,lowertop+markerheight/2)) 
lines(c(0,0),c(upperbot,14)) 
lines(c(markerwidth/-2,markerwidth/2),c(upperbot-  
markerheight/2,upperbot+markerheight/2)) 

和情節是這樣的

Answer 1

使用subplot，你的優勢，即它使用cnvrt.coords計算正確的座標和fun可以與這些新的評估任何表情座標

因此，如果我們在內創建了所需圖的子圖功能，應該使用新的座標。

data=data.frame(CAx=120,CAp=32,CTAx=12,CTAp=4,MTAX=6,MTSAx=3) 

lower=c(0,55) 
upper=c(95,140) 
y_outer=21 

lowspan=c(0,11) 
topspan=c(lowspan[2]+1,21) 

ylabel="y-axis value" 
xlabel="x-axis value" 
legendtext=c('C-Ax','C-Ap','CT-Ax','CT-Ap','MT-AX','MTS-Ax') 

plot(c(0,1),c(0,y_outer),type='n',axes=FALSE,ylab=ylabel,xlab='',lwd=7) 
subplot({ 
    y <- as.matrix(data) 
    bp <- barplot(y,col=heat.colors(2),ylim=lower,xpd=FALSE,las=3) 
    arrows(bp, y * .95, bp, y * 1.05, xpd = NA, angle = 90, code = 3, 
     length = .1, col = ifelse(y > max(lower), 0, 1)) 
},x=c(0,1),y=lowspan) 

subplot({ 
    bp <- barplot(y, col=heat.colors(2), ylim=upper, xpd=FALSE, 
      names.arg=vector(mode="character",length=length(data))) 
    arrows(bp, y * .95, bp, y * 1.05, xpd = NA, angle = 90, code = 3, 
     length = .1, col = ifelse(y > max(lower), 1, 0)) 
}, x=c(0,1), y=topspan)