R闪亮的动态过滤

Question

New R shiny user here.. I have 6 filters for a datatable and want to be able to have dynamic filters working in any direction. For instance: I have filters A, B, C, D, E, F. If I filter at A or B or C etc, I want all the other filters dynamically update to show unique() of filtered datatable and so on if I move through the filters in any direction.

I tried a bunch of different techniques and they all didn't seem to work well. Eventually I bit the bullet and wrote the most verbose code to account for all possible combinations of filter directions. So for example:

First in ui.R I set up selectInput for filters A, B, C, D, E, F

Then in server.R I easily filter the table

tt <- reactive({
    dt <- mytable
    dt <- dt[,input$ColumnsToShow2,drop=FALSE]
if (input$A != "All") {
  dt <- dt[dt$A == input$A,]
}

if (input$B != "All") {
  dt <- dt[dt$B == input$B,]
}
if (input$C != "All") {
  dt <- dt[dt$C == input$C,]
}
if (input$D != "All") {
  dt <- dT[dt$D == input$D,]
}
if (input$E != "All") {
  dt <- dt[dt$E == input$E,]
}
if (input$F != "All") {
  dt <- dt[dt$F == input$F,]
}
    dt   
})

and then I go -

observe({
#One filter is used:

If A!="All" && B && C && D && E && F are all =="All", then UpdateSelectInput filters B,C,D,E,F

If B!="All" and A && C && D && E && F are all == "All", then 
UpdateSelectInput filters A,C,D,E,F 

If C and so on, you get the logic

#Two filters are used: 
If A!="All" && B!="All" && C && D && E && F are all == "All", then 
UpdateSelectInput filters C, D, E, F

if A!="All" && C!="All" && B && D && E && F are all == "All", then 
UpdateSelectInput filters B, D, E, F

#etc all the way through 

if E!="All" && F!="All" && A && B && C && D are all == "All", then
UpdateSelectInput filters A, B, C, D.

#three filters are used...all the way through 5 filters are used

)}

You get the point now. I'm pretty sure you can set up a similar example to work with.

NB: When I tried to only use just 6 if != "All" without the additional "&&" conditions for the boolean (like I did to filter the datatable itself), it did not work.

I have the filters working perfectly this way like I want them, but my gut feeling is that I'm working too hard at this.

Thanks for reading all this and for your help!!

Addendum - here's an example that I was expecting to work but doesn't:

data <- structure(list(Country.Name = structure(c(1L, 1L, 1L, 1L, 1L, 
                                                     1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L
), .Label = c("High income", "Low income", "Mid income"), class =             
"factor"), 
Country.Code = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
                       2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L,     
3L), .Label = c("HIC", 

"LIC", "MIC"), class = "factor"), Indicator.Name = structure(c(10L, 

9L, 11L, 8L, 6L, 4L, 7L, 5L, 3L, 2L, 18L, 19L, 1L, 17L, 16L, 

12L, 20L, 13L, 14L, 15L, 3L), .Label = c("2005 PPP conversion factor, 
GDP (LCU per international $)", 

"2005 PPP conversion factor, private consumption (LCU per international 
$)", 

"Adequacy of social protection and labor programs (% of total welfare 
of beneficiary households)", 

"Adequacy of unemployment benefits and ALMP (% of total welfare of 
beneficiary households)", 

"Benefit incidence of social protection and labor programs to poorest 
quintile (% of total SPL benefits)", 

"Benefit incidence of unemployment benefits and ALMP to poorest 
quintile (% of total U/ALMP benefits)", 

"Coverage of social protection and labor programs (% of population)", 

"Coverage of unemployment benefits and ALMP (% of population)", 

"Coverage of unemployment benefits and ALMP in 2nd quintile (% of 
population)", 

"Coverage of unemployment benefits and ALMP in 3rd quintile (% of 
population)", 

"Coverage of unemployment benefits and ALMP in poorest quintile (% of 
population)", 

"DEC alternative conversion factor (LCU per US$)", "Net secondary 
income (Net current transfers from abroad) (constant LCU)", 

"Net secondary income (Net current transfers from abroad) (current 
LCU)", 

"Net secondary income (Net current transfers from abroad) (current 
US$)", 

"Official exchange rate (LCU per US$, period average)", "PPP conversion 
factor, GDP (LCU per international $)", 

"PPP conversion factor, private consumption (LCU per international $)", 

"Price level ratio of PPP conversion factor (GDP) to market exchange 
rate", 

