R/find.outliers.R

Defines functions spot.outliers.fixed

Documented in spot.outliers.fixed

#' Find Statistical Outliers in a Meta-Analysis
#'
#' Searches for statistical outliers in meta-analysis results generated by \code{\link[meta]{meta}} functions or the
#' \code{\link[metafor]{rma.uni}} in the \code{metafor} package.
#'
#' @usage find.outliers(x)
#'
#' @param x Either (1) an object of class \code{meta}, generated by the \code{metabin}, \code{metagen},
#' \code{metacont}, \code{metacor}, \code{metainc}, \code{metarate} or \code{metaprop} function; or (2)
#' and object of class \code{rma.uni} created with the \code{\link[metafor]{rma.uni}} function in \code{metafor}.
#'
#' @details
#' This function searches for outlying studies in a meta-analysis results object. Studies are defined as outliers when
#' their 95\% confidence interval lies ouside the 95\% confidence interval of the pooled effect.
#'
#' When outliers are found, the function automatically recalculates the meta-analysis results, using the same settings as
#' in the object provided in \code{x}, but excluding the detected outliers.
#'
#' A forest plot of the meta-analysis with outliers removed can be generated directly by plugging the output of the function into
#' the \code{forest} function.
#'
#' @references Harrer, M., Cuijpers, P., Furukawa, T.A, & Ebert, D. D. (2019).
#' \emph{Doing Meta-Analysis in R: A Hands-on Guide}. DOI: 10.5281/zenodo.2551803. \href{https://bookdown.org/MathiasHarrer/Doing_Meta_Analysis_in_R/detecting-outliers-influential-cases.html}{Chapter 6.2}
#'
#' @author Mathias Harrer & David Daniel Ebert
#'
#' @return
#' Returns the identified outliers and the meta-analysis results when the outliers are removed.
#'
#' If the provided meta-analysis object is of class \code{meta}, the following objects are returned if the
#' results of the function are saved to another object:
#' \itemize{
#' \item \code{out.study.fixed}: A numeric vector containing the names of the outlying studies when
#' assuming a fixed-effect model.
#' \item \code{out.study.random}: A numeric vector containing the names of the outlying studies when
#' assuming a random-effects model. The \eqn{\tau^{2}} estimator \code{method.tau} is inherited from \code{x}.
#' \item \code{m.fixed}: An object of class \code{meta} containing the results of the meta-analysis with outliers
#' removed (assuming a fixed-effect model).
#' \item \code{m.random}: An object of class \code{meta} containing the results of the meta-analysis with outliers
#' removed (assuming a random-effects model, and using the same \code{method.tau} as in the original analysis).
#'}
#'
#' If the provided meta-analysis object is of class \code{rma.uni}, the following objects are returned if the
#' results of the function are saved to another object:
#' \itemize{
#' \item \code{out.study}: A numeric vector containing the names of the outlying studies.
#' \item \code{m}: An object of class \code{rma.uni} containing the results of the meta-analysis with outliers
#' removed (using the same settings as in the meta-analysis object provided).
#'}
#' @importFrom metafor rma.uni
#' @importFrom meta update.meta
#'
#' @export find.outliers
#'
#' @aliases spot.outliers.random spot.outliers.fixed spot.outliers
#'
#' @seealso \code{\link[metafor]{influence.rma.uni}}, \code{\link[meta]{metainf}}, \code{\link[meta]{baujat}}
#'
#' @examples
#' suppressPackageStartupMessages(library(meta))
#' suppressPackageStartupMessages(library(metafor))
#' suppressPackageStartupMessages(library(dmetar))
#'
#' # Pool with meta
#' m1 <- metagen(TE, seTE, data = ThirdWave,
#'               studlab = ThirdWave$Author, comb.fixed = FALSE)
#'
#' # Pool with metafor
#' m2 <- rma(yi = TE, sei = seTE, data = ThirdWave,
#'           slab = ThirdWave$Author, method = "PM")
#'
#' # Find outliers
#' fo1 <- find.outliers(m1)
#' fo2 <- find.outliers(m2)
#'
#' # Show summary
#' summary(fo1)
#' summary(fo2)
#'
#' \dontrun{
#' # Make forest plot
#' # Pass additional arguments from meta & metafor's forest function
#' forest(fo1, prediction = TRUE)
#' forest(fo2, cex = .8, col = "lightblue")
#' }


