2 #############################################################
3 #a, b, c, and d are the counts of all (TRUE, TRUE), (TRUE, FALSE), (FALSE, TRUE), and (FALSE, FALSE)
4 # n <- a + b + c + d = nrow(x)
6 make.a <- function(x) {
11 make.b <- function(x) {
16 make.c <- function(x) {
21 make.d <- function(x, a, b, c) {
23 d <- ncol(x) - a - b - c
27 ###########################################
29 ###########################################
30 my.jaccard <- function(x) {
34 d <- make.d(x, a, b, c)
35 jac <- a / (a + b + c)
40 prcooc <- function(x, a) {
45 make.bin <- function(cs, a, i, j, nb) {
48 res <- binom.test(ab, nb, (cs[i]/nb) * (cs[j]/nb), "less")
53 #res <- binom.test(ab, nb, (cs[i]/nb) * (cs[j]/nb), "less")
57 binom.sim <- function(x) {
61 mat <- matrix(0,ncol(x),ncol(x))
62 colnames(mat)<-colnames(a)
63 rownames(mat)<-rownames(a)
64 for (i in 1:(ncol(x)-1)) {
65 for (j in (i+1):ncol(x)) {
66 mat[j,i] <- make.bin(cs, a, i, j , n)
74 ############################################
76 ############################################
77 # jaccard a, b, c a / (a + b + c)
78 # Kulczynski1 a, b, c a / (b + c)
79 # Kulczynski2 a, b, c [a / (a + b) + a / (a + c)] / 2
80 # Mountford a, b, c 2a / (ab + ac + 2bc)
81 # Fager, McGowan a, b, c a / sqrt((a + b)(a + c)) - 1 / 2 sqrt(a + c)
83 # Dice, Czekanowski, Sorensen a, b, c 2a / (2a + b + c)
84 # Mozley, Margalef a, b, c an / (a + b)(a + c)
85 # Ochiai a, b, c a / sqrt[(a + b)(a + c)]
86 # Simpson a, b, c a / min{(a + b), (a + c)}
87 # Braun-Blanquet a, b, c a / max{(a + b), (a + c)}
89 #simple matching, Sokal/Michener a, b, c, d, ((a + d) /n)
90 # Hamman, a, b, c, d, ([a + d] - [b + c]) / n
91 # Faith , a, b, c, d, (a + d/2) / n
92 # Tanimoto, Rogers a, b, c, d, (a + d) / (a + 2b + 2c + d)
93 # Phi a, b, c, d (ad - bc) / sqrt[(a + b)(c + d)(a + c)(b + d)]
94 # Stiles a, b, c, d log(n(|ad-bc| - 0.5n)^2 / [(a + b)(c + d)(a + c)(b + d)])
95 # Michael a, b, c, d 4(ad - bc) / [(a + d)^2 + (b + c)^2]
96 # Yule a, b, c, d (ad - bc) / (ad + bc)
97 # Yule2 a, b, c, d (sqrt(ad) - sqrt(bc)) / (sqrt(ad) + sqrt(bc))
99 BuildProf01<-function(x,classes) {
101 #classes : classes de chaque lignes de x
102 dm<-cbind(x,cl=classes)
103 clnb=length(summary(as.data.frame(as.character(classes)),max=100))
105 print(summary(as.data.frame(as.character(classes)),max=100))
106 mat<-matrix(0,ncol(x),clnb)
107 rownames(mat)<-colnames(x)
109 dtmp<-dm[which(dm$cl==i),]
110 for (j in 1:(ncol(dtmp)-1)) {
111 mat[j,i]<-sum(dtmp[,j])
117 do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.type = 'frutch', max.tree = TRUE, coeff.vertex=NULL, coeff.edge = NULL, minmaxeff=c(NULL,NULL), vcexminmax= c(NULL,NULL), cex = 1, coords = NULL, communities = NULL, halo = FALSE) {
120 v.label <- colnames(mat.simi)
121 g1<-graph.adjacency(mat.simi,mode="lower",weighted=TRUE)
123 weori<-get.edge.attribute(g1,'weight')
125 if (method == 'cooc') {
131 g.max<-minimum.spanning.tree(g1)
132 E(g.max)$weight<-1/E(g.max)$weight
136 if (!is.null(seuil)) {
138 if (seuil >= max(mat.simi)) seuil <- 0
140 w<-E(g.toplot)$weight
141 tovire <- which(w<=seuil)
142 g.toplot <- delete.edges(g.toplot,(tovire))
143 for (i in 0:(length(V(g.toplot)))) {
144 if (length(neighbors(g.toplot,i))==0) {
148 g.toplot <- delete.vertices(g.toplot,vec)
149 v.label <- V(g.toplot)$name
150 if (!is.logical(vec)) mat.eff <- mat.eff[-(vec)]
153 if (!is.null(minmaxeff[1])) {
154 eff<-norm.vec(mat.eff,minmaxeff[1],minmaxeff[2])
158 if (!is.null(vcexminmax[1])) {
159 label.cex = norm.vec(mat.eff, vcexminmax[1], vcexminmax[2])
163 if (!is.null(coeff.edge)) {
164 we.width <- norm.vec(abs(E(g.toplot)$weight), coeff.edge[1], coeff.edge[2])
165 #we.width <- abs((E(g.toplot)$weight/max(abs(E(g.toplot)$weight)))*coeff.edge)
169 if (method != 'binom') {
170 we.label <- round(E(g.toplot)$weight,1)
172 we.label <- round(E(g.toplot)$weight,3)
179 if (is.null(coords)) {
180 if (layout.type == 'frutch')
181 lo <- layout.fruchterman.reingold(g.toplot,dim=nd)#, weightsA=E(g.toplot)$weight)
182 if (layout.type == 'kawa')
183 lo <- layout.kamada.kawai(g.toplot,dim=nd)
184 if (layout.type == 'random')
185 lo <- layout.random(g.toplot,dim=nd)
186 if (layout.type == 'circle' & p.type != 'rgl')
187 lo <- layout.circle(g.toplot)
188 if (layout.type == 'circle' & p.type == 'rgl')
189 lo <- layout.sphere(g.toplot)
190 if (layout.type == 'graphopt')
191 lo <- layout.graphopt(g.toplot)
195 if (!is.null(communities)) {
196 if (communities == 0 ){ #'edge.betweenness.community') {
197 com <- edge.betweenness.community(g.toplot)
198 } else if (communities == 1) {
199 com <- fastgreedy.community(g.toplot)
200 } else if (communities == 2) {
201 com <- label.propagation.community(g.toplot)
202 } else if (communities == 3) {
203 com <- leading.eigenvector.community(g.toplot)
204 } else if (communities == 4) {
205 com <- multilevel.community(g.toplot)
206 } else if (communities == 5) {
207 com <- optimal.community(g.toplot)
208 } else if (communities == 6) {
209 com <- spinglass.community(g.toplot)
210 } else if (communities == 7) {
211 com <- walktrap.community(g.toplot)
217 out <- list(graph = g.toplot, mat.eff = mat.eff, eff = eff, mat = mat.simi, v.label = v.label, we.width = we.width, we.label=we.label, label.cex = label.cex, layout = lo, communities = com, halo = halo)
220 plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities = NULL, vertex.col = 'red', edge.col = 'black', edge.label = TRUE, vertex.label=TRUE, vertex.label.color = 'black', vertex.label.cex= NULL, vertex.size=NULL, leg=NULL, width = 800, height = 800, alpha = 0.1, cexalpha = FALSE, movie = NULL, svg = FALSE) {
221 mat.simi <- graph.simi$mat
222 g.toplot <- graph.simi$graph
223 if (is.null(vertex.size)) {
224 vertex.size <- graph.simi$eff
226 vertex.size <- vertex.size
228 we.width <- graph.simi$we.width
230 #v.label <- vire.nonascii(graph.simi$v.label)
231 v.label <- graph.simi$v.label
236 we.label <- graph.simi$we.label
240 lo <- graph.simi$layout
241 if (!is.null(vertex.label.cex)) {
242 label.cex<-vertex.label.cex
244 label.cex = graph.simi$label.cex
247 alphas <- norm.vec(label.cex, 0.5,1)
249 if (length(vertex.label.color) == 1) {
250 for (i in 1:length(alphas)) {
251 nvlc <- append(nvlc, adjustcolor(vertex.label.color, alpha=alphas[i]))
254 for (i in 1:length(alphas)) {
255 nvlc <- append(nvlc, adjustcolor(vertex.label.color[i], alpha=alphas[i]))
258 vertex.label.color <- nvlc
260 if (p.type=='nplot') {
261 #print('ATTENTION - PAS OPEN FILE')
262 open_file_graph(filename, width = width, height = height, svg = svg)
265 layout(matrix(c(1,2),1,2, byrow=TRUE),widths=c(3,lcm(7)))
269 if (is.null(graph.simi$com)) {
270 plot(g.toplot,vertex.label='', edge.width=we.width, vertex.size=vertex.size, vertex.color=vertex.col, vertex.label.color='white', edge.label=we.label, edge.label.cex=cex, edge.color=edge.col, vertex.label.cex = 0, layout=lo)#, rescale = FALSE)
272 com <- graph.simi$com
273 colm <- rainbow(length(com))
274 if (vertex.size != 0 || graph.simi$halo) {
275 vertex.label.color <- 'black'
276 vertex.col <- colm[membership(com)]
278 vertex.label.color <- colm[membership(com)]
280 if (graph.simi$halo) {
281 mark.groups <- communities(com)
285 plot(com, g.toplot,vertex.label='', edge.width=we.width, vertex.size=vertex.size, vertex.color=vertex.col, vertex.label.color='white', edge.label=we.label, edge.label.cex=cex, edge.color=edge.col, vertex.label.cex = 0, layout=lo, mark.groups = mark.groups)
288 txt.layout <- layout.norm(lo, -1, 1, -1, 1, -1, 1)
289 #txt.layout <- txt.layout[order(label.cex),]
290 #vertex.label.color <- vertex.label.color[order(label.cex)]
291 #v.label <- v.label[order(label.cex)]
292 #label.cex <- label.cex[order(label.cex)]
293 text(txt.layout[,1], txt.layout[,2], v.label, cex=label.cex, col=vertex.label.color)
296 plot(0, axes = FALSE, pch = '')
297 legend(x = 'center' , leg$unetoile, fill = leg$gcol)
302 if (p.type=='tkplot') {
303 id <- tkplot(g.toplot,vertex.label=v.label, edge.width=we.width, vertex.size=vertex.size, vertex.color=vertex.col, vertex.label.color=vertex.label.color, edge.label=we.label, edge.color=edge.col, layout=lo)
304 coords = tkplot.getcoords(id)
305 ok <- try(coords <- tkplot.getcoords(id), TRUE)
306 while (is.matrix(ok)) {
307 ok <- try(coords <- tkplot.getcoords(id), TRUE)
314 if (p.type == 'rgl') {
318 rglplot(g.toplot,vertex.label= vire.nonascii(v.label), edge.width=we.width/10, vertex.size=0.01, vertex.color=vertex.col, vertex.label.color="black", edge.color = edge.col, layout=lo)
319 los <- layout.norm(lo, -1, 1, -1, 1, -1, 1)
320 rgl.spheres(los, col = vertex.col, radius = vertex.size/100, alpha = alpha)
321 rgl.bg(color = c('white','black'))
322 if (!is.null(movie)) {
324 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour commencer le film",icon="info",type="ok")
326 movie3d(spin3d(axis=c(0,1,0),rpm=6), movie = 'film_graph', frames = "tmpfilm", duration=10, clean=TRUE, top = TRUE, dir = movie)
327 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Film fini !",icon="info",type="ok")
329 #play3d(spin3d(axis=c(0,1,0),rpm=6))
331 ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok")
333 # while (rgl.cur() != 0)
339 graph.word <- function(mat.simi, index) {
340 nm <- matrix(0, ncol = ncol(mat.simi), nrow=nrow(mat.simi), dimnames=list(row.names(mat.simi), colnames(mat.simi)))
341 nm[,index] <- mat.simi[,index]
342 nm[index,] <- mat.simi[index,]
345 # if (cs) nm <- nm[,-which(cs==0)]
347 # if (rs) nm <- nm[-which(rs==0),]