'print' method for 'mtable' objects now shows a legend for significan…

…ce symbols.
melff · Nov 1, 2017 · 9a78988 · 9a78988
1 parent 31a4fea
commit 9a78988
Show file tree

Hide file tree

Showing 5 changed files with 48 additions and 9 deletions.
diff --git a/pkg/DESCRIPTION b/pkg/DESCRIPTION
@@ -2,7 +2,7 @@ Package: memisc
 Type: Package
 Title: Management of Survey Data and Presentation of Analysis Results
 Version: 0.99.15
-Date: 2017-10-31
+Date: 2017-11-01
 Author: Martin Elff (with contributions from Christopher N. Lawrence, Dave Atkins, Jason W. Morgan, Achim Zeileis)
 Maintainer: Martin Elff <memisc@elff.eu>
 Description: An infrastructure for the management of survey data including

diff --git a/pkg/R/mtable-format-print.R b/pkg/R/mtable-format-print.R
@@ -276,6 +276,17 @@ pf_mtable_format_print <- function(x,
     }
 
     res <- c(toprule,res,bottomrule)
+
+    signif.symbols <- x$signif.symbols
+    if(length(signif.symbols)){
+        signif.template <- getOption("signif.symbol.print.template",
+                                     signif.symbol.print.default.template)
+        signif.symbols <- format_signif_print(signif.symbols,
+                                              signif.template,
+                                              width=nchar(bottomrule)-2*nchar(padding))
+        signif.symbols <- paste0(padding,signif.symbols,padding)
+        res <- c(res,signif.symbols)
+    }
     res <- paste0(res,rowsep)
     return(res)
 }
@@ -299,3 +310,31 @@ pf_mtable_format_print <- function(x,
     l <- length(x)
     x[[l]]
 }
+
+format_signif_print <- function(syms,tmpl,width){
+    title <- tmpl[1]
+    clps <- tmpl[3]
+    tmpl <- tmpl[2]
+    res <- title
+    empty.title <- paste(rep(" ",nchar(title)),collapse="")
+
+    ns <- length(syms)
+    for(i in 1:ns){
+        sym <- names(syms)[i]
+        thrsh <- unname(syms[i])
+        res.i <- sub("$sym",sym,tmpl,fixed=TRUE)
+        res.i <- sub("$val",thrsh,res.i,fixed=TRUE)
+        if(i < ns)
+            res.i <- paste0(res.i,clps)
+        len <- length(res)
+        res.l <- res[len]
+        n.res.l <- nchar(res.l)
+        n.res.i <- nchar(res.i)
+        if(n.res.l+n.res.i <= width)
+            res[len] <- paste0(res.l,res.i)
+        else
+            res <- c(res,paste0(empty.title,res.i))
+    }
+    res
+}
+signif.symbol.print.default.template <- c("Significance: ","$sym = p < $val","; ")
diff --git a/pkg/R/mtable.R b/pkg/R/mtable.R
@@ -614,20 +614,17 @@ preformat_mtable <- function(x){
 
     needs.signif <- any(grepl("$p",ctemplate,fixed=TRUE))
     if(needs.signif){
-        signif.symbol.template <- getOption("signif.symbol.template",
-                                            c("p-values: ","$sym: p < $val","; "))
-        signif.legend <- format_signif(signif.symbols,
-                                        signif.symbol.template)
+        signif.symbols <- signif.symbols
     }
     else
-        signif.legend <- NULL
+        signif.symbols <- NULL
 
     structure(list(parmtab=parmtab,
                    leaders=leaders,
                    headers=headers,
                    sect.headers=sect.headers,
                    summary.stats = summary.stats,
-                   signif.legend=signif.legend),
+                   signif.symbols=signif.symbols),
               class="preformatted.memisc_mtable")
     }
 

diff --git a/pkg/R/zzz.R b/pkg/R/zzz.R
@@ -31,7 +31,7 @@ memisc_env <- environment()
           memisc.repr_latex=TRUE,
           mtable.always.eqnames=FALSE,
 
-          signif.symbol.template=c("p-values: ","$sym: p < $val","; "))
+          signif.symbol.print.template=signif.symbol.print.default.template)
 }
 
 

diff --git a/pkg/inst/ChangeLog b/pkg/inst/ChangeLog
@@ -1,5 +1,8 @@
+2017-11-11:
+   - 'print' method for 'mtable' objects now shows a legend for significance symbols.
+
 2017-10-31:
-   - Fixed (internal) `readChunk` method for fixed-format files with SPSS meta data.
+   - Fixed (internal) 'readChunk' method for fixed-format files with SPSS meta data.
 
 2017-10-21:
    - Implemented explicit option to control whether equation titles