I decided to add to the info a trace field containing a list of transformations of the initial multiway network.
> wdir <- "C:/Users/vlado/docs/papers/2022/ifcs2022/genova/data"
> setwd(wdir)
> library(jsonlite)
> source("https://raw.githubusercontent.com/bavla/Rnet/master/R/Pajek.R")
> MN <- fromJSON("students.json")
> str(MN)
List of 5
$ format: chr "MWnets"
$ info :List of 5
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
$ ways :List of 4
..$ prov: chr "province"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ prov:'data.frame': 107 obs. of 8 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 37205 obs. of 5 variables:
..$ prov: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ univ: int [1:37205] 1 1 1 1 2 3 4 5 5 5 ...
..$ prog: int [1:37205] 4 5 9 11 4 3 9 3 5 9 ...
..$ year: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:37205] 4 1 1 1 11 1 1 1 1 1 ...
>
> reorderways <- function(MN,ord){
+ Cols <- colnames(MN$links); info <- MN$info
+ if(!is.numeric(ord)) ord <- match(ord,Cols)
+ nc <- length(Cols); nl <- length(ord)
+ MNr <- MN$links[c(ord,(nl+1):nc)]
+ event <- list(op="reorderways",par=Cols[ord],date=date())
+ info$trace[[length(info$trace)+1]] <- event
+ return(list(format="MWnets",info=info,ways=MN$ways[ord],
+ nodes=MN$nodes[ord],links=MNr))
+ }
> MNo <- reorderways(MN,c("year","prog","prov","univ"))
> str(MNo)
List of 5
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 1
.. ..$ :List of 3
.. .. ..$ op : chr "reorderways"
.. .. ..$ par : chr [1:4] "year" "prog" "prov" "univ"
.. .. ..$ date: chr "Mon Nov 21 02:46:18 2022"
$ ways :List of 4
..$ year: chr "year"
..$ prog: chr "programme"
..$ prov: chr "province"
..$ univ: chr "university"
$ nodes :List of 4
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" ...
..$ prov:'data.frame': 107 obs. of 8 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
$ links :'data.frame': 37205 obs. of 5 variables:
..$ year: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ prog: int [1:37205] 4 5 9 11 4 3 9 3 5 9 ...
..$ prov: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ univ: int [1:37205] 1 1 1 1 2 3 4 5 5 5 ...
..$ w : int [1:37205] 4 1 1 1 11 1 1 1 1 1 ...
P is a text containing a logical expression.
https://stackoverflow.com/questions/1567718/getting-a-function-name-as-a-string
> slice <- function(MN,P){
+ info <- MN$info
+ MNr <- with(MN$links,MN$links[eval(str2expression(P)),])
+ event <- list(op="slice",P=P,date=date())
+ info$trace[[length(info$trace)+1]] <- event
+ return(list(format="MWnets",info=info,ways=MN$ways,
+ nodes=MN$nodes,links=MNr))
+ }
> MS <- slice(MN,"year==3")
> str(MS)
List of 5
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 1
.. ..$ :List of 3
.. .. ..$ op : chr "slice"
.. .. ..$ P : chr "year==3"
.. .. ..$ date: chr "Mon Nov 21 02:49:45 2022"
$ ways :List of 4
..$ prov: chr "province"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ prov:'data.frame': 107 obs. of 8 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 9293 obs. of 5 variables:
..$ prov: int [1:9293] 1 1 1 1 1 1 1 1 1 1 ...
..$ univ: int [1:9293] 1 1 1 2 2 3 3 3 5 5 ...
..$ prog: int [1:9293] 4 9 11 4 11 3 4 11 4 5 ...
..$ year: int [1:9293] 3 3 3 3 3 3 3 3 3 3 ...
..$ w : int [1:9293] 2 4 3 7 1 5 1 1 1 1 ...
FUN is a text containing a name of the function
> flatten <- function(MN,col,by,FUN="sum"){
+ Cols <- colnames(MN$links); byList <- list()
+ if(!is.numeric(col)) col <- which(Cols==col)
+ if(!is.numeric(by)) by <- match(by,Cols)
+ for(i in 1:length(by)) byList[i] <- MN$links[by[i]]
+ MNr <- aggregate(MN$links[col],by=byList,FUN=FUN)
+ colnames(MNr) <- c(Cols[by],Cols[col])
+ event <- list(op="flatten",par=Cols[c(by,col)],FUN=FUN,date=date())
+ info <- MN$info
+ info$trace[[length(info$trace)+1]] <- event
+ return(list(format="MWnets",info=info,ways=MN$ways[by],
+ nodes=MN$nodes[by],links=MNr))
+ }
> MNf <- flatten(MN,5,c(4,1,2))
> str(MNf)
List of 5
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 1
.. ..$ :List of 4
.. .. ..$ op : chr "flatten"
.. .. ..$ par : chr [1:4] "year" "prov" "univ" "w"
.. .. ..$ FUN : chr "sum"
.. .. ..$ date: chr "Mon Nov 21 02:52:33 2022"
$ ways :List of 3
..$ year: chr "year"
..$ prov: chr "province"
..$ univ: chr "university"
$ nodes :List of 3
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
..$ prov:'data.frame': 107 obs. of 8 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
$ links :'data.frame': 15019 obs. of 4 variables:
..$ year: int [1:15019] 1 2 3 4 1 2 3 4 2 3 ...
..$ prov: int [1:15019] 1 1 1 1 2 2 2 2 3 3 ...
..$ univ: int [1:15019] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:15019] 7 17 9 8 13 12 23 6 4 6 ...
per
> reorderlinks <- function(MN,per=NULL){
+ info <- MN$info; P <- "user"
+ if(is.null(per)){n <- nrow(MN$links); per <- sample(1:n,n); P <- "random"} else
+ if(length(per)==1){P <- per; per <- with(MN$links,eval(str2expression(per)))}
+ MNr <- with(MN$links,MN$links[per,])
+ event <- list(op="reorderlinks",per=P,date=date())
+ info$trace[[length(info$trace)+1]] <- event
+ return(list(format="MWnets",info=info,ways=MN$ways,
+ nodes=MN$nodes,links=MNr))
+ }
> Mo <- reorderlinks(MN,"order(prov,univ,prog,year)")
> str(Mo)
List of 5
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 1
.. ..$ :List of 3
.. .. ..$ op : chr "reorderlinks"
.. .. ..$ per : chr "order(prov,univ,prog,year)"
.. .. ..$ date: chr "Mon Nov 21 02:59:26 2022"
$ ways :List of 4
..$ prov: chr "province"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ prov:'data.frame': 107 obs. of 8 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 37205 obs. of 5 variables:
..$ prov: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ univ: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ prog: int [1:37205] 4 4 4 4 5 5 8 9 9 9 ...
..$ year: int [1:37205] 1 2 3 4 1 4 2 1 2 3 ...
..$ w : int [1:37205] 4 6 2 3 1 1 1 1 4 4 ...
> joinways <- function(MN,way1,way2,way3,sep="÷"){
+ info <- MN$info; Nw <- names(MN$ways)
+ Nu <- MN$nodes[[way1]]$ID; Nv <- MN$nodes[[way2]]$ID
+ i <- which(Nw==way1); j <- which(Nw==way2)
+ U <- Nu[MN$links[[i]]]; V <- Nv[MN$links[[j]]]
+ UV <- paste(U,V,sep=sep); UP <- factor(UV)
+ event <- list(op="joinways",ways=c(way1,way2,way3),sep=sep,date=date())
+ info$trace[[length(info$trace)+1]] <- event
+ lab <- paste(MN$ways[[way1]],MN$ways[[way2]],sep=" and ")
+ ways <- MN$ways[-c(i,j)]; ways[[way3]] <- lab
+ nodes <- MN$nodes[-c(i,j)]; nodes[[way3]] <- data.frame(ID=levels(UP))
+ nw <- length(MN$ways); nc <- ncol(MN$links)
+ links <- MN$links[1:nw][-c(i,j)]; links[way3] <- as.integer(UP)
+ links <- cbind(links,MN$links[(nw+1):nc])
+ return(list(format="MWnets",info=info,ways=ways,nodes=nodes,links=links))
+ }
> Mj <- joinways(MN,"prog","univ","prun")
> str(Mj)
List of 5
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 1
.. ..$ :List of 4
.. .. ..$ op : chr "joinways"
.. .. ..$ ways: chr [1:3] "prog" "univ" "prun"
.. .. ..$ sep : chr "÷"
.. .. ..$ date: chr "Mon Nov 21 04:13:44 2022"
$ ways :List of 3
..$ prov: chr "province"
..$ year: chr "year"
..$ prun: chr "programme and university"
$ nodes :List of 3
..$ prov:'data.frame': 107 obs. of 8 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
..$ prun:'data.frame': 493 obs. of 1 variable:
.. ..$ ID: chr [1:493] "AFFV÷Cattolica" "AFFV÷Federico2" "AFFV÷Mediterra" "AFFV÷MGraecia" ...
$ links :'data.frame': 37205 obs. of 4 variables:
..$ prov: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ year: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ prun: int [1:37205] 99 164 321 429 100 41 322 36 165 323 ...
..$ w : int [1:37205] 4 1 1 1 11 1 1 1 1 1 ...
> projection <- function(MN,way,w){
+ Nw <- names(MN$ways); u <- which(Nw==way)
+ nw <- length(MN$ways); nc <- ncol(MN$links)
+ Nc <- names(MN$links); v <- which(Nc==w)
+ S <- c((1:nw)[-u],u,v)
+ MT <- MN$links[S]; Nt <- names(MT)[1:nw]
+ ex <- paste("order(",paste(Nt,collapse=","),")",sep="")
+ per <- with(MT,eval(str2expression(ex)))
+ MP <- with(MT,MT[per,])
+ I <- c(1); nm <- nw-1; nS <- length(MN$nodes[[way]]$ID)
+ for(i in 2:nrow(MP)) if(!all(MP[i-1,1:nm]==MP[i,1:nm])) I <- c(I,i)
+ I <- c(I,nrow(MP)+1)
+ Co <- matrix(0,nrow=nS,ncol=nS)
+ colnames(Co) <- rownames(Co) <- MN$nodes[[way]]$ID
+ for(i in 1:(length(I)-1)){
+ i1 <- I[i]; i2 <- I[i+1]-1
+ for(j in i1:i2) {
+ u <- MP[[way]][j]
+ for(k in j:i2){
+ v <- MP[[way]][k]
+ Co[u,v] <- Co[u,v] + MP[[w]][j] * MP[[w]][k]
+ }
+ }
+ }
+ D <- diag(Co); diag(Co) <- 0; Co <- Co + t(Co); diag(Co) <- D
+ return(Co)
+ }
> Co <- projection(MN,"prov","w")
> Co[1:10,1:15]
AG AL AN AO AP AQ AR AT AV BA BG BI BL BN BO
AG 27150 7885 9677 13731 6123 7522 5162 985 10768 21291 4119 1845 4494 6258 4081
AL 7885 88345 4953 3031 2577 2116 2941 5395 3102 9568 1524 5077 1736 2065 4319
AN 9677 4953 33872 4595 15528 8752 14734 1086 9000 19437 7326 1984 6859 5626 4655
AO 13731 3031 4595 32679 2445 5028 2435 424 6107 16236 2961 780 1253 3227 2825
AP 6123 2577 15528 2445 15693 6877 7956 533 9614 15132 3342 968 3370 6705 2628
AQ 7522 2116 8752 5028 6877 14169 4916 460 10148 12877 1993 669 2088 8023 2747
AR 5162 2941 14734 2435 7956 4916 13591 550 4514 9590 3115 1038 2930 2859 3065
AT 985 5395 1086 424 533 460 550 866 687 1842 360 603 378 550 987
AV 10768 3102 9000 6107 9614 10148 4514 687 17699 20279 2289 1004 2468 14181 3749
BA 21291 9568 19437 16236 15132 12877 9590 1842 20279 46495 6231 3227 7270 14026 9248
>
Nekaj je zgleda narobe Co[AT,AT] = 866 !?
> salton <- function(Co){
+ Sal <- Co; diag(Sal) <- 1; n = nrow(Sal)
+ for(u in 1:(n-1)) for(v in (u+1):n) Sal[v,u] <- Sal[u,v] <- Co[u,v]/sqrt(Co[u,u]*Co[v,v])
+ return(Sal)
+ }
> Sal <- salton(Co)
> D <- as.dist(1-Sal)
> t <- hclust(D,method="ward.D")
> plot(t,hang=-1,cex=0.8,main="Provinces / Ward")
The projection can be generalized to two weights w and z by the change Co[u,v] ← Co[u,v] + MPw[j] * MPz[k] (and some other details).
> projection2 <- function(MN,way,w,z){
+ Nw <- names(MN$ways); u <- which(Nw==way)
+ nw <- length(MN$ways); nc <- ncol(MN$links)
+ Nc <- names(MN$links); v <- which(Nc==w); t <- which(Nc==z)
+ S <- c((1:nw)[-u],u,v,t)
+ MT <- MN$links[S]; Nt <- names(MT)[1:nw]
+ ex <- paste("order(",paste(Nt,collapse=","),")",sep="")
+ per <- with(MT,eval(str2expression(ex)))
+ MP <- MT[per,]
+ I <- c(1); nm <- nw-1; nS <- length(MN$nodes[[way]]$ID)
+ for(i in 2:nrow(MP)) if(!all(MP[i-1,1:nm]==MP[i,1:nm])) I <- c(I,i)
+ I <- c(I,nrow(MP)+1)
+ Co <- matrix(0,nrow=nS,ncol=nS)
+ colnames(Co) <- rownames(Co) <- MN$nodes[[way]]$ID
+ for(i in 1:(length(I)-1)){
+ i1 <- I[i]; i2 <- I[i+1]-1
+ for(j in i1:i2) {
+ u <- MP[[way]][j]
+ for(k in i1:i2){
+ v <- MP[[way]][k]
+ Co[u,v] <- Co[u,v] + MP[[w]][j] * MP[[z]][k]
+ }
+ }
+ }
+ return(Co)
+ }
It holds projection(w) = projection2(w,w)
> Co <- projection(MN,"prog","w")
> Co[1:10,1:10]
Q AFFV AH BAL Edu EMC HW ICT NsMS Serv
Q 953 384 1214 879 77 1928 32 274 957 98
AFFV 384 62327 69116 53302 11252 53409 7584 12540 52502 18485
AH 1214 69116 735414 270636 131208 282646 46777 62826 292538 101032
BAL 879 53302 270636 431878 68597 173212 31775 33447 207525 78259
Edu 77 11252 131208 68597 91037 44260 18072 12554 52669 36972
EMC 1928 53409 282646 173212 44260 1084555 20054 39117 221177 40911
HW 32 7584 46777 31775 18072 20054 21444 3763 28145 18390
ICT 274 12540 62826 33447 12554 39117 3763 16485 40382 11456
NsMS 957 52502 292538 207525 52669 221177 28145 40382 474734 82624
Serv 98 18485 101032 78259 36972 40911 18390 11456 82624 81498
> Co2 <- projection2(MN,"prog","w","w")
> Co2[1:10,1:10]
Q AFFV AH BAL Edu EMC HW ICT NsMS Serv
Q 953 384 1214 879 77 1928 32 274 957 98
AFFV 384 62327 69116 53302 11252 53409 7584 12540 52502 18485
AH 1214 69116 735414 270636 131208 282646 46777 62826 292538 101032
BAL 879 53302 270636 431878 68597 173212 31775 33447 207525 78259
Edu 77 11252 131208 68597 91037 44260 18072 12554 52669 36972
EMC 1928 53409 282646 173212 44260 1084555 20054 39117 221177 40911
HW 32 7584 46777 31775 18072 20054 21444 3763 28145 18390
ICT 274 12540 62826 33447 12554 39117 3763 16485 40382 11456
NsMS 957 52502 292538 207525 52669 221177 28145 40382 474734 82624
Serv 98 18485 101032 78259 36972 40911 18390 11456 82624 81498
The main reason for introducing projection2 is to provide support for an approach similar to that from the section Bibliographic coupling and co-citation from the paper On fractional approach to analysis of linked networks.
It holds: projection2(w,z) = trans(projection2(z,w))
> one <- rep(1,length(MN$links[[w]]))
> MN$links$one <- one
> names(MN$links)
[1] "prov" "univ" "prog" "year" "w" "one"
> CoA <- projection2(MN,"prog","w","one")
> CoB <- projection2(MN,"prog","one","w")
> CoA[1:10,1:10]
Q AFFV AH BAL Edu EMC HW ICT NsMS Serv
Q 381 91 207 207 53 245 14 106 195 45
AFFV 189 5759 4251 4110 2079 3026 1453 2557 4325 2452
AH 740 10992 32654 21524 11778 16614 8364 12211 21269 12013
BAL 518 6965 14457 24890 7613 10090 5082 6707 12837 8238
Edu 49 1791 4122 4088 5417 2610 2055 2207 3296 2822
EMC 1042 7321 23141 13833 6155 31793 4571 7812 17123 6656
HW 27 797 1415 1441 989 991 1776 708 1201 1020
ICT 160 1439 2563 2342 1043 1698 857 3067 2571 1400
NsMS 550 7019 15676 14199 6278 13044 4446 8424 20240 8768
Serv 75 1751 4564 4413 2811 2829 2029 2272 4146 6048
> CoB[1:10,1:10]
Q AFFV AH BAL Edu EMC HW ICT NsMS Serv
Q 381 189 740 518 49 1042 27 160 550 75
AFFV 91 5759 10992 6965 1791 7321 797 1439 7019 1751
AH 207 4251 32654 14457 4122 23141 1415 2563 15676 4564
BAL 207 4110 21524 24890 4088 13833 1441 2342 14199 4413
Edu 53 2079 11778 7613 5417 6155 989 1043 6278 2811
EMC 245 3026 16614 10090 2610 31793 991 1698 13044 2829
HW 14 1453 8364 5082 2055 4571 1776 857 4446 2029
ICT 106 2557 12211 6707 2207 7812 708 3067 8424 2272
NsMS 195 4325 21269 12837 3296 17123 1201 2571 20240 4146
Serv 45 2452 12013 8238 2822 6656 1020 1400 8768 6048
bins = (b1,b2, …, bk)
code(w) = i iff w in [ bi, b<i+1> )
> recodecol2bins <- function(MN,col1,col2,bins=c(0,0,Inf)){
+ info <- MN$info; MNr <- MN$links
+ w <- MNr[[col1]]; w1 <- rep(0,length(w))
+ for(i in 1:length(w)){
+ j <- 0
+ while(w[i]>=bins[j+1]) j <- j+1
+ w1[i] <- j
+ }
+ MNr[[col2]] <- as.integer(w1)
+ event <- list(op="recodecol2bins",cols=c(col1,col2),
+ bins=bins,date=date())
+ info$trace[[length(info$trace)+1]] <- event
+ return(list(format="MWnets",info=info,ways=MN$ways,
+ nodes=MN$nodes,links=MNr))
+ }
> Mc <- recodecol2bins(MN,"w","code",bins=c(1,5,10,20,Inf))
> str(Mc)
List of 5
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 1
.. ..$ :List of 4
.. .. ..$ op : chr "recodecol2bins"
.. .. ..$ cols: chr [1:2] "w" "code"
.. .. ..$ bins: num [1:5] 1 5 10 20 Inf
.. .. ..$ date: chr "Tue Nov 22 03:12:52 2022"
$ ways :List of 4
..$ prov: chr "province"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ prov:'data.frame': 107 obs. of 8 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 37205 obs. of 6 variables:
..$ prov: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ univ: int [1:37205] 1 1 1 1 2 3 4 5 5 5 ...
..$ prog: int [1:37205] 4 5 9 11 4 3 9 3 5 9 ...
..$ year: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:37205] 4 1 1 1 11 1 1 1 1 1 ...
..$ code: int [1:37205] 1 1 1 1 3 1 1 1 1 1 ...
> table(Mc$links$code)
1 2 3 4
28998 4457 2323 1427
Additional data about regions at http://www.statoids.com/uit.html
What to do? Add an additional main field data and
MN$data$regs ← data.frame(ID=ID,long=long, … )
Ordered ID !!!
> R <- MN$nodes$prov$region
> r <- factor(R)
> long <- levels(r)
> long
[1] "Abruzzo" "Aosta Valley" "Apulia"
[4] "Basilicata" "Calabria" "Campania"
[7] "Emilia-Romagna" "Friuli-Venezia Giulia" "Lazio"
[10] "Liguria" "Lombardy" "Marche"
[13] "Molise" "Piedmont" "Sardinia"
[16] "Sicily" "Trentino-South Tyrol" "Tuscany"
[19] "Umbria" "Veneto"
> ID <- c( "ABR", "VAL", "PUG", "BAS", "CAL", "CAM", "EMI", "FRI", "LAZ", "LIG",
+ "LOM", "MAR", "MOL", "PIE", "SAR", "SIC", "TRE", "TOS", "UMB", "VEN")
> MN$data$regs <- data.frame(ID=ID,long=long)[order(ID),]
> names(ID) <- long
> ID
Abruzzo Aosta Valley Apulia Basilicata
"ABR" "VAL" "PUG" "BAS"
Calabria Campania Emilia-Romagna Friuli-Venezia Giulia
"CAL" "CAM" "EMI" "FRI"
Lazio Liguria Lombardy Marche
"LAZ" "LIG" "LOM" "MAR"
Molise Piedmont Sardinia Sicily
"MOL" "PIE" "SAR" "SIC"
Trentino-South Tyrol Tuscany Umbria Veneto
"TRE" "TOS" "UMB" "VEN"
> C <- ID[R]
> head(C)
Sicily Piedmont Marche Aosta Valley Marche Abruzzo
"SIC" "PIE" "MAR" "VAL" "MAR" "ABR"
> as.vector(C)
[1] "SIC" "PIE" "MAR" "VAL" "MAR" "ABR" "TOS" "PIE" "CAM" "PUG" "LOM" "PIE" "VEN" "CAM"
[15] "EMI" "PUG" "LOM" "PUG" "TRE" "SAR" "MOL" "CAM" "ABR" "SIC" "PIE" "LOM" "LOM" "CAL"
[29] "SIC" "CAL" "SIC" "EMI" "EMI" "PUG" "TOS" "MAR" "LAZ" "LIG" "FRI" "TOS" "LIG" "MOL"
[43] "CAL" "LOM" "PUG" "TOS" "LOM" "LAZ" "TOS" "LOM" "MAR" "SIC" "LOM" "LOM" "EMI" "TOS"
[57] "BAS" "PIE" "CAM" "SAR" "SAR" "SIC" "EMI" "VEN" "ABR" "UMB" "TOS" "FRI" "TOS" "EMI"
[71] "TOS" "MAR" "LOM" "BAS" "EMI" "CAL" "EMI" "SIC" "LAZ" "LAZ" "EMI" "VEN" "CAM" "TOS"
[85] "LOM" "LIG" "SIC" "SAR" "SAR" "LIG" "PUG" "ABR" "TRE" "PIE" "SIC" "UMB" "FRI" "VEN"
[99] "FRI" "LOM" "PIE" "PIE" "VEN" "VEN" "VEN" "LAZ" "CAL"
> Mt <- MN$nodes$prov
> Mt$IDreg <- as.vector(C)
> str(Mt)
'data.frame': 107 obs. of 9 variables:
$ ID : chr "AG" "AL" "AN" "AO" ...
$ type : chr "F" "O" "O" "D" ...
$ province : chr "Agrigento" "Alessandria" "Ancona" "Aosta" ...
$ capital : chr "Agrigento" "Alessandria" "Ancona" "Aosta" ...
$ region : chr "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
$ macreg : chr "Insular" "North-West" "Centre" "North-West" ...
$ population: int 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
$ area : num 3053 3559 1963 3261 1228 ...
$ IDreg : chr "SIC" "PIE" "MAR" "VAL" ...
> Mt <- Mt[c(1:5, 9, 6:8)]
> MN$nodes$prov <- Mt
> str(MN)
List of 6
$ format: chr "MWnets"
$ info :List of 5
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
$ ways :List of 4
..$ prov: chr "province"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ prov:'data.frame': 107 obs. of 9 variables:
.. ..$ ID : chr [1:107] "AG" "AL" "AN" "AO" ...
.. ..$ type : chr [1:107] "F" "O" "O" "D" ...
.. ..$ province : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ capital : chr [1:107] "Agrigento" "Alessandria" "Ancona" "Aosta" ...
.. ..$ region : chr [1:107] "Sicily" "Piedmont" "Marche" "Aosta Valley" ...
.. ..$ IDreg : chr [1:107] "SIC" "PIE" "MAR" "VAL" ...
.. ..$ macreg : chr [1:107] "Insular" "North-West" "Centre" "North-West" ...
.. ..$ population: int [1:107] 416181 409392 464419 124089 203425 290811 336501 209390 402929 1230158 ...
.. ..$ area : num [1:107] 3053 3559 1963 3261 1228 ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" "Business, administration and law" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 37205 obs. of 5 variables:
..$ prov: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ univ: int [1:37205] 1 1 1 1 2 3 4 5 5 5 ...
..$ prog: int [1:37205] 4 5 9 11 4 3 9 3 5 9 ...
..$ year: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:37205] 4 1 1 1 11 1 1 1 1 1 ...
$ data :List of 1
..$ regs:'data.frame': 20 obs. of 2 variables:
.. ..$ ID : chr [1:20] "ABR" "BAS" "CAL" "CAM" ...
.. ..$ long: chr [1:20] "Abruzzo" "Basilicata" "Calabria" "Campania" ...
> write(toJSON(MN),"students.json")
way1 = province, part = IDreg, way2 = region
> recodeway2part <- function(MN,way1,part,way2,desc){
+ info <- MN$info; Mt <- MN$links; W <- Mt[[way1]]
+ R <- MN$nodes$prov[[part]]; r <- factor(R)
+ C <- r[W]; Mt[[way1]] <- as.integer(C)
+ N <- names(Mt); N[which(N==way1)] <- way2; names(Mt) <- N
+ Mw <- MN$ways; Mw[[way1]] <- desc
+ N <- names(Mw); N[which(N==way1)] <- way2; names(Mw) <- N
+ Mn <- MN$nodes; Md <- MN$data
+ if(way2 %in% names(Md)){
+ Mn[[way1]] <- Md[[way2]]
+ Md <- Md[-which(names(Md)==way2)]
+ } else {
+ Mn[[way1]] <- data.frame(ID=levels(r))
+ }
+ N <- names(Mn); N[which(N==way1)] <- way2; names(Mn) <- N
+ event <- list(op="recodeway2part",pars=c(way1,part,way2),desc=desc,date=date())
+ info$trace[[length(info$trace)+1]] <- event
+ return(list(format="MWnets",info=info,ways=Mw,nodes=Mn,links=Mt,data=Md))
+ }
> Mr <- recodeway2part(MN,"prov","IDreg","regs","region")
> str(Mr)
List of 6
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 1
.. ..$ :List of 4
.. .. ..$ op : chr "recodeway2part"
.. .. ..$ pars: chr [1:3] "prov" "IDreg" "regs"
.. .. ..$ desc: chr "region"
.. .. ..$ date: chr "Tue Nov 22 23:54:43 2022"
$ ways :List of 4
..$ regs: chr "region"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ regs:'data.frame': 20 obs. of 2 variables:
.. ..$ ID : chr [1:20] "ABR" "BAS" "CAL" "CAM" ...
.. ..$ long: chr [1:20] "Abruzzo" "Basilicata" "Calabria" "Campania" ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" "Business, administration and law" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 37205 obs. of 5 variables:
..$ regs: int [1:37205] 15 15 15 15 15 15 15 15 15 15 ...
..$ univ: int [1:37205] 1 1 1 1 2 3 4 5 5 5 ...
..$ prog: int [1:37205] 4 5 9 11 4 3 9 3 5 9 ...
..$ year: int [1:37205] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:37205] 4 1 1 1 11 1 1 1 1 1 ...
$ data : Named list()
Note, the new column is not reduced (duplicates). We have to apply flatten.
> Mre <- flatten(Mr,"w",c("regs","univ","prog","year"))
> str(Mre)
List of 6
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 2
.. ..$ :List of 4
.. .. ..$ op : chr "recodeway2part"
.. .. ..$ pars: chr [1:3] "prov" "IDreg" "regs"
.. .. ..$ desc: chr "region"
.. .. ..$ date: chr "Tue Nov 22 23:54:43 2022"
.. ..$ :List of 4
.. .. ..$ op : chr "flatten"
.. .. ..$ par : chr [1:5] "regs" "univ" "prog" "year" ...
.. .. ..$ FUN : chr "sum"
.. .. ..$ date: chr "Wed Nov 23 00:26:50 2022"
$ ways :List of 4
..$ regs: chr "region"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ regs:'data.frame': 20 obs. of 2 variables:
.. ..$ ID : chr [1:20] "ABR" "BAS" "CAL" "CAM" ...
.. ..$ long: chr [1:20] "Abruzzo" "Basilicata" "Calabria" "Campania" ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" "Business, administration and law" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 15209 obs. of 5 variables:
..$ regs: int [1:15209] 3 5 7 9 12 13 15 16 18 3 ...
..$ univ: int [1:15209] 9 9 9 9 9 9 9 9 9 35 ...
..$ prog: int [1:15209] 1 1 1 1 1 1 1 1 1 1 ...
..$ year: int [1:15209] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:15209] 2 3 1 1 1 4 2 1 1 1 ...
$ data : Named list()
Or using magrittr
> library(magrittr)
> MN %>%
+ recodeway2part("prov","IDreg","regs","region") %>%
+ flatten("w",c("regs","univ","prog","year")) %T>%
+ str() ->
+ Mrw
List of 6
$ format: chr "MWnets"
$ info :List of 6
..$ network: chr "students"
..$ title : chr "Student mobility data in Italian universities 2008, 2011, 2014, 2017"
..$ by : chr [1:4] "VG Genova" "G Giordano" "G Ragozini" "MP Vitale"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 6 22:31:11 2022"
..$ trace :List of 2
.. ..$ :List of 4
.. .. ..$ op : chr "recodeway2part"
.. .. ..$ pars: chr [1:3] "prov" "IDreg" "regs"
.. .. ..$ desc: chr "region"
.. .. ..$ date: chr "Wed Nov 23 02:26:44 2022"
.. ..$ :List of 4
.. .. ..$ op : chr "flatten"
.. .. ..$ par : chr [1:5] "regs" "univ" "prog" "year" ...
.. .. ..$ FUN : chr "sum"
.. .. ..$ date: chr "Wed Nov 23 02:26:45 2022"
$ ways :List of 4
..$ regs: chr "region"
..$ univ: chr "university"
..$ prog: chr "programme"
..$ year: chr "year"
$ nodes :List of 4
..$ regs:'data.frame': 20 obs. of 2 variables:
.. ..$ ID : chr [1:20] "ABR" "BAS" "CAL" "CAM" ...
.. ..$ long: chr [1:20] "Abruzzo" "Basilicata" "Calabria" "Campania" ...
..$ univ:'data.frame': 79 obs. of 2 variables:
.. ..$ ID : chr [1:79] "Bicocca" "Bocconi" "Foscari" "Biomedico" ...
.. ..$ long: chr [1:79] "Bicocca" "Bocconi" "Cà Foscari" "Campus Biomedico" ...
..$ prog:'data.frame': 11 obs. of 2 variables:
.. ..$ ID : chr [1:11] "Q" "AFFV" "AH" "BAL" ...
.. ..$ long: chr [1:11] "?" "Agriculture, forestry, fisheries and veterinary" "Arts and humanities" "Business, administration and law" ...
..$ year:'data.frame': 4 obs. of 1 variable:
.. ..$ ID: chr [1:4] "2008" "2011" "2014" "2017"
$ links :'data.frame': 15209 obs. of 5 variables:
..$ regs: int [1:15209] 3 5 7 9 12 13 15 16 18 3 ...
..$ univ: int [1:15209] 9 9 9 9 9 9 9 9 9 35 ...
..$ prog: int [1:15209] 1 1 1 1 1 1 1 1 1 1 ...
..$ year: int [1:15209] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:15209] 2 3 1 1 1 4 2 1 1 1 ...
$ data : Named list()
The projection produces a square matrix
> matrix2net(CoU14,Net="CoU14.net")
A multiway network can be exported to Pajek as a (multirelational temporal) two-mode network on node sets u=way1 and v=way2 (and relation optional r=way3 and time instance t=way4). Additional ways are producing parallel links
mwn2net <- function(MN,way1,way2,r=NULL,t=NULL,w=NULL,Net="Pajek.net",encoding="UTF-8"){
N <- MN$nodes; L <- MN$links; R <- NULL; T <- NULL
U <- N[[way1]]$ID[L[[way1]]]; V <- N[[way2]]$ID[L[[way2]]]
if(is.null(w)) W <- rep(1,length(L[[u]])) else W <- L[[w]]
if(!is.null(r)) R <- N[[r]]$ID[L[[r]]]
if(!is.null(t)) T <- N[[t]]$ID[L[[t]]]
uvrwt2net(U,V,w=W,r=R,t=T,Net=Net,twomode=TRUE,encoding=encoding)
}
> mwn2net(S2014,"prov","univ",r="prog",w="w",Net="S2014.net")
We can also export the node partition way$part as a Pajek clustering file.
> mwn2clu <- function(MN,way,part,Clu="Pajek.clu",encoding="UTF-8"){
+ C <- MN$nodes[[way]][[part]]; n <- length(C); clu <- file(Clu,"w")
+ p <- factor(C); L <- levels(p)
+ cat("% mwn2clu",date(),"\n% Categories:\n",file=clu)
+ for(i in 1:length(L)) cat('% ',i,' "',L[i],'"\n',sep="",file=clu)
+ cat("*vertices",n,"\n",file=clu)
+ cat(as.integer(p),sep="\n",file=clu)
+ close(clu)
+ }
> mwn2clu(S2014,"prov","IDreg",Clu="regions.clu")
and the node property way$prop as a Pajek vector file if the property is numerical; otherwise it is exported as a numbered list.
>
> mwn2vec <- function(MN,way,prop,Vec="Pajek.vec",encoding="UTF-8"){
+ V <- MN$nodes[[way]][[prop]]; n <- length(V); vec <- file(Vec,"w")
+ cat("% mwn2vec",date(),"\n*vertices",n,"\n",file=vec)
+ if(is.numeric(V)) cat(V,sep="\n",file=vec) else
+ for(i in 1:n) cat(i,' "',V[i],'"\n',sep='',file=vec)
+ close(vec)
+ }
> mwn2vec(S2014,"prov","area",Vec="area.vec")
> mwn2vec(S2014,"prov","capital",Vec="capital.vec")
The functions mwn2net, mwn2clu and mwn2vec are available in the library MWnets.
Provinces on the map of Italy.