How to summarize the coefficient in Notation?

Question

With the help from Stephen Luttrell in stackexchange, I can give an intuitive expression of quantum walk, as shown in the Mathematica codes below.

Needs["Notation`"]
Notation[ParsedBoxWrapper[
RowBox[{
RowBox[{
RowBox[{
RowBox[{"\[LeftBracketingBar]", "spin_"}], "\[RightAngleBracket]"}], 
   "\[CircleTimes]", 
RowBox[{"\[LeftBracketingBar]", "index_"}]}], 
 "\[RightAngleBracket]"}]] \[DoubleLongLeftRightArrow] 
ParsedBoxWrapper[
RowBox[{"state", "[", 
RowBox[{"spin_", ",", "index_"}], "]"}]]]
H[state[spin : ("\[UpArrow]" | "\[DownArrow]"), index_]] := 
1/Sqrt[2] state["\[UpArrow]", index] + 
1/Sqrt[2] If[spin == "\[UpArrow]", 1, -1] state["\[DownArrow]", 
 index];
S[state[spin : ("\[UpArrow]" | "\[DownArrow]"), index_]] := 
state[spin, index + If[spin == "\[UpArrow]", 1, -1]];
H[u_ + v_] := H[u] + H[v];
S[u_ + v_] := S[u] + S[v];
H[u_?(FreeQ[#, state] &) v_] := u H[v];
S[u_?(FreeQ[#, state] &) v_] := u S[v];
state["\[DownArrow]", 0]
H[%];
S[%];
H[%];
S[%];
H[%];
S[%];
H[%];
S[%] // Simplify

The result (the fourth step in quantum walk) is Based on the previous codes, now I have a new problem :

First, I need to merge the elements with the same \[LeftBracketingBar]index\[RightAngleBracket], and rearrange the elements in an increasing order of \[LeftBracketingBar]index\[RightAngleBracket]. For example, in the fourth step, should be merged and rearranged as

Second, I need to summarize the coefficient and calculate the intensity for each \[LeftBracketingBar]index\[RightAngleBracket]. The intensity is square of the coefficient of \[LeftBracketingBar]"\[DownArrow]"\[RightAngleBracket], puls the square of the coefficient of \[LeftBracketingBar]"\[UpArrow]"\[RightAngleBracket]. For example, in the fourth step, the intensity is

1/16 (1; 9 + 1; 1 + 1; 1 + 1; 1)=(1/16; 5/8; 1/8; 1/8; 1/16)

My final goal is to make the following table, which is the famous quantum walk table. The x axis is the position, and the y axis is the step number.

My question is how to summarize the coefficient in Notation using Mathematica codes? Any help or suggestion is highly appreciated.

Answer 1

There are many ways of solving this problem, including redoing everything from the start, but let's begin with your last line by defining ans = S[%] // Simplify.

Define a rule for collecting together terms with the same index.

collect = 
  Plus[u___, a1_. state[spin1_, index_], v___, a2_. state[spin2_, index_], w___] :> 
  Plus[u, state[a1 spin1 + a2 spin2, index], v, w];

You can produce the collected & sorted states as follows:

Collect terms.

ans2 = ans //. collect

You should define some new Notation to display the spin part of a "collected" state in a more conventional way, but I won't do that here.

Sort terms.

ans2a = ans2 /. HoldPattern@Plus[x : state[__] ..] :> 
  Inactive[Plus] @@ SortBy[{x}, Last]

You have to use Inactive[Plus] rather than Plus, because Plus likes to sort its arguments.

You can produce the table of state probabilities as follows:

Collect terms.

ans3 = (ans // Expand) //. collect

Extract the probabilities.

ans3a = List @@ ans3 /. 
  a_. state[spinsum__, index_] :> 
    {spinsum /. b_. _String :> (a b)^2, index} // SortBy[#, #[[2]] &] &