Mapping and Plotting with precisely
To calculate several values and plot them, use map_precisely() and the included plot_*() functions and dplyr::group_by() to set the variable for the color aesthetic.
map_precisely(
precision_odds_ratio,
n_cases = seq(from = 500, to = 1000, by = 10),
exposed_cases = .6,
exposed_controls = .4,
group_ratio = 1:4
) %>%
group_by("Control/Case Ratio" = factor(group_ratio)) %>%
plot_precision()
Since the plotting functions are just ggplots, they are easy to customize. precisely also has a minimalist theme for ggplots, theme_precisely().
map_precisely(
upper_rate_ratio,
upper_limit = seq(1.5, 2.5, by = .1),
prob = seq(.50, .95, by = .05),
exposed = .01,
unexposed = .01,
group_ratio = 1:4
) %>%
group_by("Probability" = factor(prob)) %>%
plot_upper_limit(line_size = 1) +
scale_color_viridis_d() +
scale_x_continuous(breaks = c(0, 20000, 40000)) +
theme_precisely() +
theme(legend.position = "right") +
facet_wrap(~ group_ratio,
labeller = as_labeller(function(x) paste("Unexposed/Exposed:", x)))
map_precisely() is just a thin wrapper around tidyr::crossing() and purrr::pmap_dfr(). purrr::pmap_dfr() takes a data frame where the column names correspond to the arguments in the function. tidyr::crossing() takes the arguments and makes all possible combinations. Likewise, the plotting functions are primarily wrappers around ggplots with geom_line(). It’s easy, then, to create create them from scratch.
arguments <- crossing(
precision = 2,
exposed = seq(from = .01, to = .05, by = .005),
unexposed = seq(from = .01, to = .05, by = .005),
group_ratio = 1
)
arguments %>%
pmap_dfr(n_rate_ratio) %>%
gather(key, value, exposed, unexposed) %>%
ggplot(aes(n_total, rate_ratio, col = factor(value))) +
geom_line(size = 1.1) +
facet_wrap(~key, labeller = as_labeller(function(x) paste("Risk among", x))) +
labs(
title = "n Needed for an Upper to Lower CI Ratio of 2",
x = "Sample Size",
y = "Rate Ratio",
color = "Risk"
) +
scale_color_viridis_d() +
theme_minimal(14) +
theme(
plot.title = element_text(size = 20, margin = margin(.01, .01, .01, .01)),
strip.text = element_text(size = 16, color = "grey50", hjust = 0)
)
You can also be more exact in the argument values by creating your own data frames. Here’s an example recreating the figure from Rothman and Greenland’s paper.
lower_risk <- tibble(
precision = seq(from = .02, to = .20, by = .005),
exposed = .2,
unexposed = .1,
group_ratio = 1
)
higher_risk <- tibble(
precision = seq(from = .02, to = .20, by = .005),
exposed = .4,
unexposed = .3,
group_ratio = 1
)
risk_difference_data <- bind_rows(lower_risk, higher_risk) %>%
pmap_dfr(n_risk_difference)
risk_difference_data
#> # A tibble: 74 × 9
#> n_exposed n_unexposed n_total risk_difference precision exposed unexposed
#> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 9604. 9604. 19207. 0.1 0.02 0.2 0.1
#> 2 6146. 6146. 12293. 0.1 0.025 0.2 0.1
#> 3 4268. 4268. 8537. 0.1 0.03 0.2 0.1
#> 4 3136. 3136. 6272. 0.1 0.035 0.2 0.1
#> 5 2401. 2401. 4802. 0.1 0.04 0.2 0.1
#> 6 1897. 1897. 3794. 0.1 0.045 0.2 0.1
#> 7 1537. 1537. 3073. 0.1 0.05 0.2 0.1
#> 8 1270. 1270. 2540. 0.1 0.055 0.2 0.1
#> 9 1067. 1067. 2134. 0.1 0.06 0.2 0.1
#> 10 909. 909. 1818. 0.1 0.065 0.2 0.1
#> # … with 64 more rows, and 2 more variables: group_ratio <dbl>, ci <dbl>While the plotting functions support all the calculation functions in precisely, it’s easy to replicate in raw ggplot.
rg_plot <- risk_difference_data %>%
ggplot(aes(n_total, precision, col = factor(unexposed))) +
geom_line(size = 1.1) +
xlim(c(0, 9000))
rg_plot
Of course, the real power of combining this package with ggplot is to customize it.
rg_plot +
ggrepel::geom_text_repel( col = "grey30",
data = function(x) filter(x, near(n_total, 2500, 100)),
aes(label = paste("Risk in Unexposed:", unexposed)),
size = 4, segment.size = .5,
nudge_x = c(-900, 1100),
nudge_y = c(-.015, .03),
) +
labs(
x = "Study Size",
y = "Confidence Interval Width",
color = "Risk in\nUnexposed"
) +
theme_precisely() +
theme(legend.position = "none",
plot.title = element_text(size = 16),
plot.subtitle = element_text(size = 12, color = "grey60")) +
scale_color_manual(values = c("#E69F00", "#56B4E9"))