The Functions Ak1 and Ak2

Function to find all nonempty SRS periods within some subsets of D2.
Usage:
Ak1[q]
q....positive integer
This function call makes Mathematica to search for all periods within Rgq\Rgq-1.
Ak2[q]
This function is for searching for all periods within the set
Ei={(x, y) ∈ R | x≥ ygq-1-(((gq-1))^2), x≥ ygq-(((gq))^2)}.
Note that both functions will probably return the empty set, because there are not supposed to be any period in the designated areas.

<< DiscreteMath`Combinatorica`; 
$RecursionLimit = Infinity;
Off[General::spell1];

Akq=Function[{q, k},Module[{a, b},

(*Creates the set Ak,q*)

a = 
                      Ceiling[-k/(1 - k^2) - q + 
                          1]; 
b = 
                      Floor[1/(1 - k^2) + q - 
                          1]; 
Flatten[
                      Table[{x, y}, {x, Ceiling[-q], Floor[q], 1}, {y, a, 
                          b, 1}], 1]
]];

\(SetAkq = 
            Function[{r, A}, 
              Block[\ {S, S1, S2, TauR, Tau, 
                  GenerateList}, 

 (*Calculates\ the\ vertices\ of\ the\ graph*) 

 (*LeftShift\  + \ #2\ on\ the\ last\ Position*) 
Tau = \(({Apply[\((##2)\) &, #1], #2})\) &; 

 (*\ 
                  z\  -> \ {z, \(-Floor\) \((Min \((rz)\))\), \(-Floor\) \((Max \((rz)\))\)}, \ r\ \in\ R*) 
GenerateList = 
                  Function[
                    z, 
{z, \(-Floor[\(Minimize[{x, y} . z, 
                              r, {x, 
                                y}]\)[\([1]\)]]\), \(-Floor[\(Maximize[{x, 
                                  y} . z, 
                              r, {x, 
                                y}]\)[\([1]\)]]\)}]; 

 (*Generates\ Tau_ {r} \((z)\)\ for\ all\ r\ \in\ R*) 
TauR = 
                  Function[z, 
                    Table[GenerateList[Tau[z[\([1]\)], i]], {i, z[\([3]\)], 
                        z[\([2]\)]}]]; 

 (*Initialization*) 
S = 
                  GenerateList /@ 
                    A; 
S1 = {}; 

 (*S_ {i + 1} = 
                    TauR \((S_ {i}\S_ {i - 1})\)\  ⋃ \ 
                      S_ {i - 
                            1}\ up\ to\ stabilization*) 
While[\((S\  ≠ \ 
                      S1)\)\ , 
S2 = 
                    Complement[S, S1]; 
S1 = 
                    S; 
S = 
                    S ⋃ 
                      Flatten[TauR /@ S2, 
                        1];
]; 

S]];\)

\(BuildGraph = 
            Function[S, 
              Block[{mx, my, Vx, AL, AdjazenzList, 
                  gr}, 

 (*Generates\ the\ Graph\ for\ a\ set\ \((using\ the\ Combinatorics - 
                        package)\)\ *) 

 (*The\ List\ of\ Edges\ is\ Created\ without\ using\ the\ function\ "Position"\ \((very\ slow)\)*) 
AdjazenzList = 
                  Function[
                    z, 
Table[{{\((z[\([1, 1]\)] + 
                                  mx)\)*\((2*my + 1)\) + z[\([1, 2]\)] + my + 
                            1, \((z[\([1, 2]\)] + mx)\)*\((2*my + 1)\) + my + 
                            1 + i}}, {i, z[\([3]\)], 
                        z[\([2]\)]}]]; \ 
mx = 
                  Max @@ \((Abs /@ \((First /@ \((First /@ 
                                S)\))\))\); 
my = 
                  Max @@ \((Abs /@ \((Last /@ \((First /@ 
                                S)\))\))\); 
Vx = 
                  Flatten[
                    Table[{{j, i}}, {j, \(-mx\), mx}, {i, \(-my\), my}], 
                    1]; 
AL = 
                  Join @@ \((AdjazenzList /@ S)\); 
gr = 
                  Graph[AL, Vx, 
                    EdgeDirection -> 
                      True]; 
InduceSubgraph[gr, 
                  Union[First /@ Edges[gr]]]]];\)

FindAllCycles = 
            Function[g, 
              Block[{IL, FC, 
                  FAC}, 

 (*Returns the list of all cycles within the graph g that give nonemty cutouts*) 
 (*The cycles are rotated such that the leftmost element is the lexicographical lowest*) 

 (*1.  way :  
                      Recursive calculation of all cycles .  
                          Test afterwards*) 
FC = 
                  Function[{$ModuleNumber, i, SC}, 
                    Block[{erg}, 
If[
                        MemberQ[SC, i], 
NormCyc /@ 
                          Select[{First /@ 
                                Part[Vertices[g], 
                                  Take[SC, 
                                    Append[
                                      Flatten[Position[SC, i]], -1]]]}, 
                            CheckCyc], 
Union @@ (FC[ $ModuleNumber + 1, #, Append[SC, 
                                    i]] & /@   IL[[i]])]]]; 

 (*2.  way :  
                      Recursive calculation of all cycles .  
                          A path is not further persecuted,  
                  if it cannot be part of a valid cycle*) 
FAC = 
                  Function[{$ModuleNumber, i, SC}, 
If[
                      CheckSeq[
                        Part[Vertices[g], 
                          Append[SC, i]]], 
If [
                        MemberQ[SC, i], 
If [
                          SC[[1]] == 
                            i, {NormCyc[
                              First /@ 
                                Part[Vertices[g], 
                                  SC]]}, {}], 
Union @@ (FAC[ $ModuleNumber + 1, #, Append[SC, 
                                    i]] & /@   IL[[i]])], 
{}]]; 

IL = 
                  ToAdjacencyLists[
                    g]; 
 (*#  cycles  ≤ 
                      2^10  ->  1.  way,  
                  otherwise  ->  2.  way*) 
If[
                  cc == {} ∨ 
                    Times @@ (Length /@ IL) ≤ 
                      2^10 , 
FC[$ModuleNumber, 
                    1, {}], 
Union @@ (FAC[$ModuleNumber, #, {}] & /@ 
                        Table[i, {i, 1, V[g]}])]
]];

RedInq = 
            Function[inq, 
              Block[{in, i, 
                  l}, 

 (*Removes redundant Inequalities of a system (given as List or linked with And)*) 
 (*In this context it gives clearer results as the built in command Reduce*) 

in = 
                  List @@ inq; 
i = 
                  1; 
l = 
                  Length[in]; 
While[
                  i ≤ l, 
in = 
                    Complement[
                      in, {(List @@ 
                              inq)[[i]]}]; 
If[
                    FindInstance[(And @@ in) ∧ 
                          Not[(List @@ inq)[[i]]], {x, 
                          y}] ≠ {}, 
in = 
                      Append[in, (List @@ 
                              inq)[[i]]]]; 
i++]; 
Head[inq] @@ in
]];

NormCyc = 
            Function[cy, 
              Block[{b, l, Li, 
                  v}, 

  

b = 
                  Max[Abs /@ cy]; 
l = 
                  Length[cy]; 
v = 
                  Table[b^(-i), {i, 0, 
                      l - 1}]; 
Li = 
                  Table[RotateLeft[cy, i], {i, 0, 
                      l - 1}]; 
Sort[
                    Li, #1 . v < #2 . v &][[1]]]];

CheckSeq = 
            Function[Seq, 
              Block[{UGS, 
                  l}, 

  

l = 
                  Length[Seq]; 
UGS = (x < 
                        1) ∧ (And @@ 
                        Table[1 > 
                            x*Seq[[i, 1]] + y*Seq[[i, 2]] + 
                              Seq[[i + 1, 2]] ≥ 0, {i, 1, 
                            l - 1}]); 
FindInstance[
                    UGS, {x, y}] ≠ {}]];

CheckCyc = 
            Function[Cy, 
              Block[{UGS, 
                  l}, 

 (*Returns TRUE if the given List of Integers induces a nonempty cutout and not of the shape {a, -a}*) 

l = 
                  Length[Cy]; 
UGS = (x < 
                        1) ∧ (And @@ 
                        Table[1 > 
                            x*Cy[[i + 1]] + 
                              y*Cy[[Mod[i + 1, l] + 1]] + 
                              Cy[[Mod[i + 2, l] + 1]] ≥ 
                            0, {i, 0, 
                            l - 1}]); 
(Cy == {} ∨ (FindInstance[UGS, {x, 
                              y}] ≠ {})) ∧ ! ((Length[Cy] == 
                            2)  ∧  (Cy[[1]] == -Cy[[2]]))]];

Ak1=Function[i,Module[{k1, k2, r, g, cc, rt},

(*Searches for all periods within Rgi\Rgi-1 *)

rt = (Select[
                                  Re /@ (t /. 
                                        Solve[
                                        t^3 + t^2 - t - 1 + 1/# == 0, 
                                        t]) , Positive][[1]] // 
                              N) &;
k1 = 
                        IntegerPart[10^6*rt[i - 1]]/10^6;
k2 = (IntegerPart[
                                10^6*rt[i]] + 1)/10^6;
r = {k2*y - 
                                k2^2 ≥ x ≥  
                              k1*y - k1^2 ∧ y ≤ x + 1};
S = Akq[i, rt[i]];
Print["Ak,q: ",Length[S]," Elements"];
S = SetAkq[r, S];
g = BuildGraph[S];
Print["Graph has ", 
                        V[g], " vertices and  ", M[g], " edges"];
cc = InduceSubgraph[
                              g, #] & /@ (Select[
                              StronglyConnectedComponents[g], 
                              Length[#] ≥ 2 &]);
Union @@ (FindAllCycles /@ 
                            cc)]];

Ak2=Function[i,Module[{k1, k2, r, g, cc, rt},

(*Searches for all periods within the set Ei={(x, y) ∈ R | x≥ ygi-1-(((gi-1))^2), x≥ ygi-(((gi))^2)} *)

rt = (Select[
                                  Re /@ (t /. 
                                        Solve[
                                        t^3 + t^2 - t - 1 + 1/# == 0, 
                                        t]) , Positive][[1]] // 
                              N) &;
k1 = 
                        IntegerPart[10^6*rt[i - 1]]/10^6;
k2 = (IntegerPart[
                                10^6*rt[i]] + 1)/10^6;
r = {x ≥ 
                              k2*y - k2^2 ∧  
                            x ≥  k1*y - k1^2 ∧ 
                            2*x ≤ (k1 + k2)*y - 2*k1*k2};
S = Akq[i, rt[i]];
Print["Ak,q: ",Length[S]," Elements"];
S = SetAkq[r, S];
g = BuildGraph[S];
Print["Graph has ", 
                        V[g], " vertices and  ", M[g], " edges"];
cc = InduceSubgraph[
                              g, #] & /@ (Select[
                              StronglyConnectedComponents[g], 
                              Length[#] ≥ 2 &]);
Union @@ (FindAllCycles /@ 
                            cc)]];