Custom code: options for left/right/top/bottom axes in ggplot2

[Rudolf Cardinal]

Dear all (CC Hadley, Winston [at Hadley's suggestion], Jess),

In 2011 I was trying to get ggplot2 to show only left+bottom axes (or other arbitrary combinations of left/right/top/bottom), and came up with this code: https://groups.google.com/forum/?fromgroups=#!topic/ggplot2/-ZjRE2OL8lE

The previous code worked with ggplot2 0.8.7, but does not now work with ggplot2 version 0.9.3. The method I was using was to pass a custom object to the "panel.border" option.

In ggplot2 version 0.9.3, to pass something acceptable to theme's "panel.border" option, that something has to be a class inherited from element_rect (checked by validate_element() ) - easy enough. However, if I create an object called MYTHING, then for it to render in ggplot2, I have to have element_grob.MYTHING() be called by ggplot2, and I have failed to achieve this. Specifically, ggplot2's element_render() function calls element_grob(), which uses a UseMethod() call that should call element_grob.SOMETHING(). However, UseMethod() searches within the ggplot2 namespace/environment, so it doesn't find my objects. Moreover, the ggplot2 environment is locked, so I can't add my function to it, and I've found no way round this to allow ggplot2 to find my function in its search/call chain. (Instead, since MYTHING derives from element_rect, then ggplot2's element_grob.element_rect() is called instead.)

On the other hand, I can't find any option to element_rect() to make it draw only some sides of a rectangle -- so I'm stuck.

Have I missed some sensible way to have e.g. only left/bottom sides to panel.border, or to add things to ggplot2's call chain?

Many thanks!

All the best,
Rudolf.

[baptiste auguie]

FWIW, I also ran into a similar inheritance trouble when answering this question:

http://stackoverflow.com/a/14078391/471093
my ugly workaround was to fake inheritance from element_blank. I don't think there's a problem if your method is defined outside the ggplot2 namespace (it worked for my custom element).

Cheers,

baptiste

--
You received this message because you are subscribed to the ggplot2 mailing list.
Please provide a reproducible example: https://github.com/hadley/devtools/wiki/Reproducibility
 
To post: email ggp...@googlegroups.com
To unsubscribe: email ggplot2+u...@googlegroups.com
More options: http://groups.google.com/group/ggplot2

[Rudolf Cardinal]

Dear Baptiste,

Thank you! That worked a treat; hardly ugly.

The revised code is at http://egret.psychol.cam.ac.uk/statistics/R/extensions/rnc_ggplot2_border_themes_2013_01.r and pasted below.

All the best,

Rudolf.

# Rudolf Cardinal, March 2011

# Simple extensions to ggplot2 (v0.8.7); see http://pobox.com/~rudolf/statistics/R

# Modified 5 Jan 2013 for ggplot2 0.9.3 (NB: use sessionInfo() to find current package versions)

# - fetch ggplot2 source with: git clone https://github.com/hadley/ggplot2.git

# Changes, because ggplot2 has changed its internal calling mechanisms:

# - opts() deprecated in favour of theme()

# - "Element panel.border must be an element_rect object" (error from validate_element() in theme-elements.r)

#   ... so change all class = "theme" to class = c("element_rect", "element")

# - "cannot coerce type 'closure' to vector of type 'list'"

#   ... a closure is a function (see ?typeof)

#   ... change class to be of class c("MYCLASS", "element_rect", "element")

# - then element_grob.MYCLASS not called by element_render()/element_grob()/UseMethod()... environment/namespace problem

#   tried setMethod("element_grob", "theme_border", function(STUFF) { STUFF} , where = as.environment("package:ggplot2")

#   but the environment is locked

#   ggplot2's theme-elements.r defines e.g. element_rect (exported) and element_grob.element_rect (not exported, does the work)

#   However, we can't override an internal function:

#       ... e.g. rewrite "validate_element" to crash

#           set environment(validate_element) <- as.environment("package:ggplot2") -- doesn't break the plotting.

# - Upshot: now impossible to hack through this way (locked environment).

# - http://obeautifulcode.com/R/How-R-Searches-And-Finds-Stuff/

# - http://stackoverflow.com/questions/8204008/redirect-intercept-function-calls-within-a-package-function

# - These don't fix it:

#   library(proto)

#   theme <- with(proto(environment(ggplot2::theme), theme = ggplot2::theme, element_grob.theme_border = my.element_grob.theme_border), theme) --- doesn't work

#   ggplot <- with(proto(environment(ggplot2::ggplot), ggplot = ggplot2::ggplot, element_grob.theme_border = my.element_grob.theme_border), ggplot) --- breaks!

# - Fix by Baptiste Auguie 8/1/2013: inherit from element_blank instead; then it works fine.

#-------------------------------------------------------------------------------

# Requirements

#-------------------------------------------------------------------------------

library(grid) # for gpar

#-------------------------------------------------------------------------------

# Code duplicated from ggplot2 source (not exposed to wider namespace) for convenience

#-------------------------------------------------------------------------------

.pt <- 1 / 0.352777778

len0_null <- function(x) {

    if (length(x) == 0)  NULL

    else                 x

}

#-------------------------------------------------------------------------------

# Generic panel border (can set any combination of left/right/top/bottom)

#-------------------------------------------------------------------------------

theme_border <- function(

        type = c("left", "right", "bottom", "top", "none"),

        colour = "black", size = 1, linetype = 1) {

    # use with e.g.: ggplot(...) + opts( panel.border=theme_border(type=c("bottom","left")) ) + ...

    type <- match.arg(type, several.ok=TRUE)

    structure(

        list(type = type, colour = colour, size = size, linetype = linetype),

        class = c("theme_border", "element_blank", "element")

    )

}

element_grob.theme_border <- function(

        element, x = 0, y = 0, width = 1, height = 1,

        type = NULL,

        colour = NULL, size = NULL, linetype = NULL,

        ...) {

    if (is.null(type)) type = element$type

    xlist <- c()

    ylist <- c()

    idlist <- c()

    if ("bottom" %in% type) { # bottom

        xlist <- append(xlist, c(x, x+width))

        ylist <- append(ylist, c(y, y))

        idlist <- append(idlist, c(1,1))

    }

    if ("top" %in% type) { # top

        xlist <- append(xlist, c(x, x+width))

        ylist <- append(ylist, c(y+height, y+height))

        idlist <- append(idlist, c(2,2))

    }

    if ("left" %in% type) { # left

        xlist <- append(xlist, c(x, x))

        ylist <- append(ylist, c(y, y+height))

        idlist <- append(idlist, c(3,3))

    }

    if ("right" %in% type) { # right

        xlist <- append(xlist, c(x+width, x+width))

        ylist <- append(ylist, c(y, y+height))

        idlist <- append(idlist, c(4,4))

    }

    if (length(type)==0 || "none" %in% type) { # blank; cannot pass absence of coordinates, so pass a single point and use an invisible line

        xlist <- c(x,x)

        ylist <- c(y,y)

        idlist <- c(5,5)

        linetype <- "blank"

    }

    gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype)

    element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype)

    polylineGrob(

        x = xlist, y = ylist, id = idlist, ..., default.units = "npc",

        gp = modifyList(element_gp, gp),

    )

}

