How to create a planar cantor graph set in math

Question

I am wondering if anyone can help me build Cantor dust on an airplane in Mathematica. This is due to the Cantor set .

Thank you very much.

EDIT

I really wanted to have something like this:

Answer 1

Here's a naive and probably not very optimized way to play graphics for the triple assembly of a set of cantors :

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

To make Cantor dust using the same replacement rules, we take the result at a certain level, for example. 4:

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

and take tuples from it

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

Then we just build the rectangles

 Graphics[Rectangle @@@ dust4] 

---

Edit: Cantor dust + squares

Changed specifications → New, but similar, solution (still not optimized).
Set n as a positive integer and select any subset 1, ..., n, then

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

Here are the graphics for

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

and everything else:

Answer 2

You can use the following approach. Define the cantor function:

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

Then form the dust by calculating the differences F[n/3^k]-F[(n+1/2)/3^k] :

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

Answer 3

I like recursive functions, so

 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] 

Explanation: size - the length of the edge of the square into which the set belongs. pt are the coordinates {x,y} lower left corner.