Effects of multiple time dimensions

Introduction

This is a simple demonstration to visualise the effects of having more than one time dimension.

At first glance the concept of multiple time dimensions seems very strange. We will remove ourselves from “time” and view time and space dimensions from the outside. In this demonstration we have 12 conventional objects, obeying a simplified Newtonian physics, bouncing around in a box in 2 space dimensions.

We take the thermodynamic point of view, that the difference between space and time dimensions is that time dimensions exhibit an entropy gradient, while space dimensions do not.

We will see that even though each object has a definite position at each time coordinate, there is an uncertainty in its momentum. If the time coordinates are unknown then there is an uncertainty in its position.

code

(* clean start *)
dummy = 1;
Remove["Global`*"];

(* set the initial state of the balls *)
ipos = {{{8, 8}, {0, 0}, +1}, {{16, 8}, {0, 0}, +1}, {{8, 16}, {0, 
     0}, +1}, {{24, 8}, {0, 0}, +1}, {{16, 16}, {0, 0}, +1}, {{8, 
     24}, {0, 0}, +1}, {{92, 92}, {0, 0}, -1}, {{84, 92}, {0, 
     0}, -1}, {{92, 84}, {0, 0}, -1}, {{76, 92}, {0, 0}, -1}, {{84, 
     84}, {0, 0}, -1}, {{92, 76}, {0, 0}, -1}};

(*
 * calculate all the states starting from ipos at 0,0
 *)
calcstates[max_, asym_] := Module[{
    xmax, ymax, diff,
    tx, ty, lastx, lasty
    },

   {xmax, ymax} = max;
   (* initialise global 2d array for the spaces as well as the path \
of the first ball *)
   tab = Table[{}, {xmax}, {ymax}]; 
   path = Table[{}, {xmax}, {ymax}]; 

   (* initialise the first space at 1,1 and an empty path*)
   tab[[1, 1]] = ipos;
   path[[1, 1]] = {};

   (* now the axes *)
   Table[
    tab[[tx, 1]] = calcspace[tab[[tx - 1, 1]], tab[[tx - 1, 1]]];
    path[[tx, 1]] = 
     Append[path[[tx - 1, 1]], plotline[tx, 1, tx - 1, 1]],
    {tx, 2, xmax}];

   Table[
    tab[[1, ty]] = calcspace[tab[[1, ty - 1]], tab[[1, ty - 1]]] ;
    path[[1, ty]] = 
     Append[path[[1, ty - 1]], plotline[1, ty, 1, ty - 1]],
    {ty, 2, ymax}];

   (* introduce an asymmetry at space 1,2 first ball, 
   second field (dx,dy) *)
   tab[[1, 2]] [[1]][[2]] += asym;

   (* and calculate the rest of the tab cells *)
   Table[
    tab[[tx, ty]] = calcspace[tab[[tx - 1, ty]], tab[[tx, ty - 1]]];
    lastx = Append[path[[tx - 1, ty]], plotline[tx, ty, tx - 1, ty]];
    lasty = Append[path[[tx, ty - 1]], plotline[tx, ty, tx, ty - 1]];
    path[[tx, ty]] = Join[lastx, lasty],
    {ty, 2, ymax}, {tx, 2, xmax}];
   ];

(*
 * calc space from 2 neighbours
* neighbours can be the same 
 *)
