我使用了一个日期滑块，它在从UI中选择年份时是动态的。滑块选项嵌套在tabPanel中，但当年份更改时，日期不会做出反应。我不明白如何让observeEvent转播新的日期。将年份更改为2018时，从print(input$range)与print(input$year)的差异可以在终端中看到旧日期。非常感谢您的帮助！
library(shiny)
library(tidyverse)
library(plotly)
library(leaflet)
library(leaflet.minicharts)
flow<-structure(list(site_no = c(11468500, 11468500, 11468500, 11468500,
11468500, 11468500, 11468500, 11468500, 11468500, 11468500),
WY = c(2017, 2017, 2017, 2017, 2017, 2018, 2018, 2018, 2018,
2018), flow = c(367, 411, 373, 392, 349, 245, 219, 198, 175,
154), Date = structure(c(17273, 17274, 17275, 17276, 17277,
17638, 17639, 17640, 17641, 17642), class = "Date"), commonDate = structure(c(11064,
11065, 11066, 11067, 11068, 11064, 11065, 11066, 11067, 11068
), class = "Date"), year = c(2017, 2017, 2017, 2017, 2017,
2018, 2018, 2018, 2018, 2018)), class = c("spec_tbl_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -10L), spec = structure(list(
cols = list(site_no = structure(list(), class = c("collector_double",
"collector")), WY = structure(list(), class = c("collector_double",
"collector")), flow = structure(list(), class = c("collector_double",
"collector")), Date = structure(list(format = ""), class = c("collector_date",
"collector")), commonDate = structure(list(format = ""), class = c("collector_date",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), skip = 1L), class = "col_spec"))
ant_data_clean<-structure(list(ANTENNA = c("DSTM", "DSTM", "DSTM", "DSTM", "DSTM",
"DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM",
"DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "USTM",
"USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM",
"USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM",
"USTM", "USTM", "USTM"), Species = c("Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead", "Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead"), date = structure(c(17273,
17274, 17275, 17276, 17277, 17638, 17639, 17640, 17641, 17642,
17273, 17274, 17275, 17276, 17277, 17638, 17639, 17640, 17641,
17642, 17273, 17274, 17275, 17276, 17277, 17638, 17639, 17640,
17641, 17642, 17273, 17274, 17275, 17276, 17277, 17638, 17639,
17640, 17641, 17642), class = "Date"), n = c(0, 0, 0, 0, 0, 13,
13, 15, 29, 36, 0, 0, 0, 0, 0, 16, 15, 19, 28, 58, 9, 20, 16,
15, 14, 2, 3, 7, 4, 11, 2, 2, 3, 3, 4, 9, 5, 4, 8, 14), lat = c(39.534772,
39.534772, 39.534772, 39.534772, 39.534772, 39.534772, 39.534772,
39.534772, 39.534772, 39.534772, 39.534772, 39.534772, 39.534772,
39.534772, 39.534772, 39.534772, 39.534772, 39.534772, 39.534772,
39.534772, 39.525417, 39.525417, 39.525417, 39.525417, 39.525417,
39.525417, 39.525417, 39.525417, 39.525417, 39.525417, 39.525417,
39.525417, 39.525417, 39.525417, 39.525417, 39.525417, 39.525417,
39.525417, 39.525417, 39.525417), lng = c(-123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349), year = c(2017, 2017,
2017, 2017, 2017, 2018, 2018, 2018, 2018, 2018, 2017, 2017, 2017,
2017, 2017, 2018, 2018, 2018, 2018, 2018, 2017, 2017, 2017, 2017,
2017, 2018, 2018, 2018, 2018, 2018, 2017, 2017, 2017, 2017, 2017,
2018, 2018, 2018, 2018, 2018)), row.names = c(NA, -40L), class = c("tbl_df", "tbl", "data.frame"))
sppCols <- levels(factor(ant_data_clean$Species))
tilesURL <- "http://server.arcgisonline.com/ArcGIS/rest/services/Canvas/World_Light_Gray_Base/MapServer/tile/{z}/{y}/{x}"
basemap <- leaflet(width = "100%", height = "100%") %>%
addTiles(tilesURL)
parameter_tabs <- tabsetPanel(
id = "slide",
type = "hidden",
tabPanel("2017",
sliderInput("range", "Date range", as.Date("2017-04-17"), as.Date("2017-04-21"),
value = c(as.Date("2017-04-17")), step = 1,animate =animationOptions(interval = 250,loop=FALSE))
),
tabPanel("2018",
sliderInput("range","Date range", as.Date("2018-04-17"), as.Date("2018-04-21"),
value = as.Date("2018-04-17"), step = 1,animate =animationOptions(interval = 250,loop=FALSE))
)
)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "75%"),
plotlyOutput("animate", width = "100%", height = "25%"),
absolutePanel(top = 10, right = 10,
selectInput("year","Select year",choices = c(min(ant_data_clean$year):max(ant_data_clean$year)),selected = 2017),
parameter_tabs,
selectInput("spp", "Select species",choices = unique(sppCols), multiple = FALSE,selected = c("Coho Salmon")
))
)
server <- function(input, output, session) {
observeEvent(input$year,{
updateTabsetPanel(session=session,inputId = "slide", selected = input$year)
})
filteredData <- reactive({
print(input$range)
print(input$year)
ant_data_clean[ant_data_clean$date == input$range,]%>%
drop_na(date) %>%
filter(Species %in% input$spp)
})
# Initialize map
output$map <- renderLeaflet({
basemap %>%
addMinicharts(
ant_data_clean$lng,ant_data_clean$lat,
layerId = ant_data_clean$ANTENNA,
width = 65, height = 150,
transitionTime = 250
)
})
# Update charts each time input value changes
observe({
TM <- filteredData()
data <- TM %>% select(n)
# }
maxValue <- max(as.matrix(data))
leafletProxy("map", session) %>%
updateMinicharts(
layerId = TM$ANTENNA,
chartdata = data,
maxValues = maxValue,
type = "pie",
showLabels = TRUE,
transitionTime = 250
)
})
}
shinyApp(ui, server)
这里有另一个解决相同问题的选项。
- 创建
reactiveValues - 使用
ìnput$year上的observeEvent更新此reactiveValues。我们可以使用paste和gsub，这样我们就可以添加额外的年份，而无需再次触摸此处的代码
library(shiny)
library(tidyverse)
library(plotly)
library(leaflet)
library(leaflet.minicharts)
flow<-structure(list(site_no = c(11468500, 11468500, 11468500, 11468500,
11468500, 11468500, 11468500, 11468500, 11468500, 11468500),
WY = c(2017, 2017, 2017, 2017, 2017, 2018, 2018, 2018, 2018,
2018), flow = c(367, 411, 373, 392, 349, 245, 219, 198, 175,
154), Date = structure(c(17273, 17274, 17275, 17276, 17277,
17638, 17639, 17640, 17641, 17642), class = "Date"), commonDate = structure(c(11064,
11065, 11066, 11067, 11068, 11064, 11065, 11066, 11067, 11068
), class = "Date"), year = c(2017, 2017, 2017, 2017, 2017,
2018, 2018, 2018, 2018, 2018)), class = c("spec_tbl_df",
"tbl_df", "tbl", "data.frame"), row.names = c(NA, -10L), spec = structure(list(
cols = list(site_no = structure(list(), class = c("collector_double",
"collector")), WY = structure(list(), class = c("collector_double",
"collector")), flow = structure(list(), class = c("collector_double",
"collector")), Date = structure(list(format = ""), class = c("collector_date",
"collector")), commonDate = structure(list(format = ""), class = c("collector_date",
"collector"))), default = structure(list(), class = c("collector_guess",
"collector")), skip = 1L), class = "col_spec"))
ant_data_clean<-structure(list(ANTENNA = c("DSTM", "DSTM", "DSTM", "DSTM", "DSTM",
"DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM",
"DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "DSTM", "USTM",
"USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM",
"USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM", "USTM",
"USTM", "USTM", "USTM"), Species = c("Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead", "Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon", "Coho Salmon",
"Coho Salmon", "Coho Salmon", "Coho Salmon", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead", "Steelhead", "Steelhead",
"Steelhead", "Steelhead", "Steelhead"), date = structure(c(17273,
17274, 17275, 17276, 17277, 17638, 17639, 17640, 17641, 17642,
17273, 17274, 17275, 17276, 17277, 17638, 17639, 17640, 17641,
17642, 17273, 17274, 17275, 17276, 17277, 17638, 17639, 17640,
17641, 17642, 17273, 17274, 17275, 17276, 17277, 17638, 17639,
17640, 17641, 17642), class = "Date"), n = c(0, 0, 0, 0, 0, 13,
13, 15, 29, 36, 0, 0, 0, 0, 0, 16, 15, 19, 28, 58, 9, 20, 16,
15, 14, 2, 3, 7, 4, 11, 2, 2, 3, 3, 4, 9, 5, 4, 8, 14), lat = c(39.534772,
39.534772, 39.534772, 39.534772, 39.534772, 39.534772, 39.534772,
39.534772, 39.534772, 39.534772, 39.534772, 39.534772, 39.534772,
39.534772, 39.534772, 39.534772, 39.534772, 39.534772, 39.534772,
39.534772, 39.525417, 39.525417, 39.525417, 39.525417, 39.525417,
39.525417, 39.525417, 39.525417, 39.525417, 39.525417, 39.525417,
39.525417, 39.525417, 39.525417, 39.525417, 39.525417, 39.525417,
39.525417, 39.525417, 39.525417), lng = c(-123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.748447, -123.748447,
-123.748447, -123.748447, -123.748447, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349, -123.731349, -123.731349,
-123.731349, -123.731349, -123.731349), year = c(2017, 2017,
2017, 2017, 2017, 2018, 2018, 2018, 2018, 2018, 2017, 2017, 2017,
2017, 2017, 2018, 2018, 2018, 2018, 2018, 2017, 2017, 2017, 2017,
2017, 2018, 2018, 2018, 2018, 2018, 2017, 2017, 2017, 2017, 2017,
2018, 2018, 2018, 2018, 2018)), row.names = c(NA, -40L), class = c("tbl_df", "tbl", "data.frame"))
sppCols <- levels(factor(ant_data_clean$Species))
tilesURL <- "http://server.arcgisonline.com/ArcGIS/rest/services/Canvas/World_Light_Gray_Base/MapServer/tile/{z}/{y}/{x}"
basemap <- leaflet(width = "100%", height = "100%") %>%
addTiles(tilesURL)
parameter_tabs <- tabsetPanel(
id = "slide",
type = "hidden",
tabPanel("2017",
sliderInput("range17", "Date range", as.Date("2017-04-17"), as.Date("2017-04-21"),
value = c(as.Date("2017-04-17")), step = 1,animate =animationOptions(interval = 250,loop=FALSE))
),
tabPanel("2018",
sliderInput("range18","Date range", as.Date("2018-04-17"), as.Date("2018-04-21"),
value = as.Date("2018-04-17"), step = 1,animate =animationOptions(interval = 250,loop=FALSE))
)
)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "75%"),
plotlyOutput("animate", width = "100%", height = "25%"),
absolutePanel(top = 10, right = 10,
selectInput("year","Select year",choices = c(min(ant_data_clean$year):max(ant_data_clean$year)),selected = 2017),
parameter_tabs,
selectInput("spp", "Select species",choices = unique(sppCols), multiple = FALSE,selected = c("Coho Salmon")
))
)
server <- function(input, output, session) {
observeEvent(input$year,{
updateTabsetPanel(session=session,inputId = "slide", selected = input$year)
})
date <- reactiveValues(range = NULL)
observeEvent(input$year, {
date$range <- input[[paste0("range", gsub("^20","", input$year))]]
})
filteredData <- reactive({
print(date$range)
print(input$year)
ant_data_clean[ant_data_clean$date == date$range,]%>%
drop_na(date) %>%
filter(Species %in% input$spp)
})
# Initialize map
output$map <- renderLeaflet({
basemap %>%
addMinicharts(
ant_data_clean$lng,ant_data_clean$lat,
layerId = ant_data_clean$ANTENNA,
width = 65, height = 150,
transitionTime = 250
)
})
# Update charts each time input value changes
observe({
TM <- filteredData()
data <- TM %>% select(n)
# }
maxValue <- max(as.matrix(data))
leafletProxy("map", session) %>%
updateMinicharts(
layerId = TM$ANTENNA,
chartdata = data,
maxValues = maxValue,
type = "pie",
showLabels = TRUE,
transitionTime = 250
)
})
}
shinyApp(ui, server)
在我看来，我认为冲突是由于两个输入具有相同的id"范围"；。通过给他们不同的id，这对我有效。
我做了以下更改：
- 给滑动输入不同的id，即"；range1"；以及"；范围2"；而不是"；"范围">
在参数表中
parameter_tabs <- tabsetPanel(
id = "slide",
type = "hidden",
tabPanel("2017",
sliderInput("range1", "Date range", as.Date("2017-04-17"), as.Date("2017-04-21"),
value = c(as.Date("2017-04-17")), step = 1,animate =animationOptions(interval = 250,loop=FALSE))
),
tabPanel("2018",
sliderInput("range2","Date range", as.Date("2018-04-17"), as.Date("2018-04-21"),
value = as.Date("2018-04-17"), step = 1,animate =animationOptions(interval = 250,loop=FALSE))
)
)
和2。根据选择的年份(2017年的范围1和2018年的范围2(，使用sliderInput相应地更新反应过滤数据的代码。
filteredData <- reactive({
print("-------------------------")
print(input$range1)
print(input$range2)
print(input$year)
newrange <- case_when(
input$year == 2017 ~ input$range1,
input$year == 2018 ~ input$range2
)
print(newrange )
ant_data_clean[ant_data_clean$date == newrange,]%>%
drop_na(date) %>%
filter(Species %in% input$spp)
})