玩一玩简单的分形：巴恩斯利蕨

aoe1981

图如下：















原理如下：


（1）4个仿射变换，按指定概率使用：
仿射变换1：                                               
X1        =        0.85        0.04        X        +        0.08
Y1                -0.04        0.85        Y                0.18
                                               
仿射变换2：                                               
X1        =        0        0        X        +        0.5
Y1                0        0.16        Y                0
                                               
仿射变换3：                                               
X1        =        0.2        -0.26        X        +        0.4
Y1                0.23        0.22        Y                0.05
                                               
仿射变换4：                                               
X1        =        -0.15        0.28        X        +        0.58
Y1                0.26        0.24        Y                -0.09


（2）初始点：(X,Y)，变换点：(X1,Y1)；
（3）反复迭代：(X1,Y1)→(X,Y)，至指定点数。


代码如下：

1. Option Explicit
   
2. Public Sub FX_j()
   
3.     Dim X#, Y#, p, i&, j&, ds&, sjd#()
   
4.     Dim a1_11#, a1_12#, a1_21#, a1_22#, b1_11#, b1_21#
   
5.     Dim a2_11#, a2_12#, a2_21#, a2_22#, b2_11#, b2_21#
   
6.     Dim a3_11#, a3_12#, a3_21#, a3_22#, b3_11#, b3_21#
   
7.     Dim a4_11#, a4_12#, a4_21#, a4_22#, b4_11#, b4_21#
   
8.     a1_11 = Range("c2").Value
   
9.     a1_12 = Range("d2").Value
   
10.     a1_21 = Range("c3").Value
    
11.     a1_22 = Range("d3").Value
    
12.     b1_11 = Range("g2").Value
    
13.     b1_21 = Range("g3").Value
    
14.    
    
15.     a2_11 = Range("c6").Value
    
16.     a2_12 = Range("d6").Value
    
17.     a2_21 = Range("c7").Value
    
18.     a2_22 = Range("d7").Value
    
19.     b2_11 = Range("g6").Value
    
20.     b2_21 = Range("g7").Value
    
21.    
    
22.     a3_11 = Range("c10").Value
    
23.     a3_12 = Range("d10").Value
    
24.     a3_21 = Range("c11").Value
    
25.     a3_22 = Range("d11").Value
    
26.     b3_11 = Range("g10").Value
    
27.     b3_21 = Range("g11").Value
    
28.    
    
29.     a4_11 = Range("c14").Value
    
30.     a4_12 = Range("d14").Value
    
31.     a4_21 = Range("c15").Value
    
32.     a4_22 = Range("d15").Value
    
33.     b4_11 = Range("g14").Value
    
34.     b4_21 = Range("g15").Value
    
35.    
    
36.     Range("i2").Resize(1000000, 3).ClearContents
    
37.     p = Range("c18:c21").Value
    
38.     For i = UBound(p, 1) To LBound(p, 1) + 1 Step -1
    
39.         For j = 1 To i - 1
    
40.             p(i, 1) = p(i, 1) + p(j, 1)
    
41.         Next j
    
42.     Next i
    
43.    
    
44.     Randomize
    
45.     ds = Range("g17").Value
    
46.     X = Range("g19").Value
    
47.     Y = Range("g20").Value
    
48.     ReDim sjd#(1 To ds, 1 To 3)
    
49.     For i = 1 To ds
    
50.         Select Case Rnd()
    
51.         Case Is < p(1, 1)
    
52.             sjd(i, 1) = 1
    
53.             sjd(i, 2) = a1_11 * X + a1_12 * Y + b1_11
    
54.             sjd(i, 3) = a1_21 * X + a1_22 * Y + b1_21
    
55.         Case Is < p(2, 1)
    
56.             sjd(i, 1) = 2
    
57.             sjd(i, 2) = a2_11 * X + a2_12 * Y + b2_11
    
58.             sjd(i, 3) = a2_21 * X + a2_22 * Y + b2_21
    
59.         Case Is < p(3, 1)
    
60.             sjd(i, 1) = 3
    
61.             sjd(i, 2) = a3_11 * X + a3_12 * Y + b3_11
    
62.             sjd(i, 3) = a3_21 * X + a3_22 * Y + b3_21
    
63.         Case Is < p(4, 1)
    
64.             sjd(i, 1) = 4
    
65.             sjd(i, 2) = a4_11 * X + a4_12 * Y + b4_11
    
66.             sjd(i, 3) = a4_21 * X + a4_22 * Y + b4_21
    
67.         End Select
    
68.         X = sjd(i, 2)
    
69.         Y = sjd(i, 3)
    
70.     Next i
    
71.     Range("i2").Resize(ds, 3).Value = sjd
    
72. End Sub

复制代码

很简单，主要是变量占行多。

附件如下：
巴恩斯利蕨.zip (336.11 KB, 下载次数: 32)

2020-1-10 17:33 上传

点击文件名下载附件

其实，最近这一系列的主旨是：揭示“随机”与“混沌”的关系。对此，我只是模仿使用，不明深层数学原理。

larer

dongdonggege

老师，向你请教，你的每个图片的左边为什么都有3个点，是不是哪个数据点，画多了。
我用的数据画的时候，也有这三四个点，我是vba 其他方面的作图。
请老师看看是哪里的数组有问题，麻烦怎么修改，谢谢。

chis3

不懂數學
看不懂

aoe1981

dongdonggege 发表于 2020-3-23 09:55
老师，向你请教，你的每个图片的左边为什么都有3个点，是不是哪个数据点，画多了。
我用的数据画的时候， ...

