allow for pval trimming

Added a feature to allow that pvalues can be trimmed when smaller than the desired rounding digits (eg 0.008 will be displayed as <0.01 when 2 digit decimals are desired)

R/table2office.R

@@ -21,6 +21,10 @@
 #' for the column with p values.
 #' @param digitspvals number of significant digits to show for columns with p
 #' values.
+#' @param trim.pval a logical indicating if the p-values for which the significant digit is lower 
+#' than the desired rounding digit (given by \code{digitspvals}) should be trimmed as 
+#' \code{paste0("<", 10^-ndigitspvals)} (eg \code{'<0.01'}) otherwise they are rounded at 
+#' \code{ndigitspvals} digits.
 #' @param width desired width of table in inches. If the given width exceeds the page or slide 
 #' width, the table width becomes the page/slide width.
 #' @param height desired height of table in inches. If the given height exceeds the page or slide 
@@ -31,7 +35,7 @@
 #' systems and to \code{"Helvetica"} on other systems.
 #' @param pointsize desired font point size.
 #' @param add.rownames logical specifying whether or not to add row names.
-#' @param \dots extra options are passed on to \code{\link[xtable]{xtable}} or \code{\link[broom]{tidy}}
+#' @param \dots Further arguments to be passed to \code{table2office}.
 #' @return \code{\link[flextable]{flextable}} object
 #' @details Columns corresponding to degrees of freedom (with header "Df" or "df")
 #' are always given as integers. Objects that can be exported with \code{\link{table2office}} are 
