├── .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 |
--------------------------------------------------------------------------------