9
$\begingroup$

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

$\endgroup$
11
$\begingroup$
L[n_, m_] := Permutations@Array[Boole[# <= m] &, n]

L[3, 2]
(*    {{1, 1, 0}, {1, 0, 1}, {0, 1, 1}}    *)
$\endgroup$
4
  • $\begingroup$ Thanks, great reply $\endgroup$ – EGME Mar 17 at 16:02
  • 1
    $\begingroup$ @EGME, if this answers your question, mark it as the correct answer. $\endgroup$ – Chanto Mar 17 at 16:05
  • $\begingroup$ 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? $\endgroup$ – EGME Mar 17 at 16:08
  • $\begingroup$ @EGME have a look at the NextPermutation function on the Wolfram Functions Repository. $\endgroup$ – Roman Mar 17 at 17:31
6
$\begingroup$
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}}

$\endgroup$
1
  • $\begingroup$ Thanks, great reply $\endgroup$ – EGME Mar 17 at 16:02
4
$\begingroup$
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.

$\endgroup$
4
$\begingroup$
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}}
$\endgroup$
1
  • $\begingroup$ quite elegant way! $\endgroup$ – Alex Mar 23 at 16:29
3
$\begingroup$
ClearAll[f0]
f0 = Module[{ss = MapIndexed[Thread[{#2[[1]], #}] &, Subsets[Range@#, {#2}]]}, 
    SparseArray[Join @@ ss -> 1, {Length@ss, #}]] &;

Examples:

f0[3, 2]

enter image description here

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}}
$\endgroup$
2
$\begingroup$

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.

$\endgroup$

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.