|
%I #19 Apr 15 2020 12:25:31
%S 1,3,6,7,12,12,19,15,21,23,34,25,38,37,39,31,48,41,60,46,60,63,86,50,
%T 71,71,68,71,100,74,105,63,104,89,108,81,118,112,116,90,131,112,155,
%U 119,122,153,200,101,161,132,148,135,188,131,179,137,178,181,240,144,205,192,181,127,206,191,258,170,251,199,270,160,233,218,216
%N The average path sum (floored down) when iterating from n to 1 with nondeterministic map k -> k - k/p, where p is any prime factor of k.
%H Antti Karttunen, <a href="/A333001/b333001.txt">Table of n, a(n) for n = 1..20000</a>
%F a(n) = floor(A333000(n)/A333123(n)) = floor(A333002(n)/A333003(n)).
%e a(12): we have three alternative paths: {12, 8, 4, 2, 1}, {12, 6, 4, 2, 1} or {12, 6, 3, 2, 1}, with path sums 27, 25, 24, whose average is 76/3 = 25.333..., therefore a(12) = 25.
%e For n=15 we have five alternative paths from 15 to 1 (illustrated below) with path sums 37, 40, 42, 40, 39, whose average is 198/5 = 39.6, therefore a(15) = 39.
%e 15
%e / \
%e / \
%e 10 12
%e / \ / \
%e / \ / \
%e 5 8 6
%e \_ | __/|
%e \__|_/ |
%e 4 3
%e \ /
%e \ /
%e 2
%e |
%e 1.
%t Map[Floor@ Mean[Total /@ #] &, #] &@ Nest[Function[{a, n}, Append[a, Join @@ Table[Flatten@ Prepend[#, n] & /@ a[[n - n/p]], {p, FactorInteger[n][[All, 1]]}]]] @@ {#, Length@ # + 1} &, {{{1}}}, 74] (* _Michael De Vlieger_, Apr 15 2020 *)
%o (PARI)
%o up_to = 20000;
%o A333001list(up_to) = { my(u=vector(up_to), v=vector(up_to)); u[1] = v[1] = 1; for(n=2,up_to, my(ps=factor(n)[, 1]~); u[n] = vecsum(apply(p -> u[n-n/p], ps)); v[n] = (u[n]*n)+vecsum(apply(p -> v[n-n/p], ps))); vector(up_to, n, floor(v[n]/u[n])); };
%o v333001 = A333001list(up_to);
%o A333001(n) = v333001[n];
%Y Cf. A333000, A333123.
%Y Cf. A333002/A333003 (average as exact rational, numerator/denominator in lowest terms), A333785 (where the average is integer).
%Y Cf. A333790 (smallest path sum), A333794 (conjectured largest path sum).
%K nonn
%O 1,2
%A _Antti Karttunen_, Apr 06 2020
|
