Helpers

Print message when the algorithm found n-seq

MessageRelationNumber[λ_,nseqs_]:=
Print["λ=",ToString[λ,InputForm]," is a relation number with n-seqs=",ToString[nseqs]]

Calculate λ-weighted continued fraction

weightedContinuedFraction[λ_][{}]:=0
weightedContinuedFraction[λ_][weights_List]:=
(1/λ)*1/(First[weights]+ weightedContinuedFraction[λ][Rest[weights]])//Together

Find the (Subscript[M, k])-sequence until (Subscript[M, k]) > 1 using Proposition 7.4.

initialMkSeqReal[λ_]:=
Module[
{MkList={0}},
With[
{sign=If[λ>0,-1,1]},
Quiet@Check[
While[Last[MkList]<=1,
(* When it attains ∞, Power::infy error occurs *)
AppendTo[MkList,
weightedContinuedFraction[λ][-1*sign^#&/@Range[Length@MkList]]]
];
Rest[MkList]
,Throw[-1*sign^#&/@Range[Length@Rest[MkList]]]
,Power::infy
]
]]

Calculate m=-(Subscript[[(Subscript[n, k-1]),(Subscript[n, k-2]), ..., (Subscript[n, 1])], 1/λ]) and candidates for (Subscript[M, k]) for a given n=((Subscript[n, 1]),(Subscript[n, 2]), ..., (Subscript[n, k-1]))

MkCalculator[λ_][Mkseqs_]:=
SortBy[Flatten[niRangeSelectorReal[λ][{},0,Mkseqs],Length[Mkseqs]],Abs[First[#]]&]//Last

Choose a range for (Subscript[n, i]) for a given (Subscript[n, L])=((Subscript[n, 1]), (Subscript[n, 2]), ..., (Subscript[n, i-1])) and (Subscript[M, k-i]), inductively (for the exhaustive algorithm)

MkCandidate[λ_][nseqs_List,m_]:=
(* Calculate candidates for (Subscript[M, k ])for a given nseqs=((Subscript[n, 1]),(Subscript[n, 2]), ..., (Subscript[n, k-1])) *)
(* m=-[(Subscript[n, k-1]),(Subscript[n, k-2]), ..., (Subscript[n, 1])] *)
If[
IntegerQ[m] (* It cannot be zero *)
,Throw[Append[nseqs,m]] (* Return n-seq with (Subscript[n, k])=m *)
,With[
{lr=If[Ceiling[m]*Floor[m]==0,{-1,1},{Floor[m],Ceiling[m]}]},
{
Append[nseqs,First[lr]]//{weightedContinuedFraction[λ][#],#}&,
Append[nseqs,Last[lr]]//{weightedContinuedFraction[λ][#],#}&
}]
]

niRangeSelectorReal[λ_][nseqs_List,cf_,{}]:=MkCandidate[λ][nseqs,-cf]

niRangeSelectorReal[λ_][nL_List,cf_,remainingMks_]:=
With[
{M=Last@remainingMks}
,Map[
niRangeSelectorReal[λ][Append[nL,#],1/(λ*(#+cf)),Most[remainingMks]]&
,SortBy[Complement[Range[Floor[-cf-(M+1)],Ceiling[-cf+(M+1)]],{0}],Abs]
]
]

Choose a range for (Subscript[n, i]) for a given (Subscript[n, L])=((Subscript[n, 1]), (Subscript[n, 2]), ..., (Subscript[n, i-1])) and (Subscript[M, k-i]), inductively (for the greedy algorithm)

niRangeSelectorRealGreedy[λ_][nL_List,0,w_,0]:=Nothing
niRangeSelectorRealGreedy[λ_][nL_List,0,w_,k_]:=
With[{m=-weightedContinuedFraction[λ][Reverse[nL]]},
Round[m]//
If[Or[m===0,#===0]
,niRangeSelectorRealGreedy[λ][Append[nL,1],0,w,k-1]
,If[IntegerQ[m]
,Throw[Append[nL,#]]
,niRangeSelectorRealGreedy[λ][Append[nL,#],0,w,k-1]
]
]&
]

niRangeSelectorRealGreedy[λ_][nL_List,n_,w_,k_]:=
(* Choose a range for (Subscript[n, i]) for a given nL=((Subscript[n, 1]),(Subscript[n, 2]), ..., (Subscript[n, i-1])) and (Subscript[M, k-i]), inductively *)
With[
{cf=weightedContinuedFraction[λ][Reverse[nL]]}
,Map[
niRangeSelectorRealGreedy[λ][Append[nL,#],n-1,w,k-1]&
,SortBy[Complement[Range[Floor[-cf-w],Ceiling[-cf+w]],{0}],Abs]
]
]

Main Functions

ExhaustiveAlgorithm[λ_]:=
If[Abs[λ]>=4
,Print["Given λ=",ToString[λ,InputForm]," is larger than 4, it is not a relation number"]
,Catch[
Module[
{MkSeq={}},
Print["-- Exhaustive algorithm with λ=",ToString[λ,InputForm]];
MkSeq=initialMkSeqReal[λ];
(* The sequence starts from (Subscript[M, 1]), not (Subscript[M, 0])=0 for convenience *)
Print["   Start with (Subscript[M, k]) sequence=",ToString[MkSeq,InputForm]];
While[True,
MkCalculator[λ][MkSeq]//(
MkSeq=Append[MkSeq,Abs@First[#]];
Print["       Update "<>ToString[ToExpression["Subscript[M,"<>ToString[Length[MkSeq]]<>"]"],StandardForm]<>"="<>ToString[Last[MkSeq],InputForm]];
If[IntegerQ[First[#]]
,Throw[Prepend[Last[#],-First[#]]]]
)&
]
]]//(MessageRelationNumber[λ,#];#)&
]

GreedyAlgorithm[λ_,n_,w_,k_]:=
(
Print["-- Greedy algorithm with λ=",ToString[λ,InputForm]," N=",ToString[n,InputForm]," W=",ToString[w,InputForm]," and k=",ToString[k,InputForm]];
Catch[niRangeSelectorRealGreedy[λ][{},n,w,k]]//Flatten//If[Length[#]===0
,Print["Failed to find n-seq for λ=",ToString[λ,InputForm]];Nothing
,(MessageRelationNumber[λ,#];#)
]&
)

ExhaustiveAlgorithm[7/2]

GreedyAlgorithm[7/2,5,2,16]

GreedyAlgorithm[11/3,5,3,24]

GreedyAlgorithm[15/4,5,4,32]

TimeConstrained[ExhaustiveAlgorithm[11/3],3]

Association@@Map[
TimeConstrained[
#->ExhaustiveAlgorithm[#]
,60
,Nothing
]&
,Map[Function[a,
Map[Function[b,
b/a
],Select[Range[4a-1],CoprimeQ[a,#]&]]
],{21,22}]//Flatten]

record=<|
37/21->{21/37, 21/16,1113/407,1113/34,38829/37},
38/21->{21/38, 21/17,357/152,1155/53,30009/38},
47/21->{21/47, 21/26, 546/235,651/76,18627/517,6139/5},
50/21->{21/50, 21/29, 609/400,777/191,20811/650,131880/11},
52/21->{21/52,21/31,651/520,861/389,35511/2704,31101/47},
53/21->{21/53, 21/32, 672/583,231/89,5649/212,15330/13},
58/21->{21/58, 21/37, 777/928, 336/151,22659/1972,52374/773},
59/21->{21/59, 21/38, 798/1003, 357/205,25368/3127,26943/352},
61/21->{21/61, 21/40, 840/1159, 399/319,31038/14579,15078/1819,1060437/8479},
62/21->{21/62, 21/41, 861/1240, 420/379,7959/2542,3633/37},
64/21->{21/64, 21/43, 903/1408, 462/505, 10605/2752,32718/403},
65/21->{21/65, 21/44, 924/1495, 483/571, 11991/5720,13839/551,3254811/4160},
67/21->{21/67, 21/46, 966/1675, 525/709, 14889/12328,18753/9767,830445/84286,739284/4201},
68/21->{21/68, 21/47, 987/1768, 546/781, 16401/15980,4935/421,485709/884},
71/21->{21/71, 21/50, 1050/2059, 609/1009, 21189/28400, 8400/7211,151431/84419,479262/17407},
73/21->{21/73, 21/52, 1092/2263, 651/1171, 24591/37960, 10920/13369, 280749/178777,322178/76805},
74/21->{21/74, 21/53, 1113/2368, 672/1255, 26355/43142, 12243/16787, 352527/336256,95424/16271},
76/21->{21/76, 21/55, 1155/2584, 714/1429, 30009/54340, 15015/24331, 510951/708016, 195636/197065, 4138365/108604},
79/21->{21/79, 21/58, 1218/2923, 777/1705, 35805/73312, 19488/37507, 787647/1423501, 378399/635854, 13352934/20338945, 5406555/6986011, 146706231/124777024},
80/21->{21/80, 21/59, 1239/3040, 798/1801, 37821/80240, 21063/42419, 890799/1708480, 448476/817681, 17171301/29536400, 7753305/12365099, 259667079/368943520, 96847674/109276441, 2294805261/994301360},
82/21->{21/82, 21/61, 1281/3280, 840/1999, 41979/95038, 24339/53059, 1114239/2355040, 603120/1240801, 26056821/52289842, 13391301/26233021, 550893441/1053021040, 269676120/502127599, 10544679579/19061021278, 4881481059/8516341699, 178843175679/298058572480, 76332073440/119215396801, 2503523332821/3516432515602, 900549790581/1012909182781, 21271092838401/9213470160400},
83/21->{21/83, 21/62, 1302/3403, 861/2101, 44121/102920, 26040/58799, 1234779/2718997, 687939/1484218, 31168578/66091157, 16721859/34922579, 733374159/1510659760, 382215120/777285601, 16322997621/32790849923, 8296480101/16467852302, 345824898342/678223892683, 171598816221/332398994341, 6980378881161/13346414783960, 3376803740520/6366035902799, 133686753958779/248106269469157, 62773875407859/114419515510378, 2402809825717938/4286588128509077, 1084558442152899/1883778302791139, 39559344358613919/66335248432973920, 16783617073403040/26775904074360001, 562293985561560021/829359821079427763, 209838027020096181/267065835517867742, 5608382545875222582/4749908105315039563},
31/22->{22/31, 22/9,1562/155,935/6,214962/31},
35/22->{22/35,22/13,264/35,814/3,438966/35},
37/22->{22/37,22/15,143/37,209/10,32373/37},
47/22->{22/47,22/25,550/141,858/7,97790/47},
49/22->{22/49, 22/27, 594/245,1298/141,23782/147},
51/22->{22/51, 22/29, 638/357,198/19,33374/51},
53/22->{22/53, 22/31, 682/477,55/17,25498/371,150810/29},
57/22->{22/57, 22/35, 770/741,286/29,44990/57},
59/22->{22/59, 22/37, 814/885, 330/71,79442/1475,72182/87},
61/22->{22/61, 22/39, 858/1037, 374/179,1672/61,57618/17},
63/22->{22/63, 22/41, 902/1197, 418/295,8206/2709,5137/158,1977481/126},
65/22->{22/65, 22/43, 946/1365, 462/419,9218/2795,37818/833},
67/22->{22/67, 22/45, 990/1541, 506/551, 12122/3015,18678/31},
69/22->{22/69, 22/47, 1034/1725, 550/691, 15202/9729,572/133,464266/39813},
71/22->{22/71, 22/49, 1078/1917, 594/839, 18458/17395,5390/1063,2319526/5235},
73/22->{22/73, 22/51, 1122/2117, 638/995, 21890/26061, 7854/4171,83138/4453,785345/5876},
75/22->{22/75, 22/53, 1166/2325, 682/1159, 25498/35775, 10494/10277,226094/16275,849046/439},
79/22->{22/79, 22/57, 1254/2765, 770/1511, 33242/58539, 16302/25297, 556534/710605, 197890/154071,4755718/2177477},
81/22->{22/81, 22/59, 1298/2997, 814/1699, 37378/71685, 19470/34307, 754754/1201797, 326414/447043, 9834946/9770949},
83/22->{22/83, 22/61, 1342/3237, 858/1895, 41690/86071, 22814/44381, 976382/1790061, 474474/813679, 17900938/28154015, 7462510/10253077, 225567694/231617061, 61392474/6049367},
85/22->{22/85, 22/63, 1386/3485, 902/2099, 46178/101745, 26334/55567, 1222474/2484805, 643126/1262331, 27771282/52632425, 13622510/24861143, 546945146/955283805, 247249926/408338659, 8983450498/13692542305, 3543952126/4709091807, 103600019754/99036872885},
87/22->{22/87, 22/65, 1430/3741, 946/2311, 50842/118755, 30030/67913, 1494086/3295821, 833426/1801735, 39638170/84242883, 21302798/44604713, 981303686/2027266605, 512642130/1045962919, 23011184218/46398908643, 11733057358/23387724425, 514529937350/1013956034829, 256402675474/499426097479, 10987374144538/21143037714435, 5346515284110/10155663569897, 223424598537734/418395900863469, 105801262287314/194971302325735, 4289368651166170/7757793483342627, 1961740880845262/3468424832176457, 76305346307882054/131081503765813965, 33147046929286290/54776157457931911, 1205075464074502042/1881732615992169027, 475840431630203662/676657151917666985, 14886457342188673670/17471054665009309101, 4417967846324193106/2584597322820635431}
|>;

Length/@record//Values

Module[{result=<||>,recordNew=record,minlen=Length/@record//Values//Min},
KeyValueMap[
(Function[calres,
If[Length[calres]==2
,(
recordNew[#[[1]]]=Append[recordNew[#[[1]]],calres[[1]]];
Print["   Update -> ",recordNew[#[[1]]]];
)
,(
Print["Found result for ",#[[1]],": ",calres];
result[#[[1]]]=calres;
recordNew=KeyDrop[recordNew,#[[1]]];
)
]
][Catch[
Print[#1," and ",#2];
MkCalculator[#1][#2]]])&
,Select[recordNew,Length[#]===minlen&]
]]