当鼠标悬停在闪亮的应用程序的网络边缘上时，显示模式对话框

Question

我下面有一个简单的闪亮应用程序。如您所见，在两种情况下，我都可以看到相同的网络，但有所不同。顶部的网络显示两个节点之间的所有边缘，而第二个仅显示一个。我发现发生这种情况的原因是visIgraphLayout()，不幸的是我无法删除它，因为它改善了我的应用程序的性能。因此，我想在底部的网络中两个节点之间的唯一边缘上悬停鼠标时，显示所有边缘的另一种方法。我想到了一个弹出窗口或一个对话框消息，它将在鼠标悬停后显示所有边缘，或者提供了另一种方法，但是我不确定如何以及是否可以在我的应用程序中实现它。

 #dataset

id<-c("articaine","benzocaine","etho","esli")
  label<-c("articaine","benzocaine","etho","esli")
  node<-data.frame(id,label)

  from<-c("articaine","articaine","articaine","articaine","articaine","articaine","articaine","articaine","articaine")
  to<-c("benzocaine","etho","esli","benzocaine","etho","esli","benzocaine","etho","esli")
  title<-c("SCN1A","SCN1A","SCN1A","SCN2A","SCN2A","SCN2A","SCN3A","SCN3A","SCN3A")

  edge<-data.frame(from,to,title)

应用

library(igraph)
library(visNetwork)
library(dplyr)
library(shiny)
library(shinythemes)

ui <- fluidPage(theme = shinytheme("cerulean"),  # Specify that the Cerulean Shiny theme/template should be used

                # Generate Title Panel at the top of the app
                titlePanel("Network Visualization App"),  

                # Render as a sidebarLayout. Shiny expects that a sidebarPanel() function and a mainPanel() function are present.

                sidebarLayout(

                  # Sidebar section. Can set the width of the sidebar for any value ranging from 1 to 12.

                  sidebarPanel(             
                  ), # End of the sidebar panel code

                  # Define the main panel
                  mainPanel(

                    h3("Network Visualization"),

                    # Plot the network diagram within the main panel. 
                    # Note that visNetworkOutput is not a Shiny package function, but a visNetwork package function.
                    visNetworkOutput("plot1"),
                    fluidRow(
                      visNetworkOutput("plot2")
                    )

                    ) # End of main panel code

                )
)
#server.r
library(igraph)
library(visNetwork)
library(dplyr)
library(shiny)
library(shinythemes)

server <- function (input, output, session){



  # Use the renderVisNetwork() function to render the network data.
  output$plot1 <- renderVisNetwork({
    visNetwork(nodes = node,edge)%>% 


      visOptions(highlightNearest=T, nodesIdSelection = T) %>%

      # Specify that hover interaction and on-screen button navigations are active
      visInteraction(hover = T, navigationButtons = T) %>%

      visPhysics(stabilization = F)

  })
  output$plot2 <- renderVisNetwork({
    visNetwork(nodes = node,edge)%>% 


      visOptions(highlightNearest=T, nodesIdSelection = T) %>%

      # Specify that hover interaction and on-screen button navigations are active
      visInteraction(hover = T, navigationButtons = T) %>%

      visIgraphLayout()

  })

}