# Collect with a product of patterns

In the examples below, I notate Subscript[S, n] as Sn for brevity.

I'm trying to take expressions like

a X0 X1 + b X0 X1 + c X1


and produce factorisations into the basis of any product of X with a unique set of subscripts. The above expression should become

(a + b) X0 X1 + c X1


Here, a, b and c can be any form which doesn't match the pattern Subscript[X, _Integer]. This seems like a job for Collect, but using a pattern like X_ factorises to this form:

Collect[
a X0 X1 + b X0 X1 + c X1,
X_
]

>>> (c + (a + b) X0) X1


Though the 'advanced uses' in the doc include collecting with respect to a parameter, specifying strictly products doesn't seem to work:

Collect[
a X0 X1 + b X0 X1 + c X1,
X_ X_
]

>>> a X0 X1 + b X0 X1 + c X1


More explicit patterns also don't seem to work:

Collect[%, Verbatim[Times][Repeated[X_, {2, Infinity}]]]
>>> a X0 X1 + b X0 X1 + c X1

Collect[%, Verbatim[Times][Except[X_].., Repeated[X_, {2, Infinity}]]]
>>> a X0 X1 + b X0 X1 + c X1


I'm looking for a solution which would produce the following transformations, for example

a X0 + b X0 -> (a + b) X0
a X0 + b X0 + c X0 X1 + d X0 X1 -> (a + b) X0 + (c + d) X0 X1


and similarly for products of a greater number of terms, e.g.

a X0 X1 X2 + b X0 X1 X2 + c X1 X2 -> (a + b) X0 X1 X2 + c X1 X2


# Adapting Αλέξανδρος Ζεγγ's solution:

We can group our input expression ourselves into sums of terms with the same set of subscript indices, pass each to Factor[], then combine.

First, creating a function which returns the subscript indices of the terms that may appear in our input expression:

getIndices[ Subscript[X, q_] ] := {q}
getIndices[ Verbatim[Times][ Except[Subscript[X,_]] ..., p:Subscript[X,_].. ] ] := {p}[[ All, 2 ]]
getIndices[ _ ] := {}



Note we've here assumed that the Xn terms appear last in the given products, which is right in most cases, since Mathematica seems to move subscripted symbols to the end of products. If we wanted to be very thorough (to support terms with other subscripted symbols which we want to treat as coefficients yet appear else in the products), we would make our second rule accept any product and extract the Xn terms:

getIndices[ Verbatim[Times][t__] ] := Cases[{t}, Subscript[X,_]] [[All,2]]


getIndices merely replaces Αλέξανδρος's use of Count[]:

myFactor[a_] := Factor /@ GatherBy[List @@@ a, getIndices] // Total


This works great, though requires we be explicit about the forms of the terms in our input sums (which we can get by using Expand or Distribute).

• “ In the examples below, I notate Subscript[S, n] as Sn for brevity.” - please don’t do that. You should just copy / paste your code as it is or we might get down the wrong rabbit hole. Dec 12, 2020 at 3:35
• I had typed it out verbosely, deemed it very hard to see the format I'm after, and adopted that notation instead. I recognise no one communication style works for everyone, sorry about that! Dec 12, 2020 at 16:05
• Glad to see improvements :) Dec 13, 2020 at 0:56

## 3 Answers

This piece of code seems to work for the expression structure that has been presented -- Group terms by the number of Xs and terms with the same number of Xs are the same, up to a coefficient free of X. But no guarantee for expressions with more complex structures.

