]> git.donarmstrong.com Git - xtable.git/commitdiff
git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@104 edb9625f-4e0d-4859...
authordscott <dscott@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Thu, 28 Jan 2016 12:49:06 +0000 (12:49 +0000)
committerdscott <dscott@edb9625f-4e0d-4859-8d74-9fd3b1da38cb>
Thu, 28 Jan 2016 12:49:06 +0000 (12:49 +0000)
pkg/NAMESPACE
pkg/R/format.ftable.R [new file with mode: 0644]
pkg/R/xtable.R
pkg/R/xtableFtable.R
pkg/man/format.ftable.Rd [new file with mode: 0644]
pkg/man/xtable.Rd
pkg/vignettes/OtherPackagesGallery.Rnw

index f5c4c6987a5c21ca17ba87af5d236e8d57813866..9daba6af9ee7062a489217c551de2e593b46ff77 100644 (file)
@@ -10,7 +10,8 @@ export("caption<-", "caption", "label", "label<-",
        "xtableFtable", "print.xtableFtable",
        "toLatex.xtable",
        "autoformat", "xalign", "xdigits", "xdisplay",
-       "sanitize", "sanitize.numbers", "sanitize.final", "as.is", "as.math")
+       "sanitize", "sanitize.numbers", "sanitize.final", "as.is", "as.math",
+       "format.ftable")
 
 S3method("print", "xtable")
 S3method("print", "xtableMatharray")
@@ -29,6 +30,8 @@ S3method("digits<-", "xtable")
 S3method("display<-", "xtable")
 S3method("display", "xtable")
 
+S3method("format", "ftable")
+
 S3method("xtable", "data.frame")
 S3method("xtable", "matrix")
 S3method("xtable", "table")
@@ -53,7 +56,7 @@ S3method("xtable", "summary.gmsar")
 S3method("xtable", "stsls")
 S3method("xtable", "summary.stsls")
 S3method("xtable", "sarlm.pred")
-S3method("xtable", "lagImpact")
+###S3method("xtable", "lagImpact")
 S3method("xtable", "splm")
 S3method("xtable", "summary.splm")
 S3method("xtable", "sphet")
