3. Representing Graphs

t  =  Wheel[10];  ShowGraph[t,  Background -> Yellow]

Edges

?Edges

Edges[t]

Edges[
      t1 = SetGraphOptions[
          t,  {{{1,  9},  {2,  3},  EdgeStyle  ->  Fat}}], 
      All]

ShowGraph[t1]

Edges[
      t2 = SetGraphOptions[
          t,  {{{1,  9},  {2,  3},  EdgeStyle  ->  Fat}}]]

Edges[t,  EdgeWeight]

?SetEdgeWeights

k  =  
      SetEdgeWeights[t,  WeightingFunction -> RandomInteger,  
        WeightRange -> {10,  20}]

Edges[k,  EdgeWeight]

Vertices

?Vertices

Vertices[t]

Vertices[
      t3 = SetGraphOptions[
          t,  {{2,  5,  9,  VertexStyle  ->  Disc[Large]}}],  
      All]

ShowGraph[t3]

Vertices[
      t4 = SetGraphOptions[
          t,  {{2,  5,  9,  VertexStyle  ->  Disc[Large]}}]]

ShowGraph[t4]

V

?V

V[t]

V[DeleteVertices[t,  {1}]]

V[RandomGraph[20,   .4]]

M

?M

M[t]

M[AddEdges[t,  {{{1,  2}}}]]

NOTES
There are no options for M (unlike for the old version of M, that has a Directed/Undirected option). Multiple edges get counted separately and self-loops get counted once for each loop.

ChangeVertices

?ChangeVertices

s  =  
        SetGraphOptions[
          t,  {{1,  VertexColor ->  Red,  
              VertexStyle -> Disc[Large]}}];

ShowGraph[s]

s  =  
        ChangeVertices[t,  
          Vertices[CompleteGraph[5,  5], All]];

ShowGraph[s]

s  =  
        ChangeVertices[t,  Vertices[CompleteGraph[5,  5]]];

ShowGraph[s]

NOTES
The above example shows us a new 2-leveled embedding of a wheel. Difficult to recognize that the graph is a wheel. ChangeVertices is therefore a good function to use to produce new embeddings of graphs.

ChangeEdges

?ChangeEdges

s  =  
        ChangeEdges[t,  Edges[CompleteGraph[10],  All]];

ShowGraph[s]

s  =  
        ChangeEdges[t,  Edges[CompleteGraph[5,  5],  All]];

ShowGraph[s]

NOTES
ChangeEdges is another way of producing new embeddings of graphs.

AddEdges

?AddEdges

s  =  
        AddEdges[
          t,  {{{1,  3},  EdgeStyle  ->  Fat,  
              EdgeColor  ->  Red}}];

ShowGraph[s]

s  =  AddEdges[t,  {{1,  2},  {2,  1}}];

ShowGraph[s,  VertexNumber -> On,  
      VertexNumberColor -> Blue]

ShowGraph[AddEdges[t,  {1,  3}]]

NOTES
* An edge can be addded along with any associated graphics information. 
*  Adding an edge that already exists results in multiple edges.

DeleteEdges

?DeleteEdges

ShowGraph[s]

ShowGraph[DeleteEdges[s,  {{1,  2}}]]

ShowGraph[DeleteEdges[s,  {{1,  2}},  All]]

NOTES
*  There are three edges between 1 and 2 in the graph s and deleting  {1,2} deletes only one edge and leaves two other edges connecting 1 and 2 behind. The outcome is different when ALL is provided as the third argument.

s  =  SetGraphOptions[t,  EdgeDirection  ->  On];

ShowGraph[s,  VertexNumber -> On]

NOTES
* If the graph is directed then the edges in the given edge list are also treated as directed edges. Below, the directed edge {1, 2} is deleted from s. Further below, nothing is deleted since {2,1} is not a directed edge in s.

ShowGraph[DeleteEdges[s,  {{1,  2}}],  
      VertexNumber -> On]

ShowGraph[DeleteEdges[s,  {{2,  1}}],  
      VertexNumber -> On]

ShowGraph[DeleteEdges[s,  {1,  2}]]

TO DO
* DeleteEdges should also permit the user to use the function by simply typing DeleteEdges[g, {1,2}] if the user is deleting only one edge.

TIMING DISCUSSION
With and without the ALL argument, deleting d edges from an m-edge graph takes θ(md) time.  In the following expriment, m varies from 110 to 350 in steps of 10 and d is m/2. The expectation is that the running time will show a quadratic increase in m. The plot below does not show this conclusively. The Select-MemberQ combination seems to work quite well and keep the constant factors very small. This is shown by using Fit below to obtain a quadratic that fits the data. The coefficient of (x^2) is rather small.

