Part 2 : Overlap & Fourier Analysis

Code available at: Github Branch .

• Fourier Notebook

Time-Independent Calculations

Taking each logogram as a two-dimensional wavefunction $$ | \Psi_n \rangle : \langle i,j | \Psi_n \rangle = \text{pixel data (normalized) }, $$ calculate overlap for each pair $M_{n,m} =M_{m,n} = \langle \Psi_n | \Psi_m \rangle $ :

By row take the largest value other than $M_{n,n}=1$, and plot the superposition

Create wavefunctions

$$| \cos( n \phi ) \rangle: \langle i,j | \cos( n \phi ) \rangle = \cos(n \arctan(i,j)),$$ $$| \sin( n \phi ) \rangle: \langle i,j | \cos( n \phi ) \rangle = \sin(n \arctan(i,j)),$$

and use these to calculate the Fourier Amplitudes

$$FC_{n,m}=\langle \cos( n \phi ) | \Psi_m \rangle^2, $$ $$FS_{n,m}=\langle \sin( n \phi ) | \Psi_m \rangle^2, $$

Sum to obtain the total squared amplitude

$F_{m,n} = FC_{m,n}+FS_{m,n} $

For each wavefunction index by $m$, list plot the $n$ sequence. Also plot the most symmetric graphs.

more fanfiction:

Scientist: One plus one plus one, equals three. Three spatial dimensions, represented by approximate cyclic symmetry.

Linguist: Time goes around the circle. Clockwise or counterclockwise, endlessly repeating.

Scientist: Minus $d\tau^2$ equals $ds^2$. Surely the Aliens have some conception of special relativity. Logogram number 22, I'm starting to think that "spacetime" is a better translation than "time".

Linguist: The three lobes bear some resemblance to the partials for "suffering", "liberation". This third one, I don't know, looks like "stillness", possibly "death".

Part 4: Constructing a Heptapod Sentence

In the following code we construct the Heptapod sentence for:

"Teach all humans to solve time."

For complete code see: Plaintext, Notebook .

We assume the Gyroid surface appropriate for the sentence grammar, and approximate the geometric structure via the usual implicit equation

$$\sin(x + \pi/2) \cos(y + \pi/2) + \sin(y + \pi/2) \cos(z + \pi/2) + \sin(z + \pi/2) \cos(x + \pi/2)=0.$$

At the so-called monkey-saddle points, the surface expands naturally in cylindrical coordinates, with the $z$-axis along the surface normal. Applying series inversion to solve for $z(r,\theta)$ obtains a trigonometric function that coordinatizes a local patch of the surface. Even under modest series truncation, the patch combined with global, periodic structure provides an adequate cover of the entire surface. These equations allow construction of arbitrarily large alien texts, simply by mapping the logograms onto the surface contours.

ApproxGyroid =   Sin[x + Pi/2] Cos[y + Pi/2] + Sin[y + Pi/2] Cos[z + Pi/2] + Sin[z + Pi/2] Cos[x + Pi/2];
normal[mno_] := {
  If[OddQ[mno[[3]]], -1, 1],
  If[OddQ[mno[[1]]], -1, 1],
  If[OddQ[mno[[2]]], -1, 1]
  }

dualNormal[mno_] := {
  If[OddQ[mno[[2]]], -1, 1],
  If[OddQ[mno[[3]]], -1, 1],
  If[OddQ[mno[[1]]], -1, 1]
  }

xyz[mno_] :=  Plus[Times[mno, {Pi, Pi, Pi}], {Pi/2, Pi/2, Pi/2}]

Contour[mno_] :=  Plus[RotationMatrix[{{0, 0, 1}, normal[mno]}].{r Cos[\[Phi]], r Sin[\[Phi]],
    Normal[      InverseSeries[ Series[ApproxGyroid /. {x -> x + xyz[mno][[1]], 
            y -> y + xyz[mno][[2]], z -> z + xyz[mno][[3]]} /. 
          MapThread[Rule,  {{x, y, z}, 
            RotationMatrix[{{0, 0, 1}, normal[mno]}].{x, y, 
              z}}] /. {x -> r Cos[\[Phi]], y -> r Sin[\[Phi]]}, {z, 0,
          4}], y]] /. y -> 0}, xyz[mno] ]

