How do I plot a specific row over time? For example I want to plot row 10(layer.1 to 5 is actually year 1 to year 5.
library(raster)
r <- raster(nrow=5, ncol=5)
s <- stack( sapply(1:5, function(i) setValues(r, rnorm(ncell(r), i, 3) )) )
s[]
layer.1 layer.2 layer.3 layer.4 layer.5
[1,] 6.7134890 6.9141251 4.38213123 4.8995302 2.3105321
[2,] 3.4323121 6.1074031 10.12872426 3.6728949 3.2252562
[3,] 4.4370107 3.1397068 5.47572912 1.9692684 4.0064603
[4,] -1.5588723 0.4075960 -0.73333754 6.3589944 5.0355051
[5,] 2.8095750 5.4264553 1.17820009 2.0665198 8.0491221
[6,] 4.3422219 2.1106691 1.08638206 5.0640175 6.8057674
[7,] -3.1072366 -1.1174633 6.28901706 5.0713964 1.8651354
[8,] -0.5628539 2.1868130 1.21288191 0.3114011 3.0452161
[9,] 0.1725606 3.4535112 -1.38043518 3.6439042 5.4005650
[10,] -2.3376856 4.8803363 -0.05927408 7.9275016 4.7013126
[11,] 2.3032655 2.4974161 4.63961513 1.4021305 10.2302589
[12,] 0.4470648 1.1660421 -0.70127807 6.3293479 6.6178080
[13,] 2.5835127 -0.8768809 2.87405383 6.1361518 3.4851934
[14,] -3.2769134 2.1721391 2.17317611 1.4170633 0.6446692
[15,] 1.0771079 -2.5369687 4.89710339 1.8667695 4.4847933
[16,] 7.2532218 3.0210221 0.56993065 2.4564492 6.9473683
[17,] 4.0682441 -0.8198112 4.85259334 7.3296033 8.9541915
[18,] 5.3991328 -0.9818425 1.73782230 2.9220433 4.9865858
[19,] 2.0556183 -0.7470914 5.44869675 1.6452235 4.5236089
[20,] -0.6277883 6.7255821 5.12606765 5.5721351 4.7081256
[21,] 9.0139352 3.1350767 6.59366754 2.0351358 5.1865195
[22,] 7.0598020 0.2869291 7.14368927 9.7213576 0.4251934
[23,] 1.6430309 6.3806803 5.95776881 7.5234383 4.8860264
[24,] 1.9473764 1.5386180 3.89690297 2.5333431 7.7217174
[25,] 0.7960661 -1.5137800 2.84861591 -5.9986647 2.9309536
Thanks in advance.
require(raster)
r <- raster(nrow=5, ncol=5)
set.seed(20) #exact reproducible example
s <- stack( sapply(1:5, function(i) setValues(r, rnorm(ncell(r), i, 3) )) )
s[is.na(s[])] <- 0 #NA values to be replaced (here it is being replaced with zero)
summary(s) # look for minimum and maximum pixel values
#some plot examples
plot(c(s[2]),ylim=c(-8,11)) #range -8 to 11 encompasses minimun and maximum s values
plot(c(s[25]),ylim=c(-8,11))
plot(c(s[600]),ylim=c(-8,11)) #creates an empty plot as there is no such row
plot(s) #plot raster s
If your RasterStack contains spatiotemporal data you could try the
setZ and getZ functions from raster in combination with the
zoo package.
library(raster)
library(zoo)
r <- raster(nrow=5, ncol=5)
## another way to create the RasterStack using init
s <- stack(lapply(1:5, function(i)init(r, fun=rnorm, mean=i, sd=3)))
## Set the time indez of the RasterStack
s <- setZ(s, 2001:2005)
s
> s
class : RasterStack
dimensions : 5, 5, 25, 5 (nrow, ncol, ncell, nlayers)
resolution : 72, 36 (x, y)
extent : -180, 180, -90, 90 (xmin, xmax, ymin, ymax)
coord. ref. : +proj=longlat +datum=WGS84
names : layer.1, layer.2, layer.3, layer.4, layer.5
min values : -2.0324027, -2.7135752, -2.0341025, -0.8495401, -1.6712431
max values : 1.3919942, 1.9809912, 2.8753805, 1.3746949, 0.6760691
time : 2001, 2002, 2003, 2004, 2005
Let's define a time series with zoo with the content of the cell 10
of s (row 10 of s[]):
z <- zoo(c(s[10]), getZ(s))
> z
2001 2002 2003 2004 2005
0.07586314 0.10235694 -1.28134027 -0.84954013 -1.11903690
There is a method to plot zoo objects:
plot(z)
If you have NA values there are several functions in zoo to manage them (na.approx, na.fill, etc.):
z[4] <- NA
plot(na.approx(z))
Related
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 writing a script that will take any three rasters, and crop them to the minimum possible extent. All three rasters will have the same resolution and projection. However, cropping to the minimum extent does not change the extents for the three rasters. I've tried setExtent and the same thing happens. If anyone can give suggestions I would really appreciate it. Here is sample code:
library(raster)
#Projection of all three rasters
newproj<- "+proj=utm +zone=4 +datum=WGS84 +units=m +no_defs +ellps=WGS84
+towgs84=0,0,0"
#Create three rasters with varying extents
raster1p<- raster(crs = newproj)
extent(raster1p)<- c(531247, 691847, 7856684, 7987884)
res(raster1p)<- c(100, 100)
values(raster1p)<- NA
raster2p<- raster(crs = newproj)
extent(raster2p)<- c(533550.8, 646550.8, 7881307, 7973807)
res(raster2p)<- c(100, 100)
values(raster2p)<- NA
raster3p<- raster(crs = newproj)
extent(raster3p)<- c(525739, 689839, 7857305, 7996505)
res(raster3p)<- c(100, 100)
values(raster3p)<- NA
#Find minimum extent
xmin1<- c(xmin(extent(raster1p)), xmin(extent(raster2p)), xmin(extent(raster3p)))
xmax1<- c(xmax(extent(raster1p)), xmax(extent(raster2p)), xmax(extent(raster3p)))
ymin1<- c(ymin(extent(raster1p)), ymin(extent(raster2p)), ymin(extent(raster3p)))
ymax1<- c(ymax(extent(raster1p)), ymax(extent(raster2p)), ymax(extent(raster3p)))
xmin_new<- min(xmin1)
xmax_new<- min(xmax1)
ymin_new<- min(ymin1)
ymax_new<- min(ymax1)
newextent=c(xmin_new, xmax_new, ymin_new, ymax_new)
#Crop rasters to minimum extent
crop(raster1p, newextent)
crop(raster2p, newextent)
crop(raster3p, newextent)
#Compare extents
extent_check<- c(extent(raster1p), extent(raster2p), extent(raster3p))
However, when I look at the extent_check to see if the extents now match, I see that the extents have not changed at all:
> extent_check
[[1]]
class : Extent
xmin : 531247
xmax : 691847
ymin : 7856684
ymax : 7987884
[[2]]
class : Extent
xmin : 533550.8
xmax : 646550.8
ymin : 7881307
ymax : 7973807
[[3]]
class : Extent
xmin : 525739
xmax : 689839
ymin : 7857305
ymax : 7996505
Any idea what I could be doing wrong? Thank you for your time
I think it is not so much about doing something wrong, but rater a misconception (although there is a mistake in your code).
Example data
library(raster)
prj <- "+proj=utm +zone=4 +datum=WGS84"
r1 <- raster(res=100, ext=extent(c(531247, 691847, 7856684, 7987884)), crs=prj, vals=NA)
r2 <- raster(res=100, ext=extent(c(533550.8, 646550.8, 7881307, 7973807)), crs=prj, vals=NA)
r3 <- raster(res=100, ext=extent(c(525739, 689839, 7857305, 7996505)), crs=prj, vals=NA)
Find the "minimum extent"
e <- intersect(intersect(extent(r1), extent(r2)), extent(r3))
Note that the result is different from yours because you use
xmin_new <- min(xmin1) and ymin_new <- min(ymin1)
Where it should be
xmin_new <- max(xmin1) and ymin_new <- max(ymin1)
Now crop
r1e <- crop(r1, e)
r2e <- crop(r2, e)
r3e <- crop(r3, e)
Inspect the resulting extents
t(sapply(c(r1e, r2e, r3e), function(i) as.vector(extent(i))))
# [,1] [,2] [,3] [,4]
#[1,] 533547.0 646547.0 7881284 7973784
#[2,] 533550.8 646550.8 7881307 7973807
#[3,] 533539.0 646539.0 7881305 7973805
They are not exactly the same, because that is not possible because the rasters do not align. Their "origins" are different
t(sapply(c(r1e, r2e, r3e), origin))
# [,1] [,2]
#[1,] 47.0 -16
#[2,] -49.2 7
#[3,] 39.0 5
To make them align, you would need to do something like this
r1e <- crop(r1, e)
r2e <- resample(r2, r1e)
r3e <- resample(r3, r1e)
t(sapply(c(r1e, r2e, r3e), function(i) as.vector(extent(i))))
# [,1] [,2] [,3] [,4]
#[1,] 533547 646547 7881284 7973784
#[2,] 533547 646547 7881284 7973784
#[3,] 533547 646547 7881284 7973784
I'm trying to follow the code to construct a residual autocovariate model described here: https://github.com/jejoenje/PubsRexamples/blob/master/Crase_etal.R#L16
After creating a large raster space I get an error when assigning values to the raster. I have 1000 random points to sign to the raster so there are many points without data (NA). Any ideas?
head(xy)
[,1] [,2]
[1,] 543510.0 6968620
[2,] 543570.0 6968620
[3,] 543570.0 6968560
[4,] 543599.9 6968560
[5,] 543510.0 6968530
[6,] 543389.9 6968470
head(xy_residuals)
[,1] [,2] [,3]
1 543510.0 6968620 -0.4257671
2 543570.0 6968620 -0.4541684
3 543570.0 6968560 -0.4310492
4 543599.9 6968560 -0.4649595
5 543510.0 6968530 -0.5506348
6 543389.9 6968470 -0.4928708
summary(xy)
X Y
Min. :538800 Min. :6931480
1st Qu.:540480 1st Qu.:6932860
Median :541350 Median :6935320
Mean :541529 Mean :6943218
3rd Qu.:542670 3rd Qu.:6954003
Max. :544290 Max. :6968620
# Define raster ymn, ymx, xmn and xmx from coordinates
# ncol=xmx-xmn nrow=ymx-ymn.
rast <- raster(ncol = 5490, nrow = 37140, ymn = 6931480, ymx = 6968620,
xmn = 538800, xmx = 544290)
rast
class : RasterLayer
dimensions : 37140, 5490, 203898600 (nrow, ncol, ncell)
resolution : 1, 1 (x, y)
extent : 538800, 544290, 6931480, 6968620 (xmin, xmax, ymin, ymax)
coord. ref. : NA
Problematic call:
rast[cellFromXY(rast, xy)] <- xy_residuals[, 3]
Error in .replace(x, i = i, value = value, recycle = 1) :
cannot replace values in large Raster objects if their length is not 1 or the number of cells to be replaced**
The error message says why this happens (But perhaps this "feature" needs some improvement.) The raster is very large and may not fit in memory (RAM). That may be too conservative an assessment . You can adjust that via rasterOptions or you can try:
library(raster)
r <- raster(ncol = 10, nrow = 10, ymn = 6931480, ymx = 6968620, xmn = 538800, xmx = 544290)
m <- matrix(c(539868,542002,542409,6945031,6940012,6935997, 1, 2, 3), 3, 3)
cells <- cellFromXY(r, m[,1:2])
# create a large vector with all cells
v <- rep(NA, ncell(r))
v[cells] <- m[,3]
v <- setValues(r, v)
If that does not work, you could look at update, but that is more risky as it overwrites data on file, but that should not be a concern in this case.
r <- setValues(r, NA)
# that probably creates a file on disk. If not do
# r <- writeRaster(r, filename='test.grd')
r <- update(r, cell=cells, v=m[,3])
I'm using the correlog function in the pgirmess package to get Moran's I over 20-30 distance classes, but am not sure what the unit of measurement is for the output distance classes. The input coordinates are in decimal degrees. The function documentation notes "Distances are euclidian and in the same unit as the spatial coordinates", but I'm still not exactly sure how to interpret the distance classes in the output - are the distance class bins in m, km, degrees, etc? Here's my code:
# longitude = mid.lon
# latitude = mid.lat
# variable of interest for spatial autocorrelation = std_cpue
library(pgirmess)
library(spdep)
df.xy = cbind(data$mid.lon, data$mid.lat)
pgi.cor = correlog(coords=df.xy, z=data$std_cpue, method="Moran", nbclass=30)
With 30 neighborhood classes, the result for the entire dataset looks like this. The distance class given is the midpoint for the bin:
print(pgi.cor)
# Moran I statistic
# dist.class coef p.value n
# [1,] 0.2519862 2.738572e-02 3.911359e-32 698490
# [2,] 0.7559590 -2.650938e-03 9.050678e-01 1084054
# [3,] 1.2599313 6.667723e-05 4.116504e-01 1063526
# [4,] 1.7639037 3.513692e-03 1.228453e-02 884720
# [5,] 2.2678760 2.719341e-03 4.536515e-02 729678
# [6,] 2.7718483 -5.959940e-03 9.988661e-01 690428
# [7,] 3.2758207 3.388526e-03 2.280808e-02 718940
# [8,] 3.7797930 1.443793e-03 1.830925e-01 633504
# [9,] 4.2837653 -4.573091e-04 5.278008e-01 519468
# [10,] 4.7877377 -8.749218e-03 9.999291e-01 397686
# [11,] 5.2917100 2.405016e-03 1.493334e-01 311976
# [12,] 5.7956823 2.089573e-03 2.258621e-01 256072
# [13,] 6.2996547 -1.182670e-03 5.998478e-01 202578
# [14,] 6.8036270 -2.270657e-03 7.158043e-01 166596
# [15,] 7.3075993 -4.629743e-03 9.011101e-01 156026
# [16,] 7.8115716 -3.213096e-03 8.094323e-01 160848
# [17,] 8.3155440 -4.373410e-03 8.707319e-01 163870
# [18,] 8.8195163 -3.356690e-04 5.015126e-01 169376
# [19,] 9.3234886 -4.467592e-03 8.685484e-01 169512
# [20,] 9.8274610 -2.546946e-03 7.127175e-01 150146
# [21,] 10.3314333 1.370106e-02 4.662235e-04 122808
# [22,] 10.8354056 -8.699153e-03 9.719764e-01 109024
# [23,] 11.3393780 -9.322568e-03 9.750500e-01 102748
# [24,] 11.8433503 -2.383252e-03 6.464213e-01 85680
# [25,] 12.3473226 -3.473310e-03 7.210551e-01 85942
# [26,] 12.8512950 2.053248e-03 3.396486e-01 66042
# [27,] 13.3552673 -1.037403e-02 8.547700e-01 32428
# [28,] 13.8592396 -1.033826e-02 6.762256e-01 11012
# [29,] 14.3632120 -3.007297e-02 7.217509e-01 1244
# [30,] 14.8671843 -6.886551e-02 6.864535e-01 154
Reproducible data (only the first 50 rows of the dataset):
> dput(data)
structure(list(mid.lat = c(28.7969496928494, 28.3930867867479,
29.994, 27.4784336939524, 29.422593551961, 28.5826238813314,
28.7477216329144, 29.3433487514478, 29.4226940782315, 29.3535708114362,
28.113333, 28.1130776659231, 28.2415339610655, 29.0009495727289,
29.7557386166675, 30.1020183777123, 28.0200002127096, 28.7864004408834,
30.1284937679637, 29.8328992823496, 28.9037836662043, 29.8021310079424,
28.0232807300034, 28.3553360292622, 29.0875191742967, 29.0220856353549,
27.9313060847168, 28.83, 29.5104509959267, 29.8466720353246,
28.8814346610816, 28.1373531188643, 29.3582385823534, 28.809044113648,
29.3867773013913, 29.4805574724306, 28.465504194069, 28.6696044277849,
29.5300092012194, 28.0430185205882, 28.2061620529272, 29.4275806851126,
26.5081134049796, 28.1275544648238, 29.8995981792495, 27.9848607011733,
26.709333, 28.0248252141179, 27.9728617106042, 28.9710761741436
), mid.lon = c(-84.5963462803782, -90.2686343226641, -87.374667,
-84.7457473224263, -87.9880238574933, -84.8349303764527, -84.6637647705975,
-87.8703015583197, -87.6622139897327, -88.5050810721282, -94.3925,
-90.346370340355, -92.8455008541893, -85.8699396759243, -86.9236199327813,
-86.9270244367842, -84.1683543397277, -89.2031178427517, -86.7908469980617,
-86.7643717886603, -85.819506226643, -86.7113004426214, -95.8135406472186,
-91.6316607122335, -85.2654292446955, -85.3228098920376, -93.9566215033579,
-89.526667, -87.6660902037082, -86.0710278956076, -89.5803704536036,
-90.8071728375477, -85.9890923714648, -84.7585523170688, -86.3493169018374,
-87.9960861956136, -84.266238497227, -84.5619763017653, -87.516209287989,
-91.3888746998191, -90.5451786588464, -87.3552938848394, -82.8477832707687,
-93.3828028011249, -86.2444455292202, -95.0747515699181, -82.891333,
-93.7656918819001, -92.8027598646245, -85.9850645824538), std_cpue = c(4.15234074914,
5.66057254934, 9.18436048054, 57.3175320669, 18.8400703246, 1843.47803667,
2.11506377428, 12.7170026758, 11.1626934066, 8.54011518736, 15.86758562,
13.8956556998, 4.38083061994, 67.7079534217, 5.76247720007, 25.4144340451,
9.46034915015, 14.8236026456, 22.8203364264, 5.79376884735, 89.6224743353,
8.45411201327, 23.9702041714, 13.1097292376, 75.4677852659, 1.56569331032,
44.990410447, 19.7090607295, 18.1197937416, 21.593493236, 46.9911787332,
19.2194902326, 55.782614307, 12.6585921867, 87.6939183102, 7.76649659183,
5.01359412606, 14.7829900356, 28.2493550901, 22.752832268, 7.43168604362,
75.9057643933, 1.18254364377, 5.98151873107, 23.1061861061, 41.3675267384,
11.4449526399, 45.7536886171, 10.6669337284, 66.5718319458)), .Names = c("mid.lat",
"mid.lon", "std_cpue"), row.names = c(1L, 67L, 69L, 536L, 842L,
2203L, 2586L, 2997L, 2998L, 3472L, 3474L, 3475L, 3855L, 4582L,
5084L, 5088L, 5987L, 6776L, 6778L, 7648L, 7651L, 8075L, 8079L,
8086L, 9069L, 9073L, 9080L, 9532L, 10526L, 11307L, 11308L, 11683L,
12082L, 12086L, 12087L, 12094L, 12500L, 12503L, 12505L, 12506L,
12507L, 12994L, 13016L, 13488L, 13497L, 13507L, 13520L, 14605L,
15487L, 15792L), class = "data.frame")
Thanks in advance!
After working with this data and the spdep package a bit more, I believe that the distance class variable here is in km. Other functions that take decimal degree coordinates as inputs also give outputs in km, or Great Circle distances (which are in km). Since the correlog documentation notes that "Distances are euclidian and in the same unit as the spatial coordinates", I'm interpreting this as km. An example in "Applied Spatial Data Analysis with R" by Bivand et al. also indicated that the bins used in coorelog are in km.
If you look inside the function correlog it simply calculates the Euclidean distance of the coordinates you provided the function and returns the average distance for each nbclass bin you generate. Meaning it returns the dist.class values in the same units as you provided it.
It makes no special conversion from whatever format you provide it, the code snip below, you can see it calculate simple distances for the bins with no unit transformation.
function (coords, z, method = "Moran", nbclass = NULL, ...)
{
coords <- as.matrix(coords)
matdist <- dist(coords)
...
etendue <- range(matdist)
breaks1 <- seq(etendue[1], etendue[2], l = nbclass + 1)
breaks2 <- breaks1 + 0.000001
breaks <- cbind(breaks1[1:length(breaks1) - 1], breaks2[2:length(breaks2)])
...
res <- cbind(dist.class = rowMeans(breaks), coef = mat[,
1], p.value = mat[, 2], n = mat[, 3])
}
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()