Table 使用 R 包 DT 使用 autowidth 和 scrollX 渲染

Question

我在使用 DT 包渲染 table 时遇到问题。 table 是根据 plotly 图中的单击事件生成的。如果没有足够的列，我需要 table 不要跨越整个宽度。因此，根据小插图，我将以下代码添加到 DT 包中的函数数据 table 中的选项中：

 autoWidth = TRUE,
 columnDefs = list(list(className = 'dt-center'
                                         , width = '200px'
                                         , targets = '_all'))

如屏幕截图 Auto-Click1.png 所示，第一次单击时，这会根据需要正确显示（参见第一个图像）。但是，如果我第二次单击任意点，生成的 table 将跨越浏览器的整个宽度。（参见 Auto-Click2.png 或第二张图片）。我想让 table 显示为 Auto-Click1 并且渲染在点击之间持续存在。

为了保持点击之间的宽度不变，我尝试添加选项 scrollX=TRUE。这有帮助，并且宽度在点击之间持续存在。但是 headers 列现在未对齐到 table 其余部分的左侧。参见 ScrollX-True.png（参见第三张图片）。

这是一个完整的可重现示例：

    ---
    title: "Dashboard with DT and plotly.  Reproducible example"
    output: 
      flexdashboard::flex_dashboard:
        orientation: rows
        vertical_layout: fill
    runtime: shiny
    ---

    Dashboard
    ======================

    ```{r setup, include=FALSE}
    library(tidyverse)
    library(tidyselect)
    library(tidyr)
    library(magrittr)
    library(dplyr)
    library(ggplot2)
    library(plotly)
    library(shiny)
    library(shinydashboard)
    library(flexdashboard)
    library(rlang)
    library(DT)
    library(readxl)
    library(writexl)

    ```

    Row 
    -----------------------------------------------------------------------

    ### Plot {.no-padding}

    ```{r}
    data <- mtcars %>%
    rownames_to_column("Model") %>%
    mutate(Make = sub("\s+.*","", Model))

    ## Plot in the top row
    renderPlotly({
      p <- data %>%
        ggplot(aes(wt, mpg, color = factor(gear))) +
        geom_point() + guides(color=guide_legend("Gear"))
      ggplotly(p,source = "A") %>%
        event_register("plotly_click")
    })
    ```



    Row
    ---------------------------------------


    ### Data Table 

    ```{r tbl}
    renderUI({
      e <- event_data("plotly_click", priority = "event", source = "A")
      chosen_gear <- data %>% 
        pull(gear) %>% 
        unique() %>% 
        sort() %>% 
        .[e[1,"curveNumber"] + 1]

      if(is.null(e))
        return("Click events will appear here")

      DF <- data %>% 
        filter(gear == chosen_gear) %>% 
        dplyr::select(Model, wt, mpg, gear, Make)

      tbl <- DF  %>%
        datatable(rownames = FALSE
                  , extensions = 'Buttons'
                  , options = list(
                    ##scrollX = TRUE, 
                    # Turning the scrollX option on causes Column headers to misalign with rest of the table
                    # Without the scrollX option table has correct width on first click but
                    # On the second click expands to the full width.
                    autoWidth = TRUE
                    , columnDefs = list(list(className = 'dt-center'
                                             , width = '200px'
                                             , targets = '_all'))
                    , dom = "Blrtip"
                    , buttons = list("copy", list(
                      extend = "collection"
                      , buttons = c("csv", "excel", "pdf")
                      , text = "Download"
                    ))
                    , lengthMenu = list(c(5, -1)
                                        , c(5, "All"))
                    , pageLength = 5))

      output$table <- renderDT({tbl})

      DTOutput("table")
    })

Auto-Click1

Auto-Click2

ScrollX-True

感谢您的帮助或指点。

Answer 1

正如 https://github.com/rstudio/DT/issues/752#issuecomment-575706297 中的回答，我能想到的最简单的方法是 将最后一行从 DTOutput('tbl') 更改为

div(style = 'width:500px;margin:auto', DTOutput("table"))

Table 使用 R 包 DT 使用 autowidth 和 scrollX 渲染

Table rendering with autowidth and scrollX using R package DT

r

plotly

shinydashboard

dt

flexdashboard