4
$\begingroup$

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?

$\endgroup$
10
$\begingroup$

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

$\endgroup$
7
$\begingroup$

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
$\endgroup$
5
$\begingroup$

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
$\endgroup$
3
$\begingroup$

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
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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