Skip to content

Commit 3e7f300

Browse files
ecoisilvaecoisilva
committed
✨ update functions
1 parent 381ab64 commit 3e7f300

File tree

7 files changed

+286
-7
lines changed

7 files changed

+286
-7
lines changed

‎NAMESPACE

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22

33
export(run_app)
44
export(run_meta)
5+
export(run_meta_loocv)
56
export(run_meta_permutations)
67
import(shiny)
78
importFrom(crayon,make_style)

‎R/fct_meta.R

Lines changed: 111 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -150,6 +150,7 @@
150150
#' @param max_samples Integer. Maximum number of resamples when `random = TRUE`. Must be positive. Default is 100.
151151
#' @param subpop Logical. If TRUE, will run meta-analyses with groups. Default is FALSE.
152152
#' @param trace Logical. If TRUE, prints progress messages. Default is FALSE.
153+
#' @param .only_max_m Logical. If TRUE, will only run the maximum number of individuals. Default is FALSE.
153154
#' @param .lists A list containing already created meta inputs. Default is NULL.
154155
#'
155156
#' @examples
@@ -169,6 +170,7 @@ run_meta_permutations <- function(rv,
169170
random = FALSE,
170171
max_samples = 100,
171172
trace = FALSE,
173+
.only_max_m = FALSE,
172174
.lists = NULL) {
173175

174176
if (!is.logical(random) || length(random) != 1) {
@@ -262,6 +264,7 @@ run_meta_permutations <- function(rv,
262264

263265
m_iter <- NULL
264266
m_iter <- .get_sequence(input[["All"]], grouped = subpop)
267+
if (.only_max_m) m_iter <- max(m_iter)
265268

266269
for (m in m_iter) {
267270
if (m == 1) next
@@ -545,16 +548,122 @@ run_meta_permutations <- function(rv,
545548
run_meta <- function(rv,
546549
set_target = c("hr", "ctsd"),
547550
subpop = FALSE,
548-
trace = FALSE) {
551+
trace = FALSE,
552+
.only_max_m = FALSE,
553+
.lists = NULL) {
549554

550555
return(run_meta_permutations(rv,
551556
set_target = set_target,
552557
subpop = subpop,
553558
random = FALSE,
554559
max_samples = NULL,
555-
trace = trace))
560+
trace = trace,
561+
.only_max_m = .only_max_m,
562+
.lists = .lists))
556563
}
557564

565+
566+
#' @title Running \eqn{\chi^2}-IG hierarchical model meta-analyses (LOOCV)
567+
#'
568+
#' @description This function performs a meta-analysis on movement tracking data,
569+
#' for mean home range area (AKDE) or continuous-time speed and distance (CTSD)
570+
#' estimates for a sampled population. It leverages the `ctmm` R package,
571+
#' specifically the `meta()` function, to obtain population-level mean parameters.
572+
#' This function helps to assess outputs via leave-one-out cross-validation (LOOCV).
573+
#'
574+
#' @param rv A list containing outputs, settings and data objects. Must not be NULL.
575+
#' @param set_target Character. Research target: `"hr"` for home range or `"ctsd"` for speed & distance.
576+
#' @param subpop Logical. If TRUE, will run meta-analyses with groups. Default is FALSE.
577+
#' @param trace Logical. If TRUE, prints progress messages. Default is FALSE.
578+
#' @param .only_max_m Logical. If TRUE, will only run the maximum number of individuals. Default is FALSE.
579+
#' @param .lists A list containing already created meta inputs. Default is NULL.
580+
#'
581+
#' @examples
582+
#'\dontrun{
583+
#' # Running:
584+
#' run_meta_loocv(rv, set_target = "hr")
585+
#'}
586+
#'
587+
#' @encoding UTF-8
588+
#' @return A data frame containing meta-analysis outputs, including estimates, errors, confidence intervals, and group information.
589+
#' @author Inês Silva \email{i.simoes-silva@@hzdr.de}
590+
#'
591+
#' @export
592+
run_meta_loocv <- function(rv,
593+
set_target = c("hr", "ctsd"),
594+
subpop = FALSE,
595+
trace = FALSE,
596+
.only_max_m = TRUE,
597+
.lists = NULL) {
598+
599+
dt_meta <- NULL
600+
rv_list <- reactiveValuesToList(rv)
601+
602+
out <- lapply(set_target, \(target) {
603+
604+
if (target == "ctsd") {
605+
is_ctsd <- .check_for_inf_speed(rv$ctsdList)
606+
simList <- rv$simList[is_ctsd]
607+
ctsdList <- rv$ctsdList[is_ctsd]
608+
} else {
609+
simList <- rv$simList
610+
}
611+
612+
x <- 1
613+
for (x in seq_along(simList)) {
614+
if (trace)
615+
message(paste("---", x, "out of", length(rv$simList)))
616+
617+
tmp_file <- rlang::duplicate(rv_list, shallow = FALSE)
618+
tmp_file$seedList <- rv_list$seedList[-x]
619+
tmp_file$simList <- simList[-x]
620+
tmp_file$simfitList <- rv_list$simfitList[-x]
621+
if (target == "hr") tmp_file$akdeList <- rv_list$akdeList[-x]
622+
if (target == "ctsd") tmp_file$ctsdList <- ctsdList[-x]
623+
tmp_file$seedList <- rv_list$seedList[-x]
624+
625+
if (target == "ctsd" && length(tmp_file$ctsdList) > 0) {
626+
tmp_file$ctsdList[sapply(tmp_file$ctsdList, is.null)] <- NULL
627+
628+
new_i <- 0
629+
new_list <- list()
630+
for (i in seq_along(tmp_file$ctsdList)) {
631+
if (tmp_file$ctsdList[[i]]$CI[, "est"] != "Inf") {
632+
new_i <- new_i + 1
633+
new_list[[new_i]] <- tmp_file$ctsdList[[i]]
634+
}
635+
}
636+
637+
if (length(new_list) == 0) new_list <- NULL
638+
639+
tmp_file$ctsdList <- new_list
640+
tmp_file$ctsdList[sapply(tmp_file$ctsdList, is.null)] <- NULL
641+
642+
} # end of if (target == "ctsd" && length(tmp_file$ctsdList) > 0)
643+
644+
tmp_dt <- NULL
645+
tmp_dt <- run_meta(tmp_file, set_target = target, .only_max_m = TRUE)
646+
647+
if (nrow(tmp_dt) > 0) {
648+
tmp_dt$x <- x
649+
if (is.null(dt_meta)) {
650+
dt_meta <- tmp_dt
651+
} else {
652+
dt_meta <- rbind(dt_meta, tmp_dt)
653+
}
654+
}
655+
656+
} # end of [x] loop (individuals)
657+
658+
return(dt_meta)
659+
660+
}) # end of [set_target] lapply
661+
662+
return(dplyr::distinct(do.call(rbind, out)))
663+
664+
}
665+
666+
558667
#' @title Plot meta
559668
#'
560669
#' @noRd

‎R/mod_tab_meta.R

Lines changed: 106 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1078,6 +1078,12 @@ mod_tab_meta_server <- function(id, rv) {
10781078
get_analysis <- c(get_analysis, "ctsd")
10791079
}
10801080

1081+
# rv$meta_tbl_loocv <- run_meta_loocv(
1082+
# rv, set_target = get_analysis,
1083+
# subpop = rv$grouped,
1084+
# trace = TRUE,
1085+
# .only_max_m = TRUE)
1086+
10811087
tmp <- run_meta_permutations(
10821088
rv, set_target = get_analysis,
10831089
subpop = rv$grouped,
@@ -1750,6 +1756,106 @@ mod_tab_meta_server <- function(id, rv) {
17501756
input$run_meta_resample,
17511757
rv$set_analysis))
17521758

1759+
## Rendering error plot of optimal search outputs (LOOCV): -----------
1760+
1761+
output$metaPlot_m_loocv <- ggiraph::renderGirafe({
1762+
req(rv$meta_tbl, rv$which_m, rv$which_meta,
1763+
rv$which_question, rv$set_analysis)
1764+
req(length(rv$simList) > 1)
1765+
1766+
req(rv$meta_tbl_loocv)
1767+
1768+
plot_title <- NULL
1769+
if (length(rv$which_question) > 1) {
1770+
plot_title <- ifelse(rv$set_analysis == "hr",
1771+
"For home range:",
1772+
"For speed & distance:")
1773+
}
1774+
1775+
pal_values <- c("Yes" = pal$sea,
1776+
"Near" = pal$grn,
1777+
"No" = pal$dgr)
1778+
1779+
color_title <- "Sub-population detected?"
1780+
1781+
out <- rv$meta_tbl_loocv %>%
1782+
dplyr::mutate(overlaps = dplyr::between(
1783+
error, -rv$error_threshold, rv$error_threshold)) %>%
1784+
dplyr::mutate(overlaps = factor(
1785+
overlaps, levels = c("TRUE", "FALSE"))) %>%
1786+
dplyr::distinct()
1787+
1788+
p.loocv <- out %>%
1789+
ggplot2::ggplot(
1790+
ggplot2::aes(x = x,
1791+
y = error,
1792+
group = group,
1793+
color = overlaps)) +
1794+
1795+
ggplot2::geom_hline(
1796+
yintercept = rv$error_threshold,
1797+
alpha = 0.5,
1798+
linetype = "dotted", linewidth = 0.7) +
1799+
ggplot2::geom_hline(
1800+
yintercept = - rv$error_threshold,
1801+
alpha = 0.5,
1802+
linetype = "dotted", linewidth = 0.7) +
1803+
1804+
ggplot2::geom_hline(
1805+
yintercept = 0,
1806+
linewidth = 0.3,
1807+
linetype = "solid") +
1808+
1809+
ggplot2::geom_point(
1810+
position = ggplot2::position_dodge(width = 0.4),
1811+
show.legend = TRUE,
1812+
size = 2) +
1813+
1814+
ggplot2::geom_linerange(
1815+
ggplot2::aes(ymin = error_lci,
1816+
ymax = error_uci),
1817+
show.legend = TRUE,
1818+
position = ggplot2::position_dodge(width = 0.4),
1819+
linewidth = 2.2, alpha = 0.3) +
1820+
1821+
ggplot2::labs(
1822+
title = "Leave-one-out cross-validation",
1823+
x = "Individual removed",
1824+
y = "Relative error (%)",
1825+
color = paste0("Within error threshold (\u00B1",
1826+
rv$error_threshold * 100, "%)?")) +
1827+
1828+
ggplot2::scale_x_continuous(breaks = scales::breaks_pretty()) +
1829+
ggplot2::scale_y_continuous(labels = scales::percent,
1830+
breaks = scales::breaks_pretty()) +
1831+
# ggplot2::scale_shape_manual("Group:", values = c(16,17)) +
1832+
1833+
theme_movedesign(font_available = rv$is_font) +
1834+
ggplot2::theme(
1835+
legend.position = "bottom",
1836+
plot.title = ggtext::element_markdown(
1837+
size = 14, hjust = 1, margin = ggplot2::margin(b = 15)))
1838+
1839+
ggiraph::girafe(
1840+
ggobj = p.loocv,
1841+
width_svg = 5.5, height_svg = 4,
1842+
options = list(
1843+
ggiraph::opts_selection(type = "none"),
1844+
ggiraph::opts_toolbar(saveaspng = FALSE),
1845+
ggiraph::opts_tooltip(
1846+
opacity = 1,
1847+
use_fill = TRUE),
1848+
ggiraph::opts_hover(
1849+
css = paste("fill: #1279BF;",
1850+
"stroke: #1279BF;",
1851+
"cursor: pointer;")))) %>%
1852+
suppressWarnings()
1853+
1854+
}) %>% # end of renderGirafe, "metaPlot_m_loocv"
1855+
bindEvent(list(input$run_meta,
1856+
input$run_meta_resample,
1857+
rv$set_analysis))
1858+
17531859
# TABLES --------------------------------------------------------------
17541860
## Rendering meta-analyses outputs: -----------------------------------
17551861

‎R/mod_tab_report.R

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1320,7 +1320,7 @@ mod_tab_report_server <- function(id, rv) {
13201320
}) %>% # end of observe,
13211321
bindEvent(input$build_report)
13221322

1323-
## Reporting META: ----------------------------------------------------
1323+
## Reporting META-ANALYSES: -------------------------------------------
13241324

13251325
observe({
13261326
req(rv$which_meta)
@@ -1394,9 +1394,9 @@ mod_tab_report_server <- function(id, rv) {
13941394
dplyr::c_across(c(est, lci, uci)) <=
13951395
(rv$error_threshold * 2)),
13961396
overlaps_with = dplyr::case_when(
1397-
(lci < -rv$error_threshold &
1398-
uci > rv$error_threshold) ~ "Yes",
1399-
within_threshold ~ "Yes",
1397+
(est >= -rv$error_threshold &
1398+
est <= rv$error_threshold) ~ "Yes",
1399+
within_threshold ~ "Near",
14001400
close_to_threshold ~ "Near",
14011401
TRUE ~ "No"))
14021402

‎man/run_meta.Rd

Lines changed: 12 additions & 1 deletion
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/run_meta_loocv.Rd

Lines changed: 49 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎man/run_meta_permutations.Rd

Lines changed: 3 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)