An abelian square-free word over 4 letters
as a necklace design

Veikko Keränen, September 2004
Rovaniemi Polytechnic / pLab

Some preliminaries: parametric curves and elementary chain representations

\(\(Clear[x, y];\)
\)
x[t_] := Cos[t];
y[t_] := Sin[t];

circle = 
      ParametricPlot[{x[t], y[t]}, {t, 0, 2  Pi}, 
        PlotRange -> {{-1, 1}, {-1, 1}}, 
        AspectRatio -> 1]

Let's play with points:

xyPairs = Table[{x[t], y[t]} // N, {t, 0, 2  Pi, 2  Pi/8}]

myGraphics = 
      Graphics[{RGBColor[1, 0, 1], PointSize[0.1], 
          Point /@ xyPairs}]

Show[{circle, myGraphics}, 
      PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}, 
      AspectRatio -> 1]

Let's make it more colorful:

Length[xyPairs]

myColors := 
        Table[RGBColor[Random[], Random[], 
            Random[]], {Length[xyPairs]}];

myGraphics := 
      Graphics[{PointSize[0.1], 
          Thread[List[myColors, Point /@ xyPairs]]}]

Show[{circle, myGraphics}, 
      PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}, 
      AspectRatio -> 1]

Let's make it 3D:

\(\(Clear[x, y, z];\)
\)
x[t_] := Cos[t];
y[t_] := Sin[t];
z[t_] := t/10;

screwThread = 
      ParametricPlot3D[{x[t], y[t], z[t]}, {t, 0, 3*2  Pi}, 
        PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}, {0, 2}}, 
        AspectRatio -> 1]

xyzTriplets = 
        Table[{x[t], y[t], z[t]} // N, {t, 0, 6  Pi, 2  Pi/16}];

Length[xyzTriplets]

myColors := 
        Table[RGBColor[Random[], Random[], 
            Random[]], {Length[xyzTriplets]}];

myGraphics := 
      Graphics3D[{PointSize[0.05], 
          Thread[List[myColors, Point /@ xyzTriplets]]}]

Show[{screwThread, myGraphics}, 
      PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}, {0, 2}}, 
      AspectRatio -> 1, ViewPoint -> {1.5, -3, 1.5}]

Off[General::spell];
Off[General::spell1];

Abelian square-free endomorphism g85 over 4 letters:

\(cyclicPermutation = {"a" -> \ "b", "b" -> \ "c", "c" -> \ "d", "d" -> \ "a"};\)
\(g85a = "abcacdcbcdcadcdbdabacabadbabcbdbcbacbcdcacbabdabacadcbcdcacdbcbacbcdcacdcbdcdadbdcbca";\)
g85b = 
            StringReplace[g85a, cyclicPermutation];
g85c = 
            StringReplace[g85b, cyclicPermutation];
g85d = 
            StringReplace[g85c, cyclicPermutation];

\(\(\( (*\ 
      g98\ definition\ *) \)\(
\)\(
\)\(\(cyclicPermutation = {"a" -> \ "b", "b" -> \ "c", "c" -> \ "d", "d" -> \ "a"};\)

    \(ga = "abcacdcbcdcadbdcbdbabcbdcacbabdbabcabdadcdadbdcbdbabdbcbacbcdbabdcdbdcacdbcbacbcdcacdcbdcdadbdcbca";\)

    \(gb = StringReplace[ga, cyclicPermutation];\)

    \(gc = StringReplace[gb, cyclicPermutation];\)

    \(gd = 
        StringReplace[gc, 
          cyclicPermutation];\)


    \(g98a\  = \ ga;\)

    \(g98b\  = \ gd\ \  (*\ no\ mistake\ here\ *) ;\)

    \(g98c\  = \ gc;\)

    \(g98d\  = \ gb\ \ \  (*\ no\ mistake\ here\ *) ;\)\)\)\)

Clear[myColors]
myColors := 
        Characters[
            g85a] /. {"a" -> 
              RGBColor[1.000, 0.280, 0.710], "b" -> 
              RGBColor[0.100, 0.860, 0.150], "c" -> 
              RGBColor[1, 1, 0], "d" -> 
              RGBColor[0.500, 0.500, 1.000]};

