Skip to content

Commit 6d5a5de

Browse files
Monika-HMonika-H
committed
Add tests for new functionalities
1 parent c200f6a commit 6d5a5de

File tree

7 files changed

+398
-36
lines changed

7 files changed

+398
-36
lines changed

‎R/aaa.R

+1-5
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ utils::globalVariables("continuous_outcome")
2626
utils::globalVariables("treatments")
2727
utils::globalVariables("fixed_followup_days")
2828
utils::globalVariables("average")
29+
utils::globalVariables("estimate")
2930
utils::globalVariables("value")
3031
utils::globalVariables("percentage")
3132
utils::globalVariables("name")
@@ -53,12 +54,7 @@ utils::globalVariables("WIN_A")
5354
utils::globalVariables("WIN_P")
5455
utils::globalVariables("TIE_A")
5556
utils::globalVariables("linetype")
56-
utils::globalVariables("wins")
57-
utils::globalVariables("losses")
58-
utils::globalVariables("ties")
5957
utils::globalVariables("method")
6058
utils::globalVariables("UCL")
6159
utils::globalVariables("LCL")
62-
utils::globalVariables("wins")
63-
utils::globalVariables("losses")
6460
utils::globalVariables("tot")

‎R/internal.R

+21-13
Original file line numberDiff line numberDiff line change
@@ -212,6 +212,9 @@
212212
}
213213

214214
.log10Ticks <- function(range) {
215+
if (range[1] <= 0) {
216+
range[1] <- 0.0000001
217+
}
215218
range <- log10(range)
216219
get_axp <- function(x) 10^c(floor(x[1]), ceiling(x[2]))
217220
n <- ifelse(range[2] > 4, 1, 2)
@@ -291,16 +294,16 @@
291294
dplyr::group_by(arm) %>%
292295
dplyr::summarise(n = n(),
293296
x = base::sum(value, na.rm = TRUE),
294-
average = 100 *
297+
estimate = 100 *
295298
as.numeric(stats::prop.test(x, n)$estimate),
296-
se = abs(average -
299+
ci_diff = abs(estimate -
297300
(100 * as.numeric(stats::prop.test(x, n)$conf.int)[1])
298301
)) %>%
299302
dplyr::ungroup()
300303

301304
# To create ellipsis shape and avoid overlapping between both of them,
302-
# set the height to 80% of the SE (minimum scaled in x-axis or y-axis range)
303-
width <- (100 - start_binary_endpoint) * min(binary_meta$se) / 100
305+
# set the height to 80% of the CI (minimum scaled in x-axis or y-axis range)
306+
width <- (100 - start_binary_endpoint) * min(binary_meta$ci_diff) / 100
304307
y_range <- (max(actv_y, ctrl_y) + 10) * (width / 100)
305308
y_height <- min(c(0.4 * abs(actv_y - ctrl_y), 0.8 * min(width, y_range)))
306309

@@ -309,17 +312,17 @@
309312
# with the standard error as width and the height as calculated above
310313
actv_point <-
311314
.create_ellipsis_points(unlist(binary_meta[binary_meta$arm == actv,
312-
"average"]),
315+
"estimate"]),
313316
actv_y,
314317
unlist(binary_meta[binary_meta$arm == actv,
315-
"se"]),
318+
"ci_diff"]),
316319
y_height)
317320
ctrl_point <-
318321
.create_ellipsis_points(unlist(binary_meta[binary_meta$arm == ctrl,
319-
"average"]),
322+
"estimate"]),
320323
ctrl_y,
321324
unlist(binary_meta[binary_meta$arm == ctrl,
322-
"se"]),
325+
"ci_diff"]),
323326
y_height)
324327

325328
binary_data <- rbind(data.frame("outcome" = last_outcome,
@@ -332,18 +335,23 @@
332335
ctrl_point)
333336
)
334337

338+
lowest_value <- binary_meta$estimate - binary_meta$ci_diff
339+
highest_value <- binary_meta$estimate + binary_meta$ci_diff
340+
x_range <- c(min(0, floor(lowest_value / 10) * 10),
341+
max(100, ceiling(highest_value / 10) * 10))
342+
335343
binary_data$x <- .to_rangeab(
336344
binary_data$x,
337345
start_binary_endpoint,
338-
0,
339-
100
346+
x_range[1],
347+
x_range[2]
340348
)
341349

342350
binary_meta$average <- .to_rangeab(
343-
binary_meta$average,
351+
binary_meta$estimate,
344352
start_binary_endpoint,
345-
0,
346-
100
353+
x_range[1],
354+
x_range[2]
347355
)
348356

349357
binary_meta$y <- 0

‎R/internal_validation.R

+6-3
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,8 @@
2929

