As far as I understand, the merit function measures how far the data is from the fitted function.
I am calulcating the second partial derivative of a function, and then numerically finding its maxima and minima with FindRoot.
It always outputs an error message along the lines of:
FindRoot::lstol: The line search decreased the step size to within tolerance specified by AccuracyGoal and PrecisionGoal but was unable to find a sufficient decrease in the merit function. You may need more than 30.` digits of working precision to meet these tolerances.
Which makes me think: can I just change the settings of the merit function? I.e., lower the threshold for what is considered a sufficient change? And by the way, what is the default setting?
CODE:
k = 2 π;
k1 = {k, 0};
k2 = FullSimplify[RotationMatrix[(2 π)/5]. k1];
k3 = FullSimplify[RotationMatrix[(2 π)/5]. k2];
k4 = FullSimplify[RotationMatrix[(2 π)/5] .k3];
k5 = FullSimplify[RotationMatrix[(2 π)/5] .k4];
E1[x_, y_, I1_, α1_] := Sqrt[I1] Exp[I k1.{x, y} - α1]
E2[x_, y_, I1_, α1_] := Sqrt[I1] Exp[I k2.{x, y} - α1]
E3[x_, y_, I1_, α1_] := Sqrt[I1] Exp[I k3.{x, y} - α1]
E4[x_, y_, I1_, α1_] := Sqrt[I1] Exp[I k4.{x, y} - α1]
E5[x_, y_, I1_, α1_] := Sqrt[I1] Exp[I k5.{x, y} - α1]
Eges[x_, y_] :=
E1[x, y, 1, 0] + E2[x, y, 1, 0] + E3[x, y, 1, 0] + E4[x, y, 1, 0] +
E5[x, y, 1, 0]
IIges[x_, y_] :=
Conjugate[Eges[x, y]] Eges[x, y] // ComplexExpand //
Simplify; (* can't differentiate Conjugate, had to change this *)
{dx[x_, y_], dy[x_, y_]} =
D[IIges[x, y], {{x, y}}]; (* calculating partial derivatives *)
hes[x_, y_] =
D[IIges[x, y], {{x, y},
2}]; (* Hessian matrix: Second derivative matrix *)
(* Find critical points *)
crit = Cases[
Normal[ContourPlot[dx[x, y] == 0, {x, -xm, xm}, {y, -xm, xm},
ContourStyle -> None, Mesh -> {{0}},
MeshFunctions -> Function[{x, y, z}, dy[x, y]]]],
Point[{x0_, y0_}] :> ({\[FormalX], \[FormalY]} /.
FindRoot[{dx[\[FormalX], \[FormalY]],
dy[\[FormalX], \[FormalY]]}, {{\[FormalX], x0}, {\[FormalY],
y0}}, WorkingPrecision -> 30, AccuracyGoal -> 20,
PrecisionGoal -> 20, MaxIterations -> 1000]), ∞];
(* Identify points as minima, maxima or saddle points *)
hl = hes @@@ crit;
mnp = PositiveDefiniteMatrixQ /@ hl; (*pick minima*)
mxp = PositiveDefiniteMatrixQ /@ (-hl); (*pick maxima*)
sdp = Thread[mnp ⊽ mxp];(*saddle points are leftovers*)
(* Finding coordinates of critical points *)
mini = Pick[crit, mnp];
maxi = Pick[crit, mxp];
sadl = Pick[crit, sdp];
(* Plot stuff!
I changed the Image Size because it was too small *)
{Legended[
ContourPlot[IIges[x, y], {x, -xm, xm}, {y, -xm, xm},
ImageSize -> Scaled[0.3], ColorFunction -> "DarkTerrain",
Contours -> 15,
Epilog -> {AbsolutePointSize[6], {Cyan, Point[mini]}, {Orange, Point[maxi]}}],
PointLegend[{Cyan, Orange}, {"Minima", "Maxima"}]],
Show[Plot3D[IIges[x, y], {x, -xm, xm}, {y, -xm, xm},
BoundaryStyle -> None, Boxed -> False,
ColorFunction -> "DarkTerrain", Mesh -> 15,
MeshFunctions -> {#3 &}],
Graphics3D[{{Cyan, Sphere[mini, 1/20]}, {Orange,
Sphere[maxi, 1/20]}} /. {x_?NumericQ, y_?NumericQ} :> {x, y, IIges[x, y]}],
ImageSize -> Scaled[0.43], PlotRange -> All, Frame -> False]}
Conjugate[Eges[x, y]] == Eges[-x, -y]
? $\endgroup$