diff --git a/R/geom-rug.r b/R/geom-rug.r index 0d9775e34e..323e3080da 100644 --- a/R/geom-rug.r +++ b/R/geom-rug.r @@ -1,12 +1,15 @@ #' Marginal rug plots. #' -#' @section Aesthetics: +#' @section Aesthetics: #' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "rug")} #' #' @inheritParams geom_point #' @param sides A string that controls which sides of the plot the rugs appear on. #' It can be set to a string containing any of \code{"trbl"}, for top, right, #' bottom, and left. +#' @param rugwidth The width the rug segments. This should be a \code{\link{unit}} +#' object. +#' #' @export #' @examples #' p <- ggplot(mtcars, aes(x=wt, y=mpg)) @@ -15,55 +18,67 @@ #' p + geom_point() + geom_rug(sides="b") # Rug on bottom only #' p + geom_point() + geom_rug(sides="trbl") # All four sides #' p + geom_point() + geom_rug(position='jitter') -geom_rug <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", sides = "bl", ...) { - GeomRug$new(mapping = mapping, data = data, stat = stat, position = position, sides = sides, ...) +geom_rug <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", sides = "bl", rugwidth=unit(0.03, "npc"), ...) { + + GeomRug$new(mapping = mapping, data = data, stat = stat, position = position, sides = sides, rugwidth=rugwidth, ...) } GeomRug <- proto(Geom, { objname <- "rug" - draw <- function(., data, scales, coordinates, sides, ...) { + draw <- function(., data, scales, coordinates, sides, rugwidth=units(0.03, "npc"), ...) { + if (!is(rugwidth, "unit")) { + stop("'rugwidth' must be a 'unit' object.") + } rugs <- list() - data <- coord_transform(coordinates, data, scales) + data <- coord_transform(coordinates, data, scales) if (!is.null(data$x)) { if(grepl("b", sides)) { + y0b <- unit(0, "npc") + y1b <- y0b + rugwidth rugs$x_b <- segmentsGrob( x0 = unit(data$x, "native"), x1 = unit(data$x, "native"), - y0 = unit(0, "npc"), y1 = unit(0.03, "npc"), + y0 = y0b, y1 = y1b, gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt) ) } if(grepl("t", sides)) { + y0t <- unit(1, "npc") + y1t <- y0t - rugwidth rugs$x_t <- segmentsGrob( x0 = unit(data$x, "native"), x1 = unit(data$x, "native"), - y0 = unit(1, "npc"), y1 = unit(0.97, "npc"), + y0 = y0t, y1 = y1t, gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt) ) } - } + } if (!is.null(data$y)) { if(grepl("l", sides)) { + x0l <- unit(0, "npc") + x1l <- x0l + rugwidth rugs$y_l <- segmentsGrob( y0 = unit(data$y, "native"), y1 = unit(data$y, "native"), - x0 = unit(0, "npc"), x1 = unit(0.03, "npc"), + x0 = x0l, x1 = x1l, gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt) ) } if(grepl("r", sides)) { + x0r = unit(1, "npc") + x1r = x0r - rugwidth rugs$y_r <- segmentsGrob( y0 = unit(data$y, "native"), y1 = unit(data$y, "native"), - x0 = unit(1, "npc"), x1 = unit(0.97, "npc"), + x0 = x0r, x1 = x1r, gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt) ) } - } - + } + gTree(children = do.call("gList", rugs)) } - + default_stat <- function(.) StatIdentity default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = NA) guide_geom <- function(.) "path" diff --git a/inst/tests/test-rug.r b/inst/tests/test-rug.r new file mode 100644 index 0000000000..284359f381 --- /dev/null +++ b/inst/tests/test-rug.r @@ -0,0 +1,7 @@ +context("Rug") + +test_that("Rugwidth needs unit object", { + p <- ggplot(mtcars, aes(x=mpg,y=hp)) + expect_is(p + geom_rug(rugwidth=grid::unit(0.01, "npc")), "ggplot") + expect_error(print(p + geom_rug(rugwidth=0.01))) +}) diff --git a/man/geom_rug.Rd b/man/geom_rug.Rd index 3ad8e15ab2..42ee09367c 100644 --- a/man/geom_rug.Rd +++ b/man/geom_rug.Rd @@ -3,7 +3,8 @@ \title{Marginal rug plots.} \usage{ geom_rug(mapping = NULL, data = NULL, stat = "identity", - position = "identity", sides = "bl", ...) + position = "identity", sides = "bl", + rugwidth = unit(0.03, "npc"), ...) } \arguments{ \item{sides}{A string that controls which sides of the @@ -11,6 +12,9 @@ containing any of \code{"trbl"}, for top, right, bottom, and left.} + \item{rugwidth}{The width the rug segments. This should + be a \code{\link{unit}} object.} + \item{mapping}{The aesthetic mapping, usually constructed with \code{\link{aes}} or \code{\link{aes_string}}. Only needs to be set at the layer level if you are overriding