inst/shiny/funcs/find.outliers.R
In Ibrahimhassan94/MAAS: Meta-analysis with R via shiny
#' 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}.
#' @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
#' @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
}
}
Ibrahimhassan94/MAAS documentation built on Feb. 24, 2022, 8:14 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.
#' 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}.
#' @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
#' @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
}
}
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.