Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Re: Doesn't work in Mathematica 8

• To: mathgroup at smc.vnet.net
• Subject: [mg120631] Re: Doesn't work in Mathematica 8
• From: Heike Gramberg <heike.gramberg at gmail.com>
• Date: Sun, 31 Jul 2011 23:35:30 -0400 (EDT)
• Delivered-to: l-mathgroup@mail-archive0.wolfram.com
• References: <201107311126.HAA05223@smc.vnet.net>

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:
> =
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?
>

• References:
  • Doesn't work in Mathematica 8
    • From: "Scott Blomquist (sblom)" <scott@blomqui.st>