使用facet将表添加到ggplot

2 回答

• 4

  也许你需要使用网格库 . 这是一个例子：

  library(ggplot2)
  
  x = sample(1:12,100,replace=TRUE)
  y = rnorm(100)
  z = sample(c('Sample A','Sample B'), 100, replace=TRUE)
  d = data.frame(x,y,z)
  
  g1 <- ggplot(data=d, aes(factor(x),y)) + 
    geom_boxplot() + 
    stat_summary(fun.y=mean, geom="line", aes(group=1), color ='red') + 
    stat_summary(fun.y=mean, geom="point", color='red') + 
    xlab('Months') +  ylab('Metric') +  facet_wrap(~z) 
  
  g2 <- ggplot() + theme_void() + xlim(0, 1) + ylim(0, 1) + 
    annotate("text", x=0.5, y=0.5, label="Draw the summary here")
  
  library(grid)
  
  grid.newpage()
  pushViewport(viewport(layout=grid.layout(4,2)))
  print(g1, vp=viewport(layout.pos.row = 1:3, layout.pos.col = 1:2))
  print(g2, vp=viewport(layout.pos.row = 4, layout.pos.col = 1))
  print(g2, vp=viewport(layout.pos.row = 4, layout.pos.col = 2))
  

  结果：
  

  回复于 2024-05-05T12:00:26+08:00
• 0

  如果您不想要下面的表格，但需要数据（在特定点），这里是一个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")
  

  结果：

  

  回复于 2024-05-05T12:00:26+08:00