| author | wenzelm | 
| Wed, 24 Jun 2015 21:26:03 +0200 | |
| changeset 60565 | b7ee41f72add | 
| parent 60537 | 5398aa5a4df9 | 
| child 60698 | 29e8bdc41f90 | 
| permissions | -rw-r--r-- | 
| 33268 
02de0317f66f
eliminated hard tabulators, guessing at each author's individual tab-width;
 wenzelm parents: 
33153diff
changeset | 1 | (* Title: HOL/Decision_Procs/Polynomial_List.thy | 
| 
02de0317f66f
eliminated hard tabulators, guessing at each author's individual tab-width;
 wenzelm parents: 
33153diff
changeset | 2 | Author: Amine Chaieb | 
| 33153 | 3 | *) | 
| 4 | ||
| 60533 | 5 | section \<open>Univariate Polynomials as lists\<close> | 
| 33153 | 6 | |
| 7 | theory Polynomial_List | |
| 54219 | 8 | imports Complex_Main | 
| 33153 | 9 | begin | 
| 10 | ||
| 60536 | 11 | text \<open>Application of polynomial as a function.\<close> | 
| 33153 | 12 | |
| 54219 | 13 | primrec (in semiring_0) poly :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a" | 
| 52778 | 14 | where | 
| 60536 | 15 | poly_Nil: "poly [] x = 0" | 
| 16 | | poly_Cons: "poly (h # t) x = h + x * poly t x" | |
| 33153 | 17 | |
| 18 | ||
| 60536 | 19 | subsection \<open>Arithmetic Operations on Polynomials\<close> | 
| 33153 | 20 | |
| 60536 | 21 | text \<open>Addition\<close> | 
| 54219 | 22 | primrec (in semiring_0) padd :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixl "+++" 65) | 
| 52778 | 23 | where | 
| 60536 | 24 | padd_Nil: "[] +++ l2 = l2" | 
| 25 | | padd_Cons: "(h # t) +++ l2 = (if l2 = [] then h # t else (h + hd l2) # (t +++ tl l2))" | |
| 33153 | 26 | |
| 60536 | 27 | text \<open>Multiplication by a constant\<close> | 
| 54219 | 28 | primrec (in semiring_0) cmult :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixl "%*" 70) where | 
| 60536 | 29 | cmult_Nil: "c %* [] = []" | 
| 54219 | 30 | | cmult_Cons: "c %* (h#t) = (c * h)#(c %* t)" | 
| 33153 | 31 | |
| 60536 | 32 | text \<open>Multiplication by a polynomial\<close> | 
| 54219 | 33 | primrec (in semiring_0) pmult :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixl "***" 70) | 
| 52778 | 34 | where | 
| 60536 | 35 | pmult_Nil: "[] *** l2 = []" | 
| 36 | | pmult_Cons: "(h # t) *** l2 = (if t = [] then h %* l2 else (h %* l2) +++ (0 # (t *** l2)))" | |
| 33153 | 37 | |
| 60536 | 38 | text \<open>Repeated multiplication by a polynomial\<close> | 
| 39 | primrec (in semiring_0) mulexp :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" | |
| 40 | where | |
| 41 | mulexp_zero: "mulexp 0 p q = q" | |
| 42 | | mulexp_Suc: "mulexp (Suc n) p q = p *** mulexp n p q" | |
| 33153 | 43 | |
| 60536 | 44 | text \<open>Exponential\<close> | 
| 45 | primrec (in semiring_1) pexp :: "'a list \<Rightarrow> nat \<Rightarrow> 'a list" (infixl "%^" 80) | |
| 46 | where | |
| 47 | pexp_0: "p %^ 0 = [1]" | |
| 39246 | 48 | | pexp_Suc: "p %^ (Suc n) = p *** (p %^ n)" | 
| 33153 | 49 | |
| 60536 | 50 | text \<open>Quotient related value of dividing a polynomial by x + a. | 
| 51 | Useful for divisor properties in inductive proofs.\<close> | |
| 54219 | 52 | primrec (in field) "pquot" :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" | 
| 52778 | 53 | where | 
| 60536 | 54 | pquot_Nil: "pquot [] a = []" | 
| 55 | | pquot_Cons: "pquot (h # t) a = | |
| 56 | (if t = [] then [h] else (inverse a * (h - hd( pquot t a))) # pquot t a)" | |
| 33153 | 57 | |
| 60536 | 58 | text \<open>Normalization of polynomials (remove extra 0 coeff).\<close> | 
| 59 | primrec (in semiring_0) pnormalize :: "'a list \<Rightarrow> 'a list" | |
| 60 | where | |
| 61 | pnormalize_Nil: "pnormalize [] = []" | |
| 62 | | pnormalize_Cons: "pnormalize (h # p) = | |
| 54219 | 63 | (if pnormalize p = [] then (if h = 0 then [] else [h]) else h # pnormalize p)" | 
| 33153 | 64 | |
| 60536 | 65 | definition (in semiring_0) "pnormal p \<longleftrightarrow> pnormalize p = p \<and> p \<noteq> []" | 
| 66 | definition (in semiring_0) "nonconstant p \<longleftrightarrow> pnormal p \<and> (\<forall>x. p \<noteq> [x])" | |
| 67 | ||
| 68 | text \<open>Other definitions.\<close> | |
| 33153 | 69 | |
| 54219 | 70 | definition (in ring_1) poly_minus :: "'a list \<Rightarrow> 'a list" ("-- _" [80] 80)
 | 
| 52778 | 71 | where "-- p = (- 1) %* p" | 
| 33153 | 72 | |
| 54219 | 73 | definition (in semiring_0) divides :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" (infixl "divides" 70) | 
| 60536 | 74 | where "p1 divides p2 \<longleftrightarrow> (\<exists>q. poly p2 = poly(p1 *** q))" | 
| 54219 | 75 | |
| 60536 | 76 | lemma (in semiring_0) dividesI: "poly p2 = poly (p1 *** q) \<Longrightarrow> p1 divides p2" | 
| 54219 | 77 | by (auto simp add: divides_def) | 
| 33153 | 78 | |
| 54219 | 79 | lemma (in semiring_0) dividesE: | 
| 80 | assumes "p1 divides p2" | |
| 81 | obtains q where "poly p2 = poly (p1 *** q)" | |
| 82 | using assms by (auto simp add: divides_def) | |
| 33153 | 83 | |
| 60536 | 84 | -- \<open>order of a polynomial\<close> | 
| 85 | definition (in ring_1) order :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" | |
| 86 | where "order a p = (SOME n. ([-a, 1] %^ n) divides p \<and> \<not> (([-a, 1] %^ (Suc n)) divides p))" | |
| 54219 | 87 | |
| 60536 | 88 | -- \<open>degree of a polynomial\<close> | 
| 54219 | 89 | definition (in semiring_0) degree :: "'a list \<Rightarrow> nat" | 
| 52778 | 90 | where "degree p = length (pnormalize p) - 1" | 
| 33153 | 91 | |
| 60536 | 92 | -- \<open>squarefree polynomials --- NB with respect to real roots only\<close> | 
| 54219 | 93 | definition (in ring_1) rsquarefree :: "'a list \<Rightarrow> bool" | 
| 94 | where "rsquarefree p \<longleftrightarrow> poly p \<noteq> poly [] \<and> (\<forall>a. order a p = 0 \<or> order a p = 1)" | |
| 33153 | 95 | |
| 54219 | 96 | context semiring_0 | 
| 97 | begin | |
| 98 | ||
| 99 | lemma padd_Nil2[simp]: "p +++ [] = p" | |
| 52778 | 100 | by (induct p) auto | 
| 33153 | 101 | |
| 102 | lemma padd_Cons_Cons: "(h1 # p1) +++ (h2 # p2) = (h1 + h2) # (p1 +++ p2)" | |
| 52778 | 103 | by auto | 
| 33153 | 104 | |
| 54219 | 105 | lemma pminus_Nil: "-- [] = []" | 
| 52778 | 106 | by (simp add: poly_minus_def) | 
| 33153 | 107 | |
| 54219 | 108 | lemma pmult_singleton: "[h1] *** p1 = h1 %* p1" by simp | 
| 109 | ||
| 110 | end | |
| 33153 | 111 | |
| 60536 | 112 | lemma (in semiring_1) poly_ident_mult[simp]: "1 %* t = t" | 
| 113 | by (induct t) auto | |
| 33153 | 114 | |
| 60536 | 115 | lemma (in semiring_0) poly_simple_add_Cons[simp]: "[a] +++ (0 # t) = a # t" | 
| 52778 | 116 | by simp | 
| 33153 | 117 | |
| 60536 | 118 | |
| 119 | text \<open>Handy general properties.\<close> | |
| 33153 | 120 | |
| 54219 | 121 | lemma (in comm_semiring_0) padd_commut: "b +++ a = a +++ b" | 
| 122 | proof (induct b arbitrary: a) | |
| 123 | case Nil | |
| 60536 | 124 | then show ?case | 
| 125 | by auto | |
| 54219 | 126 | next | 
| 127 | case (Cons b bs a) | |
| 60536 | 128 | then show ?case | 
| 129 | by (cases a) (simp_all add: add.commute) | |
| 54219 | 130 | qed | 
| 131 | ||
| 132 | lemma (in comm_semiring_0) padd_assoc: "\<forall>b c. (a +++ b) +++ c = a +++ (b +++ c)" | |
| 133 | apply (induct a) | |
| 60536 | 134 | apply simp | 
| 135 | apply clarify | |
| 136 | apply (case_tac b) | |
| 137 | apply (simp_all add: ac_simps) | |
| 52778 | 138 | done | 
| 33153 | 139 | |
| 60536 | 140 | lemma (in semiring_0) poly_cmult_distr: "a %* (p +++ q) = a %* p +++ a %* q" | 
| 54219 | 141 | apply (induct p arbitrary: q) | 
| 52881 | 142 | apply simp | 
| 60536 | 143 | apply (case_tac q) | 
| 144 | apply (simp_all add: distrib_left) | |
| 52778 | 145 | done | 
| 33153 | 146 | |
| 60536 | 147 | lemma (in ring_1) pmult_by_x[simp]: "[0, 1] *** t = 0 # t" | 
| 54219 | 148 | apply (induct t) | 
| 52778 | 149 | apply simp | 
| 54219 | 150 | apply (auto simp add: padd_commut) | 
| 60536 | 151 | apply (case_tac t) | 
| 152 | apply auto | |
| 52778 | 153 | done | 
| 33153 | 154 | |
| 60536 | 155 | |
| 156 | text \<open>Properties of evaluation of polynomials.\<close> | |
| 33153 | 157 | |
| 54219 | 158 | lemma (in semiring_0) poly_add: "poly (p1 +++ p2) x = poly p1 x + poly p2 x" | 
| 60536 | 159 | proof (induct p1 arbitrary: p2) | 
| 54219 | 160 | case Nil | 
| 60536 | 161 | then show ?case | 
| 162 | by simp | |
| 54219 | 163 | next | 
| 164 | case (Cons a as p2) | |
| 60536 | 165 | then show ?case | 
| 166 | by (cases p2) (simp_all add: ac_simps distrib_left) | |
| 54219 | 167 | qed | 
| 33153 | 168 | |
| 54219 | 169 | lemma (in comm_semiring_0) poly_cmult: "poly (c %* p) x = c * poly p x" | 
| 52881 | 170 | apply (induct p) | 
| 54219 | 171 | apply (case_tac [2] "x = zero") | 
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 172 | apply (auto simp add: distrib_left ac_simps) | 
| 52778 | 173 | done | 
| 33153 | 174 | |
| 60536 | 175 | lemma (in comm_semiring_0) poly_cmult_map: "poly (map (op * c) p) x = c * poly p x" | 
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 176 | by (induct p) (auto simp add: distrib_left ac_simps) | 
| 33153 | 177 | |
| 54219 | 178 | lemma (in comm_ring_1) poly_minus: "poly (-- p) x = - (poly p x)" | 
| 179 | apply (simp add: poly_minus_def) | |
| 180 | apply (auto simp add: poly_cmult) | |
| 52778 | 181 | done | 
| 33153 | 182 | |
| 54219 | 183 | lemma (in comm_semiring_0) poly_mult: "poly (p1 *** p2) x = poly p1 x * poly p2 x" | 
| 184 | proof (induct p1 arbitrary: p2) | |
| 185 | case Nil | |
| 60536 | 186 | then show ?case | 
| 187 | by simp | |
| 54219 | 188 | next | 
| 189 | case (Cons a as p2) | |
| 60536 | 190 | then show ?case | 
| 191 | by (cases as) (simp_all add: poly_cmult poly_add distrib_right distrib_left ac_simps) | |
| 54219 | 192 | qed | 
| 193 | ||
| 194 | class idom_char_0 = idom + ring_char_0 | |
| 195 | ||
| 196 | subclass (in field_char_0) idom_char_0 .. | |
| 197 | ||
| 198 | lemma (in comm_ring_1) poly_exp: "poly (p %^ n) x = (poly p x) ^ n" | |
| 52881 | 199 | by (induct n) (auto simp add: poly_cmult poly_mult) | 
| 33153 | 200 | |
| 60536 | 201 | |
| 202 | text \<open>More Polynomial Evaluation lemmas.\<close> | |
| 33153 | 203 | |
| 54219 | 204 | lemma (in semiring_0) poly_add_rzero[simp]: "poly (a +++ []) x = poly a x" | 
| 52778 | 205 | by simp | 
| 33153 | 206 | |
| 54219 | 207 | lemma (in comm_semiring_0) poly_mult_assoc: "poly ((a *** b) *** c) x = poly (a *** (b *** c)) x" | 
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
55417diff
changeset | 208 | by (simp add: poly_mult mult.assoc) | 
| 33153 | 209 | |
| 54219 | 210 | lemma (in semiring_0) poly_mult_Nil2[simp]: "poly (p *** []) x = 0" | 
| 52881 | 211 | by (induct p) auto | 
| 33153 | 212 | |
| 60536 | 213 | lemma (in comm_semiring_1) poly_exp_add: "poly (p %^ (n + d)) x = poly (p %^ n *** p %^ d) x" | 
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
55417diff
changeset | 214 | by (induct n) (auto simp add: poly_mult mult.assoc) | 
| 33153 | 215 | |
| 60536 | 216 | |
| 217 | subsection \<open>Key Property: if @{term "f a = 0"} then @{term "(x - a)"} divides @{term "p(x)"}.\<close>
 | |
| 33153 | 218 | |
| 54219 | 219 | lemma (in comm_ring_1) lemma_poly_linear_rem: "\<forall>h. \<exists>q r. h#t = [r] +++ [-a, 1] *** q" | 
| 60536 | 220 | proof (induct t) | 
| 54219 | 221 | case Nil | 
| 60536 | 222 | have "[h] = [h] +++ [- a, 1] *** []" for h by simp | 
| 223 | then show ?case by blast | |
| 54219 | 224 | next | 
| 225 | case (Cons x xs) | |
| 60536 | 226 | have "\<exists>q r. h # x # xs = [r] +++ [-a, 1] *** q" for h | 
| 227 | proof - | |
| 228 | from Cons.hyps obtain q r where qr: "x # xs = [r] +++ [- a, 1] *** q" | |
| 229 | by blast | |
| 230 | have "h # x # xs = [a * r + h] +++ [-a, 1] *** (r # q)" | |
| 54219 | 231 | using qr by (cases q) (simp_all add: algebra_simps) | 
| 60536 | 232 | then show ?thesis by blast | 
| 233 | qed | |
| 234 | then show ?case by blast | |
| 54219 | 235 | qed | 
| 236 | ||
| 237 | lemma (in comm_ring_1) poly_linear_rem: "\<exists>q r. h#t = [r] +++ [-a, 1] *** q" | |
| 238 | using lemma_poly_linear_rem [where t = t and a = a] by auto | |
| 239 | ||
| 60536 | 240 | lemma (in comm_ring_1) poly_linear_divides: "(poly p a = 0) \<longleftrightarrow> p = [] \<or> (\<exists>q. p = [-a, 1] *** q)" | 
| 241 | proof (cases p) | |
| 242 | case Nil | |
| 243 | then show ?thesis by simp | |
| 244 | next | |
| 245 | case (Cons x xs) | |
| 246 | have "poly p a = 0" if "p = [-a, 1] *** q" for q | |
| 247 | using that by (simp add: poly_add poly_cmult) | |
| 54219 | 248 | moreover | 
| 60536 | 249 | have "\<exists>q. p = [- a, 1] *** q" if p0: "poly p a = 0" | 
| 250 | proof - | |
| 251 | from poly_linear_rem[of x xs a] obtain q r where qr: "x#xs = [r] +++ [- a, 1] *** q" | |
| 252 | by blast | |
| 253 | have "r = 0" | |
| 254 | using p0 by (simp only: Cons qr poly_mult poly_add) simp | |
| 255 | with Cons qr show ?thesis | |
| 256 | apply - | |
| 257 | apply (rule exI[where x = q]) | |
| 258 | apply auto | |
| 259 | apply (cases q) | |
| 260 | apply auto | |
| 261 | done | |
| 262 | qed | |
| 263 | ultimately show ?thesis using Cons by blast | |
| 54219 | 264 | qed | 
| 33153 | 265 | |
| 60536 | 266 | lemma (in semiring_0) lemma_poly_length_mult[simp]: | 
| 267 | "\<forall>h k a. length (k %* p +++ (h # (a %* p))) = Suc (length p)" | |
| 54219 | 268 | by (induct p) auto | 
| 33153 | 269 | |
| 60536 | 270 | lemma (in semiring_0) lemma_poly_length_mult2[simp]: | 
| 271 | "\<forall>h k. length (k %* p +++ (h # p)) = Suc (length p)" | |
| 54219 | 272 | by (induct p) auto | 
| 33153 | 273 | |
| 54219 | 274 | lemma (in ring_1) poly_length_mult[simp]: "length([-a,1] *** q) = Suc (length q)" | 
| 52778 | 275 | by auto | 
| 33153 | 276 | |
| 60536 | 277 | |
| 278 | subsection \<open>Polynomial length\<close> | |
| 33153 | 279 | |
| 54219 | 280 | lemma (in semiring_0) poly_cmult_length[simp]: "length (a %* p) = length p" | 
| 52778 | 281 | by (induct p) auto | 
| 33153 | 282 | |
| 54219 | 283 | lemma (in semiring_0) poly_add_length: "length (p1 +++ p2) = max (length p1) (length p2)" | 
| 284 | by (induct p1 arbitrary: p2) (simp_all, arith) | |
| 33153 | 285 | |
| 54219 | 286 | lemma (in semiring_0) poly_root_mult_length[simp]: "length([a,b] *** p) = Suc (length p)" | 
| 287 | by (simp add: poly_add_length) | |
| 33153 | 288 | |
| 54219 | 289 | lemma (in idom) poly_mult_not_eq_poly_Nil[simp]: | 
| 290 | "poly (p *** q) x \<noteq> poly [] x \<longleftrightarrow> poly p x \<noteq> poly [] x \<and> poly q x \<noteq> poly [] x" | |
| 52778 | 291 | by (auto simp add: poly_mult) | 
| 33153 | 292 | |
| 54219 | 293 | lemma (in idom) poly_mult_eq_zero_disj: "poly (p *** q) x = 0 \<longleftrightarrow> poly p x = 0 \<or> poly q x = 0" | 
| 52778 | 294 | by (auto simp add: poly_mult) | 
| 33153 | 295 | |
| 296 | ||
| 60536 | 297 | text \<open>Normalisation Properties.\<close> | 
| 298 | ||
| 299 | lemma (in semiring_0) poly_normalized_nil: "pnormalize p = [] \<longrightarrow> poly p x = 0" | |
| 52778 | 300 | by (induct p) auto | 
| 33153 | 301 | |
| 60536 | 302 | text \<open>A nontrivial polynomial of degree n has no more than n roots.\<close> | 
| 54219 | 303 | lemma (in idom) poly_roots_index_lemma: | 
| 60536 | 304 | assumes p: "poly p x \<noteq> poly [] x" | 
| 305 | and n: "length p = n" | |
| 54219 | 306 | shows "\<exists>i. \<forall>x. poly p x = 0 \<longrightarrow> (\<exists>m\<le>n. x = i m)" | 
| 307 | using p n | |
| 308 | proof (induct n arbitrary: p x) | |
| 309 | case 0 | |
| 60536 | 310 | then show ?case by simp | 
| 54219 | 311 | next | 
| 312 | case (Suc n p x) | |
| 60536 | 313 | have False if C: "\<And>i. \<exists>x. poly p x = 0 \<and> (\<forall>m\<le>Suc n. x \<noteq> i m)" | 
| 314 | proof - | |
| 315 | from Suc.prems have p0: "poly p x \<noteq> 0" "p \<noteq> []" | |
| 316 | by auto | |
| 54219 | 317 | from p0(1)[unfolded poly_linear_divides[of p x]] | 
| 60536 | 318 | have "\<forall>q. p \<noteq> [- x, 1] *** q" | 
| 319 | by blast | |
| 320 | from C obtain a where a: "poly p a = 0" | |
| 321 | by blast | |
| 322 | from a[unfolded poly_linear_divides[of p a]] p0(2) obtain q where q: "p = [-a, 1] *** q" | |
| 323 | by blast | |
| 324 | have lg: "length q = n" | |
| 325 | using q Suc.prems(2) by simp | |
| 54219 | 326 | from q p0 have qx: "poly q x \<noteq> poly [] x" | 
| 327 | by (auto simp add: poly_mult poly_add poly_cmult) | |
| 60536 | 328 | from Suc.hyps[OF qx lg] obtain i where i: "\<forall>x. poly q x = 0 \<longrightarrow> (\<exists>m\<le>n. x = i m)" | 
| 329 | by blast | |
| 54219 | 330 | let ?i = "\<lambda>m. if m = Suc n then a else i m" | 
| 331 | from C[of ?i] obtain y where y: "poly p y = 0" "\<forall>m\<le> Suc n. y \<noteq> ?i m" | |
| 332 | by blast | |
| 333 | from y have "y = a \<or> poly q y = 0" | |
| 334 | by (simp only: q poly_mult_eq_zero_disj poly_add) (simp add: algebra_simps) | |
| 60536 | 335 | with i[rule_format, of y] y(1) y(2) show ?thesis | 
| 54219 | 336 | apply auto | 
| 337 | apply (erule_tac x = "m" in allE) | |
| 338 | apply auto | |
| 339 | done | |
| 60536 | 340 | qed | 
| 341 | then show ?case by blast | |
| 54219 | 342 | qed | 
| 33153 | 343 | |
| 344 | ||
| 54219 | 345 | lemma (in idom) poly_roots_index_length: | 
| 346 | "poly p x \<noteq> poly [] x \<Longrightarrow> \<exists>i. \<forall>x. (poly p x = 0) \<longrightarrow> (\<exists>n. n \<le> length p \<and> x = i n)" | |
| 347 | by (blast intro: poly_roots_index_lemma) | |
| 33153 | 348 | |
| 54219 | 349 | lemma (in idom) poly_roots_finite_lemma1: | 
| 60536 | 350 | "poly p x \<noteq> poly [] x \<Longrightarrow> \<exists>N i. \<forall>x. (poly p x = 0) \<longrightarrow> (\<exists>n::nat. n < N \<and> x = i n)" | 
| 54219 | 351 | apply (drule poly_roots_index_length, safe) | 
| 52778 | 352 | apply (rule_tac x = "Suc (length p)" in exI) | 
| 353 | apply (rule_tac x = i in exI) | |
| 354 | apply (simp add: less_Suc_eq_le) | |
| 355 | done | |
| 33153 | 356 | |
| 54219 | 357 | lemma (in idom) idom_finite_lemma: | 
| 60536 | 358 | assumes "\<forall>x. P x \<longrightarrow> (\<exists>n. n < length j \<and> x = j!n)" | 
| 54219 | 359 |   shows "finite {x. P x}"
 | 
| 52778 | 360 | proof - | 
| 60536 | 361 |   from assms have "{x. P x} \<subseteq> set j" by auto
 | 
| 362 | then show ?thesis using finite_subset by auto | |
| 33153 | 363 | qed | 
| 364 | ||
| 54219 | 365 | lemma (in idom) poly_roots_finite_lemma2: | 
| 366 | "poly p x \<noteq> poly [] x \<Longrightarrow> \<exists>i. \<forall>x. poly p x = 0 \<longrightarrow> x \<in> set i" | |
| 60536 | 367 | apply (drule poly_roots_index_length) | 
| 368 | apply safe | |
| 369 | apply (rule_tac x = "map (\<lambda>n. i n) [0 ..< Suc (length p)]" in exI) | |
| 54219 | 370 | apply (auto simp add: image_iff) | 
| 60536 | 371 | apply (erule_tac x="x" in allE) | 
| 372 | apply clarsimp | |
| 54219 | 373 | apply (case_tac "n = length p") | 
| 374 | apply (auto simp add: order_le_less) | |
| 52778 | 375 | done | 
| 33153 | 376 | |
| 60536 | 377 | lemma (in ring_char_0) UNIV_ring_char_0_infinte: "\<not> finite (UNIV :: 'a set)" | 
| 54219 | 378 | proof | 
| 379 | assume F: "finite (UNIV :: 'a set)" | |
| 380 | have "finite (UNIV :: nat set)" | |
| 381 | proof (rule finite_imageD) | |
| 382 | have "of_nat ` UNIV \<subseteq> UNIV" by simp | |
| 60536 | 383 | then show "finite (of_nat ` UNIV :: 'a set)" | 
| 384 | using F by (rule finite_subset) | |
| 385 | show "inj (of_nat :: nat \<Rightarrow> 'a)" | |
| 386 | by (simp add: inj_on_def) | |
| 54219 | 387 | qed | 
| 388 | with infinite_UNIV_nat show False .. | |
| 33153 | 389 | qed | 
| 390 | ||
| 54219 | 391 | lemma (in idom_char_0) poly_roots_finite: "poly p \<noteq> poly [] \<longleftrightarrow> finite {x. poly p x = 0}"
 | 
| 60536 | 392 | (is "?lhs \<longleftrightarrow> ?rhs") | 
| 33153 | 393 | proof | 
| 60536 | 394 | show ?rhs if ?lhs | 
| 395 | using that | |
| 33153 | 396 | apply - | 
| 60536 | 397 | apply (erule contrapos_np) | 
| 398 | apply (rule ext) | |
| 33153 | 399 | apply (rule ccontr) | 
| 54219 | 400 | apply (clarify dest!: poly_roots_finite_lemma2) | 
| 33153 | 401 | using finite_subset | 
| 52778 | 402 | proof - | 
| 33153 | 403 | fix x i | 
| 60536 | 404 |     assume F: "\<not> finite {x. poly p x = 0}"
 | 
| 405 | and P: "\<forall>x. poly p x = 0 \<longrightarrow> x \<in> set i" | |
| 406 |     from P have "{x. poly p x = 0} \<subseteq> set i"
 | |
| 407 | by auto | |
| 408 | with finite_subset F show False | |
| 409 | by auto | |
| 33153 | 410 | qed | 
| 60536 | 411 | show ?lhs if ?rhs | 
| 412 | using UNIV_ring_char_0_infinte that by auto | |
| 33153 | 413 | qed | 
| 414 | ||
| 60536 | 415 | |
| 416 | text \<open>Entirety and Cancellation for polynomials\<close> | |
| 33153 | 417 | |
| 54219 | 418 | lemma (in idom_char_0) poly_entire_lemma2: | 
| 419 | assumes p0: "poly p \<noteq> poly []" | |
| 420 | and q0: "poly q \<noteq> poly []" | |
| 421 | shows "poly (p***q) \<noteq> poly []" | |
| 422 | proof - | |
| 423 |   let ?S = "\<lambda>p. {x. poly p x = 0}"
 | |
| 60536 | 424 | have "?S (p *** q) = ?S p \<union> ?S q" | 
| 425 | by (auto simp add: poly_mult) | |
| 426 | with p0 q0 show ?thesis | |
| 427 | unfolding poly_roots_finite by auto | |
| 54219 | 428 | qed | 
| 33153 | 429 | |
| 54219 | 430 | lemma (in idom_char_0) poly_entire: | 
| 431 | "poly (p *** q) = poly [] \<longleftrightarrow> poly p = poly [] \<or> poly q = poly []" | |
| 432 | using poly_entire_lemma2[of p q] | |
| 433 | by (auto simp add: fun_eq_iff poly_mult) | |
| 33153 | 434 | |
| 54219 | 435 | lemma (in idom_char_0) poly_entire_neg: | 
| 436 | "poly (p *** q) \<noteq> poly [] \<longleftrightarrow> poly p \<noteq> poly [] \<and> poly q \<noteq> poly []" | |
| 52778 | 437 | by (simp add: poly_entire) | 
| 33153 | 438 | |
| 54219 | 439 | lemma (in comm_ring_1) poly_add_minus_zero_iff: | 
| 440 | "poly (p +++ -- q) = poly [] \<longleftrightarrow> poly p = poly q" | |
| 60536 | 441 | by (auto simp add: algebra_simps poly_add poly_minus_def fun_eq_iff poly_cmult) | 
| 33153 | 442 | |
| 54219 | 443 | lemma (in comm_ring_1) poly_add_minus_mult_eq: | 
| 444 | "poly (p *** q +++ --(p *** r)) = poly (p *** (q +++ -- r))" | |
| 60536 | 445 | by (auto simp add: poly_add poly_minus_def fun_eq_iff poly_mult poly_cmult algebra_simps) | 
| 33153 | 446 | |
| 54219 | 447 | subclass (in idom_char_0) comm_ring_1 .. | 
| 33153 | 448 | |
| 54219 | 449 | lemma (in idom_char_0) poly_mult_left_cancel: | 
| 450 | "poly (p *** q) = poly (p *** r) \<longleftrightarrow> poly p = poly [] \<or> poly q = poly r" | |
| 451 | proof - | |
| 452 | have "poly (p *** q) = poly (p *** r) \<longleftrightarrow> poly (p *** q +++ -- (p *** r)) = poly []" | |
| 453 | by (simp only: poly_add_minus_zero_iff) | |
| 454 | also have "\<dots> \<longleftrightarrow> poly p = poly [] \<or> poly q = poly r" | |
| 455 | by (auto intro: simp add: poly_add_minus_mult_eq poly_entire poly_add_minus_zero_iff) | |
| 456 | finally show ?thesis . | |
| 457 | qed | |
| 458 | ||
| 60536 | 459 | lemma (in idom) poly_exp_eq_zero[simp]: "poly (p %^ n) = poly [] \<longleftrightarrow> poly p = poly [] \<and> n \<noteq> 0" | 
| 460 | apply (simp only: fun_eq_iff add: HOL.all_simps [symmetric]) | |
| 52778 | 461 | apply (rule arg_cong [where f = All]) | 
| 462 | apply (rule ext) | |
| 54219 | 463 | apply (induct n) | 
| 464 | apply (auto simp add: poly_exp poly_mult) | |
| 52778 | 465 | done | 
| 33153 | 466 | |
| 60536 | 467 | lemma (in comm_ring_1) poly_prime_eq_zero[simp]: "poly [a, 1] \<noteq> poly []" | 
| 468 | apply (simp add: fun_eq_iff) | |
| 54219 | 469 | apply (rule_tac x = "minus one a" in exI) | 
| 57512 
cc97b347b301
reduced name variants for assoc and commute on plus and mult
 haftmann parents: 
55417diff
changeset | 470 | apply (simp add: add.commute [of a]) | 
| 52778 | 471 | done | 
| 33153 | 472 | |
| 54219 | 473 | lemma (in idom) poly_exp_prime_eq_zero: "poly ([a, 1] %^ n) \<noteq> poly []" | 
| 52778 | 474 | by auto | 
| 33153 | 475 | |
| 60536 | 476 | |
| 477 | text \<open>A more constructive notion of polynomials being trivial.\<close> | |
| 33153 | 478 | |
| 54219 | 479 | lemma (in idom_char_0) poly_zero_lemma': "poly (h # t) = poly [] \<Longrightarrow> h = 0 \<and> poly t = poly []" | 
| 60536 | 480 | apply (simp add: fun_eq_iff) | 
| 54219 | 481 | apply (case_tac "h = zero") | 
| 60536 | 482 | apply (drule_tac [2] x = zero in spec) | 
| 483 | apply auto | |
| 484 | apply (cases "poly t = poly []") | |
| 485 | apply simp | |
| 52778 | 486 | proof - | 
| 33153 | 487 | fix x | 
| 60536 | 488 | assume H: "\<forall>x. x = 0 \<or> poly t x = 0" | 
| 489 | assume pnz: "poly t \<noteq> poly []" | |
| 33153 | 490 |   let ?S = "{x. poly t x = 0}"
 | 
| 60536 | 491 | from H have "\<forall>x. x \<noteq> 0 \<longrightarrow> poly t x = 0" | 
| 492 | by blast | |
| 493 |   then have th: "?S \<supseteq> UNIV - {0}"
 | |
| 494 | by auto | |
| 495 | from poly_roots_finite pnz have th': "finite ?S" | |
| 496 | by blast | |
| 497 | from finite_subset[OF th th'] UNIV_ring_char_0_infinte show "poly t x = 0" | |
| 54219 | 498 | by simp | 
| 52778 | 499 | qed | 
| 33153 | 500 | |
| 60537 | 501 | lemma (in idom_char_0) poly_zero: "poly p = poly [] \<longleftrightarrow> (\<forall>c \<in> set p. c = 0)" | 
| 52778 | 502 | apply (induct p) | 
| 503 | apply simp | |
| 504 | apply (rule iffI) | |
| 60536 | 505 | apply (drule poly_zero_lemma') | 
| 506 | apply auto | |
| 52778 | 507 | done | 
| 33153 | 508 | |
| 60537 | 509 | lemma (in idom_char_0) poly_0: "\<forall>c \<in> set p. c = 0 \<Longrightarrow> poly p x = 0" | 
| 54219 | 510 | unfolding poly_zero[symmetric] by simp | 
| 511 | ||
| 512 | ||
| 60536 | 513 | text \<open>Basics of divisibility.\<close> | 
| 33153 | 514 | |
| 60536 | 515 | lemma (in idom) poly_primes: "[a, 1] divides (p *** q) \<longleftrightarrow> [a, 1] divides p \<or> [a, 1] divides q" | 
| 516 | apply (auto simp add: divides_def fun_eq_iff poly_mult poly_add poly_cmult distrib_right [symmetric]) | |
| 54219 | 517 | apply (drule_tac x = "uminus a" in spec) | 
| 518 | apply (simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric]) | |
| 519 | apply (cases "p = []") | |
| 520 | apply (rule exI[where x="[]"]) | |
| 521 | apply simp | |
| 522 | apply (cases "q = []") | |
| 60536 | 523 | apply (erule allE[where x="[]"]) | 
| 524 | apply simp | |
| 54219 | 525 | |
| 526 | apply clarsimp | |
| 60536 | 527 | apply (cases "\<exists>q. p = a %* q +++ (0 # q)") | 
| 54219 | 528 | apply (clarsimp simp add: poly_add poly_cmult) | 
| 60536 | 529 | apply (rule_tac x = qa in exI) | 
| 54219 | 530 | apply (simp add: distrib_right [symmetric]) | 
| 531 | apply clarsimp | |
| 532 | ||
| 52778 | 533 | apply (auto simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric]) | 
| 54219 | 534 | apply (rule_tac x = "pmult qa q" in exI) | 
| 535 | apply (rule_tac [2] x = "pmult p qa" in exI) | |
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 536 | apply (auto simp add: poly_add poly_mult poly_cmult ac_simps) | 
| 52778 | 537 | done | 
| 33153 | 538 | |
| 54219 | 539 | lemma (in comm_semiring_1) poly_divides_refl[simp]: "p divides p" | 
| 52778 | 540 | apply (simp add: divides_def) | 
| 54219 | 541 | apply (rule_tac x = "[one]" in exI) | 
| 60536 | 542 | apply (auto simp add: poly_mult fun_eq_iff) | 
| 52778 | 543 | done | 
| 33153 | 544 | |
| 54219 | 545 | lemma (in comm_semiring_1) poly_divides_trans: "p divides q \<Longrightarrow> q divides r \<Longrightarrow> p divides r" | 
| 60536 | 546 | apply (simp add: divides_def) | 
| 547 | apply safe | |
| 54219 | 548 | apply (rule_tac x = "pmult qa qaa" in exI) | 
| 60536 | 549 | apply (auto simp add: poly_mult fun_eq_iff mult.assoc) | 
| 52778 | 550 | done | 
| 33153 | 551 | |
| 54219 | 552 | lemma (in comm_semiring_1) poly_divides_exp: "m \<le> n \<Longrightarrow> (p %^ m) divides (p %^ n)" | 
| 52778 | 553 | apply (auto simp add: le_iff_add) | 
| 554 | apply (induct_tac k) | |
| 555 | apply (rule_tac [2] poly_divides_trans) | |
| 556 | apply (auto simp add: divides_def) | |
| 557 | apply (rule_tac x = p in exI) | |
| 60536 | 558 | apply (auto simp add: poly_mult fun_eq_iff ac_simps) | 
| 52778 | 559 | done | 
| 33153 | 560 | |
| 60536 | 561 | lemma (in comm_semiring_1) poly_exp_divides: "(p %^ n) divides q \<Longrightarrow> m \<le> n \<Longrightarrow> (p %^ m) divides q" | 
| 52778 | 562 | by (blast intro: poly_divides_exp poly_divides_trans) | 
| 33153 | 563 | |
| 60536 | 564 | lemma (in comm_semiring_0) poly_divides_add: "p divides q \<Longrightarrow> p divides r \<Longrightarrow> p divides (q +++ r)" | 
| 565 | apply (auto simp add: divides_def) | |
| 54219 | 566 | apply (rule_tac x = "padd qa qaa" in exI) | 
| 60536 | 567 | apply (auto simp add: poly_add fun_eq_iff poly_mult distrib_left) | 
| 52778 | 568 | done | 
| 33153 | 569 | |
| 60536 | 570 | lemma (in comm_ring_1) poly_divides_diff: "p divides q \<Longrightarrow> p divides (q +++ r) \<Longrightarrow> p divides r" | 
| 571 | apply (auto simp add: divides_def) | |
| 54219 | 572 | apply (rule_tac x = "padd qaa (poly_minus qa)" in exI) | 
| 60536 | 573 | apply (auto simp add: poly_add fun_eq_iff poly_mult poly_minus algebra_simps) | 
| 52778 | 574 | done | 
| 33153 | 575 | |
| 60536 | 576 | lemma (in comm_ring_1) poly_divides_diff2: "p divides r \<Longrightarrow> p divides (q +++ r) \<Longrightarrow> p divides q" | 
| 52778 | 577 | apply (erule poly_divides_diff) | 
| 60536 | 578 | apply (auto simp add: poly_add fun_eq_iff poly_mult divides_def ac_simps) | 
| 52778 | 579 | done | 
| 33153 | 580 | |
| 54219 | 581 | lemma (in semiring_0) poly_divides_zero: "poly p = poly [] \<Longrightarrow> q divides p" | 
| 52778 | 582 | apply (simp add: divides_def) | 
| 60536 | 583 | apply (rule exI[where x = "[]"]) | 
| 584 | apply (auto simp add: fun_eq_iff poly_mult) | |
| 52778 | 585 | done | 
| 33153 | 586 | |
| 54219 | 587 | lemma (in semiring_0) poly_divides_zero2 [simp]: "q divides []" | 
| 52778 | 588 | apply (simp add: divides_def) | 
| 589 | apply (rule_tac x = "[]" in exI) | |
| 60536 | 590 | apply (auto simp add: fun_eq_iff) | 
| 52778 | 591 | done | 
| 33153 | 592 | |
| 60536 | 593 | |
| 594 | text \<open>At last, we can consider the order of a root.\<close> | |
| 33153 | 595 | |
| 54219 | 596 | lemma (in idom_char_0) poly_order_exists_lemma: | 
| 597 | assumes lp: "length p = d" | |
| 598 | and p: "poly p \<noteq> poly []" | |
| 599 | shows "\<exists>n q. p = mulexp n [-a, 1] q \<and> poly q a \<noteq> 0" | |
| 600 | using lp p | |
| 601 | proof (induct d arbitrary: p) | |
| 602 | case 0 | |
| 60536 | 603 | then show ?case by simp | 
| 54219 | 604 | next | 
| 605 | case (Suc n p) | |
| 606 | show ?case | |
| 607 | proof (cases "poly p a = 0") | |
| 608 | case True | |
| 60536 | 609 | from Suc.prems have h: "length p = Suc n" "poly p \<noteq> poly []" | 
| 610 | by auto | |
| 611 | then have pN: "p \<noteq> []" | |
| 612 | by auto | |
| 54219 | 613 | from True[unfolded poly_linear_divides] pN obtain q where q: "p = [-a, 1] *** q" | 
| 614 | by blast | |
| 615 | from q h True have qh: "length q = n" "poly q \<noteq> poly []" | |
| 616 | apply - | |
| 617 | apply simp | |
| 60536 | 618 | apply (simp only: fun_eq_iff) | 
| 54219 | 619 | apply (rule ccontr) | 
| 60536 | 620 | apply (simp add: fun_eq_iff poly_add poly_cmult) | 
| 54219 | 621 | done | 
| 622 | from Suc.hyps[OF qh] obtain m r where mr: "q = mulexp m [-a,1] r" "poly r a \<noteq> 0" | |
| 623 | by blast | |
| 624 | from mr q have "p = mulexp (Suc m) [-a,1] r \<and> poly r a \<noteq> 0" by simp | |
| 625 | then show ?thesis by blast | |
| 626 | next | |
| 627 | case False | |
| 628 | then show ?thesis | |
| 629 | using Suc.prems | |
| 630 | apply simp | |
| 631 | apply (rule exI[where x="0::nat"]) | |
| 632 | apply simp | |
| 633 | done | |
| 634 | qed | |
| 635 | qed | |
| 636 | ||
| 637 | ||
| 638 | lemma (in comm_semiring_1) poly_mulexp: "poly (mulexp n p q) x = (poly p x) ^ n * poly q x" | |
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 639 | by (induct n) (auto simp add: poly_mult ac_simps) | 
| 54219 | 640 | |
| 641 | lemma (in comm_semiring_1) divides_left_mult: | |
| 60536 | 642 | assumes "(p *** q) divides r" | 
| 643 | shows "p divides r \<and> q divides r" | |
| 54219 | 644 | proof- | 
| 60536 | 645 | from assms obtain t where "poly r = poly (p *** q *** t)" | 
| 54219 | 646 | unfolding divides_def by blast | 
| 60536 | 647 | then have "poly r = poly (p *** (q *** t))" and "poly r = poly (q *** (p *** t))" | 
| 648 | by (auto simp add: fun_eq_iff poly_mult ac_simps) | |
| 649 | then show ?thesis | |
| 650 | unfolding divides_def by blast | |
| 54219 | 651 | qed | 
| 652 | ||
| 33153 | 653 | |
| 654 | (* FIXME: Tidy up *) | |
| 54219 | 655 | |
| 656 | lemma (in semiring_1) zero_power_iff: "0 ^ n = (if n = 0 then 1 else 0)" | |
| 657 | by (induct n) simp_all | |
| 33153 | 658 | |
| 54219 | 659 | lemma (in idom_char_0) poly_order_exists: | 
| 60536 | 660 | assumes "length p = d" | 
| 661 | and "poly p \<noteq> poly []" | |
| 54219 | 662 | shows "\<exists>n. [- a, 1] %^ n divides p \<and> \<not> [- a, 1] %^ Suc n divides p" | 
| 663 | proof - | |
| 664 | from assms have "\<exists>n q. p = mulexp n [- a, 1] q \<and> poly q a \<noteq> 0" | |
| 665 | by (rule poly_order_exists_lemma) | |
| 60536 | 666 | then obtain n q where p: "p = mulexp n [- a, 1] q" and "poly q a \<noteq> 0" | 
| 667 | by blast | |
| 54219 | 668 | have "[- a, 1] %^ n divides mulexp n [- a, 1] q" | 
| 669 | proof (rule dividesI) | |
| 670 | show "poly (mulexp n [- a, 1] q) = poly ([- a, 1] %^ n *** q)" | |
| 54230 
b1d955791529
more simplification rules on unary and binary minus
 haftmann parents: 
54219diff
changeset | 671 | by (induct n) (simp_all add: poly_add poly_cmult poly_mult algebra_simps) | 
| 54219 | 672 | qed | 
| 673 | moreover have "\<not> [- a, 1] %^ Suc n divides mulexp n [- a, 1] q" | |
| 674 | proof | |
| 675 | assume "[- a, 1] %^ Suc n divides mulexp n [- a, 1] q" | |
| 676 | then obtain m where "poly (mulexp n [- a, 1] q) = poly ([- a, 1] %^ Suc n *** m)" | |
| 677 | by (rule dividesE) | |
| 678 | moreover have "poly (mulexp n [- a, 1] q) \<noteq> poly ([- a, 1] %^ Suc n *** m)" | |
| 679 | proof (induct n) | |
| 60536 | 680 | case 0 | 
| 681 | show ?case | |
| 54219 | 682 | proof (rule ccontr) | 
| 683 | assume "\<not> poly (mulexp 0 [- a, 1] q) \<noteq> poly ([- a, 1] %^ Suc 0 *** m)" | |
| 684 | then have "poly q a = 0" | |
| 685 | by (simp add: poly_add poly_cmult) | |
| 60536 | 686 | with \<open>poly q a \<noteq> 0\<close> show False | 
| 687 | by simp | |
| 54219 | 688 | qed | 
| 689 | next | |
| 60536 | 690 | case (Suc n) | 
| 691 | show ?case | |
| 54219 | 692 | by (rule pexp_Suc [THEN ssubst], rule ccontr) | 
| 693 | (simp add: poly_mult_left_cancel poly_mult_assoc Suc del: pmult_Cons pexp_Suc) | |
| 694 | qed | |
| 695 | ultimately show False by simp | |
| 696 | qed | |
| 60536 | 697 | ultimately show ?thesis | 
| 698 | by (auto simp add: p) | |
| 54219 | 699 | qed | 
| 33153 | 700 | |
| 54219 | 701 | lemma (in semiring_1) poly_one_divides[simp]: "[1] divides p" | 
| 702 | by (auto simp add: divides_def) | |
| 703 | ||
| 704 | lemma (in idom_char_0) poly_order: | |
| 705 | "poly p \<noteq> poly [] \<Longrightarrow> \<exists>!n. ([-a, 1] %^ n) divides p \<and> \<not> (([-a, 1] %^ Suc n) divides p)" | |
| 52778 | 706 | apply (auto intro: poly_order_exists simp add: less_linear simp del: pmult_Cons pexp_Suc) | 
| 707 | apply (cut_tac x = y and y = n in less_linear) | |
| 708 | apply (drule_tac m = n in poly_exp_divides) | |
| 709 | apply (auto dest: Suc_le_eq [THEN iffD2, THEN [2] poly_exp_divides] | |
| 60536 | 710 | simp del: pmult_Cons pexp_Suc) | 
| 52778 | 711 | done | 
| 33153 | 712 | |
| 60536 | 713 | |
| 714 | text \<open>Order\<close> | |
| 33153 | 715 | |
| 54219 | 716 | lemma some1_equalityD: "n = (SOME n. P n) \<Longrightarrow> \<exists>!n. P n \<Longrightarrow> P n" | 
| 52778 | 717 | by (blast intro: someI2) | 
| 33153 | 718 | |
| 54219 | 719 | lemma (in idom_char_0) order: | 
| 60536 | 720 | "([-a, 1] %^ n) divides p \<and> \<not> (([-a, 1] %^ Suc n) divides p) \<longleftrightarrow> | 
| 721 | n = order a p \<and> poly p \<noteq> poly []" | |
| 722 | unfolding order_def | |
| 52778 | 723 | apply (rule iffI) | 
| 724 | apply (blast dest: poly_divides_zero intro!: some1_equality [symmetric] poly_order) | |
| 725 | apply (blast intro!: poly_order [THEN [2] some1_equalityD]) | |
| 726 | done | |
| 33153 | 727 | |
| 54219 | 728 | lemma (in idom_char_0) order2: | 
| 729 | "poly p \<noteq> poly [] \<Longrightarrow> | |
| 60536 | 730 | ([-a, 1] %^ (order a p)) divides p \<and> \<not> ([-a, 1] %^ Suc (order a p)) divides p" | 
| 52778 | 731 | by (simp add: order del: pexp_Suc) | 
| 33153 | 732 | |
| 54219 | 733 | lemma (in idom_char_0) order_unique: | 
| 60536 | 734 | "poly p \<noteq> poly [] \<Longrightarrow> ([-a, 1] %^ n) divides p \<Longrightarrow> \<not> ([-a, 1] %^ (Suc n)) divides p \<Longrightarrow> | 
| 54219 | 735 | n = order a p" | 
| 52778 | 736 | using order [of a n p] by auto | 
| 33153 | 737 | |
| 54219 | 738 | lemma (in idom_char_0) order_unique_lemma: | 
| 60536 | 739 | "poly p \<noteq> poly [] \<and> ([-a, 1] %^ n) divides p \<and> \<not> ([-a, 1] %^ (Suc n)) divides p \<Longrightarrow> | 
| 52881 | 740 | n = order a p" | 
| 52778 | 741 | by (blast intro: order_unique) | 
| 33153 | 742 | |
| 54219 | 743 | lemma (in ring_1) order_poly: "poly p = poly q \<Longrightarrow> order a p = order a q" | 
| 60536 | 744 | by (auto simp add: fun_eq_iff divides_def poly_mult order_def) | 
| 33153 | 745 | |
| 54219 | 746 | lemma (in semiring_1) pexp_one[simp]: "p %^ (Suc 0) = p" | 
| 60536 | 747 | by (induct p) auto | 
| 54219 | 748 | |
| 749 | lemma (in comm_ring_1) lemma_order_root: | |
| 60536 | 750 | "0 < n \<and> [- a, 1] %^ n divides p \<and> \<not> [- a, 1] %^ (Suc n) divides p \<Longrightarrow> poly p a = 0" | 
| 54219 | 751 | by (induct n arbitrary: a p) (auto simp add: divides_def poly_mult simp del: pmult_Cons) | 
| 33153 | 752 | |
| 60536 | 753 | lemma (in idom_char_0) order_root: "poly p a = 0 \<longleftrightarrow> poly p = poly [] \<or> order a p \<noteq> 0" | 
| 54219 | 754 | apply (cases "poly p = poly []") | 
| 755 | apply auto | |
| 60536 | 756 | apply (simp add: poly_linear_divides del: pmult_Cons) | 
| 757 | apply safe | |
| 54219 | 758 | apply (drule_tac [!] a = a in order2) | 
| 759 | apply (rule ccontr) | |
| 60536 | 760 | apply (simp add: divides_def poly_mult fun_eq_iff del: pmult_Cons) | 
| 761 | apply blast | |
| 762 | using neq0_conv apply (blast intro: lemma_order_root) | |
| 52778 | 763 | done | 
| 33153 | 764 | |
| 54219 | 765 | lemma (in idom_char_0) order_divides: | 
| 766 | "([-a, 1] %^ n) divides p \<longleftrightarrow> poly p = poly [] \<or> n \<le> order a p" | |
| 52881 | 767 | apply (cases "poly p = poly []") | 
| 768 | apply auto | |
| 60536 | 769 | apply (simp add: divides_def fun_eq_iff poly_mult) | 
| 52778 | 770 | apply (rule_tac x = "[]" in exI) | 
| 54219 | 771 | apply (auto dest!: order2 [where a=a] intro: poly_exp_divides simp del: pexp_Suc) | 
| 52778 | 772 | done | 
| 33153 | 773 | |
| 54219 | 774 | lemma (in idom_char_0) order_decomp: | 
| 60536 | 775 | "poly p \<noteq> poly [] \<Longrightarrow> \<exists>q. poly p = poly (([-a, 1] %^ order a p) *** q) \<and> \<not> [-a, 1] divides q" | 
| 776 | unfolding divides_def | |
| 52778 | 777 | apply (drule order2 [where a = a]) | 
| 60536 | 778 | apply (simp add: divides_def del: pexp_Suc pmult_Cons) | 
| 779 | apply safe | |
| 780 | apply (rule_tac x = q in exI) | |
| 781 | apply safe | |
| 52778 | 782 | apply (drule_tac x = qa in spec) | 
| 60536 | 783 | apply (auto simp add: poly_mult fun_eq_iff poly_exp ac_simps simp del: pmult_Cons) | 
| 52778 | 784 | done | 
| 33153 | 785 | |
| 60536 | 786 | text \<open>Important composition properties of orders.\<close> | 
| 54219 | 787 | lemma order_mult: | 
| 60536 | 788 | fixes a :: "'a::idom_char_0" | 
| 789 | shows "poly (p *** q) \<noteq> poly [] \<Longrightarrow> order a (p *** q) = order a p + order a q" | |
| 54219 | 790 | apply (cut_tac a = a and p = "p *** q" and n = "order a p + order a q" in order) | 
| 52778 | 791 | apply (auto simp add: poly_entire simp del: pmult_Cons) | 
| 792 | apply (drule_tac a = a in order2)+ | |
| 793 | apply safe | |
| 60536 | 794 | apply (simp add: divides_def fun_eq_iff poly_exp_add poly_mult del: pmult_Cons, safe) | 
| 52778 | 795 | apply (rule_tac x = "qa *** qaa" in exI) | 
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 796 | apply (simp add: poly_mult ac_simps del: pmult_Cons) | 
| 52778 | 797 | apply (drule_tac a = a in order_decomp)+ | 
| 798 | apply safe | |
| 60536 | 799 | apply (subgoal_tac "[-a, 1] divides (qa *** qaa) ") | 
| 52778 | 800 | apply (simp add: poly_primes del: pmult_Cons) | 
| 801 | apply (auto simp add: divides_def simp del: pmult_Cons) | |
| 802 | apply (rule_tac x = qb in exI) | |
| 60536 | 803 | apply (subgoal_tac "poly ([-a, 1] %^ (order a p) *** (qa *** qaa)) = | 
| 804 | poly ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))") | |
| 805 | apply (drule poly_mult_left_cancel [THEN iffD1]) | |
| 806 | apply force | |
| 807 | apply (subgoal_tac "poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** (qa *** qaa))) = | |
| 808 | poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))) ") | |
| 809 | apply (drule poly_mult_left_cancel [THEN iffD1]) | |
| 810 | apply force | |
| 811 | apply (simp add: fun_eq_iff poly_exp_add poly_mult ac_simps del: pmult_Cons) | |
| 52778 | 812 | done | 
| 33153 | 813 | |
| 54219 | 814 | lemma (in idom_char_0) order_mult: | 
| 815 | assumes "poly (p *** q) \<noteq> poly []" | |
| 816 | shows "order a (p *** q) = order a p + order a q" | |
| 817 | using assms | |
| 818 | apply (cut_tac a = a and p = "pmult p q" and n = "order a p + order a q" in order) | |
| 819 | apply (auto simp add: poly_entire simp del: pmult_Cons) | |
| 820 | apply (drule_tac a = a in order2)+ | |
| 821 | apply safe | |
| 60536 | 822 | apply (simp add: divides_def fun_eq_iff poly_exp_add poly_mult del: pmult_Cons) | 
| 823 | apply safe | |
| 54219 | 824 | apply (rule_tac x = "pmult qa qaa" in exI) | 
| 57514 
bdc2c6b40bf2
prefer ac_simps collections over separate name bindings for add and mult
 haftmann parents: 
