Dúvida Filtro Update Shiny

dúvidas
1

Boa tarde!

Estou com uma dúvida sobre um filtro do shiny.

Quero fazer dois filtros hierárquicos, porém com múltiplas escolhas. Não estou conseguindo fazê-lo, pois está dando erro. Conseguem me ajudar? Vou anotar o código abaixo:

ui <- dashboardPage(
  dashboardHeader(title = "Dash"),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(
               #filtro Area
                box(
                    width = 3, 
                    height = 80,
                    pickerInput(
                                inputId = "selec_area", 
                                label = "Selecione a Área",
                                choices = "",
                                selected = "",
                                multiple = TRUE)),
                # filtro Lider
                box(
                  width = 3, 
                  height = 80,
                  pickerInput(
                              inputId = "selec_lider", 
                              label = "Selecione o Líder",
                              choices = ""))
)






#### server ####
server <- function(input, output, session) {
#### output area ####
  output$selec_area <- renderUI({
    areas <- df$Area %>%
     unique() %>% 
      sort()
 
    pickerInput(
      inputId = "selec_area",
      label = "Selecione a area",
      choices = areas,
      selected = areas,
      multiple = TRUE

    )
})

  observe({
    
    areas <- df$Area %>% 
      unique() %>% 
        sort()
    
    updatePickerInput(
      session,
      inputId = "selec_area",
      choices = areas
    )
  })
  
#### update lider ####  
  observe({
    
    lideres <- df %>% 
      filter(Area == input$selec_area) %>% 
        pull(Gestor_Imediato)
    
    updatePickerInput(
      session,
      inputId = "selec_lider",
      choices = lideres
    )
  })

}

Agradeço desde já!

1 curtida
2

Oi, Rodrigo, como vai?

Você conseguiria disponibilizar um exemplo reprodutível para eu rodar aqui na minha máquina (com a base mtcars, por exemplo)? Eu não tenho acesso ao objeto df do código que você enviou. :frowning:

Um abraço,

1 curtida
3

Boa noite Willian, tudo bem?

Desculpa ter mandado o código acima sem as boas práticas do portal rsrsrs Erro meu!

Desculpe também mandar o código enorme aqui. Fiz um exemplo com mtcars, como pediu.

O meu dilema é conseguir usar esta funcão pra filtro pickerInput(), do pacote shinyWidgets, e também conseguir fazer um filtro hierárquico com múltiplas escolhas. Abaixo segue a forma como não estou conseguindo rodar, mas este exemplo roda retirando os argumentos multiple() e opt() da funcão pickerInput(). No mais, agradeco muito sua atencão em me ajudar!!

library(shinydashboard)
library(shiny)
library(shinyWidgets)

opt1 <- pickerOptions(actionsBox = TRUE, size = 10, selectAllText = "Todos", 
                      deselectAllText = "Nenhum", dropdownAlignRight = "auto", 
                      width = 'css-width', noneSelectedText = "Nenhum",
                      selectedTextFormat = "count")
opt2 <- pickerOptions(actionsBox = TRUE, size = 10, selectAllText = "Todos",
                      deselectAllText = "Nenhum", dropdownAlignRight = "auto", 
                      width = 'css-width', liveSearch = TRUE, noneSelectedText = "Nenhum",
                      selectedTextFormat = "count")

df <- mtcars

ui <- dashboardPage(
  
  dashboardHeader(title = "Dash Exemplo"),
  
  dashboardSidebar(
    sidebarMenu(
      menuItem(
        "Página de Teste", tabName = "teste", icon = icon("chart-bar")))),
  dashboardBody(
    tabItem(tabName = "teste",
            #### Filtros ####
            fluidRow(
              # Filtro 1
              box(
                width = 3, height = 80,
                pickerInput(inputId = "select_cyl", 
                            label = "Selecione Cyl",
                            choices = "",
                          ### o app roda sem esse argumento abaixo
                            multiple = TRUE,
                            options = opt2)),
              # Filtro 2
              box(
                width = 3, height = 80,
                pickerInput(inputId = "select_gear", 
                            label = "Selecione Gear",
                            choices = "")
            )
  )
)
)
)
# server.R

server <- function(input, output, session) {
  output$select_cyl <- renderUI({
    cyls <- df$cyl %>%
      unique() %>% 
      sort()
    
    pickerInput(
      inputId = "select_cyl",
      label = "Selecione Cyl",
      choices = cyls,
### o app roda sem esse argumento abaixo
      multiple = TRUE,
      options = opt2
      
    )
  })
  
  observe({
    
    cyls <- df$cyl %>% 
      unique() %>% 
      sort()
    
    updatePickerInput(
      session,
      inputId = "select_cyl",
      choices = cyls
    )
  })
  
  
  observe({
    
    gears <- df %>% 
      filter(cyl == input$select_cyl) %>% 
      pull(gear)
    
    updatePickerInput(
      session,
      inputId = "select_gear",
      choices = gears
    )
  })  
}

shinyApp(ui, server)

Muito obrigado desde já!

Abracos!!

1 curtida
4

Oi, Rodrigo. Sem problemas!
Obrigado por enviar o exemplo com o mtcars.

Se entendi bem, o seu código tem dois problemas:

No server, você não precisa “recriar” o pickerInput, pois ele já está sendo criado na UI. Além do mais, não existe um output$select_cyl mapeado na UI. Sendo assim, você pode retirar as linhas de código abaixo:

  output$select_cyl <- renderUI({
    cyls <- df$cyl %>%
      unique() %>% 
      sort()
    
    pickerInput(
      inputId = "select_cyl",
      label = "Selecione Cyl",
      choices = cyls,
### o app roda sem esse argumento abaixo
      multiple = TRUE,
      options = opt2
      
    )
  })

Como o segundo filtro depende do primeiro e você permite a seleção vazia em ambos, você precisa testar se o primeiro filtro possui valores válidos antes de criar as escolhas para o segundo. Eu criei um if dentro do segundo observe para resolver isso.

if (isTruthy(input$select_cyl)) {
  gears <- df %>% 
    filter(cyl %in% input$select_cyl) %>% 
    pull(gear) %>%
    unique() %>% 
    sort()
} else {
  gears <- ""
}

Repare que como a seleção pode ser múltipla, eu usei o %in% em vez do ==.

Por fim, tomei a liberdade de construir um exemplo minimal, sem o paote shinydashboard. O código inteiro fica:

library(shiny)
library(shinyWidgets)
library(dplyr)

opt1 <- pickerOptions(actionsBox = TRUE, size = 10, selectAllText = "Todos", 
                      deselectAllText = "Nenhum", dropdownAlignRight = "auto", 
                      width = 'css-width', noneSelectedText = "Nenhum",
                      selectedTextFormat = "count")
opt2 <- pickerOptions(actionsBox = TRUE, size = 10, selectAllText = "Todos",
                      deselectAllText = "Nenhum", dropdownAlignRight = "auto", 
                      width = 'css-width', liveSearch = TRUE, noneSelectedText = "Nenhum",
                      selectedTextFormat = "count")

df <- mtcars

ui <- fluidPage(
  pickerInput(
    inputId = "select_cyl", 
    label = "Selecione Cyl",
    choices = "",
    multiple = TRUE,
    options = opt2
  ),
  pickerInput(
    inputId = "select_gear", 
    label = "Selecione Gear",
    choices = ""
  )
)

server <- function(input, output, session) {
  
  observe({
    cyls <- df$cyl %>% 
      unique() %>% 
      sort()
    updatePickerInput(
      session,
      inputId = "select_cyl",
      choices = cyls
    )
  })
  
  observe({
    if (isTruthy(input$select_cyl)) {
      gears <- df %>% 
        filter(cyl %in% input$select_cyl) %>% 
        pull(gear) %>% 
        unique() %>% 
        sort()
    } else {
      gears <- ""
    }
    updatePickerInput(
      session,
      inputId = "select_gear",
      choices = gears
    )
  })  
}

shinyApp(ui, server)
2 curtidas
5

Willian, muito obrigado mesmo!! Pela atencão e por resolver meu problema! Agradeco demais!

Grande abraco!!

1 curtida