A114577 Dispersion of the composite numbers.
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, 20, 13, 78, 69, 55, 42, 36, 32, 22, 17, 106, 94, 77, 60, 52, 48, 34, 27, 19, 141, 125, 105, 84, 74, 68, 50, 40, 30, 23, 184, 164, 140, 115, 100, 93, 70, 57, 45, 35, 29, 236, 212, 183
Offset: 1
Examples
Northwest corner: 1 4 9 16 26 39 56 78 2 6 12 21 33 49 69 94 3 8 15 25 38 55 77 105 5 10 18 28 42 60 84 115 7 14 24 36 52 74 100 133 11 20 32 48 68 93 124 162
References
- Clark Kimberling, Fractal sequences and interspersions, Ars Combinatoria 45 (1997) 157-168.
Links
- Ivan Neretin, Table of n, a(n) for n = 1..4950
- Clark Kimberling, Interspersions and Dispersions.
- Clark Kimberling, Interspersions and dispersions, Proceedings of the American Mathematical Society, 117 (1993) 313-321.
Programs
-
Mathematica
(* 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 *) r = 40; r1 = 10;(* r = # rows of T, r1 = # rows to show*); c = 40; c1 = 12;(* c = # cols of T, c1 = # cols to show*); comp = Select[Range[2, 100000], ! PrimeQ[#] &]; 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]]; TableForm[Table[t[i, j], {i, 1, r1}, {j, 1, c1}]] (* A114577 array *) u = Flatten[Table[t[k, n - k + 1], {n, 1, c1}, {k, 1, n}]] (* A114577 sequence *) row[i_] := row[i] = Table[t[i, j], {j, 1, c}]; f[n_] := Select[Range[r], MemberQ[row[#], n] &] v = Flatten[Table[f[n], {n, 1, 100}]] (* A022446, fractal sequence *) (* - Clark Kimberling, Oct 09 2014 *)
Comments