使用Rshiny整合时间序列图和传单图

问题描述 投票：0回答：1

我的数据/结果包含地理编码位置（纬度/经度）和日期/时间戳，我想使用 R闪亮与其进行交互。 我创建了 R 闪亮应用程序，其中包含多个传单地图（传单 R 包），还包含时间序列图（dygraphs R 包）。 我知道如何同步不同的dygraph（https://rstudio.github.io/dygraphs/gallery-synchronization.html），但也不知道如何将其同步到传单地图。 我的问题是如何最好地将所有图表链接在一起，因此当我在传单地图上选择一个区域或在 dygraph 时间序列图上选择一段时间时，其他图表都会更新以仅显示过滤后的数据？

我的一个想法是使用传单插件，但不确定如何使用 R/shiny 来做到这一点？ 例如，我看到一些传单插件提供了对包含日期/时间信息的地图进行动画处理的功能（http://apps.socib.es/Leaflet.TimeDimension/examples/）。 另一个问题是有没有任何文档/示例展示如何使用 Rshiny 使用传单插件？

我认为可以提取从时间序列图（dygraph）中选择的时间/日期，但不确定是否/如何提取R闪亮传单地图上显示的区域。 我的最后一个问题是，是否有可能如何提取显示传单地图的区域，以便我可以更新时间序列图。

r shiny r-leaflet r-dygraphs
1个回答
13
投票

这可能更多的是持续的讨论，而不是单一的答案。

幸运的是，您的问题涉及由 RStudio 创建的 

htmlwidgets
，他也制作了 
Shiny
。 他们付出了额外的努力将 Shiny 通信集成到 
dygraphs
和 
leaflet
中。 对于许多其他
htmlwidgets
来说，情况并非如此。 为了更广泛地讨论 Shiny 之外的
htmlwidget
内部通信，我建议关注这个 Github 问题。

第 1 部分 - 传单控制图

作为我的第一个示例，我们将让 

leaflet
控制 
dygraphs
，因此单击墨西哥的一个州会将 
dygraph
绘图限制为该州。 我应该赞扬这三个例子。

  1. 凯尔·沃克 (Kyle Walker) 的 Rpub 墨西哥 Choropleth 传单
  2. 传单中包含闪亮的示例
  3. 墨西哥迭戈瓦莱犯罪项目

R代码

  # one piece of an answer to this StackOverflow question
  #  http://stackoverflow.com/questions/31814037/integrating-time-series-graphs-and-leaflet-maps-using-r-shiny

  # for this we'll use Kyle Walker's rpubs example
  #   http://rpubs.com/walkerke/leaflet_choropleth
  # combined with data from Diego Valle's crime in Mexico project
  #   https://github.com/diegovalle/mxmortalitydb

  # we'll also build on the shiny example included in leaflet
  #  https://github.com/rstudio/leaflet/blob/master/inst/examples/shiny.R

  library(shiny)
  library(leaflet)
  library(dygraphs)
  library(rgdal)

  # let's build this in advance so we don't download the
  #    data every time
  tmp <- tempdir()
  url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
  file <- basename(url)
  download.file(url, file)
  unzip(file, exdir = tmp)
  mexico <- {
    readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
    #delete our files since no longer need
    on.exit({unlink(tmp);unlink(file)})
  }
  pal <- colorQuantile("YlGn", NULL, n = 5)

  leaf_mexico <- leaflet(data = mexico) %>%
    addTiles() %>%
    addPolygons(fillColor = ~pal(gdp08), 
                fillOpacity = 0.8, 
                color = "#BDBDC3", 
                weight = 1,
                layerId = ~id)

  # now let's get our time series data from Diego Valle
  crime_mexico <- jsonlite::fromJSON(
    "https://rawgit.com/diegovalle/crimenmexico.diegovalle.net/master/assets/json/states.json"
  )

  ui <- fluidPage(
    leafletOutput("map1"),
    dygraphOutput("dygraph1",height = 200),
    textOutput("message", container = h3)
  )

  server <- function(input, output, session) {
    v <- reactiveValues(msg = "")

    output$map1 <- renderLeaflet({
      leaf_mexico
    })

    output$dygraph1 <- renderDygraph({
      # start dygraph with all the states
      crime_wide <- reshape(
        crime_mexico$hd[,c("date","rate","state_code"),drop=F],
        v.names="rate",
        idvar = "date",
        timevar="state_code",
        direction="wide"
      )
      colnames(crime_wide) <- c("date",as.character(mexico$state))
      rownames(crime_wide) <- as.Date(crime_wide$date)
      dygraph(
        crime_wide[,-1]
      )
    })

    observeEvent(input$map1_shape_mouseover, {
      v$msg <- paste("Mouse is over shape", input$map1_shape_mouseover$id)
    })
    observeEvent(input$map1_shape_mouseout, {
      v$msg <- ""
    })
    observeEvent(input$map1_shape_click, {
      v$msg <- paste("Clicked shape", input$map1_shape_click$id)
      #  on our click let's update the dygraph to only show
      #    the time series for the clicked
      state_crime_data <- subset(crime_mexico$hd,state_code == input$map1_shape_click$id)
      rownames(state_crime_data) <- as.Date(state_crime_data$date)
      output$dygraph1 <- renderDygraph({
        dygraph(
          xts::as.xts(state_crime_data[,"rate",drop=F]),
          ylab = paste0(
            "homicide rate ",
            as.character(mexico$state[input$map1_shape_click$id])
          )
        )
      })
    })
    observeEvent(input$map1_zoom, {
      v$msg <- paste("Zoom changed to", input$map1_zoom)
    })
    observeEvent(input$map1_bounds, {
      v$msg <- paste("Bounds changed to", paste(input$map1_bounds, collapse = ", "))
    })

    output$message <- renderText(v$msg)
  }

  shinyApp(ui, server)

