R/netconnection.R

Defines functions netconnection print.netconnection netconnection.pairwise netconnection.default

Documented in netconnection netconnection.default netconnection.pairwise print.netconnection

#' Get information on network connectivity (number of subnetworks,
#' distance matrix)
#' 
#' @description
#' To determine the network structure and to test whether a given
#' network is fully connected. Network information is provided as a
#' triple of vectors \code{treat1}, \code{treat2}, and \code{studlab}
#' where each row corresponds to an existing pairwise treatment
#' comparison (\code{treat1}, \code{treat2}) in a study
#' (\code{studlab}). The function calculates the number of subnetworks
#' (connectivity components; value of 1 corresponds to a fully
#' connected network) and the distance matrix (in block-diagonal form
#' in the case of subnetworks). If some treatments are combinations of
#' other treatments or have common components, an analysis based on
#' the additive network meta-analysis model might be possible, see
#' \link{discomb} function.
#' 
#' @aliases netconnection netconnection.default print.netconnection
#' 
#' @param data A data frame, e.g., created with
#'   \code{\link{pairwise}}.
#' @param treat1 Label / number for first treatment (ignored if
#'   \code{data} was created with \code{\link{pairwise}}).
#' @param treat2 Label / number for second treatment (ignored if
#'   \code{data} was created with \code{\link{pairwise}}).
#' @param studlab Study labels (ignored if \code{data} was created
#'   with \code{\link{pairwise}}).
#' @param subset An optional vector specifying a subset of studies to
#'   be used.
#' @param title Title of meta-analysis / systematic review.
#' @param sep.trts A character used in comparison names as separator
#'   between treatment labels.
#' @param nchar.trts A numeric defining the minimum number of
#'   characters used to create unique treatment names.
#' @param warn A logical indicating whether warnings should be
#'   printed.
#' @param x An object of class \code{netconnection}.
#' @param digits Minimal number of significant digits, see
#'   \code{\link{print.default}}.
#' @param details A logical indicating whether to print the distance
#'   matrix.
#' @param details.disconnected A logical indicating whether to print
#'   more details for disconnected networks.
#' @param \dots Additional arguments (ignored at the moment)
#' 
#' @return
#' An object of class \code{netconnection} with corresponding
#' \code{print} function. The object is a list containing the
#' following components:
#' \item{treat1, treat2, studlab, title, warn, nchar.trts}{As defined
#'   above.}
#' \item{k}{Total number of studies.}
#' \item{m}{Total number of pairwise comparisons.}
#' \item{n}{Total number of treatments.}
#' \item{n.subnets}{Number of subnetworks; equal to 1 for a fully
#'   connected network.}
#' \item{D.matrix}{Distance matrix.}
#' \item{A.matrix}{Adjacency matrix.}
#' \item{L.matrix}{Laplace matrix.}
#' \item{call}{Function call.}
#' \item{version}{Version of R package netmeta used to create object.}
#' 
#' @author Gerta Rücker \email{gerta.ruecker@@uniklinik-freiburg.de}, Guido
#'   Schwarzer \email{guido.schwarzer@@uniklinik-freiburg.de}
#' 
#' @seealso \code{\link{netmeta}}, \code{\link{netdistance}},
#'   \code{\link{discomb}}
#' 
#' @examples
#' data(Senn2013)
#' 
#' nc1 <- netconnection(treat1, treat2, studlab, data = Senn2013)
#' nc1
#' 
#' # Extract number of (sub)networks
#' #
#' nc1$n.subnets
#' 
#' # Extract distance matrix
#' #
#' nc1$D.matrix
#'
#' \dontrun{
#' # Conduct network meta-analysis (results not shown)
#' #
#' net1 <- netmeta(TE, seTE, treat1, treat2, studlab, data = Senn2013)
#' 
#' # Artificial example with two subnetworks
#' #
#' t1 <- c("G", "B", "B", "D", "A", "F")
#' t2 <- c("B", "C", "E", "E", "H", "A")
#' #
#' nc2 <- netconnection(t1, t2)
#' print(nc2, details = TRUE)
#' 
#' # Number of subnetworks
#' #
#' nc2$n.subnets
#' 
#' # Extract distance matrix
#' #
#' nc2$D.matrix
#' 
#' # Conduct network meta-analysis (results in an error message due to
#' # unconnected network)
#' try(net2 <- netmeta(1:6, 1:6, t1, t2, 1:6))
#' 
#' # Conduct network meta-analysis on first subnetwork
#' #
#' net2.1 <- netmeta(1:6, 1:6, t1, t2, 1:6, subset = nc2$subnet == 1)
#' 
#' # Conduct network meta-analysis on second subnetwork
#' #
#' net2.2 <- netmeta(1:6, 1:6, t1, t2, 1:6, subset = nc2$subnet == 2)
#' 
#' net2.1
#' net2.2
#' }  
#' 
#' @rdname netconnection
#' @method netconnection default
#' @export


