X-Git-Url: http://iramuteq.org/git?p=iramuteq;a=blobdiff_plain;f=Rscripts%2Fsimi.R;h=a053259ee62f6bcc5f416aabd25705c060b95f0e;hp=2564e2e6c116c0d99aa2ad8f2829b17d32e89246;hb=de084e03e04d6448a448fe5b2e1d2d6e06b994d9;hpb=b88ae24b0e45f690eca1ffd04c7336c6641982ec

diff --git a/Rscripts/simi.R b/Rscripts/simi.R
index 2564e2e..a053259 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,7 +172,7 @@ 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)
     }
@@ -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)
@@ -311,6 +314,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 +340,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 +412,45 @@ saveAsGEXF = function(g, filepath="converted_graph.gexf")
   
   print(output, filepath, replace=T)
 }
+
+
+merge.graph <- function(graphs) {
+    ng <- graph.union(graphs, byname=T)
+    print(list.vertex.attributes(ng))
+    V.weight <- V(ng)$weight_1 
+    E.weight <- E(ng)$weight_1
+    cols <- rainbow(length(graphs))
+    V.color <- rep(cols[1], length(V.weight))
+    print(cbind(V(ng)$name, V.weight, V.color))
+    for (i in 2:length(graphs)) {
+        print(i)
+        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])
+        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
+}