Olympics pRel core

> MT <- fromJSON("Olympics1.json")
> n1 <- nrow(MT$nodes$Olympics); n2 <- nrow(MT$nodes$Country); n3 <- nrow(MT$nodes$Discipline)
> C1 <- 1:n1; C2 <- 1:n2; C3 <- 1:n3
> F12 <- sapply(1:n1,function(u) pRel(MT,u,C2,"Olympics","Country",way3="Discipline"))
> F21 <- sapply(1:n2,function(v) pRel(MT,v,C1,"Country","Olympics",way3="Discipline"))
> table(F12)
> table(F12)
F12
27 29 31 34 37 40 41 
 2  1  1  1  1  2  1 
> table(F21)
F21
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 19 20 21 22 23 24 25 27 28 29 30 32 36 
37 16 10  8  4  6  2  2  2  6  3  2  3  1  1  3  3  3  1  1  1  1  2  2  1  1  1  2  1  1 
> PRel <- function(MN,u,C,way1,way2,...) pRel(MN,u,C,way1,way2,way3="Discipline",...)
> Rcore <- Gen2modeCore(MT,"Olympics","Country",PRel,PRel,20,20)
> Rcore
$core1
[1] 1 2 3 4 5 6 7 8 9
$core2
 [1]   5  17  19  37  39  52  83  88  96  97 114 115 117 118 124
> Coli <- Rcore$core1; Cntr <- Rcore$core2
> FCp <- sapply(Coli,function(u) pRel(MT,u,Cntr,"Olympics","Country",way3="Discipline"))
> names(FCp) <- MT$nodes$Olympics$ID[Coli]
> rev(sort(FCp))
    Beijing 2008      Sydney 2000      Athens 2004     Atlanta 1996   Barcelona 1992 
              41               40               40               37               33 
      Seoul 1988 Los Angeles 1984      Moscow 1980    Montreal 1976 
              31               29               27               27 
> FCl <- sapply(Cntr,function(u) pRel(MT,u,Coli,"Country","Olympics",way3="Discipline"))
> names(FCl) <- MT$nodes$Country$ID[Cntr]
> rev(sort(FCl))
 United States        Germany         France          China         Russia   Soviet Union 
            36             32             30             30             29             28 
         Italy          Spain      Australia   West Germany         Canada United Kingdom 
            27             25             25             24             24             23 
        Poland   Unified team        Ukraine 
            22             21             20

> MTcore <- extract(MT,c("Olympics","Country"),c("Coli","Cntr")) 
> MTcore$nodes$Olympics <- as.data.frame(data.frame(ID=MTcore$nodes$Olympics))
> MTcore$nodes$Country <- as.data.frame(data.frame(ID=MTcore$nodes$Country))
> str(MTcore)
> CC <- col2rgb(createPalette(41,c("#ff0000","#00ff00","#0000ff")))/255
> LC <- MTcore$links
> Col <- cbind(CC[1,LC$Discipline],CC[2,LC$Discipline],CC[3,LC$Discipline])
> mwnX3D(MTcore,"Olympics","Country","Discipline","w",maxsize=0.95,col=Col,file="OlympicsCoreR.x3d")
> Cov <- projection(MTcore,"Country","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(MTcore,"Discipline","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 - disciplines / Ward")
> I <- inv(c(6,7,5,8,3,2,9,1,4)) 
> J <- inv(tv$order); K <- inv(tz$order) 
> mwnX3D(MTcore,"Olympics","Country","Discipline","w",pu=I,pv=J,pz=K,maxsize=0.95,col=Col,file="OlympicsCoreClusR.x3d")

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

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

> sum(MN$links$w)
[1] 15316
> sum(MTcore$links$w)
[1] 8832
> sum(MTcore$links$w)/sum(MN$links$w)
[1] 0.5766519
> length(MN$nodes$Countries$ID)
[1] 0
> length(MN$nodes$Country$ID)
[1] 127
> length(MTcore$nodes$Country$ID)
[1] 15
> length(MTcore$nodes$Country$ID)/length(MN$nodes$Country$ID)
[1] 0.1181102