ObserveEvent running twice only under specific conditions

shiny
1

So this is a very strange behavior that I have encountered; Follow these steps:

  1. Run the app
  2. Change the start date and end date however you want
  3. See the console in RStudio, a statement should be printed saying which input you changed

Now let's get to the issue:

  1. Set the view to Monthly
  2. Set the start date to any selectable month except January 2022 (do not change the end date)

You should see in the console that my debug lines for both the start and end dates being changed printed. This should not be happening, only the debug line for the start date being changed should be printed. Here's the even bigger issue:

  1. (Watch the console) Change the start date to January 2022

It gets stuck in an infinite loop of both ObserveEvent functions getting called. The only way to get out of it is to change the view or to refresh the app. I don't know why this is happening only under these specific conditions (Monthly view with the end date being June 2022, aka, the last month). You can also see that if you change the end date to anything other than June 2022, neither of the aforementioned issues occur.

Reprex:

# Activate necessary libraries ####
library("shiny")
library("shinydashboard")
library("tidyverse")
library('lubridate')

# Function Declarations ####
CustomDateInput <- function(inputId, label, minview = "days", maxview = "decades", ...) {
  d <- shiny::dateInput(inputId, label, ...)
  d$children[[2L]]$attribs[["data-date-min-view-mode"]] <- minview
  d$children[[2L]]$attribs[["data-date-max-view-mode"]] <- maxview
  return(d)
}

GetDateData <- function(df, date_type = 'day') {
  x <- df %>%
    group_by(Date = floor_date(Date, date_type)) %>%
    summarize(Count = sum(Count))
  
  return(x)
}

# Get raw data ####
Confirmed_Cases <- data.frame(
  'Date' = seq.Date(as.Date(as.character(20200310), format = '%Y%m%d'), as.Date(as.character(20220626), format = '%Y%m%d'), by = 'day'),
  'Count' = c(1,0,0,1,0,3,3,10,14,32,46,103,95,95,128,131,109,191,239,99,183,161,271,266,382,327,324,356,349,259,229,328,329,321,318,206,152,288,264,222,122,130,131,190,153,426,67,17,132,118,417,174,154,77,41,52,160,76,95,83,42,41,63,51,60,60,57,21,47,42,22,57,59,28,27,22,34,13,31,16,28,20,0,1,13,24,32,23,14,3,7,3,18,7,6,4,3,3,7,21,4,16,18,7,4,11,6,25,3,10,4,3,7,8,12,15,5,9,6,24,7,3,8,10,4,6,9,22,15,13,13,10,4,14,10,7,13,10,9,13,16,9,33,7,5,3,4,9,8,10,34,9,8,7,17,5,10,14,5,3,8,14,13,9,16,9,6,6,7,12,17,19,11,1,19,16,15,8,10,12,5,5,11,15,29,17,14,10,24,38,33,27,35,17,11,10,8,49,28,64,79,23,9,38,28,57,98,40,51,18,64,64,103,63,53,27,20,60,58,62,51,35,16,20,26,55,31,62,61,20,57,46,72,80,86,70,43,41,55,77,93,110,82,59,100,86,114,93,128,111,62,94,206,145,114,110,69,87,126,147,169,154,89,137,86,176,189,212,222,257,210,134,187,196,185,224,175,211,210,121,234,183,532,153,180,71,139,242,229,187,208,93,158,159,318,320,272,322,164,159,170,281,402,411,227,306,239,278,358,291,387,285,218,178,261,235,318,337,240,269,248,332,216,249,254,419,178,157,156,92,155,193,207,172,160,131,168,160,185,182,152,147,118,147,174,163,165,143,110,143,189,213,225,188,190,122,144,218,178,241,187,159,109,137,224,197,223,145,168,118,204,156,396,221,272,237,132,229,262,210,227,237,260,228,230,218,261,226,232,154,116,184,206,136,223,152,132,84,140,167,129,166,118,118,80,82,84,154,75,119,83,74,73,93,77,83,67,60,33,27,72,57,61,71,41,26,20,34,40,32,38,33,24,11,34,24,27,33,19,10,21,16,14,22,15,15,11,9,8,18,11,15,12,9,12,11,12,17,14,9,5,2,9,9,5,6,8,9,8,3,10,2,19,4,7,5,7,8,7,3,6,3,13,7,11,18,14,16,2,7,16,7,17,17,22,18,14,41,37,31,32,38,27,23,48,45,41,52,67,33,38,68,104,91,125,95,90,84,139,127,130,120,99,76,87,129,107,108,119,117,96,67,100,112,109,129,166,65,112,112,122,123,123,101,75,77,84,121,146,120,149,84,85,126,168,113,95,98,92,95,94,116,106,125,127,81,66,92,139,92,112,103,73,102,116,130,109,124,69,126,67,149,107,160,121,122,74,77,106,91,79,86,67,54,50,79,110,82,128,82,58,81,85,93,103,105,110,83,95,135,150,153,132,129,80,110,122,224,170,137,142,148,122,165,211,155,113,156,154,151,196,278,279,265,269,145,150,246,267,277,259,263,158,220,286,342,381,341,418,358,262,489,552,799,793,390,338,575,913,3402,1708,2182,1240,849,1311,1550,1961,2074,2018,1707,898,1168,1238,1766,1112,1040,899,634,507,686,719,540,469,319,259,284,353,358,304,290,188,115,220,239,219,157,138,66,85,121,135,152,79,78,53,38,55,70,87,67,55,40,15,47,42,51,62,40,24,18,26,30,29,125,22,20,22,27,23,45,27,27,17,15,25,32,30,35,24,20,16,50,67,44,61,60,43,31,54,59,59,69,66,40,35,97,111,108,116,103,80,51,112,108,113,82,87,89,68,119,129,145,143,111,110,83,128,175,166,141,179,138,109,157,214,213,283,250,150,125,245,289,263,252,294,168,130,226,258,250,254,225,134,113,189,198,200,158,154,130,83,86,193,187,182,142,96,84,115,105,93,119,114,74,74,115,115,128,96,92,97,52,87,110,135,107,95,89,57)
)

