Finding and Plotting Minima

Question

Using the same concept discussed in Plotting minima of a mutivariable function, I am trying to plot the minimas for the function z[v_, t_] here.

This is what I am trying to do:

e = 1;
f = 1/2;
c = Sqrt[e^2+f];
d = Sqrt[e^2-f];
a[t_] := (1/2)*(I*c*Cot[c*t]- c^2/(e*(Sin[c*t])^2 - I*c*Cos[c*t]Sin[c*t]));
b[t_] := (1/2)*(I*d*Cot[d*t]- d^2/(e*(Sin[d*t])^2 - I*d*Cos[d*t]Sin[d*t]));
g[t_] := -(a[t]+b[t]);
h[t_] := a[t]-b[t];
u[t_] := -Re[a[t]+b[t]];
w[v_,t_] := u[t] + I*v;
x[v_,t_] := (1/2)*(g[t]+w[v,t]+Sqrt[(g[t]-w[v,t])^2 + 4h[t]^2]);
y[v_,t_] := (1/2)*(g[t]+w[v,t]-Sqrt[(g[t]-w[v,t])^2 + 4h[t]^2]);
z[v_,t_] := (1/2)**Sqrt[(Log[Abs[x[v,t]]])^2 +(ArcTan[Im[x[v,t]]]/Re[x[v,t]])^2 + (Log[Abs[y[v,t]]])^2 +(ArcTan[Im[y[v,t]]]/Re[y[v,t]])^2];

I tried plotting two ways.

First Method

reg = ParametricRegion[{{t, z[v, t]}, {D[z[v, t], v] == 0, 
     D[z[v, t], {v, 2}] >= 0, -10 <= t <= 10}}, {v, t}];
Region[Style[reg, Red], Axes -> True, AspectRatio -> 1]

Second Method

min = Minimize[{z[v,t], t == j}, {v, t}][[2]];
p = {t, z[v,t]} /. min
ParametricPlot[p, {j, -10, 10}, AspectRatio -> 1]

With the first method, I am not getting errors but the plot doesn't appear. With the 2nd method, I am facing errors like ReplaceAll:{min} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. and issues related cloud:timelimit of my basic plan.

What are causing the issues and how to fix them?

Answer 1

You can use ComplexExpand to get rid Abs and so forth, if z, v and t are real numbers:

(* hopefully this finishes on the OP's limited plan *)
newZ = ComplexExpand[Re@z[v, t], TargetFunctions -> {Re, Im}];

Plot3D[newZ, {v, -1, 1}, {t, -1, 1}]

The expanded function is over 2.5MB:

newZ // ByteCount

(* 2707144 *)

I think a symbolic solution of this problem on a limited plan is not feasible. The best you might do in this situation is to accept the implication of the plot that the minimum is 0 at v == 0, t == 0. Perhaps using that, you can prove it with pencil and paper.

You can improve the numerics of z[v,t] by changing a[t] and b[t] as follows:

a[t_] = (1/2)*(I*c*Cot[c*t] - 
       c^2/(e*(Sin[c*t])^2 - I*c*Cos[c*t] Sin[c*t])) /.
     {Sin[z_] :> z  Sinc[z], Cot[z_] :> Cos[z]/(z  Sinc[z])} // FullSimplify;
b[t_] = (1/2)*(I*d*Cot[d*t] - 
       d^2/(e*(Sin[d*t])^2 - I*d*Cos[d*t] Sin[d*t])) /.
     {Sin[z_] :> z  Sinc[z], Cot[z_] :> Cos[z]/(z  Sinc[z])} // FullSimplify;

It won't improve the symbolics (the new newZ, assuming you have reevaluated the first code above, is now over 5MB).

You can speed up evaluation by compiling:

zCF = Compile @@ {{v, t}, newZ}
zCFV = Compile @@ {{{v, _Real, 1}, {t, _Real, 1}}, newZ}

zCF[0.1, 0.0000001] (* evaluate on single values for v,t *)

(* 0.0498964 *)

(* evaluate on a vector of values for each of v of t *)
zCFV @@ Transpose@CirclePoints[{0.0001, 1.}, 10000] // MinMax

(* {0.0000353553, 0.00005} *)

zCF[0., 0.000000]

(* 0. *)

The last two show that the numerical min/max on a small circle (radius 0.0001) about the origin is positive, greater than the value 0. at the origin.

The trigonometric functions raise questions about the existence of other local minima. I will let others to explore the implications of the following plot:

Plot3D[zCF[v, t], {v, -5, 5}, {t, 0, 10}, MaxRecursion -> 4]