如何在mathematica中生成平面Cantor集的图

Qia*_* Li 4 wolfram-mathematica

我想知道是否有人可以帮我在Mathematica的飞机上绘制康托尔灰尘.这与康托尔集相关联.

非常感谢.

编辑

我其实想要这样的东西:

在此输入图像描述

Sim*_*mon 5

这是一种天真的,可能不是非常优化的方式来再现三元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)

和其他一切相同:

在此输入图像描述