# Cases ####
Cases <- list(
  Day   = GetDateData(Confirmed_Cases, 'day'),
  Week  = GetDateData(Confirmed_Cases, 'week'),
  Month = GetDateData(Confirmed_Cases, 'month'),
  Year  = GetDateData(Confirmed_Cases, 'year')
)

# UI ####
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidRow(selectInput('Selected_Case_View', 'View', c("Daily", "Weekly", "Monthly", "Yearly"), 'Daily')),
    box(uiOutput('Start_Date_Cases'), uiOutput('End_Date_Cases'))
  )
)

# Server ####
server <- function(input, output, session) {
  # Inputs and Outputs ####
  output$Start_Date_Cases <- renderUI({
    req(input$Selected_Case_View)
    switch (
      input$Selected_Case_View,
      'Daily' = {
        Temp_Data <- Cases[[1]]
        CustomDateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', minview = 'days', maxview = 'decades')
      },
      'Weekly' = {
        Temp_Data <- Cases[[2]]
        dateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', daysofweekdisabled = c(1:6))
      },
      'Monthly' = {
        Temp_Data <- Cases[[3]]
        CustomDateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'M, yyyy', startview = 'year', minview = 'months', maxview = 'decades')
      },
      'Yearly' = {
        Temp_Data <- Cases[[4]]
        dateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]))
        shinyjs::disable('Start_Date_Cases')
      }
    )
  })
  output$End_Date_Cases <- renderUI({
    req(input$Selected_Case_View)
    switch (
      input$Selected_Case_View,
      'Daily' = {
        Temp_Data <- Cases[[1]]
        CustomDateInput('End_Date_Cases', 'End Date', value = max(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', minview = 'days', maxview = 'decades')
      },
      'Weekly' = {
        Temp_Data <- Cases[[2]]
        dateInput('End_Date_Cases', 'End Date', value = max(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', daysofweekdisabled = c(1, 2, 3, 4, 5, 6))
      },
      'Monthly' = {
        Temp_Data <- Cases[[3]]
        CustomDateInput('End_Date_Cases', 'End Date', value = max(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'M, yyyy', startview = 'year', minview = 'months', maxview = 'decades')
      },
      'Yearly' = {
        Temp_Data <- Cases[[4]]
        dateInput('End_Date_Cases', 'Start Date', value = max(Temp_Data[[1]]))
        shinyjs::disable('Start_Date_Cases')
      }
    )
  })
  
  # Event controllers ####
  observeEvent(input$Start_Date_Cases, {
    cat('Start Date Changed\n')
    switch(
      input$Selected_Case_View,
      'Daily' = updateDateInput(session, 'End_Date_Cases', min = input$Start_Date_Cases + 6),
      'Weekly' = updateDateInput(session, 'End_Date_Cases', min = input$Start_Date_Cases + 34),
      'Monthly' = updateDateInput(session, 'End_Date_Cases', min = input$Start_Date_Cases %m+% months(5))
    )
  })
  observeEvent(input$End_Date_Cases, {
    cat('End Date Changed\n')
    switch(
      input$Selected_Case_View,
      'Daily' = updateDateInput(session, 'Start_Date_Cases', max = input$End_Date_Cases - 6),
      'Weekly' = updateDateInput(session, 'Start_Date_Cases', max = input$End_Date_Cases - 34),
      'Monthly' = updateDateInput(session, 'Start_Date_Cases', max = input$End_Date_Cases %m-% months(5))
    )
  })
  
}

# Run the application ####
shinyApp(ui = ui, server = server)

I apologize for the very large data frame, I usually pull the number from excel, but I won't be uploading an excel file.

3

the requirements are unclear, it seems that you initialise the date selectors to be potentially a wide range apart, then given that they have starts and ends inited, each of start and end, try to change the min value of the other, this might tend to put them into impossible states, i.e. the end date sets the min of the start date to something ahead of the value that the start date currently is etc.
If I make reasonable assumptions about what you are trying to do, I would go for a different approach, which is to let the user control an aspect, and then call a validator function, that can configure all relevant elements to something that reflects the users choice but are also compatible with each other.
I would also generally avoid reusing input names, in my experiences this is a recipe for disaster , making it a) hard to reason about /program with) b) quite often an explicit error in shiny.

good luck

4

I know you helped me with my previous post, this is the same project which I am just trying to convert to using shiny dashboard for visual purposes. Both my renderUI and observeEvent functions are pretty much copy/paste from that original project.

the requirements are unclear, it seems that you initialise the date selectors to be potentially a wide range apart, then given that they have starts and ends inited, each of start and end

So yes, in my renderUI functions I am creating the date inputs which have the same min and max limits but the value is set to either the min or max value depending on whether it is the start or end date respectively.

This can be seen here:

output$Start_Date_Cases <- renderUI({
    req(input$Selected_Case_View)
    switch (
      input$Selected_Case_View,
      'Daily' = {
        Temp_Data <- Cases[[1]]
        CustomDateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', minview = 'days', maxview = 'decades')
      },
      'Weekly' = {
        Temp_Data <- Cases[[2]]
        dateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', daysofweekdisabled = c(1:6))
      },
      'Monthly' = {
        Temp_Data <- Cases[[3]]
        CustomDateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'M, yyyy', startview = 'year', minview = 'months', maxview = 'decades')
      },
      'Yearly' = {
        Temp_Data <- Cases[[4]]
        dateInput('Start_Date_Cases', 'Start Date', value = min(Temp_Data[[1]]))
        shinyjs::disable('Start_Date_Cases')
      }
    )
  })
  output$End_Date_Cases <- renderUI({
    req(input$Selected_Case_View)
    switch (
      input$Selected_Case_View,
      'Daily' = {
        Temp_Data <- Cases[[1]]
        CustomDateInput('End_Date_Cases', 'End Date', value = max(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', minview = 'days', maxview = 'decades')
      },
      'Weekly' = {
        Temp_Data <- Cases[[2]]
        dateInput('End_Date_Cases', 'End Date', value = max(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'mm/dd/yyyy', startview = 'month', daysofweekdisabled = c(1, 2, 3, 4, 5, 6))
      },
      'Monthly' = {
        Temp_Data <- Cases[[3]]
        CustomDateInput('End_Date_Cases', 'End Date', value = max(Temp_Data[[1]]), min = min(Temp_Data[[1]]), max = max(Temp_Data[[1]]), format = 'M, yyyy', startview = 'year', minview = 'months', maxview = 'decades')
      },
      'Yearly' = {
        Temp_Data <- Cases[[4]]
        dateInput('End_Date_Cases', 'Start Date', value = max(Temp_Data[[1]]))
        shinyjs::disable('Start_Date_Cases')
      }
    )
  })

Where the issue comes in is specifically only in the month view and when the end date is set to the maximum value. A previous person suggested(and then removed the suggestion) that it could be the renderUI functions causing the issue, but these only get called if input$Selected_Case_View is changed, no when the values of the dateInputs change.

try to change the min value of the other, this might tend to put them into impossible states, i.e. the end date sets the min of the start date to something ahead of the value that the start date currently is etc.

If I understand correctly what you are saying, you believe it is because the min or max value is being set either below or above the current value which is causing an error. I do not think this is the case because in each observeEvent, they only modify the complimenting variable(aka, if Start date changes then End date is modified). I also do not think this is the case because my issue only occurs in the month view, but not the daily or weekly view.

The issue also isn't that something is invalid, it is that the observeEvent functions get caught in an infinite loop like one they trigger each other back and forth. I don't understand why this would happen only for the Monthly view and only when the max value for End_Date_Cases is selected and never any other time. The action for the Daily and Weekly selections in the observeEvent functions are fundamentally the same as the Monthly version.

5

So immediately after posting this, I continued to mess with my code and ended up just going back to my old project's renderUI code and the issue does not occur:

SOLUTION:
I still don't fully understand the 'why', but essentially it was the max() statement that was causing the issue. I needed to include the ceiling_date function from lubridate as follows:

CustomDateInput('End_Date_Cases', 'End Date', value = max(ceiling_date(Cases[[3]][[1]], 'month')) - 1, min = min(Cases[[3]][[1]]), max = max(ceiling_date(Cases[[3]][[1]], 'month')) - 1, format = 'M, yyyy', startview = 'year', minview = 'months', maxview = 'decades')

I think it was probably because the way I had the Monthly data setup, the dates were always the first of the month where using ceiling_date gives me the last date of the month:

> max(Cases[[3]][[1]])
[1] "2022-05-01"
> max(ceiling_date(Cases[[3]][[1]], 'month')) - 1
[1] "2022-05-31"

It's always dumb little things isn't it?

6

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.