Skip to content

Commit 4abed3f

Browse files
ecoisilvaecoisilva
committed
✨ update functions
1 parent 2134df2 commit 4abed3f

File tree

4 files changed

+186
-79
lines changed

4 files changed

+186
-79
lines changed

‎R/fct_meta.R

Lines changed: 45 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -150,7 +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 .iter_size Numeric. The size of each iteration step. Default is 2.
153+
#' @param .iter_step Numeric. The size of each iteration step. Default is 2.
154154
#' @param .only_max_m Logical. If TRUE, will only run the maximum number of individuals. Default is FALSE.
155155
#' @param .lists A list containing already created meta inputs. Default is NULL.
156156
#'
@@ -171,7 +171,7 @@ run_meta_permutations <- function(rv,
171171
random = FALSE,
172172
max_samples = 100,
173173
trace = FALSE,
174-
.iter_size = 2,
174+
.iter_step = 2,
175175
.only_max_m = FALSE,
176176
.lists = NULL) {
177177

@@ -266,7 +266,7 @@ run_meta_permutations <- function(rv,
266266

267267
m_iter <- NULL
268268
m_iter <- .get_sequence(input[["All"]],
269-
.iter_size = .iter_size,
269+
.iter_step = .iter_step,
270270
grouped = subpop)
271271
if (.only_max_m) m_iter <- max(m_iter)
272272

@@ -688,17 +688,6 @@ run_meta_loocv <- function(rv,
688688
}
689689

690690

691-
#' @title Plot meta
692-
#'
693-
#' @noRd
694-
#'
695-
plot_meta <- function() {
696-
697-
698-
699-
700-
}
701-
702691
#' @title Plot meta (permutations)
703692
#'
704693
#' @noRd
@@ -738,43 +727,39 @@ plot_meta_permutations <- function(rv,
738727

739728
if (random) {
740729

741-
out <- rv$meta_tbl_resample %>%
742-
dplyr::mutate(m == as.integer(m)) %>%
743-
dplyr::filter(type == set_target)
730+
if (!is.null(rv$meta_nresample))
731+
out <- dplyr::filter(rv$meta_tbl_resample,
732+
sample <= rv$meta_nresample)
733+
else out <- rv$meta_tbl_resample
744734

745-
if (subpop) {
746-
out <- out %>%
747-
dplyr::filter(group != "All")
748-
}
735+
out <- out %>%
736+
dplyr::mutate(m = as.integer(m)) %>%
737+
dplyr::filter(type == set_target)
738+
if (subpop) out <- dplyr::filter(out, group != "All")
749739

750740
stopifnot(all(!is.na(out$est)), nrow(out) > 0)
751741

752742
max_samples <- max(unique(out$sample))
743+
max_samples
753744

754745
out_mean <- out %>%
755746
dplyr::group_by(type, group, m) %>%
756747
dplyr::summarize(
757748
n = dplyr::n(),
758749
error = mean(error, na.rm = TRUE),
759-
lci = mean(error_lci, na.rm = TRUE),
760-
uci = mean(error_uci, na.rm = TRUE)) %>%
750+
error_lci = mean(error_lci, na.rm = TRUE),
751+
error_uci = mean(error_uci, na.rm = TRUE)) %>%
761752
dplyr::rowwise() %>%
762753
dplyr::mutate(
763-
within_threshold = any(
764-
dplyr::c_across(c(error, lci, uci)) >=
765-
-rv$error_threshold &
766-
dplyr::c_across(c(error, lci, uci)) <=
767-
rv$error_threshold),
768-
close_to_threshold = any(
769-
dplyr::c_across(c(error, lci, uci)) >=
770-
-(rv$error_threshold * 2) &
771-
dplyr::c_across(c(error, lci, uci)) <=
772-
(rv$error_threshold * 2)),
773-
color = dplyr::case_when(
774-
(lci < -rv$error_threshold &
775-
uci > rv$error_threshold) ~ "Yes",
754+
within_threshold =
755+
(error >= -rv$error_threshold &
756+
error <= rv$error_threshold),
757+
overlaps_with_threshold =
758+
(error_lci <= rv$error_threshold &
759+
error_uci >= -rv$error_threshold),
760+
status = dplyr::case_when(
776761
within_threshold ~ "Yes",
777-
close_to_threshold ~ "Near",
762+
!within_threshold & overlaps_with_threshold ~ "Near",
778763
TRUE ~ "No")) %>%
779764
quiet() %>%
780765
suppressMessages() %>%
@@ -787,44 +772,41 @@ plot_meta_permutations <- function(rv,
787772
plot_subtitle <- paste(
788773
"<b>Maximum number of samples:</b>", max_samples)
789774

790-
p_error1 <- ggplot2::geom_hline(
791-
yintercept = rv$error_threshold,
792-
color = "black",
793-
linetype = "dotted")
794-
p_error2 <- ggplot2::geom_hline(
795-
yintercept = -rv$error_threshold,
796-
color = "black",
797-
linetype = "dotted")
798-
799775
p.optimal <- out_mean %>%
800776
ggplot2::ggplot(
801777
ggplot2::aes(x = as.factor(m),
802778
y = error,
803779
group = group,
804780
shape = group,
805-
color = color)) +
781+
color = status)) +
806782

807783
ggplot2::geom_hline(
808784
yintercept = 0,
809785
linewidth = 0.3,
810786
linetype = "solid") +
811787

812-
p_error1 +
813-
p_error2 +
788+
ggplot2::geom_hline(
789+
yintercept = rv$error_threshold,
790+
color = "black",
791+
linetype = "dotted") +
792+
ggplot2::geom_hline(
793+
yintercept = -rv$error_threshold,
794+
color = "black",
795+
linetype = "dotted") +
814796

815797
ggplot2::geom_jitter(
816798
data = out,
817799
mapping = ggplot2::aes(x = as.factor(m),
818800
y = error,
819801
group = group,
820802
shape = group,
821-
color = color),
803+
color = status),
822804
position = ggplot2::position_jitterdodge(dodge.width = 0.4),
823805
size = 3.5, color = "grey80", alpha = 0.9) +
824806

825807
ggplot2::geom_linerange(
826-
ggplot2::aes(ymin = lci,
827-
ymax = uci),
808+
ggplot2::aes(ymin = error_lci,
809+
ymax = error_uci),
828810
show.legend = TRUE,
829811
position = ggplot2::position_dodge(width = 0.4),
830812
linewidth = 2.2, alpha = 0.3) +
@@ -855,6 +837,7 @@ plot_meta_permutations <- function(rv,
855837
margin = ggplot2::margin(b = 2)),
856838
plot.subtitle = ggtext::element_markdown(
857839
size = 14, hjust = 1, margin = ggplot2::margin(b = 15)))
840+
p.optimal
858841

859842
if (rv$which_meta == "mean") {
860843
p.optimal <- p.optimal +
@@ -869,26 +852,14 @@ plot_meta_permutations <- function(rv,
869852

870853
stopifnot(all(!is.na(out$est)), nrow(out) > 0)
871854

872-
if (subpop) {
873-
out <- out %>%
874-
dplyr::filter(group != "All")
875-
}
855+
if (subpop) out <- dplyr::filter(out, group != "All")
876856

877857
stopifnot(all(!is.na(out$est)), nrow(out) > 0)
878858

879859
txt_color <- paste0(
880860
"Within error threshold (\u00B1",
881861
rv$error_threshold * 100, "%)?")
882862

883-
p_error1 <- ggplot2::geom_hline(
884-
yintercept = rv$error_threshold,
885-
color = "black",
886-
linetype = "dotted")
887-
p_error2 <- ggplot2::geom_hline(
888-
yintercept = -rv$error_threshold,
889-
color = "black",
890-
linetype = "dotted")
891-
892863
out <- out %>%
893864
dplyr::group_by(type) %>%
894865
dplyr::rowwise() %>%
@@ -926,7 +897,7 @@ plot_meta_permutations <- function(rv,
926897
pal_values <- c("A" = "#77b131", "B" = "#009da0")
927898

928899
txt_color <- "Groups:"
929-
txt_caption <- "(*) Asterisks indicate significant subpopulations."
900+
txt_caption <- "(*) Asterisks indicate subpopulations were found."
930901

931902
} # Note: refers to finding subpops within the population.
932903

@@ -938,8 +909,14 @@ plot_meta_permutations <- function(rv,
938909
shape = group,
939910
color = color)) +
940911

941-
p_error1 +
942-
p_error2 +
912+
ggplot2::geom_hline(
913+
yintercept = rv$error_threshold,
914+
color = "black",
915+
linetype = "dotted") +
916+
ggplot2::geom_hline(
917+
yintercept = -rv$error_threshold,
918+
color = "black",
919+
linetype = "dotted") +
943920

944921
ggplot2::geom_hline(
945922
yintercept = 0,

‎R/utils_meta.R

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -239,7 +239,7 @@
239239
#' @keywords internal
240240
#'
241241
#' @noRd
242-
.get_sequence <- function(input, .iter_size = 2, grouped = FALSE) {
242+
.get_sequence <- function(input, .iter_step = 2, grouped = FALSE) {
243243

244244
if (is.null(input)) stop("No input!")
245245

@@ -248,14 +248,14 @@
248248

249249
if (n == 1) return(stop("Cannot run meta() on one individual."))
250250

251-
if (.iter_size == 2) {
251+
if (.iter_step == 2) {
252252
start_value <- ifelse(n %% 2 == 0, 2, 1)
253253
} else {
254-
start_value <- n %% .iter_size
255-
if (start_value == 0) start_value <- .iter_size
254+
start_value <- n %% .iter_step
255+
if (start_value == 0) start_value <- .iter_step
256256
}
257257

258-
out_seq <- seq(start_value, n, by = .iter_size)
258+
out_seq <- seq(start_value, n, by = .iter_step)
259259
if (grouped && 1 %in% out_seq) {
260260
out_seq <- out_seq[out_seq != 1]
261261
}
@@ -312,9 +312,7 @@
312312
#' @noRd
313313
.get_groups <- function(input, groups) {
314314
group_A <- input[groups[["A"]]]
315-
# group_A[sapply(group_A, is.null)] <- NULL # TODO TOCHECK
316315
group_B <- input[groups[["B"]]]
317-
# group_B[sapply(group_B, is.null)] <- NULL # TODO TOCHECK
318316
return(list(A = group_A,
319317
B = group_B))
320318
}

‎R/utils_report.R

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -17,13 +17,16 @@
1717
if (!inherits(out, "error")) {
1818
out <- data.frame(
1919
"lci" = ifelse(is.null(out$CI_low), NA, out$CI_low),
20-
"est" = ci,
21-
"uci" = ifelse(is.null(out$CI_high), NA, out$CI_high))
20+
"est" = mean(x, na.rm = TRUE),
21+
"uci" = ifelse(is.null(out$CI_high), NA, out$CI_high),
22+
"ci" = ci)
2223
} else {
2324
out <- data.frame(
2425
"lci" = NA,
25-
"est" = ci,
26-
"uci" = NA)
26+
"est" = mean(x, na.rm = TRUE),
27+
"uci" = NA,
28+
"ci" = ci)
29+
2730
}
2831

2932
return(out)

0 commit comments

Comments
 (0)