Related
so I've combined those 2 rasters and made them into one dem raster which contains elevation values:
dem1 = read_stars("srtm_43_06.tif")
dem2 = read_stars("srtm_44_06.tif")
pol = st_read("israel_borders.shp")
dem = st_mosaic(dem1, dem2)
dem = dem[, 5687:6287, 2348:2948]
names(dem) = "elevation"
dem = st_warp(src = dem, crs = 32636, method = "near", cellsize = 90)
Now I need to calculate a point geometry of the peak of the mountain by finding the centroid of the pixel that has the highest elevation in the image, does anyone know what functions I can use?
Building on Grzegorz Sapijaszko's example, here is an alternative path to the top of the mountain.
library(terra)
f <- system.file("ex/elev.tif", package="terra")
x <- rast(f)
If there is a single maximum, you can do
g <- global(x, which.max)
xyFromCell(x, g[,1])
# x y
#[1,] 6.020833 50.17917
Now, consider a situation with multiple maxima. I add three more cells with the maximum value.
x[c(1000, 2500, 5000)] <- 547
We can find the four highest peaks with:
g <- global(x, which.max)[[1]]
v <- x[g] |> unlist()
y <- ifel(x == v, v, NA)
p <- as.points(y)
crds(p)
#[1,] 6.020833 50.17917
#[2,] 6.154167 50.10417
#[3,] 5.987500 49.97083
#[4,] 6.237500 49.75417
You should not warp (project with terra) the raster data first because that changes the cell values and potentially the location of the highest peak. You should find the peaks with the original data, but then you can transform the results like this.
pp <- project(p, "EPSG:32636")
crds(pp)
# x y
#[1,] -1411008 5916157
#[2,] -1404896 5904422
#[3,] -1422145 5894509
#[4,] -1413735 5864236
With your files, you could start with something like
ff <- c("srtm_43_06.tif", "srtm_44_06.tif")
v <- vrt(ff)
g <- global(x, which.max)
And then continue as in the examples above.
Let's use terra, however similar approach can be applied by raster package as well. For testing purposes we will use raster supplied with terra package
library(terra)
#> terra 1.5.12
f <- system.file("ex/elev.tif", package="terra")
v <- rast(f)
plot(v)
You can check the details of your raster just typing the raster object name and pressing enter, you can check the min and max values with minmax() function form terra:
minmax(v)
#> elevation
#> [1,] 141
#> [2,] 547
Let's create another raster by copying original one, however checking if the value is the max value of elevation:
w <- v == minmax(v)[2]
plot(w)
Let's create a substitution matrix, and substitute all FALSE with NA and TRUE with 1:
mx <- matrix(c(FALSE, NA, TRUE, 1), ncol = 2, byrow = TRUE)
w <- classify(w, mx)
plot(v)
plot(as.polygons(w), add=TRUE)
Let's find centroids of those polygon(s):
pts <- centroids(as.polygons(w))
plot(pts, add=TRUE)
Let's see our coordinates:
as.data.frame(pts, geom = "WKT")
#> elevation geometry
#> 1 1 POINT (6.020833 50.179167)
Created on 2022-01-29 by the reprex package (v2.0.1)
I need to estimate the weighted average of raster values for the polygon shown in squares. I want to obtain raster value and its weight within each square in the polygon shape. (As shown in this post: How can I extract an area weighted sum from a raster into a polygon in R?)
But, please see my code below and the image of what I am getting as weights. Can somebody correct me what I am doing wrong here and why my output is different from as shown in the above post.? I want to obtain an output like in the post above. Seems likes the weights I am getting is wrong too.
Please see the attached input data set here:
https://bft.usu.edu/w8crs
Thanks.
library(raster)
library(sp)
library(rgdal)
library(rgeos)
rlist = list.files(getwd(), pattern = "tif$", full.names = TRUE)
inshp = "Test"
rdata <- rlist[1]
r <- raster(rdata)
sdata <- readOGR(dsn=getwd(), layer=inshp)
sdata <- spTransform(sdata, crs(r))
extract(r, sdata, weights=TRUE)
Output:
[[1]]
value weight
56.75139 1
[[2]]
value weight
61.18781 1
[[3]]
value weight
56.75139 1
[[4]]
value weight
61.18781 1
Here is a reproducible example
library(raster)
packageVersion("raster")
#[1] ‘2.8.4’
r <- raster(xmn=0, xmx=1, ymn=0, ymx=1, nrow=2, ncol=2)
values(r) <- 1:4
m <- matrix(c(0.4, 0.6, 0.8, 0.6, 0.7, 0.2, 0.3, 0.2), ncol=2, byrow=TRUE)
s <- spPolygons(m)
plot(r); lines(s)
extract(r, s, weights=TRUE)
#[[1]]
# value weight
#[1,] 1 0.0625
#[2,] 2 0.1875
#[3,] 3 0.3125
#[4,] 4 0.4375
This did not work for you, because your polygon was very small relative to the raster cell size. I have changed the function, such that it increases the precision for those cases. I now get this with your data:
> extract(r, sdata, weights=TRUE)
[[1]]
value weight
56.75139 1
[[2]]
value weight
[1,] 61.18781 0.6592593
[2,] 56.75139 0.3407407
[[3]]
value weight
56.75139 1
[[4]]
value weight
[1,] 61.18781 0.5522388
[2,] 56.75139 0.4477612
To make it reproducible without downloads, for one of your polygons:
library(raster)
r <- raster(ncol=2, nrow=1, xmn=596959.624056728, xmx=624633.120455544, ymn=568805.230192675, ymx=582641.978392083, crs='+proj=aea +lat_1=29.5 +lat_2=45.5 +lat_0=37.5 +lon_0=-96 +x_0=0 +y_0=0 +datum=NAD83 +units=m')
values(r) <- c(61.18781, 56.75139)
g <- data.frame(matrix(c(rep(1, 18), rep(0,6), 611318.079488842,611440.751254539,610712.115334383,609842.749239201, 609703.303842618,611318.079488842,581038.816616668,579434.971927127, 579381.167042005,579315.223934334,580917.724282178,581038.816616668), ncol=6))
colnames(g) <- c('object','part','cump','hole','x','y')
p <- as(g, "SpatialPolygons")
crs(p) <- crs(r)
extract(r, p, weights=TRUE)
#[[1]]
# value weight
#[1,] 61.18781 0.6592593
#[2,] 56.75139 0.3407407
I am using sp package to create SpatialLines object and save it in the list of objects allLines. Later on I will need to compare SpatialLines to each other, but this goes beyond the current question.
So far I only need to construct SpatialLines objects. This is the last code based on the answer of hrbrmstr:
library(sp)
allLines <- NULL
x <- c(1,5,4,8)
y <- c(1,3,4,7)
xy <- cbind(x,y)
xy.sp = sp::SpatialPoints(xy)
spl <- SpatialLines(list(Lines(Line(xy.sp), ID="a")))
allLines <- rbind(allLines,spl)
Error message:
Error in (function (classes, fdef, mtable) : unable to find an
inherited method for function ‘proj4string’ for signature ‘"NULL"’
How to solve this issue?
Is:
library(sp)
x <- c(1,5,4,8)
y <- c(1,3,4,7)
SpatialLines(list(Lines(Line(cbind(x,y)), ID="a")))
## An object of class "SpatialLines"
## Slot "lines":
## [[1]]
## An object of class "Lines"
## Slot "Lines":
## [[1]]
## An object of class "Line"
## Slot "coords":
## x y
## [1,] 1 1
## [2,] 5 3
## [3,] 4 4
## [4,] 8 7
##
##
##
## Slot "ID":
## [1] "a"
##
##
##
## Slot "bbox":
## min max
## x 1 8
## y 1 7
##
## Slot "proj4string":
## CRS arguments: NA
what you're looking for?
Getting back to your last question, try
library(sp)
as(xy.spdf, "SpatialLines")
or, to create a Lines object (which may not be what you want),
as(xy.spdf, "SpatialLines")#lines[[1]]
If you came to this question to find out how to make a group of lines (as implied by the name of the function, SpatialLines) you can find examples in the sp library, filed under "SpatialLines-class".
I found their example a little strange, so I edited it to make more sense for how I normally see the data.
## Make some line segments from points
## Note, l1a and l1b are a group of two lines
l1a <- rbind(c(1, 3), c(2,2) ,c(3,2))
l1b <- l1a + .05
l2 <- rbind(c(1,1), c(2,1.5), c(3,1))
## At this point it's just a matrix, and you can plot the points
plot(l1a, type="l", xlim=c(1,3.25), ylim=c(2,3.25), xlab="", ylab="")
lines(l1b)
## Make convert the matrix objects to line objects
Sl1a <- Line(l1a)
Sl1b <- Line(l1b)
Sl2 <- Line(l2)
## Group the individual lines into "lines"
S1 <- Lines(list(Sl1a, Sl1b), ID="a")
S2 <- Lines(list(Sl2), ID="b")
## Now combine the line groups into a "spatial line object"
Sl <- SpatialLines(list(S1,S2))
## Plot the group, then (for illustration) add each line
## separately with color to illustrate the groups
plot(Sl)
plot(SpatialLines(list(S1)), add=T, col="red")
plot(SpatialLines(list(S2)), add=T, col="blue")
## Examine the properties
summary(Sl)
plot(Sl, col = c("red", "blue"))
Both spatial line plots look like this:
Note the matrix object has named rows in the example. I don't see any benefit to doing this, and it's confusing because the names overlap but do not correspond with the IDs given.
I am looking for a method to calculate the center of gravity of each polygon in the list spatialpolygons:
I thought used a loop, but he gets me for the first polygon, I don't know the way, I am new to R, can someone please help me
Code:
for ( i in 1:length(polys1_T)) {
xx=mean(coordinates(polys1_T[[i]])[,1])
yy=mean(coordinates(polys1_T[[i]])[,2])
aa<-as.data.frame(cbind(xx,yy))
}
Edit:
Code:
inter1 <- read.table("c:/inter1.csv", header=TRUE)
# add a category (required for later rasterizing/polygonizing)
inter1 <- cbind(inter1,
cat
= rep(1L, nrow(inter1)), stringsAsFactors = FALSE)
# convert to spatial points
coordinates(inter1) <- ~long + lat
# gridify your set of points
gridded(inter1) <- TRUE
# convert to raster
r <- raster(inter1)
# convert raster to polygons
sp <- rasterToPolygons(r, dissolve = T)
plot(sp)
# addition transformation to distinguish well the set of polygons
polys <- slot(sp#polygons[[1]], "Polygons")
# plot
plot(sp, border = "gray", lwd = 2) # polygonize result
inter1.csv
result:
Polys is list of 9 polygons :is that it is possible to calculate the center of gravity for each polygon?
Give rgeos::gCentroid a look. You can apply it in many ways. If you have a SpatialPolygons object, say, from a call to readOGR, you can do:
map <- readOGR(dsn, layer)
centers <- data.frame(gCentroid(map, byid=TRUE))
to get all the centroids from it.
As an aside: while accurate—a more common term is "geometric center"/"centroid" vs "center of gravity"
EDIT
For plain, ol Polygons (the "hard" way, but slightly more accurate):
library(rgdal)
library(sp)
library(PBSmapping)
library(maptools)
do.call("rbind", lapply(polys, function(x) {
calcCentroid(SpatialPolygons2PolySet(SpatialPolygons(list(Polygons(list(x), ID=1)))))
}))[,3:4]
## X Y
## 1 5.8108434 20.16466
## 2 -3.2619048 29.38095
## 3 5.5600000 34.72000
## 4 3.8000000 32.57037
## 5 6.3608108 32.49189
## 6 -2.2500000 31.60000
## 7 -8.1733333 27.61333
## 8 0.3082011 27.44444
## 9 8.6685714 26.78286
and, to use your nearly-equivalent by-hand-method:
do.call("rbind", lapply(polys, function(x) {
data.frame(mean(coordinates(x)[,1]), mean(coordinates(x)[,2]))
}))
## mean.coordinates.x....1.. mean.coordinates.x....2..
## 1 5.819892 20.15484
## 2 -3.242593 29.37778
## 3 5.539474 34.71579
## 4 3.815517 32.56552
## 5 6.323034 32.47191
## 6 -2.230952 31.60000
## 7 -8.140476 27.61905
## 8 0.350000 27.40885
## 9 8.746825 26.92063
Each method gives you the centroid for each list element (and there are 9—not 5—in the example you provided).
If you ever have a huge list of these, consider using rbindlist from the data.table package (speedier + more memory efficient).
I need to calculate the centroids of a set of spatial zones based on a separate population grid dataset. Grateful for a steer on how to achieve this for the example below.
Thanks in advance.
require(raster)
require(spdep)
require(maptools)
dat <- raster(volcano) # simulated population data
polys <- readShapePoly(system.file("etc/shapes/columbus.shp",package="spdep")[1])
# set consistent coordinate ref. systems and bounding boxes
proj4string(dat) <- proj4string(polys) <- CRS("+proj=longlat +datum=NAD27")
extent(dat) <- extent(polys)
# illustration plot
plot(dat, asp = TRUE)
plot(polys, add = TRUE)
Three steps:
First, find all the cells in each polygon, return a list of 2-column matrices with the cell number and the value:
require(plyr) # for llply, laply in a bit...
cell_value = extract(dat, polys,cellnumbers=TRUE)
head(cell_value[[1]])
cell value
[1,] 31 108
[2,] 32 108
[3,] 33 110
[4,] 92 110
[5,] 93 110
[6,] 94 111
Second, turn into a list of similar matrices but add the x and y coords:
cell_value_xy = llply(cell_value, function(x)cbind(x,xyFromCell(dat,x[,"cell"])))
head(cell_value_xy[[1]])
cell value x y
[1,] 31 108 8.581164 14.71973
[2,] 32 108 8.669893 14.71973
[3,] 33 110 8.758623 14.71973
[4,] 92 110 8.581164 14.67428
[5,] 93 110 8.669893 14.67428
[6,] 94 111 8.758623 14.67428
Third, compute the weighted mean coordinate. This neglects any edge effects and assumes all grid cells are the same size:
centr = laply(cell_value_xy, function(m){c(weighted.mean(m[,3],m[,2]), weighted.mean(m[,4],m[,2]))})
head(centr)
1 2
[1,] 8.816277 14.35309
[2,] 8.327463 14.02354
[3,] 8.993655 13.82518
[4,] 8.467312 13.71929
[5,] 9.011808 13.28719
[6,] 9.745000 13.47444
Now centr is a 2-column matrix. In your example its very close to coordinates(polys) so I'd make a contrived example with some extreme weights to make sure its working as expected.
Another alternative.
I like it for its compactness, but it will likely only make sense if you're fairly familiar with the full family of raster functions:
## Convert polygons to a raster layer
z <- rasterize(polys, dat)
## Compute weighted x and y coordinates within each rasterized region
xx <- zonal(init(dat, v="x")*dat, z) / zonal(dat,z)
yy <- zonal(init(dat, v="y")*dat, z) / zonal(dat,z)
## Combine results in a matrix
res <- cbind(xx[,2],yy[,2])
head(res)
# [,1] [,2]
# [1,] 8.816277 14.35309
# [2,] 8.327463 14.02354
# [3,] 8.993655 13.82518
# [4,] 8.467312 13.71929
# [5,] 9.011808 13.28719
# [6,] 9.745000 13.47444
The answers by Spacedman and Josh are really great, but I'd like to share two other alternatives which are relatively fast and simple.
library(data.table)
library(spatialEco)
library(raster)
library(rgdal)
using a data.table approach:
# get centroids of raster data
data_points <- rasterToPoints(dat, spatial=TRUE)
# intersect with polygons
grid_centroids <- point.in.poly(data_points, polys)
# calculate weighted centroids
grid_centroids <- as.data.frame(grid_centroids)
w.centroids <- setDT(grid_centroids)[, lapply(.SD, weighted.mean, w=layer), by=POLYID, .SDcols=c('x','y')]
using wt.centroid{spatialEco} :
# get a list of the ids from each polygon
poly_ids <- unique(grid_centroids#data$POLYID)
# use lapply to calculate the weighted centroids of each individual polygon
w.centroids.list <- lapply(poly_ids, function(i){wt.centroid( subset(grid_centroids, grid_centroids#data$POLYID ==i)
, 'layer', sp = TRUE)} )
My own less elegant solution below. Gives exactly the same results as Spacedman and Josh.
# raster to pixels
p = rasterToPoints(dat) %>% as.data.frame()
coordinates(p) = ~ x + y
crs(p) = crs(polys)
# overlay pixels on polygons
ol = over(p, polys) %>% mutate(pop = p$layer) %>% cbind(coordinates(p)) %>%
filter(COLUMBUS_ %in% polys$COLUMBUS_) %>% # i.e. a unique identifier
dplyr::select(x, y, pop, COLUMBUS_) %>% as_data_frame()
# weighted means of x/y values, by pop
pwcs = split(ol, ol$COLUMBUS_) %>% lapply(function(g){
data.frame(x = weighted.mean(g$x, g$pop), y = weighted.mean(g$y, g$pop))
}) %>% bind_rows() %>% as_data_frame()