6 Improved formatting, corrected a typo in code, updated benchmarks
source | link

HighA high-performance solution

Since you are planning to work with thousands of "necklaces"necklaces, it it may be much faster to useintroduce a canonical form of "necklaces".

You canThe main point is to write a necklace canonization function, which transforms any necklace into its canonical form. For anyfor all equivalent necklace, this functionnecklaces should return exactly the same result (canonical form). You can then apply canonization function to all necklaces in your list and use standard DeleteDuplicates procedure afterwards.

Here I tookFor simplicity we can take First@Sort@equivalentForms[necklace] as a canonical form, where (here equivalentForms generates all necklaces equivalent to a given one). In this case the full solution can be written as:

equivalentForms[nl_] := Flatten[Map[{RotateLeft[nlJoin[NestList[RotateLeft,#] nl, RotateLeft[Reverse[nl]Length[nl] - 1],#]}& NestList[RotateLeft, Range[Length[nl]]]Reverse[nl],1] Length[nl] - 1]];
canonicalForm[nl_] := First@Sort@equivalentForms[nl];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[Map[canonicalForm,list]]

(thanks to @LLlAMnYP for suggesting a more idiomatic code for equivalentForms)

For your example it giveswe get:

{{1, 1, 2, 1, 1, 2}, {1, 2, 2, 1, 2, 2}, {1, 2, 2, 2, 1, 3}, {1, 2, 3, 1 1, 2, 3}}

Let's take a large list of 5000 necklaces:  

This@kglr's answer:

First@AbsoluteTiming[myDeleteDuplicateNecklaces[largeList];]First@AbsoluteTiming[f[largeList];]

0158.139634356

First@AbsoluteTiming[deleteNecklaceDuplicates[largeList];]First@RepeatedTiming[deleteNecklaceDuplicates[largeList];]

1.94708941

@kglr'sThis answer:

First@AbsoluteTiming[f[largeList];]First@RepeatedTiming[myDeleteDuplicateNecklaces[largeList];]

1580.356077

As we can be seensee from the benchmarks, for large lists this solution is 10 to 1000 times faster on lists of thousands "necklaces".

Parallel compiled approachUpdate: compilation and parallel evaluation optimizations

In this way, we@LLlAMnYP and @halirutan showed that canonization procedure can calculatebe significantly optimized using Mathematica's compilation and parallelization capabilities. They provided the following highly-optimized code, which calculates all canonical forms in parallel whichand gives further speedup:

canonicalFormC = Compile[{{list, _Integer, 1}},
   Module[{l = 
      NestList[RotateLeft, list, Length[list] - 1]~Join~
       NestList[RotateLeft, Reverse[list], Length[list] - 1]},
    Compile`GetElement[l, First[Ordering[l]]]
    ],
   RuntimeAttributes -> {Listable},
   Parallelization -> True,
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];
myDeleteDuplicateNecklaces[list_]myDeleteDuplicateNecklacesC[list_] := DeleteDuplicates[canonicalFormC[list]]

Speed comparison: First the original implementationBenchmark of the compiled procedure:

largeList = RandomInteger[{1, 3}, {10000, 15}];
RepeatedTiming[myDeleteDuplicateNecklaces[largeList];]
(* {0.33, Null} *)First@RepeatedTiming[myDeleteDuplicateNecklacesC[largeList];]

0.00576

Thus, compilation and here the compiled formparallelization optimizations give additional 10x speedup.

RepeatedTiming[myDeleteDuplicateNecklacesC[largeList];]
(* {0.014, Null} *)

High-performance solution

Since you are planning to work with thousands of "necklaces", it may be much faster to use canonical form of "necklaces".

You can write a function which transforms any necklace into its canonical form. For any equivalent necklace, this function should return exactly the same result. You can then apply canonization function to all necklaces in your list and use standard DeleteDuplicates procedure afterwards.

Here I took First@Sort@equivalentForms[necklace] as a canonical form, where equivalentForms generates all necklaces equivalent to a given one.

equivalentForms[nl_] := Flatten[Map[{RotateLeft[nl,#], RotateLeft[Reverse[nl],#]}&, Range[Length[nl]]],1]
canonicalForm[nl_] := First@Sort@equivalentForms[nl];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[Map[canonicalForm,list]]

For your example it gives:

{{1, 1, 2, 1, 1, 2}, {1, 2, 2, 1, 2, 2}, {1, 2, 2, 2, 1, 3}, {1, 2, 3, 1, 2, 3}}

Let's take a large list:  

This answer:

First@AbsoluteTiming[myDeleteDuplicateNecklaces[largeList];]

0.139634

First@AbsoluteTiming[deleteNecklaceDuplicates[largeList];]

1.94708

@kglr's answer

First@AbsoluteTiming[f[largeList];]

158.356

As can be seen from the benchmarks, this solution is 10 to 1000 times faster on lists of thousands "necklaces".

Parallel compiled approach

In this way, we can calculate all canonical forms in parallel which gives further speedup:

canonicalFormC = Compile[{{list, _Integer, 1}},
   Module[{l = 
      NestList[RotateLeft, list, Length[list] - 1]~Join~
       NestList[RotateLeft, Reverse[list], Length[list] - 1]},
    Compile`GetElement[l, First[Ordering[l]]]
    ],
   RuntimeAttributes -> {Listable},
   Parallelization -> True,
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[canonicalFormC[list]]

Speed comparison: First the original implementation

largeList = RandomInteger[{1, 3}, {10000, 15}];
RepeatedTiming[myDeleteDuplicateNecklaces[largeList];]
(* {0.33, Null} *)

and here the compiled form

RepeatedTiming[myDeleteDuplicateNecklacesC[largeList];]
(* {0.014, Null} *)

A high-performance solution

Since you are planning to work with thousands of necklaces, it may be much faster to introduce a canonical form.

The main point is to write a necklace canonization function, which for all equivalent necklaces should return exactly the same result (canonical form). You can then apply canonization function to all necklaces in your list and use standard DeleteDuplicates procedure afterwards.

For simplicity we can take First@Sort@equivalentForms[necklace] as a canonical form (here equivalentForms generates all necklaces equivalent to a given one). In this case the full solution can be written as:

equivalentForms[nl_] := Join[NestList[RotateLeft, nl, Length[nl] - 1], NestList[RotateLeft, Reverse[nl], Length[nl] - 1]];
canonicalForm[nl_] := First@Sort@equivalentForms[nl];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[Map[canonicalForm,list]]

(thanks to @LLlAMnYP for suggesting a more idiomatic code for equivalentForms)

For your example we get:

{{1, 1, 2, 1, 1, 2}, {1, 2, 2, 1, 2, 2}, {1, 2, 2, 2, 1, 3}, {1, 2, 3, 1, 2, 3}}

Let's take a list of 5000 necklaces:

@kglr's answer

First@AbsoluteTiming[f[largeList];]

158.356

First@RepeatedTiming[deleteNecklaceDuplicates[largeList];]

1.941

This answer:

First@RepeatedTiming[myDeleteDuplicateNecklaces[largeList];]

0.077

As we can see from the benchmarks, for large lists this solution is 10 to 1000 times faster.

Update: compilation and parallel evaluation optimizations

@LLlAMnYP and @halirutan showed that canonization procedure can be significantly optimized using Mathematica's compilation and parallelization capabilities. They provided the following highly-optimized code, which calculates all canonical forms in parallel and gives further speedup:

canonicalFormC = Compile[{{list, _Integer, 1}},
   Module[{l =
      NestList[RotateLeft, list, Length[list] - 1]~Join~
       NestList[RotateLeft, Reverse[list], Length[list] - 1]},
    Compile`GetElement[l, First[Ordering[l]]]
    ],
   RuntimeAttributes -> {Listable},
   Parallelization -> True,
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];
myDeleteDuplicateNecklacesC[list_] := DeleteDuplicates[canonicalFormC[list]]

Benchmark of the compiled procedure:

First@RepeatedTiming[myDeleteDuplicateNecklacesC[largeList];]

0.00576

Thus, compilation and parallelization optimizations give additional 10x speedup.

5 added 944 characters in body
source | link

Parallel compiled approach

In this way, we can calculate all canonical forms in parallel which gives further speedup:

canonicalFormC = Compile[{{list, _Integer, 1}},
   Module[{l = 
      NestList[RotateLeft, list, Length[list] - 1]~Join~
       NestList[RotateLeft, Reverse[list], Length[list] - 1]},
    Compile`GetElement[l, First[Ordering[l]]]
    ],
   RuntimeAttributes -> {Listable},
   Parallelization -> True,
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[canonicalFormC[list]]

Speed comparison: First the original implementation

largeList = RandomInteger[{1, 3}, {10000, 15}];
RepeatedTiming[myDeleteDuplicateNecklaces[largeList];]
(* {0.33, Null} *)

and here the compiled form

RepeatedTiming[myDeleteDuplicateNecklacesC[largeList];]
(* {0.014, Null} *)

Parallel compiled approach

In this way, we can calculate all canonical forms in parallel which gives further speedup:

canonicalFormC = Compile[{{list, _Integer, 1}},
   Module[{l = 
      NestList[RotateLeft, list, Length[list] - 1]~Join~
       NestList[RotateLeft, Reverse[list], Length[list] - 1]},
    Compile`GetElement[l, First[Ordering[l]]]
    ],
   RuntimeAttributes -> {Listable},
   Parallelization -> True,
   CompilationTarget -> "C",
   RuntimeOptions -> "Speed"
   ];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[canonicalFormC[list]]

Speed comparison: First the original implementation

largeList = RandomInteger[{1, 3}, {10000, 15}];
RepeatedTiming[myDeleteDuplicateNecklaces[largeList];]
(* {0.33, Null} *)

and here the compiled form

RepeatedTiming[myDeleteDuplicateNecklacesC[largeList];]
(* {0.014, Null} *)
4 added benchmarks
source | link

High-performance solution

Since you are planning to work with thousands of "necklaces", it may be much faster to use canonical form of "necklaces".

You can write a function which transforms any necklace into its "canonical"canonical form. For any equivalent necklace, this function should return exactly the same result. You can then apply canonization function to all necklaces in your list and use standard DeleteDuplicates procedure afterwards.

Here I took First@Sort@equivalentForms[necklace] as a canonical form, where equivalentForms generates all necklaces equivalent to a given one.

equivalentForms[nl_] := Flatten[Map[{RotateLeft[nl,#], RotateLeft[Reverse[nl],#]}&, Range[Length[nl]]],1]
canonicalForm[nl_] := First@Sort@equivalentForms[nl];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[Map[canonicalForm,list]]

For your example it gives:

smallList = {{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}};

myDeleteDuplicateNecklaces[smallList]

{{1, 1, 2, 1, 1, 2}, {1, 2, 2, 1, 2, 2}, {1, 2, 2, 2, 1, 3}, {1, 2, 3, 1, 2, 3}}

We can easily use it onBenchmarks for large input:

Let's take a large listslist: 

largeList = RandomInteger[{1, 3}, {5000, 10}];
AbsoluteTiming[myDeleteDuplicateNecklaces[largeList];]

and compare calculation times (in seconds)

This answer:

First@AbsoluteTiming[myDeleteDuplicateNecklaces[largeList];]

{0 0.139634, Null}

It@halirutan's answer

First@AbsoluteTiming[deleteNecklaceDuplicates[largeList];]

1.94708

@kglr's answer

First@AbsoluteTiming[f[largeList];]

158.356

As can be seen from the benchmarks, this solution is much much10 to 1000 times faster than DeleteDuplicates with a custom test functionon lists of thousands "necklaces".

You can write a function which transforms any necklace into its "canonical" form. For any equivalent necklace, this function should return exactly the same result. You can then apply canonization function to all necklaces in your list and use standard DeleteDuplicates procedure afterwards.

Here I took First@Sort@equivalentForms[necklace] as a canonical form, where equivalentForms generates all necklaces equivalent to a given one.

equivalentForms[nl_] := Flatten[Map[{RotateLeft[nl,#], RotateLeft[Reverse[nl],#]}&, Range[Length[nl]]],1]
canonicalForm[nl_] := First@Sort@equivalentForms[nl];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[Map[canonicalForm,list]]

For your example it gives:

smallList = {{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}};

myDeleteDuplicateNecklaces[smallList]

{{1, 1, 2, 1, 1, 2}, {1, 2, 2, 1, 2, 2}, {1, 2, 2, 2, 1, 3}, {1, 2, 3, 1, 2, 3}}

We can easily use it on large lists:

largeList = RandomInteger[{1, 3}, {5000, 10}];
AbsoluteTiming[myDeleteDuplicateNecklaces[largeList];]

{0.139634, Null}

It is much much faster than DeleteDuplicates with a custom test function.

High-performance solution

Since you are planning to work with thousands of "necklaces", it may be much faster to use canonical form of "necklaces".

You can write a function which transforms any necklace into its canonical form. For any equivalent necklace, this function should return exactly the same result. You can then apply canonization function to all necklaces in your list and use standard DeleteDuplicates procedure afterwards.

Here I took First@Sort@equivalentForms[necklace] as a canonical form, where equivalentForms generates all necklaces equivalent to a given one.

equivalentForms[nl_] := Flatten[Map[{RotateLeft[nl,#], RotateLeft[Reverse[nl],#]}&, Range[Length[nl]]],1]
canonicalForm[nl_] := First@Sort@equivalentForms[nl];
myDeleteDuplicateNecklaces[list_] := DeleteDuplicates[Map[canonicalForm,list]]

For your example it gives:

smallList = {{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}};

myDeleteDuplicateNecklaces[smallList]

{{1, 1, 2, 1, 1, 2}, {1, 2, 2, 1, 2, 2}, {1, 2, 2, 2, 1, 3}, {1, 2, 3, 1, 2, 3}}

Benchmarks for large input:

Let's take a large list: 

largeList = RandomInteger[{1, 3}, {5000, 10}];

and compare calculation times (in seconds)

This answer:

First@AbsoluteTiming[myDeleteDuplicateNecklaces[largeList];]

0.139634

@halirutan's answer

First@AbsoluteTiming[deleteNecklaceDuplicates[largeList];]

1.94708

@kglr's answer

First@AbsoluteTiming[f[largeList];]

158.356

As can be seen from the benchmarks, this solution is 10 to 1000 times faster on lists of thousands "necklaces".

3 added example
source | link
    Post Undeleted by Shadowray
2 Improved performance
source | link
    Post Deleted by Shadowray
1
source | link