I am trying to make a map using leaflet. I uploaded a shapefile of 216 districts. I also have a dataset with information from 7 out the 216 districts.
I was hoping for the map to have districts that don't have values or 0% in grey saying not enough information". While having districts with actual values (>0%) showing up as colour following their corresponding bins.
When I tried to do upload my dataset and shapfile, I got a map with coloured districts everywhere. Based on my dataset, there are suppose to be 4 districts (>0%) in colour. But this is not what I see on my map.
How do I make sure that only the districts in my dataset light up where it is suppose to light up, without repeating all over the map? (while maintaining the backdrop of all the other districts in grey)
So far this is the code I used to achieved the map:
districtsg <-readOGR("sample/copyfile/Districts/Map_of_Districts_.shp")
districtsg <- sp::spTransform(districtsg, CRS("+proj=longlat +datum=WGS84"))
wpnew <- wpnew [order(match(wpnew$District,districtsg$NAME)),]
bins <- c(0.1,2.0,5.0,10.0,25.0,40.0,50.0)
pal<- colorBin("YlOrRd",domain=wpnew$per.content,bins=bins)
m<- leaflet() %>%
setView(lng = -1.0232,lat=7.9465,zoom = 6) %>%
addProviderTiles(providers$Stamen.Toner) %>%
addPolygons(data =districtsg,
weight = 1,
smoothFactor = 0.5,
color = "White",
fillOpacity = 0.8,
fillColor= ~pal(wpnew$per.content),
highlight = highlightOptions(
weight = 5,
color = "#666666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE
))
m
labels <- paste( "<p>","District:", districtsg$NAME,"</p>",
"<p>", "% of reports that are content:",round(wpnew$per.content,digits = 3),"</p>",
"<p>", "Total reports labelled as a content:",round(wpnew$totalcontent,digits = 3),"</p>",
"<p>", "Total reports from this district:",round(wpnew$totalreports,digits = 3),"</p>",sep = "" )
m<- leaflet() %>%
setView(lng = -1.0232,lat=7.9465,zoom = 6) %>%
addProviderTiles(providers$Stamen.Toner) %>%
addPolygons(data =districtsg,
weight = 1,
smoothFactor = 0.5,
color = "White",
fillOpacity = 0.8,
fillColor= pal(wpnew$per.content),
label = lapply(labels,HTML)) %>%
addLegend(pal=pal,
values = wpnew$per.content,
opacity = 0.7,
"topright")
m
districts totalreports totalcontent per.content
1 Jomoro 4 2 50.00000
2 Ellembelle 2 1 50.00000
3 Tarkwa Nsuaem 1 0 0.00000
4 Bia West 1 0 0.00000
5 Bodi 2 0 0.00000
6 Accra Metropolis 3 1 33.33333
7 Adenta 3 1 33.33333
shapefile can be downloaded here:
https://data.gov.gh/dataset/shapefiles-all-districts-ghana-2012-216-districts
I handling the joining of shape file and the data file differently and I create my base map using tmap. but perhaps this will be helpful.
library(rgdal)
library(tmap)
library(leaflet)
####Access shape map
elem <- readOGR(dsn = "Data/P3Map", layer = "Boundary___ES")
####Preschool Status for Elementary Schools####
schoolAdresses_PK_2021 <- read_excel("Data/P3Map/schoolAdresses_PK_2021.xlsx") %>%
mutate(PreK= factor(PreK)) %>%
clean_names("lower_camel") %>%
mutate(programType = factor(programType))
##### Merge shape with PreK info######
map <- merge(elem, by.x = "ES_Name", schoolAdresses_PK_2021, by.y = "esName" )
#### Render Map####
MyColors <- c('#e2a331', '#d3d3d3','#3688c8') #yellow, #grey, #blue
PKMap <- tm_shape(map)+
tm_fill(col="preK",
title = " ",
palette = MyColors)+
tm_shape(JeffcoMap)+
tm_borders(col = "white")+
tm_layout("Jeffco PreK Expansion 2019-2020", legend.text.size = -0.5)+
tm_text(text = "ES_ShortNa", size = 0.5, group = "Site Names")
PKMap %>% tmap_leaflet() %>%
setView(lng = -105.10033, lat = 39.6, zoom =9) %>% #lat and long of my district
addProviderTiles('Esri.WorldGrayCanvas', group='Grayscale Map') %>%
addProviderTiles('OpenStreetMap', group='Street Map') %>%
addMarkers(lng = -105.155927, #add marker for PK detached from elementary
lat = 39.746347,
icon = YellowIcon,
label = "Litz",
popup = "<b>Program type:</b><br>Ext. Day",
popupOptions = labelOptions(direction = "bottom",
textsize = "8px"),
group = "Stand alone PreK")
from here you can add leaflet layers
It's tough without your data, but I hope this is helpful. In my case, I am mapping 95 elementary schools in one district.
Your 'districtsg' = My 'elem'
Your 'wpnew' = My 'map'
Example map
Here is my attempt while using your datasets:
library(rgdal)
library(tmap)
library(leaflet)
library(sp)
districtsg <-readOGR('data/Map_of_Districts_216.shp')
wpnew <- read.csv('data/dataFromStack.csv')
map <- sp::merge(x = districtsg, y = wpnew, by = "NAME")
MyColors <- c('#e2a331', '#d3d3d3','#3688c8') #yellow, #grey, #blue
tm_shape(map)+
tm_fill(col="totalcontent",
title = " ",
palette = MyColors)+
tm_shape(districtsg)+
tm_borders(col = "white")
Here is the result that I get.. It does take a moment to render in the R Studio Viewer
Related
I am hoping to create an interactive map that will allow me to create a plot where users can change the year and variable plotted. I've seen the package tmap be used, so I'm imagining something like that, but I'd also take advice for a static map, or another approach to an interactive one. My data is much, much, richer than this, but looks something like:
example <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
life = sample(1:100, 40, replace=TRUE),
income = sample(8000:1000000, 40, replace=TRUE),
pop = sample(80000:1000000, 40, replace=TRUE))
I'd like my output to be a map of ONLY the counties contained in my dataset (in my case, I have all the counties in North Carolina, so I don't want a map of the whole USA), that would show a heatmap of selected variables of interest (in this sample data, year, life, income, and pop. Ideally I'd like one plot with two dropdown-type menus that allow you to select what year you want to view, and which variable you want to see. A static map where I (rather than the user) defines year and variable would be helpful if you don't know how to do the interactive thing.
I've tried the following (taken from here), but it's static, which is not my ideal, and also appears to be trying to map the whole USA, so the part that's actually contained in my data (North Carolina) is very small.
library(maps)
library(ggmap)
library(mapproj)
data(county.fips)
colors = c("#F1EEF6", "#D4B9DA", "#C994C7", "#DF65B0", "#DD1C77",
"#980043")
example$colorBuckets <- as.numeric(cut(example$life, c(0, 20, 40, 60, 80,
90, 100)))
colorsmatched <- example$colorBuckets[match(county.fips$fips, example$fips)]
map("county", col = colors[colorsmatched], fill = TRUE, resolution = 0,
lty = 0, projection = "polyconic")
Here's almost the whole solution. I had hoped some package would allow mapping to be done by fips code alone, but haven't found one yet. You have to download shapefiles and merge them by fips code. This code does everything I wanted above except allow you to also filter by year. I've asking that question here, so hopefully someone will answer there.
# get shapefiles (download shapefiles [here][1] : http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip )
usgeo <- st_read("~/cb_2014_us_county_5m/cb_2014_us_county_5m.shp") %>%
mutate(fips = as.numeric(paste0(STATEFP, COUNTYFP)))
### alternatively, this code *should* allow you download data ###
### directly, but somethings slightly wrong. I'd love to know what. ####
# temp <- tempfile()
# download.file("http://www2.census.gov/geo/tiger/GENZ2014/shp/cb_2014_us_county_5m.zip",temp)
# data <- st_read(unz(temp, "cb_2014_us_county_5m.shp"))
# unlink(temp)
########################################################
# create fake data
example <- data.frame(fips = rep(as.numeric(c("37001", "37003", "37005", "37007", "37009", "37011", "37013", "37015", "37017", "37019"), 4)),
year = c(rep(1990, 10), rep(1991, 10), rep(1992, 10), rep(1993, 10)),
life = sample(1:100, 40, replace=TRUE),
income = sample(8000:1000000, 40, replace=TRUE),
pop = sample(80000:1000000, 40, replace=TRUE))
# join fake data with shapefiles
example <- st_as_sf(example %>%
left_join(usgeo))
# drop layers (not sure why, but won't work without this)
example$geometry <- st_zm(example$geometry, drop = T, what = "ZM")
# filter for a single year (which I don't want to have to do)
example <- example %>% filter(year == 1993)
# change projection
example <- sf::st_transform(example, "+proj=longlat +datum=WGS84")
# create popups
incomepopup <- paste0("County: ", example$NAME, ", avg income = $", example$income)
poppopup <- paste0("County: ", example$NAME, ", avg pop = ", example$pop)
yearpopup <- paste0("County: ", example$NAME, ", avg year = ", example$year)
lifepopup <- paste0("County: ", example$NAME, ", avg life expectancy = ", example$life)
# create color palettes
yearPalette <- colorNumeric(palette = "Blues", domain=example$year)
lifePalette <- colorNumeric(palette = "Purples", domain=example$life)
incomePalette <- colorNumeric(palette = "Reds", domain=example$income)
popPalette <- colorNumeric(palette = "Oranges", domain=example$pop)
# create map
leaflet(example) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = poppopup,
color = ~popPalette(example$pop),
group = "pop"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = yearpopup,
color = ~yearPalette(example$year),
group = "year"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = lifepopup,
color = ~lifePalette(example$life),
group = "life"
) %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = incomepopup,
color = ~incomePalette(example$income),
group = "income"
) %>%
addLayersControl(
baseGroups=c("income", "year", "life", "pop"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
)
I'm still looking for a way to add a "year" filter that would be another interactive radio-button box to filter the data by different years.
I have a dataset that includes both a date and a species for each bird observed in a county. I've mapped them using leaflet, but want to use two AddLayersControl to control for both the date and the species. Right now I can only control for the year or the species. I would like the second group of checkboxes so I can control the species as well. I want the marker to go away if either its year group is unchecked or its species group is unchecked.
What I think I need to do is to assign each marker to two different groups that I could control independently. I don't think I am able to assign certain markers as base layers because I don't want a certain subset of them always available. I have also tried just adding another AddLayersControl - sadly the second one will always win and it doesn't seem like you can have two on the same map.
library(leaflet)
library(magrittr)
library(dplyr)
library(htmltools)
# Data
birds <- data.frame(observed_on = c("4/4/2009",
"4/1/2009",
"3/6/2016",
"2/9/2016"),
url = c("http://www.inaturalist.org/observations/2236",
"http://www.inaturalist.org/observations/2237",
"http://www.inaturalist.org/observations/2778201",
"https://www.inaturalist.org/observations/9796150"),
latitude = c(43.08267975,
43.0844841,
43.055512,
43.0180932),
longitude = c(-89.43265533,
-89.43793488,
-89.314878,
-89.52836138),
scientific_name = c("Agelaius phoeniceus",
"Bubo virginianus",
"Quiscalus quiscula",
"Strix varia"),
common_name = c("Red-winged Blackbird",
"Great Horned Owl",
"Common Grackle",
"Barred Owl"),
taxon_order_name = c("Passeriformes",
"Strigiformes",
"Passeriformes",
"Strigiformes"),
taxon_species_name = c("Agelaius phoeniceus",
"Bubo virginianus",
"Quiscalus quiscula",
"Strix varia" ),
year = c("2009", "2009", "2016", "2016"))
# Leaflet Chart Formatting --------------------------------------------------------
palette <- colorFactor(palette = rainbow(length(unique(birds$taxon_order_name))),
domain = birds$taxon_order_name)
# Leaflet Chart -------------------------------------------------------------------
mymap <- leaflet(birds) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lng = -89.398721,
lat = 43.071580,
zoom = 13)
for (t in unique(birds$year)){
sub <- birds[birds$year == t,]
labels <- mapply(function(x, y, z, a) {
HTML(sprintf("%s<br><em>%s</em><br>%s<br><a href=%s>link</a>",
htmlEscape(x),
htmlEscape(y),
htmlEscape(z),
htmlEscape(a)))},
sub$common_name,
sub$taxon_species_name,
sub$observed_on,
sub$url,
SIMPLIFY = FALSE)
mymap <- mymap %>%
addCircleMarkers(data = sub,
lng = ~longitude,
lat = ~latitude,
fillOpacity = 0.6,
radius = 8,
fillColor = ~palette(taxon_order_name),
color = "black",
weight = 1,
opacity = 0.5,
popup = labels,
group = as.character(t))
}
mymap %>%
addLegend(pal = palette,
values = ~taxon_order_name,
title = "Taxon Order") %>%
addLayersControl(overlayGroups = as.character(unique(birds$year)),
options = layersControlOptions(collapsed = FALSE))
# addLayersControl(overlayGroups = unique(birds$taxon_order_name), options = layersControlOptions(collapsed = FALSE))
map showing points with both year and species info but layers control for the only year
does this work?
addLayersControl(overlayGroups = as.character(c(unique(birds$year),unique(birds$taxon_order_name)), options = layersControlOptions(collapsed = FALSE))
Bit of a strange problem using the leaflet package on R. I'm trying to colour in certain countries depending on how many users are in those countries. Everything goes well, except the countries are being coloured in with the wrong data. So for example, Morocco is being coloured in as if it were Jordan, etc.
I'm working with this free world map shapefile: http://thematicmapping.org/downloads/world_borders.php
When I draw a map with only the data included with the shapefile (data$POP2005), everything is fine. So perhaps there is a problem with my join?
user_data table:
NAME USERS
Morocco 250
Jordan 1000
Canada 5007
Code used:
world <- readOGR(dsn=path.expand("~/TM_WORLD_BORDERS_SIMPL-0.3"),
layer="TM_WORLD_BORDERS_SIMPL-0.3")
world#data <- merge(world#data, user_data, by="NAME", all.x = TRUE)
pal <- colorBin("YlOrRd", domain = world#data$USERS, bins = 5)
m <- leaflet(world) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(world#data$USERS),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
m
When I try the code above, Morocco is showing as 1000 users (the result Jordan should have). Other countries are similarly incorrect. What am I doing wrong?
Many thanks!
I think that by merging world#data with itself is causing some strange interactions that are hard to track down (for example, in my first attempt Morocco was fine but Cuba was red). Instead I used sp::merge from the sp package which allowed me to simplify my code a bit:
library(rgdal)
library(leaflet)
user_data <- data.frame(NAME = c("Morocco", "Jordan", "Canada"),
USERS = c(250, 1000, 5007))
world <- readOGR(dsn="TM_WORLD_BORDERS_SIMPL-0.3.shp",
layer="TM_WORLD_BORDERS_SIMPL-0.3")
world_merged <- sp::merge(world, user_data)
pal <- colorBin("YlOrRd", domain = world_merged$USERS, bins = 5)
m <- leaflet(world) %>%
addTiles() %>%
addPolygons(
fillColor = ~pal(world_merged$USERS),
weight = 2,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7)
m
And yielded this leaflet map (zoomed in here):
Aim:
To create a choropleth map by municipalities in Catalonia using population.
Reproducible data:
Ok, so my first step was to download the population and municipality shapefile.
Population: https://www.idescat.cat/cat/idescat/biblioteca/docs/publicacions/gridpoblacio01012016.zip
Municipality borders: http://auriga.icc.cat/bseccen_etrs89/bseccenv10sh1f1_2002a2016_0.zip
Steps so far:
Imported both, gave them same coordinates:
catapop<-readOGR("location","rp2016_qtree_level2_ofus_allvar")
catasense<-readOGR("location","bseccenv10sh1f1_20160101_0")
catapop<-spTransform(catapop,CRSobj = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs+towsgs84=0,0,0")
catasense<-spTransform(catasense,CRSobj = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs+towsgs84=0,0,0")
Issue
When I look at the data in the shapefiles they contain what I need:
But when I look at the ID's in catasense compared to the ID's in catapop, I don't know what's happening and how I can match the ID's of catapop to catasense.
I would like to keep the ID's of catasense "MUNICIPI" since they seem the most standard in the Catalonia public data.
Any ideas on how to match the ID's and create a chloropleth map for population "TOTAL" would be really appreciated!
If there's any clarification needed, let me know!
So the first step is import this two tables to R
tab1
tab2
library(readxl)
pop <- read_excel("Downloads/rp2016/pop.xlsx")
cod <- read_excel("Downloads/rp2016/cod.xlsx")
names(cod) <- c("Codi", "Nom2", "Codi comarca", "Nom comarca")
codf <- merge(cod, pop, by.x = "Nom2", by.y = "Nom", all.x = TRUE)
#I make a treatment in the Codi field to put 0 in front of a code that starts with 8.
b <- codf$Codi
b[grep("^8", b)] <- paste0("0",b[grep("^8", b)])
codf$Codi <- b
data2 <- catasense#data
codf2 <- merge(data2, codf, by.x = "MUNICIPI", by.y = "Codi", all.x = TRUE, sort = FALSE)
catasense#data$pop <- codf2$`PoblaciĆ³ (2016)`
catasense#data$name <- codf2$Nom2
library(leaflet)
pal <- colorNumeric("viridis", NULL)
map <- leaflet(catasense) %>%
addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
opacity = 1.0, fillOpacity = 1,
fillColor = ~pal(log10(as.numeric(pop))),
popup = ~paste0("<b>", name, "</b>", " <br> ", "pop:", pop, "<br>"
),
label = ~paste0(name),
highlightOptions = highlightOptions(color = "white", weight = 2,
bringToFront = TRUE)) %>%
addLegend(pal = pal, values = ~log10(pop), opacity = 1.0,
labFormat = labelFormat(transform = function(x) round(10^x)))
map
#you can save leaflet map in html
library(htmlwidgets)
saveWidget(map, file="cata2.html")
download and open this html file and see the map
I got time related data (7 years) displayed in a choropleth map, using R and Leaflet-for-R-package. Therefore use a kmz-file for geometry and csv data for attributes. So far I tried it with data for 2 years, using this tutorial:
http://journocode.com/2016/01/28/your-first-choropleth-map/
Following the example, I used my data instead of the given one in the tutorial. Everything worked fine. But longterm, I want to add all my
7 years data, therefore it would be useful to replace the radio button-based layer control by a (time)slider - changing the overlays according to the year.
In a comparable case here on stackoverflow, someone worked with geojson-files as geometry in order to use the timeslider plugin for Leaflet:
Leaflet slider group by year
So do I need to change my geom data into geojson as well?
And do so, how I link my csv-data to geojson and will R be able to cover all?
I hope you might have some suggestions...
https://github.com/Pippo87/R-leaflet-choropleth
Here is my R-script:
library(rgdal)
berlin <- readOGR("LOR-Planungsraeume.kml","LOR_Planungsraum", encoding="utf-8")
plot(berlin)
Auslaender2007 <- read.csv("LOR_Auslaender_2007.csv", encoding="latin1", sep=",", dec=".")
Auslaender2008 <- read.csv("LOR_Auslaender_2008.csv", encoding="latin1", sep=",", dec=".")
library(leaflet)
palette <- colorBin(c('#fef0d9',
'#fdd49e',
'#fdbb84',
'#fc8d59',
'#e34a33',
'#b30000'),
Auslaender2008$ANTEIL, bins = 6, pretty=TRUE, alpha = TRUE)
popup2007 <- paste0("<strong>Auslaender 2007</strong></span>",
"<br><strong>LOR </strong></span>",
Auslaender2007$LORNAME,
"<br><strong> Relativer Auslaenderanteil </strong></span>",
Auslaender2007$ANTEIL
,"<br><strong>Absoluter Auslaenderanteil</strong></span>",
Auslaender2007$AUSLAENDER)
popup2008 <- paste0("<strong>Auslaender 2007</strong></span>",
"<br><strong>LOR </strong></span>",
Auslaender2008$LORNAME,
"<br><strong> Relativer Auslaenderanteil </strong></span>",
Auslaender2008$ANTEIL
,"<br><strong>Absoluter Auslaenderanteil</strong></span>",
Auslaender2008$AUSLAENDER)
mymap <- leaflet() %>%
addProviderTiles("Esri.WorldGrayCanvas", options = tileOptions(minZoom=10, maxZoom=16)) %>%
addPolygons(data = berlin,
fillColor = ~palette(Auslaender2007$ANTEIL),
fillOpacity = 1,
color = "darkgrey",
weight = 1.5,
group="<span style='font-size: 11pt'><strong>2007</strong></span>")%>%
addPolygons(data = berlin,
fillColor = ~palette(Auslaender2008$ANTEIL),
fillOpacity = 1,
color = "darkgrey",
weight = 1.5,
popup = popup2008,
group="<span style='font-size: 11pt'><strong>2008</strong></span>")%>%
addLayersControl(
baseGroups = c("<span style='font-size: 11pt'><strong>2007</strong></span>", "<span style='font-size: 11pt'><strong>2008</strong></span>"),
options = layersControlOptions(collapsed = FALSE))%>%
addLegend(position = 'topleft', pal = palette, values = Auslaender2008$ANTEIL, opacity = 1, title = "Relativer<br>Auslaenderanteil")
print(mymap)