我正在开发一个简单的应用程序,使用R Shiny将数据库数据显示为数据表。
从数据库查询的数据可能会发生变化,因此我希望为所存在的数据量身定制过滤输入选项,因此,我使用renderUI在服务器中生成UI。问题是来自renderUI的输入没有触发renderDataTable,因此在操作按钮触发renderDataTable之前它是空的。我想这样做,以便renderDataTable的输入触发renderDataTable。
作为一个例子,这是一个小应用程序,按我的意愿工作,但它的过滤输入是静态的,所以我不能使用它:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput(
"fish_taste", "Please select fish taste:",
choices = c("good", "bad"),
selected = c("good", "bad"),
multiple = TRUE
),
actionButton("submit", "Submit")
),
mainPanel(
DT::dataTableOutput("dt")
))
)
server <- function(input, output) {
data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
cost = c("$", "$$$", "$$", "$"),
taste = c("bad", "good", "good", "bad"))
filtered_fish <- reactive({
data[ data$taste %in% input$fish_taste, ]
})
filtered_fish_click <- reactiveVal(
value = isolate(filtered_fish())
)
observeEvent(input$submit, {
filtered_fish_click( filtered_fish() )
})
output$dt <- DT::renderDataTable({
datatable(
filtered_fish_click(),
rownames = FALSE,
options = list(
pageLength = 100,
lengthChange = FALSE
)
)
})
}
以下是编辑使用renderUI生成过滤选项的相同应用程序,请注意在按下提交之前数据表是如何生成的:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("fish_taste"),
actionButton("submit", "Submit")
),
mainPanel(
DT::dataTableOutput("dt")
))
)
server <- function(input, output) {
data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
cost = c("$", "$$$", "$$", "$"),
taste = c("bad", "good", "good", "bad"))
output$fish_taste = renderUI({
fish_taste_choices <- sort(unique(data$taste), decreasing = TRUE)
fish_taste_choices_initial <- fish_taste_choices
selectInput(
"fish_taste", "Please select fish taste:",
choices = fish_taste_choices,
selected = fish_taste_choices_initial,
multiple = TRUE
)
})
filtered_fish <- reactive({
data[ data$taste %in% input$fish_taste, ]
})
filtered_fish_click <- reactiveVal(
value = isolate(filtered_fish())
)
observeEvent(input$submit, {
filtered_fish_click( filtered_fish() )
})
output$dt <- DT::renderDataTable({
datatable(
filtered_fish_click(),
rownames = FALSE,
options = list(
pageLength = 100,
lengthChange = FALSE
)
)
})
}
在提供动态过滤选项的同时,让第二个应用程序像第一个应用程序一样工作的最佳方法是什么?
答案 0 :(得分:1)
只需按filtered_fish_click
data
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
uiOutput("fish_taste"),
actionButton("submit", "Submit")
),
mainPanel(
DT::dataTableOutput("dt")
))
)
server <- function(input, output) {
data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
cost = c("$", "$$$", "$$", "$"),
taste = c("bad", "good", "good", "bad"))
output$fish_taste = renderUI({
fish_taste_choices <- sort(unique(data$taste), decreasing = TRUE)
fish_taste_choices_initial <- fish_taste_choices
selectInput(
"fish_taste", "Please select fish taste:",
choices = fish_taste_choices,
selected = fish_taste_choices_initial,
multiple = TRUE
)
})
filtered_fish <- reactive({
data[ data$taste %in% input$fish_taste, ]
})
filtered_fish_click <- reactiveVal(
value = isolate(data)
)
observeEvent(input$submit, {
filtered_fish_click( filtered_fish() )
})
output$dt <- DT::renderDataTable({
DT::datatable(
filtered_fish_click(),
rownames = FALSE,
options = list(
pageLength = 100,
lengthChange = FALSE
)
)
})
}
shinyApp(ui, server)