带区域指令的加权平均计算

Question

I'd like to know for each category, the weighted mean of a variable (as each pixel has a weight). The code below doesn't allow me to do weighted averages. Any suggestions would be greatly appreciated!

#sample rasters
    r <- raster(ncols=10, nrows=10)
    category <-  raster(ncols=10, nrows=10)
    weight <-  raster(ncols=10, nrows=10)
    r[] <- runif(ncell(r)) * 1:ncell(r)
    category[] <- runif(ncell(category)) * 1:ncell(category)
    weight[] <- 1:ncell(weight)

#mean for each category
    zonalstats <- zonal(r, z=category, fun='mean', digits=0, na.rm=TRUE, count=T)

Answer 1

you can use this function. It applies zonal to both the weights and the raster values and calculates the weighted mean.

weightedZonalMean <- function(r, z, w, na.rm = TRUE, ...){
  zonalvalues <- zonal(r, z=z, fun=function(x, na.rm){x}, na.rm, ...)
  zonalweights <- zonal(w, z=z, function(x, na.rm){x},  na.rm, ...)
  weigtedValues <- cbind(zonalvalues[,1], 
                         sapply(1:nrow(zonalvalues), function(x){
    stats::weighted.mean(x = zonalvalues[x, 2:ncol(zonalvalues)], 
                         w = zonalweights[x, 2:ncol(zonalweights)])
  }))  
  return(weigtedValues)
}
weightedZonalMean(r, z, w, digits = 0)
#       [,1]      [,2]
#  [1,]    0 12.254438
#  [2,]    1  0.487548
#  [3,]    2  1.246249
#  [4,]    3 17.283858
#  [5,]    4 22.545906
#  [6,]    5 29.388179
#  [7,]    6 13.494853
#  [8,]    8  1.592464
#  [9,]    9 15.510155
# [10,]   10 10.091313
# ...

Answer 2

Unfortunately you can not do what you want with the zonal function, but you can build a similar function that calculates the weighted mean.

If you run findMethods(zonal)$'RasterLayer#RasterLayer' you can see how the zonal function works, and by adapting it you can do a function like the one that solves your problem.

zonalWMean <- function(x, w , z, digits = 0, na.rm = TRUE) {

  if(!compareRaster(c(x, w, z))) error("Raster not comparable!")

  df <- data.frame(x = getValues(x),
                   w = getValues(w))
  zones <- round(getValues(z), digits = digits)

  dfs <- split(df, zones)
  out <- lapply(dfs, function(l) weighted.mean(l$x, l$w, na.rm = na.rm))
  out <- cbind(as.numeric(names(out)), out)
  colnames(out)[1] <- "zone"
  colnames(out)[2] <- "weighted.mean"

  return(out)
}
zonalWMean(r, weight, category)
   zone weighted.mean
0  0    4.685347     
1  1    3.251086     
2  2    55.33882     
3  3    4.384738     
4  4    25.26902     
5  5    28.34853     
...