#r #shiny
#r #блестящий
Вопрос:
Я создаю блестящее приложение и у меня проблемы с моей функцией observeEvent. К сожалению, предполагается, что он работает с помощью ползункового ввода дат. Приложение запускается, но когда я меняю дату на ползунке, одни и те же данные появляются снова и снова. Я считаю, что это только первые пару строк, которые отображаются снова и снова.
это мой полный код:
ui <- bootstrapPage(
tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}","html, body {width:100%;height:100%}"),
leafletOutput("map"),
absolutePanel(top = 10, right = 10,
sliderInput("dateRange",
"Dates:",
min = as.Date("2020-01-01","%Y-%m-%d"),
max = as.Date("2020-12-01","%Y-%m-%d"),
value=as.Date("2020-12-01"),
timeFormat="%Y-%m-%d")
)
)
server <- function(input, output) {
result_data$Change1<- cut(result_data$Change,
c(-1,0,1,2,3,4), include.lowest = T,
labels = c('increasing', 'decreasing', 'undetectable','no data','test'))
beatCol <- colorFactor(palette = 'RdYlGn', result_data$Change1)
map=leaflet() %>%
addProviderTiles(providers$Esri.WorldStreetMap) %>%
setView(lat = 47.2529, lng = -122.4443, zoom = 10) %>%
#overlay groups
addLayersControl(
overlayGroups = c("Basins","Testing sites", "WWTP"),
position = c("bottomright"),
options = layersControlOptions(collapsed = FALSE))
observeEvent(input$dateRange,
{
leafletProxy("map") %>%
clearMarkers()%>%
addCircleMarkers(data = result_data, unique(result_data$Change),
lat = as.numeric(result_data$Latitude),
lng = as.numeric(result_data$Longitude),
weight = 1,
radius = 10,
fillOpacity = 0.1,
color = ~beatCol(Change1),
label = ~ as.character(Site),
popup = ~ as.character(Site),
)
}
)
output$map <- renderLeaflet({
map
})
}
shinyApp(ui, server)
Я попытался исправить это, сделав это вместо этого с помощью функции observeEvent.
rv <- reactiveValues(
filteredData =result_data,
ids = unique(result_data$Change)
)
observeEvent(input$dateRange,
{
leafletProxy("map") %>%
clearMarkers()%>%
addCircleMarkers(data = subset(rv$filteredData, Change == rv$ids),
lat = as.numeric(rv$filteredData$Latitude),
lng = as.numeric(rv$filteredData$Longitude),
weight = 1,
radius = 10,
fillOpacity = 0.1,
color = ~beatCol(Change1),
label = ~ as.character(Site),
popup = ~ as.character(Site),
)
}
)
Я все еще получаю ту же проблему.
Фрагмент набора данных, из которого извлекается observeEvent:
Site Change Date Latitude Longitude
Basin C04 (MH-6761957) 1 2020-05-22 47.23513 -122.40374
Basin C04 (MH-6761957) 2 2020-05-29 47.23513 -122.40374
Basin C04 (MH-6761957) 2 2020-06-05 47.23513 -122.40374
Basin C04 (MH-6761957) 1 2020-06-12 47.23513 -122.40374
Basin C04 (MH-6761957) 2 2020-06-19 47.23513 -122.40374
Basin C04 (MH-6761957) 2 2020-06-25 47.23513 -122.40374
Basin C04 (MH-6761957) 1 2020-07-02 47.23513 -122.40374
Basin C04 (MH-6761957) 2 2020-07-09 47.23513 -122.40374
Basin C04 (MH-6761957) 2 2020-07-16 47.23513 -122.40374
Basin C04 (MH-6761957) 1 2020-07-23 47.23513 -122.40374
Basin C04 (MH-6761957) 1 2020-07-30 47.23513 -122.40374
Basin C09 (MH-6754884) alt site 0 2020-05-15 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-05-22 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-05-29 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-06-05 47.22362 -122.442
Basin C09 (MH-6754884) alt site 1 2020-06-12 47.22362 -122.442
Basin C09 (MH-6754884) alt site 2 2020-06-19 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-06-25 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-07-02 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-07-09 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-07-16 47.22362 -122.442
Basin C09 (MH-6754884) alt site 0 2020-07-23 47.22362 -122.442
Я просто получаю первую дату для каждого сайта, а затем она никогда не меняется.
Комментарии:
1. Похоже, вы не используете значение
input$dateRange, отличное от простого наблюдения за событием. Что вы хотите сделать со значениями из этого ввода? Кажется, что ни одна из ваших данных не реагирует.2. Я хочу иметь возможность выбирать дату, и маркер круга будет меняться для этого сайта в соответствии со значением изменения. Например, если я выберу 2020-06-05, тогда маркер круга изменится на цвет, связанный с 0, и если я сдвину его на 2020-06-12, он должен измениться на цвет, связанный с 1
Ответ №1:
Если вы ищете диапазон дат, то вам нужно указать две даты value в sliderInput . Затем используйте даты для filter ваших данных reactive перед сопоставлением. Попробуйте это
ui <- bootstrapPage(
tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}","html, body {width:100%;height:100%}"),
leafletOutput("map"),
#DTOutput("tb1"),
absolutePanel(top = 10, right = 10,
sliderInput("dateRange",
"Dates:",
min = as.Date("2020-01-01","%Y-%m-%d"),
max = as.Date("2020-12-01","%Y-%m-%d"),
value = c(as.Date("2020-07-02"), as.Date("2020-07-16")),
timeFormat="%Y-%m-%d")
)
)
server <- function(input, output) {
result_data$Change1<- cut(result_data$Change,
c(-1,0,1,2,3,4), include.lowest = T,
labels = c('increasing', 'decreasing', 'undetectable','no data','test'))
beatCol <- colorFactor(palette = 'RdYlGn', result_data$Change1)
rv <- reactive(
filteredData <- filter(result_data, Date >= input$dateRange[1] amp; Date <= input$dateRange[2])
)
output$tb1 <- renderDT(rv())
map=leaflet() %>%
addProviderTiles(providers$Esri.WorldStreetMap) %>%
setView(lat = 47.2529, lng = -122.4443, zoom = 10) %>%
#overlay groups
addLayersControl(
overlayGroups = c("Basins","Testing sites", "WWTP"),
position = c("bottomright"),
options = layersControlOptions(collapsed = FALSE))
observeEvent(input$dateRange, {
result_dataa <- rv()
leafletProxy("map") %>%
clearMarkers()%>%
addCircleMarkers(data = result_dataa, unique(result_dataa$Change),
lat = as.numeric(result_dataa$Latitude),
lng = as.numeric(result_dataa$Longitude),
weight = 1,
radius = 10,
fillOpacity = 0.1,
color = ~beatCol(Change1),
label = ~ as.character(Site),
popup = ~ as.character(Site),
)
})
output$map <- renderLeaflet({
map
})
}
shinyApp(ui, server)
Комментарии:
1. Я думаю, я узнал, что у меня должна быть просто кнопка действия вместо диапазона дат, потому что мои данные просто накладываются, а не меняются на цвет, соответствующий этой дате. Например, я получаю красный цвет для первого свидания, а затем для второго свидания на том же сайте, он просто наложит цвет поверх него.