From 66b6405234b9db4679187b08da553f16a333cff6 Mon Sep 17 00:00:00 2001 From: zyy <2711245442@qq.com> Date: Sun, 1 Jun 2025 17:19:00 +0800 Subject: [PATCH 1/3] feature: gwr localcollinearity basic flow --- NAMESPACE | 6 + R/RcppExports.R | 4 + R/gwr_localcollinearity.R | 309 ++++++++++++++++++++ man/gwr_lcr.Rd | 136 +++++++++ man/print.Rd | 10 +- src/Makevars.in | 2 + src/Makevars.win | 2 + src/RcppExports.cpp | 25 ++ src/gwr_localcollinearity.cpp | 83 ++++++ tests/testthat/test-gwr_localcollinearity.R | 14 + 10 files changed, 589 insertions(+), 2 deletions(-) create mode 100644 R/gwr_localcollinearity.R create mode 100644 man/gwr_lcr.Rd create mode 100644 src/gwr_localcollinearity.cpp create mode 100644 tests/testthat/test-gwr_localcollinearity.R diff --git a/NAMESPACE b/NAMESPACE index 7e0b4f6..ef518d8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,20 +1,25 @@ # Generated by roxygen2: do not edit by hand S3method(coef,gtdrm) +S3method(coef,gwlcrm) S3method(coef,gwrm) S3method(coef,gwrmultiscalem) S3method(fitted,gtdrm) +S3method(fitted,gwlcrm) S3method(fitted,gwrm) S3method(fitted,gwrmultiscalem) S3method(plot,gtdrm) +S3method(plot,gwlcrm) S3method(plot,gwrm) S3method(plot,gwrmultiscalem) S3method(plot,modelselcritl) S3method(predict,gwrm) S3method(print,gtdrm) +S3method(print,gwlcrm) S3method(print,gwrm) S3method(print,gwrmultiscalem) S3method(residuals,gtdrm) +S3method(residuals,gwlcrm) S3method(residuals,gwrm) S3method(residuals,gwrmultiscalem) S3method(step,default) @@ -23,6 +28,7 @@ S3method(step,gwrm) export(gtdr) export(gtdr_config) export(gwr_basic) +export(gwr_lcr) export(gwr_multiscale) export(mgwr_config) export(print_table_md) diff --git a/R/RcppExports.R b/R/RcppExports.R index 6c1c586..37b0058 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -13,6 +13,10 @@ gwr_basic_predict <- function(pcoords, x, y, coords, bw, adaptive, kernel, longl .Call(`_GWmodel3_gwr_basic_predict`, pcoords, x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, parallel_type, parallel_arg, verbose) } +gwr_lcr_fit <- function(x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw) { + .Call(`_GWmodel3_gwr_lcr_fit`, x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw) +} + gwr_multiscale_fit <- function(x, y, coords, bw, adaptive, kernel, longlat, p, theta, optim_bw, optim_bw_criterion, threashold, initial_type, centered, optim_bw_lower, optim_bw_upper, criterion, hatmatrix, intercept, retry_times, max_iterations, parallel_type, parallel_arg, variable_names, verbose) { .Call(`_GWmodel3_gwr_multiscale_fit`, x, y, coords, bw, adaptive, kernel, longlat, p, theta, optim_bw, optim_bw_criterion, threashold, initial_type, centered, optim_bw_lower, optim_bw_upper, criterion, hatmatrix, intercept, retry_times, max_iterations, parallel_type, parallel_arg, variable_names, verbose) } diff --git a/R/gwr_localcollinearity.R b/R/gwr_localcollinearity.R new file mode 100644 index 0000000..544cc73 --- /dev/null +++ b/R/gwr_localcollinearity.R @@ -0,0 +1,309 @@ +#' Calibrate a basic GWR model +#' +#' @param formula Regresison model. +#' @param data A `sf` objects. +#' @param bw Either a value to set the size of bandwidth, +#' or one of the following characters to set the criterion for +#' bandwidth auto-optimization process. +#' - `AIC` +#' - `CV` +#' Note that if `NA` or other non-numeric value is setted, +#' this parameter will be reset to `Inf`. +#' @param adaptive Whether the bandwidth value is adaptive or not. +#' @param kernel Kernel function used. +#' @param longlat Whether the coordinates +#' @param p Power of the Minkowski distance, +#' default to 2, i.e., Euclidean distance. +#' @param theta Angle in radian to roate the coordinate system, default to 0. +#' @param optim_bw_range Bounds on bandwidth optimization, a vector of two numeric elements. +#' Set to `NA_real_` to enable default values selected by the algorithm. +#' @param hatmatrix If TRUE, great circle will be caculated. +#' @param parallel_method Parallel method. +#' @param parallel_arg Parallel method argument. +#' @param verbose Whether to print additional information. +#' +#' @return A `gwlcrm` object. +#' +#' @details +#' ## Parallelization +#' +#' Two parallel methods are provided to speed up basic GWR algorithm: +#' +#' - Multithreading (`omp`) +#' - NVIDIA GPU Computing (`cuda`) +#' +#' See the vignettes about parallelization to learn more about this topic. +#' +#' @examples +#' data(LondonHP) +#' +#' # Basic usage +#' gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY, LondonHP, 64, TRUE) +#' +#' # Bandwidth Optimization +#' m <- gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'AIC', TRUE) +#' m +#' +#' @seealso `browseVignettes("")` +#' +#' @importFrom stats na.action model.frame model.extract model.matrix terms +#' @export +gwr_lcr <- function( + formula, + data, + bw = NA, + adaptive = FALSE, + kernel = c("gaussian", "exp", "bisquare", "tricube", "boxcar"), + longlat = FALSE, + p = 2.0, + theta = 0.0, + lambda = 0, + lambda_adjust = FALSE, + cn_thresh = 30, + cv = TRUE, + hatmatrix = TRUE, + parallel_method = c("no", "omp"), + parallel_arg = c(0), + verbose = FALSE +) { + ### Check args + kernel = match.arg(kernel) + parallel_method = match.arg(parallel_method) + attr(data, "na.action") <- getOption("na.action") + + ### Extract coords + data <- do.call(na.action(data), args = list(data)) + coords <- as.matrix(sf::st_coordinates(sf::st_centroid(data))) + if (is.null(coords) || nrow(coords) != nrow(data)) + stop("Missing coordinates.") + + ### Extract variables + mc <- match.call(expand.dots = FALSE) + mf <- model.frame(formula = formula(formula), data = sf::st_drop_geometry(data)) + mt <- attr(mf, "terms") + y <- model.extract(mf, "response") + x <- model.matrix(mt, mf) + dep_var <- as.character(attr(terms(mf), "variables")[[2]]) + has_intercept <- attr(terms(mf), "intercept") == 1 + indep_vars <- colnames(x) + indep_vars[which(indep_vars == "(Intercept)")] <- "Intercept" + colnames(x) <- indep_vars + if (has_intercept && indep_vars[1] != "Intercept") { + stop("Please put Intercept to the first column.") + } + + ### Check whether bandwidth is valid. + if (missing(bw)) { + optim_bw <- TRUE + bw <- Inf + } else if (is.numeric(bw) || is.integer(bw)) { + optim_bw <- FALSE + } else { + optim_bw <- TRUE + if(is.character(bw)) + if(!match.arg(bw, c("CV"))){ + stop("Parameter bw must be 'CV' or a number") + } + bw <- Inf + } + + ### Call solver + c_result <- tryCatch(gwr_lcr_fit( + x, y, coords, + bw, adaptive, enum(kernel), longlat, p, theta, + has_intercept, hatmatrix, + enum_list(parallel_method, parallel_types), parallel_arg, + optim_bw + ), error = function (e) { + stop("Error:", conditionMessage(e)) + }) + if (optim_bw) + bw <- c_result$bandwidth + betas <- c_result$betas + yhat <- c_result$yhat + diagnostic <- c_result$diagnostic + resi <- y - yhat + # n_dp <- nrow(coords) + # rss_gw <- sum(resi * resi) + # sigma <- rss_gw / (n_dp - 2 * shat_trace[1] + shat_trace[2]) + # betas_se <- sqrt(sigma * betas_se) + # betas_tv <- betas / betas_se + + ### Create result Layer + colnames(betas) <- indep_vars + # colnames(betas_se) <- paste(indep_vars, "SE", sep = ".") + # colnames(betas_tv) <- paste(indep_vars, "TV", sep = ".") + sdf_data <- as.data.frame(cbind( + betas, + "yhat" = yhat, + "residual" = resi + # betas_se, + # betas_tv + )) + sdf_data$geometry <- sf::st_geometry(data) + sdf <- sf::st_sf(sdf_data) + + ### Return result + gwlcrm <- list( + SDF = sdf, + diagnostic = diagnostic, + args = list( + # x = x, + # y = y, + # coords = coords, + bw = bw, + adaptive = adaptive, + kernel = kernel, + longlat = longlat, + p = p, + theta = theta, + hatmatrix = hatmatrix, + has_intercept = has_intercept, + parallel_method = parallel_method, + parallel_arg = parallel_arg, + optim_bw = optim_bw + ), + call = mc, + indep_vars = indep_vars, + dep_var = dep_var + ) + class(gwlcrm) <- "gwlcrm" + gwlcrm +} + + + +#' Print description of a `gwlcrm` object +#' +#' @param x An `hgwlcrm` object returned by [gwr_lcr()]. +#' @param decimal_fmt The format string passing to [base::sprintf()]. +#' @inheritDotParams print_table_md +#' +#' @method print gwlcrm +#' @importFrom stats coef fivenum +#' @rdname print +#' @export +print.gwlcrm <- function(x, decimal_fmt = "%.3f", ...) { + if (!inherits(x, "gwlcrm")) { + stop("It's not a gwlcrm object.") + } + + ### Basic Information + cat("Results of Ridge Geographically Weighted Regression", fill = T) + cat("===================================================", fill = T) + cat(" Formula:", deparse(x$call$formula), fill = T) + cat(" Data:", deparse(x$call$data), fill = T) + cat(" Kernel:", x$args$kernel, fill = T) + cat("Bandwidth:", x$args$bw, + ifelse(x$args$adaptive, "(Nearest Neighbours)", "(Meters)"), + ifelse(x$args$optim_bw, paste0( + "(Optimized accroding to CV)" + ), ""), fill = T) + cat("\n", fill = T) + + cat("Summary of Coefficient Estimates", fill = T) + cat("--------------------------------", fill = T) + betas <- coef(x) + beta_fivenum <- t(apply(betas, 2, fivenum)) + colnames(beta_fivenum) <- c("Min.", "1st Qu.", "Median", "3rd Qu.", "Max.") + rownames(beta_fivenum) <- colnames(betas) + beta_str <- rbind( + c("Coefficient", colnames(beta_fivenum)), + cbind(rownames(beta_fivenum), matrix2char(beta_fivenum, decimal_fmt)) + ) + print_table_md(beta_str, ...) + cat("\n", fill = T) + + cat("Diagnostic Information", fill = T) + cat("----------------------", fill = T) + cat(" RSS:", x$diagnostic$RSS, fill = T) + cat(" ENP:", x$diagnostic$ENP, fill = T) + cat(" EDF:", x$diagnostic$EDF, fill = T) + cat(" R2:", x$diagnostic$RSquare, fill = T) + cat("R2adj:", x$diagnostic$RSquareAdjust, fill = T) + cat(" AIC:", x$diagnostic$AIC, fill = T) + cat(" AICc:", x$diagnostic$AICc, fill = T) + cat("\n", fill = T) +} + +#' @describeIn gwr_lcr Plot the result of basic GWR model. +#' +#' @param x A "gwlcrm" object. +#' @param y Ignored. +#' @param columns Column names to plot. +#' If it is missing or non-character value, all coefficient columns are plottd. +#' @param \dots Additional arguments passing to [sf::plot()]. +#' @method plot gwlcrm +#' +#' @examples +#' plot(m) +#' +#' @export +plot.gwlcrm <- function(x, y, ..., columns) { + if (!inherits(x, "gwlcrm")) { + stop("It's not a gwlcrm object.") + } + + sdf <- sf::st_as_sf(x$SDF) + sdf_colnames <- names(sf::st_drop_geometry(x$SDF)) + if (!missing(columns) && is.character(columns)) { + valid_columns <- intersect(columns, sdf_colnames) + if (length(valid_columns) > 0) { + sdf <- sdf[valid_columns] + } + } else { ### Select coefficient columns. + sdf <- sdf[x$indep_vars] + } + plot(sdf, ...) +} + +#' @describeIn gwr_lcr Get coefficients of a basic GWR model. +#' +#' @param object A "gwlcrm" object. +#' @param \dots Additional arguments passing to [coef()]. +#' +#' @examples +#' coef(m) +#' +#' @method coef gwlcrm +#' @export +coef.gwlcrm <- function(object, ...) { + if (!inherits(object, "gwlcrm")) { + stop("It's not a gwlcrm object.") + } + sf::st_drop_geometry(object$SDF[object$indep_vars]) +} + +#' @describeIn gwr_lcr Get fitted values of a basic GWR model. +#' +#' @param object A "gwlcrm" object. +#' @param \dots Additional arguments passing to [fitted()]. +#' +#' @examples +#' fitted(m) +#' +#' @method fitted gwlcrm +#' @export +fitted.gwlcrm <- function(object, ...) { + if (!inherits(object, "gwlcrm")) { + stop("It's not a gwlcrm object.") + } + object$SDF[["yhat"]] +} + +#' @describeIn gwr_lcr Get residuals of a basic GWR model. +#' +#' @param object A "gwlcrm" object. +#' @param \dots Additional arguments passing to [residuals()]. +#' +#' @examples +#' residuals(m) +#' +#' @method residuals gwlcrm +#' @export +residuals.gwlcrm <- function(object, ...) { + if (!inherits(object, "gwlcrm")) { + stop("It's not a gwlcrm object.") + } + object$SDF[["residual"]] +} diff --git a/man/gwr_lcr.Rd b/man/gwr_lcr.Rd new file mode 100644 index 0000000..df711b3 --- /dev/null +++ b/man/gwr_lcr.Rd @@ -0,0 +1,136 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gwr_localcollinearity.R +\name{gwr_lcr} +\alias{gwr_lcr} +\alias{plot.gwlcrm} +\alias{coef.gwlcrm} +\alias{fitted.gwlcrm} +\alias{residuals.gwlcrm} +\title{Calibrate a basic GWR model} +\usage{ +gwr_lcr( + formula, + data, + bw = NA, + adaptive = FALSE, + kernel = c("gaussian", "exp", "bisquare", "tricube", "boxcar"), + longlat = FALSE, + p = 2, + theta = 0, + lambda = 0, + lambda_adjust = FALSE, + cn_thresh = 30, + cv = TRUE, + hatmatrix = TRUE, + parallel_method = c("no", "omp"), + parallel_arg = c(0), + verbose = FALSE +) + +\method{plot}{gwlcrm}(x, y, ..., columns) + +\method{coef}{gwlcrm}(object, ...) + +\method{fitted}{gwlcrm}(object, ...) + +\method{residuals}{gwlcrm}(object, ...) +} +\arguments{ +\item{formula}{Regresison model.} + +\item{data}{A \code{sf} objects.} + +\item{bw}{Either a value to set the size of bandwidth, +or one of the following characters to set the criterion for +bandwidth auto-optimization process. +\itemize{ +\item \code{AIC} +\item \code{CV} +Note that if \code{NA} or other non-numeric value is setted, +this parameter will be reset to \code{Inf}. +}} + +\item{adaptive}{Whether the bandwidth value is adaptive or not.} + +\item{kernel}{Kernel function used.} + +\item{longlat}{Whether the coordinates} + +\item{p}{Power of the Minkowski distance, +default to 2, i.e., Euclidean distance.} + +\item{theta}{Angle in radian to roate the coordinate system, default to 0.} + +\item{hatmatrix}{If TRUE, great circle will be caculated.} + +\item{parallel_method}{Parallel method.} + +\item{parallel_arg}{Parallel method argument.} + +\item{verbose}{Whether to print additional information.} + +\item{x}{A "gwlcrm" object.} + +\item{y}{Ignored.} + +\item{\dots}{Additional arguments passing to \code{\link[=residuals]{residuals()}}.} + +\item{columns}{Column names to plot. +If it is missing or non-character value, all coefficient columns are plottd.} + +\item{object}{A "gwlcrm" object.} + +\item{optim_bw_range}{Bounds on bandwidth optimization, a vector of two numeric elements. +Set to \code{NA_real_} to enable default values selected by the algorithm.} +} +\value{ +A \code{gwlcrm} object. +} +\description{ +Calibrate a basic GWR model +} +\details{ +\subsection{Parallelization}{ + +Two parallel methods are provided to speed up basic GWR algorithm: +\itemize{ +\item Multithreading (\code{omp}) +\item NVIDIA GPU Computing (\code{cuda}) +} + +See the vignettes about parallelization to learn more about this topic. +} +} +\section{Functions}{ +\itemize{ +\item \code{plot(gwlcrm)}: Plot the result of basic GWR model. + +\item \code{coef(gwlcrm)}: Get coefficients of a basic GWR model. + +\item \code{fitted(gwlcrm)}: Get fitted values of a basic GWR model. + +\item \code{residuals(gwlcrm)}: Get residuals of a basic GWR model. + +}} +\examples{ +data(LondonHP) + +# Basic usage +gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY, LondonHP, 64, TRUE) + +# Bandwidth Optimization +m <- gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'AIC', TRUE) +m + +plot(m) + +coef(m) + +fitted(m) + +residuals(m) + +} +\seealso{ +\code{browseVignettes("")} +} diff --git a/man/print.Rd b/man/print.Rd index e7e67ee..bb0db71 100644 --- a/man/print.Rd +++ b/man/print.Rd @@ -1,8 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/gtdr.R, R/gwr_basic.R, R/gwr_multiscale.R +% Please edit documentation in R/gtdr.R, R/gwr_basic.R, +% R/gwr_localcollinearity.R, R/gwr_multiscale.R \name{print.gtdrm} \alias{print.gtdrm} \alias{print.gwrm} +\alias{print.gwlcrm} \alias{print.gwrmultiscalem} \title{Print description of a \code{gtdrm} object} \usage{ @@ -10,6 +12,8 @@ \method{print}{gwrm}(x, decimal_fmt = "\%.3f", ...) +\method{print}{gwlcrm}(x, decimal_fmt = "\%.3f", ...) + \method{print}{gwrmultiscalem}(x, decimal_fmt = "\%.3f", ...) } \arguments{ @@ -18,7 +22,7 @@ \item{decimal_fmt}{The format string passing to \code{\link[base:sprintf]{base::sprintf()}}.} \item{...}{ - Arguments passed on to \code{\link[=print_table_md]{print_table_md}}, \code{\link[=print_table_md]{print_table_md}}, \code{\link[=print_table_md]{print_table_md}} + Arguments passed on to \code{\link[=print_table_md]{print_table_md}}, \code{\link[=print_table_md]{print_table_md}}, \code{\link[=print_table_md]{print_table_md}}, \code{\link[=print_table_md]{print_table_md}} \describe{ \item{\code{col.sep}}{Column seperator. Default to \code{""}.} \item{\code{header.sep}}{Header seperator. Default to \code{"-"}.} @@ -35,5 +39,7 @@ Print description of a \code{gtdrm} object Print description of a \code{gwrm} object +Print description of a \code{gwlcrm} object + Print description of a \code{gwrmultiscalem} object } diff --git a/src/Makevars.in b/src/Makevars.in index f5897d0..0a7917b 100644 --- a/src/Makevars.in +++ b/src/Makevars.in @@ -45,6 +45,7 @@ OBJECTS_LIBGWMODEL = \ libgwmodel/src/gwmodelpp/GWRBase.o \ libgwmodel/src/gwmodelpp/GWRBasic.o \ libgwmodel/src/gwmodelpp/GWRMultiscale.o \ + libgwmodel/src/gwmodelpp/GWRLocalCollinearity.o \ libgwmodel/src/gwmodelpp/SpatialAlgorithm.o \ libgwmodel/src/gwmodelpp/SpatialMonoscaleAlgorithm.o \ libgwmodel/src/gwmodelpp/SpatialMultiscaleAlgorithm.o \ @@ -60,6 +61,7 @@ OBJECTS_GWMODEL = \ utils.o \ gwr_basic.o \ gwr_multiscale.o \ + gwr_localcollinearity.o \ gtdr.o \ RcppExports.o diff --git a/src/Makevars.win b/src/Makevars.win index 8ac438f..2d108c9 100644 --- a/src/Makevars.win +++ b/src/Makevars.win @@ -47,6 +47,7 @@ OBJECTS_LIBGWMODEL = \ libgwmodel/src/gwmodelpp/GWRBase.o \ libgwmodel/src/gwmodelpp/GWRBasic.o \ libgwmodel/src/gwmodelpp/GWRMultiscale.o \ + libgwmodel/src/gwmodelpp/GWRLocalCollinearity.o \ libgwmodel/src/gwmodelpp/SpatialAlgorithm.o \ libgwmodel/src/gwmodelpp/SpatialMonoscaleAlgorithm.o \ libgwmodel/src/gwmodelpp/SpatialMultiscaleAlgorithm.o \ @@ -62,6 +63,7 @@ OBJECTS_GWMODEL = \ utils.o \ gwr_basic.o \ gwr_multiscale.o \ + gwr_localcollinearity.o \ gtdr.o \ RcppExports.o diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index d0cedbc..93569a5 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -96,6 +96,30 @@ BEGIN_RCPP return rcpp_result_gen; END_RCPP } +// gwr_lcr_fit +List gwr_lcr_fit(const arma::mat& x, const arma::vec& y, const arma::mat& coords, double bw, bool adaptive, size_t kernel, bool longlat, double p, double theta, bool intercept, bool hatmatrix, size_t parallel_type, const IntegerVector& parallel_arg, bool optim_bw); +RcppExport SEXP _GWmodel3_gwr_lcr_fit(SEXP xSEXP, SEXP ySEXP, SEXP coordsSEXP, SEXP bwSEXP, SEXP adaptiveSEXP, SEXP kernelSEXP, SEXP longlatSEXP, SEXP pSEXP, SEXP thetaSEXP, SEXP interceptSEXP, SEXP hatmatrixSEXP, SEXP parallel_typeSEXP, SEXP parallel_argSEXP, SEXP optim_bwSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const arma::mat& >::type x(xSEXP); + Rcpp::traits::input_parameter< const arma::vec& >::type y(ySEXP); + Rcpp::traits::input_parameter< const arma::mat& >::type coords(coordsSEXP); + Rcpp::traits::input_parameter< double >::type bw(bwSEXP); + Rcpp::traits::input_parameter< bool >::type adaptive(adaptiveSEXP); + Rcpp::traits::input_parameter< size_t >::type kernel(kernelSEXP); + Rcpp::traits::input_parameter< bool >::type longlat(longlatSEXP); + Rcpp::traits::input_parameter< double >::type p(pSEXP); + Rcpp::traits::input_parameter< double >::type theta(thetaSEXP); + Rcpp::traits::input_parameter< bool >::type intercept(interceptSEXP); + Rcpp::traits::input_parameter< bool >::type hatmatrix(hatmatrixSEXP); + Rcpp::traits::input_parameter< size_t >::type parallel_type(parallel_typeSEXP); + Rcpp::traits::input_parameter< const IntegerVector& >::type parallel_arg(parallel_argSEXP); + Rcpp::traits::input_parameter< bool >::type optim_bw(optim_bwSEXP); + rcpp_result_gen = Rcpp::wrap(gwr_lcr_fit(x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw)); + return rcpp_result_gen; +END_RCPP +} // gwr_multiscale_fit List gwr_multiscale_fit(const arma::mat& x, const arma::vec& y, const arma::mat& coords, const NumericVector& bw, const LogicalVector& adaptive, const IntegerVector& kernel, const LogicalVector& longlat, const NumericVector& p, const NumericVector& theta, const LogicalVector& optim_bw, const IntegerVector& optim_bw_criterion, const NumericVector& threashold, const IntegerVector& initial_type, const LogicalVector& centered, double optim_bw_lower, double optim_bw_upper, size_t criterion, bool hatmatrix, bool intercept, size_t retry_times, size_t max_iterations, size_t parallel_type, const IntegerVector& parallel_arg, const CharacterVector& variable_names, int verbose); RcppExport SEXP _GWmodel3_gwr_multiscale_fit(SEXP xSEXP, SEXP ySEXP, SEXP coordsSEXP, SEXP bwSEXP, SEXP adaptiveSEXP, SEXP kernelSEXP, SEXP longlatSEXP, SEXP pSEXP, SEXP thetaSEXP, SEXP optim_bwSEXP, SEXP optim_bw_criterionSEXP, SEXP threasholdSEXP, SEXP initial_typeSEXP, SEXP centeredSEXP, SEXP optim_bw_lowerSEXP, SEXP optim_bw_upperSEXP, SEXP criterionSEXP, SEXP hatmatrixSEXP, SEXP interceptSEXP, SEXP retry_timesSEXP, SEXP max_iterationsSEXP, SEXP parallel_typeSEXP, SEXP parallel_argSEXP, SEXP variable_namesSEXP, SEXP verboseSEXP) { @@ -136,6 +160,7 @@ static const R_CallMethodDef CallEntries[] = { {"_GWmodel3_gtdr_fit", (DL_FUNC) &_GWmodel3_gtdr_fit, 19}, {"_GWmodel3_gwr_basic_fit", (DL_FUNC) &_GWmodel3_gwr_basic_fit, 22}, {"_GWmodel3_gwr_basic_predict", (DL_FUNC) &_GWmodel3_gwr_basic_predict, 14}, + {"_GWmodel3_gwr_lcr_fit", (DL_FUNC) &_GWmodel3_gwr_lcr_fit, 14}, {"_GWmodel3_gwr_multiscale_fit", (DL_FUNC) &_GWmodel3_gwr_multiscale_fit, 25}, {NULL, NULL, 0} }; diff --git a/src/gwr_localcollinearity.cpp b/src/gwr_localcollinearity.cpp new file mode 100644 index 0000000..b3345eb --- /dev/null +++ b/src/gwr_localcollinearity.cpp @@ -0,0 +1,83 @@ +// [[Rcpp::depends(RcppArmadillo)]] +#include +#include "utils.h" +#include "gwmodel.h" + + +using namespace std; +using namespace Rcpp; +using namespace arma; +using namespace gwm; + +// [[Rcpp::export]] +List gwr_lcr_fit( + const arma::mat& x, + const arma::vec& y, + const arma::mat& coords, + double bw, + bool adaptive, + size_t kernel, + bool longlat, + double p, + double theta, + bool intercept, + bool hatmatrix, + size_t parallel_type, + const IntegerVector& parallel_arg, + bool optim_bw +) { + vector vpar_args = as< vector >(IntegerVector(parallel_arg)); + + // Make Spatial Weight + BandwidthWeight bandwidth(bw, adaptive, BandwidthWeight::KernelFunctionType((size_t)kernel)); + Distance* distance = nullptr; + if (longlat) + { + distance = new CRSDistance(true); + } + else + { + if (p == 2.0 && theta == 0.0) + { + distance = new CRSDistance(false); + } + else + { + distance = new MinkwoskiDistance(p, theta); + } + } + SpatialWeight spatial(&bandwidth, distance); + + GWRLocalCollinearity algorithm; + algorithm.setCoords(coords); + algorithm.setDependentVariable(y); + algorithm.setIndependentVariables(x); + algorithm.setSpatialWeight(spatial); + algorithm.setHasIntercept(intercept); + algorithm.setHasHatMatrix(hatmatrix); + + + if (optim_bw) + { + algorithm.setIsAutoselectBandwidth(true); + algorithm.setBandwidthSelectionCriterion(GWRLocalCollinearity::BandwidthSelectionCriterionType::CV); + } + + algorithm.fit(); + + // Return Results + mat betas = algorithm.betas(); + vec yhat = sum(betas % x, 1); + List result_list = List::create( + Named("betas") = betas, + Named("diagnostic") = mywrap(algorithm.diagnostic()), + Named("yhat") = yhat + ); + + if (optim_bw){ + double bw_value = algorithm.spatialWeight().weight()->bandwidth(); + result_list["bandwidth"] = wrap(bw_value); + } + + return result_list; +} diff --git a/tests/testthat/test-gwr_localcollinearity.R b/tests/testthat/test-gwr_localcollinearity.R new file mode 100644 index 0000000..3ced0c6 --- /dev/null +++ b/tests/testthat/test-gwr_localcollinearity.R @@ -0,0 +1,14 @@ +data(LondonHP) +m <- NULL + +test_that("Basic GWR LocalCollinearity: works", { + m <<- expect_no_error( + gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, 64, TRUE) + ) +}) + +test_that("Basic GWR LocalCollinearity: bw selection", { + m <<- expect_no_error( + gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP) + ) +}) \ No newline at end of file From 24294fc905a39b631d4fb0abba0df0f21abbf948 Mon Sep 17 00:00:00 2001 From: zyy <2711245442@qq.com> Date: Sun, 1 Jun 2025 22:22:40 +0800 Subject: [PATCH 2/3] add: lambda selection in gwr_lcr --- R/RcppExports.R | 4 +-- R/gwr_localcollinearity.R | 22 ++++++++++++- src/RcppExports.cpp | 11 ++++--- src/gwr_localcollinearity.cpp | 28 ++++++++++++++++- tests/testthat/test-gwr_localcollinearity.R | 34 ++++++++++++++++++--- 5 files changed, 86 insertions(+), 13 deletions(-) diff --git a/R/RcppExports.R b/R/RcppExports.R index 37b0058..ad31d94 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -13,8 +13,8 @@ gwr_basic_predict <- function(pcoords, x, y, coords, bw, adaptive, kernel, longl .Call(`_GWmodel3_gwr_basic_predict`, pcoords, x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, parallel_type, parallel_arg, verbose) } -gwr_lcr_fit <- function(x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw) { - .Call(`_GWmodel3_gwr_lcr_fit`, x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw) +gwr_lcr_fit <- function(x, y, coords, bw, adaptive, kernel, longlat, p, theta, lambda, lambda_adjust, cn_thresh, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw) { + .Call(`_GWmodel3_gwr_lcr_fit`, x, y, coords, bw, adaptive, kernel, longlat, p, theta, lambda, lambda_adjust, cn_thresh, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw) } gwr_multiscale_fit <- function(x, y, coords, bw, adaptive, kernel, longlat, p, theta, optim_bw, optim_bw_criterion, threashold, initial_type, centered, optim_bw_lower, optim_bw_upper, criterion, hatmatrix, intercept, retry_times, max_iterations, parallel_type, parallel_arg, variable_names, verbose) { diff --git a/R/gwr_localcollinearity.R b/R/gwr_localcollinearity.R index 544cc73..671b519 100644 --- a/R/gwr_localcollinearity.R +++ b/R/gwr_localcollinearity.R @@ -107,10 +107,19 @@ gwr_lcr <- function( bw <- Inf } + ### Check lambda and cnthresh + if (lambda<0 || lambda>1){ + stop("Error: lambda must in [0,1]") + } + if (cn_thresh>30 || cn_thresh<20){ + warning("cn_thresh is recommended in [20,30]") + } + ### Call solver c_result <- tryCatch(gwr_lcr_fit( x, y, coords, bw, adaptive, enum(kernel), longlat, p, theta, + lambda, lambda_adjust, cn_thresh, has_intercept, hatmatrix, enum_list(parallel_method, parallel_types), parallel_arg, optim_bw @@ -123,6 +132,8 @@ gwr_lcr <- function( yhat <- c_result$yhat diagnostic <- c_result$diagnostic resi <- y - yhat + local_cn <- c_result$localCN + local_lambda <- c_result$localLambda # n_dp <- nrow(coords) # rss_gw <- sum(resi * resi) # sigma <- rss_gw / (n_dp - 2 * shat_trace[1] + shat_trace[2]) @@ -136,7 +147,9 @@ gwr_lcr <- function( sdf_data <- as.data.frame(cbind( betas, "yhat" = yhat, - "residual" = resi + "residual" = resi, + "localCN" = local_cn, + "localLambda" = local_lambda # betas_se, # betas_tv )) @@ -157,6 +170,9 @@ gwr_lcr <- function( longlat = longlat, p = p, theta = theta, + lambda = lambda, + lambda_adjust = lambda_adjust, + cn_thresh = cn_thresh, hatmatrix = hatmatrix, has_intercept = has_intercept, parallel_method = parallel_method, @@ -199,6 +215,10 @@ print.gwlcrm <- function(x, decimal_fmt = "%.3f", ...) { ifelse(x$args$optim_bw, paste0( "(Optimized accroding to CV)" ), ""), fill = T) + cat("Lambda(ridge parameter for gwr ridge model):", x$args$lambda, + ifelse(x$args$lambda_adjust, " (Adjusted)", ""), + fill = T) + cat("\n", fill = T) cat("Summary of Coefficient Estimates", fill = T) diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 93569a5..91abcf3 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -97,8 +97,8 @@ BEGIN_RCPP END_RCPP } // gwr_lcr_fit -List gwr_lcr_fit(const arma::mat& x, const arma::vec& y, const arma::mat& coords, double bw, bool adaptive, size_t kernel, bool longlat, double p, double theta, bool intercept, bool hatmatrix, size_t parallel_type, const IntegerVector& parallel_arg, bool optim_bw); -RcppExport SEXP _GWmodel3_gwr_lcr_fit(SEXP xSEXP, SEXP ySEXP, SEXP coordsSEXP, SEXP bwSEXP, SEXP adaptiveSEXP, SEXP kernelSEXP, SEXP longlatSEXP, SEXP pSEXP, SEXP thetaSEXP, SEXP interceptSEXP, SEXP hatmatrixSEXP, SEXP parallel_typeSEXP, SEXP parallel_argSEXP, SEXP optim_bwSEXP) { +List gwr_lcr_fit(const arma::mat& x, const arma::vec& y, const arma::mat& coords, double bw, bool adaptive, size_t kernel, bool longlat, double p, double theta, double lambda, bool lambda_adjust, double cn_thresh, bool intercept, bool hatmatrix, size_t parallel_type, const IntegerVector& parallel_arg, bool optim_bw); +RcppExport SEXP _GWmodel3_gwr_lcr_fit(SEXP xSEXP, SEXP ySEXP, SEXP coordsSEXP, SEXP bwSEXP, SEXP adaptiveSEXP, SEXP kernelSEXP, SEXP longlatSEXP, SEXP pSEXP, SEXP thetaSEXP, SEXP lambdaSEXP, SEXP lambda_adjustSEXP, SEXP cn_threshSEXP, SEXP interceptSEXP, SEXP hatmatrixSEXP, SEXP parallel_typeSEXP, SEXP parallel_argSEXP, SEXP optim_bwSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; @@ -111,12 +111,15 @@ BEGIN_RCPP Rcpp::traits::input_parameter< bool >::type longlat(longlatSEXP); Rcpp::traits::input_parameter< double >::type p(pSEXP); Rcpp::traits::input_parameter< double >::type theta(thetaSEXP); + Rcpp::traits::input_parameter< double >::type lambda(lambdaSEXP); + Rcpp::traits::input_parameter< bool >::type lambda_adjust(lambda_adjustSEXP); + Rcpp::traits::input_parameter< double >::type cn_thresh(cn_threshSEXP); Rcpp::traits::input_parameter< bool >::type intercept(interceptSEXP); Rcpp::traits::input_parameter< bool >::type hatmatrix(hatmatrixSEXP); Rcpp::traits::input_parameter< size_t >::type parallel_type(parallel_typeSEXP); Rcpp::traits::input_parameter< const IntegerVector& >::type parallel_arg(parallel_argSEXP); Rcpp::traits::input_parameter< bool >::type optim_bw(optim_bwSEXP); - rcpp_result_gen = Rcpp::wrap(gwr_lcr_fit(x, y, coords, bw, adaptive, kernel, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw)); + rcpp_result_gen = Rcpp::wrap(gwr_lcr_fit(x, y, coords, bw, adaptive, kernel, longlat, p, theta, lambda, lambda_adjust, cn_thresh, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw)); return rcpp_result_gen; END_RCPP } @@ -160,7 +163,7 @@ static const R_CallMethodDef CallEntries[] = { {"_GWmodel3_gtdr_fit", (DL_FUNC) &_GWmodel3_gtdr_fit, 19}, {"_GWmodel3_gwr_basic_fit", (DL_FUNC) &_GWmodel3_gwr_basic_fit, 22}, {"_GWmodel3_gwr_basic_predict", (DL_FUNC) &_GWmodel3_gwr_basic_predict, 14}, - {"_GWmodel3_gwr_lcr_fit", (DL_FUNC) &_GWmodel3_gwr_lcr_fit, 14}, + {"_GWmodel3_gwr_lcr_fit", (DL_FUNC) &_GWmodel3_gwr_lcr_fit, 17}, {"_GWmodel3_gwr_multiscale_fit", (DL_FUNC) &_GWmodel3_gwr_multiscale_fit, 25}, {NULL, NULL, 0} }; diff --git a/src/gwr_localcollinearity.cpp b/src/gwr_localcollinearity.cpp index b3345eb..06dff98 100644 --- a/src/gwr_localcollinearity.cpp +++ b/src/gwr_localcollinearity.cpp @@ -20,6 +20,9 @@ List gwr_lcr_fit( bool longlat, double p, double theta, + double lambda, + bool lambda_adjust, + double cn_thresh, bool intercept, bool hatmatrix, size_t parallel_type, @@ -56,6 +59,25 @@ List gwr_lcr_fit( algorithm.setHasIntercept(intercept); algorithm.setHasHatMatrix(hatmatrix); + algorithm.setLambdaAdjust(lambda_adjust); + algorithm.setLambda(lambda); + algorithm.setCnThresh(cn_thresh); + + switch (ParallelType(size_t(parallel_type))) + { + case ParallelType::SerialOnly: + algorithm.setParallelType(ParallelType::SerialOnly); + break; +#ifdef _OPENMP + case ParallelType::OpenMP: + algorithm.setParallelType(ParallelType::OpenMP); + algorithm.setOmpThreadNum(vpar_args[0]); + break; +#endif + default: + algorithm.setParallelType(ParallelType::SerialOnly); + break; + } if (optim_bw) { @@ -63,6 +85,8 @@ List gwr_lcr_fit( algorithm.setBandwidthSelectionCriterion(GWRLocalCollinearity::BandwidthSelectionCriterionType::CV); } + + algorithm.fit(); // Return Results @@ -71,7 +95,9 @@ List gwr_lcr_fit( List result_list = List::create( Named("betas") = betas, Named("diagnostic") = mywrap(algorithm.diagnostic()), - Named("yhat") = yhat + Named("yhat") = yhat, + Named("localCN") = algorithm.localCN(), + Named("localLambda") = algorithm.localLambda() ); if (optim_bw){ diff --git a/tests/testthat/test-gwr_localcollinearity.R b/tests/testthat/test-gwr_localcollinearity.R index 3ced0c6..b78a598 100644 --- a/tests/testthat/test-gwr_localcollinearity.R +++ b/tests/testthat/test-gwr_localcollinearity.R @@ -1,14 +1,38 @@ data(LondonHP) m <- NULL -test_that("Basic GWR LocalCollinearity: works", { - m <<- expect_no_error( +test_that("GWR LocalCollinearity: works", { + m1 <<- expect_no_error( gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, 64, TRUE) ) }) -test_that("Basic GWR LocalCollinearity: bw selection", { - m <<- expect_no_error( +test_that("GWR LocalCollinearity: bw selection", { + expect_no_error( gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP) ) -}) \ No newline at end of file +}) + +test_that("GWR LocalCollinearity: omp", { + expect_no_error( + gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, parallel_method = "omp", parallel_arg = 4) + ) +}) + +test_that("GWR LocalCollinearity: lambda & cnthresh", { + m2 <<- expect_no_error( + gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, 64, TRUE, lambda = 0.3, cn_thresh = 30) + ) +}) + +test_that("GWR LocalCollinearity: lambda & cnthresh", { + m3 <<- expect_no_error( + gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, 64, TRUE, lambda_adjust = TRUE,cn_thresh = 30) + ) +}) + +test_that("GWR LocalCollinearity: lambda error", { + expect_error({ + gwr_lcr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, 64, TRUE, lambda = 10, cn_thresh = 30) + }, "Error: lambda must in \\[0,1\\]") +}) From 7297e2554699c00befa5d5017becdc1957637771 Mon Sep 17 00:00:00 2001 From: zyy <2711245442@qq.com> Date: Wed, 11 Jun 2025 18:02:44 +0800 Subject: [PATCH 3/3] edit: paramter descriiption --- R/gwr_localcollinearity.R | 53 ++++++++++++++++------------------- man/gwr_lcr.Rd | 58 ++++++++++++++++----------------------- man/print.Rd | 3 +- 3 files changed, 49 insertions(+), 65 deletions(-) diff --git a/R/gwr_localcollinearity.R b/R/gwr_localcollinearity.R index 671b519..1780317 100644 --- a/R/gwr_localcollinearity.R +++ b/R/gwr_localcollinearity.R @@ -1,12 +1,9 @@ -#' Calibrate a basic GWR model +#' Calibrate a GWR local collinearity model #' #' @param formula Regresison model. #' @param data A `sf` objects. #' @param bw Either a value to set the size of bandwidth, -#' or one of the following characters to set the criterion for -#' bandwidth auto-optimization process. -#' - `AIC` -#' - `CV` +#' or `CV` to set the criterion for bandwidth auto-optimization process. #' Note that if `NA` or other non-numeric value is setted, #' this parameter will be reset to `Inf`. #' @param adaptive Whether the bandwidth value is adaptive or not. @@ -15,25 +12,24 @@ #' @param p Power of the Minkowski distance, #' default to 2, i.e., Euclidean distance. #' @param theta Angle in radian to roate the coordinate system, default to 0. -#' @param optim_bw_range Bounds on bandwidth optimization, a vector of two numeric elements. -#' Set to `NA_real_` to enable default values selected by the algorithm. +#' @param lambda Option for a globally-defined (constant) ridge parameter. +#' Default is lambda=0, which gives a basic GWR fit +#' @param lambda_adjust A locally-varying ridge parameter.Default FALSE, refers to: +#' -i a basic GWR without a local ridge adjustment +#' (i.e. lambda=0, everywhere); +#' -ii a penalised GWR with a global ridge adjustment +#' (i.e. lambda is user-specified as some constant, other than 0 everywhere); +#' if TRUE, use cn.tresh to set the maximum condition number. +#' Here for locations with a condition number (for its local design matrix) +#' above this user-specified threshold, a local ridge parameter is found +#' @param cn_thresh maximum value for condition number, commonly set between 20 and 30 #' @param hatmatrix If TRUE, great circle will be caculated. -#' @param parallel_method Parallel method. +#' @param parallel_method Parallel method, multithreading (`omp`) is available #' @param parallel_arg Parallel method argument. #' @param verbose Whether to print additional information. #' #' @return A `gwlcrm` object. #' -#' @details -#' ## Parallelization -#' -#' Two parallel methods are provided to speed up basic GWR algorithm: -#' -#' - Multithreading (`omp`) -#' - NVIDIA GPU Computing (`cuda`) -#' -#' See the vignettes about parallelization to learn more about this topic. -#' #' @examples #' data(LondonHP) #' @@ -41,11 +37,9 @@ #' gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY, LondonHP, 64, TRUE) #' #' # Bandwidth Optimization -#' m <- gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'AIC', TRUE) +#' m <- gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'CV', TRUE) #' m #' -#' @seealso `browseVignettes("")` -#' #' @importFrom stats na.action model.frame model.extract model.matrix terms #' @export gwr_lcr <- function( @@ -60,7 +54,6 @@ gwr_lcr <- function( lambda = 0, lambda_adjust = FALSE, cn_thresh = 30, - cv = TRUE, hatmatrix = TRUE, parallel_method = c("no", "omp"), parallel_arg = c(0), @@ -161,9 +154,9 @@ gwr_lcr <- function( SDF = sdf, diagnostic = diagnostic, args = list( - # x = x, - # y = y, - # coords = coords, + x = x, + y = y, + coords = coords, bw = bw, adaptive = adaptive, kernel = kernel, @@ -218,6 +211,8 @@ print.gwlcrm <- function(x, decimal_fmt = "%.3f", ...) { cat("Lambda(ridge parameter for gwr ridge model):", x$args$lambda, ifelse(x$args$lambda_adjust, " (Adjusted)", ""), fill = T) + if(x$args$lambda_adjust) + cat(" cnThresh:", x$args$cn_thresh, fill = T) cat("\n", fill = T) @@ -246,7 +241,7 @@ print.gwlcrm <- function(x, decimal_fmt = "%.3f", ...) { cat("\n", fill = T) } -#' @describeIn gwr_lcr Plot the result of basic GWR model. +#' @describeIn gwr_lcr Plot the result of GWR local collinearity model. #' #' @param x A "gwlcrm" object. #' @param y Ignored. @@ -277,7 +272,7 @@ plot.gwlcrm <- function(x, y, ..., columns) { plot(sdf, ...) } -#' @describeIn gwr_lcr Get coefficients of a basic GWR model. +#' @describeIn gwr_lcr Get coefficients of a GWR local collinearity model. #' #' @param object A "gwlcrm" object. #' @param \dots Additional arguments passing to [coef()]. @@ -294,7 +289,7 @@ coef.gwlcrm <- function(object, ...) { sf::st_drop_geometry(object$SDF[object$indep_vars]) } -#' @describeIn gwr_lcr Get fitted values of a basic GWR model. +#' @describeIn gwr_lcr Get fitted values of a GWR local collinearity model. #' #' @param object A "gwlcrm" object. #' @param \dots Additional arguments passing to [fitted()]. @@ -311,7 +306,7 @@ fitted.gwlcrm <- function(object, ...) { object$SDF[["yhat"]] } -#' @describeIn gwr_lcr Get residuals of a basic GWR model. +#' @describeIn gwr_lcr Get residuals of a GWR local collinearity model. #' #' @param object A "gwlcrm" object. #' @param \dots Additional arguments passing to [residuals()]. diff --git a/man/gwr_lcr.Rd b/man/gwr_lcr.Rd index df711b3..77e7087 100644 --- a/man/gwr_lcr.Rd +++ b/man/gwr_lcr.Rd @@ -6,7 +6,7 @@ \alias{coef.gwlcrm} \alias{fitted.gwlcrm} \alias{residuals.gwlcrm} -\title{Calibrate a basic GWR model} +\title{Calibrate a GWR local collinearity model} \usage{ gwr_lcr( formula, @@ -20,7 +20,6 @@ gwr_lcr( lambda = 0, lambda_adjust = FALSE, cn_thresh = 30, - cv = TRUE, hatmatrix = TRUE, parallel_method = c("no", "omp"), parallel_arg = c(0), @@ -41,14 +40,9 @@ gwr_lcr( \item{data}{A \code{sf} objects.} \item{bw}{Either a value to set the size of bandwidth, -or one of the following characters to set the criterion for -bandwidth auto-optimization process. -\itemize{ -\item \code{AIC} -\item \code{CV} +or \code{CV} to set the criterion for bandwidth auto-optimization process. Note that if \code{NA} or other non-numeric value is setted, -this parameter will be reset to \code{Inf}. -}} +this parameter will be reset to \code{Inf}.} \item{adaptive}{Whether the bandwidth value is adaptive or not.} @@ -61,9 +55,23 @@ default to 2, i.e., Euclidean distance.} \item{theta}{Angle in radian to roate the coordinate system, default to 0.} +\item{lambda}{Option for a globally-defined (constant) ridge parameter. +Default is lambda=0, which gives a basic GWR fit} + +\item{lambda_adjust}{A locally-varying ridge parameter.Default FALSE, refers to: +-i a basic GWR without a local ridge adjustment +(i.e. lambda=0, everywhere); +-ii a penalised GWR with a global ridge adjustment +(i.e. lambda is user-specified as some constant, other than 0 everywhere); +if TRUE, use cn.tresh to set the maximum condition number. +Here for locations with a condition number (for its local design matrix) +above this user-specified threshold, a local ridge parameter is found} + +\item{cn_thresh}{maximum value for condition number, commonly set between 20 and 30} + \item{hatmatrix}{If TRUE, great circle will be caculated.} -\item{parallel_method}{Parallel method.} +\item{parallel_method}{Parallel method, multithreading (\code{omp}) is available} \item{parallel_arg}{Parallel method argument.} @@ -79,37 +87,22 @@ default to 2, i.e., Euclidean distance.} If it is missing or non-character value, all coefficient columns are plottd.} \item{object}{A "gwlcrm" object.} - -\item{optim_bw_range}{Bounds on bandwidth optimization, a vector of two numeric elements. -Set to \code{NA_real_} to enable default values selected by the algorithm.} } \value{ A \code{gwlcrm} object. } \description{ -Calibrate a basic GWR model -} -\details{ -\subsection{Parallelization}{ - -Two parallel methods are provided to speed up basic GWR algorithm: -\itemize{ -\item Multithreading (\code{omp}) -\item NVIDIA GPU Computing (\code{cuda}) -} - -See the vignettes about parallelization to learn more about this topic. -} +Calibrate a GWR local collinearity model } \section{Functions}{ \itemize{ -\item \code{plot(gwlcrm)}: Plot the result of basic GWR model. +\item \code{plot(gwlcrm)}: Plot the result of GWR local collinearity model. -\item \code{coef(gwlcrm)}: Get coefficients of a basic GWR model. +\item \code{coef(gwlcrm)}: Get coefficients of a GWR local collinearity model. -\item \code{fitted(gwlcrm)}: Get fitted values of a basic GWR model. +\item \code{fitted(gwlcrm)}: Get fitted values of a GWR local collinearity model. -\item \code{residuals(gwlcrm)}: Get residuals of a basic GWR model. +\item \code{residuals(gwlcrm)}: Get residuals of a GWR local collinearity model. }} \examples{ @@ -119,7 +112,7 @@ data(LondonHP) gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY, LondonHP, 64, TRUE) # Bandwidth Optimization -m <- gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'AIC', TRUE) +m <- gwr_lcr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'CV', TRUE) m plot(m) @@ -131,6 +124,3 @@ fitted(m) residuals(m) } -\seealso{ -\code{browseVignettes("")} -} diff --git a/man/print.Rd b/man/print.Rd index 85015d7..b48b76b 100644 --- a/man/print.Rd +++ b/man/print.Rd @@ -1,7 +1,6 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/gtdr.R, R/gwaverage.R, R/gwcorrelation.R, -% R/gwr_basic.R, -% R/gwr_localcollinearity.R, R/gwr_multiscale.R +% R/gwr_basic.R, R/gwr_localcollinearity.R, R/gwr_multiscale.R \name{print.gtdrm} \alias{print.gtdrm} \alias{print.gwavgm}