find.outliers = spot.outliers.random = spot.outliers.fixed = function(x){


  if (class(x)[1] %in% c("rma.uni", "rma")){

    token = "metafor"

    # Generate lower/upper for all effects
    lower = as.numeric(x$yi - 1.96*sqrt(x$vi))
    upper = as.numeric(x$yi + 1.96*sqrt(x$vi))

    # Select outliers
    mask = upper < x$ci.lb | lower > x$ci.ub
    dat = data.frame("yi" = x$yi[!mask],
                     "vi" = x$vi[!mask],
                     "studlab" = as.character(x$slab[!mask]))
    out.study = x$slab[mask]

    # Update metafor model
    method.tau = x$method
    m = metafor::rma.uni(dat$yi, vi = dat$vi, method = method.tau, slab = dat$studlab)

    if (length(out.study) < 1){


      tau.token = "metafor.null"
      cat(paste0("No outliers detected (", method.tau,")."))
      out.study = NULL

    } else {

      tau.token = "metafor"

    }

  }

  if (class(x)[1] %in% c("metagen", "metapropr",
                         "metacor", "metainc", "metacont",
                         "metaprop", "metabin", "metabin")){

    token = "meta"

    # Control for objects with NAs in study data
    if (sum(is.na(x$TE)) > 0 | sum(is.na(x$seTE)) > 0){

      stop("The provided 'meta' object cannot contain NA's in any of the study data.")

    }


    if (class(x)[1] == "metaprop"){

      lower = x$TE - 1.96*x$seTE
      upper = x$TE + 1.96*x$seTE

      # Generate mask with outliers (fixed/random)
      mask.fixed = upper < x$lower.fixed | lower > x$upper.fixed
      mask.random = upper < x$lower.random | lower > x$upper.random

    } else {

      # Generate mask with outliers (fixed/random)
      mask.fixed = x$upper < x$lower.fixed | x$lower > x$upper.fixed
      mask.random = x$upper < x$lower.random | x$lower > x$upper.random

    }

    # Update meta-analysis with outliers removed
    m.fixed = update.meta(x, exclude = mask.fixed)
    m.random = update.meta(x, exclude = mask.random)

    # Select names of outlying studies
    out.study.fixed = x$studlab[mask.fixed]
    out.study.random = x$studlab[mask.random]

    if (x$comb.fixed == TRUE & x$comb.random == FALSE){

      if (length(out.study.fixed) < 1){

        tau.token = "null.ftrf"
        out.study.fixed = NULL

      } else {

        tau.token = "ftrf"

      }

    }

    if (x$comb.fixed == FALSE & x$comb.random == TRUE){

      if (length(out.study.random) < 1){

        tau.token = "null.ffrt"
        out.study.random = NULL

      } else {

        tau.token = "ffrt"

      }

    }

    if (x$comb.fixed == TRUE & x$comb.random == TRUE){

      if (length(out.study.fixed) < 1 & length(out.study.random) < 1){

        out.study.fixed = NULL
        out.study.random = NULL
        tau.token = "null.ftrt"

      } else {

        if (length(out.study.fixed) < 1){out.study.fixed = NULL}
        if (length(out.study.random) < 1){out.study.random = NULL}

        tau.token = "ftrt"

      }

    }

  }

  if (!class(x)[1] %in% c("rma.uni", "rma", "metacont",
                          "metagen", "metapropr",
                          "metacor", "metainc",
                          "metaprop", "metabin", "metabin")){

    message("Input must be of class 'meta' or 'rma.uni'")

  }

  if (token == "metafor"){

    returnlist = list("out.study" = out.study,
                   "m" = m)

    if (tau.token == "metafor"){class(returnlist) = c("find.outliers", "mf", method.tau)}
    if (tau.token == "metafor.null"){class(returnlist) = c("find.outliers", "mf.null", method.tau)}

    # Return
    invisible(returnlist)

    returnlist

  } else {


    returnlist = list("out.study.fixed" = out.study.fixed,
                   "out.study.random" = out.study.random,
                   "m.fixed" = m.fixed,
                   "m.random" = m.random)

    # Set classes
    if (tau.token == "ftrf"){class(returnlist) = c("find.outliers", "ftrf")}
    if (tau.token == "ffrt"){class(returnlist) = c("find.outliers", "ffrt")}
    if (tau.token == "ftrt"){class(returnlist) = c("find.outliers", "ftrt")}
    if (tau.token == "null.ftrf"){class(returnlist) = c("find.outliers", "null.ftrf")}
    if (tau.token == "null.ffrt"){class(returnlist) = c("find.outliers", "null.ffrt")}
    if (tau.token == "null.ftrt"){class(returnlist) = c("find.outliers", "null.ftrt")}

    # Return
    invisible(returnlist)

    returnlist

  }

}
MathiasHarrer/dmetar documentation built on March 29, 2020, 7:46 a.m.