2
$\begingroup$

I have recently been learning my way around the CellularAutomaton function and I'm seeking assistance in calculating the waiting times between changing events at each time step.

The CA is setup such that the result is a list, of length t, of n by n (I'm using n=100) matrices, ie. one for each time step. Each matrix is filled with 0,1,2's and is updated at each time step according to certain rules, which change the 0,1,2 to a different 0,1,2 depending on the rule.

What I am trying to do, is note the time taken (delta t) for a value 2, to cycle back to a value 2. i.e. to calculate the waiting time between the 2's occurring.

I have had a few attempts at doing so but seem to keep hitting the same dead end, or having very poor efficiency in the code.

My idea was the find the {i,j} position of all the 2's in all of the matrices, put them into a dataset with columns "t ->{ t1 , t2,...,} , "i,j" -> { i, j } and to combine only the values for t.

The counts of 2's are on the order 10^6, as I'm taking 3000 time steps for one sample of the CA result.

Rather than iterate over each position value given, is there an easier way to do this? This was my initial code:

For[ii = 1, ii < t + 1, ii++,
  pos = Position[result3[[ii]], 2];

  For[i = 1, i < Length[pos] + 1, i++,

   If[MemberQ[wait[[All, 1]], pos[[i]]],

    (*If the site for run y is in the dataset, 
    append the "t" to add in the time step that the 2 occurs*)
    pos1 = Position[wait[All, 1], pos[[i]]][[1]][[1]];
    wait = 
     ReplacePart[
      wait, {pos1, "t"} -> 
       Flatten[Join[{Normal[wait[pos1, "t"]]}, {ii}]]];,

    (*add a new row to the dataset*)
    wait = Append[wait, <|"i,j" -> pos[[i]], "t" -> ii|>]
    ]
   ](*end for i*)

  ];

And that was far too inefficient. Then I tried datasets (I'm fairly new to them)

wait = Dataset[
   Flatten[Table[<|"i,j" -> {i, j}, "t" -> {0}|>, {i, 100}, {j, 
      100}]]];
waittimes = Dataset[{<|"run" -> {}, "wt" -> {}|>}];

two = Table[Position[result3[[ii]], 2], {ii, t}];
For[ii = 2, ii < 3, ii++,

  pos = Position[wait, #] & /@ two[[ii]];

  (*Append the "t" column to add in the time step that the 2 occurs*)


  wait = ReplacePart[
    wait, {{pos[[All, 1, 1]], "t"} -> 
      Flatten[Join[{Normal[wait[pos[[All, 1, 1]], "t"]]}, {ii}]]}];

  ];

This also didn't go very well..

Any assistance is greatly appreciated! <3

$\endgroup$
1
  • $\begingroup$ I may have a solution for you, but could you clarify the result you need? Say there are 6 time steps with these samples {1,0,2,2,1,2}, should delta t be {1,2}? And for a list of 100-by-100 matrices, the result would be 100-by-100 delta T results, where some may be empty if there are fewer than two 2's in the list of samples. $\endgroup$ – creidhne May 13 '20 at 19:43
1
$\begingroup$

The goal is to find the intervals (delta-t) between events where the cell value is 2 at each time step a cellular automaton. Create test data to demonstrate the method. We'll use 6 samples of 4 by 5 matrices.

Demonstration

Here's a breakdown of the steps to find delta-t values. Verify that the delta-t values match the samples.

SeedRandom[246];
results = Table[Table[RandomChoice[{0,1,2}, 4], {i,1,5}], {t,6}];
MatrixForm /@ results

sample results

Show the time samples for each row and column of the matrices. There are 6 samples for each row and column.

{columns, rows} = Rest@Dimensions[results]; Table[
results[[All, c, r]] // MatrixForm, {c, columns}, {r, rows}]

time samples

Convert the time samples to intervals (delta-t) between cell values of 2. For example, the delta-t for the time sample {1,2,1,0,2,2} in row 1, column 3, is {3,1}.

{columns, rows} = Rest@Dimensions[results];
deltaT = Map[If[AtomQ[#], {}, Differences[#]] &, 
  2 /. Map[PositionIndex, 
    Table[results[[All, c, r]], {c, columns}, {r, rows}], {2}], {2}];
deltaT // MatrixForm

delta-t

Solution

Create a test set of random time samples of 100 by 100 matrices. This cellular automaton simulation has 3,000 time samples for each row and column of the matrices. Here's the timing to compute the delta-t values.

SeedRandom[135];
results = Table[Table[RandomChoice[{0,1,2}, 100], {i,1,100}], {t,3000}];

{columns,rows}=Rest@Dimensions[results];
deltaT = Map[If[AtomQ[#], {}, Differences[#]]&,
  2 /. Map[PositionIndex,
    Table[results[[All, c, r]], {c,columns}, {r,rows}], {2}],
  {2}]; // AbsoluteTiming // First
(* 2.75504 *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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