Summer Olympics 2016 relational core

Summer Olympics medalists

> MT <- fromJSON("Olympics16s.json")
> n1 <- nrow(MT$nodes$Games); n2 <- nrow(MT$nodes$NOC); 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","NOC",way3="Sport"))
> F21 <- sapply(1:n2,function(v) pRel(MT,v,C1,"NOC","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  3  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  3  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","NOC",PRel,PRel,22,22)
> Rcore
$core1
 [1]  5  7 11 19 20 21 22 23 24 25 26 27 28 29

$core2
 [1]   7  21  23  38  44  47  50  68  71 111 122 138 140

> Coli <- Rcore$core1; Cntr <- Rcore$core2
> FCp <- sapply(Coli,function(u) pRel(MT,u,Cntr,"Games","NOC",way3="Sport"))
> names(FCp) <- MT$nodes$Games$ID[Coli]
> rev(sort(FCp))
2016 Summer 2008 Summer 2004 Summer 2000 Summer 2012 Summer 1996 Summer 1992 Summer 1988 Summer 
         34          34          34          34          32          31          29          27 
1984 Summer 1920 Summer 1908 Summer 1980 Summer 1976 Summer 1936 Summer 
         25          25          24          23          23          22 
> FCl <- sapply(Cntr,function(u) pRel(MT,u,Coli,"NOC","Games",way3="Sport"))
> names(FCl) <- MT$nodes$NOC$ID[Cntr]
> rev(sort(FCl))
USA GBR CHN GER ESP RUS FRA CAN ITA AUS URS SWE JPN 
 36  36  31  29  28  27  26  26  25  25  24  24  23 

> MTcore <- extract(MT,c("Games","NOC"),c("Coli","Cntr")) 
> str(MTcore)
List of 6
 $ format: chr "MWnets"
 $ info  :List of 5
  ..$ network: chr "Olympic16S"
  ..$ title  : chr "Summer Olympic medals till 2016"
  ..$ by     : chr "DF2MWN"
  ..$ date   : chr "Mon Feb  6 01:23:56 2023"
  ..$ trace  :List of 1
  .. ..$ :List of 3
  .. .. ..$ op  : chr "extract"
  .. .. ..$ P   : chr "Games/Coli,NOC/Cntr"
  .. .. ..$ date: chr "Mon Feb  6 01:58:22 2023"
 $ ways  :List of 5
  ..$ Games: chr "Games"
  ..$ NOC  : chr "NOC"
  ..$ Sport: chr "Sport"
  ..$ Sex  : chr "Sex"
  ..$ Medal: chr "Medal"
 $ nodes :List of 5
  ..$ Games:'data.frame':       14 obs. of  1 variable:
  .. ..$ ID: chr [1:14] "1908 Summer" "1920 Summer" "1936 Summer" "1976 Summer" ...
  ..$ NOC  :'data.frame':       13 obs. of  1 variable:
  .. ..$ ID: chr [1:13] "AUS" "CAN" "CHN" "ESP" ...
  ..$ Sport:'data.frame':       52 obs. of  1 variable:
  .. ..$ ID: chr [1:52] "Aeronautics" "Alpinism" "Archery" "Art Competitions" ...
  ..$ Sex  :'data.frame':       2 obs. of  1 variable:
  .. ..$ ID: chr [1:2] "F" "M"
  ..$ Medal:'data.frame':       3 obs. of  1 variable:
  .. ..$ ID: chr [1:3] "Bronze" "Silver" "Gold"
 $ links :'data.frame': 3560 obs. of  9 variables:
  ..$ Games : int [1:3560] 12 1 11 10 13 4 7 6 8 11 ...
  ..$ NOC   : int [1:3560] 5 6 6 7 9 12 13 1 1 1 ...
  ..$ Sport : int [1:3560] 3 3 3 3 3 3 3 5 5 5 ...
  ..$ Sex   : int [1:3560] 1 1 1 1 1 1 1 1 1 1 ...
  ..$ Medal : num [1:3560] 1 1 1 1 1 1 1 1 1 1 ...
  ..$ w     : num [1:3560] 3 1 1 3 3 1 3 1 1 1 ...
  ..$ Age   : int [1:3560] 86 40 32 99 67 21 69 27 27 29 ...
  ..$ Height: int [1:3560] 492 NA 170 509 500 156 490 175 182 164 ...
  ..$ Weight: num [1:3560] 189 NA 73 203 180 52 173 98 84 52 ...
 $ data  : list()
> CC <- col2rgb(createPalette(34,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","NOC","Sport","w",maxsize=0.95,col=Col,file="Olympics16CoreR.x3d")
> Cov <- projection(MTcore3,"NOC","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.6,main="Olympics relational core - sports / Ward") 
> J <- inv(tv$order); K <- inv(tz$order) 
> mwnX3D(MTcore3,"Games","NOC","Sport","w",pv=J,pz=K,maxsize=0.95,col=Col,file="Olympics16CoreClusR.x3d")

Olympics relational core This is a 3D layout using X3DOM.
Use the mouse to navigate the space - rotate, ctrl+mouse to move, mouse wheel to zoom in/out, ...

Click a link (cube) for its identification (Olympics, Country, Discipline)!

> sum(MT$links$w)
[1] 34088
> sum(MTcore3$links$w)
[1] 12649
> sum(MTcore3$links$w)/sum(MT$links$w)
[1] 0.371069
> x1 <- length(MT$nodes$Games$ID); x2 <- length(MTcore3$nodes$Games$ID)
> y1 <- length(MT$nodes$NOC$ID); y2 <- length(MTcore3$nodes$NOC$ID)
> z1 <- length(MT$nodes$Sport$ID); z2 <- length(MTcore3$nodes$Sport$ID)
> cat(x1,y1,z1,x2,y2,z2,"\n")
29 147 52 14 13 34 
> (x2*y2*z2)/(x1*y1*z1)
[1] 0.02791461

Summer Olympics 2016 sum core Core cluster