#' @title Filter meta-analyses
#'
#' @description
#' Filter \code{psychmeta} meta-analysis objects based on specified criteria.
#'
#' @param ma_obj A psychmeta meta-analysis object.
#' @param analyses Which analyses to extract? Can be either \code{"all"} to extract all meta-analyses in the object (default) or a list containing one or more of the following arguments:
#' \itemize{
#' \item{\code{construct}: A list or vector of construct names to search for.}
#' \item{\code{construct_pair}: A list of vectors of construct pairs to search for. \cr
#' (e.g., \code{list(c("X", "Y"), c("X", "Z"))} ).}
#' \item{\code{pair_id}: A list or vector of numeric construct pair IDs (unique construct-pair indices).}
#' \item{\code{analysis_id}: A list or vector of numeric analysis IDs (unique analysis indexes).}
#' \item{\code{k_min}: A numeric value specifying the minimum \code{k} for extracted meta-analyses.}
#' \item{\code{N_min}: A numeric value specifying the minimum \code{N} for extracted meta-analyses.}
#' }
#' @param match Should extracted meta-analyses match all (default) or any of the criteria given in \code{analyses}?
#' @param case_sensitive Logical scalar that determines whether character values supplied in \code{analyses} should be treated as case sensitive (\code{TRUE}, default) or not (\code{FALSE}).
#' @param ... Additional arguments.
#'
#' @return A \code{psychmeta} meta-analysis object with analyses matching the specified criteria.
#' @export
#'
#' @importFrom dplyr filter
#' @importFrom rlang .data
#'
#' @examples
#' ma_obj <- ma_r(ma_method = "ic", rxyi = rxyi, n = n, rxx = rxxi, ryy = ryyi,
#' construct_x = x_name, construct_y = y_name, sample_id = sample_id, citekey = NULL,
#' moderators = moderator, data = data_r_meas_multi,
#' impute_artifacts = FALSE, clean_artifacts = FALSE)
#' ma_obj <- ma_r_ad(ma_obj, correct_rr_x = FALSE, correct_rr_y = FALSE)
#'
#' filter_ma(ma_obj, analyses="all")
#' filter_ma(ma_obj, analyses=list(construct="X"), match="all")
#' filter_ma(ma_obj, analyses=list(construct="X", k_min=21), match="any")
#' filter_ma(ma_obj, analyses=list(construct="X", k_min=21), match="all")
filter_ma <- function(ma_obj, analyses="all", match=c("all", "any"), case_sensitive = TRUE, ...){
traffic_from_get <- list(...)$traffic_from_get
if(is.null(traffic_from_get)) traffic_from_get <- FALSE
flag_summary <- "summary.ma_psychmeta" %in% class(ma_obj) & !traffic_from_get
ma_obj <- screen_ma(ma_obj = ma_obj)
match <- match.arg(match, c("all", "any"))
case_sensitive <- scalar_arg_warning(arg = case_sensitive, arg_name = "case_sensitive")
.attributes <- attributes(ma_obj)
ma_method <- .attributes$ma_method
if(any(colnames(ma_obj) == "group_contrast") |
any(colnames(ma_obj) == "construct_x") |
any(colnames(ma_obj) == "construct_y")){
if(any(colnames(ma_obj) == "group_contrast") | any(colnames(ma_obj) == "construct_x")){
if(any(colnames(ma_obj) == "group_contrast")){
construct_x <- ma_obj$group_contrast
}else{
construct_x <- ma_obj$construct_x
}
}else{
construct_x <- NULL
}
if(any(colnames(ma_obj) == "construct_y")){
construct_y <- ma_obj$construct_y
}else{
construct_y <- NULL
}
if(!case_sensitive){
if(!is.null(construct_x))
construct_x <- tolower(construct_x)
if(!is.null(construct_y))
construct_y <- tolower(construct_y)
}
}else{
construct_x <- NULL
construct_y <- NULL
}
if(mode(analyses) != "list"){
if(analyses == "all" ){
construct_ids <- NULL
analyses <- list()
}else stop("'analyses' must be either 'all' or a list. See help(filter_meta).")
}
keep_meta <- rep(TRUE, nrow(ma_obj))
if(!is.null(construct_x) & !is.null(construct_y)){
if(!is.null(analyses[["construct"]])) {
if(is.vector(analyses[["construct"]])) analyses[["construct"]] <- as.list(analyses[["construct"]])
if(match == "all"){
keep_meta <- construct_x %in% analyses[["construct"]] | construct_y %in% analyses[["construct"]]
}
}
if(!is.null(analyses[["construct_pair"]])){
construct_pair_ids <-
lapply(analyses[["construct_pair"]], function(x){
construct_x %in% x & construct_y %in% x
})
if(match == "any"){
for(i in 1:length(construct_pair_ids))
keep_meta <- keep_meta | construct_pair_ids[[i]]
}else{
for(i in 1:length(construct_pair_ids))
keep_meta <- keep_meta & construct_pair_ids[[i]]
}
}
}
if(!is.null(analyses[["k_min"]])){
.keep_meta <- unlist(map(ma_obj$meta_tables, function(x) x$barebones$k >= analyses[["k_min"]]))
if(match == "any"){
keep_meta <- keep_meta | .keep_meta
}else{
keep_meta <- keep_meta & .keep_meta
}
}
if(!is.null(analyses[["N_min"]])){
.keep_meta <- unlist(map(ma_obj$meta_tables, function(x) x$barebones$N >= analyses[["N_min"]]))
if(match == "any"){
keep_meta <- keep_meta | .keep_meta
}else{
keep_meta <- keep_meta & .keep_meta
}
}
if(!is.null(analyses$analysis_id)){
.keep_meta <- ma_obj[["analysis_id"]] %in% analyses[["analysis_id"]]
if(match == "any"){
keep_meta <- keep_meta | .keep_meta
}else{
keep_meta <- keep_meta & .keep_meta
}
}
if(any(colnames(ma_obj) == "pair_id"))
if(!is.null(analyses[["pair_id"]])) {
.keep_meta <- ma_obj[["pair_id"]] %in% analyses[["pair_id"]]
if(match == "any"){
keep_meta <- keep_meta | .keep_meta
}else{
keep_meta <- keep_meta & .keep_meta
}
}
ma_obj <- ma_obj[keep_meta,]
if(flag_summary) ma_obj <- summary(ma_obj)
return(ma_obj)
}
#' @rdname filter_ma
#' @export
filter_meta <- filter_ma
namelists.ma_psychmeta <- function(ma_obj){
analysis_id <- ma_obj$analysis_id
for(i in 1:ncol(ma_obj)) ma_obj[[i]] <- setNames(ma_obj[[i]], paste0("analysis_id: ", analysis_id))
ma_obj
}
screen_ma <- function(ma_obj){
if("summary.ma_psychmeta" %in% class(ma_obj))
ma_obj <- ma_obj$ma_obj
correct_class <- "ma_psychmeta" %in% class(ma_obj)
correct_attributes <- all(c("ma_metric", "ma_methods") %in% names(attributes(ma_obj)))
needed_cols <- c("analysis_id", "analysis_type", "meta_tables", "escalc")
correct_cols <- needed_cols %in% colnames(ma_obj)
if(!correct_class)
stop("The object supplied does not have the class 'ma_psychmeta'. This can occur if:
(1) the object does not represent a meta-analysis or
(2) the meta-analysis object has been manipulated using unsupported methods.", call. = FALSE)
if(!correct_attributes)
stop("The meta-analysis object is missing necessary attributes.
This issue typically occurs when the object has been manipulated using unsupported methods.", call. = FALSE)
if(!all(correct_cols))
stop("The meta-analysis object is missing critical columns: ", paste(needed_cols[!correct_cols], collapse = ", "), call. = FALSE)
ma_obj
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.