Clear[myFactor]
myFactor[expr_] := Factor /@ Plus @@@ GatherBy[Cases[expr, Times[__]], Count[#, X, -1] &] // Total

myFactor[a Subscript[X, 0] Subscript[X, 1] + b Subscript[X, 0] Subscript[X, 1] + c Subscript[X, 1]]
myFactor[a Subscript[X, 0] + b Subscript[X, 0]]
myFactor[a Subscript[X, 0] + b Subscript[X, 0] + c Subscript[X, 0] Subscript[X, 1] + d Subscript[X, 0] Subscript[X, 1]]
myFactor[a Subscript[X, 0] Subscript[X, 1] Subscript[X, 2] + b Subscript[X, 0] Subscript[X, 1] Subscript[X, 2] + c Subscript[X, 1] Subscript[X, 2]]

c Subscript[X, 1] + (a + b) Subscript[X, 0] Subscript[X, 1]
(a + b) Subscript[X, 0]
(a + b) Subscript[X, 0] + (c + d) Subscript[X, 0] Subscript[X, 1]
c Subscript[X, 1] Subscript[X, 2] + (a + b) Subscript[X, 0] Subscript[X, 1] Subscript[X, 2]


Update

To make it more versatile, I wove this piece of code

Clear[myFactor2]
myFactor2[expr_] := Keys[#].Values[#] & [
Total /@ (GroupBy[Cases[expr, Times[a___?(FreeQ[X])] b__ :> {Times[a], Times[b]}], Last -> First] /. x__Times?(Not@*FreeQ[X]) :> 1)
];


Besides successful recovery of results from above myFactor, as one can check, myFactor2 can handle more complex cases.

myFactor2[a Subscript[X, 0] Subscript[X, 1] + Subscript[X, 1] Subscript[X, 2]]
myFactor2[a b Subscript[X, 0] Subscript[X, 1] + b Subscript[X, 0] Subscript[X, 1] + c Subscript[X, 1] + Subscript[X, 1] Subscript[X, 2] + Subscript[X, 1] Subscript[X, 0] + c d Subscript[X, 0] Subscript[X, 1] Subscript[X, 2]]

a Subscript[X, 0] Subscript[X, 1] + Subscript[X, 1] Subscript[X, 2]
c Subscript[X, 1] + (1 + b + a b) Subscript[X, 0] Subscript[X, 1] +  Subscript[X, 1] Subscript[X, 2] +  c d Subscript[X, 0] Subscript[X, 1] Subscript[X, 2]

• Grouping by number-of-X isn't enough; the subscript incides must be unique. E.g. this example a Subscrip[X,0] Subscript[X, 1] + Subscript[X,1] Subscript[X, 2] should produce X0 X1 + X1 X2 but instead produces X1 (X0 + X2) Dec 12, 2020 at 16:14
• Replacing your Count[] with a function returning the subscript indices does what I want, thanks very much! I'll update my question with the solution Dec 12, 2020 at 17:00
• @AntiEarth At the time I posted the first part of my answer, the situation was that the terms with same number of Xs had same subscripts, that is why I put "no guarantee blabla". Please see my update. Dec 13, 2020 at 0:49
• mathematica.stackexchange.com/questions/262530/…
– dtn
Jan 23, 2022 at 8:17

With an input expression with subscripts, we can use HoldPattern in the second argument to prevent Subscript[X, _] Subscript[X, _] from evaluating (to Power[Subscript[X, Blank[]], 2]) before pattern matching starts its work:

expr = a Subscript[X, 0] Subscript[X, 1] +
b Subscript[X, 0] Subscript[X, 1] + c Subscript[X, 1]


Collect[expr, HoldPattern[Subscript[X, _]] Subscript[X, _]]


Alternatively, use named patterns (say, Subscript[X, u_] instead of Subscript[X, _]):

Collect[expr, Subscript[X, u_] Subscript[X, v_]]


Update: More generally,

Collect[expr, Unevaluated[Times[Subscript[X, _] ..]]]


• ahh I indeed missed that X_ X_ would become X_^2, thanks for pointing this out! I'm unsure why HoldPattern[X_] X_ works yet HoldPattern[X_ X_] doesn't, and that's preventing me from generalising to products of more terms Dec 12, 2020 at 16:00
• @AntiEarth, please see the update.
– kglr
Dec 13, 2020 at 6:00
• @kfglr the new code fails for expr = a X0 X1 + b X0 X1 X2, producing X0 X1 (a + b X2) instead of leaving the expression unchanged. I couldn't fix it by inserting Longest[] inside Times[] either Dec 13, 2020 at 16:22
• Collect[expr, Unevaluated[Times[Subscript[X, _], Subscript[X, _]]]] leaves expr unchanged; Collect[expr, Unevaluated[Times[Subscript[X, _] ..]]] (or Collect[expr, Unevaluated[Times[Subscript[X, _], Subscript[X, _] ..]]] gives Subscript[X, 0] Subscript[X, 1] (a + b Subscript[X, 2]).
– kglr
Dec 13, 2020 at 16:52
• Exactly.. I'm looking for an expression with the correct behaviour for all inputs Dec 15, 2020 at 15:30

I recommend that you only use subscripts for display, i.e., use formatted indexed variables.

Format[x[n_]] := Subscript[x, n];

expr1 = a x[0] x[1] + b x[0] x[1] + c x[1]


Collect[expr1, x /@ Range[0, 1]]


expr2 = a x[0] x[1] x[2] + b x[0] x[1] x[2] + c x[1] x[2]


Collect[expr2, x /@ Range[0, 2]]


• I'm afraid subscripted symbols are part of the user input language to the API that my question will ultimately enable. But your gut feeling is correct, and it has indeed proved a nightmare on many occassions ;) Dec 12, 2020 at 16:01