In 1931, Alfred Tarski proved that the real ordered field Image may be NSFW.
Clik here to view.
allows quantifier elimination: i.e., every first-order formula is equivalent to one with no quantifiers. This is implemented in Mathematica’s “Resolve” function.
The Resolve function is called like Resolve[formula,domain] where domain gives the domain for the quantifiers in formula. Since we’ll always be working over Image may be NSFW.
Clik here to view.
in this blog post, let’s set that to be the default at the start.
In[1]:= Unprotect[Resolve]; Resolve[expr_] := Resolve[expr, Reals]; Protect[Resolve];
Now let’s see what quantifier elimination lets you do!
(A couple of caveats first though: First, many of these algorithms are extremely inefficient. Second, I had some trouble exporting the Mathematica notebook, so I basically just copy-and-pasted the text. Apologies if it’s unreadable.)
How many solutions?
Let’s start with just existential formulas. By eliminating quantifiers from Image may be NSFW.
Clik here to view.
, we can tell what the conditions are on a such that there’s at least one solution Image may be NSFW.
Clik here to view.
. For example:
In[2]:= Resolve[Exists[x, x^2 + b x + c == 0]]
Out[2]= -b^2 + 4 c <= 0
This just tells you that there’s a solution to the quadratic if the discriminant is non-negative. Let’s turn this into a function:
In[3]:= atLeastOneSolution[formula_, variable_] := Resolve[Exists[variable, formula]]
Now we can verify that cubics always have solutions:
In[4]:= atLeastOneSolution[x^3 + b x^2 + c x + d == 0, x]
Out[4]= True
Now suppose we wanted to find when something has at least two solutions. Just like resolving Image may be NSFW.
Clik here to view.
told us when there was at least one, Image may be NSFW.
Clik here to view.
will be true exactly when there are at least two.
This is just as easy to program as atLeastOneSolution was, except that when we create the variables Image may be NSFW.
Clik here to view.
and Image may be NSFW.
Clik here to view.
we have to be careful to avoid capture (what if one of those two already appeared in Image may be NSFW.
Clik here to view.
?). Mathematica provides a function called Unique where if you call Unique[], you’re guaranteed to get back a variable that’s never been used before. With that we can define atLeastTwoSolutions correctly (edit: actually, this isn’t right if the passed-in variable is also bound in the passed-in formula):
In[5]:= atLeastTwoSolutions[formula_, v_] :=
With[{s1 = Unique[], s2 = Unique[]},
Resolve[
Exists[{s1, s2},
s1 != s2 && (formula /. v -> s1) && (formula /. v -> s2)]]]
We can check this by verifying that quadratics have two solutions when the discriminant is strictly positive:
In[6]:= atLeastTwoSolutions[x^2 + b x + c == 0, x]
Out[6]= -b^2 + 4 c < 0
Here’s the condition for the cubic to have at least two solutions:
In[7]:= atLeastTwoSolutions[x^3 + b x^2 + c x + d == 0, x]
Out[7]= c < b^2/3 &&
1/27 (-2 b^3 + 9 b c) - 2/27 Sqrt[b^6 - 9 b^4 c + 27 b^2 c^2 - 27 c^3] <=
d <= 1/27 (-2 b^3 + 9 b c) + 2/27 Sqrt[b^6 - 9 b^4 c + 27 b^2 c^2 - 27 c^3]
Note that (and I believe Resolve always does this) the Image may be NSFW.
Clik here to view.
condition given first is sufficient that the later square root is well-defined:
In[8]:= Resolve[ForAll[{b, c}, c < b^2/3 ⇒ b^6 - 9 b^4 c + 27 b^2 c^2 - 27 c^3 > 0]]
Out[8]= True
It’s clear that we can determine when there at least n solutions by a very similar trick: just resolve Image may be NSFW.
Clik here to view.
.
We’ll first write a helper function to produce the conjunction of inequalities we’ll need:
In[9]:= noneEqual[vars_] :=
And @@ Flatten[Table[If[s1 === s2, True, s1 != s2], {s1, vars}, {s2, vars}]]
In[10]:= noneEqual[{x, y, z}]
Out[10]= x != y && x != z && y != x && y != z && z != x && z != y
And now we’ll write atLeastNSolutions:
In[11]:= atLeastNSolutions[formula_, v_, n_] := With[{sList = Array[Unique[] &, n]},
Resolve[
Exists[sList,
noneEqual[sList] && (And @@ Table[formula /. v -> s, {s, sList}])]]]
Given atLeastNSolutions, we can easily write exactlyNSolutions:
In[12]:= exactlyNSolutions[formula_, v_, n_] :=
BooleanConvert[
atLeastNSolutions[formula, v, n] && ! atLeastNSolutions[formula, v, n + 1]]
I used BooleanConvert instead of Resolve since there won’t be any quantifiers left in the formula, so we just have to do Boolean simplifications.
In[13]:= exactlyNSolutions[x^3 + b x^2 + c x + d == 0, x, 2]
Out[13]= ! 1/27 (-2 b^3 + 9 b c) - 2/27 Sqrt[b^6 - 9 b^4 c + 27 b^2 c^2 - 27 c^3] < d <
1/27 (-2 b^3 + 9 b c) + 2/27 Sqrt[b^6 - 9 b^4 c + 27 b^2 c^2 - 27 c^3] &&
1/27 (-2 b^3 + 9 b c) - 2/27 Sqrt[b^6 - 9 b^4 c + 27 b^2 c^2 - 27 c^3] <=
d <= 1/27 (-2 b^3 + 9 b c) +
2/27 Sqrt[b^6 - 9 b^4 c + 27 b^2 c^2 - 27 c^3] && c < b^2/3
In[14]:= exactlyNSolutions[x^2 + b x + c == 0, x, 1]
Out[14]= -b^2 + 4 c <= 0 && -b^2 + 4 c >= 0
This last calculation shows that a quadratic has exactly one solution exactly when the discriminant is both nonnegative and nonpositive (as you can see, there is no guarantee that the formula will be in it’s simplest form).
We now have a way to test whether a formula with one free variable has Image may be NSFW.
Clik here to view.
Clik here to view.exactlyNSolutions will return either True or False if you quantify out the only variable. For example:
In[15]:= p = x^4 - 3 x^3 + 1
Out[15]= 1 - 3 x^3 + x^4
In[16]:= Plot[Evaluate[p], {x, -3, 3}]
Image may be NSFW.
Clik here to view.
In[17]:= exactlyNSolutions[p == 0, x, 2]
Out[17]= True
It would be nice, however, to have a function which will just tell you how many solutions such a formula has.
In the single-variable polynomial case, we could just try exactlyNSolutions for Image may be NSFW.
Clik here to view.
Clik here to view.
Clik here to view.
How can we tell if a formula has infinitely many solutions? Well, the fact that Image may be NSFW.
Clik here to view.
Clik here to view.
Clik here to view.
Clik here to view.
Clik here to view.
Clik here to view.
Clik here to view.
Clik here to view.
In[18]:= infinitelyManySolutions[formula_, v_] := With[{a = Unique[], b = Unique[]},
Resolve[Exists[{a, b}, a < b && ForAll[v, a < v < b ⇒ formula]]]]
To test:
In[19]:= infinitelyManySolutions[Exists[y, x^2 + y^2 == 1], x]
Out[19]= True
Now we can write numberOfSolutions and be assured that it will always (theoretically) terminate for any formula with a single free variable:
In[20]:= numberOfSolutions[formula_, v_] :=
If[infinitelyManySolutions[formula, v], Infinity,
Block[{n = 0},
While[! exactlyNSolutions[formula, v, n], n++];
n]]
A few examples:
In[21]:= numberOfSolutions[p == 0, x]
Out[21]= 2
In[22]:= numberOfSolutions[p > x^2, x]
Out[22]= ∞
In[23]:= numberOfSolutions[p > x^6 + 5, x]
Out[23]= ∞
In[24]:= numberOfSolutions[p > x^6 + 6, x]
Out[24]= 0
In[26]:= Plot[{p, x^6 + 5, x^6 + 6}, {x, -1.6, -1},
PlotLegend -> {HoldForm[p], x^6 + 5, x^6 + 6}, LegendPosition -> {1, 0},
ImageSize -> Large]
Image may be NSFW.
Clik here to view.
Up to now, all our functions have taken single variables, but we can accomodate tuples of variables as well. First, we’ll define the analogue of noneEqual to produce the formula asserting that none of the given tuples are equal (recall that two tuples are unequal iff a pair of corresponding components is unequal):
In[27]:= noTuplesEqual[tuples_] := And @@ Flatten[Table[If[t1 === t2, True,
Or @@ MapThread[#1 != #2 &, {t1, t2}]], {t1, tuples}, {t2, tuples}]]
In[28]:= noTuplesEqual[{{x[1], y[1]}, {x[2], y[2]}}]
Out[28]= (x[1] != x[2] || y[1] != y[2]) && (x[2] != x[1] || y[2] != y[1])
Now we can add rules to our old function to deal with tuples of variables as well:
In[29]:= atLeastNSolutions[formula_, variables_List, n_] := With[
{sList = Array[Unique[] &, {n, Length[variables]}]},
Resolve[
Exists[Evaluate[Flatten[sList]],
noTuplesEqual[sList] &&
And @@
Table[
formula /. MapThread[Rule, {variables, tuple}], {tuple, sList}]]]];
We can extend infinitelyManySolutions by observing that a formula Image may be NSFW.
Clik here to view.
Clik here to view.
In[30]:= infinitelyManySolutions[formula_, variables_List] := Or @@ Table[
infinitelyManySolutions[Exists[Select[variables, ! (# === v) &], formula],
v], {v, variables}]
In[33]:= ContourPlot[{x^2 + y^3 - 2, x^2 + y^2/4 - 2}, {x, -3, 3}, {y, -3, 3}]
Image may be NSFW.
Clik here to view.
In[34]:= exactlyNSolutions[x^2 + y^3 == 2 && x^2 + y^2/4 == 2, {x, y}, 2]
Out[34]= False
(There are actually four solutions. This example of a set equations for which it’s difficult to tell how many solutions there are by graphing is from Stan Wagon)
Solving Polynomial Equations
In the last section, we saw how to use quantifier elimination to find out how many roots there are. But how can you actually find the roots?
In a certain sense, you’ve already found them just when you identified how many there are! To “find” a root in this sense, you just introduce a new symbol for it, and have some means for answering questions about its properties. Given some property Image may be NSFW.
Clik here to view.
Clik here to view.
Clik here to view.
We can implement this by a function withSpecificRoot, that takes a variable, the formula it’s supposed to be a solution to, which of the roots it’s a solution to, and a formula in which you want to use this root:
In[35]:= withSpecificRoot[variable_, rootFormula_, whichRoot_, totalRoots_, formula_] :=
With[{roots = Array[Unique[] &, totalRoots]},
Resolve[
Exists[Evaluate[roots~Join~{variable}],
Less[Sequence @@ roots] &&
variable ==
roots[[whichRoot]] &&
(And @@
Table[(rootFormula /. variable -> root), {root, roots}]) && formula]]]
We can tell where various roots are with respect to already-known real numbers:
In[36]:= withSpecificRoot[x, x^2 - 3 == 0, 1, 2, x < 3]
Out[36]= True
In[37]:= withSpecificRoot[x, p == 0, 1, 2, x < 1]
Out[37]= True
In[38]:= withSpecificRoot[x, p == 0, 2, 2, x < 1]
Out[38]= False
We can also compute relationships between roots like Image may be NSFW.
Clik here to view.
In[39]:= withSpecificRoot[sqrt6, sqrt6^2 == 6, 2, 2,
withSpecificRoot[lhs, lhs^2 == 5 + 2 sqrt6, 2, 2,
withSpecificRoot[sqrt3, sqrt3^2 == 3, 2, 2,
withSpecificRoot[sqrt2, sqrt2^2 == 2, 2, 2,
lhs == sqrt3 + sqrt2
]]]]
Out[39]= True
That’s all I have time for now, but I hope to write another blog post on the subject soon!