Skip to content

Commit

Permalink
Add 'tabfig' argument to forest functions.
Browse files Browse the repository at this point in the history
  • Loading branch information
@wviechtb
wviechtb committed Sep 11, 2023
1 parent fe5ed56 commit 701b187
Show file tree
Hide file tree
Showing 7 changed files with 93 additions and 46 deletions.
4 changes: 2 additions & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: metafor
Version: 4.3-19
Date: 2023-09-10
Version: 4.3-20
Date: 2023-09-11
Title: Meta-Analysis Package for R
Authors@R: person(given = "Wolfgang", family = "Viechtbauer", role = c("aut","cre"), email = "[email protected]", comment = c(ORCID = "0000-0003-3463-4063"))
Depends: R (>= 4.0.0), methods, Matrix, metadat, numDeriv
Expand Down
2 changes: 1 addition & 1 deletion NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# metafor 4.3-19 (2023-09-10)
# metafor 4.3-20 (2023-09-11)

- added `getmfopt()` and `setmfopt()` functions for getting and setting package options and made some of the options more flexible

Expand Down
42 changes: 29 additions & 13 deletions R/forest.cumul.rma.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -116,15 +116,29 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
if (length(efac) == 1L)
efac <- rep(efac, 2L)

### setting for tabular figures

if (is.null(ddd$tabfig)) {
tabfig <- FALSE
} else {
tabfig <- ddd$tabfig
}

### annotation symbols vector

if (is.null(ddd$annosym)) {
annosym <- c(" [", ", ", "]", "-") # 4th element for minus sign symbol
if (tabfig) {
annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2000") # \u2009 thin space, \u2212 minus, \u2000 en quad (same width as minus for Calibri/Carlito); see [a]
} else {
annosym <- c(" [", ", ", "]", "-", " ") # 4th element for minus sign symbol; 5th for space (in place of numbers and +)
}
} else {
annosym <- ddd$annosym
if (length(annosym) == 3L)
annosym <- c(annosym, "-")
if (length(annosym) != 4L)
annosym <- c(annosym, "-", " ")
if (length(annosym) == 4L)
annosym <- c(annosym, " ")
if (length(annosym) != 5L)
stop(mstyle$stop("Argument 'annosym' must be a vector of length 3 (or 4)."))
}

Expand Down Expand Up @@ -197,14 +211,14 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
xlabfont <- ddd$xlabfont
}

lplot <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) plot(...)
labline <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) abline(...)
lsegments <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) segments(...)
laxis <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) axis(...)
lmtext <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) mtext(...)
lpolygon <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) polygon(...)
ltext <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) text(...)
lpoints <- function(..., textpos, clim, rowadj, annosym, top, xlabadj, xlabfont) points(...)
lplot <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) plot(...)
labline <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) abline(...)
lsegments <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) segments(...)
laxis <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) axis(...)
lmtext <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) mtext(...)
lpolygon <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) polygon(...)
ltext <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) text(...)
lpoints <- function(..., textpos, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) points(...)

#########################################################################

Expand Down Expand Up @@ -732,7 +746,6 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
}

annotext <- fmtx(annotext, digits[[1]])
annotext <- sub("-", annosym[4], annotext, fixed=TRUE)

if (missing(width)) {
width <- apply(annotext, 2, function(x) max(nchar(x)))
Expand All @@ -748,9 +761,12 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
}

annotext <- cbind(annotext[,1], annosym[1], annotext[,2], annosym[2], annotext[,3], annosym[3])

annotext <- apply(annotext, 1, paste, collapse="")
annotext[grepl("NA", annotext, fixed=TRUE)] <- ""
annotext <- sub("-", annosym[4], annotext, fixed=TRUE)
annotext <- gsub("-", annosym[4], annotext, fixed=TRUE) # [a]
annotext <- gsub(" ", annosym[5], annotext, fixed=TRUE)

par(family=names(fonts)[2], font=fonts[2])
ltext(textpos[2], rows+rowadj[2], labels=annotext, pos=2, cex=cex, col=col, ...)
par(family=names(fonts)[1], font=fonts[1])
Expand Down
43 changes: 29 additions & 14 deletions R/forest.default.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,15 +106,29 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
if (length(efac) == 1L)
efac <- rep(efac, 2L)

### setting for tabular figures

