How to optimize performance with DeleteDuplicates?

Question

Does anyone know how to improve this for speed performance? The code works fine, but DeleteDuplicates makes it really slow for large lists.

removeDuplicatesWithRules[mylist_] := Module[{rules, isDuplicateQ},
   
   rules = 
    Flatten /@ (Subsets[{{1 -> 2, 2 -> 1}, {3 -> 4, 4 -> 3}, {5 -> 6, 
         6 -> 5}, {7 -> 8, 8 -> 7}, {9 -> 10, 10 -> 9}}]);
   
   (*Function to check if two elements are considered duplicates \
based on rules*)
   isDuplicateQ[element1_, element2_] := 
    AnyTrue[rules, ((element1 /. #) /. 
         List :> Composition[Sort, List]) == (element2 /. 
         List :> Composition[Sort, List]) &];
   
   (*Function to remove duplicates from a list*)
   DeleteDuplicates[mylist, isDuplicateQ[#1, #2] &]
   
   ];

(*Example test list*)
mylist = {{1, 2}, {2, 1}, {3, 4}, {4, 3}, {5, 6, {7, 8, 2}}, {5, 
    6, {8, 7, 1}}, {7, 8}, {9, 10}, {10, 9}, {11, 12}};

(*Applying the function*)
removeDuplicatesWithRules[mylist]

(* {{1, 2}, {3, 4}, {5, 6, {7, 8, 2}}, {7, 8}, {9, 10}, {11, 12}} *)

Update:

I didn't check it carefully, and the current solution doesn't provide the correct result in some cases.

For example:

elm1 = {{2}, {4, 5, 8, 9}, {1, 3, 6, 7, 10}};
elm2 = {{1}, {4, 5, 8, 9}, {1, 3, 6, 7, 10}};

makestandard = i_?EvenQ :> (i - 1);
Equal @@ ({elm1, elm2} /. makestandard)

These two elements are not the same based on the list of rules above ((#1 /. a rule) = #2). makestandard makes them identical. However, there not exist any rule in rules that makes (elm1 /. a rule) = elm2.

Answer 1

In checking duplicates, you are considering 2, 4, 6, 8, 10 are the same as 1, 3 ,5, 7, 9, respectively. Then, instead of testing all possible replacement, I recommend you to convert into standard forms:

mylist = {{1, 2}, {2, 1}, {3, 4}, {4, 3}, {5, 6, {7, 8, 2}}, {5, 
    6, {8, 7, 1}}, {7, 8}, {9, 10}, {10, 9}, {11, 12}}; 

makestandard = i_?EvenQ :> (i - 1);
DeleteDuplicatesBy[mylist, (# /. makestandard) &]

(* {{1, 2}, {3, 4}, {5, 6, {7, 8, 2}}, {7, 8}, {9, 10}, {11, 12}} *)

Answer 2

This answer is for the case where the order does matter. While OP's question asks for case where the order does not matter at any level.

First of all rules can be stored in a much more neat form.

Instead of OP's

(* rules = 
    Flatten /@ (Subsets[{{1 -> 2, 2 -> 1}, {3 -> 4, 4 -> 3}, {5 -> 6, 
         6 -> 5}, {7 -> 8, 8 -> 7}, {9 -> 10, 10 -> 9}}]); *)

we can use

rules = {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}};

We define a function compare that can be used inside DeleteDuplicates.

compare[x_, y_, ru_] := 
 Block[{q, r = Sort /@ ru}, 
  MatchQ[Replace[{x, y}, Except[_List] -> Nothing, All], {p_, 
     p_}] && (q = Sort /@ Union@Transpose[Flatten /@ {x, y}]; 
    Union[Length /@ 
       Union /@ 
        Join[GatherBy[q, #[[1]] &], GatherBy[q, #[[2]] &]]] == {1}) &&
    ContainsAll[r, Sort /@ DeleteCases[q, {p_, p_}]]]

rules = {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}};

mylist1 = {{1, 2}, {2, 1}, {3, 4}, {4, 3}, {5, 6, {7, 8, 2}}, {5, 
    6, {8, 7, 1}}, {7, 8}, {9, 10}, {10, 9}, {11, 12}};

DeleteDuplicates[mylist1, compare[#1, #2, rules] &]

mylist2 = {{{2}, {4, 5, 8, 9}, {1, 3, 6, 7, 10}}, {{1}, {4, 5, 8, 
     9}, {1, 3, 6, 7, 10}}};

DeleteDuplicates[mylist2, compare[#1, #2, rules] &]

---

{{1, 2}, {3, 4}, {5, 6, {7, 8, 2}}, {7, 8}, {9, 10}, {11, 12}}

{{{2}, {4, 5, 8, 9}, {1, 3, 6, 7, 10}}, {{1}, {4, 5, 8, 9}, {1, 3, 6, 7, 10}}}

Different rules:

rules = {{9, 6}, {3, 10}, {4, 2}, {1, 5}, {7, 8}};

mylist3 = {{1, {2, 3, 2}, {{{3, 4}, 5, 1}, 6}, 4, 7, 8, 9, 
    10}, {5, {2, 3, 2}, {{{10, 4}, 1, 5}, 6}, 4, 8, 7, 9, 
    10}, {1, {4, 10, 4}, {{{10, 2}, 5, 1}, 9}, 2, 7, 8, 6, 3}};

DeleteDuplicates[mylist3, compare[#1, #2, rules] &]

---

{{1, {2, 3, 2}, {{{3, 4}, 5, 1}, 6}, 4, 7, 8, 9, 
  10}, {5, {2, 3, 2}, {{{10, 4}, 1, 5}, 6}, 4, 8, 7, 9, 10}}

Answer 3

I build upon A. Kato's idea to use a normalization: First turn each element into a unique representative of the equivalence class. Then run vanilla DeleteDuplicates. This guarantees that the default comparison function can be used, which I expect to be the fastest.

The small price to pay here is that the result does not look exactly as if just the first occurence of an element of an equivalence class would be kept.

I assume here that your list of rules consists of pairwise disjoint cycles of length 2. To normalize an element x, we loop over all cycles in the list of rules. For each cycle c we look for the first occurrence of one of its numbers and then apply or not apply this cycle to make this first occurrence be the first number in the cycle. If I am not mistaken, this define a unique respresentative for each equivalence class.

Here is the normalization function:

ClearAll[normalize];
normalize[x0_, cycles_] := Module[{x = x0, p},
   Do[
    p = FirstPosition[x, Alternatives @@ c];
    If[! MissingQ[p] && (! Extract[x, p] == c[[1]]),
     x = x /. {c[[1]] -> c[[2]], c[[2]] -> c[[1]]}
     ];
    , {c, cycles}];
   x
   ];

Here is a usage example:

cycles = {{9, 6}, {3, 10}, {4, 2}, {1, 5}, {7, 8}};

mylist3 = {
  {1, {2, 3, 2}, {{{3, 4}, 5, 1}, 6}, 4, 7, 8, 9, 10}, 
  {5, {2, 3, 2}, {{{10, 4}, 1, 5}, 6}, 4, 8, 7, 9, 10}, 
  {1, {4, 10, 4}, {{{10, 2}, 5, 1}, 9}, 2, 7, 8, 6, 3}
};

DeleteDuplicates[normalize[#, cycles] & /@ mylist3]

{{1, {4, 3, 4}, {{{3, 2}, 5, 1}, 9}, 2, 7, 8, 6, 10}, {1, {4, 3, 4}, {{{10, 2}, 5, 1}, 9}, 2, 7, 8, 6, 10}}

It seems to work also for the updated problem:

cycles = {{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}};

elm1 = {{2}, {4, 5, 8, 9}, {1, 3, 6, 7, 10}};
elm2 = {{1}, {4, 5, 8, 9}, {1, 3, 6, 7, 10}};

normalize[elm1, cycles] != normalize[elm2, cycles]

True

Disclaimer: I (maybe falsely) assumed that the ordering within each element mattered. This is might not be what OP ask for.