曼德布洛特复数集合

淩亂°似流年 2023-10-15 12:24 44阅读 0赞

#### 文章目录 ####

*  Mandelbrot 集合的生成
 *  Mandelbrot 集合的边界

## Mandelbrot 集合的生成 ##

Mandelbrot集是一种点的集合。它的大概生成方法是这样的：

在平面上取一个点 c， 例如取 (1,1)

In[]:= c := {
        1, 1}

可以将其转化为复数，表示的是复平面上的点。

In[]:= Complex @@ c
    Out[]= 1 + I

将其按照一个式子迭代：  
 x n + 1 = x n 2 + C x\_\{n+1\}=x\_n^2+C\\\\ xn\+1=xn2\+C

其中， x 1 = 0 x\_1=0 x1=0。可以得到接下来几代，例如接下来5代x的式子

In[]:= NestList[#^2 + Complex @@ c &, 0, 5]
    
    Out[]= {
        0, 1 + I, 1 + 3 I, -7 + 7 I, 1 - 97 I, -9407 - 193 I}

可以发现它越来越大，如果再来几代，它将会变得非常大。

如果我们换一个点c，例如取 (0, -1)

In[]:= c := {
        0, -1}

则再次经过这样的迭代，x的大小并不会发生多大的变化，似乎有所稳定。

In[]:= NestList[#^2 + Complex @@ c &, 0, 5]

Out[]= {
        0, -I, -1 - I, I, -1 - I, I}

如果取 (-0.25, 0.5)

In[]:= c := {
        -0.25, 0.5};
           NestList[#^2 + Complex @@ c &, 0, 5]
    
    Out[]= {
        0, -0.25 + 0.5 I, -0.4375 + 0.25 I, -0.121094 + 
           0.28125 I, -0.314438 + 0.431885 I, -0.337653 + 0.228398 I}

可以看到似乎x趋于稳定。

接下来，我们可以在复平面上画出这些点。

这样可以画出一个点，这个点是使用复数表示的。

In[]:= Graphics[{
        Point[ReIm[1 + 1 I]]}, PlotRange -> 1, Axes -> True]

这样可以画出一系列的复数。

In[]:= Graphics[{
        Point[ReIm@{
        1 + 1 I, 0 + 0 I, 1 - 1 I, -1 + I, -1 - I}]}, 
           PlotRange -> 1, Axes -> True]

这样可以画出刚才迭代40代的点。

In[]:= Graphics[{
        Point[ReIm@NestList[#^2 + Complex @@ c &, 0, 40]]}, 
           PlotRange -> 1, Axes -> True]

这样可以连接刚才迭代40代的点。

In[]:= Graphics[{
        Line[ReIm@NestList[#^2 + Complex @@ c &, 0, 40]]}, 
           PlotRange -> 1, Axes -> True]

设置好格式和作图范围，作图坐标，颜色等。然后封装。

In[]:= plotRecurrencePoints[c_, beginPoints_, iteration_, 
           OptionsPattern[{
        "LineColor" -> Red, "PointColor" -> Blue}]] := 
           Graphics[{
        OptionValue["LineColor"], PointSize[Medium], 
           Point[Drop[#, {
        2}]], Line[#], OptionValue["PointColor"], 
           Point[#[[2]]]}, PlotRange -> 1, Axes -> True] &@
           ReIm@NestList[#^2 + Complex @@ c &, beginPoints, iteration]
           c := {
        -0.25, 0.5};
           plotRecurrencePoints[c, 0, 40]

观察4个不同点的收敛情况

In[]:= Show[Table[
           plotRecurrencePoints[c, 0, 10, "LineColor" -> Hue[Norm@c], 
           "PointColor" -> RGBColor[1, Norm@c, 0]], {
        c, {
        0.2 + 0.2 I, 
           0.3 - 0.3 I, -0.5 - 0.4 I, -0.5 + 0.5 I}}]]

可以使用动画观察两个点的迭代情况。

In[]:= exportAnimate[
           Table[GraphicsRow[{
        plotRecurrencePoints[.45 + .2 I, 0, n], 
           plotRecurrencePoints[.3 - .3 I, 0, n]}], {
        n, 1, 10}], url]

希尔伯特曲线是一种可以填充平面的曲线。我想以这个曲线作为点的轨迹，来演示不同点在平面上的迭代轨迹。

In[]:= Graphics[HilbertCurve[3]]

限定曲线的范围

In[]:= Graphics[HilbertCurve[3, DataRange -> {
        {
        0, 1}, {
        0, 1}}], 
           PlotRange -> 2, Axes -> True]

这个曲线给出的是一个 Line 对象，我们可以使用 BSplineFunction , 做1阶的参数化直线。

In[]:= BSplineFunction[HilbertCurve[5, DataRange -> {
        {
        -1, 1}, {
        -1, 1}}][[1]],
           SplineDegree -> 1];
           ParametricPlot[%[t], {
        t, 0, 1}, PlotPoints -> 400]

这样就可以方便地演示平面中各个点的迭代情况了。

In[]:= tempFun03 = 
           BSplineFunction[
           HilbertCurve[5, DataRange -> {
        {
        -1, 1}, {
        -1, 1}}][[1]], 
           SplineDegree -> 1];
    
    In[]:= exportAnimate[
           Table[plotRecurrencePoints[tempFun03[c], 0, 10], {
        c, 0, 1, 
           0.001}], url]

可以看到，有一些点经过迭代，会跑到很远的地方。有一些点则是仍然在我们可以看见的范围内。  
可以使用一个函数清除那些在我感兴趣的区域外面的点。

In[]:= c := {
        -0.25, 1};
           NestWhileList[#^2 + Complex @@ c &, 0, 
           Norm@# < 2 &(*这里的兴趣范围，指的是半径为2的一个圆*), {
        1, 2}, 40]
    
    Out[]= {
        0, -0.25 + 1. I, -1.1875 + 0.5 I, 0.910156 - 0.1875 I, 
           0.543228 + 0.658691 I, -0.388778 + 1.71564 I, -3.04227 - 0.334004 I, 
           8.89385 + 3.03226 I}

在列表上的最后一个点已经超出了2的范围，于是就不继续迭代下去了。

Raster 可以将值的大小转化为像素颜色，营造出一种等高线的感觉。

In[]:= Graphics@Raster@Rescale@Table[x^2 + y^2, {
        x, -3, 3}, {
        y, -3, 3}]

我们将迭代次数，也就是迭代列表的长度，作为灰度的依据。当列表的长度是40时，意味着40代的迭代下，点仍然在我们喜欢的区域里面。这时候Raster会将这个点变成白色。

In[]:= tempFun01[x_, y_] := 
           NestWhileList[#^2 + x + I y &, 0, Norm@# < 2 &, {
        1, 2}, 40]
           Graphics@Raster@
           Rescale@Table[
           Length@tempFun01[x, y], {
        y, -1, 1, 0.2}, {
        x, -1, 1, 0.2}]

重新调整一下作图范围和像素点密集度，我们就能得到 Mandelbrot 集合的一种图像了。

In[]:= Graphics@Raster@
           Rescale@Table[
           Length@NestWhileList[#^2 + x + I y &, 0, Norm@# < 2 &, {
        1, 2}, 
           40], {
        y, -1.3, 1.3, 0.01}, {
        x, -2.6, 1.3, 0.01}]

将长度取对数，有利于观察不同迭代次数之间的不同。

In[]:= Graphics@Raster@
           Rescale@Table[
           Log@Length@
           NestWhileList[#^2 + x + I y &, 0, Norm@# < 2 &, {
        1, 2}, 
           40], {
        y, -1.3, 1.3, 0.01}, {
        x, -2.6, 1.3, 0.01}]

将两者结合起来。发现白色点都是迭代以后仍然在白色区域内的。

In[]:= g1 = Raster@
           Rescale@Table[
           Length@NestWhileList[#^2 + x + I y &, 0, Norm@# < 2 &, {
        1, 2}, 
           10], {
        y, -1.3, 1.3, 0.05}, {
        x, -2.6, 1.3, 0.05}];
           g2 = Graphics[
           Translate[Scale[g1, (2 1.3)/Length@g1[[1]], {
        0, 0}], {
        -2.6, -1.3}]];
           tempFun02 = 
           BSplineFunction[
           HilbertCurve[5, DataRange -> {
        {
        -2.6, 1.3}, {
        -1.3, 1.3}}][[1]], 
           SplineDegree -> 1];
           
    
    In[]:= exportAnimate[
           Table[Show[g2, plotRecurrencePoints[tempFun02 [c], 0, 10], 
           PlotRange -> {
        {
        -2.6, 1.3}, {
        -1.3, 1.3}}], {
        c, 0, 1, 0.001}], url]

## Mandelbrot 集合的边界 ##

刚才看Raster的时候，提到过有点像登高线的感觉。其实确实是等高线。  
Mandelbrot 集合中，迭代一次产生的点，如果它在半径为2的圆的范围内，那是什么样子的呢？

In[]:= RegionPlot[
           ImplicitRegion[Norm@Nest[#^2 + x + I y &, 0, 1] <= 2, {
        x, y}], 
           Axes -> True, Frame -> False]

很正确，因为迭代一次就是一个圆。

In[]:= Nest[#^2 + p &, 0, 1] <= 2
    
    Out[]= p <= 2

迭代七次产生的点，如果它在半径为2的圆的范围内，那是什么样子的呢？

In[]:= RegionPlot[
           ImplicitRegion[Norm@Nest[#^2 + x + I y &, 0, 7] <= 2, {
        x, y}], 
           Axes -> True, Frame -> False]

这是区域，如果取边界的话，就可以画出等高线图

In[]:= ContourPlot[
           Norm@Nest[#^2 + x + I y &, 0, 7] == 2, {
        x, -2.6, 1.3}, {
        y, -1.3, 
           1.3}, AspectRatio -> Automatic]

一次画出迭代10次，每一次的等高线图。

In[]:= ContourPlot[
           Evaluate[Norm[#] == 2 & /@ 
           Drop[NestList[#^2 + x + I y &, 0, 10], 1]], {
        x, -2.6, 
           1.3}, {
        y, -1.3, 1.3}, AspectRatio -> Automatic]

在 Mathematica 中，使用内置函数就能画出 Mandelbrot 集合的图像。

In[]:= MandelbrotSetPlot[]

可以给定大小的区域画图，营造出一种放大的效果

In\[\]:= GraphicsGrid\[  
Table\[Show\[  
MandelbrotSetPlot\[\# + 1/a \{-1 - I, 1 + I\}, Frame -> False\],  
Graphics\[\{Red, Point\[ReIm\[\#\]\]\}\]\], \{a,  
PowerRange\[10^5\]\}\] & /@ \{-0.72905 + 0.2 I\}\]

迭代次数控制了画图的精度。在很多情况下，表面上是黑色的点。随着迭代次数的增加，都会得到别的颜色。

In\[\]:= exportAnimate\[  
Table\[MandelbrotSetPlot\[-0.72905 + 0.2 I + 1/100000 \{-1 - I, 1 + I\},  
MaxIterations -> a\], \{a, 100, 400, 5\}\], url\]