1
$\begingroup$

This very simple code ran perfectly two days ago, and now it is failing, for no reason that I can see.

It is simply running indefinitely, and when I abort it, it continues running until I abort it a second time.

This is an incredibly frustrating issue. I'm expecting it to take a while, but a few days ago, the code was giving non-fatal error which at least hinted that things were moving. The result was produced after about 5-10 minutes. Now it's just stuck completely. 

M = I; tau = 1/3 + (3/2)*I; w1 = Pi/2; w2 = Pi*tau/2; inv = WeierstrassInvariants[{w1, w2}]; E2[t_] = 1 - 24*Sum[(n*Exp[2*Pi*I*(t)*n])/(1 - Exp[2*Pi*I*(t)*n]), {n, 1, 300}]; z[u_] = (I*M/2)*(WeierstrassZeta[u, inv] - ((1/3)*E2[tau]*u)); WP[x_, y_] = WeierstrassP[w1*x + w2*y, inv]; L = -(1/3)*E2[tau]; f[x_, y_] = Re[WP[x, y] - L]; g[x_, y_] = Im[WP[x, y] - L];

So there are precisely two points in the domain I'm interested in where the above functions $f$ and $g$ identically vanish. Quite simply, all I need to do is find these points. NSolve was giving me issues so I was given great advice to apply the methods described here (Updating Wagon's FindAllCrossings2D[] function). This is precisely where the second part of the code comes from 

 FindCrossings2D[{f_, g_}, {x_, xmin_, xmax_}, {y_, ymin_, ymax_}] := {x, y} /. (FindRoot[{f[x, y] == 0, g[x, y] == 0}, {{x, #[[1]]}, {y, #[[2]]}}] & /@ (ContourPlot[{f[x, y] == 0, g[x, y] == 0}, {x, xmin, xmax}, {y, ymin, ymax}][[1, 1]])) pts = FindCrossings2D[{f, g}, {x, 0, 2}, {y, -1, 1}]; ContourPlot[{f[x, y] == 0, g[x, y] == 0}, {x, 0, 2}, {y, -1, 1}, Epilog -> {AbsolutePointSize[6], Red, Point /@ pts}]

Like I said, when it worked, it does take 5-10 minutes but there were signs it was progressing. Like giving non-fatal error. A few days later, now it's just completely stuck and I have no clue why!

Improve this question
$\endgroup$
4
  • 1
    $\begingroup$ It seems you could apply some basic debugging principles and at least identify which one of these 13+ evaluations is giving you the error? $\endgroup$ Commented Dec 15, 2015 at 19:55
  • $\begingroup$ I've definitely tried all basic debugs I can think of and nothing fixes it. I feel like the problem is probably related to why this thing requires two aborts instead of just one. But who knows. $\endgroup$ Commented Dec 15, 2015 at 20:00
  • $\begingroup$ I'm not sure why you're approaching this problem this way. Perhaps you could change your question to reflect what you're actually trying to accomplish. As written it looks like you are trying to FindRoot about 1400 times, once for each point in the ContourPlot. If it was working at one point and now it is not, it could just be a memory issue. $\endgroup$ Commented Dec 15, 2015 at 20:03
  • $\begingroup$ @djphd Thanks, I added an edit above to explain motivation. $\endgroup$ Commented Dec 15, 2015 at 21:17

1 Answer 1

Reset to default
2
$\begingroup$

I cannot speak for why the second half of your code was fast earlier but is very slow now. Instead, I offer a simple solution. First, estimate where the simultaneous zeros are.

ContourPlot[{f[x, y] == 0, g[x, y] == 0}, {x, 0, 2}, {y, -1.5, 1.5}]

enter image description here

Because the functions evidently are symmetric about the point {1, 0}, only two of the four roots are distinct,

FindRoot[{f[x, y] == 0, g[x, y] == 0}, {x, 0.5}, {y, 1}] (* {x -> 0.498241, y -> 0.996698} *) FindRoot[{f[x, y] == 0, g[x, y] == 0}, {x, 1.5}, {y, 1}] (* {x -> 1.50176, y -> 1.0033} *)

(The functions are singular at {0, 0}.) The entire calculation takes less than a minute.

Improve this answer
$\endgroup$
5
  • $\begingroup$ I have no idea why, but even just attempting your "ContourPlot" step takes impossibly long. Quite literally, I just have the first half of my code in the OP, plus your ContourPlot line, and it runs indefinitely without result. Any idea what might be going on? $\endgroup$ Commented Jan 8, 2016 at 21:39
  • 1
    $\begingroup$ @spietro With Mathematica "10.3.0 for Microsoft Windows (64-bit) (October 9, 2015)", I run your first block of code, which takes just seconds, and then ContourPlot[{f[x, y] == 0, g[x, y] == 0}, {x, 0, 2}, {y, -1.5, 1.5}], which takes a minute or so and not much memory to produce the plot shown in my answer. I suggest you restart Mathematica with a new notebook, copy your first block of code from your question and the ContourPlot line of code from my answer to the notebook and run it. $\endgroup$ Commented Jan 9, 2016 at 2:11
  • $\begingroup$ Thats exactly what I did before, and tried again just now. I copied the first set of my code, copied your ContourPlot line, and ran them in the same block. The code then ran for 30+ minutes to no avail before I aborted it. I have absolutely no clue whats going on here. $\endgroup$ Commented Jan 9, 2016 at 3:03
  • 1
    $\begingroup$ @spietro I do not know what more to suggest except to reboot your computer and try again. The code ran fine for me before and continues to do so. $\endgroup$ Commented Jan 9, 2016 at 3:05
  • $\begingroup$ Thank you so much for your help. I ended up having to use N[ , 50] to numerically evaluate my Eisenstein series, and it runs in seconds flat. Why you didn't have to do this is beyond me. $\endgroup$ Commented Jan 9, 2016 at 3:20

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.