logo标签列表

R闪亮的datatable过滤框太窄，无法看到文本。

rfilterdatatableshinydt
14
我正在建立一个R闪亮仪表板。当我使用DT软件包和renderdatatable()函数将我的数据放入一个表格中时，每个列的顶部都有筛选器，但搜索框太窄了，无法看到文本并选择选项。这是一张图片：enter image description here 有人知道如何增加宽度吗？以下是我的服务器.r文件中的datatable代码：
  output$table <- DT::renderDataTable(DT::datatable({    
    data <- rv$data
    if (input$sour != "All") {
      data <- data[data[,1] == input$sour,]
    }else{data}
    if (input$sour1 != "All") {
      data <-data[data[,2] == input$sour1,]
    }else{data}
    if (input$tran != "All") {
      data <-data[data[,3] == input$tran,]
    }else{data}
  },filter='top'))

这是ui.r文件中的代码：

 tabItem(tabName = "ResultsTable",
              fluidPage(  
                headerPanel(
                  h1("List", align="center",  style = "font-family: 'Verdana';font-weight: 800; line-height: 1.1;   color: #151515;")),
                # fluidRow(
                #     column(8, DT::dataTableOutput("table",width = "100%"),offset = 2)))),
                #                 # Create a new Row in the UI for selectInputs
                fluidRow(

                  column(4,
                         selectInput("sour",
                                     "Name:",
                                     c("All",
                                       unique(as.character(df[,1]))))
                  ),
                  column(4,
                         selectInput("sour1",
                                     "Number:",
                                     c("All",
                                       unique(as.character(df[,2]))))
                  ),
                  column(4,
                         selectInput("tran",
                                     "Code:",
                                     c("All",
                                       unique(as.character(df[,3])))))),
                # Create a new row for the table.
                fluidRow(column(11, DT::dataTableOutput("table",width = "95%")))))

我尝试过这个方法，但它没有生效：

 output$table <- DT::renderDataTable(DT::datatable({    
    data <- rv$data
    if (input$sour != "All") {
      data <- data[data[,1] == input$sour,]
    }else{data}
    if (input$sour1 != "All") {
      data <-data[data[,2] == input$sour1,]
    }else{data}
    if (input$tran != "All") {
      data <-data[data[,3] == input$tran,]
    }else{data}
  },filter='top',options = list(
    autoWidth = TRUE,
    columnDefs = list(list(width = '200px', targets = "_all"))
  )))
1
一种简单的方法是将“日期列表”列重命名为一个没有空格的长字符串，例如“DateList”或“Date_List”。Shiny应用程序将至少扩展到该字符串的宽度。 - Sergei
4个回答
7
我使用CSS解决了这个问题：
input {
    width: 100px !important;
}

您还可以将此样式仅应用于因子过滤器：

td[data-type="factor"] input {
    width: 100px !important;
}

将 my.css 文件放入 www 子目录中，并链接到它：
shinyApp(
    ui = fluidPage(
        tags$head(
            tags$link(
                rel = "stylesheet",
                type = "text/css",
                href = "my.css")
        ),

        DT::dataTableOutput(...)
    )
1
这确实使选择框足够大，但似乎会导致过滤器与列名混淆的问题。 - Marijn Stevering
4
不幸的是，我确实尝试过了，但没有任何影响。我试图扩展的不一定是列宽，而是下拉筛选框的宽度。 - Tracy
0
我之前遇到过类似的问题，并通过一些 JavaScript 解决了它，具体是通过 headerCallback 来定位 selectize-dropdown-content。
headerCallback <- c("function(thead, data, start, end, display){",
                      "  var td = $('td');",
                      "  var factor_td = td.filter(function (d) {
                          return($(this)[0].attributes[0].value == 'factor');
                         })",
                      "  factor_td.each(function(d){
                          var factor_dropdown = factor_td[d].childNodes[3].childNodes[2].childNodes[1];
                          var new_dropdown = factor_dropdown.childNodes[0];
                          factor_dropdown.setAttribute('style','background-color:transparent; border:transparent; box-shadow:none')
                          new_dropdown.setAttribute('style','width:fit-content; background-color:white; border:1px solid rgba(0, 0, 0, 0.15); border-radius:4px; box-shadow:0 6px 12px rgba(0, 0, 0, 0.175); max-height:100px');
                         });")

这个功能通过筛选所有数据类型为factor的输入，然后对每个输入选择selectize-dropdown-content并添加一些CSS来实现。
要在datatable中使用它，只需将其添加到选项列表中即可。
library(shiny)
library(DT)
ui <- fluidPage(
  DTOutput("table")
)
server <- function(input,output,session){
      headerCallback <- c("function(thead, data, start, end, display){",
                      "  var td = $('td');",
                      "  var factor_td = td.filter(function (d) {
                          return($(this)[0].attributes[0].value == 'factor');
                         })",
                      "  factor_td.each(function(d){
                          var factor_dropdown = factor_td[d].childNodes[3].childNodes[2].childNodes[1];
                          var new_dropdown = factor_dropdown.childNodes[0];
                          factor_dropdown.setAttribute('style','background-color:transparent; border:transparent; box-shadow:none')
                          new_dropdown.setAttribute('style','width:fit-content; background-color:white; border:1px solid rgba(0, 0, 0, 0.15); border-radius:4px; box-shadow:0 6px 12px rgba(0, 0, 0, 0.175); max-height:100px');
                         });")
  data_use <- as.data.frame(datasets::USPersonalExpenditure)
  data_use$category <- as.factor(row.names(data_use))
  output$table <- renderDT({
    datatable(data = data_use,
              filter = "top",
              options = list(
                headerCallback = JS(headerCallback)
              )
    )
  })
}
shinyApp(ui,server)

注意：由于我还有其他下拉菜单不想改变，所以无法直接选择selectize-dropdown-content，因此我通过使用许多childNodes参数间接选择它。
-2
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接