Drawing heart in mathematica

Question

It's not really a typical math question. Today, while studying graphs, I suddenly got inquisitive about whether there exists a function that could possibly draw a heart-shaped graph. Out of sheer curiosity, I clicked on Google, which took me to this page.

The page seems informative, and I am glad to learn certain new things! Now I am interested in drawing them by my own using Mathematica. So my question is: is it possible to draw them in Mathematica? If yes, please show me how.

The following links may be useful to you:
http://xahlee.org/SpecialPlaneCurves_dir/Cardioid_dir/cardioid.html

http://demonstrations.wolfram.com/GeneratingACardioidIIICirclesPassingThroughAPoint/

There is also a differential geometry with mathematica book you may want to look up if the links don't give you what you are looking for. — WWright, Nov 27 '10 at 19:41
Duck-shaped heart: SphericalPlot3D[Log[u] + Sin[v], {u, 0, 2 Pi}, {v, 0, 2 Pi}] — Yaroslav Bulatov, Nov 28 '10 at 02:22

score 34 · Answer 1 · edited Feb 21 '14 at 04:46

34

You can plot Taubin's heart surface using ContourPlot3D:

ContourPlot3D[(2 x^2 + y^2 + z^2 - 1)^3 - (1/10) x^2 z^3 - y^2 z^3 == 0,
              {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5},
              Mesh -> None, ContourStyle -> Opacity[0.8, Red]]

Taubin's heart

edited Feb 21 '14 at 04:46

Cole Tobin

1,399
4
14
23

answered Nov 28 '10 at 02:18

Vicfred

2,787

score 28 · Answer 2 · answered Nov 28 '10 at 02:49

Consider the map $T \colon \mathbb R^2 \rightarrow \mathbb R^2, \ (x,y) \mapsto (x, y+ \sqrt{|x|})$. With a little examination, you can see that this will define a warping on the plane that will map the unit circle to a heart shaped curve: alt text

So if you know that a parametrization for the circle is $(\cos(t),\ \sin(t)),\ t\in [-\pi,\pi]$, then the parametrization for its heart-shaped image would be $(\cos(t),\ \sin(t) + \sqrt{|\cos(t)|}),\ t\in [-\pi,\pi]$. You can plot the curve with the following Mathematica code:

ParametricPlot[{Cos[t], Sin[t] + Sqrt[Abs[Cos[t]]]}, {t, -Pi, Pi}]

score 19 · Accepted Answer · answered Nov 27 '10 at 20:00

19

For the fifth function in the link you mentioned (which I thought it was the most similar to a heart):

PolarPlot[(Sin[t]Sqrt[Abs[Cos[t]]])/(Sin[t]+7/5)-2Sin[t]+2, {t, 0, 10}]

Similarly, using W|A:

alt text

answered Nov 27 '10 at 20:00

r_31415

2,934

5

Now that's love – bobobobo Nov 27 '10 at 20:05
By the way, I couldn't paste the address to W|A into a link (maybe some character is breaking the tags). However, the same code for Mathematica works in W|A. – r_31415 Nov 27 '10 at 20:44
1

For links to WA you have to replace the square brackets with parenthesis – Dr. belisarius Feb 28 '11 at 04:23
Like this http://www.wolframalpha.com/input/?i=PolarPlot%20((Sin(t)Sqrt(Abs(Cos(t))))/(Sin(t)%2B7/5)-2Sin(t)%2B2) – Dr. belisarius Feb 28 '11 at 04:26
@belisarius: I didn't know that. Thanks :-) – r_31415 Feb 28 '11 at 05:24

score 9 · Answer 4 · answered Jul 28 '11 at 20:16

A somewhat late addition (I only found my yellowed notebooks containing these just now):

$$\left(2(1+\cos\,\varphi)\sin^3 t\qquad 2\cos\,\theta\;\sin^2 t \sin\,\varphi+\sin\,\theta\cos\,t\left(\cos\,2t-2\cos\,\varphi\;\sin^2 t-3\right)\right)^T$$

is a two-parameter family of curves that generate heart shapes for some values of $\theta$ and $\varphi$. They were derived from projections of a skewed version of the nephroid.

