代码之家 › 专栏 › 技术社区 › SJB

当selectinput(multiple=t)时,datatableoutput中显示的列名不正确-闪亮

shiny r

SJB · 技术社区 · 7 年前

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

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

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

代码,

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)

提前谢谢。

2 回复 | 直到 7 年前

RolandASc 7 年前

你好像错过了几个 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 ,但我觉得上面的说法似乎有道理。

strboul 7 年前

不需要将if-else语句放在输出中,因为按列对数据帧进行子集设置将为您提供此处所需的值。我不能完全复制你的代码,也许这能给你一个主意。

library(shiny)

choices <- c("Select All", names(mtcars))

ui <- fluidPage(
  selectInput("dup_var", "Variable", choices, multiple = TRUE),
  DT::dataTableOutput("dup_data")
)

server <- function(input, output, session) {

  observe({
    if ("Select All" %in% input$dup_var) {
      allchoices <- setdiff(choices, "Select All")
      updateSelectInput(session, "dup_var", selected = allchoices)
    }
  })

  output$dup_data <- DT::renderDataTable({
    data <- mtcars[input$dup_var]
    do.call(rbind, lapply(names(data), function(name) {
      x <- data[, name, drop = TRUE]
      aggregate(list(count = x), by = list(name = x), length)
    })) -> df

    df <- df[df$count > 1, ]
    data.frame(duplicate_count = df$count, x = df[,!names(df) %in% "count"],
               stringsAsFactors = FALSE)
  }, rownames = FALSE)
}

shinyApp(ui, server)