====== 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