Westworld season 3 is another science fiction show containing a circular motif.The supercomputer Rehoboam predicts and controls human behaviour, and is shown physically as a large sphere. The interface to its "thoughts" is presented as oscillations of a black circle on a white background. Unforeseen behaviour manifests as "divergences", radial perturbations of the normal background oscillations.

I use sums of RiemannSiegelZ functions to form the background oscillations. These are shifted clockwise and counter-clockwise around the circle to give continuously changing waves. Divergences are formed by multiplying background oscillations by localised Tukey windows, scaled to rapidly rise and slowly fall. The opacity of points forming the waves is varied to produce the stripes seen in the visualisations shown in the series.

I am interested in hearing from the community of better, more efficient ways to represent the blocky or spikey oscillations shown in the series. I tried constraining @SimonWoods' friend/foe cloud of points to an annular ring; however, my version just muddied the result, not displaying the full interesting structure as when free to roam the entire plane. Is there a better way?

I am not using Dynamic properly, given some variables labelled red with the error: "occurs where it is probably not going to be evaluated before going out of scope". How do I correct this? Is DynamicModule required here?


1 Answer 1


Tukey windows and scaling for divergences.

makeTukey[n_, ntukey_] :=
   Block[{j = n*0.5, k},
         k = 2*RandomInteger[Quotient[n*{1, 4}, 50]];
         RotateLeft[TukeyWindow[Range[-j, j - 1.]/k], RandomInteger[{1, n}]],
      {i, 1, ntukey}]

scaleTukey[t_, scale_, delay_] := If[t<delay, 0., ((t-delay)*scale)*Exp[1.-(t-delay)*scale]]

Make a wave out of RiemannSiegelZ oscillations.

riemannWave[n_, u_, m_, f_] :=
      z = RiemannSiegelZ[Range[u, u + m, m/(n - 1.)]];
      z = Map[If[# < 0., -0.5 Abs[#]^f, #] &, z*TukeyWindow[Range[n]/n - 1/2, 0.2]];

Transform a wave into points with varying opacity.

riemannGraphics[waves_, opacity_, scale_, k_, p_] :=
   Block[{n = Length[waves], phase},
      phase = Range[0., n - 1]*2. \[Pi]/n;
         Opacity[opacity*(-0.8 + 0.9*(1 + Cos[6.1 i/40. + p]^10))],
         Point[(1.0 + (i/k) scale*waves)*
               Transpose[{Cos[#],Sin[#]}] &[phase+RandomReal[0.003{-1,1},n]]]},
      {i, 1., k}]

Shift waves clockwise and counter-clockwise around the circle.

riemannUpdate[waves_] :=
      If[OddQ[k], RotateRight[waves[[k]]], RotateLeft[waves[[k]]]],
   {k, 1, Length[waves]}]

Make it all dynamic.

rehoboamSE[n_, ntukey_, nwaves_] :=
   Module[{tukey, s, origins, spans, exponents, waves, delays, t = 0, v, w, p, q},

      tukey = makeTukey[n, ntukey];
      s = RandomReal[{0.008, 0.012}, ntukey];
      delays = 60*Range[ntukey] + RandomInteger[{10, 50}, ntukey];

      origins = 30.*Range[nwaves] + RandomInteger[{10, 50}, nwaves];
      spans = 25.*Range[nwaves] + RandomInteger[{10, 50}, nwaves];
      exponents = ConstantArray[0.3, nwaves];
      waves = Table[riemannWave[n, origins[[i]], spans[[i]], exponents[[i]]], {i,1,nwaves}];

      p = RandomReal[{0., 6.}]; q = RandomReal[{0., 6.}];

         t += 1;

            (* backgroup oscillations *)
            p = p + 0.01;
            riemannGraphics[(w = Total[waves]), 0.2, 0.040, 20, p],

            (* divergences *)
            q = q + 0.01;
               v = scaleTukey[t, s[[j]], delays[[j]]]*tukey[[j]];
               riemannGraphics[v*w, 0.3, 0.2, 40, q],
            {j, 1, ntukey}],

            (* update waves *)
            waves = riemannUpdate[waves];
         }, PlotRange -> 1.5, ImageSize -> 500]]

For example,

rehoboamSE[1000, 3, 8]

rehoboam ponders


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.