6
$\begingroup$

I have the following list:

x={"A", "A", "A", "E", "D", "D", "D", "C", "B", "E", "E", "E", "D", \
"B", "A", "D", "B", "E", "C", "A", "D", "A", "A", "A", "A", "C", "C", \
"C", "D", "D", "E"}

I want to make the Markov transition probability matrix of first order. To do so I have started by writing:

Partition[x, 2, 1] // Sort // Counts

This will give:

<|{"A", "A"} -> 5, {"A", "C"} -> 1, {"A", "D"} -> 2, {"A", "E"} -> 
  1, {"B", "A"} -> 1, {"B", "E"} -> 2, {"C", "A"} -> 1, {"C", "B"} -> 
  1, {"C", "C"} -> 2, {"C", "D"} -> 1, {"D", "A"} -> 1, {"D", "B"} -> 
  2, {"D", "C"} -> 1, {"D", "D"} -> 3, {"D", "E"} -> 1, {"E", "C"} -> 
  1, {"E", "D"} -> 2, {"E", "E"} -> 2|>

above shows the frequencies of state transition A to A, A to B, A to C, A to D and A to E and so on for other letters, I wonder how can I show this result as a matrix?

$\endgroup$
3
$\begingroup$

You can use SparseArray with additive assembly as follows:

