Question

我想在一个闪亮的应用程序中同步一个dygraph和一个DateRangeInput。下面的代码工作正常：我可以同时使用缩放选项和日期范围但我不能使用dyRangeSelector，因为有一个＆＃34;乒乓球＆＃34;效果：

library(xts)
library(shiny)
library(dygraphs)
library(lubridate)


data("co2")
data <- as.vector(coredata(as.xts(co2)))
serie <-  xts(x = data,order.by = seq(from=today(),by=1,length.out = length(data)))
ui <- fluidPage(
   titlePanel("Dygraph & date range input"),
   sidebarLayout(
      sidebarPanel(
        dateRangeInput('plage', label = "Selectionnez la période :",
                        start = start(serie), end = end(serie),
                         # min = start(serie), max = end(serie),
                       separator = " - ", 
                       format = "dd mm yyyy", #"yyyy-mm-dd",
                       language = 'fr', weekstart = 1
        )
      ),
      mainPanel(
         dygraphOutput("dessin")
      )
   )
)

server <- function(input, output,session) {

observeEvent(input$dessin_date_window,{
  start <- as.Date(ymd_hms(input$dessin_date_window[[1]]))
  stop  <- as.Date(ymd_hms(input$dessin_date_window[[2]]))
  updateDateRangeInput(session = session,
                       inputId = "plage",
                       start = start,end = stop
                       )
})

  output$dessin <- renderDygraph({
      dygraph(serie) %>%
    dyRangeSelector(
      dateWindow = input$plage+1) # +1 parce que voila...
  })
}

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

知道如何控制吗？（dygraph没有更新功能...... :(）

Answer 1

只需为当前系列添加一个被动反应，你应该是好的

  current_series <- reactive({
    range <- paste(input$plage[1], input$plage[2], sep = "/")
    serie[range]
  })

  output$dessin <- renderDygraph({
    dygraph(current_series()) %>%
      dyRangeSelector(
        dateWindow = input$plage+1) # +1 parce que voila...
  })

Answer 2

您可以定义将检查更改是由用户触发还是由反应性触发的值。这使您可以控制连锁反应。
因为书状图是输出，所以我需要添加一个中间值，该中间值仅在不由自动反应触发的情况下才会改变。因此，如果我们与书本互动或由日期选择器触发，则书本更新。但是，当日期选择器是由笔形变化触发时，则不会。

library(xts)
library(shiny)
library(dygraphs)
library(lubridate)


data("co2")
data <- as.vector(coredata(as.xts(co2)))
serie <-  xts(x = data,order.by = seq(from=today(),by=1,length.out = length(data)))

ui <- fluidPage(
  titlePanel("Dygraph & date range input"),
  sidebarLayout(
    sidebarPanel(
      dateRangeInput('plage', label = "Selectionnez la période :",
                     start = start(serie), end = end(serie),
                     separator = " - ", 
                     format = "dd mm yyyy", #"yyyy-mm-dd",
                     language = 'fr', weekstart = 1
      )
    ),
    mainPanel(
      dygraphOutput("dessin")
    )
  )
)

server <- function(input, output,session) {

  r <- reactiveValues(
    change_datewindow = 0,
    change_plage = 0,
    change_datewindow_auto = 0,
    change_plage_auto = 0,
    plage = c( start(serie), end(serie))
  )


  observeEvent(input$dessin_date_window, {
    message(crayon::blue("observeEvent_input_dessin_date_window"))
    r$change_datewindow <- r$change_datewindow + 1
    if (r$change_datewindow > r$change_datewindow_auto) {

      r$change_plage_auto <- r$change_plage_auto + 1
      r$change_datewindow_auto <- r$change_datewindow

      start <- as.Date(ymd_hms(input$dessin_date_window[[1]]))
      stop  <- as.Date(ymd_hms(input$dessin_date_window[[2]]))
      updateDateRangeInput(session = session,
                           inputId = "plage",
                           start = start,end = stop
      )
    } else {
      if (r$change_datewindow >= 10) {
        r$change_datewindow_auto <- r$change_datewindow <- 0
      }
    }
  })

  observeEvent(input$plage, {
    message("observeEvent_input_plage")
    r$change_plage <- r$change_plage + 1
    if (r$change_plage > r$change_plage_auto) {
      message("event input_year update")

      r$change_datewindow_auto <- r$change_datewindow_auto + 1
      r$change_plage_auto <- r$change_plage

      r$plage <- input$plage

    } else {
      if (r$change_plage >= 10) {
        r$change_plage_auto <- r$change_plage <- 0
      }
    }
  })

  output$dessin <- renderDygraph({
    message("renderDygraph")
    dygraph(serie) %>%
      dyRangeSelector(
        dateWindow = r$plage + 1) # +1 parce que voila...
  })
}

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

请注意，我在10以上时添加了计数器的重置。这也避免了R的触发值过高。当计数器重置时，您可能会注意到一个小的爆发，具体取决于用户更改计数器的速度。滑块。您可以增加此值以使其不经常出现。

我添加了一些消息，以便您可以确认没有连锁反应。

Answer 3

您可以在retainDateWindow = TRUE中使用dyRangeSelector()。

output$dessin <- renderDygraph({
  dygraph(serie) %>%
    dyRangeSelector(
      dateWindow = input$plage+1, retainDateWindow = TRUE)
})

我希望这会对你有所帮助。

在Shiny中同步Dygraph和DateRangeInput

3 个答案: