5

原始问题

(请参阅下面的部分解决方案更新。)

我有一个 RMarkdown 文档,它按组总结了有多少记录(行)具有各种属性。我希望能够通过在汇总之前进行过滤来操纵表中包含哪些记录。我在下面创建了一个最小但类似的模型。

我想要的是一个交互式复选框,可以有效地“注释或取消注释”行

  # filter(weight_class == "Heavy") %>% 

以下。

我知道我可以用 Shiny 做到这一点,但我需要能够直接与同事共享生成的 HTML 文件(在我的例子中是通过共享的 Box 文件夹),所以 Shiny 解决方案不可行,至少现在是这样。另外,我考虑过使用DT/的功能datatable,但据我所知,过滤需要在它到达那里之前进行(尽管我愿意被证明我错了)。

我见过像htmltools,htmlwidgetscrosstalk这样的包,它们似乎可以促进这一点,但我对它们还不够熟悉,似乎无法在网上找到足够接近的示例来为我的目的进行修改。

实际上,我有多个条件我希望能够过滤,并且我想从过滤后的数据中生成多个表和图,但我希望下面的最小示例可以作为一个可行的起点。

我怎样才能添加这样一个复选框(或类似的)来创建这种类型的交互而不诉诸闪亮?

演示 RMarkdown:

---
title: "Table Demo"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(DT)
```

```{r data}
set.seed(42)
df <- tibble(
  group = sample(paste0("Group ", LETTERS[1:4]), 100, replace = T),
  weight_class = sample(c("Heavy", "Light"), 100, replace = T, prob = c(.3, .7)),
  is_ready = sample(c(TRUE, FALSE), 100, replace = T, prob = c(.4, .6))
)
```

```{r table}
df %>% 
  # filter(weight_class == "Heavy") %>% 
  count(group, is_ready) %>% 
  pivot_wider(names_from = "is_ready", values_from = n) %>% 
  rename(Ready = `TRUE`, not_ready = `FALSE`) %>% 
  mutate(Total = Ready + not_ready, Ready_Percentage = Ready/Total) %>% 
  select(group, Ready, Total, Ready_Percentage, -not_ready) %>% 
  datatable() %>% 
  formatPercentage("Ready_Percentage")
```

生成的 HTML:

HTML_output

使用部分解决方案更新

我从@user2554330 的建议中得到了一个几乎可行的解决方案:

---
title: "Table Demo"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(DT)
```

```{r data}
set.seed(42)
df <- tibble(
  group = sample(paste0("Group ", LETTERS[1:4]), 100, replace = T),
  weight_class = sample(c("Heavy", "Light"), 100, replace = T, prob = c(.3, .7)),
  is_ready = sample(c(TRUE, FALSE), 100, replace = T, prob = c(.4, .6))
)
```

```{r solution}
library(reactable)
library(crosstalk)
shared_df <- SharedData$new(df)

shared_df %>% 
  reactable(
    groupBy = "group",
    columns = list(
      is_ready = colDef(aggregate = "frequency")
    )
  ) -> tb

bscols(
  widths = c(2, 10),
  list(filter_checkbox("weight_class", "Weight Class", shared_df, ~weight_class)),
  tb
)
```

不幸的是,过滤不会影响聚合(见屏幕截图)。

选择所有记录的屏幕截图:

所有记录

仅选择了重记录的屏幕截图:

仅重记录

过滤影响组计数,但不影响is_ready频率聚合。我希望过滤也会影响此列,结果如下:

df %>% filter(weight_class == "Heavy") %>% count(group, is_ready)
#> # A tibble: 8 x 3
#>   group   is_ready     n
#>   <chr>   <lgl>    <int>
#> 1 Group A FALSE        8
#> 2 Group A TRUE         1
#> 3 Group B FALSE        7
#> 4 Group B TRUE         3
#> 5 Group C FALSE        4
#> 6 Group C TRUE         1
#> 7 Group D FALSE       11
#> 8 Group D TRUE         2

reprex 包于 2021-12-14 创建(v1.0.0)

我究竟做错了什么?

4

1 回答 1

4

尝试添加一个 JS 聚合函数回调,而不是使用内置聚合:

shared_df %>% 
  reactable(
    groupBy = "group",
    columns = list(
      # is_ready = colDef(aggregate = "frequency"),
      is_ready = colDef(aggregated = JS("function(cellInfo) {
        let total_rows = cellInfo.subRows.length
        let total_ready_rows = cellInfo.subRows.filter(val => val.is_ready === true).length
        let percent = Math.round(total_ready_rows * 100 / total_rows) + '%'
        
        return percent
      }"))
    )
  ) -> tb

在此处输入图像描述 在此处输入图像描述

由于某种原因,如果您使用frequency函数或任何其他默认值,它不会被更新,但 JS 总是使用动态数据;此后,使用 JS 函数计算过滤数据的聚合。

完整代码:

---
title: "Table Demo"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(DT)
```

```{r data}
set.seed(42)
df <- tibble(
  group = sample(paste0("Group ", LETTERS[1:4]), 100, replace = T),
  weight_class = sample(c("Heavy", "Light"), 100, replace = T, prob = c(.3, .7)),
  is_ready = sample(c(TRUE, FALSE), 100, replace = T, prob = c(.4, .6))
)
```

```{r solution}
library(reactable)
library(crosstalk)
shared_df <- SharedData$new(df)

shared_df %>% 
  reactable(
    groupBy = "group",
    columns = list(
      # is_ready = colDef(aggregate = "frequency"),
      is_ready = colDef(aggregated = JS("function(cellInfo) {
        let total_rows = cellInfo.subRows.length
        let total_ready_rows = cellInfo.subRows.filter(val => val.is_ready === true).length
        let percent = Math.round(total_ready_rows * 100 / total_rows) + '%'
        
        return percent
      }"))
    )
  ) -> tb

bscols(
  widths = c(2, 10),
  list(filter_checkbox("weight_class", "Weight Class", shared_df, ~weight_class)),
  tb
)
```
于 2021-12-15T21:51:03.750 回答