Batman Equation

I am trying to plot out the batman symbol in mathematica. I have the basic equations but I am having some difficulty with plottingstyles and connecting the two ears with a straight line. I was wondering if I can specifically make one graph darker than the other in mathematica and I would like to have the middle of the symbol greyed out.

Any help will be appreciated

   Plot[{ y = -3 Sqrt[64 - x^2] (UnitStep[x + 10] - UnitStep[x + 2]),
y = 3 Sqrt[64 - x^2] (UnitStep[x - 10] - UnitStep[x - 2]),
y = (-25 (x + 1) - 10) (UnitStep[x + 2] - UnitStep[x + 1]),
y = (-25 (x - 1) + 10) (UnitStep[x - 2] - UnitStep[x - 1]),
y = (-.5 (.9 x + 17.54)^2) (UnitStep[x + 17.5] - UnitStep[x + 8]),
y = ( -.6 (1.1 x + 7.5)^2 - 52) (UnitStep[x + 8] - UnitStep[x]),
y = (-.5 (-.9 x + 17.54)^2) (UnitStep[-x + 17.5] - UnitStep[-x + 8]),
y = ( -.6 (-1.1 x + 7.5)^2 - 52) (UnitStep[-x + 8] - UnitStep[-x]),
y = 5;
}, {x, -20, 20}, PlotRange -> {-100, 100}, PlotStyle -> {Black},
PlotStyle -> Axis, Filling -> Top, FillingStyle -> Opacity[.2],
Mesh -> None]

-
Your bottom piece can be expressed entirely in terms of Piecewise[]: Piecewise[{{-.5 (.9 x + 17.54)^2, -17.5 <= x < -8}, {-.6 (1.1 x + 7.5)^2 - 52, -8 < x <= 0}, {-.6 (-1.1 x + 7.5)^2 - 52, 0 < x <= 8}, {-.5 (-.9 x + 17.54)^2, 8 < x <= 17.5}}]. Try something similar for the top. – J. M. Mar 17 at 3:26
that's actually a very good idea. I never really used piecewise functions. I will have to take a look into it – user3709772 Mar 17 at 3:29
@user3709772: Did you see math.stackexchange.com/questions/54506/… , desmos.com/calculator/dnzfajfpym – Moo Mar 17 at 4:51

3 Answers

