AnEostig
Reputation: 115
Update Picker Input, reuse selected data
I am constructing my first shiny app and I am facing some difficulty with a reactive input. In the menu visitors can select two input. First, they can select a year. Second, based on their year selection they can select a polygon. On the server side, I generate a reactive picker input so that the choices of polygon proposed to visitors react to the selected year. In the example data attached there is no polygon for year_3, so all choices in Select Polygon are disabled.
Based on the selected year/polygon combination I want to plot the relevant polygons on an OSM font. Polygons shape change between years. However here I am unable to find a way to plot the relevant polygon for each year/polygon selection. What I want is that when a visitor selects year_1, and both polygon_a and polygon_b, the app displays the shape of polygon_a and polygon_b for the year_1. Anyone can help here? Thank you!
I put together an example below:
First, UI and Server:
if (interactive()) {
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinycssloaders)
library(shinydashboard)
# Define UI -----------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Polygons"),
# Parameters
sidebarLayout(
sidebarPanel(
selectInput(inputId = "input_period", label = "Period",
choices = c("2001" = "year_1", "2002" = "year_2", "2003" = "year_3")),
pickerInput(
inputId = "picker_cny",
label = "Select Polygon",
choices = paste0(unique(codebook$Polygon)),
options = list(`actions-box` = TRUE),
multiple = TRUE),
width = 2),
# Displat the reactive map
mainPanel(
leafletOutput("m"),
tableOutput("table"),
width = 10)
))
# Define Server ------------------------------------------
server <- function(input, output, session) {
# Reactive pickerInput ---------------------------------
observeEvent(input$input_period, {
codebook_mod <- codebook[codebook$Year == paste0(input$input_period), ]
# Generate reactive picker input
disabled_choices <- !codebook$Polygon %in% codebook_mod$Polygon
updatePickerInput(session = session,
inputId = "picker_cny",
choices = paste0(unique(codebook$Polygon)),
choicesOpt = list(
disabled = disabled_choices,
style = ifelse(disabled_choices,
yes = "color: rgba(119, 119, 119, 0.5);",
no = "")
))
}, ignoreInit = TRUE)
# Reactive df ----------------------------------
reactive_codebook = reactive({
filter = subset(codebook, Year == paste0(input$input_period))
return(filter)
})
#shp <- left_join(shp@data, reactive_codebook(), by = "Polygon") # Should merge at some point to keep only polygons of the selected year
input_cny <- reactive({
paste0(input$picker_cny)
})
data <- reactive({
shp[shp@data$Polygon %in% input_cny(),]
})
# Reactive Map ---------------------------------
observeEvent(list(input$input_period, input$picker_cny),{
output$m <- renderLeaflet({
m <- leaflet() %>%
# Add Basemap OSM
addTiles(group = "OSM (default)") %>%
addPolygons(data = data())
})
output$table <- renderTable(data())
})
}
# Run the application
shinyApp(ui = ui, server = server)
}
Second, the data:
new("SpatialPolygonsDataFrame", data = structure(list(id = c("2",
"1", "1", "1", "1"), year = c("year_1", "year_2", "year_1", "year_2",
"year_1"), poly = c("polygon_a", "polygon_a", "polygon_b", "polygon_b",
"polygon_c")), row.names = c("1", "2", "3", "4", "5"), class = "data.frame"),
polygons = list(new("Polygons", Polygons = list(new("Polygon",
labpt = c(0.338510097570938, 47.8789367423025), area = 0.268213372645998,
hole = FALSE, ringDir = 1L, coords = structure(c(0.00681732104440386,
0.484029794150556, 0.770357278014247, 0.0545385683550191,
0.00681732104440386, 48.0457116592124, 48.1549787622059,
47.7394446143647, 47.6247016849114, 48.0457116592124), .Dim = c(5L,
2L)))), plotOrder = 1L, labpt = c(0.338510097570938,
47.8789367423025), ID = "1", area = 0.268213372645998), new("Polygons",
Polygons = list(new("Polygon", labpt = c(1.80479134647667,
47.6955749862821), area = 0.224089549953543, hole = FALSE,
ringDir = 1L, coords = structure(c(2.17812991677432,
2.005834598087, 1.76305483084579, 1.38489920201411,
2.17812991677432, 48.0895910398079, 47.6353579269049,
47.3651675407816, 47.6314042027695, 48.0895910398079
), .Dim = c(5L, 2L)))), plotOrder = 1L, labpt = c(1.80479134647667,
47.6955749862821), ID = "2", area = 0.224089549953543),
new("Polygons", Polygons = list(new("Polygon", labpt = c(2.10927583422516,
46.7882368725584), area = 0.559572966790018, hole = FALSE,
ringDir = 1L, coords = structure(c(2.31788915508705,
3.21777553294437, 1.79977275571466, 1.16576189858791,
2.31788915508705, 47.0193198894433, 46.8610635274769,
46.4774612519214, 46.8750461412294, 47.0193198894433
), .Dim = c(5L, 2L)))), plotOrder = 1L, labpt = c(2.10927583422516,
46.7882368725584), ID = "3", area = 0.559572966790018),
new("Polygons", Polygons = list(new("Polygon", labpt = c(-0.181380225959222,
46.929122089418), area = 1.98990706779548, hole = FALSE,
ringDir = 1L, coords = structure(c(-0.760131296447621,
1.39414215357443, -0.310188107518964, -1.48276732715122,
-0.760131296447621, 47.4290593450155, 47.3921509322044,
46.131308065997, 46.8447458743678, 47.4290593450155
), .Dim = c(5L, 2L)))), plotOrder = 1L, labpt = c(-0.181380225959222,
46.929122089418), ID = "4", area = 1.98990706779548),
new("Polygons", Polygons = list(new("Polygon", labpt = c(1.80479134647667,
47.6955749862821), area = 0.224089549953543, hole = FALSE,
ringDir = 1L, coords = structure(c(2.17812991677432,
2.005834598087, 1.76305483084579, 1.38489920201411,
2.17812991677432, 48.0895910398079, 47.6353579269049,
47.3651675407816, 47.6314042027695, 48.0895910398079
), .Dim = c(5L, 2L)))), plotOrder = 1L, labpt = c(1.80479134647667,
47.6955749862821), ID = "5", area = 0.224089549953543)),
plotOrder = c(4L, 3L, 1L, 5L, 2L), bbox = structure(c(-1.48276732715122,
46.131308065997, 3.21777553294437, 48.1549787622059), .Dim = c(2L,
2L), .Dimnames = list(c("x", "y"), c("min", "max"))), proj4string = new("CRS",
projargs = "+proj=longlat +datum=WGS84 +no_defs"))
structure(list(X = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), Polygon = c("polygon_a",
"polygon_a", "polygon_a", "polygon_a", "polygon_a", "polygon_a",
"polygon_a", "polygon_a", "polygon_b", "polygon_b", "polygon_b",
"polygon_b", "polygon_b", "polygon_b", "polygon_b", "polygon_b",
"polygon_c", "polygon_c", "polygon_c", "polygon_c"), Year = c("year_1",
"year_1", "year_1", "year_1", "year_2", "year_2", "year_2", "year_2",
"year_1", "year_1", "year_1", "year_1", "year_2", "year_2", "year_2",
"year_2", "year_1", "year_1", "year_1", "year_1"), Variable = c("Variable1",
"Variable2", "Variable3", "Variable4", "Variable1", "Variable2",
"Variable3", "Variable4", "Variable1", "Variable2", "Variable3",
"Variable4", "Variable1", "Variable2", "Variable3", "Variable4",
"Variable1", "Variable2", "Variable3", "Variable4"), Value = c(1L,
245L, 23L, 2L, 0L, 34L, 1L, 245L, 1L, 23L, 2L, 0L, 0L, 34L, 0L,
34L, 0L, 34L, 90L, 9L)), class = "data.frame", row.names = c(NA,
-20L))
Upvotes: 0
Views: 821
Answers (1)
YBS
Reputation: 21287
That is because your disabled_choices had all the rows, while the choices had unique Polygons. The number of elements should be same in both. Try this
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(shinycssloaders)
library(shinydashboard)
library(DT)
codebook <- structure(list(X = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA,
NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), Polygon = c("polygon_a",
"polygon_a", "polygon_a", "polygon_a", "polygon_a", "polygon_a",
"polygon_a", "polygon_a", "polygon_b", "polygon_b", "polygon_b",
"polygon_b", "polygon_b", "polygon_b", "polygon_b", "polygon_b",
"polygon_c", "polygon_c", "polygon_c", "polygon_c"), Year = c("year_1",
"year_1", "year_1", "year_1", "year_2", "year_2", "year_2", "year_2",
"year_1", "year_1", "year_1", "year_1", "year_2", "year_2", "year_2",
"year_2", "year_1", "year_1", "year_1", "year_1"), Variable = c("Variable1",
"Variable2", "Variable3", "Variable4", "Variable1", "Variable2",
"Variable3", "Variable4", "Variable1", "Variable2", "Variable3",
"Variable4", "Variable1", "Variable2", "Variable3", "Variable4",
"Variable1", "Variable2", "Variable3", "Variable4"), Value = c(1L,
245L, 23L, 2L, 0L, 34L, 1L, 245L, 1L, 23L, 2L, 0L, 0L, 34L, 0L,
34L, 0L, 34L, 90L, 9L)), class = "data.frame", row.names = c(NA,
-20L))
##########
# Define UI -----------------------------------------------
ui <- fluidPage(
# Application title
titlePanel("Colonial Concessions Within DRC"),
# Parameters
sidebarLayout(
sidebarPanel(
selectInput(inputId = "input_period", label = "Period",
choices = c("2001" = "year_1", "2002" = "year_2", "2003" = "year_3")),
pickerInput(
inputId = "picker_cny",
label = "Select Polygon",
choices = unique(codebook$Polygon),
options = list(`actions-box` = TRUE),
multiple = TRUE),
width = 2),
# Displat the reactive map
mainPanel(
#leafletOutput("m"),
DTOutput("t1"),
#tableOutput("table"),
width = 10)
))
# Define Server ------------------------------------------
server <- function(input, output, session) {
output$t1 <- renderDT({
### this will display all data when no Polygon is selected
# if (is.null(input$input_period)) myperiod <- unique(codebook$Year) else myperiod <- input$input_period
# if (is.null(input$picker_cny)) mypolygon <- unique(codebook$Polygon) else mypolygon <- input$picker_cny
# code1 <- codebook[codebook$Year %in% myperiod & (codebook$Polygon %in% mypolygon),]
### below code will display data only when at least one Polygon is selected; comment the line below and uncomment 3 lines above to display the other way
code1 <- codebook[codebook$Year %in% input$input_period & (codebook$Polygon %in% input$picker_cny),]
code1
})
# Reactive pickerInput ---------------------------------
observeEvent(input$input_period, {
#codebook_mod <- codebook[codebook$Year == paste0(input$input_period), ]
# Generate reactive picker input
code1 <- codebook[codebook$Year %in% input$input_period,]
codeu <- unique(codebook$Polygon)
code1u <- unique(code1$Polygon)
disabled_choices <- ifelse(codeu %in% code1u, 0,1)
#print(disabled_choices)
updatePickerInput(session = session,
inputId = "picker_cny",
choices = unique(codebook$Polygon),
choicesOpt = list(
disabled = disabled_choices,
style = ifelse(disabled_choices,
yes = "color: rgba(119, 119, 119, 0.5);",
no = "")
)
)
}, ignoreInit = TRUE)
}
# Run the application
shinyApp(ui = ui, server = server)
Upvotes: 1
Related Questions
- SelectInput Value update based on previous SelectInput in R shiny
- Update data SelectInput in shiny modules
- Update selectInput() by exlcluding values selected from another selectInput()
- How to update selectInput?
- UpdateSelectInput by User Input
- update pickerInput by using updatePickerInput in shiny
- updatePickerInput default select all choices
- Updatepickerinput with change in pickerinput in Shiny
- How to update choice of select input in r shiny dynamically
- Using the input from updateSelectInput