[Joseph’s simpler code]
[Joseph’s simpler code]
In[]:=
FAExpand[graph_,nmarks_]:=With[{v=VertexList[graph]/.i_Integer->UnitVector[VertexCount[graph],i]},Graph[Nest[Function[g,Union[Flatten[Map[Function[s,Map[#+s&,g,{2}]],v]]]],EdgeList[graph]/.i_Integer->UnitVector[VertexCount[graph],i],nmarks-1],VertexLabels->Placed["Name",Tooltip]]]
In[]:=
FAExpand[graph_,nmarks_]:=With[{v=VertexList[graph]/.i_Integer->UnitVector[VertexCount[graph],i]},With[{g=Graph[Nest[Function[g,Union[Flatten[Map[Function[s,Map[#+s&,g,{2}]],v]]]],EdgeList[graph]/.i_Integer->UnitVector[VertexCount[graph],i],nmarks-1]]},Graph[g,VertexLabels->(#->Row[#]&/@VertexList[g])]]]
In[]:=
FAExpandNoLabels[graph_,nmarks_]:=With[{v=VertexList[graph]/.i_Integer->UnitVector[VertexCount[graph],i]},With[{g=Graph[Nest[Function[g,Union[Flatten[Map[Function[s,Map[#+s&,g,{2}]],v]]]],EdgeList[graph]/.i_Integer->UnitVector[VertexCount[graph],i],nmarks-1]]},Graph[g,VertexLabels->None]]]
More code from Joseph [better version]
More code from Joseph [better version]
FAExpandNew[graph_,marks_]:=Graph[Nest[Function[g,GraphUnion@@Map[Function[s,VertexReplace[g,Map[#->#+s&,VertexList[g]]]],IdentityMatrix[VertexCount[graph]]]],VertexReplace[graph,Map[#->UnitVector[VertexCount[graph],#]&,VertexList[graph]]],marks-1],VertexLabels->Placed["Name",Tooltip]]
Experiments
Experiments
Hover over for vertex label tooltips
In[]:=
FAExpand
,1
Out[]=
In[]:=
FAExpand
,2
Out[]=
In[]:=
FAExpandNoLabels
,6
Out[]=
In[]:=
FAExpandNoLabels[Graph[{1->2,2->1}],6]
Out[]=
In[]:=
FAExpand[Graph[{1->2,2->1}],2]
Out[]=
In[]:=
Table[FAExpand[Graph[{1->2,2->1}],n],{n,5}]
Out[]=
,
,
,
,
In[]:=
IntegerPartitions[4,{2},Range[0,4]]
Out[]=
{{4,0},{3,1},{2,2}}
In[]:=
With[{n=5},IntegerPartitions[n,{2},Range[0,n]]]
Out[]=
{{5,0},{4,1},{3,2}}
In[]:=
With[{n=6},IntegerPartitions[n,{2},Range[0,n]]]
Out[]=
{{6,0},{5,1},{4,2},{3,3}}
In[]:=
Table[Length[IntegerPartitions[n,{2},Range[0,n]]],{n,20}]
Out[]=
{1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11}
In[]:=
Table[Length[IntegerPartitions[n,{3},Range[0,n]]],{n,20}]
Out[]=
{1,2,3,4,5,7,8,10,12,14,16,19,21,24,27,30,33,37,40,44}
In[]:=
ListLinePlot[Differences[%]]
Out[]=
In[]:=
ListLinePlot[Differences[Table[Length[IntegerPartitions[n,{4},Range[0,n]]],{n,50}],2]]
Out[]=
In[]:=
IntegerPartitions[10]
Out[]=
{{10},{9,1},{8,2},{8,1,1},{7,3},{7,2,1},{7,1,1,1},{6,4},{6,3,1},{6,2,2},{6,2,1,1},{6,1,1,1,1},{5,5},{5,4,1},{5,3,2},{5,3,1,1},{5,2,2,1},{5,2,1,1,1},{5,1,1,1,1,1},{4,4,2},{4,4,1,1},{4,3,3},{4,3,2,1},{4,3,1,1,1},{4,2,2,2},{4,2,2,1,1},{4,2,1,1,1,1},{4,1,1,1,1,1,1},{3,3,3,1},{3,3,2,2},{3,3,2,1,1},{3,3,1,1,1,1},{3,2,2,2,1},{3,2,2,1,1,1},{3,2,1,1,1,1,1},{3,1,1,1,1,1,1,1},{2,2,2,2,2},{2,2,2,2,1,1},{2,2,2,1,1,1,1},{2,2,1,1,1,1,1,1},{2,1,1,1,1,1,1,1,1},{1,1,1,1,1,1,1,1,1,1}}
In[]:=
Length[%]
Out[]=
42
In[]:=
PartitionsP[10]
Out[]=
42
PartitionsP[10]
In[]:=
ListLogPlot[Table[PartitionsP[n],{n,100}]]
Out[]=
Reachability
Reachability
Size of states graph
Size of states graph
m markers ; p places
All Possible Small Graphs
All Possible Small Graphs
Simple graphs only:
This shows a nontrivial reachability map
General Petri nets
General Petri nets
We have considered cases where markers always move from one node to another node;
in Petri net transitions, there may be markers on several nodes that are needed to get a marker to be delivered to a new node [and the number of markers may not be conserved]
in Petri net transitions, there may be markers on several nodes that are needed to get a marker to be delivered to a new node [and the number of markers may not be conserved]
A +2 B 3 C