?ExactRandomGraph

gt  =  
        Table[ ExactRandomGraph[50,  100 + 10  i],  {i,  
            25}];

et  =  
        Table[ Edges[gt[[i]]] [[ 
              RandomKSubset[ Range[ 100  +  10  i],  
                50 + 5  i] ]],  {i,  25}];

rt = 
      Table[Timing[DeleteEdges[gt[[i]],  
                et[[i]]];][[1]],  {i,  25}]

ListPlot[Map[First,  rt],  PlotJoined -> True]

Fit[ Map[First,  rt],  {1,  x,  x^2},  x]

AddVertices

?AddVertices

ShowGraph[AddVertices[t,  { .2,   .4}]]

ShowGraph[AddVertices[t,  {{{ .2,    .4}}}]]

ShowGraph[
      AddVertices[
        t,  {{{ .2,    .4},  VertexColor -> Red},  {{ .3,   .4},  
            VertexColor -> Green}}]]

ShowGraph[AddVertices[t,  1]]

ShowGraph[AddVertices[t,  10]]

NOTES
* Below, 10 vertices, whose embedding is derived from the embedding of K_{5, 5} are added to t. In this particular example, one of the newly added vertices coincides with a vertex in t and hence seems to be missing.

ShowGraph[
      AddVertices[t,  Vertices[CompleteGraph[5,  5],  All]]]

DeleteVertices

?DeleteVertices

s  =  DeleteVertices[t,  {1, 3,  10}];

p1 = ShowGraph[t,  VertexNumber -> On, Graphics];

p2  =  
        ShowGraph[s,  VertexNumber  ->  On,  Graphics];

Show[GraphicsArray[{p1,  p2}],  Background -> LightBlue,  
      ImageSize -> 500]

ShowGraph[
      DeleteVertices[
        DeleteVertices[DeleteVertices[t,  {1}],  {3}],  {10}],  
      VertexNumber -> On]

NOTES
* Note how deleting vertices 1, 3, and 10 successively gives a different graph as compared to the one obtained by deleting the set of vertices {1, 3, 10}. This because vertices are renumbered after each deletion.

Spectrum

?Spectrum

Spectrum[t]

Spectrum[GraphUnion[Cycle[4],  CompleteGraph[1] ]]

Spectrum[Star[5]]

Spectrum[CompleteGraph[3,  4]]

ToAdjacencyLists

?ToAdjacencyLists

t  =  AddEdges[t,  {{{1,  1}}}];

t  =  AddEdges[t,  {{{1,  9}}}];

t  =  AddEdges[t,  {{{2,  3}}}];

ShowGraph[t,  VertexNumber  ->  On]

l0  =  ToAdjacencyLists[t]

ToAdjacencyLists[t,  EdgeWeight]

NOTES
* t is a graph that has a self-loop {1, 1} and multiple edges: two edges between 2 and 3 and two between 1 and 9.Note that in the above example the self-loop {1, 1} shows up as the 1 in 1's adjacency list. The multiple edges {2, 3} show up with two 3's in 2's adjacency list and two 2's in 3's adjacency list and the multiple edges {1, 9} show up similarly. 
* ToAdjacencyLists[t, EdgeWeight] is a useful analogue to ToAdjacencyLists when we are dealing with edge-weighted graphs and want the weights organized in a convenient fashion.

ToAdjacencyLists[
      SetEdgeWeights[t,  WeightingFunction -> Random,  
        WeightRange ->  {2, 3}],  EdgeWeight]

s  =  SetGraphOptions[t,  EdgeDirection -> On];

ShowGraph[s,  VertexNumber  ->  On]

ToAdjacencyLists[s]

l3  =  ToAdjacencyLists[t,  Type  ->  Simple]

FromAdjacencyLists

?FromAdjacencyLists

ShowGraph[s  =  FromAdjacencyLists[l0,  Vertices[t]]]

Edges[s]

NOTES
* Note that in going from edge list representation to adjacency list and back, multiple edges and self-loops are preserved because these can be inferred from the adjacency list.

ShowGraph[FromAdjacencyLists[l0]]

ShowGraph[ 
      FromAdjacencyLists[  ToAdjacencyLists[Star[10]],  
        Type -> Directed]]

ToOrderedPairs

?ToOrderedPairs

