Я играл с кодом, который вы предоставили.Этот ответ может показаться неполным, но я считаю, что это лучший способ решить ваши вопросы.Давайте пройдемся по нему:
- В пользовательской части я добавил еще один
uiOutput -обёртку с именем level3 (который возвращает раскрывающийся список, только если в самом первом раскрывающемся списке выбрано более одного входа) - Впоследствии я добавил еще одну
renderUI в серверную часть - Я переместил
DT -таблицу в конец серверной части - Я добавил полный наборусловий if-else к
levels1 -объекту в серверной части (слишком сложно объяснить, просто попробуйте их) - Я также добавил полный набор условий if-else, чтобы проверить, является липользовательский интерфейс работает
Однако я не понимаю, как сохранить общий код в своем ответе.Я имею в виду, если у вас есть несколько столбцов, может быть проще сделать раскрывающийся список для каждого столбца.Кажется проще для меня
Основная проблема заключается в том, что вы не можете угадать , какой элемент пользователь выберет первым в первом раскрывающемся списке.Поэтому вам нужно будет пройти через все возможные комбинации.Который чокнутый, если у вас есть более двух переменных.В любом случае, потому что вы знаете данные, которые вы знаете лучше меня, если дополнительные усилия по программированию стоят времени.Если вы мне не верите, используйте мой код, попробуйте обобщить код, используйте пять столбцов, а затем прокомментируйте ниже то, что вы узнали.
Последнее, но не менее важное: я часто использовал 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)