Extracting parts of an expression

I have lists with expressions like this one: {-DTMomentum2[{0, 0, 1}], DTMomentum2[{0, 0, 0}]}. DTMomentum2 is just an undefined function such that the minus sign does not get distributed into the {0, 0, 1} vector. What I want is -DTMomenta[{{0, 0, 1}, {0, 0, 0}}] in the end, I want to collect all complex valued factors up front in a product and then all three-vectors in a list.

I have tried using Cases, and that works for the first one to extract the momenta:

Cases[#, DTMomentum2[p_] -> p] & /@ {-DTMomentum2[{0, 0, 1}], DTMomentum2[{0, 0, 0}]}

The output is {{{0, 0, 1}}, {}}, it did not work with the second one for some reason.

I have tried with a simple ReplaceAll, but then I get the minus sign into my vector:

{-DTMomentum2[{0, 0, 1}], DTMomentum2[{0, 0, 0}]} /. DTMomentum2[p_] -> p

Output is {{0, 0, -1}, {0, 0, 0}}.

As long as all DTMomentum2 expressions come with some factor in front, the following function does what I want:

MomentumProductToMomenta2[factors_] := Block[
{momenta, scalar},
momenta = Flatten[Cases[#, DTMomentum2[p_] -> p] & /@ factors, 1];
scalar = Times @@ (factors /. a_ DTMomentum2[p_] -> a);
scalar * DTMomenta @@ momenta];

But as soon as there are terms in the list of factors, it just gives an empty list. Changing the pattern to a_ DTMomentum2[p_] will absorb the minus sign, but that pattern will fail. Including both patterns give strange results with more terms popping up.

How can I get the coefficients that I want?

• Something like Apply[Times, #[[All, 1]]] DTMomenta[#[[All, 2]]] &[{-DTMomentum2[{0, 0, 1}], DTMomentum2[{0, 0, 0}]} /. a_. DTMomentum2[v_?VectorQ] :> {a, v}]? – J. M. will be back soon Mar 16 at 17:12
• Yes, that works! After adding the . to my a_, my version also works. Thanks so much for pointing to that optionality! – Martin Ueding Mar 16 at 17:33
• @MartinUeding Since JM's comment seems to solve your problem, consider writing it up as a self-answer, so your question shows up answered for future readers. – MarcoB Mar 16 at 19:49

Will this simple correction to your 1st approach work for you?

expr = {-DTMomentum2[{0, 0, 1}], DTMomentum2[{0, 0, 0}]};
Cases[expr, DTMomentum2[args : {__}] -> args, All]

{{0, 0, 1}, {0, 0, 0}}

Just for fun, here is another one:

expr = {-DTMomentum2[{0, 0, 1}], DTMomentum2[{0, 0, 0}]};
Abs[ToExpression[StringDelete[ToString[#], {"DTMomentum2[","]"}]]] & /@ expr

{{0, 0, 1}, {0, 0, 0}}