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>
- Doesn't work in Mathematica 8