Я хочу создать динамическое выпадающее меню для моей Shiny Dashboard, используя R?

0

У меня есть база данных 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 я хочу получить выбор динамически в зависимости от столбцов таблицы. Как я могу это сделать.

  • 0
    Используйте реактивную функцию, чтобы поместить туда значения столбцов, верните список значений с помощью return(x) затем создайте функцию наблюдения и используйте updateselectinput, поставьте вашу реактивную () в аргумент выбора, и вы получите то, что вы хотите.
Теги:
shiny

1 ответ

0

Я думаю, вам следует создать уникальный список таких значений:

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

Затем вы можете использовать его для выбора:

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

Для динамического dropdownMenu вы можете использовать это руководство, где основная идея заключается в том, что в части пользовательского интерфейса вы создаете именно это:

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
    )
  })

Ещё вопросы

Сообщество Overcoder
Наверх
Меню