A382961 A sequence constructed by greedily sampling the logarithmic distribution for parameter value 1/2 so as to minimize discrepancy.

1, 1, 2, 1, 1, 3, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 4, 1, 1, 2, 1, 1, 1, 3, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1, 5, 1, 1, 2, 1, 1, 1, 2, 1, 1, 3, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 1, 3, 1, 2, 1, 1, 1, 1, 2, 1, 1, 4, 1, 1, 2, 1, 1, 1, 3, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1, 3, 1, 1, 2, 1, 1, 1, 6, 1, 1, 2, 1, 1, 1, 2, 1, 1, 1, 3, 1, 2, 1, 1, 1, 4, 1, 1, 2, 1, 1, 1, 2

Offset: 1

Author

Jwalin Bhatt, Apr 10 2025

Keywords

• nonn
• changed

Comments

The geometric mean approaches A381898 = exp(-PolyLog'(1,1/2)/log(2)) in the limit.

The logarithmic distribution PDF is p(i) = 1/(log(2)*(2^i)*i).

Examples

			Let p(k) denote the probability of k and c(k) denote the number of occurrences of k among the first n-1 terms; then the expected number of occurrences of k among n random terms is given by n*p(k).
We subtract the actual occurrences c(k) from the expected occurrences and pick the one with the highest value.
| n | n*p(1) - c(1) | n*p(2) - c(2) | n*p(3) - c(3) | choice |
|---|---------------|---------------|---------------|--------|
| 1 |     0.721     |       -       |       -       |   1    |
| 2 |     0.442     |     0.360     |       -       |   1    |
| 3 |     0.164     |     0.541     |       -       |   2    |
| 4 |     0.885     |    -0.278     |     0.240     |   1    |
| 5 |     0.606     |    -0.098     |     0.300     |   1    |
| 6 |     0.328     |     0.082     |     0.360     |   3    |
		

Links

• Jwalin Bhatt, Table of n, a(n) for n = 1..10000
• Wikipedia, Logarithmic distribution

Crossrefs

Cf. A381617, A381898, A381900, A383238.

Programs

Mathematica

probCountDiff[j_, k_, count_] := k/(Log[2]*(2^j)*j) - Lookup[count, j, 0]
samplePDF[n_] := Module[{coeffs, unreachedVal, counts, k, probCountDiffs, mostProbable},
  coeffs = ConstantArray[0, n]; unreachedVal = 1; counts = <||>;
  Do[probCountDiffs = Table[probCountDiff[i, k, counts], {i, 1, unreachedVal}];
    mostProbable = First@FirstPosition[probCountDiffs, Max[probCountDiffs]];
    If[mostProbable == unreachedVal, unreachedVal++]; coeffs[[k]] = mostProbable;
    counts[mostProbable] = Lookup[counts, mostProbable, 0] + 1; , {k, 1, n}]; coeffs]
A382961 = samplePDF[120]