I like this version of the Batman curve, since it can be drawn as two piecewise functions (i.e. the top and bottom wouldn't be double-valued anywhere). This appears to get what you were going for,

Plot[{
Piecewise[{
{Null, x < -19.5},
{0, -19.5 <= x < -8},
{-3 Sqrt[64 - x^2], -8 <= x < -2},
{(-25 (x + 1) - 10) , -2 <= x < -1},
{0, -1 <= x < 1},
{(25 (x - 1) - 10) , 1 <= x < 2},
{-3 Sqrt[64 - x^2], 2 <= x < 8},
{0, 8 <= x < 19.5},
{Null, x > 19.5}}],
Piecewise[{
{Null, x < -19.5},
{-.5 (.9 x + 17.54)^2, -19.5 <= x < -8},
{-.6 (1.1 x + 7.5)^2 - 52, -8 < x <= 0},
{-.6 (-1.1 x + 7.5)^2 - 52, 0 < x <= 8},
{-.5 (-.9 x + 17.54)^2, 8 < x <= 19.5},
{Null, x > 19.5}}]
}, {x, -20, 20},
PlotRange -> {-100, 100},
Mesh -> None,
PlotStyle -> Black,
Filling -> {2 -> {{1}, {{Opacity[0.2], Black}, None}}},
Exclusions -> None]


I would personally tweak the ears and the top of the head just a bit,

Plot[{
Piecewise[{
{Null, x < -19.5},
{0, -19.5 <= x < -8},
{-3 Sqrt[64 - x^2], -8 <= x < -2},
{(-15 (x + 1) - 10) , -2 <= x < -1},
{-(x^2 - 1) - 8, -1 <= x < 1},
{(15 (x - 1) - 10) , 1 <= x < 2},
{-3 Sqrt[64 - x^2], 2 <= x < 8},
{0, 8 <= x < 19.5},
{Null, x > 19.5}}],
Piecewise[{
{Null, x < -19.5},
{-.5 (.9 x + 17.54)^2, -19.5 <= x < -8},
{-.6 (1.1 x + 7.5)^2 - 52, -8 < x <= 0},
{-.6 (-1.1 x + 7.5)^2 - 52, 0 < x <= 8},
{-.5 (-.9 x + 17.54)^2, 8 < x <= 19.5},
{Null, x > 19.5}}]
}, {x, -20, 20},
Axes -> False,
Mesh -> None,
PlotStyle -> Black,
Filling -> {2 -> {{1}, {{Black}, None}}},
Exclusions -> None,
AspectRatio -> .35,
ImageSize -> 600]


-
Null is certainly shorter, but Indeterminate is the usual way to handle off-domain evaluations. – J. M. Mar 17 at 9:27
I like to think outside the box :-D Also, it appears I forgot to set the bound for the upper curve. – JasonB Mar 17 at 9:29
@J.M. - Just for no real reason, how hard would it be to automate the process of generating the piecewise function? Can you think of a way to automatically split up the line segments from, say, EdgeDetect["http://i.stack.imgur.com/dqJry.png" // Import]? If so, then we could fit each segment to a polynomial. – JasonB Mar 17 at 9:43
not having sufficient image processing expertise, I can't answer that. But that sounds like a question that should be asked separately. ;) – J. M. Mar 17 at 9:54
@J.M. thanks!! what is the purpose of using Null again? – user3709772 Mar 18 at 1:09

From here:

Plot[{With[{
w = 3*Sqrt[1 - (x/7)^2],
l = (6/7)*Sqrt[10] + (3 + x)/2 - (3/7)*Sqrt[10]* Sqrt[4 - (x + 1)^2],
h = (1/2)*(3*(Abs[x - 1/2] + Abs[x + 1/2] + 6) - 11*(Abs[x - 3/4] + Abs[x + 3/4])),
r = (6/7)*Sqrt[10] + (3 - x)/2 - (3/7)*Sqrt[10]* Sqrt[4 - (x - 1)^2]},
w + (l - w)*UnitStep[x + 3] + (h - l)*UnitStep[x + 1]
+ (r - h)*UnitStep[x - 1] + (w - r)*UnitStep[x - 3]],
(1/2)*(3*Sqrt[1 - (x/7)^2] + Sqrt[1 - (Abs[Abs[x] - 2] - 1)^2]
+ Abs[x/2] - ((3*Sqrt[33] - 7)/112)*x^2 - 3)*((x + 4)/Abs[x + 4]
- (x - 4)/Abs[x - 4]) - 3*Sqrt[1 - (x/7)^2]},
{x, -7, 7}, AspectRatio -> Automatic, PlotStyle -> Black, Axes -> False, Filling -> Axis]


And as a region plot:

bm[{x_, y_}] = WolframAlpha["batman insignia",
{{"DefiningInequalitiesPod:Lamina", 1}, "ComputableData"}][[1]];

RegionPlot[Evaluate[bm[{x, y}]], {x, -8, 8}, {y, -4, 4},
PlotPoints -> 150, AspectRatio -> Automatic]


As J.M. pointed out below, this is a different curve, but Iwill leave it up incase useful. If not, please leave a comment below & I will remove.

-
1. That's a different curve. 2. Did you happen to notice the references? – J. M. Mar 17 at 5:22
@J.M. Ah, no - just saw batman curve and typed away without thinking ! Will leave it posted for the moment, but will remove if not helpful;. – martin Mar 17 at 5:46

So, a way to plot several functions all with wildly varying options is to Show[$PLOT1,$PLOT2, \$PLOT3].

Something you can do is just write a function to plot on a range, like you did here, but do each one is a separate Plot[]. Then, you can use Show to put them all on one graph, and each Plot has almost completely separately configurable display options.

-