diff --git a/pkg/R/format.ftable.R b/pkg/R/format.ftable.R
new file mode 100644 (file)
index 0000000..065cd3a
--- /dev/null
@@ -0,0 +1,99 @@
+### copy of function stats:::format.ftable because unexported from stats\r
+format.ftable <- function (x, quote = TRUE, digits = getOption("digits"),\r
+                           method = c("non.compact", "row.compact",\r
+                               "col.compact", "compact"),\r
+                           lsep = " | ", ...)\r
+{\r
+  if (!inherits(x, "ftable"))\r
+    stop("'x' must be an \"ftable\" object")\r
+  charQuote <- function(s) {\r
+    if (quote && length(s)){\r
+      paste0("\"", s, "\"")\r
+    } else {\r
+      s\r
+    }\r
+  }\r
+  makeLabels <- function(lst) {\r
+    lens <- lengths(lst)\r
+    cplensU <- c(1, cumprod(lens))\r
+    cplensD <- rev(c(1, cumprod(rev(lens))))\r
+    y <- NULL\r
+    for (i in rev(seq_along(lst))) {\r
+      ind <- 1 + seq.int(from = 0, to = lens[i] - 1) *\r
+          cplensD[i + 1L]\r
+      tmp <- character(length = cplensD[i])\r
+      tmp[ind] <- charQuote(lst[[i]])\r
+      y <- cbind(rep(tmp, times = cplensU[i]), y)\r
+    }\r
+    y\r
+  }\r
+  makeNames <- function(x) {\r
+    nmx <- names(x)\r
+    if (is.null(nmx)) {\r
+      rep_len("", length(x))\r
+    } else {\r
+      nmx\r
+    }\r
+  }\r
+  l.xrv <- length(xrv <- attr(x, "row.vars"))\r
+  l.xcv <- length(xcv <- attr(x, "col.vars"))\r
+  method <- match.arg(method)\r
+  if (l.xrv == 0) {\r
+    if (method == "col.compact"){\r
+      method <- "non.compact"\r
+    } else if (method == "compact") {\r
+      method <- "row.compact"\r
+    }\r
+  }\r
+  if (l.xcv == 0) {\r
+    if (method == "row.compact") {\r
+      method <- "non.compact"\r
+    } else if (method == "compact") {\r
+      method <- "col.compact"\r
+    }\r
+  }\r
+  LABS <- switch(method,\r
+                 non.compact =\r
+                     {cbind(rbind(matrix("",\r
+                                         nrow = length(xcv),\r
+                                         ncol = length(xrv)),\r
+                                  charQuote(makeNames(xrv)),\r
+                                  makeLabels(xrv)),\r
+                            c(charQuote(makeNames(xcv)),\r
+                              rep("", times = nrow(x) + 1)))},\r
+                 row.compact =\r
+                     {cbind(rbind(matrix("",\r
+                                         nrow = length(xcv) - 1,\r
+                                         ncol = length(xrv)),\r
+                                  charQuote(makeNames(xrv)),\r
+                                  makeLabels(xrv)),\r
+                            c(charQuote(makeNames(xcv)),\r
+                              rep("", times = nrow(x))))},\r
+                 col.compact =\r
+                     {cbind(rbind(cbind(matrix("",\r
+                                               nrow = length(xcv),\r
+                                               ncol = length(xrv) - 1),\r
+                                        charQuote(makeNames(xcv))),\r
+                                  charQuote(makeNames(xrv)),\r
+                                  makeLabels(xrv)))},\r
+                 compact =\r
+                     {xrv.nms <- makeNames(xrv)\r
+                      xcv.nms <- makeNames(xcv)\r
+                      mat <-\r
+                        cbind(rbind(cbind(matrix("",\r
+                                                 nrow = l.xcv - 1,\r
+                                                 ncol = l.xrv - 1),\r
+                                          charQuote(makeNames(xcv[-l.xcv]))),\r
+                                    charQuote(xrv.nms), makeLabels(xrv)))\r
+                      mat[l.xcv, l.xrv] <- paste(tail(xrv.nms, 1),\r
+                                                 tail(xcv.nms, 1),\r
+                                                 sep = lsep)\r
+                      mat},\r
+                 stop("wrong method"))\r
+  DATA <- rbind(if (length(xcv)) t(makeLabels(xcv)),\r
+                if (method %in% c("non.compact", "col.compact"))\r
+                  { rep("", times = ncol(x)) },\r
+                format(unclass(x), digits = digits,  ...) )\r
+  cbind(apply(LABS, 2L, format, justify = "left"),\r
+        apply(DATA, 2L, format, justify = "right"))\r
+}\r
index 83138088887c4472bc0c22a617c2701ef0c751b3..6cf0e17240674044544804af08bb82ba99a10181 100644 (file)
@@ -395,14 +395,18 @@ xtable.sarlm.pred <- function(x, caption = NULL, label = NULL, align = NULL,
                 display = display, auto = auto, ...))
 }
 
+
+### This method removed because of the need to copy code to pass CRAN checks
+### lagImpactMat is neither exported nor documented in spdep
+
 ### lagImpact objects
-xtable.lagImpact <- function(x, caption = NULL, label = NULL, align = NULL,
-                             digits = NULL, display = NULL,
-                             auto = FALSE, ...) {
-  xtable(spdep:::lagImpactMat(x), caption = caption, label = label,
-         align = align, digits = digits,
-         display = display, auto = auto, ...)
-}
+## xtable.lagImpact <- function(x, caption = NULL, label = NULL, align = NULL,
+##                              digits = NULL, display = NULL,
+##                              auto = FALSE, ...) {
+##   xtable(spdep:::lagImpactMat(x), caption = caption, label = label,
+##          align = align, digits = digits,
+##          display = display, auto = auto, ...)
+## }
 
 ### package splm
 ### splm objects
