R 选择不显示选项的输入，并在shinyApp中将值重置为“全部”
我正在mtcars数据上建立一个shinyApp。我在选择输入按钮时遇到问题。当我点击左边的disp按钮时，我没有选择。我只得到全部。 类似地，当我在carb过滤器中放入一些值，然后从vs过滤器中选择另一个值时，carb和disp立即重置为不应该发生的“All”。如果之前在carb和disp中选择的值存在于vs selected value中，则应保留它们。 谁能看看我的密码吗。我将不胜感激R 选择不显示选项的输入，并在shinyApp中将值重置为“全部”,r,input,shiny,shinydashboard,dt,R,Input,Shiny,Shinydashboard,Dt,我正在mtcars数据上建立一个shinyApp。我在选择输入按钮时遇到问题。当我点击左边的disp按钮时，我没有选择。我只得到全部。 类似地，当我在carb过滤器中放入一些值，然后从vs过滤器中选择另一个值时，carb和disp立即重置为不应该发生的“All”。如果之前在carb和disp中选择的值存在于vs selected value中，则应保留它们。 谁能看看我的密码吗。我将不胜感激 library(readr) library(shiny) library(DT)
library(readr)
library(shiny)
library(DT)
library(dplyr)
library(shinythemes)
library(htmlwidgets)
library(shinyWidgets)
library(shinydashboard)
data_table<-mtcars
#ui
ui = fluidPage(
sidebarLayout(
sidebarPanel (
uiOutput("vs_selector"),
uiOutput("carb_selector"),
uiOutput("disp_selector")),
mainPanel(
DT::dataTableOutput('mytable') )))
#server
server = function(input, output, session) {
output$vs_selector <- renderUI({
selectInput(inputId = "vs",
label = "vs:", multiple = TRUE,
choices = c( unique(data_table$vs)),
selected = c(0,1))
})
output$carb_selector <- renderUI({
available0 <- data_table[c(data_table$vs %in% input$vs ), "carb"]
selectInput(
inputId = "carb",
label = "carb:",
multiple = TRUE,
choices = c('All',as.character(unique(available0))),
selected = 'All')
})
output$disp_selector <- renderUI({
available <- data_table[c(data_table$carb %in% input$carb &
data_table$vs %in% input$vs), "disp"]
selectInput(
inputId = "disp",
label = "disp:",
multiple = TRUE,
choices = c('All',as.character(unique(available))),
selected = 'All')
})
thedata <- reactive({
data_table<-data_table[data_table$vs %in% input$vs,]
if(input$carb != 'All'){
data_table<-data_table[data_table$carb %in% input$carb,]
}
if(input$disp != 'All'){
data_table<-data_table[data_table$disp %in% input$disp,]
}
data_table
})
output$mytable = DT::renderDataTable({
DT::datatable( {
thedata() # Call reactive thedata()
})
})}
shinyApp(ui = ui, server = server)
我对你的代码做了几处修改。特别是，我添加了一些req see？req，并在输出$disp_选择器中修改了available：
这里的问题是selectInput中的选定参数。例如，在carb中，vs选择器中每次更改的disp选择器都会将其余选择器重置为All，因为这些选择器中的选项列表依赖于从vs选择器中选择的值。在vs选择器中，提及selected=c'1'，'2'没有意义，原因有二。首先，c uniqueas.characterdata_table$vs将为您提供0，1，因此您不能将其设置为1，2。第二，唯一的值不是字符串/字符数据类型，要使用QuotesHanks很多，我做了这些更改并更新了代码。但我还是有同样的问题。你能不能看得过火，你想要一步一步的过滤-像第一对然后碳水化合物，然后disp？此外，disp是一个数值，为什么要为其设置下拉列表？是的，我需要一个逐步筛选。它只是一个虚拟数据，我的原始数据有不同的变量，这就是为什么我把disp放在这里。如果你想了解更多，你可以用其他变量代替disp。我真的很感谢你的努力。你是个天才。干杯：还有一件事，NA有时会出现在disp筛选器中。有没有可能除掉NA
available <- data_table[["disp"]][data_table$vs %in% input$vs]
if(! "All" %in% input$carb){
available <- available[data_table$carb %in% input$carb]
}
data_table<-mtcars
#ui
ui = fluidPage(
sidebarLayout(
sidebarPanel (
uiOutput("vs_selector"),
uiOutput("carb_selector"),
uiOutput("disp_selector")),
mainPanel(
DT::dataTableOutput('mytable')
)
))
#server
server = function(input, output, session) {
output$vs_selector <- renderUI({
selectInput(inputId = "vs",
label = "vs:", multiple = TRUE,
choices = c( unique(data_table$vs)),
selected = c(0,1))
})
output$carb_selector <- renderUI({
req(input$vs)
available0 <- data_table[c(data_table$vs %in% input$vs ), "carb"]
selectInput(
inputId = "carb",
label = "carb:",
multiple = TRUE,
choices = c('All',as.character(unique(available0))),
selected = 'All')
})
output$disp_selector <- renderUI({
req(input$vs, input$carb)
available <- data_table[["disp"]][data_table$vs %in% input$vs]
if(! "All" %in% input$carb){
available <- available[data_table$carb %in% input$carb]
}
selectInput(
inputId = "disp",
label = "disp:",
multiple = TRUE,
choices = c('All',as.character(unique(available))),
selected = 'All')
})
thedata <- reactive({
req(input$disp, input$vs, input$carb)
data_table<-data_table[data_table$vs %in% input$vs,]
if(! "All" %in% input$carb){
data_table<-data_table[data_table$carb %in% input$carb,]
}
if(! "All" %in% input$disp){
data_table<-data_table[data_table$disp %in% input$disp,]
}
data_table
})
output$mytable = DT::renderDataTable({
DT::datatable( {
thedata() # Call reactive thedata()
})
})
}
shinyApp(ui = ui, server = server)
library(shiny)
library(shinyWidgets)
ui <- fluidPage(
fluidRow(
column(
width = 10, offset = 1,
tags$h3("Filter data with selectize group"),
panel(
selectizeGroupUI(
id = "my-filters",
params = list(
disp = list(inputId = "disp", title = "disp:"),
carb = list(inputId = "carb", title = "carb:"),
vs = list(inputId = "vs", title = "vs:")
)
), status = "primary"
),
dataTableOutput(outputId = "table")
)
)
)
server <- function(input, output, session) {
res_mod <- callModule(
module = selectizeGroupServer,
id = "my-filters",
data = mtcars,
vars = c("disp", "carb", "vs")
)
output$table <- renderDataTable(res_mod())
}
shinyApp(ui, server)