diff -r a7d1a3fdc30d -r 63f5f4c265dd src/HOL/Algebra/UnivPoly.thy --- a/src/HOL/Algebra/UnivPoly.thy Sat Jul 31 20:54:23 2004 +0200 +++ b/src/HOL/Algebra/UnivPoly.thy Mon Aug 02 09:44:46 2004 +0200 @@ -24,6 +24,10 @@ subsection {* The Constructor for Univariate Polynomials *} +text {* + Functions with finite support. +*} + locale bound = fixes z :: 'a and n :: nat @@ -47,9 +51,9 @@ coeff :: "['p, nat] => 'a" constdefs (structure R) - up :: "_ => (nat => 'a) set" + up :: "('a, 'm) ring_scheme => (nat => 'a) set" "up R == {f. f \ UNIV -> carrier R & (EX n. bound \ n f)}" - UP :: "_ => ('a, nat => 'a) up_ring" + UP :: "('a, 'm) ring_scheme => ('a, nat => 'a) up_ring" "UP R == (| carrier = up R, mult = (%p:up R. %q:up R. %n. \i \ {..n}. p i \ q (n-i)), @@ -167,8 +171,8 @@ locale UP_domain = UP_cring + "domain" R text {* - Temporarily declare @{text UP.P_def} as simp rule. -*} (* TODO: use antiquotation once text (in locale) is supported. *) + Temporarily declare @{thm [locale=UP] P_def} as simp rule. +*} declare (in UP) P_def [simp] @@ -183,26 +187,26 @@ qed lemma (in UP_cring) coeff_zero [simp]: - "coeff P \\<^sub>2 n = \" + "coeff P \\<^bsub>P\<^esub> n = \" by (auto simp add: UP_def) lemma (in UP_cring) coeff_one [simp]: - "coeff P \\<^sub>2 n = (if n=0 then \ else \)" + "coeff P \\<^bsub>P\<^esub> n = (if n=0 then \ else \)" using up_one_closed by (simp add: UP_def) lemma (in UP_cring) coeff_smult [simp]: "[| a \ carrier R; p \ carrier P |] ==> - coeff P (a \\<^sub>2 p) n = a \ coeff P p n" + coeff P (a \\<^bsub>P\<^esub> p) n = a \ coeff P p n" by (simp add: UP_def up_smult_closed) lemma (in UP_cring) coeff_add [simp]: "[| p \ carrier P; q \ carrier P |] ==> - coeff P (p \\<^sub>2 q) n = coeff P p n \ coeff P q n" + coeff P (p \\<^bsub>P\<^esub> q) n = coeff P p n \ coeff P q n" by (simp add: UP_def up_add_closed) lemma (in UP_cring) coeff_mult [simp]: "[| p \ carrier P; q \ carrier P |] ==> - coeff P (p \\<^sub>2 q) n = (\i \ {..n}. coeff P p i \ coeff P q (n-i))" + coeff P (p \\<^bsub>P\<^esub> q) n = (\i \ {..n}. coeff P p i \ coeff P q (n-i))" by (simp add: UP_def up_mult_closed) lemma (in UP) up_eqI: @@ -219,19 +223,19 @@ text {* Operations are closed over @{term P}. *} lemma (in UP_cring) UP_mult_closed [simp]: - "[| p \ carrier P; q \ carrier P |] ==> p \\<^sub>2 q \ carrier P" + "[| p \ carrier P; q \ carrier P |] ==> p \\<^bsub>P\<^esub> q \ carrier P" by (simp add: UP_def up_mult_closed) lemma (in UP_cring) UP_one_closed [simp]: - "\\<^sub>2 \ carrier P" + "\\<^bsub>P\<^esub> \ carrier P" by (simp add: UP_def up_one_closed) lemma (in UP_cring) UP_zero_closed [intro, simp]: - "\\<^sub>2 \ carrier P" + "\\<^bsub>P\<^esub> \ carrier P" by (auto simp add: UP_def) lemma (in UP_cring) UP_a_closed [intro, simp]: - "[| p \ carrier P; q \ carrier P |] ==> p \\<^sub>2 q \ carrier P" + "[| p \ carrier P; q \ carrier P |] ==> p \\<^bsub>P\<^esub> q \ carrier P" by (simp add: UP_def up_add_closed) lemma (in UP_cring) monom_closed [simp]: @@ -239,7 +243,7 @@ by (auto simp add: UP_def up_def Pi_def) lemma (in UP_cring) UP_smult_closed [simp]: - "[| a \ carrier R; p \ carrier P |] ==> a \\<^sub>2 p \ carrier P" + "[| a \ carrier R; p \ carrier P |] ==> a \\<^bsub>P\<^esub> p \ carrier P" by (simp add: UP_def up_smult_closed) lemma (in UP) coeff_closed [simp]: @@ -252,17 +256,17 @@ lemma (in UP_cring) UP_a_assoc: assumes R: "p \ carrier P" "q \ carrier P" "r \ carrier P" - shows "(p \\<^sub>2 q) \\<^sub>2 r = p \\<^sub>2 (q \\<^sub>2 r)" + shows "(p \\<^bsub>P\<^esub> q) \\<^bsub>P\<^esub> r = p \\<^bsub>P\<^esub> (q \\<^bsub>P\<^esub> r)" by (rule up_eqI, simp add: a_assoc R, simp_all add: R) lemma (in UP_cring) UP_l_zero [simp]: assumes R: "p \ carrier P" - shows "\\<^sub>2 \\<^sub>2 p = p" + shows "\\<^bsub>P\<^esub> \\<^bsub>P\<^esub> p = p" by (rule up_eqI, simp_all add: R) lemma (in UP_cring) UP_l_neg_ex: assumes R: "p \ carrier P" - shows "EX q : carrier P. q \\<^sub>2 p = \\<^sub>2" + shows "EX q : carrier P. q \\<^bsub>P\<^esub> p = \\<^bsub>P\<^esub>" proof - let ?q = "%i. \ (p i)" from R have closed: "?q \ carrier P" @@ -271,14 +275,14 @@ by (simp add: UP_def P_def up_a_inv_closed) show ?thesis proof - show "?q \\<^sub>2 p = \\<^sub>2" + show "?q \\<^bsub>P\<^esub> p = \\<^bsub>P\<^esub>" by (auto intro!: up_eqI simp add: R closed coeff R.l_neg) qed (rule closed) qed lemma (in UP_cring) UP_a_comm: assumes R: "p \ carrier P" "q \ carrier P" - shows "p \\<^sub>2 q = q \\<^sub>2 p" + shows "p \\<^bsub>P\<^esub> q = q \\<^bsub>P\<^esub> p" by (rule up_eqI, simp add: a_comm R, simp_all add: R) ML_setup {* @@ -287,7 +291,7 @@ lemma (in UP_cring) UP_m_assoc: assumes R: "p \ carrier P" "q \ carrier P" "r \ carrier P" - shows "(p \\<^sub>2 q) \\<^sub>2 r = p \\<^sub>2 (q \\<^sub>2 r)" + shows "(p \\<^bsub>P\<^esub> q) \\<^bsub>P\<^esub> r = p \\<^bsub>P\<^esub> (q \\<^bsub>P\<^esub> r)" proof (rule up_eqI) fix n { @@ -310,7 +314,7 @@ (simp cong: finsum_cong add: Pi_def a_ac finsum_ldistr m_assoc) qed } - with R show "coeff P ((p \\<^sub>2 q) \\<^sub>2 r) n = coeff P (p \\<^sub>2 (q \\<^sub>2 r)) n" + with R show "coeff P ((p \\<^bsub>P\<^esub> q) \\<^bsub>P\<^esub> r) n = coeff P (p \\<^bsub>P\<^esub> (q \\<^bsub>P\<^esub> r)) n" by (simp add: Pi_def) qed (simp_all add: R) @@ -320,10 +324,10 @@ lemma (in UP_cring) UP_l_one [simp]: assumes R: "p \ carrier P" - shows "\\<^sub>2 \\<^sub>2 p = p" + shows "\\<^bsub>P\<^esub> \\<^bsub>P\<^esub> p = p" proof (rule up_eqI) fix n - show "coeff P (\\<^sub>2 \\<^sub>2 p) n = coeff P p n" + show "coeff P (\\<^bsub>P\<^esub> \\<^bsub>P\<^esub> p) n = coeff P p n" proof (cases n) case 0 with R show ?thesis by simp next @@ -334,12 +338,12 @@ lemma (in UP_cring) UP_l_distr: assumes R: "p \ carrier P" "q \ carrier P" "r \ carrier P" - shows "(p \\<^sub>2 q) \\<^sub>2 r = (p \\<^sub>2 r) \\<^sub>2 (q \\<^sub>2 r)" + shows "(p \\<^bsub>P\<^esub> q) \\<^bsub>P\<^esub> r = (p \\<^bsub>P\<^esub> r) \\<^bsub>P\<^esub> (q \\<^bsub>P\<^esub> r)" by (rule up_eqI) (simp add: l_distr R Pi_def, simp_all add: R) lemma (in UP_cring) UP_m_comm: assumes R: "p \ carrier P" "q \ carrier P" - shows "p \\<^sub>2 q = q \\<^sub>2 p" + shows "p \\<^bsub>P\<^esub> q = q \\<^bsub>P\<^esub> p" proof (rule up_eqI) fix n { @@ -357,7 +361,7 @@ qed } note l = this - from R show "coeff P (p \\<^sub>2 q) n = coeff P (q \\<^sub>2 p) n" + from R show "coeff P (p \\<^bsub>P\<^esub> q) n = coeff P (q \\<^bsub>P\<^esub> p) n" apply (simp add: Pi_def) apply (subst l) apply (auto simp add: Pi_def) @@ -375,16 +379,16 @@ by (auto intro: ring.intro cring.axioms UP_cring) lemma (in UP_cring) UP_a_inv_closed [intro, simp]: - "p \ carrier P ==> \\<^sub>2 p \ carrier P" + "p \ carrier P ==> \\<^bsub>P\<^esub> p \ carrier P" by (rule abelian_group.a_inv_closed [OF ring.is_abelian_group [OF UP_ring]]) lemma (in UP_cring) coeff_a_inv [simp]: assumes R: "p \ carrier P" - shows "coeff P (\\<^sub>2 p) n = \ (coeff P p n)" + shows "coeff P (\\<^bsub>P\<^esub> p) n = \ (coeff P p n)" proof - from R coeff_closed UP_a_inv_closed have - "coeff P (\\<^sub>2 p) n = \ coeff P p n \ (coeff P p n \ coeff P (\\<^sub>2 p) n)" + "coeff P (\\<^bsub>P\<^esub> p) n = \ coeff P p n \ (coeff P p n \ coeff P (\\<^bsub>P\<^esub> p) n)" by algebra also from R have "... = \ (coeff P p n)" by (simp del: coeff_add add: coeff_add [THEN sym] @@ -396,6 +400,8 @@ Instantiation of lemmas from @{term cring}. *} +(* TODO: this should be automated with an instantiation command. *) + lemma (in UP_cring) UP_monoid: "monoid P" by (fast intro!: cring.is_comm_monoid comm_monoid.axioms monoid.intro @@ -545,34 +551,35 @@ lemma (in UP_cring) UP_smult_l_distr: "[| a \ carrier R; b \ carrier R; p \ carrier P |] ==> - (a \ b) \\<^sub>2 p = a \\<^sub>2 p \\<^sub>2 b \\<^sub>2 p" + (a \ b) \\<^bsub>P\<^esub> p = a \\<^bsub>P\<^esub> p \\<^bsub>P\<^esub> b \\<^bsub>P\<^esub> p" by (rule up_eqI) (simp_all add: R.l_distr) lemma (in UP_cring) UP_smult_r_distr: "[| a \ carrier R; p \ carrier P; q \ carrier P |] ==> - a \\<^sub>2 (p \\<^sub>2 q) = a \\<^sub>2 p \\<^sub>2 a \\<^sub>2 q" + a \\<^bsub>P\<^esub> (p \\<^bsub>P\<^esub> q) = a \\<^bsub>P\<^esub> p \\<^bsub>P\<^esub> a \\<^bsub>P\<^esub> q" by (rule up_eqI) (simp_all add: R.r_distr) lemma (in UP_cring) UP_smult_assoc1: "[| a \ carrier R; b \ carrier R; p \ carrier P |] ==> - (a \ b) \\<^sub>2 p = a \\<^sub>2 (b \\<^sub>2 p)" + (a \ b) \\<^bsub>P\<^esub> p = a \\<^bsub>P\<^esub> (b \\<^bsub>P\<^esub> p)" by (rule up_eqI) (simp_all add: R.m_assoc) lemma (in UP_cring) UP_smult_one [simp]: - "p \ carrier P ==> \ \\<^sub>2 p = p" + "p \ carrier P ==> \ \\<^bsub>P\<^esub> p = p" by (rule up_eqI) simp_all lemma (in UP_cring) UP_smult_assoc2: "[| a \ carrier R; p \ carrier P; q \ carrier P |] ==> - (a \\<^sub>2 p) \\<^sub>2 q = a \\<^sub>2 (p \\<^sub>2 q)" + (a \\<^bsub>P\<^esub> p) \\<^bsub>P\<^esub> q = a \\<^bsub>P\<^esub> (p \\<^bsub>P\<^esub> q)" by (rule up_eqI) (simp_all add: R.finsum_rdistr R.m_assoc Pi_def) text {* Instantiation of lemmas from @{term algebra}. *} +(* TODO: this should be automated with an instantiation command. *) + (* TODO: move to CRing.thy, really a fact missing from the locales package *) - lemma (in cring) cring: "cring R" by (fast intro: cring.intro prems) @@ -597,7 +604,7 @@ subsection {* Further lemmas involving monomials *} lemma (in UP_cring) monom_zero [simp]: - "monom P \ n = \\<^sub>2" + "monom P \ n = \\<^bsub>P\<^esub>" by (simp add: UP_def P_def) ML_setup {* @@ -606,10 +613,10 @@ lemma (in UP_cring) monom_mult_is_smult: assumes R: "a \ carrier R" "p \ carrier P" - shows "monom P a 0 \\<^sub>2 p = a \\<^sub>2 p" + shows "monom P a 0 \\<^bsub>P\<^esub> p = a \\<^bsub>P\<^esub> p" proof (rule up_eqI) fix n - have "coeff P (p \\<^sub>2 monom P a 0) n = coeff P (a \\<^sub>2 p) n" + have "coeff P (p \\<^bsub>P\<^esub> monom P a 0) n = coeff P (a \\<^bsub>P\<^esub> p) n" proof (cases n) case 0 with R show ?thesis by (simp add: R.m_comm) next @@ -617,7 +624,7 @@ by (simp cong: finsum_cong add: R.r_null Pi_def) (simp add: m_comm) qed - with R show "coeff P (monom P a 0 \\<^sub>2 p) n = coeff P (a \\<^sub>2 p) n" + with R show "coeff P (monom P a 0 \\<^bsub>P\<^esub> p) n = coeff P (a \\<^bsub>P\<^esub> p) n" by (simp add: UP_m_comm) qed (simp_all add: R) @@ -627,7 +634,7 @@ lemma (in UP_cring) monom_add [simp]: "[| a \ carrier R; b \ carrier R |] ==> - monom P (a \ b) n = monom P a n \\<^sub>2 monom P b n" + monom P (a \ b) n = monom P a n \\<^bsub>P\<^esub> monom P b n" by (rule up_eqI) simp_all ML_setup {* @@ -635,10 +642,10 @@ *} lemma (in UP_cring) monom_one_Suc: - "monom P \ (Suc n) = monom P \ n \\<^sub>2 monom P \ 1" + "monom P \ (Suc n) = monom P \ n \\<^bsub>P\<^esub> monom P \ 1" proof (rule up_eqI) fix k - show "coeff P (monom P \ (Suc n)) k = coeff P (monom P \ n \\<^sub>2 monom P \ 1) k" + show "coeff P (monom P \ (Suc n)) k = coeff P (monom P \ n \\<^bsub>P\<^esub> monom P \ 1) k" proof (cases "k = Suc n") case True show ?thesis proof - @@ -652,11 +659,12 @@ also have "... = (\i \ {..n}. coeff P (monom P \ n) i \ coeff P (monom P \ 1) (k - i))" by (simp only: ivl_disj_un_singleton) - also from True have "... = (\i \ {..n} \ {n<..k}. coeff P (monom P \ n) i \ + also from True + have "... = (\i \ {..n} \ {n<..k}. coeff P (monom P \ n) i \ coeff P (monom P \ 1) (k - i))" by (simp cong: finsum_cong add: finsum_Un_disjoint ivl_disj_int_one order_less_imp_not_eq Pi_def) - also from True have "... = coeff P (monom P \ n \\<^sub>2 monom P \ 1) k" + also from True have "... = coeff P (monom P \ n \\<^bsub>P\<^esub> monom P \ 1) k" by (simp add: ivl_disj_un_one) finally show ?thesis . qed @@ -668,7 +676,8 @@ from neq have "coeff P (monom P \ (Suc n)) k = \" by simp also have "... = (\i \ {..k}. ?s i)" proof - - have f1: "(\i \ {.." by (simp cong: finsum_cong add: Pi_def) + have f1: "(\i \ {.." + by (simp cong: finsum_cong add: Pi_def) from neq have f2: "(\i \ {n}. ?s i) = \" by (simp cong: finsum_cong add: Pi_def) arith have f3: "n < k ==> (\i \ {n<..k}. ?s i) = \" @@ -702,7 +711,7 @@ qed qed qed - also have "... = coeff P (monom P \ n \\<^sub>2 monom P \ 1) k" by simp + also have "... = coeff P (monom P \ n \\<^bsub>P\<^esub> monom P \ 1) k" by simp finally show ?thesis . qed qed (simp_all) @@ -712,15 +721,15 @@ *} lemma (in UP_cring) monom_mult_smult: - "[| a \ carrier R; b \ carrier R |] ==> monom P (a \ b) n = a \\<^sub>2 monom P b n" + "[| a \ carrier R; b \ carrier R |] ==> monom P (a \ b) n = a \\<^bsub>P\<^esub> monom P b n" by (rule up_eqI) simp_all lemma (in UP_cring) monom_one [simp]: - "monom P \ 0 = \\<^sub>2" + "monom P \ 0 = \\<^bsub>P\<^esub>" by (rule up_eqI) simp_all lemma (in UP_cring) monom_one_mult: - "monom P \ (n + m) = monom P \ n \\<^sub>2 monom P \ m" + "monom P \ (n + m) = monom P \ n \\<^bsub>P\<^esub> monom P \ m" proof (induct n) case 0 show ?case by simp next @@ -730,31 +739,31 @@ lemma (in UP_cring) monom_mult [simp]: assumes R: "a \ carrier R" "b \ carrier R" - shows "monom P (a \ b) (n + m) = monom P a n \\<^sub>2 monom P b m" + shows "monom P (a \ b) (n + m) = monom P a n \\<^bsub>P\<^esub> monom P b m" proof - from R have "monom P (a \ b) (n + m) = monom P (a \ b \ \) (n + m)" by simp - also from R have "... = a \ b \\<^sub>2 monom P \ (n + m)" + also from R have "... = a \ b \\<^bsub>P\<^esub> monom P \ (n + m)" by (simp add: monom_mult_smult del: r_one) - also have "... = a \ b \\<^sub>2 (monom P \ n \\<^sub>2 monom P \ m)" + also have "... = a \ b \\<^bsub>P\<^esub> (monom P \ n \\<^bsub>P\<^esub> monom P \ m)" by (simp only: monom_one_mult) - also from R have "... = a \\<^sub>2 (b \\<^sub>2 (monom P \ n \\<^sub>2 monom P \ m))" + also from R have "... = a \\<^bsub>P\<^esub> (b \\<^bsub>P\<^esub> (monom P \ n \\<^bsub>P\<^esub> monom P \ m))" by (simp add: UP_smult_assoc1) - also from R have "... = a \\<^sub>2 (b \\<^sub>2 (monom P \ m \\<^sub>2 monom P \ n))" + also from R have "... = a \\<^bsub>P\<^esub> (b \\<^bsub>P\<^esub> (monom P \ m \\<^bsub>P\<^esub> monom P \ n))" by (simp add: UP_m_comm) - also from R have "... = a \\<^sub>2 ((b \\<^sub>2 monom P \ m) \\<^sub>2 monom P \ n)" + also from R have "... = a \\<^bsub>P\<^esub> ((b \\<^bsub>P\<^esub> monom P \ m) \\<^bsub>P\<^esub> monom P \ n)" by (simp add: UP_smult_assoc2) - also from R have "... = a \\<^sub>2 (monom P \ n \\<^sub>2 (b \\<^sub>2 monom P \ m))" + also from R have "... = a \\<^bsub>P\<^esub> (monom P \ n \\<^bsub>P\<^esub> (b \\<^bsub>P\<^esub> monom P \ m))" by (simp add: UP_m_comm) - also from R have "... = (a \\<^sub>2 monom P \ n) \\<^sub>2 (b \\<^sub>2 monom P \ m)" + also from R have "... = (a \\<^bsub>P\<^esub> monom P \ n) \\<^bsub>P\<^esub> (b \\<^bsub>P\<^esub> monom P \ m)" by (simp add: UP_smult_assoc2) - also from R have "... = monom P (a \ \) n \\<^sub>2 monom P (b \ \) m" + also from R have "... = monom P (a \ \) n \\<^bsub>P\<^esub> monom P (b \ \) m" by (simp add: monom_mult_smult del: r_one) - also from R have "... = monom P a n \\<^sub>2 monom P b m" by simp + also from R have "... = monom P a n \\<^bsub>P\<^esub> monom P b m" by simp finally show ?thesis . qed lemma (in UP_cring) monom_a_inv [simp]: - "a \ carrier R ==> monom P (\ a) n = \\<^sub>2 monom P a n" + "a \ carrier R ==> monom P (\ a) n = \\<^bsub>P\<^esub> monom P a n" by (rule up_eqI) simp_all lemma (in UP_cring) monom_inj: @@ -769,12 +778,13 @@ subsection {* The degree function *} constdefs (structure R) - deg :: "[_, nat => 'a] => nat" + deg :: "[('a, 'm) ring_scheme, nat => 'a] => nat" "deg R p == LEAST n. bound \ n (coeff (UP R) p)" lemma (in UP_cring) deg_aboveI: "[| (!!m. n < m ==> coeff P p m = \); p \ carrier P |] ==> deg R p <= n" by (unfold deg_def P_def) (fast intro: Least_le) + (* lemma coeff_bound_ex: "EX n. bound n (coeff p)" proof - @@ -791,6 +801,7 @@ with prem show P . qed *) + lemma (in UP_cring) deg_aboveD: "[| deg R p < m; p \ carrier P |] ==> coeff P p m = \" proof - @@ -807,7 +818,7 @@ and R: "p \ carrier P" shows "n <= deg R p" -- {* Logically, this is a slightly stronger version of - @{thm [source] deg_aboveD} *} + @{thm [source] deg_aboveD} *} proof (cases "n=0") case True then show ?thesis by simp next @@ -824,7 +835,7 @@ proof - have minus: "!!(n::nat) m. n ~= 0 ==> (n - Suc 0 < m) = (n <= m)" by arith -(* TODO: why does proof not work with "1" *) +(* TODO: why does simplification below not work with "1" *) from deg have "deg R p - 1 < (LEAST n. bound \ n (coeff P p))" by (unfold deg_def P_def) arith then have "~ bound \ (deg R p - 1) (coeff P p)" by (rule not_less_Least) @@ -838,13 +849,13 @@ qed lemma (in UP_cring) lcoeff_nonzero_nonzero: - assumes deg: "deg R p = 0" and nonzero: "p ~= \\<^sub>2" and R: "p \ carrier P" + assumes deg: "deg R p = 0" and nonzero: "p ~= \\<^bsub>P\<^esub>" and R: "p \ carrier P" shows "coeff P p 0 ~= \" proof - have "EX m. coeff P p m ~= \" proof (rule classical) assume "~ ?thesis" - with R have "p = \\<^sub>2" by (auto intro: up_eqI) + with R have "p = \\<^bsub>P\<^esub>" by (auto intro: up_eqI) with nonzero show ?thesis by contradiction qed then obtain m where coeff: "coeff P p m ~= \" .. @@ -854,7 +865,7 @@ qed lemma (in UP_cring) lcoeff_nonzero: - assumes neq: "p ~= \\<^sub>2" and R: "p \ carrier P" + assumes neq: "p ~= \\<^bsub>P\<^esub>" and R: "p \ carrier P" shows "coeff P p (deg R p) ~= \" proof (cases "deg R p = 0") case True with neq R show ?thesis by (simp add: lcoeff_nonzero_nonzero) @@ -871,7 +882,7 @@ lemma (in UP_cring) deg_add [simp]: assumes R: "p \ carrier P" "q \ carrier P" - shows "deg R (p \\<^sub>2 q) <= max (deg R p) (deg R q)" + shows "deg R (p \\<^bsub>P\<^esub> q) <= max (deg R p) (deg R q)" proof (cases "deg R p <= deg R q") case True show ?thesis by (rule deg_aboveI) (simp_all add: True R deg_aboveD) @@ -897,51 +908,51 @@ qed lemma (in UP_cring) deg_zero [simp]: - "deg R \\<^sub>2 = 0" + "deg R \\<^bsub>P\<^esub> = 0" proof (rule le_anti_sym) - show "deg R \\<^sub>2 <= 0" by (rule deg_aboveI) simp_all + show "deg R \\<^bsub>P\<^esub> <= 0" by (rule deg_aboveI) simp_all next - show "0 <= deg R \\<^sub>2" by (rule deg_belowI) simp_all + show "0 <= deg R \\<^bsub>P\<^esub>" by (rule deg_belowI) simp_all qed lemma (in UP_cring) deg_one [simp]: - "deg R \\<^sub>2 = 0" + "deg R \\<^bsub>P\<^esub> = 0" proof (rule le_anti_sym) - show "deg R \\<^sub>2 <= 0" by (rule deg_aboveI) simp_all + show "deg R \\<^bsub>P\<^esub> <= 0" by (rule deg_aboveI) simp_all next - show "0 <= deg R \\<^sub>2" by (rule deg_belowI) simp_all + show "0 <= deg R \\<^bsub>P\<^esub>" by (rule deg_belowI) simp_all qed lemma (in UP_cring) deg_uminus [simp]: - assumes R: "p \ carrier P" shows "deg R (\\<^sub>2 p) = deg R p" + assumes R: "p \ carrier P" shows "deg R (\\<^bsub>P\<^esub> p) = deg R p" proof (rule le_anti_sym) - show "deg R (\\<^sub>2 p) <= deg R p" by (simp add: deg_aboveI deg_aboveD R) + show "deg R (\\<^bsub>P\<^esub> p) <= deg R p" by (simp add: deg_aboveI deg_aboveD R) next - show "deg R p <= deg R (\\<^sub>2 p)" + show "deg R p <= deg R (\\<^bsub>P\<^esub> p)" by (simp add: deg_belowI lcoeff_nonzero_deg inj_on_iff [OF a_inv_inj, of _ "\", simplified] R) qed lemma (in UP_domain) deg_smult_ring: "[| a \ carrier R; p \ carrier P |] ==> - deg R (a \\<^sub>2 p) <= (if a = \ then 0 else deg R p)" + deg R (a \\<^bsub>P\<^esub> p) <= (if a = \ then 0 else deg R p)" by (cases "a = \") (simp add: deg_aboveI deg_aboveD)+ lemma (in UP_domain) deg_smult [simp]: assumes R: "a \ carrier R" "p \ carrier P" - shows "deg R (a \\<^sub>2 p) = (if a = \ then 0 else deg R p)" + shows "deg R (a \\<^bsub>P\<^esub> p) = (if a = \ then 0 else deg R p)" proof (rule le_anti_sym) - show "deg R (a \\<^sub>2 p) <= (if a = \ then 0 else deg R p)" + show "deg R (a \\<^bsub>P\<^esub> p) <= (if a = \ then 0 else deg R p)" by (rule deg_smult_ring) next - show "(if a = \ then 0 else deg R p) <= deg R (a \\<^sub>2 p)" + show "(if a = \ then 0 else deg R p) <= deg R (a \\<^bsub>P\<^esub> p)" proof (cases "a = \") qed (simp, simp add: deg_belowI lcoeff_nonzero_deg integral_iff R) qed lemma (in UP_cring) deg_mult_cring: assumes R: "p \ carrier P" "q \ carrier P" - shows "deg R (p \\<^sub>2 q) <= deg R p + deg R q" + shows "deg R (p \\<^bsub>P\<^esub> q) <= deg R p + deg R q" proof (rule deg_aboveI) fix m assume boundm: "deg R p + deg R q < m" @@ -956,7 +967,7 @@ then show ?thesis by (simp add: deg_aboveD R) qed } - with boundm R show "coeff P (p \\<^sub>2 q) m = \" by simp + with boundm R show "coeff P (p \\<^bsub>P\<^esub> q) m = \" by simp qed (simp add: R) ML_setup {* @@ -964,31 +975,31 @@ *} lemma (in UP_domain) deg_mult [simp]: - "[| p ~= \\<^sub>2; q ~= \\<^sub>2; p \ carrier P; q \ carrier P |] ==> - deg R (p \\<^sub>2 q) = deg R p + deg R q" + "[| p ~= \\<^bsub>P\<^esub>; q ~= \\<^bsub>P\<^esub>; p \ carrier P; q \ carrier P |] ==> + deg R (p \\<^bsub>P\<^esub> q) = deg R p + deg R q" proof (rule le_anti_sym) assume "p \ carrier P" " q \ carrier P" - show "deg R (p \\<^sub>2 q) <= deg R p + deg R q" by (rule deg_mult_cring) + show "deg R (p \\<^bsub>P\<^esub> q) <= deg R p + deg R q" by (rule deg_mult_cring) next let ?s = "(%i. coeff P p i \ coeff P q (deg R p + deg R q - i))" - assume R: "p \ carrier P" "q \ carrier P" and nz: "p ~= \\<^sub>2" "q ~= \\<^sub>2" + assume R: "p \ carrier P" "q \ carrier P" and nz: "p ~= \\<^bsub>P\<^esub>" "q ~= \\<^bsub>P\<^esub>" have less_add_diff: "!!(k::nat) n m. k < n ==> m < n + m - k" by arith - show "deg R p + deg R q <= deg R (p \\<^sub>2 q)" + show "deg R p + deg R q <= deg R (p \\<^bsub>P\<^esub> q)" proof (rule deg_belowI, simp add: R) - have "finsum R ?s {.. deg R p + deg R q} - = finsum R ?s ({..< deg R p} Un {deg R p .. deg R p + deg R q})" + have "(\i \ {.. deg R p + deg R q}. ?s i) + = (\i \ {..< deg R p} \ {deg R p .. deg R p + deg R q}. ?s i)" by (simp only: ivl_disj_un_one) - also have "... = finsum R ?s {deg R p .. deg R p + deg R q}" + also have "... = (\i \ {deg R p .. deg R p + deg R q}. ?s i)" by (simp cong: finsum_cong add: finsum_Un_disjoint ivl_disj_int_one deg_aboveD less_add_diff R Pi_def) - also have "...= finsum R ?s ({deg R p} Un {deg R p <.. deg R p + deg R q})" + also have "...= (\i \ {deg R p} \ {deg R p <.. deg R p + deg R q}. ?s i)" by (simp only: ivl_disj_un_singleton) also have "... = coeff P p (deg R p) \ coeff P q (deg R q)" by (simp cong: finsum_cong add: finsum_Un_disjoint ivl_disj_int_singleton deg_aboveD R Pi_def) - finally have "finsum R ?s {.. deg R p + deg R q} + finally have "(\i \ {.. deg R p + deg R q}. ?s i) = coeff P p (deg R p) \ coeff P q (deg R q)" . - with nz show "finsum R ?s {.. deg R p + deg R q} ~= \" + with nz show "(\i \ {.. deg R p + deg R q}. ?s i) ~= \" by (simp add: integral_iff lcoeff_nonzero R) qed (simp add: R) qed @@ -996,7 +1007,7 @@ lemma (in UP_cring) coeff_finsum: assumes fin: "finite A" shows "p \ A -> carrier P ==> - coeff P (finsum P p A) k == finsum R (%i. coeff P (p i) k) A" + coeff P (finsum P p A) k = (\i \ A. coeff P (p i) k)" using fin by induct (auto simp: Pi_def) ML_setup {* @@ -1005,24 +1016,24 @@ lemma (in UP_cring) up_repr: assumes R: "p \ carrier P" - shows "(\\<^sub>2 i \ {..deg R p}. monom P (coeff P p i) i) = p" + shows "(\\<^bsub>P\<^esub> i \ {..deg R p}. monom P (coeff P p i) i) = p" proof (rule up_eqI) let ?s = "(%i. monom P (coeff P p i) i)" fix k from R have RR: "!!i. (if i = k then coeff P p i else \) \ carrier R" by simp - show "coeff P (finsum P ?s {..deg R p}) k = coeff P p k" + show "coeff P (\\<^bsub>P\<^esub> i \ {..deg R p}. ?s i) k = coeff P p k" proof (cases "k <= deg R p") case True - hence "coeff P (finsum P ?s {..deg R p}) k = - coeff P (finsum P ?s ({..k} Un {k<..deg R p})) k" + hence "coeff P (\\<^bsub>P\<^esub> i \ {..deg R p}. ?s i) k = + coeff P (\\<^bsub>P\<^esub> i \ {..k} \ {k<..deg R p}. ?s i) k" by (simp only: ivl_disj_un_one) also from True - have "... = coeff P (finsum P ?s {..k}) k" + have "... = coeff P (\\<^bsub>P\<^esub> i \ {..k}. ?s i) k" by (simp cong: finsum_cong add: finsum_Un_disjoint ivl_disj_int_one order_less_imp_not_eq2 coeff_finsum R RR Pi_def) also - have "... = coeff P (finsum P ?s ({..\<^bsub>P\<^esub> i \ {.. {k}. ?s i) k" by (simp only: ivl_disj_un_singleton) also have "... = coeff P p k" by (simp cong: finsum_cong add: setsum_Un_disjoint @@ -1030,8 +1041,8 @@ finally show ?thesis . next case False - hence "coeff P (finsum P ?s {..deg R p}) k = - coeff P (finsum P ?s ({..\<^bsub>P\<^esub> i \ {..deg R p}. ?s i) k = + coeff P (\\<^bsub>P\<^esub> i \ {.. {deg R p}. ?s i) k" by (simp only: ivl_disj_un_singleton) also from False have "... = coeff P p k" by (simp cong: finsum_cong add: setsum_Un_disjoint ivl_disj_int_singleton @@ -1042,11 +1053,11 @@ lemma (in UP_cring) up_repr_le: "[| deg R p <= n; p \ carrier P |] ==> - finsum P (%i. monom P (coeff P p i) i) {..n} = p" + (\\<^bsub>P\<^esub> i \ {..n}. monom P (coeff P p i) i) = p" proof - let ?s = "(%i. monom P (coeff P p i) i)" assume R: "p \ carrier P" and "deg R p <= n" - then have "finsum P ?s {..n} = finsum P ?s ({..deg R p} Un {deg R p<..n})" + then have "finsum P ?s {..n} = finsum P ?s ({..deg R p} \ {deg R p<..n})" by (simp only: ivl_disj_un_one) also have "... = finsum P ?s {..deg R p}" by (simp cong: UP_finsum_cong add: UP_finsum_Un_disjoint ivl_disj_int_one @@ -1071,40 +1082,40 @@ del: disjCI) lemma (in UP_domain) UP_one_not_zero: - "\\<^sub>2 ~= \\<^sub>2" + "\\<^bsub>P\<^esub> ~= \\<^bsub>P\<^esub>" proof - assume "\\<^sub>2 = \\<^sub>2" - hence "coeff P \\<^sub>2 0 = (coeff P \\<^sub>2 0)" by simp + assume "\\<^bsub>P\<^esub> = \\<^bsub>P\<^esub>" + hence "coeff P \\<^bsub>P\<^esub> 0 = (coeff P \\<^bsub>P\<^esub> 0)" by simp hence "\ = \" by simp with one_not_zero show "False" by contradiction qed lemma (in UP_domain) UP_integral: - "[| p \\<^sub>2 q = \\<^sub>2; p \ carrier P; q \ carrier P |] ==> p = \\<^sub>2 | q = \\<^sub>2" + "[| p \\<^bsub>P\<^esub> q = \\<^bsub>P\<^esub>; p \ carrier P; q \ carrier P |] ==> p = \\<^bsub>P\<^esub> | q = \\<^bsub>P\<^esub>" proof - fix p q - assume pq: "p \\<^sub>2 q = \\<^sub>2" and R: "p \ carrier P" "q \ carrier P" - show "p = \\<^sub>2 | q = \\<^sub>2" + assume pq: "p \\<^bsub>P\<^esub> q = \\<^bsub>P\<^esub>" and R: "p \ carrier P" "q \ carrier P" + show "p = \\<^bsub>P\<^esub> | q = \\<^bsub>P\<^esub>" proof (rule classical) - assume c: "~ (p = \\<^sub>2 | q = \\<^sub>2)" - with R have "deg R p + deg R q = deg R (p \\<^sub>2 q)" by simp + assume c: "~ (p = \\<^bsub>P\<^esub> | q = \\<^bsub>P\<^esub>)" + with R have "deg R p + deg R q = deg R (p \\<^bsub>P\<^esub> q)" by simp also from pq have "... = 0" by simp finally have "deg R p + deg R q = 0" . then have f1: "deg R p = 0 & deg R q = 0" by simp - from f1 R have "p = (\\<^sub>2 i \ {..0}. monom P (coeff P p i) i)" + from f1 R have "p = (\\<^bsub>P\<^esub> i \ {..0}. monom P (coeff P p i) i)" by (simp only: up_repr_le) also from R have "... = monom P (coeff P p 0) 0" by simp finally have p: "p = monom P (coeff P p 0) 0" . - from f1 R have "q = (\\<^sub>2 i \ {..0}. monom P (coeff P q i) i)" + from f1 R have "q = (\\<^bsub>P\<^esub> i \ {..0}. monom P (coeff P q i) i)" by (simp only: up_repr_le) also from R have "... = monom P (coeff P q 0) 0" by simp finally have q: "q = monom P (coeff P q 0) 0" . - from R have "coeff P p 0 \ coeff P q 0 = coeff P (p \\<^sub>2 q) 0" by simp + from R have "coeff P p 0 \ coeff P q 0 = coeff P (p \\<^bsub>P\<^esub> q) 0" by simp also from pq have "... = \" by simp finally have "coeff P p 0 \ coeff P q 0 = \" . with R have "coeff P p 0 = \ | coeff P q 0 = \" by (simp add: R.integral_iff) - with p q show "p = \\<^sub>2 | q = \\<^sub>2" by fastsimp + with p q show "p = \\<^bsub>P\<^esub> | q = \\<^bsub>P\<^esub>" by fastsimp qed qed @@ -1113,9 +1124,11 @@ by (auto intro!: domainI UP_cring UP_one_not_zero UP_integral del: disjCI) text {* - Instantiation of results from @{term domain}. + Instantiation of theorems from @{term domain}. *} +(* TODO: this should be automated with an instantiation command. *) + lemmas (in UP_domain) UP_zero_not_one [simp] = domain.zero_not_one [OF UP_domain] @@ -1129,7 +1142,7 @@ domain.m_rcancel [OF UP_domain] lemma (in UP_domain) smult_integral: - "[| a \\<^sub>2 p = \\<^sub>2; a \ carrier R; p \ carrier P |] ==> a = \ | p = \\<^sub>2" + "[| a \\<^bsub>P\<^esub> p = \\<^bsub>P\<^esub>; a \ carrier R; p \ carrier P |] ==> a = \ | p = \\<^bsub>P\<^esub>" by (simp add: monom_mult_is_smult [THEN sym] UP_integral_iff inj_on_iff [OF monom_inj, of _ "\", simplified]) @@ -1161,8 +1174,6 @@ case 0 from Rf Rg show ?case by (simp add: Pi_def) next case (Suc j) - (* The following could be simplified if there was a reasoner for - total orders integrated with simp. *) have R6: "!!i k. [| k <= j; i <= Suc j - k |] ==> g i \ carrier R" using Suc by (auto intro!: funcset_mem [OF Rg]) arith have R8: "!!i k. [| k <= Suc j; i <= k |] ==> g (k - i) \ carrier R" @@ -1189,7 +1200,7 @@ assumes bf: "bound \ n f" and bg: "bound \ m g" and Rf: "f \ {..n} -> carrier R" and Rg: "g \ {..m} -> carrier R" shows "(\k \ {..n + m}. \i \ {..k}. f i \ g (k - i)) = - (\i \ {..n}. f i) \ (\i \ {..m}. g i)" (* State revese direction? *) + (\i \ {..n}. f i) \ (\i \ {..m}. g i)" (* State revese direction? *) proof - have f: "!!x. f x \ carrier R" proof - @@ -1211,7 +1222,8 @@ also from f g have "... = (\k \ {..n}. \i \ {..n + m - k}. f k \ g i)" by (simp cong: finsum_cong add: bound.bound [OF bf] finsum_Un_disjoint ivl_disj_int_one Pi_def) - also from f g have "... = (\k \ {..n}. \i \ {..m} \ {m<..n + m - k}. f k \ g i)" + also from f g + have "... = (\k \ {..n}. \i \ {..m} \ {m<..n + m - k}. f k \ g i)" by (simp cong: finsum_cong add: ivl_disj_un_one le_add_diff Pi_def) also from f g have "... = (\k \ {..n}. \i \ {..m}. f k \ g i)" by (simp cong: finsum_cong @@ -1227,28 +1239,25 @@ by (auto intro!: ring_hom_memI intro: up_eqI simp: monom_mult_is_smult) constdefs (structure S) - eval :: "[_, _, 'a => 'b, 'b, nat => 'a] => 'b" + eval :: "[('a, 'm) ring_scheme, ('b, 'n) ring_scheme, + 'a => 'b, 'b, nat => 'a] => 'b" "eval R S phi s == \p \ carrier (UP R). - \i \ {..deg R p}. phi (coeff (UP R) p i) \ pow S s i" -(* - "eval R S phi s p == if p \ carrier (UP R) - then finsum S (%i. mult S (phi (coeff (UP R) p i)) (pow S s i)) {..deg R p} - else arbitrary" -*) + \i \ {..deg R p}. phi (coeff (UP R) p i) \ s (^) i" + +locale UP_univ_prop = ring_hom_cring R S + UP_cring R -locale ring_hom_UP_cring = ring_hom_cring R S + UP_cring R - -lemma (in ring_hom_UP_cring) eval_on_carrier: - "p \ carrier P ==> +lemma (in UP) eval_on_carrier: + includes struct S + shows "p \ carrier P ==> eval R S phi s p = - (\\<^sub>2 i \ {..deg R p}. phi (coeff P p i) \\<^sub>2 pow S s i)" + (\\<^bsub>S\<^esub> i \ {..deg R p}. phi (coeff P p i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (unfold eval_def, fold P_def) simp -lemma (in ring_hom_UP_cring) eval_extensional: +lemma (in UP) eval_extensional: "eval R S phi s \ extensional (carrier P)" by (unfold eval_def, fold P_def) simp -theorem (in ring_hom_UP_cring) eval_ring_hom: +theorem (in UP_univ_prop) eval_ring_hom: "s \ carrier S ==> eval R S h s \ ring_hom P S" proof (rule ring_hom_memI) fix p @@ -1258,126 +1267,132 @@ next fix p q assume RS: "p \ carrier P" "q \ carrier P" "s \ carrier S" - then show "eval R S h s (p \\<^sub>3 q) = eval R S h s p \\<^sub>2 eval R S h s q" + then show "eval R S h s (p \\<^bsub>P\<^esub> q) = eval R S h s p \\<^bsub>S\<^esub> eval R S h s q" proof (simp only: eval_on_carrier UP_mult_closed) from RS have - "(\\<^sub>2 i \ {..deg R (p \\<^sub>3 q)}. h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i) = - (\\<^sub>2 i \ {..deg R (p \\<^sub>3 q)} \ {deg R (p \\<^sub>3 q)<..deg R p + deg R q}. - h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i)" + "(\\<^bsub>S\<^esub> i \ {..deg R (p \\<^bsub>P\<^esub> q)}. h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) = + (\\<^bsub>S\<^esub> i \ {..deg R (p \\<^bsub>P\<^esub> q)} \ {deg R (p \\<^bsub>P\<^esub> q)<..deg R p + deg R q}. + h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp cong: finsum_cong add: deg_aboveD finsum_Un_disjoint ivl_disj_int_one Pi_def del: coeff_mult) also from RS have "... = - (\\<^sub>2 i \ {..deg R p + deg R q}. h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i)" + (\\<^bsub>S\<^esub> i \ {..deg R p + deg R q}. h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp only: ivl_disj_un_one deg_mult_cring) also from RS have "... = - (\\<^sub>2 i \ {..deg R p + deg R q}. - \\<^sub>2 k \ {..i}. h (coeff P p k) \\<^sub>2 h (coeff P q (i - k)) \\<^sub>2 (s (^)\<^sub>2 k \\<^sub>2 s (^)\<^sub>2 (i - k)))" + (\\<^bsub>S\<^esub> i \ {..deg R p + deg R q}. + \\<^bsub>S\<^esub> k \ {..i}. + h (coeff P p k) \\<^bsub>S\<^esub> h (coeff P q (i - k)) \\<^bsub>S\<^esub> + (s (^)\<^bsub>S\<^esub> k \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> (i - k)))" by (simp cong: finsum_cong add: nat_pow_mult Pi_def S.m_ac S.finsum_rdistr) also from RS have "... = - (\\<^sub>2i\{..deg R p}. h (coeff P p i) \\<^sub>2 s (^)\<^sub>2 i) \\<^sub>2 - (\\<^sub>2i\{..deg R q}. h (coeff P q i) \\<^sub>2 s (^)\<^sub>2 i)" + (\\<^bsub>S\<^esub> i\{..deg R p}. h (coeff P p i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) \\<^bsub>S\<^esub> + (\\<^bsub>S\<^esub> i\{..deg R q}. h (coeff P q i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp add: S.cauchy_product [THEN sym] bound.intro deg_aboveD S.m_ac Pi_def) finally show - "(\\<^sub>2 i \ {..deg R (p \\<^sub>3 q)}. h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i) = - (\\<^sub>2 i \ {..deg R p}. h (coeff P p i) \\<^sub>2 s (^)\<^sub>2 i) \\<^sub>2 - (\\<^sub>2 i \ {..deg R q}. h (coeff P q i) \\<^sub>2 s (^)\<^sub>2 i)" . + "(\\<^bsub>S\<^esub> i \ {..deg R (p \\<^bsub>P\<^esub> q)}. h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) = + (\\<^bsub>S\<^esub> i \ {..deg R p}. h (coeff P p i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) \\<^bsub>S\<^esub> + (\\<^bsub>S\<^esub> i \ {..deg R q}. h (coeff P q i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" . qed next fix p q assume RS: "p \ carrier P" "q \ carrier P" "s \ carrier S" - then show "eval R S h s (p \\<^sub>3 q) = eval R S h s p \\<^sub>2 eval R S h s q" + then show "eval R S h s (p \\<^bsub>P\<^esub> q) = eval R S h s p \\<^bsub>S\<^esub> eval R S h s q" proof (simp only: eval_on_carrier UP_a_closed) from RS have - "(\\<^sub>2i \ {..deg R (p \\<^sub>3 q)}. h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i) = - (\\<^sub>2i \ {..deg R (p \\<^sub>3 q)} \ {deg R (p \\<^sub>3 q)<..max (deg R p) (deg R q)}. - h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i)" + "(\\<^bsub>S \<^esub>i\{..deg R (p \\<^bsub>P\<^esub> q)}. h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) = + (\\<^bsub>S \<^esub>i\{..deg R (p \\<^bsub>P\<^esub> q)} \ {deg R (p \\<^bsub>P\<^esub> q)<..max (deg R p) (deg R q)}. + h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp cong: finsum_cong add: deg_aboveD finsum_Un_disjoint ivl_disj_int_one Pi_def del: coeff_add) also from RS have "... = - (\\<^sub>2 i \ {..max (deg R p) (deg R q)}. h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i)" + (\\<^bsub>S\<^esub> i \ {..max (deg R p) (deg R q)}. + h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp add: ivl_disj_un_one) also from RS have "... = - (\\<^sub>2i\{..max (deg R p) (deg R q)}. h (coeff P p i) \\<^sub>2 s (^)\<^sub>2 i) \\<^sub>2 - (\\<^sub>2i\{..max (deg R p) (deg R q)}. h (coeff P q i) \\<^sub>2 s (^)\<^sub>2 i)" + (\\<^bsub>S\<^esub>i\{..max (deg R p) (deg R q)}. h (coeff P p i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) \\<^bsub>S\<^esub> + (\\<^bsub>S\<^esub>i\{..max (deg R p) (deg R q)}. h (coeff P q i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp cong: finsum_cong add: l_distr deg_aboveD finsum_Un_disjoint ivl_disj_int_one Pi_def) also have "... = - (\\<^sub>2 i \ {..deg R p} \ {deg R p<..max (deg R p) (deg R q)}. - h (coeff P p i) \\<^sub>2 s (^)\<^sub>2 i) \\<^sub>2 - (\\<^sub>2 i \ {..deg R q} \ {deg R q<..max (deg R p) (deg R q)}. - h (coeff P q i) \\<^sub>2 s (^)\<^sub>2 i)" + (\\<^bsub>S\<^esub> i \ {..deg R p} \ {deg R p<..max (deg R p) (deg R q)}. + h (coeff P p i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) \\<^bsub>S\<^esub> + (\\<^bsub>S\<^esub> i \ {..deg R q} \ {deg R q<..max (deg R p) (deg R q)}. + h (coeff P q i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp only: ivl_disj_un_one le_maxI1 le_maxI2) also from RS have "... = - (\\<^sub>2 i \ {..deg R p}. h (coeff P p i) \\<^sub>2 s (^)\<^sub>2 i) \\<^sub>2 - (\\<^sub>2 i \ {..deg R q}. h (coeff P q i) \\<^sub>2 s (^)\<^sub>2 i)" + (\\<^bsub>S\<^esub> i \ {..deg R p}. h (coeff P p i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) \\<^bsub>S\<^esub> + (\\<^bsub>S\<^esub> i \ {..deg R q}. h (coeff P q i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp cong: finsum_cong add: deg_aboveD finsum_Un_disjoint ivl_disj_int_one Pi_def) finally show - "(\\<^sub>2i \ {..deg R (p \\<^sub>3 q)}. h (coeff P (p \\<^sub>3 q) i) \\<^sub>2 s (^)\<^sub>2 i) = - (\\<^sub>2i \ {..deg R p}. h (coeff P p i) \\<^sub>2 s (^)\<^sub>2 i) \\<^sub>2 - (\\<^sub>2i \ {..deg R q}. h (coeff P q i) \\<^sub>2 s (^)\<^sub>2 i)" - . + "(\\<^bsub>S\<^esub>i \ {..deg R (p \\<^bsub>P\<^esub> q)}. h (coeff P (p \\<^bsub>P\<^esub> q) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) = + (\\<^bsub>S\<^esub>i \ {..deg R p}. h (coeff P p i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) \\<^bsub>S\<^esub> + (\\<^bsub>S\<^esub>i \ {..deg R q}. h (coeff P q i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" . qed next assume S: "s \ carrier S" - then show "eval R S h s \\<^sub>3 = \\<^sub>2" + then show "eval R S h s \\<^bsub>P\<^esub> = \\<^bsub>S\<^esub>" by (simp only: eval_on_carrier UP_one_closed) simp qed text {* Instantiation of ring homomorphism lemmas. *} -lemma (in ring_hom_UP_cring) ring_hom_cring_P_S: +(* TODO: again, automate with instantiation command *) + +lemma (in UP_univ_prop) ring_hom_cring_P_S: "s \ carrier S ==> ring_hom_cring P S (eval R S h s)" by (fast intro!: ring_hom_cring.intro UP_cring cring.axioms prems - intro: ring_hom_cring_axioms.intro eval_ring_hom) + intro: ring_hom_cring_axioms.intro eval_ring_hom) -lemma (in ring_hom_UP_cring) UP_hom_closed [intro, simp]: +(* +lemma (in UP_univ_prop) UP_hom_closed [intro, simp]: "[| s \ carrier S; p \ carrier P |] ==> eval R S h s p \ carrier S" by (rule ring_hom_cring.hom_closed [OF ring_hom_cring_P_S]) -lemma (in ring_hom_UP_cring) UP_hom_mult [simp]: +lemma (in UP_univ_prop) UP_hom_mult [simp]: "[| s \ carrier S; p \ carrier P; q \ carrier P |] ==> - eval R S h s (p \\<^sub>3 q) = eval R S h s p \\<^sub>2 eval R S h s q" + eval R S h s (p \\<^bsub>P\<^esub> q) = eval R S h s p \\<^bsub>S\<^esub> eval R S h s q" by (rule ring_hom_cring.hom_mult [OF ring_hom_cring_P_S]) -lemma (in ring_hom_UP_cring) UP_hom_add [simp]: +lemma (in UP_univ_prop) UP_hom_add [simp]: "[| s \ carrier S; p \ carrier P; q \ carrier P |] ==> - eval R S h s (p \\<^sub>3 q) = eval R S h s p \\<^sub>2 eval R S h s q" + eval R S h s (p \\<^bsub>P\<^esub> q) = eval R S h s p \\<^bsub>S\<^esub> eval R S h s q" by (rule ring_hom_cring.hom_add [OF ring_hom_cring_P_S]) -lemma (in ring_hom_UP_cring) UP_hom_one [simp]: - "s \ carrier S ==> eval R S h s \\<^sub>3 = \\<^sub>2" +lemma (in UP_univ_prop) UP_hom_one [simp]: + "s \ carrier S ==> eval R S h s \\<^bsub>P\<^esub> = \\<^bsub>S\<^esub>" by (rule ring_hom_cring.hom_one [OF ring_hom_cring_P_S]) -lemma (in ring_hom_UP_cring) UP_hom_zero [simp]: - "s \ carrier S ==> eval R S h s \\<^sub>3 = \\<^sub>2" +lemma (in UP_univ_prop) UP_hom_zero [simp]: + "s \ carrier S ==> eval R S h s \\<^bsub>P\<^esub> = \\<^bsub>S\<^esub>" by (rule ring_hom_cring.hom_zero [OF ring_hom_cring_P_S]) -lemma (in ring_hom_UP_cring) UP_hom_a_inv [simp]: +lemma (in UP_univ_prop) UP_hom_a_inv [simp]: "[| s \ carrier S; p \ carrier P |] ==> - (eval R S h s) (\\<^sub>3 p) = \\<^sub>2 (eval R S h s) p" + (eval R S h s) (\\<^bsub>P\<^esub> p) = \\<^bsub>S\<^esub> (eval R S h s) p" by (rule ring_hom_cring.hom_a_inv [OF ring_hom_cring_P_S]) -lemma (in ring_hom_UP_cring) UP_hom_finsum [simp]: +lemma (in UP_univ_prop) UP_hom_finsum [simp]: "[| s \ carrier S; finite A; f \ A -> carrier P |] ==> (eval R S h s) (finsum P f A) = finsum S (eval R S h s o f) A" by (rule ring_hom_cring.hom_finsum [OF ring_hom_cring_P_S]) -lemma (in ring_hom_UP_cring) UP_hom_finprod [simp]: +lemma (in UP_univ_prop) UP_hom_finprod [simp]: "[| s \ carrier S; finite A; f \ A -> carrier P |] ==> (eval R S h s) (finprod P f A) = finprod S (eval R S h s o f) A" by (rule ring_hom_cring.hom_finprod [OF ring_hom_cring_P_S]) +*) text {* Further properties of the evaluation homomorphism. *} (* The following lemma could be proved in UP\_cring with the additional assumption that h is closed. *) -lemma (in ring_hom_UP_cring) eval_const: +lemma (in UP_univ_prop) eval_const: "[| s \ carrier S; r \ carrier R |] ==> eval R S h s (monom P r 0) = h r" by (simp only: eval_on_carrier monom_closed) simp @@ -1386,32 +1401,32 @@ (* TODO: simplify by cases "one R = zero R" *) -lemma (in ring_hom_UP_cring) eval_monom1: +lemma (in UP_univ_prop) eval_monom1: "s \ carrier S ==> eval R S h s (monom P \ 1) = s" proof (simp only: eval_on_carrier monom_closed R.one_closed) assume S: "s \ carrier S" then have - "(\\<^sub>2 i \ {..deg R (monom P \ 1)}. h (coeff P (monom P \ 1) i) \\<^sub>2 s (^)\<^sub>2 i) = - (\\<^sub>2i\{..deg R (monom P \ 1)} \ {deg R (monom P \ 1)<..1}. - h (coeff P (monom P \ 1) i) \\<^sub>2 s (^)\<^sub>2 i)" + "(\\<^bsub>S\<^esub> i\{..deg R (monom P \ 1)}. h (coeff P (monom P \ 1) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) = + (\\<^bsub>S\<^esub> i\{..deg R (monom P \ 1)} \ {deg R (monom P \ 1)<..1}. + h (coeff P (monom P \ 1) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp cong: finsum_cong del: coeff_monom add: deg_aboveD finsum_Un_disjoint ivl_disj_int_one Pi_def) also have "... = - (\\<^sub>2 i \ {..1}. h (coeff P (monom P \ 1) i) \\<^sub>2 s (^)\<^sub>2 i)" + (\\<^bsub>S\<^esub> i \ {..1}. h (coeff P (monom P \ 1) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i)" by (simp only: ivl_disj_un_one deg_monom_le R.one_closed) also have "... = s" - proof (cases "s = \\<^sub>2") + proof (cases "s = \\<^bsub>S\<^esub>") case True then show ?thesis by (simp add: Pi_def) next case False with S show ?thesis by (simp add: Pi_def) qed - finally show "(\\<^sub>2 i \ {..deg R (monom P \ 1)}. - h (coeff P (monom P \ 1) i) \\<^sub>2 s (^)\<^sub>2 i) = s" . + finally show "(\\<^bsub>S\<^esub> i \ {..deg R (monom P \ 1)}. + h (coeff P (monom P \ 1) i) \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> i) = s" . qed lemma (in UP_cring) monom_pow: assumes R: "a \ carrier R" - shows "(monom P a n) (^)\<^sub>2 m = monom P (a (^) m) (n * m)" + shows "(monom P a n) (^)\<^bsub>P\<^esub> m = monom P (a (^) m) (n * m)" proof (induct m) case 0 from R show ?case by simp next @@ -1420,32 +1435,34 @@ qed lemma (in ring_hom_cring) hom_pow [simp]: - "x \ carrier R ==> h (x (^) n) = h x (^)\<^sub>2 (n::nat)" + "x \ carrier R ==> h (x (^) n) = h x (^)\<^bsub>S\<^esub> (n::nat)" by (induct n) simp_all -lemma (in ring_hom_UP_cring) UP_hom_pow [simp]: - "[| s \ carrier S; p \ carrier P |] ==> - (eval R S h s) (p (^)\<^sub>3 n) = eval R S h s p (^)\<^sub>2 (n::nat)" - by (rule ring_hom_cring.hom_pow [OF ring_hom_cring_P_S]) - -lemma (in ring_hom_UP_cring) eval_monom: +lemma (in UP_univ_prop) eval_monom: "[| s \ carrier S; r \ carrier R |] ==> - eval R S h s (monom P r n) = h r \\<^sub>2 s (^)\<^sub>2 n" + eval R S h s (monom P r n) = h r \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> n" proof - - assume RS: "s \ carrier S" "r \ carrier R" - then have "eval R S h s (monom P r n) = - eval R S h s (monom P r 0 \\<^sub>3 (monom P \ 1) (^)\<^sub>3 n)" - by (simp del: monom_mult UP_hom_mult UP_hom_pow + assume S: "s \ carrier S" and R: "r \ carrier R" + from R S have "eval R S h s (monom P r n) = + eval R S h s (monom P r 0 \\<^bsub>P\<^esub> (monom P \ 1) (^)\<^bsub>P\<^esub> n)" + by (simp del: monom_mult (* eval.hom_mult eval.hom_pow, delayed inst! *) add: monom_mult [THEN sym] monom_pow) - also from RS eval_monom1 have "... = h r \\<^sub>2 s (^)\<^sub>2 n" + also + from ring_hom_cring_P_S [OF S] instantiate eval: ring_hom_cring + from R S eval_monom1 have "... = h r \\<^bsub>S\<^esub> s (^)\<^bsub>S\<^esub> n" by (simp add: eval_const) finally show ?thesis . qed -lemma (in ring_hom_UP_cring) eval_smult: +lemma (in UP_univ_prop) eval_smult: "[| s \ carrier S; r \ carrier R; p \ carrier P |] ==> - eval R S h s (r \\<^sub>3 p) = h r \\<^sub>2 eval R S h s p" - by (simp add: monom_mult_is_smult [THEN sym] eval_const) + eval R S h s (r \\<^bsub>P\<^esub> p) = h r \\<^bsub>S\<^esub> eval R S h s p" +proof - + assume S: "s \ carrier S" and R: "r \ carrier R" and P: "p \ carrier P" + from ring_hom_cring_P_S [OF S] instantiate eval: ring_hom_cring + from S R P show ?thesis + by (simp add: monom_mult_is_smult [THEN sym] eval_const) +qed lemma ring_hom_cringI: assumes "cring R" @@ -1455,34 +1472,41 @@ by (fast intro: ring_hom_cring.intro ring_hom_cring_axioms.intro cring.axioms prems) -lemma (in ring_hom_UP_cring) UP_hom_unique: +lemma (in UP_univ_prop) UP_hom_unique: assumes Phi: "Phi \ ring_hom P S" "Phi (monom P \ (Suc 0)) = s" "!!r. r \ carrier R ==> Phi (monom P r 0) = h r" and Psi: "Psi \ ring_hom P S" "Psi (monom P \ (Suc 0)) = s" "!!r. r \ carrier R ==> Psi (monom P r 0) = h r" - and RS: "s \ carrier S" "p \ carrier P" + and S: "s \ carrier S" and P: "p \ carrier P" shows "Phi p = Psi p" proof - have Phi_hom: "ring_hom_cring P S Phi" by (auto intro: ring_hom_cringI UP_cring S.cring Phi) have Psi_hom: "ring_hom_cring P S Psi" by (auto intro: ring_hom_cringI UP_cring S.cring Psi) - have "Phi p = Phi (\\<^sub>3i \ {..deg R p}. monom P (coeff P p i) 0 \\<^sub>3 monom P \ 1 (^)\<^sub>3 i)" - by (simp add: up_repr RS monom_mult [THEN sym] monom_pow del: monom_mult) - also have "... = Psi (\\<^sub>3i\{..deg R p}. monom P (coeff P p i) 0 \\<^sub>3 monom P \ 1 (^)\<^sub>3 i)" + have "Phi p = + Phi (\\<^bsub>P \<^esub>i \ {..deg R p}. monom P (coeff P p i) 0 \\<^bsub>P\<^esub> monom P \ 1 (^)\<^bsub>P\<^esub> i)" + by (simp add: up_repr P S monom_mult [THEN sym] monom_pow del: monom_mult) + also + from Phi_hom instantiate Phi: ring_hom_cring + from Psi_hom instantiate Psi: ring_hom_cring + have "... = + Psi (\\<^bsub>P \<^esub>i\{..deg R p}. monom P (coeff P p i) 0 \\<^bsub>P\<^esub> monom P \ 1 (^)\<^bsub>P\<^esub> i)" + by (simp add: Phi Psi P S Pi_def comp_def) +(* Without instantiate, the following command would have been necessary. by (simp add: ring_hom_cring.hom_finsum [OF Phi_hom] ring_hom_cring.hom_mult [OF Phi_hom] ring_hom_cring.hom_pow [OF Phi_hom] Phi ring_hom_cring.hom_finsum [OF Psi_hom] ring_hom_cring.hom_mult [OF Psi_hom] ring_hom_cring.hom_pow [OF Psi_hom] Psi RS Pi_def comp_def) +*) also have "... = Psi p" - by (simp add: up_repr RS monom_mult [THEN sym] monom_pow del: monom_mult) + by (simp add: up_repr P S monom_mult [THEN sym] monom_pow del: monom_mult) finally show ?thesis . qed - -theorem (in ring_hom_UP_cring) UP_universal_property: +theorem (in UP_univ_prop) UP_universal_property: "s \ carrier S ==> EX! Phi. Phi \ ring_hom P S \ extensional (carrier P) & Phi (monom P \ 1) = s & @@ -1495,31 +1519,31 @@ subsection {* Sample application of evaluation homomorphism *} -lemma ring_hom_UP_cringI: +lemma UP_univ_propI: assumes "cring R" and "cring S" and "h \ ring_hom R S" - shows "ring_hom_UP_cring R S h" - by (fast intro: ring_hom_UP_cring.intro ring_hom_cring_axioms.intro + shows "UP_univ_prop R S h" + by (fast intro: UP_univ_prop.intro ring_hom_cring_axioms.intro cring.axioms prems) constdefs INTEG :: "int ring" "INTEG == (| carrier = UNIV, mult = op *, one = 1, zero = 0, add = op + |)" -lemma cring_INTEG: +lemma INTEG_cring: "cring INTEG" by (unfold INTEG_def) (auto intro!: cringI abelian_groupI comm_monoidI zadd_zminus_inverse2 zadd_zmult_distrib) -lemma INTEG_id: - "ring_hom_UP_cring INTEG INTEG id" - by (fast intro: ring_hom_UP_cringI cring_INTEG id_ring_hom) +lemma INTEG_id_eval: + "UP_univ_prop INTEG INTEG id" + by (fast intro: UP_univ_propI INTEG_cring id_ring_hom) text {* An instantiation mechanism would now import all theorems and lemmas valid in the context of homomorphisms between @{term INTEG} and @{term - "UP INTEG"}. + "UP INTEG"} globally. *} lemma INTEG_closed [intro, simp]: @@ -1535,6 +1559,6 @@ by (induct n) (simp_all add: INTEG_def nat_pow_def) lemma "eval INTEG INTEG id 10 (monom (UP INTEG) 5 2) = 500" - by (simp add: ring_hom_UP_cring.eval_monom [OF INTEG_id]) + by (simp add: UP_univ_prop.eval_monom [OF INTEG_id_eval]) end