> 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")
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