#-------------------------------------------------------------------------------

# For convenience: "L" (left + bottom) border

#-------------------------------------------------------------------------------

theme_L_border <- function(colour = "black", size = 1, linetype = 1) {

    # use with e.g.: ggplot(...) + theme( panel.border=theme_L_border() ) + ...

    structure(

        list(colour = colour, size = size, linetype = linetype),

        class = c("theme_L_border", "element_blank", "element")

    )

}

element_grob.theme_L_border <- function(

        element, x = 0, y = 0, width = 1, height = 1,

        colour = NULL, size = NULL, linetype = NULL,

        ...) {

    gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype)

    element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype)

    polylineGrob(

        x = c(x+width, x, x), y = c(y,y,y+height), ..., default.units = "npc",

        gp = modifyList(element_gp, gp),

    )

}

#-------------------------------------------------------------------------------

# For convenience: bottom border only

#-------------------------------------------------------------------------------

theme_bottom_border <- function(colour = "black", size = 1, linetype = 1) {

    # use with e.g.: ggplot(...) + theme( panel.border=theme_bottom_border() ) + ...

    structure(

        list(colour = colour, size = size, linetype = linetype),

        class = c("theme_bottom_border", "element_blank", "element")

    )

}

element_grob.theme_bottom_border <- function(

        element, x = 0, y = 0, width = 1, height = 1,

        colour = NULL, size = NULL, linetype = NULL,

        ...) {

    gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype)

    element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype)

    polylineGrob(

        x = c(x, x+width), y = c(y,y), ..., default.units = "npc",

        gp = modifyList(element_gp, gp),

    )

}

#-------------------------------------------------------------------------------

# For convenience: left border only

#-------------------------------------------------------------------------------

theme_left_border <- function(colour = "black", size = 1, linetype = 1) {

    # use with e.g.: ggplot(...) + theme( panel.border=theme_left_border() ) + ...

    structure(

        list(colour = colour, size = size, linetype = linetype),

        class = c("theme_left_border", "element_blank", "element")

    )

}

element_grob.theme_left_border <- function(

        element, x = 0, y = 0, width = 1, height = 1,

        colour = NULL, size = NULL, linetype = NULL,

        ...) {

    gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype)

    element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype)

    polylineGrob(

        x = c(x, x), y = c(y, y+height), ..., default.units = "npc",

        gp = modifyList(element_gp, gp),

    )

}

#-------------------------------------------------------------------------------

# Border selection by number

#-------------------------------------------------------------------------------

theme_border_numerictype <- function(type, colour = "black", size = 1, linetype = 1) {

    # use with e.g.: ggplot(...) + theme( panel.border=theme_border(type=9) ) + ...

    structure(

        list(type = type, colour = colour, size = size, linetype = linetype),

        class = c("theme_border_numerictype", "element_blank", "element")

    )

}

element_grob.theme_border_numerictype <- function(

        element, x = 0, y = 0, width = 1, height = 1,

        type = NULL,

        colour = NULL, size = NULL, linetype = NULL,

        ...) {

    if (is.null(type)) type = element$type

    # numerical types from: library(gridExtra); example(borderGrob)

    # 1=none, 2=bottom, 3=right, 4=top, 5=left, 6=B+R, 7=T+R, 8=T+L, 9=B+L, 10=T+B, 11=L+R, 12=T+B+R, 13=T+L+R, 14=T+B+L, 15=B+L+R, 16=T+B+L+R

    xlist <- c()

    ylist <- c()

    idlist <- c()

    if (type==2 || type==6 || type==9 || type==10 || type==12 || type==14 || type==15 || type==16) { # bottom

        xlist <- append(xlist, c(x, x+width))

        ylist <- append(ylist, c(y, y))

        idlist <- append(idlist, c(1,1))

    }

    if (type==4 || type==7 || type==8 || type==10 || type==12 || type==13 || type==14 || type==16) { # top

        xlist <- append(xlist, c(x, x+width))

        ylist <- append(ylist, c(y+height, y+height))

        idlist <- append(idlist, c(2,2))

    }

    if (type==5 || type==8 || type==9 || type==11 || type==13 || type==14 || type==15 || type==16) { # left

        xlist <- append(xlist, c(x, x))

        ylist <- append(ylist, c(y, y+height))

        idlist <- append(idlist, c(3,3))

    }

    if (type==3 || type==6 || type==7 || type==11 || type==12 || type==13 || type==15 || type==16) { # right

        xlist <- append(xlist, c(x+width, x+width))

        ylist <- append(ylist, c(y, y+height))

        idlist <- append(idlist, c(4,4))

    }

    if (type==1) { # blank; can't pass absence of coordinates, so pass a single point and use an invisible line

        xlist <- c(x,x)

        ylist <- c(y,y)

        idlist <- c(5,5)

        linetype <- "blank"

    }

    gp <- gpar(lwd = len0_null(size * .pt), col = colour, lty = linetype)

    element_gp <- gpar(lwd = len0_null(element$size * .pt), col = element$colour, lty = element$linetype)

    polylineGrob(

        x = xlist, y = ylist, id = idlist, ..., default.units = "npc",

        gp = modifyList(element_gp, gp),

    )

}

#-------------------------------------------------------------------------------

# Examples

#-------------------------------------------------------------------------------

rnc_ggplot2_border_themes_example_script = '

    library(ggplot2)

    df = data.frame( x=c(1,2,3), y=c(4,5,6) )

    source("http://egret.psychol.cam.ac.uk/statistics/R/extensions/rnc_ggplot2_border_themes_2013_01.r")

    ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_border( c("bottom","left") ) )

    ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_left_border() )

    ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_bottom_border() )

    ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_L_border() )

    ggplot(data=df, aes(x=x, y=y)) + geom_point() + theme_bw() + theme( panel.border = theme_border_numerictype(12) ) # use 1:16 as possible values

'

[Ista Zahn]

Hi Rudolf,

This is not completely general, but you can use axis lines
independently of panel.border. So for left and bottom axis lines:

ggplot(mtcars, aes(x=wt,y=mpg)) +
geom_point() +
theme_bw() +
theme_bw() +
theme(panel.border = element_blank(),
axis.line=element_line())

Best,
Ista

[Rudolf Cardinal]

Dear Ista,
Thanks!
R.