为R Shiny中KEGG通路图的基因气泡添加悬停提示框求助

要给Shiny里的KEGG通路节点添加悬停提示，基础绘图系统不支持交互式操作，我们可以用ggiraph包将通路图转换为交互式ggplot对象，直接绑定gene_info_df中的描述信息作为提示内容。

1. 安装依赖包 #

首先安装需要的交互式绘图及辅助包：

install.packages(c("ggiraph", "ggplot2", "igraph"))

2. 修改UI部分 #

将原有的plotOutput替换为ggiraphOutput，适配交互式绘图的输出控件：

mainPanel(
  ggiraphOutput(outputId="genePlot", width = 1400, height=900)
)

3. 修改Server核心逻辑 #

把KEGGgraph生成的igraph对象转换为ggplot格式，关联gene_info_df的描述信息，添加交互式悬停绑定：

• 提取与原绘图一致的neato布局
• 匹配节点ID与基因描述信息
• 使用geom_point_interactive和geom_text_interactive创建带提示的交互式元素

完整修改后的代码 #

if (!require("BiocManager", quietly = TRUE))
  install.packages("BiocManager")
BiocManager::install(version = "3.15")
BiocManager::install("KEGGgraph")
if (!requireNamespace("BiocManager", quietly = TRUE))
  install.packages("BiocManager")
BiocManager::install("KEGGREST")
BiocManager::install("EnrichmentBrowser")
library("KEGGREST")
library("EnrichmentBrowser")

library(KEGGgraph)
library(shiny)
library(ggiraph)
library(ggplot2)
library(igraph)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Pathway testing"),
  
  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      selectInput(
        inputId = "geneInput",
        label = "Genes",
        choices = c("hsa05212"),
      ),
      selectizeInput(
        inputId = "searchme", 
        label = "Search Bar",
        multiple = FALSE,
        choices = c("Search Bar" = "", paste0(LETTERS,sample(LETTERS, 26))),
        options = list(
          create = FALSE,
          placeholder = "Search Me",
          maxItems = '1',
          onDropdownOpen = I("function($dropdown) {if (!this.lastQuery.length) {this.close(); this.settings.openOnFocus = false;}}"),
          onType = I("function (str) {if (str === \"\") {this.close();}}")
        ))
    ),
    
    # Show interactive plot
    mainPanel(
      ggiraphOutput(outputId="genePlot", width = 1400, height=900)
    )
  )
)
gene_info <- keggGet("hsa05212")
## a function to parse the data
parseIt <- function(x) {
  nr <- length(x$GENE)
  GeneID <- x$GENE[seq(1, nr, 2)]
  d.f <- do.call(rbind, strsplit(x$GENE[seq(2, nr, 2)], "; "))
  colnames(d.f) <- c("SYMBOL","DESCRIPTION")
  data.frame(GeneID, d.f, stringsAsFactors = FALSE)
}
gene_info_df <- parseIt(gene_info[[1]])

# Define server logic required to draw interactive plot
server <- function(input, output) {
  
  output$genePlot <- renderggiraph({
    # Retreive KEGG data
    mapkKGML <- system.file(sprintf("extdata/%s.xml", input$geneInput),package="KEGGgraph")
    wntKGML <- system.file(sprintf("extdata/%s.xml",input$geneInput), package="KEGGgraph")
    
    #Format KEGG data into useable format
    mapkG <- parseKGML2Graph(mapkKGML,expandGenes=TRUE)
    mapkGall <- parseKGML2Graph(mapkKGML,genesOnly=FALSE)
    mapkGsub <- subGraphByNodeType(mapkGall, "compound")
    wntG <- parseKGML2Graph(wntKGML, genesOnly=TRUE)
    graphs <- list(mapk=mapkGsub, wnt=wntG)
    merged <- mergeGraphs(graphs)
    
    # Get node layout (neato same as original plot)
    layout <- layout_with_neato(merged)
    colnames(layout) <- c("x", "y")
    
    # Prepare node data
    node_data <- data.frame(
      id = V(merged)$name,
      x = layout[,1],
      y = layout[,2],
      stringsAsFactors = FALSE
    )
    
    # Translate KEGG IDs to Gene Symbols and match descriptions
    outs <- sapply(edges(merged), length) > 0
    ins <- sapply(inEdges(merged), length) > 0
    ios <- outs | ins
    
    if(require(org.Hs.eg.db)) {
      node_data$GeneID <- translateKEGGID2GeneID(node_data$id)
      # Match with gene_info_df
      node_data <- merge(node_data, gene_info_df, by = "GeneID", all.x = TRUE)
      # Fill symbol: use SYMBOL if available, else GeneID, else original id
      node_data$symbol <- ifelse(!is.na(node_data$SYMBOL), node_data$SYMBOL, 
                                 ifelse(!is.na(node_data$GeneID), node_data$GeneID, node_data$id))
    } else {
      node_data$symbol <- node_data$id
      node_data$DESCRIPTION <- NA
    }
    
    # Prepare edge data
    edge_data <- as_data_frame(merged, what = "edges")
    edge_data <- merge(edge_data, node_data[,c("id","x","y")], by.x = "from", by.y = "id")
    edge_data <- merge(edge_data, node_data[,c("id","x","y")], by.x = "to", by.y = "id", suffixes = c("_from", "_to"))
    
    # Create tooltip text
    node_data$tooltip <- ifelse(!is.na(node_data$DESCRIPTION),
                                paste0("<b>基因名:</b> ", node_data$symbol, "<br><b>描述:</b> ", node_data$DESCRIPTION),
                                paste0("<b>节点ID:</b> ", node_data$id))
    
    # Build ggplot with interactive elements
    p <- ggplot() +
      # Plot edges
      geom_segment(data = edge_data, aes(x = x_from, y = y_from, xend = x_to, yend = y_to),
                   color = "black", size = 0.5, arrow = arrow(length = unit(0.1, "inches"))) +
      # Plot nodes
      geom_point_interactive(data = node_data, 
                             aes(x = x, y = y, fill = ifelse(id %in% names(ios)[ios], "orange", "lightgrey"),
                                 tooltip = tooltip, data_id = id),
                             shape = 21, size = 12, stroke = 1) +
      # Plot node labels
      geom_text_interactive(data = node_data, aes(x = x, y = y, label = symbol, data_id = id),
                            size = 4, color = "black") +
      # Set theme to match original plot
      theme_void() +
      scale_fill_identity() +
      coord_equal()
    
    # Convert to ggiraph object
    ggiraph(code = print(p), hover_css = "cursor:pointer;fill:#FFA500;")
  })
}

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

关键说明 #

• 用layout_with_neato保持与原绘图完全一致的节点布局
• 通过merge将节点数据与gene_info_df关联，自动匹配基因描述
• tooltip支持HTML格式，可自定义提示内容的排版
• hover_css参数可自定义悬停时的节点样式，增强交互反馈

内容的提问来源于stack exchange，提问作者Dimitris Karditsas