La ecuación del logo de Batman en Matemática

Hace ya unas semanas apareció por internet una imagen con una ecuación cuyas soluciones tenían como representación gráfica, en teoría, el logo de Batman. Aquí la tenemos:

Fue en StackExchange donde se encargaron de comprobarlo, representando de forma aislada cada una de las partes de la misma y explicándolas todas muy claramente.


Parte1
Código Mathematica:

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) &)]

Representación:

Parte 2
Código Mathematica:

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}]

Representación:

Parte 3
Código Mathematica:

pl3 = ContourPlot[(9 - 8 Abs[x] – y) == 0, {x, -7, 7}, {y, -3, 3},
RegionFunction -> ((3/4 < Abs[#] < 1) &)]

Representación:

Parte 4
Código Mathematica:

pl4 = ContourPlot[(3 Abs[x] + 3/4 – y) == 0, {x, -7, 7}, {y, -3, 3},
RegionFunction -> ((1/2 < Abs[#1] < 3/4) &)]

Representación:

Parte 5
Código Mathematica:

pl5 = ContourPlot[(9/4 - y) == 0, {x, -7, 7}, {y, -3, 3},
RegionFunction -> ((Abs[#1] < 1/2) &)]

Representación:

Parte 6
Código Mathematica:

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) &)]

Representación:

Logo Batman

Mostrando ahora en Mathematica las seis partes juntas con

Show[{pl1, pl2, pl3, pl4, pl5, pl6}]

obtenemos la siguiente representación:

que se parece bastante al contorno del logo de Batman.
Aunque, como proponen en un comentario en StackExchange, se consigue el logo más directamente con el código

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, Axes -> None, Frame -> True, PlotStyle -> GrayLevel[0]]

que nos da la siguiente representación:

Si le añadimos a la primera representación la elipse

pl7 = ContourPlot[((x/8)^2 + (y/3.5)^2 - 1) == 0, {x, -8, 8}, {y, -5,
5}]

nos queda lo siguiente:

Y con un pelín de Paint obtenemos esto

que se parece mucho más a