### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ### A layout function for a splicing graph represented as an igraph object.

 ###
 
 ### Experimental. Not ready yet!

 layout.sgraph <- function(graph)

 {
     ## Compute the 'x' col.
     vertices <- get.data.frame(graph, what="vertices")
     nodes <- vertices$name
     nnodes <- length(nodes)
     if (!identical(nodes[c(1L, nnodes)], c("R", "L")))
         stop("first and last nodes are expected to be \"R\" and \"L\", ",
              "respectively")
     max_SSid <- graph$max_SSid
     if (is.null(max_SSid)) {
         nxslot <- nnodes
         xslot <- seq_len(nxslot) - 1L
     } else {
         nxslot <- as.integer(max_SSid) + 2L
         xslot <- c(0L, as.integer(nodes[-c(1L, nnodes)]), nxslot - 1L)
     }
     x <- xslot * 2.0/(nxslot-1L) - 1.0
 
     ## Compute the 'y' col.
     edges <- get.data.frame(graph, what="edges")
     nedges <- nrow(edges)
     nin <- tabulate(factor(edges$to, levels=nodes), nbins=nnodes)
     nout <- tabulate(factor(edges$from, levels=nodes), nbins=nnodes)
     ## A sanity check.
     if (nin[1L] != 0L || nout[nnodes] != 0L)
         stop("\"R\" or \"L\" nodes cannot have incoming or outgoing edges, ",
              "respectively")
     nin_cumsum <- cumsum(nin)
     nout_cumsum <- cumsum(nout)
     ## A sanity check.
     if (nin_cumsum[nnodes] != nedges || nout_cumsum[nnodes] != nedges)
         stop("The sum of all the incoming edges for all nodes should be ",
              "equal to the total nb of edges. Same for the outgoing edges.")
     ## Nb of edges passing by.
     nbypass <- cumsum(c(0L, nout[-nnodes]) - nin)
     set.seed(33L)
     yslot <- sapply(nbypass+1L, sample, 1L)
     y <- yslot * 2.0/(nbypass+2L) - 1.0
 
     ## Return the layout matrix.
     cbind(x=x, y=y)
 }
 
 
 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

 ### .igraph.to.graphNEL2() - Replacement for igraph::igraph.to.graphNEL()
 ###
 ### igraph::igraph.to.graphNEL() works on a graph with more than 1 edge
 ### between the same 2 nodes: surprisingly it returns a graphNEL object that
 ### is plottable, seems to have the correct number of edges, and passes the
 ### validGraph() test. Nonetheless it's broken! In particular, the edge
 ### attributes (aka the "edge data" in graphNEL jargon, found in
 ### x@edgeData@data for graphNEL object 'x') propagated from the original
 ### igraph object are corrupted. The .igraph.to.graphNEL2() function below
 ### fixes that, and only that (i.e. it repairs x@edgeData@data), because this
 ### is all what we care about.

 ###
 

 .find_old2new_mapping <- function(old, new)

 {

     N <- length(old)
     if (length(new) != N)
         stop("'old' and 'new' must have the same length")
     oo1 <- order(old)
     oo2 <- order(new)
     ans <- integer(N)
     ans[oo2] <- oo1
     stopifnot(all(old[ans] == new))
     ans
 }
 
 .repair_edge_data <- function(edge_data, graph)
 {
     old_edges <- get.data.frame(graph)
     stopifnot(identical(colnames(old_edges)[1:2], c("from", "to")))
     old_edge_names <- paste0(old_edges[ , "from"], "|", old_edges[ , "to"])
     new_edge_names <- names(edge_data)
     old2new <- .find_old2new_mapping(old_edge_names, new_edge_names)
     old_edges <- old_edges[old2new, -(1:2), drop=FALSE]
     edge_data <- lapply(seq_along(edge_data),
                             function(i) {
                                 old_data <- as.list(old_edges[i, ])
                                 new_data <- edge_data[[i]]
                                 new_data[names(old_data)] <- old_data
                                 new_data
                             })
     names(edge_data) <- new_edge_names
     edge_data
 }
 
 .igraph.to.graphNEL2 <- function(graph)
 {
     ans <- igraph.to.graphNEL(graph)
     ## We use direct slot access instead of the edgeData() accessor (which
     ## is broken on a graph with more than 1 edge between the same 2 nodes).
     ans@edgeData@data <- .repair_edge_data(ans@edgeData@data, graph)
     ans

 }
 

 
 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ### make_Ragraph_from_igraph()
 ###

 ### NOT exported
 ###

 
 ### Mappings from igraph attribute names to Ragraph attribute names.
 .igraph2Ragraph_EDGE_ATTRNAMES <- c(

     width="lwd",

     label.color="fontcolor"
     #lty="style"
 )
 

 .igraph2Ragraph_NODE_ATTRNAMES <- c(

     color="fillcolor",

     .igraph2Ragraph_EDGE_ATTRNAMES

 )
 
 .safeTranslateAttrNames <- function(attr_names, old2new)
 {
     m <- match(attr_names, names(old2new), nomatch=0L)
     idx <- which(m != 0L)
     new_names <- old2new[m]
     do_it <- !(new_names %in% attr_names)
     attr_names[idx[do_it]] <- new_names[do_it]
     attr_names
 }
 

 ### Safer than using sub().
 .safeTranslateEdgeNames <- function(edge_names, old.sep="|", new.sep="~")
 {
     edge_names <- strsplit(edge_names, old.sep, fixed=TRUE)
     stopifnot(all(elementLengths(edge_names) == 2L))  # sanity check
     edge_names <- unlist(edge_names, use.names=FALSE)
     paste0(edge_names[c(TRUE, FALSE)], new.sep, edge_names[c(FALSE, TRUE)])
 }
 

 .make_Ragraph_nodeAttrs_from_graphNEL <- function(graph_nel)
 {
     attr_names <- names(nodeDataDefaults(graph_nel))
     node_data <- nodeData(graph_nel)
     node_names <- names(node_data)
     node_attrs <- lapply(attr_names,
                          function(attr_name)
                              unlist(lapply(node_data, `[[`, attr_name),
                                     recursive=FALSE))
     names(node_attrs) <- .safeTranslateAttrNames(attr_names,

                                  .igraph2Ragraph_NODE_ATTRNAMES)

     is_null <- sapply(node_attrs, is.null)
     node_attrs <- node_attrs[!is_null]
 
     node_fontsize <- rep.int("12", length(node_names))
     names(node_fontsize) <- node_names
     node_attrs$fontsize <- node_fontsize
 
     node_attrs
 }
 
 .make_Ragraph_edgeAttrs_from_graphNEL <- function(graph_nel)
 {
     attr_names <- names(edgeDataDefaults(graph_nel))

     ## We use direct slot access instead of the edgeData() accessor (which
     ## is broken on a graph with more than 1 edge between the same 2 nodes).
     edge_data <- graph_nel@edgeData@data

     edge_data_names <- names(edge_data)
     if (length(attr_names) == 0L || length(edge_data_names) == 0L)
         return(list())
     edge_data_names <- .safeTranslateEdgeNames(edge_data_names)
 
     ## edgeNames() is broken on graphNEL objects that have more than 1 edge
     ## between the same 2 nodes, hence the use of unique() in the sanity check.
     edge_names <- edgeNames(graph_nel)
     stopifnot(identical(unique(edge_data_names), edge_names))  # sanity check
 
     names(edge_data) <- edge_data_names

     edge_attrs <- lapply(attr_names,
                          function(attr_name)
                              unlist(lapply(edge_data, `[[`, attr_name),
                                     recursive=FALSE))
     names(edge_attrs) <- .safeTranslateAttrNames(attr_names,

                                  .igraph2Ragraph_EDGE_ATTRNAMES)

     is_null <- sapply(edge_attrs, is.null)
     edge_attrs <- edge_attrs[!is_null]
 

     edge_fontsize <- rep.int("10", length(edge_data_names))
     names(edge_fontsize) <- edge_data_names

     edge_attrs$fontsize <- edge_fontsize
 
     edge_attrs
 }
 

 ### Replacement for Rgraphviz::buildEdgeList().
 ### Rgraphviz::buildEdgeList() is broken when some of the components in the
 ### 'edgeAttrs' list have duplicated edge names on them (which only happens
 ### when the graph has more than 1 edge between the same 2 nodes).
 ### Note that .buildEdgeList2() assumes that 'edgeAttrs' was extracted from
 ### 'graph' with .make_Ragraph_edgeAttrs_from_graphNEL(), and that 'graph'
 ### still contains the original edge data. Because of this, .buildEdgeList2()
 ### is not a serious candidate for replacing Rgraphviz::buildEdgeList().
 
 .get_pEdge_fixed_attrs <- function(pedge_attrs, edge_names, edge_pos, edgeAttrs)
 {
     edge_name <- edge_names[edge_pos]
     ## Check and fix 'attrs' slot.
     attrs0 <- sapply(edgeAttrs,
                      function(edge_attr) {
                          idx <- which(names(edge_attr) == edge_name)
                          if (length(idx) == 0L)
                              return(NA)
                          if (length(idx) == 1L)
                              return(edge_attr[[idx]])
                          if (!identical(names(edge_attr), edge_names))
                              stop("cannot fix pEdge nb ", edge_pos)
                          edge_attr[[edge_pos]]
                      })
     if (!is.character(attrs0))
         storage.mode(attrs0) <- attrs0
     attrs0 <- attrs0[!is.na(attrs0)]
     attrs0_names <- names(attrs0)
     m <- match(attrs0_names, names(pedge_attrs))
     stopifnot(!any(is.na(m)))
     attrs1 <- unlist(pedge_attrs[attrs0_names], recursive=FALSE)
     as.list(attrs0[attrs1 != attrs0])
 }
 
 .buildEdgeList2 <- function(graph, recipEdges=c("combined", "distinct"),
                             edgeAttrs=list(), subGList=list(),
                             defAttrs=list())
 {
     ans <- buildEdgeList(graph, recipEdges=recipEdges,
                          edgeAttrs=edgeAttrs, subGList=subGList,
                          defAttrs=defAttrs)
     ans_names <- names(ans)  # the edge names
     ## Checking that 'graph' still contains the original edge data.
     ## We use direct slot access instead of the edgeData() accessor (which
     ## is broken on a graph with more than 1 edge between the same 2 nodes).
     stopifnot(identical(ans_names,
               .safeTranslateEdgeNames(names(graph@edgeData@data))))
     ans <- lapply(seq_along(ans),
                   function(i) {
                       pedge <- ans[[i]]
                       ## Check 'from' and 'to' slots.
                       edge_name <- paste0(from(pedge), "~", to(pedge))
                       stopifnot(identical(edge_name, ans_names[i]))
                       ## Get the fixed attribs (as a named list).
                       fixed_attrs <- .get_pEdge_fixed_attrs(pedge@attrs,
                                                             ans_names, i,
                                                             edgeAttrs)
                       ## Set them.
                       pedge@attrs[names(fixed_attrs)] <- fixed_attrs
                       pedge
                   })
     names(ans) <- ans_names
     ans
 }
 

 .make_Ragraph_from_graphNEL <- function(graph_nel)

 {
     node_attrs <- .make_Ragraph_nodeAttrs_from_graphNEL(graph_nel)
     edge_attrs <- .make_Ragraph_edgeAttrs_from_graphNEL(graph_nel)

     ## Passing 'edge_attrs' directly to agopen() (thru the 'edgeAttrs' arg) is
     ## broken when there is more than 1 edge between the same 2 nodes, so we
     ## need to build and pass the lists of pNode and pEdge objects instead.

     #agopen(graph_nel, name=NA, nodeAttrs=node_attrs, edgeAttrs=edge_attrs)

     nodes <- buildNodeList(graph_nel, nodeAttrs=node_attrs)
     edges <- .buildEdgeList2(graph_nel, edgeAttrs=edge_attrs)

     agopen(name=NA, nodes=nodes, edges=edges, edgeMode=edgemode(graph_nel))

 }
 

 make_Ragraph_from_igraph <- function(igraph)

 {

     .make_Ragraph_from_graphNEL(.igraph.to.graphNEL2(igraph))

 }