第 2 部分 dygraph 控制传单 + 第 1 部分传单控制 dygraph

# one piece of an answer to this StackOverflow question
#  http://stackoverflow.com/questions/31814037/integrating-time-series-graphs-and-leaflet-maps-using-r-shiny

# for this we'll use Kyle Walker's rpubs example
#   http://rpubs.com/walkerke/leaflet_choropleth
# combined with data from Diego Valle's crime in Mexico project
#   https://github.com/diegovalle/mxmortalitydb

# we'll also build on the shiny example included in dygraphs
#  https://github.com/rstudio/leaflet/blob/master/inst/examples/shiny.R

library(shiny)
library(leaflet)
library(dygraphs)
library(dplyr)
library(rgdal)

# let's build this in advance so we don't download the
#    data every time
tmp <- tempdir()
url <- "http://personal.tcu.edu/kylewalker/data/mexico.zip"
file <- basename(url)
download.file(url, file)
unzip(file, exdir = tmp)
mexico <- {
  #delete our files since no longer need
  on.exit({unlink(tmp);unlink(file)})  
  readOGR(dsn = tmp, layer = "mexico", encoding = "UTF-8")
}

# now let's get our time series data from Diego Valle
crime_mexico <- jsonlite::fromJSON(
  "https://rawgit.com/diegovalle/crimenmexico.diegovalle.net/master/assets/json/states.json"
)

# instead of the gdp data, let's use mean homicide_rate
#   for our choropleth
mexico$homicide <- crime_mexico$hd %>%
  group_by( state_code ) %>%
  summarise( homicide = mean(rate) ) %>%
  ungroup() %>%
  select( homicide ) %>%
  unlist


pal <- colorBin(
  palette = RColorBrewer::brewer.pal(n=9,"YlGn")[-(1:2)]
  , domain = c(0,50)
  , bins =7
)

popup <- paste0("<strong>Estado: </strong>", 
                      mexico$name, 
                      "<br><strong>Homicide Rate: </strong>", 
                      round(mexico$homicide,2)
          )

leaf_mexico <- leaflet(data = mexico) %>%
  addTiles() %>%
  addPolygons(fillColor = ~pal(homicide), 
              fillOpacity = 0.8, 
              color = "#BDBDC3", 
              weight = 1,
              layerId = ~id,
              popup = popup
              )


ui <- fluidPage(
  leafletOutput("map1"),
  dygraphOutput("dygraph1",height = 200),
  textOutput("message", container = h3)
)

server <- function(input, output, session) {
  v <- reactiveValues(msg = "")

  output$map1 <- renderLeaflet({
    leaf_mexico
  })

  output$dygraph1 <- renderDygraph({
    # start dygraph with all the states
    crime_wide <- reshape(
      crime_mexico$hd[,c("date","rate","state_code"),drop=F],
      v.names="rate",
      idvar = "date",
      timevar="state_code",
      direction="wide"
    )
    colnames(crime_wide) <- c("date",as.character(mexico$state))
    rownames(crime_wide) <- as.Date(crime_wide$date)
    dygraph( crime_wide[,-1])  %>%
      dyLegend( show = "never" )
  })

  observeEvent(input$dygraph1_date_window, {
    if(!is.null(input$dygraph1_date_window)){
      # get the new mean based on the range selected by dygraph
      mexico$filtered_rate <- crime_mexico$hd %>%
      filter( 
              as.Date(date) >= as.Date(input$dygraph1_date_window[[1]]),
              as.Date(date) <= as.Date(input$dygraph1_date_window[[2]])  
            ) %>%
      group_by( state_code ) %>%
      summarise( homicide = mean(rate) ) %>%
      ungroup() %>%
      select( homicide ) %>%
      unlist

      # leaflet comes with this nice feature leafletProxy
      #  to avoid rebuilding the whole map
      #  let's use it
      leafletProxy( "map1", data = mexico  ) %>%
        removeShape( layerId = ~id ) %>%
        addPolygons( fillColor = ~pal( filtered_rate ), 
                    fillOpacity = 0.8, 
                    color = "#BDBDC3", 
                    weight = 1,
                    layerId = ~id,
                    popup = paste0("<strong>Estado: </strong>", 
                        mexico$name, 
                        "<br><strong>Homicide Rate: </strong>", 
                        round(mexico$filtered_rate,2)
                    )
                    )
    }
  })

  observeEvent(input$map1_shape_click, {
    v$msg <- paste("Clicked shape", input$map1_shape_click$id)
    #  on our click let's update the dygraph to only show
    #    the time series for the clicked
    state_crime_data <- subset(crime_mexico$hd,state_code == input$map1_shape_click$id)
    rownames(state_crime_data) <- as.Date(state_crime_data$date)
    output$dygraph1 <- renderDygraph({
      dygraph(
        xts::as.xts(state_crime_data[,"rate",drop=F]),
        ylab = paste0(
          "homicide rate ",
          as.character(mexico$state[input$map1_shape_click$id])
        )
      )
    })
  })

}

shinyApp(ui, server)
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.