\(\(Clear[x, y, z];\)
\)
x[t_] := 2  Cos[t];
y[t_] := 2  Sin[t];
z[t_] = 0;
tilt = ArcTan[3, 1];

?ArcTan

Clear[x3RotMat, y3RotMat, z3RotMat];
z3RotMat[φ_] := {{Cos[-φ], 
            Sin[-φ], 0}, {-Sin[-φ], 
            Cos[-φ], 0}, {0, 0, 1}};
y3RotMat[φ_] := {{Cos[-φ], 
            0, -Sin[-φ]}, {0, 1, 
            0}, {Sin[-φ], 0, 
            Cos[-φ]}};
x3RotMat[φ_] := {{1, 0, 0}, {0, Cos[-φ], 
            Sin[-φ]}, {0, -Sin[-φ], 
            Cos[-φ]}};

Clear[rotatePoints];
rotatePoints[t_] = 
        y3RotMat[-t/32] . (x3RotMat[tilt] . {x[t], y[t], z[t]}) // 
          N;

rotatedxyzTriplets = 
        Table[rotatePoints[t] + {0, 0, 0}, {t, 
            0, (2  Pi - 
                2  Pi/Length[myColors]), (2  Pi - 
                  2  Pi/Length[myColors])/(Length[myColors] - 
                  1)}];

Length[myColors]

myGraphics := 
      Graphics3D[{PointSize[0.03], 
          Thread[List[myColors, Point /@ rotatedxyzTriplets]]}]

Show[myGraphics, ViewPoint -> {3, 1, 0.2}, Axes -> True, 
      AxesLabel -> {"x", "y", "z"}]

Abelian square-free words  g85a  and  g85c  over 4 letters
– representation with spheres (pearls):

<< Graphics`ParametricPlot3D`

\(\(\(Clear[x, y, z];\)\(
\)
    \)\)
r = 0.05;
x[cp_] := Cos[cp] - 1;
y[cp_] := Sin[cp];
z[cp_] := 0/10;

Test with one sphere:

Clear[mySphere];
mySphere[cp_, ang_] := 
      ParametricPlot3D[
        y3RotMat[
              ang] . (z3RotMat[t] . {r*Cos[u], 0, r*Sin[u]} + {x[cp], 
                  y[cp], z[cp]}) // Evaluate, {t, 0, 2  Pi, 
          Pi/4}, {u, -Pi/2, Pi/2, Pi/4}, 
        DisplayFunction -> Identity]

Clear[g85cColors]
g85cColors := 
        Characters[
            g85c] /. {"a" -> 
              RGBColor[1.000, 0.280, 0.710], "b" -> 
              RGBColor[0.100, 0.860, 0.150], "c" -> 
              RGBColor[1, 1, 0], "d" -> 
              RGBColor[0.500, 0.500, 1.000]};

Clear[g85aColors]
g85aColors := 
        Characters[
            g85a] /. {"a" -> 
              RGBColor[1.000, 0.280, 0.710], "b" -> 
              RGBColor[0.100, 0.860, 0.150], "c" -> 
              RGBColor[1, 1, 0], "d" -> 
              RGBColor[0.500, 0.500, 1.000]};

Clear[myGraphics];
myGraphics[color_, ang_] := 
      Graphics3D[{EdgeForm[{GrayLevel[1], Thickness[0.001]}], 
          Thread[List[color, 
              Table[mySphere[n, ang][[1]], {n, 0, 2  Pi - 2  Pi/85, 
                  2  Pi/85}]]]}]

g85aAndg85c = 
      Show[{myGraphics[g85cColors, Pi/3], myGraphics[g85aColors, 2  Pi/3]}, 
        ViewPoint -> {-2.030, -2.707, 0.042}, 
        PlotRange -> {{-1.1, 1.1}, {-1.1, 1.1}, {-1.2 + 1.1, 
              1.2 + 0.8}}, Lighting -> False, Boxed -> False, 
        Axes -> False]

SetDirectory["E:\\Veikko\\_pLAB"];

Export["_chainsOfg85aAndg85c.jpeg", g85aAndg85c, "JPEG", 
        ImageSize -> 100*17,  
        ConversionOptions -> {"Quality"  -> 
              100}];

A smaller picture:

