Related
I have a dataset with several hundred geographical points expressed as lat/long values that I plot as dots using tm_dots, on top of some boundaries that I plot using tm_shape (both using tmap).
Does anyone know of a way that I can draw polygons to represent areas within the boundaries of the underlying layer that are not within 500 metres of any of the points plotted? I'd be happy to use other R mapping resources (e.g. ggplot/ggmap) if better for this task.
Current code is:
#Call necessary packages
library(tidyverse)
library (readxl)
library(maptools)
library(classInt)
library(RColorBrewer)
library(sf)
library(tmap)
library(scales)
library(tmaptools)
library(geodata)
#Read in boundary polygon data
#This shape file is from https://www.data.gov.uk/dataset/2cf1f346-2f74-4c06-bd4b-30d7e4df5ae7/middle-layer-super-output-area-msoa-boundaries
shp_name <- "//ims.gov.uk//homedrive//users//JW2002//My Documents//Data//Demography, Mapping & Lookups//Shape Files//East of England//MSOA//Middle_Layer_Super_Output_Areas_December_2011_Generalised_Clipped_Boundaries_in_England_and_Wales.shp"
EofEMSOAs <- st_read(shp_name)%>%
st_as_sf()
#Read deprivation data from another source (not specifically relevant to the mapping section of this project but provides list for subsequent subset to East of England MSOAs only)
EofEMSOAsIMD <- read_excel("~/Data/Demography, Mapping & Lookups/IoD/National & EofE IoD 2019/National&IoD 2019 MSOAs.xlsx",
sheet = "East of England MSOAs")
#Subset MSOA list to East of England Only
EofEMSOAsCodeListOnly <- dplyr::pull(EofEMSOAsIMD, "Area Code")
EofEMSOAsCodeListOnly <- paste(EofEMSOAsCodeListOnly, collapse = '|')
EofEMSOAsFinalList <- EofEMSOAs[grep(EofEMSOAsCodeListOnly, EofEMSOAs$msoa11cd),]
#Generate point data
PointData <- read.table(textConnection("ID Latitude Longitude
A 52.9742585 0.5526301
B 52.972643 0.8495693
C 52.972643 0.8495693
D 51.46133804 0.36403501"), header=TRUE)
#Geocode the point list
PointDataPlotted = st_as_sf(PointData, coords = c('Longitude', 'Latitude'), crs = 4326)
#Remove geometry
PointDataPlotted2 <- PointDataPlotted %>%
as.data.frame() %>%
mutate(buffer = st_buffer(geometry, dist = 5000)) %>%
select(-geometry) %>%
st_as_sf()
#Create union shape of polygons
union <- st_union(EofEMSOAsFinalList)
# generate bounding box
mask_union <- union %>% as_tibble() %>%
mutate(bbox = st_as_sfc(st_bbox(c(xmin = -5.5, xmax = 9, ymax = 51.5, ymin = 42), crs = st_crs(4326)))) %>%
st_as_sf()
# compute difference between bounding box and union polygon to
# use as mask in the final layer
diff <- st_difference(mask_union$bbox, mask_union$geometry)
# Build map
OutputMap <-
# plot only shapes filled red
tm_shape(EofEMSOAsFinalList) +
tm_fill(col = "red") +
# plot only buffer zones of each point in green
tm_shape(PointDataPlotted2)+
tm_fill(col = "forestgreen") +
# add mask
tm_shape(diff) +
tm_fill(col = "white") +
# plot borders of shape
tm_shape(EofEMSOAsFinalList) +
tm_borders(col = "white",
lwd = 1,
lty = "solid") +
# add custom legend
tm_add_legend(type = "symbol",
labels = c("Restricted", "Public"),
col = c("red", "forestgreen"),
title = "Access type",
size = 1.5,
shape = 21)
Here's a solution to find areas within the boundaries of the underlying layer that are within 50 km of any of the points plotted.
library(tidyverse)
library(sf)
library(geodata)
# example polygons of France
polygon <- gadm(country = "FRA", level = 1, path = tempdir()) %>%
st_as_sf() %>%
filter(NAME_1 != "Corse")
# get 100 sample points within union shape of polygons
set.seed(42)
union <- st_union(polygon)
points <- st_sample(x = union, size = 100, type = "random") %>%
as.data.frame() %>%
mutate(id = row_number()) %>% # add an id for later joining
st_as_sf() %>%
# calculate aound each point a buffer zone of 50km
mutate(buffer = st_buffer(geometry, dist = 50000))
# add for each point the polygon (state) in which it is located
points <- st_join(points, polygon, join = st_within) %>%
as.data.frame() %>%
dplyr::select(id, NAME_1) %>%
left_join(points) %>%
filter(NAME_1 != "Corse")
# for each polygon calculate the union shapes of the
# corresponding buffers zones within
points_buff_union <- points %>%
dplyr::select(-geometry) %>%
st_as_sf() %>%
group_by(NAME_1) %>%
summarise()
# plot content
polygon %>%
ggplot() +
geom_sf(data = points_buff_union, aes(geometry = buffer, fill = NAME_1)) +
geom_sf(fill = NA) +
scale_fill_brewer(palette = "Paired") +
geom_sf(data = points, aes(geometry = geometry), color = "black", size = .5)
From this point I guess it's easy to find the areas not within XX meters of any of the points plotted.
If you want to find area across the underlying polygons you can simply use the following (blue areas are within 50 km of any of the points plotted while red areas don't):
# calculate union shape for all buffers
points_buff_union <- points %>%
filter(NAME_1 != "Corse") %>%
dplyr::select(-geometry) %>%
st_as_sf() %>%
summarise()
# generate bounding box
mask_union <- union %>% as_tibble() %>%
mutate(bbox = st_as_sfc(st_bbox(c(xmin = -5.5, xmax = 9, ymax = 51.5, ymin = 42), crs = st_crs(4326)))) %>%
st_as_sf()
# compute difference between bounding box and union polygon to
# use as mask in the final layer
diff <- st_difference(mask_union$bbox, mask_union$geometry)
# plot content
polygon %>%
ggplot() +
geom_sf(fill = "red3") +
geom_sf(data = points_buff_union, aes(geometry = buffer), fill = "lightblue") +
geom_sf(data = points, aes(geometry = geometry), color = "black", size = .5) +
geom_sf(fill = NA) +
geom_sf(data = diff, fill = "white")
Of course you can plot the individual layers computed with sf also using tmap:
library(tidyverse)
library(sf)
library(geodata)
library(tmap)
# example polygons of France
EofEMSOAs <- gadm(country = "FRA", level = 1, path = tempdir()) %>%
st_as_sf() %>%
filter(NAME_1 != "Corse")
# get 100 sample points within union shape of polygons
set.seed(42)
union <- st_union(EofEMSOAs)
PointDataPlot <- st_sample(x = union, size = 100, type = "random") %>%
as.data.frame() %>%
# calculate around each point a buffer zone of 50km
mutate(buffer = st_buffer(geometry, dist = 50000)) %>%
select(-geometry) %>%
st_as_sf()
# generate bounding box
mask_union <- union %>% as_tibble() %>%
mutate(bbox = st_as_sfc(st_bbox(c(xmin = -5.5, xmax = 9, ymax = 51.5, ymin = 42), crs = st_crs(4326)))) %>%
st_as_sf()
# compute difference between bounding box and union polygon to
# use as mask in the final layer
diff <- st_difference(mask_union$bbox, mask_union$geometry)
# Build map
OutputMap <-
# plot only shapes filled red
tm_shape(EofEMSOAs) +
tm_fill(col = "red") +
# plot only buffer zones of each point in green
tm_shape(PointDataPlot)+
tm_fill(col = "forestgreen") +
# add mask
tm_shape(diff) +
tm_fill(col = "white") +
# plot borders of shape
tm_shape(EofEMSOAs) +
tm_borders(col = "white",
lwd = 1,
lty = "solid") +
# add custom legend
tm_add_legend(type = "symbol",
labels = c("Restricted", "Public"),
col = c("red", "forestgreen"),
title = "Access type",
size = 1.5,
shape = 21)
UPDATE using UK data
#Call necessary packages
library(tidyverse)
library (readxl)
library(maptools)
library(classInt)
library(RColorBrewer)
library(sf)
library(tmap)
library(scales)
library(tmaptools)
library(geodata)
# Read in boundary polygon data
EofEMSOAs <- st_read("MSOA_EngWal_Dec_2011_Generalised_ClippedEW_0/Middle_Layer_Super_Output_Areas_December_2011_Generalised_Clipped_Boundaries_in_England_and_Wales.shp")%>%
st_as_sf(crs = 4326) %>%
st_make_valid() %>%
# use only a subset of the data
st_crop(c(xmin = 550000, ymin =320000, xmax = 600000, ymax = 360000))
# Generate point data
PointData <- read.table(textConnection("ID Latitude Longitude
A 52.9742585 0.5526301
B 52.972643 0.8495693
C 52.972643 0.8495693
D 51.46133804 0.36403501"), header=TRUE)
# Geocode the point list
PointDataPlotted = st_as_sf(PointData, coords = c('Longitude','Latitude'), crs = 4326)
# Remove geometry
PointDataPlotted2 <- PointDataPlotted %>%
as.data.frame() %>%
mutate(buffer = st_buffer(geometry, dist = 5000)) %>%
select(-geometry) %>%
st_as_sf(crs = 4326)
# Create union shape of polygons
union <- st_union(EofEMSOAs)
# generate bounding box
mask_union <- union %>% as_tibble() %>%
mutate(bbox = st_as_sfc(st_bbox(geometry), crs = 4326)) %>%
st_as_sf()
# compute difference between bounding box and union polygon to
# use as mask in the final layer
diff <- st_difference(mask_union$bbox, mask_union$geometry)
# Build map
OutputMap <-
# plot only shapes filled red
tm_shape(EofEMSOAs) +
tm_fill(col = "red") +
# plot only buffer zones of each point in green
tm_shape(PointDataPlotted2)+
tm_fill(col = "forestgreen") +
# add mask
tm_shape(diff) +
tm_fill(col = "white") +
# plot borders of shape
tm_shape(EofEMSOAs) +
tm_borders(col = "white",
lwd = 1,
lty = "solid") +
# add custom legend
tm_add_legend(type = "symbol",
labels = c("Restricted", "Public"),
col = c("red", "forestgreen"),
title = "Access type",
size = 1.5,
shape = 21)
I'm looking to crop the density plot to only land while keeping to sf.
Here's a simple example problem:
library(tidyverse)
library(sf)
library(albersusa)
library(ggthemes)
library(jsonlite)
dat <-
fromJSON(
"https://services1.arcgis.com/Hp6G80Pky0om7QvQ/arcgis/rest/services/Fortune_500_Corporate_Headquarters/FeatureServer/0/query?where=1%3D1&outFields=LATITUDE,LONGITUDE,NAME,PROFIT&outSR=4326&f=json"
)
dat <- as.data.frame(dat$features$attributes)
top_50 <- dat %>%
arrange(desc(PROFIT)) %>%
head(50)
ggplot() +
geom_sf(data = usa_sf()) +
geom_density_2d_filled(aes(x = LONGITUDE, y = LATITUDE),
data = top_50,
alpha = .5) +
xlim(-125,-66.5) +
ylim(20, 50) +
theme_map() +
theme(legend.position = "none")
Not sure if I'm getting close to a solution but here's some of the code I've been trying:
test <- (MASS::kde2d(
top_50$LONGITUDE, top_50$LATITUDE,
lims = c(-125,-66.5, 20, 50)
))
ggpoly2sf <- function(poly, coords = c("long", "lat"),
id = "group", region = "region", crs = 4326) {
sf::st_as_sf(poly, coords = coords, crs = crs) %>%
group_by(!! as.name(id), !! as.name(region)) %>%
summarize(do_union=FALSE) %>%
sf::st_as_sf("POLYGON") %>%
ungroup() %>%
group_by(!! as.name(region)) %>%
summarize(do_union = TRUE) %>%
ungroup()
}
v <- contourLines(test)
vv <- v
for (i in seq_along(v)) vv[[i]]$group <- i
vv <- do.call(rbind, lapply(vv, as.data.frame))
dsi_sf <- ggpoly2sf(vv, coords = c("x", "y"), region = "level") %>% st_as_sf()
usa <- usa_sf()
dsi_i_sf <- st_intersection(usa$geometry, dsi_sf)
ggplot() +
geom_sf(data=usa) +
geom_sf(data=dsi_i_sf,color="red") +
geom_density2d_filled(aes(x = LONGITUDE, y = LATITUDE),
data = top_50,alpha=.4) +
xlim(-125,-66.5) +
ylim(20, 50) +
theme(legend.position = "none")
Create a rectangle of the same plot dimensions:
rec_box <- data.frame(x=c(-125,-125,-66.5,-66.5,-125), y=c(20,50,50,20,20))
Create an outline of the US and extract only the lat/lon points into a dataframe:
outline <- map("usa", plot=FALSE)
outline <- data.frame(x=outline$x,y=outline$y)
Bind the two together to create a polygon with a hole in the middle:
mask <- rbind(rec_box,outline)
Add a geom_polygon() to plot the mask data and color appropriately:
geom_polygon(data=mask,
aes(x=x,y=y),color="white",fill="white")
Everything combined:
library(tidyverse)
library(sf)
library(albersusa)
library(ggthemes)
library(jsonlite)
dat <-
fromJSON(
"https://services1.arcgis.com/Hp6G80Pky0om7QvQ/arcgis/rest/services/Fortune_500_Corporate_Headquarters/FeatureServer/0/query?where=1%3D1&outFields=LATITUDE,LONGITUDE,NAME,PROFIT&outSR=4326&f=json"
)
dat <- as.data.frame(dat$features$attributes)
top_50 <- dat %>%
arrange(desc(PROFIT)) %>%
head(50)
usa <- usa_sf()
outline <- map("usa", plot=FALSE)
outline <- data.frame(x=outline$x,y=outline$y)
rec_box <- data.frame(x=c(-125,-125,-66.5,-66.5,-125), y=c(20,50,50,20,20))
mask <- rbind(rec_box,outline)
ggplot() +
geom_sf(data = usa_sf()) +
geom_density_2d_filled(aes(x = LONGITUDE, y = LATITUDE),
data = top_50,
alpha = .5) +
xlim(-125,-66.5) +
ylim(20, 50) +
geom_polygon(data=mask,
aes(x=x,y=y),color="white",fill="white") +
theme_map() +
theme(legend.position = "none")
Really a thing of beauty.
For a mask layer over the US with AK & HI inset:
library(tidyverse)
library(sf)
library(albersusa)
library(ggthemes)
library(jsonlite)
library(spatstat)
dat <-
fromJSON(
"https://services1.arcgis.com/Hp6G80Pky0om7QvQ/arcgis/rest/services/Fortune_500_Corporate_Headquarters/FeatureServer/0/query?where=1%3D1&outFields=LATITUDE,LONGITUDE,NAME,PROFIT&outSR=4326&f=json"
)
dat <- as.data.frame(dat$features$attributes)
top_50 <- dat %>%
arrange(desc(PROFIT)) %>%
head(50)
usa <- usa_sf()
top50sf <- st_as_sf(top_50, coords = c("LONGITUDE", "LATITUDE")) %>%
st_set_crs(4326) %>%
st_transform(st_crs(usa))
# usa polygons combined
usa_for_mask <- usa_sf() %>%
st_geometry() %>%
st_cast('POLYGON') %>%
st_union()
# bounding box of us & inset AK + HI,
# expand as needed
us_bbox <- st_bbox(usa_for_mask) %>%
st_as_sfc() %>%
st_as_sf()
us_mask <- st_difference(us_bbox, usa_for_mask)
ggplot() +
geom_sf(data = usa) +
geom_density_2d_filled(aes(x = LONGITUDE, y = LATITUDE),
data = top_50,
alpha = .5) +
geom_sf(data = us_mask, fill = 'white') +
xlim(-125,-66.5) +
ylim(20, 50) +
theme_map() +
theme(legend.position = "none")
Created on 2021-04-05 by the reprex package (v1.0.0)
You can expand the bounding box to get rid of the purple border around the plot.
This does what you're asking for, but almost certainly isn't spatially accurate. It can get a point across to a general audience, but don't make any big decisions based on it.
More accurate spatial interpolation methods can be found here:
https://rspatial.org/raster/analysis/4-interpolation.html
https://mgimond.github.io/Spatial/interpolation-in-r.html
I need to create a map of country(Thailand) based on shapes files (preferably colored)and to add the codes of the provinces (from 10 to 96,77 codes) and the corresponding coefficient from h.сsv(also 77 values) file on the map.
I am trying to show my two codes(maybe,one of them will be better for map):
1st:
library(raster)
library(rasterVis)
library(rgdal)
library(rgeos)
library(dismo)
library(sp)
library(maptools)
library(maps)
library(mapdata)
library(XML)
library(foreign)
library(latticeExtra)
library(shapefiles)
library(RColorBrewer)
library(GISTools)
#library(SDMTools)
library(dplyr)
library(tidyr)
library(tidyverse)
library(lubridate)
## preparing shapefiles
thailand_district <- shapefile("C:/usa/archive/TH_Province2012.shp")
thailand_district
crs(thailand_district)
names(thailand_district)
thailand_district_lonlat<- spTransform(thailand_district, CRS("+proj=longlat +datum=WGS84"))
crs(thailand_district_lonlat)
thailand_district_lonlat_s<-gSimplify(thailand_district_lonlat, tol=0.02, topologyPreserve=TRUE)
district_id<-thailand_district_lonlat$A_CODE
province_id<-thailand_district_lonlat$P_CODE
thailand_prov <- shapefile("C:/usa/archive/TH_Province2012.shp")
thailand_prov
crs(thailand_prov)
thailand_prov_lonlat<- spTransform(thailand_prov, CRS("+proj=longlat +datum=WGS84"))
crs(thailand_prov_lonlat)
thailand_prov_lonlat_s<-gSimplify(thailand_prov_lonlat, tol=0.02, topologyPreserve=TRUE)
## preparing centroids
thailand_district_centroids <- getSpPPolygonsLabptSlots(thailand_district_lonlat)
head(thailand_district_centroids)
district_centroids<- data.frame(province_id,district_id, thailand_district_centroids[,1],thailand_district_centroids[,2])
district_centroids<-read.csv("data.scrub.district.csv")
names(district_centroids) <- c("province_id","district_id","longitude", "latitude")
ex<-district_centroids
coordinates(ex)<- cbind("longitude", "latitude")
plot(ex)
thailand_province_centroids <- getSpPPolygonsLabptSlots(thailand_prov_lonlat)
head(thailand_province_centroids)
## read cases
scrub1<-read_csv("C:/usa/archive/scrub_2003-07_180319.csv")
names(scrub1)
scrub1<-dplyr::select(scrub1,Address, The.day.began.to.get.sick..M.D.Y.)
scrub1 <- dplyr::rename(scrub1,date=The.day.began.to.get.sick..M.D.Y.)
scrub1 <-na.omit(scrub1)
scrub2<-read_csv("C:/usa/archive/scrub_2008-11_180319.csv")
scrub2<-dplyr::select(scrub2,Address, The.day.began.to.get.sick..M.D.Y.)
scrub2 <- dplyr::rename(scrub2,date=The.day.began.to.get.sick..M.D.Y.)
scrub3<-read_csv("C:/usa/archive/scrub_2012-18_180319.csv")
scrub3<-dplyr::select(scrub3,Address, The.day.began.to.get.sick..M.D.Y.)
scrub3 <- dplyr::rename(scrub3,date=The.day.began.to.get.sick..M.D.Y.)
scrub<-dplyr::union(scrub1, scrub2)
scrub<-dplyr::union(scrub, scrub3)
scrub$district_id<-(tamboon_id=substr(scrub$Address, 1,4))
scrub <- dplyr::rename(scrub,village_id=Address)
scrub<-tidyr::drop_na(scrub,village_id)
scrub_district <- dplyr::select(scrub,district_id)
# preparation
scrub$date1 <- as.Date(scrub$date,
format = "%d/%m/%Y")
scrub$year<-lubridate::year(scrub$date1)
scrub$YearMonth<-format(scrub$date1, "%Y-%m")
scrubYear<-scrub %>%
drop_na() %>%
group_by(year) %>%
summarise(scrubcases= n())
scrub$district_id<-as.factor(scrub$district_id)
is.factor(scrub$district_id)
scrubDistrict<-scrub %>%
drop_na() %>%
group_by(district_id) %>%
summarise(scrubcases= n())
district_centroids
district_centroids2<-district_centroids %>%
unite("district_id", province_id,district_id2)
district_centroids2$district_id<-gsub("_", "",district_centroids2$district_id )
scrubdistict_longlat<-dplyr::left_join(district_centroids2,scrubDistrict,
by="district_id")
write_csv(scrubdistict_longlat,"data.scrub.district.csv")
scrubClean<-read_csv("data.scrub.district.csv")
mydata<-dplyr::filter(scrubClean, scrubcases > 0)
ex2<-mydata
coordinates(ex2)<-c("longitude","latitude")
bubble(ex2,"scrubcases")
# map
library(tmap)
library(tmaptools)
proj4string(ex2) <- proj4string(thailand_district_lonlat)
tmaptools::palette_explorer()
# thailand
tm1<-tm_shape(thailand_prov_lonlat_s) +
tm_fill(NA) + tm_borders("black")+
tm_borders("black")+
tm_compass(type = "8star", position = c("right", "top"),size = 2)+
tm_scale_bar(breaks = c(0, 100, 100), size = 0.5, position = c("right", "bottom"))+
tm_style( "beaver")
tm1
tm2<-tm_shape(thailand_district_lonlat_s)+
tm_polygons()+
tm_shape(ex2) +
tm_bubbles("scrubcases",col = "lightblue",scale = 2,
border.col = "black", border.alpha = .5,
contrast=1,
title.size="cases / district")
tm2
library(dplyr)
library(tidyr)
library(tmap)
data(World)
names(World)
mygideon<-read_csv("data.gideon.iso.final.csv") %>%
group_by(iso_a3) %>%
summarise(total.outbreaks=n())
world2<-dplyr::left_join(World,mygideon2,by="iso_a3")
tm_shape(world2) +
tm_polygons("total.outbreaks",
style = "fixed",
breaks = c(1,50,100,250,500,750, 1000, 1500, 2500),
palette="Oranges",
title = "Total outbreaks (1940-2018)", contrast = 1.2,
border.col = "gray30", id = "name", n=6,
legend.hist = TRUE,alpha = 1)+
tm_layout(legend.outside = TRUE)
**Error in data.frame(province_id, district_id, thailand_district_centroids[, :
arguments imply differing number of rows : 0, 77.use coordinates method**
2n code.
library(raster)
library(rasterVis)
library(rgdal)
library(rgeos)
library(dismo)
library(sp)
library(maptools)
library(maps)
library(mapdata)
library(XML)
library(foreign)
library(latticeExtra)
library(shapefiles)
library(RColorBrewer)
library(GISTools)
#library(SDMTools)
library(dplyr)
library(tidyr)
library(tidyverse)
library(rgeos) # to fortify without needing gpclib
library(ggplot2)
library(scales) # for formatting ggplot scales with commas
thamap <- readOGR("C:/usa/archive/TH_Province2012.shp")
thamap
crs(thamap)
thamap_lonlat<- spTransform(thamap, CRS("+proj=longlat +datum=WGS84"))
crs(thamap_lonlat)
thamap_lonlat_s<-gSimplify(thamap_lonlat, tol=0.02, topologyPreserve=TRUE)
thamap.fort <- fortify(thamap)
idList <-thamap#data$PROV_CODE
centroids.df <- as.data.frame(coordinates(thamap))
names(centroids.df) <- c("Longitude", "Latitude")
info <- read.csv("h.csv")
pop.df <- data.frame(idList,info,centroids.df)
ggplot(pop.df, aes(map_id = idList)) + #"id" is col in your df, not in the map object
geom_map(aes(fill = info), colour= "grey", map = thamap.fort) +
expand_limits(x = thamap.fort$long, y = thamap.fort$lat) +
scale_fill_gradient(high = "red", low = "white", guide = "colorbar", labels = comma) +
geom_text(aes(label = id, x = Longitude, y = Latitude)) + #add labels at centroids
coord_equal(xlim = c(-90,-30), ylim = c(-60, 20)) +
labs(x = "Longitude", y = "Latitude", title = "map Thailand") +
theme_bw()
Don't know how to automatically pick scale for object of type function. Defaulting to continuous.
Aesthetics must be valid data columns. Problematic aesthetic(s): label = id.
Did you mistype the name of a data column or forget to add after_stat()?
I would really appreciate it if you could help me to fix my codes a little to create the map.
Could you tell me please also,how is it possible to add the data(77 values) from csv file on the map near the codes of provinces?
Thank you very much for your help
Here's a solution using tmap. The shapefile containing the borders of Thailand (country and provinces) is available from https://data.humdata.org/dataset/thailand-administrative-boundaries. The province codes (10-96) are also included in the dataset in character format and can easily be extracted.
library(tmap)
library(sf)
library(tidyverse)
provinces <- st_read(dsn = "tha_adm_rtsd_itos_20190221_SHP_PART_1/tha_admbnda_adm1_rtsd_20190221.shp") %>%
as.tibble() %>%
separate(ADM1_PCODE, into = c("pcode_text", "pcode_num"), sep = "(?<=[A-Za-z])(?=[0-9])") %>%
select(geometry, pcode_num) %>%
st_as_sf()
tm_shape(provinces) +
tm_fill(col = "MAP_COLORS") +
tm_text("pcode_num", size = .5) +
tm_borders(lwd = .7, col = "black")
I would need to draw, in R the map of the European Union and a shaded circle that overlaps it. The circle should have a center at a point with known longitude and latitude and a predetermined radius.
First, I can't even draw the map, even though the code doesn't throw out any errors. The code is:
library(ggplot2)
library(grid)
library(rworldmap)
# Get the world map
worldMap <- getMap()
# Member States of the European Union
europeanUnion <- c("Austria","Belgium","Bulgaria","Croatia","Cyprus",
"Czech Rep.","Denmark","Estonia","Finland","France",
"Germany","Greece","Hungary","Ireland","Italy","Latvia",
"Lithuania","Luxembourg","Malta","Netherlands","Poland",
"Portugal","Romania","Slovakia","Slovenia","Spain",
"Sweden")
# Select only the index of states member of the E.U.
indEU <- which(worldMap$NAME%in%europeanUnion)
# Extract longitude and latitude border's coordinates of members states of E.U.
europeCoords <- lapply(indEU, function(i){
df <- data.frame(worldMap#polygons[[i]]#Polygons[[1]]#coords)
df$region =as.character(worldMap$NAME[i])
colnames(df) <- list("long", "lat", "region")
return(df)
})
europeCoords <- do.call("rbind", europeCoords)
value <- sample(x = seq(0,3,by = 0.1), size = length(europeanUnion),
replace = TRUE)
europeanUnionTable <- data.frame(country = europeanUnion, value = value)
europeCoords$value <- europeanUnionTable$value[match(europeCoords$region,europeanUnionTable$country)]
P <- ggplot() + geom_polygon(data = europeCoords, aes(x = long, y = lat, group = region, fill =
value),
colour = "black", size = 0.1) +
coord_map(xlim = c(-13, 35), ylim = c(32, 71))
How can I fix the problem and add the circle?
Thank you!
You might want to consider using the sf (simple features) package to work with geographic data.
Below is code to map the countries you've specified, and to plot a circle centered in Germany. You may need to crop or filter the data, as there are a few EU landmasses far outside what most consider 'Europe'.
The circle turns out a bit wonky due to the projection over a large area.
library(ggplot2)
library(grid)
#library(rworldmap)
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
# Member States of the European Union
europeanUnion <- c("Austria","Belgium","Bulgaria","Croatia","Cyprus",
"Czech Rep.","Denmark","Estonia","Finland","France",
"Germany","Greece","Hungary","Ireland","Italy","Latvia",
"Lithuania","Luxembourg","Malta","Netherlands","Poland",
"Portugal","Romania","Slovakia","Slovenia","Spain",
"Sweden")
library(rnaturalearth)
world_map <- ne_countries(scale = 50, returnclass = 'sf')
europe_map <- world_map %>% filter(name %in% europeanUnion)
circle <- st_as_sfc(st_bbox(europe_map %>% filter(name == 'Germany'))) %>%
st_transform(3035)%>% ## <- change projection to one in meters
st_centroid() %>% ## centroid point of the bounding box of germany
st_buffer(dist = 1e6) ## <- 1 million meters
p <- ggplot() +
geom_sf(data = europe_map, fill = 'orange') +
geom_sf(data = circle, fill = 'black', alpha = .2) +
theme_void()
p
Created on 2020-10-27 by the reprex package (v0.3.0)
Edit addressing questions in comment:
# make a point for frankfurt:
frankfurt <- st_point(x = c(8.6821, 50.1109)) %>% ## coords from google
st_geometry()
# 1896km buffer (circle) around frankfurt
frankfurt_circle_1896 <- frankfurt %>%
st_set_crs(4326) %>%
st_transform(3035) %>%
st_buffer(dist = 1896000) ## 1896km in m
## Crop the europe map, removing French Guana, etc.
## change x&y coords as needed, these are approximations
europe_bbox <- st_bbox(c(xmin = -12, xmax = 34, ymax = 71, ymin = 34), crs = st_crs(4326))
europe_map_cropped <- europe_map %>%
st_crop(europe_bbox)
# plotting
p2 <- ggplot() +
geom_sf(data = europe_map_cropped, fill = 'orange') +
geom_sf(data = frankfurt_circle_1896, alpha = .2, fill = 'black')
p2
I want to dissolve a polygon so I get only a lines for the outline of the whole region instead of it being broken up by county.
install.packages (c("tidyverse","mapdata","maps","stringr","viridis"))
library(tidyverse)
library(mapdata)
library(maps)
library(stringr)
library(viridis)
california <- map_data("state", region="california")
california1 <- ggplot() +
geom_polygon(data = california,
aes(x = long, y = lat, group = group),
color="black", fill="NA") +
coord_quickmap()
#california county lines
uscounties <-map_data("county")
ca_county <- uscounties %>% filter(region == "california")
central<- ca_county %>%
filter(subregion %in% c("alpline", "kings", "tulare", "fresno", "inyo", "kern", "madera"))
ca2 <- california1 +
theme_void() +
geom_polygon(data = central,
aes(x = long, y = lat, group = group),
fill = "white", color = "black") +
geom_polygon(color = "black", fill = NA) +
annotate("text", x = -119, y = 46.5, label="Central", colour="black")
ca2
Thanks in advance for the help!
I've answered a similar question before. Reworked it slightly for your use case, with explanations in annotated code below:
library(tidyverse)
library(maps)
# get map (as map object)
county_map <- map("county", regions = "california",
fill = T, plot = FALSE)
# convert to SpatialPolygonsDataFrame object (using maptools & sp packages)
county_map_match <- data.frame(name = county_map$names) %>%
separate(name, c("region", "subregion"), sep = ",", remove = FALSE) %>%
mutate(central = subregion %in% c("alpline", "kings", "tulare",
"fresno", "inyo", "kern", "madera")) %>%
column_to_rownames("name")
county_map <- maptools::map2SpatialPolygons(county_map, ID = county_map$names)
county_map <- sp::SpatialPolygonsDataFrame(county_map, county_map_match)
rm(county_map_match)
# remove any invalidity (using rgeos package) before dissolving
rgeos::gIsValid(county_map) # check
county_map <- rgeos::gBuffer(county_map, byid = TRUE, width = 0)
rgeos::gIsValid(county_map) # check again (invalidities removed)
# dissolve by whether each polygon is part of central area
county_map <- maptools::unionSpatialPolygons(county_map, IDs = county_map$central)
county_map <- fortify(county_map)
county_map <- county_map %>% filter(group == "TRUE.1")
# plot all the central counties as one polygon
ggplot() +
geom_polygon(data = county_map,
aes(x = long, y = lat, group = group),
fill = "white", colour = "black") +
coord_map()