J. Parker Shectman has authored 6 sequences.
A345254
Dispersion of A004754, a rectangular array T(n,k) read by downward antidiagonals.
Original entry on oeis.org
1, 2, 3, 4, 5, 6, 8, 9, 10, 7, 16, 17, 18, 11, 12, 32, 33, 34, 19, 20, 13, 64, 65, 66, 35, 36, 21, 14, 128, 129, 130, 67, 68, 37, 22, 15, 256, 257, 258, 131, 132, 69, 38, 23, 24, 512, 513, 514, 259, 260, 133, 70, 39, 40, 25, 1024, 1025, 1026, 515, 516, 261, 134
Offset: 1
Northwest corner of {T(n,k)}:
k=1 k=2 k=3 k=4 k=5 k=6
n=0: 1, 2, 4, 8, 16, 32, ...
n=1: 3, 5, 9, 17, 33, 65, ...
n=2: 6, 10, 18, 34, 66, 130, ...
n=3: 7, 11, 19, 35, 67, 131, ...
n=4: 12, 20, 36, 68, 132, 260, ...
...
Northwest corner of {T(n,k)} in base-2:
k=1 k=2 k=3 k=4 k=5 k=6
n=0: 1, 10, 100, 1000, 10000, 100000, ...
n=1: 11, 101, 1001, 10001, 100001, 1000001, ...
n=2: 110, 1010, 10010, 100010, 1000010, 10000010, ...
n=3: 111, 1011, 10011, 100010, 1000011, 10000011, ...
n=4: 1100,10100, 100100, 1000100, 10000100, 100000100, ...
...
Cf.
A000027,
A004754,
A053645,
A005408,
A005843,
A019586,
A054582,
A059893,
A065120,
A139706,
A139708,
A191448,
A345252,
A345253.
-
(*Simplified Formula*)
MatrixForm[Prepend[Table[n + 2^(Floor[Log[2, n]] + k), {n, 1, 4}, {k, 1, 6}], Table[2^(k - 1), {k, 1, 6}]]]
(*Branching Formula*)
MatrixForm[Prepend[Table[NestList[Function[# + 2^(Floor[Log[2, #]])], n + 2^(Floor[Log[2, n]] + 1), 5], {n, 1, 4}], NestList[Function[# + 2^(Floor[Log[2, #]])], 1, 5]]]
-
T(n, k) = if (n==0, 2^(k-1), n + 2^(log(n)\log(2) + k));
matrix(7, 7, n, k, n--; T(n, k)) \\ Michel Marcus, Jul 30 2021
A345253
Maximal Fibonacci tree: Arrangement of the positive integers as labels of a complete binary tree.
Original entry on oeis.org
1, 2, 3, 4, 5, 6, 8, 7, 9, 10, 13, 11, 14, 16, 21, 12, 15, 17, 22, 18, 23, 26, 34, 19, 24, 27, 35, 29, 37, 42, 55, 20, 25, 28, 36, 30, 38, 43, 56, 31, 39, 44, 57, 47, 60, 68, 89, 32, 40, 45, 58, 48, 61, 69, 90, 50, 63, 71, 92, 76, 97, 110, 144, 33, 41, 46, 59, 49
Offset: 1
As a complete binary tree:
1
/ \
2 3
/ \ / \
4 5 6 8
/ \ / \ / \ / \
7 9 10 13 11 14 16 21
/ \ / \ / \ / \ / \ / \ / \ / \
...
By maximal Fibonacci expansion:
F(1)
/ \
F(1) + F(2) F(1) + F(3)
/ \ / \
F(1) + F(2) + F(3) F(1) + F(2) + F(4) F(1) + F(3) + F(4) F(1) + F(3) + F(5)
...
"Fibonacci gaps," or differences between successive indices in maximal Fibonacci expansion above, are A007931(n-1) for n > 1 (see link):
*
/ \
1 2
/ \ / \
11 12 21 22
/ \ / \ / \ / \
111 112 121 122 211 212 221 222
/ \ / \ / \ / \ / \ / \ / \ / \
...
In examples of the three methods below:
Branch left-right-right down the tree to arrive at nodal position n = 2*(2*(2*1) + 1) + 1 = 11;
Branch right-left-left down the tree to arrive at nodal position n = 2*(2*(2*1 + 1)) = 12.
Tree by inner composition of (one plus) the lower and upper Wythoff sequences, A000201 and A001950 (Method 1):
a(11) = A000201(A001950(A001950(1) + 1) + 1) + 1 = 13.
a(12) = A001950(A000201(A000201(1) + 1) + 1) + 1 = 11.
Tree by (outer) composition of branching functions L(n) = n + F(Finv(n)) and R(n) = n + F(Finv(n) + 1), where F(n) = A000045(n) and Finv(n) = A130233(n) (Method 2):
a(11) = R(R(L(1))) = 13.
a(12) = L(R(R(1))) = 11.
Tree by outer composition of A060143 and A060144 (Wythoff inverse sequences) (Method 3):
a(11) = 13, position of first nonzero in A060144(A060144(A060143(m))) = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, ..., for m = 1, 2, 3, ....
a(12) = 11, position of first nonzero in A060143(A060143(A060144(m))) = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, ..., for m = 1, 2, 3, ....
Cf.
A000045,
A000201,
A001950,
A007931,
A020988,
A020989,
A026351,
A026352,
A029837,
A048680,
A049651,
A059893,
A061547,
A070939,
A081242,
A083047,
A095903,
A099919,
A112310,
A113473,
A130233,
A200648,
A232560,
A243571,
A255773,
A255774,
A329395,
A343152,
A345252,
A345254.
-
(* For binary tree implementations, see supporting file under LINKS *)
a[n_] := (x = 0; y = 0; BDn = Reverse[IntegerDigits[n, 2]]; imax = Length[BDn] - 1; For[i = 0, i <= imax, i++, {x, y} = {y + 1, x + y}; If[BDn[[i + 1]] == 1, {x, y} = {y, x + y}]]; y);
(* Adapted from PARI code of Kevin Ryde *)
-
a(n) = my(x=0,y=0); for(i=0,logint(n,2), [x,y]=[y+1,x+y]; if(bittest(n,i), [x,y]=[y,x+y])); y; \\ Kevin Ryde, Jun 19 2021
A345252
2-1-Fibonacci cohort array, a rectangular array T(n,k) read by downward antidiagonals.
Original entry on oeis.org
1, 2, 3, 4, 6, 5, 7, 11, 10, 8, 12, 19, 18, 16, 9, 20, 32, 31, 29, 17, 13, 33, 53, 52, 50, 30, 26, 14, 54, 87, 86, 84, 51, 47, 27, 15, 88, 142, 141, 139, 85, 81, 48, 28, 21, 143, 231, 230, 228, 140, 136, 82, 49, 42, 22, 232, 375, 374, 372, 229, 225, 137, 83, 76
Offset: 1
Northwest corner of {T(n,k)}:
k=1 k=2 k=3 k=4 k=5 k=6 ...
n=0: 1, 2, 4, 7, 12, 20, ...
n=1: 3, 6, 11, 19, 32, 53, ...
n=2: 5, 10, 18, 31, 52, 86, ...
n=3: 8, 16, 29, 50, 84, 139, ...
n=4: 9, 17, 30, 51, 85, 140, ...
...
Northwest corner of {T(n,k)} in maximal Fibonacci expansion (see link):
k=1 k=2 k=3 ...
n=0: F(1), F(1)+F(2), F(1)+F(2)+F(3), ...
n=1: F(1)+F(3), F(1)+F(3)+F(4), F(1)+F(3)+F(4)+F(5), ...
n=2: F(1)+F(2)+F(4), F(1)+F(2)+F(4)+F(5), F(1)+F(2)+F(4)+F(5)+F(6), ...
...
Northwest corner of {T(n,k)} as "Fibonacci gaps," or differences between successive indices in maximal Fibonacci expansion above, (see link):
k=1 k=2 k=3 k=4 k=5 k=6 ...
n=0: *, 1, 11, 111, 1111, 11111, ...
n=1: 2, 21, 211, 2111, 21111, 211111, ...
n=2: 12, 121, 1211, 12111, 121111, 1211111, ...
n=3: 22, 221, 2211, 22111, 221111, 2211111, ...
n=4: 122, 1221, 12211, 122111, 1221111, 12211111, ...
...
Cf.
A000027,
A000045,
A000071,
A000201,
A001950,
A035513,
A059893,
A083047,
A130233,
A132817,
A191436,
A194030,
A232560,
A345253,
A345254.
-
(* Define A000045 *)
F[n_] := Fibonacci[n]
(* Defined A130233 *)
Finv[n_] := Floor[Log[GoldenRatio, Sqrt[5]n + 1]]
(* Simplified Formula *)
MatrixForm[Table[n + F[Finv[n] + k + 2] - F[Finv[n] + 2], {n, 0, 4}, {k, 1, 6}]]
(* Branching Formula *)
MatrixForm[Table[NestList[Function[# + F[Finv[#]]], n + F[Finv[n] + 1], 5], {n, 0, 4}]]
A343152
Reverse the order of all but the most significant bits in the maximal Fibonacci expansion of n.
Original entry on oeis.org
1, 2, 3, 4, 6, 5, 7, 8, 11, 10, 9, 12, 16, 14, 19, 13, 18, 17, 15, 20, 21, 29, 27, 24, 32, 26, 23, 31, 22, 30, 28, 25, 33, 42, 37, 50, 35, 48, 45, 40, 53, 34, 47, 44, 39, 52, 43, 38, 51, 36, 49, 46, 41, 54, 55, 76, 71, 63, 84, 69, 61, 82, 58, 79, 74, 66, 87
Offset: 1
For an example of calculation by reversing Fibonacci binary digits, see reference in link, p. 144:
On the basis (1,1,2,3,5,8) n=13 is written as 110101, Reversing all but the most AND least significant digits gives 101011, which evaluates to 16, so a(13)=16.
On the basis (1,1,2,3,5,8) n=14 is written as 101101, Reversing all but the most AND least significant digits gives 101101, which evaluates to 14, so a(14)=14.
-
(*Produce indices of maximal Fibonacci expansion (recursively)*)
MaxFibInd[n_] := Module[{t = Floor[Log[GoldenRatio, Sqrt[5]*n + 1]] - 1}, Piecewise[{{{1}, n == 1}, {Append[MaxFibInd[n - Fibonacci[t]], t], n > 1}},]];
(*Define a(n)*)
a[n_] := Module[{MFI = MaxFibInd[n]}, Apply[Plus, Fibonacci[Last[MFI] - MFI + 1]]];
(*Generate DATA*)
Array[a, 67]
A343150
Reverse the order of all but the most significant bits in the minimal Fibonacci expansion of n.
Original entry on oeis.org
1, 2, 3, 4, 5, 7, 6, 8, 11, 10, 9, 12, 13, 18, 16, 15, 20, 14, 19, 17, 21, 29, 26, 24, 32, 23, 31, 28, 22, 30, 27, 25, 33, 34, 47, 42, 39, 52, 37, 50, 45, 36, 49, 44, 41, 54, 35, 48, 43, 40, 53, 38, 51, 46, 55, 76, 68, 63, 84, 60, 81, 73, 58, 79, 71, 66, 87
Offset: 1
For an example of calculation by reversing Fibonacci binary digits, see reference in link, p. 144:
On the basis (1,1,2,3,5,8,13) n=13 is written as 0000001. Reversing all but the most significant digit gives 0000001, which evaluates to 13, so a(13)=13.
On the basis (1,1,2,3,5,8,13) n=14 is written as 0100001. Reversing all but the most significant digit gives 0000101, which evaluates to 18, so a(14)=18.
Note: The permutation can also be accomplished using the basis (1,2,3,5,8,13), by holding fixed the TWO most significant digits and reversing the remaining digits.
-
(*Produce indices of minimal Fibonacci representation (recursively)*)
MinFibInd[n_] := Module[{t = Floor[Log[GoldenRatio, Sqrt[5]*n + 1]] - 1}, Piecewise[{{{2}, n == 1}, {Append[MinFibInd[n - Fibonacci[t + 1]], t + 1], n > 1 && n - Fibonacci[t + 1] >= Fibonacci[t - 1]}, {Append[Most[MinFibInd[n - Fibonacci[t - 1]]], t + 1], n > 1 && n - Fibonacci[t + 1] < Fibonacci[t - 1]}},]];
(*Define a(n)*)
a[n_] := Module[{MFI = MinFibInd[n]}, Apply[Plus, Fibonacci[Append[Last[MFI] - Most[MFI], Last[MFI]]]]];
(*Generate DATA*)
Array[a, 67]
A343149
Floor-powerfree numbers: positive integers not expressible as a (nontrivially) nested floor function using the same positive real slope throughout the nesting.
Original entry on oeis.org
2, 3, 6, 7, 15, 23, 24, 44, 47, 48, 56, 57, 58, 59, 60, 61, 62, 63, 79, 97, 98, 113, 143, 167, 184, 185, 186, 210, 211, 212, 213, 214, 215, 222, 223, 247, 287, 320, 321, 356, 381, 462, 463, 474, 475, 481, 482, 483, 507, 508, 520, 521, 522, 553, 559, 604, 623
Offset: 1
Example (of calculation by sieve, see reference in link, p. 221): The first term, 2, while given by the (un-nested) floor [mu] of a real slope 2 <= mu < 3, is too big to result from a twice-nested floor [[mu]mu], thrice-nested floor [mu[mu[mu]]], etc. for mu < 2. Yet for mu >= 2, the integer 2 is too small to result from a twice-nested, thrice-nested, etc. floor. Sequence A064801 = 1,4,5,9,... gives the "floor squares" - positive integers that are expressible as the twice-nested floor [mu[mu]] for a positive real slope mu. Thus 2,3,6,7 and 8 are not "floor squares". Besides 0 and 1, the next smallest integer obtainable from nesting a floor function with real positive slope t times is 2^t. Thus, the sequence of positive "floor cubes" starts with 1 and continues 8,9,12,13,14,27,... Hence, the first level of the sieve catches the floor squares 1,4,5,9,..., the second level of the sieve catches the floor cubes 1,8,... So, 2,3,6, and 7 are the initial floor-powerfree numbers passing the sieve for all t >= 2.
-
(*Define the nested floor function.*)
NestedFloor[slope_, t_] := Nest[Function[Floor[#*slope]], 1, t]
(*Specify an upper bound on a(n) in DATA.*)
aMax = 1017;
(*Calculate the number of floor powers that must be sifted out.*)
tMax = Ceiling[Log[2, aMax]];
(*Initialize slopes for each floor power.*)
slopes = Table[{1}, {tMax}]; slopes[[1]] = Table[n, {n, 1, aMax}];
(*Initialize "floor-powerful" numbers for each floor power.*)
powerfuls = Table[{1}, {tMax}]; powerfuls[[1]] = Table[n, {n, 1, aMax}];
Do[n = 2; While[Last[powerfuls[[t]]] < aMax,
(*Include slopes from previously sifted power as coarse slopes.*) coarseSlope = slopes[[t - 1]][[n]]; AppendTo[slopes[[t]], coarseSlope]; AppendTo[powerfuls[[t]], NestedFloor[coarseSlope, t]];
(*Generate fine slopes between the coarse slopes; use floor-powerful numbers from previously sifted floor power as denominators q, start with a numerator p that gives the least fine slope exceeding the current coarse one*) q = powerfuls[[t - 1]][[n]]; p = Floor[coarseSlope*q] + 1; fineSlope = p/q;
(*Insert fine slope(s) (if any) between the current coarse slope and the next smallest one.*) nextCoarse = slopes[[t - 1]][[n + 1]]; While[fineSlope < nextCoarse, AppendTo[slopes[[t]], fineSlope]; AppendTo[powerfuls[[t]], NestedFloor[fineSlope, t]]; p++; fineSlope = p/q;]; n++], {t, 2, tMax}]
(*Sift out all floor-powerful numbers to output the floor-powerfree numbers, a(n)*)
Complement[Table[n, {n, 1, aMax}], Union[Flatten[Rest[powerfuls]]]]
Comments