Отображать модальное диалоговое окно при наведении мыши на край сети в блестящем приложении - PullRequest
Новая
       15

Отображать модальное диалоговое окно при наведении мыши на край сети в блестящем приложении

0 голосов
/ 24 сентября 2018

У меня есть простое блестящее приложение ниже.Как вы увидите, я визуализирую одну и ту же сеть в обоих случаях, но с разницей.В сети вверху отображаются все ребра между двумя узлами, а во втором - только один.Я обнаружил, что это происходит из-за 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()

  })

}
...