2
$\begingroup$

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 appreciatedenter image description here

   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]
$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – J. M.'s technical difficulties Mar 17 '16 at 3:26
  • $\begingroup$ that's actually a very good idea. I never really used piecewise functions. I will have to take a look into it $\endgroup$ – user3709772 Mar 17 '16 at 3:29
  • $\begingroup$ @user3709772: Did you see math.stackexchange.com/questions/54506/… , desmos.com/calculator/dnzfajfpym $\endgroup$ – Moo Mar 17 '16 at 4:51
8
$\begingroup$

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]

enter image description here

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]

enter image description here

$\endgroup$
  • $\begingroup$ Null is certainly shorter, but Indeterminate is the usual way to handle off-domain evaluations. $\endgroup$ – J. M.'s technical difficulties Mar 17 '16 at 9:27
  • $\begingroup$ I like to think outside the box :-D Also, it appears I forgot to set the bound for the upper curve. $\endgroup$ – Jason B. Mar 17 '16 at 9:29
  • $\begingroup$ @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. $\endgroup$ – Jason B. Mar 17 '16 at 9:43
  • $\begingroup$ not having sufficient image processing expertise, I can't answer that. But that sounds like a question that should be asked separately. ;) $\endgroup$ – J. M.'s technical difficulties Mar 17 '16 at 9:54
  • $\begingroup$ @J.M. thanks!! what is the purpose of using Null again? $\endgroup$ – user3709772 Mar 18 '16 at 1:09
3
$\begingroup$

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]

enter image description here

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]

enter image description here

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.

$\endgroup$
  • 4
    $\begingroup$ 1. That's a different curve. 2. Did you happen to notice the references? $\endgroup$ – J. M.'s technical difficulties Mar 17 '16 at 5:22
  • $\begingroup$ @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;. $\endgroup$ – martin Mar 17 '16 at 5:46
0
$\begingroup$

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.