I am using a point dataset of class sf and a road network of class sf. I created a buffer with the road network using the st_buffer() function and I can successfully select the points that are within the roads by using the following:
points_within_roads <- st_intersection(points_shp, roads_buffer)
I need to do the opposite. I want to select the points that are outside the roads. Is there a function that allows me to do that? Thank you in advance.
You may want to check the sf::st_disjoint function. For example:
# packages
library(sf)
#> Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3
# create some fake data
set.seed(1234)
my_line <- st_linestring(rbind(c(-1, -1), c(1, 1)))
my_points <- st_cast(st_sfc(st_multipoint(matrix(runif(100, -1, 1), ncol = 2))), "POINT")
my_buffer <- st_buffer(my_line, 0.1)
# plot
par(mar = rep(0, 4))
plot(st_boundary(my_buffer), col = "darkgrey")
plot(my_line, add = TRUE)
plot(my_points[my_buffer, op = st_intersects], add = TRUE, col = "darkred")
plot(my_points[my_buffer, op = st_disjoint], add = TRUE, col = "darkblue")
Created on 2020-04-29 by the reprex package (v0.3.0)
Moreover, I think you misspelt sf::st_intersection where it should be sf::st_intersects.
Could use of ! answer this question? Below is assuming you have an unique identifier column of some sort (ID).
points_outside_buffer <- filter(points_shp, !points_within_roads$ID %in% points_shp$ID)
I just did the below with some data I am working on and it worked fine
too_far <- filter(stations_sf_r, !stations_sf_r$StationCode %in% repeats$StationCode)
Related
I have been trying to plot a raster layer by setting the value 1 to the color white. I looked at many examples but still couldn't construct the colors as I wish. I want contrasting colors for the values below and above 1. I would like them start with a light tone and get darker as they go further from 1. I also posted the figure that I managed to create so far. It looks a bit weird since it is based on made up data. I can't share the real data unfortunately. The best would be to create this using viridis colors, but I don't know how doable it is.
I wonder if anyone has any suggestions?
I got the idea of breakpoints and colors from the following post :https://gis.stackexchange.com/questions/17339/raster-legend-in-r-how-to-colour-specific-values .
I got the shapefile from here : https://gadm.org/download_country.html .
Here is my example:
library(rgdal)
library(raster)
library(sp)
library(sf)
set.seed(123)
proj = "+units=km +proj=utm +zone=37 +ellps=clrk80 +towgs84=-160,-6,-302,0,0,0,0 +no_defs"
map0 = readOGR(dsn = "dataFiles/gadm40_NGA_shp", #https://gadm.org/download_country.html (Nigeria/shapefile)
layer = "gadm40_NGA_0")
map0_trnsfrmd = spTransform(map0,proj)
predRaster <- raster(ncol=400, nrow=400, xmn=-3805.7869, xmx=-2222.120, ymn=562.5405, ymx=1828.165)
res(predRaster) = 5
projection(predRaster) = "+units=km +proj=utm +zone=37 +ellps=clrk80 +towgs84=-160,-6,-302,0,0,0,0 +no_defs"
idx = 1:80201 # index for the cell numbers
val = c(rnorm(50000), rep(1,10201),runif(20000,min=0, max=3))
r = setValues(predRaster, values = val, index=idx) # assign values to the cells
r = raster::mask(crop(r, extent(map0_trnsfrmd)), map0_trnsfrmd, snap = 'out')
below=val[val<1]
above=val[val>1]
min(below)
[1] -4.289319
max(above)
[1] 4.438207
max(below)
[1] 0.9998253
min(above)
[1] 1.000105
breakpoints = c(-4.289319, 0.9998253, 1.000105, 4.438207)
colors = c("red","white","blue")
par(mgp=c(4,1,0), mar=c(5,7,3,1)+0.1)
plot(r,las=1, asp = 1, xlab="Easting", ylab="Northing", axis.args = list(cex.axis=1),
legend.shrink =1,legend.width=2, cex.lab=2, cex.axis=1.5, legend.args = list("title", cex =1),breaks=breakpoints,col=colors)
exampleplot
Please look below on the colors definition. I have removed the shape for clarity.
library(rgdal)
library(raster)
library(sp)
library(sf)
set.seed(123)
predRaster <- raster(ncol=400, nrow=400, xmn=-3805.7869, xmx=-2222.120, ymn=562.5405, ymx=1828.165)
res(predRaster) = 5
projection(predRaster) = "+units=km +proj=utm +zone=37 +ellps=clrk80 +towgs84=-160,-6,-302,0,0,0,0 +no_defs"
idx = 1:80201 # index for the cell numbers
val = c(rnorm(50000), rep(1,10201),runif(20000,min=0, max=3))
r = setValues(predRaster, values = val, index=idx) # assign values to the cells
below=val[val<1]
above=val[val>1]
colors = c(colorRampPalette(c(rgb(1,0,0,1), rgb(1,0,0,0.1)), alpha = TRUE)(19),"white", colorRampPalette(c(rgb(0,0,1,0.1), rgb(0,0,1,1)), alpha = TRUE)(19))
plot(r, col=colors, xlab="Easting", ylab="Northing", axis.args = list(cex.axis=1),
legend.shrink =1,legend.width=2, cex.axis=1.5, legend.args = list("title", cex =1))
You can increase the number of colors on both sides. Please check the help for colorRampPalette() function.
Created on 2022-08-31 by the reprex package (v2.0.1)
I have a road network shapefile and list of points. I have to create a route from the list of points and then overlay/ spatially join (integrate the attributes of points that are overlaying the road segments)
The sample road network shape file can be found here https://drive.google.com/drive/folders/103Orz6NuiWOaFoEkM18SlzFTjGYi1rju?usp=sharing
The following is the code for points with lat (x) and long (y) information. The "order" column means, the order of destinations in the route .
points <-tribble (
~x,~y, ~order,
78.14358, 9.921388,1,
78.14519, 9.921123,2,
78.14889, 9.916954,3,
78.14932, 9.912807,4,
78.14346, 9.913828,5,
78.13490, 9.916551,6,
78.12904, 9.918782,7
)
What I want as an output is a layer of the route joining all the points in the order as mentioned. And I also want to integrate/ do a spatial join of the route to the road segments.
Thanks in advance
The following answer is based on the R package sfnetworks which can be installed as follows:
install.packages("remotes")
remotes::install_github("luukvdmeer/sfnetworks")
First of all, load packages
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(sfnetworks)
library(tidygraph)
and data. The points object is converted to sf format.
roads <- st_read("C:/Users/Utente/Desktop/Temp/roads_test.shp") %>% st_cast("LINESTRING")
#> Reading layer `roads_test' from data source `C:\Users\Utente\Desktop\Temp\roads_test.shp' using driver `ESRI Shapefile'
#> Simple feature collection with 785 features and 0 fields
#> geometry type: MULTILINESTRING
#> dimension: XY
#> bbox: xmin: 78.12703 ymin: 9.911192 xmax: 78.15389 ymax: 9.943905
#> geographic CRS: WGS 84
points <- tibble::tribble (
~x,~y, ~order,
78.14358, 9.921388,1,
78.14519, 9.921123,2,
78.14889, 9.916954,3,
78.14932, 9.912807,4,
78.14346, 9.913828,5,
78.13490, 9.916551,6,
78.12904, 9.918782,7
)
points <- st_as_sf(points, coords = c("x", "y"), crs = 4326)
Plot network and points (just to understand the problem a little bit better)
par(mar = rep(0, 4))
plot(roads, reset = FALSE)
plot(points, add = TRUE, cex = (1:7)/1.5, col = sf.colors(7), lwd = 4)
Convert roads to sfnetwork object
network <- as_sfnetwork(roads, directed = FALSE)
Subdivide edges and select the main component. Check https://luukvdmeer.github.io/sfnetworks/articles/preprocess_and_clean.html for more details.
network <- network %>%
convert(to_spatial_subdivision, .clean = TRUE) %>%
convert(to_components, .select = 1, .clean = TRUE) %E>%
mutate(weight = edge_length())
Now I want to estimate the shortest paths between each pair of consecutive points. sfnetwork does not support many-to-many routing, so we need to define a for-loop. If you need to repeat this operation for several points, I think you should check the R package dodgr.
routes <- list()
for (i in 1:6) {
path <- st_network_paths(
network,
from = st_geometry(points)[i],
to = st_geometry(points)[i + 1]
)
routes[[i]] <- path
}
Extract the id of the edges that compose all shortest paths
idx <- unlist(pull(do.call("rbind", routes), edge_paths))
Hence, if you want to extract the edges from the original network
network_shortest_path <- network %E>% slice(idx)
roads_shortest_path <- network_shortest_path %E>% st_as_sf()
Plot network and points
par(mar = rep(0, 4))
plot(roads, reset = FALSE)
plot(st_geometry(roads_shortest_path), add = TRUE, col = "darkgreen", lwd = 4)
plot(points, add = TRUE, cex = (1:7)/1.5, col = sf.colors(7), lwd = 4)
Created on 2021-03-07 by the reprex package (v0.3.0)
How can one add a new node to a SpatialLinesNetwork?
context of my problem: I have a shapefile of a bus route and another shapefile of bus stops. I want to calculate the distance between stops along the bus route. Ideally, each stop would be a node and I would use stplanr::sum_network_routes() to calculate the distance between them. The problem is that when I convert the bus route into a SpatialLinesNetwork the network only has a few nodes that are far from each other and unrelated to bus stops locations.
reproducible dataset:
# load library and data
library(stplanr)
library(sf)
# get road data
data(routes_fast)
rnet <- overline(routes_fast, attrib = "length")
# convert to sf obj
rnet <- st_as_sf(rnet)
# convert SpatialLinesDataFrame into SpatialLinesNetwork
sln <- SpatialLinesNetwork(rnet)
# identify nodes
sln_nodes = sln2points(sln)
# Here is a bus stop which should be added as a node
new_point_coordinates = c(-1.535, 53.809)
p = sf::st_sf(geometry = sf::st_sfc(sf::st_point(new_point_coordinates)), crs = st_crs(rnet))
# plot
plot(sln, col = "gray") # network
plot(sln_nodes, col="red", add = TRUE) # nodes
plot(p, add=T, col="blue") # stop to be added as a new node
This doesn't answer your question at the outset, but I believe it does resolve your "Context" by showing how your desired network distances can be calculated. This can be done with dodgr (latest dev version) like this:
library (dodgr)
library (stplanr)
library (sf)
library (sp)
dat <- st_as_sf (routes_fast)
net <- weight_streetnet (dat, wt_profile = 1)
The net object is a simple data.frame containing all edges and vertices of the network. Then adapt your code above to get the routing points as a simple matrix
rnet rnet <- overline(routes_fast, attrib = "length")
SLN <- SpatialLinesNetwork(rnet)
sln_nodes = sln2points(SLN)
xy <- coordinates (sln_nodes)
colnames (xy) <- c ("x", "y")
Node that sln2points simply returns "nodes" (in stplanr terminology), which are junction points. You can instead replace with coordinates of bus stops, or simply add those to this matrix. The following three lines convert those coordinates to unique (nearest) vertex IDs of the dodgr net object:
v <- dodgr_vertices (net)
pts <- match_pts_to_graph (v, xy)
pts <- v$id [pts]
To calculate distances between those pts on the network, just
d <- dodgr_dists (net, from = pts, to = pts)
Thanks for the question, thanks to this question and subsequent collaboration with Andrea Gilardi, I'm happy to announce that it is now possible to add new nodes to sfNetwork objects with a new function, sln_add_node().
See below and please try to test reproducible code that demonstrates how it works:
devtools::install_github("ropensci/stplanr")
#> Skipping install of 'stplanr' from a github remote, the SHA1 (33158a5b) has not changed since last install.
#> Use `force = TRUE` to force installation
library(stplanr)
#> Registered S3 method overwritten by 'R.oo':
#> method from
#> throw.default R.methodsS3
#> Warning in fun(libname, pkgname): rgeos: versions of GEOS runtime 3.7.1-CAPI-1.11.1
#> and GEOS at installation 3.7.0-CAPI-1.11.0differ
sample_routes <- routes_fast_sf[2:6, NULL]
sample_routes$value <- rep(1:3, length.out = 5)
rnet <- overline2(sample_routes, attrib = "value")
#> 2019-09-26 16:06:18 constructing segments
#> 2019-09-26 16:06:18 building geometry
#> 2019-09-26 16:06:18 simplifying geometry
#> 2019-09-26 16:06:18 aggregating flows
#> 2019-09-26 16:06:18 rejoining segments into linestrings
plot(sample_routes["value"], lwd = sample_routes$value, main = "Routes")
plot(rnet["value"], lwd = rnet$value, main = "Route network")
sln <- SpatialLinesNetwork(rnet)
#> Linking to GEOS 3.7.1, GDAL 2.4.0, PROJ 5.2.0
new_point_coordinates <- c(-1.540, 53.826)
crs <- sf::st_crs(rnet)
p <- sf::st_sf(geometry = sf::st_sfc(sf::st_point(new_point_coordinates)), crs = crs)
p_dest <- sln2points(sln)[9, ]
# We can identify the nearest point on the network at this point
# and use that to split the associated linestring:
sln_new <- sln_add_node(sln = sln, p = p)
#> although coordinates are longitude/latitude, st_nearest_feature assumes that they are planar
route_new <- route_local(sln = sln_new, from = p, to = p_dest)
plot(sln_new)
plot(p, add = TRUE)
plot(route_new, lwd = 5, add = TRUE)
#> Warning in plot.sf(route_new, lwd = 5, add = TRUE): ignoring all but the
#> first attribute
Created on 2019-09-26 by the reprex package (v0.3.0)
In case it's of use/interest, see the source code of the new small family of functions that support this new functionality here: https://github.com/ropensci/stplanr/blob/master/R/node-funs.R
Hallo everyone can anybody help me to upgrade my code with possibility of insering additional data into my map. This is the code that draw me a map with intensity of migration, and I am trying to add ehtnic information of every region (many small pie charts).
to draw a map
con <- url("http://biogeo.ucdavis.edu/data/gadm2/R/UKR_adm1.RData")
print(load(con))
close(con)
name<-gadm$VARNAME_1
value<-c(4,2,5,2,1,2,4,2,2,4,1,1,1,4,3,3,1,1,3,1,2,4,5,3,4,2,1)
gadm$VARNAME_1<-as.factor(value)
col<- colorRampPalette(c('cadetblue4','cadetblue1','mediumseagreen','tan2','tomato3'))(260)
spplot(gadm, "VARNAME_1", main="Ukraine", scales = list(draw = TRUE), col.regions=col)
sp.label <- function(x, label) {
list("sp.text", coordinates(x), label)
}
NAME.sp.label <- function(x) {
sp.label(x, x$NAME_1)
}
draw.sp.label <- function(x) {
do.call("list", NAME.sp.label(x))
}
spplot(gadm, 'VARNAME_1', sp.layout = draw.sp.label(gadm), col.regions=col,
colorkey = list(labels = list( labels = c("Very low","Low", "Average",
"High","Very high"),
width = 1, cex = 1)))
and this is a part of df, that I am trying to add to that map as pie charts or bar charts, with every latitude (lat) and longitude (long) to locate mu bar or pie charts.
df<-data.frame(region=c('Kiev oblast', 'Donezk oblast'),
rus=c(45,35), ukr=c(65,76), mold=c(11,44),long=c(50.43,48),
lat=c(30.52, 37.82))
i found one example and another but... can't figure out how to use it in ma case.
Hope for your help, thank you.
only that solution i have discovered by now, but it doesn't upgrade my code(((
mapPies( df,nameX="lat", nameY="long", nameZs=c('rus','ukr','mold'),
xlim=c(30,33), ylim=c(44,53), symbolSize = 2)
perhaps this will help:
pieSP The function provide SpatialPolygonsDataFrame depending on few attributes, ready to use for plotGoogleMaps or spplot.
library(plotGoogleMaps)
data(meuse)
coordinates(meuse)<-~x+y
proj4string(meuse) <- CRS('+init=epsg:28992')
pies <- pieSP(meuse,zcol=c('zinc','lead','copper'), max.radius=120)
pies$pie <- rep(c('zinc','lead','copper'),155)
pies$pie2 <- rep(1:3,155)
spplot(pies, 'pie2')
I'm trying to make very simple GUI for my script. In nutshell problem looks like that :
dataset is dataframe, I would like to plot one column as the time and use simple GUI for choosing next/previus column.
dataset <-data.frame(rnorm(10), rnorm(10), rnorm(10))
columnPlot <- function(dataset, i){
plot(dataset[, i])
}
how to use tcltk for calling fplot with different i's ?
Not what you asked for (not tcltkrelated), but I would advise you to have a look at the new shiny package from RStudio.
Are you particularly attached to the idea of using tcltk? I've been working on something similar using the gWidgets package and have had some success. According to it's CRAN site, "gWidgets provides a toolkit-independent API for building interactive GUIs". This package uses tcltk or GTK2 and I've been using the GTK2 portion. Here's a quick example of a GUI with a spinbutton for changing i. I also added a little fanciness to your function because you mentioned you would be plotting time series, so I made the x axis Time.
data<-data.frame(rnorm(11),rnorm(11),rnorm(11))
i = 1
fplot <- function(i, data = data){
library(ggplot2)
TimeStart <- as.Date('1/1/2012', format = '%m/%d/%Y')
plotdat <- data.frame(Value = data[ ,i], Time = seq(TimeStart,TimeStart + nrow(data) - 1, by = 1))
myplot <- ggplot(plotdat, aes(x = Time, y = Value))+
geom_line()
print(myplot)
}
library(gWidgets)
options(guiToolkit = 'RGtk2')
window <- gwindow ("Time Series Plots", visible = T)
notebook <- gnotebook (cont = window)
group1 <- ggroup(cont = notebook, label = "Choose i", horizontal=F)
ichooser <- gspinbutton(cont = group1, from = 1, to = ncol(data), by = 1, value = i, handler = function(h,...){
i <<- svalue(h$obj)})
plotbutton <- gbutton('Plot', cont = group1, handler=function(h,...){
fplot(i, data)})
graphicspane1 <- ggraphics(cont = group1)