Return to Answer

I used this generator algorithm for DAGs (by Szabolcs):

I used this generator algorithm for DAGs (by Szabolcs):

Note that this method removes unconnected singletons.

Adjacency matrix version

Here is a version that works directly on adjacency matrices. This should be faster than working on huge Graph objects directly.

The removableQ function recursively tests if the node from has an alternative route to to than the direct one, by collecting children nodes. The moment the function finds another edge terminating at to, exits from the loop, as it is unnecessary to check further.

removableQ[m_, {from_, to_}] := Module[{children},
   children = Flatten@Position[m[[from]], 1];
   If[MemberQ[children, to], Throw@to, 
    Do[removableQ[m, {i, to}], {i, children}]; None]
   ];

The wrapper reduce iterates through all edges in the matrix:

reduce[adj_] := Module[{edgeList = Position[adj, 1], rem},
   rem = DeleteCases[{First@#, 
        Catch@removableQ[ReplacePart[adj, # -> 0], #]} & /@ 
      edgeList, {_, None}];
   ReplacePart[adj, Thread[rem -> 0]]
   ];

Let's call reduce on a random DAG's adjecency matrix:

g = DirectedGraph[RandomGraph[{6, 10}], "Acyclic"];
EdgeList@g

{1 -> 3, 1 -> 4, 1 -> 5, 1 -> 6, 2 -> 3, 2 -> 4, 2 -> 5, 3 -> 5, 4 -> 6, 5 -> 6}

adj = Normal@AdjacencyMatrix@g
new = reduce@adj;
Row@{g, AdjacencyGraph@new}

Note that this method does not remove unconnected singletons.

I used this generator algorithm for DAGs (by Szabolcs):

{vertices, edges} = {7, 10};
elems = RandomSample@PadRight[ConstantArray[1, edges], vertices (vertices-1)/2];
adj = Take[FoldList[RotateLeft, elems, Range[0, vertices-2]], All, 
           vertices]~LowerTriangularize~-1;
g = AdjacencyGraph[adj, DirectedEdges -> True];

Removing redundant edges iteratively:

new = Graph[Flatten[If[GraphDistance[EdgeDelete[g, #], First@#, 
            Last@#] < Infinity, {}, #] & /@ EdgeList@g], 
         VertexLabels -> "Name", ImagePadding -> 10];
{HighlightGraph[g, new, VertexLabels -> "Name", ImagePadding -> 10], new}

For some graphs, the remaining graph is simply the path graph of the topologically sorted vertices:

I used this generator algorithm for DAGs (by Szabolcs):

{vertices, edges} = {7, 10};
elems = RandomSample@PadRight[ConstantArray[1, edges], vertices (vertices-1)/2];
adj = Take[FoldList[RotateLeft, elems, Range[0, vertices-2]], All, 
           vertices]~LowerTriangularize~-1;
g = AdjacencyGraph[adj, DirectedEdges -> True];
EdgeList@g

{2 -> 1, 3 -> 1, 3 -> 2, 4 -> 1, 4 -> 2, 4 -> 3, 5 -> 1, 5 -> 2, 5 -> 3, 5 -> 4}

Removing redundant edges iteratively:

new = Graph[Flatten[If[GraphDistance[EdgeDelete[g, #], First@#, 
            Last@#] < Infinity, {}, #] & /@ EdgeList@g], 
         VertexLabels -> "Name", ImagePadding -> 10];
Row@{HighlightGraph[g, new, VertexLabels -> "Name", ImagePadding -> 10], new}

For some graphs, the remaining graph is simply the path graph of the topologically sorted vertices:

g = Graph[{2->1, 3->1, 3->2, 4->1, 4->2, 4->3, 5->1, 5->2, 5->3, 5->4}];