Início / coding / Perguntas / 79309971
Accepted
mrroy
Asked: 2024-12-27 00:42:20 +0800 CST

Como implementar entradas interdependentes e uma tabela devidamente filtrada?

  • 772

Quero exibir uma tabela onde o usuário pode filtrar dinamicamente a tabela com base em uma ou mais colunas, com os diferentes filtros "respeitando" uns aos outros. Isso é semelhante a algumas outras perguntas (por exemplo, aqui , aqui e aqui ).

A exibição inicial deve ser a tabela completa. As colunas que podem ser usadas para filtragem são categóricas, e vários valores são permitidos para cada coluna. As escolhas nos menus suspensos devem refletir os valores disponíveis no momento, portanto, devem ser atualizadas com base nas seleções feitas em outros menus. Não há hierarquia pai/filho inerente às colunas/menus/filtros: o usuário deve ser capaz de começar a filtrar de qualquer menu. Finalmente, se nada foi selecionado em um menu específico, esse filtro deve ser desconsiderado (em vez de filtrar tudo).

No final das contas, isso também precisa ser dimensionado para ~10 filtros, então tentando evitar soluções muito detalhadas. Com base em tudo isso e perguntas/respostas relacionadas, cheguei ao seguinte. Bits individuais parecem funcionar durante o teste, mas não quando colocados juntos:

library(shiny)

ui = fluidPage(
  fluidRow(selectizeInput("cyl_select", "Select cylinder:","",multiple = TRUE), #using `selectizeInput` because real data requires adjusting the `maxOptions` setting
           selectizeInput("gear_select","Select gear:", "",multiple = TRUE),
           selectizeInput("carb_select","Select carburator:", "",multiple = TRUE)),
  fluidRow(DTOutput("filtered_table")))

server <- function(input, output, session) {
  
  df_mtcars = reactive({mtcars})
  
  #filter based on user input
  df_mtcars_filt = reactive({df_mtcars() %>%
      {if (!is.null(input$cyl_select)) filter(.,cyl %in% input$cyl_select) else . } %>% #piped if/else: only filter if input$[selection_var] contains meaningful values, otherwise pass data unaltered
      {if (!is.null(input$gear_select)) filter(.,gear %in% input$gear_select) else . } %>%
      {if (!is.null(input$carb_select)) filter(.,carb %in% input$carb_select) else . }
    })
 
  #render
  output$filtered_table = renderDT( df_mtcars_filt())
  
  #update the choice list
  observe({updateSelectizeInput(session,"cyl_select",choices = sort(unique(df_mtcars_filt()$cyl)))})
  observe({updateSelectizeInput(session,"gear_select",choices = sort(unique(df_mtcars_filt()$gear)))})
  observe({updateSelectizeInput(session,"carb_select",choices = sort(unique(df_mtcars_filt()$carb)))})
                                 
}

# run the app
shinyApp(ui = ui,
         server = server, 
         options = list(launch.browser = TRUE))

1 respostas

  1. Best Answer

    Se você tem o requisito para uma solução que deve ser escalável para um número maior de entradas (aqui: colunas para filtrar o quadro de dados), então uma abordagem adequada poderia ser confiar em lapply. Abaixo, isso é, por exemplo, usado para gerar o selectizeInpute para gerar o observeEvent()nessas entradas.

    Além disso lapply, fiz alguns ajustes no código fornecido por você, por exemplo, um selectedargumento é fornecido dentro do updateSelectizeInput. Também é preciso ter cuidado para evitar dependências circulares entre o dataTablee as atualizações de entrada.

    library(shiny)
library(DT)

cols <- c("cyl", "gear", "carb")

ui = fluidPage(
  fluidRow(
    lapply(cols, function(col) { # generate the inputs
        selectizeInput(
          paste0(col, "_select"), 
          paste("Select", col, ":"), 
          sort(unique(mtcars[[col]])), 
          multiple = TRUE
        )
      }
    )
  ),
  fluidRow(
    DTOutput("filtered_table")
  )
)

server <- function(input, output, session) {
  
  df_mtcars <- reactive({mtcars})
  df_mtcars_filt <- reactiveVal(mtcars)
  
  output$filtered_table <- renderDT(df_mtcars_filt())
  
  # generate a number of observers, reacting to input changes
  lapply(cols, function(col) { # apply on all relevant columns
    observeEvent(input[[paste0(col, "_select")]], { # event if input changed
      # set data frame initially to the starting value
      df_mtcars_filt(df_mtcars()) 
      # filter data frame processing
      lapply(cols, function(curCol) {
        df_mtcars_filt(
          df_mtcars_filt()[
            df_mtcars_filt()[, curCol] %in% if (!is.null(input[[paste0(curCol, "_select")]])) 
              input[[paste0(curCol, "_select")]] else df_mtcars()[, curCol], 
          ]
        )
      })
      # input update processing
      lapply(cols[!cols %in% col], function(colToUpdate) {
        updateSelectizeInput(
          session,
          paste0(colToUpdate, "_select"),
          choices = sort(unique(df_mtcars_filt()[[colToUpdate]])),
          selected = input[[paste0(colToUpdate, "_select")]]
        )        
      })
    }, ignoreNULL = FALSE)
  })
}

shinyApp(ui = ui, server = server)
    • 1

relate perguntas