Here for instance is the case $\theta=\pi/4,\quad \varphi=\pi/2$:

heart

score 6 · Answer 5 · answered Feb 17 '14 at 17:10

The following inputs will plot the following 6 hearts in the picture below respectively.

ContourPlot[(x^2 + y^2 - 1)^3 - x^2 y^3 == 0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, MaxRecursion -> 5]

ContourPlot[x^2 + (y - (2 (x^2 + Abs[x] - 6))/(3 (x^2 + Abs[x] + 2)))^2 == 36, {x, -9, 9}, {y, -9, 9}, MaxRecursion -> 5]

ContourPlot[x^2 + (5/4 y - Sqrt[Abs[x]])^2 == 1, {x, -1.5, 1.5}, {y, -1.5, 1.5},MaxRecursion -> 5]

ContourPlot[0 == (Sqrt[1 - (Abs[x/5] - 1)^2] - y/5 + 3/4) (ArcCos[1 - Abs[x/5]] - \[Pi] - y/5 + 3/4), {x, -12, 12}, {y, -12, 12}, MaxRecursion -> 5]

PolarPlot[2 - 2 Sin[\[Theta]] + Sin[\[Theta]] Sqrt[Abs[Cos[\[Theta]]]]/(Sin[\[Theta]] + 1.4), {\[Theta], -2 \[Pi], 2 \[Pi]}, MaxRecursion -> 5]

ContourPlot3D[(x^2 + (9 y^2)/4 + z^2 - 1)^3 - x^2 z^3 - (9 y^2 z^3)/80 == 0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5}]

Sample Hearts

I also came up with my own strictly algebraic equation that will plot the letters AB inside of a heart for my significant other. The equation is...

$ \left(\left(\left(\left| y\right| -\frac{29}{20}\right)^2+(x-1)^2\right)^2+18 \left(\left(\left| y\right| -\frac{29}{20}\right)^2+\left(x-\frac{219}{100}\right)^2\right)-8 \left(\left(x-\frac{5}{2}\right)^3-3 \left(x-\frac{39}{20}\right) \left(\left| y\right| -\frac{147}{100}\right)^2\right)-27\right) $ $ \left(\left(\left(x+\frac{7}{4}\right)^2+\left(\frac{2 y}{3}+\frac{1}{4}\right)^2\right)^2+\frac{9}{2} \left(\left(x+\frac{7}{4}\right)^2+\left(\frac{2 y}{3}+\frac{1}{4}\right)^2\right)-4 \left(\left(\frac{2 y}{3}+\frac{1}{4}\right)^3-\left(x+\frac{7}{4}\right)^2 \left(2 y+\frac{3}{2}\right)\right)-\frac{27}{16}\right) $ $ \left(\left(\left(x+\frac{7}{4}\right)^2+\left(\frac{2 y}{3}+\frac{3}{4}\right)^2\right)^2+18 \left(\left(x+\frac{7}{4}\right)^2+\left(\frac{2 y}{3}+\frac{3}{4}\right)^2\right)-8 \left(\left(\frac{2 y}{3}+\frac{3}{4}\right)^3-\left(x+\frac{7}{4}\right)^2 \left(2 y+\frac{9}{4}\right)\right)-27\right) $ $ \sqrt{\frac{\left| \sqrt{\left(\frac{2 y}{3}+2\right)^2+\left(x+\frac{11}{4}\right)^2}+\sqrt{\left(\frac{2 y}{3}+2\right)^2+\left(x+\frac{3}{4}\right)^2}-\frac{5}{2}\right| }{\sqrt{\left(x+\frac{11}{4}\right)^2+\left(\frac{2 y}{3}+2\right)^2}+\sqrt{\left(x+\frac{3}{4}\right)^2+\left(\frac{2 y}{3}+2\right)^2}-\frac{5}{2}}} \sqrt{\frac{\left| \sqrt{(y-2)^2+\left(x-\frac{9}{20}\right)^2}+\sqrt{(y+2)^2+\left(x-\frac{9}{20}\right)^2}-\frac{21}{5}\right| }{\sqrt{\left(x-\frac{9}{20}\right)^2+(y-2)^2}+\sqrt{\left(x-\frac{9}{20}\right)^2+(y+2)^2}-\frac{21}{5}}} $ $ \left(\sqrt{\left(-x-\frac{11}{4}\right)^2+\left(\frac{2 y}{3}+\frac{7}{4}\right)^2}+\sqrt{\left(-x-\frac{3}{4}\right)^2+\left(\frac{2 y}{3}+\frac{7}{4}\right)^2}-\frac{5}{2}\right) $ $ \left(\sqrt{\left(x-\frac{1}{2}\right)^2+(y-2)^2}+\sqrt{\left(x-\frac{1}{2}\right)^2+(y+2)^2}-\frac{21}{5}\right) $ $ \left(\left((\left| y\right| +1)^2+(x-2)^2\right)^2-19 \left((\left| y\right| +1)^2-(x-2)^2\right)\right) $ $ \left(\left(-\sqrt{\left| \frac{x}{2}\right| }+\frac{3 y}{10}+\frac{9}{10}\right)^2+\frac{x^2}{20}-5\right) = 0 $

