r - 如何在 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-codes 而不是将它们呈现到实际表中。我想要的输出是在替代主题下找到的输出。

标签： rshinykablekableextra

Answer 1

看起来闪亮不需要 kableExtra css 吗？

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

tableOutput在 UI 中，以及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()) %>%

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

因此，就像您在评论中指出的那样，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;
    }
    ")
  })
}