cp's OEIS Frontend

A183110 Period-length of the ultimate periodic behavior of the orbit of a list [1,1,1,...,1] of n 1's under the mapping defined in the comments.

%I A183110 #27 Aug 20 2017 23:18:38
%S A183110 1,2,1,3,3,1,4,4,4,1,5,5,5,5,1,6,6,6,6,6,1,7,7,7,7,7,7,1,8,8,8,8,8,8,
%T A183110 8,1,9,9,9,9,9,9,9,9,1,10,10,10,10,10,10,10,10,10,1,11,11,11,11,11,11,
%U A183110 11,11,11,11,1,12,12,12,12,12,12,12,12,12,12,12,1,13,13
%N A183110 Period-length of the ultimate periodic behavior of the orbit of a list [1,1,1,...,1] of n 1's under the mapping defined in the comments.
%C A183110 We use the list mapping introduced in A092964, whereby one removes the first term of the list, z(1), and adds 1 to each of the next z(1) terms (appending 1's if necessary) to get a new list.
%C A183110 This is also conjectured to be the length of the longest cycle of pebble-moves among the partitions of n (cf. A201144). - _Andrew V. Sutherland_
%H A183110 Alois P. Heinz, <a href="/A183110/b183110.txt">Table of n, a(n) for n = 1..1000</a>
%F A183110 It appears, but has not yet been proved, that a(n)=1 if n=t(k) and a(n)=k if t(k-1) < n < t(k) where t(k) is the k-th triangular number t(k) = k*(k+1)/2.
%e A183110 Under the indicated mapping the list [1,1,1,1,1,1,1] of seven 1's results in the orbit [1,1,1,1,1,1,1], [2,1,1,1,1,1], [2,2,1,1,1], [3,2,1,1], [3,2,2], [3,3,1], [4,2,1], [3,2,1,1], ... which is clearly periodic with period-length 4, so a(7) = 4.
%t A183110 f[p_] := Module[{pp, x, lpp, m, i}, pp = p; x = pp[[1]]; pp = Delete[pp,1]; lpp = Length[pp]; m = Min[x, lpp]; For[i = 1, i ≤ m, i++, pp[[i]]++]; For[i = 1, i ≤ x - lpp, i++, AppendTo[pp, 1]]; pp]; orb[p_] := Module[{s, v}, v = p; s = {v}; While[! MemberQ[s, v = f[v]], AppendTo[s, v]]; s]; attractor[p_] := Module[{orbp, pos, len, per}, orbp = orb[p]; pos = Flatten[Position[orbp, f[orbp[[-1]]]]][[1]] - 1; (*pos = steps to enter period*) len = Length[orbp] - pos; per = Take[orbp, -len]; Sort[per]]; a = {}; For[n = 1, n ≤ 80, n++, {rn = Table[1, {k, 1, n}]; orbn = orb[rn]; lenorb = Length[orbn]; lenattr = Length[attractor[rn]]; AppendTo[a, lenattr]}]; Print[a];
%Y A183110 Cf. A037306, A092964, A178572, A178574.
%K A183110 nonn,easy
%O A183110 1,2
%A A183110 _John W. Layman_, Feb 01 2011