2
$\begingroup$

I want to maximize

$${T(\epsilon)=\max\left\{\log_{(1/y)}\left(|\sqrt{2}-x/y|\right):x,y\in\mathbb{N}, |\sqrt{2}-x/y|<\epsilon\right\}}$$

Edit: I changed the inequality, it was supposed to be greater than

Edit 2: Perhaps it should be less than

When I used my code I tried (for $\epsilon=.0001$)

NMaximize[{x, y} \[Element] Integers && Log[1/y, Sqrt[2] - x/y] && 
  RealAbs[Sqrt[2] - x/y]<= .0001, {x, y}]

But instead I get:

NMaximize::nnum: The function value -False is not a number at {x,y} = {0.918621,0.716689}.

NMaximize::nnum: The function value -False is not a number at {x,y} = {0.918621,0.716689}.

NMaximize::nnum: The function value -False is not a number at {x,y} = {0.918621,0.716689}.

How do we fix this and create $T(\epsilon)$ in my code.

$\endgroup$
2
  • $\begingroup$ Are you sure about changing the inequality to be ">" ? That removes a very small fraction of all possible pairs of values. $\endgroup$
    – JimB
    Feb 12, 2022 at 22:40
  • $\begingroup$ @JimB You’re probably right. I did you the less than sign in a previous edit. Do you know why no one is answering? How difficult is this question? $\endgroup$
    – Arbuja
    Feb 12, 2022 at 22:44

3 Answers 3

4
$\begingroup$

The syntax of NMaximize that you intended to try should be NMaximize[{f, constraints}, {x, y}]. But unfortunately

NMaximize[{
  Log[1 / y, Abs[Sqrt[2] - x / y]],
  Element[{x, y}, Integers] && x >= 1 && y >= 2 && Abs[Sqrt[2] - x / y] < 0.0001
}, {x, y}]

gives a warning like

NMaximize::incst: NMaximize was unable to generate any initial points satisfying the inequality constraints ...

and you would get an answer that does not satisfy the given constraints.

As an alternative option: my guess is that $y$ should be small as possible to maximize your expression (I hope this is correct or at least works as an approximation). For this purpose, you can use Rationalize. The following function returns a triplet $\{T(\epsilon),x,y\}$ for a given $\epsilon$.

t[eps_] := Module[{r, x, y},
  r = Rationalize[Sqrt[2], eps];
  x = Numerator[r];
  y = Denominator[r];
  {Log[1/y, Abs[Sqrt[2] - x/y]], {x, y}}
];

Example:

Table[{10^-n, t[10^-n]}, {n, 1, 10}] // N

enter image description here

$\endgroup$
2
  • 1
    $\begingroup$ Because 1 cannot be a base of logarithm, it must be y>1 in the above. $\endgroup$
    – user64494
    Feb 13, 2022 at 7:57
  • $\begingroup$ @user64494 Thank you for pointing it out! I changed it to y >= 2 (and Mathematica gave me a wrong result). $\endgroup$
    – tueda
    Feb 14, 2022 at 1:30
3
$\begingroup$

Since the feasible discrete set RealAbs[Sqrt[2] - x / y] < 0.0001 is infinite, this is a hard task for NMaximize. It can be done as follows. First, we find the maximum for x >= 1000 && y >= 1000 by

NMaximize[{Log[1/y, RealAbs[Sqrt[2] - x/y]], 
Element[{x, y}, Integers] && x >= 1000 && y >= 1000 && 
RealAbs[Sqrt[2] - x/y] < 0.0001}, {x, y},Method->{"DifferentialEvolution", "ScalingFactor" ->3}]

which produces {1.51158, {x -> 1649, y -> 1166}} and a warning

NMaximize::incst: NMaximize was unable to generate any initial points satisfying the inequality constraints {-0.0001+RealAbs[Sqrt[2]-Round[x]/Round[<<1>>]]<=0}. The initial region specified may not contain any feasible points. Changing the initial region or specifying explicit initial points may provide a better solution.

The above result is a feasible solution in view of

N[RealAbs[Sqrt[2] - x/y] /. { x -> 1649, y -> 1166}]

0.0000231443

Second, in order to be sure, we apply the known lower estimate for RealAbs[Sqrt[2] - x/y] (see the "Liouville numbers and transcendence" section in that Wiki article for info) $$\exists A>0\, \forall\{x,y\}\in\mathbb{N} \left| \sqrt{2}-\frac{x}{y}\right|> \frac A {y^2} $$. According to Lemma from this section, we may take $A=\frac 1 {5}$ ($M=5$). This inequality implies the inequality ForAll[{x,y},{x,y} \[Element] PositiveIntegers && y>1, Log[1/y, RealAbs[Sqrt[2] - x/y]] < Log[1/y, 1/5] + 2]. It is clear the maximum of Log[1/y, 1/5] + 2] for all integers y >=1000 is attained at y==1000 and is equal to N[Log[1/1000, 1/5]]==0.23299.

Third, now we apply counting for x>=1&&x<=999&&y>=2&&y<=999

Do[If[RealAbs[Sqrt[2] - x/y] < 0.0001, Print[{x, y, N[Log[1/y, RealAbs[Sqrt[2] - x/y]]]}]],
 {x, 1, 999}, {y, 2, 999}]

{99,70,2.24473} {140,99,2.07542}... {997, 705, 1.59229}

Summarizing the above, we draw the conclusion that the maximum under consideration is equal to 2.224473 at {x==99,y==70}.

Edit. 1000 in the above instead of 100 and constant $A= \frac 1 5$ instead of $A=\frac 1 3$.

$\endgroup$
1
  • $\begingroup$ It should be 2.24473 instead of 2.224473 in the last but one line of my answer. Sorry for the typo. $\endgroup$
    – user64494
    Feb 13, 2022 at 14:22
1
$\begingroup$

This is just an extended comment. Many times constructing a figure helps one focus on a solution. Below the gray dots are the values of Log[1/y, Abs[Sqrt[2] - x/y]], the green dots are the values where Abs[Sqrt[2] - x/y] <= 0.0001, and the red dot is where the maximum for x>=1&&x<=300&&y>=2&&y<=300 occurs.

ϵ = 1/10000;
t = Flatten[Table[{x, y, Log[1/y, Abs[Sqrt[2] - x/y]]}, {x, 1, 300}, {y, 2,  300}], 1];

t0 = Select[t, Abs[Sqrt[2] - #[[1]]/#[[2]]] < ϵ &];
(* {{99, 70, -(Log[99/70 - Sqrt[2]]/Log[70])}, 
    {140, 99, -(Log[-(140/99) + Sqrt[2]]/Log[99])}, 
    {198, 140, -(Log[99/70 - Sqrt[2]]/Log[140])},
    {239, 169, -(Log[-(239/169) + Sqrt[2]]/Log[169])},
    {280, 198, -(Log[-(140/99) + Sqrt[2]]/Log[198])},
    {297, 210, -(Log[99/70 - Sqrt[2]]/Log[210])}} *)

tmax = Select[t0, #[[3]] == Max[t0[[All, 3]]] &]
(* {99, 70, -(Log[99/70 - Sqrt[2]]/Log[70])} *)

ListPointPlot3D[{t, t0, tmax}, SphericalRegion -> True, BoxRatios -> {1, 1, 1},
  RotationAction -> "Clip", ImageSize -> Large, PlotRange -> All, 
  PlotStyle -> {{Gray, PointSize[0.001]}, {Green, PointSize[0.01]}, {Red, PointSize[0.015]}}]

3D plot of candidate points satisfying constraints

$\endgroup$
2
  • $\begingroup$ To be exact, you should write "where the maximum for x>=1&&x<=300&&y>=2&&y<=300 occurs" instead of "where the maximum occurs". Let us call things by their proper names. $\endgroup$
    – user64494
    Feb 13, 2022 at 17:59
  • $\begingroup$ @user64494 Changed. I appreciate the comment. $\endgroup$
    – JimB
    Feb 13, 2022 at 18:37

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.