https://github.com/bavla/biblio/tree/master/code
# bibmat - Derived bibliographic networks
# Vladimir Batagelj, November 2023
# source("https://raw.githubusercontent.com/bavla/biblio/master/code/bibmat.R")
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)}
bin <- function(M) {B <- t(apply(M,1,function(x) as.integer(x!=0)))
colnames(B) <- colnames(M); return(B)}
wod <- function(M) apply(M,1,sum)
wid <- function(M) apply(M,2,sum)
od <- function(M) wod(bin(M))
id <- function(M) wid(bin(M))
wd <- wod
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)}
ltxArray <- function(M){
S <- paste("\\begin{array}{r|",paste(rep("r",ncol(M)),collapse=""),"}\n",
paste(c("",colnames(M)),collapse=" & "),"\\\\\\hline\n",sep="")
for(i in 1:nrow(M))
S <- paste(S,rownames(M)[i],paste(" &",M[i,],collapse=""),"\\\\\n")
return(paste(S,"\\hline\n\\end{array}\n",sep=""))
}
ltxMatrix <- function(M,digits=4){
S <- paste("\\kbordermatrix{\n",paste(c("",colnames(M)),collapse=" & "),
"\\\\\n",sep="")
for(i in 1:nrow(M))
S <- paste(S,rownames(M)[i],paste(" &",round(M[i,],digits=digits),collapse=""),"\\\\\n")
return(paste(S,"}\n",sep=""))
}
ltxVector <- function(v,digits=4){
return(paste("\\kbordermatrix{\n",paste(c("",names(v)),collapse=" & "),
"\\\\\n",paste(" &",round(v,digits=digits),collapse=""),"\\\\\n}\n",sep=""))
}
A toy collection of bibliographic networks
> wdir <- "C:/Users/vlado/test/biblio"
> setwd(wdir)
> source("https://raw.githubusercontent.com/bavla/biblio/master/code/bibmat.R")
> load(url("https://github.com/bavla/biblio/raw/master/dat/bib/bibNets.Rdata"))
> WA
a1 a2 a3 a4 a5 a6 a7 a8 a9
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
> WK
k1 k2 k3 k4 k5 k6
w1 1 1 0 0 1 0
w2 1 0 1 0 0 0
w3 0 1 1 1 0 1
w4 0 0 1 0 1 0
w5 0 0 0 0 0 0
w6 0 0 1 0 0 1
w7 0 1 0 1 0 0
> Ci
w1 w2 w3 w4 w5 w6 w7
w1 0 1 0 1 1 0 0
w2 0 0 1 0 1 1 0
w3 0 0 0 1 1 0 1
w4 0 0 0 0 1 1 0
w5 0 0 0 0 0 1 0
w6 0 0 0 0 0 0 0
w7 0 0 0 0 0 0 0
> AC
c1 c2 c3
a1 1 0 0
a2 0 1 0
a3 1 0 0
a4 0 0 1
a5 0 0 1
a6 1 0 0
a7 0 1 0
a8 0 0 1
a9 0 1 0
> # save as Pajek networks
> source("https://raw.githubusercontent.com/bavla/Rnet/master/R/Pajek.R")
> bimatrix2net(WK,Net="WK.net")
> bimatrix2net(WA,Net="WA.net")
> bimatrix2net(AC,Net="AC.net")
> matrix2net(Ci,Net="Ci.net")
> (wodWA <- wod(WA))
w1 w2 w3 w4 w5 w6 w7
3 3 5 5 6 4 0
> (wodWK <- wod(WK))
w1 w2 w3 w4 w5 w6 w7
3 2 4 2 0 2 2
> (AK <- t(WA)%*%WK)
k1 k2 k3 k4 k5 k6
a1 2 2 2 1 1 1
a2 1 2 3 1 2 2
a3 1 2 1 1 1 1
a4 1 0 2 0 1 0
a5 1 1 4 1 1 2
a6 0 1 1 1 0 1
a7 0 0 2 0 1 1
a8 0 0 1 0 1 0
a9 0 0 1 0 0 1
> (wodAK <- wod(AK))
a1 a2 a3 a4 a5 a6 a7 a8 a9
9 11 7 4 10 4 4 2 2
> (widAK <- wid(AK))
k1 k2 k3 k4 k5 k6
6 8 17 5 8 9
> (widAKe <- (t(WK)%*%wodWA)[,1])
k1 k2 k3 k4 k5 k6
6 8 17 5 8 9
> (wodAKe <- (t(WA)%*%wodWK)[,1])
a1 a2 a3 a4 a5 a6 a7 a8 a9
9 11 7 4 10 4 4 2 2
> cat(ltxVector(wodWA))
\kbordermatrix{
& w1 & w2 & w3 & w4 & w5 & w6 & w7\\
& 3 & 3 & 5 & 5 & 6 & 4 & 0\\
}
> cat(ltxVector(wodWK))
\kbordermatrix{
& w1 & w2 & w3 & w4 & w5 & w6 & w7\\
& 3 & 2 & 4 & 2 & 0 & 2 & 2\\
}
> cat(ltxVector(widAK))
\kbordermatrix{
& k1 & k2 & k3 & k4 & k5 & k6\\
& 6 & 8 & 17 & 5 & 8 & 9\\
}
> cat(ltxVector(wodAK))
\kbordermatrix{
& a1 & a2 & a3 & a4 & a5 & a6 & a7 & a8 & a9\\
& 9 & 11 & 7 & 4 & 10 & 4 & 4 & 2 & 2\\
}
> sum(AK)
[1] 53
> wodWA * wodWK
w1 w2 w3 w4 w5 w6 w7
9 6 20 10 0 8 0
> sum(wodWA * wodWK)
[1] 53
> (wodWA %*% wodWK)[1]
[1] 53
> (wodAK <- (t(WA)%*%wod(WK))[,1])
a1 a2 a3 a4 a5 a6 a7 a8 a9
9 11 7 4 10 4 4 2 2
> (pA <- order(wodAK,decreasing=TRUE))
[1] 2 5 1 3 4 6 7 8 9
> (widAK <- (t(WK)%*%wod(WA))[,1])
k1 k2 k3 k4 k5 k6
6 8 17 5 8 9
> (pK <- order(widAK,decreasing=TRUE))
[1] 3 6 2 5 1 4
> (AK11 <- t(WA[,pA[1:3]])%*%WK[,pK[1:3]])
k3 k6 k2
a2 3 2 2
a5 4 2 1
a1 2 1 2
> (oInt <- wod(AK11))
a2 a5 a1
7 7 5
> (oExt <- wodAK[pA[1:3]] - oInt)
a2 a5 a1
4 3 4
> (iInt <- wid(AK11))
k3 k6 k2
9 5 5
> (iExt <- widAK[pK[1:3]] - iInt)
k3 k6 k2
8 4 3
> AK[pA,pK]
k3 k6 k2 k5 k1 k4
a2 3 2 2 2 1 1
a5 4 2 1 1 1 1
a1 2 1 2 1 2 1
a3 1 1 2 1 1 1
a4 2 0 0 1 1 0
a6 1 1 1 0 0 1
a7 2 1 0 1 0 0
a8 1 0 0 1 0 0
a9 1 1 0 0 0 0
> Co <- t(WA)%*%WA > wod(Co) a1 a2 a3 a4 a5 a6 a7 a8 a9 17 23 14 8 23 11 9 11 4 > (wodWA <- wod(WA)) w1 w2 w3 w4 w5 w6 w7 3 3 5 5 6 4 0 > (wodCo <- (t(WA)%*%wodWA)[,1]) a1 a2 a3 a4 a5 a6 a7 a8 a9 17 23 14 8 23 11 9 11 4
> WAs <- rbind(rbind(WA,0),0)
> rownames(WAs)[8] <- "w8"; rownames(WAs)[9] <- "w9"
> WAs[8,6] <- 1; WAs[9,2] <- 1
> WAn <- normalize(WAs)
> WAN <- newman(WAs)
> Ct <- D0(t(WAn) %*% WAN)
> sum(Ct)
[1] 6
> (wodCt <- wod(Ct))
a1 a2 a3 a4 a5 a6 a7 a8 a9
1.0333333 1.1500000 0.7000000 0.5333333 1.1500000 0.3666667 0.4500000 0.3666667 0.2500000
> sum(WAs)
[1] 28
> sum(WAn)
[1] 8
> (widWAn <- wid(WAn))
a1 a2 a3 a4 a5 a6 a7 a8 a9
1.0333333 2.1500000 0.7000000 0.5333333 2.1500000 0.3666667 0.4500000 0.3666667 0.2500000
> round(widWAn-wodCt)
a1 a2 a3 a4 a5 a6 a7 a8 a9
0 1 0 0 1 0 0 0 0
> WAn <- normalize(WA); WKn <- normalize(WK)
> AKn <- t(WAn)%*%WKn
> (wodAKn <- wod(AKn))
a1 a2 a3 a4 a5 a6 a7 a8 a9
0.8666667 0.9833333 0.5333333 0.5333333 0.9833333 0.2000000 0.4500000 0.2000000 0.2500000
> (widAKn <- wid(AKn))
k1 k2 k3 k4 k5 k6
0.8333333 0.5833333 1.7500000 0.2500000 0.8333333 0.7500000
> wod(WAn)
w1 w2 w3 w4 w5 w6 w7
1 1 1 1 1 1 0
> wod(WKn)
w1 w2 w3 w4 w5 w6 w7
1 1 1 1 0 1 1
> (wodAKne <- (t(WAn)%*%wod(WKn))[,1])
a1 a2 a3 a4 a5 a6 a7 a8 a9
0.8666667 0.9833333 0.5333333 0.5333333 0.9833333 0.2000000 0.4500000 0.2000000 0.2500000
> (widAKne <- (t(WKn)%*%wod(WAn))[,1])
k1 k2 k3 k4 k5 k6
0.8333333 0.5833333 1.7500000 0.2500000 0.8333333 0.7500000
> sum(AKn)
[1] 5
> cat(ltxVector(wod(WAn)))
> cat(ltxVector(wod(WKn)))
> cat(ltxVector(wodAKn))
> cat(ltxVector(widAKn))
> (WAn <- normalize(WA))
> (Cin <- normalize(Ci))
> (coCin <- t(Cin)%*%Cin)
> (coCan <- t(WAn)%*%coCin%*%WAn)
> sum(WAn)
[1] 6
> sum(Cin)
[1] 5
> sum(coCin)
[1] 5
> sum(coCan)
[1] 4.444444
> wod(coCan)
a1 a2 a3 a4 a5 a6 a7 a8 a9
0.4092593 0.8675926 0.2981481 0.2222222 0.9787037 0.2981481 0.5694444 0.3425926 0.4583333
> W1 <- which(wod(WA)>0)
> (wodSp <- wod(coCin[,W1]))
w1 w2 w3 w4 w5 w6 w7
0.0000000 0.3333333 0.3333333 0.5555556 1.3888889 1.8333333 0.2222222
> (wodQ <- (t(WAn)%*%wodSp)[,1])
a1 a2 a3 a4 a5 a6 a7 a8 a9
0.4092593 0.8675926 0.2981481 0.2222222 0.9787037 0.2981481 0.5694444 0.3425926 0.4583333
> sum(wodQ)
[1] 4.444444
> cat(ltxVector(wod(coCan)))
> cat(ltxVector(wodSp))
> cat(ltxVector(wodQ))
> (wodCinp <- wod(Cin[,W1]))
w1 w2 w3 w4 w5 w6 w7
1.0000000 1.0000000 0.6666667 1.0000000 1.0000000 0.0000000 0.0000000
> (wodcoCinp <- (t(Cin)%*%wodCinp)[,1])
w1 w2 w3 w4 w5 w6 w7
0.0000000 0.3333333 0.3333333 0.5555556 1.3888889 1.8333333 0.2222222
> (wodcoCan <- (t(WAn)%*%wodcoCinp)[,1])
a1 a2 a3 a4 a5 a6 a7 a8 a9
0.4092593 0.8675926 0.2981481 0.2222222 0.9787037 0.2981481 0.5694444 0.3425926 0.4583333
> sum(wodcoCan)
[1] 4.444444
> cat(ltxVector(wodcoCinp))
> cat(ltxVector(wodCinp))
> cat(ltxVector(wodcoCan))