if (is.null(ddd$tabfig)) {
tabfig <- FALSE
} else {
tabfig <- ddd$tabfig
}

### annotation symbols vector

if (is.null(ddd$annosym)) {
annosym <- c(" [", ", ", "]", "-") # 4th element for minus sign symbol
if (tabfig) {
annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2000") # \u2009 thin space, \u2212 minus, \u2000 en quad (same width as minus for Calibri/Carlito); see [a]
} else {
annosym <- c(" [", ", ", "]", "-", " ") # 4th element for minus sign symbol; 5th for space (in place of numbers and +)
}
} else {
annosym <- ddd$annosym
if (length(annosym) == 3L)
annosym <- c(annosym, "-")
if (length(annosym) != 4L)
annosym <- c(annosym, "-", " ")
if (length(annosym) == 4L)
annosym <- c(annosym, " ")
if (length(annosym) != 5L)
stop(mstyle$stop("Argument 'annosym' must be a vector of length 3 (or 4)."))
}

Expand Down Expand Up @@ -197,14 +211,14 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
xlabfont <- ddd$xlabfont
}

lplot <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) plot(...)
labline <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) abline(...)
lsegments <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) segments(...)
laxis <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) axis(...)
lmtext <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) mtext(...)
lpolygon <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) polygon(...)
ltext <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) text(...)
lpoints <- function(..., textpos, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) points(...)
lplot <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) plot(...)
labline <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) abline(...)
lsegments <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) segments(...)
laxis <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) axis(...)
lmtext <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) mtext(...)
lpolygon <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) polygon(...)
ltext <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) text(...)
lpoints <- function(..., textpos, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) points(...)

#########################################################################

Expand Down Expand Up @@ -882,8 +896,6 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
annotext <- fmtx(annotext, digits[[1]])
}

annotext <- sub("-", annosym[4], annotext, fixed=TRUE)

if (missing(width)) {
width <- apply(annotext, 2, function(x) max(nchar(x)))
} else {
Expand All @@ -898,13 +910,16 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
}

if (showweights) {
annotext <- cbind(annotext[,1], "% ", annotext[,2], annosym[1], annotext[,3], annosym[2], annotext[,4], annosym[3])
annotext <- cbind(annotext[,1], paste0("%", rep(substr(annosym[1],1,1),3)), annotext[,2], annosym[1], annotext[,3], annosym[2], annotext[,4], annosym[3])
} else {
annotext <- cbind(annotext[,1], annosym[1], annotext[,2], annosym[2], annotext[,3], annosym[3])
}

annotext <- apply(annotext, 1, paste, collapse="")
annotext[grepl("NA", annotext, fixed=TRUE)] <- ""
annotext <- gsub("-", annosym[4], annotext, fixed=TRUE) # [a]
annotext <- gsub(" ", annosym[5], annotext, fixed=TRUE)

par(family=names(fonts)[2], font=fonts[2])
ltext(textpos[2], rows+rowadj[2], labels=annotext, pos=2, cex=cex, col=col, ...)
par(family=names(fonts)[1], font=fonts[1])
Expand Down
44 changes: 30 additions & 14 deletions R/forest.rma.r
View file
Original file line number Diff line number Diff line change
Expand Up @@ -153,15 +153,29 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
if (length(efac) == 2L)
efac <- c(efac[1], efac[1], efac[2]) # if 2 values specified: 1st = CI end lines and arrows, 2nd = summary polygon or fitted polygons

### setting for tabular figures

if (is.null(ddd$tabfig)) {
tabfig <- FALSE
} else {
tabfig <- ddd$tabfig
}

### annotation symbols vector

if (is.null(ddd$annosym)) {
annosym <- c(" [", ", ", "]", "-") # 4th element for minus sign symbol
if (tabfig) {
annosym <- c("\u2009[", ",\u2009", "]", "\u2212", "\u2000") # \u2009 thin space, \u2212 minus, \u2000 en quad (same width as minus for Calibri/Carlito); see [a]
} else {
annosym <- c(" [", ", ", "]", "-", " ") # 4th element for minus sign symbol; 5th for space (in place of numbers and +)
}
} else {
annosym <- ddd$annosym
if (length(annosym) == 3L)
annosym <- c(annosym, "-")
if (length(annosym) != 4L)
annosym <- c(annosym, "-", " ")
if (length(annosym) == 4L)
annosym <- c(annosym, " ")
if (length(annosym) != 5L)
stop(mstyle$stop("Argument 'annosym' must be a vector of length 3 (or 4)."))
}

