├── .gitattributes ├── .gitignore ├── README.md ├── fixed_position_igraph.R ├── gganimate_ggraph.R ├── gganimate_ggraph_1.R ├── ggnet_kohda.R ├── ggnetwork_edgelabel.R ├── ggnetwork_forestfire.R ├── ggnetwork_gganimate.R ├── ggnetwork_sparrows.R ├── ndtv_interactivity.R ├── networkD3_forceNetwork.R ├── networkly3d.R ├── simplenetwork1.R ├── smallmultiple_ggnet.R ├── threejs.R ├── visNetwork_eg1.R └── viznet_script.R /.gitattributes: -------------------------------------------------------------------------------- 1 | # Auto detect text files and perform LF normalization 2 | * text=auto 3 | 4 | # Custom for Visual Studio 5 | *.cs diff=csharp 6 | 7 | # Standard to msysgit 8 | *.doc diff=astextplain 9 | *.DOC diff=astextplain 10 | *.docx diff=astextplain 11 | *.DOCX diff=astextplain 12 | *.dot diff=astextplain 13 | *.DOT diff=astextplain 14 | *.pdf diff=astextplain 15 | *.PDF diff=astextplain 16 | *.rtf diff=astextplain 17 | *.RTF diff=astextplain 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Windows image file caches 2 | Thumbs.db 3 | ehthumbs.db 4 | 5 | # Folder config file 6 | Desktop.ini 7 | 8 | # Recycle Bin used on file shares 9 | $RECYCLE.BIN/ 10 | 11 | # Windows Installer files 12 | *.cab 13 | *.msi 14 | *.msm 15 | *.msp 16 | 17 | # Windows shortcuts 18 | *.lnk 19 | 20 | # ========================= 21 | # Operating System Files 22 | # ========================= 23 | 24 | # OSX 25 | # ========================= 26 | 27 | .DS_Store 28 | .AppleDouble 29 | .LSOverride 30 | 31 | # Thumbnails 32 | ._* 33 | 34 | # Files that might appear in the root of a volume 35 | .DocumentRevisions-V100 36 | .fseventsd 37 | .Spotlight-V100 38 | .TemporaryItems 39 | .Trashes 40 | .VolumeIcon.icns 41 | 42 | # Directories potentially created on remote AFP share 43 | .AppleDB 44 | .AppleDesktop 45 | Network Trash Folder 46 | Temporary Items 47 | .apdisk 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # rmeetup_examples 2 | 3 | This contains the data and code for recreating examples shown in my RMeetup Dynamic and Interctive Network Visualizations Presentation. 4 | 5 | [The slides are available here](http://curleylab.psych.columbia.edu/netviz/). 6 | -------------------------------------------------------------------------------- /fixed_position_igraph.R: -------------------------------------------------------------------------------- 1 | ### Animation 4. 2 | 3 | detach(package:sna) 4 | detach(package:network) 5 | detach(package:igraph) 6 | 7 | library(igraph) 8 | 9 | N=100 10 | set.seed(11) 11 | g <- sample_forestfire(N, fw.prob=0.3,bw.factor=.9,directed=F) 12 | V(g)$color <- cluster_edge_betweenness(g)$membership 13 | E(g)$time <- 1:length(E(g)) 14 | 15 | 16 | ti <- 1 17 | gt <- delete_edges(g,which(E(g)$time > ti)) #remove edges which are not present 18 | 19 | #generate first layout using graphopt with normalized coordinates. This places the initially connected set of nodes in the middle. If you use fruchterman.reingold it will place that initial set in the outer ring. 20 | layout.old <- norm_coords(layout.graphopt(gt), xmin = -1, xmax = 1, ymin = -1, ymax = 1) 21 | 22 | 23 | 24 | 25 | #total time of the dynamics 26 | total_time <- max(E(g)$time) 27 | #This is the time interval for the animation. In this case is taken to be 1/10 28 | #of the time (i.e. 10 snapshots) between adding two consecutive nodes 29 | dt <- 0.1 30 | 31 | 32 | #setwd for output 33 | setwd("C:/Users/curley1/Dropbox/Work/R/RMeetup/presentation/gists/gistimg") 34 | 35 | 36 | #Output for each frame will be a png with HD size 800x450 :) 37 | png(file="output_%03d.png", width=800,height=450) 38 | 39 | 40 | #Time loop starts 41 | for(time in seq(1, total_time,dt)){ 42 | 43 | #remove edges which are not present 44 | gt <- delete_edges(g,which(E(g)$time > time)) 45 | #with the new graph, we update the layout a little bit 46 | layout.new <- layout_with_fr(gt,coords=layout.old,niter=10,start.temp=0.05,grid="nogrid") 47 | #plot the new graph 48 | plot(gt,layout=layout.new,vertex.label="",vertex.size=1+2*log(degree(gt)),vertex.frame.color=V(g)$color,edge.width=1.5,asp=9/16,margin=-0.15) 49 | #use the new layout in the next round 50 | layout.old <- layout.new 51 | } 52 | dev.off() 53 | 54 | -------------------------------------------------------------------------------- /gganimate_ggraph.R: -------------------------------------------------------------------------------- 1 | ## Animation 1. 2 | 3 | set.seed(787) 4 | gr <- aging.prefatt.game(100, pa.exp=1, aging.exp=-3, aging.bin=500) 5 | edges <- data.frame(from = get.edgelist(gr)[,1], to = get.edgelist(gr)[,2]) 6 | edges <- edges[order(edges$from),] 7 | 8 | edges$time <- 1:nrow(edges) 9 | edges$timebins <- as.numeric(cut(edges$time, breaks = 100)) 10 | 11 | 12 | # We want that nice fading effect so we need to add extra data for the trailing 13 | edgesAnim <- lapply(1:10, function(i) {edges$timebins <- edges$timebins + i; edges$delay <- i; edges}) 14 | edges$delay <- 0 15 | edgesAnim <- rbind(edges, do.call(rbind, edgesAnim)) 16 | edgesGraph <- graph_from_data_frame(edgesAnim, directed = F) 17 | 18 | 19 | 20 | 21 | # We use only original data for the layout 22 | subGr <- subgraph.edges(edgesGraph, which(E(edgesGraph)$delay == 0)) 23 | V(subGr)$degree <- degree(subGr) 24 | V(subGr)$group <- cluster_edge_betweenness(subGr)$membership 25 | lay <- createLayout(subGr, 'igraph', algorithm = 'lgl') 26 | 27 | 28 | # Then we reassign the full graph with edge trails 29 | attr(lay, 'graph') <- edgesGraph 30 | head(lay) 31 | 32 | cols <- gplots::col2hex(terrain.colors(10)[-10]) 33 | cols[lay$group] 34 | cols$group <- cols[lay$group] 35 | 36 | cols <- gplots::col2hex(terrain.colors(10)[-10]) 37 | lay$group <- cols[lay$group] 38 | 39 | # Now we create the graph with timebins as frame 40 | p <- ggraph(data = lay) + 41 | geom_node_point(aes(size = degree, colour = group)) + #, colour = '#8b4836') + 42 | geom_edge_link0(aes(frame = timebins, alpha = delay, width = delay), edge_colour = '#ccf2ff') + 43 | scale_edge_alpha(range = c(1, 0), guide = 'none') + 44 | scale_edge_width(range = c(0.5, 1.5), trans = 'exp', guide = 'none') + 45 | scale_size(guide = 'none') + 46 | ggtitle('Temporal Ordering of Edge Attachment') + 47 | ggforce::theme_no_axes() + 48 | theme(plot.background = element_rect(fill = '#000'), 49 | panel.background = element_blank(), 50 | panel.border = element_blank(), 51 | plot.title = element_text(color = '#cecece')) 52 | 53 | # And then we animate 54 | animation::ani.options(interval=0.1) 55 | #gg_animate(p, 'animation.gif', title_frame = FALSE) 56 | gg_animate(p, 'animation.mp4', title_frame = FALSE) 57 | 58 | 59 | -------------------------------------------------------------------------------- /gganimate_ggraph_1.R: -------------------------------------------------------------------------------- 1 | #devtools::install_github('thomasp85/ggforce') 2 | #devtools::install_github("dgrtwo/gganimate") 3 | #devtools::install_github('thomasp85/ggraph') 4 | #devtools::install_github("hadley/ggplot2") 5 | 6 | library(ggraph) 7 | library(ggforce) 8 | library(gganimate) 9 | library(ggplot2) 10 | library(igraph) 11 | 12 | set.seed(787) 13 | N=100 14 | 15 | gr <- barabasi.game(100) 16 | #gr <- sample_forestfire(N, fw.prob=0.3,bw.factor=.9,directed=F) 17 | 18 | edges <- data.frame(from = get.edgelist(gr)[,1], to = get.edgelist(gr)[,2]) 19 | edges <- edges[order(edges$from),] 20 | 21 | edges$time <- 1:nrow(edges) 22 | edges$timebins <- as.numeric(cut(edges$time, breaks = 100)) 23 | 24 | 25 | # We want that nice fading effect so we need to add extra data for the trailing 26 | edgesAnim <- lapply(1:10, function(i) {edges$timebins <- edges$timebins + i; edges$delay <- i; edges}) 27 | edges$delay <- 0 28 | edgesAnim <- rbind(edges, do.call(rbind, edgesAnim)) 29 | edgesGraph <- graph_from_data_frame(edgesAnim, directed = F) 30 | 31 | 32 | 33 | 34 | # We use only original data for the layout 35 | subGr <- subgraph.edges(edgesGraph, which(E(edgesGraph)$delay == 0)) 36 | V(subGr)$degree <- degree(subGr) 37 | V(subGr)$group <- cluster_edge_betweenness(subGr)$membership 38 | lay <- createLayout(subGr, 'igraph', algorithm = 'lgl') 39 | 40 | 41 | # Then we reassign the full graph with edge trails 42 | attr(lay, 'graph') <- edgesGraph 43 | 44 | 45 | 46 | 47 | # Now we create the graph with timebins as frame 48 | p <- ggraph(data = lay) + 49 | geom_node_point(aes(size = degree, colour = factor(group))) + 50 | geom_edge_link0(aes(frame = timebins, alpha = delay, width = delay, colour = factor(node1.group)), data = gEdges(nodePar = 'group')) + 51 | # geom_edge_link0(aes(frame = timebins, alpha = delay, width = delay), edge_colour = '#ffffff') + 52 | scale_edge_alpha(range = c(1, 0), guide = 'none') + 53 | scale_edge_width(range = c(0.5, 1.5), trans = 'exp', guide = 'none') + 54 | scale_size(guide = 'none') + 55 | ggtitle('Temporal Ordering of Edge Attachment') + 56 | ggforce::theme_no_axes() + 57 | theme(plot.background = element_rect(fill = '#000000'), 58 | panel.background = element_blank(), 59 | panel.border = element_blank(), 60 | plot.title = element_text(color = '#000000'), 61 | legend.position="none") 62 | 63 | p 64 | 65 | # And then we animate 66 | animation::ani.options(interval=0.2) 67 | #gg_animate(p, 'animation.gif', title_frame = FALSE) 68 | gg_animate(p, 'animation.mp4', title_frame = FALSE) 69 | getwd() 70 | -------------------------------------------------------------------------------- /ggnet_kohda.R: -------------------------------------------------------------------------------- 1 | kohda <- structure(list(Am = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 2 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 3 | 0L, 0L, 0L, 0L, 0L), Bm = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 4 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 5 | 0L, 0L, 0L, 0L, 0L, 0L), Cm = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 6 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 7 | 0L, 0L, 0L, 0L, 0L, 0L, 0L), Dm = c(1L, 1L, 0L, 0L, 0L, 0L, 0L, 8 | 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 9 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Em = c(0L, 0L, 0L, 0L, 0L, 0L, 10 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 11 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Fm = c(0L, 2L, 0L, 0L, 0L, 12 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 13 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Gm = c(0L, 0L, 0L, 0L, 14 | 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 15 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Hm = c(12L, 5L, 16 | 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 17 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Im = c(0L, 18 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 19 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Jm = c(0L, 20 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 7L, 0L, 0L, 0L, 0L, 0L, 21 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Km = c(0L, 22 | 0L, 0L, 0L, 0L, 0L, 0L, 4L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 23 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Lm = c(0L, 24 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 6L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 25 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Mm = c(0L, 26 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 27 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Nm = c(0L, 28 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 3L, 0L, 0L, 0L, 0L, 29 | 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Om = c(0L, 30 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 3L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 31 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Pm = c(0L, 32 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 33 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Qm = c(0L, 34 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 35 | 0L, 0L, 3L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Rm = c(0L, 36 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 37 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Sm = c(0L, 38 | 0L, 0L, 6L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 39 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L), Tm = c(0L, 40 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 4L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 41 | 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Um = c(0L, 42 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 43 | 0L, 0L, 10L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Vm = c(0L, 44 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 45 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Wm = c(0L, 46 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 47 | 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Xm = c(0L, 48 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 49 | 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Ym = c(0L, 50 | 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 51 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), Zm = c(0L, 52 | 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 53 | 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), am2 = c(0L, 54 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 3L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 55 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), bm2 = c(0L, 56 | 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 57 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), cm2 = c(0L, 58 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 59 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L), dm2 = c(0L, 60 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 61 | 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), em2 = c(0L, 62 | 2L, 0L, 17L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 63 | 0L, 0L, 4L, 0L, 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L)), .Names = c("Am", 64 | "Bm", "Cm", "Dm", "Em", "Fm", "Gm", "Hm", "Im", "Jm", "Km", "Lm", 65 | "Mm", "Nm", "Om", "Pm", "Qm", "Rm", "Sm", "Tm", "Um", "Vm", "Wm", 66 | "Xm", "Ym", "Zm", "am2", "bm2", "cm2", "dm2", "em2"), class = "data.frame", row.names = c("Am", 67 | "Bm", "Cm", "Dm", "Em", "Fm", "Gm", "Hm", "Im", "Jm", "Km", "Lm", 68 | "Mm", "Nm", "Om", "Pm", "Qm", "Rm", "Sm", "Tm", "Um", "Vm", "Wm", 69 | "Xm", "Ym", "Zm", "am2", "bm2", "cm2", "dm2", "em2")) 70 | 71 | 72 | 73 | 74 | rownames(kohda)<-colnames(kohda) 75 | dim(kohda) 76 | 77 | 78 | 79 | library(ggnet) 80 | library(network) 81 | library(sna) 82 | library(ggplot2) 83 | library(RColorBrewer) 84 | 85 | kohda.net <- as.network.matrix(kohda, directed=T) #make network object 86 | 87 | depth <- c(rep("shallow",2), "mid", rep("shallow",5), rep("mid",2), "shallow", "mid", rep("deep",2), rep("mid",4), "shallow", rep("deep",2), "mid", rep("deep",2), "shallow", rep("mid",5), "shallow") 88 | kohda.net %v% "depth" = depth #add vertex attribute 89 | 90 | kohda.net 91 | 92 | 93 | set.seed(576) 94 | 95 | ggnet2(kohda.net, 96 | node.size = 8, node.color = "depth", 97 | color.palette = "Set2", color.legend = "Water Depth", 98 | edge.size = 1, edge.color = "black", 99 | arrow.size = 9, arrow.gap = 0.027, 100 | legend.size=20) + 101 | guides(color=guide_legend(keyheight=0.5,default.unit="inch", 102 | override.aes = list(size=6))) 103 | 104 | 105 | 106 | 107 | ggnet2(kohda.net, 108 | node.size = 8, node.color = "depth", color.palette = "Set2", color.legend = "Water Depth", 109 | edge.size = 1, edge.color = c("color", "gray88"), 110 | arrow.size = 9, arrow.gap = 0.027, 111 | legend.size=20) + 112 | guides(color=guide_legend(keyheight=0.5,default.unit="inch",override.aes = list(size=6))) 113 | 114 | 115 | 116 | ggnet2(kohda.net, 117 | size = "outdegree", size.cut = 4, 118 | node.color = "depth", 119 | color.palette = "Set2", 120 | edge.size = 1, edge.color = c("color", "gray88"), 121 | arrow.size = 9, arrow.gap = 0.022 122 | ) + 123 | guides(color = FALSE, size = FALSE) 124 | -------------------------------------------------------------------------------- /ggnetwork_edgelabel.R: -------------------------------------------------------------------------------- 1 | ### From ggnetwork vignette: 2 | 3 | detach(package:igraph) 4 | detach(package:sna) 5 | detach(package:network) 6 | 7 | library(ggplot2) #must be >2.0.0 8 | library(ggnetwork) 9 | library(network) 10 | library(sna) 11 | library(rsvg) 12 | library(svglite) 13 | 14 | svglite("plot.svg", width = 11, height = 8) 15 | # Random graph 16 | set.seed(1) 17 | n <- network(rgraph(10, tprob = 0.2), directed = FALSE) 18 | n %v% "family" <- sample(letters[1:3], 10, replace = TRUE) 19 | n %v% "importance" <- sample(1:3, 10, replace = TRUE) 20 | e <- network.edgecount(n) #get total edges 21 | set.edge.attribute(n, "type", sample(letters[24:26], e, replace = TRUE)) 22 | set.edge.attribute(n, "day", sample(1:3, e, replace = TRUE)) 23 | 24 | # add ggrepel style edge labels 25 | ggplot(n, aes(x = x, y = y, xend = xend, yend = yend)) + 26 | geom_edges(aes(linetype = type), color = "grey75", size=1) + 27 | geom_nodes(color = "#ffff4d", size = 12) + 28 | geom_nodetext(aes(label = LETTERS[ vertex.names ]),size=8) + 29 | geom_edgetext_repel(aes(label = day), color = "white", fill = "gray20", 30 | box.padding = unit(1, "lines"), 31 | label.size = .25, 32 | size=6) + 33 | theme_minimal() + 34 | theme(axis.text = element_blank(), 35 | axis.title = element_blank(), 36 | panel.background = element_rect(fill = "gray20", color = "gray20"), 37 | plot.background = element_rect(fill = "gray20"), 38 | panel.grid = element_blank(), 39 | legend.position="none") 40 | 41 | dev.off() 42 | png::writePNG(rsvg("plot.svg"), "img/ggnetworkplot1.png") 43 | 44 | ### 45 | 46 | 47 | 48 | 49 | -------------------------------------------------------------------------------- /ggnetwork_forestfire.R: -------------------------------------------------------------------------------- 1 | # may need to detach sna/network if have them loaded 2 | 3 | detach(package:igraph) 4 | detach(package:sna) 5 | detach(package:network) 6 | 7 | library(igraph) 8 | library(viridis) 9 | library(ggnetwork) 10 | library(ggplot2) 11 | 12 | set.seed(56) 13 | g <- sample_forestfire(99, fw.prob=0.3,bw.factor=.9) 14 | V(g)$Group <- LETTERS[as.numeric(cut(V(g), 3))] 15 | 16 | ggplot(ggnetwork(g,arrow.gap=0,layout = "fruchtermanreingold", cell.jitter = 0.05), aes(x = x, y = y, xend = xend, yend = yend)) + 17 | geom_edges(color = "black") + 18 | geom_nodes(aes(color = Group), size = 8) + 19 | geom_nodetext(aes(label = vertex.names),color="black", fontface = "bold") + 20 | scale_color_viridis(discrete=T, option="D",begin=.5) + 21 | theme_blank() + 22 | guides(color=guide_legend(keyheight=0.3,default.unit="inch",override.aes = list(size=6))) 23 | 24 | -------------------------------------------------------------------------------- /ggnetwork_gganimate.R: -------------------------------------------------------------------------------- 1 | 2 | detach(package:sna) 3 | detach(package:network) 4 | detach(package:igraph) 5 | 6 | 7 | library(igraph) 8 | library(dplyr) 9 | library(ggnetwork) 10 | library(gganimate) 11 | library(ggplot2) 12 | 13 | ### ggnetwork + gganimate 14 | 15 | 16 | N=120 17 | set.seed(140) 18 | g <- sample_forestfire(N, fw.prob=0.3,bw.factor=.9) 19 | V(g)$Group <- cluster_edge_betweenness(g)$membership 20 | df<-ggnetwork(g,arrow.gap=0,layout = "fruchtermanreingold", cell.jitter = 0.05) 21 | 22 | df1 <- df[(N+1):nrow(df),] 23 | 24 | results=NULL 25 | for(i in 1:nrow(df1)){ 26 | results[[i]] <- df1[1:i,] 27 | } 28 | 29 | df2 <- do.call('rbind', Map(cbind, results, time=1:nrow(df1))) 30 | 31 | 32 | ## need to find which time each node first appears and then add an NA for that node from that time onwards 33 | # this could be tidied up a bit 34 | library(dplyr) 35 | head(df2) 36 | mintimes<-rbind( 37 | df2 %>% group_by(x,y) %>% summarise(time=min(time)), 38 | df2 %>% group_by(xend,yend) %>% summarise(time=min(time)) %>% rename(x=xend,y=yend) 39 | ) %>% group_by(x,y) %>% summarise(time=min(time)) %>% ungroup() %>% as.data.frame 40 | 41 | dfx <- as.data.frame.matrix(df[1:N,]) 42 | mintimes$x<-as.numeric(mintimes$x) 43 | mintimes$y<-as.numeric(mintimes$y) 44 | nodetimes <- dfx %>% left_join(mintimes) 45 | 46 | 47 | #expand rows to fill up to end of time 48 | mt<-max(df2$time) 49 | df.expanded <- nodetimes[rep(row.names(nodetimes), (mt-nodetimes$time)), 1:9] 50 | 51 | head(df.expanded,20) 52 | df.expanded1 <- df.expanded %>% group_by(vertex.names) %>% mutate(time = time + row_number() - 1) 53 | 54 | 55 | ## bind back 56 | 57 | df3 <- rbind(df.expanded1, df2) 58 | 59 | p=ggplot(df3, aes(x = x, y = y, xend = xend, yend = yend, frame=time)) + 60 | geom_edges(color = "black") + 61 | geom_nodes(aes(color = factor(Group)), size = 8) + 62 | geom_nodetext(aes(label = vertex.names),color="black", fontface = "bold") + 63 | theme_blank() + 64 | theme(legend.position="none") + 65 | guides(color=guide_legend(keyheight=0.3,default.unit="inch",override.aes = list(size=6))) 66 | 67 | animation::ani.options(interval=0.25) 68 | gg_animate(p, 'animation1.mp4', title_frame = FALSE) 69 | 70 | 71 | 72 | 73 | 74 | ## Animation 3. 75 | 76 | # take df3 from above 77 | 78 | head(df3) 79 | 80 | df3.sp <- split(df3, df3$time) 81 | 82 | #setwd for output 83 | setwd("C:/Users/curley1/Dropbox/Work/R/RMeetup/presentation/gists/gistimgsvg1") 84 | 85 | 86 | #Time loop starts 87 | for(i in 1:max(df3$time)){ 88 | 89 | tmp<-rbind(df3.sp[[i]],data.frame(x=NA,y=NA,Group=1:max(df3$Group),na.x=NA,vertex.names=NA,xend=NA,yend=NA,na.y=NA,time=NA)) 90 | 91 | pp <- ggplot(tmp, aes(x = x, y = y, xend = xend, yend = yend)) + 92 | geom_edges(color = "black") + 93 | geom_nodes(aes(color = factor(Group)), size = 8) + 94 | geom_nodetext(aes(label = vertex.names),color="black", fontface = "bold") + 95 | theme_blank() + 96 | xlim(0,1)+ylim(0,1) + 97 | theme(legend.position="none") + 98 | guides(color=guide_legend(keyheight=0.3,default.unit="inch",override.aes = list(size=6))) 99 | 100 | ggsave(pp,filename=paste0("output_",i,".png", sep="")) 101 | 102 | 103 | } 104 | 105 | dev.off() 106 | 107 | 108 | -------------------------------------------------------------------------------- /ggnetwork_sparrows.R: -------------------------------------------------------------------------------- 1 | ### Sparrow Example. 2 | 3 | detach(package:igraph) 4 | detach(package:sna) 5 | detach(package:network) 6 | 7 | library(igraph) 8 | library(DT) # pretty tables 9 | library(dplyr) 10 | library(ggrepel) 11 | library(svgPanZoom) # zoom, zoom 12 | library(SVGAnnotation) # to help svgPanZoom; it's a bioconductor package 13 | 14 | sparrows <- structure(list(x1 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 15 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 16 | 0L, 0L), x2 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 17 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L 18 | ), x3 = c(3L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 19 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), 20 | x4 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 21 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L 22 | ), x5 = c(9L, 0L, 14L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 23 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 24 | 0L), x6 = c(7L, 0L, 0L, 8L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 25 | 1L, 3L, 4L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 26 | 0L), x7 = c(0L, 0L, 1L, 0L, 0L, 7L, 0L, 0L, 0L, 0L, 1L, 0L, 27 | 1L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 28 | 0L), x8 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 29 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 30 | 0L), x9 = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 31 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 32 | 0L), x10 = c(0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 3L, 0L, 0L, 33 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 34 | 0L, 0L), x11 = c(0L, 2L, 1L, 0L, 4L, 5L, 3L, 0L, 0L, 0L, 35 | 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 36 | 0L, 0L, 0L), x12 = c(0L, 0L, 0L, 0L, 0L, 3L, 6L, 0L, 0L, 37 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 38 | 0L, 0L, 0L, 0L), x13 = c(0L, 0L, 4L, 0L, 11L, 5L, 10L, 0L, 39 | 0L, 0L, 0L, 4L, 0L, 0L, 2L, 0L, 1L, 0L, 0L, 0L, 2L, 0L, 0L, 40 | 0L, 0L, 0L, 0L, 0L), x14 = c(28L, 0L, 1L, 0L, 0L, 2L, 2L, 41 | 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 3L, 0L, 0L, 42 | 0L, 0L, 0L, 0L, 0L, 0L), x15 = c(0L, 0L, 4L, 0L, 1L, 12L, 43 | 30L, 0L, 0L, 0L, 12L, 1L, 0L, 3L, 0L, 0L, 0L, 0L, 0L, 0L, 44 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x16 = c(0L, 0L, 0L, 0L, 45 | 0L, 0L, 3L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 46 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x17 = c(0L, 0L, 2L, 47 | 0L, 5L, 5L, 5L, 0L, 0L, 0L, 2L, 3L, 3L, 0L, 0L, 0L, 0L, 0L, 48 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x18 = c(0L, 0L, 49 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 22L, 50 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x19 = c(0L, 51 | 11L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 52 | 0L, 9L, 29L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x20 = c(0L, 53 | 2L, 0L, 8L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 54 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x21 = c(0L, 55 | 1L, 1L, 0L, 2L, 8L, 16L, 0L, 0L, 0L, 2L, 0L, 3L, 0L, 0L, 56 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x22 = c(0L, 57 | 0L, 7L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 58 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x23 = c(0L, 59 | 0L, 0L, 0L, 0L, 4L, 4L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 60 | 3L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x24 = c(2L, 61 | 0L, 0L, 0L, 5L, 4L, 3L, 0L, 0L, 0L, 0L, 0L, 0L, 9L, 0L, 0L, 62 | 2L, 0L, 0L, 0L, 2L, 1L, 0L, 0L, 0L, 0L, 0L, 0L), x25 = c(1L, 63 | 0L, 2L, 0L, 9L, 5L, 15L, 0L, 0L, 0L, 0L, 0L, 2L, 1L, 1L, 64 | 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x26 = c(0L, 65 | 0L, 0L, 0L, 0L, 0L, 3L, 0L, 0L, 0L, 1L, 0L, 0L, 1L, 0L, 0L, 66 | 5L, 4L, 0L, 0L, 9L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x27 = c(0L, 67 | 0L, 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 2L, 0L, 68 | 0L, 0L, 0L, 0L, 7L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), x28 = c(0L, 69 | 4L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 70 | 0L, 0L, 0L, 0L, 2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L)), .Names = c("x1", 71 | "x2", "x3", "x4", "x5", "x6", "x7", "x8", "x9", "x10", "x11", 72 | "x12", "x13", "x14", "x15", "x16", "x17", "x18", "x19", "x20", 73 | "x21", "x22", "x23", "x24", "x25", "x26", "x27", "x28"), class = "data.frame", row.names = c(NA, 74 | -28L)) 75 | 76 | sparrows <- sparrows[-8,-8] 77 | rownames(sparrows)<-colnames(sparrows) 78 | 79 | #Make graph with igraph 80 | gr <- graph_from_adjacency_matrix(as.matrix(sparrows)) 81 | 82 | #att vertex attribute size according to degree centrality 83 | V(gr)$size <- centralization.degree(gr)$res 84 | V(gr)$power <- round(hub.score(gr)$vector,2) 85 | 86 | 87 | #take a look 88 | datatable(arrange(data_frame(sparrow=V(gr)$name, centrality_degree=V(gr)$size, hub_score=V(gr)$power), desc(centrality_degree))) 89 | 90 | #ggiraph example 91 | library(ggiraph) 92 | sparrowdf <- data_frame(sparrow=V(gr)$name, centrality_degree=V(gr)$size, hub_score=V(gr)$power) 93 | 94 | gg_point_0 <- ggplot(sparrowdf, aes(x = centrality_degree, y = hub_score, tooltip = sparrow, data_id = sparrow) ) + 95 | geom_point_interactive(size=3) + theme_bw() + theme(text = element_text(size = rel(5.5))) +ylab("Hub Score")+ 96 | xlab("Degree Centrality") 97 | 98 | tooltip_css <- "background-opacity:0;font-size: 200%;font-style:italic;padding:10px;border-radius:10px 20px 10px 20px;" 99 | ggiraph(code = {print(gg_point_0)}, tooltip_offx = 10, tooltip_offy = -30,tooltip_extra_css = tooltip_css, tooltip_opacity = .75,hover_css = "stroke:red;fill:red;stroke-width:7pt" ) 100 | 101 | 102 | 103 | 104 | #give all edges weight 1 (unweighted) and simplify network 105 | E(gr)$weight <- 1 106 | g <- simplify(gr, edge.attr.comb="sum") 107 | 108 | #remove sna,network, igraph - issue arises if igraph loaded last as sna's is.bipartite masked by igraph 109 | detach("package:sna", unload=TRUE) 110 | detach("package:network", unload=TRUE) 111 | detach("package:igraph", unload=TRUE) 112 | 113 | library(igraph) 114 | library(network) 115 | library(sna) 116 | library(ggnetwork) 117 | 118 | # ggnetwork visualize 119 | set.seed(777) 120 | dat <- ggnetwork(g, layout="fruchtermanreingold", arrow.gap=0.0, cell.jitter=0) 121 | 122 | # add a "repelling label" to the nodes with higher centrality so it's easier to see who the "top talkers" are. 123 | 124 | ggplot() + 125 | geom_edges(data=dat, 126 | aes(x=x, y=y, xend=xend, yend=yend), 127 | color='#ccccff', curvature=0.3, size=0.2, alpha=0.7) + 128 | geom_nodes(data=dat, 129 | color="#6666ff", 130 | aes(x=x, y=y, xend=xend, yend=yend, size=sqrt(size)), 131 | alpha=0.5) + 132 | geom_label_repel(data=unique(dat[dat$size>30,c(1,2,6)]), 133 | aes(x=x, y=y, label=vertex.names), 134 | size=2, color="#3333ff") + 135 | theme_blank() + 136 | theme(legend.position="none") -> gg 137 | 138 | 139 | 140 | # pass the ggplot object to svgPlot and svgPanZoom to make it easier to generate a huge graph but still make it explorable. 141 | 142 | svgPanZoom(svgPlot(show(gg), height=3, width=3), 143 | width="600px", 144 | controlIconsEnabled=TRUE) 145 | 146 | 147 | 148 | -------------------------------------------------------------------------------- /ndtv_interactivity.R: -------------------------------------------------------------------------------- 1 | # ndtv & networkDynamic 2 | 3 | detach(package:sna) 4 | detach(package:network) 5 | detach(package:igraph) 6 | 7 | library(igraph) 8 | library(intergraph) 9 | library(network) 10 | library(randomNames) 11 | 12 | set.seed(5) 13 | N=30 14 | genders <- sample(c("Female", "Male"), N,T) 15 | 16 | df <- data.frame(id = randomNames(N,gender=genders, name.order = "first.last", name.sep = " "), 17 | sex=genders) 18 | 19 | g <- sample_forestfire(N, fw.prob=0.3,bw.factor=.9,directed=F) 20 | net<-intergraph::asNetwork(g) 21 | net %v% "col" <- c("green", "gold", "blue", "red", "pink")[edge.betweenness.community(g)$membership] 22 | 23 | net %v% "sex" <- genders 24 | net %v% 'id'<- as.character(df$id) 25 | net %v% "sizevar" <- sample(5:15,vcount(g),T) 26 | 27 | net %e% "type" <- sample(LETTERS[1:4],ecount(g),T) 28 | net %e% "weight" <- igraph::degree(g) 29 | 30 | library(ndtv) 31 | render.d3movie(net, usearrows = F, displaylabels = F, bg="#111111", 32 | vertex.border="#ffffff", vertex.col = net %v% "col", 33 | vertex.cex = (net %v% "sizevar")/8, 34 | edge.lwd = (net %e% "weight")/3, edge.col = '#55555599', 35 | vertex.tooltip = paste("Name:", (net %v% 'id') , "
", 36 | "Gender:", (net %v% 'sex')), 37 | edge.tooltip = paste("Edge type:", (net %e% 'type'), "
", 38 | "Edge weight:", (net %e% "weight" ) ), 39 | launchBrowser=T, filename="Network.html" ) 40 | 41 | 42 | 43 | library(networkDynamic) 44 | library(ndtv) 45 | ## Animation 6. 46 | 47 | # use 'net' made in ndtv_interactivity 48 | detach(package:igraph) 49 | 50 | net #30 nodes, #44 edges 51 | 52 | vs <- data.frame(onset=0, terminus=45, vertex.id=1:30) 53 | es <- data.frame(onset=1:45, terminus=45, 54 | head=as.matrix(net, matrix.type="edgelist")[,1], 55 | tail=as.matrix(net, matrix.type="edgelist")[,2]) 56 | 57 | net.dyn <- networkDynamic(base.net=net, edge.spells=es, vertex.spells=vs) 58 | 59 | 60 | plot(net.dyn, vertex.cex=(net %v% "size")/7, vertex.col="col") 61 | 62 | # Show time evolution through static images at different time points: 63 | filmstrip(net.dyn, displaylabels=F, mfrow=c(4, 8), 64 | slice.par=list(start=0, end=45, interval=5, 65 | aggregate.dur=5, rule='any')) 66 | 67 | 68 | 69 | compute.animation(net.dyn, animation.mode = "kamadakawai", 70 | slice.par=list(start=0, end=45, interval=2, 71 | aggregate.dur=1, rule='any')) 72 | 73 | 74 | render.d3movie(net.dyn, usearrows = F, displaylabels = F, label=net %v% "id", 75 | bg="#111111", 76 | #vertex.border="#ffffff", 77 | vertex.col = net %v% "col", 78 | vertex.cex = function(slice){ degree(slice)/2.5 }, 79 | edge.lwd = (net %e% "weight")/3, edge.col = '#55555599', 80 | vertex.tooltip = paste("Name:", (net %v% 'id') , "
", 81 | "Gender:", (net %v% 'sex')), 82 | edge.tooltip = paste("Edge type:", (net %e% 'type'), "
", 83 | "Edge weight:", (net %e% "weight" ) ), 84 | launchBrowser=F, filename="NetworkDynamic2.html", 85 | render.par=list(tween.frames = 15, show.time = F), 86 | script.type='remoteSrc') 87 | 88 | -------------------------------------------------------------------------------- /networkD3_forceNetwork.R: -------------------------------------------------------------------------------- 1 | ### networkD3 2 | 3 | detach(package:igraph) 4 | detach(package:sna) 5 | detach(package:network) 6 | 7 | library(networkD3) 8 | library(randomNames) 9 | library(igraph) 10 | 11 | # random name function 12 | random_name_df <- function(nl=100, size=1000, smpl=10, seed=221){ 13 | df = data.frame(source = randomNames(size,which.names='both', name.order = 'first.last', name.sep=' '), target = '') 14 | df = df[rep(seq_len(nrow(df)), sample(1:smpl,nrow(df), replace=T)),] 15 | df = df[sample(nrow(df),nl),] 16 | df$target = sample(df$source,nrow(df), replace = T) 17 | df = df[df[,1]!=df[,2], ] 18 | return(df) 19 | } 20 | 21 | # Basic Graph 22 | df <- random_name_df(seed=221) 23 | g <- graph.data.frame(df, directed=F) # raw graph 24 | 25 | ## Make a vertices df 26 | vertices<-data.frame( 27 | name = V(g)$name, 28 | group = edge.betweenness.community(g)$membership, 29 | betweenness = (betweenness(g,directed=F,normalized=T)*115)+0.1 30 | ) 31 | 32 | 33 | # create indices (indexing needs to be JS format) 34 | df$source.index = match(df$source, vertices$name)-1 35 | df$target.index = match(df$target, vertices$name)-1 36 | head(df) 37 | 38 | 39 | ## fn1 40 | 41 | # supply a edgelist + nodelist 42 | d3 = forceNetwork(Links = df, Nodes = vertices, 43 | Source = 'source.index', Target = 'target.index', 44 | NodeID = 'name', 45 | Group = 'group', # color nodes by group calculated earlier 46 | charge = -50, # node repulsion 47 | linkDistance = 20, 48 | zoom = T, 49 | opacity = 1, 50 | fontSize=24) 51 | 52 | show(d3) 53 | 54 | 55 | 56 | ##fn2 57 | 58 | ### Now add node size by betweenness 59 | d3 = forceNetwork(Links = df, Nodes = vertices, 60 | Source = 'source.index', Target = 'target.index', 61 | NodeID = 'name', 62 | Nodesize = 'betweenness', #sizing nodes by centrality 63 | Group = 'group', # color nodes by group calculated earlier 64 | charge = -50, # node repulsion 65 | linkDistance = 20, 66 | zoom = T, 67 | opacity = 1, 68 | fontSize=24) 69 | 70 | show(d3) 71 | 72 | 73 | # fn3 74 | 75 | ## The "JS" function allows you to directly write javascript 76 | 77 | ### Adding a colorScale 78 | 79 | library(RColorBrewer) 80 | 81 | scalecolors <- function(nodes, palette) { 82 | n <- max(unique(vertices$group)) 83 | cols <- rev(RColorBrewer::brewer.pal(n, palette)) 84 | cols <- paste0("'", paste(cols, collapse = "', '"), "'") 85 | networkD3::JS(paste0('d3.scale.ordinal().domain([0,', n, ']).range([', cols, '])')) 86 | } 87 | 88 | scalecolors(vertices, 'YlOrRd') 89 | 90 | #"d3.scale.ordinal().domain([0,9]).range(['#FFFFCC', '#FFEDA0', '#FED976', '#FEB24C', '#FD8D3C', '#FC4E2A', '#E31A1C', '#BD0026', '#800026'])" 91 | 92 | 93 | #Yellow-Orange-Red 94 | d3 = forceNetwork(Links = df, Nodes = vertices, 95 | Source = 'source.index', Target = 'target.index', 96 | NodeID = 'name', 97 | Group = 'group', 98 | Nodesize = 'betweenness', 99 | colourScale = scalecolors(vertices, 'YlOrRd'), 100 | charge = -70, # node repulsion 101 | linkDistance = 25, 102 | zoom = T, 103 | opacity = 1, 104 | fontSize=24) 105 | 106 | show(d3) 107 | 108 | 109 | 110 | 111 | 112 | 113 | ### to get customized text strings for colors 114 | 115 | cat(paste(shQuote(gplots::col2hex(heat.colors(9)), type="cmd"), collapse=", ")) 116 | cat(paste(shQuote(gplots::col2hex(terrain.colors(9)), type="cmd"), collapse=", ")) 117 | cat(paste(shQuote(gplots::col2hex(terrain.colors(10)[-10]), type="cmd"), collapse=", ")) #to avoid last color being too pale - "#F2F2F2" 118 | 119 | 120 | 121 | ### Couple of extra things - thanks to Kent Russell for help 122 | 123 | # fn4 124 | 125 | ### Change Background Color and Edge Color 126 | 127 | library(htmltools) 128 | browsable( 129 | tagList( 130 | forceNetwork(Links = df, Nodes = vertices, 131 | Source = 'source.index', Target = 'target.index', 132 | NodeID = 'name', 133 | Group = 'group', 134 | Nodesize = 'betweenness', 135 | colourScale = scalecolors(vertices, 'YlOrRd'), 136 | linkColour = "#fff", 137 | charge = -80, # node repulsion 138 | linkDistance = 25, 139 | zoom = T, 140 | opacity = 1, 141 | fontSize=24), 142 | tags$script( 143 | ' 144 | document.body.style.backgroundColor = "#000000" 145 | ' 146 | ) 147 | ) 148 | ) 149 | 150 | ## This hack also works but it's a bit naughty 151 | d3 = forceNetwork(Links = df, Nodes = vertices, 152 | Source = 'source.index', Target = 'target.index', 153 | NodeID = 'name', 154 | Group = 'group', 155 | Nodesize = 'betweenness', 156 | colourScale = scalecolors(vertices, 'YlOrRd'), 157 | linkColour = "#fff", 158 | charge = -80, # node repulsion 159 | linkDistance = JS('function(){d3.select("body").style("background-color", "#000"); return 25;}'), 160 | zoom = T, 161 | opacity = 1, 162 | fontSize=24) 163 | 164 | show(d3) 165 | 166 | 167 | 168 | ##fn5 169 | 170 | ## Add some clicking interactivity "clickAction" 171 | 172 | # standard effect adapted from vignette: 173 | # forceNetwork 174 | data(MisLinks) 175 | data(MisNodes) 176 | 177 | # Create graph 178 | forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source", 179 | Target = "target", Value = "value", NodeID = "name", 180 | Group = "group", opacity = 1, zoom = F, bounded = T) 181 | 182 | # with a simple click action - make the circles bigger when clicked 183 | MyClickScript <- 184 | ' d3.select(this).select("circle") 185 | .transition().duration(750).attr("r", 40) 186 | ' 187 | 188 | 189 | forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source", 190 | Target = "target", Value = "value", NodeID = "name", 191 | Group = "group", opacity = 1, zoom = T, fontSize=24, 192 | clickAction = MyClickScript) 193 | 194 | ### 195 | 196 | 197 | 198 | 199 | ## fn6 200 | 201 | ### Attempt at making a script to add text when node clicked 202 | 203 | myClickScript <- " 204 | // debugger is always our friend :) 205 | debugger; 206 | 207 | // use d3 enter, update, exit 208 | // make sure to get svg g so our tooltip will move with zoom&drag 209 | var tooltip = d3.select(el).select('svg g').selectAll('text#textid') 210 | .data([d.name + ' | group: ' + d.group]); 211 | 212 | // add if not there yet 213 | tooltip.enter().append('text') 214 | 215 | // update our attributes 216 | tooltip 217 | .text(function(d){return d;}) 218 | .attr('id', 'textid') 219 | .attr({'x':d.x,'y':d.y}) 220 | .style('font-size','22px'); 221 | " 222 | 223 | 224 | d3 = forceNetwork(Links = df, Nodes = vertices, 225 | Source = 'source.index', Target = 'target.index', 226 | NodeID = 'name', 227 | Group = 'group', 228 | Nodesize = 'betweenness', 229 | charge = -50, 230 | linkDistance = 20, 231 | colourScale = JS('d3.scale.ordinal() 232 | .range(["#e70351", "#e8fd02", "#eb03fe", "#fb9104", "#fd99ee", 233 | "#e8d97d", "#ea958a", "#fd01af", "#fc3002"]) 234 | .domain(d3.range(0,9))'), 235 | zoom = T, 236 | opacity = 0.9, 237 | fontSize = 0, 238 | clickAction = myClickScript) 239 | 240 | show(d3) 241 | 242 | 243 | 244 | 245 | 246 | -------------------------------------------------------------------------------- /networkly3d.R: -------------------------------------------------------------------------------- 1 | ### networkly: network visualization in R using Plotly 2 | 3 | #devtools::install_github("dgrapov/networkly") 4 | library(networkly) 5 | library(plotly) 6 | library(igraph) 7 | library(randomNames) 8 | 9 | ## Function for making random name edgelist dataframe 10 | random_name_df <- function(nlinks = 150,iter=1000,prox=10,seed=444){ 11 | set.seed(seed) 12 | df <- data.frame(source = randomNames(iter,which.names='both', name.order = 'first.last', name.sep=' '), target = '') 13 | df <- df[rep(seq_len(nrow(df)), sample(1:prox,nrow(df), replace=T)),] 14 | df <- df[sample(nrow(df),nlinks),] 15 | df$target = sample(df$source,nrow(df), replace = T) 16 | df = df[df[,1]!=df[,2], ] 17 | return(df) 18 | } 19 | 20 | mydf <- random_name_df() 21 | g = graph.data.frame(mydf, directed=F) # raw graph 22 | i <- edge.betweenness.community(g)$membership 23 | max(i) 24 | 25 | 26 | 27 | edge.list<-data.frame(source=mydf[,1], 28 | target=mydf[,2], 29 | color='#000000', 30 | size=2, 31 | names="A") 32 | 33 | 34 | 35 | 36 | node.data<-data.frame(color=terrain.colors(max(i))[i], 37 | size=degree(g), 38 | names=V(g)$name, 39 | stringsAsFactors = FALSE) 40 | 41 | 42 | ### Create 3D network 43 | layout<-"fruchtermanreingold" #see networkly::get_network for 2D and 3D options 44 | #net params 45 | type<-"3d" 46 | color<-'color' 47 | size<-'size' 48 | name<-'names' 49 | 50 | #create network objects 51 | obj<-get_network(edge.list,type=type,layout=layout) 52 | net<-c(get_edges(obj,color=color,width=size,name=name,type=type,hoverinfo="none",showlegend=FALSE), 53 | get_nodes(obj,node.data,color=color,size=size,name=name,type=type,hoverinfo="name",showlegend=FALSE)) 54 | 55 | 56 | net<-shiny_ly(net) 57 | 58 | #add layout options 59 | layout(net, 60 | scene = list(showlegend=F, 61 | yaxis=list(showgrid=FALSE,showticklabels=FALSE,zeroline=FALSE,title=""), 62 | xaxis=list(showgrid=FALSE,showticklabels=FALSE,zeroline=FALSE,title=""), 63 | zaxis=list(showgrid=FALSE,showticklabels=FALSE,zeroline=FALSE,title=""))) 64 | 65 | -------------------------------------------------------------------------------- /simplenetwork1.R: -------------------------------------------------------------------------------- 1 | library(networkD3) 2 | 3 | # Create data 4 | src <- c("A", "I", "A", "B", 5 | "B", "E", "C", "C", "D", "C", "B") 6 | target <- c("B", "C", "F", "J", 7 | "H", "F", "G", "H", "I", "I", "I") 8 | 9 | networkData <- data.frame(src, target) 10 | 11 | # Plot 12 | simpleNetwork(networkData, nodeColour = "red", nodeClickColour="blue",zoom=T,height=300,width=300, fontSize = 16) 13 | -------------------------------------------------------------------------------- /smallmultiple_ggnet.R: -------------------------------------------------------------------------------- 1 | 2 | ## Growing Model Graph - small multiple ggnet implementation 3 | 4 | library(dplyr) 5 | library(network) 6 | library(ggplot2) 7 | library(ggnet) 8 | library(RColorBrewer) 9 | 10 | # Set up our Network 11 | set.seed(777) 12 | g <- igraph::sample_pa_age(100, pa.exp=1, aging.exp=-0.4, aging.bin=20) # get igraph object from aging barbarsi game 13 | net <- network(intergraph::asNetwork(g),directed=F) #convert igraph object to network object 14 | 15 | # Set up the initial layout 16 | x = gplot.layout.fruchtermanreingold(net, NULL) 17 | net %v% "x" = x[, 1] 18 | net %v% "y" = x[, 2] 19 | 20 | # Get a data.frame of edges and add an arbitrary time unit 21 | dat <- as.data.frame(igraph::get.edgelist(g), stringsAsFactors = F) #get dataframe of edges 22 | colnames(dat)<-c("from", "to") #add column names 23 | dat$time <- round(seq.int(1,8,length.out=nrow(dat)),0) #add a time variable 24 | 25 | # Convert df to a matrix of when node present or absent 26 | tmp = data.frame(nodeid = c(dat$from,dat$to), time=dat$time) %>% group_by(nodeid) %>% 27 | filter(time==min(time)) %>% unique %>% arrange(nodeid) 28 | 29 | out <- sapply(tmp$time, function(i) c(rep(0, i-1), rep(1,8-i+1))) 30 | out[out==0]<-NA 31 | 32 | 33 | 34 | # Define vertex attribute activation as 1 or NA: 35 | net %v% "t1" = out[1,] 36 | net %v% "t2" = out[2,] 37 | net %v% "t3" = out[3,] 38 | net %v% "t4" = out[4,] 39 | net %v% "t5" = out[5,] 40 | net %v% "t6" = out[6,] 41 | net %v% "t7" = out[7,] 42 | net %v% "t8" = out[8,] 43 | 44 | #for color 45 | mycols <- rev(brewer.pal(9, "Greens")[-1]) #remove really overly light color 46 | 47 | 48 | # Create ggnet2 plots removing inactive nodes and setting initial layout 49 | t1 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t1") 50 | t2 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t2") 51 | t3 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t3") 52 | t4 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t4") 53 | t5 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t5") 54 | t6 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t6") 55 | t7 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t7") 56 | t8 = ggnet2(net, mode = c("x", "y"), size = 0, node.color = mycols[tmp$time], na.rm = "t8") 57 | 58 | 59 | # Set up some plot features 60 | b1 = theme(panel.background = element_rect(color = "grey50"), 61 | plot.title = element_text(size=rel(2.1))) 62 | b2 = geom_point(aes(color = color), size = 4, color = "white") 63 | b3 = geom_point(aes(color = color), size = 3, alpha = 0.4) 64 | b4 = geom_point(aes(color = color), size = 3) 65 | b5 = guides(color = FALSE) 66 | y1 = scale_y_continuous(limits = range(x[, 2] * 1.1), breaks = NULL) 67 | x1 = scale_x_continuous(limits = range(x[, 1] * 1.1), breaks = NULL) 68 | 69 | # show each temporal network 70 | gridExtra::grid.arrange(t1 + x1 + y1 + ggtitle("t = 1") + b1 + b2 + b3 + b4 + b5, 71 | t2 + x1 + y1 + ggtitle("t = 2") + b1 + b2 + b3 + b4 + b5, 72 | t3 + x1 + y1 + ggtitle("t = 3") + b1 + b2 + b3 + b4 + b5, 73 | t4 + x1 + y1 + ggtitle("t = 4") + b1 + b2 + b3 + b4 + b5, 74 | t5 + x1 + y1 + ggtitle("t = 5") + b1 + b2 + b3 + b4 + b5, 75 | t6 + x1 + y1 + ggtitle("t = 6") + b1 + b2 + b3 + b4 + b5, 76 | t7 + x1 + y1 + ggtitle("t = 7") + b1 + b2 + b3 + b4 + b5, 77 | t8 + x1 + y1 + ggtitle("t = 8") + b1 + b2 + b3 + b4 + b5, 78 | nrow = 2) 79 | 80 | 81 | 82 | -------------------------------------------------------------------------------- /threejs.R: -------------------------------------------------------------------------------- 1 | library(igraph) 2 | library(randomNames) 3 | library(threejs) 4 | 5 | ## Function for making random name edgelist dataframe 6 | random_name_df <- function(nlinks = 100,iter=1000,prox=10,seed=444){ 7 | set.seed(seed) 8 | df <- data.frame(source = randomNames(iter,which.names='both', name.order = 'first.last', name.sep=' '), target = '') 9 | df <- df[rep(seq_len(nrow(df)), sample(1:prox,nrow(df), replace=T)),] 10 | df <- df[sample(nrow(df),nlinks),] 11 | df$target = sample(df$source,nrow(df), replace = T) 12 | df = df[df[,1]!=df[,2], ] 13 | return(df) 14 | } 15 | 16 | mydf <- random_name_df() 17 | g = graph.data.frame(mydf, directed=F) # raw graph 18 | i <- edge.betweenness.community(g)$membership 19 | 20 | 21 | #V(g)$group <- edge.betweenness.community(g)$membership # betweeness centrality for each node for grouping 22 | #vertices<-data.frame('name' = unique(unlist(mydf))) # node names 23 | #g = graph.data.frame(mydf, directed=F, vertices=vertices) # raw graph 24 | #vertices$group = edge.betweenness.community(g)$membership # betweeness centrality for each node for grouping 25 | #plot(g) #basic igraph plot 26 | #graphjs(g) #link distance too great - charge too strong? - but works 27 | #graphjs(g, repulsion=0.2) 28 | 29 | 30 | #color names or hex(without opacity) are ok 31 | g <- set_vertex_attr(g, "color", value=c("#e70351", "#e8fd02", "#eb03fe", "#fb9104", "#fd99ee", "#e8d97d", "#ea958a", "#fd01af")[i]) 32 | g <- set_edge_attr(g,"color", value = "black") 33 | g <- set_edge_attr(g, "weight", value=3) 34 | 35 | graphjs(g, repulsion=0.15,bg="white") 36 | # 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /visNetwork_eg1.R: -------------------------------------------------------------------------------- 1 | 2 | detach(package:igraph) 3 | detach(package:sna) 4 | detach(package:network) 5 | 6 | ### vizNetwork 7 | 8 | ##vn1 9 | library(igraph) 10 | require(visNetwork, quietly = TRUE) 11 | # minimal example 12 | nodes <- data.frame(id = 1:5) 13 | edges <- data.frame(from = c(2,2,4,1,1), to = c(1,3,2,3,5)) 14 | visNetwork(nodes, edges, width = "100%") 15 | 16 | 17 | 18 | #vn 2 19 | 20 | ### Sade. 21 | nodes <- data.frame(id = c("oldF", "1956F","1957M","1959M","1960M", "1960F", "1961M", "1961F"), 22 | group = c("F", "F", "M", "M","M","F", "M", "F")) 23 | 24 | edges <- data.frame(from = c(rep("oldF",5), 25 | rep("1960F",4), 26 | rep("1961F",1), 27 | rep("1957M",4), 28 | rep("1959M",3), 29 | rep("1956F",6), 30 | rep("1960M",3), 31 | rep("1961M",1) 32 | ), 33 | to = c("1960F","1957M","1961F","1956F","1959M", 34 | "old","1957M","1961F","1956F", 35 | "old", 36 | "old","1959M","1961M","1956F", 37 | "old","1956F","1957M", 38 | "old","1959M","1961M","1960M","1957M","1960F", 39 | "1956F","1960F","1961M", 40 | "1956F"), 41 | width = c(2,1,2,1,1,2,1,1,2,2,1,1,1,1, 42 | 1,1,1,1,1,2,2,1,2,2,1,1,2 43 | ) 44 | 45 | ) 46 | 47 | nodes$label = nodes$id 48 | nodes$font.size = 24 49 | 50 | # edges data.frame for legend 51 | ledges <- data.frame(color = c("darkblue", "red"), 52 | label = c("grooms ", " groomed"), arrows =c("to", "from")) 53 | 54 | 55 | 56 | head(nodes) 57 | head(edges) 58 | ledges 59 | 60 | 61 | visNetwork(nodes, edges,width="100%") %>% visEdges(arrows = 'from') %>% 62 | visGroups(groupname = "M", color = "darkblue", shape = "square", shadow = list(enabled = T)) %>% 63 | visGroups(groupname = "F", color = "red", shape = "triangle") %>% 64 | visPhysics(solver = "forceAtlas2Based", forceAtlas2Based = list(gravitationalConstant = -60)) %>% 65 | visLegend(width=0.2,addEdges = ledges) 66 | 67 | 68 | ##vn3 69 | ### do with fontawesome - not stable 70 | 71 | visNetwork(nodes, edges,width="100%") %>% visEdges(arrows = 'from') %>% 72 | visGroups(groupname = "M", shape = "icon", 73 | icon = list(code = "f222", color = "darkblue", size = 55)) %>% 74 | visGroups(groupname = "F", shape = "icon", 75 | icon = list(code = "f221", color = "red",size = 55)) %>% 76 | addFontAwesome() %>% 77 | visPhysics(solver = "forceAtlas2Based", forceAtlas2Based = list(gravitationalConstant = -60)) %>% 78 | visLegend(addNodes = list( 79 | list(label = "Males", shape = "icon", 80 | icon = list(code = "f222", size = 30),color="darkblue"), 81 | list(label = "Females", shape = "icon", 82 | icon = list(code = "f221", size = 30, color = "red"))), 83 | useGroups = FALSE, 84 | width=0.2, 85 | addEdges = ledges) 86 | 87 | 88 | 89 | # vn4 90 | 91 | library(igraph) 92 | set.seed(576) 93 | g <- sample_forestfire(125, fw.prob=0.05, bw.factor = 0.2, ambs = 2,directed = F) 94 | nodes <- data.frame(id = as.character(V(g))) 95 | nodes$font.size<-20 96 | edges <- data.frame(get.edgelist(g)) 97 | colnames(edges)<-c("from","to") 98 | 99 | # with defaut layout 100 | visNetwork(nodes, edges, height = "600px") %>% 101 | visIgraphLayout() %>% 102 | visNodes(size = 25) %>% 103 | visOptions(highlightNearest = T) %>% 104 | visInteraction(keyboard = TRUE) 105 | 106 | 107 | 108 | 109 | 110 | # vn5 111 | 112 | ##### Select by Group 113 | nodes$group <- cluster_fast_greedy(g)$membership 114 | nodes$value = betweenness(g,directed=F, normalized = T) 115 | nodes$font.size <-28 116 | 117 | visNetwork(nodes, edges, height = "600px") %>% 118 | visIgraphLayout() %>% 119 | visNodes(size = 40) %>% 120 | visOptions(selectedBy = "group", 121 | highlightNearest = TRUE, 122 | nodesIdSelection = TRUE) %>% 123 | visInteraction(keyboard = TRUE, 124 | dragNodes = T, 125 | dragView = T, 126 | zoomView = T) 127 | 128 | 129 | #vn6 130 | visNetwork(nodes, edges, height = "600px") %>% 131 | visPhysics(stabilization=F) %>% 132 | visNodes(size = 40) %>% 133 | visOptions(selectedBy = "group", 134 | highlightNearest = TRUE, 135 | nodesIdSelection = TRUE) %>% 136 | visInteraction(keyboard = TRUE, 137 | dragNodes = T, 138 | dragView = T, 139 | zoomView = T) 140 | 141 | 142 | 143 | 144 | 145 | 146 | 147 | #### Tooltip 148 | nodes$title <- paste0("

