This problem is simple enough, that halirutan's brute force method is still $O(n)$ complexity for comparing two necklaces of length $n$ (which is optimal). But I would like to offer an intelligent approach, which although not being faster here (in fact it's probably not even $O(n)$) (turns out I was wrong), can be useful in many problems of this sort.
The solution is to define a canonical order for a necklace.
- The first element shall be the minimal element.
- If there are several minimal elements, we shall choose the one, whose neighbor (to the left or right) is smallest.
- If this still doesn't resolve ambiguities, we will continue in the separately chosen for each of the minimal elements direction and check subsequent neighbors.
- If all list elements have been considered and no conclusion is reached, prefer to take the sequence where the search went to the right (i.e. do not reverse the list).
- And if even that doesn't resolve the issue, I'm almost confident it doesn't matter which of the remaining starting points is picked, the output list will be the same, but let's pick the minimal element with the smallest index as the start of the list in canonical form.
The code below does just that.
toCanonical[list_] := Module[{pos, l = Length@list},
(* find positions of minimum element *)
pos = MinimalBy[With[{p = Position[list, Min@list]},
ArrayFlatten[{{1, p, p + 1}, {-1, p, p - 1}}]],
list[[Mod[#[[3]], l, 1] ]] &];
pos = NestWhile[
(pos[[;; , 3]] += pos[[;; , 1]];
pos = MinimalBy[pos,
list[[ Mod[#[[3]], l, 1] ]] &]) &, pos,
Length[#] > 1 &, 1, l - 2] // First;
If[pos[[1]] == 1, RotateLeft[list, pos[[2]] - 1],
RotateLeft[list, pos[[2]]] // Reverse]
]
The algorithm is realised by the repeated updating of pos; it is initially a column of 3-tuples.
The first element is the direction of search (+1 or -1). The second element is the starting point of the search -- the index of one of the minimal elements of the list. The third element is the index (mod length list) of the next element to be considered (as described in steps 2 and 3).
MinimalBy with each iteration removes from pos the rows whose third elements point to an element of the list which is not the smallest.
The NestWhile runs a maximum of Length[list] - 2 times, since the preceding code has already checked a minimal element and a neighbor. At the end, the first tuple surviving is selected (picking the first tuple fulfills steps 4 and 5, however I ran this on a large set of random numbers and it doesn't seem to matter, which tuple to apply to put the list into canonical form, the result is the same).
Finally the list is rotated left to put the element indexed by the second element of the tuple at the start of the list, if the search went to the right, or at the end of the list if the search went to the left, in which case the list is then reversed.
DeleteDuplicatesBy[{{1, 1, 2, 1, 1, 2}, {1, 2, 1, 1, 2, 1}, {1, 2, 2, 1, 2, 2},
{1, 2, 2, 2, 1, 3}, {1, 2, 3, 1, 2, 3}, {1, 3, 1, 2, 2, 2}, {1, 3, 2, 1, 3, 2},
{2, 2, 1, 2, 2, 1}, {2, 2, 1, 3, 1, 2}, {2, 2, 2, 1, 3, 1}, {2, 3, 1, 2, 3, 1}},
toCanonical]
{{1, 1, 2, 1, 1, 2}, {1, 2, 2, 1, 2, 2}, {1, 2, 2, 2, 1, 3}, {1, 2, 3, 1, 2, 3}}
lists = RandomInteger[3, {40, 4}];
GatherBy[lists, toCanonical] // Grid
{1, 1, 0, 0}
{1, 3, 2, 1}
{1, 2, 0, 2} {2, 0, 2, 1}
{2, 0, 3, 1} {3, 1, 2, 0} {2, 1, 3, 0} {0, 2, 1, 3}
{2, 0, 1, 3} {2, 0, 1, 3} {1, 0, 2, 3}
{2, 3, 2, 3}
{2, 1, 1, 1}
{2, 1, 3, 3} {3, 3, 1, 2}
{1, 3, 3, 0} {0, 3, 3, 1} {3, 3, 0, 1} {3, 3, 1, 0}
{0, 1, 0, 1}
{3, 2, 2, 1}
{0, 2, 2, 2} {2, 0, 2, 2}
{0, 2, 0, 1} {0, 1, 0, 2}
{3, 2, 2, 3}
{3, 3, 2, 3}
{3, 0, 1, 1}
{3, 2, 1, 0}
{1, 2, 1, 2}
{2, 3, 2, 0} {3, 2, 0, 2}
{0, 0, 0, 2}
{0, 3, 2, 2}
{0, 0, 0, 3}
{2, 1, 0, 0}
{0, 2, 2, 0}
{2, 2, 1, 2}
{1, 1, 0, 1}
{2, 1, 2, 3}
Speed turns out better than halirutan's solution, even after I compiled his pickFunc to C with RuntimeOptions -> "Speed"!
list = RandomInteger[{1, 3}, {5000, 10}];
AbsoluteTiming[DeleteDuplicatesBy[list, toCanonical];]
2.81648
AbsoluteTiming[deleteNecklaceDuplicates[list];]
5.16653
UPDATE
One more update: the 3rd argument of the NestList statements is replaced from Length[a] to Length[a] - 1. Besides the very fast parallelization of a compiled function, this is optimal, since finding the canonical from a list of all equivalent permutations is achievable by an O(n) radix sort.
Since I've been foolish enough to try to implement my own canonical form finder instead of generating all valid permutations and letting MMA sort them (as in the answer by Shadowray), not to mention wasting several hours writing this and letting myself get ninja'd by him :-) I'll throw in a benchmark for his approach and an afterthought.
(* Shadowray's solution *)
myDeleteDuplicateNecklaces[list]; // AbsoluteTiming
(* 0.202244 *)
However this transforms all elements to canonical order as well. If that's not desired then Shadowray's canonicalForm like so:
DeleteDuplicatesBy[list, canonicalForm]; // AbsoluteTiming
(* 0.290911 *)
This can be made much faster by compiling the canonicalForm:
compCanonical =
Compile[{{a, _Integer, 1}},
Sort[NestList[RotateLeft, a, Length[a] - 1]~Join~
NestList[RotateLeft, Reverse[a], Length[a] - 1]
] // First,
RuntimeAttributes -> {Listable},
CompilationTarget -> "C",
Parallelization -> True,
RuntimeOptions -> "Speed"]
Note how this leverages the special listability options of Compile'd functions: if I run this on a rank-2 array, it will map at level 1, while a top-level Listable function will map at level 2. So if conserving non-canonical forms is not necessary, one can do
DeleteDuplicates[compCanonical[list]]
(* ...; // AbsoluteTiming -> 0.0217732 *)
which is another order of magnitude faster. And if we want to keep the original forms, then
DeleteDuplicatesBy[list, compCanonical]; // AbsoluteTiming
(* 0.0797666 *)
{1, 2, 3, 4, 5}andReverse[RotateLeft[{1, 2, 3, 4, 5}, 2]]? $\endgroup$