如何在 Shiny 中正确包含 `kable_classic_2()`？

Question

根据kableExtra文档，这段代码应该能正确输出表格，

library(shiny)

ui <- fluidPage(

   # Application title
   titlePanel("mtcars"),

   sidebarLayout(
      sidebarPanel(
         sliderInput("mpg", "mpg Limit",
                     min = 11, max = 33, value = 20)
      ),

      mainPanel(
         tableOutput("mtcars_kable")
      )
   )
)

server <- function(input, output) {
  library(dplyr)
  library(kableExtra)
   output$mtcars_kable <- function() {
     req(input$mpg)
     mtcars %>%
       mutate(car = rownames(.)) %>%
       select(car, everything()) %>%
       filter(mpg <= input$mpg) %>%
       knitr::kable("html") %>%
       kable_classic_2() %>% 
       add_header_above(c(" ", "Group 1" = 5, "Group 2" = 6))
   }
}

# Run the application
shinyApp(ui = ui, server = server)

但是，输出与表格主题 kable_classic_2() 不对应。所以我更改了output$mtcars_kable，使其直接打印HTML-codes，如下所示，

library(shiny)

ui <- fluidPage(
    
    # Application title
    titlePanel("mtcars"),
    
    sidebarLayout(
        sidebarPanel(
            sliderInput("mpg", "mpg Limit",
                        min = 11, max = 33, value = 20)
        ),
        
        mainPanel(
            uiOutput("mtcars_kable")
        )
    )
)

server <- function(input, output) {
    library(dplyr)
    library(kableExtra)
    output$mtcars_kable <- renderUI(
        
        {
            req(input$mpg)
            mtcars %>%
                mutate(car = rownames(.)) %>%
                select(car, everything()) %>%
                filter(mpg <= input$mpg) %>%
                knitr::kable("html") %>%
                kable_classic_2() %>% 
                add_header_above(c(" ", "Group 1" = 5, "Group 2" = 7))
        }
    )
}

# Run the application
shinyApp(ui = ui, server = server)

但是，这只会输出HTML 代码，而不是将它们呈现到实际表格中。我想要的输出是在替代主题下找到的 here。

Answer 1

看来闪亮不需要 kableExtra css ？

您从这里提到 doc： https://cran.r-project.org/web/packages/kableExtra/vignettes/use_kable_in_shiny.html

用户界面中的tableOutput，以及服务器中的简单function()，返回过滤后的结果。

library(shiny)

ui <- fluidPage(
  
  # Application title
  titlePanel("mtcars"),
  
  sidebarLayout(
    sidebarPanel(
      sliderInput("mpg", "mpg Limit",
                  min = 11, max = 33, value = 20)
    ),
    
    mainPanel(
      tableOutput("mtcars_kable")
    )
  )
  )

server <- function(input, output) {
  library(dplyr)
  library(kableExtra)
  output$mtcars_kable <- function()(
    
    {
      req(input$mpg)
      mtcars %>%
        mutate(car = rownames(.)) %>%
        select(car, everything()) %>%
        filter(mpg <= input$mpg) %>%
        knitr::kable("html") %>%
        kable_classic_2() %>% 
        add_header_above(c(" ", "Group 1" = 5, "Group 2" = 7))
    }
  )
}

# Run the application
shinyApp(ui = ui, server = server)

最好像这样构建汽车专栏：

    mtcars %>%
      as_tibble(rownames = "car") %>% 
      select(car, everything()) %>%

要有一个没有行名的小标题。

所以，就像您在 cmets 中所指出的，来自 kableExtra 的 css 样式根本不会被渲染。 （我已经测试了更新所有包以查看是否有变化，但没有）。

gt 包的其他解决方案

另一个选择是迁移到 gt 包，您可以在其中完全编辑 css...结果非常干净，但显然它不是您问题的 kableExtra 解决方案。

ui <- fluidPage(
  
  # Application title
  titlePanel("mtcars"),
  
  sidebarLayout(
    sidebarPanel(
      sliderInput("mpg", "mpg Limit",
                  min = 11, max = 33, value = 20)
    ),
    
    mainPanel(
       gt::gt_output("mtcars_kable")
    )
  )
)

server <- function(input, output) {
  library(dplyr)
  library(kableExtra)
  output$mtcars_kable <- gt::render_gt({
    req(input$mpg)
    mtcars %>%
      as_tibble(rownames = "car") %>% 
      select(car, everything()) %>%
      filter(mpg <= input$mpg) %>%
      gt::gt(id = "cars") %>% 
      gt::tab_spanner(
        label = "Group 1",
        columns = 2:6) %>% 
      gt::tab_spanner(
        label = "Group 2",
        columns = 6:12) %>% 
      gt::opt_css(
        css = "
    #cars .gt_table {
      background-color: #fffggg;
    }
    #cars .gt_row {
      padding: 4px 12px;
    }
    #cars .gt_col_heading {
      text-align: center !important;
    }
    ")
  })
}