I would like to ask how to calculate number of point that are in some region when we have longtitue and latitude variables of point and polygon of country and its regions.
I provided example below:
I would like to calculate how many point are in what regions (including zero when there is no point) and than add this variables to data2#data object so one can use count measures to fill each regions polygons.
library(leaflet)
library(tidyverse)
set.seed(101)
URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds"
data2 <- readRDS(url(URL2))
URL3 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_ESP_2_sp.rds"
data3 <- readRDS(url(URL3))
URL4 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_PRT_2_sp.rds"
data4 <- readRDS(url(URL4))
URL5 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_GBR_2_sp.rds"
data5 <- readRDS(url(URL5))
random_long_lat <-
data.frame(
long = sample(runif(300, min = -2.5, max = 15.99), replace = F),
lat = sample(runif(300, min = 42.69, max = 59.75), replace = F)
)
all <- rbind(data2, data3, data4, data5)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=all, stroke = TRUE, color = "black", weight="", smoothFactor = 0.95,
fill = F) %>%
addCircles(lng = random_long_lat$long, lat = random_long_lat$lat)
# Here add new variable called count, that would count how many point are in the region
all#data
I would like the result so one can calculate something like this:
all#data <-
all#data %>%
mutate(counts = rnorm(nrow(all), 100, sd = 20))
cuts <- c(0, 5, 20, 40, 80, 150, max(all#data$counts))
cuts <- colorBin("Greens", domain = all$counts, bins = cuts)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=all, stroke = TRUE, color = "white", weight="", smoothFactor = 0.95,
fillOpacity = 0.65, fillColor = ~cuts(all$counts)) %>%
addLegend(pal = cuts,
values = all$counts,
labFormat = labelFormat(suffix = " "),
opacity = 0.85, title = "How many point were counted in each region", position = "topright")
however I dont know is it posible to calculate number of point in each regions having just coordinances?
If you transform the points and France polygons to sf objects, you can use st_intersects() to count the number of points in each polygon.
Note that I updated your sample points so that each quintile break in cuts is unique. With your original data, the first three quintiles were just 0 so the coloring in the leaflet map didn't work.
new sample data
library(leaflet)
library(tidyverse)
set.seed(101)
URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds"
data2 <- readRDS(url(URL2))
random_long_lat <-
data.frame(
long = sample(runif(1000, min = -2.5, max = 5.99), replace = F),
lat = sample(runif(1000, min = 42.69, max = 49.75), replace = F)
)
make sf objects and count points in polygons
library(sf)
data_sf <- data2 %>% st_as_sf()
random_long_lat_sf <- random_long_lat %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
data_sf_summary <- data_sf %>%
mutate(counts = lengths(st_intersects(., random_long_lat_sf)))
define breaks for legend and draw map
cuts <- quantile(data_sf_summary$counts, probs = seq(0, 1, 0.2))
cuts <- colorBin("Greens", domain = data_sf_summary$counts, bins = cuts)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=data_sf_summary, stroke = TRUE, color = "white", weight="", smoothFactor = 0.95,
fillOpacity = 0.65, fillColor = ~cuts(data_sf_summary$counts)) %>%
addLegend(pal = cuts,
values = data_sf_summary$hdp,
labFormat = labelFormat(suffix = " "),
opacity = 0.85, title = "How many point were counted in each region", position = "topright")
Also note that tmap package, which lets you switch between static and interactive maps using the same syntax (which resembles ggplot syntax).
same map with tmap:
library(tmap)
tmap_mode("view") # make map interactive
tm_shape(data_sf_summary) +
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
title = "How many point were counted in each region")
static map with tmap:
library(tmap)
tmap_mode("plot") # make map static
tm_shape(data_sf_summary) +
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
title = "How many point were counted in each region") +
tm_layout(legend.position = c("right","top"))
For multiple countries
First create new sample points that cover Europe:
random_long_lat <-
data.frame(
long = sample(runif(1000, min = -7.5, max = 19.99), replace = F),
lat = sample(runif(1000, min = 38.69, max = 60.75), replace = F)
)
all <- rbind(data2, data3, data4, data5)
Then make the sf objects and find the counts of points in every polygon:
all_sf <- all %>% st_as_sf()
random_long_lat_sf <- random_long_lat %>%
st_as_sf(coords = c("long", "lat"), crs = 4326)
all_sf_summary <- all_sf %>%
mutate(counts = lengths(st_intersects(., random_long_lat_sf)))
qtm(random_long_lat_sf)
Option 1: Choose maps from a list object by name using the NAME_0 column.
tmap_mode("view") # make maps interactive
list_of_maps <- map(unique(all_sf_summary$NAME_0),
~ tm_shape(all_sf_summary %>%
filter(NAME_0 == .x)) + # filter the data for your country of interest
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
alpha = 0.85,
border.col = NA,
title = "How many point were counted in each region") +
tm_layout(legend.position = c("right","top"))) %>%
set_names(unique(all_sf_summary$NAME_0))
list_of_maps[['France']]
list_of_maps[['Portugal']]
Option 2: Show all the maps at once
### all maps at once
tm_shape(all_sf_summary) + # filter the data for your country of interest
tm_polygons(col = "counts",
n = 5,
palette = "Greens",
alpha = 0.85,
border.col = NA,
title = "How many point were counted in each region") +
tm_layout(legend.position = c("right","top")) +
tm_facets(by = c("NAME_0"), ncol = 2, showNA = FALSE)
Related
How would one convert leaflet map to a static plot and then save it as pdf?,
I have createa a large leaflet map, that has over 150 MB, using mapshot does not work because it is very large. I think that convert it to static plot and then save it is more propriate.
I provided example:
library(leaflet)
library(tidyverse)
URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_2_sp.rds"
data2 <- readRDS(url(URL2))
URL3 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_ESP_2_sp.rds"
data3 <- readRDS(url(URL3))
URL4 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_PRT_2_sp.rds"
data4 <- readRDS(url(URL4))
URL5 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_GBR_2_sp.rds"
data5 <- readRDS(url(URL5))
random_long_lat <-
data.frame(
long = sample(runif(300, min = -2.5, max = 15.99), replace = F),
lat = sample(runif(300, min = 42.69, max = 59.75), replace = F)
)
all <- rbind(data2, data3, data4, data5)
all#data <-
all#data %>%
mutate(counts = rnorm(nrow(all), 100, sd = 20))
cuts <- c(0, 5, 20, 40, 80, 150, max(all#data$counts))
cuts <- colorBin("Greens", domain = all$counts, bins = cuts)
m <-
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=all, stroke = TRUE, color = "white", weight="", smoothFactor = 0.95,
fillOpacity = 0.65, fillColor = ~cuts(all$counts)) %>%
addLegend(pal = cuts,
values = all$counts,
labFormat = labelFormat(suffix = " "),
opacity = 0.85, title = "How many point were counted in each region", position = "topright")
I would like to convert map m to static map, and then save it as pdf, however I can quite figure out how.
Using command for example:
library(mapview)
mapshot(m, file = "maps.pdf")
Is very slow and when saving map that has more than 100MB usually returns an error.
I probably have very complex question related to leaflet, I am trying to plot multile countries of Europe (data downloaded from GADM), and then create a network matrix for countries, however france contain island and for some reasons computation of weight matrix work, however when creating a dataframe of it, it cannon be created (when france is dropped data6 it works)
Is there a way how to delete that island from France data, or are there pager pages where can one get and easily plot countries like in my example?
also when france is dropped and map is created in leaflet there is a weird horizontal line, can it be somehow erased?
example down here (seem very long, but that is because of many country geodata)
library(leaflet)
library(ggplot2)
library(sf)
library(spdep)
library(leaflet.minicharts)
library(leafletCN)
# Regions of each country selected
URL <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_DEU_1_sp.rds"
data <- readRDS(url(URL))
URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CZE_1_sp.rds"
data2 <- readRDS(url(URL2))
URL3 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_POL_1_sp.rds"
data3 <- readRDS(url(URL3))
URL4 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_SVK_1_sp.rds"
data4 <- readRDS(url(URL4))
URL5 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_AUT_1_sp.rds"
data5 <- readRDS(url(URL5))
URL6 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_1_sp.rds"
data6 <- readRDS(url(URL6))
URL7 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_HUN_1_sp.rds"
data7 <- readRDS(url(URL7))
URL8 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_BEL_1_sp.rds"
data8 <- readRDS(url(URL8))
URL9 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_NLD_1_sp.rds"
data9 <- readRDS(url(URL9))
URL10 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CHE_1_sp.rds"
data10 <- readRDS(url(URL10))
# Country borders of all countries
B_URL <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_DEU_0_sp.rds"
Bdata <- readRDS(url(B_URL))
B_URL2 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CZE_0_sp.rds"
Bdata2 <- readRDS(url(B_URL2))
B_URL3 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_POL_0_sp.rds"
Bdata3 <- readRDS(url(B_URL3))
B_URL4 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_SVK_0_sp.rds"
Bdata4 <- readRDS(url(B_URL4))
B_URL5 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_AUT_0_sp.rds"
Bdata5 <- readRDS(url(B_URL5))
B_URL6 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_FRA_0_sp.rds"
Bdata6 <- readRDS(url(B_URL6))
B_URL7 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_HUN_0_sp.rds"
Bdata7 <- readRDS(url(B_URL7))
B_URL8 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_BEL_0_sp.rds"
Bdata8 <- readRDS(url(B_URL8))
B_URL9 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_NLD_0_sp.rds"
Bdata9 <- readRDS(url(B_URL9))
B_URL10 <- "https://biogeo.ucdavis.edu/data/gadm3.6/Rsp/gadm36_CHE_0_sp.rds"
Bdata10 <- readRDS(url(B_URL10))
# Trying to perform network base on QUEEN AND ROOK
A <- rbind(data, data2, data3, data4, data5,data6, data7, data8, data9, data10)
queen_data <- poly2nb(A, queen = F)
queen_data <- nb2listw(queen_data, style = "W", zero.policy = TRUE)
# Creating dataframe for plot purposes
data_df <- data.frame(coordinates(A))
colnames(data_df) <- c("long", "lat")
n = length(attributes(queen_data$neighbours)$region.id)
DA = data.frame(
from = rep(1:n,sapply(queen_data$neighbours,length)),
to = unlist(queen_data$neighbours),
weight = unlist(queen_data$weights)
)
DA = cbind(DA, data_df[DA$from,], data_df[DA$to,])
colnames(DA)[4:7] = c("long","lat","long_to","lat_to")
leaflet() %>% addProviderTiles("CartoDB.Positron") %>%
addPolygons(data=data, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data2, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data3, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data4, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data5, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data7, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data8, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data9, weight = 1, fill = F, color = "red") %>%
addPolygons(data=data10, weight = 1, fill = F, color = "red") %>%
addPolygons(data=Bdata, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata2, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata3, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata4, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata5, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata6, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata7, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata8, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata9, weight = 3, fill = F, color = "black") %>%
addPolygons(data=Bdata10, weight = 3, fill = F, color = "black") %>%
addCircles(lng = data_df$long, lat = data_df$lat, weight = 9) %>%
#addCircles(lng = data_df2$long, lat = data_df2$lat) %>%
addFlows(lng0 = DA$long, lat0 = DA$lat,lng1 = DA$long_to, lat1 = DA$lat_to,
dir = 0, maxThickness= 0.85)
I came up with mechanical solution where we would mechaniccaliy force data.frame to have same number of rows, however this approach is not good.
A <- rbind(data, data2, data3, data4, data5, data6, data7, data8, data9, data10)
queen_data <- poly2nb(A, queen = T)
queen_data <- nb2listw(queen_data, zero.policy = T)
plot(A)
plot(queen_data, coordinates(A), add = T, col = "red")
# Creating dataframe for plot purposes
data_df <- data.frame(coordinates(A))
colnames(data_df) <- c("long", "lat")
n = length(attributes(queen_data$neighbours)$region.id)
weights = unlist(queen_data$weights)
data_df[DA$from,] %>% dim()
da_to = data_df[DA$to,]
da_to[709, c(1, 2)] = NA
weight[709] = NA
DA = data.frame(
from = rep(1:n,sapply(queen_data$neighbours,length)),
to = unlist(queen_data$neighbours),
weight = weight
)
DA = cbind(DA, data_df[DA$from,], da_to)
colnames(DA)[4:7] = c("long","lat","long_to","lat_to")
final plot should look like plot(A) plot(queen_data, coordinates(A), add = T, col = "red") and when plotting this DA dataframe leaflet it is NOT the same and therefore not right.
I have created a map that has different layers for different variables, but would like to also have a selector box that allows you to select which year you view, essentially filtering the data for that particular year.
The code below makes the map based on all years data. I'd like almost the same map, but with the ability to change what year you are viewing data for (i.e. 1990, 1991, 1992, or 1993)
# get shapefiles (download shapefiles: 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, tweak this code so you can download data directly ####
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
sample <- 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
sample <- st_as_sf(sample %>% left_join(usgeo))
# drop layers (not sure why, but won't work without this)
sample$geometry <- st_zm(sample$geometry, drop = T, what = "ZM")
# change projection
sample <- sf::st_transform(sample, "+proj=longlat +datum=WGS84")
# create popups
incomepopup <- paste0("County: ", sample$NAME, ", avg income = $", sample$income)
poppopup <- paste0("County: ", sample$NAME, ", avg pop = ", sample$pop)
lifepopup <- paste0("County: ", sample$NAME, ", avg life expectancy = ", sample$life)
# create color palettes
lifePalette <- colorNumeric(palette = "Purples", domain=sample$life)
incomePalette <- colorNumeric(palette = "Reds", domain=sample$income)
popPalette <- colorNumeric(palette = "Oranges", domain=sample$pop)
# create map
leaflet(sample) %>%
addProviderTiles("CartoDB.Positron") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = poppopup,
color = ~popPalette(sample$pop),
group = "pop") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = lifepopup,
color = ~lifePalette(sample$life),
group = "life") %>%
addPolygons(stroke=FALSE,
smoothFactor = 0.2,
fillOpacity = .8,
popup = incomepopup,
color = ~incomePalette(sample$income),
group = "income") %>%
addLayersControl(
baseGroups=c("income", "life", "pop"),
position = "bottomleft",
options = layersControlOptions(collapsed = FALSE)
)
The first map here (and screenshotted below) shows the output of what I already have (except the data is filtered for only year == 1993). I'd like that, but without the "year" variable, and instead, an additional selector box that would allow you to select which year you want data for.
I am working with the leaflet R package. I have a zoning system made of polygons and I'd like to lay their IDs on top of them. Below is an illustration (with another software) of my objective.
Thanks for your suggestions!
Since there is no reproducible data, I decided to use one of my previous posts related to leaflet. There are two things you want to take away from this post: 1) you need to create a data frame containing center points of target regions, 2) you need to use addLabelOnlyMarkers(). You can achieve the first thing using gCentroid(). I added row names of the polygon data set (UK) as character to centers. This is used for labeling. You need to think what labels you use in your own case. Once this data set is ready, you want to use it in addLabelOnlyMarkers().
library(raster)
library(rgeos)
library(leaflet)
# Get UK polygon data
UK <- getData("GADM", country = "GB", level = 2)
# Find a center point for each region
centers <- data.frame(gCentroid(UK, byid = TRUE))
centers$region <- row.names(UK)
### Create dummy data
set.seed(111)
mydf <- data.frame(place = unique(UK$NAME_2),
value = sample.int(n = 1000, size = n_distinct(UK$NAME_2), replace = TRUE))
### Create five colors for fill
mypal <- colorQuantile(palette = "RdYlBu", domain = mydf$value, n = 5, reverse = TRUE)
leaflet() %>%
addProviderTiles("OpenStreetMap.Mapnik") %>%
setView(lat = 55, lng = -3, zoom = 6) %>%
addPolygons(data = UK,
stroke = FALSE, smoothFactor = 0.2, fillOpacity = 0.3,
fillColor = ~mypal(mydf$value),
popup = paste("Region: ", UK$NAME_2, "<br>",
"Value: ", mydf$value, "<br>")) %>%
addLabelOnlyMarkers(data = centers,
lng = ~x, lat = ~y, label = ~region,
labelOptions = labelOptions(noHide = TRUE, direction = 'top', textOnly = TRUE)) %>%
addLegend(position = "bottomright", pal = mypal, values = mydf$value,
title = "UK value",
opacity = 0.3)
I'm trying to think what is the best way to generate a fake map with some fake data that is random but follows some conditions. For example I want to have 8 dots east of the "Deleng" river and 12 west. I want the mean of the color to be higher east than west. Other than that, I want the points to be random
This is the code I have right now:
set.seed(7102015)
gen.schools <- function(n.schools){
School.long <- rnorm(n = n.schools, mean = 21.7672, sd = 0.025)
School.lat <- rnorm(n = n.schools, mean = 58.8471, sd = 0.025)
School.VAM <- rnorm(n = n.schools, mean = 0, sd = 1)
Schools <- data.frame(School.lat, School.long, School.VAM)
return(Schools)
}
district.map <- gen.schools(n.schools = 20)
library(leaflet)
# Create a continuous palette function
pal <- colorNumeric(
palette = "RdYlBu",
domain = district.map$School.VAM
)
leaflet() %>% addTiles("http://opengeofiction.net/osm_tiles/{z}/{x}/{y}.png") %>%
setView(lng = 21.7672, lat = 58.8471, 13) %>%
addCircleMarkers(data = district.map, lat = ~School.lat, lng =~School.long,
fillColor = ~pal(School.VAM),
stroke = FALSE, fillOpacity = 1) %>%
addLegend(position = "topright",
pal = pal, values = district.map$School.VAM,
title = "Performance Index",
opacity = 1
)
If using the river as a condition is not possible, can I superimpose a fine lat long grid to this fake map so I can pick the points by hand?
Thanks!