calcspace[s1_, s2_] := Module[{
    len = Length[s1],
    new = {},
    force = 2.5,
    xdistance, ydistance, distance,
    pos, diff, newdiff, partpos,
    p1, p2, x, y,
    p, charge, pcharge
    },

   Assert[len == Length[s2]];

   For[n = 1, n <= len, n++,
    p1 = Part[s1, n];
    p2 = Part[s2, n];
    (* Take the average position from the 2 neighbours *)
    pos = (Part[p1, 1] + Part[p2, 1])/2 // N;
    diff = (Part[p1, 2] + Part[p2, 2])/2 // N;
    newdiff = diff // N;
    charge = Part[p1, 3];
    Assert[charge  == Part[p2, 3]];

    (* recalculate vectors by considering all balls, 
    even the currently processed one *)
    Do[
     partpos = Part[p, 1];
     pcharge = Part[p, 3];
     {xdistance, ydistance} = pos - partpos;
     distance = Sqrt[xdistance^2 + ydistance^2] // N;
     If[distance > 1,
      newdiff += 
         force  * {xdistance, ydistance} / distance *charge*pcharge //
         N;
      ], (* end If *)
     {p, Join[s1, s2]}]; (* end Do loop *)

    (* recalc positions *)
    pos += diff;

    (* check for bouncing off the edge *)
    {x, y} = pos;
    If[x < 4,   newdiff *= {-1, 1}; x = 4;];
    If[x > 96, newdiff *= {-1, 1}; x = 96;];
    If[y < 4 ,  newdiff *= {1, -1}; y = 4;];
    If[y > 96, newdiff *= {1, -1}; y = 96;];
    pos = {x, y};

    (* build result list *)
    AppendTo[new, {pos, newdiff, charge} // N];
    ]; (* end For *)
   Return[new // N];
   ];

(*
 * draw a line joining the positions of the first particle in two \
spaces
 *)
plotline[tx1_, ty1_, tx2_, ty2_] := Module[{
    p1 = First[ tab[[tx1, ty1]] ],
    p2 = First[ tab[[tx2, ty2]] ],
    pos1, pos2
    },
   pos1 = Part[p1, 1];
   pos2 = Part[p2, 1];
   Return[{pos1, pos2} // N]
   ];

(*
 * plot the space s at tx,ty and the path trace
 *)
plotspace[tx_, ty_] := Module[{
    s = tab[[tx, ty]],
    graph = Map[Line, path[[tx, ty]] ],
    p, pos, pcharge
    },
   Do[
    pos = Part[p, 1];
    pcharge = Part[p, 3];
    (* colour the first one differently *)
    If[p == First[s],
     AppendTo[graph, Black],
     If[pcharge < 0, AppendTo[graph, Red], AppendTo[graph, Blue] ];
     ];
    AppendTo[graph, Disk[pos, 4]],
    {p, s}];
   Graphics[graph, Frame -> True, FrameTicks -> None, 
    PlotRange -> {{0, 100}, {0, 100}}]
   ];

(*
 * plot the result 
 *)
plotstates[max_] := Module[{
    nx, ny, dx, dy, disp
    },
   {nx, ny} = max;
   disp = Table[{}, {nx}, {ny}];

   Table[
    disp[[dx, dy]] = plotspace[ dx, dy ],
    {dy, 1, ny}, {dx, 1, nx}
    ];
   GraphicsGrid[disp, ImageSize -> 800]
   ];

(* 
 * plot all the spaces of the diagonal on top of each other using \
opacity
* using only the first ball in each space
 *)
plotcloud[max_] := Module[{
    g, diag, balls, pos,
    graph = {Opacity[1/max, Black]}
    },
   diag = Table[tab[[g, max - g + 1]], {g, 1, max}];
   balls = Map[First, diag];

   Do[
    pos = First[p];
    AppendTo[graph, Disk[pos, 4]],
    {p, balls}];
   Graphics[graph, Frame -> True, FrameTicks -> None, 
    PlotRange -> {{0, 100}, {0, 100}}]
   ];

Single time dimension

We first look at the one dimensional time case. We show the objects as coloured balls. Like-coloured balls repel each other and unlike-coloured balls attract. The code does not detect collisions between balls, only between balls and the walls to keep them inside the box. The black ball is treated like a blue ball. It is a different colour because we will track its path using a black line. Physical accuracy is not the aim here, we are merely demonstrating the effects of multiple time dimensions.

This simulation with only one-dimensional time shows the familiar common sense Newtonian picture of the objects. At each time frame shown each object is in a well defined place. The black line traces one unique history for the object that we are monitoring.

max = 10; 
calcstates[{1, max}, {0, 0}];
plotstates[{1, max}]

Two-dimensional time

Now we have two time dimensions. If we start from the highest ordered state in the top left corner and we want to move along to successively less ordered states, we could move from left to right in the top row, or we could move down the left column, or we could follow a path in between such as the diagonal or move at an angle.

In the simulation we introduce a small asymmetry at the beginning to get more interesting patterns. After all a mathematically perfect symmetry is not a realistic condition for such a simulation.

As we can see, there is no longer a single history trace for each particle, but multiple lines.

max = 12;
calcstates[{max, max}, {-17, 19}];
plotstates[{max, max}]