X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fsimi.R;h=48b871d4e42240ad78ad6d2937d6a89360cb3d5b;hp=29b0b2331a8fe4b45a6ca959b452d917259f4b20;hb=0e02f9566eb56fcb0f16bd070248235f78093ff5;hpb=adc24190c47d42d5fa02f074516fc331950d8c5c

diff --git a/Rscripts/simi.R b/Rscripts/simi.R
index 29b0b23..48b871d 100644
--- a/Rscripts/simi.R
+++ b/Rscripts/simi.R
@@ -143,7 +143,7 @@ do.simi <- function(x, method = 'cooc',seuil = NULL, p.type = 'tkplot',layout.ty
         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])
@@ -170,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
@@ -217,10 +219,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)) {
@@ -264,20 +266,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)
@@ -306,16 +309,18 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities =
     return(coords)
 	}
 	
-	if (p.type == 'rgl') {
+	if (p.type == 'rgl' || p.type == 'rglweb') {
 		library('rgl')
         #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)
         rgl.spheres(lo, col = vertex.col, radius = vertex.size/100, alpha = alpha)
-        rgl.bg(color = c('white','black'))
+        #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")
@@ -324,11 +329,18 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities =
             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)
 	}
 }
 
@@ -339,3 +351,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)
+}