Styjun

I am struggling to solve an issue with passing multiple filters in a row, and sometimes the result is not as expected. In the example below, there are 7 Deer, 2 Bears, 1 Cougar, 1 Beaver, 1 Skunk, 1 Moose, and 3 Elk. When you select one or more species, sometimes the number of rows passed through the filters is not the same as it should be.

Eg. When I select Bear, Beaver, and Cougar, it should produce data set of 4 rows, however, in the textoutput displaying the number of rows, nrow=3 is displayed. Adding in more selections sometimes passes the remaining filters, sometimes not. Sometimes when selecting Deer, where you would expect 7 rows of data, only 3 are passed.

Have a look at the reproducible example below.

Server:

library(shiny)
library(dplyr)

shinyServer(function(input, output, session, clientData) 


 Accident.Date <- as.Date(c("2018-06-04", "2018-06-05", "2018-06-06", "2018-06-07", "2018-06-08", "2018-06-09", "2018-06-10", "2018-06-11", "2018-06-12", "2018-06-13", "2018-06-14", "2018-06-15", "2018-06-16", "2018-06-17", "2018-06-18", "2018-07-18"))
 Time.of.Kill <- as.character(c("DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DAY", "DAY", "DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DARK", "DUSK", "DARK", "DAY"))
 Sex <- as.character(c("MALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "MALE", "MALE", "FEMALE", "FEMALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "FEMALE"))
 Age <- as.character(c("ADULT", "YOUNG", "UNKNOWN", "ADULT", "UNKNOWN", "ADULT", "YOUNG", "YOUNG", "ADULT", "ADULT", "ADULT", "YOUNG", "ADULT", "YOUNG", "YOUNG", "ADULT"))
 Species <- as.character(c("Deer", "Deer", "Deer", "Bear", "Deer", "Cougar", "Bear", "Beaver", "Deer", "Skunk", "Moose", "Deer", "Deer", "Elk", "Elk", "Elk"))
 Year <- as.numeric(c("0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0"))


 data <- data.frame(Accident.Date, Time.of.Kill, Sex, Age, Species, stringsAsFactors = FALSE)
 data <- data %>% mutate(Data.Set = "Current")

 #A set of reactive filters. Only data that has passed all filters is passed to the map, graph, datatable etc. **Order goes datacheck > yearcheck > speccheck > sexcheck > timecheck > agecheck > indaterange


 bindata <- reactive(
 filter(data, Data.Set %in% input$datacheck)
 )

 yrdata <- reactive(
 filter(bindata(), Year %in% input$yearcheck)
 )

 specdata <- reactive(
 subset(yrdata(), Species %in% input$speccheck)
 )

 sexdata <- reactive(
 filter(specdata(), Sex %in% input$sexcheck)
 )

 timedata <- reactive(
 filter(sexdata(), Time.of.Kill %in% input$timecheck)
 )

 agedata <- reactive(
 filter(timedata(), Age %in% input$agecheck)
 )

 #Does the date range filter. Selects min and max from the two inputs of the observed indaterange filter.

 data1 <- reactive( filter(agedata(),
 Accident.Date >= input$inDateRange[[1]],
 Accident.Date <= input$inDateRange[[2]])
 )

 #If statement for choosing between current and historical datasets. If current is selected, year is set to 0 and the selection box is hidden.

 observe( if (input$datacheck == 'Current')
 updateSelectInput(session, "yearcheck", choices = c("0"), selected = c("0"))
 else
 updateSelectizeInput(session, "yearcheck", choices = sort(unique(bindata()$Year), decreasing = TRUE), server=TRUE)

 )

 observe(

 req((input$datacheck == 'Historical'))

 updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)

 )


 #Creates the observed Species

 observeEvent(input$yearcheck, 

 x <- input$yearcheck
 if (is.null(x))
 x <- character(0)

 updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)

 )


 #Creates the observed Sex

 observeEvent(input$speccheck, 

 x <- input$speccheck
 if (is.null(x))
 x <- character(0)

 updateCheckboxGroupInput(session, inputId = "sexcheck",
 choices = unique(specdata()$Sex),
 selected = unique(specdata()$Sex),
 inline = TRUE)
 )


 #Creates the observed Time

 observeEvent(input$sexcheck,

 x <- input$sexcheck
 if (is.null(x))
 x <- character(0)

 updateCheckboxGroupInput(session, inputId = "timecheck",
 choices = unique(sexdata()$Time.of.Kill),
 selected = unique(sexdata()$Time.of.Kill),
 inline = TRUE)
 )

 #Creates the observed Age

 observeEvent(input$timecheck,

 x <- input$timecheck
 if (is.null(x))
 x <- character(0)

 updateCheckboxGroupInput(session, inputId = "agecheck",
 choices = unique(timedata()$Age),
 selected = unique(timedata()$Age),
 inline = TRUE)
 )

 #Creates the observed dates and suppresses warnings from the min max

 observeEvent(input$agecheck, 

 x <- input$agecheck
 if (is.null(x))
 x <- character(0)

 #And update the date range values to match those of the dataset

 updateDateRangeInput(
 session = session,
 inputId = "inDateRange",
 start = min(suppressWarnings(agedata()$Accident.Date)),
 end = max(suppressWarnings(agedata()$Accident.Date))
 )
 )


 output$txt <- renderText(nrow(data1()))


 )