Group: ", cluster_fast_greedy(g)$membership, "
", 149 | "Degree: ", degree(g),"

") 150 | 151 | visNetwork(nodes, edges, height = "600px") %>% 152 | visIgraphLayout() %>% 153 | visNodes(size = 40) %>% 154 | visOptions(selectedBy = "group", 155 | highlightNearest = TRUE, 156 | nodesIdSelection = TRUE) %>% 157 | visInteraction(keyboard = TRUE, 158 | dragNodes = T, 159 | dragView = T, 160 | zoomView = T) 161 | 162 | 163 | 164 | 165 | visNetwork(nodes, edges, height = "600px") %>% 166 | visIgraphLayout() %>% 167 | visNodes(size = 40) %>% 168 | visOptions(selectedBy = "group", 169 | highlightNearest = TRUE, 170 | nodesIdSelection = TRUE) %>% 171 | visInteraction(keyboard = TRUE, 172 | dragNodes = T, 173 | dragView = T, 174 | zoomView = T) 175 | 176 | 177 | #vn6 178 | visNetwork(nodes, edges, height = "600px") %>% 179 | visPhysics(stabilization=F) %>% 180 | visNodes(size = 40) %>% 181 | visOptions(selectedBy = "group", 182 | highlightNearest = TRUE, 183 | nodesIdSelection = TRUE) %>% 184 | visInteraction(keyboard = TRUE, 185 | dragNodes = T, 186 | dragView = T, 187 | zoomView = T) 188 | 189 | 190 | 191 | 192 | 193 | 194 | #vn8 195 | ## Very Large Network 196 | 197 | set.seed(576) 198 | g <- g <- sample_pa(10000, directed = F) 199 | nodes <- data.frame(id = as.character(V(g))) 200 | nodes$group <- cluster_fast_greedy(g)$membership 201 | nodes$title <- paste0("

