====== Data ======
{{:r:featuring.csv}}
{{:r:actors.csv}}
{{:r:movies.csv}}
{{:r:Padgett.csv}}
{{:r:Padgw.csv}}
====== Hawthorne study ======
{{:r:davis.women.club.csv}}
library(tidiverse)
sd <- read.csv("http://commres.net/wiki/_media/r/davis.women.club.csv")
head(sd)
g <- graph.data.frame(sd, directed=FALSE)
bipartite.mapping(g)
plot(g)
V(g)$color <- ifelse(V(g)$type, "lightblue", "salmon")
V(g)$shape <- ifelse(V(g)$type, "circle", "square")
E(g)$color <- "lightgray"
plot(g, vertex.label.cex = 1.2, vertex.label.color = "black")
{{:r:pasted:20230611-224359.png}}
{{:r:pasted:20230611-225104.png}}
V(g)$type <- bipartite_mapping(g)$type
types <- V(g)$type
deg <- degree(g)
bet <- betweenness(g)
clos <- closeness(g)
eig <- eigen_centrality(g)$vector
deg
bet
clos
eig
cent_df <- data.frame(types, deg, bet, clos, eig)
cent_df[order(cent_df$type, decreasing = TRUE),]
> types <- V(g)$type
> deg <- degree(g)
> bet <- betweenness(g)
> clos <- closeness(g)
> eig <- eigen_centrality(g)$vector
>
> deg
EVELYN LAURA THERESA BRENDA CHARLOTTE FRANCES ELEANOR
8 7 8 7 4 4 4
PEARL RUTH VERNE MYRNA KATHERINE SYLVIA NORA
3 4 4 4 6 7 8
HELEN DOROTHY OLIVIA FLORA E1 E2 E3
7 4 2 2 3 3 6
E4 E5 E6 E8 E9 E7 E12
4 8 8 14 12 10 7
E10 E13 E14 E11
6 4 4 4
> bet
EVELYN LAURA THERESA BRENDA CHARLOTTE FRANCES ELEANOR
42.7600 22.8565 38.7393 22.0119 4.7279 4.7516 4.1357
PEARL RUTH VERNE MYRNA KATHERINE SYLVIA NORA
2.9763 7.3609 6.3676 5.9435 16.2889 25.2987 43.9378
HELEN DOROTHY OLIVIA FLORA E1 E2 E3
30.7265 5.9435 2.0866 2.0866 0.9737 0.9441 8.1978
E4 E5 E6 E8 E9 E7 E12
3.4530 16.9812 28.0103 108.2617 96.2295 58.0969 10.2354
E10 E13 E14 E11
6.8186 1.8892 1.8892 9.0194
> clos
EVELYN LAURA THERESA BRENDA CHARLOTTE FRANCES ELEANOR
0.01667 0.01515 0.01667 0.01515 0.01250 0.01389 0.01389
PEARL RUTH VERNE MYRNA KATHERINE SYLVIA NORA
0.01389 0.01471 0.01471 0.01429 0.01515 0.01613 0.01667
HELEN DOROTHY OLIVIA FLORA E1 E2 E3
0.01613 0.01429 0.01220 0.01220 0.01190 0.01190 0.01282
E4 E5 E6 E8 E9 E7 E12
0.01220 0.01351 0.01562 0.01923 0.01786 0.01667 0.01316
E10 E13 E14 E11
0.01282 0.01220 0.01220 0.01220
> eig
EVELYN LAURA THERESA BRENDA CHARLOTTE FRANCES ELEANOR
0.6225 0.5735 0.6934 0.5801 0.3081 0.3872 0.4287
PEARL RUTH VERNE MYRNA KATHERINE SYLVIA NORA
0.3453 0.4508 0.4360 0.3891 0.4796 0.5882 0.5599
HELEN DOROTHY OLIVIA FLORA E1 E2 E3
0.5058 0.3891 0.1394 0.1394 0.2586 0.2750 0.4607
E4 E5 E6 E8 E9 E7 E12
0.3209 0.5888 0.6100 1.0000 0.7618 0.7460 0.4873
E10 E13 E14 E11
0.4239 0.3106 0.3106 0.1957
>
> cent_df <- data.frame(types, deg, bet, clos, eig)
> cent_df[order(cent_df$type, decreasing = TRUE),]
types deg bet clos eig
E1 TRUE 3 0.9737 0.01190 0.2586
E2 TRUE 3 0.9441 0.01190 0.2750
E3 TRUE 6 8.1978 0.01282 0.4607
E4 TRUE 4 3.4530 0.01220 0.3209
E5 TRUE 8 16.9812 0.01351 0.5888
E6 TRUE 8 28.0103 0.01562 0.6100
E8 TRUE 14 108.2617 0.01923 1.0000
E9 TRUE 12 96.2295 0.01786 0.7618
E7 TRUE 10 58.0969 0.01667 0.7460
E12 TRUE 7 10.2354 0.01316 0.4873
E10 TRUE 6 6.8186 0.01282 0.4239
E13 TRUE 4 1.8892 0.01220 0.3106
E14 TRUE 4 1.8892 0.01220 0.3106
E11 TRUE 4 9.0194 0.01220 0.1957
EVELYN FALSE 8 42.7600 0.01667 0.6225
LAURA FALSE 7 22.8565 0.01515 0.5735
THERESA FALSE 8 38.7393 0.01667 0.6934
BRENDA FALSE 7 22.0119 0.01515 0.5801
CHARLOTTE FALSE 4 4.7279 0.01250 0.3081
FRANCES FALSE 4 4.7516 0.01389 0.3872
ELEANOR FALSE 4 4.1357 0.01389 0.4287
PEARL FALSE 3 2.9763 0.01389 0.3453
RUTH FALSE 4 7.3609 0.01471 0.4508
VERNE FALSE 4 6.3676 0.01471 0.4360
MYRNA FALSE 4 5.9435 0.01429 0.3891
KATHERINE FALSE 6 16.2889 0.01515 0.4796
SYLVIA FALSE 7 25.2987 0.01613 0.5882
NORA FALSE 8 43.9378 0.01667 0.5599
HELEN FALSE 7 30.7265 0.01613 0.5058
DOROTHY FALSE 4 5.9435 0.01429 0.3891
OLIVIA FALSE 2 2.0866 0.01220 0.1394
FLORA FALSE 2 2.0866 0.01220 0.1394
>
V(g)$size <- degree(g)
V(g)$label.cex <- degree(g) * 0.2
windowsFonts(d2coding = windowsFont("D2Coding"))
windowsFonts(lucida = windowsFont("Lucida Console"))
windowsFonts(courrier = windowsFont("Courrier New"))
shape <- c("circle", "square")
fnts <- c("d2coding", "lucida")
plot(g, layout = layout_with_graphopt,
vertex.shape= shape[as.numeric(V(g)$type) + 1],
vertex.label.family= fnts[as.numeric(V(g)$type)+1]
)
{{:r:pasted:20230611-232937.png}}
bipartite_matrix <- as_incidence_matrix(g)
bipartite_matrix
> bipartite_matrix <- as_incidence_matrix(g)
>
> bipartite_matrix
E1 E2 E3 E4 E5 E6 E8 E9 E7 E12 E10 E13 E14 E11
EVELYN 1 1 1 1 1 1 1 1 0 0 0 0 0 0
LAURA 1 1 1 0 1 1 1 0 1 0 0 0 0 0
THERESA 0 1 1 1 1 1 1 1 1 0 0 0 0 0
BRENDA 1 0 1 1 1 1 1 0 1 0 0 0 0 0
CHARLOTTE 0 0 1 1 1 0 0 0 1 0 0 0 0 0
FRANCES 0 0 1 0 1 1 1 0 0 0 0 0 0 0
ELEANOR 0 0 0 0 1 1 1 0 1 0 0 0 0 0
PEARL 0 0 0 0 0 1 1 1 0 0 0 0 0 0
RUTH 0 0 0 0 1 0 1 1 1 0 0 0 0 0
VERNE 0 0 0 0 0 0 1 1 1 1 0 0 0 0
MYRNA 0 0 0 0 0 0 1 1 0 1 1 0 0 0
KATHERINE 0 0 0 0 0 0 1 1 0 1 1 1 1 0
SYLVIA 0 0 0 0 0 0 1 1 1 1 1 1 1 0
NORA 0 0 0 0 0 1 0 1 1 1 1 1 1 1
HELEN 0 0 0 0 0 0 1 0 1 1 1 1 1 1
DOROTHY 0 0 0 0 0 0 1 1 0 1 1 0 0 0
OLIVIA 0 0 0 0 0 0 0 1 0 0 0 0 0 1
FLORA 0 0 0 0 0 0 0 1 0 0 0 0 0 1
>
===== stu x class 처럼 분석한 예 =====
actor_matrix <- bipartite_matrix %*% t(bipartite_matrix)
event_matrix <- t(bipartite_matrix) %*% bipartite_matrix
diag(actor_matrix) <- 0
actor_matrix
actor_matrix_cff_2 <- ifelse(actor_matrix > 2, actor_matrix, 0) # cuttoff 3 below
actor_matrix_cff_3 <- ifelse(actor_matrix > 3, actor_matrix, 0) # cuttoff 3 below
actor_g <- graph_from_adjacency_matrix(actor_matrix,
mode = "undirected",
weighted = TRUE)
actor_g_cff_2 <- graph_from_adjacency_matrix(actor_matrix_cff_2,
mode = "undirected",
weighted = TRUE)
actor_g_cff_3 <- graph_from_adjacency_matrix(actor_matrix_cff_3,
mode = "undirected",
weighted = TRUE)
V(actor_g)$size <- betweenness(actor_g)
V(actor_g_cff_2)$size <- betweenness(actor_g_cff_2)
V(actor_g_cff_3)$size <- betweenness(actor_g_cff_3)
V(actor_g)$label.cex <- betweenness(actor_g) * 0.2
V(actor_g_cff_2)$label.cex <- betweenness(actor_g_cff_2) * 0.1
V(actor_g_cff_3)$label.cex <- betweenness(actor_g_cff_3) * 0.4
actor_g
actor_g_cff_2
actor_g_cff_3
event_g <- graph_from_adjacency_matrix(event_matrix,
mode = "undirected",
weighted = TRUE)
event_g
windowsFonts(d2coding = windowsFont("D2Coding"))
windowsFonts(lucida = windowsFont("Lucida Console"))
shape <- c("circle", "square")
fnts <- c("d2coding", "lucida")
plot(actor_g,
vertex.shape= shape[as.numeric(V(g)$type) + 1],
vertex.label.family= fnts[as.numeric(V(g)$type)+1],
edge.color="red", edge.width=3
)
plot(actor_g_cff_2,
vertex.shape= shape[as.numeric(V(g)$type) + 1],
vertex.label.family= fnts[as.numeric(V(g)$type)+1],
edge.color="red", edge.width=3
)
plot(actor_g_cff_3,
vertex.shape= shape[as.numeric(V(g)$type) + 1],
vertex.label.family= fnts[as.numeric(V(g)$type)+1],
edge.color="red", edge.width=3
)
[{{:r:pasted:20230612-081851.png|actor_g}}] \\
[{{:r:pasted:20230612-082040.png|actor_g_cff_2}}] \\
[{{:r:pasted:20230612-082055.png|actor_g_cff_3}}]
===== 다른 방법 =====
library(ade4)
bipartite_matrix <- as_incidence_matrix(g) # Extract the matrix
# Method #2 is "simple matching"
women_match <- dist.binary(bipartite_matrix, method=2, upper=TRUE, diag = FALSE)
event_match <- dist.binary(t(bipartite_matrix), method=2, upper=TRUE, diag = FALSE)
women_match <- as.matrix(women_match)
matching_women <- ifelse(women_match>0.8, 1, 0)
matching_women
match_women <- graph_from_adjacency_matrix(matching_women,
mode = "undirected")
plot(match_women)
bipartite_matrix <- as_incidence_matrix(g) # Extract the matrix
women_r <- cor(t(bipartite_matrix))
event_r <- cor(bipartite_matrix)
women_r <- as.matrix(women_r)
women_r
# Look at the matrix before you binarize
r_women <- ifelse(women_r>0.6, 1, 0) # Binarize
diag(r_women) <- 0
r_women # Take a look at the matrix if you like
# Create an igraph network
ir_women <- graph_from_adjacency_matrix(r_women,
mode = "undirected")
plot(ir_women)
{{:r:pasted:20230612-025040.png}}
library(psych)
bipartite_matrix <- as_incidence_matrix(g) # Extract the matrix
women_Q <-YuleCor(t(bipartite_matrix))$rho
event_Q <-YuleCor(bipartite_matrix)$rho
women_Q <- as.matrix(women_Q)
women_Q # Look at the matrix before you binalize
Q_women <- ifelse(women_Q>0.9, 1, 0) # Binarize
diag(Q_women)<-0
# Q_women # Take a look at the matrix
YQ_women <- graph_from_adjacency_matrix(Q_women, # Create an igraph network
mode = "undirected")
plot(YQ_women)
{{:r:pasted:20230611-235802.png}}
====== Actors network ======
http://rpubs.com/wctucker/302110
====== e.g., ======
from,to,friendship,advice,gender
아이유,G-DRAGON,8,6,2
에픽하이,아이유,4,10,1
에픽하이,오혁,5,5,1
아이유,오혁,2,5,2
HIGH4,아이유,5,9,1
에픽하이,MINO,8,4,1
에픽하이,사이먼 도미닉,9,8,1
에픽하이,더콰이엇,2,5,1
에픽하이,수현,8,6,1
MINO,사이먼 도미닉,3,5,1
MINO,더콰이엇,6,5,1
사이먼 도미닉,더콰이엇,9,10,1
## A simple example with a couple of actors
## The typical case is that these tables are read in from files....
actors2 <- data.frame(name=c("Alice", "Bob", "Cecil", "David","Esmeralda"),
age=c(48,33,45,34,21),
gender=c("F","M","F","M","F"))
relations <- data.frame(
from=c("Bob", "Cecil", "Cecil", "David", "David", "Esmeralda"),
to=c("Alice", "Bob", "Alice", "Alice", "Bob", "Alice"),
same.dept=c(FALSE,FALSE,TRUE,FALSE,FALSE,TRUE),
friendship=c(4,5,5,2,1,1), advice=c(4,5,5,4,2,3))
g <- graph_from_data_frame(relations, directed=TRUE, vertices=actors)
print(g, e=TRUE, v=TRUE)
## The opposite operation
as_data_frame(g, what="vertices")
as_data_frame(g, what="edges")
위에서
- 성별에 따라서 색을 달리하여 plot을 그려보라.
- department에 따라서 색을 달리하는 것을 더하여 plot를 그려보라.
- betweenness가 가장 큰 인물은?
====== Featuring ======
from,to,friendship,advice,gender
아이유,GDRAGON,8,6,2
에픽하이,아이유,4,10,1
에픽하이,오혁,5,5,1
아이유,오혁,2,5,2
HIGH4,아이유,5,9,1
에픽하이,MINO,8,4,1
에픽하이,사이먼 도미닉,9,8,1
에픽하이,더콰이엇,2,5,1
에픽하이,수현,8,6,1
MINO,사이먼 도미닉,3,5,1
MINO,더콰이엇,6,5,1
사이먼 도미닉,더콰이엇,9,10,1
feat <- read.csv("http://commres.net/wiki/_media/r/featuring.csv")
feat
g <- graph_from_data_frame(feat)
g
plot(g)
V(g)
E(g)
feat <- read.csv("http://commres.net/wiki/_media/r/featuring.csv")
> feat
from to friendship advice
1 아이유 G-DRAGON 8 6
2 에픽하이 아이유 4 10
3 에픽하이 오혁 5 5
4 아이유 오혁 2 5
5 HIGH4 아이유 5 9
6 에픽하이 MINO 8 4
7 에픽하이 사이먼 도미닉 9 8
8 에픽하이 더콰이엇 2 5
9 에픽하이 수현 8 6
10 MINO 사이먼 도미닉 3 5
11 MINO 더콰이엇 6 5
12 사이먼 도미닉 더콰이엇 9 10
> g <- graph_from_data_frame(feat)
> g
IGRAPH e7c59b8 DN-- 9 12 --
+ attr: name (v/c), friendship (e/n), advice (e/n)
+ edges from e7c59b8 (vertex names):
[1] 아이유 ->G-DRAGON 에픽하이 ->아이유 에픽하이 ->오혁 아이유 ->오혁
[5] HIGH4 ->아이유 에픽하이 ->MINO 에픽하이 ->사이먼 도미닉 에픽하이 ->더콰이엇
[9] 에픽하이 ->수현 MINO ->사이먼 도미닉 MINO ->더콰이엇 사이먼 도미닉->더콰이엇
> plot(g)
> V(g)
+ 9/9 vertices, named, from e7c59b8:
[1] 아이유 에픽하이 HIGH4 MINO 사이먼 도미닉 G-DRAGON 오혁 더콰이엇
[9] 수현
> E(g)
+ 12/12 edges from e7c59b8 (vertex names):
[1] 아이유 ->G-DRAGON 에픽하이 ->아이유 에픽하이 ->오혁 아이유 ->오혁
[5] HIGH4 ->아이유 에픽하이 ->MINO 에픽하이 ->사이먼 도미닉 에픽하이 ->더콰이엇
[9] 에픽하이 ->수현 MINO ->사이먼 도미닉 MINO ->더콰이엇 사이먼 도미닉->더콰이엇
>
data.frame(V(g)$name)
V.g..name
1 아이유
2 에픽하이
3 HIGH4
4 MINO
5 사이먼 도미닉
6 G-DRAGON
7 오혁
8 더콰이엇
9 수현