ShinyApp 中没有复选框答案

【问题标题】：No Checkbox in ShinyAppShinyApp 中没有复选框
【发布时间】：2021-01-13 21:55:11
【问题描述】：

我正在尝试显示一个 csv 文件并创建复选框以允许过滤。该应用程序运行时没有任何错误，但我在复选框所在的位置得到一个空白框。如何让复选框显示？

library(shiny)
library(DT)

df <- read.csv("new_and_deactivated_accounts.csv", header = TRUE)

ui <- fluidPage(

    # Application title
    titlePanel("GIS Workload"),

    sidebarLayout(
        sidebarPanel(
            conditionalPanel(
                'input.dataset === "df"',
                             checkboxGroupInput("checkbox", "Select something",
                                                names(df), selected = names(df))
            )
        ),

        mainPanel(
           tabsetPanel(
               id='df',
               tabPanel(DT::dataTableOutput("mytable1"))
        )
    )
)
)

server <- function(input, output) {

    output$mytable1 <- DT::renderDataTable({
        DT::datatable(df[, input$checkbox, drop = FALSE])
    })
}

# Run the application 
shinyApp(ui, server)

这是显示内容的一部分，复选框应该是空的，因为它是半私人的，我选择不显示数据，但包括标题。

【问题讨论】：

您的条件面板检查input$dataset=="df"。但是您的应用中没有input$dataset。
明白了，不过我需要删除 === "df" 才能让它工作

标签： r shiny

【解决方案1】：

它们在那里，只是在您使用条件面板并且条件不满足时被隐藏。

您可以删除此部分，或确保满足条件：

conditionalPanel('input.dataset === "df"',

这是您删除该行的完整代码，并使用 mtcars 代替您的数据：

library(shiny)
library(DT)

df <- mtcars

ui <- fluidPage(

    # Application title
    titlePanel("GIS Workload"),

    sidebarLayout(
        sidebarPanel(
            checkboxGroupInput("checkbox", "Select something",
            names(df), selected = names(df))

        ),

        mainPanel(
           tabsetPanel(
               id='df',
               tabPanel(DT::dataTableOutput("mytable1"))
        )
    )
)
)

server <- function(input, output) {

    output$mytable1 <- DT::renderDataTable({
        DT::datatable(df[, input$checkbox, drop = FALSE])
    })
}

# Run the application 
shinyApp(ui, server)

【讨论】：

【解决方案2】：

这里有一些通用的 Shiny 代码可以帮助你。

library(shiny)
library(DT)

mymtcars <- mtcars
mymtcars[["Select"]] <- paste0('<input type="checkbox" name="row_selected" value=',1:nrow(mymtcars),' checked>')
mymtcars[["_id"]] <- paste0("row_", seq(nrow(mymtcars)))

callback <- c(
  sprintf("table.on('click', 'td:nth-child(%d)', function(){", 
          which(names(mymtcars) == "Select")),
  "  var checkbox = $(this).children()[0];",
  "  var $row = $(this).closest('tr');",
  "  if(checkbox.checked){",
  "    $row.removeClass('excluded');",
  "  }else{",
  "    $row.addClass('excluded');",
  "  }",
  "  var excludedRows = [];",
  "  table.$('tr').each(function(i, row){",
  "    if($(this).hasClass('excluded')){",
  "      excludedRows.push(parseInt($(row).attr('id').split('_')[1]));",
  "    }",
  "  });",
  "  Shiny.setInputValue('excludedRows', excludedRows);",
  "});"
)

ui = fluidPage(
  verbatimTextOutput("excludedRows"),
  DTOutput('myDT')
)

server = function(input, output) {

  output$myDT <- renderDT({

    datatable(
      mymtcars, selection = "multiple",
      options = list(pageLength = 5,
                     lengthChange = FALSE,
                     rowId = JS(sprintf("function(data){return data[%d];}", 
                                        ncol(mymtcars)-1)),
                     columnDefs = list( # hide the '_id' column
                       list(visible = FALSE, targets = ncol(mymtcars)-1)
                     )
      ),
      rownames = FALSE,
      escape = FALSE,
      callback = JS(callback)
    )
  }, server = FALSE)

  output$excludedRows <- renderPrint({
    input[["excludedRows"]]
  })
}

shinyApp(ui,server, options = list(launch.browser = TRUE))

【讨论】：