From 83f3bd9d3aa89aa6ed9076bfc233fd0cd42e5aec Mon Sep 17 00:00:00 2001 From: HPDell Date: Fri, 12 Apr 2024 10:40:14 +0100 Subject: [PATCH 01/11] edit: update libgwmodel to v0.9.5 --- src/libgwmodel | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libgwmodel b/src/libgwmodel index 56d5e4e..4e604ea 160000 --- a/src/libgwmodel +++ b/src/libgwmodel @@ -1 +1 @@ -Subproject commit 56d5e4edc47446e1fdb9b5f5e91d875e48e79d08 +Subproject commit 4e604eab1c4bd7933cdb9bf523c935cafa362526 From 7d0405f25087c0b9557b7053ce604d107cadd8e3 Mon Sep 17 00:00:00 2001 From: HPDell Date: Fri, 12 Apr 2024 11:18:03 +0100 Subject: [PATCH 02/11] add: cpp gtwr_fit --- R/RcppExports.R | 4 ++ src/Makevars.in | 3 ++ src/Makevars.win | 3 ++ src/RcppExports.cpp | 30 +++++++++++ src/gtwr.cpp | 127 ++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 167 insertions(+) create mode 100644 src/gtwr.cpp diff --git a/R/RcppExports.R b/R/RcppExports.R index d69b2ce..427cc8c 100644 --- a/R/RcppExports.R +++ b/R/RcppExports.R @@ -1,6 +1,10 @@ # Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 +gtwr_fit <- function(x, y, coords, times, bw, adaptive, kernel, lambda, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw, optim_bw_criterion, optim_lambda, verbose) { + .Call(`_GWmodel3_gtwr_fit`, x, y, coords, times, bw, adaptive, kernel, lambda, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw, optim_bw_criterion, optim_lambda, verbose) +} + gwdr_fit <- function(x, y, coords, bw, adaptive, kernel, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw, optim_bw_criterion, optim_threashold, optim_step, optim_max_iter, select_model, select_model_threshold, variable_names, verbose) { .Call(`_GWmodel3_gwdr_fit`, x, y, coords, bw, adaptive, kernel, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw, optim_bw_criterion, optim_threashold, optim_step, optim_max_iter, select_model, select_model_threshold, variable_names, verbose) } diff --git a/src/Makevars.in b/src/Makevars.in index 4924373..54fde75 100644 --- a/src/Makevars.in +++ b/src/Makevars.in @@ -34,6 +34,7 @@ endif OBJECTS_LIBGWMODEL = \ libgwmodel/src/gwmodelpp/spatialweight/BandwidthWeight.o \ libgwmodel/src/gwmodelpp/spatialweight/CRSDistance.o \ + libgwmodel/src/gwmodelpp/spatialweight/CRSSTDistance.o \ libgwmodel/src/gwmodelpp/spatialweight/DMatDistance.o \ libgwmodel/src/gwmodelpp/spatialweight/Distance.o \ libgwmodel/src/gwmodelpp/spatialweight/MinkwoskiDistance.o \ @@ -41,6 +42,7 @@ OBJECTS_LIBGWMODEL = \ libgwmodel/src/gwmodelpp/spatialweight/SpatialWeight.o \ libgwmodel/src/gwmodelpp/spatialweight/Weight.o \ libgwmodel/src/gwmodelpp/BandwidthSelector.o \ + libgwmodel/src/gwmodelpp/GTWR.o \ libgwmodel/src/gwmodelpp/GWDR.o \ libgwmodel/src/gwmodelpp/GWPCA.o \ libgwmodel/src/gwmodelpp/GWRBase.o \ @@ -63,6 +65,7 @@ OBJECTS_GWMODEL = \ gwr_basic.o \ gwr_multiscale.o \ gwdr.o \ + gtwr.o \ RcppExports.o OBJECTS_CXX = $(OBJECTS_LIBGWMODEL) $(OBJECTS_TELEGRAM) $(OBJECTS_GWMODEL) diff --git a/src/Makevars.win b/src/Makevars.win index b0b5f19..5cc5f87 100644 --- a/src/Makevars.win +++ b/src/Makevars.win @@ -36,6 +36,7 @@ PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(GSL_L OBJECTS_LIBGWMODEL = \ libgwmodel/src/gwmodelpp/spatialweight/BandwidthWeight.o \ libgwmodel/src/gwmodelpp/spatialweight/CRSDistance.o \ + libgwmodel/src/gwmodelpp/spatialweight/CRSSTDistance.o \ libgwmodel/src/gwmodelpp/spatialweight/DMatDistance.o \ libgwmodel/src/gwmodelpp/spatialweight/Distance.o \ libgwmodel/src/gwmodelpp/spatialweight/MinkwoskiDistance.o \ @@ -43,6 +44,7 @@ OBJECTS_LIBGWMODEL = \ libgwmodel/src/gwmodelpp/spatialweight/SpatialWeight.o \ libgwmodel/src/gwmodelpp/spatialweight/Weight.o \ libgwmodel/src/gwmodelpp/BandwidthSelector.o \ + libgwmodel/src/gwmodelpp/GTWR.o \ libgwmodel/src/gwmodelpp/GWDR.o \ libgwmodel/src/gwmodelpp/GWPCA.o \ libgwmodel/src/gwmodelpp/GWRBase.o \ @@ -65,6 +67,7 @@ OBJECTS_GWMODEL = \ gwr_basic.o \ gwr_multiscale.o \ gwdr.o \ + gtwr.o \ RcppExports.o diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp index 61cb38b..dd522a3 100644 --- a/src/RcppExports.cpp +++ b/src/RcppExports.cpp @@ -11,6 +11,35 @@ Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif +// gtwr_fit +List gtwr_fit(const NumericMatrix& x, const NumericVector& y, const NumericMatrix& coords, const NumericVector& times, double bw, bool adaptive, int kernel, double lambda, bool longlat, double p, double theta, bool intercept, bool hatmatrix, size_t parallel_type, const IntegerVector& parallel_arg, bool optim_bw, size_t optim_bw_criterion, bool optim_lambda, int verbose); +RcppExport SEXP _GWmodel3_gtwr_fit(SEXP xSEXP, SEXP ySEXP, SEXP coordsSEXP, SEXP timesSEXP, SEXP bwSEXP, SEXP adaptiveSEXP, SEXP kernelSEXP, SEXP lambdaSEXP, SEXP longlatSEXP, SEXP pSEXP, SEXP thetaSEXP, SEXP interceptSEXP, SEXP hatmatrixSEXP, SEXP parallel_typeSEXP, SEXP parallel_argSEXP, SEXP optim_bwSEXP, SEXP optim_bw_criterionSEXP, SEXP optim_lambdaSEXP, SEXP verboseSEXP) { +BEGIN_RCPP + Rcpp::RObject rcpp_result_gen; + Rcpp::RNGScope rcpp_rngScope_gen; + Rcpp::traits::input_parameter< const NumericMatrix& >::type x(xSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type y(ySEXP); + Rcpp::traits::input_parameter< const NumericMatrix& >::type coords(coordsSEXP); + Rcpp::traits::input_parameter< const NumericVector& >::type times(timesSEXP); + Rcpp::traits::input_parameter< double >::type bw(bwSEXP); + Rcpp::traits::input_parameter< bool >::type adaptive(adaptiveSEXP); + Rcpp::traits::input_parameter< int >::type kernel(kernelSEXP); + Rcpp::traits::input_parameter< double >::type lambda(lambdaSEXP); + 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::traits::input_parameter< size_t >::type optim_bw_criterion(optim_bw_criterionSEXP); + Rcpp::traits::input_parameter< bool >::type optim_lambda(optim_lambdaSEXP); + Rcpp::traits::input_parameter< int >::type verbose(verboseSEXP); + rcpp_result_gen = Rcpp::wrap(gtwr_fit(x, y, coords, times, bw, adaptive, kernel, lambda, longlat, p, theta, intercept, hatmatrix, parallel_type, parallel_arg, optim_bw, optim_bw_criterion, optim_lambda, verbose)); + return rcpp_result_gen; +END_RCPP +} // gwdr_fit List gwdr_fit(const NumericMatrix& x, const NumericVector& y, const NumericMatrix& coords, const NumericVector& bw, const LogicalVector& adaptive, const IntegerVector& kernel, bool intercept, bool hatmatrix, size_t parallel_type, const IntegerVector& parallel_arg, bool optim_bw, size_t optim_bw_criterion, double optim_threashold, double optim_step, size_t optim_max_iter, bool select_model, size_t select_model_threshold, const CharacterVector& variable_names, int verbose); RcppExport SEXP _GWmodel3_gwdr_fit(SEXP xSEXP, SEXP ySEXP, SEXP coordsSEXP, SEXP bwSEXP, SEXP adaptiveSEXP, SEXP kernelSEXP, SEXP interceptSEXP, SEXP hatmatrixSEXP, SEXP parallel_typeSEXP, SEXP parallel_argSEXP, SEXP optim_bwSEXP, SEXP optim_bw_criterionSEXP, SEXP optim_threasholdSEXP, SEXP optim_stepSEXP, SEXP optim_max_iterSEXP, SEXP select_modelSEXP, SEXP select_model_thresholdSEXP, SEXP variable_namesSEXP, SEXP verboseSEXP) { @@ -133,6 +162,7 @@ END_RCPP } static const R_CallMethodDef CallEntries[] = { + {"_GWmodel3_gtwr_fit", (DL_FUNC) &_GWmodel3_gtwr_fit, 19}, {"_GWmodel3_gwdr_fit", (DL_FUNC) &_GWmodel3_gwdr_fit, 19}, {"_GWmodel3_gwr_basic_fit", (DL_FUNC) &_GWmodel3_gwr_basic_fit, 22}, {"_GWmodel3_gwr_basic_predict", (DL_FUNC) &_GWmodel3_gwr_basic_predict, 14}, diff --git a/src/gtwr.cpp b/src/gtwr.cpp new file mode 100644 index 0000000..3bae047 --- /dev/null +++ b/src/gtwr.cpp @@ -0,0 +1,127 @@ +#include +#include +#include "utils.h" +#include "gwmodelpp/GTWR.h" + +using namespace std; +using namespace Rcpp; +using namespace arma; +using namespace gwm; + +// [[Rcpp::export]] +List gtwr_fit( + const NumericMatrix& x, + const NumericVector& y, + const NumericMatrix& coords, + const NumericVector& times, + double bw, + bool adaptive, + int kernel, + double lambda, + bool longlat, + double p, + double theta, + bool intercept, + bool hatmatrix, + size_t parallel_type, + const IntegerVector& parallel_arg, + bool optim_bw, + size_t optim_bw_criterion, + bool optim_lambda, + int verbose +) { + // Convert data types + arma::mat mx = myas(x); + arma::vec my = myas(y); + arma::mat mcoords = myas(coords); + arma::mat mtimes = myas(times); + std::vector vpar_args = as< std::vector >(Rcpp::IntegerVector(parallel_arg)); + + // Make Spatial Weight + BandwidthWeight bandwidth(bw, adaptive, BandwidthWeight::KernelFunctionType(kernel)); + CRSDistance *sdist = nullptr; + if (longlat) + { + sdist = new CRSDistance(true); + } + else + { + if (p == 2.0 && theta == 0.0) + { + sdist = new CRSDistance(false); + } + else + { + sdist = new MinkwoskiDistance(p, theta); + } + } + OneDimDistance tdist; + CRSSTDistance stdist(sdist, &tdist, lambda); + SpatialWeight spatial(&bandwidth, &stdist); + + // Make Algorithm Object + GTWR algorithm; + algorithm.setDependentVariable(my); + algorithm.setIndependentVariables(mx); + algorithm.setCoords(mcoords, mtimes); + algorithm.setSpatialWeight(spatial); + algorithm.setHasHatMatrix(hatmatrix); + algorithm.setHasIntercept(intercept); + + if (optim_bw) + { + algorithm.setIsAutoselectBandwidth(true); + algorithm.setBandwidthSelectionCriterion(GTWR::BandwidthSelectionCriterionType(size_t(optim_bw_criterion))); + } + + if (optim_lambda) + { + algorithm.setIsAutoselectLambda(true); + } + + 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; + } + try + { + algorithm.fit(); + } + catch(const std::exception& e) + { + stop(e.what()); + } + + // Return Results + mat betas = algorithm.betas(); + vec fitted = sum(mx % betas, 1); + List result_list = List::create( + Named("betas") = mywrap(betas), + Named("betasSE") = mywrap(algorithm.betasSE()), + Named("sTrace") = mywrap(algorithm.sHat()), + Named("sHat") = mywrap(algorithm.s()), + Named("diagnostic") = mywrap(algorithm.diagnostic()) + ); + const SpatialWeight& spatialWeights = algorithm.spatialWeight(); + if (optim_bw) + { + result_list["bw_value"] = wrap(spatialWeights.weight()->bandwidth()); + } + // if (optim_lambda) + // { + // result_list["lambda_value"] = wrap(spatialWeights.distance()->mLambda); + // } + + return result_list; +} From 27609feceed32ead838e08ff0461a1cefa70166a Mon Sep 17 00:00:00 2001 From: HPDell Date: Fri, 12 Apr 2024 12:44:43 +0100 Subject: [PATCH 03/11] add: gtwr R function --- R/gtwr.R | 283 +++++++++++++++++++++++++++++++++++++ src/gtwr.cpp | 3 +- tests/testthat/test-gtwr.R | 23 +++ 3 files changed, 308 insertions(+), 1 deletion(-) create mode 100644 R/gtwr.R create mode 100644 tests/testthat/test-gtwr.R diff --git a/R/gtwr.R b/R/gtwr.R new file mode 100644 index 0000000..af85797 --- /dev/null +++ b/R/gtwr.R @@ -0,0 +1,283 @@ +#' 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 `gtwrm` 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 +#' gtwr(PURCHASE ~ FLOORSZ + UNEMPLOY, LondonHP, 64, TRUE) +#' +#' # Bandwidth Optimization +#' m <- gtwr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'AIC', TRUE) +#' m +#' +#' @seealso `browseVignettes("")` +#' +#' @importFrom stats na.action model.frame model.extract model.matrix terms +#' @export +gtwr <- function( + formula, + data, + timestamps, + bw = NA, + lambda = NA, + adaptive = FALSE, + kernel = c("gaussian", "exp", "bisquare", "tricube", "boxcar"), + longlat = FALSE, + p = 2.0, + theta = 0.0, + optim_bw_range = c(0, Inf), + hatmatrix = TRUE, + time_format = NA, + parallel_method = c("no", "omp", "cuda"), + 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.") + } + + if (missing(timestamps)) { + stop("Timestamps are required.") + } else if (is.character(timestamps)) { + if (length(timestamps) == 1) { + if (timestamps %in% names(data)) { + timestamps <- data[[timestamps]] + } else { + stop("The specified `timestamps` must be a (only one) valid column name in `data`.") + } + } else if (length(timestamps) == nrow(coords)) { + timestamps <- as.numeric(as.Date(timestamps, format = time_format)) + } else { + stop("If `timestamps` is characters, it must be either a column name in `data`, or date-time character vector for all samples.") + } + } else if (is.numeric(timestamps) || is.integer(timestamps)) { + if (length(timestamps) != nrow(coords)) { + stop("The length of `timestamps` must be equal to the number of samples.") + } + } + + ### Check whether bandwidth is valid. + if (missing(bw)) { + optim_bw <- TRUE + optim_bw_criterion <- "AIC" + bw <- Inf + } else if (is.numeric(bw) || is.integer(bw)) { + optim_bw <- FALSE + optim_bw_criterion <- "AIC" + } else { + optim_bw <- TRUE + optim_bw_criterion <- + ifelse(is.character(bw), match.arg(bw, c("CV", "AIC")), "AIC") + bw <- Inf + } + + if (missing(lambda)) { + optim_lambda <- TRUE + lambda <- 0.05 + } else if (is.numeric(lambda) && lambda >= 0 && lambda <= 1) { + optim_lambda <- FALSE + } else { + optim_lambda <- TRUE + lambda <- 0.05 + } + + ### Call solver + c_result <- tryCatch(gtwr_fit( + x, y, coords, timestamps, bw, adaptive, enum(kernel), lambda, longlat, p, theta, + has_intercept, hatmatrix, + enum_list(parallel_method, parallel_types), parallel_arg, + optim_bw, enum(optim_bw_criterion, c("AIC", "CV")), + optim_lambda, as.integer(verbose) + ), error = function (e) { + stop("Error:", conditionMessage(e)) + }) + if (optim_bw) + bw <- c_result$bandwidth + betas <- c_result$betas + betas_se <- c_result$betasSE + shat_trace <- c_result$sTrace + fitted <- c_result$fitted + diagnostic <- c_result$diagnostic + resi <- y - fitted + 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" = fitted, + "residual" = resi, + betas_se, + betas_tv + )) + sdf_data$geometry <- sf::st_geometry(data) + sdf <- sf::st_sf(sdf_data) + + ### Return result + gtwrm <- list( + SDF = sdf, + diagnostic = diagnostic, + args = list( + x = x, + y = y, + coords = coords, + timestamps = timestamps, + 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, + optim_bw_criterion = optim_bw_criterion, + optim_lambda = optim_lambda, + verbose = verbose + ), + call = mc, + indep_vars = indep_vars, + dep_var = dep_var + ) + class(gtwrm) <- c("gtwrm", "gwrm") + gtwrm +} + +#' Print description of a `gtwrm` object +#' +#' @param x An `hgtwrm` object returned by [gtwr()]. +#' @param decimal_fmt The format string passing to [base::sprintf()]. +#' @inheritDotParams print_table_md +#' +#' @method print gtwrm +#' @importFrom stats coef fivenum +#' @rdname print +#' @export +print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { + if (!inherits(x, "gtwrm")) { + stop("It's not a gtwrm object.") + } + + ### Basic Information + cat("Geographically Weighted Regression Model", 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 ", + x$args$optim_bw_criterion, + ")" + ), ""), 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 gtwr Predict on new locations. +#' +#' @param object A "gtwrm" object. +#' @param regression_points Data of new locations. +#' @param \dots Additional arguments. +#' @param verbose Whether to print additional message. +#' +#' @method predict gtwrm +#' +#' @examples +#' predict(m, LondonHP) +#' +#' @export +predict.gtwrm <- function(object, regression_points, verbose = FALSE, ...) { + if (!inherits(object, "gtwrm")) { + stop("It's not a gtwrm object.") + } + stop("GTWR is not predictable now.") +} diff --git a/src/gtwr.cpp b/src/gtwr.cpp index 3bae047..1ce606a 100644 --- a/src/gtwr.cpp +++ b/src/gtwr.cpp @@ -111,7 +111,8 @@ List gtwr_fit( Named("betasSE") = mywrap(algorithm.betasSE()), Named("sTrace") = mywrap(algorithm.sHat()), Named("sHat") = mywrap(algorithm.s()), - Named("diagnostic") = mywrap(algorithm.diagnostic()) + Named("diagnostic") = mywrap(algorithm.diagnostic()), + Named("fitted") = mywrap(fitted) ); const SpatialWeight& spatialWeights = algorithm.spatialWeight(); if (optim_bw) diff --git a/tests/testthat/test-gtwr.R b/tests/testthat/test-gtwr.R new file mode 100644 index 0000000..6c7a6c7 --- /dev/null +++ b/tests/testthat/test-gtwr.R @@ -0,0 +1,23 @@ +data(LondonHP) +LondonHP$time <- as.integer(round(runif(nrow(LondonHP), 1, 365))) +m <- NULL + +test_that("GTWR: set timestamps", { + m <<- expect_no_error({ + gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, "time", 64, 0.05, TRUE) + }) + expect_no_error({ + gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, 64, 0.05, TRUE) + }) +}) + +test_that("GTWR: helper functions", { + expect_no_error({ + coef(m) + fitted(m) + residuals(m) + }) + expect_no_error({ + plot(m) + }) +}) From 31c904b314eead19b3bd46e9a8aaa9834c6d8942 Mon Sep 17 00:00:00 2001 From: HPDell Date: Fri, 12 Apr 2024 16:20:06 +0100 Subject: [PATCH 04/11] edit: add some test --- tests/testthat/test-gtwr.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/tests/testthat/test-gtwr.R b/tests/testthat/test-gtwr.R index 6c7a6c7..6a6e2fa 100644 --- a/tests/testthat/test-gtwr.R +++ b/tests/testthat/test-gtwr.R @@ -11,6 +11,18 @@ test_that("GTWR: set timestamps", { }) }) +test_that("GTWR: optim lambda and bandwidth", { + expect_no_error({ + gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, 0.05, TRUE) + }) + expect_no_error({ + gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, 64, NA, TRUE) + }) + expect_no_error({ + gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, NA, TRUE) + }) +}) + test_that("GTWR: helper functions", { expect_no_error({ coef(m) From 45a5afa79f51f4332b8e55c3152400b5899c4390 Mon Sep 17 00:00:00 2001 From: HPDell Date: Mon, 15 Apr 2024 15:39:01 +0100 Subject: [PATCH 05/11] edit: do not specify rtools version --- .github/workflows/cran-check.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/.github/workflows/cran-check.yml b/.github/workflows/cran-check.yml index f6423b3..061d34f 100644 --- a/.github/workflows/cran-check.yml +++ b/.github/workflows/cran-check.yml @@ -22,7 +22,6 @@ jobs: uses: r-lib/actions/setup-r@v2 with: r-version: 'release' - rtools-version: '42' update-rtools: true - name: Install R Dependencies uses: r-lib/actions/setup-r-dependencies@v2 From 9c36605d59a0cbe3635ba66f6ed884d779f56042 Mon Sep 17 00:00:00 2001 From: HPDell Date: Wed, 17 Apr 2024 10:56:16 +0100 Subject: [PATCH 06/11] edit: update document --- NAMESPACE | 3 ++ R/gtwr.R | 37 ++++++++++------ man/gtwr.Rd | 108 +++++++++++++++++++++++++++++++++++++++++++++++ man/gwr_basic.Rd | 15 +++++++ 4 files changed, 149 insertions(+), 14 deletions(-) create mode 100644 man/gtwr.Rd diff --git a/NAMESPACE b/NAMESPACE index df7f94d..6edeff5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,7 +10,9 @@ S3method(plot,gwdrm) S3method(plot,gwrm) S3method(plot,gwrmultiscalem) S3method(plot,modelselcritl) +S3method(predict,gtwrm) S3method(predict,gwrm) +S3method(print,gtwrm) S3method(print,gwdrm) S3method(print,gwrm) S3method(print,gwrmultiscalem) @@ -20,6 +22,7 @@ S3method(residuals,gwrmultiscalem) S3method(step,default) S3method(step,gwdrm) S3method(step,gwrm) +export(gtwr) export(gwdr) export(gwdr_config) export(gwr_basic) diff --git a/R/gtwr.R b/R/gtwr.R index af85797..c34d325 100644 --- a/R/gtwr.R +++ b/R/gtwr.R @@ -1,7 +1,9 @@ -#' Calibrate a basic GWR model +#' Geographically and Temporally Weighted Regression #' -#' @param formula Regresison model. +#' @param formula Formula for regression. #' @param data A `sf` objects. +#' @param timestamps A vector timestamps for all samples. +#' Either a numerical vector, or a character vector to be parsed according to `time_format`. #' @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. @@ -9,6 +11,8 @@ #' - `CV` #' Note that if `NA` or other non-numeric value is setted, #' this parameter will be reset to `Inf`. +#' @param lambda Either a value between 0 and 1 as the weight of temporal distance, +#' or a `NA` value to enable auto-selection. #' @param adaptive Whether the bandwidth value is adaptive or not. #' @param kernel Kernel function used. #' @param longlat Whether the coordinates @@ -18,6 +22,7 @@ #' @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 time_format The format used to parse timestamps if they are characters. #' @param parallel_method Parallel method. #' @param parallel_arg Parallel method argument. #' @param verbose Whether to print additional information. @@ -27,24 +32,31 @@ #' @details #' ## Parallelization #' -#' Two parallel methods are provided to speed up basic GWR algorithm: +#' Supported method(s): #' #' - Multithreading (`omp`) -#' - NVIDIA GPU Computing (`cuda`) #' #' See the vignettes about parallelization to learn more about this topic. #' #' @examples #' data(LondonHP) +#' LondonHP$time <- as.integer(round(runif(nrow(LondonHP), 1, 365))) #' #' # Basic usage -#' gtwr(PURCHASE ~ FLOORSZ + UNEMPLOY, LondonHP, 64, TRUE) +#' m <- gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, "time", 64, 0.05, TRUE) +#' m +#' coef(m) +#' fitted(m) +#' residual(m) #' #' # Bandwidth Optimization -#' m <- gtwr(PURCHASE ~ FLOORSZ + UNEMPLOY + PROF, LondonHP, 'AIC', TRUE) -#' m +#' gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, 0.05, TRUE) +#' +#' # Lambda Optimization +#' gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, 64, NA, TRUE) #' -#' @seealso `browseVignettes("")` +#' # Bandwidth and Lambda optimization +#' gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, NA, TRUE) #' #' @importFrom stats na.action model.frame model.extract model.matrix terms #' @export @@ -62,7 +74,7 @@ gtwr <- function( optim_bw_range = c(0, Inf), hatmatrix = TRUE, time_format = NA, - parallel_method = c("no", "omp", "cuda"), + parallel_method = c("no", "omp"), parallel_arg = c(0), verbose = FALSE ) { @@ -215,7 +227,7 @@ gtwr <- function( #' #' @method print gtwrm #' @importFrom stats coef fivenum -#' @rdname print +#' @noRd #' @export print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { if (!inherits(x, "gtwrm")) { @@ -262,7 +274,7 @@ print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { cat("\n", fill = T) } -#' @describeIn gtwr Predict on new locations. +#' @describeIn [Not implemented] gtwr Predict on new locations. #' #' @param object A "gtwrm" object. #' @param regression_points Data of new locations. @@ -271,9 +283,6 @@ print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { #' #' @method predict gtwrm #' -#' @examples -#' predict(m, LondonHP) -#' #' @export predict.gtwrm <- function(object, regression_points, verbose = FALSE, ...) { if (!inherits(object, "gtwrm")) { diff --git a/man/gtwr.Rd b/man/gtwr.Rd new file mode 100644 index 0000000..4e4a14f --- /dev/null +++ b/man/gtwr.Rd @@ -0,0 +1,108 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gtwr.R +\name{gtwr} +\alias{gtwr} +\title{Geographically and Temporally Weighted Regression} +\usage{ +gtwr( + formula, + data, + timestamps, + bw = NA, + lambda = NA, + adaptive = FALSE, + kernel = c("gaussian", "exp", "bisquare", "tricube", "boxcar"), + longlat = FALSE, + p = 2, + theta = 0, + optim_bw_range = c(0, Inf), + hatmatrix = TRUE, + time_format = NA, + parallel_method = c("no", "omp"), + parallel_arg = c(0), + verbose = FALSE +) +} +\arguments{ +\item{formula}{Formula for regression.} + +\item{data}{A \code{sf} objects.} + +\item{timestamps}{A vector timestamps for all samples. +Either a numerical vector, or a character vector to be parsed according to \code{time_format}.} + +\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{lambda}{Either a value between 0 and 1 as the weight of temporal distance, +or a \code{NA} value to enable auto-selection.} + +\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{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.} + +\item{hatmatrix}{If TRUE, great circle will be caculated.} + +\item{time_format}{The format used to parse timestamps if they are characters.} + +\item{parallel_method}{Parallel method.} + +\item{parallel_arg}{Parallel method argument.} + +\item{verbose}{Whether to print additional information.} +} +\value{ +A \code{gtwrm} object. +} +\description{ +Geographically and Temporally Weighted Regression +} +\details{ +\subsection{Parallelization}{ + +Supported method(s): +\itemize{ +\item Multithreading (\code{omp}) +} + +See the vignettes about parallelization to learn more about this topic. +} +} +\examples{ +data(LondonHP) +LondonHP$time <- as.integer(round(runif(nrow(LondonHP), 1, 365))) + +# Basic usage +m <- gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, "time", 64, 0.05, TRUE) +m +coef(m) +fitted(m) +residual(m) + +# Bandwidth Optimization +gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, 0.05, TRUE) + +# Lambda Optimization +gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, 64, NA, TRUE) + +# Bandwidth and Lambda optimization +gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, NA, TRUE) + +} diff --git a/man/gwr_basic.Rd b/man/gwr_basic.Rd index 0faf0de..20124ce 100644 --- a/man/gwr_basic.Rd +++ b/man/gwr_basic.Rd @@ -107,6 +107,18 @@ A \code{gwrm} 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{step(gwrm)}: Model selection for basic GWR model @@ -145,3 +157,6 @@ residuals(m) predict(m, LondonHP) } +\seealso{ +\code{browseVignettes("")} +} From cd6a08a2ec47251ab9bb066564bddb51c872fb45 Mon Sep 17 00:00:00 2001 From: HPDell Date: Wed, 17 Apr 2024 11:11:03 +0100 Subject: [PATCH 07/11] fix: error in examples --- R/gtwr.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/gtwr.R b/R/gtwr.R index c34d325..f35f469 100644 --- a/R/gtwr.R +++ b/R/gtwr.R @@ -45,9 +45,9 @@ #' # Basic usage #' m <- gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, "time", 64, 0.05, TRUE) #' m -#' coef(m) -#' fitted(m) -#' residual(m) +#' head(coef(m)) +#' head(fitted(m)) +#' head(residuals(m)) #' #' # Bandwidth Optimization #' gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, 0.05, TRUE) From 2ebb06b5ac2035b9d5efb4ca811c99cc4dd84b92 Mon Sep 17 00:00:00 2001 From: HPDell Date: Wed, 17 Apr 2024 12:08:01 +0100 Subject: [PATCH 08/11] fix: print error --- R/gtwr.R | 4 ++-- man/gtwr.Rd | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/gtwr.R b/R/gtwr.R index f35f469..b992f94 100644 --- a/R/gtwr.R +++ b/R/gtwr.R @@ -235,8 +235,8 @@ print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { } ### Basic Information - cat("Geographically Weighted Regression Model", fill = T) - cat("========================================", fill = T) + cat("Geographically and Temporally Weighted Regression Model", 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) diff --git a/man/gtwr.Rd b/man/gtwr.Rd index 4e4a14f..0a51c08 100644 --- a/man/gtwr.Rd +++ b/man/gtwr.Rd @@ -92,9 +92,9 @@ LondonHP$time <- as.integer(round(runif(nrow(LondonHP), 1, 365))) # Basic usage m <- gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, "time", 64, 0.05, TRUE) m -coef(m) -fitted(m) -residual(m) +head(coef(m)) +head(fitted(m)) +head(residuals(m)) # Bandwidth Optimization gtwr(PURCHASE~FLOORSZ+UNEMPLOY, LondonHP, LondonHP$time, NA, 0.05, TRUE) From 07806d43b7ce27c46cb5eb32cd4bf0b84e9ab8ba Mon Sep 17 00:00:00 2001 From: HPDell Date: Wed, 17 Apr 2024 12:29:27 +0100 Subject: [PATCH 09/11] fix: the print document --- R/gtwr.R | 10 +++++----- R/gwdr.R | 4 ++-- R/gwr_basic.R | 4 ++-- R/gwr_multiscale.R | 4 ++-- _pkgdown.yml | 3 ++- man/print.Rd | 20 ++++++++++---------- 6 files changed, 23 insertions(+), 22 deletions(-) diff --git a/R/gtwr.R b/R/gtwr.R index b992f94..7b5d10b 100644 --- a/R/gtwr.R +++ b/R/gtwr.R @@ -219,15 +219,15 @@ gtwr <- function( gtwrm } -#' Print description of a `gtwrm` object +#' @describeIn print.gwrm #' -#' @param x An `hgtwrm` object returned by [gtwr()]. +#' @param x Object returned by GW modelling methods. #' @param decimal_fmt The format string passing to [base::sprintf()]. #' @inheritDotParams print_table_md #' #' @method print gtwrm #' @importFrom stats coef fivenum -#' @noRd +#' @rdname print #' @export print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { if (!inherits(x, "gtwrm")) { @@ -274,7 +274,7 @@ print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { cat("\n", fill = T) } -#' @describeIn [Not implemented] gtwr Predict on new locations. +#' @describeIn gtwr [Not implemented] Predict on new locations. #' #' @param object A "gtwrm" object. #' @param regression_points Data of new locations. @@ -282,7 +282,7 @@ print.gtwrm <- function(x, decimal_fmt = "%.3f", ...) { #' @param verbose Whether to print additional message. #' #' @method predict gtwrm -#' +#' @noRd #' @export predict.gtwrm <- function(object, regression_points, verbose = FALSE, ...) { if (!inherits(object, "gtwrm")) { diff --git a/R/gwdr.R b/R/gwdr.R index bce8e7d..fc8ad6c 100644 --- a/R/gwdr.R +++ b/R/gwdr.R @@ -390,9 +390,9 @@ residuals.gwdrm <- function(object, ...) { object$SDF[["residual"]] } -#' Print description of a `gwdrm` object +#' @describeIn print.gwrm #' -#' @param x An `gwdrm` object returned by [gwdr()]. +#' @param x Object returned by GW modelling methods. #' @param decimal_fmt The format string passing to [base::sprintf()]. #' @inheritDotParams print_table_md #' diff --git a/R/gwr_basic.R b/R/gwr_basic.R index b5a48c2..53f1864 100644 --- a/R/gwr_basic.R +++ b/R/gwr_basic.R @@ -311,9 +311,9 @@ step.gwrm <- function( object } -#' Print description of a `gwrm` object +#' Print description of a GW model object #' -#' @param x An `hgwrm` object returned by [gwr_basic()]. +#' @param x Object returned by GW modelling methods. #' @param decimal_fmt The format string passing to [base::sprintf()]. #' @inheritDotParams print_table_md #' diff --git a/R/gwr_multiscale.R b/R/gwr_multiscale.R index 9b6b5e5..77e8b66 100644 --- a/R/gwr_multiscale.R +++ b/R/gwr_multiscale.R @@ -268,9 +268,9 @@ gwr_multiscale <- function( gwrmultiscalem } -#' Print description of a `gwrmultiscalem` object +#' @describeIn print.gwrm #' -#' @param x An `gwrmultiscalem` object returned by [gwr_multiscale()]. +#' @param x Object returned by GW modelling methods. #' @param decimal_fmt The format string passing to [base::sprintf()]. #' @inheritDotParams print_table_md #' diff --git a/_pkgdown.yml b/_pkgdown.yml index 35c6695..f136b39 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -24,9 +24,10 @@ reference: - contents: - GWmodel3-package - title: GW regression models - - subtitle: Basic GWR + - subtitle: Basic GWR and Extensions - contents: - starts_with("gwr_basic") + - starts_with("gtwr") - subtitle: Multiscale GWR - contents: - starts_with("gwr_multiscale") diff --git a/man/print.Rd b/man/print.Rd index 5ebdefa..29af525 100644 --- a/man/print.Rd +++ b/man/print.Rd @@ -1,11 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/gwdr.R, R/gwr_basic.R, R/gwr_multiscale.R -\name{print.gwdrm} +% Please edit documentation in R/gtwr.R, R/gwdr.R, R/gwr_basic.R, +% R/gwr_multiscale.R +\name{print.gtwrm} +\alias{print.gtwrm} \alias{print.gwdrm} \alias{print.gwrm} \alias{print.gwrmultiscalem} -\title{Print description of a \code{gwdrm} object} +\title{Print description of a GW model object} \usage{ +\method{print}{gtwrm}(x, decimal_fmt = "\%.3f", ...) + \method{print}{gwdrm}(x, decimal_fmt = "\%.3f", ...) \method{print}{gwrm}(x, decimal_fmt = "\%.3f", ...) @@ -13,12 +17,12 @@ \method{print}{gwrmultiscalem}(x, decimal_fmt = "\%.3f", ...) } \arguments{ -\item{x}{An \code{gwrmultiscalem} object returned by \code{\link[=gwr_multiscale]{gwr_multiscale()}}.} +\item{x}{Object returned by GW modelling methods.} \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{"-"}.} @@ -31,9 +35,5 @@ Possible values are \code{"plain"}, \code{"md"} or \code{"latex"}. Default to \c }} } \description{ -Print description of a \code{gwdrm} object - -Print description of a \code{gwrm} object - -Print description of a \code{gwrmultiscalem} object +Print description of a GW model object } From 0ae2c1659f282a58b2680e1a734ad69ba51c8ba3 Mon Sep 17 00:00:00 2001 From: OuGuangyu Date: Fri, 30 May 2025 10:33:38 +0800 Subject: [PATCH 10/11] edit: update libgwmodel to v0.12.0 --- src/libgwmodel | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/libgwmodel b/src/libgwmodel index 4e604ea..3f9e288 160000 --- a/src/libgwmodel +++ b/src/libgwmodel @@ -1 +1 @@ -Subproject commit 4e604eab1c4bd7933cdb9bf523c935cafa362526 +Subproject commit 3f9e288da00ad736db0fe4d726e5a975c8ed5cfe From b7da53d4ce076fc176acb6315ce87b2f85b7cbb0 Mon Sep 17 00:00:00 2001 From: OuGuangyu Date: Fri, 30 May 2025 11:08:31 +0800 Subject: [PATCH 11/11] fix: rcpp armadillo --- NAMESPACE | 4 ++-- man/print.Rd | 10 ++++++---- src/gtwr.cpp | 36 ++++++++++++++++-------------------- 3 files changed, 24 insertions(+), 26 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 9a4956e..0f21cf3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -12,8 +12,8 @@ S3method(plot,gwrmultiscalem) S3method(plot,modelselcritl) S3method(predict,gtwrm) S3method(predict,gwrm) -S3method(print,gtwrm) S3method(print,gtdrm) +S3method(print,gtwrm) S3method(print,gwrm) S3method(print,gwrmultiscalem) S3method(residuals,gtdrm) @@ -22,9 +22,9 @@ S3method(residuals,gwrmultiscalem) S3method(step,default) S3method(step,gtdrm) S3method(step,gwrm) -export(gtwr) export(gtdr) export(gtdr_config) +export(gtwr) export(gwr_basic) export(gwr_multiscale) export(mgwr_config) diff --git a/man/print.Rd b/man/print.Rd index 40911cf..a6233f8 100644 --- a/man/print.Rd +++ b/man/print.Rd @@ -1,13 +1,17 @@ % 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/gtwr.R, R/gwr_basic.R, +% R/gwr_multiscale.R \name{print.gtdrm} \alias{print.gtdrm} +\alias{print.gtwrm} \alias{print.gwrm} \alias{print.gwrmultiscalem} \title{Print description of a \code{gtdrm} object} \usage{ \method{print}{gtdrm}(x, decimal_fmt = "\%.3f", ...) +\method{print}{gtwrm}(x, decimal_fmt = "\%.3f", ...) + \method{print}{gwrm}(x, decimal_fmt = "\%.3f", ...) \method{print}{gwrmultiscalem}(x, decimal_fmt = "\%.3f", ...) @@ -33,7 +37,5 @@ Possible values are \code{"plain"}, \code{"md"} or \code{"latex"}. Default to \c \description{ Print description of a \code{gtdrm} object -Print description of a \code{gwrm} object - -Print description of a \code{gwrmultiscalem} object +Print description of a GW model object } diff --git a/src/gtwr.cpp b/src/gtwr.cpp index 1ce606a..a60b087 100644 --- a/src/gtwr.cpp +++ b/src/gtwr.cpp @@ -1,5 +1,5 @@ -#include -#include +// [[Rcpp::depends(RcppArmadillo)]] +#include #include "utils.h" #include "gwmodelpp/GTWR.h" @@ -10,10 +10,10 @@ using namespace gwm; // [[Rcpp::export]] List gtwr_fit( - const NumericMatrix& x, - const NumericVector& y, - const NumericMatrix& coords, - const NumericVector& times, + const arma::mat& x, + const arma::vec& y, + const arma::mat& coords, + const arma::vec& times, double bw, bool adaptive, int kernel, @@ -31,10 +31,6 @@ List gtwr_fit( int verbose ) { // Convert data types - arma::mat mx = myas(x); - arma::vec my = myas(y); - arma::mat mcoords = myas(coords); - arma::mat mtimes = myas(times); std::vector vpar_args = as< std::vector >(Rcpp::IntegerVector(parallel_arg)); // Make Spatial Weight @@ -61,9 +57,9 @@ List gtwr_fit( // Make Algorithm Object GTWR algorithm; - algorithm.setDependentVariable(my); - algorithm.setIndependentVariables(mx); - algorithm.setCoords(mcoords, mtimes); + algorithm.setDependentVariable(y); + algorithm.setIndependentVariables(x); + algorithm.setCoords(coords, times); algorithm.setSpatialWeight(spatial); algorithm.setHasHatMatrix(hatmatrix); algorithm.setHasIntercept(intercept); @@ -105,14 +101,14 @@ List gtwr_fit( // Return Results mat betas = algorithm.betas(); - vec fitted = sum(mx % betas, 1); + vec fitted = sum(x % betas, 1); List result_list = List::create( - Named("betas") = mywrap(betas), - Named("betasSE") = mywrap(algorithm.betasSE()), - Named("sTrace") = mywrap(algorithm.sHat()), - Named("sHat") = mywrap(algorithm.s()), - Named("diagnostic") = mywrap(algorithm.diagnostic()), - Named("fitted") = mywrap(fitted) + Named("betas") = betas, + Named("betasSE") = algorithm.betasSE(), + Named("sTrace") = algorithm.sHat(), + Named("sHat") = algorithm.s(), + Named("fitted") = fitted, + Named("diagnostic") = mywrap(algorithm.diagnostic()) ); const SpatialWeight& spatialWeights = algorithm.spatialWeight(); if (optim_bw)