0
$\begingroup$

Stydying the modulus of continuity of $\sqrt x \log(x)$ in version 13.1 on Windows 10, I execute

g[\[Delta]_?NumericQ]:=NMaximize[{RealAbs[Sqrt[x]*Log[x]-Sqrt[y]*Log[y]],RealAbs[x-y]<\[Delta]&&x>0&&y>0},{x,y}]

which works relatively well, for example,

g[0.000001][[1]]

1.09893*10^-6

and a warning

NMaximize::incst: NMaximize was unable to generate any initial points satisfying the inequality constraints {-0.00001+RealAbs[x-y]<=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

However, the plot

Plot[g[t][[1]], {t, 0, 1}, WorkingPrecision -> 50,  PlotPoints -> 40]

enter image description here

is simply incorrect (The modulus under consideration is asymptotically equivalent to $\delta$ as $\delta \to 0$ from above.) and of low quality. Also a warning

NMaximize::incst: NMaximize was unable to generate any initial points satisfying the inequality constraints {-0.0000256667+RealAbs[x-y]<=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

is produced. What is the reason and how to fix it?

Edit. A typo: $\sqrt x \log (x)$ instead of $x\log (x)$.

PS. My claim "The modulus under consideration is asymptotically equivalent to $\delta$ as $\delta \to 0$ from above" is not correct. It should be "The modulus under consideration is asymptotically equivalent to $-\sqrt \delta \log (\delta)$ as $\delta \to 0$ from above" instead of. In view of it this is rather a problem of NMaximize.

$\endgroup$
8
  • 1
    $\begingroup$ Well, this may seem obvious, but have you tried "Changing the initial region or specifying explicit initial points", since that is explicitly the suggestion given in the warning? Does that make it any better? $\endgroup$
    – MarcoB
    Nov 29, 2022 at 13:47
  • $\begingroup$ @MarcoB: Thank you for your interest to the question. Can you kindly explain how " to change the initial region or specifying explicit initial points"? TIA. As I understand it, NMaximize does not take into account x>0&&y>0. $\endgroup$
    – user64494
    Nov 29, 2022 at 14:57
  • $\begingroup$ Seems related : mathematica.stackexchange.com/questions/65608/…. $\endgroup$ Nov 29, 2022 at 14:59
  • $\begingroup$ @userrandrand: Thank you, but I don't think so. The problem under consideration consists in that NMaximize produces the correct answer despite a warning, but Plot doesn't. $\endgroup$
    – user64494
    Nov 29, 2022 at 15:05
  • $\begingroup$ Not sure what the problem is exactly but NMinimize needs help with the initial choices and you can maybe use the undocumented method by Acus in that link to provide those points. $\endgroup$ Nov 29, 2022 at 15:18

2 Answers 2

5
$\begingroup$
$Version

(* "13.1.0 for Mac OS X x86 (64-bit) (June 16, 2022)" *)

Clear["Global`*"]

g[δ_?NumericQ] := 
 NMaximize[{RealAbs[Sqrt[x]*Log[x] - Sqrt[y]*Log[y]], 
   RealAbs[x - y] < δ && x > 0 && y > 0}, {x, y}]

This definition of g uses machine precision irrespective of the precision of the input.

g[1.0`20*^-6] // Quiet

(* {1.09893*10^-6, {x -> 0.881505, y -> 0.881504}} *)

% // Precision

(* MachinePrecision *)

To maintain the precision of the input, change the definition

g[δ_?NumericQ] := 
 NMaximize[{RealAbs[Sqrt[x]*Log[x] - Sqrt[y]*Log[y]], 
   RealAbs[x - y] < δ && x > 0 && y > 0}, {x, y},
  WorkingPrecision -> Precision[δ]]

g[1.0`20*^-6] // Quiet

(* {0.55920273531026729167, {x -> 4.1794203324282570736*10^-7, 
  y -> 0.022426933542128677995}} *)

% // Precision

(* 20. *)

Note that these results are radically different from the first result.

The results are generally unstable; however, the following instance works.

Plot[g[t][[1]], {t, 0, 1},
  WorkingPrecision -> 40,
  PlotPoints -> 40,
  MaxRecursion -> 5] // Quiet

enter image description here

$\endgroup$
3
  • $\begingroup$ I am out of MMA so I'll respond later. Now try $x=0.01^3$ and $y,=0.01$. $\endgroup$
    – user64494
    Nov 30, 2022 at 6:34
  • $\begingroup$ Thank you for your attempt to answer the question (Especially Queits are impressive.). Unfortunately, you haven't seen the heart of the problem. Thank you anyway. $\endgroup$
    – user64494
    Nov 30, 2022 at 21:40
  • $\begingroup$ Here is another answer of you of such sort which also does not make a good impression. $\endgroup$
    – user64494
    Dec 1, 2022 at 3:37
-1
$\begingroup$

As I understand now, the problem is caused by NMaximize which finds for small $\delta$s the local maximum $\approx \delta$ with $x$ and $y$ near $1$, but not the true supremum $\approx -\sqrt \delta \log (\delta)$ with $x$ near $0$ and $y$ near $\delta$ (or vice versa). This is solved by indicating initial points. We also redefine the function $\sqrt x \log(x)$ at $x=0$ as $0$ , i.e. its limit from above.

g[\[Delta]_?NumericQ] :=  NMaximize[{RealAbs[ Piecewise[{{Sqrt[x]*Log[x], x > 0}, 
{0, x == 0}}] -  Piecewise[{{Sqrt[y]*Log[y], y > 0}, {0, y == 0}}]], 
RealAbs[x - y] < \[Delta] && x > 0 && y > 0}, {x, y}, 
Method -> {"RandomSearch",  "InitialPoints" -> {{\[Delta]/2, \[Delta]}, {0.9,  0.9 - \[Delta]/2}}}]

and (On my comp its execution takes about an hour.)

Plot[g[t][[1]], {t, 0, 1}, WorkingPrecision -> 20, PlotPoints -> 40, PlotRange -> All]

enter image description here

$\endgroup$
2

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.