July 24, 2017
Work in progress!!!
> setwd("C:/Users/batagelj/Documents/2017/rusija/daria")
> load("W.Rdata")
> palf <- colorRampPalette(c("white", "black"))
> heatmap(W,Rowv=NA,Colv=NA,col=palf(6),scale="none",margins=c(10,10))
> heatmap(W,Rowv=NA,Colv=NA,col=palf(6),scale="none",margins=c(6,6))
> library(RColorBrewer) > rc <- rainbow(nrow(n2), start = 0, end = .3) > cc <- rainbow(ncol(n2), start = 0, end = .3) > heatmap(x=n2,Rowv=NA,Colv=NA,col=col,symm=TRUE,cexRow=0.3,cexCol=0.3,RowSideColors = rc, ColSideColors = cc)
> p <- as.integer(read.csv("BMstruct.per",header=FALSE,skip=1)$V1)
> C <- as.integer(read.csv("BMstruct.clu",header=FALSE,skip=1)$V1)
> C <- C+1
> heatmap(x=n2,Rowv=p,Colv=p,col=col,symm=TRUE,cexRow=0.3,cexCol=0.3,RowSideColors=rc,ColSideColors=cc)
It seems that the built-in procedure does not use the corrected dissimilarity for clustering the network. This can be repaired by setting distfun=netDist from clustering_the_migration_network
> netDist <- function(A){ n <- nrow(A)
+ D <- matrix(nrow=n,ncol=n,dimnames=dimnames(A)); diag(D) <- 0
+ for(v in 2:n){
+ for(u in 1:(v-1)) {
+ d <- sum((A[v,]-A[u,])**2) - (A[v,u]-A[u,u])**2 - (A[v,v]-A[u,v])**2 +
+ (A[v,u]-A[u,v])**2 + (A[v,v]-A[u,u])**2
+ D[v,u] <- D[u,v] <- sqrt(d)
+ }
+ }
+ return(as.dist(D))
+ }
> h <- heatmap(x=n2,distfun=netDist,Rowv=p,Colv=p,col=col,symm=TRUE,
+ cexRow=0.3,cexCol=0.3,RowSideColors=rc,ColSideColors=cc)
> h <- heatmap(x=n2,distfun=netDist,Rowv=p,Colv=p,col=col,symm=TRUE,
+ cexRow=0.3,cexCol=0.3,RowSideColors=rc,ColSideColors=cc,revC=TRUE)
> library(gplots)
> h <- heatmap.2(x=n2,distfun=netDist,Rowv=p,Colv=p,col=col,symm=TRUE,
+ cexRow=0.3,cexCol=0.3,RowSideColors=rc,ColSideColors=cc,
+ revC=TRUE,dendrogram="row")
> svg("PAJheat2.svg",width=10,height=10)
> h <- heatmap.2(x=n2,distfun=netDist,Rowv=p,Colv=p,col=col,symm=TRUE,
+ cexRow=0.5,cexCol=0.5,RowSideColors=rc,ColSideColors=cc,
+ revC=TRUE,dendrogram="row",trace="none")
> dev.off()
> cc <- c(rep("blue",27),rep("red",79))
> svg("PAJheat2.svg",width=10,height=10)
> h <- heatmap.2(x=n2,distfun=netDist,Rowv=p,Colv=p,col=col,symm=TRUE,
+ colsep=c(20,40,50),rowsep=c(6,14,18,25,30,36,42,47),
+ sepcolor="blue",sepwidth=c(0.01,0.01),
+ cexRow=0.5,cexCol=0.5,RowSideColors=rc,ColSideColors=cc,
+ revC=TRUE,dendrogram="row",trace="none")
> dev.off()
> D <- netDist(n2) > hc <- hclust(D) > plot(hc,hang=-1,cex=0.2) > C <- cutree(hc,k=15) > dend <- as.dendrogram(hc) > hm <- heatmap.2(n2,Rowv=dend,col=col,symm=TRUE,cexRow=0.3,cexCol=0.3,revC=TRUE,trace="none") > P <- C[hm$rowInd] > Q <- c() > for(i in 1:105) if(P[i]!=P[i+1]) Q <- c(Q,i) > hm <- heatmap.2(n2,Rowv=dend,col=col,symm=TRUE, + ColSideColors=cc,cexRow=0.3,cexCol=0.3,# keysize=30, + colsep=Q,rowsep=Q,sepcolor="blue",sepwidth=c(0.01,0.01), + main="Collaboration among Russian SNA", + key=FALSE,dendrogram="row",revC=TRUE,trace="none")
> setwd("C:/Users/batagelj/Documents/2017/rusija/daria")
> library(gplots)
> library(xml2)
> xml2utf8 <- function(str){
+ t <- xml2::xml_text(xml2::read_xml(paste0("<x>", str, "</x>")))
+ Encoding(t) <- "UTF-8"
+ return (t)
+ }
> netDist <- function(A){ n <- nrow(A)
+ D <- matrix(nrow=n,ncol=n,dimnames=dimnames(A)); diag(D) <- 0
+ for(v in 2:n){
+ for(u in 1:(v-1)) {
+ d <- sum((A[v,]-A[u,])**2) - (A[v,u]-A[u,u])**2 - (A[v,v]-A[u,v])**2 +
+ (A[v,u]-A[u,v])**2 + (A[v,v]-A[u,u])**2
+ D[v,u] <- D[u,v] <- sqrt(d)
+ }
+ }
+ return(as.dist(D))
+ }
> # load("W.Rdata")
> N <- unlist(lapply(rownames(n2),xml2utf8))
> rownames(n2) <- N; colnames(n2) <- N
> n <- length(N)
> cc <- c(rep("blue",27),rep("red",79))
> col<- colorRampPalette(c("white", "black"))(4)
> D <- netDist(n2)
> hc <- hclust(D)
> plot(hc,hang=-1,cex=0.2)
> C <- cutree(hc,k=15)
> dend <- as.dendrogram(hc)
> hm <- heatmap.2(n2,Rowv=dend,col=col,symm=TRUE,cexRow=0.3,cexCol=0.3,revC=TRUE,trace="none")
> P <- C[hm$rowInd]
> Q <- c()
> for(i in 1:(n-1)) if(P[i]!=P[i+1]) Q <- c(Q,i)
> hm <- heatmap.2(n2,Rowv=dend,col=col,symm=TRUE,
+ ColSideColors=cc,cexRow=0.3,cexCol=0.3,
+ colsep=Q,rowsep=Q,sepcolor="blue",sepwidth=c(0.01,0.01),
+ main="Collaboration among Russian SNA",
+ key=FALSE,dendrogram="row",revC=TRUE,trace="none")
>
> svg("PAJheat2.svg",width=14,height=14)
> hm <- heatmap.2(n2,Rowv=dend,col=col,symm=TRUE,
+ ColSideColors=cc,cexRow=0.65,cexCol=0.65,
+ colsep=Q,rowsep=Q,sepcolor="blue",sepwidth=c(0.01,0.01),
+ main="Collaboration among Russian SNA",
+ key=FALSE,dendrogram="row",revC=TRUE,trace="none")
> dev.off()
> col = c("khaki1","khaki3","khaki4","black")
> hm <- heatmap.2(n2,Rowv=dend,col=col,symm=TRUE,
+ ColSideColors=cc,cexRow=0.3,cexCol=0.3,
+ colsep=Q,rowsep=Q,sepcolor="blue",sepwidth=c(0.01,0.01),
+ main="Collaboration among Russian SNA",
+ key=FALSE,dendrogram="row",revC=TRUE,trace="none")
> svg("PAJheat2b.svg",width=14,height=14)
> hm <- heatmap.2(n2,Rowv=dend,col=col,symm=TRUE,
+ ColSideColors=cc,cexRow=0.85,cexCol=0.85,
+ colsep=Q,rowsep=Q,sepcolor="blue",sepwidth=c(0.01,0.01),
+ lwid=c(0.5,4),lhei=c(0.5,4),margins=c(8,8),
+ key=FALSE,dendrogram="row",revC=TRUE,trace="none")
> dev.off()