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.
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]}]]
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]
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]
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"}}
]]
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]
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}]
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}
]
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]}
]]
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!
