CHAPTER 15, Substitutions.

15.1 Substitution Sequences

We look at substitutions and the fractals that they generate.

15.2 Dragon Curves.

The following is the dragon curve obtained from the paperfolding sequence :
  001001110011011 The substitution used is θ(0)=01, θ(1)=21, θ(2)=23, θ(3)=03

a="0";
    b="01";
    c="1";
    d="21";
    e="2";
    f="23";
    g="3";
    h="03";


    st1="0";
    num=Input["Enter Number of iterations for sequence (no more than 15): "];
    Substseq=StringReplace[st1,{a->b,c->d,e->f,g->h}];

    Do[Substseq=StringReplace[Substseq,{a->b,c->d,e->f,g->h}],{i,num-1}]
    stringlen=StringLength[Substseq];
    
    xtab=Normal[SparseArray[{i_->0},stringlen]];
    ytab=Normal[SparseArray[{i_->0},stringlen]];
    y=0;
    x=0;

    Do[
     kth = StringTake[Substseq,{i}];
     kth=ToExpression[kth];
     If[kth==0,x = x + 1;];
     If[kth==1,y=y+1];
     If[kth==2,x=x-1];
     If[kth==3,y=y-1];
     xtab=ReplacePart[xtab,x,i];
     ytab=ReplacePart[ytab,y,i], {i,stringlen}]
Print[Substseq"Is the substitution sequence of length ",num," arisng from the substitution
θ(0)=01, θ(1)=21, θ(2)=23, θ(3)=03"]
Print["Dragon Curve Produced by ",num, " iterations:"]
Table[{xtab[[i]],ytab[[i]]},{i,stringlen}];
ListPlot[%,Joined->True,Axes->False, AspectRatio->Automatic]

15.3 The Positive Paper Folding Substitution.

The substitution used in this example is θ (0) = 20, θ (1) = 21, θ (2) = 30, θ (3) = 31

a="0";
    b="20";
    c="1";
    d="21";
    e="2";
    f="30";
    g="3";
    h="31";


    st1="0";
    num=Input["Enter Number of iterations for sequence (no more than 15): "];
    Substseq=StringReplace[st1,{a->b,c->d,e->f,g->h}];

    Do[Substseq=StringReplace[Substseq,{a->b,c->d,e->f,g->h}],{i,num-1}]
    stringlen=StringLength[Substseq];
    
    
Print[Substseq"Is the substitution sequence of length ",num," arisng from the substitution
θ(0)=20, θ(1)=21, θ(2)=30, θ(3)=31"]

15.4 The Morse Substitution

The substitution used in this example is θ (0) = 01, θ (1) = 10

a="0";
    b="01";
    c="1";
    d="10";
   


    st1="0";
    num=Input["Enter Number of iterations for sequence (no more than 15): "];
    Substseq=StringReplace[st1,{a->b,c->d}];

    Do[Substseq=StringReplace[Substseq,{a->b,c->d}],{i,num-1}]
    stringlen=StringLength[Substseq];
    
Print[Substseq"Is the substitution sequence of length ",num," arisng from the substitution
θ(0)=01, θ(1)=10"]

Mathematica also has a built in command that gives as output the Morse substitution.

Table[ThueMorse[n],{n,0,40}]

15.5 A 3-Symbol Version of the Morse Substitution

The substitution used in this example is θ (0) = 010, θ (1) = 121, θ (2) = 202

a="0";
    b="010";
    c="1";
    d="121";
    e="2";
    f="202";
   


    st1="0";
    num=Input["Enter Number of iterations for sequence (no more than 15): "];
    Substseq=StringReplace[st1,{a->b,c->d,e->f}];

    Do[Substseq=StringReplace[Substseq,{a->b,c->d,e->f}],{i,num-1}]
    stringlen=StringLength[Substseq];
    
Print[Substseq"Is the substitution sequence of length ",num," arisng from the substitution
θ(0)=010, θ(1)=121, θ(2)=202"]

15.6 The Rudin-Shapiro Substitution

The substitution used in this example is θ (0) = 02, θ (1) = 32, θ (2) = 01, θ (3) = 31

a="0";
    b="02";
    c="1";
    d="32";
    e="2";
    f="01";
    g="3";
    h="31";


    st1="0";
    num=Input["Enter Number of iterations for sequence (no more than 15): "];
    Substseq=StringReplace[st1,{a->b,c->d,e->f,g->h}];

    Do[Substseq=StringReplace[Substseq,{a->b,c->d,e->f,g->h}],{i,num-1}]
    stringlen=StringLength[Substseq];
    
    
Print[Substseq"Is the substitution sequence of length ",num," arisng from the substitution
θ(0)=02, θ(1)=32, θ(2)=01, θ(3)=31"]

15.7 The Fibonacci Substitution.

The substitution used in this example is θ (0) = 01, θ (1) = 0

a="0";
    b="01";
    c="1";
    d="0";
   


    st1="0";
    num=Input["Enter Number of iterations for sequence (no more than 15): "];
    Substseq=StringReplace[st1,{a->b,c->d}];

    Do[Substseq=StringReplace[Substseq,{a->b,c->d}],{i,num-1}]
    stringlen=StringLength[Substseq];
    
Print[Substseq"Is the substitution sequence of length ",num," arisng from the substitution
θ(0)=01, θ(1)=0"]

a="11";
b="1101";

c="01";
d="1001";

e="10";
g="1100";

f="00";
h="1000";

fourcharseq="11";
num=Input["Enter Number of iterations for sequence (no more than 15): "];

Do[fourcharseq=StringReplace[fourcharseq,{a->b,c->d,e->g,f->h}],{i,num}]
stringlen=StringLength[fourcharseq];

xtab=Normal[SparseArray[{i_->0},stringlen+2]];
ytab=Normal[SparseArray[{i_->0},stringlen+2]];

y=0;
x=0;
xtab=ReplacePart[xtab,x,1];
ytab=ReplacePart[ytab,y,1];
y=0;
x=1
xtab=ReplacePart[xtab,x,2];
ytab=ReplacePart[ytab,y,2];

If[num≠0,Do[
kth=StringTake[fourcharseq,{i}];
kth=ToExpression[kth];
If[xtab[[i+1]]==xtab[[i]],
If[ytab[[i+1]]>ytab[[i]],
If[kth==1,x=x-1,x=x+1],
If[kth==1,x=x+1,x=x-1]
],
If[xtab[[i+1]]>xtab[[i]],
If[kth==1,y=y+1,y=y-1],
If[kth==1,y=y-1,y=y+1]
]
];
xtab=ReplacePart[xtab,x,i+2];
ytab=ReplacePart[ytab,y,i+2],{i,1,stringlen}]]

fourcharseq

15.8 Another Version of the Morse Substitution.

initialstring= "0";
numiterations=Input["Enter Number of iterations of Morse Sequence"];
morse=StringReplace[initialstring,{"0"->"01","1"->"10"}];
Do[morse=StringReplace[morse,{"0"->"01","1"->"10"}],{i,numiterations+1}]    

stringlen = StringLength[morse];


xtab=Normal[SparseArray[{i_->0},stringlen]];
ytab=Normal[SparseArray[{i_->0},stringlen]];
y =0;
x = 0;

Do[kth =StringTake[morse,{i}];
    kth=ToExpression[kth];                                                                          (*Finds element i in sequence*)
    w = (2Pi*i/3)+Pi/3;
    x = x + (-1)^(kth)Cos[w];
    y = y + (-1)^(kth)Sin[w];
    xtab=ReplacePart[xtab,x,i];
    ytab=ReplacePart[ytab,y,i],{i,stringlen}]

Table[{xtab[[i]],-ytab[[i]]},{i,stringlen}];
ListPlot[%,Joined->True,AspectRatio->Automatic,Axes->False]
Print["\n Iterations: ",numiterations, "     Root of Unity: ",rootunity, "      Quotient: ",quot]