From: A New Kind of Science, by Stephen Wolfram © 2002 Stephen Wolfram, LLC

The World of Simple Programs

More Cellular Automata

({{Rule 150,  (page 885)}})

Apply[Times,Map[((2^(  #+2))-(((-1))^(  #+2)))/3&,Cases[Split[IntegerDigits[t,2]],k:{(1)..}:>Length[k]]]]

Table[Apply[Times,Map[((2^( #+2))-(((-1))^( #+2)))/3&,Cases[Split[IntegerDigits[t,2]],k:{(1)..}:>Length[k]]]],{t,0,4}]

({{Two-cell neighborhoods,  (page 885)}})

CAStep[{k_,rule_},a_List]:=rule[[(k^(  2))-RotateLeft[a]-k a]]

CAStep[{k_,rule_},a_List]:=rule[[(k^(  2))-RotateLeft[a]-k a]]

Grid[NestList[CAStep[{3,IntegerDigits[7743,3,(3^2)]},#]&,{0,0,0,0,0,2,0,0,0,0,0},5]]

({{Implementation of general cellular automata,  (page 886)}})

CAStep[CARule[rule_List,k_,r_],a_List]:=rule[[-1-ListConvolve[k^Range[0,2 r],a,r+1]]]

CAStep[CARule[rule_List,k_,r_],a_List]:=rule[[-1-ListConvolve[k^Range[0,2 r],a,r+1]]]

Grid[With[{k=2,r=1,num=30},NestList[CAStep[CARule[IntegerDigits[num,k,(k^(2 r+1))],k,r],#]&,{0,0,0,0,0,1,0,0,0,0,0},5]]]

({{Implementation of totalistic cellular automata,  (page 886)}})

CAStep[TotalisticCARule[rule_List,r_Integer],a_List]:=rule[[-1-Sum[RotateLeft[a,i],{i,-r,r}]]]

ToTotalisticCARule[num_Integer,k_Integer,r_Integer]:=TotalisticCARule[IntegerDigits[num,k,1+(k-1) (2 r+1)],r]

CAStep[TotalisticCARule[rule_List,1],a_List]:=rule[[-1-(RotateLeft[a]+a+RotateRight[a])]]
CAStep[TotalisticCARule[rule_List,r_Integer],a_List]:=rule[[-1-Sum[RotateLeft[a,i],{i,-r,r}]]]
ToTotalisticCARule[num_Integer,k_Integer,r_Integer]:=TotalisticCARule[IntegerDigits[num,k,1+(k-1) (2 r+1)],r]

Grid[NestList[CAStep[ToTotalisticCARule[777,3,1],#]&,{0,0,0,0,0,1,0,0,0,0,0},5]]

({{Rules based on algebraic systems,  (page 886)}})

a[t_,i_]:=f[a[t-1,i-1],a[t-1,i]]

NestList[f[RotateRight[#],#]&,init,t]

Grid[With[{f=Times,init={-1,1,1,1,1,1,1,1,1,1,1},t=10},a[t_,i_]:=f[a[t-1,i-1],a[t-1,i]];NestList[f[RotateRight[#],#]&,init,t]/.{-1->1,1->0}]]

Mobile Automata

({{Implementation,  (page 887)}})

{{1,1,1}->{0,1},{1,1,0}->{0,1},{1,0,1}->{1,-1},{1,0,0}->{0,-1},{0,1,1}->{0,-1},{0,1,0}->{0,1},{0,0,1}->{1,1},{0,0,0}->{1,-1}}

MAStep[rule_,{list_List,n_Integer}]/;1<n<Length[list]:=Apply[{ReplacePart[list,#1,n],n+#2}&,Replace[Take[list,{n-1,n+1}],rule]]

MAEvolveList[rule_,init_List,t_Integer]:=NestList[MAStep[rule,#]&,init,t]

MAStep[rule_,{list_List,n_Integer}]/;1<n<Length[list]:=Apply[{ReplacePart[list,#1,n],n+#2}&,Replace[Take[list,{n-1,n+1}],rule]]
MAEvolveList[rule_,init_List,t_Integer]:=NestList[MAStep[rule,#]&,init,t]

MAEvolveList[{{1,1,1}->{0,1},{1,1,0}->{0,1},{1,0,1}->{1,-1},{1,0,0}->{0,-1},{0,1,1}->{0,-1},{0,1,0}->{0,1},{0,0,1}->{1,1},{0,0,0}->{1,-1}},{Table[0,{15}],7},5]

{{1,1,1}->{{0,0,0},-1},{1,1,0}->{{1,0,1},-1},{1,0,1}->{{1,1,1},1},{1,0,0}->{{1,0,0},1},{0,1,1}->{{0,0,0},1},{0,1,0}->{{0,1,1},-1},{0,0,1}->{{1,0,1},1},{0,0,0}->{{1,1,1},1}}

MAStep[rule_,{list_List,n_Integer}]/;1<n<Length[list]:=Apply[{Join[Take[list,{1,n-2}],#1,Take[list,{n+2,-1}]],n+#2}&,Replace[Take[list,{n-1,n+1}],rule]]

MAStep[rule_,{list_List,n_Integer}]/;1<n<Length[list]:=Apply[{Join[Take[list,{1,n-2}],#1,Take[list,{n+2,-1}]],n+#2}&,Replace[Take[list,{n-1,n+1}],rule]]
MAEvolveList[rule_,init_List,t_Integer]:=NestList[MAStep[rule,#]&,init,t]

MAEvolveList[{{1,1,1}->{{0,0,0},-1},{1,1,0}->{{1,0,1},-1},{1,0,1}->{{1,1,1},1},{1,0,0}->{{1,0,0},1},{0,1,1}->{{0,0,0},1},{0,1,0}->{{0,1,1},-1},{0,0,1}->{{1,0,1},1},{0,0,0}->{{1,1,1},1}},{Table[0,{15}],7},5]

({{Implementation of generalized mobile automata,  (page 887)}})

GMAStep[rules_,{list_,nlist_}]:=Module[{a,na},{a,na}=Transpose[Map[Replace[Take[list,{#-1,#+1}],rules]&,nlist]];{Fold[ReplacePart[#1,Last[#2],First[#2]]&,list,Transpose[{nlist,a}]],Union[Flatten[nlist+na]]}]

GMAStep[rules_,{list_,nlist_}]:=Module[{a,na},{a,na}=Transpose[Map[Replace[Take[list,{#-1,#+1}],rules]&,nlist]];{Fold[ReplacePart[#1,Last[#2],First[#2]]&,list,Transpose[{nlist,a}]],Union[Flatten[nlist+na]]}]

NestList[GMAStep[{{0,0,0}->{1,{1,-1}},{0,0,1}->{1,{-1}},{0,1,0}->{1,{1,-1}},{0,1,1}->{1,{-1}},{1,0,0}->{1,{1,0}},{1,0,1}->{1,{1}},{1,1,0}->{0,{1}},{1,1,1}->{0,{1}}},#]&,{Table[0,{23}],{11}},5]

Turing Machines

({{Implementation,  (page 888)}})

{{1,0}->{3,1,-1},{1,1}->{2,0,1},{2,0}->{1,1,1},{2,1}->{3,1,1},{3,0}->{2,1,1},{3,1}->{1,0,-1}}

TMStep[rule_List,{s_,a_List,n_}]/;1≤n≤Length[a]:=Apply[{#1,ReplacePart[a,#2,n],n+#3}&,Replace[{s,a[[n]]},rule]]

TMEvolveList[rule_,init_List,t_Integer]:=NestList[TMStep[rule,#]&,init,t]

TMStep[rule_List,{s_,a_List,n_}]/;1≤n≤Length[a]:=Apply[{#1,ReplacePart[a,#2,n],n+#3}&,Replace[{s,a[[n]]},rule]]
TMEvolveList[rule_,init_List,t_Integer]:=NestList[TMStep[rule,#]&,init,t]

TMEvolveList[{{1,0}->{3,1,-1},{1,1}->{2,0,1},{2,0}->{1,1,1},{2,1}->{3,1,1},{3,0}->{2,1,1},{3,1}->{1,0,-1}},{1,Table[0,{30}],15},5]

TMStep[rule_,c_]:=Replace[c,{a___,x_,h_List,y_,b___}:>Apply[{{a,x,#2,{#1,y},b},{a,{#1,x},#2,y,b}}[[#3]]&,h/.rule]]

TMEvolveList[rule_,init_List,t_Integer]:=NestList[TMStep[rule,#]&,init,t]
TMStep[rule_,c_]:=Replace[c,{a___,x_,h_List,y_,b___}:>Apply[{{a,x,#2,{#1,y},b},{a,{#1,x},#2,y,b}}[[#3]]&,h/.rule]]

TMEvolveList[{{1,0}->{3,1,-1},{1,1}->{2,0,1},{2,0}->{1,1,1},{2,1}->{3,1,1},{3,0}->{2,1,1},{3,1}->{1,0,-1}},{0,0,0,0,0,0,0,0,0,0,0,0,0,0,{1,0},0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},5]

s=1;a[_]=0;n=0;Do[{s,a[n],d}={s,a[n]}/.rule;n+=d,{t}]

Block[{t=5,a,s,n},s=1;a[_]=0;n=0;Do[{s,a[n],d}={s,a[n]}/.{{1,0}->{3,1,-1},{1,1}->{2,0,1},{2,0}->{1,1,1},{2,1}->{3,1,1},{3,0}->{2,1,1},{3,1}->{1,0,-1}};n+=d,{t}];
{s,Table[a[i],{i,-5,5}],n}]

({{Numbering scheme,  (page 888)}})

Flatten[MapIndexed[{1,-1} #2+{0,k}->{1,1,2} Mod[Quotient[#1,{2 k,2,1}],{s,k,2}]+{1,0,-1}&,Partition[IntegerDigits[n,2 s k,s k],k],{2}]]

Sort[With[{s=2,k=2,n=3024},Flatten[MapIndexed[{1,-1} #2+{0,k}->{1,1,2} Mod[Quotient[#1,{2 k,2,1}],{s,k,2}]+{1,0,-1}&,Partition[IntegerDigits[n,2 s k,s k],k],{2}]]]]

Substitution Systems

({{Implementation,  (page 889)}})

SSEvolveList[rule_,init_List,t_Integer]:=NestList[Flatten[#/.rule]&,init,t]

SSEvolveList[rule_,init_List,t_Integer]:=NestList[Flatten[#/.rule]&,init,t]

SSEvolveList[{1->{1,0},0->{0,1}},{1},5]

SSEvolveList[rule_,init_String,t_Integer]:=NestList[StringReplace[#,rule]&,init,t]

SSEvolveList[rule_,init_String,t_Integer]:=NestList[StringReplace[#,rule]&,init,t]

SSEvolveList[ {"B"->"BA","A"->"AB"},"B",5]

{{1,1}->{0,1},{1,0}->{1,0},{0,1}->{0},{0,0}->{0,1}}

SS2EvolveList[rule_,init_List,t_Integer]:=NestList[Flatten[Partition[#,2,1]/.rule]&,init,t]

SS2EvolveList[rule_,init_List,t_Integer]:=NestList[Flatten[Partition[#,2,1]/.rule]&,init,t]

SS2EvolveList[{{1,1}->{0,1},{1,0}->{1,0},{0,1}->{0},{0,0}->{0,1}},{0,1,1,0},3]

({{Page 83 · Properties,  (page 889)}})

(CoefficientList[Product[1-(z^(  (2^(  s)))),{s,0,m-1}],z]+1)/2

With[{m=3},(CoefficientList[Product[1-z^(2^s),{s,0,m-1}],z]+1)/2]

Mod[CoefficientList[Series[(1+Sqrt[(1-3 x)/(1+x)])/(2 (1+x)),{x,0,n-1}],x],2]

With[{n=16},Mod[CoefficientList[Series[(1+Sqrt[(1-3 x)/(1+x)])/(2 (1+x)),{x,0,n-1}],x],2]]

If[OddQ[n],Sign[Mod[Binomial[n-1,(n-1)/2],3]],0,1]

Table[If[OddQ[n],Sign[Mod[Binomial[n-1,(n-1)/2],3]],0,1],{n,1,27}]

({{Fibonacci numbers,  (page 890)}})

f[n_]:=f[n]=f[n-1]+f[n-2]

f[1]=f[2]=1

f[n_]:=f[n]=f[n-1]+f[n-2]
f[1]=f[2]=1;

Table[f[n],{n,1,10}]

f[{a_,b_,s_},0]={a (a+2 b),s+a (2 a-b),1}

f[{a_,b_,s_},1]={-s+(a+b) (a+2 b),a (a+2 b),-1}

First[Fold[f,{1,0,-1},Rest[IntegerDigits[n,2]]]]

f[{a_,b_,s_},0]={a (a+2 b),s+a (2 a-b),1};
f[{a_,b_,s_},1]={-s+(a+b) (a+2 b),a (a+2 b),-1};

Table[First[Fold[f,{1,0,-1},Rest[IntegerDigits[n,2]]]],{n,1,10}]

Flatten[Array[NestList[RotateRight,{0,(((-1))^(  #1)) GoldenRatio,(((-1))^(  #2))},3]&,{2,2}],2]

Flatten[Array[NestList[RotateRight,{0,(((-1))^(  #1)) GoldenRatio,(((-1))^(  #2))},3]&,{2,2}],2]//N

({{Connections with digit sequences,  (page 891)}})

Fold[Replace[{#1,#2},rule]&,1,IntegerDigits[n-1,2]]

Table[Fold[
Replace[{#1,#2},{{0,0}->0,{0,1}->1,{1,0}->1,{1,1}->0}]&,1,IntegerDigits[n-1,2]],{n,8}]

Fold[rule[[#1,#2]]&,1,IntegerDigits[n-1,k]+1]-1

With[{k=2,rule={{1,2},{2,1}}},Table[Fold[rule[[#1,#2]]&,1,IntegerDigits[n-1,k]+1]-1,{n,8}]]

Nest[Flatten[rule[[#]]]&,1,m]-1

With[{m=3,rule={{1,2},{2,1}}},Nest[Flatten[rule[[#]]]&,1,m]-1]

({{Page 84 · Other examples,  (page 892)}})

1-Mod[Flatten[Partition[FoldList[Plus,0,list],1,2]],2]

1-Mod[Flatten[Partition[FoldList[Plus,0,Table[Mod[IntegerExponent[i,2],2],{i,1,15}]],1,2]],2]

Sequential Substitution Systems

({{Implementation,  (page 893)}})

Attributes[s]=Flat

s[1,0]->s[0,1,0]

{s[0,1,0]->s[0,0,1],s[0]->s[0,1,0]}

SSSEvolveList[rule_,init_s,t_Integer]:=NestList[#/.rule&,init,t]

Attributes[s]=Flat;
SSSEvolveList[rule_,init_s,t_Integer]:=NestList[#/.rule&,init,t]

SSSEvolveList[s[1,0]->s[0,1,0],s[1,0,1,0],3]

SSSEvolveList[{s[0,1,0]->s[0,0,1],s[0]->s[0,1,0]},s[1,0,1,0],3]

Tag Systems

({{Implementation,  (page 894)}})

{2,{{0,0}->{1,1},{1,0}->{},{0,1}->{1,0},{1,1}->{0,0,0}}}

TSEvolveList[{n_,rule_},init_,t_]:=NestList[If[Length[#]<n,{},Join[Drop[#,n],Take[#,n]/.rule]]&,init,t]

TSEvolveList[{n_,rule_},init_,t_]:=NestList[If[Length[#]<n,{},Join[Drop[#,n],Take[#,n]/.rule]]&,init,t]

TSEvolveList[{2,{{0,0}->{1,1},{1,0}->{},{0,1}->{1,0},{1,1}->{0,0,0}}},{1,1},5]

{{0,0,s___}->{s,1,1},{1,0,s___}->{s},{0,1,s___}->{s,1,0},{1,1,s___}->{s,0,0,0}}

NestList[#/.{{0,0,s___}->{s,1,1},{1,0,s___}->{s},{0,1,s___}->{s,1,0},{1,1,s___}->{s,0,0,0}}&,{1,1},5]

Cyclic Tag Systems

({{Implementation,  (page 895)}})

CTEvolveList[rules_,init_,t_]:=Map[Last,NestList[CTStep,{rules,init},t]]

CTStep[{{r_,s___},{0,a___}}]:={{s,r},{a}}

CTStep[{{r_,s___},{1,a___}}]:={{s,r},Join[{a},r]}

CTStep[{u_,{}}]:={u,{}}

CTEvolveList[rules_,init_,t_]:=Map[Last,NestList[CTStep,{rules,init},t]]
CTStep[{{r_,s___},{0,a___}}]:={{s,r},{a}}
CTStep[{{r_,s___},{1,a___}}]:={{s,r},Join[{a},r]}
CTStep[{u_,{}}]:={u,{}}

CTEvolveList[{{1,1},{1,0}},{1},5]

CTList[rules_,init_,t_]:=Flatten[Map[Last,NestList[CTListStep,{rules,init},t]]]

CTListStep[{rules_,list_}]:={RotateLeft[rules,Length[list]],Flatten[rules[[Mod[Flatten[Position[list,1]],Length[rules],1]]]]}

CTList[rules_,init_,t_]:=Flatten[Map[Last,NestList[CTListStep,{rules,init},t]]]
CTListStep[{rules_,list_}]:={RotateLeft[rules,Length[list]],Flatten[rules[[Mod[Flatten[Position[list,1]],Length[rules],1]]]]}

CTList[{{1,1},{1,0}},{1},5]

({{Page 95 · Generalizations,  (page 895)}})

CTStep[{{r_,s___},{n_,a___}}]:={{s,r},Flatten[{a,Table[r,{n}]}]}

CTListStep[{rules_,list_}]:={RotateLeft[rules,Length[list]],With[{n=Length[rules]},Flatten[Apply[Table[#1,{#2}]&,Map[Transpose[{rules,#}]&,Partition[list,n,n,1,0]],{2}]]]}

CTList[rules_,init_,t_]:=Flatten[Map[Last,NestList[CTListStep,{rules,init},t]]]
CTStep[{{r_,s___},{n_,a___}}]:={{s,r},Flatten[{a,Table[r,{n}]}]}
CTListStep[{rules_,list_}]:={RotateLeft[rules,Length[list]],With[{n=Length[rules]},Flatten[Apply[Table[#1,{#2}]&,Map[Transpose[{rules,#}]&,Partition[list,n,n,1,0]],{2}]]]}

CTList[{{1,1},{1,0}},{1},5]

({{Page 96 · Properties,  (page 895)}})

Flatten[{1,0,CTList[{{1,0,0,1},{0,1,1,0}},{0,1},t]}]

CTList[rules_,init_,t_]:=Flatten[Map[Last,NestList[CTListStep,{rules,init},t]]]
CTListStep[{rules_,list_}]:={RotateLeft[rules,Length[list]],Flatten[rules[[Mod[Flatten[Position[list,1]],Length[rules],1]]]]}

With[{t=4},Flatten[{1,0,CTList[{{1,0,0,1},{0,1,1,0}},{0,1},t]}]]

({{History,  (page 895)}})

Join[{1,2},Map[First,CTEvolveList[{{1},{2}},{2},t]]]

CTEvolveList[rules_,init_,t_]:=Map[Last,NestList[CTStep,{rules,init},t]]
CTStep[{{r_,s___},{n_,a___}}]:={{s,r},Flatten[{a,Table[r,{n}]}]}
CTListStep[{rules_,list_}]:={RotateLeft[rules,Length[list]],With[{n=Length[rules]},Flatten[Apply[Table[#1,{#2}]&,Map[Transpose[{rules,#}]&,Partition[list,n,n,1,0]],{2}]]]}

With[{t=4},Join[{1,2},Map[First,CTEvolveList[{{1},{2}},{2},t]]]]

Register Machines

({{Implementation,  (page 896)}})

{i[1],d[2,1],i[2],d[1,3],d[2,1]}

RMStep[prog_,{n_Integer,list_List}]:=If[n>Length[prog],{n,list},RMExecute[prog[[n]],{n,list}]]

RMExecute[i[r_],{n_,list_}]:={n+1,MapAt[#+1&,list,r]}

RMExecute[d[r_,m_],{n_,list_}]:=If[list[[r]]>0,{m,MapAt[#-1&,list,r]},{n+1,list}]

RMEvolveList[prog_,init:{_Integer,_List},t_Integer]:=NestList[RMStep[prog,#]&,init,t]

RMStep[prog_,{n_Integer,list_List}]:=If[n>Length[prog],{n,list},RMExecute[prog[[n]],{n,list}]]
RMExecute[i[r_],{n_,list_}]:={n+1,MapAt[#+1&,list,r]}
RMExecute[d[r_,m_],{n_,list_}]:=If[list[[r]]>0,{m,MapAt[#-1&,list,r]},{n+1,list}]
RMEvolveList[prog_,init:{_Integer,_List},t_Integer]:=NestList[RMStep[prog,#]&,init,t]

RMEvolveList[{i[1],d[2,1],i[2],d[1,3],d[2,1]},{1,{0,0}},5]

({{Halting,  (page 896)}})

{i[1],d[2,7],d[2,1],i[2],i[2],d[1,4],i[1],d[2,3]}

According to the notes, this program should take 1280 steps to halt on a repeating sequence. Using 
FixedPointList, the length should be 1282 counting the initial step and the final step repeated once.

RMStep[prog_,{n_Integer,list_List}]:=If[n>Length[prog],{n,list},RMExecute[prog[[n]],{n,list}]]
RMExecute[i[r_],{n_,list_}]:={n+1,MapAt[#+1&,list,r]}
RMExecute[d[r_,m_],{n_,list_}]:=If[list[[r]]>0,{m,MapAt[#-1&,list,r]},{n+1,list}]
RMExecute[d[r_,m_],{n_,list_}]:=If[list[[r]]>0,{m,MapAt[#-1&,list,r]},{n+1,list}]
RMEvolveList[prog_,init:{_Integer,_List},t_Integer]:=NestList[RMStep[prog,#]&,init,t]

Length[FixedPointList[RMStep[{i[1],d[2,7],d[2,1],i[2],i[2],d[1,4],i[1],d[2,3]},#]&,{1,{0,0}}]]

({{Page 101 · Extended instruction sets,  (page 896)}})

RMExecute[eq[r1_,r2_,m_],{n_,list_}]:=If[list[[r1]]==list[[r2]],{m,list},{n+1,list}]

RMExecute[add[r1_,r2_],{n_,list_}]:={n+1,ReplacePart[list,list[[r1]]+list[[r2]],r1]}

RMExecute[jmp[r1_],{n_,list_}]:={list[[r1]],list}

RMExecute[i[r_],{n_,list_}]:={n+1,MapAt[#+1&,list,r]}

RMExecute[d[r_,m_],{n_,list_}]:=If[list[[r]]>0,{m,MapAt[#-1&,list,r]},{n+1,list}]

RMExecute[eq[r1_,r2_,m_],{n_,list_}]:=If[list[[r1]]==list[[r2]],{m,list},{n+1,list}]
RMExecute[add[r1_,r2_],{n_,list_}]:={n+1,ReplacePart[list,list[[r1]]+list[[r2]],r1]}
RMExecute[jmp[r1_],{n_,list_}]:={list[[r1]],list}
RMExecute[i[r_],{n_,list_}]:={n+1,MapAt[#+1&,list,r]}
RMExecute[d[r_,m_],{n_,list_}]:=If[list[[r]]>0,{m,MapAt[#-1&,list,r]},{n+1,list}]
RMEvolveList[prog_,init:{_Integer,_List},t_Integer]:=NestList[RMStep[prog,#]&,init,t]
RMStep[prog_,{n_Integer,list_List}]:=If[n>Length[prog],{n,list},RMExecute[prog[[n]],{n,list}]]

FixedPoint[RMStep[{add[1,2],eq[2,3,99],i[2],jmp[4]},#]&, {1,{0,1,10,1}}][[2,1]]

Symbolic Systems

({{Implementation,  (page 896)}})

NestList[#/.ℯ[x_][y_]->x[x[y]]&,init,t]

NestList[#/.ℯ[x_][y_]->x[x[y]]&,ℯ[ℯ[ℯ][ℯ]][ℯ][ℯ],4]

({{Representations,  (page 896)}})

Flatten[expr//.x_[y_]->{◦,x,y}]

Flatten[a[b[c[d]]]//.x_[y_]->{◦,x,y}]

First[Reverse[list]//.{w___,x_,y_,◦,z___}->{w,y[x],z}]

First[Reverse[{◦,a,◦,b,◦,c,d}]//.{w___,x_,y_,◦,z___}->{w,y[x],z}]

Flatten[Characters[ToString[expr]]/.{"["->1,"]"->0,"ℯ"->{}}]

Flatten[Characters[ToString[ℯ[ℯ[ℯ][ℯ]][ℯ][ℯ]]]/.{"["->1,"]"->0,"ℯ"->{}}]

({{Possible expressions,  (page 897)}})

c[s_,1]=s;c[s_,n_]:=Flatten[Table[Outer[#1[#2]&,c[s,n-m],c[s,m]],{m,n-1}]]

c[s_,1]=s;c[s_,n_]:=Flatten[Table[Outer[#1[#2]&,c[s,n-m],c[s,m]],{m,n-1}]]

c[{a,b},3]

Length[c[{a,b,c},5]]

({{Page 103 · Properties,  (page 897)}})

FoldList[Plus,0,Flatten[Table[{1,1,Table[-1,{IntegerExponent[i,2]+1}]},{i,m}]]]

Take[FoldList[Plus,0,Flatten[Table[{1,1,Table[-1,{IntegerExponent[i,2]+1}]},{i,1024}]]],-20]

({{Order dependence,  (page 898)}})

Module[{i=1},expr/.lhs:>rhs/;i++==1]

Module[{i=1},{foo,foo,foo}/.foo:>Bar[foo]/;i++==1]