# Plot of Implicit Equations

I've read Cool Graphs of Implicit Equations recently. In the article, it mentioned a software GrafEq which can draw graphs of arbitrary implicit equations. For example, And I've tried several equations in Mathematica, it failed to give a same graph.

ContourPlot[Exp[Sin[x] + Cos[y]] == Sin[Exp[x + y]], {x, -10, 10}, {y, -10, 10}] And in GrafEq's page, it says:

“ All software packages, except [GrafEq 2.09], produced erroneous graphical results. ... [GrafEq 2.09] demonstrated its graphical sophistication over all the other packages investigated.” — Michael J. Bossé and N. R. Nandakumar, The College Mathematics Journal

(The other software packages were MathCad 8, Mathematica 4, Maple V, MATLAB 5.3, and Derive 4.11.)

I want to know if I missed some techniques in Mathematica which can handle these equation drawing? Or it's really a 'weakness' of Mathematica in this area?

Edit:

The program also features successive refinement plotting, which deletes regions of the plane that do not contain solutions, revealing the regions that do contain solutions. Plotting is completed by proving which pixels contain solutions. This technique enables the graphing of implicit relations, in which no single variable can be readily isolated. Such relations cannot be graphed at all by the typical computer graphing utility or graphics calculator. Successive refinement plotting also permits the plotting of singularities.

It seems it judges pixel by pixel, if the pixel's (x,y) is the solution of the equation, then it will be colored. Then what Mathematica's method to draw such equations? Does it have a similar mode we can choose when drawing such graph?

Now, I think I should make my questions clear:

1. How Mathematica handle such drawings.
2. How GrafEq handle that, I think I've got some clues, but not sure.
3. How to get the same result with Mathematcia?
• I hope you understand you changed the meaning of your question completely with your last edit. You may at least say so, for the people that has been working for an hour trying to help you deserve that. Dec 20, 2014 at 8:53
• @belisarius: Thanks for your answer and your suggestion. I'm also trying hard to figure out the answer. So when I find the new clues, I think I should share it to others. I think this will be helpful to get the answer quick. Dec 20, 2014 at 8:58
• @belisarius: I just want to know: 1>. How Mathematica handle such drawings. 2>. How GrafEq handle that (I think I've got some clues, see the editing. 3>. How to get the same result with Mathematcia? Dec 20, 2014 at 9:01
• Releated link, mathematica.stackexchange.com/questions/19590/… Dec 22, 2014 at 1:51
• Anybody curious about the machinery of GrafEq should look at Tupper's paper and thesis. Mar 28, 2017 at 16:05

In principle the same method could be used in Mathematica. The problem boils down to determining if a solution to $a=b$ exists somewhere inside each pixel. Here's an oversimplified approach where I calculate $a-b$ for 100 random points within the pixel and see if there are both positive and negative values. If there are, there must be a zero crossing somewhere inside the pixel.

pixelContainsSolution[x0_, y0_] :=
(Max[#] > 0 && Min[#] < 0) &[
Exp[Sin[#1] + Cos[#2]] - Sin[Exp[#1 + #2]] & @@@
Transpose[{x0, y0} + RandomReal[{-0.05, 0.05}, {2, 100}]]]

Image[1 - Table[Boole@pixelContainsSolution[x, y],
{x, -10, 10, 0.1}, {y, -10, 10, 0.1}]] It's pretty slow - to obtain a nice high resolution plot in a reasonable amount of time would need some optimisations.

Edit

Example of faster code:

data = Compile[{}, Block[{x = Range[-10, 10, 0.0025]},
Exp[Outer[Plus, Sin[x], Cos[x]]] - Sin[Exp[Outer[Plus, x, x]]]]][];

DeveloperPartitionMap[Sign[Max[#] Min[#]] &, data, {20, 20}] // Image

• The second block of code produces a pretty respectable version of this image, more or less the same as the red one in the question. I would say Simon has a proof-of-concept that Mathematica can do whatever this GraphEq can do -- except it can also do plots that are not contour plots... and lots of other math. Dec 21, 2014 at 3:39
• @Simon: Can you use your method to plot $sin(sin(x)+cos(y))=cos(sin(x*y)+cos(x))$? I tried, but failed. I'm not very familiar with Mathematica. Dec 21, 2014 at 12:06
• @diverger See my updated. Sep 22, 2020 at 16:46

That's the best I could go with Mathematica 10.0.2, with PlotPoints->50 and MaxRecursion->4.

ContourPlot[
E^(Sin[x] + Cos[y]) == Sin[E^(x + y)], {x, -10, 10}, {y, -10, 10},
Axes -> True, ImageSize -> Large, PlotPoints -> 50,
MaxRecursion -> 4]


The rendering took about 1 hour with Mathematica eating all my 16Gb Ram. (I'll never try something like this again!) EDIT

Following Mr.Wizard comment here's a better plot and a better solution. It took just 1m 12s but the Ram utilization peaked to 13GB (beware!):

ContourPlot[
E^(Sin[x] + Cos[y]) == Sin[E^(x + y)], {x, -10, 10}, {y, -10, 10},
Axes -> True, ImageSize -> Large, PlotPoints -> 2000,
MaxRecursion -> 0] • +1 for the computational expense to demonstrate a result Dec 21, 2014 at 9:24
• Incidentally I get a fairly similar result much faster with: ContourPlot[E^(Sin[x] + Cos[y]) == Sin[E^(x + y)], {x, -10, 10}, {y, -10, 10}, Axes -> True, ImageSize -> Large, MaxRecursion -> 0, PlotPoints -> 1000] Dec 21, 2014 at 9:41
• @Mr.Wizard I can confirm your result. So I've learned that MaxRecursion is useless in this case and it just slows down the calculation and eat memory. Even MaxRecursion -> 0, PlotPoints -> 2000 works in a reasonable time (1m 12s) but with a peak of 13GB of Ram used (!). Dec 21, 2014 at 10:02

The following is a answer to the original question, without accounting for the last edit.

The red plot is nice,but I'm not sure what they are trying to show. Inside the solid colored regions the frequency is very high, but the function isn't constant, as an easy check can show:

f[x_, y_] := Exp[Sin[x] + Cos[y]] - Sin[Exp[x + y]]
GraphicsRow[{Plot[f[x, 5], {x, -10, 10}],  Plot[f[x, 5], {x, 4.999, 5}]}]  So the red plot is just a simplification of the real one which is better shown in the Mathematica output.

• I think you've misunderstood the plot. As your first plot shows, $f$ has a very large number of zero crossings in the solid region. Therefore, ideally a very large number of contours should be drawn there. If you draw a very large number of contours in a small area, it looks like a solid region, as the red plot correctly shows. It's the Mathematica plot which incorrectly suggests that, for example, there are no zero crossings in the neighbourhood of $(4,2)$.
– user484
Dec 20, 2014 at 9:59
• @Rahul A solid filling represents in my book a constant valued function. Increasing PlotPoints and MaxRecursion makes Mma performs better, as always Dec 21, 2014 at 0:57
With[{eqn = Sin[Sin[x] + Cos[y]] - Cos[Sin[x y] + Cos[x]]},
With[{data = Compile[{}, Block[{x = Range[-10, 10, .005]},
Reverse@Table[UnitStep@eqn, {y, x}]]][]},
Erosion[ColorNegate@EdgeDetect[Image[data]], 2]
]
] To change the color, you can use ColorReplace[image, Black -> color] (* A little faster than the built-in EdgeDetect *)
ClearAll[edgeDetect];
edgeDetect[img_] := Image[Sqrt[ImageData[ImageConvolve[img, {{1, 0}, {0, -1}}]]^2 +
ImageData[ImageConvolve[img, {{0, 1}, {-1, 0}}]]^2]];


data=Compile[{},With[{y=Range[-10,10,0.006]},
` 