Export["chainsOfg85aAndg85c.jpeg", g85aAndg85c, "JPEG", 
        ImageSize -> 72*12];

Chain of pearls

<<Graphics`ParametricPlot3D`

Clear[x3RotMat, y3RotMat, z3RotMat];
z3RotMat[φ_] := {{Cos[-φ], 
            Sin[-φ], 0}, {-Sin[-φ], 
            Cos[-φ], 0}, {0, 0, 1}};
y3RotMat[φ_] := {{Cos[-φ], 
            0, -Sin[-φ]}, {0, 1, 
            0}, {Sin[-φ], 0, 
            Cos[-φ]}};
x3RotMat[φ_] := {{1, 0, 0}, {0, Cos[-φ], 
            Sin[-φ]}, {0, -Sin[-φ], 
            Cos[-φ]}};

Clear[x,y,z];

r = 0.06;
x[t_]:=2Cos[t];
y[t_]:=2Sin[t];
z[t_]:=t/(2Pi*8);

Clear[mySphere];
mySphere[cp_]:=ParametricPlot3D[
 (z3RotMat[t].{r*Cos[u],0,r*Sin[u]}+{x[cp],y[cp],z[cp]})//
  Evaluate,
 {t,0,2Pi,Pi/4},{u,-Pi/2,Pi/2,Pi/4},
 DisplayFunction->Identity]

string6times85 = 
      StringReplace["abcacd", {"a" -> g85a, "b" -> 
            g85b, "c" -> g85c, "d" -> g85d}]

Clear[myColors];
myColors := Characters[string6times85] /. 
 {"a"->RGBColor[1.000, 0.280, 0.710],
  "b"->RGBColor[0.100, 0.860, 0.150],
  "c"->RGBColor[1,1,0],
  "d"->RGBColor[0.500, 0.500, 1.000]};

mySpheres = Table[mySphere[cp][[1]],
         {cp,0,6(2Pi-2Pi/Length[myColors]),
           6(2Pi-2Pi/Length[myColors])/(Length[myColors]-1)}];

mySpheres[[1]] // Length

mySpheres[[1]]

ByteCount[mySpheres]

mySpheres//Length

Length[myColors]

Clear[rotateOnePolygon, 
        myObjectRotation];
