# HG changeset patch # User wenzelm # Date 1470164734 -7200 # Node ID d0e2bad67bd467ca67929d7f5170f9478e091d20 # Parent 881e8e2cfec2d959c65af9442fe9066d485b0bcf misc tuning and modernization; diff -r 881e8e2cfec2 -r d0e2bad67bd4 src/HOL/Fun.thy --- a/src/HOL/Fun.thy Tue Aug 02 21:04:52 2016 +0200 +++ b/src/HOL/Fun.thy Tue Aug 02 21:05:34 2016 +0200 @@ -410,8 +410,8 @@ by (auto simp: bij_betw_def) qed -lemma bij_betw_cong: "(\ a. a \ A \ f a = g a) \ bij_betw f A A' = bij_betw g A A'" - unfolding bij_betw_def inj_on_def by force +lemma bij_betw_cong: "(\a. a \ A \ f a = g a) \ bij_betw f A A' = bij_betw g A A'" + unfolding bij_betw_def inj_on_def by force (* slow *) lemma bij_betw_id[intro, simp]: "bij_betw id A A" unfolding bij_betw_def id_def by auto diff -r 881e8e2cfec2 -r d0e2bad67bd4 src/HOL/Groups.thy --- a/src/HOL/Groups.thy Tue Aug 02 21:04:52 2016 +0200 +++ b/src/HOL/Groups.thy Tue Aug 02 21:05:34 2016 +0200 @@ -1,48 +1,46 @@ -(* Title: HOL/Groups.thy - Author: Gertrud Bauer, Steven Obua, Lawrence C Paulson, Markus Wenzel, Jeremy Avigad +(* Title: HOL/Groups.thy + Author: Gertrud Bauer + Author: Steven Obua + Author: Lawrence C Paulson + Author: Markus Wenzel + Author: Jeremy Avigad *) section \Groups, also combined with orderings\ theory Groups -imports Orderings + imports Orderings begin subsection \Dynamic facts\ named_theorems ac_simps "associativity and commutativity simplification rules" - + and algebra_simps "algebra simplification rules" + and field_simps "algebra simplification rules for fields" text \ - The rewrites accumulated in \algebra_simps\ deal with the - classical algebraic structures of groups, rings and family. They simplify - terms by multiplying everything out (in case of a ring) and bringing sums and - products into a canonical form (by ordered rewriting). As a result it decides - group and ring equalities but also helps with inequalities. - - Of course it also works for fields, but it knows nothing about multiplicative - inverses or division. This is catered for by \field_simps\. -\ + The rewrites accumulated in \algebra_simps\ deal with the classical + algebraic structures of groups, rings and family. They simplify terms by + multiplying everything out (in case of a ring) and bringing sums and + products into a canonical form (by ordered rewriting). As a result it + decides group and ring equalities but also helps with inequalities. -named_theorems algebra_simps "algebra simplification rules" - + Of course it also works for fields, but it knows nothing about + multiplicative inverses or division. This is catered for by \field_simps\. -text \ - Lemmas \field_simps\ multiply with denominators in (in)equations - if they can be proved to be non-zero (for equations) or positive/negative - (for inequations). Can be too aggressive and is therefore separate from the - more benign \algebra_simps\. + Facts in \field_simps\ multiply with denominators in (in)equations if they + can be proved to be non-zero (for equations) or positive/negative (for + inequalities). Can be too aggressive and is therefore separate from the more + benign \algebra_simps\. \ -named_theorems field_simps "algebra simplification rules for fields" - subsection \Abstract structures\ text \ - These locales provide basic structures for interpretation into - bigger structures; extensions require careful thinking, otherwise - undesired effects may occur due to interpretation. + These locales provide basic structures for interpretation into bigger + structures; extensions require careful thinking, otherwise undesired effects + may occur due to interpretation. \ locale semigroup = @@ -114,16 +112,13 @@ by (simp add: assoc [symmetric]) qed -lemma inverse_neutral [simp]: - "inverse \<^bold>1 = \<^bold>1" +lemma inverse_neutral [simp]: "inverse \<^bold>1 = \<^bold>1" by (rule inverse_unique) simp -lemma inverse_inverse [simp]: - "inverse (inverse a) = a" +lemma inverse_inverse [simp]: "inverse (inverse a) = a" by (rule inverse_unique) simp -lemma right_inverse [simp]: - "a \<^bold>* inverse a = \<^bold>1" +lemma right_inverse [simp]: "a \<^bold>* inverse a = \<^bold>1" proof - have "a \<^bold>* inverse a = inverse (inverse a) \<^bold>* inverse a" by simp @@ -132,8 +127,7 @@ then show ?thesis by simp qed -lemma inverse_distrib_swap: - "inverse (a \<^bold>* b) = inverse b \<^bold>* inverse a" +lemma inverse_distrib_swap: "inverse (a \<^bold>* b) = inverse b \<^bold>* inverse a" proof (rule inverse_unique) have "a \<^bold>* b \<^bold>* (inverse b \<^bold>* inverse a) = a \<^bold>* (b \<^bold>* inverse b) \<^bold>* inverse a" @@ -143,8 +137,7 @@ finally show "a \<^bold>* b \<^bold>* (inverse b \<^bold>* inverse a) = \<^bold>1" . qed -lemma right_cancel: - "b \<^bold>* a = c \<^bold>* a \ b = c" +lemma right_cancel: "b \<^bold>* a = c \<^bold>* a \ b = c" proof assume "b \<^bold>* a = c \<^bold>* a" then have "b \<^bold>* a \<^bold>* inverse a= c \<^bold>* a \<^bold>* inverse a" @@ -435,10 +428,8 @@ sublocale add: group plus 0 uminus by standard (simp_all add: left_minus) -lemma minus_unique: - assumes "a + b = 0" - shows "- a = b" - using assms by (fact add.inverse_unique) +lemma minus_unique: "a + b = 0 \ - a = b" + by (fact add.inverse_unique) lemma minus_zero: "- 0 = 0" by (fact add.inverse_neutral) @@ -701,8 +692,8 @@ lemma add_le_cancel_left [simp]: "c + a \ c + b \ a \ b" apply auto - apply (drule add_le_imp_le_left) - apply (simp_all add: add_left_mono) + apply (drule add_le_imp_le_left) + apply (simp_all add: add_left_mono) done lemma add_le_cancel_right [simp]: "a + c \ b + c \ a \ b" @@ -803,36 +794,28 @@ class ordered_ab_semigroup_monoid_add_imp_le = monoid_add + ordered_ab_semigroup_add_imp_le begin -lemma add_less_same_cancel1 [simp]: - "b + a < b \ a < 0" +lemma add_less_same_cancel1 [simp]: "b + a < b \ a < 0" using add_less_cancel_left [of _ _ 0] by simp -lemma add_less_same_cancel2 [simp]: - "a + b < b \ a < 0" +lemma add_less_same_cancel2 [simp]: "a + b < b \ a < 0" using add_less_cancel_right [of _ _ 0] by simp -lemma less_add_same_cancel1 [simp]: - "a < a + b \ 0 < b" +lemma less_add_same_cancel1 [simp]: "a < a + b \ 0 < b" using add_less_cancel_left [of _ 0] by simp -lemma less_add_same_cancel2 [simp]: - "a < b + a \ 0 < b" +lemma less_add_same_cancel2 [simp]: "a < b + a \ 0 < b" using add_less_cancel_right [of 0] by simp -lemma add_le_same_cancel1 [simp]: - "b + a \ b \ a \ 0" +lemma add_le_same_cancel1 [simp]: "b + a \ b \ a \ 0" using add_le_cancel_left [of _ _ 0] by simp -lemma add_le_same_cancel2 [simp]: - "a + b \ b \ a \ 0" +lemma add_le_same_cancel2 [simp]: "a + b \ b \ a \ 0" using add_le_cancel_right [of _ _ 0] by simp -lemma le_add_same_cancel1 [simp]: - "a \ a + b \ 0 \ b" +lemma le_add_same_cancel1 [simp]: "a \ a + b \ 0 \ b" using add_le_cancel_left [of _ 0] by simp -lemma le_add_same_cancel2 [simp]: - "a \ b + a \ 0 \ b" +lemma le_add_same_cancel2 [simp]: "a \ b + a \ 0 \ b" using add_le_cancel_right [of 0] by simp subclass cancel_comm_monoid_add @@ -911,7 +894,7 @@ lemma less_minus_iff: "a < - b \ b < - a" proof - - have "- (-a) < - b \ b < - a" + have "- (- a) < - b \ b < - a" by (rule neg_less_iff_less) then show ?thesis by simp qed @@ -925,12 +908,12 @@ lemma le_minus_iff: "a \ - b \ b \ - a" proof - - have mm: "- (- a) < -b \ - (- b) < -a" for a b :: 'a + have mm: "- (- a) < - b \ - (- b) < -a" for a b :: 'a by (simp only: minus_less_iff) - have "- (- a) \ -b \ b \ - a" + have "- (- a) \ - b \ b \ - a" apply (auto simp only: le_less) - apply (drule mm) - apply (simp_all) + apply (drule mm) + apply (simp_all) apply (drule mm[simplified], assumption) done then show ?thesis by simp @@ -1039,11 +1022,11 @@ proof (rule ccontr) assume *: "\ ?thesis" then have "b \ a" by (simp add: linorder_not_le) - then have le2: "c + b \ c + a" by (rule add_left_mono) - have "a = b" - apply (insert le1 le2) + then have "c + b \ c + a" by (rule add_left_mono) + with le1 have "a = b" + apply - apply (drule antisym) - apply simp_all + apply simp_all done with * show False by (simp add: linorder_not_le [symmetric]) @@ -1117,8 +1100,8 @@ lemma double_zero_sym [simp]: "0 = a + a \ a = 0" apply (rule iffI) - apply (drule sym) - apply simp_all + apply (drule sym) + apply simp_all done lemma zero_less_double_add_iff_zero_less_single_add [simp]: "0 < a + a \ 0 < a" @@ -1342,7 +1325,7 @@ fixes x::"'a::{dense_linorder,ordered_ab_group_add_abs}" shows "(\e. 0 < e \ \x\ \ e) \ x = 0" apply (cases "\x\ = 0") - apply simp + apply simp apply (simp only: zero_less_abs_iff [symmetric]) apply (drule dense) apply (auto simp add: not_less [symmetric]) @@ -1402,7 +1385,7 @@ begin context - fixes a b + fixes a b :: 'a assumes le: "a \ b" begin diff -r 881e8e2cfec2 -r d0e2bad67bd4 src/HOL/Inductive.thy --- a/src/HOL/Inductive.thy Tue Aug 02 21:04:52 2016 +0200 +++ b/src/HOL/Inductive.thy Tue Aug 02 21:05:34 2016 +0200 @@ -5,13 +5,13 @@ section \Knaster-Tarski Fixpoint Theorem and inductive definitions\ theory Inductive -imports Complete_Lattices Ctr_Sugar -keywords - "inductive" "coinductive" "inductive_cases" "inductive_simps" :: thy_decl and - "monos" and - "print_inductives" :: diag and - "old_rep_datatype" :: thy_goal and - "primrec" :: thy_decl + imports Complete_Lattices Ctr_Sugar + keywords + "inductive" "coinductive" "inductive_cases" "inductive_simps" :: thy_decl and + "monos" and + "print_inductives" :: diag and + "old_rep_datatype" :: thy_goal and + "primrec" :: thy_decl begin subsection \Least and greatest fixed points\ @@ -50,8 +50,8 @@ lemma lfp_const: "lfp (\x. t) = t" by (rule lfp_unfold) (simp add: mono_def) -lemma lfp_eqI: "\ mono F; F x = x; \z. F z = z \ x \ z \ \ lfp F = x" -by (rule antisym) (simp_all add: lfp_lowerbound lfp_unfold[symmetric]) +lemma lfp_eqI: "mono F \ F x = x \ (\z. F z = z \ x \ z) \ lfp F = x" + by (rule antisym) (simp_all add: lfp_lowerbound lfp_unfold[symmetric]) subsection \General induction rules for least fixed points\ @@ -64,10 +64,11 @@ shows "P (lfp f)" proof - let ?M = "{S. S \ lfp f \ P S}" - have "P (Sup ?M)" using P_Union by simp + from P_Union have "P (Sup ?M)" by simp also have "Sup ?M = lfp f" proof (rule antisym) - show "Sup ?M \ lfp f" by (blast intro: Sup_least) + show "Sup ?M \ lfp f" + by (blast intro: Sup_least) then have "f (Sup ?M) \ f (lfp f)" by (rule mono [THEN monoD]) then have "f (Sup ?M) \ lfp f" @@ -86,11 +87,18 @@ assumes mono: "mono f" and ind: "f (inf (lfp f) P) \ P" shows "lfp f \ P" -proof (induction rule: lfp_ordinal_induct) +proof (induct rule: lfp_ordinal_induct) + case mono + show ?case by fact +next case (step S) then show ?case by (intro order_trans[OF _ ind] monoD[OF mono]) auto -qed (auto intro: mono Sup_least) +next + case (union M) + then show ?case + by (auto intro: Sup_least) +qed lemma lfp_induct_set: assumes lfp: "a \ lfp f" @@ -144,10 +152,10 @@ by (iprover intro: order_antisym gfp_lemma2 gfp_lemma3) lemma gfp_const: "gfp (\x. t) = t" -by (rule gfp_unfold) (simp add: mono_def) + by (rule gfp_unfold) (simp add: mono_def) -lemma gfp_eqI: "\ mono F; F x = x; \z. F z = z \ z \ x \ \ gfp F = x" -by (rule antisym) (simp_all add: gfp_upperbound gfp_unfold[symmetric]) +lemma gfp_eqI: "mono F \ F x = x \ (\z. F z = z \ z \ x) \ gfp F = x" + by (rule antisym) (simp_all add: gfp_upperbound gfp_unfold[symmetric]) subsection \Coinduction rules for greatest fixed points\ @@ -165,11 +173,11 @@ apply (frule gfp_lemma2) apply (drule mono_sup) apply (rule le_supI) - apply assumption - apply (rule order_trans) + apply assumption apply (rule order_trans) - apply assumption - apply (rule sup_ge2) + apply (rule order_trans) + apply assumption + apply (rule sup_ge2) apply assumption done @@ -188,7 +196,7 @@ shows "P (gfp f)" proof - let ?M = "{S. gfp f \ S \ P S}" - have "P (Inf ?M)" using P_Union by simp + from P_Union have "P (Inf ?M)" by simp also have "Inf ?M = gfp f" proof (rule antisym) show "gfp f \ Inf ?M" @@ -211,10 +219,18 @@ assumes mono: "mono f" and ind: "X \ f (sup X (gfp f))" shows "X \ gfp f" -proof (induction rule: gfp_ordinal_induct) - case (step S) then show ?case +proof (induct rule: gfp_ordinal_induct) + case mono + then show ?case by fact +next + case (step S) + then show ?case by (intro order_trans[OF ind _] monoD[OF mono]) auto -qed (auto intro: mono Inf_greatest) +next + case (union M) + then show ?case + by (auto intro: mono Inf_greatest) +qed subsection \Even Stronger Coinduction Rule, by Martin Coen\ @@ -228,9 +244,9 @@ "X \ f (lfp (\x. f x \ X \ gfp f)) \ mono f \ lfp (\x. f x \ X \ gfp f) \ f (lfp (\x. f x \ X \ gfp f))" apply (rule subset_trans) - apply (erule coinduct3_mono_lemma [THEN lfp_lemma3]) + apply (erule coinduct3_mono_lemma [THEN lfp_lemma3]) apply (rule Un_least [THEN Un_least]) - apply (rule subset_refl, assumption) + apply (rule subset_refl, assumption) apply (rule gfp_unfold [THEN equalityD1, THEN subset_trans], assumption) apply (rule monoD, assumption) apply (subst coinduct3_mono_lemma [THEN lfp_unfold], auto) @@ -238,8 +254,8 @@ lemma coinduct3: "mono f \ a \ X \ X \ f (lfp (\x. f x \ X \ gfp f)) \ a \ gfp f" apply (rule coinduct3_lemma [THEN [2] weak_coinduct]) - apply (rule coinduct3_mono_lemma [THEN lfp_unfold, THEN ssubst]) - apply simp_all + apply (rule coinduct3_mono_lemma [THEN lfp_unfold, THEN ssubst]) + apply simp_all done text \Definition forms of \gfp_unfold\ and \coinduct\, to control unfolding.\ diff -r 881e8e2cfec2 -r d0e2bad67bd4 src/HOL/Lattices.thy --- a/src/HOL/Lattices.thy Tue Aug 02 21:04:52 2016 +0200 +++ b/src/HOL/Lattices.thy Tue Aug 02 21:05:34 2016 +0200 @@ -47,12 +47,10 @@ sublocale ordering less_eq less proof - fix a b show "a \<^bold>< b \ a \<^bold>\ b \ a \ b" for a b by (simp add: order_iff strict_order_iff) next - fix a - show "a \<^bold>\ a" + show "a \<^bold>\ a" for a by (simp add: order_iff) next fix a b @@ -83,8 +81,10 @@ assumes "a \<^bold>\ b" and "a \<^bold>\ c" shows "a \<^bold>\ b \<^bold>* c" proof (rule orderI) - from assms obtain "a \<^bold>* b = a" and "a \<^bold>* c = a" by (auto elim!: orderE) - then show "a = a \<^bold>* (b \<^bold>* c)" by (simp add: assoc [symmetric]) + from assms obtain "a \<^bold>* b = a" and "a \<^bold>* c = a" + by (auto elim!: orderE) + then show "a = a \<^bold>* (b \<^bold>* c)" + by (simp add: assoc [symmetric]) qed lemma boundedE: @@ -108,7 +108,8 @@ lemma strict_coboundedI1: "a \<^bold>< c \ a \<^bold>* b \<^bold>< c" using irrefl - by (auto intro: not_eq_order_implies_strict coboundedI1 strict_implies_order elim: strict_boundedE) + by (auto intro: not_eq_order_implies_strict coboundedI1 strict_implies_order + elim: strict_boundedE) lemma strict_coboundedI2: "b \<^bold>< c \ a \<^bold>* b \<^bold>< c" using strict_coboundedI1 [of b c a] by (simp add: commute) @@ -117,10 +118,10 @@ by (blast intro: boundedI coboundedI1 coboundedI2) lemma absorb1: "a \<^bold>\ b \ a \<^bold>* b = a" - by (rule antisym) (auto simp add: refl) + by (rule antisym) (auto simp: refl) lemma absorb2: "b \<^bold>\ a \ a \<^bold>* b = b" - by (rule antisym) (auto simp add: refl) + by (rule antisym) (auto simp: refl) lemma absorb_iff1: "a \<^bold>\ b \ a \<^bold>* b = a" using order_iff by auto @@ -165,8 +166,7 @@ and sup_least: "y \ x \ z \ x \ y \ z \ x" begin -text \Dual lattice\ - +text \Dual lattice.\ lemma dual_semilattice: "class.semilattice_inf sup greater_eq greater" by (rule class.semilattice_inf.intro, rule dual_order) (unfold_locales, simp_all add: sup_least) @@ -330,7 +330,10 @@ begin lemma dual_lattice: "class.lattice sup (op \) (op >) inf" - by (rule class.lattice.intro, rule dual_semilattice, rule class.semilattice_sup.intro, rule dual_order) + by (rule class.lattice.intro, + rule dual_semilattice, + rule class.semilattice_sup.intro, + rule dual_order) (unfold_locales, auto) lemma inf_sup_absorb [simp]: "x \ (x \ y) = x" @@ -343,7 +346,7 @@ lemmas inf_sup_ord = inf_le1 inf_le2 sup_ge1 sup_ge2 -text\Towards distributivity\ +text \Towards distributivity.\ lemma distrib_sup_le: "x \ (y \ z) \ (x \ y) \ (x \ z)" by (auto intro: le_infI1 le_infI2 le_supI1 le_supI2) @@ -533,7 +536,9 @@ lemma dual_boolean_algebra: "class.boolean_algebra (\x y. x \ - y) uminus sup greater_eq greater inf \ \" - by (rule class.boolean_algebra.intro, rule dual_bounded_lattice, rule dual_distrib_lattice) + by (rule class.boolean_algebra.intro, + rule dual_bounded_lattice, + rule dual_distrib_lattice) (unfold_locales, auto simp add: inf_compl_bot sup_compl_top diff_eq) lemma compl_inf_bot [simp]: "- x \ x = \" @@ -645,7 +650,8 @@ assumes "- y \ x" shows "- x \ y" proof - - from assms have "- x \ - (- y)" by (simp only: compl_less_compl_iff) + from assms have "- x \ - (- y)" + by (simp only: compl_less_compl_iff) then show ?thesis by simp qed @@ -661,7 +667,8 @@ lemma inf_cancel_left2: "inf (inf (- x) a) (inf x b) = bot" by (simp add: inf_sup_aci inf_compl_bot) -declare inf_compl_bot [simp] and sup_compl_top [simp] +declare inf_compl_bot [simp] + and sup_compl_top [simp] lemma sup_compl_top_left1 [simp]: "sup (- x) (sup x y) = top" by (simp add: sup_assoc[symmetric]) @@ -821,7 +828,8 @@ lemma sup_apply [simp, code]: "(f \ g) x = f x \ g x" by (simp add: sup_fun_def) -instance by standard (simp_all add: le_fun_def) +instance + by standard (simp_all add: le_fun_def) end diff -r 881e8e2cfec2 -r d0e2bad67bd4 src/HOL/Nat.thy --- a/src/HOL/Nat.thy Tue Aug 02 21:04:52 2016 +0200 +++ b/src/HOL/Nat.thy Tue Aug 02 21:05:34 2016 +0200 @@ -1,5 +1,7 @@ (* Title: HOL/Nat.thy - Author: Tobias Nipkow and Lawrence C Paulson and Markus Wenzel + Author: Tobias Nipkow + Author: Lawrence C Paulson + Author: Markus Wenzel Type "nat" is a linear order, and a datatype; arithmetic operators + - and * (for div and mod, see theory Divides). @@ -8,7 +10,7 @@ section \Natural numbers\ theory Nat -imports Inductive Typedef Fun Rings + imports Inductive Typedef Fun Rings begin named_theorems arith "arith facts -- only ground formulas" @@ -21,75 +23,70 @@ axiomatization Zero_Rep :: ind and Suc_Rep :: "ind \ ind" \ \The axiom of infinity in 2 parts:\ -where Suc_Rep_inject: "Suc_Rep x = Suc_Rep y \ x = y" - and Suc_Rep_not_Zero_Rep: "Suc_Rep x \ Zero_Rep" + where Suc_Rep_inject: "Suc_Rep x = Suc_Rep y \ x = y" + and Suc_Rep_not_Zero_Rep: "Suc_Rep x \ Zero_Rep" + subsection \Type nat\ text \Type definition\ -inductive Nat :: "ind \ bool" where - Zero_RepI: "Nat Zero_Rep" -| Suc_RepI: "Nat i \ Nat (Suc_Rep i)" +inductive Nat :: "ind \ bool" + where + Zero_RepI: "Nat Zero_Rep" + | Suc_RepI: "Nat i \ Nat (Suc_Rep i)" typedef nat = "{n. Nat n}" morphisms Rep_Nat Abs_Nat using Nat.Zero_RepI by auto -lemma Nat_Rep_Nat: - "Nat (Rep_Nat n)" +lemma Nat_Rep_Nat: "Nat (Rep_Nat n)" using Rep_Nat by simp -lemma Nat_Abs_Nat_inverse: - "Nat n \ Rep_Nat (Abs_Nat n) = n" +lemma Nat_Abs_Nat_inverse: "Nat n \ Rep_Nat (Abs_Nat n) = n" using Abs_Nat_inverse by simp -lemma Nat_Abs_Nat_inject: - "Nat n \ Nat m \ Abs_Nat n = Abs_Nat m \ n = m" +lemma Nat_Abs_Nat_inject: "Nat n \ Nat m \ Abs_Nat n = Abs_Nat m \ n = m" using Abs_Nat_inject by simp instantiation nat :: zero begin -definition Zero_nat_def: - "0 = Abs_Nat Zero_Rep" +definition Zero_nat_def: "0 = Abs_Nat Zero_Rep" instance .. end -definition Suc :: "nat \ nat" where - "Suc n = Abs_Nat (Suc_Rep (Rep_Nat n))" +definition Suc :: "nat \ nat" + where "Suc n = Abs_Nat (Suc_Rep (Rep_Nat n))" lemma Suc_not_Zero: "Suc m \ 0" - by (simp add: Zero_nat_def Suc_def Suc_RepI Zero_RepI Nat_Abs_Nat_inject Suc_Rep_not_Zero_Rep Nat_Rep_Nat) + by (simp add: Zero_nat_def Suc_def Suc_RepI Zero_RepI + Nat_Abs_Nat_inject Suc_Rep_not_Zero_Rep Nat_Rep_Nat) lemma Zero_not_Suc: "0 \ Suc m" - by (rule not_sym, rule Suc_not_Zero not_sym) + by (rule not_sym) (rule Suc_not_Zero) lemma Suc_Rep_inject': "Suc_Rep x = Suc_Rep y \ x = y" by (rule iffI, rule Suc_Rep_inject) simp_all lemma nat_induct0: - fixes n - assumes "P 0" and "\n. P n \ P (Suc n)" + assumes "P 0" + and "\n. P n \ P (Suc n)" shows "P n" -using assms -apply (unfold Zero_nat_def Suc_def) -apply (rule Rep_Nat_inverse [THEN subst]) \ \types force good instantiation\ -apply (erule Nat_Rep_Nat [THEN Nat.induct]) -apply (iprover elim: Nat_Abs_Nat_inverse [THEN subst]) -done - -free_constructors case_nat for - "0 :: nat" - | Suc pred -where - "pred (0 :: nat) = (0 :: nat)" + using assms + apply (unfold Zero_nat_def Suc_def) + apply (rule Rep_Nat_inverse [THEN subst]) \ \types force good instantiation\ + apply (erule Nat_Rep_Nat [THEN Nat.induct]) + apply (iprover elim: Nat_Abs_Nat_inverse [THEN subst]) + done + +free_constructors case_nat for "0 :: nat" | Suc pred + where "pred (0 :: nat) = (0 :: nat)" apply atomize_elim apply (rename_tac n, induct_tac n rule: nat_induct0, auto) - apply (simp add: Suc_def Nat_Abs_Nat_inject Nat_Rep_Nat Suc_RepI Suc_Rep_inject' - Rep_Nat_inject) + apply (simp add: Suc_def Nat_Abs_Nat_inject Nat_Rep_Nat Suc_RepI Suc_Rep_inject' Rep_Nat_inject) apply (simp only: Suc_not_Zero) done @@ -97,19 +94,19 @@ setup \Sign.mandatory_path "old"\ old_rep_datatype "0 :: nat" Suc - apply (erule nat_induct0, assumption) - apply (rule nat.inject) -apply (rule nat.distinct(1)) -done + apply (erule nat_induct0) + apply assumption + apply (rule nat.inject) + apply (rule nat.distinct(1)) + done setup \Sign.parent_path\ \ \But erase the prefix for properties that are not generated by \free_constructors\.\ setup \Sign.mandatory_path "nat"\ -declare - old.nat.inject[iff del] - old.nat.distinct(1)[simp del, induct_simp del] +declare old.nat.inject[iff del] + and old.nat.distinct(1)[simp del, induct_simp del] lemmas induct = old.nat.induct lemmas inducts = old.nat.inducts @@ -134,16 +131,16 @@ nat.split_sel_asm lemma nat_exhaust [case_names 0 Suc, cases type: nat]: + "(y = 0 \ P) \ (\nat. y = Suc nat \ P) \ P" \ \for backward compatibility -- names of variables differ\ - "(y = 0 \ P) \ (\nat. y = Suc nat \ P) \ P" -by (rule old.nat.exhaust) + by (rule old.nat.exhaust) lemma nat_induct [case_names 0 Suc, induct type: nat]: - \ \for backward compatibility -- names of variables differ\ fixes n assumes "P 0" and "\n. P n \ P (Suc n)" shows "P n" -using assms by (rule nat.induct) + \ \for backward compatibility -- names of variables differ\ + using assms by (rule nat.induct) hide_fact nat_exhaust @@ -180,35 +177,40 @@ by (simp add: inj_on_def) lemma Suc_neq_Zero: "Suc m = 0 \ R" -by (rule notE, rule Suc_not_Zero) + by (rule notE) (rule Suc_not_Zero) lemma Zero_neq_Suc: "0 = Suc m \ R" -by (rule Suc_neq_Zero, erule sym) + by (rule Suc_neq_Zero) (erule sym) lemma Suc_inject: "Suc x = Suc y \ x = y" -by (rule inj_Suc [THEN injD]) + by (rule inj_Suc [THEN injD]) lemma n_not_Suc_n: "n \ Suc n" -by (induct n) simp_all + by (induct n) simp_all lemma Suc_n_not_n: "Suc n \ n" -by (rule not_sym, rule n_not_Suc_n) - -text \A special form of induction for reasoning - about @{term "m < n"} and @{term "m - n"}\ - + by (rule not_sym) (rule n_not_Suc_n) + +text \A special form of induction for reasoning about @{term "m < n"} and @{term "m - n"}.\ lemma diff_induct: assumes "\x. P x 0" and "\y. P 0 (Suc y)" and "\x y. P x y \ P (Suc x) (Suc y)" shows "P m n" - using assms - apply (rule_tac x = m in spec) - apply (induct n) - prefer 2 - apply (rule allI) - apply (induct_tac x, iprover+) - done +proof (induct n arbitrary: m) + case 0 + show ?case by (rule assms(1)) +next + case (Suc n) + show ?case + proof (induct m) + case 0 + show ?case by (rule assms(2)) + next + case (Suc m) + from \P m n\ show ?case by (rule assms(3)) + qed +qed subsection \Arithmetic operators\ @@ -216,11 +218,13 @@ instantiation nat :: comm_monoid_diff begin -primrec plus_nat where - add_0: "0 + n = (n::nat)" -| add_Suc: "Suc m + n = Suc (m + n)" - -lemma add_0_right [simp]: "m + 0 = m" for m :: nat +primrec plus_nat + where + add_0: "0 + n = (n::nat)" + | add_Suc: "Suc m + n = Suc (m + n)" + +lemma add_0_right [simp]: "m + 0 = m" + for m :: nat by (induct m) simp_all lemma add_Suc_right [simp]: "m + Suc n = Suc (m + n)" @@ -231,13 +235,15 @@ lemma add_Suc_shift [code]: "Suc m + n = m + Suc n" by simp -primrec minus_nat where - diff_0 [code]: "m - 0 = (m::nat)" -| diff_Suc: "m - Suc n = (case m - n of 0 \ 0 | Suc k \ k)" +primrec minus_nat + where + diff_0 [code]: "m - 0 = (m::nat)" + | diff_Suc: "m - Suc n = (case m - n of 0 \ 0 | Suc k \ k)" declare diff_Suc [simp del] -lemma diff_0_eq_0 [simp, code]: "0 - n = 0" for n :: nat +lemma diff_0_eq_0 [simp, code]: "0 - n = 0" + for n :: nat by (induct n) (simp_all add: diff_Suc) lemma diff_Suc_Suc [simp, code]: "Suc m - Suc n = m - n" @@ -261,30 +267,37 @@ instantiation nat :: comm_semiring_1_cancel begin -definition - One_nat_def [simp]: "1 = Suc 0" - -primrec times_nat where - mult_0: "0 * n = (0::nat)" -| mult_Suc: "Suc m * n = n + (m * n)" - -lemma mult_0_right [simp]: "m * 0 = 0" for m :: nat +definition One_nat_def [simp]: "1 = Suc 0" + +primrec times_nat + where + mult_0: "0 * n = (0::nat)" + | mult_Suc: "Suc m * n = n + (m * n)" + +lemma mult_0_right [simp]: "m * 0 = 0" + for m :: nat by (induct m) simp_all lemma mult_Suc_right [simp]: "m * Suc n = m + (m * n)" by (induct m) (simp_all add: add.left_commute) -lemma add_mult_distrib: "(m + n) * k = (m * k) + (n * k)" for m n k :: nat +lemma add_mult_distrib: "(m + n) * k = (m * k) + (n * k)" + for m n k :: nat by (induct m) (simp_all add: add.assoc) instance proof fix k n m q :: nat - show "0 \ (1::nat)" unfolding One_nat_def by simp - show "1 * n = n" unfolding One_nat_def by simp - show "n * m = m * n" by (induct n) simp_all - show "(n * m) * q = n * (m * q)" by (induct n) (simp_all add: add_mult_distrib) - show "(n + m) * q = n * q + m * q" by (rule add_mult_distrib) + show "0 \ (1::nat)" + by simp + show "1 * n = n" + by simp + show "n * m = m * n" + by (induct n) simp_all + show "(n * m) * q = n * (m * q)" + by (induct n) (simp_all add: add_mult_distrib) + show "(n + m) * q = n * q + m * q" + by (rule add_mult_distrib) show "k * (m - n) = (k * m) - (k * n)" by (induct m n rule: diff_induct) simp_all qed @@ -296,7 +309,8 @@ text \Reasoning about \m + 0 = 0\, etc.\ -lemma add_is_0 [iff]: "(m + n = 0) = (m = 0 \ n = 0)" for m n :: nat +lemma add_is_0 [iff]: "m + n = 0 \ m = 0 \ n = 0" + for m n :: nat by (cases m) simp_all lemma add_is_1: "m + n = Suc 0 \ m = Suc 0 \ n = 0 | m = 0 \ n = Suc 0" @@ -305,21 +319,26 @@ lemma one_is_add: "Suc 0 = m + n \ m = Suc 0 \ n = 0 | m = 0 \ n = Suc 0" by (rule trans, rule eq_commute, rule add_is_1) -lemma add_eq_self_zero: "m + n = m \ n = 0" for m n :: nat +lemma add_eq_self_zero: "m + n = m \ n = 0" + for m n :: nat by (induct m) simp_all -lemma inj_on_add_nat[simp]: "inj_on (\n. n + k) N" for k :: nat - apply (induct k) - apply simp - apply (drule comp_inj_on[OF _ inj_Suc]) - apply (simp add: o_def) - done +lemma inj_on_add_nat [simp]: "inj_on (\n. n + k) N" + for k :: nat +proof (induct k) + case 0 + then show ?case by simp +next + case (Suc k) + show ?case + using comp_inj_on [OF Suc inj_Suc] by (simp add: o_def) +qed lemma Suc_eq_plus1: "Suc n = n + 1" - unfolding One_nat_def by simp + by simp lemma Suc_eq_plus1_left: "Suc n = 1 + n" - unfolding One_nat_def by simp + by simp subsubsection \Difference\ @@ -328,7 +347,8 @@ by (simp add: diff_diff_add) lemma diff_Suc_1 [simp]: "Suc n - 1 = n" - unfolding One_nat_def by simp + by simp + subsubsection \Multiplication\ @@ -336,24 +356,30 @@ by (induct m) auto lemma mult_eq_1_iff [simp]: "m * n = Suc 0 \ m = Suc 0 \ n = Suc 0" - apply (induct m) - apply simp - apply (induct n) - apply auto - done +proof (induct m) + case 0 + then show ?case by simp +next + case (Suc m) + then show ?case by (induct n) auto +qed lemma one_eq_mult_iff [simp]: "Suc 0 = m * n \ m = Suc 0 \ n = Suc 0" apply (rule trans) - apply (rule_tac [2] mult_eq_1_iff, fastforce) + apply (rule_tac [2] mult_eq_1_iff) + apply fastforce done -lemma nat_mult_eq_1_iff [simp]: "m * n = 1 \ m = 1 \ n = 1" for m n :: nat +lemma nat_mult_eq_1_iff [simp]: "m * n = 1 \ m = 1 \ n = 1" + for m n :: nat unfolding One_nat_def by (rule mult_eq_1_iff) -lemma nat_1_eq_mult_iff [simp]: "1 = m * n \ m = 1 \ n = 1" for m n :: nat +lemma nat_1_eq_mult_iff [simp]: "1 = m * n \ m = 1 \ n = 1" + for m n :: nat unfolding One_nat_def by (rule one_eq_mult_iff) -lemma mult_cancel1 [simp]: "k * m = k * n \ m = n \ k = 0" for k m n :: nat +lemma mult_cancel1 [simp]: "k * m = k * n \ m = n \ k = 0" + for k m n :: nat proof - have "k \ 0 \ k * m = k * n \ m = n" proof (induct n arbitrary: m) @@ -367,7 +393,8 @@ then show ?thesis by auto qed -lemma mult_cancel2 [simp]: "m * k = n * k \ m = n \ k = 0" for k m n :: nat +lemma mult_cancel2 [simp]: "m * k = n * k \ m = n \ k = 0" + for k m n :: nat by (simp add: mult.commute) lemma Suc_mult_cancel1: "Suc k * m = Suc k * n \ m = n" @@ -381,20 +408,23 @@ instantiation nat :: linorder begin -primrec less_eq_nat where - "(0::nat) \ n \ True" -| "Suc m \ n \ (case n of 0 \ False | Suc n \ m \ n)" +primrec less_eq_nat + where + "(0::nat) \ n \ True" + | "Suc m \ n \ (case n of 0 \ False | Suc n \ m \ n)" declare less_eq_nat.simps [simp del] -lemma le0 [iff]: "0 \ n" for n :: nat +lemma le0 [iff]: "0 \ n" for + n :: nat by (simp add: less_eq_nat.simps) -lemma [code]: "0 \ n \ True" for n :: nat +lemma [code]: "0 \ n \ True" + for n :: nat by simp -definition less_nat where - less_eq_Suc_le: "n < m \ Suc n \ m" +definition less_nat + where less_eq_Suc_le: "n < m \ Suc n \ m" lemma Suc_le_mono [iff]: "Suc n \ Suc m \ n \ m" by (simp add: less_eq_nat.simps(2)) @@ -402,13 +432,16 @@ lemma Suc_le_eq [code]: "Suc m \ n \ m < n" unfolding less_eq_Suc_le .. -lemma le_0_eq [iff]: "n \ 0 \ n = 0" for n :: nat +lemma le_0_eq [iff]: "n \ 0 \ n = 0" + for n :: nat by (induct n) (simp_all add: less_eq_nat.simps(2)) -lemma not_less0 [iff]: "\ n < 0" for n :: nat +lemma not_less0 [iff]: "\ n < 0" + for n :: nat by (simp add: less_eq_Suc_le) -lemma less_nat_zero_code [code]: "n < 0 \ False" for n :: nat +lemma less_nat_zero_code [code]: "n < 0 \ False" + for n :: nat by simp lemma Suc_less_eq [iff]: "Suc m < Suc n \ m < n" @@ -438,12 +471,15 @@ show "n < m \ n \ m \ \ m \ n" proof (induct n arbitrary: m) case 0 - then show ?case by (cases m) (simp_all add: less_eq_Suc_le) + then show ?case + by (cases m) (simp_all add: less_eq_Suc_le) next case (Suc n) - then show ?case by (cases m) (simp_all add: less_eq_Suc_le) + then show ?case + by (cases m) (simp_all add: less_eq_Suc_le) qed - show "n \ n" by (induct n) simp_all + show "n \ n" + by (induct n) simp_all then show "n = m" if "n \ m" and "m \ n" using that by (induct n arbitrary: m) (simp_all add: less_eq_nat.simps(2) split: nat.splits) @@ -469,9 +505,11 @@ instantiation nat :: order_bot begin -definition bot_nat :: nat where "bot_nat = 0" - -instance by standard (simp add: bot_nat_def) +definition bot_nat :: nat + where "bot_nat = 0" + +instance + by standard (simp add: bot_nat_def) end @@ -490,19 +528,24 @@ subsubsection \Elimination properties\ -lemma less_not_refl: "\ n < n" for n :: nat +lemma less_not_refl: "\ n < n" + for n :: nat by (rule order_less_irrefl) -lemma less_not_refl2: "n < m \ m \ n" for m n :: nat +lemma less_not_refl2: "n < m \ m \ n" + for m n :: nat by (rule not_sym) (rule less_imp_neq) -lemma less_not_refl3: "s < t \ s \ t" for s t :: nat +lemma less_not_refl3: "s < t \ s \ t" + for s t :: nat by (rule less_imp_neq) -lemma less_irrefl_nat: "n < n \ R" for n :: nat +lemma less_irrefl_nat: "n < n \ R" + for n :: nat by (rule notE, rule less_not_refl) -lemma less_zeroE: "n < 0 \ R" for n :: nat +lemma less_zeroE: "n < 0 \ R" + for n :: nat by (rule notE) (rule not_less0) lemma less_Suc_eq: "m < Suc n \ m < n \ m = n" @@ -511,17 +554,19 @@ lemma less_Suc0 [iff]: "(n < Suc 0) = (n = 0)" by (simp add: less_Suc_eq) -lemma less_one [iff]: "n < 1 \ n = 0" for n :: nat +lemma less_one [iff]: "n < 1 \ n = 0" + for n :: nat unfolding One_nat_def by (rule less_Suc0) lemma Suc_mono: "m < n \ Suc m < Suc n" by simp -text \"Less than" is antisymmetric, sort of\ -lemma less_antisym: "\ \ n < m; n < Suc m \ \ m = n" +text \"Less than" is antisymmetric, sort of.\ +lemma less_antisym: "\ n < m \ n < Suc m \ m = n" unfolding not_less less_Suc_eq_le by (rule antisym) -lemma nat_neq_iff: "m \ n \ m < n \ n < m" for m n :: nat +lemma nat_neq_iff: "m \ n \ m < n \ n < m" + for m n :: nat by (rule linorder_neq_iff) @@ -549,8 +594,10 @@ and eq: "m = n \ P" shows P apply (rule major [THEN lessE]) - apply (rule eq, blast) - apply (rule less, blast) + apply (rule eq) + apply blast + apply (rule less) + apply blast done lemma Suc_lessE: @@ -558,8 +605,9 @@ and minor: "\j. i < j \ k = Suc j \ P" shows P apply (rule major [THEN lessE]) - apply (erule lessI [THEN minor]) - apply (erule Suc_lessD [THEN minor], assumption) + apply (erule lessI [THEN minor]) + apply (erule Suc_lessD [THEN minor]) + apply assumption done lemma Suc_less_SucD: "Suc m < Suc n \ m < n" @@ -568,39 +616,42 @@ lemma less_trans_Suc: assumes le: "i < j" shows "j < k \ Suc i < k" - apply (induct k, simp_all) - using le - apply (simp add: less_Suc_eq) - apply (blast dest: Suc_lessD) - done - -text \Can be used with \less_Suc_eq\ to get @{prop "n = m \ n < m"}\ +proof (induct k) + case 0 + then show ?case by simp +next + case (Suc k) + with le show ?case + by simp (auto simp add: less_Suc_eq dest: Suc_lessD) +qed + +text \Can be used with \less_Suc_eq\ to get @{prop "n = m \ n < m"}.\ lemma not_less_eq: "\ m < n \ n < Suc m" - unfolding not_less less_Suc_eq_le .. + by (simp only: not_less less_Suc_eq_le) lemma not_less_eq_eq: "\ m \ n \ Suc n \ m" - unfolding not_le Suc_le_eq .. - -text \Properties of "less than or equal"\ + by (simp only: not_le Suc_le_eq) + +text \Properties of "less than or equal".\ lemma le_imp_less_Suc: "m \ n \ m < Suc n" - unfolding less_Suc_eq_le . + by (simp only: less_Suc_eq_le) lemma Suc_n_not_le_n: "\ Suc n \ n" - unfolding not_le less_Suc_eq_le .. - -lemma le_Suc_eq: "(m \ Suc n) = (m \ n | m = Suc n)" + by (simp add: not_le less_Suc_eq_le) + +lemma le_Suc_eq: "m \ Suc n \ m \ n \ m = Suc n" by (simp add: less_Suc_eq_le [symmetric] less_Suc_eq) lemma le_SucE: "m \ Suc n \ (m \ n \ R) \ (m = Suc n \ R) \ R" by (drule le_Suc_eq [THEN iffD1], iprover+) -lemma Suc_leI: "m < n \ Suc(m) \ n" - unfolding Suc_le_eq . - -text \Stronger version of \Suc_leD\\ +lemma Suc_leI: "m < n \ Suc m \ n" + by (simp only: Suc_le_eq) + +text \Stronger version of \Suc_leD\.\ lemma Suc_le_lessD: "Suc m \ n \ m < n" - unfolding Suc_le_eq . + by (simp only: Suc_le_eq) lemma less_imp_le_nat: "m < n \ m \ n" for m n :: nat unfolding less_eq_Suc_le by (rule Suc_leD) @@ -611,32 +662,41 @@ text \Equivalence of \m \ n\ and \m < n \ m = n\\ -lemma less_or_eq_imp_le: "m < n \ m = n \ m \ n" for m n :: nat +lemma less_or_eq_imp_le: "m < n \ m = n \ m \ n" + for m n :: nat unfolding le_less . -lemma le_eq_less_or_eq: "m \ n \ m < n \ m = n" for m n :: nat +lemma le_eq_less_or_eq: "m \ n \ m < n \ m = n" + for m n :: nat by (rule le_less) text \Useful with \blast\.\ -lemma eq_imp_le: "m = n \ m \ n" for m n :: nat +lemma eq_imp_le: "m = n \ m \ n" + for m n :: nat by auto -lemma le_refl: "n \ n" for n :: nat +lemma le_refl: "n \ n" + for n :: nat by simp -lemma le_trans: "i \ j \ j \ k \ i \ k" for i j k :: nat +lemma le_trans: "i \ j \ j \ k \ i \ k" + for i j k :: nat by (rule order_trans) -lemma le_antisym: "m \ n \ n \ m \ m = n" for m n :: nat +lemma le_antisym: "m \ n \ n \ m \ m = n" + for m n :: nat by (rule antisym) -lemma nat_less_le: "m < n \ m \ n \ m \ n" for m n :: nat +lemma nat_less_le: "m < n \ m \ n \ m \ n" + for m n :: nat by (rule less_le) -lemma le_neq_implies_less: "m \ n \ m \ n \ m < n" for m n :: nat +lemma le_neq_implies_less: "m \ n \ m \ n \ m < n" + for m n :: nat unfolding less_le .. -lemma nat_le_linear: "m \ n | n \ m" for m n :: nat +lemma nat_le_linear: "m \ n | n \ m" + for m n :: nat by (rule linear) lemmas linorder_neqE_nat = linorder_neqE [where 'a = nat] @@ -655,20 +715,24 @@ lemma gr0_implies_Suc: "n > 0 \ \m. n = Suc m" by (cases n) simp_all -lemma gr_implies_not0: "m < n \ n \ 0" for m n :: nat +lemma gr_implies_not0: "m < n \ n \ 0" + for m n :: nat by (cases n) simp_all -lemma neq0_conv[iff]: "n \ 0 \ 0 < n" for n :: nat +lemma neq0_conv[iff]: "n \ 0 \ 0 < n" + for n :: nat by (cases n) simp_all text \This theorem is useful with \blast\\ -lemma gr0I: "(n = 0 \ False) \ 0 < n" for n :: nat - by (rule neq0_conv[THEN iffD1], iprover) +lemma gr0I: "(n = 0 \ False) \ 0 < n" + for n :: nat + by (rule neq0_conv[THEN iffD1]) iprover lemma gr0_conv_Suc: "0 < n \ (\m. n = Suc m)" by (fast intro: not0_implies_Suc) -lemma not_gr0 [iff]: "\ 0 < n \ n = 0" for n :: nat +lemma not_gr0 [iff]: "\ 0 < n \ n = 0" + for n :: nat using neq0_conv by blast lemma Suc_le_D: "Suc n \ m' \ \m. m' = Suc m" @@ -687,34 +751,45 @@ lemma Suc_diff_1 [simp]: "0 < n \ Suc (n - 1) = n" unfolding One_nat_def by (rule Suc_pred) -lemma nat_add_left_cancel_le [simp]: "k + m \ k + n \ m \ n" for k m n :: nat +lemma nat_add_left_cancel_le [simp]: "k + m \ k + n \ m \ n" + for k m n :: nat by (induct k) simp_all -lemma nat_add_left_cancel_less [simp]: "k + m < k + n \ m < n" for k m n :: nat +lemma nat_add_left_cancel_less [simp]: "k + m < k + n \ m < n" + for k m n :: nat by (induct k) simp_all -lemma add_gr_0 [iff]: "m + n > 0 \ m > 0 \ n > 0" for m n :: nat +lemma add_gr_0 [iff]: "m + n > 0 \ m > 0 \ n > 0" + for m n :: nat by (auto dest: gr0_implies_Suc) text \strict, in 1st argument\ -lemma add_less_mono1: "i < j \ i + k < j + k" for i j k :: nat +lemma add_less_mono1: "i < j \ i + k < j + k" + for i j k :: nat by (induct k) simp_all text \strict, in both arguments\ -lemma add_less_mono: "i < j \ k < l \ i + k < j + l" for i j k l :: nat +lemma add_less_mono: "i < j \ k < l \ i + k < j + l" + for i j k l :: nat apply (rule add_less_mono1 [THEN less_trans], assumption+) - apply (induct j, simp_all) + apply (induct j) + apply simp_all done text \Deleted \less_natE\; use \less_imp_Suc_add RS exE\\ lemma less_imp_Suc_add: "m < n \ \k. n = Suc (m + k)" - apply (induct n) - apply (simp_all add: order_le_less) - apply (blast elim!: less_SucE - intro!: Nat.add_0_right [symmetric] add_Suc_right [symmetric]) - done - -lemma le_Suc_ex: "k \ l \ (\n. l = k + n)" for k l :: nat +proof (induct n) + case 0 + then show ?case by simp +next + case Suc + then show ?case + by (simp add: order_le_less) + (blast elim!: less_SucE intro!: Nat.add_0_right [symmetric] add_Suc_right [symmetric]) +qed + +lemma le_Suc_ex: "k \ l \ (\n. l = k + n)" + for k l :: nat by (auto simp: less_Suc_eq_le[symmetric] dest: less_imp_Suc_add) text \strict, in 1st argument; proof is by induction on \k > 0\\ @@ -734,27 +809,34 @@ text \Addition is the inverse of subtraction: if @{term "n \ m"} then @{term "n + (m - n) = m"}.\ -lemma add_diff_inverse_nat: "\ m < n \ n + (m - n) = m" for m n :: nat +lemma add_diff_inverse_nat: "\ m < n \ n + (m - n) = m" + for m n :: nat by (induct m n rule: diff_induct) simp_all -lemma nat_le_iff_add: "m \ n \ (\k. n = m + k)" for m n :: nat +lemma nat_le_iff_add: "m \ n \ (\k. n = m + k)" + for m n :: nat using nat_add_left_cancel_le[of m 0] by (auto dest: le_Suc_ex) -text\The naturals form an ordered \semidom\ and a \dioid\\ +text \The naturals form an ordered \semidom\ and a \dioid\.\ instance nat :: linordered_semidom proof fix m n q :: nat - show "0 < (1::nat)" by simp - show "m \ n \ q + m \ q + n" by simp - show "m < n \ 0 < q \ q * m < q * n" by (simp add: mult_less_mono2) - show "m \ 0 \ n \ 0 \ m * n \ 0" by simp + show "0 < (1::nat)" + by simp + show "m \ n \ q + m \ q + n" + by simp + show "m < n \ 0 < q \ q * m < q * n" + by (simp add: mult_less_mono2) + show "m \ 0 \ n \ 0 \ m * n \ 0" + by simp show "n \ m \ (m - n) + n = m" by (simp add: add_diff_inverse_nat add.commute linorder_not_less) qed instance nat :: dioid by standard (rule nat_le_iff_add) + declare le0[simp del] \ \This is now @{thm zero_le}\ declare le_0_eq[simp del] \ \This is now @{thm le_zero_eq}\ declare not_less0[simp del] \ \This is now @{thm not_less_zero}\ @@ -769,10 +851,12 @@ lemma mono_Suc: "mono Suc" by (rule monoI) simp -lemma min_0L [simp]: "min 0 n = 0" for n :: nat +lemma min_0L [simp]: "min 0 n = 0" + for n :: nat by (rule min_absorb1) simp -lemma min_0R [simp]: "min n 0 = 0" for n :: nat +lemma min_0R [simp]: "min n 0 = 0" + for n :: nat by (rule min_absorb2) simp lemma min_Suc_Suc [simp]: "min (Suc m) (Suc n) = Suc (min m n)" @@ -784,10 +868,12 @@ lemma min_Suc2: "min m (Suc n) = (case m of 0 \ 0 | Suc m' \ Suc(min m' n))" by (simp split: nat.split) -lemma max_0L [simp]: "max 0 n = n" for n :: nat +lemma max_0L [simp]: "max 0 n = n" + for n :: nat by (rule max_absorb2) simp -lemma max_0R [simp]: "max n 0 = n" for n :: nat +lemma max_0R [simp]: "max n 0 = n" + for n :: nat by (rule max_absorb1) simp lemma max_Suc_Suc [simp]: "max (Suc m) (Suc n) = Suc (max m n)" @@ -799,25 +885,31 @@ lemma max_Suc2: "max m (Suc n) = (case m of 0 \ Suc n | Suc m' \ Suc (max m' n))" by (simp split: nat.split) -lemma nat_mult_min_left: "min m n * q = min (m * q) (n * q)" for m n q :: nat +lemma nat_mult_min_left: "min m n * q = min (m * q) (n * q)" + for m n q :: nat by (simp add: min_def not_le) (auto dest: mult_right_le_imp_le mult_right_less_imp_less le_less_trans) -lemma nat_mult_min_right: "m * min n q = min (m * n) (m * q)" for m n q :: nat +lemma nat_mult_min_right: "m * min n q = min (m * n) (m * q)" + for m n q :: nat by (simp add: min_def not_le) (auto dest: mult_left_le_imp_le mult_left_less_imp_less le_less_trans) -lemma nat_add_max_left: "max m n + q = max (m + q) (n + q)" for m n q :: nat +lemma nat_add_max_left: "max m n + q = max (m + q) (n + q)" + for m n q :: nat by (simp add: max_def) -lemma nat_add_max_right: "m + max n q = max (m + n) (m + q)" for m n q :: nat +lemma nat_add_max_right: "m + max n q = max (m + n) (m + q)" + for m n q :: nat by (simp add: max_def) -lemma nat_mult_max_left: "max m n * q = max (m * q) (n * q)" for m n q :: nat +lemma nat_mult_max_left: "max m n * q = max (m * q) (n * q)" + for m n q :: nat by (simp add: max_def not_le) (auto dest: mult_right_le_imp_le mult_right_less_imp_less le_less_trans) -lemma nat_mult_max_right: "m * max n q = max (m * n) (m * q)" for m n q :: nat +lemma nat_mult_max_right: "m * max n q = max (m * n) (m * q)" + for m n q :: nat by (simp add: max_def not_le) (auto dest: mult_left_le_imp_le mult_left_less_imp_less le_less_trans) @@ -834,10 +926,11 @@ proof (induct n) case (0 n) have "P 0" by (rule step) auto - then show ?case using 0 by auto + with 0 show ?case by auto next case (Suc m n) - then have "n \ m \ n = Suc m" by (simp add: le_Suc_eq) + then have "n \ m \ n = Suc m" + by (simp add: le_Suc_eq) then show ?case proof assume "n \ m" @@ -851,34 +944,36 @@ qed -lemma Least_eq_0[simp]: "P 0 \ Least P = 0" for P :: "nat \ bool" +lemma Least_eq_0[simp]: "P 0 \ Least P = 0" + for P :: "nat \ bool" by (rule Least_equality[OF _ le0]) lemma Least_Suc: "P n \ \ P 0 \ (LEAST n. P n) = Suc (LEAST m. P (Suc m))" - apply (cases n, auto) + apply (cases n) + apply auto apply (frule LeastI) - apply (drule_tac P = "\x. P (Suc x) " in LeastI) + apply (drule_tac P = "\x. P (Suc x)" in LeastI) apply (subgoal_tac " (LEAST x. P x) \ Suc (LEAST x. P (Suc x))") - apply (erule_tac [2] Least_le) - apply (cases "LEAST x. P x", auto) - apply (drule_tac P = "\x. P (Suc x) " in Least_le) + apply (erule_tac [2] Least_le) + apply (cases "LEAST x. P x") + apply auto + apply (drule_tac P = "\x. P (Suc x)" in Least_le) apply (blast intro: order_antisym) done lemma Least_Suc2: "P n \ Q m \ \ P 0 \ \k. P (Suc k) = Q k \ Least P = Suc (Least Q)" - apply (erule (1) Least_Suc [THEN ssubst]) - apply simp - done - -lemma ex_least_nat_le: "\ P 0 \ P n \ \k\n. (\i P i) \ P k" for P :: "nat \ bool" + by (erule (1) Least_Suc [THEN ssubst]) simp + +lemma ex_least_nat_le: "\ P 0 \ P n \ \k\n. (\i P i) \ P k" + for P :: "nat \ bool" apply (cases n) apply blast apply (rule_tac x="LEAST k. P k" in exI) apply (blast intro: Least_le dest: not_less_Least intro: LeastI_ex) done -lemma ex_least_nat_less: "\ P 0 \ P n \ \ki\k. \ P i) \ P (k + 1)" for P :: "nat \ bool" - unfolding One_nat_def +lemma ex_least_nat_less: "\ P 0 \ P n \ \ki\k. \ P i) \ P (k + 1)" + for P :: "nat \ bool" apply (cases n) apply blast apply (frule (1) ex_least_nat_le) @@ -957,7 +1052,7 @@ apply (rule infinite_descent) using assms apply (case_tac "n > 0") - apply auto + apply auto done text \ @@ -988,7 +1083,7 @@ ultimately show "P x" by auto qed -text\Again, without explicit base case:\ +text \Again, without explicit base case:\ lemma infinite_descent_measure: fixes V :: "'a \ nat" assumes "\x. \ P x \ \y. V y < V x \ \ P y" @@ -1014,17 +1109,21 @@ text \non-strict, in 1st argument\ -lemma add_le_mono1: "i \ j \ i + k \ j + k" for i j k :: nat +lemma add_le_mono1: "i \ j \ i + k \ j + k" + for i j k :: nat by (rule add_right_mono) text \non-strict, in both arguments\ -lemma add_le_mono: "i \ j \ k \ l \ i + k \ j + l" for i j k l :: nat +lemma add_le_mono: "i \ j \ k \ l \ i + k \ j + l" + for i j k l :: nat by (rule add_mono) -lemma le_add2: "n \ m + n" for m n :: nat +lemma le_add2: "n \ m + n" + for m n :: nat by simp -lemma le_add1: "n \ n + m" for m n :: nat +lemma le_add1: "n \ n + m" + for m n :: nat by simp lemma less_add_Suc1: "i < Suc (i + m)" @@ -1036,43 +1135,54 @@ lemma less_iff_Suc_add: "m < n \ (\k. n = Suc (m + k))" by (iprover intro!: less_add_Suc1 less_imp_Suc_add) -lemma trans_le_add1: "i \ j \ i \ j + m" for i j m :: nat +lemma trans_le_add1: "i \ j \ i \ j + m" + for i j m :: nat by (rule le_trans, assumption, rule le_add1) -lemma trans_le_add2: "i \ j \ i \ m + j" for i j m :: nat +lemma trans_le_add2: "i \ j \ i \ m + j" + for i j m :: nat by (rule le_trans, assumption, rule le_add2) -lemma trans_less_add1: "i < j \ i < j + m" for i j m :: nat +lemma trans_less_add1: "i < j \ i < j + m" + for i j m :: nat by (rule less_le_trans, assumption, rule le_add1) -lemma trans_less_add2: "i < j \ i < m + j" for i j m :: nat +lemma trans_less_add2: "i < j \ i < m + j" + for i j m :: nat by (rule less_le_trans, assumption, rule le_add2) -lemma add_lessD1: "i + j < k \ i < k" for i j k :: nat +lemma add_lessD1: "i + j < k \ i < k" + for i j k :: nat by (rule le_less_trans [of _ "i+j"]) (simp_all add: le_add1) -lemma not_add_less1 [iff]: "\ i + j < i" for i j :: nat +lemma not_add_less1 [iff]: "\ i + j < i" + for i j :: nat apply (rule notI) apply (drule add_lessD1) apply (erule less_irrefl [THEN notE]) done -lemma not_add_less2 [iff]: "\ j + i < i" for i j :: nat +lemma not_add_less2 [iff]: "\ j + i < i" + for i j :: nat by (simp add: add.commute) -lemma add_leD1: "m + k \ n \ m \ n" for k m n :: nat - by (rule order_trans [of _ "m+k"]) (simp_all add: le_add1) - -lemma add_leD2: "m + k \ n \ k \ n" for k m n :: nat +lemma add_leD1: "m + k \ n \ m \ n" + for k m n :: nat + by (rule order_trans [of _ "m + k"]) (simp_all add: le_add1) + +lemma add_leD2: "m + k \ n \ k \ n" + for k m n :: nat apply (simp add: add.commute) apply (erule add_leD1) done -lemma add_leE: "m + k \ n \ (m \ n \ k \ n \ R) \ R" for k m n :: nat +lemma add_leE: "m + k \ n \ (m \ n \ k \ n \ R) \ R" + for k m n :: nat by (blast dest: add_leD1 add_leD2) text \needs \\k\ for \ac_simps\ to work\ -lemma less_add_eq_less: "\k::nat. k < l \ m + l = k + n \ m < n" +lemma less_add_eq_less: "\k. k < l \ m + l = k + n \ m < n" + for l m n :: nat by (force simp del: add_Suc_right simp add: less_iff_Suc_add add_Suc_right [symmetric] ac_simps) @@ -1082,42 +1192,52 @@ by (induct m n rule: diff_induct) simp_all lemma diff_less_Suc: "m - n < Suc m" -apply (induct m n rule: diff_induct) -apply (erule_tac [3] less_SucE) -apply (simp_all add: less_Suc_eq) -done - -lemma diff_le_self [simp]: "m - n \ m" for m n :: nat + apply (induct m n rule: diff_induct) + apply (erule_tac [3] less_SucE) + apply (simp_all add: less_Suc_eq) + done + +lemma diff_le_self [simp]: "m - n \ m" + for m n :: nat by (induct m n rule: diff_induct) (simp_all add: le_SucI) -lemma less_imp_diff_less: "j < k \ j - n < k" for j k n :: nat +lemma less_imp_diff_less: "j < k \ j - n < k" + for j k n :: nat by (rule le_less_trans, rule diff_le_self) lemma diff_Suc_less [simp]: "0 < n \ n - Suc i < n" by (cases n) (auto simp add: le_simps) -lemma diff_add_assoc: "k \ j \ (i + j) - k = i + (j - k)" for i j k :: nat +lemma diff_add_assoc: "k \ j \ (i + j) - k = i + (j - k)" + for i j k :: nat by (induct j k rule: diff_induct) simp_all -lemma add_diff_assoc [simp]: "k \ j \ i + (j - k) = i + j - k" for i j k :: nat +lemma add_diff_assoc [simp]: "k \ j \ i + (j - k) = i + j - k" + for i j k :: nat by (fact diff_add_assoc [symmetric]) -lemma diff_add_assoc2: "k \ j \ (j + i) - k = (j - k) + i" for i j k :: nat +lemma diff_add_assoc2: "k \ j \ (j + i) - k = (j - k) + i" + for i j k :: nat by (simp add: ac_simps) -lemma add_diff_assoc2 [simp]: "k \ j \ j - k + i = j + i - k" for i j k :: nat +lemma add_diff_assoc2 [simp]: "k \ j \ j - k + i = j + i - k" + for i j k :: nat by (fact diff_add_assoc2 [symmetric]) -lemma le_imp_diff_is_add: "i \ j \ (j - i = k) = (j = k + i)" for i j k :: nat +lemma le_imp_diff_is_add: "i \ j \ (j - i = k) = (j = k + i)" + for i j k :: nat by auto -lemma diff_is_0_eq [simp]: "m - n = 0 \ m \ n" for m n :: nat +lemma diff_is_0_eq [simp]: "m - n = 0 \ m \ n" + for m n :: nat by (induct m n rule: diff_induct) simp_all -lemma diff_is_0_eq' [simp]: "m \ n \ m - n = 0" for m n :: nat +lemma diff_is_0_eq' [simp]: "m \ n \ m - n = 0" + for m n :: nat by (rule iffD2, rule diff_is_0_eq) -lemma zero_less_diff [simp]: "0 < n - m \ m < n" for m n :: nat +lemma zero_less_diff [simp]: "0 < n - m \ m < n" + for m n :: nat by (induct m n rule: diff_induct) simp_all lemma less_imp_add_positive: @@ -1129,18 +1249,18 @@ qed text \a nice rewrite for bounded subtraction\ -lemma nat_minus_add_max: "n - m + m = max n m" for m n :: nat - by (simp add: max_def not_le order_less_imp_le) +lemma nat_minus_add_max: "n - m + m = max n m" + for m n :: nat + by (simp add: max_def not_le order_less_imp_le) lemma nat_diff_split: "P (a - b) \ (a < b \ P 0) \ (\d. a = b + d \ P d)" for a b :: nat - \ \elimination of \-\ on \nat\\ - by (cases "a < b") - (auto simp add: not_less le_less dest!: add_eq_self_zero [OF sym]) + \ \elimination of \-\ on \nat\\ + by (cases "a < b") (auto simp add: not_less le_less dest!: add_eq_self_zero [OF sym]) lemma nat_diff_split_asm: "P (a - b) \ \ (a < b \ \ P 0 \ (\d. a = b + d \ \ P d))" for a b :: nat - \ \elimination of \-\ on \nat\ in assumptions\ + \ \elimination of \-\ on \nat\ in assumptions\ by (auto split: nat_diff_split) lemma Suc_pred': "0 < n \ n = Suc(n - 1)" @@ -1149,64 +1269,78 @@ lemma add_eq_if: "m + n = (if m = 0 then n else Suc ((m - 1) + n))" unfolding One_nat_def by (cases m) simp_all -lemma mult_eq_if: "m * n = (if m = 0 then 0 else n + ((m - 1) * n))" for m n :: nat - unfolding One_nat_def by (cases m) simp_all +lemma mult_eq_if: "m * n = (if m = 0 then 0 else n + ((m - 1) * n))" + for m n :: nat + by (cases m) simp_all lemma Suc_diff_eq_diff_pred: "0 < n \ Suc m - n = m - (n - 1)" - unfolding One_nat_def by (cases n) simp_all + by (cases n) simp_all lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n" - unfolding One_nat_def by (cases m) simp_all - -lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)" + by (cases m) simp_all + +lemma Let_Suc [simp]: "Let (Suc n) f \ f (Suc n)" by (fact Let_def) subsubsection \Monotonicity of multiplication\ -lemma mult_le_mono1: "i \ j \ i * k \ j * k" for i j k :: nat +lemma mult_le_mono1: "i \ j \ i * k \ j * k" + for i j k :: nat by (simp add: mult_right_mono) -lemma mult_le_mono2: "i \ j \ k * i \ k * j" for i j k :: nat +lemma mult_le_mono2: "i \ j \ k * i \ k * j" + for i j k :: nat by (simp add: mult_left_mono) text \\\\ monotonicity, BOTH arguments\ -lemma mult_le_mono: "i \ j \ k \ l \ i * k \ j * l" for i j k l :: nat +lemma mult_le_mono: "i \ j \ k \ l \ i * k \ j * l" + for i j k l :: nat by (simp add: mult_mono) -lemma mult_less_mono1: "i < j \ 0 < k \ i * k < j * k" for i j k :: nat +lemma mult_less_mono1: "i < j \ 0 < k \ i * k < j * k" + for i j k :: nat by (simp add: mult_strict_right_mono) -text\Differs from the standard \zero_less_mult_iff\ in that - there are no negative numbers.\ -lemma nat_0_less_mult_iff [simp]: "0 < m * n \ 0 < m \ 0 < n" for m n :: nat - apply (induct m) - apply simp - apply (case_tac n) - apply simp_all - done +text \Differs from the standard \zero_less_mult_iff\ in that there are no negative numbers.\ +lemma nat_0_less_mult_iff [simp]: "0 < m * n \ 0 < m \ 0 < n" + for m n :: nat +proof (induct m) + case 0 + then show ?case by simp +next + case (Suc m) + then show ?case by (cases n) simp_all +qed lemma one_le_mult_iff [simp]: "Suc 0 \ m * n \ Suc 0 \ m \ Suc 0 \ n" - apply (induct m) - apply simp - apply (case_tac n) - apply simp_all - done - -lemma mult_less_cancel2 [simp]: "m * k < n * k \ 0 < k \ m < n" for k m n :: nat +proof (induct m) + case 0 + then show ?case by simp +next + case (Suc m) + then show ?case by (cases n) simp_all +qed + +lemma mult_less_cancel2 [simp]: "m * k < n * k \ 0 < k \ m < n" + for k m n :: nat apply (safe intro!: mult_less_mono1) - apply (cases k, auto) + apply (cases k) + apply auto apply (simp add: linorder_not_le [symmetric]) apply (blast intro: mult_le_mono1) done -lemma mult_less_cancel1 [simp]: "k * m < k * n \ 0 < k \ m < n" for k m n :: nat +lemma mult_less_cancel1 [simp]: "k * m < k * n \ 0 < k \ m < n" + for k m n :: nat by (simp add: mult.commute [of k]) -lemma mult_le_cancel1 [simp]: "k * m \ k * n \ (0 < k \ m \ n)" for k m n :: nat +lemma mult_le_cancel1 [simp]: "k * m \ k * n \ (0 < k \ m \ n)" + for k m n :: nat by (simp add: linorder_not_less [symmetric], auto) -lemma mult_le_cancel2 [simp]: "m * k \ n * k \ (0 < k \ m \ n)" for k m n :: nat +lemma mult_le_cancel2 [simp]: "m * k \ n * k \ (0 < k \ m \ n)" + for k m n :: nat by (simp add: linorder_not_less [symmetric], auto) lemma Suc_mult_less_cancel1: "Suc k * m < Suc k * n \ m < n" @@ -1215,19 +1349,24 @@ lemma Suc_mult_le_cancel1: "Suc k * m \ Suc k * n \ m \ n" by (subst mult_le_cancel1) simp -lemma le_square: "m \ m * m" for m :: nat +lemma le_square: "m \ m * m" + for m :: nat by (cases m) (auto intro: le_add1) -lemma le_cube: "m \ m * (m * m)" for m :: nat +lemma le_cube: "m \ m * (m * m)" + for m :: nat by (cases m) (auto intro: le_add1) text \Lemma for \gcd\\ -lemma mult_eq_self_implies_10: "m = m * n \ n = 1 \ m = 0" for m n :: nat +lemma mult_eq_self_implies_10: "m = m * n \ n = 1 \ m = 0" + for m n :: nat apply (drule sym) apply (rule disjCI) - apply (rule linorder_cases, erule_tac [2] _) - apply (drule_tac [2] mult_less_mono2) - apply (auto) + apply (rule linorder_cases) + defer + apply assumption + apply (drule mult_less_mono2) + apply auto done lemma mono_times_nat: @@ -1240,7 +1379,7 @@ with assms show "n * m \ n * q" by simp qed -text \the lattice order on @{typ nat}\ +text \The lattice order on @{typ nat}.\ instantiation nat :: distrib_lattice begin @@ -1272,15 +1411,16 @@ notation (latex output) compower ("(_\<^bsup>_\<^esup>)" [1000] 1000) -text \\f ^^ n = f o ... o f\, the n-fold composition of \f\\ +text \\f ^^ n = f \ \ \ f\, the \n\-fold composition of \f\\ overloading funpow \ "compow :: nat \ ('a \ 'a) \ ('a \ 'a)" begin -primrec funpow :: "nat \ ('a \ 'a) \ 'a \ 'a" where - "funpow 0 f = id" -| "funpow (Suc n) f = f o funpow n f" +primrec funpow :: "nat \ ('a \ 'a) \ 'a \ 'a" + where + "funpow 0 f = id" + | "funpow (Suc n) f = f \ funpow n f" end @@ -1300,7 +1440,7 @@ lemmas funpow_simps_right = funpow.simps(1) funpow_Suc_right -text \for code generation\ +text \For code generation.\ definition funpow :: "nat \ ('a \ 'a) \ 'a \ 'a" where funpow_code_def [code_abbrev]: "funpow = compow" @@ -1315,18 +1455,20 @@ lemma funpow_add: "f ^^ (m + n) = f ^^ m \ f ^^ n" by (induct m) simp_all -lemma funpow_mult: "(f ^^ m) ^^ n = f ^^ (m * n)" for f :: "'a \ 'a" +lemma funpow_mult: "(f ^^ m) ^^ n = f ^^ (m * n)" + for f :: "'a \ 'a" by (induct n) (simp_all add: funpow_add) lemma funpow_swap1: "f ((f ^^ n) x) = (f ^^ n) (f x)" proof - have "f ((f ^^ n) x) = (f ^^ (n + 1)) x" by simp - also have "\ = (f ^^ n o f ^^ 1) x" by (simp only: funpow_add) + also have "\ = (f ^^ n \ f ^^ 1) x" by (simp only: funpow_add) also have "\ = (f ^^ n) (f x)" by simp finally show ?thesis . qed -lemma comp_funpow: "comp f ^^ n = comp (f ^^ n)" for f :: "'a \ 'a" +lemma comp_funpow: "comp f ^^ n = comp (f ^^ n)" + for f :: "'a \ 'a" by (induct n) simp_all lemma Suc_funpow[simp]: "Suc ^^ n = (op + n)" @@ -1342,12 +1484,15 @@ lemma funpow_mono2: assumes "mono f" - assumes "i \ j" - assumes "x \ y" - assumes "x \ f x" + and "i \ j" + and "x \ y" + and "x \ f x" shows "(f ^^ i) x \ (f ^^ j) y" -using assms(2,3) -proof(induct j arbitrary: y) + using assms(2,3) +proof (induct j arbitrary: y) + case 0 + then show ?case by simp +next case (Suc j) show ?case proof(cases "i = Suc j") @@ -1358,40 +1503,43 @@ case False with assms(1,4) Suc show ?thesis by (simp del: funpow.simps add: funpow_simps_right le_eq_less_or_eq less_Suc_eq_le) - (simp add: Suc.hyps monoD order_subst1) + (simp add: Suc.hyps monoD order_subst1) qed -qed simp +qed subsection \Kleene iteration\ lemma Kleene_iter_lpfp: + fixes f :: "'a::order_bot \ 'a" assumes "mono f" and "f p \ p" - shows "(f^^k) (bot::'a::order_bot) \ p" -proof(induction k) + shows "(f ^^ k) bot \ p" +proof (induct k) case 0 show ?case by simp next case Suc - from monoD[OF assms(1) Suc] assms(2) show ?case by simp + show ?case + using monoD[OF assms(1) Suc] assms(2) by simp qed lemma lfp_Kleene_iter: assumes "mono f" - and "(f^^Suc k) bot = (f^^k) bot" - shows "lfp f = (f^^k) bot" + and "(f ^^ Suc k) bot = (f ^^ k) bot" + shows "lfp f = (f ^^ k) bot" proof (rule antisym) - show "lfp f \ (f^^k) bot" + show "lfp f \ (f ^^ k) bot" proof (rule lfp_lowerbound) - show "f ((f^^k) bot) \ (f^^k) bot" + show "f ((f ^^ k) bot) \ (f ^^ k) bot" using assms(2) by simp qed - show "(f^^k) bot \ lfp f" + show "(f ^^ k) bot \ lfp f" using Kleene_iter_lpfp[OF assms(1)] lfp_unfold[OF assms(1)] by simp qed -lemma mono_pow: "mono f \ mono (f ^^ n)" for f :: "'a \ 'a::complete_lattice" +lemma mono_pow: "mono f \ mono (f ^^ n)" + for f :: "'a \ 'a::complete_lattice" by (induct n) (auto simp: mono_def) lemma lfp_funpow: @@ -1405,9 +1553,9 @@ then show "f (lfp (f ^^ Suc n)) \ lfp (f ^^ Suc n)" by (simp add: comp_def) qed - have "(f^^n) (lfp f) = lfp f" for n + have "(f ^^ n) (lfp f) = lfp f" for n by (induct n) (auto intro: f lfp_unfold[symmetric]) - then show "lfp (f^^Suc n) \ lfp f" + then show "lfp (f ^^ Suc n) \ lfp f" by (intro lfp_lowerbound) (simp del: funpow.simps) qed @@ -1422,32 +1570,36 @@ then show "f (gfp (f ^^ Suc n)) \ gfp (f ^^ Suc n)" by (simp add: comp_def) qed - have "(f^^n) (gfp f) = gfp f" for n + have "(f ^^ n) (gfp f) = gfp f" for n by (induct n) (auto intro: f gfp_unfold[symmetric]) - then show "gfp (f^^Suc n) \ gfp f" + then show "gfp (f ^^ Suc n) \ gfp f" by (intro gfp_upperbound) (simp del: funpow.simps) qed lemma Kleene_iter_gpfp: + fixes f :: "'a::order_top \ 'a" assumes "mono f" - and "p \ f p" - shows "p \ (f ^^ k) (top::'a::order_top)" -proof(induction k) - case 0 show ?case by simp + and "p \ f p" + shows "p \ (f ^^ k) top" +proof (induct k) + case 0 + show ?case by simp next case Suc - from monoD[OF assms(1) Suc] assms(2) - show ?case by simp + show ?case + using monoD[OF assms(1) Suc] assms(2) by simp qed lemma gfp_Kleene_iter: assumes "mono f" - and "(f ^^ Suc k) top = (f ^^ k) top" - shows "gfp f = (f ^^ k) top" (is "?lhs = ?rhs") -proof(rule antisym) - have "?rhs \ f ?rhs" using assms(2) by simp - then show "?rhs \ ?lhs" by(rule gfp_upperbound) - + and "(f ^^ Suc k) top = (f ^^ k) top" + shows "gfp f = (f ^^ k) top" + (is "?lhs = ?rhs") +proof (rule antisym) + have "?rhs \ f ?rhs" + using assms(2) by simp + then show "?rhs \ ?lhs" + by (rule gfp_upperbound) show "?lhs \ ?rhs" using Kleene_iter_gpfp[OF assms(1)] gfp_unfold[OF assms(1)] by simp qed @@ -1478,9 +1630,10 @@ lemma mult_of_nat_commute: "of_nat x * y = y * of_nat x" by (induct x) (simp_all add: algebra_simps) -primrec of_nat_aux :: "('a \ 'a) \ nat \ 'a \ 'a" where - "of_nat_aux inc 0 i = i" -| "of_nat_aux inc (Suc n) i = of_nat_aux inc n (inc i)" \ \tail recursive\ +primrec of_nat_aux :: "('a \ 'a) \ nat \ 'a \ 'a" + where + "of_nat_aux inc 0 i = i" + | "of_nat_aux inc (Suc n) i = of_nat_aux inc n (inc i)" \ \tail recursive\ lemma of_nat_code: "of_nat n = of_nat_aux (\i. i + 1) n 0" proof (induct n) @@ -1492,7 +1645,8 @@ by (induct n) simp_all from this [of 0] have "of_nat_aux (\i. i + 1) n 1 = of_nat_aux (\i. i + 1) n 0 + 1" by simp - with Suc show ?case by (simp add: add.commute) + with Suc show ?case + by (simp add: add.commute) qed end @@ -1525,12 +1679,10 @@ lemma of_nat_eq_0_iff [simp]: "of_nat m = 0 \ m = 0" by (fact of_nat_eq_iff [of m 0, unfolded of_nat_0]) -lemma of_nat_neq_0 [simp]: - "of_nat (Suc n) \ 0" +lemma of_nat_neq_0 [simp]: "of_nat (Suc n) \ 0" unfolding of_nat_eq_0_iff by simp -lemma of_nat_0_neq [simp]: - "0 \ of_nat (Suc n)" +lemma of_nat_0_neq [simp]: "0 \ of_nat (Suc n)" unfolding of_nat_0_eq_iff by simp end @@ -1600,28 +1752,28 @@ by (simp add: Nats_def) lemma Nats_0 [simp]: "0 \ \" -apply (simp add: Nats_def) -apply (rule range_eqI) -apply (rule of_nat_0 [symmetric]) -done + apply (simp add: Nats_def) + apply (rule range_eqI) + apply (rule of_nat_0 [symmetric]) + done lemma Nats_1 [simp]: "1 \ \" -apply (simp add: Nats_def) -apply (rule range_eqI) -apply (rule of_nat_1 [symmetric]) -done + apply (simp add: Nats_def) + apply (rule range_eqI) + apply (rule of_nat_1 [symmetric]) + done lemma Nats_add [simp]: "a \ \ \ b \ \ \ a + b \ \" -apply (auto simp add: Nats_def) -apply (rule range_eqI) -apply (rule of_nat_add [symmetric]) -done + apply (auto simp add: Nats_def) + apply (rule range_eqI) + apply (rule of_nat_add [symmetric]) + done lemma Nats_mult [simp]: "a \ \ \ b \ \ \ a * b \ \" -apply (auto simp add: Nats_def) -apply (rule range_eqI) -apply (rule of_nat_mult [symmetric]) -done + apply (auto simp add: Nats_def) + apply (rule range_eqI) + apply (rule of_nat_mult [symmetric]) + done lemma Nats_cases [cases set: Nats]: assumes "x \ \" @@ -1633,8 +1785,7 @@ then show thesis .. qed -lemma Nats_induct [case_names of_nat, induct set: Nats]: - "x \ \ \ (\n. P (of_nat n)) \ P x" +lemma Nats_induct [case_names of_nat, induct set: Nats]: "x \ \ \ (\n. P (of_nat n)) \ P x" by (rule Nats_cases) auto end @@ -1669,7 +1820,8 @@ begin lemma lift_Suc_mono_le: - assumes mono: "\n. f n \ f (Suc n)" and "n \ n'" + assumes mono: "\n. f n \ f (Suc n)" + and "n \ n'" shows "f n \ f n'" proof (cases "n < n'") case True @@ -1681,7 +1833,8 @@ qed lemma lift_Suc_antimono_le: - assumes mono: "\n. f n \ f (Suc n)" and "n \ n'" + assumes mono: "\n. f n \ f (Suc n)" + and "n \ n'" shows "f n \ f n'" proof (cases "n < n'") case True @@ -1693,7 +1846,8 @@ qed lemma lift_Suc_mono_less: - assumes mono: "\n. f n < f (Suc n)" and "n < n'" + assumes mono: "\n. f n < f (Suc n)" + and "n < n'" shows "f n < f n'" using \n < n'\ by (induct n n' rule: less_Suc_induct) (auto intro: mono) @@ -1737,56 +1891,71 @@ then show ?thesis by simp qed -lemma less_diff_conv: "i < j - k \ i + k < j" for i j k :: nat +lemma less_diff_conv: "i < j - k \ i + k < j" + for i j k :: nat by (cases "k \ j") (auto simp add: not_le dest: less_imp_Suc_add le_Suc_ex) -lemma less_diff_conv2: "k \ j \ j - k < i \ j < i + k" for j k i :: nat +lemma less_diff_conv2: "k \ j \ j - k < i \ j < i + k" + for j k i :: nat by (auto dest: le_Suc_ex) -lemma le_diff_conv: "j - k \ i \ j \ i + k" for j k i :: nat +lemma le_diff_conv: "j - k \ i \ j \ i + k" + for j k i :: nat by (cases "k \ j") (auto simp add: not_le dest!: less_imp_Suc_add le_Suc_ex) -lemma diff_diff_cancel [simp]: "i \ n \ n - (n - i) = i" for i n :: nat +lemma diff_diff_cancel [simp]: "i \ n \ n - (n - i) = i" + for i n :: nat by (auto dest: le_Suc_ex) -lemma diff_less [simp]: "0 < n \ 0 < m \ m - n < m" for i n :: nat +lemma diff_less [simp]: "0 < n \ 0 < m \ m - n < m" + for i n :: nat by (auto dest: less_imp_Suc_add) text \Simplification of relational expressions involving subtraction\ -lemma diff_diff_eq: "k \ m \ k \ n \ m - k - (n - k) = m - n" for m n k :: nat +lemma diff_diff_eq: "k \ m \ k \ n \ m - k - (n - k) = m - n" + for m n k :: nat by (auto dest!: le_Suc_ex) hide_fact (open) diff_diff_eq -lemma eq_diff_iff: "k \ m \ k \ n \ m - k = n - k \ m = n" for m n k :: nat +lemma eq_diff_iff: "k \ m \ k \ n \ m - k = n - k \ m = n" + for m n k :: nat by (auto dest: le_Suc_ex) -lemma less_diff_iff: "k \ m \ k \ n \ m - k < n - k \ m < n" for m n k :: nat +lemma less_diff_iff: "k \ m \ k \ n \ m - k < n - k \ m < n" + for m n k :: nat by (auto dest!: le_Suc_ex) -lemma le_diff_iff: "k \ m \ k \ n \ m - k \ n - k \ m \ n" for m n k :: nat +lemma le_diff_iff: "k \ m \ k \ n \ m - k \ n - k \ m \ n" + for m n k :: nat by (auto dest!: le_Suc_ex) -lemma le_diff_iff': "a \ c \ b \ c \ c - a \ c - b \ b \ a" for a b c :: nat +lemma le_diff_iff': "a \ c \ b \ c \ c - a \ c - b \ b \ a" + for a b c :: nat by (force dest: le_Suc_ex) text \(Anti)Monotonicity of subtraction -- by Stephan Merz\ -lemma diff_le_mono: "m \ n \ m - l \ n - l" for m n l :: nat +lemma diff_le_mono: "m \ n \ m - l \ n - l" + for m n l :: nat by (auto dest: less_imp_le less_imp_Suc_add split add: nat_diff_split) -lemma diff_le_mono2: "m \ n \ l - n \ l - m" for m n l :: nat +lemma diff_le_mono2: "m \ n \ l - n \ l - m" + for m n l :: nat by (auto dest: less_imp_le le_Suc_ex less_imp_Suc_add less_le_trans split add: nat_diff_split) -lemma diff_less_mono2: "m < n \ m < l \ l - n < l - m" for m n l :: nat +lemma diff_less_mono2: "m < n \ m < l \ l - n < l - m" + for m n l :: nat by (auto dest: less_imp_Suc_add split add: nat_diff_split) -lemma diffs0_imp_equal: "m - n = 0 \ n - m = 0 \ m = n" for m n :: nat +lemma diffs0_imp_equal: "m - n = 0 \ n - m = 0 \ m = n" + for m n :: nat by (simp split add: nat_diff_split) -lemma min_diff: "min (m - i) (n - i) = min m n - i" for m n i :: nat +lemma min_diff: "min (m - i) (n - i) = min m n - i" + for m n i :: nat by (cases m n rule: le_cases) (auto simp add: not_le min.absorb1 min.absorb2 min.absorb_iff1 [symmetric] diff_le_mono) @@ -1803,7 +1972,8 @@ text \Rewriting to pull differences out\ -lemma diff_diff_right [simp]: "k \ j \ i - (j - k) = i + k - j" for i j k :: nat +lemma diff_diff_right [simp]: "k \ j \ i - (j - k) = i + k - j" + for i j k :: nat by (fact diff_diff_right) lemma diff_Suc_diff_eq1 [simp]: @@ -1870,12 +2040,9 @@ from \Suc d = j - n\ have "d + 1 = j - n" by simp then have "d + 1 - 1 = j - n - 1" by simp then have "d = j - n - 1" by simp - then have "d = j - (n + 1)" - by (simp add: diff_diff_eq) - then have "d = j - Suc n" - by simp - moreover from \n < j\ have "Suc n \ j" - by (simp add: Suc_le_eq) + then have "d = j - (n + 1)" by (simp add: diff_diff_eq) + then have "d = j - Suc n" by simp + moreover from \n < j\ have "Suc n \ j" by (simp add: Suc_le_eq) ultimately have "P (Suc n)" proof (rule Suc.hyps) fix q @@ -1883,11 +2050,9 @@ then have "n \ q" by (simp add: Suc_le_eq less_imp_le) moreover assume "q < j" moreover assume "P (Suc q)" - ultimately show "P q" - by (rule Suc.prems) + ultimately show "P q" by (rule Suc.prems) qed - with order_refl \n < j\ show "P n" - by (rule Suc.prems) + with order_refl \n < j\ show "P n" by (rule Suc.prems) qed lemma strict_inc_induct [consumes 1, case_names base step]: @@ -1906,16 +2071,11 @@ case (Suc d i) from \Suc d = j - i - 1\ have *: "Suc d = j - Suc i" by (simp add: diff_diff_add) - then have "Suc d - 1 = j - Suc i - 1" - by simp - then have "d = j - Suc i - 1" - by simp - moreover from * have "j - Suc i \ 0" - by auto - then have "Suc i < j" - by (simp add: not_le) - ultimately have "P (Suc i)" - by (rule Suc.hyps) + then have "Suc d - 1 = j - Suc i - 1" by simp + then have "d = j - Suc i - 1" by simp + moreover from * have "j - Suc i \ 0" by auto + then have "Suc i < j" by (simp add: not_le) + ultimately have "P (Suc i)" by (rule Suc.hyps) with \i < j\ show "P i" by (rule step) qed @@ -1925,7 +2085,7 @@ lemma zero_induct: "P k \ (\n. P (Suc n) \ P n) \ P 0" using inc_induct[of 0 k P] by blast -text \Further induction rule similar to @{thm inc_induct}\ +text \Further induction rule similar to @{thm inc_induct}.\ lemma dec_induct [consumes 1, case_names base step]: "i \ j \ P i \ (\n. i \ n \ n < j \ P n \ P (Suc n)) \ P j" @@ -1947,11 +2107,9 @@ moreover assume "q < j" then have "q < Suc j" by (simp add: less_Suc_eq) moreover assume "P q" - ultimately show "P (Suc q)" - by (rule Suc.prems) + ultimately show "P (Suc q)" by (rule Suc.prems) qed - ultimately show "P (Suc j)" - by (rule Suc.prems) + ultimately show "P (Suc j)" by (rule Suc.prems) next case 2 with \P i\ show "P (Suc j)" by simp @@ -1961,28 +2119,24 @@ subsection \Monotonicity of \funpow\\ -lemma funpow_increasing: - fixes f :: "'a \ 'a::{lattice,order_top}" - shows "m \ n \ mono f \ (f ^^ n) \ \ (f ^^ m) \" +lemma funpow_increasing: "m \ n \ mono f \ (f ^^ n) \ \ (f ^^ m) \" + for f :: "'a::{lattice,order_top} \ 'a" by (induct rule: inc_induct) - (auto simp del: funpow.simps(2) simp add: funpow_Suc_right - intro: order_trans[OF _ funpow_mono]) - -lemma funpow_decreasing: - fixes f :: "'a \ 'a::{lattice,order_bot}" - shows "m \ n \ mono f \ (f ^^ m) \ \ (f ^^ n) \" + (auto simp del: funpow.simps(2) simp add: funpow_Suc_right + intro: order_trans[OF _ funpow_mono]) + +lemma funpow_decreasing: "m \ n \ mono f \ (f ^^ m) \ \ (f ^^ n) \" + for f :: "'a::{lattice,order_bot} \ 'a" by (induct rule: dec_induct) - (auto simp del: funpow.simps(2) simp add: funpow_Suc_right - intro: order_trans[OF _ funpow_mono]) - -lemma mono_funpow: - fixes Q :: "'a::{lattice,order_bot} \ 'a" - shows "mono Q \ mono (\i. (Q ^^ i) \)" + (auto simp del: funpow.simps(2) simp add: funpow_Suc_right + intro: order_trans[OF _ funpow_mono]) + +lemma mono_funpow: "mono Q \ mono (\i. (Q ^^ i) \)" + for Q :: "'a::{lattice,order_bot} \ 'a" by (auto intro!: funpow_decreasing simp: mono_def) -lemma antimono_funpow: - fixes Q :: "'a::{lattice,order_top} \ 'a" - shows "mono Q \ antimono (\i. (Q ^^ i) \)" +lemma antimono_funpow: "mono Q \ antimono (\i. (Q ^^ i) \)" + for Q :: "'a::{lattice,order_top} \ 'a" by (auto intro!: funpow_increasing simp: antimono_def) @@ -1994,21 +2148,26 @@ lemma dvd_1_iff_1 [simp]: "m dvd Suc 0 \ m = Suc 0" by (simp add: dvd_def) -lemma nat_dvd_1_iff_1 [simp]: "m dvd 1 \ m = 1" for m :: nat +lemma nat_dvd_1_iff_1 [simp]: "m dvd 1 \ m = 1" + for m :: nat by (simp add: dvd_def) -lemma dvd_antisym: "m dvd n \ n dvd m \ m = n" for m n :: nat +lemma dvd_antisym: "m dvd n \ n dvd m \ m = n" + for m n :: nat unfolding dvd_def by (force dest: mult_eq_self_implies_10 simp add: mult.assoc) -lemma dvd_diff_nat [simp]: "k dvd m \ k dvd n \ k dvd (m - n)" for k m n :: nat +lemma dvd_diff_nat [simp]: "k dvd m \ k dvd n \ k dvd (m - n)" + for k m n :: nat unfolding dvd_def by (blast intro: right_diff_distrib' [symmetric]) -lemma dvd_diffD: "k dvd m - n \ k dvd n \ n \ m \ k dvd m" for k m n :: nat +lemma dvd_diffD: "k dvd m - n \ k dvd n \ n \ m \ k dvd m" + for k m n :: nat apply (erule linorder_not_less [THEN iffD2, THEN add_diff_inverse, THEN subst]) apply (blast intro: dvd_add) done -lemma dvd_diffD1: "k dvd m - n \ k dvd m \ n \ m \ k dvd n" for k m n :: nat +lemma dvd_diffD1: "k dvd m - n \ k dvd m \ n \ m \ k dvd n" + for k m n :: nat by (drule_tac m = m in dvd_diff_nat) auto lemma dvd_mult_cancel: @@ -2022,19 +2181,24 @@ then show ?thesis .. qed -lemma dvd_mult_cancel1: "0 < m \ m * n dvd m \ n = 1" for m n :: nat +lemma dvd_mult_cancel1: "0 < m \ m * n dvd m \ n = 1" + for m n :: nat apply auto - apply (subgoal_tac "m * n dvd m * 1") - apply (drule dvd_mult_cancel, auto) + apply (subgoal_tac "m * n dvd m * 1") + apply (drule dvd_mult_cancel) + apply auto done -lemma dvd_mult_cancel2: "0 < m \ n * m dvd m \ n = 1" for m n :: nat +lemma dvd_mult_cancel2: "0 < m \ n * m dvd m \ n = 1" + for m n :: nat using dvd_mult_cancel1 [of m n] by (simp add: ac_simps) -lemma dvd_imp_le: "k dvd n \ 0 < n \ k \ n" for k n :: nat +lemma dvd_imp_le: "k dvd n \ 0 < n \ k \ n" + for k n :: nat by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc) -lemma nat_dvd_not_less: "0 < m \ m < n \ \ n dvd m" for m n :: nat +lemma nat_dvd_not_less: "0 < m \ m < n \ \ n dvd m" + for m n :: nat by (auto elim!: dvdE) (auto simp add: gr0_conv_Suc) lemma less_eq_dvd_minus: @@ -2047,7 +2211,8 @@ then show ?thesis by (simp add: add.commute [of m]) qed -lemma dvd_minus_self: "m dvd n - m \ n < m \ m dvd n" for m n :: nat +lemma dvd_minus_self: "m dvd n - m \ n < m \ m dvd n" + for m n :: nat by (cases "n < m") (auto elim!: dvdE simp add: not_less le_imp_diff_is_add dest: less_imp_le) lemma dvd_minus_add: @@ -2066,55 +2231,72 @@ subsection \Aliasses\ -lemma nat_mult_1: "1 * n = n" for n :: nat +lemma nat_mult_1: "1 * n = n" + for n :: nat by (fact mult_1_left) -lemma nat_mult_1_right: "n * 1 = n" for n :: nat +lemma nat_mult_1_right: "n * 1 = n" + for n :: nat by (fact mult_1_right) -lemma nat_add_left_cancel: "k + m = k + n \ m = n" for k m n :: nat +lemma nat_add_left_cancel: "k + m = k + n \ m = n" + for k m n :: nat by (fact add_left_cancel) -lemma nat_add_right_cancel: "m + k = n + k \ m = n" for k m n :: nat +lemma nat_add_right_cancel: "m + k = n + k \ m = n" + for k m n :: nat by (fact add_right_cancel) -lemma diff_mult_distrib: "(m - n) * k = (m * k) - (n * k)" for k m n :: nat +lemma diff_mult_distrib: "(m - n) * k = (m * k) - (n * k)" + for k m n :: nat by (fact left_diff_distrib') -lemma diff_mult_distrib2: "k * (m - n) = (k * m) - (k * n)" for k m n :: nat +lemma diff_mult_distrib2: "k * (m - n) = (k * m) - (k * n)" + for k m n :: nat by (fact right_diff_distrib') -lemma le_add_diff: "k \ n \ m \ n + m - k" for k m n :: nat +lemma le_add_diff: "k \ n \ m \ n + m - k" + for k m n :: nat by (fact le_add_diff) (* FIXME delete *) -lemma le_diff_conv2: "k \ j \ (i \ j - k) = (i + k \ j)" for i j k :: nat +lemma le_diff_conv2: "k \ j \ (i \ j - k) = (i + k \ j)" + for i j k :: nat by (fact le_diff_conv2) (* FIXME delete *) -lemma diff_self_eq_0 [simp]: "m - m = 0" for m :: nat +lemma diff_self_eq_0 [simp]: "m - m = 0" + for m :: nat by (fact diff_cancel) -lemma diff_diff_left [simp]: "i - j - k = i - (j + k)" for i j k :: nat +lemma diff_diff_left [simp]: "i - j - k = i - (j + k)" + for i j k :: nat by (fact diff_diff_add) -lemma diff_commute: "i - j - k = i - k - j" for i j k :: nat +lemma diff_commute: "i - j - k = i - k - j" + for i j k :: nat by (fact diff_right_commute) -lemma diff_add_inverse: "(n + m) - n = m" for m n :: nat +lemma diff_add_inverse: "(n + m) - n = m" + for m n :: nat by (fact add_diff_cancel_left') -lemma diff_add_inverse2: "(m + n) - n = m" for m n :: nat +lemma diff_add_inverse2: "(m + n) - n = m" + for m n :: nat by (fact add_diff_cancel_right') -lemma diff_cancel: "(k + m) - (k + n) = m - n" for k m n :: nat +lemma diff_cancel: "(k + m) - (k + n) = m - n" + for k m n :: nat by (fact add_diff_cancel_left) -lemma diff_cancel2: "(m + k) - (n + k) = m - n" for k m n :: nat +lemma diff_cancel2: "(m + k) - (n + k) = m - n" + for k m n :: nat by (fact add_diff_cancel_right) -lemma diff_add_0: "n - (n + m) = 0" for m n :: nat +lemma diff_add_0: "n - (n + m) = 0" + for m n :: nat by (fact diff_add_zero) -lemma add_mult_distrib2: "k * (m + n) = (k * m) + (k * n)" for k m n :: nat +lemma add_mult_distrib2: "k * (m + n) = (k * m) + (k * n)" + for k m n :: nat by (fact distrib_left) lemmas nat_distrib = diff -r 881e8e2cfec2 -r d0e2bad67bd4 src/HOL/Rings.thy --- a/src/HOL/Rings.thy Tue Aug 02 21:04:52 2016 +0200 +++ b/src/HOL/Rings.thy Tue Aug 02 21:05:34 2016 +0200 @@ -10,7 +10,7 @@ section \Rings\ theory Rings -imports Groups Set + imports Groups Set begin class semiring = ab_semigroup_add + semigroup_mult + @@ -42,10 +42,14 @@ subclass semiring_0 proof fix a :: 'a - have "0 * a + 0 * a = 0 * a + 0" by (simp add: distrib_right [symmetric]) - then show "0 * a = 0" by (simp only: add_left_cancel) - have "a * 0 + a * 0 = a * 0 + 0" by (simp add: distrib_left [symmetric]) - then show "a * 0 = 0" by (simp only: add_left_cancel) + have "0 * a + 0 * a = 0 * a + 0" + by (simp add: distrib_right [symmetric]) + then show "0 * a = 0" + by (simp only: add_left_cancel) + have "a * 0 + a * 0 = a * 0 + 0" + by (simp add: distrib_left [symmetric]) + then show "a * 0 = 0" + by (simp only: add_left_cancel) qed end @@ -57,11 +61,16 @@ subclass semiring proof fix a b c :: 'a - show "(a + b) * c = a * c + b * c" by (simp add: distrib) - have "a * (b + c) = (b + c) * a" by (simp add: ac_simps) - also have "\ = b * a + c * a" by (simp only: distrib) - also have "\ = a * b + a * c" by (simp add: ac_simps) - finally show "a * (b + c) = a * b + a * c" by blast + show "(a + b) * c = a * c + b * c" + by (simp add: distrib) + have "a * (b + c) = (b + c) * a" + by (simp add: ac_simps) + also have "\ = b * a + c * a" + by (simp only: distrib) + also have "\ = a * b + a * c" + by (simp add: ac_simps) + finally show "a * (b + c) = a * b + a * c" + by blast qed end @@ -140,9 +149,12 @@ assumes "a dvd b" and "b dvd c" shows "a dvd c" proof - - from assms obtain v where "b = a * v" by (auto elim!: dvdE) - moreover from assms obtain w where "c = b * w" by (auto elim!: dvdE) - ultimately have "c = a * (v * w)" by (simp add: mult.assoc) + from assms obtain v where "b = a * v" + by (auto elim!: dvdE) + moreover from assms obtain w where "c = b * w" + by (auto elim!: dvdE) + ultimately have "c = a * (v * w)" + by (simp add: mult.assoc) then show ?thesis .. qed @@ -174,7 +186,8 @@ proof - from \a dvd b\ obtain b' where "b = a * b'" .. moreover from \c dvd d\ obtain d' where "d = c * d'" .. - ultimately have "b * d = (a * c) * (b' * d')" by (simp add: ac_simps) + ultimately have "b * d = (a * c) * (b' * d')" + by (simp add: ac_simps) then show ?thesis .. qed @@ -208,7 +221,8 @@ proof - from \a dvd b\ obtain b' where "b = a * b'" .. moreover from \a dvd c\ obtain c' where "c = a * c'" .. - ultimately have "b + c = a * (b' + c')" by (simp add: distrib_left) + ultimately have "b + c = a * (b' + c')" + by (simp add: distrib_left) then show ?thesis .. qed @@ -571,13 +585,13 @@ then show ?thesis by simp next case False - { - assume "a * c = b * c" - then have "a * c div c = b * c div c" + have "a = b" if "a * c = b * c" + proof - + from that have "a * c div c = b * c div c" by simp - with False have "a = b" + with False show ?thesis by simp - } + qed then show ?thesis by auto qed show "c * a = c * b \ c = 0 \ a = b" for a b c @@ -617,22 +631,23 @@ lemma dvd_times_left_cancel_iff [simp]: assumes "a \ 0" - shows "a * b dvd a * c \ b dvd c" (is "?P \ ?Q") + shows "a * b dvd a * c \ b dvd c" + (is "?lhs \ ?rhs") proof - assume ?P + assume ?lhs then obtain d where "a * c = a * b * d" .. with assms have "c = b * d" by (simp add: ac_simps) - then show ?Q .. + then show ?rhs .. next - assume ?Q + assume ?rhs then obtain d where "c = b * d" .. then have "a * c = a * b * d" by (simp add: ac_simps) - then show ?P .. + then show ?lhs .. qed lemma dvd_times_right_cancel_iff [simp]: assumes "a \ 0" - shows "b * a dvd c * a \ b dvd c" (is "?P \ ?Q") + shows "b * a dvd c * a \ b dvd c" using dvd_times_left_cancel_iff [of a b c] assms by (simp add: ac_simps) lemma div_dvd_iff_mult: @@ -698,15 +713,16 @@ lemma dvd_div_eq_mult: assumes "a \ 0" and "a dvd b" shows "b div a = c \ b = c * a" + (is "?lhs \ ?rhs") proof - assume "b = c * a" - then show "b div a = c" by (simp add: assms) + assume ?rhs + then show ?lhs by (simp add: assms) next - assume "b div a = c" + assume ?lhs then have "b div a * a = c * a" by simp moreover from assms have "b div a * a = b" by (auto elim!: dvdE simp add: ac_simps) - ultimately show "b = c * a" by simp + ultimately show ?rhs by simp qed lemma dvd_div_mult_self [simp]: "a dvd b \ b div a * a = b" @@ -743,16 +759,17 @@ lemma dvd_div_div_eq_mult: assumes "a \ 0" "c \ 0" and "a dvd b" "c dvd d" - shows "b div a = d div c \ b * c = a * d" (is "?P \ ?Q") + shows "b div a = d div c \ b * c = a * d" + (is "?lhs \ ?rhs") proof - from assms have "a * c \ 0" by simp - then have "?P \ b div a * (a * c) = d div c * (a * c)" + then have "?lhs \ b div a * (a * c) = d div c * (a * c)" by simp also have "\ \ (a * (b div a)) * c = (c * (d div c)) * a" by (simp add: ac_simps) also have "\ \ (a * b div a) * c = (c * d div c) * a" using assms by (simp add: div_mult_swap) - also have "\ \ ?Q" + also have "\ \ ?rhs" using assms by (simp add: ac_simps) finally show ?thesis . qed @@ -765,7 +782,8 @@ next case False from \a * c dvd b\ obtain d where "b = a * c * d" .. - with False show ?thesis by (simp add: mult.commute [of a] mult.assoc) + with False show ?thesis + by (simp add: mult.commute [of a] mult.assoc) qed @@ -943,23 +961,20 @@ fixes normalize :: "'a \ 'a" and unit_factor :: "'a \ 'a" assumes unit_factor_mult_normalize [simp]: "unit_factor a * normalize a = a" - assumes normalize_0 [simp]: "normalize 0 = 0" + and normalize_0 [simp]: "normalize 0 = 0" and unit_factor_0 [simp]: "unit_factor 0 = 0" - assumes is_unit_normalize: - "is_unit a \ normalize a = 1" - assumes unit_factor_is_unit [iff]: - "a \ 0 \ is_unit (unit_factor a)" - assumes unit_factor_mult: "unit_factor (a * b) = unit_factor a * unit_factor b" + and is_unit_normalize: "is_unit a \ normalize a = 1" + and unit_factor_is_unit [iff]: "a \ 0 \ is_unit (unit_factor a)" + and unit_factor_mult: "unit_factor (a * b) = unit_factor a * unit_factor b" begin text \ - Class @{class normalization_semidom} cultivates the idea that - each integral domain can be split into equivalence classes - whose representants are associated, i.e. divide each other. - @{const normalize} specifies a canonical representant for each equivalence - class. The rationale behind this is that it is easier to reason about equality - than equivalences, hence we prefer to think about equality of normalized - values rather than associated elements. + Class @{class normalization_semidom} cultivates the idea that each integral + domain can be split into equivalence classes whose representants are + associated, i.e. divide each other. @{const normalize} specifies a canonical + representant for each equivalence class. The rationale behind this is that + it is easier to reason about equality than equivalences, hence we prefer to + think about equality of normalized values rather than associated elements. \ lemma unit_factor_dvd [simp]: "a \ 0 \ unit_factor a dvd b" @@ -972,25 +987,25 @@ using unit_factor_mult_normalize [of a] by (simp add: ac_simps) lemma normalize_eq_0_iff [simp]: "normalize a = 0 \ a = 0" - (is "?P \ ?Q") + (is "?lhs \ ?rhs") proof - assume ?P + assume ?lhs moreover have "unit_factor a * normalize a = a" by simp - ultimately show ?Q by simp + ultimately show ?rhs by simp next - assume ?Q - then show ?P by simp + assume ?rhs + then show ?lhs by simp qed lemma unit_factor_eq_0_iff [simp]: "unit_factor a = 0 \ a = 0" - (is "?P \ ?Q") + (is "?lhs \ ?rhs") proof - assume ?P + assume ?lhs moreover have "unit_factor a * normalize a = a" by simp - ultimately show ?Q by simp + ultimately show ?rhs by simp next - assume ?Q - then show ?P by simp + assume ?rhs + then show ?lhs by simp qed lemma is_unit_unit_factor: @@ -1009,20 +1024,20 @@ by (rule is_unit_normalize) simp lemma normalize_1_iff: "normalize a = 1 \ is_unit a" - (is "?P \ ?Q") + (is "?lhs \ ?rhs") proof - assume ?Q - then show ?P by (rule is_unit_normalize) + assume ?rhs + then show ?lhs by (rule is_unit_normalize) next - assume ?P - then have "a \ 0" by auto - from \?P\ have "unit_factor a * normalize a = unit_factor a * 1" + assume ?lhs + then have "unit_factor a * normalize a = unit_factor a * 1" by simp then have "unit_factor a = a" by simp - moreover have "is_unit (unit_factor a)" - using \a \ 0\ by simp - ultimately show ?Q by simp + moreover + from \?lhs\ have "a \ 0" by auto + then have "is_unit (unit_factor a)" by simp + ultimately show ?rhs by simp qed lemma div_normalize [simp]: "a div normalize a = unit_factor a" @@ -1045,7 +1060,8 @@ case False then have "unit_factor a \ 0" by simp with nonzero_mult_divide_cancel_left - have "unit_factor a * normalize a div unit_factor a = normalize a" by blast + have "unit_factor a * normalize a div unit_factor a = normalize a" + by blast then show ?thesis by simp qed @@ -1071,7 +1087,8 @@ then show ?thesis by auto next case False - from unit_factor_mult_normalize have "unit_factor (a * b) * normalize (a * b) = a * b" . + have "unit_factor (a * b) * normalize (a * b) = a * b" + by (rule unit_factor_mult_normalize) then have "normalize (a * b) = a * b div unit_factor (a * b)" by simp also have "\ = a * b div unit_factor (b * a)" @@ -1163,11 +1180,11 @@ qed text \ - We avoid an explicit definition of associated elements but prefer - explicit normalisation instead. In theory we could define an abbreviation - like @{prop "associated a b \ normalize a = normalize b"} but this is - counterproductive without suggestive infix syntax, which we do not want - to sacrifice for this purpose here. + We avoid an explicit definition of associated elements but prefer explicit + normalisation instead. In theory we could define an abbreviation like @{prop + "associated a b \ normalize a = normalize b"} but this is counterproductive + without suggestive infix syntax, which we do not want to sacrifice for this + purpose here. \ lemma associatedI: @@ -1202,20 +1219,20 @@ using dvd_unit_imp_unit by (auto dest!: associatedD1 associatedD2) lemma associated_iff_dvd: "normalize a = normalize b \ a dvd b \ b dvd a" - (is "?P \ ?Q") + (is "?lhs \ ?rhs") proof - assume ?Q - then show ?P by (auto intro!: associatedI) + assume ?rhs + then show ?lhs by (auto intro!: associatedI) next - assume ?P + assume ?lhs then have "unit_factor a * normalize a = unit_factor a * normalize b" by simp then have *: "normalize b * unit_factor a = a" by (simp add: ac_simps) - show ?Q + show ?rhs proof (cases "a = 0 \ b = 0") case True - with \?P\ show ?thesis by auto + with \?lhs\ show ?thesis by auto next case False then have "b dvd normalize b * unit_factor a" and "normalize b * unit_factor a dvd b" @@ -1231,8 +1248,10 @@ proof - from assms have "normalize a = normalize b" unfolding associated_iff_dvd by simp - with \normalize a = a\ have "a = normalize b" by simp - with \normalize b = b\ show "a = b" by simp + with \normalize a = a\ have "a = normalize b" + by simp + with \normalize b = b\ show "a = b" + by simp qed end @@ -1248,9 +1267,7 @@ done lemma mult_mono': "a \ b \ c \ d \ 0 \ a \ 0 \ c \ a * c \ b * d" - apply (rule mult_mono) - apply (fast intro: order_trans)+ - done + by (rule mult_mono) (fast intro: order_trans)+ end @@ -1266,11 +1283,9 @@ lemma mult_nonpos_nonneg: "a \ 0 \ 0 \ b \ a * b \ 0" using mult_right_mono [of a 0 b] by simp -text \Legacy - use \mult_nonpos_nonneg\\ +text \Legacy -- use @{thm [source] mult_nonpos_nonneg}.\ lemma mult_nonneg_nonpos2: "0 \ a \ b \ 0 \ b * a \ 0" - apply (drule mult_right_mono [of b 0]) - apply auto - done + by (drule mult_right_mono [of b 0]) auto lemma split_mult_neg_le: "(0 \ a \ b \ 0) \ (a \ 0 \ 0 \ b) \ a * b \ 0" by (auto simp add: mult_nonneg_nonpos mult_nonneg_nonpos2) @@ -1281,6 +1296,7 @@ begin subclass semiring_0_cancel .. + subclass ordered_semiring_0 .. end @@ -1327,11 +1343,11 @@ subclass linordered_semiring proof fix a b c :: 'a - assume A: "a \ b" "0 \ c" - from A show "c * a \ c * b" + assume *: "a \ b" "0 \ c" + then show "c * a \ c * b" unfolding le_less using mult_strict_left_mono by (cases "c = 0") auto - from A show "a * c \ b * c" + from * show "a * c \ b * c" unfolding le_less using mult_strict_right_mono by (cases "c = 0") auto qed @@ -1351,11 +1367,9 @@ lemma mult_neg_pos: "a < 0 \ 0 < b \ a * b < 0" using mult_strict_right_mono [of a 0 b] by simp -text \Legacy - use \mult_neg_pos\\ +text \Legacy -- use @{thm [source] mult_neg_pos}.\ lemma mult_pos_neg2: "0 < a \ b < 0 \ b * a < 0" - apply (drule mult_strict_right_mono [of b 0]) - apply auto - done + by (drule mult_strict_right_mono [of b 0]) auto lemma zero_less_mult_pos: "0 < a * b \ 0 < a \ 0 < b" apply (cases "b \ 0") @@ -1377,9 +1391,9 @@ shows "a * c < b * d" using assms apply (cases "c = 0") - apply simp + apply simp apply (erule mult_strict_right_mono [THEN less_trans]) - apply (auto simp add: le_less) + apply (auto simp add: le_less) apply (erule (1) mult_strict_left_mono) done @@ -1394,9 +1408,9 @@ shows "a * c < b * d" using assms apply (subgoal_tac "a * c < b * c") - apply (erule less_le_trans) - apply (erule mult_left_mono) - apply simp + apply (erule less_le_trans) + apply (erule mult_left_mono) + apply simp apply (erule (1) mult_strict_right_mono) done @@ -1405,9 +1419,9 @@ shows "a * c < b * d" using assms apply (subgoal_tac "a * c \ b * c") - apply (erule le_less_trans) - apply (erule mult_strict_left_mono) - apply simp + apply (erule le_less_trans) + apply (erule mult_strict_left_mono) + apply simp apply (erule (1) mult_right_mono) done @@ -1461,8 +1475,10 @@ proof fix a b c :: 'a assume "a < b" "0 < c" - then show "c * a < c * b" by (rule comm_mult_strict_left_mono) - then show "a * c < b * c" by (simp only: mult.commute) + then show "c * a < c * b" + by (rule comm_mult_strict_left_mono) + then show "a * c < b * c" + by (simp only: mult.commute) qed subclass ordered_cancel_comm_semiring @@ -1522,7 +1538,7 @@ show "\a + b\ \ \a\ + \b\" by (auto simp add: abs_if not_le not_less algebra_simps simp del: add.commute dest: add_neg_neg add_nonneg_nonneg) -qed (auto simp add: abs_if) +qed (auto simp: abs_if) lemma zero_le_square [simp]: "0 \ a * a" using linear [of 0 a] by (auto simp add: mult_nonpos_nonpos) @@ -1560,33 +1576,33 @@ proof fix a b assume "a \ 0" - then have A: "a < 0 \ 0 < a" by (simp add: neq_iff) + then have a: "a < 0 \ 0 < a" by (simp add: neq_iff) assume "b \ 0" - then have B: "b < 0 \ 0 < b" by (simp add: neq_iff) + then have b: "b < 0 \ 0 < b" by (simp add: neq_iff) have "a * b < 0 \ 0 < a * b" proof (cases "a < 0") - case A': True + case True show ?thesis proof (cases "b < 0") case True - with A' show ?thesis by (auto dest: mult_neg_neg) + with \a < 0\ show ?thesis by (auto dest: mult_neg_neg) next case False - with B have "0 < b" by auto - with A' show ?thesis by (auto dest: mult_strict_right_mono) + with b have "0 < b" by auto + with \a < 0\ show ?thesis by (auto dest: mult_strict_right_mono) qed next case False - with A have A': "0 < a" by auto + with a have "0 < a" by auto show ?thesis proof (cases "b < 0") case True - with A' show ?thesis + with \0 < a\ show ?thesis by (auto dest: mult_strict_right_mono_neg) next case False - with B have "0 < b" by auto - with A' show ?thesis by auto + with b have "0 < b" by auto + with \0 < a\ show ?thesis by auto qed qed then show "a * b \ 0" @@ -1618,18 +1634,18 @@ lemma mult_less_cancel_right_disj: "a * c < b * c \ 0 < c \ a < b \ c < 0 \ b < a" apply (cases "c = 0") - apply (auto simp add: neq_iff mult_strict_right_mono mult_strict_right_mono_neg) - apply (auto simp add: not_less not_le [symmetric, of "a*c"] not_le [symmetric, of a]) - apply (erule_tac [!] notE) - apply (auto simp add: less_imp_le mult_right_mono mult_right_mono_neg) + apply (auto simp add: neq_iff mult_strict_right_mono mult_strict_right_mono_neg) + apply (auto simp add: not_less not_le [symmetric, of "a*c"] not_le [symmetric, of a]) + apply (erule_tac [!] notE) + apply (auto simp add: less_imp_le mult_right_mono mult_right_mono_neg) done lemma mult_less_cancel_left_disj: "c * a < c * b \ 0 < c \ a < b \ c < 0 \ b < a" apply (cases "c = 0") - apply (auto simp add: neq_iff mult_strict_left_mono mult_strict_left_mono_neg) - apply (auto simp add: not_less not_le [symmetric, of "c * a"] not_le [symmetric, of a]) - apply (erule_tac [!] notE) - apply (auto simp add: less_imp_le mult_left_mono mult_left_mono_neg) + apply (auto simp add: neq_iff mult_strict_left_mono mult_strict_left_mono_neg) + apply (auto simp add: not_less not_le [symmetric, of "c * a"] not_le [symmetric, of a]) + apply (erule_tac [!] notE) + apply (auto simp add: less_imp_le mult_left_mono mult_left_mono_neg) done text \ @@ -1727,7 +1743,8 @@ apply (subst add_le_cancel_right [where c=k, symmetric]) apply (frule le_add_diff_inverse2) apply (simp only: add.assoc [symmetric]) - using add_implies_diff apply fastforce + using add_implies_diff + apply fastforce done lemma add_le_add_imp_diff_le: @@ -1765,8 +1782,7 @@ proof have "0 \ 1 * 1" by (rule zero_le_square) then show "0 < 1" by (simp add: le_less) - show "b \ a \ a - b + b = a" for a b - by simp + show "b \ a \ a - b + b = a" for a b by simp qed lemma linorder_neqE_linordered_idom: @@ -1774,7 +1790,7 @@ obtains "x < y" | "y < x" using assms by (rule neqE) -text \These cancellation simprules also produce two cases when the comparison is a goal.\ +text \These cancellation simp rules also produce two cases when the comparison is a goal.\ lemma mult_le_cancel_right1: "c \ b * c \ (0 < c \ 1 \ b) \ (c < 0 \ b \ 1)" using mult_le_cancel_right [of 1 c b] by simp @@ -1928,7 +1944,7 @@ begin subclass ordered_ring_abs - by standard (auto simp add: abs_if not_less mult_less_0_iff) + by standard (auto simp: abs_if not_less mult_less_0_iff) lemma abs_mult: "\a * b\ = \a\ * \b\" by (rule abs_eq_mult) auto diff -r 881e8e2cfec2 -r d0e2bad67bd4 src/HOL/Set.thy --- a/src/HOL/Set.thy Tue Aug 02 21:04:52 2016 +0200 +++ b/src/HOL/Set.thy Tue Aug 02 21:05:34 2016 +0200 @@ -1,9 +1,13 @@ -(* Author: Tobias Nipkow, Lawrence C Paulson and Markus Wenzel *) +(* Title: HOL/Set.thy + Author: Tobias Nipkow + Author: Lawrence C Paulson + Author: Markus Wenzel +*) section \Set theory for higher-order logic\ theory Set -imports Lattices + imports Lattices begin subsection \Sets as predicates\ @@ -12,8 +16,8 @@ axiomatization Collect :: "('a \ bool) \ 'a set" \ "comprehension" and member :: "'a \ 'a set \ bool" \ "membership" -where mem_Collect_eq [iff, code_unfold]: "member a (Collect P) = P a" - and Collect_mem_eq [simp]: "Collect (\x. member x A) = A" + where mem_Collect_eq [iff, code_unfold]: "member a (Collect P) = P a" + and Collect_mem_eq [simp]: "Collect (\x. member x A) = A" notation member ("op \") and @@ -76,7 +80,8 @@ assumes "\x. x \ A \ x \ B" shows "A = B" proof - - from assms have "{x. x \ A} = {x. x \ B}" by simp + from assms have "{x. x \ A} = {x. x \ B}" + by simp then show ?thesis by simp qed @@ -347,7 +352,6 @@ by (simp add: Ball_def) text \Gives better instantiation for bound:\ - setup \ map_theory_claset (fn ctxt => ctxt addbefore ("bspec", fn ctxt' => dresolve_tac ctxt' @{thms bspec} THEN' assume_tac ctxt')) @@ -459,7 +463,7 @@ \ \Rule in Modus Ponens style.\ lemma rev_subsetD [intro?]: "c \ A \ A \ B \ c \ B" - \ \The same, with reversed premises for use with \erule\ -- cf. \rev_mp\.\ + \ \The same, with reversed premises for use with @{method erule} -- cf. @{thm rev_mp}.\ by (rule subsetD) lemma subsetCE [elim]: "A \ B \ (c \ A \ P) \ (c \ B \ P) \ P" @@ -696,8 +700,7 @@ lemma UnI2 [elim?]: "c \ B \ c \ A \ B" by simp -text \\<^medskip> Classical introduction rule: no commitment to @{prop A} vs @{prop B}.\ - +text \\<^medskip> Classical introduction rule: no commitment to \A\ vs. \B\.\ lemma UnCI [intro!]: "(c \ B \ c \ A) \ c \ A \ B" by auto @@ -960,7 +963,7 @@ text \\<^medskip> Range of a function -- just an abbreviation for image!\ -abbreviation range :: "('a \ 'b) \ 'b set" \ "of function" +abbreviation range :: "('a \ 'b) \ 'b set" \ \of function\ where "range f \ f ` UNIV" lemma range_eqI: "b = f x \ b \ range f" @@ -1387,7 +1390,8 @@ lemma Compl_subset_Compl_iff [iff]: "- A \ - B \ B \ A" by (fact compl_le_compl_iff) (* FIXME: already simp *) -lemma Compl_eq_Compl_iff [iff]: "- A = - B \ A = B" for A B :: "'a set" +lemma Compl_eq_Compl_iff [iff]: "- A = - B \ A = B" + for A B :: "'a set" by (fact compl_eq_compl_iff) (* FIXME: already simp *) lemma Compl_insert: "- insert x A = (- A) - {x}" @@ -1417,7 +1421,8 @@ lemma Diff_cancel [simp]: "A - A = {}" by blast -lemma Diff_idemp [simp]: "(A - B) - B = A - B" for A B :: "'a set" +lemma Diff_idemp [simp]: "(A - B) - B = A - B" + for A B :: "'a set" by blast lemma Diff_triv: "A \ B = {} \ A - B = A" @@ -1526,7 +1531,7 @@ by (auto simp add: Pow_def) lemma Pow_singleton_iff [simp]: "Pow X = {Y} \ X = {} \ Y = {}" - by blast + by blast (* somewhat slow *) lemma Pow_insert: "Pow (insert a A) = Pow A \ (insert a ` Pow A)" by (blast intro: image_eqI [where ?x = "u - {a}" for u]) @@ -1612,9 +1617,7 @@ text \\<^medskip> Monotonicity of implications.\ lemma in_mono: "A \ B \ x \ A \ x \ B" - apply (rule impI) - apply (erule subsetD, assumption) - done + by (rule impI) (erule subsetD) lemma conj_mono: "P1 \ Q1 \ P2 \ Q2 \ (P1 \ P2) \ (Q1 \ Q2)" by iprover @@ -1730,7 +1733,7 @@ lemma vimage_ident [simp]: "(\x. x) -` Y = Y" by blast - + subsubsection \Singleton sets\ definition is_singleton :: "'a set \ bool" @@ -1778,9 +1781,9 @@ \ \Courtesy of Stephan Merz\ apply clarify apply (erule_tac P = "\x. x : S" in LeastI2_order) - apply fast + apply fast apply (rule LeastI2_order) - apply (auto elim: monoD intro!: order_antisym) + apply (auto elim: monoD intro!: order_antisym) done @@ -1791,20 +1794,21 @@ hide_const (open) bind -lemma bind_bind: "Set.bind (Set.bind A B) C = Set.bind A (\x. Set.bind (B x) C)" for A :: "'a set" - by (auto simp add: bind_def) +lemma bind_bind: "Set.bind (Set.bind A B) C = Set.bind A (\x. Set.bind (B x) C)" + for A :: "'a set" + by (auto simp: bind_def) lemma empty_bind [simp]: "Set.bind {} f = {}" by (simp add: bind_def) lemma nonempty_bind_const: "A \ {} \ Set.bind A (\_. B) = B" - by (auto simp add: bind_def) + by (auto simp: bind_def) lemma bind_const: "Set.bind A (\_. B) = (if A = {} then {} else B)" - by (auto simp add: bind_def) + by (auto simp: bind_def) lemma bind_singleton_conv_image: "Set.bind A (\x. {f x}) = f ` A" - by(auto simp add: bind_def) + by (auto simp: bind_def) subsubsection \Operations for execution\ @@ -1842,12 +1846,14 @@ text \Misc\ -definition "pairwise R S \ (\x \ S. \y\ S. x \ y \ R x y)" +definition pairwise :: "('a \ 'a \ bool) \ 'a set \ bool" + where "pairwise R S \ (\x \ S. \y\ S. x \ y \ R x y)" lemma pairwise_subset: "pairwise P S \ T \ S \ pairwise P T" by (force simp: pairwise_def) -definition disjnt where "disjnt A B \ A \ B = {}" +definition disjnt :: "'a set \ 'a set \ bool" + where "disjnt A B \ A \ B = {}" lemma disjnt_iff: "disjnt A B \ (\x. \ (x \ A \ x \ B))" by (force simp: disjnt_def)