R shiny dynamic filtering - 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
*edit update: I ended up put this filter function configuration in the observe function and it works great, seems more organized too

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.