# HG changeset patch # User wenzelm # Date 1377465625 -7200 # Node ID 942a1b48bb310ce4637d9b920e4099fe350ba4be # Parent e4b18828a8178f78601b7c400199f4e22f4064bf tuned proofs; diff -r e4b18828a817 -r 942a1b48bb31 src/HOL/Library/Formal_Power_Series.thy --- a/src/HOL/Library/Formal_Power_Series.thy Sun Aug 25 21:25:17 2013 +0200 +++ b/src/HOL/Library/Formal_Power_Series.thy Sun Aug 25 23:20:25 2013 +0200 @@ -469,7 +469,7 @@ lemma fps_nonzero_least_unique: assumes a0: "a \ 0" - shows "\! n. leastP (\n. a$n \ 0) n" + shows "\!n. leastP (\n. a$n \ 0) n" proof - from fps_nonzero_nth_minimal [of a] a0 obtain n where "a$n \ 0" "\m < n. a$m = 0" by blast @@ -490,9 +490,9 @@ qed lemma fps_eq_least_unique: - assumes ab: "(a::('a::ab_group_add) fps) \ b" + assumes "(a::('a::ab_group_add) fps) \ b" shows "\! n. leastP (\n. a$n \ b$n) n" - using fps_nonzero_least_unique[of "a - b"] ab + using fps_nonzero_least_unique[of "a - b"] assms by auto instantiation fps :: (comm_ring_1) metric_space @@ -1316,7 +1316,8 @@ case (Suc k) note th = Suc.hyps[symmetric] have "(Abs_fps a - setsum (\i. fps_const (a i :: 'a) * X^i) {0 .. Suc k})$n = - (Abs_fps a - setsum (\i. fps_const (a i :: 'a) * X^i) {0 .. k} - fps_const (a (Suc k)) * X^ Suc k) $ n" + (Abs_fps a - setsum (\i. fps_const (a i :: 'a) * X^i) {0 .. k} - + fps_const (a (Suc k)) * X^ Suc k) $ n" by (simp add: field_simps) also have "\ = (if n < Suc k then 0 else a n) - (fps_const (a (Suc k)) * X^ Suc k)$n" using th unfolding fps_sub_nth by simp @@ -1594,33 +1595,36 @@ lemma fps_setprod_nth: fixes m :: nat and a :: "nat \ ('a::comm_ring_1) fps" - shows "(setprod a {0 .. m})$n = setsum (\v. setprod (\j. (a j) $ (v!j)) {0..m}) (natpermute n (m+1))" + shows "(setprod a {0 .. m})$n = + setsum (\v. setprod (\j. (a j) $ (v!j)) {0..m}) (natpermute n (m+1))" (is "?P m n") proof (induct m arbitrary: n rule: nat_less_induct) fix m n assume H: "\m' < m. \n. ?P m' n" - { - assume m0: "m = 0" - hence "?P m n" apply simp - unfolding natlist_trivial_1[where n = n, unfolded One_nat_def] by simp - } - moreover - { - fix k assume k: "m = Suc k" - have km: "k < m" using k by arith + show "?P m n" + proof (cases m) + case 0 + then show ?thesis + apply simp + unfolding natlist_trivial_1[where n = n, unfolded One_nat_def] + apply simp + done + next + case (Suc k) + then have km: "k < m" by arith have u0: "{0 .. k} \ {m} = {0..m}" - using k apply (simp add: set_eq_iff) + using Suc apply (simp add: set_eq_iff) apply presburger done have f0: "finite {0 .. k}" "finite {m}" by auto - have d0: "{0 .. k} \ {m} = {}" using k by auto + have d0: "{0 .. k} \ {m} = {}" using Suc by auto have "(setprod a {0 .. m}) $ n = (setprod a {0 .. k} * a m) $ n" unfolding setprod_Un_disjoint[OF f0 d0, unfolded u0] by simp also have "\ = (\i = 0..n. (\v\natpermute i (k + 1). \j\{0..k}. a j $ v ! j) * a m $ (n - i))" unfolding fps_mult_nth H[rule_format, OF km] .. also have "\ = (\v\natpermute n (m + 1). \j\{0..m}. a j $ v ! j)" - apply (simp add: k) + apply (simp add: Suc) unfolding natpermute_split[of m "m + 1", simplified, of n, - unfolded natlist_trivial_1[unfolded One_nat_def] k] + unfolded natlist_trivial_1[unfolded One_nat_def] Suc] apply (subst setsum_UN_disjoint) apply simp apply simp @@ -1636,12 +1640,11 @@ apply (rule_tac f="\xs. xs @[n - x]" in setsum_reindex_cong) apply (simp add: inj_on_def) apply auto - unfolding setprod_Un_disjoint[OF f0 d0, unfolded u0, unfolded k] + unfolding setprod_Un_disjoint[OF f0 d0, unfolded u0, unfolded Suc] apply (clarsimp simp add: natpermute_def nth_append) done - finally have "?P m n" . - } - ultimately show "?P m n " by (cases m) auto + finally show ?thesis . + qed qed text{* The special form for powers *} @@ -1656,7 +1659,8 @@ lemma fps_power_nth: fixes m :: nat and a :: "('a::comm_ring_1) fps" - shows "(a ^m)$n = (if m=0 then 1$n else setsum (\v. setprod (\j. a $ (v!j)) {0..m - 1}) (natpermute n m))" + shows "(a ^m)$n = + (if m=0 then 1$n else setsum (\v. setprod (\j. a $ (v!j)) {0..m - 1}) (natpermute n m))" by (cases m) (simp_all add: fps_power_nth_Suc del: power_Suc) lemma fps_nth_power_0: @@ -1679,45 +1683,47 @@ assumes a0: "a$0 = (0::'a::{idom})" and a1: "a$1 \ 0" shows "(b oo a = c oo a) \ b = c" (is "?lhs \?rhs") -proof- - { assume ?rhs then have "?lhs" by simp } - moreover - { assume h: ?lhs - { fix n have "b$n = c$n" - proof (induct n rule: nat_less_induct) - fix n - assume H: "\m {n} = {0 .. n}" using n1 by auto - have d: "{0 .. n1} \ {n} = {}" using n1 by auto - have seq: "(\i = 0..n1. b $ i * a ^ i $ n) = (\i = 0..n1. c $ i * a ^ i $ n)" - apply (rule setsum_cong2) - using H n1 apply auto - done - have th0: "(b oo a) $n = (\i = 0..n1. c $ i * a ^ i $ n) + b$n * (a$1)^n" - unfolding fps_compose_nth setsum_Un_disjoint[OF f d, unfolded eq] seq - using startsby_zero_power_nth_same[OF a0] - by simp - have th1: "(c oo a) $n = (\i = 0..n1. c $ i * a ^ i $ n) + c$n * (a$1)^n" - unfolding fps_compose_nth setsum_Un_disjoint[OF f d, unfolded eq] - using startsby_zero_power_nth_same[OF a0] - by simp - from h[unfolded fps_eq_iff, rule_format, of n] th0 th1 a1 - have "b$n = c$n" by auto - } - ultimately show "b$n = c$n" by (cases n) auto - qed} - then have ?rhs by (simp add: fps_eq_iff) - } - ultimately show ?thesis by blast +proof + assume ?rhs + then show "?lhs" by simp +next + assume h: ?lhs + { + fix n + have "b$n = c$n" + proof (induct n rule: nat_less_induct) + fix n + assume H: "\m {n} = {0 .. n}" using n1 by auto + have d: "{0 .. n1} \ {n} = {}" using n1 by auto + have seq: "(\i = 0..n1. b $ i * a ^ i $ n) = (\i = 0..n1. c $ i * a ^ i $ n)" + apply (rule setsum_cong2) + using H n1 + apply auto + done + have th0: "(b oo a) $n = (\i = 0..n1. c $ i * a ^ i $ n) + b$n * (a$1)^n" + unfolding fps_compose_nth setsum_Un_disjoint[OF f d, unfolded eq] seq + using startsby_zero_power_nth_same[OF a0] + by simp + have th1: "(c oo a) $n = (\i = 0..n1. c $ i * a ^ i $ n) + c$n * (a$1)^n" + unfolding fps_compose_nth setsum_Un_disjoint[OF f d, unfolded eq] + using startsby_zero_power_nth_same[OF a0] + by simp + from h[unfolded fps_eq_iff, rule_format, of n] th0 th1 a1 + have "b$n = c$n" by auto + } + ultimately show "b$n = c$n" by (cases n) auto + qed} + then show ?rhs by (simp add: fps_eq_iff) qed @@ -1789,27 +1795,22 @@ lemma fps_radical_power_nth[simp]: assumes r: "(r k (a$0)) ^ k = a$0" shows "fps_radical r k a ^ k $ 0 = (if k = 0 then 1 else a$0)" -proof- - { - assume "k = 0" - hence ?thesis by simp - } - moreover - { - fix h - assume h: "k = Suc h" - have eq1: "fps_radical r k a ^ k $ 0 = (\j\{0..h}. fps_radical r k a $ (replicate k 0) ! j)" - unfolding fps_power_nth h by simp - also have "\ = (\j\{0..h}. r k (a$0))" - apply (rule setprod_cong) - apply simp - using h - apply (subgoal_tac "replicate k (0::nat) ! x = 0") - apply (auto intro: nth_replicate simp del: replicate.simps) - done - also have "\ = a$0" using r by (simp add: h setprod_constant) - finally have ?thesis using h by simp} - ultimately show ?thesis by (cases k) auto +proof (cases k) + case 0 + then show ?thesis by simp +next + case (Suc h) + have eq1: "fps_radical r k a ^ k $ 0 = (\j\{0..h}. fps_radical r k a $ (replicate k 0) ! j)" + unfolding fps_power_nth Suc by simp + also have "\ = (\j\{0..h}. r k (a$0))" + apply (rule setprod_cong) + apply simp + using Suc + apply (subgoal_tac "replicate k (0::nat) ! x = 0") + apply (auto intro: nth_replicate simp del: replicate.simps) + done + also have "\ = a$0" using r Suc by (simp add: setprod_constant) + finally show ?thesis using Suc by simp qed lemma natpermute_max_card: @@ -1886,7 +1887,8 @@ have "(\j\{0..k}. fps_radical r (Suc k) a $ v ! j) = (\j\{0..k}. if j = i then fps_radical r (Suc k) a $ n else r (Suc k) (a$0))" apply (rule setprod_cong, simp) - using i r0 apply (simp del: replicate.simps) + using i r0 + apply (simp del: replicate.simps) done also have "\ = (fps_radical r (Suc k) a $ n) * r (Suc k) (a$0) ^ k" using i r0 by (simp add: setprod_gen_delta) @@ -1990,7 +1992,7 @@ and a0: "r (Suc k) (b$0 ::'a::field_char_0) = a$0" and b0: "b$0 \ 0" shows "a^(Suc k) = b \ a = fps_radical r (Suc k) b" -proof- +proof - let ?r = "fps_radical r (Suc k) b" have r00: "r (Suc k) (b$0) \ 0" using b0 r0 by auto { @@ -2131,7 +2133,8 @@ fixes a:: "'a::field_char_0 fps" assumes r0: "(r (Suc k) (a$0)) ^ Suc k = a$0" and a0: "a$0 \ 0" - shows "fps_deriv (fps_radical r (Suc k) a) = fps_deriv a / (fps_const (of_nat (Suc k)) * (fps_radical r (Suc k) a) ^ k)" + shows "fps_deriv (fps_radical r (Suc k) a) = + fps_deriv a / (fps_const (of_nat (Suc k)) * (fps_radical r (Suc k) a) ^ k)" proof - let ?r = "fps_radical r (Suc k) a" let ?w = "(fps_const (of_nat (Suc k)) * ?r ^ k)" @@ -2278,7 +2281,8 @@ and ra0: "r k (a $ 0) ^ k = a $ 0" and r1: "(r k 1)^k = 1" and a0: "a$0 \ 0" - shows "r k (inverse (a $ 0)) = r k 1 / (r k (a $ 0)) \ fps_radical r k (inverse a) = fps_radical r k 1 / fps_radical r k a" + shows "r k (inverse (a $ 0)) = r k 1 / (r k (a $ 0)) \ + fps_radical r k (inverse a) = fps_radical r k 1 / fps_radical r k a" using radical_divide[where k=k and r=r and a=1 and b=a, OF k ] ra0 r1 a0 by (simp add: divide_inverse fps_divide_def) @@ -2344,10 +2348,7 @@ have "((1+X)*a) $n = setsum (\i. (1+X)$i * a$(n-i)) {0..n}" by (simp add: fps_mult_nth) also have "\ = setsum (\i. (1+X)$i * a$(n-i)) {0.. 1}" - unfolding Suc - apply (rule setsum_mono_zero_right) - apply auto - done + unfolding Suc by (rule setsum_mono_zero_right) auto also have "\ = (if n = 0 then (a$n :: 'a::comm_ring_1) else a$n + a$(n - 1))" by (simp add: Suc) finally show ?thesis . @@ -2747,7 +2748,7 @@ case 0 then show ?thesis by simp next - case(Suc h) + case (Suc h) { fix n { @@ -3019,13 +3020,15 @@ apply (rule setsum_cong2) apply simp apply (frule binomial_fact[where ?'a = 'a, symmetric]) - by (simp add: field_simps of_nat_mult) + apply (simp add: field_simps of_nat_mult) + done qed text{* And the nat-form -- also available from Binomial.thy *} lemma binomial_theorem: "(a+b) ^ n = (\k=0..n. (n choose k) * a^k * b^(n-k))" using gbinomial_theorem[of "of_nat a" "of_nat b" n] - unfolding of_nat_add[symmetric] of_nat_power[symmetric] of_nat_mult[symmetric] of_nat_setsum[symmetric] + unfolding of_nat_add[symmetric] of_nat_power[symmetric] of_nat_mult[symmetric] + of_nat_setsum[symmetric] by simp @@ -3089,6 +3092,7 @@ unfolding fps_deriv_eq_iff by simp qed + subsubsection{* Binomial series *} definition "fps_binomial a = Abs_fps (\n. a gchoose n)" @@ -3123,47 +3127,59 @@ by (cases n, simp_all add: field_simps del: of_nat_Suc) } note th0 = this - {fix n have "a$n = (c gchoose n) * a$0" - proof(induct n) - case 0 thus ?case by simp + { + fix n + have "a$n = (c gchoose n) * a$0" + proof (induct n) + case 0 + thus ?case by simp next case (Suc m) thus ?case unfolding th0 apply (simp add: field_simps del: of_nat_Suc) unfolding mult_assoc[symmetric] gbinomial_mult_1 - by (simp add: field_simps) - qed} + apply (simp add: field_simps) + done + qed + } note th1 = this have ?rhs apply (simp add: fps_eq_iff) apply (subst th1) - by (simp add: field_simps)} + apply (simp add: field_simps) + done + } moreover - {assume h: ?rhs - have th00:"\x y. x * (a$0 * y) = a$0 * (x*y)" by (simp add: mult_commute) + { + assume h: ?rhs + have th00: "\x y. x * (a$0 * y) = a$0 * (x*y)" + by (simp add: mult_commute) have "?l = ?r" apply (subst h) apply (subst (2) h) apply (clarsimp simp add: fps_eq_iff field_simps) unfolding mult_assoc[symmetric] th00 gbinomial_mult_1 - by (simp add: field_simps gbinomial_mult_1)} + apply (simp add: field_simps gbinomial_mult_1) + done + } ultimately show ?thesis by blast qed lemma fps_binomial_deriv: "fps_deriv (fps_binomial c) = fps_const c * fps_binomial c / (1 + X)" -proof- +proof - let ?a = "fps_binomial c" have th0: "?a = fps_const (?a$0) * ?a" by (simp) from iffD2[OF fps_binomial_ODE_unique, OF th0] show ?thesis . qed lemma fps_binomial_add_mult: "fps_binomial (c+d) = fps_binomial c * fps_binomial d" (is "?l = ?r") -proof- +proof - let ?P = "?r - ?l" let ?b = "fps_binomial" let ?db = "\x. fps_deriv (?b x)" have "fps_deriv ?P = ?db c * ?b d + ?b c * ?db d - ?db (c + d)" by simp - also have "\ = inverse (1 + X) * (fps_const c * ?b c * ?b d + fps_const d * ?b c * ?b d - fps_const (c+d) * ?b (c + d))" + also have "\ = inverse (1 + X) * + (fps_const c * ?b c * ?b d + fps_const d * ?b c * ?b d - fps_const (c+d) * ?b (c + d))" unfolding fps_binomial_deriv by (simp add: fps_divide_def field_simps) also have "\ = (fps_const (c + d)/ (1 + X)) * ?P" @@ -3182,7 +3198,8 @@ proof- have th: "?r$0 \ 0" by simp have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + X)" - by (simp add: fps_inverse_deriv[OF th] fps_divide_def power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg minus_one) + by (simp add: fps_inverse_deriv[OF th] fps_divide_def + power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg minus_one) have eq: "inverse ?r $ 0 = 1" by (simp add: fps_inverse_def) from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + X)" "- 1"] th'] eq @@ -3190,8 +3207,9 @@ qed text{* Vandermonde's Identity as a consequence *} -lemma gbinomial_Vandermonde: "setsum (\k. (a gchoose k) * (b gchoose (n - k))) {0..n} = (a + b) gchoose n" -proof- +lemma gbinomial_Vandermonde: + "setsum (\k. (a gchoose k) * (b gchoose (n - k))) {0..n} = (a + b) gchoose n" +proof - let ?ba = "fps_binomial a" let ?bb = "fps_binomial b" let ?bab = "fps_binomial (a + b)" @@ -3199,9 +3217,11 @@ then show ?thesis by (simp add: fps_mult_nth) qed -lemma binomial_Vandermonde: "setsum (\k. (a choose k) * (b choose (n - k))) {0..n} = (a + b) choose n" +lemma binomial_Vandermonde: + "setsum (\k. (a choose k) * (b choose (n - k))) {0..n} = (a + b) choose n" using gbinomial_Vandermonde[of "(of_nat a)" "of_nat b" n] - apply (simp only: binomial_gbinomial[symmetric] of_nat_mult[symmetric] of_nat_setsum[symmetric] of_nat_add[symmetric]) + apply (simp only: binomial_gbinomial[symmetric] of_nat_mult[symmetric] + of_nat_setsum[symmetric] of_nat_add[symmetric]) apply simp done @@ -3216,36 +3236,49 @@ lemma Vandermonde_pochhammer_lemma: fixes a :: "'a::field_char_0" assumes b: "\ j\{0 .. of_nat j" - shows "setsum (%k. (pochhammer (- a) k * pochhammer (- (of_nat n)) k) / (of_nat (fact k) * pochhammer (b - of_nat n + 1) k)) {0..n} = pochhammer (- (a+ b)) n / pochhammer (- b) n" (is "?l = ?r") -proof- + shows "setsum (%k. (pochhammer (- a) k * pochhammer (- (of_nat n)) k) / + (of_nat (fact k) * pochhammer (b - of_nat n + 1) k)) {0..n} = + pochhammer (- (a+ b)) n / pochhammer (- b) n" + (is "?l = ?r") +proof - let ?m1 = "%m. (- 1 :: 'a) ^ m" let ?f = "%m. of_nat (fact m)" let ?p = "%(x::'a). pochhammer (- x)" from b have bn0: "?p b n \ 0" unfolding pochhammer_eq_0_iff by simp - {fix k assume kn: "k \ {0..n}" - {assume c:"pochhammer (b - of_nat n + 1) n = 0" + { + fix k + assume kn: "k \ {0..n}" + { + assume c:"pochhammer (b - of_nat n + 1) n = 0" then obtain j where j: "j < n" "b - of_nat n + 1 = - of_nat j" unfolding pochhammer_eq_0_iff by blast from j have "b = of_nat n - of_nat j - of_nat 1" by (simp add: algebra_simps) then have "b = of_nat (n - j - 1)" using j kn by (simp add: of_nat_diff) - with b have False using j by auto} + with b have False using j by auto + } then have nz: "pochhammer (1 + b - of_nat n) n \ 0" by (auto simp add: algebra_simps) from nz kn [simplified] have nz': "pochhammer (1 + b - of_nat n) k \ 0" by (rule pochhammer_neq_0_mono) - {assume k0: "k = 0 \ n =0" - then have "b gchoose (n - k) = (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" + { + assume k0: "k = 0 \ n =0" + then have "b gchoose (n - k) = + (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" using kn - by (cases "k=0", simp_all add: gbinomial_pochhammer)} + by (cases "k = 0") (simp_all add: gbinomial_pochhammer) + } moreover - { assume n0: "n \ 0" and k0: "k \ 0" - then obtain m where m: "n = Suc m" by (cases n, auto) - from k0 obtain h where h: "k = Suc h" by (cases k, auto) - { assume kn: "k = n" - then have "b gchoose (n - k) = (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" + { + assume n0: "n \ 0" and k0: "k \ 0" + then obtain m where m: "n = Suc m" by (cases n) auto + from k0 obtain h where h: "k = Suc h" by (cases k) auto + { + assume kn: "k = n" + then have "b gchoose (n - k) = + (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" using kn pochhammer_minus'[where k=k and n=n and b=b] apply (simp add: pochhammer_same) using bn0 @@ -3253,9 +3286,9 @@ done } moreover - { assume nk: "k \ n" - have m1nk: "?m1 n = setprod (%i. - 1) {0..m}" - "?m1 k = setprod (%i. - 1) {0..h}" + { + assume nk: "k \ n" + have m1nk: "?m1 n = setprod (%i. - 1) {0..m}" "?m1 k = setprod (%i. - 1) {0..h}" by (simp_all add: setprod_constant m h) from kn nk have kn': "k < n" by simp have bnz0: "pochhammer (b - of_nat n + 1) k \ 0" @@ -3263,8 +3296,10 @@ unfolding pochhammer_eq_0_iff apply auto apply (erule_tac x= "n - ka - 1" in allE) - by (auto simp add: algebra_simps of_nat_diff) - have eq1: "setprod (%k. (1::'a) + of_nat m - of_nat k) {0 .. h} = setprod of_nat {Suc (m - h) .. Suc m}" + apply (auto simp add: algebra_simps of_nat_diff) + done + have eq1: "setprod (%k. (1::'a) + of_nat m - of_nat k) {0 .. h} = + setprod of_nat {Suc (m - h) .. Suc m}" apply (rule strong_setprod_reindex_cong[where f="%k. Suc m - k "]) using kn' h m apply (auto simp add: inj_on_def image_def) @@ -3274,7 +3309,6 @@ have th1: "(?m1 k * ?p (of_nat n) k) / ?f n = 1 / of_nat(fact (n - k))" unfolding m1nk - unfolding m h pochhammer_Suc_setprod apply (simp add: field_simps del: fact_Suc minus_one) unfolding fact_altdef_nat id_def @@ -3301,9 +3335,11 @@ using kn apply (auto simp add: inj_on_def m h image_def) apply (rule_tac x= "m - x" in bexI) - by (auto simp add: of_nat_diff) - - have "?m1 n * ?p b n = pochhammer (b - of_nat n + 1) k * setprod (%i. b - of_nat i) {0.. n - k - 1}" + apply (auto simp add: of_nat_diff) + done + + have "?m1 n * ?p b n = + pochhammer (b - of_nat n + 1) k * setprod (%i. b - of_nat i) {0.. n - k - 1}" unfolding th20 th21 unfolding h m apply (subst setprod_Un_disjoint[symmetric]) @@ -3312,19 +3348,28 @@ apply (rule setprod_cong) apply auto done - then have th2: "(?m1 n * ?p b n)/pochhammer (b - of_nat n + 1) k = setprod (%i. b - of_nat i) {0.. n - k - 1}" + then have th2: "(?m1 n * ?p b n)/pochhammer (b - of_nat n + 1) k = + setprod (%i. b - of_nat i) {0.. n - k - 1}" using nz' by (simp add: field_simps) - have "(?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k) = ((?m1 k * ?p (of_nat n) k) / ?f n) * ((?m1 n * ?p b n)/pochhammer (b - of_nat n + 1) k)" + have "(?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k) = + ((?m1 k * ?p (of_nat n) k) / ?f n) * ((?m1 n * ?p b n)/pochhammer (b - of_nat n + 1) k)" using bnz0 by (simp add: field_simps) also have "\ = b gchoose (n - k)" unfolding th1 th2 using kn' by (simp add: gbinomial_def) - finally have "b gchoose (n - k) = (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" by simp} - ultimately have "b gchoose (n - k) = (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" + finally have "b gchoose (n - k) = + (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" + by simp + } + ultimately + have "b gchoose (n - k) = + (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" by (cases "k = n") auto } - ultimately have "b gchoose (n - k) = (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" "pochhammer (1 + b - of_nat n) k \ 0 " + ultimately have "b gchoose (n - k) = + (?m1 n * ?p b n * ?m1 k * ?p (of_nat n) k) / (?f n * pochhammer (b - of_nat n + 1) k)" + "pochhammer (1 + b - of_nat n) k \ 0 " apply (cases "n = 0") using nz' apply auto @@ -3340,14 +3385,15 @@ unfolding gbinomial_Vandermonde[symmetric] apply (simp add: th00) unfolding gbinomial_pochhammer - using bn0 apply (simp add: setsum_left_distrib setsum_right_distrib field_simps) + using bn0 + apply (simp add: setsum_left_distrib setsum_right_distrib field_simps) apply (rule setsum_cong2) apply (drule th00(2)) - by (simp add: field_simps power_add[symmetric]) + apply (simp add: field_simps power_add[symmetric]) + done finally show ?thesis by simp qed - lemma Vandermonde_pochhammer: fixes a :: "'a::field_char_0" assumes c: "ALL i : {0..< n}. c \ - of_nat i" @@ -3481,9 +3527,14 @@ lemma nat_induct2: "P 0 \ P 1 \ (\n. P n \ P (n + 2)) \ P (n::nat)" unfolding One_nat_def numeral_2_eq_2 apply (induct n rule: nat_less_induct) - apply (case_tac n, simp) - apply (rename_tac m, case_tac m, simp) - apply (rename_tac k, case_tac k, simp_all) + apply (case_tac n) + apply simp + apply (rename_tac m) + apply (case_tac m) + apply simp + apply (rename_tac k) + apply (case_tac k) + apply simp_all done lemma nat_add_1_add_1: "(n::nat) + 1 + 1 = n + 2" @@ -3633,7 +3684,8 @@ subsection {* Hypergeometric series *} definition "F as bs (c::'a::{field_char_0, field_inverse_zero}) = - Abs_fps (%n. (foldl (%r a. r* pochhammer a n) 1 as * c^n)/ (foldl (%r b. r * pochhammer b n) 1 bs * of_nat (fact n)))" + Abs_fps (%n. (foldl (%r a. r* pochhammer a n) 1 as * c^n) / + (foldl (%r b. r * pochhammer b n) 1 bs * of_nat (fact n)))" lemma F_nth[simp]: "F as bs c $ n = (foldl (\r a. r* pochhammer a n) 1 as * c^n) / @@ -3644,10 +3696,12 @@ "foldl (%r x. r * f x) (v::'a::comm_ring_1) as * x = foldl (%r x. r * f x) (v * x) as " by (induct as arbitrary: x v) (auto simp add: algebra_simps) -lemma foldr_mult_foldl: "foldr (%x r. r * f x) as v = foldl (%r x. r * f x) (v :: 'a::comm_ring_1) as" +lemma foldr_mult_foldl: + "foldr (%x r. r * f x) as v = foldl (%r x. r * f x) (v :: 'a::comm_ring_1) as" by (induct as arbitrary: v) (auto simp add: foldl_mult_start) -lemma F_nth_alt: "F as bs c $ n = foldr (\a r. r * pochhammer a n) as (c ^ n) / +lemma F_nth_alt: + "F as bs c $ n = foldr (\a r. r * pochhammer a n) as (c ^ n) / foldr (\b r. r * pochhammer b n) bs (of_nat (fact n))" by (simp add: foldl_mult_start foldr_mult_foldl) @@ -3659,7 +3713,8 @@ let ?a = "(Abs_fps (\n. 1)) oo (fps_const c * X)" have th0: "(fps_const c * X) $ 0 = 0" by simp show ?thesis unfolding gp[OF th0, symmetric] - by (auto simp add: fps_eq_iff pochhammer_fact[symmetric] fps_compose_nth power_mult_distrib cond_value_iff setsum_delta' cong del: if_weak_cong) + by (auto simp add: fps_eq_iff pochhammer_fact[symmetric] + fps_compose_nth power_mult_distrib cond_value_iff setsum_delta' cong del: if_weak_cong) qed lemma F_B[simp]: "F [-a] [] (- 1) = fps_binomial a" @@ -3673,12 +3728,15 @@ apply auto done -lemma foldl_prod_prod: "foldl (%(r::'b::comm_ring_1) (x::'a::comm_ring_1). r * f x) v as * foldl (%r x. r * g x) w as = +lemma foldl_prod_prod: + "foldl (%(r::'b::comm_ring_1) (x::'a::comm_ring_1). r * f x) v as * foldl (%r x. r * g x) w as = foldl (%r x. r * f x * g x) (v*w) as" by (induct as arbitrary: v w) (auto simp add: algebra_simps) -lemma F_rec: "F as bs c $ Suc n = ((foldl (%r a. r* (a + of_nat n)) c as)/ (foldl (%r b. r * (b + of_nat n)) (of_nat (Suc n)) bs )) * F as bs c $ n" +lemma F_rec: + "F as bs c $ Suc n = ((foldl (%r a. r* (a + of_nat n)) c as) / + (foldl (%r b. r * (b + of_nat n)) (of_nat (Suc n)) bs )) * F as bs c $ n" apply (simp del: of_nat_Suc of_nat_add fact_Suc) apply (simp add: foldl_mult_start del: fact_Suc of_nat_Suc) unfolding foldl_prod_prod[unfolded foldl_mult_start] pochhammer_Suc diff -r e4b18828a817 -r 942a1b48bb31 src/HOL/Library/Fraction_Field.thy --- a/src/HOL/Library/Fraction_Field.thy Sun Aug 25 21:25:17 2013 +0200 +++ b/src/HOL/Library/Fraction_Field.thy Sun Aug 25 23:20:25 2013 +0200 @@ -75,23 +75,21 @@ code_datatype Fract -lemma Fract_cases [case_names Fract, cases type: fract]: - assumes "\a b. q = Fract a b \ b \ 0 \ C" - shows C - using assms by (cases q) (clarsimp simp add: Fract_def fract_def quotient_def) +lemma Fract_cases [cases type: fract]: + obtains (Fract) a b where "q = Fract a b" "b \ 0" + by (cases q) (clarsimp simp add: Fract_def fract_def quotient_def) lemma Fract_induct [case_names Fract, induct type: fract]: - assumes "\a b. b \ 0 \ P (Fract a b)" - shows "P q" - using assms by (cases q) simp + shows "(\a b. b \ 0 \ P (Fract a b)) \ P q" + by (cases q) simp lemma eq_fract: shows "\a b c d. b \ 0 \ d \ 0 \ Fract a b = Fract c d \ a * d = c * b" - and "\a. Fract a 0 = Fract 0 1" - and "\a c. Fract 0 a = Fract 0 c" + and "\a. Fract a 0 = Fract 0 1" + and "\a c. Fract 0 a = Fract 0 c" by (simp_all add: Fract_def) -instantiation fract :: (idom) "{comm_ring_1, power}" +instantiation fract :: (idom) "{comm_ring_1,power}" begin definition Zero_fract_def [code_unfold]: "0 = Fract 0 1" @@ -103,13 +101,16 @@ fractrel `` {(fst x * snd y + fst y * snd x, snd x * snd y)})" lemma add_fract [simp]: - assumes "b \ (0::'a::idom)" and "d \ 0" + assumes "b \ (0::'a::idom)" + and "d \ 0" shows "Fract a b + Fract c d = Fract (a * d + c * b) (b * d)" proof - have "(\x y. fractrel``{(fst x * snd y + fst y * snd x, snd x * snd y :: 'a)}) respects2 fractrel" - apply (rule equiv_fractrel [THEN congruent2_commuteI]) apply (auto simp add: algebra_simps) - unfolding mult_assoc[symmetric] . + apply (rule equiv_fractrel [THEN congruent2_commuteI]) + apply (auto simp add: algebra_simps) + unfolding mult_assoc[symmetric] + done with assms show ?thesis by (simp add: Fract_def add_fract_def UN_fractrel2) qed @@ -140,8 +141,9 @@ lemma mult_fract [simp]: "Fract (a::'a::idom) b * Fract c d = Fract (a * c) (b * d)" proof - have "(\x y. fractrel `` {(fst x * fst y, snd x * snd y :: 'a)}) respects2 fractrel" - apply (rule equiv_fractrel [THEN congruent2_commuteI]) apply (auto simp add: algebra_simps) - unfolding mult_assoc[symmetric] . + apply (rule equiv_fractrel [THEN congruent2_commuteI]) + apply (auto simp add: algebra_simps) + done then show ?thesis by (simp add: Fract_def mult_fract_def UN_fractrel2) qed @@ -155,34 +157,27 @@ instance proof - fix q r s :: "'a fract" show "(q * r) * s = q * (r * s)" + fix q r s :: "'a fract" + show "(q * r) * s = q * (r * s)" by (cases q, cases r, cases s) (simp add: eq_fract algebra_simps) -next - fix q r :: "'a fract" show "q * r = r * q" + show "q * r = r * q" by (cases q, cases r) (simp add: eq_fract algebra_simps) -next - fix q :: "'a fract" show "1 * q = q" + show "1 * q = q" by (cases q) (simp add: One_fract_def eq_fract) -next - fix q r s :: "'a fract" show "(q + r) + s = q + (r + s)" + show "(q + r) + s = q + (r + s)" by (cases q, cases r, cases s) (simp add: eq_fract algebra_simps) -next - fix q r :: "'a fract" show "q + r = r + q" + show "q + r = r + q" by (cases q, cases r) (simp add: eq_fract algebra_simps) -next - fix q :: "'a fract" show "0 + q = q" + show "0 + q = q" by (cases q) (simp add: Zero_fract_def eq_fract) -next - fix q :: "'a fract" show "- q + q = 0" + show "- q + q = 0" by (cases q) (simp add: Zero_fract_def eq_fract) -next - fix q r :: "'a fract" show "q - r = q + - r" + show "q - r = q + - r" by (cases q, cases r) (simp add: eq_fract) -next - fix q r s :: "'a fract" show "(q + r) * s = q * s + r * s" + show "(q + r) * s = q * s + r * s" by (cases q, cases r, cases s) (simp add: eq_fract algebra_simps) -next - show "(0::'a fract) \ 1" by (simp add: Zero_fract_def One_fract_def eq_fract) + show "(0::'a fract) \ 1" + by (simp add: Zero_fract_def One_fract_def eq_fract) qed end @@ -205,28 +200,28 @@ "1 = Fract 1 1" by (simp_all add: fract_collapse) -lemma Fract_cases_nonzero [case_names Fract 0]: - assumes Fract: "\a b. q = Fract a b \ b \ 0 \ a \ 0 \ C" - assumes 0: "q = 0 \ C" - shows C +lemma Fract_cases_nonzero: + obtains (Fract) a b where "q = Fract a b" "b \ 0" "a \ 0" + | (0) "q = 0" proof (cases "q = 0") - case True then show C using 0 by auto + case True + then show thesis using 0 by auto next case False then obtain a b where "q = Fract a b" and "b \ 0" by (cases q) auto moreover with False have "0 \ Fract a b" by simp with `b \ 0` have "a \ 0" by (simp add: Zero_fract_def eq_fract) - with Fract `q = Fract a b` `b \ 0` show C by auto + with Fract `q = Fract a b` `b \ 0` show thesis by auto qed - subsubsection {* The field of rational numbers *} context idom begin + subclass ring_no_zero_divisors .. -thm mult_eq_0_iff + end instantiation fract :: (idom) field_inverse_zero @@ -236,12 +231,11 @@ "inverse q = Abs_fract (\x \ Rep_fract q. fractrel `` {if fst x = 0 then (0, 1) else (snd x, fst x)})" - lemma inverse_fract [simp]: "inverse (Fract a b) = Fract (b::'a::idom) a" proof - - have stupid: "\x. (0::'a) = x \ x = 0" by auto + have *: "\x. (0::'a) = x \ x = 0" by auto have "(\x. fractrel `` {if fst x = 0 then (0, 1) else (snd x, fst x :: 'a)}) respects fractrel" - by (auto simp add: congruent_def stupid algebra_simps) + by (auto simp add: congruent_def * algebra_simps) then show ?thesis by (simp add: Fract_def inverse_fract_def UN_fractrel) qed @@ -315,20 +309,20 @@ begin definition le_fract_def: - "q \ r \ the_elem (\x \ Rep_fract q. \y \ Rep_fract r. - {(fst x * snd y)*(snd x * snd y) \ (fst y * snd x)*(snd x * snd y)})" + "q \ r \ the_elem (\x \ Rep_fract q. \y \ Rep_fract r. + {(fst x * snd y) * (snd x * snd y) \ (fst y * snd x) * (snd x * snd y)})" definition less_fract_def: "z < (w::'a fract) \ z \ w \ \ w \ z" lemma le_fract [simp]: assumes "b \ 0" and "d \ 0" shows "Fract a b \ Fract c d \ (a * d) * (b * d) \ (c * b) * (b * d)" -by (simp add: Fract_def le_fract_def le_congruent2 UN_fractrel2 assms) + by (simp add: Fract_def le_fract_def le_congruent2 UN_fractrel2 assms) lemma less_fract [simp]: assumes "b \ 0" and "d \ 0" shows "Fract a b < Fract c d \ (a * d) * (b * d) < (c * b) * (b * d)" -by (simp add: less_fract_def less_le_not_le mult_ac assms) + by (simp add: less_fract_def less_le_not_le mult_ac assms) instance proof @@ -427,10 +421,11 @@ instance fract :: (linordered_idom) linordered_field_inverse_zero proof fix q r s :: "'a fract" - show "q \ r ==> s + q \ s + r" + assume "q \ r" + then show "s + q \ s + r" proof (induct q, induct r, induct s) fix a b c d e f :: 'a - assume neq: "b \ 0" "d \ 0" "f \ 0" + assume neq: "b \ 0" "d \ 0" "f \ 0" assume le: "Fract a b \ Fract c d" show "Fract e f + Fract a b \ Fract e f + Fract c d" proof - @@ -443,7 +438,10 @@ with neq show ?thesis by (simp add: field_simps) qed qed - show "q < r ==> 0 < s ==> s * q < s * r" +next + fix q r s :: "'a fract" + assume "q < r" and "0 < s" + then show "s * q < s * r" proof (induct q, induct r, induct s) fix a b c d e f :: 'a assume neq: "b \ 0" "d \ 0" "f \ 0" @@ -483,36 +481,28 @@ thus "P q" by (force simp add: linorder_neq_iff step step') qed -lemma zero_less_Fract_iff: - "0 < b \ 0 < Fract a b \ 0 < a" +lemma zero_less_Fract_iff: "0 < b \ 0 < Fract a b \ 0 < a" by (auto simp add: Zero_fract_def zero_less_mult_iff) -lemma Fract_less_zero_iff: - "0 < b \ Fract a b < 0 \ a < 0" +lemma Fract_less_zero_iff: "0 < b \ Fract a b < 0 \ a < 0" by (auto simp add: Zero_fract_def mult_less_0_iff) -lemma zero_le_Fract_iff: - "0 < b \ 0 \ Fract a b \ 0 \ a" +lemma zero_le_Fract_iff: "0 < b \ 0 \ Fract a b \ 0 \ a" by (auto simp add: Zero_fract_def zero_le_mult_iff) -lemma Fract_le_zero_iff: - "0 < b \ Fract a b \ 0 \ a \ 0" +lemma Fract_le_zero_iff: "0 < b \ Fract a b \ 0 \ a \ 0" by (auto simp add: Zero_fract_def mult_le_0_iff) -lemma one_less_Fract_iff: - "0 < b \ 1 < Fract a b \ b < a" +lemma one_less_Fract_iff: "0 < b \ 1 < Fract a b \ b < a" by (auto simp add: One_fract_def mult_less_cancel_right_disj) -lemma Fract_less_one_iff: - "0 < b \ Fract a b < 1 \ a < b" +lemma Fract_less_one_iff: "0 < b \ Fract a b < 1 \ a < b" by (auto simp add: One_fract_def mult_less_cancel_right_disj) -lemma one_le_Fract_iff: - "0 < b \ 1 \ Fract a b \ b \ a" +lemma one_le_Fract_iff: "0 < b \ 1 \ Fract a b \ b \ a" by (auto simp add: One_fract_def mult_le_cancel_right) -lemma Fract_le_one_iff: - "0 < b \ Fract a b \ 1 \ a \ b" +lemma Fract_le_one_iff: "0 < b \ Fract a b \ 1 \ a \ b" by (auto simp add: One_fract_def mult_le_cancel_right) end diff -r e4b18828a817 -r 942a1b48bb31 src/HOL/Library/Univ_Poly.thy --- a/src/HOL/Library/Univ_Poly.thy Sun Aug 25 21:25:17 2013 +0200 +++ b/src/HOL/Library/Univ_Poly.thy Sun Aug 25 23:20:25 2013 +0200 @@ -10,7 +10,8 @@ text{* Application of polynomial as a function. *} -primrec (in semiring_0) poly :: "'a list => 'a => 'a" where +primrec (in semiring_0) poly :: "'a list \ 'a \ 'a" +where poly_Nil: "poly [] x = 0" | poly_Cons: "poly (h#t) x = h + x * poly t x" @@ -22,173 +23,171 @@ primrec (in semiring_0) padd :: "'a list \ 'a list \ 'a list" (infixl "+++" 65) where padd_Nil: "[] +++ l2 = l2" -| padd_Cons: "(h#t) +++ l2 = (if l2 = [] then h#t - else (h + hd l2)#(t +++ tl l2))" +| padd_Cons: "(h#t) +++ l2 = (if l2 = [] then h#t else (h + hd l2)#(t +++ tl l2))" text{*Multiplication by a constant*} primrec (in semiring_0) cmult :: "'a \ 'a list \ 'a list" (infixl "%*" 70) where - cmult_Nil: "c %* [] = []" -| cmult_Cons: "c %* (h#t) = (c * h)#(c %* t)" + cmult_Nil: "c %* [] = []" +| cmult_Cons: "c %* (h#t) = (c * h)#(c %* t)" text{*Multiplication by a polynomial*} primrec (in semiring_0) pmult :: "'a list \ 'a list \ 'a list" (infixl "***" 70) where - pmult_Nil: "[] *** l2 = []" -| pmult_Cons: "(h#t) *** l2 = (if t = [] then h %* l2 + pmult_Nil: "[] *** l2 = []" +| pmult_Cons: "(h#t) *** l2 = (if t = [] then h %* l2 else (h %* l2) +++ ((0) # (t *** l2)))" text{*Repeated multiplication by a polynomial*} primrec (in semiring_0) mulexp :: "nat \ 'a list \ 'a list \ 'a list" where - mulexp_zero: "mulexp 0 p q = q" -| mulexp_Suc: "mulexp (Suc n) p q = p *** mulexp n p q" + mulexp_zero: "mulexp 0 p q = q" +| mulexp_Suc: "mulexp (Suc n) p q = p *** mulexp n p q" text{*Exponential*} primrec (in semiring_1) pexp :: "'a list \ nat \ 'a list" (infixl "%^" 80) where - pexp_0: "p %^ 0 = [1]" -| pexp_Suc: "p %^ (Suc n) = p *** (p %^ n)" + pexp_0: "p %^ 0 = [1]" +| pexp_Suc: "p %^ (Suc n) = p *** (p %^ n)" text{*Quotient related value of dividing a polynomial by x + a*} (* Useful for divisor properties in inductive proofs *) -primrec (in field) "pquot" :: "'a list \ 'a \ 'a list" where - pquot_Nil: "pquot [] a= []" -| pquot_Cons: "pquot (h#t) a = (if t = [] then [h] - else (inverse(a) * (h - hd( pquot t a)))#(pquot t a))" +primrec (in field) "pquot" :: "'a list \ 'a \ 'a list" +where + pquot_Nil: "pquot [] a= []" +| pquot_Cons: "pquot (h#t) a = + (if t = [] then [h] else (inverse(a) * (h - hd( pquot t a)))#(pquot t a))" text{*normalization of polynomials (remove extra 0 coeff)*} primrec (in semiring_0) pnormalize :: "'a list \ 'a list" where pnormalize_Nil: "pnormalize [] = []" -| pnormalize_Cons: "pnormalize (h#p) = (if ( (pnormalize p) = []) - then (if (h = 0) then [] else [h]) - else (h#(pnormalize p)))" +| pnormalize_Cons: "pnormalize (h#p) = + (if pnormalize p = [] then (if h = 0 then [] else [h]) else h # pnormalize p)" definition (in semiring_0) "pnormal p = ((pnormalize p = p) \ p \ [])" definition (in semiring_0) "nonconstant p = (pnormal p \ (\x. p \ [x]))" text{*Other definitions*} -definition (in ring_1) - poly_minus :: "'a list => 'a list" ("-- _" [80] 80) where - "-- p = (- 1) %* p" +definition (in ring_1) poly_minus :: "'a list \ 'a list" ("-- _" [80] 80) + where "-- p = (- 1) %* p" -definition (in semiring_0) - divides :: "'a list \ 'a list \ bool" (infixl "divides" 70) where - "p1 divides p2 = (\q. poly p2 = poly(p1 *** q))" +definition (in semiring_0) divides :: "'a list \ 'a list \ bool" (infixl "divides" 70) + where "p1 divides p2 = (\q. poly p2 = poly(p1 *** q))" --{*order of a polynomial*} -definition (in ring_1) order :: "'a => 'a list => nat" where - "order a p = (SOME n. ([-a, 1] %^ n) divides p & - ~ (([-a, 1] %^ (Suc n)) divides p))" +definition (in ring_1) order :: "'a \ 'a list \ nat" where + "order a p = (SOME n. ([-a, 1] %^ n) divides p \ ~ (([-a, 1] %^ (Suc n)) divides p))" --{*degree of a polynomial*} -definition (in semiring_0) degree :: "'a list => nat" where - "degree p = length (pnormalize p) - 1" +definition (in semiring_0) degree :: "'a list \ nat" + where "degree p = length (pnormalize p) - 1" --{*squarefree polynomials --- NB with respect to real roots only.*} -definition (in ring_1) - rsquarefree :: "'a list => bool" where - "rsquarefree p = (poly p \ poly [] & - (\a. (order a p = 0) | (order a p = 1)))" +definition (in ring_1) rsquarefree :: "'a list \ bool" + where "rsquarefree p \ poly p \ poly [] \ (\a. order a p = 0 \ order a p = 1)" context semiring_0 begin lemma padd_Nil2[simp]: "p +++ [] = p" -by (induct p) auto + by (induct p) auto lemma padd_Cons_Cons: "(h1 # p1) +++ (h2 # p2) = (h1 + h2) # (p1 +++ p2)" -by auto + by auto lemma pminus_Nil: "-- [] = []" -by (simp add: poly_minus_def) + by (simp add: poly_minus_def) lemma pmult_singleton: "[h1] *** p1 = h1 %* p1" by simp + end lemma (in semiring_1) poly_ident_mult[simp]: "1 %* t = t" by (induct t) auto lemma (in semiring_0) poly_simple_add_Cons[simp]: "[a] +++ ((0)#t) = (a#t)" -by simp + by simp text{*Handy general properties*} lemma (in comm_semiring_0) padd_commut: "b +++ a = a +++ b" -proof(induct b arbitrary: a) - case Nil thus ?case by auto +proof (induct b arbitrary: a) + case Nil + thus ?case by auto next - case (Cons b bs a) thus ?case by (cases a) (simp_all add: add_commute) + case (Cons b bs a) + thus ?case by (cases a) (simp_all add: add_commute) qed lemma (in comm_semiring_0) padd_assoc: "\b c. (a +++ b) +++ c = a +++ (b +++ c)" -apply (induct a) -apply (simp, clarify) -apply (case_tac b, simp_all add: add_ac) -done + apply (induct a) + apply (simp, clarify) + apply (case_tac b, simp_all add: add_ac) + done lemma (in semiring_0) poly_cmult_distr: "a %* ( p +++ q) = (a %* p +++ a %* q)" -apply (induct p arbitrary: q, simp) -apply (case_tac q, simp_all add: distrib_left) -done + apply (induct p arbitrary: q) + apply simp + apply (case_tac q, simp_all add: distrib_left) + done lemma (in ring_1) pmult_by_x[simp]: "[0, 1] *** t = ((0)#t)" -apply (induct "t", simp) -apply (auto simp add: padd_commut) -apply (case_tac t, auto) -done + apply (induct t) + apply simp + apply (auto simp add: padd_commut) + apply (case_tac t, auto) + done text{*properties of evaluation of polynomials.*} lemma (in semiring_0) poly_add: "poly (p1 +++ p2) x = poly p1 x + poly p2 x" proof(induct p1 arbitrary: p2) - case Nil thus ?case by simp + case Nil + thus ?case by simp next - case (Cons a as p2) thus ?case + case (Cons a as p2) + thus ?case by (cases p2) (simp_all add: add_ac distrib_left) qed lemma (in comm_semiring_0) poly_cmult: "poly (c %* p) x = c * poly p x" -apply (induct "p") -apply (case_tac [2] "x=zero") -apply (auto simp add: distrib_left mult_ac) -done + apply (induct p) + apply (case_tac [2] "x = zero") + apply (auto simp add: distrib_left mult_ac) + done lemma (in comm_semiring_0) poly_cmult_map: "poly (map (op * c) p) x = c*poly p x" - by (induct p, auto simp add: distrib_left mult_ac) + by (induct p) (auto simp add: distrib_left mult_ac) lemma (in comm_ring_1) poly_minus: "poly (-- p) x = - (poly p x)" -apply (simp add: poly_minus_def) -apply (auto simp add: poly_cmult) -done + apply (simp add: poly_minus_def) + apply (auto simp add: poly_cmult) + done lemma (in comm_semiring_0) poly_mult: "poly (p1 *** p2) x = poly p1 x * poly p2 x" -proof(induct p1 arbitrary: p2) - case Nil thus ?case by simp +proof (induct p1 arbitrary: p2) + case Nil + thus ?case by simp next case (Cons a as p2) - thus ?case by (cases as, - simp_all add: poly_cmult poly_add distrib_right distrib_left mult_ac) + thus ?case by (cases as) + (simp_all add: poly_cmult poly_add distrib_right distrib_left mult_ac) qed class idom_char_0 = idom + ring_char_0 lemma (in comm_ring_1) poly_exp: "poly (p %^ n) x = (poly p x) ^ n" -apply (induct "n") -apply (auto simp add: poly_cmult poly_mult) -done + by (induct n) (auto simp add: poly_cmult poly_mult) text{*More Polynomial Evaluation Lemmas*} -lemma (in semiring_0) poly_add_rzero[simp]: "poly (a +++ []) x = poly a x" -by simp +lemma (in semiring_0) poly_add_rzero[simp]: "poly (a +++ []) x = poly a x" + by simp lemma (in comm_semiring_0) poly_mult_assoc: "poly ((a *** b) *** c) x = poly (a *** (b *** c)) x" by (simp add: poly_mult mult_assoc) lemma (in semiring_0) poly_mult_Nil2[simp]: "poly (p *** []) x = 0" -by (induct "p", auto) + by (induct p) auto lemma (in comm_semiring_1) poly_exp_add: "poly (p %^ (n + d)) x = poly( p %^ n *** p %^ d) x" -apply (induct "n") -apply (auto simp add: poly_mult mult_assoc) -done + by (induct n) (auto simp add: poly_mult mult_assoc) subsection{*Key Property: if @{term "f(a) = 0"} then @{term "(x - a)"} divides @{term "p(x)"} *} @@ -196,11 +195,11 @@ lemma (in comm_ring_1) lemma_poly_linear_rem: "\h. \q r. h#t = [r] +++ [-a, 1] *** q" proof(induct t) case Nil - {fix h have "[h] = [h] +++ [- a, 1] *** []" by simp} + { fix h have "[h] = [h] +++ [- a, 1] *** []" by simp } thus ?case by blast next case (Cons x xs) - {fix h + { fix h from Cons.hyps[rule_format, of x] obtain q r where qr: "x#xs = [r] +++ [- a, 1] *** q" by blast have "h#x#xs = [a*r + h] +++ [-a, 1] *** (r#q)" @@ -210,12 +209,12 @@ qed lemma (in comm_ring_1) poly_linear_rem: "\q r. h#t = [r] +++ [-a, 1] *** q" -by (cut_tac t = t and a = a in lemma_poly_linear_rem, auto) + using lemma_poly_linear_rem [where t = t and a = a] by auto lemma (in comm_ring_1) poly_linear_divides: "(poly p a = 0) = ((p = []) | (\q. p = [-a, 1] *** q))" -proof- - {assume p: "p = []" hence ?thesis by simp} +proof - + { assume p: "p = []" hence ?thesis by simp } moreover { fix x xs assume p: "p = x#xs" @@ -224,59 +223,68 @@ hence "poly p a = 0" by (simp add: poly_add poly_cmult) } moreover - {assume p0: "poly p a = 0" + { assume p0: "poly p a = 0" from poly_linear_rem[of x xs a] obtain q r where qr: "x#xs = [r] +++ [- a, 1] *** q" by blast have "r = 0" using p0 by (simp only: p qr poly_mult poly_add) simp - hence "\q. p = [- a, 1] *** q" using p qr apply - apply (rule exI[where x=q])apply auto apply (cases q) apply auto done} - ultimately have ?thesis using p by blast} - ultimately show ?thesis by (cases p, auto) + hence "\q. p = [- a, 1] *** q" + using p qr + apply - + apply (rule exI[where x=q]) + apply auto + apply (cases q) + apply auto + done + } + ultimately have ?thesis using p by blast + } + ultimately show ?thesis by (cases p) auto qed lemma (in semiring_0) lemma_poly_length_mult[simp]: "\h k a. length (k %* p +++ (h # (a %* p))) = Suc (length p)" -by (induct "p", auto) + by (induct p) auto lemma (in semiring_0) lemma_poly_length_mult2[simp]: "\h k. length (k %* p +++ (h # p)) = Suc (length p)" -by (induct "p", auto) + by (induct p) auto lemma (in ring_1) poly_length_mult[simp]: "length([-a,1] *** q) = Suc (length q)" -by auto + by auto subsection{*Polynomial length*} lemma (in semiring_0) poly_cmult_length[simp]: "length (a %* p) = length p" -by (induct "p", auto) + by (induct p) auto lemma (in semiring_0) poly_add_length: "length (p1 +++ p2) = max (length p1) (length p2)" -apply (induct p1 arbitrary: p2, simp_all) -apply arith -done + by (induct p1 arbitrary: p2) (simp_all, arith) lemma (in semiring_0) poly_root_mult_length[simp]: "length([a,b] *** p) = Suc (length p)" -by (simp add: poly_add_length) + by (simp add: poly_add_length) lemma (in idom) poly_mult_not_eq_poly_Nil[simp]: - "poly (p *** q) x \ poly [] x \ poly p x \ poly [] x \ poly q x \ poly [] x" -by (auto simp add: poly_mult) + "poly (p *** q) x \ poly [] x \ poly p x \ poly [] x \ poly q x \ poly [] x" + by (auto simp add: poly_mult) lemma (in idom) poly_mult_eq_zero_disj: "poly (p *** q) x = 0 \ poly p x = 0 \ poly q x = 0" -by (auto simp add: poly_mult) + by (auto simp add: poly_mult) text{*Normalisation Properties*} lemma (in semiring_0) poly_normalized_nil: "(pnormalize p = []) --> (poly p x = 0)" -by (induct "p", auto) + by (induct p) auto text{*A nontrivial polynomial of degree n has no more than n roots*} lemma (in idom) poly_roots_index_lemma: assumes p: "poly p x \ poly [] x" and n: "length p = n" shows "\i. \x. poly p x = 0 \ (\m\n. x = i m)" using p n -proof(induct n arbitrary: p x) - case 0 thus ?case by simp +proof (induct n arbitrary: p x) + case 0 + thus ?case by simp next case (Suc n p x) - {assume C: "\i. \x. poly p x = 0 \ (\m\Suc n. x \ i m)" + { + assume C: "\i. \x. poly p x = 0 \ (\m\Suc n. x \ i m)" from Suc.prems have p0: "poly p x \ 0" "p\ []" by auto from p0(1)[unfolded poly_linear_divides[of p x]] have "\q. p \ [- x, 1] *** q" by blast @@ -293,48 +301,49 @@ by blast from y have "y = a \ poly q y = 0" by (simp only: q poly_mult_eq_zero_disj poly_add) (simp add: algebra_simps) - with i[rule_format, of y] y(1) y(2) have False apply auto - apply (erule_tac x="m" in allE) + with i[rule_format, of y] y(1) y(2) have False apply auto - done} + apply (erule_tac x = "m" in allE) + apply auto + done + } thus ?case by blast qed -lemma (in idom) poly_roots_index_length: "poly p x \ poly [] x ==> - \i. \x. (poly p x = 0) --> (\n. n \ length p & x = i n)" -by (blast intro: poly_roots_index_lemma) +lemma (in idom) poly_roots_index_length: + "poly p x \ poly [] x \ \i. \x. (poly p x = 0) \ (\n. n \ length p \ x = i n)" + by (blast intro: poly_roots_index_lemma) -lemma (in idom) poly_roots_finite_lemma1: "poly p x \ poly [] x ==> - \N i. \x. (poly p x = 0) --> (\n. (n::nat) < N & x = i n)" -apply (drule poly_roots_index_length, safe) -apply (rule_tac x = "Suc (length p)" in exI) -apply (rule_tac x = i in exI) -apply (simp add: less_Suc_eq_le) -done - +lemma (in idom) poly_roots_finite_lemma1: + "poly p x \ poly [] x \ \N i. \x. (poly p x = 0) \ (\n. (n::nat) < N \ x = i n)" + apply (drule poly_roots_index_length, safe) + apply (rule_tac x = "Suc (length p)" in exI) + apply (rule_tac x = i in exI) + apply (simp add: less_Suc_eq_le) + done lemma (in idom) idom_finite_lemma: - assumes P: "\x. P x --> (\n. n < length j & x = j!n)" + assumes P: "\x. P x --> (\n. n < length j \ x = j!n)" shows "finite {x. P x}" -proof- +proof - let ?M = "{x. P x}" let ?N = "set j" have "?M \ ?N" using P by auto thus ?thesis using finite_subset by auto qed +lemma (in idom) poly_roots_finite_lemma2: + "poly p x \ poly [] x \ \i. \x. poly p x = 0 \ x \ set i" + apply (drule poly_roots_index_length, safe) + apply (rule_tac x="map (\n. i n) [0 ..< Suc (length p)]" in exI) + apply (auto simp add: image_iff) + apply (erule_tac x="x" in allE, clarsimp) + apply (case_tac "n = length p") + apply (auto simp add: order_le_less) + done -lemma (in idom) poly_roots_finite_lemma2: "poly p x \ poly [] x ==> - \i. \x. (poly p x = 0) --> x \ set i" -apply (drule poly_roots_index_length, safe) -apply (rule_tac x="map (\n. i n) [0 ..< Suc (length p)]" in exI) -apply (auto simp add: image_iff) -apply (erule_tac x="x" in allE, clarsimp) -by (case_tac "n=length p", auto simp add: order_le_less) - -lemma (in ring_char_0) UNIV_ring_char_0_infinte: - "\ (finite (UNIV:: 'a set))" +lemma (in ring_char_0) UNIV_ring_char_0_infinte: "\ (finite (UNIV:: 'a set))" proof assume F: "finite (UNIV :: 'a set)" have "finite (UNIV :: nat set)" @@ -346,8 +355,7 @@ with infinite_UNIV_nat show False .. qed -lemma (in idom_char_0) poly_roots_finite: "(poly p \ poly []) = - finite {x. poly p x = 0}" +lemma (in idom_char_0) poly_roots_finite: "poly p \ poly [] \ finite {x. poly p x = 0}" proof assume H: "poly p \ poly []" show "finite {x. poly p x = (0::'a)}" @@ -357,7 +365,7 @@ apply (rule ccontr) apply (clarify dest!: poly_roots_finite_lemma2) using finite_subset - proof- + proof - fix x i assume F: "\ finite {x. poly p x = (0\'a)}" and P: "\x. poly p x = (0\'a) \ x \ set i" @@ -373,9 +381,10 @@ text{*Entirety and Cancellation for polynomials*} lemma (in idom_char_0) poly_entire_lemma2: - assumes p0: "poly p \ poly []" and q0: "poly q \ poly []" + assumes p0: "poly p \ poly []" + and q0: "poly q \ poly []" shows "poly (p***q) \ poly []" -proof- +proof - let ?S = "\p. {x. poly p x = 0}" have "?S (p *** q) = ?S p \ ?S q" by (auto simp add: poly_mult) with p0 q0 show ?thesis unfolding poly_roots_finite by auto @@ -383,74 +392,82 @@ lemma (in idom_char_0) poly_entire: "poly (p *** q) = poly [] \ poly p = poly [] \ poly q = poly []" -using poly_entire_lemma2[of p q] -by (auto simp add: fun_eq_iff poly_mult) + using poly_entire_lemma2[of p q] + by (auto simp add: fun_eq_iff poly_mult) -lemma (in idom_char_0) poly_entire_neg: "(poly (p *** q) \ poly []) = ((poly p \ poly []) & (poly q \ poly []))" -by (simp add: poly_entire) +lemma (in idom_char_0) poly_entire_neg: + "poly (p *** q) \ poly [] \ poly p \ poly [] \ poly q \ poly []" + by (simp add: poly_entire) -lemma fun_eq: " (f = g) = (\x. f x = g x)" -by auto +lemma fun_eq: "f = g \ (\x. f x = g x)" + by auto -lemma (in comm_ring_1) poly_add_minus_zero_iff: "(poly (p +++ -- q) = poly []) = (poly p = poly q)" -by (auto simp add: algebra_simps poly_add poly_minus_def fun_eq poly_cmult) +lemma (in comm_ring_1) poly_add_minus_zero_iff: + "poly (p +++ -- q) = poly [] \ poly p = poly q" + by (auto simp add: algebra_simps poly_add poly_minus_def fun_eq poly_cmult) -lemma (in comm_ring_1) poly_add_minus_mult_eq: "poly (p *** q +++ --(p *** r)) = poly (p *** (q +++ -- r))" -by (auto simp add: poly_add poly_minus_def fun_eq poly_mult poly_cmult distrib_left) +lemma (in comm_ring_1) poly_add_minus_mult_eq: + "poly (p *** q +++ --(p *** r)) = poly (p *** (q +++ -- r))" + by (auto simp add: poly_add poly_minus_def fun_eq poly_mult poly_cmult distrib_left) subclass (in idom_char_0) comm_ring_1 .. -lemma (in idom_char_0) poly_mult_left_cancel: "(poly (p *** q) = poly (p *** r)) = (poly p = poly [] | poly q = poly r)" -proof- - have "poly (p *** q) = poly (p *** r) \ poly (p *** q +++ -- (p *** r)) = poly []" by (simp only: poly_add_minus_zero_iff) - also have "\ \ poly p = poly [] | poly q = poly r" + +lemma (in idom_char_0) poly_mult_left_cancel: + "poly (p *** q) = poly (p *** r) \ poly p = poly [] \ poly q = poly r" +proof - + have "poly (p *** q) = poly (p *** r) \ poly (p *** q +++ -- (p *** r)) = poly []" + by (simp only: poly_add_minus_zero_iff) + also have "\ \ poly p = poly [] \ poly q = poly r" by (auto intro: simp add: poly_add_minus_mult_eq poly_entire poly_add_minus_zero_iff) finally show ?thesis . qed lemma (in idom) poly_exp_eq_zero[simp]: - "(poly (p %^ n) = poly []) = (poly p = poly [] & n \ 0)" -apply (simp only: fun_eq add: HOL.all_simps [symmetric]) -apply (rule arg_cong [where f = All]) -apply (rule ext) -apply (induct n) -apply (auto simp add: poly_exp poly_mult) -done + "poly (p %^ n) = poly [] \ poly p = poly [] \ n \ 0" + apply (simp only: fun_eq add: HOL.all_simps [symmetric]) + apply (rule arg_cong [where f = All]) + apply (rule ext) + apply (induct n) + apply (auto simp add: poly_exp poly_mult) + done lemma (in comm_ring_1) poly_prime_eq_zero[simp]: "poly [a,1] \ poly []" -apply (simp add: fun_eq) -apply (rule_tac x = "minus one a" in exI) -apply (unfold diff_minus) -apply (subst add_commute) -apply (subst add_assoc) -apply simp -done + apply (simp add: fun_eq) + apply (rule_tac x = "minus one a" in exI) + apply (unfold diff_minus) + apply (subst add_commute) + apply (subst add_assoc) + apply simp + done -lemma (in idom) poly_exp_prime_eq_zero: "(poly ([a, 1] %^ n) \ poly [])" -by auto +lemma (in idom) poly_exp_prime_eq_zero: "poly ([a, 1] %^ n) \ poly []" + by auto text{*A more constructive notion of polynomials being trivial*} -lemma (in idom_char_0) poly_zero_lemma': "poly (h # t) = poly [] ==> h = 0 & poly t = poly []" -apply(simp add: fun_eq) -apply (case_tac "h = zero") -apply (drule_tac [2] x = zero in spec, auto) -apply (cases "poly t = poly []", simp) -proof- +lemma (in idom_char_0) poly_zero_lemma': "poly (h # t) = poly [] \ h = 0 \ poly t = poly []" + apply (simp add: fun_eq) + apply (case_tac "h = zero") + apply (drule_tac [2] x = zero in spec, auto) + apply (cases "poly t = poly []", simp) +proof - fix x - assume H: "\x. x = (0\'a) \ poly t x = (0\'a)" and pnz: "poly t \ poly []" + assume H: "\x. x = (0\'a) \ poly t x = (0\'a)" + and pnz: "poly t \ poly []" let ?S = "{x. poly t x = 0}" from H have "\x. x \0 \ poly t x = 0" by blast hence th: "?S \ UNIV - {0}" by auto from poly_roots_finite pnz have th': "finite ?S" by blast - from finite_subset[OF th th'] UNIV_ring_char_0_infinte - show "poly t x = (0\'a)" by simp - qed + from finite_subset[OF th th'] UNIV_ring_char_0_infinte show "poly t x = (0\'a)" + by simp +qed lemma (in idom_char_0) poly_zero: "(poly p = poly []) = list_all (%c. c = 0) p" -apply (induct "p", simp) -apply (rule iffI) -apply (drule poly_zero_lemma', auto) -done + apply (induct p) + apply simp + apply (rule iffI) + apply (drule poly_zero_lemma', auto) + done lemma (in idom_char_0) poly_0: "list_all (\c. c = 0) p \ poly p x = 0" unfolding poly_zero[symmetric] by simp @@ -459,115 +476,126 @@ text{*Basics of divisibility.*} -lemma (in idom) poly_primes: "([a, 1] divides (p *** q)) = ([a, 1] divides p | [a, 1] divides q)" -apply (auto simp add: divides_def fun_eq poly_mult poly_add poly_cmult distrib_right [symmetric]) -apply (drule_tac x = "uminus a" in spec) -apply (simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric]) -apply (cases "p = []") -apply (rule exI[where x="[]"]) -apply simp -apply (cases "q = []") -apply (erule allE[where x="[]"], simp) +lemma (in idom) poly_primes: + "[a, 1] divides (p *** q) \ [a, 1] divides p \ [a, 1] divides q" + apply (auto simp add: divides_def fun_eq poly_mult poly_add poly_cmult distrib_right [symmetric]) + apply (drule_tac x = "uminus a" in spec) + apply (simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric]) + apply (cases "p = []") + apply (rule exI[where x="[]"]) + apply simp + apply (cases "q = []") + apply (erule allE[where x="[]"], simp) -apply clarsimp -apply (cases "\q\'a list. p = a %* q +++ ((0\'a) # q)") -apply (clarsimp simp add: poly_add poly_cmult) -apply (rule_tac x="qa" in exI) -apply (simp add: distrib_right [symmetric]) -apply clarsimp + apply clarsimp + apply (cases "\q\'a list. p = a %* q +++ ((0\'a) # q)") + apply (clarsimp simp add: poly_add poly_cmult) + apply (rule_tac x="qa" in exI) + apply (simp add: distrib_right [symmetric]) + apply clarsimp -apply (auto simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric]) -apply (rule_tac x = "pmult qa q" in exI) -apply (rule_tac [2] x = "pmult p qa" in exI) -apply (auto simp add: poly_add poly_mult poly_cmult mult_ac) -done + apply (auto simp add: poly_linear_divides poly_add poly_cmult distrib_right [symmetric]) + apply (rule_tac x = "pmult qa q" in exI) + apply (rule_tac [2] x = "pmult p qa" in exI) + apply (auto simp add: poly_add poly_mult poly_cmult mult_ac) + done lemma (in comm_semiring_1) poly_divides_refl[simp]: "p divides p" -apply (simp add: divides_def) -apply (rule_tac x = "[one]" in exI) -apply (auto simp add: poly_mult fun_eq) -done + apply (simp add: divides_def) + apply (rule_tac x = "[one]" in exI) + apply (auto simp add: poly_mult fun_eq) + done -lemma (in comm_semiring_1) poly_divides_trans: "[| p divides q; q divides r |] ==> p divides r" -apply (simp add: divides_def, safe) -apply (rule_tac x = "pmult qa qaa" in exI) -apply (auto simp add: poly_mult fun_eq mult_assoc) -done - +lemma (in comm_semiring_1) poly_divides_trans: "p divides q \ q divides r \ p divides r" + apply (simp add: divides_def, safe) + apply (rule_tac x = "pmult qa qaa" in exI) + apply (auto simp add: poly_mult fun_eq mult_assoc) + done -lemma (in comm_semiring_1) poly_divides_exp: "m \ n ==> (p %^ m) divides (p %^ n)" -apply (auto simp add: le_iff_add) -apply (induct_tac k) -apply (rule_tac [2] poly_divides_trans) -apply (auto simp add: divides_def) -apply (rule_tac x = p in exI) -apply (auto simp add: poly_mult fun_eq mult_ac) -done +lemma (in comm_semiring_1) poly_divides_exp: "m \ n \ (p %^ m) divides (p %^ n)" + apply (auto simp add: le_iff_add) + apply (induct_tac k) + apply (rule_tac [2] poly_divides_trans) + apply (auto simp add: divides_def) + apply (rule_tac x = p in exI) + apply (auto simp add: poly_mult fun_eq mult_ac) + done -lemma (in comm_semiring_1) poly_exp_divides: "[| (p %^ n) divides q; m\n |] ==> (p %^ m) divides q" -by (blast intro: poly_divides_exp poly_divides_trans) +lemma (in comm_semiring_1) poly_exp_divides: + "(p %^ n) divides q \ m \ n \ (p %^ m) divides q" + by (blast intro: poly_divides_exp poly_divides_trans) lemma (in comm_semiring_0) poly_divides_add: - "[| p divides q; p divides r |] ==> p divides (q +++ r)" -apply (simp add: divides_def, auto) -apply (rule_tac x = "padd qa qaa" in exI) -apply (auto simp add: poly_add fun_eq poly_mult distrib_left) -done + "p divides q \ p divides r \ p divides (q +++ r)" + apply (simp add: divides_def, auto) + apply (rule_tac x = "padd qa qaa" in exI) + apply (auto simp add: poly_add fun_eq poly_mult distrib_left) + done lemma (in comm_ring_1) poly_divides_diff: - "[| p divides q; p divides (q +++ r) |] ==> p divides r" -apply (simp add: divides_def, auto) -apply (rule_tac x = "padd qaa (poly_minus qa)" in exI) -apply (auto simp add: poly_add fun_eq poly_mult poly_minus algebra_simps) -done + "p divides q \ p divides (q +++ r) \ p divides r" + apply (simp add: divides_def, auto) + apply (rule_tac x = "padd qaa (poly_minus qa)" in exI) + apply (auto simp add: poly_add fun_eq poly_mult poly_minus algebra_simps) + done -lemma (in comm_ring_1) poly_divides_diff2: "[| p divides r; p divides (q +++ r) |] ==> p divides q" -apply (erule poly_divides_diff) -apply (auto simp add: poly_add fun_eq poly_mult divides_def add_ac) -done +lemma (in comm_ring_1) poly_divides_diff2: + "p divides r \ p divides (q +++ r) \ p divides q" + apply (erule poly_divides_diff) + apply (auto simp add: poly_add fun_eq poly_mult divides_def add_ac) + done -lemma (in semiring_0) poly_divides_zero: "poly p = poly [] ==> q divides p" -apply (simp add: divides_def) -apply (rule exI[where x="[]"]) -apply (auto simp add: fun_eq poly_mult) -done +lemma (in semiring_0) poly_divides_zero: "poly p = poly [] \ q divides p" + apply (simp add: divides_def) + apply (rule exI[where x="[]"]) + apply (auto simp add: fun_eq poly_mult) + done -lemma (in semiring_0) poly_divides_zero2[simp]: "q divides []" -apply (simp add: divides_def) -apply (rule_tac x = "[]" in exI) -apply (auto simp add: fun_eq) -done +lemma (in semiring_0) poly_divides_zero2 [simp]: "q divides []" + apply (simp add: divides_def) + apply (rule_tac x = "[]" in exI) + apply (auto simp add: fun_eq) + done text{*At last, we can consider the order of a root.*} -lemma (in idom_char_0) poly_order_exists_lemma: - assumes lp: "length p = d" and p: "poly p \ poly []" +lemma (in idom_char_0) poly_order_exists_lemma: + assumes lp: "length p = d" + and p: "poly p \ poly []" shows "\n q. p = mulexp n [-a, 1] q \ poly q a \ 0" -using lp p -proof(induct d arbitrary: p) - case 0 thus ?case by simp + using lp p +proof (induct d arbitrary: p) + case 0 + thus ?case by simp next case (Suc n p) - {assume p0: "poly p a = 0" + show ?case + proof (cases "poly p a = 0") + case True from Suc.prems have h: "length p = Suc n" "poly p \ poly []" by auto hence pN: "p \ []" by auto - from p0[unfolded poly_linear_divides] pN obtain q where - q: "p = [-a, 1] *** q" by blast - from q h p0 have qh: "length q = n" "poly q \ poly []" + from True[unfolded poly_linear_divides] pN obtain q where q: "p = [-a, 1] *** q" + by blast + from q h True have qh: "length q = n" "poly q \ poly []" apply - apply simp apply (simp only: fun_eq) apply (rule ccontr) apply (simp add: fun_eq poly_add poly_cmult) done - from Suc.hyps[OF qh] obtain m r where - mr: "q = mulexp m [-a,1] r" "poly r a \ 0" by blast + from Suc.hyps[OF qh] obtain m r where mr: "q = mulexp m [-a,1] r" "poly r a \ 0" + by blast from mr q have "p = mulexp (Suc m) [-a,1] r \ poly r a \ 0" by simp - hence ?case by blast} - moreover - {assume p0: "poly p a \ 0" - hence ?case using Suc.prems apply simp by (rule exI[where x="0::nat"], simp)} - ultimately show ?case by blast + then show ?thesis by blast + next + case False + then show ?thesis + using Suc.prems + apply simp + apply (rule exI[where x="0::nat"]) + apply simp + done + qed qed @@ -585,263 +613,240 @@ qed - (* FIXME: Tidy up *) -lemma (in semiring_1) - zero_power_iff: "0 ^ n = (if n = 0 then 1 else 0)" +lemma (in semiring_1) zero_power_iff: "0 ^ n = (if n = 0 then 1 else 0)" by (induct n) simp_all lemma (in idom_char_0) poly_order_exists: - assumes lp: "length p = d" and p0: "poly p \ poly []" - shows "\n. ([-a, 1] %^ n) divides p & ~(([-a, 1] %^ (Suc n)) divides p)" -proof- -let ?poly = poly -let ?mulexp = mulexp -let ?pexp = pexp -from lp p0 -show ?thesis -apply - -apply (drule poly_order_exists_lemma [where a=a], assumption, clarify) -apply (rule_tac x = n in exI, safe) -apply (unfold divides_def) -apply (rule_tac x = q in exI) -apply (induct_tac "n", simp) -apply (simp (no_asm_simp) add: poly_add poly_cmult poly_mult distrib_left mult_ac) -apply safe -apply (subgoal_tac "?poly (?mulexp n [uminus a, one] q) \ ?poly (pmult (?pexp [uminus a, one] (Suc n)) qa)") -apply simp -apply (induct_tac "n") -apply (simp del: pmult_Cons pexp_Suc) -apply (erule_tac Q = "?poly q a = zero" in contrapos_np) -apply (simp add: poly_add poly_cmult) -apply (rule pexp_Suc [THEN ssubst]) -apply (rule ccontr) -apply (simp add: poly_mult_left_cancel poly_mult_assoc del: pmult_Cons pexp_Suc) -done -qed - + assumes "length p = d" and "poly p \ poly []" + shows "\n. ([-a, 1] %^ n) divides p \ ~(([-a, 1] %^ (Suc n)) divides p)" + using assms + apply - + apply (drule poly_order_exists_lemma [where a=a], assumption, clarify) + apply (rule_tac x = n in exI, safe) + apply (unfold divides_def) + apply (rule_tac x = q in exI) + apply (induct_tac n, simp) + apply (simp (no_asm_simp) add: poly_add poly_cmult poly_mult distrib_left mult_ac) + apply safe + apply (subgoal_tac "poly (mulexp n [uminus a, one] q) \ + poly (pmult (pexp [uminus a, one] (Suc n)) qa)") + apply simp + apply (induct_tac n) + apply (simp del: pmult_Cons pexp_Suc) + apply (erule_tac Q = "poly q a = zero" in contrapos_np) + apply (simp add: poly_add poly_cmult) + apply (rule pexp_Suc [THEN ssubst]) + apply (rule ccontr) + apply (simp add: poly_mult_left_cancel poly_mult_assoc del: pmult_Cons pexp_Suc) + done lemma (in semiring_1) poly_one_divides[simp]: "[1] divides p" -by (simp add: divides_def, auto) + by (auto simp add: divides_def) -lemma (in idom_char_0) poly_order: "poly p \ poly [] - ==> EX! n. ([-a, 1] %^ n) divides p & - ~(([-a, 1] %^ (Suc n)) divides p)" -apply (auto intro: poly_order_exists simp add: less_linear simp del: pmult_Cons pexp_Suc) -apply (cut_tac x = y and y = n in less_linear) -apply (drule_tac m = n in poly_exp_divides) -apply (auto dest: Suc_le_eq [THEN iffD2, THEN [2] poly_exp_divides] - simp del: pmult_Cons pexp_Suc) -done +lemma (in idom_char_0) poly_order: + "poly p \ poly [] \ \!n. ([-a, 1] %^ n) divides p \ \ (([-a, 1] %^ Suc n) divides p)" + apply (auto intro: poly_order_exists simp add: less_linear simp del: pmult_Cons pexp_Suc) + apply (cut_tac x = y and y = n in less_linear) + apply (drule_tac m = n in poly_exp_divides) + apply (auto dest: Suc_le_eq [THEN iffD2, THEN [2] poly_exp_divides] + simp del: pmult_Cons pexp_Suc) + done text{*Order*} -lemma some1_equalityD: "[| n = (@n. P n); EX! n. P n |] ==> P n" -by (blast intro: someI2) +lemma some1_equalityD: "n = (SOME n. P n) \ \!n. P n \ P n" + by (blast intro: someI2) lemma (in idom_char_0) order: - "(([-a, 1] %^ n) divides p & + "(([-a, 1] %^ n) divides p \ ~(([-a, 1] %^ (Suc n)) divides p)) = - ((n = order a p) & ~(poly p = poly []))" -apply (unfold order_def) -apply (rule iffI) -apply (blast dest: poly_divides_zero intro!: some1_equality [symmetric] poly_order) -apply (blast intro!: poly_order [THEN [2] some1_equalityD]) -done + ((n = order a p) \ ~(poly p = poly []))" + apply (unfold order_def) + apply (rule iffI) + apply (blast dest: poly_divides_zero intro!: some1_equality [symmetric] poly_order) + apply (blast intro!: poly_order [THEN [2] some1_equalityD]) + done -lemma (in idom_char_0) order2: "[| poly p \ poly [] |] - ==> ([-a, 1] %^ (order a p)) divides p & - ~(([-a, 1] %^ (Suc(order a p))) divides p)" -by (simp add: order del: pexp_Suc) +lemma (in idom_char_0) order2: + "poly p \ poly [] \ + ([-a, 1] %^ (order a p)) divides p \ \ (([-a, 1] %^ (Suc (order a p))) divides p)" + by (simp add: order del: pexp_Suc) -lemma (in idom_char_0) order_unique: "[| poly p \ poly []; ([-a, 1] %^ n) divides p; - ~(([-a, 1] %^ (Suc n)) divides p) - |] ==> (n = order a p)" -by (insert order [of a n p], auto) +lemma (in idom_char_0) order_unique: + "poly p \ poly [] \ ([-a, 1] %^ n) divides p \ ~(([-a, 1] %^ (Suc n)) divides p) \ + n = order a p" + using order [of a n p] by auto -lemma (in idom_char_0) order_unique_lemma: "(poly p \ poly [] & ([-a, 1] %^ n) divides p & - ~(([-a, 1] %^ (Suc n)) divides p)) - ==> (n = order a p)" -by (blast intro: order_unique) +lemma (in idom_char_0) order_unique_lemma: + "poly p \ poly [] \ ([-a, 1] %^ n) divides p \ ~(([-a, 1] %^ (Suc n)) divides p) \ + n = order a p" + by (blast intro: order_unique) -lemma (in ring_1) order_poly: "poly p = poly q ==> order a p = order a q" +lemma (in ring_1) order_poly: "poly p = poly q \ order a p = order a q" by (auto simp add: fun_eq divides_def poly_mult order_def) lemma (in semiring_1) pexp_one[simp]: "p %^ (Suc 0) = p" by (induct "p") auto lemma (in comm_ring_1) lemma_order_root: - " 0 < n & [- a, 1] %^ n divides p & ~ [- a, 1] %^ (Suc n) divides p - \ poly p a = 0" -apply (induct n arbitrary: a p, blast) -apply (auto simp add: divides_def poly_mult simp del: pmult_Cons) -done + "0 < n \ [- a, 1] %^ n divides p \ ~ [- a, 1] %^ (Suc n) divides p \ poly p a = 0" + by (induct n arbitrary: a p) (auto simp add: divides_def poly_mult simp del: pmult_Cons) -lemma (in idom_char_0) order_root: "(poly p a = 0) = ((poly p = poly []) | order a p \ 0)" -proof- - let ?poly = poly - show ?thesis -apply (case_tac "?poly p = ?poly []", auto) -apply (simp add: poly_linear_divides del: pmult_Cons, safe) -apply (drule_tac [!] a = a in order2) -apply (rule ccontr) -apply (simp add: divides_def poly_mult fun_eq del: pmult_Cons, blast) -using neq0_conv -apply (blast intro: lemma_order_root) -done -qed +lemma (in idom_char_0) order_root: + "poly p a = 0 \ poly p = poly [] \ order a p \ 0" + apply (cases "poly p = poly []") + apply auto + apply (simp add: poly_linear_divides del: pmult_Cons, safe) + apply (drule_tac [!] a = a in order2) + apply (rule ccontr) + apply (simp add: divides_def poly_mult fun_eq del: pmult_Cons, blast) + using neq0_conv + apply (blast intro: lemma_order_root) + done -lemma (in idom_char_0) order_divides: "(([-a, 1] %^ n) divides p) = ((poly p = poly []) | n \ order a p)" -proof- - let ?poly = poly - show ?thesis -apply (case_tac "?poly p = ?poly []", auto) -apply (simp add: divides_def fun_eq poly_mult) -apply (rule_tac x = "[]" in exI) -apply (auto dest!: order2 [where a=a] - intro: poly_exp_divides simp del: pexp_Suc) -done -qed +lemma (in idom_char_0) order_divides: + "([-a, 1] %^ n) divides p \ poly p = poly [] \ n \ order a p" + apply (cases "poly p = poly []") + apply auto + apply (simp add: divides_def fun_eq poly_mult) + apply (rule_tac x = "[]" in exI) + apply (auto dest!: order2 [where a=a] intro: poly_exp_divides simp del: pexp_Suc) + done lemma (in idom_char_0) order_decomp: - "poly p \ poly [] - ==> \q. (poly p = poly (([-a, 1] %^ (order a p)) *** q)) & - ~([-a, 1] divides q)" -apply (unfold divides_def) -apply (drule order2 [where a = a]) -apply (simp add: divides_def del: pexp_Suc pmult_Cons, safe) -apply (rule_tac x = q in exI, safe) -apply (drule_tac x = qa in spec) -apply (auto simp add: poly_mult fun_eq poly_exp mult_ac simp del: pmult_Cons) -done + "poly p \ poly [] \ \q. poly p = poly (([-a, 1] %^ (order a p)) *** q) \ ~([-a, 1] divides q)" + apply (unfold divides_def) + apply (drule order2 [where a = a]) + apply (simp add: divides_def del: pexp_Suc pmult_Cons, safe) + apply (rule_tac x = q in exI, safe) + apply (drule_tac x = qa in spec) + apply (auto simp add: poly_mult fun_eq poly_exp mult_ac simp del: pmult_Cons) + done text{*Important composition properties of orders.*} -lemma order_mult: "poly (p *** q) \ poly [] - ==> order a (p *** q) = order a p + order (a::'a::{idom_char_0}) q" -apply (cut_tac a = a and p = "p *** q" and n = "order a p + order a q" in order) -apply (auto simp add: poly_entire simp del: pmult_Cons) -apply (drule_tac a = a in order2)+ -apply safe -apply (simp add: divides_def fun_eq poly_exp_add poly_mult del: pmult_Cons, safe) -apply (rule_tac x = "qa *** qaa" in exI) -apply (simp add: poly_mult mult_ac del: pmult_Cons) -apply (drule_tac a = a in order_decomp)+ -apply safe -apply (subgoal_tac "[-a,1] divides (qa *** qaa) ") -apply (simp add: poly_primes del: pmult_Cons) -apply (auto simp add: divides_def simp del: pmult_Cons) -apply (rule_tac x = qb in exI) -apply (subgoal_tac "poly ([-a, 1] %^ (order a p) *** (qa *** qaa)) = poly ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))") -apply (drule poly_mult_left_cancel [THEN iffD1], force) -apply (subgoal_tac "poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** (qa *** qaa))) = poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))) ") -apply (drule poly_mult_left_cancel [THEN iffD1], force) -apply (simp add: fun_eq poly_exp_add poly_mult mult_ac del: pmult_Cons) -done +lemma order_mult: + "poly (p *** q) \ poly [] \ + order a (p *** q) = order a p + order (a::'a::{idom_char_0}) q" + apply (cut_tac a = a and p = "p *** q" and n = "order a p + order a q" in order) + apply (auto simp add: poly_entire simp del: pmult_Cons) + apply (drule_tac a = a in order2)+ + apply safe + apply (simp add: divides_def fun_eq poly_exp_add poly_mult del: pmult_Cons, safe) + apply (rule_tac x = "qa *** qaa" in exI) + apply (simp add: poly_mult mult_ac del: pmult_Cons) + apply (drule_tac a = a in order_decomp)+ + apply safe + apply (subgoal_tac "[-a,1] divides (qa *** qaa) ") + apply (simp add: poly_primes del: pmult_Cons) + apply (auto simp add: divides_def simp del: pmult_Cons) + apply (rule_tac x = qb in exI) + apply (subgoal_tac "poly ([-a, 1] %^ (order a p) *** (qa *** qaa)) = poly ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))") + apply (drule poly_mult_left_cancel [THEN iffD1], force) + apply (subgoal_tac "poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** (qa *** qaa))) = poly ([-a, 1] %^ (order a q) *** ([-a, 1] %^ (order a p) *** ([-a, 1] *** qb))) ") + apply (drule poly_mult_left_cancel [THEN iffD1], force) + apply (simp add: fun_eq poly_exp_add poly_mult mult_ac del: pmult_Cons) + done lemma (in idom_char_0) order_mult: - assumes pq0: "poly (p *** q) \ poly []" + assumes "poly (p *** q) \ poly []" shows "order a (p *** q) = order a p + order a q" -proof- - let ?order = order - let ?divides = "op divides" - let ?poly = poly -from pq0 -show ?thesis -apply (cut_tac a = a and p = "pmult p q" and n = "?order a p + ?order a q" in order) -apply (auto simp add: poly_entire simp del: pmult_Cons) -apply (drule_tac a = a in order2)+ -apply safe -apply (simp add: divides_def fun_eq poly_exp_add poly_mult del: pmult_Cons, safe) -apply (rule_tac x = "pmult qa qaa" in exI) -apply (simp add: poly_mult mult_ac del: pmult_Cons) -apply (drule_tac a = a in order_decomp)+ -apply safe -apply (subgoal_tac "?divides [uminus a,one ] (pmult qa qaa) ") -apply (simp add: poly_primes del: pmult_Cons) -apply (auto simp add: divides_def simp del: pmult_Cons) -apply (rule_tac x = qb in exI) -apply (subgoal_tac "?poly (pmult (pexp [uminus a, one] (?order a p)) (pmult qa qaa)) = ?poly (pmult (pexp [uminus a, one] (?order a p)) (pmult [uminus a, one] qb))") -apply (drule poly_mult_left_cancel [THEN iffD1], force) -apply (subgoal_tac "?poly (pmult (pexp [uminus a, one ] (order a q)) (pmult (pexp [uminus a, one] (order a p)) (pmult qa qaa))) = ?poly (pmult (pexp [uminus a, one] (order a q)) (pmult (pexp [uminus a, one] (order a p)) (pmult [uminus a, one] qb))) ") -apply (drule poly_mult_left_cancel [THEN iffD1], force) -apply (simp add: fun_eq poly_exp_add poly_mult mult_ac del: pmult_Cons) -done -qed + using assms + apply (cut_tac a = a and p = "pmult p q" and n = "order a p + order a q" in order) + apply (auto simp add: poly_entire simp del: pmult_Cons) + apply (drule_tac a = a in order2)+ + apply safe + apply (simp add: divides_def fun_eq poly_exp_add poly_mult del: pmult_Cons, safe) + apply (rule_tac x = "pmult qa qaa" in exI) + apply (simp add: poly_mult mult_ac del: pmult_Cons) + apply (drule_tac a = a in order_decomp)+ + apply safe + apply (subgoal_tac "[uminus a, one] divides pmult qa qaa") + apply (simp add: poly_primes del: pmult_Cons) + apply (auto simp add: divides_def simp del: pmult_Cons) + apply (rule_tac x = qb in exI) + apply (subgoal_tac "poly (pmult (pexp [uminus a, one] (order a p)) (pmult qa qaa)) = + poly (pmult (pexp [uminus a, one] (?order a p)) (pmult [uminus a, one] qb))") + apply (drule poly_mult_left_cancel [THEN iffD1], force) + apply (subgoal_tac "poly (pmult (pexp [uminus a, one] (order a q)) + (pmult (pexp [uminus a, one] (order a p)) (pmult qa qaa))) = + poly (pmult (pexp [uminus a, one] (order a q)) + (pmult (pexp [uminus a, one] (order a p)) (pmult [uminus a, one] qb)))") + apply (drule poly_mult_left_cancel [THEN iffD1], force) + apply (simp add: fun_eq poly_exp_add poly_mult mult_ac del: pmult_Cons) + done -lemma (in idom_char_0) order_root2: "poly p \ poly [] ==> (poly p a = 0) = (order a p \ 0)" -by (rule order_root [THEN ssubst], auto) +lemma (in idom_char_0) order_root2: "poly p \ poly [] \ poly p a = 0 \ order a p \ 0" + by (rule order_root [THEN ssubst]) auto lemma (in semiring_1) pmult_one[simp]: "[1] *** p = p" by auto lemma (in semiring_0) poly_Nil_zero: "poly [] = poly [0]" -by (simp add: fun_eq) + by (simp add: fun_eq) lemma (in idom_char_0) rsquarefree_decomp: - "[| rsquarefree p; poly p a = 0 |] - ==> \q. (poly p = poly ([-a, 1] *** q)) & poly q a \ 0" -apply (simp add: rsquarefree_def, safe) -apply (frule_tac a = a in order_decomp) -apply (drule_tac x = a in spec) -apply (drule_tac a = a in order_root2 [symmetric]) -apply (auto simp del: pmult_Cons) -apply (rule_tac x = q in exI, safe) -apply (simp add: poly_mult fun_eq) -apply (drule_tac p1 = q in poly_linear_divides [THEN iffD1]) -apply (simp add: divides_def del: pmult_Cons, safe) -apply (drule_tac x = "[]" in spec) -apply (auto simp add: fun_eq) -done + "rsquarefree p \ poly p a = 0 \ + \q. poly p = poly ([-a, 1] *** q) \ poly q a \ 0" + apply (simp add: rsquarefree_def, safe) + apply (frule_tac a = a in order_decomp) + apply (drule_tac x = a in spec) + apply (drule_tac a = a in order_root2 [symmetric]) + apply (auto simp del: pmult_Cons) + apply (rule_tac x = q in exI, safe) + apply (simp add: poly_mult fun_eq) + apply (drule_tac p1 = q in poly_linear_divides [THEN iffD1]) + apply (simp add: divides_def del: pmult_Cons, safe) + apply (drule_tac x = "[]" in spec) + apply (auto simp add: fun_eq) + done text{*Normalization of a polynomial.*} lemma (in semiring_0) poly_normalize[simp]: "poly (pnormalize p) = poly p" -apply (induct "p") -apply (auto simp add: fun_eq) -done + by (induct p) (auto simp add: fun_eq) text{*The degree of a polynomial.*} -lemma (in semiring_0) lemma_degree_zero: - "list_all (%c. c = 0) p \ pnormalize p = []" -by (induct "p", auto) +lemma (in semiring_0) lemma_degree_zero: "list_all (%c. c = 0) p \ pnormalize p = []" + by (induct p) auto lemma (in idom_char_0) degree_zero: - assumes pN: "poly p = poly []" shows"degree p = 0" -proof- - let ?pn = pnormalize - from pN - show ?thesis - apply (simp add: degree_def) - apply (case_tac "?pn p = []") - apply (auto simp add: poly_zero lemma_degree_zero ) - done -qed + assumes "poly p = poly []" + shows "degree p = 0" + using assms + by (cases "pnormalize p = []") (auto simp add: degree_def poly_zero lemma_degree_zero) lemma (in semiring_0) pnormalize_sing: "(pnormalize [x] = [x]) \ x \ 0" -by simp -lemma (in semiring_0) pnormalize_pair: "y \ 0 \ (pnormalize [x, y] = [x, y])" by simp + by simp + +lemma (in semiring_0) pnormalize_pair: "y \ 0 \ (pnormalize [x, y] = [x, y])" + by simp + lemma (in semiring_0) pnormal_cons: "pnormal p \ pnormal (c#p)" unfolding pnormal_def by simp + lemma (in semiring_0) pnormal_tail: "p\[] \ pnormal (c#p) \ pnormal p" unfolding pnormal_def by(auto split: split_if_asm) -lemma (in semiring_0) pnormal_last_nonzero: "pnormal p ==> last p \ 0" -by(induct p) (simp_all add: pnormal_def split: split_if_asm) +lemma (in semiring_0) pnormal_last_nonzero: "pnormal p \ last p \ 0" + by (induct p) (simp_all add: pnormal_def split: split_if_asm) lemma (in semiring_0) pnormal_length: "pnormal p \ 0 < length p" unfolding pnormal_def length_greater_0_conv by blast -lemma (in semiring_0) pnormal_last_length: "\0 < length p ; last p \ 0\ \ pnormal p" -by (induct p) (auto simp: pnormal_def split: split_if_asm) +lemma (in semiring_0) pnormal_last_length: "0 < length p \ last p \ 0 \ pnormal p" + by (induct p) (auto simp: pnormal_def split: split_if_asm) -lemma (in semiring_0) pnormal_id: "pnormal p \ (0 < length p \ last p \ 0)" +lemma (in semiring_0) pnormal_id: "pnormal p \ 0 < length p \ last p \ 0" using pnormal_last_length pnormal_length pnormal_last_nonzero by blast -lemma (in idom_char_0) poly_Cons_eq: "poly (c#cs) = poly (d#ds) \ c=d \ poly cs = poly ds" (is "?lhs \ ?rhs") +lemma (in idom_char_0) poly_Cons_eq: + "poly (c # cs) = poly (d # ds) \ c = d \ poly cs = poly ds" + (is "?lhs \ ?rhs") proof assume eq: ?lhs hence "\x. poly ((c#cs) +++ -- (d#ds)) x = 0" @@ -851,18 +856,20 @@ unfolding poly_zero by (simp add: poly_minus_def algebra_simps) hence "c = d \ (\x. poly (cs +++ -- ds) x = 0)" unfolding poly_zero[symmetric] by simp - thus ?rhs by (simp add: poly_minus poly_add algebra_simps fun_eq_iff) + then show ?rhs by (simp add: poly_minus poly_add algebra_simps fun_eq_iff) next - assume ?rhs then show ?lhs by(simp add:fun_eq_iff) + assume ?rhs + then show ?lhs by(simp add:fun_eq_iff) qed lemma (in idom_char_0) pnormalize_unique: "poly p = poly q \ pnormalize p = pnormalize q" -proof(induct q arbitrary: p) - case Nil thus ?case by (simp only: poly_zero lemma_degree_zero) simp +proof (induct q arbitrary: p) + case Nil + thus ?case by (simp only: poly_zero lemma_degree_zero) simp next case (Cons c cs p) thus ?case - proof(induct p) + proof (induct p) case Nil hence "poly [] = poly (c#cs)" by blast then have "poly (c#cs) = poly [] " by simp @@ -880,44 +887,51 @@ qed qed -lemma (in idom_char_0) degree_unique: assumes pq: "poly p = poly q" +lemma (in idom_char_0) degree_unique: + assumes pq: "poly p = poly q" shows "degree p = degree q" -using pnormalize_unique[OF pq] unfolding degree_def by simp + using pnormalize_unique[OF pq] unfolding degree_def by simp -lemma (in semiring_0) pnormalize_length: "length (pnormalize p) \ length p" by (induct p, auto) +lemma (in semiring_0) pnormalize_length: + "length (pnormalize p) \ length p" by (induct p) auto lemma (in semiring_0) last_linear_mul_lemma: - "last ((a %* p) +++ (x#(b %* p))) = (if p=[] then x else b*last p)" + "last ((a %* p) +++ (x#(b %* p))) = (if p = [] then x else b * last p)" + apply (induct p arbitrary: a x b) + apply auto + apply (subgoal_tac "padd (cmult aa p) (times b a # cmult b p) \ []") + apply simp + apply (induct_tac p) + apply auto + done -apply (induct p arbitrary: a x b, auto) -apply (subgoal_tac "padd (cmult aa p) (times b a # cmult b p) \ []", simp) -apply (induct_tac p, auto) -done - -lemma (in semiring_1) last_linear_mul: assumes p:"p\[]" shows "last ([a,1] *** p) = last p" -proof- - from p obtain c cs where cs: "p = c#cs" by (cases p, auto) - from cs have eq:"[a,1] *** p = (a %* (c#cs)) +++ (0#(1 %* (c#cs)))" +lemma (in semiring_1) last_linear_mul: + assumes p: "p \ []" + shows "last ([a,1] *** p) = last p" +proof - + from p obtain c cs where cs: "p = c#cs" by (cases p) auto + from cs have eq: "[a,1] *** p = (a %* (c#cs)) +++ (0#(1 %* (c#cs)))" by (simp add: poly_cmult_distr) show ?thesis using cs unfolding eq last_linear_mul_lemma by simp qed lemma (in semiring_0) pnormalize_eq: "last p \ 0 \ pnormalize p = p" -by (induct p) (auto split: split_if_asm) + by (induct p) (auto split: split_if_asm) lemma (in semiring_0) last_pnormalize: "pnormalize p \ [] \ last (pnormalize p) \ 0" - by (induct p, auto) + by (induct p) auto lemma (in semiring_0) pnormal_degree: "last p \ 0 \ degree p = length p - 1" using pnormalize_eq[of p] unfolding degree_def by simp -lemma (in semiring_0) poly_Nil_ext: "poly [] = (\x. 0)" by (rule ext) simp +lemma (in semiring_0) poly_Nil_ext: "poly [] = (\x. 0)" + by (rule ext) simp lemma (in idom_char_0) linear_mul_degree: assumes p: "poly p \ poly []" shows "degree ([a,1] *** p) = degree p + 1" -proof- +proof - from p have pnz: "pnormalize p \ []" unfolding poly_zero lemma_degree_zero . @@ -926,7 +940,6 @@ from last_pnormalize[OF pnz] last_linear_mul[OF pnz, of a] pnormal_degree[OF l0] pnormal_degree[OF last_pnormalize[OF pnz]] pnz - have th: "degree ([a,1] *** pnormalize p) = degree (pnormalize p) + 1" by simp @@ -938,64 +951,81 @@ lemma (in idom_char_0) linear_pow_mul_degree: "degree([a,1] %^n *** p) = (if poly p = poly [] then 0 else degree p + n)" -proof(induct n arbitrary: a p) +proof (induct n arbitrary: a p) case (0 a p) - {assume p: "poly p = poly []" - hence ?case using degree_unique[OF p] by (simp add: degree_def)} - moreover - {assume p: "poly p \ poly []" hence ?case by (auto simp add: poly_Nil_ext) } - ultimately show ?case by blast + show ?case + proof (cases "poly p = poly []") + case True + then show ?thesis + using degree_unique[OF True] by (simp add: degree_def) + next + case False + then show ?thesis by (auto simp add: poly_Nil_ext) + qed next case (Suc n a p) have eq: "poly ([a,1] %^(Suc n) *** p) = poly ([a,1] %^ n *** ([a,1] *** p))" - apply (rule ext, simp add: poly_mult poly_add poly_cmult) - by (simp add: mult_ac add_ac distrib_left) + apply (rule ext) + apply (simp add: poly_mult poly_add poly_cmult) + apply (simp add: mult_ac add_ac distrib_left) + done note deq = degree_unique[OF eq] - {assume p: "poly p = poly []" + show ?case + proof (cases "poly p = poly []") + case True with eq have eq': "poly ([a,1] %^(Suc n) *** p) = poly []" - by - (rule ext,simp add: poly_mult poly_cmult poly_add) - from degree_unique[OF eq'] p have ?case by (simp add: degree_def)} - moreover - {assume p: "poly p \ poly []" - from p have ap: "poly ([a,1] *** p) \ poly []" + apply - + apply (rule ext) + apply (simp add: poly_mult poly_cmult poly_add) + done + from degree_unique[OF eq'] True show ?thesis + by (simp add: degree_def) + next + case False + then have ap: "poly ([a,1] *** p) \ poly []" using poly_mult_not_eq_poly_Nil unfolding poly_entire by auto have eq: "poly ([a,1] %^(Suc n) *** p) = poly ([a,1]%^n *** ([a,1] *** p))" - by (rule ext, simp add: poly_mult poly_add poly_exp poly_cmult algebra_simps) - from ap have ap': "(poly ([a,1] *** p) = poly []) = False" by blast - have th0: "degree ([a,1]%^n *** ([a,1] *** p)) = degree ([a,1] *** p) + n" - apply (simp only: Suc.hyps[of a "pmult [a,one] p"] ap') - by simp - - from degree_unique[OF eq] ap p th0 linear_mul_degree[OF p, of a] - have ?case by (auto simp del: poly.simps)} - ultimately show ?case by blast + by (rule ext, simp add: poly_mult poly_add poly_exp poly_cmult algebra_simps) + from ap have ap': "(poly ([a,1] *** p) = poly []) = False" + by blast + have th0: "degree ([a,1]%^n *** ([a,1] *** p)) = degree ([a,1] *** p) + n" + apply (simp only: Suc.hyps[of a "pmult [a,one] p"] ap') + apply simp + done + from degree_unique[OF eq] ap False th0 linear_mul_degree[OF False, of a] + show ?thesis by (auto simp del: poly.simps) + qed qed lemma (in idom_char_0) order_degree: assumes p0: "poly p \ poly []" shows "order a p \ degree p" -proof- +proof - from order2[OF p0, unfolded divides_def] obtain q where q: "poly p = poly ([- a, 1]%^ (order a p) *** q)" by blast - {assume "poly q = poly []" - with q p0 have False by (simp add: poly_mult poly_entire)} - with degree_unique[OF q, unfolded linear_pow_mul_degree] - show ?thesis by auto + { + assume "poly q = poly []" + with q p0 have False by (simp add: poly_mult poly_entire) + } + with degree_unique[OF q, unfolded linear_pow_mul_degree] show ?thesis + by auto qed text{*Tidier versions of finiteness of roots.*} -lemma (in idom_char_0) poly_roots_finite_set: "poly p \ poly [] ==> finite {x. poly p x = 0}" -unfolding poly_roots_finite . +lemma (in idom_char_0) poly_roots_finite_set: + "poly p \ poly [] \ finite {x. poly p x = 0}" + unfolding poly_roots_finite . text{*bound for polynomial.*} -lemma poly_mono: "abs(x) \ k ==> abs(poly p (x::'a::{linordered_idom})) \ poly (map abs p) k" -apply (induct "p", auto) -apply (rule_tac y = "abs a + abs (x * poly p x)" in order_trans) -apply (rule abs_triangle_ineq) -apply (auto intro!: mult_mono simp add: abs_mult) -done +lemma poly_mono: "abs(x) \ k \ abs(poly p (x::'a::{linordered_idom})) \ poly (map abs p) k" + apply (induct p) + apply auto + apply (rule_tac y = "abs a + abs (x * poly p x)" in order_trans) + apply (rule abs_triangle_ineq) + apply (auto intro!: mult_mono simp add: abs_mult) + done lemma (in semiring_0) poly_Sing: "poly [c] x = c" by simp