# Finding a critical point

I hope you can help me find the "critical points" I'm looking for. For some context: I'm trying to find a critical point in my equations defined as:

equation1 = Pi (L - 3)/2 == (L - 2) ArcTan[2 x] + 2 ArcTan[2 (x - alpha)]
equation2 = (d / (1 - d))^2 == ((d^2 + x^2) / ((1 - d)^2 + x^2))^(L-2) * ((d^2 + (x - alpha)^2) / ((1 - d)^2 + (x - alpha)^2))^2


and:

solL[x_] := L /. Solve[equation1, {L}][[1]];
solD[x_] := d /. NSolve[equation2 /. L -> solL[x], {d}, Reals][[1]]


alpha is just a constant I fix every case I try to solve.

Due to the symmetries in the equations, only if alpha={0, L/2, L/4, L} it is possible to solve this problem analytically. However, I want to be able to find a solution for any fixed alpha, so non-analytically. If I plot solD[x] it looks like:

Fixing another value for alpha shifts the critical point over the horizontal axis. Now, I am trying to find the critical point x (see the red arrow), where my value "hits the ceiling". Anyone an idea how to do this?

Thanks a million!

• Hi, welcome to Mathematica.SE, please take the tour. Here its considered helpful and polite show your own efforts and share your data and code attempts in a well formatted form, so we can quickly see the problem you are facing. Please help us to help you and edit your question accordingly and include the definitions for differentialEquation. Can you please confirm that you mean NSolve and not NDSolve? – rhermans Jun 22 '18 at 12:55
• Hi rhermans, I tried to look up questions in here on stackexchange about finding these kinds of critical points. However so far, I have not found a question/answer that matches my question. I am out of ideas myself on how to do this, so I hope one of the stackexchange smart people can help me out. Thanks! – White Jun 22 '18 at 13:06
• We will be happy to help, and point to other answers if available. But first, we need your help to understand your problem. This question will be easier to answer and more useful for others if you add a minimal working example of working code and data to show specifically what you are working with. Please edit your question to improve it. Include the definition of differentialEquation and please confirm that you mean NSolve and not NDSolve. – rhermans Jun 22 '18 at 13:09
• Very difficult to suggest anything in the absence of a concrete example (as already noted by @rhermans). My guess is a WhenEvent, triggered by a large magnitude of a derivative, will be useful for locating such points. A sufficiently large derivative is basically an approximation to a discontinuity. – Daniel Lichtblau Jun 22 '18 at 13:33
• differentialEquation and differentialEquation2 are not differential equations, are they? – xzczd Jun 22 '18 at 13:43

What you call critical point, is where two solutions of the equation yield both the value 1/2.

Let me write the equations as funtions to be zero.

f1 = Pi (L - 3)/2 - ((L - 2) ArcTan[2 x] + 2 ArcTan[2 (x - alpha)]) //Simplify;

sol1 = First@Solve[f1 == 0, L]

(*   {L -> (3 \[Pi] - 4 ArcTan[2 alpha - 2 x] - 4 ArcTan[2 x])/(\[Pi] -
2 ArcTan[2 x])}   *)

f2 = (d/(1 - d))^2 - (((d^2 + x^2)/((1 - d)^2 + x^2))^(L - 2)*
((d^2 + (x - alpha)^2)/((1 - d)^2 + (x - alpha)^2))^2) //
Simplify

f3 = f2 /. sol1 // Simplify


ContourPlot shows first, that you have the unique solution d==1/2 for all x and solutions, that drift to higher x for higher alpha, together with your "critical point", where two solutions intersect.

ContourPlot[
Evaluate[Thread[0 == f3 /. alpha -> {0, 2, 4}]], {x, 0, 5}, {d, 0,
2}, PlotPoints -> 50, ContourStyle -> {Red, Green, Blue}]


In order to look for the x value, where d gets 1/2 for varying alpha, I took a d near d==1/2, since at exactly d==1/2, f3 is zero.

f3 /. d -> 1/2 // FullSimplify[#, x > 0 && alpha > 0] &

(*   0   *)


ContourPlot with d near 1/2, shows how the two "critical points" vary with alpha.

ContourPlot[
Evaluate[0 == f3 /. d -> 1/2 - 10^-5], {alpha, 0, 5}, {x, 0, 10},
PlotPoints -> 50]


Due to lack of time, I leave you with that qualitative answer.

• This is great. This definitely helped me and I learned some new Mathematica skills... Thanks from the Mathematica-noob speaking here! – White Jun 25 '18 at 7:30