geom_fit.r

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){
  t <- textGrob(x$label)
  tw <- convertWidth(grobWidth(t), "native", valueOnly = TRUE)
  cex <- x$width / tw
  grid.text(x$label, x$x, x$y, gp=gpar(cex=cex), name="text", default.units = "native")
}


test <- fitGrob(label="test", width=1)
grid.newpage()
grid.draw(test)

`%||%` <- ggplot2:::`%||%`

GeomFit <- ggproto("GeomFit", GeomRect,
                   required_aes = "x",
                   
                   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)
                     # tt <- rectGrob(y = coords$y/2, x = coords$x, width = width, height=unit(1,"mm"))
                     tg <- fitGrob(label=round(coords$y, 4), 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)) +
  geom_fit(stat = "identity") +
  theme()