PAKIETY
library(readxl)
library(igraph)
library(RColorBrewer)
library(ggplot2)
library(ggrepel)
library(writexl)WCZYTYWANIE DANYCH
UWAGA!!!!!
Prosze podać swoją ścieżkę do pliku!
dane<-readRDS("C:/Users/majko/OneDrive/Dokumenty/DOKTORAT/2 rok/Podyplomowe/Cwiczenia_SNA/dane_star_wars_macierz.rds")
head(dane,10)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE GOLD LEADER GREEDO
## BERU 1 0 0 0 0 0 0 0
## BIGGS 0 29 0 0 0 0 1 0
## CAMIE 0 0 2 0 0 0 0 0
## DARTH VADER 0 0 0 41 0 0 0 0
## DODONNA 0 0 0 0 4 0 1 0
## GOLD FIVE 0 0 0 0 0 7 0 0
## GOLD LEADER 0 1 0 0 1 0 10 0
## GREEDO 0 0 0 0 0 0 0 2
## HAN 0 0 0 0 0 0 0 1
## JABBA 0 0 0 0 0 0 0 0
## HAN JABBA LEIA LUKE OBI-WAN OWEN RED LEADER WEDGE
## BERU 0 0 0 1 0 0 0 0
## BIGGS 0 0 1 9 0 0 2 2
## CAMIE 0 0 0 2 0 0 0 0
## DARTH VADER 0 0 5 0 2 0 0 0
## DODONNA 0 0 0 0 0 0 0 0
## GOLD FIVE 0 0 0 0 0 0 0 0
## GOLD LEADER 0 0 0 0 0 0 1 0
## GREEDO 1 0 0 0 0 0 0 0
## HAN 99 3 22 43 12 0 0 0
## JABBA 3 3 0 0 0 0 0 0BUDOWA SIECI
g <- graph.adjacency(dane, weighted = TRUE, mode = "undirected", diag = FALSE)OPIS SIECI
g## IGRAPH 285684d UNW- 16 21 --
## + attr: name (v/c), weight (e/n)
## + edges from 285684d (vertex names):
## [1] BERU --LUKE BIGGS --GOLD LEADER BIGGS --LEIA
## [4] BIGGS --LUKE BIGGS --RED LEADER BIGGS --WEDGE
## [7] CAMIE --LUKE DARTH VADER--LEIA DARTH VADER--OBI-WAN
## [10] DODONNA --GOLD LEADER GOLD LEADER--RED LEADER GREEDO --HAN
## [13] HAN --JABBA HAN --LEIA HAN --LUKE
## [16] HAN --OBI-WAN LEIA --LUKE LUKE --OBI-WAN
## [19] LUKE --OWEN LUKE --RED LEADER LUKE --WEDGEKRAWĘDZIE
E(g)## + 21/21 edges from 285684d (vertex names):
## [1] BERU --LUKE BIGGS --GOLD LEADER BIGGS --LEIA
## [4] BIGGS --LUKE BIGGS --RED LEADER BIGGS --WEDGE
## [7] CAMIE --LUKE DARTH VADER--LEIA DARTH VADER--OBI-WAN
## [10] DODONNA --GOLD LEADER GOLD LEADER--RED LEADER GREEDO --HAN
## [13] HAN --JABBA HAN --LEIA HAN --LUKE
## [16] HAN --OBI-WAN LEIA --LUKE LUKE --OBI-WAN
## [19] LUKE --OWEN LUKE --RED LEADER LUKE --WEDGEWIERZCHOŁKI
V(g)## + 16/16 vertices, named, from 285684d:
## [1] BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## [7] GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## [13] OBI-WAN OWEN RED LEADER 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 GREEDO
## BERU 0 4 3 10 4 Inf 3 25
## BIGGS 4 0 5 6 2 Inf 1 21
## CAMIE 3 5 0 11 5 Inf 4 26
## DARTH VADER 10 6 11 0 8 Inf 7 15
## DODONNA 4 2 5 8 0 Inf 1 23
## GOLD FIVE Inf Inf Inf Inf Inf 0 Inf Inf
## GOLD LEADER 3 1 4 7 1 Inf 0 22
## GREEDO 25 21 26 15 23 Inf 22 0
## HAN 24 20 25 14 22 Inf 21 1
## JABBA 27 23 28 17 25 Inf 24 4
## LEIA 5 1 6 5 3 Inf 2 20
## LUKE 1 3 2 9 3 Inf 2 24
## OBI-WAN 12 8 13 2 10 Inf 9 13
## OWEN 7 9 8 15 9 Inf 8 30
## RED LEADER 2 2 3 8 2 Inf 1 23
## WEDGE 2 2 3 8 4 Inf 3 23
## HAN JABBA LEIA LUKE OBI-WAN OWEN RED LEADER WEDGE
## BERU 24 27 5 1 12 7 2 2
## BIGGS 20 23 1 3 8 9 2 2
## CAMIE 25 28 6 2 13 8 3 3
## DARTH VADER 14 17 5 9 2 15 8 8
## DODONNA 22 25 3 3 10 9 2 4
## GOLD FIVE Inf Inf Inf Inf Inf Inf Inf Inf
## GOLD LEADER 21 24 2 2 9 8 1 3
## GREEDO 1 4 20 24 13 30 23 23
## HAN 0 3 19 23 12 29 22 22
## JABBA 3 0 22 26 15 32 25 25
## LEIA 19 22 0 4 7 10 3 3
## LUKE 23 26 4 0 11 6 1 1
## OBI-WAN 12 15 7 11 0 17 10 10
## OWEN 29 32 10 6 17 0 7 7
## RED LEADER 22 25 3 1 10 7 0 2
## WEDGE 22 25 3 1 10 7 2 0sp=get.all.shortest.paths(g, "CAMIE", "DODONNA")
sp## $res
## $res[[1]]
## + 5/16 vertices, named, from 285684d:
## [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] 11.2381GĘ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.007751938 0.009345794 0.007042254 0.007407407 0.008264463 NaN
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 0.009259259 0.003703704 0.003891051 0.003378378 0.009090909 0.008620690
## OBI-WAN OWEN RED LEADER WEDGE
## 0.006711409 0.005154639 0.009009009 0.008695652closeness(g,mode = 'all',weights=NA)## BERU BIGGS CAMIE DARTH VADER DODONNA GOLD FIVE
## 0.03030303 0.04000000 0.03030303 0.02777778 0.02083333 NaN
## GOLD LEADER GREEDO HAN JABBA LEIA LUKE
## 0.02857143 0.02564103 0.03846154 0.02564103 0.04000000 0.05000000
## OBI-WAN OWEN RED LEADER WEDGE
## 0.03571429 0.03030303 0.03571429 0.03333333max(closeness(g,mode = 'all'))## [1] NaNmax(closeness(g,mode = 'all',weights = NA))## [1] NaNPOŚ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 2.609438
## [9] 1.693147 1.000000 1.000000 1.000000 2.098612 4.091042 4.761200 3.484907
## [17] 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" "grey20"
## [9] "gold" "grey20" "gold" "gold" "gold" "gold" "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)## Warning: pakiet 'd3Network' został zbudowany w wersji R 4.1.3library(networkD3)## Warning: pakiet 'networkD3' został zbudowany w wersji R 4.1.3sg <- 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)#saveRDS(dane, file = "C:/Users/majko/OneDrive/Dokumenty/Zajecia_WZR/Zajecia 2021-2022/Podypolomowe_2021-22/AGATA.rds")
#dane<-as.data.frame(dane)
#write_xlsx(dane, "C:/Users/majko/OneDrive/Dokumenty/Zajecia_WZR/Zajecia 2021-2022/Podypolomowe_2021-22/AGATA.xlsx")
#write.csv(dane, "C:/Users/majko/OneDrive/Dokumenty/Zajecia_WZR/Zajecia 2021-2022/Podypolomowe_2021-22/AGATA.csv")kliki = cliques(g)
a<-largest_cliques(g)
a[[2]]## + 3/16 vertices, named, from 285684d:
## [1] RED LEADER BIGGS GOLD LEADERclique2<-a[[2]]
g2<-induced.subgraph(graph=g,vids=clique2)
plot(g2)
# Filtrowanie klik zawierających "LUKE"
kliki_z_luke <- Filter(function(k) "LUKE" %in% V(g)[k]$name, kliki)
# Wyświetlenie klik zawierających LUKE
print(kliki_z_luke)## [[1]]
## + 1/16 vertex, named, from 285684d:
## [1] LUKE
##
## [[2]]
## + 2/16 vertices, named, from 285684d:
## [1] BIGGS LUKE
##
## [[3]]
## + 2/16 vertices, named, from 285684d:
## [1] HAN LUKE
##
## [[4]]
## + 2/16 vertices, named, from 285684d:
## [1] LUKE OWEN
##
## [[5]]
## + 2/16 vertices, named, from 285684d:
## [1] CAMIE LUKE
##
## [[6]]
## + 2/16 vertices, named, from 285684d:
## [1] BERU LUKE
##
## [[7]]
## + 3/16 vertices, named, from 285684d:
## [1] BIGGS LUKE WEDGE
##
## [[8]]
## + 2/16 vertices, named, from 285684d:
## [1] LUKE WEDGE
##
## [[9]]
## + 3/16 vertices, named, from 285684d:
## [1] BIGGS LUKE RED LEADER
##
## [[10]]
## + 2/16 vertices, named, from 285684d:
## [1] LUKE RED LEADER
##
## [[11]]
## + 3/16 vertices, named, from 285684d:
## [1] HAN LUKE OBI-WAN
##
## [[12]]
## + 2/16 vertices, named, from 285684d:
## [1] LUKE OBI-WAN
##
## [[13]]
## + 3/16 vertices, named, from 285684d:
## [1] HAN LEIA LUKE
##
## [[14]]
## + 3/16 vertices, named, from 285684d:
## [1] BIGGS LEIA LUKE
##
## [[15]]
## + 2/16 vertices, named, from 285684d:
## [1] LEIA LUKE