Remove or change edge weights of graph with good performance

Question

How can I remove edge weights from a graph, or change all edge weights in one go, with good performance, while preserving edge ordering?

Consider this weight vector and unweighted graph:

weights = RandomReal[1, 5000];
g = RandomGraph[{1000, 5000}];

Adding the weights to the graph is very fast:

wg = Graph[g, EdgeWeight -> weights]; // RepeatedTiming
(* {0.000010, Null} *)

The only way I know to either remove all these weights, or to change the entire edge-weight vector, is to re-build the graph. This is much too slow for my purposes.

g2 = Graph[VertexList[wg], EdgeList[wg]]; // RepeatedTiming
(* {0.0027, Null} *)

wg2 = Graph[VertexList[wg], EdgeList[wg], EdgeWeight -> 2 weights]; // RepeatedTiming
(* {0.0028, Null} *)

Is there a much faster way? I am looking for something comparable in performance to setting the initial weights.

---

Update:

Originally I neglected to say that I strongly prefer a solution that maintains edges ordering. Consider for example the task of computing the EdgeBetwennessCentrality of a weighted and unweighted version of a graph. The result of this function depends on edge ordering.

Carl's original answer based on Nucleus does maintain edge ordering. The solution based on adjacency matrices is much faster, but it does not maintain edge ordering.

Finally, the performance of these solutions depends on the kind of graph we use. Here's a better benchmark:

g1 = ExampleData[{"NetworkGraph", "CondensedMatterCollaborations"}];
g2 = RandomGraph[{VertexCount[g1], EdgeCount[g1]}, EdgeWeight -> RandomReal[1, EdgeCount[g1]]];

Let us preserve all graph options except edge weights. Re-building the graph from vertices and edges is actually slightly faster than re-building it with Nucleus for g1:

wg = g1;

ug = Activate[Nucleus[wg] /. Rule[EdgeWeight, _] -> Sequence[]]; // RepeatedTiming
(* {0.22, Null} *)

ug = Graph[VertexList[wg], EdgeList[wg], FilterRules[Options[wg], Except[EdgeWeight]]]; // RepeatedTiming
(* {0.15, Null} *)

For g2, the timings are 0.011 and 0.056, i.e. Nucleus is significantly faster than the straightforward re-building.

Thus overall Nucleus is still a significant win for performance. But I am still hoping for further improvement, or at least a solution which is never slower than the naïve rebuild.

I believe that the overhead of Nucleus comes from re-evaluating all the graph options (3rd Graph argument), and may be possible to eliminate with an appropriately placed Unevaluated.

The implementation I settled on for the moment is a variation of Carl's Nucleus idea:

$graphLink::usage = "$graphLink is a loopback link used to convert atomic graphs to a compound form.";
transformGraphOptions::usage = "transformGraphOptions[fun][graph] applies fun to the list of options stored in graph.";
transformGraphOptions[fun_][g_?GraphQ] :=
    (
      If[Not@MemberQ[Links[], $graphLink],
        $graphLink = LinkCreate[LinkMode -> Loopback];
      ];
      With[
        {
          expr = AbortProtect[
            LinkWrite[$graphLink, g];
            LinkRead[$graphLink, Hold]
          ]
        },
        Replace[expr, Hold@Graph[v_, e_, opt : _ : {}, rest___] :> Graph[v, e, fun[opt], rest]]
      ]
    )

IGUnweighted[g_?IGEdgeWeightedQ] := transformGraphOptions[ FilterRules[#, Except[EdgeWeight]]& ][g]
IGUnweighted[g_?GraphQ] := g

For g1 above it runs in about 0.18-0.19 seconds on my machine.

Answer 1

Update

Thinking about this some more, my answer had three components:

1. "Inactivate" the Graph
2. Process the inactivated Graph
3. Activate the graph

For your example, the inactivate part (using Nucleus) took about .2 ms, while the activation part took about .45 ms. However, if all we care about is creating a graph with the same vertices and no weights, we could skip step 1 and just construct the graph using step 3. So, a slightly faster way to regenerate a graph with the right edge weights is the following:

ng = Graph[
    VertexList[wg],
    {Null, AdjacencyMatrix[wg]}
]; //RepeatedTiming

{0.00043, Null}

And a check that ng has the same WeightedAdjacencyMatrix as the original:

WeightedAdjacencyMatrix[g] === WeightedAdjacencyMatrix[ng]

True

Old answer

You could use my Nucleus function (which is derived from one of your ideas) to convert the Graph object to an Inactive expression, delete or modify the offending EdgeWeight option, and then Activate. Here I repeat the Nucleus definition:

Nucleus[input_, head_:Automatic] := With[
    {
    atoms = Replace[head,
        {
        Automatic :> If[AtomQ[input], {Head[input]}, Message[Nucleus::atom]; $Failed],
        h_Symbol :> {h},
        h:{__Symbol} :> h,
        _ :> (Message[Nucleus::syms,head,2];$Failed)
        }
    ]
    },
    (
    If[!MemberQ[Links[], $AtomLink] || LinkReadyQ[$AtomLink],
        Quiet @ LinkClose[$AtomLink];
        $AtomLink = LinkCreate[LinkMode -> Loopback]
    ];
    LinkWrite[$AtomLink, input];
    inactiveBlock[atoms, LinkRead[$AtomLink]]
    ) /; atoms =!= $Failed
]

SetAttributes[inactiveBlock, HoldAll]
inactiveBlock[h_List, body_] := Block @@ Join[
    Apply[Set, Hold @ Evaluate @ Thread[{h,Inactive/@h}], {2}],
    Hold[body]
]

Nucleus::syms = "Argument `1` at position `2` is expected to be a symbol or a list of symbols";
Nucleus::atom = "Unable to determine atomic symbol";

Then, use Nucleus:

ng = Activate[Nucleus[wg] /. Rule[EdgeWeight,_]->Sequence[]]; //RepeatedTiming

WeightedAdjacencyMatrix[ng] === WeightedAdjacencyMatrix[g]

{0.00063, Null}

True

A little over 4 times faster than rebuilding the Graph, but over 60 times slower than setting the initial weights, so I hope there's something better.