#r #time #shiny #leaflet #heatmap
Вопрос:
Я планирую создать тепловую карту, которая показывает изменение активности глубины за выбранный период времени на 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
На a glimpse() , quakes_cat является factor типом, в то время как, time находится dttm в Тихоокеанском стандартном времени
Теперь для моего полного кода R shiny Ниже
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]amp; 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 этом были изменены, Может ли кто-нибудь помочь? Спасибо.
Ответ №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] amp; 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) , чтобы код выполнялся.
Комментарии:
1. Я загружаю другой набор данных с большими точками данных. Карта иногда мигает, когда она отображается. Как мне уменьшить или остановить это?
2. Невозможно сказать без данных. Я предлагаю поднять еще один вопрос со всеми подробностями.