I m trying to create polygon from cluster of points boundaries of which would be touching all exterior points. Any help to improve my code would be appreciated.
library(dplyr)
library(sf)
df<- read.table(text ="lon lat
74.03687 30.17482
74.23605 30.23773
74.24127 29.95988
74.29211 30.07575
74.25612 30.17687
74.15972 30.06242
74.06484 30.11025
74.36046 30.02749
74.08133 30.01889
74.26168 30.16881
73.91083 30.01378
74.00881 30.07585
74.40638 29.97712
74.34974 30.22231
74.20501 30.11133
74.18108 30.01113
74.00717 30.11362
73.94891 30.03807
74.18977 30.14367
74.18857 30.13621
74.19862 30.15222
74.19376 30.13425",header= T)
polygon <- df %>%
st_as_sf(coords = c("lon", "lat"), crs = 4326) %>%
summarise(geometry = st_combine(geometry)) %>%
st_cast("POLYGON")
plot(polygon)
Need the output like blue line in a single polygon.
I recommend using the concaveman package for this task:
library(concaveman)
pnts <- df %>%
st_as_sf(coords = c("lon", "lat"), crs = 4326)
polygon <- concaveman(pnts)
plot(polygon, reset = FALSE)
plot(pnts, add = TRUE)
The following code:
plot(df, type='n')
polygon(df)
chx <- chull(df)
chx <- rbind(df = df[chx, ], df[chx[1], ])
lines(chx, col='blue', lwd=4)
Will produce the following plot:
Or remove the polygon(df) to get:
I hope you find it useful.
Related
How can I remove the crossing line while using the buffer code below. I tried to create buffers round some point locations and to have a union but ended up getting a crossline.
please see the codes below
train_data
library(raster)
library(dismo)
library(sf)
bioc1 <- getData('worldclim', var='bio', res=5) #
bio1 <- bioc1[[1]]
plot(bio1)
train <- read.csv("forexample_training.csv") # the points locations to be buffered
head(train)
train.sf <- sf::st_as_sf(train, coords=c("longitude", "latitude"), crs=raster::crs(bio1))
plot(train.sf, add=TRUE)
eckertIV <- "+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs"
train.sf <- sf::st_transform(train.sf, crs = eckertIV)
train.buf <- sf::st_buffer(train.sf, dist = 500000) %>%
sf::st_union() %>%
sf::st_sf() %>%
sf::st_transform(crs = raster::crs(bio1))
plot(bio1, main = names(bio1))
train.sf <- sf::st_as_sf(train, coords=c("longitude", "latitude"), crs=raster::crs(bio1))
plot(train.sf, add=TRUE)
# To add sf objects to a plot, use add = TRUE
plot(train.buf, border = "red", lwd = 3, add = TRUE)
I'm trying to create a heatmap based on schools/unis/colleges in SF.
I am querying them from OSM and would like to plot them in CRS 2227.
This is what I tried:
san_fran_map <- get_map(c(-122.5209,37.6020,-122.3489,37.8130), maptype = "toner-background", source = "stamen")
location_spec <- opq(bbox = c(-122.5209,37.6020,-122.3489,37.8130))
specified_institutions <- c("college","school","university")
osm_institution <- location_spec %>%
add_osm_feature(key = "amenity", value = specified_institutions) %>%
osmdata_sf ()
#removing polygons that are empty
not_all_na <- function(x) any(!is.na(x))
osm_polys <- osm_institution$osm_polygons %>%
select(where(not_all_na))
#creating a centroid
osm_polys$geometry <- st_centroid(osm_polys$geometry)
osm_polys <- st_sf(osm_polys)
osm_polys<-subset(osm_polys, (!is.na(osm_polys$name))) %>% #removing all unnamed ones
filter(duplicated("name") == FALSE)
#splitting geography column up into longitude/latitude
osm_polys <- osm_polys %>%
dplyr::mutate(longitude = sf::st_coordinates(.)[,1],
latitude = sf::st_coordinates(.)[,2])
osm_polys <- st_as_sf(osm_polys, coords = c("longitude", "latitude"), crs = 2227, remove = FALSE)
san_fran <- ggmap(san_fran_map, extent="device", legend="none")
heatmap_map5 <- san_fran + stat_density2d(data=osm_polys,
aes(x="latitude", y="longitude",
fill=..level..,
alpha=..level..),
geom="polygon")
heatmap_map5 <- heatmap_map5 + scale_fill_gradientn(colours=rev(brewer.pal(7, "Spectral")))
heatmap_map5
It leaves me with the error "Error: Discrete value supplied to continuous scale". I don't really know how to fix it and every adjustment I make leaves me with more errors.
These are the libraries I'm using (and a couple of others):
library("tidyverse")
library("sf")
library("readr")
library("dplyr")
library("tidytable")
library("tmap")
library("ggplot2")
library("mapsf")
library("scales")
library("ggmap") # need to cite if using
library("maptools")
library("acs")
library("leaflet")
library("tidycensus")
library("cowplot")
library("googleway")
library("ggrepel")
library("ggspatial")
library("rnaturalearth")
library("rnaturalearthdata")
library("RColorBrewer")
library("data.table")
library("osrm")
library("osmdata")
library(tidyverse)
library(tidycensus)
library(sf)
library(sp)
#install.packages('geosphere')
library('geosphere')
library(rgeos)
library(sfheaders)
#install.packages('reshape')
library('reshape')
#> Linking to GEOS 3.6.1, GDAL 2.1.3, PROJ 4.9.3
census_tract <- get_acs(geography = "tract",
variables = "B19013_001",
state = "CA",
county = c("San Joaquin","Merced","stanislaus"),
geometry = TRUE,
year = 2020)
plot(st_geometry(census_tract), axes = T)
plot(st_centroid(st_geometry(census_tract)), pch = "+", col = "red", add = T)
library(ggplot2)
ggplot(census_tract) + geom_sf() +
geom_sf(aes(geometry = st_centroid(st_geometry(census_tract))), colour = "red")
census_tract$centroid <- st_centroid(st_geometry(census_tract))
schoolloc <- read.csv("C:/Users/rlnu/Desktop/EXAMPLE/pubschls.csv")
schoolloc <- schoolloc%>% filter(County == c("San Joaquin","Merced","Stanislaus"))
census_tract <- census_tract %>%
mutate(long = unlist(map(census_tract$centroid,1)),
lat = unlist(map(census_tract$centroid,2)))
shortest_distance$min_distance <- expand.grid.df(census_tract,schoolloc) %>%
mutate(distance = distHaversine(p1 = cbind(long,lat),
p2 = cbind(Longitude,Latitude))
`
I am trying to find distance between the each census tract's centroid to three nearest schools. please help me out with it. I have written some code . The logic is wrong and the code is not working
Can achieve this using the sf package.
I could not access you schools data so made a dummy set of 4 schools.
library(sf)
schools <- data.frame(School_Name=c("School_1", "School_2", "School_3", "School_4"), Lat=c(37.83405, 38.10867, 37.97743, 37.51615), Long=c(-121.2810, -121.2312, -121.2575, -120.8772)) %>% st_as_sf(coords=c("Long", "Lat"), crs=4326)
Convert tracts to centroids and make the crs the same as the school set then calculate the distance matrix
census_centroid <- st_centroid(census_tract) %>% st_transform(4326)
DISTS<- st_distance(census_centroid, schools)
Rename the columns to be the school IDs
colnames(DISTS) <- schools$School_Name
link it back to centoids
cent_dists <- cbind(census_centroid, DISTS) %>% #bind ditances to centroids
pivot_longer(cols = -names(census_centroid), names_to = "School Name", values_to = "Distance") %>% #make long for ordering
group_by(NAME) %>% #group by centroid
slice_min(Distance,n= 3) %>% # take three closest
mutate(Near_No=paste0("Near_School_",rep(1:3))) #School distance ranking
Make wide if one row per census centroid desired, might want to play with column order though
cent_dists_wide <- cent_dists %>%
pivot_wider(names_from = c("Near_No"), values_from = c("Distance", "School Name"), names_sort = FALSE) #make wid if wyou want one row per centoid
What I would like to be able to is to generate a circle packing plot of values similar as shown here:
https://www.r-graph-gallery.com/308-interactive-circle-packing/
However, I'd like to be able to plot that within the boundaries of an area on a map, such as a county area using leaflet (or other packages) within R.
I tried running the code provided from the site in their example to generate their plot but I am unable to get it work for me for some reason.
When I try to do it myself within a mapped area, it comes out to be something like below. Thank you for your help.
packages <-c("tidyverse","charlatan" "ggmap", "reshape2", "raster", "GISTools", "rgdal", "sp", "maps", "mapdata", "rgeos", "maptools", "rstan", "leaflet")
lapply(packages, require, character.only = TRUE)
us <- getData('GADM', country='USA', level=2)
texas <- subset(us,NAME_1=="Texas")
Dallas <- subset(texas, NAME_2=="Dallas")
leaflet(Dallas) %>%
addPolygons() %>%
addTiles()
bb <- bbox(Dallas)
minx <- bb[1]
miny <- bb[2]
maxx <- bb[3]
maxy <- bb[4]
set.seed(23)
LL1k <- data.frame(ch_position(n = 7, bbox = c(minx, miny, maxx, maxy)))
LL1kcol <- as.data.frame(t(LL1k))
colnames(LL1kcol) <- c("lon", "lat")
leaflet(Dallas) %>%
addPolygons() %>%
addTiles() %>%
addCircles(lat = LL1kcol$lat, lng = LL1kcol$lon, radius = iris$Sepal.Length*500, color = iris$Species)
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)