Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I have two polynomials: $\;A(x) = \sum a_i\;x^i$, $\quad B(x) = \sum b_i\;x^i$.
Given $A(x)$, $B(x)$, I want to compute $\;C(x) = $MIN$(A(x), B(x)) = c_i\;x^i$ where $c_i = $MIN$(a_i, b_i)$.

How can I do it automatically in Mathematica?

share|improve this question
add comment

4 Answers

up vote 8 down vote accepted

Another one, possibly shorter, which works with any number of unequal degree polys:

f[p_, x_] := FromDigits[Min @@@ Reverse@Transpose@PadRight@CoefficientList[p, x], x]

Expand@f[{6 - 5 x +   x^2 + 2 x^3 + 4 x^4 + 4 x^5 - 2 x^6, 
         -4 + 7 x - 3 x^2 - 3 x^3 + 5 x^4}               , x]

-4 - 5 x - 3 x^2 - 3 x^3 + 4 x^4 - 2 x^6

Works for any number of polys:

Expand@f[{6 - 5 x +   x^2 + 2 x^3 + 4 x^4 + 4 x^5 - 2 x^6, 
         -4 + 7 x - 3 x^2 - 3 x^3 + 5 x^4, 
        -11 -11 x}                                       , x]

-11 - 11 x - 3 x^2 - 3 x^3 - 2 x^6

share|improve this answer
1  
Thanks to @ssch :) chat.stackexchange.com/transcript/message/11805319#11805319 –  belisarius Oct 22 '13 at 15:11
add comment

With exact coefficient lists you can do the following:

a = {1, 3, 5};
b = {3, 2, 4};
c = MapThread[Min, {a, b}]
 {1, 2, 4}

With polynimials:

pa = 1 + 3 x + 5 x^2;
pb = 3 + 2 x + 3 x^2;

Plus @@ MapIndexed[Min[#1] x^(First[#2] - 1) &, Transpose@CoefficientList[{pa, pb}, x]]
1 + 2 x + 4 x^2

Update: generalization to any number of nonaligned polynomials (inspired by ubpdqn)

f[p_, x_] := FromCoefficientRules[#[[1, 1]] -> Min@PadRight[#[[All, 2]], Length[p]] & /@ 
     GatherBy[Join @@ CoefficientRules[p, x], First], x]

f[{6 - 5 x + x^2 + 2 x^3 + 4 x^4 + 4 x^5 - 2 x^6, -4 + 7 x - 3 x^2 - 3 x^3 + 5 x^4}, x]
-4 - 5 x - 3 x^2 - 3 x^3 + 2 x^4 - 2 x^6
share|improve this answer
add comment

Here is the way to work with any number of polynomials of different orders:

minPoly[polys_List, var_] := With[{rg = Range[0, Max @ Exponent[polys, var]]}, 
                                  Min @ Coefficient[ polys, var, #]& /@ rg.var^rg]

Let's choose a list of polynomials, e.g.

{a1, a2, a3} = {10        - 2 x^2 - 8 x^3 +   x^4 - 4 x^5 + 3 x^6,
                -8 +  2 x - 2 x^2 + 2 x^3 +   x^4 + 2 x^5 + 9 x^6 - 4 x^7,
                -8 + 10 x + 2 x^2 -   x^3 - 4 x^4 - 4 x^5 - 2 x^6 +   x^7 - 10 x^8}; 

then we have

minPoly[{a1, a2, a3}, x]
-8 - 2 x^2 - 8 x^3 - 4 x^4 - 4 x^5 - 2 x^6 - 4 x^7 - 10 x^8

If we know that orders of the polynomials are equal, for example:

A[x_]:= -4 - x + 2 x^2 - x^3 + 4 x^4 + x^5
B[x_]:= 10 + 5 x^2 - 3 x^3 - 7 x^4 - 2 x^5

this is another approach:

x^Range[0, 5].MapThread[ Min, CoefficientList[{A[x], B[x]}, x]] 
-4 - x + 2 x^2 - 3 x^3 - 7 x^4 - 2 x^5

of course minPoly works nicely as well:

minPoly[{A[x], B[x]}, x]
-4 - x + 2 x^2 - 3 x^3 - 7 x^4 - 2 x^5
share|improve this answer
add comment

On the off chance that the polynomials have unequal highest degree (hence unequal coefficient list lengths):

func[u_, v_, x_] := Module[{cl, ncl},
  cl = GatherBy[
     Join @@ (CoefficientRules[#] & /@ {u, v}), #[[1]] &] /. {{a_} -> 
       b_} :> {{a} -> b, {a} -> 0};
  ncl = First /@ (SortBy[#, #[[2]] &] & /@ cl);
  Total[(#[[2]] x^First@#[[1]]) & /@ ncl]
  ]

Testing:

 6 - 5 x + x^2 + 2 x^3 + 4 x^4 + 4 x^5 - 2 x^6
-4 + 7 x - 3 x^2 - 3 x^3 + 5 x^4

then

func[6 - 5 x + x^2 + 2 x^3 + 4 x^4 + 4 x^5 - 2 x^6,
 -4 + 7 x - 3 x^2 - 3 x^3 + 5 x^4, x]

yields:

-4 - 5 x - 3 x^2 - 3 x^3 + 4 x^4 - 2 x^6
share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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