# Tuples optimization challenge

Consider a function that for a given integer $$0\le n <256$$ computes the number of leading zeros in its binary representation.

LeadingZeros[x_] := LengthWhile[IntegerDigits[x, 2, 8], # == 0 &]


The following histogram can be easily plotted

Histogram[
Tuples[ Range[0, 255], 2]), Automatic, "Probability"]


However, my MA crashes for the following

Histogram[LeadingZeros[#] & /@ (Min @@@ Tuples[Range[0, 255], 4])]


Can you optimize the code to be able to do this calculation.

I actually would like to perform a series of such calculations for $$k=2, 4, 8, 16, \ldots$$

Histogram[LeadingZeros[#] & /@ (Min @@@ Tuples[Range[0, 255], k])]


I suppose that for larger values of $$k$$ it is infeasible, and some randomized algorithm can be used. But I am also curious if the brute force approach can be pushed further.

• n = 8; LeadingZeros[x_, n_] := LengthWhile[IntegerDigits[x, 2, n], # == 0 &] ; Table[{i, IntegerDigits[i, 2, n], LeadingZeros[i, n], If[i == 0, n, n - Floor[Log2[i] + 1]]}, {i, 0, 2^n - 1}] // Grid
– Syed
Apr 6, 2022 at 15:01
• @Syed I did not get. Can you reproduce my histogram with your code? Apr 6, 2022 at 15:04
• No, I am suggesting that leading zeros can be found without counting.
– Syed
Apr 6, 2022 at 15:07
• There are two things here. First, the error that you're seeing is not because of any performance problem with your LeadingZeros function. It's due to trying to create an enormous list with Tuples[Range[0, 255], 4]. Second, as Syed pointed out, you don't need to construct the digit sequence and then count the leading zeros (that you had to create with padding). So your implementation does seem likely to be inefficient compared to just directly computing what you're after like Syed demonstrated. Apr 6, 2022 at 15:10
• lz[x_, n_] := If[x == 0, n, n - Floor[Log2[x] + 1]] and Histogram[ lz[#, 8] & /@ (Min @@@ Tuples[Range[0, 255], 2]), Automatic, "Probability"] gives the histogram in the OP.
– Syed
Apr 6, 2022 at 15:12

Don't use brute force, instead compute probabilities for each amount of leading zero bits in OrderDistribution for the smallest entry of k DiscreteUniformDistributions:

With[{k = 2},
Table[
Probability[2^(7 - n + 1) > a >= Floor[2^(7 - n)],
Distributed[a,
OrderDistribution[{DiscreteUniformDistribution[{0, 255}], k}, 1]]]
// Labeled[#, n] &,
{n, 0, 8}]] // BarChart


This also works for larger k such as 4:

You can also derive a symbolic form of the probability:

Probability[
2^(7 - n + 1) > a >= Floor[2^(7 - n)],
Distributed[a,
OrderDistribution[{DiscreteUniformDistribution[{0, 255}], k}, 1]]] //
FullSimplify[#,
Element[n, Integers] && Element[k, Integers] && 0 <= n <= 8 && k >= 1] &

(* -Piecewise[{{1 - (1 - Floor[2^(7 - n)]/256)^k, 1 <= Floor[2^(7 - n)]}}, 0] +
Piecewise[{{1, 2^n <= 1}, {1 - (1 - 2^(-n))^k, Inequality[1, LessEqual, 2^(8 - n), Less, 256]}}, 0] *)


EDIT:

You can also use Histogram instead of BarChart by converting probabilities into WeightedData:

With[{k = 2},
Table[
{n,
Probability[2^(7 - n + 1) > a >= Floor[2^(7 - n)],
Distributed[a,
OrderDistribution[{DiscreteUniformDistribution[{0, 255}], k}, 1]]]},
{n, 0, 8}]] // Histogram[WeightedData @@ Transpose@#, {1}, "Probability"] &


• Nice, I had not hope it can be done analytically. Amazing! Apr 7, 2022 at 8:17