Блог

Главная - Вопросы по программированию - Как обновить выбор ввода внутри renderIU?

Как обновить выбор ввода внутри renderIU?

#r #shiny

Вопрос:

Я показываю вам свое блестящее приложение, но у меня проблема, я не могу обновить selectimput, я использовал updateSelectInput, но он не работает. У меня есть два параметра выбора внутри панели tabsetPanel, так как мне нужно обновить таблицу двумя фильтрами, один из которых-категория, а другой-подкатегория. вот мой код.

 library(shiny)
library(tidyverse)
library(DT)


cat1<-rep("LINEA BLANCA", 75)
cat2<- rep("VIDEO", 75)
subcat1<-rep("LAVADORAS", 40)
subcat2<- rep("REFRIS", 35)
subcat3<- rep("TV", 40)
subcat4<- rep("SONIDO", 35)
vent<-sample(100:900, 150, replace=T)
segm1<-rep("AAA", 25)
segm2<-rep("BBB", 25)
segm3<-rep("CCC", 25)
segm4<-rep("ABB", 25)
segm5<-rep("ACC", 25)
segm6<-rep("BAC", 25)
db<- tibble(segment=c(segm1,segm2,segm3,segm4,segm5,
                      segm1),CATEGORIA=c(cat1,cat2), SUBCAT=c(subcat1,subcat2, subcat3, subcat4), vent=vent)


ui <- fluidPage(
  
  # App title
  titlePanel("EXAMPLE"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      
      # Output: Tabset w/ plot, summary, and table ----
      tabsetPanel(type = "tabs",
                  
                  tabPanel("Ana_inv", uiOutput("selectcat"), uiOutput("selectsubcat"),DT::dataTableOutput("ana_inv")),
                  #tabPanel("Summary", verbatimTextOutput("summary")),
                  tabPanel("Table", tableOutput("table"))
      )
      
    )
  )
)

server <- function(input, output, session) {
  output$selectcat <- renderUI({
    selectInput("Cat", "Seleccione Categoria", choices = c("ALL",as.vector(db$CATEGORIA)))
  })
  output$selectsubcat <- renderUI({
    #opciones<- db_prueba %>% filter(CATEGORIA==input$CAT)
    selectInput("Subcat", "Seleccione Subcategoria", choices = c("ALL",as.vector(db$SUBCAT)))
  })
  
  activar<- reactive({
    
    req(input$Cat)
    req(input$Subcat)

    opciones<- db %>% filter(CATEGORIA==input$Cat)
    if(input$Cat == "TODOS") {
      
      filt1 <- quote(CATEGORIA != "@?><")
      
      
    } else {
      
      filt1 <- quote(CATEGORIA == input$Cat) 
      
    }
    
    
    if (input$Subcat == "TODOS") {
      
      filt2 <- quote(SUBCAT != "@?><")
      
      
    } else {
      
      filt2 <- quote(SUBCAT == input$Subcat)
      
    }
    
    db %>%
      filter_(filt1) %>%
      filter_(filt2) %>% group_by(segment)%>%
      summarise(SKUs=n(), 
                vta=sum(vent))
    
  })
  # Return the formula text for printing as a caption ----
  output$ana_inv <- DT::renderDataTable({
    activar()
    
  })
  
}
shinyApp(ui = ui, server = server)

Поэтому мне нужно, чтобы, если категория «LINEA BLANCA» выбрана в подкатегории, она показывала только «РЕФРИС» и «ЛАВАДОРАС», но также, если кто-то выберет «ВСЕ» в категории, он также может выбрать каждую подкатегорию, то есть ее можно отфильтровать по подкатегории, предполагая, что я хочу видеть только подкатегории.

Я перепробовал много способов, но ни один не работает, есть идеи? вы можете запустить приложение в R, чтобы получить представление о том, чего я хочу.

Ответ №1:

Попробуй это

 server <- function(input, output, session) {
  output$selectcat <- renderUI({
    selectInput("Cat", "Seleccione Categoria", choices = c("ALL",as.vector(db$CATEGORIA)))
  })
  output$selectsubcat <- renderUI({
    req(input$Cat)
    if (input$Cat=="ALL"){ df <- db
    }else df <- db %>% filter(CATEGORIA %in% input$Cat)
    selectInput("Subcat", "Seleccione Subcategoria", choices = c("ALL",as.vector(df$SUBCAT)))
  })
  
  activar<- reactive({
    
    req(input$Cat,input$Subcat)
    
    if (input$Cat=="ALL"){ df <- db
    }else df <- db %>% filter(CATEGORIA %in% input$Cat)
    
    if (input$Subcat=="ALL"){ df <- df
    }else df <- df %>% filter(SUBCAT == input$Subcat)

    df %>%
      group_by(segment) %>%
      summarise(SKUs=n(), 
                vta=sum(vent))
    
  })
  # Return the formula text for printing as a caption ----
  output$ana_inv <- DT::renderDataTable({
    activar()
  })
  
}
Метки: