psychmeta: Psychometric Meta-Analysis Toolkit

#' @name print
#'
#' @title Print methods for **`psychmeta`**
#'
#' @description
#' Print methods for **`psychmeta`** output objects with classes exported from **`psychmeta`**.
#'
#' @param x Object to be printed (object is used to select a method).
#' @param ... Additional arguments.
#' @param digits Number of digits to which results should be rounded.
#' @param ma_methods Meta-analytic methods to be included. Valid options are: "bb", "ic", and "ad"
#' @param correction_types Types of meta-analytic corrections to be included Valid options are: "ts", "vgx", and "vgy"
#' @param verbose Logical scalar that determines whether printed object should contain verbose information (e.g., non-standard columns of meta-analytic output; `TRUE`) or not (`FALSE`).
#' @param n For `print.ma_psychmeta()` and `print.ad_tibble()`, number of rows to print for tibble. Defaults to all rows. See [tibble::print.tbl()] for details.
#' @param width For `print.ma_psychmeta()` and `print.ad_tibble()`, width of text output to generate for tibble. See [tibble::print.tbl()] for details.
#' @param n_extra For `print.ma_psychmeta()` and `print.ad_tibble()`, number of extra columns to print abbreviated information for, if the width is too small for the entire meta-analysis tibble. See [tibble::print.tbl()] for details.
#' @param symbolic.cor For `print.lm_mat()`, Logical. If `TRUE`, print the correlations in a symbolic form (see [stats::symnum()]) rather than as numbers.
#' @param signif.stars For `print.lm_mat()`, Logical. If `TRUE`, ‘significance stars’ are printed for each coefficient.
#'
#' @md
NULL



#' @export
#' @keywords internal
#' @method print lm_mat
print.lm_mat <- function(x, ..., digits = max(3L, getOption("digits") - 3L)){
        .print.lm_mat(x = x, digits = digits, ...)
        invisible(x)
}

#' Print method for objects of the class "summary.lm_mat"
#' @keywords internal
.print.summary.lm_mat <- stats:::print.summary.lm



#' @export
#' @keywords internal
#' @method print summary.lm_mat
print.summary.lm_mat <- function(x, digits = max(3L, getOption("digits") - 3L), symbolic.cor = x$symbolic.cor,
                                 signif.stars = getOption("show.signif.stars"), ...){
        .print.summary.lm_mat(x = x, digits = digits, symbolic.cor = symbolic.cor,
                              signif.stars = signif.stars, ...)
        if(x$cov.is.cor)
                message("Note: cov_mat is a standardized matrix, interpret coefficients' significance tests with caution. \nFor best results, use an unstandardized covariance matrix as the cov_mat argument.")
        invisible(x)
}

#' Print method for objects of the class "lm_mat"
#' @keywords internal
.print.lm_mat <- stats:::print.lm


#### Print artifact distributions ####

#' @export
#' @keywords internal
#' @method print ad_tsa
print.ad_tsa <- function(x, ..., digits = 3){
        cat("Taylor-Series Artifact Distributions\n")
        cat("------------------------------------\n")

        print(round(as.matrix(x[,]), digits = digits))

        cat("\n")
        invisible(x)
}



