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