@@ -169,9 +173,9 @@
 #' @export
 #' 
 table2office = function(x = NULL, file = "Rtable", type = c("PPT","DOC"), append = FALSE, digits = 2, 
-                     digitspvals = 2, width = NULL, height = NULL, offx = 1, offy = 1, 
+                     digitspvals = 2, trim.pval = TRUE, width = NULL, height = NULL, offx = 1, offy = 1, 
                      font = ifelse(Sys.info()["sysname"]=="Windows","Arial","Helvetica")[[1]], pointsize = 12, 
-                     add.rownames = FALSE, ...) {
+                     add.rownames = FALSE) {
 
   obj=x
   if (is.null(obj)) {
@@ -227,11 +231,11 @@ table2office = function(x = NULL, file = "Rtable", type = c("PPT","DOC"), append
 
   # Depending on the data class, call xtable or tidy
   if (length(intersect(class(outp), as.character(gsub("xtable.", "", methods(xtable))))) >= 1) {
-    tab <- xtable2(x=outp, ndigits = digits, ndigitspvals = digitspvals,...)
+    tab <- xtable2(x=outp, ndigits = digits, ndigitspvals = digitspvals, trim.pval = trim.pval)
   } else if (length(intersect(class(outp), as.character(gsub("tidy.", "", methods(tidy))))) >= 1) {
-    tab <- tidy2(x=outp, ndigits = digits, ndigitspvals = digitspvals,...)
+    tab <- tidy2(x=outp, ndigits = digits, ndigitspvals = digitspvals, trim.pval = trim.pval)
   } else { # should not occur
-    tab <- data.frame2(x=outp, ndigits = digits, ndigitspvals = digitspvals)
+    tab <- data.frame2(x=outp, ndigits = digits, ndigitspvals = digitspvals, trim.pval = trim.pval)
   }
 
   nc <- ncol(tab)

R/table2spreadsheet.R

@@ -23,6 +23,10 @@
 #' for the column with p values.
 #' @param digitspvals number of significant digits to show for columns with p
 #' values.
+#' @param trim.pval a logical indicating if the p-values for which the significant digit is lower 
+#' than the desired rounding digit (given by \code{digitspvals}) should be trimmed as 
+#' \code{paste0("<", 10^-ndigitspvals)} (eg \code{'<0.01'}) otherwise they are rounded at 
+#' \code{ndigitspvals} digits.
 #' @param add.rownames logical specifying whether or not to add row names.
 #' @param \dots extra options are passed on to \code{\link[openxlsx]{createStyle}} for the formatting of the woorksheet.
 #' This is only applicable for \code{type=="XLS"}.
@@ -164,7 +168,7 @@
 #' @export
 #' 
 table2spreadsheet = function(x = NULL, file = "Rtable", type = c("XLS","CSV","CSV2"), append = FALSE, sheetName="new sheet",
-                        digits = 2, digitspvals = 2, add.rownames = FALSE, ...) {
+                        digits = 2, digitspvals = 2, trim.pval = TRUE, add.rownames = FALSE, ...) {
 
   obj=x
   if (is.null(obj)) {
@@ -201,11 +205,11 @@ table2spreadsheet = function(x = NULL, file = "Rtable", type = c("XLS","CSV","CS
 
   # Depending on the data class, call xtable or tidy
   if (length(intersect(class(outp), as.character(gsub("xtable.", "", methods(xtable))))) >= 1) {
-    tab <- xtable2(x=outp, ndigits = digits, ndigitspvals = digitspvals)
+    tab <- xtable2(x=outp, ndigits = digits, ndigitspvals = digitspvals, trim.pval=trim.pval)
   } else if (length(intersect(class(outp), as.character(gsub("tidy.", "", methods(tidy))))) >= 1) {
-    tab <- tidy2(x=outp, ndigits = digits, ndigitspvals = digitspvals)
+    tab <- tidy2(x=outp, ndigits = digits, ndigitspvals = digitspvals, trim.pval=trim.pval)
   } else { # should not occur
-    tab <- data.frame2(x=outp, ndigits = digits, ndigitspvals = digitspvals)
+    tab <- data.frame2(x=outp, ndigits = digits, ndigitspvals = digitspvals, trim.pval=trim.pval)
   }
 
   if(type=="XLS"){

R/table2tex.R

@@ -14,6 +14,10 @@
 #' for the column with p values.
 #' @param digitspvals number of significant digits to show for columns with p
 #' values.
+#' @param trim.pval a logical indicating if the p-values for which the significant digit is lower 
+#' than the desired rounding digit (given by \code{digitspvals}) should be trimmed as 
+#' \code{paste0("<", 10^-ndigitspvals)} (eg \code{'<0.01'}) otherwise they are rounded at 
+#' \code{ndigitspvals} digits.
 #' @param summary logical indicating whether or not to summarize data files.
 #' @param standAlone logical indicating whether exported Latex code should be
 #' standalone compilable, or whether it will be pasted into another document.
@@ -104,7 +108,7 @@
 #' @export
 #' 
 table2tex = function(x = NULL, file = "Rtable", type="TEX", digits = 2, digitspvals = 2, 
-                     summary=FALSE, standAlone=TRUE, add.rownames = FALSE,...) {
+                     trim.pval = TRUE, summary=FALSE, standAlone=TRUE, add.rownames = FALSE,...) {
   # Get the data that will be exported
   obj=x
   if (is.null(obj)) 
@@ -123,10 +127,10 @@ table2tex = function(x = NULL, file = "Rtable", type="TEX", digits = 2, digitspv
 
   # Depending on the class of the data call the formating function
   if (length(intersect(class(obj), as.character(gsub("xtable.", "", methods(xtable))))) >= 1) {
-    obj <- xtable2(x=obj, ndigits = digits, ndigitspvals = digitspvals)
+    obj <- xtable2(x=obj, ndigits = digits, ndigitspvals = digitspvals, trim.pval=trim.pval)
     obj <- as.data.frame(obj)
   } else if (length(intersect(class(obj), as.character(gsub("tidy.", "", methods(tidy))))) >= 1) {
-    obj <- tidy2(x=obj, ndigits = digits, ndigitspvals = digitspvals)
+    obj <- tidy2(x=obj, ndigits = digits, ndigitspvals = digitspvals, trim.pval=trim.pval)
     obj <- as.data.frame(obj)
   } 
   # Else supported objects that should be supported by stargazer

R/utils.R

@@ -16,54 +16,73 @@ preview = function(x){
 
 # helper function to show p values right aligned with digitspvals sign digits and 
 # degrees of freedom columns as right aligned integers
-xtable2 = function(x, ndigits = 2, ndigitspvals = 2, ...) {
+xtable2 = function(x, ndigits = 2, ndigitspvals = 2, trim.pval = T, ...) {
   sm = xtable(x)
   ncol = ncol(sm)
   digs = rep(ndigits, ncol + 1)
   disp = rep("f", ncol + 1)
   whch = grep("\\QPr(\\E|\\Qp-value\\E|\\Qp value\\E|\\Qpadj\\E|^p$|^padj$", colnames(sm))
   if (length(whch) != 0) {
-    digs[whch + 1] = ndigitspvals
-    disp[whch + 1] = "f"
+    for(j in whch){ # Format the pvalues in scientific format
+      sm[,j] <- sapply(sm[,j],function(val){
+        ifelse(val < 10^-ndigitspvals && trim.pval,
+               paste0("<", 10^-ndigitspvals),
+               formatC(val, format = "f", digits = ndigitspvals))
+      })
+    }
   }
   whch = grep("^Df$|^df$", colnames(sm))
   if (length(whch) != 0){
     digs[whch + 1] = 0
     disp[whch + 1] = "d"
   }
-  digs[c(1,which(!apply(sm,2,is.numeric))+1)] <- 0
-  disp[c(1,which(!apply(sm,2,is.numeric))+1)] <- "s"
+  digs[c(1,which(!sapply(sm,is.numeric))+1)] <- NA
+  disp[c(1,which(!sapply(sm,is.numeric))+1)] <- "s"
   for(i in 2:length(digs)){
-    if(!is.na(digs[i])) sm[,i-1] <- round(sm[,i-1], digits = digs[i])
+    if(disp[i]=="f") sm[,i-1] <- round(sm[,i-1], digits = digs[i])
   }
   xtable(sm, digits = digs, display = disp,...)
 }
 
-tidy2 <- function(x, ndigits = 2, ndigitspvals = 2,...) {
+tidy2 <- function(x, ndigits = 2, ndigitspvals = 2, trim.pval = T, ...) {
   x <- tidy(x)
   ncol = ncol(x)
   digs = rep(ndigits, ncol)
   whch = grep("\\QPr(\\E|\\Qp-value\\E|\\Qp value\\E|\\Qpadj\\E|^p$|^padj$", colnames(x))
-  if (length(whch) != 0) { digs[whch] = ndigitspvals }
+  if (length(whch) != 0) { digs[whch] = "pval" }
   whch = grep("^Df$|^df$", colnames(x))
   if (length(whch) != 0){ digs[whch] = 0 }
   digs[!sapply(x,is.numeric)] <- NA
   for(i in 1:length(digs)){
-    if(!is.na(digs[i])) x[,i] <- round(x[,i], digits = digs[i])
+    if(is.numeric(digs[i])) x[,i] <- round(x[,i], digits = digs[i])
+    if(digs[i]=="pval"){ 
+      x[,i] <- sapply(x[,i],function(val){
+        ifelse(val < 10^-ndigitspvals & trim.pval,
+               paste0("<", 10^-ndigitspvals),
+               formatC(val, format = "f", digits = ndigitspvals))
+      })
+    }
   }
   return(x)
 }
 
-data.frame2<- function(x, ndigits = 2, ndigitspvals = 2) {
+data.frame2<- function(x, ndigits = 2, ndigitspvals = 2, trim.pval = T,...) {
   x <- data.frame(x, check.names = F)
   ncol = ncol(x)
   digs = rep(ndigits, ncol)
   whch = grep("\\QPr(\\E|\\Qp-value\\E|\\Qp value\\E|\\Qpadj\\E|^p$|^padj$", colnames(x))
-  if (length(whch) != 0) { digs[whch] = ndigitspvals }
+  if (length(whch) != 0) { digs[whch] = "pval" }
   whch = grep("^Df$|^df$", colnames(x))
   if (length(whch) != 0){ digs[whch] = 0 }
   for(i in 1:length(digs)){
-    if(!is.na(digs[i])) x[,i-1] <- round(x[,i-1], digits = digs[i])
+    if(is.numeric(digs[i])) x[,i-1] <- round(x[,i-1], digits = digs[i])
+    if(digs[i]=="pval"){ 
+      x[,i-1] <- sapply(x[,i-1],function(val){
+        ifelse(val < 10^-ndigitspvals & trim.pval,
+               paste0("<", 10^-ndigitspvals),
+               formatC(val, format = "f", digits = ndigitspvals))
+      })
+    }
   }
   return(x)
 }

cran-comments.md

@@ -18,9 +18,21 @@ Running under: Ubuntu 17.10
 
 ## Resubmission
 
-This is a second resubmission. 
 
-In this version I have:
+This is the 4th submission.
+
+
+**Changes since 3rd submission :**
+
+* Changed the way temporary file names are created. We received exactly 
+  the same comment as last submission. We updated the example script, but 
+  forgot to update the '*.Rd' help file. Our sincere apologies for that.
+
+* Meanwhile, a user asked us to add a minor feature when exporting tables. 
+  p-values in the exported tables can now be (optionally) trimmed (eg '<0.001').
+
+**Changes since 2nd submission :**
+
 
 * Changed the way temporary file names are created in the 
   examples. Previously I used the syntax:
@@ -36,7 +48,7 @@ In this version I have:
   """
 
 
-In the previous version (first resubmission) I had:
+**Changes since 1st submission :**
 
 * Changed function names in the DESCRIPTION by adding  '()'.
 

export.Rproj

@@ -15,3 +15,4 @@ LaTeX: pdfLaTeX
 BuildType: Package
 PackageUseDevtools: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source
+PackageRoxygenize: rd,collate,namespace,vignette