iramuteq.org Git - iramuteq/blob - Rscripts/Rgraph.R

   1 ############FIXME##################
   2 PlotDendroComp <- function(chd,filename,reso) {
   3    jpeg(filename,res=reso)
   4    par(cex=PARCEX)
   5    plot(chd,which.plots=2, hang=-1)
   6    dev.off()
   7 }
   8
   9 PlotDendroHori <- function(dendrocutupper,filename,reso) {
  10    jpeg(filename,res=reso)
  11    par(cex=PARCEX)
  12    nP <- list(col=3:2, cex=c(0.5, 0.75), pch= 21:22, bg= c('light blue', 'pink'),lab.cex = 0.75, lab.col = 'tomato')
  13    plot(dendrocutupper,nodePar= nP, edgePar = list(col='gray', lwd=2),horiz=TRUE, center=FALSE)
  14    dev.off()
  15 }
  16
  17 PlotDendroCut <- function(chd,filename,reso,clusternb) {
  18    h.chd <- as.hclust(chd)
  19    memb <- cutree(h.chd, k = clusternb)
  20    cent <- NULL
  21    for(k in 1:clusternb){
  22        cent <- rbind(cent, k)
  23    }
  24    h.chd1 <- hclust(dist(cent)^2, method = 'cen', members = table(memb))
  25    h.chd1$labels <- sprintf('CL %02d',1:clusternb)
  26    nP <- list(col=3:2, cex=c(2.0, 0.75), pch= 21:22, bg= c('light blue', 'pink'),lab.cex = 0.75, lab.col = 'tomato')
  27    jpeg(filename,res=reso)
  28    par(cex=PARCEX)
  29    plot(h.chd1, nodePar= nP, edgePar = list(col='gray', lwd=2), horiz=TRUE, center=TRUE, hang= -1)
  30    dev.off()
  31 }
  32
  33 PlotAfc<- function(afc, filename, width=800, height=800, quality=100, reso=200, toplot=c('all','all'), PARCEX=PARCEX) {
  34         if (Sys.info()["sysname"]=='Darwin') {
  35                 width<-width/74.97
  36                 height<-height/74.97
  37                 quartz(file=filename,type='jpeg',width=width,height=height)
  38         } else {
  39                 jpeg(filename,width=width,height=height,quality=quality,res=reso)
  40         }
  41         par(cex=PARCEX)
  42         plot(afc,what=toplot,labels=c(1,1),contrib=c('absolute','relative'))
  43         dev.off()
  44 }
  45
  46 PlotAfc2dCoul<- function(afc,chisqrtable,filename, what='coord',col=FALSE, axetoplot=c(1,2), deb=0,fin=0, width=800, height=800, quality=100, reso=200, parcex=PARCEX, xlab = NULL, ylab = NULL) {
  47         if (col) {
  48                 if (what == 'coord') {
  49                         rowcoord <- as.matrix(afc$colcoord)
  50                 } else {
  51                         rowcoord <- as.matrix(afc$colcrl)
  52                 }
  53         } else {
  54                 if (what == 'coord') {
  55                         rowcoord <- as.matrix(afc$rowcoord)
  56                 } else {
  57                         rowcoord <- as.matrix(afc$rowcrl)
  58                 }
  59         }
  60         x <- axetoplot[1]
  61         y <- axetoplot[2]
  62
  63         if (col)
  64                 rownames(rowcoord) <- afc$colnames
  65         if (!col){
  66                 rownames(rowcoord) <- afc$rownames
  67                 rowcoord <- as.matrix(rowcoord[deb:fin,])
  68                 chitable<- as.matrix(chisqrtable[deb:fin,])
  69                 #row_keep <- select_point_nb(chitable,15)
  70         }
  71         if (ncol(rowcoord) == 1) {
  72                 rowcoord <- t(rowcoord)
  73         }
  74         clnb <- ncol(chisqrtable)
  75
  76         if (!col) classes <- as.matrix(apply(chitable,1,which.max))
  77         else  classes <- 1:clnb
  78         ntabtot <- cbind(rowcoord, classes)
  79         #if (!col) ntabtot <- ntabtot[row_keep,]
  80         open_file_graph(filename, width = width, height = height)
  81         par(cex=PARCEX)
  82         plot(rowcoord[,x],rowcoord[,y], pch='', xlab = xlab, ylab = ylab)
  83         abline(h=0,v=0)
  84         for (i in 1:clnb) {
  85                 ntab <- subset(ntabtot,ntabtot[,ncol(ntabtot)] == i)
  86                 if (nrow(ntab) != 0)
  87                         text(ntab[,x],ntab[,y],rownames(ntab),col=rainbow(clnb)[i])
  88         }
  89         dev.off()
  90 }
  91
  92 filename.to.svg <- function(filename) {
  93     filename <- gsub('.png', '.svg', filename)
  94     return(filename)
  95 }
  96
  97 open_file_graph <- function (filename, width=800, height = 800, quality = 100, svg = FALSE) {
  98         if (Sys.info()["sysname"] == 'Darwin') {
  99                 width <- width/74.97
 100                 height <- height/74.97
 101                 quartz(file = filename, type = 'jpeg', width = width, height = height)
 102         } else {
 103         #print('ATTENTION SVG!!!!!!!!!!!!!!!!!!!!!!!!!!!')
 104         #library(RSvgDevice)
 105         if (svg) {
 106             svg(filename.to.svg(filename), width=width/74.97, height=height/74.97)
 107         } else {
 108                     png(filename, width=width, height=height)#, quality = quality)
 109         }
 110         }
 111 }
 112
 113 make_tree_tot <- function (chd) {
 114         library(ape)
 115         lf<-chd$list_fille
 116         clus<-'a1a;'
 117         for (i in 1:length(lf)) {
 118                 if (!is.null(lf[[i]])) {
 119                         clus<-gsub(paste('a',i,'a',sep=''),paste('(','a',lf[[i]][1],'a',',','a',lf[[i]][2],'a',')',sep=''),clus)
 120         }
 121         }
 122         dendro_tuple <- clus
 123         clus <- gsub('a','',clus)
 124         tree.cl <- read.tree(text = clus)
 125         res<-list(tree.cl = tree.cl, dendro_tuple = dendro_tuple)
 126         res
 127 }
 128
 129 make_dendro_cut_tuple <- function(dendro_in, coordok, classeuce, x, nbt = 9) {
 130         library(ape)
 131         dendro<-dendro_in
 132         i <- 0
 133         for (cl in coordok[,x]) {
 134                 i <- i + 1
 135                 fcl<-fille(cl,classeuce)
 136                 for (fi in fcl) {
 137                         dendro <- gsub(paste('a',fi,'a',sep=''),paste('b',i,'b',sep=''),dendro)
 138                 }
 139         }
 140         clnb <- nrow(coordok)
 141     tcl=((nbt+1) *2) - 2
 142         for (i in 1:(tcl + 1)) {
 143                 dendro <- gsub(paste('a',i,'a',sep=''),paste('b',0,'b',sep=''),dendro)
 144         }
 145         dendro <- gsub('b','',dendro)
 146         dendro <- gsub('a','',dendro)
 147         dendro_tot_cl <- read.tree(text = dendro)
 148         #FIXME
 149         for (i in 1:10) {
 150                 for (cl in 1:clnb) {
 151                         dendro <- gsub(paste('\\(',cl,',',cl,'\\)',sep=''),cl,dendro)
 152                 }
 153         }
 154         for (i in 1:10) {
 155                 dendro <- gsub(paste('\\(',0,',',0,'\\)',sep=''),0,dendro)
 156                 for (cl in 1:clnb) {
 157                         dendro <- gsub(paste('\\(',0,',',cl,'\\)',sep=''),cl,dendro)
 158                         dendro <- gsub(paste('\\(',cl,',',0,'\\)',sep=''),cl,dendro)
 159                 }
 160         }
 161         print(dendro)
 162         tree.cl <- read.tree(text = dendro)
 163     lab <- tree.cl$tip.label
 164     if ("0" %in% lab) {
 165         tovire <- which(lab == "0")
 166         tree.cl <- drop.tip(tree.cl, tip = tovire)
 167     }
 168         res <- list(tree.cl = tree.cl, dendro_tuple_cut = dendro, dendro_tot_cl = dendro_tot_cl)
 169         res
 170 }
 171
 172 select_point_nb <- function(tablechi, nb) {
 173         chimax<-as.matrix(apply(tablechi,1,max))
 174         chimax<-cbind(chimax,1:nrow(tablechi))
 175         order_chi<-as.matrix(chimax[order(chimax[,1],decreasing = TRUE),])
 176         row_keep <- order_chi[,2][1:nb]
 177         row_keep
 178 }
 179
 180 select_point_chi <- function(tablechi, chi_limit) {
 181         chimax<-as.matrix(apply(tablechi,1,max))
 182         row_keep <- which(chimax >= chi_limit)
 183         row_keep
 184 }
 185
 186 #from summary.ca
 187 summary.ca.dm <- function(object, scree = TRUE, ...){
 188   obj <- object
 189   nd  <- obj$nd
 190   if (is.na(nd)){
 191     nd <- 2
 192     } else {
 193     if (nd > length(obj$sv)) nd <- length(obj$sv)
 194     }
 195  # principal coordinates:
 196   K   <- nd
 197   I   <- dim(obj$rowcoord)[1] ; J <- dim(obj$colcoord)[1]
 198   svF <- matrix(rep(obj$sv[1:K], I), I, K, byrow = TRUE)
 199   svG <- matrix(rep(obj$sv[1:K], J), J, K, byrow = TRUE)
 200   rpc <- obj$rowcoord[,1:K] * svF
 201   cpc <- obj$colcoord[,1:K] * svG
 202
 203  # rows:
 204   r.names <- obj$rownames
 205   sr      <- obj$rowsup
 206   if (!is.na(sr[1])) r.names[sr] <- paste("(*)", r.names[sr], sep = "")
 207   r.mass <- obj$rowmass
 208   r.inr  <- obj$rowinertia / sum(obj$rowinertia, na.rm = TRUE)
 209   r.COR  <- matrix(NA, nrow = length(r.names), ncol = nd)
 210   colnames(r.COR) <- paste('COR -facteur', 1:nd, sep=' ')
 211   r.CTR  <- matrix(NA, nrow = length(r.names), ncol = nd)
 212   colnames(r.CTR) <- paste('CTR -facteur', 1:nd, sep=' ')
 213   for (i in 1:nd){
 214     r.COR[,i] <- obj$rowmass * rpc[,i]^2 / obj$rowinertia
 215     r.CTR[,i] <- obj$rowmass * rpc[,i]^2 / obj$sv[i]^2
 216     }
 217  # cor and quality for supplementary rows
 218   if (length(obj$rowsup) > 0){
 219     i0 <- obj$rowsup
 220     for (i in 1:nd){
 221       r.COR[i0,i] <- obj$rowmass[i0] * rpc[i0,i]^2
 222       r.CTR[i0,i] <- NA
 223     }
 224     }
 225
 226  # columns:
 227   c.names <- obj$colnames
 228   sc      <- obj$colsup
 229   if (!is.na(sc[1])) c.names[sc] <- paste("(*)", c.names[sc], sep = "")
 230   c.mass  <- obj$colmass
 231   c.inr   <- obj$colinertia / sum(obj$colinertia, na.rm = TRUE)
 232   c.COR   <- matrix(NA, nrow = length(c.names), ncol = nd)
 233   colnames(c.COR) <- paste('COR -facteur', 1:nd, sep=' ')
 234   c.CTR   <- matrix(NA, nrow = length(c.names), ncol = nd)
 235   colnames(c.CTR) <- paste('CTR -facteur', 1:nd, sep=' ')
 236   for (i in 1:nd)
 237     {
 238     c.COR[,i] <- obj$colmass * cpc[,i]^2 / obj$colinertia
 239     c.CTR[,i] <- obj$colmass * cpc[,i]^2 / obj$sv[i]^2
 240     }
 241   if (length(obj$colsup) > 0){
 242     i0 <- obj$colsup
 243     for (i in 1:nd){
 244       c.COR[i0,i] <- obj$colmass[i0] * cpc[i0,i]^2
 245       c.CTR[i0,i] <- NA
 246       }
 247     }
 248
 249  # scree plot:
 250   if (scree) {
 251     values     <- obj$sv^2
 252     values2    <- 100*(obj$sv^2)/sum(obj$sv^2)
 253     values3    <- cumsum(100*(obj$sv^2)/sum(obj$sv^2))
 254     scree.out  <- cbind(values, values2, values3)
 255     } else {
 256     scree.out <- NA
 257     }
 258
 259   obj$r.COR <- r.COR
 260   obj$r.CTR <- r.CTR
 261   obj$c.COR <- c.COR
 262   obj$c.CTR <- c.CTR
 263   obj$facteur <- scree.out
 264   return(obj)
 265   }
 266
 267 create_afc_table <- function(x) {
 268    #x = afc
 269         facteur.table <- as.matrix(x$facteur)
 270     nd <- ncol(x$colcoord)
 271         rownames(facteur.table) <- paste('facteur',1:nrow(facteur.table),sep = ' ')
 272     colnames(facteur.table) <- c('Valeurs propres', 'Pourcentages', 'Pourcentage cumules')
 273         ligne.table <- as.matrix(x$rowcoord)
 274         rownames(ligne.table) <- x$rownames
 275         colnames(ligne.table) <- paste('Coord. facteur', 1:nd, sep=' ')
 276     tmp <- as.matrix(x$rowcrl)
 277         colnames(tmp) <- paste('Corr. facteur', 1:nd, sep=' ')
 278         ligne.table <- cbind(ligne.table,tmp)
 279         ligne.table <- cbind(ligne.table, x$r.COR)
 280         ligne.table <- cbind(ligne.table, x$r.CTR)
 281         ligne.table <- cbind(ligne.table, mass = x$rowmass)
 282         ligne.table <- cbind(ligne.table, chi.distance = x$rowdist)
 283         ligne.table <- cbind(ligne.table, inertie = x$rowinertia)
 284     colonne.table <- x$colcoord
 285         rownames(colonne.table) <- paste('classe', 1:(nrow(colonne.table)),sep=' ')
 286         colnames(colonne.table) <- paste('Coord. facteur', 1:nd, sep=' ')
 287     tmp <- as.matrix(x$colcrl)
 288         colnames(tmp) <- paste('Corr. facteur', 1:nd, sep=' ')
 289         colonne.table <- cbind(colonne.table, tmp)
 290         colonne.table <- cbind(colonne.table, x$c.COR)
 291         colonne.table <- cbind(colonne.table, x$c.CTR)
 292         colonne.table <- cbind(colonne.table, mass = x$colmass)
 293         colonne.table <- cbind(colonne.table, chi.distance = x$coldist)
 294         colonne.table <- cbind(colonne.table, inertie = x$colinertia)
 295     res <- list(facteur = facteur.table, ligne = ligne.table, colonne = colonne.table)
 296         res
 297 }
 298
 299 make_afc_graph <- function(toplot,classes,clnb, xlab, ylab, cex.txt = NULL, leg = FALSE, cmd = FALSE) {
 300         rain <- rainbow(clnb)
 301     compt <- 1
 302     tochange <- NULL
 303     for (my.color in rain) {
 304         my.color <- col2rgb(my.color)
 305         if ((my.color[1] > 200) & (my.color[2] > 200) & (my.color[3] < 20)) {
 306            tochange <- append(tochange, compt)
 307         }
 308         compt <- compt + 1
 309     }
 310     if (!is.null(tochange)) {
 311         gr.col <- grey.colors(length(tochange))
 312         compt <- 1
 313         for (val in tochange) {
 314             rain[val] <- gr.col[compt]
 315             compt <- compt + 1
 316         }
 317     }
 318         cl.color <- rain[classes]
 319         plot(toplot[,1],toplot[,2], pch='', xlab = xlab, ylab = ylab)
 320         abline(h=0,v=0, lty = 'dashed')
 321     #print('ATTENTION Rgraph.R : utilisation de maptools !')
 322     #library(maptools)
 323         if (is.null(cex.txt))
 324         #pointLabel(toplot[,1],toplot[,2],rownames(toplot),col=cl.color)
 325                 text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color)
 326         else
 327                 #pointLabel(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt)
 328         text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt)
 329
 330     if (!cmd) {
 331             dev.off()
 332     }
 333 }
 334
 335 plot.dendropr <- function(tree, classes, type.dendro="phylogram", histo=FALSE, from.cmd=FALSE, bw=FALSE, lab = NULL, tclasse=TRUE) {
 336         classes<-classes[classes!=0]
 337         classes<-as.factor(classes)
 338         sum.cl<-as.matrix(summary(classes))
 339         sum.cl<-(sum.cl/colSums(sum.cl)*100)
 340         sum.cl<-round(sum.cl,2)
 341         sum.cl<-cbind(sum.cl,as.matrix(100-sum.cl[,1]))
 342     tree.order<- as.numeric(tree$tip.label)
 343     if (! bw) {
 344         col = rainbow(nrow(sum.cl))[as.numeric(tree$tip.label)]
 345         col.bars <- col
 346         col.pie <- rainbow(nrow(sum.cl))
 347             #col.vec<-rainbow(nrow(sum.cl))[as.numeric(tree[[2]])]
 348     } else {
 349         col = 'black'
 350         col.bars = 'grey'
 351         col.pie <- rep('grey',nrow(sum.cl))
 352     }
 353         vec.mat<-NULL
 354         for (i in 1:nrow(sum.cl)) vec.mat<-append(vec.mat,1)
 355         v<-2
 356         for (i in 1:nrow(sum.cl)) {
 357                 vec.mat<-append(vec.mat,v)
 358                 v<-v+1
 359         }
 360         par(mar=c(0,0,0,0))
 361     if (tclasse) {
 362         if (! histo) {
 363                 layout(matrix(vec.mat,nrow(sum.cl),2),widths=c(3,1))
 364         } else {
 365             layout(matrix(c(1,2),1,byrow=TRUE), widths=c(3,2),TRUE)
 366         }
 367     }
 368         par(mar=c(0,0,0,0),cex=1)
 369         label.ori<-tree[[2]]
 370     if (!is.null(lab)) {
 371         tree$tip.label <- lab
 372     } else {
 373             tree[[2]]<-paste('classe ',tree[[2]])
 374     }
 375         plot.phylo(tree,label.offset=0.1,tip.col=col, type=type.dendro)
 376     #cl.order <- as.numeric(label.ori)
 377     #sum.cl[cl.order,1]
 378         #for (i in 1:nrow(sum.cl)) {
 379     if (tclasse) {
 380         if (! histo) {
 381             for (i in rev(tree.order)) {
 382                 par(mar=c(0,0,1,0),cex=0.7)
 383                     pie(sum.cl[i,],col=c(col.pie[i],'white'),radius = 1, labels='', clockwise=TRUE, main = paste('classe ',i,' - ',sum.cl[i,1],'%' ))
 384             }
 385         } else {
 386             par(cex=0.7)
 387             par(mar=c(0,0,0,1))
 388             to.plot <- sum.cl[tree.order,1]
 389             d <- barplot(to.plot,horiz=TRUE, col=col.bars, names.arg='', axes=FALSE, axisname=FALSE)
 390             text(x=to.plot, y=d[,1], label=paste(round(to.plot,1),'%'), adj=1.2)
 391         }
 392     }
 393     if (!from.cmd) dev.off()
 394         tree[[2]]<-label.ori
 395 }
 396 #tree <- tree.cut1$tree.cl
 397 #to.plot <- di
 398 plot.dendro.lex <- function(tree, to.plot, bw=FALSE, lab=NULL, lay.width=c(3,3,2), cmd=FALSE) {
 399     tree.order<- as.numeric(tree$tip.label)
 400     par(mar=c(0,0,0,0))
 401     layout(matrix(c(1,2,3),1,byrow=TRUE), widths=lay.width,TRUE)
 402         par(mar=c(3,0,2,0),cex=1)
 403         label.ori<-tree[[2]]
 404     if (!is.null(lab)) {
 405         tree$tip.label <- lab
 406     } else {
 407             tree[[2]]<-paste('classe ',tree[[2]])
 408     }
 409     to.plot <- matrix(to.plot[,tree.order], nrow=nrow(to.plot), dimnames=list(rownames(to.plot), colnames(to.plot)))
 410     if (!bw) {
 411         col <- rainbow(ncol(to.plot))
 412         col.bars <- rainbow(nrow(to.plot))
 413     } else {
 414         col <- 'black'
 415         col.bars <- grey.colors(nrow(to.plot),0,0.8)
 416     }
 417     col <- col[tree.order]
 418         plot.phylo(tree,label.offset=0.1,tip.col=col)
 419
 420     par(mar=c(3,0,2,1))
 421     d <- barplot(to.plot,horiz=TRUE, col=col.bars, beside=TRUE, names.arg='', space = c(0.1,0.6), axisname=FALSE)
 422     c <- colMeans(d)
 423     c1 <- c[-1]
 424     c2 <- c[-length(c)]
 425     cc <- cbind(c1,c2)
 426     lcoord <- apply(cc, 1, mean)
 427     abline(h=lcoord)
 428     if (min(to.plot) < 0) {
 429         amp <- abs(max(to.plot) - min(to.plot))
 430     } else {
 431         amp <- max(to.plot)
 432     }
 433     if (amp < 10) {
 434         d <- 2
 435     } else {
 436         d <- signif(amp%/%10,1)
 437     }
 438     mn <- round(min(to.plot))
 439     mx <- round(max(to.plot))
 440     for (i in mn:mx) {
 441         if ((i/d) == (i%/%d)) {
 442             abline(v=i,lty=3)
 443         }
 444     }
 445     par(mar=c(0,0,0,0))
 446     plot(0, axes = FALSE, pch = '')
 447     legend(x = 'center' , rownames(to.plot), fill = col.bars)
 448     if (!cmd) {
 449         dev.off()
 450     }
 451         tree[[2]]<-label.ori
 452 }
 453
 454 plot.alceste.graph <- function(rdata,nd=3,layout='fruke', chilim = 2) {
 455     load(rdata)
 456     if (is.null(debsup)) {
 457         tab.toplot<-afctable[1:(debet+1),]
 458         chitab<-chistabletot[1:(debet+1),]
 459     } else {
 460         tab.toplot<-afctable[1:(debsup+1),]
 461         chitab<-chistabletot[1:(debsup+1),]
 462     }
 463     rkeep<-select_point_chi(chitab,chilim)
 464     tab.toplot<-tab.toplot[rkeep,]
 465     chitab<-chitab[rkeep,]
 466     dm<-dist(tab.toplot,diag=TRUE,upper=TRUE)
 467     cn<-rownames(tab.toplot)
 468     cl.toplot<-apply(chitab,1,which.max)
 469     col<-rainbow(ncol(tab.toplot))[cl.toplot]
 470     library(igraph)
 471     g1 <- graph.adjacency(as.matrix(dm), mode = 'lower', weighted = TRUE)
 472     g.max<-minimum.spanning.tree(g1)
 473     we<-(rowSums(tab.toplot)/max(rowSums(tab.toplot)))*2
 474     #lo <- layout.fruchterman.reingold(g.max,dim=nd)
 475     lo<- layout.kamada.kawai(g.max,dim=nd)
 476     print(nrow(tab.toplot))
 477     print(nrow(chitab))
 478     print(length(we))
 479     print(length(col))
 480     print(length(cn))
 481     if (nd == 3) {
 482         rglplot(g.max, vertex.label = cn, vertex.size = we*3, edge.width = 0.5, edge.color='black', vertex.label.color = col,vertex.color = col, layout = lo, vertex.label.cex = 1)
 483     } else if (nd == 2) {
 484         plot(g.max, vertex.label = cn, vertex.size = we, edge.width = 0.5, edge.color='black', vertex.label.color = col,vertex.color = col, layout = lo, vertex.label.cex = 0.8)
 485     }
 486
 487 }
 488
 489 make.simi.afc <- function(x,chitable,lim=0, alpha = 0.1, movie = NULL) {
 490     library(igraph)
 491     chimax<-as.matrix(apply(chitable,1,max))
 492     chimax<-as.matrix(chimax[,1][1:nrow(x)])
 493     chimax<-cbind(chimax,1:nrow(x))
 494     order_chi<-as.matrix(chimax[order(chimax[,1],decreasing = TRUE),])
 495     if ((lim == 0) || (lim>nrow(x))) lim <- nrow(x)
 496     x<-x[order_chi[,2][1:lim],]
 497     maxchi <- chimax[order_chi[,2][1:lim],1]
 498     #-------------------------------------------------------
 499     limit<-nrow(x)
 500     distm<-dist(x,diag=TRUE)
 501     distm<-as.matrix(distm)
 502     g1<-graph.adjacency(distm,mode='lower',weighted=TRUE)
 503     g1<-minimum.spanning.tree(g1)
 504     lo<-layout.kamada.kawai(g1,dim=3)
 505     lo <- layout.norm(lo, -3, 3, -3, 3, -3, 3)
 506     mc<-rainbow(ncol(chistabletot))
 507     chitable<-chitable[order_chi[,2][1:lim],]
 508     cc <- apply(chitable, 1, which.max)
 509     cc<-mc[cc]
 510     #mass<-(rowSums(x)/max(rowSums(x))) * 5
 511     maxchi<-norm.vec(maxchi, 0.03, 0.3)
 512     rglplot(g1,vertex.label = vire.nonascii(rownames(x)),vertex.label.color='black',vertex.color=cc,vertex.size = 0.1, layout=lo, rescale=FALSE)
 513     rgl.spheres(lo, col = cc, radius = maxchi, alpha = alpha)
 514     rgl.bg(color = c('white','black'))
 515     if (!is.null(movie)) {
 516         require(tcltk)
 517         ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour commencer le film",icon="info",type="ok")
 518
 519         movie3d(spin3d(axis=c(0,1,0),rpm=6), movie = 'film_graph', frames = "tmpfilm", duration=10, clean=TRUE, top = TRUE, dir = movie)
 520         ReturnVal <- tkmessageBox(title="RGL 3 D",message="Film fini !",icon="info",type="ok")
 521     }
 522         while (rgl.cur() != 0)
 523                 Sys.sleep(1)
 524
 525 }
 526
 527 # from igraph
 528 norm.vec <- function(v, min, max) {
 529
 530   vr <- range(v)
 531   if (vr[1]==vr[2]) {
 532     fac <- 1
 533   } else {
 534     fac <- (max-min)/(vr[2]-vr[1])
 535   }
 536   (v-vr[1]) * fac + min
 537 }
 538
 539
 540 vire.nonascii <- function(rnames) {
 541     print('vire non ascii')
 542     couple <- list(c('é','e'),
 543                 c('è','e'),
 544                 c('ê','e'),
 545                 c('ë','e'),
 546                 c('î','i'),
 547                 c('ï','i'),
 548                 c('ì','i'),
 549                 c('à','a'),
 550                 c('â','a'),
 551                 c('ä','a'),
 552                 c('á','a'),
 553                 c('ù','u'),
 554                 c('û','u'),
 555                 c('ü','u'),
 556                 c('ç','c'),
 557                 c('ò','o'),
 558                 c('ô','o'),
 559                 c('ö','o'),
 560                 c('ñ','n')
 561                 )
 562
 563     for (c in couple) {
 564         rnames<-gsub(c[1],c[2], rnames)
 565     }
 566     rnames
 567 }
 568
 569
 570
 571 #par(mar=c(0,0,0,0))
 572 #layout(matrix(c(1,2),1,byrow=TRUE), widths=c(3,2),TRUE)
 573 #par(mar=c(1,0,1,0), cex=1)
 574 #plot.phylo(tree,label.offset=0.1)
 575 #par(mar=c(0,0,0,1))
 576 #to.plot <- sum.cl[cl.order,1]
 577 #d <- barplot(to.plot,horiz=TRUE, names.arg='', axes=FALSE, axisname=FALSE)
 578 #text(x=to.plot, y=d[,1], label=round(to.plot,1), adj=1.2)
 579