ndtv и r блестящий: ярлыки для узлов не отображаются - PullRequest
Новая
       25

ndtv и r блестящий: ярлыки для узлов не отображаются

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

Я создал это приложение: https://usaskssrl.shinyapps.io/AnnualReport_2017_18/

Я пытаюсь сделать динамическую визуализацию сети в R блестящей (вкладка: Анализ сети, загрузка занимает несколько минут) ,

Все выглядит так, как будто все работает нормально , но нет никаких ярлыков для узлов .

Я не отвечал за эту часть приложения, но воткод для вашей справки (также доступен через мою ссылку на репозиторий ниже)

Global.R (строка 225): 

library(ndtv)
library(network)  
#SOCIAL NETOWORK ANALYSIS

 nodes <- read.csv   (text=getURL("https://raw.githubusercontent.com/AhmadMobin/SSRL201712018/master/ssrlNODES17%2618%5B1%5D.csv"),header = TRUE, stringsAsFactors = FALSE, fileEncoding = "UTF-8")

 links <-  read.csv  (text=getURL("https://raw.githubusercontent.com/AhmadMobin/SSRL201712018/master/ssrlEDGES17%2618%5B1%5D.csv"),header = TRUE, stringsAsFactors = FALSE, fileEncoding = "UTF-8")  

 net3 <- network(links, vertex.attr=nodes, matrix.type="edgelist",
            loops=F, multiple=F, ignore.eval = F)

 net3[,]
 net3 %n% "net.name" <- "SSRL Network" # network attribute
 net3 %v% "group" # Node attribute
 net3 %e% "value" # Edge attribute

 net3 %v% "col" <- c("blueviolet", "blue", "red", "midnightblue")[net3 %v% "group"]
 plot(net3, vertex.cex=(net3 %v% "size")/7, vertex.col="col")

 vs <- data.frame(onset=0, terminus=204, vertex.id=1:88)
 es <- data.frame(onset=1:203, terminus=204,
             head=as.matrix(net3, matrix.type="edgelist")[,1],
             tail=as.matrix(net3, matrix.type="edgelist")[,2])

 net3.dyn <- networkDynamic(base.net=net3, edge.spells=es, vertex.spells=vs)

Server.R (строка 216): 

 #NETWORK ANALYSIS
 output$netPlot <- ndtv:::renderNdtvAnimationWidget({
    render.d3movie(net3.dyn, usearrows = F,
                   displaylabels = F, label=net3 %v% "group",
                   bg="#ffffff", vertex.border="#333333",
                   vertex.cex = net3 %v% "size"/10,
                   vertex.col = net3.dyn %v% "col",
                   edge.lwd = (net3.dyn %e% "value")/10,
                   edge.col = '#55555599',
                   vertex.tooltip = paste("<b>Name:</b>", (net3.dyn %v% "name") , "<br>",
                                          "<b>Group:</b>", (net3.dyn %v% "group.name")),
                   edge.tooltip = paste("<b>Number of Collaborations:</b>", (net3.dyn %e% "value" )),
                   #launchBrowser=T, filename="SSRL SNA 2017 and 2018.html", #don't think this line is needed
                   render.par=list(tween.frames = 30, show.time = F), output.mode = 'htmlWidget')
   }
   )

Ui.R (строка 129): 

 tabItem(tabName="sixth",
                      h5("Note: This will take a few minutes to load"),
                      HTML ('</br>'),
                      ndtv:::ndtvAnimationWidgetOutput("netPlot")
                      )
            )) 
 )

Это не мой код, но если у вас, ребята, есть какие-либо предложения по его очистке, я был бы также признателен за это!

Мой репозиторий GitHub можно найти здесь: https://github.com/AhmadMobin/SSRL201712018

1 Ответ

0 голосов
/ 03 октября 2018

Ну, я нашел обходной путь.

Я создал сетевую анимацию и получил вывод HTML.Я разместил эту анимацию в Интернете и указал свое приложение на эту веб-страницу.Если вы нажмете на вкладку «Сетевой анализ», вы увидите, что я имею в виду https://usaskssrl.shinyapps.io/AnnualReport_2017_18/ http://ssrl.usask.ca/documents/SSRL%20SNA%202017%20and%202018.html

Для тех, кто заинтересован, вот код для анимации 

library(ndtv)
library(network)
library(RCurl) #package for the get URL function 

nodes <- read.csv (text=getURL(https://raw.githubusercontent.com/AhmadMobin/SSRL201712018/master/ssrlNODES17%2618%5B1%5D.csv"),header = TRUE, stringsAsFactors = FALSE, fileEncoding = "UTF-8")

links <- read.csv (text=getURL("https://raw.githubusercontent.com/AhmadMobin/SSRL201712018/master/ssrlEDGES17%2618%5B1%5D.csv"),header = TRUE, stringsAsFactors = FALSE, fileEncoding = "UTF-8")


 net3 <- network(links, vertex.attr=nodes, matrix.type="edgelist",
            loops=F, multiple=F, ignore.eval = F)

 net3[,]
 net3 %n% "net.name" <- "SSRL Network" # network attribute
 net3 %v% "group" # Node attribute
 net3 %e% "value" # Edge attribute

 net3 %v% "col" <- c("blueviolet", "blue", "red", "midnightblue")[net3 %v% "group"]
 plot(net3, vertex.cex=(net3 %v% "size")/7, vertex.col="col")

 vs <- data.frame(onset=0, terminus=204, vertex.id=1:88)
 es <- data.frame(onset=1:203, terminus=204,
             head=as.matrix(net3, matrix.type="edgelist")[,1],
             tail=as.matrix(net3, matrix.type="edgelist")[,2])
  net3.dyn <- networkDynamic(base.net=net3, edge.spells=es, vertex.spells=vs)

 compute.animation(net3.dyn, animation.mode = "kamadakawai",default.dist=2,
              slice.par=list(start=0, end=203, interval=1,
                             aggregate.dur=1, rule='any'))
 render.d3movie(net3.dyn, usearrows = F,
           displaylabels = F, label=net3 %v% "group",
           bg="#ffffff", vertex.border="#333333",
           vertex.cex = net3 %v% "size"/10,
           vertex.col = net3.dyn %v% "col",
           edge.lwd = (net3.dyn %e% "value")/10,
           edge.col = '#55555599',
           vertex.tooltip = paste("<b>Name:</b>", (net3.dyn %v% "name") , "<br>",
                                  "<b>Group:</b>", (net3.dyn %v% "group.name")),
           edge.tooltip = paste("<b>Number of Collaborations:</b>", (net3.dyn %e% "value" ) ),
           launchBrowser=T, filename="SSRL SNA 2017 and 2018.html",
           render.par=list(tween.frames = 30, show.time = F))
...