DualContour[mno_] :=  Plus[RotationMatrix[{{0, 0, 1}, dualNormal[mno]}].{r Cos[\[Phi]], 
    r Sin[\[Phi]], Normal[InverseSeries[Series[
        ApproxGyroid /. {x -> x + Pi/2 + xyz[mno][[1]], 
            y -> y + Pi/2 + xyz[mno][[2]], 
            z -> z + Pi/2 + xyz[mno][[3]]} /. MapThread[Rule,
           {{x, y, z}, 
            RotationMatrix[{{0, 0, 1}, dualNormal[mno]}].{x, y, 
              z}}] /. {x -> r Cos[\[Phi]], y -> r Sin[\[Phi]]}, {z, 0,
          4}], y]] /. y -> 0},  xyz[mno] + {Pi/2, Pi/2, Pi/2}]

 AbsoluteTiming[ ContoursF = TrigReduce[  Normal@Series[ Contour /@ Tuples[{0, 1}, 3], {r, 0, 7}]];
 DualContoursF =   TrigReduce[   Normal@Series[      DualContour /@ Join[IdentityMatrix[3], -IdentityMatrix[3]],
 {r,  0, 7}]]; (* About 80(s) for me *)

 CentralDualContour = TrigReduce[Normal@Series[DualContour[{0, 0, 0}], {r, 0, 7}]];]

Notice that the powers $r^n$ higher than $n=1$, the perturbative terms, all attach to $2\pi/3$ periodic functions. Compare this with earlier Fourier analysis, which characterizes the obvious symmetry of the Time symbol itself. Compare with the standard Mathematica Drawing

g0 = ContourPlot3D[
   ApproxGyroid == 0, {x, 0, 2 Pi}, {y, 0, 2 Pi}, {z, 0, 2 Pi}, 
   Mesh -> 3, ContourStyle -> Directive[Blue, Opacity[0.5]], 
   Boxed -> False, Axes -> False];