netconnection.default <- function(data = NULL, treat1, treat2, studlab = NULL,
                                  subset = NULL,
                                  sep.trts = ":",
                                  nchar.trts = 666,
                                  title = "", details.disconnected = FALSE,
                                  warn = FALSE, ...) {
  
  ##
  ##
  ## (1) Check arguments
  ##
  ##
  
  nulldata <- is.null(data)
  sfsp <- sys.frame(sys.parent())
  mc <- match.call()
  ##
  ## Catch treat1
  ##
  if (!nulldata & !is.data.frame(data)) {
    if (!missing(treat1) & !missing(treat2) & !missing(studlab))
      stop("Argument 'data' must be a data frame.")
    else if (!missing(treat1) & !missing(treat2)) {
      treat1 <- catch("data", mc, sfsp, sfsp)
      treat2 <- catch("treat1", mc, sfsp, sfsp)
      studlab <- catch("treat2", mc, sfsp, sfsp)
    }
    else if (!missing(treat1)) {
      treat1 <- catch("data", mc, sfsp, sfsp)
      treat2 <- catch("treat1", mc, sfsp, sfsp)
    }
  }
  else {
    ##
    if (nulldata)
      data <- sfsp
    ##
    treat1 <- catch("treat1", mc, data, sfsp)
    treat2 <- catch("treat2", mc, data, sfsp)
    studlab <- catch("studlab", mc, data, sfsp)
    subset <- catch("subset", mc, data, sfsp)
  }
  ##
  if (length(studlab) != 0)
    studlab <- as.character(studlab)
  else {
    if (warn)
      warning("No information given for argument 'studlab'. ",
              "Assuming that comparisons are from independent studies.")
    studlab <- as.character(seq_along(treat1))
  }
  ##
  chknumeric(nchar.trts, min = 1, length = 1)
  ##
  chklogical(details.disconnected)
  chklogical(warn)
  
  
  ##
  ##
  ## (2) Check length of essential variables
  ##
  ##
  
  fun <- "netconnection"
  ##
  k.All <- length(treat1)
  ##
  missing.subset <- is.null(subset)
  ##
  chklength(treat2, k.All, fun,
                   text = paste0("Arguments 'treat1' and 'treat2' ",
                                 "must have the same length."))
  chklength(studlab, k.All, fun,
                   text = paste0("Arguments 'treat1' and 'studlab' ",
                                 "must have the same length."))
  ##
  if (is.factor(treat1))
    treat1 <- as.character(treat1)
  if (is.factor(treat2))
    treat2 <- as.character(treat2)
  
  
  ##
  ##
  ## (3) Use subset for analysis
  ##
  ##
  
  if (!missing.subset) {
    if ((is.logical(subset) & (sum(subset) > k.All)) ||
        (length(subset) > k.All))
      stop("Length of subset is larger than number of studies.")
    ##
    treat1 <- treat1[subset]
    treat2 <- treat2[subset]
    studlab <- studlab[subset]
  }
  
  
  ##
  ##
  ## (4) Additional checks
  ##
  ##
  
  if (any(treat1 == treat2))
    stop("Treatments must be different (arguments 'treat1' and 'treat2').")
  ##
  ## Check for correct number of comparisons
  ##
  tabnarms <- table(studlab)
  sel.narms <- !is.wholenumber((1 + sqrt(8 * tabnarms + 1)) / 2)
  ##
  if (sum(sel.narms) == 1)
    stop("Study '", names(tabnarms)[sel.narms],
         "' has a wrong number of comparisons.",
         "\n  Please provide data for all treatment comparisons ",
         "(two-arm: 1; three-arm: 3; four-arm: 6, ...).")
  if (sum(sel.narms) > 1)
    stop("The following studies have a wrong number of comparisons: ",
         paste(paste0("'", names(tabnarms)[sel.narms], "'"),
               collapse = ", "),
         "\n  Please provide data for all treatment comparisons ",
         "(two-arm: 1; three-arm: 3; four-arm: 6, ...).")
  ##
  labels <- sort(unique(c(treat1, treat2)))
  ##
  if (compmatch(labels, sep.trts)) {
    if (!missing(sep.trts))
      warning("Separator '", sep.trts,
              "' used in at least one treatment label. ",
              "Try to use predefined separators: ",
              "':', '-', '_', '/', '+', '.', '|', '*'.",
              call. = FALSE)
    ##
    if (!compmatch(labels, ":"))
      sep.trts <- ":"
    else if (!compmatch(labels, "-"))
      sep.trts <- "-"
    else if (!compmatch(labels, "_"))
      sep.trts <- "_"
    else if (!compmatch(labels, "/"))
      sep.trts <- "/"
    else if (!compmatch(labels, "+"))
      sep.trts <- "+"
    else if (!compmatch(labels, "."))
      sep.trts <- "-"
    else if (!compmatch(labels, "|"))
      sep.trts <- "|"
    else if (!compmatch(labels, "*"))
      sep.trts <- "*"
    else
      stop("All predefined separators (':', '-', '_', '/', '+', ",
           "'.', '|', '*') are used in at least one treatment label.",
           "\n   Please specify a different character that should be ",
           "used as separator (argument 'sep.trts').",
           call. = FALSE)
  }
  
  
  ##
  ##
  ## (5) Determine (sub)network(s)
  ##
  ##
  
  treats <- as.factor(c(as.character(treat1), as.character(treat2)))
  trts <- levels(treats)
  ##
  n <- length(trts)   # Number of treatments
  m <- length(treat1) # Number of comparisons
  ##
  ## Edge-vertex incidence matrix
  ##
  treat1.pos <- treats[1:m]
  treat2.pos <- treats[(m + 1):(2 * m)]
  B <- createB(treat1.pos, treat2.pos, ncol = n)
  ##
  rownames(B) <- studlab
  colnames(B) <- trts
  ##
  L.mult <- t(B) %*% B             # Laplacian matrix with multiplicity
  A <- diag(diag(L.mult)) - L.mult # Adjacency matrix
  D <- netdistance(A)              # Distance matrix
  L <- diag(rowSums(A)) - A        # Laplacian matrix without multiplicity
  ##
  n.subsets <- as.integer(table(round(eigen(L)$values, 10) == 0)[2])
  ##
  ## Block diagonal matrix in case of sub-networks
  ##
  maxdist <- dim(D)[1]
  ##
  D2 <- D
  D2[is.infinite(D2)] <- maxdist
  order.D <- hclust(dist(D2))$order
  ##
  D <- D[order.D, order.D]
  A <- A[order.D, order.D]
  L <- L[order.D, order.D]
  ##
  A.i <- A
  D.i <- D
  id.treats <- character(0)
  id.subnets <- numeric(0)
  more.subnets <- TRUE
  subnet.i <- 0
  res.i <- data.frame(subnet = numeric(0), comparison = character(0))
  ##
  while (more.subnets) {
    subnet.i <- subnet.i + 1
    n.i <- seq_len(nrow(D.i))
    next.subnet <- min(max(n.i) + 1, n.i[is.infinite(D.i[, 1])])
    sel.i <- seq_len(next.subnet - 1)
    id.treats <- c(id.treats, rownames(D.i)[sel.i])
    id.subnets <- c(id.subnets, rep(subnet.i, length(sel.i)))
    D.i <- D.i[-seq_len(next.subnet - 1), -seq_len(next.subnet - 1)]
    more.subnets <- nrow(D.i) > 0
    ##
    A.subnet <- A.i[seq_len(next.subnet - 1), seq_len(next.subnet - 1)]
    A.subnet <-
      A.subnet[order(rownames(A.subnet)), order(colnames(A.subnet))]
    ##
    for (row.i in 1:(ncol(A.subnet) -1)) {
      for (col.i in 2:ncol(A.subnet)) {
        if (col.i > row.i)
          if (A.subnet[row.i, col.i] > 0) {
            comp.i <- paste(rownames(A.subnet)[row.i],
                            colnames(A.subnet)[col.i],
                            sep = sep.trts)
            res.i <- rbind(res.i,
                           data.frame(subnet = subnet.i,
                                      comparison = comp.i))
          }
      }
    }
    ##
    A.i <- A.i[-seq_len(next.subnet - 1), -seq_len(next.subnet - 1)]
  }
  ##
  subnet <- rep(NA, length(treat1))
  ##
  for (i in seq_along(id.treats))
    subnet[treat1 == id.treats[i]] <- id.subnets[i]
  ##
  comparisons <- res.i$comparison
  subnet.comparisons <- res.i$subnet
  
  
  designs <- designs(treat1, treat2, studlab)
  
  
  res <- list(treat1 = treat1,
              treat2 = treat2,
              studlab = studlab,
              ##
              design = designs$design,
              subnet = subnet,
              ##
              k = length(unique(studlab)),
              m = m,
              n = n,
              n.subnets = n.subsets,
              d = length(unique(designs$design)),
              ##
              D.matrix = D,
              A.matrix = A,
              L.matrix = L,
              ##
              designs = unique(sort(designs$design)),
              comparisons = comparisons,
              subnet.comparisons = subnet.comparisons,
              ##
              nchar.trts = nchar.trts,
              ##
              title = title,
              ##
              details.disconnected = details.disconnected,
              ##
              warn = warn,
              call = match.call(),
              version = packageDescription("netmeta")$Version
              )

  class(res) <- "netconnection"

  res
}





