如何在R中使用Plotly绘制带年份下拉筛选的年龄金字塔？

原代码的核心问题 #

1. 金字塔布局逻辑错误：年龄金字塔需要男性数值为正、女性为负，且barmode应设为'relative'而非'stack'——stack是堆叠效果，relative才会让正负值向两侧展开形成金字塔形状。
2. 下拉菜单可见性匹配错误：每个年份用split=~SEXO会生成2个trace（男/女），但原代码的visible列表只按1个trace设置，导致切换年份后显示异常。
3. 轴标签与数据不匹配：x轴标题错误写为"Raça/cor"，且未使用已计算好的percent列实现对称的金字塔效果。
4. 年龄组顺序混乱：未将FAIXA_ETARIA设为有序因子，导致x轴年龄组顺序随机。

修正后的完整代码 #

library(plotly)
library(dplyr)

# 生成模拟数据
dadosbr <- data.frame(
  SEXO = sample(c("Masculino", "Feminino"), 7525, replace = TRUE),
  FAIXA_ETARIA = sample(c("0-19", "20-29", "30-39", "40-49", "50-59", "60 ou mais"), 7525, replace = TRUE),
  ANO_TRAT = sample(2019:2024, 7525, replace = TRUE)
)

# 数据预处理：计算百分比，设置女性为负，年龄组转为有序因子
sexo <- dadosbr %>%
  group_by(SEXO, FAIXA_ETARIA, ANO_TRAT) %>%
  tally() %>%
  ungroup() %>%
  group_by(ANO_TRAT, FAIXA_ETARIA) %>%
  mutate(percent = round(n / sum(n) * 100, 1)) %>%  # 按年龄组+年份计算占比
  ungroup() %>%
  mutate(
    percent = ifelse(SEXO == "Feminino", -percent, percent),
    FAIXA_ETARIA = factor(FAIXA_ETARIA, levels = c("0-19", "20-29", "30-39", "40-49", "50-59", "60 ou mais"))
  )

# 初始化Plotly图表
p <- plot_ly(sexo, hoverinfo = 'text', textposition = "none") %>%
  # 为每个年份添加男/女两个trace
  add_trace(data = filter(sexo, ANO_TRAT == 2019),
            x = ~FAIXA_ETARIA, y = ~percent, color = ~SEXO, type = 'bar', 
            name = '2019', visible = TRUE,
            text = ~paste('</br> Ano do Início do Tratamento: ', ANO_TRAT,
                          '</br> Sexo: ', SEXO,
                          '</br> Número de Casos: ', n,
                          '</br> % na Faixa Etária: ', abs(percent))) %>%
  add_trace(data = filter(sexo, ANO_TRAT == 2020),
            x = ~FAIXA_ETARIA, y = ~percent, color = ~SEXO, type = 'bar', 
            name = '2020', visible = FALSE,
            text = ~paste('</br> Ano do Início do Tratamento: ', ANO_TRAT,
                          '</br> Sexo: ', SEXO,
                          '</br> Número de Casos: ', n,
                          '</br> % na Faixa Etária: ', abs(percent))) %>%
  add_trace(data = filter(sexo, ANO_TRAT == 2021),
            x = ~FAIXA_ETARIA, y = ~percent, color = ~SEXO, type = 'bar', 
            name = '2021', visible = FALSE,
            text = ~paste('</br> Ano do Início do Tratamento: ', ANO_TRAT,
                          '</br> Sexo: ', SEXO,
                          '</br> Número de Casos: ', n,
                          '</br> % na Faixa Etária: ', abs(percent))) %>%
  add_trace(data = filter(sexo, ANO_TRAT == 2022),
            x = ~FAIXA_ETARIA, y = ~percent, color = ~SEXO, type = 'bar', 
            name = '2022', visible = FALSE,
            text = ~paste('</br> Ano do Início do Tratamento: ', ANO_TRAT,
                          '</br> Sexo: ', SEXO,
                          '</br> Número de Casos: ', n,
                          '</br> % na Faixa Etária: ', abs(percent))) %>%
  add_trace(data = filter(sexo, ANO_TRAT == 2023),
            x = ~FAIXA_ETARIA, y = ~percent, color = ~SEXO, type = 'bar', 
            name = '2023', visible = FALSE,
            text = ~paste('</br> Ano do Início do Tratamento: ', ANO_TRAT,
                          '</br> Sexo: ', SEXO,
                          '</br> Número de Casos: ', n,
                          '</br> % na Faixa Etária: ', abs(percent))) %>%
  add_trace(data = filter(sexo, ANO_TRAT == 2024),
            x = ~FAIXA_ETARIA, y = ~percent, color = ~SEXO, type = 'bar', 
            name = '2024', visible = FALSE,
            text = ~paste('</br> Ano do Início do Tratamento: ', ANO_TRAT,
                          '</br> Sexo: ', SEXO,
                          '</br> Número de Casos: ', n,
                          '</br> % na Faixa Etária: ', abs(percent))) %>%
  # 布局设置
  layout(
    width = 820,
    xaxis = list(title = "Faixa Etária", linecolor = 'black', showline = TRUE, showgrid = FALSE),
    yaxis = list(title = 'Percentual por Faixa Etária', showgrid = FALSE, zeroline = TRUE,
                 linecolor = 'black', range = c(-50, 50),
                 ticktext = c("40%", "20%", "0%", "20%", "40%"),
                 tickvals = c(-40, -20, 0, 20, 40)),
    colorway = c("#118dff", "#4567a9"),  # 对应女性、男性的颜色
    barmode = 'relative',  # 关键：实现左右分展的金字塔
    showlegend = TRUE,
    updatemenus = list(
      list(
        active = 0,
        buttons = list(
          list(method = "restyle",
               args = list("visible", list(TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)),
               label = "2019"),
          list(method = "restyle",
               args = list("visible", list(FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)),
               label = "2020"),
          list(method = "restyle",
               args = list("visible", list(FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)),
               label = "2021"),
          list(method = "restyle",
               args = list("visible", list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE, FALSE)),
               label = "2022"),
          list(method = "restyle",
               args = list("visible", list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE, FALSE, FALSE)),
               label = "2023"),
          list(method = "restyle",
               args = list("visible", list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, TRUE)),
               label = "2024")
        )
      )
    ),
    margin = list(l = 80, r = 80, b = 80, t = 40, pad = 10)
  )

p

关键修正点说明 #

1. 数据处理：将FAIXA_ETARIA转为有序因子，保证年龄组从低到高排列；按年龄组+年份计算百分比，女性设为负值，实现对称金字塔。
2. 图表类型与布局：使用barmode='relative'让正负条形向两侧展开；调整y轴刻度显示绝对值，提升可读性。
3. 下拉菜单：每个年份对应2个trace（男/女），所以visible列表需要按每2个元素为一组设置可见性。
4. hover信息：显示百分比的绝对值，避免负号造成误解。

内容的提问来源于stack exchange，提问作者Lana Meijinhos