Wolfram mathematica 如何在mathematica中生成平面康托集的图

我想知道是否有人能帮我用Mathematica在飞机上画出这张图。这是链接到的

非常感谢

编辑

我真的想要这样的东西：

---

以下是一种简单且可能不是非常优化的方式，用于为以下对象再现图形：

为了使用相同的替换规则，我们在特定级别获取结果，例如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;

其他一切都一样：

---

Once可以使用以下方法。定义康托函数：

cantorF[r:(0|1)] = r;
cantorF[r_Rational /; 0 < r < 1] := 
 Module[{digs, scale}, {digs, scale} = RealDigits[r, 3];
  If[! FreeQ[digs, 1], 
   digs = Append[TakeWhile[Most[digs]~Join~Last[digs], # != 1 &], 1];];
  FromDigits[{digs, scale}, 2]]

---

我喜欢递归函数，所以

cantor[size_, n_][pt_] :=
  With[{s = size/3, ct = cantor[size/3, n - 1]},
    {ct[pt], ct[pt + {2 s, 0}], ct[pt + {0, 2 s}], ct[pt + {2 s, 2 s}]}
  ]

cantor[size_, 0][pt_] := Rectangle[pt, pt + {size, size}]

drawCantor[n_] := Graphics[cantor[1, n][{0, 0}]]

drawCantor[5]

---

说明：

size

是集合所适合的正方形的边长

pt

是它左下角的

{x，y}

坐标。

+1，谢谢。我真的想有一个情节作为我在这里附加的。你能帮个忙吗？像这样的情节似乎更难拍。谢谢。我需要一些解释。首先，我认为

np=n-.1

应该是

np=n-1

，不是吗？只是对为什么代码仍然产生正确的结果感到困惑？还有，这一行如何

cantorRule={CanD[x，y，z]：>（CanD[x，z]/.cantorRule），{a，b}:>与[{d=（b-a）/3}，CanD@@NestList[#+d&，{a，a+d}，2]}？我不能完全理解…@QiangLi:np=n-.1

只是为了在第一张图像中获得正确的y轴间距。这些术语在第二张图片中被扔掉了，第三张图片使用了不同的规则。@QiangLi:至于最后的

cantorRule

，它有两个功能。第二项取一对x坐标并返回一个序列，该序列将其分成3个相等的部分。这些用于绘制空正方形。第一条规则取这三个部分，然后扔掉中间项——这就是阻止整个事物被正方形均匀填充的原因。请注意，在

Graphics

命令中，在绘制最终填充的正方形时，我必须手动扔掉中间项。@QiangLi:我修改了代码，使其更清晰、更灵活。漂亮、干净+1！使用（）也相当简单。

With[{k = 4}, 
  Outer[Times, #, #] &[
   Table[(cantorF[(n + 1/2)/3^k] - cantorF[(n)/3^k]), {n, 0, 
     3^k - 1}]]] // ArrayPlot

cantor[size_, n_][pt_] :=
  With[{s = size/3, ct = cantor[size/3, n - 1]},
    {ct[pt], ct[pt + {2 s, 0}], ct[pt + {0, 2 s}], ct[pt + {2 s, 2 s}]}
  ]

cantor[size_, 0][pt_] := Rectangle[pt, pt + {size, size}]

drawCantor[n_] := Graphics[cantor[1, n][{0, 0}]]

drawCantor[5]