#' @rdname netconnection
#' @method netconnection pairwise
#' @export


netconnection.pairwise <- function(data,
                                   treat1, treat2, studlab = NULL,
                                   subset = NULL,
                                   sep.trts = ":",
                                   nchar.trts = 666,
                                   title = "", details.disconnected = FALSE,
                                   warn = FALSE,
                                   ...) {
  
  ##
  ##
  ## (1) Check arguments
  ##
  ##
  
  chkclass(data, "pairwise")
  ##
  chklogical(warn)
  ##
  ## Arguments 'treat1', 'treat2' and 'studlab' ignored
  ##
  if (warn) {
    if (!missing(treat1))
      warning("Argument 'treat1' ignored as argument 'data' is an ",
              "object created with pairwise().",
              call. = FALSE)
    ##
    if (!missing(treat2))
      warning("Argument 'treat2' ignored as argument 'data' is an ",
              "object created with pairwise().",
              call. = FALSE)
    ##
    if (!missing(studlab))
      warning("Argument 'studlab' ignored as argument 'data' is an ",
              "object created with pairwise().",
              call. = FALSE)
  }
  ##
  treat1 <- data$treat1
  treat2 <- data$treat2
  studlab <- data$studlab
  ##
  if (is.factor(treat1))
    treat1 <- as.character(treat1)
  if (is.factor(treat2))
    treat2 <- as.character(treat2)
  ##
  missing.subset <- missing(subset)
  if (!missing.subset) {
    sfsp <- sys.frame(sys.parent())
    mc <- match.call()
    subset <- catch("subset", mc, data, sfsp)
    ##
    k.All <- length(treat1)
    ##
    if ((is.logical(subset) & (sum(subset) > k.All)) ||
        (length(subset) > k.All))
      stop("Length of subset is larger than number of studies.")
    ##
    treat1 <- treat1[subset]
    treat2 <- treat2[subset]
    studlab <- studlab[subset]
  }
  ##
  chknumeric(nchar.trts, min = 1, length = 1)
  ##
  chklogical(details.disconnected)
  
  
  ##
  ##
  ## (2) Additional checks
  ##
  ##
  
  if (any(treat1 == treat2))
    stop("Treatments must be different (arguments 'treat1' and 'treat2').")
  ##
  ## Check for correct number of comparisons
  ##
  tabnarms <- table(studlab)
  sel.narms <- !is.wholenumber((1 + sqrt(8 * tabnarms + 1)) / 2)
  ##
  if (sum(sel.narms) == 1)
    stop("Study '", names(tabnarms)[sel.narms],
         "' has a wrong number of comparisons.",
         "\n  Please provide data for all treatment comparisons ",
         "(two-arm: 1; three-arm: 3; four-arm: 6, ...).")
  if (sum(sel.narms) > 1)
    stop("The following studies have a wrong number of comparisons: ",
         paste(paste0("'", names(tabnarms)[sel.narms], "'"),
               collapse = ", "),
         "\n  Please provide data for all treatment comparisons ",
         "(two-arm: 1; three-arm: 3; four-arm: 6, ...).")
  ##
  labels <- sort(unique(c(treat1, treat2)))
  ##
  if (compmatch(labels, sep.trts)) {
    if (!missing(sep.trts))
      warning("Separator '", sep.trts,
              "' used in at least one treatment label. ",
              "Try to use predefined separators: ",
              "':', '-', '_', '/', '+', '.', '|', '*'.",
              call. = FALSE)
    ##
    if (!compmatch(labels, ":"))
      sep.trts <- ":"
    else if (!compmatch(labels, "-"))
      sep.trts <- "-"
    else if (!compmatch(labels, "_"))
      sep.trts <- "_"
    else if (!compmatch(labels, "/"))
      sep.trts <- "/"
    else if (!compmatch(labels, "+"))
      sep.trts <- "+"
    else if (!compmatch(labels, "."))
      sep.trts <- "-"
    else if (!compmatch(labels, "|"))
      sep.trts <- "|"
    else if (!compmatch(labels, "*"))
      sep.trts <- "*"
    else
      stop("All predefined separators (':', '-', '_', '/', '+', ",
           "'.', '|', '*') are used in at least one treatment label.",
           "\n   Please specify a different character that should be ",
           "used as separator (argument 'sep.trts').",
           call. = FALSE)
  }
  
  
  ##
  ##
  ## (3) Determine (sub)network(s)
  ##
  ##
  
  treats <- as.factor(c(as.character(treat1), as.character(treat2)))
  trts <- levels(treats)
  ##
  n <- length(trts)   # Number of treatments
  m <- length(treat1) # Number of comparisons
  ##
  ## Edge-vertex incidence matrix
  ##
  treat1.pos <- treats[1:m]
  treat2.pos <- treats[(m + 1):(2 * m)]
  B <- createB(treat1.pos, treat2.pos, ncol = n)
  ##
  rownames(B) <- studlab
  colnames(B) <- trts
  ##
  L.mult <- t(B) %*% B             # Laplacian matrix with multiplicity
  A <- diag(diag(L.mult)) - L.mult # Adjacency matrix
  D <- netdistance(A)              # Distance matrix
  L <- diag(rowSums(A)) - A        # Laplacian matrix without multiplicity
  ##
  n.subsets <- as.integer(table(round(eigen(L)$values, 10) == 0)[2])
  ##
  ## Block diagonal matrix in case of sub-networks
  ##
  maxdist <- dim(D)[1]
  ##
  D2 <- D
  D2[is.infinite(D2)] <- maxdist
  order.D <- hclust(dist(D2))$order
  ##
  D <- D[order.D, order.D]
  A <- A[order.D, order.D]
  L <- L[order.D, order.D]
  ##
  A.i <- A
  D.i <- D
  id.treats <- character(0)
  id.subnets <- numeric(0)
  more.subnets <- TRUE
  subnet.i <- 0
  res.i <- data.frame(subnet = numeric(0), comparison = character(0))
  ##
  while (more.subnets) {
    subnet.i <- subnet.i + 1
    n.i <- seq_len(nrow(D.i))
    next.subnet <- min(max(n.i) + 1, n.i[is.infinite(D.i[, 1])])
    sel.i <- seq_len(next.subnet - 1)
    id.treats <- c(id.treats, rownames(D.i)[sel.i])
    id.subnets <- c(id.subnets, rep(subnet.i, length(sel.i)))
    D.i <- D.i[-seq_len(next.subnet - 1), -seq_len(next.subnet - 1)]
    more.subnets <- nrow(D.i) > 0
    ##
    A.subnet <- A.i[seq_len(next.subnet - 1), seq_len(next.subnet - 1)]
    A.subnet <-
      A.subnet[order(rownames(A.subnet)), order(colnames(A.subnet))]
    ##
    for (row.i in 1:(ncol(A.subnet) -1)) {
      for (col.i in 2:ncol(A.subnet)) {
        if (col.i > row.i)
          if (A.subnet[row.i, col.i] > 0) {
            comp.i <- paste(rownames(A.subnet)[row.i],
                            colnames(A.subnet)[col.i],
                            sep = sep.trts)
            res.i <- rbind(res.i,
                           data.frame(subnet = subnet.i,
                                      comparison = comp.i))
          }
      }
    }
    ##
    A.i <- A.i[-seq_len(next.subnet - 1), -seq_len(next.subnet - 1)]
  }
  ##
  subnet <- rep(NA, length(treat1))
  ##
  for (i in seq_along(id.treats))
    subnet[treat1 == id.treats[i]] <- id.subnets[i]
  ##
  comparisons <- res.i$comparison
  subnet.comparisons <- res.i$subnet
  
  
  designs <- designs(treat1, treat2, studlab)
  
  
  res <- list(treat1 = treat1,
              treat2 = treat2,
              studlab = studlab,
              ##
              design = designs$design,
              subnet = subnet,
              ##
              k = length(unique(studlab)),
              m = m,
              n = n,
              n.subnets = n.subsets,
              d = length(unique(designs$design)),
              ##
              D.matrix = D,
              A.matrix = A,
              L.matrix = L,
              ##
              designs = unique(sort(designs$design)),
              comparisons = comparisons,
              subnet.comparisons = subnet.comparisons,
              ##
              nchar.trts = nchar.trts,
              ##
              title = title,
              ##
              details.disconnected = details.disconnected,
              ##
              warn = warn,
              call = match.call(),
              version = packageDescription("netmeta")$Version
              )

  class(res) <- "netconnection"

  res
}





