For “Multicomputational approach to games and puzzles”...
DirectedGraphTransferMatrix
DirectedGraphTransferMatrix
DirectedGraphTransferMatrix[graph_]:=Module[{vertices,edges,weights,ins,outs,mids,inGroup,outGroup,normalization,readIn,readOut,continuity,balance,sol},vertices=VertexList[graph];ins=Select[vertices,VertexInDegree[graph,#]==0&];outs=Select[vertices,VertexOutDegree[graph,#]==0&];mids=Complement[vertices,Join[ins,outs]];edges=EdgeList[graph];inGroup=GroupBy[edges,Last];outGroup=GroupBy[edges,First];vertices=Association[MapIndexed[#1->#2[[1]]&,vertices]];weights=WeightedAdjacencyMatrix[graph];weights=Map[#->Part[weights,Sequence@@Lookup[vertices,List@@#]]&,edges];edges=Association[MapIndexed[#1->#2[[1]]&,edges]];normalization={Equal[Total[pv/@Lookup[vertices,ins]],pt],Equal[Total[pv/@Lookup[vertices,outs]],pt]};readIn=MapThread[Total[#2]==pv[vertices[#1]]&,{ins,Map[pe,Lookup[edges,#]&/@Lookup[outGroup,ins],{2}]}];readOut=MapThread[Total[#2]==pv[vertices[#1]]&,{outs,Map[pe,Lookup[edges,#]&/@Lookup[inGroup,outs],{2}]}];continuity=MapThread[Equal[Total[pe/@#1],Total[pe/@#2]]&,{Lookup[edges,#]&/@Lookup[outGroup,mids],Lookup[edges,#]&/@Lookup[inGroup,mids]}];balance=Catenate[MapApply[Equal,Partition[Divide[pe/@Lookup[edges,outGroup[#]],Lookup[weights,outGroup[#]]],2,1]]&/@Join[mids,ins]];sol=Solve[Join[readIn,readOut,normalization,continuity,balance],Join[pv/@Lookup[vertices,outs],pe/@Values[edges],{pt}]];Outer[Coefficient[#1,#2]&,ReplaceAll[pv/@Lookup[vertices,outs],sol[[1]]],Reverse[pv/@Lookup[vertices,ins]],1]]
testing (no weights, maze post examples)
testing (no weights, maze post examples)
In[]:=
g0=
;
In[]:=
DirectedGraphTransferMatrix[g0]//MatrixForm
Out[]//MatrixForm=
1 7 | 2 7 | 4 7 |
2 7 | 4 7 | 1 7 |
4 7 | 1 7 | 2 7 |
In[]:=
g1=
;
In[]:=
DirectedGraphTransferMatrix[g1]//MatrixForm
Out[]//MatrixForm=
1 168 | 1 14 | 0 | 1 14 | 0 |
1 168 | 1 14 | 0 | 1 14 | 1 |
4 21 | 2 7 | 0 | 2 7 | 0 |
1 21 | 4 7 | 1 | 4 7 | 0 |
1 4 | 0 | 0 | 0 | 0 |
1 2 | 0 | 0 | 0 | 0 |
In[]:=
g2=
;
In[]:=
DirectedGraphTransferMatrix[g2]//MatrixForm
Out[]//MatrixForm=
32 45 |
8 45 |
4 45 |
1 90 |
1 90 |
In[]:=
SeedRandom[23342];rg=First[ReverseSortBy[WeaklyConnectedGraphComponents[RandomGraph[{60,100},DirectedEdges->True]],VertexCount]]
Out[]=
In[]:=
DirectedGraphTransferMatrix[rg]//MatrixForm
Out[]//MatrixForm=
0 | 24094 175759 | 88270 527277 | 99755 175759 | 133401 1406072 | 54718 175759 | 219887 1054554 | 219487 703036 |
0 | 1241082 1933349 | 582151 5800047 | 185813 3866698 | 1399249 15466792 | 177602 1933349 | 989353 5800047 | 5829653 15466792 |
0 | 168309 1933349 | 415202 1933349 | 1837573 7733396 | 13792135 30933584 | 644785 1933349 | 7108567 23200188 | 1171273 7733396 |
0 | 180846 1933349 | 398852 5800047 | 60183 1933349 | 501731 7733396 | 293552 1933349 | 400397 5800047 | 307741 3866698 |
0 | 57300 1933349 | 794763 1933349 | 657607 7733396 | 4544081 30933584 | 155486 1933349 | 4450675 23200188 | 904647 15466792 |
0 | 20778 1933349 | 218179 5800047 | 118319 3866698 | 495213 15466792 | 60026 1933349 | 311108 5800047 | 82567 3866698 |
1 | 0 | 0 | 0 | 1 8 | 0 | 0 | 0 |
Example from stack exchange
Example from stack exchange
this fails
this fails
There is no proper input!
There is no proper input!
But this does work:
But this does work:
testing against brute force
testing against brute force