Wolfram Blog http://blog.wolfram.com News, views, and ideas from the front lines at Wolfram Research. Fri, 18 May 2018 16:21:55 +0000 en hourly 1 http://wordpress.org/?v=3.2.1 Strange Circles in the Complex Plane—More Experimental Mathematics Results http://blog.wolfram.com/2018/05/10/strange-circles-in-the-complex-plane-more-experimental-mathematics-results/ http://blog.wolfram.com/2018/05/10/strange-circles-in-the-complex-plane-more-experimental-mathematics-results/#comments Thu, 10 May 2018 20:00:04 +0000 Michael Trott http://blog.internal.wolfram.com/?p=45347 #post-45347 h2 { margin: 2px 0 0 0; font-size: 22px; padding: 12px 0 6px; display: block; float: none; } #post-45347 blockquote { //padding: 10px 25px; font-family: Georgia; font-style: italic; font-size: 130%; line-height: 1.4; color: #e26a0f; margin: 0 0 8px; //border-top: 1px solid #c3c3c3; //border-bottom: 1px solid #c3c3c3; } #post-45347 blockquote p { margin: 0; padding: 0; }

The Shape of the Differences of the Complex Zeros of Three-Term Exponential Polynomials

In my last blog, I looked at the distribution of the distances of the real zeros of functions of the form with incommensurate , . And after analyzing the real case, I now want to have a look at the differences of the zeros of three-term exponential polynomials of the form for real , , . (While we could rescale to set and for the zero set , keeping and will make the resulting formulas look more symmetric.) Looking at the zeros in the complex plane, one does not see any obvious pattern. But by forming differences of pairs of zeros, regularities and patterns emerge, which often give some deeper insight into a problem. We do not make any special assumptions about the incommensurability of , , .

The differences of the zeros of this type of function are all located on oval-shaped curves. We will find a closed form for these ovals. Using experimental mathematics techniques, we will show that ovals are described by the solutions of the following equation:


… where:


Here this situation is visualized for the function , meaning and , , , , . We calculate a few dozen exact zeros and plot the described curve.

edzs = Sort[
   N[z /. Solve[
      Exp[I z] + 2/3 Exp[I Sqrt[2] z] + 1/2 Exp[I Sqrt[3] z] ==
        0 \[And]
                                  -5 < Im[z] < 5 \[And]
       0 < Re[z] < 500, z]]];

Show[{(* curves of zeros *)

  RegionPlot[(2/3)^(2 (Sqrt[3] - 1)) (1/2)^(2 (1 - Sqrt[2])) *
     (Cosh[(Sqrt[2] - 1) y] - Cos[(Sqrt[2] - 1) x])^(
     Sqrt[2] - 1) (Cosh[(1 - Sqrt[3]) y] - Cos[(1 - Sqrt[3]) x])^(
     1 - Sqrt[
      3]) (Cosh[(Sqrt[3] - Sqrt[2]) y] - Cos[(Sqrt[3] - Sqrt[2]) x])^(
     Sqrt[3] - Sqrt[2]) > 1, {x, 0, 55}, {y, -3, 3},
   PlotPoints -> 60,
   PlotStyle -> Directive[RGBColor[0.88, 0.61, 0.14], Opacity[0.3]],
   BoundaryStyle -> None],
  (* numerically calculated zeros *)

  ListPlot[-ReIm[Apply[Subtract, Subsets[edzs, {2}], {1}]],
   PlotRange -> {{0, 55}, {-3, 3}}]}, AspectRatio -> 1/3]

While one easily sees the ovals emerge from numerically calculated zeros, how does one find a closed form for the curves on which they all fall? Using an experimental mathematics approach that includes symbolic polynomial manipulations as well as numerical techniques, including high-precision calculations, one can find the previously shown closed form of the curves. In this blog, I will show how to find these curves.

Expressions containing for occur from time to time in complex analysis---for instance, for the Dirichlet kernel of a strip (Widder, 1961) or in fluid dynamics (see e.g. Baker and Pham, 2006).

From cos to exp: Exponential Polynomials

A natural generalization of the function used in the last blog is for real . There is a lot of literature on exponential polynomials that are prime examples of almost periodic functions (see e.g. Jessen and Tornehave, 1945, Moreno, 1973, Sepulcre, 2016, and Mora, Sepulcre and Vidal, 2013.)

Let us have a quick look at this function. Like in the last blog, we use the special instance .

fGoldenExp[z_] :=
 Exp[I z] + Exp[I GoldenRatio z] + Exp[I GoldenRatio^2 z]

We calculate the first zeros, extrema and inflection points.

zeis = Table[
   z /. Solve[
     D[fGoldenExp[z], {z, k}] == 0 \[And] -5 < Im[z] < 5 \[And]
      0 < Re[z] < 50, z], {k, 0, 2}];

Plotting the zeros, extrema and inflection points in the complex plane shows that the real parts are nearly identical for each "group" of zero, extrema and inflection point triples.

Legended[ContourPlot[
  Evaluate[# == 0 & /@ ReIm[fGoldenExp[x + I y] ]],
  {x, 000, 050}, {y, -3, 3}, PlotPoints -> 50, AspectRatio -> 1/2,
  Epilog :> {Purple, PointSize[0.01], Point[N[ReIm[#]] & /@ zeis[[1]]],
    Darker[Green], Point[N[ReIm[#]] & /@ zeis[[2]]],
    Darker[Red], Point[N[ReIm[#]] & /@ zeis[[3]]]}],
 LineLegend[{Directive[Thick, Purple], Darker[Green], Darker[Red]},
  {"zeros", "extrema", "inflection points"}]]

(The "nice" vertical alignment of the zeros of the function and their derivatives is not always the case---for instance, when and have different signs, the alignment is broken.)

I now calculate ~5k zeros of . This time, we can't use the differential equation technique; instead we use Solve. We sort the zeros by increasing real part.

Monitor[fGoldenExpZeros =
   SortBy[N@
     Flatten[Table[
       z /.

        Solve[fGoldenExp[z] == 0 \[And] -5 < Im[z] < 5 \[And]
          100 k <= Re[z] < 100 k + 100, z],
       {k, 0, 200}]], Re];, k]

Length[fGoldenExpZeros]

The values of the three exponential summands at the zeros form interesting shapes in the complex plane.

Legended[
 Graphics[{Thickness[0.001],
   Transpose[{{RGBColor[0.36, 0.50, 0.71], RGBColor[0.88, 0.61, 0.14],
       RGBColor[0.56, 0.69, 0.19]},
     Line /@ Transpose[Function[z, {{{0, 0}, ReIm[Exp[I z]]} ,
          {{0, 0}, ReIm[Exp[I GoldenRatio z]]}, {{0, 0},
           ReIm[Exp[I GoldenRatio^2 z]]}}] /@
        RandomSample[fGoldenExpZeros, 500]]}]},
  Frame -> True],
 LineLegend[{Directive[Thick, RGBColor[0.36, 0.50, 0.71]],
   Directive[Thick, RGBColor[0.88, 0.61, 0.14]],
   Directive[Thick, RGBColor[0.56, 0.69, 0.19]]}, {Exp[I z],
   Exp[I GoldenRatio z], Exp[I GoldenRatio^2 z]}]]

As one can already see from the graphic, the term is never the smallest and never the largest at a zero.

(Function[z, Sort[{{Abs[Exp[I z]], 1},
       {Abs[Exp[I GoldenRatio z]], 2}, {Abs[Exp[I GoldenRatio^2 z]],
        3}}][[2, 2]]] /@ fGoldenExpZeros) // Union

Looking at the number of curves for vanishing real and imaginary parts for large positive and negative real parts of z shows that the slowest and fastest oscillating terms dominate the function behavior in the upper and lower half-plane. The mean spacing along the real axis between zeros follows from this observation as .

2 Pi/(GoldenRatio^2 - 1) // N

This value agrees well with the spacing derived from the calculated zeros.

Re[fGoldenExpZeros[[-1]]]/Length[fGoldenExpZeros]

Plotting the zeros with the real parts modulo the mean spacing confirms the calculated value. All roots are within a constant distance from the reduced center.

Manipulate[
 Graphics[{Thickness[0.001], RGBColor[0.36, 0.51, 0.71],
   Opacity[0.3],
   Line[{Mod[Re[#], \[CapitalDelta]], Im[#]} & /@
     Take[fGoldenExpZeros, 1000]]}],
 {{\[CapitalDelta], 2 Pi/(GoldenRatio^2 - 1.)}, 3, 5,
  Appearance -> "Labeled"},
 TrackedSymbols :> True, SaveDefinitions -> True]

At the zeros, is strongly correlated with . For a given real part, there is a unique imaginary part.

Histogram3D[{Mod[Re[#1], 2 Pi], Im[#2]} & @@@
  Partition[fGoldenExpZeros, 2, 1], 100]

The real and imaginary parts of have the following distributions at the zeros.

Histogram[#[fGoldenExp' /@ fGoldenExpZeros], 100] & /@ {Re, Im}

The distribution of the complex values of the three summands , , has some unexpected shapes.

Function[p, Histogram3D[{Mod[#1, p], #2} & @@@
     (ReIm /@ (-Subtract @@@
         Subsets[RandomSample[fGoldenExpZeros, 2000],
          {2}])), 100]] /@ (2 Pi/{1, GoldenRatio, GoldenRatio^2 })

Following the main thread of the distribution of zero distances, I sort the zeros by increasing real parts and calculate the differences. Interestingly, one gets a Stonehenge-like distribution for the differences in the complex plane.

Finding Strange Circles

differencesGoldenExp = Differences[fGoldenExpZeros];

Histogram3D[ReIm /@ differencesGoldenExp, 100]

The figure looks like a perfect circle. I fit an ellipse to the data.

ellipseData = ((Re[#] - xm)^2/a^2 + (Im[#] - ym)^2/b^2 - 1^2) & /@
   differencesGoldenExp;

fmEllipse = FindMinimum[ellipseData.ellipseData,
                              {{xm,
    Mean[ReIm /@ differencesGoldenExp][[1]]}, {ym, 0}, {a, 1}, {b,
    1}},
                                  PrecisionGoal -> 10]

Interestingly, the figure is nearly a circle. The blue circle is the best-fit ellipse, and the black points are the observed differences. (Trying to fit a rotated ellipse does not improve the fit.)

{#, Show[#, PlotRange -> {{4, 4.1}, {1.11, 1.15}}]} &[
 Graphics[{Blue, Circle[{xm, ym}, Abs[{a, b}]] /. fmEllipse[[2]],
                      PointSize[0.002], Black,
   Point[ReIm /@ differencesGoldenExp]}, Axes -> True]]

But it is not quite a circle or even an ellipse; zooming in, one sees some small oscillating deviations from the circle. The following plot shows the difference in local radius of the fitted circle to the calculated zeros as a function of the complex argument.

ListPlot[({Arg[# - (xm + I ym)], Abs[# - (xm + I ym)]} /.
     fmEllipse[[2]]) & /@  differencesGoldenExp]

Successive differences are often quite different. I connect successive differences in the complex plane. The angles between two successive line segments seem to be approximately constant.

Graphics[{Thickness[0.001], RGBColor[0.36, 0.51, 0.71],
  Line[ReIm /@ Take[differencesGoldenExp, 200]]}]

The angle between successive line segments in the last image is quite localized to a narrow range, with the minimal and maximal angles occurring the most frequently.

Histogram[
 VectorAngle[#1 - #2, #3 - #2] & @@@
  Partition[ReIm /@ differencesGoldenExp, 3, 1], 100,
 PlotRange -> {{0, Pi}, All}]

The pair correlation of successive differences shows a strict correlation of successive zeros.

Histogram3D[Partition[Arg /@ differencesGoldenExp, 2, 1], 100]

These patterns observed for successive differences are all also present in the differences of next-neighboring zeros. The following graphics array shows the zero differences for j=3,4,...,11.

Table[Graphics[{Thickness[0.001], RGBColor[0.36, 0.51, 0.71],
    Line[ReIm[#[[-1]] - #[[1]]] & /@
      Partition[Take[differencesGoldenExp, 500], k, 1]]},
                     ImageSize -> 160], {k, 3, 11}] //
 Partition[#, 3] &

The observed properties are: 1) zeros, extrema and inflection points line up with nearly identical real parts; and 2) the differences of successive zeros that are approximately on an ellipse are not special to the exponential polynomial with =, but hold for general . For generic , we still see these ellipses. And, similar to the previous Stonehenge image, the rightmost parts of the histogram are often the largest.

Similar to what I did in my last blog for , we shift the argument of and show how the function behaves in the neighborhoods of zeros. The following graphic shows the curves of the vanishing real part in gray and the vanishing imaginary part in blue in the neighborhood of the first 30 zeros. The genesis of the zero accumulation on near-circles is clearly visible.

Show[{Table[
   ContourPlot[Evaluate[# == 0 & /@ ReIm[fGoldenExp[z0 + (x + I y)]]],
    {x, 0, 10}, {y, -2, 2},
    ContourStyle -> {Directive[Gray, Opacity[0.4], Thickness[0.001]],
      Directive[RGBColor[0.36, 0.51, 0.71], Opacity[0.6],
       Thickness[0.001]]}], {z0, Take[fGoldenExpZeros, 30]}],
  Graphics[{Purple, PointSize[0.004],
    Point[ReIm /@
      Table[fGoldenExpZeros[[j + 1]] - fGoldenExpZeros[[j]], {j,
        30}]] ,
    Point[
     ReIm /@ Table[
       fGoldenExpZeros[[j + 2]] - fGoldenExpZeros[[j]], {j, 30}]]}]},
 AspectRatio -> Automatic]

Comparing the last graphic with a version that uses randomized phases between the three exponential terms does not reproduce the circle patterns of the zeros.

fGoldenExpRandomPhases[
  z_, {\[CurlyPhi]2_, \[CurlyPhi]3_}] := (-Exp[I \[CurlyPhi]2] -
     Exp[I \[CurlyPhi]3]) Exp[I z] +
  Exp[I \[CurlyPhi]2] Exp[I GoldenRatio z] +
  Exp[I \[CurlyPhi]3] Exp[I GoldenRatio^2 z] 

Module[{\[CurlyPhi]2, \[CurlyPhi]3},
 plData =
  Table[\[CurlyPhi]2 = RandomReal[{0, 2 Pi}]; \[CurlyPhi]3 =
    RandomReal[{0, 2 Pi}];
   {ContourPlot[
     Evaluate[# == 0 & /@
       ReIm[fGoldenExpRandomPhases[
         x + I y, {\[CurlyPhi]2, \[CurlyPhi]3}]]],
     {x, 0, 10}, {y, -2, 2},
     ContourStyle -> {Directive[Gray, Opacity[0.4],
        Thickness[0.001]],
       Directive[RGBColor[0.36, 0.51, 0.71], Opacity[0.6],
        Thickness[0.001]]}],
     Point[
      ReIm /@ (z /.
         Solve[fGoldenExpRandomPhases[
             z, {\[CurlyPhi]2, \[CurlyPhi]3}] == 0 \[And]
           0 < Re[z] < 10 \[And] -3 < Im[z] < 3, z])] //
     Quiet} , {30}];
 Show[{First /@ plData,
   Graphics[{Purple, PointSize[0.004], Last /@ plData}]},
  AspectRatio -> Automatic]]

This time, it does not make sense to form the envelope with, say, because the resulting equation is independent of and so has no family of solutions, but rather just isolated points.

Factor[Subtract @@
  Eliminate[{fGoldenExpRandomPhases[
       z, {\[CurlyPhi]2, \[CurlyPhi]3}] == 0,
     D[fGoldenExpRandomPhases[
        z, {\[CurlyPhi]2, \[CurlyPhi]3}], \[CurlyPhi]2] ==
      0} /. \[CurlyPhi]2 -> Log[C]/I, C]  ]

It is possible to derive a closed form for the circle-shaped curves on which the differences of the zeros are located.

A Closed Form of the Exponential Polynomial Zero Rings

The locations of the zero differences on the ellipse-shaped curves are curious. Can we get a closed-form equation for these shapes? As it turns out, we can. Since the derivation is a bit longer, we carry it out in this appendix. Rather than dealing with the general , situation, we will deal with , and then generalize to generic , by guessing based on the golden ratio result.

f\[Alpha][z_] :=
 Exp[I z] + Exp[I \[Alpha] z] +(* \[Equal]\[ThinSpace]Exp[
  I \[Alpha]^2 z] for \[Alpha]\[ThinSpace]\[Equal]\[ThinSpace]\[Phi] *)
  Exp[I z] Exp[I \[Alpha] z]

We start by writing down the conditions for and , which should both be zeros of .

{f\[Alpha][z0], f\[Alpha][z0 + \[Delta]z]} // ExpandAll

We separate real and imaginary parts using and ; supplement with two trigonometric identities; and rewrite , , and as polynomial variables.

eqs1 = {Re[f\[Alpha][x0 + I y0]]  // ComplexExpand // TrigExpand,

   Im[f\[Alpha][x0 + I y0]]  // ComplexExpand // TrigExpand,

   Re[f\[Alpha][x0 + I y0 + \[Delta]x + I \[Delta]y]] //
      ComplexExpand // ExpandAll // TrigExpand,

   Im[f\[Alpha][x0 + I y0 + \[Delta]x + I \[Delta]y]] //
      ComplexExpand // ExpandAll // TrigExpand,
          Cos[x0]^2 + Sin[x0]^2 - 1,

   Cos[\[Alpha] x0]^2 + Sin[\[Alpha] x0]^2 - 1 } /. {Cos[x0] -> c0,
   Sin[x0] -> s0, Cos[\[Alpha] x0] -> c\[Alpha],
   Sin[\[Alpha] x0] -> s\[Alpha]}

This system of equations does describe the possible positions of the zeros at . A quick numerical experiment confirms this.

of1 = eqs1.eqs1 /. \[Alpha] -> GoldenRatio;

Monitor[nsol1 = Module[{fm}, Table[
     fm = FindMinimum[Evaluate[of1],
        {c0, RandomReal[{-1, 1}]}, {s0, RandomReal[{-1, 1}]},
        {c\[Alpha], RandomReal[{-1, 1}]}, {s\[Alpha],
         RandomReal[{-1, 1}]},
        {\[Delta]x, RandomReal[{2, 4}]}, {\[Delta]y,
         RandomReal[{-1.5, 1.5}]},
        {y0, RandomReal[{-1.5, 1.5}]},
        PrecisionGoal -> 12, AccuracyGoal -> 15,
        WorkingPrecision -> 30,
        Method -> "Newton"] // Quiet;
     If[fm[[1]] < 10^-8, fm, Sequence @@ {}], {j, 100}]];, j]

Graphics[{RGBColor[0.36, 0.51, 0.71],
  Point[{\[Delta]x, \[Delta]y} /. N[nsol1[[All, 2]]]]},
                     PlotRange -> {{0, 8}, {-2, 2}}, Axes -> True]

Now we want to eliminate the variables and to obtain universally valid formulas for any root. We introduce some more polynomial variables and eliminate the four terms that contain .

eqs2 = Numerator[
  Together[eqs1 /.
                              \[Alpha] y0 ->
        Log[Y\[Alpha]0] /. y0 -> Log[Y0] /. \[Alpha] \[Delta]y ->
      Log[\[Delta]Y\[Alpha]] /. \[Delta]y -> Log[\[Delta]Y]]]

gb2 = GroebnerBasis[eqs2, {}, { c0, s0, c\[Alpha], s\[Alpha]},
    MonomialOrder -> EliminationOrder] // Factor;

Now we have 15 equations.

Length[gb2]

These equations still describe the positions of the roots.

of2 = Evaluate[
   gb2.gb2 /. {\[Delta]Y -> Exp[\[Delta]y], \[Delta]Y\[Alpha] ->
         Exp[\[Alpha] \[Delta]y]} /. Y0 -> Exp[y0] /.
     Y\[Alpha]0 -> Exp[\[Alpha] y0] /. \[Alpha] -> GoldenRatio];
Monitor[nsol2 = Module[{fm}, Table[
     fm = FindMinimum[Evaluate[of2],
        {\[Delta]x, RandomReal[{2, 4}]}, {\[Delta]y,
         RandomReal[{-1.5, 1.5}]},
        {y0, RandomReal[{-2, 2}]},
        PrecisionGoal -> 12, AccuracyGoal -> 15,
        WorkingPrecision -> 30,
        Method -> "Newton"] // Quiet;
     If[fm[[1]] < 10^-8, fm, Sequence @@ {}] , {j, 100}]];, j]

Graphics[{RGBColor[0.36, 0.51, 0.71],
  Point[{\[Delta]x, \[Delta]y} /. N[nsol2[[All, 2]]]]},
                     PlotRange -> {{0, 8}, {-2, 2}}, Axes -> True]

Let's hope that we do not need 15 equations to find an equation that describes the three values , and . Fortunately, using just the three smallest elements of the GroebnerBasis still yields the desired zero shape.

gb2Sorted = SortBy[gb2, Length];

of3 = Evaluate[#.# &[
        Take[gb2Sorted, 3]] /. {\[Delta]Y ->
         Exp[\[Delta]y], \[Delta]Y\[Alpha] ->
         Exp[\[Alpha] \[Delta]y]} /. Y0 -> Exp[y0] /.
     Y\[Alpha]0 -> Exp[\[Alpha] y0] /. \[Alpha] -> GoldenRatio];
Monitor[nsol3 = Module[{fm}, Table[
     fm = FindMinimum[Evaluate[of3],
        {\[Delta]x, RandomReal[{2, 4}]}, {\[Delta]y,
         RandomReal[{-1.5, 1.5}]},
        {y0, RandomReal[{-2, 2}]},
        PrecisionGoal -> 12, AccuracyGoal -> 15,
        WorkingPrecision -> 30,
        Method -> "Newton"] // Quiet;
     If[fm[[1]] < 10^-8, fm, Sequence @@ {}] , {j, 100}]];, j]

Graphics[{RGBColor[0.36, 0.51, 0.71],
  Point[{\[Delta]x, \[Delta]y} /. N[nsol3[[All, 2]]]]},
                     PlotRange -> {{0, 8}, {-2, 2}}, Axes -> True]

These three equations can be further reduced to just two equations.

eqs3 = List @@ FullSimplify[And @@ (# == 0 & /@ Take[gb2Sorted, 3])]

Plotting these two equations together as functions of , and shows that the regions where both equations are fulfilled are just the ellipse-shaped rings we are after.

eqs3A = (List @@ eqs3) /. {\[Delta]Y ->
    Exp[\[Delta]y], \[Delta]Y\[Alpha] -> Exp[\[Alpha] \[Delta]y],
   Y0 -> Exp[y0], Y\[Alpha]0 -> Exp[\[Alpha] y0]}

ContourPlot3D[Evaluate[eqs3A /. \[Alpha] -> GoldenRatio],
 {\[Delta]x, 0, 8}, {\[Delta]y, -2, 2}, {y0, -2, 2},
 MeshFunctions -> {#3 &}, BoxRatios -> Automatic,
 ViewPoint -> {0.39, 3.059, 1.39}]

To obtain one equation that describes the rings, we also have to eliminate the imaginary parts of the reference zero, meaning . Unfortunately, because the two terms and are not algebraically related, we cannot use GroebnerBasis or Resultant to eliminate . But we are lucky and can solve the first equation for .

sol3A = Solve[eqs3A[[1]], y0]

The resulting implicit equation for the rings is a bit ugly.

(Subtract @@ eqs3A[[2]] == 0) /. sol3A[[2]]

But it can be simplified to a quite nice-looking closed form.

FullSimplify[% /.
  sol3A[[2]], \[Delta]x > 0 \[And] \[Delta]y \[Element]
   Reals \[And] \[Alpha] > 0] 

Plotting this equation together with the zeros calculated above shows a perfect match of the zeros and the closed forms of the curves.

ContourPlot[
 Evaluate[Cos[\[Delta]x] + (-Cos[\[Alpha] \[Delta]x] +
        Cosh[\[Alpha] \[Delta]y])^\[Alpha] (-Cos[\[Delta]x - \[Alpha] \
\[Delta]x] + Cosh[\[Delta]y - \[Alpha] \[Delta]y])^(1 - \[Alpha]) ==
    Cosh[\[Delta]y] /. \[Alpha] -> GoldenRatio],
 {\[Delta]x, 0, 8}, {\[Delta]y, -2, 2}, AspectRatio -> Automatic,
 Prolog -> {RGBColor[0.88, 0.61, 0.14], PointSize[0.01], Opacity[0.5],
    Table[Point[
     ReIm[#[[-1]] - #[[1]]] & /@
      Partition[Take[fGoldenExpZeros, 200], j, 1]], {j, 2, 6}]},
 AxesLabel -> {"\[Delta]x", "\[Delta]y"} ]

Now, taking into account that for general , the resulting formula that describes the roots must be symmetric in and and that for the general three-term sums , it is not difficult to conjecture a closed form for the rings. We have the following implicit description for the relative zero positions. (We use , , to make the equation fully symmetric.)

zeros\[Alpha]\[Beta]\[Gamma][{\[Alpha]_, \[Beta]_, \[Gamma]_}, {\
\[Delta]x_, \[Delta]y_}] := (Cosh[(\[Beta] - \[Alpha]) \[Delta]y] -
     Cos[(\[Beta] - \[Alpha]) \[Delta]x])^(\[Beta] - \[Alpha]) \
(Cosh[(\[Gamma] - \[Beta]) \[Delta]y] -
     Cos[(\[Gamma] - \[Beta]) \[Delta]x])^(\[Gamma] - \[Beta]) \
(Cosh[(\[Gamma] - \[Alpha]) \[Delta]y] -
     Cos[(\[Gamma] - \[Alpha]) \[Delta]x])^(\[Alpha] - \[Gamma]) == 1

A quick check for the exponential polynomial confirms the conjectured equation.

Monitor[fSqrt3EPiExpZeros = SortBy[Flatten[Table[
      z /.
       Solve[Exp[I Sqrt[3] z] + Exp[I E z] + Exp[I Pi z] == 0 \[And]
           -5 < Im[z] < 5 \[And] 50 k <= Re[z] < 50 k + 50, z], {k, 0,
        20}]], Re];, k]

ContourPlot[
 Evaluate[
  zeros\[Alpha]\[Beta]\[Gamma][{Sqrt[3], E,
    Pi}, {\[Delta]x, \[Delta]y}] ],
 {\[Delta]x, 0, 25}, {\[Delta]y, -2, 2}, AspectRatio -> Automatic,
 PerformanceGoal -> "Quality", PlotPoints -> 40,
 MaxRecursion -> 1, PlotPoints -> {120, 40}, WorkingPrecision -> 40,
 Prolog -> {RGBColor[0.88, 0.61, 0.14], PointSize[0.005],
   Opacity[0.5],
   Table[Point[
     ReIm[#[[-1]] - #[[1]]] & /@
      Partition[Take[N@fSqrt3EPiExpZeros, 200], j, 1]], {j, 2, 6}]},
 AxesLabel -> {"\[Delta]x", "\[Delta]y"} ]

In addition to this visual check, we should perform a more stringent test. To do this, we have a look at the difference of the two sides of the equation zeros.

zeros\[Alpha]\[Beta]\[Gamma]Difference[{\[Alpha]_, \[Beta]_, \
\[Gamma]_}, {\[Delta]x_, \[Delta]y_}] =
 Subtract @@
  zeros\[Alpha]\[Beta]\[Gamma][{\[Alpha], \[Beta], \[Gamma]}, {\
\[Delta]x, \[Delta]y}]

Checking the identity with all zeros calculated to one thousand digits shows that the conjectured identity indeed holds. While this is not a proof, it is a very comforting check.

With[{zerosHP = N[fSqrt3EPiExpZeros, 1000]},
   Table[zeros\[Alpha]\[Beta]\[Gamma]Difference[{Sqrt[3], E, Pi},
       ReIm[#[[-1]] - #[[1]]]] & /@ Partition[zerosHP, j, 1], {j, 2,
     6}]] // Abs // Max

The function that appears in the last formula has the following shape in space.

Y[\[Sigma]_, {x_, y_}] := (Cosh[\[Sigma] y] -
   Cos[\[Sigma] x])^\[Sigma]

ContourPlot3D[
 Y[\[Sigma], {x, y}] == 1 , {x, -4 Pi, 4 Pi}, {y, -4, 4}, {\[Sigma],
  0, 3},
 AxesLabel -> {x, y, \[Sigma]}, ViewPoint -> {0.64, -3.02, 1.37},
 MeshFunctions -> {#3 &},
 BoxRatios -> {2, 1, 1}, PlotPoints -> {80, 40, 60},
 MaxRecursion -> 0]

As a function of and , the function Y obeys two symmetric differential equations:

{D[f[x, y], x]^2 - D[f[x, y], y]^2 + 2 D[f[x, y], y]^2 \[Sigma] -
    2 f[x, y] D[f[x, y], y, y] \[Sigma] + f[x, y]^2 \[Sigma]^4,
   D[f[x, y], x]^2 - D[f[x, y], y]^2 - 2 D[f[x, y], x]^2 \[Sigma] +
    2 f[x, y] D[f[x, y], x, x] \[Sigma] + f[x, y]^2 \[Sigma]^4}  /.

  f -> Function[{x, y}, Y[\[Sigma], {x, y}] ] // Simplify

And the even simpler equation:

  \[Sigma] f[x, y] D[f[x, y], x, y] +
   D[f[x, y], x] (D[f[x, y], y] - \[Sigma] D[f[x, y], y]) /.
  f -> Function[{x, y}, Y[\[Sigma], {x, y}] ] // Simplify

A Generalization

One can easily generalize the previous formula that describes the location of the zero differences to the case .

zeroABC\[Alpha]\[Beta]\[Gamma]Curve[{A_, B_,
   C_}, {\[Alpha]_, \[Beta]_, \[Gamma]_}, {x_, y_}] :=
 Abs[A]^(2 (\[Beta] - \[Gamma])) Abs[B]^(2 (\[Gamma] - \[Alpha]))
   Abs[C]^(2 (\[Alpha] - \[Beta]))
   Y[\[Alpha] - \[Gamma], {x, y}] Y[\[Gamma] - \[Beta], {x,
    y}] Y[\[Beta] - \[Alpha], {x, y}]

Here is a random example of a three-term sum with prefactors.

f2[{A_, B_, C_}, {\[Alpha]_, \[Beta]_, \[Gamma]_}, z_] :=
 A Exp[I \[Alpha] z] + B Exp[I \[Beta] z] + C Exp[I \[Gamma]  z] 

The numerically calculated zero differences all are on the implicitly described curve zeroABCCurve.

With[{\[Alpha] = Sqrt[2], \[Beta] = Sqrt[3], \[Gamma] = E/3,
  A = 1/2 Exp[2 I], B = 3/4 Exp[3^(1/3) I], C = 5/4},
 edzs = Sort[
   N[z /. Solve[
      f2[{A, B, C}, {\[Alpha], \[Beta], \[Gamma]}, z] == 0 \[And] -5 <
         Im[z] < 5 \[And] 0 < Re[z] < 500, z], 100]];
 zeroPairs = -Subtract @@@ Subsets[edzs, {2}];
 lp = ListPlot[ReIm /@ zeroPairs, PlotRange -> {{0, 30}, {-2, 2}}];
 Show[{RegionPlot[
    Evaluate[
     zeroABC\[Alpha]\[Beta]\[Gamma]Curve[{A, B,
        C}, {\[Alpha], \[Beta], \[Gamma]}, {x, y}] > 1], {x, 0,
     30}, {y, -2, 2},
    PlotPoints -> 60,
    PlotStyle -> Directive[RGBColor[0.88, 0.61, 0.14], Opacity[0.3]],
    BoundaryStyle -> None], lp}, AspectRatio -> 1/3]]

Phases in the three exponents have no influence on the positions and shapes of the ovals. Here is an example that demonstrates this. The blue points with zero phases are on the same curve as the yellow/brown points that come from the exponential polynomial with phases. Just their position on the curve depends on the phases.

f3[{A_, B_,
   C_}, {\[Alpha]_, \[Beta]_, \[Gamma]_}, {\[CurlyPhi]\[Alpha]_, \
\[CurlyPhi]\[Beta]_, \[CurlyPhi]\[Gamma]_}, z_] :=
 A Exp[I \[Alpha] z + I \[CurlyPhi]\[Alpha]] +
  B Exp[I \[Beta] z + I \[CurlyPhi]\[Beta]] +
  C Exp[I \[Gamma] z + I \[CurlyPhi]\[Gamma]] 

With[{\[Alpha] = Sqrt[2], \[Beta] = Sqrt[3], \[Gamma] = E/3, A = 1/2,
  B = 3/4, C = 5/4,  \[CurlyPhi]\[Alpha] = 1, \[CurlyPhi]\[Beta] =
   2, \[CurlyPhi]\[Gamma] = 3},
 edzs1 = Sort[
   N[z /. Solve[
      f3[{A, B, C}, {\[Alpha], \[Beta], \[Gamma]}, {0, 0, 0}, z] ==
        0 \[And]
                  -5 < Im[z] < 5 \[And] 0 < Re[z] < 500, z], 100]];
 edzs2 = Sort[
   N[z /. Solve[
      f3[{A, B,
          C}, {\[Alpha], \[Beta], \[Gamma]}, {\[CurlyPhi]\[Alpha], \
\[CurlyPhi]\[Beta], \[CurlyPhi]\[Gamma]}, z] == 0 \[And]
       -5 < Im[z] < 5 \[And] 0 < Re[z] < 500, z], 100]];
   ListPlot[{ReIm /@ (-Subtract @@@ Subsets[edzs1, {2}]),
                    ReIm /@ (-Subtract @@@ Subsets[edzs2, {2}])},
  PlotRange -> {{0, 30}, {-2, 2}}] ]

The ovals don't always have to be separated. For appropriate parameter values , , , , and the ovals can melt onto strips. Here is an example.

ContourPlot[
 Evaluate[zeroABC\[Alpha]\[Beta]\[Gamma]Curve[{1, 2, 1}, {0, Log[2],
     Log[3]}, {x, y}] == 1], {x, 0, 40}, {y, -5, 5},
 PlotPoints -> {80, 20}, AspectRatio -> 1/2]

If we use , , that are not incommensurable, the zeros still lay on the curve described by zeroABCCurve. In this case, we sometimes can get closed forms for all zeros. Here is a simple example that brings us back to the golden ratio shown previously.

Solve[ 2 + 2 Exp[1/2 I z] + I Exp[1 I z] == 0, z]

For C[1]==0, we form the difference of the two zeros.

diff = (Subtract @@ (z /. % /. ConditionalExpression[x_, _] :> x /.
      C[1] -> 0)) // FullSimplify

zeroABC\[Alpha]\[Beta]\[Gamma]Curve[{2, 2, I}, {0, 1/2, 1},
   ReIm[diff]] /. (ri : (_Re | _Im)) :>
   ComplexExpand[ri, TargetFunctions -> {Re, Im}] // FullSimplify

N[%, 50]

The two expressions in the denominator are exotic representations of and 1/.

N[{Cosh[ArcTan[Im[((1 + I) - Sqrt[-1 + 2 I])^I]/
      Re[((1 + I) - Sqrt[-1 + 2 I])^I]]],
    Cos[Log[Abs[((1 + I) - Sqrt[-1 + 2 I])^I]]]} - {GoldenRatio,
    1/GoldenRatio}, 20] // Quiet

Unfortunately there is no similar equation that describes the zeros of the sum of four exponentials. The addition of the fourth exponential term changes the behavior of the zero differences dramatically. We calculate 100+ zeros of the three-term sum .

zs = With[{L = 200},
   Monitor[Flatten@Table[
      N[z /.
        Solve[Exp[I Sqrt[2] z] + Exp[I Zeta[3] z] + Exp[I E/2 z] ==
           0 \[And] -30 < Im[z] < 20 \[And] j L < Re[z] < j L + L, z],
        20] , {j, 0, 20}] , j]];

We calculate the -dependent zeros of using the differential equations of these zeros.

nds = NDSolveValue[
  {D[Exp[I Sqrt[2] z[\[CurlyEpsilon]]] +
      Exp[I Zeta[3] z[\[CurlyEpsilon]]] +
      Exp[I E/2 z[\[CurlyEpsilon]]] + \[CurlyEpsilon] Exp[
        I 3^(1/3) z[\[CurlyEpsilon]]], \[CurlyEpsilon]] == 0,
   z[0] == zs}, z, {\[CurlyEpsilon], 0, 1}]

Graphically, the zeros on their own mostly change the real part.

pt[\[CurlyEpsilon]_Real] := ReIm[nds[\[CurlyEpsilon]]]
ParametricPlot[pt[\[CurlyEpsilon]], {\[CurlyEpsilon], 0, 1},
 AspectRatio -> 1/3]

But the differences of the zeros show a much more complicated dependence of .

diffs[\[CurlyEpsilon]_Real] :=
 With[{zeros = SortBy[nds[\[CurlyEpsilon]], Re]},
  ReIm[Flatten[
    Table[zeros[[i + j]] - zeros[[i]], {j, 1, 4}, {i,
      Length[zeros] - j}]]]]

ListPlot[Transpose[
  Table[diffs[N[\[CurlyEpsilon]]], {\[CurlyEpsilon], 0, 1, 1/100}]],
 Joined -> True, PlotStyle -> Thickness[0.002]]

Generically, in the case of four exponentials, the differences between zeros are no longer located on curves, but fill regions of the complex plane densely. The following input calculated about 75,000 zeros of a four-term exponential polynomial. (In the notebook, this cell is set to unevaluatable because it will run a few hours.)

L = 200; counter = 0;
Monitor[
 zs = Flatten@Table[
     N[z /.
       Solve[Exp[I Sqrt[2] z] + Exp[I Zeta[3] z] + Exp[I E/2 z] +
           Exp[I 3^(1/3) z] == 0 \[And] -30 < Im[z] < 20 \[And]
         jj L < Re[z] < jj L + L, z], 20],
     counter = counter + Length[zeros];, {jj, 0, 10^4}]; , { jj,
  counter}]

Plotting the first few differences shows how the zero differences fill out a stripe along the real axis.

ListPlot[Table[
  ReIm[#[[-1]] - #[[1]]] & /@ (
    Partition[SortBy[N[zs], Re], jk, 1]), {jk, 8}],
 PlotStyle -> {PointSize[0.001]}, Frame -> True,
 PlotRange -> {{10, All}, All}, AspectRatio -> 1/2]

Reduced forms of a sum of four exponentials, e.g. one constant term and the remaining three terms algebraically dependent, show an intermediate degree of complexity in the zero differences. Here is an example.

f\[Alpha][z_] :=
 A + 2 Exp[I z] + Exp[I \[Alpha] z] Exp[-I z] +
  Exp[I \[Alpha] z] Exp[I z]

Monitor[sol = Flatten[
    Table[
     Solve[(f\[Alpha][z] ==
          0 /. {A -> 1/3, \[Alpha] -> Sqrt[3]}) && -10 < Im[z] < 10 &&
        20 k < Re[z] < 20 k + 20, z], {k, 0, 50}], 1], k];

zs = Cases[N[z /. sol], _Complex];

ListPlot[ReIm[Subtract @@@ (Reverse /@  Subsets[zs, {2}])],
 PlotRange -> {{0, 12}, All}, Frame -> True, AspectRatio -> 1/3]

Finding a closed form for these curves is surely possible, but the symbolic expressions that are needed in intermediate steps are quite large. So we will postpone this calculation to a later time.

To summarize: continuing some mathematical experiments about the positions of zeros of sums of complex trigonometric functions, "strange" circles were observed. Using a mixture of visualization, numerical experiments and algebraic computations, all of which work seamlessly together in the Wolfram Language, we were able to determine a closed form equation for the positions of these "circles."


Download this post as a Computable Document Format (CDF) file. New to CDF? Get your copy for free with this one-time download.

]]>
http://blog.wolfram.com/2018/05/10/strange-circles-in-the-complex-plane-more-experimental-mathematics-results/feed/ 2
Experience Innovation and Insight at the 2018 Wolfram Technology Conference http://blog.wolfram.com/2018/05/03/experience-innovation-and-insight-at-the-2018-wolfram-technology-conference/ http://blog.wolfram.com/2018/05/03/experience-innovation-and-insight-at-the-2018-wolfram-technology-conference/#comments Thu, 03 May 2018 19:37:21 +0000 Melanie Moore http://blog.internal.wolfram.com/?p=45350 Join us October 16–19, 2018, for four days of hands-on training, workshops, talks and networking with creators, experts and enthusiasts of Wolfram technology. We’ll kick off on Tuesday, October 16, with a keynote address by Wolfram founder and CEO Stephen Wolfram.



Before the conference begins, take a tour of the Wolfram Research headquarters or join one of our in-depth training sessions. Pre-conference opportunities include:

  • Wolfram Language Crash Course for Scientists & Engineers
  • Learn Image Processing with the Wolfram Language
  • The Multiparadigm Data Science Workflow
  • The Data Science Pipeline: Analysis to Insight

Interested in speaking at the conference? The Wolfram Technology Conference is a great platform to share your innovations, stories and work. Submit your abstract by July 27, 2018, for consideration.

Data Science, Engineering, Math and More!

This year’s conference will have three distinct focus areas: Data Science & AI, Engineering & Modeling and Math & Science.

  • Data Science & AI provides hands-on experience, allowing you to work with industry experts to apply automated machine learning, deep neural networks and advanced human-data interfaces to real-world problems.
  • Keep up with the newest tech and best practices in Engineering & Modeling by exploring ways to integrate symbolic-numeric computation, machine learning, visualizations and automated algorithm selection into your workflows.
  • Finally, dive into the latest trends and functionalities in a variety of topical areas, from machine learning to advanced geometry, statistics, chemistry and more in the Math & Science track.

Last year, we introduced the Wolfram Livecoding Championship, where participants answered challenges from Stephen using Wolfram Language code, showing off their skills and competing for the Wolfram Livecoding Championship belt. We’re bringing the Championship back this year, along with other favorites and some new special treats.

To reserve your spot at this year’s Wolfram Technology Conference, register today.

]]>
http://blog.wolfram.com/2018/05/03/experience-innovation-and-insight-at-the-2018-wolfram-technology-conference/feed/ 2
A Tale of Three Cosines—An Experimental Mathematics Adventure http://blog.wolfram.com/2018/04/24/a-tale-of-three-cosines-an-experimental-mathematics-adventure/ http://blog.wolfram.com/2018/04/24/a-tale-of-three-cosines-an-experimental-mathematics-adventure/#comments Tue, 24 Apr 2018 17:00:05 +0000 Michael Trott http://blog.internal.wolfram.com/?p=44716 #post-44716 h2 { margin: 2px 0 0 0; font-size: 22px; padding: 12px 0 6px; display: block; float: none; } #post-44716 h3 { color: #333; margin: 5px 0 10px; font-size: 18px; } #post-44716 blockquote { //padding: 10px 25px; font-family: Georgia; font-style: italic; font-size: 130%; line-height: 1.4; color: #e26a0f; margin: 0 0 8px; //border-top: 1px solid #c3c3c3; //border-bottom: 1px solid #c3c3c3; } #post-44716 blockquote p { margin: 0; padding: 0; }

Identifying Peaks in Distributions of Zeros and Extrema of Almost-Periodic Functions: Inspired by Answering a MathOverflow Question

One of the Holy Grails of mathematics is the Riemann zeta function, especially its zeros. One representation of is the infinite sum . In the last few years, the interest in partial sums of such infinite sums and their zeros has grown. A single cosine or sine function is periodic, and the distribution of its zeros is straightforward to describe. A sum of two cosine functions can be written as a product of two cosines, . Similarly, a sum of two sine functions can be written as a product of . This reduces the zero-finding of a sum of two cosines or sines to the case of a single one. A sum of three cosine or sine functions, , is already much more interesting.

Fifteen years ago, in the notes to chapter 4 of Stephen Wolfram’s A New Kind of Science, a log plot of the distribution of the zero distances…

A New Kind of Science, notes from Chapter 4

… of the zero distribution of —showing characteristic peaks—was shown.

And a recent question on MathOverflow.net asked for the closed forms of the positions of the maxima of the distribution of the distances of successive zeros of almost-periodic functions of the form for incommensurate and . The post showed some interesting-looking graphics, the first of which was the following ( is the golden ratio) for the distance between successive zeros (taking into account the first 100k positive zeros):

Positions of the maxima

At first, one might be skeptical seeing such an unusual-looking histogram, but a quick one-liner that calculates all zeros in the intervals and does confirm a distribution of the shape shown above as a universal shape independent of the argument range for large enough intervals.

Function[x0, Histogram[Differences[
     t /. Solve[
      Cos[t] + Cos[GoldenRatio t] + Cos[GoldenRatio^2 t] == 0 \[And]
       x0 < t < x0 + 10^3 \[Pi], t]], 200]] /@ {0, 10^6}

Output 1

And the MathOverflow post goes on to conjecture that the continued fraction expansions of are involved in the closed-form expressions for the position of the clearly visible peaks around zero distance , with 1, 1.5, 1.8 and 3.0. In the following, we will reproduce this plot, as well as generate, interpret and analyze many related ones; we will also try to come to an intuitive as well as algebraic understanding of why the distribution looks so.

It turns out the answer is simpler, and one does not need the continued fraction expansion of . Analyzing hundreds of thousands of zeros, plotting the curves around zeros and extrema and identifying envelope curves lets one conjecture that the positions of the four dominant singularities are twice the smallest roots of the four equations.

Or in short form: .

The idea that the concrete Diophantine properties of and determine the positions of the zeros and their distances seems quite natural. A well-known example where the continued fraction expansion does matter is the difference set of the sets of numbers for a fixed irrational (Bleher, 1990). Truncating the set of for , one obtains the following distributions for the spacings between neighboring values of . The distributions are visibly different and do depend on the continued fraction properties of .

sumSpacings[\[Alpha]_, n_] :=
 With[{k = Ceiling[Sqrt[n/\[Alpha]]]}, Take[#, UpTo[n]] &@N@
    Differences[
     Sort[Flatten[
       Table[N[i + \[Alpha] j, 10], {i, Ceiling[\[Alpha] k]}, {j,
         k}]]]]]

ListLogLogPlot[Tally[sumSpacings[1/#, 100000]],
                              Filling -> Axis,
   PlotRange -> {{10^-3, 1}, All},
   PlotLabel -> HoldForm[\[Alpha] == 1/#],

   Ticks -> {{ 0.01, 0.1, 0.5}, Automatic}] & /@ {GoldenRatio, Pi,
  CubeRoot[3]}

Output 2

Because for incommensurate values of and , one could intuitively assume that all possible relative phases between the three cos terms occur with increasing . And because most relative phase situations do occur, the details of the (continued fraction) digits of and do not matter. But not every possible curve shape of the sum of the three cos terms will be after a zero, nor will they be realized; the occurring phases might not be equally or uniformly distributed. But concrete realizations of the phases will define a boundary curve of the possible curve shapes. At these boundaries (envelopes), the curve will cluster, and these clustered curves will lead to the spikes visible in the aforementioned graphic. This clustering together with the almost-periodic property of the function leads to the sharp peaks in the distribution of the zeros.

The first image in the previously mentioned post uses the function , with being the golden ratio. Some structures in the zero distribution are universal and occur for all functions of the form for generic nonrational , , but some structures are special to the concrete coefficients , , the reason being that the relation slips in some dependencies between the three summands , and . (The three-parameter case of can be rescaled to the above case with only two parameters, and .) At the same time, the choice , has most of the features of the generic case. As we will see, using , for other quadratic irrationals generates zero spacing distributions with additional structures.

In this blog, I will demonstrate how one could come to the conjecture that the above four equations describe the positions of the singularities using static and interactive visualizations for gaining intuition of the behavior of functions and families of functions; numerical computations for obtaining tens of thousand of zeros; and symbolic polynomial computations to derive (sometimes quite large) equations.

Although just a simple sum, three real cosines with linear arguments, the zeros, extrema and function values will show a remarkable variety of shapes and distributions.

After investigating an intuitive approach based on envelopes, an algebraic approach will be used to determine the peaks of the zero distributions as well as the maximal possible distance between two successive zeros.

Rather than stating and proving the result for the position of the peaks, in this blog I want to show how, with graphical and numerical experiments, one is naturally led to the result. Despite ( being the golden ratio) being such a simple-looking function, it turns out that the distribution and correlation of its function values, zeros and extrema are rich sources of interesting, and for most people unexpected, structures. So in addition to finding the peak position, I will construct and analyze various related graphics and features, as well as some related functions.

While this blog does contain a fair amount of Wolfram Language code, the vast majority of inputs are short and straightforward. Only a few more complicated functions will have to be defined.

The overall plan will be the following:

    • Look at the function values of for various and to get a first impression of the function
    • Calculate and visualize the zeros of
    • Calculate and visualize the extrema of
    • Divide the zeros into groups and plot them around their zeros to identify common features
    • Ponder about the plots of around the zeros, and identify the role of envelopes
    • Develop algebraic equations that describe the peak positions of the zero distributions
    • Numerically and semi-analytically investigate the distribution in the neighborhood of the peaks
    • Determine the maximal spacing between successive zeros

From time to time, we will take a little detour to have a look at some questions that come up naturally while carrying out the outlined steps. Although simple and short looking, the function has a lot of interesting features, and even in this long blog (the longest one I have ever written!), not all features of interest can be discussed.

The distribution of function values of the sums of the three sine/cosine function is discussed in Blevins, 1997, and the pair correlation between successive zeros was looked at in Maeda, 1996.

Introduction and Almost Recurrences

Here are some almost-periodic functions. The functions are all of the form for incommensurate and .

fGolden[x_] := Cos[x] + Cos[GoldenRatio x] + Cos[GoldenRatio^2 x]

fPi[x_] := Cos[x] + Cos[Pi x] + Cos[Pi^2 x]

fSqrt[x_] := Cos[x] + Cos[Sqrt[2] x] + Cos[Sqrt[3] x]

fCbrt[x_] := Cos[x] + Cos[CubeRoot[2] x] + Cos[CubeRoot[3] x]

Here is a plot of these four functions. Note that they have a visibly different character, e.g. the blue curve, on average, doesn’t seem to extend as much toward negative values as the other curves.

Plot[{fGolden[x], fPi[x], fSqrt[x], fCbrt[x]} // Evaluate, {x, 0,
  10 Pi},
 PlotStyle -> Thickness[0.002], PlotLegends -> "Expressions"] 

Output 3

The following interactive demonstration allows one to change the parameters and as well as the ranges over which the function is plotted. (Try to find parameter values such that four or more consecutive extrema are all above or below the real axis.)

Manipulate[
 Plot[Evaluate[
   Cos[x0 + \[Delta]x] + Cos[\[Alpha]\[Beta][[1]] (x0 + \[Delta]x)] +
    Cos[\[Alpha]\[Beta][[2]] (x0 + \[Delta]x)]],
             {\[Delta]x, -X, X}, PlotPoints -> 60, PlotRange -> 3.2,

  PlotLabel ->
   Row[{{"\[Alpha]", "\[Beta]"}, "\[Equal]\[ThinSpace]",
     NumberForm[\[Alpha]\[Beta], 3]}]],
 {{\[Alpha]\[Beta], {3., 2.5}, "\[Alpha],\[Beta]"}, {0, 0}, {3, 3}},
 {{X, 22.7}, 0, 30, Appearance -> "Labeled"},
 {{x0, 473, Subscript["x", 0]}, 0, 1000, Appearance -> "Labeled"},
 TrackedSymbols :> True]

Output 4

And here is a 2D plot of the function over the plane. The interplay between periodicity and broken periodicity is nicely visible.

 With[{m = 600},
 ReliefPlot[
  Log[Abs[Table[
      Evaluate[N[1. Cos[x] + Cos[\[Alpha] x] + Cos[\[Alpha]^2 x]]] ,
                                                 {\[Alpha], 0, 3/2,
       3/2/m}, {x, 0, 48 Pi, 48 Pi/(2 m)}]] + 1],
                         FrameTicks -> True, AspectRatio -> 1/3,
                         DataRange -> {{0, 48 Pi}, {0, 3/2}},
  FrameLabel -> {x, \[Alpha]}]]

Output 5

The interplay between translation symmetry along the axis and symmetry violations becomes even more visible if one colors the connected regions where the function value is negative.

rp = RegionPlot[
  Cos[x] + Cos[\[Alpha] x] + Cos[\[Alpha]^2 x] < 0, {x, 0,
   48 Pi}, {\[Alpha], 0, 5/4},
                         PlotPoints -> {200, 80}, AspectRatio -> 1/3,
  FrameLabel -> {x, \[Alpha]}]

Output 6

We color the connected regions with different colors. The connected regions of one color will gain more meaning below when we construct parts of the Riemann surface of .

Graphics[{EdgeForm[], Antialiasing -> False,
    Blend[{RGBColor[0.88, 0.61, 0.14], RGBColor[0.36, 0.51, 0.71]},
     RandomReal[]], MeshPrimitives[#, 2]} & /@
  ConnectedMeshComponents[
   MeshRegion[#1, Cases[#2, _Polygon, \[Infinity]]] & @@
    Cases[rp, _GraphicsComplex, \[Infinity]][[1]]],
 AspectRatio -> 1/3, Frame -> True, FrameLabel -> {x, \[Alpha]}]

Output 7

The zero set of the more general surface forms a regular network-like surface. A 3D plot of the zero surface shows this nicely. The irregularities in the last image with the colored regions arise from slicing the 3D surface from the next image with the surface .

ContourPlot3D[
 Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x] == 0, {x, 0,
  80}, {\[Alpha], 0, 3/2}, {\[Beta], 0, 3/2},
 RegionFunction -> (#2 < #3 &), MeshFunctions -> {Norm[{#1, #2}] &},
 PlotPoints -> {60, 60, 160}, MaxRecursion -> 0,
 BoxRatios -> {3, 1, 1},
 ViewPoint -> {-1.04, -3.52, 0.39},
 AxesLabel -> {x, \[Alpha], \[Beta]}, ImageSize -> 400]

Output 8

Let’s now focus on the first function from above, . As already mentioned, this function is a bit special compared to the generic case where and are totally unrelated. Expanding the two golden ratios, we have the following representation.

fGolden[x] // FunctionExpand // Simplify

Output 9

This function will generate a distribution of zero distances with sharp discontinuities, something that will not happen in the generic case.

Plot[fGolden[x], {x, 0, 33 Pi}]

Output 10

Interestingly, and probably unexpectedly, one sees many positions with , but no function values with .

The special nature of the sum of the three-cosine term comes from the fundamental identities that define the golden ratio.

Entity["MathematicalConstant", "GoldenRatio"]["Identities"] //
  Take[#, 5] & // TraditionalForm

Output 11

While will never strictly repeat itself (its period is zero)...

FunctionPeriod[fGolden[x], x]

Output 12

... when we calculate the squared difference of and over , one sees that the function nearly repeats itself many, many times. (To make the values where and are nearly identical, I plot the negative logarithm of the difference, meaning spikes correspond to the values of where over a domain of size .)

overlapDiff = (Integrate[#, {x, 0, X}] & /@
    Expand[(fGolden[x] - fGolden[T + x])^2]);
cfOverlapDiff = Compile[{T, X}, Evaluate[overlapDiff]];

Plot[-Log[Abs[cfOverlapDiff[T, 2 Pi]]], {T, 1, 10000},
           AxesOrigin -> {0, -4}, PlotPoints -> 2000,
 PlotRange -> All, AxesLabel -> {T, None}]

Output 13

Locating the peak around 2,400, more precisely, one sees that in this neighborhood the two functions nearly coincide. The difference over a  interval is quite small, on the order of 0.005. We can easily locate the exact location of this local maximum.

FindMaximum[-Log[Abs[overlapDiff /. X -> 2 Pi]], {T, 2369},
                              WorkingPrecision -> 50,
  PrecisionGoal -> 20] // N[#, 20] &

Output 14

In the left graphic, the two curves are not distinguishable; the right plot shows the difference between the two curves.

With[{T = 2368.763898630},
     {Plot[{fGolden[x], fGolden[T + x]}, {x, 0, 2 Pi}],
  Plot[fGolden[x] - fGolden[T + x], {x, 0, 2 Pi},
   PlotLabel -> "difference"]}]

Output 15

The choice , results in some nontypical (compared to the case of general ) correlations between the last two summands. The following interactive demonstration shows a phase space–like plot of and its derivative with changeable and .

Manipulate[
 Column[{Row[{Row[{"\[Alpha]",
        "\[ThinSpace]\[Equal]\[ThinSpace]", \[Alpha]}], "  |  ",
      Row[{"\[Beta]",
        "\[ThinSpace]\[Equal]\[ThinSpace]", \[Beta]}]}],
    If[d == 2,
     ParametricPlot[
      Evaluate[{Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x],
        D[Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x], x]}],
                               {x, 0, 10^xMax}, AspectRatio -> 1,
      PlotPoints -> Ceiling[10^xMax 4],

      PlotStyle ->
       Directive[Thickness[0.001], RGBColor[0.36, 0.51, 0.71]],
                                 ImageSize -> 360,
      PlotRange -> {3 {-1, 1}, (1 + \[Alpha] + \[Beta]) {-1, 1}},
                                 Frame -> True, Axes -> False],
       ParametricPlot3D[
      Evaluate[{Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x],
        D[Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x], x],

        D[Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x], x, x]}],
                               {x, 0, 10^xMax}, AspectRatio -> 1,
      PlotPoints -> Ceiling[10^xMax 4],

      PlotStyle ->
       Directive[Thickness[0.001], RGBColor[0.36, 0.51, 0.71]],
                                 ImageSize -> 360,
      Axes -> False,     

      PlotRange -> {3 {-1, 1}, (1 + \[Alpha] + \[Beta]) {-1,
          1}, (1 + \[Alpha]^2 + \[Beta]^2) {-1, 1}} ]]},
                                            Alignment -> Center] //
  TraditionalForm,
 {{d, 2, ""}, {2 ->
    Row[{Style["x", Italic], ",", Style["x", Italic], "'"}], 

   3 -> Row[{Style["x", Italic], ",", Style["x", Italic], "'", ",",
      Style["x", Italic], "''"}]}},
 {{xMax, 2.8, Subscript["x", "max"]}, 0.1, 4},
 {{\[Alpha], GoldenRatio}, 1/2, 3}, {{\[Beta], GoldenRatio^2}, 1/2, 3},
 TrackedSymbols :> True]

Output 16

The fϕ(x) ≈ 3 Recurrences

Among the positions where the function will nearly repeat will also be intervals where . Let’s find such values. To do this, one needs to find values of such that simultaneously the three expressions , and are very near to integer multiples of . The function rationalize yields simultaneous rational approximations with an approximate error of . (See Zhang and Liu, 2017 for a nice statistical physics-inspired discussion of recurrences.)

rationalize[\[Alpha]s_List, \[CurlyEpsilon]_] :=
 Module[{B, RB, q, T, Q = Round[1/\[CurlyEpsilon]]},
       B = Normal[SparseArray[Flatten[ {{1, 1} -> 1,
        MapIndexed[({1, #2[[1]] + 1} -> Round[Q #]) &, \[Alpha]s],
       Table[{j, j} -> Q, {j, 2, Length[\[Alpha]s] + 1}]}]]];
      RB = LatticeReduce[B];
      (* common denominator *) q = Abs[RB[[1, 1]]];
  -Round[Rest[RB[[1]]]/Q - q \[Alpha]s]/q ] 

Here is an example of three rationals (with a common denominator) that within an error of about are approximations of 1, , . (The first one could be written as .)

rationalize[{1, GoldenRatio, GoldenRatio^2}, 10^-40]

Output 17

Block[{$MaxExtraPrecision = 1000},
 N[% - {1, GoldenRatio, GoldenRatio^2}, 10]]

Output 18

Given these approximations, one can easily calculate the corresponding “almost” period of (meaning ).

getPeriod[\[Alpha]s_, \[CurlyEpsilon]_] :=
 Module[{rat, den, period},
                   rat = rationalize[\[Alpha]s, \[CurlyEpsilon]];
                  den = Denominator[Last[rat]];
                 period = 2 Pi den ]

The arguments are listed in increasing order, such that assumes values very close to 3.

(nearlyThreeArguments =
   Table[period =
      getPeriod[{1, GoldenRatio, GoldenRatio^2}, 10^-exp];
              {period, N[3 - fGolden[period], 10]},
     {exp, 2, 20, 0.1}] // DeleteDuplicates) // Short[#, 6] &

Output 19

ListLogLogPlot[nearlyThreeArguments]

Output 20

Around , the function again takes on the value 3 up to a difference on the order of .

TLarge = getPeriod[{1, GoldenRatio, GoldenRatio^2}, 10^-1001]

Output 21

Block[{$MaxExtraPrecision = 10000}, N[3 - fGolden[TLarge], 10]]

Output 22

The Function Values of fϕ(x)

Now let us look at the function in more detail, namely the distribution of the function values of at various scales and discretizations. The distribution seems invariant with respect to discretization scales (we use the same amount of points in each of the four intervals.).

 (With[{max = Round[500 #/0.001]},
     Histogram[Table[Evaluate[N[fGolden[x]]], {x, 0, max Pi, #}],
      500, PlotLabel -> Row[{"[", 0, ",", max Pi, "]"}]]] & /@
                                           {0.001, 0.01, 0.1, 1}) //
 Partition[#, 2] &

Output 23

Interestingly, the three terms , and are always partially phase locked, and so not all function values between –3 and 3 are attained. Here are the values of the three summands for different arguments. Interpreted as 3-tuples within the cube , these values are on a 2D surface. (This is not the generic situation for general and , in which case the cube is generically densely filled; see below).

Graphics3D[{PointSize[0.001], RGBColor[0.36, 0.51, 0.71], Opacity[0.4],
  Point[Union@
    Round[Table[
      Evaluate[
       N[{Cos[x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}]],
                                                      {x, 0, 500 Pi,
       0.02}], 0.01]]},
                          PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
 Axes -> True,

 AxesLabel -> {x, Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}]

Output 24

The points are all on a tetrahedron-like surface. Plotting the images of the intervals in different colors shows nicely how this surface is more and more covered by repeatedly winding around the tetrahedron-like surface, and no point is ever assumed twice.

Show[Table[
  ParametricPlot3D[
   Evaluate[N[{Cos[x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}]],
                     {x, k 2 Pi, (k + 1) 2 Pi},
   PlotStyle ->
    Directive[
     Blend[{{0, RGBColor[0.88, 0.61, 0.14]}, {30,
        RGBColor[0.36, 0.51, 0.71]},
       {60, RGBColor[0.561, 0.69, 0.19]}}, k],
     Thickness[0.001]]], {k, 0, 60}],

 AxesLabel -> {x, Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}]

Output 25

Ultimately, the fact that the points are all on a surface reduces to the fact that the points are not filling the cube densely, but rather are located on parallel planes with finite distance between them.

Graphics3D[{PointSize[0.002], RGBColor[0.36, 0.51, 0.71],

  Point[Table[
    Mod[{x, GoldenRatio x, GoldenRatio^2 x}, 2 Pi], {x, 0.,
     10000}]]},

 AxesLabel -> (HoldForm[Mod[# x, 2 Pi]] & /@ {1, GoldenRatio,
     GoldenRatio^2}),

 PlotRange -> {{0, 2 Pi}, {0, 2 Pi}, {0, 2 Pi}}]

Output 26

As we will look at distances often in this blog, let us have a quick look at the distances of points on the surface. To do this, we use 1,000 points per intervals, and we will use 1,000 intervals. The left graphic shows the distribution between consecutive points, and the right graphic shows the distance to the nearest point for all points. The peaks in the right-hand histogram come from points near the corners as well as from points of bands around diameters around the smooth parts of the tetrahedron-like surface.

Module[{pts =
   Table[ {Cos[x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]},
                                      {x, 0. 2 Pi, 1000 2 Pi,
     2 Pi/1000}], nf},
 nf = Nearest[pts];
    {Histogram[EuclideanDistance @@@ Partition[pts, 2, 1], 1000,
   PlotRange -> All],
  Histogram[EuclideanDistance[#, nf[#, 2][[-1]]] & /@ pts, 1000,
   PlotRange -> All]}]

Output 27

The tetrahedron-like shape looks like a Cayley surface, and indeed, the values fulfill the equation of a Cayley surface. (Later, after complexifying the equation for , it will be obvious why a Cayley surface appears here.)

x^2 + y^2 + z^2 == 1 + 2 x y z /.
  {x -> Cos[t], y -> Cos[GoldenRatio t],
   z -> Cos[GoldenRatio^2 t]} // FullSimplify

Output 28

While the three functions , , are algebraically related through a quadratic polynomial, any pair of these three functions is not related through an algebraic relation; with ranging over the real numbers, any pair covers the square densely.

With[{c1 = Cos[1 x], c\[Phi] = Cos[GoldenRatio x],
  c\[Phi]2 = Cos[GoldenRatio^2 x], m = 100000},
 Graphics[{PointSize[0.001], RGBColor[0.36, 0.51, 0.71],
     Point[Table[#, {x, 0., m, 1}]]}] & /@ {{c1, c\[Phi]}, {c1,
    c\[Phi]2}, {c\[Phi], c\[Phi]2}}]

Output 29

This means that our function for a given contains only two algebraically independent components. This algebraic relation will be essential for understanding the special case of the cosine sum for , and for getting some closed-form polynomials for the zero distances later.

This polynomial equation of the three summands also explains purely algebraically why the observed minimal function value of is not –3, but rather –3/2.

MinValue[{x + y + z,
  x^2 + y^2 + z^2 == 1 + 2 x y z \[And] -1 < x < 1 \[And] -1 < y <
    1 \[And] -1 < z < 1}, {x, y, z}]

Output 30

cayley = ContourPlot3D[
   x^2 + y^2 + z^2 == 1 + 2 x y z, {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
    Mesh -> None];

And the points are indeed on it. Advancing the argument by and coloring the spheres successively, one gets the following graphic.

With[{M = 10000, \[Delta] = 1},
 Show[{cayley, Graphics3D[Table[{ColorData["DarkRainbow"][x/M],
      Sphere[N[{Cos[1. x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}],
        0.02]},
                                                      {x, 0,
      M, \[Delta]}]]}, Method -> {"SpherePoints" -> 8}]]

Output 31

Here I will make use of the function , which arises from by adding independent phases to the three cosine terms. The resulting surface formed by as varies and forms a more complicated shape than just a Cayley surface.

Manipulate[
 With[{pts =
    Table[Evaluate[
      N[{Cos[x + \[CurlyPhi]1], Cos[GoldenRatio x + \[CurlyPhi]2],
        Cos[GoldenRatio^2 x + \[CurlyPhi]3]}]], {x, 0, M Pi,
      10^\[Delta]t}]},
  Graphics3D[{PointSize[0.003], RGBColor[0.36, 0.51, 0.71],
    Thickness[0.002],

    Which[pl == "points", Point[pts], pl == "line", Line[pts],
     pl == "spheres", Sphere[pts, 0.2/CubeRoot[Length[pts]]]]},
   PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
   Method -> {"SpherePoints" -> 8}]],
 {{pl, "line", ""}, {"line", "points", "spheres"}},
 {{M, 100}, 1, 500, Appearance -> "Labeled"},
 {{\[Delta]t, -1.6}, -2, 1},
 {{\[CurlyPhi]1, Pi/2, Subscript["\[CurlyPhi]", 1]}, 0, 2 Pi,
  Appearance -> "Labeled"},
 {{\[CurlyPhi]2, Pi/2, Subscript["\[CurlyPhi]", 2]}, 0, 2 Pi,
  Appearance -> "Labeled"},
 {{\[CurlyPhi]3, Pi/2, Subscript["\[CurlyPhi]", 3]}, 0, 2 Pi,
  Appearance -> "Labeled"},
  TrackedSymbols :> True] 

Output 32

The points are still located on an algebraic surface; the implicit equation of the surface is now the following.

surface[{x_, y_,
   z_}, {\[CurlyPhi]1_, \[CurlyPhi]2_, \[CurlyPhi]3_}] := (x^4 + y^4 +
     z^4) - (x^2 + y^2 + z^2) + 4 x^2 y^2 z^2 -
  x y z (4 (x^2 + y^2 + z^2) -
     5) Cos[\[CurlyPhi]1 + \[CurlyPhi]2 - \[CurlyPhi]3] + (2 (x^2 y^2 \
+ x^2 z^2 + y^2 z^2) - (x^2 + y^2 + z^2) + 1/2) Cos[
    2 (\[CurlyPhi]1 + \[CurlyPhi]2 - \[CurlyPhi]3)] -
  x y z Cos[3 (\[CurlyPhi]1 + \[CurlyPhi]2 - \[CurlyPhi]3)] +
  Cos[4 (\[CurlyPhi]1 + \[CurlyPhi]2 - \[CurlyPhi]3)]/8 + 3/8

surface[{Cos[t + \[CurlyPhi]1], Cos[GoldenRatio t + \[CurlyPhi]2],
     Cos[GoldenRatio^2 t + \[CurlyPhi]3]}, {\[CurlyPhi]1, \
\[CurlyPhi]2, \[CurlyPhi]3}] // TrigToExp // Factor // Simplify

Output 33

For vanishing phases , and , one recovers the Cayley surface.

surface[{x, y, z}, {0, 0, 0}] // Simplify

Output 34

Note that the implicit equation does only depend on a linear combination of the three parameters, namely . Here are some examples of the surface.

Partition[
 Table[ContourPlot3D[
   Evaluate[surface[{x, y, z}, {c, 0, 0}] == 0], {x, -1.1,
    1.1}, {y, -1.1, 1.1}, {z, -1.1, 1.1},
   MeshFunctions -> (Norm[{#1, #2, #3}] &),
   MeshStyle -> RGBColor[0.36, 0.51, 0.71],
   PlotPoints -> 40, MaxRecursion -> 2, Axes -> False,
   ImageSize -> 180], {c, 6}], 3]

Output 35

As a side note, I want to mention that for being the smallest positive solution of are also all on the Cayley surface.

Table[With[{p = Root[-1 - # + #^deg &, 1]},
   x^2 + y^2 + z^2 - (1 + 2 x y z) /.
    {x -> Cos[t], y -> Cos[p t], z -> Cos[p^deg t]}] //
  FullSimplify, {deg, 2, 12}]

Output 36

An easy way to understand why the function values of are on a Cayley surface is to look at the functions whose real part is just . For the exponential case = , due to the additivity of the exponents, the corresponding formula becomes quite simply due to the defining equality for the golden ratio.

Exp[I z] *  Exp[I GoldenRatio z] == Exp[I GoldenRatio^2 z] // Simplify

Output 37

Using the last formula and splitting it into real and imaginary parts, it is now easy to derive the Cayley surface equation from the above. We do this by writing down a system of equations for the real and imaginary components, the corresponding equations for all occurring arguments and eliminate the trigonometric functions.

GroebnerBasis[
 {xc yc - zc,
  xc - (Cos[t] + I Sin[t]),
  yc - (Cos[GoldenRatio t] + I Sin[GoldenRatio t]),
  zc - (Cos[GoldenRatio^2 t] + I Sin[GoldenRatio^2 t]),
  x - Cos[t], y - Cos[GoldenRatio t], z - Cos[GoldenRatio^2 t],
  Cos[t]^2 + Sin[t]^2 - 1,
  Cos[GoldenRatio t]^2 + Sin[GoldenRatio t]^2 - 1,
  Cos[GoldenRatio ^2 t]^2 + Sin[GoldenRatio^2 t]^2 - 1 }, {},
    {Cos[t], Cos[GoldenRatio t], Cos[GoldenRatio^2 t],
  Sin[t], Sin[GoldenRatio t], Sin[GoldenRatio^2 t], xc, yc, zc}]

Output 38

For generic , , the set of triples for with increasing will fill the cube. For rational , , the points are on a 1D curve for special algebraic values of , . The following interactive demonstration allows one to explore the position of the triples in the cube. The demonstration uses three 2D sliders (rather than just one) for specifying and to allow for minor modifications of the values of and .

Manipulate[
 With[{\[Alpha] = \[Alpha]\[Beta][[1]] + \[Delta]\[Alpha]\[Beta][[
      1]] + \[Delta]\[Delta]\[Alpha]\[Beta][[
      1]], \[Beta] = \[Alpha]\[Beta][[2]] + \[Delta]\[Alpha]\[Beta][[
      2]] + \[Delta]\[Delta]\[Alpha]\[Beta][[2]]},
  Graphics3D[{PointSize[0.003], RGBColor[0.36, 0.51, 0.71],
    Opacity[0.66],
    Point[
     Table[Evaluate[N[{Cos[x], Cos[\[Alpha] x], Cos[\[Beta] x]}]], {x,
        0, M Pi, 10^\[Delta]t}]]},
   PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
   PlotLabel ->
    NumberForm[
     Grid[{{"\[Alpha]", \[Alpha]}, {"\[Beta]", \[Beta]}},
      Dividers -> Center], 6]]],
 {{M, 100}, 1, 500, Appearance -> "Labeled"},
 {{\[Delta]t, -2,
   Row[{"\[Delta]" Style["\[NegativeThinSpace]t", Italic]}]}, -3,
  1},
 Grid[{{"{\[Alpha],\[Beta] }", "{\[Alpha], \[Beta]} zoom",
    "{\[Alpha], \[Beta]} zoom 2"},
   {Control[{{\[Alpha]\[Beta], {0.888905, 1.27779}, ""}, {1/2,
       1/2}, {3, 3}, ImageSize -> {100, 100}}],
    Control[{{\[Delta]\[Alpha]\[Beta], {0.011, -0.005},
       ""}, {-0.02, -0.02}, {0.02, 0.02}, ImageSize -> {100, 100}}],
    Control[{{\[Delta]\[Delta]\[Alpha]\[Beta], {-0.00006, 0.00008},
       ""}, {-0.0002, -0.0002}, {0.0002, 0.0002},
      ImageSize -> {100, 100}}]}}] , TrackedSymbols :> True]

Output 39

The degree of filling depends sensitively on the values of and . Counting how many values after rounding are used in the cube gives an estimation of the filling. For the case , the following plot shows that the filling degree is a discontinuous function of . The lowest filling degree is obtained for rational with small denominators, which results in closed curves in the cube. (We use rational values for , which explains most of the small filling ratios.)

usedCubes[\[Alpha]_] := Length[Union[Round[Table[Evaluate[
      N[{Cos[x], Cos[\[Alpha] x], Cos[\[Alpha]^2 x]}]], {x, 0.,
      1000 Pi, Pi/100.}],
         (* rounding *)0.01]]]

ListLogPlot[
 Table[{\[Alpha], usedCubes[\[Alpha]]}, {\[Alpha], 1, 2, 0.0005}],
 Joined -> True,
                           GridLines -> {{GoldenRatio}, {}}]

Output 40

Plotting over a large domain shows clearly that not all possible values of occur equally often. Function values near –1 seem to be assumed much more frequently.

Plot[Evaluate[fGolden[x]], {x, 0, 1000 Pi},
 PlotStyle -> Directive[ Opacity[0.3], Thickness[0.001]],
 Frame -> True, PlotPoints -> 10000]

Output 42

How special is with respect to not taking on negative values near –3? The following graphic shows the smallest function values of the function over the domain as a function of . The special behavior near is clearly visible, but other values of , such that the extremal function value is greater than –3, do exist (especially rational and/or rational ).

ListPlot[Monitor[
     Table[{\[Alpha],
    Min[Table[
      Evaluate[N[Cos[x] + Cos[\[Alpha] x] + Cos[\[Alpha]^2 x]]],
      {x, 0., 100 Pi, Pi/100.}]]}, {\[Alpha], 1, 2,
    0.0001}], \[Alpha]],
 PlotRange -> All, AxesLabel -> {"\[Alpha]", None}]

Output 43

And the next graphic shows the minimum values over the plane. I sample the function in the intervals and . Straight lines with simple rational relations between and emerge.

cfMin = Compile[{max},
   Table[Min[
     Table[Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x], {x, 1. Pi, max,
       Pi/100}]], {\[Beta], 0, 2, 1/300}, {\[Alpha], 0, 2, 1/300}]];

ReliefPlot[cfMin[#], Frame -> True, FrameTicks -> True,
   DataRange -> {{0, 2}, {0, 2}}, ImageSize -> 200] & /@ {10 Pi,
  100 Pi} 

Here are the two equivalent images for the maxima.

cfMax = Compile[{max},
   Table[Max[
     Table[Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x], {x, 1. Pi, max,
       Pi/100}]], {\[Beta], 1/2, 2, 1/300}, {\[Alpha], 1/2, 2,
     1/300}]];

ReliefPlot[cfMax[#], Frame -> True, FrameTicks -> True,
   DataRange -> {{0, 2}, {0, 2}}, ImageSize -> 200] & /@ {10 Pi,
  100 Pi} 

The Zeros of fϕ(x) and Distances between Successive Zeros

Now I will work toward reproducing the first graphic that was shown in the MathOverflow post. The poster also gives a clever method to quickly calculate 100k+ zeros based on solving the differential equation and recording zero crossings on the fly using WhenEvent to detect zeros. As NDSolve will adaptively select step sizes, a zero of the function can be conveniently detected as a side effect of solving the differential equation of the derivative of the function whose zeros we are interested in. I use an optional third argument for function values different from zero. This code is not guaranteed to catch every single zero—it might happen that a zero is missed; using the MaxStepSize option, one could control the probability of a miss. Because we are only interested in statistical properties of the zeros, we use the default option value of MaxStepSize.

findZeros[f_, n_, f0_: 0, ndsolveoptions : OptionsPattern[]] :=
 Module[{F, zeroList, counter, t0},
  zeroList = Table[0, {n}];
  counter = 0;
  Monitor[
    NDSolve[{F'[t] == D[f[t], t], F[0] == f[0],
                    WhenEvent[F[t] == f0, counter++; t0 = t;
                                          (* locate zeros,
       store zero,
       and use new starting value *)
                                 \
         If[counter <= n, zeroList[[counter]] = t0,
                                           F[t0] = f[t0];
        "StopIntegration"],
       "LocationMethod" -> {"Brent", PrecisionGoal -> 10}]},
     F, {t, 10^8,  10^8},
         ndsolveoptions, Method -> "BDF", PrecisionGoal -> 12,
     MaxSteps -> 10^8, MaxStepSize -> 0.1],
    {"zero counter" -> counter, "zero abscissa" -> t0}] // Quiet;
  zeroList]

Here are the first 20 zeros of .

zerosGolden = findZeros[fGolden, 20]

Output 44

They are indeed the zeros of .

Plot[fGolden[x], {x, 0, 10 Pi},
 Epilog -> {Darker[Red], Point[{#, fGolden[#]} & /@ zerosGolden]}]

Output 45

Of course, using Solve, one could also get the roots.

Short[exactZerosGolden =
  x /. Solve[fGolden[x] == 0 \[And] 0 < x < 36, x], 4]

Output 46

The two sets of zeros coincide.

Max[Abs[zerosGolden - exactZerosGolden]]

Output 47

While this gives more reliable results, it is slower, and for the statistics of the zeros that we are interested in, exact solutions are not needed.

Calculating 100k zeros takes on the order of a minute.

(zerosGolden = findZeros[fGolden, 10^5];) // Timing

Output 48

The quality of the zeros () is good enough for various histograms and plots to be made.

Mean[Abs[fGolden /@ zerosGolden]]

Output 49

But one could improve the quality of the roots needed to, say, by using a Newton method, with the found roots as starting values.

zerosGoldenRefined =
  FixedPoint[Function[x, Evaluate[N[x - fGolden[x]/fGolden'[x]]]], #,
     10] & /@ Take[zerosGolden, All]; 

Mean[Abs[fGolden /@ zerosGoldenRefined]]

Output 50

The process of applying Newton iterations to find zeros as a function of the starting values has its very own interesting features for the function , as the basins of attraction as well as the convergence properties are not equal for all zeros, e.g. the braided strand near the zero stands out. The following graphic gives a glimpse of the dramatic differences, but we will not look into this quite-interesting subtopic any deeper in this post.

Graphics[{Thickness[0.001], Opacity[0.1], RGBColor[0.36, 0.51, 0.71],
  Table[BSplineCurve[Transpose[{N@
       NestList[(# - fGolden[#]/fGolden'[#]) &, N[x0, 50], 20],
      Range[21]}]], {x0, 1/100, 40, 1/100}]},
 PlotRange -> { {-10, 50}, All}, AspectRatio -> 1/3, Frame -> True,
 FrameLabel -> {x, "iterations"},
 PlotRangeClipping -> True]

Output 51

If we consider the function , it has a constant function value between the zeros. The Fourier transform of this function, calculated based on the zeros, shows all possible harmonics between the three frequencies 1, and .

Module[{ft, nf, pl, labels},
 (* Fourier transform *)
 ft = Compile[\[Omega], Evaluate[
    Total[
     Function[{a, b},
       Sign[fGolden[
          Mean[{a, b}]]] I (Exp[I a \[Omega]] -
           Exp[I b \[Omega]])/\[Omega] ] @@@ 

      Partition[Take[zerosGolden, 10000], 2, 1]]]];
 (* identify harmonics *)

 nf = Nearest[
    SortBy[Last /@ #, LeafCount][[1]] & /@
     Split[Sort[{N[#, 10], #} & /@
         Flatten[
         Table[Total /@
           Tuples[{1, GoldenRatio, GoldenRatio^2, -1, -GoldenRatio,
             -GoldenRatio^2}, {j}], {j, 8}]]], #1[[1]] === #2[[
         1]] &]] // Quiet;
 (* plot Fourier transforms *)

 pl = Plot[Abs[ft[\[Omega]]], {\[Omega], 0.01, 8},
   PlotRange -> {0, 1000}, Filling -> Axis, PlotPoints -> 100];
 (* label peaks *)

 labels = SortBy[#, #[[1, 2]] &][[-1]] & /@
   GatherBy[Select[{{#1, #2}, nf[#1][[1]]} & @@@ 

      Select[Level[Cases[Normal[pl], _Line, \[Infinity]], {-2}],
       Last[#] > 100 &], Abs[#[[1, 1]] - #[[2]]] < 10^-2 &], Last];
 Show[{pl, ListPlot[Callout @@@ labels, PlotStyle -> None]},
         PlotRange -> {{0.1, 8.5}, {0, 1100}}, Axes -> {True, False}]]

Output 52

There is a clearly visible zero-free region of the zeros mod 2π around .

Histogram[Mod[zerosGolden, 2 Pi], 200]

Output 53

Plotting the square of in a polar plot around the unit circle (in yellow/brown) shows the zero-free region nicely.

PolarPlot[1 + fGolden[t]^2/6, {t, 0, 200 2 Pi},

 PlotStyle ->
  Directive[Opacity[0.4], RGBColor[0.36, 0.51, 0.71],
   Thickness[0.001]],
                      PlotPoints -> 1000,
 Prolog -> {RGBColor[0.88, 0.61, 0.14], Disk[]}]

Output 54

Modulo we again see the two peaks and a flat distribution between them.

Histogram[(# - Round[#, Pi]) & /@ zerosGolden, 200]

Output 55

The next graphic shows the distance between the zeros (vertical) as a function of . The zero-free region, as well as the to-be-discussed clustering of the roots, is clearly visible.

Graphics[{RGBColor[0.36, 0.51, 0.71],

  Function[{a, b}, Line[{{a, b - a}, {b, b - a}}]] @@@
                                                                      \
                   Partition[Take[zerosGolden, 10000], 2, 1]},
                     AspectRatio -> 1/2, Frame -> True,
 FrameLabel -> {x, "zero distance"}]

Output 56

Statistically, the three terms of the defining sum of do not contribute equally to the formation of the zeros.

summandValues = {Cos[#], Cos[GoldenRatio #], Cos[GoldenRatio^2 #]} & /@
   zerosGolden;

Histogram[#, 200] & /@ Transpose[summandValues]

Output 57

Table[Histogram3D[{#[[1]], #[[-1]]} & /@
   Partition[fGolden' /@ zerosGolden, j, 1], 100,
  PlotLabel -> Row[{"shift \[Equal] ", j - 1}]],
 {j, 2, 4}]

Output 58

The slopes of at the zeros are strongly correlated to the slopes of successive zeros.

Table[Histogram3D[{#[[1]], #[[-1]]} & /@
   Partition[fGolden' /@ zerosGolden, j, 1], 100,
  PlotLabel -> Row[{"shift \[Equal] ", j - 1}]],
 {j, 2, 4}]

Output 59

A plot of the summands and their derivatives for randomly selected zeros shows that the values of the summands are not unrelated at the zeros. The graphic shows triangles made from the three components of the two derivatives.

fGoldenfGoldenPrime[
   x_] = {D[{Cos[x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}, x],
                                                              {Cos[
     x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}};

Graphics[{Thickness[0.001], Opacity[0.05],
  RGBColor[0.88, 0.61, 0.14],

  Line[Append[#, First[#]] &@Transpose[fGoldenfGoldenPrime[#]]] & /@
                                                                      \
           RandomSample[zerosGolden, 10000]}]

Output 60

Here are the values of the three terms shown in a 3D plot. As a cross-section of the above Cayley surface, it is a closed 1D curve.

Graphics3D[{PointSize[0.002], RGBColor[0.36, 0.51, 0.71],
                       Point[Union@Round[summandValues, 0.01]]},
                         PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
 Axes -> True,

 AxesLabel -> {Cos[x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}]

Output 61

And here is the distribution of the distances between successive zeros. This is the graphic shown in the original MathOverflow post. The position of the peaks is what was asked for.

differencesGolden = Differences[zerosGolden];

Histogram[differencesGolden, 1000, PlotRange -> All]

The pair correlation function between successive zero distances is localized along a few curve segments.

Histogram3D[Partition[differencesGolden, 2, 1], 100, PlotRange -> All]

Output 62

The nonrandomness of successive zero distances also becomes visible by forming an angle path with the zero distances as step sizes.

Graphics[{Thickness[0.001], Opacity[0.5], RGBColor[0.36, 0.51, 0.71],
  Line[AnglePath[{#, 2 Pi/5} & /@ Take[differencesGolden, 50000]]]},
 Frame -> True]

Output 63

Here are some higher-order differences of the distances between successive zeros.

{Histogram[Differences[zerosGolden, 2], 1000, PlotRange -> All],
 Histogram[Differences[zerosGolden, 3], 1000, PlotRange -> All]}

Output 64

Even the nearest-neighbor differences show a lot of correlation between them. The next graphic shows their bivariate distribution for , with each distribution in a different color.

Show[Table[
  Histogram3D[Partition[differencesGolden, m, 1][[All, {1, -1}]],
   400,
   ColorFunction -> (Evaluate[{RGBColor[0.368417, 0.506779, 0.709798],
          RGBColor[0.880722, 0.611041, 0.142051], RGBColor[
         0.560181, 0.691569, 0.194885], RGBColor[
         0.922526, 0.385626, 0.209179], RGBColor[
         0.528488, 0.470624, 0.701351], RGBColor[
         0.772079, 0.431554, 0.102387], RGBColor[
         0.363898, 0.618501, 0.782349], RGBColor[1, 0.75, 0],
         RGBColor[0.647624, 0.37816, 0.614037], RGBColor[
         0.571589, 0.586483, 0.], RGBColor[0.915, 0.3325, 0.2125],
         RGBColor[0.40082222609352647`, 0.5220066643438841, 0.85]}[[
        m]]] &)], {m, 12}],
            PlotRange -> All, ViewPoint -> {2, -2, 3}]

Output 65

The distribution of the slopes at the zeros have much less structure and show the existence of a maximal slope.

Histogram[fGolden' /@ zerosGolden, 1000]

Output 66

The distribution of the distance of the zeros with either positive or negative slope at the zeros is identical for the two signs.

Function[lg,
  Histogram[Differences[Select[zerosGolden, lg[fGolden'[#], 0] &]],
   1000,

   PlotLabel ->
    HoldForm[lg[Subscript["f", "\[Phi]"]'[x], 0]]]] /@ {Less, Greater}

Output 67

A plot of the values of the first versus the second derivative of at the zeros shows a strong correlation between these two values.

Histogram3D[{fGolden'[#], fGolden''[#]} & /@ zerosGolden, 100,
 PlotRange -> All]

Output 68

The ratio of the values of the first to the second derivative at the zeros shows an interesting-looking distribution with two well-pronounced peaks at ±1. (Note the logarithmic vertical scale.)

Histogram[
 Select[fGolden''[#]/fGolden'[#] & /@ zerosGolden,
  Abs[#] < 3 &], 1000, {"Log", "Count"}]

Output 69

As we will see in later examples, this is typically not the case for generic sums of three-cosine terms. Assuming that locally around a zero the function would look like++, the possible region in  is larger. In the next graphic, the blue region shows the allowed region, and the black curve shows the actually observed pairs.

slopeCurvatureRegion[{\[CurlyPhi]2_, \[CurlyPhi]3_}, {\[Alpha]_, \
\[Beta]_}] :=

 Module[{v = Sqrt[1 - (-Cos[\[CurlyPhi]2] - Cos[\[CurlyPhi]3])^2]},
               {# v - \[Alpha] Sin[\[CurlyPhi]2] - \[Beta] Sin[\
\[CurlyPhi]3],
     Cos[\[CurlyPhi]2] - \[Alpha]^2 Cos[\[CurlyPhi]2] +
      Cos[\[CurlyPhi]3] - \[Beta]^2 Cos[\[CurlyPhi]3]} & /@ {-1, 1}]

Show[{ParametricPlot[
   slopeCurvatureRegion[{\[CurlyPhi]2, \[CurlyPhi]3}, {GoldenRatio,
     GoldenRatio^2}],
                                   {\[CurlyPhi]2, 0,
    2 Pi}, {\[CurlyPhi]3, 0, 2 Pi}, PlotRange -> All, AspectRatio -> 1,
                                    PlotPoints -> 120,
   BoundaryStyle -> None, FrameLabel -> {f', f''}],
  Graphics[{PointSize[0.003], RGBColor[0.88, 0.61, 0.14],
    Point[{fGolden'[#], fGolden''[#]} & /@ zerosGolden]}]}]

Output 70

For , the possible region is indeed fully used.

Show[{ParametricPlot[
   slopeCurvatureRegion[{\[CurlyPhi]2, \[CurlyPhi]3}, {Pi, Pi^2}],
                                   {\[CurlyPhi]2, 0,
    2 Pi}, {\[CurlyPhi]3, 0, 2 Pi}, PlotRange -> All, AspectRatio -> 1,
                                    PlotPoints -> 20,
   BoundaryStyle -> None, FrameLabel -> {f', f''}],
  Graphics[{PointSize[0.003], RGBColor[0.88, 0.61, 0.14],
                   Opacity[0.4],
    Point[{fPi'[#], fPi''[#]} & /@ findZeros[fPi, 20000]]}]}]

Output 71

Similar to the fact that the function values of do not take on larger negative values, the maximum slope observed at the zeros is smaller than the one realizable with a free choice of phases in ++, which is for .

Max[Abs[fGolden' /@ zerosGolden]]

Output 72

In the above histograms, we have seen the distribution for the distances of the zeros of . While in some sense zeros are always special, a natural generalization to look at are the distances between successive values such that as a function of . The following input calculates this data from . I exclude small intervals around the endpoints because the distances between values become quite large and thus the calculation becomes time-consuming. (This calculation will take a few hours.)

Monitor[cDistancesGolden = Table[ zeros = findZeros[fGolden, 25000, c];
        {c, Tally[Round[Differences[zeros] , 0.005]]}, {c, -1.49,
    2.99, 0.0025}],
 Row[{"c", "\[ThinSpace]=\[ThinSpace]", c}]]

cDistancesGoldenSA =
  SparseArray[
   Flatten[Table[({j, Round[200 #1] + 1} -> #2) & @@@

      cDistancesGolden[[j]][[2]], {j, Length[cDistancesGolden]}], 1]];

The following relief plot of the logarithm of the density shows that sharp peaks (as shown above) for the zeros exist for any value of in .

ReliefPlot[Log[1 + Take[cDistancesGoldenSA, All, {1, 1600}]],

 DataRange -> {{0, 1600 0.005}, {-1.49, 2.99}}, FrameTicks -> True,

 FrameLabel -> {"\[CapitalDelta] zeros", Subscript[ f, "\[Phi]"]}]

Output 73

Interlude I: The Function f2(x) = cos(x) + cos(ϕ x)

Before analyzing in more detail, for comparison—and as a warmup for later calculations—let us look at the simpler case of a sum of two cos terms, concretely . The zeros also do not have a uniform distance.

f2Terms[x_] := Cos[x] + Cos[GoldenRatio x]

zeros2Terms = findZeros[f2Terms, 10^5];

Here is a plot of ; the zeros are again marked with a red dot.

Plot[f2Terms[x], {x, 0, 12 Pi},

 Epilog -> {Darker[Red],
   Point[{#, f2Terms[#]} & /@ Take[zeros2Terms, 100]]}]

Output 74

But one distance (at ) is exponentially more common than others (note the logarithmic scaling of the vertical axis!).

Histogram[Differences[zeros2Terms], 1000, {"Log", "Count"},
 PlotRange -> All]

Output 75

About 60% of all zeros seem to cluster near a distance of approximately 2.4. I write the sum of the two cosine terms as a product.

f2Terms[x]  // TrigFactor

Output 76

The two terms have different period, the smaller one being approximately 2.4.

{FunctionPeriod[Cos[(Sqrt[5] - 1)/4 x], x],
 FunctionPeriod[Cos[(Sqrt[5] + 3)/4 x], x]}

Output 77

N[%/2]

Output 77

Plotting the zeros for each of the two factors explains why one sees so many zero distances with approximate distance 2.4.

Solve[f2Terms[x] == 0, x]

Output 78

Plot[{Sqrt[2] Cos[(Sqrt[5] - 1)/4 x],
  Sqrt[2] Cos[(Sqrt[5] + 3)/4 x]}, {x, 0, 20 Pi},

 Epilog -> {{Blue, PointSize[0.01],
    Point[Table[{(2 (2 k - 1) Pi)/(3 + Sqrt[5]), 0}, {k, 230}]]},
                              {Darker[Red], PointSize[0.01],
    Point[Table[{1/2 (1 + Sqrt[5]) (4 k - 1) Pi, 0}, {k, 10}]]}}]

Output 79

SortBy[Tally[Round[Differences[zeros2Terms], 0.0001]], Last][[-1]]

Output 80

Let us look at and next to each other. One observes an obvious difference between the two curves: in , ones sees triples of maximum-minimum-maximum, with all three extrema being negative. This situation does not occur in .

GraphicsRow[{Plot[fGolden[x], {x, 0, 14 Pi},
   PlotLabel -> Subscript[f, \[Phi]], ImageSize -> 320],
  Plot[f2Terms[x], {x, 0, 14 Pi}, PlotLabel -> Subscript[f, 2],
   ImageSize -> 320]}]

Output 81

Here is a plot of after a zero for 1,000 randomly selected zeros. Graphically, one sees many curves crossing zero exactly at the first zero of . Mouse over the curves to see the underlying curve in red to better follow its graph.

Show[Plot[f2Terms[t - #], {t, -2, 0 + 5}, PlotRange -> All,
     PlotStyle ->
      Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
       Opacity[0.3]]] & /@
   RandomSample[zeros2Terms, 1000],
  PlotRange -> All, Frame -> True, GridLines -> {{0}, {3}},
  ImageSize -> 400]  /.

 l_Line :> Mouseover[l, {Red, Thickness[0.002], Opacity[1], l}]

Output 82

The distance from the origin to the first zero of is indeed the most commonly occurring distance between zeros.

{#, N[#]} &@(2 x /. Solve[f2Terms[x] == 0 \[And] 1 < x < 2, x] //
   Simplify)

Output 83

Let us note that adding more terms does not lead to more zeros. Consider the function .

f2TermsB[x_] := Cos[GoldenRatio^2 x]

zeros2TermsB = findZeros[f2TermsB, 10^5];

It has many more zeros up to a given (large) than the function .

Max[zeros2TermsB]/Max[zerosGolden]

Output 84

The reason for this is that the addition of the slower oscillating functions ( and ) effectively “converts” some zeros into minimum-maximum-minimum triples all below (above) the real axis. The following graphic visualizes this effect.

Plot[{fGolden[x], Cos[GoldenRatio^2 x]}, {x, 10000, 10036},
 Filling -> Axis]

 

Output 85

Seeing Envelopes in Families of Curves

Now let’s come back to our function composed of three cos terms.

If we are at a given zero of , what will happen afterward? If we are at a zero that has distance to its next zero , how different can the function behave in the interval ? For the function , there is a very strong correlation between the function value and the zero distances, even if we move to the function values in the intervals , .

Table[Histogram3D[{#[[1, 1]], fGolden[#[[-1, 2]] + #[[-1, 1]]/2]} & /@
     Partition[Transpose[{differencesGolden, Most[zerosGolden]}], k,
     1], 100,
   PlotLabel -> Row[{"shift:\[ThinSpace]", k - 0.5}],
   AxesLabel -> {HoldForm[d], Subscript[f, \[Phi]], None}], {k, 4}] //
  Partition[#, 2] &

Output 86

Plotting the function starting at zeros shows envelopes. Using a mouseover effect allows one to highlight individual curves. The graphic shows a few clearly recognizable envelopes. Near to them, many of the curves cluster. The four purple points indicate the intersections of the envelopes with the axis.

Show[Plot[fGolden[# + t], {t, -2, 0 + 5}, PlotRange -> All,
     PlotStyle ->
      Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
       Opacity[0.3]]] & /@
   RandomSample[zerosGolden, 1000],
  Epilog -> {Directive[Purple, PointSize[0.012]],
    Point[{#, 0} & /@ {1.81362, 1.04398, 1.49906, 3.01144}]},
  PlotRange -> All, Frame -> True, GridLines -> {{0}, {-1, 3}},
  ImageSize -> 400] /.

 l_Line :> Mouseover[l, {Red, Thickness[0.002], Opacity[1], l}]

Output 87

The envelope that belongs to zeros that are followed with nearly reaching explains the position of the largest maximum in the zero-distance distribution.

zerosGolden[[1]]

Output 88

Using transcendental roots, one can obtain a closed-form representation of the root that can be numericalized to any precision.

Solve[fGolden[x] == 0 \[And] 1/2 < x < 3/2, x]

Output 89

root3 = N[
  Root[{Cos[#1] + Cos[GoldenRatio #1] + Cos[GoldenRatio^2 #1] &,
                     0.9068093955855631129`20}], 50]

Output 90

The next graphic shows the histogram of the zero distances together with the just-calculated root.

Histogram[differencesGolden, 1000, ChartStyle -> Opacity[0.4],
  PlotRange -> {{1.7, 1.9}, All},
 GridLines -> {{2 zerosGolden[[1]]}, {}}, GridLinesStyle -> Purple]

Output 91

We select zeros with a spacing to the next zero that are in a small neighborhood of the just-calculated zero spacing.

getNearbyZeros[zeros_, z0_, \[Delta]_] :=
 Last /@ Select[Transpose[{Differences[zeros], Most[zeros]}],
   z0 - \[Delta] < #[[1]] < z0 + \[Delta] &]

zerosAroundPeak = getNearbyZeros[zerosGolden, 2 root3, 0.001];
Length[zerosAroundPeak]

Output 92

Plotting these curves shifted by the corresponding zeros such that they all have the point in common shows that all these curves are indeed locally (nearly) identical.

Show[Plot[fGolden[# + t], {t, -3, 6}, PlotRange -> All,
     PlotStyle ->
      Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
       Opacity[0.3]]] & /@
   RandomSample[zerosAroundPeak, 100],
  PlotRange -> All, Frame -> True, GridLines -> {{0}, {-1, 1, 3}},
  ImageSize -> 400] /.

 l_Line :> Mouseover[l, {Red, Thickness[0.002], Opacity[1], l}]

Output 93

Curves that start at the zero function value and attain a function value of ≈3 will soon move apart. The next graphic shows the mean value of spread of the distances after a selected distance. This spread is the reason that the zero distances that appear after 2 root3 are not peaks in the distribution of zero distances.

Module[{zeroPosis, data},
 zeroPosis = Select[Last /@ Select[Transpose[{differencesGolden,
       Range[Length[zerosGolden] - 1]}],
     2 root3 - 0.001 < #[[1]] < 2 root3 + 0.001 &], # < 99000 &];
 data = Table[{j, Mean[#] \[PlusMinus] StandardDeviation[#]} &[
    differencesGolden[[zeroPosis + j]]], {j, 100}];
 Graphics[{RGBColor[0.36, 0.51, 0.71],
   Line[{{#1, Subtract @@ #2}, {#1, Plus @@ #2}} & @@@ data]},
                    AspectRatio -> 1/2, Frame -> True]]

Output 94

Instead of looking for the distance of successive roots of , one could look at the roots with an arbitrary right-hand side . Based on the above graphics, the most interesting distribution might occur for . Similar to the two-summand case, the distance between the zeros of the fastest component, namely , dominates the distribution. (Note the logarithmic vertical scale.)

Histogram[
 Differences[findZeros[fGolden, 10^5, -1]], 1000, {"Log", "Count"},
 PlotRange -> All]

Output 95

The above plot of seemed to show that the smallest values attained are around –1.5. This is indeed the absolute minimum possible; this follows from the fact that the summands lie on the Cayley surface.

Minimize[{x + y + z,
  x^2 + y^2 + z^2 == 1 + 2 x y z \[And] -1 <= x <= 1 \[And] -1 <= y <=
     1 \[And] -1 <= z <= 1}, {x, y, z}]

Output 96

I use findZeros to find some near-minima positions. Note the relatively large distances between these minima. Because of numerical errors, one sometimes gets two nearby values, in which case duplicates are deleted.

zerosGoldenMin =
  findZeros[fGolden, 100, -3/2] //
   DeleteDuplicates[#, Abs[#1 - #2] < 0.1 &] &;

Close to these absolute minima positions, the function takes on two universal shapes. This is clearly visible by plotting in the neighborhoods of all 100 minima.

Show[Plot[fGolden[# + t], {t, -2, 0 + 5}, PlotRange -> All,
    PlotStyle ->
     Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
      Opacity[0.3]]] & /@ zerosGoldenMin,
        GridLines -> {{}, {-3/2, 3}}]

Output 97

Interlude II: Using Rational Approximations of ϕ

The structure in the zero-distance distribution is already visible in relatively low-degree rational approximations of .

fGoldenApprox[x_] =
 fGolden[x] /. GoldenRatio -> Convergents[GoldenRatio, 12][[-1]]

Output 98

zerosGoldenApprox = findZeros[fGoldenApprox, 100000];

Histogram[Differences[zerosGoldenApprox], 1000, PlotRange -> All]

Output 99

For small rational values of , in , one can factor the expression and calculate the roots of each factor symbolically to more quickly generate the list of zeros.

getFirstZeros[f_[x_] + f_[\[Alpha]_ x_] + f_[\[Beta]_ x_] , n_] :=
 Module[{sols, zs},
    sols =
   Select[x /. Solve[f[x] + f[\[Alpha] x] + f[\[Beta] x] == 0, x] //
       N // ExpandAll // Chop, FreeQ[#, _Complex, \[Infinity]] &];
     zs = getZeros[#, Ceiling[n/Length[sols]]] & /@ sols;
    Sort@Take[Flatten[zs], n]]

getZeros[ConditionalExpression[a_. + C[1] b_,
   C[1] \[Element] Integers], n_] := a + b Range[n]

Table[Histogram[
   Differences[
    getFirstZeros[
     Cos[x] + Cos[\[Alpha] x] + Cos[\[Alpha]^2 x] /. \[Alpha] ->
       Convergents[GoldenRatio, d][[-1]], 100000]], 1000,
   PlotRange -> All,
   PlotLabel -> Row[{"convergent" , " \[Rule] ", d}]], {d, 2, 5}] //
 Partition[#, 2] &

Output 100

For comparison, here are the corresponding plots for .

Table[Histogram[
   Differences[
    getFirstZeros[
     Sin[x] + Sin[\[Alpha] x] + Sin[\[Alpha]^2 x] /. \[Alpha] ->
       Convergents[GoldenRatio, d][[-1]], 100000]], 1000,
   PlotRange -> All,
   PlotLabel -> Row[{"convergent" , " \[Rule] ", d}]], {d, 2, 5}] //
 Partition[#, 2] &

Output 101

The Extrema of fϕ(x)

I now repeat some of the above visualizations for the extrema instead of the zeros.

findExtremas[f_, n_] := findZeros[f', n]

extremasGolden = Prepend[findExtremas[fGolden, 100000], 0.];

Here is a plot of together with the extrema, marked with the just-calculated values.

Plot[fGolden[x], {x, 0, 10 Pi},
 Epilog -> {Darker[Red],
   Point[{#, fGolden[#]} & /@ Take[ extremasGolden, 30]]}]

Output 102

The extrema in the plane shows that extrema cluster around .

Graphics[{PointSize[0.001], RGBColor[0.36, 0.51, 0.71], Opacity[0.1],
  Point[N[{#, fGolden[#]} & /@ extremasGolden]]},
                    AspectRatio -> 1/2, ImageSize -> 400,
 Frame -> True]

Output 103

The distribution of the function values at the extrema is already visible in the last graphic. The peaks are at –3/2, –1 and 3. The following histogram shows how pronounced the density increases at these three values.

Histogram[fGolden /@ extremasGolden, 1000,
                      GridLines -> {{-3/2, -1, 3}, {}},
 PlotRange -> All]

Output 104

In a 3D histogram, one sees a strong correlation between the position of the extrema mod and the function value at the extrema.

Histogram3D[{Mod[#, 2 Pi], fGolden[#]} & /@ extremasGolden, 100,

 AxesLabel -> {\[CapitalDelta]x, Subscript[f, \[Phi]], None}]

Output 105

If one separates the minima and the maxima, one obtains the following distributions.

Function[lg,
  Histogram3D[{Mod[#, 2 Pi], fGolden[#]} & /@

    Select[extremasGolden, lg[fGolden''[#], 0] &], 100,

   AxesLabel -> {\[CapitalDelta]x, Subscript[f, \[Phi]],
     None}]] /@ {Less, Greater}

Output 106

The function values of extrema ordinates are strongly correlated to the function values of successive extrema.

Table[Histogram3D[{#[[1]], #[[-1]]} & /@
   Partition[fGolden /@ extremasGolden, j, 1], 100,
  PlotLabel -> Row[{"shift:", j - 1}]],
 {j, 2, 4}]

Output 107

A periodogram of the function values at the extrema shows a lot of structure. The various periodicities arising from the three cosine terms and their interference terms become visible. (The equivalent curve for the slope at the zeros is much noisier.) For all , , the periodogram of the function values at the extrema is a relatively smooth curve with only a few structures.

Periodogram[fGolden /@ extremasGolden,
 PlotStyle -> RGBColor[0.88, 0.61, 0.14], Filling -> Axis]

Output 108

Here again are two graphics that show how the three terms contribute to the function value at the maximum. The value of the term at the extrema is quite limited.

summandValuesE = {Cos[#], Cos[GoldenRatio #],
     Cos[GoldenRatio^2 #]} & /@ extremasGolden;

Graphics3D[{PointSize[0.002], RGBColor[0.36, 0.51, 0.71],
  Point[Union@Round[summandValuesE, 0.01]]},
                        PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}},
 Axes -> True,

 AxesLabel -> {Subscript[f, \[Phi]], Cos[GoldenRatio x],
   Cos[GoldenRatio^2 x]}]

Output 109

Histogram[#, 200] & /@ Transpose[summandValuesE]

Output 110

The two disconnected supports arise from the contributions at the minima and maxima. The contribution at the maxima is quite localized.

Histogram[Cos[GoldenRatio^2 #], 200,
   PlotRange -> {{-1, 1}, All}] & /@  {Select[extremasGolden,
   fGolden''[#] > 0 &], Select[extremasGolden, fGolden''[#] < 0 &]}

Output 111

I zoom into the second graphic of the last result.

Histogram[
 Cos[GoldenRatio^2 #] & /@
  Select[extremasGolden, fGolden''[#] < 0 &], 200,
 PlotRange -> {{0.94, 1}, All}]

Output 113

Here is the distribution of the function values at the minima and maxima.

{Histogram[fGolden /@ Select[extremasGolden, fGolden''[#] > 0 &], 200],
 Histogram[fGolden /@ Select[extremasGolden, fGolden''[#] < 0 &],
  200]}

Output 114

Reduced to the interval , one sees a small, smooth peak around .

Histogram[Mod[extremasGolden, 2 Pi], 200]

Output 115

And this is the overall distribution of the distances between successive extrema. Compared with the zeros, it does not show much unexpected structure.

Histogram[Differences[extremasGolden], 1000, PlotRange -> All]

Output 116

Higher differences do show some interesting structure.

Histogram[Differences[extremasGolden, 2], 1000, PlotRange -> All]

Output 117

In an analogy to the zeros, I also show the pair correlation function. (In this context, this is also called a peak-to-peak plot.)

Histogram3D[{#2 - #1, #3 - #2} & @@@
  Partition[extremasGolden, 3, 1], 100, PlotRange -> All]

Output 118

And here are the shapes of near the extrema for 1,000 randomly selected extrema.

Show[Plot[fGolden[# + t], {t, -2, 0 + 5}, PlotRange -> All,
     PlotStyle ->
      Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
       Opacity[0.3]]] & /@
                                                                      \
              RandomSample[extremasGolden, 1000],
         PlotRange -> All, Frame -> True, GridLines -> {{0}, {3}},
  ImageSize -> 400] /.

 l_Line :> Mouseover[l, {Red, Thickness[0.002], Opacity[1], l}]

Output 119

For use in the next section and in the next example, I form a list of the zeros and extrema in the order in which they are on the real axis.

zerosAndExtremaGolden =
  Sort[Join[{#, "zero"} & /@ zerosGolden, {#, "extrema"} & /@
     extremasGolden]];

Using this list, one can make a correlation plot of the slope at a zero with the height of the following maximum. One sees quite a strong correlation.

Histogram3D[{fGolden'[#1[[1]]], fGolden[#2[[1]]]} & @@@
  Cases[Partition[zerosAndExtremaGolden, 2,
    1], {{_, "zero"}, {_, "extrema"}}], 120]

Output 120

There is even a strong correlation between the slope at a zero and the second next extrema value.

Histogram3D[{fGolden'[#[[1, 1]]],
    fGolden[Cases[#, {_, "extrema"}][[2, 1]]]} & /@
  Take[Cases[
    Partition[zerosAndExtremaGolden, 5, 1], {{_, "zero"}, __}],
   60000], 120]

Output 120

Interlude III: The Complex Zeros of fϕ(x)

All zeros of are on the real axis, while does have complex zeros—exactly at the maximum in the negative maximum-minimum-maximum triples. A plot of shows zeros as peaks. These pairs of zeros with nonvanishing imaginary parts result in relatively large spacing between successive roots in . (The appearance of these complex-valued zeros does not depend on , being irrational, but also occurs for rational , .)

Plot3D[Evaluate[-Log[Abs[fGolden[x + I y]]]], {x, 0, 12}, {y, -1, 1},
 PlotPoints -> {60, 60},
 BoxRatios -> {3, 1, 1}, MeshFunctions -> {#3 &},
 ViewPoint -> {1.9, -2.4, 1.46},
 MeshStyle -> RGBColor[0.36, 0.51, 0.71],
 AxesLabel -> {x,  y, Subscript[f, \[Phi]][x + I y]}]

Output 121

A contour plot showing the curves of vanishing real and imaginary parts has the zeros as crossings of curves of different color.

ContourPlot[
 Evaluate[# == 0 & /@ ReIm[fGolden[x + I y]]], {x, 0, 24}, {y, -1, 1},
  PlotPoints -> {60, 60},
 AspectRatio -> 1/3,
 Epilog -> {Purple, PointSize[0.012],
   Point[ ReIm[
     z /. Solve[
       fGolden[z] == 0 \[And] -2 < Im[z] < 2 \[And]
        0 < Re[z] < 24]]]}]

Output 122

Similar to the above case along the real axis, here is the path of convergence in Newton iterations.

Module[{ppx = 111, ppy = 21,
  f = Evaluate[(# - fGolden[#]/fGolden'[#])] &, data, vals, color},
 data = Table[
   NestList[f, N[x0 + I y0], 20], {y0, -1, 1, 2/ppy}, {x0, 0, 30,
    30/ppx}];
 vals = First /@
   Select[Reverse[
     SortBy[Tally[Flatten[Round[Map[Last, data, {2}], 0.001]]],
      Last]], #[[2]] > 50 &];
 (color[#] =
     Blend[{{0, RGBColor[0.88, 0.61, 0.14]}, {1/2,
        RGBColor[0.36, 0.51, 0.71]},
       {1, RGBColor[0.561, 0.69, 0.19]}}, RandomReal[]]) & /@ vals;
 Graphics3D[{Thickness[0.001], Opacity[0.5],
   Map[If[MemberQ[vals, Round[Last[#], 0.001]],
      {color[Round[Last[#], 0.001]],
       BSplineCurve[MapIndexed[Append[#, #2[[1]]] &, ReIm[#]]]}, {}] &,
    data, {2}]}, BoxRatios -> {3, 1, 2},
  ViewPoint -> {0.95, -3.17, 0.70}]]

Output 123

Now that we have the positions of the zeros and extrema, we can also have a look at the complex zeros in more detail. In the above plots of over the complex plane, we saw that complex zeros occur when we have the situation maximum-minimum-maximum with all three function values at these negative extrema. Using the zeros and the extrema, we can easily find the positions of these extrema triples.

tripleExtrema =
  SequenceCases[
    zerosAndExtremaGolden, {{_, "extrema"}, {_, "extrema"}, {_,
      "extrema"}}][[All, 2, 1]];

About one-seventh of all these roots have a nonvanishing imaginary part.

Length[tripleExtrema]/(Length[tripleExtrema] + Length[zerosGolden]) //
  N

Output 124

The function value of the maximum of all of these consecutive triple extrema are indeed all negative and never smaller than –1.

Histogram[fGolden /@ tripleExtrema, 100]

Output 125

A log-log histogram of the absolute values of these middle maxima suggests that over a large range, a power law relation between their frequencies and their function values holds.

Histogram[
 Sort[-Select[fGolden /@ tripleExtrema, Negative]], {"Log",
  100}, {"Log", "Count"}]

Output 126

Interestingly, the distance between the middle maxima is narrowly concentrated at three different distances.

Output 127

tripleExtremaDifferences = Differences[tripleExtrema];

Histogram[tripleExtremaDifferences, 100]

Output 128

The next three plots zoom into the last three localized structures.

Function[x,
  Histogram[Select[tripleExtremaDifferences, x - 1 < # < x + 1 &],
   100]] /@ {5, 7, 12}

Output 129

Here are the three typical shapes that belong to these three classes of distances. I show 100 randomly selected and shifted pieces of .

extremaGroups =
  With[{L =
     Sort[Transpose[{tripleExtremaDifferences, Most[tripleExtrema]}]]},
   Function[x, {x, Select[L, x - 1 < #[[1]] < x + 1 & ]}] /@ {5, 7,
     12}];

Function[{\[CapitalDelta], l},
  Show[Plot[Evaluate[fGolden[# + t]], {t, -2, \[CapitalDelta] + 2},
        PlotRange -> All,
      PlotLabel ->
       Row[{HoldForm[\[CapitalDelta]x == \[CapitalDelta]]}],
         PlotStyle ->
       Directive[Thickness[0.001], RGBColor[0.36, 0.51, 0.71],
        Opacity[0.6]]] & /@
    RandomSample[l[[All, 2]], 100]]] @@@ extremaGroups

Output 130

I use the position of all middle maxima as starting values for a numerical root-finding procedure to get the nearby complex roots.

cRoots = If[Im[#] < 0, Conjugate[#]] & /@ z /.

     FindRoot[Evaluate[fGolden[z] == 0], {z, # + 1/2 I}] & /@
   tripleExtrema;

Large imaginary parts of the complex zeros occur at real parts that are nearby multiples of π.

Histogram3D[{Mod[Re[#], 2 Pi], Im[#]} & /@ cRoots, 100,
                          AxesLabel -> {Im[x], Mod[Re[x], 2 Pi]}]

Output 131

The function value at a middle maximum is strongly correlated with the magnitude of the imaginary part of the nearby complex root.

Histogram3D[Transpose[{fGolden /@ tripleExtrema, Im[cRoots]}], 100,
                           AxesLabel -> {Subscript[f, \[Phi]], Im[z]}]

Output 132

And here are the distributions of imaginary parts and the differences of the imaginary parts of consecutive (along the real axis) zeros.

{Histogram[Im[cRoots], 100], Histogram[Differences[Im[cRoots]], 100]}

Output 133

If one splits the complex roots into the three groups from above, one obtains the following distributions.

Column[GraphicsRow[{Histogram[Im[#], 100],
       Histogram[Differences[Im[#]], 100]} &[

     If[Im[#] < 0, Conjugate[#]] & /@ z /.

        FindRoot[Evaluate[fGolden[z] == 0], {z, # + 1/2 I}] & /@ #2[[
       All, 2]]],
                        ImageSize -> 360,
    PlotLabel -> Row[{HoldForm[\[CapitalDelta]x == #1]}]] & @@@
  extremaGroups]

As a function of , the complex zeros of periodically join the real axis. The following graphic shows the surface in the -space in yellow/brown and the complex zeros as blue tubes. We first plot the surface and then plot the curves as mesh lines on this surface.

ContourPlot3D[
 Re[Cos[x + I y] + Cos[\[Alpha] (x + I y)] +
   Cos[\[Alpha]^2 (x + I y)]], {x, 0, 12}, {y, 0, 1}, {\[Alpha], 1,
  2}, Contours -> {0}, BoxRatios -> {3, 1, 1},
 ContourStyle -> {Directive[RGBColor[0.88, 0.61, 0.14], Opacity[0.3],
    Specularity[RGBColor[0.36, 0.51, 0.71], 10]]},
 BoundaryStyle -> None, ImageSize -> 600, PlotPoints -> {160, 80, 80},
  MaxRecursion -> 0,
 MeshStyle -> Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.006]],
  Mesh -> {{0}},
 MeshFunctions -> {Function[{x, y, \[Alpha]},
    Im[Cos[x + I y] + Cos[\[Alpha] (x + I y)] +
      Cos[\[Alpha]^2 (x + I y)]]]}, AxesLabel -> {x,  y, \[Alpha]}]

Output 134

The next natural step (and the last one for this section) would be to look at the defined implicitly through. As for any value of , we will have (possibly infinitely) many ; we want to construct the Riemann surface for . A convenient way to calculate Riemann surfaces is through solving the differential equation for the defining function. Through differentiation, we immediately get the differential equation.

f\[Alpha][z_, \[Alpha]_] :=
 Cos[z] + Cos[\[Alpha] z] + Cos[\[Alpha]^2 z]

Solve[D[f\[Alpha][z[\[Alpha]], \[Alpha]], \[Alpha]] == 0,
  Derivative[1][z][\[Alpha]]] // Simplify

Output 135

rhs[z_, \[Alpha]_] := -((
  z (Sin[\[Alpha] z] + 2 \[Alpha] Sin[\[Alpha]^2 z]) )/(
  Sin[z] + \[Alpha] (Sin[\[Alpha] z] + \[Alpha] Sin[\[Alpha]^2 z])))

As starting values, I use along a segment of the real axis.

ICs\[Alpha]x =
  Cases[Flatten[
    Table[{#, x} & /@
                            (\[Alpha] /.
        Quiet[Solve[
          f\[Alpha][N[1, 40] x, \[Alpha]] == 0 \[And]
           0 < \[Alpha] < 2, \[Alpha]]]),  {x, 0, 6, 6/100}], 1],
                            {_Real, _}];

These are the points that we will use for the numerical differential equation solving.

cp = ContourPlot[
  f\[Alpha][x, \[Alpha]] == 0, {x, 0, 6}, {\[Alpha], 0, 1.9},
  Epilog -> {Purple, Point[Reverse /@ ICs\[Alpha]x]},
  FrameLabel -> {x, \[Alpha]}]

Output 136

Starting at a point , we move on a semicircle around the origin of the complex plane. To make sure we stay on the defining Riemann surface, we use the projection method for the numerical solution. And we change variables from , where .

Monitor[rsf\[Alpha]Data =
   Table[With[{r = ICs\[Alpha]x[[k, 1]]},
         nds\[Alpha] =
       NDSolveValue[{Derivative[1][z][\[CurlyPhi]] ==
          I r Exp[I \[CurlyPhi]] rhs[z[\[CurlyPhi]],
            r Exp[I \[CurlyPhi]]], z[0] == ICs\[Alpha]x[[k, 2]]},
        z, {\[CurlyPhi], 0 , Pi }, WorkingPrecision -> 30,
        PrecisionGoal -> 6, AccuracyGoal -> 6,
        Method -> {"Projection", Method -> "StiffnessSwitching",
          "Invariants" ->
           f\[Alpha][z[\[CurlyPhi]], r Exp[I \[CurlyPhi]]]},
        MaxStepSize -> 0.01, MaxSteps -> 10^5];
        {{r, nds\[Alpha][0], nds\[Alpha][Pi]},   

       ParametricPlot3D[
          Evaluate[{r Cos[\[CurlyPhi]],
            r Sin[\[CurlyPhi]], #[nds\[Alpha][\[CurlyPhi]]]}],
          Evaluate[Flatten[{\[CurlyPhi], nds\[Alpha][[1]]}]],
          BoxRatios -> {1, 1, 1}, Axes -> True, PlotRange -> All,
          PlotStyle -> Directive[Thickness[0.002], Darker[Blue]],
          ColorFunctionScaling -> False,
          ColorFunction -> (ColorData["DarkRainbow"][
              Abs[1 - #4/ Pi]] &)] & /@ {Re, Im}}], {k,
      Length[ICs\[Alpha]x]}] // Quiet;,
 Text@ Row[{"path ", k, " of ", Length[ICs\[Alpha]x]}]]

Here is a plot of the real part of . One clearly sees how the sets of initially nearby zeros split at branch points in the complex plane.

rsfRe = Show[rsf\[Alpha]Data[[All, 2, 1]],
  PlotRange -> {All, {0, All}, 10 {-1, 1}},
  AxesLabel -> {Re[\[Alpha]], Im[\[Alpha]], Re[z]},
          ViewPoint -> {-0.512, -3.293, 0.581}]  

Output 137

One can calculate the branch points numerically as the simultaneous solutions of and .

branchPointEqs[z_, \[Alpha]_] = {f\[Alpha][z, \[Alpha]],
  D[f\[Alpha][z, \[Alpha]], z]}

Output 138

branchPoints =
  Union[Round[Select[#, Total[Abs[branchPointEqs @@ #]] < 10^-10 &],
      10.^-6]] &@
   ( Table[{z, \[Alpha]} /.
       FindRoot[Evaluate[branchPointEqs[z, \[Alpha]] == {0, 0}] ,
                     {z,
         RandomReal[{-8, 8}] + I RandomReal[{-8, 8}] },
                     {\[Alpha],
         RandomReal[{-5, 5}] + I RandomReal[{-5, 5}] },
        PrecisionGoal -> 10] // Quiet,
                     {20000}]);

Here are the branch points near the origin of the complex plane.

Graphics[{RGBColor[0.36, 0.51, 0.71],
  Point[ReIm /@ Last /@ branchPoints]},
                    Frame -> True, PlotRange -> 3.5,
 FrameLabel -> {Re[\[Alpha]], Im[\[Alpha]]},
 PlotRangeClipping -> True]

Output 139

Representing the positions of the branch points in the above plot as vertical cylinders shows that the splitting indeed occurs at the branch points (we do not include the branch points with to have a better view of this complicated surface).

Show[{rsfRe,
  Graphics3D[{CapForm[None], GrayLevel[0.3], Specularity[Purple, 20],
    Cylinder[{Append[ReIm[#], -10], Append[ReIm[#], 10]}, 0.02] & /@
     Select[Last /@ branchPoints, Im[#] > 10^-2 &]}]},
 PlotRange -> {{-2, 2}, {0, 2}, 8 {-1, 1}},
 ViewPoint -> {-1.46, 2.87, 1.05}]

Output 140

Finding More Envelopes

The possible “shapes” of fGolden near points where the function has an extremum and a value ≈±1 is quite limited. The three possible curves arise from the different ways to form the sum –1 from the values ±1 of the three summands.

maxMinus1Value =
  Select[extremasGolden, Abs[fGolden[#] - (-1)] < 10^-4 &];
Length[maxMinus1Value]

Output 141

Take[maxMinus1Value, 12]

Output 142

Show[Plot[fGolden[# + t], {t, 0 - 2, 0 + 5}, PlotRange -> All,
    PlotStyle ->
     Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
      Opacity[0.3]]] & /@ maxMinus1Value,
 PlotRange -> All, Frame -> True, GridLines -> {{0}, {3}},
 ImageSize -> 400]  

Output 143

We compare these three curves with the possible curves that could be obtained from considering all possible phases between the three summands—meaning we consider all+ + such that and .

gGolden[x_, {\[CurlyPhi]1_, \[CurlyPhi]2_, \[CurlyPhi]3_}] :=
  Cos[x + \[CurlyPhi]1] + Cos[GoldenRatio x + \[CurlyPhi]2] +
   Cos[GoldenRatio^2 x + \[CurlyPhi]3];

phaseList = Table[
    Block[{\[CurlyPhi]1 = RandomReal[{-Pi, Pi}]},
     Check[Flatten[{\[CurlyPhi]1, {\[CurlyPhi]2, \[CurlyPhi]3} /.
         FindRoot[{Cos[\[CurlyPhi]1] + Cos[\[CurlyPhi]2] +
             Cos[\[CurlyPhi]3] == -1,
                                                      -Sin[\[CurlyPhi]\
1] - GoldenRatio Sin[\[CurlyPhi]2] - GoldenRatio^2 Sin[\[CurlyPhi]3] ==
            0},
                              {{\[CurlyPhi]2,
            RandomReal[{-Pi, Pi}]}, {\[CurlyPhi]3,
            RandomReal[{-Pi, Pi}]}}]}],
      {}]], {600}]; // Quiet

The next graphic shows the two curve families together.

 Show[
 {Plot[Evaluate[
    gGolden[x, #] &@  DeleteCases[Take[phaseList, All], {}]], {t, -2,
    0 + 5},
   PlotRange -> All,
   PlotStyle ->
    Directive[RGBColor[0.36, 0.51, 0.71], Opacity[0.3],
     Thickness[0.001]]],
  Plot[fGolden[t - #], {t, -2, 0 + 5}, PlotRange -> All,
     PlotStyle ->
      Directive[RGBColor[0.88, 0.61, 0.14], Thickness[0.003],
       Opacity[0.3]]] & /@ maxMinus1Value}]

Output 144

These curves now allow us to answer the original question about the location of the singularities in the distribution of the distances of successive zeros. Similar to the largest peak identified above arising from the bunching of curves with function values , the other three maxima arise from curves with local minima or maxima . We calculate some of these zeros numerically.

minEnvelopeZeros =
 Union[Round[
   Sort[\[Delta] /.
       Quiet[FindRoot[
         fGolden[# + \[Delta]] == 0, {\[Delta],
          1/2}]] & /@

     Take[maxMinus1Value, 100]], 0.025]]

Output 145

Indeed, the gridlines match the singularities precisely.

Histogram[Differences[zerosGolden], 1000, PlotRange -> All,
 GridLines -> {Flatten[{2 zerosGolden[[1]], 2 minEnvelopeZeros}], {}}]

Output 146

The unifying feature of all four singularities is their location at the zeros of envelope curves. Here are the curves of fGolden around 100 zeros for each of the four singularities.

With[{L = {#[[1, 1]], Last /@ #} & /@
     Reverse[SortBy[Split[Sort[Transpose[
          {Round[differencesGolden, 0.002], Most[zerosGolden]}]], #1[[
           1]] === #2[[1]] &], Length]]},
  Partition[Function[p,
     Show[
      Plot[fGolden[# + t], {t, -2, 0 + 5}, PlotRange -> All,
         PlotLabel -> Row[{"x", "\[TildeTilde]", p}],
         GridLines -> {None, {-1, 3}},
         PlotStyle ->
          Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
           Opacity[0.3]]] & /@
       Take[Select[L, Abs[#[[1]] - p] < 0.1 &, 1][[1, 2]],
        UpTo[100]]]] /@ {1, 1.5, 1.8, 3}, 2]] // Grid

Output 147

These graphics show strikingly the common feature of these four groups of zero distances: either maxima cluster around or minima cluster around .

The curves in the plane that fulfill the two conditions are shown in the next contour plot.

 ContourPlot[
 Evaluate[Function[sign,
    Derivative[1, {0, 0, 0}][gGolden][
       0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] ==
      0 /.
     (Solve[
         gGolden[0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] ==
          sign 1, \[CurlyPhi]1] /.
        ConditionalExpression[x_, _] :> x /. _C :> 0)] /@ {-1, 1}],
 {\[CurlyPhi]2, 0, 2 Pi}, {\[CurlyPhi]3, 0, 2 Pi}, PlotPoints -> 60,
 ContourStyle -> RGBColor[0.36, 0.51, 0.71]]

Output 148

Now we can also calculate a numerical approximation to the exact value of the position of the first singularity. We consider the envelope of all curves with the properties , . The envelope property is represented through the vanishing partial derivative with respect to .

(Table[Round[
      Mod[{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3} /.

         FindRoot[
          Evaluate[{gGolden[
              0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == -1, 

            Derivative[1, {0, 0, 0}][gGolden][
              0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,

            Derivative[0, {1, 0, 0}][gGolden][
              0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0}],
          {\[CurlyPhi]1, RandomReal[{-Pi, Pi}]}, {\[CurlyPhi]2,
           RandomReal[{-Pi, Pi}]}, {\[CurlyPhi]3,
           RandomReal[{-Pi, Pi}]},
          PrecisionGoal -> 12] , 2 Pi]  /.
       x_?(Abs[#] < 10^-6 || Abs[2 Pi - #] < 10.^-6 &) :> 0,
      10.^-6], {100}] // Quiet // Tally) /.
 x_Real?(Abs[# - Pi] < 0.01 &) :> Pi

Output 149

The envelope curve of this family is a small modification of our original function—the sign of the first term is inverted.

cosEqs = {gGolden[x, {Pi, Pi, 0}], gGolden[x, {0, Pi, Pi}],
  gGolden[x, {Pi, 0, Pi}]} 

Output 150

The positions of the first roots of the last equations are , and . Multiplying these numbers by two to account for their symmetric distance from the origin yields the zero distances seen above at , and .

FindRoot[# == 0, {x, 1/2}] & /@ cosEqs

Output 151

And, using the higher-precision root, we zoom into the neighborhood of the first peak to confirm our conjecture.

With[{z0 =
   2 x /. FindRoot[
     Evaluate[Cos[x] - Cos[GoldenRatio x] - Cos[GoldenRatio^2 x] == 0],
     {x, 1/2}, PrecisionGoal -> 12]},
 Histogram[
  Select[Differences[
     zerosGoldenRefined], -0.0003 < z0 - # < 0.0004 &] - z0, 100,
  "PDF",
  GridLines -> {{0}, {}}]]

Output 152

The envelope arises from the fact that a small variation in can be compensated by appropriate changes in and .

((-\[Alpha] + \[Beta]*Sqrt[\[Alpha]^2 + \[Beta]^2 - 1])*Sin[x*\[Alpha]])/(\[Alpha]^2 + \[Beta]^2) + ((-\[Beta] - \[Alpha]*Sqrt[\[Alpha]^2 + \[Beta]^2 - 1])*Sin[x*\[Beta]])/
   (\[Alpha]^2 + \[Beta]^2) // FullSimplify

Output 153

((-\[Alpha] + \[Beta] Sqrt[\[Alpha]^2 + \[Beta]^2 - 1]) Sin[x \[Alpha]] - (\[Beta] + \[Alpha] Sqrt[\[Alpha]^2 + \[Beta]^2 - 1]) Sin[x \[Beta]])/(\[Alpha]^2 + \[Beta]^2) 

Output 154

Manipulate[
 Plot[Evaluate[{-Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x], -Cos[x] +
       Cos[x \[Alpha]] + Cos[x \[Beta]] +
                   (((-\[Alpha] + \[Beta] Sqrt[\[Alpha]^2 + \[Beta]^2 \
- 1]) Sin[x \[Alpha]] -
             (\[Beta] + \[Alpha] Sqrt[\[Alpha]^2 + \[Beta]^2 -
                  1]) Sin[
              x \[Beta]])/(\[Alpha]^2 + \[Beta]^2)) \
\[CurlyPhi]1MinusPi} /.
     { \[Alpha] -> GoldenRatio, \[Beta] ->
       GoldenRatio^2} /. \[CurlyPhi]1 -> Pi + 0.1],
  {x, 0, 1}],
 {{\[CurlyPhi]1MinusPi, 0.3, HoldForm[\[CurlyPhi]1 - Pi]}, -0.5, 0.5,
  Appearance -> "Labeled"},
 TrackedSymbols :> True]

Output 155

These zeros of the equation do indeed match the position of the above singularities in the distribution of the zero distances.

We end this section by noting that envelope condition, meaning the vanishing of derivatives with respect to the phases, is a very convenient method for finding special families of curves. For instance, there are families of solutions such that many curves meet at a zero.

findSolutions[eqs_] := Module[{fm},
   While[fm = FindRoot[Evaluate[eqs],
      {\[CurlyPhi]1, RandomReal[{0, 2 Pi}]}, {\[CurlyPhi]2,
       RandomReal[{0, 2 Pi}]}, {\[CurlyPhi]3,
       RandomReal[{0, 2 Pi}]},
      {d, RandomReal[{1/2, 5}]}] // Quiet;
         Not[
    Total[Abs[(Subtract @@@ eqs) /. fm]] < 10^-6 \[And]
     10^-3 < Abs[d /. fm] < 5]  ] ;
  fm /. (\[CurlyPhi] : (\[CurlyPhi]1 | \[CurlyPhi]2 | \[CurlyPhi]3) \
-> \[Xi]_) :> (\[CurlyPhi] -> Mod[\[Xi], 2 Pi])]

Modulo reflection symmetry, there is a unique solution to this problem.

SeedRandom[1];
fs1 = findSolutions[{gGolden[
     0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,

   Derivative[0, {1, 0, 0}][gGolden][
     0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,

   gGolden[d, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,

   Derivative[0, {1, 0, 0}][gGolden][
     d, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0}]

Output 156

Plotting a family of curves with different values of shows that at the two zeros, the family of curves bunches up.

Plot[Evaluate[
  Table[gGolden[
     x, {\[CurlyPhi]1 + \[Delta]\[CurlyPhi]1, \[CurlyPhi]2, \
\[CurlyPhi]3}], {\[Delta]\[CurlyPhi]1, -0.2, 0.2, 0.4/6}] /.
   fs1], {x, -3, 6}, GridLines -> ({{d}, {}} /. fs1)]

Output 157

And here are some solutions that show curves that bunch at a zero and at an extremum.

Function[sr, SeedRandom[sr];
  fs2 = findSolutions[{gGolden[
       0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,

     Derivative[0, {1, 0, 0}][gGolden][
       0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,

     Derivative[1, {0, 0, 0}][gGolden][
       d, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,

     Derivative[0, {1, 0, 0}][gGolden][
       d, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0}];
  Plot[Evaluate[
    Table[gGolden[
       x, {\[CurlyPhi]1 + \[Delta]\[CurlyPhi]1, \[CurlyPhi]2, \
\[CurlyPhi]3}], {\[Delta]\[CurlyPhi]1, -0.2, 0.2, 0.4/6}] /.
     fs2], {x, -3, 6}, GridLines -> ({{d}, {}} /. fs2)]] /@ {1, 6, 38}

Output 158

We also look at a second family of envelope solutions: what are the most general types of curves that fulfill the envelope condition at an extremum? This means we have to simultaneously fulfill the following two equations.

{Derivative[1, {0, 0, 0}][gGolden][
   0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0,
 Derivative[0, {1, 0, 0}][gGolden][
   0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0}

Output 159

This in turn means we must have .

cpExtEnv =
 ContourPlot[-GoldenRatio Sin[\[CurlyPhi]2] -
    GoldenRatio^2 Sin[\[CurlyPhi]3] == 0,
                                                {\[CurlyPhi]2, 0,
   2 Pi}, {\[CurlyPhi]3, 0, 2 Pi}, PlotPoints -> 40]

Output 160

Here is a contour plot of the curves in the plane where the extremum envelope condition is fulfilled.

linesExtEnv = Cases[Normal[cpExtEnv], _Line, \[Infinity]];

Show[ Plot[
    Cos[x + 0] + Cos[GoldenRatio x + #1] +
     Cos[GoldenRatio^2 x + #2], {x, -5, 5},
       PlotStyle ->
     Directive[Thickness[0.001], RGBColor[0.36, 0.51, 0.71],
      Opacity[0.5]],
       PlotRange -> All,
    GridLines -> {{}, {-3, -1, 1,
       3}}] & @@@
                                                    \

  RandomSample[Level[linesExtEnv, {-2}], UpTo[300]]]

Output 161

We add a mouseover to the contour plot that shows a family of curves near to the envelope conditions.

make\[CurlyPhi]2\[CurlyPhi]3Plot[{\[CurlyPhi]2_, \[CurlyPhi]3_}] :=
 Column[{Plot[
    Evaluate[
     Table[gGolden[
       x, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}], {\[CurlyPhi]1, \
-0.15, 0.15, 0.3/6}]],
                            {x, -4, 4},
    PlotLabel -> Subscript[\[CurlyPhi], 1] \[TildeTilde] 0],
         Plot[
    Evaluate[
     Table[gGolden[
       x, {Pi + \[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}], {\
\[CurlyPhi]1, -0.15, 0.15, 0.3/6}]],
                           {x, -4, 4},
    PlotLabel -> Subscript[\[CurlyPhi], 1] \[TildeTilde] Pi]},
  Dividers -> Center]

Normal[cpExtEnv] /.
 Line[l_] :> (Tooltip[Line[ #],
      Dynamic[make\[CurlyPhi]2\[CurlyPhi]3Plot[Mean[#]]]] & /@
    Partition[l, 2, 1] )

Output 162

And the next graphic shows the distance between the nearest (to the origin) positive or negative roots.

addHeight[{\[CurlyPhi]2_, \[CurlyPhi]3_}, pm_] :=
 Module[{roots, \[Rho] },
  roots =
   Sort[x /.
      Solve[gGolden[x, {0, \[CurlyPhi]2, \[CurlyPhi]3}] ==
         0 \[And] -6 < x < 6, x]] // Quiet;
  \[Rho] =
   If[pm === 1,
     Select[roots, # > 0 &, 1], -Select[Sort[-roots], # > 0 &, 1] ][[
    1]];
  {{\[CurlyPhi]2, \[CurlyPhi]3,
    0}, {\[CurlyPhi]2, \[CurlyPhi]3, \[Rho]}}]

Graphics3D[{Opacity[0.2], Gray,
  Polygon[{{0, 0, 0}, {2 Pi, 0, 0}, {2 Pi, 2 Pi, 0}, {0, 2 Pi, 0}}],
  EdgeForm[], Opacity[1],
  Transpose[{{RGBColor[0.88, 0.61, 0.14],
     RGBColor[0.36, 0.51, 0.71]},
    Table[
     Polygon[Join[#1, Reverse[#2]] & @@@
         Partition[addHeight[#, s] & /@ #[[1]], 2, 1]] & /@
      linesExtEnv,
     {s, {1, -1}}]}]}, PlotRange -> All, Axes -> True,
 Lighting -> "Neutral",
 AxesLabel -> {Subscript[\[CurlyPhi], 2], Subscript[\[CurlyPhi], 3],
\!\(\*SubscriptBox[\(\[Rho]\), \("\<\[PlusMinus]\>"\)]\)} ]

Output 163

The Peak Positions of the Zero Distances

Now I can implement the following function, maximaPositions, to find the singularities of the distributions of the distances of successive zeros for functions of the form + for arbitrary real .

maximaPositions[
  a1_. Cos[x_] + a2_. Cos[\[Alpha]_ x_] + a3_. Cos[\[Beta]_ x_], x_] :=

  2*(Function[{s1, s2, s3},
     Min[N[
       x /. Solve[
         s1 a1 Cos[x] + s2 a2 Cos[\[Alpha] x] +
            s3 a3 Cos[\[Beta] x] == 0 \[And]
          0 < x < 10, x]]]] @@@ {{1, 1, 1}, {-1, 1, 1}, {1, -1,
      1}, {1, 1, -1}})

Here are the positions of the peaks for .

peaksGolden = maximaPositions[fGolden[x], x]

Output 164

Zooming into the histogram shows again that the predicted peak positions match the observed ones well.

Partition[Histogram[Differences[zerosGolden], 2000,
     PlotRange -> {{# - 0.02, # + 0.02}, All},
     GridLines -> {peaksGolden, {}},
     PlotRangeClipping -> True] & /@ peaksGolden, 2] // Grid

Output 165

Here is a quick numerical/graphical check for a “random” function of the prescribed form with not identically one.

testFunction[x_] := Cos[x] + 2 Cos[Sqrt[2] x] + Sqrt[3] Cos[Pi x]

 zerosTestFunction = findZeros[testFunction, 10^5]; 

singPosFunction = maximaPositions[testFunction[x], x]

Output 166

Histogram[Differences[zerosTestFunction], 100,
 GridLines -> {singPosFunction, {}}]

Output 167

We should check for an extended range of parameters if the conjectured formula for the position of the singularities really holds. So for a few hundred values of in , we calculate the histograms of the zero distances. This calculation will take a few hours. (In the interactive version, the cell is set to unevaluatable.)

With[{p\[Alpha] = 200},
 Monitor[
  \[Alpha]Data =
   SparseArray[
      Flatten[Table[({j, Round[p\[Alpha] #1] + 1} -> #2) & @@@ #[[
           j]][[2]], {j, Length[#]}], 1]] & @
    Table[
     f\[Alpha][x_] := Cos[x] + Cos[\[Alpha] x] + Cos[\[Alpha]^2 x];
                  zList = findZeros[f\[Alpha], 20000, 0];
                          {\[Alpha],
      Tally[Round[Differences[zList], N[1/p\[Alpha]]]]};,
              {\[Alpha], 1/2, 2, 1/(120 Pi)}],
  Row[{"\[Alpha]=", N[\[Alpha]]}]]]   

rPlot\[Alpha] =
 ReliefPlot[Log[1 + Take[\[Alpha]Data, {2, -1}, {1, 1200}]],

  DataRange -> {{0, 1200 0.005}, {1/2, 2}}, FrameTicks -> True,

  FrameLabel -> {"\[CapitalDelta] zeros", "\[Alpha]"},
  AspectRatio -> 1/3]

Output 168

Output 169

I overlay with the predicted positions of the singularities; they match perfectly.

Monitor[\[Alpha]Sings =
   Table[{#, \[Alpha]} & /@
     maximaPositions[N[Cos[x] + Cos[\[Alpha] x] + Cos[\[Alpha]^2 x]],
      x],
                                      {\[Alpha], 0.5, 2,
     1/5/201}];, \[Alpha]]

Output 170

Now, what do the positions of the singularities in the case of two parameters , in look like? Plotting the locations of a few thousand singularity positions in space clearly shows four intersecting surfaces.

singGraphics3D =
 Graphics3D[{RGBColor[0.36, 0.51, 0.71], Sphere[Flatten[
     Table[{\[Alpha], \[Beta], #} & /@
       Quiet[maximaPositions[
         N[Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x]], x]],
      {\[Beta], 1/2 + Pi/1000, 5/2 + Pi/1000, 2/31},
      {\[Alpha], 1/2 + Pi/1001, 5/2 + Pi/1001, 2/31}], 2], 0.015]},
  PlotRange -> {{0.5, 2.5}, {0.5, 2.5}, {0, 6}},
  BoxRatios -> {1, 1, 1}, Axes -> True,
  ViewPoint -> {2.83, 1.76, -0.61}, Method -> {"SpherePoints" -> 6}]

Output 171

Instead of calculating many concrete tuples of positions, we can consider the positions of the singularities as functions of , in . Differentiating the last expression allows us to get a partial differential equation for each of the four equations that, given boundary conditions, we can solve numerically and then plot. Or instead of solving a partial differential equation, we can fix one of the two parameters and and obtain a family of parametrized ordinary differential equations. We carry this procedure out for the two sheets that don’t cross each other.

smallestRoot[{pm1_, pm2_, pm3_}, \[Alpha]_, \[Beta]_] :=
 Min@Select[DeleteCases[Table[
     Quiet@
      Check[x /.
        FindRoot[
         pm1 Cos[x] + pm2 Cos[\[Alpha] x] + pm3 Cos[\[Beta] x] == 0,
             {x, RandomReal[{0, Pi}]},
         PrecisionGoal -> 12], {}], {40}], {}], # > 0 &]

makeGrid[{pm1_, pm2_, pm3_}, M_] :=
 Show[Cases[Flatten[
     {Table[
       nds\[Alpha] =
        NDSolveValue[{D[
            Cos[x[\[Alpha]]] + Cos[\[Alpha] x[\[Alpha]]] +
             Cos[\[Beta] x[\[Alpha]]], \[Alpha]] == 0,
          x[E] == smallestRoot[{pm1, pm2, pm3}, E, \[Beta]]},
         x, {\[Alpha], 3/4, 3}, PrecisionGoal -> 12];
       ParametricPlot3D[{\[Alpha], \[Beta], 2 nds\[Alpha][\[Alpha]]},
        Evaluate[Flatten[{\[Alpha], nds\[Alpha][[1]]}]],
        PlotRange -> All, PlotStyle -> Gray], {\[Beta],
        3/4 + Pi/1000, 3 + Pi/1000, 2/M}],
      Table[
       nds\[Beta] =
        NDSolveValue[{D[
            Cos[x[\[Beta]]] + Cos[\[Alpha] x[\[Beta]]] +
             Cos[\[Beta] x[\[Beta]]], \[Beta]] == 0,
          x[E] == smallestRoot[{pm1, pm2, pm3}, \[Alpha], E]},
         x, {\[Beta], 3/4, 3}, PrecisionGoal -> 12];
       ParametricPlot3D[{\[Alpha], \[Beta], 2 nds\[Beta][\[Beta]]},
        Evaluate[Flatten[{\[Beta], nds\[Beta][[1]]}]],
        PlotRange -> All,
        PlotStyle ->
         Directive[RGBColor[0.88, 0.61, 0.14], Thickness[0.002]]],
       {\[Alpha], 3/4 + Pi/1000, 3 + Pi/1000, 2/M}]
      }], _Graphics3D], PlotRange -> All,
   AxesLabel -> {"\[Alpha]", "\[Beta]", None}] // Quiet

Show[{singGraphics3D, makeGrid[{1, 1, 1}, 20],
  makeGrid[{-1, 1, 1}, 20]}]

Output 172

The other two sheets could also be calculated, but things would become a bit more complicated because the initial conditions calculated with smallestRoot are no longer continuous functions of and . The following graphic visualizes this situation when new zeros suddenly appear that didn’t exist for the blue curve due to a small change in .

Module[{\[Alpha] = 2.02, \[Beta] = 2.704},
 Plot[{Cos[x] - Cos[\[Alpha] x] + Cos[\[Beta] x],
   Cos[x] - Cos[(\[Alpha] - 0.1) x] + Cos[\[Beta] x]}, {x, 0, 3}]]

Output 173

Interestingly, one can generalize even further the above formula for the peaks in the distance between successive zeros and allow arbitrary phases in the three cos functions. Numerical experiments indicate that for many such cosine sums, one can just ignore the phases and find the smallest zeros of exactly the same equations as above.

maximaPositionsGeneralized[
  a1_. Cos[x_ + \[CurlyPhi]1_.] +
   a2_. Cos[\[Alpha]_ x_ + \[CurlyPhi]2_.] +
   a3_. Cos[\[Beta]_ x_ + \[CurlyPhi]3_.], 

  x_] := maximaPositions[
  a1 Cos[x] + a2 Cos[\[Alpha] x] + a3 Cos[\[Beta] x], x]  

Here is another random example.

fRandom[x_] :=
 1/2 Cos[x + 1] + Sqrt[2] Cos[GoldenRatio x + Pi/5] +
  Sqrt[3] Cos[Pi x + 2]
zerosRandom = findZeros[fRandom, 10^5]; 

singPosFunction = maximaPositionsGeneralized[fRandom[x], x]

Output 174

Histogram[Differences[zerosRandom], 100,
 GridLines -> {singPosFunction, {}}]

Output 175

I modify the phases in the above function fRandom, and obtain the same position for the singularities.

fRandom2[x_] :=
 1/2 Cos[x + Cos[3]] + Sqrt[2] Cos[GoldenRatio x + Log[2]] +
  Sqrt[3] Cos[Pi x + E]
zerosRandom2 = findZeros[fRandom2, 10^5]; 

Histogram[Differences[zerosRandom2], 100,
 GridLines -> {singPosFunction, {}}]

Output 176

In degenerate cases, such as all phases being , meaning , the positions of the peaks in the distribution of the zero distances will sometimes be different from the just-given conjecture. This means that e.g. the position of the spacings of the extrema of the sin equivalent of are not described by the above equations.

Even More Peaks—Well, Sometimes

In the last section, we established the position of the peaks of the original MathOverflow post as twice the smallest zeros of . And for many random instances of and , these four numbers indeed characterize the peaks visible in the distribution of successive zero distances of . We saw this clearly in the plots in the last section that spanned various parameter ranges for and .

Earlier, I remarked that the original MathOverflow plot that used the function has some features special to this function, like the gaps in the distribution of the zero distances. At the same time, the function is generic in the sense that the zero-spacing distribution has exactly four peaks, as we expect for generic and : the four red curves in the above graphic for rPlotα. We consider a slight modification of fGolden where instead of , we use .

\[Phi]Brass = (1 + Sqrt[3])/2;
fBrass[x_] := Cos[x] + Cos[\[Phi]Brass x] + Cos[\[Phi]Brass^2 x]

We again calculate the first 100k zeros and their distances.

zerosBrass = findZeros[fBrass, 10^5];

differencesBrass = Differences[zerosBrass];

Interestingly, we now get a distribution with six maxima. Four of the maxima are again well described by the maxima position conjectured above.

peaksBrass = maximaPositions[fBrass[x], x];

Histogram[differencesBrass, 1000, GridLines -> {peaksBrass, {}}]

Output 177

The square root term makes all these examples special. The function is ultimately only dependent on two, rather than three, algebraically independent terms.

Cos[x] + Cos[(1 + Sqrt[n])/2 x] + Cos[(1 + Sqrt[n])/2 ^2 x] //
  ExpandAll // TrigExpand 

Output 178

Collect[Subtract @@
  Eliminate[{fSqrtN == %, Cos[x/4]^2 + Sin[x/4]^2 == 1,
    Cos[Sqrt[n] x/4]^2 + Sin[Sqrt[n] x/4]^2 == 1}, {Sin[x/4],
    Sin[Sqrt[n] x/4]}] , fP, Factor]

Output 179

This is reflected in the fact that the triples , similar to the above equivalent for the golden ratio, are located on relatively simple 2D surfaces.

Show[{ContourPlot3D[(-1 + x + 2 y^2)^2 + 4 (-1 + x - 2 x y^2) z^2 +
     4 z^4 == 0,
                                 {x, -1, 1}, {y, -1, 1}, {z, -1, 1},
   PlotPoints -> 40, Mesh -> None,
                                  ContourStyle -> Opacity[0.5]],
  Graphics3D[{PointSize[0.005],
    Point[
     Table[{Cos[x] , Cos[\[Phi]Brass x] , Cos[\[Phi]Brass^2 x]}, {x,
       1., 10000., 1.}]]}]}]

Output 180

A tempting and easy generalization of the positions of the maxima might be zero distances that follow the previously calculated four distances. This generalization is easy to implement.

rootDistances[
  a1_. Cos[x_] + a2_. Cos[\[Alpha]_ x_] + a3_. Cos[\[Beta]_ x_], x_,
  xMax_] := Function[{s1, s2, s3},
   DeleteDuplicates[Differences[ Sort[
      N[x /.
        Solve[s1 a1 Cos[x] + s2 a2 Cos[\[Alpha] x] +
            s3 a3 Cos[\[Beta] x] == 0 \[And] -xMax < x < xMax,
         x]]]]]] @@@ {{1, 1, 1}, {-1, 1, 1}, {1, -1, 1}, {1, 1, -1}}

Interestingly, that gives nearly the correct positions, but not quite.

rdBrass = rootDistances[fBrass[x], x, 12]

Output 181

Function[c,
  Histogram[Select[differencesBrass, c - 0.005 < # < c + 0.005 &],
   100, GridLines -> {Flatten[rdBrass], {}},
                           PlotRangeClipping -> True]] /@ {1.0977,
  2.366}

Output 182

Where are these additional maxima? We will not calculate their exact positions here. But a quick look at the neighborhood of zeros that have the peak distances shows clearly that there are additional families of envelope curves involved. Interestingly again, families with occur, and this time reflected and translated versions of the curve arise.

With[{L = {#[[1, 1]], Last /@ #} & /@
     Reverse[SortBy[Split[Sort[Transpose[
          {Round[differencesBrass, 0.001], Most[zerosBrass]}]], #1[[
           1]] === #2[[1]] &], Length]]},
  Function[p,
    Show[Plot[fBrass[# + t], {t, -10, 0 + 10}, PlotRange -> All,
        PlotLabel -> Row[{"x", "\[TildeTilde]", p}],
        GridLines -> {None, {-1, 1, 3}},
        PlotStyle ->
         Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
          Opacity[0.5]]] & /@
      Take[Select[L, Abs[#[[1]] - p] < 0.1 &, 1][[
         1, 2]], UpTo[50]]]] /@ {1.098, 2.367}] /.
 l_Line :> Mouseover[l, {Red, Thick, l}] 

Output 183

We will not try to interpret the family of curves that form these singularities here and now; in the next section we will develop some general methods to identify the positions of the singularities on the zero distances.

For larger square roots, even stranger distributions with even more maxima can occur in the distribution of the zero spacings. Here is the case:

\[Phi]Platinum = (1 + Sqrt[13])/2;
fPlatinum[x_] :=
 Cos[x] + Cos[\[Phi]Platinum x] + Cos[\[Phi]Platinum^2 x]
zerosPlatinum = findZeros[fPlatinum, 10^5];

The zeros mod have multiple gaps.

Histogram[Mod[zerosPlatinum, 2 Pi], 1000]

Output 184

PolarPlot[1 + fPlatinum[t]^2/6, {t, 0, 200 2 Pi},

 PlotStyle ->
  Directive[Opacity[0.4], RGBColor[0.36, 0.51, 0.71],
   Thickness[0.001]],
                     PlotPoints -> 1000,
 Prolog -> {RGBColor[0.88, 0.61, 0.14], Disk[]}]

Output 185

differencesPlatinum = Differences[zerosPlatinum];
peaksPlatinum = maximaPositions[fPlatinum[x], x];
Histogram[differencesPlatinum, 1000, GridLines -> {peaksPlatinum, {}}]

Output 186

We end this section with the square root of 11, which has an even more complicated zero-spacing distribution.

\[Phi]Rhodium = (1 + Sqrt[11]);
fRhodium[x_] := Cos[x] + Cos[\[Phi]Rhodium x] + Cos[\[Phi]Rhodium^2 x]
zerosRhodium = findZeros[fRhodium, 10^5];
peaksRhodium = maximaPositions[fRhodium[x], x]
Histogram[Differences[zerosRhodium], 1000,
 GridLines -> {peaksRhodium, {}}, PlotRange -> All]

Output 187

Output 188

Zero Distances between Nonsuccessive Zeros

So far, we have looked at the distribution of the distances between successive zeros. In this section, we will generalize to the distribution between any pair of zeros. While this seems like a more general problem, the equations describing the possible distances will easily allow us to determine the peak positions for successive zero distances.

If we consider not only the distance between consecutive zeros but also between more distant zeros, we get a more complicated distribution of zero distances.

hgd = Histogram[
  zeroDistancesAll =
   Select[(zerosGolden[[#2]] - zerosGolden[[#1]]) & @@@
     Sort[Flatten[Table[{k, k + j}, {k, 20000}, {j, 1, 50}], 1]],
    # < 20 &], {0.001}]

Output 189

All of the peaks are sums of the four peaks seen in the distances between consecutive zeros. But the reverse is not true—not all sums of consecutive zero distances show up as peaks. We identify the sums that are observed.

observedPeaks =
  Sort[First /@
    Select[Tally[ Round[zeroDistancesAll, 0.001]], Last[#] > 50 &]];

calculatedPeaks =
  Flatten[Table[Union[{Total[First /@ #], Sort[Last /@ #]} & /@
      Tuples[
       Transpose[{{1.8136187, 1.04397, 1.49906, 3.01144},
         Range[4]}], {j}]],
    {j, 1, 10}], 1];

nf = Nearest[(#[[1]] -> #) & /@ calculatedPeaks];

peakSums = DeleteDuplicates[Sort[nf[#][[1]] & /@ observedPeaks]]

Output 190

Here is the left half of the last histogram shown together with the peak sum positions.

Show[{hgd,
  ListPlot[Callout[ {#1, 20 + 12 #}, Row[#2]] & @@@ peakSums,
   Filling -> Axis,
   PlotStyle -> PointSize[0.008]]}]

Output 191

The variable ranges from 0 to infinity in and so is not suited to be used as a parametrization variable to show large ranges. The three expressions , and are all in the interval . Above, we plotted the summands in these cosine terms; now we plot the triples , where is the distance between the and the zero. This gives some interesting-looking curves.

zeroPairIndices =
  Sort[Flatten[Table[{k, k + j}, {k, 25000}, {j, 1, 30}], 1]];

Graphics3D[{PointSize[0.001], RGBColor[0.36, 0.51, 0.71], Point[
   {Cos[GoldenRatio zerosGolden[[#1]]],
      Cos[GoldenRatio^2 zerosGolden[[#1]]],
      zerosGolden[[#2]] - zerosGolden[[#1]]} & @@@ zeroPairIndices]},
 BoxRatios -> {1, 1, 2}, Axes -> True,
 PlotRange -> {{-1, 1}, {-1, 1}, {0, 8}}]

Output 192

In the case of , we just get a curve; in the case of general and , we obtain an intricate-looking surface—for instance, for .

zerosEPi =
  findZeros[Function[x, Cos[x] + Cos[E x] + Cos[Pi x]], 4 10^4];

Graphics3D[{PointSize[0.001], RGBColor[0.36, 0.51, 0.71], Point[
   {Cos[ E zerosEPi[[#1]]], Cos[Pi zerosEPi[[#1]]],
      zerosEPi[[#2]] - zerosEPi[[#1]]} & @@@ zeroPairIndices]},
 BoxRatios -> {1, 1, 2}, Axes -> True,
 PlotRange -> {{-1, 1}, {-1, 1}, {0, 8}},
 ViewPoint -> {1.37, -3.08, 0.28},
 AxesLabel -> {Cos[\[Alpha] Subscript[z, i]],
   Cos[\[Beta] Subscript[z, i]], Subscript[z, j] - Subscript[z, i]}]

Output 193

Now, can we find a closed form of this surface? Turns out, we can. For generic  and , we will have no algebraic relation between and , so these two expressions are natural independent variables. Assume that is a zero of and that another zero has distance to . Then the sum of the three cosines implies a relation between and and . We can calculate this relation by eliminating unwanted variables from and .

f\[Alpha]\[Beta][x_] := Cos[x] + Cos[\[Alpha] x] + Cos[\[Beta] x]

 f\[Alpha]\[Beta][x0 + \[Delta]] // ExpandAll // TrigExpand

c\[Alpha]c\[Beta]\[Delta]Equation = GroebnerBasis[
      {f\[Alpha]\[Beta][x0],
       f\[Alpha]\[Beta][x0 + \[Delta]] // ExpandAll // TrigExpand,
       (* algebaric identities for Cos[...], Sin[...]  *)

       Cos[x0]^2 + Sin[x0]^2 - 1,
       Cos[\[Alpha] x0]^2 + Sin[\[Alpha] x0]^2 - 1,
       Cos[\[Beta] x0]^2 + Sin[\[Beta] x0]^2 - 1}, {},
      {Cos[x0], Sin[x0], Sin[\[Alpha] x0], Sin[\[Beta] x0]},
      MonomialOrder -> EliminationOrder][[
     1]] /.
    {Cos[x0 \[Alpha]] -> c\[Alpha],
     Cos[x0 \[Beta]] -> c\[Beta]} // Factor;

The resulting polynomial (in , ) is pretty large, with more than 2,500 terms.

{Exponent[c\[Alpha]c\[Beta]\[Delta]Equation, {c\[Alpha], c\[Beta]}],
 Length[c\[Alpha]c\[Beta]\[Delta]Equation]}

Output 194

Here is a snippet of the resulting equation.

Short[c\[Alpha]c\[Beta]\[Delta]Equation, 8]

Output 195

The displayed curve and surface are special cases of this equation. Because of its size, we compile the equation for faster plotting.

cf\[Alpha]\[Beta] =
 Compile[{\[Alpha], \[Beta], c\[Alpha], c\[Beta], \[Delta]},
  Evaluate[c\[Alpha]c\[Beta]\[Delta]Equation],
  CompilationOptions -> {"ExpressionOptimization" -> True}]

Output 196

We cut part of the surface open to get a better look at the inside of it. (Because of the complicated nature of the surface, we plot over a smaller vertical range compared to the above plot that used points for the zeros.)

Module[{pp = 160, \[CurlyEpsilon] = 10^-1, data},
 Monitor[
  data = Table[
     cf\[Alpha]\[Beta][GoldenRatio, GoldenRatio^2, c\[Alpha],
      c\[Beta], \[Delta]],
     {\[Delta], \[CurlyEpsilon],
      4, (4 - \[CurlyEpsilon])/pp}, {c\[Beta], -1, 1,
      2/pp}, {c\[Alpha], -1, 1, 2/pp}];, N[\[Delta]]];
 ListContourPlot3D[data,
  DataRange -> {{-1, 1}, {-1, 1}, {\[CurlyEpsilon], 4}},
  Contours -> {0}, RegionFunction -> (Not[#1 > 0 \[And] #2 < 0] &),
  MeshFunctions -> {Norm[{#1, #2}] &, #3 &},
  BoundaryStyle ->
   Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.004]],
  ViewPoint -> {2.49, -2.22, 0.53}, BoxRatios -> {1, 1, 2},
  AxesLabel -> {Cos[\[Alpha] Subscript[z, i]],
    Cos[\[Beta] Subscript[z, i]], Subscript[z, j] - Subscript[z, i]}]]

Output 197

In the case of and , we have the above algebraic equation of the Cayley surface at our disposal to remove the term.

auxEq = Cos[x0]^2 + Cos[\[Alpha] x0]^2 +
    Cos[\[Beta] x0]^2 - (1 +
      2 Cos[x0] Cos[\[Alpha] x0] Cos[\[Beta] x0]) /.
   Cos[x0] -> -Cos[\[Alpha] x0] - Cos[\[Beta] x0] /. {Cos[
     x0 \[Alpha]] -> c\[Alpha], Cos[x0 \[Beta]] -> c\[Beta]}

Output 198

(Note that the last equation is zero only for , , only at zeros and not for all values of . Eliminating the variable cβ gives us an even larger implicit equation for the distances of nonsuccessive zeros, with more than 74,000 terms.)

c\[Alpha]\[Delta]Equation =
  Resultant[c\[Alpha]c\[Beta]\[Delta]Equation, auxEq, c\[Beta]];

{Exponent[c\[Alpha]\[Delta]Equation, c\[Alpha]],
 Length[c\[Alpha]\[Delta]Equation]}

Output 199

Luckily, this large equation factors in about 10 minutes into 4 much smaller equations, each having “only” 300 summands.

(c\[Alpha]\[Delta]EquationFactored =
    Factor[c\[Alpha]\[Delta]Equation];) // Timing

{Length[c\[Alpha]\[Delta]EquationFactored],
 Length /@ (List @@ c\[Alpha]\[Delta]EquationFactored)}

Output 200

Here is a simplified form of the first factor. (For brevity of the resulting expression, we don’t yet substitute and , but will do so in a moment.)

firstFactor =
 Collect[c\[Alpha]\[Delta]EquationFactored[[1]], c\[Alpha],
  FullSimplify]

Output 201

cpc\[Phi] =
 ContourPlot[
   Evaluate[Block[{\[Alpha] = GoldenRatio, \[Beta] = GoldenRatio^2},
     (# == 0) & /@ (List @@
        c\[Alpha]\[Delta]EquationFactored)]], {c\[Alpha], -1,
    1}, {\[Delta], 0.1, 6},
   PlotPoints -> 60, AspectRatio -> 3/2] /. Tooltip[x_, _] :> x

Output 202

We overlay a few thousand randomly selected distances from the 100k zeros of calculated above. The points all fall on the blue curve, meaning the equation firstFactor describes the position of the nonsuccessive zero distances. We indicate the positions of the maxima in the successive zero distances by horizontal gridlines. (As we used generic , in the derivation of the four functions of cαδEquationFactored, we could also use and obtain a similar image.)

c\[Phi]Points = Module[{i, j},
        Select[
    Table[i = RandomInteger[{1, 99900}]; j = RandomInteger[{1, 10}];
               {Cos[GoldenRatio  zerosGolden[[i]]],
      zerosGolden[[i + j]] - zerosGolden[[i]]},
                              {50000}], #[[2]] < 6 &]];

Show[{cpc\[Phi],
  Graphics[{Black, Opacity[0.2], PointSize[0.005],
    Point[c\[Phi]Points]}]},
             GridLines -> {{}, {1.8136, 1.0439, 1.4990, 3.0114`} }]

Output 203

We see that the peak positions of the successive zero distances (gridlines) are horizontal tangents on the curves. Intuitively, this is to be expected: at a horizontal tangent, many zero distances have approximately equal values, and so the singularities in the distribution form. This horizontal tangent observation now gives us a purely algebraic method to determine the peak positions of the zero distances. The condition of horizontal tangents on the given curve described by firstFactor gives two curves whose intersection points determine the peak positions we are looking for. Here are the curves for firstFactor and the curves that represent the conditions of horizontal tangents plotted together. The intersections of the blue and the yellow/brown curves are the relevant points.

ContourPlot[
  Evaluate[Block[{\[Alpha] = GoldenRatio, \[Beta] = GoldenRatio^2},
    {firstFactor == 0,
     D[firstFactor == 0 /. \[Delta] -> \[Delta][c\[Alpha]],
        c\[Alpha] ] /. \[Delta]'[c\[Alpha]] -> 0 /. \[Delta][
        c\[Alpha]] -> \[Delta]}]],
  {c\[Alpha], -1, 1}, {\[Delta], 0, 3.5}, PlotPoints -> 60,
  GridLines -> {{}, {1.8136, 1.044, 1.5, 3.011}}] /.
 Tooltip[x_, _] :> x

Output 204

By eliminating the variable cα, we are left with a univariate equation in the zero spacing. But the resulting intermediate polynomials will be quite large (~877k terms!). So instead, we calculate a numerically high-precision approximation of the values of the horizontal tangents.

firstFactorTangents =
 FindRoot[Evaluate[
     Block[{\[Alpha] = GoldenRatio, \[Beta] = GoldenRatio^2},
                       {firstFactor == 0,
       D[firstFactor == 0 /. \[Delta] -> \[Delta][c\[Alpha]],
          c\[Alpha] ] /. \[Delta]'[c\[Alpha]] -> 0 /. \[Delta][
          c\[Alpha]] -> \[Delta]}]],
                       {c\[Alpha], #1}, {\[Delta], #2},
    WorkingPrecision -> 50, Method -> "Newton"] & @@@ {{0.3,
    1.8}, {-0.6, 1.04}, {0.3, 1.5}, {0.8, 3.01}}

Output 205

The four peak position values agree perfectly with the previously calculated values.

peakFunctions =
  Function[x, #1 Cos[x] + #2 Cos[GoldenRatio x] + #3 Cos[
        GoldenRatio^2 x]] & @@@ {{1, 1, 1}, {-1, 1, 1}, {1, -1,
     1}, {1, 1, -1}};

#1[\[Delta]/2 /. #2] & @@@
 Transpose[{peakFunctions, firstFactorTangents}]

Output 206

As a function of the zero distance , the function firstFactor describes not only the distance between successive zeros, but also between distant zeros. In the following graphic, we connect the points of the zeros and for . The graphic shows how firstFactor does indeed describe the zero distances.

Show[{
  Graphics[{Thickness[0.001], Opacity[0.2],
    Table[{{RGBColor[0.368417, 0.506779, 0.709798], RGBColor[
        0.880722, 0.611041, 0.142051], RGBColor[
        0.560181, 0.691569, 0.194885], RGBColor[
        0.922526, 0.385626, 0.209179], RGBColor[
        0.528488, 0.470624, 0.701351], RGBColor[
        0.772079, 0.431554, 0.102387], RGBColor[
        0.363898, 0.618501, 0.782349], RGBColor[1, 0.75, 0], RGBColor[
        0.647624, 0.37816, 0.614037], RGBColor[
        0.571589, 0.586483, 0.], RGBColor[0.915, 0.3325, 0.2125],
        RGBColor[0.40082222609352647`, 0.5220066643438841, 0.85]}[[
       k - 1]],
      Line[{ #[[-1]] - #1[[1]], Cos[GoldenRatio #[[1]]]} & /@
        Take[Partition[zerosGolden, k, 1], 2000]]},
     {k, 2, 7}]}, Axes -> True, PlotRange -> {{0, 10}, {-1, 1}}],
  ContourPlot[
    Evaluate[
     Block[{\[Alpha] = (1 + Sqrt[5])/
         2, \[Beta] = ((1 + Sqrt[5])/2)^2},
      firstFactor == 0]], {\[Delta], 0.1, 10}, {c\[Alpha], -1, 1},
    PlotPoints -> {80, 20}, ContourStyle -> Black] /.
   Tooltip[x_, _] :> x},
 Frame -> True, Axes -> False, PlotRangeClipping -> True,
 AspectRatio -> 1/4]

Output 207

The graphic also shows the string correlation between successive zeros that we saw in the previous pair correlation histogram.

Histogram[
 VectorAngle[#1 - #2, #3 - #2] & @@@
  Partition[{ #[[-1]] - #1[[1]], Cos[GoldenRatio #[[1]]]} & /@
                                   Partition[zerosGolden, 2, 1], 3,
   1], 1000, {"Log", "Count"}]

Output 208

Above, we plotted the zero distances over the complex plane. The expression firstFactor allows us to plot the value of over the complexplane. The next graphic shows the real part of over a part of the first quadrant.

Module[{pp = 60, pts, c\[Alpha]Zeros},
 (c\[Alpha]Zeros[\[Delta]_] :=
     c\[Alpha] /.
      Solve[Block[{\[Alpha] = GoldenRatio, \[Beta] =
          GoldenRatio^2}, # == 0], c\[Alpha]]) &[firstFactor];
 pts = Cases[
   Flatten[Table[
     N@{\[Delta]x, \[Delta]y, Re[#]} & /@
      c\[Alpha]Zeros[N[\[Delta]x + I \[Delta]y]],
                                {\[Delta]y, -0, 2, 2/pp}, {\[Delta]x,
      0, 2, 2/pp}], 2], {_Real, _Real, _Real}];
 Graphics3D[{RGBColor[0.36, 0.51, 0.71], Sphere[pts, 0.01]},
  BoxRatios -> {1, 1, 3/2}, Axes -> True,
  PlotRange -> {All, All, 6 {-1, 1}},
  AxesLabel -> {Re[\[Delta]], Im[\[Delta]], Re[c\[Alpha]]},
  ViewPoint -> {1.98, -2.66, 0.65}, Method -> {"SpherePoints" -> 6}]]

Output 209

Now we have all equations at hand to determine the two remaining peak positions of the function fBrass, which had the approximate values and . We use the implicit equation obeyed by and at zeros of .

c\[Alpha]c\[Beta]Brass[c\[Alpha]_, c\[Beta]_] =
 Collect[1 + 2 c\[Alpha] - 3 c\[Alpha]^2 - 4 c\[Alpha]^3 +
   4 c\[Alpha]^4 + 2 c\[Beta] + 2 c\[Alpha] c\[Beta] -
   4 c\[Alpha]^2 c\[Beta] - 3 c\[Beta]^2 - 4 c\[Alpha] c\[Beta]^2 +
   8 c\[Alpha]^3 c\[Beta]^2 - 4 c\[Beta]^3 +
   8 c\[Alpha]^2 c\[Beta]^3 + 4 c\[Beta]^4, c\[Beta]]

Output 210

Rather than eliminating the variable symbolically, for each cα, we numerically calculate all possible values for cβ and substitute these values into cαcβδEquation. For faster numerical evaluation, we compile the resulting expression.

c\[Alpha]\[Delta]BrassCompiled =
 Compile[{{c\[Alpha], _Complex}, {\[Delta], _Complex}},
  Evaluate[Block[{\[Alpha] = (1 + Sqrt[3])/
       2, \[Beta] = ((1 + Sqrt[3])/2)^2},

    Block[{c\[Beta] = #},
       c\[Alpha]c\[Beta]\[Delta]Equation] & /@ (c\[Beta] /.
       Solve[c\[Alpha]c\[Beta]Brass[c\[Alpha], c\[Beta]] == 0,
        c\[Beta]])]],
  CompilationOptions -> {"ExpressionOptimization" -> True}]

Output 211

Calculating the values of cαcβBrass on a dense set of cα, δ grid points as blue points graphically the represents all possible zero distances as a function of cα. We overlay some of the previously calculated zero distances from above as orange points, the four identified peak positions as dark green lines and the two outstanding peak positions as red lines.

Module[{ppc\[Alpha] = 400, pp\[Delta] = 600, data, cp},
 Monitor[data =
    Table[c\[Alpha]\[Delta]BrassCompiled[
      c\[Alpha], \[Delta]], {\[Delta], 0, 4,
      4/pp\[Delta]}, {c\[Alpha], -1, 1, 2/ppc\[Alpha]}];,
  N[{\[Delta], c\[Alpha]}]];
 cp = Show[
   ListContourPlot[Re[#], Contours -> {0}, ContourShading -> None,
      DataRange -> {{-1, 1}, {0, 4}},
      ContourStyle ->
       Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.004]],
      PlotRange -> {{-1, 1}, {0.1, 4}}] & /@
    Transpose[data, {2, 3, 1}]];
 Show[{Graphics[{PointSize[0.004], Opacity[0.3], Orange,
     Point[{Cos[\[Phi]Brass #1], #2} & @@@

       RandomSample[Transpose[{Most[zerosBrass], differencesBrass}],
        10000]],
     Darker[Green], Opacity[1], Thickness[0.002],
     Line[{{-1, #}, {1, #}} & /@ {2.2299, 1.46396, 2.0722, 3.5761}],
     Red, Line[{{-1, #}, {1, #}} & /@ {1.098, 2.367}]},
    AspectRatio -> 3/2, Frame -> True, PlotRangeClipping -> True,
    PlotRange -> {{-1, 1}, {0.1, 4}}], cp}]]

Output 212

We clearly see that the two remaining peak positions also occur at points where the zero distance curve has a horizontal tangent. Expressing the condition of a horizontal tangent to the curve cαcβδEquation (with the constraint cαcβBrass) numerically allows us to calculate high-precision values for the two remaining peak positions. (We also include the differentiated form of the constraint to have four equations in four variables.)

c\[Alpha]c\[Beta]Brass = (-1 + x + 2 y^2)^2 +
     4 (-1 + x - 2 x y^2) z^2 + 4 z^4 /.
    x -> -y - z /. {y -> c\[Alpha], z -> c\[Beta]} // Simplify

Output 213

horizontalTangentsBrass =
  Block[{\[Alpha] = \[Phi]Brass, \[Beta] = \[Phi]Brass^2},
     {c\[Alpha]c\[Beta]\[Delta]Equation /. {
       c\[Beta] ->
        c\[Beta][c\[Alpha]], \[Delta] -> \[Delta][c\[Alpha]]},
     D[c\[Alpha]c\[Beta]\[Delta]Equation /. {
        c\[Beta] ->
         c\[Beta][c\[Alpha]], \[Delta] -> \[Delta][c\[Alpha]]},
      c\[Alpha]],
     c\[Alpha]c\[Beta]Brass /. c\[Beta] -> c\[Beta][c\[Alpha]],
     D[c\[Alpha]c\[Beta]Brass /. c\[Beta] -> c\[Beta][c\[Alpha]],
      c\[Alpha]]} /. {c\[Beta][c\[Alpha]] -> c\[Beta],
     Derivative[1][c\[Beta]][c\[Alpha]] ->
      c\[Beta]P, \[Delta][c\[Alpha]] -> \[Delta], \[Delta]'[
       c\[Alpha]] -> 0}];

Length[Expand[#]] & /@ horizontalTangentsBrass

Output 214

FindRoot[Evaluate[horizontalTangentsBrass],
                  {c\[Alpha], -4305/100000}, {\[Delta],
  10966/10000}, {c\[Beta], 97/100}, {c\[Beta]P, 78/100},
         WorkingPrecision -> 30, PrecisionGoal -> 10,
 Method -> "Newton", MaxIterations -> 100]

Output 215

FindRoot[Evaluate[horizontalTangentsBrass],
                   {c\[Alpha], 39/100}, {\[Delta],
  2366/1000}, {c\[Beta], -38/100}, {c\[Beta]P, -71/100},
         WorkingPrecision -> 30, PrecisionGoal -> 10,
 Method -> "Newton", MaxIterations -> 100]

Output 216

And now the calculated peak positions of the zero distances agree perfectly with the numerically observed ones.

Function[c,
  Histogram[Select[differencesBrass, c - 0.005 < # < c + 0.005 &],
   100, 

   GridLines -> {{1.0966482948, 2.3673493597}, {}},
                       PlotRangeClipping -> True,
   Method -> {"GridLinesInFront" -> True}]] /@ {1.0977, 2.366}

Output 217

Power Laws near the Peaks of the Zero Distances?

Now that we have found equations for the positions of the singularities, how does the density of the zero distances behave near such a singularity? To find out, we select bins near the singularities and count the number of distances in these bins.

singData =
  Table[Module[{sel}, sel =
     If[j == 2 || j == 3 || j == 4,
      Select[differencesGolden,
       Evaluate[peaksGolden[[j]] <= # <= peaksGolden[[j]] + 0.2] &],
      Select[differencesGolden,
       Evaluate[peaksGolden[[j]] - 0.2 <= # <= peaksGolden[[j]]] &]];
    {Abs[#1 - peaksGolden[[j]]], #2} & @@@ Tally[Round[sel, 0.001]]],
   {j, 4}];

A log-log plot of the counts versus the distance to the singularities shows straight lines. This encourages us to conjecture that the behavior of the density near a singularity behaves as .

ListLogLogPlot[singData, PlotRange -> {{5 10^-3, 1.8 10^-1}, All},
 PlotLegends -> (Row[{"x", "\[TildeTilde]", NumberForm[#, 4]}] & /@
    peaksGolden)]

Output 218

The numerical value of depends on the concrete singularity, and seems to be in the range of . Numerical experiments with other sums of three trigonometric functions show a power law behavior near the singularities in general. The values of the exponents vary.

Coefficient[
   Fit[Log[Select[#, 10^-3 <= #[[1]] <= 10^-1 &]], {1, x}, x],
   x] & /@ singData

Output 219

We can now also model what would happen if the phases in++ were random (but fulfilling the conditions for the envelopes). Here we do this for the local extrema at with function value –1 at this point.

gGolden[x_, {\[CurlyPhi]1_, \[CurlyPhi]2_, \[CurlyPhi]3_}] :=
  Cos[x + \[CurlyPhi]1] + Cos[GoldenRatio x + \[CurlyPhi]2] +
   Cos[GoldenRatio^2 x + \[CurlyPhi]3];

We select a random value for and calculate values for and so that , .

phases = DeleteCases[
   Table[Check[Block[{\[CurlyPhi]1 = RandomReal[{-Pi, Pi}]},
       {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3} /.
        FindRoot[
         Evaluate[{gGolden[
             0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == -1,
                                                                      \
        Derivative[1, {0, 0, 0}][gGolden][
             0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] == 0}],
         {\[CurlyPhi]2, RandomReal[{-Pi, Pi}]}, {\[CurlyPhi]3,
          RandomReal[{-Pi, Pi}]}]], {}],
                    {100000}] // Quiet, {}];

Due to the two constraint equations, the phases are correlated.

Histogram3D[Mod[phases, 2 Pi][[All, {##}]], 100,

   AxesLabel -> {Subscript["\[CurlyPhi]", #1],
     Subscript[
      "\[CurlyPhi]", #2]}] & @@@
                                     \
                                                                      \
     {{1, 2}, {1, 3}, {2, 3}}

Output 220

Two of the three remaining envelope zeros are clearly visible. (With the numerical root-finding method, one catches only a few curves that are near the green curve.) While the overall graphics look symmetric with respect to the line, the individual curves are not. In contrast to the behavior of , under the assumption of totally random phases between , and , the sums with random phases quickly take on values smaller than –3/2.

Plot[Evaluate[gGolden[x, #] & /@ RandomSample[phases, 250]], {x, -2,
   5},

  PlotStyle -> Directive[Thickness[0.001], Opacity[0.2], Gray],
  Prolog -> {Plot[
      Cos[x] - Cos[GoldenRatio x] - Cos[GoldenRatio^2 x], {x, -2, 5},

      PlotStyle ->
       Directive[RGBColor[0.36, 0.51, 0.71], Opacity[0.5]]][[1]],

    Plot[-Cos[x] + Cos[GoldenRatio x] - Cos[GoldenRatio^2 x], {x, -2,
       5},

      PlotStyle ->
       Directive[RGBColor[0.88, 0.61, 0.14], Opacity[0.5]]][[1]],

    Plot[-Cos[x] - Cos[GoldenRatio x] + Cos[GoldenRatio^2 x], {x, -2,
       5},

      PlotStyle ->
       Directive[ RGBColor[0.56, 0.69, 0.19], Opacity[0.5]]][[1]]},
  GridLines -> {{}, {-1, 3}},
  Epilog -> {Directive[Purple, PointSize[0.01]], 

    Point[{#/2, 0} & /@ {1.04398, 1.49906, 3.01144}]}] /.

 l_Line :> Mouseover[l, {Red, Thickness[0.002], Opacity[1], l}]

gGoldenZeros =
  Quiet[x /. FindRoot[Evaluate[gGolden[x, #]], {x, 1/2}] & /@ phases];

The estimated in obtained from the zeros of these curves with random phases agree remarkably well with the two values from the above histograms. This suggests that, to a certain degree, the assumption of random local phases is justified.

phasesmpp =
  With[{\[Xi] = peaksGolden[[2]]/2},
   Select[gGoldenZeros, \[Xi] < # < \[Xi] + 0.1 &] - \[Xi]];
\[Gamma]2 =
  Coefficient[
   Fit[N[Cases[Log[Tally[Round[phasesmpp, 0.001]]], {_Real, _}]], {1,
     x}, x], x];
Histogram[phasesmpp, 100,
 PlotLabel ->
  Row[{"\[Gamma]", "\[ThinSpace]\[TildeTilde]\[ThinSpace]",
    NumberForm[\[Gamma]2, 2]}]]

Output 221

phasespmp =
  With[{\[Xi] =
     peaksGolden[[3]]/
      2}, -(Select[gGoldenZeros, \[Xi] - 0.03 < # < \[Xi] &] - \[Xi])];
\[Gamma]3 =
  Coefficient[
   Fit[N[Cases[Log[Tally[Round[phasespmp, 0.001]]], {_Real, _}]], {1,
     x}, x], x];
Histogram[phasespmp, 100,
 PlotLabel ->
  Row[{"\[Gamma]", "\[ThinSpace]\[TildeTilde]\[ThinSpace]",
    NumberForm[\[Gamma]3, 2]}]]

Output 222

The appendix contains some calculations based on the computed zero density (assuming uniform distribution of phases) to see if the power law holds exactly or is approximate.

The Inflection Points of fɸ(x)

For completeness, I repeat the distance investigations that were carried out for the zeros and extrema for inflection points.

The inflection points are the zeros of the second derivative.

findInflectionPoints[f_, n_] := findZeros[f'', n]

inflectionsGolden =
  Prepend[findInflectionPoints[fGolden, 100000], 0.];

The following plots are the direct equivalent to the case of extrema, so we skip commenting on them individually.

Plot[fGolden[x], {x, 0, 10.3 Pi},
 Epilog -> {Darker[Red],
   Point[{#, fGolden[#]} & /@ Take[ inflectionsGolden, 30]]}]

Output 223

Graphics[{PointSize[0.001], RGBColor[0.36, 0.51, 0.71], Opacity[0.2],
  Point[N[{#, fGolden[#]} & /@ inflectionsGolden]]},
 AspectRatio -> 1/2, ImageSize -> 400, Frame -> True]

Output 224

Histogram[Mod[inflectionsGolden, 2 Pi], 200]

Output 225

Histogram[Differences[inflectionsGolden], 1000, PlotRange -> All]

Output 226

Histogram[Differences[inflectionsGolden, 2], 1000, PlotRange -> All]

Output 227

Histogram3D[{#2 - #1, #3 - #2} & @@@
  Partition[inflectionsGolden, 3, 1], 100, PlotRange -> All]

Output 228

summandValuesI = {Cos[#], Cos[GoldenRatio #],
     Cos[GoldenRatio^2 #]} & /@ inflectionsGolden;

Graphics3D[{PointSize[0.002], RGBColor[0.36, 0.51, 0.71],
  Point[Union@Round[summandValuesI, 0.01]]},
 PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}, Axes -> True,
 AxesLabel -> {Cos[x], Cos[GoldenRatio x], Cos[GoldenRatio^2 x]}]

Output 229

Maximal Distance between Successive Zeros

Having found the positions of the peaks of the distribution of the distances of the zeros, another natural question to ask about the zero distribution is: what is the largest possible distance between two successive roots? The largest distance will occur in the following situation: starting at a zero, the function will increase or decrease, then have a first extremum, then a second and a third extremum, and then will have another zero. When the middle extremum barely touches the real axis, the distance between the two zeros will be largest. Here are some plots of the function around zeros that are the furthest apart. Note that while the curves look, at first glance, symmetric around x ≈ 1.6, the low maxima on the left side belongs to the curve with the high maxima on the right side and vice versa.

Show[Plot[fGolden[# + t], {t, -2, 0 + 5}, PlotRange -> All,
     PlotStyle ->
      Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
       Opacity[0.3]]] & /@
   Take[Sort[
      Transpose[{differencesGolden, Most[zerosGolden]}]], -500][[All,
    2]],
  PlotRange -> All, Frame -> True, GridLines -> {{0}, {-1, 3}},
  ImageSize -> 400] /.

 l_Line :> Mouseover[l, {Red, Thickness[0.002], Opacity[1], l}]

Output 230

For the random phase model, I calculate the phases that make the middle extrema just touch the real axis.

h[x_] = Cos[x + \[CurlyPhi]1] + Cos[\[Alpha] x + \[CurlyPhi]2] +
   Cos[\[Beta] x + \[CurlyPhi]3] ;
\[CurlyPhi]2\[CurlyPhi]3MaxD\[CurlyPhi]1[] = (Solve[{h[x] == 0,
        D[h[x], x] == 0, D[h[x], \[CurlyPhi]1] == 0} /.
       x -> 0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] /. _C ->
      0 // Simplify);
{Length[\[CurlyPhi]2\[CurlyPhi]3MaxD\[CurlyPhi]1[]], \[CurlyPhi]2\
\[CurlyPhi]3MaxD\[CurlyPhi]1[][[1]]}

Output 230

Here is a plot of a solution with the middle extrema touching the real axis.

touchingSolutions\[CurlyPhi]1[x_] =
  h[x] /. Select[ \[CurlyPhi]2\[CurlyPhi]3MaxD\[CurlyPhi]1[],
     Im[h[x] /. # /.
                                  {\[Alpha] ->
            GoldenRatio, \[Beta] -> GoldenRatio^2} /. x -> 5.] ==
       0 &] /.
   {\[Alpha] -> GoldenRatio, \[Beta] -> GoldenRatio^2};

Here is one of the solutions.

touchingSolutions\[CurlyPhi]1[x][[1]] // FullSimplify

Output 231

Here is a plot of a solution with the middle extrema touching the real axis. The four solutions each give the same maximal zero distance.

Plot[touchingSolutions\[CurlyPhi]1[x], {x, -3, 3}]

Output 232

The so-obtained maximal distance between two zeros agrees well with the observed value. The calculated maximum is slightly larger than the observed one. (The reverse situation would be bad.)

(Min[x /.
     Solve[touchingSolutions\[CurlyPhi]1[x][[1]] == 0 \[And]
       1/10 < x < 4, x, Reals]] -
   Max[x /.
     Solve[touchingSolutions\[CurlyPhi]1[x][[1]] == 0 \[And] -4 <
        x < -1/10, x, Reals]]) // N[#, 5] &

Output 233

Max[differencesGolden]

Output 234

Finding the envelopes with respect to and does not give a larger result.

\[CurlyPhi]2\[CurlyPhi]3MaxD\[CurlyPhi]2[] = (Solve[{h[x] == 0,
        D[h[x], x] == 0, D[h[x], \[CurlyPhi]2] == 0} /.
       x -> 0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] /. _C ->
      0 // Simplify);
touchingSolutions\[CurlyPhi]2[x_] =
  With[{R = {\[Alpha] -> GoldenRatio, \[Beta] -> GoldenRatio^2}},
   h[x] /.

     Select[ \[CurlyPhi]2\[CurlyPhi]3MaxD\[CurlyPhi]2[],
      Im[h[x] /. # /. R /. x -> 5.] == 0 &] /. R];

\[CurlyPhi]2\[CurlyPhi]3MaxD\[CurlyPhi]3[] = (Solve[{h[x] == 0,
        D[h[x], x] == 0, D[h[x], \[CurlyPhi]3] == 0} /.
       x -> 0, {\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}] /. _C ->
      0 // Simplify);
touchingSolutions\[CurlyPhi]3[x_] =
  With[{R = {\[Alpha] -> GoldenRatio, \[Beta] -> GoldenRatio^2}},
   h[x] /.

     Select[ \[CurlyPhi]2\[CurlyPhi]3MaxD\[CurlyPhi]3[],
      Im[h[x] /. # /. R /. x -> 5.] == 0 &] /. R] ;

(Quiet[Min[x /. Solve[N[#] == 0 \[And] 0 < x < 4, x, Reals]] -
       Max[
        x /. Solve[N[#] == 0 \[And] -4 < x < 0, x,
          Reals]]] & /@ #) & /@ {touchingSolutions\[CurlyPhi]1[x],
  touchingSolutions\[CurlyPhi]2[x], touchingSolutions\[CurlyPhi]3[x]}

Output 235

Here are the three envelope curve families together with near 97,858.4.

With[{x0 = 97858.38930},
 Show[{Plot[fGolden[x0 + x], {x, -3, 3},

    PlotStyle -> Directive[Thickness[0.01], Gray, Opacity[0.4]]],

   Plot[touchingSolutions\[CurlyPhi]1[x], {x, -3, 3},
    PlotStyle -> RGBColor[0.88, 0.61, 0.14]],

   Plot[touchingSolutions\[CurlyPhi]2[x], {x, -3, 3},
    PlotStyle -> RGBColor[0.36, 0.51, 0.71] ],

   Plot[touchingSolutions\[CurlyPhi]3[x], {x, -3, 3},
    PlotStyle -> RGBColor[0.56, 0.69, 0.19] ]},
                PlotRange -> All]]

Output 236

Interestingly, the absolute minimum of the distance between two successive zeros in + + is slightly larger.

rootDistance[{\[CurlyPhi]1_Real, \[CurlyPhi]2_Real, \
\[CurlyPhi]3_Real}] := (Min[Select[#, Positive]] -
     Max[Select[#, Negative]]) &[
  N[x /. Quiet[
     Solve[Cos[x + \[CurlyPhi]1] + Cos[GoldenRatio x + \[CurlyPhi]2] +
          Cos[GoldenRatio^2 x + \[CurlyPhi]3] == 0 \[And] -5 < x < 5,
      x]]]]

If one lets the three phases range over the domains , then one finds a slightly larger maximal distance between zeros.

 With[{pp = 24},
 Monitor[Table[{{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3},
     rootDistance[
      N@{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}]}, {\[CurlyPhi]1,
     0, 2 Pi (1 - 1/pp), 2 Pi/pp},
                   {\[CurlyPhi]2, 0, 2 Pi (1 - 1/pp),
     2 Pi/pp}, {\[CurlyPhi]3, 0, 2 Pi (1 - 1/pp), 2 Pi/pp}];,
  N@{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}]]

FindMaximum[
  rootDistance[{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}], {{\
\[CurlyPhi]1, 23 Pi/12}, {\[CurlyPhi]2, 7 Pi/6}, {\[CurlyPhi]3,
    Pi/3}}] // Quiet

Output 237

FindMaximum[
  rootDistance[{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}], {{\
\[CurlyPhi]1, 23 Pi/12}, {\[CurlyPhi]2, 7 Pi/6}, {\[CurlyPhi]3,
    Pi/3}}] // Quiet

Output 238

This maximum distance is realized when a minimum (maximum) between two zeros barely touches the real axis.

Plot[Cos[x + \[CurlyPhi]1] + Cos[GoldenRatio x + \[CurlyPhi]2] +
   Cos[GoldenRatio^2 x + \[CurlyPhi]3] /. %[[2]], {x, -3, 3}]

Output 239

Calculating the first million zeros of does not yield a value larger than the previously calculated value of 3.334. This suggests that the last curve configuration is not realized along the real axis in .

Here is a list of record maxima slightly below the real axis, found by calculating the first few million extrema of . (This list was found using a version of the above function findZeros for the first derivative and only keeping a list of extremal shallow maxima.)

shallowMaxima =
  {2.4987218706691797180876160929177,
   33.704071215892008970482202830654,
   98.293712744702474592256555931685,
   443.88844400968497878246638591063,
   3388.8528289090563871971140906274,
   12846.898421437481029976313761124,
   55352.647183638537564573877897525,
   124704.59412664060098149321964301,
   166634.14221987979291743435707392,
   304761.83543691954802508678830822,
   457972.87856640025996046175960675,
   776157.81309371886102983541391071,
   1220707.5925697200786171039302735};

The next plot shows how record maxima approach the real axis from below.

ListLogLogPlot[{#, -fGolden[#]} & /@ shallowMaxima,
 AxesLabel -> {x, -Subscript[f, \[Phi]][x]}]

Output 240

Here is a plot of at the least shallow value.

{Plot[fGolden[shallowMaxima[[-1]] + x], {x, -2, 2}],
 Plot[fGolden[shallowMaxima[[-1]] + x], {x, -0.001, 0.001}]}

Output 241

The root difference for this “near” zero is about 3.326058.

Differences[
 N[x /. Solve[
    fGolden[Rationalize[shallowMaxima[[-1]], 0] + x] == 0 \[And] -3 <
      x < 3, x], 15]]

Output 242

Interpolating the data from the last graphic, one gets for the value of the shallowest maxima up to .

The distances between the nearest roots to the right and left of these maxima seem to approach an upper bound below the 3.3340 value from above.

Differences[
     Function[\[CapitalDelta],
       x /. FindRoot[
         Evaluate[fGolden[x] == 0], {x, # + \[CapitalDelta]},
          WorkingPrecision -> 100, PrecisionGoal -> 30]] /@ {-2,
       2}] & /@
                                                      \
                     shallowMaxima // Flatten // N[#, 10] &

Output 243

So is it a special property of that the maximal root distance assuming arbitrary phases is not realized, or is it a more general property of all ? Numerically, experiments with various transcendental values of and suggest that generically the maximal possible root distance obtained from the envelope method agrees with the maximum observed.

Unfortunately, this time the algebraic formulation of the distances between the zeros does not provide the ultimate answer. The following graphic shows the four branches of the factored cαδEquation together with the observed points. No special structure is visible in the curves at the maximal-observed zero distances. The two “strands” of points correspond to the two curves shown in the first plot in this section.

ContourPlot[
  Evaluate[Block[{\[Alpha] = GoldenRatio, \[Beta] = GoldenRatio^2},
    # == 0 & /@ (List @@
       c\[Alpha]\[Delta]EquationFactored)]], {c\[Alpha], -1,
   1}, {\[Delta], 3.25, 3.4}, PlotPoints -> 50,
  Epilog -> {Black, PointSize[0.01],
    Point[{Cos[GoldenRatio #1] , #2 - #1} & @@@
      Select[Partition[zerosGolden, 2,
        1], #[[2]] - #[[1]] > 3.25 &]]},
  GridLines -> {{}, {1.813, 1.044, 1.5, 3.011, 3.334}}] /.
 Tooltip[x_, _] :> x

Output 244

The new root that appears at the maximal root distance is in the algebraic formulation visible as vertical tangents in the curve. Plotting the vertical tangents at the positions of the largest zero distances observed and the observed zero distances shows this clearly.

ContourPlot[
  Evaluate[Block[{\[Alpha] = (1 + Sqrt[5])/
       2, \[Beta] = ((1 + Sqrt[5])/2)^2},
    {firstFactor == 0}]], {c\[Alpha], -1, 1}, {\[Delta], 0, 3.6},
  PlotPoints -> 50,
  Epilog -> {Black, PointSize[0.003],
    Point[{Cos[GoldenRatio #1] , #2 - #1} & @@@
      RandomSample[Partition[zerosGolden, 2, 1], 15000]]},
  GridLines -> {Mean /@
     Split[Sort[
       Cos[GoldenRatio #1] & @@@
        Select[Partition[zerosGolden, 2,
          1], #[[2]] - #[[1]] > 3.32 &]],
      Abs[#1 - #2] < 0.4 &], {} }] /. Tooltip[x_, _] :> x

Output 245

Finding the points of vertical tangents and “lifting” the values of these points to the curve near the observed intersections gives the algebraic prediction for maximal root distances.

verticalTangentsc\[Alpha]\[Delta] =
 FindRoot[Evaluate[
     Block[{\[Alpha] = (1 + Sqrt[5])/
         2, \[Beta] = ((1 + Sqrt[5])/2)^2}, {firstFactor == 0,
       D[firstFactor == 0 /.
           c\[Alpha] -> c\[Alpha][\[Delta]], \[Delta]] /.
         c\[Alpha]'[\[Delta]] -> 0 /.
        c\[Alpha][\[Delta]] -> c\[Alpha]}]],
    {c\[Alpha], #1}, {\[Delta], #2}, WorkingPrecision -> 50,
    PrecisionGoal -> 20, MaxIterations -> 200] & @@@
  {{-0.15,
    1.63}, {0.68, 1.7}}

Output 246

(FindRoot[
     Evaluate[
      Block[{\[Alpha] = (1 + Sqrt[5])/
          2, \[Beta] = ((1 + Sqrt[5])/2)^2},
                        firstFactor == 0 /. #[[1]] ]],
      {\[Delta], 3.3}, WorkingPrecision -> 40, PrecisionGoal -> 20,
     MaxIterations -> 200] //
    N[#, 20] &) & /@ verticalTangentsc\[Alpha]\[Delta]

Output 247

Both zero distances agree; this means the maximal root distance is about 3.32606.

Summary and Features Still to Look At

Through graphical explorations, statistical tests and numerical checks, we have been able to conjecture the answer to the original MathOverflow question: the positions of the peaks in the distribution of zero distances of are two times the positions of the smallest zeros of .

The concrete function exhibits an interesting mixture of generic and nongeneric properties due to the golden ratio factors.

Many other structures within the zeros, extrema and inflection points of the sum of three trigonometric functions could be investigated, as well as the relations between the zeros, extrema and other special points. Here are a few examples.

Special Points mod 2π

For instance, we could visualize the cosine arguments of the zeros, extrema and inflection points. Here are the argument values modulo .

Graphics3D[{PointSize[0.002], RGBColor[0.36, 0.51, 0.71],
   Point[Mod[# {1, GoldenRatio, GoldenRatio^2}, 2 Pi] & /@
     zerosGolden],
   RGBColor[0.88, 0.61, 0.14],
   Point[Mod[# {1, GoldenRatio, GoldenRatio^2}, 2 Pi] & /@
     extremasGolden],
   RGBColor[0.56, 0.69, 0.19],
   Point[Mod[# {1, GoldenRatio, GoldenRatio^2}, 2 Pi] & /@
     inflectionsGolden]},
  PlotRange -> {{0, 2 Pi}, {0, 2 Pi}, {0, 2 Pi}}, Axes -> True] //
 Legended[#,
   LineLegend[{RGBColor[0.36, 0.51, 0.71], RGBColor[0.88, 0.61, 0.14],
      RGBColor[0.56, 0.69, 0.19]}, {"zeros", "extrema",
     "inflection points"}]] &

Output 248

Correctness of the Random Phase Assumption

Or we could look in more detail at how faithful the zero distances are reproduced if one takes the random phases seriously and looks at all functions of the form + +. For a grid of , , values, we calculate the distance between the smallest positive and largest negative zero.

zeroDistance0[
  f_] :=
 (Min[Select[#, Positive]] - Max[Select[#, Negative]]) &[
   Table[x /. FindRoot[f, {x, x0}], {x0, -3, 3, 6/17}]] // Quiet

The resulting distribution of the zero distances looks quantitatively different from the zero distance distributions of . But because the peak positions arise from the envelopes, we see the same peak positions as in .

With[{pp = 40},
 Monitor[
  zeroData =
    Table[zeroDistance0[
      Cos[x + \[CurlyPhi]1] + Cos[GoldenRatio x + \[CurlyPhi]2] +
       Cos[GoldenRatio^2 x + \[CurlyPhi]3]],
     {\[CurlyPhi]3, 0, 2 Pi (1 - 1/pp), 2 Pi/pp}, {\[CurlyPhi]2, 0,
      2 Pi (1 - 1/pp), 2 Pi/pp}, {\[CurlyPhi]1, 0, 2 Pi (1 - 1/pp),
      2 Pi/pp}];,
  N@{\[CurlyPhi]3, \[CurlyPhi]2, \[CurlyPhi]1}]]

Histogram[Flatten[zeroData], 200, GridLines -> {peaksGolden, {}}]

Output 249

Function Value Distribution in the Random Phase Assumption

Or we could model the function value distribution in the general case. The function value distribution for generic , is quite different from the one observed above for . Generically (see the examples in the postlude) it has a characteristic flat middle part in the interval . Assuming again that locally around the function looks like + + with and uniformly distributed and , we can express the probability to see the function value as:

P(y) = \!\(
\*UnderoverscriptBox[\(\[Integral]\), \(0\), \(2  \[Pi]\)]\(
\*UnderoverscriptBox[\(\[Integral]\), \(0\), \(2  \[Pi]\)]\(
\*UnderoverscriptBox[\(\[Integral]\), \(0\), \(2  \[Pi]\)]\*
TemplateBox[{RowBox[{"y", "-",
RowBox[{"(",
RowBox[{
RowBox[{"cos", "(",
SubscriptBox["\[CurlyPhi]", "1"], ")"}], "+",
RowBox[{"cos", "(",
SubscriptBox["\[CurlyPhi]", "2"], ")"}], "+",
RowBox[{"cos", "(",
SubscriptBox["\[CurlyPhi]", "3"], ")"}]}], ")"}]}]},
"DiracDeltaSeq"] \[DifferentialD]
\*SubscriptBox[\(\[CurlyPhi]\), \(1\)] \[DifferentialD]
\*SubscriptBox[\(\[CurlyPhi]\), \(2\)] \[DifferentialD]
\*SubscriptBox[\(\[CurlyPhi]\), \(3\)]\)\)\)

Integrating out the delta function, we obtain the following.

P(y)~\!\(
\*UnderoverscriptBox[\(\[Integral]\), \(0\), \(2  \[Pi]\)]\(
\*UnderoverscriptBox[\(\[Integral]\), \(0\), \(2  \[Pi]\)]
\*FractionBox[\(\[Theta](1 -
\*SuperscriptBox[\((y - cos(
\*SubscriptBox[\(\[CurlyPhi]\), \(1\)]) - cos(
\*SubscriptBox[\(\[CurlyPhi]\), \(2\)]))\), \(2\)])\),
SqrtBox[\(1 -
\*SuperscriptBox[\((y - cos(
\*SubscriptBox[\(\[CurlyPhi]\), \(1\)]) - cos(
\*SubscriptBox[\(\[CurlyPhi]\), \(2\)]))\), \(2\)]\)]] \[DifferentialD]
\*SubscriptBox[\(\[CurlyPhi]\), \(1\)] \[DifferentialD]
\*SubscriptBox[\(\[CurlyPhi]\), \(2\)]\)\)

Carrying out the integral numerically gives exactly the function value distribution shown below.

Pfv[y_] :=
 NIntegrate[
   Piecewise[{{1/(\[Pi] Sqrt[
          1 - (y - Cos[\[CurlyPhi]1] - Cos[\[CurlyPhi]2])^2]),

      1 - (y - Cos[\[CurlyPhi]1] - Cos[\[CurlyPhi]2])^2 >= 0}}],
    {\[CurlyPhi]1, 0, 2 Pi}, {\[CurlyPhi]2, 0, 2 Pi},
   PrecisionGoal -> 3]/(2 Pi)^2

lpPfv = ListPlot[Join[Reverse[{-1, 1} # & /@ #], #] &[
           Monitor[Table[{y, Pfv[y]}, {y, 0, 3, 0.05}], y]],
  Joined -> True, Filling -> Axis]

Output 250

This distribution agrees quite well with the value distribution observed for .

Show[{Histogram[Table[fPi[x], {x, 0, 1000, 0.001}], 100, "PDF"],
  lpPfv}]

Output 251

Mean Zero Spacing in the Random Phase Assumption

The observed value of mean spacing between zeros is ≈1.78.

meanGoldenZeroSpacing = Mean[differencesGolden]

Output 252

Here is a plot showing how the average mean spacing evolves with an increasing number of zeros taken into account. The convergence is approximately proportional to .

{ListPlot[Take[#, 100] &@Transpose[{ Most[zerosGolden],
     MapIndexed[#1/#2[[1]] &, Accumulate[differencesGolden]]}],
  PlotRange -> All, GridLines -> {{}, {meanGoldenZeroSpacing}}],
 Show[{ListLogLogPlot[Transpose[{ Most[zerosGolden],
      Abs[
       MapIndexed[#1/#2[[1]] &, Accumulate[differencesGolden]] -
        meanGoldenZeroSpacing]}]],
   LogLogPlot[5 x^-0.88, {x, 1, 2 10^5}, PlotStyle -> Gray]}]}

Output 253

If one uses the random phase approximation and average over all zero distances with at least one zero in the interval , and using a grid of values for the phases, one gets a value that agrees with the empirically observed spacing to less than 1%.

zeroSpacings[{\[CurlyPhi]1_, \[CurlyPhi]2_, \[CurlyPhi]3_}] :=
 Module[{sols, pos1, pos2},
  sols = Quiet[
    Sort[x /.

      Solve[N[Cos[x + \[CurlyPhi]1] +
           Cos[GoldenRatio x + \[CurlyPhi]2] +
           Cos[GoldenRatio^2 x + \[CurlyPhi]3]] == 0 \[And] -6 < x <
         12, x]]];
  pos1 = Max[Position[sols, _?(# < 0 &)]];
  pos2 = Min[Position[sols, _?(# > 2 Pi &)]];
  Differences[Take[sols, {pos1, pos2}]]]

Module[{pp = 32, sp}, Monitor[
  spacingArray =
    Table[
     sp = zeroSpacings[{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}], {\
\[CurlyPhi]1, 0, 2 Pi (1 - 1/pp), 2 Pi/pp},
                             {\[CurlyPhi]2, 0, 2 Pi (1 - 1/pp),
      2 Pi/pp}, {\[CurlyPhi]3, 0, 2 Pi (1 - 1/pp), 2 Pi/pp}];,
  {N@{\[CurlyPhi]1, \[CurlyPhi]2, \[CurlyPhi]3}, sp}]]

Mean[Mean /@ Flatten[spacingArray, 2]]

Output 254

Distribution of Zero-Nearest Extrema

We could also look in more detail at the distribution of the distances to the nearest zero from the extrema.

nfZerosGolden = Nearest[zerosGolden]

Output 255

Histogram[Abs[# - nfZerosGolden[#][[1]]] & /@ extremasGolden, 1000]

Output 256

Distribution of Areas under the Curve

We can look at the distribution of the (unsigned) areas under a curve between successive zeros.

area[{a_, b_}] = Integrate[fGolden[x], {x, a, b}] 

Output 257

Histogram[Abs[area /@ Partition[zerosGolden, 2, 1]], 500]

Output 258

Zero Distance Distribution for Sums of Four Cosines

We should check if the natural generalizations of the conjectures’ peak positions hold. For instance, here is a sum of four cosine terms that uses the plastic constant.

P = N@Root[-1 - # + #^3 &, 1] // ToRadicals;
fPlastic[x_] = Cos[x] + Cos[P x] + Cos[P^2 x] + Cos[P^3 x];

We again calculate 100k zeros. We also calculate the conjectured peak positions and plot both together. One of the predicted peaks turns out to be an edge; the plastic constant is nongeneric for four cosine terms in the same sense as the golden ratio is for three terms.

zerosPlastic = findZeros[fPlastic, 10^5];

peaksPlastic =
  (2 x /.
     FindRoot[{Cos[x], Cos[P x] , Cos[P^2 x],
        Cos[P^3 x]}.#1, {x, #2}]) & @@@
  {{{1, 1, 1, 1},
    1}, {{-1, 1, 1, 1}, 0.8}, {{1, -1, 1, 1}, 0.8}, {{1, 1, -1, 1},
    1}, {{1, 1, 1, -1}, 1.6}}

Output 259

Histogram[Differences[zerosPlastic], 1000, PlotRange -> All,
 GridLines -> {peaksPlastic, {}}]

Output 260

The peak positions again agree perfectly. Plotting the function near the zeros with the peak distances shows similar envelopes as in the three-term case.

With[{aux =
   Sort@Transpose[{Differences[zerosPlastic], Most[zerosPlastic]}]},
 Function[v,
   Show[Plot[fPlastic[# + t], {t, -2, 0 + 5}, PlotRange -> All,
        PlotStyle ->
         Directive[RGBColor[0.36, 0.51, 0.71], Thickness[0.001],
          Opacity[0.3]]] & /@
      Take[Sort[{Abs[#1 - v], #2} & @@@ aux], 100][[All, 2]],
     PlotLabel ->
      Row[{"x", "\[ThinSpace]\[Equal]\[ThinSpace]", NumberForm[v, 3]}],
     PlotRange -> All, Frame -> True, GridLines -> {{0}, {-2, 4}}] /.

        l_Line :>
     Mouseover[l, {Red, Thickness[0.002], Opacity[1], l}]] /@
  peaksPlastic]

Output 261

Visibility Graphs of the Extrema

A plot of the extrema invites us to make visibility graphs from the extrema. Remember that a visibility graph can be constructed from time series–like data by connecting all points that are “visible” to each other. The following graphic is mostly self-explanatory. We consider the vertical lines from the axis as visibility blockers (rather than the actual function graph). The function visibleQ determines if the point p1 is visible from the point p2 (and vice versa), where “visible” means that no line from the axis to any point between p1 and p2 blocks sight.

visibleQ[{p1_, p2_}] := True
visibleQ[{p1_, middle__, p2_}] :=
 (And @@ (C[{p1, #, p2}] & /@ {middle})) /. C :> tf

tf[{{t1_, v1_}, {s_, u_}, {t2_, v2_}}] :=

 With[{U = v1 + (t1 - s)/(t1 - t2) (v2 - v1)},
  If[u < 0, U > 0 || U < u, U > u || U < 0]]

visibilityEdges[pts_] :=
 Monitor[Table[
    If[visibleQ[Take[pts, {i, j}]], i \[UndirectedEdge] j, {}], {i,
     Length[pts] - 1}, {j, i + 1, Length[pts]}],
   {i, j}] // Flatten

extremasGoldenPoints[n_] := {#, fGolden[#]} & /@
  Take[extremasGolden, n]

With[{pts = {#, fGolden[#]} & /@ Take[extremasGolden, 10]},
 Show[{Plot[fGolden[x], {x, 0, 11},
    PlotStyle -> RGBColor[0.36, 0.51, 0.71]],

   ListPlot[pts, Filling -> Axis,
    FillingStyle -> RGBColor[0.88, 0.61, 0.14]],

   Graphics[{RGBColor[0.36, 0.51, 0.71], PointSize[0.02],
     MapIndexed[{Point[{#, fGolden[#]}],
        Black , Text[ #2[[1]], {#, fGolden[#] + 0.2}]} &,
      Take[ extremasGolden, 10]],
     Gray,
     Line[Map[pts[[#]] &,
       List @@@ visibilityEdges[extremasGoldenPoints[10]], {-1}]]}]}]]

Output 262

Here is a larger graph. The maxima with are responsible for the far-distance edges (e.g. 1–179).

visGr = Graph[
  visibilityEdges[{#, fGolden[#]} & /@ Take[extremasGolden, 200]],
  VertexLabels -> "Name", EdgeLabels -> Placed["Name", Tooltip]]

Output 263

The relevant information is contained in the degree distribution of the visibility graph.

ListLogLogPlot[Tally[VertexDegree[visGr]]]

Output 264

Products of Cosines

In addition to more summands, we could also look at products of cosine functions.

f\[CapitalPi][x_] =
 Cos[x]*Product[If[IntegerQ[Sqrt[k]], 1, Cos[Sqrt[k] x]], {k, 2, 6}]

Output 265

Plot[f\[CapitalPi][x], {x, 0, 20}, PlotRange -> All]

Output 266

cosZeros[\[Alpha]_, n_] :=
 Join[Table[(Pi/2 + 2 \[Pi] k)/\[Alpha], {k, 0, n}],
  Table[(-Pi/2 + 2 \[Pi] k)/\[Alpha], {k, n}]]

zeros\[CapitalPi] = With[{n = 10000}, Sort[N@Flatten[{cosZeros[1, n],

       Table[If[IntegerQ[Sqrt[k]], {}, cosZeros[Sqrt[k], n]], {k, 2,
         6}]}]]];

Histogram3D[
 Partition[Select[Differences[zeros\[CapitalPi]], # < 3 &], 2,
  1], 100]

Output 267

Modulo an increase in the degree of the polynomials involved, such products should also be amenable to the algebraic approach used above for the nonsuccessive zero distances.

Sums of Three Sines

If instead of we had used , the distribution of the zero differences would be much less interesting. (For generic , , there is no substantial difference in the zero-distance distribution between , but , is a nongeneric situation).

Calculating the distribution of spacings gives a mostly uniform distribution. The small visible structures on the right are numerical artifacts, and calculating the zeros with a higher precision makes most of them go away.

fGoldenSin[x_] := Sin[x] + Sin[GoldenRatio x] + Sin[GoldenRatio^2 x]
zerosGoldenSin = findZeros[fGoldenSin, 10^5];
Histogram[Differences[zerosGoldenSin], 1000, PlotRange -> All]

Output 268

Visually, the spacing of + + does not seem to depend on .

ContourPlot[
 Cos[x + \[CurlyPhi]] + Cos[Pi x + \[CurlyPhi]] +
   Cos[Pi^2 x + \[CurlyPhi]] == 0,
                           {x, -4 Pi, 4 Pi}, {\[CurlyPhi], 0, 2 Pi},
 PlotPoints -> 120, AspectRatio -> 1/2,
                            GridLines -> {{}, {Pi/2, Pi, 3/2 Pi}}]

Output 269

Let’s end with the example mentioned in the introduction: + + .

fSqrtSin[x_] := Sin[x] + Sin[Sqrt[2] x] + Sin[Sqrt[3] x]
zerosSqrtSin = findZeros[fSqrtSin, 10^5];

The positions of the peaks are described by the formulas conjectured above.

{peak1, peak2, peak3} =
 {2 x /. Solve[-Cos[x] + Cos[Sqrt[2] x] + Cos[Sqrt[3] x] == 0 \[And]
      0 < x < 1, x][[1]],
  2 x /. Solve[+Cos[x] + Cos[Sqrt[2] x] + Cos[Sqrt[3] x] == 0 \[And]
      1 < x < 4, x][[1]],
  2 x /. Solve[+Cos[x] + Cos[Sqrt[2] x] - Cos[Sqrt[3] x] == 0 \[And]
      1 < x < 2, x][[1]]}

Output 270

Histogram[Differences[zerosSqrtSin], 1000, {"Log", "Count"},
 PlotRange -> All, GridLines -> {{peak1, peak2, peak3}, {}}]

Output 271

We note that one of the roots of is very near one of the observed peaks, but it does not describe the peak position.

peak2Alt =
 x /. Solve[
    Sin[x] + Sin[Sqrt[2] x] + Sin[Sqrt[3] x] == 0 \[And] 1 < x < 4,
    x][[1]]

Output 272

Histogram[Select[Differences[zerosSqrtSin], 2.2 < # < 2.35 &], 200,
 PlotRange -> All,

 GridLines -> {{{peak2, Red}, {peak2Alt, Blue}}, {}}]

Output 273

We will end our graphical/numerical investigation of sums of three cosines for today.

The Density of the Zeros

A natural question is the following: can one find a symbolic representation of the density of the zero distances along the algebraic curve derived above? Based on the calculated zeros, we have the following empirical density along the curve.

sdkc\[Alpha]\[Delta] =
 SmoothKernelDistribution[{Cos[GoldenRatio #], #2 - #1} & @@@
                             Take[Partition[zerosGolden, 2, 1], All],
  0.03, PerformanceGoal -> "Quality"]

Output 274

Plot3D[PDF[
  sdkc\[Alpha]\[Delta], {c\[Alpha], \[Delta]}], {c\[Alpha], -1.1,
  1.1}, {\[Delta], 0, 4}, PlotRange -> All, Exclusions -> {},
 PlotPoints -> 120, MeshFunctions -> {#3 &},
 AxesLabel -> {c\[Alpha], \[Delta]}]

Output 275

Quantitative Classification of the Curve Shapes around the Zeros

How can the behavior of a concrete sum of three cosines be classified around their zeros?

For the sums for which an algebraic relation between the three cosine terms exists, the zeros form curves in the plane. Along these curves, the shape of the function around their zeros changes smoothly. And at the self-intersection of the curve, shapes “split.” The next graphic plots the zeros for the above example . Mouse over the points to see shifted versions of near the zero under consideration.

nfc\[Alpha]\[Delta]Brass =
  Nearest[c\[Alpha]\[Delta]ListBrass = ({Cos[\[Phi]Brass #], #2 - #1} \
-> #1) & @@@
     Take[Partition[zerosBrass, 2, 1], All]];

makeZeroPlotBrass[{c\[Alpha]_, \[Delta]_}] :=
 Module[{pts =
    nfc\[Alpha]\[Delta]Brass[{c\[Alpha], \[Delta]}, {All, 0.01}]},
  Plot[Evaluate[(Cos[# + x] + Cos[\[Phi]Brass (# + x)] +
        Cos[\[Phi]Brass^2 (# + x)]) & /@ 

     RandomSample[pts, UpTo[10]]], {x, -4, 4}]]

Graphics[{PointSize[0.002],
   Point[First[#]] & /@
    RandomSample[c\[Alpha]\[Delta]ListBrass, 25000]}, Frame -> True,
  PlotRange -> {{-1, 1}, {0, 2.6}}] /.
 Point[l_] :> (Tooltip[Point[ l], Dynamic[makeZeroPlotBrass[l]]] )

Output 276

For generic , with no algebraic relation between them, the zeros do not form curves in the plane. One could display the zeros in space where they form a surface (see the above example of the function ). Even after projection into the plane. While this gives point clouds, it is still instructive to see the possible curve shapes.

zerosSqrt23 = findZeros[fSqrt, 100000];

nfc\[Alpha]\[Delta]Sqrt23 =
  Nearest[c\[Alpha]\[Delta]ListSqrt23 = ({Cos[
          Sqrt[2] #], #2 - #1} -> #1) & @@@
     Take[Partition[zerosSqrt23, 2, 1], All]];

makeZeroPlotSqrt23[{c\[Alpha]_, \[Delta]_}] :=
 Module[{pts =
    nfc\[Alpha]\[Delta]Sqrt23[{c\[Alpha], \[Delta]}, {All, 0.01}]},
  Plot[Evaluate[
    fSqrt[# + x] & /@ RandomSample[pts, UpTo[10]]], {x, -4, 4}]]

Graphics[{PointSize[0.002],
   Point[First[#]] & /@
    RandomSample[c\[Alpha]\[Delta]ListSqrt23, 25000]}, Frame -> True,
  PlotRange -> {{-1, 1}, {0, 5}}, AspectRatio -> 2] /.
 Point[l_] :> (Tooltip[Point[ l], Dynamic[makeZeroPlotSqrt23[l]]] )

Output 277

Appendix: Modeling the Power Law near the Peaks

Above, based on the observed distribution of the distances between consecutive zeros, a power-law like decay of the distribution was conjectured. In this appendix, we will give some numerical evidence for the power law based on the envelope that defines the smallest zero.

We remind ourselves that we are interested in the smallest zero of + + subject to the constraints , .

Before modeling the power law, let us have a closer look at the data, especially the minima with function values approximately equal to –1 and slope 0 and the following zero. We use the list zerosAndExtremaGolden from above to find such pairs.

minimaAtMinus1 =
  Select[Cases[
    Partition[zerosAndExtremaGolden, 2,
     1], {{_, "extrema"}, {_, "zero"}}],
                 (Abs[fGolden[#[[1, 1]]] + 1] < 0.02 \[And]
      Abs[fGolden'[#[[1, 1]]]] < 0.02) &];

These minima split visibly into two groups.

Show[Plot[Evaluate[fGolden[# + t]], {t, -1, 3},
    PlotStyle ->
     Directive[Thickness[0.001], RGBColor[0.36, 0.51, 0.71]]] & /@
  RandomSample[minimaAtMinus1, 100][[All, 1, 1]], PlotRange -> 1 All]

Output 278

We select the zeros smaller than 0.6.

minimaAtMinus1B =
  Select[minimaAtMinus1, #[[2, 1]] - #[[1, 1]] < 0.6 &];

minimumAndZeroDistances = {#[[1, 1]], #[[2, 1]] - #[[1, 1]]} & /@
   minimaAtMinus1B;

At the minimum , we can locally write + +, which defines three phases , and in = + + .

\[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples = ({Mod[-#1, 2 Pi],
       Mod[-GoldenRatio #, 1 2 Pi],
       Mod[-GoldenRatio^2 #1, 2 Pi], #2} & @@@
     minimumAndZeroDistances) /. x_?(# > 5 &) :> (2 Pi - x);

Plotting and shows an approximate linear relationship.

ListPlot[{{#1, #2} & @@@ \[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples, \
{#1, #3} & @@@ \[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples},

 PlotLegends -> {Subscript["\[CurlyPhi]", 2],
   Subscript["\[CurlyPhi]", 3]},
                     AxesLabel -> {Subscript["\[CurlyPhi]", 1]}]

Output 279

Here are the triples observed in space.

Graphics3D[{RGBColor[0.99, 0.81, 0.495],
  Sphere[#1, 0.0001 #2] & @@@
   Tally[Round[{#1, #2, #3} & @@@ \
\[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples, 0.01]]},
 PlotRange -> All, Axes -> True,
 AxesLabel -> {Subscript["\[CurlyPhi]", 1],
   Subscript["\[CurlyPhi]", 2], Subscript["\[CurlyPhi]", 3]}]

Output 280

As a function of the position of the first zero after , where is the smallest root of , we obtain the following graphic. Because near we expect the relative phases to be , and , we display , and .

ListPlot[{{#4, #1} & @@@ \[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples, \
{#4, #2 -
      Pi} & @@@ \[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples, {#4, #3 -
       Pi} & @@@ \[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples},

 PlotLegends -> {Subscript["\[CurlyPhi]", 1],
   Subscript["\[CurlyPhi]", 2], Subscript["\[CurlyPhi]", 3]},
                      AxesLabel -> {Style["z", Italic]}]

Output 281

The distribution of the observed phases near the minima with function value –1 are all approximately uniform. (We will use this fact below to model the power law decay.)

Histogram[#1, 50, PlotLabel -> Subscript["\[CurlyPhi]", #2]] & @@@
 Transpose[{Take[
    Transpose[\[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3Triples], 3], {1, 2,
     3}}]

Output 282

Now let us compare this observed phase distribution with all mathematically possible solutions from the envelope conditions.

\[CurlyPhi]1\[CurlyPhi]2Of\[CurlyPhi]3Solution =
  Solve[{Cos[\[CurlyPhi]1] + Cos[\[CurlyPhi]2] +
      Cos[\[CurlyPhi]3] == -1,
                                         -Sin[\[CurlyPhi]1] -
      GoldenRatio Sin[\[CurlyPhi]2] -
      GoldenRatio^2 Sin[\[CurlyPhi]3] ==
     0}, {\[CurlyPhi]1, \[CurlyPhi]2}];

\[CurlyPhi]1\[CurlyPhi]2Of\[CurlyPhi]3CF =
 Compile[{{\[CurlyPhi]3, _Complex}},
  Evaluate[{\[CurlyPhi]1, \[CurlyPhi]2} /. \[CurlyPhi]1\[CurlyPhi]2Of\
\[CurlyPhi]3Solution /.
     ConditionalExpression[\[Zeta]_, _] :> \[Zeta] /. _C :> 0]]

Output 283

\[CurlyPhi]1\[CurlyPhi]2Of\[CurlyPhi]3[\[CurlyPhi]3_Real] :=
 Append[#, \[CurlyPhi]3] & /@
  Cases[Chop[\[CurlyPhi]1\[CurlyPhi]2Of\[CurlyPhi]3CF[\[CurlyPhi]3]], \
{_Real, _Real}]

For a given value of , we either have no, two or four solutions for . The following interactive demonstration allows us to explore the solutions as a function of . We see the two types of solutions represented by the list minimaAtMinus1 above.

Manipulate[
 With[{phases = \
\[CurlyPhi]1\[CurlyPhi]2Of\[CurlyPhi]3[\[CurlyPhi]3]},
   Plot[Evaluate[(Cos[x + #[[1]]] + Cos[GoldenRatio x + #[[2]]] +
         Cos[GoldenRatio^2 x + #[[3]]]) & /@ phases], {x, -1, 3},
    PlotLegends ->
     Placed[({Subscript["\[CurlyPhi]", 1],
           Subscript["\[CurlyPhi]", 2], Subscript["\[CurlyPhi]", 3]} ==
          NumberForm[#, 3] & /@ phases), Below]]] // Quiet,
 {{\[CurlyPhi]3, Pi + 0.2, Subscript["\[CurlyPhi]", 3]}, 0, 2 Pi,
  Appearance -> "Labeled"},
 TrackedSymbols :> True]

Output 284

Here are the possible phases that are compatible with the envelope conditions as a function of , the position of the first zero.

\[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3zList =
  Table[{#,
      x /. Quiet[
        Solve[gGolden[x, #] == 0 \[And] 0.4 < x < 0.6,
         x]]} & /@ \
\[CurlyPhi]1\[CurlyPhi]2Of\[CurlyPhi]3[\[CurlyPhi]3], {\[CurlyPhi]3,
    Pi - 0.5, Pi + 0.5, 1/1001}];

\[Pi]ize[x_] := If[x < -Pi/2, 2 Pi + x, x];
\[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3zListB = {\[Pi]ize /@ #1, #2} & @@@
   Cases[Flatten[\[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3zList,
     1], {_, {_Real}}];

ListPlot[{{#2[[1]], #1[[1]] -
      0} & @@@ \[CurlyPhi]1\[CurlyPhi]2\[CurlyPhi]3zListB,
                    {#2[[1]], #1[[2]] -
      Pi} & @@@ \[CurlyPhi]1\[Curl


Download this post as a Wolfram Notebook or as a Computable Document Format (CDF) file. New to CDF? Get your copy for free with this one-time download.

]]>
http://blog.wolfram.com/2018/04/24/a-tale-of-three-cosines-an-experimental-mathematics-adventure/feed/ 5
Five Ways to Make Your Technical Presentations Awesome http://blog.wolfram.com/2018/04/19/five-ways-to-make-your-technical-presentations-awesome/ http://blog.wolfram.com/2018/04/19/five-ways-to-make-your-technical-presentations-awesome/#comments Thu, 19 Apr 2018 17:00:39 +0000 Joanna Crown http://blog.internal.wolfram.com/?p=43175 #post-43175 h2 { margin: 2px 0 0 0; font-size: 22px; padding: 12px 0 6px; display: block; float: none; } #post-43175 h3 { color: #333; margin: 5px 0 10px; font-size: 18px; } #post-43175 blockquote { padding: 10px 25px; font-family: Georgia; font-style: italic; font-size: 130%; line-height: 1.4; color: #e26a0f; margin: 0 0 8px; border-top: 1px solid #c3c3c3; border-bottom: 1px solid #c3c3c3; } #post-43175 blockquote p { margin: 0; padding: 0; }

“Tell me and I forget. Teach me and I remember. Involve me and I learn.” — Benjamin Franklin

I can count on one hand the best presentations I have ever experienced, the most recent being my university dynamics lecturer bringing out his electric guitar at the end of term to demonstrate sound waves; a pharmaceutical CEO giving an impassioned after-dinner oration about how his love of music influenced his business decisions; and last but not least, my award-winning attempt at explaining quantum entanglement using a marble run and a cardboard box (I won a bottle of wine).

It’s perhaps equally easy to recall all the worst presentations I’ve experienced as well—for example, too many PowerPoint presentations crammed full of more bullet points than a shooting target; infinitesimally small text that only Superman’s telescopic vision could handle; presenters intent on slowly reading every word that they’ve squeezed onto a screen and thoroughly missing the point of a presentation: that of succinctly communicating interesting ideas to an audience.

It is no secret that when it comes to presentations, less is definitely more. A picture may be worth a thousand words, a meme worth a thousand likes, but as much as a technical presenter wants to fill a presentation full of cute pictures, the key point is to communicate their results, findings, explorations, experiments and data in a clear, succinct and beautiful way.

As someone who uses Wolfram Notebooks for everything from a notepad to a word processing document, a coding scratchpad and as a complete computational narrative, I am so excited that it is now possible to present live, interactive technical presentations directly from notebooks.

So What Is Presenter Tools?

As announced this week, Wolfram Presenter Tools is the first responsive technical presentation platform incorporating dynamic interactivity and live computation into the environment.

Presenter Tools features 

What Does This Mean?

You can now change your parameters on the fly, use interactive manipulates to cleanly demonstrate complex ideas, pull real-time data from live feeds and use multimedia to include your audience in your presentation.

This comes with everything you’d expect from a presentation environment: live-time presenter notes and navigation controls, a comprehensive quick-editing toolbar, the ability to position your text, images and interactives within your slides and auto-resizing to any resolution or screen size.

But the Best Part…?

Creating presentations can be automatic from your existing notebooks. You can use the work you’ve already done, the notebooks you’ve already written, the results you’ve already generated, the functions and manipulates already in your reports, and present them immediately. This is the prime-time, go-to technical presenting tool. Take your technical work and present it now.

So How Does This Help Me?

Could Presenter Tools be the electric guitar of your presentation? Of course it can. Let’s revisit Benjamin Franklin:

  • You can tell someone what a static chart of your data means—and they’ll forget.
  • You can teach someone how your data produced the results you concluded—and they may remember.
  • Or you can involve someone in your presentation and let them directly interact with your results.

Therein lies the key to unforgettable, impressive and interactive presentations.

Here Are My Go-To Top Five Presentation Tips…

1) Keep it simple

“If you can’t explain it simply, you don’t understand it well enough.” — Feynstein

Whether it was Albert Einstein or Richard Feynman who said it (there is a fair amount of debate), the sentiment holds true. If you are the expert, it’s very likely that your audience doesn’t have the same grasp of the material that you do. If you’ve been working on your findings for days, weeks, months, bring people on that journey with you and keep it light.

Using cell hierarchies, keep your titles and subsections distinct. Distill your thoughts into clear sections and hide the bits that go on a tangent!

2) Keep it short

“Make sure you have finished speaking before your audience has finished listening.” — Dorothy Sarnoff

We’ve all been on the other side of those presentations that go on and on. Don’t be that person. Make your case clearly and quickly.

Use direct, interactive plots to get your results across, no image duplication required. Demonstrate to them exactly how your data behaves—don’t snapshot it.

3) Keep it on point

“If you can’t state your position in eight words, you don’t have a position.” — Seth Godin

Decide what you want to get across to your audience. What are your top three points? What is your takeaway message?

Going to forget something important? Keep presenter notes on the side to keep you on track.

4) Practice

“All the great speakers were bad speakers at first.” — Ralph Waldo Emerson

The more you’re prepared, the calmer you’ll be and the better you’ll communicate your points. Choose your best examples and talk them through. Find out what works and what doesn’t: iterate, evaluate.

With livecoding, you can make up coding examples on the go. Or if you’d like things to be “safer,” keep tried and trusted examples in your presenter notes palette on the side to insert and evaluate during your talk. It’ll appear spontaneous, but you have the dependable certainty that it’ll run.

5) Be you!

“I didn’t lie. I was writing fiction in my mouth.” — Homer Simpson

If you want to make your mark, be distinctive. If you want to be the person who has a picture of a sheep on each slide, do it. If you want rainbow colors, do it. When you feel comfortable and confident presenting, you’ll be a better presenter. Let your voice come across and people will remember you and your work.

With customizable themes, Presenter Tools allows you to choose the fonts and colors that you want to use, and automatically updates cell styles accordingly. Add images to your heart’s content, and make your presentations your own!

]]>
http://blog.wolfram.com/2018/04/19/five-ways-to-make-your-technical-presentations-awesome/feed/ 3
Announcing Wolfram Presenter Tools http://blog.wolfram.com/2018/04/17/announcing-wolfram-presenter-tools/ http://blog.wolfram.com/2018/04/17/announcing-wolfram-presenter-tools/#comments Tue, 17 Apr 2018 14:01:32 +0000 Cat Frazier http://blog.internal.wolfram.com/?p=43173 Introducing the Ultimate Technical Presentation Environment with Live Interactivity

We are delighted to announce that Wolfram’s latest comprehensive notebook technology extension is here. Released with Version 11.3 of Wolfram desktop products, Wolfram Presenter Tools is the world’s first fully computational presentation environment, seamlessly extending the notebook workflow for easy creation and delivery of dynamic presentations and slide shows, automatically scaled to fit any screen size. Our unique presentation features include rapid stylesheet updating and automatic slide breaking based on cell style.

Working from your existing notebooks or using templated guides, it is now possible to easily create impressive, interactive and beautiful presentations—harnessing the power of the Wolfram Language with interactive manipulates, real-time data and livecoding. Together with publication-quality technical typesetting, coherent design templates and configurable presentation controls, Presenter Tools’ range of customizable themes makes presentations eye-catching and unique to you.

Presenter Tools features 

What Is Involved?

One of Presenter Tools’ key elements is the new quick-editing toolbar, providing authoring style options, slide show controls and fine layout-adjustment tools in one convenient interface. Our new screen environments, for viewing the same notebook in a variety of different presentation modes, include scrolling edit mode, slide edit mode and both slide and continuous presentation environments. In fact, your presentations will now take advantage of all the superior features of the computational notebook. Easily see and manage your manual and automatic slide breaks, and use the hierarchical cell structure of Wolfram Notebooks to arrange your text, output, images and code in an easily digestible format.

Another important feature of Presenter Tools customizes cell styles throughout an entire presentation to make stylesheet changes easy. Update colors, fonts, alignment, spacing and sizing for any given cell style right from the toolbar.

We have added user-friendly controls to make your presentation experience as smooth as possible. From configurable keyboard commands for slide navigation to writing side notes and auto-inserting code cells, we have designed the full toolkit for keeping a computable presentation on point. Remind yourself of your favorite anecdotes and metapoints, or keep ready-to-use livecoding examples for impressive and reliable demonstrations.

Explore these key features and learn more about Wolfram Presenter Tools »

]]>
http://blog.wolfram.com/2018/04/17/announcing-wolfram-presenter-tools/feed/ 7
Launching the Wolfram Challenges Site http://blog.wolfram.com/2018/04/12/launching-the-wolfram-challenges-site/ http://blog.wolfram.com/2018/04/12/launching-the-wolfram-challenges-site/#comments Thu, 12 Apr 2018 16:01:07 +0000 Stephen Wolfram http://blog.internal.wolfram.com/?p=43986 Wolfram Challenges

The more one does computational thinking, the better one gets at it. And today we’re launching the Wolfram Challenges site to give everyone a source of bite-sized computational thinking challenges based on the Wolfram Language. Use them to learn. Use them to stay sharp. Use them to prove how great you are.

The Challenges typically have the form: “Write a function to do X”. But because we’re using the Wolfram Language—with all its built-in computational intelligence—it’s easy to make the X be remarkably sophisticated.

The site has a range of levels of Challenges. Some are good for beginners, while others will require serious effort even for experienced programmers and computational thinkers. Typically each Challenge has at least some known solution that’s at most a few lines of Wolfram Language code. But what are those lines of code?

There may be many different approaches to a particular Challenge, leading to very different kinds of code. Sometimes the code will be smaller, sometimes it will run faster, and so on. And for each Challenge, the site maintains a leaderboard that shows who’s got the smallest, the fastest, etc. solution so far.

What does it take to be able to tackle Challenges on the site? If you’ve read my An Elementary Introduction to the Wolfram Language, for example, you should be well prepared—maybe with some additional help on occasion from the main Wolfram Language documentation. But even if you’re more of a beginner, you should still be able to do simpler Challenges, perhaps looking at parts of my book when you need to. (If you’re an experienced programmer, a good way to jump-start yourself is to look at the Fast Introduction for Programmers.)

How It Works

There are lots of different kinds of Challenges on the site. Each Challenge is tagged with topic areas. And on the front page there are a number of “tracks” that you can use as guides to sequences of related Challenges. Here are the current Challenges in the Real-World Data track:

Real-World Data Challenges

Click one you want to try—and you’ll get a webpage that explains the Challenge:

Antipode above or below Sea Level Challenge

Now you can choose either to download the Challenge notebook to the desktop, or just open it directly in your web browser in the Wolfram Cloud. (It’s free to use the Wolfram Cloud for this, though you’ll have to have a login—otherwise the system won’t be able to give you credit for the Challenges you’ve solved.)

Here’s the cloud version of this particular notebook:

Challenge cloud notebook

You can build up your solution in the Scratch Area, and try it out there. Then when you’re ready, put your code where it says “Enter your code here”. Then press Submit.

What Submit does is to send your solution to the Wolfram Cloud—where it’ll be tested to see if it’s correct. If it’s not correct, you’ll get something like this:

Error code

But if it’s correct, you’ll get this, and you’ll be able to go to the leaderboard and see how your solution compared to other people’s. You can submit the same Challenge as many times as you want. (By the way, you can pick your name and icon for the leaderboard from the Profile tab.)

Challenges leaderboard

The Range of Challenges

The range of Challenges on the site is broad both in terms of difficulty level and topic. (And, by the way, we’re planning to progressively grow the site, not least through material from outside contributors.)

Here’s an example of a simple Challenge, that for example I can personally solve in a few seconds:

Butterflied Strings Challenge

Here’s a significantly more complicated Challenge, that took me a solid 15 minutes to solve at all well:

Babbage Squares Challenge

Some of the Challenges are in a sense “pure algorithm challenges” that don’t depend on any outside data:

Maximal Contiguous Sum Challenge

Some of the Challenges are “real-world”, and make use of the Wolfram Knowledgebase:

Country Chains Challenge

And some of the Challenges are “math-y”, and make use of the math capabilities of the Wolfram Language:

Factorial Zeros Challenge

Count the Number of Squares Challenge

Pre-launch Experience

We’ve been planning to launch a site like Wolfram Challenges for years, but it’s only now, with the current state of the Wolfram Cloud, that we’ve been able to set it up as we have today—so that anyone can just open a web browser and start solving Challenges.

Still, we’ve had unannounced preliminary versions for about three years now—complete with a steadily growing number of Challenges. And in fact, a total of 270 people have discovered the preliminary version—and produced in all no less than 11,400 solutions. Some people have solved the same Challenge many times, coming up with progressively shorter or progressively faster solutions. Others have moved on to different Challenges.

It’s interesting to see how diverse the solutions to even a single Challenge can be. Here are word clouds of the functions used in solutions to three different Challenges:

Functions used in Wolfram Challenges

And when it comes to lengths of solutions (here in characters of code), there can be quite a variation for a particular Challenge:

Length of solutions in Wolfram Challenges

Here’s the distribution of solution lengths for all solutions submitted during the pre-launch period, for all Challenges:

Solution lengths for submitted solutions

It’s not clear what kind of distribution this is (though it seems close to lognormal). But what’s really nice is how concentrated it is on solutions that aren’t much more than a line long. (81% of them would even fit in a 280-character tweet!)

And in fact what we’re seeing can be viewed as a great tribute to the Wolfram Language. In any other programming language most Challenges—if one could do them at all—would take pages of code. But in the Wolfram Language even sophisticated Challenges can often be solved with just tweet-length amounts of code.

Why is this? Well, basically it’s because the Wolfram Language is a different kind of language: it’s a knowledge-based language where lots of knowledge about computation and other things is built right into the language (thanks to 30+ years of hard work on our part).

But then are the Challenges still “real”? Of course! It’s just that the Wolfram Language lets one operate at a higher level. One doesn’t have to worry about writing out the low-level mechanics of how even sophisticated operations get implemented—one can just concentrate on the pure high-level computational thinking of how to get the Challenge done.

Under the Hood

OK, so what have been some of the challenges in setting up the Wolfram Challenges site? Probably the most important is how to check whether a particular solution is correct. After all, we’re not just asking to compute some single result (say, 42) that we can readily compare with. We’re asking to create a function that can take a perhaps infinite set of possible arguments, and in each case give the correct result.

So how can we know if the function is correct? In some simple cases, we can actually see if the code of the function can be transformed in a meaning-preserving way into code that we already know is correct. But most of the time—like in most practical software quality assurance—the best thing to do is just to try test cases. Some will be deterministically chosen—say based on checking simple or corner cases. Others can be probabilistically generated.

But in the end, if we find that the function isn’t correct, we want to give the user a simple case that demonstrates this. Often in practice we may first see failure in some fairly complicated case—but then the system tries to simplify the failure as much as possible.

OK, so another issue is: how does one tell whether a particular value of a function is correct? If the value is just something like an integer (say, 343) or a string (say, “hi”), then it’s easy. But what if it’s an approximate number (say, 3.141592…)? Well, then we have to start worrying about numerical precision. And what if it’s a mathematical expression (say, 1 + 1/x)? What transformations should we allow on the expression?

There are many other cases too. If it’s a network, we’ll probably want to say it’s correct if it’s isomorphic to what we expect (i.e. the same up to relabeling nodes). If it’s a graphic, we’ll probably want to say it’s correct if it visually looks the same as we expected, or at least is close enough. And if we’re dealing with real-world data, then we have to make sure to recompute our expected result, to take account of data in our knowledgebase that’s changed because of changes out there in the real world.

Alright, so let’s say we’ve concluded that a particular function is correct. Well now, to fill in the leaderboard, we have to make some measurements on it. First, how long is the code?

We can just format the code in InputForm, then count characters. That gives us one measure. One can also apply ByteCount to just count bytes in the definition of the function. Or we can apply LeafCount, to count the number of leaves in the expression tree for the definition. The leaderboard separately tracks the values for all these measures of “code size”.

OK, so how about the speed of the code? Well, that’s a bit tricky. First because speed isn’t something abstract like “total number of operations on a Turing machine”—it’s actual speed running a computer. And so it has be normalized for the speed of the computer hardware. Then it has to somehow discard idiosyncrasies (say associated with caching) seen in particular test runs, as achieved by RepeatedTiming. Oh, and even more basically, it has to decide which instances of the function to test, and how to average them. (And it has to make sure that it won’t waste too much time chasing an incredibly slow solution.)

Well, to actually do all these things, one has to make a whole sequence of specific decisions. And in the end what we’ve done is to package everything up into a single “speed score” that we report in the leaderboard.

A final metric in the leaderboard is “memory efficiency”. Like “speed score”, this is derived in a somewhat complicated way from actual test runs of the function. But the point is that within narrow margins, the results should be repeatable between identical solutions. (And, yes, the speed and memory leaderboards might change when they’re run in a new version of the Wolfram Language, with different optimizations.)

Backstory

We first started testing what’s now the Wolfram Challenges site at the Wolfram Summer School in 2016—and it was rapidly clear that many people found the kinds of Challenges we’d developed quite engaging. At first we weren’t sure how long—and perhaps whimsical—to make the Challenges. We experimented with having whole “stories” in each Challenge (like some math competitions and things like Project Euler do). But pretty soon we decided to restrict Challenges to be fairly short to state—albeit sometimes giving them slightly whimsical names.

We tested our Challenges again at the 2017 Wolfram Summer School, as well as at the Wolfram High School Summer Camp—and we discovered that the Challenges were addictive enough that some people systematically went through trying to solve all of them.

We were initially not sure what forms of Challenges to allow. But after a while we made the choice to (at least initially) concentrate on “write a function to do X”, rather than, for example, just “compute X”. Our basic reason was that we wanted the solutions to the Challenges to be more open-ended.

If the challenge is “compute X”, then there’s typically just one final answer, and once you have it, you have it. But with “write a function to do X”, there’s always a different function to write—that might be faster, smaller, or just different. At a practical level, with “compute X” it’s easier to “spoil the fun” by having answers posted on the web. With “write a function”, yes, there could be one version of code for a function posted somewhere, but there’ll always be other versions to write—and if you always submit versions that have been seen before it’ll soon be pretty clear you have to have just copied them from somewhere.

As it turns out, we’ve actually had quite a bit of experience with the “compute X” format. Because in my book An Elementary Introduction to the Wolfram Language all 655 exercises are basically of the form “write code to compute X”. And in the online version of the book, all these exercises are automatically graded.

Automatic grading

Now, if we were just doing “cheap” automatic grading, we’d simply look to see if the code produces the correct result when it runs. But that doesn’t actually check the code. After all, if the answer was supposed to be 42, someone could just give 42 (or maybe 41 + 1) as the “code”.

Our actual automatic grading system is much more sophisticated. It certainly looks at what comes out when the code runs (being careful not to blindly evaluate Quit in a piece of code—and taking account of things like random numbers or graphics or numerical precision). But the real meat of the system is the analysis of the code itself, and the things that happen when it runs.

Because the Wolfram Language is symbolic, “code” is the same kind of thing as “data”. And the automatic grading system makes extensive use of this—not least in applying sequences of symbolic code transformations to determine whether a particular piece of code that’s been entered is equivalent to one that’s known to represent an appropriate solution. (The system has ways to handle “completely novel” code structures too.)

Code equivalence is a difficult (in fact, in general, undecidable) problem. A slightly easier problem (though still in general undecidable) is equivalence of mathematical expressions. And a place where we’ve used this kind of equivalence extensively is in our Wolfram Problem Generator:

Of course, exactly what equivalence we want to allow may depend on the kind of problem we’re generating. Usually we’ll want 1 + x and x + 1 to be considered equivalent. But (1 + x)/x might or might not want to be considered equivalent to 1 + 1/x. It’s not easy to get these things right (and many online grading systems do horribly at it). But by using some of the sophisticated math and symbolic transformation capabilities available in the Wolfram Language, we’ve managed to make this work well in Wolfram Problem Generator.

Contribute New Challenges!

The Wolfram Challenges site as it exists today is only the beginning. We intend it to grow. And the best way for it to grow—like our long-running Wolfram Demonstrations Project—is for people to contribute great new Challenges for us to include.

At the bottom of the Wolfram Challenges home page you can download the Challenges Authoring Notebook:

Challenges Authoring Notebook

Fill this out, press “Submit Challenge”—and off this will go to us for review.

Beyond Challenges

I’m not surprised that Wolfram Challenges seem to appeal to people who like solving math puzzles, crosswords, brain teasers, sudoku and the like. I’m also not surprised that they appeal to people who like gaming and coding competitions. But personally—for better or worse—I don’t happen to fit into any of these categories. And in fact when we were first considering creating Wolfram Challenges I said “yes, lots of people will like it, but I won’t be one of them”.

Well, I have to say I was wrong about myself. Because actually I really like doing these Challenges—and I’m finding I have to avoid getting started on them because I’ll just keep doing them (and, yes, I’m a finisher, so there’s a risk I could just keep going until I’ve done them all, which would be a very serious investment of time).

So what’s different about these Challenges? I think the answer for me is that they feel much more real. Yes, they’ve been made up to be Challenges. But the kind of thinking that’s needed to solve them is essentially just the same as the kind of thinking I end up doing all the time in “real settings”. So when I work on these Challenges, I don’t feel like I’m “just doing something recreational”; I feel like I’m honing my skills for real things.

Now I readily recognize that not everyone’s motivation structure is the same—and many people will like doing these Challenges as true recreations. But I think it’s great that Challenges can also help build real skills. And of course, if one sees that someone has done lots of these Challenges, it shows that they have some real skills. (And, yes, we’re starting to use Challenges as a way to assess applicants, say, for our summer programs.)

It’s worth saying there are some other nice “potentially recreational” uses of the Wolfram Language too.

One example is competitive livecoding. The Wolfram Language is basically unique in being a language in which interesting programs can be written fast enough that it’s fun to watch. Over the years, I’ve done large amounts of (non-competitive) livecoding—both in person and livestreamed. But in the past couple of years we’ve been developing the notion of competitive livecoding as a kind of new sport.

Wolfram Technology Conference

We’ve done some trial runs at our Wolfram Technology Conference—and we’re working towards having robust rules and procedures. In what we’ve done so far, the typical challenges have been of the “compute X” form—and people have taken between a few seconds and perhaps ten minutes to complete them. We’ve used what’s now our Wolfram Chat functionality to distribute Challenges and let contestants submit solutions. And we’ve used automated testing methods—together with human “refereeing”—to judge the competitions.

A different kind of recreational application of the Wolfram Language is our Tweet-a-Program service, released in 2014. The idea here is to write Wolfram Language programs that are short enough to fit in a tweet (and when we launched Tweet-a-Program that meant just 128 characters)—and to make them produce output that is as interesting as possible:

Tweet-a-Program output

We’ve also had a live analog of this at our Wolfram Technology Conference for some time: our annual One-Liner Competition. And I have to say that even though I (presumably) know the Wolfram Language well, I’m always amazed at what people actually manage to do with just a single line of Wolfram Language code.

At our most recent Wolfram Technology Conference, in recognition of our advances in machine learning, we decided to also do a “Machine-Learning Art Competition”—to make the most interesting possible restyled “Wolfie”:

Wolfie submissions

In the future, we’re planning to do machine learning challenges as part of Wolfram Challenges too. In fact, there are several categories of Challenges we expect to add. We’ve already got Challenges that make use of the Wolfram Knowledgebase, and the built-in data it contains. But we’re also planning to add Challenges that use external data from the Wolfram Data Repository. And we want to add Challenges that involve creating things like neural networks.

There’s a new issue that arises here—and that’s actually associated with a large category of possible Challenges. Because with most uses of things like neural networks, one no longer expects to produce a function that definitively “gets the right answer”. Instead, one just wants a function that does the best possible job on a particular task.

There are plenty of examples of Challenges one can imagine that involve finding “the lowest-cost solution”, or the “best fit”. And it’s a similar setup with typical machine learning tasks: find a function (say based on a neural network) that performs best on classifying a certain test set, etc.

And, yes, the basic structure of Wolfram Challenges is well set up to handle a situation like this. It’s just that instead of it definitively telling you that you’ve got a correct solution for a particular Challenge, it’ll just tell you how your solution ranks relative to others on the leaderboard.

The Challenges in the Wolfram Challenges site always have very well-defined end goals. But one of the great things about the Wolfram Language is how easy it is to use it to explore and create in an open-ended way. But as a kind of analog of Challenges one can always give seeds for this. One example is the Go Further sections of the Explorations in Wolfram Programming Lab. And other examples are the many kinds of project suggestions we make for things like our summer programs.

What is the right output for an open-ended exploration? I think a good answer in many cases is a computational essay, written in a Wolfram Notebook, and “telling a story” with a mixture of ordinary text and Wolfram Language code. Of course, unlike Challenges, where one’s doing something that’s intended to be checked and analyzed by machine, computational essays are fundamentally about communicating with humans—and don’t have right or wrong “answers”.

The Path Forward

One of my overarching goals in creating the Wolfram Language has been to bring computational knowledge and computational thinking to as many people as possible. And the launch of the Wolfram Challenges site is the latest step in the long journey of doing this.

It’s a great way to engage with programming and computational thinking. And it’s set up to always let you know how you’re getting on. Did you solve that Challenge? How did you do relative to other people who’ve also solved the Challenge?

I’m looking forward to seeing just how small and efficient people can make the solutions to these Challenges. (And, yes, large numbers of equivalent solutions provide great raw material for doing machine learning on program transformations and optimization.)

Who will be the leaders on the leaderboards of Wolfram Challenges? I think it’ll be a wide range of people—with different backgrounds and education. Some will be young; some will be old. Some will be from the most tech-rich parts of the world; some, I hope, will be from tech-poor areas. Some will already be energetic contributors to the Wolfram Language community; others, I hope, will come to the Wolfram Language through Challenges—and perhaps even be “discovered” as talented programmers and computational thinkers this way.

But most of all, I hope lots of people get lots of enjoyment and fulfillment out of Wolfram Challenges—and get a chance to experience that thrill that comes with figuring out a particularly clever and powerful solution that you can then see run on your computer.

]]>
http://blog.wolfram.com/2018/04/12/launching-the-wolfram-challenges-site/feed/ 0
European Wolfram Technology Conference 2018 http://blog.wolfram.com/2018/04/12/european-wolfram-technology-conference/ http://blog.wolfram.com/2018/04/12/european-wolfram-technology-conference/#comments Thu, 12 Apr 2018 13:43:44 +0000 Sandra Sarac http://blog.internal.wolfram.com/?p=43179

This year, we’ll be in Oxford for the European Wolfram Technology Conference. Join us June 14–15 for two days of expert talks showcasing the latest releases in Wolfram technologies, in-depth explorations of key features and practical use cases for integrating Wolfram technologies in your ecosystem.

Catering to both new and existing users, the conference provides an overview of the entire Wolfram technology stack while also exploring some of our new products and features; you will also learn about the field of multiparadigm data science, the new approach of using modern analytical techniques, automation and human-data interfaces to move the bar on answers.

Session highlights will include keynotes from Conrad Wolfram, Tom Wickham-Jones and a range of Wolfram experts and users from around the world, giving you the inside track on the future direction of computational technology.

Key topics will include:

  • Machine learning and neural networks
  • Enterprise computation strategies
  • Deployment in the Wolfram Cloud
  • Signal and image processing

With a conference dinner rounding out the first day, this is a great opportunity for attendees to not only meet those who develop Wolfram technologies but also connect with our thriving community of like-minded users.

To join us in Oxford, register now.

]]>
http://blog.wolfram.com/2018/04/12/european-wolfram-technology-conference/feed/ 1
Unleash Your Models with SystemModeler 5.1 http://blog.wolfram.com/2018/03/21/unleash-your-models-with-systemmodeler-5-1/ http://blog.wolfram.com/2018/03/21/unleash-your-models-with-systemmodeler-5-1/#comments Wed, 21 Mar 2018 17:00:23 +0000 Patrik Ekenberg http://blog.internal.wolfram.com/?p=41690 We are excited to announce the latest installment in the Wolfram SystemModeler series, Version 5.1, where our primary focus has been on pushing the scope of use for models of systems beyond the initial stages of development.

Since 2012, SystemModeler has been used in a wide variety of fields with an even larger number of goals—such as optimizing the fuel consumption of a car, finding the optimal dosage of a drug for liver disease and maximizing the lifetime of a battery system. The Version 5.1 update expands SystemModeler beyond its previous usage horizons to include a whole host of options, such as:

  • Exporting models in a form that includes a full simulation engine, which makes them usable in a wide variety of tools
  • Providing the right interface for your models so that they are easy for others to explore and analyze
  • Sharing models with millions of users with the simulation core now included in the Wolfram Language

Wolfram SystemModeler 5.1

Standardized Simulators, Usable Anywhere

With SystemModeler 5, there were two standardized ways of exporting a SystemModeler model: either as Modelica code or using the Functional Mock-up Interface (FMI) for model exchange. In SystemModeler 5.1, we are adding a new, powerful export option, with FMI for co-simulation. While the previous two standards required the importing software to have its own simulation engine, with co-simulation, you are instead exporting a standalone simulator that has the SystemModeler simulation engine built in.

The FMI standard is supported by a wide variety of different tools. This opens up many new use cases, such as:

  • An engineer integrating the model with hardware, for hardware-in-the-loop simulation
  • A game designer using the exported model to drive behaviors in a game engine
  • A project manager using the model as an advanced simulator in e.g. Excel to calculate the return of investment for a power plant

SystemModeler simulate

See how the integration with Excel works in the following video:

Ready Your Models for Exploration, Analysis and Deployment

Whether your models are being simulated by yourself or by others—or whether you are building models for exploration, analysis or deployment—the ability to change or even completely switch configurations in your models is important. It is what allows you to do things like tweak shape parameters to perform optimal cam design, explore fundamental processes in the human body or use different control schemes in a connected system. However, all these possibilities for arranging parameters, variables and configurations can feel daunting.

SystemModeler explore

That is why, with SystemModeler 5.1, we are making it easier to add, document and organize parameters. This makes it possible to quickly set up models that can easily be used, explored and configured by others.

Find out more about the new model development improvements in the following video:

Share Models with Millions of Wolfram Language Users

With SystemModeler 5.1 and Wolfram Language 11.3, the full simulation core of SystemModeler is available to all Wolfram Language users. The system modeling functionality in the Wolfram Language makes it very easy to accomplish tasks such as:

SystemModeler is a great tool to create models of any complexity, and the Wolfram Language is equally great for exploration, analysis and optimization of models. Since this is a natural division of labor, we’ve also made it easy to switch between the two views of models. In fact, SystemModeler and the Wolfram Language use a shared state. When you update a model in one of them, you will see that change directly reflected in the other.

Updated model

SystemModeler users have had a Wolfram Language interface since SystemModeler 3. Based on what we’ve learned from our users since then, we have completely redesigned the system modeling functionality in Wolfram Language 11.3 and SystemModeler 5.1. The functionality has been streamlined, improved and now integrated permanently in the Wolfram Language. This means that you can now share your models with millions of Wolfram Language users whether they have SystemModeler or not.

Share SystemModeler

One potential use of this is creating a virtual lab, where students can try out different hypotheses using interactive interfaces and learn from them. Let’s illustrate this with an example from biology, where the students can explore the spread of genes for sickle cell anemia in a population. Suppose their professor has created the following model:

Input 1

SystemModel["SickleCellAnemia"]

Output 1

The professor can embed the model in a Wolfram Language notebook and then add explanations, questions and interactive interfaces using the Manipulate function. This can then be delivered to students as standalone notebooks with interfaces like this:

With this, students can interact with the simulations to try different scenarios, set up experiments and instantly see if their results match their hypotheses.

We have made a complete version of this virtual lab available. You can download it to test for yourself. You don’t even need a copy of SystemModeler to run it—just the latest version of a desktop Wolfram Language product such as Mathematica 11.3. Of course, you can always download an unrestricted 30-day trial of SystemModeler 5.1 and modify the included models to your own liking, or create your very own models for exploration, teaching or advanced analysis.

For more details on what’s new in Wolfram SystemModeler, visit the What’s New page or see a full list of changes here.

To share your models with other Wolfram Language and SystemModeler users, please join the Wolfram Community.

Introduction to Model Analytics

]]>
http://blog.wolfram.com/2018/03/21/unleash-your-models-with-systemmodeler-5-1/feed/ 4
User Research: Deep Learning for Gravitational Wave Detection with the Wolfram Language http://blog.wolfram.com/2018/03/14/user-research-deep-learning-for-gravitational-wave-detection-with-the-wolfram-language/ http://blog.wolfram.com/2018/03/14/user-research-deep-learning-for-gravitational-wave-detection-with-the-wolfram-language/#comments Wed, 14 Mar 2018 17:00:36 +0000 Swede White http://blog.internal.wolfram.com/?p=41555 Daniel George is a graduate student at the University of Illinois at Urbana-Champaign, Wolfram Summer School alum and Wolfram intern whose award-winning research on deep learning for gravitational wave detection recently landed in the prestigious pages of Physics Letters B in a special issue commemorating the Nobel Prize in 2017.

We sat down with Daniel to learn more about his research and how the Wolfram Language plays a part in it.

DanielGeorgeAward

How did you become interested in researching gravitational waves?

This was actually a perfect choice in my research area, and the timing was perfect, since within one week after I joined the group, there was the first gravitational wave detection by LIGO, and things got very exciting from there.

I was very fortunate to work in the most exciting fields of astronomy as well as computer science. At the [NCSA] Gravity Group, I had complete freedom to work on any project that I wanted, and funding to avoid any teaching duties, and a lot of support and guidance from my advisors and mentors who are experts in astrophysics and supercomputing. Also, NCSA was an ideal environment for interdisciplinary research.

Initially, my research was focused on developing gravitational waveform models using post-Newtonian methods, calibrated with massively parallel numerical relativity simulations using the Einstein Toolkit on the Blue Waters petascale supercomputer.

These waveform models are used to generate templates that are required for the existing matched-filtering method (a template-matching method) to detect signals in the data from LIGO and estimate their properties.

However, these template-matching methods are slow and extremely computationally expensive, and not scalable to all types of signals. Furthermore, they are not optimal for the complex non-Gaussian noise background in the LIGO detectors. This meant a new approach was necessary to solve these issues.

Your research is also being published in Physics Letters B—that must be pretty exciting…

My article was featured in the special issue commemorating the Nobel Prize in 2017.

Even though peer review is done for free by referees in the scientific community and the expenses to host online articles are negligible, most high-profile journals today are behind expensive paywalls and charge thousands of dollars for publication. However, Physics Letters B is completely open access to everyone in the world for free and has no publication charges for the authors. I believe all journals should follow this example to maximize scientific progress by promoting open science.

This was the main reason why we chose Physics Letters B as the very first journal where we submitted this article.

You recently won an award at SC17 for your work—how was your demo received?

I think the attendees and judges found this very impressive, since it was connecting high-performance parallel numerical simulations with artificial intelligence methods based on deep learning to enable real-time analysis of big data from LIGO for gravitational wave and multimessenger astrophysics. Basically, this research is at the interface of all these exciting topics receiving a lot of hype recently.

Deep learning seems like a novel approach. What led you to explore this?

I was always interested in artificial intelligence since my childhood, but I had no background in deep learning or even machine learning until November 2016, when I attended the Supercomputing Conference (SC16).

There was a lot of hype about deep learning at this conference, especially a lot of demos and workshops by NVIDIA, which got me excited to try out these techniques for my research. This was also right after the new neural network functionality was released in Version 11 of the Wolfram Language. I already had the training data of gravitational wave signals from my research with the NCSA Gravity Group, as mentioned before. So all these came together, and this was a perfect time to try out applying deep learning to tackle the problem of gravitational wave analysis.

Since I had no background in this field, I started out by taking an online course by Geoffrey Hinton on Coursera and CS231 at Stanford, and quickly read through the Deep Learning book by Bengio [Courville and Goodfellow], all in about a week.

Then it took only a couple of days to get used to the neural net framework in the Wolfram Language by reading the documentation. I decided to give time series inputs directly into 1D convolutional neural networks instead of images (spectrograms). Amazingly, the very first convolutional network I tried performed better than expected for gravitational wave analysis, which was very encouraging.

What advantages does deep learning have over other methods?

Here are some advantages of using deep learning over matched filtering:

1) Speed: The analysis can be carried out within milliseconds using deep learning (with minimal computational resources), which will help in finding the electromagnetic counterpart using telescopes faster. Enabling rapid followup observations can lead to new physical insights.

2) Covering more parameters: Only a small subset of the full parameter space of signals can be searched for using matched filtering (template matching), since the computational cost explodes exponentially with the number of parameters. Deep learning is highly scalable and requires only a one-time training process, so the high-dimensional parameter space can be covered.

3) Generalization to new sources: The article shows that signals from new classes of sources beyond the training data, such as spin precessing or eccentric compact binaries, can be automatically detected with this method with the same sensitivity. This is because, unlike template-matching techniques, deep learning can interpolate to points within the training data and generalize beyond it to some extent.

4) Resilience to non-Gaussian noise: The results show that this deep learning method can distinguish signals from transient non-Gaussian noises (glitches) and works even when a signal is contaminated by a glitch, unlike matched filtering. For instance, the occurrence of a glitch in coincidence with the recent detection of the neutron star merger delayed the analysis by several hours using existing methods and required manual inspection. The deep learning technique can automatically find these events and estimate their parameters.

5) Interpretability: Once the deep learning method detects a signal and predicts its parameters, this can be quickly cross-validated using matched filtering with a few templates around these predicted parameters. Therefore, this can be seen as a method to accelerate matched filtering by narrowing down the search space—so the interpretability of the results is not lost.

Why did you choose the Wolfram Language for this research?

I have been using Mathematica since I was an undergraduate at IIT Bombay. I have used it for symbolic calculation as well as numerical computation.

The Wolfram Language is very coherent, unlike other languages such as Python, and includes all the functionality across different domains of science and engineering without relying on any external packages that have to be loaded. All the 6,000 or so functions have explicit names and are designed with a very similar syntax, which means that most of the time you can simply guess the name and usage without referring to any documentation. The documentation is excellent, and it is all in one place.

Overall, the Wolfram Language saves a researcher’s time by a factor of 2–3x compared to other programming languages. This means you can do twice as much research. If everyone used Mathematica, we could double the progress of science!

I also used it for all my coursework, and submitted Mathematica notebooks exported into PDFs, while everyone else in my class was still writing things down with pen and paper.

The Wolfram Language neural network framework was extremely helpful for me. It is a very high-level framework and doesn’t require you to worry about what is happening under the hood. Even someone with zero background in deep learning can use it successfully for their projects by simply referring to just the documentation.

What about GPUs for neural net training?

Using GPUs to do training with the Wolfram Language was as simple as including the string TargetDevice->"GPU" in the code. With this small change, everything ran on GPUs like magic on any of my machines on Windows, OSX or Linux, including my laptop, Blue Waters, the Campus Cluster, the Volta and Pascal NVIDIA DGX-1 deep learning supercomputers and the hybrid machine with four P100 GPUs at the NCSA Innovative Systems Lab.

I used about 12 GPUs in parallel to try out different neural network architectures as well.

Was the Wolfram Language helpful in quick prototyping for successful grant applications?

I completed the whole project, including the research, writing the paper and posting on arXiv, within two weeks after I came up with the idea at SC16, even though I had never done any deep learning–related work before. This was only possible because I used the Wolfram Language.

I had drafted the initial version of the research paper as a Mathematica notebook. This allowed me to write paragraphs of text and typeset everything, even mathematical equations and figures, and organize into sections and subsections just like in a Word document. At the end, I could export everything into a LaTeX file and submit to the journal.

Everything, including the data preparation, preprocessing, training and inference with the deep convolutional neural nets, along with the preparation of figures and diagrams of the neural net architecture, was done with the Wolfram Language.

Apart from programming, I regularly use Mathematica notebooks as a word processor and to create slides for presentations. All this functionality is included with Mathematica.

What would you say to people who are new either to the Wolfram Language or deep learning to get them started?

Read the documentation, which is one of the greatest strengths of the language.

There are a lot of included examples about using deep learning for various types of problems, such as classification, regression in fields such as time series analysis, natural language processing, image processing, etc.

The Wolfram Neural Net Repository is a unique feature in the Wolfram Language that is super helpful. You can directly import state-of-the-art neural network models that are pre-trained for hundreds of different tasks and use them in your code. You can also perform “net surgery” on these models to customize them as you please for your research/applications.

The Mathematica Stack Exchange is a very helpful resource, as is the Fast Introduction for Programmers, along with Mathematica Programming—An Advanced Introduction by Leonid Shifrin.

George’s Research and Publications

Deep Learning for Real-Time Gravitational Wave Detection and Parameter Estimation: Results with Advanced LIGO Data (Physics Letters B)

Glitch Classification and Clustering for LIGO with Deep Transfer Learning (NIPS 2017, Deep Learning for Physical Science)

Deep Neural Networks to Enable Real-Time Multimessenger Astrophysics (Physics Review D)

Daniel George’s University of Illinois website

]]>
http://blog.wolfram.com/2018/03/14/user-research-deep-learning-for-gravitational-wave-detection-with-the-wolfram-language/feed/ 0
Roaring into 2018 with Another Big Release: Launching Version 11.3 of the Wolfram Language & Mathematica http://blog.wolfram.com/2018/03/08/roaring-into-2018-with-another-big-release-launching-version-11-3-of-the-wolfram-language-mathematica/ http://blog.wolfram.com/2018/03/08/roaring-into-2018-with-another-big-release-launching-version-11-3-of-the-wolfram-language-mathematica/#comments Thu, 08 Mar 2018 20:08:20 +0000 Stephen Wolfram http://blog.internal.wolfram.com/?p=41593 a.twitch { display: inline-block; width: 200px; height: 168px; background: url(http://blog.stephenwolfram.com/data/uploads/2018/03/livecoding-banner-blog.png) no-repeat; float: right; margin-left: 10px; } a.twitch:hover { background-position: 0px -168px; background-color: inherit; cursor: pointer; }

The Release Pipeline

Last September we released Version 11.2 of the Wolfram Language and Mathematica—with all sorts of new functionality, including 100+ completely new functions. Version 11.2 was a big release. But today we’ve got a still bigger release: Version 11.3 that, among other things, includes nearly 120 completely new functions.

This June 23rd it’ll be 30 years since we released Version 1.0, and I’m very proud of the fact that we’ve now been able to maintain an accelerating rate of innovation and development for no less than three decades. Critical to this, of course, has been the fact that we use the Wolfram Language to develop the Wolfram Language—and indeed most of the things that we can now add in Version 11.3 are only possible because we’re making use of the huge stack of technology that we’ve been systematically building for more than 30 years.

11.3We’ve always got a large pipeline of R&D underway, and our strategy for .1 versions is to use them to release everything that’s ready at a particular moment in time. Sometimes what’s in a .1 version may not completely fill out a new area, and some of the functions may be tagged as “experimental”. But our goal with .1 versions is to be able to deliver the latest fruits of our R&D efforts on as timely a basis as possible. Integer (.0) versions aim to be more systematic, and to provide full coverage of new areas, rounding out what has been delivered incrementally in .1 versions.

In addition to all the new functionality in 11.3, there’s a new element to our process. Starting a couple of months ago, we began livestreaming internal design review meetings that I held as we brought Version 11.3 to completion. So for those interested in “how the sausage is made”, there are now almost 122 hours of recorded meetings, from which you can find out exactly how some of the things you can now see released in Version 11.3 were originally invented. And in this post, I’m going to be linking to specific recorded livestreams relevant to features I’m discussing.

What’s New?

OK, so what’s new in Version 11.3? Well, a lot of things. And, by the way, Version 11.3 is available today on both desktop (Mac, Windows, Linux) and the Wolfram Cloud. (And yes, it takes extremely nontrivial software engineering, management and quality assurance to achieve simultaneous releases of this kind.)

In general terms, Version 11.3 not only adds some completely new directions, but also extends and strengthens what’s already there. There’s lots of strengthening of core functionality: still more automated machine learning, more robust data import, knowledgebase predictive prefetching, more visualization options, etc. There are all sorts of new conveniences: easier access to external languages, immediate input iconization, direct currying, etc. And we’ve also continued to aggressively push the envelope in all sorts of areas where we’ve had particularly active development in recent years: machine learning, neural nets, audio, asymptotic calculus, external language computation, etc.

Here’s a word cloud of new functions that got added in Version 11.3:

Word cloud

Blockchain

There are so many things to say about 11.3, it’s hard to know where to start. But let’s start with something topical: blockchain. As I’ll be explaining at much greater length in future posts, the Wolfram Language—with its built-in ability to talk about the real world—turns out to be uniquely suited to defining and executing computational smart contracts. The actual Wolfram Language computation for these contracts will (for now) happen off the blockchain, but it’s important for the language to be able to connect to blockchains—and that’s what’s being added in Version 11.3. [Livestreamed design discussion.]

The first thing we can do is just ask about blockchains that are out there in the world. Like here’s the most recent block added to the main Ethereum blockchain:

Blockchain

BlockchainBlockData[-1, BlockchainBase -> "Ethereum"]

Now we can pick up one of the transactions in that block, and start looking at it:

BlockchainBase

BlockchainTransactionData[\
"735e1643c33c6a632adba18b5f321ce0e13b612c90a3b9372c7c9bef447c947c",
 BlockchainBase -> "Ethereum"]

And we can then start doing data science—or whatever analysis—we want about the structure and content of the blockchain. For the initial release of Version 11.3, we’re supporting Bitcoin and Ethereum, though other public blockchains will be added soon.

But already in Version 11.3, we’re supporting a private (Bitcoin-core) Wolfram Blockchain that’s hosted in our Wolfram Cloud infrastructure. We’ll be periodically publishing hashes from this blockchain out in the world (probably in things like physical newspapers). And it’ll also be possible to run versions of it in private Wolfram Clouds.

It’s extremely easy to write something to the Wolfram Blockchain (and, yes, it charges a small number of Cloud Credits):

BlockchainPut

BlockchainPut[Graphics[Circle[]]]

The result is a transaction hash, which one can then look up on the blockchain:

BlockchainTransactionData

BlockchainTransactionData[\
"9db73562fb45a75dd810456d575abbeb313ac19a2ec5813974c108a6935fcfb9"]

Here’s the circle back again from the blockchain:

BlockchainGet


 

 

By the way, the Hash function in the Wolfram Language has been extended in 11.3 to immediately support the kinds of hashes (like “RIPEMD160SHA256”) that are used in cryptocurrency blockchains. And by using Encrypt and related functions, it’s possible to start setting up some fairly sophisticated things on the blockchain—with more coming soon.

System Modeling

Alright, so now let’s talk about something really big that’s new—at least in experimental form—in Version 11.3. One of our long-term goals in the Wolfram Language is to be able to compute about anything in the world. And in Version 11.3 we’re adding a major new class of things that we can compute about: complex engineering (and other) systems. [Livestreamed design discussions 1 and 2.]

Back in 2012 we introduced Wolfram SystemModeler: an industrial-strength system modeling environment that’s been used to model things like jet engines with tens of thousands of components. SystemModeler lets you both run simulations of models, and actually develop models using a sophisticated graphical interface.

What we’re adding (experimentally) in Version 11.3 is the built-in capability for the Wolfram Language to run models from SystemModeler—or in fact basically any model described in the Modelica language.

Let’s start with a simple example. This retrieves a particular model from our built-in repository of models:

SystemModel

SystemModel["Modelica.Electrical.Analog.Examples.IdealTriacCircuit"]

If you press the [+] you see more detail:

IdealTriacCircuit

But the place where it gets really interesting is that you can actually run this model. SystemModelPlot makes a plot of a “standard simulation” of the model:

Standard manipulation

SystemModelPlot[
 SystemModel["Modelica.Electrical.Analog.Examples.IdealTriacCircuit"]]

What actually is the model underneath? Well, it’s a set of equations that describe the dynamics of how the components of the system behave. And for a very simple system like this, these equations are already pretty complicated:

SystemEquations

SystemModel["Modelica.Electrical.Analog.Examples.IdealTriacCircuit"][\
"SystemEquations"]

It comes with the territory in modeling real-world systems that there tend to be lots of components, with lots of complicated interactions. SystemModeler is set up to let people design arbitrarily complicated systems graphically, hierarchically connecting together components representing physical or other objects. But the big new thing is that once you have the model, then with Version 11.3 you can immediately work with it in the Wolfram Language.

Every model has lots of properties:

Properties

[SystemModel["Modelica.Electrical.Analog.Examples.IdealTriacCircuit"] \
"Properties"]

One of these properties gives the variables that characterize the system. And, yes, even in a very simple system like this, there are already lots of those:

SystemVariables

[SystemModel["Modelica.Electrical.Analog.Examples.IdealTriacCircuit"] \
"SystemVariables"]

Here’s a plot of how one of those variables behaves in the simulation:

Variable behavior

SystemModelPlot[[SystemModel["Modelica.Electrical.Analog.Examples.IdealTriacCircuit"],
  "idealTriac.capacitor.p.i"]]

A typical thing one wants to do is to investigate how the system behaves when parameters are changed. This simulates the system with one of its parameters changed, then makes a plot:

SystemModelSimulate

SystemModelSimulate[[SystemModel["Modelica.Electrical.Analog.Examples.IdealTriacCircuit"]],  {"V.freqHz" -> 2.5}|>]
SystemModelPlot

SystemModelPlot[%, "idealTriac.capacitor.p.i"]

We could go on from here to sample lots of different possible inputs or parameter values, and do things like studying the robustness of the system to changes. Version 11.3 provides a very rich environment for doing all these things as an integrated part of the Wolfram Language.

In 11.3 there are already over 1000 ready-to-run models included—of electrical, mechanical, thermal, hydraulic, biological and other systems. Here’s a slightly more complicated example—the core part of a car:

SystemModel

SystemModel["IndustryExamples.AutomotiveTransportation.Driveline.\
DrivelineModel"]

If you expand the icon, you can mouse over the parts to find out what they are:

DrivelineModel

This gives a quick summary of the model, showing that it involves 1110 variables:

Summary

SystemModel["IndustryExamples.AutomotiveTransportation.Driveline.\
DrivelineModel"]["Summary"]

In addition to complete ready-to-run models, there are also over 6000 components included in 11.3, from which models can be constructed. SystemModeler provides a full graphical environment for assembling these components. But one can also do it purely with Wolfram Language code, using functions like ConnectSystemModelComponents (which essentially defines the graph of how the connectors of different components are connected):

Components

components = {"R" \[Element]
    "Modelica.Electrical.Analog.Basic.Resistor",
   "L" \[Element] "Modelica.Electrical.Analog.Basic.Inductor",
   "AC" \[Element] "Modelica.Electrical.Analog.Sources.SineVoltage",
   "G" \[Element] "Modelica.Electrical.Analog.Basic.Ground"};
Connections

connections = {"G.p" -> "AC.n", "AC.p" -> "L.n", "L.p" -> "R.n",
   "R.p" -> "AC.n"};
ConnectSystemModelComponents

model = ConnectSystemModelComponents[components, connections]

You can also create models directly from their underlying equations, as well as making “black-box models” purely from data or empirical functions (say from machine learning).

It’s taken a long time to build all the system modeling capabilities that we’re introducing in 11.3. And they rely on a lot of sophisticated features of the Wolfram Language—including large-scale symbolic manipulation, the ability to robustly solve systems of differential-algebraic equations, handling of quantities and units, and much more. But now that system modeling is integrated into the Wolfram Language, it opens all sorts of important new opportunities—not only in engineering, but in all fields that benefit from being able to readily simulate multi-component real-world systems.

New in Notebooks

We first introduced notebooks in Version 1.0 back in 1988—so by now we’ve been polishing how they work for no less than 30 years. Version 11.3 introduces a number of new features. A simple one is that closed cell groups now by default have an “opener button”, as well as being openable using their cell brackets:

Section

I find this helpful, because otherwise I sometimes don’t notice closed groups, with extra cells inside. (And, yes, if you don’t like it, you can always switch it off in the stylesheet.)

Another small but useful change is the introduction of “indefinite In/Out labels”. In a notebook that’s connected to an active kernel, successive cells are labeled In[1], Out[1], etc. But if one’s no longer connected to the same kernel (say, because one saved and reopened the notebook), the In/Out numbering no longer makes sense. So in the past, there were just no In, Out labels shown. But as of Version 11.3, there are still labels, but they’re grayed down, and they don’t have any explicit numbers in them:

In Out

Another new feature in Version 11.3 is Iconize. Here’s the basic problem it solves. Let’s say you’ve got some big piece of data or other input that you want to store in the notebook, but you don’t want it to visually fill up the notebook. Well, one thing you can do is to put it in closed cells. But then to use the data you have to do something like creating a variable and so on. Iconize provides a simple, inline way to save data in a notebook.

Here’s how you make an iconized version of an expression:

Iconize

Iconize[Range[10]]

Now you can use this iconized form in place of giving the whole expression; it just immediately evaluates to the full expression:

Reverse

Reverse[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}]

Another convenient use of Iconize is to make code easier to read, while still being complete. For example, consider something like this:

Plot

Plot[Sin[Tan[x]], {x, 0, 10}, Filling -> Axis,
 PlotTheme -> "Scientific"]

You can select the options here, then go to the right-click menu and say to Iconize them:

Iconize menu

The result is an easier-to-read piece of code—that still evaluates just as it did before:

Better plot

Plot[Sin[Tan[x]], {x, 0, 10}, Sequence[
 Filling -> Axis, PlotTheme -> "Scientific"]]

In Version 11.2 we introduced ExternalEvaluate, for evaluating code in external languages (initially Python and JavaScript) directly from the Wolfram Language. (This is supported on the desktop and in private clouds; for security and provisioning reasons, the public Wolfram Cloud only runs pure Wolfram Language code.)

In Version 11.3 we’re now making it even easier to enter external code in notebooks. Just start an input cell with a > and you’ll get an external code cell (you can stickily select the language you want):

Python code

ExternalEvaluate["Python", "import platform; platform.platform()"]

And, yes, what comes back is a Wolfram Language expression that you can compute with:

StringSplit

StringSplit[%, "-"]

Workflow Documentation

We put a lot of emphasis on documenting the Wolfram Language—and traditionally we’ve had basically three kinds of components to our documentation: “reference pages” that cover a single function, “guide pages” that give a summary with links to many functions, and “tutorials” that provide narrative introductions to areas of functionality. Well, as of Version 11.3 there’s a fourth kind of component: workflows—which is what the gray tiles at the bottom of the “root guide page” lead to.

Documentation page

When everything you’re doing is represented by explicit Wolfram Language code, the In/Out paradigm of notebooks is a great way to show what’s going on. But if you’re clicking around, or, worse, using external programs, this isn’t enough. And that’s where workflows come in—because they use all sorts of graphical devices to present sequences of actions that aren’t just entering Wolfram Language input.

Hiding input

So if you’re getting coordinates from a plot, or deploying a complex form to the web, or adding a banner to a notebook, then expect to follow the new workflow documentation that we have. And, by the way, you’ll find links to relevant workflows from reference pages for functions.

Presenter Tools

Another big new interface-related thing in Version 11.3 is Presenter Tools—a complete environment for creating and running presentations that include live interactivity. What makes Presenter Tools possible is the rich notebook system that we’ve built over the past 30 years. But what it does is to add all the features one needs to conveniently create and run really great presentations.

People have been using our previous SlideShow format to give presentations with Wolfram Notebooks for about 20 years. But it was never a complete solution. Yes, it provided nice notebook features like live computation in a slide show environment, but it didn’t do “PowerPoint-like” things such as automatically scaling content to screen resolution. To be fair, we expected that operating systems would just intrinsically solve problems like content scaling. But it’s been 20 years and they still haven’t. So now we’ve built the new Presenter Tools that both solves such problems, and adds a whole range of features to create great presentations with notebooks as easy as possible.

To start, just choose File > New > Presenter Notebook. Then pick your template and theme, and you’re off and running:

Presenter Notebook

Here’s what it looks like when you’re editing your presentation (and you can change themes whenever you want):

Presenter demonstration

When you’re ready to present, just press Start Presentation. Everything goes full screen and is automatically scaled to the resolution of the screen you’re using. But here’s the big difference from PowerPoint-like systems: everything is live, interactive, editable, and scrollable. For example, you can have a Manipulate right inside a slide, and you can immediately interact with it. (Oh, and everything can be dynamic, say recreating graphics based on data that’s being imported in real time.)  You can also use things like cell groups to organize content in slides. And you can edit what’s on a slide, and for example, do livecoding, running your code as you go.

When you’re ready to go to a new slide, just press a single key (or have your remote do it for you). By default, the key is Page Down (so you can still use arrow keys in editing), but you can set a different key if you want. You can have Presenter Tools show your slides on one display, then display notes and controls on another display. When you make your slides, you can include SideNotes and SideCode. SideNotes are “PowerPoint-like” textual notes. But SideCode is something different. It’s actually based on something I’ve done in my own talks for years. It’s code you’ve prepared, that you can “magically” insert onto a slide in real time during your presentation, immediately evaluating it if you want.

Presenter details

I’ve given a huge number of talks using Wolfram Notebooks over the years. A few times I’ve used the SlideShow format, but mostly I’ve just done everything in an ordinary notebook, often keeping notes on a separate device. But now I’m excited that with Version 11.3 I’ve got basically exactly the tools I need to prepare and present talks. I can pre-define some of the content and structure, but then the actual talk can be very dynamic and spontaneous—with live editing, livecoding and all sorts of interactivity.

Wolfram Chat

While we’re discussing interface capabilities, here’s another new one: Wolfram Chat. When people are interactively working together on something, it’s common to hear someone say “let me just send you a piece of code” or “let me send you a Manipulate”. Well, in Version 11.3 there’s now a very convenient way to do this, built directly into the Wolfram Notebook system—and it’s called Wolfram Chat. [Livestreamed design discussion.]

Just select File > New > Chat; you’ll get asked who you want to “chat with”—and it could be anyone anywhere with a Wolfram ID (though of course they do have to accept your invitation):

Chat invite

Then you can start a chat session, and, for example, put it alongside an ordinary notebook:

Notebook chat session

The neat thing is that you can send anything that can appear in a notebook, including images, code, dynamic objects, etc. (though it’s sandboxed so people can’t send “code bombs” to each other).

There are lots of obvious applications of Wolfram Chat, not only in collaboration, but also in things like classroom settings and technical support. And there are some other applications too. Like for running livecoding competitions. And in fact one of the ways we stress-tested Wolfram Chat during development was to use it for the livecoding competition at the Wolfram Technology Conference last fall.

One might think that chat is something straightforward. But actually it’s surprisingly tricky, with a remarkable number of different situations and cases to cover. Under the hood, Wolfram Chat is using both the Wolfram Cloud and the new pub-sub channel framework that we introduced in Version 11.0. In Version 11.3, Wolfram Chat is only being supported for desktop Wolfram Notebooks, but it’ll be coming soon to notebooks on the web and on mobile.

Language Conveniences

We’re always polishing the Wolfram Language to make it more convenient and productive to use. And one way we do this is by adding new little “convenience functions” in every version of the language. Often what these functions do is pretty straightforward; the challenge (which has often taken years) is to come up with really clean designs for them. (You can see quite a bit of the discussion about the new convenience functions for Version 11.3 in livestreams we’ve done recently.)

Here’s a function that it’s sort of amazing we’ve never explicitly had before—a function that just constructs an expression from its head and arguments:

Construct

Construct[f, x, y]

Why is this useful? Well, it can save explicitly constructing pure functions with Function or &, for example in a case like this:

Fold

Fold[Construct, f, {a, b, c}]

Another function that at some level is very straightforward (but about whose name we agonized for quite a while) is Curry. Curry (named after “currying”, which is in turn named after Haskell Curry) essentially makes operator forms, with Curry[f,n] “currying in” n arguments:

Curry

Curry[f, 3][a][b][c][d][e]

The one-argument form of Curry itself is:

One-argument Curry

Curry[f][x][y]

Why is this useful? Well, some functions (like Select, say) have built-in “operator forms”, in which you give one argument, then you “curry in” others:

Select Curry

Select[# > 5 &][Range[10]]

But what if you wanted to create an operator form yourself? Well, you could always explicitly construct it using Function or &. But with Curry you don’t need to do that. Like here’s an operator form of D, in which the second argument is specified to be x:

Curry operator form

Curry[D][x]

Now we can apply this operator form to actually do differentiation with respect to x:

Differentiation

%[f[x]]

Yes, Curry is at some level rather abstract. But it’s a nice convenience if you understand it—and understanding it is a good exercise in understanding the symbolic structure of the Wolfram Language.

Talking of operator forms, by the way, NearestTo is an operator-form analog of Nearest (the one-argument form of Nearest itself generates a NearestFunction):

Nearest

NearestTo[2.3][{1, 2, 3, 4, 5}]

Here’s an example of why this is useful. This finds the 5 chemical elements whose densities are nearest to 10 g/cc:

Chemical elements

Entity["Element", "Density" -> NearestTo[\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "10 g/cc", Typeset`boxes$$ =
        TemplateBox[{"10",
RowBox[{"\"g\"", " ", "\"/\"", " ",
SuperscriptBox["\"cm\"", "3"]}], "grams per centimeter cubed",
FractionBox["\"Grams\"",
SuperscriptBox["\"Centimeters\"", "3"]]}, "Quantity",
         SyntaxForm -> Mod], Typeset`allassumptions$$ = {},
        Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
        Typeset`querystate$$ = {
        "Online" -> True, "Allowed" -> True,
         "mparse.jsp" -> 0.777394`6.342186177878503,
         "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{94., {8., 19.}},
TrackedSymbols:>{
          Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
           Typeset`assumptions$$, Typeset`open$$,
           Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\), 5]] // EntityList

In Version 10.1 in 2015 we introduced a bunch of  functions that operate on sequences in lists. Version 11.3 adds a couple more such functions. One is SequenceSplit. It’s like StringSplit for lists: it splits lists at the positions of particular sequences:

SequenceSplit

uenceSplit[{a, b, x, x, c, d, x, e, x, x, a, b}, {x, x}]

Also new in the “Sequence family” is the function SequenceReplace:

SequenceReplace

SequenceReplace[{a, b, x, x, c, d, x, e, x, x, a,
  b}, {x, n_} -> {n, n, n}]

Visualization Updates

Just as we’re always polishing the core programming functionality of the Wolfram Language, we’re also always polishing things like visualization.

In Version 11.0, we added GeoHistogram, here showing “volcano density” in the US:

GeoHistogram

GeoHistogram[GeoPosition[GeoEntities[\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "USA", Typeset`boxes$$ =
       TemplateBox[{"\"United States\"",
RowBox[{"Entity", "[",
RowBox[{"\"Country\"", ",", "\"UnitedStates\""}], "]"}],
         "\"Entity[\\\"Country\\\", \\\"UnitedStates\\\"]\"",
         "\"country\""}, "Entity"],
       Typeset`allassumptions$$ = {{
        "type" -> "Clash", "word" -> "USA",
         "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "2",
         "Values" -> {{
           "name" -> "Country", "desc" -> "a country",
            "input" -> "*C.USA-_*Country-"}, {
           "name" -> "FileFormat", "desc" -> "a file format",
            "input" -> "*C.USA-_*FileFormat-"}}}},
       Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
       Typeset`querystate$$ = {
       "Online" -> True, "Allowed" -> True,
        "mparse.jsp" -> 0.373096`6.02336558644664, "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{197., {7., 16.}},
TrackedSymbols:>{
         Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
          Typeset`assumptions$$, Typeset`open$$,
          Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\), "Volcano"]]]

In Version 11.3, we’ve added GeoSmoothHistogram:

GeoSmoothHistogram

GeoSmoothHistogram[GeoPosition[GeoEntities[\!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "USA", Typeset`boxes$$ =
       TemplateBox[{"\"United States\"",
RowBox[{"Entity", "[",
RowBox[{"\"Country\"", ",", "\"UnitedStates\""}], "]"}],
         "\"Entity[\\\"Country\\\", \\\"UnitedStates\\\"]\"",
         "\"country\""}, "Entity"],
       Typeset`allassumptions$$ = {{
        "type" -> "Clash", "word" -> "USA",
         "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "2",
         "Values" -> {{
           "name" -> "Country", "desc" -> "a country",
            "input" -> "*C.USA-_*Country-"}, {
           "name" -> "FileFormat", "desc" -> "a file format",
            "input" -> "*C.USA-_*FileFormat-"}}}},
       Typeset`assumptions$$ = {}, Typeset`open$$ = {1, 2},
       Typeset`querystate$$ = {
       "Online" -> True, "Allowed" -> True,
        "mparse.jsp" -> 0.373096`6.02336558644664, "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{197., {7., 16.}},
TrackedSymbols:>{
         Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
          Typeset`assumptions$$, Typeset`open$$,
          Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\), "Volcano"]]]

Also new in Version 11.3 are callouts in 3D plots, here random words labeling random points (but note how the words are positioned to avoid each other):

3D plot callout

ListPointPlot3D[Table[Callout[RandomReal[10, 3], RandomWord[]], 25]]

We can make a slightly more meaningful plot of words in 3D by using the new machine-learning-based FeatureSpacePlot3D (notice for example that “vocalizing” and “crooning” appropriately end up close together):

FeatureSpacePlot3D

FeatureSpacePlot3D[RandomWord[20]]

Text Reading

Talking of machine learning, Version 11.3 continues our aggressive development of automated machine learning, building both general tools, and specific functions that make use of machine learning.

An interesting example of a new function is FindTextualAnswer, which takes a piece of text, and tries to find answers to textual questions. Here we’re using the Wikipedia article on “rhinoceros”, asking how much a rhino weighs:

FindTextualAnswer

FindTextualAnswer[
 WikipediaData["rhinoceros"], "How much does a rhino weigh?"]

It almost seems like magic. Of course it doesn’t always work, and it can do things that we humans would consider pretty stupid. But it’s using very state-of-the-art machine learning methodology, together with a lot of unique training data based on Wolfram|Alpha. We can see a little more of what it does if we ask not just for its top answer about rhino weights, but for its top 5:

FindTextualAnswer top 5

FindTextualAnswer[
 WikipediaData["rhinoceros"], "How much does a rhino weigh?", 5]

Hmmm. So what’s a more definitive answer? Well, for that we can use our actual curated knowledgebase:

Knowledgebase answer

\!\(
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "rhino weight", Typeset`boxes$$ =
    RowBox[{
TemplateBox[{"\"rhinoceroses\"",
RowBox[{"Entity", "[",
RowBox[{"\"Species\"", ",", "\"Family:Rhinocerotidae\""}], "]"}],
        "\"Entity[\\\"Species\\\", \\\"Family:Rhinocerotidae\\\"]\"",
        "\"species specification\""}, "Entity"], "[",
TemplateBox[{"\"weight\"",
RowBox[{"EntityProperty", "[",
RowBox[{"\"Species\"", ",", "\"Weight\""}], "]"}],
        "\"EntityProperty[\\\"Species\\\", \\\"Weight\\\"]\""},
       "EntityProperty"], "]"}],
    Typeset`allassumptions$$ = {{
     "type" -> "MultiClash", "word" -> "",
      "template" -> "Assuming ${word1} is referring to ${desc1}. Use \
\"${word2}\" as ${desc2}. Use \"${word3}\" as ${desc3}.",
      "count" -> "3",
      "Values" -> {{
        "name" -> "Species", "word" -> "rhino",
         "desc" -> "a species specification",
         "input" -> "*MC.%7E-_*Species-"}, {
        "name" -> "Person", "word" -> "rhino", "desc" -> "a person",
         "input" -> "*MC.%7E-_*Person-"}, {
        "name" -> "Formula", "word" -> "", "desc" -> "a formula",
         "input" -> "*MC.%7E-_*Formula-"}}}},
    Typeset`assumptions$$ = {}, Typeset`open$$ = {1},
    Typeset`querystate$$ = {
    "Online" -> True, "Allowed" -> True,
     "mparse.jsp" -> 0.812573`6.361407381082941, "Messages" -> {}}},
DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{96., {7., 16.}},
TrackedSymbols:>{
      Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
       Typeset`assumptions$$, Typeset`open$$, Typeset`querystate$$}],
DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\)

Or in tons:

UnitConvert

UnitConvert[%, \!\(\*
NamespaceBox["LinguisticAssistant",
DynamicModuleBox[{Typeset`query$$ = "tons", Typeset`boxes$$ =
     TemplateBox[{
InterpretationBox[" ", 1], "\"sh tn\"", "short tons",
       "\"ShortTons\""}, "Quantity", SyntaxForm -> Mod],
     Typeset`allassumptions$$ = {{
      "type" -> "Clash", "word" -> "tons",
       "template" -> "Assuming \"${word}\" is ${desc1}. Use as \
${desc2} instead", "count" -> "2",
       "Values" -> {{
         "name" -> "Unit", "desc" -> "a unit",
          "input" -> "*C.tons-_*Unit-"}, {
         "name" -> "Word", "desc" -> "a word",
          "input" -> "*C.tons-_*Word-"}}}, {
      "type" -> "Unit", "word" -> "tons",
       "template" -> "Assuming ${desc1} for \"${word}\". Use ${desc2} \
instead", "count" -> "10",
       "Values" -> {{
         "name" -> "ShortTons", "desc" -> "short tons",
          "input" -> "UnitClash_*tons.*ShortTons--"}, {
         "name" -> "LongTons", "desc" -> "long tons",
          "input" -> "UnitClash_*tons.*LongTons--"}, {
         "name" -> "MetricTons", "desc" -> "metric tons",
          "input" -> "UnitClash_*tons.*MetricTons--"}, {
         "name" -> "ShortTonsForce", "desc" -> "short tons-force",
          "input" -> "UnitClash_*tons.*ShortTonsForce--"}, {
         "name" -> "TonsOfTNT", "desc" -> "tons of TNT",
          "input" -> "UnitClash_*tons.*TonsOfTNT--"}, {
         "name" -> "DisplacementTons", "desc" -> "displacement tons",
          "input" -> "UnitClash_*tons.*DisplacementTons--"}, {
         "name" -> "LongTonsForce", "desc" -> "long tons-force",
          "input" -> "UnitClash_*tons.*LongTonsForce--"}, {
         "name" -> "MetricTonsForce", "desc" -> "metric tons-force",
          "input" -> "UnitClash_*tons.*MetricTonsForce--"}, {
         "name" -> "TonsOfRefrigerationUS",
          "desc" -> "US commercial tons of refrigeration",
          "input" -> "UnitClash_*tons.*TonsOfRefrigerationUS--"}, {
         "name" -> "TonsOfRefrigerationUKCommercial",
          "desc" -> "UK commercial tons of refrigeration (power)",
          "input" -> "UnitClash_*tons.*\
TonsOfRefrigerationUKCommercial--"}}}}, Typeset`assumptions$$ = {},
     Typeset`open$$ = {1}, Typeset`querystate$$ = {
     "Online" -> True, "Allowed" -> True,
      "mparse.jsp" -> 0.303144`5.933193970346431, "Messages" -> {}}}, 

DynamicBox[ToBoxes[
AlphaIntegration`LinguisticAssistantBoxes["", 4, Automatic,
Dynamic[Typeset`query$$],
Dynamic[Typeset`boxes$$],
Dynamic[Typeset`allassumptions$$],
Dynamic[Typeset`assumptions$$],
Dynamic[Typeset`open$$],
Dynamic[Typeset`querystate$$]], StandardForm],
ImageSizeCache->{47., {7., 16.}},
TrackedSymbols:>{
       Typeset`query$$, Typeset`boxes$$, Typeset`allassumptions$$,
        Typeset`assumptions$$, Typeset`open$$, Typeset`querystate$$}],

DynamicModuleValues:>{},
UndoTrackedVariables:>{Typeset`open$$}],
BaseStyle->{"Deploy"},
DeleteWithContents->True,
Editable->False,
SelectWithContents->True]\)]

FindTextualAnswer is no substitute for our whole data curation and computable data strategy. But it’s useful as a way to quickly get a first guess of an answer, even from completely unstructured text. And, yes, it should do well at critical reading exercises, and could probably be made to do well at Jeopardy! too.

Face Computation

We humans respond a lot to human faces, and with modern machine learning it’s possible to do all sorts of face-related computations—and in Version 11.3 we’ve added systematic functions for this. Here FindFaces pulls out faces (of famous physicists) from a photograph:

Physicists' faces

FindFaces[CloudGet["https://wolfr.am/sWoDYqbb"], "Image"]

FacialFeatures uses machine learning methods to estimate various attributes of faces (such as the apparent age, apparent gender and emotional state):

FacialFeatures[CloudGet["https://wolfr.am/sWRQARe8"]]//Dataset

These features can for example be used as criteria in FindFaces, here picking out physicists who appear to be under 40:

FindFaces

FindFaces[CloudGet["https://wolfr.am/sWoDYqbb"], #Age < 40 &, "Image"]

Neural Networks

There are now all sorts of functions in the Wolfram Language (like FacialFeatures) that use neural networks inside. But for several years we’ve also been energetically building a whole subsystem in the Wolfram Language to let people work directly with neural networks. We’ve been building on top of low-level libraries (particularly MXNet, to which we’ve been big contributors), so we can make use of all the latest GPU and other optimizations. But our goal is to build a high-level symbolic layer that makes it as easy as possible to actually set up neural net computations. [Livestreamed design discussions 1, 2 and 3.]

There are many parts to this. Setting up automatic encoding and decoding to standard Wolfram Language constructs for text, images, audio and so on. Automatically being able to knit together individual neural net operations, particularly ones that deal with things like sequences. Being able to automate training as much as possible, including automatically doing hyperparameter optimization.

But there’s something perhaps even more important too: having a large library of existing, trained (and untrained) neural nets, that can both be used directly for computations, and can be used for transfer learning, or as feature extractors. And to achieve this, we’ve been building our Neural Net Repository:

Neural Net Repository

There are networks here that do all sorts of remarkable things. And we’re adding new networks every week. Each network has its own page, that includes examples and detailed information. The networks are stored in the cloud. But all you have to do to pull them into your computation is to use NetModel:

NetModel trained

NetModel["3D Face Alignment Net Trained on 300W Large Pose Data"]

Here’s the actual network used by FindTextualAnswer:

NetModel

NetModel["Wolfram FindTextualAnswer Net for WL 11.3"]

One thing that’s new in Version 11.3 is the iconic representation we’re using for networks. We’ve optimized it to give you a good overall view of the structure of net graphs, but then to allow interactive drilldown to any level of detail. And when you train a neural network, the interactive panels that come up have some spiffy new features—and with NetTrainResultsObject, we’ve now made the actual training process itself computable.

Version 11.3 has some new layer types like CTCLossLayer (particularly to support audio), as well as lots of updates and enhancements to existing layer types (10x faster LSTMs on GPUs, automatic variable-length convolutions, extensions of many layers to support arbitrary-dimension inputs, etc.). In Version 11.3 we’ve had a particular focus on recurrent networks and sequence generation. And to support this, we’ve introduced things like NetStateObject—that basically allows a network to have a persistent state that’s updated as a result of input data the network receives.

In developing our symbolic neural net framework we’re really going in two directions. The first is to make everything more and more automated, so it’s easier and easier to set up neural net systems. But the second is to be able to readily handle more and more neural net structures. And in Version 11.3 we’re adding a whole collection of “network surgery” functions—like NetTake, NetJoin and NetFlatten—to let you go in and tweak and hack neural nets however you want. Of course, our system is designed so that even if you do this, our whole automated system—with training and so on—still works just fine.

Asymptotic Analysis

For more than 30 years, we’ve been on a mission to make as much mathematics as possible computational. And in Version 11.3 we’ve finally started to crack an important holdout area: asymptotic analysis.

Here’s a simple example: find an approximate solution to a differential equation near x = 0:

AsymptoticDSolveValue

AsymptoticDSolveValue[x^2  y'[x] + (x^2 + 1) y[x] == 0,
 y[x], {x, 0, 10}]

At first, this might just look like a power series solution. But look more carefully: there’s an e(1/x) factor that would just give infinity at every order as a power series in x. But with Version 11.3, we’ve now got asymptotic analysis functions that handle all sorts of scales of growth and oscillation, not just powers.

Back when I made my living as a physicist, it always seemed like some of the most powerful dark arts centered around perturbation methods. There were regular perturbations and singular perturbations. There were things like the WKB method, and the boundary layer method. The point was always to compute an expansion in some small parameter, but it seemed to always require different trickery in different cases to achieve it. But now, after a few decades of work, we finally in Version 11.3 have a systematic way to solve these problems. Like here’s a differential equation where we’re looking for the solution for small ε:

AsymptoticDSolveValue

AsymptoticDSolveValue[{\[Epsilon] y''[x] + (x + 1) y[x] == 0,
  y[0] == 1, y[1] == 0}, y[x], x, {\[Epsilon], 0, 2}]

Back in Version 11.2, we added a lot of capabilities for dealing with more sophisticated limits. But with our asymptotic analysis techniques we’re now also able to do something else, that’s highly relevant for all sorts of problems in areas like number theory and computational complexity theory, which is to compare asymptotic growth rates.

This is asking: is 2nk asymptotically less than (nm)! as n->∞? The result: yes, subject to certain conditions:

AsymptoticLess

AsymptoticLess[ 2^n^k, (n^m)!, n -> \[Infinity]]

“Elementary” Algebra

One of the features of Wolfram|Alpha popular among students is its “Show Steps” functionality, in which it synthesizes “on-the-fly tutorials” showing how to derive answers it gives. But what actually are the steps, in, say, a Show Steps result for algebra? Well, they’re “elementary operations” like “add the corresponding sides of two equations”. And in Version 11.3, we’re including functions to just directly do things like this:

AddSides

AddSides[a == b, c == d]
MultiplySides

MultiplySides[a == b, c == d]

And, OK, it seems like these are really trivial functions, that basically just operate on the structure of equations. And that’s actually what I thought when I said we should implement them. But as our Algebra R&D team quickly pointed out, there are all sorts of gotchas (“what if b is negative?”, etc.), that are what students often get wrong—but that with all of the algorithmic infrastructure in the Wolfram Language it’s easy for us to get right:

Negative MultiplySides

MultiplySides[x/b > 7, b]

Proofs

The Wolfram Language is mostly about computing results. But given a result, one can also ask why it’s correct: one can ask for some kind of proof that demonstrates that it’s correct. And for more than 20 years I’ve been wondering how to find and represent general proofs in a useful and computable way in the Wolfram Language. And I’m excited that finally in Version 11.3 the function FindEquationalProof provides an example—which we’ll be generalizing and building on in future versions. [Livestreamed design discussion.]

My all-time favorite success story for automated theorem proving is the tiny (and in fact provably simplest) axiom system for Boolean algebra that I found in 2000. It’s just a single axiom, with a single operator that one can think of as corresponding to the Nand operation. For 11 years, FullSimplify has actually been able to use automated theorem-proving methods inside, to be able to compute things. So here it’s starting from my axiom for Boolean algebra, then computing that Nand is commutative:

FullSimplify

FullSimplify[nand[p, q] == nand[q, p],
 ForAll[{a, b, c},
  nand[nand[nand[a, b], c], nand[a, nand[nand[a, c], a]]] == c]]

But this just tells us the result; it doesn’t give any kind of proof. Well, in Version 11.3, we can now get a proof:

FindEquationalProof

proof = FindEquationalProof[nand[p, q] == nand[q, p],
  ForAll[{a, b, c},
   nand[nand[nand[a, b], c], nand[a, nand[nand[a, c], a]]] == c]]

What is the proof object? We can see from the summary that the proof takes 102 steps. Then we can ask for a “proof graph”. The green arrow at the top represents the original axiom; the red square at the bottom represents the thing being proved. All the nodes in the middle are intermediate lemmas, proved from each other according to the connections shown.

ProofGraph

proof = FindEquationalProof[nand[p, q] == nand[q, p],
  ForAll[{a, b, c},
   nand[nand[nand[a, b], c], nand[a, nand[nand[a, c], a]]] == c]];
proof["ProofGraph"]

What’s actually in the proof? Well, it’s complicated. But here’s a dataset that gives all the details:

ProofDataset

proof = FindEquationalProof[nand[p, q] == nand[q, p],
  ForAll[{a, b, c},
   nand[nand[nand[a, b], c], nand[a, nand[nand[a, c], a]]] == c]];
proof["ProofDataset"]

You can get a somewhat more narrative form as a notebook too:

Proof notebook

proof = FindEquationalProof[nand[p, q] == nand[q, p],
  ForAll[{a, b, c},
   nand[nand[nand[a, b], c], nand[a, nand[nand[a, c], a]]] == c]];
proof["ProofNotebook"]

And then you can also get a “proof function”, which is a piece of code that can be executed to verify the result:

Proof

proof = FindEquationalProof[nand[p, q] == nand[q, p],
  ForAll[{a, b, c},
   nand[nand[nand[a, b], c], nand[a, nand[nand[a, c], a]]] == c]];
proof["ProofFunction"]

Unsurprisingly, and unexcitingly, it gives True if you run it:

Proof result

proof = FindEquationalProof[nand[p, q] == nand[q, p],
  ForAll[{a, b, c},
   nand[nand[nand[a, b], c], nand[a, nand[nand[a, c], a]]] == c]];
proof["ProofFunction"][]

Now that we can actually generate symbolic proof structures in the Wolfram Language, there’s a lot of empirical metamathematics to do—as I’ll discuss in a future post. But given that FindEquationalProof works on arbitrary “equation-like” symbolic relations, it can actually be applied to lots of things—like verifying protocols and policies, for example in popular areas like blockchain.

The Growing Knowledgebase

The Wolfram Knowledgebase grows every single day—partly through systematic data feeds, and partly through new curated data and domains being explicitly added. If one asks what happens to have been added between Version 11.2 and Version 11.3, it’s a slightly strange grab bag. There are 150+ new properties about public companies. There are 900 new named features on Pluto and Mercury. There are 16,000 new anatomical structures, such as nerve pathways. There are nearly 500 new “notable graphs”. There are thousands of new mountains, islands, notable buildings, and other geo-related features. There are lots of new properties of foods, and new connections to diseases. And much more.

But in terms of typical everyday use of the Wolfram Knowledgebase the most important new feature in Version 11.3 is the entity prefetching system. The knowledgebase is obviously big, and it’s stored in the cloud. But if you’re using a desktop system, the data you need is “magically” downloaded for you.

Well, in Version 11.3, the magic got considerably stronger. Because now when you ask for one particular item, the system will try to figure out what you’re likely to ask for next, and it’ll automatically start asynchronously prefetching it, so when you actually ask for it, it’ll already be there on your computer—and you won’t have to wait for it to download from the cloud. (If you want to do the prefetching “by hand”, there’s the function EntityPrefetch to do it. Note that if you’re using the Wolfram Language in the cloud, the knowledgebase is already “right there”, so there’s no downloading or prefetching to do.)

The whole prefetching mechanism is applied quite generally. So, for example, if you use Interpreter to interpret some input (say, US state abbreviations), information about how to do the interpretations will also get prefetched—so if you’re using the desktop, the interpretations can be done locally without having to communicate with the cloud.

Messages and Mail

You’ve been able to send email from the Wolfram Language (using SendMail) for a decade. But starting in Version 11.3, it can use full HTML formatting, and you can embed lots of things in it—not just graphics and images, but also cloud objects, datasets, audio and so on. [Livestreamed design discussion.]

Version 11.3 also introduces the ability to send text messages (SMS and MMS) using SendMessage. For security reasons, though, you can only send to your own mobile number, as given by the value of $MobilePhone (and, yes, obviously, the number gets validated).

The Wolfram Language has been able to import mail messages and mailboxes for a long time, and with MailReceiverFunction it’s also able to respond to incoming mail. But in Version 11.3 something new that’s been added is the capability to deal with live mailboxes.

First, connect to an (IMAP, for now) mail server (I’m not showing the authentication dialog that comes up):

MailServerConnect

mail = MailServerConnect[]

Then you can basically use the Wolfram Language as a programmable mail client. This gives you a dataset of current unread messages in your mailbox:

MailSearch

MailSearch[ "fahim"|>]

Now we can pick out one of these messages, and we get a symbolic MailItem object, that for example we can delete:

MailSearch Part

MailSearch[ "fahim"|>][[1]]
MailExecute

MailExecute["Delete", %%["MailItem"]]

Systems-Level Operations

Version 11.3 supports a lot of new systems-level operations. Let’s start with a simple but useful one: remote program execution. The function RemoteRun is basically like Unix rsh: you give it a host name (or IP address) and it runs a command there. The Authentication option lets you specify a username and password. If you want to run a persistent program remotely, you can now do that with RemoteRunProcess, which is the remote analog of the local RunProcess.

In dealing with remote computer systems, authentication is always an issue—and for several years we’ve been building a progressively more sophisticated symbolic authentication framework in the Wolfram Language. In Version 11.3 there’s a new AuthenticationDialog function, which pops up a whole variety of appropriately configured authentication dialogs. Then there’s GenerateSecuredAuthenticationKey—which generates OAuth SecuredAuthenticationKey objects that people can use to authenticate calls into the Wolfram Cloud from the outside.

Also at a systems level, there are some new import/export formats, like BSON (JSON-like binary serialization format) and WARC (web archive format). There are also HTTPResponse and HTTPRequest formats, that (among many other things) you can use to basically write a web server in the Wolfram Language in a couple of lines.

We introduced ByteArray objects into the Wolfram Language quite a few years ago—and we’ve been steadily growing support for them. In Version 11.3, there are BaseEncode and BaseDecode for converting between byte arrays and Base64 strings. Version 11.3 also extends Hash (which, among other things, works on byte arrays), adding various types of hashing (such as double SHA-256 and RIPEMD) that are used for modern blockchain and cryptocurrency purposes.

We’re always adding more kinds of data that we can make computable in the Wolfram Language, and in Version 11.3 one addition is system process data, of the sort that you might get from a Unix ps command:

SystemProcessData

SystemProcessData[]

Needless to say, you can do very detailed searches for processes with specific properties. You can also use SystemProcesses to get an explicit list of ProcessObject symbolic objects, which you can interrogate and manipulate (for example, by using KillProcess).

RandomProcess

RandomSample[SystemProcesses[], 3]

Of course, because everything is computable, it’s easy to do things like make plots of the start times of processes running on your computer (and, yes, I last rebooted a few days ago):

TimelinePlot

TimelinePlot[SystemProcessData[][All, "StartTime"]]

If you want to understand what’s going on around your computer, Version 11.3 provides another powerful tool: NetworkPacketRecording. You may have to do some permissions setup, but then this function can record network packets going through any network interface on your computer.

Here’s just 0.1 seconds of packets going in and out of my computer as I quietly sit here writing this post:

NetworkPacketRecording

NetworkPacketRecording[.1]

You can drill down to look at each packet; here’s the first one that was recorded:

NetworkPacketRecording

NetworkPacketRecording[.1][[1]]

Why is this interesting? Well, I expect to use it for debugging quite regularly—and it’s also useful for studying computer security, not least because you can immediately feed everything into standard Wolfram Language visualization, machine learning and other functionality.

What Has Not Been Mentioned

This is already a long post—but there are lots of other things in 11.3 that I haven’t even mentioned. For example, there’ve been all sorts of updates for importing and exporting. Like much more efficient and robust XLS, CSV, and TSV import. Or export of animated PNGs. Or support for metadata in sound formats like MP3 and WAV. Or more sophisticated color quantization in GIF, TIFF, etc. [Livestreamed design discussions 1 and 2.]

We introduced symbolic Audio objects in 11.0, and we’ve been energetically developing audio functionality ever since. Version 11.3 has made audio capture more robust (and supported it for the first time on Linux). It’s also introduced functions like AudioPlay, AudioPause and AudioStop that control open AudioStream objects.

Also new is AudioDistance, which supports various distance measures for audio. Meanwhile, AudioIntervals can now automatically break audio into sections that are separated by silence. And, in a somewhat different area, $VoiceStyles gives the list of possible voices available for SpeechSynthesize.

Here’s a little new math function—that in this case gives a sequence of 0s and 1s in which every length-4 block appears exactly once:

DeBrujinSequence

DeBruijnSequence[{0, 1}, 4]

The Wolfram Language now has sophisticated support for quantities and units—both explicit quantities (like 2.5 kg) and symbolic “quantity variables” (“p which has units of pressure”). But once you’re inside, doing something like solving an equation, you typically want to “factor the units out”. And in 11.3 there’s now a function that systematically does this: NondimensionalizationTransform. There’s also a new mechanism in 11.3 for introducing new kinds of quantities, using IndependentPhysicalQuantity.

Much of the built-in Wolfram Knowledgebase is ultimately represented in terms of entity stores, and in Version 11 we introduced an explicit EntityStore construct for defining new entity stores. Version 11.3 introduces the function EntityRegister, which lets you register an entity store, so that you can refer to the types of entities it contains just like you would refer to built-in types of entities (like cities or chemicals).

Another thing that’s being introduced as an experiment in Version 11.3 is the MongoLink package, which supports connection to external MongoDB databases. We use MongoLink ourselves to manage terabyte-and-beyond datasets for things like machine learning training. And in fact MongoLink is part of our large-scale development effort—whose results will be seen in future versions—to seamlessly support extremely large amounts of externally stored data.

In Version 11.2 we introduced ExternalEvaluate to run code in external languages like Python. In Version 11.3 we’re experimenting with generalizing ExternalEvaluate to control web browsers, by setting up a WebDriver framework. You can give all sorts of commands, both ones that have the same effect as clicking around an actual web browser, and ones that extract things you can see on the page.

Here’s how you can use Chrome (we support both it and Firefox) to open a webpage, then capture it:

WebDriver

ExternalEvaluate["WebDriver-Chrome", {"OpenWebPage" ->
   "https://www.wolfram.com", "CaptureWebPage"}]//Last

Well, this post is getting long, but there’s certainly more I could say. Here’s a more complete list of functions that are new or updated in Version 11.3:

Summary of New Features in 11.3

But to me it’s remarkable how much there is that’s in a .1 release of the Wolfram Language—and that’s emerged in just the few months since the last .1 release. It’s a satisfying indication of the volume of R&D that we’re managing to complete—by building on the whole Wolfram Language technology stack that we’ve created. And, yes, even in 11.3 there are a great many new corners to explore. And I hope that lots of people will do this, and will use the latest tools we’ve created to discover and invent all sorts of new and important things in the world.

Webinar ad

]]>
http://blog.wolfram.com/2018/03/08/roaring-into-2018-with-another-big-release-launching-version-11-3-of-the-wolfram-language-mathematica/feed/ 13