merged;
authorwenzelm
Sat Aug 11 16:02:55 2018 +0200 (2 months ago)
changeset 68740682ff0e84387
parent 68739 0c62e3b4f4c0
parent 68727 ec0b2833cfc4
child 68741 e90cf766723c
merged;
NEWS
     1.1 --- a/CONTRIBUTORS	Tue Aug 07 11:39:40 2018 +0200
     1.2 +++ b/CONTRIBUTORS	Sat Aug 11 16:02:55 2018 +0200
     1.3 @@ -3,6 +3,10 @@
     1.4  listed as an author in one of the source files of this Isabelle distribution.
     1.5  
     1.6  
     1.7 +Contributions to this Isabelle version
     1.8 +--------------------------------------
     1.9 +
    1.10 +
    1.11  Contributions to Isabelle2018
    1.12  -----------------------------
    1.13  
     2.1 --- a/NEWS	Tue Aug 07 11:39:40 2018 +0200
     2.2 +++ b/NEWS	Sat Aug 11 16:02:55 2018 +0200
     2.3 @@ -4,6 +4,11 @@
     2.4  (Note: Isabelle/jEdit shows a tree-view of the NEWS file in Sidekick.)
     2.5  
     2.6  
     2.7 +New in this Isabelle version
     2.8 +----------------------------
     2.9 +
    2.10 +
    2.11 +
    2.12  New in Isabelle2018 (August 2018)
    2.13  ---------------------------------
    2.14  
     3.1 --- a/src/HOL/Algebra/AbelCoset.thy	Tue Aug 07 11:39:40 2018 +0200
     3.2 +++ b/src/HOL/Algebra/AbelCoset.thy	Sat Aug 11 16:02:55 2018 +0200
     3.3 @@ -269,17 +269,15 @@
     3.4      by (rule a_comm_group)
     3.5    interpret subgroup "H" "(add_monoid G)"
     3.6      by (rule a_subgroup)
     3.7 -
     3.8 -  show "abelian_subgroup H G"
     3.9 -    apply unfold_locales
    3.10 -  proof (simp add: r_coset_def l_coset_def, clarsimp)
    3.11 -    fix x
    3.12 -    assume xcarr: "x \<in> carrier G"
    3.13 -    from a_subgroup have Hcarr: "H \<subseteq> carrier G"
    3.14 -      unfolding subgroup_def by simp
    3.15 -    from xcarr Hcarr show "(\<Union>h\<in>H. {h \<oplus>\<^bsub>G\<^esub> x}) = (\<Union>h\<in>H. {x \<oplus>\<^bsub>G\<^esub> h})"
    3.16 +  have "(\<Union>xa\<in>H. {xa \<oplus> x}) = (\<Union>xa\<in>H. {x \<oplus> xa})" if "x \<in> carrier G" for x
    3.17 +  proof -
    3.18 +    have "H \<subseteq> carrier G"
    3.19 +      using a_subgroup that unfolding subgroup_def by simp
    3.20 +    with that show "(\<Union>h\<in>H. {h \<oplus>\<^bsub>G\<^esub> x}) = (\<Union>h\<in>H. {x \<oplus>\<^bsub>G\<^esub> h})"
    3.21        using m_comm [simplified] by fastforce
    3.22    qed
    3.23 +  then show "abelian_subgroup H G"
    3.24 +    by unfold_locales (auto simp: r_coset_def l_coset_def)
    3.25  qed
    3.26  
    3.27  lemma abelian_subgroupI3:
    3.28 @@ -304,14 +302,6 @@
    3.29  by (rule normal.inv_op_closed2 [OF a_normal,
    3.30      folded a_inv_def, simplified monoid_record_simps])
    3.31  
    3.32 -text\<open>Alternative characterization of normal subgroups\<close>
    3.33 -lemma (in abelian_group) a_normal_inv_iff:
    3.34 -     "(N \<lhd> (add_monoid G)) = 
    3.35 -      (subgroup N (add_monoid G) & (\<forall>x \<in> carrier G. \<forall>h \<in> N. x \<oplus> h \<oplus> (\<ominus> x) \<in> N))"
    3.36 -      (is "_ = ?rhs")
    3.37 -by (rule group.normal_inv_iff [OF a_group,
    3.38 -    folded a_inv_def, simplified monoid_record_simps])
    3.39 -
    3.40  lemma (in abelian_group) a_lcos_m_assoc:
    3.41    "\<lbrakk> M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G \<rbrakk> \<Longrightarrow> g <+ (h <+ M) = (g \<oplus> h) <+ M"
    3.42  by (rule group.lcos_m_assoc [OF a_group,
    3.43 @@ -322,13 +312,11 @@
    3.44  by (rule group.lcos_mult_one [OF a_group,
    3.45      folded a_l_coset_def, simplified monoid_record_simps])
    3.46  
    3.47 -
    3.48  lemma (in abelian_group) a_l_coset_subset_G:
    3.49    "\<lbrakk> H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> x <+ H \<subseteq> carrier G"
    3.50  by (rule group.l_coset_subset_G [OF a_group,
    3.51      folded a_l_coset_def, simplified monoid_record_simps])
    3.52  
    3.53 -
    3.54  lemma (in abelian_group) a_l_coset_swap:
    3.55       "\<lbrakk>y \<in> x <+ H;  x \<in> carrier G;  subgroup H (add_monoid G)\<rbrakk> \<Longrightarrow> x \<in> y <+ H"
    3.56  by (rule group.l_coset_swap [OF a_group,
    3.57 @@ -498,15 +486,15 @@
    3.58  
    3.59  text \<open>Since the Factorization is based on an \emph{abelian} subgroup, is results in 
    3.60          a commutative group\<close>
    3.61 -theorem (in abelian_subgroup) a_factorgroup_is_comm_group:
    3.62 -  "comm_group (G A_Mod H)"
    3.63 -apply (intro comm_group.intro comm_monoid.intro) prefer 3
    3.64 -  apply (rule a_factorgroup_is_group)
    3.65 - apply (rule group.axioms[OF a_factorgroup_is_group])
    3.66 -apply (rule comm_monoid_axioms.intro)
    3.67 -apply (unfold A_FactGroup_def FactGroup_def RCOSETS_def, fold set_add_def a_r_coset_def, clarsimp)
    3.68 -apply (simp add: a_rcos_sum a_comm)
    3.69 -done
    3.70 +theorem (in abelian_subgroup) a_factorgroup_is_comm_group: "comm_group (G A_Mod H)"
    3.71 +proof -
    3.72 +  have "Group.comm_monoid_axioms (G A_Mod H)"
    3.73 +    apply (rule comm_monoid_axioms.intro)
    3.74 +    apply (auto simp: A_FactGroup_def FactGroup_def RCOSETS_def a_normal add.m_comm normal.rcos_sum)
    3.75 +    done
    3.76 +  then show ?thesis
    3.77 +    by (intro comm_group.intro comm_monoid.intro) (simp_all add: a_factorgroup_is_group group.is_monoid)
    3.78 +qed
    3.79  
    3.80  lemma add_A_FactGroup [simp]: "X \<otimes>\<^bsub>(G A_Mod H)\<^esub> X' = X <+>\<^bsub>G\<^esub> X'"
    3.81  by (simp add: A_FactGroup_def set_add_def)
    3.82 @@ -552,11 +540,8 @@
    3.83    interpret G: abelian_group G by fact
    3.84    interpret H: abelian_group H by fact
    3.85    show ?thesis
    3.86 -    apply (intro abelian_group_hom.intro abelian_group_hom_axioms.intro)
    3.87 -      apply fact
    3.88 -     apply fact
    3.89 -    apply (rule a_group_hom)
    3.90 -    done
    3.91 +    by (intro abelian_group_hom.intro abelian_group_hom_axioms.intro 
    3.92 +        G.abelian_group_axioms H.abelian_group_axioms a_group_hom)
    3.93  qed
    3.94  
    3.95  lemma (in abelian_group_hom) is_abelian_group_hom:
    3.96 @@ -576,8 +561,7 @@
    3.97  
    3.98  lemma (in abelian_group_hom) zero_closed [simp]:
    3.99    "h \<zero> \<in> carrier H"
   3.100 -by (rule group_hom.one_closed[OF a_group_hom,
   3.101 -    simplified ring_record_simps])
   3.102 +  by simp
   3.103  
   3.104  lemma (in abelian_group_hom) hom_zero [simp]:
   3.105    "h \<zero> = \<zero>\<^bsub>H\<^esub>"
   3.106 @@ -586,8 +570,7 @@
   3.107  
   3.108  lemma (in abelian_group_hom) a_inv_closed [simp]:
   3.109    "x \<in> carrier G ==> h (\<ominus>x) \<in> carrier H"
   3.110 -by (rule group_hom.inv_closed[OF a_group_hom,
   3.111 -    folded a_inv_def, simplified ring_record_simps])
   3.112 +  by simp
   3.113  
   3.114  lemma (in abelian_group_hom) hom_a_inv [simp]:
   3.115    "x \<in> carrier G ==> h (\<ominus>x) = \<ominus>\<^bsub>H\<^esub> (h x)"
   3.116 @@ -596,19 +579,15 @@
   3.117  
   3.118  lemma (in abelian_group_hom) additive_subgroup_a_kernel:
   3.119    "additive_subgroup (a_kernel G H h) G"
   3.120 -apply (rule additive_subgroup.intro)
   3.121 -apply (rule group_hom.subgroup_kernel[OF a_group_hom,
   3.122 -       folded a_kernel_def, simplified ring_record_simps])
   3.123 -done
   3.124 +  by (simp add: additive_subgroup.intro a_group_hom a_kernel_def group_hom.subgroup_kernel)
   3.125  
   3.126  text\<open>The kernel of a homomorphism is an abelian subgroup\<close>
   3.127  lemma (in abelian_group_hom) abelian_subgroup_a_kernel:
   3.128    "abelian_subgroup (a_kernel G H h) G"
   3.129 -apply (rule abelian_subgroupI)
   3.130 -apply (rule group_hom.normal_kernel[OF a_group_hom,
   3.131 -       folded a_kernel_def, simplified ring_record_simps])
   3.132 -apply (simp add: G.a_comm)
   3.133 -done
   3.134 +  apply (rule abelian_subgroupI)
   3.135 +   apply (simp add: G.abelian_group_axioms abelian_subgroup.a_normal abelian_subgroupI3 additive_subgroup_a_kernel)
   3.136 +  apply (simp add: G.a_comm)
   3.137 +  done
   3.138  
   3.139  lemma (in abelian_group_hom) A_FactGroup_nonempty:
   3.140    assumes X: "X \<in> carrier (G A_Mod a_kernel G H h)"
   3.141 @@ -715,48 +694,34 @@
   3.142  qed
   3.143  
   3.144  lemma (in abelian_subgroup) a_repr_independence':
   3.145 -  assumes y: "y \<in> H +> x"
   3.146 -      and xcarr: "x \<in> carrier G"
   3.147 +  assumes "y \<in> H +> x" "x \<in> carrier G"
   3.148    shows "H +> x = H +> y"
   3.149 -  apply (rule a_repr_independence)
   3.150 -    apply (rule y)
   3.151 -   apply (rule xcarr)
   3.152 -  apply (rule a_subgroup)
   3.153 -  done
   3.154 +  using a_repr_independence a_subgroup assms by blast
   3.155  
   3.156  lemma (in abelian_subgroup) a_repr_independenceD:
   3.157 -  assumes ycarr: "y \<in> carrier G"
   3.158 -      and repr:  "H +> x = H +> y"
   3.159 +  assumes "y \<in> carrier G" "H +> x = H +> y"
   3.160    shows "y \<in> H +> x"
   3.161 -by (rule group.repr_independenceD [OF a_group a_subgroup,
   3.162 -    folded a_r_coset_def, simplified monoid_record_simps]) (rule ycarr, rule repr)
   3.163 +  by (simp add: a_rcos_self assms)
   3.164  
   3.165  
   3.166  lemma (in abelian_subgroup) a_rcosets_carrier:
   3.167    "X \<in> a_rcosets H \<Longrightarrow> X \<subseteq> carrier G"
   3.168 -by (rule subgroup.rcosets_carrier [OF a_subgroup a_group,
   3.169 -    folded A_RCOSETS_def, simplified monoid_record_simps])
   3.170 +  using a_rcosets_part_G by auto
   3.171  
   3.172  
   3.173  subsubsection \<open>Addition of Subgroups\<close>
   3.174  
   3.175  lemma (in abelian_monoid) set_add_closed:
   3.176 -  assumes Acarr: "A \<subseteq> carrier G"
   3.177 -      and Bcarr: "B \<subseteq> carrier G"
   3.178 +  assumes "A \<subseteq> carrier G" "B \<subseteq> carrier G"
   3.179    shows "A <+> B \<subseteq> carrier G"
   3.180 -by (rule monoid.set_mult_closed [OF a_monoid,
   3.181 -    folded set_add_def, simplified monoid_record_simps]) (rule Acarr, rule Bcarr)
   3.182 +  by (simp add: assms add.set_mult_closed set_add_defs(1))
   3.183  
   3.184  lemma (in abelian_group) add_additive_subgroups:
   3.185    assumes subH: "additive_subgroup H G"
   3.186 -      and subK: "additive_subgroup K G"
   3.187 +    and subK: "additive_subgroup K G"
   3.188    shows "additive_subgroup (H <+> K) G"
   3.189 -apply (rule additive_subgroup.intro)
   3.190 -apply (unfold set_add_def)
   3.191 -apply (intro comm_group.mult_subgroups)
   3.192 -  apply (rule a_comm_group)
   3.193 - apply (rule additive_subgroup.a_subgroup[OF subH])
   3.194 -apply (rule additive_subgroup.a_subgroup[OF subK])
   3.195 -done
   3.196 +  unfolding set_add_def
   3.197 +  using add.mult_subgroups additive_subgroup_def subH subK
   3.198 +  by (blast intro: additive_subgroup.intro)
   3.199  
   3.200  end
     4.1 --- a/src/HOL/Algebra/Bij.thy	Tue Aug 07 11:39:40 2018 +0200
     4.2 +++ b/src/HOL/Algebra/Bij.thy	Sat Aug 11 16:02:55 2018 +0200
     4.3 @@ -46,15 +46,11 @@
     4.4    by (simp add: Bij_def compose_inv_into_id)
     4.5  
     4.6  theorem group_BijGroup: "group (BijGroup S)"
     4.7 -apply (simp add: BijGroup_def)
     4.8 -apply (rule groupI)
     4.9 -    apply (simp add: compose_Bij)
    4.10 -   apply (simp add: id_Bij)
    4.11 -  apply (simp add: compose_Bij)
    4.12 -  apply (blast intro: compose_assoc [symmetric] dest: Bij_imp_funcset)
    4.13 - apply (simp add: id_Bij Bij_imp_funcset Bij_imp_extensional, simp)
    4.14 -apply (blast intro: Bij_compose_restrict_eq restrict_inv_into_Bij)
    4.15 -done
    4.16 +  apply (simp add: BijGroup_def)
    4.17 +  apply (rule groupI)
    4.18 +      apply (auto simp: compose_Bij id_Bij Bij_imp_funcset Bij_imp_extensional compose_assoc [symmetric])
    4.19 +  apply (blast intro: Bij_compose_restrict_eq restrict_inv_into_Bij)
    4.20 +  done
    4.21  
    4.22  
    4.23  subsection\<open>Automorphisms Form a Group\<close>
    4.24 @@ -63,13 +59,18 @@
    4.25  by (simp add: Bij_def bij_betw_def inv_into_into)
    4.26  
    4.27  lemma Bij_inv_into_lemma:
    4.28 - assumes eq: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> h(g x y) = g (h x) (h y)"
    4.29 - shows "\<lbrakk>h \<in> Bij S;  g \<in> S \<rightarrow> S \<rightarrow> S;  x \<in> S;  y \<in> S\<rbrakk>
    4.30 -        \<Longrightarrow> inv_into S h (g x y) = g (inv_into S h x) (inv_into S h y)"
    4.31 -apply (simp add: Bij_def bij_betw_def)
    4.32 -apply (subgoal_tac "\<exists>x'\<in>S. \<exists>y'\<in>S. x = h x' \<and> y = h y'", clarify)
    4.33 - apply (simp add: eq [symmetric] inv_f_f funcset_mem [THEN funcset_mem], blast)
    4.34 -done
    4.35 +  assumes eq: "\<And>x y. \<lbrakk>x \<in> S; y \<in> S\<rbrakk> \<Longrightarrow> h(g x y) = g (h x) (h y)"
    4.36 +      and hg: "h \<in> Bij S" "g \<in> S \<rightarrow> S \<rightarrow> S" and "x \<in> S" "y \<in> S"
    4.37 +  shows "inv_into S h (g x y) = g (inv_into S h x) (inv_into S h y)"
    4.38 +proof -
    4.39 +  have "h ` S = S"
    4.40 +    by (metis (no_types) Bij_def Int_iff assms(2) bij_betw_def mem_Collect_eq)
    4.41 +  with \<open>x \<in> S\<close> \<open>y \<in> S\<close> have "\<exists>x'\<in>S. \<exists>y'\<in>S. x = h x' \<and> y = h y'"
    4.42 +    by auto
    4.43 +  then show ?thesis
    4.44 +    using assms
    4.45 +    by (auto simp add: Bij_def bij_betw_def eq [symmetric] inv_f_f funcset_mem [THEN funcset_mem])
    4.46 +qed
    4.47  
    4.48  
    4.49  definition
    4.50 @@ -94,8 +95,7 @@
    4.51  
    4.52  lemma inv_BijGroup:
    4.53       "f \<in> Bij S \<Longrightarrow> m_inv (BijGroup S) f = (\<lambda>x \<in> S. (inv_into S f) x)"
    4.54 -apply (rule group.inv_equality)
    4.55 -apply (rule group_BijGroup)
    4.56 +apply (rule group.inv_equality [OF group_BijGroup])
    4.57  apply (simp_all add:BijGroup_def restrict_inv_into_Bij Bij_compose_restrict_eq)
    4.58  done
    4.59  
     5.1 --- a/src/HOL/Algebra/Complete_Lattice.thy	Tue Aug 07 11:39:40 2018 +0200
     5.2 +++ b/src/HOL/Algebra/Complete_Lattice.thy	Sat Aug 11 16:02:55 2018 +0200
     5.3 @@ -680,22 +680,25 @@
     5.4      next
     5.5        case False
     5.6        show ?thesis
     5.7 -      proof (rule_tac x="\<Squnion>\<^bsub>L\<^esub> A" in exI, rule least_UpperI, simp_all)
     5.8 +      proof (intro exI least_UpperI, simp_all)
     5.9          show b:"\<And> x. x \<in> A \<Longrightarrow> x \<sqsubseteq>\<^bsub>L\<^esub> \<Squnion>\<^bsub>L\<^esub>A"
    5.10            using a by (auto intro: L.sup_upper, meson L.at_least_at_most_closed L.sup_upper subset_trans)
    5.11          show "\<And>y. y \<in> Upper (L\<lparr>carrier := \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>\<rparr>) A \<Longrightarrow> \<Squnion>\<^bsub>L\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> y"
    5.12            using a L.at_least_at_most_closed by (rule_tac L.sup_least, auto intro: funcset_mem simp add: Upper_def)
    5.13 -        from a show "A \<subseteq> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.14 -          by (auto)
    5.15 -        from a show "\<Squnion>\<^bsub>L\<^esub>A \<in> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.16 -          apply (rule_tac L.at_least_at_most_member)
    5.17 -          apply (auto)
    5.18 -          apply (meson L.at_least_at_most_closed L.sup_closed subset_trans)
    5.19 -          apply (meson False L.at_least_at_most_closed L.at_least_at_most_lower L.le_trans L.sup_closed b all_not_in_conv assms(2) contra_subsetD subset_trans)
    5.20 -          apply (rule L.sup_least)
    5.21 -          apply (auto simp add: assms)
    5.22 -          using L.at_least_at_most_closed apply blast
    5.23 -        done
    5.24 +        from a show *: "A \<subseteq> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.25 +          by auto
    5.26 +        show "\<Squnion>\<^bsub>L\<^esub>A \<in> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.27 +        proof (rule_tac L.at_least_at_most_member)
    5.28 +          show 1: "\<Squnion>\<^bsub>L\<^esub>A \<in> carrier L"
    5.29 +            by (meson L.at_least_at_most_closed L.sup_closed subset_trans *)
    5.30 +          show "a \<sqsubseteq>\<^bsub>L\<^esub> \<Squnion>\<^bsub>L\<^esub>A"
    5.31 +            by (meson "*" False L.at_least_at_most_closed L.at_least_at_most_lower L.le_trans L.sup_upper 1 all_not_in_conv assms(2) set_mp subset_trans)
    5.32 +          show "\<Squnion>\<^bsub>L\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> b"
    5.33 +          proof (rule L.sup_least)
    5.34 +            show "A \<subseteq> carrier L" "\<And>x. x \<in> A \<Longrightarrow> x \<sqsubseteq>\<^bsub>L\<^esub> b"
    5.35 +              using * L.at_least_at_most_closed by blast+
    5.36 +          qed (simp add: assms)
    5.37 +        qed
    5.38        qed
    5.39      qed
    5.40      show "\<exists>s. is_glb (L\<lparr>carrier := \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>\<rparr>) s A"
    5.41 @@ -711,15 +714,17 @@
    5.42            using a L.at_least_at_most_closed by (force intro!: L.inf_lower)
    5.43          show "\<And>y. y \<in> Lower (L\<lparr>carrier := \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>\<rparr>) A \<Longrightarrow> y \<sqsubseteq>\<^bsub>L\<^esub> \<Sqinter>\<^bsub>L\<^esub>A"
    5.44             using a L.at_least_at_most_closed by (rule_tac L.inf_greatest, auto intro: funcset_carrier' simp add: Lower_def)
    5.45 -        from a show "A \<subseteq> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.46 -          by (auto)
    5.47 -        from a show "\<Sqinter>\<^bsub>L\<^esub>A \<in> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.48 -          apply (rule_tac L.at_least_at_most_member)
    5.49 -          apply (auto)
    5.50 -          apply (meson L.at_least_at_most_closed L.inf_closed subset_trans)
    5.51 -          apply (meson L.at_least_at_most_closed L.at_least_at_most_lower L.inf_greatest assms(2) set_rev_mp subset_trans)
    5.52 -          apply (meson False L.at_least_at_most_closed L.at_least_at_most_upper L.inf_closed L.le_trans b all_not_in_conv assms(3) contra_subsetD subset_trans)            
    5.53 -        done
    5.54 +        from a show *: "A \<subseteq> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.55 +          by auto
    5.56 +        show "\<Sqinter>\<^bsub>L\<^esub>A \<in> \<lbrace>a..b\<rbrace>\<^bsub>L\<^esub>"
    5.57 +        proof (rule_tac L.at_least_at_most_member)
    5.58 +          show 1: "\<Sqinter>\<^bsub>L\<^esub>A \<in> carrier L"
    5.59 +            by (meson "*" L.at_least_at_most_closed L.inf_closed subset_trans)
    5.60 +          show "a \<sqsubseteq>\<^bsub>L\<^esub> \<Sqinter>\<^bsub>L\<^esub>A"
    5.61 +            by (meson "*" L.at_least_at_most_closed L.at_least_at_most_lower L.inf_greatest assms(2) subsetD subset_trans)
    5.62 +          show "\<Sqinter>\<^bsub>L\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> b"
    5.63 +            by (meson * 1 False L.at_least_at_most_closed L.at_least_at_most_upper L.inf_lower L.le_trans all_not_in_conv assms(3) set_mp subset_trans)
    5.64 +        qed
    5.65        qed
    5.66      qed
    5.67    qed
    5.68 @@ -731,7 +736,7 @@
    5.69  text \<open>The set of fixed points of a complete lattice is itself a complete lattice\<close>
    5.70  
    5.71  theorem Knaster_Tarski:
    5.72 -  assumes "weak_complete_lattice L" "f \<in> carrier L \<rightarrow> carrier L" "isotone L L f"
    5.73 +  assumes "weak_complete_lattice L" and f: "f \<in> carrier L \<rightarrow> carrier L" and "isotone L L f"
    5.74    shows "weak_complete_lattice (fpl L f)" (is "weak_complete_lattice ?L'")
    5.75  proof -
    5.76    interpret L: weak_complete_lattice L
    5.77 @@ -805,15 +810,14 @@
    5.78        show "is_lub ?L'' (LFP\<^bsub>?L'\<^esub> f) A"
    5.79        proof (rule least_UpperI, simp_all)
    5.80          fix x
    5.81 -        assume "x \<in> Upper ?L'' A"
    5.82 -        hence "LFP\<^bsub>?L'\<^esub> f \<sqsubseteq>\<^bsub>?L'\<^esub> x"
    5.83 -          apply (rule_tac L'.LFP_lowerbound)
    5.84 -          apply (auto simp add: Upper_def)
    5.85 -          apply (simp add: A AL L.at_least_at_most_member L.sup_least set_rev_mp)          
    5.86 -          apply (simp add: Pi_iff assms(2) fps_def, rule_tac L.weak_refl)
    5.87 -          apply (auto)
    5.88 -          apply (rule funcset_mem[of f "carrier L"], simp_all add: assms(2))
    5.89 -        done
    5.90 +        assume x: "x \<in> Upper ?L'' A"
    5.91 +        have "LFP\<^bsub>?L'\<^esub> f \<sqsubseteq>\<^bsub>?L'\<^esub> x"
    5.92 +        proof (rule L'.LFP_lowerbound, simp_all)
    5.93 +          show "x \<in> \<lbrace>\<Squnion>\<^bsub>L\<^esub>A..\<top>\<^bsub>L\<^esub>\<rbrace>\<^bsub>L\<^esub>"
    5.94 +            using x by (auto simp add: Upper_def A AL L.at_least_at_most_member L.sup_least set_rev_mp)    
    5.95 +          with x show "f x \<sqsubseteq>\<^bsub>L\<^esub> x"
    5.96 +            by (simp add: Upper_def) (meson L.at_least_at_most_closed L.use_fps L.weak_refl subsetD f_top_chain imageI)
    5.97 +        qed
    5.98          thus " LFP\<^bsub>?L'\<^esub> f \<sqsubseteq>\<^bsub>L\<^esub> x"
    5.99            by (simp)
   5.100        next
   5.101 @@ -838,17 +842,13 @@
   5.102               by (auto simp add: at_least_at_most_def)
   5.103            have "LFP\<^bsub>?L'\<^esub> f .=\<^bsub>?L'\<^esub> f (LFP\<^bsub>?L'\<^esub> f)"
   5.104            proof (rule "L'.LFP_weak_unfold", simp_all)
   5.105 -            show "f \<in> \<lbrace>\<Squnion>\<^bsub>L\<^esub>A..\<top>\<^bsub>L\<^esub>\<rbrace>\<^bsub>L\<^esub> \<rightarrow> \<lbrace>\<Squnion>\<^bsub>L\<^esub>A..\<top>\<^bsub>L\<^esub>\<rbrace>\<^bsub>L\<^esub>"
   5.106 -              apply (auto simp add: Pi_def at_least_at_most_def)
   5.107 -              using assms(2) apply blast
   5.108 -              apply (meson AL funcset_mem L.le_trans L.sup_closed assms(2) assms(3) pf_w use_iso2)
   5.109 -              using assms(2) apply blast
   5.110 -            done
   5.111 -            from assms(3) show "Mono\<^bsub>L\<lparr>carrier := \<lbrace>\<Squnion>\<^bsub>L\<^esub>A..\<top>\<^bsub>L\<^esub>\<rbrace>\<^bsub>L\<^esub>\<rparr>\<^esub> f"
   5.112 -              apply (auto simp add: isotone_def)
   5.113 -              using L'.weak_partial_order_axioms apply blast
   5.114 -              apply (meson L.at_least_at_most_closed subsetCE)
   5.115 -            done
   5.116 +            have "\<And>x. \<lbrakk>x \<in> carrier L; \<Squnion>\<^bsub>L\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> x\<rbrakk> \<Longrightarrow> \<Squnion>\<^bsub>L\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> f x"
   5.117 +              by (meson AL funcset_mem L.le_trans L.sup_closed assms(2) assms(3) pf_w use_iso2)
   5.118 +            with f show "f \<in> \<lbrace>\<Squnion>\<^bsub>L\<^esub>A..\<top>\<^bsub>L\<^esub>\<rbrace>\<^bsub>L\<^esub> \<rightarrow> \<lbrace>\<Squnion>\<^bsub>L\<^esub>A..\<top>\<^bsub>L\<^esub>\<rbrace>\<^bsub>L\<^esub>"
   5.119 +              by (auto simp add: Pi_def at_least_at_most_def)
   5.120 +            show "Mono\<^bsub>L\<lparr>carrier := \<lbrace>\<Squnion>\<^bsub>L\<^esub>A..\<top>\<^bsub>L\<^esub>\<rbrace>\<^bsub>L\<^esub>\<rparr>\<^esub> f"
   5.121 +              using L'.weak_partial_order_axioms assms(3) 
   5.122 +              by (auto simp add: isotone_def) (meson L.at_least_at_most_closed subsetCE)
   5.123            qed
   5.124            thus "f (LFP\<^bsub>?L'\<^esub> f) .=\<^bsub>L\<^esub> LFP\<^bsub>?L'\<^esub> f"
   5.125              by (simp add: L.equivalence_axioms funcset_carrier' c assms(2) equivalence.sym) 
   5.126 @@ -889,7 +889,6 @@
   5.127            thus ?thesis
   5.128              by (meson AL L.inf_closed L.le_trans assms(3) b(1) b(2) fx use_iso2 w)
   5.129          qed
   5.130 -   
   5.131          show "\<bottom>\<^bsub>L\<^esub> \<sqsubseteq>\<^bsub>L\<^esub> f x"
   5.132            by (simp add: fx)
   5.133        qed
   5.134 @@ -905,12 +904,16 @@
   5.135        proof (rule greatest_LowerI, simp_all)
   5.136          fix x
   5.137          assume "x \<in> Lower ?L'' A"
   5.138 -        hence "x \<sqsubseteq>\<^bsub>?L'\<^esub> GFP\<^bsub>?L'\<^esub> f"
   5.139 -          apply (rule_tac L'.GFP_upperbound)
   5.140 -          apply (auto simp add: Lower_def)
   5.141 -          apply (meson A AL L.at_least_at_most_member L.bottom_lower L.weak_complete_lattice_axioms fps_carrier subsetCE weak_complete_lattice.inf_greatest)
   5.142 -          apply (simp add: funcset_carrier' L.sym assms(2) fps_def)          
   5.143 -        done
   5.144 +        then have x: "\<forall>y. y \<in> A \<and> y \<in> fps L f \<longrightarrow> x \<sqsubseteq>\<^bsub>L\<^esub> y" "x \<in> fps L f"
   5.145 +          by (auto simp add: Lower_def)
   5.146 +        have "x \<sqsubseteq>\<^bsub>?L'\<^esub> GFP\<^bsub>?L'\<^esub> f"
   5.147 +          unfolding Lower_def
   5.148 +        proof (rule_tac L'.GFP_upperbound; simp)
   5.149 +          show "x \<in> \<lbrace>\<bottom>\<^bsub>L\<^esub>..\<Sqinter>\<^bsub>L\<^esub>A\<rbrace>\<^bsub>L\<^esub>"
   5.150 +            by (meson x A AL L.at_least_at_most_member L.bottom_lower L.inf_greatest contra_subsetD fps_carrier)
   5.151 +          show "x \<sqsubseteq>\<^bsub>L\<^esub> f x"
   5.152 +            using x by (simp add: funcset_carrier' L.sym assms(2) fps_def)
   5.153 +        qed
   5.154          thus "x \<sqsubseteq>\<^bsub>L\<^esub> GFP\<^bsub>?L'\<^esub> f"
   5.155            by (simp)
   5.156        next
   5.157 @@ -935,17 +938,14 @@
   5.158               by (auto simp add: at_least_at_most_def)
   5.159            have "GFP\<^bsub>?L'\<^esub> f .=\<^bsub>?L'\<^esub> f (GFP\<^bsub>?L'\<^esub> f)"
   5.160            proof (rule "L'.GFP_weak_unfold", simp_all)
   5.161 -            show "f \<in> \<lbrace>\<bottom>\<^bsub>L\<^esub>..?w\<rbrace>\<^bsub>L\<^esub> \<rightarrow> \<lbrace>\<bottom>\<^bsub>L\<^esub>..?w\<rbrace>\<^bsub>L\<^esub>"
   5.162 -              apply (auto simp add: Pi_def at_least_at_most_def)
   5.163 -              using assms(2) apply blast
   5.164 -              apply (simp add: funcset_carrier' assms(2))
   5.165 -              apply (meson AL funcset_carrier L.inf_closed L.le_trans assms(2) assms(3) pf_w use_iso2)
   5.166 -            done
   5.167 -            from assms(3) show "Mono\<^bsub>L\<lparr>carrier := \<lbrace>\<bottom>\<^bsub>L\<^esub>..?w\<rbrace>\<^bsub>L\<^esub>\<rparr>\<^esub> f"
   5.168 -              apply (auto simp add: isotone_def)
   5.169 -              using L'.weak_partial_order_axioms apply blast
   5.170 -              using L.at_least_at_most_closed apply (blast intro: funcset_carrier')
   5.171 -            done
   5.172 +            have "\<And>x. \<lbrakk>x \<in> carrier L; x \<sqsubseteq>\<^bsub>L\<^esub> \<Sqinter>\<^bsub>L\<^esub>A\<rbrakk> \<Longrightarrow> f x \<sqsubseteq>\<^bsub>L\<^esub> \<Sqinter>\<^bsub>L\<^esub>A"
   5.173 +              by (meson AL funcset_carrier L.inf_closed L.le_trans assms(2) assms(3) pf_w use_iso2)
   5.174 +            with assms(2) show "f \<in> \<lbrace>\<bottom>\<^bsub>L\<^esub>..?w\<rbrace>\<^bsub>L\<^esub> \<rightarrow> \<lbrace>\<bottom>\<^bsub>L\<^esub>..?w\<rbrace>\<^bsub>L\<^esub>"
   5.175 +              by (auto simp add: Pi_def at_least_at_most_def)
   5.176 +            have "\<And>x y. \<lbrakk>x \<in> \<lbrace>\<bottom>\<^bsub>L\<^esub>..\<Sqinter>\<^bsub>L\<^esub>A\<rbrace>\<^bsub>L\<^esub>; y \<in> \<lbrace>\<bottom>\<^bsub>L\<^esub>..\<Sqinter>\<^bsub>L\<^esub>A\<rbrace>\<^bsub>L\<^esub>; x \<sqsubseteq>\<^bsub>L\<^esub> y\<rbrakk> \<Longrightarrow> f x \<sqsubseteq>\<^bsub>L\<^esub> f y"
   5.177 +              by (meson L.at_least_at_most_closed subsetD use_iso1  assms(3)) 
   5.178 +            with L'.weak_partial_order_axioms show "Mono\<^bsub>L\<lparr>carrier := \<lbrace>\<bottom>\<^bsub>L\<^esub>..?w\<rbrace>\<^bsub>L\<^esub>\<rparr>\<^esub> f"
   5.179 +              by (auto simp add: isotone_def)
   5.180            qed
   5.181            thus "f (GFP\<^bsub>?L'\<^esub> f) .=\<^bsub>L\<^esub> GFP\<^bsub>?L'\<^esub> f"
   5.182              by (simp add: L.equivalence_axioms funcset_carrier' c assms(2) equivalence.sym) 
   5.183 @@ -1117,17 +1117,16 @@
   5.184      qed
   5.185      show "\<Sqinter>\<^bsub>fpl L f\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> f (\<Sqinter>\<^bsub>L\<^esub>A)"
   5.186      proof -
   5.187 +      have *: "\<Sqinter>\<^bsub>fpl L f\<^esub>A \<in> carrier L"
   5.188 +        using FA infA by blast
   5.189        have "\<And>x. x \<in> A \<Longrightarrow> \<Sqinter>\<^bsub>fpl L f\<^esub>A \<sqsubseteq>\<^bsub>fpl L f\<^esub> x"
   5.190          by (rule L'.inf_lower, simp_all add: assms)
   5.191        hence "\<Sqinter>\<^bsub>fpl L f\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> (\<Sqinter>\<^bsub>L\<^esub>A)"
   5.192 -        apply (rule_tac L.inf_greatest, simp_all add: A)
   5.193 -        using FA infA apply blast
   5.194 -        done
   5.195 +        by (rule_tac L.inf_greatest, simp_all add: A *)
   5.196        hence 1:"f(\<Sqinter>\<^bsub>fpl L f\<^esub>A) \<sqsubseteq>\<^bsub>L\<^esub> f(\<Sqinter>\<^bsub>L\<^esub>A)"
   5.197          by (metis (no_types, lifting) A FA L.inf_closed assms(2) infA subsetCE use_iso1)
   5.198        have 2:"\<Sqinter>\<^bsub>fpl L f\<^esub>A \<sqsubseteq>\<^bsub>L\<^esub> f (\<Sqinter>\<^bsub>fpl L f\<^esub>A)"
   5.199          by (metis (no_types, lifting) FA L.sym L.use_fps L.weak_complete_lattice_axioms PiE assms(4) infA subsetCE weak_complete_lattice_def weak_partial_order.weak_refl)
   5.200 -        
   5.201        show ?thesis  
   5.202          using FA fA infA by (auto intro!: L.le_trans[OF 2 1] ic fc, metis FA PiE assms(4) subsetCE)
   5.203      qed
   5.204 @@ -1189,21 +1188,11 @@
   5.205  lemma sup_pres_is_join_pres:
   5.206    assumes "weak_sup_pres X Y f"
   5.207    shows "join_pres X Y f"
   5.208 -  using assms
   5.209 -  apply (simp add: join_pres_def weak_sup_pres_def, safe)
   5.210 -  apply (rename_tac x y)
   5.211 -  apply (drule_tac x="{x, y}" in spec)
   5.212 -  apply (auto simp add: join_def)
   5.213 -done
   5.214 +  using assms by (auto simp: join_pres_def weak_sup_pres_def join_def)
   5.215  
   5.216  lemma inf_pres_is_meet_pres:
   5.217    assumes "weak_inf_pres X Y f"
   5.218    shows "meet_pres X Y f"
   5.219 -  using assms
   5.220 -  apply (simp add: meet_pres_def weak_inf_pres_def, safe)
   5.221 -  apply (rename_tac x y)
   5.222 -  apply (drule_tac x="{x, y}" in spec)
   5.223 -  apply (auto simp add: meet_def)
   5.224 -done
   5.225 +  using assms by (auto simp: meet_pres_def weak_inf_pres_def meet_def)
   5.226  
   5.227  end
     6.1 --- a/src/HOL/Algebra/Coset.thy	Tue Aug 07 11:39:40 2018 +0200
     6.2 +++ b/src/HOL/Algebra/Coset.thy	Sat Aug 11 16:02:55 2018 +0200
     6.3 @@ -440,45 +440,36 @@
     6.4    shows "N \<lhd> G"
     6.5    using assms normal_inv_iff by blast
     6.6  
     6.7 -corollary (in group) normal_invE:
     6.8 -  assumes "N \<lhd> G"
     6.9 -  shows "subgroup N G" and "\<And>x h. \<lbrakk> x \<in> carrier G; h \<in> N \<rbrakk> \<Longrightarrow> x \<otimes> h \<otimes> inv x \<in> N"
    6.10 -  using assms normal_inv_iff apply blast
    6.11 -  by (simp add: assms normal.inv_op_closed2)
    6.12 -
    6.13 -
    6.14 -lemma (in group) one_is_normal :
    6.15 -   "{\<one>} \<lhd> G"
    6.16 -proof(intro normal_invI )
    6.17 +lemma (in group) one_is_normal: "{\<one>} \<lhd> G"
    6.18 +proof(intro normal_invI)
    6.19    show "subgroup {\<one>} G"
    6.20      by (simp add: subgroup_def)
    6.21 -  show "\<And>x h. x \<in> carrier G \<Longrightarrow> h \<in> {\<one>} \<Longrightarrow> x \<otimes> h \<otimes> inv x \<in> {\<one>}" by simp
    6.22 -qed
    6.23 +qed simp
    6.24  
    6.25  
    6.26  subsection\<open>More Properties of Left Cosets\<close>
    6.27  
    6.28  lemma (in group) l_repr_independence:
    6.29 -  assumes "y \<in> x <# H" "x \<in> carrier G" "subgroup H G"
    6.30 +  assumes "y \<in> x <# H" "x \<in> carrier G" and HG: "subgroup H G"
    6.31    shows "x <# H = y <# H"
    6.32  proof -
    6.33    obtain h' where h': "h' \<in> H" "y = x \<otimes> h'"
    6.34      using assms(1) unfolding l_coset_def by blast
    6.35    hence "x \<otimes> h = y \<otimes> ((inv h') \<otimes> h)" if "h \<in> H" for h
    6.36    proof -
    6.37 -    have f3: "h' \<in> carrier G"
    6.38 -      by (meson assms(3) h'(1) subgroup.mem_carrier)
    6.39 -    have f4: "h \<in> carrier G"
    6.40 -      by (meson assms(3) subgroup.mem_carrier that)
    6.41 -    then show ?thesis
    6.42 -      by (metis assms(2) f3 h'(2) inv_closed inv_solve_right m_assoc m_closed)
    6.43 +    have "h' \<in> carrier G"
    6.44 +      by (meson HG h'(1) subgroup.mem_carrier)
    6.45 +    moreover have "h \<in> carrier G"
    6.46 +      by (meson HG subgroup.mem_carrier that)
    6.47 +    ultimately show ?thesis
    6.48 +      by (metis assms(2) h'(2) inv_closed inv_solve_right m_assoc m_closed)
    6.49    qed
    6.50 -  hence "\<And> xh. xh \<in> x <# H \<Longrightarrow> xh \<in> y <# H"
    6.51 -    unfolding l_coset_def by (metis (no_types, lifting) UN_iff assms(3) h'(1) subgroup_def)
    6.52 -  moreover have "\<And> h. h \<in> H \<Longrightarrow> y \<otimes> h = x \<otimes> (h' \<otimes> h)"
    6.53 -    using h' by (meson assms(2) assms(3) m_assoc subgroup.mem_carrier)
    6.54 -  hence "\<And> yh. yh \<in> y <# H \<Longrightarrow> yh \<in> x <# H"
    6.55 -    unfolding l_coset_def using subgroup.m_closed[OF assms(3) h'(1)] by blast
    6.56 +  hence "\<And>xh. xh \<in> x <# H \<Longrightarrow> xh \<in> y <# H"
    6.57 +    unfolding l_coset_def by (metis (no_types, lifting) UN_iff HG h'(1) subgroup_def)
    6.58 +  moreover have "\<And>h. h \<in> H \<Longrightarrow> y \<otimes> h = x \<otimes> (h' \<otimes> h)"
    6.59 +    using h' by (meson assms(2) HG m_assoc subgroup.mem_carrier)
    6.60 +  hence "\<And>yh. yh \<in> y <# H \<Longrightarrow> yh \<in> x <# H"
    6.61 +    unfolding l_coset_def using subgroup.m_closed[OF HG h'(1)] by blast
    6.62    ultimately show ?thesis by blast
    6.63  qed
    6.64  
    6.65 @@ -655,8 +646,8 @@
    6.66    shows "hb \<otimes> a \<in> (\<Union>h\<in>H. {h \<otimes> b})"
    6.67  proof -
    6.68    interpret subgroup H G by fact
    6.69 -  from p show ?thesis apply (rule_tac UN_I [of "hb \<otimes> ((inv ha) \<otimes> h)"])
    6.70 -    apply blast by (simp add: inv_solve_left m_assoc)
    6.71 +  from p show ?thesis 
    6.72 +    by (rule_tac UN_I [of "hb \<otimes> ((inv ha) \<otimes> h)"]) (auto simp: inv_solve_left m_assoc)
    6.73  qed
    6.74  
    6.75  lemma (in group) rcos_disjoint:
    6.76 @@ -666,9 +657,8 @@
    6.77  proof -
    6.78    interpret subgroup H G by fact
    6.79    from p show ?thesis
    6.80 -    apply (simp add: RCOSETS_def r_coset_def)
    6.81 -    apply (blast intro: rcos_equation assms sym)
    6.82 -    done
    6.83 +    unfolding RCOSETS_def r_coset_def
    6.84 +    by (blast intro: rcos_equation assms sym)
    6.85  qed
    6.86  
    6.87  
    6.88 @@ -761,26 +751,26 @@
    6.89  proof -
    6.90    interpret subgroup H G by fact
    6.91    show ?thesis
    6.92 -    apply (rule equalityI)
    6.93 -    apply (force simp add: RCOSETS_def r_coset_def)
    6.94 -    apply (auto simp add: RCOSETS_def intro: rcos_self assms)
    6.95 -    done
    6.96 +    unfolding RCOSETS_def r_coset_def by auto
    6.97  qed
    6.98  
    6.99  lemma (in group) cosets_finite:
   6.100       "\<lbrakk>c \<in> rcosets H;  H \<subseteq> carrier G;  finite (carrier G)\<rbrakk> \<Longrightarrow> finite c"
   6.101 -apply (auto simp add: RCOSETS_def)
   6.102 -apply (simp add: r_coset_subset_G [THEN finite_subset])
   6.103 -done
   6.104 +  unfolding RCOSETS_def
   6.105 +  by (auto simp add: r_coset_subset_G [THEN finite_subset])
   6.106  
   6.107  text\<open>The next two lemmas support the proof of \<open>card_cosets_equal\<close>.\<close>
   6.108  lemma (in group) inj_on_f:
   6.109 -    "\<lbrakk>H \<subseteq> carrier G;  a \<in> carrier G\<rbrakk> \<Longrightarrow> inj_on (\<lambda>y. y \<otimes> inv a) (H #> a)"
   6.110 -apply (rule inj_onI)
   6.111 -apply (subgoal_tac "x \<in> carrier G \<and> y \<in> carrier G")
   6.112 - prefer 2 apply (blast intro: r_coset_subset_G [THEN subsetD])
   6.113 -apply (simp add: subsetD)
   6.114 -done
   6.115 +  assumes "H \<subseteq> carrier G" and a: "a \<in> carrier G"
   6.116 +  shows "inj_on (\<lambda>y. y \<otimes> inv a) (H #> a)"
   6.117 +proof 
   6.118 +  fix x y
   6.119 +  assume "x \<in> H #> a" "y \<in> H #> a" and xy: "x \<otimes> inv a = y \<otimes> inv a"
   6.120 +  then have "x \<in> carrier G" "y \<in> carrier G"
   6.121 +    using assms r_coset_subset_G by blast+
   6.122 +  with xy a show "x = y"
   6.123 +    by auto
   6.124 +qed
   6.125  
   6.126  lemma (in group) inj_on_g:
   6.127      "\<lbrakk>H \<subseteq> carrier G;  a \<in> carrier G\<rbrakk> \<Longrightarrow> inj_on (\<lambda>y. y \<otimes> a) H"
   6.128 @@ -827,16 +817,17 @@
   6.129    using rcosets_part_G by auto
   6.130  
   6.131  proposition (in group) lagrange_finite:
   6.132 -     "\<lbrakk>finite(carrier G); subgroup H G\<rbrakk>
   6.133 -      \<Longrightarrow> card(rcosets H) * card(H) = order(G)"
   6.134 -apply (simp (no_asm_simp) add: order_def rcosets_part_G [symmetric])
   6.135 -apply (subst mult.commute)
   6.136 -apply (rule card_partition)
   6.137 -   apply (simp add: rcosets_subset_PowG [THEN finite_subset])
   6.138 -  apply (simp add: rcosets_part_G)
   6.139 -  apply (simp add: card_rcosets_equal subgroup.subset)
   6.140 -apply (simp add: rcos_disjoint)
   6.141 -done
   6.142 +  assumes "finite(carrier G)" and HG: "subgroup H G"
   6.143 +  shows "card(rcosets H) * card(H) = order(G)"
   6.144 +proof -
   6.145 +  have "card H * card (rcosets H) = card (\<Union>(rcosets H))"
   6.146 +  proof (rule card_partition)
   6.147 +    show "\<And>c1 c2. \<lbrakk>c1 \<in> rcosets H; c2 \<in> rcosets H; c1 \<noteq> c2\<rbrakk> \<Longrightarrow> c1 \<inter> c2 = {}"
   6.148 +      using HG rcos_disjoint by auto
   6.149 +  qed (auto simp: assms finite_UnionD rcosets_part_G card_rcosets_equal subgroup.subset)
   6.150 +  then show ?thesis
   6.151 +    by (simp add: HG mult.commute order_def rcosets_part_G)
   6.152 +qed
   6.153  
   6.154  theorem (in group) lagrange:
   6.155    assumes "subgroup H G"
   6.156 @@ -844,29 +835,29 @@
   6.157  proof (cases "finite (carrier G)")
   6.158    case True thus ?thesis using lagrange_finite assms by simp
   6.159  next
   6.160 -  case False note inf_G = this
   6.161 +  case False 
   6.162    thus ?thesis
   6.163    proof (cases "finite H")
   6.164 -    case False thus ?thesis using inf_G  by (simp add: order_def)
   6.165 +    case False thus ?thesis using \<open>infinite (carrier G)\<close>  by (simp add: order_def)
   6.166    next
   6.167 -    case True note finite_H = this
   6.168 +    case True 
   6.169      have "infinite (rcosets H)"
   6.170 -    proof (rule ccontr)
   6.171 -      assume "\<not> infinite (rcosets H)"
   6.172 +    proof 
   6.173 +      assume "finite (rcosets H)"
   6.174        hence finite_rcos: "finite (rcosets H)" by simp
   6.175        hence "card (\<Union>(rcosets H)) = (\<Sum>R\<in>(rcosets H). card R)"
   6.176 -        using card_Union_disjoint[of "rcosets H"] finite_H rcos_disjoint[OF assms(1)]
   6.177 +        using card_Union_disjoint[of "rcosets H"] \<open>finite H\<close> rcos_disjoint[OF assms(1)]
   6.178                rcosets_finite[where ?H = H] by (simp add: assms subgroup.subset)
   6.179        hence "order G = (\<Sum>R\<in>(rcosets H). card R)"
   6.180          by (simp add: assms order_def rcosets_part_G)
   6.181        hence "order G = (\<Sum>R\<in>(rcosets H). card H)"
   6.182          using card_rcosets_equal by (simp add: assms subgroup.subset)
   6.183        hence "order G = (card H) * (card (rcosets H))" by simp
   6.184 -      hence "order G \<noteq> 0" using finite_rcos finite_H assms ex_in_conv
   6.185 +      hence "order G \<noteq> 0" using finite_rcos \<open>finite H\<close> assms ex_in_conv
   6.186                                  rcosets_part_G subgroup.one_closed by fastforce
   6.187 -      thus False using inf_G order_gt_0_iff_finite by blast
   6.188 +      thus False using \<open>infinite (carrier G)\<close> order_gt_0_iff_finite by blast
   6.189      qed
   6.190 -    thus ?thesis using inf_G by (simp add: order_def)
   6.191 +    thus ?thesis using \<open>infinite (carrier G)\<close> by (simp add: order_def)
   6.192    qed
   6.193  qed
   6.194  
   6.195 @@ -908,8 +899,8 @@
   6.196  
   6.197  theorem (in normal) factorgroup_is_group:
   6.198    "group (G Mod H)"
   6.199 -apply (simp add: FactGroup_def)
   6.200 -apply (rule groupI)
   6.201 +  unfolding FactGroup_def
   6.202 +  apply (rule groupI)
   6.203      apply (simp add: setmult_closed)
   6.204     apply (simp add: normal_imp_subgroup subgroup_in_rcosets [OF is_group])
   6.205    apply (simp add: restrictI setmult_closed rcosets_assoc)
   6.206 @@ -922,10 +913,20 @@
   6.207    by (simp add: FactGroup_def)
   6.208  
   6.209  lemma (in normal) inv_FactGroup:
   6.210 -     "X \<in> carrier (G Mod H) \<Longrightarrow> inv\<^bsub>G Mod H\<^esub> X = set_inv X"
   6.211 -apply (rule group.inv_equality [OF factorgroup_is_group])
   6.212 -apply (simp_all add: FactGroup_def setinv_closed rcosets_inv_mult_group_eq)
   6.213 -done
   6.214 +  assumes "X \<in> carrier (G Mod H)"
   6.215 +  shows "inv\<^bsub>G Mod H\<^esub> X = set_inv X"
   6.216 +proof -
   6.217 +  have X: "X \<in> rcosets H"
   6.218 +    using assms by (simp add: FactGroup_def)
   6.219 +  moreover have "set_inv X <#> X = H"
   6.220 +    using X by (simp add: normal.rcosets_inv_mult_group_eq normal_axioms)
   6.221 +  moreover have "Group.group (G Mod H)"
   6.222 +    using normal.factorgroup_is_group normal_axioms by blast
   6.223 +  moreover have "set_inv X \<in> rcosets H"
   6.224 +    by (simp add: \<open>X \<in> rcosets H\<close> setinv_closed)
   6.225 +  ultimately show ?thesis
   6.226 +    by (simp add: FactGroup_def group.inv_equality)
   6.227 +qed
   6.228  
   6.229  text\<open>The coset map is a homomorphism from @{term G} to the quotient group
   6.230    @{term "G Mod H"}\<close>
   6.231 @@ -945,15 +946,13 @@
   6.232    where "kernel G H h = {x. x \<in> carrier G \<and> h x = \<one>\<^bsub>H\<^esub>}"
   6.233  
   6.234  lemma (in group_hom) subgroup_kernel: "subgroup (kernel G H h) G"
   6.235 -apply (rule subgroup.intro)
   6.236 -apply (auto simp add: kernel_def group.intro is_group)
   6.237 -done
   6.238 +  by (auto simp add: kernel_def group.intro is_group intro: subgroup.intro)
   6.239  
   6.240  text\<open>The kernel of a homomorphism is a normal subgroup\<close>
   6.241  lemma (in group_hom) normal_kernel: "(kernel G H h) \<lhd> G"
   6.242 -apply (simp add: G.normal_inv_iff subgroup_kernel)
   6.243 -apply (simp add: kernel_def)
   6.244 -done
   6.245 +  apply (simp only: G.normal_inv_iff subgroup_kernel)
   6.246 +  apply (simp add: kernel_def)
   6.247 +  done
   6.248  
   6.249  lemma (in group_hom) FactGroup_nonempty:
   6.250    assumes X: "X \<in> carrier (G Mod kernel G H h)"
   6.251 @@ -982,37 +981,40 @@
   6.252  
   6.253  lemma (in group_hom) FactGroup_hom:
   6.254       "(\<lambda>X. the_elem (h`X)) \<in> hom (G Mod (kernel G H h)) H"
   6.255 -apply (simp add: hom_def FactGroup_the_elem_mem normal.factorgroup_is_group [OF normal_kernel] group.axioms monoid.m_closed)
   6.256 -proof (intro ballI)
   6.257 -  fix X and X'
   6.258 -  assume X:  "X  \<in> carrier (G Mod kernel G H h)"
   6.259 -     and X': "X' \<in> carrier (G Mod kernel G H h)"
   6.260 -  then
   6.261 -  obtain g and g'
   6.262 -           where "g \<in> carrier G" and "g' \<in> carrier G"
   6.263 -             and "X = kernel G H h #> g" and "X' = kernel G H h #> g'"
   6.264 -    by (auto simp add: FactGroup_def RCOSETS_def)
   6.265 -  hence all: "\<forall>x\<in>X. h x = h g" "\<forall>x\<in>X'. h x = h g'"
   6.266 -    and Xsub: "X \<subseteq> carrier G" and X'sub: "X' \<subseteq> carrier G"
   6.267 -    by (force simp add: kernel_def r_coset_def image_def)+
   6.268 -  hence "h ` (X <#> X') = {h g \<otimes>\<^bsub>H\<^esub> h g'}" using X X'
   6.269 -    by (auto dest!: FactGroup_nonempty intro!: image_eqI
   6.270 -             simp add: set_mult_def
   6.271 -                       subsetD [OF Xsub] subsetD [OF X'sub])
   6.272 -  then show "the_elem (h ` (X <#> X')) = the_elem (h ` X) \<otimes>\<^bsub>H\<^esub> the_elem (h ` X')"
   6.273 -    by (auto simp add: all FactGroup_nonempty X X' the_elem_image_unique)
   6.274 +proof -
   6.275 +  have "the_elem (h ` (X <#> X')) = the_elem (h ` X) \<otimes>\<^bsub>H\<^esub> the_elem (h ` X')"
   6.276 +    if X: "X  \<in> carrier (G Mod kernel G H h)" and X': "X' \<in> carrier (G Mod kernel G H h)" for X X'
   6.277 +  proof -
   6.278 +    obtain g and g'
   6.279 +      where "g \<in> carrier G" and "g' \<in> carrier G"
   6.280 +        and "X = kernel G H h #> g" and "X' = kernel G H h #> g'"
   6.281 +      using X X' by (auto simp add: FactGroup_def RCOSETS_def)
   6.282 +    hence all: "\<forall>x\<in>X. h x = h g" "\<forall>x\<in>X'. h x = h g'"
   6.283 +      and Xsub: "X \<subseteq> carrier G" and X'sub: "X' \<subseteq> carrier G"
   6.284 +      by (force simp add: kernel_def r_coset_def image_def)+
   6.285 +    hence "h ` (X <#> X') = {h g \<otimes>\<^bsub>H\<^esub> h g'}" using X X'
   6.286 +      by (auto dest!: FactGroup_nonempty intro!: image_eqI
   6.287 +          simp add: set_mult_def
   6.288 +          subsetD [OF Xsub] subsetD [OF X'sub])
   6.289 +    then show "the_elem (h ` (X <#> X')) = the_elem (h ` X) \<otimes>\<^bsub>H\<^esub> the_elem (h ` X')"
   6.290 +      by (auto simp add: all FactGroup_nonempty X X' the_elem_image_unique)
   6.291 +  qed
   6.292 +  then show ?thesis
   6.293 +    by (simp add: hom_def FactGroup_the_elem_mem normal.factorgroup_is_group [OF normal_kernel] group.axioms monoid.m_closed)
   6.294  qed
   6.295  
   6.296  
   6.297  text\<open>Lemma for the following injectivity result\<close>
   6.298  lemma (in group_hom) FactGroup_subset:
   6.299 -     "\<lbrakk>g \<in> carrier G; g' \<in> carrier G; h g = h g'\<rbrakk>
   6.300 -      \<Longrightarrow>  kernel G H h #> g \<subseteq> kernel G H h #> g'"
   6.301 -apply (clarsimp simp add: kernel_def r_coset_def)
   6.302 -apply (rename_tac y)
   6.303 -apply (rule_tac x="y \<otimes> g \<otimes> inv g'" in exI)
   6.304 -apply (simp add: G.m_assoc)
   6.305 -done
   6.306 +  assumes "g \<in> carrier G" "g' \<in> carrier G" "h g = h g'"
   6.307 +  shows "kernel G H h #> g \<subseteq> kernel G H h #> g'"
   6.308 +  unfolding kernel_def r_coset_def
   6.309 +proof clarsimp
   6.310 +  fix y 
   6.311 +  assume "y \<in> carrier G" "h y = \<one>\<^bsub>H\<^esub>"
   6.312 +  with assms show "\<exists>x. x \<in> carrier G \<and> h x = \<one>\<^bsub>H\<^esub> \<and> y \<otimes> g = x \<otimes> g'"
   6.313 +    by (rule_tac x="y \<otimes> g \<otimes> inv g'" in exI) (auto simp: G.m_assoc)
   6.314 +qed
   6.315  
   6.316  lemma (in group_hom) FactGroup_inj_on:
   6.317       "inj_on (\<lambda>X. the_elem (h ` X)) (carrier (G Mod kernel G H h))"
   6.318 @@ -1113,13 +1115,13 @@
   6.319      from hHN obtain h1 h2 where h1h2 : "h1 \<in> H" "h2 \<in> N" "h = (h1,h2)"
   6.320        unfolding DirProd_def by fastforce
   6.321      hence h1h2GK : "h1 \<in> carrier G" "h2 \<in> carrier K"
   6.322 -      using normal_imp_subgroup subgroup.subset assms apply blast+.
   6.323 +      using normal_imp_subgroup subgroup.subset assms by blast+
   6.324      have "inv\<^bsub>G \<times>\<times> K\<^esub> x = (inv\<^bsub>G\<^esub> x1,inv\<^bsub>K\<^esub> x2)"
   6.325        using inv_DirProd[OF group_axioms assms(1) x1x2(1)x1x2(2)] x1x2 by auto
   6.326      hence "x \<otimes>\<^bsub>G \<times>\<times> K\<^esub> h \<otimes>\<^bsub>G \<times>\<times> K\<^esub> inv\<^bsub>G \<times>\<times> K\<^esub> x = (x1 \<otimes> h1 \<otimes> inv x1,x2 \<otimes>\<^bsub>K\<^esub> h2 \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x2)"
   6.327        using h1h2 x1x2 h1h2GK by auto
   6.328      moreover have "x1 \<otimes> h1 \<otimes> inv x1 \<in> H" "x2 \<otimes>\<^bsub>K\<^esub> h2 \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x2 \<in> N"
   6.329 -      using normal_invE group.normal_invE[OF assms(1)] assms x1x2 h1h2 apply auto.
   6.330 +      using assms x1x2 h1h2 assms by (simp_all add: normal.inv_op_closed2)
   6.331      hence "(x1 \<otimes> h1 \<otimes> inv x1, x2 \<otimes>\<^bsub>K\<^esub> h2 \<otimes>\<^bsub>K\<^esub> inv\<^bsub>K\<^esub> x2)\<in> H \<times> N" by auto
   6.332      ultimately show " x \<otimes>\<^bsub>G \<times>\<times> K\<^esub> h \<otimes>\<^bsub>G \<times>\<times> K\<^esub> inv\<^bsub>G \<times>\<times> K\<^esub> x \<in> H \<times> N" by auto
   6.333    qed
   6.334 @@ -1133,7 +1135,7 @@
   6.335  
   6.336  proof-
   6.337    have R :"(\<lambda>(X, Y). X \<times> Y) \<in> carrier (G Mod H) \<times> carrier (K Mod N) \<rightarrow> carrier (G \<times>\<times> K Mod H \<times> N)"
   6.338 -    unfolding r_coset_def Sigma_def DirProd_def FactGroup_def RCOSETS_def apply simp by blast
   6.339 +    unfolding r_coset_def Sigma_def DirProd_def FactGroup_def RCOSETS_def by force
   6.340    moreover have "(\<forall>x\<in>carrier (G Mod H). \<forall>y\<in>carrier (K Mod N). \<forall>xa\<in>carrier (G Mod H).
   6.341                  \<forall>ya\<in>carrier (K Mod N). (x <#> xa) \<times> (y <#>\<^bsub>K\<^esub> ya) =  x \<times> y <#>\<^bsub>G \<times>\<times> K\<^esub> xa \<times> ya)"
   6.342      unfolding set_mult_def by force
   6.343 @@ -1143,8 +1145,14 @@
   6.344      by (metis assms(2) assms(3) normal_def partial_object.select_convs(1))
   6.345    moreover have "(\<lambda>(X, Y). X \<times> Y) ` (carrier (G Mod H) \<times> carrier (K Mod N)) =
   6.346                                       carrier (G \<times>\<times> K Mod H \<times> N)"
   6.347 -    unfolding image_def  apply auto using R apply force
   6.348 -    unfolding DirProd_def FactGroup_def RCOSETS_def r_coset_def by force
   6.349 +  proof -
   6.350 +    have 1: "\<And>x a b. \<lbrakk>a \<in> carrier (G Mod H); b \<in> carrier (K Mod N)\<rbrakk> \<Longrightarrow> a \<times> b \<in> carrier (G \<times>\<times> K Mod H \<times> N)"
   6.351 +      using R by force
   6.352 +    have 2: "\<And>z. z \<in> carrier (G \<times>\<times> K Mod H \<times> N) \<Longrightarrow> \<exists>x\<in>carrier (G Mod H). \<exists>y\<in>carrier (K Mod N). z = x \<times> y"
   6.353 +      unfolding DirProd_def FactGroup_def RCOSETS_def r_coset_def by force
   6.354 +    show ?thesis
   6.355 +      unfolding image_def by (auto simp: intro: 1 2)
   6.356 +  qed
   6.357    ultimately show ?thesis
   6.358      unfolding iso_def hom_def bij_betw_def inj_on_def by simp
   6.359  qed
   6.360 @@ -1262,7 +1270,7 @@
   6.361        have hH:"h\<in>carrier(GH)"
   6.362          using hHK HK_def GH_def by auto
   6.363        have  "(\<forall>x\<in>carrier (GH). \<forall>h\<in>H1.  x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> H1)"
   6.364 -        using assms normal_invE GH_def normal.inv_op_closed2 by fastforce
   6.365 +        using assms GH_def normal.inv_op_closed2 by fastforce
   6.366        hence INCL_1 : "x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> H1"
   6.367          using  xH H1K_def p2 by blast
   6.368        have " x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> HK"
   6.369 @@ -1275,7 +1283,6 @@
   6.370    qed
   6.371  qed
   6.372  
   6.373 -
   6.374  lemma (in group) normal_inter_subgroup:
   6.375    assumes "subgroup H G"
   6.376      and "N \<lhd> G"
   6.377 @@ -1288,8 +1295,8 @@
   6.378    ultimately have "N \<inter> H \<lhd> G\<lparr>carrier := K \<inter> H\<rparr>"
   6.379      using normal_inter[of K H N] assms(1) by blast
   6.380    moreover have "K \<inter> H = H" using K_def assms subgroup.subset by blast
   6.381 -  ultimately show "normal (N\<inter>H) (G\<lparr>carrier := H\<rparr>)" by auto
   6.382 +  ultimately show "normal (N\<inter>H) (G\<lparr>carrier := H\<rparr>)"
   6.383 + by auto
   6.384  qed
   6.385  
   6.386 -
   6.387  end
     7.1 --- a/src/HOL/Algebra/Divisibility.thy	Tue Aug 07 11:39:40 2018 +0200
     7.2 +++ b/src/HOL/Algebra/Divisibility.thy	Sat Aug 11 16:02:55 2018 +0200
     7.3 @@ -547,22 +547,14 @@
     7.4    using pf by (elim properfactorE)
     7.5  
     7.6  lemma (in monoid) properfactor_trans1 [trans]:
     7.7 -  assumes dvds: "a divides b"  "properfactor G b c"
     7.8 -    and carr: "a \<in> carrier G"  "c \<in> carrier G"
     7.9 +  assumes "a divides b"  "properfactor G b c" "a \<in> carrier G"  "c \<in> carrier G"
    7.10    shows "properfactor G a c"
    7.11 -  using dvds carr
    7.12 -  apply (elim properfactorE, intro properfactorI)
    7.13 -   apply (iprover intro: divides_trans)+
    7.14 -  done
    7.15 +  by (meson divides_trans properfactorE properfactorI assms)
    7.16  
    7.17  lemma (in monoid) properfactor_trans2 [trans]:
    7.18 -  assumes dvds: "properfactor G a b"  "b divides c"
    7.19 -    and carr: "a \<in> carrier G"  "b \<in> carrier G"
    7.20 +  assumes "properfactor G a b"  "b divides c" "a \<in> carrier G"  "b \<in> carrier G"
    7.21    shows "properfactor G a c"
    7.22 -  using dvds carr
    7.23 -  apply (elim properfactorE, intro properfactorI)
    7.24 -   apply (iprover intro: divides_trans)+
    7.25 -  done
    7.26 +  by (meson divides_trans properfactorE properfactorI assms)
    7.27  
    7.28  lemma properfactor_lless:
    7.29    fixes G (structure)
    7.30 @@ -660,23 +652,20 @@
    7.31    using assms by (fast elim: irreducibleE)
    7.32  
    7.33  lemma (in monoid_cancel) irreducible_cong [trans]:
    7.34 -  assumes irred: "irreducible G a"
    7.35 -    and aa': "a \<sim> a'" "a \<in> carrier G"  "a' \<in> carrier G"
    7.36 +  assumes "irreducible G a" "a \<sim> a'" "a \<in> carrier G"  "a' \<in> carrier G"
    7.37    shows "irreducible G a'"
    7.38 +proof -
    7.39 +  have "a' divides a"
    7.40 +    by (meson \<open>a \<sim> a'\<close> associated_def)
    7.41 +  then show ?thesis
    7.42 +    by (metis (no_types) assms assoc_unit_l irreducibleE irreducibleI monoid.properfactor_trans2 monoid_axioms)
    7.43 +qed
    7.44 +
    7.45 +lemma (in monoid) irreducible_prod_rI:
    7.46 +  assumes "irreducible G a" "b \<in> Units G" "a \<in> carrier G"  "b \<in> carrier G"
    7.47 +  shows "irreducible G (a \<otimes> b)"
    7.48    using assms
    7.49 -  apply (auto simp: irreducible_def assoc_unit_l)
    7.50 -  apply (metis aa' associated_sym properfactor_cong_r)
    7.51 -  done
    7.52 -
    7.53 -lemma (in monoid) irreducible_prod_rI:
    7.54 -  assumes airr: "irreducible G a"
    7.55 -    and bunit: "b \<in> Units G"
    7.56 -    and carr[simp]: "a \<in> carrier G"  "b \<in> carrier G"
    7.57 -  shows "irreducible G (a \<otimes> b)"
    7.58 -  using airr carr bunit
    7.59 -  apply (elim irreducibleE, intro irreducibleI)
    7.60 -  using prod_unit_r apply blast
    7.61 -  using associatedI2' properfactor_cong_r by auto
    7.62 +  by (metis (no_types, lifting) associatedI2' irreducible_def monoid.m_closed monoid_axioms prod_unit_r properfactor_cong_r)
    7.63  
    7.64  lemma (in comm_monoid) irreducible_prod_lI:
    7.65    assumes birr: "irreducible G b"
    7.66 @@ -764,9 +753,7 @@
    7.67      and pp': "p \<sim> p'" "p \<in> carrier G"  "p' \<in> carrier G"
    7.68    shows "prime G p'"
    7.69    using assms
    7.70 -  apply (auto simp: prime_def assoc_unit_l)
    7.71 -  apply (metis pp' associated_sym divides_cong_l)
    7.72 -  done
    7.73 +  by (auto simp: prime_def assoc_unit_l) (metis pp' associated_sym divides_cong_l)
    7.74  
    7.75  (*by Paulo Emílio de Vilhena*)
    7.76  lemma (in comm_monoid_cancel) prime_irreducible:
    7.77 @@ -849,9 +836,7 @@
    7.78      and "set as \<subseteq> carrier G" and "set bs \<subseteq> carrier G"
    7.79    shows "\<forall>a\<in>set bs. irreducible G a"
    7.80    using assms
    7.81 -  apply (clarsimp simp add: list_all2_conv_all_nth set_conv_nth)
    7.82 -  apply (blast intro: irreducible_cong)
    7.83 -  done
    7.84 +  by (fastforce simp add: list_all2_conv_all_nth set_conv_nth intro: irreducible_cong)
    7.85  
    7.86  
    7.87  text \<open>Permutations\<close>
    7.88 @@ -1001,15 +986,7 @@
    7.89    then have f: "f \<in> carrier G"
    7.90      by blast
    7.91    show ?case
    7.92 -  proof (cases "f = a")
    7.93 -    case True
    7.94 -    then show ?thesis
    7.95 -      using Cons.prems by auto
    7.96 -  next
    7.97 -    case False
    7.98 -    with Cons show ?thesis
    7.99 -      by clarsimp (metis f divides_prod_l multlist_closed)
   7.100 -  qed
   7.101 +    using Cons.IH Cons.prems(1) Cons.prems(2) divides_prod_l f by auto
   7.102  qed auto
   7.103  
   7.104  lemma (in comm_monoid_cancel) multlist_listassoc_cong:
   7.105 @@ -1051,9 +1028,7 @@
   7.106      and "set fs \<subseteq> carrier G" and "set fs' \<subseteq> carrier G"
   7.107    shows "foldr (\<otimes>) fs \<one> \<sim> foldr (\<otimes>) fs' \<one>"
   7.108    using assms
   7.109 -  apply (elim essentially_equalE)
   7.110 -  apply (simp add: multlist_perm_cong multlist_listassoc_cong perm_closed)
   7.111 -  done
   7.112 +  by (metis essentially_equal_def multlist_listassoc_cong multlist_perm_cong perm_closed)
   7.113  
   7.114  
   7.115  subsubsection \<open>Factorization in irreducible elements\<close>
   7.116 @@ -1120,9 +1095,6 @@
   7.117      and carr[simp]: "set fs \<subseteq> carrier G"
   7.118    shows "fs = []"
   7.119  proof (cases fs)
   7.120 -  case Nil
   7.121 -  then show ?thesis .
   7.122 -next
   7.123    case fs: (Cons f fs')
   7.124    from carr have fcarr[simp]: "f \<in> carrier G" and carr'[simp]: "set fs' \<subseteq> carrier G"
   7.125      by (simp_all add: fs)
   7.126 @@ -1874,6 +1846,18 @@
   7.127  qed
   7.128  
   7.129  lemma (in factorial_monoid) properfactor_fmset:
   7.130 +  assumes "properfactor G a b"
   7.131 +    and "wfactors G as a"
   7.132 +    and "wfactors G bs b"
   7.133 +    and "a \<in> carrier G"
   7.134 +    and "b \<in> carrier G"
   7.135 +    and "set as \<subseteq> carrier G"
   7.136 +    and "set bs \<subseteq> carrier G"
   7.137 +  shows "fmset G as \<subseteq># fmset G bs"
   7.138 +  using assms
   7.139 +  by (meson divides_as_fmsubset properfactor_divides)
   7.140 +
   7.141 +lemma (in factorial_monoid) properfactor_fmset_ne:
   7.142    assumes pf: "properfactor G a b"
   7.143      and "wfactors G as a"
   7.144      and "wfactors G bs b"
   7.145 @@ -1881,11 +1865,8 @@
   7.146      and "b \<in> carrier G"
   7.147      and "set as \<subseteq> carrier G"
   7.148      and "set bs \<subseteq> carrier G"
   7.149 -  shows "fmset G as \<subseteq># fmset G bs \<and> fmset G as \<noteq> fmset G bs"
   7.150 -  using pf
   7.151 -  apply safe
   7.152 -   apply (meson assms divides_as_fmsubset monoid.properfactor_divides monoid_axioms)
   7.153 -  by (meson assms associated_def comm_monoid_cancel.ee_wfactorsD comm_monoid_cancel.fmset_ee factorial_monoid_axioms factorial_monoid_def properfactorE)
   7.154 +  shows "fmset G as \<noteq> fmset G bs"
   7.155 +  using properfactorE [OF pf] assms divides_as_fmsubset by force
   7.156  
   7.157  subsection \<open>Irreducible Elements are Prime\<close>
   7.158  
   7.159 @@ -2246,75 +2227,70 @@
   7.160  qed
   7.161  
   7.162  lemma (in gcd_condition_monoid) gcdof_cong_l:
   7.163 -  assumes a'a: "a' \<sim> a"
   7.164 -    and agcd: "a gcdof b c"
   7.165 -    and a'carr: "a' \<in> carrier G" and carr': "a \<in> carrier G"  "b \<in> carrier G"  "c \<in> carrier G"
   7.166 +  assumes "a' \<sim> a" "a gcdof b c" "a' \<in> carrier G" and carr': "a \<in> carrier G"  "b \<in> carrier G"  "c \<in> carrier G"
   7.167    shows "a' gcdof b c"
   7.168  proof -
   7.169 -  note carr = a'carr carr'
   7.170    interpret weak_lower_semilattice "division_rel G" by simp
   7.171    have "is_glb (division_rel G) a' {b, c}"
   7.172 -    by (subst greatest_Lower_cong_l[of _ a]) (simp_all add: a'a carr gcdof_greatestLower[symmetric] agcd)
   7.173 +    by (subst greatest_Lower_cong_l[of _ a]) (simp_all add: assms gcdof_greatestLower[symmetric])
   7.174    then have "a' \<in> carrier G \<and> a' gcdof b c"
   7.175      by (simp add: gcdof_greatestLower carr')
   7.176    then show ?thesis ..
   7.177  qed
   7.178  
   7.179  lemma (in gcd_condition_monoid) gcd_closed [simp]:
   7.180 -  assumes carr: "a \<in> carrier G"  "b \<in> carrier G"
   7.181 +  assumes "a \<in> carrier G" "b \<in> carrier G"
   7.182    shows "somegcd G a b \<in> carrier G"
   7.183  proof -
   7.184    interpret weak_lower_semilattice "division_rel G" by simp
   7.185    show ?thesis
   7.186 -    apply (simp add: somegcd_meet[OF carr])
   7.187 -    apply (rule meet_closed[simplified], fact+)
   7.188 -    done
   7.189 +  using  assms meet_closed by (simp add: somegcd_meet)
   7.190  qed
   7.191  
   7.192  lemma (in gcd_condition_monoid) gcd_isgcd:
   7.193 -  assumes carr: "a \<in> carrier G"  "b \<in> carrier G"
   7.194 +  assumes "a \<in> carrier G"  "b \<in> carrier G"
   7.195    shows "(somegcd G a b) gcdof a b"
   7.196  proof -
   7.197    interpret weak_lower_semilattice "division_rel G"
   7.198      by simp
   7.199 -  from carr have "somegcd G a b \<in> carrier G \<and> (somegcd G a b) gcdof a b"
   7.200 +  from assms have "somegcd G a b \<in> carrier G \<and> (somegcd G a b) gcdof a b"
   7.201      by (simp add: gcdof_greatestLower inf_of_two_greatest meet_def somegcd_meet)
   7.202    then show "(somegcd G a b) gcdof a b"
   7.203      by simp
   7.204  qed
   7.205  
   7.206  lemma (in gcd_condition_monoid) gcd_exists:
   7.207 -  assumes carr: "a \<in> carrier G"  "b \<in> carrier G"
   7.208 +  assumes "a \<in> carrier G"  "b \<in> carrier G"
   7.209    shows "\<exists>x\<in>carrier G. x = somegcd G a b"
   7.210  proof -
   7.211    interpret weak_lower_semilattice "division_rel G"
   7.212      by simp
   7.213    show ?thesis
   7.214 -    by (metis carr(1) carr(2) gcd_closed)
   7.215 +    by (metis assms gcd_closed)
   7.216  qed
   7.217  
   7.218  lemma (in gcd_condition_monoid) gcd_divides_l:
   7.219 -  assumes carr: "a \<in> carrier G"  "b \<in> carrier G"
   7.220 +  assumes "a \<in> carrier G" "b \<in> carrier G"
   7.221    shows "(somegcd G a b) divides a"
   7.222  proof -
   7.223    interpret weak_lower_semilattice "division_rel G"
   7.224      by simp
   7.225    show ?thesis
   7.226 -    by (metis carr(1) carr(2) gcd_isgcd isgcd_def)
   7.227 +    by (metis assms gcd_isgcd isgcd_def)
   7.228  qed
   7.229  
   7.230  lemma (in gcd_condition_monoid) gcd_divides_r:
   7.231 -  assumes carr: "a \<in> carrier G"  "b \<in> carrier G"
   7.232 +  assumes "a \<in> carrier G"  "b \<in> carrier G"
   7.233    shows "(somegcd G a b) divides b"
   7.234  proof -
   7.235    interpret weak_lower_semilattice "division_rel G"
   7.236      by simp
   7.237    show ?thesis
   7.238 -    by (metis carr gcd_isgcd isgcd_def)
   7.239 +    by (metis assms gcd_isgcd isgcd_def)
   7.240  qed
   7.241  
   7.242  lemma (in gcd_condition_monoid) gcd_divides:
   7.243 -  assumes sub: "z divides x"  "z divides y"
   7.244 +  assumes "z divides x" "z divides y"
   7.245      and L: "x \<in> carrier G"  "y \<in> carrier G"  "z \<in> carrier G"
   7.246    shows "z divides (somegcd G x y)"
   7.247  proof -
   7.248 @@ -2325,49 +2301,25 @@
   7.249  qed
   7.250  
   7.251  lemma (in gcd_condition_monoid) gcd_cong_l:
   7.252 -  assumes xx': "x \<sim> x'"
   7.253 -    and carr: "x \<in> carrier G"  "x' \<in> carrier G"  "y \<in> carrier G"
   7.254 +  assumes "x \<sim> x'" "x \<in> carrier G"  "x' \<in> carrier G"  "y \<in> carrier G"
   7.255    shows "somegcd G x y \<sim> somegcd G x' y"
   7.256  proof -
   7.257    interpret weak_lower_semilattice "division_rel G"
   7.258      by simp
   7.259    show ?thesis
   7.260 -    apply (simp add: somegcd_meet carr)
   7.261 -    apply (rule meet_cong_l[simplified], fact+)
   7.262 -    done
   7.263 +    using somegcd_meet assms
   7.264 +    by (metis eq_object.select_convs(1) meet_cong_l partial_object.select_convs(1))
   7.265  qed
   7.266  
   7.267  lemma (in gcd_condition_monoid) gcd_cong_r:
   7.268 -  assumes carr: "x \<in> carrier G"  "y \<in> carrier G"  "y' \<in> carrier G"
   7.269 -    and yy': "y \<sim> y'"
   7.270 +  assumes "y \<sim> y'" "x \<in> carrier G"  "y \<in> carrier G" "y' \<in> carrier G"
   7.271    shows "somegcd G x y \<sim> somegcd G x y'"
   7.272  proof -
   7.273    interpret weak_lower_semilattice "division_rel G" by simp
   7.274    show ?thesis
   7.275 -    apply (simp add: somegcd_meet carr)
   7.276 -    apply (rule meet_cong_r[simplified], fact+)
   7.277 -    done
   7.278 +    by (meson associated_def assms gcd_closed gcd_divides gcd_divides_l gcd_divides_r monoid.divides_trans monoid_axioms)
   7.279  qed
   7.280  
   7.281 -(*
   7.282 -lemma (in gcd_condition_monoid) asc_cong_gcd_l [intro]:
   7.283 -  assumes carr: "b \<in> carrier G"
   7.284 -  shows "asc_cong (\<lambda>a. somegcd G a b)"
   7.285 -using carr
   7.286 -unfolding CONG_def
   7.287 -by clarsimp (blast intro: gcd_cong_l)
   7.288 -
   7.289 -lemma (in gcd_condition_monoid) asc_cong_gcd_r [intro]:
   7.290 -  assumes carr: "a \<in> carrier G"
   7.291 -  shows "asc_cong (\<lambda>b. somegcd G a b)"
   7.292 -using carr
   7.293 -unfolding CONG_def
   7.294 -by clarsimp (blast intro: gcd_cong_r)
   7.295 -
   7.296 -lemmas (in gcd_condition_monoid) asc_cong_gcd_split [simp] =
   7.297 -    assoc_split[OF _ asc_cong_gcd_l] assoc_split[OF _ asc_cong_gcd_r]
   7.298 -*)
   7.299 -
   7.300  lemma (in gcd_condition_monoid) gcdI:
   7.301    assumes dvd: "a divides b"  "a divides c"
   7.302      and others: "\<And>y. \<lbrakk>y\<in>carrier G; y divides b; y divides c\<rbrakk> \<Longrightarrow> y divides a"
   7.303 @@ -2390,25 +2342,23 @@
   7.304  
   7.305  lemma (in gcd_condition_monoid) SomeGcd_ex:
   7.306    assumes "finite A"  "A \<subseteq> carrier G"  "A \<noteq> {}"
   7.307 -  shows "\<exists>x\<in> carrier G. x = SomeGcd G A"
   7.308 +  shows "\<exists>x \<in> carrier G. x = SomeGcd G A"
   7.309  proof -
   7.310    interpret weak_lower_semilattice "division_rel G"
   7.311      by simp
   7.312    show ?thesis
   7.313 -    apply (simp add: SomeGcd_def)
   7.314 -    apply (rule finite_inf_closed[simplified], fact+)
   7.315 -    done
   7.316 +    using finite_inf_closed by (simp add: assms SomeGcd_def)
   7.317  qed
   7.318  
   7.319  lemma (in gcd_condition_monoid) gcd_assoc:
   7.320 -  assumes carr: "a \<in> carrier G"  "b \<in> carrier G"  "c \<in> carrier G"
   7.321 +  assumes "a \<in> carrier G"  "b \<in> carrier G"  "c \<in> carrier G"
   7.322    shows "somegcd G (somegcd G a b) c \<sim> somegcd G a (somegcd G b c)"
   7.323  proof -
   7.324    interpret weak_lower_semilattice "division_rel G"
   7.325      by simp
   7.326    show ?thesis
   7.327      unfolding associated_def
   7.328 -    by (meson carr divides_trans gcd_divides gcd_divides_l gcd_divides_r gcd_exists)
   7.329 +    by (meson assms divides_trans gcd_divides gcd_divides_l gcd_divides_r gcd_exists)
   7.330  qed
   7.331  
   7.332  lemma (in gcd_condition_monoid) gcd_mult:
   7.333 @@ -2641,141 +2591,124 @@
   7.334      using Cons.IH Cons.prems(1) by force
   7.335  qed
   7.336  
   7.337 -
   7.338 -lemma (in primeness_condition_monoid) wfactors_unique__hlp_induct:
   7.339 -  "\<forall>a as'. a \<in> carrier G \<and> set as \<subseteq> carrier G \<and> set as' \<subseteq> carrier G \<and>
   7.340 -           wfactors G as a \<and> wfactors G as' a \<longrightarrow> essentially_equal G as as'"
   7.341 -proof (induct as)
   7.342 +proposition (in primeness_condition_monoid) wfactors_unique:
   7.343 +  assumes "wfactors G as a"  "wfactors G as' a"
   7.344 +    and "a \<in> carrier G"  "set as \<subseteq> carrier G"  "set as' \<subseteq> carrier G"
   7.345 +  shows "essentially_equal G as as'"
   7.346 +  using assms
   7.347 +proof (induct as arbitrary: a as')
   7.348    case Nil
   7.349 -  show ?case
   7.350 -    apply (clarsimp simp: wfactors_def)
   7.351 -    by (metis Units_one_closed assoc_unit_r list_update_nonempty unit_wfactors_empty unitfactor_ee wfactorsI)
   7.352 +  then have "a \<sim> \<one>"
   7.353 +    by (meson Units_one_closed one_closed perm.Nil perm_wfactorsD unit_wfactors)
   7.354 +  then have "as' = []"
   7.355 +    using Nil.prems assoc_unit_l unit_wfactors_empty by blast
   7.356 +  then show ?case
   7.357 +    by auto
   7.358  next
   7.359    case (Cons ah as)
   7.360 -  then show ?case
   7.361 -  proof clarsimp
   7.362 -    fix a as'
   7.363 -    assume ih [rule_format]:
   7.364 -      "\<forall>a as'. a \<in> carrier G \<and> set as' \<subseteq> carrier G \<and> wfactors G as a \<and>
   7.365 -        wfactors G as' a \<longrightarrow> essentially_equal G as as'"
   7.366 -      and acarr: "a \<in> carrier G" and ahcarr: "ah \<in> carrier G"
   7.367 -      and ascarr: "set as \<subseteq> carrier G" and as'carr: "set as' \<subseteq> carrier G"
   7.368 -      and afs: "wfactors G (ah # as) a"
   7.369 -      and afs': "wfactors G as' a"
   7.370 -    then have ahdvda: "ah divides a"
   7.371 -      by (intro wfactors_dividesI[of "ah#as" "a"]) simp_all
   7.372 +  then have ahdvda: "ah divides a"
   7.373 +    using wfactors_dividesI by auto
   7.374      then obtain a' where a'carr: "a' \<in> carrier G" and a: "a = ah \<otimes> a'"
   7.375        by blast
   7.376 +    have carr_ah: "ah \<in> carrier G" "set as \<subseteq> carrier G"
   7.377 +      using Cons.prems by fastforce+
   7.378 +    have "ah \<otimes> foldr (\<otimes>) as \<one> \<sim> a"
   7.379 +      by (rule wfactorsE[OF \<open>wfactors G (ah # as) a\<close>]) auto
   7.380 +    then have "foldr (\<otimes>) as \<one> \<sim> a'"
   7.381 +      by (metis Cons.prems(4) a a'carr assoc_l_cancel insert_subset list.set(2) monoid.multlist_closed monoid_axioms)
   7.382 +    then
   7.383      have a'fs: "wfactors G as a'"
   7.384 -      apply (rule wfactorsE[OF afs], rule wfactorsI, simp)
   7.385 -      by (metis a a'carr ahcarr ascarr assoc_l_cancel factorsI factors_def factors_mult_single list.set_intros(1) list.set_intros(2) multlist_closed)
   7.386 -    from afs have ahirr: "irreducible G ah"
   7.387 -      by (elim wfactorsE) simp
   7.388 -    with ascarr have ahprime: "prime G ah"
   7.389 -      by (intro irreducible_prime ahcarr)
   7.390 -
   7.391 -    note carr [simp] = acarr ahcarr ascarr as'carr a'carr
   7.392 -
   7.393 +      by (meson Cons.prems(1) set_subset_Cons subset_iff wfactorsE wfactorsI)
   7.394 +    then have ahirr: "irreducible G ah"
   7.395 +      by (meson Cons.prems(1) list.set_intros(1) wfactorsE)
   7.396 +    with Cons have ahprime: "prime G ah"
   7.397 +      by (simp add: irreducible_prime)
   7.398      note ahdvda
   7.399 -    also from afs' have "a divides (foldr (\<otimes>) as' \<one>)"
   7.400 -      by (elim wfactorsE associatedE, simp)
   7.401 +    also have "a divides (foldr (\<otimes>) as' \<one>)"
   7.402 +      by (meson Cons.prems(2) associatedE wfactorsE)
   7.403      finally have "ah divides (foldr (\<otimes>) as' \<one>)"
   7.404 -      by simp
   7.405 +      using Cons.prems(4) by auto
   7.406      with ahprime have "\<exists>i<length as'. ah divides as'!i"
   7.407 -      by (intro multlist_prime_pos) simp_all
   7.408 +      by (intro multlist_prime_pos) (use Cons.prems in auto)
   7.409      then obtain i where len: "i<length as'" and ahdvd: "ah divides as'!i"
   7.410        by blast
   7.411 -    from afs' carr have irrasi: "irreducible G (as'!i)"
   7.412 -      by (fast intro: nth_mem[OF len] elim: wfactorsE)
   7.413 -    from len carr have asicarr[simp]: "as'!i \<in> carrier G"
   7.414 -      unfolding set_conv_nth by force
   7.415 -    note carr = carr asicarr
   7.416 -
   7.417 -    from ahdvd obtain x where "x \<in> carrier G" and asi: "as'!i = ah \<otimes> x"
   7.418 +    then obtain x where "x \<in> carrier G" and asi: "as'!i = ah \<otimes> x"
   7.419        by blast
   7.420 -    with carr irrasi[simplified asi] have asiah: "as'!i \<sim> ah"
   7.421 -      by (metis ahprime associatedI2 irreducible_prodE primeE)
   7.422 +    have irrasi: "irreducible G (as'!i)"
   7.423 +      using nth_mem[OF len] wfactorsE
   7.424 +      by (metis Cons.prems(2))
   7.425 +    have asicarr[simp]: "as'!i \<in> carrier G"
   7.426 +      using len \<open>set as' \<subseteq> carrier G\<close> nth_mem by blast
   7.427 +    have asiah: "as'!i \<sim> ah"
   7.428 +      by (metis \<open>ah \<in> carrier G\<close> \<open>x \<in> carrier G\<close> asi irrasi ahprime associatedI2 irreducible_prodE primeE)
   7.429      note setparts = set_take_subset[of i as'] set_drop_subset[of "Suc i" as']
   7.430 -    note partscarr [simp] = setparts[THEN subset_trans[OF _ as'carr]]
   7.431 -    note carr = carr partscarr
   7.432 -
   7.433      have "\<exists>aa_1. aa_1 \<in> carrier G \<and> wfactors G (take i as') aa_1"
   7.434 -      by (meson afs' in_set_takeD partscarr(1) wfactorsE wfactors_prod_exists)
   7.435 -    then obtain aa_1 where aa1carr: "aa_1 \<in> carrier G" and aa1fs: "wfactors G (take i as') aa_1"
   7.436 +      using Cons
   7.437 +      by (metis setparts(1) subset_trans in_set_takeD wfactorsE wfactors_prod_exists)
   7.438 +    then obtain aa_1 where aa1carr [simp]: "aa_1 \<in> carrier G" and aa1fs: "wfactors G (take i as') aa_1"
   7.439        by auto
   7.440 -
   7.441 -    have "\<exists>aa_2. aa_2 \<in> carrier G \<and> wfactors G (drop (Suc i) as') aa_2"
   7.442 -      by (meson afs' in_set_dropD partscarr(2) wfactors_def wfactors_prod_exists)
   7.443 -    then obtain aa_2 where aa2carr: "aa_2 \<in> carrier G"
   7.444 +    obtain aa_2 where aa2carr [simp]: "aa_2 \<in> carrier G"
   7.445        and aa2fs: "wfactors G (drop (Suc i) as') aa_2"
   7.446 -      by auto
   7.447 -
   7.448 -    note carr = carr aa1carr[simp] aa2carr[simp]
   7.449 -
   7.450 -    from aa1fs aa2fs
   7.451 -    have v1: "wfactors G (take i as' @ drop (Suc i) as') (aa_1 \<otimes> aa_2)"
   7.452 -      by (intro wfactors_mult, simp+)
   7.453 -    then have v1': "wfactors G (as'!i # take i as' @ drop (Suc i) as') (as'!i \<otimes> (aa_1 \<otimes> aa_2))"
   7.454 -      using irrasi wfactors_mult_single by auto
   7.455 -    from aa2carr carr aa1fs aa2fs have "wfactors G (as'!i # drop (Suc i) as') (as'!i \<otimes> aa_2)"
   7.456 -      by (metis irrasi wfactors_mult_single)
   7.457 -    with len carr aa1carr aa2carr aa1fs
   7.458 +      by (metis Cons.prems(2) Cons.prems(5) subset_code(1) in_set_dropD wfactors_def wfactors_prod_exists)
   7.459 +
   7.460 +    have set_drop: "set (drop (Suc i) as') \<subseteq> carrier G"
   7.461 +      using Cons.prems(5) setparts(2) by blast
   7.462 +    moreover have set_take: "set (take i as') \<subseteq> carrier G"
   7.463 +      using  Cons.prems(5) setparts by auto
   7.464 +    moreover have v1: "wfactors G (take i as' @ drop (Suc i) as') (aa_1 \<otimes> aa_2)"
   7.465 +      using aa1fs aa2fs \<open>set as' \<subseteq> carrier G\<close> by (force simp add: dest: in_set_takeD in_set_dropD)
   7.466 +    ultimately have v1': "wfactors G (as'!i # take i as' @ drop (Suc i) as') (as'!i \<otimes> (aa_1 \<otimes> aa_2))"
   7.467 +      using irrasi wfactors_mult_single
   7.468 +        by (simp add: irrasi v1 wfactors_mult_single)      
   7.469 +    have "wfactors G (as'!i # drop (Suc i) as') (as'!i \<otimes> aa_2)"
   7.470 +      by (simp add: aa2fs irrasi set_drop wfactors_mult_single)
   7.471 +    with len  aa1carr aa2carr aa1fs
   7.472      have v2: "wfactors G (take i as' @ as'!i # drop (Suc i) as') (aa_1 \<otimes> (as'!i \<otimes> aa_2))"
   7.473 -      using wfactors_mult by auto
   7.474 +      using wfactors_mult  by (simp add: set_take set_drop) 
   7.475      from len have as': "as' = (take i as' @ as'!i # drop (Suc i) as')"
   7.476        by (simp add: Cons_nth_drop_Suc)
   7.477 -    with carr have eer: "essentially_equal G (take i as' @ as'!i # drop (Suc i) as') as'"
   7.478 -      by simp
   7.479 -    with v2 afs' carr aa1carr aa2carr nth_mem[OF len] have "aa_1 \<otimes> (as'!i \<otimes> aa_2) \<sim> a"
   7.480 -      by (metis as' ee_wfactorsD m_closed)
   7.481 +    have eer: "essentially_equal G (take i as' @ as'!i # drop (Suc i) as') as'"
   7.482 +      using Cons.prems(5) as' by auto
   7.483 +    with v2 aa1carr aa2carr nth_mem[OF len] have "aa_1 \<otimes> (as'!i \<otimes> aa_2) \<sim> a"
   7.484 +      using Cons.prems as' comm_monoid_cancel.ee_wfactorsD is_comm_monoid_cancel by fastforce
   7.485      then have t1: "as'!i \<otimes> (aa_1 \<otimes> aa_2) \<sim> a"
   7.486        by (metis aa1carr aa2carr asicarr m_lcomm)
   7.487 -    from carr asiah have "ah \<otimes> (aa_1 \<otimes> aa_2) \<sim> as'!i \<otimes> (aa_1 \<otimes> aa_2)"
   7.488 -      by (metis associated_sym m_closed mult_cong_l)
   7.489 +    from asiah have "ah \<otimes> (aa_1 \<otimes> aa_2) \<sim> as'!i \<otimes> (aa_1 \<otimes> aa_2)"
   7.490 +      by (simp add: \<open>ah \<in> carrier G\<close> associated_sym mult_cong_l)
   7.491      also note t1
   7.492 -    finally have "ah \<otimes> (aa_1 \<otimes> aa_2) \<sim> a" by simp
   7.493 -
   7.494 -    with carr aa1carr aa2carr a'carr nth_mem[OF len] have a': "aa_1 \<otimes> aa_2 \<sim> a'"
   7.495 -      by (simp add: a, fast intro: assoc_l_cancel[of ah _ a'])
   7.496 -
   7.497 +    finally have "ah \<otimes> (aa_1 \<otimes> aa_2) \<sim> a"
   7.498 +      using Cons.prems(3) carr_ah aa1carr aa2carr by blast
   7.499 +    with aa1carr aa2carr a'carr nth_mem[OF len] have a': "aa_1 \<otimes> aa_2 \<sim> a'"
   7.500 +      using a assoc_l_cancel carr_ah(1) by blast
   7.501      note v1
   7.502      also note a'
   7.503      finally have "wfactors G (take i as' @ drop (Suc i) as') a'"
   7.504 -      by simp
   7.505 -
   7.506 -    from a'fs this carr have "essentially_equal G as (take i as' @ drop (Suc i) as')"
   7.507 -      by (intro ih[of a']) simp
   7.508 -    then have ee1: "essentially_equal G (ah # as) (ah # take i as' @ drop (Suc i) as')"
   7.509 -      by (elim essentially_equalE) (fastforce intro: essentially_equalI)
   7.510 -
   7.511 -    from carr have ee2: "essentially_equal G (ah # take i as' @ drop (Suc i) as')
   7.512 +      by (simp add: a'carr set_drop set_take)
   7.513 +    from a'fs this have "essentially_equal G as (take i as' @ drop (Suc i) as')"
   7.514 +      using Cons.hyps a'carr carr_ah(2) set_drop set_take by auto
   7.515 +    with carr_ah have ee1: "essentially_equal G (ah # as) (ah # take i as' @ drop (Suc i) as')"
   7.516 +      by (auto simp: essentially_equal_def)
   7.517 +    have ee2: "essentially_equal G (ah # take i as' @ drop (Suc i) as')
   7.518        (as' ! i # take i as' @ drop (Suc i) as')"
   7.519      proof (intro essentially_equalI)
   7.520        show "ah # take i as' @ drop (Suc i) as' <~~> ah # take i as' @ drop (Suc i) as'"
   7.521          by simp
   7.522      next
   7.523        show "ah # take i as' @ drop (Suc i) as' [\<sim>] as' ! i # take i as' @ drop (Suc i) as'"
   7.524 -        by (simp add: list_all2_append) (simp add: asiah[symmetric])
   7.525 +        by (simp add: asiah associated_sym set_drop set_take)
   7.526      qed
   7.527  
   7.528      note ee1
   7.529      also note ee2
   7.530      also have "essentially_equal G (as' ! i # take i as' @ drop (Suc i) as')
   7.531                                     (take i as' @ as' ! i # drop (Suc i) as')"
   7.532 -      by (metis as' as'carr listassoc_refl essentially_equalI perm_append_Cons)
   7.533 +      by (metis Cons.prems(5) as' essentially_equalI listassoc_refl perm_append_Cons)
   7.534      finally have "essentially_equal G (ah # as) (take i as' @ as' ! i # drop (Suc i) as')"
   7.535 -      by simp
   7.536 -    then show "essentially_equal G (ah # as) as'"
   7.537 -      by (subst as')
   7.538 -  qed
   7.539 +      using Cons.prems(4) set_drop set_take by auto
   7.540 +    then show ?case
   7.541 +      using as' by auto
   7.542  qed
   7.543  
   7.544 -lemma (in primeness_condition_monoid) wfactors_unique:
   7.545 -  assumes "wfactors G as a"  "wfactors G as' a"
   7.546 -    and "a \<in> carrier G"  "set as \<subseteq> carrier G"  "set as' \<subseteq> carrier G"
   7.547 -  shows "essentially_equal G as as'"
   7.548 -  by (rule wfactors_unique__hlp_induct[rule_format, of a]) (simp add: assms)
   7.549 -
   7.550  
   7.551  subsubsection \<open>Application to factorial monoids\<close>
   7.552  
   7.553 @@ -2841,7 +2774,6 @@
   7.554      by blast
   7.555  
   7.556    note [simp] = acarr bcarr ccarr ascarr cscarr
   7.557 -
   7.558    assume b: "b = a \<otimes> c"
   7.559    from afs cfs have "wfactors G (as@cs) (a \<otimes> c)"
   7.560      by (intro wfactors_mult) simp_all
   7.561 @@ -2918,9 +2850,7 @@
   7.562    apply unfold_locales
   7.563    apply (rule wfUNIVI)
   7.564    apply (rule measure_induct[of "factorcount G"])
   7.565 -  apply simp
   7.566 -  apply (metis properfactor_fcount)
   7.567 -  done
   7.568 +  using properfactor_fcount by auto
   7.569  
   7.570  sublocale factorial_monoid \<subseteq> primeness_condition_monoid
   7.571    by standard (rule irreducible_prime)
     8.1 --- a/src/HOL/Algebra/Embedded_Algebras.thy	Tue Aug 07 11:39:40 2018 +0200
     8.2 +++ b/src/HOL/Algebra/Embedded_Algebras.thy	Sat Aug 11 16:02:55 2018 +0200
     8.3 @@ -187,7 +187,7 @@
     8.4  
     8.5  corollary Span_is_add_subgroup:
     8.6    "set Us \<subseteq> carrier R \<Longrightarrow> subgroup (Span K Us) (add_monoid R)"
     8.7 -  using line_extension_is_subgroup add.normal_invE(1)[OF add.one_is_normal] by (induct Us) (auto)
     8.8 +  using line_extension_is_subgroup normal_imp_subgroup[OF add.one_is_normal] by (induct Us) (auto)
     8.9  
    8.10  lemma line_extension_smult_closed:
    8.11    assumes "\<And>k v. \<lbrakk> k \<in> K; v \<in> E \<rbrakk> \<Longrightarrow> k \<otimes> v \<in> E" and "E \<subseteq> carrier R" "a \<in> carrier R"
    8.12 @@ -246,7 +246,7 @@
    8.13  
    8.14  lemma line_extension_of_combine_set:
    8.15    assumes "u \<in> carrier R"
    8.16 -  shows "line_extension K u { combine Ks Us | Ks. set Ks \<subseteq> K } = 
    8.17 +  shows "line_extension K u { combine Ks Us | Ks. set Ks \<subseteq> K } =
    8.18                  { combine Ks (u # Us) | Ks. set Ks \<subseteq> K }"
    8.19    (is "?line_extension = ?combinations")
    8.20  proof
    8.21 @@ -292,7 +292,7 @@
    8.22  
    8.23  lemma line_extension_of_combine_set_length_version:
    8.24    assumes "u \<in> carrier R"
    8.25 -  shows "line_extension K u { combine Ks Us | Ks. length Ks = length Us \<and> set Ks \<subseteq> K } = 
    8.26 +  shows "line_extension K u { combine Ks Us | Ks. length Ks = length Us \<and> set Ks \<subseteq> K } =
    8.27                        { combine Ks (u # Us) | Ks. length Ks = length (u # Us) \<and> set Ks \<subseteq> K }"
    8.28    (is "?line_extension = ?combinations")
    8.29  proof
    8.30 @@ -329,16 +329,16 @@
    8.31    assumes "set Us \<subseteq> carrier R" and "a \<in> carrier R"
    8.32    shows "a \<in> Span K Us \<longleftrightarrow> (\<exists>k \<in> K - { \<zero> }. \<exists>Ks. set Ks \<subseteq> K \<and> combine (k # Ks) (a # Us) = \<zero>)"
    8.33           (is "?in_Span \<longleftrightarrow> ?exists_combine")
    8.34 -proof 
    8.35 +proof
    8.36    assume "?in_Span"
    8.37    then obtain Ks where Ks: "set Ks \<subseteq> K" "a = combine Ks Us"
    8.38      using Span_eq_combine_set[OF assms(1)] by auto
    8.39    hence "((\<ominus> \<one>) \<otimes> a) \<oplus> a = combine ((\<ominus> \<one>) # Ks) (a # Us)"
    8.40      by auto
    8.41    moreover have "((\<ominus> \<one>) \<otimes> a) \<oplus> a = \<zero>"
    8.42 -    using assms(2) l_minus l_neg by auto  
    8.43 +    using assms(2) l_minus l_neg by auto
    8.44    moreover have "\<ominus> \<one> \<noteq> \<zero>"
    8.45 -    using subfieldE(6)[OF K] l_neg by force 
    8.46 +    using subfieldE(6)[OF K] l_neg by force
    8.47    ultimately show "?exists_combine"
    8.48      using subring_props(3,5) Ks(1) by (force simp del: combine.simps)
    8.49  next
    8.50 @@ -391,14 +391,14 @@
    8.51      proof (induct Ks Us rule: combine.induct)
    8.52        case (1 k Ks u Us)
    8.53        hence "k \<in> K" and "u \<in> set (u # Us)" by auto
    8.54 -      hence "k \<otimes> u \<in> E" 
    8.55 +      hence "k \<otimes> u \<in> E"
    8.56          using 1(4) unfolding set_mult_def by auto
    8.57        moreover have "K <#> set Us \<subseteq> E"
    8.58          using 1(4) unfolding set_mult_def by auto
    8.59        hence "combine Ks Us \<in> E"
    8.60          using 1 by auto
    8.61        ultimately show ?case
    8.62 -        using add.subgroupE(4)[OF assms(2)] by auto 
    8.63 +        using add.subgroupE(4)[OF assms(2)] by auto
    8.64      next
    8.65        case "2_1" thus ?case
    8.66          using subgroup.one_closed[OF assms(2)] by auto
    8.67 @@ -436,7 +436,7 @@
    8.68        hence "combine [ k ] (u # Us) \<in> Span K (u # Us)"
    8.69          using Span_eq_combine_set[OF Cons(2)] by (auto simp del: combine.simps)
    8.70        moreover have "k \<in> carrier R" and "u \<in> carrier R"
    8.71 -        using Cons(2) k subring_props(1) by (blast, auto) 
    8.72 +        using Cons(2) k subring_props(1) by (blast, auto)
    8.73        ultimately show "k \<otimes> u \<in> Span K (u # Us)"
    8.74          by (auto simp del: Span.simps)
    8.75      qed
    8.76 @@ -455,7 +455,7 @@
    8.77  corollary Span_same_set:
    8.78    assumes "set Us \<subseteq> carrier R"
    8.79    shows "set Us = set Vs \<Longrightarrow> Span K Us = Span K Vs"
    8.80 -  using Span_eq_generate assms by auto 
    8.81 +  using Span_eq_generate assms by auto
    8.82  
    8.83  corollary Span_incl: "set Us \<subseteq> carrier R \<Longrightarrow> K <#> (set Us) \<subseteq> Span K Us"
    8.84    using Span_eq_generate generate.incl[of _ _ "add_monoid R"] by auto
    8.85 @@ -583,7 +583,7 @@
    8.86    moreover have "Span K Us \<subseteq> Span K (u # Us)"
    8.87      using mono_Span independent_in_carrier[OF assms] by auto
    8.88    ultimately show ?thesis
    8.89 -    using independent_backwards(1)[OF assms] by auto 
    8.90 +    using independent_backwards(1)[OF assms] by auto
    8.91  qed
    8.92  
    8.93  corollary independent_replacement:
    8.94 @@ -624,7 +624,7 @@
    8.95    from assms show "Span K Us \<inter> Span K Vs = { \<zero> }"
    8.96    proof (induct Us rule: list.induct)
    8.97      case Nil thus ?case
    8.98 -      using Span_subgroup_props(2)[OF independent_in_carrier[of K Vs]] by simp 
    8.99 +      using Span_subgroup_props(2)[OF independent_in_carrier[of K Vs]] by simp
   8.100    next
   8.101      case (Cons u Us)
   8.102      hence IH: "Span K Us \<inter> Span K Vs = {\<zero>}" by auto
   8.103 @@ -653,7 +653,7 @@
   8.104        hence "k \<otimes> u = (\<ominus> u') \<oplus> v'"
   8.105          using in_carrier(1) k(2) u'(2) v'(2) add.m_comm r_neg1 by auto
   8.106        hence "k \<otimes> u \<in> Span K (Us @ Vs)"
   8.107 -        using Span_subgroup_props(4)[OF in_carrier(2) u'(1)] v'(1) 
   8.108 +        using Span_subgroup_props(4)[OF in_carrier(2) u'(1)] v'(1)
   8.109                Span_append_eq_set_add[OF in_carrier(2-3)] unfolding set_add_def' by blast
   8.110        hence "u \<in> Span K (Us @ Vs)"
   8.111          using Cons(2) Span_m_inv_simprule[OF _ _ in_carrier(1), of "Us @ Vs" k]
   8.112 @@ -678,7 +678,7 @@
   8.113    hence in_carrier:
   8.114      "u \<in> carrier R" "set Us \<subseteq> carrier R" "set Vs \<subseteq> carrier R" "set (u # Us) \<subseteq> carrier R"
   8.115      using Cons(2-3)[THEN independent_in_carrier] by auto
   8.116 -  hence "Span K Us \<subseteq> Span K (u # Us)" 
   8.117 +  hence "Span K Us \<subseteq> Span K (u # Us)"
   8.118      using mono_Span by auto
   8.119    hence "Span K Us \<inter> Span K Vs = { \<zero> }"
   8.120      using Cons(4) Span_subgroup_props(2)[OF in_carrier(2)] by auto
   8.121 @@ -733,7 +733,7 @@
   8.122      hence "combine Ks' Us = \<zero>"
   8.123        using combine_in_carrier[OF _ Us, of Ks'] Ks' u Cons(3) subring_props(1) unfolding Ks by auto
   8.124      hence "set (take (length Us) Ks') \<subseteq> { \<zero> }"
   8.125 -      using Cons(1)[OF Ks' _ independent_backwards(2)[OF Cons(4)]] by simp 
   8.126 +      using Cons(1)[OF Ks' _ independent_backwards(2)[OF Cons(4)]] by simp
   8.127      thus ?thesis
   8.128        using k_zero unfolding Ks by auto
   8.129    qed
   8.130 @@ -878,10 +878,10 @@
   8.131      case (Cons u Us)
   8.132      then obtain Vs' Vs'' where Vs: "Vs = Vs' @ (u # Vs'')"
   8.133        by (metis list.set_intros(1) split_list)
   8.134 -    
   8.135 +
   8.136      have in_carrier: "u \<in> carrier R" "set Us \<subseteq> carrier R"
   8.137 -      using independent_in_carrier[OF Cons(2)] by auto 
   8.138 -    
   8.139 +      using independent_in_carrier[OF Cons(2)] by auto
   8.140 +
   8.141      have "distinct Vs"
   8.142        using Cons(3-4) independent_distinct[OF Cons(2)]
   8.143        by (metis card_distinct distinct_card)
   8.144 @@ -905,7 +905,7 @@
   8.145    shows "\<exists>Vs'. set Vs' \<subseteq> set Vs \<and> length Vs' = length Us' \<and> independent K (Vs' @ Us)"
   8.146    using assms
   8.147  proof (induct "length Us'" arbitrary: Us' Us)
   8.148 -  case 0 thus ?case by auto 
   8.149 +  case 0 thus ?case by auto
   8.150  next
   8.151    case (Suc n)
   8.152    then obtain u Us'' where Us'': "Us' = Us'' @ [u]"
   8.153 @@ -1074,9 +1074,9 @@
   8.154          using space_subgroup_props(1)[OF assms(1)] li_Cons[OF _ v(2) step(4)] by auto
   8.155        then obtain Vs
   8.156          where "length (Vs @ (v # Us)) = n" "independent K (Vs @ (v # Us))" "Span K (Vs @ (v # Us)) = E"
   8.157 -        using step(3)[of "v # Us"] step(1-2,4-6) v by auto 
   8.158 +        using step(3)[of "v # Us"] step(1-2,4-6) v by auto
   8.159        thus ?case
   8.160 -        by (metis append.assoc append_Cons append_Nil)  
   8.161 +        by (metis append.assoc append_Cons append_Nil)
   8.162      qed } note aux_lemma = this
   8.163  
   8.164    have "length Us \<le> n"
   8.165 @@ -1119,7 +1119,7 @@
   8.166    hence in_carrier: "set Us \<subseteq> carrier R" "set (Vs @ Bs) \<subseteq> carrier R"
   8.167      using independent_in_carrier[OF Us(2)] independent_in_carrier[OF Vs(2)] by auto
   8.168    hence "Span K Us \<inter> (Span K (Vs @ Bs)) \<subseteq> Span K Bs"
   8.169 -    using Bs(4) Us(3) Vs(3) mono_Span_append(1)[OF _ Bs(1), of Us] by auto 
   8.170 +    using Bs(4) Us(3) Vs(3) mono_Span_append(1)[OF _ Bs(1), of Us] by auto
   8.171    hence "Span K Us \<inter> (Span K (Vs @ Bs)) \<subseteq> { \<zero> }"
   8.172      using independent_split(3)[OF Us(2)] by blast
   8.173    hence "Span K Us \<inter> (Span K (Vs @ Bs)) = { \<zero> }"
   8.174 @@ -1147,7 +1147,7 @@
   8.175      ultimately show "v \<in> (Span K Us) <+>\<^bsub>R\<^esub> F"
   8.176        using u1' unfolding set_add_def' by auto
   8.177    qed
   8.178 -  ultimately have "Span K (Us @ (Vs @ Bs)) = E <+>\<^bsub>R\<^esub> F" 
   8.179 +  ultimately have "Span K (Us @ (Vs @ Bs)) = E <+>\<^bsub>R\<^esub> F"
   8.180      using Span_append_eq_set_add[OF in_carrier] Vs(3) by auto
   8.181  
   8.182    thus ?thesis using dim by simp
   8.183 @@ -1169,7 +1169,7 @@
   8.184      by (metis One_nat_def length_0_conv length_Suc_conv)
   8.185    have in_carrier: "set (map (\<lambda>u'. u' \<otimes> u) Us) \<subseteq> carrier R"
   8.186      using Us(1) u(1) by (induct Us) (auto)
   8.187 -  
   8.188 +
   8.189    have li: "independent K (map (\<lambda>u'. u' \<otimes> u) Us)"
   8.190    proof (rule trivial_combine_imp_independent[OF assms(1) in_carrier])
   8.191      fix Ks assume Ks: "set Ks \<subseteq> K" and "combine Ks (map (\<lambda>u'. u' \<otimes> u) Us) = \<zero>"
   8.192 @@ -1244,7 +1244,7 @@
   8.193    ultimately have "dimension (n * Suc m) K (Span F [ v ] <+>\<^bsub>R\<^esub> Span F Vs')"
   8.194      using dimension_direct_sum_space[OF assms(1) _ _ inter] by auto
   8.195    thus "dimension (n * Suc m) K E"
   8.196 -    using Span_append_eq_set_add[OF assms(2) li[THEN independent_in_carrier]] Vs(4) v by auto 
   8.197 +    using Span_append_eq_set_add[OF assms(2) li[THEN independent_in_carrier]] Vs(4) v by auto
   8.198  qed
   8.199  
   8.200  
   8.201 @@ -1271,14 +1271,14 @@
   8.202    hence "combine Ks Us = (combine (take (length Us) Ks) Us) \<oplus> \<zero>"
   8.203      using combine_append[OF _ _ assms(2), of "take (length Us) Ks" "drop (length Us) Ks" "[]"] len by auto
   8.204    also have " ... = combine (take (length Us) Ks) Us"
   8.205 -    using combine_in_carrier[OF set_t assms(2)] by auto 
   8.206 +    using combine_in_carrier[OF set_t assms(2)] by auto
   8.207    finally show "combine Ks Us = combine (take (length Us) Ks) Us" .
   8.208  qed
   8.209  *)
   8.210  
   8.211  (*
   8.212  lemma combine_normalize:
   8.213 -  assumes "set Ks \<subseteq> K" "set Us \<subseteq> carrier R" "a = combine Ks Us" 
   8.214 +  assumes "set Ks \<subseteq> K" "set Us \<subseteq> carrier R" "a = combine Ks Us"
   8.215    shows "\<exists>Ks'. set Ks' \<subseteq> K \<and> length Ks' = length Us \<and> a = combine Ks' Us"
   8.216  proof (cases "length Ks \<le> length Us")
   8.217    assume "\<not> length Ks \<le> length Us"
   8.218 @@ -1291,12 +1291,12 @@
   8.219  next
   8.220    assume len: "length Ks \<le> length Us"
   8.221    have Ks: "set Ks \<subseteq> carrier R" and set_r: "set (replicate (length Us - length Ks) \<zero>) \<subseteq> carrier R"
   8.222 -    using assms subring_props(1) zero_closed by (metis dual_order.trans, auto) 
   8.223 +    using assms subring_props(1) zero_closed by (metis dual_order.trans, auto)
   8.224    moreover
   8.225    have set_t: "set (take (length Ks) Us) \<subseteq> carrier R"
   8.226     and set_d: "set (drop (length Ks) Us) \<subseteq> carrier R"
   8.227      using assms(2) len dual_order.trans by (metis set_take_subset, metis set_drop_subset)
   8.228 -  ultimately 
   8.229 +  ultimately
   8.230    have "combine (Ks @ (replicate (length Us - length Ks) \<zero>)) Us =
   8.231         (combine Ks (take (length Ks) Us)) \<oplus>
   8.232         (combine (replicate (length Us - length Ks) \<zero>) (drop (length Ks) Us))"
     9.1 --- a/src/HOL/Algebra/Generated_Groups.thy	Tue Aug 07 11:39:40 2018 +0200
     9.2 +++ b/src/HOL/Algebra/Generated_Groups.thy	Sat Aug 11 16:02:55 2018 +0200
     9.3 @@ -466,7 +466,7 @@
     9.4    shows "derived G H \<lhd> G" unfolding derived_def
     9.5  proof (rule normal_generateI)
     9.6    show "(\<Union>h1 \<in> H. \<Union>h2 \<in> H. { h1 \<otimes> h2 \<otimes> inv h1 \<otimes> inv h2 }) \<subseteq> carrier G"
     9.7 -    using subgroup.subset assms normal_invE(1) by blast
     9.8 +    using subgroup.subset assms normal_imp_subgroup by blast
     9.9  next
    9.10    show "\<And>h g. \<lbrakk> h \<in> derived_set G H; g \<in> carrier G \<rbrakk> \<Longrightarrow> g \<otimes> h \<otimes> inv g \<in> derived_set G H"
    9.11    proof -
    9.12 @@ -474,7 +474,7 @@
    9.13      then obtain h1 h2 where h1: "h1 \<in> H" "h1 \<in> carrier G"
    9.14                          and h2: "h2 \<in> H" "h2 \<in> carrier G"
    9.15                          and h:  "h = h1 \<otimes> h2 \<otimes> inv h1 \<otimes> inv h2"
    9.16 -      using subgroup.subset assms normal_invE(1) by blast
    9.17 +      using subgroup.subset assms normal_imp_subgroup by blast
    9.18      hence "g \<otimes> h \<otimes> inv g =
    9.19             g \<otimes> h1 \<otimes> (inv g \<otimes> g) \<otimes> h2 \<otimes> (inv g \<otimes> g) \<otimes> inv h1 \<otimes> (inv g \<otimes> g) \<otimes> inv h2 \<otimes> inv g"
    9.20        by (simp add: g m_assoc)
    9.21 @@ -486,8 +486,8 @@
    9.22      have "g \<otimes> h \<otimes> inv g =
    9.23           (g \<otimes> h1 \<otimes> inv g) \<otimes> (g \<otimes> h2 \<otimes> inv g) \<otimes> inv (g \<otimes> h1 \<otimes> inv g) \<otimes> inv (g \<otimes> h2 \<otimes> inv g)"
    9.24        by (simp add: g h1 h2 inv_mult_group m_assoc)
    9.25 -    moreover have "g \<otimes> h1 \<otimes> inv g \<in> H" by (simp add: assms normal_invE(2) g h1)
    9.26 -    moreover have "g \<otimes> h2 \<otimes> inv g \<in> H" by (simp add: assms normal_invE(2) g h2)
    9.27 +    moreover have "g \<otimes> h1 \<otimes> inv g \<in> H" by (simp add: assms normal.inv_op_closed2 g h1)
    9.28 +    moreover have "g \<otimes> h2 \<otimes> inv g \<in> H" by (simp add: assms normal.inv_op_closed2 g h2)
    9.29      ultimately show "g \<otimes> h \<otimes> inv g \<in> derived_set G H" by blast
    9.30    qed
    9.31  qed
    10.1 --- a/src/HOL/Algebra/Group.thy	Tue Aug 07 11:39:40 2018 +0200
    10.2 +++ b/src/HOL/Algebra/Group.thy	Sat Aug 11 16:02:55 2018 +0200
    10.3 @@ -763,13 +763,13 @@
    10.4      and "subgroup I K"
    10.5    shows "subgroup (H \<times> I) (G \<times>\<times> K)"
    10.6  proof (intro group.group_incl_imp_subgroup[OF DirProd_group[OF assms(1)assms(3)]])
    10.7 -  have "H \<subseteq> carrier G" "I \<subseteq> carrier K" using subgroup.subset assms apply blast+.
    10.8 +  have "H \<subseteq> carrier G" "I \<subseteq> carrier K" using subgroup.subset assms by blast+
    10.9    thus "(H \<times> I) \<subseteq> carrier (G \<times>\<times> K)" unfolding DirProd_def by auto
   10.10    have "Group.group ((G\<lparr>carrier := H\<rparr>) \<times>\<times> (K\<lparr>carrier := I\<rparr>))"
   10.11      using DirProd_group[OF subgroup.subgroup_is_group[OF assms(2)assms(1)]
   10.12          subgroup.subgroup_is_group[OF assms(4)assms(3)]].
   10.13    moreover have "((G\<lparr>carrier := H\<rparr>) \<times>\<times> (K\<lparr>carrier := I\<rparr>)) = ((G \<times>\<times> K)\<lparr>carrier := H \<times> I\<rparr>)"
   10.14 -    unfolding DirProd_def using assms apply simp.
   10.15 +    unfolding DirProd_def using assms by simp
   10.16    ultimately show "Group.group ((G \<times>\<times> K)\<lparr>carrier := H \<times> I\<rparr>)" by simp
   10.17  qed
   10.18  
   10.19 @@ -1054,7 +1054,7 @@
   10.20  lemma (in group_hom) img_is_subgroup: "subgroup (h ` (carrier G)) H"
   10.21    apply (rule subgroupI)
   10.22    apply (auto simp add: image_subsetI)
   10.23 -  apply (metis (no_types, hide_lams) G.inv_closed hom_inv image_iff)
   10.24 +  apply (metis G.inv_closed hom_inv image_iff)
   10.25    by (metis G.monoid_axioms hom_mult image_eqI monoid.m_closed)
   10.26  
   10.27  lemma (in group_hom) subgroup_img_is_subgroup:
   10.28 @@ -1157,9 +1157,8 @@
   10.29    show "monoid (G\<lparr>carrier := H\<rparr>)"
   10.30      using submonoid.submonoid_is_monoid assms comm_monoid_axioms comm_monoid_def by blast
   10.31    show "\<And>x y. x \<in> carrier (G\<lparr>carrier := H\<rparr>) \<Longrightarrow> y \<in> carrier (G\<lparr>carrier := H\<rparr>)
   10.32 -        \<Longrightarrow> x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y = y \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x" apply simp
   10.33 -    using  assms comm_monoid_axioms_def submonoid.mem_carrier
   10.34 -    by (metis m_comm)
   10.35 +        \<Longrightarrow> x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y = y \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x" 
   10.36 +    by simp (meson assms m_comm submonoid.mem_carrier)
   10.37  qed
   10.38  
   10.39  locale comm_group = comm_monoid + group
    11.1 --- a/src/HOL/Algebra/Ideal.thy	Tue Aug 07 11:39:40 2018 +0200
    11.2 +++ b/src/HOL/Algebra/Ideal.thy	Sat Aug 11 16:02:55 2018 +0200
    11.3 @@ -128,10 +128,9 @@
    11.4  proof -
    11.5    interpret additive_subgroup I R by fact
    11.6    interpret cring R by fact
    11.7 -  show ?thesis apply intro_locales
    11.8 -    apply (intro ideal_axioms.intro)
    11.9 -    apply (erule (1) I_l_closed)
   11.10 -    apply (erule (1) I_r_closed)
   11.11 +  show ?thesis
   11.12 +    apply intro_locales
   11.13 +    apply (simp add: I_l_closed I_r_closed ideal_axioms_def)
   11.14      by (simp add: I_notcarr I_prime primeideal_axioms.intro)
   11.15  qed
   11.16  
    12.1 --- a/src/HOL/Algebra/RingHom.thy	Tue Aug 07 11:39:40 2018 +0200
    12.2 +++ b/src/HOL/Algebra/RingHom.thy	Sat Aug 11 16:02:55 2018 +0200
    12.3 @@ -20,11 +20,10 @@
    12.4    by standard (rule homh)
    12.5  
    12.6  sublocale ring_hom_ring \<subseteq> abelian_group?: abelian_group_hom R S
    12.7 -apply (intro abelian_group_homI R.is_abelian_group S.is_abelian_group)
    12.8 -apply (intro group_hom.intro group_hom_axioms.intro R.a_group S.a_group)
    12.9 -apply (insert homh, unfold hom_def ring_hom_def)
   12.10 -apply simp
   12.11 -done
   12.12 +proof 
   12.13 +  show "h \<in> hom (add_monoid R) (add_monoid S)"
   12.14 +    using homh by (simp add: hom_def ring_hom_def)
   12.15 +qed
   12.16  
   12.17  lemma (in ring_hom_ring) is_ring_hom_ring:
   12.18    "ring_hom_ring R S h"
   12.19 @@ -33,8 +32,7 @@
   12.20  lemma ring_hom_ringI:
   12.21    fixes R (structure) and S (structure)
   12.22    assumes "ring R" "ring S"
   12.23 -  assumes (* morphism: "h \<in> carrier R \<rightarrow> carrier S" *)
   12.24 -          hom_closed: "!!x. x \<in> carrier R ==> h x \<in> carrier S"
   12.25 +  assumes hom_closed: "!!x. x \<in> carrier R ==> h x \<in> carrier S"
   12.26        and compatible_mult: "\<And>x y. [| x \<in> carrier R; y \<in> carrier R |] ==> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
   12.27        and compatible_add: "\<And>x y. [| x \<in> carrier R; y \<in> carrier R |] ==> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
   12.28        and compatible_one: "h \<one> = \<one>\<^bsub>S\<^esub>"
   12.29 @@ -42,13 +40,12 @@
   12.30  proof -
   12.31    interpret ring R by fact
   12.32    interpret ring S by fact
   12.33 -  show ?thesis apply unfold_locales
   12.34 -apply (unfold ring_hom_def, safe)
   12.35 -   apply (simp add: hom_closed Pi_def)
   12.36 -  apply (erule (1) compatible_mult)
   12.37 - apply (erule (1) compatible_add)
   12.38 -apply (rule compatible_one)
   12.39 -done
   12.40 +  show ?thesis
   12.41 +  proof
   12.42 +    show "h \<in> ring_hom R S"
   12.43 +      unfolding ring_hom_def
   12.44 +      by (auto simp: compatible_mult compatible_add compatible_one hom_closed)
   12.45 +  qed
   12.46  qed
   12.47  
   12.48  lemma ring_hom_ringI2:
   12.49 @@ -58,11 +55,11 @@
   12.50  proof -
   12.51    interpret R: ring R by fact
   12.52    interpret S: ring S by fact
   12.53 -  show ?thesis apply (intro ring_hom_ring.intro ring_hom_ring_axioms.intro)
   12.54 -    apply (rule R.is_ring)
   12.55 -    apply (rule S.is_ring)
   12.56 -    apply (rule h)
   12.57 -    done
   12.58 +  show ?thesis 
   12.59 +  proof
   12.60 +    show "h \<in> ring_hom R S"
   12.61 +      using h .
   12.62 +  qed
   12.63  qed
   12.64  
   12.65  lemma ring_hom_ringI3:
   12.66 @@ -75,13 +72,11 @@
   12.67    interpret abelian_group_hom R S h by fact
   12.68    interpret R: ring R by fact
   12.69    interpret S: ring S by fact
   12.70 -  show ?thesis apply (intro ring_hom_ring.intro ring_hom_ring_axioms.intro, rule R.is_ring, rule S.is_ring)
   12.71 -    apply (insert group_hom.homh[OF a_group_hom])
   12.72 -    apply (unfold hom_def ring_hom_def, simp)
   12.73 -    apply safe
   12.74 -    apply (erule (1) compatible_mult)
   12.75 -    apply (rule compatible_one)
   12.76 -    done
   12.77 +  show ?thesis
   12.78 +  proof
   12.79 +    show "h \<in> ring_hom R S"
   12.80 +      unfolding ring_hom_def by (auto simp: compatible_one compatible_mult)
   12.81 +  qed
   12.82  qed
   12.83  
   12.84  lemma ring_hom_cringI:
   12.85 @@ -91,21 +86,22 @@
   12.86    interpret ring_hom_ring R S h by fact
   12.87    interpret R: cring R by fact
   12.88    interpret S: cring S by fact
   12.89 -  show ?thesis by (intro ring_hom_cring.intro ring_hom_cring_axioms.intro)
   12.90 -    (rule R.is_cring, rule S.is_cring, rule homh)
   12.91 +  show ?thesis 
   12.92 +  proof
   12.93 +    show "h \<in> ring_hom R S"
   12.94 +      by (simp add: homh)
   12.95 +  qed
   12.96  qed
   12.97  
   12.98  
   12.99  subsection \<open>The Kernel of a Ring Homomorphism\<close>
  12.100  
  12.101  \<comment> \<open>the kernel of a ring homomorphism is an ideal\<close>
  12.102 -lemma (in ring_hom_ring) kernel_is_ideal:
  12.103 -  shows "ideal (a_kernel R S h) R"
  12.104 -apply (rule idealI)
  12.105 -   apply (rule R.is_ring)
  12.106 -  apply (rule additive_subgroup.a_subgroup[OF additive_subgroup_a_kernel])
  12.107 - apply (unfold a_kernel_def', simp+)
  12.108 -done
  12.109 +lemma (in ring_hom_ring) kernel_is_ideal: "ideal (a_kernel R S h) R"
  12.110 +  apply (rule idealI [OF R.is_ring])
  12.111 +    apply (rule additive_subgroup.a_subgroup[OF additive_subgroup_a_kernel])
  12.112 +   apply (auto simp: a_kernel_def')
  12.113 +  done
  12.114  
  12.115  text \<open>Elements of the kernel are mapped to zero\<close>
  12.116  lemma (in abelian_group_hom) kernel_zero [simp]:
  12.117 @@ -174,29 +170,10 @@
  12.118  corollary (in ring_hom_ring) rcos_eq_homeq:
  12.119    assumes acarr: "a \<in> carrier R"
  12.120    shows "(a_kernel R S h) +> a = {x \<in> carrier R. h x = h a}"
  12.121 -  apply rule defer 1
  12.122 -   apply clarsimp defer 1
  12.123 -proof
  12.124 +proof -
  12.125    interpret ideal "a_kernel R S h" "R" by (rule kernel_is_ideal)
  12.126 -
  12.127 -  fix x
  12.128 -  assume xrcos: "x \<in> a_kernel R S h +> a"
  12.129 -  from acarr and this
  12.130 -  have xcarr: "x \<in> carrier R"
  12.131 -    by (rule a_elemrcos_carrier)
  12.132 -
  12.133 -  from xrcos
  12.134 -  have "h x = h a" by (rule rcos_imp_homeq[OF acarr])
  12.135 -  from xcarr and this
  12.136 -  show "x \<in> {x \<in> carrier R. h x = h a}" by fast
  12.137 -next
  12.138 -  interpret ideal "a_kernel R S h" "R" by (rule kernel_is_ideal)
  12.139 -
  12.140 -  fix x
  12.141 -  assume xcarr: "x \<in> carrier R"
  12.142 -    and hx: "h x = h a"
  12.143 -  from acarr xcarr hx
  12.144 -  show "x \<in> a_kernel R S h +> a" by (rule homeq_imp_rcos)
  12.145 +  show ?thesis
  12.146 +    using assms by (auto simp: intro: homeq_imp_rcos rcos_imp_homeq a_elemrcos_carrier)
  12.147  qed
  12.148  
  12.149  lemma (in ring_hom_ring) nat_pow_hom:
    13.1 --- a/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Tue Aug 07 11:39:40 2018 +0200
    13.2 +++ b/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Sat Aug 11 16:02:55 2018 +0200
    13.3 @@ -1341,6 +1341,29 @@
    13.4  lemma contour_integral_trivial [simp]: "contour_integral (linepath a a) f = 0"
    13.5    using has_contour_integral_trivial contour_integral_unique by blast
    13.6  
    13.7 +lemma differentiable_linepath [intro]: "linepath a b differentiable at x within A"
    13.8 +  by (auto simp: linepath_def)
    13.9 +
   13.10 +lemma bounded_linear_linepath:
   13.11 +  assumes "bounded_linear f"
   13.12 +  shows   "f (linepath a b x) = linepath (f a) (f b) x"
   13.13 +proof -
   13.14 +  interpret f: bounded_linear f by fact
   13.15 +  show ?thesis by (simp add: linepath_def f.add f.scale)
   13.16 +qed
   13.17 +
   13.18 +lemma bounded_linear_linepath':
   13.19 +  assumes "bounded_linear f"
   13.20 +  shows   "f \<circ> linepath a b = linepath (f a) (f b)"
   13.21 +  using bounded_linear_linepath[OF assms] by (simp add: fun_eq_iff)
   13.22 +
   13.23 +lemma cnj_linepath: "cnj (linepath a b x) = linepath (cnj a) (cnj b) x"
   13.24 +  by (simp add: linepath_def)
   13.25 +
   13.26 +lemma cnj_linepath': "cnj \<circ> linepath a b = linepath (cnj a) (cnj b)"
   13.27 +  by (simp add: linepath_def fun_eq_iff)
   13.28 +
   13.29 +
   13.30  
   13.31  subsection\<open>Relation to subpath construction\<close>
   13.32  
   13.33 @@ -1501,6 +1524,62 @@
   13.34       "contour_integral g f = integral {0..1} (\<lambda>x. f (g x) * vector_derivative g (at x))"
   13.35    by (simp add: contour_integral_def integral_def has_contour_integral contour_integrable_on)
   13.36  
   13.37 +lemma contour_integral_cong:
   13.38 +  assumes "g = g'" "\<And>x. x \<in> path_image g \<Longrightarrow> f x = f' x"
   13.39 +  shows   "contour_integral g f = contour_integral g' f'"
   13.40 +  unfolding contour_integral_integral using assms
   13.41 +  by (intro integral_cong) (auto simp: path_image_def)
   13.42 +
   13.43 +
   13.44 +text \<open>Contour integral along a segment on the real axis\<close>
   13.45 +
   13.46 +lemma has_contour_integral_linepath_Reals_iff:
   13.47 +  fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   13.48 +  assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   13.49 +  shows   "(f has_contour_integral I) (linepath a b) \<longleftrightarrow>
   13.50 +             ((\<lambda>x. f (of_real x)) has_integral I) {Re a..Re b}"
   13.51 +proof -
   13.52 +  from assms have [simp]: "of_real (Re a) = a" "of_real (Re b) = b"
   13.53 +    by (simp_all add: complex_eq_iff)
   13.54 +  from assms have "a \<noteq> b" by auto
   13.55 +  have "((\<lambda>x. f (of_real x)) has_integral I) (cbox (Re a) (Re b)) \<longleftrightarrow>
   13.56 +          ((\<lambda>x. f (a + b * of_real x - a * of_real x)) has_integral I /\<^sub>R (Re b - Re a)) {0..1}"
   13.57 +    by (subst has_integral_affinity_iff [of "Re b - Re a" _ "Re a", symmetric])
   13.58 +       (insert assms, simp_all add: field_simps scaleR_conv_of_real)
   13.59 +  also have "(\<lambda>x. f (a + b * of_real x - a * of_real x)) =
   13.60 +               (\<lambda>x. (f (a + b * of_real x - a * of_real x) * (b - a)) /\<^sub>R (Re b - Re a))"
   13.61 +    using \<open>a \<noteq> b\<close> by (auto simp: field_simps fun_eq_iff scaleR_conv_of_real)
   13.62 +  also have "(\<dots> has_integral I /\<^sub>R (Re b - Re a)) {0..1} \<longleftrightarrow> 
   13.63 +               ((\<lambda>x. f (linepath a b x) * (b - a)) has_integral I) {0..1}" using assms
   13.64 +    by (subst has_integral_cmul_iff) (auto simp: linepath_def scaleR_conv_of_real algebra_simps)
   13.65 +  also have "\<dots> \<longleftrightarrow> (f has_contour_integral I) (linepath a b)" unfolding has_contour_integral_def
   13.66 +    by (intro has_integral_cong) (simp add: vector_derivative_linepath_within)
   13.67 +  finally show ?thesis by simp
   13.68 +qed
   13.69 +
   13.70 +lemma contour_integrable_linepath_Reals_iff:
   13.71 +  fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   13.72 +  assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   13.73 +  shows   "(f contour_integrable_on linepath a b) \<longleftrightarrow>
   13.74 +             (\<lambda>x. f (of_real x)) integrable_on {Re a..Re b}"
   13.75 +  using has_contour_integral_linepath_Reals_iff[OF assms, of f]
   13.76 +  by (auto simp: contour_integrable_on_def integrable_on_def)
   13.77 +
   13.78 +lemma contour_integral_linepath_Reals_eq:
   13.79 +  fixes a b :: complex and f :: "complex \<Rightarrow> complex"
   13.80 +  assumes "a \<in> Reals" "b \<in> Reals" "Re a < Re b"
   13.81 +  shows   "contour_integral (linepath a b) f = integral {Re a..Re b} (\<lambda>x. f (of_real x))"
   13.82 +proof (cases "f contour_integrable_on linepath a b")
   13.83 +  case True
   13.84 +  thus ?thesis using has_contour_integral_linepath_Reals_iff[OF assms, of f]
   13.85 +    using has_contour_integral_integral has_contour_integral_unique by blast
   13.86 +next
   13.87 +  case False
   13.88 +  thus ?thesis using contour_integrable_linepath_Reals_iff[OF assms, of f]
   13.89 +    by (simp add: not_integrable_contour_integral not_integrable_integral)
   13.90 +qed
   13.91 +
   13.92 +
   13.93  
   13.94  text\<open>Cauchy's theorem where there's a primitive\<close>
   13.95  
   13.96 @@ -4875,6 +4954,10 @@
   13.97    apply (rule derivative_eq_intros | simp)+
   13.98    done
   13.99  
  13.100 +corollary differentiable_part_circlepath:
  13.101 +  "part_circlepath c r a b differentiable at x within A"
  13.102 +  using has_vector_derivative_part_circlepath[of c r a b x A] differentiableI_vector by blast
  13.103 +
  13.104  corollary vector_derivative_part_circlepath:
  13.105      "vector_derivative (part_circlepath z r s t) (at x) =
  13.106         \<i> * r * (of_real t - of_real s) * exp(\<i> * linepath s t x)"
  13.107 @@ -4923,6 +5006,17 @@
  13.108      by (fastforce simp add: path_image_def part_circlepath_def)
  13.109  qed
  13.110  
  13.111 +proposition path_image_part_circlepath':
  13.112 +  "path_image (part_circlepath z r s t) = (\<lambda>x. z + r * cis x) ` closed_segment s t"
  13.113 +proof -
  13.114 +  have "path_image (part_circlepath z r s t) = 
  13.115 +          (\<lambda>x. z + r * exp(\<i> * of_real x)) ` linepath s t ` {0..1}"
  13.116 +    by (simp add: image_image path_image_def part_circlepath_def)
  13.117 +  also have "linepath s t ` {0..1} = closed_segment s t"
  13.118 +    by (rule linepath_image_01)
  13.119 +  finally show ?thesis by (simp add: cis_conv_exp)
  13.120 +qed
  13.121 +
  13.122  corollary path_image_part_circlepath_subset:
  13.123      "\<lbrakk>s \<le> t; 0 \<le> r\<rbrakk> \<Longrightarrow> path_image(part_circlepath z r s t) \<subseteq> sphere z r"
  13.124  by (auto simp: path_image_part_circlepath sphere_def dist_norm algebra_simps norm_mult)
  13.125 @@ -4937,6 +5031,106 @@
  13.126      by (simp add: dist_norm norm_minus_commute)
  13.127  qed
  13.128  
  13.129 +corollary path_image_part_circlepath_subset':
  13.130 +  assumes "r \<ge> 0"
  13.131 +  shows   "path_image (part_circlepath z r s t) \<subseteq> sphere z r"
  13.132 +proof (cases "s \<le> t")
  13.133 +  case True
  13.134 +  thus ?thesis using path_image_part_circlepath_subset[of s t r z] assms by simp
  13.135 +next
  13.136 +  case False
  13.137 +  thus ?thesis using path_image_part_circlepath_subset[of t s r z] assms
  13.138 +    by (subst reversepath_part_circlepath [symmetric], subst path_image_reversepath) simp_all
  13.139 +qed
  13.140 +
  13.141 +lemma part_circlepath_cnj: "cnj (part_circlepath c r a b x) = part_circlepath (cnj c) r (-a) (-b) x"
  13.142 +  by (simp add: part_circlepath_def exp_cnj linepath_def algebra_simps)
  13.143 +
  13.144 +lemma contour_integral_bound_part_circlepath:
  13.145 +  assumes "f contour_integrable_on part_circlepath c r a b"
  13.146 +  assumes "B \<ge> 0" "r \<ge> 0" "\<And>x. x \<in> path_image (part_circlepath c r a b) \<Longrightarrow> norm (f x) \<le> B"
  13.147 +  shows   "norm (contour_integral (part_circlepath c r a b) f) \<le> B * r * \<bar>b - a\<bar>"
  13.148 +proof -
  13.149 +  let ?I = "integral {0..1} (\<lambda>x. f (part_circlepath c r a b x) * \<i> * of_real (r * (b - a)) *
  13.150 +              exp (\<i> * linepath a b x))"
  13.151 +  have "norm ?I \<le> integral {0..1} (\<lambda>x::real. B * 1 * (r * \<bar>b - a\<bar>) * 1)"
  13.152 +  proof (rule integral_norm_bound_integral, goal_cases)
  13.153 +    case 1
  13.154 +    with assms(1) show ?case
  13.155 +      by (simp add: contour_integrable_on vector_derivative_part_circlepath mult_ac)
  13.156 +  next
  13.157 +    case (3 x)
  13.158 +    with assms(2-) show ?case unfolding norm_mult norm_of_real abs_mult
  13.159 +      by (intro mult_mono) (auto simp: path_image_def)
  13.160 +  qed auto
  13.161 +  also have "?I = contour_integral (part_circlepath c r a b) f"
  13.162 +    by (simp add: contour_integral_integral vector_derivative_part_circlepath mult_ac)
  13.163 +  finally show ?thesis by simp
  13.164 +qed
  13.165 +
  13.166 +lemma has_contour_integral_part_circlepath_iff:
  13.167 +  assumes "a < b"
  13.168 +  shows "(f has_contour_integral I) (part_circlepath c r a b) \<longleftrightarrow>
  13.169 +           ((\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) has_integral I) {a..b}"
  13.170 +proof -
  13.171 +  have "(f has_contour_integral I) (part_circlepath c r a b) \<longleftrightarrow>
  13.172 +          ((\<lambda>x. f (part_circlepath c r a b x) * vector_derivative (part_circlepath c r a b)
  13.173 +           (at x within {0..1})) has_integral I) {0..1}"
  13.174 +    unfolding has_contour_integral_def ..
  13.175 +  also have "\<dots> \<longleftrightarrow> ((\<lambda>x. f (part_circlepath c r a b x) * r * (b - a) * \<i> *
  13.176 +                            cis (linepath a b x)) has_integral I) {0..1}"
  13.177 +    by (intro has_integral_cong, subst vector_derivative_part_circlepath01)
  13.178 +       (simp_all add: cis_conv_exp)
  13.179 +  also have "\<dots> \<longleftrightarrow> ((\<lambda>x. f (c + r * exp (\<i> * linepath (of_real a) (of_real b) x)) *
  13.180 +                       r * \<i> * exp (\<i> * linepath (of_real a) (of_real b) x) *
  13.181 +                       vector_derivative (linepath (of_real a) (of_real b)) 
  13.182 +                         (at x within {0..1})) has_integral I) {0..1}"
  13.183 +    by (intro has_integral_cong, subst vector_derivative_linepath_within)
  13.184 +       (auto simp: part_circlepath_def cis_conv_exp of_real_linepath [symmetric])
  13.185 +  also have "\<dots> \<longleftrightarrow> ((\<lambda>z. f (c + r * exp (\<i> * z)) * r * \<i> * exp (\<i> * z)) has_contour_integral I)
  13.186 +                      (linepath (of_real a) (of_real b))"
  13.187 +    by (simp add: has_contour_integral_def)
  13.188 +  also have "\<dots> \<longleftrightarrow> ((\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) has_integral I) {a..b}" using assms
  13.189 +    by (subst has_contour_integral_linepath_Reals_iff) (simp_all add: cis_conv_exp)
  13.190 +  finally show ?thesis .
  13.191 +qed
  13.192 +
  13.193 +lemma contour_integrable_part_circlepath_iff:
  13.194 +  assumes "a < b"
  13.195 +  shows "f contour_integrable_on (part_circlepath c r a b) \<longleftrightarrow>
  13.196 +           (\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}"
  13.197 +  using assms by (auto simp: contour_integrable_on_def integrable_on_def 
  13.198 +                             has_contour_integral_part_circlepath_iff)
  13.199 +
  13.200 +lemma contour_integral_part_circlepath_eq:
  13.201 +  assumes "a < b"
  13.202 +  shows "contour_integral (part_circlepath c r a b) f =
  13.203 +           integral {a..b} (\<lambda>t. f (c + r * cis t) * r * \<i> * cis t)"
  13.204 +proof (cases "f contour_integrable_on part_circlepath c r a b")
  13.205 +  case True
  13.206 +  hence "(\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}" 
  13.207 +    using assms by (simp add: contour_integrable_part_circlepath_iff)
  13.208 +  with True show ?thesis
  13.209 +    using has_contour_integral_part_circlepath_iff[OF assms]
  13.210 +          contour_integral_unique has_integral_integrable_integral by blast
  13.211 +next
  13.212 +  case False
  13.213 +  hence "\<not>(\<lambda>t. f (c + r * cis t) * r * \<i> * cis t) integrable_on {a..b}" 
  13.214 +    using assms by (simp add: contour_integrable_part_circlepath_iff)
  13.215 +  with False show ?thesis
  13.216 +    by (simp add: not_integrable_contour_integral not_integrable_integral)
  13.217 +qed
  13.218 +
  13.219 +lemma contour_integral_part_circlepath_reverse:
  13.220 +  "contour_integral (part_circlepath c r a b) f = -contour_integral (part_circlepath c r b a) f"
  13.221 +  by (subst reversepath_part_circlepath [symmetric], subst contour_integral_reversepath) simp_all
  13.222 +
  13.223 +lemma contour_integral_part_circlepath_reverse':
  13.224 +  "b < a \<Longrightarrow> contour_integral (part_circlepath c r a b) f = 
  13.225 +               -contour_integral (part_circlepath c r b a) f"
  13.226 +  by (rule contour_integral_part_circlepath_reverse)
  13.227 +
  13.228 +
  13.229  proposition finite_bounded_log: "finite {z::complex. norm z \<le> b \<and> exp z = w}"
  13.230  proof (cases "w = 0")
  13.231    case True then show ?thesis by auto
    14.1 --- a/src/HOL/Analysis/Complex_Analysis_Basics.thy	Tue Aug 07 11:39:40 2018 +0200
    14.2 +++ b/src/HOL/Analysis/Complex_Analysis_Basics.thy	Sat Aug 11 16:02:55 2018 +0200
    14.3 @@ -41,6 +41,24 @@
    14.4  lemma linear_cnj: "linear cnj"
    14.5    using bounded_linear.linear[OF bounded_linear_cnj] .
    14.6  
    14.7 +lemma vector_derivative_cnj_within:
    14.8 +  assumes "at x within A \<noteq> bot" and "f differentiable at x within A"
    14.9 +  shows   "vector_derivative (\<lambda>z. cnj (f z)) (at x within A) = 
   14.10 +             cnj (vector_derivative f (at x within A))" (is "_ = cnj ?D")
   14.11 +proof -
   14.12 +  let ?D = "vector_derivative f (at x within A)"
   14.13 +  from assms have "(f has_vector_derivative ?D) (at x within A)"
   14.14 +    by (subst (asm) vector_derivative_works)
   14.15 +  hence "((\<lambda>x. cnj (f x)) has_vector_derivative cnj ?D) (at x within A)"
   14.16 +    by (rule has_vector_derivative_cnj)
   14.17 +  thus ?thesis using assms by (auto dest: vector_derivative_within)
   14.18 +qed
   14.19 +
   14.20 +lemma vector_derivative_cnj:
   14.21 +  assumes "f differentiable at x"
   14.22 +  shows   "vector_derivative (\<lambda>z. cnj (f z)) (at x) = cnj (vector_derivative f (at x))"
   14.23 +  using assms by (intro vector_derivative_cnj_within) auto
   14.24 +
   14.25  lemma lambda_zero: "(\<lambda>h::'a::mult_zero. 0) = ( * ) 0"
   14.26    by auto
   14.27  
   14.28 @@ -286,6 +304,35 @@
   14.29    "f holomorphic_on s \<Longrightarrow> g holomorphic_on t \<Longrightarrow> f ` s \<subseteq> t \<Longrightarrow> (g o f) holomorphic_on s"
   14.30    by (metis holomorphic_on_compose holomorphic_on_subset)
   14.31  
   14.32 +lemma holomorphic_on_balls_imp_entire:
   14.33 +  assumes "\<not>bdd_above A" "\<And>r. r \<in> A \<Longrightarrow> f holomorphic_on ball c r"
   14.34 +  shows   "f holomorphic_on B"
   14.35 +proof (rule holomorphic_on_subset)
   14.36 +  show "f holomorphic_on UNIV" unfolding holomorphic_on_def
   14.37 +  proof
   14.38 +    fix z :: complex
   14.39 +    from \<open>\<not>bdd_above A\<close> obtain r where r: "r \<in> A" "r > norm (z - c)"
   14.40 +      by (meson bdd_aboveI not_le)
   14.41 +    with assms(2) have "f holomorphic_on ball c r" by blast
   14.42 +    moreover from r have "z \<in> ball c r" by (auto simp: dist_norm norm_minus_commute)
   14.43 +    ultimately show "f field_differentiable at z"
   14.44 +      by (auto simp: holomorphic_on_def at_within_open[of _ "ball c r"])
   14.45 +  qed
   14.46 +qed auto
   14.47 +
   14.48 +lemma holomorphic_on_balls_imp_entire':
   14.49 +  assumes "\<And>r. r > 0 \<Longrightarrow> f holomorphic_on ball c r"
   14.50 +  shows   "f holomorphic_on B"
   14.51 +proof (rule holomorphic_on_balls_imp_entire)
   14.52 +  {
   14.53 +    fix M :: real
   14.54 +    have "\<exists>x. x > max M 0" by (intro gt_ex)
   14.55 +    hence "\<exists>x>0. x > M" by auto
   14.56 +  }
   14.57 +  thus "\<not>bdd_above {(0::real)<..}" unfolding bdd_above_def
   14.58 +    by (auto simp: not_le)
   14.59 +qed (insert assms, auto)
   14.60 +
   14.61  lemma holomorphic_on_minus [holomorphic_intros]: "f holomorphic_on s \<Longrightarrow> (\<lambda>z. -(f z)) holomorphic_on s"
   14.62    by (metis field_differentiable_minus holomorphic_on_def)
   14.63  
    15.1 --- a/src/HOL/Analysis/Complex_Transcendental.thy	Tue Aug 07 11:39:40 2018 +0200
    15.2 +++ b/src/HOL/Analysis/Complex_Transcendental.thy	Sat Aug 11 16:02:55 2018 +0200
    15.3 @@ -176,6 +176,16 @@
    15.4  lemma holomorphic_on_cos: "cos holomorphic_on S"
    15.5    by (simp add: field_differentiable_within_cos holomorphic_on_def)
    15.6  
    15.7 +lemma holomorphic_on_sin' [holomorphic_intros]:
    15.8 +  assumes "f holomorphic_on A"
    15.9 +  shows   "(\<lambda>x. sin (f x)) holomorphic_on A"
   15.10 +  using holomorphic_on_compose[OF assms holomorphic_on_sin] by (simp add: o_def)
   15.11 +
   15.12 +lemma holomorphic_on_cos' [holomorphic_intros]:
   15.13 +  assumes "f holomorphic_on A"
   15.14 +  shows   "(\<lambda>x. cos (f x)) holomorphic_on A"
   15.15 +  using holomorphic_on_compose[OF assms holomorphic_on_cos] by (simp add: o_def)
   15.16 +
   15.17  subsection\<open>Get a nice real/imaginary separation in Euler's formula\<close>
   15.18  
   15.19  lemma Euler: "exp(z) = of_real(exp(Re z)) *
   15.20 @@ -1308,6 +1318,11 @@
   15.21  lemma holomorphic_on_Ln [holomorphic_intros]: "(\<And>z. z \<in> S \<Longrightarrow> z \<notin> \<real>\<^sub>\<le>\<^sub>0) \<Longrightarrow> Ln holomorphic_on S"
   15.22    by (simp add: field_differentiable_within_Ln holomorphic_on_def)
   15.23  
   15.24 +lemma holomorphic_on_Ln' [holomorphic_intros]:
   15.25 +  "(\<And>z. z \<in> A \<Longrightarrow> f z \<notin> \<real>\<^sub>\<le>\<^sub>0) \<Longrightarrow> f holomorphic_on A \<Longrightarrow> (\<lambda>z. Ln (f z)) holomorphic_on A"
   15.26 +  using holomorphic_on_compose_gen[OF _ holomorphic_on_Ln, of f A "- \<real>\<^sub>\<le>\<^sub>0"]
   15.27 +  by (auto simp: o_def)
   15.28 +
   15.29  lemma tendsto_Ln [tendsto_intros]:
   15.30    fixes L F
   15.31    assumes "(f \<longlongrightarrow> L) F" "L \<notin> \<real>\<^sub>\<le>\<^sub>0"
    16.1 --- a/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy	Tue Aug 07 11:39:40 2018 +0200
    16.2 +++ b/src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy	Sat Aug 11 16:02:55 2018 +0200
    16.3 @@ -4612,6 +4612,93 @@
    16.4      unfolding absolutely_integrable_restrict_UNIV .
    16.5  qed
    16.6  
    16.7 +lemma uniform_limit_set_lebesgue_integral_at_top:
    16.8 +  fixes f :: "'a \<Rightarrow> real \<Rightarrow> 'b::{banach, second_countable_topology}"
    16.9 +    and g :: "real \<Rightarrow> real"
   16.10 +  assumes bound: "\<And>x y. x \<in> A \<Longrightarrow> y \<ge> a \<Longrightarrow> norm (f x y) \<le> g y"
   16.11 +  assumes integrable: "set_integrable M {a..} g"
   16.12 +  assumes measurable: "\<And>x. x \<in> A \<Longrightarrow> set_borel_measurable M {a..} (f x)"
   16.13 +  assumes "sets borel \<subseteq> sets M"
   16.14 +  shows   "uniform_limit A (\<lambda>b x. LINT y:{a..b}|M. f x y) (\<lambda>x. LINT y:{a..}|M. f x y) at_top"
   16.15 +proof (cases "A = {}")
   16.16 +  case False
   16.17 +  then obtain x where x: "x \<in> A" by auto
   16.18 +  have g_nonneg: "g y \<ge> 0" if "y \<ge> a" for y
   16.19 +  proof -
   16.20 +    have "0 \<le> norm (f x y)" by simp
   16.21 +    also have "\<dots> \<le> g y" using bound[OF x that] by simp
   16.22 +    finally show ?thesis .
   16.23 +  qed
   16.24 +
   16.25 +  have integrable': "set_integrable M {a..} (\<lambda>y. f x y)" if "x \<in> A" for x
   16.26 +    unfolding set_integrable_def
   16.27 +  proof (rule Bochner_Integration.integrable_bound)
   16.28 +    show "integrable M (\<lambda>x. indicator {a..} x * g x)"
   16.29 +      using integrable by (simp add: set_integrable_def)
   16.30 +    show "(\<lambda>y. indicat_real {a..} y *\<^sub>R f x y) \<in> borel_measurable M" using measurable[OF that]
   16.31 +      by (simp add: set_borel_measurable_def)
   16.32 +    show "AE y in M. norm (indicat_real {a..} y *\<^sub>R f x y) \<le> norm (indicat_real {a..} y * g y)"
   16.33 +      using bound[OF that] by (intro AE_I2) (auto simp: indicator_def g_nonneg)
   16.34 +  qed
   16.35 +
   16.36 +  show ?thesis
   16.37 +  proof (rule uniform_limitI)
   16.38 +    fix e :: real assume e: "e > 0"
   16.39 +    have sets [intro]: "A \<in> sets M" if "A \<in> sets borel" for A
   16.40 +      using that assms by blast
   16.41 +  
   16.42 +    have "((\<lambda>b. LINT y:{a..b}|M. g y) \<longlongrightarrow> (LINT y:{a..}|M. g y)) at_top"
   16.43 +      by (intro tendsto_set_lebesgue_integral_at_top assms sets) auto
   16.44 +    with e obtain b0 :: real where b0: "\<forall>b\<ge>b0. \<bar>(LINT y:{a..}|M. g y) - (LINT y:{a..b}|M. g y)\<bar> < e"
   16.45 +      by (auto simp: tendsto_iff eventually_at_top_linorder dist_real_def abs_minus_commute)
   16.46 +    define b where "b = max a b0"
   16.47 +    have "a \<le> b" by (simp add: b_def)
   16.48 +    from b0 have "\<bar>(LINT y:{a..}|M. g y) - (LINT y:{a..b}|M. g y)\<bar> < e"
   16.49 +      by (auto simp: b_def)
   16.50 +    also have "{a..} = {a..b} \<union> {b<..}" by (auto simp: b_def)
   16.51 +    also have "\<bar>(LINT y:\<dots>|M. g y) - (LINT y:{a..b}|M. g y)\<bar> = \<bar>(LINT y:{b<..}|M. g y)\<bar>"
   16.52 +      using \<open>a \<le> b\<close> by (subst set_integral_Un) (auto intro!: set_integrable_subset[OF integrable])
   16.53 +    also have "(LINT y:{b<..}|M. g y) \<ge> 0"
   16.54 +      using g_nonneg \<open>a \<le> b\<close> unfolding set_lebesgue_integral_def
   16.55 +      by (intro Bochner_Integration.integral_nonneg) (auto simp: indicator_def)
   16.56 +    hence "\<bar>(LINT y:{b<..}|M. g y)\<bar> = (LINT y:{b<..}|M. g y)" by simp
   16.57 +    finally have less: "(LINT y:{b<..}|M. g y) < e" .
   16.58 +
   16.59 +    have "eventually (\<lambda>b. b \<ge> b0) at_top" by (rule eventually_ge_at_top)
   16.60 +    moreover have "eventually (\<lambda>b. b \<ge> a) at_top" by (rule eventually_ge_at_top)
   16.61 +    ultimately show "eventually (\<lambda>b. \<forall>x\<in>A. 
   16.62 +                       dist (LINT y:{a..b}|M. f x y) (LINT y:{a..}|M. f x y) < e) at_top"
   16.63 +    proof eventually_elim
   16.64 +      case (elim b)
   16.65 +      show ?case
   16.66 +      proof
   16.67 +        fix x assume x: "x \<in> A"
   16.68 +        have "dist (LINT y:{a..b}|M. f x y) (LINT y:{a..}|M. f x y) =
   16.69 +                norm ((LINT y:{a..}|M. f x y) - (LINT y:{a..b}|M. f x y))"
   16.70 +          by (simp add: dist_norm norm_minus_commute)
   16.71 +        also have "{a..} = {a..b} \<union> {b<..}" using elim by auto
   16.72 +        also have "(LINT y:\<dots>|M. f x y) - (LINT y:{a..b}|M. f x y) = (LINT y:{b<..}|M. f x y)"
   16.73 +          using elim x
   16.74 +          by (subst set_integral_Un) (auto intro!: set_integrable_subset[OF integrable'])
   16.75 +        also have "norm \<dots> \<le> (LINT y:{b<..}|M. norm (f x y))" using elim x
   16.76 +          by (intro set_integral_norm_bound set_integrable_subset[OF integrable']) auto
   16.77 +        also have "\<dots> \<le> (LINT y:{b<..}|M. g y)" using elim x bound g_nonneg
   16.78 +          by (intro set_integral_mono set_integrable_norm set_integrable_subset[OF integrable']
   16.79 +                    set_integrable_subset[OF integrable]) auto
   16.80 +        also have "(LINT y:{b<..}|M. g y) \<ge> 0"
   16.81 +          using g_nonneg \<open>a \<le> b\<close> unfolding set_lebesgue_integral_def
   16.82 +          by (intro Bochner_Integration.integral_nonneg) (auto simp: indicator_def)
   16.83 +        hence "(LINT y:{b<..}|M. g y) = \<bar>(LINT y:{b<..}|M. g y)\<bar>" by simp
   16.84 +        also have "\<dots> = \<bar>(LINT y:{a..b} \<union> {b<..}|M. g y) - (LINT y:{a..b}|M. g y)\<bar>"
   16.85 +          using elim by (subst set_integral_Un) (auto intro!: set_integrable_subset[OF integrable])
   16.86 +        also have "{a..b} \<union> {b<..} = {a..}" using elim by auto
   16.87 +        also have "\<bar>(LINT y:{a..}|M. g y) - (LINT y:{a..b}|M. g y)\<bar> < e"
   16.88 +          using b0 elim by blast
   16.89 +        finally show "dist (LINT y:{a..b}|M. f x y) (LINT y:{a..}|M. f x y) < e" .
   16.90 +      qed
   16.91 +    qed
   16.92 +  qed
   16.93 +qed auto
   16.94  
   16.95  
   16.96  
    17.1 --- a/src/HOL/Analysis/FPS_Convergence.thy	Tue Aug 07 11:39:40 2018 +0200
    17.2 +++ b/src/HOL/Analysis/FPS_Convergence.thy	Sat Aug 11 16:02:55 2018 +0200
    17.3 @@ -193,6 +193,24 @@
    17.4      by (subst analytic_on_open) auto
    17.5  qed
    17.6  
    17.7 +lemma continuous_eval_fps [continuous_intros]:
    17.8 +  fixes z :: "'a::{real_normed_field,banach}"
    17.9 +  assumes "norm z < fps_conv_radius F"
   17.10 +  shows   "continuous (at z within A) (eval_fps F)"
   17.11 +proof -
   17.12 +  from ereal_dense2[OF assms] obtain K :: real where K: "norm z < K" "K < fps_conv_radius F"
   17.13 +    by auto
   17.14 +  have "0 \<le> norm z" by simp
   17.15 +  also have "norm z < K" by fact
   17.16 +  finally have "K > 0" .
   17.17 +  from K and \<open>K > 0\<close> have "summable (\<lambda>n. fps_nth F n * of_real K ^ n)"
   17.18 +    by (intro summable_fps) auto
   17.19 +  from this have "isCont (eval_fps F) z" unfolding eval_fps_def
   17.20 +    by (rule isCont_powser) (use K in auto)
   17.21 +  thus "continuous (at z within A)  (eval_fps F)"
   17.22 +    by (simp add: continuous_at_imp_continuous_within)
   17.23 +qed
   17.24 +
   17.25  
   17.26  subsection%unimportant \<open>Lower bounds on radius of convergence\<close>
   17.27  
   17.28 @@ -831,6 +849,20 @@
   17.29    ultimately show ?thesis using r(1) by (auto simp: has_fps_expansion_def)
   17.30  qed
   17.31  
   17.32 +lemma has_fps_expansion_imp_continuous:
   17.33 +  fixes F :: "'a::{real_normed_field,banach} fps"
   17.34 +  assumes "f has_fps_expansion F"
   17.35 +  shows   "continuous (at 0 within A) f"
   17.36 +proof -
   17.37 +  from assms have "isCont (eval_fps F) 0"
   17.38 +    by (intro continuous_eval_fps) (auto simp: has_fps_expansion_def zero_ereal_def)
   17.39 +  also have "?this \<longleftrightarrow> isCont f 0" using assms
   17.40 +    by (intro isCont_cong) (auto simp: has_fps_expansion_def)
   17.41 +  finally have "isCont f 0" .
   17.42 +  thus "continuous (at 0 within A) f"
   17.43 +    by (simp add: continuous_at_imp_continuous_within)
   17.44 +qed
   17.45 +
   17.46  lemma has_fps_expansion_const [simp, intro, fps_expansion_intros]:
   17.47    "(\<lambda>_. c) has_fps_expansion fps_const c"
   17.48    by (auto simp: has_fps_expansion_def)
    18.1 --- a/src/HOL/Analysis/Gamma_Function.thy	Tue Aug 07 11:39:40 2018 +0200
    18.2 +++ b/src/HOL/Analysis/Gamma_Function.thy	Sat Aug 11 16:02:55 2018 +0200
    18.3 @@ -1457,6 +1457,15 @@
    18.4  lemma holomorphic_rGamma [holomorphic_intros]: "rGamma holomorphic_on A"
    18.5    unfolding holomorphic_on_def by (auto intro!: field_differentiable_rGamma)
    18.6  
    18.7 +lemma holomorphic_rGamma' [holomorphic_intros]: 
    18.8 +  assumes "f holomorphic_on A"
    18.9 +  shows   "(\<lambda>x. rGamma (f x)) holomorphic_on A"
   18.10 +proof -
   18.11 +  have "rGamma \<circ> f holomorphic_on A" using assms
   18.12 +    by (intro holomorphic_on_compose assms holomorphic_rGamma)
   18.13 +  thus ?thesis by (simp only: o_def)
   18.14 +qed
   18.15 +
   18.16  lemma analytic_rGamma: "rGamma analytic_on A"
   18.17    unfolding analytic_on_def by (auto intro!: exI[of _ 1] holomorphic_rGamma)
   18.18  
   18.19 @@ -1467,6 +1476,15 @@
   18.20  lemma holomorphic_Gamma [holomorphic_intros]: "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> Gamma holomorphic_on A"
   18.21    unfolding holomorphic_on_def by (auto intro!: field_differentiable_Gamma)
   18.22  
   18.23 +lemma holomorphic_Gamma' [holomorphic_intros]: 
   18.24 +  assumes "f holomorphic_on A" and "\<And>x. x \<in> A \<Longrightarrow> f x \<notin> \<int>\<^sub>\<le>\<^sub>0"
   18.25 +  shows   "(\<lambda>x. Gamma (f x)) holomorphic_on A"
   18.26 +proof -
   18.27 +  have "Gamma \<circ> f holomorphic_on A" using assms
   18.28 +    by (intro holomorphic_on_compose assms holomorphic_Gamma) auto
   18.29 +  thus ?thesis by (simp only: o_def)
   18.30 +qed
   18.31 +
   18.32  lemma analytic_Gamma: "A \<inter> \<int>\<^sub>\<le>\<^sub>0 = {} \<Longrightarrow> Gamma analytic_on A"
   18.33    by (rule analytic_on_subset[of _ "UNIV - \<int>\<^sub>\<le>\<^sub>0"], subst analytic_on_open)
   18.34       (auto intro!: holomorphic_Gamma)
    19.1 --- a/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy	Tue Aug 07 11:39:40 2018 +0200
    19.2 +++ b/src/HOL/Analysis/Henstock_Kurzweil_Integration.thy	Sat Aug 11 16:02:55 2018 +0200
    19.3 @@ -687,6 +687,17 @@
    19.4    apply (simp_all add: integrable_integral integrable_linear has_integral_linear )
    19.5    done
    19.6  
    19.7 +lemma integrable_on_cnj_iff:
    19.8 +  "(\<lambda>x. cnj (f x)) integrable_on A \<longleftrightarrow> f integrable_on A"
    19.9 +  using integrable_linear[OF _ bounded_linear_cnj, of f A]
   19.10 +        integrable_linear[OF _ bounded_linear_cnj, of "cnj \<circ> f" A]
   19.11 +  by (auto simp: o_def)
   19.12 +
   19.13 +lemma integral_cnj: "cnj (integral A f) = integral A (\<lambda>x. cnj (f x))"
   19.14 +  by (cases "f integrable_on A")
   19.15 +     (simp_all add: integral_linear[OF _ bounded_linear_cnj, symmetric]
   19.16 +                    o_def integrable_on_cnj_iff not_integrable_integral)
   19.17 +
   19.18  lemma integral_component_eq[simp]:
   19.19    fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   19.20    assumes "f integrable_on S"
   19.21 @@ -3440,6 +3451,64 @@
   19.22  
   19.23  lemmas has_integral_affinity01 = has_integral_affinity [of _ _ 0 "1::real", simplified]
   19.24  
   19.25 +lemma integrable_on_affinity:
   19.26 +  assumes "m \<noteq> 0" "f integrable_on (cbox a b)"
   19.27 +  shows   "(\<lambda>x. f (m *\<^sub>R x + c)) integrable_on ((\<lambda>x. (1 / m) *\<^sub>R x - ((1 / m) *\<^sub>R c)) ` cbox a b)"
   19.28 +proof -
   19.29 +  from assms obtain I where "(f has_integral I) (cbox a b)"
   19.30 +    by (auto simp: integrable_on_def)
   19.31 +  from has_integral_affinity[OF this assms(1), of c] show ?thesis
   19.32 +    by (auto simp: integrable_on_def)
   19.33 +qed
   19.34 +
   19.35 +lemma has_integral_cmul_iff:
   19.36 +  assumes "c \<noteq> 0"
   19.37 +  shows   "((\<lambda>x. c *\<^sub>R f x) has_integral (c *\<^sub>R I)) A \<longleftrightarrow> (f has_integral I) A"
   19.38 +  using assms has_integral_cmul[of f I A c]
   19.39 +        has_integral_cmul[of "\<lambda>x. c *\<^sub>R f x" "c *\<^sub>R I" A "inverse c"] by (auto simp: field_simps)
   19.40 +
   19.41 +lemma has_integral_affinity':
   19.42 +  fixes a :: "'a::euclidean_space"
   19.43 +  assumes "(f has_integral i) (cbox a b)" and "m > 0"
   19.44 +  shows "((\<lambda>x. f(m *\<^sub>R x + c)) has_integral (i /\<^sub>R m ^ DIM('a)))
   19.45 +           (cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m))"
   19.46 +proof (cases "cbox a b = {}")
   19.47 +  case True
   19.48 +  hence "(cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)) = {}"
   19.49 +    using \<open>m > 0\<close> unfolding box_eq_empty by (auto simp: algebra_simps)
   19.50 +  with True and assms show ?thesis by simp
   19.51 +next
   19.52 +  case False
   19.53 +  have "((\<lambda>x. f (m *\<^sub>R x + c)) has_integral (1 / \<bar>m\<bar> ^ DIM('a)) *\<^sub>R i)
   19.54 +          ((\<lambda>x. (1 / m) *\<^sub>R x + - ((1 / m) *\<^sub>R c)) ` cbox a b)"
   19.55 +    using assms by (intro has_integral_affinity) auto
   19.56 +  also have "((\<lambda>x. (1 / m) *\<^sub>R x + - ((1 / m) *\<^sub>R c)) ` cbox a b) =
   19.57 +               ((\<lambda>x.  - ((1 / m) *\<^sub>R c) + x) ` (\<lambda>x. (1 / m) *\<^sub>R x) ` cbox a b)"
   19.58 +    by (simp add: image_image algebra_simps)
   19.59 +  also have "(\<lambda>x. (1 / m) *\<^sub>R x) ` cbox a b = cbox ((1 / m) *\<^sub>R a) ((1 / m) *\<^sub>R b)" using \<open>m > 0\<close> False
   19.60 +    by (subst image_smult_cbox) simp_all
   19.61 +  also have "(\<lambda>x. - ((1 / m) *\<^sub>R c) + x) ` \<dots> = cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)"
   19.62 +    by (subst cbox_translation [symmetric]) (simp add: field_simps vector_add_divide_simps)
   19.63 +  finally show ?thesis using \<open>m > 0\<close> by (simp add: field_simps)
   19.64 +qed
   19.65 +
   19.66 +lemma has_integral_affinity_iff:
   19.67 +  fixes f :: "'a :: euclidean_space \<Rightarrow> 'b :: real_normed_vector"
   19.68 +  assumes "m > 0"
   19.69 +  shows   "((\<lambda>x. f (m *\<^sub>R x + c)) has_integral (I /\<^sub>R m ^ DIM('a)))
   19.70 +               (cbox ((a - c) /\<^sub>R m) ((b - c) /\<^sub>R m)) \<longleftrightarrow>
   19.71 +           (f has_integral I) (cbox a b)" (is "?lhs = ?rhs")
   19.72 +proof
   19.73 +  assume ?lhs
   19.74 +  from has_integral_affinity'[OF this, of "1 / m" "-c /\<^sub>R m"] and \<open>m > 0\<close>
   19.75 +    show ?rhs by (simp add: field_simps vector_add_divide_simps)
   19.76 +next
   19.77 +  assume ?rhs
   19.78 +  from has_integral_affinity'[OF this, of m c] and \<open>m > 0\<close>
   19.79 +  show ?lhs by simp
   19.80 +qed
   19.81 +
   19.82 +
   19.83  subsection \<open>Special case of stretching coordinate axes separately\<close>
   19.84  
   19.85  lemma has_integral_stretch:
    20.1 --- a/src/HOL/Analysis/Path_Connected.thy	Tue Aug 07 11:39:40 2018 +0200
    20.2 +++ b/src/HOL/Analysis/Path_Connected.thy	Sat Aug 11 16:02:55 2018 +0200
    20.3 @@ -1177,6 +1177,21 @@
    20.4    unfolding pathfinish_def linepath_def
    20.5    by auto
    20.6  
    20.7 +lemma linepath_inner: "linepath a b x \<bullet> v = linepath (a \<bullet> v) (b \<bullet> v) x"
    20.8 +  by (simp add: linepath_def algebra_simps)
    20.9 +
   20.10 +lemma Re_linepath': "Re (linepath a b x) = linepath (Re a) (Re b) x"
   20.11 +  by (simp add: linepath_def)
   20.12 +
   20.13 +lemma Im_linepath': "Im (linepath a b x) = linepath (Im a) (Im b) x"
   20.14 +  by (simp add: linepath_def)
   20.15 +
   20.16 +lemma linepath_0': "linepath a b 0 = a"
   20.17 +  by (simp add: linepath_def)
   20.18 +
   20.19 +lemma linepath_1': "linepath a b 1 = b"
   20.20 +  by (simp add: linepath_def)
   20.21 +
   20.22  lemma continuous_linepath_at[intro]: "continuous (at x) (linepath a b)"
   20.23    unfolding linepath_def
   20.24    by (intro continuous_intros)
   20.25 @@ -1200,6 +1215,9 @@
   20.26  lemma linepath_0 [simp]: "linepath 0 b x = x *\<^sub>R b"
   20.27    by (simp add: linepath_def)
   20.28  
   20.29 +lemma linepath_cnj: "cnj (linepath a b x) = linepath (cnj a) (cnj b) x"
   20.30 +  by (simp add: linepath_def)
   20.31 +
   20.32  lemma arc_linepath:
   20.33    assumes "a \<noteq> b" shows [simp]: "arc (linepath a b)"
   20.34  proof -
    21.1 --- a/src/HOL/Analysis/Set_Integral.thy	Tue Aug 07 11:39:40 2018 +0200
    21.2 +++ b/src/HOL/Analysis/Set_Integral.thy	Sat Aug 11 16:02:55 2018 +0200
    21.3 @@ -54,6 +54,15 @@
    21.4    by (auto simp add: indicator_def)
    21.5  *)
    21.6  
    21.7 +lemma set_integrable_cong:
    21.8 +  assumes "M = M'" "A = A'" "\<And>x. x \<in> A \<Longrightarrow> f x = f' x"
    21.9 +  shows   "set_integrable M A f = set_integrable M' A' f'"
   21.10 +proof -
   21.11 +  have "(\<lambda>x. indicator A x *\<^sub>R f x) = (\<lambda>x. indicator A' x *\<^sub>R f' x)"
   21.12 +    using assms by (auto simp: indicator_def)
   21.13 +  thus ?thesis by (simp add: set_integrable_def assms)
   21.14 +qed
   21.15 +
   21.16  lemma set_borel_measurable_sets:
   21.17    fixes f :: "_ \<Rightarrow> _::real_normed_vector"
   21.18    assumes "set_borel_measurable M X f" "B \<in> sets borel" "X \<in> sets M"
   21.19 @@ -925,4 +934,127 @@
   21.20    then show "integrable M (F n)" by (subst integrable_iff_bounded, simp add: assms(1)[of n])
   21.21  qed (auto simp add: assms Limsup_bounded)
   21.22  
   21.23 +lemma tendsto_set_lebesgue_integral_at_right:
   21.24 +  fixes a b :: real and f :: "real \<Rightarrow> 'a :: {banach,second_countable_topology}"
   21.25 +  assumes "a < b" and sets: "\<And>a'. a' \<in> {a<..b} \<Longrightarrow> {a'..b} \<in> sets M"
   21.26 +      and "set_integrable M {a<..b} f"
   21.27 +  shows   "((\<lambda>a'. set_lebesgue_integral M {a'..b} f) \<longlongrightarrow>
   21.28 +             set_lebesgue_integral M {a<..b} f) (at_right a)"
   21.29 +proof (rule tendsto_at_right_sequentially[OF assms(1)], goal_cases)
   21.30 +  case (1 S)
   21.31 +  have eq: "(\<Union>n. {S n..b}) = {a<..b}"
   21.32 +  proof safe
   21.33 +    fix x n assume "x \<in> {S n..b}"
   21.34 +    with 1(1,2)[of n] show "x \<in> {a<..b}" by auto
   21.35 +  next
   21.36 +    fix x assume "x \<in> {a<..b}"
   21.37 +    with order_tendstoD[OF \<open>S \<longlonglongrightarrow> a\<close>, of x] show "x \<in> (\<Union>n. {S n..b})"
   21.38 +      by (force simp: eventually_at_top_linorder dest: less_imp_le)
   21.39 +  qed
   21.40 +  have "(\<lambda>n. set_lebesgue_integral M {S n..b} f) \<longlonglongrightarrow> set_lebesgue_integral M (\<Union>n. {S n..b}) f"
   21.41 +    by (rule set_integral_cont_up) (insert assms 1, auto simp: eq incseq_def decseq_def less_imp_le)
   21.42 +  with eq show ?case by simp
   21.43 +qed
   21.44 +
   21.45 +
   21.46 +text \<open>
   21.47 +  The next lemmas relate convergence of integrals over an interval to
   21.48 +  improper integrals.
   21.49 +\<close>
   21.50 +lemma tendsto_set_lebesgue_integral_at_left:
   21.51 +  fixes a b :: real and f :: "real \<Rightarrow> 'a :: {banach,second_countable_topology}"
   21.52 +  assumes "a < b" and sets: "\<And>b'. b' \<in> {a..<b} \<Longrightarrow> {a..b'} \<in> sets M"
   21.53 +      and "set_integrable M {a..<b} f"
   21.54 +  shows   "((\<lambda>b'. set_lebesgue_integral M {a..b'} f) \<longlongrightarrow>
   21.55 +             set_lebesgue_integral M {a..<b} f) (at_left b)"
   21.56 +proof (rule tendsto_at_left_sequentially[OF assms(1)], goal_cases)
   21.57 +  case (1 S)
   21.58 +  have eq: "(\<Union>n. {a..S n}) = {a..<b}"
   21.59 +  proof safe
   21.60 +    fix x n assume "x \<in> {a..S n}"
   21.61 +    with 1(1,2)[of n] show "x \<in> {a..<b}" by auto
   21.62 +  next
   21.63 +    fix x assume "x \<in> {a..<b}"
   21.64 +    with order_tendstoD[OF \<open>S \<longlonglongrightarrow> b\<close>, of x] show "x \<in> (\<Union>n. {a..S n})"
   21.65 +      by (force simp: eventually_at_top_linorder dest: less_imp_le)
   21.66 +  qed
   21.67 +  have "(\<lambda>n. set_lebesgue_integral M {a..S n} f) \<longlonglongrightarrow> set_lebesgue_integral M (\<Union>n. {a..S n}) f"
   21.68 +    by (rule set_integral_cont_up) (insert assms 1, auto simp: eq incseq_def decseq_def less_imp_le)
   21.69 +  with eq show ?case by simp
   21.70 +qed
   21.71 +
   21.72 +lemma tendsto_set_lebesgue_integral_at_top:
   21.73 +  fixes f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
   21.74 +  assumes sets: "\<And>b. b \<ge> a \<Longrightarrow> {a..b} \<in> sets M"
   21.75 +      and int: "set_integrable M {a..} f"
   21.76 +  shows "((\<lambda>b. set_lebesgue_integral M {a..b} f) \<longlongrightarrow> set_lebesgue_integral M {a..} f) at_top"
   21.77 +proof (rule tendsto_at_topI_sequentially)
   21.78 +  fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   21.79 +  show "(\<lambda>n. set_lebesgue_integral M {a..X n} f) \<longlonglongrightarrow> set_lebesgue_integral M {a..} f"
   21.80 +    unfolding set_lebesgue_integral_def
   21.81 +  proof (rule integral_dominated_convergence)
   21.82 +    show "integrable M (\<lambda>x. indicat_real {a..} x *\<^sub>R norm (f x))"
   21.83 +      using integrable_norm[OF int[unfolded set_integrable_def]] by simp
   21.84 +    show "AE x in M. (\<lambda>n. indicator {a..X n} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {a..} x *\<^sub>R f x"
   21.85 +    proof
   21.86 +      fix x
   21.87 +      from \<open>filterlim X at_top sequentially\<close>
   21.88 +      have "eventually (\<lambda>n. x \<le> X n) sequentially"
   21.89 +        unfolding filterlim_at_top_ge[where c=x] by auto
   21.90 +      then show "(\<lambda>n. indicator {a..X n} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {a..} x *\<^sub>R f x"
   21.91 +        by (intro Lim_eventually) (auto split: split_indicator elim!: eventually_mono)
   21.92 +    qed
   21.93 +    fix n show "AE x in M. norm (indicator {a..X n} x *\<^sub>R f x) \<le> 
   21.94 +                             indicator {a..} x *\<^sub>R norm (f x)"
   21.95 +      by (auto split: split_indicator)
   21.96 +  next
   21.97 +    from int show "(\<lambda>x. indicat_real {a..} x *\<^sub>R f x) \<in> borel_measurable M"
   21.98 +      by (simp add: set_integrable_def)
   21.99 +  next
  21.100 +    fix n :: nat
  21.101 +    from sets have "{a..X n} \<in> sets M" by (cases "X n \<ge> a") auto
  21.102 +    with int have "set_integrable M {a..X n} f"
  21.103 +      by (rule set_integrable_subset) auto
  21.104 +    thus "(\<lambda>x. indicat_real {a..X n} x *\<^sub>R f x) \<in> borel_measurable M"
  21.105 +      by (simp add: set_integrable_def)
  21.106 +  qed
  21.107 +qed
  21.108 +
  21.109 +lemma tendsto_set_lebesgue_integral_at_bot:
  21.110 +  fixes f :: "real \<Rightarrow> 'a::{banach, second_countable_topology}"
  21.111 +  assumes sets: "\<And>a. a \<le> b \<Longrightarrow> {a..b} \<in> sets M"
  21.112 +      and int: "set_integrable M {..b} f"
  21.113 +    shows "((\<lambda>a. set_lebesgue_integral M {a..b} f) \<longlongrightarrow> set_lebesgue_integral M {..b} f) at_bot"
  21.114 +proof (rule tendsto_at_botI_sequentially)
  21.115 +  fix X :: "nat \<Rightarrow> real" assume "filterlim X at_bot sequentially"
  21.116 +  show "(\<lambda>n. set_lebesgue_integral M {X n..b} f) \<longlonglongrightarrow> set_lebesgue_integral M {..b} f"
  21.117 +    unfolding set_lebesgue_integral_def
  21.118 +  proof (rule integral_dominated_convergence)
  21.119 +    show "integrable M (\<lambda>x. indicat_real {..b} x *\<^sub>R norm (f x))"
  21.120 +      using integrable_norm[OF int[unfolded set_integrable_def]] by simp
  21.121 +    show "AE x in M. (\<lambda>n. indicator {X n..b} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {..b} x *\<^sub>R f x"
  21.122 +    proof
  21.123 +      fix x
  21.124 +      from \<open>filterlim X at_bot sequentially\<close>
  21.125 +      have "eventually (\<lambda>n. x \<ge> X n) sequentially"
  21.126 +        unfolding filterlim_at_bot_le[where c=x] by auto
  21.127 +      then show "(\<lambda>n. indicator {X n..b} x *\<^sub>R f x) \<longlonglongrightarrow> indicat_real {..b} x *\<^sub>R f x"
  21.128 +        by (intro Lim_eventually) (auto split: split_indicator elim!: eventually_mono)
  21.129 +    qed
  21.130 +    fix n show "AE x in M. norm (indicator {X n..b} x *\<^sub>R f x) \<le> 
  21.131 +                             indicator {..b} x *\<^sub>R norm (f x)"
  21.132 +      by (auto split: split_indicator)
  21.133 +  next
  21.134 +    from int show "(\<lambda>x. indicat_real {..b} x *\<^sub>R f x) \<in> borel_measurable M"
  21.135 +      by (simp add: set_integrable_def)
  21.136 +  next
  21.137 +    fix n :: nat
  21.138 +    from sets have "{X n..b} \<in> sets M" by (cases "X n \<le> b") auto
  21.139 +    with int have "set_integrable M {X n..b} f"
  21.140 +      by (rule set_integrable_subset) auto
  21.141 +    thus "(\<lambda>x. indicat_real {X n..b} x *\<^sub>R f x) \<in> borel_measurable M"
  21.142 +      by (simp add: set_integrable_def)
  21.143 +  qed
  21.144 +qed
  21.145 +
  21.146  end
    22.1 --- a/src/HOL/Archimedean_Field.thy	Tue Aug 07 11:39:40 2018 +0200
    22.2 +++ b/src/HOL/Archimedean_Field.thy	Sat Aug 11 16:02:55 2018 +0200
    22.3 @@ -707,6 +707,9 @@
    22.4  lemma frac_of_int [simp]: "frac (of_int z) = 0"
    22.5    by (simp add: frac_def)
    22.6  
    22.7 +lemma frac_frac [simp]: "frac (frac x) = frac x"
    22.8 +  by (simp add: frac_def)
    22.9 +
   22.10  lemma floor_add: "\<lfloor>x + y\<rfloor> = (if frac x + frac y < 1 then \<lfloor>x\<rfloor> + \<lfloor>y\<rfloor> else (\<lfloor>x\<rfloor> + \<lfloor>y\<rfloor>) + 1)"
   22.11  proof -
   22.12    have "x + y < 1 + (of_int \<lfloor>x\<rfloor> + of_int \<lfloor>y\<rfloor>) \<Longrightarrow> \<lfloor>x + y\<rfloor> = \<lfloor>x\<rfloor> + \<lfloor>y\<rfloor>"
   22.13 @@ -743,6 +746,14 @@
   22.14    apply (meson frac_lt_1 less_iff_diff_less_0 not_le not_less_iff_gr_or_eq)
   22.15    done
   22.16  
   22.17 +lemma frac_in_Ints_iff [simp]: "frac x \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
   22.18 +proof safe
   22.19 +  assume "frac x \<in> \<int>"
   22.20 +  hence "of_int \<lfloor>x\<rfloor> + frac x \<in> \<int>" by auto
   22.21 +  also have "of_int \<lfloor>x\<rfloor> + frac x = x" by (simp add: frac_def)
   22.22 +  finally show "x \<in> \<int>" .
   22.23 +qed (auto simp: frac_def)
   22.24 +
   22.25  
   22.26  subsection \<open>Rounding to the nearest integer\<close>
   22.27  
    23.1 --- a/src/HOL/Complex.thy	Tue Aug 07 11:39:40 2018 +0200
    23.2 +++ b/src/HOL/Complex.thy	Sat Aug 11 16:02:55 2018 +0200
    23.3 @@ -623,6 +623,27 @@
    23.4  lemma sums_cnj: "((\<lambda>x. cnj(f x)) sums cnj l) \<longleftrightarrow> (f sums l)"
    23.5    by (simp add: sums_def lim_cnj cnj_sum [symmetric] del: cnj_sum)
    23.6  
    23.7 +lemma differentiable_cnj_iff:
    23.8 +  "(\<lambda>z. cnj (f z)) differentiable at x within A \<longleftrightarrow> f differentiable at x within A"
    23.9 +proof
   23.10 +  assume "(\<lambda>z. cnj (f z)) differentiable at x within A"
   23.11 +  then obtain D where "((\<lambda>z. cnj (f z)) has_derivative D) (at x within A)"
   23.12 +    by (auto simp: differentiable_def)
   23.13 +  from has_derivative_cnj[OF this] show "f differentiable at x within A"
   23.14 +    by (auto simp: differentiable_def)
   23.15 +next
   23.16 +  assume "f differentiable at x within A"
   23.17 +  then obtain D where "(f has_derivative D) (at x within A)"
   23.18 +    by (auto simp: differentiable_def)
   23.19 +  from has_derivative_cnj[OF this] show "(\<lambda>z. cnj (f z)) differentiable at x within A"
   23.20 +    by (auto simp: differentiable_def)
   23.21 +qed
   23.22 +
   23.23 +lemma has_vector_derivative_cnj [derivative_intros]:
   23.24 +  assumes "(f has_vector_derivative f') (at z within A)"
   23.25 +  shows   "((\<lambda>z. cnj (f z)) has_vector_derivative cnj f') (at z within A)"
   23.26 +  using assms by (auto simp: has_vector_derivative_complex_iff intro: derivative_intros)
   23.27 +
   23.28  
   23.29  subsection \<open>Basic Lemmas\<close>
   23.30  
   23.31 @@ -778,9 +799,15 @@
   23.32  lemma sgn_cis [simp]: "sgn (cis a) = cis a"
   23.33    by (simp add: sgn_div_norm)
   23.34  
   23.35 +lemma cis_2pi [simp]: "cis (2 * pi) = 1"
   23.36 +  by (simp add: cis.ctr complex_eq_iff)
   23.37 +
   23.38  lemma cis_neq_zero [simp]: "cis a \<noteq> 0"
   23.39    by (metis norm_cis norm_zero zero_neq_one)
   23.40  
   23.41 +lemma cis_cnj: "cnj (cis t) = cis (-t)"
   23.42 +  by (simp add: complex_eq_iff)
   23.43 +
   23.44  lemma cis_mult: "cis a * cis b = cis (a + b)"
   23.45    by (simp add: complex_eq_iff cos_add sin_add)
   23.46  
   23.47 @@ -802,6 +829,15 @@
   23.48  lemma cis_pi [simp]: "cis pi = -1"
   23.49    by (simp add: complex_eq_iff)
   23.50  
   23.51 +lemma cis_pi_half[simp]: "cis (pi / 2) = \<i>"
   23.52 +  by (simp add: cis.ctr complex_eq_iff)
   23.53 +
   23.54 +lemma cis_minus_pi_half[simp]: "cis (-(pi / 2)) = -\<i>"
   23.55 +  by (simp add: cis.ctr complex_eq_iff)
   23.56 +
   23.57 +lemma cis_multiple_2pi[simp]: "n \<in> \<int> \<Longrightarrow> cis (2 * pi * n) = 1"
   23.58 +  by (auto elim!: Ints_cases simp: cis.ctr one_complex.ctr)
   23.59 +
   23.60  
   23.61  subsubsection \<open>$r(\cos \theta + i \sin \theta)$\<close>
   23.62  
   23.63 @@ -847,6 +883,11 @@
   23.64  
   23.65  subsubsection \<open>Complex exponential\<close>
   23.66  
   23.67 +lemma exp_Reals_eq:
   23.68 +  assumes "z \<in> \<real>"
   23.69 +  shows   "exp z = of_real (exp (Re z))"
   23.70 +  using assms by (auto elim!: Reals_cases simp: exp_of_real)
   23.71 +
   23.72  lemma cis_conv_exp: "cis b = exp (\<i> * b)"
   23.73  proof -
   23.74    have "(\<i> * complex_of_real b) ^ n /\<^sub>R fact n =
   23.75 @@ -901,6 +942,10 @@
   23.76  lemma exp_two_pi_i' [simp]: "exp (\<i> * (of_real pi * 2)) = 1"
   23.77    by (metis exp_two_pi_i mult.commute)
   23.78  
   23.79 +lemma continuous_on_cis [continuous_intros]:
   23.80 +  "continuous_on A f \<Longrightarrow> continuous_on A (\<lambda>x. cis (f x))"
   23.81 +  by (auto simp: cis_conv_exp intro!: continuous_intros)
   23.82 +
   23.83  
   23.84  subsubsection \<open>Complex argument\<close>
   23.85  
    24.1 --- a/src/HOL/GCD.thy	Tue Aug 07 11:39:40 2018 +0200
    24.2 +++ b/src/HOL/GCD.thy	Sat Aug 11 16:02:55 2018 +0200
    24.3 @@ -110,7 +110,7 @@
    24.4    assumes "a \<in> A"
    24.5    shows "a \<^bold>* F A = F A"
    24.6    using assms by (induct A rule: infinite_finite_induct)
    24.7 -    (auto simp add: left_commute [of a])
    24.8 +    (auto simp: left_commute [of a])
    24.9  
   24.10  lemma union:
   24.11    "F (A \<union> B) = F A \<^bold>* F B"
   24.12 @@ -239,7 +239,7 @@
   24.13  
   24.14  lemma is_unit_gcd_iff [simp]:
   24.15    "is_unit (gcd a b) \<longleftrightarrow> gcd a b = 1"
   24.16 -  by (cases "a = 0 \<and> b = 0") (auto simp add: unit_factor_gcd dest: is_unit_unit_factor)
   24.17 +  by (cases "a = 0 \<and> b = 0") (auto simp: unit_factor_gcd dest: is_unit_unit_factor)
   24.18  
   24.19  sublocale gcd: abel_semigroup gcd
   24.20  proof
   24.21 @@ -569,20 +569,17 @@
   24.22  lemma normalize_lcm_right: "lcm a (normalize b) = lcm a b"
   24.23    by (fact lcm.normalize_right_idem)
   24.24  
   24.25 -lemma gcd_mult_unit1: "is_unit a \<Longrightarrow> gcd (b * a) c = gcd b c"
   24.26 -  apply (rule gcdI)
   24.27 -     apply simp_all
   24.28 -  apply (rule dvd_trans)
   24.29 -   apply (rule gcd_dvd1)
   24.30 -  apply (simp add: unit_simps)
   24.31 -  done
   24.32 +lemma gcd_mult_unit1: 
   24.33 +  assumes "is_unit a" shows "gcd (b * a) c = gcd b c"
   24.34 +proof -
   24.35 +  have "gcd (b * a) c dvd b"
   24.36 +    using assms local.dvd_mult_unit_iff by blast
   24.37 +  then show ?thesis
   24.38 +    by (rule gcdI) simp_all
   24.39 +qed
   24.40  
   24.41  lemma gcd_mult_unit2: "is_unit a \<Longrightarrow> gcd b (c * a) = gcd b c"
   24.42 -  apply (subst gcd.commute)
   24.43 -  apply (subst gcd_mult_unit1)
   24.44 -   apply assumption
   24.45 -  apply (rule gcd.commute)
   24.46 -  done
   24.47 +  using gcd.commute gcd_mult_unit1 by auto
   24.48  
   24.49  lemma gcd_div_unit1: "is_unit a \<Longrightarrow> gcd (b div a) c = gcd b c"
   24.50    by (erule is_unitE [of _ b]) (simp add: gcd_mult_unit1)
   24.51 @@ -652,13 +649,13 @@
   24.52    "a dvd d \<and> b dvd d \<and> normalize d = d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
   24.53    by rule (auto intro: lcmI simp: lcm_least lcm_eq_0_iff)
   24.54  
   24.55 -lemma lcm_proj1_if_dvd: "b dvd a \<Longrightarrow> lcm a b = normalize a"
   24.56 -  apply (cases "a = 0")
   24.57 -   apply simp
   24.58 -  apply (rule sym)
   24.59 -  apply (rule lcmI)
   24.60 -     apply simp_all
   24.61 -  done
   24.62 +lemma lcm_proj1_if_dvd:
   24.63 +  assumes "b dvd a" shows "lcm a b = normalize a"
   24.64 +proof (cases "a = 0")
   24.65 +  case False
   24.66 +  then show ?thesis
   24.67 +    using assms gcd_proj2_if_dvd lcm_mult_gcd local.lcm_gcd by auto
   24.68 +qed auto
   24.69  
   24.70  lemma lcm_proj2_if_dvd: "a dvd b \<Longrightarrow> lcm a b = normalize b"
   24.71    using lcm_proj1_if_dvd [of a b] by (simp add: ac_simps)
   24.72 @@ -841,14 +838,12 @@
   24.73    by (blast intro: Lcm_least dvd_Lcm)
   24.74  
   24.75  lemma Lcm_Un: "Lcm (A \<union> B) = lcm (Lcm A) (Lcm B)"
   24.76 -  apply (rule lcmI)
   24.77 -     apply (blast intro: Lcm_subset)
   24.78 -    apply (blast intro: Lcm_subset)
   24.79 -   apply (intro Lcm_least ballI, elim UnE)
   24.80 -    apply (rule dvd_trans, erule dvd_Lcm, assumption)
   24.81 -   apply (rule dvd_trans, erule dvd_Lcm, assumption)
   24.82 -  apply simp
   24.83 -  done
   24.84 +proof -
   24.85 +  have "\<And>d. \<lbrakk>Lcm A dvd d; Lcm B dvd d\<rbrakk> \<Longrightarrow> Lcm (A \<union> B) dvd d"
   24.86 +    by (meson UnE local.Lcm_least local.dvd_Lcm local.dvd_trans)
   24.87 +  then show ?thesis
   24.88 +    by (meson Lcm_subset local.lcm_unique local.normalize_Lcm sup.cobounded1 sup.cobounded2)
   24.89 +qed
   24.90  
   24.91  lemma Gcd_0_iff [simp]: "Gcd A = 0 \<longleftrightarrow> A \<subseteq> {0}"
   24.92    (is "?P \<longleftrightarrow> ?Q")
   24.93 @@ -963,7 +958,7 @@
   24.94  next
   24.95    case False
   24.96    with assms show ?thesis
   24.97 -    by (induct A rule: finite_ne_induct) (auto simp add: lcm_eq_0_iff)
   24.98 +    by (induct A rule: finite_ne_induct) (auto simp: lcm_eq_0_iff)
   24.99  qed
  24.100  
  24.101  lemma Gcd_image_normalize [simp]: "Gcd (normalize ` A) = Gcd A"
  24.102 @@ -996,25 +991,25 @@
  24.103  lemma dvd_Gcd_iff: "x dvd Gcd A \<longleftrightarrow> (\<forall>y\<in>A. x dvd y)"
  24.104    by (blast dest: dvd_GcdD intro: Gcd_greatest)
  24.105  
  24.106 -lemma Gcd_mult: "Gcd (( * ) c ` A) = normalize c * Gcd A"
  24.107 +lemma Gcd_mult: "Gcd (( *) c ` A) = normalize c * Gcd A"
  24.108  proof (cases "c = 0")
  24.109    case True
  24.110    then show ?thesis by auto
  24.111  next
  24.112    case [simp]: False
  24.113 -  have "Gcd (( * ) c ` A) div c dvd Gcd A"
  24.114 +  have "Gcd (( *) c ` A) div c dvd Gcd A"
  24.115      by (intro Gcd_greatest, subst div_dvd_iff_mult)
  24.116         (auto intro!: Gcd_greatest Gcd_dvd simp: mult.commute[of _ c])
  24.117 -  then have "Gcd (( * ) c ` A) dvd c * Gcd A"
  24.118 +  then have "Gcd (( *) c ` A) dvd c * Gcd A"
  24.119      by (subst (asm) div_dvd_iff_mult) (auto intro: Gcd_greatest simp: mult_ac)
  24.120    also have "c * Gcd A = (normalize c * Gcd A) * unit_factor c"
  24.121      by (subst unit_factor_mult_normalize [symmetric]) (simp only: mult_ac)
  24.122 -  also have "Gcd (( * ) c ` A) dvd \<dots> \<longleftrightarrow> Gcd (( * ) c ` A) dvd normalize c * Gcd A"
  24.123 +  also have "Gcd (( *) c ` A) dvd \<dots> \<longleftrightarrow> Gcd (( *) c ` A) dvd normalize c * Gcd A"
  24.124      by (simp add: dvd_mult_unit_iff)
  24.125 -  finally have "Gcd (( * ) c ` A) dvd normalize c * Gcd A" .
  24.126 -  moreover have "normalize c * Gcd A dvd Gcd (( * ) c ` A)"
  24.127 +  finally have "Gcd (( *) c ` A) dvd normalize c * Gcd A" .
  24.128 +  moreover have "normalize c * Gcd A dvd Gcd (( *) c ` A)"
  24.129      by (intro Gcd_greatest) (auto intro: mult_dvd_mono Gcd_dvd)
  24.130 -  ultimately have "normalize (Gcd (( * ) c ` A)) = normalize (normalize c * Gcd A)"
  24.131 +  ultimately have "normalize (Gcd (( *) c ` A)) = normalize (normalize c * Gcd A)"
  24.132      by (rule associatedI)
  24.133    then show ?thesis
  24.134      by (simp add: normalize_mult)
  24.135 @@ -1035,10 +1030,10 @@
  24.136  
  24.137  lemma Lcm_mult:
  24.138    assumes "A \<noteq> {}"
  24.139 -  shows "Lcm (( * ) c ` A) = normalize c * Lcm A"
  24.140 +  shows "Lcm (( *) c ` A) = normalize c * Lcm A"
  24.141  proof (cases "c = 0")
  24.142    case True
  24.143 -  with assms have "( * ) c ` A = {0}"
  24.144 +  with assms have "( *) c ` A = {0}"
  24.145      by auto
  24.146    with True show ?thesis by auto
  24.147  next
  24.148 @@ -1047,23 +1042,23 @@
  24.149      by blast
  24.150    have "c dvd c * x"
  24.151      by simp
  24.152 -  also from x have "c * x dvd Lcm (( * ) c ` A)"
  24.153 +  also from x have "c * x dvd Lcm (( *) c ` A)"
  24.154      by (intro dvd_Lcm) auto
  24.155 -  finally have dvd: "c dvd Lcm (( * ) c ` A)" .
  24.156 -
  24.157 -  have "Lcm A dvd Lcm (( * ) c ` A) div c"
  24.158 +  finally have dvd: "c dvd Lcm (( *) c ` A)" .
  24.159 +
  24.160 +  have "Lcm A dvd Lcm (( *) c ` A) div c"
  24.161      by (intro Lcm_least dvd_mult_imp_div)
  24.162        (auto intro!: Lcm_least dvd_Lcm simp: mult.commute[of _ c])
  24.163 -  then have "c * Lcm A dvd Lcm (( * ) c ` A)"
  24.164 +  then have "c * Lcm A dvd Lcm (( *) c ` A)"
  24.165      by (subst (asm) dvd_div_iff_mult) (auto intro!: Lcm_least simp: mult_ac dvd)
  24.166    also have "c * Lcm A = (normalize c * Lcm A) * unit_factor c"
  24.167      by (subst unit_factor_mult_normalize [symmetric]) (simp only: mult_ac)
  24.168 -  also have "\<dots> dvd Lcm (( * ) c ` A) \<longleftrightarrow> normalize c * Lcm A dvd Lcm (( * ) c ` A)"
  24.169 +  also have "\<dots> dvd Lcm (( *) c ` A) \<longleftrightarrow> normalize c * Lcm A dvd Lcm (( *) c ` A)"
  24.170      by (simp add: mult_unit_dvd_iff)
  24.171 -  finally have "normalize c * Lcm A dvd Lcm (( * ) c ` A)" .
  24.172 -  moreover have "Lcm (( * ) c ` A) dvd normalize c * Lcm A"
  24.173 +  finally have "normalize c * Lcm A dvd Lcm (( *) c ` A)" .
  24.174 +  moreover have "Lcm (( *) c ` A) dvd normalize c * Lcm A"
  24.175      by (intro Lcm_least) (auto intro: mult_dvd_mono dvd_Lcm)
  24.176 -  ultimately have "normalize (normalize c * Lcm A) = normalize (Lcm (( * ) c ` A))"
  24.177 +  ultimately have "normalize (normalize c * Lcm A) = normalize (Lcm (( *) c ` A))"
  24.178      by (rule associatedI)
  24.179    then show ?thesis
  24.180      by (simp add: normalize_mult)
  24.181 @@ -1240,7 +1235,7 @@
  24.182  
  24.183  lemma Lcm_fin_0_iff:
  24.184    "Lcm\<^sub>f\<^sub>i\<^sub>n A = 0 \<longleftrightarrow> 0 \<in> A" if "finite A"
  24.185 -  using that by (induct A) (auto simp add: lcm_eq_0_iff)
  24.186 +  using that by (induct A) (auto simp: lcm_eq_0_iff)
  24.187  
  24.188  lemma Lcm_fin_1_iff:
  24.189    "Lcm\<^sub>f\<^sub>i\<^sub>n A = 1 \<longleftrightarrow> (\<forall>a\<in>A. is_unit a) \<and> finite A"
  24.190 @@ -1452,7 +1447,7 @@
  24.191    from this [symmetric] have "?g * ?a' = (?g * ?g') * ka'" "?g * ?b' = (?g * ?g') * kb'"
  24.192      by (simp_all add: mult.assoc mult.left_commute [of "gcd a b"])
  24.193    then have dvdgg':"?g * ?g' dvd a" "?g* ?g' dvd b"
  24.194 -    by (auto simp add: dvd_mult_div_cancel [OF dvdg(1)] dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
  24.195 +    by (auto simp: dvd_mult_div_cancel [OF dvdg(1)] dvd_mult_div_cancel [OF dvdg(2)] dvd_def)
  24.196    have "?g \<noteq> 0"
  24.197      using assms by simp
  24.198    moreover from gcd_greatest [OF dvdgg'] have "?g * ?g' dvd ?g" .
  24.199 @@ -1480,11 +1475,12 @@
  24.200  lemma gcd_coprime_exists:
  24.201    assumes "gcd a b \<noteq> 0"
  24.202    shows "\<exists>a' b'. a = a' * gcd a b \<and> b = b' * gcd a b \<and> coprime a' b'"
  24.203 -  apply (rule_tac x = "a div gcd a b" in exI)
  24.204 -  apply (rule_tac x = "b div gcd a b" in exI)
  24.205 -  using assms
  24.206 -  apply (auto intro: div_gcd_coprime)
  24.207 -  done
  24.208 +proof -
  24.209 +  have "coprime (a div gcd a b) (b div gcd a b)"
  24.210 +    using assms div_gcd_coprime by auto
  24.211 +  then show ?thesis
  24.212 +    by force
  24.213 +qed
  24.214  
  24.215  lemma pow_divides_pow_iff [simp]:
  24.216    "a ^ n dvd b ^ n \<longleftrightarrow> a dvd b" if "n > 0"
  24.217 @@ -1628,7 +1624,7 @@
  24.218      by simp
  24.219    also note gcd_mult_distrib
  24.220    also have "unit_factor (gcd a b ^ n) = 1"
  24.221 -    using False by (auto simp add: unit_factor_power unit_factor_gcd)
  24.222 +    using False by (auto simp: unit_factor_power unit_factor_gcd)
  24.223    also have "(gcd a b) ^ n * (a div gcd a b) ^ n = a ^ n"
  24.224      by (simp add: ac_simps div_power dvd_power_same)
  24.225    also have "(gcd a b) ^ n * (b div gcd a b) ^ n = b ^ n"
  24.226 @@ -1809,16 +1805,16 @@
  24.227    for i j :: int
  24.228    by (simp only: lcm_int_def)
  24.229  
  24.230 -lemma gcd_nat_induct:
  24.231 +lemma gcd_nat_induct [case_names base step]:
  24.232    fixes m n :: nat
  24.233    assumes "\<And>m. P m 0"
  24.234      and "\<And>m n. 0 < n \<Longrightarrow> P n (m mod n) \<Longrightarrow> P m n"
  24.235    shows "P m n"
  24.236 -  apply (rule gcd_nat.induct)
  24.237 -  apply (case_tac "y = 0")
  24.238 -  using assms
  24.239 -   apply simp_all
  24.240 -  done
  24.241 +proof (induction m n rule: gcd_nat.induct)
  24.242 +  case (1 x y)
  24.243 +  then show ?case
  24.244 +    using assms neq0_conv by blast
  24.245 +qed
  24.246  
  24.247  lemma gcd_neg1_int [simp]: "gcd (- x) y = gcd x y"
  24.248    for x y :: int
  24.249 @@ -1856,7 +1852,7 @@
  24.250      and "x \<le> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> P (lcm (- x) y)"
  24.251      and "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> P (lcm (- x) (- y))"
  24.252    shows "P (lcm x y)"
  24.253 -  using assms by (auto simp add: lcm_neg1_int lcm_neg2_int) arith
  24.254 +  using assms by (auto simp: lcm_neg1_int lcm_neg2_int) arith
  24.255  
  24.256  lemma lcm_ge_0_int [simp]: "lcm x y \<ge> 0"
  24.257    for x y :: int
  24.258 @@ -1907,7 +1903,7 @@
  24.259  
  24.260  lemma gcd_idem_int: "gcd x x = \<bar>x\<bar>"
  24.261    for x :: int
  24.262 -  by (auto simp add: gcd_int_def)
  24.263 +  by (auto simp: gcd_int_def)
  24.264  
  24.265  declare gcd_nat.simps [simp del]
  24.266  
  24.267 @@ -1921,13 +1917,10 @@
  24.268    fix m n :: nat
  24.269    show "gcd m n dvd m" and "gcd m n dvd n"
  24.270    proof (induct m n rule: gcd_nat_induct)
  24.271 -    fix m n :: nat
  24.272 -    assume "gcd n (m mod n) dvd m mod n"
  24.273 -      and "gcd n (m mod n) dvd n"
  24.274 +    case (step m n)
  24.275      then have "gcd n (m mod n) dvd m"
  24.276 -      by (rule dvd_mod_imp_dvd)
  24.277 -    moreover assume "0 < n"
  24.278 -    ultimately show "gcd m n dvd m"
  24.279 +      by (metis dvd_mod_imp_dvd)
  24.280 +    with step show "gcd m n dvd m"
  24.281        by (simp add: gcd_non_0_nat)
  24.282    qed (simp_all add: gcd_0_nat gcd_non_0_nat)
  24.283  next
  24.284 @@ -1979,25 +1972,16 @@
  24.285  
  24.286  lemma gcd_unique_nat: "d dvd a \<and> d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
  24.287    for d a :: nat
  24.288 -  apply auto
  24.289 -  apply (rule dvd_antisym)
  24.290 -   apply (erule (1) gcd_greatest)
  24.291 -  apply auto
  24.292 -  done
  24.293 +  using gcd_unique by fastforce
  24.294  
  24.295  lemma gcd_unique_int:
  24.296    "d \<ge> 0 \<and> d dvd a \<and> d dvd b \<and> (\<forall>e. e dvd a \<and> e dvd b \<longrightarrow> e dvd d) \<longleftrightarrow> d = gcd a b"
  24.297    for d a :: int
  24.298 -  apply (cases "d = 0")
  24.299 -   apply simp
  24.300 -  apply (rule iffI)
  24.301 -   apply (rule zdvd_antisym_nonneg)
  24.302 -      apply (auto intro: gcd_greatest)
  24.303 -  done
  24.304 +  using zdvd_antisym_nonneg by auto
  24.305  
  24.306  interpretation gcd_nat:
  24.307    semilattice_neutr_order gcd "0::nat" Rings.dvd "\<lambda>m n. m dvd n \<and> m \<noteq> n"
  24.308 -  by standard (auto simp add: gcd_unique_nat [symmetric] intro: dvd_antisym dvd_trans)
  24.309 +  by standard (auto simp: gcd_unique_nat [symmetric] intro: dvd_antisym dvd_trans)
  24.310  
  24.311  lemma gcd_proj1_if_dvd_int [simp]: "x dvd y \<Longrightarrow> gcd x y = \<bar>x\<bar>"
  24.312    for x y :: int
  24.313 @@ -2013,11 +1997,11 @@
  24.314  lemma gcd_mult_distrib_nat: "k * gcd m n = gcd (k * m) (k * n)"
  24.315    for k m n :: nat
  24.316    \<comment> \<open>@{cite \<open>page 27\<close> davenport92}\<close>
  24.317 -  apply (induct m n rule: gcd_nat_induct)
  24.318 -   apply simp
  24.319 -  apply (cases "k = 0")
  24.320 -   apply (simp_all add: gcd_non_0_nat)
  24.321 -  done
  24.322 +proof (induct m n rule: gcd_nat_induct)
  24.323 +  case (step m n)
  24.324 +  then show ?case
  24.325 +    by (metis gcd_mult_distrib' gcd_red_nat)
  24.326 +qed auto
  24.327  
  24.328  lemma gcd_mult_distrib_int: "\<bar>k\<bar> * gcd m n = gcd (k * m) (k * n)"
  24.329    for k m n :: int
  24.330 @@ -2033,34 +2017,49 @@
  24.331  
  24.332  lemma gcd_diff2_nat: "n \<ge> m \<Longrightarrow> gcd (n - m) n = gcd m n"
  24.333    for m n :: nat
  24.334 -  apply (subst gcd.commute)
  24.335 -  apply (subst gcd_diff1_nat [symmetric])
  24.336 -   apply auto
  24.337 -  apply (subst gcd.commute)
  24.338 -  apply (subst gcd_diff1_nat)
  24.339 -   apply assumption
  24.340 -  apply (rule gcd.commute)
  24.341 -  done
  24.342 -
  24.343 -lemma gcd_non_0_int: "y > 0 \<Longrightarrow> gcd x y = gcd y (x mod y)"
  24.344 -  for x y :: int
  24.345 -  apply (frule_tac b = y and a = x in pos_mod_sign)
  24.346 -  apply (simp del: Euclidean_Division.pos_mod_sign add: gcd_int_def abs_if nat_mod_distrib)
  24.347 -  apply (auto simp add: gcd_non_0_nat nat_mod_distrib [symmetric] zmod_zminus1_eq_if)
  24.348 -  apply (frule_tac a = x in pos_mod_bound)
  24.349 -  apply (subst (1 2) gcd.commute)
  24.350 -  apply (simp del: Euclidean_Division.pos_mod_bound add: nat_diff_distrib gcd_diff2_nat nat_le_eq_zle)
  24.351 -  done
  24.352 +  by (metis gcd.commute gcd_add2 gcd_diff1_nat le_add_diff_inverse2)
  24.353 +
  24.354 +lemma gcd_non_0_int: 
  24.355 +  fixes x y :: int
  24.356 +  assumes "y > 0" shows "gcd x y = gcd y (x mod y)"
  24.357 +proof (cases "x mod y = 0")
  24.358 +  case False
  24.359 +  then have neg: "x mod y = y - (- x) mod y"
  24.360 +    by (simp add: zmod_zminus1_eq_if)
  24.361 +  have xy: "0 \<le> x mod y" 
  24.362 +    by (simp add: assms)
  24.363 +  show ?thesis
  24.364 +  proof (cases "x < 0")
  24.365 +    case True
  24.366 +    have "nat (- x mod y) \<le> nat y"
  24.367 +      by (simp add: assms dual_order.order_iff_strict)
  24.368 +    moreover have "gcd (nat (- x)) (nat y) = gcd (nat (- x mod y)) (nat y)"
  24.369 +      using True assms gcd_non_0_nat nat_mod_distrib by auto
  24.370 +    ultimately have "gcd (nat (- x)) (nat y) = gcd (nat y) (nat (x mod y))"
  24.371 +      using assms 
  24.372 +      by (simp add: neg nat_diff_distrib') (metis gcd.commute gcd_diff2_nat)
  24.373 +    with assms \<open>0 \<le> x mod y\<close> show ?thesis
  24.374 +      by (simp add: True dual_order.order_iff_strict gcd_int_def)
  24.375 +  next
  24.376 +    case False
  24.377 +    with assms xy have "gcd (nat x) (nat y) = gcd (nat y) (nat x mod nat y)"
  24.378 +      using gcd_red_nat by blast
  24.379 +    with False assms show ?thesis
  24.380 +      by (simp add: gcd_int_def nat_mod_distrib)
  24.381 +  qed
  24.382 +qed (use assms in auto)
  24.383  
  24.384  lemma gcd_red_int: "gcd x y = gcd y (x mod y)"
  24.385    for x y :: int
  24.386 -  apply (cases "y = 0")
  24.387 -   apply force
  24.388 -  apply (cases "y > 0")
  24.389 -   apply (subst gcd_non_0_int, auto)
  24.390 -  apply (insert gcd_non_0_int [of "- y" "- x"])
  24.391 -  apply auto
  24.392 -  done
  24.393 +proof (cases y "0::int" rule: linorder_cases)
  24.394 +  case less
  24.395 +  with gcd_non_0_int [of "- y" "- x"] show ?thesis
  24.396 +    by auto
  24.397 +next
  24.398 +  case greater
  24.399 +  with gcd_non_0_int [of y x] show ?thesis
  24.400 +    by auto
  24.401 +qed auto
  24.402  
  24.403  (* TODO: differences, and all variations of addition rules
  24.404      as simplification rules for nat and int *)
  24.405 @@ -2092,34 +2091,34 @@
  24.406  qed
  24.407  
  24.408  lemma Max_divisors_self_nat [simp]: "n \<noteq> 0 \<Longrightarrow> Max {d::nat. d dvd n} = n"
  24.409 -  apply (rule antisym)
  24.410 -   apply (fastforce intro: Max_le_iff[THEN iffD2] simp: dvd_imp_le)
  24.411 -  apply simp
  24.412 -  done
  24.413 -
  24.414 -lemma Max_divisors_self_int [simp]: "n \<noteq> 0 \<Longrightarrow> Max {d::int. d dvd n} = \<bar>n\<bar>"
  24.415 -  apply (rule antisym)
  24.416 -   apply (rule Max_le_iff [THEN iffD2])
  24.417 -     apply (auto intro: abs_le_D1 dvd_imp_le_int)
  24.418 -  done
  24.419 -
  24.420 -lemma gcd_is_Max_divisors_nat: "m > 0 \<Longrightarrow> n > 0 \<Longrightarrow> gcd m n = Max {d. d dvd m \<and> d dvd n}"
  24.421 -  for m n :: nat
  24.422 -  apply (rule Max_eqI[THEN sym])
  24.423 -    apply (metis finite_Collect_conjI finite_divisors_nat)
  24.424 -   apply simp
  24.425 -   apply (metis Suc_diff_1 Suc_neq_Zero dvd_imp_le gcd_greatest_iff gcd_pos_nat)
  24.426 -  apply simp
  24.427 -  done
  24.428 -
  24.429 -lemma gcd_is_Max_divisors_int: "m \<noteq> 0 \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> gcd m n = Max {d. d dvd m \<and> d dvd n}"
  24.430 -  for m n :: int
  24.431 -  apply (rule Max_eqI[THEN sym])
  24.432 -    apply (metis finite_Collect_conjI finite_divisors_int)
  24.433 -   apply simp
  24.434 -   apply (metis gcd_greatest_iff gcd_pos_int zdvd_imp_le)
  24.435 -  apply simp
  24.436 -  done
  24.437 +  by (fastforce intro: antisym Max_le_iff[THEN iffD2] simp: dvd_imp_le)
  24.438 +
  24.439 +lemma Max_divisors_self_int [simp]: 
  24.440 +  assumes "n \<noteq> 0" shows "Max {d::int. d dvd n} = \<bar>n\<bar>"
  24.441 +proof (rule antisym)
  24.442 +  show "Max {d. d dvd n} \<le> \<bar>n\<bar>"
  24.443 +    using assms by (auto intro: abs_le_D1 dvd_imp_le_int intro!: Max_le_iff [THEN iffD2])
  24.444 +qed (simp add: assms)
  24.445 +
  24.446 +lemma gcd_is_Max_divisors_nat:
  24.447 +  fixes m n :: nat
  24.448 +  assumes "n > 0" shows "gcd m n = Max {d. d dvd m \<and> d dvd n}"
  24.449 +proof (rule Max_eqI[THEN sym], simp_all)
  24.450 +  show "finite {d. d dvd m \<and> d dvd n}"
  24.451 +    by (simp add: \<open>n > 0\<close>)
  24.452 +  show "\<And>y. y dvd m \<and> y dvd n \<Longrightarrow> y \<le> gcd m n"
  24.453 +    by (simp add: \<open>n > 0\<close> dvd_imp_le)
  24.454 +qed
  24.455 +
  24.456 +lemma gcd_is_Max_divisors_int:
  24.457 +  fixes m n :: int
  24.458 +  assumes "n \<noteq> 0" shows "gcd m n = Max {d. d dvd m \<and> d dvd n}"
  24.459 +proof (rule Max_eqI[THEN sym], simp_all)
  24.460 +  show "finite {d. d dvd m \<and> d dvd n}"
  24.461 +    by (simp add: \<open>n \<noteq> 0\<close>)
  24.462 +  show "\<And>y. y dvd m \<and> y dvd n \<Longrightarrow> y \<le> gcd m n"
  24.463 +    by (simp add: \<open>n \<noteq> 0\<close> zdvd_imp_le)
  24.464 +qed
  24.465  
  24.466  lemma gcd_code_int [code]: "gcd k l = \<bar>if l = 0 then k else gcd l (\<bar>k\<bar> mod \<bar>l\<bar>)\<bar>"
  24.467    for k l :: int
  24.468 @@ -2178,25 +2177,22 @@
  24.469  
  24.470  declare bezw.simps [simp del]
  24.471  
  24.472 -lemma bezw_aux: "fst (bezw x y) * int x + snd (bezw x y) * int y = int (gcd x y)"
  24.473 +
  24.474 +lemma bezw_aux: "int (gcd x y) = fst (bezw x y) * int x + snd (bezw x y) * int y"
  24.475  proof (induct x y rule: gcd_nat_induct)
  24.476 -  fix m :: nat
  24.477 -  show "fst (bezw m 0) * int m + snd (bezw m 0) * int 0 = int (gcd m 0)"
  24.478 -    by auto
  24.479 -next
  24.480 -  fix m n :: nat
  24.481 -  assume ngt0: "n > 0"
  24.482 -    and ih: "fst (bezw n (m mod n)) * int n + snd (bezw n (m mod n)) * int (m mod n) =
  24.483 -      int (gcd n (m mod n))"
  24.484 -  then show "fst (bezw m n) * int m + snd (bezw m n) * int n = int (gcd m n)"
  24.485 -    apply (simp add: bezw_non_0 gcd_non_0_nat)
  24.486 -    apply (erule subst)
  24.487 -    apply (simp add: field_simps)
  24.488 -    apply (subst div_mult_mod_eq [of m n, symmetric])
  24.489 -      (* applying simp here undoes the last substitution! what is procedure cancel_div_mod? *)
  24.490 -    apply (simp only: NO_MATCH_def field_simps of_nat_add of_nat_mult)
  24.491 -    done
  24.492 -qed
  24.493 +  case (step m n)
  24.494 +  then have "fst (bezw m n) * int m + snd (bezw m n) * int n - int (gcd m n) 
  24.495 +             = int m * snd (bezw n (m mod n)) -
  24.496 +               (int (m mod n) * snd (bezw n (m mod n)) + int n * (int (m div n) * snd (bezw n (m mod n))))"
  24.497 +    by (simp add: bezw_non_0 gcd_non_0_nat field_simps)
  24.498 +  also have "\<dots> = int m * snd (bezw n (m mod n)) - (int (m mod n) + int (n * (m div n))) * snd (bezw n (m mod n))"
  24.499 +    by (simp add: distrib_right)
  24.500 +  also have "\<dots> = 0"
  24.501 +    by (metis cancel_comm_monoid_add_class.diff_cancel mod_mult_div_eq of_nat_add)
  24.502 +  finally show ?case
  24.503 +    by simp
  24.504 +qed auto
  24.505 +
  24.506  
  24.507  lemma bezout_int: "\<exists>u v. u * x + v * y = gcd x y"
  24.508    for x y :: int
  24.509 @@ -2204,13 +2200,9 @@
  24.510    have aux: "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> \<exists>u v. u * x + v * y = gcd x y" for x y :: int
  24.511      apply (rule_tac x = "fst (bezw (nat x) (nat y))" in exI)
  24.512      apply (rule_tac x = "snd (bezw (nat x) (nat y))" in exI)
  24.513 -    apply (unfold gcd_int_def)
  24.514 -    apply simp
  24.515 -    apply (subst bezw_aux [symmetric])
  24.516 -    apply auto
  24.517 -    done
  24.518 +    by (simp add: bezw_aux gcd_int_def)
  24.519    consider "x \<ge> 0" "y \<ge> 0" | "x \<ge> 0" "y \<le> 0" | "x \<le> 0" "y \<ge> 0" | "x \<le> 0" "y \<le> 0"
  24.520 -    by atomize_elim auto
  24.521 +    using linear by blast
  24.522    then show ?thesis
  24.523    proof cases
  24.524      case 1
  24.525 @@ -2218,48 +2210,29 @@
  24.526    next
  24.527      case 2
  24.528      then show ?thesis
  24.529 -      apply -
  24.530 -      apply (insert aux [of x "-y"])
  24.531 -      apply auto
  24.532 -      apply (rule_tac x = u in exI)
  24.533 -      apply (rule_tac x = "-v" in exI)
  24.534 -      apply (subst gcd_neg2_int [symmetric])
  24.535 -      apply auto
  24.536 -      done
  24.537 +      using aux [of x "-y"]
  24.538 +      by (metis gcd_neg2_int mult.commute mult_minus_right neg_0_le_iff_le)
  24.539    next
  24.540      case 3
  24.541      then show ?thesis
  24.542 -      apply -
  24.543 -      apply (insert aux [of "-x" y])
  24.544 -      apply auto
  24.545 -      apply (rule_tac x = "-u" in exI)
  24.546 -      apply (rule_tac x = v in exI)
  24.547 -      apply (subst gcd_neg1_int [symmetric])
  24.548 -      apply auto
  24.549 -      done
  24.550 +      using aux [of "-x" y]
  24.551 +      by (metis gcd.commute gcd_neg2_int mult.commute mult_minus_right neg_0_le_iff_le)
  24.552    next
  24.553      case 4
  24.554      then show ?thesis
  24.555 -      apply -
  24.556 -      apply (insert aux [of "-x" "-y"])
  24.557 -      apply auto
  24.558 -      apply (rule_tac x = "-u" in exI)
  24.559 -      apply (rule_tac x = "-v" in exI)
  24.560 -      apply (subst gcd_neg1_int [symmetric])
  24.561 -      apply (subst gcd_neg2_int [symmetric])
  24.562 -      apply auto
  24.563 -      done
  24.564 +      using aux [of "-x" "-y"]
  24.565 +      by (metis diff_0 diff_ge_0_iff_ge gcd_neg1_int gcd_neg2_int mult.commute mult_minus_right)
  24.566    qed
  24.567  qed
  24.568  
  24.569  
  24.570  text \<open>Versions of Bezout for \<open>nat\<close>, by Amine Chaieb.\<close>
  24.571  
  24.572 -lemma ind_euclid:
  24.573 +lemma Euclid_induct [case_names swap zero add]:
  24.574    fixes P :: "nat \<Rightarrow> nat \<Rightarrow> bool"
  24.575 -  assumes c: " \<forall>a b. P a b \<longleftrightarrow> P b a"
  24.576 -    and z: "\<forall>a. P a 0"
  24.577 -    and add: "\<forall>a b. P a b \<longrightarrow> P a (a + b)"
  24.578 +  assumes c: "\<And>a b. P a b \<longleftrightarrow> P b a"
  24.579 +    and z: "\<And>a. P a 0"
  24.580 +    and add: "\<And>a b. P a b \<longrightarrow> P a (a + b)"
  24.581    shows "P a b"
  24.582  proof (induct "a + b" arbitrary: a b rule: less_induct)
  24.583    case less
  24.584 @@ -2302,53 +2275,32 @@
  24.585  qed
  24.586  
  24.587  lemma bezout_lemma_nat:
  24.588 -  assumes ex: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and>
  24.589 -    (a * x = b * y + d \<or> b * x = a * y + d)"
  24.590 -  shows "\<exists>d x y. d dvd a \<and> d dvd a + b \<and>
  24.591 -    (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
  24.592 -  using ex
  24.593 -  apply clarsimp
  24.594 -  apply (rule_tac x="d" in exI)
  24.595 -  apply simp
  24.596 -  apply (case_tac "a * x = b * y + d")
  24.597 -   apply simp_all
  24.598 -   apply (rule_tac x="x + y" in exI)
  24.599 -   apply (rule_tac x="y" in exI)
  24.600 -   apply algebra
  24.601 -  apply (rule_tac x="x" in exI)
  24.602 -  apply (rule_tac x="x + y" in exI)
  24.603 -  apply algebra
  24.604 -  done
  24.605 -
  24.606 -lemma bezout_add_nat: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and>
  24.607 -    (a * x = b * y + d \<or> b * x = a * y + d)"
  24.608 -  apply (induct a b rule: ind_euclid)
  24.609 -    apply blast
  24.610 -   apply clarify
  24.611 -   apply (rule_tac x="a" in exI)
  24.612 -   apply simp
  24.613 -  apply clarsimp
  24.614 -  apply (rule_tac x="d" in exI)
  24.615 -  apply (case_tac "a * x = b * y + d")
  24.616 -   apply simp_all
  24.617 -   apply (rule_tac x="x+y" in exI)
  24.618 -   apply (rule_tac x="y" in exI)
  24.619 -   apply algebra
  24.620 -  apply (rule_tac x="x" in exI)
  24.621 -  apply (rule_tac x="x+y" in exI)
  24.622 -  apply algebra
  24.623 -  done
  24.624 -
  24.625 -lemma bezout1_nat: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and>
  24.626 -    (a * x - b * y = d \<or> b * x - a * y = d)"
  24.627 -  using bezout_add_nat[of a b]
  24.628 -  apply clarsimp
  24.629 -  apply (rule_tac x="d" in exI)
  24.630 -  apply simp
  24.631 -  apply (rule_tac x="x" in exI)
  24.632 -  apply (rule_tac x="y" in exI)
  24.633 +  fixes d::nat
  24.634 +  shows "\<lbrakk>d dvd a; d dvd b; a * x = b * y + d \<or> b * x = a * y + d\<rbrakk>
  24.635 +    \<Longrightarrow> \<exists>x y. d dvd a \<and> d dvd a + b \<and> (a * x = (a + b) * y + d \<or> (a + b) * x = a * y + d)"
  24.636    apply auto
  24.637 -  done
  24.638 +  apply (metis add_mult_distrib2 left_add_mult_distrib)
  24.639 +  apply (rule_tac x=x in exI)
  24.640 +  by (metis add_mult_distrib2 mult.commute add.assoc)
  24.641 +
  24.642 +lemma bezout_add_nat: 
  24.643 +  "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x = b * y + d \<or> b * x = a * y + d)"
  24.644 +proof (induct a b rule: Euclid_induct)
  24.645 +  case (swap a b)
  24.646 +  then show ?case
  24.647 +    by blast
  24.648 +next
  24.649 +  case (zero a)
  24.650 +  then show ?case
  24.651 +    by fastforce    
  24.652 +next
  24.653 +  case (add a b)
  24.654 +  then show ?case
  24.655 +    by (meson bezout_lemma_nat)
  24.656 +qed
  24.657 +
  24.658 +lemma bezout1_nat: "\<exists>(d::nat) x y. d dvd a \<and> d dvd b \<and> (a * x - b * y = d \<or> b * x - a * y = d)"
  24.659 +  using bezout_add_nat[of a b]  by (metis add_diff_cancel_left')
  24.660  
  24.661  lemma bezout_add_strong_nat:
  24.662    fixes a b :: nat
  24.663 @@ -2356,7 +2308,7 @@
  24.664    shows "\<exists>d x y. d dvd a \<and> d dvd b \<and> a * x = b * y + d"
  24.665  proof -
  24.666    consider d x y where "d dvd a" "d dvd b" "a * x = b * y + d"
  24.667 -    | d x y where "d dvd a" "d dvd b" "b * x = a * y + d"
  24.668 +         | d x y where "d dvd a" "d dvd b" "b * x = a * y + d"
  24.669      using bezout_add_nat [of a b] by blast
  24.670    then show ?thesis
  24.671    proof cases
  24.672 @@ -2377,13 +2329,7 @@
  24.673        proof cases
  24.674          case 1
  24.675          with a H show ?thesis
  24.676 -          apply simp
  24.677 -          apply (rule exI[where x = b])
  24.678 -          apply simp
  24.679 -          apply (rule exI[where x = b])
  24.680 -          apply (rule exI[where x = "a - 1"])
  24.681 -          apply (simp add: diff_mult_distrib2)
  24.682 -          done
  24.683 +          by (metis Suc_pred add.commute mult.commute mult_Suc_right neq0_conv)
  24.684        next
  24.685          case 2
  24.686          show ?thesis
  24.687 @@ -2410,13 +2356,7 @@
  24.688            then have "a * ((b - 1) * y) = b * (x * (b - 1) - d) + d"
  24.689              by (simp only: diff_mult_distrib2 ac_simps)
  24.690            with H(1,2) show ?thesis
  24.691 -            apply -
  24.692 -            apply (rule exI [where x = d])
  24.693 -            apply simp
  24.694 -            apply (rule exI [where x = "(b - 1) * y"])
  24.695 -            apply (rule exI [where x = "x * (b - 1) - d"])
  24.696 -            apply simp
  24.697 -            done
  24.698 +            by blast
  24.699          qed
  24.700        qed
  24.701      qed
  24.702 @@ -2451,17 +2391,11 @@
  24.703    
  24.704  lemma prod_gcd_lcm_nat: "m * n = gcd m n * lcm m n"
  24.705    for m n :: nat
  24.706 -  unfolding lcm_nat_def
  24.707 -  by (simp add: dvd_mult_div_cancel [OF gcd_dvd_prod])
  24.708 +  by simp
  24.709  
  24.710  lemma prod_gcd_lcm_int: "\<bar>m\<bar> * \<bar>n\<bar> = gcd m n * lcm m n"
  24.711    for m n :: int
  24.712 -  unfolding lcm_int_def gcd_int_def
  24.713 -  apply (subst of_nat_mult [symmetric])
  24.714 -  apply (subst prod_gcd_lcm_nat [symmetric])
  24.715 -  apply (subst nat_abs_mult_distrib [symmetric])
  24.716 -  apply (simp add: abs_mult)
  24.717 -  done
  24.718 +  by simp
  24.719  
  24.720  lemma lcm_pos_nat: "m > 0 \<Longrightarrow> n > 0 \<Longrightarrow> lcm m n > 0"
  24.721    for m n :: nat
  24.722 @@ -2473,7 +2407,7 @@
  24.723  
  24.724  lemma dvd_pos_nat: "n > 0 \<Longrightarrow> m dvd n \<Longrightarrow> m > 0"  (* FIXME move *)
  24.725    for m n :: nat
  24.726 -  by (cases m) auto
  24.727 +  by auto
  24.728  
  24.729  lemma lcm_unique_nat:
  24.730    "a dvd d \<and> b dvd d \<and> (\<forall>e. a dvd e \<and> b dvd e \<longrightarrow> d dvd e) \<longleftrightarrow> d = lcm a b"
  24.731 @@ -2487,17 +2421,11 @@
  24.732  
  24.733  lemma lcm_proj2_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> lcm x y = y"
  24.734    for x y :: nat
  24.735 -  apply (rule sym)
  24.736 -  apply (subst lcm_unique_nat [symmetric])
  24.737 -  apply auto
  24.738 -  done
  24.739 +  by (simp add: lcm_proj2_if_dvd)
  24.740  
  24.741  lemma lcm_proj2_if_dvd_int [simp]: "x dvd y \<Longrightarrow> lcm x y = \<bar>y\<bar>"
  24.742    for x y :: int
  24.743 -  apply (rule sym)
  24.744 -  apply (subst lcm_unique_int [symmetric])
  24.745 -  apply auto
  24.746 -  done
  24.747 +  by (simp add: lcm_proj2_if_dvd)
  24.748  
  24.749  lemma lcm_proj1_if_dvd_nat [simp]: "x dvd y \<Longrightarrow> lcm y x = y"
  24.750    for x y :: nat
  24.751 @@ -2551,7 +2479,7 @@
  24.752    by (simp add: Lcm_nat_def del: One_nat_def)
  24.753  
  24.754  lemma Lcm_nat_insert: "Lcm (insert n M) = lcm n (Lcm M)" for n :: nat
  24.755 -  by (cases "finite M") (auto simp add: Lcm_nat_def simp del: One_nat_def)
  24.756 +  by (cases "finite M") (auto simp: Lcm_nat_def simp del: One_nat_def)
  24.757  
  24.758  lemma Lcm_nat_infinite: "infinite M \<Longrightarrow> Lcm M = 0" for M :: "nat set"
  24.759    by (simp add: Lcm_nat_def)
  24.760 @@ -2595,9 +2523,9 @@
  24.761    fix N :: "nat set"
  24.762    fix n :: nat
  24.763    show "Gcd N dvd n" if "n \<in> N"
  24.764 -    using that by (induct N rule: infinite_finite_induct) (auto simp add: Gcd_nat_def)
  24.765 +    using that by (induct N rule: infinite_finite_induct) (auto simp: Gcd_nat_def)
  24.766    show "n dvd Gcd N" if "\<And>m. m \<in> N \<Longrightarrow> n dvd m"
  24.767 -    using that by (induct N rule: infinite_finite_induct) (auto simp add: Gcd_nat_def)
  24.768 +    using that by (induct N rule: infinite_finite_induct) (auto simp: Gcd_nat_def)
  24.769    show "n dvd Lcm N" if "n \<in> N"
  24.770      using that by (induct N rule: infinite_finite_induct) auto
  24.771    show "Lcm N dvd n" if "\<And>m. m \<in> N \<Longrightarrow> m dvd n"
  24.772 @@ -2629,52 +2557,51 @@
  24.773    from fin show "Gcd M \<le> Max (\<Inter>m\<in>M. {d. d dvd m})"
  24.774      by (auto intro: Max_ge Gcd_dvd)
  24.775    from fin show "Max (\<Inter>m\<in>M. {d. d dvd m}) \<le> Gcd M"
  24.776 -    apply (rule Max.boundedI)
  24.777 -     apply auto
  24.778 -    apply (meson Gcd_dvd Gcd_greatest \<open>0 < m\<close> \<open>m \<in> M\<close> dvd_imp_le dvd_pos_nat)
  24.779 -    done
  24.780 +  proof (rule Max.boundedI, simp_all)
  24.781 +    show "(\<Inter>m\<in>M. {d. d dvd m}) \<noteq> {}"
  24.782 +      by auto
  24.783 +    show "\<And>a. \<forall>x\<in>M. a dvd x \<Longrightarrow> a \<le> Gcd M"
  24.784 +      by (meson Gcd_dvd Gcd_greatest \<open>0 < m\<close> \<open>m \<in> M\<close> dvd_imp_le dvd_pos_nat)
  24.785 +  qed
  24.786  qed
  24.787  
  24.788  lemma Gcd_remove0_nat: "finite M \<Longrightarrow> Gcd M = Gcd (M - {0})"
  24.789    for M :: "nat set"
  24.790 -  apply (induct pred: finite)
  24.791 -   apply simp
  24.792 -  apply (case_tac "x = 0")
  24.793 -   apply simp
  24.794 -  apply (subgoal_tac "insert x F - {0} = insert x (F - {0})")
  24.795 -   apply simp
  24.796 -  apply blast
  24.797 -  done
  24.798 +proof (induct pred: finite)
  24.799 +  case (insert x M)
  24.800 +  then show ?case
  24.801 +    by (simp add: insert_Diff_if)
  24.802 +qed auto
  24.803  
  24.804  lemma Lcm_in_lcm_closed_set_nat:
  24.805 -  "finite M \<Longrightarrow> M \<noteq> {} \<Longrightarrow> \<forall>m n. m \<in> M \<longrightarrow> n \<in> M \<longrightarrow> lcm m n \<in> M \<Longrightarrow> Lcm M \<in> M"
  24.806 -  for M :: "nat set"
  24.807 -  apply (induct rule: finite_linorder_min_induct)
  24.808 -   apply simp
  24.809 -  apply simp
  24.810 -  apply (subgoal_tac "\<forall>m n. m \<in> A \<longrightarrow> n \<in> A \<longrightarrow> lcm m n \<in> A")
  24.811 -   apply simp
  24.812 -   apply(case_tac "A = {}")
  24.813 -    apply simp
  24.814 -   apply simp
  24.815 -  apply (metis lcm_pos_nat lcm_unique_nat linorder_neq_iff nat_dvd_not_less not_less0)
  24.816 -  done
  24.817 +  fixes M :: "nat set" 
  24.818 +  assumes "finite M" "M \<noteq> {}" "\<And>m n. \<lbrakk>m \<in> M; n \<in> M\<rbrakk> \<Longrightarrow> lcm m n \<in> M"
  24.819 +  shows "Lcm M \<in> M"
  24.820 +  using assms
  24.821 +proof (induction M rule: finite_linorder_min_induct)
  24.822 +  case (insert x M)
  24.823 +  then have "\<And>m n. m \<in> M \<Longrightarrow> n \<in> M \<Longrightarrow> lcm m n \<in> M"
  24.824 +    by (metis dvd_lcm1 gr0I insert_iff lcm_pos_nat nat_dvd_not_less)
  24.825 +  with insert show ?case
  24.826 +    by simp (metis Lcm_nat_empty One_nat_def dvd_1_left dvd_lcm2)
  24.827 +qed auto
  24.828  
  24.829  lemma Lcm_eq_Max_nat:
  24.830 -  "finite M \<Longrightarrow> M \<noteq> {} \<Longrightarrow> 0 \<notin> M \<Longrightarrow> \<forall>m n. m \<in> M \<longrightarrow> n \<in> M \<longrightarrow> lcm m n \<in> M \<Longrightarrow> Lcm M = Max M"
  24.831 -  for M :: "nat set"
  24.832 -  apply (rule antisym)
  24.833 -   apply (rule Max_ge)
  24.834 -    apply assumption
  24.835 -   apply (erule (2) Lcm_in_lcm_closed_set_nat)
  24.836 -  apply (auto simp add: not_le Lcm_0_iff dvd_imp_le leD le_neq_trans)
  24.837 -  done
  24.838 +  fixes M :: "nat set" 
  24.839 +  assumes M: "finite M" "M \<noteq> {}" "0 \<notin> M" and lcm: "\<And>m n. \<lbrakk>m \<in> M; n \<in> M\<rbrakk> \<Longrightarrow> lcm m n \<in> M"
  24.840 +  shows "Lcm M = Max M"
  24.841 +proof (rule antisym)
  24.842 +  show "Lcm M \<le> Max M"
  24.843 +    by (simp add: Lcm_in_lcm_closed_set_nat \<open>finite M\<close> \<open>M \<noteq> {}\<close> lcm)
  24.844 +  show "Max M \<le> Lcm M"
  24.845 +    by (meson Lcm_0_iff Max_in M dvd_Lcm dvd_imp_le le_0_eq not_le)
  24.846 +qed
  24.847  
  24.848  lemma mult_inj_if_coprime_nat:
  24.849 -  "inj_on f A \<Longrightarrow> inj_on g B \<Longrightarrow> \<forall>a\<in>A. \<forall>b\<in>B. coprime (f a) (g b) \<Longrightarrow>
  24.850 +  "inj_on f A \<Longrightarrow> inj_on g B \<Longrightarrow> (\<And>a b. \<lbrakk>a\<in>A; b\<in>B\<rbrakk> \<Longrightarrow> coprime (f a) (g b)) \<Longrightarrow>
  24.851      inj_on (\<lambda>(a, b). f a * g b) (A \<times> B)"
  24.852    for f :: "'a \<Rightarrow> nat" and g :: "'b \<Rightarrow> nat"
  24.853 -  by (auto simp add: inj_on_def coprime_crossproduct_nat simp del: One_nat_def)
  24.854 +  by (auto simp: inj_on_def coprime_crossproduct_nat simp del: One_nat_def)
  24.855  
  24.856  
  24.857  subsubsection \<open>Setwise GCD and LCM for integers\<close>
    25.1 --- a/src/HOL/Int.thy	Tue Aug 07 11:39:40 2018 +0200
    25.2 +++ b/src/HOL/Int.thy	Sat Aug 11 16:02:55 2018 +0200
    25.3 @@ -892,6 +892,9 @@
    25.4    apply (rule of_int_minus [symmetric])
    25.5    done
    25.6  
    25.7 +lemma minus_in_Ints_iff: "-x \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
    25.8 +  using Ints_minus[of x] Ints_minus[of "-x"] by auto
    25.9 +
   25.10  lemma Ints_diff [simp]: "a \<in> \<int> \<Longrightarrow> b \<in> \<int> \<Longrightarrow> a - b \<in> \<int>"
   25.11    apply (auto simp add: Ints_def)
   25.12    apply (rule range_eqI)
    26.1 --- a/src/HOL/Library/FuncSet.thy	Tue Aug 07 11:39:40 2018 +0200
    26.2 +++ b/src/HOL/Library/FuncSet.thy	Sat Aug 11 16:02:55 2018 +0200
    26.3 @@ -163,8 +163,6 @@
    26.4  
    26.5  lemma compose_assoc:
    26.6    assumes "f \<in> A \<rightarrow> B"
    26.7 -    and "g \<in> B \<rightarrow> C"
    26.8 -    and "h \<in> C \<rightarrow> D"
    26.9    shows "compose A h (compose A g f) = compose A (compose B h g) f"
   26.10    using assms by (simp add: fun_eq_iff Pi_def compose_def restrict_def)
   26.11  
    27.1 --- a/src/HOL/Library/datatype_records.ML	Tue Aug 07 11:39:40 2018 +0200
    27.2 +++ b/src/HOL/Library/datatype_records.ML	Sat Aug 11 16:02:55 2018 +0200
    27.3 @@ -7,10 +7,10 @@
    27.4  
    27.5    val mk_update_defs: string -> local_theory -> local_theory
    27.6  
    27.7 -  val bnf_record: binding -> ctr_options -> (binding option * (typ * sort)) list ->
    27.8 +  val record: binding -> ctr_options -> (binding option * (typ * sort)) list ->
    27.9      (binding * typ) list -> local_theory -> local_theory
   27.10  
   27.11 -  val bnf_record_cmd: binding -> ctr_options_cmd ->
   27.12 +  val record_cmd: binding -> ctr_options_cmd ->
   27.13      (binding option * (string * string option)) list -> (binding * string) list -> local_theory ->
   27.14      local_theory
   27.15  
   27.16 @@ -35,21 +35,31 @@
   27.17    val extend = I
   27.18  )
   27.19  
   27.20 +fun mk_eq_dummy (lhs, rhs) =
   27.21 +  Const (@{const_name HOL.eq}, dummyT --> dummyT --> @{typ bool}) $ lhs $ rhs
   27.22 +
   27.23 +val dummify = map_types (K dummyT)
   27.24 +fun repeat_split_tac ctxt thm = REPEAT_ALL_NEW (CHANGED o Splitter.split_tac ctxt [thm])
   27.25 +
   27.26  fun mk_update_defs typ_name lthy =
   27.27    let
   27.28      val short_name = Long_Name.base_name typ_name
   27.29 +    val {ctrs, casex, selss, split, sel_thmss, injects, ...} =
   27.30 +      the (Ctr_Sugar.ctr_sugar_of lthy typ_name)
   27.31 +    val ctr = case ctrs of [ctr] => ctr | _ => error "Datatype_Records.mk_update_defs: expected only single constructor"
   27.32 +    val sels = case selss of [sels] => sels | _ => error "Datatype_Records.mk_update_defs: expected selectors"
   27.33 +    val sels_dummy = map dummify sels
   27.34 +    val ctr_dummy = dummify ctr
   27.35 +    val casex_dummy = dummify casex
   27.36 +    val len = length sels
   27.37  
   27.38 -    val {ctrs, casex, selss, ...} = the (Ctr_Sugar.ctr_sugar_of lthy typ_name)
   27.39 -    val ctr = case ctrs of [ctr] => ctr | _ => error "BNF_Record.mk_update_defs: expected only single constructor"
   27.40 -    val sels = case selss of [sels] => sels | _ => error "BNF_Record.mk_update_defs: expected selectors"
   27.41 -    val ctr_dummy = Const (fst (dest_Const ctr), dummyT)
   27.42 -    val casex_dummy = Const (fst (dest_Const casex), dummyT)
   27.43 -
   27.44 -    val len = length sels
   27.45 +    val simp_thms = flat sel_thmss @ injects
   27.46  
   27.47      fun mk_name sel =
   27.48        Binding.name ("update_" ^ Long_Name.base_name (fst (dest_Const sel)))
   27.49  
   27.50 +    val thms_binding = (@{binding record_simps}, @{attributes [simp]})
   27.51 +
   27.52      fun mk_t idx =
   27.53        let
   27.54          val body =
   27.55 @@ -59,22 +69,143 @@
   27.56          Abs ("f", dummyT, casex_dummy $ body)
   27.57        end
   27.58  
   27.59 +    fun simp_only_tac ctxt =
   27.60 +      REPEAT_ALL_NEW (resolve_tac ctxt @{thms impI allI}) THEN'
   27.61 +        asm_full_simp_tac (put_simpset HOL_basic_ss ctxt addsimps simp_thms)
   27.62 +
   27.63 +    fun prove ctxt defs ts n =
   27.64 +      let
   27.65 +        val t = nth ts n
   27.66 +
   27.67 +        val sel_dummy = nth sels_dummy n
   27.68 +        val t_dummy = dummify t
   27.69 +        fun tac {context = ctxt, ...} =
   27.70 +          Goal.conjunction_tac 1 THEN
   27.71 +            Local_Defs.unfold_tac ctxt defs THEN
   27.72 +            PARALLEL_ALLGOALS (repeat_split_tac ctxt split THEN' simp_only_tac ctxt)
   27.73 +
   27.74 +        val sel_upd_same_thm =
   27.75 +          let
   27.76 +            val ([f, x], ctxt') = Variable.add_fixes ["f", "x"] ctxt
   27.77 +            val f = Free (f, dummyT)
   27.78 +            val x = Free (x, dummyT)
   27.79 +
   27.80 +            val lhs = sel_dummy $ (t_dummy $ f $ x)
   27.81 +            val rhs = f $ (sel_dummy $ x)
   27.82 +            val prop = Syntax.check_term ctxt' (HOLogic.mk_Trueprop (mk_eq_dummy (lhs, rhs)))
   27.83 +          in
   27.84 +            [Goal.prove_future ctxt' [] [] prop tac]
   27.85 +            |> Variable.export ctxt' ctxt
   27.86 +          end
   27.87 +
   27.88 +        val sel_upd_diff_thms =
   27.89 +          let
   27.90 +            val ([f, x], ctxt') = Variable.add_fixes ["f", "x"] ctxt
   27.91 +            val f = Free (f, dummyT)
   27.92 +            val x = Free (x, dummyT)
   27.93 +
   27.94 +            fun lhs sel = sel $ (t_dummy $ f $ x)
   27.95 +            fun rhs sel = sel $ x
   27.96 +            fun eq sel = (lhs sel, rhs sel)
   27.97 +            fun is_n i = i = n
   27.98 +            val props =
   27.99 +              sels_dummy ~~ (0 upto len - 1)
  27.100 +              |> filter_out (is_n o snd)
  27.101 +              |> map (HOLogic.mk_Trueprop o mk_eq_dummy o eq o fst)
  27.102 +              |> Syntax.check_terms ctxt'
  27.103 +          in
  27.104 +            if length props > 0 then
  27.105 +              Goal.prove_common ctxt' (SOME ~1) [] [] props tac
  27.106 +              |> Variable.export ctxt' ctxt
  27.107 +            else
  27.108 +              []
  27.109 +          end
  27.110 +
  27.111 +        val upd_comp_thm =
  27.112 +          let
  27.113 +            val ([f, g, x], ctxt') = Variable.add_fixes ["f", "g", "x"] ctxt
  27.114 +            val f = Free (f, dummyT)
  27.115 +            val g = Free (g, dummyT)
  27.116 +            val x = Free (x, dummyT)
  27.117 +
  27.118 +            val lhs = t_dummy $ f $ (t_dummy $ g $ x)
  27.119 +            val rhs = t_dummy $ Abs ("a", dummyT, f $ (g $ Bound 0)) $ x
  27.120 +            val prop = Syntax.check_term ctxt' (HOLogic.mk_Trueprop (mk_eq_dummy (lhs, rhs)))
  27.121 +          in
  27.122 +            [Goal.prove_future ctxt' [] [] prop tac]
  27.123 +            |> Variable.export ctxt' ctxt
  27.124 +          end
  27.125 +
  27.126 +        val upd_comm_thms =
  27.127 +          let
  27.128 +            fun prop i ctxt =
  27.129 +              let
  27.130 +                val ([f, g, x], ctxt') = Variable.variant_fixes ["f", "g", "x"] ctxt
  27.131 +                val self = t_dummy $ Free (f, dummyT)
  27.132 +                val other = dummify (nth ts i) $ Free (g, dummyT)
  27.133 +                val lhs = other $ (self $ Free (x, dummyT))
  27.134 +                val rhs = self $ (other $ Free (x, dummyT))
  27.135 +              in
  27.136 +                (HOLogic.mk_Trueprop (mk_eq_dummy (lhs, rhs)), ctxt')
  27.137 +              end
  27.138 +            val (props, ctxt') = fold_map prop (0 upto n - 1) ctxt
  27.139 +            val props = Syntax.check_terms ctxt' props
  27.140 +          in
  27.141 +            if length props > 0 then
  27.142 +              Goal.prove_common ctxt' (SOME ~1) [] [] props tac
  27.143 +              |> Variable.export ctxt' ctxt
  27.144 +            else
  27.145 +              []
  27.146 +          end
  27.147 +
  27.148 +        val upd_sel_thm =
  27.149 +          let
  27.150 +            val ([x], ctxt') = Variable.add_fixes ["x"] ctxt
  27.151 +
  27.152 +            val lhs = t_dummy $ Abs("_", dummyT, (sel_dummy $ Free(x, dummyT))) $ Free (x, dummyT)
  27.153 +            val rhs = Free (x, dummyT)
  27.154 +            val prop = Syntax.check_term ctxt (HOLogic.mk_Trueprop (mk_eq_dummy (lhs, rhs)))
  27.155 +          in
  27.156 +            [Goal.prove_future ctxt [] [] prop tac]
  27.157 +            |> Variable.export ctxt' ctxt
  27.158 +          end
  27.159 +      in
  27.160 +        sel_upd_same_thm @ sel_upd_diff_thms @ upd_comp_thm @ upd_comm_thms @ upd_sel_thm
  27.161 +      end
  27.162 +
  27.163      fun define name t =
  27.164 -      Local_Theory.define ((name, NoSyn), ((Binding.empty, @{attributes [datatype_record_update, code]}), t)) #> snd
  27.165 +      Local_Theory.define ((name, NoSyn), ((Binding.empty, @{attributes [datatype_record_update, code]}),t))
  27.166 +      #> apfst (apsnd snd)
  27.167  
  27.168 -    val lthy' =
  27.169 -      Local_Theory.map_background_naming (Name_Space.qualified_path false (Binding.name short_name)) lthy
  27.170 +    val (updates, (lthy'', lthy')) =
  27.171 +      lthy
  27.172 +      |> Local_Theory.open_target
  27.173 +      |> snd
  27.174 +      |> Local_Theory.map_background_naming (Name_Space.qualified_path false (Binding.name short_name))
  27.175 +      |> @{fold_map 2} define (map mk_name sels) (Syntax.check_terms lthy (map mk_t (0 upto len - 1)))
  27.176 +      ||> `Local_Theory.close_target
  27.177 +
  27.178 +    val phi = Proof_Context.export_morphism lthy' lthy''
  27.179 +
  27.180 +    val (update_ts, update_defs) =
  27.181 +      split_list updates
  27.182 +      |>> map (Morphism.term phi)
  27.183 +      ||> map (Morphism.thm phi)
  27.184 +
  27.185 +    val thms = flat (map (prove lthy'' update_defs update_ts) (0 upto len-1))
  27.186  
  27.187      fun insert sel =
  27.188        Symtab.insert op = (fst (dest_Const sel), Local_Theory.full_name lthy' (mk_name sel))
  27.189    in
  27.190 -    lthy'
  27.191 -    |> @{fold 2} define (map mk_name sels) (Syntax.check_terms lthy (map mk_t (0 upto len - 1)))
  27.192 +    lthy''
  27.193 +    |> Local_Theory.map_background_naming (Name_Space.mandatory_path short_name)
  27.194 +    |> Local_Theory.note (thms_binding, thms)
  27.195 +    |> snd
  27.196 +    |> Local_Theory.restore_background_naming lthy
  27.197      |> Local_Theory.background_theory (Data.map (fold insert sels))
  27.198 -    |> Local_Theory.restore_background_naming lthy
  27.199    end
  27.200  
  27.201 -fun bnf_record binding opts tyargs args lthy =
  27.202 +fun record binding opts tyargs args lthy =
  27.203    let
  27.204      val constructor =
  27.205        (((Binding.empty, Binding.map_name (fn c => "make_" ^ c) binding), args), NoSyn)
  27.206 @@ -93,8 +224,8 @@
  27.207      lthy'
  27.208    end
  27.209  
  27.210 -fun bnf_record_cmd binding opts tyargs args lthy =
  27.211 -  bnf_record binding (opts lthy)
  27.212 +fun record_cmd binding opts tyargs args lthy =
  27.213 +  record binding (opts lthy)
  27.214      (map (apsnd (apfst (Syntax.parse_typ lthy) o apsnd (Typedecl.read_constraint lthy))) tyargs)
  27.215      (map (apsnd (Syntax.parse_typ lthy)) args) lthy
  27.216  
  27.217 @@ -172,7 +303,7 @@
  27.218      @{command_keyword datatype_record}
  27.219      "Defines a record based on the BNF/datatype machinery"
  27.220      (parser >> (fn (((ctr_options, tyargs), binding), args) =>
  27.221 -      bnf_record_cmd binding ctr_options tyargs args))
  27.222 +      record_cmd binding ctr_options tyargs args))
  27.223  
  27.224  val setup =
  27.225     (Sign.parse_translation
    28.1 --- a/src/HOL/Limits.thy	Tue Aug 07 11:39:40 2018 +0200
    28.2 +++ b/src/HOL/Limits.thy	Sat Aug 11 16:02:55 2018 +0200
    28.3 @@ -1316,6 +1316,16 @@
    28.4      and filterlim_compose[OF filterlim_uminus_at_top_at_bot, of "\<lambda>x. - f x" F]
    28.5    by auto
    28.6  
    28.7 +lemma tendsto_at_botI_sequentially:
    28.8 +  fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
    28.9 +  assumes *: "\<And>X. filterlim X at_bot sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
   28.10 +  shows "(f \<longlongrightarrow> y) at_bot"
   28.11 +  unfolding filterlim_at_bot_mirror
   28.12 +proof (rule tendsto_at_topI_sequentially)
   28.13 +  fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   28.14 +  thus "(\<lambda>n. f (-X n)) \<longlonglongrightarrow> y" by (intro *) (auto simp: filterlim_uminus_at_top)
   28.15 +qed
   28.16 +
   28.17  lemma filterlim_at_infinity_imp_filterlim_at_top:
   28.18    assumes "filterlim (f :: 'a \<Rightarrow> real) at_infinity F"
   28.19    assumes "eventually (\<lambda>x. f x > 0) F"
    29.1 --- a/src/HOL/List.thy	Tue Aug 07 11:39:40 2018 +0200
    29.2 +++ b/src/HOL/List.thy	Sat Aug 11 16:02:55 2018 +0200
    29.3 @@ -1,5 +1,5 @@
    29.4  (*  Title:      HOL/List.thy
    29.5 -    Author:     Tobias Nipkow
    29.6 +    Author:     Tobias Nipkow; proofs tidied by LCP
    29.7  *)
    29.8  
    29.9  section \<open>The datatype of finite lists\<close>
   29.10 @@ -166,7 +166,7 @@
   29.11  
   29.12  primrec upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where
   29.13  upt_0: "[i..<0] = []" |
   29.14 -upt_Suc: "[i..<(Suc j)] = (if i <= j then [i..<j] @ [j] else [])"
   29.15 +upt_Suc: "[i..<(Suc j)] = (if i \<le> j then [i..<j] @ [j] else [])"
   29.16  
   29.17  definition insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
   29.18  "insert x xs = (if x \<in> set xs then xs else x # xs)"
   29.19 @@ -834,11 +834,9 @@
   29.20  
   29.21  lemma Suc_length_conv:
   29.22    "(Suc n = length xs) = (\<exists>y ys. xs = y # ys \<and> length ys = n)"
   29.23 -apply (induct xs, simp, simp)
   29.24 -apply blast
   29.25 -done
   29.26 -
   29.27 -lemma impossible_Cons: "length xs <= length ys ==> xs = x # ys = False"
   29.28 +  by (induct xs; simp; blast)
   29.29 +
   29.30 +lemma impossible_Cons: "length xs \<le> length ys ==> xs = x # ys = False"
   29.31  by (induct xs) auto
   29.32  
   29.33  lemma list_induct2 [consumes 1, case_names Nil Cons]:
   29.34 @@ -846,10 +844,8 @@
   29.35     (\<And>x xs y ys. length xs = length ys \<Longrightarrow> P xs ys \<Longrightarrow> P (x#xs) (y#ys))
   29.36     \<Longrightarrow> P xs ys"
   29.37  proof (induct xs arbitrary: ys)
   29.38 -  case Nil then show ?case by simp
   29.39 -next
   29.40    case (Cons x xs ys) then show ?case by (cases ys) simp_all
   29.41 -qed
   29.42 +qed simp
   29.43  
   29.44  lemma list_induct3 [consumes 2, case_names Nil Cons]:
   29.45    "length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> P [] [] [] \<Longrightarrow>
   29.46 @@ -960,19 +956,15 @@
   29.47  lemma append_eq_append_conv [simp]:
   29.48    "length xs = length ys \<or> length us = length vs
   29.49    ==> (xs@us = ys@vs) = (xs=ys \<and> us=vs)"
   29.50 -apply (induct xs arbitrary: ys)
   29.51 - apply (case_tac ys, simp, force)
   29.52 -apply (case_tac ys, force, simp)
   29.53 -done
   29.54 +  by (induct xs arbitrary: ys; case_tac ys; force)
   29.55  
   29.56  lemma append_eq_append_conv2: "(xs @ ys = zs @ ts) =
   29.57    (\<exists>us. xs = zs @ us \<and> us @ ys = ts \<or> xs @ us = zs \<and> ys = us @ ts)"
   29.58 -apply (induct xs arbitrary: ys zs ts)
   29.59 - apply fastforce
   29.60 -apply(case_tac zs)
   29.61 - apply simp
   29.62 -apply fastforce
   29.63 -done
   29.64 +proof (induct xs arbitrary: ys zs ts)
   29.65 +  case (Cons x xs)
   29.66 +  then show ?case
   29.67 +    by (case_tac zs) auto
   29.68 +qed fastforce
   29.69  
   29.70  lemma same_append_eq [iff, induct_simp]: "(xs @ ys = xs @ zs) = (ys = zs)"
   29.71  by simp
   29.72 @@ -1152,15 +1144,14 @@
   29.73  qed
   29.74  
   29.75  lemma map_inj_on:
   29.76 - "[| map f xs = map f ys; inj_on f (set xs Un set ys) |]
   29.77 -  ==> xs = ys"
   29.78 -apply(frule map_eq_imp_length_eq)
   29.79 -apply(rotate_tac -1)
   29.80 -apply(induct rule:list_induct2)
   29.81 - apply simp
   29.82 -apply(simp)
   29.83 -apply (blast intro:sym)
   29.84 -done
   29.85 +  assumes map: "map f xs = map f ys" and inj: "inj_on f (set xs Un set ys)"
   29.86 +  shows "xs = ys"
   29.87 +  using map_eq_imp_length_eq [OF map] assms
   29.88 +proof (induct rule: list_induct2)
   29.89 +  case (Cons x xs y ys)
   29.90 +  then show ?case
   29.91 +    by (auto intro: sym)
   29.92 +qed auto
   29.93  
   29.94  lemma inj_on_map_eq_map:
   29.95    "inj_on f (set xs Un set ys) \<Longrightarrow> (map f xs = map f ys) = (xs = ys)"
   29.96 @@ -1177,21 +1168,13 @@
   29.97  by (iprover dest: map_injective injD intro: inj_onI)
   29.98  
   29.99  lemma inj_mapD: "inj (map f) ==> inj f"
  29.100 -  apply (unfold inj_def)
  29.101 -  apply clarify
  29.102 -  apply (erule_tac x = "[x]" in allE)
  29.103 -  apply (erule_tac x = "[y]" in allE)
  29.104 -  apply auto
  29.105 -  done
  29.106 +  by (metis (no_types, hide_lams) injI list.inject list.simps(9) the_inv_f_f)
  29.107  
  29.108  lemma inj_map[iff]: "inj (map f) = inj f"
  29.109  by (blast dest: inj_mapD intro: inj_mapI)
  29.110  
  29.111  lemma inj_on_mapI: "inj_on f (\<Union>(set ` A)) \<Longrightarrow> inj_on (map f) A"
  29.112 -apply(rule inj_onI)
  29.113 -apply(erule map_inj_on)
  29.114 -apply(blast intro:inj_onI dest:inj_onD)
  29.115 -done
  29.116 +  by (blast intro:inj_onI dest:inj_onD map_inj_on)
  29.117  
  29.118  lemma map_idI: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = x) \<Longrightarrow> map f xs = xs"
  29.119  by (induct xs, auto)
  29.120 @@ -1248,9 +1231,11 @@
  29.121  by (cases xs) auto
  29.122  
  29.123  lemma rev_is_rev_conv [iff]: "(rev xs = rev ys) = (xs = ys)"
  29.124 -apply (induct xs arbitrary: ys, force)
  29.125 -apply (case_tac ys, simp, force)
  29.126 -done
  29.127 +proof  (induct xs arbitrary: ys)
  29.128 +  case (Cons a xs)
  29.129 +  then show ?case 
  29.130 +    by (case_tac ys) auto
  29.131 +qed force
  29.132  
  29.133  lemma inj_on_rev[iff]: "inj_on rev A"
  29.134  by(simp add:inj_on_def)
  29.135 @@ -1481,11 +1466,12 @@
  29.136  by (induct xs) simp_all
  29.137  
  29.138  lemma filter_id_conv: "(filter P xs = xs) = (\<forall>x\<in>set xs. P x)"
  29.139 -apply (induct xs)
  29.140 - apply auto
  29.141 -apply(cut_tac P=P and xs=xs in length_filter_le)
  29.142 -apply simp
  29.143 -done
  29.144 +proof (induct xs)
  29.145 +  case (Cons x xs)
  29.146 +  then show ?case
  29.147 +    using length_filter_le
  29.148 +    by (simp add: impossible_Cons)
  29.149 +qed auto
  29.150  
  29.151  lemma filter_map: "filter P (map f xs) = map f (filter (P \<circ> f) xs)"
  29.152  by (induct xs) simp_all
  29.153 @@ -1503,9 +1489,7 @@
  29.154    case Nil thus ?case by simp
  29.155  next
  29.156    case (Cons x xs) thus ?case
  29.157 -    apply (auto split:if_split_asm)
  29.158 -    using length_filter_le[of P xs] apply arith
  29.159 -  done
  29.160 +    using Suc_le_eq by fastforce
  29.161  qed
  29.162  
  29.163  lemma length_filter_conv_card:
  29.164 @@ -1573,17 +1557,17 @@
  29.165  lemma filter_eq_ConsD:
  29.166    "filter P ys = x#xs \<Longrightarrow>
  29.167    \<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs"
  29.168 -by(rule Cons_eq_filterD) simp
  29.169 +  by(rule Cons_eq_filterD) simp
  29.170  
  29.171  lemma filter_eq_Cons_iff:
  29.172    "(filter P ys = x#xs) =
  29.173    (\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)"
  29.174 -by(auto dest:filter_eq_ConsD)
  29.175 +  by(auto dest:filter_eq_ConsD)
  29.176  
  29.177  lemma Cons_eq_filter_iff:
  29.178    "(x#xs = filter P ys) =
  29.179    (\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)"
  29.180 -by(auto dest:Cons_eq_filterD)
  29.181 +  by(auto dest:Cons_eq_filterD)
  29.182  
  29.183  lemma inj_on_filter_key_eq:
  29.184    assumes "inj_on f (insert y (set xs))"
  29.185 @@ -1592,24 +1576,22 @@
  29.186  
  29.187  lemma filter_cong[fundef_cong]:
  29.188    "xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x) \<Longrightarrow> filter P xs = filter Q ys"
  29.189 -apply simp
  29.190 -apply(erule thin_rl)
  29.191 -by (induct ys) simp_all
  29.192 +  by (induct ys arbitrary: xs) auto
  29.193  
  29.194  
  29.195  subsubsection \<open>List partitioning\<close>
  29.196  
  29.197  primrec partition :: "('a \<Rightarrow> bool) \<Rightarrow>'a list \<Rightarrow> 'a list \<times> 'a list" where
  29.198 -"partition P [] = ([], [])" |
  29.199 -"partition P (x # xs) =
  29.200 +  "partition P [] = ([], [])" |
  29.201 +  "partition P (x # xs) =
  29.202    (let (yes, no) = partition P xs
  29.203     in if P x then (x # yes, no) else (yes, x # no))"
  29.204  
  29.205  lemma partition_filter1: "fst (partition P xs) = filter P xs"
  29.206 -by (induct xs) (auto simp add: Let_def split_def)
  29.207 +  by (induct xs) (auto simp add: Let_def split_def)
  29.208  
  29.209  lemma partition_filter2: "snd (partition P xs) = filter (Not \<circ> P) xs"
  29.210 -by (induct xs) (auto simp add: Let_def split_def)
  29.211 +  by (induct xs) (auto simp add: Let_def split_def)
  29.212  
  29.213  lemma partition_P:
  29.214    assumes "partition P xs = (yes, no)"
  29.215 @@ -1631,8 +1613,8 @@
  29.216  
  29.217  lemma partition_filter_conv[simp]:
  29.218    "partition f xs = (filter f xs,filter (Not \<circ> f) xs)"
  29.219 -unfolding partition_filter2[symmetric]
  29.220 -unfolding partition_filter1[symmetric] by simp
  29.221 +  unfolding partition_filter2[symmetric]
  29.222 +  unfolding partition_filter1[symmetric] by simp
  29.223  
  29.224  declare partition.simps[simp del]
  29.225  
  29.226 @@ -1640,28 +1622,28 @@
  29.227  subsubsection \<open>@{const concat}\<close>
  29.228  
  29.229  lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys"
  29.230 -by (induct xs) auto
  29.231 +  by (induct xs) auto
  29.232  
  29.233  lemma concat_eq_Nil_conv [simp]: "(concat xss = []) = (\<forall>xs \<in> set xss. xs = [])"
  29.234 -by (induct xss) auto
  29.235 +  by (induct xss) auto
  29.236  
  29.237  lemma Nil_eq_concat_conv [simp]: "([] = concat xss) = (\<forall>xs \<in> set xss. xs = [])"
  29.238 -by (induct xss) auto
  29.239 +  by (induct xss) auto
  29.240  
  29.241  lemma set_concat [simp]: "set (concat xs) = (UN x:set xs. set x)"
  29.242 -by (induct xs) auto
  29.243 +  by (induct xs) auto
  29.244  
  29.245  lemma concat_map_singleton[simp]: "concat(map (%x. [f x]) xs) = map f xs"
  29.246 -by (induct xs) auto
  29.247 +  by (induct xs) auto
  29.248  
  29.249  lemma map_concat: "map f (concat xs) = concat (map (map f) xs)"
  29.250 -by (induct xs) auto
  29.251 +  by (induct xs) auto
  29.252  
  29.253  lemma filter_concat: "filter p (concat xs) = concat (map (filter p) xs)"
  29.254 -by (induct xs) auto
  29.255 +  by (induct xs) auto
  29.256  
  29.257  lemma rev_concat: "rev (concat xs) = concat (map rev (rev xs))"
  29.258 -by (induct xs) auto
  29.259 +  by (induct xs) auto
  29.260  
  29.261  lemma concat_eq_concat_iff: "\<forall>(x, y) \<in> set (zip xs ys). length x = length y ==> length xs = length ys ==> (concat xs = concat ys) = (xs = ys)"
  29.262  proof (induct xs arbitrary: ys)
  29.263 @@ -1670,66 +1652,78 @@
  29.264  qed (auto)
  29.265  
  29.266  lemma concat_injective: "concat xs = concat ys ==> length xs = length ys ==> \<forall>(x, y) \<in> set (zip xs ys). length x = length y ==> xs = ys"
  29.267 -by (simp add: concat_eq_concat_iff)
  29.268 +  by (simp add: concat_eq_concat_iff)
  29.269  
  29.270  
  29.271  subsubsection \<open>@{const nth}\<close>
  29.272  
  29.273  lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x"
  29.274 -by auto
  29.275 +  by auto
  29.276  
  29.277  lemma nth_Cons_Suc [simp, code]: "(x # xs)!(Suc n) = xs!n"
  29.278 -by auto
  29.279 +  by auto
  29.280  
  29.281  declare nth.simps [simp del]
  29.282  
  29.283  lemma nth_Cons_pos[simp]: "0 < n \<Longrightarrow> (x#xs) ! n = xs ! (n - 1)"
  29.284 -by(auto simp: Nat.gr0_conv_Suc)
  29.285 +  by(auto simp: Nat.gr0_conv_Suc)
  29.286  
  29.287  lemma nth_append:
  29.288    "(xs @ ys)!n = (if n < length xs then xs!n else ys!(n - length xs))"
  29.289 -apply (induct xs arbitrary: n, simp)
  29.290 -apply (case_tac n, auto)
  29.291 -done
  29.292 +proof (induct xs arbitrary: n)
  29.293 +  case (Cons x xs)
  29.294 +  then show ?case
  29.295 +    using less_Suc_eq_0_disj by auto
  29.296 +qed simp
  29.297  
  29.298  lemma nth_append_length [simp]: "(xs @ x # ys) ! length xs = x"
  29.299 -by (induct xs) auto
  29.300 +  by (induct xs) auto
  29.301  
  29.302  lemma nth_append_length_plus[simp]: "(xs @ ys) ! (length xs + n) = ys ! n"
  29.303 -by (induct xs) auto
  29.304 +  by (induct xs) auto
  29.305  
  29.306  lemma nth_map [simp]: "n < length xs ==> (map f xs)!n = f(xs!n)"
  29.307 -apply (induct xs arbitrary: n, simp)
  29.308 -apply (case_tac n, auto)
  29.309 -done
  29.310 +proof (induct xs arbitrary: n)
  29.311 +  case (Cons x xs)
  29.312 +  then show ?case
  29.313 +    using less_Suc_eq_0_disj by auto
  29.314 +qed simp
  29.315  
  29.316  lemma nth_tl: "n < length (tl xs) \<Longrightarrow> tl xs ! n = xs ! Suc n"
  29.317 -by (induction xs) auto
  29.318 +  by (induction xs) auto
  29.319  
  29.320  lemma hd_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd xs = xs!0"
  29.321 -by(cases xs) simp_all
  29.322 +  by(cases xs) simp_all
  29.323  
  29.324  
  29.325  lemma list_eq_iff_nth_eq:
  29.326    "(xs = ys) = (length xs = length ys \<and> (\<forall>i<length xs. xs!i = ys!i))"
  29.327 -apply(induct xs arbitrary: ys)
  29.328 - apply force
  29.329 -apply(case_tac ys)
  29.330 - apply simp
  29.331 -apply(simp add:nth_Cons split:nat.split)apply blast
  29.332 -done
  29.333 +proof (induct xs arbitrary: ys)
  29.334 +  case (Cons x xs ys)
  29.335 +  show ?case 
  29.336 +  proof (cases ys)
  29.337 +    case (Cons y ys)
  29.338 +    then show ?thesis
  29.339 +      using Cons.hyps by fastforce
  29.340 +  qed simp
  29.341 +qed force
  29.342  
  29.343  lemma set_conv_nth: "set xs = {xs!i | i. i < length xs}"
  29.344 -apply (induct xs, simp, simp)
  29.345 -apply safe
  29.346 -apply (metis nat.case(1) nth.simps zero_less_Suc)
  29.347 -apply (metis less_Suc_eq_0_disj nth_Cons_Suc)
  29.348 -apply (case_tac i, simp)
  29.349 -apply (metis diff_Suc_Suc nat.case(2) nth.simps zero_less_diff)
  29.350 -done
  29.351 +proof (induct xs)
  29.352 +  case (Cons x xs)
  29.353 +  have "insert x {xs ! i |i. i < length xs} = {(x # xs) ! i |i. i < Suc (length xs)}" (is "?L=?R")
  29.354 +  proof
  29.355 +    show "?L \<subseteq> ?R"
  29.356 +      by force
  29.357 +    show "?R \<subseteq> ?L"
  29.358 +      using less_Suc_eq_0_disj by auto
  29.359 +  qed
  29.360 +  with Cons show ?case
  29.361 +    by simp
  29.362 +qed simp
  29.363  
  29.364  lemma in_set_conv_nth: "(x \<in> set xs) = (\<exists>i < length xs. xs!i = x)"
  29.365 -by(auto simp:set_conv_nth)
  29.366 +  by(auto simp:set_conv_nth)
  29.367  
  29.368  lemma nth_equal_first_eq:
  29.369    assumes "x \<notin> set xs"
  29.370 @@ -1761,18 +1755,18 @@
  29.371  qed
  29.372  
  29.373  lemma list_ball_nth: "\<lbrakk>n < length xs; \<forall>x \<in> set xs. P x\<rbrakk> \<Longrightarrow> P(xs!n)"
  29.374 -by (auto simp add: set_conv_nth)
  29.375 +  by (auto simp add: set_conv_nth)
  29.376  
  29.377  lemma nth_mem [simp]: "n < length xs \<Longrightarrow> xs!n \<in> set xs"
  29.378 -by (auto simp add: set_conv_nth)
  29.379 +  by (auto simp add: set_conv_nth)
  29.380  
  29.381  lemma all_nth_imp_all_set:
  29.382    "\<lbrakk>\<forall>i < length xs. P(xs!i); x \<in> set xs\<rbrakk> \<Longrightarrow> P x"
  29.383 -by (auto simp add: set_conv_nth)
  29.384 +  by (auto simp add: set_conv_nth)
  29.385  
  29.386  lemma all_set_conv_all_nth:
  29.387    "(\<forall>x \<in> set xs. P x) = (\<forall>i. i < length xs \<longrightarrow> P (xs ! i))"
  29.388 -by (auto simp add: set_conv_nth)
  29.389 +  by (auto simp add: set_conv_nth)
  29.390  
  29.391  lemma rev_nth:
  29.392    "n < size xs \<Longrightarrow> rev xs ! n = xs ! (length xs - Suc n)"
  29.393 @@ -1816,149 +1810,141 @@
  29.394  subsubsection \<open>@{const list_update}\<close>
  29.395  
  29.396  lemma length_list_update [simp]: "length(xs[i:=x]) = length xs"
  29.397 -by (induct xs arbitrary: i) (auto split: nat.split)
  29.398 +  by (induct xs arbitrary: i) (auto split: nat.split)
  29.399  
  29.400  lemma nth_list_update:
  29.401 -"i < length xs==> (xs[i:=x])!j = (if i = j then x else xs!j)"
  29.402 -by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split)
  29.403 +  "i < length xs==> (xs[i:=x])!j = (if i = j then x else xs!j)"
  29.404 +  by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split)
  29.405  
  29.406  lemma nth_list_update_eq [simp]: "i < length xs ==> (xs[i:=x])!i = x"
  29.407 -by (simp add: nth_list_update)
  29.408 +  by (simp add: nth_list_update)
  29.409  
  29.410  lemma nth_list_update_neq [simp]: "i \<noteq> j ==> xs[i:=x]!j = xs!j"
  29.411 -by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split)
  29.412 +  by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split)
  29.413  
  29.414  lemma list_update_id[simp]: "xs[i := xs!i] = xs"
  29.415 -by (induct xs arbitrary: i) (simp_all split:nat.splits)
  29.416 +  by (induct xs arbitrary: i) (simp_all split:nat.splits)
  29.417  
  29.418  lemma list_update_beyond[simp]: "length xs \<le> i \<Longrightarrow> xs[i:=x] = xs"
  29.419 -apply (induct xs arbitrary: i)
  29.420 - apply simp
  29.421 -apply (case_tac i)
  29.422 -apply simp_all
  29.423 -done
  29.424 +proof (induct xs arbitrary: i)
  29.425 +  case (Cons x xs i)
  29.426 +  then show ?case
  29.427 +    by (metis leD length_list_update list_eq_iff_nth_eq nth_list_update_neq)
  29.428 +qed simp
  29.429  
  29.430  lemma list_update_nonempty[simp]: "xs[k:=x] = [] \<longleftrightarrow> xs=[]"
  29.431 -by (simp only: length_0_conv[symmetric] length_list_update)
  29.432 +  by (simp only: length_0_conv[symmetric] length_list_update)
  29.433  
  29.434  lemma list_update_same_conv:
  29.435    "i < length xs ==> (xs[i := x] = xs) = (xs!i = x)"
  29.436 -by (induct xs arbitrary: i) (auto split: nat.split)
  29.437 +  by (induct xs arbitrary: i) (auto split: nat.split)
  29.438  
  29.439  lemma list_update_append1:
  29.440    "i < size xs \<Longrightarrow> (xs @ ys)[i:=x] = xs[i:=x] @ ys"
  29.441 -by (induct xs arbitrary: i)(auto split:nat.split)
  29.442 +  by (induct xs arbitrary: i)(auto split:nat.split)
  29.443  
  29.444  lemma list_update_append:
  29.445    "(xs @ ys) [n:= x] =
  29.446    (if n < length xs then xs[n:= x] @ ys else xs @ (ys [n-length xs:= x]))"
  29.447 -by (induct xs arbitrary: n) (auto split:nat.splits)
  29.448 +  by (induct xs arbitrary: n) (auto split:nat.splits)
  29.449  
  29.450  lemma list_update_length [simp]:
  29.451    "(xs @ x # ys)[length xs := y] = (xs @ y # ys)"
  29.452 -by (induct xs, auto)
  29.453 +  by (induct xs, auto)
  29.454  
  29.455  lemma map_update: "map f (xs[k:= y]) = (map f xs)[k := f y]"
  29.456 -by(induct xs arbitrary: k)(auto split:nat.splits)
  29.457 +  by(induct xs arbitrary: k)(auto split:nat.splits)
  29.458  
  29.459  lemma rev_update:
  29.460    "k < length xs \<Longrightarrow> rev (xs[k:= y]) = (rev xs)[length xs - k - 1 := y]"
  29.461 -by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits)
  29.462 +  by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits)
  29.463  
  29.464  lemma update_zip:
  29.465    "(zip xs ys)[i:=xy] = zip (xs[i:=fst xy]) (ys[i:=snd xy])"
  29.466 -by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split)
  29.467 -
  29.468 -lemma set_update_subset_insert: "set(xs[i:=x]) <= insert x (set xs)"
  29.469 -by (induct xs arbitrary: i) (auto split: nat.split)
  29.470 +  by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split)
  29.471 +
  29.472 +lemma set_update_subset_insert: "set(xs[i:=x]) \<le> insert x (set xs)"
  29.473 +  by (induct xs arbitrary: i) (auto split: nat.split)
  29.474  
  29.475  lemma set_update_subsetI: "\<lbrakk>set xs \<subseteq> A; x \<in> A\<rbrakk> \<Longrightarrow> set(xs[i := x]) \<subseteq> A"
  29.476 -by (blast dest!: set_update_subset_insert [THEN subsetD])
  29.477 +  by (blast dest!: set_update_subset_insert [THEN subsetD])
  29.478  
  29.479  lemma set_update_memI: "n < length xs \<Longrightarrow> x \<in> set (xs[n := x])"
  29.480 -by (induct xs arbitrary: n) (auto split:nat.splits)
  29.481 +  by (induct xs arbitrary: n) (auto split:nat.splits)
  29.482  
  29.483  lemma list_update_overwrite[simp]:
  29.484    "xs [i := x, i := y] = xs [i := y]"
  29.485 -apply (induct xs arbitrary: i) apply simp
  29.486 -apply (case_tac i, simp_all)
  29.487 -done
  29.488 +  by (induct xs arbitrary: i) (simp_all split: nat.split)
  29.489  
  29.490  lemma list_update_swap:
  29.491    "i \<noteq> i' \<Longrightarrow> xs [i := x, i' := x'] = xs [i' := x', i := x]"
  29.492 -apply (induct xs arbitrary: i i')
  29.493 - apply simp
  29.494 -apply (case_tac i, case_tac i')
  29.495 -  apply auto
  29.496 -apply (case_tac i')
  29.497 -apply auto
  29.498 -done
  29.499 +  by (induct xs arbitrary: i i') (simp_all split: nat.split)
  29.500  
  29.501  lemma list_update_code [code]:
  29.502    "[][i := y] = []"
  29.503    "(x # xs)[0 := y] = y # xs"
  29.504    "(x # xs)[Suc i := y] = x # xs[i := y]"
  29.505 -by simp_all
  29.506 +  by simp_all
  29.507  
  29.508  
  29.509  subsubsection \<open>@{const last} and @{const butlast}\<close>
  29.510  
  29.511  lemma last_snoc [simp]: "last (xs @ [x]) = x"
  29.512 -by (induct xs) auto
  29.513 +  by (induct xs) auto
  29.514  
  29.515  lemma butlast_snoc [simp]: "butlast (xs @ [x]) = xs"
  29.516 -by (induct xs) auto
  29.517 +  by (induct xs) auto
  29.518  
  29.519  lemma last_ConsL: "xs = [] \<Longrightarrow> last(x#xs) = x"
  29.520 -by simp
  29.521 +  by simp
  29.522  
  29.523  lemma last_ConsR: "xs \<noteq> [] \<Longrightarrow> last(x#xs) = last xs"
  29.524 -by simp
  29.525 +  by simp
  29.526  
  29.527  lemma last_append: "last(xs @ ys) = (if ys = [] then last xs else last ys)"
  29.528 -by (induct xs) (auto)
  29.529 +  by (induct xs) (auto)
  29.530  
  29.531  lemma last_appendL[simp]: "ys = [] \<Longrightarrow> last(xs @ ys) = last xs"
  29.532 -by(simp add:last_append)
  29.533 +  by(simp add:last_append)
  29.534  
  29.535  lemma last_appendR[simp]: "ys \<noteq> [] \<Longrightarrow> last(xs @ ys) = last ys"
  29.536 -by(simp add:last_append)
  29.537 +  by(simp add:last_append)
  29.538  
  29.539  lemma last_tl: "xs = [] \<or> tl xs \<noteq> [] \<Longrightarrow>last (tl xs) = last xs"
  29.540 -by (induct xs) simp_all
  29.541 +  by (induct xs) simp_all
  29.542  
  29.543  lemma butlast_tl: "butlast (tl xs) = tl (butlast xs)"
  29.544 -by (induct xs) simp_all
  29.545 +  by (induct xs) simp_all
  29.546  
  29.547  lemma hd_rev: "xs \<noteq> [] \<Longrightarrow> hd(rev xs) = last xs"
  29.548 -by(rule rev_exhaust[of xs]) simp_all
  29.549 +  by(rule rev_exhaust[of xs]) simp_all
  29.550  
  29.551  lemma last_rev: "xs \<noteq> [] \<Longrightarrow> last(rev xs) = hd xs"
  29.552 -by(cases xs) simp_all
  29.553 +  by(cases xs) simp_all
  29.554  
  29.555  lemma last_in_set[simp]: "as \<noteq> [] \<Longrightarrow> last as \<in> set as"
  29.556 -by (induct as) auto
  29.557 +  by (induct as) auto
  29.558  
  29.559  lemma length_butlast [simp]: "length (butlast xs) = length xs - 1"
  29.560 -by (induct xs rule: rev_induct) auto
  29.561 +  by (induct xs rule: rev_induct) auto
  29.562  
  29.563  lemma butlast_append:
  29.564    "butlast (xs @ ys) = (if ys = [] then butlast xs else xs @ butlast ys)"
  29.565 -by (induct xs arbitrary: ys) auto
  29.566 +  by (induct xs arbitrary: ys) auto
  29.567  
  29.568  lemma append_butlast_last_id [simp]:
  29.569    "xs \<noteq> [] \<Longrightarrow> butlast xs @ [last xs] = xs"
  29.570 -by (induct xs) auto
  29.571 +  by (induct xs) auto
  29.572  
  29.573  lemma in_set_butlastD: "x \<in> set (butlast xs) \<Longrightarrow> x \<in> set xs"
  29.574 -by (induct xs) (auto split: if_split_asm)
  29.575 +  by (induct xs) (auto split: if_split_asm)
  29.576  
  29.577  lemma in_set_butlast_appendI:
  29.578    "x \<in> set (butlast xs) \<or> x \<in> set (butlast ys) \<Longrightarrow> x \<in> set (butlast (xs @ ys))"
  29.579 -by (auto dest: in_set_butlastD simp add: butlast_append)
  29.580 +  by (auto dest: in_set_butlastD simp add: butlast_append)
  29.581  
  29.582  lemma last_drop[simp]: "n < length xs \<Longrightarrow> last (drop n xs) = last xs"
  29.583 -by (induct xs arbitrary: n)(auto split:nat.split)
  29.584 +  by (induct xs arbitrary: n)(auto split:nat.split)
  29.585  
  29.586  lemma nth_butlast:
  29.587    assumes "n < length (butlast xs)" shows "butlast xs ! n = xs ! n"
  29.588 @@ -1970,164 +1956,173 @@
  29.589  qed simp
  29.590  
  29.591  lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - 1)"
  29.592 -by(induct xs)(auto simp:neq_Nil_conv)
  29.593 +  by(induct xs)(auto simp:neq_Nil_conv)
  29.594  
  29.595  lemma butlast_conv_take: "butlast xs = take (length xs - 1) xs"
  29.596 -by (induction xs rule: induct_list012) simp_all
  29.597 +  by (induction xs rule: induct_list012) simp_all
  29.598  
  29.599  lemma last_list_update:
  29.600    "xs \<noteq> [] \<Longrightarrow> last(xs[k:=x]) = (if k = size xs - 1 then x else last xs)"
  29.601 -by (auto simp: last_conv_nth)
  29.602 +  by (auto simp: last_conv_nth)
  29.603  
  29.604  lemma butlast_list_update:
  29.605    "butlast(xs[k:=x]) =
  29.606    (if k = size xs - 1 then butlast xs else (butlast xs)[k:=x])"
  29.607 -by(cases xs rule:rev_cases)(auto simp: list_update_append split: nat.splits)
  29.608 +  by(cases xs rule:rev_cases)(auto simp: list_update_append split: nat.splits)
  29.609  
  29.610  lemma last_map: "xs \<noteq> [] \<Longrightarrow> last (map f xs) = f (last xs)"
  29.611 -by (cases xs rule: rev_cases) simp_all
  29.612 +  by (cases xs rule: rev_cases) simp_all
  29.613  
  29.614  lemma map_butlast: "map f (butlast xs) = butlast (map f xs)"
  29.615 -by (induct xs) simp_all
  29.616 +  by (induct xs) simp_all
  29.617  
  29.618  lemma snoc_eq_iff_butlast:
  29.619    "xs @ [x] = ys \<longleftrightarrow> (ys \<noteq> [] \<and> butlast ys = xs \<and> last ys = x)"
  29.620 -by fastforce
  29.621 +  by fastforce
  29.622  
  29.623  corollary longest_common_suffix:
  29.624    "\<exists>ss xs' ys'. xs = xs' @ ss \<and> ys = ys' @ ss
  29.625         \<and> (xs' = [] \<or> ys' = [] \<or> last xs' \<noteq> last ys')"
  29.626 -using longest_common_prefix[of "rev xs" "rev ys"]
  29.627 -unfolding rev_swap rev_append by (metis last_rev rev_is_Nil_conv)
  29.628 +  using longest_common_prefix[of "rev xs" "rev ys"]
  29.629 +  unfolding rev_swap rev_append by (metis last_rev rev_is_Nil_conv)
  29.630  
  29.631  
  29.632  subsubsection \<open>@{const take} and @{const drop}\<close>
  29.633  
  29.634  lemma take_0: "take 0 xs = []"
  29.635 -by (induct xs) auto
  29.636 +  by (induct xs) auto
  29.637  
  29.638  lemma drop_0: "drop 0 xs = xs"
  29.639 -by (induct xs) auto
  29.640 +  by (induct xs) auto
  29.641  
  29.642  lemma take0[simp]: "take 0 = (\<lambda>xs. [])"
  29.643 -by(rule ext) (rule take_0)
  29.644 +  by(rule ext) (rule take_0)
  29.645  
  29.646  lemma drop0[simp]: "drop 0 = (\<lambda>x. x)"
  29.647 -by(rule ext) (rule drop_0)
  29.648 +  by(rule ext) (rule drop_0)
  29.649  
  29.650  lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs"
  29.651 -by simp
  29.652 +  by simp
  29.653  
  29.654  lemma drop_Suc_Cons [simp]: "drop (Suc n) (x # xs) = drop n xs"
  29.655 -by simp
  29.656 +  by simp
  29.657  
  29.658  declare take_Cons [simp del] and drop_Cons [simp del]
  29.659  
  29.660  lemma take_Suc: "xs \<noteq> [] \<Longrightarrow> take (Suc n) xs = hd xs # take n (tl xs)"
  29.661 -by(clarsimp simp add:neq_Nil_conv)
  29.662 +  by(clarsimp simp add:neq_Nil_conv)
  29.663  
  29.664  lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)"
  29.665 -by(cases xs, simp_all)
  29.666 +  by(cases xs, simp_all)
  29.667  
  29.668  lemma hd_take[simp]: "j > 0 \<Longrightarrow> hd (take j xs) = hd xs"
  29.669 -by (metis gr0_conv_Suc list.sel(1) take.simps(1) take_Suc)
  29.670 +  by (metis gr0_conv_Suc list.sel(1) take.simps(1) take_Suc)
  29.671  
  29.672  lemma take_tl: "take n (tl xs) = tl (take (Suc n) xs)"
  29.673 -by (induct xs arbitrary: n) simp_all
  29.674 +  by (induct xs arbitrary: n) simp_all
  29.675  
  29.676  lemma drop_tl: "drop n (tl xs) = tl(drop n xs)"
  29.677 -by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split)
  29.678 +  by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split)
  29.679  
  29.680  lemma tl_take: "tl (take n xs) = take (n - 1) (tl xs)"
  29.681 -by (cases n, simp, cases xs, auto)
  29.682 +  by (cases n, simp, cases xs, auto)
  29.683  
  29.684  lemma tl_drop: "tl (drop n xs) = drop n (tl xs)"
  29.685 -by (simp only: drop_tl)
  29.686 +  by (simp only: drop_tl)
  29.687  
  29.688  lemma nth_via_drop: "drop n xs = y#ys \<Longrightarrow> xs!n = y"
  29.689 -by (induct xs arbitrary: n, simp)(auto simp: drop_Cons nth_Cons split: nat.splits)
  29.690 +  by (induct xs arbitrary: n, simp)(auto simp: drop_Cons nth_Cons split: nat.splits)
  29.691  
  29.692  lemma take_Suc_conv_app_nth:
  29.693    "i < length xs \<Longrightarrow> take (Suc i) xs = take i xs @ [xs!i]"
  29.694 -apply (induct xs arbitrary: i, simp)
  29.695 -apply (case_tac i, auto)
  29.696 -done
  29.697 +proof (induct xs arbitrary: i)
  29.698 +  case (Cons x xs) then show ?case
  29.699 +    by (case_tac i, auto)
  29.700 +qed simp
  29.701  
  29.702  lemma Cons_nth_drop_Suc:
  29.703    "i < length xs \<Longrightarrow> (xs!i) # (drop (Suc i) xs) = drop i xs"
  29.704 -apply (induct xs arbitrary: i, simp)
  29.705 -apply (case_tac i, auto)
  29.706 -done
  29.707 +proof (induct xs arbitrary: i)
  29.708 +  case (Cons x xs) then show ?case
  29.709 +    by (case_tac i, auto)
  29.710 +qed simp
  29.711  
  29.712  lemma length_take [simp]: "length (take n xs) = min (length xs) n"
  29.713 -by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.714 +  by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.715  
  29.716  lemma length_drop [simp]: "length (drop n xs) = (length xs - n)"
  29.717 -by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.718 -
  29.719 -lemma take_all [simp]: "length xs <= n ==> take n xs = xs"
  29.720 -by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.721 -
  29.722 -lemma drop_all [simp]: "length xs <= n ==> drop n xs = []"
  29.723 -by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.724 +  by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.725 +
  29.726 +lemma take_all [simp]: "length xs \<le> n ==> take n xs = xs"
  29.727 +  by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.728 +
  29.729 +lemma drop_all [simp]: "length xs \<le> n ==> drop n xs = []"
  29.730 +  by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.731  
  29.732  lemma take_append [simp]:
  29.733    "take n (xs @ ys) = (take n xs @ take (n - length xs) ys)"
  29.734 -by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.735 +  by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.736  
  29.737  lemma drop_append [simp]:
  29.738    "drop n (xs @ ys) = drop n xs @ drop (n - length xs) ys"
  29.739 -by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.740 +  by (induct n arbitrary: xs) (auto, case_tac xs, auto)
  29.741  
  29.742  lemma take_take [simp]: "take n (take m xs) = take (min n m) xs"
  29.743 -apply (induct m arbitrary: xs n, auto)
  29.744 - apply (case_tac xs, auto)
  29.745 -apply (case_tac n, auto)
  29.746 -done
  29.747 +proof (induct m arbitrary: xs n)
  29.748 +  case (Suc m) then show ?case
  29.749 +    by (case_tac xs; case_tac n; simp)
  29.750 +qed auto
  29.751  
  29.752  lemma drop_drop [simp]: "drop n (drop m xs) = drop (n + m) xs"
  29.753 -apply (induct m arbitrary: xs, auto)
  29.754 - apply (case_tac xs, auto)
  29.755 -done
  29.756 +proof (induct m arbitrary: xs)
  29.757 +  case (Suc m) then show ?case
  29.758 +    by (case_tac xs; simp)
  29.759 +qed auto
  29.760  
  29.761  lemma take_drop: "take n (drop m xs) = drop m (take (n + m) xs)"
  29.762 -apply (induct m arbitrary: xs n, auto)
  29.763 - apply (case_tac xs, auto)
  29.764 -done
  29.765 +proof (induct m arbitrary: xs n)
  29.766 +  case (Suc m) then show ?case
  29.767 +    by (case_tac xs; case_tac n; simp)
  29.768 +qed auto
  29.769  
  29.770  lemma drop_take: "drop n (take m xs) = take (m-n) (drop n xs)"
  29.771 -by(induct xs arbitrary: m n)(auto simp: take_Cons drop_Cons split: nat.split)
  29.772 +  by(induct xs arbitrary: m n)(auto simp: take_Cons drop_Cons split: nat.split)
  29.773  
  29.774  lemma append_take_drop_id [simp]: "take n xs @ drop n xs = xs"
  29.775 -apply (induct n arbitrary: xs, auto)
  29.776 -apply (case_tac xs, auto)
  29.777 -done
  29.778 +proof (induct n arbitrary: xs)
  29.779 +  case (Suc n) then show ?case
  29.780 +    by (case_tac xs; simp)
  29.781 +qed auto
  29.782  
  29.783  lemma take_eq_Nil[simp]: "(take n xs = []) = (n = 0 \<or> xs = [])"
  29.784 -by(induct xs arbitrary: n)(auto simp: take_Cons split:nat.split)
  29.785 -
  29.786 -lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs <= n)"
  29.787 -by (induct xs arbitrary: n) (auto simp: drop_Cons split:nat.split)
  29.788 +  by(induct xs arbitrary: n)(auto simp: take_Cons split:nat.split)
  29.789 +
  29.790 +lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs \<le> n)"
  29.791 +  by (induct xs arbitrary: n) (auto simp: drop_Cons split:nat.split)
  29.792  
  29.793  lemma take_map: "take n (map f xs) = map f (take n xs)"
  29.794 -apply (induct n arbitrary: xs, auto)
  29.795 - apply (case_tac xs, auto)
  29.796 -done
  29.797 +proof (induct n arbitrary: xs)
  29.798 +  case (Suc n) then show ?case
  29.799 +    by (case_tac xs; simp)
  29.800 +qed auto
  29.801  
  29.802  lemma drop_map: "drop n (map f xs) = map f (drop n xs)"
  29.803 -apply (induct n arbitrary: xs, auto)
  29.804 - apply (case_tac xs, auto)
  29.805 -done
  29.806 +proof (induct n arbitrary: xs)
  29.807 +  case (Suc n) then show ?case
  29.808 +    by (case_tac xs; simp)
  29.809 +qed auto
  29.810  
  29.811  lemma rev_take: "rev (take i xs) = drop (length xs - i) (rev xs)"
  29.812 -apply (induct xs arbitrary: i, auto)
  29.813 - apply (case_tac i, auto)
  29.814 -done
  29.815 +proof (induct xs arbitrary: i)
  29.816 +  case (Cons x xs) then show ?case
  29.817 +    by (case_tac i, auto)
  29.818 +qed simp
  29.819  
  29.820  lemma rev_drop: "rev (drop i xs) = take (length xs - i) (rev xs)"
  29.821 -apply (induct xs arbitrary: i, auto)
  29.822 - apply (case_tac i, auto)
  29.823 -done
  29.824 +proof (induct xs arbitrary: i)
  29.825 +  case (Cons x xs) then show ?case
  29.826 +    by (case_tac i, auto)
  29.827 +qed simp
  29.828  
  29.829  lemma drop_rev: "drop n (rev xs) = rev (take (length xs - n) xs)"
  29.830    by (cases "length xs < n") (auto simp: rev_take)
  29.831 @@ -2136,87 +2131,87 @@
  29.832    by (cases "length xs < n") (auto simp: rev_drop)
  29.833  
  29.834  lemma nth_take [simp]: "i < n ==> (take n xs)!i = xs!i"
  29.835 -apply (induct xs arbitrary: i n, auto)
  29.836 - apply (case_tac n, blast)
  29.837 -apply (case_tac i, auto)
  29.838 -done
  29.839 +proof (induct xs arbitrary: i n)
  29.840 +  case (Cons x xs) then show ?case
  29.841 +    by (case_tac n; case_tac i; simp)
  29.842 +qed auto
  29.843  
  29.844  lemma nth_drop [simp]:
  29.845 -  "n <= length xs ==> (drop n xs)!i = xs!(n + i)"
  29.846 -apply (induct n arbitrary: xs i, auto)
  29.847 - apply (case_tac xs, auto)
  29.848 -done
  29.849 +  "n \<le> length xs ==> (drop n xs)!i = xs!(n + i)"
  29.850 +proof (induct n arbitrary: xs)
  29.851 +  case (Suc n) then show ?case
  29.852 +    by (case_tac xs; simp)
  29.853 +qed auto
  29.854  
  29.855  lemma butlast_take:
  29.856 -  "n <= length xs ==> butlast (take n xs) = take (n - 1) xs"
  29.857 -by (simp add: butlast_conv_take min.absorb1 min.absorb2)
  29.858 +  "n \<le> length xs ==> butlast (take n xs) = take (n - 1) xs"
  29.859 +  by (simp add: butlast_conv_take min.absorb1 min.absorb2)
  29.860  
  29.861  lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)"
  29.862 -by (simp add: butlast_conv_take drop_take ac_simps)
  29.863 +  by (simp add: butlast_conv_take drop_take ac_simps)
  29.864  
  29.865  lemma take_butlast: "n < length xs ==> take n (butlast xs) = take n xs"
  29.866 -by (simp add: butlast_conv_take min.absorb1)
  29.867 +  by (simp add: butlast_conv_take min.absorb1)
  29.868  
  29.869  lemma drop_butlast: "drop n (butlast xs) = butlast (drop n xs)"
  29.870 -by (simp add: butlast_conv_take drop_take ac_simps)
  29.871 +  by (simp add: butlast_conv_take drop_take ac_simps)
  29.872  
  29.873  lemma hd_drop_conv_nth: "n < length xs \<Longrightarrow> hd(drop n xs) = xs!n"
  29.874 -by(simp add: hd_conv_nth)
  29.875 +  by(simp add: hd_conv_nth)
  29.876  
  29.877  lemma set_take_subset_set_take:
  29.878 -  "m <= n \<Longrightarrow> set(take m xs) <= set(take n xs)"
  29.879 -apply (induct xs arbitrary: m n)
  29.880 - apply simp
  29.881 -apply (case_tac n)
  29.882 -apply (auto simp: take_Cons)
  29.883 -done
  29.884 +  "m \<le> n \<Longrightarrow> set(take m xs) \<le> set(take n xs)"
  29.885 +proof (induct xs arbitrary: m n)
  29.886 +  case (Cons x xs m n) then show ?case
  29.887 +    by (cases n) (auto simp: take_Cons)
  29.888 +qed simp
  29.889  
  29.890  lemma set_take_subset: "set(take n xs) \<subseteq> set xs"
  29.891 -by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split)
  29.892 +  by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split)
  29.893  
  29.894  lemma set_drop_subset: "set(drop n xs) \<subseteq> set xs"
  29.895 -by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split)
  29.896 +  by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split)
  29.897  
  29.898  lemma set_drop_subset_set_drop:
  29.899 -  "m >= n \<Longrightarrow> set(drop m xs) <= set(drop n xs)"
  29.900 -apply(induct xs arbitrary: m n)
  29.901 - apply(auto simp:drop_Cons split:nat.split)
  29.902 -by (metis set_drop_subset subset_iff)
  29.903 +  "m \<ge> n \<Longrightarrow> set(drop m xs) \<le> set(drop n xs)"
  29.904 +proof (induct xs arbitrary: m n)
  29.905 +  case (Cons x xs m n)
  29.906 +  then show ?case
  29.907 +    by (clarsimp simp: drop_Cons split: nat.split) (metis set_drop_subset subset_iff)
  29.908 +qed simp
  29.909  
  29.910  lemma in_set_takeD: "x \<in> set(take n xs) \<Longrightarrow> x \<in> set xs"
  29.911 -using set_take_subset by fast
  29.912 +  using set_take_subset by fast
  29.913  
  29.914  lemma in_set_dropD: "x \<in> set(drop n xs) \<Longrightarrow> x \<in> set xs"
  29.915 -using set_drop_subset by fast
  29.916 +  using set_drop_subset by fast
  29.917  
  29.918  lemma append_eq_conv_conj:
  29.919    "(xs @ ys = zs) = (xs = take (length xs) zs \<and> ys = drop (length xs) zs)"
  29.920 -apply (induct xs arbitrary: zs, simp, clarsimp)
  29.921 - apply (case_tac zs, auto)
  29.922 -done
  29.923 +proof (induct xs arbitrary: zs)
  29.924 +  case (Cons x xs zs) then show ?case
  29.925 +    by (cases zs, auto)
  29.926 +qed auto
  29.927  
  29.928  lemma take_add:  "take (i+j) xs = take i xs @ take j (drop i xs)"
  29.929 -apply (induct xs arbitrary: i, auto)
  29.930 - apply (case_tac i, simp_all)
  29.931 -done
  29.932 +proof (induct xs arbitrary: i)
  29.933 +  case (Cons x xs i) then show ?case
  29.934 +    by (cases i, auto)
  29.935 +qed auto
  29.936  
  29.937  lemma append_eq_append_conv_if:
  29.938    "(xs\<^sub>1 @ xs\<^sub>2 = ys\<^sub>1 @ ys\<^sub>2) =
  29.939    (if size xs\<^sub>1 \<le> size ys\<^sub>1
  29.940     then xs\<^sub>1 = take (size xs\<^sub>1) ys\<^sub>1 \<and> xs\<^sub>2 = drop (size xs\<^sub>1) ys\<^sub>1 @ ys\<^sub>2
  29.941     else take (size ys\<^sub>1) xs\<^sub>1 = ys\<^sub>1 \<and> drop (size ys\<^sub>1) xs\<^sub>1 @ xs\<^sub>2 = ys\<^sub>2)"
  29.942 -apply(induct xs\<^sub>1 arbitrary: ys\<^sub>1)
  29.943 - apply simp
  29.944 -apply(case_tac ys\<^sub>1)
  29.945 -apply simp_all
  29.946 -done
  29.947 +proof (induct xs\<^sub>1 arbitrary: ys\<^sub>1)
  29.948 +  case (Cons a xs\<^sub>1 ys\<^sub>1) then show ?case
  29.949 +    by (cases ys\<^sub>1, auto)
  29.950 +qed auto
  29.951  
  29.952  lemma take_hd_drop:
  29.953    "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs"
  29.954 -apply(induct xs arbitrary: n)
  29.955 - apply simp
  29.956 -apply(simp add:drop_Cons split:nat.split)
  29.957 -done
  29.958 +  by (induct xs arbitrary: n) (simp_all add:drop_Cons split:nat.split)
  29.959  
  29.960  lemma id_take_nth_drop:
  29.961    "i < length xs \<Longrightarrow> xs = take i xs @ xs!i # drop (Suc i) xs"
  29.962 @@ -2225,15 +2220,15 @@
  29.963    hence "xs = take (Suc i) xs @ drop (Suc i) xs" by auto
  29.964    moreover
  29.965    from si have "take (Suc i) xs = take i xs @ [xs!i]"
  29.966 -    apply (rule_tac take_Suc_conv_app_nth) by arith
  29.967 +    using take_Suc_conv_app_nth by blast
  29.968    ultimately show ?thesis by auto
  29.969  qed
  29.970  
  29.971  lemma take_update_cancel[simp]: "n \<le> m \<Longrightarrow> take n (xs[m := y]) = take n xs"
  29.972 -by(simp add: list_eq_iff_nth_eq)
  29.973 +  by(simp add: list_eq_iff_nth_eq)
  29.974  
  29.975  lemma drop_update_cancel[simp]: "n < m \<Longrightarrow> drop m (xs[n := x]) = drop m xs"
  29.976 -by(simp add: list_eq_iff_nth_eq)
  29.977 +  by(simp add: list_eq_iff_nth_eq)
  29.978  
  29.979  lemma upd_conv_take_nth_drop:
  29.980    "i < length xs \<Longrightarrow> xs[i:=a] = take i xs @ a # drop (Suc i) xs"
  29.981 @@ -2247,105 +2242,107 @@
  29.982  qed
  29.983  
  29.984  lemma take_update_swap: "take m (xs[n := x]) = (take m xs)[n := x]"
  29.985 -apply(cases "n \<ge> length xs")
  29.986 - apply simp
  29.987 -apply(simp add: upd_conv_take_nth_drop take_Cons drop_take min_def diff_Suc
  29.988 -  split: nat.split)
  29.989 -done
  29.990 -
  29.991 -lemma drop_update_swap: "m \<le> n \<Longrightarrow> drop m (xs[n := x]) = (drop m xs)[n-m := x]"
  29.992 -apply(cases "n \<ge> length xs")
  29.993 - apply simp
  29.994 -apply(simp add: upd_conv_take_nth_drop drop_take)
  29.995 -done
  29.996 +proof (cases "n \<ge> length xs")
  29.997 +  case False
  29.998 +  then show ?thesis
  29.999 +    by (simp add: upd_conv_take_nth_drop take_Cons drop_take min_def diff_Suc split: nat.split)
 29.1000 +qed auto
 29.1001 +
 29.1002 +lemma drop_update_swap: 
 29.1003 +  assumes "m \<le> n" shows "drop m (xs[n := x]) = (drop m xs)[n-m := x]"
 29.1004 +proof (cases "n \<ge> length xs")
 29.1005 +  case False
 29.1006 +  with assms show ?thesis
 29.1007 +    by (simp add: upd_conv_take_nth_drop drop_take)
 29.1008 +qed auto
 29.1009  
 29.1010  lemma nth_image: "l \<le> size xs \<Longrightarrow> nth xs ` {0..<l} = set(take l xs)"
 29.1011 -by(auto simp: set_conv_nth image_def) (metis Suc_le_eq nth_take order_trans)
 29.1012 +  by(auto simp: set_conv_nth image_def) (metis Suc_le_eq nth_take order_trans)
 29.1013  
 29.1014  
 29.1015  subsubsection \<open>@{const takeWhile} and @{const dropWhile}\<close>
 29.1016  
 29.1017  lemma length_takeWhile_le: "length (takeWhile P xs) \<le> length xs"
 29.1018 -by (induct xs) auto
 29.1019 +  by (induct xs) auto
 29.1020  
 29.1021  lemma takeWhile_dropWhile_id [simp]: "takeWhile P xs @ dropWhile P xs = xs"
 29.1022 -by (induct xs) auto
 29.1023 +  by (induct xs) auto
 29.1024  
 29.1025  lemma takeWhile_append1 [simp]:
 29.1026    "\<lbrakk>x \<in> set xs; \<not>P(x)\<rbrakk> \<Longrightarrow> takeWhile P (xs @ ys) = takeWhile P xs"
 29.1027 -by (induct xs) auto
 29.1028 +  by (induct xs) auto
 29.1029  
 29.1030  lemma takeWhile_append2 [simp]:
 29.1031    "(\<And>x. x \<in> set xs \<Longrightarrow> P x) \<Longrightarrow> takeWhile P (xs @ ys) = xs @ takeWhile P ys"
 29.1032 -by (induct xs) auto
 29.1033 +  by (induct xs) auto
 29.1034  
 29.1035  lemma takeWhile_tail: "\<not> P x \<Longrightarrow> takeWhile P (xs @ (x#l)) = takeWhile P xs"
 29.1036 -by (induct xs) auto
 29.1037 +  by (induct xs) auto
 29.1038  
 29.1039  lemma takeWhile_nth: "j < length (takeWhile P xs) \<Longrightarrow> takeWhile P xs ! j = xs ! j"
 29.1040 -apply (subst (3) takeWhile_dropWhile_id[symmetric]) unfolding nth_append by auto
 29.1041 +  by (metis nth_append takeWhile_dropWhile_id)
 29.1042  
 29.1043  lemma dropWhile_nth: "j < length (dropWhile P xs) \<Longrightarrow>
 29.1044    dropWhile P xs ! j = xs ! (j + length (takeWhile P xs))"
 29.1045 -apply (subst (3) takeWhile_dropWhile_id[symmetric]) unfolding nth_append by auto
 29.1046 +  by (metis add.commute nth_append_length_plus takeWhile_dropWhile_id)
 29.1047  
 29.1048  lemma length_dropWhile_le: "length (dropWhile P xs) \<le> length xs"
 29.1049 -by (induct xs) auto
 29.1050 +  by (induct xs) auto
 29.1051  
 29.1052  lemma dropWhile_append1 [simp]:
 29.1053    "\<lbrakk>x \<in> set xs; \<not>P(x)\<rbrakk> \<Longrightarrow> dropWhile P (xs @ ys) = (dropWhile P xs)@ys"
 29.1054 -by (induct xs) auto
 29.1055 +  by (induct xs) auto
 29.1056  
 29.1057  lemma dropWhile_append2 [simp]:
 29.1058    "(\<And>x. x \<in> set xs \<Longrightarrow> P(x)) ==> dropWhile P (xs @ ys) = dropWhile P ys"
 29.1059 -by (induct xs) auto
 29.1060 +  by (induct xs) auto
 29.1061  
 29.1062  lemma dropWhile_append3:
 29.1063    "\<not> P y \<Longrightarrow>dropWhile P (xs @ y # ys) = dropWhile P xs @ y # ys"
 29.1064 -by (induct xs) auto
 29.1065 +  by (induct xs) auto
 29.1066  
 29.1067  lemma dropWhile_last:
 29.1068    "x \<in> set xs \<Longrightarrow> \<not> P x \<Longrightarrow> last (dropWhile P xs) = last xs"
 29.1069 -by (auto simp add: dropWhile_append3 in_set_conv_decomp)
 29.1070 +  by (auto simp add: dropWhile_append3 in_set_conv_decomp)
 29.1071  
 29.1072  lemma set_dropWhileD: "x \<in> set (dropWhile P xs) \<Longrightarrow> x \<in> set xs"
 29.1073 -by (induct xs) (auto split: if_split_asm)
 29.1074 +  by (induct xs) (auto split: if_split_asm)
 29.1075  
 29.1076  lemma set_takeWhileD: "x \<in> set (takeWhile P xs) \<Longrightarrow> x \<in> set xs \<and> P x"
 29.1077 -by (induct xs) (auto split: if_split_asm)
 29.1078 +  by (induct xs) (auto split: if_split_asm)
 29.1079  
 29.1080  lemma takeWhile_eq_all_conv[simp]:
 29.1081    "(takeWhile P xs = xs) = (\<forall>x \<in> set xs. P x)"
 29.1082 -by(induct xs, auto)
 29.1083 +  by(induct xs, auto)
 29.1084  
 29.1085  lemma dropWhile_eq_Nil_conv[simp]:
 29.1086    "(dropWhile P xs = []) = (\<forall>x \<in> set xs. P x)"
 29.1087 -by(induct xs, auto)
 29.1088 +  by(induct xs, auto)
 29.1089  
 29.1090  lemma dropWhile_eq_Cons_conv:
 29.1091    "(dropWhile P xs = y#ys) = (xs = takeWhile P xs @ y # ys \<and> \<not> P y)"
 29.1092 -by(induct xs, auto)
 29.1093 +  by(induct xs, auto)
 29.1094  
 29.1095  lemma distinct_takeWhile[simp]: "distinct xs ==> distinct (takeWhile P xs)"
 29.1096 -by (induct xs) (auto dest: set_takeWhileD)
 29.1097 +  by (induct xs) (auto dest: set_takeWhileD)
 29.1098  
 29.1099  lemma distinct_dropWhile[simp]: "distinct xs ==> distinct (dropWhile P xs)"
 29.1100 -by (induct xs) auto
 29.1101 +  by (induct xs) auto
 29.1102  
 29.1103  lemma takeWhile_map: "takeWhile P (map f xs) = map f (takeWhile (P \<circ> f) xs)"
 29.1104 -by (induct xs) auto
 29.1105 +  by (induct xs) auto
 29.1106  
 29.1107  lemma dropWhile_map: "dropWhile P (map f xs) = map f (dropWhile (P \<circ> f) xs)"
 29.1108 -by (induct xs) auto
 29.1109 +  by (induct xs) auto
 29.1110  
 29.1111  lemma takeWhile_eq_take: "takeWhile P xs = take (length (takeWhile P xs)) xs"
 29.1112 -by (induct xs) auto
 29.1113 +  by (induct xs) auto
 29.1114  
 29.1115  lemma dropWhile_eq_drop: "dropWhile P xs = drop (length (takeWhile P xs)) xs"
 29.1116 -by (induct xs) auto
 29.1117 +  by (induct xs) auto
 29.1118  
 29.1119  lemma hd_dropWhile: "dropWhile P xs \<noteq> [] \<Longrightarrow> \<not> P (hd (dropWhile P xs))"
 29.1120 -by (induct xs) auto
 29.1121 +  by (induct xs) auto
 29.1122  
 29.1123  lemma takeWhile_eq_filter:
 29.1124    assumes "\<And> x. x \<in> set (dropWhile P xs) \<Longrightarrow> \<not> P x"
 29.1125 @@ -2386,12 +2383,12 @@
 29.1126        thus "\<not> P (xs ! n')" using Cons by auto
 29.1127      qed
 29.1128      ultimately show ?thesis by simp
 29.1129 -   qed
 29.1130 +  qed
 29.1131  qed
 29.1132  
 29.1133  lemma nth_length_takeWhile:
 29.1134    "length (takeWhile P xs) < length xs \<Longrightarrow> \<not> P (xs ! length (takeWhile P xs))"
 29.1135 -by (induct xs) auto
 29.1136 +  by (induct xs) auto
 29.1137  
 29.1138  lemma length_takeWhile_less_P_nth:
 29.1139    assumes all: "\<And> i. i < j \<Longrightarrow> P (xs ! i)" and "j \<le> length xs"
 29.1140 @@ -2404,47 +2401,46 @@
 29.1141  
 29.1142  lemma takeWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow>
 29.1143    takeWhile (\<lambda>y. y \<noteq> x) (rev xs) = rev (tl (dropWhile (\<lambda>y. y \<noteq> x) xs))"
 29.1144 -by(induct xs) (auto simp: takeWhile_tail[where l="[]"])
 29.1145 +  by(induct xs) (auto simp: takeWhile_tail[where l="[]"])
 29.1146  
 29.1147  lemma dropWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow>
 29.1148    dropWhile (\<lambda>y. y \<noteq> x) (rev xs) = x # rev (takeWhile (\<lambda>y. y \<noteq> x) xs)"
 29.1149 -apply(induct xs)
 29.1150 - apply simp
 29.1151 -apply auto
 29.1152 -apply(subst dropWhile_append2)
 29.1153 -apply auto
 29.1154 -done
 29.1155 +proof (induct xs)
 29.1156 +  case (Cons a xs)
 29.1157 +  then show ?case
 29.1158 +    by(auto, subst dropWhile_append2, auto)
 29.1159 +qed simp
 29.1160  
 29.1161  lemma takeWhile_not_last:
 29.1162    "distinct xs \<Longrightarrow> takeWhile (\<lambda>y. y \<noteq> last xs) xs = butlast xs"
 29.1163 -by(induction xs rule: induct_list012) auto
 29.1164 +  by(induction xs rule: induct_list012) auto
 29.1165  
 29.1166  lemma takeWhile_cong [fundef_cong]:
 29.1167    "\<lbrakk>l = k; \<And>x. x \<in> set l \<Longrightarrow> P x = Q x\<rbrakk>
 29.1168    \<Longrightarrow> takeWhile P l = takeWhile Q k"
 29.1169 -by (induct k arbitrary: l) (simp_all)
 29.1170 +  by (induct k arbitrary: l) (simp_all)
 29.1171  
 29.1172  lemma dropWhile_cong [fundef_cong]:
 29.1173    "\<lbrakk>l = k; \<And>x. x \<in> set l \<Longrightarrow> P x = Q x\<rbrakk>
 29.1174    \<Longrightarrow> dropWhile P l = dropWhile Q k"
 29.1175 -by (induct k arbitrary: l, simp_all)
 29.1176 +  by (induct k arbitrary: l, simp_all)
 29.1177  
 29.1178  lemma takeWhile_idem [simp]:
 29.1179    "takeWhile P (takeWhile P xs) = takeWhile P xs"
 29.1180 -by (induct xs) auto
 29.1181 +  by (induct xs) auto
 29.1182  
 29.1183  lemma dropWhile_idem [simp]:
 29.1184    "dropWhile P (dropWhile P xs) = dropWhile P xs"
 29.1185 -by (induct xs) auto
 29.1186 +  by (induct xs) auto
 29.1187  
 29.1188  
 29.1189  subsubsection \<open>@{const zip}\<close>
 29.1190  
 29.1191  lemma zip_Nil [simp]: "zip [] ys = []"
 29.1192 -by (induct ys) auto
 29.1193 +  by (induct ys) auto
 29.1194  
 29.1195  lemma zip_Cons_Cons [simp]: "zip (x # xs) (y # ys) = (x, y) # zip xs ys"
 29.1196 -by simp
 29.1197 +  by simp
 29.1198  
 29.1199  declare zip_Cons [simp del]
 29.1200  
 29.1201 @@ -2452,15 +2448,15 @@
 29.1202    "zip [] ys = []"
 29.1203    "zip xs [] = []"
 29.1204    "zip (x # xs) (y # ys) = (x, y) # zip xs ys"
 29.1205 -by (fact zip_Nil zip.simps(1) zip_Cons_Cons)+
 29.1206 +  by (fact zip_Nil zip.simps(1) zip_Cons_Cons)+
 29.1207  
 29.1208  lemma zip_Cons1:
 29.1209    "zip (x#xs) ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x,y)#zip xs ys)"
 29.1210 -by(auto split:list.split)
 29.1211 +  by(auto split:list.split)
 29.1212  
 29.1213  lemma length_zip [simp]:
 29.1214    "length (zip xs ys) = min (length xs) (length ys)"
 29.1215 -by (induct xs ys rule:list_induct2') auto
 29.1216 +  by (induct xs ys rule:list_induct2') auto
 29.1217  
 29.1218  lemma zip_obtain_same_length:
 29.1219    assumes "\<And>zs ws n. length zs = length ws \<Longrightarrow> n = min (length xs) (length ys)
 29.1220 @@ -2482,21 +2478,21 @@
 29.1221  lemma zip_append1:
 29.1222    "zip (xs @ ys) zs =
 29.1223    zip xs (take (length xs) zs) @ zip ys (drop (length xs) zs)"
 29.1224 -by (induct xs zs rule:list_induct2') auto
 29.1225 +  by (induct xs zs rule:list_induct2') auto
 29.1226  
 29.1227  lemma zip_append2:
 29.1228    "zip xs (ys @ zs) =
 29.1229    zip (take (length ys) xs) ys @ zip (drop (length ys) xs) zs"
 29.1230 -by (induct xs ys rule:list_induct2') auto
 29.1231 +  by (induct xs ys rule:list_induct2') auto
 29.1232  
 29.1233  lemma zip_append [simp]:
 29.1234    "[| length xs = length us |] ==>
 29.1235    zip (xs@ys) (us@vs) = zip xs us @ zip ys vs"
 29.1236 -by (simp add: zip_append1)
 29.1237 +  by (simp add: zip_append1)
 29.1238  
 29.1239  lemma zip_rev:
 29.1240    "length xs = length ys ==> zip (rev xs) (rev ys) = rev (zip xs ys)"
 29.1241 -by (induct rule:list_induct2, simp_all)
 29.1242 +  by (induct rule:list_induct2, simp_all)
 29.1243  
 29.1244  lemma zip_map_map:
 29.1245    "zip (map f xs) (map g ys) = map (\<lambda> (x, y). (f x, g y)) (zip xs ys)"
 29.1246 @@ -2511,66 +2507,66 @@
 29.1247  
 29.1248  lemma zip_map1:
 29.1249    "zip (map f xs) ys = map (\<lambda>(x, y). (f x, y)) (zip xs ys)"
 29.1250 -using zip_map_map[of f xs "\<lambda>x. x" ys] by simp
 29.1251 +  using zip_map_map[of f xs "\<lambda>x. x" ys] by simp
 29.1252  
 29.1253  lemma zip_map2:
 29.1254    "zip xs (map f ys) = map (\<lambda>(x, y). (x, f y)) (zip xs ys)"
 29.1255 -using zip_map_map[of "\<lambda>x. x" xs f ys] by simp
 29.1256 +  using zip_map_map[of "\<lambda>x. x" xs f ys] by simp
 29.1257  
 29.1258  lemma map_zip_map:
 29.1259    "map f (zip (map g xs) ys) = map (%(x,y). f(g x, y)) (zip xs ys)"
 29.1260 -by (auto simp: zip_map1)
 29.1261 +  by (auto simp: zip_map1)
 29.1262  
 29.1263  lemma map_zip_map2:
 29.1264    "map f (zip xs (map g ys)) = map (%(x,y). f(x, g y)) (zip xs ys)"
 29.1265 -by (auto simp: zip_map2)
 29.1266 +  by (auto simp: zip_map2)
 29.1267  
 29.1268  text\<open>Courtesy of Andreas Lochbihler:\<close>
 29.1269  lemma zip_same_conv_map: "zip xs xs = map (\<lambda>x. (x, x)) xs"
 29.1270 -by(induct xs) auto
 29.1271 +  by(induct xs) auto
 29.1272  
 29.1273  lemma nth_zip [simp]:
 29.1274    "[| i < length xs; i < length ys|] ==> (zip xs ys)!i = (xs!i, ys!i)"
 29.1275 -apply (induct ys arbitrary: i xs, simp)
 29.1276 -apply (case_tac xs)
 29.1277 - apply (simp_all add: nth.simps split: nat.split)
 29.1278 -done
 29.1279 +proof (induct ys arbitrary: i xs)
 29.1280 +  case (Cons y ys)
 29.1281 +  then show ?case
 29.1282 +    by (cases xs) (simp_all add: nth.simps split: nat.split)
 29.1283 +qed auto
 29.1284  
 29.1285  lemma set_zip:
 29.1286    "set (zip xs ys) = {(xs!i, ys!i) | i. i < min (length xs) (length ys)}"
 29.1287 -by(simp add: set_conv_nth cong: rev_conj_cong)
 29.1288 +  by(simp add: set_conv_nth cong: rev_conj_cong)
 29.1289  
 29.1290  lemma zip_same: "((a,b) \<in> set (zip xs xs)) = (a \<in> set xs \<and> a = b)"
 29.1291 -by(induct xs) auto
 29.1292 -
 29.1293 -lemma zip_update:
 29.1294 -  "zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]"
 29.1295 -by(rule sym, simp add: update_zip)
 29.1296 +  by(induct xs) auto
 29.1297 +
 29.1298 +lemma zip_update: "zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]"
 29.1299 +  by (simp add: update_zip)
 29.1300  
 29.1301  lemma zip_replicate [simp]:
 29.1302    "zip (replicate i x) (replicate j y) = replicate (min i j) (x,y)"
 29.1303 -apply (induct i arbitrary: j, auto)
 29.1304 -apply (case_tac j, auto)
 29.1305 -done
 29.1306 +proof (induct i arbitrary: j)
 29.1307 +  case (Suc i)
 29.1308 +  then show ?case
 29.1309 +    by (cases j, auto)
 29.1310 +qed auto
 29.1311  
 29.1312  lemma zip_replicate1: "zip (replicate n x) ys = map (Pair x) (take n ys)"
 29.1313 -by(induction ys arbitrary: n)(case_tac [2] n, simp_all)
 29.1314 -
 29.1315 -lemma take_zip:
 29.1316 -  "take n (zip xs ys) = zip (take n xs) (take n ys)"
 29.1317 -apply (induct n arbitrary: xs ys)
 29.1318 - apply simp
 29.1319 -apply (case_tac xs, simp)
 29.1320 -apply (case_tac ys, simp_all)
 29.1321 -done
 29.1322 -
 29.1323 -lemma drop_zip:
 29.1324 -  "drop n (zip xs ys) = zip (drop n xs) (drop n ys)"
 29.1325 -apply (induct n arbitrary: xs ys)
 29.1326 - apply simp
 29.1327 -apply (case_tac xs, simp)
 29.1328 -apply (case_tac ys, simp_all)
 29.1329 -done
 29.1330 +  by(induction ys arbitrary: n)(case_tac [2] n, simp_all)
 29.1331 +
 29.1332 +lemma take_zip: "take n (zip xs ys) = zip (take n xs) (take n ys)"
 29.1333 +proof (induct n arbitrary: xs ys)
 29.1334 +  case (Suc n)
 29.1335 +  then show ?case
 29.1336 +    by (case_tac xs; case_tac ys; simp)
 29.1337 +qed simp
 29.1338 +
 29.1339 +lemma drop_zip: "drop n (zip xs ys) = zip (drop n xs) (drop n ys)"
 29.1340 +proof (induct n arbitrary: xs ys)
 29.1341 +  case (Suc n)
 29.1342 +  then show ?case
 29.1343 +    by (case_tac xs; case_tac ys; simp)
 29.1344 +qed simp
 29.1345  
 29.1346  lemma zip_takeWhile_fst: "zip (takeWhile P xs) ys = takeWhile (P \<circ> fst) (zip xs ys)"
 29.1347  proof (induct xs arbitrary: ys)
 29.1348 @@ -2583,26 +2579,26 @@
 29.1349  qed simp
 29.1350  
 29.1351  lemma set_zip_leftD: "(x,y)\<in> set (zip xs ys) \<Longrightarrow> x \<in> set xs"
 29.1352 -by (induct xs ys rule:list_induct2') auto
 29.1353 +  by (induct xs ys rule:list_induct2') auto
 29.1354  
 29.1355  lemma set_zip_rightD: "(x,y)\<in> set (zip xs ys) \<Longrightarrow> y \<in> set ys"
 29.1356 -by (induct xs ys rule:list_induct2') auto
 29.1357 +  by (induct xs ys rule:list_induct2') auto
 29.1358  
 29.1359  lemma in_set_zipE:
 29.1360    "(x,y) \<in> set(zip xs ys) \<Longrightarrow> (\<lbrakk> x \<in> set xs; y \<in> set ys \<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R"
 29.1361 -by(blast dest: set_zip_leftD set_zip_rightD)
 29.1362 +  by(blast dest: set_zip_leftD set_zip_rightD)
 29.1363  
 29.1364  lemma zip_map_fst_snd: "zip (map fst zs) (map snd zs) = zs"
 29.1365 -by (induct zs) simp_all
 29.1366 +  by (induct zs) simp_all
 29.1367  
 29.1368  lemma zip_eq_conv:
 29.1369    "length xs = length ys \<Longrightarrow> zip xs ys = zs \<longleftrightarrow> map fst zs = xs \<and> map snd zs = ys"
 29.1370 -by (auto simp add: zip_map_fst_snd)
 29.1371 +  by (auto simp add: zip_map_fst_snd)
 29.1372  
 29.1373  lemma in_set_zip:
 29.1374    "p \<in> set (zip xs ys) \<longleftrightarrow> (\<exists>n. xs ! n = fst p \<and> ys ! n = snd p
 29.1375    \<and> n < length xs \<and> n < length ys)"
 29.1376 -by (cases p) (auto simp add: set_zip)
 29.1377 +  by (cases p) (auto simp add: set_zip)
 29.1378  
 29.1379  lemma in_set_impl_in_set_zip1:
 29.1380    assumes "length xs = length ys"
 29.1381 @@ -2636,25 +2632,25 @@
 29.1382  
 29.1383  lemma list_all2_lengthD [intro?]:
 29.1384    "list_all2 P xs ys ==> length xs = length ys"
 29.1385 -by (simp add: list_all2_iff)
 29.1386 +  by (simp add: list_all2_iff)
 29.1387  
 29.1388  lemma list_all2_Nil [iff, code]: "list_all2 P [] ys = (ys = [])"
 29.1389 -by (simp add: list_all2_iff)
 29.1390 +  by (simp add: list_all2_iff)
 29.1391  
 29.1392  lemma list_all2_Nil2 [iff, code]: "list_all2 P xs [] = (xs = [])"
 29.1393 -by (simp add: list_all2_iff)
 29.1394 +  by (simp add: list_all2_iff)
 29.1395  
 29.1396  lemma list_all2_Cons [iff, code]:
 29.1397    "list_all2 P (x # xs) (y # ys) = (P x y \<and> list_all2 P xs ys)"
 29.1398 -by (auto simp add: list_all2_iff)
 29.1399 +  by (auto simp add: list_all2_iff)
 29.1400  
 29.1401  lemma list_all2_Cons1:
 29.1402    "list_all2 P (x # xs) ys = (\<exists>z zs. ys = z # zs \<and> P x z \<and> list_all2 P xs zs)"
 29.1403 -by (cases ys) auto
 29.1404 +  by (cases ys) auto
 29.1405  
 29.1406  lemma list_all2_Cons2:
 29.1407    "list_all2 P xs (y # ys) = (\<exists>z zs. xs = z # zs \<and> P z y \<and> list_all2 P zs ys)"
 29.1408 -by (cases xs) auto
 29.1409 +  by (cases xs) auto
 29.1410  
 29.1411  lemma list_all2_induct
 29.1412    [consumes 1, case_names Nil Cons, induct set: list_all2]:
 29.1413 @@ -2663,59 +2659,69 @@
 29.1414    assumes Cons: "\<And>x xs y ys.
 29.1415      \<lbrakk>P x y; list_all2 P xs ys; R xs ys\<rbrakk> \<Longrightarrow> R (x # xs) (y # ys)"
 29.1416    shows "R xs ys"
 29.1417 -using P
 29.1418 -by (induct xs arbitrary: ys) (auto simp add: list_all2_Cons1 Nil Cons)
 29.1419 +  using P
 29.1420 +  by (induct xs arbitrary: ys) (auto simp add: list_all2_Cons1 Nil Cons)
 29.1421  
 29.1422  lemma list_all2_rev [iff]:
 29.1423    "list_all2 P (rev xs) (rev ys) = list_all2 P xs ys"
 29.1424 -by (simp add: list_all2_iff zip_rev cong: conj_cong)
 29.1425 +  by (simp add: list_all2_iff zip_rev cong: conj_cong)
 29.1426  
 29.1427  lemma list_all2_rev1:
 29.1428    "list_all2 P (rev xs) ys = list_all2 P xs (rev ys)"
 29.1429 -by (subst list_all2_rev [symmetric]) simp
 29.1430 +  by (subst list_all2_rev [symmetric]) simp
 29.1431  
 29.1432  lemma list_all2_append1:
 29.1433    "list_all2 P (xs @ ys) zs =
 29.1434    (\<exists>us vs. zs = us @ vs \<and> length us = length xs \<and> length vs = length ys \<and>
 29.1435 -    list_all2 P xs us \<and> list_all2 P ys vs)"
 29.1436 -apply (simp add: list_all2_iff zip_append1)
 29.1437 -apply (rule iffI)
 29.1438 - apply (rule_tac x = "take (length xs) zs" in exI)
 29.1439 - apply (rule_tac x = "drop (length xs) zs" in exI)
 29.1440 - apply (force split: nat_diff_split simp add: min_def, clarify)
 29.1441 -apply (simp add: ball_Un)
 29.1442 -done
 29.1443 +    list_all2 P xs us \<and> list_all2 P ys vs)" (is "?lhs = ?rhs")
 29.1444 +proof
 29.1445 +  assume ?lhs
 29.1446 +  then show ?rhs
 29.1447 +    apply (rule_tac x = "take (length xs) zs" in exI)
 29.1448 +    apply (rule_tac x = "drop (length xs) zs" in exI)
 29.1449 +    apply (force split: nat_diff_split simp add: list_all2_iff zip_append1)
 29.1450 +    done
 29.1451 +next
 29.1452 +  assume ?rhs
 29.1453 +  then show ?lhs
 29.1454 +    by (auto simp add: list_all2_iff)
 29.1455 +qed
 29.1456  
 29.1457  lemma list_all2_append2:
 29.1458    "list_all2 P xs (ys @ zs) =
 29.1459    (\<exists>us vs. xs = us @ vs \<and> length us = length ys \<and> length vs = length zs \<and>
 29.1460 -    list_all2 P us ys \<and> list_all2 P vs zs)"
 29.1461 -apply (simp add: list_all2_iff zip_append2)
 29.1462 -apply (rule iffI)
 29.1463 - apply (rule_tac x = "take (length ys) xs" in exI)
 29.1464 - apply (rule_tac x = "drop (length ys) xs" in exI)
 29.1465 - apply (force split: nat_diff_split simp add: min_def, clarify)
 29.1466 -apply (simp add: ball_Un)
 29.1467 -done
 29.1468 +    list_all2 P us ys \<and> list_all2 P vs zs)" (is "?lhs = ?rhs")
 29.1469 +proof
 29.1470 +  assume ?lhs
 29.1471 +  then show ?rhs
 29.1472 +    apply (rule_tac x = "take (length ys) xs" in exI)
 29.1473 +    apply (rule_tac x = "drop (length ys) xs" in exI)
 29.1474 +    apply (force split: nat_diff_split simp add: list_all2_iff zip_append2)
 29.1475 +    done
 29.1476 +next
 29.1477 +  assume ?rhs
 29.1478 +  then show ?lhs
 29.1479 +    by (auto simp add: list_all2_iff)
 29.1480 +qed
 29.1481  
 29.1482  lemma list_all2_append:
 29.1483    "length xs = length ys \<Longrightarrow>
 29.1484    list_all2 P (xs@us) (ys@vs) = (list_all2 P xs ys \<and> list_all2 P us vs)"
 29.1485 -by (induct rule:list_induct2, simp_all)
 29.1486 +  by (induct rule:list_induct2, simp_all)
 29.1487  
 29.1488  lemma list_all2_appendI [intro?, trans]:
 29.1489    "\<lbrakk> list_all2 P a b; list_all2 P c d \<rbrakk> \<Longrightarrow> list_all2 P (a@c) (b@d)"
 29.1490 -by (simp add: list_all2_append list_all2_lengthD)
 29.1491 +  by (simp add: list_all2_append list_all2_lengthD)
 29.1492  
 29.1493  lemma list_all2_conv_all_nth:
 29.1494    "list_all2 P xs ys =
 29.1495    (length xs = length ys \<and> (\<forall>i < length xs. P (xs!i) (ys!i)))"
 29.1496 -by (force simp add: list_all2_iff set_zip)
 29.1497 +  by (force simp add: list_all2_iff set_zip)
 29.1498  
 29.1499  lemma list_all2_trans:
 29.1500    assumes tr: "!!a b c. P1 a b ==> P2 b c ==> P3 a c"
 29.1501    shows "!!bs cs. list_all2 P1 as bs ==> list_all2 P2 bs cs ==> list_all2 P3 as cs"
 29.1502 -        (is "!!bs cs. PROP ?Q as bs cs")
 29.1503 +    (is "!!bs cs. PROP ?Q as bs cs")
 29.1504  proof (induct as)
 29.1505    fix x xs bs assume I1: "!!bs cs. PROP ?Q xs bs cs"
 29.1506    show "!!cs. PROP ?Q (x # xs) bs cs"
 29.1507 @@ -2728,100 +2734,98 @@
 29.1508  
 29.1509  lemma list_all2_all_nthI [intro?]:
 29.1510    "length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> P (a!n) (b!n)) \<Longrightarrow> list_all2 P a b"
 29.1511 -by (simp add: list_all2_conv_all_nth)
 29.1512 +  by (simp add: list_all2_conv_all_nth)
 29.1513  
 29.1514  lemma list_all2I:
 29.1515    "\<forall>x \<in> set (zip a b). case_prod P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b"
 29.1516 -by (simp add: list_all2_iff)
 29.1517 +  by (simp add: list_all2_iff)
 29.1518  
 29.1519  lemma list_all2_nthD:
 29.1520    "\<lbrakk> list_all2 P xs ys; p < size xs \<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)"
 29.1521 -by (simp add: list_all2_conv_all_nth)
 29.1522 +  by (simp add: list_all2_conv_all_nth)
 29.1523  
 29.1524  lemma list_all2_nthD2:
 29.1525    "\<lbrakk>list_all2 P xs ys; p < size ys\<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)"
 29.1526 -by (frule list_all2_lengthD) (auto intro: list_all2_nthD)
 29.1527 +  by (frule list_all2_lengthD) (auto intro: list_all2_nthD)
 29.1528  
 29.1529  lemma list_all2_map1:
 29.1530    "list_all2 P (map f as) bs = list_all2 (\<lambda>x y. P (f x) y) as bs"
 29.1531 -by (simp add: list_all2_conv_all_nth)
 29.1532 +  by (simp add: list_all2_conv_all_nth)
 29.1533  
 29.1534  lemma list_all2_map2:
 29.1535    "list_all2 P as (map f bs) = list_all2 (\<lambda>x y. P x (f y)) as bs"
 29.1536 -by (auto simp add: list_all2_conv_all_nth)
 29.1537 +  by (auto simp add: list_all2_conv_all_nth)
 29.1538  
 29.1539  lemma list_all2_refl [intro?]:
 29.1540    "(\<And>x. P x x) \<Longrightarrow> list_all2 P xs xs"
 29.1541 -by (simp add: list_all2_conv_all_nth)
 29.1542 +  by (simp add: list_all2_conv_all_nth)
 29.1543  
 29.1544  lemma list_all2_update_cong:
 29.1545    "\<lbrakk> list_all2 P xs ys; P x y \<rbrakk> \<Longrightarrow> list_all2 P (xs[i:=x]) (ys[i:=y])"
 29.1546 -by (cases "i < length ys") (auto simp add: list_all2_conv_all_nth nth_list_update)
 29.1547 +  by (cases "i < length ys") (auto simp add: list_all2_conv_all_nth nth_list_update)
 29.1548  
 29.1549  lemma list_all2_takeI [simp,intro?]:
 29.1550    "list_all2 P xs ys \<Longrightarrow> list_all2 P (take n xs) (take n ys)"
 29.1551 -apply (induct xs arbitrary: n ys)
 29.1552 - apply simp
 29.1553 -apply (clarsimp simp add: list_all2_Cons1)
 29.1554 -apply (case_tac n)
 29.1555 -apply auto
 29.1556 -done
 29.1557 +proof (induct xs arbitrary: n ys)
 29.1558 +  case (Cons x xs)
 29.1559 +  then show ?case
 29.1560 +    by (cases n) (auto simp: list_all2_Cons1)
 29.1561 +qed auto
 29.1562  
 29.1563  lemma list_all2_dropI [simp,intro?]:
 29.1564 -  "list_all2 P as bs \<Longrightarrow> list_all2 P (drop n as) (drop n bs)"
 29.1565 -apply (induct as arbitrary: n bs, simp)
 29.1566 -apply (clarsimp simp add: list_all2_Cons1)
 29.1567 -apply (case_tac n, simp, simp)
 29.1568 -done
 29.1569 +  "list_all2 P xs ys \<Longrightarrow> list_all2 P (drop n xs) (drop n ys)"
 29.1570 +proof (induct xs arbitrary: n ys)
 29.1571 +  case (Cons x xs)
 29.1572 +  then show ?case
 29.1573 +    by (cases n) (auto simp: list_all2_Cons1)
 29.1574 +qed auto
 29.1575  
 29.1576  lemma list_all2_mono [intro?]:
 29.1577    "list_all2 P xs ys \<Longrightarrow> (\<And>xs ys. P xs ys \<Longrightarrow> Q xs ys) \<Longrightarrow> list_all2 Q xs ys"
 29.1578 -apply (induct xs arbitrary: ys, simp)
 29.1579 -apply (case_tac ys, auto)
 29.1580 -done
 29.1581 +  by (rule list.rel_mono_strong)
 29.1582  
 29.1583  lemma list_all2_eq:
 29.1584    "xs = ys \<longleftrightarrow> list_all2 (=) xs ys"
 29.1585 -by (induct xs ys rule: list_induct2') auto
 29.1586 +  by (induct xs ys rule: list_induct2') auto
 29.1587  
 29.1588  lemma list_eq_iff_zip_eq:
 29.1589    "xs = ys \<longleftrightarrow> length xs = length ys \<and> (\<forall>(x,y) \<in> set (zip xs ys). x = y)"
 29.1590 -by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong)
 29.1591 +  by(auto simp add: set_zip list_all2_eq list_all2_conv_all_nth cong: conj_cong)
 29.1592  
 29.1593  lemma list_all2_same: "list_all2 P xs xs \<longleftrightarrow> (\<forall>x\<in>set xs. P x x)"
 29.1594 -by(auto simp add: list_all2_conv_all_nth set_conv_nth)
 29.1595 +  by(auto simp add: list_all2_conv_all_nth set_conv_nth)
 29.1596  
 29.1597  lemma zip_assoc:
 29.1598    "zip xs (zip ys zs) = map (\<lambda>((x, y), z). (x, y, z)) (zip (zip xs ys) zs)"
 29.1599 -by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all
 29.1600 +  by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all
 29.1601  
 29.1602  lemma zip_commute: "zip xs ys = map (\<lambda>(x, y). (y, x)) (zip ys xs)"
 29.1603 -by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all
 29.1604 +  by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all
 29.1605  
 29.1606  lemma zip_left_commute:
 29.1607    "zip xs (zip ys zs) = map (\<lambda>(y, (x, z)). (x, y, z)) (zip ys (zip xs zs))"
 29.1608 -by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all
 29.1609 +  by(rule list_all2_all_nthI[where P="(=)", unfolded list.rel_eq]) simp_all
 29.1610  
 29.1611  lemma zip_replicate2: "zip xs (replicate n y) = map (\<lambda>x. (x, y)) (take n xs)"
 29.1612 -by(subst zip_commute)(simp add: zip_replicate1)
 29.1613 +  by(subst zip_commute)(simp add: zip_replicate1)
 29.1614  
 29.1615  subsubsection \<open>@{const List.product} and @{const product_lists}\<close>
 29.1616  
 29.1617  lemma product_concat_map:
 29.1618    "List.product xs ys = concat (map (\<lambda>x. map (\<lambda>y. (x,y)) ys) xs)"
 29.1619 -by(induction xs) (simp)+
 29.1620 +  by(induction xs) (simp)+
 29.1621  
 29.1622  lemma set_product[simp]: "set (List.product xs ys) = set xs \<times> set ys"
 29.1623 -by (induct xs) auto
 29.1624 +  by (induct xs) auto
 29.1625  
 29.1626  lemma length_product [simp]:
 29.1627    "length (List.product xs ys) = length xs * length ys"
 29.1628 -by (induct xs) simp_all
 29.1629 +  by (induct xs) simp_all
 29.1630  
 29.1631  lemma product_nth:
 29.1632    assumes "n < length xs * length ys"
 29.1633    shows "List.product xs ys ! n = (xs ! (n div length ys), ys ! (n mod length ys))"
 29.1634 -using assms proof (induct xs arbitrary: n)
 29.1635 +  using assms proof (induct xs arbitrary: n)
 29.1636    case Nil then show ?case by simp
 29.1637  next
 29.1638    case (Cons x xs n)
 29.1639 @@ -2832,7 +2836,7 @@
 29.1640  
 29.1641  lemma in_set_product_lists_length:
 29.1642    "xs \<in> set (product_lists xss) \<Longrightarrow> length xs = length xss"
 29.1643 -by (induct xss arbitrary: xs) auto
 29.1644 +  by (induct xss arbitrary: xs) auto
 29.1645  
 29.1646  lemma product_lists_set:
 29.1647    "set (product_lists xss) = {xs. list_all2 (\<lambda>x ys. x \<in> set ys) xs xss}" (is "?L = Collect ?R")
 29.1648 @@ -2851,25 +2855,25 @@
 29.1649  lemma fold_simps [code]: \<comment> \<open>eta-expanded variant for generated code -- enables tail-recursion optimisation in Scala\<close>
 29.1650    "fold f [] s = s"
 29.1651    "fold f (x # xs) s = fold f xs (f x s)"
 29.1652 -by simp_all
 29.1653 +  by simp_all
 29.1654  
 29.1655  lemma fold_remove1_split:
 29.1656    "\<lbrakk> \<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f x \<circ> f y = f y \<circ> f x;
 29.1657      x \<in> set xs \<rbrakk>
 29.1658    \<Longrightarrow> fold f xs = fold f (remove1 x xs) \<circ> f x"
 29.1659 -by (induct xs) (auto simp add: comp_assoc)
 29.1660 +  by (induct xs) (auto simp add: comp_assoc)
 29.1661  
 29.1662  lemma fold_cong [fundef_cong]:
 29.1663    "a = b \<Longrightarrow> xs = ys \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> f x = g x)
 29.1664      \<Longrightarrow> fold f xs a = fold g ys b"
 29.1665 -by (induct ys arbitrary: a b xs) simp_all
 29.1666 +  by (induct ys arbitrary: a b xs) simp_all
 29.1667  
 29.1668  lemma fold_id: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = id) \<Longrightarrow> fold f xs = id"
 29.1669 -by (induct xs) simp_all
 29.1670 +  by (induct xs) simp_all
 29.1671  
 29.1672  lemma fold_commute:
 29.1673    "(\<And>x. x \<in> set xs \<Longrightarrow> h \<circ> g x = f x \<circ> h) \<Longrightarrow> h \<circ> fold g xs = fold f xs \<circ> h"
 29.1674 -by (induct xs) (simp_all add: fun_eq_iff)
 29.1675 +  by (induct xs) (simp_all add: fun_eq_iff)
 29.1676  
 29.1677  lemma fold_commute_apply:
 29.1678    assumes "\<And>x. x \<in> set xs \<Longrightarrow> h \<circ> g x = f x \<circ> h"
 29.1679 @@ -2882,41 +2886,41 @@
 29.1680  lemma fold_invariant:
 29.1681    "\<lbrakk> \<And>x. x \<in> set xs \<Longrightarrow> Q x;  P s;  \<And>x s. Q x \<Longrightarrow> P s \<Longrightarrow> P (f x s) \<rbrakk>
 29.1682    \<Longrightarrow> P (fold f xs s)"
 29.1683 -by (induct xs arbitrary: s) simp_all
 29.1684 +  by (induct xs arbitrary: s) simp_all
 29.1685  
 29.1686  lemma fold_append [simp]: "fold f (xs @ ys) = fold f ys \<circ> fold f xs"
 29.1687 -by (induct xs) simp_all
 29.1688 +  by (induct xs) simp_all
 29.1689  
 29.1690  lemma fold_map [code_unfold]: "fold g (map f xs) = fold (g \<circ> f) xs"
 29.1691 -by (induct xs) simp_all
 29.1692 +  by (induct xs) simp_all
 29.1693  
 29.1694  lemma fold_filter:
 29.1695    "fold f (filter P xs) = fold (\<lambda>x. if P x then f x else id) xs"
 29.1696 -by (induct xs) simp_all
 29.1697 +  by (induct xs) simp_all
 29.1698  
 29.1699  lemma fold_rev:
 29.1700    "(\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y)
 29.1701    \<Longrightarrow> fold f (rev xs) = fold f xs"
 29.1702 -by (induct xs) (simp_all add: fold_commute_apply fun_eq_iff)
 29.1703 +  by (induct xs) (simp_all add: fold_commute_apply fun_eq_iff)
 29.1704  
 29.1705  lemma fold_Cons_rev: "fold Cons xs = append (rev xs)"
 29.1706 -by (induct xs) simp_all
 29.1707 +  by (induct xs) simp_all
 29.1708  
 29.1709  lemma rev_conv_fold [code]: "rev xs = fold Cons xs []"
 29.1710 -by (simp add: fold_Cons_rev)
 29.1711 +  by (simp add: fold_Cons_rev)
 29.1712  
 29.1713  lemma fold_append_concat_rev: "fold append xss = append (concat (rev xss))"
 29.1714 -by (induct xss) simp_all
 29.1715 +  by (induct xss) simp_all
 29.1716  
 29.1717  text \<open>@{const Finite_Set.fold} and @{const fold}\<close>
 29.1718  
 29.1719  lemma (in comp_fun_commute) fold_set_fold_remdups:
 29.1720    "Finite_Set.fold f y (set xs) = fold f (remdups xs) y"
 29.1721 -by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm insert_absorb)
 29.1722 +  by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm insert_absorb)
 29.1723  
 29.1724  lemma (in comp_fun_idem) fold_set_fold:
 29.1725    "Finite_Set.fold f y (set xs) = fold f xs y"
 29.1726 -by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm)
 29.1727 +  by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_left_comm)
 29.1728  
 29.1729  lemma union_set_fold [code]: "set xs \<union> A = fold Set.insert xs A"
 29.1730  proof -
 29.1731 @@ -2927,7 +2931,7 @@
 29.1732  
 29.1733  lemma union_coset_filter [code]:
 29.1734    "List.coset xs \<union> A = List.coset (List.filter (\<lambda>x. x \<notin> A) xs)"
 29.1735 -by auto
 29.1736 +  by auto
 29.1737  
 29.1738  lemma minus_set_fold [code]: "A - set xs = fold Set.remove xs A"
 29.1739  proof -
 29.1740 @@ -2939,15 +2943,15 @@
 29.1741  
 29.1742  lemma minus_coset_filter [code]:
 29.1743    "A - List.coset xs = set (List.filter (\<lambda>x. x \<in> A) xs)"
 29.1744 -by auto
 29.1745 +  by auto
 29.1746  
 29.1747  lemma inter_set_filter [code]:
 29.1748    "A \<inter> set xs = set (List.filter (\<lambda>x. x \<in> A) xs)"
 29.1749 -by auto
 29.1750 +  by auto
 29.1751  
 29.1752  lemma inter_coset_fold [code]:
 29.1753    "A \<inter> List.coset xs = fold Set.remove xs A"
 29.1754 -by (simp add: Diff_eq [symmetric] minus_set_fold)
 29.1755 +  by (simp add: Diff_eq [symmetric] minus_set_fold)
 29.1756  
 29.1757  lemma (in semilattice_set) set_eq_fold [code]:
 29.1758    "F (set (x # xs)) = fold f xs x"
 29.1759 @@ -2995,82 +2999,82 @@
 29.1760  text \<open>Correspondence\<close>
 29.1761  
 29.1762  lemma foldr_conv_fold [code_abbrev]: "foldr f xs = fold f (rev xs)"
 29.1763 -by (induct xs) simp_all
 29.1764 +  by (induct xs) simp_all
 29.1765  
 29.1766  lemma foldl_conv_fold: "foldl f s xs = fold (\<lambda>x s. f s x) xs s"
 29.1767 -by (induct xs arbitrary: s) simp_all
 29.1768 +  by (induct xs arbitrary: s) simp_all
 29.1769  
 29.1770  lemma foldr_conv_foldl: \<comment> \<open>The ``Third Duality Theorem'' in Bird \& Wadler:\<close>
 29.1771    "foldr f xs a = foldl (\<lambda>x y. f y x) a (rev xs)"
 29.1772 -by (simp add: foldr_conv_fold foldl_conv_fold)
 29.1773 +  by (simp add: foldr_conv_fold foldl_conv_fold)
 29.1774  
 29.1775  lemma foldl_conv_foldr:
 29.1776    "foldl f a xs = foldr (\<lambda>x y. f y x) (rev xs) a"
 29.1777 -by (simp add: foldr_conv_fold foldl_conv_fold)
 29.1778 +  by (simp add: foldr_conv_fold foldl_conv_fold)
 29.1779  
 29.1780  lemma foldr_fold:
 29.1781    "(\<And>x y. x \<in> set xs \<Longrightarrow> y \<in> set xs \<Longrightarrow> f y \<circ> f x = f x \<circ> f y)
 29.1782    \<Longrightarrow> foldr f xs = fold f xs"
 29.1783 -unfolding foldr_conv_fold by (rule fold_rev)
 29.1784 +  unfolding foldr_conv_fold by (rule fold_rev)
 29.1785  
 29.1786  lemma foldr_cong [fundef_cong]:
 29.1787    "a = b \<Longrightarrow> l = k \<Longrightarrow> (\<And>a x. x \<in> set l \<Longrightarrow> f x a = g x a) \<Longrightarrow> foldr f l a = foldr g k b"
 29.1788 -by (auto simp add: foldr_conv_fold intro!: fold_cong)
 29.1789 +  by (auto simp add: foldr_conv_fold intro!: fold_cong)
 29.1790  
 29.1791  lemma foldl_cong [fundef_cong]:
 29.1792    "a = b \<Longrightarrow> l = k \<Longrightarrow> (\<And>a x. x \<in> set l \<Longrightarrow> f a x = g a x) \<Longrightarrow> foldl f a l = foldl g b k"
 29.1793 -by (auto simp add: foldl_conv_fold intro!: fold_cong)
 29.1794 +  by (auto simp add: foldl_conv_fold intro!: fold_cong)
 29.1795  
 29.1796  lemma foldr_append [simp]: "foldr f (xs @ ys) a = foldr f xs (foldr f ys a)"
 29.1797 -by (simp add: foldr_conv_fold)
 29.1798 +  by (simp add: foldr_conv_fold)
 29.1799  
 29.1800  lemma foldl_append [simp]: "foldl f a (xs @ ys) = foldl f (foldl f a xs) ys"
 29.1801 -by (simp add: foldl_conv_fold)
 29.1802 +  by (simp add: foldl_conv_fold)
 29.1803  
 29.1804  lemma foldr_map [code_unfold]: "foldr g (map f xs) a = foldr (g \<circ> f) xs a"
 29.1805 -by (simp add: foldr_conv_fold fold_map rev_map)
 29.1806 +  by (simp add: foldr_conv_fold fold_map rev_map)
 29.1807  
 29.1808  lemma foldr_filter:
 29.1809    "foldr f (filter P xs) = foldr (\<lambda>x. if P x then f x else id) xs"
 29.1810 -by (simp add: foldr_conv_fold rev_filter fold_filter)
 29.1811 +  by (simp add: foldr_conv_fold rev_filter fold_filter)
 29.1812  
 29.1813  lemma foldl_map [code_unfold]:
 29.1814    "foldl g a (map f xs) = foldl (\<lambda>a x. g a (f x)) a xs"
 29.1815 -by (simp add: foldl_conv_fold fold_map comp_def)
 29.1816 +  by (simp add: foldl_conv_fold fold_map comp_def)
 29.1817  
 29.1818  lemma concat_conv_foldr [code]:
 29.1819    "concat xss = foldr append xss []"
 29.1820 -by (simp add: fold_append_concat_rev foldr_conv_fold)
 29.1821 +  by (simp add: fold_append_concat_rev foldr_conv_fold)
 29.1822  
 29.1823  
 29.1824  subsubsection \<open>@{const upt}\<close>
 29.1825  
 29.1826  lemma upt_rec[code]: "[i..<j] = (if i<j then i#[Suc i..<j] else [])"
 29.1827 -\<comment> \<open>simp does not terminate!\<close>
 29.1828 -by (induct j) auto
 29.1829 +  \<comment> \<open>simp does not terminate!\<close>
 29.1830 +  by (induct j) auto
 29.1831  
 29.1832  lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n
 29.1833  
 29.1834 -lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []"
 29.1835 -by (subst upt_rec) simp
 29.1836 -
 29.1837 -lemma upt_eq_Nil_conv[simp]: "([i..<j] = []) = (j = 0 \<or> j <= i)"
 29.1838 -by(induct j)simp_all
 29.1839 +lemma upt_conv_Nil [simp]: "j \<le> i ==> [i..<j] = []"
 29.1840 +  by (subst upt_rec) simp
 29.1841 +
 29.1842 +lemma upt_eq_Nil_conv[simp]: "([i..<j] = []) = (j = 0 \<or> j \<le> i)"
 29.1843 +  by(induct j)simp_all
 29.1844  
 29.1845  lemma upt_eq_Cons_conv:
 29.1846 - "([i..<j] = x#xs) = (i < j \<and> i = x \<and> [i+1..<j] = xs)"
 29.1847 -apply(induct j arbitrary: x xs)
 29.1848 - apply simp
 29.1849 -apply(clarsimp simp add: append_eq_Cons_conv)
 29.1850 -apply arith
 29.1851 -done
 29.1852 -
 29.1853 -lemma upt_Suc_append: "i <= j ==> [i..<(Suc j)] = [i..<j]@[j]"
 29.1854 -\<comment> \<open>Only needed if \<open>upt_Suc\<close> is deleted from the simpset.\<close>
 29.1855 -by simp
 29.1856 +  "([i..<j] = x#xs) = (i < j \<and> i = x \<and> [i+1..<j] = xs)"
 29.1857 +proof (induct j arbitrary: x xs)
 29.1858 +  case (Suc j)
 29.1859 +  then show ?case
 29.1860 +    by (simp add: upt_rec)
 29.1861 +qed simp
 29.1862 +
 29.1863 +lemma upt_Suc_append: "i \<le> j ==> [i..<(Suc j)] = [i..<j]@[j]"
 29.1864 +  \<comment> \<open>Only needed if \<open>upt_Suc\<close> is deleted from the simpset.\<close>
 29.1865 +  by simp
 29.1866  
 29.1867  lemma upt_conv_Cons: "i < j ==> [i..<j] = i # [Suc i..<j]"
 29.1868 -by (simp add: upt_rec)
 29.1869 +  by (simp add: upt_rec)
 29.1870  
 29.1871  lemma upt_conv_Cons_Cons: \<comment> \<open>no precondition\<close>
 29.1872    "m # n # ns = [m..<q] \<longleftrightarrow> n # ns = [Suc m..<q]"
 29.1873 @@ -3081,90 +3085,79 @@
 29.1874  qed
 29.1875  
 29.1876  lemma upt_add_eq_append: "i<=j ==> [i..<j+k] = [i..<j]@[j..<j+k]"
 29.1877 -\<comment> \<open>LOOPS as a simprule, since \<open>j <= j\<close>.\<close>
 29.1878 -by (induct k) auto
 29.1879 +  \<comment> \<open>LOOPS as a simprule, since \<open>j \<le> j\<close>.\<close>
 29.1880 +  by (induct k) auto
 29.1881  
 29.1882  lemma length_upt [simp]: "length [i..<j] = j - i"
 29.1883 -by (induct j) (auto simp add: Suc_diff_le)
 29.1884 +  by (induct j) (auto simp add: Suc_diff_le)
 29.1885  
 29.1886  lemma nth_upt [simp]: "i + k < j ==> [i..<j] ! k = i + k"
 29.1887 -by (induct j) (auto simp add: less_Suc_eq nth_append split: nat_diff_split)
 29.1888 +  by (induct j) (auto simp add: less_Suc_eq nth_append split: nat_diff_split)
 29.1889  
 29.1890  lemma hd_upt[simp]: "i < j \<Longrightarrow> hd[i..<j] = i"
 29.1891 -by(simp add:upt_conv_Cons)
 29.1892 +  by(simp add:upt_conv_Cons)
 29.1893  
 29.1894  lemma tl_upt: "tl [m..<n] = [Suc m..<n]"
 29.1895 -by (simp add: upt_rec)
 29.1896 +  by (simp add: upt_rec)
 29.1897  
 29.1898  lemma last_upt[simp]: "i < j \<Longrightarrow> last[i..<j] = j - 1"
 29.1899 -by(cases j)(auto simp: upt_Suc_append)
 29.1900 -
 29.1901 -lemma take_upt [simp]: "i+m <= n ==> take m [i..<n] = [i..<i+m]"
 29.1902 -apply (induct m arbitrary: i, simp)
 29.1903 -apply (subst upt_rec)
 29.1904 -apply (rule sym)
 29.1905 -apply (subst upt_rec)
 29.1906 -apply (simp del: upt.simps)
 29.1907 -done
 29.1908 +  by(cases j)(auto simp: upt_Suc_append)
 29.1909 +
 29.1910 +lemma take_upt [simp]: "i+m \<le> n ==> take m [i..<n] = [i..<i+m]"
 29.1911 +proof (induct m arbitrary: i)
 29.1912 +  case (Suc m)
 29.1913 +  then show ?case
 29.1914 +    by (subst take_Suc_conv_app_nth) auto
 29.1915 +qed simp
 29.1916  
 29.1917  lemma drop_upt[simp]: "drop m [i..<j] = [i+m..<j]"
 29.1918 -by(induct j) auto
 29.1919 +  by(induct j) auto
 29.1920  
 29.1921  lemma map_Suc_upt: "map Suc [m..<n] = [Suc m..<Suc n]"
 29.1922 -by (induct n) auto
 29.1923 +  by (induct n) auto
 29.1924  
 29.1925  lemma map_add_upt: "map (\<lambda>i. i + n) [0..<m] = [n..<m + n]"
 29.1926 -by (induct m) simp_all
 29.1927 +  by (induct m) simp_all
 29.1928  
 29.1929  lemma nth_map_upt: "i < n-m ==> (map f [m..<n]) ! i = f(m+i)"
 29.1930 -apply (induct n m  arbitrary: i rule: diff_induct)
 29.1931 -  prefer 3 apply (subst map_Suc_upt[symmetric])
 29.1932 -  apply (auto simp add: less_diff_conv)
 29.1933 -done
 29.1934 +proof (induct n m  arbitrary: i rule: diff_induct)
 29.1935 +  case (3 x y)
 29.1936 +  then show ?case
 29.1937 +    by (metis add.commute length_upt less_diff_conv nth_map nth_upt)
 29.1938 +qed auto
 29.1939  
 29.1940  lemma map_decr_upt: "map (\<lambda>n. n - Suc 0) [Suc m..<Suc n] = [m..<n]"
 29.1941 -by (induct n) simp_all
 29.1942 +  by (induct n) simp_all
 29.1943  
 29.1944  lemma map_upt_Suc: "map f [0 ..< Suc n] = f 0 # map (\<lambda>i. f (Suc i)) [0 ..< n]"
 29.1945 -by (induct n arbitrary: f) auto
 29.1946 -
 29.1947 +  by (induct n arbitrary: f) auto
 29.1948  
 29.1949  lemma nth_take_lemma:
 29.1950    "k \<le> length xs \<Longrightarrow> k \<le> length ys \<Longrightarrow>
 29.1951       (\<And>i. i < k \<longrightarrow> xs!i = ys!i) \<Longrightarrow> take k xs = take k ys"
 29.1952 -apply (atomize, induct k arbitrary: xs ys)
 29.1953 -apply (simp_all add: less_Suc_eq_0_disj all_conj_distrib, clarify)
 29.1954 -txt \<open>Both lists must be non-empty\<close>
 29.1955 -apply (case_tac xs, simp)
 29.1956 -apply (case_tac ys, clarify)
 29.1957 - apply (simp (no_asm_use))
 29.1958 -apply clarify
 29.1959 -txt \<open>prenexing's needed, not miniscoping\<close>
 29.1960 -apply (simp (no_asm_use) add: all_simps [symmetric] del: all_simps)
 29.1961 -apply blast
 29.1962 -done
 29.1963 +proof (induct k arbitrary: xs ys)
 29.1964 +  case (Suc k)
 29.1965 +  then show ?case
 29.1966 +    apply (simp add: less_Suc_eq_0_disj)
 29.1967 +    by (simp add: Suc.prems(3) take_Suc_conv_app_nth)
 29.1968 +qed simp
 29.1969  
 29.1970  lemma nth_equalityI:
 29.1971    "[| length xs = length ys; \<forall>i < length xs. xs!i = ys!i |] ==> xs = ys"
 29.1972 -by (frule nth_take_lemma [OF le_refl eq_imp_le]) simp_all
 29.1973 +  by (frule nth_take_lemma [OF le_refl eq_imp_le]) simp_all
 29.1974  
 29.1975  lemma map_nth:
 29.1976    "map (\<lambda>i. xs ! i) [0..<length xs] = xs"
 29.1977 -by (rule nth_equalityI, auto)
 29.1978 +  by (rule nth_equalityI, auto)
 29.1979  
 29.1980  lemma list_all2_antisym:
 29.1981    "\<lbrakk> (\<And>x y. \<lbrakk>P x y; Q y x\<rbrakk> \<Longrightarrow> x = y); list_all2 P xs ys; list_all2 Q ys xs \<rbrakk>
 29.1982    \<Longrightarrow> xs = ys"
 29.1983 -apply (simp add: list_all2_conv_all_nth)
 29.1984 -apply (rule nth_equalityI, blast, simp)
 29.1985 -done
 29.1986 +  by (simp add: list_all2_conv_all_nth nth_equalityI)
 29.1987  
 29.1988  lemma take_equalityI: "(\<forall>i. take i xs = take i ys) ==> xs = ys"
 29.1989  \<comment> \<open>The famous take-lemma.\<close>
 29.1990 -apply (drule_tac x = "max (length xs) (length ys)" in spec)
 29.1991 -apply (simp add: le_max_iff_disj)
 29.1992 -done
 29.1993 -
 29.1994 +  by (metis length_take min.commute order_refl take_all)
 29.1995  
 29.1996  lemma take_Cons':
 29.1997    "take n (x # xs) = (if n = 0 then [] else x # take (n - 1) xs)"
 29.1998 @@ -3241,7 +3234,7 @@
 29.1999  qed
 29.2000  
 29.2001  lemma nth_upto: "i + int k \<le> j \<Longrightarrow> [i..j] ! k = i + int k"
 29.2002 -apply(induction i j arbitrary: k rule: upto.induct)
 29.2003 +  apply(induction i j arbitrary: k rule: upto.induct)
 29.2004  apply(subst upto_rec1)
 29.2005  apply(auto simp add: nth_Cons')
 29.2006  done
 29.2007 @@ -3307,17 +3300,16 @@
 29.2008  lemma remdups_eq_nil_right_iff [simp]: "([] = remdups x) = (x = [])"
 29.2009  by (induct x, auto)
 29.2010  
 29.2011 -lemma length_remdups_leq[iff]: "length(remdups xs) <= length xs"
 29.2012 +lemma length_remdups_leq[iff]: "length(remdups xs) \<le> length xs"
 29.2013  by (induct xs) auto
 29.2014  
 29.2015  lemma length_remdups_eq[iff]:
 29.2016    "(length (remdups xs) = length xs) = (remdups xs = xs)"
 29.2017 -apply(induct xs)
 29.2018 - apply auto
 29.2019 -apply(subgoal_tac "length (remdups xs) <= length xs")
 29.2020 - apply arith
 29.2021 -apply(rule length_remdups_leq)
 29.2022 -done
 29.2023 +proof (induct xs)
 29.2024 +  case (Cons a xs)
 29.2025 +  then show ?case
 29.2026 +    by simp (metis Suc_n_not_le_n impossible_Cons length_remdups_leq)
 29.2027 +qed auto
 29.2028  
 29.2029  lemma remdups_filter: "remdups(filter P xs) = filter P (remdups xs)"
 29.2030  by (induct xs) auto
 29.2031 @@ -3343,31 +3335,38 @@
 29.2032  done
 29.2033  
 29.2034  lemma distinct_take[simp]: "distinct xs \<Longrightarrow> distinct (take i xs)"
 29.2035 -apply(induct xs arbitrary: i)
 29.2036 - apply simp
 29.2037 -apply (case_tac i)
 29.2038 - apply simp_all
 29.2039 -apply(blast dest:in_set_takeD)
 29.2040 -done
 29.2041 +proof (induct xs arbitrary: i)
 29.2042 +  case (Cons a xs)
 29.2043 +  then show ?case
 29.2044 +    by (metis Cons.prems append_take_drop_id distinct_append)
 29.2045 +qed auto
 29.2046  
 29.2047  lemma distinct_drop[simp]: "distinct xs \<Longrightarrow> distinct (drop i xs)"
 29.2048 -apply(induct xs arbitrary: i)
 29.2049 - apply simp
 29.2050 -apply (case_tac i)
 29.2051 - apply simp_all
 29.2052 -done
 29.2053 +proof (induct xs arbitrary: i)
 29.2054 +  case (Cons a xs)
 29.2055 +  then show ?case
 29.2056 +    by (metis Cons.prems append_take_drop_id distinct_append)
 29.2057 +qed auto
 29.2058  
 29.2059  lemma distinct_list_update:
 29.2060 -assumes d: "distinct xs" and a: "a \<notin> set xs - {xs!i}"
 29.2061 -shows "distinct (xs[i:=a])"
 29.2062 +  assumes d: "distinct xs" and a: "a \<notin> set xs - {xs!i}"
 29.2063 +  shows "distinct (xs[i:=a])"
 29.2064  proof (cases "i < length xs")
 29.2065    case True
 29.2066 -  with a have "a \<notin> set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}"
 29.2067 -    apply (drule_tac id_take_nth_drop) by simp
 29.2068 -  with d True show ?thesis
 29.2069 -    apply (simp add: upd_conv_take_nth_drop)
 29.2070 -    apply (drule subst [OF id_take_nth_drop]) apply assumption
 29.2071 -    apply simp apply (cases "a = xs!i") apply simp by blast
 29.2072 +  with a have anot: "a \<notin> set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}"
 29.2073 +    by simp (metis in_set_dropD in_set_takeD)
 29.2074 +  show ?thesis
 29.2075 +  proof (cases "a = xs!i")
 29.2076 +    case True
 29.2077 +    with d show ?thesis
 29.2078 +      by auto
 29.2079 +  next
 29.2080 +    case False
 29.2081 +    then show ?thesis
 29.2082 +      using d anot \<open>i < length xs\<close> 
 29.2083 +      apply (simp add: upd_conv_take_nth_drop)
 29.2084 +      by (metis disjoint_insert(1) distinct_append id_take_nth_drop set_simps(2))
 29.2085 +  qed
 29.2086  next
 29.2087    case False with d show ?thesis by auto
 29.2088  qed
 29.2089 @@ -3382,22 +3381,14 @@
 29.2090  text \<open>It is best to avoid this indexed version of distinct, but
 29.2091  sometimes it is useful.\<close>
 29.2092  
 29.2093 -lemma distinct_conv_nth:
 29.2094 -"distinct xs = (\<forall>i < size xs. \<forall>j < size xs. i \<noteq> j \<longrightarrow> xs!i \<noteq> xs!j)"
 29.2095 -apply (induct xs, simp, simp)
 29.2096 -apply (rule iffI, clarsimp)
 29.2097 - apply (case_tac i)
 29.2098 -apply (case_tac j, simp)
 29.2099 -apply (simp add: set_conv_nth)
 29.2100 - apply (case_tac j)
 29.2101 -apply (clarsimp simp add: set_conv_nth, simp)
 29.2102 -apply (rule conjI)
 29.2103 - apply (clarsimp simp add: set_conv_nth)
 29.2104 - apply (erule_tac x = 0 in allE, simp)
 29.2105 - apply (erule_tac x = "Suc i" in allE, simp, clarsimp)
 29.2106 -apply (erule_tac x = "Suc i" in allE, simp)
 29.2107 -apply (erule_tac x = "Suc j" in allE, simp)
 29.2108 -done
 29.2109 +lemma distinct_conv_nth: "distinct xs = (\<forall>i < size xs. \<forall>j < size xs. i \<noteq> j \<longrightarrow> xs!i \<noteq> xs!j)"
 29.2110 +proof (induct xs)
 29.2111 +  case (Cons x xs)
 29.2112 +  show ?case
 29.2113 +    apply (auto simp add: Cons nth_Cons split: nat.split_asm)
 29.2114 +    apply (metis Suc_less_eq2 in_set_conv_nth less_not_refl zero_less_Suc)+
 29.2115 +    done
 29.2116 +qed auto
 29.2117  
 29.2118  lemma nth_eq_iff_index_eq:
 29.2119    "\<lbrakk> distinct xs; i < length xs; j < length xs \<rbrakk> \<Longrightarrow> (xs!i = xs!j) = (i = j)"
 29.2120 @@ -3422,7 +3413,7 @@
 29.2121  
 29.2122  lemma distinct_swap[simp]: "\<lbrakk> i < size xs; j < size xs \<rbrakk> \<Longrightarrow>
 29.2123    distinct(xs[i := xs!j, j := xs!i]) = distinct xs"
 29.2124 -apply (simp add: distinct_conv_nth nth_list_update)
 29.2125 +  apply (simp add: distinct_conv_nth nth_list_update)
 29.2126  apply safe
 29.2127  apply metis+
 29.2128  done
 29.2129 @@ -3436,8 +3427,6 @@
 29.2130  
 29.2131  lemma card_distinct: "card (set xs) = size xs ==> distinct xs"
 29.2132  proof (induct xs)
 29.2133 -  case Nil thus ?case by simp
 29.2134 -next
 29.2135    case (Cons x xs)
 29.2136    show ?case
 29.2137    proof (cases "x \<in> set xs")
 29.2138 @@ -3450,17 +3439,20 @@
 29.2139      ultimately have False by simp
 29.2140      thus ?thesis ..
 29.2141    qed
 29.2142 -qed
 29.2143 +qed simp
 29.2144  
 29.2145  lemma distinct_length_filter: "distinct xs \<Longrightarrow> length (filter P xs) = card ({x. P x} Int set xs)"
 29.2146  by (induct xs) (auto)
 29.2147  
 29.2148  lemma not_distinct_decomp: "\<not> distinct ws \<Longrightarrow> \<exists>xs ys zs y. ws = xs@[y]@ys@[y]@zs"
 29.2149 -apply (induct n == "length ws" arbitrary:ws) apply simp
 29.2150 -apply(case_tac ws) apply simp
 29.2151 -apply (simp split:if_split_asm)
 29.2152 -apply (metis Cons_eq_appendI eq_Nil_appendI split_list)
 29.2153 -done
 29.2154 +proof (induct n == "length ws" arbitrary:ws)
 29.2155 +  case (Suc n ws)
 29.2156 +  then show ?case
 29.2157 +    using length_Suc_conv [of ws n]
 29.2158 +    apply (auto simp: eq_commute)
 29.2159 +     apply (metis append_Nil in_set_conv_decomp_first)
 29.2160 +    by (metis append_Cons)
 29.2161 +qed simp
 29.2162  
 29.2163  lemma not_distinct_conv_prefix:
 29.2164    defines "dec as xs y ys \<equiv> y \<in> set xs \<and> distinct xs \<and> as = xs @ y # ys"
 29.2165 @@ -3692,7 +3684,6 @@
 29.2166          then have "Suc 0 \<notin> f ` {0 ..< length (x1 # x2 # xs)}" by auto
 29.2167          then show False using f_img \<open>2 \<le> length ys\<close> by auto
 29.2168        qed
 29.2169 -
 29.2170        obtain ys' where "ys = x1 # x2 # ys'"
 29.2171          using \<open>2 \<le> length ys\<close> f_nth[of 0] f_nth[of 1]
 29.2172          apply (cases ys)
 29.2173 @@ -3717,10 +3708,7 @@
 29.2174            using Suc0_le_f_Suc f_mono by (auto simp: f'_def mono_iff_le_Suc le_diff_iff)
 29.2175        next
 29.2176          have "f' ` {0 ..< length (x2 # xs)} = (\<lambda>x. f x - 1) ` {0 ..< length (x1 # x2 #xs)}"
 29.2177 -          apply safe
 29.2178 -          apply (rename_tac [!] n,  case_tac [!] n)
 29.2179 -          apply (auto simp: f'_def \<open>f 0 = 0\<close> \<open>f (Suc 0) = Suc 0\<close> intro: rev_image_eqI)
 29.2180 -          done
 29.2181 +          by (auto simp: f'_def \<open>f 0 = 0\<close> \<open>f (Suc 0) = Suc 0\<close> image_def Bex_def less_Suc_eq_0_disj)
 29.2182          also have "\<dots> = (\<lambda>x. x - 1) ` f ` {0 ..< length (x1 # x2 #xs)}"
 29.2183            by (auto simp: image_comp)
 29.2184          also have "\<dots> = (\<lambda>x. x - 1) ` {0 ..< length ys}"
 29.2185 @@ -3887,10 +3875,12 @@
 29.2186  
 29.2187  lemma sum_count_set:
 29.2188    "set xs \<subseteq> X \<Longrightarrow> finite X \<Longrightarrow> sum (count_list xs) X = length xs"
 29.2189 -apply(induction xs arbitrary: X)
 29.2190 - apply simp
 29.2191 -apply (simp add: sum.If_cases)
 29.2192 -by (metis Diff_eq sum.remove)
 29.2193 +proof (induction xs arbitrary: X)
 29.2194 +  case (Cons x xs)
 29.2195 +  then show ?case
 29.2196 +    apply (auto simp: sum.If_cases sum.remove)
 29.2197 +    by (metis (no_types) Cons.IH Cons.prems(2) diff_eq sum.remove)
 29.2198 +qed simp
 29.2199  
 29.2200  
 29.2201  subsubsection \<open>@{const List.extract}\<close>
 29.2202 @@ -3933,23 +3923,13 @@
 29.2203  
 29.2204  lemma in_set_remove1[simp]:
 29.2205    "a \<noteq> b \<Longrightarrow> a \<in> set(remove1 b xs) = (a \<in> set xs)"
 29.2206 -apply (induct xs)
 29.2207 - apply auto
 29.2208 -done
 29.2209 +  by (induct xs) auto
 29.2210  
 29.2211  lemma set_remove1_subset: "set(remove1 x xs) \<subseteq> set xs"
 29.2212 -apply(induct xs)
 29.2213 - apply simp
 29.2214 -apply simp
 29.2215 -apply blast
 29.2216 -done
 29.2217 +  by (induct xs) auto
 29.2218  
 29.2219  lemma set_remove1_eq [simp]: "distinct xs \<Longrightarrow> set(remove1 x xs) = set xs - {x}"
 29.2220 -apply(induct xs)
 29.2221 - apply simp
 29.2222 -apply simp
 29.2223 -apply blast
 29.2224 -done
 29.2225 +  by (induct xs) auto
 29.2226  
 29.2227  lemma length_remove1:
 29.2228    "length(remove1 x xs) = (if x \<in> set xs then length xs - 1 else length xs)"
 29.2229 @@ -4069,9 +4049,7 @@
 29.2230  text\<open>Courtesy of Matthias Daum:\<close>
 29.2231  lemma append_replicate_commute:
 29.2232    "replicate n x @ replicate k x = replicate k x @ replicate n x"
 29.2233 -apply (simp add: replicate_add [symmetric])
 29.2234 -apply (simp add: add.commute)
 29.2235 -done
 29.2236 +  by (metis add.commute replicate_add)
 29.2237  
 29.2238  text\<open>Courtesy of Andreas Lochbihler:\<close>
 29.2239  lemma filter_replicate:
 29.2240 @@ -4092,23 +4070,24 @@
 29.2241  
 29.2242  text\<open>Courtesy of Matthias Daum (2 lemmas):\<close>
 29.2243  lemma take_replicate[simp]: "take i (replicate k x) = replicate (min i k) x"
 29.2244 -apply (case_tac "k \<le> i")
 29.2245 - apply  (simp add: min_def)
 29.2246 -apply (drule not_le_imp_less)
 29.2247 -apply (simp add: min_def)
 29.2248 -apply (subgoal_tac "replicate k x = replicate i x @ replicate (k - i) x")
 29.2249 - apply  simp
 29.2250 -apply (simp add: replicate_add [symmetric])
 29.2251 -done
 29.2252 +proof (cases "k \<le> i")
 29.2253 +  case True
 29.2254 +  then show ?thesis
 29.2255 +    by (simp add: min_def)
 29.2256 +next
 29.2257 +  case False
 29.2258 +  then have "replicate k x = replicate i x @ replicate (k - i) x"
 29.2259 +    by (simp add: replicate_add [symmetric])
 29.2260 +  then show ?thesis
 29.2261 +    by (simp add: min_def)
 29.2262 +qed
 29.2263  
 29.2264  lemma drop_replicate[simp]: "drop i (replicate k x) = replicate (k-i) x"
 29.2265 -apply (induct k arbitrary: i)
 29.2266 - apply simp
 29.2267 -apply clarsimp
 29.2268 -apply (case_tac i)
 29.2269 - apply simp
 29.2270 -apply clarsimp
 29.2271 -done
 29.2272 +proof (induct k arbitrary: i)
 29.2273 +  case (Suc k)
 29.2274 +  then show ?case
 29.2275 +    by (simp add: drop_Cons')
 29.2276 +qed simp
 29.2277  
 29.2278  lemma set_replicate_Suc: "set (replicate (Suc n) x) = {x}"
 29.2279  by (induct n) auto
 29.2280 @@ -4150,11 +4129,11 @@
 29.2281  
 29.2282  lemma replicate_eq_replicate[simp]:
 29.2283    "(replicate m x = replicate n y) \<longleftrightarrow> (m=n \<and> (m\<noteq>0 \<longrightarrow> x=y))"
 29.2284 -apply(induct m arbitrary: n)
 29.2285 - apply simp
 29.2286 -apply(induct_tac n)
 29.2287 -apply auto
 29.2288 -done
 29.2289 +proof (induct m arbitrary: n)
 29.2290 +  case (Suc m n)
 29.2291 +  then show ?case
 29.2292 +    by (induct n) auto
 29.2293 +qed simp
 29.2294  
 29.2295  lemma replicate_length_filter:
 29.2296    "replicate (length (filter (\<lambda>y. x = y) xs)) x = filter (\<lambda>y. x = y) xs"
 29.2297 @@ -4241,10 +4220,7 @@
 29.2298  lemma enumerate_simps [simp, code]:
 29.2299    "enumerate n [] = []"
 29.2300    "enumerate n (x # xs) = (n, x) # enumerate (Suc n) xs"
 29.2301 -apply (auto simp add: enumerate_eq_zip not_le)
 29.2302 -apply (cases "n < n + length xs")
 29.2303 - apply (auto simp add: upt_conv_Cons)
 29.2304 -done
 29.2305 +  by (simp_all add: enumerate_eq_zip upt_rec)
 29.2306  
 29.2307  lemma length_enumerate [simp]:
 29.2308    "length (enumerate n xs) = length xs"
 29.2309 @@ -4290,12 +4266,7 @@
 29.2310  
 29.2311  lemma enumerate_append_eq:
 29.2312    "enumerate n (xs @ ys) = enumerate n xs @ enumerate (n + length xs) ys"
 29.2313 -unfolding enumerate_eq_zip
 29.2314 -apply auto
 29.2315 - apply (subst zip_append [symmetric]) apply simp
 29.2316 - apply (subst upt_add_eq_append [symmetric])
 29.2317 - apply (simp_all add: ac_simps)
 29.2318 -done
 29.2319 +  by (simp add: enumerate_eq_zip add.assoc zip_append2)
 29.2320  
 29.2321  lemma enumerate_map_upt:
 29.2322    "enumerate n (map f [n..<m]) = map (\<lambda>k. (k, f k)) [n..<m]"
 29.2323 @@ -4320,31 +4291,37 @@
 29.2324  lemma rotate1_rotate_swap: "rotate1 (rotate n xs) = rotate n (rotate1 xs)"
 29.2325  by(simp add:rotate_def funpow_swap1)
 29.2326  
 29.2327 -lemma rotate1_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate1 xs = xs"
 29.2328 +lemma rotate1_length01[simp]: "length xs \<le> 1 \<Longrightarrow> rotate1 xs = xs"
 29.2329  by(cases xs) simp_all
 29.2330  
 29.2331 -lemma rotate_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate n xs = xs"
 29.2332 -apply(induct n)
 29.2333 - apply simp
 29.2334 -apply (simp add:rotate_def)
 29.2335 -done
 29.2336 +lemma rotate_length01[simp]: "length xs \<le> 1 \<Longrightarrow> rotate n xs = xs"
 29.2337 +  by (induct n) (simp_all add:rotate_def)
 29.2338  
 29.2339  lemma rotate1_hd_tl: "xs \<noteq> [] \<Longrightarrow> rotate1 xs = tl xs @ [hd xs]"
 29.2340  by (cases xs) simp_all
 29.2341  
 29.2342  lemma rotate_drop_take:
 29.2343    "rotate n xs = drop (n mod length xs) xs @ take (n mod length xs) xs"
 29.2344 -apply(induct n)
 29.2345 - apply simp
 29.2346 -apply(simp add:rotate_def)
 29.2347 -apply(cases "xs = []")
 29.2348 - apply (simp)
 29.2349 -apply(case_tac "n mod length xs = 0")
 29.2350 - apply(simp add:mod_Suc)
 29.2351 - apply(simp add: rotate1_hd_tl drop_Suc take_Suc)
 29.2352 -apply(simp add:mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric]
 29.2353 -                take_hd_drop linorder_not_le)
 29.2354 -done
 29.2355 +proof (induct n)
 29.2356 +  case (Suc n)
 29.2357 +  show ?case
 29.2358 +  proof (cases "xs = []")
 29.2359 +    case False
 29.2360 +    then show ?thesis
 29.2361 +    proof (cases "n mod length xs = 0")
 29.2362 +      case True
 29.2363 +      then show ?thesis
 29.2364 +        apply (simp add: mod_Suc)
 29.2365 +        by (simp add: False Suc.hyps drop_Suc rotate1_hd_tl take_Suc)
 29.2366 +    next
 29.2367 +      case False
 29.2368 +      with \<open>xs \<noteq> []\<close> Suc
 29.2369 +      show ?thesis
 29.2370 +        by (simp add: rotate_def mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric]
 29.2371 +            take_hd_drop linorder_not_le)
 29.2372 +    qed
 29.2373 +  qed simp
 29.2374 +qed simp
 29.2375  
 29.2376  lemma rotate_conv_mod: "rotate n xs = rotate (n mod length xs) xs"
 29.2377  by(simp add:rotate_drop_take)
 29.2378 @@ -4387,11 +4364,14 @@
 29.2379      by(simp add:rotate_drop_take rev_drop rev_take)
 29.2380  qed force
 29.2381  
 29.2382 -lemma hd_rotate_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd(rotate n xs) = xs!(n mod length xs)"
 29.2383 -apply(simp add:rotate_drop_take hd_append hd_drop_conv_nth hd_conv_nth)
 29.2384 -apply(subgoal_tac "length xs \<noteq> 0")
 29.2385 - prefer 2 apply simp
 29.2386 -using mod_less_divisor[of "length xs" n] by arith
 29.2387 +lemma hd_rotate_conv_nth:
 29.2388 +  assumes "xs \<noteq> []" shows "hd(rotate n xs) = xs!(n mod length xs)"
 29.2389 +proof -
 29.2390 +  have "n mod length xs < length xs"
 29.2391 +    using assms by simp
 29.2392 +  then show ?thesis
 29.2393 +    by (metis drop_eq_Nil hd_append2 hd_drop_conv_nth leD rotate_drop_take)
 29.2394 +qed
 29.2395  
 29.2396  lemma rotate_append: "rotate (length l) (l @ q) = q @ l"
 29.2397    by (induct l arbitrary: q) (auto simp add: rotate1_rotate_swap)
 29.2398 @@ -4410,14 +4390,13 @@
 29.2399  by(simp add: nths_def length_filter_conv_card cong:conj_cong)
 29.2400  
 29.2401  lemma nths_shift_lemma_Suc:
 29.2402 -  "map fst (filter (%p. P(Suc(snd p))) (zip xs is)) =
 29.2403 -   map fst (filter (%p. P(snd p)) (zip xs (map Suc is)))"
 29.2404 -apply(induct xs arbitrary: "is")
 29.2405 - apply simp
 29.2406 -apply (case_tac "is")
 29.2407 - apply simp
 29.2408 -apply simp
 29.2409 -done
 29.2410 +  "map fst (filter (\<lambda>p. P(Suc(snd p))) (zip xs is)) =
 29.2411 +   map fst (filter (\<lambda>p. P(snd p)) (zip xs (map Suc is)))"
 29.2412 +proof (induct xs arbitrary: "is")
 29.2413 +  case (Cons x xs "is")
 29.2414 +  show ?case
 29.2415 +    by (cases "is") (auto simp add: Cons.hyps)
 29.2416 +qed simp
 29.2417  
 29.2418  lemma nths_shift_lemma:
 29.2419    "map fst (filter (\<lambda>p. snd p \<in> A) (zip xs [i..<i + length xs])) =
 29.2420 @@ -4426,26 +4405,26 @@
 29.2421  
 29.2422  lemma nths_append:
 29.2423    "nths (l @ l') A = nths l A @ nths l' {j. j + length l \<in> A}"
 29.2424 -apply (unfold nths_def)
 29.2425 -apply (induct l' rule: rev_induct, simp)
 29.2426 -apply (simp add: upt_add_eq_append[of 0] nths_shift_lemma)
 29.2427 -apply (simp add: add.commute)
 29.2428 -done
 29.2429 +  unfolding nths_def
 29.2430 +proof (induct l' rule: rev_induct)
 29.2431 +  case (snoc x xs)
 29.2432 +  then show ?case
 29.2433 +    by (simp add: upt_add_eq_append[of 0] nths_shift_lemma add.commute)
 29.2434 +qed auto
 29.2435  
 29.2436  lemma nths_Cons:
 29.2437    "nths (x # l) A = (if 0 \<in> A then [x] else []) @ nths l {j. Suc j \<in> A}"
 29.2438 -apply (induct l rule: rev_induct)
 29.2439 - apply (simp add: nths_def)
 29.2440 -apply (simp del: append_Cons add: append_Cons[symmetric] nths_append)
 29.2441 -done
 29.2442 +proof (induct l rule: rev_induct)
 29.2443 +  case (snoc x xs)
 29.2444 +  then show ?case
 29.2445 +    by (simp flip: append_Cons add: nths_append)
 29.2446 +qed (auto simp: nths_def)
 29.2447  
 29.2448  lemma nths_map: "nths (map f xs) I = map f (nths xs I)"
 29.2449  by(induction xs arbitrary: I) (simp_all add: nths_Cons)
 29.2450  
 29.2451  lemma set_nths: "set(nths xs I) = {xs!i|i. i<size xs \<and> i \<in> I}"
 29.2452 -apply(induct xs arbitrary: I)
 29.2453 -apply(auto simp: nths_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc)
 29.2454 -done
 29.2455 +  by (induct xs arbitrary: I) (auto simp: nths_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc)
 29.2456  
 29.2457  lemma set_nths_subset: "set(nths xs I) \<subseteq> set xs"
 29.2458  by(auto simp add:set_nths)
 29.2459 @@ -4794,8 +4773,7 @@
 29.2460      show ?thesis
 29.2461        unfolding transpose.simps \<open>i = Suc j\<close> nth_Cons_Suc "3.hyps"[OF j_less]
 29.2462        apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric])
 29.2463 -      apply (rule list.exhaust)
 29.2464 -      by auto
 29.2465 +      by (simp add: nth_tl)
 29.2466    qed
 29.2467  qed simp_all
 29.2468  
 29.2469 @@ -4919,11 +4897,7 @@
 29.2470  qed
 29.2471  
 29.2472  lemma infinite_UNIV_listI: "\<not> finite(UNIV::'a list set)"
 29.2473 -apply (rule notI)
 29.2474 -apply (drule finite_maxlen)
 29.2475 -apply clarsimp
 29.2476 -apply (erule_tac x = "replicate n undefined" in allE)
 29.2477 -by simp
 29.2478 +  by (metis UNIV_I finite_maxlen length_replicate less_irrefl)
 29.2479  
 29.2480  
 29.2481  subsection \<open>Sorting\<close>
 29.2482 @@ -4938,10 +4912,11 @@
 29.2483  by(simp)
 29.2484  
 29.2485  lemma sorted_wrt2: "transp P \<Longrightarrow> sorted_wrt P (x # y # zs) = (P x y \<and> sorted_wrt P (y # zs))"
 29.2486 -apply(induction zs arbitrary: x y)
 29.2487 -apply(auto dest: transpD)
 29.2488 -apply (meson transpD)
 29.2489 -done
 29.2490 +proof (induction zs arbitrary: x y)
 29.2491 +  case (Cons z zs)
 29.2492 +  then show ?case
 29.2493 +    by simp (meson transpD)+
 29.2494 +qed auto
 29.2495  
 29.2496  lemmas sorted_wrt2_simps = sorted_wrt1 sorted_wrt2
 29.2497  
 29.2498 @@ -4971,9 +4946,7 @@
 29.2499  
 29.2500  lemma sorted_wrt_iff_nth_less:
 29.2501    "sorted_wrt P xs = (\<forall>i j. i < j \<longrightarrow> j < length xs \<longrightarrow> P (xs ! i) (xs ! j))"
 29.2502 -apply(induction xs)
 29.2503 -apply(auto simp add: in_set_conv_nth Ball_def nth_Cons split: nat.split)
 29.2504 -done
 29.2505 +  by (induction xs) (auto simp add: in_set_conv_nth Ball_def nth_Cons split: nat.split)
 29.2506  
 29.2507  lemma sorted_wrt_nth_less:
 29.2508    "\<lbrakk> sorted_wrt P xs; i < j; j < length xs \<rbrakk> \<Longrightarrow> P (xs ! i) (xs ! j)"
 29.2509 @@ -4983,10 +4956,11 @@
 29.2510  by(induction n) (auto simp: sorted_wrt_append)
 29.2511  
 29.2512  lemma sorted_wrt_upto[simp]: "sorted_wrt (<) [i..j]"
 29.2513 -apply(induction i j rule: upto.induct)
 29.2514 -apply(subst upto.simps)
 29.2515 -apply(simp)
 29.2516 -done
 29.2517 +proof(induct i j rule:upto.induct)
 29.2518 +  case (1 i j)
 29.2519 +  from this show ?case
 29.2520 +    unfolding upto.simps[of i j] by auto
 29.2521 +qed
 29.2522  
 29.2523  text \<open>Each element is greater or equal to its index:\<close>
 29.2524  
 29.2525 @@ -5315,12 +5289,13 @@
 29.2526  qed
 29.2527  
 29.2528  lemma finite_sorted_distinct_unique:
 29.2529 -shows "finite A \<Longrightarrow> \<exists>!xs. set xs = A \<and> sorted xs \<and> distinct xs"
 29.2530 -apply(drule finite_distinct_list)
 29.2531 -apply clarify
 29.2532 -apply(rule_tac a="sort xs" in ex1I)
 29.2533 -apply (auto simp: sorted_distinct_set_unique)
 29.2534 -done
 29.2535 +  assumes "finite A" shows "\<exists>!xs. set xs = A \<and> sorted xs \<and> distinct xs"
 29.2536 +proof -
 29.2537 +  obtain xs where "distinct xs" "A = set xs"
 29.2538 +    using finite_distinct_list [OF assms] by metis
 29.2539 +  then show ?thesis
 29.2540 +    by (rule_tac a="sort xs" in ex1I) (auto simp: sorted_distinct_set_unique)
 29.2541 +qed
 29.2542  
 29.2543  lemma insort_insert_key_triv:
 29.2544    "f x \<in> f ` set xs \<Longrightarrow> insort_insert_key f x xs = xs"
 29.2545 @@ -5719,7 +5694,7 @@
 29.2546  
 29.2547  lemmas in_listsI [intro!] = in_listspI [to_set]
 29.2548  
 29.2549 -lemma lists_eq_set: "lists A = {xs. set xs <= A}"
 29.2550 +lemma lists_eq_set: "lists A = {xs. set xs \<le> A}"
 29.2551  by auto
 29.2552  
 29.2553  lemma lists_empty [simp]: "lists {} = {[]}"
 29.2554 @@ -5743,12 +5718,12 @@
 29.2555    | insert:  "ListMem x xs \<Longrightarrow> ListMem x (y # xs)"
 29.2556  
 29.2557  lemma ListMem_iff: "(ListMem x xs) = (x \<in> set xs)"
 29.2558 -apply (rule iffI)
 29.2559 - apply (induct set: ListMem)
 29.2560 -  apply auto
 29.2561 -apply (induct xs)
 29.2562 - apply (auto intro: ListMem.intros)
 29.2563 -done
 29.2564 +proof
 29.2565 +  show "ListMem x xs \<Longrightarrow> x \<in> set xs"
 29.2566 +    by (induct set: ListMem) auto
 29.2567 +  show "x \<in> set xs \<Longrightarrow> ListMem x xs"
 29.2568 +    by (induct xs) (auto intro: ListMem.intros)
 29.2569 +qed
 29.2570  
 29.2571  
 29.2572  subsubsection \<open>Lists as Cartesian products\<close>
 29.2573 @@ -5791,20 +5766,23 @@
 29.2574  "lenlex r = inv_image (less_than <*lex*> lex r) (\<lambda>xs. (length xs, xs))"
 29.2575          \<comment> \<open>Compares lists by their length and then lexicographically\<close>
 29.2576  
 29.2577 -lemma wf_lexn: "wf r ==> wf (lexn r n)"
 29.2578 -apply (induct n, simp, simp)
 29.2579 -apply(rule wf_subset)
 29.2580 - prefer 2 apply (rule Int_lower1)
 29.2581 -apply(rule wf_map_prod_image)
 29.2582 - prefer 2 apply (rule inj_onI, auto)
 29.2583 -done
 29.2584 +lemma wf_lexn: assumes "wf r" shows "wf (lexn r n)"
 29.2585 +proof (induct n)
 29.2586 +  case (Suc n)
 29.2587 +  have inj: "inj (\<lambda>(x, xs). x # xs)"
 29.2588 +    using assms by (auto simp: inj_on_def)
 29.2589 +  have wf: "wf (map_prod (\<lambda>(x, xs). x # xs) (\<lambda>(x, xs). x # xs) ` (r <*lex*> lexn r n))"
 29.2590 +    by (simp add: Suc.hyps assms wf_lex_prod wf_map_prod_image [OF _ inj])
 29.2591 +  then show ?case
 29.2592 +    by (rule wf_subset) auto
 29.2593 +qed auto
 29.2594  
 29.2595  lemma lexn_length:
 29.2596    "(xs, ys) \<in> lexn r n \<Longrightarrow> length xs = n \<and> length ys = n"
 29.2597  by (induct n arbitrary: xs ys) auto
 29.2598  
 29.2599  lemma wf_lex [intro!]: "wf r ==> wf (lex r)"
 29.2600 -  apply (unfold lex_def)
 29.2601 +  unfolding lex_def
 29.2602    apply (rule wf_UN)
 29.2603     apply (simp add: wf_lexn)
 29.2604    apply (metis DomainE Int_emptyI RangeE lexn_length)
 29.2605 @@ -5907,14 +5885,12 @@
 29.2606  by (simp add:lex_conv)
 29.2607  
 29.2608  lemma Cons_in_lex [simp]:
 29.2609 -    "((x # xs, y # ys) \<in> lex r) =
 29.2610 +  "((x # xs, y # ys) \<in> lex r) =
 29.2611        ((x, y) \<in> r \<and> length xs = length ys \<or> x = y \<and> (xs, ys) \<in> lex r)"
 29.2612 -apply (simp add: lex_conv)
 29.2613 -apply (rule iffI)
 29.2614 - prefer 2 apply (blast intro: Cons_eq_appendI, clarify)
 29.2615 -apply (case_tac xys, simp, simp)
 29.2616 -apply blast
 29.2617 -  done
 29.2618 +  apply (simp add: lex_conv)
 29.2619 +  apply (rule iffI)
 29.2620 +   prefer 2 apply (blast intro: Cons_eq_appendI, clarify)
 29.2621 +  by (metis hd_append append_Nil list.sel(1) list.sel(3) tl_append2)
 29.2622  
 29.2623  lemma lex_append_rightI:
 29.2624    "(xs, ys) \<in> lex r \<Longrightarrow> length vs = length us \<Longrightarrow> (xs @ us, ys @ vs) \<in> lex r"
 29.2625 @@ -5962,12 +5938,13 @@
 29.2626  by (unfold lexord_def, induct_tac x, auto)
 29.2627  
 29.2628  lemma lexord_cons_cons[simp]:
 29.2629 -     "((a # x, b # y) \<in> lexord r) = ((a,b)\<in> r \<or> (a = b \<and> (x,y)\<in> lexord r))"
 29.2630 -  apply (unfold lexord_def, safe, simp_all)
 29.2631 -  apply (case_tac u, simp, simp)
 29.2632 -  apply (case_tac u, simp, clarsimp, blast, blast, clarsimp)
 29.2633 -  apply (erule_tac x="b # u" in allE)
 29.2634 -  by force
 29.2635 +  "((a # x, b # y) \<in> lexord r) = ((a,b)\<in> r \<or> (a = b \<and> (x,y)\<in> lexord r))"
 29.2636 +  unfolding lexord_def
 29.2637 +  apply (safe, simp_all)
 29.2638 +     apply (metis hd_append list.sel(1))
 29.2639 +    apply (metis hd_append list.sel(1) list.sel(3) tl_append2)
 29.2640 +   apply blast
 29.2641 +  by (meson Cons_eq_appendI)
 29.2642  
 29.2643  lemmas lexord_simps = lexord_Nil_left lexord_Nil_right lexord_cons_cons
 29.2644  
 29.2645 @@ -5991,24 +5968,17 @@
 29.2646       (\<exists>i. i < min(length x)(length y) \<and> take i x = take i y \<and> (x!i,y!i) \<in> r))"
 29.2647    apply (unfold lexord_def Let_def, clarsimp)
 29.2648    apply (rule_tac f = "(% a b. a \<or> b)" in arg_cong2)
 29.2649 +  apply (metis Cons_nth_drop_Suc append_eq_conv_conj drop_all list.simps(3) not_le)
 29.2650    apply auto
 29.2651 -  apply (rule_tac x="hd (drop (length x) y)" in exI)
 29.2652 -  apply (rule_tac x="tl (drop (length x) y)" in exI)
 29.2653 -  apply (erule subst, simp add: min_def)
 29.2654    apply (rule_tac x ="length u" in exI, simp)
 29.2655 -  apply (rule_tac x ="take i x" in exI)
 29.2656 -  apply (rule_tac x ="x ! i" in exI)
 29.2657 -  apply (rule_tac x ="y ! i" in exI, safe)
 29.2658 -  apply (rule_tac x="drop (Suc i) x" in exI)
 29.2659 -  apply (drule sym, simp add: Cons_nth_drop_Suc)
 29.2660 -  apply (rule_tac x="drop (Suc i) y" in exI)
 29.2661 -  by (simp add: Cons_nth_drop_Suc)
 29.2662 +  by (metis id_take_nth_drop)
 29.2663  
 29.2664  \<comment> \<open>lexord is extension of partial ordering List.lex\<close>
 29.2665  lemma lexord_lex: "(x,y) \<in> lex r = ((x,y) \<in> lexord r \<and> length x = length y)"
 29.2666 -  apply (rule_tac x = y in spec)
 29.2667 -  apply (induct_tac x, clarsimp)
 29.2668 -  by (clarify, case_tac x, simp, force)
 29.2669 +proof (induction x arbitrary: y)
 29.2670 +  case (Cons a x y) then show ?case
 29.2671 +    by (cases y) (force+)
 29.2672 +qed auto
 29.2673  
 29.2674  lemma lexord_irreflexive: "\<forall>x. (x,x) \<notin> r \<Longrightarrow> (xs,xs) \<notin> lexord r"
 29.2675  by (induct xs) auto
 29.2676 @@ -6051,12 +6021,15 @@
 29.2677  lemma lexord_transI:  "trans r \<Longrightarrow> trans (lexord r)"
 29.2678  by (rule transI, drule lexord_trans, blast)
 29.2679  
 29.2680 -lemma lexord_linear: "(\<forall>a b. (a,b)\<in> r \<or> a = b \<or> (b,a) \<in> r) \<Longrightarrow> (x,y) \<in> lexord r \<or> x = y \<or> (y,x) \<in> lexord r"
 29.2681 -  apply (rule_tac x = y in spec)
 29.2682 -  apply (induct_tac x, rule allI)
 29.2683 -  apply (case_tac x, simp, simp)
 29.2684 -  apply (rule allI, case_tac x, simp, simp)
 29.2685 -  by blast
 29.2686 +lemma lexord_linear: "(\<forall>a b. (a,b) \<in> r \<or> a = b \<or> (b,a) \<in> r) \<Longrightarrow> (x,y) \<in> lexord r \<or> x = y \<or> (y,x) \<in> lexord r"
 29.2687 +proof (induction x arbitrary: y)
 29.2688 +  case Nil
 29.2689 +  then show ?case
 29.2690 +    by (metis lexord_Nil_left list.exhaust)
 29.2691 +next
 29.2692 +  case (Cons a x y) then show ?case
 29.2693 +    by (cases y) (force+)
 29.2694 +qed 
 29.2695  
 29.2696  lemma lexord_irrefl:
 29.2697    "irrefl R \<Longrightarrow> irrefl (lexord R)"
 29.2698 @@ -6222,27 +6195,17 @@
 29.2699  lemma lexordp_eq_trans:
 29.2700    assumes "lexordp_eq xs ys" and "lexordp_eq ys zs"
 29.2701    shows "lexordp_eq xs zs"
 29.2702 -using assms
 29.2703 -apply(induct arbitrary: zs)
 29.2704 -apply(case_tac [2-3] zs)
 29.2705 -apply auto
 29.2706 -done
 29.2707 +  using assms
 29.2708 +  by (induct arbitrary: zs) (case_tac zs; auto)+
 29.2709  
 29.2710  lemma lexordp_trans:
 29.2711    assumes "lexordp xs ys" "lexordp ys zs"
 29.2712    shows "lexordp xs zs"
 29.2713 -using assms
 29.2714 -apply(induct arbitrary: zs)
 29.2715 -apply(case_tac [2-3] zs)
 29.2716 -apply auto
 29.2717 -done
 29.2718 +  using assms
 29.2719 +  by (induct arbitrary: zs) (case_tac zs; auto)+
 29.2720  
 29.2721  lemma lexordp_linear: "lexordp xs ys \<or> xs = ys \<or> lexordp ys xs"
 29.2722 -proof(induct xs arbitrary: ys)
 29.2723 -  case Nil thus ?case by(cases ys) simp_all
 29.2724 -next
 29.2725 -  case Cons thus ?case by(cases ys) auto
 29.2726 -qed
 29.2727 +  by(induct xs arbitrary: ys; case_tac ys; fastforce)
 29.2728  
 29.2729  lemma lexordp_conv_lexordp_eq: "lexordp xs ys \<longleftrightarrow> lexordp_eq xs ys \<and> \<not> lexordp_eq ys xs"
 29.2730    (is "?lhs \<longleftrightarrow> ?rhs")
 29.2731 @@ -6260,13 +6223,11 @@
 29.2732  by(auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl dest: lexordp_eq_antisym)
 29.2733  
 29.2734  lemma lexordp_eq_linear: "lexordp_eq xs ys \<or> lexordp_eq ys xs"
 29.2735 -apply(induct xs arbitrary: ys)
 29.2736 -apply(case_tac [!] ys)
 29.2737 -apply auto
 29.2738 -done
 29.2739 +  by (induct xs arbitrary: ys) (case_tac ys; auto)+
 29.2740  
 29.2741  lemma lexordp_linorder: "class.linorder lexordp_eq lexordp"
 29.2742 -by unfold_locales(auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl lexordp_eq_antisym intro: lexordp_eq_trans del: disjCI intro: lexordp_eq_linear)
 29.2743 +  by unfold_locales
 29.2744 +     (auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl lexordp_eq_antisym intro: lexordp_eq_trans del: disjCI intro: lexordp_eq_linear)
 29.2745  
 29.2746  end
 29.2747  
 29.2748 @@ -6294,7 +6255,7 @@
 29.2749  lemma measures_less: "f x < f y ==> (x, y) \<in> measures (f#fs)"
 29.2750  by simp
 29.2751  
 29.2752 -lemma measures_lesseq: "f x <= f y ==> (x, y) \<in> measures fs ==> (x, y) \<in> measures (f#fs)"
 29.2753 +lemma measures_lesseq: "f x \<le> f y ==> (x, y) \<in> measures fs ==> (x, y) \<in> measures (f#fs)"
 29.2754  by auto
 29.2755  
 29.2756  
 29.2757 @@ -6404,17 +6365,20 @@
 29.2758  apply (induct arbitrary: xs set: Wellfounded.acc)
 29.2759  apply (erule thin_rl)
 29.2760  apply (erule acc_induct)
 29.2761 -apply (rule accI)
 29.2762 +  apply (rule accI)
 29.2763  apply (blast)
 29.2764  done
 29.2765  
 29.2766  lemma lists_accD: "xs \<in> lists (Wellfounded.acc r) \<Longrightarrow> xs \<in> Wellfounded.acc (listrel1 r)"
 29.2767 -apply (induct set: lists)
 29.2768 - apply (rule accI)
 29.2769 - apply simp
 29.2770 -apply (rule accI)
 29.2771 -apply (fast dest: acc_downward)
 29.2772 -done
 29.2773 +proof (induct set: lists)
 29.2774 +  case Nil
 29.2775 +  then show ?case
 29.2776 +    by (meson acc.intros not_listrel1_Nil)
 29.2777 +next
 29.2778 +  case (Cons a l)
 29.2779 +  then show ?case
 29.2780 +    by blast
 29.2781 +qed
 29.2782  
 29.2783  lemma lists_accI: "xs \<in> Wellfounded.acc (listrel1 r) \<Longrightarrow> xs \<in> lists (Wellfounded.acc r)"
 29.2784  apply (induct set: Wellfounded.acc)
 29.2785 @@ -6461,10 +6425,7 @@
 29.2786  
 29.2787  
 29.2788  lemma listrel_mono: "r \<subseteq> s \<Longrightarrow> listrel r \<subseteq> listrel s"
 29.2789 -apply clarify
 29.2790 -apply (erule listrel.induct)
 29.2791 -apply (blast intro: listrel.intros)+
 29.2792 -done
 29.2793 +  by (meson listrel_iff_nth subrelI subset_eq)
 29.2794  
 29.2795  lemma listrel_subset: "r \<subseteq> A \<times> A \<Longrightarrow> listrel r \<subseteq> lists A \<times> lists A"
 29.2796  apply clarify
 29.2797 @@ -6479,10 +6440,7 @@
 29.2798  done
 29.2799  
 29.2800  lemma listrel_sym: "sym r \<Longrightarrow> sym (listrel r)"
 29.2801 -apply (auto simp add: sym_def)
 29.2802 -apply (erule listrel.induct)
 29.2803 -apply (blast intro: listrel.intros)+
 29.2804 -done
 29.2805 +  by (simp add: listrel_iff_nth sym_def)
 29.2806  
 29.2807  lemma listrel_trans: "trans r \<Longrightarrow> trans (listrel r)"
 29.2808  apply (simp add: trans_def)
 29.2809 @@ -7138,7 +7096,7 @@
 29.2810  lemma subset_code [code]:
 29.2811    "set xs \<le> B \<longleftrightarrow> (\<forall>x\<in>set xs. x \<in> B)"
 29.2812    "A \<le> List.coset ys \<longleftrightarrow> (\<forall>y\<in>set ys. y \<notin> A)"
 29.2813 -  "List.coset [] \<le> set [] \<longleftrightarrow> False"
 29.2814 +  "List.coset [] \<subseteq> set [] \<longleftrightarrow> False"
 29.2815    by auto
 29.2816  
 29.2817  text \<open>A frequent case -- avoid intermediate sets\<close>
 29.2818 @@ -7367,10 +7325,7 @@
 29.2819    "(rel_set A ===> rel_set (list_all2 A) ===> rel_set (list_all2 A))
 29.2820      set_Cons set_Cons"
 29.2821    unfolding rel_fun_def rel_set_def set_Cons_def
 29.2822 -  apply safe
 29.2823 -  apply (simp add: list_all2_Cons1, fast)
 29.2824 -  apply (simp add: list_all2_Cons2, fast)
 29.2825 -  done
 29.2826 +  by (fastforce simp add: list_all2_Cons1 list_all2_Cons2)
 29.2827  
 29.2828  lemma listset_transfer [transfer_rule]:
 29.2829    "(list_all2 (rel_set A) ===> rel_set (list_all2 A)) listset listset"
    30.1 --- a/src/HOL/Number_Theory/Cong.thy	Tue Aug 07 11:39:40 2018 +0200
    30.2 +++ b/src/HOL/Number_Theory/Cong.thy	Sat Aug 11 16:02:55 2018 +0200
    30.3 @@ -395,11 +395,8 @@
    30.4  
    30.5  lemma cong_dvd_modulus_nat: "[x = y] (mod m) \<Longrightarrow> n dvd m \<Longrightarrow> [x = y] (mod n)"
    30.6    for x y :: nat
    30.7 -  apply (auto simp add: cong_iff_lin_nat dvd_def)
    30.8 -  apply (rule_tac x= "k1 * k" in exI)
    30.9 -  apply (rule_tac x= "k2 * k" in exI)
   30.10 -  apply (simp add: field_simps)
   30.11 -  done
   30.12 +  unfolding cong_iff_lin_nat dvd_def
   30.13 +  by (metis mult.commute mult.left_commute)
   30.14  
   30.15  lemma cong_to_1_nat:
   30.16    fixes a :: nat
   30.17 @@ -433,41 +430,36 @@
   30.18    for x y :: nat
   30.19    by (auto simp add: cong_altdef_nat le_imp_diff_is_add elim!: dvdE)
   30.20  
   30.21 +
   30.22  lemma cong_solve_nat:
   30.23    fixes a :: nat
   30.24 -  assumes "a \<noteq> 0"
   30.25    shows "\<exists>x. [a * x = gcd a n] (mod n)"
   30.26 -proof (cases "n = 0")
   30.27 +proof (cases "a = 0 \<or> n = 0")
   30.28    case True
   30.29 -  then show ?thesis by force
   30.30 +  then show ?thesis
   30.31 +    by (force simp add: cong_0_iff cong_sym)
   30.32  next
   30.33    case False
   30.34    then show ?thesis
   30.35 -    using bezout_nat [of a n, OF \<open>a \<noteq> 0\<close>]
   30.36 +    using bezout_nat [of a n]
   30.37      by auto (metis cong_add_rcancel_0_nat cong_mult_self_left)
   30.38  qed
   30.39  
   30.40 -lemma cong_solve_int: "a \<noteq> 0 \<Longrightarrow> \<exists>x. [a * x = gcd a n] (mod n)"
   30.41 -  for a :: int
   30.42 -  apply (cases "n = 0")
   30.43 -   apply (cases "a \<ge> 0")
   30.44 -    apply auto
   30.45 -   apply (rule_tac x = "-1" in exI)
   30.46 -   apply auto
   30.47 -  apply (insert bezout_int [of a n], auto)
   30.48 -  apply (metis cong_iff_lin mult.commute)
   30.49 -  done
   30.50 +lemma cong_solve_int:
   30.51 +  fixes a :: int
   30.52 +  shows "\<exists>x. [a * x = gcd a n] (mod n)"
   30.53 +    by (metis bezout_int cong_iff_lin mult.commute)
   30.54  
   30.55  lemma cong_solve_dvd_nat:
   30.56    fixes a :: nat
   30.57 -  assumes a: "a \<noteq> 0" and b: "gcd a n dvd d"
   30.58 +  assumes "gcd a n dvd d"
   30.59    shows "\<exists>x. [a * x = d] (mod n)"
   30.60  proof -
   30.61 -  from cong_solve_nat [OF a] obtain x where "[a * x = gcd a n](mod n)"
   30.62 +  from cong_solve_nat [of a] obtain x where "[a * x = gcd a n](mod n)"
   30.63      by auto
   30.64    then have "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)"
   30.65      using cong_scalar_left by blast
   30.66 -  also from b have "(d div gcd a n) * gcd a n = d"
   30.67 +  also from assms have "(d div gcd a n) * gcd a n = d"
   30.68      by (rule dvd_div_mult_self)
   30.69    also have "(d div gcd a n) * (a * x) = a * (d div gcd a n * x)"
   30.70      by auto
   30.71 @@ -476,10 +468,11 @@
   30.72  qed
   30.73  
   30.74  lemma cong_solve_dvd_int:
   30.75 -  assumes a: "(a::int) \<noteq> 0" and b: "gcd a n dvd d"
   30.76 +  fixes a::int
   30.77 +  assumes b: "gcd a n dvd d"
   30.78    shows "\<exists>x. [a * x = d] (mod n)"
   30.79  proof -
   30.80 -  from cong_solve_int [OF a] obtain x where "[a * x = gcd a n](mod n)"
   30.81 +  from cong_solve_int [of a] obtain x where "[a * x = gcd a n](mod n)"
   30.82      by auto
   30.83    then have "[(d div gcd a n) * (a * x) = (d div gcd a n) * gcd a n] (mod n)"
   30.84      using cong_scalar_left by blast
   30.85 @@ -493,12 +486,11 @@
   30.86  
   30.87  lemma cong_solve_coprime_nat:
   30.88    "\<exists>x. [a * x = Suc 0] (mod n)" if "coprime a n"
   30.89 -  using that cong_solve_nat [of a n] by (cases "a = 0") simp_all
   30.90 +  using that cong_solve_nat [of a n] by auto
   30.91  
   30.92  lemma cong_solve_coprime_int:
   30.93    "\<exists>x. [a * x = 1] (mod n)" if "coprime a n" for a n x :: int
   30.94 -  using that cong_solve_int [of a n] by (cases "a = 0")
   30.95 -    (auto simp add: zabs_def split: if_splits)
   30.96 +  using that cong_solve_int [of a n] by (auto simp add: zabs_def split: if_splits)
   30.97  
   30.98  lemma coprime_iff_invertible_nat:
   30.99    "coprime a m \<longleftrightarrow> (\<exists>x. [a * x = Suc 0] (mod m))" (is "?P \<longleftrightarrow> ?Q")
  30.100 @@ -529,27 +521,29 @@
  30.101  qed
  30.102  
  30.103  lemma coprime_iff_invertible'_nat:
  30.104 -  "m > 0 \<Longrightarrow> coprime a m \<longleftrightarrow> (\<exists>x. 0 \<le> x \<and> x < m \<and> [a * x = Suc 0] (mod m))"
  30.105 -  apply (subst coprime_iff_invertible_nat)
  30.106 -   apply auto
  30.107 -  apply (auto simp add: cong_def)
  30.108 -  apply (metis mod_less_divisor mod_mult_right_eq)
  30.109 -  done
  30.110 +  assumes "m > 0"
  30.111 +  shows "coprime a m \<longleftrightarrow> (\<exists>x. 0 \<le> x \<and> x < m \<and> [a * x = Suc 0] (mod m))"
  30.112 +proof -
  30.113 +  have "\<And>b. \<lbrakk>0 < m; [a * b = Suc 0] (mod m)\<rbrakk> \<Longrightarrow> \<exists>b'<m. [a * b' = Suc 0] (mod m)"
  30.114 +    by (metis cong_def mod_less_divisor [OF assms] mod_mult_right_eq)
  30.115 +  then show ?thesis
  30.116 +    using assms coprime_iff_invertible_nat by auto
  30.117 +qed
  30.118  
  30.119  lemma coprime_iff_invertible'_int:
  30.120 -  "m > 0 \<Longrightarrow> coprime a m \<longleftrightarrow> (\<exists>x. 0 \<le> x \<and> x < m \<and> [a * x = 1] (mod m))"
  30.121 -  for m :: int
  30.122 -  apply (subst coprime_iff_invertible_int)
  30.123 -   apply (auto simp add: cong_def)
  30.124 -  apply (metis mod_mult_right_eq pos_mod_conj)
  30.125 -  done
  30.126 +  fixes m :: int
  30.127 +  assumes "m > 0"
  30.128 +  shows "coprime a m \<longleftrightarrow> (\<exists>x. 0 \<le> x \<and> x < m \<and> [a * x = 1] (mod m))"
  30.129 +proof -
  30.130 +  have "\<And>b. \<lbrakk>0 < m; [a * b = 1] (mod m)\<rbrakk> \<Longrightarrow> \<exists>b'<m. [a * b' = 1] (mod m)"
  30.131 +    by (meson cong_less_unique_int cong_scalar_left cong_sym cong_trans)
  30.132 +  then show ?thesis
  30.133 +    by (metis assms coprime_iff_invertible_int cong_def cong_mult_lcancel mod_pos_pos_trivial pos_mod_conj)
  30.134 +qed
  30.135  
  30.136  lemma cong_cong_lcm_nat: "[x = y] (mod a) \<Longrightarrow> [x = y] (mod b) \<Longrightarrow> [x = y] (mod lcm a b)"
  30.137    for x y :: nat
  30.138 -  apply (cases "y \<le> x")
  30.139 -   apply (simp add: cong_altdef_nat)
  30.140 -  apply (meson cong_altdef_nat cong_sym lcm_least_iff nat_le_linear)
  30.141 -  done
  30.142 +  by (meson cong_altdef_nat' lcm_least)
  30.143  
  30.144  lemma cong_cong_lcm_int: "[x = y] (mod a) \<Longrightarrow> [x = y] (mod b) \<Longrightarrow> [x = y] (mod lcm a b)"
  30.145    for x y :: int
  30.146 @@ -636,10 +630,7 @@
  30.147  
  30.148  lemma cong_modulus_mult_nat: "[x = y] (mod m * n) \<Longrightarrow> [x = y] (mod m)"
  30.149    for x y :: nat
  30.150 -  apply (cases "y \<le> x")
  30.151 -   apply (auto simp add: cong_altdef_nat elim: dvd_mult_left)
  30.152 -  apply (metis cong_def mod_mult_cong_right)
  30.153 -  done
  30.154 +  by (metis cong_def mod_mult_cong_right)
  30.155  
  30.156  lemma cong_less_modulus_unique_nat: "[x = y] (mod m) \<Longrightarrow> x < m \<Longrightarrow> y < m \<Longrightarrow> x = y"
  30.157    for x y :: nat
  30.158 @@ -651,50 +642,28 @@
  30.159      and nz: "m1 \<noteq> 0" "m2 \<noteq> 0"
  30.160    shows "\<exists>!x. x < m1 * m2 \<and> [x = u1] (mod m1) \<and> [x = u2] (mod m2)"
  30.161  proof -
  30.162 -  from binary_chinese_remainder_nat [OF a] obtain y
  30.163 -    where "[y = u1] (mod m1)" and "[y = u2] (mod m2)"
  30.164 -    by blast
  30.165 +  obtain y where y1: "[y = u1] (mod m1)" and y2: "[y = u2] (mod m2)"
  30.166 +    using binary_chinese_remainder_nat [OF a] by blast
  30.167    let ?x = "y mod (m1 * m2)"
  30.168    from nz have less: "?x < m1 * m2"
  30.169      by auto
  30.170    have 1: "[?x = u1] (mod m1)"
  30.171 -    apply (rule cong_trans)
  30.172 -     prefer 2
  30.173 -     apply (rule \<open>[y = u1] (mod m1)\<close>)
  30.174 -    apply (rule cong_modulus_mult_nat [of _ _ _ m2])
  30.175 -    apply simp
  30.176 -    done
  30.177 +    using y1 mod_mult_cong_right by blast
  30.178    have 2: "[?x = u2] (mod m2)"
  30.179 -    apply (rule cong_trans)
  30.180 -     prefer 2
  30.181 -     apply (rule \<open>[y = u2] (mod m2)\<close>)
  30.182 -    apply (subst mult.commute)
  30.183 -    apply (rule cong_modulus_mult_nat [of _ _ _ m1])
  30.184 -    apply simp
  30.185 -    done
  30.186 -  have "\<forall>z. z < m1 * m2 \<and> [z = u1] (mod m1) \<and> [z = u2] (mod m2) \<longrightarrow> z = ?x"
  30.187 -  proof clarify
  30.188 -    fix z
  30.189 -    assume "z < m1 * m2"
  30.190 -    assume "[z = u1] (mod m1)" and  "[z = u2] (mod m2)"
  30.191 +    using y2 mod_mult_cong_left by blast
  30.192 +  have "z = ?x" if "z < m1 * m2" "[z = u1] (mod m1)"  "[z = u2] (mod m2)" for z
  30.193 +  proof -
  30.194      have "[?x = z] (mod m1)"
  30.195 -      apply (rule cong_trans)
  30.196 -       apply (rule \<open>[?x = u1] (mod m1)\<close>)
  30.197 -      apply (rule cong_sym)
  30.198 -      apply (rule \<open>[z = u1] (mod m1)\<close>)
  30.199 -      done
  30.200 +      by (metis "1" cong_def that(2))
  30.201      moreover have "[?x = z] (mod m2)"
  30.202 -      apply (rule cong_trans)
  30.203 -       apply (rule \<open>[?x = u2] (mod m2)\<close>)
  30.204 -      apply (rule cong_sym)
  30.205 -      apply (rule \<open>[z = u2] (mod m2)\<close>)
  30.206 -      done
  30.207 +      by (metis "2" cong_def that(3))
  30.208      ultimately have "[?x = z] (mod m1 * m2)"
  30.209        using a by (auto intro: coprime_cong_mult_nat simp add: mod_mult_cong_left mod_mult_cong_right)
  30.210      with \<open>z < m1 * m2\<close> \<open>?x < m1 * m2\<close> show "z = ?x"
  30.211        by (auto simp add: cong_def)
  30.212    qed
  30.213 -  with less 1 2 show ?thesis by auto
  30.214 +  with less 1 2 show ?thesis
  30.215 +    by blast
  30.216   qed
  30.217  
  30.218  lemma chinese_remainder_nat:
  30.219 @@ -720,7 +689,7 @@
  30.220      ultimately show "\<exists>a. [a = 1] (mod m i) \<and> [a = 0] (mod prod m (A - {i}))"
  30.221        by blast
  30.222    qed
  30.223 -  then obtain b where b: "\<forall>i \<in> A. [b i = 1] (mod m i) \<and> [b i = 0] (mod (\<Prod>j \<in> A - {i}. m j))"
  30.224 +  then obtain b where b: "\<And>i. i \<in> A \<Longrightarrow> [b i = 1] (mod m i) \<and> [b i = 0] (mod (\<Prod>j \<in> A - {i}. m j))"
  30.225      by blast
  30.226    let ?x = "\<Sum>i\<in>A. (u i) * (b i)"
  30.227    show ?thesis
  30.228 @@ -735,29 +704,32 @@
  30.229          by auto
  30.230        also have "[u i * b i + (\<Sum>j \<in> A - {i}. u j * b j) =
  30.231                    u i * 1 + (\<Sum>j \<in> A - {i}. u j * 0)] (mod m i)"
  30.232 -        apply (rule cong_add)
  30.233 -         apply (rule cong_scalar_left)
  30.234 -        using b a apply blast
  30.235 -        apply (rule cong_sum)
  30.236 -        apply (rule cong_scalar_left)
  30.237 -        using b apply (auto simp add: mod_eq_0_iff_dvd cong_def)
  30.238 -        apply (rule dvd_trans [of _ "prod m (A - {x})" "b x" for x])
  30.239 -        using a fin apply auto
  30.240 -        done
  30.241 +      proof (intro cong_add cong_scalar_left cong_sum)
  30.242 +        show "[b i = 1] (mod m i)"
  30.243 +          using a b by blast
  30.244 +        show "[b x = 0] (mod m i)" if "x \<in> A - {i}" for x
  30.245 +        proof -
  30.246 +          have "x \<in> A" "x \<noteq> i"
  30.247 +            using that by auto
  30.248 +          then show ?thesis
  30.249 +            using a b [OF \<open>x \<in> A\<close>] cong_dvd_modulus_nat fin by blast
  30.250 +        qed
  30.251 +      qed
  30.252        finally show ?thesis
  30.253          by simp
  30.254      qed
  30.255    qed
  30.256  qed
  30.257  
  30.258 -lemma coprime_cong_prod_nat:
  30.259 -  "[x = y] (mod (\<Prod>i\<in>A. m i))"
  30.260 -  if "\<forall>i\<in>A. (\<forall>j\<in>A. i \<noteq> j \<longrightarrow> coprime (m i) (m j))"
  30.261 -    and "\<forall>i\<in>A. [x = y] (mod m i)" for x y :: nat
  30.262 -  using that apply (induct A rule: infinite_finite_induct)
  30.263 -    apply auto
  30.264 -  apply (metis coprime_cong_mult_nat prod_coprime_right)
  30.265 -  done
  30.266 +lemma coprime_cong_prod_nat: "[x = y] (mod (\<Prod>i\<in>A. m i))"
  30.267 +  if "\<And>i j. \<lbrakk>i \<in> A; j \<in> A; i \<noteq> j\<rbrakk> \<Longrightarrow> coprime (m i) (m j)"
  30.268 +    and "\<And>i. i \<in> A \<Longrightarrow> [x = y] (mod m i)" for x y :: nat
  30.269 +  using that 
  30.270 +proof (induct A rule: infinite_finite_induct)
  30.271 +  case (insert x A)
  30.272 +  then show ?case
  30.273 +    by simp (metis coprime_cong_mult_nat prod_coprime_right)
  30.274 +qed auto
  30.275  
  30.276  lemma chinese_remainder_unique_nat:
  30.277    fixes A :: "'a set"
  30.278 @@ -795,94 +767,4 @@
  30.279      by blast
  30.280  qed
  30.281  
  30.282 -
  30.283 -subsection \<open>Aliasses\<close>
  30.284 -
  30.285 -lemma cong_altdef_int:
  30.286 -  "[a = b] (mod m) \<longleftrightarrow> m dvd (a - b)"
  30.287 -  for a b :: int
  30.288 -  by (fact cong_iff_dvd_diff)
  30.289 -
  30.290 -lemma cong_iff_lin_int: "[a = b] (mod m) \<longleftrightarrow> (\<exists>k. b = a + m * k)"
  30.291 -  for a b :: int
  30.292 -  by (fact cong_iff_lin)
  30.293 -
  30.294 -lemma cong_minus_int: "[a = b] (mod - m) \<longleftrightarrow> [a = b] (mod m)"
  30.295 -  for a b :: int
  30.296 -  by (fact cong_modulus_minus_iff)
  30.297 -
  30.298 -lemma cong_add_lcancel_int: "[a + x = a + y] (mod n) \<longleftrightarrow> [x = y] (mod n)"
  30.299 -  for a x y :: int
  30.300 -  by (fact cong_add_lcancel)
  30.301 -
  30.302 -lemma cong_add_rcancel_int: "[x + a = y + a] (mod n) \<longleftrightarrow> [x = y] (mod n)"
  30.303 -  for a x y :: int
  30.304 -  by (fact cong_add_rcancel)
  30.305 -
  30.306 -lemma cong_add_lcancel_0_int:
  30.307 -  "[a + x = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
  30.308 -  for a x :: int
  30.309 -  by (fact cong_add_lcancel_0)
  30.310 -
  30.311 -lemma cong_add_rcancel_0_int:
  30.312 -  "[x + a = a] (mod n) \<longleftrightarrow> [x = 0] (mod n)"
  30.313 -  for a x :: int
  30.314 -  by (fact cong_add_rcancel_0) 
  30.315 -
  30.316 -lemma cong_dvd_modulus_int: "[x = y] (mod m) \<Longrightarrow> n dvd m \<Longrightarrow> [x = y] (mod n)"
  30.317 -  for x y :: int
  30.318 -  by (fact cong_dvd_modulus)
  30.319 -
  30.320 -lemma cong_abs_int:
  30.321 -  "[x = y] (mod \<bar>m\<bar>) \<longleftrightarrow> [x = y] (mod m)"
  30.322 -  for x y :: int
  30.323 -  by (fact cong_abs)
  30.324 -
  30.325 -lemma cong_square_int:
  30.326 -  "prime p \<Longrightarrow> 0 < a \<Longrightarrow> [a * a = 1] (mod p) \<Longrightarrow> [a = 1] (mod p) \<or> [a = - 1] (mod p)"
  30.327 -  for a :: int
  30.328 -  by (fact cong_square)
  30.329 -
  30.330 -lemma cong_mult_rcancel_int:
  30.331 -  "[a * k = b * k] (mod m) \<longleftrightarrow> [a = b] (mod m)"
  30.332 -  if "coprime k m" for a k m :: int
  30.333 -  using that by (fact cong_mult_rcancel)
  30.334 -
  30.335 -lemma cong_mult_lcancel_int:
  30.336 -  "[k * a = k * b] (mod m) = [a = b] (mod m)"
  30.337 -  if "coprime k m" for a k m :: int
  30.338 -  using that by (fact cong_mult_lcancel)
  30.339 -
  30.340 -lemma coprime_cong_mult_int:
  30.341 -  "[a = b] (mod m) \<Longrightarrow> [a = b] (mod n) \<Longrightarrow> coprime m n \<Longrightarrow> [a = b] (mod m * n)"
  30.342 -  for a b :: int
  30.343 -  by (fact coprime_cong_mult)
  30.344 -
  30.345 -lemma cong_gcd_eq_nat: "[a = b] (mod m) \<Longrightarrow> gcd a m = gcd b m"
  30.346 -  for a b :: nat
  30.347 -  by (fact cong_gcd_eq)
  30.348 -
  30.349 -lemma cong_gcd_eq_int: "[a = b] (mod m) \<Longrightarrow> gcd a m = gcd b m"
  30.350 -  for a b :: int
  30.351 -  by (fact cong_gcd_eq)
  30.352 -
  30.353 -lemma cong_imp_coprime_nat: "[a = b] (mod m) \<Longrightarrow> coprime a m \<Longrightarrow> coprime b m"
  30.354 -  for a b :: nat
  30.355 -  by (fact cong_imp_coprime)
  30.356 -
  30.357 -lemma cong_imp_coprime_int: "[a = b] (mod m) \<Longrightarrow> coprime a m \<Longrightarrow> coprime b m"
  30.358 -  for a b :: int
  30.359 -  by (fact cong_imp_coprime)
  30.360 -
  30.361 -lemma cong_cong_prod_coprime_int:
  30.362 -  "[x = y] (mod (\<Prod>i\<in>A. m i))" if
  30.363 -    "(\<forall>i\<in>A. [x = y] (mod m i))"
  30.364 -    "(\<forall>i\<in>A. (\<forall>j\<in>A. i \<noteq> j \<longrightarrow> coprime (m i) (m j)))"
  30.365 -  for x y :: int
  30.366 -  using that by (fact cong_cong_prod_coprime)
  30.367 -
  30.368 -lemma cong_modulus_mult_int: "[x = y] (mod m * n) \<Longrightarrow> [x = y] (mod m)"
  30.369 -  for x y :: int
  30.370 -  by (fact cong_modulus_mult)
  30.371 -
  30.372  end
    31.1 --- a/src/HOL/Number_Theory/Euler_Criterion.thy	Tue Aug 07 11:39:40 2018 +0200
    31.2 +++ b/src/HOL/Number_Theory/Euler_Criterion.thy	Sat Aug 11 16:02:55 2018 +0200
    31.3 @@ -48,8 +48,8 @@
    31.4      have "[nat \<bar>b\<bar> ^ (p - 1) = 1] (mod p)"
    31.5      using p_prime proof (rule fermat_theorem)
    31.6        from b p_a_relprime show "\<not> p dvd nat \<bar>b\<bar>"
    31.7 -        by (auto simp add: cong_altdef_int power2_eq_square)
    31.8 -          (metis cong_altdef_int cong_dvd_iff dvd_mult2) 
    31.9 +        by (auto simp add: cong_iff_dvd_diff power2_eq_square)
   31.10 +          (metis cong_iff_dvd_diff cong_dvd_iff dvd_mult2) 
   31.11      qed
   31.12      then have "nat \<bar>b\<bar> ^ (p - 1) mod p = 1 mod p"
   31.13        by (simp add: cong_def)
   31.14 @@ -90,13 +90,13 @@
   31.15      cong_scalar_right [of "x * y'" 1 "int p" a]
   31.16      by (auto simp add: cong_def ac_simps)
   31.17    moreover have "y \<in> {0 .. int p - 1}" unfolding y_def using p_ge_2 by auto
   31.18 -  hence "y \<in> S1" using calculation cong_altdef_int p_a_relprime S1_def by auto
   31.19 +  hence "y \<in> S1" using calculation cong_iff_dvd_diff p_a_relprime S1_def cong_dvd_iff by fastforce
   31.20    ultimately have "P x y" unfolding P_def by blast
   31.21    moreover {
   31.22      fix y1 y2
   31.23      assume "P x y1" "P x y2"
   31.24      moreover hence "[y1 = y2] (mod p)" unfolding P_def
   31.25 -      using co_xp cong_mult_lcancel_int[of x p y1 y2] cong_sym cong_trans by blast
   31.26 +      using co_xp cong_mult_lcancel[of x p y1 y2] cong_sym cong_trans by blast
   31.27      ultimately have "y1 = y2" unfolding P_def S1_def using cong_less_imp_eq_int by auto
   31.28    }
   31.29    ultimately show ?thesis by blast
   31.30 @@ -200,7 +200,8 @@
   31.31    moreover have "(0::int) ^ ((p - 1) div 2) = 0"
   31.32      using zero_power [of "(p - 1) div 2"] assms(2) by simp
   31.33    ultimately have "[a ^ ((p - 1) div 2) = 0] (mod p)"
   31.34 -    using True assms(1) cong_altdef_int prime_dvd_power_int_iff by auto
   31.35 +    using True assms(1) prime_dvd_power_int_iff
   31.36 +    by (simp add: cong_iff_dvd_diff)
   31.37    then show ?thesis unfolding Legendre_def using True cong_sym
   31.38      by auto
   31.39  next
    32.1 --- a/src/HOL/Number_Theory/Gauss.thy	Tue Aug 07 11:39:40 2018 +0200
    32.2 +++ b/src/HOL/Number_Theory/Gauss.thy	Sat Aug 11 16:02:55 2018 +0200
    32.3 @@ -18,7 +18,7 @@
    32.4  lemma cong_prime_prod_zero_int:
    32.5    "[a * b = 0] (mod p) \<Longrightarrow> prime p \<Longrightarrow> [a = 0] (mod p) \<or> [b = 0] (mod p)"
    32.6    for a :: int
    32.7 -  by (auto simp add: cong_altdef_int prime_dvd_mult_iff)
    32.8 +  by (simp add: cong_0_iff prime_dvd_mult_iff)
    32.9  
   32.10  
   32.11  locale GAUSS =
   32.12 @@ -114,11 +114,11 @@
   32.13      for x y
   32.14    proof -
   32.15      from p_a_relprime have "\<not> p dvd a"
   32.16 -      by (simp add: cong_altdef_int)
   32.17 +      by (simp add: cong_0_iff)
   32.18      with p_prime prime_imp_coprime [of _ "nat \<bar>a\<bar>"]
   32.19      have "coprime a (int p)"
   32.20        by (simp_all add: ac_simps)
   32.21 -    with a cong_mult_rcancel_int [of a "int p" x y] have "[x = y] (mod p)"
   32.22 +    with a cong_mult_rcancel [of a "int p" x y] have "[x = y] (mod p)"
   32.23        by simp
   32.24      with cong_less_imp_eq_int [of x y p] p_minus_one_l
   32.25        order_le_less_trans [of x "(int p - 1) div 2" p]
   32.26 @@ -127,12 +127,8 @@
   32.27        by (metis b c cong_less_imp_eq_int d e zero_less_imp_eq_int of_nat_0_le_iff)
   32.28    qed
   32.29    show ?thesis
   32.30 -    apply (insert p_ge_2 p_a_relprime p_minus_one_l)
   32.31 -    apply (auto simp add: B_def)
   32.32 -    apply (rule ResSet_image)
   32.33 -      apply (auto simp add: A_res)
   32.34 -    apply (auto simp add: A_def *)
   32.35 -    done
   32.36 +    using p_ge_2 p_a_relprime p_minus_one_l
   32.37 +    by (metis "*" A_def A_res B_def GAUSS.ResSet_image GAUSS_axioms greaterThanAtMost_iff odd_p odd_pos of_nat_0_less_iff)
   32.38  qed
   32.39  
   32.40  lemma SR_B_inj: "inj_on (\<lambda>x. x mod p) B"
   32.41 @@ -149,11 +145,11 @@
   32.42      from a have a': "[x * a = y * a](mod p)"
   32.43        using cong_def by blast
   32.44      from p_a_relprime have "\<not>p dvd a"
   32.45 -      by (simp add: cong_altdef_int)
   32.46 +      by (simp add: cong_0_iff)
   32.47      with p_prime prime_imp_coprime [of _ "nat \<bar>a\<bar>"]
   32.48      have "coprime a (int p)"
   32.49        by (simp_all add: ac_simps)  
   32.50 -    with a' cong_mult_rcancel_int [of a "int p" x y]
   32.51 +    with a' cong_mult_rcancel [of a "int p" x y]
   32.52      have "[x = y] (mod p)" by simp
   32.53      with cong_less_imp_eq_int [of x y p] p_minus_one_l
   32.54        order_le_less_trans [of x "(int p - 1) div 2" p]
   32.55 @@ -224,7 +220,7 @@
   32.56    "coprime x p" if "x \<in> A"
   32.57  proof -
   32.58    from A_ncong_p [OF that] have "\<not> int p dvd x"
   32.59 -    by (simp add: cong_altdef_int)
   32.60 +    by (simp add: cong_0_iff)
   32.61    with p_prime show ?thesis
   32.62      by (metis (no_types) coprime_commute prime_imp_coprime prime_nat_int_transfer)
   32.63  qed
   32.64 @@ -370,7 +366,7 @@
   32.65    then have "[prod id A * (-1)^(card E) = prod id A * a^(card A)](mod p)"
   32.66      by (rule cong_trans) (simp add: aux cong del: prod.strong_cong)
   32.67    with A_prod_relprime have "[(- 1) ^ card E = a ^ card A](mod p)"
   32.68 -    by (metis cong_mult_lcancel_int)
   32.69 +    by (metis cong_mult_lcancel)
   32.70    then show ?thesis
   32.71      by (simp add: A_card_eq cong_sym)
   32.72  qed
   32.73 @@ -390,7 +386,8 @@
   32.74    moreover have "(-1::int) ^ (card E) = 1 \<or> (-1::int) ^ (card E) = -1"
   32.75      using neg_one_even_power neg_one_odd_power by blast
   32.76    moreover have "[1 \<noteq> - 1] (mod int p)"
   32.77 -    using cong_altdef_int nonzero_mod_p[of 2] p_odd_int by fastforce
   32.78 +    using cong_iff_dvd_diff [where 'a=int] nonzero_mod_p[of 2] p_odd_int   
   32.79 +    by fastforce
   32.80    ultimately show ?thesis
   32.81      by (auto simp add: cong_sym)
   32.82  qed
    33.1 --- a/src/HOL/Number_Theory/Pocklington.thy	Tue Aug 07 11:39:40 2018 +0200
    33.2 +++ b/src/HOL/Number_Theory/Pocklington.thy	Sat Aug 11 16:02:55 2018 +0200
    33.3 @@ -121,7 +121,7 @@
    33.4    obtain x where x: "x < a * b" "[x = m] (mod a)" "[x = n] (mod b)" "\<forall>y. ?P y \<longrightarrow> y = x"
    33.5      by blast
    33.6    from ma nb x have "coprime x a" "coprime x b"
    33.7 -    using cong_imp_coprime_nat cong_sym by blast+
    33.8 +    using cong_imp_coprime cong_sym by blast+
    33.9    then have "coprime x (a*b)"
   33.10      by simp
   33.11    with x show ?thesis
   33.12 @@ -209,7 +209,7 @@
   33.13      by arith+
   33.14    from mod_less_divisor[of n 1] n01 have onen: "1 mod n = 1"
   33.15      by simp
   33.16 -  from lucas_coprime_lemma[OF n01(3) an1] cong_imp_coprime_nat an1
   33.17 +  from lucas_coprime_lemma[OF n01(3) an1] cong_imp_coprime an1
   33.18    have an: "coprime a n" "coprime (a ^ (n - 1)) n"
   33.19      using \<open>n \<ge> 2\<close> by simp_all
   33.20    have False if H0: "\<exists>m. 0 < m \<and> m < n - 1 \<and> [a ^ m = 1] (mod n)" (is "\<exists>m. ?P m")
   33.21 @@ -716,7 +716,7 @@
   33.22          by simp
   33.23      qed
   33.24      then have b1: "b \<ge> 1" by arith
   33.25 -    from cong_imp_coprime_nat[OF Cong.cong_diff_nat[OF cong_sym [OF b(1)] cong_refl [of 1] b1]]
   33.26 +    from cong_imp_coprime[OF Cong.cong_diff_nat[OF cong_sym [OF b(1)] cong_refl [of 1] b1]]
   33.27        ath b1 b nqr
   33.28      have "coprime (a ^ ((n - 1) div p) - 1) n"
   33.29        by simp
   33.30 @@ -858,7 +858,7 @@
   33.31      have "[a ^ ((n - 1) div p) mod n - 1 = a ^ ((n - 1) div p) - 1] (mod n)"
   33.32        by (simp add: cong_diff_nat)
   33.33      then show ?thesis
   33.34 -      by (metis cong_imp_coprime_nat eq1 p')
   33.35 +      by (metis cong_imp_coprime eq1 p')
   33.36    qed
   33.37    with pocklington[OF n qrn[symmetric] nq2 an1] show ?thesis
   33.38      by blast
    34.1 --- a/src/HOL/Number_Theory/Quadratic_Reciprocity.thy	Tue Aug 07 11:39:40 2018 +0200
    34.2 +++ b/src/HOL/Number_Theory/Quadratic_Reciprocity.thy	Sat Aug 11 16:02:55 2018 +0200
    34.3 @@ -93,7 +93,7 @@
    34.4  
    34.5  lemma Gpq: "GAUSS p q"
    34.6    using p_prime pq_neq p_ge_2 q_prime
    34.7 -  by (auto simp: GAUSS_def cong_altdef_int dest: primes_dvd_imp_eq)
    34.8 +  by (auto simp: GAUSS_def cong_iff_dvd_diff dest: primes_dvd_imp_eq)
    34.9  
   34.10  lemma Gqp: "GAUSS q p"
   34.11    by (simp add: QRqp QR.Gpq)
   34.12 @@ -304,7 +304,7 @@
   34.13    by (simp add: f_2_def)
   34.14  
   34.15  lemma f_2_lemma_2: "[f_2 x = int p - x] (mod p)"
   34.16 -  by (simp add: f_2_def cong_altdef_int)
   34.17 +  by (simp add: f_2_def cong_iff_dvd_diff)
   34.18  
   34.19  lemma f_2_lemma_3: "f_2 x \<in> S \<Longrightarrow> x \<in> f_2 ` S"
   34.20    using f_2_lemma_1[of x] image_eqI[of x f_2 "f_2 x" S] by presburger
    35.1 --- a/src/HOL/Real_Vector_Spaces.thy	Tue Aug 07 11:39:40 2018 +0200
    35.2 +++ b/src/HOL/Real_Vector_Spaces.thy	Sat Aug 11 16:02:55 2018 +0200
    35.3 @@ -1012,6 +1012,9 @@
    35.4  lemma dist_triangle3: "dist x y \<le> dist a x + dist a y"
    35.5    using dist_triangle2 [of x y a] by (simp add: dist_commute)
    35.6  
    35.7 +lemma abs_dist_diff_le: "\<bar>dist a b - dist b c\<bar> \<le> dist a c"
    35.8 +  using dist_triangle3[of b c a] dist_triangle2[of a b c] by simp
    35.9 +
   35.10  lemma dist_pos_lt: "x \<noteq> y \<Longrightarrow> 0 < dist x y"
   35.11    by (simp add: zero_less_dist_iff)
   35.12  
    36.1 --- a/src/HOL/Series.thy	Tue Aug 07 11:39:40 2018 +0200
    36.2 +++ b/src/HOL/Series.thy	Sat Aug 11 16:02:55 2018 +0200
    36.3 @@ -703,6 +703,27 @@
    36.4    qed
    36.5  qed
    36.6  
    36.7 +lemma summable_Cauchy':
    36.8 +  fixes f :: "nat \<Rightarrow> 'a :: banach"
    36.9 +  assumes "eventually (\<lambda>m. \<forall>n\<ge>m. norm (sum f {m..<n}) \<le> g m) sequentially"
   36.10 +  assumes "filterlim g (nhds 0) sequentially"
   36.11 +  shows "summable f"
   36.12 +proof (subst summable_Cauchy, intro allI impI, goal_cases)
   36.13 +  case (1 e)
   36.14 +  from order_tendstoD(2)[OF assms(2) this] and assms(1)
   36.15 +  have "eventually (\<lambda>m. \<forall>n. norm (sum f {m..<n}) < e) at_top"
   36.16 +  proof eventually_elim
   36.17 +    case (elim m)
   36.18 +    show ?case
   36.19 +    proof
   36.20 +      fix n
   36.21 +      from elim show "norm (sum f {m..<n}) < e"
   36.22 +        by (cases "n \<ge> m") auto
   36.23 +    qed
   36.24 +  qed
   36.25 +  thus ?case by (auto simp: eventually_at_top_linorder)
   36.26 +qed
   36.27 +
   36.28  context
   36.29    fixes f :: "nat \<Rightarrow> 'a::banach"
   36.30  begin
    37.1 --- a/src/HOL/Topological_Spaces.thy	Tue Aug 07 11:39:40 2018 +0200
    37.2 +++ b/src/HOL/Topological_Spaces.thy	Sat Aug 11 16:02:55 2018 +0200
    37.3 @@ -2131,6 +2131,9 @@
    37.4  lemma isCont_def: "isCont f a \<longleftrightarrow> f \<midarrow>a\<rightarrow> f a"
    37.5    by (rule continuous_at)
    37.6  
    37.7 +lemma isContD: "isCont f x \<Longrightarrow> f \<midarrow>x\<rightarrow> f x"
    37.8 +  by (simp add: isCont_def)
    37.9 +
   37.10  lemma isCont_cong:
   37.11    assumes "eventually (\<lambda>x. f x = g x) (nhds x)"
   37.12    shows "isCont f x \<longleftrightarrow> isCont g x"
    38.1 --- a/src/HOL/ex/Datatype_Record_Examples.thy	Tue Aug 07 11:39:40 2018 +0200
    38.2 +++ b/src/HOL/ex/Datatype_Record_Examples.thy	Sat Aug 11 16:02:55 2018 +0200
    38.3 @@ -45,4 +45,23 @@
    38.4  lemma "b_set \<lparr> field_1 = True, field_2 = False \<rparr> = {False}"
    38.5    by simp
    38.6  
    38.7 +text \<open>More tests\<close>
    38.8 +
    38.9 +datatype_record ('a, 'b) test1 =
   38.10 +  field_t11 :: 'a
   38.11 +  field_t12 :: 'b
   38.12 +  field_t13 :: nat
   38.13 +  field_t14 :: int
   38.14 +
   38.15 +thm test1.record_simps
   38.16 +
   38.17 +definition ID where "ID x = x"
   38.18 +lemma ID_cong[cong]: "ID x = ID x" by (rule refl)
   38.19 +
   38.20 +lemma "update_field_t11 f (update_field_t12 g (update_field_t11 h x)) = ID (update_field_t12 g (update_field_t11 (\<lambda>x. f (h x)) x))"
   38.21 +  apply (simp only: test1.record_simps)
   38.22 +  apply (subst ID_def)
   38.23 +  apply (rule refl)
   38.24 +  done
   38.25 +
   38.26  end
   38.27 \ No newline at end of file
    39.1 --- a/src/Pure/ROOT	Tue Aug 07 11:39:40 2018 +0200
    39.2 +++ b/src/Pure/ROOT	Sat Aug 11 16:02:55 2018 +0200
    39.3 @@ -4,7 +4,7 @@
    39.4    description {*
    39.5      The Pure logical framework
    39.6    *}
    39.7 -  options [threads = 1]
    39.8 +  options [threads = 1, export_theory]
    39.9    theories
   39.10      Pure (global)
   39.11      ML_Bootstrap (global)
    40.1 --- a/src/Pure/Thy/export_theory.ML	Tue Aug 07 11:39:40 2018 +0200
    40.2 +++ b/src/Pure/Thy/export_theory.ML	Sat Aug 11 16:02:55 2018 +0200
    40.3 @@ -13,6 +13,28 @@
    40.4  structure Export_Theory: EXPORT_THEORY =
    40.5  struct
    40.6  
    40.7 +(* names for bound variables *)
    40.8 +
    40.9 +local
   40.10 +  fun declare_names (Abs (_, _, b)) = declare_names b
   40.11 +    | declare_names (t $ u) = declare_names t #> declare_names u
   40.12 +    | declare_names (Const (c, _)) = Name.declare (Long_Name.base_name c)
   40.13 +    | declare_names (Free (x, _)) = Name.declare x
   40.14 +    | declare_names _ = I;
   40.15 +
   40.16 +  fun variant_abs bs (Abs (x, T, t)) =
   40.17 +        let
   40.18 +          val names = fold Name.declare bs (declare_names t Name.context);
   40.19 +          val x' = #1 (Name.variant x names);
   40.20 +          val t' = variant_abs (x' :: bs) t;
   40.21 +        in Abs (x', T, t') end
   40.22 +    | variant_abs bs (t $ u) = variant_abs bs t $ variant_abs bs u
   40.23 +    | variant_abs _ t = t;
   40.24 +in
   40.25 +  val named_bounds = variant_abs [];
   40.26 +end;
   40.27 +
   40.28 +
   40.29  (* general setup *)
   40.30  
   40.31  fun setup_presentation f =
   40.32 @@ -59,9 +81,12 @@
   40.33              else
   40.34                (case export name decl of
   40.35                  NONE => I
   40.36 -              | SOME body => cons (name, XML.Elem (entity_markup space name, body))))
   40.37 -          |> sort_by #1 |> map #2
   40.38 +              | SOME body =>
   40.39 +                  cons (#serial (Name_Space.the_entry space name),
   40.40 +                    XML.Elem (entity_markup space name, body))))
   40.41 +          |> sort (int_ord o apply2 #1) |> map #2
   40.42          end;
   40.43 +
   40.44        in if null elems then () else export_body thy export_name elems end;
   40.45  
   40.46  
   40.47 @@ -86,7 +111,7 @@
   40.48  
   40.49      val encode_const =
   40.50        let open XML.Encode Term_XML.Encode
   40.51 -      in triple (list string) typ (option term) end;
   40.52 +      in triple (list string) typ (option (term o named_bounds)) end;
   40.53  
   40.54      fun export_const c (T, abbrev) =
   40.55        let
   40.56 @@ -102,31 +127,36 @@
   40.57  
   40.58      (* axioms and facts *)
   40.59  
   40.60 -    val standard_prop_of =
   40.61 -      Thm.transfer thy #>
   40.62 -      Thm.check_hyps (Context.Theory thy) #>
   40.63 -      Drule.sort_constraint_intr_shyps #>
   40.64 -      Thm.full_prop_of;
   40.65 +    fun standard_prop_of raw_thm =
   40.66 +      let
   40.67 +        val thm = raw_thm
   40.68 +          |> Thm.transfer thy
   40.69 +          |> Thm.check_hyps (Context.Theory thy)
   40.70 +          |> Thm.strip_shyps;
   40.71 +        val prop = thm
   40.72 +          |> Thm.full_prop_of
   40.73 +          |> Term_Subst.zero_var_indexes;
   40.74 +      in (Thm.extra_shyps thm, prop) end;
   40.75  
   40.76 -    val encode_props =
   40.77 -      let open XML.Encode Term_XML.Encode
   40.78 -      in triple (list (pair string sort)) (list (pair string typ)) (list term) end;
   40.79 +    fun encode_prop (Ss, prop) =
   40.80 +      let
   40.81 +        val prop' = Logic.unvarify_global (named_bounds prop);
   40.82 +        val typargs = rev (Term.add_tfrees prop' []);
   40.83 +        val sorts = Name.invent (Name.make_context (map #1 typargs)) Name.aT (length Ss) ~~ Ss;
   40.84 +        val args = rev (Term.add_frees prop' []);
   40.85 +      in
   40.86 +        (sorts @ typargs, args, prop') |>
   40.87 +          let open XML.Encode Term_XML.Encode
   40.88 +          in triple (list (pair string sort)) (list (pair string typ)) term end
   40.89 +      end;
   40.90  
   40.91 -    fun export_props props =
   40.92 -      let
   40.93 -        val props' = map Logic.unvarify_global props;
   40.94 -        val typargs = rev (fold Term.add_tfrees props' []);
   40.95 -        val args = rev (fold Term.add_frees props' []);
   40.96 -      in encode_props (typargs, args, props') end;
   40.97 -
   40.98 -    val export_axiom = export_props o single;
   40.99 -    val export_fact = export_props o Term_Subst.zero_var_indexes_list o map standard_prop_of;
  40.100 +    val encode_fact = XML.Encode.list encode_prop o map standard_prop_of;
  40.101  
  40.102      val _ =
  40.103 -      export_entities "axioms" (K (SOME o export_axiom)) Theory.axiom_space
  40.104 +      export_entities "axioms" (fn _ => fn t => SOME (encode_prop ([], t))) Theory.axiom_space
  40.105          (Theory.axioms_of thy);
  40.106      val _ =
  40.107 -      export_entities "facts" (K (SOME o export_fact)) (Facts.space_of o Global_Theory.facts_of)
  40.108 +      export_entities "facts" (K (SOME o encode_fact)) (Facts.space_of o Global_Theory.facts_of)
  40.109          (Facts.dest_static true [] (Global_Theory.facts_of thy));
  40.110  
  40.111  
  40.112 @@ -134,7 +164,7 @@
  40.113  
  40.114      val encode_class =
  40.115        let open XML.Encode Term_XML.Encode
  40.116 -      in pair (list (pair string typ)) (list term) end;
  40.117 +      in pair (list (pair string typ)) (list (term o named_bounds)) end;
  40.118  
  40.119      fun export_class name =
  40.120        (case try (Axclass.get_info thy) name of
    41.1 --- a/src/Pure/Thy/export_theory.scala	Tue Aug 07 11:39:40 2018 +0200
    41.2 +++ b/src/Pure/Thy/export_theory.scala	Sat Aug 11 16:02:55 2018 +0200
    41.3 @@ -66,8 +66,8 @@
    41.4    sealed case class Theory(name: String, parents: List[String],
    41.5      types: List[Type],
    41.6      consts: List[Const],
    41.7 -    axioms: List[Axiom],
    41.8 -    facts: List[Fact],
    41.9 +    axioms: List[Fact_Single],
   41.10 +    facts: List[Fact_Multi],
   41.11      classes: List[Class],
   41.12      typedefs: List[Typedef],
   41.13      classrel: List[Classrel],
   41.14 @@ -75,6 +75,14 @@
   41.15    {
   41.16      override def toString: String = name
   41.17  
   41.18 +    lazy val entities: Set[Long] =
   41.19 +      Set.empty[Long] ++
   41.20 +        types.iterator.map(_.entity.serial) ++
   41.21 +        consts.iterator.map(_.entity.serial) ++
   41.22 +        axioms.iterator.map(_.entity.serial) ++
   41.23 +        facts.iterator.map(_.entity.serial) ++
   41.24 +        classes.iterator.map(_.entity.serial)
   41.25 +
   41.26      def cache(cache: Term.Cache): Theory =
   41.27        Theory(cache.string(name),
   41.28          parents.map(cache.string(_)),
   41.29 @@ -122,18 +130,41 @@
   41.30      if (cache.isDefined) theory.cache(cache.get) else theory
   41.31    }
   41.32  
   41.33 +  def read_pure_theory(store: Sessions.Store, cache: Option[Term.Cache] = None): Theory =
   41.34 +  {
   41.35 +    val session_name = Thy_Header.PURE
   41.36 +    val theory_name = Thy_Header.PURE
   41.37 +
   41.38 +    using(store.open_database(session_name))(db =>
   41.39 +    {
   41.40 +      db.transaction {
   41.41 +        read_theory(Export.Provider.database(db, session_name, theory_name),
   41.42 +          session_name, theory_name, cache = cache)
   41.43 +      }
   41.44 +    })
   41.45 +  }
   41.46 +
   41.47  
   41.48    /* entities */
   41.49  
   41.50 -  sealed case class Entity(name: String, serial: Long, pos: Position.T)
   41.51 +  object Kind extends Enumeration
   41.52    {
   41.53 -    override def toString: String = name
   41.54 +    val TYPE = Value("type")
   41.55 +    val CONST = Value("const")
   41.56 +    val AXIOM = Value("axiom")
   41.57 +    val FACT = Value("fact")
   41.58 +    val CLASS = Value("class")
   41.59 +  }
   41.60 +
   41.61 +  sealed case class Entity(kind: Kind.Value, name: String, serial: Long, pos: Position.T)
   41.62 +  {
   41.63 +    override def toString: String = kind.toString + " " + quote(name)
   41.64  
   41.65      def cache(cache: Term.Cache): Entity =
   41.66 -      Entity(cache.string(name), serial, cache.position(pos))
   41.67 +      Entity(kind, cache.string(name), serial, cache.position(pos))
   41.68    }
   41.69  
   41.70 -  def decode_entity(tree: XML.Tree): (Entity, XML.Body) =
   41.71 +  def decode_entity(kind: Kind.Value, tree: XML.Tree): (Entity, XML.Body) =
   41.72    {
   41.73      def err(): Nothing = throw new XML.XML_Body(List(tree))
   41.74  
   41.75 @@ -142,7 +173,7 @@
   41.76          val name = Markup.Name.unapply(props) getOrElse err()
   41.77          val serial = Markup.Serial.unapply(props) getOrElse err()
   41.78          val pos = props.filter({ case (a, _) => Markup.POSITION_PROPERTIES(a) })
   41.79 -        (Entity(name, serial, pos), body)
   41.80 +        (Entity(kind, name, serial, pos), body)
   41.81        case _ => err()
   41.82      }
   41.83    }
   41.84 @@ -161,7 +192,7 @@
   41.85    def read_types(provider: Export.Provider): List[Type] =
   41.86      provider.uncompressed_yxml(export_prefix + "types").map((tree: XML.Tree) =>
   41.87        {
   41.88 -        val (entity, body) = decode_entity(tree)
   41.89 +        val (entity, body) = decode_entity(Kind.TYPE, tree)
   41.90          val (args, abbrev) =
   41.91          {
   41.92            import XML.Decode._
   41.93 @@ -186,7 +217,7 @@
   41.94    def read_consts(provider: Export.Provider): List[Const] =
   41.95      provider.uncompressed_yxml(export_prefix + "consts").map((tree: XML.Tree) =>
   41.96        {
   41.97 -        val (entity, body) = decode_entity(tree)
   41.98 +        val (entity, body) = decode_entity(Kind.CONST, tree)
   41.99          val (args, typ, abbrev) =
  41.100          {
  41.101            import XML.Decode._
  41.102 @@ -196,56 +227,65 @@
  41.103        })
  41.104  
  41.105  
  41.106 -  /* axioms and facts */
  41.107 +  /* facts */
  41.108  
  41.109 -  def decode_props(body: XML.Body):
  41.110 -    (List[(String, Term.Sort)], List[(String, Term.Typ)], List[Term.Term]) =
  41.111 +  sealed case class Prop(
  41.112 +    typargs: List[(String, Term.Sort)],
  41.113 +    args: List[(String, Term.Typ)],
  41.114 +    term: Term.Term)
  41.115    {
  41.116 -    import XML.Decode._
  41.117 -    import Term_XML.Decode._
  41.118 -    triple(list(pair(string, sort)), list(pair(string, typ)), list(term))(body)
  41.119 +    def cache(cache: Term.Cache): Prop =
  41.120 +      Prop(
  41.121 +        typargs.map({ case (name, sort) => (cache.string(name), cache.sort(sort)) }),
  41.122 +        args.map({ case (name, typ) => (cache.string(name), cache.typ(typ)) }),
  41.123 +        cache.term(term))
  41.124    }
  41.125  
  41.126 -  sealed case class Axiom(
  41.127 -    entity: Entity,
  41.128 -    typargs: List[(String, Term.Sort)],
  41.129 -    args: List[(String, Term.Typ)],
  41.130 -    prop: Term.Term)
  41.131 +  def decode_prop(body: XML.Body): Prop =
  41.132    {
  41.133 -    def cache(cache: Term.Cache): Axiom =
  41.134 -      Axiom(entity.cache(cache),
  41.135 -        typargs.map({ case (name, sort) => (cache.string(name), cache.sort(sort)) }),
  41.136 -        args.map({ case (name, typ) => (cache.string(name), cache.typ(typ)) }),
  41.137 -        cache.term(prop))
  41.138 +    val (typargs, args, t) =
  41.139 +    {
  41.140 +      import XML.Decode._
  41.141 +      import Term_XML.Decode._
  41.142 +      triple(list(pair(string, sort)), list(pair(string, typ)), term)(body)
  41.143 +    }
  41.144 +    Prop(typargs, args, t)
  41.145    }
  41.146  
  41.147 -  def read_axioms(provider: Export.Provider): List[Axiom] =
  41.148 +  sealed case class Fact_Single(entity: Entity, prop: Prop)
  41.149 +  {
  41.150 +    def cache(cache: Term.Cache): Fact_Single =
  41.151 +      Fact_Single(entity.cache(cache), prop.cache(cache))
  41.152 +  }
  41.153 +
  41.154 +  sealed case class Fact_Multi(entity: Entity, props: List[Prop])
  41.155 +  {
  41.156 +    def cache(cache: Term.Cache): Fact_Multi =
  41.157 +      Fact_Multi(entity.cache(cache), props.map(_.cache(cache)))
  41.158 +
  41.159 +    def split: List[Fact_Single] =
  41.160 +      props match {
  41.161 +        case List(prop) => List(Fact_Single(entity, prop))
  41.162 +        case _ =>
  41.163 +          for ((prop, i) <- props.zipWithIndex)
  41.164 +          yield Fact_Single(entity.copy(name = entity.name + "(" + (i + 1) + ")"), prop)
  41.165 +      }
  41.166 +  }
  41.167 +
  41.168 +  def read_axioms(provider: Export.Provider): List[Fact_Single] =
  41.169      provider.uncompressed_yxml(export_prefix + "axioms").map((tree: XML.Tree) =>
  41.170        {
  41.171 -        val (entity, body) = decode_entity(tree)
  41.172 -        val (typargs, args, List(prop)) = decode_props(body)
  41.173 -        Axiom(entity, typargs, args, prop)
  41.174 +        val (entity, body) = decode_entity(Kind.AXIOM, tree)
  41.175 +        val prop = decode_prop(body)
  41.176 +        Fact_Single(entity, prop)
  41.177        })
  41.178  
  41.179 -  sealed case class Fact(
  41.180 -    entity: Entity,
  41.181 -    typargs: List[(String, Term.Sort)],
  41.182 -    args: List[(String, Term.Typ)],
  41.183 -    props: List[Term.Term])
  41.184 -  {
  41.185 -    def cache(cache: Term.Cache): Fact =
  41.186 -      Fact(entity.cache(cache),
  41.187 -        typargs.map({ case (name, sort) => (cache.string(name), cache.sort(sort)) }),
  41.188 -        args.map({ case (name, typ) => (cache.string(name), cache.typ(typ)) }),
  41.189 -        props.map(cache.term(_)))
  41.190 -  }
  41.191 -
  41.192 -  def read_facts(provider: Export.Provider): List[Fact] =
  41.193 +  def read_facts(provider: Export.Provider): List[Fact_Multi] =
  41.194      provider.uncompressed_yxml(export_prefix + "facts").map((tree: XML.Tree) =>
  41.195        {
  41.196 -        val (entity, body) = decode_entity(tree)
  41.197 -        val (typargs, args, props) = decode_props(body)
  41.198 -        Fact(entity, typargs, args, props)
  41.199 +        val (entity, body) = decode_entity(Kind.FACT, tree)
  41.200 +        val props = XML.Decode.list(decode_prop)(body)
  41.201 +        Fact_Multi(entity, props)
  41.202        })
  41.203  
  41.204  
  41.205 @@ -263,7 +303,7 @@
  41.206    def read_classes(provider: Export.Provider): List[Class] =
  41.207      provider.uncompressed_yxml(export_prefix + "classes").map((tree: XML.Tree) =>
  41.208        {
  41.209 -        val (entity, body) = decode_entity(tree)
  41.210 +        val (entity, body) = decode_entity(Kind.CLASS, tree)
  41.211          val (params, axioms) =
  41.212          {
  41.213            import XML.Decode._
    42.1 --- a/src/Pure/build-jars	Tue Aug 07 11:39:40 2018 +0200
    42.2 +++ b/src/Pure/build-jars	Sat Aug 11 16:02:55 2018 +0200
    42.3 @@ -159,6 +159,7 @@
    42.4    Tools/update_then.scala
    42.5    Tools/update_theorems.scala
    42.6    library.scala
    42.7 +  pure_thy.scala
    42.8    term.scala
    42.9    term_xml.scala
   42.10    ../Tools/Graphview/graph_file.scala
    43.1 --- a/src/Pure/drule.ML	Tue Aug 07 11:39:40 2018 +0200
    43.2 +++ b/src/Pure/drule.ML	Sat Aug 11 16:02:55 2018 +0200
    43.3 @@ -98,8 +98,6 @@
    43.4    val is_sort_constraint: term -> bool
    43.5    val sort_constraintI: thm
    43.6    val sort_constraint_eq: thm
    43.7 -  val sort_constraint_intr: indexname * sort -> thm -> thm
    43.8 -  val sort_constraint_intr_shyps: thm -> thm
    43.9    val with_subgoal: int -> (thm -> thm) -> thm -> thm
   43.10    val comp_no_flatten: thm * int -> int -> thm -> thm
   43.11    val rename_bvars: (string * string) list -> thm -> thm
   43.12 @@ -649,26 +647,6 @@
   43.13          (Thm.unvarify_global (Context.the_global_context ()) sort_constraintI)))
   43.14        (implies_intr_list [A, C] (Thm.assume A)));
   43.15  
   43.16 -val sort_constraint_eq' = Thm.symmetric sort_constraint_eq;
   43.17 -
   43.18 -fun sort_constraint_intr tvar thm =
   43.19 -  Thm.equal_elim
   43.20 -    (Thm.instantiate
   43.21 -      ([((("'a", 0), []), Thm.global_ctyp_of (Thm.theory_of_thm thm) (TVar tvar))],
   43.22 -       [((("A", 0), propT), Thm.cprop_of thm)])
   43.23 -      sort_constraint_eq') thm;
   43.24 -
   43.25 -fun sort_constraint_intr_shyps raw_thm =
   43.26 -  let val thm = Thm.strip_shyps raw_thm in
   43.27 -    (case Thm.extra_shyps thm of
   43.28 -      [] => thm
   43.29 -    | shyps =>
   43.30 -        let
   43.31 -          val names = Name.make_context (map #1 (Thm.fold_terms Term.add_tvar_names thm []));
   43.32 -          val constraints = map (rpair 0) (Name.invent names Name.aT (length shyps)) ~~ shyps;
   43.33 -        in Thm.strip_shyps (fold_rev sort_constraint_intr constraints thm) end)
   43.34 -  end;
   43.35 -
   43.36  end;
   43.37  
   43.38  
    44.1 --- a/src/Pure/library.scala	Tue Aug 07 11:39:40 2018 +0200
    44.2 +++ b/src/Pure/library.scala	Sat Aug 11 16:02:55 2018 +0200
    44.3 @@ -259,6 +259,15 @@
    44.4      result.toList
    44.5    }
    44.6  
    44.7 +  def replicate[A](n: Int, a: A): List[A] =
    44.8 +    if (n < 0) throw new IllegalArgumentException
    44.9 +    else if (n == 0) Nil
   44.10 +    else {
   44.11 +      val res = new mutable.ListBuffer[A]
   44.12 +      (1 to n).foreach(_ => res += a)
   44.13 +      res.toList
   44.14 +    }
   44.15 +
   44.16  
   44.17    /* proper values */
   44.18  
    45.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    45.2 +++ b/src/Pure/pure_thy.scala	Sat Aug 11 16:02:55 2018 +0200
    45.3 @@ -0,0 +1,20 @@
    45.4 +/*  Title:      Pure/pure_thy.scala
    45.5 +    Author:     Makarius
    45.6 +
    45.7 +Pure theory content.
    45.8 +*/
    45.9 +
   45.10 +package isabelle
   45.11 +
   45.12 +
   45.13 +object Pure_Thy
   45.14 +{
   45.15 +  val DUMMY: String = "dummy"
   45.16 +  val FUN: String = "fun"
   45.17 +  val PROP: String = "prop"
   45.18 +  val ITSELF: String = "itself"
   45.19 +
   45.20 +  val ALL: String = "Pure.all"
   45.21 +  val IMP: String = "Pure.imp"
   45.22 +  val EQ: String = "Pure.eq"
   45.23 +}