The Cantor Set, Real and Complex

Code for Chapter Opening Art

.  The Real Cantor Set

spawn[{a_Rational,b_Rational}]:=With[{w=(b-a)/3},{{a-2 w,a-w},{b+w,b+2 w}}]
spawn[{(1/3),(2/3)}]

spawn[intervals_]:=Map[spawn,intervals]

spawn[spawn[{(1/3),(2/3)}]]

removed=NestList[spawn,{(1/3),(2/3)},3]

BaseForm[N[removed],3]

Cases[removed,_Rational,3]

n=5; removed = NestList[spawn,{1/3,2/3},n];
Graphics[{
	Table[{th=(5-(4-0.4) (depth-1)/n)/20;
	(Rectangle[{#[[1]],n-depth-th},{#[[2]],n-depth+th}]&)/@ 
   Partition[{0,1}⋃Cases[removed,_Rational,depth],2]},
	 {depth,n}]},
	FrameTicks->{({#,BaseForm[#,3]} &) /@( Range[0.,1,1/9]),None,None,None},
	Frame->True,PlotRange->{-1,n}, AspectRatio->1/4,GridLines->{Range[0,1,1/9],{}}]

.  The Cantor Function

spawn[{a_Rational,b_Rational}]:=Module[{w=((b-a)/3)},{{a-2 w,a-w},{b+w,b+2 w}}]
spawn[intervals_]:=spawn/@intervals
f[0]=0;
f[x_]:=(1/2) f[3 x]/;x≤(1/3)
f[x_]:=1-f[1-x]/;x≥(2/3)
CantorFunction[n_]:=With[{intervalEnds=
Flatten[{0,1}⋃Cases[NestList[spawn,{(1/3),(2/3)},n],_Rational,∞]]},
Graphics[{Thickness[0.006],
Line[Transpose[{intervalEnds,f/@intervalEnds}]]},
Frame->True,FrameTicks->{Range[(1/9),1,(1/9)],Range[(1/4),1,(1/4)],None,None}]];

CantorFunction[8]

.  Complex Cantor Sets

complexTicks[s_]:=Transpose[{s,s I}];

reim=Compile[{{z,_Complex,1}},Transpose[{Re[z],Im[z]}]];
reim[{1,I,2-I}]

ComplexBase[b_,depth_, opts___]:=Graphics[Point[Tuples[{0,1},depth] .( reim[ (b^(Range[depth]))])],opts,PlotRange->All,Frame->True,FrameTicks->{Range[-2,2],complexTicks[Range[-2,2]],None,None}]

GraphicsGrid[Partition[Table[ComplexBase[b,17],{b,{0.931 I,0.8+0.2 I,0.65+0.3 I,0.5+0.5 I,0.697 (E^((2 I π)/5)),0.2+0.6 I}}],2]]

Manipulate[ComplexBase[p[[1]]+p[[2]] I,depth,PlotRange->-2,PlotRangeClipping->True,PlotLabel->StringForm["`` + `` I",p[[1]],p[[2]]],Epilog->{White,PointSize[.03],Point[p],Locator[p,Appearance->Large]}],{{p,{0.6,0.3}},Locator},{{depth,12},1,15,1}]

Manipulate[Show[
ComplexBase[Complex@@If[Norm[p]>1,Normalize,Identity][p],depth,PlotRange->-2,PlotLabel->StringForm["`` ``  `` I",p[[1]],If[p[[2]]>0,"+","-"],Abs[p[[2]]]]],Graphics[{Green,PointSize[0.04],Point[If[Norm[p]>1,Normalize,Identity][p]],Locator[If[Norm[p]>1,Normalize,Identity][p],Appearance->Large],{Red,Thickness[0.004],Circle[{0,0},#]&/@{1,(1/2),((Sqrt[2])/2) }}}], PlotRangeClipping->True],{{p,{0.5,0.5}},Locator,Appearance->None},{{depth,13},1,15,1, SetterBar}]