+
+merge.graph.proto <- function(graphs) {
+ library(colorspace)
+ ng <- graph.union(graphs, byname=T)
+ V.weight <- V(ng)$weight_1
+ E.weight <- E(ng)$weight_1
+ V.proto.color <- V(ng)$proto.color_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)
+ 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]
+
+ cw <- paste('proto.color_', i, sep='')
+ tocomp.col <- get.vertex.attribute(ng,cw)
+ which.sup <- which(resmax==2)
+ V.proto.color[totest[which.sup]] <- tocomp.col[totest[which.sup]]
+ V.proto.color[fr2] <- tocomp.col[fr2]
+
+ V.color[totest[which.sup]] <- cols[i]
+ 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)$proto.color <- V.proto.color
+ V(ng)$color <- V.proto.color
+ E(ng)$weight <- E.weight
+ V(ng)$ocolor <- V.color
+ 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
+}
+