3030
.create_validation_binary_step <- function(layers, x, arms) {
3131

32+
`%>%` <- dplyr::`%>%`
33+
3234
binary_layers <- which(layers == "GeomSegment")
3335

3436
if (length(binary_layers) != 0) {
@@ -60,6 +62,8 @@
6062

6163
.create_validation_binary_last <- function(layers, x, arms) {
6264

65+
`%>%` <- dplyr::`%>%`
66+
6367
polygon_layers <- which(layers == "GeomPolygon")
6468
point_layers <- which(layers == "GeomPoint")
6569

@@ -73,12 +77,11 @@
7377
polygon_data <- polygon_data %>%
7478
dplyr::filter(y %in% point_data$y) %>%
7579
dplyr::group_by(group) %>%
76-
dplyr::summarise("lower_se" = base::min(x, na.rm = TRUE),
77-
"upper_se" = base::max(x, na.rm = TRUE))
80+
dplyr::summarise("lower_ci" = base::min(x, na.rm = TRUE),
81+
"upper_ci" = base::max(x, na.rm = TRUE))
7882

7983
binary_data <- dplyr::left_join(point_data, polygon_data,
8084
by = "group")
81-
binary_data$se <- binary_data$x - binary_data$lower_se
8285
binary_data$group <- factor(binary_data$group, labels = arms)
8386

8487
} else {

‎R/internal_winOdds.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -260,10 +260,10 @@
260260
}
261261

262262
plot <- ggplot(data = wo_bar, aes(x = GROUP, y = percentage, fill = name)) +
263-
geom_bar(stat = "identity", position = position_dodge(), width = .9) +
263+
geom_bar(stat = "identity", position = position_dodge(), width = .8) +
264264
coord_flip() + # make bar plot horizontal
265265
geom_text(aes(label = round(percentage, 1)),
266-
position = ggplot2::position_dodge(width = .9),
266+
position = ggplot2::position_dodge(width = .8),
267267
vjust = 0.5, hjust = -0.2)
268268

269269
plot <- switch(theme,

‎R/maraca.R

+6-6
Original file line numberDiff line numberDiff line change
@@ -447,8 +447,8 @@ plot_maraca <- function(
447447

448448
} else if (last_type == "binary") {
449449

450-
lowest_value <- min(plotdata_last$value, na.rm = TRUE)
451-
highest_value <- max(plotdata_last$value, na.rm = TRUE)
450+
lowest_value <- last_data$meta$estimate - last_data$meta$ci_diff
451+
highest_value <- last_data$meta$estimate + last_data$meta$ci_diff
452452
range <- c(min(0, floor(lowest_value / 10) * 10),
453453
max(100, ceiling(highest_value / 10) * 10))
454454
minor_grid <- seq(range[1], range[2], continuous_grid_spacing_x)
@@ -462,14 +462,14 @@ plot_maraca <- function(
462462
dplyr::select("x" = median, arm)
463463
} else if (vline_type == "mean") {
464464
vline_data <- last_data$meta %>%
465-
dplyr::select("x" = median, arm)
465+
dplyr::select("x" = average, arm)
466466
}
467467

468468
if (trans %in% c("log", "log10", "sqrt")) {
469469

470470
if (range[1] < 0) {
471471
warning(paste("Continuous endpoint has negative values - the",
472-
trans, "transformation will result in missing values"))
472+
trans, "transformation will result in missing values."))
473473
}
474474
plotdata_last$value <- eval(parse(text = paste0(trans,
475475
"(plotdata_last$value)")))
@@ -486,7 +486,7 @@ plot_maraca <- function(
486486
if (trans == "reverse") {
487487
if (!is.null(win_odds) && !obj$lowerBetter) {
488488
message(paste("Last endpoint axis has been reversed, which might",
489-
"indicate that lower values are considered advantageuos.",
489+
"indicate that lower values are considered advantageous.",
490490
"Note that the win odds were calculated assuming that",
491491
"higher values are better. If that is not correct, please",
492492
"use the parameter lowerBetter = TRUE in the",
@@ -498,7 +498,7 @@ plot_maraca <- function(
498498
plotdata_last$x <- start_last_endpoint - plotdata_last$x + 100
499499

500500
if (!is.null(vline_data)) {
501-
vline_data$x <- start_last_endpoint - plotdata_last$x + 100
501+
vline_data$x <- start_last_endpoint - vline_data$x + 100
502502
}
503503
}
504504

‎R/themes.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,8 @@
2525
ggplot2::geom_vline(xintercept = seq(0.5, n + 1.5, 1),
2626
linetype = 2, linewidth = 0.3, color = "darkgray") +
2727
# Axis showing percentages
28-
ggplot2::scale_y_continuous(labels =
29-
function(x) paste0(round(x, 2), "%")) +
28+
ggplot2::scale_y_continuous(labels = function(x) paste0(round(x, 2), "%"),
29+
expand = expansion(mult = c(0, .2))) +
3030
ggplot2::ylab("Percent of all comparisons") +
3131
ggplot2::theme_bw() +
3232
ggplot2::theme(legend.position = "bottom",

0 commit comments

Comments
 (0)