在ggplot2中,如何删除所有主题+删除一些数据,但保留数据显示的纵横比?

7
我正在尝试创建一个基本图,并在没有某些数据和任何其他元素的情况下重新创建修改后的版本(基本上是+ theme_void())。这里的困难在于保持绘图之间保持的数据的确切大小和位置。
假设我有以下图表:
library(ggplot2)

# Sample data frame
d <- data.frame(group = c("A", "B", "C"),
                value = c(10, 15, 5))

# Create the original bar plot
g1 <- ggplot() +
  geom_col(data = d,
           aes(x = group, 
               y = value,
               fill = group)) +
  theme_bw()

enter image description here

目标是创建(并保存为.SVG)三个图表,每个图表有一个柱形图(+ theme_void),但位置/大小与第一个图表相同。
期望的图表1: {{link1:输入图像描述}}
期望的图表2: {{link2:输入图像描述}}
期望的图表3: {{link3:输入图像描述}}
我猜一种可能性是将其他所有元素设为白色/透明,但我想避免这种方法,因为我将进一步操作保存为.SVG的图表,并且这些元素会一直存在(增加复杂性和文件大小)。
另一种我想要追求的方法是介入到ggplot2的工作流程中,在合适的时机停止它(绘图上下文已经给定),修改它(比如擦除除了一个单独的柱形之外的所有内容),最后渲染修改后的图表。
gginnards包中有像delete_layers()这样的函数,主题可以用%+%运算符替换,但据我所见,它们只修改大小/位置(虽然这是应该的,但不是我想要的)。
我找到的最接近的东西是ggtrace包(特别是"highjack-ggproto")和整个关于grid/grob的讨论(对我来说仍然非常晦涩)。
我想在接下来的几周里会更多地了解这些问题,但对此方面的任何建议都将非常感激!
编辑:根据下面宝贵的答案,我必须强调:
这只是一个玩具例子,真实情况中会在原始图中加入许多主题修改。也就是说,在这种情况下,简化第一个图以便更容易比较的方法并不适用。
目标是将结果保存为干净的SVG文件。所谓干净,意味着SVG文件中应该只有可见元素(根据我检查其源代码)。例如,如果我的图中有数百个点,并且我筛选出一个点,那么这个单独的点应该在新的SVG文件中独立存在(位置与第一个图中完全相同 - 第一个图包含了多个主题修改、标题、图例、坐标轴等等)。

你所提出的困难在于ggplot2会根据图例、标签、坐标轴等元素的存在自动调整对象的大小。因此,要保持它们的大小和位置不变,同时移除除了那个对象以外的所有内容,就需要对工具进行一些修改。 - Phil
没错!我猜这个问题可能出在ggplot2绘图过程中的某个步骤上(就像"highjack-ggproto"所使用的那个)。 - Arthur Welle
5个回答

11
这实际上相当困难。问题在于条形的确切位置是由嵌套的视口确定的。最简单的解决方案可能只是遍历ggplot对象的gTable,并将所有不是条形的对象设置为zeroGrobs。
让我们从图表本身开始:
library(ggplot2)

# Sample data frame
d <- data.frame(group = c("A", "B", "C"),
                value = c(10, 15, 5))

# Create the original bar plot
g1 <- ggplot() +
  geom_col(data = d,
           aes(x = group, 
               y = value,
               fill = group)) +
  theme_bw()

我们的第一步是将其构建成一个 gTable
gt <- ggplot_gtable(ggplot_build(g1))

请注意,从现在开始,如果我们想要绘制结果,可以这样做:
grid::grid.newpage()
grid::grid.draw(gt)

现在,让我们把除了面板以外的所有内容都变成零grobs。面板始终是一个gTree,所以我们可以这样做:
gt$grobs <- lapply(gt$grobs, function(x) {
  if(class(x)[1] == 'gTree') x else zeroGrob()
  })

请注意,这将清除除面板以外的所有内容,但保持所有间距不变。
grid::grid.newpage()
grid::grid.draw(gt)

现在我们想在面板内做同样的事情,删除除了 geom_rect grob 之外的所有内容:

panel <- which(lengths(gt$grobs) > 3)

gt$grobs[[panel]]$children <- lapply(gt$grobs[[panel]]$children, function(x) {
  if(grepl('geom_rect', x)) x else zeroGrob()
})

这就只剩下我们的三个条形图了:
grid::grid.newpage()
grid::grid.draw(gt)

为了将每个柱状图分别绘制在它们自己的图表中,我们创建三个绘图对象的副本。
gt_list <- list(gt1 = gt, gt2 = gt, gt3 = gt)

现在我们遍历这个列表,并删除除了一个之外的所有条形图:

