ggplot2: geom_text resize with the plot and force/fit text within geom_bar

后端 未结 2 1116
傲寒
傲寒 2020-12-30 03:00

This is actually two questions in one (not sure if goes against SO rules, but anyway).

First question is how can I force a geom_text to fit within a

2条回答
  •  温柔的废话
    2020-12-30 03:39

    one option might be to write a geom that uses a textGrob with a custom drawDetails method to fit within the allocated space, set by the bar width.

    library(grid)
    library(ggplot2)
    
    fitGrob <- function(label, x=0.5, y=0.5, width=1){
      grob(x=x, y=y, width=width, label=label, cl = "fit")
    }
    drawDetails.fit <- function(x, recording=FALSE){
      tw <- sapply(x$label, function(l) convertWidth(grobWidth(textGrob(l)), "native", valueOnly = TRUE))
      cex <- x$width / tw
      grid.text(x$label, x$x, x$y, gp=gpar(cex=cex), default.units = "native")
    }
    
    
    `%||%` <- ggplot2:::`%||%`
    
    GeomFit <- ggproto("GeomFit", GeomRect,
                       required_aes = c("x", "label"),
    
                       setup_data = function(data, params) {
                         data$width <- data$width %||%
                           params$width %||% (resolution(data$x, FALSE) * 0.9)
                         transform(data,
                                   ymin = pmin(y, 0), ymax = pmax(y, 0),
                                   xmin = x - width / 2, xmax = x + width / 2, width = NULL
                         )
                       },
                       draw_panel = function(self, data, panel_scales, coord, width = NULL) {
                         bars <- ggproto_parent(GeomRect, self)$draw_panel(data, panel_scales, coord)
                         coords <- coord$transform(data, panel_scales)    
                         width <- abs(coords$xmax - coords$xmin)
                         tg <- fitGrob(label=coords$label, y = coords$y/2, x = coords$x, width = width)
    
                         grobTree(bars, tg)
                       }
    )
    
    geom_fit <- function(mapping = NULL, data = NULL,
                         stat = "count", position = "stack",
                         ...,
                         width = NULL,
                         binwidth = NULL,
                         na.rm = FALSE,
                         show.legend = NA,
                         inherit.aes = TRUE) {
    
      layer(
        data = data,
        mapping = mapping,
        stat = stat,
        geom = GeomFit,
        position = position,
        show.legend = show.legend,
        inherit.aes = inherit.aes,
        params = list(
          width = width,
          na.rm = na.rm,
          ...
        )
      )
    }
    
    
    set.seed(1234567)
    data_gd <- data.frame(x = letters[1:5], 
                          y = runif(5, 100, 99999))
    
    ggplot(data = data_gd,
           mapping = aes(x = x, y = y, fill = x, label=round(y))) +
      geom_fit(stat = "identity") +
      theme()
    

提交回复
热议问题