使用 gt 表绘制每行的直方图 - R

Posted 2023-02-16

【中文标题】使用 gt 表绘制每行的直方图 - R

【英文标题】：Plot histograms per row using gt tables - R

【发布时间】：2021-11-30 12:49:53

【问题描述】：

我想创建一个 gt 表，在其中可以看到一些指标，例如观察次数、平均值和中位数，并且我想要一个带有直方图的列。对于这个问题，我将使用 iris 数据集。

我最近学会了如何使用以下代码将情节放在小标题中：

library(dplyr)
library(tidyr)
library(purrr)
library(gt)
my_tibble <- iris %>%
  pivot_longer(-Species, 
               names_to = "Vars", 
               values_to = "Values") %>%
  group_by(Vars) %>%
  summarise(obs = n(),
            mean = round(mean(Values),2),
            median = round(median(Values),2), 
            plots = list(ggplot(cur_data(), aes(Values)) + geom_histogram()))

现在我想使用 plots 列来绘制每个变量的直方图，所以我尝试了这个：

my_tibble %>%
  mutate(ggplot = NA) %>%
  gt() %>%
  text_transform(
    locations = cells_body(vars(ggplot)),
    fn = function(x) 
      map(.$plots,ggplot_image)
    
  )

但它返回一个错误：

Error in body[[col]][stub_df$rownum_i %in% loc$rows] <- fn(body[[col]][stub_df$rownum_i %in%  : 
  replacement has length zero

gt 表应该是这样的：

任何帮助将不胜感激。

【参考方案1】：

我们需要遍历plots

library(dplyr)
library(tidyr)
library(purrr)
library(gt)
library(ggplot2)
iris %>%
  pivot_longer(-Species, 
               names_to = "Vars", 
               values_to = "Values") %>%
  nest_by(Vars) %>%
  mutate(n = nrow(data),
         mean = round(mean(data$Values), 2), 
         median = round(median(data$Values), 2), 
         plots = list(ggplot(data, aes(Values)) + geom_histogram()), .keep = "unused") %>%
  ungroup %>%
  mutate(ggplot = NA) %>%
  dat <- .
  dat %>%
    select(-plots) %>%
    gt() %>%
  text_transform(locations = cells_body(c(ggplot)),
                 fn = function(x) 
                  map(dat$plots, ggplot_image, height = px(100))
                 
                 
                 
                 )
  

-检查输出

【讨论】：

这个真不错！

@Alexis 你需要my_tibble$plots2 <- map(my_tibble$plots, ~ tibble(ggplot = NA) %>% gt() %>% text_transform( locations = cells_body(columns = ggplot), fn = function(x) .x %>% ggplot_image(height = px(200)) ) )

你好@akrun，你的回答给了我一些关于如何实现预期表格的想法。再次感谢您，非常感谢您的帮助。

我有点忙，没来得及尝试。谢谢

@Alexis 我更新了帖子。我调整了你的代码并在一个 %>% 中完成了这个，这样我们就不必重做两次 pivot_longer

【参考方案2】：

更新：参见 cmets：

根据闪亮的应用程序，您可以使用summarytools，请参阅此处：https://cran.r-project.org/web/packages/summarytools/vignettes/introduction.html

兼容 r shiny！

这是一个小例子：

library(summarytools)
dfSummary(iris, 
          plain.ascii  = FALSE, 
          style        = "grid", 
          graph.magnif = 0.75, 
          valid.col    = FALSE,
          tmp.img.dir  = "/tmp")

view(dfSummary(iris))

试试这个：

library(skimr)
skim(iris)

  skim_variable n_missing complete_rate  mean    sd    p0   p25   p50   p75  p100 hist 
* <chr>             <int>         <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr>
1 Sepal.Length          0             1  5.84 0.828   4.3   5.1  5.8    6.4   7.9 ▆▇▇▅▂
2 Sepal.Width           0             1  3.06 0.436   2     2.8  3      3.3   4.4 ▁▆▇▂▁
3 Petal.Length          0             1  3.76 1.77    1     1.6  4.35   5.1   6.9 ▇▁▆▇▂
4 Petal.Width           0             1  1.20 0.762   0.1   0.3  1.3    1.8   2.5 ▇▁▇▅▃

【讨论】：

嗨@TarJae，该解决方案很好，但是用于绘制直方图的特殊字符存在问题（例如，其中一些字符不适用于闪亮），这就是原因我想用 gt 来实现它。无论如何谢谢你！ （老实说，我想要像撇渣器这样的东西，但还有其他指标，如偏度、峰度等）

给我几秒钟。目前正在研究另一个问题，但有可能使用闪亮。我做到了。很快就会回来！

我正在处理一个复杂的例子，Thomas Mock 用它来绘制每行的迷你图，除了 akrun 给出的很好的答案之外，这对于其他读者来说将是一个很好的问题和答案。

请看我的更新。不是skimr，而是summarytools我在闪亮的应用程序中使用的！

嗨@TarJae，感谢您的回答，我非常感谢您和SO 中的其他人对该社区成员的帮助。祝你有美好的一天！

【参考方案3】：

在回顾了@akrun 和@TarJae 的优秀想法之后，我有了这个解决方案，它提供了所需的 gt 表：

plots <- iris %>% 
  pivot_longer(-Species, 
               names_to = "Vars", 
               values_to = "Values") %>%
  group_by(Vars) %>%
  nest() %>%
  mutate(plot = map(data, 
                    function(df) df %>% 
                      ggplot(aes(Values)) + 
                      geom_histogram())) %>%
  select(-data)

iris %>%
  pivot_longer(-Species, 
               names_to = "Vars", 
               values_to = "Values") %>%
  group_by(Vars) %>%
  summarise(obs = n(),
            mean = round(mean(Values),2),
            median = round(median(Values),2)) %>%
  mutate(ggplot = NA) %>%
  gt() %>%
  text_transform(
    locations = cells_body(vars(ggplot)),
    fn = function(x) 
      map(plots$plot, ggplot_image, height = px(100))
    
  )

这是表格：

我必须在输出表之外创建绘图，所以我可以在 gt 表中调用它。