0
$\begingroup$

I am reading an interesting paper One of the numbers ζ(5), ζ(7), ζ(9), ζ(11) is irrational by Zudilin. We fix odd numbers $q$ and $r$, $q\geq r+4$ and a tuple $\eta_0,\eta_1,...,\eta_q$ of positive-integer tuple satisfying the constraints $\eta_1\leq \eta_2\leq...\leq \eta_q<\eta_0/2$ and $ 2(\eta_1+\eta_2+...+\eta_q)\leq \eta_0(q-r)$. We put $m_j=\max\{\eta_r,\eta_0-2\eta_{r+1},\eta_0-\eta_1-\eta_{r+j}\}$ for $j=1,2,...,q-r$ and define $$\varphi(x)=\min_{0\leq y<1}\left(\sum_{j=1}^{r}(\lfloor y\rfloor+\lfloor\eta_0x-y\rfloor-\lfloor y-\eta_j x\rfloor-\lfloor(\eta_0-\eta_j)x-y\rfloor-2\lfloor\eta_j x\rfloor)+\sum_{j=r+1}^{q}(\lfloor(\eta_0-2\eta_j)x\rfloor-\lfloor y-\eta_j x\rfloor-\lfloor(\eta_0-\eta_j)x-y\rfloor)\right)$$ where $\lfloor.\rfloor $ denotes the floor function.

We introduce the function $$f_0(\tau)=r\eta_0\log(\eta_0-\tau)+\sum_{j=1}^{q} (\eta_j\log(\tau-\eta_j)-(\eta_0-\eta_j)\log(\tau-\eta_0+\eta_j)) -2\sum_{j=1}^r \eta_j\log \eta_j+\sum_{j=r+1}^q (\eta_0-2\eta_j)\log(\eta_0-2\eta_j)$$ defined in the $\tau$-plane with the cuts $(-\infty,\eta_0-\eta_1]$ and $[\eta_0,+\infty)$.

Therefore the following holds:

Lemma $2$: Let $r=3$ and $\tau_0$ be a zero of the polynomial $$(\tau-\eta_0)^r(\tau-\eta_1)...(\tau-\eta_q)-\tau^r(\tau-\eta_0+\eta_1)...(\tau-\eta_0+\eta_q) $$ with $\text{Im}\ \tau_0>0$ and the maximum possible value of $\text{Re}\ \tau_0$.