#' @rdname netconnection
#' @method print netconnection
#' @export


print.netconnection <- function(x,
                                digits = max(4, .Options$digits - 3),
                                nchar.trts = x$nchar.trts,
                                details = FALSE,
                                details.disconnected = x$details.disconnected,
                                ...) {
  
  chkclass(x, "netconnection")
  ##
  if (is.null(nchar.trts))
    nchar.trts <- 666
  
  
  chknumeric(digits, length = 1)
  chknumeric(nchar.trts, min = 1, length = 1)
  chklogical(details)
  details.disconnected <- replaceNULL(details.disconnected, FALSE)
  chklogical(details.disconnected)
  
  
  matitle(x)
  ##
  cat(paste("Number of studies: k = ", x$k, "\n", sep = ""))
  cat(paste("Number of pairwise comparisons: m = ", x$m, "\n", sep = ""))
  cat(paste("Number of treatments: n = ", x$n, "\n", sep = ""))
  if (!is.null(x$d))
    cat(paste("Number of designs: d = ", x$d, "\n", sep = ""))
  ##
  cat("Number of subnetworks: ", x$n.subnets, "\n", sep = "")
  ##
  if (x$n.subnets > 1) {
    f <- function(x) length(unique(x))
    d <- as.data.frame(x)
    k.subset <- tapply(d$studlab, d$subnet, f)
    ##
    m <- as.matrix(
      data.frame(subnetwork = names(k.subset),
                 k = as.vector(k.subset),
                 m = as.vector(tapply(d$studlab, d$subnet, length)),
                 n = as.vector(tapply(c(d$treat1, d$treat2),
                                      c(d$subnet, d$subnet), f)))
    )
    rownames(m) <- rep("", nrow(m))
    ##
    cat("\nDetails on subnetworks: \n")
    prmatrix(m, quote = FALSE, right = TRUE)
    ##
    if (details.disconnected) {
      cat("\n")
      for (i in seq_len(x$n.subnets)) {
        d.i <- subset(d, d$subnet == i)
        cat(paste0("Subnetwork ", i, ":\n"))
        print(sort(unique(c(d.i$treat1, d.i$treat2))))
      }
    }
  }
  
  
  if (details) {
    cat("\nDistance matrix:\n")
    
    D <- round(x$D.matrix, digits = digits)
    D[is.infinite(D)] <- "."
    ##
    if (x$n.subnets == 1)
      diag(D) <- "."
    ##
    rownames(D) <- treats(rownames(D), nchar.trts)
    colnames(D) <- treats(colnames(D), nchar.trts)
    ##
    prmatrix(D, quote = FALSE, right = TRUE)
    
    diff.rownames <- rownames(x$D.matrix) != rownames(D)
    if (any(diff.rownames)) {
      abbr <- rownames(D)
      full <- rownames(x$D.matrix)
      ##
      tmat <- data.frame(abbr, full)
      names(tmat) <- c("Abbreviation", "Treatment name")
      tmat <- tmat[diff.rownames, ]
      tmat <- tmat[order(tmat$Abbreviation), ]
      ##
      cat("\nLegend:\n")
      prmatrix(tmat, quote = FALSE, right = TRUE,
               rowlab = rep("", length(abbr)))
    }
  }
  
  
  invisible(NULL)
}





#' @rdname netconnection
#' @export


netconnection <- function(data, ...)
  UseMethod("netconnection")
guido-s/netmeta documentation built on Feb. 3, 2024, 8:34 a.m.