|
%I #11 Mar 23 2017 21:19:21
%S 1,4,2,9,6,3,16,12,8,5,26,21,15,10,7,39,33,25,18,14,11,56,49,38,28,24,
%T 20,13,78,69,55,42,36,32,22,17,106,94,77,60,52,48,34,27,19,141,125,
%U 105,84,74,68,50,40,30,23,184,164,140,115,100,93,70,57,45,35,29,236,212,183
%N Dispersion of the composite numbers.
%C Column 1 consists of 1 and the primes. As a sequence, this is a permutation of the positive integers. As an array, its fractal sequence is A022446 and its transposition sequence is A114578.
%C The dispersion of the primes is given at A114537.
%D Clark Kimberling, Fractal sequences and interspersions, Ars Combinatoria 45 (1997) 157-168.
%H Ivan Neretin, <a href="/A114577/b114577.txt">Table of n, a(n) for n = 1..4950</a>
%H Clark Kimberling, <a href="http://faculty.evansville.edu/ck6/integer/intersp.html">Interspersions and Dispersions</a>.
%H Clark Kimberling, <a href="http://dx.doi.org/10.1090/S0002-9939-1993-1111434-0">Interspersions and dispersions</a>, Proceedings of the American Mathematical Society, 117 (1993) 313-321.
%e Northwest corner:
%e 1 4 9 16 26 39 56 78
%e 2 6 12 21 33 49 69 94
%e 3 8 15 25 38 55 77 105
%e 5 10 18 28 42 60 84 115
%e 7 14 24 36 52 74 100 133
%e 11 20 32 48 68 93 124 162
%t (* Program computes dispersion array T of increasing sequence s[n] and the fractal sequence f of T; here, T = dispersion of the composite numbers, A114577 *)
%t r = 40; r1 = 10;(* r = # rows of T, r1 = # rows to show*);
%t c = 40; c1 = 12;(* c = # cols of T, c1 = # cols to show*);
%t comp = Select[Range[2, 100000], ! PrimeQ[#] &];
%t s[n_] := s[n] = comp[[n]]; mex[list_] := NestWhile[#1 + 1 &, 1, Union[list][[#1]] <= #1 &, 1, Length[Union[list]]]; rows = {NestList[s, 1, c]}; Do[rows = Append[rows, NestList[s, mex[Flatten[rows]], r]], {r}]; t[i_, j_] := rows[[i, j]];
%t TableForm[Table[t[i, j], {i, 1, r1}, {j, 1, c1}]] (* A114577 array *)
%t u = Flatten[Table[t[k, n - k + 1], {n, 1, c1}, {k, 1, n}]] (* A114577 sequence *)
%t row[i_] := row[i] = Table[t[i, j], {j, 1, c}];
%t f[n_] := Select[Range[r], MemberQ[row[#], n] &]
%t v = Flatten[Table[f[n], {n, 1, 100}]] (* A022446, fractal sequence *)
%t (* - _Clark Kimberling_, Oct 09 2014 *)
%Y Cf. A022446, A114537, A114578.
%K nonn,tabl
%O 1,2
%A _Clark Kimberling_, Dec 09 2005
|
