Visualization of multi-relational networks

Visualization of multi-relational networks

Function mwnX3D

We can use the pattern from the file testColor.x3d for visualizing multi/relational networks using the following function:

mwnX3D <- function(MN,u,v,z,w,pu=NULL,pv=NULL,pz=NULL,
  shape="Box",col=c(1,0,0),bg=c(0.8,0.8,0.8),maxsize=1,file="MWnets.x3d"){
Ha <- '<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE X3D PUBLIC "ISO//Web3D//DTD X3D 3.0//EN" "http://www.web3d.org/specifications/x3d-3.0.dtd">
<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">
<head>
<meta name="title" content="MWnets"/>
<meta name="created" content="'
Hb <- '"/>
<meta name="generator" content="MWnets by Vladimir Batagelj: https://github.com/bavla/ibm3m/tree/master/multiway"/>
</head>'
B <- '
<Scene>

  <Background skyColor="'

  x3d <- file(file,"w")
  n <- length(MN$links[[w]]); nu <- length(MN$nodes[[u]]$ID)
  nv <- length(MN$nodes[[v]]$ID); nz <- length(MN$nodes[[z]]$ID)
  U <- MN$links[[u]]; V <- MN$links[[v]]; Z <- MN$links[[z]]
  W <- MN$links[[w]]; maxw <- max(W)
  if(is.null(pu)) pu <- 1:n
  if(is.null(pv)) pv <- 1:n
  if(is.null(pz)) pz <- 1:n

cell <- function(i){
  cat('  <Anchor description="link',i,'">\n',file=x3d)
  cat('  <Transform translation="',pu[U[i]]-nu/2," ",nv/2-pv[V[i]]," ",
    pz[Z[i]]-nz/2,'">\n',sep="",file=x3d)
  cat('  <Shape>              <!-- Link ',i,' -->\n',
    ' <Appearance><Material diffuseColor="',
    if(length(col)==3) col else col[i,],
    '"/></Appearance>\n',sep=" ",file=x3d) 
  a <- maxsize*(W[i]/maxw)**(1/3)
  if(shape=="Box") cat('  <Box size="',a,a,a,'"/>\n',file=x3d) else
     cat('  <Sphere radius="',a/2,'"/>\n',file=x3d) 
  cat('  </Shape>\n  </Transform>\n  </Anchor>\n\n',file=x3d)
}

  cat(Ha,date(),Hb,"\n",sep="",file=x3d) 
  cat(B,bg,'"/>\n\n',file=x3d)
  for(i in 1:n) cell(i)
  cat('</Scene>\n</X3D>\n',file=x3d)
  close(x3d)
}

Let's apply it to the random multiway test network

> library(jsonlite)
> library(magrittr)
> source("https://raw.githubusercontent.com/bavla/Rnet/master/R/Pajek.R")
> source("https://raw.githubusercontent.com/bavla/ibm3m/master/multiway/MWnets.R")
> MN <- fromJSON("./random/random35.json")
> mwnX3D(MN,"X","Y","Z","w",maxsize=1,file="random.x3d")

X3D inline example

X3D random network

Multiway/Bavla

Reordering nodes by clustering

> Cox <- projection(MN,"X","w")
> Sax <- salton(Cox); Dx <- as.dist(1-Sax)
> tx <- hclust(Dx,method="complete")
> # plot(tx,hang=-1,cex=0.8,main="Random test X / Complete")
> Coy <- projection(MN,"Y","w")
> Say <- salton(Coy); Dy <- as.dist(1-Say)
> ty <- hclust(Dy,method="complete")
> # plot(ty,hang=-1,cex=0.8,main="Random test Y / Complete")
> Coz <- projection(MN,"Z","w")
> Saz <- salton(Coz); Dz <- as.dist(1-Saz)
> tz <- hclust(Dz,method="complete")
> # plot(tz,hang=-1,cex=0.8,main="Random test Z / Complete")
> I <- J <- K <- 1:35
> I[tx$order] <- 1:35; J[ty$order] <- 1:35; K[tz$order] <- 1:35
> mwnX3D(MN,"X","Y","Z","w",maxsize=1,pu=I,pv=J,pz=K,file="randomClu.x3d")

X3D inline example

X3D random network reordered by clusterings

Multiway/Bavla

Move it using the mouse.

and also coloring by clustering

> qx <- cutree(tx,k=5); Cx <- as.vector((qx-1)/4)
> qy <- cutree(ty,k=6); Cy <- as.vector((qy-1)/5)
> qz <- cutree(tz,k=4); Cz <- as.vector((qz-1)/3)
> L <- MN$links
> cluCol <- cbind(Cx[L$X],Cy[L$Y],Cz[L$Z])
> mwnX3D(MN,"X","Y","Z","w",maxsize=0.8,col=cluCol,pu=I,pv=J,pz=K,file="randomClux.x3d")

X3D inline example

X3D random network reordered and colored by clusterings

Multiway/Bavla