wolfram-mathematica - 如何在mathematica中生成平面康托图

Question

我想知道是否有人可以帮助我绘制 Cantor dust在 Mathematica 的飞机上。这链接到 Cantor set .

非常感谢。

编辑

我实际上想要这样的东西:

Answer 1

这是为 ternary Cantor set construction 再现图形的一种幼稚且可能不是很优化的方法。 :

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]}]

使 Cantor dust使用相同的替换规则，我们在特定级别获取结果，例如4:

dust4=Flatten@Nest[#/.cantorRule&,Line[{{0.,0},{1.,0}}],4]/.Line[{{a_,_},{b_,_}}]:>{a,b}

并取它的元组

dust4 = Transpose /@ Tuples[dust4, 2];

然后我们只绘制矩形

Graphics[Rectangle @@@ dust4]

编辑:康托尘+方块

更改规范 -> 新的但类似的解决方案(仍未优化)。
将 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]}]

这是图形

n = 7; choice = {1, 2, 4, 6, 7};
dust = NestList[# /. CanDChoice /. splitRange &, {0, 1}, 2] // Rest;

其他一切都一样: