当selectInput(multiple = T) - 有光泽时,dataTableOutput中显示的列名不正确

Question

我想显示一个表,显示重复计数以及用户定义的列.我在闪亮的应用程序中有selectinput选项,用户可以通过该选项选择多个列来检查重复的组合.

但是,当用户选择第一列时,将显示不正确的列名称.选择两列时,列名称是正确的.

请帮我找到解决这个问题的方法.当用户选择第一列时,应显示正确的列.

码,

library(shiny)
library(shinydashboard)

ui <- dashboardPage(skin = "black",
                    dashboardHeader(title = "test"),
                    dashboardSidebar(
                      sidebarMenu(
                        menuItem("Complete", tabName = "comp"))),
                  dashboardBody(useShinyjs(),
                    tabItems(
                    tabItem(tabName = "comp",
                      fluidRow(
                      box(selectInput("dup_var", "Variable", multiple = TRUE, c("1"="1","2"="2")), 
                          width = 3, status = "primary")),
                      fluidRow(
                      box(title = "Duplicate Records", width = 12, solidHeader = TRUE, status = "primary", 
                      collapsible = TRUE, DT::dataTableOutput("dup_data")))))))

server <- function(input, output, session) {
  observe({
    cname <- c("Select All", names(mtcars))
    col_options <- list()
    col_options[ cname] <- cname

    updateSelectInput(session, "dup_var",
                      label = "",
                      choices = c("Choose Attributes"="",col_options))   
  })

  output$dup_data <- DT::renderDT({ 
    if (input$dup_var == "Select All"){
      col_names = colnames(mtcars)
      df = count(mtcars, col_names)
      df = df[df$freq > 1,]
      Dup <- df$freq
      df1 <- cbind.data.frame(Dup, df[,!names(df) %in% "freq"])
      df1 <- df1[order(-df1$Dup),]
      names(df1)[names(df1) == 'Dup'] <- 'Duplicate Count'

      dp <- DT::datatable(df1, rownames = FALSE)
      return(dp)
    } else {
      col_names = colnames(mtcars[,c(input$dup_var)])
      df = count(mtcars[,c(input$dup_var)], col_names)
      df = df[df$freq > 1,]
      Dup <- df$freq
      df1 <- cbind.data.frame(Dup, df[,!names(df) %in% "freq"])
      df1 <- df1[order(-df1$Dup),]
      names(df1)[names(df1) == 'Dup'] <- 'Duplicate Count'

      dp <- DT::datatable(df1, rownames = FALSE)
      return(dp)
    }
  }) 
          }
shinyApp(ui, server)

提前致谢.

Answer 1

看来你错过了一些drop = FALSE。添加此功能，您可以像处理多列的情况一样处理一列的特殊情况：

else {
  col_names = colnames(mtcars[, c(input$dup_var), drop = FALSE])
  df = count(mtcars[, c(input$dup_var), drop = FALSE], col_names)
  df = df[df$freq > 1, ]
  Dup <- df$freq
  df1 <- cbind.data.frame(Dup, df[, !(names(df) %in% "freq"), drop = FALSE])
  df1 <- df1[order(-df1$Dup), ]
  names(df1)[names(df1) == 'Dup'] <- 'Duplicate Count'

请注意，我不确定你的功能count，但上面的内容对我来说似乎是合理的。