Expand Down Expand Up @@ -249,14 +263,14 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
xlabfont <- ddd$xlabfont
}

lplot <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) plot(...)
labline <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) abline(...)
lsegments <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) segments(...)
laxis <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) axis(...)
lmtext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) mtext(...)
lpolygon <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) polygon(...)
ltext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) text(...)
lpoints <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, top, xlabadj, xlabfont) points(...)
lplot <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) plot(...)
labline <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) abline(...)
lsegments <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) segments(...)
laxis <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) axis(...)
lmtext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) mtext(...)
lpolygon <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) polygon(...)
ltext <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) text(...)
lpoints <- function(..., textpos, addcred, pi.type, decreasing, clim, rowadj, annosym, tabfig, top, xlabadj, xlabfont) points(...)

if (is.character(showweights)) {
weighttype <- match.arg(showweights, c("diagonal", "rowsum"))
Expand Down Expand Up @@ -1148,8 +1162,6 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
annotext <- fmtx(annotext, digits[[1]])
}

annotext <- sub("-", annosym[4], annotext, fixed=TRUE)

if (missing(width)) {
width <- apply(annotext, 2, function(x) max(nchar(x)))
} else {
Expand All @@ -1167,20 +1179,24 @@ lty, fonts, cex, cex.lab, cex.axis, ...) {
width <- width[-1] # remove the first entry for the weights (so this can be used by addpoly() via .metafor)

if (showweights) {
annotext <- cbind(annotext[,1], "% ", annotext[,2], annosym[1], annotext[,3], annosym[2], annotext[,4], annosym[3])
annotext <- cbind(annotext[,1], paste0("%", paste0(rep(substr(annosym[1],1,1),3), collapse="")), annotext[,2], annosym[1], annotext[,3], annosym[2], annotext[,4], annosym[3])
} else {
annotext <- cbind(annotext[,1], annosym[1], annotext[,2], annosym[2], annotext[,3], annosym[3])
}

annotext <- apply(annotext, 1, paste, collapse="")
annotext[grepl("NA", annotext, fixed=TRUE)] <- ""
annotext <- gsub("-", annosym[4], annotext, fixed=TRUE) # [a]
annotext <- gsub(" ", annosym[5], annotext, fixed=TRUE)

par(family=names(fonts)[2], font=fonts[2])

if (addfit && x$int.only) {
ltext(textpos[2], c(rows,-1)+rowadj[2], labels=annotext, pos=2, cex=cex, ...)
} else {
ltext(textpos[2], rows+rowadj[2], labels=annotext, pos=2, cex=cex, ...)
}

par(family=names(fonts)[1], font=fonts[1])

} else {
Expand Down
2 changes: 1 addition & 1 deletion R/zzz.r
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
.onAttach <- function(libname, pkgname) {

ver <- "4.3-19"
ver <- "4.3-20"

loadmsg <- paste0("\nLoading the 'metafor' package (version ", ver, "). For an\nintroduction to the package please type: help(metafor)\n")

Expand Down
2 changes: 1 addition & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ metafor: A Meta-Analysis Package for R
[![R build status](https://github.com/wviechtb/metafor/workflows/R-CMD-check/badge.svg)](https://github.com/wviechtb/metafor/actions)
[![Code Coverage](https://codecov.io/gh/wviechtb/metafor/branch/master/graph/badge.svg)](https://app.codecov.io/gh/wviechtb/metafor)
[![CRAN Version](https://www.r-pkg.org/badges/version/metafor)](https://cran.r-project.org/package=metafor)
[![devel Version](https://img.shields.io/badge/devel-4.3--19-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
[![devel Version](https://img.shields.io/badge/devel-4.3--20-brightgreen.svg)](https://www.metafor-project.org/doku.php/installation#development_version)
[![Monthly Downloads](https://cranlogs.r-pkg.org/badges/metafor)](https://cranlogs.r-pkg.org/badges/metafor)
[![Total Downloads](https://cranlogs.r-pkg.org/badges/grand-total/metafor)](https://cranlogs.r-pkg.org/badges/grand-total/metafor)

Expand Down

0 comments on commit 701b187

Please sign in to comment.