5. Properties of Graphs

ConnectedComponents

?ConnectedComponents

ConnectedComponents[s  = RegularGraph[1,  10]]

ShowGraph[s,  VertexNumber -> On]

c  =  ConnectedComponents[s  = RegularGraph[2,  20]]

ShowGraph[s,  VertexNumber -> On,  VertexNumberColor -> Purple,  
      Background -> Yellow]

ShowGraph[InduceSubgraph[s,  c[[1]]]]

a  =  GraphUnion[Wheel[5],  Star[10]];

ConnectedComponents[ a ]

a  =  GraphUnion [10,  Star[10]]; 
    ConnectedComponents[ a ]

TIMING DISCUSSION
First we have a comparison between the new and old implementations of ConnectedComponents. As can be seen from the tables of timings given below, the new implementation is dramatically faster than the old implementation - factor of speed ranges from 80 to more than 100.

$RecursionLimit = 100000;

g  =  
        Table[DiscreteMath`OldCombinatorica`RandomGraph[i*100,  
            0.01],  {i,  5}];

h  =  Table[RandomGraph[i*100,  0.01],  {i, 10}]

Table[{Length[
          DiscreteMath`OldCombinatorica`ConnectedComponents[g[[i]]]],  
        Length[ConnectedComponents[h[[i]]]]},  {i,  5}]

ort  =  
      Table[Timing[DiscreteMath`OldCombinatorica`ConnectedComponents[
              g[[i]]];],  {i,  5}]

rt  =  
      Table[ Timing[ ConnectedComponents[ h[[i]] ]; ],  {i,  
          10}]

The running time plot for ConnectedComponents confirms that the running time grows quadratically in the size of the graph. However, the experiment might be misleading since the expected number of edges in the random graph also grows quadratically. So I do a second experiment below. In that experiment the running time seems almost linear!  Note that in this experiment, the number of vertices and the number of edges are growing in a roughly linear fashion.

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

gt  =  
        Table[ InduceSubgraph[GridGraph[20,  10*i],  
            RandomKSubset[ Range[ 200*i],  100*i]],  {i,  
            10}];

Map[ V,  gt]

Map[M,  gt]

rt  =  
      Table[ Timing[ ConnectedComponents[ gt[[i]] ];],  {i, 
          10}]

Clear[gt]

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

The following experiment shows that BFS may be faster than DFS and it might be better to use BFS in the new ConnectedComponents. However, I will wait to make this change to ConnectedComponents because I expect both DFS and BFS to be speeded up.

s  =  
      GridGraph[50,  50];  {Timing[DepthFirstTraversal[s,  1];],  
      Timing[BreadthFirstTraversal[s, 1 ];]}

Here is a larger experiment with ConnectedComponents.

s  =  
      InduceSubgraph[GridGraph[70,  70],  
        RandomSubset[Range[4900]]]

V[s]

M[s]

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

Timing[c  =  ConnectedComponents[s];]

Length[c]

Max[Map[Length,  c]]

Only 11 seconds for a graph with 5030 vertices and lots of components!

g  =  GridGraph[100,  100]

h  =  InduceSubgraph[g,  RandomSubset[Range[10000]]];

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

V[h]

M[h]

Timing[c  =  ConnectedComponents[h];]

{Length[c],  Max[Map[Length,  c]]}

ConnectedQ

?ConnectedQ

ConnectedQ[Wheel[10]]

ConnectedQ[DeleteVertices[Star[10],  {10}]]

ConnectedQ[Wheel[10],  Weak]

ConnectedQ[OrientGraph[Wheel[10]],  Strong]

ConnectedQ[
      SetGraphOptions[RandomTree[20],  EdgeDirection -> On],  
      Strong]

ConnectedQ[
      SetGraphOptions[RandomTree[20],  EdgeDirection -> On],  
      Weak]

NOTES
* ConnectedQ with the strong and weak options works only on directed graphs.

ConnectedQ[ Wheel[10],  Weak]

ConnectedQ[ Wheel[10],  Strong]

g  =  
        SetGraphOptions[ Wheel[10],  EdgeDirection -> On];

ShowGraph[ g ,  
      VertexNumber -> 
        Text[ {0.03, 0},  
          TextStyle -> {FontSize -> 14,  FontColor -> Blue,  
              FontWeight -> Bold}],  PlotRange -> Large[0.05]]

ConnectedQ[ g,  Weak]

ConnectedQ[g,  Strong]

h  =  AddEdges[g,  {{{9, 1}},  {{10, 1}}}];

ConnectedQ[h,  Strong]

ConnectedQ[h,  Weak]

ShowGraph[ h ]

WeaklyConnectedComponents, StronglyConnectedComponents

?WeaklyConnectedComponents

?StronglyConnectedComponents

s  =  
        SetGraphOptions[GridGraph[5,  6],  
          EdgeDirection -> On];

ShowGraph[s,  
      VertexNumber -> Text[{-0.04,  -0.04}],  
      PlotRange -> Large[0.05]]

WeaklyConnectedComponents[s]

StronglyConnectedComponents[s]

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

StronglyConnectedComponents[ s ]

NOTES
* The above example shows that s  is almost strongly connected - addition of one edge makes it strongly connected.
TIMING DISCUSSION
WeaklyConnectedComponents simply turns the graph into an undirected graph and runs the function ConnectedComponents on that. Therefore its running time is completely dominated by the running time of ConnectedComponents.
Here I focus on the running time of StronglyConnectedComponents. As the plot below shows StronglyConnectedComponents has running time that is roughly quadratic in the size of the graph. This should not be the case and I should try to recode StronglyConnectedComponents so that it runs in linear time.
TO DO
* Redo strongly connected components so that it runs in linear time.
The timings and plots further below make it clear that the new implementation of StronglyConnectedComponents[...] is much faster than the old implementation. The plots seem to indicate that both functions take quadratic time with different constants.

gt  =  
        Table[ RandomGraph[100  i,  N[1/100  i],  Directed],  {i,  
            10}];

rt  = 
      Table[ Timing[StronglyConnectedComponents[gt[[i]]];],  {i, 
          10}]

Map[V,  gt]

Map[M,  gt]

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

ogt  =  
        Table[DiscreteMath`OldCombinatorica`RandomGraph[100  i,  
            N[1/100  i], {0, 1}],  {i,  5}];

ort  =  
      Table[ Timing[ DiscreteMath`OldCombinatorica`StronglyConnectedComponents[ 
              ogt[[i]] ];],  {i, 5}]

Clear[MultipleListPlot];  Remove[ MultipleListPlot];

<< Graphics`MultipleListPlot`

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

g  =  
        SetGraphOptions[GridGraph[70,  70],  
          EdgeDirection -> On];

{Timing[cw  =  WeaklyConnectedComponents[g];],  
      Timing[cs  =  StronglyConnectedComponents[g];],  Length[cw],  
      Length[cs]}

OrientGraph

?OrientGraph

g  =  GridGraph[10, 10];

ShowGraph[ h = OrientGraph[ GridGraph[10, 10] ] ]

Length[StronglyConnectedComponents[h]]

g  =  RandomGraph[20,   .6];

Bridges[g]

Length[ 
      StronglyConnectedComponents[
        SetGraphOptions[g,  EdgeDirection -> On]] ]

h  =  OrientGraph[g];

Length[ StronglyConnectedComponents[g] ]

TIMING DISCUSSION
OrientGraph in  new Combinatorica is extremely slow!!  About 227 seconds for 400 vertex grid graph! Most of the time is however taken by ExtractCycles. So ExtractCycles is in need of major repair. One immediate improvement is for ExtractCycles to not compute the new adjacency list representation from scratch after each cycle has been deleted. Of course, OrientGraph in "old" Combinatorica seems 4 times slower (based on one sample point). 
I wonder if it is possible to do this in linear time. Even if it isn't, I am sure it is possible to do this in  much more speedy fashion.
TO DO
Speed up ExtractCycles[...]

g  =  GridGraph[20, 20];

Timing [ OrientGraph[g];]

Timing[ ExtractCycles[g]; ]

h  =  DiscreteMath`OldCombinatorica`GridGraph[20, 20];  
    Timing[ DiscreteMath`OldCombinatorica`OrientGraph[h]; ]

BiconnectedComponents

?BiconnectedComponents

BiconnectedComponents[RandomTree[100]]

Length[%]

BiconnectedComponents[Cycle[100]]

ShowGraph[g  =  Contract[Cycle[50],  {1,  30}]]

BiconnectedComponents[g]

TIMING DISCUSSION
Like ConnectedComponents, StronglyConnectedComponents etc, BiconnectedComponents is also quadratic in running time. This is not clear from the plot below. I wonder what is giong on.
Comparing the running times of the old and new implementation reveals that the new implementation is dramatically faster! For a 200-vertex random graph with p =1/200 the new implementation takes 0.21 s while the old implementation takes 88.62 s! When the two timing tables are plotted in the same plot, the plot for the new implementation is not visible.

gt  =  
        Table[ RandomGraph[i*10, N[1/(10  i)]],  {i, 20}];

rt  =  
      Table[Timing[ BiconnectedComponents[ gt[[i]] ];],  {i, 
          20}]

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

gt =  
        Table[ DiscreteMath`OldCombinatorica`RandomGraph[i*10, 
            1/(10  i)],  {i, 20}];

ort  =  
      Table[Timing[ DiscreteMath`OldCombinatorica`BiconnectedComponents[ 
              gt[[i]] ];],  {i, 20}]

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

TO DO
* Also we should definitely produce the Block-Cutpoint-Tree of a graph. It would be a nice illustration of the excellent properties that blocks and cutpoints have.
* Here we might also consider discussing the connectivity approximation algorithms of Khuller. These are easily implemented and so it might not be a bad idea to include a few of these.

BiconnectedQ

?BiconnectedQ

g  =  GridGraph[4, 4];

BiconnectedQ[g]

BiconnectedQ[CompleteGraph[10]]

BiconnectedQ[
      GraphUnion[CompleteGraph[10],  CompleteGraph[10]]]

BiconnectedQ[
      g  =  Contract[
          GraphUnion[CompleteGraph[10],  CompleteGraph[10]],  {10,  
            14}]]

ShowGraph[g,  
      VertexNumber -> 
        Text[{-0.03,  -0.03},  
          TextStyle -> {FontSize -> 14,  FontWeight -> Bold,  
              FontColor -> Red}],  Background -> Yellow,  
      EdgeColor -> Orange,  ImageSize -> 400,  
      PlotRange -> Large[0.05]]

NOTES
* This function simply finds all the biconnected components by calling the new BiconnectedComponents and then checks the number of biconnected components found. So its running time will be almost identical to the running time of BiconnectedComponents. The same is true for the next two functions: ArticulationVertices and Bridges.

ArticulationVertices

?ArticulationVertices

g = Star[20];

ArticulationVertices[g]

ArticulationVertices[CompleteGraph[10]]

Bridges

?Bridges

Bridges[RandomTree[10]]

g  =  GridGraph[10, 10];

Bridges[g]

Bridges[
      s  = AddEdges[
          GraphUnion[Wheel[5],  Wheel[7]],  {{{5,  6}}}]]

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

EdgeConnectivity

?EdgeConnectivity

EdgeConnectivity[ GridGraph[20, 5]]

EdgeConnectivity[
      s  = AddEdges[
          GraphUnion[Wheel[5],  Wheel[7]],  {{{5,  6}}}]]

EdgeConnectivity[ RandomGraph[20,   .3] ]

EdgeConnectivity[ RandomGraph[20,   .5] ]

EdgeConnectivity[ RandomGraph[20,   .7] ]

EdgeConnectivity [ CompleteGraph[10] ]

TIMING DISCUSSION
EdgeConnectivity is extremely slow because it calls NetworkFlow n times. 220 seconds for a 5 X 250 grid graph!! This needs substantial repair. The way to do EdgeConnectivity efficiently would be to implement the Stoer-Wagner algorithm. I should also implement preflow-push to speedup the NetworkFlow algorithm. I should then do a timing comparison of both algorithms. 
The new implementation is faster than the old implementation, but this is no reason to gloat given that both implementations are terribly slow.
TO DO
* Implement Stoer-Wagner algorithm for edge connectivity.
* Implement the pre-flow puch algorithm for Network flows.

gt =  
        Table [RandomGraph[5  i, N[1/(5  i)]],  {i,  
            15}];

rt = 
      Table [Timing[ EdgeConnectivity[ gt[[i]] ]; ],  {i,  
          15}]

Map[V,  gt]

Map[M,  gt]

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

gt =  Table [GridGraph[5, 5  i],  {i,  10}];

rt = 
      Table [Timing[ EdgeConnectivity[ gt[[i]] ]; ],  {i,  
          10}]

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

h  =  
        Table [DiscreteMath`OldCombinatorica`RandomGraph[i*5,  
            N[1/5  i]],  {i,  5}];

Table [
      Timing[ DiscreteMath`OldCombinatorica`EdgeConnectivity[ 
            h[[i]] ]; ],  {i,  5}]

VertexConnectivity

?VertexConnectivity

VertexConnectivity[ GridGraph[10, 3] ]

VertexConnectivity[ Star[30] ]

VertexConnectivity[ CompleteGraph[4] ]

DiscreteMath`OldCombinatorica`VertexConnectivity [ 
      DiscreteMath`OldCombinatorica`CompleteGraph [ 4] ]

NOTES
* The convention is to define the vertex-connectivity of a complete graph of n vertices as n-1. Old Combinatorica does not get this right.

TIMING DISCUSSION
Vertex connectivity is too slow - that fact that the old version of this function is even slower is not a source of comfort. Calling Network Flow n times is a bad idea and an overkill. As I write in the comments for EdgeConnectivity, I should implement the Stoer-Wagner algorithm for both edge and vertex connectivity.  Of course, I should also speed up network flow.

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

Timing[ VertexConnectivity[ g ]; ]

Timing[ DiscreteMath`OldCombinatorica`VertexConnectivity[ 
          h ]; ]

VertexConnectivityGraph

?VertexConnectivityGraph

NOTES
* This function was hidden in old Combinatorica. I think it produces interesting graphs and therefore have made the new function public. I have also tried to give the vertices a reasonable embedding that shows what transpired. The function produces directed graphs.

ShowGraph[g  =  VertexConnectivityGraph[Wheel[10]],  
      VertexStyle -> Disc[0.025],  ImageSize -> 400]

ShowGraph[g  =  RandomTree[10]]

NOTES
The following example also tries to show the use of relative headscaling for arrows. I thought this option would be very useful, but now I am skeptical. Look at the smallest edges - they seem not to have any arrow heads. That is only because their arrow heads are too small to be visible.

ShowGraph[VertexConnectivityGraph[g],   HeadScaling -> Relative, 
      ImageSize -> 400,  VertexStyle -> Disc[0.015]]

TIMING DISCUSSION
The above timing information shows that constructing the vertex connectivity graph takes virtually no time as compared to the computation of vertex connectivity itself: 0.02 s vc 26 s. So no significant improvement of VertexConnectivity will come from improving the construction of the vertex connectivity graph.

g  =  GridGraph[10,  4];  
    Timing[ VertexConnectivityGraph[g]; ]

TO DO
Both EdgeConnectivity and VertexConnectivity need to have options that will make the functions return a smallest edge-cut or smallest vertex-cut respectively.

Harary

?Harary

ShowGraph[Harary[3,  10]]

ShowGraph[Harary[7,  13]]

CompleteQ[Harary[8,  9]]

CompleteQ[Harary[10,  9]]

TIMING DISCUSSION
Harary[n, k] seems to be linear both in n and in k. I need to look at the code more carefully to determine if this is indeed true. I am surprised that it is linear in n.
As can be seen from the timing results below, construction of the Harary graph using the old version of the function is faster than using the new version. This is because Harary makes a call to CirculantGraph and CirculantGraph is extremely fast in the old version because it uses extremely convenient in-built matrix/vector operations. I don't think much can be done to improve the "new" version of Harary.

rt = Table[Timing[ Harary[5,  i*10];],  {i,  20}]

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

Table[
      Timing[ DiscreteMath`OldCombinatorica`Harary[5,  i*10];],  {i,  
        20}]

rt  = 
      Table[Timing[ Harary[5,  i*10];],  {i,   20}]

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

BUG
The old Harary is producing an error message here. How come?

Table[
      Timing[ DiscreteMath`OldCombinatorica`Harary[i*5,  
            10];],  {i,   3, 20}]

IdenticalQ

?IdenticalQ

g  =  CompleteGraph[10];

IdenticalQ[g,  CompleteGraph[10]]

IdenticalQ[g,  Wheel[10]]

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

IdenticalQ[g,  CompleteGraph[10]]

IdenticalQ[CirculantGraph[10,  Range[5]],  
      CompleteGraph[10]]

IdenticalQ[RemoveMultipleEdges[CirculantGraph[10,  Range[5]]],  
      CompleteGraph[10]]

IdenticalQ[GraphDifference[Wheel[11],  AddVertices[Cycle[10], 1 ]],  
      Star[11]]

g  =  GridGraph[100, 100];

Timing[ IdenticalQ[g, g];]

TIMING DISCUSSION
The "new" version of IdenticalQ is quite fast - 10, 000 vertex-graphs in less than a second. Of course the old version of this function is also extremely fast since it involves comparing  the two adjacency matrices.

IsomorphismQ

?IsomorphismQ

IsomorphismQ[CompleteGraph[10],  CompleteGraph[10],  
      RandomPermutation[10]]

tf  =  
      Map[IsomorphismQ[Cycle[4],  Cycle[4],  #] &,  
        Permutations[Range[4]]]

Length[Select[tf,  (# == True) &]]

NOTES
* The automorphism group of a 4-cycle is an order-8 subgroup of the symmetric group S_4. This is basically the dihedral group on 4 elements.
TIMING DISCUSSION
The new implementation of this  function seems to be quadratic in running time. This is because InducePermuteSubgraph is quadratic.This should be speeded up.
TO DO
Speed up the InducePermuteSubgraph function.
The old implementation of function is much faster than the new implementation because the old InduceSubgraph is lightning fast!

gt  =  Table[GridGraph[20, 10  i],  {i,  8}];  
    pt  =  Table[RandomPermutation[200  i],  {i,  8}];

rt = 
      Table[Timing[ IsomorphismQ[gt[[i]] , gt[[i]],  
              pt[[i]] ]; ],  {i,  8}]

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

ht = 
        Table[ DiscreteMath`OldCombinatorica`GridGraph[20, 10  i],  {i,  
            8}];

rt  =  
      Table[ Timing[ DiscreteMath`OldCombinatorica`IsomorphismQ[
              gt[[i]], gt[[i]],  pt[[i]] ]; ],  {i,  
          8}]

Isomorphism

?Isomorphism

Isomorphism[Wheel[10],  CompleteGraph[10]]

Isomorphism[Wheel[5],  Wheel[5],  All]

Isomorphism[Star[5], Star[5],  All]

Isomorphism[Wheel[10],  Star[10]]

Isomorphism[Cycle[10],  Cycle[10],  All]

NOTES
* The above is the automorphism group of a 10-cycle. This is isomorphic to the dihedral group on 10 symbols.
TIMING DISCUSSION
The isomorphism function is extremely slow - the newer version of the function seems slower than the older (already slow) function. This function, needs major repair. It would be very nice to add a variety of heuristics to this function that help it prune the search space quickly. Clearly, Backtrack, as it is does not suffice. Brendan McKay's Nauty  specializes in graph isomorphism - I should look that up and see how it does what it does.

g  =  Table[Cycle[i],  {i,  10,  20, 2}];  
    h  =  Table[Cycle[i],  {i,  10, 20, 2}];

Table[
      Timing[ Isomorphism[g[[i]],  g[[i]],  All];],  {i, 
        6}]

Table[
      Timing[ DiscreteMath`OldCombinatorica`Isomorphism[h[[i]],  
            h[[i]],  All]; ],  {i,  6}]

NOTES
* Now the new Isomorphism also yields the automorphism group if called with a single graph.

Isomorphism[Cycle[5]]

Isomorphism[Path[5]]

Isomorphism[t  =  RandomTree[7]]

ShowGraph[t,  VertexNumber -> On,  
      PlotRange -> Large[ .1]]

IsomorphicQ

?IsomorphicQ

IsomorphicQ[Wheel[10],  Wheel[10]]

IsomorphicQ[CompleteGraph[8],  
      GraphJoin[CompleteGraph[4],  CompleteGraph[4]]]

IsomorphicQ[ RandomTree[20],  CompleteGraph[20]]

Equivalences

?Equivalences

NOTES
* The example below shows that the first 9 vertices in Wheel[10], each of which  has degree 3, cannot be mapped on to any vertex in CompleteGraph[10], while the 10th vertex in Wheel[10], which has degree 9, can be mapped on to any vertex in CompleteGraph[10].

Equivalences[Wheel[10],  CompleteGraph[10]]

Equivalences[Path[10],  CompleteGraph[10]]

Equivalences[Path[10],  Path[10]]

NOTES
Below I construct two non-isomorphic 8-vertex 3-regular graphs. The first of these these two graphs,  has several triangles while the second graph is Hypercube[3], which is bipartite. Note that since Equivalences[g, h] pays attention only to vertex  degrees it ends up concluding that every vertex in the first graph can be mapped on to every vertex in the second graph. Looking at the adjacency matrix of the squares of these graphs quickly resolves the confusion and

g  =  GraphUnion[ Cycle[4],  Cycle[4]]; 
    ShowGraph[g,  VertexNumber -> On]

g  =  
        AddEdges[
          g,  { {{1,  5}},  {{2,  4}},  {{6,  8}},  {{3,  
                7}} }];

ShowGraph[g,  VertexNumber -> On,  
      PlotRange -> Large[0.1]]

DegreeSequence[ g ]

ShowGraph[h =  Hypercube[ 3 ] ]

DegreeSequence[ h ]

Equivalences[g,  h ]

Isomorphism[g,  h,  All]

Equivalences[ GraphPower[g, 2],  GraphPower[h,  2]]

NOTES
* This is simply the beginnings of how I think Isomorphism can be improved. I think that using AllPairsShortestPaths is probably too costly a method to determine equivalences. It would definitely be faster to use the number of paths matrix for paths of some small constant length. This matrix can be computed by simple matrix multiplication, which will make the computation relatively fast. Also, the user should be allowed to play with Equivalences so that using different methods, the equivalences can be made more fine. Here is an example.

gm  =  Path[10];  gm2  =  GraphPower[gm,  2];

Equivalences[gm2,  gm2]

NOTE
* Notice that since we used the 2nd power of the adjacency matrix, we have finer equivalence classes. Similarly, the situation improves with the third power of the adjacency matrix.  Finally, when we get to the 5th power of adjacency matrix, it is clear that there are only two candidate permutations that we need to try: identity and the path "flip". In this case, both are isomorphisms.

Equivalences[gm3 = GraphPower[gm,  3],  gm3]

Equivalences[gm5  =  GraphPower[gm,  5],  gm5]

Equivalences[Wheel[5]]

Equivalences[CompleteGraph[4]]

Automorphisms

?Automorphisms

Automorphisms[Star[4]]

SelfComplementaryQ

?SelfComplementaryQ

SelfComplementaryQ[Path[4]]

SelfComplementaryQ[Cycle[5]]

SelfComplementaryQ[Path[5]]

FindCycle

?FindCycle

NOTES
* FindCycle needs to have an edge option that will cause the function to return the edges in a cycle. This option can then be carried over to ExtractCycles.

ShowGraph[t  =  RandomGraph[10,   .4],  VertexNumber -> On,  
      VertexNumberColor -> Red,  PlotRange -> Large[0.1],  
      Background -> LightBlue]

FindCycle[t]

ShowGraph[t  =  AddEdges[RandomTree[10],  {{{1,  10}}}],  
      VertexNumber -> On,  PlotRange -> Large[0.05]]

FindCycle[t]

HighlightCycle[t_Graph]  :=  
      Highlight[t,  
          c  =  FindCycle[t]; {Table[
              Sort[{c[[i]],  c[[i + 1]]}],  {i, Length[c] - 1}]},  
          HighlightedEdgeColors -> {Red}]  /;  UndirectedQ[t]

HighlightCycle[t_Graph]  :=  
      Highlight[t,  
        c  =  FindCycle[
            t]; {Table[{c[[i]],  c[[i + 1]]},  {i, 
              Length[c] - 1}]}, HighlightedEdgeColors ->  {Red}]

ShowGraph[HighlightCycle[t],  VertexNumber -> On]

ShowGraph[HighlightCycle[RandomGraph[10,   .4]]]

ShowGraph[
      t  =  SetGraphOptions[GridGraph[5,  5],  EdgeDirection -> On,  
          VertexNumber -> Text[{-0.03, -0.03}]],  
      PlotRange -> Large[0.07]]

ShowGraph[
      t  =  AddEdges[
          DeleteEdges[
            t,  {{16,  17},  {17,  22}}],  {{{17,  16}},  {{22,  
                17}}}],  VertexNumber -> On,  
      PlotRange -> Large[0.1]]

ShowGraph[HighlightCycle[t]]

NOTES
*  FindCycle can deal correctly with multiple edges. It reports 2-cycles correctly. In fact, it reports self-loops also correctly.

t  =  AddEdges[Path[4],  {{{1,  2}}}];

Edges[t]

FindCycle[t]

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

FindCycle[ t ]

TIMING DISCUSSION
The plot of the table of timings for FindCyle on random graphs is quite strange - partly caused by the fact that the graphs are random and partly caused by the fact that the function stops as soon as it finds a cycle.
The plot of FindCycle timings for grid graphs is shown below. This is linear, but this is just because the function quickly finds 4-cycles in each of these graphs. The asymptotic running time of the function is definitely quadratic and this needs to be fixed.
The new version of FindCyle is faster than the old version, but the new version could be improved some more.
TO DO
Speed up FindCycle.

gt  = 
        Table[ RandomGraph[50  i,  N[1/(50  i)]],  {i,  
            10}];

rt  =  
      Table[ Timing[ FindCycle[gt[[i]] ];],  {i,  
          10}]

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

gt  =  Table[ GridGraph[20,  10  i],  {i,  10}];

ct  =  Table[0, {10}];

rt  =  
      Table[ Timing[ct[[i]] =  FindCycle[gt[[i]] ];],  {i,  
          10}]

ct

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

ht =  
        Table[DiscreteMath`OldCombinatorica`RandomGraph[50  i,  
            N[1/(50  i)]],  {i,  5}];

rt =  
      Table[Timing[ DiscreteMath`OldCombinatorica`FindCycle[
              ht[[i]] ]; ],  {i,  5}]

AcyclicQ

?AcyclicQ

AcyclicQ[RandomTree[100]]

AcyclicQ[GridGraph[10,  10]]

AcyclicQ[
      SetGraphOptions[GridGraph[10,  10],  EdgeDirection -> On]]

TreeQ

?TreeQ

TreeQ[Star[100]]

$RecursionLimit = 10000;

TreeQ[Path[100]]

TreeQ[RandomTree[10]]

TreeQ[CompleteGraph[10]]

TreeQ[Wheel[10]]

ExtractCycles

?ExtractCycles

ExtractCycles[Wheel[10]]

cl  =  ExtractCycles[CompleteGraph[10]]

cl  =  Map[Map[Sort,  Partition[#,  2,  1]] &,  cl]

ShowGraph[Highlight[CompleteGraph[10],  cl]]

TIMING DISCUSSION
As I discovered when I timed OrientGraph, the ExtractCycles function is extremely and unnecessarily slow. This function seems amenable to significant speedup. Here is a timing experiment. Though the new version seems to be roughly 3-4 times faster than the old function, it could probably be much faster.

g  =  Table[GridGraph[i*5,  5],  {i,  5}];

Table[ 
      Timing[ ExtractCycles[g[[i]]]; ],  {i, 5}]

h  =  
        Table[DiscreteMath`OldCombinatorica`GridGraph[i*5,  5],  {i,  
            5}];

Table[ 
      Timing[ DiscreteMath`OldCombinatorica`ExtractCycles[
            h[[i]]]; ],  {i, 5}]

DeleteCycle

?DeleteCycle

NOTE
* This function should probably be able to delete several cycles in one shot.

ShowGraph[
      DeleteCycle[
        CompleteGraph[10],  {1,  2,  3,  4,  5,  6,  7,  8,  9,  
          10,  1}]]

IdenticalQ[
      DeleteCycle[
        Wheel[10],  {1,  2,  3,  4,  5,  6,  7,  8,  9,  1}],  
      Star[10]]

TIMING DISCUSSION
Both versions of DeleteCycle are pretty fast and there is not much scope for improvement here.

g  =  GridGraph[30,  30];

Timing[ DeleteCycle[
          g,  {1,  2,  3,  33,  32,  31,  1}]; ]

h  =  DiscreteMath`OldCombinatorica`GridGraph[30, 30];

Timing[ DiscreteMath`OldCombinatorica`DeleteCycle[
          g,  {1,  2,  3,  33,  32,  31,  1}]; ]

Girth

?Girth

NOTES
* The new Girth should probably return a cycle that realizes thegirth. It might have been fun to have a construction of a graph with arbitrarily large girth AND arbitrarily large chromatic number.  Nesetril and Rodl supposedly have a construction that is not too complicated.

Girth[Wheel[10]]

Girth[GridGraph[5,  5]]

Girth[Cycle[10]]

ShowGraph[t  =  AddEdges[Cycle[10],  {{{1,  6}}}]]

Girth[t]

Girth[CompleteGraph[4,  4]]

Girth[RandomTree[10]]

TIMING DISCUSSION
I need to look at the code of Girth to figure out what its asymptotic running time is. The plot below indicates that it is superlinear. I suspect it's running time is cubic.
The new version of Girth is a shade faster than the older version of Girth. Can it be speeded up significantly?

gt  =  
        Table[RandomGraph[i*10,   .4],  {i, 1,  10}];

rt = 
      Table [ Timing[ Girth[gt[[i]]]; ],  {i, 10}]

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

ht  =  
        Table[DiscreteMath`OldCombinatorica`RandomGraph[i*10,   .4],  {i, 
            1, 10}];

rt = 
      Table [ Timing[DiscreteMath`OldCombinatorica`Girth[
              ht[[i]]]; ],  {i, 10}]

OutDegree

?OutDegree

OutDegree[
      t  =  SetGraphOptions[GridGraph[5,  7],  
          EdgeDirection -> On]]

ShowGraph[t,  VertexNumber -> On,  
      PlotRange -> Large[0.07]]

OutDegree[
      SetGraphOptions[GraphUnion[10,  CompleteGraph[1]],  
        EdgeDirection -> On]]

InDegree

?InDegree

InDegree[
      SetGraphOptions[GridGraph[5,  5],  EdgeDirection -> On]]

ReverseEdges

?ReverseEdges

NOTES
* The new ReverseEdges has been created to help in writing the new InDegree function. This plays the same role that TransposeGraph played in the earlier implementation. Now I have gotten rid of TransposeGraph. Two questions I have are (1) Should the new ReverseEdges be public? (2) Should the new ReverseEdges be more general in the sense that any subset of edges should be reversible?

ShowGraph[
      t  =  SetGraphOptions[GridGraph[5,  5],  
          EdgeDirection -> On]]

ShowGraph[ReverseEdges[t]]

EulerianQ

?EulerianQ

EulerianQ[CompleteGraph[9]]

EulerianQ[Cycle[10]]

EulerianQ[t  = GridGraph[5,  5]]

ShowGraph[t,  VertexNumber -> On,  
      PlotRange -> Large[0.05]]

ShowGraph[t  =  DeleteVertices[t,  {1,  5,  21,  25}],  
      VertexNumber -> On]

EulerianQ[t]

ShowGraph[
      t  =  DeleteEdges[
          t,  {{9,  10},  {16,  20},  {12,  13},  {2,  
              6}}]]

EulerianQ[t]

$RecursionLimit = 100000000000

g  =  GridGraph[70, 70];

Timing[  EulerianQ[g]; ]

Timing[ ConnectedQ[g]; ]

The new EulerianQ is  reatively slow because of new ConnectedQ, as can be seen from the above example. When I replace the current ConnectedQ by the faster version, we should see a significant speedup in the new EulerianQ as well. It is quite amazing how slow the old version of EulerianQ is; I suppose I should not use that as a benchmark!

g  =  GridGraph[30, 30];

Timing[  EulerianQ[g]; ]

h  =  DiscreteMath`OldCombinatorica`GridGraph[30, 30];

Timing[  DiscreteMath`OldCombinatorica`EulerianQ[ 
          h ]; ]

EulerianCycle

?EulerianCycle

EulerianCycle[CompleteGraph[4,  4]]

EulerianCycle[Hypercube[4]]

g  =  Table[Hypercube[i],  {i, 3, 10}];

Table[
      Timing[ EulerianCycle[ g[[i]] ];],  {i,  5}]

Table[
      Timing[ ExtractCycles[ g[[i]] ];],  {i,  5}]

The seemingly strange  non-monotonic behaviour of the EulerianCycle function is because of the fact that Hypercubes with odd dimension are non-Eulerian, while the rest are. EulerianCycle starts by first checking if the given graph is Eulerian. 
The bottleneck for this function also is ExtractCycles, when that is speeded up,  EulerianCycle will be faster. Of course, the new version of the function is faster than the old version, but again that is no big consolation.

h  =  
        Table[DiscreteMath`OldCombinatorica`Hypercube[i],  {i, 3,  
            7}];

Table[
      Timing[ DiscreteMath`OldCombinatorica`EulerianCycle[ 
            h[[i]] ];],  {i,  5}]

DeBruijnGraph

?DeBruijnGraph

ShowGraph[t  =  DeBruijnGraph[{0, 1},  4]]

states  =  
        Map[FromCharacterCode,  
          Map[(# + 48) &,  Strings[{0, 1},  3]]];

ShowGraph[
      SetGraphOptions[t,  
        Table[{{i},  VertexLabel -> states[[i]]},  {i,  
            Length[states]}]],  
      PlotRange -> {{-0.1,  1.2},  {-0.1,  1.2}}]

EulerianQ[t]

states[[EulerianCycle[t]]]

In my view, it is more important to construct a DeBruijn graph, than a DeBruijn sequence - in fact it is simply one extra line of code to go from a DeBruijn graph to a DeBruijn sequence. So for now, I have replaced the function DeBruijnSequence by the new DeBruijnGraph. Of course we could always have both the graph and the sequence function.

Along with the DeBruijn graph and Hypercube, we might also consider other interconnection networks like the shuffle-exchange, butterfly network etc.

Table[
      Timing[ DeBruijnGraph[ {0,  1},  i];],  {i,  3,  
        10}]

Table[
      Timing[ DeBruijnGraph[ 2,  i];],  {i,  3,  10}]

We are able to constuct a 10-dimensional DeBruijn graph (with 1024 vertices) in 4.29 seconds - not bad - is there scope for improvement?

HamiltonianCycle

?HamiltonianCycle

HamiltonianCycle[CompleteGraph[3,  3],  All]

ShowGraph[t  =  RegularGraph[4,  7],  
      VertexNumber -> On]

HamiltonianCycle[t]

HamiltonianCycle[
      AddEdges[GridGraph[5,  5],  {{{1,  25}}}]]

HamiltonianCycle[ GridGraph[5, 5] ]

g  =  Table[ GridGraph [i,  i],  {i,  3, 6}];

Table [ 
      Timing[  HamiltonianCycle[ g[[i]] ]; ],  {i,  
        4}]

h  =  
        Table [ 
          DiscreteMath`OldCombinatorica`GridGraph[i, i],  {i, 3, 
            6}];

Table [ 
      Timing[  DiscreteMath`OldCombinatorica`HamiltonianCycle[ 
            h[[i]] ]; ],  {i,  4}]

There is virtually no difference between the running times of the old version and the new version of Hamiltonian Cycle. Again, I think this is a candidate for improvement.

SetEdgeWeights

?SetEdgeWeights

This function assigns random weights to edges or vertices of a graph.

Edges[SetEdgeWeights[GridGraph[5,  5]], EdgeWeight]

Edges[
      SetEdgeWeights[GridGraph[5,  5],  
        WeightingFunction -> RandomInteger,  WeightRange -> {10,  20}], 
      EdgeWeight]

Edges[
      SetEdgeWeights[GridGraph[5,  5],  WeightingFunction -> Random,  
        WeightRange -> {-10,  10}], EdgeWeight]

Edges[
      SetEdgeWeights[GridGraph[3,  3],  WeightingFunction -> Euclidean], 
      EdgeWeight]

GetEdgeWeights[
      SetEdgeWeights[RandomGraph[10,   .3],  
        WeightingFunction -> Euclidean]]

SetVertexWeights

?SetVertexWeights

*BUG: SetVertexWeights should have the same syntax as setEdgeWeights.

GetVertexWeights[
      SetVertexWeights[GridGraph[3,  3],  Random,  
        Integer,  {10,  20}]]

GetVertexWeights[SetVertexWeights[GridGraph[3,  3]]]

GetEdgeWeights

?GetEdgeWeights

g  =  
        SetEdgeWeights[GridGraph[5,  5],  
          WeightingFunction -> RandomInteger,  
          WeightRange -> {0,  10}];

GetEdgeWeights[g]

GetVertexWeights

?GetVertexWeights

GetVertexWeights[g]

g  =  
        SetVertexWeights[g,  Random,  
          Integer,  {100,  200}];

GetVertexWeights[g]

CostOfPath

?CostOfPath

g  =  
      SetEdgeWeights[GridGraph[4,  4], WeightingFunction -> RandomInteger,  
        WeightRange -> {1,  5}]

CostOfPath[g,  {1,  2,  3,  4,  8,  12}]

CostOfPath[
      g,  {1,  2,  3,  4,  5,  6,  7,  8,  9,  10}]

TravelingSalesman

?TravelingSalesman

g  =  
      SetEdgeWeights[Cycle[10],  WeightingFunction -> RandomInteger,  
        WeightRange -> {1,  3}]

TravelingSalesman[g]

GetEdgeWeights[
      g  =  SetEdgeWeights[CompleteGraph[4],  
          WeightingFunction -> RandomInteger, 
          WeightRange ->  {1,  100}]]

TravelingSalesman[g]

GetEdgeWeights[
      g  =  SetEdgeWeights[Wheel[6],  
          WeightingFunction -> Euclidean]]

p  =  TravelingSalesman[g]

CostOfPath[g,  p]

CostOfPath[g,  {1,  2,  4,  3,  5,  6,  1}]

CostOfPath[g,  {1,  2,  6,  3,  4,  5,  1}]

g  =  
        Table[SetEdgeWeights[CompleteGraph[i], 
            WeightingFunction ->  RandomInteger,  
            WeightRange -> {1,  100}],  {i,  5,  8}];

Table[ 
      Timing[ TravelingSalesman[ g[[i]] ]; ],  {i,  
        4}]

HamiltonianCycle and TravelingSalesman are very similar functions and any ideas for speeding up one can be applied to the other. For TravelingSalesman, there are different heuristics that can be used.

TriangleInequalityQ

?TriangleInequalityQ

I don't see this function used very much and so this is another candidate for deletion. I also wonder if I can implement this more efficiently - I simply construct a matrix of edge weights and then use the old code.

GetEdgeWeights[g  =  SetEdgeWeights[GridGraph[2,  2]]]

TriangleInequalityQ[g]

The above function returns true because there are no triangle in the grid graph!

GetEdgeWeights[g  =  SetEdgeWeights[CompleteGraph[5]]]

TriangleInequalityQ[g]

As expected, randomly chosen edge weights will typically not satisfy the triangle inequality.
Below I set weights in K_4 to satisfy the triangle inequality.

g  =  
      SetGraphOptions[
        CompleteGraph[
          4],  {{{{1,  2},  {2, 3},  {3,  4},  {1,  4}},  
            EdgeWeight -> 1},  {{{2,  4},  {1,  3}},  
            EdgeWeight -> 1.5}}]

TriangleInequalityQ[g]

g  =  SetGraphOptions[g,  EdgeDirection -> On]

TriangleInequalityQ[g]

TravelingSalesmanBounds

?TravelingSalesmanBounds

TravelingSalesmanBounds[Wheel[5]]

TransitiveClosure

?TransitiveClosure

ShowGraph[
      g  =  SetGraphOptions[GridGraph[4,  4],  EdgeDirection -> On],  
      VertexNumber -> On]

Here is an attempt to make the edges in the orginal graph show up in a different color as compared to the new edges added during by transitive closure. It does not quite work as one would want because of "hidden" edges such as {1, 3}, {1, 4}, {1, 9}, amd {1, 13} that are added by transitive closure AND because of the order in which the edges are rendered.

Edges[g]

ShowGraph[gg  =  TransitiveClosure[g],  
      Append[Edges[g], EdgeColor -> Red], VertexNumber -> On]

Edges[gg]

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

g  =  GridGraph[10, 10];

Timing[ TransitiveClosure[g]; ]

As expected, the new TransitiveClosure is slower than the old TransitiveClosure because the new version converts edge lists into an adjacency matrix representation and then simply uses the old code. I might be able to do this faster by not going into adjacency matrix representation??

TransitveQ

?TransitiveQ

ShowGraph[
      g  =  SetGraphOptions[RandomGraph[10,  0.3],  
          EdgeDirection -> On],  VertexNumber -> On]

TransitiveQ[g]

TransitiveQ[TransitiveClosure[g]]

TransitiveQ[
      SetGraphOptions[CompleteGraph[10],  EdgeDirection -> On]]

TransitiveQ[
      g  =  SetGraphOptions[CompleteGraph[3,  3,  3],  
          EdgeDirection -> On]]

ShowGraph[g]

ReflexiveQ

?ReflexiveQ

ReflexiveQ[g  =  CompleteGraph[10]]

g  =  AddEdges[g,  Table[{{i, i}},  {i,  10}]];

ReflexiveQ[g]

g  =  DeleteEdges[g,  {{1,  1}}];

ReflexiveQ[g]

AntiSymmetricQ

?AntiSymmetricQ

ShowGraph[
      g  =  SetGraphOptions[Wheel[20],  EdgeDirection -> On]]

AntiSymmetricQ[g]

ShowGraph[g  =  AddEdges[g,  {{{2,  1}}}]]

AntiSymmetricQ[g]

PartialOrderQ

?PartialOrderQ

PartialOrderQ[g  =  GridGraph[3,  3]]

g   =  TransitiveClosure[g];

Edges[g]

PartialOrderQ[g]

TransitiveReduction

?TransitiveReduction

ShowGraph[
      TransitiveReduction[
        g  = SetGraphOptions[GridGraph[4,  4],  
            EdgeDirection -> On]]]

ShowGraph[g  =  TransitiveClosure[g]]

ShowGraph[TransitiveReduction[g]]

HasseDiagram

ShowGraph[
      s  =  MakeGraph[
          Subsets[4],  ((Intersection[#2,  #1] === #1)  &&  (#1  !=  #2)) &]]

ShowGraph[t  = HasseDiagram[s],  VertexNumber -> On]

TopologicalSort

?TopologicalSort

ShowGraph[
      g  = SetGraphOptions[GridGraph[5, 5],  EdgeDirection -> On],  
      VertexNumber -> On]

ShowGraph[HasseDiagram[g],  VertexNumber -> On]

TopologicalSort[g]

ShowGraph[
      g  =  AddEdges[
          DeleteEdges[g,  {{9,  10}}],  {{{10,  9}}}]]

TopologicalSort[g]

ShowGraph[g  =  MakeGraph[Range[12],  (Mod[#2,  #1] == 0) &],  
      VertexNumber -> On]

ShowGraph[HasseDiagram[g],  VertexNumber -> On]

TopologicalSort[g]

ChromaticPolynomial

?ChromaticPolynomial

g  =  CompleteGraph[5];

ChromaticPolynomial[g, z]

g  =  GraphUnion[10,  CompleteGraph[1]];

ChromaticPolynomial[g,  z]

ChromaticPolynomial[RandomTree[10],  z]

g  =  DeleteEdges[CompleteGraph[5],  {{1,  2}}];

ChromaticPolynomial[g,  z]

ChromaticPolynomial[Cycle[5],  z]

Table[{Timing[ DiscreteMath`OldCombinatorica`ChromaticPolynomial[
              DiscreteMath`OldCombinatorica`Cycle[i],  z];],  
        Timing[ChromaticPolynomial[Cycle[i],  z];]},  {i,  5,  
        10}]

The speedup is not exciting! Clearly,more work is needed here.

Expand[
      wheelpoly[z_]  =  ChromaticPolynomial[Wheel[5],  z]]

Table[wheelpoly[z],  {z,  1,  7}]

ChromaticNumber

?ChromaticNumber

ChromaticNumber[Cycle[7]]

ChromaticNumber[CompleteGraph[4,  5]]

g  =  GridGraph[5, 5];

Timing[ ChromaticNumber[g]; ]

This function is hopelessly slow since it uses ChromaticPolynomials. We have to find other ways of finding an optimal coloring. I ran out of patience in trying the color the above 5X5 grid graph.

TwoColoring

?TwoColoring

TwoColoring[t = RandomTree[20]]

$RecursionLimit = 100000;

TwoColoring[CompleteGraph[3,  3,  3]]

g  =  
        Table[DiscreteMath`OldCombinatorica`GridGraph[i,  i],  {i,  10,  
            30,  10}];

h  =  
        Table[GridGraph[i,  i],  {i,  10,  30,  10}];

Table[{Timing[DiscreteMath`OldCombinatorica`TwoColoring[
              g[[i]]];],  
        Timing[TwoColoring[h[[i]]];]},  {i,  3}]

The new version of BreadthFirstTraversal returns levels of vertices as well. This can be used to obtain a one-line TwoColoring function. However, as can be seen from below, the new version is slightly slower, even though both versions are much faster than the old version of two coloring.

MyTC[ g_Graph]  :=  
      Map[If[EvenQ[#],  1,  2] &, 
        BreadthFirstTraversal[g,  1,  Level]]

MyTC[ t ]

Table[ Timing[ MyTC[h[[i]]]; ],  {i,  3}]

BipartiteQ

?BipartiteQ

BipartiteQ[Wheel[10]]

BipartiteQ[Star[10]]

BipartiteQ[GridGraph[5,  5]]

BipartiteQ[Cycle[5]]

VertexColoring

?VertexColoring

VertexColoring[CompleteGraph[4]]

VertexColoring[GridGraph[10,  10]]

c  =  VertexColoring[ g  =  Wheel[30] ]

p  =  Table[Flatten[Position[c,  i], 1],  {i,  Max[c]}]

ShowGraph[ Highlight[g,  p] ]

g  =  
        Table[DiscreteMath`OldCombinatorica`GridGraph[i,  i],  {i,  5,  
            30,  10}];

h  =  
        Table[GridGraph[i,  i],  {i,  5,  30,  10}];

Table[{Timing[DiscreteMath`OldCombinatorica`VertexColoring[
              g[[i]]];],  
        Timing[VertexColoring[h[[i]]];]},  {i,  3}]

Originally, I used Steve's code for this and was amazed at how slow both the new and the old implementations were (though the new implementation was just a little faster than the old implementation). I rewrote this function and the speedup is now significant significant!

g  =  ExactRandomGraph[30,  100];

ShowGraph[g]

c  =  VertexColoring[g]

p  =  Table[Flatten[Position[c,  i], 1],  {i,  Max[c]}]

ShowGraph[Highlight[g, p]]

EdgeColoring

?EdgeColoring

EdgeColoring[Wheel[10]]

c  = EdgeColoring[GridGraph[5,  5]]

g  =  LineGraph[GridGraph[5, 5]];

p  =  Table[Flatten[Position[c,  i], 1],  {i,  4}]

ShowGraph[Highlight[g,  p],  VertexNumber -> On]

ep  =  
      Map[Edges[g = GridGraph[5,  5]][[#]] &,  p]

ShowGraph[Highlight[g,  ep]]

g  =  
        Table [ GridGraph[i, i],  {i,  10,  30,  10}];

Table[Timing[ EdgeColoring[ g[[i]] ];],  {i, 2}]

Table[ 
      Timing[ LineGraph[ g[[i]] ]; ],  {i, 2}]

h  =  
        Table [ 
          DiscreteMath`OldCombinatorica`GridGraph[i, i],  {i,  10, 30, 
            10}];

Table[
      Timing[  DiscreteMath`OldCombinatorica`EdgeColoring[ 
            h[[i]] ];],  {i, 2}]

Table[
      Timing[  DiscreteMath`OldCombinatorica`LineGraph[ 
            h[[i]] ];],  {i, 2}]

Brelaz's Heuristic has been speeded up and that shows up in the speedup of the new implementation of edge coloring. However, the construction of a line graph is quite slow and when that is speeded up, it will take much less than 22 seconds to color the edges in a 20X20 grid graph. Note that about 18 of the 22 seconds is spent in construction of the line graph. Of course, the new version still beats the old version by far.  Notice how in the old version 25 seconds is spent on constructing the line graph, but about 165 seconds is spent in coloring the graph.

EdgeChromaticNumber

?EdgeChromaticNumber

EdgeChromaticNumber[Star[10]]

ShowGraph[t  = LineGraph[Wheel[10]]]

ChromaticPolynomial[t,  z]

It takes too long to compute the chromatic polynomial of the above line graph!

MaximumClique

?MaximumClique

MaximumClique[t]

MaximumClique[Turan[6,  4]]

MaximumClique[CompleteGraph[10]]

MaximumClique[t = RandomGraph[10,   .5]]

ShowGraph[t,  VertexNumber -> On]

t  =  RandomGraph[20,   .5];

Timing[MaximumClique[t];]

In my view, without significant repair work, this function is pretty much useless. It cannot even handle a 20-vertex random graph, gracefully!

CliqueQ

?CliqueQ

CliqueQ[CompleteGraph[12],  Range[12]]

CliqueQ[CompleteGraph[12],  Range[5]]

CliqueQ[RandomGraph[10,   .5],  Range[5]]

MinimumVertexCover

?MinimumVertexCover

?Highlight

ShowGraph[
      Highlight[g  =  RandomGraph[10,   .6],  MinimumVertexCover[g],  
        HighlightedVertexColors -> {Blue}]]

ShowGraph[
      Highlight[g  =  RandomGraph[14,   .3],  MinimumVertexCover[g], 
        HighlightedVertexColors ->  {Blue}]]

VertexCoverQ

?VertexCoverQ

MinimumVertexCover[GridGraph[4,  4]]

c  =  {2, 4, 5, 7, 10, 12, 13, 15}

VertexCoverQ[GridGraph[4,  4],  c]

VertexCoverQ[GridGraph[4,  4],  Complement[c,  {2}]]

MaximumIndependentSet

?MaximumIndependentSet

ShowGraph[
      Highlight[g = RandomGraph[10,  .4],  MaximumIndependentSet[g],  
        HighlightedVertexColors -> {Purple}]]

These algorithms for vertex cover, independent set, clique etc. are pretty useless. The need is for significant improvements in these algorithms, for simple and possibly randomized heuristics that provide good approximation etc.

IndependentSetQ

?IndependentSetQ

IndependentSetQ[CompleteGraph[3,  3],  {1,  2,  3}]

IndependentSetQ[CompleteGraph[3,  3],  {3,  4}]

PerfectQ

PerfectQ is definitely useless as it is. It cannot even compute whether a 8-vertex graph is Perfect or not. No point in having this function around.