CantorSet.ma

Steven R. Dunbar
Department of Mathematics and Statistics
University of Nebraska-Lincoln

David Fowler
Department of Curriculum and Instruction
University of Nebraska-Lincoln

ã Copyright  Steven R. Dunbar, David Fowler, 1992, All rights reserved.  T

Implementation

set up the package context

BeginPackage["CantorSet`"]

usage messages for the exported functions and the context itself

CantorSet::usage = "CantorSet is a collection of basic 
routines for building and displaying approximations to 
the Cantor set and its generalizations"

intervals::usage = "intervals[n] returns the list of 
subintervals of {0,1} created by n iterations of the 
middle third removal process."

complementaryIntervals::usage = "complementaryIntervals[n] returns the list of subintervals removed in n iterations of the middle third removal process."

cantorSet::usage = "cantorSet[{a,b},r1,r2,n] returns
a list of intervals created by the retaining a portion 
r1 on the left of the interval {a,b}, a portion r2 on 
the right, and removing the middle (1-r1-r2) portion."

complementaryCantorSet::usage = 
"complementaryCantorSet[{a,b}, r1,r2,n] returns a list of
of intervals removed by stage n in the process of creating
cantorSet[{a,b},r1,r2,n]."

showIntervals::usage = "showIntervals[n] 
gives a graphical representation of the first n stages 
in the construction of the traditional Cantor set."

showCantorSet::usage = "showCantorSet[{{a,b}}, r1, r2 ,n] 
gives a graphical representation of the first n stages 
in the construction of the generalized Cantor set."

mapUnion::usage = "mapUnion[intervals_List, affinemaps_List]
returns the list which is the union of the images of each of
the affine maps from the argument affinemap applied to each 
of the intervals in the argument intervals."

showMapUnion::usage = "showMapUnion[intervals_List,
affinemaps_List, n] gives a graphical representation 
of the first n stages of the iterated function system
given by affinemaps applied to the intervals."

psi::usage = "psi[{a,b}, r1, r2, n] returns a Line graphics object which the stage n piecewise-linear approximation to the Cantor function on the genaralized Cantor set on interval {a,b} with preservation ratios r1,r2."

cantorFunction::usage = "cantorFunction[n] returns a Line graphics object which the stage n piecewise-linear approximation to the classical Cantor function."

set the private context

Begin["`Private`"]

definition of auxiliary functions

These  definitions are adapted from S. Wagon, Mathematica in Action, Section 4.2,  W. H. Freeman, 1991

removePortions[{a_,b_}, r1_, r2_] := 
	{{a,a+r1*(b-a)}, {b-r2*(b-a),b}} /; 
		((r1+r2<1) && NumberQ[N[a]] && NumberQ[N[b]])

removePortions[intervals_List, r1_, r2_] :=
	Flatten[Map[removePortions[# ,r1,r2] &, intervals],1]/;
	Length[intervals[[1]]] > 1

lines[n_Integer, l_List] :=
    Map[Line[{{#[[1]], n+.5}, {#[[2]], n+.5}}] &,l];

showStages[stage_List] := 
Module[ {level},
    level = Length[stage]-1;
	Show[
		Graphics[
    		Map[lines[level--,#] &,
    			stage
         	]
        ],
    Axes->Automatic,
    AxesOrigin->{0,0},
    Ticks->{Automatic, None}
    ]
]

psinodes[interval_, r1_, r2_, n_] := 
Module[ {ci = complementaryCantorSet[interval, r1,r2,n]},
	nodepts = Flatten[{interval[[1]],ci,interval[[2]]}];
    heights = Flatten[{0,
         			    Table[{j*2^(-n), j*2^(-n)}, 
         				{j, Length[ci]}
         			  ],
         		      1
         		     }
         	   ];
	Transpose[ {nodepts, heights}]
]

definition of the exported functions

cantorSet[interval_, r1_, r2_, n_] := 
    cantorSet[interval, r1, r2, n] =
       removePortions[cantorSet[interval,r1,r2,n-1], r1, r2]

cantorSet[interval_,r1_,r2_,1] = 
    	removePortions[interval,r1,r2];

complementaryCantorSet[interval_, r1_, r2_, n_] :=
Partition[ Drop[Rest[Flatten[
cantorSet[interval, r1,r2,n]]],-1],2]

intervals[n_] := cantorSet[{0,1}, 1/3,1/3,n]

complementaryIntervals[n_] :=
 Partition[ Drop[Rest[Flatten[intervals[n]]], -1],2]

showCantorSet[intervals_List, r1_, r2_, n_] := 
showStages[
	NestList[
		removePortions[#, r1,r2] &,
		intervals, n]]

showIntervals[n_] := showCantorSet[{{0,1}}, 1/3, 1/3,n]

mapUnion[interval_List, affinemap_List] :=
Apply[
	Union,
	Table[ 
		Map[
			affinemap[[i,1]] + #*affinemap[[i,2]] &, 
			interval,
			{2}],
		{i,Length[affinemap]}]]

showMapUnion[interval_List, affinemap_List, n_] :=
	showStages[
		NestList[
			mapUnion[#, affinemap] &,
			interval,
			n
		]
	]

psi[interval_, r1_, r2_, n_] := 
	Line[psinodes[interval, r1, r2, n]]

cantorFunction[n_] := psi[{0,1}, 1/3,1/3, n]

epilog

End[]	(* end the private context *)

Protect[intervals, complementaryIntervals, showCantorSet, showIntervals, mapUnion, showMapUnion, psi, cantorFunction]

EndPackage[] 	(* end the package context *)