我正在开发一个闪亮的应用程序，其中选择输入的选择应该基于先前的输入动态更新。
例如，如果在第一个输入窗口小部件中选择了类别和段，而在第二个输入窗口小部件中仅选择了skin_care，则选择Medicated和Non medicated 应该作为第三个输入小部件中的选项而不是所有段的唯一名称。 如果在第二个输入小部件中选择了hair_care而不是skin_care，那么Gents和Ladies应该是第三个输入小部件下拉列表中的选择。 所以基本上从下拉列表中选择的选择取决于在早期输入窗口小部件上选择的用户。品牌也是如此。 在这里，我假设维度的seletcion总是从左到右。
实际应用程序会要求用户加载数据，它可能有10个维度或者可能更多。为简单起见我保留了3个维度。
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
tabsetPanel(
tabPanel("Data", fluid = TRUE,
sidebarLayout(
sidebarPanel(p("Please remove None first"),
uiOutput("dim"),
uiOutput("levels1")),
mainPanel(
DT::dataTableOutput("data_display")
))))))
server <- shinyServer(function(input,output){
# creating Data
data <- reactive({
data <- data.frame(Date = as.Date(c("2018-05-25","2018-05-26")),
category = c(rep("skin_care",6),rep("hair_care",6)),
Segment = c(rep("Medicated",4),rep("Non_Medicated",2),
rep("Ladies",4),rep("Gents",2)),
Brand = c("X","X","Y","Y","Z","Z","A","A","B","B","C","C"),
sales = round(rnorm(12,100,3)))
})
# Displaying Data
output$data_display <- DT::renderDataTable(
datatable(data(),options = list(pageLength = 12),rownames = FALSE)
)
# selects dimension (Only character variable to be selected)
output$dim<-renderUI({
b<-colnames(data()[sapply(data(),class)=="character"])
selectInput("x","Select only character variable",choices =
c("NONE",b[1:length(b)]),selected="NONE",multiple = TRUE)
})
# user selects levels of dimension
output$levels1<-renderUI({
if(is.null(input$x)){
return(NULL)
}
else if(sum(input$x=="NONE")==1){
return(NULL)
}
else{
lapply(seq(input$x),function(i){
selectInput(inputId = paste0("range",i),
paste0("Select level of ",input$x[i]),
choices = c(unique(data()[,input$x[i]]),"ALL"),multiple = TRUE)
})
}
})
})
shinyApp(ui,server)
编辑：在动态显示的selectinput小部件的下拉列表中提供了选项
答案 0 :(得分：0)
我玩了你提供的代码。这个答案似乎不完整，但我相信这是解决问题的最佳方法。让我们来看看：
uiOutput - 名为level3的包装器（如果在第一个下拉列表中选择了多个输入，则只返回一个下拉列表）renderUI
DT - 表移到了服务器部分的末尾levels1 - 对象中添加了一整套if-else条件（太复杂，不能解释，只是试试看）但是，我不知道如何在我的答案中保持我的代码通用。我的意思是，如果您有多个列，则可能更容易为每个列创建一个下拉列表。对我来说似乎更容易。
主要问题是您无法猜测用户将在第一个下拉列表中首先选择哪个元素。因此，您需要经历所有可能的组合。如果你有两个以上的变量，哪个是坚果。无论如何，因为你知道数据 如果额外的编程工作值得花时间，你比我更清楚。如果您不相信我，请使用我的代码，尝试推广代码，使用ie，五个字符列，然后在下面评论您学到的内容。
最后但并非最不重要的是，我经常使用grep对数据进行子集化。如果将其与paste和collapse='|'结合使用，则会匹配角色向量的每个场合。
这是应用程序：
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
tabsetPanel(
tabPanel("Data", fluid = TRUE,
sidebarLayout(
sidebarPanel(uiOutput("dim"),
uiOutput("levels1"),
uiOutput("level3")),
mainPanel(
DT::dataTableOutput("data_display")
))))))
server <- shinyServer(function(input,output){
# creating Data
data <- reactive({
data <- data.frame(Date = as.Date(c("2018-05-25","2018-05-26")),
category = c(rep("skin_care",6),rep("hair_care",6)),
Brand = c("X","X","Y","Y","Z","Z","A","A","B","B","C","C"),
sales = round(rnorm(12,100,3)),stringsAsFactors = FALSE)
})
# selects dimension (Only character variable to be selected)
output$dim<-renderUI({
b<-colnames(data()[sapply(data(),class)=="character"])
selectInput("x","Select only character variable",
choices = b[1:length(b)],multiple = TRUE)
})
# user selects levels of dimension
output$levels1<-renderUI({
if(is.null(input$x)){
return(NULL)
}
else if(sum(input$x=="NONE")==1){
return(NULL)
}
else{
mydata<-data()
if(length(input$x)==2){
selectInput(inputId = 'range1',
paste0("Select level of ",'category'),
choices = unique(as.character(mydata$category)),
selected = "",multiple = TRUE)
} else {
lapply(seq(input$x),function(i){
mychoice<-unique(as.character(mydata[,input$x[i]]))
selectInput(inputId = paste0("range",i),
paste0("Select level of ",input$x[i]),
choices = mychoice,selected = "",multiple = TRUE)
})
}
}
})
output$level3<-renderUI({
if(is.null(input$range1) | length(input$x)<2){
return(NULL)
} else {
mydata<-data()
myrows<-grepl(paste0(input$range1,collapse = '|'),mydata$category)
mychoices<-unique(as.character(mydata$Brand[myrows]))
selectInput(inputId = 'range2',
paste0("Select level of ",'category'),
choices = mychoices,
selected = mychoices,multiple = TRUE)
}
})
# Displaying Data
output$data_display <- DT::renderDataTable({
if(is.null(input$x)){ #show full data when nothing is selected in first dropdown
mydata<-data()
}
if(is.null(input$range1)){ # show full data when nothing is selected in second drop down
mydata<-data()
} else { # something is selected in second dropdown
if(length(input$x)>1){ # First dropdown contains two elements
mydata<-data()
if(!is.null(input$range2)){
mydata=mydata[grep(paste0(input$range2,collapse='|'),as.character(mydata$Brand)),]
}
} else { # First dropdown contains one element
mydata<-data()
if(input$x=='Brand'){
mydata=mydata[grep(paste0(input$range1,collapse='|'),as.character(mydata$Brand)),]
} else{
mydata=mydata[grep(paste0(input$range1,collapse='|'),as.character(mydata$category)),]
}
} # close: First dropdown has one element
} # close: something is selected in second dropdown
datatable(mydata,options = list(pageLength = 12),rownames = FALSE)
})
# observeEvent(input$x,
# updateSelectInput(inputId = paste0("range",i),
# paste0("Select level of ",input$x[i]),
# choices = unique(data()[,input$x])))
})
shinyApp(ui,server)