Nothing
#' @title Plot multiple histograms of STRAPP test statistics over time-steps
#'
#' @description Plot an histogram of the distribution of the test statistics
#' obtained from a deepSTRAPP workflow carried out for each focal time in `$time_steps`.
#' Main input = output of a deepSTRAPP run over time using [deepSTRAPP::run_deepSTRAPP_over_time()]).
#'
#' Returns one histogram for overall tests for each focal time in `$time_steps`.
#' If `plot_posthoc_tests = TRUE`, it will return one faceted plot with an histogram
#' per post hoc tests for each focal time in `$time_steps`.
#'
#' If a PDF file path is provided in `PDF_file_path`, the plots will be saved directly in a PDF file,
#' with one page per focal time in `$time_steps`.
#'
#' @param deepSTRAPP_outputs List of elements generated with [deepSTRAPP::run_deepSTRAPP_over_time()],
#' that summarize the results of multiple deepSTRAPP across `$time_steps`. It needs to include the `$STRAPP_results_over_time`
#' element with `$perm_data_df` obtained when setting both `return_STRAPP_results = TRUE` and `return_perm_data = TRUE`.
#' @param display_plots Logical. Whether to display the histograms generated in the R console. Default is `TRUE`.
#' @param plot_posthoc_tests Logical. For multinominal data only. Whether to plot the histograms for the overall Kruskal-Wallis test across all states (`plot_posthoc_tests = FALSE`),
#' or plot the histograms for all the pairwise post hoc Dunn's tests across pairs of states (`plot_posthoc_tests = TRUE`).
#' Time-steps at which the data does not yield more than two states/ranges will show a warning and generate no plot. Default is `FALSE`.
#' @param PDF_file_path Character string. If provided, the plots will be saved in a unique PDF file following the path provided here. The path must end with ".pdf".
#' Each page of the PDF corresponds to a focal time in `$time_steps`.
#'
#' @export
#' @importFrom ggplot2 ggplot geom_histogram aes geom_vline labs ggtitle theme element_line element_rect element_text unit margin annotate annotation_custom
#' @importFrom grid gpar
#' @importFrom cowplot plot_grid save_plot
#' @importFrom grDevices pdf dev.off
#'
#' @details The main input `deepSTRAPP_outputs` is the typical output of [deepSTRAPP::run_deepSTRAPP_over_time()].
#' It provides information on results of a STRAPP tests performed over multiple time-steps.
#'
#' Histograms are built based on the distribution of the test statistics.
#' Such distributions are recorded in the outputs of a deepSTRAPP run carried out with [deepSTRAPP::run_deepSTRAPP_over_time()]
#' when `return_STRAPP_results = TRUE` AND `return_perm_data = TRUE`. The `$STRAPP_results_over_time` objects provided within the input are lists that must contain
#' a `$perm_data_df` element that summarizes test statistics computed across posterior samples.
#'
#' For multinominal data (categorical or biogeographic data with more than 2 states), it is possible to plot the histograms of post hoc pairwise tests.
#' Set `plot_posthoc_tests = TRUE` to generate histograms for all the pairwise post hoc Dunn's test across pairs of states.
#' To achieve this, the `$STRAPP_results_over_time` objects must contain a `$posthoc_pairwise_tests$perm_data_array` element that summarizes test statistics
#' computed across posterior samples for all pairwise post hoc tests. This is obtained from [deepSTRAPP::run_deepSTRAPP_over_time()] when setting
#' `return_STRAPP_results = TRUE` to return the STRAPP results, `posthoc_pairwise_tests = TRUE` to carry out post hoc tests,
#' and `return_perm_data = TRUE` to record distributions of test statistics.
#' Time-steps for which the data do not yield more than two states/ranges will show a warning and generate no plot.
#'
#' @return By default, the function returns a list of sub-lists of classes `gg` and `ggplot` ordered as in `$time_steps`.
#' Each sub-list corresponds to a ggplot for a given `focal_time` `i` that can be displayed on the console with `print(output[[i]])`.
#' If `display_plots = TRUE`, the histograms are being displayed on the console one by one while generated.
#'
#' If using multinominal data and set `plot_posthoc_tests = TRUE`, the function will return a list of sub-lists of objects ordered as in `$time_steps`.
#' Each sub-list is a list of the ggplots associated with pairwise post hoc tests carried out for this a given `focal_time`.
#' For a given `focal_time` i, to plot each histogram j individually, use `print(output_list[[i]][[j]])`.
#' To plot all histograms of a given `focal_time` `i` at once in a multifaceted plot, as displayed sequentially on the console if `display_plots = TRUE`,
#' use `cowplot::plot_grid(plotlist = output_list[[i]])`.
#'
#' Each plot also displays summary statistics for the STRAPP test associated with the data displayed.
#' * The quantile of null statistic distribution at the significant threshold used to define test significance. This is the value found on the red dashed line.
#' The test will be considered significant (i.e., the null hypothesis is rejected) if this value is higher than zero (the black dashed line).
#' * The p-value of the STRAPP test which correspond the proportion of cases in which the statistics was lower than expected under the null hypothesis
#' (i.e., the proportion of the histogram found below / on the left-side of the black dashed line).
#'
#' If a `PDF_file_path` is provided, the function will also generate a PDF file of the plots with one page per `$time_steps`.
#' For post hoc tests, this will save the multifaceted plots.
#'
#' @author Maël Doré
#'
#' @seealso Associated functions in deepSTRAPP: [deepSTRAPP::run_deepSTRAPP_over_time()] [deepSTRAPP::plot_histogram_STRAPP_test_for_focal_time()]
#'
#' @examples
#' if (deepSTRAPP::is_dev_version())
#' {
#' # ----- Example 1: Continuous trait ----- #
#'
#' # Load fake trait df
#' data(Ponerinae_trait_tip_data, package = "deepSTRAPP")
#' # Load phylogeny with old calibration
#' data(Ponerinae_tree_old_calib, package = "deepSTRAPP")
#'
#' # Load the BAMM_object summarizing 1000 posterior samples of BAMM
#' data(Ponerinae_BAMM_object_old_calib, package = "deepSTRAPP")
#' ## This dataset is only available in development versions installed from GitHub.
#' # It is not available in CRAN versions.
#' # Use remotes::install_github(repo = "MaelDore/deepSTRAPP") to get the latest development version.
#'
#' ## Prepare trait data
#'
#' # Extract continuous trait data as a named vector
#' Ponerinae_cont_tip_data <- setNames(object = Ponerinae_trait_tip_data$fake_cont_tip_data,
#' nm = Ponerinae_trait_tip_data$Taxa)
#'
#' # Select a color scheme from lowest to highest values
#' color_scale = c("darkgreen", "limegreen", "orange", "red")
#'
#' # Get Ancestral Character Estimates based on a Brownian Motion model
#' # To obtain values at internal nodes
#' Ponerinae_ACE <- phytools::fastAnc(tree = Ponerinae_tree_old_calib, x = Ponerinae_cont_tip_data)
#'
#' \donttest{ # (May take several minutes to run)
#' # Run a Stochastic Mapping based on a Brownian Motion model
#' # to interpolate values along branches and obtain a "contMap" object
#' Ponerinae_contMap <- phytools::contMap(Ponerinae_tree, x = Ponerinae_cont_tip_data,
#' res = 100, # Number of time steps
#' plot = FALSE)
#' # Plot contMap = stochastic mapping of continuous trait
#' plot_contMap(contMap = Ponerinae_contMap,
#' color_scale = color_scale)
#'
#' ## Set for time steps of 5 My. Will generate deepSTRAPP workflows for 0 to 40 Mya.
#' # nb_time_steps <- 5
#' time_step_duration <- 5
#' time_range <- c(0, 40)
#'
#' ## Run deepSTRAPP on net diversification rates
#' Ponerinae_deepSTRAPP_cont_old_calib_0_40 <- run_deepSTRAPP_over_time(
#' contMap = Ponerinae_contMap,
#' ace = Ponerinae_ACE,
#' tip_data = Ponerinae_cont_tip_data,
#' trait_data_type = "continuous",
#' BAMM_object = Ponerinae_BAMM_object_old_calib,
#' # nb_time_steps = nb_time_steps,
#' time_range = time_range,
#' time_step_duration = time_step_duration,
#' return_perm_data = TRUE,
#' extract_trait_data_melted_df = TRUE,
#' extract_diversification_data_melted_df = TRUE,
#' return_STRAPP_results = TRUE,
#' return_updated_trait_data_with_Map = TRUE,
#' return_updated_BAMM_object = TRUE,
#' verbose = TRUE,
#' verbose_extended = TRUE) }
#'
#' ## Load directly trait data output
#' data(Ponerinae_deepSTRAPP_cont_old_calib_0_40, package = "deepSTRAPP")
#' ## This dataset is only available in development versions installed from GitHub.
#' # It is not available in CRAN versions.
#' # Use remotes::install_github(repo = "MaelDore/deepSTRAPP") to get the latest development version.
#'
#' ## Plot histograms of STRAPP overall test results
#' # Tests are Spearman's rank correlation tests
#'
#' # Plot all histograms
#' histogram_ggplots <- plot_histograms_STRAPP_tests_over_time(
#' deepSTRAPP_outputs = Ponerinae_deepSTRAPP_cont_old_calib_0_40,
#' display_plot = TRUE,
#' # PDF_file_path = "./plot_STRAPP_histogram_overall_test.pdf",
#' plot_posthoc_tests = FALSE)
#'
#' # Print histogram for time step 1 = 0 My
#' print(histogram_ggplots[[1]])
#' # Adjust aesthetics of plot for time step 1 a posteriori
#' histogram_ggplot_adj <- histogram_ggplots[[1]] +
#' ggplot2::theme(plot.title = ggplot2::element_text(color = "red", size = 15))
#' print(histogram_ggplot_adj)
#'
#' # ----- Example 2: Categorical data ----- #
#'
#' ## Load data
#'
#' # Load trait df
#' data(Ponerinae_trait_tip_data, package = "deepSTRAPP")
#' # Load phylogeny
#' data(Ponerinae_tree_old_calib, package = "deepSTRAPP")
#'
#' # Load the BAMM_object summarizing 1000 posterior samples of BAMM
#' data(Ponerinae_BAMM_object_old_calib, package = "deepSTRAPP")
#' ## This dataset is only available in development versions installed from GitHub.
#' # It is not available in CRAN versions.
#' # Use remotes::install_github(repo = "MaelDore/deepSTRAPP") to get the latest development version.
#'
#' ## Prepare trait data
#'
#' # Extract categorical data with 3-levels
#' Ponerinae_cat_3lvl_tip_data <- setNames(object = Ponerinae_trait_tip_data$fake_cat_3lvl_tip_data,
#' nm = Ponerinae_trait_tip_data$Taxa)
#' table(Ponerinae_cat_3lvl_tip_data)
#'
#' # Select color scheme for states
#' colors_per_states <- c("forestgreen", "sienna", "goldenrod")
#' names(colors_per_states) <- c("arboreal", "subterranean", "terricolous")
#'
#' \donttest{ # (May take several minutes to run)
#' ## Produce densityMaps using stochastic character mapping based on an ARD Mk model
#' Ponerinae_cat_3lvl_data_old_calib <- prepare_trait_data(
#' tip_data = Ponerinae_cat_3lvl_tip_data,
#' phylo = Ponerinae_tree_old_calib,
#' trait_data_type = "categorical",
#' colors_per_levels = colors_per_states,
#' evolutionary_models = "ARD",
#' nb_simulations = 100,
#' return_best_model_fit = TRUE,
#' return_model_selection_df = TRUE,
#' plot_map = FALSE) }
#'
#' # Load directly trait data output
#' data(Ponerinae_cat_3lvl_data_old_calib, package = "deepSTRAPP")
#'
#' ## Set for time steps of 5 My. Will generate deepSTRAPP workflows for 0 to 40 Mya.
#' # nb_time_steps <- 5
#' time_step_duration <- 5
#' time_range <- c(0, 40)
#'
#' \donttest{ # (May take several minutes to run)
#' ## Run deepSTRAPP on net diversification rates across time-steps.
#' Ponerinae_deepSTRAPP_cat_3lvl_old_calib_0_40 <- run_deepSTRAPP_over_time(
#' densityMaps = Ponerinae_cat_3lvl_data_old_calib$densityMaps,
#' ace = Ponerinae_cat_3lvl_data_old_calib$ace,
#' tip_data = Ponerinae_cat_3lvl_tip_data,
#' trait_data_type = "categorical",
#' BAMM_object = Ponerinae_BAMM_object_old_calib,
#' # nb_time_steps = nb_time_steps,
#' time_range = time_range,
#' time_step_duration = time_step_duration,
#' rate_type = "net_diversification",
#' seed = 1234, # Set for reproducibility
#' alpha = 0.10, # Select a generous level of significance for the sake of the example
#' posthoc_pairwise_tests = TRUE,
#' return_perm_data = TRUE,
#' extract_trait_data_melted_df = TRUE,
#' extract_diversification_data_melted_df = TRUE,
#' return_STRAPP_results = TRUE,
#' return_updated_trait_data_with_Map = TRUE,
#' return_updated_BAMM_object = TRUE,
#' verbose = TRUE,
#' verbose_extended = TRUE) }
#'
#' ## Load directly deepSTRAPP output
#' data(Ponerinae_deepSTRAPP_cat_3lvl_old_calib_0_40, package = "deepSTRAPP")
#' ## This dataset is only available in development versions installed from GitHub.
#' # It is not available in CRAN versions.
#' # Use remotes::install_github(repo = "MaelDore/deepSTRAPP") to get the latest development version.
#'
#' ## Explore output
#' str(Ponerinae_deepSTRAPP_cat_3lvl_old_calib_0_40, max.level = 1)
#'
#' ## Plot histograms of STRAPP overall test results #
#' # Tests are Kruskall-Wallis H tests when more than two states/ranges are present.
#' # Tests are Mann–Whitney–Wilcoxon rank-sum tests when only two states/ranges are present.
#'
#' histogram_ggplots <- plot_histograms_STRAPP_tests_over_time(
#' deepSTRAPP_outputs = Ponerinae_deepSTRAPP_cat_3lvl_old_calib_0_40,
#' display_plot = TRUE,
#' # PDF_file_path = "./plot_STRAPP_histograms_overall_tests.pdf",
#' plot_posthoc_tests = FALSE)
#'
#' # Print histogram for time step 1 = 0 My
#' print(histogram_ggplots[[1]])
#' # Adjust aesthetics of plot for time step 1 a posteriori
#' histogram_ggplot_adj <- histogram_ggplots[[1]] +
#' ggplot2::theme(plot.title = ggplot2::element_text(color = "red", size = 15))
#' print(histogram_ggplot_adj)
#'
#' ## Plot histograms of STRAPP post hoc test results ------ #
#' # Tests are Dunn's multiple comparison pairwise post hoc tests possible
#' # only when more than two states/ranges are present.
#'
#' histograms_ggplots_list <- plot_histograms_STRAPP_tests_over_time(
#' deepSTRAPP_outputs = Ponerinae_deepSTRAPP_cat_3lvl_old_calib_0_40,
#' display_plot = TRUE,
#' # PDF_file_path = "./plot_STRAPP_histograms_posthoc_tests.pdf",
#' plot_posthoc_tests = TRUE)
#'
#' # Print all histograms for time step 1 (= 0 My) one by one
#' print(histograms_ggplots_list[[1]])
#' # Plot all histograms for time step 1 (= 0 My) on one faceted plot
#' cowplot::plot_grid(plotlist = histograms_ggplots_list[[1]])
#' }
#'
plot_histograms_STRAPP_tests_over_time <- function (
deepSTRAPP_outputs,
display_plots = TRUE,
plot_posthoc_tests = FALSE,
PDF_file_path = NULL)
{
### Check input validity
{
## deepSTRAPP_outputs$STRAPP_results_over_time
# deepSTRAPP_outputs must have element $STRAPP_results_over_time
if (is.null(deepSTRAPP_outputs$STRAPP_results_over_time))
{
stop(paste0("'$STRAPP_results_over_time' is missing from 'deepSTRAPP_outputs'. You can inspect the structure of the input object with 'str(deepSTRAPP_outputs, 2)'.\n",
"See ?deepSTRAPP::run_deepSTRAPP_over_time() to learn how to generate those objects.\n",
"Especially, check if you used 'return_STRAPP_results = TRUE' to save the STRAPP_results for each time step needed for the histogram plots."))
}
## deepSTRAPP_outputs$time_steps
# deepSTRAPP_outputs must have element $time_steps
if (is.null(deepSTRAPP_outputs$time_steps))
{
stop(paste0("'$time_steps' is missing from 'deepSTRAPP_outputs'. You can inspect the structure of the input object with 'str(deepSTRAPP_outputs, 2)'.\n",
"See ?deepSTRAPP::run_deepSTRAPP_over_time() to learn how to generate those objects."))
}
# Extract $focal_time from deepSTRAPP_outputs$STRAPP_results_over_time
focal_time_list <- unlist(lapply(X = deepSTRAPP_outputs$STRAPP_results_over_time, FUN = function (x) { x$focal_time } ))
# deepSTRAPP_outputs$time_steps must match with focal_time found in deepSTRAPP_outputs$STRAPP_results_over_time
if (!all(deepSTRAPP_outputs$time_steps == focal_time_list))
{
stop(paste0("'deepSTRAPP_outputs$time_steps' does not match with 'focal_time' found in 'deepSTRAPP_outputs$STRAPP_results_over_time'.\n",
"You can inspect the structure of the input object with 'str(deepSTRAPP_outputs, 2)'.\n",
"See ?deepSTRAPP::run_deepSTRAPP_over_time() to learn how to generate those objects."))
}
## deepSTRAPP_outputs$STRAPP_results_over_time is a list.
# All elements are STRAPP_results that should have all the needed sub-elements: $focal_time, $estimate, $p_value, $method, $trait_data_type_for_stats, $perm_data_df
# Detect time-steps with no STRAPP test results
trait_data_type_for_stats_list <- unlist(lapply(X = deepSTRAPP_outputs$STRAPP_results_over_time, FUN = function (x) { x$trait_data_type_for_stats }))
time_steps_with_STRAPP_results_ID <- which(trait_data_type_for_stats_list != "none")
time_steps_with_no_STRAPP_results <- focal_time_list[which(trait_data_type_for_stats_list == "none")]
# Send warning for time-steps without STRAPP results
if (any(trait_data_type_for_stats_list == "none"))
{
if (sum(trait_data_type_for_stats_list == "none") == 1)
{
warning(paste0("STRAPP test results were missing from 'deepSTRAPP_outputs$STRAPP_results_over_time'.\n",
"A unique ML state/range was inferred across branches for this time-step: ",time_steps_with_no_STRAPP_results,".\n",
"No STRAPP test for differences in rates between states/ranges can be computed with a unique state/range.\n",
"Therefore, no histogram of test stats can be plotted for this time-step."))
} else {
warning(paste0("STRAPP test results were missing from 'deepSTRAPP_outputs$STRAPP_results_over_time'.\n",
"A unique ML state/range was inferred across branches for these time-steps: ",paste(time_steps_with_no_STRAPP_results, collapse = ", "),".\n",
"No STRAPP test for differences in rates between states/ranges can be computed with a unique state/range.\n",
"Therefore, no histogram of test stats can be plotted for these time-steps."))
}
}
# Extract deepSTRAPP_outputs$STRAPP_results_over_time only for time-steps with STRAPP results
STRAPP_results_over_time_with_STRAPP_results <- deepSTRAPP_outputs$STRAPP_results_over_time[time_steps_with_STRAPP_results_ID]
# Check for presence of $perm_data_df
perm_data_df_check_list <- unlist(lapply(X = STRAPP_results_over_time_with_STRAPP_results, FUN = function (x) { "perm_data_df" %in% names(x) } ))
if (!all(perm_data_df_check_list))
{
stop(paste0("Elements in 'deepSTRAPP_outputs$STRAPP_results_over_time' do not have a '$perm_data_df'.\n",
"You can inspect the structure of the input object with 'str(deepSTRAPP_outputs$STRAPP_results_over_time, 2)'.\n",
"See ?deepSTRAPP::run_deepSTRAPP_over_time() to learn how to generate those objects.\n",
"Especially, check if you used 'return_STRAPP_results = TRUE' AND 'return_perm_data = TRUE' to save the permutated data",
"needed for the histogram plot to save the permutated data needed for the histogram plot."))
}
## plot_posthoc_tests
if (plot_posthoc_tests)
{
# Extract $trait_data_type_for_stats from deepSTRAPP_outputs$STRAPP_results_over_time
trait_data_type_for_stats <- deepSTRAPP_outputs$trait_data_type_for_stats
# plot_posthoc_tests = TRUE only for "multinominal" data
if (trait_data_type_for_stats != "multinominal")
{
stop(paste0("'posthoc_pairwise_tests = TRUE' only makes sense for categorical/biogeographic data with more than two states/ranges.\n",
"Set 'posthoc_pairwise_tests = FALSE', or provide 'deepSTRAPP_outputs' for a trait with more than two states/ranges'.\n",
"See ?deepSTRAPP::run_deepSTRAPP_over_time() to learn how to generate those objects."))
}
# Check if $posthoc_pairwise_tests is present in elements of deepSTRAPP_outputs$STRAPP_results_over_time.
posthoc_pairwise_tests_check_list <- unlist(lapply(X = deepSTRAPP_outputs$STRAPP_results_over_time, FUN = function (x) { "posthoc_pairwise_tests" %in% names(x) } ))
posthoc_pairwise_tests_check_list_with_STRAPP_results <- unlist(lapply(X = STRAPP_results_over_time_with_STRAPP_results, FUN = function (x) { "posthoc_pairwise_tests" %in% names(x) } ))
if (all(!posthoc_pairwise_tests_check_list_with_STRAPP_results))
{
stop(paste0("Elements in 'deepSTRAPP_outputs$STRAPP_results_over_time' do not have a '$posthoc_pairwise_tests'.\n",
"You can inspect the structure of the input object with 'str(deepSTRAPP_outputs$STRAPP_results_over_time, 2)'.\n",
"See ?deepSTRAPP::run_deepSTRAPP_over_time() to learn how to generate those objects.\n",
"Especially, check if you used 'return_STRAPP_results = TRUE' AND 'posthoc_pairwise_tests = TRUE' to run post hoc tests ",
"and save the results in 'deepSTRAPP_outputs'."))
} else { # Case with '$posthoc_pairwise_tests' missing only for some time-steps
if (!all(posthoc_pairwise_tests_check_list))
{
time_steps_no_posthoc_tests <- focal_time_list[!posthoc_pairwise_tests_check_list]
warning(paste0("No posthoc pairwise tests recorded for these time-steps: ", paste(time_steps_no_posthoc_tests, collapse = ", "),".\n",
"This is likely because two or less states/ranges where present at these time-steps.\n",
"No histogram of test stats was generated for these time-steps."))
}
}
# Extract only STRAPP_results for time-step with multinominal data
STRAPP_results_over_time_for_post_hoc <- deepSTRAPP_outputs$STRAPP_results_over_time[posthoc_pairwise_tests_check_list]
# Check if $posthoc_pairwise_tests$perm_data_array is present in elements of STRAPP_results_over_time_for_post_hoc.
posthoc_pairwise_tests_list <- lapply(X = STRAPP_results_over_time_for_post_hoc, FUN = function (x) { x$posthoc_pairwise_tests } )
perm_data_array_check_list <- unlist(lapply(X = posthoc_pairwise_tests_list, FUN = function (x) { "perm_data_array" %in% names(x) } ))
if (all(!perm_data_array_check_list))
{
warning(paste0("Elements in 'deepSTRAPP_outputs$STRAPP_results_over_time' do not have a '$posthoc_pairwise_tests$perm_data_array' despite recording posthoc test results otherwise.\n",
"You can inspect the structure of the input object with 'str(deepSTRAPP_outputs$STRAPP_results_over_time, 3)'.\n",
"See ?deepSTRAPP::run_deepSTRAPP_over_time() to learn how to generate those objects.\n",
"Especially, check if you used 'return_STRAPP_results = TRUE', 'posthoc_pairwise_tests = TRUE' AND return_perm_data = TRUE to run post hoc tests ",
"and save the results and the permutated data needed for the histogram plots in 'deepSTRAPP_outputs'."))
}
}
## PDF_file_path
# If provided, PDF_file_path must end with ".pdf"
if (!is.null(PDF_file_path))
{
if (length(grep(pattern = "\\.pdf$", x = PDF_file_path)) != 1)
{
stop("'PDF_file_path' must end with '.pdf'")
}
}
}
## Save initial par() and reassign them on exit
oldpar <- par(no.readonly = TRUE)
on.exit(par(oldpar))
if (!plot_posthoc_tests)
{
## Case for overall test plot
# Initiate list of ggplots
ggplot_histo_list <- list()
# Loop per time steps with recorded STRAPP results
for (i in time_steps_with_STRAPP_results_ID)
{
# i <- 1
# Extract STRAPP_results
STRAPP_results_i <- deepSTRAPP_outputs$STRAPP_results_over_time[[i]]
# Extract name of the statistic
stat_name <- names(STRAPP_results_i$perm_data_df)[4]
# Extract null distribution of the statistic
stat_null_distri <- STRAPP_results_i$perm_data_df[,stat_name]
# Extract quantile of the critical threshold
estimate_quantile <- names(STRAPP_results_i$estimate)
# Build ggplot object
ggplot_histo_i <- ggplot2::ggplot(data = as.data.frame(stat_null_distri)) +
# Generate histogram
ggplot2::geom_histogram(mapping = ggplot2::aes(x = stat_null_distri),
bins = 30, # Set to avoid displaying automatic message from ggplot
fill = "grey80", color = "grey50", alpha = 0.8) +
# Add vline for x = 0 (evaluation threshold)
ggplot2::geom_vline(xintercept = 0, color = "black",
linetype = "dashed", linewidth = 1.0) +
# Add vline for x = estimate (significance threshold)
ggplot2::geom_vline(xintercept = STRAPP_results_i$estimate, color = "red",
linetype = "dashed", linewidth = 1.0) +
# Add test summary
# alpha value : Estimate, p-value
annotate_npc(x = 0.05, y = 0.95, hjust = 0, vjust = 1, gp = grid::gpar(fontsize = 18),
label = paste0("Q", estimate_quantile, " = ", round(STRAPP_results_i$estimate, digits = 3), "\n",
"P-value = ", round(STRAPP_results_i$p_value, digits = 3))) +
# Adjust axis labels
ggplot2::labs(x = paste0("Distribution of the test statistics"),
y = "Counts across posterior samples") +
# Add title
ggplot2::ggtitle(paste0("STRAPP based on ",STRAPP_results_i$method," test\n",
"Focal time = ", STRAPP_results_i$focal_time)) +
# Adjust aesthetics
ggplot2::theme(panel.grid.major = ggplot2::element_line(color = "grey70", linetype = "dashed", linewidth = 0.3),
panel.background = ggplot2::element_rect(fill = NA, color = NA),
plot.margin = ggplot2::unit(c(0.3, 0.5, 0.5, 0.5), "inches"),
plot.title = ggplot2::element_text(size = 20, hjust = 0.5, color = "black",
margin = ggplot2::margin(b = 15, t = 5)),
axis.title = ggplot2::element_text(size = 20, color = "black"),
axis.title.x = ggplot2::element_text(margin = ggplot2::margin(t = 10)),
axis.title.y = ggplot2::element_text(margin = ggplot2::margin(r = 12)),
axis.line = ggplot2::element_line(linewidth = 1.5),
axis.text = ggplot2::element_text(size = 18, color = "black"),
axis.text.x = ggplot2::element_text(margin = ggplot2::margin(t = 5)),
axis.text.y = ggplot2::element_text(margin = ggplot2::margin(r = 5)))
## Display plot at each time step if requested
if (display_plots)
{
print(ggplot_histo_i)
}
## Store in list of ggplots
ggplot_histo_list[[i]] <- ggplot_histo_i
}
## Export all plots in one PDF if requested
if (!is.null(PDF_file_path))
{
grDevices::pdf(file = file.path(PDF_file_path), height = 8, width = 10, onefile = TRUE)
for (i in seq_along(ggplot_histo_list))
{
print(ggplot_histo_list[[i]])
}
grDevices::dev.off()
}
## Return list of ggplots
return(invisible(ggplot_histo_list))
} else {
## Case for post hoc tests plot
# Initiate list of lists of ggplots
ggplot_histo_list_of_lists <- list()
# Detect ID of time-steps with recorded posthoc tests
time_steps_ID_with_posthoc_tests <- which(posthoc_pairwise_tests_check_list)
# Loop per time steps
# for (i in seq_along(deepSTRAPP_outputs$time_steps))
for (i in seq_along(time_steps_ID_with_posthoc_tests)) # Run only across time-steps with recorded posthoc tests
{
# i <- 1
# Extract ID of the time-step
time_steps_ID_i <- time_steps_ID_with_posthoc_tests[i]
# Extract STRAPP_results
STRAPP_results_i <- deepSTRAPP_outputs$STRAPP_results_over_time[[time_steps_ID_i]]
# Create list of pairwise plots for time step i
ggplots_histo_list_i <- list()
# Extract pairs
all_pairs <- dimnames(STRAPP_results_i$posthoc_pairwise_tests$perm_data_array)$pairs
# Compute size factor to adjust size of everything
size_factor <- sqrt(length(all_pairs))
for (j in seq_along(all_pairs))
{
# j <- 1
# Extract perm data for pair j
perm_data_df_j <- as.data.frame(STRAPP_results_i$posthoc_pairwise_tests$perm_data_array[j, , ])
# Extract pair names
pair_j <- all_pairs[j]
# # Replace "!=" with unicode
# pair_j <- gsub(pattern = "!=", replacement = "\u2260", x = pair_j )
# Extract name of the statistic
stat_name <- names(perm_data_df_j)[3]
# Extract null distribution of the statistic
stat_null_distri <- perm_data_df_j[,stat_name]
# Extract quantile of the critical threshold (same the one used for the main test)
estimate_quantile <- names(STRAPP_results_i$estimate)
# Extract estimate of the critical threshold
estimate_value <- STRAPP_results_i$posthoc_pairwise_tests$summary_df$estimates[j]
# Extract p-value
p_value <- STRAPP_results_i$posthoc_pairwise_tests$summary_df$p_values[j]
# Detect if adjusted p-values differ from p-value
p_value_adj_to_plot <- any(STRAPP_results_i$posthoc_pairwise_tests$summary_df$p_values != STRAPP_results_i$posthoc_pairwise_tests$summary_df$p_values_adjusted)
# Extract p-value adjusted if different
if (p_value_adj_to_plot)
{
p_value_adj <- STRAPP_results_i$posthoc_pairwise_tests$summary_df$p_values_adjusted[j]
}
# Build ggplot object for pair j
ggplot_histo_j <- ggplot2::ggplot(data = as.data.frame(stat_null_distri)) +
# Generate histogram
ggplot2::geom_histogram(mapping = ggplot2::aes(x = stat_null_distri),
bins = 30, # Set to avoid displaying automatic message from ggplot
fill = "grey80", color = "grey50", alpha = 0.8) +
# Add vline for x = 0 (evaluation threshold)
ggplot2::geom_vline(xintercept = 0, color = "black",
linetype = "dashed", linewidth = 1.0/size_factor) +
# Add vline for x = estimate (significance threshold)
ggplot2::geom_vline(xintercept = estimate_value, color = "red",
linetype = "dashed", linewidth = 1.0/size_factor) +
# Add test summary
# alpha value : Estimate, p-value
annotate_npc(x = 0.05, y = 0.95, hjust = 0, vjust = 1, gp = grid::gpar(fontsize = 18/size_factor),
label = paste0("Q", estimate_quantile, " = ", round(estimate_value, digits = 3), "\n",
"P-value = ", round(p_value, digits = 3))) +
# Adjust axis labels
ggplot2::labs(x = paste0("Distribution of the test statistics"),
y = "Counts across posterior samples") +
# Add title
ggplot2::ggtitle(paste0("STRAPP based on ",STRAPP_results_i$posthoc_pairwise_tests$method," test\n",
"Focal time = ", STRAPP_results_i$focal_time, "\n",
"Hypothesis = ",pair_j, "\n")) +
# Adjust aesthetics
ggplot2::theme(panel.grid.major = ggplot2::element_line(color = "grey70", linetype = "dashed", linewidth = 0.3/size_factor),
panel.background = ggplot2::element_rect(fill = NA, color = NA),
plot.margin = ggplot2::unit(c(0.3/(size_factor*2), 0.5/(size_factor*2), 0.5/(size_factor*2), 0.5/(size_factor*2)), "inches"),
plot.title = ggplot2::element_text(size = 20/size_factor, hjust = 0.5, color = "black",
margin = ggplot2::margin(b = 15/size_factor, t = 5/size_factor)),
axis.title = ggplot2::element_text(size = 20/size_factor, color = "black"),
axis.title.x = ggplot2::element_text(margin = ggplot2::margin(t = 10/size_factor)),
axis.title.y = ggplot2::element_text(margin = ggplot2::margin(r = 12/size_factor)),
axis.line = ggplot2::element_line(linewidth = 1.5/size_factor),
axis.text = ggplot2::element_text(size = 18/size_factor, color = "black"),
axis.text.x = ggplot2::element_text(margin = ggplot2::margin(t = 5/size_factor)),
axis.text.y = ggplot2::element_text(margin = ggplot2::margin(r = 5/size_factor)))
# Add adjusted p-value if present
if (p_value_adj_to_plot)
{
ggplot_histo_j <- ggplot_histo_j +
# Add test summary including adjusted p-value
annotate_npc(x = 0.05, y = 0.95, hjust = 0, vjust = 1, gp = grid::gpar(fontsize = 18/size_factor),
label = paste0("Q", estimate_quantile, " = ", round(estimate_value, digits = 3), "\n",
"P-value = ", round(p_value, digits = 3), "\n",
"P-value adj = ", round(p_value_adj, digits = 3)))
}
# Store ggplot for pairs j
ggplots_histo_list_i[[j]] <- ggplot_histo_j
}
## Display plot at each time step if requested
if (display_plots)
{
cow_plot_to_print_i <- cowplot::plot_grid(plotlist = ggplots_histo_list_i)
print(cow_plot_to_print_i)
}
## Store in list of lists of ggplots
ggplot_histo_list_of_lists[[i]] <- ggplots_histo_list_i
}
## Export all plots in one PDF if requested
if (!is.null(PDF_file_path))
{
# # Find the number of rows and columns
# nb_plots <- length(cow_plot_to_print_i$layers)
# nb_cols <- ceiling(sqrt(nb_plots))
# nb_rows <- ceiling(nb_plots/nb_cols)
# Export PDF witn one page per plot
grDevices::pdf(file = file.path(PDF_file_path), height = 8, width = 10, onefile = TRUE)
# pdf(file = PDF_file_path, height = 8*nb_rows, width = 10*nb_cols, onefile = TRUE)
for (i in seq_along(ggplot_histo_list_of_lists))
{
cow_plot_to_print_i <- cowplot::plot_grid(plotlist = ggplot_histo_list_of_lists[[i]])
print(cow_plot_to_print_i)
}
grDevices::dev.off()
}
## Return list of lists of ggplots
return(invisible(ggplot_histo_list_of_lists))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.