ui:

navbarPage("Test", id="nav",

 tabPanel("Map",

 absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
 draggable = FALSE, top = 200, left = 5, right = "auto", bottom = "auto",
 width = "auto", height = "auto",


 radioButtons("datacheck", label = tags$div( HTML("<b>Dataset</b>")),
 choices = c("Current" = "Current", "Historical" = "Historical"),
 selected = c("Current"), inline = TRUE),



 conditionalPanel(condition = "input.datacheck != 'Current'",

 #Only displays yearcheck for historical as there is no year column on current dataset. Current dataset has had all year values set to 0. 

 selectizeInput("yearcheck", label = "Select Year (Only Available for Historical)", choices = NULL, options = list(placeholder = 'Select Year:', maxOptions = 40, maxItems = 40))),

 selectizeInput("speccheck", h3("Select Species:"), choices = NULL, options = list(placeholder = 'Select Species: (Max 12) ', maxOptions = 36, maxItems = 12)),


 conditionalPanel(condition = "input.speccheck >= '1'",
 dateRangeInput("inDateRange", "Date range input:"),

 checkboxGroupInput("sexcheck", label = tags$div( HTML("<b>Sex</b><br>"))),

 checkboxGroupInput("agecheck", label = tags$div( HTML("<b>Age</b><br>"))),

 checkboxGroupInput("timecheck", label = tags$div( HTML("<b>Time of Accident</b><br>")))
 ),
 verbatimTextOutput("txt")


)))

Any help would be appreciated. I have been scratching my head at this one for a while.

The issue is related with how you update your checkbox. Using your code: select first BEAR, the output looks great, yeah, but if you add BEAVER nothing happens. Why? Because when your filter pass

 timedata <- reactive(
 filter(sexdata(),(Time.of.Kill %in% input$timecheck))
 )

Because BEAR has not DAWN as a Time.of.Kill, BEAVER does not pass this filter.

Here is my solution:

