A354236 - OEIS

%I #27 Jan 17 2025 16:39:20

%S 1,5,2,3,10,4,17,6,20,8,11,34,12,21,16,7,22,35,13,40,32,9,14,23,68,24,

%T 42,64,25,18,15,44,69,26,80,128,33,49,19,28,45,70,48,84,256,43,65,50,

%U 36,29,46,75,52,85,512,57,86,66,51,37,30,88,136,53,160,1024

%N A(n,k) is the n-th number m such that the Collatz (or 3x+1) trajectory starting at m contains exactly k odd integers; square array A(n,k), n>=1, k>=1, read by antidiagonals.

%H Alois P. Heinz, <a href="/A354236/b354236.txt">Rows n = 1..150, flattened</a>

%H Wikipedia, <a href="https://en.wikipedia.org/wiki/Collatz_conjecture">Collatz Conjecture</a>

%H <a href="/index/3#3x1">Index entries for sequences related to 3x+1 (or Collatz) problem</a>

%H <a href="/index/Per#IntegerPermutation">Index entries for sequences that are permutations of the positive integers</a>

%F A078719(A(n,k)) = k.

%e Square array A(n,k) begins:

%e     1,   5,  3,  17, 11,  7,  9,  25,  33,  43, ...

%e     2,  10,  6,  34, 22, 14, 18,  49,  65,  86, ...

%e     4,  20, 12,  35, 23, 15, 19,  50,  66,  87, ...

%e     8,  21, 13,  68, 44, 28, 36,  51,  67,  89, ...

%e    16,  40, 24,  69, 45, 29, 37,  98, 130, 172, ...

%e    32,  42, 26,  70, 46, 30, 38,  99, 131, 173, ...

%e    64,  80, 48,  75, 88, 56, 72, 100, 132, 174, ...

%e   128,  84, 52, 136, 90, 58, 74, 101, 133, 177, ...

%e   256,  85, 53, 138, 92, 60, 76, 102, 134, 178, ...

%e   512, 160, 96, 140, 93, 61, 77, 196, 260, 179, ...

%p b:= proc(n) option remember; irem(n, 2, 'r')+

%p       `if`(n=1, 0, b(`if`(n::odd, 3*n+1, r)))

%p     end:

%p A:= proc() local h, p, q; p, q:= proc() [] end, 0;

%p       proc(n, k)

%p         if k=1 then return 2^(n-1) fi;

%p         while nops(p(k))<n do q:= q+1;

%p           h:= b(q);

%p           p(h):= [p(h)[], q]

%p         od; p(k)[n]

%p       end

%p     end():

%p seq(seq(A(n, 1+d-n), n=1..d), d=1..12);

%t b[n_] := b[n] = Module[{q, r}, {q, r} = QuotientRemainder[n, 2]; r +

%t      If[n == 1, 0, b[If[OddQ[n], 3*n + 1, q]]]];

%t A = Module[{h, p, q}, p[_] = {}; q = 0;

%t      Function[{n, k}, If[k == 1, 2^(n - 1)];

%t      While[Length[p[k]] < n, q = q + 1;

%t         h = b[q];

%t         p[h] = Append[p[h], q]];

%t      p[k][[n]]]];

%t Table[Table[A[n, 1+d-n], {n, 1, d}], {d, 1, 12}] // Flatten (* _Jean-François Alcover_, Jun 02 2022, after _Alois P. Heinz_ *)

%Y Columns k=1-12 give: A011782, A062052, A062053, A062054, A062055, A062056, A062057, A062058, A062059, A062060, A072466, A072122.

%Y Row n=1 gives A092893(k-1).

%Y Main diagonal gives A380244.

%Y Cf. A006577, A006667, A078719.

%K nonn,tabl,changed

%O 1,2

%A _Alois P. Heinz_, May 20 2022