"Terms of trade adjustment (constant LCU)"), class = "factor"), 
Indicator.Code = structure(c(21L, 20L, 19L, 18L, 17L, 16L, 
                         15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L, 
5L, 4L, 3L, 
                         2L, 1L), .Label = c("NY.GSR.NFCY.CN", 
"NY.GSR.NFCY.KN", "NY.TAX.NIND.CD", 
                                             "NY.TAX.NIND.CN", 
"NY.TAX.NIND.KN", "NY.TRF.NCTR.CD", "NY.TRF.NCTR.CN", 
                                             "NY.TRF.NCTR.KN", 
"NY.TTF.GNFS.KN", "PA.NUS.ATLS", "PA.NUS.FCRF", 
                                             "PA.NUS.PPP", 
"PA.NUS.PPP.05", "PA.NUS.PPPC.RF", "per_allsp.cov_pop_tot", 

"per_lm_alllm.adq_pop_tot", "per_lm_alllm.ben_q1_tot", 
"per_lm_alllm.cov_pop_tot", 
                                             "per_lm_alllm.cov_q1_tot", 
"per_lm_alllm.cov_q2_tot", "per_lm_alllm.cov_q3_tot"
                         ), class = "factor"), Source.no = 
structure(c(3L, 3L, 3L, 

3L, 3L, 3L, 3L, 3L, 3L, 8L, 1L, 7L, 8L, 1L, 5L, 4L, 9L, 6L, 

2L, 10L, 11L), .Label = c(" for Economic Co-operation and Development 
(OECD).", 

" nonresidents. Data are in current local currency.", "es include both 
direct and indirect beneficiaries.", 

"expressed in local currency units per U.S. dollar.", "local currency 
units relative to the U.S. dollar).", 

"nonresidents. Data are in constant local currency.", "onversion 
factors are based on the 2011 ICP round.", 

"rapolated estimates based on the latest ICP round.", "stant prices. 
Data are in constant local currency.", 

"to nonresidents. Data are in current U.S. dollars.", "to producers. 
Data are in constant local currency."

), class = "factor"), Source.organization = structure(c(4L, 

4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 1L, 2L, 5L, 

3L, 3L, 3L, 3L, 3L), .Label = c("d Bank, International Comparison 
Program database.", 

"Monetary Fund, International Financial Statistics.", "ounts data, and 
OECD National Accounts data files.", 

"sehold surveys. (datatopics.worldbank.org/aspire/)", "stics, 
supplemented by World Bank staff estimates."

), class = "factor")), .Names = c("Country.Name", "Country.Code", 

"Indicator.Name", "Indicator.Code", "Source.no", "Source.organization"

), class = "data.frame", row.names = c(NA, -21L))