ContourDrawing = Show[g0,
  ParametricPlot3D[  Evaluate[(ContoursF /. r -> #/4)], {\[Phi], 0, 2 Pi}, 
     PlotStyle -> Directive[Thick, Blend[{Yellow, Green}, 2/3]]] & /@ 
   Range[7],  ParametricPlot3D[
     Evaluate[(DualContoursF /. r -> #/4)], {\[Phi], 0, 2 Pi}, 
     PlotStyle -> Directive[Thick, Darker@Blue]] & /@ Range[7],
  ParametricPlot3D[
     Evaluate[(CentralDualContour /. r -> #/4)], {\[Phi], 0, 2 Pi}, 
     PlotStyle -> Directive[Thick, Darker@Cyan]] & /@ Range[7], 
PlotRange -> All, Boxed -> False, Axes -> False, ImageSize -> 800  ]

With a little more effort, we produce the following DIY drawing:

which shows the various patches overlapping sufficiently along all boundaries. This contour graph is essentially hand-writing paper that helps to align the alien logograms. In this particular sentence, Earth occupies a central position, and is surrounded by "time" repeated on 8 locations. While the symbols for "human", "humanity", "solve", "solve on you now", "use marker write", "there is no linear time" occupy the remaining six locations on the dual lattice.

More Fanfiction ( The Fight )

Linguist: Is this impermanence between us nothing more than a time ratio to you?

Scientist: A time ratio, yes. One person's lifetime, to the duration of a spoken lie, to all your social time. Unless blame outlasts, say, the galactic lifetime, I don't care !

Linguist: What about family time? You're willing to loose a wife because you need perfect ordering to work? A marriage isn't a monastery, get over it!

Hi Sander,

Thanks for the compliment. You're also doing well with the recent Chaos game. Could be interesting to see a variation of your code for a mapping between the coherent logogram ring structure and diffuse pixel-dust.

But I am still worried that maybe the aliens have some extra-sensory perception for geometric powers of $r$, so I did some more surface calculation starting with the condition for minimal surfaces:

$$(1+h_x^2)h_{yy} - 2 h_x h_y h_{xy} + (1+h_y^2)h_{xx}=0,$$

another one of Lagrange's equations. I have never seen an expansion solution of this equation, but can produce one easily. Here we include only odd powers of $r$ and angular dependence $2\pi/3$ periodic. Since the constraint is in cartesian coordinates, we define the following variables:

r = Sqrt[x^2 + y^2]; P = y/r; Q = x/r;
Q3 = 4 Q^3 - 3 Q; P3 = 3 P - 4 P^3;

And construct the surface as a ring over these variables

indList[n_ /; OddQ[n]] := Flatten[Table[{n, i - j, j}, {i, 1, Floor[n/3], 2}, {j, 0, i}], 1]
indList[n_ /; EvenQ[n]] :=  Flatten[Table[{n, i - j, j}, {i, 0, Floor[n/3], 2}, {j, 0, i}], 1]
params = Flatten[indList[2 # + 1] & /@ Range[7], 1];
(*params = Flatten[indList[#]&/@Range[2,15],1];*)
AbsoluteTiming[ \[CapitalPsi] =  Expand[Simplify[     Expand[Total[
       Times[c @@ #, r^#[[1]], Q3^#[[2]], P3^#[[3]] ] & /@   params]]]]; ]


d\[CapitalPsi]dx = D[\[CapitalPsi], x];
d\[CapitalPsi]dy = D[\[CapitalPsi], y];
d2\[CapitalPsi]dx2 = D[\[CapitalPsi], {x, 2}];
d2\[CapitalPsi]dy2 = D[\[CapitalPsi], {y, 2}];
d2\[CapitalPsi]dxdy = D[D[\[CapitalPsi], x], y];

AbsoluteTiming[ testExp = Expand[((1 + d\[CapitalPsi]dx^2)*d2\[CapitalPsi]dy2 - 
      2 d\[CapitalPsi]dx d\[CapitalPsi]dy d2\[CapitalPsi]dxdy + (1 + 
         d\[CapitalPsi]dy^2)*d2\[CapitalPsi]dx2)]; ]

And solve,

Sols[n_] := Fold[Join[#1, Expand@Solve[#2 /. #1 ][[1]]] &, {}, Function[{a}, # == 
         0 & /@ (Coefficient[Coefficient[testExp, x, #], y, a - #] & /@
          Range[0, a])][#] & /@ (2 Range[n] + 1)]

AbsoluteTiming[ With[{Sol6 = Sols[6]}, SolList =    Cases[Sol6, 
HoldPattern@Rule[c[n_ /; n < Evaluate[2 #], _, _], _]] & /@ 
     Range[3, 8]; ]]

These values cause cancellation of the first few coefficients in the expansion of the mean curvature numerator

Expand[Function[{a}, ((Coefficient[Coefficient[testExp, x, #], y, 
            a - #] //. SolList[[-1]]) & /@ Range[0, a])][#] & /@ Range[0, 13]] // TableForm

The solution is a formal power series, not gauranteed to converge. However, if the coefficients decrease quickly as powers of $r$ increase, convergence should occur. We choose coefficients $1/n!$ for terms with $r^n$. A test of the error is given by change in amplitude with change in iteration parameter, relative to the total amplitude at radius $r=1$.

ErrorFunctions =   Evaluate[Partition[ \[CapitalPsi] /. 
        SolList /. {c[x_, _, 0] :> 1/x!, c[_, _, _] -> 0}, 2, 1] /.
     {x_, y_} :> 100 Subtract[y, x]/Mean[{y, x}] /. {x -> 
      Cos[\[Theta]], y -> Sin[\[Theta]]}];

LogPlot[ErrorFunctions[[{1, 3, 5}]], {\[Theta], 0, 2 Pi},
 AxesLabel -> {"Angle", "Percent
   Error"}, ImageSize -> 500, PlotRange -> Full]

As iteration of the recursive solution algorithm increases, the difference oscillates more rapidly and with a decreasing amplitude. By a sixth approximation, already converges to $0.05\%$. Good enough.

It's also possible to measure convergence of the mean curvature to zero as a function of the iteration parameter

MeanCurvatureConvergence =   N[(testExp //. SolList[[#]] /. {c[x_, _, 0] :> 1/x!, 
c[_, _, _] -> 0} /. x -> Cos[Pi] /. y -> Sin[Pi]) & /@ Range[6]];

ListLogPlot[MeanCurvatureConvergence, PlotRange -> All, 
AxesLabel -> {"Iteration", "Curvature
Numerator"}, Joined -> True, ImageSize -> 500]

So yes, the surface as written appears to converge toward minimal form,

\[CapitalPsi]6 =  Expand[\[CapitalPsi] /. SolList[[-1]] /. {c[x_, _, 0] :> 1/x!,  c[_, _, _] -> 0}]
Expand[TrigReduce[\[CapitalPsi]6 /. {x -> \[Rho] Cos[\[Phi]],     y -> \[Rho] Sin[\[Phi]]}]]

Finally, the logogram plot, "earth" + "walk",

This deformed logogram looks quite similar to those above. However the equations underlying this surface have no $r^5$ term. It seems that a $2\pi/3$ periodic minimal surface, which expands in whole powers of $r$, cannot have an $r^5$ term. Compare with previous expansions, which are not minimal and do have a term like $r^5$.

We have yet to find parameter values that lead to periodic surfaces, but already have obtained a surface geometry that could be tested in nature. The famous soap film experiment should yield surfaces as seen at math.hmc.edu and daviddarling.info .

- Congratulations! This post is now a Staff Pick! Thank you for your wonderful contributions. Please, keep them coming!