I am using a date slider that is dynamic on the selection of year from the UI. The slider options are nested in tabPanel but when the year is changed the date does not react. I don't understand how to get the observeEvent to relay the new date. The old date can be seen in the terminal from the discrepancy of print(input$range) vs print(input$year) when the year is changed to 2018. Any help is greatly appreciated!
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)
CodePudding user response：
In my opinion, I think the conflicts is due to both inputs having the same id "range". By giving them different id, it works for me.
I made the following changes :
- give the sliderInputs different id, i.e "range1" and "range2" instead of "range".
In parameter_tabs
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))
)
)
And 2. Update the code of reactive filtredData accordingly by using the sliderInput depending on which year (range1 for 2017 and range2 for 2018) was selected.
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)
})
CodePudding user response：
Here is another option to solve the same problem.
- Create
reactiveValues - Update this
reactiveValueswith anobserveEventonìnput$year. We can usepasteandgsubso that we can add additional years without the need to touch the code here again.
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)