The mathematica code is...

ContourPlot[0 == (x^2/20 + ((3 y)/10 + 9/10 - Sqrt[Abs[x/2]])^2 - 
 5) ((((2 y)/3 + 1/4)^2 + (x + 7/4)^2)^2 + 
 9/2 (((2 y)/3 + 1/4)^2 + (x + 7/4)^2) - 27/16 - 
 4 (((2 y)/3 + 1/4)^3 - (2 y + 3/2) (x + 7/4)^2)) (((x + 7/
     4)^2 + ((2 y)/3 + 3/4)^2)^2 + 
 18 ((x + 7/4)^2 + ((2 y)/3 + 3/4)^2) - 27 - 
 8 (((2 y)/3 + 3/4)^3 - (2 y + 9/4) (x + 7/4)^2)) (Sqrt[((2 y)/
    3 + 7/4)^2 + (-x - 11/4)^2] + 
 Sqrt[((2 y)/3 + 7/4)^2 + (-x - 3/4)^2] - 5/
 2) \[Sqrt](Abs[
   Sqrt[((2 y)/3 + 2)^2 + (x + 11/4)^2] + 
    Sqrt[((2 y)/3 + 2)^2 + (x + 3/4)^2] - 5/
    2]/(Sqrt[((2 y)/3 + 2)^2 + (x + 11/4)^2] + 
    Sqrt[((2 y)/3 + 2)^2 + (x + 3/4)^2] - 5/
    2)) ((((Abs[y] + 1)^2 + (x - 2)^2)^2 - 
  19 ((Abs[y] + 1)^2 - (x - 2)^2))) (((x - 1)^2 + (Abs[y] - 29/
     20)^2)^2 + 18 ((x - 219/100)^2 + (Abs[y] - 29/20)^2) - 27 - 
 8 ((x - 5/2)^3 - 3 (x - 39/20) (Abs[y] - 147/100)^2)) (Sqrt[(x - 
    1/2)^2 + (y - 2)^2] + Sqrt[(x - 1/2)^2 + (y + 2)^2] - 21/
 5) (Sqrt[
Abs[Sqrt[(x - 9/20)^2 + (y - 2)^2] + 
  Sqrt[(x - 9/20)^2 + (y + 2)^2] - 21/5]/(
Sqrt[(x - 9/20)^2 + (y - 2)^2] + Sqrt[(x - 9/20)^2 + (y + 2)^2] - 
 21/5)]), {x, -12, 12}, {y, -12, 12}, MaxRecursion -> 7]

and the graph is...

AB Algebraic Heart

When using the ContourPlot function in Mathematica there are issues and you may get some noise. So your image may not be as clean as mine. Also it will take a while to plot it at MaxRecursion->7 so stand by.

Is there any easy way to write something to the Heart such as BEST? — hhh, Mar 07 '14 at 20:15
@hhh There is not an easy way to do that or to write anything for that matter. It would have to be calculated. — David Caliri, Mar 07 '14 at 20:24

