如果您不想要下表但在数据上(在特定点),这是一个作为 geom 的实现:
library(grid)
library(gridExtra)
library(gtable)
library(ggplot2)
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
}
})
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, ...)
)
}
# helper function
to_csv_ <- function(x) {
paste(capture.output(write.csv(x, stdout(), row.names = F)),
collapse = "\n")
}
# data
data <- data.frame(x = 1:20, y = 20:1, c = rep(c("a", "b"), 10))
# this could be the output of a summarize pipe
suma <- to_csv_(data.frame(a = c(1, 2), b = c(2, 3)))
sumb <- to_csv_(data.frame(a = c(9, 9), b = c(9, 9)))
dt <- data.frame(c = c("a", "b"), t = c(suma, sumb), stringsAsFactors = FALSE)
ggplot(data, aes(x, y)) + geom_point() + facet_wrap( ~ c) +
geom_table(data = dt, aes(table = t), x = 15, y = 15, rownames = "mean|sd")
结果: