+make.afc.attributes <- function(rn, afc.table, contafc, clnb, column = FALSE, x=1, y=2) {
+ if (!column){
+ nd <- clnb - 1
+ afc.res <- afc.table$ligne
+ #tokeep <- which(row.names(afc.res) %in% rn)
+ afc.res <- afc.res[rn,]
+ debcor <- (nd*2) + 1
+ cor <- afc.res[,debcor:(debcor+nd-1)][,c(x,y)]
+ debctr <- (nd*3) + 1
+ ctr <- afc.res[,debctr:(debctr+nd-1)][,c(x,y)]
+ massdeb <- (nd*4) + 1
+ mass <- afc.res[,massdeb]
+ chideb <- massdeb + 1
+ chi <- afc.res[,chideb]
+ inertiadeb <- chideb + 1
+ inertia <- afc.res[,inertiadeb]
+ frequence <- rowSums(contafc[rn,])
+ }
+ res <- list(frequence=frequence, cor, ctr, mass = mass, chi=chi, inertia=inertia)
+ return(res)
+}
+
+
+afctogexf <- function(fileout, toplot, classes, clnb, sizes, nodes.attr=NULL) {
+ toplot <- toplot[,1:3]
+ toplot[,3] <- 0
+ #toplot <- afc$rowcoord[1:100,1:3]
+ #toplot[,3] <- 0
+ #rownames(toplot)<-afc$rownames[1:100]
+ cc <- rainbow(clnb)[classes]
+ cc <- t(sapply(cc, col2rgb, alpha=TRUE))
+ #sizes <- apply(chistabletot[1:100,], 1, max)
+
+ nodes <- data.frame(cbind(1:nrow(toplot), rownames(toplot)))
+ colnames(nodes) <- c('id', 'label')
+ nodes[,1] <- as.character(nodes[,1])
+ nodes[,2] <- as.character(nodes[,2])
+ #nodes attributs
+ if (! is.null(nodes.attr)) {
+ nodesatt <- as.data.frame(nodes.attr)
+ } else {
+ nodesatt <- data.frame(cbind(toplot[,1],toplot[,2]))
+ }
+ #make axes
+ edges<-matrix(c(1,1),ncol=2)
+ xmin <- min(toplot[,1])
+ xmax <- max(toplot[,1])
+ ymin <- min(toplot[,2])
+ ymax <- max(toplot[,2])
+ nodes<-rbind(nodes, c(nrow(nodes)+1, 'F1'))
+ nodes<-rbind(nodes, c(nrow(nodes)+1, 'F1'))
+ nodes<-rbind(nodes, c(nrow(nodes)+1, 'F2'))
+ nodes<-rbind(nodes, c(nrow(nodes)+1, 'F2'))
+ nodesatt<-rbind(nodesatt, c(0,0))
+ nodesatt<-rbind(nodesatt, c(0,0))
+ nodesatt<-rbind(nodesatt, c(0,0))
+ nodesatt<-rbind(nodesatt, c(0,0))
+ toplot <- rbind(toplot, c(xmin, 0,0))
+ toplot <- rbind(toplot, c(xmax,0,0))
+ toplot <- rbind(toplot, c(0,ymin,0))
+ toplot <- rbind(toplot, c(0,ymax,0))
+ cc <- rbind(cc, c(255,255,255,1))
+ cc <- rbind(cc, c(255,255,255,1))
+ cc <- rbind(cc, c(255,255,255,1))
+ cc <- rbind(cc, c(255,255,255,1))
+ sizes <- c(sizes, c(0.5, 0.5, 0.5, 0.5))
+ edges <- rbind(edges, c(nrow(nodes)-3, nrow(nodes)-2))
+ edges <- rbind(edges, c(nrow(nodes)-1, nrow(nodes)))
+ write.gexf(nodes, edges, output=fileout, nodesAtt=nodesatt, nodesVizAtt=list(color=cc, position=toplot, size=sizes))
+}
+
+simi.to.gexf <- function(fileout, graph.simi, nodes.attr = NULL) {
+ lo <- graph.simi$layout
+ if (ncol(lo) == 3) {
+ lo[,3] <- 0
+ } else {
+ lo <- cbind(lo, rep(0,nrow(lo)))
+ }
+ g <- graph.simi$graph
+ nodes <- data.frame(cbind(1:nrow(lo), V(g)$name))
+ colnames(nodes) <- c('id', 'label')
+ if (! is.null(nodes.attr)) {
+ nodesatt <- as.data.frame(nodes.attr)
+ } else {
+ nodesatt <- data.frame(cbind(lo[,1],lo[,2]))
+ }
+ edges <- as.data.frame(get.edges(g, c(1:ecount(g))))
+ col <- graph.simi$color
+ col <- t(sapply(col, col2rgb, alpha=TRUE))
+ write.gexf(nodes, edges, output=fileout, nodesAtt=nodesatt, nodesVizAtt=list(color=col,position=lo, size=graph.simi$label.cex), edgesVizAtt=list(size=graph.simi$we.width))
+}
+
+graphml.to.file <- function(graph.path) {
+ library(igraph)
+ g <- read.graph(graph.path, format='graphml')
+ layout <- layout.fruchterman.reingold(g, dim=3)
+ #print(V(g)$color)
+ graph.simi <- list(graph=g, layout=layout, color = V(g)$color ,eff=V(g)$weight)
+ graph.simi
+}
+
+
+
+graph.to.file <- function(graph.simi, nodesfile = NULL, edgesfile = NULL, community = FALSE, color = NULL, sweight = NULL) {
+ require(igraph)
+ g <- graph.simi$graph
+ print(graph.simi$eff)
+ if (!is.null(graph.simi$eff)) {
+ V(g)$weight <- graph.simi$eff
+ } else {
+ V(g)$weight <- graph.simi$label.cex
+ }
+ V(g)$x <- graph.simi$layout[,1]
+ V(g)$y <- graph.simi$layout[,2]
+ if (ncol(graph.simi$layout) == 3) {
+ V(g)$z <- graph.simi$layout[,3]
+ }
+ if (community) {
+ member <- graph.simi$communities$membership
+ col <- rainbow(max(member))
+ v.colors <- col[member]
+ v.colors <- col2rgb(v.colors)
+ V(g)$r <- v.colors[1,]
+ V(g)$g <- v.colors[2,]
+ V(g)$b <- v.colors[3,]
+ }
+ if (!is.null(color)) {
+ v.colors <- col2rgb(color)
+ V(g)$r <- v.colors[1,]
+ V(g)$g <- v.colors[2,]
+ V(g)$b <- v.colors[3,]
+ }
+ if (!is.null(sweight)) {
+ V(g)$sweight <- sweight
+ }
+ df <- get.data.frame(g, what='both')
+ if (!is.null(nodesfile)) {
+ write.table(df$vertices, nodesfile, sep='\t', row.names=FALSE)
+ }
+ if (!is.null(edgesfile)) {
+ write.table(df$edges, edgesfile, sep='\t', row.names=FALSE)
+ }
+ if (is.null(edgesfile) & is.null(nodesfile)) {
+ df
+ }
+}
+
+graph.to.file2 <- function(graph, layout, nodesfile = NULL, edgesfile = NULL, community = FALSE, color = NULL, sweight = NULL) {
+ require(igraph)
+ g <- graph
+ V(g)$x <- layout[,1]
+ V(g)$y <- layout[,2]
+ if (ncol(layout) == 3) {
+ V(g)$z <- layout[,3]
+ }
+ v.colors <- col2rgb(V(g)$color)
+ V(g)$r <- v.colors[1,]
+ V(g)$g <- v.colors[2,]
+ V(g)$b <- v.colors[3,]
+
+ if (!is.null(sweight)) {
+ V(g)$sweight <- sweight
+ }
+ df <- get.data.frame(g, what='both')
+ if (!is.null(nodesfile)) {
+ write.table(df$vertices, nodesfile, sep='\t', row.names=FALSE)
+ }
+ if (!is.null(edgesfile)) {
+ write.table(df$edges, edgesfile, sep='\t', row.names=FALSE)
+ }
+ if (is.null(edgesfile) & is.null(nodesfile)) {
+ df
+ }
+}
+