I have converted a raster to a point matrix in R. The file has 3 columns, x (lon), y (lat) and v (pixel value) - I am now looking to delete every second column by x and every second row by y as shown in the upper left corner of the image but am at loss how to do this. The idea is to thin the data without any interpolation or resampling.
Sample data as shown can be accessed here: https://drive.google.com/file/d/1XGEPsPEyrVNLEcZy-C6ES5915kWIaqGz/view?usp=sharing
When asking an R question, please always include a minimal reproducible, self-contained example, that is show some code and do not rely on files that must be downloaded.
As you started out with raster data, it is probably easiest to manipulate the raster data before creating points.
With the raster package:
Example data
library(raster)
r <- raster(nrow=20, ncol=20, xmn=0, xmx=1, ymn=0, ymx=1, crs="+proj=utm +zone=1 +datum=WGS84")
values(r) <- 1:ncell(r)
p <- rasterToPoints(r)
plot(r)
points(p, cex=.5)
Solution
i <- seq(1, nrow(r), 2)
j <- seq(1, ncol(r), 2)
r[i,] <- NA
r[, j] <- NA
pp <- rasterToPoints(r)
points(pp, pch=20, cex=2)
Or with the terra package:
library(terra)
r <- rast(nrow=20, ncol=20, xmin=0, xmax=1, ymin=0, ymax=1, crs="+proj=utm +zone=1 +datum=WGS84")
values(r) <- 1:ncell(r)
p <- as.points(r)
plot(r)
points(p, cex=.5)
i <- seq(1, nrow(r), 2)
j <- seq(1, ncol(r), 2)
r[i,] <- NA
r[, j] <- NA
pp <- as.points(r)
points(pp, pch=20, cex=2)
Does this work? Hard to know what to manipulate without a reproducible example and desired output, but this should remove even rows and columns from your matrix.
library(dplyr)
matrix(1:100, nrow = 10) %>%
as.data.frame() %>%
filter(row_number() %% 2 != 0) %>%
select(seq(1, ncol(.), 2)) %>%
as.matrix()
I'd like to create histograms of raster values for polygons based on different combinations of their attributes. Reproducible data below:
library(raster)
library(sp)
poly <- raster(nrow=10, ncol=10)
poly[] <- runif(ncell(poly)) * 10
poly <- rasterToPolygons(poly, fun=function(x){x > 9})
r <- raster(nrow=100, ncol=100)
r[] <- runif(ncell(r))
poly#data$place<-sample(letters[1:3], length(poly), TRUE)
poly#data$rank<-sample.int(3, length(poly), replace = TRUE)
plot(r)
plot(poly, add=TRUE, lwd=4)
v <- raster::extract(r, poly, df=TRUE)
I can plot a histogram for all of the IDs (i.e., polygons) in v with ggplot
ggplot(v, aes(layer)) + geom_histogram(aes(y = stat(count / sum(count))), binwidth = 0.25)
However, I'd like to create a set of three histograms based on the rank attribute (i.e., 1,2,3) and another set of three histograms based on the place attribute (i.e., a,b,c). Perhaps using facet in ggplot but I'm not sure how to link the IDs in v to the attributes in poly.
Your example:
library(raster)
#Loading required package: sp
pr <- raster(nrow=10, ncol=10)
set.seed(1)
values(pr) <- runif(ncell(pr)) * 10
poly <- rasterToPolygons(pr, fun=function(x){x > 9})
poly$place <- sample(letters[1:3], length(poly), TRUE)
poly$rank <- sample.int(3, length(poly), replace = TRUE)
r <- raster(nrow=100, ncol=100)
values(r) <- runif(ncell(r))
v <- raster::extract(r, poly, df=TRUE)
Assign an explicit ID the polygons, only keep variables of interest, and extract the data.frame from the SpatialPolygonsDataFrame.
poly$ID <- 1:length(poly)
poly$layer <- NULL
d <- data.frame(poly)
Merge
vd <- merge(d, v, by="ID")
Select a subset and make a histogram
x <- vd[vd$place == "a",]
hist(x$layer)
This is how I plot multiple raster
library(raster)
x <- raster::getData('worldclim', var='tmin', res = 10)
var.list <- c("tmin1","tmin2","tmin3","tmin4")
ras.stack <- stack()
for(i in var.list){
stack.list <- stack(stack.list, x[[paste0(i)]])
}
spplot(stack.list)
I want to do the same for 4 shape files which have a common attribute
called "mean.value"
fra <- raster::getData('GADM',country = 'FRA', level = 2)
shp.stack <- stack()
for(i in 1:4){
mean.value <- data.frame(NAME_2 = fra#data$NAME_2, sample(1:200, 96))
my.shp <- merge(fra, mean.value, by = 'NAME_2')
shp.stack <- stack(shp.stack, my.shp)
}
Error in sapply(x, fromDisk) & sapply(x, inMemory) : operations
are possible only for numeric, logical or complex types
How can I fix it?
You have to transform the SpatialPolygonsDataFrame to a raster object first, to be able to stack it. You could also transform to SpatialGrid*, SpatialPixels* - objects based on the manual of raster::stack.
So your second code would become something like this:
library(raster)
fra <- raster::getData('GADM',country = 'FRA', level = 2)
shp.stack <- stack()
for(i in 1:4){
mean.value <- data.frame(NAME_2 = fra#data$NAME_2, sample(1:200, 96))
my.shp <- raster::merge(fra, mean.value, by = 'NAME_2')
r <- raster(ncol=180, nrow=180)
extent(r) <- extent(my.shp)
rp <- rasterize(x = my.shp, y = r)
shp.stack <- raster::stack(shp.stack, rp)
}
plot(shp.stack)
I would like to plot the SpatialPointsDataFrame points over raster by attributes attr1. Specifically, I would like 1's to be red and 0's to be blue circles. Help will be appreciated.
s <- 1 # scale
increment <- seq(-6,6,1) # Create a sequence of x values
y=matrix(0,length(increment))
for (i in 1:length(increment)) {
y[i] <- 1/(1+ exp(-(increment[i])/s))
}
# Create matrix:
rep <- 8
valuematrix <- replicate(rep,y[,1])
library(sp)
library(raster)
raster <- raster(valuematrix)
# Create SpatialPointsDataFrame
x <- c(0.2,0.04,0.7)
y <- c(0.34,0.5,0.9)
attr1 <- c(0,1,0)
attr2 <- c(32,13,30)
data_DF <- data.frame(x,y,attr1,attr2)
colnames(data_DF) <- c("x","y","attr1","attr2")
coords <- data.frame(data_DF$x, data_DF$y)
coords <- SpatialPoints(coords, proj4string=CRS(as.character(NA)), bbox = NULL)
initialdata_DF <- data.frame(coords,data_DF$attr1,data_DF$attr2)
initialdata_SPDF <- SpatialPointsDataFrame(coords,initialdata_DF)
plot(raster)
plot(initialdata_SPDF, add=TRUE)
Does anyone know of a way to turn the output of contourLines polygons in order to plot as filled contours, as with filled.contours. Is there an order to how the polygons must then be plotted in order to see all available levels? Here is an example snippet of code that doesn't work:
#typical plot
filled.contour(volcano, color.palette = terrain.colors)
#try
cont <- contourLines(volcano)
fun <- function(x) x$level
LEVS <- sort(unique(unlist(lapply(cont, fun))))
COLS <- terrain.colors(length(LEVS))
contour(volcano)
for(i in seq(cont)){
COLNUM <- match(cont[[i]]$level, LEVS)
polygon(cont[[i]], col=COLS[COLNUM], border="NA")
}
contour(volcano, add=TRUE)
A solution that uses the raster package (which calls rgeos and sp). The output is a SpatialPolygonsDataFrame that will cover every value in your grid:
library('raster')
rr <- raster(t(volcano))
rc <- cut(rr, breaks= 10)
pols <- rasterToPolygons(rc, dissolve=T)
spplot(pols)
Here's a discussion that will show you how to simplify ('prettify') the resulting polygons.
Thanks to some inspiration from this site, I worked up a function to convert contour lines to filled contours. It's set-up to process a raster object and return a SpatialPolygonsDataFrame.
raster2contourPolys <- function(r, levels = NULL) {
## set-up levels
levels <- sort(levels)
plevels <- c(min(values(r), na.rm=TRUE), levels, max(values(r), na.rm=TRUE)) # pad with raster range
llevels <- paste(plevels[-length(plevels)], plevels[-1], sep=" - ")
llevels[1] <- paste("<", min(levels))
llevels[length(llevels)] <- paste(">", max(levels))
## convert raster object to matrix so it can be fed into contourLines
xmin <- extent(r)#xmin
xmax <- extent(r)#xmax
ymin <- extent(r)#ymin
ymax <- extent(r)#ymax
rx <- seq(xmin, xmax, length.out=ncol(r))
ry <- seq(ymin, ymax, length.out=nrow(r))
rz <- t(as.matrix(r))
rz <- rz[,ncol(rz):1] # reshape
## get contour lines and convert to SpatialLinesDataFrame
cat("Converting to contour lines...\n")
cl <- contourLines(rx,ry,rz,levels=levels)
cl <- ContourLines2SLDF(cl)
## extract coordinates to generate overall boundary polygon
xy <- coordinates(r)[which(!is.na(values(r))),]
i <- chull(xy)
b <- xy[c(i,i[1]),]
b <- SpatialPolygons(list(Polygons(list(Polygon(b, hole = FALSE)), "1")))
## add buffer around lines and cut boundary polygon
cat("Converting contour lines to polygons...\n")
bcl <- gBuffer(cl, width = 0.0001) # add small buffer so it cuts bounding poly
cp <- gDifference(b, bcl)
## restructure and make polygon number the ID
polys <- list()
for(j in seq_along(cp#polygons[[1]]#Polygons)) {
polys[[j]] <- Polygons(list(cp#polygons[[1]]#Polygons[[j]]),j)
}
cp <- SpatialPolygons(polys)
cp <- SpatialPolygonsDataFrame(cp, data.frame(id=seq_along(cp)))
## cut the raster by levels
rc <- cut(r, breaks=plevels)
## loop through each polygon, create internal buffer, select points and define overlap with raster
cat("Adding attributes to polygons...\n")
l <- character(length(cp))
for(j in seq_along(cp)) {
p <- cp[cp$id==j,]
bp <- gBuffer(p, width = -max(res(r))) # use a negative buffer to obtain internal points
if(!is.null(bp)) {
xy <- SpatialPoints(coordinates(bp#polygons[[1]]#Polygons[[1]]))[1]
l[j] <- llevels[extract(rc,xy)]
}
else {
xy <- coordinates(gCentroid(p)) # buffer will not be calculated for smaller polygons, so grab centroid
l[j] <- llevels[extract(rc,xy)]
}
}
## assign level to each polygon
cp$level <- factor(l, levels=llevels)
cp$min <- plevels[-length(plevels)][cp$level]
cp$max <- plevels[-1][cp$level]
cp <- cp[!is.na(cp$level),] # discard small polygons that did not capture a raster point
df <- unique(cp#data[,c("level","min","max")]) # to be used after holes are defined
df <- df[order(df$min),]
row.names(df) <- df$level
llevels <- df$level
## define depressions in higher levels (ie holes)
cat("Defining holes...\n")
spolys <- list()
p <- cp[cp$level==llevels[1],] # add deepest layer
p <- gUnaryUnion(p)
spolys[[1]] <- Polygons(p#polygons[[1]]#Polygons, ID=llevels[1])
for(i in seq(length(llevels)-1)) {
p1 <- cp[cp$level==llevels[i+1],] # upper layer
p2 <- cp[cp$level==llevels[i],] # lower layer
x <- numeric(length(p2)) # grab one point from each of the deeper polygons
y <- numeric(length(p2))
id <- numeric(length(p2))
for(j in seq_along(p2)) {
xy <- coordinates(p2#polygons[[j]]#Polygons[[1]])[1,]
x[j] <- xy[1]; y[j] <- xy[2]
id[j] <- as.numeric(p2#polygons[[j]]#ID)
}
xy <- SpatialPointsDataFrame(cbind(x,y), data.frame(id=id))
holes <- over(xy, p1)$id
holes <- xy$id[which(!is.na(holes))]
if(length(holes)>0) {
p2 <- p2[p2$id %in% holes,] # keep the polygons over the shallower polygon
p1 <- gUnaryUnion(p1) # simplify each group of polygons
p2 <- gUnaryUnion(p2)
p <- gDifference(p1, p2) # cut holes in p1
} else { p <- gUnaryUnion(p1) }
spolys[[i+1]] <- Polygons(p#polygons[[1]]#Polygons, ID=llevels[i+1]) # add level
}
cp <- SpatialPolygons(spolys, pO=seq_along(llevels), proj4string=CRS(proj4string(r))) # compile into final object
cp <- SpatialPolygonsDataFrame(cp, df)
cat("Done!")
cp
}
It probably holds several inefficiencies, but it has worked well in the tests I've conducted using bathymetry data. Here's an example using the volcano data:
r <- raster(t(volcano))
l <- seq(100,200,by=10)
cp <- raster2contourPolys(r, levels=l)
cols <- terrain.colors(length(cp))
plot(cp, col=cols, border=cols, axes=TRUE, xaxs="i", yaxs="i")
contour(r, levels=l, add=TRUE)
box()
Building on the excellent work of Paul Regular, here is a version that should ensure exclusive polygons (i.e. no overlapping).
I've added a new argument fd for fairy dust to address an issue I discovered working with UTM-type coordinates. Basically as I understand the algorithm works by sampling lateral points from the contour lines to determine which side is inside the polygon. The distance of the sample point from the line can create problems if it ends up in e.g. behind another contour. So if your resulting polygons looks wrong try setting fd to values 10^±n until it looks very wrong or about right..
raster2contourPolys <- function(r, levels = NULL, fd = 1) {
## set-up levels
levels <- sort(levels)
plevels <- c(min(values(r)-1, na.rm=TRUE), levels, max(values(r)+1, na.rm=TRUE)) # pad with raster range
llevels <- paste(plevels[-length(plevels)], plevels[-1], sep=" - ")
llevels[1] <- paste("<", min(levels))
llevels[length(llevels)] <- paste(">", max(levels))
## convert raster object to matrix so it can be fed into contourLines
xmin <- extent(r)#xmin
xmax <- extent(r)#xmax
ymin <- extent(r)#ymin
ymax <- extent(r)#ymax
rx <- seq(xmin, xmax, length.out=ncol(r))
ry <- seq(ymin, ymax, length.out=nrow(r))
rz <- t(as.matrix(r))
rz <- rz[,ncol(rz):1] # reshape
## get contour lines and convert to SpatialLinesDataFrame
cat("Converting to contour lines...\n")
cl0 <- contourLines(rx, ry, rz, levels = levels)
cl <- ContourLines2SLDF(cl0)
## extract coordinates to generate overall boundary polygon
xy <- coordinates(r)[which(!is.na(values(r))),]
i <- chull(xy)
b <- xy[c(i,i[1]),]
b <- SpatialPolygons(list(Polygons(list(Polygon(b, hole = FALSE)), "1")))
## add buffer around lines and cut boundary polygon
cat("Converting contour lines to polygons...\n")
bcl <- gBuffer(cl, width = fd*diff(bbox(r)[1,])/3600000) # add small buffer so it cuts bounding poly
cp <- gDifference(b, bcl)
## restructure and make polygon number the ID
polys <- list()
for(j in seq_along(cp#polygons[[1]]#Polygons)) {
polys[[j]] <- Polygons(list(cp#polygons[[1]]#Polygons[[j]]),j)
}
cp <- SpatialPolygons(polys)
cp <- SpatialPolygonsDataFrame(cp, data.frame(id=seq_along(cp)))
# group by elev (replicate ids)
# ids = sapply(slot(cl, "lines"), slot, "ID")
# lens = sapply(1:length(cl), function(i) length(cl[i,]#lines[[1]]#Lines))
## cut the raster by levels
rc <- cut(r, breaks=plevels)
## loop through each polygon, create internal buffer, select points and define overlap with raster
cat("Adding attributes to polygons...\n")
l <- character(length(cp))
for(j in seq_along(cp)) {
p <- cp[cp$id==j,]
bp <- gBuffer(p, width = -max(res(r))) # use a negative buffer to obtain internal points
if(!is.null(bp)) {
xy <- SpatialPoints(coordinates(bp#polygons[[1]]#Polygons[[1]]))[1]
l[j] <- llevels[raster::extract(rc,xy)]
}
else {
xy <- coordinates(gCentroid(p)) # buffer will not be calculated for smaller polygons, so grab centroid
l[j] <- llevels[raster::extract(rc,xy)]
}
}
## assign level to each polygon
cp$level <- factor(l, levels=llevels)
cp$min <- plevels[-length(plevels)][cp$level]
cp$max <- plevels[-1][cp$level]
cp <- cp[!is.na(cp$level),] # discard small polygons that did not capture a raster point
df <- unique(cp#data[,c("level","min","max")]) # to be used after holes are defined
df <- df[order(df$min),]
row.names(df) <- df$level
llevels <- df$level
## define depressions in higher levels (ie holes)
cat("Defining holes...\n")
spolys <- list()
p <- cp[cp$level==llevels[1],] # add deepest layer
p <- gUnaryUnion(p)
spolys[[1]] <- Polygons(p#polygons[[1]]#Polygons, ID=llevels[1])
for(i in seq(length(llevels)-1)) {
p1 <- cp[cp$level==llevels[i+1],] # upper layer
p2 <- cp[cp$level==llevels[i],] # lower layer
x <- numeric(length(p2)) # grab one point from each of the deeper polygons
y <- numeric(length(p2))
id <- numeric(length(p2))
for(j in seq_along(p2)) {
xy <- coordinates(p2#polygons[[j]]#Polygons[[1]])[1,]
x[j] <- xy[1]; y[j] <- xy[2]
id[j] <- as.numeric(p2#polygons[[j]]#ID)
}
xy <- SpatialPointsDataFrame(cbind(x,y), data.frame(id=id))
holes <- over(xy, p1)$id
holes <- xy$id[which(!is.na(holes))]
if(length(holes)>0) {
p2 <- p2[p2$id %in% holes,] # keep the polygons over the shallower polygon
p1 <- gUnaryUnion(p1) # simplify each group of polygons
p2 <- gUnaryUnion(p2)
p <- gDifference(p1, p2) # cut holes in p1
} else { p <- gUnaryUnion(p1) }
spolys[[i+1]] <- Polygons(p#polygons[[1]]#Polygons, ID=llevels[i+1]) # add level
}
cp <- SpatialPolygons(spolys, pO=seq_along(llevels), proj4string=CRS(proj4string(r))) # compile into final object
## make polygons exclusive (i.e. no overlapping)
cpx = gDifference(cp[1,], cp[2,], id=cp[1,]#polygons[[1]]#ID)
for(i in 2:(length(cp)-1)) cpx = spRbind(cpx, gDifference(cp[i,], cp[i+1,], id=cp[i,]#polygons[[1]]#ID))
cp = spRbind(cpx, cp[length(cp),])
## it's a wrap
cp <- SpatialPolygonsDataFrame(cp, df)
cat("Done!")
cp
}