rotateOnePolygon[xangle_, yangle_][polygon_] := 
        Polygon[(x3RotMat[xangle] . y3RotMat[yangle] . #) &   /@  
            polygon[[1]]];
myObjectRotation[xangle_, yangle_][
          listOfPolygons_] := rotateOnePolygon[xangle, 
                yangle][#] &  /@  listOfPolygons;

myObjectRotation[π/6, π/20][mySpheres[[1]]]

myRotatedSpheres  =  myObjectRotation[π/8 // N, π/16 // 
                  N][#] &  /@  mySpheres;

Clear[myGraphics];
myGraphics[color_] := Graphics3D[ 
 { EdgeForm[{GrayLevel[1],Thickness[0.0007]}], Thread[List[color, 
   myRotatedSpheres ]], Text["(abcacd)",{0,-1.5,1}] } ]

sixPoints = 
      Table[{x[t], y[t], z[t]} - {0, 0, 0.14}, {t, 0, 
            5*6 (2  Pi - 2  Pi/Length[myColors])/(Length[myColors] - 
                    1), 6 (2  Pi - 
                    2  Pi/Length[myColors])/(Length[myColors] - 1)}] // 
        N

Clear[myGraphics, rot];
rot[x_] := (x3RotMat[π/8] . y3RotMat[π/16]) . x // 
          N;
rot6points = (rot  /@  sixPoints);
\(myGraphics[color_] := 
      Graphics3D[{\ EdgeForm[{GrayLevel[1], Thickness[0.0007]}], 
          Thread[List[color, myRotatedSpheres]], 
          Text[\*""\!\(g\_85\)(abcacd)"", {0, \(-1.5\), 1.3}, 
            TextStyle -> {FontFamily -> "Times", 
                FontSlant -> "Italic", 
                FontSize -> 24}]\ , 
Text["a", 
            rot6points[\([1]\)]]\ , Text["b", rot6points[\([2]\)]]\ , 
          Text["c", rot6points[\([3]\)]]\ , 
          Text["a", rot6points[\([4]\)]]\ , 
          Text["c", rot6points[\([5]\)]]\ , 
          Text["d", rot6points[\([6]\)]]\ }\ ]\)

chainOf6times85spheres = Show[myGraphics[myColors], 
     PlotRange->{{-2,2.2},{-2.2,2},{-1.7,2}},
     AspectRatio->0.9,
     ViewPoint->{2.5, 0.975, 0.7}, Lighting->False,
     TextStyle->{FontFamily->"Times",FontSlant->"Italic", FontSize->14},
     Boxed->False]

SetDirectory["E:\\Veikko\\_pLAB"];

Export["_chain6Times85_Spheres_WhiteLines.jpeg", 
        chainOf6times85spheres, "JPEG", ImageSize -> 100*17,  
        ConversionOptions -> {"Quality"  -> 
              100}];

A smaller picture:

Export["chain6Times85_Spheres_WhiteLines.jpeg", 
        chainOf6times85spheres, ImageSize -> 72*12];

Chain of polyhedra

<<Graphics`ParametricPlot3D`

<<Graphics`Polyhedra`

aCol=RGBColor[1.00, 0.28, 0.71];
bCol=RGBColor[0.10, 0.86, 0.15];
cCol=RGBColor[1,1,0];
dCol=RGBColor[0.50, 0.50, 1.00];

aPolyhedron = Polyhedron[Dodecahedron]

aPolyhedron[[1]]

Show[aPolyhedron]

Clear[aPh];
\(aPh[grl_] := 
      Graphics3D[
\ \ \ \ \ {EdgeForm[{GrayLevel[grl], \ Thickness[0.001]}], 
          aCol, 
\ \ \ \ \ \ \ \ \ \ \ Dodecahedron[\ ]}]\)

Show[aPh[1], Lighting -> False]

bPolyhedron = Stellate[Polyhedron[Octahedron]]

Clear[bPh];
\(bPh[grl_] := 
      Graphics3D[
\ \ \ \ \ {EdgeForm[{GrayLevel[grl], \ Thickness[0.001]}], 
          bCol, 
\ \ \ \ \ \ \ \ \ \ \ \(Stellate[
              Polyhedron[Octahedron]]\)[\([1]\)]}]\)

Show[bPh[1], Lighting -> False]

cPolyhedron = Polyhedron[Octahedron]

Clear[cPh];
\(cPh[grl_] := 
      Graphics3D[
\ \ \ \ \ {EdgeForm[{GrayLevel[grl], \ Thickness[0.001]}], 
          cCol, 
\ \ \ \ \ \ \ \ \ \ \ Octahedron[\ ]}]\)

Show[cPh[1], Lighting -> False]

dPolyhedron = Polyhedron[Tetrahedron]

Polyhedron[Tetrahedron][[1]]

Clear[dPh];
\(dPh[
        grl_] := 
Graphics3D[
\ \ \ \ \ {EdgeForm[{GrayLevel[grl], \ Thickness[0.001]}], 
          dCol, 
\ \ \ \ \ \ \ \ \ \ \ Tetrahedron[\ ]}]\)

Show[dPh[1], Lighting -> False]

Show[GraphicsArray[{{aPh[1], bPh[1]}, {cPh[1], dPh[1]}}]]

aPh[
          1][[1]][[1]]   
aPh[1][[1]][[2]]   
aPh[
          1][[1]][[3]]

Adjust (scale and rotate) the polyhedra properly:

Clear[aPhAd, bPhAd, cPhAd, dPhAd];
aPhAd[grl_] := 
        aPh[grl]  /. 
          Polygon[xyz_] :> 
            Polygon[Map[1.3*# &, xyz]];
bPhAd[grl_] := bPh[grl];
cPhAd[grl_] := cPh[grl];
dPhAd[
          grl_] := (dPh[grl]  /. 
              Polygon[xyz_] :> 
                Polygon[Map[(1.1*# - {0, 0,  .3}) &, xyz]])  /. 
          Polygon[xyz_] :> 
            Polygon[Map[(z3RotMat[π] . #) &, xyz]];

Just for viewing the size of each polyheron:

Clear[aPhAdView, bPhAdView, cPhAdView, 
        dPhAdView];
aPhAdView[grl_] := aPhAd [grl]
bPhAdView[grl_] := 
        bPhAd [grl] /. 
          Polygon[xyz_] :> 
            Polygon[Map[(# + {3, 0, 0}) &, 
                xyz]];
cPhAdView[grl_] := 
        cPhAd [grl] /. 
          Polygon[xyz_] :> 
            Polygon[Map[(# + {6, 0, 0}) &, 
                xyz]];
dPhAdView[grl_] := 
        dPhAd [grl] /. 
          Polygon[xyz_] :> 
            Polygon[Map[(# + {9, 0, 0}) &, xyz]];

Show[aPhAdView[1], bPhAdView[1], cPhAdView[1], dPhAdView[1], 
      ViewPoint -> {2, -5,  .5}, Lighting -> False]

Show[aPhAdView[0], bPhAdView[0], cPhAdView[0], dPhAdView[0], 
      ViewPoint -> {2, -5,  .5}, Lighting -> False]

Show[aPhAdView[ .5], bPhAdView[ .5], cPhAdView[ .5], dPhAdView[ .5], 
      ViewPoint -> {2, -5,  .5}, Lighting -> False]

Clear[x3RotMat, y3RotMat, z3RotMat];
z3RotMat[φ_] := {{Cos[-φ], 
            Sin[-φ], 0}, {-Sin[-φ], 
            Cos[-φ], 0}, {0, 0, 1}};
y3RotMat[φ_] := {{Cos[-φ], 
            0, -Sin[-φ]}, {0, 1, 
            0}, {Sin[-φ], 0, 
            Cos[-φ]}};
x3RotMat[φ_] := {{1, 0, 0}, {0, Cos[-φ], 
            Sin[-φ]}, {0, -Sin[-φ], 
            Cos[-φ]}};

Clear[myPolyhedron];
myPolyhedron[{letter_,cp_}][grl_]:=
Switch[letter,
"a", aPhAd[grl] /. Polygon[xyz_] :> Polygon[Map[(#+cp)&,xyz]],
"b", bPhAd[grl] /. Polygon[xyz_] :> Polygon[Map[(#+cp)&,xyz]],
"c", cPhAd[grl] /. Polygon[xyz_] :> Polygon[Map[(#+cp)&,xyz]],
"d", dPhAd[grl] /. Polygon[xyz_] :> Polygon[Map[(#+cp)&,xyz]],
_, "Wrong or missing letter " <> ToString[letter] <> " !"]

myPolyhedron[{"a", {0, 0, 0}}][
            0][[1]][[3]][[1]]

myPolyhedron[{"e", {0, 0, 0}}][0]

Clear[x,y,z];
r = 40;
x[t_]:=r*Cos[2π*t];
y[t_]:=r*Sin[2π*t];
z[t_]:=2.5*t;

Clear[listOfLettersWithPolyhedronCenterPoints];
listOfLettersWithPolyhedronCenterPoints[xangle_,yangle_,numberOfRounds_][word_] := Table[
{StringTake[word,{(StringLength[word]-1)/(numberOfRounds*(1-1/StringLength[word]))*t+1}],
(x3RotMat[xangle//N].y3RotMat[yangle//N].{x[t],y[t],z[t]})//Evaluate},
         {t,0,numberOfRounds(1-1/StringLength[word]),
           numberOfRounds(1-1/StringLength[word])/(StringLength[word]-1)}];

(x3RotMat[xangle // N] . 
          y3RotMat[yangle // N] . {x[t], y[t], z[t]}) // 
      Evaluate

listOfLettersWithPolyhedronCenterPoints[0, 
        0]["abcd"]

string6times85 = 
      StringReplace["abcacd", {"a" -> g85a, "b" -> 
            g85b, "c" -> g85c, "d" -> g85d}]

Clear[myPolyhedraChain];
myPolyhedraChain[grl_, myString_, 
          numberOfRounds_] := myPolyhedron[#][
              grl] &  /@  listOfLettersWithPolyhedronCenterPoints[π/
                8. , π/16. , numberOfRounds][myString];

Clear[pointsForPrefixLetters];
pointsForPrefixLetters[myString_, shownPrefixLength_, numberOfRounds_] := 
      Table[{x[t], y[t], z[t]} - {0, 0, 4}, {t, 
            0, (shownPrefixLength - 1)*
              numberOfRounds*(1 - 
                    1/StringLength[myString])/(StringLength[myString] - 
                    1), numberOfRounds (1 - 
                    1/StringLength[myString])/(StringLength[myString] - 
                    1)}] // N

Clear[myGraphics, rot, rotNpoints];
rot[x_] := (x3RotMat[π/8] . y3RotMat[π/16]) . x // 
          N;
rotNpoints[myString_, shownPrefixLength_, 
          numberOfRounds_] := (rot  /@  
            pointsForPrefixLetters[myString, shownPrefixLength, 
              numberOfRounds]);
myGraphics[grl_, myString_, numberOfRounds_, shownPrefixLength_, 
        titleString_,  
        pointForTitle_] := 
Module[{letterPoints = 
            rotNpoints[myString, shownPrefixLength, 
              numberOfRounds]}, {myPolyhedraChain[grl, myString, 
            numberOfRounds], 
          Graphics3D[ {Text[titleString, pointForTitle, 
                TextStyle -> {FontFamily -> "Times", 
                    FontSlant -> "Italic", 
                    FontSize -> 24}], 
Text[
                    StringTake[myString, {#}], 
                    letterPoints[[#]]]  &  /@   Range[
                  shownPrefixLength]}]} ]

chain6times85WhiteLinesWithLighting = Show[myGraphics[1,string6times85,6,6,
"\!\(g\_85\)(abcacd)", {0,-30,25}],
     ViewPoint->{2.5,0.7,0.7},
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->18},
     Boxed->False]

SetDirectory["E:\\Veikko\\_pLAB"];

$ExportFormats

Export["_chain6times85_WhiteLinesWithLighting.jpeg", 
        chain6times85WhiteLinesWithLighting, "JPEG", 
        ImageSize -> 100*13,  
        ConversionOptions -> {"Quality"  -> 
              100}];

chain6times85WhiteLines = Show[myGraphics[1,string6times85,6,6,
"\!\(g\_85\)(abcacd)", {0,-30,25}],
     ViewPoint->{2.5,0.7,0.7}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->18},
     Boxed->False]

Export["_chain6times85_WhiteLines.jpeg", 
        chain6times85WhiteLines, "JPEG",  ImageSize -> 100*13,  
        ConversionOptions -> {"Quality"  -> 
              100}];

chain6times85GreyLines = Show[myGraphics[0.8,string6times85,6,6,
"\!\(g\_85\)(abcacd)", {0,-30,25}],
     ViewPoint->{2.5,0.7,0.7}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->18},
     Boxed->False]

Export["_chain6times85_GreyLines.jpeg", 
        chain6times85GreyLines, "JPEG", ImageSize -> 100*13,  
        ConversionOptions -> {"Quality"  -> 
              100}];

<< RealTime3D`

Clear[myGraphicsRT];
myGraphicsRT[grl_, myString_, numberOfRounds_, shownPrefixLength_, 
        titleString_,  
        pointForTitle_] := 
Module[{letterPoints = 
            rotNpoints[myString, shownPrefixLength, 
              numberOfRounds]}, {myPolyhedraChain[grl, myString, 
            numberOfRounds], 
          Graphics3D[ {Text[titleString, 
                pointForTitle], 
Text[
                    StringTake[myString, {#}], 
                    letterPoints[[#]]]  &  /@   Range[
                  shownPrefixLength]}]} ]

chain6times85RT = Show[myGraphicsRT[1,string6times85,6,6,
"g85(abcacd)", {0,-30,25}],
     ViewPoint->{2.5,0.7,0.7},
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->18},
     Boxed->False]

<< Default3D`

chain6times85BlackLines = Show[myGraphics[0,string6times85,6,6,
"\!\(g\_85\)(abcacd)", {0,-30,25}],
     ViewPoint->{2.5,0.7,0.7}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->18},
     Boxed->False]

Export["_chain6times85_BlackLines.jpeg", 
        chain6times85BlackLines, "JPEG",  ImageSize -> 100*13,  
        ConversionOptions -> {"Quality"  -> 
              100}];

g85a

string8times85 = 
        StringReplace["abcacdcb", {"a" -> g85a, "b" -> 
              g85b, "c" -> g85c, "d" -> 
              g85d}];

string8times85GreyLines = Show[myGraphics[0.8,string8times85,8,8,"\!\(g\_85\)(abcacdcb)", {0,-30,30}],
     ViewPoint->{2.5,0.7,0.7}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->18},
     Boxed->False]

string85times85 = 
        StringReplace[
          g85a, {"a" -> g85a, "b" -> g85b, "c" -> 
              g85c, "d" -> g85d}];

string85times85GreyLines = Show[myGraphics[0.8,string85times85,85,11,"\!\(g\_85\)(\!\(g\_85\)(a))", {0,-55,90}],
     ViewPoint->{1,0.3,0.5}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->8},
     Boxed->False]

ByteCount[string85times85GreyLines]

LiveGraphics3D

\(\(\(\(SetDirectory["C:\Veikko\_pLAB\pLAB_S04"]\) \)\(;\)\(\ \ \)\( (*\ Change\ this\ to\ work\ for\ you\ *) \)\)\)

Clear[myGraphics, rot, rotNpoints];
rot[x_] := (x3RotMat[π/8] . y3RotMat[π/16]) . x // 
          N;
rotNpoints[myString_, shownPrefixLength_, 
          numberOfRounds_] := (rot  /@  
            pointsForPrefixLetters[myString, shownPrefixLength, 
              numberOfRounds]);

  

myGraphicsLG3D[grl_, myString_, numberOfRounds_, shownPrefixLength_, 
        titleString_,  
        pointForTitle_] := 
Module[{letterPoints = 
            rotNpoints[myString, shownPrefixLength, 
              numberOfRounds]}, {myPolyhedraChain[grl, myString, 
            numberOfRounds], 
          Graphics3D[ {Text[titleString, 
                pointForTitle], 
Text[
                    StringTake[myString, {#}], 
                    letterPoints[[#]]]  &  /@   Range[
                  shownPrefixLength]}]} ]

string85times85GreyLines = Show[myGraphicsLG3D[0.8,string85times85,85,11,"g85(g85(a))", {0,-55,90}],
     ViewPoint->{1,0.3,0.5}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->8},
     Boxed->False]

string85times85GreyLines >> "string85times85GreyLines.m";

StringTake[g85a, {1, 20}]

string20times85 = 
        StringReplace["abcacdcbcdcadcdbdaba", {"a" -> 
              g85a, "b" -> g85b, "c" -> 
              g85c, "d" -> g85d}];

string20times85GreyLines = Show[myGraphicsLG3D[0.8,string20times85,20,11,"g85(abcacdcbcdcadcdbdaba)", {0,-50,40}],
     ViewPoint->{1,0.3,0.5}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->12},
     Boxed->False]

string20times85GreyLines >> "string20times85GreyLines.m";

StringTake[g98a, {1, 20}]

string20times98 = 
        StringReplace["abcacdcbcdcadbdcbdba", {"a" -> 
              g98a, "b" -> g98b, "c" -> 
              g98c, "d" -> g98d}];

string20times98GreyLines = Show[myGraphicsLG3D[0.8,string20times98,20,11,"g98(abcacdcbcdcadbdcbdba)", {0,-50,40}],
     ViewPoint->{1,0.3,0.5}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->12},
     Boxed->False]

string20times98GreyLines >> "string20times98GreyLines.m";

StringTake[g85a, {1, 40}]

\(\(string40times85 = 
        StringReplace["abcacdcbcdcadcdbdabacabadbabcbdbcbacbcdc", {"a" -> g85a, "b" -> g85b, "c" -> 
              g85c, "d" -> g85d}];\)\)

string40times85GreyLines = Show[myGraphicsLG3D[0.8,string40times85,40,11,"g85(abcacdcbcdcadcdbdabacabadbabcbdbcbacbcdc)", {0,-50,40}],
     ViewPoint->{1,0.3,0.5}, Lighting->False,
     TextStyle->{FontFamily->"Times", FontSlant->"Italic", FontSize->12},
     Boxed->False]

string40times85GreyLines >> "string40times85GreyLines.m";