#' @export
#' @keywords internal
#' @method print ad_int_list
print.ad_int_list <- function(x, ..., digits = 3){
        cat("Interactive Artifact Distributions\n")
        cat("----------------------------------\n")

        cat("\n")
        cat("qxa Artifact Distribution - Indirect Range Restriction\n")
        print.data.frame(x[["qxa_irr"]], digits = digits)

        cat("\n")
        cat("qxa Artifact Distribution - Direct Range Restriction\n")
        print.data.frame(x[["qxa_drr"]], digits = digits)


        cat("\n")
        cat("qxi Artifact Distribution - Indirect Range Restriction\n")
        print.data.frame(x[["qxi_irr"]], digits = digits)

        cat("\n")
        cat("qxi Artifact Distribution - Direct Range Restriction\n")
        print.data.frame(x[["qxi_drr"]], digits = digits)


        cat("\n")
        cat("ux Artifact Distribution\n")
        print.data.frame(x[["ux"]], digits = digits)

        cat("\n")
        cat("ut Artifact Distribution\n")
        print.data.frame(x[["ut"]], digits = digits)

        cat("\n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print ad_int
print.ad_int <- function(x, ..., digits = 3){
        print(x$Distribution, digits = digits)
        invisible(x)
}







#### Print correlation corrections ####

#' @export
#' @keywords internal
#' @method print correct_r
print.correct_r <- function(x, ..., digits = 3){
        if(inherits(x, "meas"))
                cat("Correlations Corrected for Measurement Error:\n")

        if(inherits(x, "uvdrr"))
                cat("Correlations Corrected for Measurement Error and Univariate Direct Range Restriction:\n")

        if(inherits(x, "uvirr"))
                cat("Correlations Corrected for Measurement Error and Univariate Indirect Range Restriction:\n")

        if(inherits(x, "bvirr"))
                cat("Correlations Corrected for Measurement Error and Bivariate Indirect Range Restriction:\n")

        if(inherits(x, "bvdrr"))
                cat("Correlations Corrected for Measurement Error and Bivariate Direct Range Restriction:\n")

        cat("---------------------------------------------------------------------------------------\n")

        if(is.data.frame(x[["correlations"]])){
                print.data.frame(x[["correlations"]], digits = digits)
        }else{
                if(inherits(x, "meas")){
                        print.data.frame(x[["correlations"]][["rtp"]], digits = digits)
                }else{
                        print.data.frame(x[["correlations"]][["rtpa"]], digits = digits)
                }
        }
        invisible(x)
}



#### Print d value corrections ####

#' @export
#' @keywords internal
#' @method print correct_d
print.correct_d <- function(x, ..., digits = 3){
        if(inherits(x, "meas"))
                cat("d Values Corrected for Measurement Error:\n")

        if(inherits(x, "uvdrr"))
                cat("d Values Corrected for Measurement Error and Univariate Direct Range Restriction:\n")

        if(inherits(x, "uvirr"))
                cat("d Values Corrected for Measurement Error and Univariate Indirect Range Restriction:\n")

        if(inherits(x, "bvirr"))
                cat("d Values Corrected for Measurement Error and Bivariate Indirect Range Restriction:\n")

        if(inherits(x, "bvdrr"))
                cat("d Values Corrected for Measurement Error and Bivariate Direct Range Restriction:\n")

        cat("---------------------------------------------------------------------------------------\n")

        if(is.data.frame(x[["d_values"]])){
                print.data.frame(x[["d_values"]], digits = digits)
        }else{
                if(inherits(x, "meas")){
                        print.data.frame(x[["d_values"]][["dGp"]], digits = digits)
                }else{
                        print.data.frame(x[["d_values"]][["dGpa"]], digits = digits)
                }
        }
        invisible(x)
}




#### Print simulation outputs ####

#' @export
#' @keywords internal
#' @method print simdat_psych
print.simdat_psych <- function(x, ..., digits = 3){
        cat("Data from a Simulated Study of", nrow(x$obs), "Cases\n")
        cat("--------------------------\n")

        cat("\nObserved scores:\n")
        print(x$observed, digits = digits)

        cat("\nTrue scores:\n")
        print(x$true, digits = digits)

        cat("\nError scores:\n")
        print(x$error, digits = digits)

        invisible(x)

}


#' @export
#' @keywords internal
#' @method print simdat_r_sample
print.simdat_r_sample <- function(x, ..., digits = 3){
        if(is.infinite(x$na)){
                type <- "(Parameters)"
        }else{
                type <- "(Statistics)"
        }

        cat("Results of Simulated Study", type, "\n")
        cat("--------------------------\n")
        cat("\n")

        cat("Simulated ", x$na, " applicant cases and selected ", x$ni, " incumbent cases for a selection ratio of ", round(x$sr, 3) * 100, "%.\n", sep = "")
        cat("\n")

        cat("Observed Applicant Correlations:\n")
        print(round(x[["R_obs_a"]], digits = digits))
        cat("\n")

        cat("Observed Incumbent Correlations:\n")
        print(round(x[["R_obs_i"]], digits = digits))
        cat("\n")

        cat("Observed Descriptive Statistics:\n")
        print(round(x[["descriptives"]][["observed"]], digits = digits))

        invisible(x)

}



#' @export
#' @keywords internal
#' @method print simdat_r_database
print.simdat_r_database <- function(x, ..., digits = 3){
        if(inherits(x, "merged")){
                merged <- "(Merged from Multiple Databases)"
        }else{
                merged <- NULL
        }
        if(inherits(x, "wide")){
                cat("Simulated Correlation Database of", nrow(x[["statistics"]]), "Studies", merged, "\n")
        }else{
                construct_pairs <- paste(unlist(x[["statistics"]][,"x_name"]), unlist(x[["statistics"]][,"y_name"]))
                cat("Simulated Correlation Database of", sum(construct_pairs == construct_pairs[1]), "Studies", merged, "\n")
        }
        cat("----------------------------------------------------------\n")
        cat("\n")

        cat("Most recent call associated with this object:\n")
        print(x$call[[length(x$call)]])
        cat("\n")

        cat("Overview of simulated statistics (i.e., results with sampling error):\n")
        print(x[["statistics"]], digits = digits)

        cat("\n")

        cat("Overview of simulated parameters (i.e., results without sampling error):\n")
        print(x[["parameters"]], digits = digits)
        invisible(x)

}





#' @export
#' @keywords internal
#' @method print simdat_d_sample
print.simdat_d_sample <- function(x, ..., digits = 3){
        if(is.null(x$data) & !all(c("ni1", "ni2") %in% colnames(x$overall_results$observed))){
                type <- "(Parameters)"
        }else{
                type <- "(Statistics)"
        }
        cat("Results of Simulated Study with", length(x$group_results), "Groups", type, "\n")
        cat("--------------------------\n")
        cat("\n")

        cat("Simulated ", x$proportions$na[nrow(x$proportions)], " applicant cases and selected ", x$proportions$ni[nrow(x$proportions)], " incumbent cases for an overall selection ratio of ", round(x$proportions$sr[nrow(x$proportions)], 3) * 100, "%.\n", sep = "")
        cat("\n")

        print(x$overall_results$observed, digits = digits)
        invisible(x)
}



#' @export
#' @keywords internal
#' @method print simdat_d_database
print.simdat_d_database <- function(x, ..., digits = 3){
        if(inherits(x, "merged")){
                merged <- "(Merged from Multiple Databases)"
        }else{
                merged <- NULL
        }
        cat("Simulated d Value Database of", length(unique(unlist(x[["statistics"]][,"sample_id"]))), "Studies", merged, " \n")
        cat("----------------------------------------------------------\n")
        cat("\n")

        cat("Most recent call associated with this object:\n")
        print(x$call[[length(x$call)]])
        cat("\n")

        cat("Overview of simulated statistics (i.e., results with sampling error):\n")
        cat("\n")
        print(x[["statistics"]], digits = digits)

        cat("\n")

        cat("Overview of simulated parameters (i.e., results without sampling error):\n")
        cat("\n")
        print(x[["parameters"]], digits = digits)
        invisible(x)

}




#' @export
#' @keywords internal
#' @method print convert_es
print.convert_es <- function(x, ..., digits = 3){
        cat(attr(x, "output_es"), "values converted from", attr(x, "input_es"), "values\n")
        cat("-----------------------------------------\n")
        print.data.frame(x, digits = digits)
        invisible(x)
}



#' @export
#' @keywords internal
#' @method print dmod
print.dmod <- function(x, ..., digits = 3){
        cat("\n")
        cat("Call:\n")
        print(x$call)

        if(length(x) > 3){
                cat("\n")
                cat("Point Estimates:\n")
                print.data.frame(x[["point_estimate"]], digits = digits)

                cat("\n")
                cat("Mean Bootstrapped Values:\n")
                print.data.frame(x[["bootstrap_mean"]], digits = digits)

                cat("\n")
                cat("Bootstrapped Standard Errors:\n")
                print.data.frame(x[["bootstrap_se"]], digits = digits)

                cat("\n")
                cat("Bootstrapped Lower-Bound Confidence Limit:\n")
                print.data.frame(x[[grep(x = names(x), pattern = "bootstrap_CI_LL_")]], digits = digits)

                cat("\n")
                cat("Bootstrapped Upper-Bound Confidence Limit:\n")
                print.data.frame(x[[grep(x = names(x), pattern = "bootstrap_CI_UL_")]], digits = digits)
        }else{
                cat("\n")
                cat("Point Estimates:\n")
                print.data.frame(x[["point_estimate"]], digits = digits)
        }

        invisible(x)
}



#' @export
#' @keywords internal
#' @method print ma_heterogeneity
print.ma_heterogeneity <- function(x, ..., digits = 3){
        es_type <- x$es_type
        ma_method <- attributes(x)$ma_method
        conf_level <- attributes(x)$conf_level * 100
        sd_label <- switch(ma_method,
                           bb = "sd_res",
                           switch(es_type,
                                  r = "sd_rho",
                                  d = "sd_delta",
                                  "sd_res_c"))
        var_label <- switch(ma_method,
                            bb = "var_res",
                            switch(es_type,
                                   r = "var_rho",
                                   d = "var_delta",
                                   "var_res_c"))

        cat("\nHeterogeneity results for", es_type, "\n")
        cat(rep("-", nchar(paste("Heterogeneity results for", es_type))), "\n", sep = "")

        cat("\n")
        cat("Accounted for a total of ", round2char(x$percent_var_accounted["total"], digits = digits), "% of variance", "\n", sep = "")
        cat((paste0("   Due to sampling error:  ", round2char(x$percent_var_accounted["sampling_error"], digits = digits), "%\n"))[!is.na(x$percent_var_accounted["sampling_error"])])
        cat((paste0("   Due to other artifacts: ", round2char(x$percent_var_accounted["artifacts"], digits = digits), "%\n"))[!is.na(x$percent_var_accounted["artifacts"])])

        cat("\n")
        cat("Correlation between ", es_type, " values and artifactual perturbations: ",  round2char(x$`cor(es, perturbations)`["total"], digits = digits), "\n", sep = "")
        cat((paste0("   Between ", es_type, " values and sampling error values: ", round2char(x$`cor(es, perturbations)`["sampling_error"], digits = digits), "\n"))[!is.na(x$`cor(es, perturbations)`["sampling_error"])])
        cat((paste0("   Between ", es_type, " values and other artifact values: ", round2char(x$`cor(es, perturbations)`["artifacts"], digits = digits), "\n"))[!is.na(x$`cor(es, perturbations)`["artifacts"])])

        cat("\n")
        cat("The reliability of observed effect sizes is: ", round2char(x$rel_es_obs), "\n", sep = "")

        cat("\n\n")
        cat("Random effects variance estimates")
        cat("\n---------------------------------\n")

        if (attributes(x)$revc_method == "HS") {
          cat("Hunter-Schmidt method:")
        } else {
          cat("Hunter-Schmidt method (with k-correction):")
        }
        cat("\n")
        cat("  ", sd_label, "  (tau):   ", round2char(x$HS_method$tau[1], digits = digits),
            ", SE = ", round2char(x$HS_method$tau[2], digits = digits), ", ",
            conf_level, "% CI = [", round2char(x$HS_method$tau[3], digits = digits, na_replace = "NA"),
            ", ", round2char(x$HS_method$tau[4], digits = digits, na_replace = "NA"), "] \n", sep = "")
        cat("  ", var_label, " (tau^2): ", round2char(x$HS_method$tau_squared[1], digits = digits),
            ", SE = ", round2char(x$HS_method$tau_squared[2], digits = digits), ", ",
            conf_level, "% CI = [", round2char(x$HS_method$tau_squared[3], digits = digits),
            ", ", round2char(x$HS_method$tau_squared[4], digits = digits), "] \n", sep = "")

        cat("\n")
        cat("  Q statistic: ", round2char(x$HS_method$Q[1], digits = digits), " (df = ",
            round2char(x$HS_method$Q[2], digits = 0), ", p = ",
            round2char(x$HS_method$Q[3], digits = digits), ") \n", sep = "")
        cat("  H: ", round2char(x$HS_method$H, digits = digits),
            "   H^2: ", round2char(x$HS_method$H_squared, digits = digits),
            "   I^2: ", round2char(x$HS_method$I_squared, digits = digits),  "\n", sep = "")

        if (attributes(x)$wt_source == "metafor") {
                wt_type <- attributes(x)$wt_type
                if (exists(paste(wt_type, "method", sep = "_"), x)) {
                        metafor <- get(paste(wt_type, "method", sep = "_"), x)

                        cat("\n")
                        cat(wt_type, "method:")
                        cat("\n")
                        cat("  ", sd_label, "  (tau):   ", round2char(metafor$tau[1], digits = digits),
                            ", SE = ", round2char(metafor$tau[2], digits = digits), ", ",
                            conf_level, "% CI = [", round2char(metafor$tau[3], digits = digits, na_replace = "NA"),
                            ", ", round2char(metafor$tau[4], digits = digits, na_replace = "NA"), "] \n", sep = "")
                        cat("  ", var_label, " (tau^2): ", round2char(metafor$tau_squared[1], digits = digits),
                            ", SE = ", round2char(metafor$tau_squared[2], digits = digits), ", ",
                            conf_level, "% CI = [", round2char(metafor$tau_squared[3], digits = digits),
                            ", ", round2char(metafor$tau_squared[4], digits = digits), "] \n", sep = "")

                        cat("\n")
                        cat("  Q statistic: ", round2char(metafor$Q[1], digits = digits), " (df = ",
                            round2char(metafor$Q[2], digits = 0), ", p = ",
                            round2char(metafor$Q[3], digits = digits), ") \n", sep = "")
                        cat("  H: ", round2char(metafor$H, digits = digits),
                            "   H^2: ", round2char(metafor$H_squared, digits = digits),
                            "   I^2: ", round2char(metafor$I_squared, digits = digits),  "\n", sep = "")
                }

        }

        if (!is.null(x$DL_method)) {
                cat("\n")
                cat("DerSimonian-Laird method:")
                cat("\n")
                cat("  ", sd_label, "  (tau):   ", round2char(x$DL_method$tau[1], digits = digits), "\n", sep = "")
                cat("  ", var_label, " (tau^2): ", round2char(x$DL_method$tau_squared[1], digits = digits), "\n", sep = "")

                cat("\n")
                cat("  Q statistic: ", round2char(x$DL_method$Q[1], digits = digits), "\n", sep = "")
                cat("  H: ", round2char(x$DL_method$H, digits = digits),
                    "   H^2: ", round2char(x$DL_method$H_squared, digits = digits),
                    "   I^2: ", round2char(x$DL_method$I_squared, digits = digits),  "\n", sep = "")
        }

        if (!is.null(x$outlier_robust_mean)) {
                cat("\n")
                cat("Outlier-robust method (absolute deviation from mean):")
                cat("\n")
                cat("  ", sd_label, "  (tau_r):   ", round2char(x$outlier_robust_mean$tau_r[1], digits = digits), "\n", sep = "")
                cat("  ", var_label, " (tau_r^2): ", round2char(x$outlier_robust_mean$tau_squared_r[1], digits = digits), "\n", sep = "")

                cat("\n")
                cat("  Q_r statistic: ", round2char(x$outlier_robust_mean$Q_r[1], digits = digits), "\n", sep = "")
                cat("  H_r: ", round2char(x$outlier_robust_mean$H_r, digits = digits),
                    "   H_r^2: ", round2char(x$outlier_robust_mean$H_squared_r, digits = digits),
                    "   I_r^2: ", round2char(x$outlier_robust_mean$I_squared_r, digits = digits),  "\n", sep = "")
        }

        if (!is.null(x$outlier_robust_median)) {
                cat("\n")
                cat("Outlier-robust method (absolute deviation from median):")
                cat("\n")
                cat("  ", sd_label, "  (tau_m):   ", round2char(x$outlier_robust_median$tau_m[1], digits = digits), "\n", sep = "")
                cat("  ", var_label, " (tau_m^2): ", round2char(x$outlier_robust_median$tau_squared_m[1], digits = digits), "\n", sep = "")

                cat("\n")
                cat("  Q_m statistic: ", round2char(x$outlier_robust_median$Q_m[1], digits = digits), "\n", sep = "")
                cat("  H_m: ", round2char(x$outlier_robust_median$H_m, digits = digits),
                    "   H_m^2: ", round2char(x$outlier_robust_median$H_squared_m, digits = digits),
                    "   I_m^2: ", round2char(x$outlier_robust_median$I_squared_m, digits = digits),  "\n", sep = "")
        }

        if (!is.null(x$file_drawer)) {
                cat("\n\n")
                cat("Failsafe k is ", ceiling(x$file_drawer[2]), " and failsafe N is ", ceiling(x$file_drawer[3]), " for failsafe ", es_type, " of ", round2char(x$file_drawer[1], digits = digits), ".\n", sep = "")
        }

        cat("\n")
        invisible(x)

}



#' @export
#' @keywords internal
#' @method print ma_leave1out
print.ma_leave1out <- function(x, ..., digits = 3){
        cat("Leave-one-out meta-analysis results \n")
        cat("---------------------------------------- \n")
        print.data.frame(x$data, digits = digits)
        x$sd_plot
        cat("\nSee the 'plots' list for data visualizations. \n")
        invisible(x)
}



#' @export
#' @keywords internal
#' @method print ma_cumulative
print.ma_cumulative <- function(x, ..., digits = 3){
        cat("Cumulative meta-analysis results \n")
        cat("---------------------------------------- \n")
        print.data.frame(x$data, digits = digits)
        cat("\nSee the 'plots' list for data visualizations. \n")
        invisible(x)
}



#' @export
#' @keywords internal
#' @method print ma_bootstrap
print.ma_bootstrap <- function(x, ..., digits = 3){
        cat("Bootstrapped meta-analysis results \n")
        cat("---------------------------------------- \n")
        print.data.frame(as.data.frame(x$boot_summary, stringsAsFactors = FALSE), digits = digits)
        cat("\nSee list item 'boot_data' for meta-analysis results from each bootstrap iteration \n")
        invisible(x)
}


####Print output of get_stuff functions ####

#' @export
#' @keywords internal
#' @method print get_metatab
print.get_metatab <- function(x, ..., digits = 3){
        cat("List of meta-analytic tables \n")
        cat("---------------------------------------- \n")
        cat("To view specific tables, use the '$' operator to search this list object. \n")
        cat("\n")
        cat("Meta-analyses available in this list are:\n")
        cat(attributes(x)$contents)
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_plots
print.get_plots <- function(x, ..., digits = 3){
        cat("List of meta-analysis plots \n")
        cat("---------------------------------------- \n")
        cat("To view plots, use the '$' operator to search this list object. \n")
        cat(paste0("For example, get_plots()$", names(x)[1], "\n"))
        cat("\n")
        cat("Plots available in this list are:", paste(names(x), collapse = ", "), "\n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_matrix
print.get_matrix <- function(x, ..., digits = 3){
        cat("Tibble of meta-analytic matrices \n")
        cat("---------------------------------------- \n")
        tab <- ungroup(x)
        class(tab) <- c("tbl_df", "tbl", "data.frame")
        print(tab, digits = digits)
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_escalc
print.get_escalc <- function(x, ..., digits = 3){
        cat("List of escalc objects \n")
        cat("---------------------------------------- \n")
        cat("To view specific escalc data frames, use the '$' operator to search this list object. \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_followup
print.get_followup <- function(x, ..., digits = 3){
        cat("List of meta-analytic follow-up analyses \n")
        cat("---------------------------------------- \n")
        cat("To view specific results, use the '$' operator to search this list object. \n")
        cat(paste0("For example, get_followup()$", names(x)[1], "\n"))
        cat("\n")
        cat("Analyses included in this list are:", paste(names(x), collapse = ", "), "\n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_heterogeneity
print.get_heterogeneity <- function(x, ..., digits = 3){
        cat("List of heterogeneity analyses \n")
        cat("---------------------------------------- \n")
        cat("To view specific results, use the '$' operator to search this list object. \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_metareg
print.get_metareg <- function(x, ..., digits = 3){
        cat("List of meta-regression analyses \n")
        cat("---------------------------------------- \n")
        cat("To view specific results, use the '$' operator to search this list object. \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_bootstrap
print.get_bootstrap <- function(x, ..., digits = 3){
        cat("List of bootstrap meta-analyses \n")
        cat("---------------------------------------- \n")
        cat("To view specific results, use the '$' operator to search this list object. \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_leave1out
print.get_leave1out <- function(x, ..., digits = 3){
        cat("List of leave-one-out meta-analyses \n")
        cat("---------------------------------------- \n")
        cat("To view specific results, use the '$' operator to search this list object. \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_cumulative
print.get_cumulative <- function(x, ..., digits = 3){
        cat("List of cumulative meta-analyses \n")
        cat("---------------------------------------- \n")
        cat("To view specific results, use the '$' operator to search this list object. \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print ad_list
print.ad_list <- function(x, ..., digits = 3){
        cat("List of artifact distributions \n")
        cat("---------------------------------------- \n")
        cat("To view specific results, use the '$' operator to search this list object. \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print get_ad
print.get_ad <- function(x, ..., digits = 3){
        cat("List of artifact-distributions\n")
        cat("------------------------------\n")
        cat("To view specific results, use the '$' operator to search this list object. \n")

        includes <- "\nThis object includes artifact distributions from the following meta-analytic methods:"
        .names <- names(x)
        .names <- .names[!unlist(map(x, is.null))]
        if("ic" %in% .names){
                includes <- c(includes, "\n- ic (distributions generated during individual-correction meta-analysis)")
                if("tsa" %in% names(x$ic)) includes <- c(includes, "\n     - tsa (Taylor-series approximation distributions)")
                if("int" %in% names(x$ic)) includes <- c(includes, "\n     - int (Interactive distributions)")
        }
        if("ad" %in% .names) includes <- c(includes, "\n- ad (distributions used to make artifact-distribution corrections)")

        cat(includes)
        invisible(x)

}


#' @export
#' @keywords internal
#' @method print ma_psychmeta
print.ma_psychmeta <- function(x, ..., digits = 3, n = nrow(x), width = NULL, n_extra = NULL){
        ma_method <- attributes(x)$ma_method
        correction_type <- attributes(x)$correction_type
        ma_metric <- attributes(x)$ma_metric

        additional_args <- list(...)
        suppress_title <- additional_args$suppress_title
        if(is.null(suppress_title)) suppress_title <- FALSE

        title_text <- "Overview tibble of psychmeta meta-analysis"
        if(ma_metric == "r_as_r" | ma_metric == "d_as_r"){
                title_text <- "Overview tibble of psychmeta meta-analysis of correlations"
        }else if(ma_metric == "r_as_d" | ma_metric == "d_as_d"){
                title_text <- "Overview tibble of psychmeta meta-analysis of d values"
        }else if(ma_metric == "generic"){
                title_text <- "Overview tibble of psychmeta meta-analysis of generic effect sizes"
        }else if(ma_metric == "r_order2"){
                title_text <- "Overview tibble of psychmeta second-order meta-analysis of correlations"
        }else if(ma_metric == "d_order2"){
                title_text <- "Overview tibble of psychmeta second-order meta-analysis of d values"
        }

        if(!suppress_title){
                cat(title_text, " \n")
                cat("---------------------------------------------------------------------- \n")
        }
        tab <- ungroup(x)
        class(tab) <- c("tbl_df", "tbl", "data.frame")
        print(tab)

        cat("\nTo extract results, try summary() or the get_stuff functions (run ?get_stuff for help). \n")
        invisible(x)
}


#' @export
#' @keywords internal
#' @method print ad_tibble
print.ad_tibble <- function(x, ..., digits = 3, n = nrow(x), width = NULL, n_extra = NULL){

        additional_args <- list(...)
        suppress_title <- additional_args$suppress_title
        if(is.null(suppress_title)) suppress_title <- FALSE

        if(!suppress_title){
                cat("Tibble of artifact distributions \n")
                cat("-------------------------------- \n")
        }
        tab <- ungroup(x)
        class(tab) <- c("tbl_df", "tbl", "data.frame")
        print(tab, n = n, width = width, n_extra = n_extra)
        invisible(x)
}


#' @export
#' @method print ma_table
print.ma_table <- function(x, ..., digits = 3, verbose = FALSE){
        ma_type <- attributes(x)$ma_type

        additional_args <- list(...)
        suppress_title <- additional_args$suppress_title
        if(is.null(suppress_title)) suppress_title <- FALSE

        if(ma_type == "r_bb"){
                full_names <- c("mean_r", "var_r", "var_e", "var_res", "sd_r", "se_r", "sd_e", "sd_res")
                verbose_names <- c("mean_r", "sd_r", "se_r", "sd_e", "sd_res")
                succinct_names <- c("mean_r", "sd_r", "se_r", "sd_res")
        }
        if(ma_type == "r_ic"){
                full_names <- c("mean_r", "var_r", "var_e", "var_res", "sd_r", "se_r", "sd_e", "sd_res",
                                "mean_rho", "var_r_c", "var_e_c", "var_rho", "sd_r_c", "se_r_c", "sd_e_c", "sd_rho")
                verbose_names <- c("mean_r", "sd_r", "se_r", "sd_e", "sd_res",
                                   "mean_rho", "sd_r_c", "se_r_c", "sd_e_c", "sd_rho")
                succinct_names <- c("mean_r", "sd_r", "se_r", "sd_res",
                                    "mean_rho", "sd_r_c", "se_r_c", "sd_rho")
        }
        if(ma_type == "r_ad"){
                full_names <- c("mean_r", "var_r", "var_e", "var_art", "var_pre", "var_res", "sd_r", "se_r", "sd_e", "sd_art", "sd_pre", "sd_res",
                                "mean_rho", "var_r_c", "var_e_c", "var_art_c", "var_pre_c", "var_rho", "sd_r_c", "se_r_c", "sd_e_c", "sd_art_c", "sd_pre_c", "sd_rho")
                verbose_names <- c("mean_r", "sd_r", "se_r", "sd_e", "sd_art", "sd_pre", "sd_res",
                                   "mean_rho", "sd_r_c", "se_r_c", "sd_e_c", "sd_art_c", "sd_pre_c", "sd_rho")
                succinct_names <- c("mean_r", "sd_r", "se_r", "sd_res",
                                    "mean_rho", "sd_r_c", "se_r_c", "sd_rho")
        }


        if(ma_type == "d_bb"){
                full_names <- c("mean_d", "var_d", "var_e", "var_res", "sd_d", "se_d", "sd_e", "sd_res")
                verbose_names <- c("mean_d", "sd_d", "se_d", "sd_e", "sd_res")
                succinct_names <- c("mean_d", "sd_d", "se_d", "sd_res")
        }
        if(ma_type == "d_ic"){
                full_names <- c("mean_d", "var_d", "var_e", "var_res", "sd_d", "se_d", "sd_e", "sd_res",
                                "mean_delta", "var_d_c", "var_e_c", "var_delta", "sd_d_c", "se_d_c", "sd_e_c", "sd_delta")
                verbose_names <- c("mean_d", "sd_d", "se_d", "sd_e", "sd_res",
                                   "mean_delta", "sd_d_c", "se_d_c", "sd_e_c", "sd_delta")
                succinct_names <- c("mean_d", "sd_d", "se_d", "sd_res",
                                    "mean_delta", "sd_d_c", "se_d_c", "sd_delta")
        }
        if(ma_type == "d_ad"){
                full_names <- c("mean_d", "var_d", "var_e", "var_art", "var_pre", "var_res", "sd_d", "se_d", "sd_e", "sd_art", "sd_pre", "sd_res",
                                "mean_delta", "var_d_c", "var_e_c", "var_art_c", "var_pre_c", "var_delta", "sd_d_c", "se_r_c", "sd_e_c", "sd_art_c", "sd_pre_c", "sd_delta")
                verbose_names <- c("mean_d", "sd_d", "se_d", "sd_e", "sd_art", "sd_pre", "sd_res",
                                   "mean_delta", "sd_d_c", "se_r_c", "sd_e_c", "sd_art_c", "sd_pre_c", "sd_delta")
                succinct_names <- c("mean_d", "sd_d", "se_d", "sd_res",
                                    "mean_delta", "sd_d_c", "se_r_c", "sd_delta")
        }


        if(ma_type == "generic_bb"){
                full_names <- c("mean_es", "var_es", "var_e", "var_res", "sd_es", "se_es", "sd_e", "sd_res")
                verbose_names <- c("mean_es", "sd_es", "se_es", "sd_e", "sd_res")
                succinct_names <- c("mean_es", "sd_es", "se_es", "sd_res")
        }


        if(ma_type == "r_bb_order2"){
                full_names <- c("mean_r_bar", "var_r_bar", "var_e", "var_r_bar_res", "sd_r_bar", "se_r_bar", "sd_e", "sd_r_bar_res")
                verbose_names <- c("mean_r_bar", "sd_r_bar", "se_r_bar", "sd_e", "sd_r_bar_res")
                succinct_names <- c("mean_r_bar", "sd_r_bar", "se_r_bar", "sd_r_bar_res")
        }
        if(ma_type == "r_ic_order2"){
                full_names <- c("mean_rho_bar", "var_rho_bar", "var_e", "var_rho_bar_res", "sd_rho_bar", "se_rho_bar", "sd_e", "sd_rho_bar_res")
                verbose_names <- c("mean_rho_bar", "sd_rho_bar", "se_rho_bar", "sd_e", "sd_rho_bar_res")
                succinct_names <- c("mean_rho_bar", "sd_rho_bar", "se_rho_bar", "sd_rho_bar_res")
        }
        if(ma_type == "r_ad_order2"){
                full_names <- c("mean_rho_bar", "var_rho_bar", "var_e", "var_rho_bar_res", "sd_rho_bar", "se_rho_bar", "sd_e", "sd_rho_bar_res")
                verbose_names <- c("mean_rho_bar", "sd_rho_bar", "se_rho_bar", "sd_e", "sd_rho_bar_res")
                succinct_names <- c("mean_rho_bar", "sd_rho_bar", "se_rho_bar", "sd_rho_bar_res")
        }


        if(ma_type == "d_bb_order2"){
                full_names <- c("mean_d_bar", "var_d_bar", "var_e", "var_d_bar_res", "sd_d_bar", "se_d_bar", "sd_e", "sd_d_bar_res")
                verbose_names <- c("mean_d_bar", "sd_d_bar", "se_d_bar", "sd_e", "sd_d_bar_res")
                succinct_names <- c("mean_d_bar", "sd_d_bar", "se_d_bar", "sd_d_bar_res")
        }
        if(ma_type == "d_ic_order2"){
                full_names <- c("mean_delta_bar", "var_delta_bar", "var_e", "var_delta_bar_res", "sd_delta_bar", "se_delta_bar", "sd_e", "sd_delta_bar_res")
                verbose_names <- c("mean_delta_bar", "sd_delta_bar", "se_delta_bar", "sd_e", "sd_delta_bar_res")
                succinct_names <- c("mean_delta_bar", "sd_delta_bar", "se_delta_bar", "sd_delta_bar_res")
        }
        if(ma_type == "d_ad_order2"){
                full_names <- c("mean_delta_bar", "var_delta_bar", "var_e", "var_delta_bar_res", "sd_delta_bar", "se_delta_bar", "sd_e", "sd_delta_bar_res")
                verbose_names <- c("mean_delta_bar", "sd_delta_bar", "se_delta_bar", "sd_e", "sd_delta_bar_res")
                succinct_names <- c("mean_delta_bar", "sd_delta_bar", "se_delta_bar", "sd_delta_bar_res")
        }

        .colnames <- colnames(x)
        leading_cols <- 1:max(which(.colnames == "N"))
        trailing_cols <- which(grepl(x = .colnames, pattern = "CI_LL_") | grepl(x = .colnames, pattern = "CI_UL_") | grepl(x = .colnames, pattern = "CR_LL_") | grepl(x = .colnames, pattern = "CR_UL_"))
        trailing_cols <- trailing_cols[trailing_cols > max(leading_cols)]

        if(verbose){
                middle_cols <- which(.colnames %in% verbose_names)
        }else{
                middle_cols <- which(.colnames %in% succinct_names)
        }

        if(!suppress_title)
                cat("Meta-analysis table \n")

        tab <- as.data.frame(x)
        print(tab[,c(leading_cols, middle_cols, trailing_cols)], digits = digits)
        invisible(x)
}



#' @export
#' @keywords internal
#' @method print ma_ic_list
print.ma_ic_list <- function(x, ..., digits = 3){
        cat("Individual-correction meta-analysis results")
        if(any(names(x) == "true_score")){
                cat("\nFully corrected \n")
                print(x$true_score, suppress_title = TRUE)
                cat("\nWith measurement error in X \n")
                print(x$validity_generalization_x, suppress_title = TRUE)
                cat("\nWith measurement error in Y \n")
                print(x$validity_generalization_y, suppress_title = TRUE)
        }else{
                cat("\nFully corrected \n")
                print(x$latentGroup_latentY, suppress_title = TRUE)
                cat("\nWith measurement error in X \n")
                print(x$observedGroup_latentY, suppress_title = TRUE)
                cat("\nWith measurement error in Y \n")
                print(x$latentGroup_observedY, suppress_title = TRUE)
        }
        invisible(x)
}



#' @export
#' @keywords internal
#' @method print ma_ad_list
print.ma_ad_list <- function(x, ..., digits = 3){
        cat("Artifact-distribution meta-analysis results")
        if(any(names(x) == "true_score")){
                cat("\nFully corrected \n")
                print(x$true_score, suppress_title = TRUE)
                cat("\nWith measurement error in X \n")
                print(x$validity_generalization_x, suppress_title = TRUE)
                cat("\nWith measurement error in Y \n")
                print(x$validity_generalization_y, suppress_title = TRUE)
        }else{
                cat("\nFully corrected \n")
                print(x$latentGroup_latentY, suppress_title = TRUE)
                cat("\nWith measurement error in X \n")
                print(x$observedGroup_latentY, suppress_title = TRUE)
                cat("\nWith measurement error in Y \n")
                print(x$latentGroup_observedY, suppress_title = TRUE)
        }
        invisible(x)
}




#' @export
#' @method print summary.ma_psychmeta
print.summary.ma_psychmeta <- function(x, ..., ma_methods = NULL, correction_types = "ts",
                                       verbose = FALSE, digits = 3){

        ma_obj <- x$ma_obj
        meta_tables <- x$meta_tables
        ma_metric <- x$ma_metric
        correction_titles <- x$correction_titles
        correction_labels <- x$correction_labels
        method_details <- x$method_details

        if(!is.null(ma_methods)){
                if(!all(ma_methods %in% x$ma_methods)){
                        stop("Supplied 'ma_methods' not represented in the summary x")
                }
        }else{
                ma_methods <- (c("ad", "ic", "bb")[c("ad", "ic", "bb") %in% x$ma_methods])[1]
        }

        if(any(c("ic", "ad") %in% ma_methods))
                if(!is.null(correction_types)){
                        if(!all(correction_types %in% c("ts", "vgx", "vgy"))){
                                stop("Supplied 'correction_types' not represented in the summary object", call. = FALSE)
                        }
                }else{
                        correction_types <- "ts"
                }

        ts_title <- correction_titles$ts
        vgx_title <- correction_titles$vgx
        vgy_title <- correction_titles$vgy

        ts_label <- correction_labels$ts
        vgx_label <- correction_labels$vgx
        vgy_label <- correction_labels$vgy

        correction_types_ic <- correction_types_ad <- correction_types

        if("bb" %in% ma_methods){
                if(ma_metric %in% c("r_order2", "d_order2")){
                        cat("Second-order bare-bones meta-analysis results \n")
                }else{
                        cat("Bare-bones meta-analysis results \n")
                }
                cat("---------------------------------------------------------------------- \n")
                print(meta_tables$barebones,
                      suppress_title = TRUE, verbose = verbose, digits = digits)
        }

        if("ic" %in% ma_methods){
                if(length(unlist(correction_labels)) == 0){
                        if(ma_metric %in% c("r_order2", "d_order2")){
                                cat("\nSecond-order individual-correction meta-analysis results \n")
                        }else{
                                cat("\nIndividual-correction meta-analysis results \n")
                        }
                        cat("---------------------------------------------------------------------- \n")
                        print(meta_tables$individual_correction,
                              suppress_title = TRUE, verbose = verbose, digits = digits)
                }else{
                        cat("\nIndividual-correction meta-analysis results \n")
                        cat("----------------------------------------------------------------------")

                        if("ts" %in% correction_types_ic){
                                cat(ts_title)
                                print(meta_tables$individual_correction[[ts_label]],
                                      suppress_title = TRUE, verbose = verbose, digits = digits)
                        }

                        if("vgx" %in% correction_types_ic){
                                cat(vgx_title)
                                print(meta_tables$individual_correction[[vgx_label]],
                                      suppress_title = TRUE, verbose = verbose, digits = digits)
                        }

                        if("vgy" %in% correction_types_ic){
                                cat(vgy_title)
                                print(meta_tables$individual_correction[[vgy_label]],
                                      suppress_title = TRUE, verbose = verbose, digits = digits)
                        }

                        cat("\n")
                        cat("\nSummary of correction methods \n")

                        method_details$ic$Correction <- as.character(method_details$ic$Correction)
                        if(nrow(method_details$ic) > 1 & all(method_details$ic$Correction == method_details$ic$Correction[1])){
                                .method_details <- data.frame(analysis_id = "All", Correction = method_details$ic$Correction[1], stringsAsFactors = FALSE)
                                print(.method_details)
                        }else{
                                print(method_details$ic)
                        }

                }
        }


        if("ad" %in% ma_methods){

                if(length(unlist(correction_labels)) == 0){
                        if(ma_metric %in% c("r_order2", "d_order2")){
                                cat("\nSecond-order artifact-distribution meta-analysis results \n")
                        }else{
                                cat("\nArtifact-distribution meta-analysis results \n")
                        }
                        cat("---------------------------------------------------------------------- \n")
                        print(meta_tables$artifact_distribution,
                              suppress_title = TRUE, verbose = verbose, digits = digits)
                }else{
                        cat("\nArtifact-distribution meta-analysis results \n")
                        cat("----------------------------------------------------------------------")

                        if("ts" %in% correction_types_ad){
                                cat(ts_title)
                                print(meta_tables$artifact_distribution[[ts_label]],
                                      suppress_title = TRUE, verbose = verbose, digits = digits)
                        }

                        if("vgx" %in% correction_types_ad){
                                cat(vgx_title)
                                print(meta_tables$artifact_distribution[[vgx_label]],
                                      suppress_title = TRUE, verbose = verbose, digits = digits)
                        }

                        if("vgy" %in% correction_types_ad){
                                cat(vgy_title)
                                print(meta_tables$artifact_distribution[[vgy_label]],
                                      suppress_title = TRUE, verbose = verbose, digits = digits)
                        }

                        cat("\n")
                        cat("\nSummary of correction methods \n")
                        for(i in 2:4) method_details$ad[,i] <- paste0("     ", method_details$ad[,i])

                        .ad_corrections <- apply(method_details$ad[,-1], 1, paste, collapse = "")

                        if(length(.ad_corrections) > 1 & all(.ad_corrections == .ad_corrections[1])){
                                .method_details <- cbind(analysis_id = "All", method_details$ad[1,-1])
                                print(.method_details)
                        }else{
                                print(method_details$ad)
                        }

                }
        }

        .cols <- colnames(ma_obj)
        .cols <- .cols[which(.cols == "meta_tables"):length(.cols)]

        .cols[.cols == "meta_tables"]   <- paste("meta_tables   [ access using get_metatab() ]")
        .cols[.cols == "escalc"]        <- paste("escalc        [ access using get_escalc() ]")
        .cols[.cols == "ad"]            <- paste("ad            [ access using get_ad() ]")

        .cols[.cols == "bootstrap"]     <- paste("bootstrap     [ access using get_bootstrap() ]")
        .cols[.cols == "cumulative"]    <- paste("cumulative    [ access using get_cumulative() ]")
        .cols[.cols == "leave1out"]     <- paste("leave1out     [ access using get_leave1out() ]")

        .cols[.cols == "heterogeneity"] <- paste("heterogeneity [ access using get_heterogeneity() ]")

        .cols[.cols == "metareg"]       <- paste("metareg       [ access using get_metareg() ]")

        .cols[.cols == "funnel"]        <- paste("funnel        [ access using get_plots() ]")
        .cols[.cols == "forest"]        <- paste("forest        [ access using get_plots() ]")

        cat("\n")
        cat("\nInformation available in the meta-analysis object includes:\n", paste0(paste("-", .cols), "\n"))
        invisible(x)
}


#' @export
#' @method print metabulate
print.metabulate <- function(x, ...){
        for(i in names(x)) {
                if(!is.null(attr(x[[i]], "caption"))) {
                        cat(attr(x[[i]], "caption"), "\n", rep("=", nchar(attr(x[[i]], "caption"))), "\n", sep="")
                }
                print(x[[i]])
                cat("\n", attr(x[[i]], "footnote"), "\n\n")
        }

}

#' @export
#' @method print metabulate_table
print.metabulate_table <- function(x, ...){
        print(as.data.frame(x, stringsAsFactors = FALSE))
}

#' @export
#' @method print anova.ma_psychmeta
print.anova.ma_psychmeta <- function(x, ..., digits = 3) {
        tab <- as.data.frame(x)
        print(tab, digits = digits)
        invisible(x)
}