爱心方程 | czp001的小站

说起❤爱心方程，大家最熟悉的应该是笛卡尔的心形线。方程千变万化，爱心方程也有很多种，我搜集了一些，有的也做了一些变化，一起来看看吧！

笛卡尔心形线

这是大家最熟悉的一种了，图中 $a=3$

$\rho =a (1-\cos (\theta )),\theta \in [0,2 \pi ]$

1	PolarPlot[3 (1 - Cos[\[Theta]]), {\[Theta], 0, 2 \[Pi]}]

带绝对值的二次方程

$x$ 不带绝对值的话，是一个倾斜的椭圆，加了之后图形关于 $y$ 轴对称了，下半部分还削掉了两块

$x^2-y \left| x\right|+y^2-1=0$

1	ContourPlot[x^2 - Abs[x]*y + y^2 - 1 == 0, {x, -2, 2}, {y, 2, -2}]

加点变化

ContourPlot[{x^2 - Abs[x] y + y^2 - 1}, {x, -2, 2}, {y, 2, -2}, 
 ContourStyle -> 
  Directive[RGBColor[0.27, 0.43, 1.], Opacity[0.6], 
   AbsoluteThickness[1.3]]]

3D爱心❤

我第一次见这个方程是在Wolfram Alpha的网页版上，在网页右侧的一个小窗口里作为宣传，放出了图形和方程，当时我就很惊讶，这也可以！？真的假的，半信半疑的把方程输入Mathematica之后十分惊喜,不知道这方程是谁想到的

$\left(x^2+\frac{9 y^2}{4}+z^2-1\right)^3-x^2 z^3-\frac{9 y^2 z^3}{80}=0$

1
2
3

ContourPlot3D[(x^2 + 9/4*y^2 + z^2 - 1)^3 - x^2*z^3 - 9/80*y^2*z^3 == 
  0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5}, Mesh -> None, 
 PlotPoints -> 50, ContourStyle -> Red, Boxed -> False]

有了这个方程可以画一个“一箭双心”，画两个心，做一个平移，然后再画一个箭头穿过他们

p1 = ContourPlot3D[(x^2 + 9/4*y^2 + z^2 - 1)^3 - x^2*z^3 - 
     9/80*y^2*z^3 == 0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 
    1.5}, Mesh -> None, PlotPoints -> 50, ContourStyle -> Red];
p2 = ContourPlot3D[((x + 1)^2 + 9/4*(y - 1/2)^2 + z^2 - 
        1)^3 - (x + 1)^2*z^3 - 9/80*(y - 1/2)^2*z^3 == 0, {x, -2.5, 
    0.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5}, Mesh -> None, 
   PlotPoints -> 50, ContourStyle -> Red];
p3 = Graphics3D[{Cyan, Arrowheads[0.07], 
    Arrow[Tube[{{-2, 1.5, 0.5}, {1.0, -1.5, 0.5}}, 0.03]]}];
Show[p1, p2, p3, PlotRange -> All, AspectRatio -> Automatic, 
 Boxed -> False, Axes -> None, BoxRatios -> {1, 1, 0.65}]

再加点小花样，让心跳动起来！每个时刻将图形在 $y$ 轴方向上压缩，同时 $z$ 轴方向做小幅度的压缩，然后将这若干帧图片导出GIF图片就可以了。Export函数可以将图片列表导出为GIF格式，我画的这个GIF为5帧

Export["xintiao.gif", 
 Table[ContourPlot3D[(x^2 + (9/4 + t) y^2 + (1 - 0.02 t) z^2 - 1)^3 - 
     x^2 z^3 - 9/80 y^2 z^3 == 0, {x, -1.15, 1.15}, {y, -1, 
    1}, {z, -1.3, 1.3}, Mesh -> None, Boxed -> False, Axes -> True, 
   ContourStyle -> Directive[Red], BoundaryStyle -> None, 
   PlotPoints -> 50], {t, 0, 2, 0.4}], "AnimationRepetitions" -> 100]
SystemOpen["xintiao.gif"]

这种我不知道怎么起名字

gr = ContourPlot3D[(x^2 + 9/4 y^2 + z^2 - 1)^3 - x^2*z^3 - 
     9/80 y^2*z^3 == 0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 
    1.5}, BoxRatios -> 1, PlotPoints -> 20, MeshFunctions -> {#2 &}];
InsetPoints[pts_] := 
  Polygon[Join[pts, 
    Reverse[Module[{centroid = (Plus @@ pts)/
         Length[pts]}, (# + .1 (centroid - #)) & /@ pts]]]];
Show[ContourPlot3D[(x^2 + 9/4 y^2 + z^2 - 1)^3 - x^2*z^3 - 
    9/80 y^2*z^3 == 0, {x, -1.5, 1.5}, {y, -1.5, 1.5}, {z, -1.5, 1.5},
   BoxRatios -> 1, Mesh -> None, PlotPoints -> 100, Axes -> False, 
  Boxed -> False, ContourStyle -> {Red, Opacity[.2]}], 
 Graphics3D@Cases[Normal[gr], Line[x_] :> InsetPoints[x], Infinity], 
 ImageSize -> 500]

心碎方程

有爱情也会有心碎 /(ㄒoㄒ)/~~

{leftSide, rightSide} = 
 Map[Function[{side}, 
   RegionPlot[(x^2 + y^2 - 1)^3 - x^2 y^3 < 0 && 
     side*x < 
      side*(Abs[
          Abs[Abs[Abs[
                Abs[.5 y] - 1] - .5] - .25] - .125] - .125), {x, -1.5,
      1.5}, {y, -1.5, 1.5}, ColorFunction -> "CherryTones"]], {1, -1}]
pics = Table[
  Show[leftSide, 
   rightSide /. 
    GraphicsComplex[points_List, other__] :> 
     GraphicsComplex[
      RotationTransform[-rotation \[Degree], {0, -1}][points], other],
    AspectRatio -> Automatic, Frame -> False, 
   PlotRangePadding -> {{.5, 1.25}, {1, .5}}], {rotation, 0, 30, 3}]
Export["BrokenHeart.gif", pics, "AnimationRepetitions" -> 100];
SystemOpen[DirectoryName[AbsoluteFileName["BrokenHeart.gif"]]]