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.tzio...@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]] _______________________________________________ R-sig-Geo mailing list R-sig-Geo@r-project.org https://stat.ethz.ch/mailman/listinfo/r-sig-geo