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

diff --git a/Rscripts/simi.R b/Rscripts/simi.R
index a053259..2f22c3b 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, index.word=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,39 +166,69 @@ 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 (nd==2) {
+				library(sna)
+				library(intergraph)
+				lo <- gplot.layout.fruchtermanreingold(asNetwork(g.toplot), list())
+				detach("package:intergraph", unload=TRUE)
+				detach("package:sna", unload=TRUE)
+				detach("package:network", unload=TRUE)
+				library(igraph)
+			} else {
+				lo <- layout_with_fr(g.toplot,dim=nd)
+			}
+        }
+    	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)
+		if (layout.type == 'spirale')
+			lo <- spirale(g.toplot, E(g.toplot)$weight, index.word) 
+		if (layout.type == 'spirale3D')
+			lo <- spirale3D(g.toplot, E(g.toplot)$weight, index.word)
     } else {
         lo <- coords
     }
     if (!is.null(communities)) {
-        if (communities == 0 ){ #'edge.betweenness.community') {
+        if (communities == 0 ){ 
             com <- edge.betweenness.community(g.toplot)
         } else if (communities == 1) {
             com <- fastgreedy.community(g.toplot)
@@ -243,11 +273,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
@@ -341,6 +373,9 @@ plot.simi <- function(graph.simi, p.type = 'tkplot',filename=NULL, communities =
 	} else if (p.type == 'web') {
 		library(rgexf)
         graph.simi$label.cex <- label.cex
+		if (length(vertex.col)==1) {
+			vertex.col <- rep(vertex.col, length(v.label))
+		}
         graph.simi$color <- vertex.col
         label <- v.label
         nodes.attr <- data.frame(label)
@@ -415,30 +450,43 @@ saveAsGEXF = function(g, filepath="converted_graph.gexf")
 
 
 merge.graph <- function(graphs) {
+    library(colorspace)
     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))
+	print(cols)
     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]
+        #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] <- hex(mix.col)
+			#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])
@@ -452,5 +500,93 @@ merge.graph <- function(graphs) {
     V(ng)$weight <- V.weight
     V(ng)$color <- V.color
     E(ng)$weight <- E.weight
+	colors <- col2rgb(V(ng)$color)
+	V(ng)$r <- colors["red", ]
+	V(ng)$g <- colors["green", ]
+	V(ng)$b <- colors["blue", ]
     ng
 }
+
+spirale <- function(g, weigth, center, miny=0.1) {
+	ncoord <- matrix(0, nrow=length(weigth)+1, ncol=2)
+	v.names <- V(g)$name 
+	center.name <- v.names[center]
+	first <- which.max(weigth)[1]
+	if (head_of(g, first)$name == center.name) {
+		n.name <- tail_of(g, first)
+	} else {
+		n.name <- head_of(g, first)
+	}
+	n.name <- n.name$name
+	nb <- length(weigth)
+	ncoord[which(v.names==n.name),] <- c(0,1)
+	weigth[first] <- 0
+	rs <- norm.vec(weigth,1, miny)
+	nbt <- nb %/% 50
+	if (nbt == 0) nbt <- 1
+	angler <- ((360 * nbt) / (nb- 1)) * (pi/180)
+	ang <- 90 * (pi/180)
+	rr <- (1-miny) / (nb-1)
+	r <- 1
+	while (max(weigth != 0)) {
+		first <- which.max(weigth)[1]
+		if (head_of(g, first)$name == center.name) {
+			n.name <- tail_of(g, first)
+		} else {
+			n.name <- head_of(g, first)
+		}
+		n.name <- n.name$name
+		#r <- rs[first]
+		r <- r - rr
+		ang <- ang + angler 
+		x <- r * cos(ang)
+		y <- r * sin(ang)
+		weigth[first] <- 0
+		ncoord[which(v.names==n.name),] <- c(x,y)
+	}
+	ncoord
+}
+
+spirale3D <- function(g, weigth, center, miny=0.1) {
+	ncoord <- matrix(0, nrow=length(weigth)+1, ncol=3)
+	v.names <- V(g)$name 
+	center.name <- v.names[center]
+	first <- which.max(weigth)[1]
+	if (head_of(g, first)$name == center.name) {
+		n.name <- tail_of(g, first)
+	} else {
+		n.name <- head_of(g, first)
+	}
+	n.name <- n.name$name
+	nb <- length(weigth)
+	ncoord[which(v.names==n.name),] <- c(0,0,1)
+	weigth[first] <- 0
+	rs <- norm.vec(weigth,1, miny)
+	nbt <- nb %/% 50
+	if (nbt == 0) nbt <- 1
+	angler <- ((360 * nbt) / (nb- 1)) * (pi/180)
+	theta <- 0
+	phi <- 90 * (pi/180)
+	rr <- (1-miny) / (nb-1)
+	r <- 1
+	while (max(weigth != 0)) {
+		first <- which.max(weigth)[1]
+		if (head_of(g, first)$name == center.name) {
+			n.name <- tail_of(g, first)
+		} else {
+			n.name <- head_of(g, first)
+		}
+		n.name <- n.name$name
+		#r <- rs[first]
+		r <- r - rr
+		theta <- theta + angler
+		phi <- phi + angler/2
+		x <- r * sin(theta) * cos(phi)
+		y <- r * sin(theta) * sin(phi)
+		z <- r * cos(theta)
+		weigth[first] <- 0
+		ncoord[which(v.names==n.name),] <- c(x,y,z)
+	}
+	ncoord
+}
+