[R-sig-Geo] package spgwr: apply model parameters to a finer spatial scale

[Nikolaos Tziokas]

In order to apply *GWR*'s model parameters to a finer spatial scale using
the *spgwr *package:


   1. calculate *GWR *at the coarse scale
   2. apply step 1 again using the parameters* fit.points*, *predictions *and
   *fittedGWRobject*.

The code:

library(spgwr)
library(sf)
library(raster)
library(parallel)

ghs = raster("path/ghs.tif") # fine res raster
regpoints <- as.data.frame(ghs[[1]], xy = TRUE)
regpoints = na.omit(regpoints)
coordinates(regpoints) <- c("x", "y")
gridded(regpoints) <- TRUE

block.data = read.csv(file = "path/block.data.csv") # df containing the
dependent and independent coarse variables

#convert the data to spatialPointsdf
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())
xx <- gwr(eq1,
              data = block.data,
              adapt = abw,
              gweight = gwr.Gauss,
              hatmatrix = TRUE,
              se.fit = TRUE,
              cl = cl)
stopCluster(cl)

# predict to a fine spatial scale
cl <- makeCluster(detectCores())
ab_gwr <- gwr(eq1,
              data = block.data,
              adapt = abw,
              gweight = gwr.Gauss,
              fit.points = regpoints,
              predictions = TRUE,
              se.fit = TRUE,
              fittedGWRobject = xx,
              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"

# slope
slope = as.data.frame(sf$ghs)
slope = SpatialPointsDataFrame(data = slope, coords = regpoints)
gridded(slope) <- TRUE
slope <- raster(slope)
raster::crs(slope) <- "EPSG:7767"


gwr_pred = intercept + slope * ghs

writeRaster(gwr_pred,
            "path/gwr_pred.tif",
            overwrite = TRUE)

Στις Σάβ 10 Δεκ 2022 στις 10:56 π.μ., ο/η Nikolaos Tziokas <
nikos.tziokas using gmail.com> έγραψε:

> 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>
>


-- 
Tziokas Nikolaos
Cartographer

Tel:(+44)07561120302
LinkedIn <http://linkedin.com/in/nikolaos-tziokas-896081130>

	[[alternative HTML version deleted]]