如何使用ggplot和plotly在R中制作带有辅助y轴的堆叠条形图？

Question

我正在使用以下数据框：

data <- data.frame('Tipo_de_Parto' = c("Cesário", "Vaginal",
                                       "Cesário", "Vaginal",
                                       "Cesário", "Vaginal",
                                       "Cesário", "Vaginal",
                                       "Cesário", "Vaginal"),
                   'Ano_do_Nascimento' = c("2019", "2019",
                                       "2020", "2020",
                                       "2021", "2021",
                                       "2022", "2022",
                                       "2023", "2023"),
                   'perc' = c(34.1, 65.9,
                           32.0, 68.0,
                           0.0, 0.0,
                           36.6, 63.4,
                           39.2, 60.8),
                   'n' = c(723, 1395,
                           587, 1247,
                           0, 0,
                           545, 943,
                           439, 681))

我正在尝试绘制这样的内容：

如何使用 ggplot 在 R 中绘制它，然后使用 ggplotly 将其转换为交互式绘图？ “Tipo_de_Parto”填充条形，“n”作为主 y 轴，“perc”作为辅助 y 轴。 “perc”应绘制为一条线，但需要将其过滤为仅“阴道”。

我正在为 HTML 文件执行此操作。

Answer 1

您可以首先创建一个带有第二个轴的

ggplot

。为了使点处于正确的比例，您需要一个具有最大值的因子。之后，您可以使用

ggplotly

和

add_trace

向

yaxis="y2"

对象添加第二个轴，如下所示：

your_factor <- max(data$n)/max(data$perc)
library(ggplot2)
library(plotly)

p <- ggplot(data, aes(x = Ano_do_Nascimento, y = n, fill = Tipo_de_Parto)) +
  geom_col() +
  geom_point(aes(x = Ano_do_Nascimento, y = perc*your_factor, color = Tipo_de_Parto)) +
  scale_y_continuous("n", 
                     sec.axis = sec_axis(~./your_factor, name = "perc")) 

ggplotly(p) |>
  add_trace(x=~Ano_do_Nascimento, y=~perc, colors=~Tipo_de_Parto, yaxis="y2", 
            data=data, showlegend=FALSE, inherit=FALSE, mode = "markers") %>%
  layout(yaxis2 = list(overlaying = "y", side = "right", title = "perc"))

^{创建于 2023-12-05，使用 reprex v2.0.2}

Answer 2

基于之前的答案...仍然不确定这是否正是您想要的，但它应该会让您接近。

library(ggplot2)
library(dplyr)
library(plotly)

data <- data.frame('Tipo_de_Parto' = c("Cesário", "Vaginal",
                                       "Cesário", "Vaginal",
                                       "Cesário", "Vaginal",
                                       "Cesário", "Vaginal",
                                       "Cesário", "Vaginal"),
                   'Ano_do_Nascimento' = c("2019", "2019",
                                           "2020", "2020",
                                           "2021", "2021",
                                           "2022", "2022",
                                           "2023", "2023"),
                   'perc' = c(34.1, 65.9,
                              32.0, 68.0,
                              0.0, 0.0,
                              36.6, 63.4,
                              39.2, 60.8),
                   'n' = c(723, 1395,
                           587, 1247,
                           0, 0,
                           545, 943,
                           439, 681)) %>%
  
  mutate(Ano_do_Nascimento = as.numeric(as.character(Ano_do_Nascimento)),
         perc = ifelse(Tipo_de_Parto == 'Vaginal', perc, NA)) # drop unwanted percentages here


# this is the factor we will use to scale the secondary y-axis
your_factor <- max(data$n) / 100


# plot bars
p <- ggplot(data, aes(x = Ano_do_Nascimento, y = n, fill = Tipo_de_Parto)) +
  geom_bar(stat = 'identity', position = 'dodge') +
  scale_fill_manual(values = c('Cesário' = 'blue4', 'Vaginal' = 'blue')) +
  
  # add percentages
  geom_point(aes(x = Ano_do_Nascimento, y = perc*your_factor),
             color = 'orange') +
  geom_line(aes(x = Ano_do_Nascimento, y = perc*your_factor),
             color = 'orange') +
  
  # add secondary y-axis
  scale_y_continuous("n", 
                     sec.axis = sec_axis(~./your_factor, name = "perc")) 

# calculate the range of the secondary y-axis
y2_range <- ggplot_build(p)$layout$panel_params[[1]]$y.range / your_factor

# add the points to the plotly object
ggplotly(p) %>%
  
  # add the secondary axis back in
  add_trace(x=~Ano_do_Nascimento, y=~perc, yaxis="y2",
            data=data, showlegend=FALSE, inherit=FALSE, mode = "markers") %>%
  layout(yaxis2 = list(overlaying = "y", side = "right", title = "perc", range = y2_range))