├── .Rbuildignore ├── .gitattributes ├── .gitignore ├── .travis.yml ├── ChangeLog ├── DESCRIPTION ├── NAMESPACE ├── R ├── helpers.R ├── labels.R ├── plot.R ├── prettify.R ├── summarize.R └── toLatex.R ├── README.md ├── SOP_release.txt ├── appveyor.yml ├── copy_Rout_to_Routsave.R ├── inst ├── CITATION ├── CONTRIBUTIONS ├── COPYRIGHTS ├── NEWS.Rd └── SPSS │ └── data.sav ├── man ├── Anova.lme.Rd ├── confint.Rd ├── get_options.Rd ├── labels.data.frame.Rd ├── latex_table_cont.Rd ├── latex_table_fac.Rd ├── papeR-package.Rd ├── prettify.Rd ├── summarize.Rd ├── summarize_factor.Rd ├── summarize_numeric.Rd ├── toLatex.Rd └── xtable_summary.Rd ├── tests ├── Examples │ └── papeR-Ex.Rout.save ├── regtest-plot.R ├── regtest-summarize.R ├── testthat.R └── testthat │ ├── test-helpers.R │ ├── test-labels.R │ ├── test-prettify.R │ ├── test-summarize.R │ └── test-toLatex.R └── vignettes ├── graphics └── papeR_example_tables.Rnw ├── papeR_introduction.Rmd ├── papeR_with_latex.Rnw └── tables.png /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^\..* 2 | ^\.travis\.yml$ 3 | ^appveyor\.yml$ 4 | .*\.tar\.gz 5 | ^.*\.Rproj$ 6 | ^\.Rproj\.user$ 7 | \.Rhistory 8 | \.gitattributes 9 | appveyor.yml 10 | SOP_release.txt 11 | copy_Rout_to_Routsave.R 12 | tests/.*\.Rout\.save$ 13 | tests/testthat/bib.bib 14 | vignettes/auto 15 | vignettes/graphics -------------------------------------------------------------------------------- /.gitattributes: -------------------------------------------------------------------------------- 1 | * text=auto 2 | data/* binary 3 | src/* text=lf 4 | R/* text=lf -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Sample .travis.yml for R projects. 2 | # 3 | # See README.md for instructions, or for more configuration options, 4 | # see the wiki: 5 | # https://github.com/craigcitro/r-travis/wiki 6 | 7 | language: r 8 | sudo: required 9 | dist: trusty 10 | 11 | repos: 12 | CRAN: https://cloud.r-project.org 13 | 14 | before_install: 15 | - tlmgr install capt-of 16 | 17 | r_github_packages: 18 | - jimhester/covr 19 | 20 | after_failure: 21 | - ./travis-tool.sh dump_logs 22 | 23 | after_success: 24 | - Rscript -e 'library(covr); coveralls()' 25 | 26 | notifications: 27 | email: 28 | on_success: change 29 | on_failure: change 30 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: papeR 2 | Title: A Toolbox for Writing Pretty Papers and Reports 3 | Version: 1.0-6 4 | Date: 2025-04-01 5 | Authors@R: c(person(given = "Benjamin", family = "Hofner", role = c("aut", "cre"), 6 | email = "benjamin.hofner@pei.de", 7 | comment = c(ORCID = "0000-0003-2810-3186")), 8 | person("Romain", "Francois", role = "ctb"), 9 | person("Kurt", "Hornik", role = "ctb"), 10 | person("Martin", "Maechler", role = "ctb"), 11 | person("David", "Dahl", role = "ctb", comment = "see inst/CONTRIBUTIONS for details") 12 | ) 13 | Maintainer: Benjamin Hofner 14 | Description: A toolbox for writing 'knitr', 'Sweave' or other 'LaTeX'- or 'markdown'-based 15 | reports and to prettify the output of various estimated models. 16 | Depends: 17 | car, 18 | xtable 19 | Enhances: 20 | lme4, 21 | survival 22 | Imports: 23 | utils, 24 | gmodels, 25 | graphics, 26 | stats 27 | Suggests: 28 | nlme, 29 | knitr, 30 | rmarkdown, 31 | testthat (>= 0.10.0), 32 | foreign 33 | License: GPL-2 34 | URL: https://github.com/hofnerb/papeR 35 | Copyright: See inst/COPYRIGHTS. 36 | VignetteBuilder: knitr 37 | Collate: 38 | 'helpers.R' 39 | 'labels.R' 40 | 'summarize.R' 41 | 'plot.R' 42 | 'prettify.R' 43 | 'toLatex.R' 44 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | importFrom("car", "Anova") 2 | importFrom("utils", "citation", "sessionInfo", "toLatex", "toBibtex") 3 | importFrom("gmodels", "ci") 4 | importFrom("graphics", "abline", "barplot", "boxplot", "plot") 5 | importFrom("stats", "as.formula", "coef", "coefficients", "complete.cases", 6 | "fivenum", "lm", "qnorm", "qt", "sd", "symnum", "vcov") 7 | import(xtable) 8 | 9 | export(as.ldf, 10 | is.ldf, 11 | convert.labels, 12 | get_option, 13 | labels.data.frame, 14 | latex.table.cont, 15 | latex.table.fac, 16 | plot.ldf, 17 | prettify, 18 | prettifyPValue, 19 | summarize, summarise, 20 | summarize_numeric, summarize_factor, 21 | toLatex, 22 | toLatex.character, 23 | "labels<-") 24 | 25 | S3method(Anova, lme) 26 | S3method(confint, mer) 27 | S3method(as.ldf, data.frame) 28 | S3method(labels, lv) 29 | S3method(labels, data.frame) 30 | S3method(plot, ldf) 31 | S3method(prettify, summary.lm) 32 | S3method(prettify, summary.glm) 33 | S3method(prettify, summary.coxph) 34 | S3method(prettify, summary.coxph.penal) 35 | S3method(prettify, summary.lme) 36 | S3method(prettify, summary.mer) 37 | S3method(prettify, summary.merMod) 38 | S3method(prettify, anova) 39 | S3method(prettify, data.frame) 40 | S3method(prettify, summarize.factor) 41 | S3method(prettify, summarize.numeric) 42 | S3method(mySapply, default) 43 | S3method(mySapply, data.frame) 44 | S3method(xtable, summary) 45 | S3method(print, LatexBibtex) 46 | S3method(print, summary) 47 | S3method(print, xtable.summary) 48 | S3method(toLatex, default) 49 | S3method(toLatex, character) 50 | S3method(toLatex, sessionInfo) 51 | S3method(toLatex, LatexBibtex) 52 | S3method(toBibtex, LatexBibtex) 53 | -------------------------------------------------------------------------------- /R/helpers.R: -------------------------------------------------------------------------------- 1 | 2 | ################################################################################ 3 | # sapply function that differentiates between data.frames and (numeric) vectors 4 | mySapply <- function(object, FUN, ...) 5 | UseMethod("mySapply") 6 | 7 | mySapply.data.frame <- function(object, FUN, ...) { 8 | sapply(object, FUN, ...) 9 | } 10 | 11 | mySapply.default <- function(object, FUN, ...) { 12 | FUN(object, ...) 13 | } 14 | 15 | 16 | ################################################################################ 17 | # marginal anova function in the fashion of library(car) for mixed models 18 | Anova.lme <- function(mod, type = c("marginal", "sequential"), ...) { 19 | type <- match.arg(type) 20 | nlme::anova.lme(mod, type = type, ...) 21 | } 22 | 23 | ################################################################################ 24 | # add and get options from tables 25 | set_options <- function(object, ..., class) { 26 | attr(object, "table.options") <- list(...) 27 | class(object) <- c(class, class(object)) 28 | object 29 | } 30 | 31 | get_option <- function(object, name) { 32 | attr(object, "table.options")[[name]] 33 | } 34 | 35 | ## nocov start 36 | ## function for lme4 version < 1.0 only 37 | confint.mer <- function (object, parm, level = 0.95, 38 | simulate = c("ifneeded", TRUE, FALSE), 39 | B = 1000, ...) { 40 | 41 | simulate <- as.character(simulate) 42 | simulate <- match.arg(simulate) 43 | #tab <- as.data.frame(lme4::summary(object)@coefs) 44 | tab <- as.data.frame(summary(object)@coefs) 45 | wchZval <- match("z value", names(tab)) 46 | if (is.na(wchZval) && simulate == "FALSE") 47 | warning("Currently only asymptotic confidence intervals for ", sQuote("mer"), " models with ", 48 | sQuote("z values"), " are supported.\n", 49 | "Use simulated confidence intervals instead.") 50 | 51 | if (simulate == "TRUE" || (is.na(wchZval) && simulate == "ifneeded")) { 52 | ## use ci() from package gmodels 53 | CI <- ci(x = object, confidence = level, n.sim = B) 54 | ## extract conifidence intervals 55 | CI <- CI[parm, 2:3, drop = FALSE] 56 | return(CI) 57 | } 58 | 59 | cf <- lme4::fixef(object) 60 | pnames <- names(cf) 61 | if (missing(parm)) 62 | parm <- pnames 63 | else if (is.numeric(parm)) 64 | parm <- pnames[parm] 65 | a <- (1 - level)/2 66 | a <- c(a, 1 - a) 67 | pct <- format.perc(a, 3) 68 | fac <- qnorm(a) 69 | ci <- array(NA, dim = c(length(parm), 2L), 70 | dimnames = list(parm, pct)) 71 | ses <- sqrt(diag(as.matrix(vcov(object)))) 72 | names(ses) <- pnames 73 | ses <- ses[parm] 74 | ci[] <- cf[parm] + ses %o% fac 75 | ci 76 | } 77 | ## nocov end 78 | 79 | 80 | refit_model <- function(cl, ENV = globalenv(), summary, .call = "prettify") { 81 | 82 | if (!is.null(cl[["data"]]) && is.name(cl[["data"]]) && 83 | is.null(ENV[[as.character(cl[["data"]])]])) { 84 | 85 | return(FALSE) ## set confint = FALSE 86 | ## else: data might be a data.frame 87 | } 88 | if (is.null(cl[["data"]]) && 89 | any(sapply(all.vars(cl[["formula"]]), 90 | function(what) is.null(ENV[[what]])))) { 91 | 92 | return(FALSE) ## set confint = FALSE 93 | } 94 | mod <- eval(cl, envir = ENV) 95 | ## needed to really call summary from lme4 (< 1.0) 96 | if (inherits(mod, "mer")) { 97 | # ae <- all.equal(lme4::summary(mod), summary) 98 | ae <- all.equal(summary(mod), summary) 99 | } else { 100 | ae <- all.equal(summary(mod), summary) 101 | } 102 | 103 | if (!all(ae == TRUE)) 104 | warning(" In ", .call, ":\n", 105 | " Summary specified via argument ", sQuote("object"), 106 | " and summary of refitted model differ.\n", 107 | " Make shure that the data set has not been changed.\n", 108 | " Differences are:\n", 109 | paste(" ", ae, "\n"), call. = FALSE) 110 | 111 | return(mod) 112 | } 113 | 114 | ## modified version based on format.perc from package stats 115 | ## 116 | ## Copyright (C) 1994-2003 W. N. Venables and B. D. Ripley 117 | ## Copyright (C) 2003-2012 The R Core Team 118 | ## URL: http://cran.at.r-project.org/src/base/R-3/R-3.0.1.tar.gz 119 | ## Inside archive path: /src/library/stats/R/confint.R 120 | ## Licence of R package utils: >= GPL-2 121 | ## Author of the original function: Martin Maechler 122 | format.perc <- function(x, digits, ...) { 123 | txt <- format(100 * x, trim = TRUE, scientific = FALSE, digits = digits) 124 | paste(txt, "%") 125 | } 126 | 127 | 128 | ## Function that makes NAs to a new level with given label 129 | NAtoLvl <- function(x, na.lab) { 130 | if (any(is.na(x))) { 131 | lvls <- levels(x) 132 | x <- as.character(x) 133 | x[is.na(x)] <- na.lab 134 | return(factor(x, levels = c(lvls, na.lab))) 135 | } 136 | return(x) 137 | } 138 | 139 | ## make sure no fatcor level is dropped if grouped latex.table.fac is computed 140 | keep_levels <- function(sub_data, complete_data) { 141 | for (i in 1:ncol(sub_data)) { 142 | if (is.factor(sub_data[, i])) { 143 | sub_data[, i] <- factor(sub_data[, i], levels = levels(complete_data[, i])) 144 | } 145 | } 146 | return(sub_data) 147 | } 148 | 149 | 150 | ## check which in labels() function 151 | check_which <- function(which, data, what) { 152 | if (is.null(which)) 153 | which <- 1:ncol(data) 154 | 155 | if (is.numeric(which) && (any(which > ncol(data)) || 156 | any(which < 1) || 157 | !all(which %% 1 == 0))) 158 | stop("One cannot ", what, " labels for none-existing variables", 159 | call. = FALSE) 160 | 161 | if (is.character(which) && !all(which %in% colnames(data))) { 162 | txt <- paste0("One cannot ", what, " labels for none-existing variables\n", 163 | " Variables not found in data set:\n\t", 164 | paste(which[!(which %in% colnames(data))], 165 | collapse = "\n\t")) 166 | stop(txt, call. = FALSE) 167 | } 168 | return(which) 169 | } 170 | 171 | ## get labels from a data set 172 | get_labels <- function(x) 173 | attr(x, "variable.label") 174 | -------------------------------------------------------------------------------- /R/labels.R: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ## Author: Benjamin Hofner, benjamin.hofner@fau.de 3 | 4 | ################################################################################ 5 | # Extract labels from data sets 6 | labels.data.frame <- function(object, which = NULL, abbreviate = FALSE, ...) { 7 | 8 | ## if no labels were properly set use alternative methods to specify labels: 9 | if (!is.ldf(object)) { 10 | ## if no labels specified temporarily set names as labels 11 | if (is.null(attr(object, "variable.labels"))) { 12 | labels(object) <- colnames(object) 13 | } else { 14 | ## clean labels 15 | object <- CLEAN_LABELS(object) 16 | ## set these labels temporarily as elementwise labels 17 | labels(object) <- attr(object, "variable.labels") 18 | } 19 | } 20 | 21 | ## which labels should be extracted? 22 | which <- check_which(which, object, "extract") 23 | 24 | ## now extract labels 25 | RET <- sapply(as.data.frame(object)[which], get_labels) 26 | ## fix non-existing labels 27 | if (is.list(RET) && any(idx_null <- sapply(RET, is.null))) { 28 | nms <- colnames(object) 29 | if (is.character(which)) 30 | names(nms) <- nms 31 | RET[idx_null] <- nms[which][idx_null] 32 | RET <- unlist(RET) 33 | } 34 | 35 | ## should labels be abbreviated? 36 | if (abbreviate) { 37 | nms <- names(RET) 38 | RET <- abbreviate(RET, ...) 39 | names(RET) <- nms 40 | } 41 | return(RET) 42 | } 43 | 44 | ################################################################################ 45 | # Extract labels from labeled variables 46 | labels.lv <- function(object, abbreviate = FALSE, ...) { 47 | RET <- get_labels(object) 48 | ## should labels be abbreviated? 49 | if (abbreviate) { 50 | nms <- names(RET) 51 | RET <- abbreviate(RET, ...) 52 | names(RET) <- nms 53 | } 54 | RET 55 | } 56 | 57 | ################################################################################ 58 | # Sets labels 59 | "labels<-" <- function(data, which = NULL, value){ 60 | 61 | which <- check_which(which, data, "define") 62 | 63 | if (!is.null(value)) { 64 | if (length(which) != length(value)) 65 | stop("One must supply a label for each _selected_ column of the data set.") 66 | if (is.character(which)) 67 | names(value) <- which 68 | } 69 | 70 | for (i in seq_along(which)) { 71 | attr(data[[which[i]]], "variable.label") <- value[[i]] 72 | class(data[[which[i]]]) <- c("lv", class(data[[which[i]]])) 73 | } 74 | 75 | ## remove attribute of data set if it exists 76 | if (!is.null(attr(data, "variable.labels"))) 77 | attr(data, "variable.labels") <- NULL 78 | 79 | class(data) <- c("ldf", class(data)) 80 | return(data) 81 | } 82 | 83 | "labels[<-" <- function(data, i, value) 84 | labels(data, which = i) <- value 85 | 86 | 87 | CLEAN_LABELS <- function(data) { 88 | ## drop spare labels 89 | spare <- !(names(attr(data, "variable.labels")) %in% names(data)) 90 | if (any(spare)) { 91 | message("Note: Variables have been removed or label names and ", 92 | "column names don't match. ", 93 | "Corresponding variable labels are removed.") 94 | attr(data, "variable.labels") <- attr(data, "variable.labels")[!spare] 95 | } 96 | ## add missing labels 97 | missing <- !(names(data) %in% names(attr(data, "variable.labels"))) 98 | if (any(missing)) { 99 | tmp <- names(data)[missing] 100 | names(tmp) <- names(data)[missing] 101 | attr(data, "variable.labels") <- c(attr(data, "variable.labels"), 102 | tmp) 103 | } 104 | ## re-order 105 | attr(data, "variable.labels") <- attr(data, "variable.labels")[names(data)] 106 | ## return altered data set 107 | return(data) 108 | } 109 | 110 | 111 | ## define coercion function 112 | as.ldf <- function(object, ...) 113 | UseMethod("as.ldf") 114 | 115 | as.ldf.data.frame <- function(object, ...) { 116 | labels(object) <- labels(object) 117 | object 118 | } 119 | 120 | convert.labels <- function(object) 121 | as.ldf.data.frame(object) 122 | 123 | is.ldf <- function(object) 124 | !all(sapply(lapply(object, get_labels), is.null)) 125 | -------------------------------------------------------------------------------- /R/plot.R: -------------------------------------------------------------------------------- 1 | ## plot function for (labeled) data frames 2 | 3 | ## now specify modified plot function for data frames 4 | plot.ldf <- function(x, variables = names(x), 5 | labels = TRUE, by = NULL, 6 | with = NULL, regression.line = TRUE, 7 | line.col = "red", ...) { 8 | 9 | if (is.numeric(variables)) { 10 | variables <- names(x)[variables] 11 | } 12 | 13 | if (!is.null(with)) { 14 | if (!is.null(by)) 15 | stop("One can only specify either ", sQuote("by"), " or ", 16 | sQuote("with")) 17 | by <- with 18 | } 19 | 20 | if (is.numeric(by)) { 21 | by <- names(x)[by] 22 | } 23 | 24 | if (!all(c(by, variables) %in% names(x))) 25 | stop("(Some of the) specified variables are not available in x") 26 | 27 | ## set up labels 28 | if (is.null(labels)) { 29 | labels <- variables 30 | } else { 31 | if (is.logical(labels) && labels) { 32 | labels <- labels(x, which = variables) 33 | if (!is.null(by)) 34 | grp_label <- labels(x, which = by) 35 | } else { 36 | if (length(variables) != length(labels)) 37 | stop(sQuote("variables"), " and ", sQuote("labels"), 38 | " must have the same length") 39 | } 40 | } 41 | 42 | if (!is.null(by)) { 43 | if(!is.factor(x[, by]) && !is.numeric(x[, by])) 44 | stop(sQuote("by"), " must specify a factor or numeric variable") 45 | if (by %in% variables) { 46 | idx <- variables != by 47 | variables <- variables[idx] 48 | labels <- labels[idx] 49 | } 50 | by_var <- x[, by] 51 | } 52 | 53 | x <- x[, variables, drop = FALSE] 54 | 55 | ## get numerical variables 56 | num <- mySapply(x, is.numeric) 57 | fac <- mySapply(x, is.factor) 58 | 59 | ## if anything else is present (not num or fac) 60 | if (!all(num | fac)) 61 | warning("Only numeric or factor variables are plotted") 62 | 63 | which.num <- which(num) 64 | which.fac <- which(fac) 65 | 66 | if (is.null(by)) { 67 | for (i in which.num) { 68 | boxplot(x[, i], main = variables[i], ylab = labels[i], ...) 69 | } 70 | for (i in which.fac) { 71 | barplot(table(x[, i]), 72 | main = variables[i], ylab = labels[i], ...) 73 | } 74 | } else { 75 | grp_label <- ifelse(!is.null(grp_label), grp_label, by) 76 | if (is.factor(by_var)) { 77 | for (i in which.num) { 78 | cc <- complete.cases(x[, i], by_var) 79 | tmp_by_var <- by_var[cc, drop = TRUE] 80 | boxplot(x[cc, i] ~ tmp_by_var, main = variables[i], 81 | ylab = labels[i], xlab = grp_label, ...) 82 | } 83 | for (i in which.fac) { 84 | cc <- complete.cases(x[, i], by_var) 85 | tmp_by_var <- by_var[cc, drop = TRUE] 86 | plot(tmp_by_var, x[cc, i], main = variables[i], 87 | ylab = labels[i], xlab = grp_label, ...) 88 | } 89 | } else { ## i.e. is.numeric(by_var) 90 | for (i in which.num) { 91 | cc <- complete.cases(x[, i], by_var) 92 | tmp_by_var <- by_var[cc, drop = TRUE] 93 | graphics::plot.default(x[cc, i], tmp_by_var, main = variables[i], 94 | xlab = labels[i], ylab = grp_label, ...) 95 | if (regression.line) 96 | abline(lm(tmp_by_var ~ x[cc, i]), col = line.col) 97 | } 98 | for (i in which.fac) { 99 | cc <- complete.cases(x[, i], by_var) 100 | tmp_by_var <- by_var[cc, drop = TRUE] 101 | boxplot(tmp_by_var ~ x[cc, i], main = variables[i], 102 | xlab = labels[i], ylab = grp_label, ...) 103 | } 104 | } 105 | } 106 | } 107 | -------------------------------------------------------------------------------- /R/prettify.R: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | ## Author: Benjamin Hofner, benjamin.hofner@fau.de 3 | 4 | ################################################################################ 5 | # Prettify function for summary tables 6 | prettify <- function(object, ...) 7 | UseMethod("prettify") 8 | 9 | prettify.summary.lm <- function(object, labels = NULL, sep = ": ", extra.column = FALSE, 10 | confint = TRUE, level = 0.95, 11 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 12 | signif.stars = getOption("show.signif.stars"), ...) { 13 | 14 | .call <- match.call() 15 | res <- as.data.frame(coef(object)) 16 | 17 | ## compute confidence interval or extract it from confint 18 | if (is.logical(confint)) { 19 | if (confint) { 20 | mod <- refit_model(cl = object$call, 21 | ENV = attr(object$terms, ".Environment"), 22 | summary = object, .call = .call) 23 | if (is.logical(mod)) { 24 | ## model could not be refitted, i.e., mod == FALSE 25 | confint <- mod 26 | } else { 27 | CI <- confint(mod, level = level) 28 | } 29 | } 30 | } else { 31 | CI <- confint 32 | confint <- TRUE 33 | } 34 | 35 | if (confint){ 36 | res$CI_lower <- CI[,1] 37 | res$CI_upper <- CI[,2] 38 | ## move confint to the front 39 | newVars <- (ncol(res) -1):ncol(res) 40 | res <- cbind(res[, 1, drop = FALSE], 41 | res[, newVars], 42 | res[, - c(1, newVars)]) 43 | names(res)[2] <- "CI (lower)" 44 | names(res)[3] <- "CI (upper)" 45 | } 46 | 47 | ## use variable names as labels 48 | if (is.null(labels)) { 49 | labels <- names(attr(object$terms, "dataClasses")) 50 | names(labels) <- labels 51 | } 52 | 53 | prettify(res, labels = labels, sep = sep, extra.column = extra.column, 54 | smallest.pval = smallest.pval, digits = digits, 55 | scientific = scientific, signif.stars = signif.stars, ...) 56 | } 57 | 58 | prettify.summary.glm <- function(object, labels = NULL, sep = ": ", extra.column = FALSE, 59 | confint = TRUE, level = 0.95, OR = TRUE, 60 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 61 | signif.stars = getOption("show.signif.stars"), 62 | ...) { 63 | 64 | .call <- match.call() 65 | res <- as.data.frame(coef(object)) 66 | if (OR <- (object$family$family == "binomial" && OR)) { 67 | res$OR <- exp(res$Estimate) 68 | } 69 | 70 | ## compute confidence interval or extract it from confint 71 | if (is.logical(confint)) { 72 | if (confint) { 73 | mod <- refit_model(cl = object$call, 74 | ENV = attr(object$terms, ".Environment"), 75 | summary = object, .call = .call) 76 | if (is.logical(mod)) { 77 | ## model could not be refitted, i.e., mod == FALSE 78 | confint <- mod 79 | } else { 80 | CI <- confint(mod, level = level) 81 | } 82 | } 83 | } else { 84 | CI <- confint 85 | confint <- TRUE 86 | } 87 | 88 | if (confint){ 89 | if (OR) { 90 | res$CI_lower <- exp(CI[,1]) 91 | res$CI_upper <- exp(CI[,2]) 92 | ## move confint to the front 93 | newVars <- (ncol(res) - 2):ncol(res) 94 | res <- cbind(res[, 1, drop = FALSE], 95 | res[, newVars], 96 | res[, - c(1, newVars)]) 97 | names(res)[2] <- "Odds Ratio" 98 | names(res)[3] <- "CI (lower)" 99 | names(res)[4] <- "CI (upper)" 100 | } else { 101 | res$CI_lower <- CI[,1] 102 | res$CI_upper <- CI[,2] 103 | ## move confint to the front 104 | newVars <- (ncol(res) -1):ncol(res) 105 | res <- cbind(res[, 1, drop = FALSE], 106 | res[, newVars], 107 | res[, - c(1, newVars)]) 108 | names(res)[2] <- "CI (lower)" 109 | names(res)[3] <- "CI (upper)" 110 | } 111 | } 112 | 113 | ## use variable names as labels 114 | if (is.null(labels)) { 115 | labels <- names(attr(object$terms, "dataClasses")) 116 | names(labels) <- labels 117 | } 118 | 119 | prettify(res, labels = labels, sep = sep, extra.column = extra.column, 120 | smallest.pval = smallest.pval, digits = digits, 121 | scientific = scientific, signif.stars = signif.stars, ...) 122 | } 123 | 124 | prettify.summary.coxph.penal <- prettify.summary.coxph <- 125 | function(object, labels = NULL, sep = ": ", extra.column = FALSE, 126 | confint = TRUE, level = 0.95, HR = TRUE, 127 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 128 | signif.stars = getOption("show.signif.stars"), 129 | env = parent.frame(), ...) { 130 | 131 | .call <- match.call() 132 | res <- as.data.frame(coef(object)) 133 | if (!HR) { 134 | res$"exp(coef)" <- NULL 135 | } else { 136 | if (is.null(res$"exp(coef)")) 137 | res$"exp(coef)" <- exp(res$coef) 138 | } 139 | if (is.null(labels) || (is.logical(confint) && confint)) { 140 | mod <- refit_model(cl = object$call, ENV = env, 141 | summary = object, .call = .call) 142 | } 143 | if (is.null(labels) && is.logical(mod)) 144 | stop("Model can't be refitted and no labels are specified. ", 145 | "Please specify labels.") 146 | 147 | 148 | ## compute confidence interval or extract it from confint 149 | if (is.logical(confint)) { 150 | if (confint) { 151 | if (is.logical(mod)) { 152 | ## model could not be refitted, i.e., mod == FALSE 153 | confint <- mod 154 | } else { 155 | CI <- confint(mod, level = level) 156 | } 157 | } 158 | } else { 159 | CI <- confint 160 | confint <- TRUE 161 | } 162 | 163 | if (confint){ 164 | message("Confidence intervals are experimental only;\n", 165 | "Model refitted but original environment not available.\n") 166 | res$CI_upper <- res$CI_lower <- NA 167 | if (HR) { 168 | res$CI_lower[1:nrow(CI)] <- exp(CI[,1]) 169 | res$CI_upper[1:nrow(CI)] <- exp(CI[,2]) 170 | ## move confint to the front 171 | res <- cbind(res[, c("coef", "exp(coef)"), drop = FALSE], 172 | res[, c("CI_lower", "CI_upper")], 173 | res[, !colnames(res) %in% c("coef", "exp(coef)", "CI_lower", "CI_upper", "se2")]) 174 | names(res)[2] <- "Hazard Ratio" 175 | names(res)[3] <- "CI (lower)" 176 | names(res)[4] <- "CI (upper)" 177 | } else { 178 | res$CI_lower[1:nrow(CI)] <- CI[,1] 179 | res$CI_upper[1:nrow(CI)] <- CI[,2] 180 | ## move confint to the front 181 | res <- cbind(res[, c("coef"), drop = FALSE], 182 | res[, c("CI_lower", "CI_upper")], 183 | res[, !colnames(res) %in% c("coef", "CI_lower", "CI_upper", "se2")]) 184 | names(res)[2] <- "CI (lower)" 185 | names(res)[3] <- "CI (upper)" 186 | } 187 | } 188 | 189 | ## use variable names as labels 190 | if (is.null(labels)) { 191 | labels <- names(attr(mod$terms, "dataClasses")) 192 | names(labels) <- labels 193 | } 194 | 195 | prettify(res, labels = labels, sep = sep, extra.column = extra.column, 196 | smallest.pval = smallest.pval, digits = digits, 197 | scientific = scientific, signif.stars = signif.stars, ...) 198 | } 199 | 200 | prettify.summary.lme <- function(object, labels = NULL, sep = ": ", extra.column = FALSE, 201 | confint = TRUE, level = 0.95, 202 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 203 | signif.stars = getOption("show.signif.stars"), 204 | ...) { 205 | 206 | .call <- match.call() 207 | res <- as.data.frame(object$tTable) 208 | 209 | ## compute confidence interval or extract it from confint 210 | if (is.logical(confint)) { 211 | if (confint) { 212 | mod <- refit_model(cl = object$call, 213 | ENV = attr(object$terms, ".Environment"), 214 | summary = object, .call = .call) 215 | if (is.logical(mod)) { 216 | ## model could not be refitted, i.e., mod == FALSE 217 | confint <- mod 218 | } else { 219 | CI <- nlme::intervals(mod, level = level, which = "fixed")$fixed[, c("lower", "upper")] 220 | } 221 | } 222 | } else { 223 | CI <- confint 224 | confint <- TRUE 225 | } 226 | 227 | if (confint){ 228 | res$CI_lower <- CI[,1] 229 | res$CI_upper <- CI[,2] 230 | ## move confint to the front 231 | newVars <- (ncol(res) -1):ncol(res) 232 | res <- cbind(res[, 1, drop = FALSE], 233 | res[, newVars], 234 | res[, - c(1, newVars)]) 235 | names(res)[2] <- "CI (lower)" 236 | names(res)[3] <- "CI (upper)" 237 | } 238 | 239 | ## use variable names as labels 240 | if (is.null(labels)) { 241 | labels <- names(attr(object$terms, "dataClasses")) 242 | names(labels) <- labels 243 | } 244 | 245 | prettify(res, labels = labels, sep = sep, extra.column = extra.column, 246 | smallest.pval = smallest.pval, digits = digits, 247 | scientific = scientific, signif.stars = signif.stars, ...) 248 | } 249 | 250 | prettify.summary.merMod <- function(object, 251 | labels = NULL, sep = ": ", extra.column = FALSE, 252 | confint = TRUE, level = 0.95, 253 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 254 | signif.stars = getOption("show.signif.stars"), 255 | method = c("profile", "Wald", "boot"), B = 1000, 256 | env = parent.frame(), ...) { 257 | 258 | .call <- match.call() 259 | res <- as.data.frame(coefficients(object)) 260 | 261 | if (is.null(labels) || (is.logical(confint) && confint)) { 262 | mod <- refit_model(cl = object$call, ENV = env, 263 | summary = object, .call = .call) 264 | } 265 | if (is.null(labels) && is.logical(mod)) 266 | stop("Model can't be refitted and no labels are specified. ", 267 | "Please specify labels.") 268 | 269 | ## compute confidence interval or extract it from confint 270 | if (is.logical(confint)) { 271 | if (confint) { 272 | if (is.logical(mod)) { 273 | ## model could not be refitted, i.e., mod == FALSE 274 | confint <- mod 275 | } else { 276 | CI <- confint(mod, level = level, method = method, nsim = B, 277 | ...)[rownames(res), ] 278 | } 279 | } 280 | } else { 281 | CI <- confint 282 | confint <- TRUE 283 | } 284 | 285 | if (confint){ 286 | message("Confidence intervals are experimental only;\n", 287 | "Model refitted but original environment not available.\n") 288 | res$CI_lower <- CI[,1] 289 | res$CI_upper <- CI[,2] 290 | ## move confint to the front 291 | newVars <- (ncol(res) -1):ncol(res) 292 | res <- cbind(res[, 1, drop = FALSE], 293 | res[, newVars], 294 | res[, - c(1, newVars)]) 295 | names(res)[2] <- "CI (lower)" 296 | names(res)[3] <- "CI (upper)" 297 | } 298 | 299 | ## use variable names as labels 300 | if (is.null(labels)) { 301 | labels <- names(attr(attr(mod@frame, "terms"), "dataClasses")) 302 | names(labels) <- labels 303 | } 304 | 305 | prettify(res, labels = labels, sep = sep, extra.column = extra.column, 306 | smallest.pval = smallest.pval, digits = digits, 307 | scientific = scientific, signif.stars = signif.stars, ...) 308 | } 309 | 310 | ## nocov start (exclude this function from test coverage) 311 | ## function for lme4 version < 1.0 only 312 | prettify.summary.mer <- function(object, 313 | labels = NULL, sep = ": ", extra.column = FALSE, 314 | confint = TRUE, level = 0.95, 315 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 316 | signif.stars = getOption("show.signif.stars"), 317 | simulate = c("ifneeded", TRUE, FALSE), B = 1000, ...) { 318 | 319 | .call <- match.call() 320 | res <- as.data.frame(object@coefs) 321 | 322 | ## compute confidence interval or extract it from confint 323 | if (is.logical(confint)) { 324 | if (confint) { 325 | mod <- refit_model(cl = object@call, 326 | ENV = attr(attr(object@frame, "terms"), ".Environment"), 327 | summary = object, .call = .call) 328 | if (is.logical(mod)) { 329 | ## model could not be refitted, i.e., mod == FALSE 330 | confint <- mod 331 | } else { 332 | CI <- confint(mod, level = level, simulate = simulate, B = B, ...) 333 | } 334 | } 335 | } else { 336 | CI <- confint 337 | confint <- TRUE 338 | } 339 | 340 | if (confint){ 341 | res$CI_lower <- CI[,1] 342 | res$CI_upper <- CI[,2] 343 | ## move confint to the front 344 | newVars <- (ncol(res) -1):ncol(res) 345 | res <- cbind(res[, 1, drop = FALSE], 346 | res[, newVars], 347 | res[, - c(1, newVars)]) 348 | names(res)[2] <- "CI (lower)" 349 | names(res)[3] <- "CI (upper)" 350 | } 351 | 352 | ## use variable names as labels 353 | if (is.null(labels)) { 354 | labels <- names(attr(attr(object@frame, "terms"), "dataClasses")) 355 | names(labels) <- labels 356 | } 357 | 358 | prettify(res, labels = labels, sep = sep, extra.column = extra.column, 359 | smallest.pval = smallest.pval, digits = digits, 360 | scientific = scientific, signif.stars = signif.stars, ...) 361 | } 362 | ## nocov end 363 | 364 | prettify.anova <- function(object, labels = NULL, 365 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 366 | signif.stars = getOption("show.signif.stars"), ...){ 367 | 368 | res <- as.data.frame(object) 369 | res <- prettifyPValue(res, smallest.pval, digits, scientific, signif.stars, ...) 370 | 371 | res$varlabel <- dimnames(object)[[1]] 372 | res$varlabel <- as.character(res$varlabel) 373 | newVars <- ncol(res) 374 | res <- cbind(res[, newVars], 375 | res[, - newVars]) 376 | names(res)[1] <- " " 377 | rownames(res) <- NULL 378 | 379 | if (!is.null(labels)) { 380 | idx <- res[, 1] %in% names(labels) 381 | if (any(idx == TRUE)) 382 | res[, 1] <- as.character(res[, 1]) 383 | res[idx, 1] <- labels[res[idx, 1]] 384 | } 385 | 386 | res <- res[!apply(res, 1, function(x) any(is.na(x))), ] 387 | res 388 | } 389 | 390 | prettify.data.frame <- function(object, labels = NULL, sep = ": ", extra.column = FALSE, 391 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 392 | signif.stars = getOption("show.signif.stars"), 393 | ...) { 394 | ## get row names 395 | nms <- new_nms <- rownames(object) 396 | 397 | if (is.null(labels)) { 398 | if (extra.column) 399 | warning(sQuote("extra.column"), 400 | " can only be used if labels are specified") 401 | extra.column <- FALSE 402 | } else { 403 | ## order labels to avoid matching with substrings 404 | labels <- labels[rev(order(sapply(names(labels), nchar)))] 405 | } 406 | 407 | ## make extra column for factor levels if needed 408 | if (extra.column) { 409 | object$varlabel <- " " 410 | object$"FactorLevel" <- " " 411 | ## move Factor Levels to the front 412 | newVars <- (ncol(object) -1):ncol(object) 413 | object <- cbind(object[, newVars], 414 | object[, - newVars]) 415 | names(object)[1] <- " " 416 | object[,1] <- as.character(object[,1]) 417 | names(object)[2] <- "Factor Level" 418 | object[,2] <- as.character(object[,2]) 419 | } else { 420 | object$varlabel <- new_nms 421 | newVars <- ncol(object) 422 | object <- cbind(object[, newVars], 423 | object[, - newVars]) 424 | names(object)[1] <- " " 425 | object[,1] <- as.character(object[,1]) 426 | } 427 | 428 | if (!is.null(labels)) { 429 | for (i in 1:length(labels)) { 430 | idx <- grep(names(labels)[i], nms) 431 | if (!length(idx) == 0){ 432 | ## Is there a factor level? 433 | if (any(grepl(paste("^",names(labels)[i], "$", sep = ""), nms[idx]))) { 434 | ## if not replace variable names with labels 435 | new_nms[idx] <- gsub(names(labels)[i], labels[i], nms[idx]) 436 | } else { 437 | ## if factors are present separate variable name and factor 438 | ## level 439 | if (extra.column) { 440 | ## replace variable name with label and discard 441 | ## everything else 442 | new_nms[idx] <- gsub(paste("^",names(labels)[i], "(.*)", sep = ""), 443 | labels[i], 444 | nms[idx]) 445 | ## remove duplicate variable labels 446 | new_nms[idx][duplicated(new_nms[idx])] <- "" 447 | ## extract variable levels 448 | object[idx, 2] <- gsub(paste("^",names(labels)[i], "(.*)", sep = ""), 449 | "\\1", 450 | nms[idx]) 451 | } else { 452 | new_nms[idx] <- gsub(paste("^",names(labels)[i], "(.*)", sep = ""), 453 | paste(labels[i], sep, "\\1", sep = ""), 454 | nms[idx]) 455 | } 456 | } 457 | nms[idx] <- "" 458 | } 459 | } 460 | } 461 | object[, 1] <- new_nms 462 | rownames(object) <- NULL 463 | 464 | object <- prettifyPValue(object, smallest.pval, digits, scientific, 465 | signif.stars, ...) 466 | 467 | object 468 | 469 | } 470 | 471 | 472 | ### helper for pretty p-values and other numerical values 473 | prettifyPValue <- function(object, 474 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 475 | signif.stars = getOption("show.signif.stars"), ...) { 476 | 477 | wchPval <- grep("Pr(.*)|p-value|^p$", names(object)) 478 | if (length(wchPval) != 0) { 479 | if (signif.stars) { 480 | object$signif <- symnum(object[, wchPval], corr = FALSE, na = FALSE, 481 | cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1), 482 | symbols = c("***", "**", "*", ".", " ")) 483 | names(object)[names(object) == "signif"] <- " " 484 | } 485 | r.digits <- 10 486 | num <- strsplit(as.character(smallest.pval), "\\.")[[1]] 487 | if (!is.null(num[2])) 488 | r.digits <- nchar(num[2]) 489 | object[, wchPval] <- format.pval(round(object[, wchPval], digits = r.digits), 490 | digits = digits, scientific = scientific, 491 | eps = smallest.pval, ...) 492 | } 493 | 494 | if (!is.null(digits)) { 495 | object[-wchPval] <- sapply(object[-wchPval], function(col) 496 | formatC(col, digits = digits, flag = "#", ...)) 497 | } 498 | 499 | object 500 | } 501 | -------------------------------------------------------------------------------- /R/toLatex.R: -------------------------------------------------------------------------------- 1 | ## functions for coercion to LaTeX "objects" 2 | 3 | ## overwrite standard generic 4 | toLatex <- function(object, ...) 5 | UseMethod("toLatex") 6 | 7 | ## per default fall back to standard generic 8 | toLatex.default <- function(object, ...) 9 | utils::toLatex(object, ...) # nocov 10 | 11 | ## modified version based on sanitize subroutine defined in 12 | ## R package xtable (Version 1.7-1) inside function print.xtable 13 | ## 14 | ## URL of original package: http://CRAN.R-project.org/package=xtable 15 | ## Authors of R package xtable (inlcuding print.xtable): 16 | ## David Dahl with contributions and 17 | ## suggestions from many others (see source code). 18 | ## 19 | ## Licence of R package xtable: GPL-2 | GPL-3 20 | toLatex.character <- function(object, ...) { 21 | result <- object 22 | result <- gsub("$\\sum$", "SUM", result, fixed = TRUE) 23 | result <- gsub("\\\\", "SANITIZE.BACKSLASH", result) 24 | result <- gsub("$", "\\$", result, fixed = TRUE) 25 | result <- gsub(">=", "$\\geq$", result, fixed = TRUE) 26 | result <- gsub("<=", "$\\leq$", result, fixed = TRUE) 27 | result <- gsub(">", "$>$", result, fixed = TRUE) 28 | result <- gsub("<", "$<$", result, fixed = TRUE) 29 | result <- gsub("|", "$|$", result, fixed = TRUE) 30 | result <- gsub("{", "\\{", result, fixed = TRUE) 31 | result <- gsub("}", "\\}", result, fixed = TRUE) 32 | result <- gsub("%", "\\%", result, fixed = TRUE) 33 | result <- gsub("&", "\\&", result, fixed = TRUE) 34 | result <- gsub("_", "\\_", result, fixed = TRUE) 35 | result <- gsub("#", "\\#", result, fixed = TRUE) 36 | ## a^NOT_A_NUMBER 37 | result <- gsub("\\^([^[:digit:]])", "\\\\verb|^|\\1", result) 38 | result <- gsub("\\^([[:digit:]]+)", "$^{\\1}$", result) 39 | result <- gsub("~", "\\~{}", result, fixed = TRUE) 40 | ## grep for ^2 and ^3 41 | result <- gsub("\u00B2", "$^2$", result, fixed = TRUE) 42 | result <- gsub("\u00B3", "$^3$", result, fixed = TRUE) 43 | result <- gsub("SANITIZE.BACKSLASH", "$\\backslash$", 44 | result, fixed = TRUE) 45 | result <- gsub("SUM", "$\\sum$", result, fixed = TRUE) 46 | return(result) 47 | } 48 | 49 | 50 | ## modified version based on toLatex.sessionInfo from package utils 51 | ## 52 | ## Copyright (C) 1995-2013 The R Core Team 53 | ## URL: http://cran.at.r-project.org/src/base/R-3/R-3.0.1.tar.gz 54 | ## Inside archive path: /src/library/utils/R/sessionInfo.R 55 | ## Licence of R package utils: >= GPL-2 56 | ## 57 | ## with major changes and modifications by Benjamin Hofner 58 | toLatex.sessionInfo <- function(object, pkgs = NULL, locale = FALSE, 59 | base.pkgs = FALSE, other.pkgs = TRUE, 60 | namespace.pkgs = FALSE, citations = TRUE, 61 | citecommand = "\\citep", file = NULL, 62 | append = FALSE, ...) { 63 | if (!is.null(pkgs)) { 64 | object <- sessionInfo(package = pkgs) 65 | if (!other.pkgs) 66 | warning(sQuote("other.pkgs"), " should be TRUE if ", 67 | sQuote("pkgs"), " is specified.") 68 | } 69 | 70 | opkgver <- sapply(object$otherPkgs, function(x) x$Version) 71 | nspkgver <- sapply(object$loadedOnly, function(x) x$Version) 72 | key <- NULL 73 | 74 | if (citations) { 75 | bibs <- write.bib("base", file = file, append = append, verbose = FALSE) 76 | all_bibs <- bibs 77 | key <- bibs$key 78 | } 79 | 80 | z <- c("\\begin{itemize}\\raggedright", 81 | paste0(" \\item ", object$R.version$version.string, 82 | if (citations) 83 | paste0(citecommand, "{", key, "}"))) 84 | 85 | if (locale) { 86 | z <- c(z, paste0(" \\item Locale: \\verb|", 87 | gsub(";", "|, \\\\verb|", object$locale), "|")) 88 | } 89 | 90 | if (base.pkgs) { 91 | z <- c(z, strwrap(paste("\\item Base packages: ", 92 | paste(sort(object$basePkgs), collapse = ", ")), 93 | indent = 2, exdent = 4)) 94 | } 95 | if (other.pkgs && length(opkgver)) { 96 | if (is.null(pkgs)) 97 | opkgver <- opkgver[sort(names(opkgver))] 98 | if (citations) { 99 | bibs <- write.bib(names(opkgver), file = file, append = TRUE, 100 | verbose = FALSE) 101 | all_bibs <- c(all_bibs, bibs) 102 | key <- bibs$key 103 | } 104 | z <- c(z, " \\item Used packages: ", " \\begin{itemize}", 105 | formatPkgs(names(opkgver), opkgver, key), " \\end{itemize}") 106 | } 107 | if (namespace.pkgs && length(nspkgver)) { 108 | nspkgver <- nspkgver[sort(names(nspkgver))] 109 | if (citations) { 110 | bibs <- write.bib(names(nspkgver), file = file, append = TRUE, 111 | verbose = FALSE) 112 | all_bibs <- c(all_bibs, bibs) 113 | key <- bibs$key 114 | } 115 | z <- c(z, " \\item Loaded via a namespace (and not attached): ", 116 | " \\begin{itemize}", 117 | formatPkgs(names(nspkgver), nspkgver, key), " \\end{itemize}") 118 | } 119 | z <- c(z, "\\end{itemize}") 120 | 121 | if (citations && !is.null(file)) { 122 | message("Written ", length(all_bibs), " BibTeX entries to file '", file, 123 | "' ...") 124 | message("Use \\bibliography{", file, "} to include citations.\n\n") 125 | } 126 | if (citations && is.null(file)) { 127 | attr(z, "BibTeX") <- all_bibs 128 | class(z) <- c("LatexBibtex", "Latex") 129 | return(z) 130 | } else { 131 | class(z) <- "Latex" 132 | return(z) 133 | } 134 | } 135 | 136 | print.LatexBibtex <- function(x, ...) { 137 | NextMethod("print", x) 138 | cat("\n\n") 139 | print(attr(x, "BibTeX")) 140 | invisible(x) 141 | } 142 | 143 | toLatex.LatexBibtex <- function(object, ...) { 144 | attributes(object) <- NULL 145 | class(object) <- "Latex" 146 | object 147 | } 148 | 149 | toBibtex.LatexBibtex <- function(object, ...) { 150 | object <- toBibtex(attr(object, "BibTeX")) 151 | object 152 | } 153 | 154 | formatPkgs <- function(name, vers, key, citecommand = "\\citep") { 155 | if (!is.null(key)) { 156 | key <- sapply(name, function(x) 157 | paste(key[grep(paste0("^pkg:", x, "[[:digit:]]*$"), key)], 158 | collapse = ",")) 159 | cites <- paste0(citecommand, "{", key, "}") 160 | cites[is.null(key)] <- "" 161 | } else { 162 | cites <- rep("", length(name)) 163 | } 164 | paste0("\\item ", name, " (vers. ", vers, ") ", cites) 165 | } 166 | 167 | ## modified version based on R package version 0.3-5. 168 | ## 169 | ## URL of original package: http://CRAN.R-project.org/package=bibtex 170 | ## Authors of R package bibtex (inlcuding write.bib): 171 | ## Romain Francois, Kurt Hornik 172 | ## Licence of R package bibtex: GPL-2 | GPL-3 173 | write.bib <- function(entry = "base", file = NULL, 174 | append = FALSE, verbose = TRUE) { 175 | 176 | ## define bibs 177 | bibs <- if (inherits(entry, "bibentry")) { 178 | entry 179 | } else { 180 | if (length(entry) == 0) { 181 | if (verbose) 182 | message("Empty package list: nothing to be done.") 183 | return(invisible("")) 184 | } 185 | if (is.character(entry)) { 186 | ## save names of packages 187 | pkgs <- entry 188 | bibs <- sapply(pkgs, function(x) citation(x), simplify = FALSE) 189 | n.installed <- length(bibs) 190 | ok <- sapply(bibs, inherits, "bibentry") 191 | pkgs <- pkgs[ok] 192 | bibs <- bibs[ok] 193 | n.converted <- sum(ok) 194 | ## generate unique keys 195 | pkgs <- lapply(seq_along(pkgs), function(i) 196 | if (length(bibs[[i]]) > 1) { 197 | paste0(pkgs[i], 1:length(bibs[[i]])) 198 | } else { 199 | pkgs[i] 200 | }) 201 | pkgs <- do.call("c", pkgs) 202 | bibs <- do.call("c", bibs) 203 | ## add keys to bibentries 204 | bibs <- mapply(function(b, k) { 205 | b$key <- paste0("pkg:", k) 206 | b 207 | }, bibs, pkgs, SIMPLIFY = FALSE) 208 | bibs <- do.call("c", bibs) 209 | if (verbose) 210 | message("Converted ", n.converted, " of ", n.installed, 211 | " package citations to BibTeX") 212 | bibs 213 | } else { 214 | stop("Invalid argument 'entry': ", 215 | "expected a bibentry object or a character vector ", 216 | "of package names.") 217 | } 218 | } 219 | 220 | if (length(bibs) == 0) { 221 | if (verbose) 222 | message("Empty bibentry list: nothing to be done.") 223 | return(invisible()) 224 | } 225 | if (!is.null(file)) { 226 | if (is.character(file)) { 227 | if (!grepl("\\.bib$", file)) 228 | file <- paste(file, ".bib", sep = "") 229 | } 230 | fh <- file(file, open = ifelse(append, "a+", "w+")) 231 | on.exit(if (isOpen(fh)) close(fh)) 232 | if (verbose) 233 | message("Writing ", length(bibs), " BibTeX entries ... ", 234 | appendLF = FALSE) 235 | writeLines(toBibtex(bibs), fh) 236 | if (verbose) 237 | message("OK\nResults written to file '", file, "'") 238 | return(invisible(bibs)) 239 | } else { 240 | return(bibs) 241 | } 242 | } 243 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | papeR 2 | ===== 3 | 4 | [![Build Status (Windows)](https://ci.appveyor.com/api/projects/status/t58j1j2hygy6evst/branch/master?svg=true)](https://ci.appveyor.com/project/hofnerb/paper/branch/master) 5 | [![Coverage Status](https://coveralls.io/repos/hofnerb/papeR/badge.svg?branch=master&service=github)](https://coveralls.io/github/hofnerb/papeR?branch=master) 6 | [![CRAN Status Badge](http://www.r-pkg.org/badges/version/papeR)](https://cran.r-project.org/package=papeR) 7 | [![](http://cranlogs.r-pkg.org/badges/papeR)](https://cran.r-project.org/package=papeR) 8 | 9 | **papeR** provides a toolbox for writing knitr, Sweave or other LaTeX- or markdown-based papers and reports and to prettify the output of various estimated models. 10 | 11 | ## Installation: 12 | 13 | - Current version (from CRAN): 14 | 15 | ```r 16 | install.packages("papeR") 17 | ``` 18 | 19 | - Latest development version from GitHub: 20 | 21 | ```r 22 | library("devtools") 23 | install_github("hofnerb/papeR") 24 | ``` 25 | 26 | - To be able to use the `install_github()` command, one needs to install `devtools` first: 27 | 28 | ```r 29 | install.packages("devtools") 30 | ``` 31 | 32 | ## Using papeR 33 | 34 | Tutorials on how to use **papeR** can be found on CRAN: 35 | 36 | - [Using papeR with Markdown](https://cran.r-project.org/package=papeR/vignettes/papeR_introduction.html) 37 | - [Using papeR with LaTeX](https://cran.r-project.org/package=papeR/vignettes/papeR_with_latex.pdf) 38 | 39 | or within R via 40 | 41 | ```r 42 | ## introduction to papeR (in combination with Markdown) 43 | vignette("papeR_introduction", package = "papeR") 44 | ## introduction to papeR with LaTeX 45 | vignette("papeR_with_latex", package = "papeR") 46 | ``` -------------------------------------------------------------------------------- /SOP_release.txt: -------------------------------------------------------------------------------- 1 | 2 | ########################################################### 3 | # Standard operating procedures for `papeR' development # 4 | ########################################################### 5 | 6 | 7 | Update ChangeLog 8 | ------------------ 9 | 10 | Go to root directory of project: 11 | 12 | git log 809c532..HEAD --pretty=short > ChangeLog 13 | 14 | 15 | Checking the package with latest development verstion of R 16 | ---------------------------------------------------------- 17 | 18 | Get source from 19 | ftp://ftp.stat.math.ethz.ch/Software/R/ 20 | 21 | UnTar and install according to guide in INSTALL (source directory). 22 | 23 | Go to mboost directory and call 24 | ../relative/path/to/R-devel/bin/R 25 | 26 | Run 27 | install.packages(c("car", "xtable", "nlme", "lme4", "survival", "gmodels", "knitr", "testthat", "foreign")) 28 | 29 | Quit R and run 30 | ../relative/path/to/R-devel/bin/R CMD check --as-cran --run-donttest papeR_XXX.tar.gz 31 | 32 | 33 | Making a release 34 | ---------------- 35 | 36 | Increase patch or minor level in DESCRIPTION 37 | Update Date: field in DESCRIPTION 38 | Update date and version in man/papeR-package.Rd 39 | Update inst/NEWS.Rd 40 | Update ChangeLog 41 | 42 | R CMD build --resave-data --compact-vignettes . && R CMD check --as-cran --run-donttest papeR_XXX.tar.gz 43 | 44 | Run check with R-devel 45 | (see section "Checking the package with latest development version of R") 46 | 47 | If differences to .Rout.save occure: 48 | - Manually check differences. You might want to use something like: 49 | cd papeR.Rcheck/tests 50 | meld Examples/papeR-Ex.Rout.save ../papeR-Ex.Rout & 51 | or 52 | meld regtest-XXX.Rout.save regtest-XXX.Rout & 53 | 54 | - If ok, copy new .Rout files to .Rout.save: 55 | 56 | Rscript copy_Rout_to_Routsave.R "vignettes=FALSE" 57 | 58 | - Update vignette .Rout.save files if necessary 59 | 60 | Rscript copy_Rout_to_Routsave.R "vignettes=TRUE" 61 | 62 | For details see 63 | http://r.789695.n4.nabble.com/Generate-Rout-save-files-for-vignettes-td4652752.html 64 | 65 | Gives no warnings / errors. 66 | 67 | Commit changes 68 | 69 | Now build package (perhaps in future without test folder) to be submitted to CRAN 70 | R CMD build --resave-data --compact-vignettes . && R CMD check --as-cran --run-donttest papeR_XXX.tar.gz 71 | 72 | Run checks on WinBuilder: 73 | upload package to http://win-builder.r-project.org/ 74 | 75 | Ftp source package to CRAN or use web form at http://xmpalantir.wu.ac.at/cransubmit/. 76 | 77 | 78 | How to preview NEWS.Rd files 79 | ---------------------------- 80 | 81 | Create NEWS.Rd from plain text NEWS: 82 | tools:::news2Rd("NEWS", "inst/NEWS.Rd") 83 | 84 | For HTML preview: 85 | R CMD Rdconv -t 'html' -o 'NEWS.html' NEWS.Rd && firefox NEWS.html 86 | 87 | and for PDF preview: 88 | R CMD Rd2pdf NEWS.Rd 89 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | # Download script file from GitHub 4 | init: 5 | ps: | 6 | $ErrorActionPreference = "Stop" 7 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 8 | Import-Module '..\appveyor-tool.ps1' 9 | install: 10 | - mkdir src 11 | - ps: Bootstrap 12 | 13 | # Adapt as necessary starting from here 14 | 15 | build_script: 16 | - travis-tool.sh install_deps 17 | 18 | test_script: 19 | - travis-tool.sh run_tests 20 | 21 | on_failure: 22 | - travis-tool.sh dump_logs 23 | 24 | artifacts: 25 | - path: '*.Rcheck\**\*.log' 26 | name: Logs 27 | 28 | - path: '*.Rcheck\**\*.out' 29 | name: Logs 30 | 31 | - path: '*.Rcheck\**\*.fail' 32 | name: Logs 33 | 34 | - path: '*.Rcheck\**\*.Rout' 35 | name: Logs 36 | 37 | - path: '\*_*.tar.gz' 38 | name: Bits 39 | 40 | - path: '\*_*.zip' 41 | name: Bits 42 | -------------------------------------------------------------------------------- /copy_Rout_to_Routsave.R: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | # 3 | # USE THIS SCRIPT TO REPLACE ALL OCCURENCES OF *.Rout.save WITH NEW *.Rout FILES 4 | # 5 | # Author: Benjamin Hofner, 2012-2013 6 | # 7 | # USAGE: 8 | # Use either 9 | # ## To copy test output 10 | # Rscript copy_Rout_to_Routsave.R "vignettes=FALSE" 11 | # ## To copy vignette output 12 | # Rscript copy_Rout_to_Routsave.R "vignettes=TRUE" 13 | # 14 | # ALTERNATIVE USAGE (with R CMD BATCH): 15 | # Use either 16 | # ## To copy test output 17 | # R CMD BATCH "--args vignettes=FALSE" copy_Rout_to_Routsave.R 18 | # ## To copy vignette output 19 | # R CMD BATCH "--args vignettes=TRUE" copy_Rout_to_Routsave.R 20 | # 21 | ################################################################################ 22 | 23 | ## Get command line arguments 24 | args <- commandArgs(TRUE) 25 | if (length(args) > 1) 26 | stop("specify (at maximum) one argument (i.e., vignettes)") 27 | eval(parse(text=args)) 28 | if (length(args) == 0) { 29 | vignettes <- FALSE 30 | } 31 | if (is.null(vignettes)) 32 | vignettes <- FALSE 33 | 34 | path <- "." 35 | check_path <- "../papeR.Rcheck/" 36 | 37 | ################################################################################ 38 | ## Copy output of test files 39 | 40 | if (vignettes == FALSE) { 41 | 42 | ## Get relevant file names 43 | ROUT <- list.files(path = check_path, pattern = ".Rout$", recursive = TRUE) 44 | ROUT2 <- paste(check_path, ROUT, sep ="") 45 | 46 | ROUT.SAVE <- list.files(path = path, pattern = ".Rout.save$", recursive = TRUE) 47 | ROUT.SAVE <- paste(path, "/", ROUT.SAVE, sep ="") 48 | ROUT.SAVE <- ROUT.SAVE[grep("test", ROUT.SAVE)] 49 | 50 | if (length(ROUT.SAVE) == length(ROUT)) { 51 | ## sort ROUT.SAVE 52 | idx <- rep(NA, length(ROUT)) 53 | for (i in 1:length(ROUT)) 54 | idx[i] <- grep(ROUT[i], ROUT.SAVE) 55 | ROUT.SAVE <- ROUT.SAVE[idx] 56 | 57 | cbind(ROUT2, ROUT.SAVE) 58 | 59 | cat("\n\nCopy *.Rout to *.Rout.save:\n---------------------------\n") 60 | 61 | for (i in 1:length(ROUT)) 62 | print(file.copy(ROUT2[i], ROUT.SAVE[i], overwrite = TRUE)) 63 | 64 | cat("#########################################################################", 65 | "# To revert changes simply use:", 66 | "# svn revert --recursive pkg/tests", 67 | "#########################################################################", 68 | sep = "\n") 69 | } else { 70 | which_missing <- !(ROUT %in% ROUT.SAVE) 71 | ROUT <- paste0(path, "/", ROUT[which_missing], ".save") 72 | file.create(ROUT) 73 | ## add to svn 74 | for (file in ROUT) 75 | system(paste0("svn add ", file)) 76 | 77 | cat("#########################################################################", 78 | "# To revert changes simply use:", 79 | "# svn revert --recursive pkg/tests", 80 | "#########################################################################", 81 | sep = "\n") 82 | } 83 | } 84 | 85 | ################################################################################ 86 | ## Copy output of vignettes 87 | 88 | if (vignettes == TRUE) { 89 | vpath <- paste(path, "vignettes", sep ="/") 90 | 91 | ## get vignette output as created by R CMD check: 92 | vROUT <- list.files(path = check_path, pattern = ".Rnw.log$") 93 | if (length(vROUT) > 0) { 94 | vROUT2 <- paste(check_path, vROUT, sep ="") 95 | 96 | vROUT.SAVE <- list.files(path = vpath, pattern = ".Rout.save", 97 | recursive = TRUE) 98 | vROUT.SAVE <- paste(vpath, vROUT.SAVE, sep = "/") 99 | 100 | ## sort 101 | filenames <- gsub("(.*)\\.Rnw\\.log", "\\1", vROUT) 102 | idx <- sapply(filenames, function(fn) 103 | res <- grep(paste(fn, "\\.Rout\\.save$", sep=""), vROUT.SAVE)) 104 | 105 | vROUT.SAVE <- vROUT.SAVE[idx] 106 | 107 | cbind(vROUT2, vROUT.SAVE) 108 | 109 | cat("\n\nCopy *.Rnw.log to *.Rout.save:\n---------------------------\n") 110 | 111 | for (i in 1:length(vROUT)) 112 | print(file.copy(vROUT2[i], vROUT.SAVE[i], overwrite = TRUE)) 113 | 114 | cat("#########################################################################", 115 | "# To revert changes simply use:", 116 | "# svn revert --recursive pkg/vignettes", 117 | "#########################################################################", 118 | sep = "\n") 119 | } else { 120 | cat("\n\nNOTE: No changes in output of vignettes.\n\n") 121 | } 122 | } 123 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite package 'papeR' in publications use:") 2 | 3 | year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date) 4 | vers <- meta$Version 5 | 6 | bibentry( 7 | bibtype="Manual", 8 | title = "{papeR}: A Toolbox for Writing Pretty Papers and Reports", 9 | author = c(person("Benjamin", "Hofner")), 10 | year = year, 11 | note = paste("{R} package version", vers), 12 | url = "https://CRAN.R-project.org/package=papeR", 13 | textVersion = 14 | paste("B. Hofner (", year, 15 | "). papeR: A Toolbox for Writing Pretty Papers and Reports, ", 16 | paste("R package version", vers), 17 | ", https://CRAN.R-project.org/package=papeR", ".", 18 | sep="") 19 | ) 20 | -------------------------------------------------------------------------------- /inst/CONTRIBUTIONS: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | Contributions 3 | -------------------------------------------------------------------------------- 4 | 5 | The code of this package is licenced under GPL-2. 6 | 7 | The package "papeR" contains modified code from other R packages. 8 | A list of the functions, their authors and of the licenes can be found below: 9 | 10 | - bibtex: write.bib (see R/toLatex.R) 11 | - stats: confint.lm (see R/helpers.R) 12 | format.perc (see R/helpers.R) 13 | - utils: toLatex.sessionInfo (see R/toLatex.R) 14 | - xtable: toLatex.character (see R/toLatex.R) 15 | 16 | See also inst/COPYRIGHT. 17 | 18 | -------------------------------------------------------------------------------- 19 | bibtex 20 | -------------------------------------------------------------------------------- 21 | 22 | write.bib 23 | 24 | modified version based on R package version 0.3-5. 25 | URL of original package: http://CRAN.R-project.org/package=bibtex 26 | Authors of R package bibtex (inlcuding write.bib): 27 | Romain Francois, Kurt Hornik 28 | Licence of R package bibtex: GPL-2 | GPL-3 29 | 30 | 31 | -------------------------------------------------------------------------------- 32 | stats 33 | -------------------------------------------------------------------------------- 34 | 35 | format.perc 36 | 37 | Copyright (C) 1994-2003 W. N. Venables and B. D. Ripley 38 | Copyright (C) 2003-2012 The R Core Team 39 | URL: http://cran.at.r-project.org/src/base/R-3/R-3.0.1.tar.gz 40 | Inside archive path: /src/library/stats/R/confint.R 41 | Licence of R package utils: >= GPL-2 42 | Author of the function format.perc: Martin Maechler 43 | 44 | confint.lm 45 | 46 | Copyright (C) 1994-2003 W. N. Venables and B. D. Ripley 47 | Copyright (C) 2003-2012 The R Core Team 48 | URL: http://cran.at.r-project.org/src/base/R-3/R-3.0.1.tar.gz 49 | Inside archive path: /src/library/stats/R/confint.R 50 | Licence of R package utils: >= GPL-2 51 | 52 | 53 | -------------------------------------------------------------------------------- 54 | utils 55 | -------------------------------------------------------------------------------- 56 | 57 | toLatex.sessionInfo 58 | 59 | Copyright (C) 1995-2013 The R Core Team 60 | URL: http://cran.at.r-project.org/src/base/R-3/R-3.0.1.tar.gz 61 | Inside archive path: /src/library/utils/R/sessionInfo.R 62 | Licence of R package utils: >= GPL-2 63 | 64 | 65 | -------------------------------------------------------------------------------- 66 | xtable 67 | -------------------------------------------------------------------------------- 68 | 69 | modified version based on sanitize subroutine defined in 70 | R package xtable (Version 1.7-1) inside function print.xtable 71 | 72 | URL of original package: http://CRAN.R-project.org/package=xtable 73 | Authors of R package xtable (inlcuding print.xtable): 74 | David Dahl with contributions and 75 | suggestions from many others (see source code). 76 | Licence of R package xtable: GPL-2 | GPL-3 77 | -------------------------------------------------------------------------------- /inst/COPYRIGHTS: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | Copyright 3 | -------------------------------------------------------------------------------- 4 | 5 | The code of this package is licenced under GPL-2. 6 | 7 | The funcions format.perc and confint.lm are copyright (C) 1994-2003 W. N. 8 | Venables and B. D. Ripley, copyright (C) 2003-2012 The R Core Team, and 9 | the function toLatex.sessionInfo is copyright (C) 1995-2013 The R Core Team. 10 | 11 | All other code is copyright (C) Benjamin Hofner. 12 | 13 | For a detailed description and autorship see inst/CONTRIBUTIONS. 14 | -------------------------------------------------------------------------------- /inst/NEWS.Rd: -------------------------------------------------------------------------------- 1 | \name{NEWS} 2 | \title{News for Package 'papeR'} 3 | 4 | \section{Changes in papeR version 1.0-6 (2025-04-01)}{ 5 | \subsection{Miscellaneous}{ 6 | \itemize{ 7 | \item Included original authors of functions that are used in a modified 8 | form in this package as contributors in \code{Authors@R} field 9 | in \file{DESCRIPTION}. 10 | } 11 | } 12 | \subsection{Bug-fixes}{ 13 | \itemize{ 14 | \item Fixed links in manuals. 15 | \item Removed Travis-CI integration from \file{README.md}. 16 | \item Updated \file{inst/CITATION} to new \code{bibentry} format. 17 | \item Added missing S3 methods for \code{prettify}. 18 | \item Fixed calls to S3 methods by correcting object names and 19 | adding \code{...} where missing. 20 | } 21 | } 22 | } 23 | \section{Changes in papeR version 1.0-5 (2021-03-19)}{ 24 | \subsection{Bug-fixes}{ 25 | \itemize{ 26 | \item Fixed error introduced by changes in \pkg{survival}: 27 | \code{data(ovarian, package = "survival")} was replaced with \code{data(cancer, package = "survival")}. 28 | } 29 | } 30 | } 31 | \section{Changes in papeR version 1.0-4 (2019-01-03)}{ 32 | \subsection{Bug-fixes}{ 33 | \itemize{ 34 | \item Fixed vignette (load \pkg{knitr} correctly). 35 | \item Added \pkg{rmarkdown} to \code{Suggests:}. 36 | \item Fixed handling of trailing zeros in \code{prettify} 37 | (fixes \href{https://github.com/hofnerb/papeR/issues/40}{#40}). 38 | } 39 | } 40 | } 41 | \section{Changes in papeR version 1.0-3 (2018-09-11)}{ 42 | \subsection{Bug-fixes}{ 43 | \itemize{ 44 | \item Stop checking for specific error message 45 | (fixes \href{https://github.com/hofnerb/papeR/issues/39}{#39}). 46 | \item Make Rmarkdown happy 47 | (fixes \href{https://github.com/hofnerb/papeR/issues/35}{#35}). 48 | } 49 | } 50 | } 51 | \section{Changes in papeR version 1.0-2 (2017-02-16)}{ 52 | \subsection{Miscellaneous}{ 53 | \itemize{ 54 | \item Updated maintainer's email address. 55 | } 56 | } 57 | \subsection{Bug-fixes}{ 58 | \itemize{ 59 | \item Fix scoping in \code{summarize} function 60 | (fixes \href{https://github.com/hofnerb/papeR/issues/33}{#33}). 61 | \item Removed \code{confint.lme} to make CRAN happy 62 | (fixes \href{https://github.com/hofnerb/papeR/issues/34}{#34}). 63 | \item Fixed bug in \code{label} assignment with numerical \code{which}. 64 | } 65 | } 66 | } 67 | \section{Changes in papeR version 1.0-1 (2016-04-08)}{ 68 | \subsection{User-visible changes}{ 69 | \itemize{ 70 | \item \code{print.xtable.summary} now also centers tables per 71 | default if \code{floating = FALSE}. 72 | \item Added support for Cox frailty models in \code{prettify} 73 | \item Fixed problem with \code{include.rownames} by ignoring the option 74 | (fixes \href{https://github.com/hofnerb/papeR/issues/30}{#30}). 75 | \item Use \code{$-$} per default for negative numeric values 76 | (fixes \href{https://github.com/hofnerb/papeR/issues/32}{#32}). 77 | } 78 | } 79 | \subsection{Bug-fixes}{ 80 | \itemize{ 81 | \item Make tests compatible with new testthat version (> 0.11.0). 82 | \item Fixed messages of old summary functions. 83 | } 84 | } 85 | } 86 | \section{Changes in papeR version 1.0-0 (2015-12-01)}{ 87 | \subsection{User-visible changes}{ 88 | \itemize{ 89 | \item \code{summarize} produces summary tables that can be further 90 | processed with \code{xtable} or \code{kable} to produce LaTeX or 91 | Markdown tables, respectively (closes 92 | \href{https://github.com/hofnerb/papeR/issues/2}{#2} and 93 | \href{https://github.com/hofnerb/papeR/issues/3}{#3}). 94 | \item \code{latex.table.cont} and \code{latex.table.fac} are now 95 | deprecated. Use \code{summarize} instead. 96 | \item \code{labels()} are now stored as attribute of the variable 97 | instead of as attribute of the data set (closes 98 | \href{https://github.com/hofnerb/papeR/issues/1}{#1}). 99 | } 100 | } 101 | \subsection{Miscellaneous}{ 102 | \itemize{ 103 | \item Completely refactored code base. 104 | \item Added two vignettes (closes 105 | \href{https://github.com/hofnerb/papeR/issues/7}{#7}). 106 | \item The package is now extensively tested using \code{testthat} 107 | (closes \href{https://github.com/hofnerb/papeR/issues/12}{#12}). 108 | } 109 | } 110 | \subsection{Bug-fixes}{ 111 | \itemize{ 112 | \item Adhere to CRAN policies regarding import of base packages 113 | (closes \href{https://github.com/hofnerb/papeR/issues/8}{#8}). 114 | } 115 | } 116 | } 117 | 118 | 119 | \section{Changes in papeR version 0.6-1 (2015-06-09)}{ 120 | \subsection{Miscellaneous}{ 121 | \itemize{ 122 | \item Fixed \file{man/toLatex.Rd}: 123 | Changed \code{\\donttest} to \code{\\dontrun} 124 | \item \file{DESCRIPTION} now uses single quotes for package and 125 | software names. 126 | } 127 | } 128 | \subsection{Bug-fixes}{ 129 | \itemize{ 130 | \item Fixed \file{inst/CITATION}: Now it is possible to extract 131 | citation without the need to install the package. 132 | } 133 | } 134 | } 135 | 136 | \section{Changes in papeR version 0.6-0 (2015-06-05)}{ 137 | \subsection{User-visible changes}{ 138 | \itemize{ 139 | \item \code{latex.table.fac}: 140 | \itemize{ 141 | \item Allow more than two groups. 142 | \item Added p-values. 143 | \item Added option to display fractions or percentages 144 | (\code{percent = TRUE}). The latter is the default. 145 | \item Changed default to \code{digits = 3}. 146 | \item Generally improved display of grouped statistics. 147 | } 148 | } 149 | } 150 | \subsection{Miscellaneous}{ 151 | \itemize{ 152 | \item Added \file{inst/CITATION} file. 153 | \item Added \file{inst/COPYRIGHTS} file. 154 | \item Added \file{inst/CONTRIBUTIONS} file. 155 | \item Updated \file{DESCRIPTION} to reflect CRAN policies. 156 | \item Changed URL in \file{DESCRIPTION} to 157 | \url{https://github.com/hofnerb/papeR}. 158 | } 159 | } 160 | \subsection{Bug-fixes}{ 161 | \itemize{ 162 | \item Do not replace registered S3 methods from base/recommended 163 | packages (#5). 164 | \item Fixed handling of \code{levels()}. 165 | \item Fixed bug with factor levels. 166 | \item \code{latex.table.fac} and \code{latex.table.cont}: 167 | fixed handling of missing values in \code{group}. 168 | } 169 | } 170 | } 171 | \section{Changes in papeR version 0.5-0 (2014-11-13)}{ 172 | \subsection{User-visible changes}{ 173 | \itemize{ 174 | \item Exported \code{plot.labeled.data.frame} (and some other 175 | functions for labeled \code{data.frame}s) 176 | \item Greatly improved \code{plot} function for labeled 177 | \code{data.frame}s 178 | } 179 | } 180 | \subsection{Miscellaneous}{ 181 | \itemize{ 182 | \item Changed plain text \file{NEWS} to \file{inst/NEWS.Rd} 183 | \item The package now \emph{enhances} \pkg{nlme}, \pkg{lme4} and 184 | \pkg{survival}. Thus, we no longer import \pkg{lme4} and 185 | \pkg{survival}. 186 | } 187 | } 188 | \subsection{Bug-fixes}{ 189 | \itemize{ 190 | \item Fixed bug in \code{toLatex.sessionInfo(, citations = FALSE)} 191 | (spotted by Brian S. Diggs ) 192 | \item Changed \code{plot(data, ...)} to \code{plot(x, ...)} to 193 | make the generic function happy. 194 | } 195 | } 196 | } 197 | \section{Changes in papeR version 0.4-0 (2013-09-13)}{ 198 | \itemize{ 199 | \item included (experimental) version of 200 | \code{prettify.summary.merMod} to make \pkg{lme4} (>= 1.0.0) happy 201 | \item included better handling of environments in \code{prettify} 202 | functions and checks if the data has changed 203 | \item included possibility to specify confidence intervals directly 204 | via \code{confint}, e.g. 205 | 206 | \code{prettify(summary(mod), confint = confint(mod))} 207 | 208 | \item better handling of \code{NAMESPACES} and \code{Imports} 209 | \item added (first) software tests 210 | } 211 | } 212 | \section{Changes in papeR version 0.3-0 (2013-08-07)}{ 213 | \itemize{ 214 | \item first release to CRAN 215 | \item improvement/bugfix in \code{rbind.labeled.data.frame()} 216 | \item improvement of \code{toLatex.sessionInfo()}: 217 | file can be \code{NULL} now (no BibTeX file created on HDD) 218 | \item added plot function for \code{labeled.data.frame} objects that 219 | allows for univariate plots and grouped, bivariate plots 220 | \item numerous improvements in manuals 221 | } 222 | } 223 | \section{Changes in papeR version 0.2-0 (2013-07-01)}{ 224 | \itemize{ 225 | \item greatly improved \code{prettify} functions: 226 | \itemize{ 227 | \item added prettify functions for \code{summary.coxph}, 228 | \code{summary.lme}, \code{summary.mer} and \code{anova} 229 | \item added confidence intervals to all model based 230 | \code{prettify} functions and made \code{confint = TRUE} the 231 | default; confidence intervalls are computed by refitting the 232 | model within \code{prettify} and using \code{confint()} on this 233 | model (experimental) 234 | \item improved handling of p-values 235 | } 236 | \item added new class \code{"labeled.data.frame"} with special 237 | \code{subset}, \code{cbind} and \code{rbind} functions (to keep 238 | labels when changing data set) 239 | \item added "shortcut" to define labels using \code{labels = 240 | TRUE} in \code{latex.tables.XXX}: 241 | 242 | labels are extracted from \code{labeled.data.frame} directly 243 | 244 | \item new \code{toLatex} function for \code{sessionInfo()} 245 | [with nicer results than the default function from base \pkg{R}: 246 | e.g. citations are included] 247 | } 248 | } 249 | \section{Changes in papeR version 0.1-0 (2013-01-21)}{ 250 | \itemize{ 251 | \item initial version 252 | \item improvement of \code{prettify} function 253 | \item added \code{prettify} functions for more object classes 254 | \item added function \code{toLatex} to sanitize code for usage in LaTeX 255 | \item improved label handling when data set is alterd 256 | (e.g. variables dropped, added or renamed) 257 | } 258 | } 259 | -------------------------------------------------------------------------------- /inst/SPSS/data.sav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hofnerb/papeR/9b46640d9d506bf36a2504b66a3cb1e9d0556bc2/inst/SPSS/data.sav -------------------------------------------------------------------------------- /man/Anova.lme.Rd: -------------------------------------------------------------------------------- 1 | \name{Anova.lme} 2 | \alias{Anova.lme} 3 | 4 | \title{ Anova Function for lme Models } 5 | \description{ 6 | This is a wrapper to \code{\link[nlme]{anova.lme}} from package \pkg{nlme} 7 | and is coded similar to \code{\link[car]{Anova}} from \pkg{car} as it 8 | produces marginal tests by default. 9 | } 10 | \usage{ 11 | \method{Anova}{lme}(mod, type = c("marginal", "sequential"), ...) 12 | } 13 | 14 | \arguments{ 15 | \item{mod}{ 16 | linear mixed model fitted with package \pkg{nlme}. 17 | } 18 | \item{type}{ 19 | type of anova, either marginal (default) or sequential. 20 | } 21 | \item{\dots}{ 22 | further arguments to be passed to \code{\link[nlme]{anova.lme}} 23 | } 24 | } 25 | 26 | \seealso{ 27 | \code{\link[car]{Anova}} (package \pkg{car}) 28 | } 29 | \examples{ 30 | ## Example requires package nlme to be installed and loaded 31 | if (require("nlme")) { 32 | ## Load data set Orthodont 33 | data(Orthodont, package = "nlme") 34 | 35 | ## Fit a model for distance with random intercept for Subject 36 | mod <- lme(distance ~ age + Sex, data = Orthodont, random = ~ 1 | Subject) 37 | 38 | Anova(mod) 39 | } 40 | } 41 | 42 | \keyword{methods} 43 | \keyword{models} 44 | -------------------------------------------------------------------------------- /man/confint.Rd: -------------------------------------------------------------------------------- 1 | \name{confint.mer} 2 | \alias{confint.mer} 3 | \title{Confidence intervals for mixed models} 4 | \usage{ 5 | \method{confint}{mer}(object, parm, level = 0.95, 6 | simulate = c("ifneeded", TRUE, FALSE), 7 | B = 1000,...) 8 | } 9 | \arguments{ 10 | \item{object}{ 11 | Model of class \code{mer}. 12 | } 13 | 14 | \item{parm}{ 15 | Parameters to be included in the confidence interval. See 16 | \code{\link{confint.default}} for details. 17 | } 18 | 19 | \item{level}{ 20 | the confidence level. 21 | } 22 | 23 | \item{simulate}{ 24 | If \dQuote{"ifneeded"} is specified (default), simulated confidence 25 | intervals are returned if (and only if) no z-value exists in the 26 | corresponding \code{summary} and asymptotic confidence intervals 27 | will be returned otherwise. If \code{TRUE} (or \dQuote{"TRUE"}) 28 | confidence intervals will be estimated using \code{\link[gmodels]{ci}} from 29 | package \pkg{gmodels}, which uses \code{\link[lme4]{mcmcsamp}} internally. 30 | If \code{FALSE} (or \dQuote{"FALSE"}), asymptotic confidence 31 | intervals will be returned and an error is given if not possible. 32 | } 33 | 34 | \item{B}{ 35 | number of samples to take in \code{\link[lme4]{mcmcsamp}}. Per default 36 | 1000 samples are used. 37 | } 38 | 39 | \item{...}{ 40 | Additional arguments. Currently not used. 41 | } 42 | } 43 | \value{ 44 | Matrix with confidence intervals. 45 | } 46 | \description{ 47 | Compute confidence intervals for mixed models from 48 | package \pkg{lme4} (prior to version 1.0). 49 | This function is only needed for backward compatibility. 50 | } 51 | \author{ 52 | Benjamin Hofner, partially based on code from package stats. 53 | See source code for documentation. 54 | } 55 | 56 | -------------------------------------------------------------------------------- /man/get_options.Rd: -------------------------------------------------------------------------------- 1 | \name{get_option} 2 | \alias{get_option} 3 | 4 | \title{ Extract printing options from \code{table.cont} and 5 | \code{table.fac} objects } 6 | \description{ 7 | Helper function to extract printing options from \code{table.cont} and 8 | \code{table.fac} objects as produced by \code{\link{latex.table.cont}} and 9 | \code{\link{latex.table.fac}}. 10 | } 11 | \usage{ 12 | 13 | get_option(object, name) 14 | 15 | } 16 | 17 | \arguments{ 18 | \item{object}{ 19 | \code{table.cont} or \code{table.fac} object as produced by 20 | \code{\link{latex.table.cont}} and \code{\link{latex.table.fac}} 21 | } 22 | \item{name}{ 23 | name of the option, e.g. \code{"table"} and \code{"align"}. See 24 | \code{\link{latex.table.cont}} and \code{\link{latex.table.fac}} for 25 | available options. 26 | } 27 | } 28 | \value{ 29 | Option. 30 | } 31 | \author{ 32 | Benjamin Hofner 33 | } 34 | \seealso{ 35 | \code{\link{latex.table.cont}} and \code{\link{latex.table.fac}} 36 | } 37 | 38 | 39 | \keyword{IO} 40 | \keyword{print} 41 | 42 | -------------------------------------------------------------------------------- /man/labels.data.frame.Rd: -------------------------------------------------------------------------------- 1 | \name{labels} 2 | 3 | \alias{labels} 4 | \alias{labels.default} 5 | \alias{labels.data.frame} 6 | \alias{labels<-} 7 | 8 | \alias{as.ldf} 9 | \alias{is.ldf} 10 | \alias{convert.labels} 11 | 12 | \alias{plot} 13 | \alias{plot.ldf} 14 | 15 | \title{ 16 | Extract labels from and set labels for data frames 17 | } 18 | \description{ 19 | Labels can be stored as an attribute \code{"variable.label"} for each 20 | variable in a data set using the assignment function. With the 21 | extractor function one can assess these labels. 22 | } 23 | \usage{ 24 | 25 | \method{labels}{data.frame}(object, which = NULL, abbreviate = FALSE, ...) 26 | 27 | ## assign labels 28 | labels(data, which = NULL) <- value 29 | 30 | ## check if data.frame is a special labeled data.frame ('ldf') 31 | is.ldf(object) 32 | 33 | ## convert object to labeled data.frame ('ldf') 34 | convert.labels(object) 35 | as.ldf(object, ...) 36 | 37 | ## special plotting function for labeled data.frames ('ldf') 38 | \method{plot}{ldf}(x, variables = names(x), 39 | labels = TRUE, by = NULL, with = NULL, 40 | regression.line = TRUE, line.col = "red", ...) 41 | } 42 | 43 | \arguments{ 44 | \item{object}{ 45 | a \code{data.frame}. 46 | } 47 | \item{data}{ 48 | a \code{data.frame}. 49 | } 50 | \item{which}{ 51 | either a number indicating the label to extract or a character 52 | string with the \emph{variable name} for which the label should be 53 | extracted. One can also use a vector of numerics or character 54 | strings to extract mutiple labels. If \code{which} is \code{NULL} 55 | (default), all labels are returned. 56 | } 57 | \item{value}{ 58 | a vector containing the labels (in the order of the variables). If 59 | which is given, only the corresponding subset is labeled. Note that 60 | all other labels contain the variable name as label afterwards. 61 | } 62 | \item{abbreviate}{ 63 | logical (default: \code{FALSE}). If \code{TRUE} variable labels are 64 | abbreviated such that they remain unique. See 65 | \code{\link{abbreviate}} for details. Further arguments to 66 | \code{\link{abbreviate}} can be specified (see below). 67 | } 68 | \item{\dots}{ 69 | further options passed to function \code{\link{abbreviate}} if argument 70 | \code{abbreviate = TRUE}. 71 | 72 | In \code{x[...]}, \dots can be used to specify indices for 73 | extraction. See \code{\link{[}} for details. 74 | 75 | In \code{plot}, \code{\dots} can be used to specify further graphial 76 | parameters. 77 | } 78 | \item{x}{ 79 | a labeled \code{data.frame} with class \code{'ldf'}. 80 | } 81 | \item{variables}{ 82 | character vector or numeric vector defining (continuous) variables 83 | that should be included in the table. Per default, all numeric and 84 | factor variables of \code{data} are used. 85 | } 86 | \item{labels}{ 87 | labels for the variables. If \code{labels = TRUE} (the default), 88 | \code{labels(data, which = variables)} is used as labels. If 89 | \code{labels = NULL} \code{variables} is used as label. 90 | \code{labels} can also be specified as character vector. 91 | } 92 | \item{by}{ 93 | a character or numeric value specifying a variable in the data set. 94 | This variable can be either a grouping \code{factor} or is used as 95 | numeric y-variable (see \code{with} for details). Per default no 96 | grouping is applied. See also \sQuote{Details} and \sQuote{Examples}. 97 | } 98 | \item{with}{ 99 | a character or numeric value specifying a numeric variable 100 | \code{with} which to \dQuote{correlate} all variables specified in 101 | \code{variables}. For numeric \code{variables} a scatterplot is 102 | plotted, for factor \code{variables} one gets a grouped boxplot. 103 | Per default no variable is given here. Instead of \code{with} one 104 | can also specify a numeric variable in \code{by} with the same 105 | results. See also \sQuote{Details} and \sQuote{Examples}. 106 | } 107 | \item{regression.line}{ 108 | a logical argument specifying if a regression line should be added 109 | to scatter plots (which are plotted if both \code{variables} and 110 | \code{by} are numeric values). 111 | } 112 | \item{line.col}{ 113 | the color of the regression line. 114 | } 115 | } 116 | \details{ 117 | All labels are stored as attributes of the columns of the data frame, 118 | i.e., each variable has (up to) one attribute which contains the 119 | variable lable. 120 | 121 | One can set or extract labels from \code{\link{data.frame}} objects. 122 | If no labels are specified \code{labels(data)} returns the column 123 | names of the data frame. 124 | 125 | Using \code{abbreviate = TRUE}, all labels are abbreviated to (at 126 | least) 4 characters such that they are unique. Other minimal lengths 127 | can specified by setting \code{minlength} (see examples below). 128 | 129 | Univariate plots can be easily obtained for all numeric and factor 130 | variables in a data set \code{data} by using \code{plot(data)}. 131 | 132 | Bivariate plots can be obtained by specifying \code{by}. In case of a 133 | factor variable, grouped \code{boxplot}s or \code{spineplot}s are 134 | plotted depending on the class of the variable specified in 135 | \code{variables}. In case of a numeric variable, grouped 136 | \code{boxplot}s or scatter plots are plotted depending on the 137 | class of the variable specified in \code{variables}. Note that one 138 | cannot specify \code{by} and \code{with} at the same time (as they are 139 | internally identical). Note that missings are excluded plot wise (also 140 | for bivariate plots). 141 | } 142 | \value{ 143 | \code{labels(data)} returns a named vector of variable labels, where 144 | the names match the variable names and the values represent the labels. 145 | } 146 | 147 | \author{ 148 | Benjamin Hofner 149 | } 150 | \note{ 151 | If a data set is generated by \code{\link[foreign]{read.spss}} in package 152 | \pkg{foreign}, labels are stored in a single attribute of the data 153 | set. Assigning new labels, e.g. via \code{labels(data) <- 154 | labels(data)} removes this attribute and stores all labels as 155 | attributes of the variables. Alternatively one can use 156 | \code{data <- convert.labels(data)}. 157 | } 158 | \seealso{ 159 | \code{\link[foreign]{read.spss}} in package \pkg{foreign} 160 | } 161 | \examples{ 162 | ############################################################ 163 | ### Basic labels manipulations 164 | 165 | data <- data.frame(a = 1:10, b = 10:1, c = rep(1:2, 5)) 166 | labels(data) ## only the variable names 167 | is.ldf(data) ## not yet 168 | 169 | ## now set labels 170 | labels(data) <- c("my_a", "my_b", "my_c") 171 | ## one gets a named character vector of labels 172 | labels(data) 173 | ## data is now a ldf: 174 | is.ldf(data) 175 | 176 | ## Altervatively one could use as.ldf(data) or convert.labels(data); 177 | ## This would keep the default labels but set the class 178 | ## correctly. 179 | 180 | ## set labels for a and b only 181 | ## Note that which represents the variable names! 182 | labels(data, which = c("a", "b")) <- c("x", "y") 183 | labels(data) 184 | 185 | ## reset labels (to variable names): 186 | labels(data) <- NULL 187 | labels(data) 188 | 189 | ## set label for a only and use default for other labels: 190 | labels(data, which = "a") <- "x" 191 | labels(data) 192 | 193 | ## attach label for new variable: 194 | data2 <- data 195 | data2$z <- as.factor(rep(2:3, each = 5)) 196 | labels(data2) ## no real label for z, only variable name 197 | labels(data2, which = "z") <- "new_label" 198 | labels(data2) 199 | 200 | 201 | ############################################################ 202 | ### Abbreviate labels 203 | 204 | ## attach long labels to data 205 | labels(data) <- c("This is a long label", "This is another long label", 206 | "This also") 207 | labels(data) 208 | labels(data, abbreviate = TRUE, minlength = 10) 209 | 210 | 211 | ############################################################ 212 | ### Data manipulations 213 | 214 | ## reorder dataset: 215 | tmp <- data2[, c(1, 4, 3, 2)] 216 | labels(tmp) 217 | ## labels are kept and order is updated 218 | 219 | ## subsetting to single variables: 220 | labels(tmp[, 2]) ## not working as tmp[, 2] drops to vector 221 | ## note that the label still exists but cannot be extracted 222 | ## using labels.default() 223 | str(tmp[, 2]) 224 | 225 | labels(tmp[, 2, drop = FALSE]) ## prevent dropping 226 | 227 | ## one can also cbind labeled data.frame objects: 228 | labels(cbind(data, tmp[, 2])) 229 | ## or better: 230 | labels(cbind(data, tmp[, 2, drop = FALSE])) 231 | ## or rbind labeled.data.set objects: 232 | labels(rbind(data, tmp[, -2])) 233 | 234 | 235 | ############################################################ 236 | ### Plotting data sets 237 | 238 | ## plot the data auto"magically"; numerics as boxplot, factors as barplots 239 | par(mfrow = c(2,2)) 240 | plot(data2) 241 | 242 | ## a single plot 243 | plot(data2, variables = "a") 244 | ## grouped plot 245 | plot(data2, variables = "a", by = "z") 246 | ## make "c" a factor and plot "c" vs. "z" 247 | data2$c <- as.factor(data2$c) 248 | plot(data2, variables = "c", by = "z") 249 | ## the same 250 | plot(data2, variables = 3, by = 4) 251 | 252 | ## plot everithing against "b" 253 | ## (grouped boxplots, stacked barplots or scatterplots) 254 | plot(data2, with = "b") 255 | } 256 | 257 | \keyword{methods} 258 | -------------------------------------------------------------------------------- /man/latex_table_cont.Rd: -------------------------------------------------------------------------------- 1 | \name{latex.table.cont} 2 | \alias{latex.table.cont} 3 | \alias{print.table.cont} 4 | 5 | \title{ Produce (LaTeX) Summaries for Continuous Variables } 6 | \description{ 7 | The function produces LaTeX tables with summary statistics for continous 8 | variables. It makes use of the booktabs package in LaTeX to obtain 9 | tables with a nice layout. 10 | } 11 | \usage{ 12 | 13 | latex.table.cont(..., caption = NULL, label = NULL, 14 | table = c("tabular", "longtable"), align = NULL, 15 | floating = FALSE, center = TRUE) 16 | } 17 | 18 | \arguments{ 19 | \item{...}{ 20 | arguments for \code{\link{summarize}}. See there for details. 21 | } 22 | \item{caption}{ 23 | (optional) character string. Caption of LaTeX table. Note that 24 | captions are suported for all tables (see also details below). 25 | } 26 | \item{label}{ 27 | (optional) character string. Label of LaTeX table specified as 28 | \code{\\label{"label"}}. 29 | } 30 | \item{table}{ 31 | character string. LaTeX table format, currently either 32 | \code{"tabular"} (default) or \code{"longtable"}. 33 | } 34 | \item{align}{ 35 | character string. LaTeX alignment of table rows, per default 36 | \code{"llr...r"}, where \code{"r"} is repeated \code{ncol - 1} times. 37 | } 38 | \item{floating}{ 39 | logical (default: \code{FALSE}). Determines whether the table is a floating 40 | object (i.e. use a \code{table} environment or not). Note that a 41 | \code{longtable} cannot be a floating object but captions can be 42 | used. 43 | } 44 | \item{center}{ 45 | logical (default: \code{TRUE}). Determines if table should be centered. 46 | } 47 | } 48 | \details{ 49 | This function is deprecated and only available for backward 50 | comaptibility. Use \code{\link{summarize}} for more flexibility. 51 | 52 | The output requires \code{\\usepackage{booktabs}} in the LaTeX file. 53 | 54 | Captions can be added to both, \code{longtable}s and \code{tabular}s. 55 | In the latter case, captions are also suported if the table is no 56 | floating object. In this case, the LaTeX package \code{capt-of} is 57 | required. 58 | } 59 | \value{ 60 | The output is printed with LaTeX style syntax highlighting to be used 61 | e.g. in Sweave chunks with \code{results=tex}. 62 | } 63 | \author{ 64 | Benjamin Hofner 65 | } 66 | \seealso{ 67 | \code{\link{latex.table.fac}} and \code{\link{get_option}} 68 | } 69 | \examples{ 70 | ## Example requires package nlme to be installed and loaded 71 | if (require("nlme")) { 72 | ## Use dataset Orthodont 73 | data(Orthodont, package = "nlme") 74 | 75 | ## Get summary for continuous variables 76 | latex.table.cont(Orthodont) 77 | 78 | ## Change statistics to display 79 | latex.table.cont(Orthodont, quantiles = FALSE) 80 | latex.table.cont(Orthodont, count = FALSE, quantiles = FALSE) 81 | latex.table.cont(Orthodont, mean_sd = FALSE) 82 | 83 | ## Show column 'Missing' even if no missings are present 84 | latex.table.cont(Orthodont, show.NAs = TRUE) 85 | 86 | ## Change variables to display 87 | latex.table.cont(Orthodont, variables = "age") 88 | 89 | ## What happens in the display if we introduce some missing values: 90 | set.seed(1907) 91 | Orthodont$age[sample(nrow(Orthodont), 20)] <- NA 92 | latex.table.cont(Orthodont) 93 | } 94 | } 95 | 96 | \keyword{univar} 97 | \keyword{IO} 98 | \keyword{print} 99 | 100 | -------------------------------------------------------------------------------- /man/latex_table_fac.Rd: -------------------------------------------------------------------------------- 1 | \name{latex.table.fac} 2 | \alias{latex.table.fac} 3 | \alias{print.table.fac} 4 | 5 | \title{ Produce (LaTeX) Summaries for Factor Variables } 6 | \description{ 7 | The function produces LaTeX tables with summary statistics for factor 8 | variables. It makes use of the booktabs package in LaTeX to obtain 9 | tables with a nice layout. 10 | } 11 | \usage{ 12 | latex.table.fac(..., caption = NULL, label = NULL, 13 | table = c("tabular", "longtable"), align = NULL, 14 | floating = FALSE, center = TRUE) 15 | } 16 | 17 | \arguments{ 18 | \item{...}{ 19 | arguments for \code{\link{summarize}}. See there for details. 20 | } 21 | \item{caption}{ 22 | (optional) character string. Caption of LaTeX table. Note that 23 | captions are suported for all tables (see also details below). 24 | } 25 | \item{label}{ 26 | (optional) character string. Label of LaTeX table specified as 27 | \code{\\label{"label"}}. 28 | } 29 | \item{table}{ 30 | character string. LaTeX table format, currently either 31 | \code{"tabular"} (default) or \code{"longtable"}. 32 | } 33 | \item{align}{ 34 | character string. LaTeX alignment of table rows, per default 35 | \code{"lllr...r"}, where \code{"r"} is repeated \code{ncol - 2} times. 36 | } 37 | \item{floating}{ 38 | logical (default: \code{FALSE}). Determines whether the table is a floating 39 | object (i.e. use a \code{table} environment or not). Note that a 40 | \code{longtable} cannot be a floating object but captions can be 41 | used. 42 | } 43 | \item{center}{ 44 | logical (default: \code{TRUE}). Determines if table should be centered. 45 | } 46 | } 47 | \details{ 48 | This function is deprecated and only available for backward 49 | comaptibility. Use \code{\link{summarize}} for more flexibility. 50 | 51 | The output requires \code{\\usepackage{booktabs}} in the LaTeX file. 52 | 53 | Captions can be added to both, \code{longtable}s and \code{tabular}s. 54 | In the latter case, captions are also suported if the table is no 55 | floating object. In this case, the LaTeX package \code{capt-of} is 56 | required. 57 | } 58 | \value{ 59 | The output is printed with LaTeX style syntax highlighting to be used 60 | e.g. in Sweave chunks with \code{results=tex}. 61 | } 62 | \author{ 63 | Benjamin Hofner 64 | } 65 | \seealso{ 66 | \code{\link{latex.table.cont}} and \code{\link{get_option}} 67 | } 68 | \examples{ 69 | ## Example requires package nlme to be installed and loaded 70 | if (require("nlme")) { 71 | ## Use dataset Orthodont 72 | data(Orthodont, package = "nlme") 73 | 74 | ## Get summary for continuous variables 75 | latex.table.fac(Orthodont) 76 | 77 | ## Reorder data for table: 78 | latex.table.fac(Orthodont, variables = c("Sex", "Subject")) 79 | 80 | ## What happens in the display if we introduce some missing values: 81 | set.seed(1907) 82 | Orthodont$Sex[sample(nrow(Orthodont), 20)] <- NA 83 | latex.table.fac(Orthodont) 84 | latex.table.fac(Orthodont, variables = "Sex") 85 | ## do not show statistics on missing values 86 | latex.table.fac(Orthodont, variables = "Sex", show.NAs = FALSE) 87 | } 88 | } 89 | 90 | \keyword{univar} 91 | \keyword{IO} 92 | \keyword{print} 93 | -------------------------------------------------------------------------------- /man/papeR-package.Rd: -------------------------------------------------------------------------------- 1 | \name{papeR-package} 2 | \alias{papeR-package} 3 | \alias{papeR} 4 | \docType{package} 5 | \title{ 6 | A Toolbox for Writing Pretty Papers and Reports 7 | } 8 | \description{ 9 | A toolbox for writing knitr, Sweave or other LaTeX- or markdown-based 10 | reports and to prettify the output of various estimated models. 11 | } 12 | \details{ 13 | \tabular{ll}{ 14 | Package: \tab papeR\cr 15 | Type: \tab Package\cr 16 | Version: \tab 1.0-6\cr 17 | Date: \tab 2025-04-01\cr 18 | License: \tab GPL-2\cr 19 | } 20 | 21 | Version 1.0-0 is based on a completely refactored code base. Some 22 | functions from previsous versions are deprecated. New functions to 23 | create summary tables exist (see \code{\link{summarize}}. The package now 24 | also provides a vignette and was extensively tested using 25 | \code{testthat}. 26 | 27 | For news and changes see \code{news(package = "papeR")}. 28 | } 29 | \author{ 30 | Benjamin Hofner 31 | 32 | Maintainer: Benjamin Hofner 33 | } 34 | 35 | \keyword{package} 36 | -------------------------------------------------------------------------------- /man/prettify.Rd: -------------------------------------------------------------------------------- 1 | \name{prettify} 2 | \alias{prettify} 3 | \alias{prettify.anova} 4 | \alias{prettify.data.frame} 5 | \alias{prettify.summary.lm} 6 | \alias{prettify.summary.glm} 7 | \alias{prettify.summary.coxph} 8 | \alias{prettify.summary.lme} 9 | \alias{prettify.summary.mer} 10 | \alias{prettify.summary.merMod} 11 | \alias{prettifyPValue} 12 | 13 | \title{Make Pretty Summary and Anova Tables} 14 | \description{ 15 | Improve summary tables by replacing variable names with labels and 16 | separating variable names and value labels of factor variables. 17 | Additionally, confidence intervalls are added to summaries per default and 18 | p-values are formated for pretty printing. 19 | } 20 | \usage{ 21 | ## generic function called by all prettify.summary.xxx functions 22 | \method{prettify}{data.frame}(object, labels = NULL, sep = ": ", extra.column = FALSE, 23 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 24 | signif.stars = getOption("show.signif.stars"), ...) 25 | 26 | \method{prettify}{summary.lm}(object, labels = NULL, sep = ": ", extra.column = FALSE, 27 | confint = TRUE, level = 0.95, 28 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 29 | signif.stars = getOption("show.signif.stars"), ...) 30 | 31 | \method{prettify}{summary.glm}(object, labels = NULL, sep = ": ", extra.column = FALSE, 32 | confint = TRUE, level = 0.95, OR = TRUE, 33 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 34 | signif.stars = getOption("show.signif.stars"), ...) 35 | 36 | \method{prettify}{summary.coxph}(object, labels = NULL, sep = ": ", extra.column = FALSE, 37 | confint = TRUE, level = 0.95, HR = TRUE, 38 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 39 | signif.stars = getOption("show.signif.stars"), 40 | env = parent.frame(), ...) 41 | 42 | \method{prettify}{summary.lme}(object, labels = NULL, sep = ": ", extra.column = FALSE, 43 | confint = TRUE, level = 0.95, 44 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 45 | signif.stars = getOption("show.signif.stars"), ...) 46 | 47 | ## method for mixed models fitted with lme4 (vers. < 1.0) 48 | \method{prettify}{summary.mer}(object, labels = NULL, sep = ": ", extra.column = FALSE, 49 | confint = TRUE, level = 0.95, 50 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 51 | signif.stars = getOption("show.signif.stars"), 52 | simulate = c("ifneeded", TRUE, FALSE), B = 1000, ...) 53 | 54 | ## method for mixed models fitted with lme4 (vers. >= 1.0) 55 | \method{prettify}{summary.merMod}(object, labels = NULL, sep = ": ", extra.column = FALSE, 56 | confint = TRUE, level = 0.95, 57 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 58 | signif.stars = getOption("show.signif.stars"), 59 | method = c("profile", "Wald", "boot"), B = 1000, env = parent.frame(), ...) 60 | 61 | \method{prettify}{anova}(object, labels, 62 | smallest.pval = 0.001, digits = NULL, scientific = FALSE, 63 | signif.stars = getOption("show.signif.stars"), ...) 64 | 65 | ## helper function for pretty p-values 66 | prettifyPValue(object, smallest.pval = 0.001, digits = NULL, 67 | scientific = FALSE, 68 | signif.stars = getOption("show.signif.stars"), ...) 69 | } 70 | \arguments{ 71 | \item{object}{ 72 | object of class \code{data.frame} resulting (most likely) from a 73 | call to \code{\link{summary}} or directly the output from 74 | \code{\link{summary}}, \code{\link{anova}} or \code{\link[car]{Anova}} 75 | (the latter from package \pkg{car}). 76 | } 77 | \item{labels}{ 78 | specify labels here. For the format see \code{\link{labels}}. 79 | } 80 | \item{sep}{ 81 | separator between variable label and value label of a factor 82 | variable (default: \code{": "}). 83 | } 84 | \item{extra.column}{ 85 | logical: provide an extra column for the value labels of factors 86 | (default: \code{FALSE}). 87 | } 88 | \item{confint}{ 89 | logical value indicating if confidence intervals sould be added or 90 | the confidence intervals themself. 91 | 92 | Using \code{confint = TRUE} is experimental only and special care 93 | needs to be taken that the data set used for fitting is neither 94 | changed nor deleted. See \sQuote{Details} and \sQuote{Examples}. 95 | } 96 | \item{level}{ 97 | confidence level; Per default 0.95\% confidence 98 | intervals are returned 99 | } 100 | \item{OR}{ 101 | logical. Should odds ratios be added? Only applicable if a logistic 102 | regression model was fitted (i.e., with \code{family = "binomial"}). 103 | } 104 | \item{HR}{ 105 | logical. Should hazard ratios be added? 106 | } 107 | \item{smallest.pval}{ 108 | determines the smallest p-value to be printed 109 | exactly. Smaller values are given as \dQuote{< smallest.pval}. 110 | This argument is passed to the \code{eps} argument of 111 | \code{\link{format.pval}}. See there for details. 112 | } 113 | \item{digits}{ 114 | number of significant digits. The default, \code{NULL}, uses 115 | \code{getOption("digits")} for formating p-values and leaves all 116 | other columns unchanged. If \code{digits} are specified, all columns 117 | use this number of significant digits (columnwise). See also 118 | argument \code{digits} in \code{\link{format}}. 119 | } 120 | \item{scientific}{specifies if numbers should be printed in scientific 121 | format. For details and possible values see \code{\link{format}}. 122 | } 123 | \item{signif.stars}{ 124 | logical (default = TRUE). Should significance stars be added? Per 125 | default system options are used. See \code{ getOption("show.signif.stars")}. 126 | } 127 | \item{simulate}{ 128 | should the asysmptotic or simulated confidence intervals be used? 129 | See \code{\link{confint.mer}} for details. 130 | } 131 | \item{B}{ 132 | number of samples to take in \code{\link[lme4]{mcmcsamp}}. See 133 | \code{\link{confint.mer}} for details. 134 | } 135 | \item{method}{ 136 | Determines the method for computing confidence intervals; One of 137 | \code{"profile"} (default), \code{"Wald"}, \code{"boot"}. For 138 | details see \code{confint.merMod} in package \pkg{lme4}. 139 | } 140 | \item{\dots}{ 141 | further options. Currently not applicable. 142 | } 143 | \item{env}{ 144 | specify environment in which the model was fitted. Needed to find 145 | the correct data for refitting the model in order to obtain 146 | confidence intervals. 147 | } 148 | } 149 | \details{ 150 | Specialized functions that prettify summary tables of various models 151 | exist. For the \code{data.frame} method, \code{extra.column} and 152 | \code{sep} can only be used if \code{labels} are specified as variable 153 | names need to be known in order to split variable name and factor 154 | level. For \code{\link{summary}} objects, variable names can be extracted 155 | from the objects. 156 | 157 | To compute confidence intervalls, the model is refitted internally 158 | extrating the call and environment from the model summary. All 159 | functions then use \code{\link{confint}} on the refitted model. For 160 | \code{mer} models special \code{\link[=confint.mer]{confint}} functions 161 | are defined in this package (for backward compatibility). For details see there. 162 | Note that is it highly important 163 | \bold{not} to modify or delete the data in the fitting environment if 164 | one wants to obtain correct confidence intervals. See examples for what 165 | might happen. We try ourt best to find changes of the data and to warn 166 | the user (but without any warranty). 167 | 168 | Alternatively, one can directly specify the confidence intervals using 169 | e.g. \code{confint = confint(model)}, where \code{model} is the fitted 170 | model. This does not rely on refitting of the model and should always 171 | work as expected. In this case, arguments \code{level}, 172 | \code{simulate} and \code{B} are ignored. Note that in this case it is 173 | adviced to also specify the labels by hand! 174 | 175 | \code{prettifyPValue} is a helper function used within the prettify 176 | functions but can also be used directly on a \code{data.frame} object. 177 | The function tries to (cleverly) \dQuote{guess} the column of p-values 178 | (based on the column names) and formats them nicely. Additionally, 179 | significance stars are added if requested. 180 | 181 | } 182 | \value{ 183 | \code{data.frame} with prettier variable labels. 184 | For summary functions additionally confidence 185 | intervalls (if requested), odds ratio (for logistic regression models, 186 | if requested), p-values formated for pretty printing and significance 187 | stars (if requested) are attached. 188 | } 189 | \author{ 190 | Benjamin Hofner 191 | } 192 | 193 | \seealso{ 194 | \code{\link{summary}}, \code{\link{summary.lm}}, 195 | \code{\link{summary.glm}}, \code{\link[nlme]{summary.lme}}, 196 | \code{\link[lme4]{summary.merMod}} (or \code{summary.mer-class} in \pkg{lme4} < 1.0) 197 | and \code{\link[survival]{summary.coxph}} for summary functions. 198 | 199 | \code{\link{anova}} and \code{\link[car]{Anova}} for ANOVA functions. 200 | 201 | \code{\link{confint}} and \code{\link[gmodels]{ci}} for confidence intervals. 202 | Special functions are implemented for mixed models: 203 | \code{\link{confint.mer}}. 204 | } 205 | \examples{ 206 | ## Example requires package nlme to be installed and loaded 207 | if (require("nlme")) { 208 | ## Load data set Orthodont 209 | data(Orthodont, package = "nlme") 210 | 211 | ###################################################################### 212 | # Linear model 213 | ###################################################################### 214 | 215 | ## Fit a linear model 216 | linmod <- lm(distance ~ age + Sex, data = Orthodont) 217 | ## Extract pretty summary 218 | prettify(summary(linmod)) 219 | 220 | ## Extract anova (sequential tests) 221 | anova(linmod) 222 | ## now prettify it 223 | prettify(anova(linmod)) 224 | 225 | ###################################################################### 226 | # Random effects model (nlme) 227 | ###################################################################### 228 | 229 | ### (fit a more suitable model with random effects) 230 | ## With package nlme: 231 | require("nlme") 232 | ## Fit a model for distance with random intercept for Subject 233 | mod <- lme(distance ~ age + Sex, data = Orthodont, random = ~ 1 | Subject) 234 | summary(mod) 235 | ## Extract fixed effects table, add confidence interval and make it pretty 236 | prettify(summary(mod)) 237 | ## Extract fixed effects table only and make it pretty 238 | prettify(summary(mod), confint = FALSE) 239 | 240 | ###################################################################### 241 | # Random effects model (lme4) 242 | ###################################################################### 243 | 244 | set.seed(130913) 245 | 246 | ## With package lme4: 247 | if (require("lme4") && require("car")) { 248 | ## Fit a model for distance with random intercept for Subject 249 | mod4 <- lmer(distance ~ age + Sex + (1|Subject), data = Orthodont) 250 | summary(mod4) 251 | ## Extract fixed effects table and make it pretty 252 | prettify(summary(mod4)) 253 | 254 | ## Extract and prettify anova (sequential tests) 255 | prettify(anova(mod4)) 256 | 257 | ## Better: extract Anova (partial instead of sequential tests) 258 | library("car") 259 | Anova(mod4) 260 | ## now prettify it 261 | prettify(Anova(mod4)) 262 | } 263 | 264 | ###################################################################### 265 | # Cox model 266 | ###################################################################### 267 | 268 | ## survival models 269 | if (require("survival")) { 270 | ## Load data set ovarian (now part of cancer) 271 | data(cancer, package = "survival") 272 | 273 | ## fit a Cox model 274 | mod5 <- coxph(Surv(futime, fustat) ~ age, data=ovarian) 275 | summary(mod5) 276 | ## Make pretty summary 277 | prettify(summary(mod5)) 278 | 279 | ## Make pretty summary 280 | prettify(Anova(mod5)) 281 | } 282 | 283 | 284 | ###################################################################### 285 | # ATTENTION when confint = TRUE: Do not modify or delete data 286 | ###################################################################### 287 | 288 | ## Fit a linear model (same as above) 289 | linmod <- lm(distance ~ age + Sex, data = Orthodont) 290 | ## Extract pretty summary 291 | prettify(summary(linmod)) 292 | 293 | ## Change the data (age in month instead of years) 294 | Orthodont$age <- Orthodont$age * 12 295 | prettify(summary(linmod)) ## confidence intervals for age have changed 296 | ## but coefficients stayed the same; a 297 | ## warning is issued 298 | 299 | ## Remove data in fitting environment 300 | rm(Orthodont) 301 | prettify(summary(linmod)) ## confidence intervals are missing as no 302 | ## data set was available to refit the model 303 | 304 | 305 | 306 | ###################################################################### 307 | # Use confint to specify confidence interval without refitting 308 | ###################################################################### 309 | 310 | ## make labels without using the data set 311 | labels <- c("distance", "age", "Subject", "Sex") 312 | names(labels) <- labels 313 | 314 | ## usually easier via: labels(Orthodont) 315 | 316 | prettify(summary(linmod), confint = confint(linmod), 317 | labels = labels) 318 | } 319 | } 320 | 321 | \keyword{methods} 322 | \keyword{models} 323 | -------------------------------------------------------------------------------- /man/summarize.Rd: -------------------------------------------------------------------------------- 1 | \name{summarize} 2 | \alias{summarize} 3 | \alias{summarise} 4 | 5 | \title{ Produce Summary Tables for Data Sets} 6 | \description{ 7 | The function produces summary tables for factors and continuous 8 | variables. The obtained tables can be used directly in R, with LaTeX 9 | and HTML (by using the \code{\link[xtable]{xtable}} function) or Markdown 10 | (e.g. by using the function \code{\link[knitr]{kable}}). 11 | } 12 | \usage{ 13 | summarize(data, type = c("numeric", "factor"), 14 | variables = names(data), variable.labels = labels, labels = NULL, 15 | group = NULL, test = !is.null(group), colnames = NULL, 16 | digits = NULL, digits.pval = 3, smallest.pval = 0.001, 17 | sep = NULL, sanitize = TRUE, drop = TRUE, 18 | show.NAs = any(is.na(data[, variables])), ...) 19 | } 20 | 21 | \arguments{ 22 | \item{data}{ 23 | data set to be used. 24 | } 25 | \item{type}{ 26 | print summary table for either \code{numeric} or \code{factor} 27 | variables. 28 | } 29 | \item{variables}{ 30 | character vector defining variables that should be included in the 31 | table. Per default, all numeric or factor variables of \code{data} 32 | are used, depending on \code{type}. 33 | } 34 | \item{variable.labels, labels}{ 35 | labels for the variables. If \code{variable.labels = NULL} (default) 36 | \code{variables} is used as label. If \code{variable.labels = TRUE}, 37 | \code{labels(data, which = variables)} is used as labels. Instead of 38 | \code{variable.labels} one can also use \code{labels}. 39 | } 40 | \item{group}{ 41 | character specifying a grouping factor. Per default no grouping is 42 | applied. 43 | } 44 | \item{test}{ 45 | logical or character string. If a \code{group} is given, this argument 46 | determines whether a test for group differences is computed. For 47 | details see \code{\link{summarize_numeric}} and 48 | \code{\link{summarize_factor}}. 49 | } 50 | \item{colnames}{ 51 | a vector of character strings of appropriate length. 52 | The vector supplies alternative column names for the resulting 53 | table. If \code{NULL} default names are used. 54 | } 55 | \item{digits}{ 56 | number of digits to round to. For defaults see 57 | \code{\link{summarize_numeric}} and \code{\link{summarize_factor}}. 58 | } 59 | \item{digits.pval}{ 60 | number of significant digits used for p-values. 61 | } 62 | \item{smallest.pval}{ 63 | determines the smallest p-value to be printed 64 | exactly. Smaller values are given as \dQuote{< smallest.pval}. 65 | This argument is passed to the \code{eps} argument of 66 | \code{\link{format.pval}}. See there for details. 67 | } 68 | \item{sep}{ 69 | logical. Determines whether separators (lines) should be added after 70 | each variable. For defaults see \code{\link{summarize_numeric}} and 71 | \code{\link{summarize_factor}}. 72 | } 73 | \item{sanitize}{ 74 | logical (default: \code{TRUE}) or a sanitizing function used to clean the 75 | input in order to be useable in LaTeX environments. Per default 76 | \code{\link{toLatex.character}} is used. 77 | } 78 | \item{drop}{ 79 | logical (default: \code{TRUE}). Determines whether variables, which contain 80 | only missing values are dropped from the table. 81 | } 82 | \item{show.NAs}{ 83 | logical. Determines if NAs are displayed. Per default, 84 | \code{show.NAs} is \code{TRUE} if there are any missings in the 85 | variables to be displayed (and \code{FALSE} if not). For details see 86 | \code{\link{summarize_numeric}} and \code{\link{summarize_factor}}. 87 | } 88 | \item{...}{ 89 | additional arguments for \code{\link{summarize_numeric}} and 90 | \code{\link{summarize_factor}}. See there for details. 91 | } 92 | 93 | } 94 | \value{ 95 | A special \code{data.frame} with additional class \code{summary} 96 | containing the computed statistics is returned from function 97 | \code{summarize}. Addtional attributes required for the 98 | \code{\link{xtable.summary}} or \code{\link{print.xtable.summary}} 99 | function are contained as attributes. These are extracted using the 100 | function \code{\link{get_option}}. 101 | } 102 | \author{ 103 | Benjamin Hofner 104 | } 105 | \seealso{ 106 | For details see 107 | \code{\link{summarize_numeric}} and \code{\link{summarize_factor}}. 108 | 109 | Conversion to LaTeX tables can be done using 110 | \code{\link{xtable.summary}} and \code{\link{print.xtable.summary}}. 111 | 112 | \code{\link{get_option}} 113 | } 114 | \examples{ 115 | if (require("nlme")) { 116 | ## Use dataset Orthodont 117 | data(Orthodont, package = "nlme") 118 | 119 | ## Get summary for continuous variables 120 | (tab1 <- summarize(Orthodont, type = "numeric")) 121 | 122 | ## Change statistics to display 123 | summarize(Orthodont, quantiles = FALSE, type = "numeric") 124 | summarize(Orthodont, quantiles = FALSE, count = FALSE, type = "numeric") 125 | summarize(Orthodont, mean_sd = FALSE, type = "numeric") 126 | 127 | ## Get summary for categorical variables 128 | (tab2 <- summarize(Orthodont, type = "fac")) 129 | 130 | ## use fraction instead of percentage 131 | summarize(Orthodont, percent = FALSE, type = "fac") 132 | 133 | ## Using the tables with Markdown 134 | if (require("knitr")) { 135 | kable(tab1) 136 | kable(tab2) 137 | } 138 | 139 | ## Using the tables with LaTeX 140 | if (require("xtable")) { 141 | xtable(tab1) 142 | ## grouped table 143 | xtable(summarize(Orthodont, group = "Sex")) 144 | xtable(tab2) 145 | } 146 | } 147 | } 148 | 149 | \keyword{univar} 150 | \keyword{IO} 151 | \keyword{print} 152 | -------------------------------------------------------------------------------- /man/summarize_factor.Rd: -------------------------------------------------------------------------------- 1 | \name{summarize_factor} 2 | \alias{summarize_factor} 3 | 4 | \title{ Produce Summary Tables for Data Sets} 5 | \description{ 6 | The function produces summary tables for factor variables. 7 | The obtained tables can be used directly in R, with LaTeX 8 | and HTML (by using the \code{\link[xtable]{xtable}} function) or Markdown 9 | (e.g. by using the function \code{\link[knitr]{kable}}). 10 | } 11 | \usage{ 12 | summarize_factor(data, 13 | variables = names(data), variable.labels = labels, labels = NULL, 14 | group = NULL, test = !is.null(group), colnames = NULL, 15 | digits = 3, digits.pval = 3, smallest.pval = 0.001, 16 | sep = TRUE, sanitize = TRUE, drop = TRUE, 17 | show.NAs = any(is.na(data[, variables])), 18 | ## additional specific arguments 19 | percent = TRUE, cumulative = FALSE, 20 | na.lab = "", ...) 21 | } 22 | 23 | \arguments{ 24 | \item{data}{ 25 | data set to be used. 26 | } 27 | \item{variables}{ 28 | variables that should be included in the table. 29 | For details see \code{\link{summarize}}. 30 | } 31 | \item{variable.labels, labels}{ 32 | labels for the variables. 33 | For details see \code{\link{summarize}}. 34 | } 35 | \item{group}{ 36 | character specifying a grouping factor. 37 | For details see \code{\link{summarize}}. 38 | } 39 | \item{test}{ 40 | logical or charachter specifying test for group differences. 41 | For details see \code{\link{summarize}}. 42 | } 43 | \item{colnames}{ 44 | a vector of character strings of appropriate length. 45 | For details see \code{\link{summarize}}. 46 | } 47 | \item{digits}{ 48 | number of digits to round to (only used for fractions). Per default 49 | all values are rounded to three digits. 50 | } 51 | \item{digits.pval}{ 52 | number of significant digits used for p-values. 53 | } 54 | \item{smallest.pval}{ 55 | determines the smallest p-value to be printed exactly. 56 | For details see \code{\link{summarize}}. 57 | } 58 | \item{sep}{ 59 | logical (default: \code{TRUE}). Determines whether separators 60 | (lines) should be added after each variable. 61 | } 62 | \item{sanitize}{ 63 | logical (default: \code{TRUE}) or a sanitizing function. 64 | For details see \code{\link{summarize}}. 65 | } 66 | \item{drop}{ 67 | logical (default: \code{TRUE}). Determines whether variables, which contain 68 | only missing values are dropped from the table. 69 | } 70 | \item{show.NAs}{ 71 | logical. Determines if NAs are displayed as a separate category for 72 | each factor variable with missings. If \code{TRUE}, an additional 73 | statistic which includes the missings is displayed (see Examples). 74 | Per default, \code{show.NAs} is \code{TRUE} if there are any 75 | missings in the variables to be displayed (and \code{FALSE} if not). 76 | } 77 | \item{percent}{ 78 | logical. Should the fractions be given as percent values? Otherwise, 79 | fractions are given as decimal numbers. 80 | } 81 | \item{cumulative}{ 82 | logical. Should cumulative fractions be displayed? 83 | } 84 | \item{na.lab}{ 85 | label for missing values (default: \code{""}). 86 | } 87 | \item{...}{ 88 | additional arguments. Currently not used. 89 | } 90 | 91 | } 92 | \value{ 93 | A special \code{data.frame} with additional class \code{summary} 94 | containing the computed statistics is returned from function 95 | \code{summarize}. Addtional attributes required for the 96 | \code{\link{xtable.summary}} or \code{\link{print.xtable.summary}} 97 | function are contained as attributes. These are extracted using the 98 | function \code{\link{get_option}}. 99 | } 100 | \author{ 101 | Benjamin Hofner 102 | } 103 | \seealso{ 104 | For details see \code{link{summarize}} and \code{link{summarize_factor}}. 105 | 106 | Conversion to LaTeX tables can be done using 107 | \code{\link{xtable.summary}} and \code{\link{print.xtable.summary}}. 108 | 109 | \code{\link{get_option}} 110 | } 111 | \examples{ 112 | ## Example requires package nlme to be installed and loaded 113 | if (require("nlme")) { 114 | ## Use dataset Orthodont 115 | data(Orthodont, package = "nlme") 116 | 117 | ## Get summary for continuous variables 118 | summarize(Orthodont, type = "factor") 119 | 120 | ## Reorder data for table: 121 | summarize(Orthodont, variables = c("Sex", "Subject"), type = "factor") 122 | 123 | ## What happens in the display if we introduce some missing values: 124 | set.seed(1907) 125 | Orthodont$Sex[sample(nrow(Orthodont), 20)] <- NA 126 | summarize(Orthodont, type = "factor") 127 | summarize(Orthodont, variables = "Sex", type = "factor") 128 | ## do not show statistics on missing values 129 | summarize(Orthodont, variables = "Sex", show.NAs = FALSE, type = "factor") 130 | } 131 | } 132 | 133 | \keyword{univar} 134 | \keyword{IO} 135 | \keyword{print} 136 | -------------------------------------------------------------------------------- /man/summarize_numeric.Rd: -------------------------------------------------------------------------------- 1 | \name{summarize_numeric} 2 | \alias{summarize_numeric} 3 | 4 | \title{ Produce Summary Tables for Data Sets} 5 | \description{ 6 | The function produces summary tables for continuous 7 | variables. The obtained tables can be used directly in R, with LaTeX 8 | and HTML (by using the \code{\link[xtable]{xtable}} function) or Markdown 9 | (e.g. by using the function \code{\link[knitr]{kable}}). 10 | } 11 | \usage{ 12 | summarize_numeric(data, 13 | variables = names(data), variable.labels = labels, labels = NULL, 14 | group = NULL, test = !is.null(group), colnames = NULL, 15 | digits = 2, digits.pval = 3, smallest.pval = 0.001, 16 | sep = !is.null(group), sanitize = TRUE, 17 | drop = TRUE, show.NAs = any(is.na(data[, variables])), 18 | ## additional specific arguments 19 | count = TRUE, mean_sd = TRUE, quantiles = TRUE, 20 | incl_outliers = TRUE, ...) 21 | } 22 | 23 | \arguments{ 24 | \item{data}{ 25 | data set to be used. 26 | } 27 | \item{variables}{ 28 | variables that should be included in the table. 29 | For details see \code{\link{summarize}}. 30 | } 31 | \item{variable.labels, labels}{ 32 | labels for the variables. 33 | For details see \code{\link{summarize}}. 34 | } 35 | \item{group}{ 36 | character specifying a grouping factor. 37 | For details see \code{\link{summarize}}. 38 | } 39 | \item{test}{ 40 | logical or charachter specifying test for group differences. 41 | For details see \code{\link{summarize}}. 42 | } 43 | \item{colnames}{ 44 | a vector of character strings of appropriate length. 45 | For details see \code{\link{summarize}}. 46 | } 47 | \item{digits}{ 48 | number of digits to round to. Per default all values are rounded to 49 | two digits. 50 | } 51 | \item{digits.pval}{ 52 | number of significant digits used for p-values. 53 | } 54 | \item{smallest.pval}{ 55 | determines the smallest p-value to be printed exactly. 56 | For details see \code{\link{summarize}}. 57 | } 58 | \item{sep}{ 59 | logical (default: \code{TRUE} if grouping specified, \code{FALSE} otherwise). 60 | Determines whether separators (lines) should be added after 61 | each variable. 62 | } 63 | \item{sanitize}{ 64 | logical (default: \code{TRUE}) or a sanitizing function. 65 | For details see \code{\link{summarize}}. 66 | } 67 | \item{drop}{ 68 | logical (default: \code{TRUE}). Determines whether variables, which contain 69 | only missing values are dropped from the table. 70 | } 71 | \item{show.NAs}{ 72 | logical. Determines if the number of missings (NAs) is displayed as 73 | a separate column. Per default, \code{show.NAs} is \code{TRUE} if 74 | there are any missings in the variables to be displayed (and 75 | \code{FALSE} if not). 76 | } 77 | \item{count}{ 78 | (logical) indicator if number of complete cases ("n") should be 79 | included in the table (default: \code{TRUE}). 80 | } 81 | \item{mean_sd}{ 82 | (logical) indicator if mean and standard deviation should be 83 | included in the table (default: \code{TRUE}). 84 | } 85 | \item{quantiles}{ 86 | (logical) indicator if quantiles (including min and max) should be 87 | included in the table (default: \code{TRUE}). 88 | } 89 | \item{incl_outliers}{ 90 | Per default we use \code{\link{fivenum}} to compute the quantiles 91 | (if \code{quantiles = TRUE}). If extreme values should be excluded 92 | from min/max in the table, \code{boxplot( , plot = FALSE)$stats} is 93 | used instead. 94 | } 95 | \item{...}{ 96 | additional arguments. Currently not used. 97 | } 98 | 99 | } 100 | \value{ 101 | A special \code{data.frame} with additional class \code{summary} 102 | containing the computed statistics is returned from function 103 | \code{summarize}. Addtional attributes required for the 104 | \code{\link{xtable.summary}} or \code{\link{print.xtable.summary}} 105 | function are contained as attributes. These are extracted using the 106 | function \code{\link{get_option}}. 107 | } 108 | \author{ 109 | Benjamin Hofner 110 | } 111 | \seealso{ 112 | For details see \code{link{summarize}} and \code{link{summarize_factor}}. 113 | 114 | Conversion to LaTeX tables can be done using 115 | \code{\link{xtable.summary}} and \code{\link{print.xtable.summary}}. 116 | 117 | \code{\link{get_option}} 118 | } 119 | \examples{ 120 | if (require("nlme")) { 121 | ## Use dataset Orthodont 122 | data(Orthodont, package = "nlme") 123 | 124 | ## Get summary for continuous variables 125 | summarize(Orthodont, type = "numeric") 126 | 127 | ## Change statistics to display 128 | summarize(Orthodont, quantiles = FALSE, type = "numeric") 129 | summarize(Orthodont, quantiles = FALSE, count = FALSE, type = "numeric") 130 | summarize(Orthodont, mean_sd = FALSE, type = "numeric") 131 | 132 | ## for more examples see ?summarize 133 | } 134 | } 135 | 136 | \keyword{univar} 137 | \keyword{IO} 138 | \keyword{print} 139 | -------------------------------------------------------------------------------- /man/toLatex.Rd: -------------------------------------------------------------------------------- 1 | \name{toLatex} 2 | \alias{toLatex} 3 | \alias{toLatex.character} 4 | \alias{toLatex.sessionInfo} 5 | 6 | \title{ Cleaning R Code for printing in LaTeX environments } 7 | \description{ 8 | The function produces code that LaTeX is able to typeset. 9 | } 10 | \usage{ 11 | \method{toLatex}{character}(object, ...) 12 | 13 | \method{toLatex}{sessionInfo}(object, pkgs = NULL, locale = FALSE, 14 | base.pkgs = FALSE, other.pkgs = TRUE, 15 | namespace.pkgs = FALSE, citations = TRUE, 16 | citecommand = "\\\\citep", file = NULL, 17 | append = FALSE, ...) 18 | } 19 | 20 | \arguments{ 21 | \item{object}{ 22 | either an object of class character which should be cleaned for printing in 23 | LaTeX environments or an object of class \code{\link{sessionInfo}}. 24 | } 25 | \item{pkgs}{ 26 | character vector (optional). Specify specific packages here to show 27 | information on these (instead of all attached packages). See 28 | \code{package} in \code{\link{sessionInfo}}. 29 | } 30 | \item{locale}{ 31 | logical (default = FALSE). Show information on locale. 32 | } 33 | \item{base.pkgs}{ 34 | logical (default = FALSE). Show information on base packages. 35 | } 36 | \item{other.pkgs}{ 37 | logical (default = TRUE). Show information on currently attached 38 | packages. If \code{pkgs} is specified, information on these 39 | packages is given instead of all attached packages. 40 | } 41 | \item{namespace.pkgs}{ 42 | logical (default = FALSE). Show information on packages whose 43 | namespaces are currently loaded but not attached. 44 | } 45 | \item{citations}{ 46 | logical (default = TRUE). Should citations for all packages be 47 | added? BibTeX is used for storing the citations. 48 | } 49 | \item{citecommand}{ 50 | Specify LaTeX-command for citation here. Curly brackets are added 51 | internally. Note that \code{\\} needs to be escaped, i.e., one needs 52 | to write \code{\\\\} instead. 53 | } 54 | \item{file}{ 55 | Specify path to BibTeX file where citations should be saved. If 56 | \code{file = NULL} is specified, the BibTeX entries are attached to 57 | the output as attribute \code{"BibTeX"}. See examples for details. 58 | } 59 | \item{append}{ 60 | logical (default = FALSE). Should citations be added to an existing 61 | BibTeX file (if existing) or should old BibTeX files be overwritten? 62 | } 63 | \item{...}{ 64 | additional arguments. Currently not used. 65 | } 66 | } 67 | \value{ 68 | A character string with special markup is returned: The output is 69 | printed with LaTeX style syntax highlighting to be used 70 | e.g. in Sweave chunks with \code{results=tex}. 71 | } 72 | \author{ 73 | Benjamin Hofner, based on code from package xtable, bibtex and package utils. 74 | See source code for documentation. 75 | } 76 | \seealso{ 77 | \code{\link{toLatex}}. For details on \code{toLatex.sessionInfo} see 78 | also \code{\link{sessionInfo}}. 79 | } 80 | \examples{ 81 | txt <- "Price: <= 500$ & additional goodies" 82 | toLatex(txt) 83 | 84 | ############################################################ 85 | ## session info for automatic inclusion in reports 86 | 87 | info <- toLatex(sessionInfo()) 88 | info 89 | 90 | ## extract first part (the Latex part) 91 | toLatex(info) 92 | ## extract second part (the BibTeX part) 93 | toBibtex(info) 94 | 95 | 96 | ############################################################ 97 | ## usual usage scenario 98 | 99 | ## Do not run the following code automatically as it needs 100 | ## write access to the current working directory. 101 | ## This code (without removing the file) could for example 102 | ## be included in a LaTeX chunk of your Sweave or knitr 103 | ## report. 104 | 105 | \dontrun{getwd() ## location where write access is needed 106 | toLatex(sessionInfo(), file = "packages.bib") 107 | file.remove("packages.bib") 108 | } 109 | 110 | } 111 | 112 | \keyword{univar} 113 | \keyword{IO} 114 | \keyword{print} 115 | -------------------------------------------------------------------------------- /man/xtable_summary.Rd: -------------------------------------------------------------------------------- 1 | \name{xtable.summary} 2 | \alias{xtable} 3 | \alias{xtable.summary} 4 | \alias{print.xtable} 5 | \alias{print.xtable.summary} 6 | 7 | \title{ Create And Print Tables With Markup } 8 | \description{ 9 | The function produces objects which can be printed to LaTeX 10 | and HTML code. 11 | } 12 | \usage{ 13 | 14 | \method{xtable}{summary}(x, caption = NULL, label = NULL, align = NULL, 15 | digits = NULL, display = NULL, ...) 16 | 17 | \method{print}{xtable.summary}(x, rules = NULL, header = NULL, 18 | caption.placement = getOption("xtable.caption.placement", "top"), 19 | hline.after = getOption("xtable.hline.after", NULL), 20 | include.rownames = FALSE, 21 | add.to.row = getOption("xtable.add.to.row", NULL), 22 | booktabs = getOption("xtable.booktabs", TRUE), 23 | sanitize.text.function = get_option(x, "sanitize"), 24 | math.style.negative = getOption("xtable.math.style.negative", TRUE), 25 | math.style.exponents = getOption("xtable.math.style.exponents", TRUE), 26 | tabular.environment = getOption("xtable.tabular.environment", "tabular"), 27 | floating = getOption("xtable.floating", FALSE), 28 | latex.environments = getOption("xtable.latex.environments", c("center")), 29 | ...) 30 | 31 | } 32 | 33 | \arguments{ 34 | \item{x}{ 35 | object of class \code{"summary"}, which is produced by the 36 | function \code{\link{summarize}} or an object of class 37 | \code{"xtable.summary"} produced by \code{xtable}. 38 | } 39 | \item{caption}{ 40 | character vector specifying the table's caption; see 41 | \code{\link[xtable]{xtable}} for details. 42 | } 43 | \item{label}{ 44 | character string specifying the LaTeX label or HTML anchor; see 45 | \code{\link[xtable]{xtable}} for details. 46 | } 47 | \item{align}{ 48 | character string specifying the alignment of table columns; see 49 | \code{\link[xtable]{xtable}} for details. 50 | } 51 | \item{digits}{ 52 | numeric vector specifying the number of digits to display in each 53 | column; see \code{\link[xtable]{xtable}} for details. 54 | } 55 | \item{display}{ 56 | character string specifying the column types; see 57 | \code{\link[xtable]{xtable}} for details. 58 | } 59 | 60 | \item{rules}{ 61 | character string specifying the rules to be used. Per default the 62 | \code{rules} are defined by \code{\link{summarize}} and subsequently 63 | extracted from \code{x} via \code{get_option(x, "rules")}. 64 | } 65 | \item{header}{ 66 | character string specifying the table header to be used. Per default the 67 | \code{header} is defined by \code{\link{summarize}} and subsequently 68 | extracted from \code{x} via \code{get_option(x, "header")}. 69 | } 70 | \item{caption.placement}{ 71 | can be either \code{"bottom"} or \code{"top"} (default). Note that 72 | the standard default of \code{\link[xtable]{print.xtable}} 73 | is \code{"bottom"}. 74 | } 75 | \item{hline.after}{ 76 | vector indicating the rows after which a horizontal line is printed. 77 | Here, the default is to not draw hlines (i.e. \code{hline.after = 78 | NULL}) and horizontal lines are added via \code{add.to.row} 79 | (see there for details). Note that the standard default of 80 | \code{\link[xtable]{print.xtable}} is \code{c(-1,0,nrow(x))}. 81 | } 82 | \item{add.to.row}{ 83 | list of row numbers (\code{pos}) and text (\code{command}) to be 84 | added to the specified rows. Per default, top and bottom rules are 85 | added to the table and a rule specified in \code{rules} is added 86 | below the heading. If \code{sep = TRUE} in \code{\link{summarize}} 87 | additional separators (as specified in \code{rules}) are added after 88 | each variable. 89 | } 90 | \item{include.rownames}{ 91 | logical. Always set to \code{FALSE}. 92 | } 93 | \item{booktabs}{ 94 | logical. If \code{TRUE} (default), the \code{toprule}, 95 | \code{midrule} and \code{bottomrule} tags from the LaTeX package 96 | \code{"booktabs"} are used rather than \code{hline} for the 97 | horizontal line tags. Note that the standard default of 98 | \code{\link[xtable]{print.xtable}} is \code{FALSE}. 99 | } 100 | \item{sanitize.text.function}{ 101 | All non-numeric enteries (except row and column names) are sanitised 102 | in an attempt to remove characters which have special meaning for 103 | the output format. Per default the function \code{\link{toLatex}} is 104 | used to sanitize the text. For more options see 105 | \code{\link[xtable]{print.xtable}}. 106 | } 107 | \item{math.style.negative}{ 108 | logical. If \code{TRUE} (default) the negative sign is wrapped in 109 | dollar signs for LaTeX tables. Note that the standard default of 110 | \code{\link[xtable]{print.xtable}} is \code{FALSE}. 111 | } 112 | \item{math.style.exponents}{ 113 | logical. If \code{TRUE} (default) scientific numers are set as 114 | exponents. See \code{\link[xtable]{print.xtable}} for details. 115 | Note that the standard default of \code{\link[xtable]{print.xtable}} 116 | is \code{FALSE}. 117 | } 118 | \item{tabular.environment}{ 119 | character string. Per default \code{"tabular"} is used. For long 120 | tables that span over more than one page, one can use 121 | \code{"longtable"}. For more options see 122 | \code{\link[xtable]{print.xtable}}. 123 | } 124 | \item{floating}{ 125 | logical. Determine if the table is printed in a floating 126 | environment. Note that the standard default of 127 | \code{\link[xtable]{print.xtable}} is \code{TRUE}. See there for 128 | details. 129 | } 130 | \item{latex.environments}{ 131 | character string. Per default \code{"center"} is used. In contrast 132 | to the default behavior of \code{\link[xtable]{print.xtable}}, 133 | tables are also centered if no floating environment is used. For 134 | details and more options see \code{\link[xtable]{print.xtable}}. 135 | } 136 | \item{...}{ 137 | additional arguments passed to \code{\link[xtable]{xtable}} or 138 | \code{\link[xtable]{print.xtable}}. See there for details. 139 | } 140 | } 141 | \details{ 142 | We use the standard \code{xtable} function but add a special class 143 | that allows different defaults in the \code{print.xtable} function. 144 | 145 | In general, all options of \code{print.xtable} can be used as well as 146 | global options set via \code{options()}. E.g. 147 | \code{options(xtable.booktabs = FALSE} 148 | will set the argument \code{booktabs} per default to 149 | \code{FALSE} for all calls to \code{print.xtable}. 150 | } 151 | \value{ 152 | After printing, a table with LaTeX markup is returned. 153 | } 154 | \author{ 155 | Benjamin Hofner 156 | } 157 | \seealso{ 158 | For details see \code{\link[xtable]{xtable}} and 159 | \code{\link[xtable]{print.xtable}}. 160 | 161 | \code{\link{summarize}}, \code{\link{get_option}} 162 | } 163 | \examples{ 164 | if (require("nlme")) { 165 | ## Use dataset Orthodont 166 | data(Orthodont, package = "nlme") 167 | 168 | ## Get summary for continuous variables 169 | (tab1 <- summarize(Orthodont, type = "numeric")) 170 | 171 | ## Get summary for categorical variables 172 | (tab2 <- summarize(Orthodont, type = "fac")) 173 | 174 | ## Using the tables with LaTeX 175 | if (require("xtable")) { 176 | xtable(tab1) 177 | ## grouped table 178 | xtable(summarize(Orthodont, group = "Sex")) 179 | xtable(tab2) 180 | } 181 | } 182 | } 183 | 184 | \keyword{univar} 185 | \keyword{IO} 186 | \keyword{print} 187 | -------------------------------------------------------------------------------- /tests/regtest-plot.R: -------------------------------------------------------------------------------- 1 | ##### 2 | ## Tests for plot interface 3 | 4 | require("papeR") 5 | 6 | ## make sure other plot functions work 7 | example("plot.data.frame", package = "graphics", ask = FALSE) 8 | example("plot.formula", package = "graphics", ask = FALSE) 9 | 10 | #### 11 | ## check plot.ldf 12 | 13 | data <- data.frame(a = 1:10, b = 10:1, c = rep(1:2, 5)) 14 | data$z <- as.factor(rep(2:3, each = 5)) 15 | data <- as.ldf(data) 16 | 17 | ## plot the data auto"magically"; numerics as boxplot, factors as barplots 18 | par(mfrow = c(2,2)) 19 | plot(data) 20 | 21 | ## a single plot 22 | plot(data, variables = "a") 23 | ## grouped plot 24 | plot(data, variables = "a", by = "z") 25 | ## make "c" a factor and plot "c" vs. "z" 26 | data$c <- as.factor(data$c) 27 | plot(data, variables = "c", by = "z") 28 | ## the same 29 | plot(data, variables = 3, by = 4) 30 | 31 | ## plot everithing against "b" 32 | ## (grouped boxplots, stacked barplots or scatterplots) 33 | plot(data, with = "b") 34 | -------------------------------------------------------------------------------- /tests/regtest-summarize.R: -------------------------------------------------------------------------------- 1 | ##### 2 | ## Tests for summary tables 3 | require("papeR") 4 | 5 | if (require("nlme")) { 6 | ## Use dataset Orthodont 7 | data(Orthodont, package = "nlme") 8 | 9 | ## Get summary for continuous variables 10 | (tab1 <- summarize(Orthodont, type = "numeric")) 11 | get_option(tab1, "sep") 12 | summary(tab1) 13 | ## check handling of digits and sep 14 | (tab1a <- summarize(Orthodont, type = "numeric", digits = 3, sep = TRUE)) 15 | get_option(tab1a, "sep") 16 | 17 | ## Change statistics to display 18 | summarize(Orthodont, quantiles = FALSE, type = "numeric") 19 | summarize(Orthodont, quantiles = FALSE, count = FALSE, type = "numeric") 20 | (tmp <- summarize(Orthodont, mean_sd = FALSE, type = "numeric")) 21 | 22 | ## Get summary for categorical variables 23 | (tab2 <- summarize(Orthodont, type = "fac")) 24 | get_option(tab2, "sep") 25 | summary(tab2) 26 | ## check handling of digits and sep 27 | (tab2a <- summarize(Orthodont, type = "fac", digits = 4, sep = FALSE)) 28 | get_option(tab2a, "sep") 29 | 30 | ## use fraction instead of percentage 31 | summarize(Orthodont, percent = FALSE, type = "fac") 32 | 33 | ## try using the tables with Markdown 34 | if (require("knitr")) { 35 | kable(tab1) 36 | kable(tab2) 37 | } 38 | 39 | if (require("xtable")) { 40 | ans <- xtable(tab1) 41 | print(ans) 42 | ## grouped 43 | xtable(summarize(Orthodont, group = "Sex")) 44 | print(xtable(tab2)) 45 | } 46 | } 47 | 48 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(papeR) 3 | 4 | test_check("papeR") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-helpers.R: -------------------------------------------------------------------------------- 1 | library("papeR") 2 | context("helper functions") 3 | 4 | ############################################################ 5 | ## mySapply 6 | ############################################################ 7 | set.seed(1234) 8 | df <- data.frame(x = rnorm(100), y = rnorm(100)) 9 | 10 | test_that("mySapply dispatches correctly on data.frames", { 11 | expect_equal(names(mySapply(df, mean)), c("x", "y")) 12 | expect_equal(mySapply(df, mean), sapply(df, mean)) 13 | }) 14 | 15 | test_that("mySapply dispatches correctly on vectors", { 16 | expect_equal(length(mySapply(df$x, mean)), 1) 17 | expect_equal(mySapply(df$x, mean), mean(df$x)) 18 | }) 19 | 20 | 21 | ############################################################ 22 | ## ADD TESTS FOR Anova.lme() 23 | ############################################################ 24 | 25 | 26 | 27 | 28 | 29 | ############################################################ 30 | ## get and set options 31 | ############################################################ 32 | df <- set_options(df, a = 1, b = "B", class = "test") 33 | 34 | test_that("options and class are set correctly", { 35 | expect_equal(attr(df, "table.options"), 36 | list(a = 1, b = "B")) 37 | expect_equal(class(df), 38 | c("test", "data.frame")) 39 | }) 40 | 41 | test_that("class needs to be set", { 42 | expect_error(set_options(df, a = 1, b = list(x = 0, y = "y"))) 43 | }) 44 | 45 | test_that("options are correctly obtained", { 46 | expect_equal(get_option(df, "a"), 1) 47 | expect_equal(get_option(df, "b"), "B") 48 | expect_equal(get_option(df, 1), 1) 49 | expect_equal(get_option(df, 2), "B") 50 | ## only one option can be obtained at once 51 | expect_error(get_option(df, 1:2)) 52 | }) 53 | 54 | 55 | 56 | ############################################################ 57 | ## ADD TESTS FOR confint.lme 58 | ############################################################ 59 | 60 | 61 | 62 | ############################################################ 63 | ## ADD TESTS FOR confint.mer 64 | ############################################################ 65 | 66 | 67 | ############################################################ 68 | ## ADD TESTS FOR refit_model 69 | ############################################################ 70 | 71 | 72 | ############################################################ 73 | ## format.perc 74 | ############################################################ 75 | 76 | test_that("format.perc works", { 77 | expect_equal(format.perc(c(0, 0.123456, 0.1, 1), digits = 2), 78 | paste0(c(0, 12, 10, 100), " %")) 79 | expect_equal(format.perc(c(0, 0.123456, 0.1, 1), digits = 3), 80 | paste0(c("0.0", "12.3", "10.0", "100.0"), " %")) 81 | expect_equal(format.perc(c(0, 0.0001234, 0.1, 1), digits = 1), 82 | paste0(c("0.00", "0.01", "10.00", "100.00"), " %")) 83 | 84 | expect_error(format.perc(c(0, 0.13456, 0.1, 1), digits = -1)) 85 | expect_error(format.perc("A", 3)) 86 | }) 87 | 88 | 89 | ############################################################ 90 | ## NAtoLvl 91 | ############################################################ 92 | 93 | test_that("NAs are correctly replaced for factors",{ 94 | x <- xNA <- factor(rep(1:3, each = 2)) 95 | xNA[2] <- NA 96 | 97 | expect_equal(NAtoLvl(x, na.lab = "missing"), x) 98 | expect_equal(levels(NAtoLvl(xNA, na.lab = "missing")), 99 | c(1, 2, 3, "missing")) 100 | expect_equal(as.vector(table((NAtoLvl(xNA, na.lab = "missing")))), 101 | c(1, 2, 2, 1)) 102 | }) 103 | 104 | ############################################################ 105 | ## keep_levels 106 | ############################################################ 107 | 108 | 109 | 110 | ############################################################ 111 | ## check_which 112 | ############################################################ 113 | 114 | test_that("NAs are correctly replaced for factors",{ 115 | expect_equal(check_which(NULL, df, "extract"), 1:2) 116 | expect_equal(check_which(1, df, "extract"), 1) 117 | expect_equal(check_which(1:2, df, "extract"), 1:2) 118 | 119 | expect_equal(check_which("x", df, "extract"), "x") 120 | expect_equal(check_which(c("x", "y"), df, "extract"), c("x", "y")) 121 | 122 | expect_error(check_which(-1, df, "extract"), 123 | paste("One cannot extract labels for", 124 | "none-existing variables")) 125 | expect_error(check_which(3, df, "extract"), 126 | paste("One cannot extract labels for", 127 | "none-existing variables")) 128 | expect_error(check_which(1.2, df, "extract"), 129 | paste("One cannot extract labels for", 130 | "none-existing variables")) 131 | 132 | expect_error(check_which("z", df, "extract"), 133 | paste("One cannot extract labels for", 134 | "none-existing variables\n Variables", 135 | "not found in data set:\n\tz")) 136 | expect_error(check_which(c("a", "z"), df, "extract"), 137 | paste("One cannot extract labels for", 138 | "none-existing variables\n Variables", 139 | "not found in data set:\n\ta\n\tz")) 140 | }) 141 | 142 | ############################################################ 143 | ## get_labels 144 | ############################################################ 145 | 146 | test_that("labels are correctly extracted", { 147 | labels(df) <- labels(df) 148 | 149 | expect_equal(get_labels(df), NULL) 150 | expect_equal(get_labels(df$x), "x") 151 | expect_equal(get_labels(df$y), "y") 152 | }) 153 | -------------------------------------------------------------------------------- /tests/testthat/test-labels.R: -------------------------------------------------------------------------------- 1 | library("papeR") 2 | context("label functions") 3 | 4 | data <- data.frame(a = 1:10, b = 10:1, c = rep(1:2, 5)) 5 | 6 | ############################################################ 7 | ## labels.default 8 | ############################################################ 9 | 10 | test_that("labels.default is dispatched correctly", { 11 | expect_equal(labels(matrix(1:10)), 12 | list(as.character(1:10), as.character(1))) 13 | }) 14 | 15 | ############################################################ 16 | ## labels / labels.data.frame 17 | ############################################################ 18 | 19 | library("foreign") 20 | spss.data <- suppressWarnings( 21 | read.spss(system.file("SPSS/data.sav", package = "papeR"), 22 | to.data.frame = TRUE)) 23 | lbls <- c(x = "Predictor", y = "Outcome", Notes = "Additional Notes") 24 | 25 | test_that("SPSS labels are correctly imported", { 26 | expect_equal(labels(spss.data), lbls) 27 | expect_equal(labels(spss.data, "x"), lbls[1]) 28 | expect_false(is.ldf(spss.data)) 29 | }) 30 | 31 | test_that("abbreviate works as expected", { 32 | lbls <- c("This is a long label", "This is another long label", 33 | "This also") 34 | lbls_short <- c(a = "Thsisalngl", b = "Thsisantll", c = "This also") 35 | lbls_shorter <- c(a = "Thsisalnl", b = "Thsisanll", c = "Ta") 36 | labels(data) <- lbls 37 | names(lbls) <- c("a", "b", "c") 38 | expect_equal(labels(data), lbls) 39 | expect_equal(labels(data, abbreviate = TRUE, minlength = 10), 40 | lbls_short) 41 | expect_equal(labels(data, abbreviate = TRUE, minlength = 2), 42 | lbls_shorter) 43 | }) 44 | 45 | ############################################################ 46 | ## setting labels 47 | ############################################################ 48 | 49 | test_that("labels can be set and reset", { 50 | labels(data) <- c("my_a", "my_b", "my_c") 51 | expect_equal(labels(data), c(a = "my_a", b = "my_b", c = "my_c")) 52 | expect_true(is.ldf(data)) 53 | labels(data) <- NULL 54 | expect_equal(labels(data), c(a = "a", b = "b", c = "c")) 55 | }) 56 | 57 | 58 | test_that("labels for subsets of the data can be set", { 59 | labels(data, which = c("a", "b")) <- c("x", "y") 60 | expect_equal(labels(data), c(a = "x", b = "y", c = "c")) 61 | expect_true(is.ldf(data)) 62 | ## new variable 63 | data$z <- as.factor(rep(2:3, each = 5)) 64 | expect_equal(labels(data), c(a = "x", b = "y", c = "c", z = "z")) 65 | labels(data, which = "z") <- "new_label" 66 | expect_equal(labels(data, "z"), c(z = "new_label")) 67 | ## subsets with [] operator 68 | labels(data)[1] <- "A" 69 | expect_equal(labels(data, "a"), c(a = "A")) 70 | }) 71 | 72 | test_that("labels for subsets of a labeled data frame can be set", { 73 | data <- as.ldf(data) 74 | labels(data, which = c("a", "b")) <- c("x", "y") 75 | expect_equal(labels(data), c(a = "x", b = "y", c = "c")) 76 | }) 77 | 78 | ############################################################ 79 | ## CLEAN_LABELS 80 | ############################################################ 81 | 82 | test_that("label cleaning works", { 83 | ## drop variable [note that this also drops all non-data.frame attributes] 84 | expect_equal(labels(spss.data[-1]), c(y = "y", Notes = "Notes")) 85 | ## add variable 86 | spss.data$z <- 4:1 87 | expect_equal(labels(spss.data), c(lbls, z = "z")) 88 | ## reorder data [note that this also drops all non-data.frame attributes] 89 | expect_equal(labels(spss.data[, c(4, 2, 1, 3)]), 90 | c(z = "z", y = "y", x = "x", Notes = "Notes")) 91 | ## rename variable 92 | names(spss.data)[3] <- "comments" 93 | expect_equal(labels(spss.data), 94 | c(x = "Predictor", y = "Outcome", comments = "comments", z = "z")) 95 | }) 96 | 97 | ############################################################ 98 | ## as.ldf / convert.labels / is.ldf 99 | ############################################################ 100 | 101 | test_that("conversion of labels works (1)", { 102 | spss.data <- convert.labels(spss.data) 103 | expect_true(is.ldf(spss.data)) 104 | expect_equivalent(labels(spss.data$x), labels(spss.data, "x")) 105 | expect_equivalent(labels(spss.data$x, abbreviate = TRUE, minlength = 5), 106 | labels(spss.data, "x", abbreviate = TRUE, minlength = 5)) 107 | expect_equal(labels(spss.data, "x"), lbls[1]) 108 | }) 109 | 110 | test_that("conversion of labels works (2)", { 111 | spss.data <- as.ldf(spss.data) 112 | expect_true(is.ldf(spss.data)) 113 | expect_equivalent(labels(spss.data$x), labels(spss.data, "x")) 114 | expect_equivalent(labels(spss.data$x, abbreviate = TRUE, minlength = 5), 115 | labels(spss.data, "x", abbreviate = TRUE, minlength = 5)) 116 | expect_equal(labels(spss.data, "x"), lbls[1]) 117 | }) 118 | -------------------------------------------------------------------------------- /tests/testthat/test-prettify.R: -------------------------------------------------------------------------------- 1 | library("papeR") 2 | context("prettify functions") 3 | 4 | set.seed(1234) 5 | 6 | ################################################################################ 7 | ## Test computation of CIs when data is part of the call 8 | ## (i.e. not only a link is passed but really the data) 9 | ################################################################################ 10 | 11 | test_that("computation of CIs when data is part of the call", { 12 | model_fit <- function(my_data, model_class) { 13 | do.call(model_class, list(y ~ x, data = my_data)) 14 | } 15 | 16 | for (model_class in c("lm", "glm")) { 17 | x <- rnorm(100) 18 | y <- rnorm(100, mean = 2 * x) 19 | data <- data.frame(y = y, x = x) 20 | 21 | ## fit model with data argument 22 | mod <- do.call(model_class, list(y ~ x, data = data)) 23 | psm1 <- prettify(summary(mod)) 24 | rm(data) 25 | psm1a <- prettify(summary(mod)) 26 | 27 | ## fit model without data argument 28 | mod2 <- do.call(model_class, list(y ~ x)) 29 | psm2 <- prettify(summary(mod2)) 30 | 31 | ## fit model in different environment 32 | mod3 <- model_fit(data.frame(y = y, x = x), model_class) 33 | psm3 <- prettify(summary(mod3)) 34 | 35 | ## change data and compute summary 36 | x <- rnorm(100) 37 | y <- rnorm(100, mean = 2 * x) 38 | data <- data.frame(y = y, x = x) 39 | 40 | psm4 <- prettify(summary(mod)) 41 | 42 | expect_equal(psm1, psm1a) 43 | expect_equal(psm1, psm2) 44 | expect_equal(psm1, psm3) 45 | expect_equal(psm1, psm4) 46 | } 47 | }) 48 | 49 | ################################################################################ 50 | ## Test computation of CIs when data is *not* part of the call 51 | ################################################################################ 52 | 53 | rm(list = ls()) 54 | model_fit2 <- function(my_data, model_class) { 55 | switch(model_class, 56 | lm = lm(y ~ x, data = my_data), 57 | glm = glm(y ~ x, data = my_data), 58 | coxph = coxph(Surv(y, event) ~ x, data = my_data), 59 | lme = lme(y ~ x, random = ~ 1 | group, data = my_data), 60 | lmer = lmer(y ~ x + (1 | group), data = my_data)) 61 | } 62 | 63 | fit_model <- function(model_class = c("lm", "glm", "coxph", "lme", "lmer")) { 64 | x <- rnorm(100) 65 | y <- rnorm(100, mean = 2 * x) 66 | data <- data.frame(y = y, x = x) 67 | 68 | if (model_class %in% c("lme", "lmer")) { 69 | group <- sample(1:2, 100, replace = TRUE) 70 | data$group <- group 71 | } 72 | 73 | if (model_class %in% "coxph") { 74 | event <- as.logical(sample(0:1, 100, replace = TRUE)) 75 | data$event <- event 76 | data$y <- exp(y) 77 | } 78 | 79 | ## fit model with data argument 80 | mod <- switch(model_class, 81 | lm = lm(y ~ x, data = data), 82 | glm = glm(y ~ x, data = data), 83 | coxph = coxph(Surv(y, event) ~ x, data = data), 84 | lme = lme(y ~ x, random = ~ 1 | group, data = data), 85 | lmer = lmer(y ~ x + (1 | group), data = data)) 86 | psm1 <- prettify(summary(mod)) 87 | data_tmp <- data 88 | rm(data) 89 | psm1a <- try(prettify(summary(mod)), silent = TRUE) 90 | 91 | ## fit model without data argument 92 | mod2 <- switch(model_class, 93 | lm = lm(y ~ x), 94 | glm = glm(y ~ x), 95 | coxph = coxph(Surv(y, event) ~ x), 96 | lme = lme(y ~ x, random = ~ 1 | group), 97 | lmer = lmer(y ~ x + (1 | group))) 98 | psm2 <- prettify(summary(mod2)) 99 | 100 | ## fit model in different environment 101 | mod3 <- model_fit2(data_tmp, model_class) 102 | psm3 <- try(prettify(summary(mod3)), silent = TRUE) 103 | 104 | ## change data and compute summary 105 | x <- rnorm(100) 106 | y <- rnorm(100, mean = 2 * x) 107 | data <- data.frame(y = y, x = x) 108 | 109 | if (model_class %in% c("lme", "lmer")) { 110 | group <- sample(1:2, 100, replace = TRUE) 111 | data$group <- group 112 | } 113 | 114 | if (model_class %in% "coxph") { 115 | event <- as.logical(sample(0:1, 100, replace = TRUE)) 116 | data$event <- event 117 | data$y <- exp(y) 118 | } 119 | 120 | psm4 <- prettify(summary(mod)) 121 | 122 | ret <- list(psm1, psm1a, psm2, psm3, psm4) 123 | names(ret) <- c("standard", "data removed from global environment", 124 | "no data argument in call", "local environment", 125 | "data in global environment changed") 126 | return(ret) 127 | } 128 | 129 | 130 | ## check lm interface 131 | test_that("lm interface works", { 132 | expect_warning(res <- fit_model("lm")) 133 | expect_equivalent(res[[1]], res[[3]]) 134 | expect_equivalent(res[[1]], res[[4]]) 135 | ## differences in CIs as different data is used 136 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[1], "lower") 137 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[2], "upper") 138 | ## CI dropped. Other values equal 139 | expect_equivalent(res[[1]][, -(3:4)], res[[2]]) 140 | }) 141 | 142 | ## check glm interface 143 | test_that("glm interface works", { 144 | expect_warning(res <- fit_model("glm")) 145 | expect_equivalent(res[[1]], res[[3]]) 146 | expect_equivalent(res[[1]], res[[4]]) 147 | ## differences in CIs as different data is used 148 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[1], "lower") 149 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[2], "upper") 150 | ## CI dropped. Other values equal 151 | expect_equivalent(res[[1]][, -(3:4)], res[[2]]) 152 | }) 153 | 154 | ### check lme interface 155 | if (require("nlme", quietly = TRUE)) { 156 | test_that("nlme interface works", { 157 | expect_warning(res <- fit_model("lme")) 158 | expect_equivalent(res[[1]], res[[3]]) 159 | expect_equivalent(res[[1]], res[[4]]) 160 | ## differences in CIs as different data is used 161 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[1], "lower") 162 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[2], "upper") 163 | ## CI dropped. Other values equal 164 | stopifnot(all.equal(res[[1]][, -(3:4)], res[[2]], check.attributes = FALSE)) 165 | }) 166 | } 167 | 168 | ## check coxph interfaces 169 | if (require("survival", quietly = TRUE)) { 170 | test_that("survival interface works", { 171 | expect_warning(res <- fit_model("coxph")) 172 | expect_equivalent(res[[1]], res[[3]]) 173 | expect_is(res[[2]], "try-error") 174 | expect_is(res[[4]], "try-error") 175 | ## differences in CIs as different data is used 176 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[1], "lower") 177 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[2], "upper") 178 | }) 179 | } 180 | 181 | ## check lmer interface 182 | if (require("lme4", quietly = TRUE, warn.conflicts = FALSE)) { 183 | test_that("lme4 interface works", { 184 | expect_warning(res <- fit_model("lmer")) 185 | if (packageDescription("lme4")$Version >= 1) { 186 | expect_equivalent(res[[1]], res[[3]]) 187 | expect_is(res[[2]], "try-error") 188 | expect_is(res[[4]], "try-error") 189 | ## differences in CIs as different data is used 190 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[1], "lower") 191 | expect_match(all.equal(res[[1]], res[[5]], check.attributes = FALSE)[2], "upper") 192 | } 193 | }) 194 | } 195 | 196 | ################################################################################ 197 | ## Test OR 198 | ################################################################################ 199 | 200 | test_that("OR are included", { 201 | x <- rnorm(100) 202 | y <- rbinom(100, 1, make.link("logit")$linkinv(x * 2)) 203 | data <- data.frame(x, y) 204 | mod <- glm(y ~ x, data = data, family = binomial) 205 | ps <- prettify(summary(mod)) 206 | expect_true("Odds Ratio" %in% names(ps)) 207 | }) 208 | 209 | ################################################################################ 210 | ## Test specification of CIs 211 | ################################################################################ 212 | 213 | fit_model <- function(model_class = c("lm", "glm", "coxph", "lme", "lmer")) { 214 | x <- rnorm(100) 215 | y <- rnorm(100, mean = 2 * x) 216 | data <- data.frame(y = y, x = x) 217 | 218 | if (model_class %in% c("lme", "lmer")) { 219 | group <- sample(1:2, 100, replace = TRUE) 220 | data$group <- group 221 | } 222 | 223 | if (model_class %in% "coxph") { 224 | event <- as.logical(sample(0:1, 100, replace = TRUE)) 225 | data$event <- event 226 | data$y <- exp(y) 227 | } 228 | 229 | ## fit model with data argument 230 | mod <- switch(model_class, 231 | lm = lm(y ~ x, data = data), 232 | glm = glm(y ~ x, data = data), 233 | coxph = coxph(Surv(y, event) ~ x, data = data), 234 | lme = lme(y ~ x, random = ~ 1 | group, data = data), 235 | lmer = lmer(y ~ x + (1 | group), data = data)) 236 | return(list(data = data, model = mod)) 237 | } 238 | 239 | if (require("nlme", quietly = TRUE) && require("lme4", quietly = TRUE) && packageDescription("lme4")$Version >= 1) { 240 | test_that("CIs can be hand specified", { 241 | for (model_class in c("lm", "glm", "lme", "lmer")) { 242 | ## fit model 243 | RES <- fit_model(model_class) 244 | mod <- RES$mod 245 | data <- RES$data 246 | CI <- matrix(c(1, 2, 3, 4), ncol = 2) 247 | ps <- prettify(summary(mod), confint = CI) 248 | expect_equivalent(as.matrix(ps[,3:4]), CI, info = model_class) 249 | } 250 | }) 251 | } 252 | 253 | ################################################################################ 254 | ## Test anova 255 | ################################################################################ 256 | 257 | if (require("nlme", quietly = TRUE) && require("survival", quietly = TRUE) && require("lme4", quietly = TRUE) && packageDescription("lme4")$Version >= 1) { 258 | test_that("prettify.anova works", { 259 | for (model_class in c("lm", "glm", "lme", "lmer", "coxph")) { 260 | ## fit model 261 | RES <- fit_model(model_class) 262 | mod <- RES$mod 263 | data <- RES$data 264 | if (model_class == "lm") { 265 | ps_anova <- prettify(anova(mod)) 266 | nc <- ncol(ps_anova) 267 | expect_match(ps_anova[, nc - 1], "<0.001") 268 | expect_match(as.character(ps_anova[, nc]), 269 | "\\*\\*\\*") 270 | } 271 | if (require("car", quietly = TRUE)) { 272 | ps_anova <- prettify(Anova(mod)) 273 | ps_anova_lbl <- prettify(Anova(mod), 274 | labels = c(x = "Predictor x", 275 | z = "nonsense")) 276 | nc <- ncol(ps_anova) 277 | if (model_class %in% c("lm", "glm", "lmer", "coxph")) { 278 | expect_match(ps_anova[, nc - 1], 279 | "<0.001", info = model_class) 280 | expect_match(as.character(ps_anova[, nc]), 281 | "\\*\\*\\*", info = model_class) 282 | expect_match(ps_anova_lbl[, 1], 283 | "Predictor x", info = model_class) 284 | } 285 | if (model_class == "lme") { 286 | expect_match(ps_anova[2, nc - 1], 287 | "<0.001", info = model_class) 288 | expect_match(as.character(ps_anova[2, nc]), 289 | "\\*\\*\\*", info = model_class) 290 | expect_match(ps_anova_lbl[2, 1], 291 | "Predictor x", info = model_class) 292 | } 293 | } 294 | } 295 | }) 296 | } 297 | 298 | ################################################################################ 299 | ## Test HR 300 | ################################################################################ 301 | 302 | if (require("survival", quietly = TRUE)) { 303 | test_that("survival works", { 304 | RES <- fit_model("coxph") 305 | mod <- RES$mod 306 | data <- RES$data 307 | CI <- matrix(c(1, 2), ncol = 2) 308 | 309 | ps1 <- prettify(summary(mod), HR = TRUE) 310 | ps2 <- prettify(summary(mod), HR = FALSE) 311 | ps3 <- prettify(summary(mod), confint = CI, HR = TRUE) 312 | ps4 <- prettify(summary(mod), confint = CI, HR = FALSE) 313 | 314 | expect_equivalent(ps1[,2], coef(mod)) 315 | expect_equivalent(ps1[,3], exp(coef(mod))) 316 | expect_equivalent(ps2[,2], coef(mod)) 317 | expect_equivalent(ps1[,4:5], exp(ps2[, 3:4])) 318 | expect_equivalent(as.matrix(ps3[,4:5]), exp(CI)) 319 | expect_equivalent(as.matrix(ps4[,3:4]), CI) 320 | }) 321 | } 322 | 323 | 324 | ################################################################################ 325 | ## Extra column for value labels 326 | ################################################################################ 327 | 328 | fit_anova <- function(model_class = c("lm", "glm", "coxph", "lme", "lmer")) { 329 | x <- as.factor(sample(c("Gr. A", "Gr. B", "Gr. C"), 100, replace = TRUE)) 330 | y <- rnorm(100, mean = 2 * (x == "Gr. B") - 1 * (x == "Gr. C")) 331 | data <- data.frame(y = y, x = x) 332 | 333 | if (model_class %in% c("lme", "lmer")) { 334 | group <- sample(1:2, 100, replace = TRUE) 335 | data$group <- group 336 | } 337 | 338 | if (model_class %in% "coxph") { 339 | event <- as.logical(sample(0:1, 100, replace = TRUE)) 340 | data$event <- event 341 | data$y <- exp(y) 342 | } 343 | 344 | ## fit model with data argument 345 | mod <- switch(model_class, 346 | lm = lm(y ~ x, data = data), 347 | glm = glm(y ~ x, data = data), 348 | coxph = coxph(Surv(y, event) ~ x, data = data), 349 | lme = lme(y ~ x, random = ~ 1 | group, data = data), 350 | lmer = lmer(y ~ x + (1 | group), data = data)) 351 | return(list(data = data, model = mod)) 352 | } 353 | 354 | 355 | if (require("nlme", quietly = TRUE) && require("survival", quietly = TRUE) && require("lme4", quietly = TRUE) && packageDescription("lme4")$Version >= 1) { 356 | test_that("prettify.anova works", { 357 | for (model_class in c("lm", "glm", "lme", "lmer", "coxph")) { 358 | ## fit model 359 | RES <- fit_anova(model_class) 360 | mod <<- RES$mod 361 | data <- RES$data 362 | 363 | sum1 <- prettify(summary(mod), confint = FALSE) 364 | sum2 <- prettify(summary(mod), confint = FALSE, extra.column = TRUE) 365 | expect_equal(colnames(sum2)[2], "Factor Level", info = model_class) 366 | if (model_class == "coxph") { 367 | expect_equal(sum1[1, 1], "x: Gr. B", info = model_class) 368 | expect_equal(sum2[1, 2], "Gr. B", info = model_class) 369 | expect_true(all(sum2[,1] == c("x", ""))) 370 | } else { 371 | expect_equal(sum1[2, 1], "x: Gr. B", info = model_class) 372 | expect_equal(sum2[2, 2], "Gr. B", info = model_class) 373 | expect_true(all(sum2[2:3,1] == c("x", ""))) 374 | } 375 | } 376 | }) 377 | } 378 | 379 | ################################################################################ 380 | ## Test that trailing zeros are not dropped 381 | ################################################################################ 382 | 383 | if (require("survival", quietly = TRUE)) { 384 | test_that("trailing zeros are not dropped", { 385 | data(cancer, package = "survival") 386 | mod <- coxph(Surv(futime, fustat) ~ age, data = ovarian) 387 | x <- prettify(summary(mod), digit = 3, env = .GlobalEnv) 388 | expect_match(x[1,5], "1.30") 389 | }) 390 | } -------------------------------------------------------------------------------- /tests/testthat/test-summarize.R: -------------------------------------------------------------------------------- 1 | library("papeR") 2 | context("summarize functions") 3 | 4 | if (require("nlme", quietly = TRUE)) { 5 | ## Use dataset Orthodont 6 | data(Orthodont, package = "nlme") 7 | Ortho_small <<- Orthodont[Orthodont$Subject %in% c("M01", "M02", "F01", "F02"), ] 8 | 9 | ############################################################ 10 | ## test old functions latex.table.fac / latex.table.cont 11 | ############################################################ 12 | 13 | test_that("latex.table.cont works", { 14 | expect_output(latex.table.cont(Orthodont), 15 | paste0("tabular.*", 16 | "& N & & Mean & SD & & Min & Q1 & Median & Q3 & Max", 17 | ".*", 18 | "distance & 108 & & 24.02 & 2.93 & & 16.50 & 22.00 & 23.75 & 26.00 & 31.50", 19 | ".*", 20 | "age & 108 & & 11.00 & 2.25 & & 8.00 & 9.00 & 11.00 & 13.00 & 14.00")) 21 | ## check that longtable isn't printed here 22 | expect_output(latex.table.cont(Orthodont), "(longtable){0}") 23 | ## but here 24 | expect_output(latex.table.cont(Orthodont, table = "longtable"), "longtable") 25 | }) 26 | 27 | test_that("latex.table.fac works", { 28 | expect_output(latex.table.fac(Orthodont), 29 | paste0("tabular.*", 30 | "& Level & & N & \\\\%", 31 | ".*", 32 | "Subject & M16 & & 4 & 3.7", 33 | ".*", 34 | "Sex & Male & & 64 & 59.3", 35 | ".*", 36 | "& Female & & 44 & 40.7")) 37 | ## check that longtable isn't printed here 38 | expect_output(latex.table.fac(Orthodont), "(longtable){0}") 39 | ## but here 40 | expect_output(latex.table.fac(Orthodont, table = "longtable"), "longtable") 41 | }) 42 | 43 | ############################################################ 44 | ## test variable labels in summaries 45 | ############################################################ 46 | 47 | test_that("variable labels work", { 48 | factor <- sapply(Orthodont, is.factor) 49 | for (type in c("numeric", "factor")) { 50 | data <- Ortho_small 51 | labels(data) <- c("Distance (mm)", "Age (yr)", "ID", "Sex") 52 | which <- if (type == "numeric") { !factor } else { factor } 53 | 54 | ## summary with data set labels 55 | summary <- summarize(data, type = type, variable.labels = TRUE) 56 | expect_equivalent(summary[summary[, 1] != "", 1], 57 | labels(data)[which], 58 | info = type) 59 | 60 | ## summary with user specified labels 61 | usr_labels <- summarize(data, type = type, 62 | variable.labels = c("a", "b", "c", "d")) 63 | expect_equivalent(usr_labels[usr_labels[, 1] != "", 1], 64 | c("a", "b", "c", "d")[which], 65 | info = type) 66 | 67 | ## grouped summary with data set labels 68 | which[4] <- FALSE 69 | grouped <- summarize(data, type = type, group = "Sex", 70 | variable.labels = TRUE) 71 | expect_equivalent(grouped[grouped[, 1] != "", 1], 72 | labels(data)[which], 73 | info = type) 74 | } 75 | }) 76 | 77 | test_that("grouped summaries work", { 78 | ## grouped summaries for numerics 79 | numeric <- summarize(Orthodont, type = "numeric", group = "Sex") 80 | expect_equivalent(numeric[, 2], rep(levels(Orthodont$Sex), 2)) 81 | expect_equivalent(numeric$p.value[c(1,3)], c("<0.001", "1.000")) 82 | ## grouped summaries for factors 83 | factor <- summarize(Ortho_small, type = "factor", group = "Sex") 84 | expect_equivalent(factor[, 2], levels(Ortho_small$Subject)) 85 | expect_equivalent(ncol(factor), 10) 86 | expect_equivalent(factor$p.value[1], "< 0.001") 87 | }) 88 | 89 | test_that("print.summary works", { 90 | expect_output(print(summarize(Orthodont, type = "numeric")), 91 | paste0(" N Mean SD Min Q1 Median Q3 Max\n", 92 | "1 distance 108 24.02 2.93 16.5 22 23.75 26 31.5\n", 93 | "2 age 108 11.00 2.25 8.0 9 11.00 13 14.0")) 94 | expect_output(print(summarize(Orthodont, group = "Sex", type = "numeric")), 95 | paste0(" Sex N Mean SD Min Q1 Median Q3 Max p.value\n", 96 | "1 distance Male 64 24.97 2.90 17.0 23 24.75 26.50 31.5 <0.001\n", 97 | "2 Female 44 22.65 2.40 16.5 21 22.75 24.25 28.0 \n", 98 | "3 age Male 64 11.00 2.25 8.0 9 11.00 13.00 14.0 1.000\n", 99 | "4 Female 44 11.00 2.26 8.0 9 11.00 13.00 14.0 ")) 100 | expect_output(print(summarize(Orthodont, type = "factor")), 101 | paste0(" Level N %\n", 102 | "1 Subject M16 4 3.7\n", 103 | "2 M05 4 3.7\n", 104 | "3 M02 4 3.7\n", 105 | ".*", 106 | "28 Sex Male 64 59.3\n", 107 | "29 Female 44 40.7")) 108 | expect_output(print(summarize(Ortho_small, group = "Sex", type = "factor")), 109 | paste0(" Sex: Male Sex: Female \n", 110 | " Level N % N % p.value\n", 111 | "1 Subject M02 4 50.0 0 0.0 < 0.001\n", 112 | "2 M01 4 50.0 0 0.0 \n", 113 | "3 F01 0 0.0 4 50.0 \n", 114 | "4 F02 0 0.0 4 50.0 ")) 115 | 116 | }) 117 | 118 | test_that("caption works", { 119 | ## via call arguments 120 | expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test"), 121 | floating = TRUE), 122 | ".*\\caption\\{Test\\}.*") 123 | expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test", 124 | label= "tab:Test"), 125 | floating = TRUE), 126 | ".*\\caption\\{Test\\}.*\\label\\{tab:Test\\}") 127 | 128 | expect_output(expect_warning(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test"), 129 | tabular.environment = "longtable", floating = TRUE)), 130 | ".*\\caption\\{Test\\}.*") 131 | expect_output(expect_warning(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test", 132 | label= "tab:Test"), 133 | tabular.environment = "longtable", floating = TRUE)), 134 | ".*\\caption\\{Test\\}.*\\label\\{tab:Test\\}") 135 | 136 | expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test"), 137 | tabular.environment = "longtable"), 138 | ".*\\caption\\{Test\\}.*") 139 | expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test", 140 | label= "tab:Test"), 141 | tabular.environment = "longtable"), 142 | ".*\\caption\\{Test\\}.*\\label\\{tab:Test\\}") 143 | 144 | ## requires capt-of 145 | expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test")), 146 | paste0(".*begin\\{minipage\\}\\{.*linewidth\\}\n", 147 | ".*captionof\\{table\\}\\{Test\\}\n", 148 | ".*", 149 | "end\\{minipage\\}")) 150 | expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test", 151 | label= "tab:Test")), 152 | paste0(".*begin\\{minipage\\}\\{.*linewidth\\}\n", 153 | ".*captionof\\{table\\}\\{Test\\}\n", 154 | ".*label\\{tab:Test\\}\n", 155 | ".*", 156 | "end\\{minipage\\}")) 157 | ## additionally test if this also works via options 158 | }) 159 | 160 | test_that("endhead is included if necessary", { 161 | ## via call arguments 162 | expect_output(print(xtable(summarize(Orthodont, type = "numeric")), 163 | tabular.environment = "longtable"), 164 | ".*cmidrule\\{7-11\\}\n.*endhead\ndistance.*") 165 | ## via options 166 | options(xtable.tabular.environment = "longtable") 167 | expect_output(print(xtable(summarize(Orthodont, type = "numeric"))), 168 | ".*cmidrule\\{7-11\\}\n.*endhead\ndistance.*") 169 | options(xtable.tabular.environment = NULL) 170 | }) 171 | 172 | test_that("xtable works for summarize_factor with groups", { 173 | grouped <- summarize(Ortho_small, type = "factor", group = "Sex") 174 | expect_output(print(xtable(grouped)), 175 | paste(".* & & &\\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Male\\} &", 176 | "& \\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Female\\} & &.*")) 177 | grouped <- summarize(Ortho_small, type = "factor", group = "Sex", test = FALSE) 178 | expect_output(print(xtable(grouped)), 179 | paste(".* & & &\\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Male\\} &", 180 | "& \\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Female\\}.*")) 181 | }) 182 | 183 | test_that("include.rownames is ignored", { 184 | tab <- summarize(Orthodont, type = "numeric") 185 | expect_output(print(xtable(tab), include.rownames = FALSE), 186 | ".*\n distance .*\n age .*") 187 | ## expect output AND warning 188 | expect_output(expect_warning(print(xtable(tab), include.rownames = TRUE)), 189 | ".*\n distance .*\n age .*") 190 | expect_output(print(xtable(tab)), 191 | ".*\n distance .*\n age .*") 192 | }) 193 | 194 | test_that("scoping works correctly", { 195 | test <- function(type) { 196 | a1 <- Orthodont 197 | ## get summary for continuous variables 198 | (tab1 <- summarize(a1, type = type)) 199 | } 200 | expect_output(print(test("factor")), 201 | ".*\n1 Subject .*") 202 | expect_output(print(test("numeric")), 203 | ".*\n1 distance .*\n2 age .*") 204 | }) 205 | 206 | } -------------------------------------------------------------------------------- /tests/testthat/test-toLatex.R: -------------------------------------------------------------------------------- 1 | library("papeR") 2 | context("toLatex") 3 | 4 | ############################################################ 5 | ## toLatex.character 6 | ############################################################ 7 | 8 | test_that("toLatex.character works", { 9 | expect_equal(toLatex("a"), "a") 10 | expect_equal(toLatex("$\\sum$"), "$\\sum$") 11 | expect_equal(toLatex("\\"), "$\\backslash$") 12 | expect_equal(toLatex("$"), "\\$") 13 | expect_equal(toLatex(">="), "$\\geq$") 14 | expect_equal(toLatex("<="), "$\\leq$") 15 | expect_equal(toLatex("<"), "$<$") 16 | expect_equal(toLatex(">"), "$>$") 17 | expect_equal(toLatex("|"), "$|$") 18 | expect_equal(toLatex("{"), "\\{") 19 | expect_equal(toLatex("}"), "\\}") 20 | expect_equal(toLatex("%"), "\\%") 21 | expect_equal(toLatex("&"), "\\&") 22 | expect_equal(toLatex("_"), "\\_") 23 | expect_equal(toLatex("#"), "\\#") 24 | expect_equal(toLatex("a^1"), "a$^{1}$") 25 | expect_equal(toLatex("a^(1)"), "a\\verb|^|(1)") 26 | expect_equal(toLatex("~"), "\\~{}") 27 | expect_equal(toLatex("\u00B2"), "$^2$") 28 | expect_equal(toLatex("\u00B3"), "$^3$") 29 | }) 30 | 31 | ############################################################ 32 | ## toLatex.sessionInfo 33 | ############################################################ 34 | 35 | test_that("toLatex.sessionInfo is correctly used", { 36 | expect_message(a <- toLatex(sessionInfo(), file = "bib.bib"), 37 | "Written .* BibTeX entries to file 'bib.bib' ...\n.*") 38 | expect_equal(class(a), "Latex") 39 | expect_true(any(grepl("\\citep", a))) 40 | 41 | ## expect NO message when file is NULL 42 | expect_message(b <- toLatex(sessionInfo()), NA) 43 | expect_equal(class(b), c("LatexBibtex", "Latex")) 44 | expect_false(is.null(attr(b, "BibTeX"))) 45 | expect_true(any(grepl("\\citep", b))) 46 | 47 | expect_message(c <- toLatex(sessionInfo(), citations = FALSE), NA) 48 | expect_equal(class(c), "Latex") 49 | expect_true(is.null(attr(c, "BibTeX"))) 50 | expect_false(any(grepl("\\citep", c))) 51 | 52 | expect_message(d <- toLatex(sessionInfo(), citations = FALSE, 53 | file = "bib.bib"), NA) 54 | expect_equal(class(d), "Latex") 55 | expect_false(any(grepl("\\citep", d))) 56 | 57 | e <- toLatex(sessionInfo(), pkgs = "xtable") 58 | expect_match(e[5], "xtable") 59 | expect_equal(length(e), 7) 60 | 61 | expect_warning(e <- toLatex(sessionInfo(), pkgs = "xtable", 62 | other.pkgs = FALSE), 63 | "should be TRUE") 64 | expect_equal(length(e), 3) 65 | 66 | expect_match(toLatex(sessionInfo(), locale = TRUE)[3], "Locale:") 67 | expect_match(toLatex(sessionInfo(), base.pkgs = TRUE)[3], "Base packages:") 68 | expect_true(any(grepl(".*namespace.*", toLatex(sessionInfo(), namespace.pkgs = TRUE)))) 69 | }) 70 | 71 | 72 | ############################################################ 73 | ## print.LatexBibtex 74 | ############################################################ 75 | 76 | test_that("print.latex.bibtex works as expected", { 77 | expect_output(print(toLatex(sessionInfo(), file = NULL)), 78 | paste0(".*begin\\{itemize\\}", 79 | ".*item papeR.*", 80 | ".*end\\{itemize\\}.*", 81 | "Hofner B.*papeR.*A Toolbox for Writing Pretty")) 82 | }) 83 | 84 | ############################################################ 85 | ## toLatex.LatexBibtex / toBibtex.LatexBibtex 86 | ############################################################ 87 | 88 | test_that("toLatex.LatexBibtex and toBibtex.LatexBibtex works", { 89 | latex <- toLatex(toLatex(sessionInfo())) 90 | bibtex <- toBibtex(toLatex(sessionInfo())) 91 | expect_match(latex[1], "\\\\begin\\{itemize\\}.*") 92 | expect_match(latex[length(latex)], "\\\\end\\{itemize\\}.*") 93 | expect_is(latex, "Latex") 94 | expect_match(bibtex[1], "@Manual.*") 95 | expect_is(bibtex, "Bibtex") 96 | }) 97 | 98 | ############################################################ 99 | ## write.bib 100 | ############################################################ 101 | 102 | test_that("write.bib", { 103 | expect_message(write.bib(c()), 104 | "Empty package list: nothing to be done.") 105 | expect_error(write.bib("nonexisting_pkg")) 106 | rref <- bibentry( 107 | bibtype = "Manual", 108 | title = "R: A Language and Environment for Statistical Computing", 109 | author = person("R Core Team"), 110 | organization = "R Foundation for Statistical Computing", 111 | address = "Vienna, Austria", 112 | year = 2014, 113 | url = "http://www.R-project.org/") 114 | expect_equal(write.bib(rref), rref) 115 | expect_error(write.bib(1), "Invalid argument") 116 | }) 117 | -------------------------------------------------------------------------------- /vignettes/graphics/papeR_example_tables.Rnw: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \usepackage{booktabs} 3 | 4 | %\VignetteEngine{knitr::knitr} 5 | %\VignetteIndexEntry{Using papeR - Example Tables} 6 | 7 | <>= 8 | library("papeR") 9 | opts_chunk$set(message = FALSE, warning = FALSE, echo = FALSE, results = 'asis') 10 | data(Orthodont, package = "nlme") 11 | @ 12 | 13 | 14 | \begin{document} 15 | <<>>= 16 | print(xtable(summarize(Orthodont, type = "numeric"))) 17 | @ 18 | 19 | <<>>= 20 | xtable(summarize(Orthodont, type = "factor", variables = "Sex")) 21 | @ 22 | 23 | <<>>= 24 | xtable(summarize(Orthodont, type = "numeric", group = "Sex")) 25 | @ 26 | \end{document} 27 | -------------------------------------------------------------------------------- /vignettes/papeR_introduction.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Using papeR with Markdown" 3 | author: "Benjamin Hofner" 4 | date: "" 5 | output: 6 | html_document: 7 | keep_md: yes 8 | --- 9 | 10 | 14 | 15 | 16 | ```{r initialization, include=FALSE} 17 | library("knitr") 18 | options(knitr.table.format = 'markdown') 19 | opts_chunk$set(message = FALSE, warning = FALSE, fig.path = "graphics/fig-", 20 | out.width = "480px") 21 | set.seed(1234) 22 | ``` 23 | 24 | 25 | # Using **papeR** -- A short tutorial 26 | 27 | This is a short tutorial that covers some of the main features of the R package **papeR**. 28 | 29 | The main goal of the package is to ease statistical reporting and thus to ease 30 | reproducible research. By relying on powerful tools such as the `Sweave`, or the 31 | packages **knitr** and **xtable**, the package can be easily integrated in 32 | existing workflows. 33 | 34 | - First of all, the package provides an infrastructure to handle variable labels which 35 | are used in all other functions (`labels()`). 36 | 37 | - The package allows to create (complex) summary tables of the data sets (`summarize()`) and 38 | to easily plot the data (`plot()` for labeled `data.frame`s). 39 | 40 | - Finally, the package allows to enhance summary tables of statistical models by 41 | (possibly) adding confidence intervals, significance stars, odds ratios, etc. and 42 | by separating variable names and factor levels (`prettify()`). 43 | 44 | ## Getting started 45 | 46 | Before we start, we need to install the package. The package can be easily obtained 47 | from [CRAN](https://CRAN.R-project.org/package=papeR), e.g. via the command 48 | ```{r install_CRAN, eval = FALSE} 49 | install.packages("papeR") 50 | ``` 51 | 52 | To install the latest development version, one can use **devtools** to install 53 | packages from [GitHub](https://github.com/hofnerb/papeR). Therefore we need to 54 | install and load **devtools** before we can install **papeR**: 55 | 56 | ```{r install_github, eval=FALSE} 57 | install.packages("devtools") 58 | library("devtools") 59 | install_github("hofnerb/papeR") 60 | ``` 61 | 62 | Now we can load the package 63 | 64 | ```{r load_pkg} 65 | library("papeR") 66 | ``` 67 | 68 | ## The package 69 | 70 | ### Labeled data frames 71 | 72 | To be able to use *all* features of the package, we first need to create a labeled 73 | data frame. We need labeled data frames to use the special `plot()` function (see below). 74 | All other functions do not strictly require labeled data frames but can exploit 75 | the labels. 76 | 77 | Labels in **papeR** are stored as attributes of the variables, i.e., each variable 78 | in a labeld data frame has an attribute `"variable.label"`, and the data set gets an 79 | additional class `'ldf'`. Other packages store variable labels differently. E.g. 80 | the function `read.spss()` from the package **foreign** stores variable labels as 81 | a single attribute of the data set. The package **papeR** is also capable of using 82 | these labels. For details see the section "Conversion to labeled data frames". 83 | 84 | #### Setting and extracting labels 85 | 86 | If we create a new `data.frame` we can extract and set variable labels using the 87 | function `labels()`. We use the `Orthodont` data package **nlme** throughout this 88 | tutorial. First load the data 89 | ```{r} 90 | data(Orthodont, package = "nlme") 91 | ## keep the original data set for later use 92 | Orthodont_orig <- Orthodont 93 | ``` 94 | To check if the data set is a labeled data set (i.e., of class `'ldf'`), we can use 95 | ```{r} 96 | is.ldf(Orthodont) 97 | ``` 98 | 99 | Despite the fact that we do not have a labeled data frame, we can query the labels. 100 | In this case, we simply get the variable names as no labels were set so far 101 | ```{r} 102 | labels(Orthodont) 103 | ``` 104 | This is a convenient feature, as we thus can relly on the fact that we will always 105 | have *some* variable labels. 106 | 107 | To explicitly set labels, which are usually more descriptive than the variable names, 108 | we can simply assign a vector of labels. We use some of the information which is 109 | given on the help page of the `Orthodont` data and use it as labels: 110 | ```{r} 111 | labels(Orthodont) <- c("fissure distance (mm)", "age (years)", "Subject", "Sex") 112 | ``` 113 | If we now query if `Orthodont` is a labeled data frame and extract the labels, we get 114 | ```{r} 115 | is.ldf(Orthodont) 116 | class(Orthodont) 117 | ``` 118 | We see that by setting variable labels, we also add the class `'ldf'` to the data frame. 119 | Now, the labels are 120 | ```{r} 121 | labels(Orthodont) 122 | ``` 123 | 124 | 125 | #### Advanced labelling 126 | 127 | We can also set or ectract labels for a subset of the variables using the option 128 | `which`, which can either be a vector of variable names or indices. Let's capitalize 129 | the labels of `distance` and `age` to make it consitent with `Subject` and `Sex`: 130 | ```{r} 131 | ## set labels for distance and age 132 | labels(Orthodont, which = c("distance", "age")) <- c("Fissure distance (mm)", "Age (years)") 133 | ## extract labels for age only 134 | labels(Orthodont, which = "age") 135 | ## or for the first two variables (i.e., distance and age) 136 | labels(Orthodont, which = 1:2) 137 | ``` 138 | 139 | #### Conversion to labeled data frames 140 | 141 | Instead of manually setting labels, we can simply convert a data frame to a 142 | labeled data frame, either with the function `as.ldf()` or with `convert.labels()`. 143 | Actually, both calls reference the same function (for an object of class `data.frame`). 144 | 145 | While `as.ldf()` can be seen as the classical counterpart of `is.ldf()`, the 146 | function name `convert.labels()` is inspired by the fact that these functions either 147 | convert the variable names to labels or convert other variable labels to **papeR**-type 148 | variable labels. Hence, these functions can, for example, be used to convert labels 149 | from data sets which are imported via the function `read.spss()` to **papeR**-type 150 | variable labels. 151 | 152 | If no variable labels are specified, the original variable names are used. 153 | ```{r} 154 | Orthodont2 <- convert.labels(Orthodont_orig) 155 | class(Orthodont2) 156 | labels(Orthodont2) 157 | ``` 158 | 159 | ### Plotting labeled data frames 160 | 161 | For data frames of class `'ldf'`, there exist special plotting functions: 162 | ```{r plot_labeled_dataframe} 163 | par(mfrow = c(2, 2)) 164 | plot(Orthodont) 165 | ``` 166 | 167 | As one can see, the plot type is automatically determined 168 | based on the data type and the axis label is defined by 169 | the `labels()`. 170 | 171 | To obtain group comparisons, we can use grouped plots. To plot all variable in the 172 | groups of `Sex` one can use 173 | ```{r grouped_plot} 174 | par(mfrow = c(1, 3)) 175 | plot(Orthodont, by = "Sex") 176 | ``` 177 | 178 | We can as well plot everything against the metrical variable `distance` 179 | ```{r with_x} 180 | par(mfrow = c(1, 3)) 181 | plot(Orthodont, with = "distance") 182 | ``` 183 | 184 | To plot only a subset of the data, say all but `Subject`, against `distance` and 185 | suppress the regression line we can use 186 | ```{r univariate_no_regressionline} 187 | par(mfrow = c(1, 2)) 188 | plot(Orthodont, variables = -3, with = "distance", regression.line = FALSE) 189 | ``` 190 | 191 | Note that again we can use either variable names or indices to specify the variables 192 | which are to be plotted. 193 | 194 | 195 | ### Summary tables 196 | 197 | One can use the command `summarize()` to automatically produce summary tables for 198 | either numerical variables (i.e., variables where `is.numeric()` is `TRUE`) or 199 | categorical variables (where `is.factor()` is `TRUE`). We now extract a summary 200 | table for numerical variables of the `Orthodont` data set: 201 | ```{r} 202 | data(Orthodont, package = "nlme") 203 | summarize(Orthodont, type = "numeric") 204 | ``` 205 | 206 | Similarly, we can extract summaries for all factor variables. As one of the factors 207 | is the `Subject` which has `r nlevels(Orthodont$Subject)` levels, each with 208 | `r unique(table(Orthodont$Subject))` observations, we exclude this from the summary 209 | table and only have a look at `Sex` 210 | ```{r} 211 | summarize(Orthodont, type = "factor", variables = "Sex") 212 | ``` 213 | 214 | Again, as for the plots, one can specify `group`s to obtain grouped statistics: 215 | ```{r} 216 | summarize(Orthodont, type = "numeric", group = "Sex", test = FALSE) 217 | ``` 218 | 219 | Per default, one also gets `test`s for group differences: 220 | ```{r} 221 | summarize(Orthodont, type = "numeric", group = "Sex") 222 | ``` 223 | 224 | ### Converting summaries to PDF 225 | 226 | So far, we only got standard R output. Yet, any of these summary tables can be 227 | easily converted to LaTeX code using the package **xtable**. In **papeR** two 228 | special functions `xtable.summary()` and `print.xtable.summary()` are defined 229 | for easy and pretty conversion. In `Sweave` we can use 230 | ```r 231 | <>= 232 | xtable(summarize(Orthodont, type = "numeric")) 233 | xtable(summarize(Orthodont, type = "factor", variables = "Sex")) 234 | xtable(summarize(Orthodont, type = "numeric", group = "Sex")) 235 | @ 236 | ``` 237 | and in **knitr** we can use 238 | ```r 239 | <>= 240 | xtable(summarize(Orthodont, type = "numeric")) 241 | xtable(summarize(Orthodont, type = "factor", variables = "Sex")) 242 | xtable(summarize(Orthodont, type = "numeric", group = "Sex")) 243 | @ 244 | ``` 245 | to get the following PDF output 246 | 247 | ![LaTeX Output](tables.png) 248 | 249 | Note that per default, `booktabs` is set to `TRUE` in `print.xtable.summary`, and 250 | thus `\usepackage{booktabs}` is needed in the header of the LaTeX report. For details 251 | on LaTeX summary tables see the dedicated vignette, which can be obtained, e.g., via 252 | `vignette("papeR\_with\_latex", package = "papeR")`. See also there for more details 253 | on summary tables in general. 254 | 255 | ### Converting summaries to Markdown 256 | 257 | To obtain markdown output we can use, for example, the function `kable()` from 258 | package **knitr** on the summary objects: 259 | 260 | ```r 261 | `` `{r, echo = FALSE, results = 'asis'} 262 | library("knitr") 263 | kable(summarize(Orthodont, type = "numeric")) 264 | kable(summarize(Orthodont, type = "factor", variables = "Sex", cumulative = TRUE)) 265 | kable(summarize(Orthodont, type = "numeric", group = "Sex", test = FALSE)) 266 | `` ` 267 | ``` 268 | 269 | which gives the following results 270 | 271 | ```{r, echo = FALSE, results = 'asis'} 272 | library("knitr") 273 | kable(summarize(Orthodont, type = "numeric")) 274 | kable(summarize(Orthodont, type = "factor", variables = "Sex", cumulative = TRUE)) 275 | kable(summarize(Orthodont, type = "numeric", group = "Sex")) 276 | ``` 277 | 278 | 279 | ### Prettify model output 280 | 281 | To prettify the output of a linear model, one can use the function 282 | `prettify()`. This function adds confidence intervals, properly 283 | prints p-values, adds significance stars to the output (if desired) 284 | and additionally adds pretty formatting for factors. 285 | 286 | ```{r} 287 | linmod <- lm(distance ~ age + Sex, data = Orthodont) 288 | ## Extract pretty summary 289 | (pretty_lm <- prettify(summary(linmod))) 290 | ``` 291 | 292 | The resulting table can now be formatted for printing using packages like 293 | **xtable** for LaTeX which can be used in `.Rnw` files with the option 294 | `results='asis'` (in **knitr**) or `results = tex` (in `Sweave`) 295 | 296 | ```{r, results='hide'} 297 | xtable(pretty_lm) 298 | ``` 299 | 300 | In markdown files (`.Rmd`) one can instead use the function `kable()` with the 301 | chunk option `results='asis'`. The result looks as follows: 302 | 303 | ```{r, results='asis'} 304 | kable(pretty_lm) 305 | ``` 306 | 307 | #### Supported objects 308 | 309 | The function `prettify` is *currently* implemented for objects of the following classes: 310 | 311 | * `lm` (linear models) 312 | * `glm` (generalized linear models) 313 | * `coxph` (Cox proportional hazards models) 314 | * `lme` (linear mixed models; implemented in package **nlme**) 315 | * `mer` (linear mixed models; implemented in package **lme4**, version < 1.0) 316 | * `merMod` (linear mixed models; implemented in package **lme4**, version >= 1.0) 317 | * `anova` (anova objects) 318 | 319 | ## Summary and Outlook 320 | 321 | The package is intended to ease reporting of standard data analysis tasks such as 322 | descriptive statistics, simple test results, plots and to prettify the output of 323 | various statistical models. 324 | 325 | **papeR** is under active development. Feature requests, bug reports, or 326 | patches, which either add new features or fix bugs, are always welcome. Please use 327 | the [GitHub](https://github.com/hofnerb/papeR) page. 328 | -------------------------------------------------------------------------------- /vignettes/papeR_with_latex.Rnw: -------------------------------------------------------------------------------- 1 | \documentclass{article} 2 | \usepackage{booktabs} 3 | \usepackage{longtable} 4 | \usepackage{capt-of} 5 | 6 | \setlength{\parskip}{1em} 7 | \setlength{\parindent}{0em} 8 | 9 | %\VignetteEngine{knitr::knitr} 10 | %\VignetteIndexEntry{Using papeR with LaTeX} 11 | 12 | <>= 13 | library("knitr") 14 | opts_chunk$set(message = FALSE, warning = FALSE, echo = TRUE, results = 'asis') 15 | data(Orthodont, package = "nlme") 16 | @ 17 | 18 | \title{Using papeR with \LaTeX} 19 | \author{Benjamin Hofner} 20 | \date{Version \Sexpr{packageDescription("papeR")$Version}} %$ 21 | 22 | \begin{document} 23 | \maketitle 24 | 25 | \begin{abstract} 26 | \setlength{\parskip}{0.5em} 27 | 28 | The main goal of the package \textbf{papeR} is to ease statistical reporting 29 | and thus to ease reproducible research. By relying on powerful tools such as 30 | the \texttt{Sweave} command kit, or the packages \textbf{knitr} and 31 | \textbf{xtable}, the package can be easily integrated in existing workflows. 32 | 33 | The package provides an infrastructure to handle variable labels which are 34 | used in all other functions (\texttt{labels()}), allows to create (complex) 35 | summary tables of the data sets (\texttt{summarize()}) and to easily plot the 36 | data (\texttt{plot()} for labeled \texttt{data.frame}s), and enhances summary 37 | tables of statistical models by (possibly) adding confidence intervals, 38 | significance stars, odds ratios, etc. and by separating variable names and 39 | factor levels (\texttt{prettify()}). 40 | \end{abstract} 41 | 42 | \section{Introduction} 43 | 44 | This is a short description of some of the \LaTeX related features of 45 | \texttt{papeR}. For installation instructions and a comprehensive overview of 46 | the features of \texttt{papeR} see also the vignette on using \texttt{papeR} to 47 | (mainly) produce Markdown output (e.g. via 48 | \texttt{vignette("papeR\_introduction", package = "papeR")}). 49 | 50 | In short, we load the package, load an example data set, and set variable labels: 51 | <<>>= 52 | library("papeR") 53 | data(Orthodont, package = "nlme") 54 | labels(Orthodont) <- c("fissure distance (mm)", 55 | "age (years)", "Subject", "Sex") 56 | @ 57 | 58 | \section{Pretty tables} 59 | 60 | To produce \LaTeX tables, we heavily rely on the R package \textbf{xtable}. Note 61 | that all arguments to \texttt{xtable()} or \texttt{print.xtable()} can be used 62 | as usual, yet, some defaults were changed in package \textbf{papeR}. For 63 | example, we use per default the \LaTeX package \texttt{booktabs} to print 64 | tables and tables are not set as floating objects. For further changes see the 65 | manual of \texttt{xtable.summary}. 66 | 67 | \subsection{Summary tables for numerical variables} 68 | 69 | Now we can produce summary tables for numeric variables: 70 | <<>>= 71 | xtable(summarize(Orthodont, type = "numeric")) 72 | @ 73 | 74 | Grouped statistics with tests can be obtained via: 75 | <<>>= 76 | xtable(summarize(Orthodont, type = "numeric", group = "Sex")) 77 | @ 78 | 79 | Per default, t-tests are computed. To change the test, one can use: 80 | <<>>= 81 | xtable(summarize(Orthodont, type = "numeric", group = "Sex", 82 | test = c("wilcox.test", "t.test"))) 83 | @ 84 | To use Wicoxon tests for all variables, one could simply set \texttt{test = 85 | "wilcox.test"}, or one could switch off tests by setting \texttt{test = 86 | FALSE}. 87 | 88 | To drop some of the statistics one can set several options to \texttt{FALSE}. 89 | E.g., if we do not want to show the five-number summaries (minimum, 25\% 90 | quantile, median, 75\% quantile, maximum), one can use 91 | <<>>= 92 | xtable(summarize(Orthodont, type = "numeric", group = "Sex", 93 | quantiles = FALSE)) 94 | @ 95 | Alternatively or additionally, one could also drop $N$ (\texttt{count = FALSE}) 96 | or mean and standard deviation (\texttt{mean\_sd = FALSE}). For details see also 97 | the manual of \texttt{summary\_numeric()}. 98 | 99 | \subsection{Summary tables for factor variables} 100 | 101 | In the same way, summary tables for factors can be computed. Here, we only want 102 | to print the variable \texttt{Sex}: 103 | <<>>= 104 | xtable(summarize(Orthodont, type = "factor", variables = "Sex")) 105 | @ 106 | 107 | If tables are longer than one page or cross a page, one can also use 108 | \texttt{"tabular.environment = "longtable""}: 109 | <<>>= 110 | print(xtable(summarize(Orthodont, type = "factor")), 111 | tabular.environment = "longtable") 112 | @ 113 | which automatically specifies the table header such that it is repeated at the 114 | top of each new page. 115 | 116 | To additionally obtain the cumulative frequencies, we can use: 117 | <<>>= 118 | xtable(summarize(Orthodont, type = "factor", variables = "Sex", 119 | cumulative = TRUE)) 120 | @ 121 | 122 | As for numerical summaries, grouped statistics are tested. Per default, Fisher's 123 | exact test is used. To speed up computations (of this non-sense test), we only 124 | use a small subset of the original data: 125 | <<>>= 126 | Ortho_small <- subset(Orthodont, 127 | Subject %in% c("M01", "M02", "F01", "F02")) 128 | xtable(summarize(Ortho_small, type = "factor", 129 | variables = "Subject", group = "Sex")) 130 | @ 131 | 132 | \subsection{Captions} 133 | 134 | As usual, all floating tables can have captions. Per default, these are printed 135 | above the table. Note that by using the \LaTeX package \texttt{capt-of}, one can 136 | specify table captions and labels also for non floating tables as shown in 137 | Table~\ref{tab:Fisher}. 138 | <<>>= 139 | xtable(summarize(Ortho_small, type = "factor", 140 | variables = "Subject", group = "Sex"), 141 | caption = "Example table for Fisher's exact test", 142 | label = "tab:Fisher") 143 | @ 144 | 145 | \end{document} 146 | -------------------------------------------------------------------------------- /vignettes/tables.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hofnerb/papeR/9b46640d9d506bf36a2504b66a3cb1e9d0556bc2/vignettes/tables.png --------------------------------------------------------------------------------