使用plotly (R)在Shiny中根据用户输入更改标记大小和颜色

Question

我希望能够根据用户输入更改火山图中标记的大小和颜色。用户将写入基因的名称（Gene1 等），并且图中对应于该基因的标记将更新，改变其大小（例如，更改为 20）和颜色（更改为黄色）。然后，当选择另一个基因时，之前的标记应该返回到之前的状态，并且新的基因将突出显示。

这是我尝试使用

restyle

，但我没有让它工作：

# Simulate some data
set.seed(123)  # For reproducibility
genes <- paste0("Gene", 1:100)
estimates <- rnorm(100, 0, 1)
metric <- runif(100, 0, 0.05)
contrasts <- sample(c("Contrast1", "Contrast2"), 100, replace = TRUE)
groups <- ifelse(estimates < -1 & metric <= 0.05, "Downregulated",
                 ifelse(estimates > 1 & metric <= 0.05, "Upregulated", "Not significant"))

# Create a dataframe
data <- data.frame(gene = genes, estimate = estimates, metric = metric, contrast = contrasts, group = groups)

library(shiny)
library(plotly)

ui <- fluidPage(
  titlePanel("Interactive RNAseq Data Visualization"),
  sidebarLayout(
    sidebarPanel(
      textInput("selectedGene", "Enter Gene Name:", value = ""),
      actionButton("highlightBtn", "Highlight")
    ),
    mainPanel(
      plotlyOutput("volcano_plot")
    )
  )
)

server <- function(input, output, session) {
  # Define your reactive data
  reactive_data <- reactive({
    # Your code to generate the data goes here.
    # For the sake of example, let's assume you have a dataframe 'df' that includes a 'gene' column.
    df <- data  # Replace 'data' with the actual data frame variable
    return(df)
  })
  
  # Output the plot
  output$volcano_plot <- renderPlotly({
    plot_ly(
      data, 
      x = ~estimate, 
      y = ~metric, 
      text = ~gene,
      type = "scatter", 
      mode = "markers",
      color = ~group,
      marker = list(opacity = 0.5, line = list(color = "black", width = 1)),
      hoverinfo = "text",
      source = "volcano_plot"  # important for plotlyProxy to know which plot to target
    ) %>% layout(
      title = "Volcano Plot",
      xaxis = list(title = "Estimate"),
      yaxis = list(title = "Metric")
    )
  })
  
  observeEvent(input$highlightBtn, {
    req(input$selectedGene)  # Ensure a gene is selected
    
    # Access the current reactive data
    df <- reactive_data()
    
    # Find the index of the gene to highlight
    selected_gene <- input$selectedGene
    gene_index <- which(df$gene == selected_gene)
    
    # Make sure there is only one gene to highlight and it's in the plot
    if(length(gene_index) == 1) {
      # Calculate the correct index for JavaScript
      gene_index_js <- gene_index - 1
      
      # Restyle the plot to highlight the selected gene
      plotlyProxy("volcano_plot", session) %>%
        plotlyProxyInvoke("restyle", 
                          list(
                            'marker.size' = list(20),
                            'marker.color' = list('yellow'),
                            'marker.opacity' = list(1)
                          ),
                          gene_index_js
        )
    }
  }, ignoreNULL = FALSE)
}

shinyApp(ui = ui, server = server)

我尝试使用

restyle

根据用户输入更改绘图，但它不起作用。图表根本没有改变。我也尝试过

update

，但它给出了我无法控制的非常奇怪的行为。

提前致谢！

Answer 1

在我看来，用高光绘制情节有一些限制。这里我用ggplot制作，并将其转换为plotly。

...
server <- function(input, output, session) {
  # Create a reactive dataset based on user input
  reactive_data <- reactive({
    req(input$selectedGenes)
    selected_genes <- unlist(strsplit(input$selectedGenes, ","))
    
    df <- data
    df$highlight <- ifelse(df$gene %in% selected_genes, "Selected", "Not Selected")
    return(df)
  })
  
  # Output the plot
  output$volcano_plot <- renderPlotly({
    df <- reactive_data()
    
    gg <- ggplot(df, aes(x = estimate, y = metric, text = gene)) +
      geom_point(aes(color = highlight), size = 3) +
      scale_color_manual(values = c("Selected" = "yellow", "Not Selected" = "blue")) +
      labs(title = "Volcano Plot", x = "Estimate", y = "Metric")
    
    ggplotly(gg) %>%
      layout(
        hovermode = "closest"
      )
  })
  
  observeEvent(input$highlightBtn, {
    req(input$selectedGenes)  # Ensure genes are selected
    
    # Update the plot based on the selected genes
    plotlyProxy("volcano_plot", session) %>%
      plotlyProxyInvoke("relayout", list(xaxis = list(rangeslider = list(highlight = input$selectedGenes))))
  }, ignoreNULL = FALSE)
}

即使您在输入中选择多个基因（用逗号分隔），这也有效：“Gene1，Gene2，Gene3”