score 2 · Answer 6 · answered Aug 17 '16 at 22:30

Inigo Quilez has found a polar plot of a heart that doesn't require any of trigonometric functions:

polar plot r = (0.322515 * abs(theta)^3 - 2.22907 * abs(theta)^2 + 4.13803 * abs(theta))/(6.0 - 1.59155 * abs(theta)), theta=-pi to pi

Wolphram Alpha plot

Shadertoy live version

E. Noujeim · Answer 7 · 2018-02-21T22:26:32.080

A three-dimensional space curve with the shape of a red heart:

The Mathematica code for the image above is:

ParametricPlot3D[{Cos[u]*(4*Sqrt[1 - v^2]*Sin[Abs[u]]^Abs[u]), v, 
  Sin[u]*(4*Sqrt[1 - v^2]*Sin[Abs[u]]^Abs[u])}, 
   {u, -Pi, Pi}, {v, -1, 1}, Axes -> None, Mesh -> False, 
 Boxed -> False, 
   PlotStyle -> {Red, Specularity[White, 10]}]

3D red heart with Mesh and lines:

Mathematica code for the image above:

ParametricPlot3D[{Cos[u]*(4*Sqrt[1 - v^2]*Sin[Abs[u]]^Abs[u]), v, 
  Sin[u]*(4*Sqrt[1 - v^2]*Sin[Abs[u]]^Abs[u])}, {u, -Pi, 
  Pi}, {v, -0.97, 0.97}, PlotPoints -> 50, Axes -> None, 
 Boxed -> False, 
 PlotStyle -> 
  Directive[Glow[Red], Specularity[White, 30], Opacity[0.15]], 
 Mesh -> 50, Background -> Black, MeshStyle -> {Blue, Red}, 
 Lighting -> {{"Directional", Yellow, {{1.5, 1.5, 5}, {1.5, 1.5, 0}}, 
    Pi/6}}]

A variation on the use of the Taubin heart surface with hue:

Mathematica code for the last image above:

ContourPlot3D[(-1/10) x^2 z^3 - 
   y^2 z^3 + (2 x^2 + y^2 + z^2 - 1)^3 == 0, {x, -1.2, 1.2}, {y, -1.4,
   1.4}, {z, -1.5, 1.5}, Mesh -> False, PlotPoints -> 60, 
 Axes -> None, Boxed -> False, 
 ContourStyle -> Directive[Opacity[0.5], Red], 
 ColorFunction -> Function[{x, y, z, f}, Hue[z]]]

For more customized heart images, see the post in my website/blog:

https://knowledgemix.wordpress.com/2014/02/14/heart-to-heart-with-3d-math/

Timothy Wagner · Answer 8 · 2010-11-27T19:30:45.427

1

This is really about plotting polar plots, parametric plots and implicitly defined functions in Mathematica.

This is the info on how to draw polar plots

http://mathworld.wolfram.com/PolarPlot.html

Parametric plots

http://reference.wolfram.com/mathematica/ref/ParametricPlot.html

This provides info on implicit plots

http://grosz.math.txstate.edu/~dhaz/prob_sets/LTs09cal1lab8.pdf

edited Nov 27 '10 at 19:30

answered Nov 27 '10 at 19:14

Timothy Wagner

10,319

Am not getting how to plot the second and third graph in that page. – Quixotic Nov 27 '10 at 19:25
@Debanjan: Second is just an implicit plot, check out the link in my answer. Third is a parametric plot, http://reference.wolfram.com/mathematica/ref/ParametricPlot.html – Timothy Wagner Nov 27 '10 at 19:30

JustBeingHelpful · Answer 9 · 2014-02-17T16:54:45.960

1

Here is a screen shot from this equation on Wolfram Alpha. I don't have a license for Mathematica.

(x^2+y^2-1)^3 = x^2

enter image description here

edited Feb 17 '14 at 16:54

answered Feb 17 '14 at 16:13

JustBeingHelpful

442
4
16

1

http://commons.wikimedia.org/wiki/Category:Heart_shapes_in_mathematics – Adam Mar 07 '14 at 21:19

Drawing heart in mathematica

9 Answers9

Linked

Related