基于dplyr管道创建带rxid下拉筛选的交互式R可视化图表

Great question! You absolutely can build that interactive chart with a rxid dropdown filter—no Shiny required if you prefer, and I’ll cover both that approach and a Shiny fallback just in case. Here’s how to make it work:

No-Shiny Approach (Using crosstalk + ggplotly) #

This method creates a self-contained interactive HTML file that works in any browser, no server needed. We’ll use crosstalk to add the dropdown filter and ggplotly to make your ggplot interactive.

First, install and load the required packages if you haven’t already:

install.packages(c("crosstalk", "ggplot2", "dplyr", "plotly"))
library(crosstalk)
library(ggplot2)
library(dplyr)
library(plotly)

Then, modify your pipeline to work with shared interactive data:

# Turn your data into a "SharedData" object so crosstalk can filter it
shared_lhoabx <- SharedData$new(lhoabx, key = ~rxid, group = "rxid_filter")

# Create the dropdown filter for rxid
rxid_dropdown <- filter_select(
  id = "rxid_selector",
  label = "Select RxID:",
  sharedData = shared_lhoabx,
  group = ~rxid,
  multiple = FALSE # Set to TRUE if you want to pick multiple rxids at once
)

# Build your chart pipeline using the shared data
dot_plot <- shared_lhoabx %>%
  group_by(locationid, month) %>%
  summarise(totaldot = sum(as.numeric(dot)), .groups = "drop") %>%
  right_join(pdays.summary, by = c("locationid", "month")) %>%
  mutate(
    totaldot = case_when(is.na(totaldot) ~ 0, TRUE ~ totaldot),
    dot1000 = totaldot / totalpdays * 1000
  ) %>%
  ggplot(aes(x = month, y = dot1000)) +
  geom_line(aes(linetype = locationid)) +
  labs(
    title = "DOT per 1000 Days by Location",
    x = "Month",
    y = "DOT per 1000 Patient Days"
  )

# Combine the dropdown and interactive plot in a responsive layout
bscols(widths = c(3, 9), rxid_dropdown, ggplotly(dot_plot))

When you run this, it’ll generate an HTML page with your dropdown on the left and the interactive chart on the right. Select a different rxid from the menu, and the chart will update automatically.

Shiny Approach (For More Flexibility) #

If you need more advanced features later (like multiple filters, download buttons, or dynamic calculations), Shiny is a solid option. Here’s a minimal working version:

install.packages(c("shiny", "ggplot2", "dplyr"))
library(shiny)
library(ggplot2)
library(dplyr)

# Define the app UI
ui <- fluidPage(
  titlePanel("DOT per 1000 Days by Location"),
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "selected_rxid",
        label = "Select RxID:",
        choices = unique(lhoabx$rxid),
        selected = unique(lhoabx$rxid)[1] # Default to first rxid
      )
    ),
    mainPanel(
      plotOutput("dot_plot")
    )
  )
)

# Define server logic
server <- function(input, output) {
  output$dot_plot <- renderPlot({
    lhoabx %>%
      filter(rxid == input$selected_rxid) %>%
      group_by(locationid, month) %>%
      summarise(totaldot = sum(as.numeric(dot)), .groups = "drop") %>%
      right_join(pdays.summary, by = c("locationid", "month")) %>%
      mutate(
        totaldot = case_when(is.na(totaldot) ~ 0, TRUE ~ totaldot),
        dot1000 = totaldot / totalpdays * 1000
      ) %>%
      ggplot(aes(x = month, y = dot1000)) +
      geom_line(aes(linetype = locationid)) +
      labs(x = "Month", y = "DOT per 1000 Patient Days")
  })
}

# Run the app
shinyApp(ui = ui, server = server)

Just run this script, and a Shiny app window will open with your dropdown filter and chart.

Quick Notes: #

• Make sure your month column is formatted as a date (not character) so the x-axis displays correctly.
• Double-check that pdays.summary includes every combination of locationid and month you need—this ensures the right_join doesn’t drop any time points.

内容的提问来源于stack exchange，提问作者Tom O