# generating tuples of ones and zeroes with a fixed number of ones

I would like to generate all the tuples of ones and zeros of a given length and with a given number of ones without generating all the possible tuples, which is impossible for tuples of large enough length (but for which the tuples with fixed number of ones is small). For example, if we consider lists of length 3, and number of ones equal to 2, I would like to directly generate {{0,1,1},{1,0,1},{1,1,0}} without having to generate the 8 tuples of length 3.

For those interested, I posted this related question: Generating representatives of rotation classes of tuples of ones and zeros with a fixed number of ones

L[n_, m_] := Permutations@Array[Boole[# <= m] &, n]

L[3, 2]
(*    {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}}    *)

– EGME
Mar 17 at 16:02
• @EGME, if this answers your question, mark it as the correct answer. Mar 17 at 16:05
• I wonder if there is a way to monitor the progress of the function when there are nevertheless many tuples ... with monitor ... is there in today's functionality the equivalent of the old Combinatorica NextPermutation?
– EGME
Mar 17 at 16:08
• @EGME have a look at the NextPermutation function on the Wolfram Functions Repository. Mar 17 at 17:31
With[{n = 5, k = 2},
ReplacePart[ConstantArray[0, n], Thread[# -> 1]] & /@
Subsets[Range[n], {k}]]


{{1, 1, 0, 0, 0}, {1, 0, 1, 0, 0}, {1, 0, 0, 1, 0}, {1, 0, 0, 0, 1}, {0, 1, 1, 0, 0}, {0, 1, 0, 1, 0}, {0, 1, 0, 0, 1}, {0, 0, 1, 1, 0}, {0, 0, 1, 0, 1}, {0, 0, 0, 1, 1}}

– EGME
Mar 17 at 16:02
f[len_,wt_] := Table[
Boole[MemberQ[sub,i]],
{sub,Subsets[Range[len],{wt}]},
{i,len}
]


Try it online!

Subsets[Range[len],{wt}] is designed to pick out all possible wt-tuples of indices from 1 to len. We simply use Boole to decide when a particular index i is in a particular subset sub, and loop over all such subsets and indices.

ClearAll[L2]

L2[n_, m_] := Permute[PadRight[ConstantArray[1, m], n], SymmetricGroup @ n]

L2[3, 2]

 {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}}

L2[4, 2]

{{1, 1, 0, 0}, {1, 0, 1, 0}, {1, 0, 0, 1}, {0, 1, 1, 0},
{0, 1, 0, 1}, {0, 0, 1, 1}}

• quite elegant way!
– alex
Mar 23 at 16:29
ClearAll[f0]
f0 = Module[{ss = MapIndexed[Thread[{#2[], #}] &, Subsets[Range@#, {#2}]]},
SparseArray[Join @@ ss -> 1, {Length@ss, #}]] &;


Examples:

f0[3, 2] f0[3, 2] // Normal

 {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}}

f0[5, 2] // Normal

{{1, 1, 0, 0, 0},
{1, 0, 1, 0, 0},
{1, 0, 0, 1, 0},
{1, 0, 0, 0, 1},
{0, 1, 1, 0, 0},
{0, 1, 0, 1, 0},
{0, 1, 0, 0, 1},
{0, 0, 1, 1, 0},
{0, 0, 1, 0, 1},
{0, 0, 0, 1, 1}}


How can we stop without offering a recursive idea? Compact the binary elements into integers for fast processing:

intperm[n_, 0] := {0}
intperm[n_, 1] := Array[2^# &, n, 0]
intperm[n_, m_] := 2^n - 1 - # & /@ intperm[n, n - m] /; m > n/2
intperm[n_, m_] := (intperm[n, m] =
Join[2 intperm[n - 1, m - 1] + 1, 2 intperm[n - 1, m]])
binperm[n_, m_] := IntegerDigits[#, 2, n] & /@ intperm[n, m]


Interestingly, for large $$n$$, the time taken is entirely dominated by IntegerDigits.