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, black = 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     if (black) {
 320         cl.color <- 'black'
 321     }
 322         plot(toplot[,1],toplot[,2], pch='', xlab = xlab, ylab = ylab)
 323         abline(h=0,v=0, lty = 'dashed')
 324     #print('ATTENTION Rgraph.R : utilisation de maptools !')
 325     #library(maptools)
 326         if (is.null(cex.txt))
 327         #pointLabel(toplot[,1],toplot[,2],rownames(toplot),col=cl.color)
 328                 text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color)
 329         else
 330                 #pointLabel(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt)
 331         text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt)
 332
 333     if (!cmd) {
 334             dev.off()
 335     }
 336 }
 337
 338 plot.dendropr <- function(tree, classes, type.dendro="phylogram", histo=FALSE, from.cmd=FALSE, bw=FALSE, lab = NULL, tclasse=TRUE) {
 339         classes<-classes[classes!=0]
 340         classes<-as.factor(classes)
 341         sum.cl<-as.matrix(summary(classes))
 342         sum.cl<-(sum.cl/colSums(sum.cl)*100)
 343         sum.cl<-round(sum.cl,2)
 344         sum.cl<-cbind(sum.cl,as.matrix(100-sum.cl[,1]))
 345     tree.order<- as.numeric(tree$tip.label)
 346     if (! bw) {
 347         col = rainbow(nrow(sum.cl))[as.numeric(tree$tip.label)]
 348         col.bars <- col
 349         col.pie <- rainbow(nrow(sum.cl))
 350             #col.vec<-rainbow(nrow(sum.cl))[as.numeric(tree[[2]])]
 351     } else {
 352         col = 'black'
 353         col.bars = 'grey'
 354         col.pie <- rep('grey',nrow(sum.cl))
 355     }
 356         vec.mat<-NULL
 357         for (i in 1:nrow(sum.cl)) vec.mat<-append(vec.mat,1)
 358         v<-2
 359         for (i in 1:nrow(sum.cl)) {
 360                 vec.mat<-append(vec.mat,v)
 361                 v<-v+1
 362         }
 363         par(mar=c(0,0,0,0))
 364     if (tclasse) {
 365         if (! histo) {
 366                 layout(matrix(vec.mat,nrow(sum.cl),2),widths=c(3,1))
 367         } else {
 368             layout(matrix(c(1,2),1,byrow=TRUE), widths=c(3,2),TRUE)
 369         }
 370     }
 371         par(mar=c(0,0,0,0),cex=1)
 372         label.ori<-tree[[2]]
 373     if (!is.null(lab)) {
 374         tree$tip.label <- lab
 375     } else {
 376             tree[[2]]<-paste('classe ',tree[[2]])
 377     }
 378         plot.phylo(tree,label.offset=0.1,tip.col=col, type=type.dendro)
 379     #cl.order <- as.numeric(label.ori)
 380     #sum.cl[cl.order,1]
 381         #for (i in 1:nrow(sum.cl)) {
 382     if (tclasse) {
 383         if (! histo) {
 384             for (i in rev(tree.order)) {
 385                 par(mar=c(0,0,1,0),cex=0.7)
 386                     pie(sum.cl[i,],col=c(col.pie[i],'white'),radius = 1, labels='', clockwise=TRUE, main = paste('classe ',i,' - ',sum.cl[i,1],'%' ))
 387             }
 388         } else {
 389             par(cex=0.7)
 390             par(mar=c(0,0,0,1))
 391             to.plot <- sum.cl[tree.order,1]
 392             d <- barplot(to.plot,horiz=TRUE, col=col.bars, names.arg='', axes=FALSE, axisname=FALSE)
 393             text(x=to.plot, y=d[,1], label=paste(round(to.plot,1),'%'), adj=1.2)
 394         }
 395     }
 396     if (!from.cmd) dev.off()
 397         tree[[2]]<-label.ori
 398 }
 399 #tree <- tree.cut1$tree.cl
 400 #to.plot <- di
 401 plot.dendro.lex <- function(tree, to.plot, bw=FALSE, lab=NULL, lay.width=c(3,3,2), cmd=FALSE) {
 402     tree.order<- as.numeric(tree$tip.label)
 403     par(mar=c(0,0,0,0))
 404     layout(matrix(c(1,2,3),1,byrow=TRUE), widths=lay.width,TRUE)
 405         par(mar=c(3,0,2,0),cex=1)
 406         label.ori<-tree[[2]]
 407     if (!is.null(lab)) {
 408         tree$tip.label <- lab
 409     } else {
 410             tree[[2]]<-paste('classe ',tree[[2]])
 411     }
 412     to.plot <- matrix(to.plot[,tree.order], nrow=nrow(to.plot), dimnames=list(rownames(to.plot), colnames(to.plot)))
 413     if (!bw) {
 414         col <- rainbow(ncol(to.plot))
 415         col.bars <- rainbow(nrow(to.plot))
 416     } else {
 417         col <- 'black'
 418         col.bars <- grey.colors(nrow(to.plot),0,0.8)
 419     }
 420     col <- col[tree.order]
 421         plot.phylo(tree,label.offset=0.1,tip.col=col)
 422
 423     par(mar=c(3,0,2,1))
 424     d <- barplot(to.plot,horiz=TRUE, col=col.bars, beside=TRUE, names.arg='', space = c(0.1,0.6), axisname=FALSE)
 425     c <- colMeans(d)
 426     c1 <- c[-1]
 427     c2 <- c[-length(c)]
 428     cc <- cbind(c1,c2)
 429     lcoord <- apply(cc, 1, mean)
 430     abline(h=lcoord)
 431     if (min(to.plot) < 0) {
 432         amp <- abs(max(to.plot) - min(to.plot))
 433     } else {
 434         amp <- max(to.plot)
 435     }
 436     if (amp < 10) {
 437         d <- 2
 438     } else {
 439         d <- signif(amp%/%10,1)
 440     }
 441     mn <- round(min(to.plot))
 442     mx <- round(max(to.plot))
 443     for (i in mn:mx) {
 444         if ((i/d) == (i%/%d)) {
 445             abline(v=i,lty=3)
 446         }
 447     }
 448     par(mar=c(0,0,0,0))
 449     plot(0, axes = FALSE, pch = '')
 450     legend(x = 'center' , rownames(to.plot), fill = col.bars)
 451     if (!cmd) {
 452         dev.off()
 453     }
 454         tree[[2]]<-label.ori
 455 }
 456
 457 plot.alceste.graph <- function(rdata,nd=3,layout='fruke', chilim = 2) {
 458     load(rdata)
 459     if (is.null(debsup)) {
 460         tab.toplot<-afctable[1:(debet+1),]
 461         chitab<-chistabletot[1:(debet+1),]
 462     } else {
 463         tab.toplot<-afctable[1:(debsup+1),]
 464         chitab<-chistabletot[1:(debsup+1),]
 465     }
 466     rkeep<-select_point_chi(chitab,chilim)
 467     tab.toplot<-tab.toplot[rkeep,]
 468     chitab<-chitab[rkeep,]
 469     dm<-dist(tab.toplot,diag=TRUE,upper=TRUE)
 470     cn<-rownames(tab.toplot)
 471     cl.toplot<-apply(chitab,1,which.max)
 472     col<-rainbow(ncol(tab.toplot))[cl.toplot]
 473     library(igraph)
 474     g1 <- graph.adjacency(as.matrix(dm), mode = 'lower', weighted = TRUE)
 475     g.max<-minimum.spanning.tree(g1)
 476     we<-(rowSums(tab.toplot)/max(rowSums(tab.toplot)))*2
 477     #lo <- layout.fruchterman.reingold(g.max,dim=nd)
 478     lo<- layout.kamada.kawai(g.max,dim=nd)
 479     print(nrow(tab.toplot))
 480     print(nrow(chitab))
 481     print(length(we))
 482     print(length(col))
 483     print(length(cn))
 484     if (nd == 3) {
 485         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)
 486     } else if (nd == 2) {
 487         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)
 488     }
 489
 490 }
 491
 492 make.simi.afc <- function(x,chitable,lim=0, alpha = 0.1, movie = NULL) {
 493     library(igraph)
 494     chimax<-as.matrix(apply(chitable,1,max))
 495     chimax<-as.matrix(chimax[,1][1:nrow(x)])
 496     chimax<-cbind(chimax,1:nrow(x))
 497     order_chi<-as.matrix(chimax[order(chimax[,1],decreasing = TRUE),])
 498     if ((lim == 0) || (lim>nrow(x))) lim <- nrow(x)
 499     x<-x[order_chi[,2][1:lim],]
 500     maxchi <- chimax[order_chi[,2][1:lim],1]
 501     #-------------------------------------------------------
 502     limit<-nrow(x)
 503     distm<-dist(x,diag=TRUE)
 504     distm<-as.matrix(distm)
 505     g1<-graph.adjacency(distm,mode='lower',weighted=TRUE)
 506     g1<-minimum.spanning.tree(g1)
 507     lo<-layout.kamada.kawai(g1,dim=3)
 508     lo <- layout.norm(lo, -3, 3, -3, 3, -3, 3)
 509     mc<-rainbow(ncol(chistabletot))
 510     chitable<-chitable[order_chi[,2][1:lim],]
 511     cc <- apply(chitable, 1, which.max)
 512     cc<-mc[cc]
 513     #mass<-(rowSums(x)/max(rowSums(x))) * 5
 514     maxchi<-norm.vec(maxchi, 0.03, 0.3)
 515     rglplot(g1,vertex.label = vire.nonascii(rownames(x)),vertex.label.color= cc,vertex.label.cex = maxchi, vertex.size = 0.1, layout=lo, rescale=FALSE)
 516     text3d(lo[,1], lo[,2],lo[,3], rownames(x), cex=maxchi, col=cc)
 517     #rgl.spheres(lo, col = cc, radius = maxchi, alpha = alpha)
 518     rgl.bg(color = c('white','black'))
 519     if (!is.null(movie)) {
 520         require(tcltk)
 521         ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour commencer le film",icon="info",type="ok")
 522
 523         movie3d(spin3d(axis=c(0,1,0),rpm=6), movie = 'film_graph', frames = "tmpfilm", duration=10, clean=TRUE, top = TRUE, dir = movie)
 524         ReturnVal <- tkmessageBox(title="RGL 3 D",message="Film fini !",icon="info",type="ok")
 525     }
 526         while (rgl.cur() != 0)
 527                 Sys.sleep(1)
 528
 529 }
 530
 531 # from igraph
 532 norm.vec <- function(v, min, max) {
 533
 534   vr <- range(v)
 535   if (vr[1]==vr[2]) {
 536     fac <- 1
 537   } else {
 538     fac <- (max-min)/(vr[2]-vr[1])
 539   }
 540   (v-vr[1]) * fac + min
 541 }
 542
 543
 544 vire.nonascii <- function(rnames) {
 545     print('vire non ascii')
 546     couple <- list(c('é','e'),
 547                 c('è','e'),
 548                 c('ê','e'),
 549                 c('ë','e'),
 550                 c('î','i'),
 551                 c('ï','i'),
 552                 c('ì','i'),
 553                 c('à','a'),
 554                 c('â','a'),
 555                 c('ä','a'),
 556                 c('á','a'),
 557                 c('ù','u'),
 558                 c('û','u'),
 559                 c('ü','u'),
 560                 c('ç','c'),
 561                 c('ò','o'),
 562                 c('ô','o'),
 563                 c('ö','o'),
 564                 c('ñ','n')
 565                 )
 566
 567     for (c in couple) {
 568         rnames<-gsub(c[1],c[2], rnames)
 569     }
 570     rnames
 571 }
 572
 573
 574
 575 #par(mar=c(0,0,0,0))
 576 #layout(matrix(c(1,2),1,byrow=TRUE), widths=c(3,2),TRUE)
 577 #par(mar=c(1,0,1,0), cex=1)
 578 #plot.phylo(tree,label.offset=0.1)
 579 #par(mar=c(0,0,0,1))
 580 #to.plot <- sum.cl[cl.order,1]
 581 #d <- barplot(to.plot,horiz=TRUE, names.arg='', axes=FALSE, axisname=FALSE)
 582 #text(x=to.plot, y=d[,1], label=round(to.plot,1), adj=1.2)
 583