Main version
Main version
Sequential multiway system (resort the StringPosition to get other updating schedules)
SMWEvolveList[rule_,s_,n_]:=NestList[SMWStep[rule,#]&,s,n]
SMWStep[rule_,s_]:=SMWStep1[rule,s,SMWFilter[StringPosition[s,First/@rule]]]
SMWFilter[s_]:=Fold[If[Last[Last[#1]]>=First[#2],#,Append[#,#2]]&,{First[s]},Rest[s]]
SMWFilter[{}]={};
SMWStep1[rule_,s_,pos_]:=StringReplacePart[s,(StringTake[s,#]&/@pos)/.rule,pos]
SMWStep1[rule_,s_,{}]:=s
Evolution with backward scanning of rules
SMWEvolveList[rule_,s_,n_,Backward]:=NestList[SMWStepBackward[rule,#]&,s,n]
SMWStepBackward[rule_,s_]:=SMWStep1[rule,s,Reverse[SMWFilterBackward[Reverse[StringPosition[s,First/@rule]]]]]
SMWFilterBackward[s_]:=Fold[If[First[Last[#1]]<=Last[#2],#,Append[#,#2]]&,{First[s]},Rest[s]]
SMWFilterBackward[{}]={};
Evolution with first position only (absolute first position, picking any rule)
SMWEvolveList[rule_,s_,n_,First]:=NestList[SMWStepFirst[rule,#]&,s,n]
SMWStepFirst[rule_,s_]:=SMWStep1[rule,s,StringPosition[s,First/@rule,1]]
Evolution like sequential substitution system
SMWEvolveList[rule_,s_,n_,SSS]:=NestList[SMWStepSSS[rule,#]&,s,n]
SMWStepSSS[rule_,s_]:=SMWStep1[rule,s,If[#==={},{},{First[#]}]&[Flatten[StringPosition[s,First[#],1]&/@rule,1]]]
Version set up to be able to see replacements
Version set up to be able to see replacements
SMWEvolveListX[rule_,s_,n_]:=NestList[SMWStepX[rule,First[#]]&,{s},n]
SMWStepX[rule_,s_]:=Module[{q,z},z=SMWStep1X[rule,s,q=SMWFilter[StringPosition[s,First/@rule]]];{StringReplace[z,{"<"->"",">"->""}],MapThread[Rule,{q,FinalPositions[z]}]}]
SMWStep1X[rule_,s_,pos_]:=StringReplacePart[s,(StringTake[s,#]&/@pos)/.ModRules[rule],pos]
SMWStep1X[rule_,s_,{}]:=s
ModRules[rule_]:=(First[#]->StringJoin["<",Last[#],">"])&/@rule
FinalPositions[s_]:=(#-2(Range[Length[#]]-1))&[Transpose[{First/@StringPosition[s,"<"],First/@StringPosition[s,">"]-2}]]
SMWEvolveListX[rule_,s_,n_,Backward]:=NestList[SMWStepXBackward[rule,First[#]]&,{s},n]
SMWStepXBackward[rule_,s_]:=Module[{q,z},z=SMWStep1X[rule,s,q=Reverse[SMWFilterBackward[Reverse[StringPosition[s,First/@rule]]]]];{StringReplace[z,{"<"->"",">"->""}],MapThread[Rule,{q,FinalPositions[z]}]}]
SMWEvolveListX[rule_,s_,n_,First]:=NestList[SMWStepXFirst[rule,First[#]]&,{s},n]
SMWStepXFirst[rule_,s_]:=Module[{q,z},z=SMWStep1X[rule,s,q=StringPosition[s,First/@rule,1]];{StringReplace[z,{"<"->"",">"->""}],MapThread[Rule,{q,FinalPositions[z]}]}]
SMWEvolveListX[rule_,s_,n_,SSS]:=NestList[SMWStepXSSS[rule,First[#]]&,{s},n]
SMWStepXSSS[rule_,s_]:=Module[{q,z},z=SMWStep1X[rule,s,q=If[#==={},{},{First[#]}]&[Flatten[StringPosition[s,First[#],1]&/@rule,1]]];{StringReplace[z,{"<"->"",">"->""}],MapThread[Rule,{q,FinalPositions[z]}]}]
Random updates
Random updates
SMWEvolveListRandomX[rule_,s_,n_,max_:1]:=NestList[SMWStepRandomX[rule,First[#],max]&,{s},n]
SMWStepRandomX[rule_,s_,max_]:=Module[{q,z},z=SMWStep1X[rule,s,q=SMWFilterRandom[StringPosition[s,First/@rule],max]];{StringReplace[z,{"<"->"",">"->""}],MapThread[Rule,{q,FinalPositions[z]}]}]
SMWFilterRandom[{},_]={};
SMWFilterRandom[s_,max_]:=Sort[Block[{used={}},Nest[SFR0,s,max];used]]
SFR0[{}]={};
SFR0[s_]:=Module[{i=Random[Integer,{1,Length[s]}],s0,s1},{s0,s1}=s[[i]];If[Select[used,((s0<=First[#]&&s1>=First[#])||(s0<=Last[#]&&s1>=Last[#])||(s0>=First[#]&&s1<=Last[#])||(s0<=First[#]&&s1>=Last[#]))&]==={},AppendTo[used,s[[i]]];Drop[s,{i}],s]]
Cyclic evolution
Cyclic evolution
SMWCyclicEvolveListX[rule_,s_,n_]:=NestList[SMWCyclicStepX[rule,First[#],Max[StringLength[First[#]]&/@rule]-1]&,{s},n]
SMWCyclicStepX[rule_,s_,max_]:=Module[{q,z,ss,addon,beg,end}, addon=Min[StringLength[s],max]; ss=StringJoin[s,StringTake[s,addon]]; q=SMWFilter[StringPosition[ss,First/@rule]]; q=Cases[q,{x_,y_}/;y<=StringLength[s]||y-StringLength[s]<q〚1,1〛]; beg=If[Length[q]>0,Max[Last[q]〚2〛-StringLength[s],0],0]; end=If[Length[q]>0,addon-Max[0,Last[q]〚2〛-StringLength[s]],addon]; z=StringDrop[StringDrop[SMWStep1X[rule,ss,q],beg],-end]; (* If[Last[q]〚2〛>StringLength[s],q〚Length[q]〛={q〚Length[q],1〛,StringLength[s],q〚Length[q],2〛-StringLength[s]}];*) {StringReplace[z,{"<"->"",">"->""}],MapThread[Rule,{q,FinalPositions[z]}]}]
Network evolution
Network evolution
SMWEvolveListNW[rule_,s_,n_]:=TransformNW[SMWEvolveListNW0[SMWEvolveListX[rule,s,n]]]
SMWEvolveListNW0::usage="The input to SMWEvolveListNW0[v_] is the output from SMWEvolveListX. The output is a list of the edges in the causal network. Each edge is of the form {{w,x},{y,z}} where w is the starting node, x is the spatial position on that node (relative to the left-hand side of the whole space, not to the left-hand side of the node), and similarly y is the finishing node and z is the spatial position on that node. Note that the initial state is considered to be node 0. Edges which constitute the final state are not included unless the option AddFinalNode is set to True, in which case the final state is also considered to be a node. If IncludeColors->True, then the edge is listed as {{w,x},{y,z},C} where C is the color of the edge (by color I mean the character associated with the edge; typically this is some capital letter like A or B).";
Options[SMWEvolveListNW0]={AddFinalNode->False,IncludeColors->False};
SMWEvolveListNW0[v_,opts___?OptionQ]:= Module{nw={},c=1,state={0,#,StringTake[v〚1,1〛,{#}]}&/@Range[StringLength[v〚1,1〛]],newstate,addfinalnode,includecolors},{addfinalnode,includecolors}={AddFinalNode,IncludeColors}/.{opts}/.Options[SMWEvolveListNW0]; Functiony,IfLength[y〚2〛]>0,newstate=stateRange[1,y〚2,1,1,1〛-1];MapIndexedFunction{z,w},newstate=Join[newstate,{c,#,StringTake[y〚1〛,{#}]}&/@Range@@z〚2〛];nw=Join[nw,If[includecolors,{state〚#,{1,2}〛,{c,#},state〚#,3〛},{state〚#,{1,2}〛,{c,#}}]&/@Range@@z〚1〛]; newstate=Joinnewstate,IfFirst[w]==Length[y〚2〛], stateRange[z〚1,2〛+1,Length[state]], stateRange[z〚1,2〛+1,y〚2,First[w]+1,1,1〛-1]; c++,y2;state=newstate/@Rest[v];If[addfinalnode,nw=Join[nw,MapIndexed[If[includecolors,{#1〚{1,2}〛,{c,First[#2]},#1〚3〛},{#1〚{1,2}〛,{c,First[#2]}}]&,state]]]; nw
Network cyclic evolution
Network cyclic evolution
Cauchy surface routines
Cauchy surface routines
Graphics
Graphics
SMW Rule Graphics
SMW Rule Graphics
Directed Neighbors
Directed Neighbors
Note that SMWNetworkPicture has been decomposed into two parts: SMWNetwork and DNPicture. The first generates data needed for the graphic; the second generates the graphic.
Replaced with code suggested by Todd Rowland to fix bug
SMWsort
SMWsort
DNPcoords
DNPcoords
DNPgetcolor
DNPgetcolor
QuadraticCurve
QuadraticCurve
DirectedNeighborsPicture
DirectedNeighborsPicture
The following is a modification of SMWNetworkPicture meant to work with any directed network of the form {1->{2,3,3,5},2->{3,∞},3->{},} and so on. It takes input like this and converts it using DirectedNetworkToNW1 into a form similar to that used in SMWNetworkPicture. The sort routine could be made way shorter and I haven't really checked it carefully, but it might work.
Utilities for Testing and Searching
Utilities for Testing and Searching
Rule Generation
Rule Generation
Enumerate all rules with {LHS,RHS} lengths up to {m,n}:
Initial States etc.
Initial States etc.
Generate all strings of length at most n:
Evolution Functions
Evolution Functions
General Behavior Testing
General Behavior Testing
Overlap Testing
Overlap Testing
Test whether there is any overlap of rule LHSs with a given string (i.e. whether any choices have to be made in the application of the rule)
Basic String Overlap Testing
Basic String Overlap Testing
Multiway initialization
Multiway initialization
MA emulation
MA emulation
CA emulation
CA emulation