Analiza sieci społecznościowych - STAR WARS
PAKIETY
library(readxl)
library(igraph)
library(RColorBrewer)
library(ggplot2)
library(ggrepel)WCZYTYWANIE DANYCH
UWAGA!!!!!
Prosze podać swoją ścieżkę do pliku!
dane<-readRDS("C:/Users/majko/OneDrive/Pulpit/DOKTORAT/2 rok/Podyplomowe/Cwiczenia_SNA/dane_star_wars_macierz.rds")
head(dane,10)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE GOLD LEADER
## BERU 1 0 0 0 0 0 0
## BIGGS 0 29 0 0 0 0 1
## CAMIE 0 0 2 0 0 0 0
## DARTH VADER 0 0 0 41 0 0 0
## DODONNA 0 0 0 0 4 0 1
## GOLD FIVE 0 0 0 0 0 7 0
## GOLD LEADER 0 1 0 0 1 0 10
## GREEDO 0 0 0 0 0 0 0
## HAN 0 0 0 0 0 0 0
## JABBA 0 0 0 0 0 0 0
## GREEDO HAN JABBA LEIA LUKE OBI-WAN OWEN RED LEADER WEDGE
## BERU 0 0 0 0 1 0 0 0 0
## BIGGS 0 0 0 1 9 0 0 2 2
## CAMIE 0 0 0 0 2 0 0 0 0
## DARTH VADER 0 0 0 5 0 2 0 0 0
## DODONNA 0 0 0 0 0 0 0 0 0
## GOLD FIVE 0 0 0 0 0 0 0 0 0
## GOLD LEADER 0 0 0 0 0 0 0 1 0
## GREEDO 2 1 0 0 0 0 0 0 0
## HAN 1 99 3 22 43 12 0 0 0
## JABBA 0 3 3 0 0 0 0 0 0BUDOWA SIECI
g <- graph.adjacency(dane, weighted = TRUE, mode = "undirected", diag = FALSE)OPIS SIECI
g## IGRAPH 0e0b570 UNW- 16 21 --
## + attr: name (v/c), weight (e/n)
## + edges from 0e0b570 (vertex names):
## [1] BERU --LUKE BIGGS --GOLD LEADER
## [3] BIGGS --LEIA BIGGS --LUKE
## [5] BIGGS --RED LEADER BIGGS --WEDGE
## [7] CAMIE --LUKE DARTH VADER--LEIA
## [9] DARTH VADER--OBI-WAN DODONNA --GOLD LEADER
## [11] GOLD LEADER--RED LEADER GREEDO --HAN
## [13] HAN --JABBA HAN --LEIA
## [15] HAN --LUKE HAN --OBI-WAN
## + ... omitted several edgesKRAWĘDZIE
E(g)## + 21/21 edges from 0e0b570 (vertex names):
## [1] BERU --LUKE BIGGS --GOLD LEADER
## [3] BIGGS --LEIA BIGGS --LUKE
## [5] BIGGS --RED LEADER BIGGS --WEDGE
## [7] CAMIE --LUKE DARTH VADER--LEIA
## [9] DARTH VADER--OBI-WAN DODONNA --GOLD LEADER
## [11] GOLD LEADER--RED LEADER GREEDO --HAN
## [13] HAN --JABBA HAN --LEIA
## [15] HAN --LUKE HAN --OBI-WAN
## [17] LEIA --LUKE LUKE --OBI-WAN
## [19] LUKE --OWEN LUKE --RED LEADER
## + ... omitted several edgesWIERZCHOŁKI
V(g)## + 16/16 vertices, named, from 0e0b570:
## [1] BERU BIGGS CAMIE DARTH VADER DODONNA
## [6] GOLD FIVE GOLD LEADER GREEDO HAN JABBA
## [11] LEIA LUKE OBI-WAN OWEN RED LEADER
## [16] WEDGEMIARY
STOPIEŃ WIERZCHOŁKA
degree(g)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 1 5 1 2 1 0
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 3 1 5 1 4 9
## OBI-WAN OWEN RED LEADER WEDGE
## 3 1 3 2degree(g, mode = 'in')## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 1 5 1 2 1 0
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 3 1 5 1 4 9
## OBI-WAN OWEN RED LEADER WEDGE
## 3 1 3 2degree(g, mode = 'out')## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 1 5 1 2 1 0
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 3 1 5 1 4 9
## OBI-WAN OWEN RED LEADER WEDGE
## 3 1 3 2mean(degree(g, mode = 'in'))## [1] 2.625mean(degree(g, mode = 'out'))## [1] 2.625mean(degree(g))## [1] 2.625NAJKRÓTSZA ŚCIEŻKA
shortest.paths(g)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE GOLD LEADER
## BERU 0 4 3 10 4 Inf 3
## BIGGS 4 0 5 6 2 Inf 1
## CAMIE 3 5 0 11 5 Inf 4
## DARTH VADER 10 6 11 0 8 Inf 7
## DODONNA 4 2 5 8 0 Inf 1
## GOLD FIVE Inf Inf Inf Inf Inf 0 Inf
## GOLD LEADER 3 1 4 7 1 Inf 0
## GREEDO 25 21 26 15 23 Inf 22
## HAN 24 20 25 14 22 Inf 21
## JABBA 27 23 28 17 25 Inf 24
## LEIA 5 1 6 5 3 Inf 2
## LUKE 1 3 2 9 3 Inf 2
## OBI-WAN 12 8 13 2 10 Inf 9
## OWEN 7 9 8 15 9 Inf 8
## RED LEADER 2 2 3 8 2 Inf 1
## WEDGE 2 2 3 8 4 Inf 3
## GREEDO HAN JABBA LEIA LUKE OBI-WAN OWEN RED LEADER WEDGE
## BERU 25 24 27 5 1 12 7 2 2
## BIGGS 21 20 23 1 3 8 9 2 2
## CAMIE 26 25 28 6 2 13 8 3 3
## DARTH VADER 15 14 17 5 9 2 15 8 8
## DODONNA 23 22 25 3 3 10 9 2 4
## GOLD FIVE Inf Inf Inf Inf Inf Inf Inf Inf Inf
## GOLD LEADER 22 21 24 2 2 9 8 1 3
## GREEDO 0 1 4 20 24 13 30 23 23
## HAN 1 0 3 19 23 12 29 22 22
## JABBA 4 3 0 22 26 15 32 25 25
## LEIA 20 19 22 0 4 7 10 3 3
## LUKE 24 23 26 4 0 11 6 1 1
## OBI-WAN 13 12 15 7 11 0 17 10 10
## OWEN 30 29 32 10 6 17 0 7 7
## RED LEADER 23 22 25 3 1 10 7 0 2
## WEDGE 23 22 25 3 1 10 7 2 0sp=get.all.shortest.paths(g, "BERU", "WEDGE",weights=E(g)$dist)
sp=get.all.shortest.paths(g, "CAMIE", "DODONNA")
sp## $res
## $res[[1]]
## + 5/16 vertices, named, from 0e0b570:
## [1] CAMIE LUKE RED LEADER GOLD LEADER DODONNA
##
##
## $nrgeo
## [1] 1 0 1 0 1 0 1 0 0 0 0 1 0 0 1 1ŚREDNIA DŁUGOŚC ŚCIEŻKI
average.path.length(g)## [1] 2.27619GĘSTOŚĆ
edge_density(g, loops = F)## [1] 0.175graph.density(g, loop=T)## [1] 0.1544118BLISKOŚĆ
closeness(g,mode = 'all')## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 0.006896552 0.008130081 0.006329114 0.006622517 0.007299270 0.004166667
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 0.008064516 0.003496503 0.003663004 0.003205128 0.007936508 0.007575758
## OBI-WAN OWEN RED LEADER WEDGE
## 0.006060606 0.004761905 0.007874016 0.007633588closeness(g,mode = 'all',weights=NA)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 0.020408163 0.024390244 0.020408163 0.019230769 0.015625000 0.004166667
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 0.019607843 0.018181818 0.023809524 0.018181818 0.024390244 0.027777778
## OBI-WAN OWEN RED LEADER WEDGE
## 0.022727273 0.020408163 0.022727273 0.021739130max(closeness(g,mode = 'all'))## [1] 0.008130081max(closeness(g,mode = 'all',weights = NA))## [1] 0.02777778POŚREDNICTWO
betweenness(g,weights=NA)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 0.0000000 17.1666667 0.0000000 0.3333333 0.0000000 0.0000000
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 13.0000000 0.0000000 25.3333333 0.0000000 11.3333333 55.6666667
## OBI-WAN OWEN RED LEADER WEDGE
## 4.1666667 0.0000000 7.0000000 0.0000000betweenness(g)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 0.000000 49.000000 0.000000 40.000000 0.000000 0.000000
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 25.833333 0.000000 25.000000 0.000000 45.000000 38.000000
## OBI-WAN OWEN RED LEADER WEDGE
## 33.000000 0.000000 27.666667 9.333333WIZUALIZACJA PROSTA
plot(g)
WIZUALIZACJA
plot(g,
vertex.color=brewer.pal(8, "Pastel2"),
edge.arrow.size=10,
edge.color="black", ### KOLOR KRAWĘDZI
vertex.size=20, ### WIELKOŚĆ WĘZŁA (AKTORA)
vertex.label.cex=2, ### WIELKOŚĆ ETYKIETY WĘZŁA
vertex.size=5,
layout=layout.fruchterman.reingold,
main="GRAF") 
LAYOUT
layouts <- grep("^layout\\.", ls("package:igraph"), value=TRUE)
layouts## [1] "layout.auto" "layout.bipartite"
## [3] "layout.circle" "layout.davidson.harel"
## [5] "layout.drl" "layout.fruchterman.reingold"
## [7] "layout.fruchterman.reingold.grid" "layout.gem"
## [9] "layout.graphopt" "layout.grid"
## [11] "layout.grid.3d" "layout.kamada.kawai"
## [13] "layout.lgl" "layout.mds"
## [15] "layout.merge" "layout.norm"
## [17] "layout.random" "layout.reingold.tilford"
## [19] "layout.sphere" "layout.spring"
## [21] "layout.star" "layout.sugiyama"
## [23] "layout.svd"WIZUALIZACJA - WIELKOŚC WIERZCHOŁKA ZE WZGLĘDU NA STOPIEŃ WIERZCHOŁKA
plot(g,
vertex.color=brewer.pal(8, "Pastel2"),
edge.arrow.size=10,
edge.color="black", ### KOLOR KRAWĘDZI
vertex.size=degree(g)*2, ### WIELKOŚĆ WĘZŁA (AKTORA)
vertex.label.cex=2, ### WIELKOŚĆ ETYKIETY WĘZŁA
layout=layout.fruchterman.reingold,
main="Graf wględem liczby połączeń") 
WIZUALIZACJA - GRUBOŚCI KRAWEDZI ZE WZGLĘDU NA WSPÓLNĄ LICZBĘ SCEN AKTORÓW
PRZYGOTOWANIE DANYCH
GRUBOŚC KRAWĘDZI JAKO FUNCKJA WSPÓLNYCH SCEN AKTORÓW
E(g)$width <- log(E(g)$weight) + 1
edge_attr(g)## $weight
## [1] 1 1 1 9 2 2 2 5 2 1 1 1 3 22 43 12 20 33 6 1 1
##
## $width
## [1] 1.000000 1.000000 1.000000 3.197225 1.693147 1.693147 1.693147
## [8] 2.609438 1.693147 1.000000 1.000000 1.000000 2.098612 4.091042
## [15] 4.761200 3.484907 3.995732 4.496508 2.791759 1.000000 1.000000WIZUALIZACJA
plot(g)
plot(g,
vertex.color=brewer.pal(8, "Pastel2"),
edge.arrow.size=10,
edge.color="red", ### KOLOR KRAWĘDZI
vertex.size=degree(g)*2, ### WIELKOŚĆ WĘZŁA (AKTORA)
vertex.label.cex=2, ### WIELKOŚĆ ETYKIETY WĘZŁA
layout=layout.fruchterman.reingold,
main="Graf wględem liczby połączeń")
PODZIAŁ NA ZŁĄ I DOBRĄ STRONĘ MOCY
PRZYGOTOWANIE DANYCH
dark_side <- c("DARTH VADER", "MOTTI", "TARKIN")
light_side <- c("R2-D2", "CHEWBACCA", "C-3PO", "LUKE", "CAMIE", "BIGGS",
"LEIA", "BERU", "OWEN", "OBI-WAN", "HAN", "DODONNA",
"GOLD LEADER", "WEDGE", "RED LEADER", "RED TEN", "GOLD FIVE")
other <- c("GREEDO", "JABBA")PRZYPISANIE KOLORÓW DO POSZCZEGÓLNYCH “STRON MOCY”
V(g)$color <- NA
V(g)$color[V(g)$name %in% dark_side] <- "red"
V(g)$color[V(g)$name %in% light_side] <- "gold"
V(g)$color[V(g)$name %in% other] <- "grey20"
vertex_attr(g)## $name
## [1] "BERU" "BIGGS" "CAMIE" "DARTH VADER" "DODONNA"
## [6] "GOLD FIVE" "GOLD LEADER" "GREEDO" "HAN" "JABBA"
## [11] "LEIA" "LUKE" "OBI-WAN" "OWEN" "RED LEADER"
## [16] "WEDGE"
##
## $color
## [1] "gold" "gold" "gold" "red" "gold" "gold" "gold"
## [8] "grey20" "gold" "grey20" "gold" "gold" "gold" "gold"
## [15] "gold" "gold"WIZUALIZACJA
plot(g)
legend(x=.8, y=.8, legend=c("Dark side", "Light side", "Other"),
pch=21, pt.bg=c("red", "gold", "grey20"), pt.cex=2, bty="n")
plot(g,
# vertex.color=brewer.pal(8, "Pastel2"),
edge.arrow.size=10,
edge.color="black", ### KOLOR KRAWĘDZI
vertex.size=degree(g)*2, ### WIELKOŚĆ WĘZŁA (AKTORA)
vertex.label.cex=2, ### WIELKOŚĆ ETYKIETY WĘZŁA
layout=layout.fruchterman.reingold,
main="Graf wględem liczby połączeń")
legend(x=.8, y=.8, legend=c("Dark side", "Light side", "Other"),
pch=21, pt.bg=c("red", "gold", "grey20"), pt.cex=3, bty="n")
SIEĆ 3D
library(d3Network)
library(networkD3)
sg <- simplify(g)
df <- get.edgelist(g, names=TRUE)
df <- as.data.frame(df)
colnames(df) <- c('source', 'target')
df$value <- rep(1, nrow(df))
# get communities
fc <- fastgreedy.community(g)
com <- membership(fc)
node.info <- data.frame(name=names(com), group=as.vector(com))
links <- data.frame(source=match(df$source, node.info$name)-1,target=match(df$target, node.info$name)-1,value=df$value)
forceNetwork(Links = links, Nodes = node.info,Source = "source", Target = "target",Value = "value", NodeID = "name",Group = "group", opacity = 1, opacityNoHover=1) Made by:
Majkowska Agata
agata.majkowska@phdstud.ug.edu.pl