login
Least k such that 1 + 1/2 + ... + 1/k < 1/(k+1) + ... + 1/n.
1

%I #20 Apr 10 2021 22:43:08

%S 1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,

%T 4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,

%U 5,5,5,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6

%N Least k such that 1 + 1/2 + ... + 1/k < 1/(k+1) + ... + 1/n.

%C For k = 1..20, the runlength of k's is given by 7, 11, 14, 18, 21, 25, 29, 32, 36, 39, 42, 47, 50, 53, 57, 61, 64, 67, 72, 74.

%H Clark Kimberling, <a href="/A226764/b226764.txt">Table of n, a(n) for n = 4..1000</a>

%F a(n) = Sum_{k>=1} sign(1 - sign(2*H_k - H_n)). - _Mats Granvik_, Apr 06 2021

%e 1/3 + 1/4 + ... + 1/10 < 1 + 1/2 < 1/3 + 1/4 + ... + 1/11, so that a(11) = 2.

%t (* first program *)

%t h[n_] := HarmonicNumber[n]; f[n_, k_] := f[n, k] = If[2 h[k] <= h[n] && 2 h[k + 1] > h[n], 1, 0]; t[n_] := t[n] = Table[f[n, k], {k, 1, n}]; a[n_] := First[Position[t[n], 1]]; u = Flatten[Table[a[n], {n, 4, 500}]]

%t (* second program, with plot *)

%t a[1] = 0; a[n_] := a[n] = NestWhile[# + 1 &, a[n - 1] + 1, Sum[1/k, {k, 1, #}] < Sum[1/k, {k, # + 1, n}] &] - 1; A226764 = Map[a, Range[4, 500]]; ListLogLogPlot[A226764] (* _Peter J. C. Moses_, Jun 20 2013 *)

%Y Cf. A226762.

%K nonn

%O 4,8

%A _Clark Kimberling_, Jun 19 2013