Speeding up the generation of all k-edge-coloring of a graph

Question

A $k$-edge-coloring of a graph $G=(V,E)$ is a function from $E$ to $\{1,\ldots,k\}$, so in other words every edge of $G$ receives one of the $k$ colors available. (In particular, note that we are not talking about proper $k$-edge-colorings, but just all colorings).

I want to generate all possible $k$-edge-colorings of a given graph. The number of such colorings is given by the Stirling number of second kind, so there are $S(m,k)$ $k$-edge-coloring for a given graph, where $m$ is the number of edges.

What I am currently doing is this:

<< Combinatorica`;
g = System`RandomGraph[{7, 10}, VertexLabels -> "Name"]
numColors = 3;
c = {Red, Green, Blue, Purple, Cyan, Magenta, Orange, Yellow};
p = Combinatorica`KSetPartitions[EdgeList[g], numColors];

First[Timing[
  all = Flatten[
    Reap[
      For[i = 1, i <= Length[p], ++i,
       Do[
          Scan[(PropertyValue[{g, #}, EdgeStyle] = c[[k]]) &, 
           p[[i]][[k]]],
          {k, 1, numColors}
          ] 
         Sow[g];
       ]
      ] // Last]]]

It seems to work correctly, but it's pretty slow (I know the number $S(m,k)$ can be huge). KSetPartitions is not really a bottleneck, but we can speed it up a little with the help of this answer. Other than that, I guess setting PropertyValues might be slow to begin with.

Is there a way to speed up the generation process?

Answer 1

This is much faster in my machine:

el = Sort /@ EdgeList[g];
eSF[pos_, vert_, kset_] := {c[[Position[kset, Sort@vert][[1, 1]]]], Line[pos]}
genG[el_, kSet_] := System`Graph[el, EdgeShapeFunction -> (eSF[##, kSet] &), VertexLabels -> "Name"]
all1 = genG[el, #] & /@ p; // Timing
(* {0.790625, Null} *)

The "new" PropertyValue[] is nice, but a time hog.

Grid@Partition[all1[[1 ;; 9]], 3]

Answer 2

Try this:

First[Timing[
  all = Graph[g, 
      EdgeStyle -> 
       Thread[Rule[
         Function[set, 
           If[Length[set] > 1, Alternatives @@ set, First@set]] /@ #, 
         c[[;; numColors]]]]] & /@ p]]