social network analyses
512
社交網絡分析是一種無監督的機器學習方法，有一些類似於機器學習中的KNN，識別出不同的網絡群體，可以應用在 FB推薦朋友、或是商品推薦、影片推薦、甚至是疾病傳播、反詐欺等等。 社交網絡通常使用圖來描述，圖可以非常直觀的描述事物之間的關係。在圖中，節點（node）表示一個人，或者一個事物，邊（edge）代表人或者事物之間的關係。
library(statnet)
library(igraph)
# detach(package:igraph)
# setwd("/Users/Lynn/Documents/資料管理/midtermReport")建構graph
# 建立一個空的圖
g<-graph.empty(directed=F)
# 增加node
g<-add.vertices(g,3)
# 增加edge
g<-add.edges(g,c(c(1,2,1,3,2,3,2,1,3,2,1,1)))
# 可以用XQuartz修改
# tkplot(g)
# rglplot(g)
# 設定node的feature
V(g)$label <- c("a","b","c")
V(g)$color <- c('red','blue','orange')
V(g)$size <- c(20,40,60)
V(g)$member <- c(1,2,1)
# 篩選
V(g)[which(V(g)$member==1)]## + 2/3 vertices, from 3562d3e:
## [1] 1 3## + 3/3 vertices, from 3562d3e:
## [1] 1 2 3## [1] 3## + 5/3 vertices, from 3564cf8:
## [1] 1 1 2 2 3## + 4/3 vertices, from 3564cf8:
## [1] 1 1 3 3## [1] FALSE FALSE FALSE FALSE FALSE TRUE## [1] FALSE FALSE FALSE TRUE TRUE FALSE# 設定edge的weight
E(g)$weight <- c(2,8,13,4,11,3)
# 內建E(g)$weight。但是沒有label項，用set_vertex_attr加入edge label
g<-set_vertex_attr(g,"name",value=V(g)$label)
# 篩選與刪除
E(g)## + 6/6 edges from 3564cf8 (vertex names):
## [1] a--b a--c b--c a--b b--c a--a## + 5/6 edges from 3564cf8 (vertex names):
## [1] a--c b--c a--b b--c a--a## + 6/6 edges from 35673ee (vertex names):
## [1] a--b a--c b--c a--b b--c a--a## [1] 2 1 2 2 2 1# 簡化網絡，loops指回自己，比如1-2-1；multiple是指重複比如1-2,2-1。edge.attr.comb,使用重複次數來更新edge權重E(g)$weight
gsim <- simplify(g,remove.multiple = TRUE, remove.loops = TRUE, edge.attr.comb = "mean")
E(gsim)$weight## [1] 3 8 12繪圖
plot(g,
layout=layout.fruchterman.reingold,
edge.arrow.size=0.4,
vertex.color=V(g)$color,
vertex.size=V(g)$size,
edge.width=E(g)$weight)
繪圖參數
layout表示佈局方式（發散性）
mark.groups 表示設置分組
NODES
vertex.color 節點顏色(display.brewer.all()看配色)
vertex.frame.color 節點邊框顏色
vertex.shape 節點形狀，可以參考names(igraph:::.igraph.shapes)
vertex.size 節點大小（默認為15）
vertex.label 默認顯示id，可以自己設定
vertex.label.family 字體類型
vertex.label.font 2粗體 3斜體 4粗體斜體
vertex.label.cex 字體大小
vertex.label.color 字體顏色
vertex.label.dist 點label和節點之間的距離一般0.1，錯開重疊
vertex.label.degree label相對於頂點的位置，0右，“pi”左，“pi/2”下，“-pi/2”上
EDGES
edge.color edge顏色
edge.width 邊緣寬度，默認為1
edge.arrow.size 箭頭大小，默認為1
edge.arrow.width 箭頭寬度，默認為1
edge.lty 0 “” 1“實心” 2“虛線” 3“點綴” 4“dotdash” 5“longdash” 6“twodash”
edge.label
edge.label.family
edge.label.font
edge.label.cex
edge.curved 邊緣曲率，範圍0-1（FALSE＝0，TRUE＝0.5）
arrow.mode 是否應該有箭頭，0沒有箭頭，1後退，2前進，3兩者
edge.arrow.mode = “-” 箭頭換成線
data.frame轉成graph
g <- graph.data.frame(data.frame(id1=c('Bob','Mark','Red','Mat','White','White','Bob'), di2=c('Red','White','Mat','Blue','Bob','Mark','Mat')))
# 等同於
# g <- graph(edges=c('Bob','Red','Mark','White','Red','Mat','Mat','Blue','White','Bob','White','Mark','Bob','Mat'), directed = TRUE)
plot(g,
layout=layout.fruchterman.reingold,
edge.arrow.size=0.4,
vertex.color='lightblue',
vertex.size=25)
## 6 x 6 sparse Matrix of class "dgCMatrix"
## Bob Mark Red Mat White Blue
## Bob . . 1 1 . .
## Mark . . . . 1 .
## Red . . . 1 . .
## Mat . . . . . 1
## White 1 1 . . . .
## Blue . . . . . .matrix轉成graph
# 隨便構造的一個矩陣
adjm <- matrix(sample(0:1, 100, replace=TRUE, prob=c(0.9,0.1)), nc=10)
# # matrix轉成graph
g1 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, mode="undirected")
# weighted是否需要加入權重
# mode有directed, undirected, upper, lower, max, min, plus有這麼幾種
g1## IGRAPH 358f4fd U-W- 10 9 --
## + attr: weight (e/n)
## + edges from 358f4fd:
## [1] 1-- 2 1-- 7 2-- 8 4-- 6 4-- 8 4--10 5-- 7 5-- 8 6-- 9plot(g1,
layout=layout.fruchterman.reingold,
edge.arrow.size=0.4,
vertex.color='white',
vertex.size=25)
## 對矩陣行列命名
rownames(adjm) <- sample(letters, nrow(adjm))
colnames(adjm) <- seq(ncol(adjm))
# add.rownames以及add.colnames定義名稱，用V(g10)$row以及V(g10)$col可以看到
g10 <- graph_from_adjacency_matrix(adjm, weighted=TRUE, add.rownames="row",add.colnames="col")
g10## IGRAPH 3590922 D-W- 10 11 --
## + attr: col (v/c), row (v/c), weight (e/n)
## + edges from 3590922:
## [1] 1-> 2 2-> 8 4-> 6 4-> 8 4->10 5-> 7 5-> 8 6-> 9 7-> 1 8-> 5 9-> 6plot(g10,
layout=layout.fruchterman.reingold,
edge.arrow.size=0.4,
vertex.color='white',
vertex.size=25)
graphs 結合
## IGRAPH 35b86c2 U--- 4 3 -- Full graph
## + attr: name (g/c), loops (g/l)
## + edges from 35b86c2:
## [1] 1--4 2--4 3--4內建圖形函數
tree
## ring
Watts-Strogatz
sw <- sample_smallworld(dim=2, size=10, nei=1, p=0.1)
plot(sw, vertex.size=6, vertex.label=NA, layout=layout_in_circle)
Erdos-Renyi Model
# Generate Random Graphs According To The Erdos-Renyi Model
g <- erdos.renyi.game(20, 0.3)
plot(g, layout=layout.fruchterman.reingold, vertex.label=NA, vertex.size=5)
Erdos-Renyi Model:gnm
# Generate random graph, fixed number of arcs
g <- erdos.renyi.game(20, 15, type='gnm') # sample_gnm
plot(g, layout=layout.fruchterman.reingold, vertex.label=NA, vertex.size=5)
Erdos-Renyi Model:gnp
# Generate Random Graphs According To The G(N,P) Erdos-Renyi Model
# different color for each component
g <- sample_gnp(100, 1/100)
comps <- components(g)$membership
colbar <- rainbow(max(comps)+1)
V(g)$color <- colbar[comps+1]
plot(g, layout=layout_with_fr, vertex.size=5, vertex.label=NA)
Barabasi-Albert Model
# Generate Scale-Free Graphs According To The Barabasi-Albert Model
g <- barabasi.game(60, power=1, zero.appeal=1.3)
plot(g, layout=layout.fruchterman.reingold, vertex.label=NA, vertex.size=5, edge.arrow.size=0.2)
communities
# plot communities in a graph
g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5)
g <- add_edges(g, c(1,6, 1,11, 6,11))
com <- cluster_spinglass(g, spins=5)
V(g)$color <- com$membership+1
g <- set_graph_attr(g, "layout", layout_with_kk(g))
plot(g, vertex.label.dist=1.5)
layout
g <- graph(c(2,1,3,1,4,1,5,1,6,1,7,1),directed = F)
par(mfrow=c(2,3))
plot(g,vertex.size=40,layout=layout_on_grid,main="簡單的網格布局")
plot(g,vertex.size=40,layout=layout.auto,main="自動布局")
plot(g,vertex.size=40,layout=layout_as_star,main="星形布局")
plot(g,vertex.size=40,layout=layout.circle,main="環形布局")
plot(g,vertex.size=40,layout=layout_randomly,main="隨機布局")
plot(g,vertex.size=40,layout=layout_as_tree(g),main="樹狀布局")
# {-}
分群
## IGRAPH clustering edge betweenness, groups: 7, mod: 0.68
## + groups:
## $`1`
## [1] 1 4 13 38 39 40
##
## $`2`
## [1] 2 6 7 17 18 19 20 21 22
##
## $`3`
## [1] 3 9 10 26 27 28 29 30 31
##
## $`4`
## + ... omitted several groups/vertices其他package
networkD3
library(networkD3)
data(MisLinks)
data(MisNodes)
forceNetwork(Links = MisLinks, Nodes = MisNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
Group = "group", opacity = 0.4, zoom = TRUE)MyNodes = data.frame(name = c("Google", "Apple", "Amazon", "Youtube", "Paypal"),
group = c("A", "B", "C", "A", "C"),
size = c(100, 25, 9, 1, 4))
# 描述圈圈間的聯結，source必定大於target
MyLinks = data.frame(source = c(1, 2, 2, 3),
target = c(0, 0, 1, 0),
value = c(1, 2, 5, 10)) # value代表線的粗細
forceNetwork(Links = MyLinks, Nodes = MyNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
Group = "group", opacity = 1, zoom = TRUE)qgraph
qplot with matrix
- dataframe要轉成matrix
adj=matrix(sample(0:1,10^2,TRUE,prob=c(0.8,0.2)),nrow=10,ncol=10)
qgraph(adj)
title("Unweighted and directed graphs",line=2.5)
big5
library("psych")
data(big5)
data(big5groups)
# Correlations:
big5Graph <- qgraph(cor(big5),minimum=0.25,groups=big5groups,
legend=TRUE,borders=FALSE, title = "Big 5 correlations")
Exploratory factor analysis (have problems)
big5efa <- factanal(big5,factors=5,rotation="promax",scores="regression")
qgraph(big5efa,groups=big5groups,layout="circle",minimum=0.2,
cut=0.4,vsize=c(1.5,10),borders=FALSE,vTrans=200,title="Big 5 EFA")
qgraph.efa(big5, 5, groups = big5groups, rotation = "promax",
minimum = 0.2, cut = 0.4, vsize = c(1, 15), borders = FALSE,
asize = 0.07, esize = 4, vTrans = 200)
## Principal component analysis:
big5pca <- principal(cor(big5),5,rotate="promax")
qgraph(big5pca,groups=big5groups,layout="circle",rotation="promax",minimum=0.2,
cut=0.4,vsize=c(1.5,10),borders=FALSE,vTrans=200,title="Big 5 PCA")bfi
## Variables detected as ordinal: A1; A2; A3; A4; A5; C1; C2; C3; C4; C5; E1; E2; E3; E4; E5; N1; N2; N3; N4; N5; O1; O2; O3; O4; O5# Compute graph with tuning = 0 (BIC):
BICgraph <- qgraph(CorMat, graph = "glasso", sampleSize = nrow(bfi),
tuning = 0, layout = "spring", title = "BIC", details = TRUE)## Warning in EBICglassoCore(S = S, n = n, gamma = gamma, penalize.diagonal =
## penalize.diagonal, : A dense regularized network was selected (lambda < 0.1 *
## lambda.max). Recent work indicates a possible drop in specificity. Interpret the
## presence of the smallest edges with care. Setting threshold = TRUE will enforce
## higher specificity, at the cost of sensitivity.
# Compute graph with tuning = 0.5 (EBIC)
EBICgraph <- qgraph(CorMat, graph = "glasso", sampleSize = nrow(bfi),
tuning = 0.5, layout = "spring", title = "BIC", details = TRUE)## Warning in EBICglassoCore(S = S, n = n, gamma = gamma, penalize.diagonal =
## penalize.diagonal, : A dense regularized network was selected (lambda < 0.1 *
## lambda.max). Recent work indicates a possible drop in specificity. Interpret the
## presence of the smallest edges with care. Setting threshold = TRUE will enforce
## higher specificity, at the cost of sensitivity.
centrality and clustering
## Note: z-scores are shown on x-axis rather than raw centrality indices.
## Note: z-scores are shown on x-axis rather than raw centrality indices.
## $node.centrality
## Betweenness Closeness Strength ExpectedInfluence
## A1 1 0.002716442 1.1992734 0.07940005
## A2 21 0.003053247 1.3587499 0.58200345
## A3 21 0.003090016 1.1067197 0.80763348
## A4 11 0.003001281 1.0386257 0.47713477
## A5 15 0.003169514 1.0816605 0.80328282
## C1 1 0.002780521 1.0664627 0.45471026
## C2 24 0.003270458 1.4859097 0.93158319
## C3 1 0.002764676 0.9766622 0.34190355
## C4 20 0.003140338 1.6280943 0.46617377
## C5 18 0.003199705 1.2710371 0.19734802
## E1 2 0.002993497 1.3240260 0.01502169
## E2 15 0.003322839 1.4523626 0.21331156
## E3 11 0.003086533 1.2399614 0.91152675
## E4 27 0.003389793 1.4695271 0.29832606
## E5 18 0.003377435 1.4622480 0.42041192
## N1 17 0.002604386 1.3456596 1.07989571
## N2 0 0.002444764 1.3195712 0.92947537
## N3 10 0.002758246 1.0946576 1.05587436
## N4 21 0.003085156 1.2692687 0.84728279
## N5 13 0.003115974 1.3093307 0.81756516
## O1 5 0.002925719 1.1055700 0.56271647
## O2 2 0.002856739 1.0634642 0.48765815
## O3 14 0.003088007 1.4193970 0.36307922
## O4 10 0.003330758 1.2380914 0.75518512
## O5 4 0.003066329 1.2971293 0.25049676
##
## $edge.betweenness.centrality
## from to edgebetweenness
## 194 N3 N4 23
## 300 A5 E4 23
## 245 A3 A5 22
## 168 A2 A3 21
## 74 C4 C5 18
## 271 A4 C2 16
## 100 C5 N4 15
## 164 E5 N1 15
## 175 N1 N2 15
## 1 A1 A2 14
## 15 C1 C2 14
## 149 E3 O3 14
## 126 E2 E4 13
## 170 E5 O1 12
## 254 A3 E3 12
## 37 C2 C4 11
## 49 C2 N5 11
## 127 E2 E5 11
## 232 A2 E5 11
## 244 A3 A4 11
## 163 E4 O5 10
## 176 N1 N3 10
## 206 N4 O4 10
## 110 E1 E4 9
## 137 E2 O4 9
## 215 O1 O3 9
## 52 C2 O3 8
## 56 C3 C5 8
## 156 E4 N4 8
## 178 N1 N5 8
## 87 C4 O2 7
## 91 C4 O5 7
## 108 E1 E2 7
## 132 E2 N5 7
## 209 N5 O2 7
## 224 A2 C3 7
## 278 A4 E4 7
## 279 A1 C4 7
## 17 C1 C4 6
## 36 C2 C3 6
## 179 A2 A4 6
## 195 N3 N5 6
## 4 A5 N1 5
## 88 C4 O3 5
## 93 C5 E2 5
## 117 E1 N4 5
## 140 E3 E5 5
## 147 E3 O1 5
## 185 N2 N3 5
## 216 O1 O4 5
## 218 O2 O3 5
## 221 O3 O4 5
## 222 O3 O5 5
## 238 A2 N5 5
## 274 A4 C5 5
## 33 C1 O4 4
## 39 C2 E1 4
## 106 C5 O4 4
## 139 E3 E4 4
## 160 E4 O2 4
## 202 N4 N5 4
## 225 O4 O5 4
## 299 A5 E3 4
## 55 C3 C4 3
## 57 A1 N1 3
## 98 C5 N2 3
## 220 O2 O5 3
## 43 C2 E5 2
## 92 C5 E1 2
## 125 E2 E3 2
## 184 N1 O5 2
## 214 O1 O2 2
## 242 A2 O4 2
## 16 C1 C3 1
## 23 C1 E5 1
## 62 C3 E5 1
## 121 E1 O3 1
## 146 A1 O4 1
## 157 A1 O5 1
## 167 E5 N4 1
## 169 E5 N5 1
## 208 N5 O1 1
## 282 A4 N2 1
## 2 A1 E1 0
## 3 A5 E5 0
## 5 A5 N2 0
## 6 A5 N3 0
## 7 A5 N4 0
## 8 A5 N5 0
## 9 A5 O1 0
## 10 A5 O2 0
## 11 A5 O3 0
## 12 A5 O4 0
## 13 A1 E2 0
## 14 A5 O5 0
## 18 C1 C5 0
## 19 C1 E1 0
## 20 C1 E2 0
## 21 C1 E3 0
## 22 C1 E4 0
## 24 A1 E3 0
## 25 C1 N1 0
## 26 C1 N2 0
## 27 C1 N3 0
## 28 C1 N4 0
## 29 C1 N5 0
## 30 C1 O1 0
## 31 C1 O2 0
## 32 C1 O3 0
## 34 C1 O5 0
## 35 A1 E4 0
## 38 C2 C5 0
## 40 C2 E2 0
## 41 C2 E3 0
## 42 C2 E4 0
## 44 C2 N1 0
## 45 C2 N2 0
## 46 A1 E5 0
## 47 C2 N3 0
## 48 C2 N4 0
## 50 C2 O1 0
## 51 C2 O2 0
## 53 C2 O4 0
## 54 C2 O5 0
## 58 C3 E1 0
## 59 C3 E2 0
## 60 C3 E3 0
## 61 C3 E4 0
## 63 C3 N1 0
## 64 C3 N2 0
## 65 C3 N3 0
## 66 C3 N4 0
## 67 C3 N5 0
## 68 A1 N2 0
## 69 C3 O1 0
## 70 C3 O2 0
## 71 C3 O3 0
## 72 C3 O4 0
## 73 C3 O5 0
## 75 C4 E1 0
## 76 C4 E2 0
## 77 C4 E3 0
## 78 C4 E4 0
## 79 A1 N3 0
## 80 C4 E5 0
## 81 C4 N1 0
## 82 C4 N2 0
## 83 C4 N3 0
## 84 C4 N4 0
## 85 C4 N5 0
## 86 C4 O1 0
## 89 C4 O4 0
## 90 A1 N4 0
## 94 C5 E3 0
## 95 C5 E4 0
## 96 C5 E5 0
## 97 C5 N1 0
## 99 C5 N3 0
## 101 A1 N5 0
## 102 C5 N5 0
## 103 C5 O1 0
## 104 C5 O2 0
## 105 C5 O3 0
## 107 C5 O5 0
## 109 E1 E3 0
## 111 E1 E5 0
## 112 A1 A3 0
## 113 A1 O1 0
## 114 E1 N1 0
## 115 E1 N2 0
## 116 E1 N3 0
## 118 E1 N5 0
## 119 E1 O1 0
## 120 E1 O2 0
## 122 E1 O4 0
## 123 E1 O5 0
## 124 A1 O2 0
## 128 E2 N1 0
## 129 E2 N2 0
## 130 E2 N3 0
## 131 E2 N4 0
## 133 E2 O1 0
## 134 E2 O2 0
## 135 A1 O3 0
## 136 E2 O3 0
## 138 E2 O5 0
## 141 E3 N1 0
## 142 E3 N2 0
## 143 E3 N3 0
## 144 E3 N4 0
## 145 E3 N5 0
## 148 E3 O2 0
## 150 E3 O4 0
## 151 E3 O5 0
## 152 E4 E5 0
## 153 E4 N1 0
## 154 E4 N2 0
## 155 E4 N3 0
## 158 E4 N5 0
## 159 E4 O1 0
## 161 E4 O3 0
## 162 E4 O4 0
## 165 E5 N2 0
## 166 E5 N3 0
## 171 E5 O2 0
## 172 E5 O3 0
## 173 E5 O4 0
## 174 E5 O5 0
## 177 N1 N4 0
## 180 N1 O1 0
## 181 N1 O2 0
## 182 N1 O3 0
## 183 N1 O4 0
## 186 N2 N4 0
## 187 N2 N5 0
## 188 N2 O1 0
## 189 N2 O2 0
## 190 A2 A5 0
## 191 N2 O3 0
## 192 N2 O4 0
## 193 N2 O5 0
## 196 N3 O1 0
## 197 N3 O2 0
## 198 N3 O3 0
## 199 N3 O4 0
## 200 N3 O5 0
## 201 A2 C1 0
## 203 N4 O1 0
## 204 N4 O2 0
## 205 N4 O3 0
## 207 N4 O5 0
## 210 N5 O3 0
## 211 N5 O4 0
## 212 A2 C2 0
## 213 N5 O5 0
## 217 O1 O5 0
## 219 O2 O4 0
## 223 A1 A4 0
## 226 A2 C4 0
## 227 A2 C5 0
## 228 A2 E1 0
## 229 A2 E2 0
## 230 A2 E3 0
## 231 A2 E4 0
## 233 A2 N1 0
## 234 A2 N2 0
## 235 A1 A5 0
## 236 A2 N3 0
## 237 A2 N4 0
## 239 A2 O1 0
## 240 A2 O2 0
## 241 A2 O3 0
## 243 A2 O5 0
## 246 A1 C1 0
## 247 A3 C1 0
## 248 A3 C2 0
## 249 A3 C3 0
## 250 A3 C4 0
## 251 A3 C5 0
## 252 A3 E1 0
## 253 A3 E2 0
## 255 A3 E4 0
## 256 A3 E5 0
## 257 A1 C2 0
## 258 A3 N1 0
## 259 A3 N2 0
## 260 A3 N3 0
## 261 A3 N4 0
## 262 A3 N5 0
## 263 A3 O1 0
## 264 A3 O2 0
## 265 A3 O3 0
## 266 A3 O4 0
## 267 A3 O5 0
## 268 A1 C3 0
## 269 A4 A5 0
## 270 A4 C1 0
## 272 A4 C3 0
## 273 A4 C4 0
## 275 A4 E1 0
## 276 A4 E2 0
## 277 A4 E3 0
## 280 A4 E5 0
## 281 A4 N1 0
## 283 A4 N3 0
## 284 A4 N4 0
## 285 A4 N5 0
## 286 A4 O1 0
## 287 A4 O2 0
## 288 A4 O3 0
## 289 A4 O4 0
## 290 A1 C5 0
## 291 A4 O5 0
## 292 A5 C1 0
## 293 A5 C2 0
## 294 A5 C3 0
## 295 A5 C4 0
## 296 A5 C5 0
## 297 A5 E1 0
## 298 A5 E2 0
##
## $ShortestPathLengths
## A1 A2 A3 A4 A5 C1 C2
## A1 0.000000 3.570297 7.254209 10.067359 10.905571 17.280308 15.571419
## A2 3.570297 0.000000 3.683912 6.497063 7.335274 16.626394 13.109532
## A3 7.254209 3.683912 0.000000 6.637428 3.651362 16.766759 13.249897
## A4 10.067359 6.497063 6.637428 0.000000 10.288790 10.129332 6.612469
## A5 10.905571 7.335274 3.651362 10.288790 0.000000 20.418121 16.901259
## C1 17.280308 16.626394 16.766759 10.129332 20.418121 0.000000 3.516862
## C2 15.571419 13.109532 13.249897 6.612469 16.901259 3.516862 0.000000
## C3 12.859478 9.289181 12.973093 12.862596 16.624455 8.465579 6.250126
## C4 10.955133 14.525430 17.866183 11.228756 20.098983 6.325176 4.616287
## C5 14.321551 14.930146 15.415329 8.777902 19.066691 9.691594 7.982705
## E1 19.924278 16.353982 12.670069 13.130302 9.018707 16.996003 13.479141
## E2 17.636086 14.065789 11.492810 11.953043 7.841448 16.681292 17.218080
## E3 13.684147 10.113850 6.429938 13.067365 6.139703 19.097089 15.580227
## E4 15.147202 11.576905 7.892993 8.353226 4.241631 18.482557 14.965695
## E5 11.107030 7.536734 11.220646 14.033796 13.338028 14.307231 11.466751
## N1 16.666995 17.203811 18.417357 23.700874 14.765995 22.060543 18.543681
## N2 18.405225 18.942041 20.155586 22.100222 16.504224 23.798773 20.281910
## N3 21.429440 20.816607 22.308273 19.142399 18.656911 19.078856 15.561993
## N4 21.451558 21.150075 19.073782 15.907909 15.422420 16.821601 15.112712
## N5 18.571816 15.001519 18.685432 16.359375 16.147242 13.263768 9.746906
## O1 17.753936 14.183639 12.708492 19.345920 12.418258 16.933389 15.435780
## O2 19.581943 21.210571 17.526659 19.855566 16.242537 14.951985 13.243096
## O3 19.007276 15.436979 11.753067 16.869567 11.462832 13.773960 10.257098
## O4 14.862673 14.046768 17.730680 18.437109 14.325514 10.197226 13.714088
## O5 17.866042 19.778939 16.095027 16.555260 12.443665 13.980494 12.271605
## C3 C4 C5 E1 E2 E3 E4
## A1 12.859478 10.955133 14.321551 19.924278 17.636086 13.684147 15.147202
## A2 9.289181 14.525430 14.930146 16.353982 14.065789 10.113850 11.576905
## A3 12.973093 17.866183 15.415329 12.670069 11.492810 6.429938 7.892993
## A4 12.862596 11.228756 8.777902 13.130302 11.953043 13.067365 8.353226
## A5 16.624455 20.098983 19.066691 9.018707 7.841448 6.139703 4.241631
## C1 8.465579 6.325176 9.691594 16.996003 16.681292 19.097089 18.482557
## C2 6.250126 4.616287 7.982705 13.479141 17.218080 15.580227 14.965695
## C3 0.000000 8.050523 5.640965 19.729267 18.412432 19.403031 20.866086
## C4 8.050523 0.000000 3.366418 18.067297 16.137885 17.562143 15.857352
## C5 5.640965 3.366418 0.000000 14.700879 12.771467 20.928561 16.371284
## E1 19.729267 18.067297 14.700879 0.000000 3.738939 13.066852 4.777076
## E2 18.412432 16.137885 12.771467 3.738939 0.000000 10.844424 3.599817
## E3 19.403031 17.562143 20.928561 13.066852 10.844424 0.000000 8.289775
## E4 20.866086 15.857352 16.371284 4.777076 3.599817 8.289775 0.000000
## E5 15.606836 16.083038 19.300523 10.267994 6.529055 7.198325 10.128872
## N1 20.767908 18.493361 15.126943 18.539517 16.196133 16.865402 19.007625
## N2 20.945607 18.671060 15.304642 18.740611 17.934363 18.603632 19.378819
## N3 16.005463 13.730916 10.364498 13.777072 14.120882 21.627847 14.415280
## N4 12.770972 10.496425 7.130007 10.542581 14.281520 19.470565 11.180790
## N5 15.997032 14.363192 13.278563 12.044733 8.305794 19.150218 11.905611
## O1 21.685906 17.417696 17.174214 16.914900 13.175961 6.278554 14.568330
## O2 16.677333 8.626810 11.993228 16.777982 15.600723 11.096721 12.000906
## O3 16.507224 12.239014 15.605432 16.555443 13.580246 5.323129 13.334892
## O4 16.079016 13.804470 10.438051 10.223004 6.484066 12.419310 10.083883
## O5 15.705842 7.655319 11.021737 12.979110 11.801851 10.455987 8.202034
## E5 N1 N2 N3 N4 N5 O1
## A1 11.107030 16.666995 18.405225 21.429440 21.451558 18.571816 17.753936
## A2 7.536734 17.203811 18.942041 20.816607 21.150075 15.001519 14.183639
## A3 11.220646 18.417357 20.155586 22.308273 19.073782 18.685432 12.708492
## A4 14.033796 23.700874 22.100222 19.142399 15.907909 16.359375 19.345920
## A5 13.338028 14.765995 16.504224 18.656911 15.422420 16.147242 12.418258
## C1 14.307231 22.060543 23.798773 19.078856 16.821601 13.263768 16.933389
## C2 11.466751 18.543681 20.281910 15.561993 15.112712 9.746906 15.435780
## C3 15.606836 20.767908 20.945607 16.005463 12.770972 15.997032 21.685906
## C4 16.083038 18.493361 18.671060 13.730916 10.496425 14.363192 17.417696
## C5 19.300523 15.126943 15.304642 10.364498 7.130007 13.278563 17.174214
## E1 10.267994 18.539517 18.740611 13.777072 10.542581 12.044733 16.914900
## E2 6.529055 16.196133 17.934363 14.120882 14.281520 8.305794 13.175961
## E3 7.198325 16.865402 18.603632 21.627847 19.470565 19.150218 6.278554
## E4 10.128872 19.007625 19.378819 14.415280 11.180790 11.905611 14.568330
## E5 0.000000 9.667077 11.405307 14.429523 13.803299 12.985795 6.646905
## N1 9.667077 0.000000 1.738230 4.762445 7.996936 8.796775 16.313983
## N2 11.405307 1.738230 0.000000 4.963539 8.198029 10.535005 18.052213
## N3 14.429523 4.762445 4.963539 0.000000 3.234490 5.815088 18.841528
## N4 13.803299 7.996936 8.198029 3.234490 0.000000 6.148556 15.607037
## N5 12.985795 8.796775 10.535005 5.815088 6.148556 0.000000 16.969612
## O1 6.646905 16.313983 18.052213 18.841528 15.607037 16.969612 0.000000
## O2 17.079196 18.942574 20.680804 15.960887 16.294355 10.145799 10.432291
## O3 11.825587 21.492665 23.230894 19.201545 15.967055 15.919391 5.178682
## O4 13.013121 16.867810 17.068904 12.105365 8.870874 14.789860 6.736163
## O5 16.958446 19.818974 21.557203 19.478040 16.243549 15.059860 10.311540
## O2 O3 O4 O5
## A1 19.581943 19.007276 14.862673 17.866042
## A2 21.210571 15.436979 14.046768 19.778939
## A3 17.526659 11.753067 17.730680 16.095027
## A4 19.855566 16.869567 18.437109 16.555260
## A5 16.242537 11.462832 14.325514 12.443665
## C1 14.951985 13.773960 10.197226 13.980494
## C2 13.243096 10.257098 13.714088 12.271605
## C3 16.677333 16.507224 16.079016 15.705842
## C4 8.626810 12.239014 13.804470 7.655319
## C5 11.993228 15.605432 10.438051 11.021737
## E1 16.777982 16.555443 10.223004 12.979110
## E2 15.600723 13.580246 6.484066 11.801851
## E3 11.096721 5.323129 12.419310 10.455987
## E4 12.000906 13.334892 10.083883 8.202034
## E5 17.079196 11.825587 13.013121 16.958446
## N1 18.942574 21.492665 16.867810 19.818974
## N2 20.680804 23.230894 17.068904 21.557203
## N3 15.960887 19.201545 12.105365 19.478040
## N4 16.294355 15.967055 8.870874 16.243549
## N5 10.145799 15.919391 14.789860 15.059860
## O1 10.432291 5.178682 6.736163 10.311540
## O2 0.000000 5.773592 12.286735 4.914061
## O3 5.773592 0.000000 7.096181 5.132858
## O4 12.286735 7.096181 0.000000 7.372675
## O5 4.914061 5.132858 7.372675 0.000000
##
## attr(,"class")
## [1] "list" "centrality_auto"case study
Higgs Twitter Dataset : Friends/follower
dta <- read.table("higgs-social_network.edgelist",header = F)
dta <- dta-1
tmp1 <- dta[dta$V1<200,]
tmp2 <- dta[dta$V2<200,]
dta <- merge(tmp1, tmp2)
head(dta)g <- graph.data.frame(dta)
plot(g, layout=layout_with_gem,
vertex.size=degree(g), vertex.label=NA, edge.arrow.size=0.1,)
colnames(dta) <- c("source","target")
node <- data.frame(name = as.numeric(V(g)),
group = "0",
size = degree(g)*2)
forceNetwork(Links = dta, Nodes = node, Source = "source", Group = "group",
Target = "target", NodeID = "name",Nodesize = "size",
opacity = 1, zoom = TRUE,legend = TRUE, fontSize = 20,
bounded = FALSE, arrows = TRUE, charge = -120,
opacityNoHover = 0.6, linkDistance = 150)商場購物資料集
產生Nodes
# 所有商品
all.items = c(as.character(dat[,1]), as.character(dat[,2]), as.character(dat[,3]), as.character(dat[,4]), as.character(dat[,5]), as.character(dat[,6]))
# 所有種類
levels.all = levels(as.factor(all.items))
# 去掉 ""
levels.all = levels.all[-1]
# 建立架構
MyNodes = data.frame(matrix(NA, ncol = 3, nrow = length(levels.all)))
# 命名
colnames(MyNodes) = c("name", "group", "size")
MyNodes[,1] = levels.all
# output的商品與類別
out.items = as.character(dat[,6])
levels.out = levels(dat[,6])
# 依照分類填入group
MyNodes[levels.all %in% levels.out,2] = "Output"
MyNodes[!levels.all %in% levels.out,2] = "Input"
# size都設100
MyNodes[,3] = c(rep(5,5),rep(10,10),rep(100,5))
head(MyNodes)整理Links
# 將商品數字化
for (i in 1:6) {
dat[,i] = as.integer(factor(dat[,i], levels = levels.all)) - 1
}
# 逐行做成 大的node｜小的node｜lift 格式
Links = NULL
for (i in 1:nrow(dat)) {
n.rule = sum(!is.na(dat[i,1:5]))
new.rule = matrix(NA, ncol = 3, nrow = n.rule)
for (k in 1:n.rule) {
item1 = dat[i,k]
item2 = dat[i,6]
new.rule[k,1] = max(item1, item2)
new.rule[k,2] = min(item1, item2)
new.rule[k,3] = dat[i,9]
}
Links = rbind(Links, new.rule)
}
#將重複的相加在一起
dup.MyLinks = Links[duplicated(Links[,1:2]),]
nondup.MyLinks = Links[!duplicated(Links[,1:2]),]
for (i in 1:nrow(dup.MyLinks)) {
dup.pos = which(nondup.MyLinks[,1]==dup.MyLinks[i,1] & nondup.MyLinks[,2]==dup.MyLinks[i,2])
nondup.MyLinks[dup.pos,3] = nondup.MyLinks[dup.pos,3] + dup.MyLinks[i,3]
}
#重新格式化
colnames(nondup.MyLinks) = c("source", "target", "value")
MyLinks = data.frame(nondup.MyLinks)
head(MyLinks)畫圖
forceNetwork(Links = MyLinks, Nodes = MyNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
Group = "group", opacity = 1, zoom = TRUE, Nodesize = "size",
# colourScale = JS("d3.scale.category10()"),
legend = TRUE, fontSize = 20, bounded = FALSE,
charge = -120, opacityNoHover = 0.6, linkDistance = 150)NBA
##
## Attaching package: 'scales'## The following object is masked from 'package:purrr':
##
## discard## The following object is masked from 'package:readr':
##
## col_factor## The following objects are masked from 'package:psych':
##
## alpha, rescale看相關
## corrplot 0.84 loadedlibrary(RColorBrewer)
cormatrix.nba = cor(nba)
corrplot(cormatrix.nba, type="upper", order="hclust", tl.col="black", tl.srt=45)
igraph作法
cormatrix.nba[cormatrix.nba < 0.4] = 0
cormatrix.nba[cormatrix.nba == 1] = 0
g <- graph_from_adjacency_matrix(cormatrix.nba, weighted=TRUE, add.rownames="row",add.colnames="col")
plot(g,
layout=layout.fruchterman.reingold,
edge.arrow.size=0.2,
vertex.color='white',
vertex.size=15)
networkD3作法
MyNodes <- data.frame(name = rownames(cormatrix.nba),
group = c(1, 2, 2, 2, 2, 1, 2, 2, 3, 3, 3, 3, 1, 1, 1, 2, 2, 1, 2, 1))
cormatrix.nba.t <- cormatrix.nba
rownames(cormatrix.nba.t) <- as.integer(as.factor(rownames(cormatrix.nba))) - 1
colnames(cormatrix.nba.t) <- as.integer(as.factor(rownames(cormatrix.nba))) - 1
library(reshape2)##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithsMyLinks <- melt(cormatrix.nba.t)
colnames(MyLinks) = c("source", "target", "value")
MyLinks <- MyLinks[MyLinks$value != 0,]
MyLinks <- MyLinks[MyLinks$value != 1,]
forceNetwork(Links = MyLinks, Nodes = MyNodes, Source = "source",
Target = "target", Value = "value", NodeID = "name",
Group = "group",opacity = 1, zoom = TRUE,
# colourScale = JS("d3.scale.category10()"),
legend = TRUE, fontSize = 20, bounded = FALSE,
charge = -120, opacityNoHover = 0.6, linkDistance = 150)