Related
My shapefile has columns mean, median and sd and i want to draw a choropleth map in R Shiny. I have a sidebar that controls if tiles of map should display mean, median or sd. But I am not able to do it in Shiny. I tried using the reactive funtions but I keep getting the error below
Error: Polygon data not found; please provide addPolygons with data and/or lng/lat arguments
My code is below
library(shiny)
library(leaflet)
library(rgdal)
library(RColorBrewer)
val <- readOGR('exampleshapefile.shp')
mybins <- c(24,270,470,555,770,2000,Inf)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons("stat", "Stat Type:",
c("Mean" = "mean",
"Median" = "q0_50",
"Standard Deviation" = "sd"
)
)
),
mainPanel("mainpanel",
leafletOutput("distSAM")
)
)
)
server <- function(input, output) {
###################### dist-wise
data <- eventReactive(input$stat,{
val#data$input$stat
})
pal <- reactive({
colorBin(palette="RdYlGn", domain = data(), na.color = "transparent", bins=mybins, reverse = TRUE)
})
labels <- reactive({
sprintf(
"<strong>%s<br/>%s</strong>%.1f",
val#data[["NAME_2"]], "SAM: ", data()
) %>% lapply(htmltools::HTML)
})
output$distSAM <- renderLeaflet({
df <- data()
pal <- pal()
lab <- labels()
leaflet() %>% addTiles() %>%
addPolygons(data = df,
fillColor = ~pal(mean),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = lab,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(pal = pal, values = ~df$mean,
title = "SAM </br> Prevalence",
position = "bottomleft")
}
)
}
shinyApp(ui, server)
val#data$input$stat is not a valid data selection. Instead you can use:
selected_stat <- val[[input$stat]]
I am trying to create a Shiny Leaflet map with slider input based on the years listed in the columns. The data component of the Large SpatialPolygonsDataFrame looks like this with the postcode on the side and years as column names:
I am wanting to create a slider using the P2015 to P2020 columns.
How do I get the map to change the colours when a different input year is selected?
I'm not sure I understand how to use the reactive function properly.
Here is the code that I currently have:
ui <- fillPage(
titlePanel("Title"),
tags$style(type = "text/css", "html, body {width:100%; height:100%}"),
leafletOutput("mymap", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("year", "Year", min = 2015, max = 2020,
value = 2015, step = 1)
)
)
server <- function(input, output, session) {
LargeSpatialPDF <- rgdal::readOGR("~/blah.geojson")
output$mymap <- renderLeaflet({
leaflet(LargeSpatialPDF ) %>%
addMapPane(name="polygons", zIndex = 410) %>%
setView( lat=-32.30, lng=116.5 , zoom=9.45) %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
addProviderTiles(providers$Stamen.TonerLabels,
options = leafletOptions(pane = "maplabels"),
group = "map labels")
})
#not sure how to use this reactive statement here?
layer <- reactive({LargeSpatialPDF})
observeEvent({input$year}, {
year_column <- paste0('P',input$year)
data=layer()[year_column]
bins <- c(0,1,5, 10,15,20,25,30,Inf)
pal <- colorBin(c("#fff7cf",
"#f7e2af",
"#f2cc91",
"#eeb576",
"#eb9c60",
"#e7824e",
"#e36543",
"#dd433d",
"#d6003d"), domain = LargeSpatialPDF#data[year_column], bins = bins)
leafletProxy("mymap", data = data) %>%
addPolygons(
fillColor = ~pal(x),
weight = 1,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 2,
color = "white",
dashArray = "",
fillOpacity = 1,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))
})
}
shinyApp(ui = ui, server = server)
reactive isn't necessary because LargeSpatialPDF is static.
I think the problems of your code are:
Whrere does x come from in fillColor = ~pal(x) ??
not df["colname"] but df[["colname"]] gives a vector.
clearShapes() is necessary.
Below is my example:
library(shiny)
library(leaflet)
library(sp)
ui <- fillPage(
titlePanel("Title"),
leafletOutput("mymap", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
sliderInput("year", "Year", min = 1, max = 3,
value = 1, step = 1)
)
)
server <- function(input, output, session) {
# sample_data
dsn <- system.file("vectors/ps_cant_31.MIF", package = "rgdal")[1]
LargeSpatialPDF <- rgdal::readOGR(dsn=dsn, layer="ps_cant_31", stringsAsFactors=FALSE)
set.seed(1); LargeSpatialPDF#data <- cbind(LargeSpatialPDF#data,
data.frame(P1 = sample(44), P2 = sample(44), P3 = sample(44)))
output$mymap <- renderLeaflet({
leaflet() %>%
addMapPane(name="polygons", zIndex = 410) %>%
setView( lat=43.5, lng=1.5 , zoom=8 ) %>%
addProviderTiles(providers$Esri.WorldGrayCanvas) %>%
addProviderTiles(providers$Stamen.TonerLabels,
options = leafletOptions(pane = "maplabels"),
group = "map labels")
})
observeEvent({input$year}, {
year_column <- paste0('P',input$year)
bins <- seq(0, 45, length = 9)
pal <- colorBin(c("#fff7cf",
"#f7e2af",
"#f2cc91",
"#eeb576",
"#eb9c60",
"#e7824e",
"#e36543",
"#dd433d",
"#d6003d"), domain = LargeSpatialPDF#data[[year_column]], bins = bins)
leafletProxy("mymap") %>%
clearShapes() %>% # important
addPolygons(
data = LargeSpatialPDF,
fillColor = ~ pal(LargeSpatialPDF#data[[year_column]]), # use values of the year
options = pathOptions(pane = "polygons")) # my guess
})
}
shinyApp(ui = ui, server = server)
I'm building an R Shiny app. I want reactive plots (plotly) that highlight one or more counties when they are clicked on the map (leaflet). When a highlighted county is clicked again, I want it to be removed.
Ideally I'd also like the reverse, where clicking on a bar in the plot also highlights it and the respective county on the map, but that is a lower priority.
I have tried to adapt code from multiple related posts (especially Changing styles when selecting and deselecting multiple polygons with Leaflet/Shiny and R leaflet highlight options), but can't figure it out.
Problems to solve:
Proxy adds new polygons but does not remove when clicked a second time
I want the proxy to have a green outline so that the original choropleth is still visible, but instead it fills it in all white.
I want to apply the same type of proxy update to the plotly bar chart, but I'm waiting to do that until I figure it out with the leaflet.
Here is a simple reprex using a dummy dataset and percent variable like what I will be using.
#MAP REPREX
library(sf)
library(shiny)
library(tidyverse)
library(leaflet)
library(leaflet.extras)
library(tidycensus)
library(plotly)
library(htmltools)
# GET DATA
NC_counties <- tigris::counties("North Carolina", cb=TRUE, year=2018)%>% st_as_sf()%>% st_transform(crs=4326)
NC_counties <- NC_counties %>% mutate(
pct_water = AWATER/(ALAND+AWATER)*100)
# UI
ui <- fluidPage(
tabsetPanel(id="page1",
tabPanel("Data Tracker",
fluidRow(column(6, leafletOutput("my_map", height = 300)),
column(6, plotlyOutput("comp_bars", height=300))),
tabPanel("About the data")))
)
# SERVER
server <- function(input,output, session){
# CHOROPLETH MAP OF NC COUNTIES
output$my_map = renderLeaflet({
data <- NC_counties
var <- NC_counties$pct_water
bins <- c(0,1,5,10,50,100)
pal <- colorBin(palette = c("#dde4e6","#547980"),
domain = var,
bins = bins,
na.color="#cfcfcf")
labels <- sprintf("%s County", data$NAME)%>% lapply(htmltools::HTML)
leaflet(data,
options=leafletOptions(minZoom=6, maxZoom=6, zoomControl=FALSE))%>%
setView(-80, 34.7, 6) %>%
setMapWidgetStyle(list(background= "white"))%>%
addPolygons(
fillColor = ~pal(var),
fillOpacity = 1,
color = "white",
weight = 1,
layerId=~GEOID,
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto")) %>%
addLegend(pal = pal,
values = ~var,
opacity = 1,
title = "Percent water",
position = "bottomleft")
})
# I WANT A PROXY MAP THAT UPDATES TO HIGHLIGHT ONE OR MORE COUNTIES (THAT GET REMOVED ON THE SECOND CLICK)
clicklist <- reactiveValues(ids=vector())
observe({
click <- input$my_map_shape_click
clicklist$ids <- c(clicklist$ids, click$id)
selected <- NC_counties[as.character(NC_counties$GEOID) %in% clicklist$ids, ]
proxy <- leafletProxy("my_map")
proxy %>%
addPolygons(data = selected,
layerId = ~GEOID,
color = "#9DE0AD",
weight = 3,
opacity = 1,
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto"))
})
# TOTAL CLAIMS BY COUNTY LINE CHART
output$comp_bars <- renderPlotly({
NC_counties$NAME <- factor(NC_counties$NAME, levels = unique(NC_counties$NAME)[order(NC_counties$pct_water)])
ylabs <- list(
title = NULL,
showticklabels = FALSE
)
fig <- plot_ly(
x=NC_counties$pct_water,
y=NC_counties$NAME,
name = "Percent water",
type = "bar",
orientation = 'h',
marker = list(color = "#cfcfcf"))
fig <- fig %>% layout(yaxis=ylabs)
fig
})
# UPDATE BAR CHART WITH SELECTED POLYGONS
observeEvent(input$my_map_shape_click, {
click <- input$my_map_shape_click
clicklist$ids <- c(clicklist$ids, click$id)
selected <- NC_counties[GEOID %in% clicklist$ids, ]
})
}
# SHINY APP
shinyApp(ui, server)
#MAP REPREX
library(sf)
library(shiny)
library(tidyverse)
library(leaflet)
library(leaflet.extras)
library(tidycensus)
library(plotly)
library(htmltools)
# GET DATA
NC_counties <- tigris::counties("North Carolina", cb=TRUE, year=2018)%>% st_as_sf()%>% st_transform(crs=4326)
NC_counties <- NC_counties %>% mutate(
pct_water = AWATER/(ALAND+AWATER)*100)
# UI
ui <- fluidPage(
tabsetPanel(id="page1",
tabPanel("Data Tracker",
fluidRow(column(6, leafletOutput("my_map", height = 300)),
column(6, plotlyOutput("comp_bars", height=300))),
tabPanel("About the data")))
)
# SERVER
server <- function(input,output, session){
# CHOROPLETH MAP OF NC COUNTIES
output$my_map = renderLeaflet({
data <- NC_counties
var <- NC_counties$pct_water
bins <- c(0,1,5,10,50,100)
pal <- colorBin(palette = c("#dde4e6","#547980"),
domain = var,
bins = bins,
na.color="#cfcfcf")
labels <- sprintf("%s County", data$NAME)%>% lapply(htmltools::HTML)
leaflet(data,
options=leafletOptions(minZoom=6, maxZoom=6, zoomControl=FALSE))%>%
setView(-80, 34.7, 6) %>%
setMapWidgetStyle(list(background= "white"))%>%
addPolygons(
fillColor = ~pal(var),
fillOpacity = 1,
color = "white",
weight = 1,
layerId=~GEOID,
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto")) %>%
addLegend(pal = pal,
values = ~var,
opacity = 1,
title = "Percent water",
position = "bottomleft")
})
# I WANT A PROXY MAP THAT UPDATES TO HIGHLIGHT ONE OR MORE COUNTIES (THAT GET REMOVED ON THE SECOND CLICK)
clicklist <- reactiveValues(ids=vector())
observeEvent(input$my_map_shape_click, {
click <- input$my_map_shape_click
proxy <- leafletProxy("my_map")
# gather previous and new clicks in single vector
clicklist$ids <- c(clicklist$ids, click$id)
# subset data
selected <- NC_counties[as.character(NC_counties$GEOID) %in% clicklist$ids, ]
#if the current click ID exists in the clicked polygon (if it has been clicked twice)
if(click$id %in% selected$GEOID){
#define vector that subsets NAME that matches first click ID
duplicates <- selected$GEOID[selected$GEOID == click$id]
# remove the current click$id AND its name match from the selected shapefile
clicklist$ids <- clicklist$ids[!clicklist$ids %in% click$id]
clicklist$ids <- clicklist$ids[!clicklist$ids %in% duplicates]
#remove that highlighted polygon from the map
proxy %>% removeShape(layerId = click$id)
} else {
# map highlighted polygons
proxy %>%
addPolygons(data = selected,
layerId = ~GEOID,
color = "#9DE0AD",
fillOpacity=0,
weight = 3,
opacity = 1,
highlight = highlightOptions(weight = 0,
color = NA,
bringToFront = T),
label = labels,
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto"))
}
})
# TOTAL CLAIMS BY COUNTY LINE CHART
output$comp_bars <- renderPlotly({
NC_counties$NAME <- factor(NC_counties$NAME, levels = unique(NC_counties$NAME)[order(NC_counties$pct_water)])
ylabs <- list(
title = NULL,
showticklabels = FALSE
)
fig <- plot_ly(
x=NC_counties$pct_water,
y=NC_counties$NAME,
name = "Percent water",
type = "bar",
orientation = 'h',
marker = list(color = "#cfcfcf"))
fig <- fig %>% layout(yaxis=ylabs)
fig
})
# UPDATE BAR CHART WITH SELECTED POLYGONS
# to do with plotlyProxy() after map gets resolved
}
# SHINY APP
shinyApp(ui, server)
Currently i've managed to align the data with the shape file and plot each region to the map. The polygon is added layer to segregate each region giving more information to whats going on in that region.
what i'm trying to do is that, user should be able to click on the polygon and this should update the inputselect option.
i tried to use Observe() with updateselectinput() but i dont think its working
library(leaflet)
library(leaflet.extras)
library(rgdal)
library(shiny)
library(shinydashboard)
sgmap55 <-readOGR("https://raw.githubusercontent.com/aeiyuni/regioncount/master/55_MP14_PLNG_AREA_WEB_PL.kml")
wfmap <- read.csv("https://raw.githubusercontent.com/aeiyuni/regioncount/master/wfmap.csv")
## to check if all the data matches
bins <-c(1,50,100,150,200,250,300,350,400,450,500)
pal <- colorBin("YlGnBu", domain = wfmap$count, bins = bins, na.color = "#808080")
labels <- sprintf(
"<strong>%s</strong><br/>%g respondents </sup>",
wfmap$planarea, wfmap$count
) %>% lapply(htmltools::HTML)
##_----------------------------
ui<- fluidPage(
sidebarPanel(
selectInput("region", "Planning Area:",
choices = wfmap$planarea)
),
mainPanel(
leafletOutput("sgmap2", height= "1000px"))
)
server <- function(input, output, session){
output$sgmap2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addSearchOSM()%>%
addResetMapButton()%>%
clearMarkers()%>%
addProviderTiles("OpenStreetMap") %>%
setView(103.8198,1.3521,12) %>%
addPolygons(data = sgmap55,
weight = 1,
color = "white",
smoothFactor = 0.5,
fillOpacity = 0.8,
fillColor = pal(wfmap$count),
highlight = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal",
padding = "3px 8px"),
textsize = "15px",
direction = "auto"),
group = "By region")%>%
addLegend(pal = pal,
values = wfmap$count,
opacity = 0.7,
position = "topright")
})
###<<<< observe() code here
}
shinyApp(ui, server)
When i added Observe(), it stop working.
##trial code starts here----
observe({
event <- input$insgmap2_shape_click
updateSelectInput(session, inputId = "region", selected = event$Name
)
})
## trial code end here------
Here you go. As per my comment, you need to specify the layerId as the ~Name. This will then be returned in the id field of the click event.
You also had an error in your observe() event. You weren't referencing the correct map name. I've fixed this for you (see my comment in the observe() function)
I've also included a print(event) statement so you can see the data that gets returned when you click on the layer
library(leaflet)
library(leaflet.extras)
library(rgdal)
library(shiny)
library(shinydashboard)
sgmap55 <- readOGR("https://raw.githubusercontent.com/aeiyuni/regioncount/master/55_MP14_PLNG_AREA_WEB_PL.kml")
wfmap <- read.csv("https://raw.githubusercontent.com/aeiyuni/regioncount/master/wfmap.csv")
bins <-c(1,50,100,150,200,250,300,350,400,450,500)
pal <- colorBin("YlGnBu", domain = wfmap$count, bins = bins, na.color = "#808080")
labels <- sprintf(
"<strong>%s</strong><br/>%g respondents </sup>",
wfmap$planarea, wfmap$count
) %>% lapply(htmltools::HTML)
ui<- fluidPage(
sidebarPanel(
selectInput("region", "Planning Area:",
choices = wfmap$planarea)
),
mainPanel(
leafletOutput("sgmap2", height= "1000px"))
)
server <- function(input, output, session){
output$sgmap2 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addSearchOSM()%>%
addResetMapButton()%>%
clearMarkers()%>%
addProviderTiles("OpenStreetMap") %>%
setView(103.8198,1.3521,12) %>%
addPolygons(data = sgmap55,
weight = 1,
color = "white",
smoothFactor = 0.5,
fillOpacity = 0.8,
fillColor = pal(wfmap$count),
highlight = highlightOptions(
weight = 5,
color = "#666666",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal",
padding = "3px 8px"),
textsize = "15px",
direction = "auto"),
group = "By region",
layerId = ~Name
) %>%
addLegend(pal = pal,
values = wfmap$count,
opacity = 0.7,
position = "topright")
})
observe({
## the sgmap2 needs to match the name of the map you're outputting above
event <- input$sgmap2_shape_click
print( event )
updateSelectInput(session, inputId = "region", selected = event$id
)
})
}
shinyApp(ui, server)
I am trying to build an interactive Choropleth in Shiny using leaflet. However, the load time and recreate time is really slow. Any way to speed it up.
Here is a link to the entire app folder along with the data:
https://www.dropbox.com/home/Leaflet_Shiny_app
global.R
library(shinydashboard)
library(tidyverse)
library(ggvis)
library(leaflet)
library(WDI)
library(sp)
ui.R
header <- dashboardHeader(
title = "Greenhouse gas (GHG) emissions"
)
## Sidebar content
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Interactive Choropleth", tabName = "choropleth")
)
)
## Body content
body <- dashboardBody(
# First tab content
tabItem("choropleth",
fluidRow(
column(width = 9,
box(width = NULL, solidHeader = TRUE,
title = "Greenhouse gas emissions (kt of CO2 equivalent)",
leafletOutput("choropleth_ghg", height = 500)
)
),
column(width = 3,
box(width = NULL, status = "warning",
selectInput("year", "Year",
choices = seq(1970, 2012, 1),
selected = 2012)
)
)
)
)
)
dashboardPage(
header,
sidebar,
body
)
server.R
# Read the dataset for choropleth
# From http://data.okfn.org/data/core/geo-countries#data
countries <- geojsonio::geojson_read("json/countries.geojson", what = "sp")
# Download the requested data by using the World Bank's API,
# parse the resulting JSON file, and format it in long country-year format.
load("who_ghg.RData")
function(input, output, session) {
# Interactive Choropleth map.........................................................
# Reactive expression for the data subsetted to what the user selected
countries_plus_ghg <- reactive({
# Filter the data to select for the year user selected
who_ghg_subset <- filter(who_ghg, year == input$year)
# Merge a Spatial object having a data.frame for Choropleth map
sp::merge(countries, who_ghg_subset,
by.x = "ISO_A3", by.y = "iso3c")
})
# Create the map
output$choropleth_ghg <- renderLeaflet({
leaflet(countries) %>%
setView(0, 20, zoom = 1) %>%
addTiles()
})
# Observer to change the color of countries, labels and legends
# based on the year user selects in the UI
observe({
dat <- countries_plus_ghg()
# Define numeric vector bins to add some color
bins <- ggplot2:::breaks(c(min(dat$EN.ATM.GHGT.KT.CE, na.rm = TRUE)
,max(dat$EN.ATM.GHGT.KT.CE, na.rm = TRUE)),
"width",n = 5)
# Call colorBin to generate a palette function that maps the RColorBrewer
#"YlOrRd" colors to our bins.
pal <- colorBin("YlOrRd",
domain = dat$EN.ATM.GHGT.KT.CE,
bins = bins)
# Generate the labels with some HTML
labels <- sprintf(
"<strong>%s</strong><br/>%g",
dat$country, dat$EN.ATM.GHGT.KT.CE
) %>% lapply(htmltools::HTML)
leafletProxy("choropleth_ghg", data = dat) %>%
addPolygons(
fillColor = ~pal(EN.ATM.GHGT.KT.CE),
weight = 1,
opacity = 1,
color = "white",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 2,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
clearControls() %>%
addLegend(pal = pal, values = ~EN.ATM.GHGT.KT.CE, opacity = 0.7, title = NULL,
position = "bottomleft")
})
}
Simplifying geometries using rmapshaper::ms_simplify helped make it a lot faster.
This is what I did-
# Topologically-aware geometry simplification using rmapshaper package,
# keep = proportion of points to retain
countries_simple <- rmapshaper::ms_simplify(countries, keep = 0.05, keep_shapes = TRUE)
I used countries_simple instead of countries in the code then.