boB Rudis
7 years ago
19 changed files with 276 additions and 13 deletions
@ -0,0 +1,52 @@ |
|||
geom_rrect <- function(mapping = NULL, data = NULL, |
|||
stat = "identity", position = "identity", |
|||
..., |
|||
na.rm = FALSE, |
|||
show.legend = NA, |
|||
inherit.aes = TRUE) { |
|||
layer( |
|||
data = data, |
|||
mapping = mapping, |
|||
stat = stat, |
|||
geom = GeomRect, |
|||
position = position, |
|||
show.legend = show.legend, |
|||
inherit.aes = inherit.aes, |
|||
params = list( |
|||
na.rm = na.rm, |
|||
... |
|||
) |
|||
) |
|||
} |
|||
|
|||
GeomRrect <- ggplot2::ggproto("GeomRrect", ggplot2::Geom, |
|||
default_aes = aes(colour = NA, fill = "grey35", size = 0.5, linetype = 1, |
|||
alpha = NA), |
|||
|
|||
required_aes = c("xmin", "xmax", "ymin", "ymax"), |
|||
|
|||
draw_panel = function(self, data, panel_params, coord) { |
|||
coords <- coord$transform(data, panel_params) |
|||
lapply(1:length(coords$xmin), function(i) { |
|||
ggname("geom_rrect", grid::roundrectGrob( |
|||
coords$xmin[i], coords$ymax[i], |
|||
width = (coords$xmax[i] - coords$xmin[i]), |
|||
height = (coords$ymax[i] - coords$ymin)[i], |
|||
r=unit(0.3, "snpc"), |
|||
default.units = "native", |
|||
just = c("left", "top"), |
|||
gp = grid::gpar( |
|||
col = coords$colour[i], |
|||
fill = alpha(coords$fill[i], coords$alpha[i]), |
|||
lwd = coords$size[i] * .pt, |
|||
lty = coords$linetype[i], |
|||
lineend = "butt" |
|||
) |
|||
)) |
|||
}) -> gl |
|||
|
|||
do.call(grid::gList, gl) |
|||
}, |
|||
|
|||
draw_key = ggplot2::draw_key_polygon |
|||
) |
@ -0,0 +1,41 @@ |
|||
geom_rtile <- function(mapping = NULL, data = NULL, |
|||
stat = "identity", position = "identity", |
|||
..., |
|||
na.rm = FALSE, |
|||
show.legend = NA, |
|||
inherit.aes = TRUE) { |
|||
layer( |
|||
data = data, |
|||
mapping = mapping, |
|||
stat = stat, |
|||
geom = GeomRtile, |
|||
position = position, |
|||
show.legend = show.legend, |
|||
inherit.aes = inherit.aes, |
|||
params = list( |
|||
na.rm = na.rm, |
|||
... |
|||
) |
|||
) |
|||
} |
|||
|
|||
GeomRtile <- ggplot2::ggproto("GeomRtile", GeomRrect, |
|||
extra_params = c("na.rm", "width", "height"), |
|||
|
|||
setup_data = function(data, params) { |
|||
data$width <- data$width %||% params$width %||% resolution(data$x, FALSE) |
|||
data$height <- data$height %||% params$height %||% resolution(data$y, FALSE) |
|||
|
|||
transform(data, |
|||
xmin = x - width / 2, xmax = x + width / 2, width = NULL, |
|||
ymin = y - height / 2, ymax = y + height / 2, height = NULL |
|||
) |
|||
}, |
|||
|
|||
default_aes = aes(fill = "grey20", colour = NA, size = 0.1, linetype = 1, |
|||
alpha = NA), |
|||
|
|||
required_aes = c("x", "y"), |
|||
|
|||
draw_key = ggplot2::draw_key_polygon |
|||
) |
@ -0,0 +1,8 @@ |
|||
# Name ggplot grid object |
|||
# Convenience function to name grid objects |
|||
# |
|||
# @keyword internal |
|||
ggname <- function(prefix, grob) { |
|||
grob$name <- grid::grobName(grob, prefix) |
|||
grob |
|||
} |
Before Width: | Height: | Size: 87 KiB After Width: | Height: | Size: 118 KiB |
After Width: | Height: | Size: 87 KiB |
Before Width: | Height: | Size: 34 KiB |
Before Width: | Height: | Size: 36 KiB |
Before Width: | Height: | Size: 30 KiB |
|
|
File diff suppressed because one or more lines are too long
Loading…
Reference in new issue