#' 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{metamean}, \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}. #' @param ... Additional parameters for the \code{\link[metafor]{rma.uni}} or \code{\link[meta]{update.meta}} function. #' #' @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 #' @import meta #' @import utils #' #' @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 #' \dontrun{ #' library(meta) #' library(metafor) #' library(dmetar) #' #' # Pool with meta #' m1 <- metagen(TE, seTE, data = ThirdWave, #' studlab = ThirdWave$Author, common = 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 #' fo1 #' fo2 #' #' # 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, ...){ update.meta = getFromNamespace("update.meta", "meta") 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", "metamean", "metacor", "metainc", "metacont", "metaprop", "metabin", "metabin")){ token = "meta" # Control for objects with NAs in study data if (anyNA(x$TE) | anyNA(x$seTE)){ warning("Studies with NAs not considered in outlier analysis.") } 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 = (!is.na(upper) & upper < x$lower.fixed) | (!is.na(lower) & lower > x$upper.fixed) mask.random = (!is.na(upper) & upper < x$lower.random) | (!is.na(lower) & lower > x$upper.random) } else { # Generate mask with outliers (fixed/random) mask.fixed = (!is.na(x$upper) & x$upper < x$lower.fixed) | (!is.na(x$lower) & x$lower > x$upper.fixed) mask.random = (!is.na(x$upper) & x$upper < x$lower.random) | (!is.na(x$lower) & 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$common == TRUE & x$random == FALSE){ if (length(out.study.fixed) < 1){ tau.token = "null.ftrf" out.study.fixed = NULL } else { tau.token = "ftrf" } } if (x$common == FALSE & x$random == TRUE){ if (length(out.study.random) < 1){ tau.token = "null.ffrt" out.study.random = NULL } else { tau.token = "ffrt" } } if (x$common == TRUE & x$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", "metamean", "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 } }