X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fsimi.R;h=0439a3b5dc1de84a9d7529d2d6b76c29b5a99bba;hp=bd772c298e0de7bee610eda32e38bb2fb0b9ad50;hb=ed43a2036c36b4146a957ae2ba893e80b3c14342;hpb=3337f787ca0fe81614a3957d8fe332a7d44a14bc diff --git a/Rscripts/simi.R b/Rscripts/simi.R index bd772c2..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,7 +138,7 @@ 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) @@ -166,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,2) - } 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 } @@ -222,7 +237,7 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty 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, edge.curved = TRUE, 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)) { @@ -243,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 @@ -266,6 +283,7 @@ 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)) @@ -339,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) } } @@ -407,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 +}