X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fsimi.R;h=bd772c298e0de7bee610eda32e38bb2fb0b9ad50;hp=98bacf7a50c3db6ac68d39a006704ed139f5a4e1;hb=f12da65c1895ecdd1b48109d7b1334181487a25f;hpb=9fbe978a9b2734bd17d10721a44016cc0ac97153 diff --git a/Rscripts/simi.R b/Rscripts/simi.R index 98bacf7..bd772c2 100644 --- a/Rscripts/simi.R +++ b/Rscripts/simi.R @@ -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) { +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) { mat.simi <- x$mat mat.eff <- x$eff v.label <- colnames(mat.simi) @@ -122,28 +122,38 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty g.toplot<-g1 weori<-get.edge.attribute(g1,'weight') if (max.tree) { - invw<-1/weori + if (method == 'cooc') { + invw <- 1 / weori + } else { + invw <- 1 - weori + } E(g1)$weight<-invw g.max<-minimum.spanning.tree(g1) - E(g.max)$weight<-1/E(g.max)$weight + if (method == 'cooc') { + E(g.max)$weight<-1 / E(g.max)$weight + } else { + E(g.max)$weight<-1 - E(g.max)$weight + } g.toplot<-g.max } if (!is.null(seuil)) { - if (seuil >= max(mat.simi)) seuil <- max(mat.simi)-1 + if (seuil >= max(mat.simi)) seuil <- 0 vec<-vector() w<-E(g.toplot)$weight tovire <- which(w<=seuil) - g.toplot <- delete.edges(g.toplot,(tovire-1)) - for (i in 0:(length(V(g.toplot))-1)) { + g.toplot <- delete.edges(g.toplot,(tovire)) + for (i in 1:(length(V(g.toplot)))) { if (length(neighbors(g.toplot,i))==0) { vec<-append(vec,i) } } g.toplot <- delete.vertices(g.toplot,vec) v.label <- V(g.toplot)$name - if (!is.logical(vec)) mat.eff <- mat.eff[-(vec+1)] - } + 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]) @@ -162,11 +172,11 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty we.width <- NULL } if (method != 'binom') { - we.label <- round(E(g.toplot)$weight,1) + we.label <- round(E(g.toplot)$weight,2) } else { we.label <- round(E(g.toplot)$weight,3) } - if (p.type=='rgl') { + if (p.type=='rgl' || p.type=='rglweb') { nd<-3 } else { nd<-2 @@ -187,10 +197,32 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty } else { lo <- coords } - 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) + if (!is.null(communities)) { + if (communities == 0 ){ #'edge.betweenness.community') { + com <- edge.betweenness.community(g.toplot) + } else if (communities == 1) { + com <- fastgreedy.community(g.toplot) + } else if (communities == 2) { + com <- label.propagation.community(g.toplot) + } else if (communities == 3) { + com <- leading.eigenvector.community(g.toplot) + } else if (communities == 4) { + com <- multilevel.community(g.toplot) + } else if (communities == 5) { + com <- optimal.community(g.toplot) + } else if (communities == 6) { + com <- spinglass.community(g.toplot) + } else if (communities == 7) { + com <- walktrap.community(g.toplot) + } + } else { + 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, elim=vec) } -plot.simi <- function(graph.simi, p.type = 'tkplot',filename=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) { +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) { mat.simi <- graph.simi$mat g.toplot <- graph.simi$graph if (is.null(vertex.size)) { @@ -232,14 +264,23 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, vertex.col = } if (p.type=='nplot') { #print('ATTENTION - PAS OPEN FILE') - open_file_graph(filename, width = width, height = height) + open_file_graph(filename, width = width, height = height, svg = svg) par(mar=c(2,2,2,2)) 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=' ') - 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) + 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, 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, edge.curved=edge.curved) + } #txt.layout <- lo txt.layout <- layout.norm(lo, -1, 1, -1, 1, -1, 1) #txt.layout <- txt.layout[order(label.cex),] @@ -267,14 +308,18 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, vertex.col = return(coords) } - if (p.type == 'rgl') { + if (p.type == 'rgl' || p.type == 'rglweb') { library('rgl') #rgl.open() #par3d(cex=0.8) - 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) - los <- layout.norm(lo, -1, 1, -1, 1, -1, 1) - rgl.spheres(los, col = vertex.col, radius = vertex.size/100, alpha = alpha) - rgl.bg(color = c('white','black')) + 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) + rgl.spheres(lo, col = vertex.col, radius = vertex.size/100, alpha = alpha) + #rgl.bg(color = c('white','black')) + #bg3d('white') if (!is.null(movie)) { require(tcltk) ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour commencer le film",icon="info",type="ok") @@ -283,11 +328,18 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, vertex.col = ReturnVal <- tkmessageBox(title="RGL 3 D",message="Film fini !",icon="info",type="ok") } #play3d(spin3d(axis=c(0,1,0),rpm=6)) - require(tcltk) - ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok") + if (p.type == 'rglweb') { + writeWebGL(dir = filename, width = width, height= height) + } else { + require(tcltk) + ReturnVal <- tkmessageBox(title="RGL 3 D",message="Cliquez pour fermer",icon="info",type="ok") + } rgl.close() # while (rgl.cur() != 0) # Sys.sleep(0.5) + } else if (p.type == 'web') { + library(rgexf) + simi.to.gexf(filename, graph.simi, nodes.attr = NULL) } } @@ -298,3 +350,60 @@ graph.word <- function(mat.simi, index) { nm[index,] <- mat.simi[index,] nm } + +#from : +#http://gopalakrishna.palem.in/iGraphExport.html#GexfExport +# Converts the given igraph object to GEXF format and saves it at the given filepath location +# g: input igraph object to be converted to gexf format +# filepath: file location where the output gexf file should be saved +# +saveAsGEXF = function(g, filepath="converted_graph.gexf") +{ + require(igraph) + require(rgexf) + + # gexf nodes require two column data frame (id, label) + # check if the input vertices has label already present + # if not, just have the ids themselves as the label + if(is.null(V(g)$label)) + V(g)$label <- as.character(V(g)) + + # similarily if edges does not have weight, add default 1 weight + if(is.null(E(g)$weight)) + E(g)$weight <- rep.int(1, ecount(g)) + + nodes <- data.frame(cbind(1:vcount(g), V(g)$label)) + nodes[,1] <- as.character(nodes[,1]) + nodes[,2] <- as.character(nodes[,2]) + edges <- t(Vectorize(get.edge, vectorize.args='id')(g, 1:ecount(g))) + + # combine all node attributes into a matrix (and take care of & for xml) + vAttrNames <- setdiff(list.vertex.attributes(g), "label") + for (val in c("x","y","color")) { + vAttrNames <- setdiff(vAttrNames, val) + } + nodesAtt <- data.frame(sapply(vAttrNames, function(attr) sub("&", "&",get.vertex.attribute(g, attr)))) + for (i in 1:ncol(nodesAtt)) { + nodesAtt[,i] <- as.character(nodesAtt[,i]) + } + + # combine all edge attributes into a matrix (and take care of & for xml) + eAttrNames <- setdiff(list.edge.attributes(g), "weight") + edgesAtt <- data.frame(sapply(eAttrNames, function(attr) sub("&", "&",get.edge.attribute(g, attr)))) + + # combine all graph attributes into a meta-data + graphAtt <- sapply(list.graph.attributes(g), function(attr) sub("&", "&",get.graph.attribute(g, attr))) + ll <- length(V(g)$x) + cc <- t(sapply(V(g)$color, col2rgb, alpha=TRUE)) + cc[,4] <- cc[,4]/255 + # generate the gexf object + output <- write.gexf(nodes, edges, + edgesWeight=E(g)$weight, + edgesAtt = edgesAtt, + #edgesVizAtt = list(size=as.matrix(E(g)$weight)), + nodesAtt = nodesAtt, + nodesVizAtt=list(color=cc, position=cbind(V(g)$x,V(g)$y, rep(0,ll)), size=V(g)$weight), + meta=c(list(creator="iramuteq", description="igraph -> gexf converted file", keywords="igraph, gexf, R, rgexf"), graphAtt)) + + print(output, filepath, replace=T) +}