mathematica 变分「举例说明分型中的数学美」

大家好，mathematica 变分「举例说明分型中的数学美」很多人还不知道，现在让我们一起来看看吧！

分形是数学领域的新方法、新理论，分形艺术呈现出来数学美是极致的、奇幻的，令人着迷、叹为观止。下面分享几个简单的分形程序，可以用Mathematica运行。

参考网址：https://mathematica.stackexchange.com/questions/113719/make-a-fractal-like-dot-animation

(*parameters*)innerradius = 20;outerradius = 23;numvertices = 12;xrange = {-100, 100};yrange = {-100, 100};numframes = 150;colour = Black;finalangle =720 Degree;(*must be a multiple of 360 Degree/numvertices*)blurring = 10;halfangleadjust = 14/10;(*secondary stuff*)middleradius = (outerradius innerradius)/2;enlargementfactor = 2 outerradius/(outerradius - innerradius);initialcenter = {0, -middleradius*enlargementfactor};vertices = CirclePoints[ initialcenter, {middleradius*enlargementfactor, 90 Degree},numvertices];annuli[innerrad_] := Annulus[#, {innerrad, outerradius}] & /@ vertices;(*transformations*)translationsteps = Table[{0, middleradius*enlargementfactor} x, {x, 0, 1, 1/numframes}];shrinkingsteps = Subpide[1, 1/enlargementfactor, numframes];rotationsteps = Table[finalangle*x^4, {x, 0, 1, 1/numframes}];ingrowthsteps = Table[innerradius*x^10, {x, 0, 1, 1/numframes}];(*faux motion blur*)opacitysteps = Abs[Abs@Subpide[-1, 1, blurring] - 1];halfanglesteps = Table[halfangleadjust (360 Degree/numvertices/2) x^5, {x, 0, 1, 1/numframes}];(*construction*)frames = Table[ Module[{centre, innerrad, blurringsteps, composite}, centre = TranslationTransform[translationsteps[[n]]]@initialcenter;innerrad = innerradius - ingrowthsteps[[n]];blurringsteps =Subpide[-halfanglesteps[[n]], halfanglesteps[[n]], blurring];composite =Composition[Rotate[#, -rotationsteps[[n]], centre] &,Scale[#, shrinkingsteps[[n]], centre] &,Translate[#, translationsteps[[n]]] &]@annuli[If[innerrad == 0, 1/1000, innerrad]];Graphics[{MapThread[{Opacity[#1, colour],Rotate[composite, #2, centre]} &, {opacitysteps, blurringsteps}]}, ImageSize -> {500, 500},Background -> GrayLevel[95/100],PlotRange -> {xrange, yrange}]], {n, 1, numframes 1}];ListAnimate[frames]方块

参考网址：https://mathematica.stackexchange.com/questions/243948/the-correct-way-to-draw-this-fractal

replace[square[{p1_, p2_, p3_, p4_}, 0]] := {square[{p1 (p1 - p3)/2, p1 (p1 - p4)/2, p1,p1 (p1 - p2)/2}, 1],square[{p2 (p2 - p3)/2, p2 (p2 - p4)/2, p2 (p2 - p1)/2, p2}, 2], square[{p3, p3 (p3 - p4)/2, p3 (p3 - p1)/2,p3 (p3 - p2)/2}, 3],square[{p4 (p4 - p3)/2, p4, p4 (p4 - p1)/2, p4 (p4 - p2)/2}, 4]};replace[square[{p1_, p2_, p3_, p4_}, 1]] := {square[{p1 (p1 - p3)/2, p1 (p1 - p4)/2, p1,p1 (p1 - p2)/2}, 1],square[{p2 (p2 - p3)/2, p2 (p2 - p4)/2, p2 (p2 - p1)/2, p2}, 2], square[{p4 (p4 - p3)/2, p4, p4 (p4 - p1)/2,p4 (p4 - p2)/2}, 4]};replace[square[{p1_, p2_, p3_, p4_}, 2]] := {square[{p1 (p1 - p3)/2, p1 (p1 - p4)/2, p1,p1 (p1 - p2)/2}, 1],square[{p2 (p2 - p3)/2, p2 (p2 - p4)/2, p2 (p2 - p1)/2, p2}, 2], square[{p3, p3 (p3 - p4)/2, p3 (p3 - p1)/2,p3 (p3 - p2)/2}, 3]};replace[square[{p1_, p2_, p3_, p4_}, 3]] := {square[{p2 (p2 - p3)/2, p2 (p2 - p4)/2,p2 (p2 - p1)/2, p2}, 2],square[{p3, p3 (p3 - p4)/2, p3 (p3 - p1)/2, p3 (p3 - p2)/2}, 3], square[{p4 (p4 - p3)/2, p4, p4 (p4 - p1)/2,p4 (p4 - p2)/2}, 4]};replace[square[{p1_, p2_, p3_, p4_}, 4]] := {square[{p1 (p1 - p3)/2, p1 (p1 - p4)/2, p1,p1 (p1 - p2)/2}, 1],square[{p3, p3 (p3 - p4)/2, p3 (p3 - p1)/2, p3 (p3 - p2)/2}, 3], square[{p4 (p4 - p3)/2, p4, p4 (p4 - p1)/2,p4 (p4 - p2)/2}, 4]};replace[squares_List] := replace /@ squares;atlist = AffineTransform[{{{1/2, 0}, {0, 1/2}}, #}] & /@Tuples[{-1, 1} 3/4, 2];addSquares[c_, Polygon[x_]] := {#, Polygon[#2@x]} & @@@DeleteCases[{c /. {Red -> Orange, Orange -> Red, Green -> Blue, Blue -> Green}, _}]@Thread[{{Red, Green, Blue, Orange}, atlist}];step = ReplaceAll[{c : Red | Green | Blue | Orange | Black,p_Polygon} :> {LightBlue, p, addSquares[c, p]}];square = Polygon[{{-1, -1}, {1, -1}, {1, 1}, {-1, 1}}/2];frames1 = Graphics[{EdgeForm[None], # /. _?ColorQ -> Blue},ImageSize -> {500, 500}, Background -> Yellow,PlotRange -> {{-3/2, 3/2}, {-3/2, 3/2}}] & /@NestList[step, {Black, square}, 7];ListAnimate[frames1]毕达哥拉斯树

参考网址：https : // demonstrations.wolfram.com/PythagorasTree/

Manipulate[ Graphics[{With[{pt = PythagorasTree[m, n]}, MapIndexed[{EdgeForm[{Thickness[0.005`],ColorData["Rainbow"][1 - First[#2]/Length[pt]]}],Opacity[0.7`],ColorData["Rainbow"][First[#2]/Length[pt]], #1} &, pt]]}, ImageSize -> {400, 400}, Background -> Append[ColorData["Rainbow"][0.5`], 0.3`]], {{m, 3,"steps"}, 1, 4, 1, Appearance -> "Labeled"}, {{n, 5.35`, "bend"}, 2, 10}, ControllerLinking -> True,Initialization :> {PythagorasTree[p1_, bend_ : 4] := Module[{p = 2^p1, xx = 0, yy = 0, scale = -1, f = N[[Pi]/bend], c, cc, ss, sxy, eps = 0.005`, a1, a2, b1, b2, c1, c2, d1, d2, x1 = 0, y1 = 0, u1 = 1, v1 = 0, q = 0, j = 1, k, m, xa, xb, ya, yb, done = False, tree = {}}, cc = Cos[f]; ss = Sin[f];a1 = -cc ss; a2 = cc^2; b1 = a1 a2; b2 = -a1 a2; c1 = b2;c2 = 1 - b1; d1 = 1 - a1; d2 = 1 - a2; s[0] = 1;tree = {{{xx, yy}, {xx scale, yy}, {xx scale,yy scale}, {xx, yy scale}, {xx, yy}}};While[! done, m = q j; x = u1 - x1; y = v1 - y1; xa = x1 a1 x - a2 y; ya = y1 a2 x a1 y; xb = x1 b1 x - b2 y; yb = y1 b2 x b1 y; x2[m] = x1 c1 x - c2 y; y2[m] = y1 c2 x c1 y; u2[m] = x1 d1 x - d2 y; v2[m] = y1 d2 x d1 y; sxy = x x y y; s[m] = 1; tree = Append[tree, {{xx scale x1, yy - scale y1}, {xx scale xa, yy - scale ya}, {xx scale xb, yy - scale yb}, {xx scale u1, yy - scale v1}, {xx scale u2[m], yy - scale v2[m]}, {xx scale x2[m], yy - scale y2[m]}, {xx scale x1, yy - scale y1}}]; x1 = xa; y1 = ya; u1 = xb; v1 = yb; If[m == p || sxy < eps, k = 1; While[s[m - k] == 0, k];If[m == k, done = True, q = m - k; x1 = x2[q]; y1 = y2[q]; u1 = u2[q]; v1 = v2[q]; s[q]--; j = 0;];]; j;];Polygon /@ tree], s[0] = 1, s[1] = 0, s[2] = 0, s[3] = 0,s[4] = 0, s[5] = 0, s[6] = 1, s[7] = 1, s[8] = 1, s[9] = 0,s[10] = 0, s[11] = 0, s[12] = 0, s[13] = 0, s[14] = 0, s[15] = 0,s[16] = 0, s[17] = 0, s[18] = 0, s[19] = 0, s[20] = 0, s[21] = 0,s[22] = 0, s[23] = 0, s[24] = 0, s[25] = 0, s[26] = 0, s[27] = 0,s[28] = 1, x = 0.010654221947971498`, y = 0.051107152272904105`,x2[1] = 1.1542701983296473`, x2[2] = 1.8629094961728099`,x2[3] = 1.9436436632245975`, x2[4] = 1.7756817561660512`,x2[5] = 1.6477826647559384`, x2[6] = 1.6208200710447829`,x2[7] = 1.6090666369561677`, x2[8] = 2.360499393879944`,x2[9] = 3.9775788829863594`, x2[10] = 3.4634421416292422`,x2[11] = 2.980393095825654`, x2[12] = 2.610681982706536`,x2[13] = 2.400964904332599`, x2[14] = 2.360290714388068`,x2[15] = 2.4652982208490455`, x2[16] = 2.6703657209515077`,x2[17] = 2.919964553446602`, x2[18] = 3.1605674072136023`,x2[19] = 3.3500252790632605`, x2[20] = 3.4631672821732753`,x2[21] = 3.4932916083405714`, x2[22] = 3.4500240599518386`,x2[23] = 3.354594915205548`, x2[24] = 3.23386349171239`,x2[25] = 3.114405749190393`, x2[26] = 3.017729427366142`,x2[27] = 2.9572822981277858`, x2[28] = 2.9374716653993986`,y2[1] = 0.7681986345559655`, y2[2] = 0.47161898642413663`,y2[3] = 0.05373081361794274`, y2[4] = -0.1117832790333746`,y2[5] = -0.0851203708840258`, y2[6] = -0.01794434934122939`,y2[7] = -0.19496902112622103`, y2[8] = -0.18702050200643816`,y2[9] = -0.9281079126843934`, y2[10] = -1.0900371859125595`,y2[11] = -1.0241272023384866`, y2[12] = -0.7838359504928709`,y2[13] = -0.44462765556322226`, y2[14] = -0.08623460643831671`,y2[15] = 0.22262965790051248`, y2[16] = 0.4347699410545492`,y2[17] = 0.5291821943357933`, y2[18] = 0.5101095419682204`,y2[19] = 0.40167548604844666`, y2[20] = 0.23987585550297724`,y2[21] = 0.06386751438194505`, y2[22] = -0.09173286577904782`,y2[23] = -0.20232227737452435`, y2[24] = -0.2559664200779013`,y2[25] = -0.2532660497097181`, y2[26] = -0.20496645602008426`,y2[27] = -0.1281558257780754`, y2[28] = -0.04200113435464113`,u2[1] = 1.4612344164428064`, u2[2] = 1.744399340463297`,u2[3] = 1.7766598774510955`, u2[4] = 1.709544038976814`,u2[5] = 1.6584368867039099`, u2[6] = 1.6476629135092924`,u2[7] = 1.6227003600324348`, u2[8] = 2.330382784738217`,u2[9] = 3.7027673362919584`, u2[10] = 3.3534110992927566`,u2[11] = 3.025178970846641`, u2[12] = 2.7739600384763383`,u2[13] = 2.631457152684142`, u2[14] = 2.6038190152024594`,u2[15] = 2.6751716814543256`, u2[16] = 2.814515175905868`,u2[17] = 2.9841177385426283`, u2[18] = 3.147607528012709`,u2[19] = 3.276344270313138`, u2[20] = 3.3532243321206865`,u2[21] = 3.3736938305738873`, u2[22] = 3.3442935044089666`,u2[23] = 3.2794493409270586`, u2[24] = 3.197412263227082`,u2[25] = 3.1162406525428406`, u2[26] = 3.0505490314571877`,u2[27] = 3.0094751693706647`, u2[28] = 2.9960138320534875`,v2[1] = 0.3069642181131591`, v2[2] = 0.18845406240364604`,v2[3] = 0.02147027663014406`, v2[4] = -0.04466744055909312`,v2[5] = -0.03401321861112169`, v2[6] = -0.0071703761466119925`,v2[7] = -0.17512142940947717`, v2[8] = -0.18657834819590458`,v2[9] = -0.630649906576872`, v2[10] = -0.7406809489133577`,v2[11] = -0.6958950738923708`, v2[12] = -0.5326170181225685`,v2[13] = -0.3021247697710258`, v2[14] = -0.05859646895663417`,v2[15] = 0.15127699164864616`, v2[16] = 0.29542644660300665`,v2[17] = 0.35957963169903306`, v2[18] = 0.3466197524981398`,v2[19] = 0.2729387437480174`, v2[20] = 0.16299579369542858`,v2[21] = 0.04339801592874437`, v2[22] = -0.0623325396141273`,v2[23] = -0.13747811389261638`, v2[24] = -0.17392934237792437`,v2[25] = -0.17209443902547683`, v2[26] = -0.13927483493443127`,v2[27] = -0.08708196369155245`, v2[28] = -0.028539797037463843`}]H树

参考网址：https : // demonstrations.wolfram.com/HFractal/

Manipulate[ trunk1 = Cylinder[{{0, 0, 0}, {0, 0, 10 ext}}, 1]; next = Cylinder[{{0, 0, 0}, {0, 0, 10aff}}, aff]; left1 = Translate[ Rotate[Rotate[next, Pi/2 - tilt, {1, 0, 0}], -twist, {0, 0,1}], {0, 0, 10 ext}]; right1 = Translate[ Rotate[Rotate[next, -Pi/2 tilt, {1, 0, 0}], -twist, {0, 0,1}], {0, 0, 10 ext}]; u1 = {left1, right1, trunk1};trunk2 = Cylinder[{{0, 0, 0}, {0, 0, 10 ext/aff}}, 1/aff]; left2 = Translate[ Rotate[Rotate[u1, Pi/2 - tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff}]; right2 = Translate[ Rotate[Rotate[u1, -Pi/2 tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext /aff}]; u2 = {trunk2, left2, right2};trunk3 = Cylinder[{{0, 0, 0}, {0, 0, 10 ext/aff^2}}, 1/aff^2]; left3 = Translate[ Rotate[Rotate[u2, Pi/2 - tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^2}]; right3 = Translate[ Rotate[Rotate[u2, -Pi/2 tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^2}]; u3 = {trunk3, left3, right3};trunk4 = Cylinder[{{0, 0, 0}, {0, 0, 10 ext/aff^3}}, 1/aff^3]; left4 = Translate[ Rotate[Rotate[u3, Pi/2 - tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^3}]; right4 = Translate[ Rotate[Rotate[u3, -Pi/2 tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^3}]; u4 = {trunk4, left4, right4};trunk5 = Cylinder[{{0, 0, 0}, {0, 0, 10 ext/aff^4}}, 1/aff^4]; left5 = Translate[ Rotate[Rotate[u4, Pi/2 - tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^4}]; right5 = Translate[ Rotate[Rotate[u4, -Pi/2 tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^4}]; u5 = {trunk5, left5, right5};trunk6 = Cylinder[{{0, 0, 0}, {0, 0, 10 ext/aff^5}}, 1/aff^5]; left6 = Translate[ Rotate[Rotate[u5, Pi/2 - tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^5}]; right6 = Translate[ Rotate[Rotate[u5, -Pi/2 tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^5}]; u6 = {trunk6, left6, right6};trunk7 = Cylinder[{{0, 0, 0}, {0, 0, 10 ext/aff^6}}, 1/aff^6]; left7 = Translate[ Rotate[Rotate[u6, Pi/2 - tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^6}]; right7 = Translate[ Rotate[Rotate[u6, -Pi/2 tilt, {1, 0, 0}], -twist, {0, 0, 1}], {0, 0, 10 ext/aff^6}];Graphics3D[{EdgeForm[], trunk7, left7, right7}, ImageSize -> {500, 500}, ViewPoint -> {10, 0, -2}, ViewAngle -> Pi/35, Boxed -> False, SphericalRegion -> True], {{tilt, 0, "tilt branch"}, 0, 0.9 Pi/2, ImageSize -> Tiny}, {{aff, 0.69, "growth rate"}, 0.6, 0.8, ImageSize -> Tiny}, {{ext, 1.1, "extend trunk"}, 0.4, 2, ImageSize -> Tiny}, {{twist, 0, "twist branch"}, 0, Pi/2, ImageSize -> Tiny}, ControlPlacement -> Left, TrackedSymbols -> {aff, ext, tilt, twist},ContinuousAction -> False, AutorunSequencing -> {1, 4}]