# How to compute MIN$(A(x), B(x))$

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?

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

With exact coefficient lists you can do the following:

a = {1, 3, 5};
b = {3, 2, 4};

 {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


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


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}), #[] &] /. {{a_} ->
b_} :> {{a} -> b, {a} -> 0};
ncl = First /@ (SortBy[#, #[] &] & /@ cl);
Total[(#[] x^First@#[]) & /@ 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