EXPLOOT project
Ivan Cnop
icnop@vub.ac.be

Nearly impossible: drilling squares.

A square borehole

Problem: drill a tunnel with a square section using drills that are fixed on rotating disks.

In the next drawing, the coloured rectangles represent train silouettes and ducts and the white border is a concrete structure. 
There is a problem drilling the outer square if the drills are fixed on disks that rotate with fixed relative gear speeds in the "one armed robot" (spirograph) way.

Show[
      Graphics[
{Line[{{0, 0}, {0, 1}, {1, 1}, {1, 0}, {0, 
                0}}], 
{Hue[0.7], 
            Rectangle[{0.1, 
                0.1}, { .45,  .2}]}, 
Line[{{0.1, 
                0.3}, {0.9,  .3}, { .9,  .9}, { .1,  .9}, {0.1, 
                0.3}}], 
{Hue[0.7], 
            Rectangle[{0.55, 0.1}, { .9,  .2}]}, 
{Hue[0], 
            Rectangle[{0.18, 0.4}, { .44,  .8}]}, 
{Hue[0], 
            Rectangle[{0.56, 0.4}, { .82,  .8}]}}
], 
      AspectRatio -> Automatic]

The problem is to bore a tunnel in which the above construction nearly fits.

Definition of the spirograph

Arbitrary trigonometric polynomials

A polynomial is completely determined by its coefficient list. The following lines write the full expression from the coefficient list:

powers[coeffList_, z_] :=  z^Range[Length[coeffList]]

f[coeffList_, φ_] := (coeffList .  
            powers[coeffList, z]) /. z -> E^(I φ)

Example

coeffList = {1, 0,  .5, 0, 0,  .1}

f[%, φ]

𝓈 = spirograph[%, φ];

Shifted polynomials: rational expresssions

They give more efficient robots (including the one drawing ellipses) and more flexible shapes. 
We also include a radius   r   variable for mapping concentric circles.

shiftPowers[coeffList_, n_, z_] :=  
      z^(Range[Length[coeffList]] - n)

f[coeffList_, n_, 
        r_, φ_] := (coeffList .  
            shiftPowers[coeffList, n, z]) /. 
        z -> (r E^(I φ))

Example

Experimenting shows that the following two-term gives a decent approximation to the square

coeffList = { .28, 0, 0, 0, 2.05, 0, 0, 0, 0}

f[coeffList, 4, 
        r, φ] (E^(I π/4))

r = 1; 
    spirograph[
      f[coeffList, 4, 
          r, φ] (E^(I π/4)), φ]

Images of nearby circles are given by

Table[
        spirograph[
          f[coeffList, 4, 
              r, φ] (E^(I π/4)), φ], {r,  .9, 1.1, 0.025}];

Example

r = 1;

coeffList = { .29, 0, 0, 0, 2, 0, 0, 0}

f[%, 4, 
        r, φ] (E^(I π/4))

𝓈 = spirograph[%, φ];

Sneak preview: a square torus

Creating square toruses (see also the Spiroids notebook)

The notebook referred to defines  shapes similar to a Torus.

Clear[f, g]

Define   f   to be the above approximation of the square:

f[φ_] = (E^(((I π)/4))) (((0.29 (E^(-3 I φ)))/(r^3)) + 
            2 (E^(I φ)) r)

and let the following run through all directions:

g[φ_] = 
      2 (E^( I φ))

toroid[a_, f_, g_, opts___] := 
        ParametricPlot3D[{(a + Re[g[u]]) Re[f[t]], 
            Im[f[t]] (a + Re[g[u]]), Im[g[u]]}, {t, 0, 2 Pi}, {u, 0, 
            2 Pi}, opts];

r = 1; toroid[5, g, g, PlotPoints -> {60, 60}]

r = 1; toroid[5, f, g, PlotPoints -> {60, 60}]

r = 1; toroid[5, g, f, PlotPoints -> {60, 60}]

r = 1; toroid[5, f, f, PlotPoints -> {60, 60}]

Problem

These objects are the result of a combination of low order (shifted) polynomials whose coefficients where obtained by trial and error. Here we used

but other polynomials may be possible. Higher order polynomials will give better approximations.

Can we find a method that determines such (shifted) polynomials in a more systematic way ?

Precisely: 
given any set of points in the plane, can we find a polynomial image of the (unit) circle which goes through these points, or at least approximates these as well as possible?

This is what we will do in the "Shapes"  notebook.