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.

96 lines
2.5 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 = utils::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
# #'
# #' @export
# #' @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, ...)
# )
# }
#