NOTES
* In going  to ordered pairs, we view every undirected edge as a pair of directed edges. The option values for Type have obvious meanings. Note that in the example below since there are two undirected edges {1, 9}, these show up as two pairs {1, 9} and two pairs {9, 1}. The semantics of going from a directed graph to ordered pairs are obvious.

l0  =  ToOrderedPairs[t]

l1  =  ToOrderedPairs[t,  Type  -> Simple]

s  =  SetGraphOptions[t,  EdgeDirection -> On];

ToOrderedPairs[ s ]

FromOrderedPairs

?FromOrderedPairs

NOTES
* The semantics of going from ordered pairs to a directed graph are obvious. In going from ordered pairs to an undirected graph,  we get the underlying undirected graph. The Type -> Directed option  is the default as well.

s  = FromOrderedPairs[l0];

ShowGraph[s]

s =  FromOrderedPairs[l0,  Type  ->  Undirected];

l0

ShowGraph[s]

ShowGraph[
      FromOrderedPairs[l0,  Vertices[CompleteGraph[5,  5]]]]

BUG?
Why is the self-loop an ellipse? Somehow the aspect ratio became something other than 1 when the embedding is changed?

ToUnorderedPairs

?ToUnorderedPairs

t

ToUnorderedPairs[t]

ToUnorderedPairs[t,  Type -> NoSelfLoops]

ToUnorderedPairs[t,  Type  ->  NoMultipleEdges]

ToUnorderedPairs[t,  Type  ->  Simple]

s  =  SetGraphOptions[t,  EdgeDirection -> On];

ToUnorderedPairs[ s ]

NOTES
* For both undirected and directed graphs in going to unordered pairs, the edges just get reported as they are.
* It is unclear if these functions to go back and forth between a graph and ordered/unordered pairs are needed any more, since the representation is essentially unordered/ordered pairs. I will check how often I use these functions; I seem to just use Edges[...] to get the edges of the graph.

FromUnorderedPairs

?FromUnorderedPairs

NOTES
* In going back from unordered pairs matters are straightforward since unordered pairs cannot be interpreted in different ways.  The option Type -> Directed views every unordered pair as two directed edges.

l0  =  ToUnorderedPairs[t]

ShowGraph[FromUnorderedPairs[l0]]

ShowGraph[FromUnorderedPairs[l0,  Type  ->  Directed]]

ToAdjacencyMatrix

?ToAdjacencyMatrix

NOTES
* As things stand an adjacency matrix is assumed to be binary and hence cannot represent multiple edges, though it can represent self-loops. Should I change this to make an adjacency matrix be a non-negative integer matrix?

ToAdjacencyMatrix[t] // MatrixForm

ToAdjacencyMatrix[t,  Type  -> Simple] // MatrixForm

k  =  
        SetEdgeWeights[RandomGraph[10,   .3],  
          WeightingFunction -> Euclidean];

ToAdjacencyMatrix[k,  EdgeWeight]  //  TableForm

g  =  
        GraphUnion[ CompleteGraph[2],  CompleteGraph[2],  
          CompleteGraph[2]];

ToAdjacencyMatrix[g,  EdgeWeight]

ToAdjacencyMatrix[g] // MatrixForm

FromAdjacencyMatrix

?FromAdjacencyMatrix

tg  =  FromAdjacencyMatrix[ToAdjacencyMatrix[t]]

ShowGraph[tg]

PseudographQ

?PseudographQ

PseudographQ[t]

PseudographQ[DeleteEdges[t,  {{1,  1}}]]

UnweightedQ

?UnweightedQ

UnweightedQ[t]

UnweightedQ[ 
      SetEdgeWeights[t,  WeightingFunction -> Random]]

SimpleQ

?SimpleQ

SimpleQ[t]

s  =  RemoveSelfLoops[t];  SimpleQ[s]

s  =  RemoveMultipleEdges[s];  SimpleQ[s]

RemoveSelfLoops

?RemoveSelfLoops

s  =  AddEdges[t,  {{{2,  2}}}];

PseudographQ[s]

PseudographQ[RemoveSelfLoops[s]]

RemoveMultipleEdges

?RemoveMultipleEdges

s  = 
        SetGraphOptions[
          Wheel[10],  {{{1,  10},  {2,  10},  EdgeStyle -> Fat,  
              EdgeColor -> Green}}];

ShowGraph[ s ]

s  =  
        AddEdges[
          s,  {{{1,  10}},  {{1,  10}},  {{2,  10}},  {{3,  
                4}}}];

ShowGraph[ s ]

M[s]

ss  = RemoveMultipleEdges[s];

M[ss]

ShowGraph[ss]

