rshinyshiny-reactivity
How can I use observe
I am trying to build a shiny app but so far I can only put reactivity to one selectInput control(StageBox). I need help with the following:
selectInput 'type'>> I would like to display on the map the points from the selected option, however, I would like to hide theStageBoxif the type on first box is notLifeStage.I would like my
sliderInputcontrol to update the map according to what theselectInputboxes have selected.
I have the dummy app below with I have tried:
library(shiny)
library(shinydashboard)
library(mapview)
library(tidyverse)
library(leaflet)
library(readxl)
library(sf)
library(shinyWidgets)
library(shinythemes)
library(scales)
library(shinyjs)
library(shinycssloaders)
type <- c("LifeStage", "Survey", "ReleaseType")
lifestage <- c("Adult", "Larvae", "Juvenile", "Post-Larvae")
ds <- structure(list(SampleDate = structure(c(14959, 14960, 14978,
14992, 15358, 15369), class = "Date"), Survey = c("Morning",
"MidDay", "Night", "Morning", "Morning", "MidDay"), LifeStage = c("Adult",
"Post-Larvae", "Juvenile", "Adult", "Larvae", "Adult"), lat = c(38.11429,
38.07435, 38.152333, 38.17354, 38.047967, 38.07868), lon = c(-121.6875,
-121.7623, -121.684833, -121.94784, -121.909917, -121.75566),
ReleaseEvent = c("BY2010", "BY2010", "BY2011", "BY2011",
"BY2012", "BY2012"), ReleaseMethod = c("Nice", "No Nice",
"Full", "Medium", "No Nice", "Full"), year = c(2010, 2010,
2011, 2011, 2012, 2012)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
ds$SampleDate <- as.Date(ds$SampleDate,"%m/%d/%Y")
# make ds sf object:
ds_sf <- st_as_sf(ds,coords = c(5, 4), remove = F, crs = 4326)
st_crs(ds_sf)
colors <- colorRampPalette(c('yellow', 'red', 'blue', 'green'))#use colorRampPalette so
map points and legend points match same color
ui <- fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(width=3,
h3("Select Options"),
selectInput(inputId = "type",
label = "Type",
choices = type,
selected = "LifeStage"),
pickerInput(inputId = "lstages",
label = "StageBox",
choices = lifestage,
selected = "Adult",
options = list(`actions-box` = TRUE),
multiple = TRUE),
selectInput(inputId = "event",
label = "Event",
choices = ds$ReleaseEvent),
sliderInput(inputId = "Yearslider",
label = "Years to plot",
sep = "",
min = 2010,
max = 2012,
step = 1,
value = 2011)),
mainPanel(leafletOutput("map",width = "100%", height="87vh"))
)
)
server <- function(input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
output$map <- renderLeaflet({
req(input$lstages)
final <- mapview(ds_sf[ds_sf$LifeStage %in% input$lstages, ],
zcol = "LifeStage",
col.regions = colors,
layer.name = "LifeStage",
alpha = 0.2, cex = 4)
final@map
})
}
shinyApp(ui, server)
Solution
- Use
conditionalPanel(condition = "input.type == 'LifeStage'", pickerInput(around thelstagespickerinput - You can simply filter your map data based on the year-slider, but only filter LifeStage, if input.type == "LifeStage", because if it isn't then the stageBox is hidden, so we should not retain the last filter.
md <- ds_sf
if(input$type == "LifeStage") # only filter by LifeStage if LifeStage is selected..
md <- ds_sf %>% filter(LifeStage %in% input$lstages & year == input$Yearslider)
else
md <- ds_sf %>% filter(year == input$Yearslider )
final <- mapview(md, zcol = "LifeStage", col.regions = colors, layer.name = "LifeStage", alpha = 0.2, cex = 4)
final@map
Code
if (!require("pacman")) install.packages("pacman")
p_load(shiny, shinydashboard, mapview, tidyverse, leaflet, sf, shinyWidgets, shinythemes, scales, shinyjs, shinycssloaders)
ds <- structure(list(SampleDate = structure(c(14959, 14960, 14978,
14992, 15358, 15369), class = "Date"), Survey = c("Morning",
"MidDay", "Night", "Morning", "Morning", "MidDay"), LifeStage = c("Adult",
"Post-Larvae", "Juvenile", "Adult", "Larvae", "Adult"), lat = c(38.11429,
38.07435, 38.152333, 38.17354, 38.047967, 38.07868), lon = c(-121.6875,
-121.7623, -121.684833, -121.94784, -121.909917, -121.75566),
ReleaseEvent = c("BY2010", "BY2010", "BY2011", "BY2011",
"BY2012", "BY2012"), ReleaseMethod = c("Nice", "No Nice",
"Full", "Medium", "No Nice", "Full"), year = c(2010, 2010,
2011, 2011, 2012, 2012)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
ds$SampleDate <- format(ds$SampleDate,"%m/%d/%Y") # use format, R already read in the number as date
# make ds sf object:
ds_sf <- st_as_sf(ds,coords = c(5, 4), remove = F, crs = 4326)
colors <- colorRampPalette(c('yellow', 'red', 'blue', 'green'))
ui <- fluidPage(
useShinyjs(),
sidebarLayout(
sidebarPanel(width=3,
h3("Select Options"),
selectInput(inputId = "type",
label = "Type",
choices = c("LifeStage", "Survey", "ReleaseType"),
selected = "LifeStage"),
conditionalPanel( # show panel conditionally
condition = "input.type == 'LifeStage'",
pickerInput(inputId = "lstages",
label = "StageBox",
choices = c("Adult", "Larvae", "Juvenile", "Post-Larvae"),
selected = "Adult",
options = list(`actions-box` = TRUE),
multiple = TRUE)
),
sliderInput(inputId = "Yearslider",
label = "Years to plot",
sep = "",
min = min(ds$year),
max = max(ds$year),
step = 1,
value = 2011)),
mainPanel(leafletOutput("map",width = "100%", height="87vh"))
)
)
server <- function(input, output, session) {
session$onSessionEnded(function() {
stopApp()
})
output$map <- renderLeaflet({
req(input$lstages)
md <- ds_sf
if(input$type == "LifeStage") # only filter by LifeStage if LifeStage is selected..
md <- ds_sf %>% filter(LifeStage %in% input$lstages & year == input$Yearslider)
else
md <- ds_sf %>% filter(year == input$Yearslider )
final <- mapview(md, zcol = "LifeStage", col.regions = colors, layer.name = "LifeStage", alpha = 0.2, cex = 4)
final@map
})
}
shinyApp(ui, server)
- rintrojs only shows first dialog in Safari
- Automatically read a column of lowercases True and False as logical
- How do I add counts to a stacked bar graph?
- Counting the number of rows between each pair of months?
- How to create a conditional panel using a reactive object that is passed from another module?
- Plot multiple normalized stock charts from different dates into a single plot
- Select columns based on string match - dplyr::select
- Looking for a more efficient way to replace matrix elements
- modelsummary modelplot: change linewidth
- custom R function with group argument does not work while using the filter
- ggsurvplot function, risk table alignment problem
- plot running average in ggplot2
- Calling variable in df within function
- How to find position of running minimum (runMin) in a vector in R?
- Using httr2::last_response() in conjunction with purrr::possibly()
- Cropping a raster using terra does not return the expected extent
- Can janitor::clean_names be used on only certain columns in a data frame?
- Efficient way of row binding time series in a data.table, with correctly sorted timestamps
- Defining optional arguments in R when more complex function
- Can I change the cursor in plotly only when hovering over points?
- Issue Loading RStoolbox: "Cannot find proj.db" Error
- Filter CSV files for specific value before importing
- Matching the same lines from 2 different files and 2 columns
- Conditional coloring and outer borders in pdf KableExtra table in R
- How can I use observe
- Posterior predictive check for GAM (mgcv in R)
- Embed images in plotly tick labels
- Product of two beta distributions
- R: how to include a character between two repeted items in R?
- Categorizing data from 7 columns into 2