那是初始点，以及最开始迭代出来的几个点……

规律性是在后面大量的迭代过程中展现出来的……

您可以试着把生成的数据中的前几个点删掉看看。

dongdonggege

谢谢老师！
我是搞ppt的，和excel有很多相同性。由于ppt没有单元格，所以我改成数组或直接赋值了。因此就出现了一些偏差，图形也有所变化。
下面是我改自你的程序，还是那个程序，变化不是太大，麻烦看下哪里改的有问题，应该怎么改，谢谢。

1. Option Explicit
   
2. Public Sub FX_j()
   
3.     'Dim X#, Y#, p, i&, j&, ds&, sjd#()
   
4.     Dim X#, Y#, i&, j&, ds&, sjd#()
   
5.     Dim a1_11#, a1_12#, a1_21#, a1_22#, b1_11#, b1_21#
   
6.     Dim a2_11#, a2_12#, a2_21#, a2_22#, b2_11#, b2_21#
   
7.     Dim a3_11#, a3_12#, a3_21#, a3_22#, b3_11#, b3_21#
   
8.     Dim a4_11#, a4_12#, a4_21#, a4_22#, b4_11#, b4_21#
   
9.     'a1_11 = Range("c2").Value
   
10.     'a1_12 = Range("d2").Value
    
11.     'a1_21 = Range("c3").Value
    
12.     'a1_22 = Range("d3").Value
    
13.     'b1_11 = Range("g2").Value
    
14.     'b1_21 = Range("g3").Value
    
15.    
    
16.     'a2_11 = Range("c6").Value
    
17.     'a2_12 = Range("d6").Value
    
18.     'a2_21 = Range("c7").Value
    
19.     'a2_22 = Range("d7").Value
    
20.     'b2_11 = Range("g6").Value
    
21.     'b2_21 = Range("g7").Value
    
22.    
    
23.     'a3_11 = Range("c10").Value
    
24.     'a3_12 = Range("d10").Value
    
25.     'a3_21 = Range("c11").Value
    
26.     'a3_22 = Range("d11").Value
    
27.     'b3_11 = Range("g10").Value
    
28.     'b3_21 = Range("g11").Value
    
29.    
    
30.     'a4_11 = Range("c14").Value
    
31.     'a4_12 = Range("d14").Value
    
32.     'a4_21 = Range("c15").Value
    
33.     'a4_22 = Range("d15").Value
    
34.     'b4_11 = Range("g14").Value
    
35.     'b4_21 = Range("g15").Value
    
36.     a1_11 = 0.85: a1_12 = 0.04: a1_21 = -0.04: a1_22 = 0.85: b1_11 = 0.08: b1_21 = 0.18
    
37.     a2_11 = 0: a2_12 = 0: a2_21 = 0: a2_22 = 0.16: b2_11 = 0.5: b2_21 = 0
    
38.     a3_11 = 0.2: a3_12 = -0.26: a3_21 = 0.23: a3_22 = 0.22: b3_11 = 0.44: b3_21 = 0.05
    
39.     a4_11 = -0.15: a4_12 = 0.28: a4_21 = 0.26: a4_22 = 0.24: b4_11 = 0.58: b4_21 = -0.09
    
40.    
    
41.     Range("i2").Resize(1000000, 3).ClearContents
    
42.     'p = Range("c18:c21").Value
    
43.     Dim p(4, 1) As Integer
    
44.     p(1, 1) = 0.739: p(2, 1) = 0.826: p(3, 1) = 0.817: p(4, 1) = 1
    
45.     For i = UBound(p, 1) To LBound(p, 1) + 1 Step -1
    
46.         For j = 1 To i - 1
    
47.             p(i, 1) = p(i, 1) + p(j, 1)
    
48.         Next j
    
49.     Next i
    
50.    
    
51.     Randomize
    
52.     'ds = Range("g17").Value
    
53.     'X = Range("g19").Value
    
54.     'Y = Range("g20").Value
    
55.     ds = 5000: X = 0: Y = 0
    
56.     ReDim sjd#(1 To ds, 1 To 3)
    
57.     For i = 1 To ds
    
58.         Select Case Rnd()
    
59.         Case Is < p(1, 1)
    
60.             sjd(i, 1) = 1
    
61.             sjd(i, 2) = a1_11 * X + a1_12 * Y + b1_11
    
62.             sjd(i, 3) = a1_21 * X + a1_22 * Y + b1_21
    
63.         Case Is < p(2, 1)
    
64.             sjd(i, 1) = 2
    
65.             sjd(i, 2) = a2_11 * X + a2_12 * Y + b2_11
    
66.             sjd(i, 3) = a2_21 * X + a2_22 * Y + b2_21
    
67.         Case Is < p(3, 1)
    
68.             sjd(i, 1) = 3
    
69.             sjd(i, 2) = a3_11 * X + a3_12 * Y + b3_11
    
70.             sjd(i, 3) = a3_21 * X + a3_22 * Y + b3_21
    
71.         Case Is < p(4, 1)
    
72.             sjd(i, 1) = 4
    
73.             sjd(i, 2) = a4_11 * X + a4_12 * Y + b4_11
    
74.             sjd(i, 3) = a4_21 * X + a4_22 * Y + b4_21
    
75.         End Select
    
76.         X = sjd(i, 2)
    
77.         Y = sjd(i, 3)
    
78.     Next i
    
79.     Range("i2").Resize(ds, 3).Value = sjd
    
80. End Sub

复制代码

麻烦你了！老师。