====== Bibliographic networks - small example ======
===== Creation =====
> wdir <- "C:/Users/vlado/test/biblio"
> setwd(wdir)
> library(jsonlite)
> BL <- fromJSON("https://raw.githubusercontent.com/bavla/biblio/master/Eu/Data/bibList.json")
> Ci <- matrix(
+ c( 0, 1, 0, 1, 1, 0,
+ 0, 0, 1, 0, 1, 1,
+ 0, 0, 0, 1, 1, 0,
+ 0, 0, 0, 0, 1, 1,
+ 0, 0, 0, 0, 0, 1,
+ 0, 0, 0, 0, 0, 0 ), byrow=TRUE, nrow=6)
> rownames(Ci) <- colnames(Ci) <- BL$wID
> Ci
w1 w2 w3 w4 w5 w6
w1 0 1 0 1 1 0
w2 0 0 1 0 1 1
w3 0 0 0 1 1 0
w4 0 0 0 0 1 1
w5 0 0 0 0 0 1
w6 0 0 0 0 0 0
> A <- Reduce(union,sapply(BL$authors,function(x) x$aID))
> A
[1] "AB" "CD" "EF" "GH" "IJ" "KL" "MN" "OP" "RS"
> WA <- matrix(0,nrow=length(BL$wID),ncol=length(A))
> rownames(WA) <- BL$wID; colnames(WA) <- A
> for(w in 1:6) WA[w,which(A %in% BL$authors[[w]]$aID)] <- 1
> WA
AB CD EF GH IJ KL MN OP RS
w1 1 1 1 0 0 0 0 0 0
w2 1 0 0 1 1 0 0 0 0
w3 1 1 1 0 1 1 0 0 0
w4 0 1 0 1 1 0 1 1 0
w5 1 1 1 0 1 1 0 1 0
w6 0 1 0 0 1 0 1 0 1
>
> C <- Reduce(union,sapply(BL$authors,function(x) x$c))
> C
[1] "IT" "DE" "SI"
> AC <- matrix(0,nrow=length(A),ncol=length(C))
> rownames(AC) <- A; colnames(AC) <- C
> for(w in 1:6) {L <- BL$authors[[w]]$aID; k <- length(L)
+ for(j in 1:k) AC[L[j],BL$authors[[w]]$c[j]] <- 1 }
> AC
IT DE SI
AB 1 0 0
CD 0 1 0
EF 1 0 0
GH 0 0 1
IJ 0 0 1
KL 1 0 0
MN 0 1 0
OP 0 0 1
RS 0 1 0
> saveRDS(list(Ci=Ci,WA=WA,AC=AC),file="ExNets.RDS")
> # Ex <- readRDS("ExNets.RDS")
> source("https://raw.githubusercontent.com/bavla/Rnet/master/R/Pajek.R")
> matrix2net(Ci,Net="ExCi.net")
> bimatrix2net(WA,Net="ExWA.net")
> bimatrix2net(AC,Net="ExAC.net")
===== Reading =====
The data/networks are available at
[[https://github.com/bavla/biblio/tree/master/Eu/Data|GitHub/Bavla]]
> wdir <- "C:/Users/vlado/test/biblio"
> setwd(wdir)
> library(jsonlite)
> BL <- fromJSON("https://raw.githubusercontent.com/bavla/biblio/master/Eu/Data/bibList.json")
> urlEx <- "https://github.com/bavla/biblio/raw/master/Eu/Data/ExNets.RDS"
> download.file(url=urlEx,destfile=paste0(wdir,"/ExNets.RDS",sep=""))
> Ex <- readRDS("ExNets.RDS")
> Ci <- Ex$Ci; WA <- Ex$WA; AC <- Ex$AC
===== Some useful functions =====
Package [[https://github.com/bavla/biblio/tree/master/code|bibmat]]
normalize <- function(M) t(apply(M,1,function(x) x/max(1,sum(x))))
newman <- function(M) t(apply(M,1,function(x) x/max(1,sum(x)-1)))
D0 <- function(M) {diag(M) <- 0; return(M)}
binary <- function(M) {B <- t(apply(M,1,function(x) as.integer(x!=0)))
colnames(B) <- colnames(M); return(B)}
wodeg <- function(M) apply(M,1,sum)
wideg <- function(M) apply(M,2,sum)
odeg <- function(M) wodeg(binary(M))
ideg <- function(M) wideg(binary(M))
wdeg <- wodeg
Co <- function(M) t(M)%*%M
Cn <- function(M) Co(normalize(M))
Ct <- function(M) D0(t(normalize(M))%*%newman(M))
through <- function(M,S) t(M)%*%S%*%M
arit <- function(a,b) mean(c(a,b))
amin <- function(a,b) min(c(a,b))
amax <- function(a,b) max(c(a,b))
geom <- function(a,b) sqrt(a*b)
harm <- function(a,b) ifelse(a*b==0,0,2/(1/a+1/b))
jacc <- function(a,b) ifelse(a*b==0,0,1/(1/a+1/b - 1))
symm <- function(A,M) {n <- nrow(M); S <- M
for(i in 1:(n-1)) for(j in (i+1):n)
S[i,j] <- S[j,i] <- A(M[i,j],M[j,i])
return(S)}
===== Some tests =====
> wdir <- "C:/Users/vlado/test/biblio"
> setwd(wdir)
> source("https://raw.githubusercontent.com/bavla/biblio/master/code/bibmat.R")
> urlEx <- "https://github.com/bavla/biblio/raw/master/Eu/Data/ExNets.RDS"
> download.file(url=urlEx,destfile=paste0(wdir,"/ExNets.RDS",sep=""))
> Ex <- readRDS("ExNets.RDS")
> Ci <- Ex$Ci; WA <- Ex$WA; AC <- Ex$AC
> WAn <- normalize(WA)
> Cn <- t(WAn)%*%WAn
> wideg(WAn)
AB CD EF GH IJ KL MN OP RS
1.0333 1.1500 0.7000 0.5333 1.1500 0.3667 0.4500 0.3667 0.2500
> wideg(Cn)
AB CD EF GH IJ KL MN OP RS
1.0333 1.1500 0.7000 0.5333 1.1500 0.3667 0.4500 0.3667 0.2500
> WAt <- newman(WA)
> Ct <- D0(t(WAn)%*%WAt)
> wideg(Ct)
AB CD EF GH IJ KL MN OP RS
1.0333 1.1500 0.7000 0.5333 1.1500 0.3667 0.4500 0.3667 0.2500
> sum(Cn)
[1] 6
> sum(Ct)
[1] 6
> empty <- rep(0,length(A))
> WA1 <- rbind(WA,empty,empty)
> rownames(WA1)[7:8] <- c("w7","w8")
> WA1["w8","CD"] <- 1
> WA1
AB CD EF GH IJ KL MN OP RS
w1 1 1 1 0 0 0 0 0 0
w2 1 0 0 1 1 0 0 0 0
w3 1 1 1 0 1 1 0 0 0
w4 0 1 0 1 1 0 1 1 0
w5 1 1 1 0 1 1 0 1 0
w6 0 1 0 0 1 0 1 0 1
w7 0 0 0 0 0 0 0 0 0
w8 0 1 0 0 0 0 0 0 0
> WAn1 <- normalize(WA1)
> Cn1 <- t(WAn1)%*%WAn1
> sum(Cn1)
[1] 7
> WAt1 <- newman(WA1)
> Ct1 <- D0(t(WAn1)%*%WAt1)
> sum(Ct1)
[1] 6
> wideg(WAn1)
AB CD EF GH IJ KL MN OP RS
1.0333 2.1500 0.7000 0.5333 1.1500 0.3667 0.4500 0.3667 0.2500
> wdeg(Cn1)
AB CD EF GH IJ KL MN OP RS
1.0333 2.1500 0.7000 0.5333 1.1500 0.3667 0.4500 0.3667 0.2500
> wdeg(Ct1)
AB CD EF GH IJ KL MN OP RS
1.0333 1.1500 0.7000 0.5333 1.1500 0.3667 0.4500 0.3667 0.2500
> sum(wideg(WAn1))
[1] 7
> Cin <- normalize(Ci)
> CoCin <- t(Cin)%*%Cin
> CoCan <- t(WAn)%*%CoCin%*%WAn
> wdeg_CoCan <- (t(WAn)%*%wideg(Cin))[,1]
> wdeg_CoCan
AB CD EF GH IJ KL MN OP RS
0.4556 0.9694 0.3444 0.2778 1.0806 0.3444 0.6250 0.4444 0.4583
> wodeg(CoCan)
AB CD EF GH IJ KL MN OP RS
0.4556 0.9694 0.3444 0.2778 1.0806 0.3444 0.6250 0.4444 0.4583
> Can <- Cin%*%WAn
> wideg(Can)
AB CD EF GH IJ KL MN OP RS
0.4556 0.9694 0.3444 0.2778 1.0806 0.3444 0.6250 0.4444 0.4583
> biC <- Cin %*% t(Ci)
> biCo <- Ci %*% t(Ci)
> (wicin <- wideg(Cin))
w1 w2 w3 w4 w5 w6
0.0000000 0.3333333 0.3333333 0.8333333 1.6666667 1.8333333
> wideg(biC)
w1 w2 w3 w4 w5 w6
2.833333 3.833333 2.500000 3.500000 1.833333 0.000000
> (Ci %*% wicin)[,1]
w1 w2 w3 w4 w5 w6
2.833333 3.833333 2.500000 3.500000 1.833333 0.000000
> wodeg(biC)
w1 w2 w3 w4 w5 w6
2.333333 2.666667 3.000000 3.500000 3.000000 0.000000
> (Cin %*% ideg(Ci))[,1]
w1 w2 w3 w4 w5 w6
2.333333 2.666667 3.000000 3.500000 3.000000 0.000000
> biConG <- symm(geom,biC)
> (biCa <- through(WAn,biConG))
AB CD EF GH IJ KL MN OP RS
AB 0.5915234 0.5093036 0.38408370 0.33265960 0.5141621 0.18150245 0.12521988 0.18507268 0
CD 0.5093036 0.4693287 0.35854188 0.26154849 0.4273296 0.16578111 0.11078678 0.16213478 0
EF 0.3840837 0.3585419 0.28775510 0.16711538 0.2893263 0.12221088 0.07078678 0.09856456 0
GH 0.3326596 0.2615485 0.16711538 0.25997732 0.3628391 0.10286179 0.09443311 0.15007835 0
IJ 0.5141621 0.4273296 0.28932627 0.36283912 0.5334787 0.17063957 0.13800333 0.22142635 0
KL 0.1815025 0.1657811 0.12221088 0.10286179 0.1706396 0.06777778 0.04357023 0.07134800 0
MN 0.1252199 0.1107868 0.07078678 0.09443311 0.1380033 0.04357023 0.04000000 0.06357023 0
OP 0.1850727 0.1621348 0.09856456 0.15007835 0.2214264 0.07134800 0.06357023 0.11491823 0
RS 0.0000000 0.0000000 0.00000000 0.00000000 0.0000000 0.00000000 0.00000000 0.00000000 0