Removing edge weights from a Graph

Question

Bug introduced in 8.0 and fixed in 12.2.

---

How can I remove EdgeWeights from a Graph without affecting any other properties of the graph?

Let's construct a graph with weights:

g = RandomGraph[{10, 20}, EdgeWeight -> ConstantArray[1, 20]]

Based on the documentation I would expect the following to return Automatic (the same thing it returns for a graph that has no edge weights):

PropertyValue[RemoveProperty[g, EdgeWeight], EdgeWeight]

(* ==> {1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1} *)

However, it returns the weights that were originally set.

The following seems to work, but it removes other properties as well

PropertyValue[RemoveProperty[g], EdgeWeight]

(* ==> Automatic *)

Extracting the edges and vertices, then re-building the graph will discard other properties as well. Graph objects are atomic, and they don't have a Mathematica-expression form, so trying to modify them at the expression level is not a possibility either.

How can one then remove EdgeWeights from a Graph without modifying any other properties of the Graph?

Update: It turns out WeightedGraphQ@RemoveProperty[g] still returns True. So even though the weight values are removed, the system still considers the graph to be weighted.

Answer 1

This has to be a bug. I think Graph never really associates EdgeWeight with corresponding edges.

Here is a simplified example.

g = Graph[{1, 2, 3}, {
                Property[1 <-> 2, EdgeWeight -> x],
                         1 <-> 3,
                Property[2 <-> 3, EdgeWeight -> y]
                }];

gNew = RemoveProperty[{g, 1 <-> 2}, EdgeWeight];
gNew2 = SetProperty[{g, 1 <-> 2}, EdgeWeight -> Missing["Nonexistent"]];


Outer[
            PropertyValue[{#1, #2}, EdgeWeight] &,
            {g, gNew, gNew2},
            {1 <-> 2, 1 <-> 3, 2 <-> 3}
            ] // TableForm[#, 
                TableHeadings -> {{"g", "gNew", "gNew2"},
                 {1 <-> 2, 1 <-> 3, 2 <-> 3}}] & // Quiet

Notice the gNew row, how EdgeWeights are mis-aligned when the preceding one (i.e. x) deleted. And the 3rd column gives us a clue how PropertyValue extracts EdgeWeight -- that is, by Part.

I would definitely call this a bug.

---

The workaround I can come up with are two ways. The easy way is as I did for gNew2 -- instead of removing it, replacing it with a placeholder. While the hard way is to permute the to-be-delete edge to the end of edge-list before performing the delete:

myRemoveEdgeWeight[g_, e_] :=
    Module[{vl = VertexList[g], el = EdgeList[g], pos, ewl, ew},
        pos = Position[el, e];
        el = Insert[Delete[el, pos], e, -1];
        ewl = PropertyValue[g, EdgeWeight];
        ew = Extract[ewl, pos][[1]];
        ewl = Insert[Delete[ewl, pos], ew, -1];
        Graph[vl, el, EdgeWeight -> ewl] //
            RemoveProperty[{#, e}, EdgeWeight] &
        ]

PropertyValue[{myRemoveEdgeWeight[g, 1 <-> 2], #}, EdgeWeight] & /@
 {1 <-> 2, 1 <-> 3, 2 <-> 3}

{{1, y}[[3]], 1, y}

Answer 2

I should post this as a comment, but it is too long. Perhaps I'll delete it later.

There is also some nuisance with RandomGraph[]. Compare the following equivalent graphs:

n = 6;
g = CompleteGraph[n, EdgeWeight -> Range[n (n - 1)/2]]
WeightedAdjacencyMatrix[g] // MatrixForm
g1 = RandomGraph[{n, n (n - 1) /2}, EdgeWeight -> Range[n (n - 1)/2]]
WeightedAdjacencyMatrix[g1] // MatrixForm

Edit

Answering Szabolcs's comment:

n = 6;
g = CompleteGraph[n, EdgeWeight -> Range[n (n - 1)/2]];
w = WeightedAdjacencyMatrix[g] // MatrixForm;
g1 = RandomGraph[{n, n (n - 1) /2}, EdgeWeight -> Range[n (n - 1)/2]];
w1 = WeightedAdjacencyMatrix[g1] // MatrixForm;
Row[{w, w1}]

Answer 3

IGUnweighted in IGraph/M can do this.

---

A possible implementation is

Graph[ VertexList[g], EdgeList[g], FilterRules[Options[g], Except[EdgeWeight]] ]

However, this is not as fast as it could be. The current implementation IGraph/M uses is similar to how Carl Woll's Nucleus function works.

Answer 4

The bug appears to have been fixed in V13.0.0 or earlier

Answer 5

You can use simple loop.

Before

For[i = 1, i <= Length@EdgeList@bridge, i++,
  bridge = RemoveProperty[{bridge, EdgeList[bridge][[i]]}, EdgeLabels]]; 
bridge

After