Spatialreg

DESCRIPTION

@@ -465,6 +465,7 @@ Collate:
     'robustbase-glmrob-tidiers.R'
     'robustbase-lmrob-tidiers.R'
     'sp-tidiers.R'
+    'spdep-tidiers.R'
     'speedglm-speedglm-tidiers.R'
     'speedglm-speedlm-tidiers.R'
     'stats-anova-tidiers.R'

NAMESPACE

@@ -34,6 +34,7 @@ S3method(augment,rlm)
 S3method(augment,rma)
 S3method(augment,rq)
 S3method(augment,rqs)
+S3method(augment,sarlm)
 S3method(augment,smooth.spline)
 S3method(augment,speedglm)
 S3method(augment,speedlm)
@@ -96,6 +97,7 @@ S3method(glance,rlm)
 S3method(glance,rma)
 S3method(glance,rq)
 S3method(glance,rqs)
+S3method(glance,sarlm)
 S3method(glance,smooth.spline)
 S3method(glance,speedglm)
 S3method(glance,speedlm)
@@ -204,6 +206,7 @@ S3method(tidy,rma)
 S3method(tidy,roc)
 S3method(tidy,rq)
 S3method(tidy,rqs)
+S3method(tidy,sarlm)
 S3method(tidy,spec)
 S3method(tidy,speedglm)
 S3method(tidy,speedlm)

R/spdep-tidiers.R

@@ -0,0 +1,126 @@
+#' Tidying methods for spatially autoregressive models
+#'
+#' These methods tidy the coefficients of spatial autoregression
+#' models generated by functions of the `spatialreg` package.
+#'
+#' @param x An object of object returned from [spatialreg::lagsarlm()] or [spatialreg::errorsarlm()].
+#' @template param_confint
+#' @template param_unused_dots
+#' 
+#' @examples 
+#' library(spatialreg)
+#' data(oldcol, package="spdep")
+#' listw <- spdep::nb2listw(COL.nb, style="W")
+#' 
+#' crime_sar <- lagsarlm(CRIME ~ INC + HOVAL, data=COL.OLD,  
+#'   listw=listw, method="eigen")
+#'   
+#' tidy(crime_sar)
+#' tidy(crime_sar, conf.int = TRUE)
+#' glance(crime_sar)
+#' augment(crime_sar)
+#' 
+#' crime_sem <- errorsarlm(CRIME ~ INC + HOVAL, data=COL.OLD, listw)
+#' 
+#' tidy(crime_sem)
+#' tidy(crime_sem, conf.int = TRUE)
+#' glance(crime_sem)
+#' augment(crime_sem)
+#'
+#' 
+#' @aliases spatialreg_tidiers
+#' @export
+#' @family spatialreg tidiers
+#' @seealso [tidy()], [spatialreg::lagsarlm()], [spatialreg::errorsarlm()]
+tidy.sarlm <- function(x, conf.int = FALSE, conf.level = .95, ...) {
+  # construct parameter table
+  s <- summary(x)
+  ret <- as_tibble(s$Coef, rownames = 'term')
+  colnames(ret) <- c("term", "estimate", "std.error", "statistic", "p.value")
+
+  # append spatial autoregression coefficient to parameter table
+  if (!is.null(s$rho) == T) {
+    # if SAR model, get rho and append to table
+    ret2 <- tibble(
+        term = "rho",
+        estimate = as.numeric(s$rho),
+        std.error = as.numeric(s$rho.se),
+        statistic = as.numeric(estimate / std.error),
+        p.value = as.numeric(2 * (1 - pnorm( abs(statistic) ) ) )
+      )
+    ret = rbind(ret, ret2)
+  } else if (!is.null(s$lambda))  {
+    # if SEM model, get lambda and append to table
+    ret2 <- tibble(
+      term = "lambda",
+      estimate = as.numeric(s$lambda),
+      std.error = as.numeric(s$lambda.se),
+      statistic = as.numeric(estimate / std.error),
+      p.value = as.numeric(2 * (1 - pnorm( abs(statistic) ) ) )
+    )
+    colnames(ret2) <- c("term", "estimate", "std.error", "statistic", "p.value")
+    ret = rbind(ret, ret2)
+  }
+
+
+  # Calculate confidence interval
+  if (conf.int) {
+    ci <- confint(x, level = conf.level)
+    ci <- as_tibble(ci, rownames = "term")
+    colnames(ci) <- c("term", "conf.low", "conf.high")
+    ret <- dplyr::left_join(ret, ci, by = "term")
+  }
+
+  ret
+}
+
+#' @templateVar class spatialreg
+#' @template title_desc_augment
+#'
+#' @template augment_NAs
+#'
+#' @inherit tidy.sarlm params examples
+#'
+#' @export
+#' @seealso [augment()],[mlogit::miscmethods.mlogit()]
+#' @family spatialreg tidiers
+augment.sarlm <- function(x) {
+
+  reg <- as_tibble(x$X) %>%
+    select(-1) %>%
+    dplyr::mutate(
+      y = x$y,
+      .fitted = x$fitted.values, 
+      .resid = x$residuals
+    )
+
+  #TODO: Extend for spatial lags of variables
+
+  reg
+
+}
+
+
+#' @templateVar class spatialreg
+#' @template title_desc_glance
+#' 
+#' @inherit tidy.sarlm params examples
+#' 
+#' @evalRd return_glance("logLik", "AIC", "BIC", "deviance", "logLik", "nobs")
+#' @export
+#' @family spatialreg tidiers
+#' @seealso [glance()], [spatialreg::lagsarlm()], [spatialreg::errorsarlm()]
+glance.sarlm <- function(x) {
+
+  res <- tibble(
+      # Using Pseudo R squared.
+      r.squared = cor(x$fitted.values, x$y)^2,
+      AIC = stats::AIC(x),
+      BIC = stats::BIC(x),
+      deviance = stats::deviance(x),
+      logLik = as.numeric(x$LL),
+      nobs = length(x$fitted.values)
+    )
+
+  res
+}