> MT <- fromJSON("Olympics20s.json")
> n1 <- nrow(MT$nodes$Games); n2 <- nrow(MT$nodes$Team); n3 <- nrow(MT$nodes$Sport)
> C1 <- 1:n1; C2 <- 1:n2; C3 <- 1:n3
> F12 <- sapply(1:n1,function(u) pRel(MT,u,C2,"Games","Team",way3="Sport"))
> F21 <- sapply(1:n2,function(v) pRel(MT,v,C1,"Team","Games",way3="Sport"))
> table(F12)
F12
9 13 17 18 19 20 21 23 24 25 27 29 31 32 34
1 1 2 2 3 4 1 4 2 2 1 1 1 1 4
> table(F12)
F12
9 13 17 18 19 20 21 23 24 25 27 29 31 32 34
1 1 2 2 3 4 1 4 2 2 1 1 1 1 4
> PRel <- function(MN,u,C,way1,way2,...) pRel(MN,u,C,way1,way2,way3="Sport",...)
> Rcore <- Gen2modeCore(MT,"Games","Team",PRel,PRel,20,20)
> Rcore
$core1
[1] 7 8 11 12 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
$core2
[1] 19 34 54 67 77 103 147 163 168 196 213 216 299 337 362 398 401 402 416 422 448 449 453
[24] 477
> Coli <- Rcore$core1; Cntr <- Rcore$core2
> FCp <- sapply(Coli,function(u) pRel(MT,u,Cntr,"Games","Team",way3="Sport"))
> names(FCp) <- MT$nodes$Games$ID[Coli]
> rev(sort(FCp))
2004 Summer 2016 Summer 2008 Summer 2000 Summer 2012 Summer 1996 Summer 1992 Summer 1988 Summer
34 33 33 33 31 30 29 27
1984 Summer 1920 Summer 2020 Summer 1980 Summer 1976 Summer 1936 Summer 1972 Summer 1964 Summer
25 24 23 23 23 23 22 21
1968 Summer 1948 Summer 1924 Summer
20 20 20
> FCl <- sapply(Cntr,function(u) pRel(MT,u,Coli,"Team","Games",way3="Sport"))
> names(FCl) <- MT$nodes$Team$ID[Cntr]
> rev(sort(FCl))
Great Britain United States France Spain Japan Italy Germany
40 34 34 31 31 31 31
Australia Netherlands China Sweden Canada Russia Ukraine
31 29 29 27 27 26 25
Poland Soviet Union Brazil Belgium Switzerland Hungary Denmark
25 24 24 24 21 21 21
West Germany Unified Team South Korea
20 20 20
> MTcore <- extract(MT,c("Games","Team"),c("Coli","Cntr"))
> str(MTcore)
> rev(sort(table(L$Sport)))
5 50 17 43 47 34 14 65 23 29 22 12 46 20 60 3 52 54 36 53 58 31 8 59
658 594 357 320 317 308 302 299 298 275 273 258 213 189 179 111 91 74 74 73 66 61 61 55
25 30 6 4 56 18 51 19 55 41 13 64 21 62 49 7 39 11 38 28 63 44 24 61
49 47 44 43 41 40 32 30 28 28 17 13 13 12 12 9 8 8 6 5 4 4 4 3
57 45 32 27 2 48 26 10 1
3 3 2 2 2 1 1 1 1
> f <- table(L$Sport)
> fc <- f[f>50]
> sel <- as.integer(names(fc))
> sel
[1] 3 5 8 12 14 17 20 22 23 29 31 34 36 43 46 47 50 52 53 54 58 59 60 65
> MTcore2 <- extract(MTcore,"Sport","sel")
> MTcore3 <- flatten(MTcore2,"w",c("Games","Team","Sport"))
> str(MTcore3)
List of 6
$ format: chr "MWnets"
$ info :List of 5
..$ network: chr "Olympic20S"
..$ title : chr "Summer Olympic medals till 2020"
..$ by : chr "DF2MWN"
..$ date : chr "Sat Feb 4 22:02:21 2023"
..$ trace :List of 3
.. ..$ :List of 3
.. .. ..$ op : chr "extract"
.. .. ..$ P : chr "Games/Coli,Team/Cntr"
.. .. ..$ date: chr "Sun Feb 5 02:48:50 2023"
.. ..$ :List of 3
.. .. ..$ op : chr "extract"
.. .. ..$ P : chr "Sport/sel"
.. .. ..$ date: chr "Sun Feb 5 03:14:33 2023"
.. ..$ :List of 4
.. .. ..$ op : chr "flatten"
.. .. ..$ par : chr [1:4] "Games" "Team" "Sport" "w"
.. .. ..$ FUN : chr "sum"
.. .. ..$ date: chr "Sun Feb 5 03:28:45 2023"
$ ways :List of 3
..$ Games: chr "Games"
..$ Team : chr "Team"
..$ Sport: chr "Sport"
$ nodes :List of 3
..$ Games:'data.frame': 19 obs. of 1 variable:
.. ..$ ID: chr [1:19] "1920 Summer" "1924 Summer" "1936 Summer" "1948 Summer" ...
..$ Team :'data.frame': 24 obs. of 1 variable:
.. ..$ ID: chr [1:24] "Australia" "Belgium" "Brazil" "Canada" ...
..$ Sport:'data.frame': 24 obs. of 1 variable:
.. ..$ ID: chr [1:24] "Archery" "Athletics" "Basketball" "Boxing" ...
$ links :'data.frame': 2687 obs. of 4 variables:
..$ Games: int [1:2687] 14 15 18 1 10 12 13 15 16 17 ...
..$ Team : int [1:2687] 1 1 1 2 5 5 5 5 5 5 ...
..$ Sport: int [1:2687] 1 1 1 1 1 1 1 1 1 1 ...
..$ w : int [1:2687] 1 1 3 45 1 3 1 3 7 4 ...
$ data : list()
> library(Polychrome)
> CC <- col2rgb(createPalette(24,c("#ff0000","#00ff00","#0000ff")))/255
> LC <- MTcore3$links
> Col <- cbind(CC[1,LC$Sport],CC[2,LC$Sport],CC[3,LC$Sport])
> mwnX3D(MTcore3,"Games","Team","Sport","w",maxsize=0.95,col=Col,file="Olympics20CoreR.x3d")
> Cov <- projection(MTcore3,"Team","w")
> Sav <- salton(Cov); Dv <- as.dist(1-Sav); Dv[is.na(Dv)] <- 1
> tv <- hclust(Dv,method="ward")
> plot(tv,hang=-1,cex=1,main="Olympics relational core - countries / Ward")
> Coz <- projection(MTcore3,"Sport","w")
> Saz <- salton(Coz); Dz <- as.dist(1-Saz); Dz[is.na(Dz)] <- 1
> tz <- hclust(Dz,method="ward")
> plot(tz,hang=-1,cex=0.9,main="Olympics relational core - sports / Ward")
> J <- inv(tv$order); K <- inv(tz$order)
> mwnX3D(MTcore3,"Games","Team","Sport","w",pv=J,pz=K,maxsize=0.95,col=Col,file="Olympics20CoreClusR.x3d")
It seems from the 3D layout that some data for the 2020 Summer are missing.