1

networkD3Shiny のプロットでマウスオーバー時に表示されるツールチップを作成しようとしています。以下の例ではtwitteR、Shiny アプリのユーザーがtwitteR検索からデータを生成できるようにし、ソース screenName、ターゲット screenName、およびツイートのテキストを含む互換性のあるエッジ リストgraphTweetsを作成しました。networkD3次に、このエッジリストを に渡しsimpleNetworkます。

以下の例で、ハイパーリンクを twitter アカウントにバインドする方法を示しましたclickAction。また、各リンクに関連付けられた各ツイートのテキストを含むリストをネットワーク グラフに追加しました。各リンクのマウスオーバーでこのテキストを表示するために使用できる R または JS コードはありますか?

library(shiny)
library(networkD3)
library(twitteR)
library(graphTweets)
library(dplyr)

ui <- shinyUI(fluidPage(sidebarLayout(
  sidebarPanel(
    textInput("searchkw", "Search:"),
    actionButton("btn", "Click to Generate")
  ),
  mainPanel(simpleNetworkOutput("network"))
)))

server <- shinyServer(function(input, output) {
  #Set up twitteR OAuth
  consumer_key <- xxxxxxxxxxxxxxxxxxxxxxxxx
  consumer_secret <- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  access_token <- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  access_secret <- xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
  setup_twitter_oauth(consumer_key, consumer_secret, access_token, access_secret)

  edges <- eventReactive(input$btn, {
    #search twitter, convert to dataframe, and get edges with text vector
    tw.edges <- twListToDF(searchTwitter(input$searchkw)) %>%
     getEdges(tweets = "text", source = "screenName", str.length = NULL, "text")
    tw.edges$text <- sapply(tw.edges$text, function(row) iconv(row, "latin1", "ASCII", sub = "")) #convert text to useable format
    return(tw.edges)
  })

  output$network <- renderSimpleNetwork({
    sn <- simpleNetwork(edges()) #Create simplenetwork graph
    sn$x$nodes$link <- paste0('https://twitter.com/', sn$x$nodes$name) #Add links to twitter accounts to nodes
    sn$x$options$clickAction = 'window.open(d.link)' #Bind node clicks to links
    sn$x$links$text <- edges()$text #Add text as links property
    #How to bind to mouse over/out??#
    return(sn)
  })
})

shinyApp(ui = ui, server = server)
4

1 に答える 1