# Efficiently delete cyclic permutations in list [duplicate]

Edit I think I misused the words cyclic permutation. I mean rotating the list, but not changing the order: the permutations I'd like to consider for $a,b,c,d$ are $(b,c,d,a)$, $(c,d,a,b)$, $(d,a,b,c)$ but not $(b,a,c,d)$. Please let me know if you know the exact terminology.

I have a list of a few million 5-tuples and want to delete duplicates given a specified tolerance, and also cyclic permutations. For example, f[{{1.,2.,3.,4.,5.},{4.01,4.99,1.,2.03,3.2}}] should return {{1.,2.,3.,4.,5.}}.

The following naive approach works but is very slow for big lists:

n = 5;
norm[list1_, list2_] :=
Min[Norm /@ (list2 - # & /@ NestList[RotateLeft, list1, n - 1])]

Union[{{1., 2., 3., 4., 5.}, {4.01, 4.99, 1., 2.03, 3.2}},
SameTest -> (norm[#1, #2] < .3 &)]
(* {1., 2., 3., 4., 5.} *)


Example for a larger list:

tab = RandomReal[1, {5000, n}];
Union[tab, SameTest -> (norm[#1, #2] < .3 &)];//AbsoluteTiming
(* ~ 5 seconds *)


Are there some better solutions? If you post an answer, please explain the idea behind it, as it not always easy to understand.

• This sounds like a sensible thing to do, however it doesn't have a well-defined solution. For example, if vector x is close to y and y is close to z, but x is not close to z what should be returned? y? or x and z? Do you just want a list where 1) all members of the input list are close to a member of the output list; and 2) no members of the output list are close together? Commented Oct 8, 2016 at 14:41
• @mikado I will choose the tolerance sufficiently small that it does not matter if it returns x, y or z. I want a list were no member is close to another or its cyclic permutations, so 2). In other words, two elements of the output should not be cyclic permutations of each other. Commented Oct 8, 2016 at 14:46
• So the empty list will do? :) Commented Oct 8, 2016 at 14:49
• @mikado Hehe I agree that the problem is not well-defined, but I'm fine with a "list order"-dependent algorithm. Commented Oct 8, 2016 at 14:51
• Oops, you're right. Try this: cyclicPermutationQ[v1_, v2_] := Length[v1] == Length[v2] && MatchQ[Quiet[FindPermutation[v1, v2], FindPermutation::norel], Cycles[{v : {__Integer} /; Length[v] == 5}]]. Commented Oct 8, 2016 at 15:15

SameTest is not always the best way to approach such tasks because it forces a pairwise comparison between all elements. That means $O(n^2)$ complexity.

A better way is to construct a canonical form. Transform each element to a standard form so that equivalent elements will look identical. The functions like Union or DeleteDuplicates can use $O(n \log n)$ algorithms based on sorting instead of pairwise comparison.

Of course such a canonical form doesn't always exist, but sometimes we can use approximations. The problem here is comparison with a tolerance. This isn't a proper equivalence relation anyway because it is not transitive ... I.e. with a tolerance of 0.01, 1.00 == 1.01 and 1.01 == 1.02, but 1.00 != 1.02.

What we can do instead is Round the numbers. Then consider numbers in the same rounding bin to be equivalent. The reason why this is just an approximation is that with a rounding bin size of 0.1, 3.09 and 3.11 would be considered different. Still, this technique is useful to throw out as many duplicates as possible. If the list gets much smaller, then a SameTest based method will be much faster as a post-processing step.

What about a canonical form to deal with permutation? Cyclically rotate each list so that the smallest element comes first. Here I'm assuming that the sublists do not contain duplicates, otherwise there may be multiple smallest elements at different positions.

Here's a function to construct a canonical form for equivalent cyclic permutations:

can1 = RotateLeft[#, Ordering[#, 1] - 1] &


Here's one for comparison with a tolerance of 0.5:

can2 = Round[#, 0.05] &


Then use DeleteDuplicatesBy:

DeleteDuplicatesBy[{{1., 2., 3., 4., 5.}, {4.01, 4.99, 1., 2.03, 3.02}}, can1@*can2]

(* {{1., 2., 3., 4., 5.}} *)

tab = RandomReal[1, {5000, n}];

DeleteDuplicatesBy[tab, can1@*can2] // Length // AbsoluteTiming
(* {0.022923, 98} *)


There's room for optimization here: the rounding can be done in one step on the whole list, exploiting vectorization.

• Very instructive and efficient. Can you explain @* in can1@*can2? (It had been a long time since you last answered a question of mine!) Commented Oct 8, 2016 at 16:54
• Any ideas how it could also deal with lists with duplicates (such as {1,2,3,1,1,4}? A "partially canonical" way would be to place the minimal value which is followed by the maximal value, first. I don't think this can be done with Ordering, so I tried with Position. Just in case, this gives the same result as your can1, but slower: can1b = Function[list, RotateLeft[list, First@Position[list, _?(# == Min[list] &)][[1]] - 1]]. My idea was to change the [[1]] to [[2]] etc. but this does not work with lists which have no duplicates. Commented Oct 8, 2016 at 18:15
• @anderstood, can1 @* can2 is shorthand for Composition[can1, can2] that was introduced in version 10. Commented Oct 8, 2016 at 18:33
• You can get a canonical order with cannonical[list_List] := First[Sort[NestList[RotateLeft, list, Length[list] - 1]]]. This does not allow for tolerances, but I don't think it is possible to design a robust canonical order with tolerances. Commented Oct 8, 2016 at 18:59
• @J.M. The difference with @ is that it holds the expression? I'm asking because f@g@h@x and f@*g@*h@x both return f[g[h[x]]]. Commented Oct 8, 2016 at 19:17