[R-sig-Geo] package spgwr: apply model parameters to a finer spatial scale
Nikolaos Tziokas
n|ko@@tz|ok@@ @end|ng |rom gm@||@com
Sat Dec 10 11:56:10 CET 2022
I using the *R* package *spgwr *to perform geographically weighted
regression (GWR). I want to apply the model parameters to a finer spatial
scale but I am receiving this error: *Error in validObject(.Object):
invalid class “SpatialPointsDataFrame” object: number of rows in data.frame
and SpatialPoints don't match*.
When I use another package for GWR, called *GWmodel*, I do not have this
issue. For example using the *GWmodel*, I do:
library(GWmodel)
library(sp)
library(raster)
ghs = raster("path/ghs.tif") # fine resolution raster
regpoints <- as(ghs, "SpatialPoints")
block.data = read.csv(file = "path/block.data.csv")
coordinates(block.data) <- c("x", "y")
proj4string(block.data) <- "EPSG:7767"
eq1 <- ntl ~ ghs
abw = bw.gwr(eq1,
data = block.data,
approach = "AIC",
kernel = "gaussian",
adaptive = TRUE,
p = 2,
parallel.method = "omp",
parallel.arg = "omp")
ab_gwr = gwr.basic(eq1,
data = block.data,
regression.points = regpoints,
bw = abw,
kernel = "gaussian",
adaptive = TRUE,
p = 2,
F123.test = FALSE,
cv = FALSE,
parallel.method = "omp",
parallel.arg = "omp")
ab_gwr
sp <- ab_gwr$SDF
sf <- st_as_sf(sp)
# intercept
intercept = as.data.frame(sf$Intercept)
intercept = SpatialPointsDataFrame(data = intercept, coords = regpoints)
gridded(intercept) <- TRUE
intercept <- raster(intercept)
raster::crs(intercept) <- "EPSG:7767"
intercept = resample(intercept, ghs, method = "bilinear")
# slope
slope = as.data.frame(sf$ghs)
slope = SpatialPointsDataFrame(data = slope, coords = regpoints)
gridded(slope) <- TRUE
slope <- raster(slope)
raster::crs(slope) <- "EPSG:7767"
slope = resample(slope, ghs, method = "bilinear")
gwr_pred = intercept + slope * ghs
writeRaster(gwr_pred,
"path/gwr_pred.tif",
overwrite = TRUE)
How can I apply the GWR model parameters to a finer spatial scale, using
the spgwr package?
Here is the code, using the *spgwr *package:
library(spgwr)
library(sf)
library(raster)
library(parallel)
ghs = raster("path/ghs.tif") # fine resolution raster
regpoints <- as(ghs, "SpatialPoints")
block.data = read.csv(file = "path/block.data.csv")
#create mararate df for the x & y coords
x = as.data.frame(block.data$x)
y = as.data.frame(block.data$y)
#convert the data to spatialPointsdf and then to spatialPixelsdf
coordinates(block.data) = c("x", "y")
# specify a model equation
eq1 <- ntl ~ ghs
# find optimal ADAPTIVE kernel bandwidth using cross validation
abw <- gwr.sel(eq1,
data = block.data,
adapt = TRUE,
gweight = gwr.Gauss)
# fit a gwr based on adaptive bandwidth
cl <- makeCluster(detectCores())
ab_gwr <- gwr(eq1,
data = block.data,
adapt = abw,
gweight = gwr.Gauss,
hatmatrix = TRUE,
regpoints,
predictions = TRUE,
se.fit = TRUE,
cl = cl)
stopCluster(cl)
#print the results of the model
ab_gwr
sp <- ab_gwr$SDF
sf <- st_as_sf(sp)
# intercept
intercept = as.data.frame(sf$Intercept)
intercept = SpatialPointsDataFrame(data = intercept, coords = regpoints)
gridded(intercept) <- TRUE
intercept <- raster(intercept)
raster::crs(intercept) <- "EPSG:7767"
intercept = resample(intercept, ghs, method = "bilinear")
# slope
slope = as.data.frame(sf$ghs)
slope = SpatialPointsDataFrame(data = slope, coords = regpoints)
gridded(slope) <- TRUE
slope <- raster(slope)
raster::crs(slope) <- "EPSG:7767"
slope = resample(slope, ghs, method = "bilinear")
gwr_pred = intercept + slope * ghs
writeRaster(gwr_pred,
"path/gwr_pred.tif",
overwrite = TRUE)
The fine resolution raster:
ghs = raster(ncols=47, nrows=92, xmn=582216.388, xmx=603366.388,
ymn=1005713.0202, ymx=1047113.0202, crs='+proj=lcc +lat_0=18.88015774
+lon_0=76.75 +lat_1=16.625 +lat_2=21.125 +x_0=1000000 +y_0=1000000
+datum=WGS84 +units=m +no_defs')
The csv can be downloaded from here
<https://drive.google.com/drive/folders/1V115zpdU2-5fXssI6iWv_F6aNu4E5qA7?usp=sharing>
.
--
Tziokas Nikolaos
Cartographer
Tel:(+44)07561120302
LinkedIn <http://linkedin.com/in/nikolaos-tziokas-896081130>
[[alternative HTML version deleted]]
More information about the R-sig-Geo
mailing list