shinyServer(function(input, output, session, clientData) 


 Accident.Date <- as.Date(c("2018-06-04", "2018-06-05", "2018-06-06", "2018-06-07", "2018-06-08", "2018-06-09", "2018-06-10", "2018-06-11", "2018-06-12", "2018-06-13", "2018-06-14", "2018-06-15", "2018-06-16", "2018-06-17", "2018-06-18", "2018-07-18"))
 Time.of.Kill <- as.character(c("DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DAY", "DAY", "DAWN", "DAY", "DARK", "UNKNOWN", "DUSK", "DARK", "DUSK", "DARK", "DAY"))
 Sex <- as.character(c("MALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "MALE", "MALE", "FEMALE", "FEMALE", "MALE", "FEMALE", "MALE", "FEMALE", "FEMALE", "FEMALE"))
 Age <- as.character(c("ADULT", "YOUNG", "UNKNOWN", "ADULT", "UNKNOWN", "ADULT", "YOUNG", "YOUNG", "ADULT", "ADULT", "ADULT", "YOUNG", "ADULT", "YOUNG", "YOUNG", "ADULT"))
 Species <- as.character(c("Deer", "Deer", "Deer", "Bear", "Deer", "Cougar", "Bear", "Beaver", "Deer", "Skunk", "Moose", "Deer", "Deer", "Elk", "Elk", "Elk"))
 Year <- as.numeric(c("0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0", "0"))


 data <- data.frame(Accident.Date, Time.of.Kill, Sex, Age, Species, stringsAsFactors = FALSE)
 data <- data %>% mutate(Data.Set = "Current")

 #A set of reactive filters. Only data that has passed all filters is passed to the map, graph, datatable etc. **Order goes datacheck > yearcheck > speccheck > sexcheck > timecheck > agecheck > indaterange


 bindata <- reactive(
 filter(data, Data.Set %in% input$datacheck)
 )

 yrdata <- reactive(
 filter(bindata(), Year %in% input$yearcheck)
 )

 specdata <- reactive(
 sub <- subset(yrdata(), Species %in% input$speccheck)

 )

 sexdata <- reactive(
 filter(specdata(), Sex %in% input$sexcheck)
 )

 timedata <- reactive(
 filter(sexdata(),(Time.of.Kill %in% input$timecheck))
 )

 agedata <- reactive(
 filter(timedata(), Age %in% input$agecheck)
 )

 #Does the date range filter. Selects min and max from the two inputs of the observed indaterange filter.

 data1 <- reactive( filter(agedata(),
 Accident.Date >= input$inDateRange[[1]],
 Accident.Date <= input$inDateRange[[2]])
 )

 #If statement for choosing between current and historical datasets. If current is selected, year is set to 0 and the selection box is hidden.

 observe( if (input$datacheck == 'Current')
 updateSelectInput(session, "yearcheck", choices = c("0"), selected = c("0"))
 else
 updateSelectizeInput(session, "yearcheck", choices = sort(unique(bindata()$Year), decreasing = TRUE), server=TRUE)

 )

 observe(

 req((input$datacheck == 'Historical'))

 updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)

 )


 #Creates the observed Species

 observeEvent(input$yearcheck, 

 x <- input$yearcheck
 if (is.null(x))
 x <- character(0)

 updateSelectizeInput(session, "speccheck", choices = sort(unique(yrdata()$Species)), server=TRUE)

 )


 #Creates the observed Sex

 observeEvent(input$speccheck, 

 x <- input$speccheck
 if (is.null(x))
 x <- character(0)

 updateCheckboxGroupInput(session, inputId = "sexcheck",
 choices = unique(bindata()$Sex),
 selected = unique(bindata()$Sex),
 inline = TRUE)
 )


 #Creates the observed Time

 observeEvent(input$sexcheck,

 x <- input$sexcheck
 if (is.null(x))
 x <- character(0)

 updateCheckboxGroupInput(session, inputId = "timecheck",
 choices = unique(bindata()$Time.of.Kill),
 selected = unique(bindata()$Time.of.Kill),
 inline = TRUE)
 )

 #Creates the observed Age

 observeEvent(input$timecheck,

 x <- input$timecheck
 if (is.null(x))
 x <- character(0)

 updateCheckboxGroupInput(session, inputId = "agecheck",
 choices = unique(bindata()$Age),
 selected = unique(bindata()$Age),
 inline = TRUE)
 )

 #Creates the observed dates and suppresses warnings from the min max

 observeEvent(input$agecheck, 

 x <- input$agecheck
 if (is.null(x))
 x <- character(0)

 #And update the date range values to match those of the dataset

 updateDateRangeInput(
 session = session,
 inputId = "inDateRange",
 start = min(suppressWarnings(bindata()$Accident.Date)),
 end = max(suppressWarnings(bindata()$Accident.Date))
 )
 )


 output$txt <- renderText(nrow(data1()))


)

My only change is to use bindata() to update checkboxs, this will force all to appear so no animal is pre-filtered.
Therefore, my solution is to renounce to create dynamic checks and show all from the very first time you select an animal.

The solution was rather obvious. The desired effect was obtained by just placing the updateinputs inside of observe() rather than trying to observe the upstream inputs as they change. This was applied to all upstream updateinputs.

 observe(

 x <- input$agecheck
 if (is.null(x))
 x <- character(0)

 #And update the date range values to match those of the dataset

 updateDateRangeInput(
 session = session,
 inputId = "inDateRange",
 start = suppressWarnings(min(agedata()$Accident.Date)),
 end = suppressWarnings(max(agedata()$Accident.Date))
 )
 )

This solved the problem!