# Generate an ε-machine graph from transition probability matrices

I am trying to generate this type of graphic:

see Fig.1a from https://arxiv.org/abs/0905.3587.

This process is associated with two transition matrices

$$T^{(0)} = \begin{pmatrix} 0&p&0\\ 1&0&0\\ q&0&0\\ \end{pmatrix}$$ and $$T^{(1)} = \begin{pmatrix} 0&0&(1-p)\\ 0&0&0\\ 1-q&0&0\\ \end{pmatrix}\,.$$ Their interpretation is that there are 3 causal states, $$A,B,C$$ that the process can be in (thus the matrices are 3x3) and each matrix element $$T^{(x)}_{ij}$$ gives the probability of transitioning from causal state $$i$$ to causal state $$j$$ while emitting symbol $$x$$.

So, going back to my question. In Mathematica how can I generate this graph when I input the two matrices, e.g. as in

T = {{{0, p, 0}, {1, 0, 0}, {q, 0, 0}}, {{0, 0, 1 - p}, {0, 0, 0}, {1 - q, 0, 0}}};


which has as entries the two transition matrices. Is there a built-in command to do that. If not what are my options?

Here is a question that is fairly similar but not quite the same: a) the transition matrix has real entries instead of abstract symbols $$p,q$$, and b) there is only one transition matrix.

Any help appreciated!

• Do you want to visualize something, or do you want to construct a Graph object which can be used for further analysis? Nov 4, 2020 at 12:23
• No, I just want to visualize. Nov 4, 2020 at 12:50

## 2 Answers

The defined function is general enough -- it can work with collections of multiple square matrices that have the same dimensions.

## Defintion

Import["https://raw.githubusercontent.com/antononcube/MathematicaForPrediction/master/SSparseMatrix.m"]

Clear[TransitionsGraph];

TransitionsGraph[lsTMats : {_?MatrixQ ..}, opts : OptionsPattern[]] :=
TransitionsGraph[AssociationThread[Range[0, Length[lsTMats] - 1], lsTMats], opts];

TransitionsGraph[aTMats : Association[(_ -> _?MatrixQ) ..], opts : OptionsPattern[]] :=
Module[{lsStates, aSMats, aAsc, lsRules, EdgeFunc},

lsStates = CharacterRange["A", "Z"][[1 ;; Max[Dimensions /@ Values[aTMats]]]];

aSMats = ToSSparseMatrix[SparseArray[#], "RowNames" -> lsStates, "ColumnNames" -> lsStates] & /@ aTMats;

aAsc = SSparseMatrixAssociation /@ aSMats;

lsRules =
Flatten@KeyValueMap[
Function[{id, asc},
KeyValueMap[DirectedEdge[Sequence @@ #1, Row[{#2, "|", id}]] &, asc]], aAsc];

lsRules = GroupBy[lsRules, #[[1 ;; 2]] &, Grid[List /@ #[[All, 3]]] &];
lsRules = KeyValueMap[Append, lsRules];

EdgeFunc[el_, ___] := {Black, Thick, Arrow[el, 0.04]};

GraphPlot[lsRules,
FilterRules[{opts}, Options[GraphPlot]],
VertexShape ->
Map[# ->
Graphics[{EdgeForm[{Black, Thick}], FaceForm[{White}],
Disk[{0, 0}, 5],
Text[Style[#, Italic, FontSize -> 22], {0, 0}]}] &,
RowNames[aSMats[[1]]]],
VertexSize -> 0.08,
EdgeLabels -> "EdgeTag",
EdgeLabelStyle -> Directive[Black, Italic, 20, Background -> White],
EdgeShapeFunction -> EdgeFunc]
];


## Examples

TransitionsGraph[{{{0, p, 0}, {1, 0, 0}, {q, 0, 0}}, {{0, 0, 1 - p}, {0, 0, 0}, {1 - q, 0, 0}}}, ImageSize -> 900,
GraphLayout -> "SpringElectricalEmbedding"]

Grid[Table[
Block[{n = RandomChoice[{3, 4, 5}]},
Magnify[#, 0.5] &@
TransitionsGraph[
RandomChoice[{9, 1, 1, 1, 1, 1} -> {0, 1, p, q, 1 - p,
1 - q}, {RandomChoice[{2, 3}], n, n}], VertexSize -> 0.12,
ImageSize -> 900]], 2, 3], Dividers -> All, FrameStyle -> Gray]


• Thanks! That's what I was after. Nov 4, 2020 at 15:58

Something like this:

T = {{{0, p, 0}, {1, 0, 0}, {q, 0, 0}}, {{0, 0, 1 - p}, {0, 0,
0}, {1 - q, 0, 0}}}; vars = {x1, x2, x3};
vertexLabels = {1, 2, 3}
edg1 = Outer[Coefficient[#1, #2] &, T[[1]].vars, vars];
edg2 = Outer[Coefficient[#1, #2] &, T[[2]].vars, vars];
edgs = Reap[
Do[If[edg1[[i, j]] =!= 0, Sow[{i, j, edg1[[i, j]], 1}, e1]];
If[edg2[[i, j]] =!= 0, Sow[{i, j, edg2[[i, j]], 2}, e2]];, {i,
Length[vars]}, {j, Length[vars]}]][[2]];
edgs = Join @@ edgs;
{edges, labels} = Reap[Scan[(Sow[#[[1]] \[DirectedEdge] #[[2]], e1];
Sow[#[[1]] \[DirectedEdge] #[[2]] ->
StringForm[" | ", #[[3]], #[[4]]], e2]) &, edgs]][[2]];
Graph[edges, EdgeLabels -> labels,
VertexLabels -> Table[i -> vertexLabels[[i]], {i, Length[vars]}],
GraphLayout -> "GridEmbedding"]


• Thanks for the answer! However, first the labels are not quite right; just compare with the figure I attached to my question . Second, in terms of style it looks quite ugly. Any ideas how to fix these? Nov 4, 2020 at 10:31
• Just fixed it. Change the style to your liking. It should not be too hard. Nov 4, 2020 at 10:35