A394034 - OEIS

%I #6 Mar 16 2026 17:46:43

%S 1,3,4,8,11,14,21,19,25,17,55,27,30,43,46,144,29,35,45,51,59,377,50,

%T 37,82,53,61,67,987,71,66,95,98,114,69,77,2584,76,79,108,103,119,127,

%U 140,85,6765,131,92,113,121,124,137,153,156,93,17711,186,97,118,134

%N Rectangular array, read by descending antidiagonals: numerators in the best lower approximating array to the golden ratio, phi (A001622). (See A394033.)

%e Corner of array of denominators:

%e    1     2    5   13   34   89  233  610  1597  4181 10946 28657

%e    3     7   12   17   18   31   44   47    81   115   123   212

%e    9    16   19   22   23   41   49   57    60   107   128   149

%e    11   27   28   51   59   67   70   73   133   154   157   280

%e    29   32   33   61   64   75   83   86   159   167   175   183

%e    37   38   71   74   77   80   96   99   185   191   301   322

%e Corner of array of numerators:

%e     1    3    8   21   55  144  377  987  2584  6765 17711

%e     4   11   19   27   29   50   71   76   131   186   199

%e    14   25   30   35   37   66   79   92    97   173   207

%e    17   43   45   82   95  108  113  118   215   249   254

%e    46   51   53   98  103  121  134  139   257   270   283

%e    59   61  114  119  124  129  155  160   299   309   487

%e Corner of array of approximations:

%e     1.       1.5       1.6       1.61538   1.61765

%e    1.33333   1.57143   1.58333   1.58824   1.61111

%e    1.55556   1.5625    1.57895   1.59091   1.6087

%e    1.54545   1.59259   1.60714   1.60784   1.61017

%e    1.58621   1.59375   1.60606   1.60656   1.60938

%e    1.59459   1.60526   1.60563   1.60811   1.61039

%t x = GoldenRatio; numRows = 6; numCols = 12;

%t usedValues = {}; lowerArray = Table[Null, {numRows}, {numCols}];

%t For[n = 1, n <= numRows, n++, b = 1;

%t   foundStart = False;

%t   While[! foundStart, a = Floor[b*x]; val = a/b;

%t    If[val < x && GCD[a, b] == 1 && ! MemberQ[usedValues, val],

%t     lowerArray[[n, 1]] = val;

%t     AppendTo[usedValues, val]; foundStart = True, b++]];

%t   For[k = 1, k < numCols, k++, currentVal = lowerArray[[n, k]];

%t    currentB = Denominator[currentVal];

%t    nextVal = Null; testB = currentB + 1;

%t    While[nextVal === Null, testA = Floor[testB*x];

%t     candidate = testA/testB;

%t     If[GCD[testA, testB] == 1 && candidate > currentVal &&

%t       candidate < x && ! MemberQ[usedValues, candidate],

%t      nextVal = candidate;

%t      AppendTo[usedValues, candidate];

%t      lowerArray[[n, k + 1]] = nextVal, testB++]];];];

%t Grid[lowerArray]  (* Lower best approximating array to golden ratio *)

%t Grid[N[lowerArray]]  (* approximations *)

%t Grid[Denominator[lowerArray]]  (* A394033 *)

%t Grid[Numerator[lowerArray]]    (* A394034 *)

%Y Cf. A001622, A001519 (row 1), A394035, A394036, A394037.

%K nonn,tabl,frac

%O 1,2

%A _Clark Kimberling_, Mar 10 2026