# Quickly compute inverse summation

I'd like to look at behavior of $$f(n)$$ for the following $$f$$

$$\begin{array}{lll} g(s,n)&=&\frac{1}{n}\sum_i^n \left(1-\frac{1}{i}\right)^s\\ f(n)&=&\text{smallest } s \text{ such that } g(s,n)<10^{-6} \end{array}$$

My naive implementation is below, but it's too slow to make a good plot in reasonable time. Any tips how to speed this up?

g[s_, n_] := Total@Table[(1. - 1/i)^s, {i, 1, n}]/n;
f[n_] := (For[i = 1, i < 20 n, i++,
If[g[i, n] < 10^(-6), Break[]]]; i)
f // Timing (* {1.74248, 11243} *)

• the hypothesis is that $f(n)$ is linear in $n$ Jun 17 at 19:41
• Maybe something along the lines of FindRoot[g[s, 1000] == 10^-6, {s, 100}]? Jun 17 at 19:45
• Was just in the process of trying Carl Woll's suggestion: Jun 17 at 19:56
• zero[n_, s_] := n 10^(-6) - NSum[(1 - 1/i)^s, {i, 1, n}] Jun 17 at 19:56
• lastSolution = s /. FindRoot[zero[10, s], {s, 2}];Table[{2^n, lastSolution = s /. FindRoot[zero[2^n, s], {s, lastSolution}]}, {n, 1, 12}];ListPlot[%] but slows down for larger n... Jun 17 at 19:57

Could do it recursively, using FindRoot with starting point determined by previous value (per comment by @CraigCarter).

ff = 1;
ff[n_Integer] :=
ff[n] = Floor[
s /. FindRoot[
Sum[((i - 1)/i)^s, {i, 2, n}] == n*10^(-6), {s, ff[n - 1]},
WorkingPrecision -> Log[2, n] + \$MachinePrecision]]


Check result:

ListPlot[Table[ff[n], {n, 3, 100}]] • thanks! Fixed a typo, now the result seems perfectly linear. There's probably an analytic way to derive this Jun 22 at 0:35
• Thanks @YaroslavBulatov. Does look like it is approximately linear. Jun 22 at 13:39