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
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))
I need to label several overlapping polygons, but only the label of the biggest one is shown. However when I tested with some simulated data the labels were shown correctly. I compared the data in two cases carefully but cannot find the difference caused the problem.
Here is a minimal example of simulated overlapping polygons:
library(leaflet)
library(sp)
poly_a <- data.frame(lng = c(0, 0.5, 2, 3),
lat = c(0, 4, 4, 0))
poly_b <- data.frame(lng = c(1, 1.5, 1.8),
lat = c(2, 3, 2))
pgons = list(
Polygons(list(Polygon(poly_a)), ID="1"),
Polygons(list(Polygon(poly_b)), ID="2")
)
poly_dat <- data.frame(name = as.factor(c("a", "b")))
rownames(poly_dat) <- c("1", "2")
spgons = SpatialPolygons(pgons)
spgonsdf = SpatialPolygonsDataFrame(spgons, poly_dat, TRUE)
leaflet() %>% addPolygons(data = spgonsdf, label = ~name
# ,
# highlightOptions = highlightOptions(
# color = "red", weight = 2,bringToFront = TRUE)
)
It's working properly:
However it didn't work with my data.
https://github.com/rstudio/leaflet/files/1430888/Gabs.zip
You can drag the zip into this site and use the i button to see it's correctly labeled
library(rgdal)
# download Gabs.zip and extract files to Gabs folder
hr_shape_gabs <- readOGR(dsn = 'Gabs', layer = 'Gabs - OU anisotropic')
hr_shape_gabs_pro <- spTransform(hr_shape_gabs,
CRS("+proj=longlat +datum=WGS84 +no_defs"))
leaflet(hr_shape_gabs_pro) %>%
addTiles() %>%
addPolygons(weight = 1, label = ~name)
Only the biggest polygon label is shown:
The data in both case are SpatialPolygonsDataFrame, the data slot have proper polygon names.
Change the order of polygons in hr_shape_gabs: polygon in position 3 should be the smaller one.
library(leaflet)
library(sp)
library(rgdal)
hr_shape_gabs <- readOGR(dsn = 'Gabs - OU anisotropic.shp',
layer = 'Gabs - OU anisotropic')
# Change the position of the smaller and wider polygons
# Position 1 = wider polygon, position 3 = smaller polygon
pol3 <- hr_shape_gabs#polygons[[3]]
hr_shape_gabs#polygons[[3]] <- hr_shape_gabs#polygons[[1]]
hr_shape_gabs#polygons[[1]] <- pol3
hr_shape_gabs$name <- rev(hr_shape_gabs$name)
hr_shape_gabs_pro <- spTransform(hr_shape_gabs,
CRS("+proj=longlat +datum=WGS84 +no_defs"))
leaflet() %>%
addTiles() %>%
addPolygons(data= hr_shape_gabs_pro, weight = 1, label = ~name)
Here's a scalable solution in sf for many layers, based on this answer.
The idea is to order the polygons by decreasing size, such that the smallest polygons plot last.
library(sf)
library(dplyr)
# calculate area of spatial polygons sf object
poly_df$area <- st_area(poly_df)
poly_df <- arrange(poly_df, -area)
# view with labels in leaflet to see that small polygons plot on top
leaflet(poly_df) %>% addTiles() %>% addPolygons(label = ~id)
Apologies for the lack of reproducibility. This is more of a concept answer.
I recently found this shape file of NYC bus routes shape file of NYC bus routes (zip file) that I am interested in plotting with the leaflet package in R.
When I attempt to do so, some routes do not show up on the map. I can tell they're missing because I overlay the bus stop data and some do not line up with the routes.
When I read in the shape file, I notice that the spatial lines data frame that is created has nested lists, which I think leaflet is not mapping.
What do I need to do so that leaflet reads coordinates of these missing routes? Below is the code I used to produce the map with missing routes:
bus <- readOGR(dsn = path.expand("bus_route_shapefile"), layer = "bus_route_shapefile")
bus.pj <- spTransform(bus, CRS("+proj=longlat +datum=WGS84"))
bus.st <- readOGR(dsn = path.expand("bus_stop_shapefile"), layer = "bus_stop_shapefile")
bus.st.pj <- spTransform(bus.st, CRS("+proj=longlat +datum=WGS84"))
bus_map <- leaflet() %>%
setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
addPolylines(data = bus.pj, color = "black", opacity = 1) %>%
addCircles(data=bus.st.pj#data,~stop_lon, ~stop_lat, color = "red") %>%
addTiles()
bus_map
It would be easier to help you if you provided not only bus_routes but also bus_stop (zip file). You can solve it by converting bus.pj into new SpatialLinesxxx obj where each class Lines has only one class Line. SLDF below code makes doesn't have bus.pj#data$trip_heads because of unknown.
library(dplyr); library(sp); library(leaflet)
## resolve bus.pj#lines into list(Line.objs) (Don't worry about warnings)
Line_list <- lapply(bus.pj#lines, getLinesLinesSlot) %>% unlist()
## If you want just Lines infromation, finish with this line.
SL <- sapply(1:length(Line_list), function(x) Lines(Line_list[[x]], ID = x)) %>%
SpatialLines()
## make new ids (originalID_nth)
ori_id <- getSLLinesIDSlots(bus.pj) # get original ids
LinLS <- sapply(bus.pj#lines, function(x) length(x#Lines)) # how many Line.obj does each Lines.obj has
new_id <- sapply(1:length(LinLS), function(x) paste0(x, "_", seq.int(LinLS[[x]]))) %>%
unlist()
## make a new data.frame (only route_id)
df <- data.frame(route_id = rep(bus.pj#data$route_id, times = LinLS))
rownames(df) <- new_id
## integrate Line.objs, ids and a data.frame into SpatialLinesDataFrame.obj
SLDF <- mapply(function(x, y) Lines(x, ID = y), x = Line_list, y = new_id) %>%
SpatialLines() %>% SpatialLinesDataFrame(data = df)
leaflet() %>%
setView(lng = -73.932667, lat = 40.717266, zoom = 11) %>%
addPolylines(data = SLDF, color = "black", opacity = 1, weight = 1) %>%
addCircles(data=bus.st.pj#data,~stop_lon, ~stop_lat, color = "red", weight = 0.3)
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)