...))
}
-### xtableMatharray object
-### To deal with numeric arrays such as a variance-covariance matrix
-### From a request by James Curran, 16 October 2015
-xtable.xtableMatharray <- function(x, caption = NULL, label = NULL,
- align = NULL, digits = NULL,
- display = NULL, auto = FALSE,
- ...) {
- class(x) <- c("xtableMatharray","matrix")
- xtbl <- xtable.matrix(x,
- caption = caption, label = label, align = align,
- digits = digits, display = display, auto = auto,
- ...)
- class(xtbl) <- c("xtableMatharray","xtable","data.frame")
- return(xtbl)
-}
+
### table objects (of 1 or 2 dimensions) by Guido Gay, 9 Feb 2007
### Fixed to pass R checks by DBD, 9 May 2007
return(xtable(as.ts(x), ...))
}
-### Function to create lists of tables
-xtable.xtableList <- function(x, caption = NULL, label = NULL, align = NULL,
- digits = NULL, display = NULL, ...) {
- if (is.null(digits)){
- digitsList <- vector("list", length(x))
- } else {
- if (!is.list(digits)){
- digitsList <- vector("list", length(x))
- for (i in 1:length(x)) digitsList[[i]] <- digits
- }
- }
- if (is.null(display)){
- displayList <- vector("list", length(x))
- } else {
- if (!is.list(display)){
- displayList <- vector("list", length(x))
- for (i in 1:length(x)) displayList[[i]] <- display
- }
- }
- xList <- vector("list", length(x))
- for (i in 1:length(x)){
- xList[[i]] <- xtable(x[[i]], caption = caption, label = label,
- align = align, digits = digitsList[[i]],
- display = displayList[[i]], ...)
- attr(xList[[i]], 'subheading') <- attr(x, 'subheadings')[[i]]
- }
- attr(xList, "message") <- attr(x, "message")
- attr(xList, "caption") <- caption
- attr(xList, "label") <- label
- return(xList)
-}
-
-### Uses xtable.xtableList
-xtable.lsmeans <- function(x, caption = NULL, label = NULL,
- align = NULL, digits = NULL,
- display = NULL, auto = FALSE,
- ...){
- if (attr(x, "estName") == "lsmean"){
- xList <- split(x, f = x[, 2])
- for (i in 1:length(xList)){
- xList[[i]] <- as.data.frame(xList[[i]][, -2])
- }
- attr(xList, "subheadings") <-
- paste0(dimnames(x)[[2]][2], " = ", levels(x[[2]]))
- attr(xList, "message") <- c("", attr(x, "mesg"))
- xList <- xtable.xtableList(xList, caption =caption, label = label,
- align = align, digits = digits,
- display = display, auto = auto, ...)
- } else {
- xList <- x
- xList <- xtable.data.frame(xList, caption =caption, label = label,
- align = align, digits = digits,
- display = display, auto = auto, ...)
+### Date: Fri, 29 May 2015 11:41:04 +0200
+### From: Martin G. <martin.gubri@framasoft.org>
+### Subject: [xtable] Code for spdep, splm and sphet objects outputs
+### package spdep
+### sarlm objects
+xtable.sarlm <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL, auto = FALSE, ...) {
+ return(xtable.summary.sarlm(summary(x), caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto))
+}
+
+xtable.summary.sarlm <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL, auto = FALSE,
+ ...) {
+ x <- data.frame(x$Coef, check.names = FALSE)
+
+ class(x) <- c("xtable","data.frame")
+ caption(x) <- caption
+ label(x) <- label
+ if(auto && is.null(align)) align <- xalign(x)
+ if(auto && is.null(digits)) digits <- xdigits(x)
+ if(auto && is.null(display)) display <- xdisplay(x)
+ align(x) <- switch(1+is.null(align), align, c("r","r","r","r","r"))
+ digits(x) <- switch(1+is.null(digits), digits, c(0,4,4,2,4))
+ display(x) <- switch(1+is.null(display), display, c("s","f","f","f","f"))
+ return(x)
+}
+
+### spautolm objects: added by David Scott, 6/1/2016, after suggestion by
+### Guido Schulz
+### Date: Wed, 29 Apr 2015 10:45:16 +0200
+### Guido Schulz <schulzgu@student.hu-berlin.de>
+xtable.spautolm <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL, auto = FALSE, ...) {
+ return(xtable.summary.sarlm(summary(x), caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto))
+}
+
+xtable.summary.spautolm <- function(x, caption = NULL, label = NULL,
+ align = NULL, digits = NULL,
+ display = NULL, auto = FALSE, ...) {
+ return(xtable.summary.sarlm(summary(x), caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto))
+}
+
+
+### gmsar objects
+xtable.gmsar <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL, auto = FALSE, ...) {
+ return(xtable.summary.sarlm(summary(x), caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto, ...))
+}
+
+xtable.summary.gmsar <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL,
+ auto = FALSE, ...) {
+ return(xtable.summary.sarlm(x, caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto))
+}
+
+### stsls objects
+xtable.stsls <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL, auto = FALSE, ...) {
+ return(xtable.summary.sarlm(summary(x), caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto, ...))
+}
+
+xtable.summary.stsls <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL,
+ auto = FALSE, ...) {
+ return(xtable.summary.sarlm(x, caption = caption, label = label,
+ align = align, digits = digits,
+ 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))
+}
+
+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)
}
- return(xList)
+ x <- data.frame(x$CoefTable, check.names = FALSE)
+
+ class(x) <- c("xtable","data.frame")
+ caption(x) <- caption
+ label(x) <- label
+ if(auto && is.null(align)) align <- xalign(x)
+ if(auto && is.null(digits)) digits <- xdigits(x)
+ if(auto && is.null(display)) display <- xdisplay(x)
+ align(x) <- switch(1+is.null(align), align, c("r","r","r","r","r"))
+ digits(x) <- switch(1+is.null(digits), digits, c(0,4,4,2,4))
+ display(x) <- switch(1+is.null(display), display, c("s","f","f","f","f"))
+ return(x)
+}
+
+### package sphet
+### sphet objects
+xtable.sphet <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL, auto = FALSE, ...) {
+ return(xtable.summary.splm(summary(x), caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto))
+}
+
+xtable.summary.sphet <- function(x, caption = NULL, label = NULL, align = NULL,
+ digits = NULL, display = NULL,
+ auto = FALSE, ...) {
+ return(xtable.summary.splm(x, caption = caption, label = label,
+ align = align, digits = digits,
+ display = display, auto = auto))
}
projects / xtable.git / blobdiff