0
$\begingroup$

I have been stuck in this problem for a long time.

I need to find a general code to collect all binary numbers which are at most n digits (<2^(n-1)) with the kth digit equal to 0. For example, I need to find all binary numbers in the form of x0xx (4 digits with the second one equal to 0), then I need to write three For loops and get the answer: {0000,0001,0010,0011,1000,1001,1010,1011}. However, if I change the value of n or k, I need to modify my code, so now I am trying to find a general code for any n and k.

My idea is

ithzero = Compile[{{k, _Integer},{n,_Integer}}, nul = {};Do[nul = Append[nul, BaseForm[i, 2]*Boole[IntegerDigits[i, 2, n][[k]] == 0]], {i, 0, 2^n - 1}]];

However, I am not satisfied with this code, because it gives many 0s due to Boole. By the way, I still don't have any idea about how to verify if x is in ithzero[n,k]. I thought 5\[Element]ithzero[5,2] is a logic expression, but it isn't.

I am very grateful to any help!

$\endgroup$
  • $\begingroup$ ToString /@ Row /@ Select[Tuples[{0, 1}, n /. n -> 4], (#[[k /. k -> 2]] == 0) &] $\endgroup$ – LouisB May 16 '17 at 6:04
2
$\begingroup$

Consider Tuples. For example:

fn[n_, k_] /; 0 < k <= n :=
  Tuples @ ReplacePart[Table[{0, 1}, {n}], k -> {0}]

FromDigits[fn[4, 2]\[Transpose]]
{0, 1, 10, 11, 1000, 1001, 1010, 1011}

Or as strings:

ToString /@ Row /@ fn[4, 2]
{"0000", "0001", "0010", "0011", "1000", "1001", "1010", "1011"}
$\endgroup$
  • $\begingroup$ Nice work, Thanks! $\endgroup$ – Jieyu You May 16 '17 at 16:17
  • $\begingroup$ By the way, is there a neat way to convert {0, 1, 10, 11, 1000, 1001, 1010, 1011} into decimal numbers? $\endgroup$ – Jieyu You May 16 '17 at 17:57
  • $\begingroup$ @JieyuYou Certainly, just specify the correct base in FromDigits: FromDigits[fn[4, 2]\[Transpose], 2] gives {0, 1, 2, 3, 8, 9, 10, 11} $\endgroup$ – Mr.Wizard May 17 '17 at 5:07
4
$\begingroup$

Could use bit operations:

f[n_, k_] := Union @ BitAnd[Range[0,2^n-1], BitXor[2^n-1, 2^k]]

f[4, 2]
IntegerDigits[f[4, 2], 2, 4]

{0, 1, 2, 3, 8, 9, 10, 11}

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

Another faster possibility:

g[n_, k_] := Flatten @ Outer[Plus, 2^(k+1) Range[0, 2^(n-k-1)-1], Range[0, 2^k-1]]

g[4, 2]
IntegerDigits[g[4, 2], 2, 4]

{0, 1, 2, 3, 8, 9, 10, 11}

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

$\endgroup$
  • $\begingroup$ Fortunately, BitClear[] is now built-in: Union[BitClear[Range[0, 2^n - 1], k]] $\endgroup$ – J. M. is away May 18 '17 at 8:52
0
$\begingroup$
f1[n_, k_] := Insert[#, 0, k] & /@ Tuples[{0, 1}, n - 1]
f1[4, 2]
(*{{0, 0, 0, 0}, {0, 0, 0, 1}, {0, 0, 1, 0}, {0, 0, 1, 1}, {1, 0, 0, 0},
{1, 0, 0, 1}, {1, 0, 1, 0}, {1, 0, 1, 1}}*)

Instead of mapping each element and inserting 0, we can transpose the list and use Insert[] to insert a ConstantArray.

f2[n_, k_] := Insert[#, ConstantArray[0, 2^(n - 1)], k] &@ 
Transpose@Tuples[{0, 1}, n - 1] // Transpose

f1[20,3]//AbsoluteTiming
f2[20,3]//AbsoluteTiming
fn[20,3]//AbsoluteTiming (*Mr.Wizard's solution*)

0.21

0.14

0.02

$\endgroup$
  • $\begingroup$ Insert while clear is orders of magnitude slower than using Tuples alone, and uses far more memory. I encourage you compare the two. $\endgroup$ – Mr.Wizard May 16 '17 at 6:41
  • $\begingroup$ @Mr.Wizard Yes, you are right. I checked it and it is almost an order of magnitude slower compared to yours. I don't seem to understand the purpose of insert at all if it can't be applied even for a question like this. It might be because of mapping the list. I tried to use Insertin a different way, but it is still slower than yours, please check the edit. Can I include the timing of your solution for the purpose of comparison? $\endgroup$ – Anjan Kumar May 16 '17 at 7:04
  • $\begingroup$ Of course you may include timings for my function if you wish. Insert is very useful it just isn't particularly fast as it must be applied once for each element. It is almost always faster to perform vectorized operations in Mathematica, apart from compilation. See e.g. (7996) for some possibly useful examples. $\endgroup$ – Mr.Wizard May 16 '17 at 7:17
  • $\begingroup$ Also Tuples is especially fast (see (4751)) so it is best for performance to use it directly rather than further processing its output, where possible. $\endgroup$ – Mr.Wizard May 16 '17 at 7:19
0
$\begingroup$

This answer is updated.

In:

Clear[f]
f[n_, k_] := Module[{xss},
  xss = Tuples[{0, 1}, n];
  xss [[All, k]] = 0 xss [[All, k]] ;
  Union[xss]]
 f[5, 1]

Out:

{{0, 0, 0, 0, 0}, {0, 0, 0, 0, 1}, {0, 0, 0, 1, 0}, {0, 0, 0, 1, 
  1}, {0, 0, 1, 0, 0}, {0, 0, 1, 0, 1}, {0, 0, 1, 1, 0}, {0, 0, 1, 1, 
  1}, {0, 1, 0, 0, 0}, {0, 1, 0, 0, 1}, {0, 1, 0, 1, 0}, {0, 1, 0, 1, 
  1}, {0, 1, 1, 0, 0}, {0, 1, 1, 0, 1}, {0, 1, 1, 1, 0}, {0, 1, 1, 1, 
  1}}
$\endgroup$
0
$\begingroup$

Where k is position from right:

f[n_, k_] := 
 Flatten[IntegerDigits[2^k # + Range[0, 2^(k - 1) - 1], 2, n] & /@ 
   Range[0, 2^(n - k) - 1], 1]
Row@(ArrayPlot[f[6, #], PlotLabel -> Row[{"k=", #}], 
     ImageSize -> 100] & /@ Range[6])

enter image description here

Where k is position from left:

g[n_, k_] := f[n, n - k + 1]
Row@(ArrayPlot[g[6, #], PlotLabel -> Row[{"kl=", #}], 
     ImageSize -> 100] & /@ Range[6])

enter image description here

$\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.