x = RandomChoice[Alphabet["English", "IndexCharacters"], 1000000];
data = Flatten[ToCharacterCode[x]] - (ToCharacterCode["A"][[1]] - 1); // AbsoluteTiming // First
A = With[{
 spopt = SystemOptions["SparseArrayOptions"]},
  Internal`WithLocalSettings[
   (*switch to additive assembly*)
   SetSystemOptions["SparseArrayOptions" -> {"TreatRepeatedEntries" -> Total}],
   
   (*assemble matrix*)
   SparseArray[
    Partition[data, 2, 1] -> 1, 
    Max[data] {1, 1}
    ]
   
   , 
   (*reset "SparseArrayOptions" to previous value*)
   SetSystemOptions[spopt]]
  ]; // AbsoluteTiming // First

0.739454

0.114682

Remarks

  • As the timings suggest, it is worthwhile to avoid strings in the first place.

  • Formerly, I used LetterNumber, but ToCharacterCode is much, much faster.

  • It is "TreatRepeatedEntries" -> Total which enables summing of entries. Count is not needed anymore. Developer`ToPackedArray might speed up things a bit if x is very long. The other hokus-pokus is for making things bulletproof against aborts (i.e., options are reset even if computations are interrupted). See also (37566) and (136017).

$\endgroup$
  • 1
    $\begingroup$ That "TreatRepeatedEntries" -> Total is a nice trick! $\endgroup$ – Chris K Aug 7 '18 at 13:41
  • 1
    $\begingroup$ Thank you, @ChrisK. You know, I could not live without the "TreatRepeatedEntries" option. $\endgroup$ – Henrik Schumacher Aug 7 '18 at 13:46
  • $\begingroup$ @HenrikSchumacher Thank you for this, I turned this into matrix form using //MatrixForm and I got the answer I was after, I wonder if it is possible to use the same for different size of partition and offsets? Such as SparseArray[ Partition[Developer`ToPackedArray[LetterNumber[x]], 3, 1] -> 1] in that case I get wrong matrix positions $\endgroup$ – Wiliam Aug 7 '18 at 14:56
  • $\begingroup$ You may try this, instead: A = With[{ data = Developer`ToPackedArray[LetterNumber[x]], spopt = SystemOptions["SparseArrayOptions"] }, Internal`WithLocalSettings[ SetSystemOptions[ "SparseArrayOptions" -> {"TreatRepeatedEntries" -> Total}], SparseArray[Partition[data, 3, 1] -> 1, Max[data] {1, 1, 1}], SetSystemOptions[spopt]]]. It prescribes the tensor dimensions explicitly. $\endgroup$ – Henrik Schumacher Aug 7 '18 at 14:59
6
$\begingroup$

You can use the package CrossTabulate.m. (More detailed references are given in this MSE answer.)

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

cmat = CrossTabulate[Partition[x, 2, 1]];

MatrixForm[cmat]

enter image description here

cmat["SparseMatrix"] = cmat["SparseMatrix"]/Total[cmat["SparseMatrix"], {2}];
MatrixForm[cmat]

enter image description here

ArrayRules[cmat["SparseMatrix"]]

(* {{1, 1} -> 5/9, {1, 5} -> 1/9, {1, 4} -> 2/9, {1, 3} -> 1/
  9, {2, 5} -> 2/3, {2, 1} -> 1/3, {3, 2} -> 1/5, {3, 1} -> 1/
  5, {3, 3} -> 2/5, {3, 4} -> 1/5, {4, 4} -> 3/8, {4, 3} -> 1/
  8, {4, 2} -> 1/4, {4, 1} -> 1/8, {4, 5} -> 1/8, {5, 4} -> 2/
  5, {5, 5} -> 2/5, {5, 3} -> 1/5, {_, _} -> 0} *)
$\endgroup$
  • $\begingroup$ I like to create a transition matrix using a weighted, directed graph with the domain of weights, [0, 1.5]. My states will be 7 equal length subsets of the domain and the transition matrix will have the number of binary links in each subset. I could have asked a new question but then I realized that instead of letters I wanted to use subsets. I have two directed graphs (time t and t+1) to start with the exercise. But you may just create two randreal graphs to answer. Can you help me? $\endgroup$ – Tugrul Temel Aug 25 '20 at 22:49
  • $\begingroup$ @TugrulTemel Yes, please post a new MSE question. (The possible answers are too long to be just comments...) $\endgroup$ – Anton Antonov Aug 26 '20 at 12:23
  • 1
    $\begingroup$ I have posted a new question yesterday after sending you my request. I realized that the answers are too long for comments. $\endgroup$ – Tugrul Temel Aug 26 '20 at 12:27
3
$\begingroup$

You can also use EstimatedProcess and MarkovProcessProperties as follows:

states = DeleteDuplicates[x];
ordering = Ordering[states]; 
data = ArrayComponents @ x ;
estproc = EstimatedProcess[data, DiscreteMarkovProcess[Length@states]];
tm = MarkovProcessProperties[estproc, "TransitionMatrix"][[ordering, ordering]] 

TeXForm[TableForm[tm, TableHeadings -> {states[[ordering]], states[[ordering]]}]]

$\begin{array}{cccccc} & \text{A} & \text{B} & \text{C} & \text{D} & \text{E} \\ \text{A} & \frac{5}{9} & 0 & \frac{1}{9} & \frac{2}{9} & \frac{1}{9} \\ \text{B} & \frac{1}{3} & 0 & 0 & 0 & \frac{2}{3} \\ \text{C} & \frac{1}{5} & \frac{1}{5} & \frac{2}{5} & \frac{1}{5} & 0 \\ \text{D} & \frac{1}{8} & \frac{1}{4} & \frac{1}{8} & \frac{3}{8} & \frac{1}{8} \\ \text{E} & 0 & 0 & \frac{1}{5} & \frac{2}{5} & \frac{2}{5} \\ \end{array}$

$\endgroup$
  • $\begingroup$ This is very neat thank you what if you want to find the same transition probability matrix for higher orders? For example in the second order case one would have the same columns namely, A, B, C, D and E and 5^2 rows {AA,AB,AC,AD,AE,BA,...,EA,EB,EC,ED,EE}. $\endgroup$ – Wiliam Aug 8 '18 at 9:12
  • $\begingroup$ @William, that's a good question. Can't think of a way off the top of my head. $\endgroup$ – kglr Aug 8 '18 at 9:19
  • $\begingroup$ @William if you have a follow up question it's best to ask a new question that links to this one. $\endgroup$ – rhermans Aug 8 '18 at 9:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.