# HG changeset patch # User ballarin # Date 1091432686 -7200 # Node ID 63f5f4c265dd75df820db055c97bb9d82643317d # Parent a7d1a3fdc30d62781a84af2c6109a565ed3ea723 Theories now take advantage of recent syntax improvements with (structure). diff -r a7d1a3fdc30d -r 63f5f4c265dd src/HOL/Algebra/CRing.thy --- a/src/HOL/Algebra/CRing.thy Sat Jul 31 20:54:23 2004 +0200 +++ b/src/HOL/Algebra/CRing.thy Mon Aug 02 09:44:46 2004 +0200 @@ -17,7 +17,7 @@ text {* Derived operations. *} constdefs (structure R) - a_inv :: "[_, 'a ] => 'a" ("\\ _" [81] 80) + a_inv :: "[('a, 'm) ring_scheme, 'a ] => 'a" ("\\ _" [81] 80) "a_inv R == m_inv (| carrier = carrier R, mult = add R, one = zero R |)" minus :: "[('a, 'm) ring_scheme, 'a, 'a] => 'a" (infixl "\\" 65) @@ -40,29 +40,31 @@ subsection {* Basic Properties *} lemma abelian_monoidI: + includes struct R assumes a_closed: - "!!x y. [| x \ carrier R; y \ carrier R |] ==> add R x y \ carrier R" - and zero_closed: "zero R \ carrier R" + "!!x y. [| x \ carrier R; y \ carrier R |] ==> x \ y \ carrier R" + and zero_closed: "\ \ carrier R" and a_assoc: "!!x y z. [| x \ carrier R; y \ carrier R; z \ carrier R |] ==> - add R (add R x y) z = add R x (add R y z)" - and l_zero: "!!x. x \ carrier R ==> add R (zero R) x = x" + (x \ y) \ z = x \ (y \ z)" + and l_zero: "!!x. x \ carrier R ==> \ \ x = x" and a_comm: - "!!x y. [| x \ carrier R; y \ carrier R |] ==> add R x y = add R y x" + "!!x y. [| x \ carrier R; y \ carrier R |] ==> x \ y = y \ x" shows "abelian_monoid R" by (auto intro!: abelian_monoid.intro comm_monoidI intro: prems) lemma abelian_groupI: + includes struct R assumes a_closed: - "!!x y. [| x \ carrier R; y \ carrier R |] ==> add R x y \ carrier R" + "!!x y. [| x \ carrier R; y \ carrier R |] ==> x \ y \ carrier R" and zero_closed: "zero R \ carrier R" and a_assoc: "!!x y z. [| x \ carrier R; y \ carrier R; z \ carrier R |] ==> - add R (add R x y) z = add R x (add R y z)" + (x \ y) \ z = x \ (y \ z)" and a_comm: - "!!x y. [| x \ carrier R; y \ carrier R |] ==> add R x y = add R y x" - and l_zero: "!!x. x \ carrier R ==> add R (zero R) x = x" - and l_inv_ex: "!!x. x \ carrier R ==> EX y : carrier R. add R y x = zero R" + "!!x y. [| x \ carrier R; y \ carrier R |] ==> x \ y = y \ x" + and l_zero: "!!x. x \ carrier R ==> \ \ x = x" + and l_inv_ex: "!!x. x \ carrier R ==> EX y : carrier R. y \ x = \" shows "abelian_group R" by (auto intro!: abelian_group.intro abelian_monoidI abelian_group_axioms.intro comm_monoidI comm_groupI @@ -169,7 +171,7 @@ *} constdefs - finsum :: "[_, 'a => 'b, 'a set] => 'b" + finsum :: "[('b, 'm) ring_scheme, 'a => 'b, 'a set] => 'b" "finsum G f A == finprod (| carrier = carrier G, mult = add G, one = zero G |) f A" @@ -183,7 +185,8 @@ "_finsum" :: "index => idt => 'a set => 'b => 'b" ("(3\__\_. _)" [1000, 0, 51, 10] 10) translations - "\\i:A. b" == "finsum \\ (%i. b) A" -- {* Beware of argument permutation! *} + "\\i:A. b" == "finsum \\ (%i. b) A" + -- {* Beware of argument permutation! *} (* lemmas (in abelian_monoid) finsum_empty [simp] = @@ -194,10 +197,10 @@ lemmas (in abelian_monoid) finsum_empty [simp] = abelian_monoid.finprod_empty [OF a_abelian_monoid, folded finsum_def, simplified monoid_record_simps] -makes the locale slow, because proofs are repeated for every -"lemma (in abelian_monoid)" command. -When lemma is used time in UnivPoly.thy from beginning to UP_cring goes down -from 110 secs to 60 secs. + makes the locale slow, because proofs are repeated for every + "lemma (in abelian_monoid)" command. + When lemma is used time in UnivPoly.thy from beginning to UP_cring goes down + from 110 secs to 60 secs. *) lemma (in abelian_monoid) finsum_empty [simp]: @@ -212,7 +215,7 @@ folded finsum_def, simplified monoid_record_simps]) lemma (in abelian_monoid) finsum_zero [simp]: - "finite A ==> (\i: A. \) = \" + "finite A ==> (\i\A. \) = \" by (rule comm_monoid.finprod_one [OF a_comm_monoid, folded finsum_def, simplified monoid_record_simps]) @@ -310,7 +313,7 @@ assumes abelian_group: "abelian_group R" and monoid: "monoid R" and l_distr: "!!x y z. [| x \ carrier R; y \ carrier R; z \ carrier R |] - ==> mult R (add R x y) z = add R (mult R x z) (mult R y z)" + ==> (x \ y) \ z = x \ z \ y \ z" and r_distr: "!!x y z. [| x \ carrier R; y \ carrier R; z \ carrier R |] ==> z \ (x \ y) = z \ x \ z \ y" shows "ring R" @@ -330,7 +333,7 @@ assumes abelian_group: "abelian_group R" and comm_monoid: "comm_monoid R" and l_distr: "!!x y z. [| x \ carrier R; y \ carrier R; z \ carrier R |] - ==> mult R (add R x y) z = add R (mult R x z) (mult R y z)" + ==> (x \ y) \ z = x \ z \ y \ z" shows "cring R" proof (rule cring.intro) show "ring_axioms R" @@ -457,7 +460,7 @@ lemma includes ring R + cring S shows "[| a \ carrier R; b \ carrier R; c \ carrier S; d \ carrier S |] ==> - a \ \ (a \ \ b) = b & c \\<^sub>2 d = d \\<^sub>2 c" + a \ \ (a \ \ b) = b & c \\<^bsub>S\<^esub> d = d \\<^bsub>S\<^esub> c" by algebra lemma @@ -528,21 +531,21 @@ subsection {* Morphisms *} -constdefs +constdefs (structure R S) ring_hom :: "[('a, 'm) ring_scheme, ('b, 'n) ring_scheme] => ('a => 'b) set" "ring_hom R S == {h. h \ carrier R -> carrier S & (ALL x y. x \ carrier R & y \ carrier R --> - h (mult R x y) = mult S (h x) (h y) & - h (add R x y) = add S (h x) (h y)) & - h (one R) = one S}" + h (x \ y) = h x \\<^bsub>S\<^esub> h y & h (x \ y) = h x \\<^bsub>S\<^esub> h y) & + h \ = \\<^bsub>S\<^esub>}" lemma ring_hom_memI: + includes struct R + struct S assumes hom_closed: "!!x. x \ carrier R ==> h x \ carrier S" and hom_mult: "!!x y. [| x \ carrier R; y \ carrier R |] ==> - h (mult R x y) = mult S (h x) (h y)" + h (x \ y) = h x \\<^bsub>S\<^esub> h y" and hom_add: "!!x y. [| x \ carrier R; y \ carrier R |] ==> - h (add R x y) = add S (h x) (h y)" - and hom_one: "h (one R) = one S" + h (x \ y) = h x \\<^bsub>S\<^esub> h y" + and hom_one: "h \ = \\<^bsub>S\<^esub>" shows "h \ ring_hom R S" by (auto simp add: ring_hom_def prems Pi_def) @@ -551,17 +554,22 @@ by (auto simp add: ring_hom_def funcset_mem) lemma ring_hom_mult: - "[| h \ ring_hom R S; x \ carrier R; y \ carrier R |] ==> - h (mult R x y) = mult S (h x) (h y)" - by (simp add: ring_hom_def) + includes struct R + struct S + shows + "[| h \ ring_hom R S; x \ carrier R; y \ carrier R |] ==> + h (x \ y) = h x \\<^bsub>S\<^esub> h y" + by (simp add: ring_hom_def) lemma ring_hom_add: - "[| h \ ring_hom R S; x \ carrier R; y \ carrier R |] ==> - h (add R x y) = add S (h x) (h y)" - by (simp add: ring_hom_def) + includes struct R + struct S + shows + "[| h \ ring_hom R S; x \ carrier R; y \ carrier R |] ==> + h (x \ y) = h x \\<^bsub>S\<^esub> h y" + by (simp add: ring_hom_def) lemma ring_hom_one: - "h \ ring_hom R S ==> h (one R) = one S" + includes struct R + struct S + shows "h \ ring_hom R S ==> h \ = \\<^bsub>S\<^esub>" by (simp add: ring_hom_def) locale ring_hom_cring = cring R + cring S + var h + @@ -572,18 +580,18 @@ and hom_one [simp] = ring_hom_one [OF homh] lemma (in ring_hom_cring) hom_zero [simp]: - "h \ = \\<^sub>2" + "h \ = \\<^bsub>S\<^esub>" proof - - have "h \ \\<^sub>2 h \ = h \ \\<^sub>2 \\<^sub>2" + have "h \ \\<^bsub>S\<^esub> h \ = h \ \\<^bsub>S\<^esub> \\<^bsub>S\<^esub>" by (simp add: hom_add [symmetric] del: hom_add) then show ?thesis by (simp del: S.r_zero) qed lemma (in ring_hom_cring) hom_a_inv [simp]: - "x \ carrier R ==> h (\ x) = \\<^sub>2 h x" + "x \ carrier R ==> h (\ x) = \\<^bsub>S\<^esub> h x" proof - assume R: "x \ carrier R" - then have "h x \\<^sub>2 h (\ x) = h x \\<^sub>2 (\\<^sub>2 h x)" + then have "h x \\<^bsub>S\<^esub> h (\ x) = h x \\<^bsub>S\<^esub> (\\<^bsub>S\<^esub> h x)" by (simp add: hom_add [symmetric] R.r_neg S.r_neg del: hom_add) with R show ?thesis by simp qed diff -r a7d1a3fdc30d -r 63f5f4c265dd src/HOL/Algebra/FiniteProduct.thy --- a/src/HOL/Algebra/FiniteProduct.thy Sat Jul 31 20:54:23 2004 +0200 +++ b/src/HOL/Algebra/FiniteProduct.thy Mon Aug 02 09:44:46 2004 +0200 @@ -283,7 +283,7 @@ subsection {* Products over Finite Sets *} constdefs (structure G) - finprod :: "[_, 'a => 'b, 'a set] => 'b" + finprod :: "[('b, 'm) monoid_scheme, 'a => 'b, 'a set] => 'b" "finprod G f A == if finite A then foldD (carrier G) (mult G o f) \ A else arbitrary" @@ -298,7 +298,8 @@ "_finprod" :: "index => idt => 'a set => 'b => 'b" ("(3\__\_. _)" [1000, 0, 51, 10] 10) translations - "\\i:A. b" == "finprod \\ (%i. b) A" -- {* Beware of argument permutation! *} + "\\i:A. b" == "finprod \\ (%i. b) A" + -- {* Beware of argument permutation! *} ML_setup {* simpset_ref() := simpset() setsubgoaler asm_full_simp_tac; @@ -402,9 +403,8 @@ from insert have ga: "g a \ carrier G" by fast from insert have fgA: "(%x. f x \ g x) \ A -> carrier G" by (simp add: Pi_def) - show ?case (* check if all simps are really necessary *) - by (simp add: insert fA fa gA ga fgA m_ac Int_insert_left insert_absorb - Int_mono2 Un_subset_iff) + show ?case + by (simp add: insert fA fa gA ga fgA m_ac) qed lemma (in comm_monoid) finprod_cong': diff -r a7d1a3fdc30d -r 63f5f4c265dd src/HOL/Algebra/Module.thy --- a/src/HOL/Algebra/Module.thy Sat Jul 31 20:54:23 2004 +0200 +++ b/src/HOL/Algebra/Module.thy Mon Aug 02 09:44:46 2004 +0200 @@ -13,41 +13,41 @@ locale module = cring R + abelian_group M + assumes smult_closed [simp, intro]: - "[| a \ carrier R; x \ carrier M |] ==> a \\<^sub>2 x \ carrier M" + "[| a \ carrier R; x \ carrier M |] ==> a \\<^bsub>M\<^esub> x \ carrier M" and smult_l_distr: "[| a \ carrier R; b \ carrier R; x \ carrier M |] ==> - (a \ b) \\<^sub>2 x = a \\<^sub>2 x \\<^sub>2 b \\<^sub>2 x" + (a \ b) \\<^bsub>M\<^esub> x = a \\<^bsub>M\<^esub> x \\<^bsub>M\<^esub> b \\<^bsub>M\<^esub> x" and smult_r_distr: "[| a \ carrier R; x \ carrier M; y \ carrier M |] ==> - a \\<^sub>2 (x \\<^sub>2 y) = a \\<^sub>2 x \\<^sub>2 a \\<^sub>2 y" + a \\<^bsub>M\<^esub> (x \\<^bsub>M\<^esub> y) = a \\<^bsub>M\<^esub> x \\<^bsub>M\<^esub> a \\<^bsub>M\<^esub> y" and smult_assoc1: "[| a \ carrier R; b \ carrier R; x \ carrier M |] ==> - (a \ b) \\<^sub>2 x = a \\<^sub>2 (b \\<^sub>2 x)" + (a \ b) \\<^bsub>M\<^esub> x = a \\<^bsub>M\<^esub> (b \\<^bsub>M\<^esub> x)" and smult_one [simp]: - "x \ carrier M ==> \ \\<^sub>2 x = x" + "x \ carrier M ==> \ \\<^bsub>M\<^esub> x = x" locale algebra = module R M + cring M + assumes smult_assoc2: "[| a \ carrier R; x \ carrier M; y \ carrier M |] ==> - (a \\<^sub>2 x) \\<^sub>2 y = a \\<^sub>2 (x \\<^sub>2 y)" + (a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> y = a \\<^bsub>M\<^esub> (x \\<^bsub>M\<^esub> y)" lemma moduleI: includes struct R + struct M assumes cring: "cring R" and abelian_group: "abelian_group M" and smult_closed: - "!!a x. [| a \ carrier R; x \ carrier M |] ==> a \\<^sub>2 x \ carrier M" + "!!a x. [| a \ carrier R; x \ carrier M |] ==> a \\<^bsub>M\<^esub> x \ carrier M" and smult_l_distr: "!!a b x. [| a \ carrier R; b \ carrier R; x \ carrier M |] ==> - (a \ b) \\<^sub>2 x = (a \\<^sub>2 x) \\<^sub>2 (b \\<^sub>2 x)" + (a \ b) \\<^bsub>M\<^esub> x = (a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> (b \\<^bsub>M\<^esub> x)" and smult_r_distr: "!!a x y. [| a \ carrier R; x \ carrier M; y \ carrier M |] ==> - a \\<^sub>2 (x \\<^sub>2 y) = (a \\<^sub>2 x) \\<^sub>2 (a \\<^sub>2 y)" + a \\<^bsub>M\<^esub> (x \\<^bsub>M\<^esub> y) = (a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> (a \\<^bsub>M\<^esub> y)" and smult_assoc1: "!!a b x. [| a \ carrier R; b \ carrier R; x \ carrier M |] ==> - (a \ b) \\<^sub>2 x = a \\<^sub>2 (b \\<^sub>2 x)" + (a \ b) \\<^bsub>M\<^esub> x = a \\<^bsub>M\<^esub> (b \\<^bsub>M\<^esub> x)" and smult_one: - "!!x. x \ carrier M ==> \ \\<^sub>2 x = x" + "!!x. x \ carrier M ==> \ \\<^bsub>M\<^esub> x = x" shows "module R M" by (auto intro: module.intro cring.axioms abelian_group.axioms module_axioms.intro prems) @@ -57,21 +57,21 @@ assumes R_cring: "cring R" and M_cring: "cring M" and smult_closed: - "!!a x. [| a \ carrier R; x \ carrier M |] ==> a \\<^sub>2 x \ carrier M" + "!!a x. [| a \ carrier R; x \ carrier M |] ==> a \\<^bsub>M\<^esub> x \ carrier M" and smult_l_distr: "!!a b x. [| a \ carrier R; b \ carrier R; x \ carrier M |] ==> - (a \ b) \\<^sub>2 x = (a \\<^sub>2 x) \\<^sub>2 (b \\<^sub>2 x)" + (a \ b) \\<^bsub>M\<^esub> x = (a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> (b \\<^bsub>M\<^esub> x)" and smult_r_distr: "!!a x y. [| a \ carrier R; x \ carrier M; y \ carrier M |] ==> - a \\<^sub>2 (x \\<^sub>2 y) = (a \\<^sub>2 x) \\<^sub>2 (a \\<^sub>2 y)" + a \\<^bsub>M\<^esub> (x \\<^bsub>M\<^esub> y) = (a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> (a \\<^bsub>M\<^esub> y)" and smult_assoc1: "!!a b x. [| a \ carrier R; b \ carrier R; x \ carrier M |] ==> - (a \ b) \\<^sub>2 x = a \\<^sub>2 (b \\<^sub>2 x)" + (a \ b) \\<^bsub>M\<^esub> x = a \\<^bsub>M\<^esub> (b \\<^bsub>M\<^esub> x)" and smult_one: - "!!x. x \ carrier M ==> (one R) \\<^sub>2 x = x" + "!!x. x \ carrier M ==> (one R) \\<^bsub>M\<^esub> x = x" and smult_assoc2: "!!a x y. [| a \ carrier R; x \ carrier M; y \ carrier M |] ==> - (a \\<^sub>2 x) \\<^sub>2 y = a \\<^sub>2 (x \\<^sub>2 y)" + (a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> y = a \\<^bsub>M\<^esub> (x \\<^bsub>M\<^esub> y)" shows "algebra R M" by (auto intro!: algebra.intro algebra_axioms.intro cring.axioms module_axioms.intro prems) @@ -93,52 +93,53 @@ subsection {* Basic Properties of Algebras *} lemma (in algebra) smult_l_null [simp]: - "x \ carrier M ==> \ \\<^sub>2 x = \\<^sub>2" + "x \ carrier M ==> \ \\<^bsub>M\<^esub> x = \\<^bsub>M\<^esub>" proof - assume M: "x \ carrier M" note facts = M smult_closed - from facts have "\ \\<^sub>2 x = (\ \\<^sub>2 x \\<^sub>2 \ \\<^sub>2 x) \\<^sub>2 \\<^sub>2 (\ \\<^sub>2 x)" by algebra - also from M have "... = (\ \ \) \\<^sub>2 x \\<^sub>2 \\<^sub>2 (\ \\<^sub>2 x)" + from facts have "\ \\<^bsub>M\<^esub> x = (\ \\<^bsub>M\<^esub> x \\<^bsub>M\<^esub> \ \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> (\ \\<^bsub>M\<^esub> x)" by algebra + also from M have "... = (\ \ \) \\<^bsub>M\<^esub> x \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> (\ \\<^bsub>M\<^esub> x)" by (simp add: smult_l_distr del: R.l_zero R.r_zero) - also from facts have "... = \\<^sub>2" by algebra + also from facts have "... = \\<^bsub>M\<^esub>" by algebra finally show ?thesis . qed lemma (in algebra) smult_r_null [simp]: - "a \ carrier R ==> a \\<^sub>2 \\<^sub>2 = \\<^sub>2"; + "a \ carrier R ==> a \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> = \\<^bsub>M\<^esub>"; proof - assume R: "a \ carrier R" note facts = R smult_closed - from facts have "a \\<^sub>2 \\<^sub>2 = (a \\<^sub>2 \\<^sub>2 \\<^sub>2 a \\<^sub>2 \\<^sub>2) \\<^sub>2 \\<^sub>2 (a \\<^sub>2 \\<^sub>2)" + from facts have "a \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> = (a \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> a \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>) \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> (a \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>)" by algebra - also from R have "... = a \\<^sub>2 (\\<^sub>2 \\<^sub>2 \\<^sub>2) \\<^sub>2 \\<^sub>2 (a \\<^sub>2 \\<^sub>2)" + also from R have "... = a \\<^bsub>M\<^esub> (\\<^bsub>M\<^esub> \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>) \\<^bsub>M\<^esub> \\<^bsub>M\<^esub> (a \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>)" by (simp add: smult_r_distr del: M.l_zero M.r_zero) - also from facts have "... = \\<^sub>2" by algebra + also from facts have "... = \\<^bsub>M\<^esub>" by algebra finally show ?thesis . qed lemma (in algebra) smult_l_minus: - "[| a \ carrier R; x \ carrier M |] ==> (\a) \\<^sub>2 x = \\<^sub>2 (a \\<^sub>2 x)" + "[| a \ carrier R; x \ carrier M |] ==> (\a) \\<^bsub>M\<^esub> x = \\<^bsub>M\<^esub> (a \\<^bsub>M\<^esub> x)" proof - assume RM: "a \ carrier R" "x \ carrier M" note facts = RM smult_closed - from facts have "(\a) \\<^sub>2 x = (\a \\<^sub>2 x \\<^sub>2 a \\<^sub>2 x) \\<^sub>2 \\<^sub>2(a \\<^sub>2 x)" by algebra - also from RM have "... = (\a \ a) \\<^sub>2 x \\<^sub>2 \\<^sub>2(a \\<^sub>2 x)" + from facts have "(\a) \\<^bsub>M\<^esub> x = (\a \\<^bsub>M\<^esub> x \\<^bsub>M\<^esub> a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>(a \\<^bsub>M\<^esub> x)" + by algebra + also from RM have "... = (\a \ a) \\<^bsub>M\<^esub> x \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>(a \\<^bsub>M\<^esub> x)" by (simp add: smult_l_distr) - also from facts smult_l_null have "... = \\<^sub>2(a \\<^sub>2 x)" by algebra + also from facts smult_l_null have "... = \\<^bsub>M\<^esub>(a \\<^bsub>M\<^esub> x)" by algebra finally show ?thesis . qed lemma (in algebra) smult_r_minus: - "[| a \ carrier R; x \ carrier M |] ==> a \\<^sub>2 (\\<^sub>2x) = \\<^sub>2 (a \\<^sub>2 x)" + "[| a \ carrier R; x \ carrier M |] ==> a \\<^bsub>M\<^esub> (\\<^bsub>M\<^esub>x) = \\<^bsub>M\<^esub> (a \\<^bsub>M\<^esub> x)" proof - assume RM: "a \ carrier R" "x \ carrier M" note facts = RM smult_closed - from facts have "a \\<^sub>2 (\\<^sub>2x) = (a \\<^sub>2 \\<^sub>2x \\<^sub>2 a \\<^sub>2 x) \\<^sub>2 \\<^sub>2(a \\<^sub>2 x)" + from facts have "a \\<^bsub>M\<^esub> (\\<^bsub>M\<^esub>x) = (a \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>x \\<^bsub>M\<^esub> a \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>(a \\<^bsub>M\<^esub> x)" by algebra - also from RM have "... = a \\<^sub>2 (\\<^sub>2x \\<^sub>2 x) \\<^sub>2 \\<^sub>2(a \\<^sub>2 x)" + also from RM have "... = a \\<^bsub>M\<^esub> (\\<^bsub>M\<^esub>x \\<^bsub>M\<^esub> x) \\<^bsub>M\<^esub> \\<^bsub>M\<^esub>(a \\<^bsub>M\<^esub> x)" by (simp add: smult_r_distr) - also from facts smult_r_null have "... = \\<^sub>2(a \\<^sub>2 x)" by algebra + also from facts smult_r_null have "... = \\<^bsub>M\<^esub>(a \\<^bsub>M\<^esub> x)" by algebra finally show ?thesis . qed 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