rectangles <- which(lengths(gt$grobs[[panel]]$children) > 3)

gt_list <- Map(function(x, i) {
  rect <- x$grobs[[panel]]$children[[rectangles]]
  rect$x <- rect$x[i]
  rect$y <- rect$y[i]
  rect$width <- rect$width[i]
  rect$height <- rect$height[i]
  rect$gp <- rect$gp[i]
  x$grobs[[panel]]$children[[rectangles]] <- rect
  x
}, gt_list, seq_along(gt_list))

我们现在有三个图形,每个图形中只有一个图形对象,但是与原始图形相比,每个图形元素的位置都没有改变。
grid::grid.newpage()
grid::grid.draw(gt_list[[1]])

grid::grid.newpage()
grid::grid.draw(gt_list[[2]])

grid::grid.newpage()
grid::grid.draw(gt_list[[3]])

此外,我们可以看到生成的SVG文件中没有多余的不可见对象;只有条形图被写入文件中。
svg('my.svg')
grid::grid.newpage()
grid::grid.draw(gt_list[[1]])
dev.off()

导致的结果

my.svg

<?xml version="1.0" encoding="UTF-8"?>
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" width="504pt" height="504pt" viewBox="0 0 504 504" version="1.1">
<g id="surface1">
<rect x="0" y="0" width="504" height="504" style="fill:rgb(100%,100%,100%);fill-opacity:1;stroke:none;"/>
<path style=" stroke:none;fill-rule:nonzero;fill:rgb(97.254902%,46.27451%,42.745098%);fill-opacity:1;" d="M 52.492188 451.675781 L 169.050781 451.675781 L 169.050781 168.375 L 52.492188 168.375 Z M 52.492188 451.675781 "/>
</g>
</svg>

而且,如果有任何疑虑认为事情不合适,让我们保存这些图表并将它们动画化来证明:
gt <- ggplot_gtable(ggplot_build(g1))

png('plot1.png')
grid::grid.newpage()
grid::grid.draw(gt)
dev.off()

Map(function(x, f) {
  png(f)
  grid::grid.newpage()
  grid::grid.draw(x)
  dev.off()
}, gt_list, c('plot2.png', 'plot3.png', 'plot4.png'))

library(magick)

list.files(pattern = 'plot\\d+\\.png', full.names = TRUE) |> 
  image_read() |>
  image_join() |> 
  image_animate(fps=4) |> 
  image_write("barplot.gif")

enter image description here

于2023年08月31日使用reprex v2.0.2创建


谢谢,艾伦!就这样了!我需要开始学习ggplot2的内部机制,我能感受到它所带来的强大力量! - Arthur Welle
1
@ArthurWelle 我实际上不喜欢粗暴地入侵,如果能避免的话,但是我在这里没有看到更好的方法,而且代码也不是太难。 - Allan Cameron
1
一个让我产生疑问的问题是你使用svg()和dev.off()来保存它。如果我使用ggsave(),结果会不同。在这种情况下,svg中有一个条形的路径,而ggsave()中是一个矩形元素。现在ggsave不再适用,因为我们有一个网格了,是这样吗? - Arthur Welle
@ArthurWelle 正确。你不能使用ggsave,因为它不再是一个ggplot对象。根据你设定的限制条件,它无法成为一个ggplot对象。你可以选择要么使用theme_blank来设置边距以精确复制原始图形的尺寸(但这并不是你想要的),要么使用不可见元素(会导致svg垃圾),要么将图形构建为图形对象并选择你想要的部分,就像我在这里提供的解决方案一样,但那时你就不再有一个ggplot对象了。在ggplot中,无法在构建绘图之前添加填充空元素。 - Allan Cameron
1
虽然如果你想使用ggsave,你可以采取额外的步骤,使用patchwork::wrap_elements,这样应该可以使用ggsave保存grob。 - Allan Cameron

6
我是ggtrace的作者。Allan很棒,已经很好地回答了你的问题(我将无耻地复制他的reprex/答案的部分),但是既然你提到了ggtrace,我忍不住要给出一个ggtrace的解决方案!
ggtrace的工作流程如下:
第一步是在图层的数据即将传递给几何图形之前拦截。图层的绘制始于ggproto方法Geom$draw_layer(),该方法接受图层数据作为data参数。当我说"图层的数据"时,我指的是layer_data(g1)
g1 <- ggplot() +
  geom_col(data = d,
           aes(x = group, 
               y = value,
               fill = group)) +
  theme_bw()
layer_data(g1)
#>      fill x  y PANEL group flipped_aes ymin ymax xmin xmax colour linewidth linetype alpha
#> 1 #F8766D 1 10     1     1       FALSE    0   10 0.55 1.45     NA       0.5        1    NA
#> 2 #00BA38 2 15     1     2       FALSE    0   15 1.55 2.45     NA       0.5        1    NA
#> 3 #619CFF 3  5     1     3       FALSE    0    5 2.55 3.45     NA       0.5        1    NA

注意每一行数据代表一个条形图。如果我们希望geom图层只绘制一个条形图,我们可以劫持传递给Geom$draw_layer()的参数,使其接收到的data参数只是其中的一行。我们可以使用ggtrace_highjack_args()来实现这一点,通过传递表达式data = data[1,](这个赋值是我们所做的“劫持”)。为了保险起见,我还打印了data[1,],这样你可以在发生这种情况时检查其值:
gt_bar1 <- ggtrace_highjack_args(
  x = g1, method = Geom$draw_layer,
  values = expression(
    data = print(data[1,])
  )
)
#>      fill x  y PANEL group flipped_aes ymin ymax xmin xmax colour linewidth linetype alpha
#> 1 #F8766D 1 10     1     1       FALSE    0   10 0.55 1.45     NA       0.5        1    NA

gt_bar1

gt_bar1

高级功能的输出只是另一个(gtable)grob(带有额外的“ggtrace_highjacked”类,仅用于打印方法),因此您可以在此之后对其进行常规的网格操作。在这里,我复制了Allan的代码,用于“擦除”gtable的非条形元素,并将其应用于gt_bar1。
class(gt_bar1)
#> [1] "ggtrace_highjacked" "gtable"             "gTree"              "grob"               "gDesc"

wipe_nonbar <- function(gt) {
  gt$grobs <- lapply(gt$grobs, function(x) {
    if(class(x)[1] == 'gTree') x else zeroGrob()
  })
  panel <- which(lengths(gt$grobs) > 3)
  gt$grobs[[panel]]$children <- lapply(gt$grobs[[panel]]$children, function(x) {
    if(grepl('geom_rect', x)) x else zeroGrob()
  })
  gt
}

gt_bar1_wiped <- wipe_nonbar(gt_bar1)
gt_bar1_wiped

gt_bar1_wiped

最后,我们将这个工作流程封装成一个函数,并在图层中迭代条形数量,并将grobs保存到一个名为gt_bars的列表中。
n_bars <- nrow(layer_data(g1))
gt_bars <- lapply(seq_len(n_bars), function(i) {
  bar_gt <- ggtrace_highjack_args(
    x = g1, method = GeomBar$draw_panel,
    values = rlang::exprs(
      data = data[data$group == !!i,]
    )
  )
  wipe_nonbar(bar_gt)
})

动画:
purrr::iwalk(
  c(list(g1), gt_bars),
  ~ ggsave(filename = paste0(.y, ".png"), plot = .x, path = tempdir())
)
list.files(tempdir(), "\\d.png", full.names = TRUE) |> 
  magick::image_read() |> 
  magick::image_animate(fps = 4)

animation

结语

你可能会想为什么我们需要劫持ggplot,而不是直接使用geom_col(data = d[1,])。在“渲染时间”进行这样的操作的优势在于,你可以使用已经为其他事情增强了的图层数据,比如位置信息。因此,我们保留了位置调整,比如position_stack()

g2 <- ggplot() +
  geom_col(data = d,
           aes(x = 1, 
               y = value,
               fill = group),
           position = position_stack()) +
  theme_bw()
g2

g2

g2_bar2 <- ggtrace_highjack_args(
  g2, Geom$draw_layer,
  values = expression(
    data = data[2,]
  )
)
g2_bar2

g2_bar2

总的来说,ggtrace让你在"内部"(ggproto、grid等)方面做出更少的让步。柱状图是我们可以在语法中表示的构造,因此我们对它们应该有比其他一些东西(比如隐藏绘图中的所有其他元素)更高级的控制权——我们可以让grid来处理那个。使用ggtrace的这种中间级抽象需要一些时间来适应,但如果你对此感兴趣,请告诉我你想看到更多ggtrace实际应用的内容!

编辑:我对清除非柱状元素的看法

我回到这个问题上,并尝试了一个更符合我的"口味"的wipe_nonbar2()

wipe_nonbar2 <- function(gt) {
  panel <- which(gt$layout$name == "panel")
  gt$grobs[-panel] <- list(zeroGrob())
  rect <- which(grepl("geom_rect", gt$grobs[[panel]]$childrenOrder))
  gt$grobs[[panel]]$children[-rect] <- list(zeroGrob())
  gt
}

这保留了gtable grobs中的一个gList类(虽然微不足道,但使用list(zeroGrob())进行基于索引的赋值是一个很好的特性)。
waldo::compare(wipe_nonbar(gt_bar1), wipe_nonbar2(gt_bar1))
#> `old$grobs[[6]]$children` is a list
#> `new$grobs[[6]]$children` is an S3 object of class <gList>, a list

