Question

我有一个包含多个表的MySQL数据库。现在，我想在Shiny仪表板中创建一个下拉菜单，该菜单会根据表格中每列的唯一值自动添加值。

我目前的代码如下所示

ui <- fluidPage(
  numericInput("nrows", "Enter the number of rows to display:", 5),
  tableOutput("tbl")
)

server <- function(input, output, session) {
    output$tbl <- renderTable({
        conn <- dbConnect(
      drv = RMySQL::MySQL(),
      dbname = "apilogs",
      host = "localhost",
      username = "root",
      password = "root")
        on.exit(dbDisconnect(conn), add = TRUE)
        dbGetQuery(conn, paste0("SELECT * FROM logs where key = 'agc' LIMIT ", input$nrows, ";"))

    })
}

现在，对于我闪亮的仪表板，我想根据日志表的列值创建一个下拉菜单。

  dashboardSidebar(
        selectInput("Filter", "Filter:",
                  choices = c())
  )

现在choices我希望根据表格列动态选择。我怎么能这样做。

Answer 1

我认为，您应该创建这样的唯一值列表：

unique_values <- sort(unique(table_name$column_name))

然后你可以用它来做出选择：

selectInput("filter", "Filter:", choices = unique_values)

对于动态dropdownMenu，您可以使用此guide，其中主要想法是在您创建的UI部分上：

ui <- dashboardPage(
  dashboardHeader(title = "Dropdowns 2.0",
    dropdownMenuOutput("dropdownMenuDynamic")
  )
)

你还需要做这样的事情：

size <- length(output$filter)
tasks <- vector("list", size)
for(i in 1:length(tasks)) { 
  tasks[[i]] <- list(
    value = 10,
    color = "yellow",
    text = output$filter[[i]]
  ) 
}

最后一部分是创建dropdownMenuDynamicon服务器端：

output$dropdownMenuDynamic <- renderMenu({
    items <- lapply(tasks, function(el) {
      taskItem(value = el$value, color = el$color, text = el$text)
    })
    dropdownMenu(
      type = "tasks", badgeStatus = "danger",
      .list = items
    )
  })

我想使用R为我的Shiny Dashboard创建一个动态下拉菜单？

1 个答案: