R заменить один бар в барплоте на скрипке
Я сравниваю результаты 3 моделей с использованием барплота для определенного набора параметров. Барплот необходим, потому что у меня есть только медианы и вероятные интервалы для 2 моделей. Я хотел бы заменить или наложить 3-й столбец для каждой группы на графике для скрипки (показывая маргинальный апостериор для параметра Model 3 для каждой группы). Я счастлив использовать базу R, ggplot или что-нибудь еще, что работает!
Упрощенная версия того, что я пробовал до сих пор, приведена ниже:
library(ggplot2)
library(plyr)
## Data
params <- paste0("param", 1:3)
medians <- data.frame(value = c(seq(0.1,0.6, by = 0.1), rep(0, 3)),
model = rep(c("M1", "M2", "M3"), each = 3),
parameter = rep(paste0("param", 1:3), 3))
m3_posterior <- data.frame(value = runif(900, 0.2, 0.7),
model = "M3",
parameter = rep(params, each = 3))
m3_stats <- ddply(m3_posterior, .(parameter), summarize,
lower = quantile(value, 0.025),
upper = quantile(value, 0.975) )
confs <- data.frame(lower = c(seq(0.05, 0.55, by = 0.1), m3_stats$lower),
upper = c(seq(0.15, 0.65, by = 0.1), m3_stats$upper),
model = rep(c("M1", "M2", "M3"), each = 3),
parameter = rep(params, 3))
## plotting code
transparent_theme <- theme(
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank(),
axis.line = element_blank(),
panel.background = element_rect(fill = "transparent",colour = NA),
plot.background = element_rect(fill = "transparent",colour = NA))
print_list <- list()
for (param in 1 : length(params)) {
gg_medians <- subset(medians, parameter == params[param])
gg_confs <- subset(confs, parameter == params[param])
gg_post <- subset(m3_posterior, parameter == params[param])
p1 <- ggplot(gg_medians, aes(model, value)) +
geom_bar(stat="identity", fill = "white", colour = "black") +
geom_errorbar(data = gg_confs,
aes(y=upper, ymax=upper, ymin=lower)) +
scale_y_continuous(limits=c(0,1)) + labs(x=params[param])
p2 <- ggplot(gg_post, aes(parameter, value)) +
geom_violin(width=1.5, fill = NA)+
transparent_theme +
geom_errorbar(data = subset(gg_confs, model == "M3"),
aes(y=upper, ymax=upper, ymin=lower)) +
scale_y_continuous(limits=c(0,1)) + labs(x=params[param])
if (param > 1 ) {
p1 <- p1 + theme(axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank())
p2 <- p2 + theme(axis.title.y=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank())
}
p2_grob <- ggplotGrob(p2)
print_list[[param]] <- p1 + annotation_custom(grob = p2_grob,
xmin = 2.5, xmax = 3.5,
ymin = -0.0665, ymax = 1.061)
}
lay_out = function(...) {
x <- list(...)
n <- max(sapply(x, function(x) max(x[[2]])))
p <- max(sapply(x, function(x) max(x[[3]])))
grid::pushViewport(grid::viewport(layout = grid::grid.layout(n, p)))
for (i in seq_len(length(x))) {
print(x[[i]][[1]], vp = grid::viewport(
layout.pos.row = x[[i]][[2]],
layout.pos.col = x[[i]][[3]]))
}
}
lay_out(list(print_list[[1]], 1, 1),
list(print_list[[2]], 1, 2),
list(print_list[[3]], 1, 3))
Основные проблемы, с которыми я сталкиваюсь:
выравнивание гробовой графики скрипки с нижележащей гистограммой (я использовал догадку и проверку чисел)
сохраняя площадь графика каждого графика одинаковой, имея только ось Y на первом
1 ответ
Похоже, что вы хотите, чтобы две панели ошибок в m3 были выровнены по вертикали и горизонтали.
Выравнивание по горизонтали. Ваш метод задания пустых элементов оси не работает - на оси остается небольшое пространство. Мне проще выбрать панель графика из таблицы p2, а затем вставить ее в p1.
Выравнивание по вертикали - установка ymin и ymax в -Inf и Inf должна заботиться о выравнивании по вертикали, при условии, что пределы для двух графиков одинаковы. Я изменил цвет полос ошибок на графике скрипки на красный, чтобы было легче увидеть выравнивание (или смещение).
Получив одинаковую ширину трех панелей графиков, удалите материал оси из print_list[[1]], а затем сделайте ширину трех панелей равной единице (1, "npc"). Кроме того, вы можете выбрать панель графика из print_list[[2]] и print_list[[3]], поэтому нет необходимости устанавливать пустые элементы оси. Мне проще настроить макет с помощью gtable.
Кроме того, вы получаете предупреждение, потому что geom_errorbar не имеет эстетического вида. И в m3 вы получите линию при y=0, потому что высота бара установлена на ноль. Если вы не хотите линию, установите высоту бара на NA.
## Data
library(ggplot2)
library(plyr)
library(gtable)
library(grid)
params <- paste0("param", 1:3)
medians <- data.frame(value = c(seq(0.1,0.6, by = 0.1), rep(NA, 3)),
model = rep(c("M1", "M2", "M3"), each = 3),
parameter = rep(paste0("param", 1:3), 3))
m3_posterior <- data.frame(value = runif(900, 0.2, 0.7),
model = "M3",
parameter = rep(params, each = 3))
m3_stats <- ddply(m3_posterior, .(parameter), summarize,
lower = quantile(value, 0.025),
upper = quantile(value, 0.975) )
confs <- data.frame(lower = c(seq(0.05, 0.55, by = 0.1), m3_stats$lower),
upper = c(seq(0.15, 0.65, by = 0.1), m3_stats$upper),
model = rep(c("M1", "M2", "M3"), each = 3),
parameter = rep(params, 3))
print_list <- list()
for (param in 1 : length(params)) {
gg_medians <- subset(medians, parameter == params[param])
gg_confs <- subset(confs, parameter == params[param])
gg_post <- subset(m3_posterior, parameter == params[param])
p1 <- ggplot(gg_medians, aes(model)) +
geom_bar(aes(y = value), stat="identity", fill = "white", colour = "black") +
geom_errorbar(data = gg_confs,
aes(ymax=upper, ymin=lower)) +
scale_y_continuous(limits=c(0,1)) + labs(x=params[param])
p2 <- ggplot(gg_post, aes(parameter)) +
geom_violin(aes(y = value), width=1.5, fill = NA) +
geom_errorbar(data = subset(gg_confs, model == "M3"),
aes(ymax=upper, ymin=lower), colour = "red") +
scale_y_continuous(limits=c(0,1)) + labs(x=params[param]) +
theme_bw() +
theme(panel.grid = element_blank(),
panel.border = element_blank(),
panel.background = element_rect(fill = "transparent"))
p2_grob <- ggplotGrob(p2)
panel = gtable_filter(p2_grob, "panel") # Select plot panel from p2
print_list[[param]] <- p1 + annotation_custom(grob = panel,
xmin = 2.5, xmax = 3.5,
ymin = -Inf, ymax = Inf) # Put the panel it into p1
}
# From print_list:
# separate y-axis and panel columns in print_list[[1]]
# and get panel columns from print_list[[2]] and print_list[[3]]
g1 = ggplotGrob(print_list[[1]])
axis = g1[, 2:3] # Get the y axis
g1 = g1[, -c(1:3)] # Get the panel & columns to the right for param1
g2 = ggplotGrob(print_list[[2]])
g2 = g2[, -c(1:3)] # Get the panel & columns to the right for param2
g3 = ggplotGrob(print_list[[3]])
g3 = g3[, -c(1:3)] # Get the panel & columns to the right for param3
# Set up gtable 5 columns X 1 row
# 5 columns: left margin, width of y axis, width of three panels
# 1 row
gt = gtable(unit.c(unit(5.5, "pt"), sum(axis$widths), unit(c(1,1,1), "null")), unit(1, "null"))
# Populate the gtable, and draw the plot
gt = gtable_add_grob(gt, list(axis, g1, g2, g3), t = 1, l = 2:5)
grid.newpage()
grid.draw(gt)