# How to factorize polynomials into "shortest possible" pieces

I am using Factor a lot in my work, it is extremely versatile and efficient, except for one aspect. Example: Factor[1 - q^8 - q^11 - q^14 + q^19 + q^22 + q^25 - q^33] results in

-(-1 + q)^3 (1 + q)^2 (1 + q^2) (1 + q^4) (1 - q + q^2 - q^3 + q^4 - q^5 + q^6)
(1 + q + q^2 + q^3 + q^4 + q^5 + q^6)
(1 + q + q^2 + q^3 + q^4 + q^5 + q^6 + q^7 + q^8 + q^9 + q^10)


whereas I would like to obtain (1 - q^8) (1 - q^11) (1 - q^14).

Is there a way to explain to Mathematica that I want factors with as few summands as possible?

• Is this $q$-series work, by any chance? Apr 17 '17 at 12:54
• @J.M. Well yes, among other things I have to deal with $q$-hypergeometric functions. I am using some RISC packages but from time to time I have to figure out some tricky generating functions myself. Apr 17 '17 at 12:56
• To be more specific - in case you are interested - on MO here and here you can see some kinds of stuff I need this for. Apr 17 '17 at 13:04

Here is one possibility. Introduce the following transformation functions:

qm[(q-1)^n_. (1+q+r_) z_] := (q-1)^(n-1) z Simplify[(q-1)(1+q+r)]
qm[x_] := x

qp[(q+1)^n_. (1-q+r_) z_] := (q+1)^(n-1) z Simplify[(q+1)(1-q+r)]
qp[x_] := x

qq[(q_-1)^n_. (q_+1)^m_. z_] := (q-1)^(n-1)(q+1)^(m-1) z (q^2-1)
qq[x_] := x


Then, use these transformation functions in Simplify on the result of Factor:

Simplify[
Factor[1-q^8-q^11-q^14+q^19+q^22+q^25-q^33],
TransformationFunctions->{qm, qp, qq}
]


-(-1 + q^8) (-1 + q^11) (-1 + q^14)

It is hard to get Simplify to convert the above to (1-q^8)(1-q^11)(1-q^14) because the LeafCount is 5 higher. One idea is to introduce another function:

invert[x_] := x /. a_Plus :> s(-a) /. s->-1


and then use a custom ComplexityFunction:

Simplify[
Factor[1-q^8-q^11-q^14+q^19+q^22+q^25-q^33],
TransformationFunctions->{qm, qp, qq, invert},
ComplexityFunction->(LeafCount[#]+If[MatchQ[#,-_],6,0]&)
]


(1 - q^8) (1 - q^11) (1 - q^14)

but I don't know how robust that would be.

If the polynomial can be factored in the form

( 1 - x^n[1]) (1 - x^n[2])...(1 - x^n[c])

then the following code should do the work

poly = 1 - x^8 - x^11 - x^14 + x^19 + x^22 + x^25 - x^33;
Fin = {};
While[Length@poly > 1, S = CoefficientList[poly, {x}];
pow = First@Flatten[Position[Drop[S, 1], -1]];
AppendTo[Fin, 1 - x^pow];
poly = Simplify[poly/(1 - x^pow)]]
Fin


{1 - x^8, 1 - x^11, 1 - x^14}

EDIT

If the polynomial can be factored in the form

( 1 +/- x^n[1]) (1 +/- x^n[2])...(1 + x^n[c])

then you can use this

poly = 1 + x^3 - x^5 - x^8 + x^9 - x^14 - x^15 + x^17 + 2 x^20 -
x^21 - x^22 - x^24 - x^25 + 2 x^26 + x^29 - x^31 - x^32 + x^37 -
x^38 - x^41 + x^43 + x^46;
Fin = {};
While[Length@poly > 1, S = CoefficientList[poly, {x}];
If[MemberQ[S, -1] && MemberQ[S, 1],
If[First@Flatten[Position[Drop[S, 1], 1]] <
First@Flatten[Position[Drop[S, 1], -1]],
pow = First@Flatten[Position[Drop[S, 1], 1]];
AppendTo[Fin, 1 + x^pow];
poly = Simplify[poly/(1 + x^pow)],
pow = First@Flatten[Position[Drop[S, 1], -1]];
AppendTo[Fin, 1 - x^pow];
poly = Simplify[poly/(1 - x^pow)]],
If[MemberQ[S, 1], pow = First@Flatten[Position[Drop[S, 1], 1]];
AppendTo[Fin, 1 + x^pow];
poly = Simplify[poly/(1 + x^pow)],
If[MemberQ[S, -1], pow = First@Flatten[Position[Drop[S, 1], -1]];
AppendTo[Fin, 1 - x^pow];
poly = Simplify[poly/(1 - x^pow)]]]]]
Fin


{1 + x^3, 1 - x^5, 1 + x^9, 1 - x^12, 1 + x^17}

• But your code doesn't work for very closely related polynomials, such as Expand[(1-x^9)(2+x^4)(3+x^8)]. Apr 17 '17 at 22:40
• right now I'm making some improvements which I will post very soon. Apr 17 '17 at 22:54