Nothing
R/netsplit.R
In netmeta: Network Meta-Analysis using Frequentist Methods
Defines functions
print.netsplit
netsplit
Documented in
netsplit
print.netsplit
#' Split direct and indirect evidence in network meta-analysis
#'
#' @description
#' Methods to split network estimates into the contribution of direct
#' and indirect evidence and to test for local inconsistency in
#' network meta-analysis.
#'
#' @aliases netsplit print.netsplit
#'
#' @param x An object of class \code{netmeta} or \code{netsplit}.
#' @param method A character string indicating which method to split
#' direct and indirect evidence is to be used. Either
#' \code{"Back-calculation"} or \code{"SIDDE"}, can be abbreviated.
#' See Details.
#' @param upper A logical indicating whether treatment comparisons
#' should be selected from the lower or upper triangle of the
#' treatment effect matrices (see list elements \code{TE.common} and
#' \code{TE.random} in the \code{netmeta} object). Ignored if
#' argument \code{order} is provided.
#' @param reference.group Reference treatment. Ignored if argument
#' \code{order} is provided.
#' @param baseline.reference A logical indicating whether results
#' should be expressed as comparisons of other treatments versus the
#' reference treatment or vice versa. This argument is only
#' considered if \code{reference.group} is not equal to \code{""}
#' and argument\code{order} is not provided.
#' @param order A optional character or numerical vector specifying
#' the order of treatments in comparisons.
#' @param sep.trts A character string used in comparison names as
#' separator between treatment labels, e.g., " vs ".
#' @param quote.trts A character used to print around treatment
#' labels.
#' @param tol.direct A numeric defining the maximum deviation of the
#' direct evidence proportion from 0 or 1 to classify a comparison
#' as providing only indirect or direct evidence, respectively.
#' @param common A logical indicating whether results for the common
#' effects network meta-analysis should be printed.
#' @param random A logical indicating whether results for the random
#' effects network meta-analysis should be printed.
#' @param show A character string indicating which comparisons should
#' be printed (see Details).
#' @param overall A logical indicating whether estimates from network
#' meta-analyis should be printed in addition to direct and indirect
#' estimates.
#' @param ci A logical indicating whether confidence intervals should
#' be printed in addition to treatment estimates.
#' @param test A logical indicating whether results of a test
#' comparing direct and indirect estimates should be printed.
#' @param only.reference A logical indicating whether only comparisons
#' with the reference group should be printed.
#' @param sortvar An optional vector used to sort comparisons (must be
#' of same length as the total number of comparisons).
#' @param subset An optional logical vector specifying a subset of
#' comparisons to print (must be of same length as the total number of
#' comparisons) .
#' @param nchar.trts A numeric defining the minimum number of
#' characters used to create unique treatment names.
#' @param digits Minimal number of significant digits, see
#' \code{print.default}.
#' @param digits.stat Minimal number of significant digits for z-value
#' of test of agreement between direct and indirect evidence, see
#' \code{print.default}.
#' @param digits.pval Minimal number of significant digits for p-value
#' of test of agreement between direct and indirect evidence, see
#' \code{print.default}.
#' @param digits.prop Minimal number of significant digits for direct
#' evidence proportions, see \code{print.default}.
#' @param text.NA A character string specifying text printed for
#' missing values.
#' @param backtransf A logical indicating whether printed results
#' should be back transformed. For example, if \code{backtransf =
#' TRUE}, results for \code{sm = "OR"} are printed as odds ratios
#' rather than log odds ratios.
#' @param scientific.pval A logical specifying whether p-values should
#' be printed in scientific notation, e.g., 1.2345e-01 instead of
#' 0.12345.
#' @param big.mark A character used as thousands separator.
#' @param legend A logical indicating whether a legend should be
#' printed.
#' @param indent A logical indicating whether items in the legend
#' should be indented.
#' @param warn A logical indicating whether warnings should be
#' printed.
#' @param warn.deprecated A logical indicating whether warnings should
#' be printed if deprecated arguments are used.
#' @param verbose A logical indicating whether progress information
#' should be printed.
#' @param \dots Additional arguments.
#'
#' @details
#' A comparison of direct and indirect treatment estimates can serve
#' as check for consistency of network meta-analysis (Dias et al.,
#' 2010).
#'
#' This function provides two methods to derive indirect estimates:
#' \itemize{
#' \item Separate Indirect from Direct Evidence (SIDE) using a
#' back-calculation method (\code{method = "Back-calculation"})
#' based on the \emph{direct evidence proportion} to calculate the
#' indirect evidence (König et al., 2013);
#' \item Separate Indirect from Direct Design Evidence (SIDDE) as
#' described in Efthimiou et al. (2019).
#' }
#'
#' Note, for the back-calculation method, indirect treatment estimates
#' are already calculated in \code{\link{netmeta}} and this function
#' combines and prints these estimates in a user-friendly
#' way. Furthermore, this method is not available for the
#' Mantel-Haenszel and non-central hypergeometric distribution
#' approach implemented in \code{\link{netmetabin}}.
#'
#' For the random-effects model, the direct treatment estimates are
#' based on the common between-study variance \eqn{\tau^2} from the
#' network meta-analysis, i.e. the square of list element
#' \code{x$tau}.
#'
#' Argument \code{show} determines which comparisons are printed:
#' \tabular{ll}{
#' \dQuote{all} \tab All comparisons \cr
#' \dQuote{both} \tab Only comparisons contributing both direct and
#' indirect evidence \cr
#' \dQuote{with.direct} \tab Comparisons providing direct evidence \cr
#' \dQuote{direct.only} \tab Comparisons providing only direct
#' evidence \cr
#' \dQuote{indirect.only} \tab Comparisons providing only indirect
#' evidence
#' }
#'
#' The node-splitting method and SIDDE can be compute-intensive in
#' large networks. Crude information on the computation progress is
#' printed if argument \code{verbose = TRUE}. In addition, computation
#' times are printed if R package \bold{tictoc} is installed.
#'
#' @return
#' An object of class \code{netsplit} with corresponding \code{print}
#' and \code{forest} functions. The object is a list containing the
#' following components:
#' \item{common, random}{As defined above.}
#' \item{comparison}{A vector with treatment comparisons.}
#' \item{prop.common, prop.random}{A vector with direct evidence
#' proportions (common / random effects model).}
#' \item{common, random}{Results of network meta-analysis (common /
#' random effects model), i.e., data frame with columns comparison,
#' TE, seTE, lower, upper, z, and p.}
#' \item{direct.common, direct.random}{Network meta-analysis results
#' based on direct evidence (common / random effects model), i.e.,
#' data frame with columns comparison, TE, seTE, lower, upper, z,
#' and p.}
#' \item{indirect.common, indirect.random}{Network meta-analysis
#' results based on indirect evidence (common / random effects
#' model), i.e., data frame with columns comparison, TE, seTE,
#' lower, upper, z, and p.}
#' \item{compare.common, compare.random}{Comparison of direct and
#' indirect evidence in network meta-analysis (common / random
#' effects model), i.e., data frame with columns comparison, TE,
#' seTE, lower, upper, z, and p.}
#' \item{sm}{A character string indicating underlying summary measure}
#' \item{level.ma}{The level used to calculate confidence intervals
#' for pooled estimates.}
#' \item{tictoc}{Computation times for node-splitting method or SIDDE
#' (if R package \bold{tictoc} is installed).}
#' \item{version}{Version of R package netmeta used to create object.}
#'
#' @author Guido Schwarzer \email{guido.schwarzer@@uniklinik-freiburg.de}, Gerta
#' Rücker \email{gerta.ruecker@@uniklinik-freiburg.de}, Orestis Efthimiou
#' \email{oremiou@@gmail.com}
#'
#' @seealso \code{\link{forest.netsplit}}, \code{\link{netmeta}},
#' \code{\link{netmetabin}}, \code{\link{netmeasures}}
#'
#' @references
#' Dias S, Welton NJ, Caldwell DM, Ades AE (2010):
#' Checking consistency in mixed treatment comparison meta-analysis.
#' \emph{Statistics in Medicine},
#' \bold{29}, 932--44
#'
#' Efthimiou O, Rücker G, Schwarzer G, Higgins J, Egger M, Salanti G
#' (2019):
#' A Mantel-Haenszel model for network meta-analysis of rare events.
#' \emph{Statistics in Medicine},
#' \bold{38}, 2992--3012
#'
#' König J, Krahn U, Binder H (2013):
#' Visualizing the flow of evidence in network meta-analysis and
#' characterizing mixed treatment comparisons.
#' \emph{Statistics in Medicine},
#' \bold{32}, 5414--29
#'
#' Puhan MA, Schünemann HJ, Murad MH, et al. (2014):
#' A GRADE working group approach for rating the quality of treatment
#' effect estimates from network meta-analysis.
#' \emph{British Medical Journal},
#' \bold{349}, g5630
#'
#' @examples
#' data(Woods2010)
#' #
#' p1 <- pairwise(treatment, event = r, n = N,
#' studlab = author, data = Woods2010, sm = "OR")
#' #
#' net1 <- netmeta(p1)
#' #
#' print(netsplit(net1), digits = 2)
#'
#' \dontrun{
#' print(netsplit(net1), digits = 2,
#' backtransf = FALSE, common = FALSE)
#'
#' # Sort by increasing number of studies in direct comparisons
#' print(netsplit(net1), digits = 2, sortvar = k)
#' # Sort by decreasing number of studies in direct comparisons
#' print(netsplit(net1), digits = 2, sortvar = -k)
#'
#' # Sort by increasing evidence proportion under common effects model
#' print(netsplit(net1), digits = 2, sortvar = prop.common)
#' # Sort by decreasing evidence proportion under common effects model
#' print(netsplit(net1), digits = 2, sortvar = -prop.common)
#'
#' # Sort by decreasing evidence proportion under common effects model
#' # and number of studies
#' print(netsplit(net1), digits = 2, sortvar = cbind(-prop.common, -k))
#'
#' data(Senn2013)
#' #
#' net2 <- netmeta(TE, seTE, treat1.long, treat2.long,
#' studlab, data = Senn2013)
#' #
#' print(netsplit(net2), digits = 2)
#' # Layout of Puhan et al. (2014), Table 1
#' print(netsplit(net2), digits = 2, ci = TRUE, test = FALSE)
#'
#' data(Dong2013)
#' p3 <- pairwise(treatment, death, randomized, studlab = id,
#' data = Dong2013, sm = "OR")
#' net3 <- netmetabin(p3)
#' netsplit(net3)
#' }
#'
#' @rdname netsplit
#' @export netsplit
netsplit <- function(x, method,
upper = TRUE,
reference.group = x$reference.group,
baseline.reference = x$baseline.reference,
order = NULL,
sep.trts = x$sep.trts, quote.trts = "",
tol.direct = 0.0005,
common = x$common,
random = x$random,
backtransf = x$backtransf,
warn = FALSE, warn.deprecated = gs("warn.deprecated"),
verbose = FALSE,
...) {
##
##
## (1) Check for netmeta object and upgrade object
##
##
chkclass(x, "netmeta")
x <- updateversion(x)
##
is.bin <- inherits(x, "netmetabin")
##
is.tictoc <- is.installed.package("tictoc", stop = FALSE)
##
##
## (2) Check other arguments
##
##
if (!missing(method))
method <- setchar(method, c("Back-calculation", "SIDDE"))
else {
if (is.bin)
method <- "SIDDE"
else
method <- "Back-calculation"
}
##
chklogical(upper)
chklogical(baseline.reference)
##
if (!is.null(order)) {
order <- setseq(order, x$trts)
baseline.reference <- FALSE
reference.group <- ""
}
##
chkchar(sep.trts)
chkchar(quote.trts)
chknumeric(tol.direct, min = 0, length = 1)
if (!is.null(backtransf))
chklogical(backtransf)
chklogical(warn)
chklogical(verbose)
##
## Check for deprecated arguments in '...'
##
args <- list(...)
chklogical(warn.deprecated)
##
missing.common <- missing(common)
common <- deprecated(common, missing.common, args, "comb.fixed",
warn.deprecated)
common <- deprecated(common, missing.common, args, "fixed",
warn.deprecated)
chklogical(common)
##
random <- deprecated(random, missing(random), args, "comb.random",
warn.deprecated)
chklogical(random)
##
x$common <- common
x$random <- random
##
##
## (3) Create dat.trts
##
##
dat.trts <- comptrts(x, upper, reference.group, baseline.reference,
order, sep.trts, quote.trts)
##
##
## (4) Change order of prop.direct.common and prop.direct.random
##
##
if (!(is.bin & method == "SIDDE")) {
prop.common <- sortprop(x$prop.direct.common, dat.trts, x$sep.trts)
prop.random <- sortprop(x$prop.direct.random, dat.trts, x$sep.trts)
}
else
prop.common <- prop.random <- NULL
##
##
## (5) Calculate / extract indirect estimates
##
##
x.direct.indirect <- x
##
if (method == "SIDDE") {
ind <- sidde(x.direct.indirect, sep.trts, verbose, warn, is.tictoc)
##
x.direct.indirect$TE.indirect.common <- ind$TE.indirect.common
x.direct.indirect$seTE.indirect.common <- ind$seTE.indirect.common
##
if (!is.bin) {
x.direct.indirect$TE.indirect.random <- ind$TE.indirect.random
x.direct.indirect$seTE.indirect.random <- ind$seTE.indirect.random
}
}
##
direct.indirect <- direct.indirect(x.direct.indirect, tol.direct)
##
##
## (6) Transform matrices to data frames
##
##
m2d.f <- mat2dat.split(direct.indirect, "common", dat.trts)
m2d.r <- mat2dat.split(direct.indirect, "random", dat.trts)
##
##
## (7) Return results
##
##
res <- list(comparison = dat.trts$comparison,
##
k = m2d.f$k,
##
prop.common = prop.common,
##
common = m2d.f$nma,
direct.common = m2d.f$direct,
indirect.common = m2d.f$indirect,
compare.common = m2d.f$compare,
##
prop.random = prop.random,
##
random = m2d.r$nma,
direct.random = m2d.r$direct,
indirect.random = m2d.r$indirect,
compare.random = m2d.r$compare,
##
predict = m2d.r$predict,
##
method = method,
##
sm = x$sm,
level.ma = x$level.ma,
##
prediction = x$prediction,
level.predict = x$level.predict,
tau = x$tau,
##
reference.group = reference.group,
baseline.reference = baseline.reference,
order = order,
sep.trts = sep.trts,
quote.trts = quote.trts,
nchar.trts = x$nchar.trts,
##
tol.direct = tol.direct,
backtransf = backtransf,
##
x = x,
##
version = packageDescription("netmeta")$Version
)
##
if (method == "SIDDE" & is.tictoc)
res$tictoc <- ind$tictoc
##
## Backward compatibility
##
res$prop.fixed <- res$prop.common
res$fixed <- res$common
res$direct.fixed <- res$direct.common
res$indirect.fixed <- res$indirect.common
res$compare.fixed <- res$compare.common
##
class(res) <-
c("netsplit",
if (is.bin & method == "SIDDE")
"netsplit.netmetabin")
res
}
#' @rdname netsplit
#' @method print netsplit
#' @export
print.netsplit <- function(x,
common = x$x$common,
random = x$x$random,
##
show = "all",
overall = TRUE,
ci = FALSE,
test = show %in% c("all", "with.direct", "both"),
only.reference = FALSE,
##
sortvar = NULL,
subset = NULL,
##
nchar.trts = x$nchar.trts,
##
digits = gs("digits"),
digits.stat = gs("digits.stat"),
digits.pval = gs("digits.pval"),
digits.prop = max(gs("digits.pval") - 2, 2),
##
text.NA = ".",
backtransf = x$backtransf,
scientific.pval = gs("scientific.pval"),
big.mark = gs("big.mark"),
legend = TRUE,
##
indent = TRUE,
warn.deprecated = gs("warn.deprecated"),
##
...) {
##
##
## (1) Check for netsplit object and upgrade object
##
##
chkclass(x, "netsplit")
x <- updateversion(x)
##
is.bin <- inherits(x, "netsplit.netmetabin")
##
## All individual results in a single row - be on the save side:
##
oldopts <- options(width = 200)
on.exit(options(oldopts))
##
##
## (2) Check other arguments
##
##
##
args <- list(...)
##
show <-
deprecated(show, missing(show), args, "showall")
if (is.logical(show))
if (show)
show <- "all"
else
show <- "both"
##
show <- setchar(show, c("all", "both", "with.direct",
"direct.only", "indirect.only",
"reference.only"))
##
if (show == "reference.only") {
warning("Argument 'show = \"reference.only\" replaced with ",
"'only.reference = TRUE'.",
call. = FALSE)
show <- "both"
if (missing.only.reference)
only.reference <- TRUE
}
##
chklogical(overall)
chklogical(ci)
chklogical(test)
##
missing.only.reference <- missing(only.reference)
if (!missing.only.reference)
chklogical(only.reference)
#
# Catch sortvar and subset from data:
#
mc <- match.call()
sfsp <- sys.frame(sys.parent())
#
error <- try(sortvar.x <- catch("sortvar", mc, x, sfsp), silent = TRUE)
if (!any(class(error) == "try-error"))
sortvar <- sortvar.x
##
if (!is.null(sortvar)) {
if (length(dim(sortvar)) == 2) {
if (dim(sortvar)[1] != length(x$comparison))
stop("Argument 'sortvar' must be of length ",
length(x$comparison), ".",
call. = FALSE)
##
## Set proportions to 0 or 1
##
if (is.numeric(sortvar)) {
sortvar[is.zero(abs(sortvar), n = 1000)] <- 0
sortvar[is.zero(1 - abs(sortvar), n = 1000)] <-
1 * sign(sortvar)[is.zero(1 - abs(sortvar), n = 1000)]
}
sortvar <- order(do.call(order, as.list(as.data.frame(sortvar))))
}
else
chklength(sortvar, length(x$comparison),
text = paste0("Argument 'sortvar' must be of length ",
length(x$comparison), "."))
##
if (!is.numeric(sortvar))
sortvar <- setchar(sortvar, x$comparison)
}
#
error <- try(subset.x <- catch("subset", mc, x, sfsp), silent = TRUE)
if (!any(class(error) == "try-error"))
subset <- subset.x
##
if (!is.null(subset)) {
chklength(subset, length(x$comparison),
text = paste0("Argument 'subset' must be of length ",
length(x$comparison), "."))
if (!is.logical(subset))
stop("Argument 'subset' must be a logical vector.")
}
##
if (is.null(nchar.trts))
nchar.trts <- 666
chknumeric(nchar.trts, length = 1)
##
chknumeric(digits, min = 0, length = 1)
chknumeric(digits.stat, min = 0, length = 1)
chknumeric(digits.pval, min = 1, length = 1)
chknumeric(digits.prop, min = 0, length = 1)
##
if (is.null(backtransf))
backtransf <- TRUE
chklogical(backtransf)
chklogical(scientific.pval)
chklogical(legend)
chklogical(indent)
##
## Check for deprecated arguments in '...'
##
fun <- "print.netmeta"
##
chklogical(warn.deprecated)
##
missing.common <- missing(common)
common <- deprecated(common, missing.common, args, "comb.fixed",
warn.deprecated)
common <- deprecated(common, missing.common, args, "fixed",
warn.deprecated)
chklogical(common)
common.logical <- common
##
random <- deprecated(random, missing(random), args, "comb.random",
warn.deprecated)
chklogical(random)
random.logical <- random
##
##
## (3) Some additional settings and checks
##
##
sm <- x$sm
sm.lab <- sm
##
relative <- is.relative.effect(sm)
##
if (!backtransf & relative)
sm.lab <- paste("log", sm, sep = "")
##
if (!(sm.lab == "" | sm.lab == "log"))
sm.lab <- paste("(", sm.lab, ") ", sep = "")
else
sm.lab <- ""
##
level.ma <- x$level.ma
ci.lab <- paste(100 * level.ma, "%-CI", sep ="")
##
random.available <- !is.null(x$random)
##
if (!random.available & random) {
warning("No results for random effects model available. ",
"Argument 'random' set to FALSE.",
call. = FALSE)
##
random <- FALSE
}
if (show == "all")
sel <- rep_len(TRUE, length(x$direct.common$TE))
else if (show == "with.direct")
sel <- !is.na(x$direct.common$TE)
else if (show == "both")
sel <- !is.na(x$direct.common$TE) & !is.na(x$indirect.common$TE)
else if (show == "direct.only")
sel <- !is.na(x$direct.common$TE) & is.na(x$indirect.common$TE)
else if (show == "indirect.only")
sel <- is.na(x$direct.common$TE) & !is.na(x$common$TE)
##
if (sum(sel) == 0) {
warning("No results for argument 'show = ", show, "'.",
call. = FALSE)
return(invisible(NULL))
}
##
if (only.reference) {
if (x$reference.group == "") {
warning("First treatment used as reference as argument ",
"'reference.group' was unspecified in netsplit().",
call. = FALSE)
x$reference.group <-
compsplit(x$comparison, x$sep.trts)[[1]][1]
}
##
sel.ref <-
apply(!is.na(sapply(compsplit(x$comparison, x$sep.trts),
match, x$reference.group)), 2, sum) >= 1
##
sel <- sel & sel.ref
}
##
comp <- x$comparison[sel]
##
k <- x$k[sel]
##
prop.common <- x$prop.common[sel]
##
TE.common <- x$common$TE[sel]
lower.common <- x$common$lower[sel]
upper.common <- x$common$upper[sel]
##
TE.direct.common <- x$direct.common$TE[sel]
lower.direct.common <- x$direct.common$lower[sel]
upper.direct.common <- x$direct.common$upper[sel]
##
TE.indirect.common <- x$indirect.common$TE[sel]
lower.indirect.common <- x$indirect.common$lower[sel]
upper.indirect.common <- x$indirect.common$upper[sel]
##
TE.compare.common <- x$compare.common$TE[sel]
lower.compare.common <- x$compare.common$lower[sel]
upper.compare.common <- x$compare.common$upper[sel]
statistic.compare.common <- x$compare.common$statistic[sel]
pval.compare.common <- x$compare.common$p[sel]
##
if (random.available) {
prop.random <- x$prop.random[sel]
##
TE.random <- x$random$TE[sel]
lower.random <- x$random$lower[sel]
upper.random <- x$random$upper[sel]
##
TE.direct.random <- x$direct.random$TE[sel]
lower.direct.random <- x$direct.random$lower[sel]
upper.direct.random <- x$direct.random$upper[sel]
##
TE.indirect.random <- x$indirect.random$TE[sel]
lower.indirect.random <- x$indirect.random$lower[sel]
upper.indirect.random <- x$indirect.random$upper[sel]
##
TE.compare.random <- x$compare.random$TE[sel]
lower.compare.random <- x$compare.random$lower[sel]
upper.compare.random <- x$compare.random$upper[sel]
statistic.compare.random <- x$compare.random$statistic[sel]
pval.compare.random <- x$compare.random$p[sel]
}
if (backtransf & relative) {
TE.common <- exp(TE.common)
lower.common <- exp(lower.common)
upper.common <- exp(upper.common)
##
TE.direct.common <- exp(TE.direct.common)
lower.direct.common <- exp(lower.direct.common)
upper.direct.common <- exp(upper.direct.common)
##
TE.indirect.common <- exp(TE.indirect.common)
lower.indirect.common <- exp(lower.indirect.common)
upper.indirect.common <- exp(upper.indirect.common)
##
TE.compare.common <- exp(TE.compare.common)
lower.compare.common <- exp(lower.compare.common)
upper.compare.common <- exp(upper.compare.common)
##
if (random.available) {
TE.random <- exp(TE.random)
lower.random <- exp(lower.random)
upper.random <- exp(upper.random)
##
TE.direct.random <- exp(TE.direct.random)
lower.direct.random <- exp(lower.direct.random)
upper.direct.random <- exp(upper.direct.random)
##
TE.indirect.random <- exp(TE.indirect.random)
lower.indirect.random <- exp(lower.indirect.random)
upper.indirect.random <- exp(upper.indirect.random)
##
TE.compare.random <- exp(TE.compare.random)
lower.compare.random <- exp(lower.compare.random)
upper.compare.random <- exp(upper.compare.random)
}
}
common <- list(comp = comp,
k = k,
prop = formatPT(prop.common, digits = digits.prop))
names.common <- c("comparison", "k", "prop")
##
if (overall) {
common$TE.common <- formatN(TE.common, digits, text.NA = text.NA,
big.mark = big.mark)
names.common <- c(names.common, "nma")
if (ci) {
common$ci.common <- formatCI(round(lower.common, digits),
round(upper.common, digits))
common$ci.common[is.na(common$ci.common)] <- text.NA
names.common <- c(names.common, ci.lab)
}
}
##
common$TE.direct.common <-
formatN(TE.direct.common, digits, text.NA = text.NA,
big.mark = big.mark)
names.common <- c(names.common, "direct")
if (ci) {
common$ci.direct.common <-
formatCI(round(lower.direct.common, digits),
round(upper.direct.common, digits))
common$ci.direct.common[is.na(common$ci.direct.common)] <- text.NA
names.common <- c(names.common, ci.lab)
}
##
common$TE.indirect.common <-
formatN(TE.indirect.common, digits,
text.NA = text.NA, big.mark = big.mark)
names.common <- c(names.common, "indir.")
##
if (ci) {
common$ci.indirect.common <-
formatCI(round(lower.indirect.common, digits),
round(upper.indirect.common, digits))
common$ci.indirect.common[is.na(common$ci.indirect.common)] <- text.NA
names.common <- c(names.common, ci.lab)
}
##
if (test) {
common$diff <- formatN(TE.compare.common, digits, text.NA = text.NA,
big.mark = big.mark)
names.common <-
c(names.common, if (backtransf & relative) "RoR" else "Diff")
if (ci) {
common$ci.diff <- formatCI(round(lower.compare.common, digits),
round(upper.compare.common, digits))
common$ci.diff[is.na(common$ci.diff)] <- text.NA
names.common <- c(names.common, ci.lab)
}
##
common$statistic <- formatN(statistic.compare.common, digits.stat,
big.mark = big.mark)
common$statistic[common$statistic == "--"] <- text.NA
common$p <- formatPT(pval.compare.common, digits = digits.pval,
scientific = scientific.pval)
common$p[rmSpace(common$p) == "--"] <- text.NA
names.common <- c(names.common, c("z", "p-value"))
}
common <- as.data.frame(common)
names(common) <- names.common
if (random.available) {
random <- list(comp = comp,
k = k,
prop = formatPT(prop.random, digits = digits.prop))
names.random <- c("comparison", "k", "prop")
##
if (overall) {
random$TE.random <- formatN(TE.random, digits, text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random, "nma")
if (ci) {
random$ci.random <- formatCI(round(lower.random, digits),
round(upper.random, digits))
random$ci.random[is.na(random$ci.random)] <- text.NA
names.random <- c(names.random, ci.lab)
}
}
##
random$TE.direct.random <- formatN(TE.direct.random, digits,
text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random, "direct")
if (ci) {
random$ci.direct.random <- formatCI(round(lower.direct.random, digits),
round(upper.direct.random, digits))
random$ci.direct.random[is.na(random$ci.direct.random)] <- text.NA
names.random <- c(names.random, ci.lab)
}
##
random$TE.indirect.random <- formatN(TE.indirect.random, digits,
text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random, "indir.")
if (ci) {
random$ci.indirect.random <-
formatCI(round(lower.indirect.random, digits),
round(upper.indirect.random, digits))
random$ci.indirect.random[is.na(random$ci.indirect.random)] <- text.NA
names.random <- c(names.random, ci.lab)
}
##
if (test) {
random$diff <- formatN(TE.compare.random, digits, text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random,
if (backtransf & relative) "RoR" else "Diff")
if (ci) {
random$ci.diff <- formatCI(round(lower.compare.random, digits),
round(upper.compare.random, digits))
random$ci.diff[is.na(random$ci.diff)] <- text.NA
names.random <- c(names.random, ci.lab)
}
##
random$statistic <- formatN(statistic.compare.random, digits.stat,
big.mark = big.mark)
random$statistic[random$statistic == "--"] <- text.NA
random$p <- formatPT(pval.compare.random, digits = digits.pval,
scientific = scientific.pval)
random$p[rmSpace(random$p) == "--"] <- text.NA
names.random <- c(names.random, c("z", "p-value"))
}
random <- as.data.frame(random)
names(random) <- names.random
}
## Do not print direct evidence proportion for node-splitting method
## or SIDDE
##
##
noprop <- is.bin | x$method == "SIDDE" | all(common$prop == "")
##
if (noprop) {
common <- common[, !(names(common) %in% "prop")]
if (random.available)
random <- random[, !(names(random) %in% "prop")]
}
if (!is.null(sortvar))
sortvar <- sortvar[sel]
#
if (!is.null(subset))
subset <- subset[sel]
#
if (!is.null(sortvar)) {
o <- order(sortvar)
#
if (common.logical)
common <- common[o, ]
if (random.logical)
random <- random[o, ]
#
if (!is.null(subset))
subset <- subset[o]
}
#
if (!is.null(subset)) {
if (common.logical)
common <- common[subset, ]
if (random.logical)
random <- random[subset, ]
}
if (common.logical | random.logical) {
if (x$method == "SIDDE")
cat("Separate indirect from direct design evidence (SIDDE)\n\n")
else
cat(paste("Separate indirect from direct evidence (SIDE)",
"using back-calculation method\n\n"))
}
else
legend <- FALSE
if (common.logical) {
cat("Common effects model: \n\n")
common[is.na(common)] <- text.NA
trts <- unique(sort(unlist(compsplit(common$comparison, x$sep.trts))))
common$comparison <- comps(common$comparison, trts, x$sep.trts, nchar.trts)
prmatrix(common, quote = FALSE, right = TRUE,
rowlab = rep("", dim(common)[1]))
if (random.logical)
cat("\n")
}
##
if (random.logical) {
cat("Random effects model: \n\n")
random[is.na(random)] <- text.NA
trts <- unique(sort(unlist(compsplit(random$comparison, x$sep.trts))))
random$comparison <- comps(random$comparison, trts, x$sep.trts, nchar.trts)
prmatrix(random, quote = FALSE, right = TRUE,
rowlab = rep("", dim(random)[1]))
}
##
if (legend) {
cat("\nLegend:\n")
cat(" comparison - Treatment comparison\n")
cat(paste0(" k", if (indent) " " else " ",
"- Number of studies providing direct evidence\n"))
if (!noprop)
cat(paste0(" prop", if (indent) " " else " ",
"- Direct evidence proportion\n"))
if (overall)
cat(paste0(" nma", if (indent) " " else " ",
"- Estimated treatment effect ", sm.lab,
"in network meta-analysis\n", sep = ""))
cat(paste0(" direct", if (indent) " " else " ",
"- Estimated treatment effect ", sm.lab,
"derived from direct evidence\n", sep = ""))
cat(paste0(" indir.", if (indent) " " else " ",
"- Estimated treatment effect ", sm.lab,
"derived from indirect evidence\n", sep = ""))
if (test) {
if (backtransf & relative)
cat(paste0(" RoR", if (indent) " " else " ",
"- Ratio of Ratios ",
"(direct versus indirect)\n"))
else
cat(paste0(" Diff", if (indent) " " else " ",
"- Difference between direct and ",
"indirect treatment estimates\n"))
##
cat(paste0(" z", if (indent) " " else " ",
"- z-value of test for disagreement ",
"(direct versus indirect)\n"))
cat(paste0(" p-value", if (indent) " " else " ",
"- p-value of test for disagreement ",
"(direct versus indirect)\n"))
}
##
## Add legend with abbreviated treatment labels
##
legendabbr(trts, treats(trts, nchar.trts), TRUE, header = "\n")
}
invisible(NULL)
}
Try the netmeta package in your browser
Any scripts or data that you put into this service are public.
netmeta documentation built on June 23, 2024, 9:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions print.netsplit netsplit
Documented in netsplit print.netsplit
#' Split direct and indirect evidence in network meta-analysis
#'
#' @description
#' Methods to split network estimates into the contribution of direct
#' and indirect evidence and to test for local inconsistency in
#' network meta-analysis.
#'
#' @aliases netsplit print.netsplit
#'
#' @param x An object of class \code{netmeta} or \code{netsplit}.
#' @param method A character string indicating which method to split
#' direct and indirect evidence is to be used. Either
#' \code{"Back-calculation"} or \code{"SIDDE"}, can be abbreviated.
#' See Details.
#' @param upper A logical indicating whether treatment comparisons
#' should be selected from the lower or upper triangle of the
#' treatment effect matrices (see list elements \code{TE.common} and
#' \code{TE.random} in the \code{netmeta} object). Ignored if
#' argument \code{order} is provided.
#' @param reference.group Reference treatment. Ignored if argument
#' \code{order} is provided.
#' @param baseline.reference A logical indicating whether results
#' should be expressed as comparisons of other treatments versus the
#' reference treatment or vice versa. This argument is only
#' considered if \code{reference.group} is not equal to \code{""}
#' and argument\code{order} is not provided.
#' @param order A optional character or numerical vector specifying
#' the order of treatments in comparisons.
#' @param sep.trts A character string used in comparison names as
#' separator between treatment labels, e.g., " vs ".
#' @param quote.trts A character used to print around treatment
#' labels.
#' @param tol.direct A numeric defining the maximum deviation of the
#' direct evidence proportion from 0 or 1 to classify a comparison
#' as providing only indirect or direct evidence, respectively.
#' @param common A logical indicating whether results for the common
#' effects network meta-analysis should be printed.
#' @param random A logical indicating whether results for the random
#' effects network meta-analysis should be printed.
#' @param show A character string indicating which comparisons should
#' be printed (see Details).
#' @param overall A logical indicating whether estimates from network
#' meta-analyis should be printed in addition to direct and indirect
#' estimates.
#' @param ci A logical indicating whether confidence intervals should
#' be printed in addition to treatment estimates.
#' @param test A logical indicating whether results of a test
#' comparing direct and indirect estimates should be printed.
#' @param only.reference A logical indicating whether only comparisons
#' with the reference group should be printed.
#' @param sortvar An optional vector used to sort comparisons (must be
#' of same length as the total number of comparisons).
#' @param subset An optional logical vector specifying a subset of
#' comparisons to print (must be of same length as the total number of
#' comparisons) .
#' @param nchar.trts A numeric defining the minimum number of
#' characters used to create unique treatment names.
#' @param digits Minimal number of significant digits, see
#' \code{print.default}.
#' @param digits.stat Minimal number of significant digits for z-value
#' of test of agreement between direct and indirect evidence, see
#' \code{print.default}.
#' @param digits.pval Minimal number of significant digits for p-value
#' of test of agreement between direct and indirect evidence, see
#' \code{print.default}.
#' @param digits.prop Minimal number of significant digits for direct
#' evidence proportions, see \code{print.default}.
#' @param text.NA A character string specifying text printed for
#' missing values.
#' @param backtransf A logical indicating whether printed results
#' should be back transformed. For example, if \code{backtransf =
#' TRUE}, results for \code{sm = "OR"} are printed as odds ratios
#' rather than log odds ratios.
#' @param scientific.pval A logical specifying whether p-values should
#' be printed in scientific notation, e.g., 1.2345e-01 instead of
#' 0.12345.
#' @param big.mark A character used as thousands separator.
#' @param legend A logical indicating whether a legend should be
#' printed.
#' @param indent A logical indicating whether items in the legend
#' should be indented.
#' @param warn A logical indicating whether warnings should be
#' printed.
#' @param warn.deprecated A logical indicating whether warnings should
#' be printed if deprecated arguments are used.
#' @param verbose A logical indicating whether progress information
#' should be printed.
#' @param \dots Additional arguments.
#'
#' @details
#' A comparison of direct and indirect treatment estimates can serve
#' as check for consistency of network meta-analysis (Dias et al.,
#' 2010).
#'
#' This function provides two methods to derive indirect estimates:
#' \itemize{
#' \item Separate Indirect from Direct Evidence (SIDE) using a
#' back-calculation method (\code{method = "Back-calculation"})
#' based on the \emph{direct evidence proportion} to calculate the
#' indirect evidence (König et al., 2013);
#' \item Separate Indirect from Direct Design Evidence (SIDDE) as
#' described in Efthimiou et al. (2019).
#' }
#'
#' Note, for the back-calculation method, indirect treatment estimates
#' are already calculated in \code{\link{netmeta}} and this function
#' combines and prints these estimates in a user-friendly
#' way. Furthermore, this method is not available for the
#' Mantel-Haenszel and non-central hypergeometric distribution
#' approach implemented in \code{\link{netmetabin}}.
#'
#' For the random-effects model, the direct treatment estimates are
#' based on the common between-study variance \eqn{\tau^2} from the
#' network meta-analysis, i.e. the square of list element
#' \code{x$tau}.
#'
#' Argument \code{show} determines which comparisons are printed:
#' \tabular{ll}{
#' \dQuote{all} \tab All comparisons \cr
#' \dQuote{both} \tab Only comparisons contributing both direct and
#' indirect evidence \cr
#' \dQuote{with.direct} \tab Comparisons providing direct evidence \cr
#' \dQuote{direct.only} \tab Comparisons providing only direct
#' evidence \cr
#' \dQuote{indirect.only} \tab Comparisons providing only indirect
#' evidence
#' }
#'
#' The node-splitting method and SIDDE can be compute-intensive in
#' large networks. Crude information on the computation progress is
#' printed if argument \code{verbose = TRUE}. In addition, computation
#' times are printed if R package \bold{tictoc} is installed.
#'
#' @return
#' An object of class \code{netsplit} with corresponding \code{print}
#' and \code{forest} functions. The object is a list containing the
#' following components:
#' \item{common, random}{As defined above.}
#' \item{comparison}{A vector with treatment comparisons.}
#' \item{prop.common, prop.random}{A vector with direct evidence
#' proportions (common / random effects model).}
#' \item{common, random}{Results of network meta-analysis (common /
#' random effects model), i.e., data frame with columns comparison,
#' TE, seTE, lower, upper, z, and p.}
#' \item{direct.common, direct.random}{Network meta-analysis results
#' based on direct evidence (common / random effects model), i.e.,
#' data frame with columns comparison, TE, seTE, lower, upper, z,
#' and p.}
#' \item{indirect.common, indirect.random}{Network meta-analysis
#' results based on indirect evidence (common / random effects
#' model), i.e., data frame with columns comparison, TE, seTE,
#' lower, upper, z, and p.}
#' \item{compare.common, compare.random}{Comparison of direct and
#' indirect evidence in network meta-analysis (common / random
#' effects model), i.e., data frame with columns comparison, TE,
#' seTE, lower, upper, z, and p.}
#' \item{sm}{A character string indicating underlying summary measure}
#' \item{level.ma}{The level used to calculate confidence intervals
#' for pooled estimates.}
#' \item{tictoc}{Computation times for node-splitting method or SIDDE
#' (if R package \bold{tictoc} is installed).}
#' \item{version}{Version of R package netmeta used to create object.}
#'
#' @author Guido Schwarzer \email{guido.schwarzer@@uniklinik-freiburg.de}, Gerta
#' Rücker \email{gerta.ruecker@@uniklinik-freiburg.de}, Orestis Efthimiou
#' \email{oremiou@@gmail.com}
#'
#' @seealso \code{\link{forest.netsplit}}, \code{\link{netmeta}},
#' \code{\link{netmetabin}}, \code{\link{netmeasures}}
#'
#' @references
#' Dias S, Welton NJ, Caldwell DM, Ades AE (2010):
#' Checking consistency in mixed treatment comparison meta-analysis.
#' \emph{Statistics in Medicine},
#' \bold{29}, 932--44
#'
#' Efthimiou O, Rücker G, Schwarzer G, Higgins J, Egger M, Salanti G
#' (2019):
#' A Mantel-Haenszel model for network meta-analysis of rare events.
#' \emph{Statistics in Medicine},
#' \bold{38}, 2992--3012
#'
#' König J, Krahn U, Binder H (2013):
#' Visualizing the flow of evidence in network meta-analysis and
#' characterizing mixed treatment comparisons.
#' \emph{Statistics in Medicine},
#' \bold{32}, 5414--29
#'
#' Puhan MA, Schünemann HJ, Murad MH, et al. (2014):
#' A GRADE working group approach for rating the quality of treatment
#' effect estimates from network meta-analysis.
#' \emph{British Medical Journal},
#' \bold{349}, g5630
#'
#' @examples
#' data(Woods2010)
#' #
#' p1 <- pairwise(treatment, event = r, n = N,
#' studlab = author, data = Woods2010, sm = "OR")
#' #
#' net1 <- netmeta(p1)
#' #
#' print(netsplit(net1), digits = 2)
#'
#' \dontrun{
#' print(netsplit(net1), digits = 2,
#' backtransf = FALSE, common = FALSE)
#'
#' # Sort by increasing number of studies in direct comparisons
#' print(netsplit(net1), digits = 2, sortvar = k)
#' # Sort by decreasing number of studies in direct comparisons
#' print(netsplit(net1), digits = 2, sortvar = -k)
#'
#' # Sort by increasing evidence proportion under common effects model
#' print(netsplit(net1), digits = 2, sortvar = prop.common)
#' # Sort by decreasing evidence proportion under common effects model
#' print(netsplit(net1), digits = 2, sortvar = -prop.common)
#'
#' # Sort by decreasing evidence proportion under common effects model
#' # and number of studies
#' print(netsplit(net1), digits = 2, sortvar = cbind(-prop.common, -k))
#'
#' data(Senn2013)
#' #
#' net2 <- netmeta(TE, seTE, treat1.long, treat2.long,
#' studlab, data = Senn2013)
#' #
#' print(netsplit(net2), digits = 2)
#' # Layout of Puhan et al. (2014), Table 1
#' print(netsplit(net2), digits = 2, ci = TRUE, test = FALSE)
#'
#' data(Dong2013)
#' p3 <- pairwise(treatment, death, randomized, studlab = id,
#' data = Dong2013, sm = "OR")
#' net3 <- netmetabin(p3)
#' netsplit(net3)
#' }
#'
#' @rdname netsplit
#' @export netsplit
netsplit <- function(x, method,
upper = TRUE,
reference.group = x$reference.group,
baseline.reference = x$baseline.reference,
order = NULL,
sep.trts = x$sep.trts, quote.trts = "",
tol.direct = 0.0005,
common = x$common,
random = x$random,
backtransf = x$backtransf,
warn = FALSE, warn.deprecated = gs("warn.deprecated"),
verbose = FALSE,
...) {
##
##
## (1) Check for netmeta object and upgrade object
##
##
chkclass(x, "netmeta")
x <- updateversion(x)
##
is.bin <- inherits(x, "netmetabin")
##
is.tictoc <- is.installed.package("tictoc", stop = FALSE)
##
##
## (2) Check other arguments
##
##
if (!missing(method))
method <- setchar(method, c("Back-calculation", "SIDDE"))
else {
if (is.bin)
method <- "SIDDE"
else
method <- "Back-calculation"
}
##
chklogical(upper)
chklogical(baseline.reference)
##
if (!is.null(order)) {
order <- setseq(order, x$trts)
baseline.reference <- FALSE
reference.group <- ""
}
##
chkchar(sep.trts)
chkchar(quote.trts)
chknumeric(tol.direct, min = 0, length = 1)
if (!is.null(backtransf))
chklogical(backtransf)
chklogical(warn)
chklogical(verbose)
##
## Check for deprecated arguments in '...'
##
args <- list(...)
chklogical(warn.deprecated)
##
missing.common <- missing(common)
common <- deprecated(common, missing.common, args, "comb.fixed",
warn.deprecated)
common <- deprecated(common, missing.common, args, "fixed",
warn.deprecated)
chklogical(common)
##
random <- deprecated(random, missing(random), args, "comb.random",
warn.deprecated)
chklogical(random)
##
x$common <- common
x$random <- random
##
##
## (3) Create dat.trts
##
##
dat.trts <- comptrts(x, upper, reference.group, baseline.reference,
order, sep.trts, quote.trts)
##
##
## (4) Change order of prop.direct.common and prop.direct.random
##
##
if (!(is.bin & method == "SIDDE")) {
prop.common <- sortprop(x$prop.direct.common, dat.trts, x$sep.trts)
prop.random <- sortprop(x$prop.direct.random, dat.trts, x$sep.trts)
}
else
prop.common <- prop.random <- NULL
##
##
## (5) Calculate / extract indirect estimates
##
##
x.direct.indirect <- x
##
if (method == "SIDDE") {
ind <- sidde(x.direct.indirect, sep.trts, verbose, warn, is.tictoc)
##
x.direct.indirect$TE.indirect.common <- ind$TE.indirect.common
x.direct.indirect$seTE.indirect.common <- ind$seTE.indirect.common
##
if (!is.bin) {
x.direct.indirect$TE.indirect.random <- ind$TE.indirect.random
x.direct.indirect$seTE.indirect.random <- ind$seTE.indirect.random
}
}
##
direct.indirect <- direct.indirect(x.direct.indirect, tol.direct)
##
##
## (6) Transform matrices to data frames
##
##
m2d.f <- mat2dat.split(direct.indirect, "common", dat.trts)
m2d.r <- mat2dat.split(direct.indirect, "random", dat.trts)
##
##
## (7) Return results
##
##
res <- list(comparison = dat.trts$comparison,
##
k = m2d.f$k,
##
prop.common = prop.common,
##
common = m2d.f$nma,
direct.common = m2d.f$direct,
indirect.common = m2d.f$indirect,
compare.common = m2d.f$compare,
##
prop.random = prop.random,
##
random = m2d.r$nma,
direct.random = m2d.r$direct,
indirect.random = m2d.r$indirect,
compare.random = m2d.r$compare,
##
predict = m2d.r$predict,
##
method = method,
##
sm = x$sm,
level.ma = x$level.ma,
##
prediction = x$prediction,
level.predict = x$level.predict,
tau = x$tau,
##
reference.group = reference.group,
baseline.reference = baseline.reference,
order = order,
sep.trts = sep.trts,
quote.trts = quote.trts,
nchar.trts = x$nchar.trts,
##
tol.direct = tol.direct,
backtransf = backtransf,
##
x = x,
##
version = packageDescription("netmeta")$Version
)
##
if (method == "SIDDE" & is.tictoc)
res$tictoc <- ind$tictoc
##
## Backward compatibility
##
res$prop.fixed <- res$prop.common
res$fixed <- res$common
res$direct.fixed <- res$direct.common
res$indirect.fixed <- res$indirect.common
res$compare.fixed <- res$compare.common
##
class(res) <-
c("netsplit",
if (is.bin & method == "SIDDE")
"netsplit.netmetabin")
res
}
#' @rdname netsplit
#' @method print netsplit
#' @export
print.netsplit <- function(x,
common = x$x$common,
random = x$x$random,
##
show = "all",
overall = TRUE,
ci = FALSE,
test = show %in% c("all", "with.direct", "both"),
only.reference = FALSE,
##
sortvar = NULL,
subset = NULL,
##
nchar.trts = x$nchar.trts,
##
digits = gs("digits"),
digits.stat = gs("digits.stat"),
digits.pval = gs("digits.pval"),
digits.prop = max(gs("digits.pval") - 2, 2),
##
text.NA = ".",
backtransf = x$backtransf,
scientific.pval = gs("scientific.pval"),
big.mark = gs("big.mark"),
legend = TRUE,
##
indent = TRUE,
warn.deprecated = gs("warn.deprecated"),
##
...) {
##
##
## (1) Check for netsplit object and upgrade object
##
##
chkclass(x, "netsplit")
x <- updateversion(x)
##
is.bin <- inherits(x, "netsplit.netmetabin")
##
## All individual results in a single row - be on the save side:
##
oldopts <- options(width = 200)
on.exit(options(oldopts))
##
##
## (2) Check other arguments
##
##
##
args <- list(...)
##
show <-
deprecated(show, missing(show), args, "showall")
if (is.logical(show))
if (show)
show <- "all"
else
show <- "both"
##
show <- setchar(show, c("all", "both", "with.direct",
"direct.only", "indirect.only",
"reference.only"))
##
if (show == "reference.only") {
warning("Argument 'show = \"reference.only\" replaced with ",
"'only.reference = TRUE'.",
call. = FALSE)
show <- "both"
if (missing.only.reference)
only.reference <- TRUE
}
##
chklogical(overall)
chklogical(ci)
chklogical(test)
##
missing.only.reference <- missing(only.reference)
if (!missing.only.reference)
chklogical(only.reference)
#
# Catch sortvar and subset from data:
#
mc <- match.call()
sfsp <- sys.frame(sys.parent())
#
error <- try(sortvar.x <- catch("sortvar", mc, x, sfsp), silent = TRUE)
if (!any(class(error) == "try-error"))
sortvar <- sortvar.x
##
if (!is.null(sortvar)) {
if (length(dim(sortvar)) == 2) {
if (dim(sortvar)[1] != length(x$comparison))
stop("Argument 'sortvar' must be of length ",
length(x$comparison), ".",
call. = FALSE)
##
## Set proportions to 0 or 1
##
if (is.numeric(sortvar)) {
sortvar[is.zero(abs(sortvar), n = 1000)] <- 0
sortvar[is.zero(1 - abs(sortvar), n = 1000)] <-
1 * sign(sortvar)[is.zero(1 - abs(sortvar), n = 1000)]
}
sortvar <- order(do.call(order, as.list(as.data.frame(sortvar))))
}
else
chklength(sortvar, length(x$comparison),
text = paste0("Argument 'sortvar' must be of length ",
length(x$comparison), "."))
##
if (!is.numeric(sortvar))
sortvar <- setchar(sortvar, x$comparison)
}
#
error <- try(subset.x <- catch("subset", mc, x, sfsp), silent = TRUE)
if (!any(class(error) == "try-error"))
subset <- subset.x
##
if (!is.null(subset)) {
chklength(subset, length(x$comparison),
text = paste0("Argument 'subset' must be of length ",
length(x$comparison), "."))
if (!is.logical(subset))
stop("Argument 'subset' must be a logical vector.")
}
##
if (is.null(nchar.trts))
nchar.trts <- 666
chknumeric(nchar.trts, length = 1)
##
chknumeric(digits, min = 0, length = 1)
chknumeric(digits.stat, min = 0, length = 1)
chknumeric(digits.pval, min = 1, length = 1)
chknumeric(digits.prop, min = 0, length = 1)
##
if (is.null(backtransf))
backtransf <- TRUE
chklogical(backtransf)
chklogical(scientific.pval)
chklogical(legend)
chklogical(indent)
##
## Check for deprecated arguments in '...'
##
fun <- "print.netmeta"
##
chklogical(warn.deprecated)
##
missing.common <- missing(common)
common <- deprecated(common, missing.common, args, "comb.fixed",
warn.deprecated)
common <- deprecated(common, missing.common, args, "fixed",
warn.deprecated)
chklogical(common)
common.logical <- common
##
random <- deprecated(random, missing(random), args, "comb.random",
warn.deprecated)
chklogical(random)
random.logical <- random
##
##
## (3) Some additional settings and checks
##
##
sm <- x$sm
sm.lab <- sm
##
relative <- is.relative.effect(sm)
##
if (!backtransf & relative)
sm.lab <- paste("log", sm, sep = "")
##
if (!(sm.lab == "" | sm.lab == "log"))
sm.lab <- paste("(", sm.lab, ") ", sep = "")
else
sm.lab <- ""
##
level.ma <- x$level.ma
ci.lab <- paste(100 * level.ma, "%-CI", sep ="")
##
random.available <- !is.null(x$random)
##
if (!random.available & random) {
warning("No results for random effects model available. ",
"Argument 'random' set to FALSE.",
call. = FALSE)
##
random <- FALSE
}
if (show == "all")
sel <- rep_len(TRUE, length(x$direct.common$TE))
else if (show == "with.direct")
sel <- !is.na(x$direct.common$TE)
else if (show == "both")
sel <- !is.na(x$direct.common$TE) & !is.na(x$indirect.common$TE)
else if (show == "direct.only")
sel <- !is.na(x$direct.common$TE) & is.na(x$indirect.common$TE)
else if (show == "indirect.only")
sel <- is.na(x$direct.common$TE) & !is.na(x$common$TE)
##
if (sum(sel) == 0) {
warning("No results for argument 'show = ", show, "'.",
call. = FALSE)
return(invisible(NULL))
}
##
if (only.reference) {
if (x$reference.group == "") {
warning("First treatment used as reference as argument ",
"'reference.group' was unspecified in netsplit().",
call. = FALSE)
x$reference.group <-
compsplit(x$comparison, x$sep.trts)[[1]][1]
}
##
sel.ref <-
apply(!is.na(sapply(compsplit(x$comparison, x$sep.trts),
match, x$reference.group)), 2, sum) >= 1
##
sel <- sel & sel.ref
}
##
comp <- x$comparison[sel]
##
k <- x$k[sel]
##
prop.common <- x$prop.common[sel]
##
TE.common <- x$common$TE[sel]
lower.common <- x$common$lower[sel]
upper.common <- x$common$upper[sel]
##
TE.direct.common <- x$direct.common$TE[sel]
lower.direct.common <- x$direct.common$lower[sel]
upper.direct.common <- x$direct.common$upper[sel]
##
TE.indirect.common <- x$indirect.common$TE[sel]
lower.indirect.common <- x$indirect.common$lower[sel]
upper.indirect.common <- x$indirect.common$upper[sel]
##
TE.compare.common <- x$compare.common$TE[sel]
lower.compare.common <- x$compare.common$lower[sel]
upper.compare.common <- x$compare.common$upper[sel]
statistic.compare.common <- x$compare.common$statistic[sel]
pval.compare.common <- x$compare.common$p[sel]
##
if (random.available) {
prop.random <- x$prop.random[sel]
##
TE.random <- x$random$TE[sel]
lower.random <- x$random$lower[sel]
upper.random <- x$random$upper[sel]
##
TE.direct.random <- x$direct.random$TE[sel]
lower.direct.random <- x$direct.random$lower[sel]
upper.direct.random <- x$direct.random$upper[sel]
##
TE.indirect.random <- x$indirect.random$TE[sel]
lower.indirect.random <- x$indirect.random$lower[sel]
upper.indirect.random <- x$indirect.random$upper[sel]
##
TE.compare.random <- x$compare.random$TE[sel]
lower.compare.random <- x$compare.random$lower[sel]
upper.compare.random <- x$compare.random$upper[sel]
statistic.compare.random <- x$compare.random$statistic[sel]
pval.compare.random <- x$compare.random$p[sel]
}
if (backtransf & relative) {
TE.common <- exp(TE.common)
lower.common <- exp(lower.common)
upper.common <- exp(upper.common)
##
TE.direct.common <- exp(TE.direct.common)
lower.direct.common <- exp(lower.direct.common)
upper.direct.common <- exp(upper.direct.common)
##
TE.indirect.common <- exp(TE.indirect.common)
lower.indirect.common <- exp(lower.indirect.common)
upper.indirect.common <- exp(upper.indirect.common)
##
TE.compare.common <- exp(TE.compare.common)
lower.compare.common <- exp(lower.compare.common)
upper.compare.common <- exp(upper.compare.common)
##
if (random.available) {
TE.random <- exp(TE.random)
lower.random <- exp(lower.random)
upper.random <- exp(upper.random)
##
TE.direct.random <- exp(TE.direct.random)
lower.direct.random <- exp(lower.direct.random)
upper.direct.random <- exp(upper.direct.random)
##
TE.indirect.random <- exp(TE.indirect.random)
lower.indirect.random <- exp(lower.indirect.random)
upper.indirect.random <- exp(upper.indirect.random)
##
TE.compare.random <- exp(TE.compare.random)
lower.compare.random <- exp(lower.compare.random)
upper.compare.random <- exp(upper.compare.random)
}
}
common <- list(comp = comp,
k = k,
prop = formatPT(prop.common, digits = digits.prop))
names.common <- c("comparison", "k", "prop")
##
if (overall) {
common$TE.common <- formatN(TE.common, digits, text.NA = text.NA,
big.mark = big.mark)
names.common <- c(names.common, "nma")
if (ci) {
common$ci.common <- formatCI(round(lower.common, digits),
round(upper.common, digits))
common$ci.common[is.na(common$ci.common)] <- text.NA
names.common <- c(names.common, ci.lab)
}
}
##
common$TE.direct.common <-
formatN(TE.direct.common, digits, text.NA = text.NA,
big.mark = big.mark)
names.common <- c(names.common, "direct")
if (ci) {
common$ci.direct.common <-
formatCI(round(lower.direct.common, digits),
round(upper.direct.common, digits))
common$ci.direct.common[is.na(common$ci.direct.common)] <- text.NA
names.common <- c(names.common, ci.lab)
}
##
common$TE.indirect.common <-
formatN(TE.indirect.common, digits,
text.NA = text.NA, big.mark = big.mark)
names.common <- c(names.common, "indir.")
##
if (ci) {
common$ci.indirect.common <-
formatCI(round(lower.indirect.common, digits),
round(upper.indirect.common, digits))
common$ci.indirect.common[is.na(common$ci.indirect.common)] <- text.NA
names.common <- c(names.common, ci.lab)
}
##
if (test) {
common$diff <- formatN(TE.compare.common, digits, text.NA = text.NA,
big.mark = big.mark)
names.common <-
c(names.common, if (backtransf & relative) "RoR" else "Diff")
if (ci) {
common$ci.diff <- formatCI(round(lower.compare.common, digits),
round(upper.compare.common, digits))
common$ci.diff[is.na(common$ci.diff)] <- text.NA
names.common <- c(names.common, ci.lab)
}
##
common$statistic <- formatN(statistic.compare.common, digits.stat,
big.mark = big.mark)
common$statistic[common$statistic == "--"] <- text.NA
common$p <- formatPT(pval.compare.common, digits = digits.pval,
scientific = scientific.pval)
common$p[rmSpace(common$p) == "--"] <- text.NA
names.common <- c(names.common, c("z", "p-value"))
}
common <- as.data.frame(common)
names(common) <- names.common
if (random.available) {
random <- list(comp = comp,
k = k,
prop = formatPT(prop.random, digits = digits.prop))
names.random <- c("comparison", "k", "prop")
##
if (overall) {
random$TE.random <- formatN(TE.random, digits, text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random, "nma")
if (ci) {
random$ci.random <- formatCI(round(lower.random, digits),
round(upper.random, digits))
random$ci.random[is.na(random$ci.random)] <- text.NA
names.random <- c(names.random, ci.lab)
}
}
##
random$TE.direct.random <- formatN(TE.direct.random, digits,
text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random, "direct")
if (ci) {
random$ci.direct.random <- formatCI(round(lower.direct.random, digits),
round(upper.direct.random, digits))
random$ci.direct.random[is.na(random$ci.direct.random)] <- text.NA
names.random <- c(names.random, ci.lab)
}
##
random$TE.indirect.random <- formatN(TE.indirect.random, digits,
text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random, "indir.")
if (ci) {
random$ci.indirect.random <-
formatCI(round(lower.indirect.random, digits),
round(upper.indirect.random, digits))
random$ci.indirect.random[is.na(random$ci.indirect.random)] <- text.NA
names.random <- c(names.random, ci.lab)
}
##
if (test) {
random$diff <- formatN(TE.compare.random, digits, text.NA = text.NA,
big.mark = big.mark)
names.random <- c(names.random,
if (backtransf & relative) "RoR" else "Diff")
if (ci) {
random$ci.diff <- formatCI(round(lower.compare.random, digits),
round(upper.compare.random, digits))
random$ci.diff[is.na(random$ci.diff)] <- text.NA
names.random <- c(names.random, ci.lab)
}
##
random$statistic <- formatN(statistic.compare.random, digits.stat,
big.mark = big.mark)
random$statistic[random$statistic == "--"] <- text.NA
random$p <- formatPT(pval.compare.random, digits = digits.pval,
scientific = scientific.pval)
random$p[rmSpace(random$p) == "--"] <- text.NA
names.random <- c(names.random, c("z", "p-value"))
}
random <- as.data.frame(random)
names(random) <- names.random
}
## Do not print direct evidence proportion for node-splitting method
## or SIDDE
##
##
noprop <- is.bin | x$method == "SIDDE" | all(common$prop == "")
##
if (noprop) {
common <- common[, !(names(common) %in% "prop")]
if (random.available)
random <- random[, !(names(random) %in% "prop")]
}
if (!is.null(sortvar))
sortvar <- sortvar[sel]
#
if (!is.null(subset))
subset <- subset[sel]
#
if (!is.null(sortvar)) {
o <- order(sortvar)
#
if (common.logical)
common <- common[o, ]
if (random.logical)
random <- random[o, ]
#
if (!is.null(subset))
subset <- subset[o]
}
#
if (!is.null(subset)) {
if (common.logical)
common <- common[subset, ]
if (random.logical)
random <- random[subset, ]
}
if (common.logical | random.logical) {
if (x$method == "SIDDE")
cat("Separate indirect from direct design evidence (SIDDE)\n\n")
else
cat(paste("Separate indirect from direct evidence (SIDE)",
"using back-calculation method\n\n"))
}
else
legend <- FALSE
if (common.logical) {
cat("Common effects model: \n\n")
common[is.na(common)] <- text.NA
trts <- unique(sort(unlist(compsplit(common$comparison, x$sep.trts))))
common$comparison <- comps(common$comparison, trts, x$sep.trts, nchar.trts)
prmatrix(common, quote = FALSE, right = TRUE,
rowlab = rep("", dim(common)[1]))
if (random.logical)
cat("\n")
}
##
if (random.logical) {
cat("Random effects model: \n\n")
random[is.na(random)] <- text.NA
trts <- unique(sort(unlist(compsplit(random$comparison, x$sep.trts))))
random$comparison <- comps(random$comparison, trts, x$sep.trts, nchar.trts)
prmatrix(random, quote = FALSE, right = TRUE,
rowlab = rep("", dim(random)[1]))
}
##
if (legend) {
cat("\nLegend:\n")
cat(" comparison - Treatment comparison\n")
cat(paste0(" k", if (indent) " " else " ",
"- Number of studies providing direct evidence\n"))
if (!noprop)
cat(paste0(" prop", if (indent) " " else " ",
"- Direct evidence proportion\n"))
if (overall)
cat(paste0(" nma", if (indent) " " else " ",
"- Estimated treatment effect ", sm.lab,
"in network meta-analysis\n", sep = ""))
cat(paste0(" direct", if (indent) " " else " ",
"- Estimated treatment effect ", sm.lab,
"derived from direct evidence\n", sep = ""))
cat(paste0(" indir.", if (indent) " " else " ",
"- Estimated treatment effect ", sm.lab,
"derived from indirect evidence\n", sep = ""))
if (test) {
if (backtransf & relative)
cat(paste0(" RoR", if (indent) " " else " ",
"- Ratio of Ratios ",
"(direct versus indirect)\n"))
else
cat(paste0(" Diff", if (indent) " " else " ",
"- Difference between direct and ",
"indirect treatment estimates\n"))
##
cat(paste0(" z", if (indent) " " else " ",
"- z-value of test for disagreement ",
"(direct versus indirect)\n"))
cat(paste0(" p-value", if (indent) " " else " ",
"- p-value of test for disagreement ",
"(direct versus indirect)\n"))
}
##
## Add legend with abbreviated treatment labels
##
legendabbr(trts, treats(trts, nchar.trts), TRUE, header = "\n")
}
invisible(NULL)
}
Try the netmeta package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.