Finding the asymptotic rate of growth of a table of values

Question

Suppose we define entropy[k] where:

Clear["*Global`*"]
F[r_] := F[r] = 
  DeleteDuplicates[Flatten[Table[Range[0, t]/t, {t, 1, r}]]]
S1[k_] := 
 S1[k] = Sort[Select[F[k], Boole[IntegerQ[Denominator[#]/2]] == 1 &]]
S2[k_] := 
 S2[k] = Sort[Select[F[k], Boole[IntegerQ[Denominator[#]/2]] == 0 &]]
P1[k_] := P1[k] = Join[Differences[S1[k]], Differences[S2[k]]]
U1[k_] := U1[k] = P1[k]/Total[P1[k]]
entropy[k_] := entropy[k] = N[Total[-U1[k] Log[2, U1[k]]]]

Question: How do we determine the rate of growth of T=Table[{k,entropy[k]},{k,1,Infinity}] using mathematica?

Attempt:

We can't actually take infinite values from T, but we could replace Infinity with a large integer.

If we define

T=Join[Table[{k, entropy[k]}, {k, 3, 30}], Table[{10 k, entropy[10 k]}, {k, 3, 10}]]

We could visualize the points using ListPlot

It seems the following function should fit:

nlm1 = NonlinearModelFit[
  T, {a + b Log2[x], {a, b}, x]

We end up with:

nlm1=2.72984 Log[E,x]-1.49864

However, when we add additional points to T

 T=Join[Table[{k, entropy[k]}, {k, 3, 30}], Table[{10 k, entropy[10 k]}, {k, 3, 10}],
       Table[{100 k, entropy[100 k]}, {k, 1, 10}]]

We end up with:

nlm1=2.79671 Log[E,x]-1.6831

My guess is we can bound T with the function $\require{enclose}\enclose{horizontalstrike}{3\ln(x)-2}$; however, I could only go up to {3000,entropy[3000]} and need more accurate bounds.

Edit: I need approximation by asymptotic expansion, not an upper bound?

Is there an asymptotic expansion we can use?

Answer 1

Conclusion

An approximation that appears to either approach constant or at least sub-logarithmic error for sufficiently large $k$ is:

$$ \begin{align} \mathrm{entropy}(n) & \approx -f(k) \log _2\left(\frac{f(k)}{2}\right) \sum _i^{\frac{k}{2}} \phi (2 i-1) + C\\ \mathrm{with}\\\\ f(k) & = \frac{\pi ^2 k}{2(k-3) (k-1)^2} \\ C & \approx \log _2\left(\frac{\pi }{6}\right) \end{align} $$ Where $\phi(i)$ is Euler's totient function. The value of $C$ is just an observational guess, I really wouldn't put a lot of confidence in its exact value.

This arises from finding the average values of the Differences of S1 and S2 as a function of k, and observing that Length@F[k] == 1 + Sum[EulerPhi[i], {i, k}]

---

We can also use the asymptotic growth of $\sum_i^k \phi(i)$ to further simplify: $$ \begin{align} \sum_i^{k/2} \phi(i) & \approx 3 \frac{k^2}{4\pi^2} - 1\\ \frac{\sum _i^{\frac{k}{2}} \phi (2 i-1)}{\sum _i^{\frac{k}{2}} \phi (i)} & \approx \frac{8}{3} \\ \sum _i^{\frac{k}{2}} \phi (2 i-1) & \approx \frac{2 k^2}{\pi ^2}-\frac{8}{3} \end{align} $$ to get a simpler approximation:

$$ \mathrm{entropy}(k) \approx -\left(\frac{2 k^2}{\pi ^2}-\frac{8}{3}\right) f(k) \log _2\left(\frac{f(k)}{2}\right)+C $$

---

And using $f \approx \frac{\pi ^2}{2 k^2}$ (See @Arbuja 's comment below):

$$ \mathrm{entropy}(k) \approx \left(-1 + \frac{4 \pi ^2}{3 k^2}\right) \log _2\left(\frac{\pi ^2}{4 k^2}\right) + C $$

Which can be further simplified to see the asymptotic limit:

$$ \begin{align} \mathrm{entropy}(k) &\approx \left(-1 + \frac{4 \pi ^2}{3 k^2}\right) \log _2\left(\frac{\pi ^2}{4 k^2}\right) + C \\\\ \mathrm{entropy}(k) &\approx \left(\frac{4 \pi ^2}{3 k^2}-1\right) \log _2\left(\left(\frac{\pi }{2 k}\right)^2\right) +C\\\\ \mathrm{entropy}(k) &\approx 2 \left(\frac{4 \pi ^2}{3 k^2}-1\right) \left(-\log _2(k)-1+\log _2(\pi )\right)+C \\\\ \mathrm{entropy}(k) &\approx 2 \log _2(k) + \frac{8 \pi ^2}{3 k^2} \left(-\log _2(k)-1+\log _2(\pi )\right) + C+2-2 \log _2(\pi )\\\\ \mathrm{entropy}(k) &\approx 2 \log _2(k) + K \\\\ K &= C+2-2 \log _2(\pi ) = 1 - \log_2(3\pi) \end{align} $$

---

Here we see the comparison plot of the approximation and the true entropy (and using @azerbajdzan 's newentropy for faster comparison with $RecursionLimit = 5000:

f[k_] := (k \[Pi]^2)/(2 (k - 3) (k - 1)^2)
entropyApprox[
  k_] := -f[k] (Log[2, f[k]/2]) Sum[EulerPhi[2 i - 1], {i, k/2}] + 
  Log2[Pi/6]
entropyVeryApprox[
   k_] := -f[k] (Log[2, f[k]/2]) (-(8/3) + (2 k^2)/\[Pi]^2) + 
   Log2[Pi/6];

testValuesK = Join[Range[2000], Range[3000, 5000, 500]];

plot = DiscretePlot[{newentropy[k], entropyApprox[k]}, {k, 
   testValuesK}, Frame -> True, FrameLabel -> {"k", "entropy(k)"}, 
  LabelStyle -> Directive[Bold, Medium], Filling -> None, 
  Joined -> True, PlotLegends -> {"entropy(k)", "entropyApprox(k)"}]

And we see the error is either approaching 0, or is growing extremely slowly (note the $k$ step size is changed from 1 to 500 past $k = 2000$, due to how long newentropy takes to calculate for large k) :

errsAtK = ({#, newentropy[#] - entropyApprox[#]}) & /@ testValuesK;
ListLinePlot[errsAtK, PlotRange -> All, Frame -> True, 
 FrameLabel -> {"k", "error"}, LabelStyle -> Directive[Bold, Medium]]

Zooming in on the error just for $k ≥ 1000$, we see the error appears to be settling around 0 (notice it goes up and then back down towards the end):

So although $C$ might not be exactly correct, the error does appear to be staying somewhat constant and not growing.

Also note the approximation using the limit of the sum of $\phi(i)$ tends towards the other approximation:

DiscretePlot[{entropyApprox[k] - entropyVeryApprox[k]}, {k, 5000}]

---

Walkthrough

Note: all Analysis is for even $k ≥ 4$, this made things easier. This is fine since if you zoom out enough on entropy[k] it appears smooth.

Means of the differences of S1[k],S2[k]

Notice that the minimum value of Differences@S2[k] is

$$ \frac{1}{4 \left(\frac{k}{2}-1\right)^2-1} $$

min[k_] := 1/(4*(k/2 - 1)^2 - 1)
And @@ Table[Min@Differences@Sort@S2[k] == min[k], {k, 4, 100, 2}]
(*True*)

Next notice that the mean of the differences of S2[k] divided by min[k] approaches a constant, and it appears to be exactly $\frac{\pi^2}{2}$:

Table[Mean@Differences@Sort@S2[2^k]/(min[2^k]*Pi^2/2), {k, 2, 12}] // 
 N

(*{0.202642, 0.545576, 0.806434, 0.855284, 0.943945, 0.966921,
0.988094, 0.990977, 0.996279, 0.997858, 0.999265}*)

So the mean of the differences of S2[k] for large k is

$$ \frac{\pi^2}{2} * \frac{1}{4 \left(\frac{k}{2}-1\right)^2-1} $$

Also observe that for large $k$, the mean of $S1[k]$ is twice the mean of $S2[k]$:

Table[Mean@Differences@Sort@S1[2^k]/
  Mean@Differences@Sort@S2[2^k], {k, 2, 12}] // N

(*{0.75, 1.21875, 1.42917, 1.81534, 1.84152, 1.9333, 1.95468, 1.98692,
1.99061, 1.99604, 1.99716}*)

So the mean of the differences of S1[k] for large k is

$$ \frac{\pi^2}{4 \left(\frac{k}{2}-1\right)^2-1} $$

min[k_] := 1/(4*(k/2 - 1)^2 - 1)
meanDiffS1[k_] := Pi^2 * min[k]
meanDiffS2[k_] := meanDiffS1[k]/2

Lengths of S1[k], S2[k]

It can be shown that the length of S1[k] is

$$ \mathrm{length ~of~ S1[k]} = \sum _i^{\frac{k}{2}} \phi (2 i) $$

While the length of S2[k] is the same sum but over the odds plus 1: $$ \mathrm{length ~of~ S2[k]} = 1 + \sum _i^{\frac{k}{2}} \phi (2 i -1) $$

Table[Length@S1[k] - Sum[EulerPhi[2 i], {i, k/2}], {k, 4, 100, 
   2}] // DeleteDuplicates
(*{0}*)

Table[Length@S2[k] - (1 + Sum[EulerPhi[2 i - 1], {i, k/2}]), {k, 4, 
  100, 2}]
(*{0}*)

And the Differences of S1 and S2 will just have this length minus 1:

lenDiffS1[k_] := Sum[EulerPhi[2 i], {i, k/2}] - 1
lenDiffS2[k_] := Sum[EulerPhi[2 i - 1], {i, k/2}]

Total of P1[k]

Now observe the Total of Diffferences@S1[k] is:

$$ \frac{k-2}{k} $$

totS1[k_] := (k - 2)/k
Table[Total@Differences@S1[k] - totS1[k], {k, 4, 100, 
   2}] // DeleteDuplicates
(*{0}*)

While the total of S2[k] is always 1:

Table[Total@Differences@S2[k] - 1, {k, 4, 100, 2}] // DeleteDuplicates
(*{0}*)

meaning that the total of P1[k] is $ 1 + \frac{k-2}{k}$

totS1[k_] := (k - 2)/k
totP[k_] := 1 + totS1[k]
Table[Total@P1[k] - totP[k], {k, 4, 100, 2}] // DeleteDuplicates
(*{0}*)

Adding together entropy contributions of S1[k] and S2[k]

Since we know the mean of the differences of S1 and S2 and their respective lengths, and the total of P1, we can calculate mean contributions (very roughly, I would much prefer to find the mean of each elements entropy -U1[k]*Log2[U1[k] but I couldn't find a regular behavior to this) of S1 and S2 to the entropy:

contribS1[k_] := 
 lenDiffS1[k]*(-(meanDiffS1[k]/totP[k])*Log2[meanDiffS1[k]/totP[k]])

contribS2[k_] := 
 lenDiffS2[k]*(-(meanDiffS2[k]/totP[k])*Log2[meanDiffS2[k]/totP[k]])

totEntropy[k_] := contribS2[k] + contribS2[k]

And simplifying:

Simplify[totEntropy1[k], k \[Element] PositiveIntegers]

(*-1/2*(k*Pi^2*Log[(k*Pi^2)/(4*(-3 + k)*(-1 + k)^2)]*Sum[EulerPhi[-1 + 2*i], {i, k/2}])/((-3 + k)*(-1 + k)^2*Log[2])*)

gives us:

$$ \mathrm{entropy}(k) \approx -\frac{\pi ^2 k \log \left(\frac{\pi ^2 k}{4 (k-3) (k-1)^2}\right) \sum _i^{\frac{k}{2}} \phi (2 i-1)}{2 (k-3) (k-1)^2 \log (2)} $$

Which appears to be off by a constant value that might be around $\log_2{\frac{\pi}{6}}$, although this is really just a guess

Ways to Improve

Describing the Distribution of $S_i[k]$

Note that using the means of the differences of S1 and S2 is kind of a sin, because in the end it gets transformed by -U1[k] *Log2[U1[k]. The distributions of S1[k] and S2[k] are also not tightly distributed about the mean:

frameLabels = {"\!\(\*FractionBox[\(differences\), \(mean\)]\)", 
   "prob."};
s1Hist = 
 Histogram[Differences@S1[2^12]/meanDiffS1[2^12], "FreedmanDiaconis", 
  "Probability", Frame -> True, FrameLabel -> frameLabels, 
  LabelStyle -> Directive[Bold, Medium]]
s2Hist = 
 Histogram[Differences@S2[2^12]/meanDiffS2[2^12], "FreedmanDiaconis", 
  "Probability", Frame -> True, FrameLabel -> frameLabels, 
  LabelStyle -> Directive[Bold, Medium]]

The shape of the distributions of S1 and S2 appear identical, and for sufficiently large k the shape appears to approach whatever this distribution is. If someone can describe this distribution better than just using the mean, this could improve estimates on entropy[k]

Describing the mean of e[k] := -U1[k]* Log2[U1[k]]

An even better improvement would be for describing the mean of each individual entropy in the list -U1[k] * Log2[U1[k]]. This would exactly describe entropy[k] since it's just the sum of the individual entropies.

I originally hoped to do this, but I could find no regular pattern in how the mean of -U1[k] * Log[k] behaves:

e[k_] := e[k] = -U1[k]*Log2[U1[k]]

Table[Mean[e[2^k]]/(-min[2^k]*Log2[min[2^k]]), {k, 2, 13}] // N

(*{0.873814, 1.37538, 1.95718, 2.26098, 2.5353, 2.6853, 2.79824, \
2.8629, 2.91559, 2.9536, 2.98467, 3.00889}*)

I could guess that Mean[e[k] looks something like -x * min[k]*Log2[x*min[k]] or -x * min[k]*Log2[min[k]] but the ratio isn't really slowing down enough for me to confidently say that Mean[e[k] is related to the entropy of min[k] like this.

If someone can find an approximate relationship for the mean of the entropy: $$ \mathrm{Mean(e(k))} \approx g(k) $$

Then we can probably get a much better approximation since we know the length of e[k] to be

$$ \mathrm{Length~of~e(k)} = \sum _i^{k} \phi (i)-1 $$ so $$ \mathrm{entropy}(k) \approx g(k) \sum _i^{k} \phi (i)-1 $$

And using the asymptotic limit of $\sum _i^{k} \phi (i)$:

$$ \mathrm{entropy}(k) \approx g(k) (3 \frac{k^2}{\pi^2} - 2) $$

It may be helpful to note that e[k] also has a distribution which has a constant shape for large k, but I don't know how to describe this distribution either:

eHist = Histogram[e[2^12], "FreedmanDiaconis", "Probability", 
  Frame -> True, FrameLabel -> {"individual entropy values", "prob."},
   LabelStyle -> Directive[Bold, Medium]]

Additional comment for further exploration

Notice that S1 and S2 can be defined recursively by finding the coprimes of k in Range[k]:

coprimes[k_] := Select[Range@k,  CoprimeQ[#, k] &]
newS1Elems[k_] := newS1Elems[k] = If[EvenQ[k], coprimes[k]/k, {}]
newS2Elems[k_] := newS2Elems[k] = If[OddQ[k], coprimes[k]/k, {}]

And then initialize and S1 and S2 and Join the new elements:

S1New[1] = {};
S1New[k_] := S1New[k] = Join[S1New[k - 1], newS1Elems[k]] // Sort

S2New[1] = {0, 1};
S2New[k_] := S2New[k] = Join[S2New[k - 1], newS2Elems[k]] // Sort

I don't think this will speed up calculating entropy, but I'm wondering if thinking about it this way will bring any new insights.

Answer 2

This is just an extended comment.

It might be that the rate of growth for large values of $k$ is not linear in the log of $k$.

First, generate some entropy values a bit more uniform in the range from 3 to 3,0000, fit the log/linear function, and plot the results with a log/linear plot:

T = Join[Table[{k, entropy[k]}, {k, Join[Range[3, 10], Range[20, 100, 10],
  Range[200, 1000, 100], Range[2000, 4000, 1000]]}]];
nlm = NonlinearModelFit[T, a + b  Log[k], {a, b}, k];
Show[ListLogLinearPlot[T, Frame -> True, FrameLabel -> {"k", "Entropy"}],
 LogLinearPlot[nlm[k], {k, 3, 4000}]]

But looking at the residuals vs k suggests that a linear-in-the-logs function does not fit the complete range of values of $k$:

ListLogLinearPlot[Transpose[{T[[All, 1]], nlm["FitResiduals"]}],
 Frame -> True, FrameLabel -> {"k", "Residual"}]

We see that the fit for large values of $k$ (the values the OP states are more important), the fit is not good. Suppose we now just look at values of $k \geq 500$:

T2 = Select[T, #[[1]] >= 500 &];
nlm2 = NonlinearModelFit[T2, a + b  Log[k], {a, b}, k];
ListLogLinearPlot[Transpose[{T2[[All, 1]], nlm2["FitResiduals"]}]]

We see a similar pattern of residuals which suggests (to me) that either a linear rate of change of entropy in the log of $k$ is inadequate or that such a summary of the rate of change does not occur until the value of $k$ is larger than $k=3,000$.

Answer 3

I defined OP's entropy a bit differently as newentropy. It is a bit faster on my PC.

Precomputing fraction lists up to m=300 (it took 0.7 seconds):

$RecursionLimit = 2000;
Clear[fr]
m = 300;

fr[1] = {1/2};
fr[x_] := fr[x] = Union[fr[x - 1], Range[(x - 1)/2]/x]
fr[m]; // AbsoluteTiming

---

{0.727258, Null}

Definition of newentropy:

Clear[newentropy]
newentropy[1] = 0;
newentropy[n_] := 
 newentropy[n] = 
  N[Total[-2 # Log[
         2, #] & /@ ((Flatten@(Differences /@ 
            GatherBy[fr[n], EvenQ@*Denominator]))/((
         2 (n - 1)^2 - 1 + (-1)^n)/((n - 1) n)))] - (3 # Log[
         2, #] &@(((2 n - 1 + (-1)^n)/(
        2 (n - 1) n))/((2 (n - 1)^2 - 1 + (-1)^n)/((n - 1) n))))]

Verifying that my newentropy is identical to OP's entropy:

Table[newentropy[n] == entropy[n], {n, 1, 300}] // Union

---

{True}

Finding the fit in three parameters {a, b, c} (while OP used only two) and plotting fit with entropy in the same plot. The next plot is difference between the two.

Computing table tEntropy took 20.8 seconds.

tEntropy = Table[newentropy[n], {n, m}];
fit = Normal@
  NonlinearModelFit[tEntropy, {a + b Log[x + c]}, {a, b, c}, x]
tFit = Table[fit, {x, m}];
ListLinePlot[{tEntropy, tFit}, 
 PlotStyle -> {Directive[Thick, ColorData[97, 3]], 
   Directive[Thick, Dashing[Large], ColorData[97, 4]]}]
ListPlot[tEntropy - tFit]

---

-2.02903 + 2.85731 Log[0.699937 + x]

With m = 1000; computing fr[m] took 29.9 seconds and computing tEntropy took 16.4 minutes.

This is the result with m = 1000;:

-2.07043 + 2.86581 Log[0.738438 + x]

---

Answer 4

I use a variant of the definitions which is slightly faster I think.

ff2[n_] := 
 ff2[n] = Flatten[Join[{0, 1}, Table[Range[1, j - 1]/j, {j, n}]]]
ss1[k_] := 
 ss1[k] = Sort[N@Select[ff2[k], IntegerQ[Denominator[#]/2] &]]
ss2[k_] := 
 ss2[k] = Sort[N@Select[ff2[k], ! IntegerQ[Denominator[#]/2] &]]
pp1[k_] := pp1[k] = Join[Differences[ss1[k]], Differences[ss2[k]]]
uu1[k_] := uu1[k] = pp1[k]/Total[pp1[k]] /. 0. -> Nothing
entropy2[k_] := entropy2[k] = N[Total[-uu1[k]  Log[2, uu1[k]]]]

Here are a couple of runs using fairly large inputs.

Timing[entropytable = 
  Table[PrintTemporary[n]; entropy2[n], {n, 200, 5000, 200}]]

(* Out[23]= {179.603, {13.1198, 15.1009, 16.2643, 17.0921, 17.7338, 
  18.2577, 18.702, 19.0862, 19.4254, 19.7295, 20.0035, 20.2543, 
  20.4851, 20.6985, 20.8974, 21.0834, 21.2582, 21.4229, 21.5789, 
  21.7267, 21.8672, 22.0015, 22.1295, 22.2523, 22.37}} *)

Timing[entropytablebig = 
  Table[PrintTemporary[n]; entropy2[n], {n, 6000, 10000, 2000}]]

(* Out[24]= {162.95, {22.8956, 23.7254, 24.3689}} *)

So how to assess asymptotics?

First thing, noted by @ydd, is that we want to know how many values we're using for a given input n. This is estimated to first approximation as 3/Pi^2*n^2. Computations below show this to be a sound estimate.

It is straightforward to then find the average value of the differences. What we want is actually an average of differences times log of differences. I do not know how to find that. First leap of faith: I instead use average of differences times average of logs. I do not know how to bound the error of discrepancy, but I'm fairly certain it is small. So this step is a leap of faith.

Next is to realize we do not know the average of the logs of differences. We of course know the log of the average diff (since we know the af=verage diff). A bit of thought shows that these differ by the log of (ratio of the geometric to arithmetic mean of the diffs). Computations below indicate that this seems stable.

top = 3000;
fracs = Select[pp1[top], # > 10^(-14) &] // Sort;
{Length[fracs], With[{m = top}, Round[3./Pi^2*m^2]]}
mn = Mean[fracs];
gmn = GeometricMean[fracs];
agquot = mn/gmn

(* Out[89]= {2736187, 2735672}

Out[92]= 1.32189 *)

top = 5000;
fracs = Select[pp1[top], # > 10^(-14) &] // Sort;
{Length[fracs], With[{m = top}, Round[3./Pi^2*m^2]]}
mn = Mean[fracs];
gmn = GeometricMean[fracs];
agquot = mn/gmn

(* Out[95]= {7600457, 7599089}

Out[98]= 1.32211 *)

I also show this for odd values, to indicate that it does not change between evens and odds.

top = 4001;
fracs = Select[pp1[top], # > 10^(-14) &] // Sort;
{Length[fracs], With[{m = top}, Round[3./Pi^2*m^2]]}
mn = Mean[fracs];
gmn = GeometricMean[fracs];
agquot = mn/gmn

(* Out[101]= {4867601, 4865849}

Out[104]= 1.32211 *)

top = 6001;
fracs = Select[pp1[top], # > 10^(-14) &] // Sort;
{Length[fracs], With[{m = top}, Round[3./Pi^2*m^2]]}
mn = Mean[fracs];
gmn = GeometricMean[fracs];
agquot = mn/gmn

(* Out[107]= {10948795, 10946336}

Out[110]= 1.32228 *)

Now a higher value, to show it seems not to grow.

top = 10000;
fracs = Select[pp1[top], # > 10^(-13) &] // Sort;
{Length[fracs], With[{m = top}, Round[3./Pi^2*m^2]]}
mn = Mean[fracs];
gmn = GeometricMean[fracs];
agquot = mn/gmn

(* Out[113]= {30397485, 30396355}

Out[116]= 1.32222 *)

What this indicates is, subject to the leap of faith noted above, our entropy estimate is like so:

estimated[n_] := (2*Log[2, N@n] + 1 - Log[2, 2/3.*Pi^2]) - Log[2, 1.3222]

Here I have used some facts already noted by others, that the sum of the diffs asymptotically approaches 2 (it is 2-2/n, to be specific), so the log average has a denominator of 2, hence a term -Log[1/2] or +1. The rest comes from Log[2, 2/3.*Pi^2*1/n^2] for the log of the average, and the adjustment factor, that becomes a summand on taking logs, accounting for the ratio of the means as indicated earlier.

How well does this track?

(* estimatedtablebig = Table[estimated[n], {n, 6000, 10000, 2000}];

Transpose[{entropytablebig, estimatedtablebig, 
  entropytablebig/estimatedtablebig}]

(* Out[117]= {{22.8956, 22.9805, 0.996306}, {23.7254, 23.8106, 
  0.99642}, {24.3689, 24.4545, 0.996501}} *) *)

So we have discrepancies around .35 percent.

I will note that the estimated by @azerbajdzan has errors only around half that. But they seem to be rising in the range where mine are falling.

A weak spot in this analysis has to do with the clustering shown in the response by @ydd. I do not have any good estimate there. I can get a small and asymptotically meaningless refinement of my estimate above, by accounting for the two terms of size 1/n (or 1/(n-1) if n is even). But this gives an adjustment of -log2(n)/n which, for n=10000, is -.00133. Are there "many" terms that are in some sense much larger that O(1/n^2)? It is not difficult to show that the total count of these must be o(n^2). But I still have no handle on how, or to what extent, they might change the constant part of the estimate. I do not have a proof that the log part is correct, although the heuristic arguments presented here and by @ydd indicate the plausibility.