2017-03-27 229 views
0

我有一個問題,擴展在this之一。基本上我想添加bty = "n" ggplot2圖正確的方式。在這裏強調適當的,因爲在另一個問題的解決方案几乎是我想要的,除了這個細節:enter image description here我希望如果軸線將繼續,直到滴答的結束,直到它的中間。首先,對於圖的代碼:ggplot with bty =「n」,或如何將網格座標添加到繪圖座標

library(ggplot2) 
library(grid) 

graph = ggplot(faithful, aes(x=eruptions, y=waiting)) + 
    geom_point(shape=21) + 
    theme(
    # tick width, a bit exaggerated as example 
    axis.ticks = element_line(size = 5, color = "gray") 
    ) 
graph # graph with no axis lines 

# get axis limits 
gb = ggplot_build(graph) 
xLim = range(gb$layout$panel_ranges[[1]]$x.major_source) 
yLim = range(gb$layout$panel_ranges[[1]]$y.major_source) 

# add lines 
graph + 
    geom_segment(y = -Inf, yend = -Inf, x = xLim[1], xend = xLim[2]) + 
    geom_segment(x = -Inf, xend = -Inf, y = yLim[1], yend = yLim[2]) 

所以,問題是:我在x軸繪製從50至90。但是,所述刻度線是在50和90爲中心,因此它們通過size = 5一半上延伸每一面。 ?element_line告訴我,行/邊框尺寸默認爲毫米。因此,我想要繪製從50行 - 5毫米/ 2直到90 +5毫米/ 2.我嘗試(的許多變型)下面:

xLim = range(gb$layout$panel_ranges[[1]]$x.major_source) 
yLim = range(gb$layout$panel_ranges[[1]]$y.major_source) 

uType = "npc" 
uType2 = "mm" 

# attempt conversion of units 
xLim[1] = xLim[1] - convertWidth(unit(2.5, units = uType2), 
         unitTo = uType, valueOnly = TRUE) 
xLim[2] = xLim[2] + convertWidth(unit(2.5, units = uType2), 
         unitTo = uType, valueOnly = TRUE) 

yLim[1] = yLim[1] - convertHeight(unit(2.5, units = uType2), 
          unitTo = uType, valueOnly = TRUE) 
yLim[2] = yLim[2] - convertHeight(unit(2.5, units = uType2), 
          unitTo = uType, valueOnly = TRUE) 

# redraw graph  
cairo_pdf("Rplot.pdf") 
graph + 
    geom_segment(y = -Inf, yend = -Inf, x = xLim[1], xend = xLim[2]) + 
    geom_segment(x = -Inf, xend = -Inf, y = yLim[1], yend = yLim[2]) 
dev.off() 

但是,沒有任何運氣。有任何想法嗎?

回答

1

我相信你必須編寫一個drawDetails方法或類似的方法來完成繪圖時的單位計算。

或者(也許更容易),您可以編寫一個自定義的勾號延伸以覆蓋軸線。

enter image description here

(請注意,兩個軸由於它們z順序IIRC的不同線寬的;我認爲錯誤已被固定)。

library(ggplot2) 
library(grid) 


element_grob.element_custom_x <- function (element, x = 0:1, y = 0:1, colour = NULL, size = NULL, 
              linetype = NULL, lineend = "butt", default.units = "npc", id.lengths = NULL, 
              ...) 
{ 
    gp <- gpar(lwd = ggplot2:::len0_null(size * .pt), col = colour, lty = linetype, 
      lineend = lineend) 
    element_gp <- gpar(lwd = ggplot2:::len0_null(element$size * .pt), col = element$colour, 
        lty = element$linetype, lineend = element$lineend) 
    arrow <- if (is.logical(element$arrow) && !element$arrow) { 
    NULL 
    } 
    else { 
    element$arrow 
    } 
    g1 <- polylineGrob(x, y, default.units = default.units, 
        gp = utils::modifyList(element_gp, gp), 
        id.lengths = id.lengths, arrow = arrow, ...) 

    vertical <- length(unique(element$x)) == 1 && length(unique(element$y)) >= 1 

    g2 <- grid::editGrob(g1, y=y + unit(1,"mm"), gp=utils::modifyList(gp, list(col="green")), name="new") 

    grid::grobTree(g2, g1) 

} 


element_grob.element_custom_y <- function (element, x = 0:1, y = 0:1, colour = NULL, size = NULL, 
              linetype = NULL, lineend = "butt", default.units = "npc", id.lengths = NULL, 
              ...) 
{ 
    gp <- gpar(lwd = ggplot2:::len0_null(size * .pt), col = colour, lty = linetype, 
      lineend = lineend) 
    element_gp <- gpar(lwd = ggplot2:::len0_null(element$size * .pt), col = element$colour, 
        lty = element$linetype, lineend = element$lineend) 
    arrow <- if (is.logical(element$arrow) && !element$arrow) { 
    NULL 
    } 
    else { 
    element$arrow 
    } 
    g1 <- polylineGrob(x, y, default.units = default.units, 
        gp = utils::modifyList(element_gp, gp), 
        id.lengths = id.lengths, arrow = arrow, ...) 

    g2 <- grid::editGrob(g1, x=x + unit(1,"mm"), gp=utils::modifyList(gp, list(col="green")), name="new") 

    grid::grobTree(g2, g1) 

} 


## silly wrapper to fool ggplot2 
x_custom <- function(...){ 
    structure(
    list(...), # this ... information is not used, btw 
    class = c("element_custom_x","element_blank", "element") # inheritance test workaround 
) 

} 
y_custom <- function(...){ 
    structure(
    list(...), # this ... information is not used, btw 
    class = c("element_custom_y","element_blank", "element") # inheritance test workaround 
) 

} 

graph = ggplot(faithful, aes(x=eruptions, y=waiting)) + 
    geom_point(shape=21) + theme_minimal() + 
    theme(
    axis.ticks.x = x_custom(size = 5, colour = "red") , 
    axis.ticks.y = y_custom(size = 5, colour = "red") , 
    axis.ticks.length = unit(2,"mm") 
) 
graph # graph with no axis lines 
gb <- ggplot_build(graph) 
xLim = range(gb$layout$panel_ranges[[1]]$x.major_source) 
yLim = range(gb$layout$panel_ranges[[1]]$y.major_source) 


graph + 
    geom_segment(y = -Inf, yend = -Inf, x = xLim[1], xend = xLim[2],lwd=2) + 
    geom_segment(x = -Inf, xend = -Inf, y = yLim[1], yend = yLim[2],lwd=2)