Double calls to plot/load functions in shiny app - r

Question

I have an app with a map, dropdown, calendar and line plot (my real app is much bigger but I have simplified as much as I can). The problem with it is that when I modify any of the uicontrol features, the data loading and plotting routines run twice (as evidenced from the print statements). In the full app the plots display a reasonable amount of data so running them twice leads to poor performance.
The app is structured so that I can select 1 of 2 predefined points on the map and it will change the dropdown and graph. A new location can also be selected with the dropdown menu (which in turn updates the map). There is also a checkbox to lock the timeframe and when this is not selected the timeframe gets reset to the extents of the timeseries for the new location.
I have isolated the problem to the updateDateRangeInput that is called in the server.R file (line 35). I can comment this out and the problem goes away, but then I lose the functionality to reset the calendar to the new timeframe. Does anyone know how I can keep that functionality but stop the data loading and plotting code from running twice?
Example app below:
app.R
library(shiny)
library(rsconnect)
source('ui.R')
source('server.R')
ui <- ui_page()
server <- server_page(input, output, session)
shinyApp(ui=ui, server=server)
ui.R
library(shiny)
library(leaflet)
library(dygraphs)
inc_level <- 5
ui_page <- function(){
fluidPage(
titlePanel("TEST APP"),
sidebarLayout(
sidebarPanel(
leafletOutput('region_map'),
selectInput(inputId = "Site",label = "Pick a site",choices = c("A","B"), selected = "A"),
fluidRow(
column(6,
dateRangeInput(inputId = "timeframe",label="Select time range", start ="2015-07-01", end = "2016-07-01")),
column(4,checkboxInput(inputId = "lock_timeframe",label = "Lock Time Range"))
)
),
mainPanel(
tabsetPanel(
tabPanel("Plot 1", dygraphOutput(outputId = "plot1"))
)
)
)
)
}
server.R
library(shiny)
library(ggplot2)
library(dygraphs)
library(xts)
server_page <- function(input, output, session){
# Create Data -------------------------------------------------------------
Y1 <- c(21000, 23400, 26800)
Time1 <- startdate <- as.Date(c('2007-11-1','2008-3-25','2010-3-14'))
Y2 <- c(11000, 11400, 16800)
Time2 <- startdate <- as.Date(c('2001-11-1','2003-3-25','2005-3-14'))
Lat <-c(-39.095980, -39.605823)
Lon <- c(173.887903, 173.824561)
Site <- c("A","B")
# Extract Data -------------------------------------------------------
df1 <- reactive({
print("load data")
if (input$Site=="A"){
df1 <- data.frame(Time1, Y1)
}
else if (input$Site=="B"){
df1 <- data.frame(Time2, Y2)
}
names(df1) <- c("Time","Y")
if (1){ # IF YOU CHANGE THIS TO A 0 FUNCTIONLITY IS LOST BUT PROBLEM GOES AWAY
lockTest <- input$lock_timeframe
if (lockTest==FALSE){
updateDateRangeInput(session, "timeframe",
start = df1$Time[1],
end =df1$Time[length(df1$Time)])
}
}
df1 <- df1[df1$Time >= format(input$timeframe[1]) & df1$Time <= format(input$timeframe[2]),]
validate(need(nrow(df1)!=0, "No Data In Range"))
return(df1)
}) #%>% bindCache(input$Site) # I woudl like to cache based on location to stop reloading of data from file in the full app
# Line Plot --------------------------------------------------------
output$plot1 <- renderDygraph({
print("Plotting")
data <- df1()
data <- xts(x = data$Y, order.by = data$Time)
dyPlt <- dygraph(data,width = 800, height = 400)
})
# Plot Map -----------------------------------------------------
output$region_map <- renderLeaflet({
y <- Lat
x <- Lon
id <- Site
leaflet() %>%
addProviderTiles(providers$OpenStreetMap, options = providerTileOptions(noWrap = TRUE)) %>%
setView(lng = 174.051515, lat = -39.301619, zoom = 8) %>%
addCircleMarkers(lng = x, lat = y ,color="green", radius = 2, layerId = id, label = id,
labelOptions = labelOptions(noHide = F, direction = "bottom",
style = list("color" = "green","border-color" = "rgba(0,0,0,0.5)"))
)
})
# Map Click Behaviour -----------------------------------------------------
#When map is clicked: update map and change dropdown value
observeEvent(input$region_map_marker_click, {
event <- input$region_map_marker_click
updateSelectInput(session,
inputId = "Site",
label = "Pick a site",
choices = Site,
selected = event$id)
})
# Update map when a new site is selected from the dropdown
observeEvent(input$Site, {
update_markers()
})
# Function to redraw markers and highlight the selected location
update_markers <- function(){
y <- Lat
x <- Lon
id <- Site
sitInd <- id == input$Site
leafletProxy("region_map") %>% clearMarkers() %>% addCircleMarkers(lng = x, lat = y ,color="green", radius = 2, layerId = id, label = id,
labelOptions = labelOptions(noHide = F, direction = "bottom",
style = list("color" = "green","border-color" = "rgba(0,0,0,0.5)")),
options = list(zIndex = 200)) %>%
addCircleMarkers(lng = x[sitInd], lat = y[sitInd] ,color="blue", radius = 4, layerId = id[sitInd], label = id[sitInd],
labelOptions = labelOptions(noHide = F, direction = "bottom",
style = list("color" = "blue","border-color" = "rgba(0,0,0,0.5)")),
options = list(zIndex = 300) )
}
}