NOTES
* Suppose there are three edges {a, b} in a graph. RemoveMultipleEdges removes two copies of {a, b}. The choice of which two to remove is arbitrary and the user cannot depend on which two edges the function removes. This is especially so because no assumption can be made about the order in which edges are listed in the edge-list representation.

EmptyQ

?EmptyQ

EmptyQ[DeleteEdges[CompleteGraph[2],  {{1,  2}}]]

EmptyQ[t]

CompleteQ

?CompleteQ

CompleteQ[t]

CompleteQ[CompleteGraph[10]]

CompleteQ[
      s  =  DeleteEdges[CompleteGraph[3],  {{1,  2}}]]

s  =  
        AddEdges[
          EmptyGraph[
            3],  {{{1,  2}},  {{1, 3}},  {{2, 3}},  {{2, 1}},  {{3, 
                1}},  {{3,  2}}}];

CompleteQ[s]

s  =  SetGraphOptions[s,  EdgeDirection -> On];

ShowGraph[s]

CompleteQ[s]

s  =  
        AddEdges[
          SetGraphOptions[EmptyGraph[3],  
            EdgeDirection -> 
              On],  {{{1,  2}},  {{1, 3}},  {{2, 3}},  {{2, 1}},  {{3, 
                1}},  {{3,  2}}}];

ShowGraph[s]

CompleteQ[s]

MultipleEdgesQ

?MultipleEdgesQ

Sort[Edges[t]]

MultipleEdgesQ[t]

MultipleEdgesQ[DeleteEdges[t,  {{2,  3},  {1,  9}}]]

s  =  AddEdges[t,  {{{2, 3}}}];  
    MultipleEdgesQ[ DeleteEdges[s,  {{2, 3}, {1, 9}}]]

MultipleEdgesQ[ 
      DeleteEdges[s,  {{2, 3}, {1, 9}},  All]]

InduceSubgraph

?InduceSubgraph

p1  =  
      ShowGraph[t,  Background -> HotPink, 
        VertexNumber -> 
          Text[{0.02,  0.02},  TextStyle -> {FontSize -> 12}],  
        Graphics];  
    p2  =  ShowGraph[InduceSubgraph[t,  {1,  9,  8,  10}],  
        Background -> HotPink, 
        VertexNumber -> 
          Text[{0.02,  0.02},  TextStyle -> {FontSize -> 12}],  
        Graphics]

Show[ GraphicsArray[{ p1,  p2 }],  Background -> Yellow,  
      ImageSize -> 600]

ShowGraph[InduceSubgraph[t,  {1,  9,  8,  10,  5}]]

ShowGraph[
      InduceSubgraph[t,  {1,  9,  8,  10,  5,  4,  6}]]

ShowGraph[
      InduceSubgraph[
        t,  {1, 2, 4,  3,   5,  6,  7,  8,  9}]]

NOTES
* Note that the list of vertices need be specified in order and may contain duplicates.
* Below I compare the times of InduceSubgraph in the old and the new versions. It is hard to beat the old implementation because InduceSubgraph is so naturally and simply expressed as simple matrix operations on the adjacency matrix.

g1  = DiscreteMath`OldCombinatorica`GridGraph[30,  30];  
    g2  =  GridGraph[30,  30];

s  =  RandomSubset[Range[900]];

{Timing[DiscreteMath`OldCombinatorica`InduceSubgraph[g1, s];],  
      Timing[InduceSubgraph[g2,  s];]}

ShowGraph[
      InduceSubgraph[GridGraph[50,  50],  RandomSubset[Range[2500]]],  
      VertexStyle -> Disc[0]]

NOTES
* One of the CUP referees  had complained that InduceSubgraph does not preserve original embedding for the subgraph. This is not quite true as the following examples show. However, InduceSubgraph is clever in the sense that the subset of vertices is also viewed as a permutation and the vertex embedding is permuted accordingly. While this is a natural consequence of the implementation of InduceSubgraph, I agree with the referee that viewing subsets as permutations also in this context is a bit of overload. 
* So I have separated the two tasks into two functions: InduceSubgraph and PermuteSubgraph. InduceSubgraph simply calls PermuteSubgraph with a sorted subset. As a consequence, instead of InduceSubgraph, we use PermuteSubgraph in functions related to graph isomorphism. PermuteSubgraph has the advantage of providing new embeddings as a result of permuting the vertices, something that InduceSubgraph did not do.

r  =  RandomSubset[Range[100]];

rp  =  Permute[r,  RandomPermutation[Length[r]]];

DiscreteMath`OldCombinatorica`ShowGraph[
      DiscreteMath`OldCombinatorica`InduceSubgraph[
        DiscreteMath`OldCombinatorica`GridGraph[10,  10],  r]]

ShowGraph[InduceSubgraph[GridGraph[10,  10],  rp]]

PermuteSubgraph

?PermuteSubgraph

NOTES
* In the example below, 1 -> 2, 2 -> 10, and 10-> 1 with everything else staying in place.

ShowGraph[t,  VertexNumber -> On]

ShowGraph[
      PermuteSubgraph[
        t,  {2, 10,  3,  4,  5,  6,  7,  8,  9,  1}],  
      VertexNumber -> On]

ShowGraph[
      PermuteSubgraph[t,  {2, 10,  3,  4,  5,   9,  1}]]

Length[rp]

ShowGraph[PermuteSubgraph[GridGraph[10,  10],  rp]]

ShowGraph[ 
      PermuteSubgraph[ GridGraph[4,  4],  
        RandomPermutation[16] ] ]

NOTES
* This is another way to get new and possibly interesting embeddings of graphs.
* Note how this differs from InduceSubgraph.

Contract

?Contract

NOTES
* In Steve Skiena's description of Contract in the book, it talks about contracting an edge. I don't see why contract should not be defined for ANY pair of vertices. Also, when a pair of vertices that have an edge connecting them is contracted, the edge becomes a self-loop. This is the definition of contract in West's graph theory book.

ShowGraph[s  = Contract[t,  {5,  6}],  
      VertexNumber -> On]

NOTES
* Note the self-loops in s. When 5 and 6 were contracted into vertex 9 we got a self-loop {9. 9}. Also note the multiple edges {9, 8} - since both 5 and 6 have edges to 8, we get the multiple edges {9, 8}.

ShowGraph[s  = Contract[s,  {5,  8}],  
      VertexNumber  ->  On]

GraphComplement

?GraphComplement

\(\(\(\(\(s\  = \ Graph[\ {}, \ {}]\) \); \ GraphComplement[s]\)\(
\)
    \)\)

ShowGraph[GraphComplement[t]]

p1 = 
        ShowGraph[s  =  SetGraphOptions[t,  EdgeDirection -> On],  
          Graphics];
p2  =  ShowGraph[GraphComplement[s],  Graphics];

Show[ GraphicsArray[{p1,  p2}],  ImageSize -> 500]

NOTES
* As can be seen from the above examples, GraphComplement works as expected for undirected as well as for directed graphs.

ShowGraph[
      GraphComplement[CompleteGraph[10,  Type -> Directed]]]

ShowGraph[s = GraphComplement[ GridGraph[4, 4]],  
      VertexNumber -> On]

MakeUndirected

?MakeUndirected

s = MakeUndirected[t]

ShowGraph[s]

s  =  
        SetGraphOptions[CompleteGraph[3],  
          EdgeDirection -> On];

ShowGraph[s,  ImageSize -> 200]

s  =  AddEdges[s,  {{{2,  1}}}];

ShowGraph[s,  ImageSize -> 200]

ShowGraph[MakeUndirected[s]]

SetGraphOptions[s,  EdgeDirection -> Off]

NOTES
* Note that MakeUndirected takes two directed edges going in opposite directions and converts them into two undirected edges. Also note the difference between MakeUndirected and simply setting the EdgeDirection Off. MakeUndirected also makes sure that the edges go from lower numbered vertices to higher numbered vertices. In other words, it is a bad idea to turn edge-directions off by using SetGraphOptions[...].

UndirectedQ

?UndirectedQ

UndirectedQ[t]

UndirectedQ[
      s  =  SetGraphOptions[t,  EdgeDirection -> On]]

UndirectedQ[
      MakeUndirected[
        s  =  SetGraphOptions[t,  EdgeDirection -> On]]]

MakeSimple

?MakeSimple

tt  = MakeSimple[t];

M[tt]

SimpleQ[tt]

ShowGraph[ tt ]

DepthFirstTraversal

?DepthFirstTraversal

TO DO
* DFS should be made more powerful and flexible - it should in addition return a partition of the edges into tree edges, back edges, forward edges, and cross edges. This should be done through various options to DFS.

s  =  DeleteEdges[t,  {{2,  3}}];

ShowGraph[s,  VertexNumber  ->  On]

DepthFirstTraversal[s,  2]

s  =  DeleteEdges[s,  {{1, 2}}];

ShowGraph[s,  VertexNumber -> On]

DepthFirstTraversal[s,  2]

s  =  DeleteEdges[s,  {{2,  3}}];

ShowGraph[s,  VertexNumber -> On]

DepthFirstTraversal[s,  2]

ShowGraph[
      Highlight[t,  {Map[Sort,  DepthFirstTraversal[t,  2,  Edge]]}, 
        HighlightedEdgeColors ->  {Blue}],  VertexNumber -> On]

NOTES
* Note that multiple edges are highlighted correctly - and only one of the edges {1,9} is highlighted.

$RecursionLimit  =  20000;

s  =  GridGraph[20,  20];

ShowGraph[
      Highlight[s,  {Map[Sort,  DepthFirstTraversal[s,  2,  Edge]]},  
        HighlightedEdgeColors -> {Blue}],  
      VertexStyle -> Disc[0]]

DepthFirstTraversal[
      s  =  SetGraphOptions[t,  EdgeDirection -> On],  1,  
      Edge]

p1 = ShowGraph[s,  Graphics];  
    p2  =  ShowGraph[ 
        Highlight[s, {DepthFirstTraversal[s ,  1,  Edge]}, 
          HighlightedEdgeColors -> {Green}],  Graphics];

Show[ GraphicsArray[{p1,  p2}],  ImageSize -> 500]

Note that 10 is a sink and hence no edges are traversed in a depth-first traversal starting from 10.

DepthFirstTraversal[
      s  =  SetGraphOptions[t,  EdgeDirection -> On],  10,  
      Edge]

NOTES
* DepthFirstTraversal works fine for directed graphs as well. 
TIMING DSCUSSION
DFS can be easily implmented so that it runs in O(m+n) time on an n-vertex, m-edge graph. Here are some timing experiments to determine if this is true.  The plot below shows that we probably have a quadratic implementation of DFS. The most likely reason for this state of affairs is the two AppendTo[...] calls in DFS. Each is appending to a list that grows linearly and since AppendTo[...] takes linear time in Mathematica, we end up with a function that takes quadratic time. This is unfortunate because DFS is fundamental to the package.

gt  =  
      Table[ GridGraph[20,  10  i],  {i,  20}];   rt  =  
      Table[ Timing[DepthFirstTraversal[gt[[i]], 1];],  {i,  
          20}]

ListPlot[ Map[#[[1, 1]] &,  rt],  PlotJoined -> True]

To make sure that my conjecture about AppendTo[...] being the problem is true, I reproduce the DFS functions below with the AppendTo[...] deleted. As a result, the new DFS function does a depth first traversal of the graph, but does not remember the edges or the vertices visited in order. The evidence is conclusive.

NewDepthFirstTraversal[g_Graph, start_Integer, flag_:  Vertex] := 
      Block[{visit = {}, e = ToAdjacencyLists[g], edges = {}, 
          dfi = Table[0, {V[g]}], cnt = 1}, 
        NewDFS[start]; 
If[flag === Edge, edges, 
          visit]]

NewDFS[
        v_Integer] := (dfi[[v]] = cnt++; 
Scan[(If[dfi[[#]] == 0, NewDFS[#]]) &, 
          e[[v]]])

gt  =  
      Table[ GridGraph[20,  10  i],  {i,  20}];   rt  =  
      Table[ Timing[NewDepthFirstTraversal[gt[[i]], 1];],  {i,  
          20}]

ListPlot[ Map[#[[1, 1]] &,  rt],  PlotJoined -> True]

How does the new implementation compare in running time with the old version? Here are some more timing experiments to determine this.

gt  =  
      Table[ DiscreteMath`OldCombinatorica`GridGraph[20,  10  i],  {i,  
          5}];   rt  =  
      Table[ Timing[DiscreteMath`OldCombinatorica`DepthFirstTraversal[
              gt[[i]], 1];],  {i,  5}]

The first 5 timings for the new implementation of DFS are: {0.031 Second,Null},{0.047 Second,Null},{0.094 Second,Null},{0.125
Second,Null},{0.125 Second,Null}. So the gains are significant.
TO DO
* Modify DFS so that its running time is indeed linear - asymptotically.

BreadthFirstTraversal

?BreadthFirstTraversal

ShowGraph[s  =  DeleteEdges[t,  {{2,  3}}],  
      VertexNumber -> On]

ShowGraph[s  =  DeleteEdges[s,  {{2,  10}}],  
      VertexNumber -> On]

ShowGraph[BreadthFirstTraversal[s,  1,  Tree],  
      VertexNumber -> On]

BreadthFirstTraversal[s,  1,  Edge]

BreadthFirstTraversal[s,  1,  Level]

ShowGraph[BreadthFirstTraversal[s,  10,  Tree],  
      VertexNumber -> On]

BreadthFirstTraversal[s,  10,  Edge]

BreadthFirstTraversal[s,  10,  Level]

ShowGraph[BreadthFirstTraversal[s,  5,  Tree],  
      VertexNumber -> On]

BreadthFirstTraversal[s,  5,  Edge]

BreadthFirstTraversal[s,  5,  Level]

ShowGraph[
      Highlight[s,  {Map[Sort,  BreadthFirstTraversal[s,  2,  Edge]]},  
        HighlightedEdgeColors -> {Blue}],  VertexNumber -> On]

s  =  GridGraph[30,  30];

ShowGraph[
      Highlight[s,  {Map[Sort,  BreadthFirstTraversal[s,  2,  Edge]]}, 
        HighlightedEdgeColors -> {Blue}],  
      VertexStyle -> Disc[0]]

s  =  InduceSubgraph[s,  RandomSubset[Range[900]]];

ShowGraph[s,  VertexStyle -> Disc[0]]

BreadthFirstTraversal[s,  2,  Edge]

ShowGraph[
      Highlight[s,  {Map[Sort,  BreadthFirstTraversal[s,  2,  Edge]]},  
        HighlightedEdgeColors -> {Blue}],  
      VertexStyle -> Disc[0]]

NOTES
* The eccentricity of a vertex in an unweighted graph can now be easily calculated using the levels returned by BFS. I have rewritten the function Eccentricity[...] in the package to first test if a graph is weighted and then use BFS or ShortestPaths accordingly.

* It is also easy to partion the edges  of the graph into same-level edges, tree edges, and other edges. This can be used for testing bipartiteness and also two coloring a graph if possible.

TO DO
Two other things that can be done to make BFS and related functions more "fun" and accessible are: 
(1) Add an option to BreadthFirstSearch that returns the edge partition mentioned above. 
(2) Add an option to BFS that returns an embedding that highlights the induced levels. This can be done easily using RankedEmbedding.

ShowGraph

This is illustrated in a separate notebook.

ShowLabeledGraph

Does not exist. This brings up the question of how we'll provide support for obsolete functions? Do we keep them in this version and then throw them away in future versions?

CircularVertices

?CircularVertices

TO DO
A linear embedding in which the edges are shown as circular arcs above or below the line of vertices should be added to the package.

s  =  CircularVertices[t];

ShowGraph[s]

ShowGraph[CircularVertices[CompleteGraph[10,  10]]]

RankGraph

?RankGraph

TO DO
The code here is essentially the bfs code. It is a bad idea to rewrite this code again. NewRankGraph should be calling bfs. This is yet another reason to make bfs more powerful and more general - with several additional options, possibly.

s =  GridGraph[5,  4];

r  = RankGraph[s,  {1,  2,  3,  4}]

s1 =  
        SetGraphOptions[s, 
          Table[{i,  VertexLabel  -> {r[[i]]}},  {i,  
              Length[r]}]];

ShowGraph[s1,  PlotRange -> Large[0.2]]

RankedEmbedding

?RankedEmbedding

TO DO
(1) To be consistent with RankedEmbedding, CircularVertices should be called CircularEmbedding.
(2) To be consistent with CircularEmbedding, RankedVertices should have the same name as RankedEmbedding.
(3) RankGraph, in my view, should dissapear and should just be a call to bfs with certain options.

s  =  GridGraph[5,  5];

ShowGraph[RankedEmbedding[s,  {13}]]

ShowGraph[RankedEmbedding[t,  {1}]]

Eccentricity

?Eccentricity

g  =  Wheel[10];

Eccentricity[g]

g  =  GridGraph[10, 10];

Eccentricity[ g ]

Timing[ Eccentricity[g];]

g = SetEdgeWeights[g];

Timing[ Eccentricity[g]; ]

NOTES
* In general computing eccentricities of vertices in a graph is time consuming - typically cubic (for dense graphs). However, the eccentricites in an unweighted graph are much faster to compute than those in a weighted graph since BFS can be used instead of shortest path algorithms. I have separated the computation of Eccentricites of weighted and unweighted graphs - the difference is significant.

g  =  DiscreteMath`OldCombinatorica`GridGraph[10, 10];

Timing[ DiscreteMath`OldCombinatorica`Eccentricity[
          g]; ]

Diameter

?Diameter

g  =  CompleteGraph[20];

Diameter[g]

g  =  RandomGraph[25,   .3];

Diameter[g]

g  =  RandomGraph[50,  .3];

Diameter[g]

g  =  RandomGraph[100,   .3];

Diameter[g]

TO DO
For fixed p, as  n->Infinity the expected diameter of the random graph goes to 2. I should expriment with this some more.

Radius

?Radius

g  =  Wheel[100];

Radius[g]

GraphCenter

?GraphCenter

g  =  Wheel[100];

GraphCenter[g]

RadialEmbedding

?RadialEmbedding

TO DO
(1) To be consistent with CircularEmbedding and RankedEmbedding, RadialEmbedding should also have a version that simply returns the embedding of the vertices.
(2) This remark actually applies to the functions above - Eccentricity, Diameter, Radius, and GraphCenter. For trees, the general form of the functions should not be used. It is easy to calculate the graph center of a tree - can be done in linear time. So that is what should be used.

s  =  RandomTree[20];

ShowGraph[s]

ShowGraph[RadialEmbedding[s,  11],  VertexNumber -> On]

ShowGraph[RadialEmbedding[RandomTree[20], 11],  
      VertexNumber -> On]

ShowGraph[RadialEmbedding[RandomTree[20], 11],  
      VertexNumber -> On]

NOTES
We can get strange embeddings as shown below by constructing RadialEmbeddings of graphs that are not trees.

ShowGraph[RadialEmbedding[ GridGraph[3, 3]]]

RootedEmbedding

?RootedEmbedding

s  =  RandomTree[20];

ShowGraph[RootedEmbedding[s,  1],  VertexNumber -> On,  
      PlotRange -> Large[0.05]]

ShowGraph[RootedEmbedding[s,  3],  VertexNumber  ->  On]

ShowGraph[RootedEmbedding[s,  19],  VertexNumber  ->  Center,  
      VertexNumberColor  ->  White,  VertexStyle  ->  Disc[Large],  
      PlotRange -> Large[0.03],  Background -> LightBlue]

TranslateVertices

?TranslateVertices

TO DO 
TranslateVertices will be more useful when subsets of vertices can be translated. I should generalize the function to be able to do this.

t

TranslateVertices[t,  { .001,   .002}]

DilateVertices

?DilateVertices

TO DO
The user should be able to dilate subsets of vertices as well.

t

DilateVertices[t,  2]

RotateVertices

?RotateVertices

TO DO
 Same as for the previous 2 functions. We should be able the Rotate a subset of the vertices.

ShowGraph[s  =  CompleteGraph[3,  2,  2,  4]]

ShowGraph[RotateVertices[s,  Pi/2]]

ShowGraph[RotateVertices[s,  Pi/4]]

NormalizeVertices

?NormalizeVertices

s  =  CompleteGraph[7]

Vertices[s]

s  =  TranslateVertices[s,  {0.5,  0.3}]

Vertices[s]

Vertices[NormalizeVertices[s]]

ShakeGraph

?ShakeGraph

s  =  
      RankedEmbedding[
        Wheel[10],  {1,  2,  3,  4,  5,  6,  7,  8,  9}]

ShowGraph[s]

ss = ShakeGraph[s];

ShowGraph[ss]

ss = ShakeGraph[s,  0.3];

ShowGraph[ss]

ShowGraph[CompleteGraph[2,  2,  2],  
      VertexNumber  ->  On]

ShowGraph[ShakeGraph[CompleteGraph[2,  2,  2],  0.3],  
      VertexNumber  ->  On]

GraphOptions

?GraphOptions

GraphOptions[s]

r  =  
      SetGraphOptions[CompleteGraph[5,  5],  VertexColor -> Red,  
        EdgeColor -> Green]

ShowGraph[r]

GraphOptions[r]

NOTES
* This function's behavior might change when I make changes to ShowGraph.

SpringEmbedding

?SpringEmbedding

s  = 
        MakeGraph[
          Permutations[{1,  2,  3,  
              4}],   (Count[#1  -  #2,  0] == 0) &];

oldS  =  
        DiscreteMath`OldCombinatorica`MakeGraph[
          Permutations[{1,  2,  3,  
              4}],   (Count[#1  -  #2,  0] == 0) &];

ShowGraph[s]

V[s]

M[s]

Timing[r  =  SpringEmbedding[s];]

ShowGraph[r]

Timing[r  =  
          DiscreteMath`OldCombinatorica`SpringEmbedding[oldS];]

ReadGraph

Not yet implemented. Probably will  not be implemented.

WriteGraph

Not yet implemented. Probably will not be implemented.