index 34b544df833b0f39aa1d02bb5463fdeadf15f6cd..dafb6f0e72ebe116d292703fa3c2032328b744a5 100644 (file)
@@ -110,8 +110,8 @@ print.xtableFtable <- function(x,
     nCharCols <- attr(x, "nChars")[2]
     nRowVars <- length(attr(x, "row.vars"))
     nColVars <- length(attr(x, "col.vars"))
-    fmtFtbl <- stats:::format.ftable(x, quote = quote, digits = digits,
-                                     method = method, lsep = lsep)
+    fmtFtbl <- format.ftable(x, quote = quote, digits = digits,
+                             method = method, lsep = lsep)
     attr(fmtFtbl, "caption") <- caption
     attr(fmtFtbl, "label") <- label
     ## if method is "compact", rotate both if either requested
diff --git a/pkg/man/format.ftable.Rd b/pkg/man/format.ftable.Rd
new file mode 100644 (file)
index 0000000..962af8c
--- /dev/null
@@ -0,0 +1,66 @@
+%% File src/library/stats/man/read.ftable.Rd\r
+%% Part of the R package, https://www.R-project.org\r
+%% Copyright 1995-2014 R Core Team\r
+%% Copyright 2002-2013 The R Foundation\r
+%% Distributed under GPL 2 or later\r
+\r
+%% Copied to document copy of unexported function format.ftable\r
+\r
+\name{format.ftable}\r
+\title{Format Flat Contingency Tables}\r
+\alias{format.ftable}\r
+\description{\r
+  Format \sQuote{flat} contingency tables.\r
+}\r
+\usage{\r
+\method{format}{ftable}(x, quote = TRUE, digits = getOption("digits"),\r
+                        method = c("non.compact", "row.compact",\r
+                                  "col.compact", "compact"),\r
+                        lsep = " | ", \dots)\r
+}\r
+\arguments{\r
+  \item{x}{an object of class \code{"ftable"}.}\r
+  \item{quote}{a character string giving the set of quoting characters\r
+    for \code{read.ftable}; to disable quoting altogether, use\r
+    \code{quote=""}.  For \code{write.table}, a logical indicating\r
+    whether strings in the data will be surrounded by double quotes.}\r
+  \item{digits}{an integer giving the number of significant digits to\r
+    use for (the cell entries of) \code{x}.}\r
+  \item{method}{string specifying how the \code{"ftable"} object is formatted\r
+    (and printed if used as in \code{write.ftable()} or the \code{print}\r
+    method).  Can be abbreviated.  Available methods are (see the examples):\r
+    \describe{\r
+      \item{"non.compact"}{the default representation of an\r
+        \code{"ftable"} object.}\r
+      \item{"row.compact"}{a row-compact version without empty cells\r
+        below the column labels.}\r
+      \item{"col.compact"}{a column-compact version without empty cells\r
+        to the right of the row labels.}\r
+      \item{"compact"}{a row- and column-compact version.  This may imply\r
+        a row and a column label sharing the same cell.  They are then\r
+        separated by the string \code{lsep}.}\r
+    }\r
+  }\r
+  \item{lsep}{only for \code{method = "compact"}, the separation string\r
+    for row and column labels.}\r
+  \item{\dots}{further arguments such as \code{method}, passed to\r
+    \code{format()}.}\r
+}\r
+\details{\r
+  This format method is a copy of \code{format.ftable} from\r
+  \pkg{stats}, and this man page is derived from the page\r
+  \code{\link[stats]{read.ftable}}.\r
+}\r
+\seealso{\r
+  \code{\link[stats]{ftable}} and\r
+  \code{\link[stats]{read.ftable}} for more information on flat\r
+  contingency tables.\r
+}\r
+\examples{\r
+ft22 <- ftable(Titanic, row.vars = 2:1, col.vars = 4:3)\r
+write.ftable(ft22, quote = FALSE)\r
+write.ftable(ft22, quote = FALSE, method="row.compact")\r
+write.ftable(ft22, quote = FALSE, method="col.compact")\r
+write.ftable(ft22, quote = FALSE, method="compact")\r
+}\r
+\keyword{category}\r
index 29efa7c0f9d22bc1046b5647b3677784930b8758..3277d56f214f530b8fdc3a55a1f9251003b1e214 100644 (file)
@@ -25,7 +25,7 @@
 \alias{xtable.stsls}
 \alias{xtable.summary.stsls}
 \alias{xtable.sarlm.pred}
-\alias{xtable.lagImpact}
+%%%\alias{xtable.lagImpact}
 \alias{xtable.splm}
 \alias{xtable.summary.splm}
 \alias{xtable.sphet}
index d23db164c8848782ee75dc51808c938c5e95ca48..fff3c4073c2e1869dd96b5750be7f0dd84bff401 100644 (file)
@@ -139,25 +139,35 @@ xtable(COL.lag.stsls)
 xtable(p1)\r
 @ %def\r
 \r
-This method transforms the \code{sarlm.pred} objects into data frames, allowing any number of attributes vectors which may vary according to predictor types.\r
+This method transforms the \code{sarlm.pred} objects into data frames,\r
+allowing any number of attributes vectors which may vary according to\r
+predictor types.\r
 \r
 <<xtablesarlmpred2, results = 'asis'>>=\r
 xtable(p2)\r
 @ %def\r
 \r
-\subsubsection{\code{lagImpact} objects}\r
-\label{sec:codelagimpact-objects}\r
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\r
+%% xtable.lagImpactMat removed because of problems with unexported function\r
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\r
 \r
-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.\r
+%% \subsubsection{\code{lagImpact} objects}\r
+%% \label{sec:codelagimpact-objects}\r
 \r
-<<xtablelagimpactexact, results = 'asis'>>=\r
-xtable(imp.exact)\r
-@ %def\r
+%% The \code{xtable} method returns the values of direct, indirect and\r
+%% total impacts for all the variables in the model. The class\r
+%% \code{lagImpact} have two different sets of attributes according to if\r
+%% simulations are used. But the \code{xtable} method always returns the\r
+%% three components of the non-simulation case.\r
 \r
-\p\r
-<<xtablelagimpactmcmc, results = 'asis'>>=\r
-xtable(imp.sim)\r
-@ %def\r
+%% <<xtablelagimpactexact, results = 'asis'>>=\r
+%% xtable(imp.exact)\r
+%% @ %def\r
+\r
+%% \p\r
+%% <<xtablelagimpactmcmc, results = 'asis'>>=\r
+%% xtable(imp.sim)\r
+%% @ %def\r
 \r
 \r
 \subsubsection{\code{spautolm} objects}\r
@@ -226,11 +236,16 @@ xtable(respatlag)
 xtable(GM)\r
 @ %def\r
 \r
-The \code{xtable} method works the same on impacts of \code{splm} models.\r
 \r
-<<xtablesplmimpacts, results = 'asis'>>=\r
-xtable(imp.spml)\r
-@ %def\r
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\r
+%% xtable.lagImpactMat removed because of problems with unexported function\r
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\r
+\r
+%% The \code{xtable} method works the same on impacts of \code{splm} models.\r
+\r
+%% <<xtablesplmimpacts, results = 'asis'>>=\r
+%% xtable(imp.spml)\r
+%% @ %def\r
 \r
 \subsection{The package \pkg{sphet}}\r
 \label{sec:package-pkgsphet}\r
@@ -265,23 +280,26 @@ xtable(res.stsls)
 xtable(res.gstsls)\r
 @ %def\r
 \r
-\code{sphet} also provides a method for computing impacts.\r
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\r
+%% xtable.lagImpactMat removed because of problems with unexported function\r
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\r
+%% \code{sphet} also provides a method for computing impacts.\r
 \r
-<<xtablesphetimpacts, results = 'asis'>>=\r
-xtable(imp.gstsls)\r
-@ %def\r
+%% <<xtablesphetimpacts, results = 'asis'>>=\r
+%% xtable(imp.gstsls)\r
+%% @ %def\r
 \r
 \section{The \pkg{zoo} package}\r
 \label{sec:pkgzoo-package}\r
 \r
\r
+\r
 <<zoo, results = 'asis'>>=\r
 library(zoo)\r
 xDate <- as.Date("2003-02-01") + c(1, 3, 7, 9, 14) - 1\r
 as.ts(xDate)\r
 x <- zoo(rnorm(5), xDate)\r
 xtable(x)\r
-@ %def \r
+@ %def\r
 \r
 \r
 \p\r
@@ -293,21 +311,21 @@ tempTable <- xtable(tempTs, digits = 0)
 tempTable\r
 tempZoo <- as.zoo(tempTs)\r
 xtable(tempZoo, digits = 0)\r
-@ %def \r
+@ %def\r
 \r
 \r
 \section{The \pkg{survival} package}\r
 \label{sec:pkgsurvival-package}\r
 \r
\r
+\r
 <<survival, results = 'asis'>>=\r
 library(survival)\r
-test1 <- list(time=c(4,3,1,1,2,2,3), \r
-              status=c(1,1,1,0,1,1,0), \r
-              x=c(0,2,1,1,1,0,0), \r
-              sex=c(0,0,0,0,1,1,1)) \r
-coxFit <- coxph(Surv(time, status) ~ x + strata(sex), test1) \r
+test1 <- list(time=c(4,3,1,1,2,2,3),\r
+              status=c(1,1,1,0,1,1,0),\r
+              x=c(0,2,1,1,1,0,0),\r
+              sex=c(0,0,0,0,1,1,1))\r
+coxFit <- coxph(Surv(time, status) ~ x + strata(sex), test1)\r
 xtable(coxFit)\r
-@ %def \r
+@ %def\r
 \r
 \end{document}\r