修改 R Markdown Flexdashboard 以使用 Purrr 循环和 HTMLWidgets 为子组和数据生成页面和选项卡

问题描述 投票:0回答:0

如何使用 purrr 循环和 htmlwidgets 修改我现有的 R Markdown flexdashboard 代码以生成包含与数据框中的子组和数据相对应的页面和选项卡的仪表板?

目前,我的代码使用 purrr 循环为每个子组(物种)创建选项卡,并使用串扰连接 flextable 和 ggplotly 图。但是,我想修改代码,以便它为数据集中的每个物种生成页面,并在每个页面中使用 htmlwidgets 显示成对比较。

当前代码生成两个页面用于比较(不在循环中,硬编码)和每个物种的选项卡。我将不胜感激一些关于修改语法以生成所有鸢尾花物种页面的指导,并且在每个页面中,包含每个物种中的成对比较的选项卡。

我希望答案对那些没有基础设施来启动闪亮服务器但希望提供全面和交互式报告、跨部门组和子组的分析师有用。

感谢您的帮助!

---
title: "Flexdashboard"
output: flexdashboard::flex_dashboard

---


```{r setup}
pacman::p_load(tidyverse, flexdashboard, crosstalk, plotly, reactable, reactablefmtr, htmltools)


labels <- unique(as.character(iris$Species))

fn_plot <- function(df = iris, x, y, grp ) {
  
  df <- df %>% filter(Species == {{grp}})
  
  df_reactive <- highlight_key(df)  


  pl <-   df_reactive %>% 
      ggplot(aes(x = get(x), y =get(y))) +
      geom_point() 
  
  pl <-
    ggplotly(pl)
  
  
  
  t <-     df_reactive %>%  reactable()
      

  output <-
    bscols(widths = c(6, NA),
           div(style = css(width = "100%", height = "100%"),
               list( t)),
           div(style = css(width = "100%", height = "700px"),
               list(pl)))
return(output)

}


hcs <- 
 map(.x = labels, ~ fn_plot(iris, x = "Sepal.Length", y = "Sepal.Width", grp = .x )) %>%
    setNames(labels) 


hcs2 <- 
  map(.x = labels, ~ fn_plot(iris, x = "Petal.Length", y = "Petal.Width", grp = .x )) %>%
    setNames(labels) 

```

Page 1
====================

Column {.tabset .tabset-fade}
-----------------------------



```{r chunkA}

out <- map(seq_along(hcs), function(i) {

  a1 <- knitr::knit_expand(text = sprintf("### %s\n", names(hcs)[i])) 
  a2 <- knitr::knit_expand(text = "\n```{r}")
  a3 <- knitr::knit_expand(text = sprintf("\nhcs[[%d]]", i)) 
  a4 <- knitr::knit_expand(text = "\n```\n")

  paste(a1, a2, a3, a4, collapse = '\n') 

})

```


`r paste(knitr::knit(text = paste(out, collapse = '\n')))`



Page 2
====================

Column {.tabset .tabset-fade}
-----------------------------



```{r chunkB}

out2 <- map(seq_along(hcs2), function(i) {

  a1 <- knitr::knit_expand(text = sprintf("### %s\n", names(hcs2)[i])) 
  a2 <- knitr::knit_expand(text = "\n```{r}") 
  a3 <- knitr::knit_expand(text = sprintf("\nhcs2[[%d]]", i)) 
  a4 <- knitr::knit_expand(text = "\n```\n")

  paste(a1, a2, a3, a4, collapse = '\n') 
})

```

`r paste(knitr::knit(text = paste(out2, collapse = '\n')))`
r r-markdown knitr purrr flexdashboard
© www.soinside.com 2019 - 2024. All rights reserved.