I'm a Rshiny newbie very eager to learn but right now I'm facing an issue I cannot overcome alone and I would greatly appreciate if someone could help me out ! :)
My problem is (I guess) quite simple:
I have created a map with my polygons and I've managed to display some basic informations when I click on them (have a look on here) but I have no idea how to add a barplot (for example) below my map for each polygon I click.
Could someone help me on how doing that please ? (after hours and hours of attempts my eyesballs are really about to pop out of their sockets !!!)
Many thanks in advance !
Romain
My code:
library(shiny)
library(leaflet)
library(dplyr)
library(magrittr)
library(devtools)
library(RColorBrewer)
library(rgdal)
library(sp)
communes <- readOGR("G:/Ateliers/Projet/communes.shp")
commmunes#data
nom_commune INSEE Variable_1 Variable_2 Variable_3 area_sqkm
1 AUZEVILLE-TOLOSANE 31035 289 8.727212 9.336384 6.979758
2 CASTANET-TOLOSAN 31113 85 4.384877 8.891650 8.460724
3 LABEGE 31254 288 5.047406 2.031651 7.663404
4 PECHBUSQUE 31411 443 6.577743 8.120896 3.099422
5 RAMONVILLE-SAINT-AGNE 31446 95 2.601305 8.909278 6.236784
>
ui <- fluidPage(
leafletOutput("mymap"))
#### SERVEUR R #####
bins <- c(3,3.5,6,6.5,7,7.5,8,8.5)
pal <- colorBin("YlOrRd", domain = communes$area_sqkm, bins = bins)
labels <- sprintf(
"<strong>%s</strong><br/>%g km2",
communes$nom_commun, communes$area_sqkm
) %>% lapply(htmltools::HTML)
server <- function(input, output, session) {
output$mymap<-renderLeaflet(
leaflet(communes) %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE)
) %>%
setView(1.50, 43.54, zoom = 12) %>%
addTiles() %>%
addPolygons(fillColor = ~pal(area_sqkm),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = labels,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(pal = pal, values = ~area_sqkm, opacity = 0.7, title = NULL,
position = "bottomright")
)
}
shinyApp(ui = ui, server=server)
The data I would like to display in my barplots are the variable 1,2 and 3 :
data <- read.csv("G:/Ateliers/Projet/communes.csv", sep=";")
data
nom_commune INSEE Variable_1 Variable_2 Variable_3 area_sqkm
1 AUZEVILLE-TOLOSANE 31035 289 8.727212 9.336384 6.979758
2 CASTANET-TOLOSAN 31113 85 4.384877 8.891650 8.460724
3 LABEGE 31254 288 5.047406 2.031651 7.663404
4 PECHBUSQUE 31411 443 6.577743 8.120896 3.099422
5 RAMONVILLE-SAINT-AGNE 31446 95 2.601305 8.909278 6.236784
>
Here is an example shiny app with other data, since I do not have access to your shape data for the map. I believe this might do what you need it to do and can be adapted for your needs.
I would create a reactiveVal to store the id of the polygon region that is clicked on (this variable stores input$mymap_shape_click$id). You data used in addPolygons should have an id to reference.
In your plot (or in a separate reactive expression), you can filter the data based on the reactiveVal containing the id.
library(shiny)
library(leaflet)
library(rgdal)
library(sf)
library(ggplot2)
library(tidyverse)
arcgis_data = st_read("http://data.phl.opendata.arcgis.com/datasets/bc2b2e8e356742568e43b0128c344d03_0.geojson")
arcgis_data$id <- 1:nrow(arcgis_data) ## Add an 'id' value to each shape
plot_data <- read.table(text =
"id nom_commune INSEE Variable_1 Variable_2 Variable_3 area_sqkm
1 AUZEVILLE-TOLOSANE 31035 289 8.727212 9.336384 6.979758
2 CASTANET-TOLOSAN 31113 85 4.384877 8.891650 8.460724
3 LABEGE 31254 288 5.047406 2.031651 7.663404
4 PECHBUSQUE 31411 443 6.577743 8.120896 3.099422
5 RAMONVILLE-SAINT-AGNE 31446 95 2.601305 8.909278 6.236784", header = T, stringsAsFactors = F
)
ui <- fluidPage(
leafletOutput(outputId = "mymap"),
plotOutput(outputId = "myplot")
)
server <- function(input, output){
## use reactive value to store the id from observing the shape click
rv <- reactiveVal()
output$mymap <- renderLeaflet({
leaflet() %>%
addPolygons(data = arcgis_data %>% slice(1:5), layerId = ~id) %>%
addProviderTiles("CartoDB.Positron")
})
observeEvent(input$mymap_shape_click, {
rv(input$mymap_shape_click$id)
})
## you can now plot your plot based on the id of region selected
output$myplot <- renderPlot({
plot_data %>%
filter(id == rv()) %>%
pivot_longer(cols = starts_with("Variable"), names_to = "Variable", values_to = "Value") %>%
ggplot(aes(x = Variable, y = Value)) +
geom_col()
})
}
shinyApp(ui, server)
Edit: For your uploaded data, you don't need to add a separate id for communes. Instead, you could match by name (nom_commune). You can use that in your layerId instead. This looks like it should work. I did take out some of the additional label information as this appeared to be missing from the .shp file I downloaded.
library(shiny)
library(leaflet)
library(rgdal)
library(sf)
library(ggplot2)
library(tidyverse)
communes <- readOGR("communes_ok.shp")
ui <- fluidPage(
leafletOutput(outputId = "mymap"),
plotOutput(outputId = "myplot")
)
server <- function(input, output){
## use reactive values to store the id from observing the shape click
rv <- reactiveVal()
output$mymap<-renderLeaflet(
leaflet(communes) %>%
addProviderTiles(providers$Stamen.TonerLite,
options = providerTileOptions(noWrap = TRUE)) %>%
setView(1.50, 43.54, zoom = 12) %>%
addTiles() %>%
addPolygons(fillColor = "blue",
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.3,
highlight = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
layerId = ~nm_cmmn)
)
observeEvent(input$mymap_shape_click, {
rv(input$mymap_shape_click$id)
})
## you can now 'output' your generated data however you want
output$myplot <- renderPlot({
if (is.null(rv())) return (NULL)
plot_data %>%
filter(nom_commune == rv()) %>%
pivot_longer(cols = starts_with("Variable"), names_to = "Variable", values_to = "Value") %>%
ggplot(aes(x = Variable, y = Value)) +
geom_col()
})
}
shinyApp(ui, server)
Related
I'm working on a shiny app with basic functionality like this:
library(sf)
library(DT)
library(leaflet)
library(shiny)
library(tidyverse)
nc <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = T) %>%
st_transform(4326) %>%
select(NAME, geometry, id = CNTY_ID) %>%
mutate(x = rnorm(n = nrow(.), mean = 100, sd = 20),
fill = sample(c("green", "red"), n(), replace = T),
fill_2 = if_else(fill == "green", "red", "green"))
# Function to change fill color on click event (taken from https://stackoverflow.com/a/69618323)
change_color <- function(map, id_to_remove, data, colour, new_group){
leafletProxy(map) %>%
removeShape(id_to_remove) %>% # remove previous occurrence
addPolygons(
data = data,
layerId = data$id,
group = new_group, # change group
fillColor = colour,
color = "black",
weight = 1,
fillOpacity = 1)
}
## UI
ui <- fluidPage(
leafletOutput("map"),
DT::dataTableOutput("table")
)
## Server
server <- function(input,output,session){
# Reactives
rv <- reactiveValues(
df = nc,
df.tab = as.data.frame(nc)
)
# Initial map
output$map <- renderLeaflet({
leaflet() %>%
setView(-79.99, 35.52, zoom = 7)
})
observe({
data <- rv$df
leafletProxy("map") %>%
addPolygons(
data = data,
weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill,
layerId = data$id,
group = "unclicked_poly")
})
#first click
observeEvent(input$map_shape_click, {
# execute only if the polygon has never been clicked
req(input$map_shape_click$group == "unclicked_poly")
# filter data
data <- rv$df[rv$df$id==input$map_shape_click$id,]
change_color(map = "map",
id_to_remove = input$map_shape_click$id,
data = data,
colour = ~fill_2,
new_group = "clicked1_poly")
})
#second click: reverse first click
observeEvent(input$map_shape_click, {
req(input$map_shape_click$group == "clicked1_poly")
data <- rv$df[rv$df$id==input$map_shape_click$id,]
leafletProxy("map") %>%
removeShape(input$map_shape_click$id) %>% # remove previous occurrence
addPolygons(
data = data,
weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill,
layerId = data$id,
group = "unclicked_poly") # back to initialize group
})
output$table <- DT::renderDataTable({
rv$df.tab %>%
group_by(fill) %>%
summarise(x = sum(x))
})
}
shinyApp(ui, server)
The idea here is that the user can change the fill color of the polygons with the click of a button. This works as is. However, I also want to dynamically display the fill-specific sum of x in the data tabe below the leaflet map. Currently, the table shows the grouped sums according to the initial data frame. However, when a user changes a polygon from green to red, the calculation should be done anew.
I have tried implementing this idea using a logic similar to the observeEvents() in output(map), but the problem here was that I could only ever access the last click, so previous clicks would not factor into the grouped sums calculation (group_by(fill) %>% summarise(x = sum(x))). Ideally, I would like to have information on whatever the current fill of all polygons is so that the data table reflects the user's input.
I ended up solving this problem in four steps:
Recording each click on a polygon using reactiveValues(Clicks=vector())
Converting vector into data frame, with click frequency determined by table()
Using modulo division on the number of clicks with the %% operator to ascertain current fill color on map (the number of fill options is much higher than two in my real world application)
Merging clicked and unclicked polygons to obtain current map status and using DT::dataTableProxy() to update table
App is now working as intended. Code:
library(sf)
library(DT)
library(leaflet)
library(shiny)
library(tidyverse)
nc <- st_read(system.file("shape/nc.shp", package = "sf"), quiet = T) %>%
st_transform(4326) %>%
select(NAME, geometry, id = CNTY_ID) %>%
mutate(x = rnorm(n = nrow(.), mean = 100, sd = 20),
fill = sample(c("green", "red"), n(), replace = T),
fill_2 = if_else(fill == "green", "red", "green"))
# Function to change fill color on click event (taken from https://stackoverflow.com/a/69618323)
change_color <- function(map, id_to_remove, data, colour, new_group){
leafletProxy(map) %>%
removeShape(id_to_remove) %>% # remove previous occurrence
addPolygons(
data = data,
layerId = data$id,
group = new_group, # change group
fillColor = colour,
color = "black",
weight = 1,
fillOpacity = 1)
}
## UI
ui <- fluidPage(
leafletOutput("map"),
DT::dataTableOutput("table")
)
## Server
server <- function(input,output,session){
# Reactives
rv <- reactiveValues(
df = nc,
df.tab = as.data.frame(nc)
)
# Initial map
output$map <- renderLeaflet({
leaflet() %>%
setView(-79.99, 35.52, zoom = 7)
})
observe({
data <- rv$df
leafletProxy("map") %>%
addPolygons(
data = data,
weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill,
layerId = data$id, label = ~id,
group = "unclicked_poly")
})
#first click
observeEvent(input$map_shape_click, {
# execute only if the polygon has never been clicked
req(input$map_shape_click$group == "unclicked_poly")
# filter data
data <- rv$df[rv$df$id==input$map_shape_click$id,]
change_color(map = "map",
id_to_remove = input$map_shape_click$id,
data = data,
colour = ~fill_2,
new_group = "clicked1_poly")
})
#second click: reverse first click
observeEvent(input$map_shape_click, {
req(input$map_shape_click$group == "clicked1_poly")
data <- rv$df[rv$df$id==input$map_shape_click$id,]
leafletProxy("map") %>%
removeShape(input$map_shape_click$id) %>% # remove previous occurrence
addPolygons(
data = data,
weight = 1, color = "black", fillOpacity = 1, fillColor = ~fill,
layerId = data$id, label = ~id,
group = "unclicked_poly") # back to initialize group
})
output$table <- DT::renderDataTable({
rv$df.tab %>%
group_by(fill) %>%
summarise(x = sum(x)) -> sum
sum
})
proxy <- DT::dataTableProxy("table")
RV<-reactiveValues(Clicks=vector())
observeEvent(input$map_shape_click, {
#create object for clicked polygon
click <- input$map_shape_click
RV$Clicks<- c(RV$Clicks,click$id)
test <- as.data.frame(table(RV$Clicks)) %>%
mutate(current = Freq %% 2,
id = as.double(as.character(Var1)))
rv$df.tab %>%
full_join(test, by = "id") %>%
mutate(fill = case_when(current == 1 ~ fill_2,
TRUE ~ fill)) %>%
group_by(fill) %>%
summarise(x = sum(x)) -> sum
proxy %>% replaceData(sum)
})
}
shinyApp(ui, server)
at the moment I try to create an interactive heatmap in R with apexcharter. This works fine at manual chart creation but fails on interactive use within shiny.
library(shiny)
library(tidyverse)
library(apexcharter)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Test Heatmap"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
selectInput(
inputId = "heatmap_filter",
label = "heatmap filter",
choices = c(1999, 2008),
selected = 2008
)
),
mainPanel(
apexchartOutput("heatmap")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$heatmap <- renderApexchart({
df <- mpg %>% filter(year == input$heatmap_filter) %>% mutate_if(is.character, as.factor) %>% group_by(manufacturer, class) %>% summarise(cnt = n()) %>% tidyr::complete(class, fill = list(cnt = 0))
q20 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[2],0)
q40 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[3],0)
q60 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[4],0)
q80 <- round(as.numeric(quantile(df %>% filter(cnt>0) %>% pull(cnt), probs = seq(0,1,0.2), na.rm = TRUE))[5],0)
apex(
data = df,
type = "heatmap",
mapping = aes(x = manufacturer, y = class, fill = cnt)
) %>%
ax_dataLabels(enabled = TRUE) %>%
ax_plotOptions(
heatmap = heatmap_opts(
enableShades = FALSE,
colorScale = list(
ranges = list(
list(from = 0, to = q20, color = "#106e45"), #grün
list(from = q20, to = q40, color = "#90dbba"), #leichtes grün
list(from = q40, to = q60, color = "#fff33b"), #gelb
list(from = q60, to = q80, color = "#f3903f"), # orange
list(from = q80, to = 20, color = "#e93e3a") #rot
)
)
)
) %>%
ax_title(
text = paste("Test interactive heatmap",
input$heatmap_filter
), align = "center"
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
With the manual approach everthing works as expected. But when I change the input select only the values changes but not the heatmap quantil ranges and not the title input. Its seems like the input value is not pushing the changes to already calculated variables. I already tried to use an reactive df or reactive variables but so far nothing works.
I added a minimal example where you could change the year input and this should change the title and the color ranges.
Can you help me?
Thanks in advance.
Try setting auto_update to FALSE in the call to apex
apex(
data = df,
type = "heatmap",
auto_update = FALSE,
...
I am in the process of creating an R flexdashboard. The dashboard contains several maps for Bangladesh, which are linked to a (Highcharts) chart that is activated by clicking on a polygon (e.g. region). I am able to make it work for one page. However, if I set it up for two pages, things no longer work.
It seems that flexdashboard (at least how I set it up) is not able to handle two input$map_shape_click operations at the same time. At the moment it only works on the first page, while the map does not react on the second page although a figure is produced. I welcome any suggestions to make this work.
Below a reproducible example. Note that (1) I omitted the flexdashboard yaml in the example and (2) markdown used by stackoverflow automatically renders the first, second and third header level. They render differently when run in flexdasboard (i.e. A Large Header is a new page in flexdashboard).
# Packages
library(tidyverse)
library(raster)
library(sf)
library(highcharter)
library(leaflet)
library(htmltools)
# Get data
adm1 <- getData('GADM', country='BGD', level=1)
adm1 <- st_as_sf(adm1)
# Create dummy data.frames with link to polygon
df1 <- data.frame(NAME_1 = adm1$NAME_1,
value_1 = c(1:7))
df2 <- data.frame(NAME_1 = adm1$NAME_1,
value_2 = c(8:14))
Page 1
Column {data-width=350}
Map 1
# MAIN MAP --------------------------------------------------------------------------------
output$map <- renderLeaflet({
# Base map
leaflet() %>%
addTiles(group = "OpenStreetMap") %>%
clearShapes() %>%
addPolygons(data = adm1,
smoothFactor = 0,
color = "black",
opacity = 1,
fillColor = "transparent",
weight = 0.5,
stroke = TRUE,
label = ~htmlEscape(NAME_1),
layerId = ~NAME_1,
)
})
leafletOutput('map')
# REGION SELECTION -----------------------------------------------------------------------
# Click event for the map to draw chart
click_poly <- eventReactive(input$map_shape_click, {
x <- input$map_shape_click
y <- x$id
return(y)
}, ignoreNULL = TRUE)
observe({
req(click_poly()) # do this if click_poly() is not null
# Add the clicked poly and remove when a new one is clicked
map <- leafletProxy('map') %>%
removeShape('NAME_1') %>%
addPolygons(data = adm1[adm1$NAME_1 == click_poly(), ],
fill = FALSE,
weight = 4,
color = '#d01010',
opacity = 1,
layerId = 'NAME_1')
})
Column {data-width=350}
Plot 1
data <- reactive({
# Fetch data for the click poly
out <- df1[df1$NAME_1 == click_poly(), ]
print("page 1") # print statement to show which click_poly is used
return(out)
})
output$plot <- renderHighchart({
req(data()) # do this if click_poly() is not null
chart <- highchart() %>%
hc_chart(type = 'column') %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(categories = c('A'),
title = list(text = 'Title 1')) %>%
hc_yAxis(title = list(text = 'Value 1')) %>%
hc_plotOptions(series = list(dataLabels = list(enabled = TRUE))) %>%
hc_add_series(name = 'Series',
data = c(data()$value_1)) %>%
hc_add_theme(hc_theme_smpl()) %>%
hc_colors(c('#d01010'))
})
highchartOutput('plot')
Page 2
Column {data-width=350}
Map 2
# MAIN MAP --------------------------------------------------------------------------------
output$map2 <- renderLeaflet({
# Base map
leaflet() %>%
addTiles(group = "OpenStreetMap") %>%
clearShapes() %>%
addPolygons(data = adm1,
smoothFactor = 0,
color = "black",
opacity = 1,
fillColor = "transparent",
weight = 0.5,
stroke = TRUE,
label = ~htmlEscape(NAME_1),
layerId = ~NAME_1,
)
})
leafletOutput('map2')
# REGION SELECTION -----------------------------------------------------------------------
# Click event for the map to draw chart
click_poly2 <- eventReactive(input$map_shape_click, {
x <- input$map_shape_click
y <- x$id
return(y)
}, ignoreNULL = TRUE)
observe({
req(click_poly2()) # do this if click_poly() is not null
# Add the clicked poly and remove when a new one is clicked
map <- leafletProxy('map2') %>%
removeShape('NAME_1') %>%
addPolygons(data = adm1[adm1$NAME_1 == click_poly2(), ],
fill = FALSE,
weight = 4,
color = '#d01010',
opacity = 1,
layerId = 'NAME_1')
})
Column {data-width=350}
Plot 2
data2 <- reactive({
# Fetch data for the click poly
out <- df2[df2$NAME_1 == click_poly2(), ]
print("page 2") # print statement to show which click_poly is used
return(out)
})
output$plot2 <- renderHighchart({
req(data2()) # do this if click_poly() is not null
chart <- highchart() %>%
hc_chart(type = 'column') %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(categories = c('A'),
title = list(text = 'Title 2')) %>%
hc_yAxis(title = list(text = 'Value 2')) %>%
hc_plotOptions(series = list(dataLabels = list(enabled = TRUE))) %>%
hc_add_series(name = 'Series',
data = c(data2()$value_2)) %>%
hc_add_theme(hc_theme_smpl()) %>%
hc_colors(c('#d01010'))
})
highchartOutput('plot2')
In your click_poly2 <- eventReactive(input$map_shape_click, you have click_poly2 being the 2nd map, but you have the same map_shape_click, what if you made it map_shape_click2, hopefully flexdashboard will handle it differently as now they are 2 different maps
I figured out the answer myself following a similar question I found somewhere else. As I am quite new to shiny and based my code on examples I found, I did not realize that 'map_shape_click' applies 'shape_click' on 'map' where 'map' corresponds with the map in output$map. As I have two maps: map and map2, the eventReactive statement for page2 should be changed into
click_poly2 <- eventReactive(input$map2_shape_click, {
x <- input$map2_shape_click
y <- x$id
return(y)
}, ignoreNULL = TRUE)
Now responding to a shape_click on map2
With the code below I get my dataframe with US county data
library(raster)
library(leaflet)
library(tidyverse)
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE)
My object is to crate an interactive leaflet choropleth map of Avg_yield so first I fortify my USA polygon data
library(rgeos)
library(maptools)
library(ggplot2)
states.shp.f <- fortify(USA, region = "NAME_2")
Then I subset my dataset and merge it with the fortified:
mydata2<-mydata[,c("COUNTY_NAME","Avg_yield")]
colnames(mydata2)[1]<-"id"
## merge shape file with data
merge.shp.coef <- merge(states.shp.f, mydata2, by = "id")
but now I have a dataset with every county name many times and also some counties have different values of Avg_yield. Whats the proper way to process those data in order to use the leaflet code like:
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(data = USA, stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydata$Avg_yield),
popup = paste("Region: ", USA$NAME_2, "<br>",
"Avg_yield: ", mydata$Avg_yield, "<br>")) %>%
addLegend(position = "bottomleft", pal = mypal, values = mydata$Avg_yield,
title = "Avg_yield",
opacity = 1)
The propoer way to do this is to transform your polygon object into a sf object
with st_as_sf()
Here you have a working example :
(I did used some other data for the polygon, I thought yours too precise and require a lot of resources, plus I made it work with shiny)
library(leaflet)
library(tidyverse)
library(ggplot2)
library(sf)
library(shiny)
USA <- st_read(dsn = '[your path]/cb_2018_us_county_500k.shp')
### Get data
mydata <- read.csv("https://www.betydb.org/miscanthus_county_avg_yield.csv",
stringsAsFactors = FALSE)
states_sf <- st_as_sf(USA)
mydata2<-mydata[,c("COUNTY_NAME","Avg_yield")]
colnames(mydata2)[1]<-"NAME"
## merge shape file with data
states_sf_coef <- left_join(states_sf, mydata2, by = "NAME")
ui <- fluidPage(
leafletOutput("map", height = "100vh")
)
server <- function(input, output, session) {
bins <- c(0, 5, 10, 15, 20, 25, 30, 35, 40)
mypal <- colorBin("YlOrRd", domain = states_sf_coef$Avg_yield, bins = bins)
#Sortie map
output$map <- renderLeaflet({
leaflet()%>%
addProviderTiles("OpenStreetMap.Mapnik")%>%
setView(lat = 39.8283, lng = -98.5795, zoom = 4) %>%
addPolygons(
data = states_sf_coef,
fillColor = ~mypal(states_sf_coef$Avg_yield),
stroke = FALSE,
smoothFactor = 0.2,
fillOpacity = 0.3,
popup = paste("Region: ", states_sf_coef$NAME_2, "<br>",
"Avg_yield: ", states_sf_coef$Avg_yield, "<br>"))%>%
addLegend(position = "bottomleft",
pal = mypal,
values = states_sf_coef$Avg_yield,
title = "Avg_yield",
opacity = 1)
})
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
AIM
Create a leaflet map using Shiny that represents one set of data with circle marker and add a markers for points using a second set of data.
ISSUE
The "circle" markers are working, but "markers" are not. The "addMarkers" code is not being read or is being ignored.
SERVER
library(shiny)
library(leaflet)
server <- function(input, output, session) {
points <- read.csv(textConnection("Loc,STZip,Lat,Long,Vol
Loc1,17699,40.0185,-76.297582,15
Loc2,76177,32.949819,-97.31406,20
Loc3,27801,35.935125,-77.77076,17
Loc4,52404,41.947335,-91.68819,12
Loc5,19380,39.983108,-75.59332,18
"))
newpoints <- read.csv(textConnection("Loc,STZip,Lat,Long,Vol
Loc6,18640,41.317242,-75.77942,12
Loc7,38133,35.208709,-89.80518,20
"))
output$mymap <- renderLeaflet({
leaflet() %>%
addProviderTiles("Stamen.TonerLite",
options = providerTileOptions(noWrap = TRUE)) %>%
addCircleMarkers(lng = ~Long, lat = ~Lat, radius = ~Vol, layerId = NULL,
group = "NGS_Facilities", stroke = TRUE, color = "#0000CC", weight = 5, opacity = 0.5,
fill = TRUE, fillColor = "#0000CC", fillOpacity = 0.2, dashArray = NULL,
popup = ~Loc, options = pathOptions(), clusterOptions = NULL, clusterId = NULL,
data = (newpoints)) %>%
#this code is not being read or is ignored...
addMarkers(lng = ~Long, lat = ~Lat, popup = ~Loc, data = (newpoints))
})
}
UI
library(shiny)
library(leaflet)
r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()
ui <- fluidPage(
title = "Map of Stuff",
leafletOutput("mymap", width = 1800, height = 800),
p()
)
This is a weird error... fought with it for a while, until I realized it was a problem with how you read your data.
> newpoints
Loc STZip Lat Long Vol
1 Loc6 18640 41.31724 -75.77942 12
2 Loc7 38133 35.20871 -89.80518 20
3 NA NA NA NA
Because your end quote is on a new line, it leaves a break. This causes the last line in your data to be NAs. When I was debugging, it seemed like anything I put before the data would display, but after would fail.
To fix this, read your data as:
points <- read.csv(textConnection("Loc,STZip,Lat,Long,Vol
Loc1,17699,40.0185,-76.297582,15
Loc2,76177,32.949819,-97.31406,20
Loc3,27801,35.935125,-77.77076,17
Loc4,52404,41.947335,-91.68819,12
Loc5,19380,39.983108,-75.59332,18"))
newpoints <- read.csv(textConnection("Loc,STZip,Lat,Long,Vol
Loc6,18640,40.0185,-76.297582,12
Loc7,38133,35.208709,-89.80518,20"))
For whatever reason, Leaflet bugs out if the last row is all NAs