graph_to_newick.R

graph_to_newick = function(graph, root){
  ##### Define callback functions for DFS
  # 1. function to be called whenever a vertex is visited
  f.in <- function(graph, data, extra) {
    curr_node = extra$names[data['vid']+1] # Get vertex name (Add 1 to index because igraph uses 0-based indexing)
    prev_node = extra$order.in[which(extra$order.in == curr_node)-1]
    next_node = extra$order.out[which(extra$order.out == curr_node)+1]
    if(length(extra$distances[prev_node]) == 0){ # first node / root
      cat("")
    } else{
      if(extra$distances[prev_node] < extra$distances[curr_node]){cat("(")}
    }
    FALSE # Do not terminate
  }
  
  # 2. function to be called whenever the subtree of a vertex is completed
  f.out <- function(graph, data, extra) {
    curr_node = extra$names[data['vid']+1] # Get vertex name (Add 1 to index because igraph uses 0-based indexing)
    prev_node = extra$order.in[which(extra$order.in == curr_node)-1]
    next_node = extra$order.out[which(extra$order.out == curr_node)+1]
    if(length(extra$distances[prev_node]) == 0){ # first node / root
      cat("")
    } else if(is.na(next_node)){ # last / root
      cat(curr_node)
      cat(";")
    } else{
      cat(curr_node)
      if(extra$distances[next_node] < extra$distances[curr_node]){cat(")")}
      if(extra$distances[next_node] == extra$distances[curr_node]){cat(",")}
      if(extra$distances[next_node] > extra$distances[curr_node]){cat(",")}
    }
    FALSE # Do not terminate
  }
  
  ##### Instructions
  # Obtain extra arguments (distance from root, order of node visits etc.) by running a test DFS without callback functions
  tmp_dfs = graph.dfs(graph, root = which(names(V(graph)) == root), dist = T, order = T, order.out = T) 
  # Organize results as extra arguments for the actual DFS
  extra = list(names  = names(V(graph)), order.in = names(tmp_dfs$order), order.out = names(tmp_dfs$order.out), 
               distances = tmp_dfs$dist, maxdist = max(tmp_dfs$dist))
  # Run DFS with callback functions
  newick_string = capture.output(graph.dfs(graph, root = which(names(V(graph)) == root), 
                                           dist = T, father = T, in.callback = f.in, out.callback = f.out, extra = extra))[1]
  # Tidy up
  newick_string = gsub(pattern = "\\$root", paste(root, ";", sep  = ""), newick_string)
  return(newick_string)
}