3 of 5
added 969 characters in body
ybeltukov
  • 42.5k
  • 5
  • 105
  • 206

One can do it purely with graph functions

mixedGraph[g_Graph] := 
 GraphUnion[GraphDifference@##, UndirectedGraph@GraphIntersection@##] &[g, ReverseGraph@g]

SeedRandom[0]
edges = Rule @@@ RandomInteger[{1, 5}, {12, 2}];
g = Graph[Range@7, edges]

enter image description here

mixedGraph@g

enter image description here

However, it simplifies multiple edges and converts directed loops to undirected loops. But I think it is not a problem in many applications.


Another possibility is to use adjacency matrix:

mixedGraph[g_Graph] := GraphComputation`GraphSum @@ (AdjacencyGraph[
            VertexList@g, #] & /@ {# - #2, #2}) &[#, Quotient[+## - Abs[# - #2], 2]] &
   [#, Transpose@#] &@AdjacencyMatrix@g

Here Quotient[...] is just a fast version of pairwise Min.

mixedGraph[g]

enter image description here

As you can see it works fine with multigraphs. However it requires to update GraphComputation`GraphSum for mixed graphs (in V10 it uses redundant checks)

Unprotect[GraphComputation`GraphOperationsDump`graphSum];
GraphComputation`GraphOperationsDump`graphSum[graphs__, 
   opts___?OptionQ] /; VectorQ[{graphs}, GraphQ] := 
 Block[{res, v}, v = VertexList /@ {graphs}; v = Union @@ v; 
  res = EdgeList /@ {graphs}; (res = Graph[v, Join @@ res, opts]; 
    res /; GraphQ[res]) /; ListQ[res]]
Protect[GraphComputation`GraphOperationsDump`graphSum];
ybeltukov
  • 42.5k
  • 5
  • 105
  • 206