X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fsimi.R;h=0439a3b5dc1de84a9d7529d2d6b76c29b5a99bba;hp=2564e2e6c116c0d99aa2ad8f2829b17d32e89246;hb=ed43a2036c36b4146a957ae2ba893e80b3c14342;hpb=b88ae24b0e45f690eca1ffd04c7336c6641982ec diff --git a/Rscripts/simi.R b/Rscripts/simi.R index 2564e2e..0439a3b 100644 --- a/Rscripts/simi.R +++ b/Rscripts/simi.R @@ -31,7 +31,7 @@ my.jaccard <- function(x) { a <- make.a(x) b <- make.b(x) c <- make.c(x) - d <- make.d(x, a, b, c) + #d <- make.d(x, a, b, c) jac <- a / (a + b + c) jac } @@ -114,7 +114,7 @@ BuildProf01<-function(x,classes) { mat } -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) { +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, fromcoords=NULL, forvertex=NULL) { mat.simi <- x$mat mat.eff <- x$eff v.label <- colnames(mat.simi) @@ -138,12 +138,12 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty } if (!is.null(seuil)) { - if (seuil >= max(mat.simi)) seuil <- 0 + if (seuil >= max(mat.simi)) seuil <- -Inf vec<-vector() w<-E(g.toplot)$weight tovire <- which(w<=seuil) g.toplot <- delete.edges(g.toplot,(tovire)) - for (i in 0:(length(V(g.toplot)))) { + for (i in 1:(length(V(g.toplot)))) { if (length(neighbors(g.toplot,i))==0) { vec<-append(vec,i) } @@ -151,7 +151,9 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty g.toplot <- delete.vertices(g.toplot,vec) v.label <- V(g.toplot)$name if (!is.logical(vec)) mat.eff <- mat.eff[-(vec)] - } + } else { + vec <- NULL + } if (!is.null(minmaxeff[1])) { eff<-norm.vec(mat.eff,minmaxeff[1],minmaxeff[2]) @@ -164,34 +166,49 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty label.cex = cex } if (!is.null(coeff.edge)) { + #FIXME we.width <- norm.vec(abs(E(g.toplot)$weight), coeff.edge[1], coeff.edge[2]) #we.width <- abs((E(g.toplot)$weight/max(abs(E(g.toplot)$weight)))*coeff.edge) } else { we.width <- NULL } if (method != 'binom') { - we.label <- round(E(g.toplot)$weight,1) - } else { we.label <- round(E(g.toplot)$weight,3) + } else { + we.label <- round(E(g.toplot)$weight,4) } if (p.type=='rgl' || p.type=='rglweb') { nd<-3 } else { nd<-2 } + if (! is.null(fromcoords)) { + newfrom <- matrix(runif(nd*length(V(g.toplot)$name),min(fromcoords)),max(fromcoords),ncol=nd, nrow=length(V(g.toplot)$name)) + for (i in 1:length(V(g.toplot)$name)) { + if(V(g.toplot)$name[i] %in% forvertex) { + newfrom[i,] <- fromcoords[which(forvertex==V(g.toplot)$name[i]),] + } + } + fromcoords <- newfrom + } + #print(layout.type) if (is.null(coords)) { - if (layout.type == 'frutch') - lo <- layout.fruchterman.reingold(g.toplot,dim=nd)#, weightsA=E(g.toplot)$weight) - if (layout.type == 'kawa') - lo <- layout.kamada.kawai(g.toplot,dim=nd) + if (layout.type == 'frutch') { + #lo <- layout_with_drl(g.toplot,dim=nd) + lo <- layout_with_fr(g.toplot,dim=nd, grid="grid", niter=10000, weights=1/E(g.toplot)$weight)#, start.temp = 1)#, ) + } + if (layout.type == 'kawa') { + lo <- layout_with_kk(g.toplot,dim=nd, weights=1/E(g.toplot)$weight, start=fromcoords, epsilon=0, maxiter = 10000) + #print(lo) + } if (layout.type == 'random') - lo <- layout.random(g.toplot,dim=nd) + lo <- layout_on_grid(g.toplot,dim=nd) if (layout.type == 'circle' & p.type != 'rgl') - lo <- layout.circle(g.toplot) + lo <- layout_in_circle(g.toplot) if (layout.type == 'circle' & p.type == 'rgl') - lo <- layout.sphere(g.toplot) + lo <- layout_on_sphere(g.toplot) if (layout.type == 'graphopt') - lo <- layout.graphopt(g.toplot) + lo <- layout_as_tree(g.toplot, circular = TRUE) } else { lo <- coords } @@ -217,10 +234,10 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty com <- NULL } - 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) + 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, elim=vec) } -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) { +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, edge.curved = TRUE, svg = FALSE, bg='white') { mat.simi <- graph.simi$mat g.toplot <- graph.simi$graph if (is.null(vertex.size)) { @@ -241,11 +258,13 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities = we.label <- NA } lo <- graph.simi$layout + #rownames(lo) <- v.label if (!is.null(vertex.label.cex)) { label.cex<-vertex.label.cex } else { label.cex = graph.simi$label.cex } + if (cexalpha) { alphas <- norm.vec(label.cex, 0.5,1) nvlc <- NULL @@ -264,20 +283,21 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities = #print('ATTENTION - PAS OPEN FILE') open_file_graph(filename, width = width, height = height, svg = svg) par(mar=c(2,2,2,2)) + par(bg=bg) if (!is.null(leg)) { layout(matrix(c(1,2),1,2, byrow=TRUE),widths=c(3,lcm(7))) par(mar=c(2,2,1,0)) } par(pch=' ') if (is.null(graph.simi$com)) { - 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) + 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, edge.curved=edge.curved)#, rescale = FALSE) } else { if (graph.simi$halo) { mark.groups <- communities(graph.simi$com) } else { mark.groups <- NULL } - 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) + 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, edge.curved=edge.curved) } #txt.layout <- lo txt.layout <- layout.norm(lo, -1, 1, -1, 1, -1, 1) @@ -311,6 +331,7 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities = #rgl.open() #par3d(cex=0.8) lo <- layout.norm(lo, -10, 10, -10, 10, -10, 10) + bg3d('white') rglplot(g.toplot,vertex.label='', edge.width=we.width/10, vertex.size=0.01, vertex.color=vertex.col, vertex.label.color="black", edge.color = edge.col, layout=lo, rescale = FALSE) #los <- layout.norm(lo, -1, 1, -1, 1, -1, 1) text3d(lo[,1], lo[,2], lo[,3], vire.nonascii(v.label), col = vertex.label.color, alpha = 1, cex = vertex.label.cex) @@ -336,7 +357,11 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities = # Sys.sleep(0.5) } else if (p.type == 'web') { library(rgexf) - simi.to.gexf(filename, graph.simi, nodes.attr = NULL) + graph.simi$label.cex <- label.cex + graph.simi$color <- vertex.col + label <- v.label + nodes.attr <- data.frame(label) + simi.to.gexf(filename, graph.simi, nodes.attr = nodes.attr) } } @@ -404,3 +429,56 @@ saveAsGEXF = function(g, filepath="converted_graph.gexf") print(output, filepath, replace=T) } + + +merge.graph <- function(graphs) { + library(colorspace) + ng <- graph.union(graphs, byname=T) + V.weight <- V(ng)$weight_1 + E.weight <- E(ng)$weight_1 + cols <- rainbow(length(graphs)) + V.color <- rep(cols[1], length(V.weight)) + for (i in 2:length(graphs)) { + tw <- paste('weight_', i, sep='') + tocomp <- get.vertex.attribute(ng,tw) + totest <- intersect(which(!is.na(V.weight)), which(!is.na(tocomp))) + maxmat <- cbind(V.weight[totest], tocomp[totest]) + resmax <- apply(maxmat, 1, which.max) + ncolor <- c(cols[(i-1)], cols[i]) + #rbgcol1 <- col2rgb(cols[(i-1)]) + #rbgcol1 <- rbgcol1/255 + #rgbcol1 <- RGB(rbgcol1[1],rbgcol1[2],rbgcol1[3]) + rbgcol2 <- col2rgb(cols[i]) + rbgcol2 <- rbgcol2/255 + #rgbcol2 <- RGB(rbgcol2[1],rbgcol2[2],rbgcol2[3]) + for (j in totest) { + alpha <- tocomp[j] /(V.weight[j] + tocomp[j]) + rbgcol1 <- col2rgb(V.color[j]) + rbgcol1 <- rbgcol1/255 + #mix.col <- mixcolor(alpha,rbgcol1, rbgcol2) + mix.col <- mixcolor(alpha, RGB(rbgcol1[1],rbgcol1[2],rbgcol1[3]), RGB(rbgcol2[1],rbgcol2[2],rbgcol2[3])) + V.color[j] <- adjustcolor(hex(mix.col), 0.6) + } + #to.change <- totest[which(resmax == 2)] + #V.color[to.change] <- cols[i] + V.weight[totest] <- apply(maxmat, 1, max) + nas <- which(is.na(V.weight)) + nas2 <- which(is.na(tocomp)) + fr2 <- setdiff(nas,nas2) + V.weight[fr2] <- tocomp[fr2] + V.color[fr2] <- cols[i] + tocomp <- get.edge.attribute(ng, tw) + totest <- intersect(which(!is.na(E.weight)), which(!is.na(tocomp))) + maxmat <- cbind(E.weight[totest], tocomp[totest]) + resmax <- apply(maxmat, 1, which.max) + E.weight[totest] <- apply(maxmat, 1, max) + nas <- which(is.na(E.weight)) + nas2 <- which(is.na(tocomp)) + fr2 <- setdiff(nas,nas2) + E.weight[fr2] <- tocomp[fr2] + } + V(ng)$weight <- V.weight + V(ng)$color <- V.color + E(ng)$weight <- E.weight + ng +}