plot_sca = function(data, combined = TRUE, labels = c("A", "B"),
title = FALSE, limits = NULL,
point_size = .5, point_alpha = 1,
ci = TRUE, ci_alpha = .5, ci_size = .5,
line = FALSE, line_size = 1,
median_alpha = 1, median_size = 1,
text_size = 14, title_size = 6,
color_vars = NULL, palette = palette, legend = TRUE,
choices = c("x", "content", "medium", "sharing", "controls"),
alpha_values = c(0.5, 1),
remove_y = FALSE, remove_facet = FALSE,
collapse_content = FALSE, reorder_var = NULL) {
medians = data %>%
group_by(get(color_vars)) %>%
summarize(median = median(estimate)) %>%
ungroup() %>%
mutate(color = sprintf("%s", palette))
if (combined == TRUE) {
p1 = specr::plot_curve(data, point_size = point_size, point_alpha = point_alpha,
ci = ci, ci_alpha = ci_alpha, ci_size = ci_size,
line = line, line_size = line_size,
limits = limits) +
geom_hline(data = medians, aes(yintercept = median, color = color, linetype = `get(color_vars)`),
alpha = median_alpha, size = median_size, show_guide = TRUE) +
scale_linetype_manual(name = "", values = rep(1, nrow(medians)),
guide = guide_legend(override.aes = list(color = palette))) +
labs(x = "", y = "standarized\nregression coefficient\n") +
theme(legend.position = "top",
text = element_text(size = text_size, family = "Futura Medium"))
if (legend == FALSE) {
p1 = p1 +
theme(legend.position = "none")
}
if (title == TRUE) {
if (is.null(limits)) {
title_range = max(data$conf.high) - min(data$conf.high)
title_y = max(data$conf.high) - (title_range / 10)
} else {
title_range = limits[2] - limits[1]
title_y = limits[2] - (title_range / 10)
}
p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$x), fontface = 2, size = title_size,
x = 0.5*(1 + nrow(data)),
y = title_y)
}
if (!is.null(color_vars)) {
p2 = plot_choices(data, choices = choices,
alpha_values = alpha_values, color_vars = color_vars,
palette = palette, collapse_content = collapse_content,
reorder_var = reorder_var) +
labs(x = "\nspecifications (ranked)") +
theme(strip.text.x = element_blank(),
text = element_text(size = text_size, family = "Futura Medium"))
} else {
p2 = plot_choices(data, choices = choices,
alpha_values = alpha_values, collapse_content = collapse_content,
reorder_var = reorder_var) +
labs(x = "\nspecifications (ranked)") +
theme(strip.text.x = element_blank(),
text = element_text(size = text_size, family = "Futura Medium"))
}
} else {
p1 = specr::plot_curve(data, point_size = point_size, point_alpha = point_alpha,
ci_alpha = ci_alpha, ci_size = ci_size) +
geom_hline(yintercept = 0, linetype = "solid", color = "black", size = .5) +
labs(x = "", y = "standarized\nregression coefficient\n") +
theme(text = element_text(size = text_size, family = "Futura Medium"))
if (title == TRUE) {
if (is.null(limits)) {
title_range = max(data$conf.high) - min(data$conf.high)
title_y = max(data$conf.high) - (title_range / 10)
} else {
title_range = limits[2] - limits[1]
title_y = limits[2] - (title_range / 10)
}
p1 = p1 + annotate("text", -Inf, Inf, label = unique(data$y), fontface = 2, size = title_size,
x = 0.5*(1 + nrow(data)),
y = title_y)
}
p2 = plot_choices(data, choices = choices,
alpha_values = alpha_values, collapse_content = collapse_content,
reorder_var = reorder_var) +
labs(x = "\nspecification number (ranked)") +
theme(strip.text.x = element_blank(),
text = element_text(size = text_size, family = "Futura Medium"))
}
if (remove_y == TRUE) {
p1 = p1 + labs(y = "")
p2 = p2 + theme(axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
labs(y = "")
}
if (remove_facet == TRUE) {
p2 = p2 + theme(strip.text.y = element_blank())
}
specr::plot_specs(plot_a = p1,
plot_b = p2,
labels = labels,
rel_height = c(.35, .65))
}
plot_sca_compare = function(data, pointrange = TRUE, labels = c("A", "B"),
rel_heights = c(.75, .25), rel_widths = c(.75, .25),
title = FALSE, text_size = 14, title_size = 6, n_rows = 1, angle_text = FALSE,
remove_x = FALSE, remove_y = FALSE, sig = NULL) {
# source raincloud plot
source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")
# merge and tidy for plotting
plot_data = data %>%
group_by(x) %>%
arrange(estimate) %>%
mutate(specification = row_number()) %>%
ungroup() %>%
unique()
# labels
median_cl_boot = function(x, conf = 0.95, df = TRUE, ci = "low") {
lconf = (1 - conf)/2
uconf = 1 - lconf
require(boot)
bmedian = function(x, ind) median(x[ind])
bt = boot(x, bmedian, 1000)
bb = boot.ci(bt, type = "perc")
if (df == TRUE){
data.frame(y = median(x),
ymin = quantile(bt$t, lconf),
ymax = quantile(bt$t, uconf))
} else {
if (ci == "low") {
quantile(bt$t, lconf)
} else {
quantile(bt$t, uconf)
}
}
}
labs = plot_data %>%
group_by(x) %>%
summarize(med = median(estimate),
low = median_cl_boot(estimate, df = FALSE, ci = "low"),
high = median_cl_boot(estimate, df = FALSE, ci = "high")) %>%
mutate(range = max(high) - min(low),
estimate = ifelse(med > 0, high + (range / 10), low - (range / 10)),
label = ifelse(x %in% sig, "*", ""))
# plot curves
if (pointrange == TRUE) {
a = plot_data %>%
ggplot(aes(specification, estimate, color = x)) +
geom_linerange(aes(ymin = conf.low, ymax = conf.high), size = .1) +
geom_point() +
geom_hline(yintercept = 0, linetype = "solid", color = "black", size = 1) +
scale_color_manual(name = "", values = palette_relevance) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 4)) +
labs(x = "\nspecification number (ranked)", y = "standarized\negression coefficient\n") +
theme_minimal() +
theme(strip.text = element_blank(),
axis.line = element_line("black", size = 0.5),
legend.position = c(.5, .1),
legend.direction = "horizontal",
panel.spacing = unit(0.75, "lines"),
axis.text = element_text(colour = "black"),
text = element_text(size = text_size, family = "Futura Medium"))
if (title == TRUE) {
a = a + annotate("text", -Inf, Inf, label = unique(plot.data$y), fontface = 2, size = title_size,
x = 0.5*(min(plot.data$specification) + max(plot.data$specification)),
y = max(plot.data$conf.high))
}
} else {
a = plot_data %>%
ggplot(aes(specification, estimate, color = x)) +
geom_point() +
geom_hline(yintercept = 0, linetype = "solid", color = "black", size = 1) +
scale_color_manual(name = "", values = palette_relevance) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 4)) +
labs(x = "\nspecification number (ranked)", y = "standarized\nregression coefficient\n") +
theme_minimal() +
theme(strip.text = element_blank(),
axis.line = element_line("black", size = 0.5),
legend.position = "none",
legend.direction = "horizontal",
panel.spacing = unit(0.75, "lines"),
axis.text = element_text(colour = "black"),
text = element_text(size = text_size, family = "Futura Medium"))
if (title == TRUE) {
a = a + annotate("text", -Inf, Inf, label = unique(plot.data$y), fontface = 2, size = title_size,
x = 0.5*(min(plot.data$specification) + max(plot.data$specification)),
y = max(plot.data$estimate))
}
}
b = plot_data %>%
group_by(x) %>%
mutate(order = median(estimate)) %>%
ggplot(aes(reorder(x, order), estimate, fill = x)) +
geom_flat_violin(position = position_nudge(x = .1, y = 0), color = FALSE) +
geom_point(aes(color = x), position = position_jitter(width = .05), size = .5, alpha = .5) +
geom_boxplot(width = .1, outlier.shape = NA, fill = NA) +
geom_text(data = labs, aes(label = label, x = x, y = estimate), size = 6) +
scale_fill_manual(name = "", values = palette_relevance) +
scale_color_manual(name = "", values = palette_relevance) +
scale_y_continuous(breaks = scales::pretty_breaks(n = 4)) +
labs(x = "\n", y = "standarized\nregression coefficient\n") +
theme_minimal() +
theme(strip.text = element_blank(),
axis.line = element_line("black", size = 0.5),
legend.position = "none",
panel.spacing = unit(0.75, "lines"),
axis.text = element_text(colour = "black"),
text = element_text(size = text_size, family = "Futura Medium"))
if (angle_text == TRUE) {
b = b + theme(axis.text.x = element_text(angle = 45, hjust = 1))
}
if (n_rows == 1) {
a = a + theme(legend.position = c(.5, .1))
b = b + coord_flip() +
labs(x = "\n", y = "\nmedian") +
theme(axis.text.x = element_text(angle = 0, hjust = 1),
axis.text.y = element_blank())
}
if (remove_x == TRUE) {
a = a + labs(x = "")
if (n_rows == 1) {
b = b + labs(y = "")
} else {
b = b + labs(x = "")
}
}
if (remove_y == TRUE) {
a = a + labs(y = "")
if (n_rows == 1) {
b = b + labs(x = "")
} else {
b = b + labs(y = "")
}
}
cowplot::plot_grid(a, b, labels = labels, rel_heights = rel_heights, rel_widths = rel_widths, nrow = n_rows)
}
