










Study with the several resources on Docsity
Earn points by helping other students or get them with a premium plan
Prepare for your exams
Study with the several resources on Docsity
Earn points to download
Earn points by helping other students or get them with a premium plan
Community
Ask the community for help and clear up your study doubts
Discover the best universities in your country according to Docsity users
Free resources
Download our free guides on studying techniques, anxiety management strategies, and thesis advice from Docsity tutors
In this work, we formally proved Descartes Rule of Signs, which re- lates the number of positive real roots of a polynomial with the number of sign changes in ...
Typology: Study notes
1 / 18
This page cannot be seen from the preview
Don't miss anything!
Abstract In this work, we formally proved Descartes Rule of Signs, which re- lates the number of positive real roots of a polynomial with the number of sign changes in its coefficient list. Our proof follows the simple inductive proof given by Arthan [1], which was also used by John Harrison in his HOL Light formalisation. We proved most of the lemmas for arbitrary linearly-ordered integrity domains (e.g. integers, rationals, reals); the main result, however, requires the intermediate value theorem and was therefore only proven for real polynomials.
theory Descartes-Sign-Rule imports Complex-Main HOL−Computational-Algebra.Polynomial begin
lemma op-plus-0 : ((+) ( 0 :: ′a :: monoid-add)) = id by auto
lemma filter-dropWhile: filter (λx. ¬P x) (dropWhile P xs) = filter (λx. ¬P x) xs by (induction xs) simp-all
1.1 Polynomials
lemma pos-root-exI : assumes poly p 0 ∗ lead-coeff p < ( 0 :: real) obtains x where x > 0 poly p x = 0 proof − have P: ∃ x> 0. poly p x = ( 0 ::real) if lead-coeff p > 0 poly p 0 < 0 for p proof − note that( 1 ) also from poly-pinfty-gt-lc[OF ‹lead-coeff p > 0 ›] obtain x where
x. x ≥ x0 =⇒ poly p x ≥ lead-coeff p by auto hence poly p (max x0 1 ) ≥ lead-coeff p by auto finally have poly p (max x0 1 ) > 0. with that have ∃ x. x > 0 ∧ x < max x0 1 ∧ poly p x = 0 by (intro poly-IVT mult-neg-pos) auto thus ∃ x> 0. poly p x = 0 by auto qed
show ?thesis proof (cases lead-coeff p > 0 ) case True with assms have poly p 0 < 0 by (auto simp: mult-less-0-iff ) from P[OF True this] that show ?thesis by blast next case False from False assms have poly (−p) 0 < 0 by (auto simp: mult-less-0-iff ) moreover from assms have p 6 = 0 by auto with False have lead-coeff (−p) > 0 by (cases rule: linorder-cases[of lead-coeff p 0 ]) (simp-all add:) ultimately show ?thesis using that P[of −p] by auto qed qed
definition reduce-root where reduce-root a p = pcompose p [: 0 , a:]
lemma reduce-root-pCons: reduce-root a (pCons c p) = pCons c (smult a (reduce-root a p)) by (simp add: reduce-root-def pcompose-pCons)
also have... = x + y + (
i= 1 ..m. (y#xs)! i) by (auto simp: atLeast0AtMost [symmetric] sum.atLeast-Suc-atMost[of 0 ]) also have (
i= 1 ..m. (y#xs)! i) = (
i=Suc 1 ..Suc m. (x#y#xs)! i) by (subst sum.shift-bounds-cl-Suc-ivl) simp also from Suc have x + y +... = (
i≤n. (x#y#xs)! i) by (auto simp: atLeast0AtMost [symmetric] sum.atLeast-Suc-atMost add-ac) finally show ?thesis. qed simp qed simp-all
1.3 Sign changes in a list
definition sign-changes :: ( ′a :: {sgn,zero} list) ⇒ nat where sign-changes xs = length (remdups-adj (filter (λx. x 6 = 0 ) (map sgn xs))) − 1
lemma sign-changes-Nil [simp]: sign-changes [] = 0 by (simp add: sign-changes-def )
lemma sign-changes-singleton [simp]: sign-changes [x] = 0 by (simp add: sign-changes-def )
lemma sign-changes-cong: assumes map sgn xs = map sgn ys shows sign-changes xs = sign-changes ys using assms unfolding sign-changes-def by simp
lemma sign-changes-Cons-ge: sign-changes (x # xs) ≥ sign-changes xs unfolding sign-changes-def by (simp add: remdups-adj-Cons split: list.split)
lemma sign-changes-Cons-Cons-different: fixes x y :: ′a :: linordered-idom assumes x ∗ y < 0 shows sign-changes (x # y # xs) = 1 + sign-changes (y # xs) proof − from assms have sgn x = − 1 ∧ sgn y = 1 ∨ sgn x = 1 ∧ sgn y = − 1 by (auto simp: mult-less-0-iff ) thus ?thesis by (fastforce simp: sign-changes-def ) qed
lemma sign-changes-Cons-Cons-same: fixes x y :: ′a :: linordered-idom
shows x ∗ y > 0 =⇒ sign-changes (x # y # xs) = sign-changes (y # xs) by (subst (asm) zero-less-mult-iff ) (fastforce simp: sign-changes-def )
lemma sign-changes-0-Cons [simp]: sign-changes ( 0 # xs :: ′a :: idom-abs-sgn list) = sign-changes xs by (simp add: sign-changes-def )
lemma sign-changes-two: fixes x y :: ′a :: linordered-idom shows sign-changes [x,y] = (if x > 0 ∧ y < 0 ∨ x < 0 ∧ y > 0 then 1 else 0 ) by (auto simp: sgn-if sign-changes-def mult-less-0-iff )
lemma sign-changes-induct [case-names nil sing zero nonzero]: assumes P []
x. P [x]
∧ xs.^ P xs^ =⇒^ P^ (^0 #xs) x y xs. x 6 = 0 =⇒ P ((x + y) # xs) =⇒ P (x # y # xs) shows P xs proof (induction length xs arbitrary: xs rule: less-induct) case (less xs) show ?case proof (cases xs rule: psums.cases) fix x y xs ′^ assume xs = x # y # xs ′ with assms less show ?thesis by (cases x = 0 ) auto qed (insert less assms, auto) qed
lemma sign-changes-filter: fixes xs :: ′a :: linordered-idom list shows sign-changes (filter (λx. x 6 = 0 ) xs) = sign-changes xs by (simp add: sign-changes-def filter-map o-def sgn-0-0 )
lemma sign-changes-Cons-Cons-0 : fixes xs :: ′a :: linordered-idom list shows sign-changes (x # 0 # xs) = sign-changes (x # xs) by (subst (1 2 ) sign-changes-filter [symmetric]) simp-all
lemma sign-changes-uminus: fixes xs :: ′a :: linordered-idom list shows sign-changes (map uminus xs) = sign-changes xs proof − have sign-changes (map uminus xs) = length (remdups-adj [x←map sgn (map uminus xs). x 6 = 0 ]) − 1 unfolding sign-changes-def .. also have map sgn (map uminus xs) = map uminus (map sgn xs) by (auto simp: sgn-minus) also have remdups-adj (filter (λx. x 6 = 0 ).. .) = map uminus (remdups-adj (filter (λx. x 6 = 0 ) (map sgn xs))) by (subst filter-map, subst remdups-adj-map-injective) (simp-all add: o-def )
moreover from xy have sgn x = − sgn y by (auto simp: mult-less-0-iff ) moreover have even (sign-changes (y # xs ′′)) ←→ sgn (hd (y # xs ′′)) = sgn (last (y # xs ′′)) using xy less.prems by (intro less) (auto simp: x y) moreover from xy less.prems have sgn y = sgn (last xs) ←→ −sgn y 6 = sgn (last xs) by (auto simp: sgn-if ) ultimately show ?thesis by (auto simp: sign-changes-Cons-Cons-different x y) qed qed (auto simp: x) qed (insert less.prems, simp-all) qed
1.4 Arthan’s lemma
context begin
private lemma arthan-wlog [consumes 3 , case-names nonneg lift]: fixes xs :: ′a :: linordered-idom list assumes xs 6 = [] last xs 6 = 0 x + y + sum-list xs = 0 assumes
x y xs. xs 6 = [] =⇒ last xs 6 = 0 =⇒ x + y + sum-list xs = 0 =⇒ x ≥ 0 =⇒ P x y xs assumes
x y xs. xs 6 = [] =⇒ P x y xs =⇒ P (−x) (−y) (map uminus xs) shows P x y xs proof (cases x ≥ 0 ) assume x: ¬(x ≥ 0 ) from assms have map uminus xs 6 = [] by simp moreover from x assms( 1 , 2 , 3 ) have P (−x) (−y) (map uminus xs) using uminus-sum-list-map[of λx. x xs, symmetric] by (intro assms) (auto simp: last-map algebra-simps o-def neg-eq-iff-add-eq-0 ) ultimately have P (− (−x)) (− (−y)) (map uminus (map uminus xs)) by (rule assms) thus ?thesis by (simp add: o-def ) qed (simp-all add: assms)
private lemma arthan-aux1 : fixes xs :: ′a :: {linordered-idom} list assumes xs 6 = [] last xs 6 = 0 x + y + sum-list xs = 0 defines v ≡ λxs. int (sign-changes xs) shows v (x # y # xs) − v ((x + y) # xs) ≥ v (psums (x # y # xs)) − v (psums ((x + y) # xs)) ∧ even (v (x # y # xs) − v ((x + y) # xs) −
(v (psums (x # y # xs)) − v (psums ((x + y) # xs)))) using assms( 1 − 3 ) proof (induction rule: arthan-wlog) have uminus-v: v (map uminus xs) = v xs for xs by (simp add: v-def sign-changes-uminus)
case (lift x y xs) note lift( 2 ) also have v (psums (x#y#xs)) − v (psums ((x+y)#xs)) = v (psums (− x # − y # map uminus xs)) − v (psums ((− x + − y) # map uminus xs)) by (subst (1 2 ) uminus-v [symmetric]) (simp add: map-uminus-psums) also have v (x # y # xs) − v ((x + y) # xs) = v (−x # −y # map uminus xs) − v ((−x + −y) # map uminus xs) by (subst (1 2 ) uminus-v [symmetric]) simp finally show ?case. next case (nonneg x y xs) define p where p = (LEAST n. xs! n 6 = 0 ) define xs1 :: ′a list where xs1 = replicate p 0 define xs2 where xs2 = drop (Suc p) xs from nonneg have xs! (length xs − 1 ) 6 = 0 by (simp add: last-conv-nth) hence p-nz: xs! p 6 = 0 unfolding p-def by (rule LeastI ) { fix q assume q < p hence xs! q = 0 using Least-le[of λn. xs! n 6 = 0 q] unfolding p-def by force } note less-p-zero = this from Least-le[of λn. xs! n 6 = 0 length xs − 1 ] nonneg have p ≤ length xs − 1 unfolding p-def by (auto simp: last-conv-nth) with nonneg have p-less-length: p < length xs by (cases xs) simp-all
from p-less-length less-p-zero have take p xs = replicate p 0 by (subst list-eq-iff-nth-eq) auto with p-less-length have xs-decompose: xs = xs1 @ xs! p # xs unfolding xs1-def xs2-def by (subst append-take-drop-id [of p, symmetric], subst Cons-nth-drop-Suc) simp-all
have v-decompose: v (xs ′^ @ xs) = v (xs ′^ @ [xs! p]) + v (xs! p # xs2 ) for xs ′ proof − have xs ′^ @ xs = (xs ′^ @ xs1 ) @ xs! p # xs2 by (subst xs-decompose) simp also have v... = v (xs ′^ @ [xs! p]) + v (xs! p # xs2 ) unfolding v-def by (subst sign-changes-decompose[OF p-nz], subst (1 2 3 4 ) sign-changes-filter [symmetric]) (simp-all add: xs1-def ) finally show ?thesis. qed
have psums-decompose: psums xs = replicate p 0 @ psums (xs!p # xs2 ) by (subst xs-decompose) (simp add: xs1-def psums-replicate-0-append) have v-psums-decompose: sign-changes (xs ′^ @ psums xs) = sign-changes (xs ′^ @
add-ac) next assume xy: x + y = 0 show ?case proof (cases xs! p > 0 ) assume p: xs! p > 0 from p y have different ′: y ∗ xs! p < 0 by (intro mult-neg-pos) with v-decompose[of [x, y]] v-decompose[of [x+y]] x xy p different different ′
v-psums-decompose[of [x]] v-psums-decompose[of []] show ?thesis by (auto simp add: algebra-simps v-def sign-changes-Cons-Cons-
sign-changes-Cons-Cons-different sign-changes-Cons-Cons-same) next assume ¬(xs! p > 0 ) with p-nz have p: xs! p < 0 by simp from p y have same: y ∗ xs! p > 0 by (intro mult-neg-neg) from p x have different ′: x ∗ xs! p < 0 by (intro mult-pos-neg) from v-decompose[of [x, y]] v-decompose[of [x+y]] xy different different ′ same v-psums-decompose[of [x]] v-psums-decompose[of []] show ?thesis by (auto simp add: algebra-simps v-def sign-changes-Cons-Cons-
sign-changes-Cons-Cons-different sign-changes-Cons-Cons-same) qed next assume xy: x + y > 0 from x and this have same: x ∗ (x + y) > 0 by (rule mult-pos-pos) show ?case proof (cases xs! p > 0 ) assume p: xs! p > 0 from xy p have same ′: (x + y) ∗ xs! p > 0 by (intro mult-pos-pos) from p y have different ′: y ∗ xs! p < 0 by (intro mult-neg-pos) have (λt. t + (x + y)) = ((+) (x + y)) by (rule ext) simp with v-decompose[of [x, y]] v-decompose[of [x+y]] different different ′^ same same ′ show ?thesis by (auto simp add: algebra-simps v-def psums-Cons o-def sign-changes-Cons-Cons-different sign-changes-Cons-Cons-same) next assume ¬(xs! p > 0 ) with p-nz have p: xs! p < 0 by simp from xy p have different ′: (x + y) ∗ xs! p < 0 by (rule mult-pos-neg) from y p have same ′: y ∗ xs! p > 0 by (rule mult-neg-neg) have (λt. t + (x + y)) = ((+) (x + y)) by (rule ext) simp with v-decompose[of [x, y]] v-decompose[of [x+y]] different different ′^ same same ′ show ?thesis by (auto simp add: algebra-simps v-def psums-Cons o-def sign-changes-Cons-Cons-different sign-changes-Cons-Cons-same) qed
qed qed qed qed
lemma arthan: fixes xs :: ′a :: linordered-idom list assumes xs 6 = [] last xs 6 = 0 sum-list xs = 0 shows sign-changes xs > sign-changes (psums xs) ∧ odd (sign-changes xs − sign-changes (psums xs)) using assms proof (induction xs rule: sign-changes-induct) case (nonzero x y xs) show ?case proof (cases xs = []) case False define α where α = int (sign-changes (x # y # xs)) − int (sign-changes ((x
end
1.5 Roots of a polynomial with a certain property
definition roots-with P p = {x. P x ∧ poly p x = 0 }
definition count-roots-with P p = (
x∈roots-with P p. order x p)
abbreviation pos-roots ≡ roots-with (λx. x > 0 ) abbreviation count-pos-roots ≡ count-roots-with (λx. x > 0 )
1.6 Coefficient sign changes of a polynomial
abbreviation (input) coeff-sign-changes f ≡ sign-changes (coeffs f )
lemma sign-changes-coeff-sign-changes: assumes Poly xs = (p :: ′a :: linordered-idom poly) shows sign-changes xs = coeff-sign-changes p proof − have coeffs p = coeffs (Poly xs) by (subst assms) (rule refl) also have... = strip-while ((=) 0 ) xs by simp also have filter (( 6 =) 0 )... = filter (( 6 =) 0 ) xs unfolding strip-while-def o-def by (subst rev-filter [symmetric], subst filter-dropWhile) (simp-all add: rev-filter) also have sign-changes... = sign-changes xs by (simp add: sign-changes-filter) finally show ?thesis by (simp add: sign-changes-filter) qed
lemma coeff-sign-changes-reduce-root: assumes a > ( 0 :: ′a :: linordered-idom) shows coeff-sign-changes (reduce-root a p) = coeff-sign-changes p proof (intro sign-changes-cong, induction p) case (pCons c p) have map sgn (coeffs (reduce-root a (pCons c p))) = cCons (sgn c) (map sgn (coeffs (reduce-root a p))) using assms by (auto simp add: cCons-def sgn-0-0 sgn-mult reduce-root-pCons coeffs-smult) also note pCons.IH also have cCons (sgn c) (map sgn (coeffs p)) = map sgn (coeffs (pCons c p)) using assms by (auto simp add: cCons-def sgn-0-0 ) finally show ?case. qed (simp-all add: reduce-root-def )
lemma coeff-sign-changes-smult: assumes a > ( 0 :: ′a :: linordered-idom) shows coeff-sign-changes (smult a p) = coeff-sign-changes p using assms by (auto intro!: sign-changes-cong simp: sgn-mult coeffs-smult)
context
begin
private lemma odd-coeff-sign-changes-imp-pos-roots-aux: assumes [simp]: p 6 = ( 0 :: real poly) poly p 0 6 = 0 assumes odd (coeff-sign-changes p) obtains x where x > 0 poly p x = 0 proof − from ‹poly p 0 6 = 0 › have [simp]: hd (coeffs p) 6 = 0 by (induct p) auto from assms have ¬ even (coeff-sign-changes p) by blast also have even (coeff-sign-changes p) ←→ sgn (hd (coeffs p)) = sgn (lead-coeff p) by (auto simp add: even-sign-changes-iff last-coeffs-eq-coeff-degree) finally have sgn (hd (coeffs p)) ∗ sgn (lead-coeff p) < 0 by (auto simp: sgn-if split: if-split-asm) also from ‹p 6 = 0 › have hd (coeffs p) = poly p 0 by (induction p) auto finally have poly p 0 ∗ lead-coeff p < 0 by (auto simp: mult-less-0-iff )
from pos-root-exI [OF this] that show ?thesis by blast qed
lemma odd-coeff-sign-changes-imp-pos-roots: assumes p 6 = ( 0 :: real poly) assumes odd (coeff-sign-changes p) obtains x where x > 0 poly p x = 0 proof − define s where s = sgn (lead-coeff p) define n where n = order 0 p define r where r = p div [: 0 , 1 :] ^ n have p: p = [: 0 , 1 :] ^ n ∗ r unfolding r-def n-def using order-1 [of 0 p] by (simp del: mult-pCons-left)
also from coeff-poly-times-one-minus-x[of Poly ys i] assms have... = (
j≤i. coeff (Poly xs) j) by simp also from i have... = psums xs! i by (auto simp: nth-default-def psums-nth) finally show ys! i = psums xs! i. qed simp-all
lemma sign-changes-poly-times-one-minus-x: fixes g :: ′a :: linordered-idom poly and a :: ′a assumes nz: g 6 = 0 defines v ≡ coeff-sign-changes shows v ([: 1 , − 1 :] ∗ g) − v g > 0 ∧ odd (v ([: 1 , − 1 :] ∗ g) − v g) proof − define xs where xs = coeffs ([: 1 , − 1 :] ∗ g) define ys where ys = coeffs g @ [ 0 ] have ys: ys = psums xs proof (rule Poly-times-one-minus-x-eq-psums) show length xs = length ys unfolding xs-def ys-def by (simp add: length-coeffs nz degree-mult-eq no-zero-divisors del: mult-pCons-left) show Poly xs = Poly ys ∗ [: 1 , − 1 :] unfolding xs-def ys-def by (simp only: Poly-snoc Poly-coeffs) simp qed have sign-changes (psums xs) < sign-changes xs ∧ odd (sign-changes xs − sign-changes (psums xs)) proof (rule arthan) show xs 6 = [] by (auto simp: xs-def nz simp del: mult-pCons-left) then show sum-list xs = 0 by (simp add: last-psums [symmetric] ys [symmetric] ys-def ) show last xs 6 = 0 by (auto simp: xs-def nz last-coeffs-eq-coeff-degree simp del: mult-pCons-left) qed with ys have sign-changes ys < sign-changes xs ∧ odd (sign-changes xs − sign-changes ys) by simp also have sign-changes xs = v ([: 1 , − 1 :] ∗ g) unfolding v-def by (intro sign-changes-coeff-sign-changes) (simp-all add: xs-def ) also have sign-changes ys = v g unfolding v-def by (intro sign-changes-coeff-sign-changes) (simp-all add: ys-def Poly-snoc) finally show ?thesis by simp qed
lemma sign-changes-poly-times-root-minus-x: fixes g :: ′a :: linordered-idom poly and a :: ′a
assumes nz: g 6 = 0 and pos: a > 0 defines v ≡ coeff-sign-changes shows v ([:a, − 1 :] ∗ g) − v g > 0 ∧ odd (v ([:a, − 1 :] ∗ g) − v g) proof − have 0 < v ([: 1 , − 1 :] ∗ reduce-root a g) − v (reduce-root a g) ∧ odd (v ([: 1 , − 1 :] ∗ reduce-root a g) − v (reduce-root a g)) using nz pos unfolding v-def by (intro sign-changes-poly-times-one-minus-x) simp-all also have v ([: 1 , − 1 :] ∗ reduce-root a g) = v (smult a ([: 1 , − 1 :] ∗ reduce-root a g)) unfolding v-def by (simp add: coeff-sign-changes-smult pos) also have smult a ([: 1 , − 1 :] ∗ reduce-root a g) = [:a:] ∗ [: 1 , − 1 :] ∗ reduce-root a g by (subst mult.assoc) simp also have [:a:] ∗ [: 1 , − 1 :] = reduce-root a [:a, − 1 :] by (simp add: reduce-root-def pcompose-pCons) also have... ∗ reduce-root a g = reduce-root a ([:a, − 1 :] ∗ g) unfolding reduce-root-def by (simp only: pcompose-mult) also have v... = v ([:a, − 1 :] ∗ g) by (simp add: v-def coeff-sign-changes-reduce-root pos) also have v (reduce-root a g) = v g by (simp add: v-def coeff-sign-changes-reduce-root pos) finally show ?thesis. qed
lemma descartes-sign-rule-aux: fixes p :: real poly assumes p 6 = 0 shows coeff-sign-changes p ≥ count-pos-roots p ∧ even (coeff-sign-changes p − count-pos-roots p) using assms proof (induction p rule: poly-root-induct[ where P = λa. a > 0 ]) case (root a p) define q where q = [:a, − 1 :] ∗ p from root.prems have p: p 6 = 0 by auto with root p sign-changes-poly-times-root-minus-x[of p a] count-roots-with-times-root[of p λx. x > 0 a] show ?case by (fold q-def ) fastforce next case (no-roots p) from no-roots have pos-roots p = {} by (auto simp: roots-with-def ) hence [simp]: count-pos-roots p = 0 by (simp add: count-roots-with-def ) thus ?case using no-roots ‹p 6 = 0 › odd-coeff-sign-changes-imp-pos-roots[of p] by (auto simp: roots-with-def ) qed simp-all