Extra Coordinate Systems, 'Geoms', Statistical Transformations, Scales and Fonts for 'ggplot2'
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

94 lines
2.2 KiB

#' @rdname ggalt-ggproto
#' @format NULL
#' @usage NULL
#' @export
GeomTable <- ggproto(
"GeomTable",
Geom,
required_aes = c("x", "y", "table"),
default_aes = aes(
widthx = 10,
widthy = 10,
rownames = NA
),
draw_key = draw_key_blank,
draw_panel = function(data, panel_scales, coord) {
if (nrow(data) != 1) {
stop(
sprintf(
"only one table per panel allowed, got %s (%s)",
nrow(data),
as.character(data)
),
call. = FALSE
)
}
wy = data$widthy / 2
wx = data$widthx / 2
corners <-
data.frame(x = c(data$x - wx, data$x + wx),
y = c(data$y - wy, data$y + wy))
d <- coord$transform(corners, panel_scales)
# gross hack, but I've found no other way to get a table/matrix/dataframe to this point :-(
table = read.csv(text = data$table, header = TRUE)
if (!is.na(data$rownames)) {
rownames(table) <-
unlist(strsplit(data$rownames, "|", fixed = TRUE))
}
x_rng <- range(d$x, na.rm = TRUE)
y_rng <- range(d$y, na.rm = TRUE)
vp <-
viewport(
x = mean(x_rng),
y = mean(y_rng),
width = diff(x_rng),
height = diff(y_rng),
just = c("center", "center")
)
grob <-
tableGrob(table, theme = ttheme_minimal())
# add a line across the header
grob <- gtable_add_grob(
grob,
grobs = segmentsGrob(y1 = unit(0, "npc"),
gp = gpar(lwd = 2.0)),
t = 1,
b = 1,
l = 1,
r = ncol(d) + 1
)
editGrob(grob, vp = vp, name = paste(grob$name, facet_id()))
}
)
facet_id <- local({
i <- 1
function() {
i <<- i + 1
i
}
})
#' Add a table to a ggplot2 plot
#'
#' @author Jan Schulz
geom_table <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
geom = GeomTable,
mapping = mapping,
data = data,
stat = stat,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}