Doesn't work in Mathematica 8
Scott Blomquist (sblom)
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:
http://www.reddit.com/r/pics/comments/j2qjc/do_you_like_batman_do_you_like_math_my_math/c28ozge
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?
Heike Gramberg
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:
> =
Helen Read
It would be easier for us to help you if you post the actual code that
you used.
--
Helen Read
University of Vermont
Ralph Dratman
early paper by Watson presciently suggested that the Robin Manifold
should be piecewise isomorphic to the upper half of the Holmes plane,
but seems to have dropped the subject after 1854. Wayne (1962)
suggested that an invertible mapping onto Joker polynomials is always
possible. Meanwhile, two Finnish groups are looking for
counterexamples to the Alfred Conjecture.