shinyApp(
  ui = fluidPage(

    fluidRow(
      column(2,
             selectInput("CN",
                         "Country name:",
                         c("All",
                           unique(as.character(data$Country.Name))))
      ),
      column(2,
             selectInput("CC",
                         "Country code:",
                         c("All",
                           unique(as.character(data$Country.Code))))
      ),
      column(2,
             selectInput("IN",
                         "Indicator name:",
                         c("All",
                           unique(as.character(data$Indicator.Name))))
      ),
      column(2,
             selectInput("IC",
                         "Indicator Code:",
                         c("All",
                           unique(as.character(data$Indicator.Code))))
      ),
      column(2,
             selectInput("SN",
                         "Source no:",
                         c("All",
                           unique(as.character(data$Source.no))))
      ),
      column(2,
             selectInput("SO",
                         "Source org:",
                         c("All",
                           unique(as.character(data$Source.organization))))
      )

    ),

    fluidRow(
      div(DT::dataTableOutput("table1"),style="font-size: 100%",tags$head(tags$style(type="text/css", "#table table td {line-height:50%;}")) )
    )
  ),
  server = function(input, output,session) {

    table_one <- reactive({
      if (input$CN != "All") {
        data <- data[data$Country.Name == input$CN,]
      }
      if (input$CC != "All") {
        data <- data[data$Country.Code == input$CC,]
      }
      if (input$IN != "All") {
        data <- data[data$Indicator.Name == input$IN,]
      }
      if (input$IC != "All") {
        data <- data[data$Indicator.Code == input$IC,]
      }
      if (input$SN != "All") {
        data <- data[data$Source.no == input$SN,]
      }
      if (input$SO != "All") {
        data <- data[data$Source.organization == input$SO,]
      }
      data 
    }) 


    output$table1 <- DT::renderDataTable(DT::datatable({
      table_one()
    },rownames = FALSE,
    options = list(scrollX=TRUE,
                   autoWidth = TRUE,
                   columnDefs = list(list(width = '150px', targets = "_all")))

    ))

    #filter code begin
    #if all filters are "all"
    observe({
      if (input$CN=="All"&&input$CC=="All"&&input$IN=="All"&&input$IC=="All"&&input$SN=="All"&&input$SO=="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(data$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(data$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(data$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(data$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(data$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(data$Source.organization))))
      }

      #otherwise
      if (input$CN!="All"){
        #updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$CC!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        #updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$IN!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        #updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$IC!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        #updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$SN!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        #updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }
      if (input$SO!="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(table_one()$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(table_one()$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(table_one()$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(table_one()$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(table_one()$Source.no))))
        #updateSelectInput(session,"SO",choices = c("All",unique(as.character(table_one()$Source.organization))))
      }

    })

  }
)

Answer 1

Using the filter() function and piping from dplyr might be the answer. I used it inside of a renderPlot({}) server function, and it worked for me (I didn't try it in an observe function).

data = data %>% filter(if(input$CN == 'ALL'){Country.Name %in% c("countryname_1", "countryname_2",...,"countryname_n")} else {Country.Name == input$CN}) %>%
  filter(if(input$CC == 'ALL'){Country.Code %in% c("countrycode_1",..,"countrycode_n")} else {Country.Code == input$CC}) %>%

and so on for each filter

There is probably a better way to get the unfiltered version in case you have a lot of countries than this part inside the if statement: Country.Code %in% c("countrycode_1",..,"countrycode_n") , but the if/else nested inside the filter, and filter statements for each attribute connected with %>% piping worked for me (and saved a LOT of space).

These links might help too: filtering values

using filter with if/else statement

Answer 2

You dont have to code individually to update each dropdown. You can make the dataset reactive, and set the dropdowns choices as column values from that reactive dataset.

You might want to use Observe function, to update the SelectInput.

   observe(
        UpdateSelectInput(session,inputId,label, choices = c(unique(dataframe()$Column))
    )

if you provide a reproducible example, it would be easier to demonstrate

Updated Solution

shinyApp(
  ui = fluidPage(

    fluidRow(
      column(2,
             selectInput("CN",
                         "Country name:",
                         c("All",
                           unique(as.character(data$Country.Name))))
      ),
      column(2,
             selectInput("CC",
                         "Country code:",
                         c("All",
                           unique(as.character(data$Country.Code))))
      ),
      column(2,
             selectInput("IN",
                         "Indicator name:",
                         c("All",
                           unique(as.character(data$Indicator.Name))))
      ),
      column(2,
             selectInput("IC",
                         "Indicator Code:",
                         c("All",
                           unique(as.character(data$Indicator.Code))))
      ),
      column(2,
             selectInput("SN",
                         "Source no:",
                         c("All",
                           unique(as.character(data$Source.no))))
      ),
      column(2,
             selectInput("SO",
                         "Source org:",
                         c("All",
                           unique(as.character(data$Source.organization))))
      )

    ),

    fluidRow(
      div(DT::dataTableOutput("table1"),style="font-size: 100%",tags$head(tags$style(type="text/css", "#table table td {line-height:50%;}")) )
    ),
    fluidRow(actionButton('reset','reset'))
  ),
  server = function(input, output,session) {

    rv = reactiveValues()
    rv$data=data

    observe({
      #table_one <- data
      if (input$CN != "All") {
        rv$data <- rv$data[rv$data$Country.Name == input$CN,]
      }
      if (input$CC != "All") {
        rv$data <- rv$data[rv$data$Country.Code == input$CC,]
      }
      if (input$IN != "All") {
        rv$data <- rv$data[rv$data$Indicator.Name == input$IN,]
      }
      if (input$IC != "All") {
        rv$data <- rv$data[rv$data$Indicator.Code == input$IC,]
      }
      if (input$SN != "All") {
        rv$data <- rv$data[rv$data$Source.no == input$SN,]
      }
      if (input$SO != "All") {
        rv$data <- rv$data[data$Source.organization == input$SO,]
      }

    }) 
    observeEvent(input$reset,{
      rv$data <- data
    })

    output$table1 <- DT::renderDataTable(DT::datatable({
      rv$data
    },rownames = FALSE,
    options = list(scrollX=TRUE,
                   autoWidth = TRUE,
                   columnDefs = list(list(width = '150px', targets = "_all")))

    ))

    #filter code begin
    #if all filters are "all"
    observe({
      #if (input$CN=="All"&&input$CC=="All"&&input$IN=="All"&&input$IC=="All"&&input$SN=="All"&&input$SO=="All"){
        updateSelectInput(session,"CN",choices = c("All",unique(as.character(rv$data$Country.Name))))
        updateSelectInput(session,"CC",choices = c("All",unique(as.character(rv$data$Country.Code))))
        updateSelectInput(session,"IN",choices = c("All",unique(as.character(rv$data$Indicator.Name))))
        updateSelectInput(session,"IC",choices = c("All",unique(as.character(rv$data$Indicator.Code))))
        updateSelectInput(session,"SN",choices = c("All",unique(as.character(rv$data$Source.no))))
        updateSelectInput(session,"SO",choices = c("All",unique(as.character(rv$data$Source.organization))))

    })

  }
)

The code demonstrates how you can update the dropdowns using reactiveValues. I havent written up code to handle the 'All' situation, but have provided a Reset button as a workaround. You can add on code to capture the All situation without the need for a reset button.