在 RMarkdown HTML 文件中向 ggplot 添加下拉列表过滤器列表？

您可以将绘图嵌入到交互式 Shiny 文档中。在 Rmd 文件中，添加行 .runtime: shiny

---
title: "A Shiny Document"
output: html_document
runtime: shiny
---

然后，您可以使用如下所示的下拉过滤器创建一个 Shiny 应用程序。在 using 中插入下拉菜单。然后在你的 ，让你的绘图按年份过滤uiselectInputserverdia %>% filter(anoobito == input$years) %>% ...

library(dplyr)
library(ggplot2)
library(shiny)


# data
data <- data.frame(
  anoobito = sample(2019:2023),
  diadasemana = sample(c("Segunda", "Terça", "Quarta", "Quinta", "Sexta", "Sábado", "Domingo"), 23000, replace = TRUE)
)

dia <- data %>%
  group_by(anoobito, diadasemana) %>%
  tally %>%
  mutate(diadasemana = factor(diadasemana, levels = c("Domingo","Segunda", "Terça", "Quarta", "Quinta", "Sexta", "Sábado")))


# ui
ui <- fluidPage(
    selectInput("years", label = "Year:", choices = unique(data$anoobito), selected = 2019),
    plotOutput("my_plot")
  )

# server
server <- function(input, output){
    output$my_plot <- renderPlot({
      dia %>% 
        filter(anoobito == input$years) %>%
        ggplot(aes(x = diadasemana, y = n, group = 1)) +
        geom_line(linewidth = 2) +
        geom_point(size = 3) +
        theme_minimal(base_size = 15) +
        scale_y_continuous(limits = c(0,1000), expand = expansion(mult = c(0, .1))) +
        theme(legend.position = "bottom",
              axis.line = element_line(colour = "black"),
              axis.text.x=element_text(colour="black"), axis.text.y=element_text(colour="black")) +  
        labs(
          x = "Ano do Óbito", 
          y = "Número de Óbitos",
          caption = "**Fonte**: SIM, SMS-RJ. Dados sujeitos a alterações.")
    })
  }

# run app
shinyApp(ui = ui,server = server, options = list(height = 700))

编辑

这是另一个使用包的解决方案。您可以在 中添加下拉列表，并使用 中的参数过滤数据。您还可以将输出编织为 html。plotlylayouttransformplot_ly

library(plotly)

dia |>
  mutate(anoobito = as.factor(anoobito)) |> 
  ungroup() |> 
  arrange(diadasemana) |> 
  plot_ly(x=~diadasemana, y=~n, 
          type="scatter", mode="lines+markers",
          transforms = list(
            list(
              type = 'filter',
              target = ~anoobito,
              operation = '=',
              value = unique(dia$anoobito)[1]
            )
          )
  ) |> 
  layout(
    yaxis = list(range = c(0,1000), title = "Número de Óbitos"),
    xaxis = list(title = "Ano do Óbito"),
    updatemenus = list(
      list(
        type = 'dropdown',
        active = 0,
        buttons = lapply(unique(dia$anoobito), 
                         \(x) list(method = "restyle",
                                   args = list("transforms[0].value", x),
                                   label = x)
        )
      )
    )
  )