first import
[iramuteq] / 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