Problem
I want to rasterize spatial lines and assign the maximum value of all lines that touch/intersect a raster cell to that cell.
I work in terra with lines as a SpatVect object, I would hence prefer a terra::rasterize solution. I would also be happy with a solution using stars::st_rasterize (see also this question).
The documentation of terra::rasterize seems to suggest it does not support lines properly so far - using the fun argument seems to be limited to points vector data only. I tried with terra::rasterize nevertheless, see the example below.
I'm aware of raster::rasterize, but it seems a bit outdated since it's still sp object based. Or is it the only way to do it atm?
Example
Here you can see that neither the max nor the mean function seems to work properly when rasterizing via terra::rasterize(... fun = "max"/"mean"):
library("terra")
### Example data ###
f <- system.file("ex/lux.shp", package="terra")
v <- vect(f)
lns <- as.lines(v)
r <- rast(v, res=.2)
### Rasterize via terra::rasterize ###
x_max <- rasterize(lns, r, fun="max", field = "POP")
x_mean <- rasterize(lns, r, fun="mean", field = "POP")
### Plot results ###
fontsize <- 0.7
par(mfrow=c(1,3))
plot(lns, y = "POP", main = "Lines with original values")
text(lns, "POP", cex = fontsize)
plot(x_max, main = "Rasterized via fun 'max'")
text(x_max, cex = fontsize)
plot(lns, add = T)
plot(x_mean, main = "Rasterized via fun 'mean'")
text(x_mean, cex = fontsize)
plot(lns, add = T)
I have found a somewhat hacky solution.
As proposed in the comments, I turned the lines into points by sampling along them.
I used sf::st_line_sample() for this instead of rgeos::gInterpolate() - it was cleaner and easier. Then terra::rasterize() can handle the points correctly and applies the max fun as expected.
Confirmed by the plot below.
Example solution
library("terra")
library("dplyr")
library("sf")
library("units")
### Example data ###
f <- system.file("ex/lux.shp", package="terra")
v <- vect(f)
lns <- as.lines(v)
r <- rast(v, res=.2)
### Turn SpatVector lines into sf object
lns_sf <- lns %>%
st_as_sf() %>%
st_transform(2169) # reprojection needed for st_line_sample
### Sample points along all lines every kilometer
pts_geometries <- lns_sf %>%
st_line_sample(density = units::set_units(1, 1/km))
### Add attributes and make MULTIPOINTs simple POINTS
pts_sf <- st_sf(lns_sf,
geometry = pts_geometries) %>%
st_cast("POINT") %>%
st_transform(crs(lns))
### Go back to terra: Turn sf into SpatVector object
pts <- pts_sf %>%
vect()
### Now rasterization works and "max" function is applied corretly
x_max <- rasterize(pts, r, fun="max", field = "POP")
fontsize <- 0.7
par(mfrow=c(1,3))
plot(lns, y = "POP", main = "Lines with original values")
text(lns, "POP", cex = fontsize)
plot(x_max, main = "Rasterized with fun 'max' using points generated from lines")
text(x_max, cex = fontsize)
plot(lns, add = T)
plot(pts, main = "Points used for rasterization")
Related
I created a choropleth with base R but I'm struggling with the colors. First, the colors don't follow the same order as the intervals and second, two of the intervals are using the same color, all of which makes the graph hard to read. This happens regardless of how many colors I use. It also doesn't matter whether I'm using brewer.pal or base colors.Here is a map with its respective legend illustrating the issue.
Below are the statements that I use to create the graph once data has been downloaded:
#Relevant packages:
library(dplyr)
library(RColorBrewer)
library(rgdal)
#create colors vector
pop_colors <- brewer.pal(8,"Purples")
#create breaks/intervals
pop_breaks <- c(0,20000,40000,60000,80000,100000,120000)
#apply breaks to population
cuts <- cut(cal_pop$Pop2016, pop_breaks, dig.lab = 6)
#create a vector with colors by population according to the interval they belong to:
color_breaks <- pop_colors[findInterval(cal_pop$Pop2016,vec = pop_breaks)]
Create choropleth
plot(cal_pop,col = color_breaks, main = "Calgary Population (2016)")
#create legend
legend("topleft", fill = color_breaks, legend = levels(cuts), title = "Population")
I used readOGR() command to read the shape file, which I'm linking here in case anybody is interested in taking a look at the data.
I'd appreciate any advice you could give me.
Thanks!
Your error is in this line:
color_breaks <- pop_colors[findInterval(cal_pop$Pop2016,vec = pop_breaks)]
I can't read your data file, so I'll use a built-in one from the sf package.
library(sf)
nc <- readOGR(system.file("shapes/", package="maptools"), "sids")
str(nc#data)
colors <- brewer.pal(8,"Purples")
#create breaks/intervals
sid_breaks <- c(0,2,4,6,8,10,12,20,60)
#apply breaks to population
sid_cuts <- cut(nc$SID79, sid_breaks, dig.lab = 6, include=TRUE)
#create a vector with colors by population according to the interval they belong to:
sid_colors <- colors[sid_cuts]
#Create choropleth
par(mar=c(0,0,0,0))
plot(nc, col = sid_colors)
legend("bottomleft", fill = colors, legend = levels(sid_cuts), nc=2, title = "SID (1979)", bty="n")
My problem: I want to draw a map obtained via rastermap package with ggplot2.
Searching for alternatives to ggmap package I found the rastermap package which provides an easy way to obtain maps from external sources. The readme provides a very simple example:
# install.packages("devtools")
devtools::install_github("hadley/rastermap")
houston <- fetch_region(c(-95.80204, -94.92313), c(29.38048, 30.14344),
stamen("terrain"))
houston
plot(houston)
The problem comes whether I try to plot using ggplot. So far I've tried several ways but none of them seems to work. Is it possible? Any idea?
rastermap generates a matrix of colours in hexadecimal strings (#RRGGBB format). It may be simplest to convert this to a more common form for spatial data, a multiband raster brick, with separate layers for the red, green and blue.
We can write a short helper function to convert hexadecimal strings into the separate integer values (i.e. this is the reverse of the rgb() function):
un_rgb = function (x) {
x = unlist(str_split(x, ''))
r = paste0(x[2], x[3])
g = paste0(x[4], x[5])
b = paste0(x[6], x[7])
strtoi(c(r,g,b), 16)
}
Using this function we convert the rastermap matrix into a three band raster brick:
library(raster)
m = as.matrix(houston)
l=lapply(m[], un_rgb)
r=g=b=matrix(, dim(m)[1], dim(m)[2])
r[] = sapply(l, function(i) i[1])
g[] = sapply(l, function(i) i[2])
b[] = sapply(l, function(i) i[3])
rgb.brick = brick(raster(r), raster(g), raster(b))
And set the extent of the new raster to that of the original rastermap
extent(rgb.brick) = extent(matrix(unlist(attributes(houston)$bb), nrow=2))
Now that we have a more usual form of raster object, we can do various things with it. For example, we can plot it in ggplot using library(RStoolbox):
ggRGB(rgb.brick, r=1, g=2, b=3)
Or we can save it as an image to use as an annotation background in ggplot:
png('test.png', dim(rgb.brick)[2], dim(rgb.brick)[1])
plotRGB(rgb.brick, 1, 2, 3)
dev.off()
img <- png::readPNG("test.png")
gr <- grid::rasterGrob(img, interpolate=TRUE)
ggplot() + annotation_custom(gr, -Inf, Inf, -Inf, Inf)
Why would you want an alternative? You can get a stamen map from ggmap:
library(ggmap)
ggmap(get_stamenmap(c(-95.80204, 29.38048, -94.92313, 30.14344))) +
# some points to plot
geom_point(aes(x = seq(-95.5, -95.2, 0.1), y = seq(29.7, 30, 0.1)), color = "red")
I'm trying to overlay some spatial data from a bigger SpatialPolygonsDataFrame (world size) to a smaller (country size), by doing these:
x <- c("rgdal", "dplyr",'ggplot2')
apply(x, library, character.only = TRUE)
est<-readOGR(dsn='/estados_2010',layer='estados_2010')
est_f<-fortify(est)
est$id<-row.names(est)
est_f<-left_join(est_f,est#data)
zon<-readOGR(dsn='/Zonas Homogeneas/gyga_ed_poly.shp',layer='gyga_ed_poly')
zon_f<-fortify(zon)
zon$id<-row.names(zon)
zon_f<-left_join(zon_f,zon#data)
t<-ggplot()+geom_polygon(data=zon_f,aes(x=long,y=lat,group=group,fill=GRID_CODE))
t+geom_polygon(data=est_f,aes(x=long,y=lat,group=group),fill=NA,color='red')+coord_fixed(xlim=est_f$long,ylim=est_f$lat,1)
Which is resulting in this:
I'm want to select only what is being plotted inside the polygon with the red lines.
If someone could help me with this issue, I'll appreciate
PS.: For those who want to reproduce the example completely by yourselves, the files are available in the links above to my google drive:
https://drive.google.com/open?id=0B6XKeXRlyyTDakx2cmJORlZqNUE
Thanks in advance.
Since you are using polygons to display the raster values, you can use a spatial selection via [ like in this reproducible example:
library(raster)
library(rgdal)
bra <- getData("GADM", country = "BRA", level = 1)
r <- getData("worldclim", res = 10, var = "bio")
r <- r[[1]]
r <- crop(r, bra)
r <- rasterToPolygons(r)
# bra and raster (now as polygons) have to have the same projection, thusly reproject!
bra <- spTransform(bra, CRSobj = proj4string(r))
here comes the magic!!
r <- r[bra, ]
let's look at the results:
library(ggplot2)
t <- ggplot()+
geom_polygon(data=r,aes(x=long,y=lat,group=group, fill = rep(r$bio1, each = 5)))
t +
geom_polygon(data=bra,aes(x=long,y=lat,group=group),fill=NA,color='red') + coord_map()
A very common procedure is to transform lines and borders into SpatialPolygons objects using the Polygon functions from the sp package. But is it possible to transform other object classes into SpatialPolygons? I use the function circles from dismo to create a circumference with specific radius distance from a known spatial point. This function returns an object of class CirclesRange.
circ<-circles(spcoords,d=100000)
class(circ)
[1] "CirclesRange"
attr(,"package")
[1] "dismo"
When I try to convert the CirclesRange object into SpatialPolygons, the following error occurs:
Error: is.integer(pO) is not TRUE
Then, I have searched other ways to transform this object, but I have not been successful. I think that first it is necessary to transform "circ" into another class and then try to convert it to SpatialPolygons, but I can't find information about this.
Have a look at str(circ), the desired SpatialPolygons object is already part of the created object. You simply need to run circ#polygons to extract the polygon. Here is some sample code based on the meuse dataset.
## sample data
data(meuse)
coordinates(meuse) <- ~ x + y
proj4string(meuse) <- CRS("+init=epsg:28992")
## circle around the first 'meuse' feature (top-right corner)
circ <- circles(meuse[1, ], d = 1000, lonlat = FALSE)
poly <- circ#polygons
proj4string(poly) <- proj4string(meuse)
## display data
library(latticeExtra)
spplot(meuse, "elev", scales = list(draw = TRUE),
col.regions = topo.colors(100), key.space = "right") +
as.layer(spplot(poly, fill = "transparent", lwd = 2))
I'm trying to produce voronoi diagrams with R. The plotting of the diagrams itself is working fine, but I have a problem with labelling the different tiles of my plots.
The code I'm using is as follows:
data <- read.csv("data.csv", sep=",")
x <- data$column1
y <- data$column2
voro <- deldir(x,y,rw=c(0,1,0,1))
list <- tile.list(voro)
color <- heat.colors(6)
plot(list,polycol=color,close=TRUE)
plot(voro,number=TRUE,add=TRUE,wlines=c('tess'))
Is it possible to swap the numbers for custom labels before plotting the diagram?
You can use text to add the labels (you already know the coordinates, x and y).
library(deldir)
# Sample data
x <- c(2.3,3.0,7.0,1.0,3.0,8.0)
y <- c(2.3,3.0,2.0,5.0,8.0,9.0)
voro <- deldir(x,y,list(ndx=2,ndy=2),c(0,10,0,10))
# Plot
plot( tile.list(voro), polycol = heat.colors(6), close=TRUE )
plot( voro, add = TRUE, wlines = 'tess' )
text( x, y, labels = LETTERS[1:length(x)], adj = c(0,0) )