Generating representatives of rotation classes of tuples of ones and zeros with a fixed number of ones

Question

In a related question I asked how to generate all the tuples of ones and zeroes with a fixed number of ones (generating tuples of ones and zeroes with a fixed number of ones). I wish to consider a more challenging problem. Here we have, for example, all the five-tuples with two ones, numbered on the right

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

However, note that tuples 1, 4, 5, 8, 10 are rotations of each other, and the remaining tuples are rotations of each other. What I want is to generate just two tuples, one corresponding to each rotation class, without generating the rest of the tuples, for example, say, {1, 1, 0, 0, 0} and {1, 0, 1, 0, 0}. I got very good answers to my previous question, but I can't quite see how to extend any of those answers to solve this problem. I would particularly like to see a solution which can be monitored with monitor as the solutions are generated. Only some of the solutions offered to my previous question have this feature, even though they are all great solutions. Many thanks in advance.

Answer 1

Not sure whether this works always correctly.

Say you want the lost of all $n$-tuples with $k$ 1 up to rotation. You can encode such a tuple by going through it in clockwise order and by counting the number of steps from one 1 to the next. This gives you k integers that ought to sum to n. We can always rotate this list of k integers, such that its maximum gets in front. The following tries to generate all these tuples.

n = 5;
k = 2;

f = Normal[SparseArray[Partition[Accumulate[#], 1] -> 1, {n}]] &;
lists = Map[ p \[Function] Map[f[Prepend[#, p[[1]]]] &, Permutations[Rest[p]]], 
  IntegerPartitions[n, {k}]]
result = Join @@ lists;

The members of lists may still contain a couple of duplicates. But these sublists are probably sufficiently small to just run a brute force test on them and join the sublists afterwards.

Explanation:

f takes an list, say {a[1],...,a[k]} whose entries sum to n and returns returns a vector of 0 and 1 with the first 1 at position a[1], the second ant position a[1]+a[2], third at a[1]+a[2]+a[3} and so on. If the list has k entries, the vector will have exactly k 1s in it.

My first idea was to use

f /@ Join @@ (Permutations /@ IntegerPartitions[n, {k}])

to generate a bunch of vectors with exactly k 1-entries. Since this list has many duplicates up to rotation, I tried to sieve out a couple of duplicates by permuting only the second to last entries of each integer partition vector. Thus the somewhat complicated expression for list.

Answer 2

We first define the number of 1's: n1 and the number of 0' s: n2 and create a single sample list: li:

n1 = 2; n2 = 3; n = n1 + n2;
li = Join[Table[1, n1], Table[0, n2]];

We now create all different permutations of the sample list.

perm = Union@Permutations[li];

We now have a lot of rotated list in perm that we need to delete. Towards this aim we rotate every permutation and delete permutations whose first rotated list is a member of another set of a rotated permutation:

rot = Table[RotateRight[#, i], {i, n}] & /@ perm;
res = DeleteDuplicates[rot, MemberQ[#1, #2[[1]]] &];

We now have the results in form of all rotations. We choose the first one as a representative:

res = First /@ res

(* {{1, 0, 0, 0, 1}, {1, 0, 0, 1, 0}} *)

Update

Here is a more elegant solution using a hash function:

n1 = 2; n2 = 3; n = n1 + n2;
li = Join[Table[1, n1], Table[0, n2]];
rot = Table[RotateRight[#, i], {i, n}] & /@ Permutations[li];
hash = ((Times @@ FromDigits[#, 2]) &@#) & /@ rot;
res = GatherBy[Transpose[{hash, rot}], First][[All, All, 2, 1, 1]]

(*{{0, 1, 0, 0, 1}, {0, 0, 0, 1, 1}}*)