I guess the problem is that the function plotted is complex almost
everywhere in the xy-plane which is something ContourPlot doesn't like.
If you look at the function carefully, however, you can get it to work
but it takes a bit of effort.
The graph plotted is the solution of
((x/7)^2 g[Abs[x] - 3] + (y/3)^2 g[y + (3 Sqrt[33])/7] -
1) (Abs[x/2] - ((3 Sqrt[33] - 7)/112) x^2 - 3 +
Sqrt[1 - (Abs[Abs[x] - 2] - 1)^2] -
y) (9 g[(1 - Abs[x]) (Abs[x] - 3/4)] - 8 Abs[x] -
y) (3 Abs[x] + .75 g[(3/4 - Abs[x]) (Abs[x] - 1/2)] -
y) (9/4 g[((1/2 - x) (1/2 + x))] -
y) ((6 Sqrt[10])/
7 + (3/2 - Abs[x]/2) g[(Abs[x] - 1)] - (6 Sqrt[10])/14 Sqrt[
4 - (Abs[x] - 1)^2] - y)==0
where g[a_]:=Sqrt[Abs[a]/a]. Note that g[a] is basically the same as
PieceWise[{{1,a>0},{I,a<0}}].
Since the left-hand side is the product of 6 parts it's equal to zero if
and only if any of those parts is zero. Setting the
first part to zero gives something like
((x/7)^2 g[(Abs[x] - 3)] + (y/3)^2 g[(y + (3 Sqrt[33])/7)] - 1)==0
=46rom the definition of g we find that this has real solutions for x
and y if Abs[x]>3 and y> - (3 Sqrt[33])/7) fin which case we get
(x/7)^2 + (y/3)^2 - 1 ==0
Therefore, the part of the plot corresponding to the first part being
equal to zero becomes something like
pl1 = ContourPlot[((x/7)^2 + (y/3)^2 - 1) == 0, {x, -8, 8}, {y,
-5,
5}, RegionFunction -> ((Abs[#1] >
3 && #2 > -(3 Sqrt[33])/7) &)]
If you do the same with the other parts you get
pl2 = ContourPlot[(Abs[x/2] - ((3 Sqrt[33] - 7)/112) x^2 - 3 +
Sqrt[1 - (Abs[Abs[x] - 2] - 1)^2] - y) == 0, {x, -7, 7}, {y,
-3,
3}]
pl3 = ContourPlot[(9 - 8 Abs[x] - y) == 0, {x, -7, 7}, {y, -3,
3},
RegionFunction -> ((3/4 < Abs[#] < 1) &)]
pl4 = ContourPlot[(3 Abs[x] + 3/4 - y) == 0, {x, -7, 7}, {y, -3,
3},
RegionFunction -> ((1/2 < Abs[#1] < 3/4) &)]
pl5 = ContourPlot[(9/4 - y) == 0 , {x, -7, 7}, {y, -3, 3},
RegionFunction -> ((Abs[#1] < 1/2) &)]
pl6 = ContourPlot[((6 Sqrt[10])/
7 + (3/2 - Abs[x]/2) - (6 Sqrt[10])/14 Sqrt[
4 - (Abs[x] - 1)^2] - y) == 0 , {x, -7, 7}, {y, -3, 3},
RegionFunction -> ((Abs[#1] > 1) &)]
And combining everything gives
Show[{pl1, pl2, pl3, pl4, pl5, pl6}]
Heike
On 31 Jul 2011, at 12:26, Scott Blomquist (sblom) wrote:
> An equation for plotting a Batman symbol has been making the rounds on
> the internet. I figured it'd be fun to reproduce the originator's
> result for myself in Mathematica 8, so I carefully typed it in and
> tried a ContourPlot[batman[x,y]==0,{x,-8,8},{y,-4,4}]. It didn't
work.
> I broke it down into constituent pieces and plotted each of the
> topmost () sections by itself. Most of them work as expected, but a
> few of them don't.
> Reports from those with access to older versions of Mathematica
> indicate some luck getting the equation to work with ImplicitPlot:
> =
> Do any of you have any tips for fixing my attempt to ContourPlot this?
> Any ideas why this is working with older versions of Mathematica but
> not the latest one?
