Qia*_* Li 4 wolfram-mathematica
我想知道是否有人可以帮我在Mathematica的飞机上绘制康托尔灰尘.这与康托尔集相关联.
非常感谢.
编辑
我其实想要这样的东西:
这是一种天真的,可能不是非常优化的方式来再现三元Cantor集结构的图形:
cantorRule = Line[{{a_, n_}, {b_, n_}}] :>
With[{d = b - a, np = n - .1},
{Line[{{a, np}, {a + d/3, np}}], Line[{{b - d/3, np}, {b, np}}]}]
Graphics[{CapForm["Butt"], Thickness[.05],
Flatten@NestList[#/.cantorRule&, Line[{{0., 0}, {1., 0}}], 6]}]
Run Code Online (Sandbox Code Playgroud)
为了使用相同的替换规则制作Cantor粉尘,我们将结果取特定级别,例如4:
dust4=Flatten@Nest[#/.cantorRule&,Line[{{0.,0},{1.,0}}],4]/.Line[{{a_,_},{b_,_}}]:>{a,b}
Run Code Online (Sandbox Code Playgroud)
并采取它的元组
dust4 = Transpose /@ Tuples[dust4, 2];
Run Code Online (Sandbox Code Playgroud)
然后我们只绘制矩形
Graphics[Rectangle @@@ dust4]
Run Code Online (Sandbox Code Playgroud)
更改了规格 - >新的,但类似的解决方案(仍未优化).
将n设置为正整数,然后选择1,...,n的任何子集
n = 3; choice = {1, 3};
CanDChoice = c:CanD[__]/;Length[c]===n :> CanD[c[[choice]]];
splitRange = {a_, b_} :> With[{d = (b - a + 0.)/n},
CanD@@NestList[# + d &, {a, a + d}, n - 1]];
cantLevToRect[lev_]:=Rectangle@@@(Transpose/@Tuples[{lev}/.CanD->Sequence,2])
dust = NestList[# /. CanDChoice /. splitRange &, {0, 1}, 4] // Rest;
Graphics[{FaceForm[LightGray], EdgeForm[Black],
Table[cantLevToRect[lev], {lev, Most@dust}],
FaceForm[Black], cantLevToRect[Last@dust /. CanDChoice]}]
Run Code Online (Sandbox Code Playgroud)
这是图形
n = 7; choice = {1, 2, 4, 6, 7};
dust = NestList[# /. CanDChoice /. splitRange &, {0, 1}, 2] // Rest;
Run Code Online (Sandbox Code Playgroud)
和其他一切相同: