Group Abstract Group Abstract

Message Boards Message Boards

[WSS22] Multiway mobile automata

enter image description here

POSTED BY: Felipe Amorim
3 Replies
MCAStep[{ru1_, ru2_}, {c_, b_, a_}] := {b, a, 
  IntegerDigits[ru2, 2, 8][[
   8 - (#1 + 2 (#2 + 2 #3)) & @@ # & /@ 
    Transpose[{c, b, 
      IntegerDigits[ru1, 2, 8][[
       8 - (RotateLeft[a] + 2 (a + 2 RotateRight[a]))]]}]]]}
With[{t = 500}, 
 ArrayPlot[
  Last /@ NestList[
    MCAStep[{90, 150}, #] &, {Table[0, 2 t + 1], Table[0, 2 t + 1], 
     CenterArray[{1}, 2 t + 1]}, t]]]

MCA Step Last But Not Least

It is something where the sort of whole computational irreducibility story is quite relevant. I tend to think that eventually we will have more of an overarching theory of biology than we have "right now". Biology has been rather allergic to theory "just" because a lot of simple theories don't work in biology. Biology has this sort of meta feature that usually if you try and explain something in biology, the most complicated explanation, there's many footnotes and many special cases and that will be what's going on. In Physics it's much more likely that the simplest explanation will be the best explanation. So I think that's something to "realize" that but I do think, that the problem of aging is probably solvable. And the clock starts again. When I first found Mathematica, I didn't realize how much focus was on exploring how discrete systems--where only one (or a few) "active" cell(s) are updated at a time--can be a thing with which we evolve in multiple ways. We did eventually get the multiway systems installed on our machines, what with all the highschool teachers begging us every time there's an executive order to save them the Texas Instruments..Mathematica was the answer to a pressing need for computational software that is able to solve all these problems. It was probably right about that time when the Ruliad "really" got started and it was nothing short of intriguing to discover these mobile automata. I think the fundamental concept is that they use rules specified as pairs of numbers whether it's {275, 999} and {81, 384}..much like you've described..the first number represents a color change and the second represents a break from the default value, for instance the updated cell's NEW position. So every time you apply the rule you generate a new branch in the multiway graph, that's probably why the ResourceFunction["MultiwaySystem"] makes it possible to explore different evolution paths and the connectivity, of branchial graphs.

ClearAll[MultiwayMobileAutomaton3D, getMAStateGraphics3D, 
  stateRenderingFunction3D, statesEvolutionFunction3D];
stripMetadata[expression_] := 
  If[Head[expression] === Rule, Last[expression], expression];
getMAStateGraphics3D[rule_, state_] := 
  Framed[Style[
    ResourceFunction["MobileAutomatonPlot"][
     ResourceFunction["MobileAutomaton"][rule, state, 0], 
     ColorRules -> {0 -> White}, Mesh -> True], Hue[0.62, 1, 0.48]], 
   Background -> Directive[Opacity[0.2], Hue[0.62, 0.45, 0.87]], 
   FrameMargins -> {{2, 2}, {0, 0}}, RoundingRadius -> 0, 
   FrameStyle -> Directive[Opacity[0.5], Hue[0.62, 0.52, 0.82]]];
stateRenderingFunction3D[rule_] := 
  Inset[getMAStateGraphics3D[rule, 
     ToExpression[stripMetadata[#2]]], #1, Center, #3] &;
statesEvolutionFunction3D[state_String, rules_List] := 
  ToString /@ (ResourceFunction["MobileAutomaton"][ToExpression[#1], 
        ToExpression[state], 1][[-1]] & /@ rules);
MultiwayMobileAutomaton3D[rules_List, initialConditions_List, 
   stepCount_Integer, rest___] := 
  ResourceFunction["MultiwaySystem"][
   Association[
    "StateEvolutionFunction" -> (statesEvolutionFunction3D[#1, 
        rules] &), "StateEquivalenceFunction" -> SameQ, 
    "StateEventFunction" -> (# &), 
    "EventDecompositionFunction" -> Function[{a, b, c}, None], 
    "EventApplicationFunction" -> Function[{a, b, c}, None], 
    "SystemType" -> "MobileAutomaton", 
    "EventSelectionFunction" -> Identity], 
   ToString /@ initialConditions, stepCount, rest, 
   "StateRenderingFunction" -> stateRenderingFunction3D[First[rules]],
    "EventRenderingFunction" -> Function[{a, b, c}, None]];
VisualizeMultiwayMobileAutomaton3D[rules_, initialConditions_, 
   stepCount_] := 
  Module[{graph3D}, 
   graph3D = 
    MultiwayMobileAutomaton3D[rules, initialConditions, stepCount, 
     "StatesGraphStructure"];
   Graph3D[graph3D, VertexSize -> 0.5, 
    VertexStyle -> Directive[Hue[0.62, 1, 0.48]], 
    EdgeStyle -> Directive[Opacity[0.5], Hue[0.62, 0.52, 0.82]], 
    ImageSize -> Large, 
    PlotLabel -> Style["3D Multiway Mobile Automaton", Bold, 16]]];
rules = {{275, 999}, {81, 384}};
initialConditions = {{ConstantArray[0, 35], 17}};
stepCount = 5;
VisualizeMultiwayMobileAutomaton3D[rules, initialConditions, \
stepCount]

That's why it's so important to visualize these multiway evolutions to reveal, the complexity of the branching & merging behavior. And, one of the issues with algebraic topology is that there's all these concepts that fit together in complex ways. Meanwhile there was an American named Saunders Mac Lane who I met a couple of times who got involved with algebraic topology..and so as soon as Mac Lane invented category theory which is saying how concepts fit together, it had been the case in Mathematics that a function would take a number and produce another number. A mapping, you apply this mapping and you get another set of things. That mapping is a more general, set of things where you generate a new branch in the multiway evolution like getMAStateGraphics3D and VisualizeMultiwayMobileAutomaton3D which render each state as a 3D graphic and then compose these into a 3D graph. This lets you see not only the automaton's state but also how different states connect--it's the echo chamber on branchial structures and state graphs.

3d multiway

So even though all this evolution of initial states was going on I think that from our perspectives as students of Wolfram, I was probably about..what I remember kicking at the ball (I think now they call it FIFA) and just thinking, why do we have to install all these Wolfram technologies..so by the time I finally saw the evolution of Mathematica from a primarily array oriented structure (e.g. using a constant array with a specified active cell) over several steps and then visualizing the outcome, I saw how we can demonstrate how even simple update rules can lead to a rich, multiway structure. It isn't always the young who change things, but it is not my impression that sometimes the young say I'm embedded in this environment and the old are like yea I know that environment there are other things we can do. There are things that evolution has put in for the benefit of the species, if not for the benefit of us as individuals, and embody how different rules interact to produce multiple evolutionary paths. I for one was quite happy to see that the Wolfram technologies from the Iris scanner to the kitchenette area, there's just so much to be had and explored there. When you really drill down to the essence of it you see that there's this system thing set up where an automaton state evolves over several steps..there's every potential for branching into multiple states..therefore we display the evolution as a 3D graph with each node rendered as a 3D visualization of the state.

DynamicModule[{rule1 = 30, rule2 = 90, steps = 50, size = 101}, 
 Panel[Column[{Row[{Slider[Dynamic[rule1], {0, 255, 1}, 
       ImageSize -> 300], Dynamic[rule1], Spacer[20], 
      Slider[Dynamic[rule2], {0, 255, 1}, ImageSize -> 300], 
      Dynamic[rule2]}], 
    Slider[Dynamic[steps], {1, 200, 1}, ImageSize -> 700], 
    Dynamic@Row[{ArrayPlot[
        CellularAutomaton[{rule1, 2}, {{1}, 0}, steps], 
        ColorFunction -> "SolarColors", ImageSize -> 300, 
        Frame -> False, PlotLabel -> "Rule " <> ToString[rule1]], 
       ArrayPlot[CellularAutomaton[{rule2, 2}, {{1}, 0}, steps], 
        ColorFunction -> "Aquamarine", ImageSize -> 300, 
        Frame -> False, PlotLabel -> "Rule " <> ToString[rule2]], 
       ArrayPlot[{Mod[
          CellularAutomaton[{rule1, 2}, {{1}, 0}, steps][[steps]] + 
           CellularAutomaton[{rule2, 2}, {{1}, 0}, steps][[steps]], 
          2]}, ColorFunction -> (Blend[{Red, Blue}, #] &), 
        ImageSize -> 300, Frame -> False, 
        PlotLabel -> "Combined Pattern"]}, Spacer[10]]}, 
   Alignment -> Center], Background -> LightGray]]

Dynamic Module

Folks like chemists and material scientists who after all have been dealing with molecules! And in the end, it seems like what happened is the nanotechnology direction just sort of got "stomped on" by these existing fields, and it really hasn't been pursued. My own feeling is that there's a lot of promise there. One thing that's probably not correct is that we take machinery that operates on the scale of centimeters and have it shrink down to nanometers and have it be machinery on a small scale. How do you take the components of molecules we have and how do you assemble them to compile up to a thing that's useful to us? If we wanted to do arithmetic, we could do what Charles Babbage did when they made mechanical computers back in the early 1800s. And they had a "wheel" that had digits 0 through 9 and cogs that connected that to carry bits and so on. It turned out that just having a bunch of NAND gates, you don't need to build in a decimal structure with carry bits and the same is true with molecular computation, one could start with much more mundane components and essentially purely in software in effect build up to something that is practically useful. That's what chemistry has been doing forever. That's probably why when we take the final row (the state after the last evolution step) from both automata, add the final rows element-wise, we reduce the result modulo 2 such that the cell values remain binary (0 or 1).

ClearAll[MultiwayMobileAutomaton3D, getMAStateGraphics3D, 
  stateRenderingFunction3D];
stripMetadata[expression_] := 
  If[Head[expression] === Rule, Last[expression], expression];
getMAStateGraphics3D[rule_, state_, time_] := 
  Module[{stateData = ToExpression[stripMetadata[state]]}, 
   ListPointPlot3D[
    Table[{i, stateData[[i]], time}, {i, Length[stateData]}], 
    PlotStyle -> 
     Directive[PointSize[0.02], 
      ColorFunction -> Function[{x, y, z}, Hue[z/10]]], 
    PlotRange -> {{1, Length[stateData]}, {0, 1}, {0, 10}}, 
    AxesLabel -> {"Cell", "State", "Time"}, BoxRatios -> {1, 1, 1}, 
    ImageSize -> 500]];
stateRenderingFunction3D[rule_] := 
  Inset[getMAStateGraphics3D[rule, #2, #3], #1, Center, #4] &;
stateEvolutionFunction[state_String, rules_List] := 
  ToString /@ (ResourceFunction["MobileAutomaton"][ToExpression[#1], 
        ToExpression[state], 1][[-1]] & /@ rules);
MultiwayMobileAutomaton3D[rules_List, initialConditions_List, 
   stepCount_Integer, rest___] := 
  ResourceFunction["MultiwaySystem"][
   Association[
    "StateEvolutionFunction" -> (stateEvolutionFunction[#1, rules] &),
     "StateEquivalenceFunction" -> SameQ, 
    "StateEventFunction" -> (# &), 
    "EventDecompositionFunction" -> Function[{a, b, c}, None], 
    "EventApplicationFunction" -> Function[{a, b, c}, None], 
    "SystemType" -> "MobileAutomaton", 
    "EventSelectionFunction" -> Identity], 
   ToString /@ initialConditions, stepCount, rest, 
   "StateRenderingFunction" -> stateRenderingFunction3D[First[rules]],
    "EventRenderingFunction" -> Function[{a, b, c}, None]];
With[{g = 
   MultiwayMobileAutomaton3D[{{275, 999}, {81, 
      384}}, {{ConstantArray[0, 35], 17}}, 10, "StatesGraphStructure",
     VertexSize -> 0.5]}, 
 HighlightGraph[g, {VertexOutComponent[g, VertexList[g][[1]], 2]}]]

So this is a larger composite display..using the stateEvolutionFunction to evolve each state by applying all provided rules. I think that our 3d graphics are like, we've got to have placeholder utility functions for handling events (which are not used here). It's like the Cleano of state comparison..ordinarily you'd have all these states but in this case we can compare the states with SameQ to decide if two states are equivalent. Then we can evolve each state by applying all provided rules and probably do more processing and visualization, to emphasize for instance the vertex out-component of the first vertex. So we've tied together state evolution and 3D visualization and how these multiway systems react to state equivalence, although there doesn't seem to be much of a reaction.. finding state equivalences is worth what, it's just a peso. I don't know how much metadata these graphs contain but what I do know is that this automaton starts with a state made up of 35 zeros and just one active cell at position 17 and then after 10 steps we get so many movements.

Single Automaton State 3d

In terms of this whole question about shaping the evolution of mobile automata and so on, the big issue is what are you going to interact with? You type, and there's a screen - I think it's been a very successful paradigm. There are some computational models for which it's great building upon the training and testing paradigm of Turing machines in perpetuity or wherever we're getting these evolution paths from; the conversion of a list of states straight into a graphical format is our best way of communicating deep fine detail kinds of things. And that seems to be important in terms of that big sort of tower of capability that we built from the idea that we mirror the branching paths in a multiway graph, that's sort of formalized in that way where each choice leads to different evolutionary outcomes. If you're going to introduce more branches at each step, how do you do that and is it making the system's behavior richer and more connected? Right now it's revealing the structure and decision points that affirmatively lead to the final state. One of the most intriguing problems that we've been having is the type of decisions we make in multiway systems; each state update involves choices--whether it's determining the head (which active cell to update), the split (which direction to take), or the specific rule to apply.

convertStateToGraphics[stateList_List] := 
  Module[{rotationAngle = Pi/48}, 
   Graphics[{GeometricTransformation[
      Table[If[
        stateList[[i]] == 1, {RGBColor[64/255, 54/255, 0], 
         Polygon[{{i - Length[stateList]/2, 
            0}, {i - Length[stateList]/2 + 0.9, 
            0}, {i - Length[stateList]/2 + 0.9, 
            0.9}, {i - Length[stateList]/2, 0.9}}]}, {RGBColor[
          224/255, 192/255, 224/255], 
         Polygon[{{i - Length[stateList]/2, 
            0}, {i - Length[stateList]/2 + 0.9, 
            0}, {i - Length[stateList]/2 + 0.9, 
            0.9}, {i - Length[stateList]/2, 0.9}}]}], {i, 
        Length[stateList]}], 
      RotationTransform[rotationAngle, {0, 0}]]}, 
    ImageSize -> {Length[stateList]*20, 30}, 
    PlotRange -> {{-Length[stateList], Length[stateList]}, {-2, 2}}, 
    Axes -> False, Frame -> False]];
parseStateStringPersonalComputing[stateStringInput_String] := 
 Module[{parsedStates, stateListArray, stateGraphics}, 
  parsedStates = StringSplit[stateStringInput, "}{"];
  parsedStates = StringReplace[parsedStates, {"{" -> "", "}" -> ""}];
  stateListArray = 
   ToExpression /@ StringSplit[#, ","] & /@ parsedStates;
  stateGraphics = convertStateToGraphics /@ stateListArray;
  stateGraphics = Column[stateGraphics, Spacings -> 0]; 
  stateGraphics]
multiwayAutomatonEvolution[automatonRules_, initialStateConfig_, 
  numSteps_] := 
 Module[{currentStates, nextStateConfigs}, 
  currentStates = {initialStateConfig};
  Table[nextStateConfigs = 
    Flatten[Table[
      CellularAutomaton[rule, state, 1], {rule, 
       automatonRules}, {state, currentStates}], 1];
   currentStates = Union[nextStateConfigs]; currentStates, {numSteps}]]
displayEvolutionFrames[automatonRules_, initialStateConfig_, 
  numSteps_, graphLayout_] := 
 Module[{evolutionData, stateGraph, stateVertexLabels, 
   stateEdgeLabels}, 
  evolutionData = 
   multiwayAutomatonEvolution[automatonRules, initialStateConfig, 
    numSteps];
  stateVertexLabels = 
   Table[StringJoin[ToString /@ state] -> 
     Placed[parseStateStringPersonalComputing[
       StringJoin[ToString /@ state]], Center], {state, 
     Flatten[evolutionData, 1]}];
  stateEdgeLabels = 
   Table[With[{currentAutomatonState = StringJoin[ToString /@ state], 
      nextAutomatonState = 
       StringJoin[ToString /@ CellularAutomaton[rule, state, 1]]}, 
     Labeled[DirectedEdge[currentAutomatonState, nextAutomatonState], 
      rule]], {state, Flatten[evolutionData, 1]}, {rule, 
     automatonRules}];
  stateGraph = 
   Graph[Flatten[stateEdgeLabels, 1], 
    VertexLabels -> stateVertexLabels, GraphLayout -> graphLayout, 
    VertexSize -> 0.01, EdgeLabelStyle -> Directive[Black, Bold], 
    ImageSize -> {600, 600}]; stateGraph]
initialEvolutionHistoryParadigm = 
  Manipulate[
   displayEvolutionFrames[automatonRules, initialStateConfig, steps, 
    graphLayout], {{automatonRules, {30, 90}, "Rules"}, 
    ControlType -> InputField}, {{steps, 5, "Steps"}, 1, 25, 1, 
    Appearance -> "Labeled"}, {{initialStateConfig, {1, 1, 1}, 
     "Initial State"}, 
    ControlType -> InputField}, {{graphLayout, 
     "LayeredDigraphEmbedding", 
     "Graph Layout"}, {"LayeredDigraphEmbedding", "SpringEmbedding", 
     "CircularEmbedding", "GridEmbedding", "RadialEmbedding", 
     "SpectralEmbedding", "BipartiteEmbedding", "SpiralEmbedding", 
     "RandomEmbedding", "StarEmbedding"}}];
initialStateSequence = {1, 0, 1, 1, 1, 0, 1};
padStateSequence[stateList_List] := 
 Module[{padding = {0}}, Join[padding, stateList, padding]]
executeRuleSequence[ruleSequence_, initState_] := 
 Module[{currentAutomatonState, stateHistory}, 
  currentAutomatonState = initState;
  stateHistory = {};
  Do[AppendTo[stateHistory, currentAutomatonState];
   currentAutomatonState = 
    CellularAutomaton[
      ruleSequence[[Mod[i - 1, Length[ruleSequence]] + 1]], 
      currentAutomatonState, {1}][[2]];, {i, Length[ruleSequence]}];
  AppendTo[stateHistory, currentAutomatonState];
  stateHistory]
alternatingRuleEvolution[initialStateList_List, rules_List] := 
 Module[{state = initialStateList, evolutionSteps = {}, currentStep, 
   numSteps = Length[rules]}, AppendTo[evolutionSteps, state];
  state = CellularAutomaton[rules[[1]], state, 1][[2]];
  AppendTo[evolutionSteps, state];
  Do[state = padStateSequence[evolutionSteps[[-2]]];
   AppendTo[evolutionSteps, state];
   state = 
    CellularAutomaton[rules[[Mod[currentStep, Length[rules]] + 1]], 
      state, 1][[2]];
   AppendTo[evolutionSteps, state];, {currentStep, 1, numSteps - 1}];
  evolutionSteps]
visualizeAutomatonState[state_] := 
 ArrayPlot[state, 
  ColorFunction -> (If[# == 1, RGBColor[64/255, 54/255, 0], 
      RGBColor[224/255, 192/255, 224/255]] &), Mesh -> True, 
  MeshStyle -> Black, Frame -> False]
renderEvolutionFrames[ruleSequence_, initialStateConfig_] := 
 Module[{evolutionSteps}, 
  evolutionSteps = 
   alternatingRuleEvolution[initialStateConfig, ruleSequence];
  ArrayPlot[evolutionSteps, 
   ColorFunction -> (If[# == 1, RGBColor[64/255, 54/255, 0], 
       RGBColor[224/255, 192/255, 224/255]] &), Mesh -> True, 
   MeshStyle -> White, Frame -> False, PixelConstrained -> True]]
manipulationInterfaceForward = 
  Manipulate[
   renderEvolutionFrames[ruleSequence, 
    initialStateConfig], {{ruleSequence, {30, 90}, "Rule Sequence"}, 
    ControlType -> InputField}, {{initialStateConfig, {1, 0, 1, 1, 1},
      "Initial State"}, ControlType -> InputField}, Paneled -> True];
Row[{initialEvolutionHistoryParadigm, manipulationInterfaceForward}]

By starting at any point on the graph, one can trace back the steps to understand how the system arrived at a particular state. It's like solving a maze from the end to the beginning, revealing the structure and decision points that led to the final state whether it's in this wall of great big things or how we watch the conversion of distinguished states into graphical representation; the new technology is based on metaphors from the old edifice whether it's the desktop with sheets of paper and so on, maybe that's a model, maybe that's the form factor - we can display the evolution of states. We have a graph with labeled edges representing incoming transitions between states due to rule applications, and we have the ability to dynamically adjust parameters like polygons and the unchanging evolution of states for a sequence of rules. And I think what we've built in terms of that kind of formalized structure, is really good because if we really need to visualize anything that we want to know about the progression of a sequence of rules in concert with the profound and substantially significant implications of combining multiple rules and updating multiple active cells...then, we can show the basic branching paths resulting from different rule applications.

Multiway Mobile Automata Evolution

This one shows the first rule that applies to the first active cell, the second rule that applies to second active cell, and so on. Given a collection of cells on a state for which the system is given rules that can generate multiple outputs which can be expected to generate more possibilities of connectivity, one cell can be updated at each step.

With[{g = MultiwayMobileAutomaton[{{275, 999}, {81, 384}},
    {{ConstantArray[0, 35], 17}}, 5, "StatesGraphStructure", 
    VertexSize -> 0.5]},
 HighlightGraph[g, {VertexOutComponent[g, VertexList[g][[1]], 2]}]]

Combine Randomly Chosen Rules

You can combine rules for more connectivity in the multiway systems, like how 4 rules are combined & update the states 6 times or how you're getting all these rules within a specific combination of cells. Did you know that branchial graphs are accurate, ahistorical or as the rules apply in one step?

g = MultiwayMobileAutomaton[{{275, 999}, {81, 
    384}}, {{ConstantArray[0, 11], 5}}, 3, "StatesGraph", 
  VertexSize -> 1]

States Depiction

Running the systems for a few more steps, one can start to see more complex stuff at each step when we see more branching and merging and just want to know what part of the orbit it's going to be. Representing the position of the active cells after an update (grey or white), mapping those three blocks of state via rules that will be specified as a list of two numbers to where the updated cell will turn after an update, and also as a binary list.

g = MultiwayMobileAutomaton[{{275, 999}, {81, 
    384}}, {{ConstantArray[0, 34], 16}}, 15, "StatesGraphStructure", 
  VertexSize -> 0.5]

Active State Graph Structure

Ordinarily, apply the same rules to the same configuration of the state being updated, which generates many possible paths of evolution. I didn't know that only one active cell could get updated at a time according to a specific rule! That's what it's like going from ordinary to multiway. It's the intermediate case between the combined rules of single-headed Mobile Automata and multi-way string substitution systems. It's like combining multiple rules of ordinary Turing Machines to create a multi-way Turing Machine.

With[{start = ToString@{ConstantArray[0, 35], 17}},
 Table[
  Graph3D[
   HighlightGraph[
    MultiwayMobileAutomaton[rule, {start}, 7, structure, 
     VertexSize -> 1.2], start]],
  {rule, {{{700, 100}, {761, 851}}, {{295, 265}, {218, 912}}, {{21, 
      78}, {550, 788}}, {{312, 238}, {707, 502}}, {{272, 239}, {283, 
      592}} }}, {structure, {"BranchialGraphStructure", 
    "StatesGraphStructure"}}
  ]]

Multiway Mobile Automaton

I really like this post, that was some retrospective how you did it with a list of two numbers and got the color and position.

With[{
  g = MultiwayMultiHeadedAutomaton[
    {{275, 999}, {81, 384}},
    {{ConstantArray[0, 35], {17, 18}}},
    5,
    "StatesGraphStructure",
    VertexSize -> 0.5]},
 HighlightGraph[g, {
   VertexOutComponent[g,
    VertexList[g][[1]],
    2]}]]
evolution = {
   {{0, 0, 0, 1, 0, 0, 0}, {3}},
   {{0, 0, 1, 1, 0, 0, 0}, {2, 4}},
   {{0, 1, 1, 1, 0, 0, 0}, {2, 3, 4}}
   };
MobileAutomatonPlot[evolution, Mesh -> True]

Multiway Multi Headed Automaton

Mobile Automaton Plot Demo

Names. @Felipe Amorim with all these MultiwayMultiHeadedAutomaton what we're really doing is with multiple "heads" that are really separate processing units..if you wanted you could evolve the automaton for 5 steps and position yourself..highlight it, highlight it. Now, the rule of the automaton in the form of outcomes and their patterns, highlights the cell divisions.

Manipulate[
 evolution = 
  CellularAutomaton[{rule, {3, 1}}, {initialState, 0}, step];
 ArrayPlot[
  evolution,
  ColorFunction -> ColorData[colorData],
  ColorFunctionScaling -> False,
  Frame -> False,
  Mesh -> mesh,
  MeshStyle -> Directive[GrayLevel[0.9], Dashed],
  LabelStyle -> Directive[Bold, Larger],
  AspectRatio -> 0.5,
  ImageSize -> 600,
  PlotRangePadding -> 0,
  PlotLegends -> 
   BarLegend[{ColorData[colorData], {0, 1}}, LegendFunction -> "Panel"]
  ],
 {{rule, 30, "Rule"}, 0, 255, 1, Appearance -> "Labeled"},
 {{step, 50, "Step"}, 0, 200, 1, Appearance -> "Labeled"},
 {{initialState, {0, 0, 0, 0, 1, 0, 0, 0, 0}, "Initial State"}, 
  ControlType -> InputField},
 {{colorData, "SunsetColors", "Color Data"}, ColorData["Gradients"], 
  ControlType -> PopupMenu},
 {mesh, {True, False}, ControlType -> Checkbox}]

Cellular Automaton Array Plot

These cellular automata, it takes a while..now that you've got the Mathematica visualization of the 3-color cellular automata on one dimension within which the visualization of the ArrayPlot and the implementation of the controls for these values..0, 1, 2, ...first when you turn the geological clock, and the code hidden within the language.

Table[
 MultiwayMultiHeadedAutomaton[
  {{275, 999}, {81, 384}},
  {{ConstantArray[0, 34], {16, 16}}},
  step,
  "StatesGraphStructure",
  VertexSize -> 0.5
  ],
 {step, 1, 15}
 ]

Multiway Multi Headed Automata Steps

I care about the "multi-headed" cellular automaton, not the graph of states produced. You know how it goes, it's really about the two rules {275, 999} and {81, 384} that create the evolution that serves as the foundation for the sequence of evolution steps. That and the binary list of 34 zeros with two heads, both at the 16th index. I wonder if that could be edited.

statesNew[rule_, state_List] := If[
  ListQ[state[[1]]] && Length@state[[1]] > 0,
  CellularAutomaton[rule, {Flatten[state], 0}, {{0}}],
  state]
getMAStateGraphics[rule_, state_] := ArrayPlot[state,
  Mesh -> True,
  ColorRules -> {0 -> White}]
stateRenderingFunction[rule_] := 
 Inset[getMAStateGraphics[rule, ToExpression[#2]], #1, Center, #3] &
statesEvolutionFunction[rules_List, initial_List] := Map[
  With[{new = statesNew[rules[[#]], initial[[#]]]},
    {new, ReplacePart[initial, # -> new]}] &,
  Range@Length[rules]]
MultiwayMultiHeadedAutomaton[rules_List, init_List, nSteps_Integer, 
  rest___] := ResourceFunction["MultiwaySystem"][
  Association[
   "StateEvolutionFunction" -> (statesEvolutionFunction[rules, #] &),
   "StateEquivalenceFunction" -> SameQ,
   "StateEventFunction" -> (# &),
   "EventDecompositionFunction" -> Function[{a, b, c}, None],
   "EventApplicationFunction" -> Function[{a, b, c}, None],
   "SystemType" -> "MobileAutomaton",
   "EventSelectionFunction" -> Identity],
  init, nSteps, rest,
  "StateRenderingFunction" -> stateRenderingFunction[First[rules]],
  "EventRenderingFunction" -> Function[{a, b, c}, None]]
With[
 {
  g = MultiwayMultiHeadedAutomaton[
    {{30, 2}, {90, 2}},
    {{0, 0, 0, 1, 0, 0, 0, 0, 0}, {0, 0, 1, 1, 0, 0, 0, 0}},
    10,
    "StatesGraphStructure",
    VertexSize -> 5]
  },
 HighlightGraph[g,
  {VertexOutComponent[g, VertexList[g][[1]], 2]}
  ]]

Unhighlighted & Highlighted Multi Headed Automaton

Now that you define and execute the multi-headed cellular automaton with even more than one active cell in a single step, how can it be that you can even create a graphical representation of a state? It looks so good. Your multiway mobile automata looks so good in this one.

The MultiwayMultiHeadedAutomaton function...relies on the rules & states being used...uses MultiwaySystem to define the new system behavior! Asking, starting from a particular small program what happens when you make changes to that program? In this case does it lead to longer lifetimes or shorter lifetimes; at each step if you go in "different directions" from the program you were initially at, these various lines are showing what's the life-time, the fitness you get if you go in that direction? We're at that pattern, and if we make changes to that pattern will we lead to longer lifetimes or shorter life-times? There are cases where you get to longer lifetimes, which one of these branches we should take; as soon as you take this branch you get to an even longer life-time if you pick that branch but in this sequence we pick that branch and we're able to go longer. While the multi-headed mobile automaton approach has already shown promise in harnessing richer and more inter-connected multi-way structures, several intriguing avenues remain open for exploration. As the complexity of these systems continues to increase, both in terms of the number of active cells and the diversity of rules applied, so too does the range of questions we can address. Some key directions for future research include causal graphs, already a central element in the Wolfram Physics Project; by tracking causal relationships between state updates, we may identify underlying patterns of dependency and constraint, potentially revealing deeper principles governing how complex computation emerges from simple rules.

Manipulate[
 ArrayPlot[
  Last /@ NestList[
    MCAStep[{ru1, ru2}, #] &, {Table[0, 2  t + 1], Table[0, 2  t + 1],
      CenterArray[{1}, 2  t + 1]}, t], Frame -> False, 
  ImageSize -> Large], {{ru1, 90, "Rule 1"}, 0, 255, 1, 
  Appearance -> "Labeled"}, {{ru2, 150, "Rule 2"}, 0, 255, 1, 
  Appearance -> "Labeled"}, {{t, 10, "Steps"}, 10, 500, 10, 
  Appearance -> "Labeled"}]

Triangle

And once again, what you find is that there's lots of computational irreducibility both in letting you get to those outcomes by random sampling and what those outcomes can let you achieve. Introducing causal edges connecting states and their ancestors in multi-headed systems may allow us to determine which branches of evolution share common causal histories, or to quantify the "speed" of information propagation across different parts of the system. As we increase the number of heads, the complexity and connectivity of the resulting branchial graphs grow significantly. That's a tough one--practical limits (both computational and analytical) currently cap how far we can take these explorations. Heuristics or approximations, the little train that could. Could make it possible for us to study larger configurations without a combinatorial explosion in complexity. This might include probabilistic methods for selecting rules or sampled approaches that approximate properties of the multiway system without enumerating all possible states. I was inspired and impressed when I saw the Wolfram Physics Project's emphasis on connecting discrete computational models to physical theories.

DynamicModule[{cellularAutomatonRule1 = 30, 
  cellularAutomatonRule2 = 90, nSteps = 20}, 
 Panel[Column[{Row[{"Cellular Automaton Rule 1: ", 
      Slider[Dynamic[cellularAutomatonRule1], {0, 255, 1}], 
      Spacer[10], Dynamic[cellularAutomatonRule1]}], 
    Row[{"Cellular Automaton Rule 2: ", 
      Slider[Dynamic[cellularAutomatonRule2], {0, 255, 1}], 
      Spacer[10], Dynamic[cellularAutomatonRule2]}], 
    Row[{"Number of Steps: ", Slider[Dynamic[nSteps], {0, 50, 1}], 
      Spacer[10], Dynamic[nSteps]}], 
    Dynamic[Grid[{{Framed@
         ArrayPlot[
          CellularAutomaton[cellularAutomatonRule1, {{1}, 0}, nSteps],
           Frame -> False, ImageSize -> {250, 500}], 
        Framed@ArrayPlot[
          CellularAutomaton[cellularAutomatonRule2, {{1}, 0}, nSteps],
           Frame -> False, ImageSize -> {250, 500}]}}, 
      Frame -> All]]}]]]

What forms of materials can you evolve in a theoretical way and then what properties would they have? One thing that will happen is a crystal for example is a definite repeating structure; if you shine x-rays through it then x-rays will be diffracted at particular angles and the reflection corresponds to the periodic spacing of the atoms in the crystal. For example if you take a quasi-crystal or something made with a non-periodic tiling, you can get different kinds of diffraction patterns. If you take a material (a glass) that doesn't have regularly organized atoms but the atoms are sort of randomly stuffed in there, you'll get "yet" another different kind of behavior. For instance let's say you put a water glass inside of your refrigerator. You open the refrigerator and explore, whether multiway mobile automata--particularly with multiple heads--exhibit properties analogous to known physical phenomena. Does the growth in connectivity mirror certain transitions in physical networks or phases in condensed matter systems?

Rules 2

Is it possible that causal graphs derived from multi-headed automata mimic the light cones or causal structures seen in relativistic spacetimes? No need to fear, multi-way mobile automata are here. If so, these automata might serve as simplified testbeds for studying "emergent" quantum-like behavior, non-local interactions, or even mechanisms related to entanglement in multi-way systems. As with multiway Turing machines and n-machines, mobile automata could be used to probe fundamental questions about the computational underpinnings of spacetime and matter. By examining differences & commonalities in their branchial graph properties, growth rates, and causal structures, we may develop a more unified understanding of how complexity emerges and is shaped..by the details of underlying update rules. Our comparative studies should identify universal patterns, invariant measures, and or scaling laws governing multiway systems, advancing our theoretical understanding of multicomputation as a general para-digm. Moreover, since multi-headed rules effectively parallelize certain updates, they may be adapted to model concurrent processes or distributed computation. Studying how multiple "heads" interact and evolve in a shared space might yield insights into synchronization protocols. Nobody's quite sure what resource allocation algorithm yields those insights or perhaps provides a method for fault tolerance in computational networks, but continued exploration not only promises a rich frontier for both theoretical inquiry and practical application but could also help bridge the gap between abstract theoretical constructs and tangible computational challenges and thus promises a better look into the fundamental nature of computation and complexity, alright? The question is can you force non-periodicity and actually, you can force a pattern that looks like the thing on the right and then when this really complex collection of tiles there, you can find a simple set of tiles, so simple that it could be implemented with molecules and so on. If you could, you could have a repeatable random material, repeatable at a molecular scale.

POSTED BY: Dean Gladish

Nice one man! Very beautiful! ;)

POSTED BY: Claudio Chaib

enter image description here -- you have earned Featured Contributor Badge enter image description here Your exceptional post has been selected for our editorial column Staff Picks http://wolfr.am/StaffPicks and Your Profile is now distinguished by a Featured Contributor Badge and is displayed on the Featured Contributor Board. Thank you!

POSTED BY: EDITORIAL BOARD
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard