如何在没有 Shiny 的情况下过滤 Rmarkdown 中的预聚合数据？
How can I filter pre-aggregated data in Rmarkdown without Shiny?
原问题
（请参阅下面的部分解决方案更新。）
我有一个 RMarkdown 文档，它按组总结了有多少记录（行）具有各种属性。我希望能够通过在汇总之前进行过滤来操纵 table 中包含哪些记录。我在下面创建了一个最小但相似的模型。
我想要的是一个交互式复选框，可以有效地“评论或取消评论”行
# filter(weight_class == "Heavy") %>%
以下。
我知道我可以用 Shiny 做到这一点，但我需要能够直接与同事共享生成的 HTML 文件（在我的例子中是通过共享的 Box 文件夹），所以 Shiny 解决方案不是可行，至少目前是这样。此外，我考虑过使用 DT/datatable 的功能，但据我所知，过滤需要在它到达那里之前发生（尽管我愿意被展示我是错了）。
我见过像 htmltools、htmlwidgets 和 crosstalk 这样的软件包，它们似乎可以促进这一点，但我对它们还不够熟悉，也不能似乎在网上找到了一个足够接近的示例，可以根据我的目的进行修改。
实际上我有多个条件我希望能够过滤和多个 tables 和图我想从过滤后的数据中产生，但我希望下面的最小示例可以作为可行的起点。
如何在不借助 Shiny 的情况下添加这样的复选框（或类似复选框）来创建这种类型的交互？
演示 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：
更新部分解决方案
我从@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 package (v1.0.0)
创建于 2021-12-14
我做错了什么？
尝试添加 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
)
```
原问题
（请参阅下面的部分解决方案更新。）
我有一个 RMarkdown 文档，它按组总结了有多少记录（行）具有各种属性。我希望能够通过在汇总之前进行过滤来操纵 table 中包含哪些记录。我在下面创建了一个最小但相似的模型。
我想要的是一个交互式复选框，可以有效地“评论或取消评论”行
# filter(weight_class == "Heavy") %>%
以下。
我知道我可以用 Shiny 做到这一点，但我需要能够直接与同事共享生成的 HTML 文件（在我的例子中是通过共享的 Box 文件夹），所以 Shiny 解决方案不是可行，至少目前是这样。此外，我考虑过使用 DT/datatable 的功能，但据我所知，过滤需要在它到达那里之前发生（尽管我愿意被展示我是错了）。
我见过像 htmltools、htmlwidgets 和 crosstalk 这样的软件包，它们似乎可以促进这一点，但我对它们还不够熟悉，也不能似乎在网上找到了一个足够接近的示例，可以根据我的目的进行修改。
实际上我有多个条件我希望能够过滤和多个 tables 和图我想从过滤后的数据中产生，但我希望下面的最小示例可以作为可行的起点。
如何在不借助 Shiny 的情况下添加这样的复选框（或类似复选框）来创建这种类型的交互？
演示 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：
更新部分解决方案
我从@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 package (v1.0.0)
创建于 2021-12-14我做错了什么？
尝试添加 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
)
```