From: dscott Date: Mon, 11 Jan 2016 04:08:42 +0000 (+0000) Subject: Added math.style.exponents option to print.xtable via a change to X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=14a0e1cc0c8bd9bfbb658a6f22d0cbe83c2f4a8d;p=xtable.git Added math.style.exponents option to print.xtable via a change to sanitize.numbers git-svn-id: svn://scm.r-forge.r-project.org/svnroot/xtable@87 edb9625f-4e0d-4859-8d74-9fd3b1da38cb --- diff --git a/pkg/NEWS b/pkg/NEWS index fba8404..4d24a5e 100644 --- a/pkg/NEWS +++ b/pkg/NEWS @@ -1,4 +1,4 @@ -1.8-1 (NOT YET SUBMITTED TO CRAN) +1.8-2 (NOT YET SUBMITTED TO CRAN) * Added function print.xtableMatharray to enable easy creation of LaTeX code to enable an array to be included in a document. * Added example to the gallery using sanitizing headings and row @@ -8,6 +8,9 @@ sphet. * Extracted sanitize functions from print.xtable as stand-alone functions, and exported them. + * Added option to produce math style exponents when sanitizing + numbers, as suggested by Don Armstrong (don@donarmstrong.com), who + also provided code 1.8-0 diff --git a/pkg/R/print.xtable.R b/pkg/R/print.xtable.R index 1cbf37f..b3b4b9a 100644 --- a/pkg/R/print.xtable.R +++ b/pkg/R/print.xtable.R @@ -45,6 +45,7 @@ print.xtable <- function(x, sanitize.colnames.function = getOption("xtable.sanitize.colnames.function", sanitize.text.function), math.style.negative = getOption("xtable.math.style.negative", FALSE), + math.style.exponents = getOption("xtable.math.style.exponents", FALSE), html.table.attributes = getOption("xtable.html.table.attributes", "border=1"), print.results = getOption("xtable.print.results", TRUE), format.args = getOption("xtable.format.args", NULL), @@ -537,7 +538,8 @@ print.xtable <- function(x, if ( is.numeric.column ) { cols[, i+pos] <- sanitize.numbers(cols[, i+pos], type = type, - math.style.negative = math.style.negative) + math.style.negative = math.style.negative, + math.style.exponents = math.style.exponents) } else { if (is.null(sanitize.text.function)) { cols[, i+pos] <- sanitize(cols[, i+pos], type = type) diff --git a/pkg/R/sanitize.R b/pkg/R/sanitize.R index 1313a96..18c6619 100644 --- a/pkg/R/sanitize.R +++ b/pkg/R/sanitize.R @@ -26,7 +26,9 @@ sanitize <- function(str, type) { } -sanitize.numbers <- function(str, type, math.style.negative){ +sanitize.numbers <- function(str, type, + math.style.negative = FALSE, + math.style.exponents = FALSE){ if (type == "latex"){ result <- str if ( math.style.negative ) { @@ -34,6 +36,40 @@ sanitize.numbers <- function(str, type, math.style.negative){ result[i] <- gsub("-", "$-$", result[i], fixed = TRUE) } } + if ( math.style.exponents ) { + if (is.logical(math.style.exponents) && ! math.style.exponents ) { + } else if (is.logical(math.style.exponents) && math.style.exponents || + math.style.exponents == "$$" + ) { + for(i in 1:length(str)) { + result[i] <- + gsub("^\\$?(-?)\\$?([0-9.]+)[eE]\\$?(-?)\\+?\\$?0*(\\d+)$", + "$\\1\\2 \\\\times 10^{\\3\\4}$", result[i]) + } + } else if (math.style.exponents == "ensuremath") { + for(i in 1:length(str)) { + result[i] <- + gsub("^\\$?(-?)\\$?([0-9.]+)[eE]\\$?(-?)\\+?\\$?0*(\\d+)$", + "\\\\ensuremath{\\1\\2 \\\\times 10^{\\3\\4}}", + result[i]) + } + } else if (math.style.exponents == "UTF8" || + math.style.exponents == "UTF-8") { + for(i in 1:length(str)) { + ## this code turns 1e5 into 1×10⁵x + if (all(grepl("^\\$?(-?)\\$?([0-9.]+)[eE]\\$?(-?)\\+?\\$?0*(\\d+)$", + result[i]))) { + temp <- strsplit(result[i],"eE",result[i]) + result[i] <- + paste0(temp[1], + "\u00d710", + chartr("-1234567890", + "\u207b\u00b9\u00b2\u00b3\u2074\u2075\u20746\u20747\u20748\u20749\u2070", + temp[2])) + } + } + } + } return(result) } else { return(str) @@ -47,7 +83,7 @@ sanitize.final <- function(str, type){ } else { str$text <- gsub(" *", " ", str$text, fixed = TRUE) str$text <- gsub(' align="left"', "", str$text, - fixed = TRUE) + fixed = TRUE) return(str) } } diff --git a/pkg/R/table.attributes.R b/pkg/R/table.attributes.R index 718e41f..9932cef 100644 --- a/pkg/R/table.attributes.R +++ b/pkg/R/table.attributes.R @@ -20,56 +20,57 @@ ### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, ### MA 02111-1307, USA -"caption<-" <- function(x,value) UseMethod("caption<-") -"caption<-.xtable" <- function(x,value) { - if (length(value)>2) +"caption<-" <- function(x, value) UseMethod("caption<-") +"caption<-.xtable" <- function(x, value) { + if (length(value) > 2) stop("\"caption\" must have length 1 or 2") - attr(x,"caption") <- value + attr(x, "caption") <- value return(x) } -caption <- function(x,...) UseMethod("caption") -caption.xtable <- function(x,...) { - return(attr(x,"caption",exact=TRUE)) +caption <- function(x, ...) UseMethod("caption") +caption.xtable <- function(x, ...) { + return(attr(x, "caption", exact = TRUE)) } -"label<-" <- function(x,value) UseMethod("label<-") -"label<-.xtable" <- function(x,value) { - if (length(value)>1) +"label<-" <- function(x, value) UseMethod("label<-") +"label<-.xtable" <- function(x, value) { + if (length(value) > 1) stop("\"label\" must have length 1") - attr(x,"label") <- value + attr(x, "label") <- value return(x) } -label <- function(x,...) UseMethod("label") -label.xtable <- function(x,...) { - return(attr(x,"label",exact=TRUE)) +label <- function(x, ...) UseMethod("label") +label.xtable <- function(x, ...) { + return(attr(x, "label", exact = TRUE)) } -"align<-" <- function(x,value) UseMethod("align<-") +"align<-" <- function(x, value) UseMethod("align<-") -# Based on contribution from Jonathan Swinton in e-mail dated Wednesday, January 17, 2007 +### Based on contribution from Jonathan Swinton +### in e-mail dated Wednesday, January 17, 2007 .alignStringToVector <- function(aString) { - # poor mans parsing - separating string of form "l{2in}llr|p{1in}c|{1in}" - # into "l{2in}" "l" "l" "r" "|" "p{1in}" "c" "|{1in}" + ## poor mans parsing - separating string of form "l{2in}llr|p{1in}c|{1in}" + ## into "l{2in}" "l" "l" "r" "|" "p{1in}" "c" "|{1in}" aString.Align <- character(0); aString.Width <- character(0); wString <- aString - while( nchar(wString)>0) { - aString.Align <- c(aString.Align,substr(wString,1,1)) - # is it followed by a brace? + while( nchar(wString) > 0) { + aString.Align <- c(aString.Align, substr(wString, 1, 1)) + ## is it followed by a brace? thisWidth <- "" - if ( nchar(wString)>1 & substr(wString,2,2)=="{") { - beforeNextBrace <- regexpr("[^\\]\\}",wString) + if ( nchar(wString) > 1 & substr(wString, 2, 2) == "{") { + beforeNextBrace <- regexpr("[^\\]\\}", wString) if (beforeNextBrace <0 ) { stop("No closing } in align string") } - thisWidth <- substr(wString,2,beforeNextBrace+1) - wString <- substr(wString,beforeNextBrace+2,nchar(wString)) + thisWidth <- substr(wString, 2, beforeNextBrace + 1) + wString <- substr(wString, beforeNextBrace + 2, nchar(wString)) } else { - wString <- substr(wString,2,nchar(wString)) + wString <- substr(wString, 2, nchar(wString)) } - aString.Width <- c(aString.Width,thisWidth) + aString.Width <- c(aString.Width, thisWidth) } alignAllowed <- c("l","r","p","c","|","X") @@ -77,78 +78,84 @@ label.xtable <- function(x,...) { if (any( !(aString.Align %in% alignAllowed))) { warning("Nonstandard alignments in align string") } - res <- paste(aString.Align,aString.Width,sep="") + res <- paste(aString.Align, aString.Width, sep = "") res } -#.alignStringToVector ("l{2in}llr|p{1in}c|{1in}") -#.alignStringToVector ("l{2in}llr|p{1in}c|") -#.alignStringToVector ("{2in}llr|p{1in}c|") # latex syntax error, but gives wrong alignment -#.alignStringToVector("llllp{3cm}") - -"align<-.xtable" <- function(x,value) { -# Based on contribution from Benno in e-mail dated Wednesday, December 01, 2004 -# Based on contribution from Jonathan Swinton in e-mail dated Wednesday, January 17, 2007 - # cat("%",value,"\n") - if ( (!is.null(value)) && ( is.character(value) ) && ( length(value) == 1 ) && ( nchar(value) > 1 ) ) { +###.alignStringToVector ("l{2in}llr|p{1in}c|{1in}") +###.alignStringToVector ("l{2in}llr|p{1in}c|") +### latex syntax error, but gives wrong alignment +###.alignStringToVector ("{2in}llr|p{1in}c|") +###.alignStringToVector("llllp{3cm}") + +"align<-.xtable" <- function(x, value) { +### Based on contribution from Benno +### in e-mail dated Wednesday, December 01, 2004 +### Based on contribution from Jonathan Swinton +### in e-mail dated Wednesday, January 17, 2007 + ## cat("%", value, "\n") + if ( (!is.null(value)) && ( is.character(value) ) && + ( length(value) == 1 ) && ( nchar(value) > 1 ) ) { value <- .alignStringToVector(value) - } # That should have checked we had only lrcp| - # but what if the "if statement" is false? - # For simplicity, deleting check present in version 1.4-2 and earlier. - c.value <- if (any(!is.na(match(value,"|")))) { - value[-which(value=='|')] + } + ## That should have checked we had only lrcp| + ## but what if the "if statement" is false? + ## For simplicity, deleting check present in version 1.4-2 and earlier. + c.value <- if (any(!is.na(match(value, "|")))) { + value[-which(value == '|')] } else { - value + value } - if (length(c.value)!=ncol(x)+1) - stop(paste("\"align\" must have length equal to",ncol(x)+1,"( ncol(x) + 1 )")) - - attr(x,"align") <- value + if (length(c.value) != ncol(x) + 1) + stop(paste("\"align\" must have length equal to", + ncol(x) + 1, "( ncol(x) + 1 )")) + attr(x, "align") <- value return(x) } -align <- function(x,...) UseMethod("align") -align.xtable <- function(x,...) { - return(attr(x,"align",exact=TRUE)) +align <- function(x, ...) UseMethod("align") +align.xtable <- function(x, ...) { + return(attr(x, "align", exact = TRUE)) } -"digits<-" <- function(x,value) UseMethod("digits<-") -"digits<-.xtable" <- function(x,value) { +"digits<-" <- function(x, value) UseMethod("digits<-") +"digits<-.xtable" <- function(x, value) { if( is.matrix( value ) ) { - if( ncol( value ) != ncol(x)+1 || nrow( value ) != nrow(x) ) { + if( ncol( value ) != ncol(x) + 1 || nrow( value ) != nrow(x) ) { stop( "if argument 'digits' is a matrix, it must have columns equal", - " to ", ncol(x)+1, " ( ncol(x) + 1 ) and rows equal to ", nrow(x), - " ( nrow( x )" ) + " to ", ncol(x) + 1, " ( ncol(x) + 1 ) and rows equal to ", nrow(x), + " ( nrow( x )" ) } } else { - if( length(value)==1 ) { value <- rep(value, ncol(x)+1) } - if( length( value ) >1 & length( value ) != ncol(x)+1 ) { + if( length(value) == 1 ) { value <- rep(value, ncol(x) + 1) } + if( length( value ) > 1 & length( value ) != ncol(x) + 1 ) { stop( "if argument 'digits' is a vector of length more than one, it must have length equal", - " to ", ncol(x)+1, " ( ncol(x) + 1 )" ) + " to ", ncol(x) + 1, " ( ncol(x) + 1 )" ) } } if (!is.numeric(value)) stop("\"digits\" must be numeric") - attr(x,"digits") <- value + attr(x, "digits") <- value return(x) } -digits <- function(x,...) UseMethod("digits") -digits.xtable <- function(x,...) { - return(attr(x,"digits",exact=TRUE)) +digits <- function(x, ...) UseMethod("digits") +digits.xtable <- function(x, ...) { + return(attr(x, "digits", exact = TRUE)) } -"display<-" <- function(x,value) UseMethod("display<-") -"display<-.xtable" <- function(x,value) { - if (length(value)!=ncol(x)+1) - stop(paste("\"display\" must have length equal to",ncol(x)+1,"( ncol(x) + 1 )")) - if (!all(!is.na(match(value,c("d","f","e","E","g","G","fg","s"))))) +"display<-" <- function(x, value) UseMethod("display<-") +"display<-.xtable" <- function(x, value) { + if (length(value) != ncol(x) + 1) + stop(paste("\"display\" must have length equal to", + ncol(x) + 1, "( ncol(x) + 1 )")) + if (!all(!is.na(match(value, c("d","f","e","E","g","G","fg","s"))))) stop("\"display\" must be in {\"d\",\"f\",\"e\",\"E\",\"g\",\"G\", \"fg\", \"s\"}") - attr(x,"display") <- value + attr(x, "display") <- value return(x) } -display <- function(x,...) UseMethod("display") -display.xtable <- function(x,...) { - return(attr(x,"display",exact=TRUE)) +display <- function(x, ...) UseMethod("display") +display.xtable <- function(x, ...) { + return(attr(x, "display", exact = TRUE)) } diff --git a/pkg/man/print.xtable.Rd b/pkg/man/print.xtable.Rd index ba3b45d..c8ca654 100644 --- a/pkg/man/print.xtable.Rd +++ b/pkg/man/print.xtable.Rd @@ -30,6 +30,7 @@ sanitize.colnames.function = getOption("xtable.sanitize.colnames.function", sanitize.text.function), math.style.negative = getOption("xtable.math.style.negative", FALSE), + math.style.exponents = getOption("xtable.math.style.exponents", FALSE), html.table.attributes = getOption("xtable.html.table.attributes", "border=1"), print.results = getOption("xtable.print.results", TRUE), @@ -137,6 +138,12 @@ The default uses the \code{sanitize.text.function}. } \item{math.style.negative}{In a LaTeX table, if \code{TRUE}, then use $-$ for the negative sign (as was the behavior prior to version 1.5-3). + Default value is \code{FALSE}.} + \item{math.style.exponents}{In a LaTeX table, if \code{TRUE} or + \code{"$$"}, then use \verb{$5 \times 10^{5}$} for 5e5. If + \code{"ensuremath"}, then use \verb{\\ensuremath{5 \times 10^{5}}} + for 5e5. If \code{"UTF-8"} or \code{"UTF-8"}, then use UTF-8 to + approximate the LaTeX typsetting for 5e5. Default value is \code{FALSE}.} \item{html.table.attributes}{In an HTML table, attributes associated with the \code{} tag. diff --git a/pkg/man/sanitize.Rd b/pkg/man/sanitize.Rd index aa46247..3bba107 100644 --- a/pkg/man/sanitize.Rd +++ b/pkg/man/sanitize.Rd @@ -13,7 +13,8 @@ } \usage{ sanitize(str, type) -sanitize.numbers(str, type, math.style.negative) +sanitize.numbers(str, type, math.style.negative = FALSE, + math.style.exponents = FALSE) sanitize.final(str, type) } @@ -25,6 +26,12 @@ sanitize.final(str, type) \item{math.style.negative}{In a LaTeX table, if \code{TRUE}, then use $-$ for the negative sign (as was the behavior prior to version 1.5-3). Default value is \code{FALSE}.} + \item{math.style.exponents}{In a LaTeX table, if \code{TRUE} or + \code{"$$"}, then use \verb{$5 \times 10^{5}$} for 5e5. If + \code{"ensuremath"}, then use \verb{\ensuremath{5 \times 10^{5}}} + for 5e5. If \code{"UTF-8"} or \code{"UTF-8"}, then use UTF-8 to + approximate the LaTeX typsetting for 5e5. + Default value is \code{FALSE}.} } \details{ @@ -42,6 +49,12 @@ sanitize.final(str, type) \code{"latex"}, $-$ is used for the negative sign rather than a simple hyphen (-). No effect when \code{type} is \code{"html"}. + When \code{type} is \code{"latex"}, and \code{math.style.exponents} + is \code{TRUE} or \verb{"$$"}, then use \verb{$5 \times 10^{5}$} for + 5e5. If \code{"ensuremath"}, then use \verb{\ensuremath{5 \times + 10^{5}}} for 5e5. If \code{"UTF-8"} or \code{"UTF-8"}, then use UTF-8 + to approximate the LaTeX typsetting for 5e5. + When \code{type} is \code{"latex"} \code{sanitize.final} has no effect. When \code{type} is \code{"html"}, multiple spaces are replaced by a single space and occurrences of \code{' align="left"'} @@ -72,7 +85,8 @@ names(insane) <- c("Ampersand","Greater than","Less than") sanitize(insane, type = "html") x <- rnorm(10) sanitize.numbers(x, "latex", TRUE) -sanitize.numbers(x, "html", TRUE) +sanitize.numbers(x*10^(10), "latex", TRUE, TRUE) +sanitize.numbers(x, "html", TRUE, TRUE) } \keyword{print } diff --git a/pkg/vignettes/xtableGallery.Rnw b/pkg/vignettes/xtableGallery.Rnw index 6b7d47b..1349096 100644 --- a/pkg/vignettes/xtableGallery.Rnw +++ b/pkg/vignettes/xtableGallery.Rnw @@ -188,6 +188,25 @@ autoformat(x) \newpage +\subsection{Math-Style Exponents} +If you prefer $5 \times 10^5$ in your tables to 5e5, the +\code{math.style.exponents} option to \code{print.xtable} is useful: + +<>= +print(xtable(data.frame(text=c("foo","bar"), + googols=c(10e10,50e10), + small=c(8e-24,7e-5), + row.names=c("A","B")), + display=c("s","s","g","g")), + math.style.exponents=TRUE + ) +@ + +this option also supports the values \code{ensuremath} which uses +\code{\char`\\ensuremath} instead of \code{\$\$} and \code{UTF-8} +which uses UTF-8 to approximate the \LaTeX typesetting. + + \section{Sanitization} <>= insane <- data.frame(Name = c("Ampersand","Greater than","Less than",