====== Olympics ======

[[..:mwcores|MW cores]]

<code>
> setwd("C:/Users/vlado/DL/data/kaggle/Olympic/2016/cores")
> 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")
> OL <- fromJSON("https://raw.githubusercontent.com/bavla/ibm3m/master/data/Olympics16S.json")
> str(OL)

> cw <- c("Games","NOC","Sport")
> ci <- unname(sapply(cw,\(x) which(names(OL$ways)==x)))
> pWSUM <- function(MN,v,cip,C,...) pWsum(MN,v,cip,C,weight="w")
> P <- list(
+   p1 = list(
+     p = pWSUM, t = 100,
+     cwp = c("Games","NOC","Sport"),
+     cip = NULL),
+   p2 = list(
+     p = pWSUM, t = 100,
+     cwp = c("NOC","Games","Sport"),
+     cip = NULL),
+   p3 = list(
+     p = pWSUM, t = 100,
+     cwp = c("Sport","Games","NOC"),
+     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(OL$nodes[[x]])); names(C) <- cw
> listCore(OL,C,P) 
> P[[1]]$t <- 400; P[[2]]$t <- 100; P[[3]]$t <- 300
> CC <- MWcore(OL,P,trace=TRUE)
> listCore(OL,CC,P) 
1 Games : 400 29 1 2 3 
2004 Summer 2008 Summer 2000 Summer 2012 Summer 1996 Summer 1992 Summer 2016 Summer 1988 Summer 
       1611        1608        1575        1530        1498        1496        1495        1481 
1984 Summer 1980 Summer 1976 Summer 1972 Summer 1920 Summer 1968 Summer 1964 Summer 1912 Summer 
       1414        1325        1294        1170        1159        1016         992         870 
1960 Summer 1952 Summer 1956 Summer 1936 Summer 1948 Summer 1924 Summer 1908 Summer 1928 Summer 
        869         846         843         832         775         694         672         661 
1932 Summer 1900 Summer 1906 Summer 
        608         462         416 
2 NOC : 100 147 2 1 3 
 USA  URS  GBR  GER  FRA  ITA  AUS  HUN  SWE  NED  GDR  RUS  JPN  CHN  ROU  CAN  NOR  DEN  POL  FRG 
4325 2034 1696 1632 1472 1401 1203 1070 1035  896  843  780  732  681  632  617  580  559  524  500 
 KOR  FIN  BRA  BEL  ESP  CUB  SUI  YUG  BUL  TCH  ARG  NZL  EUN  IND  UKR  GRE  JAM  AUT  CRO  PAK 
 464  456  446  436  419  399  385  379  317  308  257  211  211  187  179  177  157  148  130  121 
 RSA  KEN 
 107  106 
3 Sport : 300 52 3 1 2 
    Athletics      Swimming        Rowing    Gymnastics       Fencing        Hockey      Football 
         3504          2952          2842          2158          1700          1513          1366 
      Cycling       Sailing      Shooting      Canoeing      Handball     Wrestling    Basketball 
         1203          1198          1143          1070          1032          1023           974 
   Water Polo Equestrianism    Volleyball        Boxing          Judo Weightlifting        Diving 
          972           928           911           742           477           475           402 
     Baseball       Archery 
          316           311 
> P[[1]]$t <- 500; P[[2]]$t <- 300; P[[3]]$t <- 350
> CC <- MWcore(OL,P,trace=TRUE)
1 Games 1 : 1 2 3 / 500 
 1 3 4 
2 NOC 2 : 2 1 3 / 300 
 1 2 3 4 5 6 8 9 10 11 12 14 15 16 17 19 22 24 25 26 27 28 30 31 33 34 35 36 37 39 40 41 42 46 49 51 52 53
...
118 120 121 123 124 126 127 128 129 130 131 132 133 134 135 136 137 139 141 142 143 144 146 147 
3 Sport 3 : 3 1 2 / 350 
 1 2 3 4 6 7 9 10 13 14 19 21 25 26 28 29 30 31 32 33 34 36 37 40 42 43 44 45 46 47 48 
1 Games 1 : 1 2 3 / 500 
 2 
2 NOC 2 : 2 1 3 / 300 
 29 
3 Sport 3 : 3 1 2 / 350 
 
1 Games 1 : 1 2 3 / 500 
 
2 NOC 2 : 2 1 3 / 300 
 
3 Sport 3 : 3 1 2 / 350 
 
> str(CC)
List of 3
 $ Games: int [1:25] 5 6 7 8 9 10 11 12 13 14 ...
 $ NOC  : int [1:29] 7 13 18 20 21 23 32 38 43 44 ...
 $ Sport: int [1:21] 5 8 11 12 15 16 17 18 20 22 ... 
> listCore(OL,CC,P) 
1 Games : 500 29 1 2 3 
1988 Summer 1984 Summer 2008 Summer 2012 Summer 2000 Summer 2016 Summer 2004 Summer 1980 Summer 
       1405        1354        1352        1338        1324        1320        1305        1270 
1996 Summer 1976 Summer 1992 Summer 1972 Summer 1920 Summer 1964 Summer 1968 Summer 1912 Summer 
       1251        1220        1112        1080        1054         952         949         853 
1960 Summer 1952 Summer 1956 Summer 1936 Summer 1948 Summer 1924 Summer 1908 Summer 1928 Summer 
        826         797         795         754         731         681         656         610 
1932 Summer 
        577 
2 NOC : 300 147 2 1 3 
 USA  URS  GBR  GER  ITA  FRA  AUS  HUN  SWE  NED  GDR  RUS  CHN  JPN  ROU  CAN  NOR  POL  DEN  FRG 
4153 2027 1594 1573 1325 1184 1165 1052 1019  854  843  776  662  661  632  613  546  520  519  500 
 FIN  BRA  ESP  YUG  SUI  KOR  BEL  BUL  TCH 
 446  446  416  379  352  347  337  317  308 
3 Sport : 350 52 3 1 2 
    Athletics      Swimming        Rowing    Gymnastics       Fencing      Football       Cycling 
         2911          2815          2535          2043          1584          1216          1129 
       Hockey      Canoeing      Shooting       Sailing     Wrestling      Handball    Basketball 
         1126          1010           995           995           941           924           914 
Equestrianism    Water Polo    Volleyball        Boxing          Judo Weightlifting        Diving 
          883           876           839           596           425           419           390 
</code>

<code>
> w1 <- CC$Games; w2 <- CC$NOC; w3 <- CC$Sport
> Rcore <- extract(OL,cw,c("w1","w2","w3"))
> c21 <- glasbey.colors(21); Co <- col2rgb(c21)/255; LS <- Rcore$links$Sport
> Col <- cbind(Co[1,LS],Co[2,LS],Co[3,LS])
> Score <- flatten(Rcore,"w",cw)
> mwnX3D(Score,"Games","NOC","Sport","w",maxsize=0.95,col=Col,file="Oly16Core.x3d")

> Cov <- projection(Score,"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=0.7,main="Olympics core - NOCs / Ward")
> Coz <- projection(Score,"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.7,main="Olympics core - sports / Ward")
> J <- inv(tv$order); K <- inv(tz$order)
> c21 <- glasbey.colors(21); Co <- col2rgb(c21)/255; LS <- Score$links$Sport
> Col <- cbind(Co[1,LS],Co[2,LS],Co[3,LS]) 
> mwnX3D(Score,"Games","NOC","Sport","w",maxsize=0.95,pv=J,pz=K,col=Col,file="Oly16CoreClu.x3d")
</code>

<html>

<head>
  <meta http-equiv="X-UA-Compatible" content="IE=edge" />
  <meta http-equiv="Content-Security-Policy" content="default-src 'self' https://*;">
  <title>European Airports core</title>
  <script type='text/javascript' src='https://www.x3dom.org/download/dev/x3dom.debug.js'> </script>
  <link rel='stylesheet' type='text/css' href='https://www.x3dom.org/download/x3dom.css'>
  </link>
</head>
<body>
  <b>This is a 3D layout using <a href="https://www.x3dom.org/">X3DOM</a>.<br> 
    Use the mouse to navigate the space - rotate, ctrl+mouse to move, mouse wheel to zoom in/out, ...</b>
  <p id='message'>
    <b style="color:red;">Click a link (cube) for its identification (olympics, NOC, sport)!</b>
  </p>
   <X3D version='3.0' profile='Immersive' xmlns:xsd='http://www.w3.org/2001/XMLSchema-instance'
      xsd:noNamespaceSchemaLocation='http://www.web3d.org/specifications/x3d-3.0.xsd'
      width='1200px' height='750px'>
     <Scene>
       <Inline url='https://raw.githubusercontent.com/bavla/ibm3m/master/multiway/X3D/Oly16CoreClu.x3d' 
         namespacename='Oly16CoreClu'></Inline>
     <Scene>
   </X3D>
</body>
<script>
document.onload = function () {
  function loadHandler() {
    function clickHandler(e) {
      var hitShape = e.target; // always the Shape clicked
      var anchor = hitShape.parentElement.parentElement; //grandparent is Anchor
      var description = anchor.getAttribute('description');
      var msgArea = document.getElementById('message');
      //console.log(hitShape, description);
      msgArea.textContent = "Clicked link description: " + description;
    };
    console.log("HERE");
    var anchors = document.querySelectorAll('Anchor');
    anchors.forEach(function(anchor) {
      //anchor.setAttribute("onclick", "clickHandler(event)");
      anchor.addEventListener("click", clickHandler, false);
    });
  } 
  // document.querySelector('.x3dom-log').style.display = 'block';
  document.querySelector('Inline').onload = loadHandler;
}
</script>
</html>


<code>
> (St <- sum(OL$links$w))
[1] 34088
> (Sc <- sum(Score$links$w))
[1] 25566
> Sc/St
[1] 0.75
> nrow(Score$links)
[1] 3607
> nrow(OL$links)
[1] 10429
> (nrow(Score$links)/nrow(OL$links))
[1] 0.3458625
> NC <- Score$nodes; NT <- OL$nodes
> nrow(NC$Games)
[1] 25
> nrow(NC$NOC)
[1] 29
> nrow(NC$Sport)
[1] 21
> nrow(NT$Games)
[1] 29
> nrow(NT$NOC)
[1] 147
> nrow(NT$Sport)
[1] 52
> (nrow(NC$Games)*nrow(NC$NOC)*nrow(NC$Sport))/(nrow(NT$Games)*nrow(NT$NOC)*nrow(NT$Sport))
[1] 0.06868132
</code>

===== Change labels of Olympics =====

<code>
> N <- paste(OL$nodes$Games$Year,OL$nodes$Games$City)
> Score$nodes$Games$ID <- N[CC$Games]
> mwnX3D(Score,"Games","NOC","Sport","w",maxsize=0.95,pv=J,pz=K,col=Col,file="Oly16CoreClu.x3d")
</code>