3
$\begingroup$

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.

$\endgroup$
5
$\begingroup$

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.

$\endgroup$
5
  • $\begingroup$ Thank you. This seems to work with some duplicities. I would like to understand what you do but I can't quite figure it out. Would you be willing to help? We can go by parts. Could you please as a first step provide a "good" argument for the function f? I cannot even figure out what that might be. And, what is the meaning of the argument {n} for SparseArray in this case? Perhaps you might also explain just in general what the idea is behind this. You start with an IntegerPartition (you already explained well how they code these lists of ones and zeroes) ... and then? Thank you. $\endgroup$
    – EGME
    Mar 27 at 19:42
  • $\begingroup$ The {n} in SparseArray is just the dimension of the vector that is supposed to be generated. $\endgroup$ Mar 27 at 19:49
  • $\begingroup$ Usage example for f: f /@ IntegerPartitions[n, {k}]. $\endgroup$ Mar 27 at 19:53
  • $\begingroup$ Thanks! Let me ponder this and work on it some more. I am almost sure that what you write in the comment above generates all such vectors, so the key thing is the sieving ... but then I don't know if you could end up sieving out an entire rotation class. I will try to understand further. I will probably ask you some more questions down the road. $\endgroup$
    – EGME
    Mar 27 at 20:48
  • $\begingroup$ I used to think about this mostly in terms of gaps, i.e., of sequences of consecutive zeros. The idea behind list is that it contains only vectors that start with a greatest gap. (Unfortunately, that does define a unique representative in the equivalence class because there can be more than one greatest gap.) $\endgroup$ Mar 28 at 20:59
2
$\begingroup$

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}}*)
$\endgroup$
2
  • $\begingroup$ Hi, if I understand the code of your second solution correctly, you are generating all the strings with n1 1s and n2 0s in the third line (Permutations[li]), is that correct. If that is the case, this is something I want to avoid, and generate only one string per rotation class, ideally the largest such string if you convert it to a number using FromDigits[#,2]& $\endgroup$
    – EGME
    Mar 21 at 20:14
  • $\begingroup$ That's correct. The problem is: if you can create only a single permutation for every rotation class, then you problem is already solved. I you have some clever idea, let me know. $\endgroup$ Mar 21 at 20:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.