Lemma $3$: Suppose that $r=3$ and in the above notation $C_0=-\text{Re} f_0(\tau_0)$, $$C_2=rm_1+m_2+...+m_{q-r}-\left(\int_0^1\varphi(x)\frac{\Gamma'(x)}{\Gamma(x)}dx-\int_0^{1/m_{q-r}}\varphi(x)\frac{dx}{x^2}\right)$$ If $C_0>C_2$, then at least of the numbers $$\zeta(5), \zeta(7), ...,\zeta(q-4), \text{and}\ \zeta(q-2)$$ is irrational. The line below Lemma $3$ reads: we put, $r=3,q=13$, $$\eta_0=91,\ \ \eta_1=\eta_2=\eta_3=27,\ \ \eta_j=25+j\ \ \text{for}\ \ j=4,5,...,13,$$ we obtain $\tau_0=87.47900541...+i\ 3.32820690...$ Then $$C_0=-\text{Re} f_0(\tau_0)=227.58019641...,C_2=226.24944266...$$

Question: I request Mathematica code to exhaustively search $$ \eta_{0}\le100,\ \eta_{1}\le\eta_{2}\le\cdots\le\eta_{13}<\frac{\eta_0}{2},\quad \sum_{j=1}^{13}\eta_{j}\le5\,\eta_{0} $$ for the first tuple satisfying $$ C_{0}>C_{2}, $$

Also in the answer, I need a code that runs from $b=100$, and then decreases to $b=1$.

Thank you.

Improve this question
$\endgroup$
4
  • $\begingroup$ High precision answer: math.stackexchange.com/questions/4884922/… $\endgroup$ Commented Aug 2 at 16:54
  • $\begingroup$ @MariuszIwaniuk Thanks. But my question is different. How using mathematica we get the choice $\eta=(91;27,27,27,29,30,31,32,33,34,35,36,37,38)$ or find a different $\eta$ so that $C_0>C_2$. $\endgroup$ Commented Aug 2 at 17:15
  • 1
    $\begingroup$ I believe finding the smallest (by total sum) list of $\eta$ values would be extremely difficult, but if we constrain ourselves to look for $\eta$ that look like $$\eta_0=a,\ \ \eta_1=\eta_2=\eta_3=b,\ \ \eta_j=c+j\ \ \text{for}\ \ j=4,5,...,13,$$ as in the paper, we can find $\{a,b,c\} = \{79,23,20\}$ works, and is smaller in terms of total sum than the $\eta$ values given in the paper. $\endgroup$ Commented Aug 5 at 16:19
  • $\begingroup$ @ydd Thank you so much. I request you to please write an answer for the code which you used to find $\{a,b,c\}=\{79,23,20\}$. I will with utmost respect accept your answer. Thank you again. $\endgroup$ Commented Aug 5 at 19:03

1 Answer 1

Reset to default
3
+50
$\begingroup$

This isn't a very elegant solution as it's just a brute-force search.

I use your code for calculating $C_0$ and just turned it into a function that takes a given list of $\eta$ values:

ClearAll["`*"]
q = 13;
r = 3;
getC0[etas_List, prec_ : $MachinePrecision] := 
 Module[{x, term1, term2, f, rootsAll, candRoots, sortedByReal, tau0, 
   f0},
  x =.;
  
  term1 = Times @@ (x - # & /@ etas);
  term1 = term1*(x - etas[[1]])^2;
  term2 = Times @@ ((x - etas[[1]] + #) & /@ Rest[etas]);
  term2 = term2*x^3;
  f = Expand[term1 - term2];
  rootsAll = x /. NSolve[f == 0, x, WorkingPrecision -> prec];
  candRoots = Select[rootsAll, Im[#] > 0 &];
  sortedByReal = SortBy[candRoots, Re];
  tau0 = Last[sortedByReal];
  f0[t_] := Module[{ret, term}, ret = r*etas[[1]]*Log[etas[[1]] - t];
    Do[term = 
      etas[[j]]*Log[t - etas[[j]]] - (etas[[1]] - etas[[j]])*
        Log[t - etas[[1]] + etas[[j]]];
     ret += term;, {j, 2, q + 1}];
    Do[term = 2*etas[[j]]*Log[etas[[j]]];
     ret -= term;, {j, 2, r + 1}];
    Do[term = (etas[[1]] - 2*etas[[j]])*Log[etas[[1]] - 2*etas[[j]]];
     ret += term;, {j, r + 2, q + 1}];
    ret];
  -N[Re[f0[tau0]], prec]
  ]

I then use my method from my previous answer to calculate $C_2$ in a relatively fast way (I say relatively because this is still the bottleneck of the code). We find the constant value intervals of $\phi(x)$ and now can do a dot product instead of an integral:

getC2[etalis_List, prec_ : $MachinePrecision] := 
 Module[{etasl, msl, phi1, yDecremementTerms, yDecremementCoeffs, 
   yIncrementTerms, yIncrementCoeffs, yTerms, yCoeffs, phi0, fastPhi, 
   uniqueEtas, subtractedEtas, kList, yDiscontinuities, 
   getConstantInterval, changePoints, intervals, phiVals, mBound, 
   lowerIntervals, lowerPhiVals, int1, int2, constTerm},
  etasl = Table[eta[i] -> etalis[[i + 1]], {i, 0, 13}];
  
  
  msl = Table[
    m[j] -> (Max[eta[r], eta[0] - 2 eta[r + 1], 
        eta[0] - eta[1] - eta[r + j]]) /. etasl, {j, 1, q - r}];
  
  
  phi1[x_, 
    y_] := (Sum[(Floor[y] + Floor[eta[0] x - y] - 
         Floor[y - eta[j] x] - Floor[(eta[0] - eta[j]) x - y] - 
         2 Floor[eta[j] x]) /. etasl, {j, 1, r}] + 
     Sum[(Floor[(eta[0] - 2 eta[j]) x] - Floor[y - eta[j] x] - 
         Floor[(eta[0] - eta[j]) x - y]) /. etasl, {j, r + 1, q}]);
  
  yDecremementTerms = Table[eta[j], {j, 0, q}] /. etasl;
  yDecremementCoeffs = -(1 + SparseArray[1 -> 2, q + 1]) // Normal;
  
  
  yIncrementTerms = Table[(eta[0] - eta[j]), {j, q}] /. etasl;
  yIncrementCoeffs = Length /@ Gather[yIncrementTerms];
  yIncrementTerms = DeleteDuplicates[yIncrementTerms];
  
  yTerms = Join[yIncrementTerms, yDecremementTerms];
  yCoeffs = Join[yIncrementCoeffs, yDecremementCoeffs];
  
  phi0[x_] = phi1[x, 0];
  fastPhi[x_] := Module[{ord},
    ord = FractionalPart[yTerms*x ] // Ordering;
    Min@Accumulate[yCoeffs[[ord]]] + phi0[x]
    ];
  
  uniqueEtas = uniqueEtas = etalis;
  subtractedEtas = Table[eta[0] - eta[j], {j, q}] /. etasl;
  kList = Union[uniqueEtas, subtractedEtas];
  
  yDiscontinuities[x_] := FractionalPart[kList*x];
  (*gets interval[x,x+ϵ) where phi is a constant value*)
  getConstantInterval[x_] := 
   Module[{p, ord, w, k, yOrdered, ϵCandidates, ϵ}, 
    p = yDiscontinuities[x];
    ord = Ordering[p];
    w = Min[(1 - p)/kList];
    k = kList[[ord]];
    p = p[[ord]];
    ϵCandidates = -Differences[p]/Differences[k];
    ϵCandidates = Select[ϵCandidates, 0 < # <= w &];
    ϵCandidates = Join[ϵCandidates, {w}];
    ϵ = Min[ϵCandidates];
    x + ϵ];
  (*get endpoints of constant phi intervals*)
  changePoints = NestWhileList[getConstantInterval, 0, # < 1 &];
  (*split into pairs*)
  intervals = Partition[changePoints, 2, 1];
  phiVals = fastPhi@*Mean /@ intervals;
  
  mBound = 1/m[q - r] /. msl;
  lowerIntervals = TakeWhile[intervals, #[[2]] <= mBound &];
  lowerPhiVals = Take[phiVals, Length@lowerIntervals][[2 ;; All]];
  lowerIntervals = lowerIntervals[[2 ;; All]];
  int2 = Flatten[Differences /@ (1/lowerIntervals)] . lowerPhiVals;
  int1 = 
   Flatten[(Differences /@ Map[PolyGamma, Rest@intervals, {2}])] . 
    Rest[phiVals];
  constTerm = r*m[1] + Sum[m[i], {i, 2, q - r}] /. msl;
  
  N[constTerm - (int2 + int1), prec]
  ]

Then define a test $C_0 > C_2$, with user-supplied precision. The default is $MachinePrecision:

test[etalis_List, prec_ : $MachinePrecision] := 
 getC0[etalis, prec] > getC2[etalis, prec]

We limit ourselves to look for a list of $\eta$ of the form:

$$\eta_0=a,\ \ \eta_1=\eta_2=\eta_3=b,\ \ \eta_j=c+j\ \ \text{for}\ \ j=4,5,...,13,$$

Since $\eta_4 ≥ \eta_3$, we have $c ≥ b -4$, and due to the constraints given in the paper $$ a ≥ \max\left( \frac{\sum_{i=1}^q \eta_i}{5}, 2(c+q)+1 \right) $$ I modify $c$ to be in terms of $b$, $c = b + k$:

$$\eta_0=a,\ \ \eta_1=\eta_2=\eta_3=b,\ \ \eta_j=(b + k) +j \ \ ,k ≥ -4, \ \ \text{for}\ \ j=4,5,...,13,$$

And now brute force.

etaTest = ConstantArray[0, q + 1];
AbsoluteTiming[
 Monitor[
  Do[
   (*\[Eta]1 = \[Eta]2 = \[Eta]3 = b*)
   etaTest[[2 ;; 4]] = b;
   (*\[Eta]j = (b+k) + j, k \[GreaterEqual] -4, j = 4,5,...,q*)
   etaTest[[5 ;; All]] = (b + k) + Range[4, q];
   
   (*initalize \[Eta]0 at its lower bound*)
   a = Ceiling@Max[2 etaTest[[-1]] + 1, Total[Rest@etaTest]/5];
   etaTest[[1]] = a;
   (* test if C0 > C2*)
   isGoodEtaList = test[etaTest];
   (*increment \[Eta]0 until we find one such that C0 > 
   C2 or we hit 100*)
   While[isGoodEtaList == False && etaTest[[1]] < 100,
    etaTest[[1]] += 1;
    isGoodEtaList = test[etaTest];
    ];
   (*stop once we find C0 > C2*)
   If[isGoodEtaList, Break[]];
   , {b, 100}, {k, -4, 4}
   ]
  , etaTest]
 ]

etaTest
(*{79, 23, 23, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33}*)
getC0[etaTest, 4]
(*202.*)
getC2[etaTest, 4]
(*201.1*)

This took about 50 minutes on my laptop.

Note I'm kind of cheating by setting an upper bound of 4 for $k$; if I wanted to search the full solution space I'd have increment $k$ until the lower bound of $\eta_0$ is 100 $$ \max\left( \frac{\sum_{i=1}^q \eta_i}{5}, 2(b+k+q)+1 \right) > 100 $$ Which would be a larger space and take longer.

Add-on To get all $\eta$ lists of our desired form such that $C_0 > C_2$, we can just increase the upper bound of $k$ to 100, and check if the lower bound for $\eta_0$ is less than 100 (this is a computationally cheap check compared to the other calculations we are doing). This took a little over an hour using ParallelDo:

etaTest = ConstantArray[0, q + 1];
AbsoluteTiming[
 ParallelEvaluate[pass = {}];
 ParallelDo[
  (*\[Eta]1 = \[Eta]2 = \[Eta]3 = b*)
  etaTest[[2 ;; 4]] = b;
  (*\[Eta]j = (b+k) + j, k \[GreaterEqual] -4, j = 4,5,...,q*)
  etaTest[[5 ;; All]] = (b + k) + Range[4, q];
  
  (*initalize \[Eta]0 at its lower bound*)
  eta0LowerBound = 
   Ceiling@Max[2 etaTest[[-1]] + 1, Total[Rest@etaTest]/5];
  etaTest[[1]] = eta0LowerBound;
  (*evaluate test if lower bound is < 100*)
  If[eta0LowerBound < 100,
   
   (* test if C0 > C2*)
   isGoodEtaList = test[etaTest];
   (*increment \[Eta]0 until we find one such that C0 > 
   C2 or we hit 100*)
   While[isGoodEtaList == False && etaTest[[1]] < 100,
    etaTest[[1]] += 1;
    isGoodEtaList = test[etaTest];
    ];
   (*if C0 > C2, store the \[Eta] list*)
   If[isGoodEtaList,
    AppendTo[pass, etaTest]
    ];
   ];
  , {b, 100}, {k, -4, 100}
  ];
 
 ]

And then looking at the $\eta$ lists that pass, we see the one we found before is the smallest by total, and we also see the $\eta$ list specified in the paper:

SortBy[Join @@ ParallelEvaluate[pass], Total]

{
{79, 23, 23, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33}, 
{81, 24, 24, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34}, 
{84, 24, 24, 24, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35}, 
{83, 25, 25, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35}, 
{86, 25, 25, 25, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36}, 
{86, 26, 26, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36}, 
{88, 26, 26, 26, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37}, 
{89, 27, 27, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37}, 
{91, 27, 27, 27, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38}, 
{92, 28, 28, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38}, 
{94, 28, 28, 28, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39}, 
{95, 29, 29, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39}, 
{97, 29, 29, 29, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40}, 
{98, 30, 30, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40}, 
{100, 30, 30, 30, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41}
}
Improve this answer
$\endgroup$
13
  • $\begingroup$ $(+1)$. Thank you so much for such a nice answer. I can see that we are setting an upper bound of $k$ as $4$. I request you to kindly give a code which does not require the upper bound of $k$ as $4$. I am sorry, I am not very good at coding and please excuse me if I am asking something trivial.Thank you so much. $\endgroup$ Commented Aug 8 at 6:09
  • $\begingroup$ Thank you for the edit. Which version of Mathematica did you use? Was it on wolfram cloud or on laptop? Thanks again. $\endgroup$ Commented Aug 11 at 7:47
  • $\begingroup$ This was on my laptop with $Version 14.3.0 for Mac OS X ARM (64-bit) $\endgroup$ Commented Aug 11 at 13:05
  • $\begingroup$ Thanks a lot. I am not so good at coding. I request you to please write the mathematical implication of the code you wrote. Thank you so much. $\endgroup$ Commented Aug 12 at 6:06
  • $\begingroup$ There really isn't much going on in the code so I'm not sure what you would want me to write; it really is just a brute force search of all $\eta$ lists of the form $ \eta_0 = a, \eta_1=\eta_2=\eta_3 = b, \eta_i = (b+k+j), j = 4,...,q$. You can derive some constraints on $b$ and $k$ due to the prescribed constraints on $\eta_0$, but I'm not sure what else I could say about this code that could be helpful. $\endgroup$ Commented Aug 12 at 15:33

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.