如何为使用 JavaScript 创建的闪亮数据表调整一列的宽度？

Question

My Shiny App 有一个分页系统，允许来回移动。下面是我整个应用程序的迷你版。我想调整包含复选框的数据表的第一列的大小，并使其至少是此时大小的一半，以便为第二列中的实际文本留出更多空间。 如何正确调整第一列？

我在 renderdatatable 命令中尝试过： columnDefs = list(list(targets= 0, width= '30px')。不工作。

我还添加了 autoWidth= TRUE 在 options=list() 中建议 here 和 here，但是，这会使整个表变小。您可以在下面看到我是如何将这些包含在代码中的。

output$table_p2 <- DT::renderDataTable(
      checkboxtable2,
      server = FALSE, escape = FALSE, selection = 'none',
      rownames = FALSE,
      options = list(
        dom = 't', paging = FALSE, ordering = FALSE,autoWidth = TRUE,
        columnDefs = list(list(targets= 0, width= '30%')),
        preDrawCallback = JS('function() { 
        Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { 
        Shiny.bindAll(this.api().table().node()); } '))
    )

我还尝试使用here 建议的新语法 aoColumnDefs()。我也无法工作。如何显式减小第一列的宽度？

ShinyApp

## miniversion of survey
if(!require(shiny))install.packages("shiny");require(shiny)
if(!require(shinyjs)) install.packages("shinyjs"); require(shiny)
if(!require(htmlwidgets)) install.packages("htmlwidgets"); require(htmlwidgets)
if(!require(shinyWidgets)) install.packages("shinyWidgets"); require(shinyWidgets)
if(!require(DT)) install.packages("DT"); require(DT)


answer_options = c("riding", "climbing", "travelling", "binge watching series", "swimming", "reading")

# https://stackoverflow.com/questions/37875078/shiny-checkbox-in-table-in-shiny/37875435#37875435
shinyInput <- function(FUN, ids, ...) {
  inputs <- NULL
  inputs <- sapply(ids, function(x) {
    inputs[x] <- as.character(FUN(inputId = x, label = NULL, ...))
  })
  inputs
}

# 
shinyApp(
  ui = fluidPage( ####
    useShinyjs(),# For Shinyjs functions
    tags$script("
                Shiny.addCustomMessageHandler('resetValue', function(variableName) {
                Shiny.onInputChange(variableName, null);
                });
                "),

    tags$style('{background-color: #256986;}'),

    div(class="content",
        # progressbar showing the progress of the survey, currently moves ahead per page in steps of 
        # 12.5 (excluding intro and thank you page)

        progressBar(id= "pbar", value= 0, size= "xs"),

        # main utput/ modified userinterface for each page
        uiOutput("MainAction")
        )
    ),



  server =function(input, output, session) { ####
    output$MainAction <- renderUI({
      PageLayouts()
    })

    CurrentPage <- reactiveValues(page= "page1",
                                  selected= 0)
    PageLayouts<- reactive({


      if(CurrentPage$page == "page1"){
        return(
          list(
            textInput(inputId = "username", label= "Please enter your username"),

            # button displayed to continue
            div(class= "next button",actionButton(inputId = "p1_next", #input ID refers to following page
                                                  label= "Continue"))
          ))
      }


      if(CurrentPage$page == "page2"){
        checkboxtable2 <- data.frame(
          "answer options" = shinyInput(checkboxInput, answer_options),
          "What are your hobbies?" = answer_options,
          check.names = FALSE
        )

        output$table_p2 <- DT::renderDataTable(
          checkboxtable2,
          server = FALSE, escape = FALSE, selection = 'none',
          rownames = FALSE,
          options = list(
            dom = 't', paging = FALSE, ordering = FALSE,
            columnDefs = list(list(targets= 0, width= '30px')),
            preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
            drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
        )

        return(
          list(
            # create datatable with checkboxes
            p("What are your hobbies?"),
            # create datatable with checkboxes
            # surpresses header without removing checkboxes
            tags$head(tags$style(type = "text/css", "#table_p2 th {display:none;}")),
            DT::dataTableOutput('table_p2'),

            updateProgressBar(session= session, id= "pbar", value = 12.5),
            tags$style(".progress-bar {background-color: #25c484;}")
          ))

      }
    })

      observeEvent(input$p1_next, {CurrentPage$page <- "page2"})
      })

如果您想知道数据表的构造，请发表评论：我创建这些表的过程是首先从两个向量（其中一个包括复选框）中创建数据帧，转换将它们放入带有 renderDataTable 的 DataTables 中，然后通过在列表中覆盖其 CSS 来返回不带标题的表。我必须遵循这个过程，因为所有其他返回没有标题行的复选框表的方法都会导致一个没有复选框的数据表。因此，必须拆分代码，因为我无法在列表中创建带有复选框的向量。

Answer 1

当涉及到列宽时，DataTables 不是很好。 here 说，宽度永远不会从给定的定义中得到字面意思，而是总是适应表格大小而不是什么。这就是为什么你的努力是徒劳的。

但是您仍然可以根据自己的需要来塑造事物。起初，使用checkboxInput 在复选框周围创建一个默认宽度为 300 像素的容器，这是列如此之大的主要原因。您可以在第一步取消设置此宽度以查看该列的“自然”大小。

如果您想进一步减小大小，列宽的 css 规则可以正常工作。对于那个和上面的部分，我们为第一列单元格配备了一个特定的类名。

编织

columnDefs = list(list(targets = 0, className = "small" ))

到您的 DataTable 定义中，然后添加

td.small .shiny-input-container{width:auto;}

到您的 css 以取消设置此列中的预定义宽度。

可以通过css规则进一步缩小

td.small{width:30px;}