R 在Shining app中双击绘图/加载函数

我有一个带有地图、下拉列表、日历和线条图的应用程序（我真正的应用程序要大得多，但我尽可能简化了）。它的问题是，当我修改任何uicontrol功能时，数据加载和打印例程运行两次（从打印语句可以看出）。在完整应用程序中，绘图显示的数据量合理，因此运行两次会导致性能不佳

该应用程序是结构化的，因此我可以选择地图上2个预定义点中的1个，它将更改下拉列表和图形。还可以使用下拉菜单选择新位置（这反过来会更新地图）。还有一个复选框用于锁定时间段，如果未选中此复选框，则时间段将重置为新位置的时间序列范围

我已将问题隔离到server.R文件（第35行）中调用的UpdatedTerangeInput。我可以将其注释掉，问题就消失了，但随后我就失去了将日历重置为新时间段的功能。有人知道我如何保持该功能，但不让数据加载和绘图代码运行两次吗

示例应用程序如下：

应用程序R

图书馆（闪亮）
图书馆（rsconnect）
源（'ui.R'）
源（'server.R'）
ui您的绘图取决于两个输入变量，它们不会同时注册更改。我建议使用
xts（.）
创建一个反应数据块，然后在
输出$region\u映射中使用它。（我建议
debounce
ing，这样它的反应不会太快。）感谢您的快速回复。这听起来是一个可行的解决方案，尽管增加延迟听起来像是一个解决办法，更不用说增加可视化过程的时间了。我觉得我对反应链有些误解。似乎应该有一种方式来表示：如果单击地图，则更新日历、下拉列表和线形图，如果选择下拉列表，则更新地图、日历和线形图。如果修改了日历，则仅更新测线图。在我看来，这在我的生活中并不是一件不寻常的事情。

library(shiny)
library(rsconnect)

source('ui.R')
source('server.R')

ui <- ui_page()

server <- server_page(input, output, session)

shinyApp(ui=ui, server=server)




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"))

      )
    )
  )
)
}

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) )
  }

}