# Simultaneous equations

I am trying to solve two simultaneous equations that are claimed to have 145 solutions but I believe they have 143, I want to check I am right before sending an email to my professor. Mathematica is taking an incredible amount of time with this so I thought my code was wrong. Could you please check it for me?

Length[NSolve[{x == Sin[6 Pi y], y == Sin[6 Pi x]}, {x, y}]]


The equations are $y=sin(6 Pi x)$ and $x=sin(6 Pi y)$

apologies if my conjecture is wrong!

-
Mathematica agrees there are 143 at least for real values. Complex solutions is another matter (should be infinitely many per Picard). In[41]:= Timing[ Length[NSolve[{x == Sin[6 Pi y], y == Sin[6 Pi x]}, {x, y}, Reals]]] Out[41]= {0.180000, 143} –  Daniel Lichtblau Feb 6 at 18:32
So, it appears the disputed solutions are those for the first two 'vertical' peaks near x=0: Plot[Evaluate@{Sin[6π x], Table[{ArcSin[x]/(6π) + k/3, -ArcSin[x]/(6π) + 1/6 - k/3}, {k, -3, 3, 1}]}, {x, -1, 1}, AspectRatio -> Automatic]. It seems easy to count 12x11+2x6 solutions. –  Peltio Feb 6 at 22:42
Apologies - it's 1x11+10x12+2x6 = 143 solutions. –  Peltio Feb 6 at 22:57

I would have posted this in a comment but I don't have enough reputation to do it. I suppose you want to solve these equation with x and y being real numbers, thus:

Length[NSolve[{x == Sin[6 Pi y], y == Sin[6 Pi x]}, {x, y}, Reals]] // Timing

{0.296875, 143}


You where right, 143 solutions, 0.29secs to find them.

-
NSolve isn't guaranteed to find all solutions. This shows there are at least 143. –  Ymareth Feb 6 at 17:44
What about Complex solutions? –  Max Feb 6 at 17:57
Yeah you're right, but I got the same result with reduce, so I guess 143 is right –  John Feb 6 at 17:59
@Max for Complex solutions your code is fine but they're harder to find so Mathematica takes much longer. –  John Feb 6 at 18:04

[Way too long for a comment but not quite an answer.]

We can use numerical integration at modest precision to show that the correct number of solutions, counting by multiplicity, cannot exceed 143.

First thing is to observe that roots satisfy the univariate x - Sin[6*Pi*Sin[6*Pi*z]] == 0. Since the Sin[...], for real x, cannot exceed 1 in absolute value, this means all roots are bounded by -+1. A simple computation shows that the endpoints of this interval are not themselves roots.

that I use the argument principal and integrate around a thin box where top and bottom are at y=+-epsilon (I set epsilon to 1/1000) and left and right edges are at -1-epsilon and 1+epsilon respectively. I could in theory use -+1 but I wanted to allow a bit of extra room because it looks like there are roots nearby. What the integral shows is that there are 143 roots inside this box. Coupled with the fact that you can find 143 explicitly real roots, this shows that is all there can be.

ee = z - Sin[6*Pi*Sin[6*Pi*z]];
eps = 1/1000;

bottom =
NIntegrate[D[ee, z]/ee, {z, -1 - eps - eps*I, 1 + eps - eps*I},
WorkingPrecision -> 100, MaxRecursion -> 16]
right = NIntegrate[D[ee, z]/ee, {z, 1 + eps - eps*I, 1 + eps + eps*I},
WorkingPrecision -> 100, MaxRecursion -> 16]
top = NIntegrate[D[ee, z]/ee, {z, 1 + eps + eps*I, -1 - eps + eps*I},
WorkingPrecision -> 100, MaxRecursion -> 16]
left = NIntegrate[
D[ee, z]/ee, {z, -1 - eps + eps*I, -1 - eps - eps*I},
WorkingPrecision -> 100, MaxRecursion -> 16]

(* Out[27]= 0.*10^-122 +
450.23417218584244411148838277077827524114697014604184527662050714016\
98412748656717060712169899295271 I

-0.9864227225020110113303789618093628009517460354017128772034304401520\
951759377849022622369660067864026 I

0.*10^-122 +
450.23417218584244411148838277077827524114697014604184527662050714016\
98412748656717060712169899295271 I

-0.9864227225020110113303789618093628009517460354017128772034304401520\
951759377849022622369660067864026 I *)

(bottom + right + top + left)/(2*Pi*I)

(* 143.000000000000000000000000000000000000000000000000000000000000000000\
0000000000000000000000000000000 + 0.*10^-122 I *)


I remark that there are probably complex-valued roots lurking nearby. When I set epsilon to 1/100 I had a slightly higher count.

-

Here's something a little fun. Let's solve the same problem for different integer coefficients:

list = Table[Length[NSolve[{x == Sin[i Pi y], y == Sin[i Pi x]}, {x, y}, Reals]],
{i, 1, 10}]

{7, 15, 39, 63, 103, 143, 199, 255, 327, 399}


Now we can ask what the pattern is:

FindSequenceFunction[list]
1 - 2 (-1)^#1 + 4 #1^2 &


which means that the nth solution can be found from 1 - 2 (-1)^n + 4 x^n. Of course this isn't a proof, but it would be a good place to start...

-