57512diff
changeset | 825 | apply (simp add: poly_mult ac_simps del: pmult_Cons) | 
| 54219 | 826 | apply (drule_tac a = a in order_decomp)+ | 
| 827 | apply safe | |
| 828 | apply (subgoal_tac "[uminus a, one] divides pmult qa qaa") | |
| 829 | apply (simp add: poly_primes del: pmult_Cons) | |
| 830 | apply (auto simp add: divides_def simp del: pmult_Cons) | |
| 831 | apply (rule_tac x = qb in exI) | |
| 832 | apply (subgoal_tac "poly (pmult (pexp [uminus a, one] (order a p)) (pmult qa qaa)) = | |
| 59807 | 833 | poly (pmult (pexp [uminus a, one] (order a p)) (pmult [uminus a, one] qb))") | 
| 54219 | 834 | apply (drule poly_mult_left_cancel [THEN iffD1], force) | 
| 835 | apply (subgoal_tac "poly (pmult (pexp [uminus a, one] (order a q)) | |
| 836 | (pmult (pexp [uminus a, one] (order a p)) (pmult qa qaa))) = | |
| 837 | poly (pmult (pexp [uminus a, one] (order a q)) | |
| 838 | (pmult (pexp [uminus a, one] (order a p)) (pmult [uminus a, one] qb)))") | |
| 839 | apply (drule poly_mult_left_cancel [THEN iffD1], force) | |
| 60536 | 840 | apply (simp add: fun_eq_iff poly_exp_add poly_mult ac_simps del: pmult_Cons) | 
| 54219 | 841 | done | 
| 842 | ||
| 843 | lemma (in idom_char_0) order_root2: "poly p \<noteq> poly [] \<Longrightarrow> poly p a = 0 \<longleftrightarrow> order a p \<noteq> 0" | |
| 52881 | 844 | by (rule order_root [THEN ssubst]) auto | 
| 33153 | 845 | |
| 60536 | 846 | lemma (in semiring_1) pmult_one[simp]: "[1] *** p = p" | 
| 847 | by auto | |
| 33153 | 848 | |
| 54219 | 849 | lemma (in semiring_0) poly_Nil_zero: "poly [] = poly [0]" | 
| 60536 | 850 | by (simp add: fun_eq_iff) | 
| 33153 | 851 | |
| 54219 | 852 | lemma (in idom_char_0) rsquarefree_decomp: | 
| 60536 | 853 | "rsquarefree p \<Longrightarrow> poly p a = 0 \<Longrightarrow> \<exists>q. poly p = poly ([-a, 1] *** q) \<and> poly q a \<noteq> 0" | 
| 854 | apply (simp add: rsquarefree_def) | |
| 855 | apply safe | |
| 52778 | 856 | apply (frule_tac a = a in order_decomp) | 
| 857 | apply (drule_tac x = a in spec) | |
| 858 | apply (drule_tac a = a in order_root2 [symmetric]) | |
| 859 | apply (auto simp del: pmult_Cons) | |
| 54219 | 860 | apply (rule_tac x = q in exI, safe) | 
| 60536 | 861 | apply (simp add: poly_mult fun_eq_iff) | 
| 52778 | 862 | apply (drule_tac p1 = q in poly_linear_divides [THEN iffD1]) | 
| 54219 | 863 | apply (simp add: divides_def del: pmult_Cons, safe) | 
| 52778 | 864 | apply (drule_tac x = "[]" in spec) | 
| 60536 | 865 | apply (auto simp add: fun_eq_iff) | 
| 52778 | 866 | done | 
| 33153 | 867 | |
| 868 | ||
| 60536 | 869 | text \<open>Normalization of a polynomial.\<close> | 
| 33153 | 870 | |
| 54219 | 871 | lemma (in semiring_0) poly_normalize[simp]: "poly (pnormalize p) = poly p" | 
| 60536 | 872 | by (induct p) (auto simp add: fun_eq_iff) | 
| 33153 | 873 | |
| 60536 | 874 | text \<open>The degree of a polynomial.\<close> | 
| 33153 | 875 | |
| 60537 | 876 | lemma (in semiring_0) lemma_degree_zero: "(\<forall>c \<in> set p. c = 0) \<longleftrightarrow> pnormalize p = []" | 
| 52778 | 877 | by (induct p) auto | 
| 33153 | 878 | |
| 54219 | 879 | lemma (in idom_char_0) degree_zero: | 
| 880 | assumes "poly p = poly []" | |
| 881 | shows "degree p = 0" | |
| 882 | using assms | |
| 883 | by (cases "pnormalize p = []") (auto simp add: degree_def poly_zero lemma_degree_zero) | |
| 33153 | 884 | |
| 60536 | 885 | lemma (in semiring_0) pnormalize_sing: "pnormalize [x] = [x] \<longleftrightarrow> x \<noteq> 0" | 
| 54219 | 886 | by simp | 
| 887 | ||
| 60536 | 888 | lemma (in semiring_0) pnormalize_pair: "y \<noteq> 0 \<longleftrightarrow> pnormalize [x, y] = [x, y]" | 
| 52881 | 889 | by simp | 
| 52778 | 890 | |
| 60536 | 891 | lemma (in semiring_0) pnormal_cons: "pnormal p \<Longrightarrow> pnormal (c # p)" | 
| 33153 | 892 | unfolding pnormal_def by simp | 
| 52778 | 893 | |
| 60536 | 894 | lemma (in semiring_0) pnormal_tail: "p \<noteq> [] \<Longrightarrow> pnormal (c # p) \<Longrightarrow> pnormal p" | 
| 895 | unfolding pnormal_def by (auto split: split_if_asm) | |
| 54219 | 896 | |
| 897 | lemma (in semiring_0) pnormal_last_nonzero: "pnormal p \<Longrightarrow> last p \<noteq> 0" | |
| 898 | by (induct p) (simp_all add: pnormal_def split: split_if_asm) | |
| 899 | ||
| 900 | lemma (in semiring_0) pnormal_length: "pnormal p \<Longrightarrow> 0 < length p" | |
| 901 | unfolding pnormal_def length_greater_0_conv by blast | |
| 902 | ||
| 903 | lemma (in semiring_0) pnormal_last_length: "0 < length p \<Longrightarrow> last p \<noteq> 0 \<Longrightarrow> pnormal p" | |
| 904 | by (induct p) (auto simp: pnormal_def split: split_if_asm) | |
| 905 | ||
| 906 | lemma (in semiring_0) pnormal_id: "pnormal p \<longleftrightarrow> 0 < length p \<and> last p \<noteq> 0" | |
| 907 | using pnormal_last_length pnormal_length pnormal_last_nonzero by blast | |
| 908 | ||
| 909 | lemma (in idom_char_0) poly_Cons_eq: | |
| 910 | "poly (c # cs) = poly (d # ds) \<longleftrightarrow> c = d \<and> poly cs = poly ds" | |
| 911 | (is "?lhs \<longleftrightarrow> ?rhs") | |
| 912 | proof | |
| 60536 | 913 | show ?rhs if ?lhs | 
| 914 | proof - | |
| 915 | from that have "poly ((c # cs) +++ -- (d # ds)) x = 0" for x | |
| 916 | by (simp only: poly_minus poly_add algebra_simps) (simp add: algebra_simps) | |
| 917 | then have "poly ((c # cs) +++ -- (d # ds)) = poly []" | |
| 918 | by (simp add: fun_eq_iff) | |
| 60537 | 919 | then have "c = d" and "\<forall>x \<in> set (cs +++ -- ds). x = 0" | 
| 60536 | 920 | unfolding poly_zero by (simp_all add: poly_minus_def algebra_simps) | 
| 921 | from this(2) have "poly (cs +++ -- ds) x = 0" for x | |
| 922 | unfolding poly_zero[symmetric] by simp | |
| 923 | with \<open>c = d\<close> show ?thesis | |
| 924 | by (simp add: poly_minus poly_add algebra_simps fun_eq_iff) | |
| 925 | qed | |
| 926 | show ?lhs if ?rhs | |
| 927 | using that by (simp add:fun_eq_iff) | |
| 54219 | 928 | qed | 
| 929 | ||
| 930 | lemma (in idom_char_0) pnormalize_unique: "poly p = poly q \<Longrightarrow> pnormalize p = pnormalize q" | |
| 931 | proof (induct q arbitrary: p) | |
| 932 | case Nil | |
| 60536 | 933 | then show ?case | 
| 934 | by (simp only: poly_zero lemma_degree_zero) simp | |
| 54219 | 935 | next | 
| 936 | case (Cons c cs p) | |
| 60536 | 937 | then show ?case | 
| 54219 | 938 | proof (induct p) | 
| 939 | case Nil | |
| 60536 | 940 | then have "poly [] = poly (c # cs)" | 
| 941 | by blast | |
| 942 | then have "poly (c#cs) = poly []" | |
| 943 | by simp | |
| 944 | then show ?case | |
| 945 | by (simp only: poly_zero lemma_degree_zero) simp | |
| 54219 | 946 | next | 
| 947 | case (Cons d ds) | |
| 60536 | 948 | then have eq: "poly (d # ds) = poly (c # cs)" | 
| 949 | by blast | |
| 950 | then have eq': "\<And>x. poly (d # ds) x = poly (c # cs) x" | |
| 951 | by simp | |
| 952 | then have "poly (d # ds) 0 = poly (c # cs) 0" | |
| 953 | by blast | |
| 954 | then have dc: "d = c" | |
| 955 | by auto | |
| 54219 | 956 | with eq have "poly ds = poly cs" | 
| 957 | unfolding poly_Cons_eq by simp | |
| 60536 | 958 | with Cons.prems have "pnormalize ds = pnormalize cs" | 
| 959 | by blast | |
| 960 | with dc show ?case | |
| 961 | by simp | |
| 54219 | 962 | qed | 
| 963 | qed | |
| 964 | ||
| 965 | lemma (in idom_char_0) degree_unique: | |
| 966 | assumes pq: "poly p = poly q" | |
| 967 | shows "degree p = degree q" | |
| 968 | using pnormalize_unique[OF pq] unfolding degree_def by simp | |
| 969 | ||
| 60536 | 970 | lemma (in semiring_0) pnormalize_length: "length (pnormalize p) \<le> length p" | 
| 971 | by (induct p) auto | |
| 54219 | 972 | |
| 973 | lemma (in semiring_0) last_linear_mul_lemma: | |
| 60536 | 974 | "last ((a %* p) +++ (x # (b %* p))) = (if p = [] then x else b * last p)" | 
| 54219 | 975 | apply (induct p arbitrary: a x b) | 
| 52881 | 976 | apply auto | 
| 55417 
01fbfb60c33e
adapted to 'xxx_{case,rec}' renaming, to new theorem names, and to new variable names in theorems
 blanchet parents: 
54230diff
changeset | 977 | apply (rename_tac a p aa x b) | 
| 54219 | 978 | apply (subgoal_tac "padd (cmult aa p) (times b a # cmult b p) \<noteq> []") | 
| 979 | apply simp | |
| 980 | apply (induct_tac p) | |
| 52881 | 981 | apply auto | 
| 52778 | 982 | done | 
| 983 | ||
| 54219 | 984 | lemma (in semiring_1) last_linear_mul: | 
| 985 | assumes p: "p \<noteq> []" | |
| 60536 | 986 | shows "last ([a, 1] *** p) = last p" | 
| 54219 | 987 | proof - | 
| 60536 | 988 | from p obtain c cs where cs: "p = c # cs" | 
| 989 | by (cases p) auto | |
| 990 | from cs have eq: "[a, 1] *** p = (a %* (c # cs)) +++ (0 # (1 %* (c # cs)))" | |
| 54219 | 991 | by (simp add: poly_cmult_distr) | 
| 60536 | 992 | show ?thesis | 
| 993 | using cs unfolding eq last_linear_mul_lemma by simp | |
| 54219 | 994 | qed | 
| 995 | ||
| 996 | lemma (in semiring_0) pnormalize_eq: "last p \<noteq> 0 \<Longrightarrow> pnormalize p = p" | |
| 997 | by (induct p) (auto split: split_if_asm) | |
| 998 | ||
| 999 | lemma (in semiring_0) last_pnormalize: "pnormalize p \<noteq> [] \<Longrightarrow> last (pnormalize p) \<noteq> 0" | |
| 1000 | by (induct p) auto | |
| 1001 | ||
| 1002 | lemma (in semiring_0) pnormal_degree: "last p \<noteq> 0 \<Longrightarrow> degree p = length p - 1" | |
| 1003 | using pnormalize_eq[of p] unfolding degree_def by simp | |
| 52778 | 1004 | |
| 54219 | 1005 | lemma (in semiring_0) poly_Nil_ext: "poly [] = (\<lambda>x. 0)" | 
| 60536 | 1006 | by auto | 
| 54219 | 1007 | |
| 1008 | lemma (in idom_char_0) linear_mul_degree: | |
| 1009 | assumes p: "poly p \<noteq> poly []" | |
| 60536 | 1010 | shows "degree ([a, 1] *** p) = degree p + 1" | 
| 54219 | 1011 | proof - | 
| 1012 | from p have pnz: "pnormalize p \<noteq> []" | |
| 1013 | unfolding poly_zero lemma_degree_zero . | |
| 1014 | ||
| 1015 | from last_linear_mul[OF pnz, of a] last_pnormalize[OF pnz] | |
| 1016 | have l0: "last ([a, 1] *** pnormalize p) \<noteq> 0" by simp | |
| 60536 | 1017 | |
| 54219 | 1018 | from last_pnormalize[OF pnz] last_linear_mul[OF pnz, of a] | 
| 1019 | pnormal_degree[OF l0] pnormal_degree[OF last_pnormalize[OF pnz]] pnz | |
| 1020 | have th: "degree ([a,1] *** pnormalize p) = degree (pnormalize p) + 1" | |
| 1021 | by simp | |
| 1022 | ||
| 1023 | have eqs: "poly ([a,1] *** pnormalize p) = poly ([a,1] *** p)" | |
| 1024 | by (rule ext) (simp add: poly_mult poly_add poly_cmult) | |
| 60536 | 1025 | from degree_unique[OF eqs] th show ?thesis | 
| 1026 | by (simp add: degree_unique[OF poly_normalize]) | |
| 54219 | 1027 | qed | 
| 52778 | 1028 | |
| 54219 | 1029 | lemma (in idom_char_0) linear_pow_mul_degree: | 
| 1030 | "degree([a,1] %^n *** p) = (if poly p = poly [] then 0 else degree p + n)" | |
| 1031 | proof (induct n arbitrary: a p) | |
| 1032 | case (0 a p) | |
| 1033 | show ?case | |
| 1034 | proof (cases "poly p = poly []") | |
| 1035 | case True | |
| 1036 | then show ?thesis | |
| 1037 | using degree_unique[OF True] by (simp add: degree_def) | |
| 1038 | next | |
| 1039 | case False | |
| 60536 | 1040 | then show ?thesis | 
| 1041 | by (auto simp add: poly_Nil_ext) | |
| 54219 | 1042 | qed | 
| 1043 | next | |
| 1044 | case (Suc n a p) | |
| 60536 | 1045 | have eq: "poly ([a, 1] %^(Suc n) *** p) = poly ([a, 1] %^ n *** ([a, 1] *** p))" | 
| 54219 | 1046 | apply (rule ext) | 
| 1047 | apply (simp add: poly_mult poly_add poly_cmult) | |
| 60536 | 1048 | apply (simp add: ac_simps distrib_left) | 
| 54219 | 1049 | done | 
| 1050 | note deq = degree_unique[OF eq] | |
| 1051 | show ?case | |
| 1052 | proof (cases "poly p = poly []") | |
| 1053 | case True | |
| 60536 | 1054 | with eq have eq': "poly ([a, 1] %^(Suc n) *** p) = poly []" | 
| 1055 | by (auto simp add: poly_mult poly_cmult poly_add) | |
| 54219 | 1056 | from degree_unique[OF eq'] True show ?thesis | 
| 1057 | by (simp add: degree_def) | |
| 1058 | next | |
| 1059 | case False | |
| 1060 | then have ap: "poly ([a,1] *** p) \<noteq> poly []" | |
| 1061 | using poly_mult_not_eq_poly_Nil unfolding poly_entire by auto | |
| 60536 | 1062 | have eq: "poly ([a, 1] %^(Suc n) *** p) = poly ([a, 1]%^n *** ([a, 1] *** p))" | 
| 1063 | by (auto simp add: poly_mult poly_add poly_exp poly_cmult algebra_simps) | |
| 1064 | from ap have ap': "poly ([a, 1] *** p) = poly [] \<longleftrightarrow> False" | |
| 54219 | 1065 | by blast | 
| 60536 | 1066 | have th0: "degree ([a, 1]%^n *** ([a, 1] *** p)) = degree ([a, 1] *** p) + n" | 
| 54219 | 1067 | apply (simp only: Suc.hyps[of a "pmult [a,one] p"] ap') | 
| 1068 | apply simp | |
| 1069 | done | |
| 1070 | from degree_unique[OF eq] ap False th0 linear_mul_degree[OF False, of a] | |
| 60536 | 1071 | show ?thesis | 
| 1072 | by (auto simp del: poly.simps) | |
| 54219 | 1073 | qed | 
| 1074 | qed | |
| 52778 | 1075 | |
| 54219 | 1076 | lemma (in idom_char_0) order_degree: | 
| 1077 | assumes p0: "poly p \<noteq> poly []" | |
| 1078 | shows "order a p \<le> degree p" | |
| 1079 | proof - | |
| 1080 | from order2[OF p0, unfolded divides_def] | |
| 60536 | 1081 | obtain q where q: "poly p = poly ([- a, 1]%^ (order a p) *** q)" | 
| 1082 | by blast | |
| 1083 | with q p0 have "poly q \<noteq> poly []" | |
| 1084 | by (simp add: poly_mult poly_entire) | |
| 54219 | 1085 | with degree_unique[OF q, unfolded linear_pow_mul_degree] show ?thesis | 
| 1086 | by auto | |
| 1087 | qed | |
| 33153 | 1088 | |
| 1089 | ||
| 60536 | 1090 | text \<open>Tidier versions of finiteness of roots.\<close> | 
| 54219 | 1091 | lemma (in idom_char_0) poly_roots_finite_set: | 
| 1092 |   "poly p \<noteq> poly [] \<Longrightarrow> finite {x. poly p x = 0}"
 | |
| 52778 | 1093 | unfolding poly_roots_finite . | 
| 33153 | 1094 | |
| 1095 | ||
| 60536 | 1096 | text \<open>Bound for polynomial.\<close> | 
| 1097 | lemma poly_mono: | |
| 1098 | fixes x :: "'a::linordered_idom" | |
| 1099 | shows "abs x \<le> k \<Longrightarrow> abs (poly p x) \<le> poly (map abs p) k" | |
| 52881 | 1100 | apply (induct p) | 
| 1101 | apply auto | |
| 55417 
01fbfb60c33e
adapted to 'xxx_{case,rec}' renaming, to new theorem names, and to new variable names in theorems
 blanchet parents: 
54230diff
changeset | 1102 | apply (rename_tac a p) | 
| 52778 | 1103 | apply (rule_tac y = "abs a + abs (x * poly p x)" in order_trans) | 
| 1104 | apply (rule abs_triangle_ineq) | |
| 1105 | apply (auto intro!: mult_mono simp add: abs_mult) | |
| 1106 | done | |
| 33153 | 1107 | |
| 60536 | 1108 | lemma (in semiring_0) poly_Sing: "poly [c] x = c" | 
| 1109 | by simp | |
| 33268 
02de0317f66f
eliminated hard tabulators, guessing at each author's individual tab-width;
 wenzelm parents: 
33153diff
changeset | 1110 | |
| 33153 | 1111 | end |