I am planning on the make a heatmap that shows the change in activity of a depth over a selected period of time on R shiny. The problem I am currently running into is that the heatmap does not change over time. It keeps showing the initial plot over and over.
Here is the dataset I am using. It is from the quake dataset with a few modifications. I named this dataset called 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
Upon a glimpse(), quakes_cat is a factor type while, time is dttm in Pacific Standard Time
Now for my full R shiny Code Below
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)
However, upon observing my heatmap, nothing has changed. The heatmap matter does not change based upon the time selected in the scroller. It just resorts to the heatmap that was initially plotted. I know for a fact that a few values in depth that were changed. Can anyone be of assistance?
Here are some changes to make the code display points based on the selected dates. It uses the results of the filtered() reactive rather than the full df data frame. The full data frame will display all the points, the filtered will display only those that are selected. I have changed the data so that the fully reproducible example will illustrate the functioning code. I used dput to make the data frame which is always better than pasting a text version of the data since there is no chance of ambiguity.
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)
I also added library(leaflet.extras) so the code runs.