Factor terms by kets

I have an expression that contains several kets with numerical factors. I would like to retrieve the individual kets and store each individually as a list element.

The expression is as follows:

-(1/2) (1/2 + mf) Ket[-(1/2), 1/2 + mf] +
1/2 (Sqrt[3] Sqrt[(3 - mf) (5 + mf)] Ket[-(3/2), 3/2 + mf] +
2 Sqrt[(4 - mf) (4 + mf)] Ket[1/2, -(1/2) + mf])

However when I try to Expand the expression Mathematica gives me this:

1/2 Sqrt[3] Sqrt[(3 - mf) (5 + mf)] Ket[-(3/2), 3/2 + mf] -
1/4 Ket[-(1/2), 1/2 + mf] - 1/2 mf Ket[-(1/2), 1/2 + mf] +
Sqrt[(4 - mf) (4 + mf)] Ket[1/2, -(1/2) + mf]

Notice that there are 2 identical kets there (Ket[-(1/2),1/2+mf]). Right now my workaround this problem is... bad. I expand the expression, then compare the Ket parts as strings and if they match, I join them together.

templist = Cases[-(1/2) (1/2 + mf) Ket[-(1/2), 1/2 + mf] +
1/2 (Sqrt[3] Sqrt[(3 - mf) (5 + mf)] Ket[-(3/2), 3/2 + mf] +
2 Sqrt[(4 - mf) (4 + mf)] Ket[1/2, -(1/2) + mf]) // Expand,
Times[_, Ket[__]]]
Table[If[ToString@(templist[[i]] /.
Times[_, Ket[a_, b_]] -> Ket[a, b]) ==
ToString@(templist[[j]] /.
Times[_, Ket[a_, b_]] -> Ket[a, b]), {templist[[i]] =
templist[[i]] + templist[[j]]; templist[[j]] = 0;}], {i, 1,
Length[templist]}, {j, i + 1, Length[templist]}];

However there must be a better way to retrieve Kets from a sum than this.

Janis, I think the following approaches might be easier. I am going to name your expanded expression for convenience:

expandedexpr =
1/2 Sqrt[3] Sqrt[(3 - mf) (5 + mf)] Ket[-(3/2), 3/2 + mf] -
1/4 Ket[-(1/2), 1/2 + mf] - 1/2 mf Ket[-(1/2), 1/2 + mf] +
Sqrt[(4 - mf) (4 + mf)] Ket[1/2, -(1/2) + mf];

Easiest of all is to use Simplify on the expanded expression and let Mathematica do all the work for you:

Simplify[expandedexpr]

(*
1/2 Sqrt[3] Sqrt[15 - 2 mf - mf^2] Ket[-(3/2), 3/2 + mf] -
1/4 (1 + 2 mf) Ket[-(1/2), 1/2 + mf] + Sqrt[16 - mf^2] Ket[1/2, -(1/2) + mf]
*)

It may be useful for future reference for you to see that you can easily extract a list of Ket expressions from the expanded expression you have using Cases, without transforming them to strings. This relies on the convenient fact that the parts you want have head Ket.

Cases[expandedexpr, _Ket, Infinity]

(* Out:
{Ket[-(3/2), 3/2 + mf], Ket[-(1/2), 1/2 + mf], Ket[-(1/2), 1/2 + mf], Ket[1/2, -(1/2) + mf]}
*)

As you mentioned, one of the Ket expressions is duplicated. You can then feed that list to Collect to have these expressions collected. In one step, this would look like the following:

Collect[expandedexpr, Cases[expandedexpr, _Ket, Infinity]]

(* Out:
1/2 Sqrt[3] Sqrt[(3 - mf) (5 + mf)] Ket[-(3/2), 3/2 + mf] +
(-(1/4) - mf/2) Ket[-(1/2), 1/2 + mf] + Sqrt[(4 - mf) (4 + mf)] Ket[1/2, -(1/2) + mf]
*)

You can check that the two approaches are ultimately equivalent:

Simplify[
Simplify[expandedexpr] == Collect[expandedexpr, Cases[expandedexpr, _Ket, Infinity]]
]

(* Out: True *)