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 select.chi.classe <- function(tablechi, nb) {
 187     rowkeep <- NULL
 188     for (i in 1:ncol(tablechi)) {
 189         rowkeep <- append(rowkeep,order(tablechi[,i], decreasing = TRUE)[1:nb])
 190     }
 191     rowkeep <- unique(rowkeep)
 192     rowkeep
 193 }
 194
 195 #from summary.ca
 196 summary.ca.dm <- function(object, scree = TRUE, ...){
 197   obj <- object
 198   nd  <- obj$nd
 199   if (is.na(nd)){
 200     nd <- 2
 201     } else {
 202     if (nd > length(obj$sv)) nd <- length(obj$sv)
 203     }
 204  # principal coordinates:
 205   K   <- nd
 206   I   <- dim(obj$rowcoord)[1] ; J <- dim(obj$colcoord)[1]
 207   svF <- matrix(rep(obj$sv[1:K], I), I, K, byrow = TRUE)
 208   svG <- matrix(rep(obj$sv[1:K], J), J, K, byrow = TRUE)
 209   rpc <- obj$rowcoord[,1:K] * svF
 210   cpc <- obj$colcoord[,1:K] * svG
 211
 212  # rows:
 213   r.names <- obj$rownames
 214   sr      <- obj$rowsup
 215   if (!is.na(sr[1])) r.names[sr] <- paste("(*)", r.names[sr], sep = "")
 216   r.mass <- obj$rowmass
 217   r.inr  <- obj$rowinertia / sum(obj$rowinertia, na.rm = TRUE)
 218   r.COR  <- matrix(NA, nrow = length(r.names), ncol = nd)
 219   colnames(r.COR) <- paste('COR -facteur', 1:nd, sep=' ')
 220   r.CTR  <- matrix(NA, nrow = length(r.names), ncol = nd)
 221   colnames(r.CTR) <- paste('CTR -facteur', 1:nd, sep=' ')
 222   for (i in 1:nd){
 223     r.COR[,i] <- obj$rowmass * rpc[,i]^2 / obj$rowinertia
 224     r.CTR[,i] <- obj$rowmass * rpc[,i]^2 / obj$sv[i]^2
 225     }
 226  # cor and quality for supplementary rows
 227   if (length(obj$rowsup) > 0){
 228     i0 <- obj$rowsup
 229     for (i in 1:nd){
 230       r.COR[i0,i] <- obj$rowmass[i0] * rpc[i0,i]^2
 231       r.CTR[i0,i] <- NA
 232     }
 233     }
 234
 235  # columns:
 236   c.names <- obj$colnames
 237   sc      <- obj$colsup
 238   if (!is.na(sc[1])) c.names[sc] <- paste("(*)", c.names[sc], sep = "")
 239   c.mass  <- obj$colmass
 240   c.inr   <- obj$colinertia / sum(obj$colinertia, na.rm = TRUE)
 241   c.COR   <- matrix(NA, nrow = length(c.names), ncol = nd)
 242   colnames(c.COR) <- paste('COR -facteur', 1:nd, sep=' ')
 243   c.CTR   <- matrix(NA, nrow = length(c.names), ncol = nd)
 244   colnames(c.CTR) <- paste('CTR -facteur', 1:nd, sep=' ')
 245   for (i in 1:nd)
 246     {
 247     c.COR[,i] <- obj$colmass * cpc[,i]^2 / obj$colinertia
 248     c.CTR[,i] <- obj$colmass * cpc[,i]^2 / obj$sv[i]^2
 249     }
 250   if (length(obj$colsup) > 0){
 251     i0 <- obj$colsup
 252     for (i in 1:nd){
 253       c.COR[i0,i] <- obj$colmass[i0] * cpc[i0,i]^2
 254       c.CTR[i0,i] <- NA
 255       }
 256     }
 257
 258  # scree plot:
 259   if (scree) {
 260     values     <- obj$sv^2
 261     values2    <- 100*(obj$sv^2)/sum(obj$sv^2)
 262     values3    <- cumsum(100*(obj$sv^2)/sum(obj$sv^2))
 263     scree.out  <- cbind(values, values2, values3)
 264     } else {
 265     scree.out <- NA
 266     }
 267
 268   obj$r.COR <- r.COR
 269   obj$r.CTR <- r.CTR
 270   obj$c.COR <- c.COR
 271   obj$c.CTR <- c.CTR
 272   obj$facteur <- scree.out
 273   return(obj)
 274   }
 275
 276 create_afc_table <- function(x) {
 277    #x = afc
 278         facteur.table <- as.matrix(x$facteur)
 279     nd <- ncol(x$colcoord)
 280         rownames(facteur.table) <- paste('facteur',1:nrow(facteur.table),sep = ' ')
 281     colnames(facteur.table) <- c('Valeurs propres', 'Pourcentages', 'Pourcentage cumules')
 282         ligne.table <- as.matrix(x$rowcoord)
 283         rownames(ligne.table) <- x$rownames
 284         colnames(ligne.table) <- paste('Coord. facteur', 1:nd, sep=' ')
 285     tmp <- as.matrix(x$rowcrl)
 286         colnames(tmp) <- paste('Corr. facteur', 1:nd, sep=' ')
 287         ligne.table <- cbind(ligne.table,tmp)
 288         ligne.table <- cbind(ligne.table, x$r.COR)
 289         ligne.table <- cbind(ligne.table, x$r.CTR)
 290         ligne.table <- cbind(ligne.table, mass = x$rowmass)
 291         ligne.table <- cbind(ligne.table, chi.distance = x$rowdist)
 292         ligne.table <- cbind(ligne.table, inertie = x$rowinertia)
 293     colonne.table <- x$colcoord
 294         rownames(colonne.table) <- paste('classe', 1:(nrow(colonne.table)),sep=' ')
 295         colnames(colonne.table) <- paste('Coord. facteur', 1:nd, sep=' ')
 296     tmp <- as.matrix(x$colcrl)
 297         colnames(tmp) <- paste('Corr. facteur', 1:nd, sep=' ')
 298         colonne.table <- cbind(colonne.table, tmp)
 299         colonne.table <- cbind(colonne.table, x$c.COR)
 300         colonne.table <- cbind(colonne.table, x$c.CTR)
 301         colonne.table <- cbind(colonne.table, mass = x$colmass)
 302         colonne.table <- cbind(colonne.table, chi.distance = x$coldist)
 303         colonne.table <- cbind(colonne.table, inertie = x$colinertia)
 304     res <- list(facteur = facteur.table, ligne = ligne.table, colonne = colonne.table)
 305         res
 306 }
 307
 308 make_afc_graph <- function(toplot, classes, clnb, xlab, ylab, cex.txt = NULL, leg = FALSE, cmd = FALSE, black = FALSE) {
 309         rain <- rainbow(clnb)
 310     compt <- 1
 311     tochange <- NULL
 312     for (my.color in rain) {
 313         my.color <- col2rgb(my.color)
 314         if ((my.color[1] > 200) & (my.color[2] > 200) & (my.color[3] < 20)) {
 315            tochange <- append(tochange, compt)
 316         }
 317         compt <- compt + 1
 318     }
 319     if (!is.null(tochange)) {
 320         gr.col <- grey.colors(length(tochange))
 321         compt <- 1
 322         for (val in tochange) {
 323             rain[val] <- gr.col[compt]
 324             compt <- compt + 1
 325         }
 326     }
 327         cl.color <- rain[classes]
 328     if (black) {
 329         cl.color <- 'black'
 330     }
 331         plot(toplot[,1],toplot[,2], pch='', xlab = xlab, ylab = ylab)
 332         abline(h=0, v=0, lty = 'dashed')
 333         if (is.null(cex.txt))
 334                 text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, offset=0)
 335         else
 336         text(toplot[,1],toplot[,2],rownames(toplot),col=cl.color, cex = cex.txt, offset=0)
 337
 338     if (!cmd) {
 339             dev.off()
 340     }
 341 }
 342
 343 plot.dendropr <- function(tree, classes, type.dendro="phylogram", histo=FALSE, from.cmd=FALSE, bw=FALSE, lab = NULL, tclasse=TRUE) {
 344         classes<-classes[classes!=0]
 345         classes<-as.factor(classes)
 346         sum.cl<-as.matrix(summary(classes))
 347         sum.cl<-(sum.cl/colSums(sum.cl)*100)
 348         sum.cl<-round(sum.cl,2)
 349         sum.cl<-cbind(sum.cl,as.matrix(100-sum.cl[,1]))
 350     tree.order<- as.numeric(tree$tip.label)
 351     if (! bw) {
 352         col = rainbow(nrow(sum.cl))[as.numeric(tree$tip.label)]
 353         col.bars <- col
 354         col.pie <- rainbow(nrow(sum.cl))
 355             #col.vec<-rainbow(nrow(sum.cl))[as.numeric(tree[[2]])]
 356     } else {
 357         col = 'black'
 358         col.bars = 'grey'
 359         col.pie <- rep('grey',nrow(sum.cl))
 360     }
 361         vec.mat<-NULL
 362         for (i in 1:nrow(sum.cl)) vec.mat<-append(vec.mat,1)
 363         v<-2
 364         for (i in 1:nrow(sum.cl)) {
 365                 vec.mat<-append(vec.mat,v)
 366                 v<-v+1
 367         }
 368         par(mar=c(0,0,0,0))
 369     if (tclasse) {
 370         if (! histo) {
 371                 layout(matrix(vec.mat,nrow(sum.cl),2),widths=c(3,1))
 372         } else {
 373             layout(matrix(c(1,2),1,byrow=TRUE), widths=c(3,2),TRUE)
 374         }
 375     }
 376         par(mar=c(0,0,0,0),cex=1)
 377         label.ori<-tree[[2]]
 378     if (!is.null(lab)) {
 379         tree$tip.label <- lab
 380     } else {
 381             tree[[2]]<-paste('classe ',tree[[2]])
 382     }
 383         plot.phylo(tree,label.offset=0.1,tip.col=col, type=type.dendro)
 384     #cl.order <- as.numeric(label.ori)
 385     #sum.cl[cl.order,1]
 386         #for (i in 1:nrow(sum.cl)) {
 387     if (tclasse) {
 388         if (! histo) {
 389             for (i in rev(tree.order)) {
 390                 par(mar=c(0,0,1,0),cex=0.7)
 391                     pie(sum.cl[i,],col=c(col.pie[i],'white'),radius = 1, labels='', clockwise=TRUE, main = paste('classe ',i,' - ',sum.cl[i,1],'%' ))
 392             }
 393         } else {
 394             par(cex=0.7)
 395             par(mar=c(0,0,0,1))
 396             to.plot <- sum.cl[tree.order,1]
 397             d <- barplot(to.plot,horiz=TRUE, col=col.bars, names.arg='', axes=FALSE, axisname=FALSE)
 398             text(x=to.plot, y=d[,1], label=paste(round(to.plot,1),'%'), adj=1.2)
 399         }
 400     }
 401     if (!from.cmd) dev.off()
 402         tree[[2]]<-label.ori
 403 }
 404 #tree <- tree.cut1$tree.cl
 405 #to.plot <- di
 406 plot.dendro.lex <- function(tree, to.plot, bw=FALSE, lab=NULL, lay.width=c(3,3,2), cmd=FALSE) {
 407     tree.order<- as.numeric(tree$tip.label)
 408     par(mar=c(0,0,0,0))
 409     layout(matrix(c(1,2,3),1,byrow=TRUE), widths=lay.width,TRUE)
 410         par(mar=c(3,0,2,0),cex=1)
 411         label.ori<-tree[[2]]
 412     if (!is.null(lab)) {
 413         tree$tip.label <- lab
 414     } else {
 415             tree[[2]]<-paste('classe ',tree[[2]])
 416     }
 417     to.plot <- matrix(to.plot[,tree.order], nrow=nrow(to.plot), dimnames=list(rownames(to.plot), colnames(to.plot)))
 418     if (!bw) {
 419         col <- rainbow(ncol(to.plot))
 420         col.bars <- rainbow(nrow(to.plot))
 421     } else {
 422         col <- 'black'
 423         col.bars <- grey.colors(nrow(to.plot),0,0.8)
 424     }
 425     col <- col[tree.order]
 426         plot.phylo(tree,label.offset=0.1,tip.col=col)
 427
 428     par(mar=c(3,0,2,1))
 429     d <- barplot(to.plot,horiz=TRUE, col=col.bars, beside=TRUE, names.arg='', space = c(0.1,0.6), axisname=FALSE)
 430     c <- colMeans(d)
 431     c1 <- c[-1]
 432     c2 <- c[-length(c)]
 433     cc <- cbind(c1,c2)
 434     lcoord <- apply(cc, 1, mean)
 435     abline(h=lcoord)
 436     if (min(to.plot) < 0) {
 437         amp <- abs(max(to.plot) - min(to.plot))
 438     } else {
 439         amp <- max(to.plot)
 440     }
 441     if (amp < 10) {
 442         d <- 2
 443     } else {
 444         d <- signif(amp%/%10,1)
 445     }
 446     mn <- round(min(to.plot))
 447     mx <- round(max(to.plot))
 448     for (i in mn:mx) {
 449         if ((i/d) == (i%/%d)) {
 450             abline(v=i,lty=3)
 451         }
 452     }
 453     par(mar=c(0,0,0,0))
 454     plot(0, axes = FALSE, pch = '')
 455     legend(x = 'center' , rownames(to.plot), fill = col.bars)
 456     if (!cmd) {
 457         dev.off()
 458     }
 459         tree[[2]]<-label.ori
 460 }
 461
 462 plot.alceste.graph <- function(rdata,nd=3,layout='fruke', chilim = 2) {
 463     load(rdata)
 464     if (is.null(debsup)) {
 465         tab.toplot<-afctable[1:(debet+1),]
 466         chitab<-chistabletot[1:(debet+1),]
 467     } else {
 468         tab.toplot<-afctable[1:(debsup+1),]
 469         chitab<-chistabletot[1:(debsup+1),]
 470     }
 471     rkeep<-select_point_chi(chitab,chilim)
 472     tab.toplot<-tab.toplot[rkeep,]
 473     chitab<-chitab[rkeep,]
 474     dm<-dist(tab.toplot,diag=TRUE,upper=TRUE)
 475     cn<-rownames(tab.toplot)
 476     cl.toplot<-apply(chitab,1,which.max)
 477     col<-rainbow(ncol(tab.toplot))[cl.toplot]
 478     library(igraph)
 479     g1 <- graph.adjacency(as.matrix(dm), mode = 'lower', weighted = TRUE)
 480     g.max<-minimum.spanning.tree(g1)
 481     we<-(rowSums(tab.toplot)/max(rowSums(tab.toplot)))*2
 482     #lo <- layout.fruchterman.reingold(g.max,dim=nd)
 483     lo<- layout.kamada.kawai(g.max,dim=nd)
 484     print(nrow(tab.toplot))
 485     print(nrow(chitab))
 486     print(length(we))
 487     print(length(col))
 488     print(length(cn))
 489     if (nd == 3) {
 490         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)
 491     } else if (nd == 2) {
 492         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)
 493     }
 494
 495 }
 496
 497 make.simi.afc <- function(x,chitable,lim=0, alpha = 0.1, movie = NULL) {
 498     library(igraph)
 499     chimax<-as.matrix(apply(chitable,1,max))
 500     chimax<-as.matrix(chimax[,1][1:nrow(x)])
 501     chimax<-cbind(chimax,1:nrow(x))
 502     order_chi<-as.matrix(chimax[order(chimax[,1],decreasing = TRUE),])
 503     if ((lim == 0) || (lim>nrow(x))) lim <- nrow(x)
 504     x<-x[order_chi[,2][1:lim],]
 505     maxchi <- chimax[order_chi[,2][1:lim],1]
 506     #-------------------------------------------------------
 507     limit<-nrow(x)
 508     distm<-dist(x,diag=TRUE)
 509     distm<-as.matrix(distm)
 510     g1<-graph.adjacency(distm,mode='lower',weighted=TRUE)
 511     g1<-minimum.spanning.tree(g1)
 512     lo<-layout.kamada.kawai(g1,dim=3)
 513     lo <- layout.norm(lo, -3, 3, -3, 3, -3, 3)
 514     mc<-rainbow(ncol(chistabletot))
 515     chitable<-chitable[order_chi[,2][1:lim],]
 516     cc <- apply(chitable, 1, which.max)
 517     cc<-mc[cc]
 518     #mass<-(rowSums(x)/max(rowSums(x))) * 5
 519     maxchi<-norm.vec(maxchi, 0.03, 0.3)
 520     rglplot(g1,vertex.label = vire.nonascii(rownames(x)),vertex.label.color= cc,vertex.label.cex = maxchi, vertex.size = 0.1, layout=lo, rescale=FALSE)
 521     text3d(lo[,1], lo[,2],lo[,3], rownames(x), cex=maxchi, col=cc)
 522     #rgl.spheres(lo, col = cc, radius = maxchi, alpha = alpha)
 523     rgl.bg(color = c('white','black'))
 524     if (!is.null(movie)) {
 525         require(tcltk)
 526         ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour commencer le film",icon="info",type="ok")
 527
 528         movie3d(spin3d(axis=c(0,1,0),rpm=6), movie = 'film_graph', frames = "tmpfilm", duration=10, clean=TRUE, top = TRUE, dir = movie)
 529         ReturnVal <- tkmessageBox(title="RGL 3 D",message="Film fini !",icon="info",type="ok")
 530     }
 531         while (rgl.cur() != 0)
 532                 Sys.sleep(1)
 533
 534 }
 535
 536 # from igraph
 537 norm.vec <- function(v, min, max) {
 538
 539   vr <- range(v)
 540   if (vr[1]==vr[2]) {
 541     fac <- 1
 542   } else {
 543     fac <- (max-min)/(vr[2]-vr[1])
 544   }
 545   (v-vr[1]) * fac + min
 546 }
 547
 548
 549 vire.nonascii <- function(rnames) {
 550     print('vire non ascii')
 551     couple <- list(c('é','e'),
 552                 c('è','e'),
 553                 c('ê','e'),
 554                 c('ë','e'),
 555                 c('î','i'),
 556                 c('ï','i'),
 557                 c('ì','i'),
 558                 c('à','a'),
 559                 c('â','a'),
 560                 c('ä','a'),
 561                 c('á','a'),
 562                 c('ù','u'),
 563                 c('û','u'),
 564                 c('ü','u'),
 565                 c('ç','c'),
 566                 c('ò','o'),
 567                 c('ô','o'),
 568                 c('ö','o'),
 569                 c('ñ','n')
 570                 )
 571
 572     for (c in couple) {
 573         rnames<-gsub(c[1],c[2], rnames)
 574     }
 575     rnames
 576 }
 577
 578
 579
 580 #par(mar=c(0,0,0,0))
 581 #layout(matrix(c(1,2),1,byrow=TRUE), widths=c(3,2),TRUE)
 582 #par(mar=c(1,0,1,0), cex=1)
 583 #plot.phylo(tree,label.offset=0.1)
 584 #par(mar=c(0,0,0,1))
 585 #to.plot <- sum.cl[cl.order,1]
 586 #d <- barplot(to.plot,horiz=TRUE, names.arg='', axes=FALSE, axisname=FALSE)
 587 #text(x=to.plot, y=d[,1], label=round(to.plot,1), adj=1.2)
 588