February 12, 2023
> wdir <- "C:/Users/vlado/DL/data/multi/cores/air"
> setwd(wdir)
> library(jsonlite)
> library(Polychrome)
> source("https://raw.githubusercontent.com/bavla/Rnet/master/R/Pajek.R")
> source("https://raw.githubusercontent.com/bavla/ibm3m/master/multiway/MWnets.R")
> MN <- fromJSON("https://raw.githubusercontent.com/bavla/ibm3m/master/data/AirEu2013Ext.json")
> N <- gsub("Air Base","AB",gsub("National A","NA",gsub("International A","IA",
+ gsub("Airport","A",MN$nodes$airA$long))))
> MN$nodes$airA$long <- MN$nodes$airB$long <- N
> str(MN)
> cw <- c("airA","airB")
> ci <- unname(sapply(cw,\(x) which(names(MN$ways)==x)))
> pDIV <- function(MN,v,cip,C,...) pDiv(MN,v,cip,C,way="line")
> P <- list(
+ p1 = list(
+ p = pDIV, t = 10,
+ cwp = c("airA","airB"),
+ cip = NULL),
+ p2 = list(
+ p = pDIV, t = 10,
+ cwp = c("airB","airA"),
+ cip = NULL),
+ cways = list(cw=cw,ci=ci)
+ )
> for(i in 1:(length(P)-1)) P[[i]]$cip <- unname(sapply(P[[i]]$cwp,\(x) which(cw==x)))
> str(P)
> C <- lapply(cw, \(x) 1:nrow(MN$nodes[[x]])); names(C) <- cw
> listCore(MN,C,P)
> CC <- MWcore(MN,P,trace=TRUE)
> listCore(MN,CC,P)
1 airA : 10 450 1 2
LEBL LIRF LIMC LEMD EHAM LFPG LIPZ EBBR LGAV EDDF LOWW LFMN EDDH EDDL EPWA EDDM EKCH LSZH LHBP LROP
29 26 26 24 23 23 22 22 22 22 21 20 20 20 20 20 20 19 18 18
LKPR LSGG LEMG EGLL EDDT ESSA LLBG LPPT EDDS EFHK ENGM LBSF EGCC ESGG LFBO LIML LFLL LEPA LTBA LIPE
18 17 17 17 17 17 16 15 15 15 15 14 14 13 13 12 12 12 12 12
LIRN LEVC LYBE LGTS LFML EDDV EIDW LFBD EGBB
11 11 11 11 11 11 10 10 10
2 airB : 10 450 2 1
LEBL LIRF LIMC LEMD EHAM LFPG LIPZ EBBR LGAV EDDF LOWW LFMN EDDH EDDL EPWA EDDM EKCH LSZH LHBP LROP
29 26 26 24 23 23 22 22 22 22 21 20 20 20 20 20 20 19 18 18
LKPR LSGG LEMG EGLL EDDT ESSA LLBG LPPT EDDS EFHK ENGM LBSF EGCC ESGG LFBO LIML LFLL LEPA LTBA LIPE
18 17 17 17 17 17 16 15 15 15 15 14 14 13 13 12 12 12 12 12
LIRN LEVC LYBE LGTS LFML EDDV EIDW LFBD EGBB
11 11 11 11 11 11 10 10 10
> P[[1]]$t <- 13; P[[2]]$t <- 13
> CC <- MWcore(MN,P,trace=TRUE)
1 airA 1 : 1 2 / 13
1 4 5 6 9 10 11 12 13 16 17 18 19 21 23 25 29 30 32 33 35 36 37 39 43 44 45 46 47 49 51 52 53 54 56 60
...
426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
2 airB 2 : 2 1 / 13
1 3 4 5 6 9 10 11 12 13 16 17 18 19 21 23 24 25 29 30 32 33 35 36 37 39 43 44 45 46 47 49 51 52 53 54 56
...
426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
1 airA 1 : 1 2 / 13
3 8 20 24 57 58 59 61 65 80 108 122 164 211 215 225 244
2 airB 2 : 2 1 / 13
8 20 31 61 122 215 244
1 airA 1 : 1 2 / 13
31 77
2 airB 2 : 2 1 / 13
77
1 airA 1 : 1 2 / 13
2 airB 2 : 2 1 / 13
> listCore(MN,CC,P)
1 airA : 13 450 1 2
LEBL LIRF LIMC LGAV LIPZ LEMD EHAM LFPG EKCH EBBR EDDF LFMN EDDL EDDT LOWW LROP EPWA LLBG EDDM LKPR
23 21 20 20 19 18 18 18 17 17 17 16 15 15 15 15 15 15 15 15
LSZH LHBP ESSA EDDH LBSF LSGG LEMG EGLL
14 14 14 13 13 13 13 13
2 airB : 13 450 2 1
LEBL LIRF LIMC LGAV LIPZ LEMD EHAM LFPG EKCH EBBR EDDF LFMN EDDL EDDT LOWW LROP EPWA LLBG EDDM LKPR
23 21 20 20 19 18 18 18 17 17 17 16 15 15 15 15 15 15 15 15
LSZH LHBP ESSA EDDH LBSF LSGG LEMG EGLL
14 14 14 13 13 13 13 13
> Ap <- MN$nodes$airA$long[CC[[1]]]
> w1 <- CC$airA; w2 <- CC$airB
> Score <- extract(MN,c("airA","airB"),c("w1","w2"))
> act <- as.integer(names(table(Score$links$line)))
> Rcore <- extract(Score,"line","act")
> str(Rcore)
List of 6
$ format: chr "MWnets"
$ info :List of 8
..$ network: chr "AirEu2013"
..$ title : chr "Air Transportation Multiplex"
..$ by : chr "Cardillo A. et al."
..$ ref : chr "Cardillo A. et al. Emergence of network features from multiplexity, Scientific Reports 3, 1344 (2013)"
..$ href : chr "http://complex.unizar.es/~atnmultiplex/"
..$ creator: chr "V. Batagelj"
..$ date : chr "Sun Nov 27 16:47:26 2022"
..$ trace :List of 2
.. ..$ :List of 3
.. .. ..$ op : chr "extract"
.. .. ..$ P : chr "airA/w1,airB/w2"
.. .. ..$ date: chr "Fri Feb 17 17:24:37 2023"
.. ..$ :List of 3
.. .. ..$ op : chr "extract"
.. .. ..$ P : chr "line/act"
.. .. ..$ date: chr "Fri Feb 17 17:25:26 2023"
$ ways :List of 3
..$ airA: chr "first airport"
..$ airB: chr "second airport"
..$ line: chr "airline"
$ nodes :List of 3
..$ airA:'data.frame': 28 obs. of 7 variables:
.. ..$ ID : chr [1:28] "EDDF" "LFPG" "LGAV" "EHAM" ...
.. ..$ lon : num [1:28] 8.57 2.55 23.94 4.76 4.48 ...
.. ..$ lat : num [1:28] 50 49 37.9 52.3 50.9 ...
.. ..$ iata : chr [1:28] "FRA" "CDG" "ATH" "AMS" ...
.. ..$ long : chr [1:28] "Frankfurt Airport" "Charles de Gaulle Airport (Roissy Airport)" ...
.. ..$ region : chr [1:28] "Hessen" "Ile-de-France" "Attiki" "Noord-Holland" ...
.. ..$ country: chr [1:28] "DE" "FR" "GR" "NL" ...
..$ airB:'data.frame': 28 obs. of 2 variables:
.. ..$ ID : chr [1:28] "EDDF" "LFPG" "LGAV" "EHAM" ...
.. ..$ long: chr [1:28] "Frankfurt Airport" "Charles de Gaulle Airport (Roissy Airport)" ...
..$ line:'data.frame': 27 obs. of 1 variable:
.. ..$ ID: chr [1:27] "Lufthansa" "Ryanair" "Easyjet" "British A" ...
$ links :'data.frame': 1098 obs. of 4 variables:
..$ airA: int [1:1098] 1 1 1 1 1 1 1 1 1 1 ...
..$ airB: int [1:1098] 2 3 4 5 6 7 8 9 10 11 ...
..$ line: int [1:1098] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:1098] 1 1 1 1 1 1 1 1 1 1 ...
$ data :List of 1
..$ Eu:'data.frame': 40 obs. of 6 variables:
.. ..$ alpha2 : chr [1:40] "AT" "BA" "BE" "BG" ...
.. ..$ alpha3 : chr [1:40] "AUT" "BIH" "BEL" "BGR" ...
.. ..$ Ccode : int [1:40] 40 70 56 100 756 196 203 276 208 233 ...
.. ..$ long : chr [1:40] "Austria" "Bosnia and Herzegovina" "Belgium" "Bulgaria" ...
.. ..$ region : chr [1:40] "Europe" "Europe" "Europe" "Europe" ...
.. ..$ subregion: chr [1:40] "Western Europe" "Southern Europe" "Western Europe" "Eastern Europe" ...
> c27 <- glasbey.colors(27); CC <- col2rgb(c27)/255
> Col <- cbind(CC[1,Rcore$links$line],CC[2,Rcore$links$line],CC[3,Rcore$links$line])
> ts <- c(1,20,10,26,27,19,24,9,7,8,21,13,18,4,2,15,11,23,6,22,5,16,3,12,14,17,25,28)
> t <- inv(ts)
> qs <- c(1,5,10,19,3,7,12,4,16,13,21,8,20,6,11,18,17,2,23,9,15,24,25,14,22,27,26)
> qq <- inv(qs)
> mwnX3D(Rcore,"airA","airB","line","w",pu=t,pv=t,pz=qq,lu="long",lv="long",maxsize=0.85,col=Col,file="EuAirCore13.x3d")
> percents(MN,Rcore,"airA","airB","line","w")
weights: 1098 / 7176 = 0.15301
links: 1098 / 7176 = 0.15301
space: ( 28 * 28 * 27 )/( 450 * 450 * 37 ) = 0.002825225