2
$\begingroup$

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).

$\endgroup$
3
  • 1
    $\begingroup$ “ 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. $\endgroup$
    – MarcoB
    Dec 12, 2020 at 3:35
  • $\begingroup$ 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! $\endgroup$
    – Anti Earth
    Dec 12, 2020 at 16:05
  • $\begingroup$ Glad to see improvements :) $\endgroup$ Dec 13, 2020 at 0:56

3 Answers 3

2
$\begingroup$

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]
$\endgroup$
4
  • $\begingroup$ 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) $\endgroup$
    – Anti Earth
    Dec 12, 2020 at 16:14
  • $\begingroup$ 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 $\endgroup$
    – Anti Earth
    Dec 12, 2020 at 17:00
  • $\begingroup$ @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. $\endgroup$ Dec 13, 2020 at 0:49
  • $\begingroup$ mathematica.stackexchange.com/questions/262530/… $\endgroup$
    – dtn
    Jan 23, 2022 at 8:17
2
$\begingroup$

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]

enter image description here

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

enter image description here

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

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

enter image description here

Update: More generally,

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

enter image description here

$\endgroup$
6
  • 1
    $\begingroup$ 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 $\endgroup$
    – Anti Earth
    Dec 12, 2020 at 16:00
  • 1
    $\begingroup$ @AntiEarth, please see the update. $\endgroup$
    – kglr
    Dec 13, 2020 at 6:00
  • 1
    $\begingroup$ @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 $\endgroup$
    – Anti Earth
    Dec 13, 2020 at 16:22
  • 1
    $\begingroup$ 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]). $\endgroup$
    – kglr
    Dec 13, 2020 at 16:52
  • 1
    $\begingroup$ Exactly.. I'm looking for an expression with the correct behaviour for all inputs $\endgroup$
    – Anti Earth
    Dec 15, 2020 at 15:30
1
$\begingroup$

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]

enter image description here

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

enter image description here

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

enter image description here

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

enter image description here

$\endgroup$
1
  • 1
    $\begingroup$ 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 ;) $\endgroup$
    – Anti Earth
    Dec 12, 2020 at 16:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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