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