From 1a34c35c49810e765662371866ef2ac5654f6be6 Mon Sep 17 00:00:00 2001 From: dscott Date: Mon, 11 Jan 2016 05:06:34 +0000 Subject: [PATCH] Added extra methods for spatial econometrics provided by Martin Gubri git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@88 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- pkg/NAMESPACE | 2 + pkg/R/xtable.R | 17 ++++++ pkg/man/xtable.Rd | 2 + pkg/vignettes/OtherPackagesGallery.Rnw | 71 +++++++++++++++++++++++--- 4 files changed, 85 insertions(+), 7 deletions(-) diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE index 810fa7f..3e815f6 100644 --- a/pkg/NAMESPACE +++ b/pkg/NAMESPACE @@ -50,6 +50,8 @@ S3method("xtable", "gmsar") S3method("xtable", "summary.gmsar") S3method("xtable", "stsls") S3method("xtable", "summary.stsls") +S3method("xtable", "sarlm.pred") +S3method("xtable", "lagImpact") S3method("xtable", "splm") S3method("xtable", "summary.splm") S3method("xtable", "sphet") diff --git a/pkg/R/xtable.R b/pkg/R/xtable.R index 647276d..36146d9 100644 --- a/pkg/R/xtable.R +++ b/pkg/R/xtable.R @@ -386,11 +386,24 @@ xtable.summary.stsls <- function(x, caption = NULL, label = NULL, align = NULL, display = display, auto = auto)) } +### pred.sarlm objects +xtable.sarlm.pred <- function(x, ...) { + return(xtable(as.data.frame(x), ...)) +} + +### lagImpact objects +xtable.lagImpact <- function(x, ...) { + xtable(spdep:::lagImpactMat(x), ...) +} ### package splm ### splm objects xtable.splm <- function(x, caption = NULL, label = NULL, align = NULL, digits = NULL, display = NULL, auto = FALSE, ...) { + if (!requireNamespace("splm", quietly = TRUE)) { + stop("Package splm is needed for this function to work.", + call. = FALSE) + } return(xtable.summary.splm(summary(x), caption = caption, label = label, align = align, digits = digits, display = display, auto = auto)) @@ -399,6 +412,10 @@ xtable.splm <- function(x, caption = NULL, label = NULL, align = NULL, xtable.summary.splm <- function(x, caption = NULL, label = NULL, align = NULL, digits = NULL, display = NULL, auto = FALSE, ...) { + if (!requireNamespace("splm", quietly = TRUE)) { + stop("Package splm is needed for this function to work.", + call. = FALSE) + } x <- data.frame(x$CoefTable, check.names = FALSE) class(x) <- c("xtable","data.frame") diff --git a/pkg/man/xtable.Rd b/pkg/man/xtable.Rd index 9b41fb9..9beb1a6 100644 --- a/pkg/man/xtable.Rd +++ b/pkg/man/xtable.Rd @@ -24,6 +24,8 @@ \alias{xtable.summary.gmsar} \alias{xtable.stsls} \alias{xtable.summary.stsls} +\alias{xtable.sarlm.pred} +\alias{xtable.lagImpact} \alias{xtable.splm} \alias{xtable.summary.splm} \alias{xtable.sphet} diff --git a/pkg/vignettes/OtherPackagesGallery.Rnw b/pkg/vignettes/OtherPackagesGallery.Rnw index 43fbebb..30d0e08 100644 --- a/pkg/vignettes/OtherPackagesGallery.Rnw +++ b/pkg/vignettes/OtherPackagesGallery.Rnw @@ -32,7 +32,7 @@ \section{Introduction} This document represents a test of the functions in \pkg{xtable} which -deal with other packages +deal with other packages. <>= library(knitr) @@ -61,7 +61,7 @@ First load the package and create some objects. <>= library(spdep) data(oldcol) -COL.lag.eig <- lagsarlm(CRIME ~ INC + HOVAL, data = COL.OLD, +COL.lag.eig <- lagsarlm(CRIME ~ INC + HOVAL, data = COL.OLD[], nb2listw(COL.nb)) class(COL.lag.eig) COL.errW.GM <- GMerrorsar(CRIME ~ INC + HOVAL, data = COL.OLD, @@ -71,6 +71,19 @@ class(COL.errW.GM) COL.lag.stsls <- stsls(CRIME ~ INC + HOVAL, data = COL.OLD, nb2listw(COL.nb)) class(COL.lag.stsls) + +p1 <- predict(COL.lag.eig, newdata = COL.OLD[45:49,], + listw = nb2listw(COL.nb)) +class(p1) +p2 <- predict(COL.lag.eig, newdata = COL.OLD[45:49,], + pred.type = "trend", type = "trend") +#type option for retrocompatibility with spdep 0.5-92 +class(p2) + +imp.exact <- impacts(COL.lag.eig, listw = nb2listw(COL.nb)) +class(imp.exact) +imp.sim <- impacts(COL.lag.eig, listw = nb2listw(COL.nb), R = 200) +class(imp.sim) @ %def @@ -116,6 +129,34 @@ xtable(COL.errW.GM) xtable(COL.lag.stsls) @ %def +\subsubsection{\code{sarlm.pred} objects} +\label{sec:codesarlmpred-objects} + +\code{xtable} has a method for predictions of \code{sarlm} models. + +<>= +xtable(p1) +@ %def + +This method transforms the \code{sarlm.pred} objects into data frames, allowing any number of attributes vectors which may vary according to predictor types. + +<>= +xtable(p2) +@ %def + +\subsubsection{\code{lagImpact} objects} +\label{sec:codelagimpact-objects} + +The \code{xtable} method returns the values of direct, indirect and total impacts for all the variables in the model. The class \code{lagImpact} have two different sets of attributes according to if simulations are used. But the \code{xtable} method always returns the three components of the non-simulation case. + +<>= +xtable(imp.exact) +@ %def + +\p +<>= +xtable(imp.sim) +@ %def \subsubsection{\code{spautolm} objects} @@ -126,7 +167,7 @@ by Guido Schulz (\url{schulzgu@student.hu-berlin.de}), who also provided an example of an object of this type. The required code was implemented by David Scott (\url{d.scott@auckland.ac.nz}). -First create an object of the required type +First create an object of the required type. <>= library(spdep) @@ -159,12 +200,15 @@ library(splm) data(Produc, package = "plm") data(usaww) fm <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp -fespaterr <- spml(fm, data = Produc, listw = mat2listw(usaww), - model = "within", spatial.error = "b", Hess = FALSE) -class(fespaterr) +respatlag <- spml(fm, data = Produc, listw = mat2listw(usaww), + model="random", spatial.error="none", lag=TRUE) +class(respatlag) GM <- spgm(log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp, data = Produc, listw = usaww, moments = "fullweights", spatial.error = TRUE) class(GM) + +imp.spml <- impacts(respatlag, listw = mat2listw(usaww, style = "W"), time = 17) +class(imp.spml) @ %def @@ -172,7 +216,7 @@ class(GM) \label{sec:codesplm-objects} <>= -xtable(fespaterr) +xtable(respatlag) @ %def @@ -181,6 +225,11 @@ xtable(fespaterr) xtable(GM) @ %def +The \code{xtable} method works the same on impacts of \code{splm} models. + +<>= +xtable(imp.spml) +@ %def \subsection{The package \pkg{sphet}} \label{sec:package-pkgsphet} @@ -197,6 +246,9 @@ class(res.stsls) res.gstsls <- gstslshet(CRIME ~ HOVAL + INC, data = columbus, listw = listw) class(res.gstsls) + +imp.gstsls <- impacts(res.gstsls, listw = listw) +class(imp.gstsls) @ %def @@ -212,5 +264,10 @@ xtable(res.stsls) xtable(res.gstsls) @ %def +\code{sphet} also provides a method for computing impacts. + +<>= +xtable(imp.gstsls) +@ %def \end{document} -- 2.39.5