1
我已经根据@Phil的代码和功能进行了调整,并保留了相同的图表,但隐藏了所有的图例和标题...


myplotfun <- function(x) {
  alpha <- rep(0, 3)
  names(alpha) <- c("A", "B", "C")
  alpha[names(alpha) == x] <- 1
  
  p <- ggplot() +
    geom_col(data = d,
             aes(x = group, 
                 y = value,
                 fill = group,
                 alpha = group)) +
    scale_alpha_manual(values = alpha) +
    theme(
      legend.text = element_text(color = "white"),
      panel.background = element_rect(fill = "white"),
      axis.text = element_blank(),
      axis.ticks = element_blank(),
      axis.title = element_blank(),
      legend.title = element_blank(),
      legend.key=element_rect(fill = "white")) +
    guides(fill = guide_legend(override.aes = list(alpha = 0, fill = "white"))) 

  ggsave(paste0(x, ".svg"), p, device = "svg")
  
}

purrr::walk(c("A", "B", "C"), myplotfun)
  
  ggsave(paste0(x, ".svg"), p, device = "svg")
}

purrr::walk(c("A", "B", "C"), myplotfun)


谢谢Matt。@Phil的方法仍然存在问题。1)保存的SVG文件中包含了所有元素(现在是白色的);B)柱状图的位置稍有不同。 - Arthur Welle
感谢您的评论。我刚刚进行了编辑,我之前误解了您的帖子。 - Matt B
我无法在不影响比例尺的情况下移除图例,所以我需要隐藏它,但其他所有内容都已经被移除了。 - Matt B

1
如果您将数据转换为factor并指定保留删除的水平,那么第一部分就可以完成。
library(ggplot2)
library(dplyr)

d <- data.frame(group = as.factor(c("A", "B", "C")),
                value = c(10, 15, 5))

# Create the original bar plot
g1 <- ggplot() +
  geom_col(data = d,
           aes(x = group, 
               y = value,
               fill = group)) +
  theme_void()

g1


g2 <- d %>% 
  filter(group == "A") %>% 
  ggplot() +
  aes(
    x = group, 
    y = value,
    fill = group
  ) +
  geom_col() +
  scale_fill_discrete(drop = FALSE) +
  scale_x_discrete(drop = FALSE) +
  theme_void()

g2

2023-08-31由reprex package(v1.0.0)创建

然而,图例有些棘手,到目前为止我还没有找到解决办法。也许对你有用的一个变通方法是先生成所有没有图例的图形(设置theme(legend.position = "none")),然后在另一个步骤中创建图例,并将其放置在适合布局的位置?你可以使用cowplot::get_legend(g1)ggpubr::get_legend(g1)提取图例。


谢谢Starja!我看到你用theme_void来描述了第一个情节。对我来说,这是不可行的。这只是一个简单的玩具例子,真实情况下的情节更加复杂,有很多主题修改。我们从一个充满变化的情节开始,然后我想将其减少到一个保持相同视图(与第一个情节完全相同的大小和位置)的单一柱状图。所以我猜想在网格/图形阶段进行修改可能是正确的方法。 - Arthur Welle
2
我明白了。你确实可能需要调整一下图形对象(grobs),我找到了这些函数,也许对你有帮助:ggplot_gtable(ggplot_build(g1)) - starja

1
如果你在一个自定义函数中捕获主要步骤,然后可以遍历绘图的每个元素,将不需要的柱状图的 alpha 值设为 0(即透明)。
myplotfun <- function(x) {
  alpha <- rep(0, 3)
  names(alpha) <- c("A", "B", "C")
  alpha[names(alpha) == x] <- 1
  
  p <- ggplot() +
    geom_col(data = d,
             aes(x = group, 
                 y = value,
                 fill = group,
                 alpha = group), show.legend = FALSE) +
    scale_alpha_manual(values = alpha) +
    theme_void()
  
  ggsave(paste0(x, ".svg"), p, device = "svg")
}

使用purrr::walk()进行迭代。
purrr::walk(c("A", "B", "C"), myplotfun)

1
谢谢Phil!但是这种方法有两个不希望的特点:1)单列图中的列不在与第一个图完全相同的位置(因为第一个图中有多个元素:坐标轴、图例、标题、说明等)。2)透明度会保留保存的SVG中的所有元素。在这个玩具示例中,这几乎不是问题,因为只有三列,但我的用例有数百/数千个元素。我希望每个新的SVG只包含独立的条形图(在这种情况下是svg中的一个矩形)。 - Arthur Welle

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接