Search code examples
rshinylabelnodesnetwork-analysis

ndtv and r shiny: labels for nodes do not show up


I have created this application: https://usaskssrl.shinyapps.io/AnnualReport_2017_18/

I am trying to make a network dynamic visualization in R shiny (tab: Network Analysis, this takes a few minutes to load).

Everything looks like it works fine but there isn't any labels for the nodes.

I wasn't responsible for this part of the app but here is the code for your reference (can also be accessed through my repo- see link below)

Global.R (line 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 (line 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 (line 129):

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

This is not my code, but if you guys have any suggestions to clean it up I would greatly appreciate that as well!

My GitHub Repo can be found here: https://github.com/AhmadMobin/SSRL201712018


Solution

  • Well I found a work around.

    I created the network animation and had the output be HTML. I hosted that animation online and pointed my app to that webpage. If you click on the "Network Analysis" tab you will see what I mean https://usaskssrl.shinyapps.io/AnnualReport_2017_18/ http://ssrl.usask.ca/documents/SSRL%20SNA%202017%20and%202018.html

    For those interested, here is the code for the animation

    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))