Group: ", cluster_fast_greedy(g)$membership, "
", 202 | "Degree: ", degree(g),"

") 203 | nodes$font.size <- 0 204 | 205 | edges <- data.frame(get.edgelist(g)) 206 | colnames(edges)<-c("from","to") 207 | 208 | 209 | visNetwork(nodes, edges, height = "600px") %>% 210 | visIgraphLayout() %>% 211 | visNodes(size = 10) %>% 212 | visOptions(selectedBy = "group") %>% 213 | visInteraction(keyboard = TRUE, 214 | dragNodes = T, 215 | dragView = T, 216 | zoomView = T) 217 | 218 | -------------------------------------------------------------------------------- /viznet_script.R: -------------------------------------------------------------------------------- 1 | detach(package:igraph) 2 | detach(package:sna) 3 | detach(package:network) 4 | 5 | 6 | # ggnetwork + ggiraph 7 | 8 | library(ggplot2) 9 | library(ggiraph) 10 | library(network) 11 | library(sna) 12 | library(ggnetwork) 13 | 14 | n <- network(rgraph(10, tprob = 0.2), directed = FALSE) 15 | n %v% "family" <- sample(letters[1:3], 10, replace = TRUE) 16 | e <- network.edgecount(n) 17 | set.edge.attribute(n, "type", sample(letters[24:26], e, replace = TRUE)) 18 | 19 | 20 | df<-ggnetwork(n, layout = "fruchtermanreingold", cell.jitter = 0.75) 21 | df$tooltip <- paste0("Betweenness = ", round(betweenness(n)[df$vertex.names],2)) 22 | 23 | gg_point_1 <- ggplot(df, aes(x = x, y = y, xend=xend, color=family, yend=yend, tooltip = tooltip) ) + 24 | geom_edges(aes(linetype = type), color = "grey50") + 25 | geom_nodes(color = "black", size = 8) + 26 | theme_blank() + 27 | geom_nodetext(aes(label = LETTERS[vertex.names]), fontface = "bold") + 28 | geom_point_interactive(size=5) 29 | 30 | # htmlwidget call 31 | ggiraph(code = {print(gg_point_1)}, width = 7, height = 6) 32 | 33 | 34 | --------------------------------------------------------------------------------