src/HOL/Groebner_Basis.thy
changeset 35216 7641e8d831d2
parent 35092 cfe605c54e50
child 35410 1ea89d2a1bd4
equal deleted inserted replaced
35215:a03462cbf86f 35216:7641e8d831d2
   141 next show "add a c = add c a" by (rule add_c)
   141 next show "add a c = add c a" by (rule add_c)
   142 next show "add a (add c d) = add (add a c) d" using add_a by simp
   142 next show "add a (add c d) = add (add a c) d" using add_a by simp
   143 next show "mul (pwr x p) (pwr x q) = pwr x (p + q)" by (rule mul_pwr)
   143 next show "mul (pwr x p) (pwr x q) = pwr x (p + q)" by (rule mul_pwr)
   144 next show "mul x (pwr x q) = pwr x (Suc q)" using pwr_Suc by simp
   144 next show "mul x (pwr x q) = pwr x (Suc q)" using pwr_Suc by simp
   145 next show "mul (pwr x q) x = pwr x (Suc q)" using pwr_Suc mul_c by simp
   145 next show "mul (pwr x q) x = pwr x (Suc q)" using pwr_Suc mul_c by simp
   146 next show "mul x x = pwr x 2" by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
   146 next show "mul x x = pwr x 2" by (simp add: nat_number' pwr_Suc pwr_0 mul_1 mul_c)
   147 next show "pwr (mul x y) q = mul (pwr x q) (pwr y q)" by (rule pwr_mul)
   147 next show "pwr (mul x y) q = mul (pwr x q) (pwr y q)" by (rule pwr_mul)
   148 next show "pwr (pwr x p) q = pwr x (p * q)" by (rule pwr_pwr)
   148 next show "pwr (pwr x p) q = pwr x (p * q)" by (rule pwr_pwr)
   149 next show "pwr x 0 = r1" using pwr_0 .
   149 next show "pwr x 0 = r1" using pwr_0 .
   150 next show "pwr x 1 = x" unfolding One_nat_def by (simp add: nat_number pwr_Suc pwr_0 mul_1 mul_c)
   150 next show "pwr x 1 = x" unfolding One_nat_def by (simp add: nat_number' pwr_Suc pwr_0 mul_1 mul_c)
   151 next show "mul x (add y z) = add (mul x y) (mul x z)" using mul_d by simp
   151 next show "mul x (add y z) = add (mul x y) (mul x z)" using mul_d by simp
   152 next show "pwr x (Suc q) = mul x (pwr x q)" using pwr_Suc by simp
   152 next show "pwr x (Suc q) = mul x (pwr x q)" using pwr_Suc by simp
   153 next show "pwr x (2 * n) = mul (pwr x n) (pwr x n)" by (simp add: nat_number mul_pwr)
   153 next show "pwr x (2 * n) = mul (pwr x n) (pwr x n)" by (simp add: nat_number' mul_pwr)
   154 next show "pwr x (Suc (2 * n)) = mul x (mul (pwr x n) (pwr x n))"
   154 next show "pwr x (Suc (2 * n)) = mul x (mul (pwr x n) (pwr x n))"
   155     by (simp add: nat_number pwr_Suc mul_pwr)
   155     by (simp add: nat_number' pwr_Suc mul_pwr)
   156 qed
   156 qed
   157 
   157 
   158 
   158 
   159 lemmas gb_semiring_axioms' =
   159 lemmas gb_semiring_axioms' =
   160   gb_semiring_axioms [normalizer
   160   gb_semiring_axioms [normalizer
   163 
   163 
   164 end
   164 end
   165 
   165 
   166 interpretation class_semiring: gb_semiring
   166 interpretation class_semiring: gb_semiring
   167     "op +" "op *" "op ^" "0::'a::{comm_semiring_1}" "1"
   167     "op +" "op *" "op ^" "0::'a::{comm_semiring_1}" "1"
   168   proof qed (auto simp add: algebra_simps power_Suc)
   168   proof qed (auto simp add: algebra_simps)
   169 
   169 
   170 lemmas nat_arith =
   170 lemmas nat_arith =
   171   add_nat_number_of
   171   add_nat_number_of
   172   diff_nat_number_of
   172   diff_nat_number_of
   173   mult_nat_number_of
   173   mult_nat_number_of
   174   eq_nat_number_of
   174   eq_nat_number_of
   175   less_nat_number_of
   175   less_nat_number_of
   176 
   176 
   177 lemma not_iszero_Numeral1: "\<not> iszero (Numeral1::'a::number_ring)"
   177 lemma not_iszero_Numeral1: "\<not> iszero (Numeral1::'a::number_ring)"
   178   by (simp add: numeral_1_eq_1)
   178   by simp
   179 
   179 
   180 lemmas comp_arith =
   180 lemmas comp_arith =
   181   Let_def arith_simps nat_arith rel_simps neg_simps if_False
   181   Let_def arith_simps nat_arith rel_simps neg_simps if_False
   182   if_True add_0 add_Suc add_number_of_left mult_number_of_left
   182   if_True add_0 add_Suc add_number_of_left mult_number_of_left
   183   numeral_1_eq_1[symmetric] Suc_eq_plus1
   183   numeral_1_eq_1[symmetric] Suc_eq_plus1
   348   thus "b = 0" by blast
   348   thus "b = 0" by blast
   349 qed
   349 qed
   350 
   350 
   351 interpretation class_ringb: ringb
   351 interpretation class_ringb: ringb
   352   "op +" "op *" "op ^" "0::'a::{idom,number_ring}" "1" "op -" "uminus"
   352   "op +" "op *" "op ^" "0::'a::{idom,number_ring}" "1" "op -" "uminus"
   353 proof(unfold_locales, simp add: algebra_simps power_Suc, auto)
   353 proof(unfold_locales, simp add: algebra_simps, auto)
   354   fix w x y z ::"'a::{idom,number_ring}"
   354   fix w x y z ::"'a::{idom,number_ring}"
   355   assume p: "w * y + x * z = w * z + x * y" and ynz: "y \<noteq> z"
   355   assume p: "w * y + x * z = w * z + x * y" and ynz: "y \<noteq> z"
   356   hence ynz': "y - z \<noteq> 0" by simp
   356   hence ynz': "y - z \<noteq> 0" by simp
   357   from p have "w * y + x* z - w*z - x*y = 0" by simp
   357   from p have "w * y + x* z - w*z - x*y = 0" by simp
   358   hence "w* (y - z) - x * (y - z) = 0" by (simp add: algebra_simps)
   358   hence "w* (y - z) - x * (y - z) = 0" by (simp add: algebra_simps)
   364 
   364 
   365 declaration {* normalizer_funs @{thm class_ringb.ringb_axioms'} *}
   365 declaration {* normalizer_funs @{thm class_ringb.ringb_axioms'} *}
   366 
   366 
   367 interpretation natgb: semiringb
   367 interpretation natgb: semiringb
   368   "op +" "op *" "op ^" "0::nat" "1"
   368   "op +" "op *" "op ^" "0::nat" "1"
   369 proof (unfold_locales, simp add: algebra_simps power_Suc)
   369 proof (unfold_locales, simp add: algebra_simps)
   370   fix w x y z ::"nat"
   370   fix w x y z ::"nat"
   371   { assume p: "w * y + x * z = w * z + x * y" and ynz: "y \<noteq> z"
   371   { assume p: "w * y + x * z = w * z + x * y" and ynz: "y \<noteq> z"
   372     hence "y < z \<or> y > z" by arith
   372     hence "y < z \<or> y > z" by arith
   373     moreover {
   373     moreover {
   374       assume lt:"y <z" hence "\<exists>k. z = y + k \<and> k > 0" by (rule_tac x="z - y" in exI, auto)
   374       assume lt:"y <z" hence "\<exists>k. z = y + k \<and> k > 0" by (rule_tac x="z - y" in exI, auto)
   375       then obtain k where kp: "k>0" and yz:"z = y + k" by blast
   375       then obtain k where kp: "k>0" and yz:"z = y + k" by blast
   376       from p have "(w * y + x *y) + x*k = (w * y + x*y) + w*k" by (simp add: yz algebra_simps)
   376       from p have "(w * y + x *y) + x*k = (w * y + x*y) + w*k" by (simp add: yz algebra_simps)
   377       hence "x*k = w*k" by simp
   377       hence "x*k = w*k" by simp
   378       hence "w = x" using kp by (simp add: mult_cancel2) }
   378       hence "w = x" using kp by simp }
   379     moreover {
   379     moreover {
   380       assume lt: "y >z" hence "\<exists>k. y = z + k \<and> k>0" by (rule_tac x="y - z" in exI, auto)
   380       assume lt: "y >z" hence "\<exists>k. y = z + k \<and> k>0" by (rule_tac x="y - z" in exI, auto)
   381       then obtain k where kp: "k>0" and yz:"y = z + k" by blast
   381       then obtain k where kp: "k>0" and yz:"y = z + k" by blast
   382       from p have "(w * z + x *z) + w*k = (w * z + x*z) + x*k" by (simp add: yz algebra_simps)
   382       from p have "(w * z + x *z) + w*k = (w * z + x*z) + x*k" by (simp add: yz algebra_simps)
   383       hence "w*k = x*k" by simp
   383       hence "w*k = x*k" by simp
   384       hence "w = x" using kp by (simp add: mult_cancel2)}
   384       hence "w = x" using kp by simp }
   385     ultimately have "w=x" by blast }
   385     ultimately have "w=x" by blast }
   386   thus "(w * y + x * z = w * z + x * y) = (w = x \<or> y = z)" by auto
   386   thus "(w * y + x * z = w * z + x * y) = (w = x \<or> y = z)" by auto
   387 qed
   387 qed
   388 
   388 
   389 declaration {* normalizer_funs @{thm natgb.semiringb_axioms'} *}
   389 declaration {* normalizer_funs @{thm natgb.semiringb_axioms'} *}