热图不会根据 Leaflet (R Shiny) 上的时间值而改变

Question

我正计划制作一个热图，显示在 R Shiny 上选定时间段内深度活动的变化。我目前遇到的问题是热图不会随着时间而改变。它一遍又一遍地显示初始情节。

这是我正在使用的数据集。它来自quake 数据集，经过一些修改。我将这个数据集命名为quakes_mod.csv

X1     lat   long  depth mag stations    quakes_cat    time
1   -20.42  181.62  562 4.8   41          High Depth    2020-12-04 05:45:32
2   -20.62  181.03  650 4.2   15          High Depth    2020-12-04 05:45:32
3   -26.00  184.10  42  5.4   43          No Depth     2020-12-04 05:45:32
4   -17.97  181.66  626 4.1   19          High Depth    2020-12-04 05:45:32
5   -20.42  181.96  649 4.0   11          High Depth    2020-12-04 05:45:32
6   -19.68  184.31  195 4.0   12          Low Depth     2020-12-04 05:45:32
7   -11.70  166.10  82  4.8   43          No Depth    2020-12-04 05:45:32
8   -28.11  181.93  194 4.4   15          Low Depth 2020-12-04 05:45:32
9   -28.74  181.74  211 4.7   35         Low Depth  2020-12-04 05:45:32
10  -17.47  179.59  622 4.3   19         High Depth 2020-12-01 08:22:42

在glimpse() 上，quakes_cat 是 factor 类型，而 time 在太平洋标准时间是 dttm

下面是我完整的 R 闪亮代码

library(shiny)
library(xts)
library(leaflet)
library(dplyr)


df<-read_csv('data/quakes_mod.csv')%>%
  mutate(time=as.POSIXct(time))

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, 
             body {width:100%;height:100%}"),
  leafletOutput("basemap", width= "100%", height = "100%"),
  
  absolutePanel(
    sliderInput(
      "timeRange", label = "Choose Time Range:",
      min = as.POSIXct("2020-12-01 00:00:00"),
      max = as.POSIXct("2020-12-31 23:59:59"),
      value = c(as.POSIXct("2020-12-01 00:00:00"), as.POSIXct("2020-12-04 23:59:59")),
      timeFormat = "%Y-%m-%d %H:%M", timezone='PST', ticks = F, animate = T
    ), draggable = TRUE, top = "80%", left = "40%")
  
)


server <- function(input, output, session) {
  #filter the traffic data based on time selected by user
  filtered <- reactive({
    df[df$time>=input$timeRange[1]& df$time<=input$timeRange[2],]
  })
  
  #initial static content along with leaflet the way it should be initially
  output$basemap <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(providers$CartoDB.Positron)
  })
  
  #updating the markers real time
  observeEvent(input$timeRange,
               leafletProxy("basemap", data=filtered()) %>%
                 clearHeatmap() %>%
                 addHeatmap(lng=df$long,lat=df$lat,
                            max=3,radius=3,blur=3,intensity=df$quakes_cat,gradient= "OrRd")
  )
}

shinyApp(ui, server)

但是，在观察我的热图后，什么都没有改变。热图问题不会根据滚动条中选择的时间而改变。它只是求助于最初绘制的热图。我知道depth 中的一些值已更改，有人可以提供帮助吗？谢谢。

Answer 1

以下是一些更改，以根据所选日期使代码显示点。它使用filtered() 响应式而不是完整的df 数据帧的结果。完整的数据框将显示所有点，过滤后的将仅显示那些被选中的点。我已经更改了数据，以便完全可重现的示例将说明功能代码。我使用dput 制作的数据框总是比粘贴数据的文本版本要好，因为不会有歧义。

library(shiny)
library(xts)
library(leaflet)
library(leaflet.extras)
library(dplyr)

df <- structure(
    list(
        X1 = 1:10,
        lat = c(
            -20.42,
            -20.62,
            -26,
            -17.97,-20.42,
            -19.68,
            -11.7,
            -28.11,
            -28.74,
            -17.47
        ),
        long = c(
            181.62,
            181.03,
            184.1,
            181.66,
            181.96,
            184.31,
            166.1,
            181.93,
            181.74,
            179.59
        ),
        depth = c(562L, 650L, 42L, 626L, 649L, 195L, 82L, 194L,
                            211L, 622L),
        mag = c(4.8, 4.2, 5.4, 4.1, 4, 4, 4.8, 4.4, 4.7,
                        4.3),
        stations = c(41L, 15L, 43L, 19L, 11L, 12L, 43L, 15L, 35L,
                                 19L),
        quakes_cat = c(
            "High Depth",
            "High Depth",
            "No Depth",
            "High Depth",
            "High Depth",
            "Low Depth",
            "No Depth",
            "Low Depth",
            "Low Depth",
            "High Depth"
        ),
        time = c(
            "2020-12-01 05:45:32",
            "2020-12-04 05:45:32",
            "2020-12-04 05:45:32",
            "2020-12-06 05:45:32",
            "2020-12-09 05:45:32",
            "2020-12-11 05:45:32",
            "2020-12-15 05:45:32",
            "2020-12-18 05:45:32",
            "2020-12-20 05:45:32",
            "2020-12-30 08:22:42"
        )
    ),
    class = "data.frame",
    row.names = c(NA,-10L)
)

ui <- bootstrapPage(
    tags$style(type = "text/css", "html,
             body {width:100%;height:100%}"),
    leafletOutput("basemap", width = "100%", height = "100%"),
    
    absolutePanel(
        sliderInput(
            "timeRange",
            label = "Choose Time Range:",
            min = as.POSIXct("2020-12-01 00:00:00"),
            max = as.POSIXct("2020-12-31 23:59:59"),
            value = c(
                as.POSIXct("2020-12-01 00:00:00"),
                as.POSIXct("2020-12-04 23:59:59")
            ),
            timeFormat = "%Y-%m-%d %H:%M",
            timezone = 'PST',
            ticks = F,
            animate = T
        ),
        draggable = TRUE,
        top = "80%",
        left = "40%"
    )
)

server <- function(input, output, session) {
    #filter the traffic data based on time selected by user
    filtered <- reactive({
        df[df$time >= input$timeRange[1] & df$time <= input$timeRange[2], ]
    })
    
    output$basemap <- renderLeaflet({
        leaflet() %>%
            addProviderTiles(providers$CartoDB.Positron)
    })
    
    observeEvent(
        input$timeRange,
        {                    # do some work in a block and return a leafletProxy
            dff <- filtered()  # get the filtered data frame
            lfp <-             # and use this data to create the map
              leafletProxy("basemap", data = dff) %>%
              clearHeatmap() %>%
              addHeatmap(
                  lng = dff$long,
                  lat = dff$lat,
                  max = 3,
                  radius = 3,
                  blur = 3,
                  intensity = dff$quakes_cat,
                  gradient = "OrRd"
              )
            lfp  # return the leaflet proxy
        }
    )
}

shinyApp(ui, server)

我还添加了library(leaflet.extras)，以便代码运行。