]> git.donarmstrong.com Git - xtable.git/blobdiff - pkg/R/xtable.R
Some minor changes only to methods
[xtable.git] / pkg / R / xtable.R
index 76a4be963ee125dd138f5dd1a8ea69447ec15c7d..39d5b190890011c48d0a80bda57e4e7692e5d685 100644 (file)
@@ -67,21 +67,7 @@ xtable.matrix <- function(x, caption = NULL, label = NULL, align = NULL,
                            ...))
 }
 
-### 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
@@ -105,7 +91,6 @@ xtable.table <- function(x, caption = NULL, label = NULL, align = NULL,
 
 
 ### anova objects
-
 xtable.anova <- function(x, caption = NULL, label = NULL, align = NULL,
                          digits = NULL, display = NULL, auto = FALSE, ...) {
   suggested.digits <- c(0,rep(2, ncol(x)))
@@ -127,7 +112,6 @@ xtable.anova <- function(x, caption = NULL, label = NULL, align = NULL,
 
 
 ### aov objects
-
 xtable.aov <- function(x, caption = NULL, label = NULL, align = NULL,
                        digits = NULL, display = NULL, auto = FALSE, ...) {
   return(xtable.anova(anova(x, ...), caption = caption, label = label,
@@ -172,7 +156,6 @@ xtable.aovlist <- function(x, caption = NULL, label = NULL, align = NULL,
 
 
 ### lm objects
-
 xtable.lm <- function(x, caption = NULL, label = NULL, align = NULL,
                       digits = NULL, display = NULL, auto = FALSE, ...) {
   return(xtable.summary.lm(summary(x), caption = caption, label = label,
@@ -199,7 +182,6 @@ xtable.summary.lm <- function(x, caption = NULL, label = NULL, align = NULL,
 
 
 ### glm objects
-
 xtable.glm <- function(x, caption = NULL, label = NULL, align = NULL,
                        digits = NULL, display = NULL, auto = FALSE, ...) {
   return(xtable.summary.glm(summary(x), caption = caption,
@@ -216,7 +198,6 @@ xtable.summary.glm <- function(x, caption = NULL, label = NULL, align = NULL,
 
 
 ### prcomp objects
-
 xtable.prcomp <- function(x, caption = NULL, label = NULL, align = NULL,
                           digits = NULL, display = NULL, auto = FALSE, ...) {
   x <- data.frame(x$rotation, check.names = FALSE)
@@ -251,10 +232,10 @@ xtable.summary.prcomp <- function(x, caption = NULL, label = NULL, align = NULL,
 }
 
 
-# Slightly modified version of xtable.coxph contributed on r-help by
-#   Date: Wed, 2 Oct 2002 17:47:56 -0500 (CDT)
-#   From: Jun Yan <jyan@stat.wisc.edu>
-#   Subject: Re: [R] xtable for Cox model output
+### Slightly modified version of xtable.coxph contributed on r-help by
+###   Date: Wed, 2 Oct 2002 17:47:56 -0500 (CDT)
+###   From: Jun Yan <jyan@stat.wisc.edu>
+###   Subject: Re: [R] xtable for Cox model output
 xtable.coxph <- function (x, caption = NULL, label = NULL, align = NULL,
                           digits = NULL, display = NULL, auto = FALSE, ...)
 {
@@ -275,13 +256,13 @@ xtable.coxph <- function (x, caption = NULL, label = NULL, align = NULL,
                 digits = digits, display = display, auto = auto))
 }
 
-# Additional method: xtable.ts
-# Contributed by David Mitchell (davidm@netspeed.com.au)
-# Date: July 2003
+### Additional method: xtable.ts
+### Contributed by David Mitchell (davidm@netspeed.com.au)
+### Date: July 2003
 xtable.ts <- function(x, caption = NULL, label = NULL, align = NULL,
                       digits = NULL, display = NULL, auto = FALSE, ...) {
   if (inherits(x, "ts") && !is.null(ncol(x))) {
-    # COLNAMES <- paste(colnames(x));
+    ## COLNAMES <- paste(colnames(x));
     tp.1 <- trunc(time(x))
     tp.2 <- trunc(cycle(x))
     day.abb <- c("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat")
@@ -314,8 +295,141 @@ xtable.ts <- function(x, caption = NULL, label = NULL, align = NULL,
                 digits = digits, display = display, auto = auto))
 }
 
-# Suggested by Ajay Narottam Shah <ajayshah@mayin.org> in e-mail 2006/07/22
+### Suggested by Ajay Narottam Shah <ajayshah@mayin.org> in e-mail 2006/07/22
 xtable.zoo <- function(x, ...) {
   return(xtable(as.ts(x), ...))
 }
 
+### 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, ...) {
+  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,
+                                ...) {
+  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))
+}