4 added 448 characters in body
source | link
ClearAll[monotoneDigits]
monotoneDigits = Module[{a = Accumulate[Binomial[#, Range[-1, #]]]},
 Join[{ConstantArray[0, 2^#]}, 
  IntegerDigits[Join@@Range[2^Most[1 + a] - 1, 2^Rest[a] - 1, 2^Most[a]], 2, 2^#]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

Update: An alternative using Tuples in combination with PadLeft and PadRight:

ClearAll[paddedTuples , monotoneDigits2]
paddedTuples[t_][{m_, n_}] := PadLeft[PadRight[Rest@Tuples[{0, 1}, m], 
  {Automatic, n}, 1], {Automatic, t}] 

monotoneDigits2 = Module[{a = Transpose[{#, Accumulate@#}& @ Binomial[#, Range[0, #]]]}, 
   Join @@ (paddedTuples[2^#] /@ a)]&;

monotoneDigits2[5] == res

True

ClearAll[monotoneDigits]
monotoneDigits = Module[{a = Accumulate[Binomial[#, Range[-1, #]]]},
 Join[{ConstantArray[0, 2^#]}, 
  IntegerDigits[Join@@Range[2^Most[1 + a] - 1, 2^Rest[a] - 1, 2^Most[a]], 2, 2^#]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

ClearAll[monotoneDigits]
monotoneDigits = Module[{a = Accumulate[Binomial[#, Range[-1, #]]]},
 Join[{ConstantArray[0, 2^#]}, 
  IntegerDigits[Join@@Range[2^Most[1 + a] - 1, 2^Rest[a] - 1, 2^Most[a]], 2, 2^#]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

Update: An alternative using Tuples in combination with PadLeft and PadRight:

ClearAll[paddedTuples , monotoneDigits2]
paddedTuples[t_][{m_, n_}] := PadLeft[PadRight[Rest@Tuples[{0, 1}, m], 
  {Automatic, n}, 1], {Automatic, t}] 

monotoneDigits2 = Module[{a = Transpose[{#, Accumulate@#}& @ Binomial[#, Range[0, #]]]}, 
   Join @@ (paddedTuples[2^#] /@ a)]&;

monotoneDigits2[5] == res

True

3 deleted 8 characters in body
source | link
ClearAll[monotoneDigits]
monotoneDigits = Module[{a = Accumulate[Binomial[#, Range[-1, #]]]},
 Join[{ConstantArray[0, a[[-1]]]2^#]}, 
  IntegerDigits[Join@@Range[2^Most[1 + a] - 1, 2^Rest[a] - 1, 2^Most[a]], 2, a[[-1]]]]]&;2^#]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

ClearAll[monotoneDigits]
monotoneDigits = Module[{a = Accumulate[Binomial[#, Range[-1, #]]]},
 Join[{ConstantArray[0, a[[-1]]]}, 
  IntegerDigits[Join@@Range[2^Most[1 + a] - 1, 2^Rest[a] - 1, 2^Most[a]], 2, a[[-1]]]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

ClearAll[monotoneDigits]
monotoneDigits = Module[{a = Accumulate[Binomial[#, Range[-1, #]]]},
 Join[{ConstantArray[0, 2^#]}, 
  IntegerDigits[Join@@Range[2^Most[1 + a] - 1, 2^Rest[a] - 1, 2^Most[a]], 2, 2^#]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

2 deleted 59 characters in body
source | link
ClearAll[monotoneDigits]
monotoneDigits = Module[{a=a = Accumulate[Binomial[#, Range[0Range[-1, #]]], il},
    il = a[[-1]];
    Join[{ConstantArray[0, il]a[[-1]]]}, 
     Flatten[IntegerDigits[Range[2 #IntegerDigits[Join@@Range[2^Most[1 + 1, #2, # +a] 1],- 21, il] & @@@ 
       Partition[Prepend[2^a2^Rest[a] - 1, 0]2^Most[a]], 2, 1], 1]]] &;a[[-1]]]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

ClearAll[monotoneDigits]
monotoneDigits = Module[{a= Accumulate[Binomial[#, Range[0, #]]], il},
    il = a[[-1]];
    Join[{ConstantArray[0, il]}, 
     Flatten[IntegerDigits[Range[2 # + 1, #2, # + 1], 2, il] & @@@ 
       Partition[Prepend[2^a - 1, 0], 2, 1], 1]]] &;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

ClearAll[monotoneDigits]
monotoneDigits = Module[{a = Accumulate[Binomial[#, Range[-1, #]]]},
 Join[{ConstantArray[0, a[[-1]]]}, 
  IntegerDigits[Join@@Range[2^Most[1 + a] - 1, 2^Rest[a] - 1, 2^Most[a]], 2, a[[-1]]]]]&;

Length @ monotoneDigits[5]

2111

Rest @ monotoneDigits[5] == res (* res from Carl's answer *)

True

Length /@ (monotoneDigits /@ Range[2, 6])

{6, 17, 96, 2111, 1114238}

monotoneDigits2[3] // Column // TeXForm

$\small\begin{array}{l} \{0,0,0,0,0,0,0,0\} \\ \{0,0,0,0,0,0,0,1\} \\ \{0,0,0,0,0,0,1,1\} \\ \{0,0,0,0,0,1,0,1\} \\ \{0,0,0,0,0,1,1,1\} \\ \{0,0,0,0,1,0,0,1\} \\ \{0,0,0,0,1,0,1,1\} \\ \{0,0,0,0,1,1,0,1\} \\ \{0,0,0,0,1,1,1,1\} \\ \{0,0,0,1,1,1,1,1\} \\ \{0,0,1,0,1,1,1,1\} \\ \{0,0,1,1,1,1,1,1\} \\ \{0,1,0,0,1,1,1,1\} \\ \{0,1,0,1,1,1,1,1\} \\ \{0,1,1,0,1,1,1,1\} \\ \{0,1,1,1,1,1,1,1\} \\ \{1,1,1,1,1,1,1,1\} \\ \end{array}$

1
source | link