2
$\begingroup$

Not sure how to do this with Factor/Collect etc. I'm thinking this might not be straightforward at all.

Given a large Laurent polynomial I am trying to factor it into irreducible Laurent polynomials.

NOTE: The large polynomial in question will be symmetric in the positive and negative exponents. i.e

x^-n + x^-n+1 ... + 1 + ... x^n-1 + x^n

Example:

bigpoly = 1 + 1/x^40 + 1/x^39 + 1/x^38 + 1/x^37 + 1/x^36 + 1/x^35 + 1/x^34 + \
1/x^33 + 1/x^32 + 1/x^31 + 1/x^30 + 1/x^29 + 1/x^28 + 1/x^27 + 1/x^26 \
+ 1/x^25 + 1/x^24 + 1/x^23 + 1/x^22 + 1/x^21 + 1/x^20 + 1/x^19 + \
1/x^18 + 1/x^17 + 1/x^16 + 1/x^15 + 1/x^14 + 1/x^13 + 1/x^12 + 1/x^11 \
+ 1/x^10 + 1/x^9 + 1/x^8 + 1/x^7 + 1/x^6 + 1/x^5 + 1/x^4 + 1/x^3 + \
1/x^2 + 1/x + x + x^2 + x^3 + x^4 + x^5 + x^6 + x^7 + x^8 + x^9 + \
x^10 + x^11 + x^12 + x^13 + x^14 + x^15 + x^16 + x^17 + x^18 + x^19 + \
x^20 + x^21 + x^22 + x^23 + x^24 + x^25 + x^26 + x^27 + x^28 + x^29 + \
x^30 + x^31 + x^32 + x^33 + x^34 + x^35 + x^36 + x^37 + x^38 + x^39 + \
x^40;

Factor[bigpoly]

(* ((1 + x + x^2) (1 + x^3 + x^6) (1 + x^9 + x^18) (1 + x^27 + 
   x^54))/x^40 *)

What I would like is a way to distribute the denominator x^40 to the 4 individual factors so that I get:

((x^-1 + 1 + x) (x^-3 + 1 + x^3) (x^-9 + 1 + x^9) (x^-27 + 1 + 
   x^27))

Now I can write some messy code to do this but is there a quick way to handle this job using some inbuilt command or two such as Factor/Collect etc.

If there is I haven't found it. As always any help/insight would be appreciated.

EDIT: The more I think about it this is a bad question. It's basically asking Mathematica to mind read. I can see that dividing the factors in brackets by the Median of the exponents of the given factor does the job.

I think it probably should be closed!!!!

Improve this question
$\endgroup$
10
  • $\begingroup$ Is this well defined in general? What are the criteria for distributing to each factor? $\endgroup$ Commented Nov 19, 2024 at 17:34
  • $\begingroup$ @DanielLichtblau That the factors are symmetric in the sense that you get a form like x^-n + x^-n+1 ... + 1 + ... x^n-1 + x^n. Obviously the example I showed they were just 3 terms in each factor - in practice they could be far larger. $\endgroup$ Commented Nov 19, 2024 at 17:45
  • $\begingroup$ With[{t = List @@ (bigpoly // Factor)}, Times @@ Expand[(x^Flatten[{Total[#], -#} &@Exponent[Rest[t][[All, 2]], x]]) t]] $\endgroup$ Commented Nov 19, 2024 at 20:50
  • $\begingroup$ How would this work in practice with this example? In[151]:= smallpoly = 1 + 1/x^5 + 1/x^4 + 1/x^3 + x + x^2 + x^3 + x^4 + x^9; Factor[smallpoly] Out[152]= (1 + x + x^2 + x^5 + x^6 + x^7 + x^8 + x^9 + x^14)/x^5 $\endgroup$ Commented Nov 19, 2024 at 20:54
  • $\begingroup$ @DanielLichtblau It wouldn't - if you notice the input polynomial has to be symmetric in the sense I asked for the factors to be. As I have said in the edit - it's a bad question really. Also I solved it with a one liner. Just divide each polynomial by the Median of it's exponents. $\endgroup$ Commented Nov 19, 2024 at 21:28

3 Answers 3

Reset to default
1
$\begingroup$

You can try this substitution:

f = Factor[bigpoly] // Numerator
# /. {Plus[1,Power[x,a_],Power[x,b_]]/;b==2*a->Plus[1,Power[x,-a],Power[x,a]],1+x+x^2->1+1/x+x}& /@ f
Improve this answer
$\endgroup$
1
$\begingroup$

How about this? (Using the same idea as @yarchik's)

Clear["Global`*"]; 

reciprocalPolyRewrite[f_, var_ : x] := Module[{e, w},
  w = CoefficientList[f, var];
  If[w === Reverse[w],
   e = Exponent[f, var]/2;
   Expand[f/x^e]*x^e, f]
  ];

Factor[bigpoly] /. {f_?(PolynomialQ[#, x]&) :> reciprocalPolyRewrite[f]}

ans

Improve this answer
$\endgroup$
1
$\begingroup$

You can use

FactorSymmetricLaurent[poly_, x_] := 
 Module[{fpoly}, 
  fpoly = Times @@ (If[EvenQ[Exponent[#1, x]], 
        Expand[#1/x^(Exponent[#1, x]/2)]^#2, 
        Expand[#1*(#1 /. x -> 1/x)]^(#2/2)] & @@@ FactorList[poly]);
   Together[poly/fpoly] fpoly]

Then you have

FactorSymmetricLaurent[bigpoly, x]
(*==>(1 + 1/x + x) (1 + 1/x^3 + x^3) (1 + 1/x^9 + x^9) (1 + 1/x^27 + x^27)*)

This odd-looking If[EvenQ[Exponent[#1, x]],...] is needed to correctly handle cases like

FactorSymmetricLaurent[4 + 2/x^2 + 5/x + 5 x + 2 x^2, x]
(*==> (1/x + x) (5 + 2/x + 2 x)*)

Is it what you asked for?

Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.