4

I encountered a function $f(z)$ with several zeros in a region $1<\Re(z)<2, 3<\Im(z)<4$. These zeros are visible in a three dimensional plot like

  Plot3D[-Log[Abs[f[x+ I y]]],{x,1,2},{y,3,4}]

Is there any method in Mathematica 7.0 or 9.0 that can find these numerical zeros automatically and completely?

EDIT: A test function is:

f[t_] := Exp[-2Pi Cosh[2t]] (2 + Cosh[2t]) (1/2 - Cosh[t])

Another test function is:

g[t_] := Exp[-2Pi Cosh[2t]] (Pi - 2 Cosh[Pi t] + Sqrt[2] Cosh[2t] - Cosh[Pi t] Cosh[2t])
J. M.'s missing motivation
  • 124,525
  • 11
  • 401
  • 574
mike
  • 303
  • 1
  • 6
  • 1
    Try: FindInstance[-Log[Abs[f[x+I y]]]==0&&1<x<2&&3<y<4&&Element[x,Reals]&&Element[y,Reals],{x,y},Complexes,100] – Tyilo Oct 23 '14 at 15:06
  • 1
    It depends on the function f. Since you haven't provided it, your question cannot be reasonably answered, nevertheless if Reduce[ f[z]==0&&1<Re[z]<2&&3<Im[z]<4,z] cannot answer this question there one should use appropriately the FindRoot function, see e.g. this answer First positive root although Method -> "Brent" works for real valued functions. – Artes Oct 23 '14 at 15:31
  • @Tyilo. Your method of "FindInstant" worked fine for the test function I just added in the OP. But it did not work if I replace $f(z)$ by $g(z)=f(z)//N$. It seemed to me that it can only solve the symbolic equations exactly. The actual function I have does not have exact solutions. So I can only solve it nemerically. Thanks- – mike Oct 24 '14 at 03:47
  • Let f[t_] = Exp[-2PiCosh[2*t]](2 + Cosh[2t])(1/2 - Cosh[t]), then Reduce[f[t] == 0, t] gives Element[C[1], Integers] && (t == -((IPi)/3) + 2IPiC[1] || t == (IPi)/3 + 2IPiC[1] || t == (1/2)(-ArcCosh[-2] + 2IPiC[1]) || t == (1/2)(ArcCosh[-2] + 2IPi*C[1])). I haven't checked if there are more roots than these. – Dr. Wolfgang Hintze Oct 24 '14 at 09:39
  • @Dr.WolfgangHintze. Thanks for the suggestions. Your method worked for f[t] in the example. I think that the most probable reason is that f[z] can be factored. If g[t_] := Exp[-2Pi Cosh[2t]]*([Pi] - 2 Cosh[[Pi] t] + Sqrt[2] Cosh[2 t] - Cosh[[Pi] t] Cosh[2 t]), then "Reduce[g[t]==0,t]" command does not seems to work for me. Neither do "Reduce[N[g[t]]==0,t]". – mike Oct 25 '14 at 01:39
  • This looks like a good time to use FindAllCrossings2D[]: FindAllCrossings2D[{Re[f[x + I y]] == 0, Im[f[x + I y]] == 0}, {x, 1, 2}, {y, 3, 4}] – J. M.'s missing motivation May 15 '15 at 23:52

2 Answers2

3

If you can make the function look explicitly real e.g. using ComplexExpand, then Reduce might be able to do what you have in mind. Here is a simple example.

f[x_] := x^2 - 3 x + 14
Reduce[-Log[ComplexExpand[Abs[f[x + I y]]]] == 0 && 
  1 <= x <= 2 && 3 <= y <= 4, {x, y}]

(* Out[143]= (x == 1/94 (141 - 2 Sqrt[47]) && 
   y == Root[
     195 - 84 x + 37 x^2 - 6 x^3 + 
       x^4 + (-19 - 6 x + 2 x^2) #1^2 + #1^4 &, 3]) || (1/
     94 (141 - 2 Sqrt[47]) < x < 
    1/94 (141 + 2 Sqrt[47]) && (y == 
      Root[195 - 84 x + 37 x^2 - 6 x^3 + 
         x^4 + (-19 - 6 x + 2 x^2) #1^2 + #1^4 &, 3] || 
     y == Root[
       195 - 84 x + 37 x^2 - 6 x^3 + 
         x^4 + (-19 - 6 x + 2 x^2) #1^2 + #1^4 &, 4])) || (x == 
    1/94 (141 + 2 Sqrt[47]) && 
   y == Root[
     195 - 84 x + 37 x^2 - 6 x^3 + 
       x^4 + (-19 - 6 x + 2 x^2) #1^2 + #1^4 &, 3]) *)
Daniel Lichtblau
  • 58,970
  • 2
  • 101
  • 199
  • The functions are: – mike Oct 24 '14 at 02:06
  • I added a test function in OP. Your method does not seem to work. If it worked for you, please replace $f(z)$ by $g(z)=f(z)//N$ and try to solve $g(z)$. Thanks- – mike Oct 24 '14 at 03:51
2

Treating the problem purely numerically, one thing you can do is trace out lines in the complex plane, then use standard 1D root finding techniques:

For your example this simple approach works just fine seaching on lines of constant x:

 f[z_] := -N@Log[Abs[Exp[-2 Pi Cosh[2 z]] (2 + Cosh[2 z]) (1/2 - Cosh[2 z])]]
 zero[x_?NumericQ] := y /. First@FindRoot[ f[x + I y ], {y, 2, 3}]
 locus = First@Cases[ Plot[ zero[x], {x, 1, 2}] , Line[x_] :> x , Infinity];
 Show[{
  Plot3D[f[x + I y], {x, 1, 2}, {y, 2, 3}, PlotRange -> {-120, 160}],
  Graphics3D[{Thick, Red, Line[Append[#, 0] & /@ locus], 
    Green, Polygon[ { {1,2,0} , {2,2,0} , {2,3,0}, {1,3,0}}]}]}]

enter image description here

This obviously depends not only on the function being smooth, but on the chance of your choice of search curves hitting your roots. I suspect the fully general problem is intractable.

Incidentally, for this example FindRoot can directly find one point:

 FindRoot[ { f[x + I y ], 0}, {x, 1, 2}, {y, 2, 3}]

{x -> 0.171946, y -> 2.37038}

(note we have to trick it into thinking there are two equations.. )

george2079
  • 38,913
  • 1
  • 43
  • 110