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!

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

5 Answers 5

Reset to default
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"}
Improve this answer
$\endgroup$
3
  • $\begingroup$ Nice work, Thanks! $\endgroup$
    – Jieyu You
    May 16, 2017 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, 2017 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, 2017 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}}

Improve this answer
$\endgroup$
1
  • $\begingroup$ Fortunately, BitClear[] is now built-in: Union[BitClear[Range[0, 2^n - 1], k]] $\endgroup$
    – J. M.'s lack of A.I. ♦
    May 18, 2017 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

Improve this answer
$\endgroup$
4
  • $\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, 2017 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, 2017 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, 2017 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, 2017 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}}
Improve this answer
$\endgroup$
0
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

Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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