How do I prune a list of pairs of numbers so that each number occurs on only one pair?
Update: I was able to improve the performance of pruner2b
below with a couple of suggestions from the screw on my cell block. In honor of the booze we make in the toilets here, I'll call it pruno
:
pruno[lst_] := Module[{f, g},
g[_] = True;
f[a_, b_] := If[g[a] && g[b], g[a] = g[b] = False; {a, b},Unevaluated@Sequence[]];
f @@@ lst];
The original idea and updated benchmark follow.
Just a quick-and-dirty idea:
pruner2b[lst_] := Module[{f},
f[_] = True;
Map[If[f[#[[1]]] && f[#[[2]]], (f[#] = False)&/@#; #,Unevaluated@Sequence[]] &, lst]]
This returns precisely the same results as Kguler's DeleteDuplicates
solution (I've not proofed that this is "optimal", in the sense of maximizing length of result).
A quick performance comparison using lstx = RandomInteger[{1, 10000}, {10000, 2}];
to generate a test list and then incrementally increasing the amount used:
By 500 pairs pruno
is over 2 orders of magnitude faster than using DeleteDuplicates
and significantly leads pruner2b
, ran out of patience much beyond that...
Taking further advantage of the speed of the pattern matcher, this is even faster for lists >~1K pairs on the loungebook (with a nod to Mr. W's "cool kids" comment - no performance difference using ##&[]
, but certainly prettier):
prunod[lst_] := Module[{f, g},
g[_] = True;
f[a_?g, b_?g] := (g[a] = g[b] = False; {a, b});
f[_, _] = ## &[];
f @@@ lst];
Maybe
lst = {{20, 11}, {17, 20}, {26, 5}, {14, 9}, {18, 13}, {19, 11}};
DeleteDuplicates[lst, Intersection[##] != {} &]
(* {{20, 11}, {26, 5}, {14, 9}, {18, 13}} *)
lst2 = {{20, 11}, {17, 20}, {26, 13}, {14, 26}, {11, 20}, {18, 13}, {19, 11}};
DeleteDuplicates[lst2, Intersection[##] != {} &]
(* {{20, 11}, {26, 13}} *)
A bit shorter than the answer by kglr is
list = {{20, 11}, {17, 20}, {26, 13}, {14, 26}, {11, 20}, {18, 13}, {19, 11}};
DeleteDuplicates[list, IntersectingQ]
But it also gets really slow for large lists.