2017-03-27 226 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)