merged
authorpaulson
Thu Jun 14 15:20:20 2018 +0100 (5 months ago)
changeset 684483d1517f3ba49
parent 68442 477b3f7067c9
parent 68447 0beb927eed89
child 68449 6d0f1a5a16ea
merged
src/HOL/Algebra/More_Finite_Product.thy
src/HOL/Algebra/More_Group.thy
src/HOL/Algebra/More_Ring.thy
     1.1 --- a/src/HOL/Algebra/AbelCoset.thy	Thu Jun 14 15:45:53 2018 +0200
     1.2 +++ b/src/HOL/Algebra/AbelCoset.thy	Thu Jun 14 15:20:20 2018 +0100
     1.3 @@ -17,45 +17,42 @@
     1.4  
     1.5  definition
     1.6    a_r_coset    :: "[_, 'a set, 'a] \<Rightarrow> 'a set"    (infixl "+>\<index>" 60)
     1.7 -  where "a_r_coset G = r_coset \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
     1.8 +  where "a_r_coset G = r_coset (add_monoid G)"
     1.9  
    1.10  definition
    1.11    a_l_coset    :: "[_, 'a, 'a set] \<Rightarrow> 'a set"    (infixl "<+\<index>" 60)
    1.12 -  where "a_l_coset G = l_coset \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
    1.13 +  where "a_l_coset G = l_coset (add_monoid G)"
    1.14  
    1.15  definition
    1.16    A_RCOSETS  :: "[_, 'a set] \<Rightarrow> ('a set)set"   ("a'_rcosets\<index> _" [81] 80)
    1.17 -  where "A_RCOSETS G H = RCOSETS \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> H"
    1.18 +  where "A_RCOSETS G H = RCOSETS (add_monoid G) H"
    1.19  
    1.20  definition
    1.21    set_add  :: "[_, 'a set ,'a set] \<Rightarrow> 'a set" (infixl "<+>\<index>" 60)
    1.22 -  where "set_add G = set_mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
    1.23 +  where "set_add G = set_mult (add_monoid G)"
    1.24  
    1.25  definition
    1.26    A_SET_INV :: "[_,'a set] \<Rightarrow> 'a set"  ("a'_set'_inv\<index> _" [81] 80)
    1.27 -  where "A_SET_INV G H = SET_INV \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> H"
    1.28 +  where "A_SET_INV G H = SET_INV (add_monoid G) H"
    1.29  
    1.30  definition
    1.31    a_r_congruent :: "[('a,'b)ring_scheme, 'a set] \<Rightarrow> ('a*'a)set"  ("racong\<index>")
    1.32 -  where "a_r_congruent G = r_congruent \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
    1.33 +  where "a_r_congruent G = r_congruent (add_monoid G)"
    1.34  
    1.35  definition
    1.36    A_FactGroup :: "[('a,'b) ring_scheme, 'a set] \<Rightarrow> ('a set) monoid" (infixl "A'_Mod" 65)
    1.37      \<comment> \<open>Actually defined for groups rather than monoids\<close>
    1.38 -  where "A_FactGroup G H = FactGroup \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> H"
    1.39 +  where "A_FactGroup G H = FactGroup (add_monoid G) H"
    1.40  
    1.41  definition
    1.42    a_kernel :: "('a, 'm) ring_scheme \<Rightarrow> ('b, 'n) ring_scheme \<Rightarrow>  ('a \<Rightarrow> 'b) \<Rightarrow> 'a set"
    1.43      \<comment> \<open>the kernel of a homomorphism (additive)\<close>
    1.44 -  where "a_kernel G H h =
    1.45 -    kernel \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>
    1.46 -      \<lparr>carrier = carrier H, mult = add H, one = zero H\<rparr> h"
    1.47 +  where "a_kernel G H h = kernel (add_monoid G) (add_monoid H) h"
    1.48  
    1.49  locale abelian_group_hom = G?: abelian_group G + H?: abelian_group H
    1.50      for G (structure) and H (structure) +
    1.51    fixes h
    1.52 -  assumes a_group_hom: "group_hom \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>
    1.53 -                                  \<lparr>carrier = carrier H, mult = add H, one = zero H\<rparr> h"
    1.54 +  assumes a_group_hom: "group_hom (add_monoid G) (add_monoid H) h"
    1.55  
    1.56  lemmas a_r_coset_defs =
    1.57    a_r_coset_def r_coset_def
    1.58 @@ -63,8 +60,7 @@
    1.59  lemma a_r_coset_def':
    1.60    fixes G (structure)
    1.61    shows "H +> a \<equiv> \<Union>h\<in>H. {h \<oplus> a}"
    1.62 -unfolding a_r_coset_defs
    1.63 -by simp
    1.64 +  unfolding a_r_coset_defs by simp
    1.65  
    1.66  lemmas a_l_coset_defs =
    1.67    a_l_coset_def l_coset_def
    1.68 @@ -72,8 +68,7 @@
    1.69  lemma a_l_coset_def':
    1.70    fixes G (structure)
    1.71    shows "a <+ H \<equiv> \<Union>h\<in>H. {a \<oplus> h}"
    1.72 -unfolding a_l_coset_defs
    1.73 -by simp
    1.74 +  unfolding a_l_coset_defs by simp
    1.75  
    1.76  lemmas A_RCOSETS_defs =
    1.77    A_RCOSETS_def RCOSETS_def
    1.78 @@ -81,8 +76,7 @@
    1.79  lemma A_RCOSETS_def':
    1.80    fixes G (structure)
    1.81    shows "a_rcosets H \<equiv> \<Union>a\<in>carrier G. {H +> a}"
    1.82 -unfolding A_RCOSETS_defs
    1.83 -by (fold a_r_coset_def, simp)
    1.84 +  unfolding A_RCOSETS_defs by (fold a_r_coset_def, simp)
    1.85  
    1.86  lemmas set_add_defs =
    1.87    set_add_def set_mult_def
    1.88 @@ -90,8 +84,7 @@
    1.89  lemma set_add_def':
    1.90    fixes G (structure)
    1.91    shows "H <+> K \<equiv> \<Union>h\<in>H. \<Union>k\<in>K. {h \<oplus> k}"
    1.92 -unfolding set_add_defs
    1.93 -by simp
    1.94 +  unfolding set_add_defs by simp
    1.95  
    1.96  lemmas A_SET_INV_defs =
    1.97    A_SET_INV_def SET_INV_def
    1.98 @@ -99,18 +92,53 @@
    1.99  lemma A_SET_INV_def':
   1.100    fixes G (structure)
   1.101    shows "a_set_inv H \<equiv> \<Union>h\<in>H. {\<ominus> h}"
   1.102 -unfolding A_SET_INV_defs
   1.103 -by (fold a_inv_def)
   1.104 +  unfolding A_SET_INV_defs by (fold a_inv_def)
   1.105  
   1.106  
   1.107  subsubsection \<open>Cosets\<close>
   1.108  
   1.109 +sublocale abelian_group <
   1.110 +        add: group "(add_monoid G)"
   1.111 +  rewrites "carrier (add_monoid G) =   carrier G"
   1.112 +       and "   mult (add_monoid G) =       add G"
   1.113 +       and "    one (add_monoid G) =      zero G"
   1.114 +       and "  m_inv (add_monoid G) =     a_inv G"
   1.115 +       and "finprod (add_monoid G) =    finsum G"
   1.116 +       and "r_coset (add_monoid G) = a_r_coset G"
   1.117 +       and "l_coset (add_monoid G) = a_l_coset G"
   1.118 +       and "(\<lambda>a k. pow (add_monoid G) a k) = (\<lambda>a k. add_pow G k a)"
   1.119 +  by (rule a_group)
   1.120 +     (auto simp: m_inv_def a_inv_def finsum_def a_r_coset_def a_l_coset_def add_pow_def)
   1.121 +
   1.122 +context abelian_group
   1.123 +begin
   1.124 +
   1.125 +thm add.coset_mult_assoc
   1.126 +lemmas a_repr_independence' = add.repr_independence
   1.127 +
   1.128 +(*
   1.129 +lemmas a_coset_add_assoc = add.coset_mult_assoc
   1.130 +lemmas a_coset_add_zero [simp] = add.coset_mult_one
   1.131 +lemmas a_coset_add_inv1 = add.coset_mult_inv1
   1.132 +lemmas a_coset_add_inv2 = add.coset_mult_inv2
   1.133 +lemmas a_coset_join1 = add.coset_join1
   1.134 +lemmas a_coset_join2 = add.coset_join2
   1.135 +lemmas a_solve_equation = add.solve_equation
   1.136 +lemmas a_repr_independence = add.repr_independence
   1.137 +lemmas a_rcosI = add.rcosI
   1.138 +lemmas a_rcosetsI = add.rcosetsI
   1.139 +*)
   1.140 +
   1.141 +end
   1.142 +
   1.143  lemma (in abelian_group) a_coset_add_assoc:
   1.144       "[| M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G |]
   1.145        ==> (M +> g) +> h = M +> (g \<oplus> h)"
   1.146  by (rule group.coset_mult_assoc [OF a_group,
   1.147      folded a_r_coset_def, simplified monoid_record_simps])
   1.148  
   1.149 +thm abelian_group.a_coset_add_assoc
   1.150 +
   1.151  lemma (in abelian_group) a_coset_add_zero [simp]:
   1.152    "M \<subseteq> carrier G ==> M +> \<zero> = M"
   1.153  by (rule group.coset_mult_one [OF a_group,
   1.154 @@ -129,22 +157,22 @@
   1.155      folded a_r_coset_def a_inv_def, simplified monoid_record_simps])
   1.156  
   1.157  lemma (in abelian_group) a_coset_join1:
   1.158 -     "[| H +> x = H;  x \<in> carrier G;  subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> |] ==> x \<in> H"
   1.159 +     "[| H +> x = H;  x \<in> carrier G;  subgroup H (add_monoid G) |] ==> x \<in> H"
   1.160  by (rule group.coset_join1 [OF a_group,
   1.161      folded a_r_coset_def, simplified monoid_record_simps])
   1.162  
   1.163  lemma (in abelian_group) a_solve_equation:
   1.164 -    "\<lbrakk>subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>; x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> \<exists>h\<in>H. y = h \<oplus> x"
   1.165 +    "\<lbrakk>subgroup H (add_monoid G); x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> \<exists>h\<in>H. y = h \<oplus> x"
   1.166  by (rule group.solve_equation [OF a_group,
   1.167      folded a_r_coset_def, simplified monoid_record_simps])
   1.168  
   1.169  lemma (in abelian_group) a_repr_independence:
   1.170 -     "\<lbrakk>y \<in> H +> x;  x \<in> carrier G; subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> \<rbrakk> \<Longrightarrow> H +> x = H +> y"
   1.171 -by (rule group.repr_independence [OF a_group,
   1.172 -    folded a_r_coset_def, simplified monoid_record_simps])
   1.173 +  "\<lbrakk> y \<in> H +> x; x \<in> carrier G; subgroup H (add_monoid G) \<rbrakk> \<Longrightarrow>
   1.174 +     H +> x = H +> y"
   1.175 +  using a_repr_independence' by (simp add: a_r_coset_def)
   1.176  
   1.177  lemma (in abelian_group) a_coset_join2:
   1.178 -     "\<lbrakk>x \<in> carrier G;  subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>; x\<in>H\<rbrakk> \<Longrightarrow> H +> x = H"
   1.179 +     "\<lbrakk>x \<in> carrier G;  subgroup H (add_monoid G); x\<in>H\<rbrakk> \<Longrightarrow> H +> x = H"
   1.180  by (rule group.coset_join2 [OF a_group,
   1.181      folded a_r_coset_def, simplified monoid_record_simps])
   1.182  
   1.183 @@ -167,23 +195,15 @@
   1.184  lemma (in abelian_group) a_transpose_inv:
   1.185       "[| x \<oplus> y = z;  x \<in> carrier G;  y \<in> carrier G;  z \<in> carrier G |]
   1.186        ==> (\<ominus> x) \<oplus> z = y"
   1.187 -by (rule group.transpose_inv [OF a_group,
   1.188 -    folded a_r_coset_def a_inv_def, simplified monoid_record_simps])
   1.189 +  using r_neg1 by blast
   1.190  
   1.191 -(*
   1.192 ---"duplicate"
   1.193 -lemma (in abelian_group) a_rcos_self:
   1.194 -     "[| x \<in> carrier G; subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> |] ==> x \<in> H +> x"
   1.195 -by (rule group.rcos_self [OF a_group,
   1.196 -    folded a_r_coset_def, simplified monoid_record_simps])
   1.197 -*)
   1.198  
   1.199  
   1.200  subsubsection \<open>Subgroups\<close>
   1.201  
   1.202  locale additive_subgroup =
   1.203    fixes H and G (structure)
   1.204 -  assumes a_subgroup: "subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.205 +  assumes a_subgroup: "subgroup H (add_monoid G)"
   1.206  
   1.207  lemma (in additive_subgroup) is_additive_subgroup:
   1.208    shows "additive_subgroup H G"
   1.209 @@ -191,7 +211,7 @@
   1.210  
   1.211  lemma additive_subgroupI:
   1.212    fixes G (structure)
   1.213 -  assumes a_subgroup: "subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.214 +  assumes a_subgroup: "subgroup H (add_monoid G)"
   1.215    shows "additive_subgroup H G"
   1.216  by (rule additive_subgroup.intro) (rule a_subgroup)
   1.217  
   1.218 @@ -221,18 +241,18 @@
   1.219  text \<open>Every subgroup of an \<open>abelian_group\<close> is normal\<close>
   1.220  
   1.221  locale abelian_subgroup = additive_subgroup + abelian_group G +
   1.222 -  assumes a_normal: "normal H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.223 +  assumes a_normal: "normal H (add_monoid G)"
   1.224  
   1.225  lemma (in abelian_subgroup) is_abelian_subgroup:
   1.226    shows "abelian_subgroup H G"
   1.227  by (rule abelian_subgroup_axioms)
   1.228  
   1.229  lemma abelian_subgroupI:
   1.230 -  assumes a_normal: "normal H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.231 +  assumes a_normal: "normal H (add_monoid G)"
   1.232        and a_comm: "!!x y. [| x \<in> carrier G; y \<in> carrier G |] ==> x \<oplus>\<^bsub>G\<^esub> y = y \<oplus>\<^bsub>G\<^esub> x"
   1.233    shows "abelian_subgroup H G"
   1.234  proof -
   1.235 -  interpret normal "H" "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.236 +  interpret normal "H" "(add_monoid G)"
   1.237      by (rule a_normal)
   1.238  
   1.239    show "abelian_subgroup H G"
   1.240 @@ -241,13 +261,13 @@
   1.241  
   1.242  lemma abelian_subgroupI2:
   1.243    fixes G (structure)
   1.244 -  assumes a_comm_group: "comm_group \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.245 -      and a_subgroup: "subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.246 +  assumes a_comm_group: "comm_group (add_monoid G)"
   1.247 +      and a_subgroup: "subgroup H (add_monoid G)"
   1.248    shows "abelian_subgroup H G"
   1.249  proof -
   1.250 -  interpret comm_group "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.251 +  interpret comm_group "(add_monoid G)"
   1.252      by (rule a_comm_group)
   1.253 -  interpret subgroup "H" "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.254 +  interpret subgroup "H" "(add_monoid G)"
   1.255      by (rule a_subgroup)
   1.256  
   1.257    show "abelian_subgroup H G"
   1.258 @@ -264,13 +284,10 @@
   1.259  
   1.260  lemma abelian_subgroupI3:
   1.261    fixes G (structure)
   1.262 -  assumes asg: "additive_subgroup H G"
   1.263 -      and ag: "abelian_group G"
   1.264 +  assumes "additive_subgroup H G"
   1.265 +    and "abelian_group G"
   1.266    shows "abelian_subgroup H G"
   1.267 -apply (rule abelian_subgroupI2)
   1.268 - apply (rule abelian_group.a_comm_group[OF ag])
   1.269 -apply (rule additive_subgroup.a_subgroup[OF asg])
   1.270 -done
   1.271 +  using assms abelian_subgroupI2 abelian_group.a_comm_group additive_subgroup_def by blast
   1.272  
   1.273  lemma (in abelian_subgroup) a_coset_eq:
   1.274       "(\<forall>x \<in> carrier G. H +> x = x <+ H)"
   1.275 @@ -289,15 +306,14 @@
   1.276  
   1.277  text\<open>Alternative characterization of normal subgroups\<close>
   1.278  lemma (in abelian_group) a_normal_inv_iff:
   1.279 -     "(N \<lhd> \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>) = 
   1.280 -      (subgroup N \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> \<and> (\<forall>x \<in> carrier G. \<forall>h \<in> N. x \<oplus> h \<oplus> (\<ominus> x) \<in> N))"
   1.281 +     "(N \<lhd> (add_monoid G)) = 
   1.282 +      (subgroup N (add_monoid G) & (\<forall>x \<in> carrier G. \<forall>h \<in> N. x \<oplus> h \<oplus> (\<ominus> x) \<in> N))"
   1.283        (is "_ = ?rhs")
   1.284  by (rule group.normal_inv_iff [OF a_group,
   1.285      folded a_inv_def, simplified monoid_record_simps])
   1.286  
   1.287  lemma (in abelian_group) a_lcos_m_assoc:
   1.288 -     "[| M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G |]
   1.289 -      ==> g <+ (h <+ M) = (g \<oplus> h) <+ M"
   1.290 +  "\<lbrakk> M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G \<rbrakk> \<Longrightarrow> g <+ (h <+ M) = (g \<oplus> h) <+ M"
   1.291  by (rule group.lcos_m_assoc [OF a_group,
   1.292      folded a_l_coset_def, simplified monoid_record_simps])
   1.293  
   1.294 @@ -308,33 +324,28 @@
   1.295  
   1.296  
   1.297  lemma (in abelian_group) a_l_coset_subset_G:
   1.298 -     "[| H \<subseteq> carrier G; x \<in> carrier G |] ==> x <+ H \<subseteq> carrier G"
   1.299 +  "\<lbrakk> H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> x <+ H \<subseteq> carrier G"
   1.300  by (rule group.l_coset_subset_G [OF a_group,
   1.301      folded a_l_coset_def, simplified monoid_record_simps])
   1.302  
   1.303  
   1.304  lemma (in abelian_group) a_l_coset_swap:
   1.305 -     "\<lbrakk>y \<in> x <+ H;  x \<in> carrier G;  subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>\<rbrakk> \<Longrightarrow> x \<in> y <+ H"
   1.306 +     "\<lbrakk>y \<in> x <+ H;  x \<in> carrier G;  subgroup H (add_monoid G)\<rbrakk> \<Longrightarrow> x \<in> y <+ H"
   1.307  by (rule group.l_coset_swap [OF a_group,
   1.308      folded a_l_coset_def, simplified monoid_record_simps])
   1.309  
   1.310  lemma (in abelian_group) a_l_coset_carrier:
   1.311 -     "[| y \<in> x <+ H;  x \<in> carrier G;  subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> |] ==> y \<in> carrier G"
   1.312 +     "[| y \<in> x <+ H;  x \<in> carrier G;  subgroup H (add_monoid G) |] ==> y \<in> carrier G"
   1.313  by (rule group.l_coset_carrier [OF a_group,
   1.314      folded a_l_coset_def, simplified monoid_record_simps])
   1.315  
   1.316  lemma (in abelian_group) a_l_repr_imp_subset:
   1.317 -  assumes y: "y \<in> x <+ H" and x: "x \<in> carrier G" and sb: "subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.318 +  assumes "y \<in> x <+ H" "x \<in> carrier G" "subgroup H (add_monoid G)"
   1.319    shows "y <+ H \<subseteq> x <+ H"
   1.320 -apply (rule group.l_repr_imp_subset [OF a_group,
   1.321 -    folded a_l_coset_def, simplified monoid_record_simps])
   1.322 -apply (rule y)
   1.323 -apply (rule x)
   1.324 -apply (rule sb)
   1.325 -done
   1.326 +  by (metis (full_types) a_l_coset_defs(1) add.l_repr_independence assms set_eq_subset)
   1.327  
   1.328  lemma (in abelian_group) a_l_repr_independence:
   1.329 -  assumes y: "y \<in> x <+ H" and x: "x \<in> carrier G" and sb: "subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   1.330 +  assumes y: "y \<in> x <+ H" and x: "x \<in> carrier G" and sb: "subgroup H (add_monoid G)"
   1.331    shows "x <+ H = y <+ H"
   1.332  apply (rule group.l_repr_independence [OF a_group,
   1.333      folded a_l_coset_def, simplified monoid_record_simps])
   1.334 @@ -348,7 +359,7 @@
   1.335  by (rule group.setmult_subset_G [OF a_group,
   1.336      folded set_add_def, simplified monoid_record_simps])
   1.337  
   1.338 -lemma (in abelian_group) subgroup_add_id: "subgroup H \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> \<Longrightarrow> H <+> H = H"
   1.339 +lemma (in abelian_group) subgroup_add_id: "subgroup H (add_monoid G) \<Longrightarrow> H <+> H = H"
   1.340  by (rule group.subgroup_mult_id [OF a_group,
   1.341      folded set_add_def, simplified monoid_record_simps])
   1.342  
   1.343 @@ -427,8 +438,7 @@
   1.344  lemma (in abelian_group) a_card_cosets_equal:
   1.345       "\<lbrakk>c \<in> a_rcosets H;  H \<subseteq> carrier G; finite(carrier G)\<rbrakk>
   1.346        \<Longrightarrow> card c = card H"
   1.347 -by (rule group.card_cosets_equal [OF a_group,
   1.348 -    folded A_RCOSETS_def, simplified monoid_record_simps])
   1.349 +  by (simp add: A_RCOSETS_defs(1) add.card_rcosets_equal)
   1.350  
   1.351  lemma (in abelian_group) rcosets_subset_PowG:
   1.352       "additive_subgroup H G  \<Longrightarrow> a_rcosets H \<subseteq> Pow(carrier G)"
   1.353 @@ -509,7 +519,7 @@
   1.354  text\<open>The coset map is a homomorphism from @{term G} to the quotient group
   1.355    @{term "G Mod H"}\<close>
   1.356  lemma (in abelian_subgroup) a_r_coset_hom_A_Mod:
   1.357 -  "(\<lambda>a. H +> a) \<in> hom \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> (G A_Mod H)"
   1.358 +  "(\<lambda>a. H +> a) \<in> hom (add_monoid G) (G A_Mod H)"
   1.359  by (rule normal.r_coset_hom_Mod [OF a_normal,
   1.360      folded A_FactGroup_def a_r_coset_def, simplified monoid_record_simps])
   1.361  
   1.362 @@ -535,8 +545,8 @@
   1.363  lemma abelian_group_homI:
   1.364    assumes "abelian_group G"
   1.365    assumes "abelian_group H"
   1.366 -  assumes a_group_hom: "group_hom \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>
   1.367 -                                  \<lparr>carrier = carrier H, mult = add H, one = zero H\<rparr> h"
   1.368 +  assumes a_group_hom: "group_hom (add_monoid G)
   1.369 +                                  (add_monoid H) h"
   1.370    shows "abelian_group_hom G H h"
   1.371  proof -
   1.372    interpret G: abelian_group G by fact
   1.373 @@ -614,7 +624,7 @@
   1.374  
   1.375  lemma (in abelian_group_hom) A_FactGroup_hom:
   1.376       "(\<lambda>X. the_elem (h`X)) \<in> hom (G A_Mod (a_kernel G H h))
   1.377 -          \<lparr>carrier = carrier H, mult = add H, one = zero H\<rparr>"
   1.378 +          (add_monoid H)"
   1.379  by (rule group_hom.FactGroup_hom[OF a_group_hom,
   1.380      folded a_kernel_def A_FactGroup_def, simplified ring_record_simps])
   1.381  
   1.382 @@ -633,13 +643,16 @@
   1.383  
   1.384  text\<open>If @{term h} is a homomorphism from @{term G} onto @{term H}, then the
   1.385   quotient group @{term "G Mod (kernel G H h)"} is isomorphic to @{term H}.\<close>
   1.386 -theorem (in abelian_group_hom) A_FactGroup_iso:
   1.387 +theorem (in abelian_group_hom) A_FactGroup_iso_set:
   1.388    "h ` carrier G = carrier H
   1.389 -   \<Longrightarrow> (\<lambda>X. the_elem (h`X)) \<in> (G A_Mod (a_kernel G H h)) \<cong>
   1.390 -          \<lparr>carrier = carrier H, mult = add H, one = zero H\<rparr>"
   1.391 -by (rule group_hom.FactGroup_iso[OF a_group_hom,
   1.392 +   \<Longrightarrow> (\<lambda>X. the_elem (h`X)) \<in> iso (G A_Mod (a_kernel G H h)) (add_monoid H)"
   1.393 +by (rule group_hom.FactGroup_iso_set[OF a_group_hom,
   1.394      folded a_kernel_def A_FactGroup_def, simplified ring_record_simps])
   1.395  
   1.396 +corollary (in abelian_group_hom) A_FactGroup_iso :
   1.397 +  "h ` carrier G = carrier H
   1.398 +   \<Longrightarrow>  (G A_Mod (a_kernel G H h)) \<cong>  (add_monoid H)"
   1.399 +  using A_FactGroup_iso_set unfolding is_iso_def by auto
   1.400  
   1.401  subsubsection \<open>Cosets\<close>
   1.402  
     2.1 --- a/src/HOL/Algebra/Congruence.thy	Thu Jun 14 15:45:53 2018 +0200
     2.2 +++ b/src/HOL/Algebra/Congruence.thy	Thu Jun 14 15:20:20 2018 +0100
     2.3 @@ -43,6 +43,10 @@
     2.4    where "class_of\<^bsub>S\<^esub> x = {y \<in> carrier S. x .=\<^bsub>S\<^esub> y}"
     2.5  
     2.6  definition
     2.7 +  eq_classes :: "_ \<Rightarrow> ('a set) set" ("classes\<index>")
     2.8 +  where "classes\<^bsub>S\<^esub> = {class_of\<^bsub>S\<^esub> x | x. x \<in> carrier S}"
     2.9 +
    2.10 +definition
    2.11    eq_closure_of :: "_ \<Rightarrow> 'a set \<Rightarrow> 'a set" ("closure'_of\<index>")
    2.12    where "closure_of\<^bsub>S\<^esub> A = {y \<in> carrier S. y .\<in>\<^bsub>S\<^esub> A}"
    2.13  
    2.14 @@ -69,235 +73,148 @@
    2.15      and trans [trans]:
    2.16        "\<lbrakk> x .= y; y .= z; x \<in> carrier S; y \<in> carrier S; z \<in> carrier S \<rbrakk> \<Longrightarrow> x .= z"
    2.17  
    2.18 +lemma equivalenceI:
    2.19 +  fixes P :: "'a \<Rightarrow> 'a \<Rightarrow> bool" and E :: "'a set"
    2.20 +  assumes refl: "\<And>x.     \<lbrakk> x \<in> E \<rbrakk> \<Longrightarrow> P x x"
    2.21 +    and    sym: "\<And>x y.   \<lbrakk> x \<in> E; y \<in> E \<rbrakk> \<Longrightarrow> P x y \<Longrightarrow> P y x"
    2.22 +    and  trans: "\<And>x y z. \<lbrakk> x \<in> E; y \<in> E; z \<in> E \<rbrakk> \<Longrightarrow> P x y \<Longrightarrow> P y z \<Longrightarrow> P x z"
    2.23 +  shows "equivalence \<lparr> carrier = E, eq = P \<rparr>"
    2.24 +  unfolding equivalence_def using assms
    2.25 +  by (metis eq_object.select_convs(1) partial_object.select_convs(1))
    2.26 +
    2.27 +locale partition =
    2.28 +  fixes A :: "'a set" and B :: "('a set) set"
    2.29 +  assumes unique_class: "\<And>a. a \<in> A \<Longrightarrow> \<exists>!b \<in> B. a \<in> b"
    2.30 +    and incl: "\<And>b. b \<in> B \<Longrightarrow> b \<subseteq> A"
    2.31 +
    2.32 +lemma equivalence_subset:
    2.33 +  assumes "equivalence L" "A \<subseteq> carrier L"
    2.34 +  shows "equivalence (L\<lparr> carrier := A \<rparr>)"
    2.35 +proof -
    2.36 +  interpret L: equivalence L
    2.37 +    by (simp add: assms)
    2.38 +  show ?thesis
    2.39 +    by (unfold_locales, simp_all add: L.sym assms rev_subsetD, meson L.trans assms(2) contra_subsetD)
    2.40 +qed
    2.41 +
    2.42 +
    2.43  (* Lemmas by Stephan Hohe *)
    2.44  
    2.45  lemma elemI:
    2.46    fixes R (structure)
    2.47 -  assumes "a' \<in> A" and "a .= a'"
    2.48 +  assumes "a' \<in> A" "a .= a'"
    2.49    shows "a .\<in> A"
    2.50 -unfolding elem_def
    2.51 -using assms
    2.52 -by fast
    2.53 +  unfolding elem_def using assms by auto
    2.54  
    2.55  lemma (in equivalence) elem_exact:
    2.56 -  assumes "a \<in> carrier S" and "a \<in> A"
    2.57 +  assumes "a \<in> carrier S" "a \<in> A"
    2.58    shows "a .\<in> A"
    2.59 -using assms
    2.60 -by (fast intro: elemI)
    2.61 +  unfolding elem_def using assms by auto
    2.62  
    2.63  lemma elemE:
    2.64    fixes S (structure)
    2.65    assumes "a .\<in> A"
    2.66      and "\<And>a'. \<lbrakk>a' \<in> A; a .= a'\<rbrakk> \<Longrightarrow> P"
    2.67    shows "P"
    2.68 -using assms
    2.69 -unfolding elem_def
    2.70 -by fast
    2.71 +  using assms unfolding elem_def by auto
    2.72  
    2.73  lemma (in equivalence) elem_cong_l [trans]:
    2.74 -  assumes cong: "a' .= a"
    2.75 -    and a: "a .\<in> A"
    2.76 -    and carr: "a \<in> carrier S"  "a' \<in> carrier S"
    2.77 -    and Acarr: "A \<subseteq> carrier S"
    2.78 +  assumes "a \<in> carrier S"  "a' \<in> carrier S" "A \<subseteq> carrier S"
    2.79 +    and "a' .= a" "a .\<in> A"
    2.80    shows "a' .\<in> A"
    2.81 -using a
    2.82 -apply (elim elemE, intro elemI)
    2.83 -proof assumption
    2.84 -  fix b
    2.85 -  assume bA: "b \<in> A"
    2.86 -  note [simp] = carr bA[THEN subsetD[OF Acarr]]
    2.87 -  note cong
    2.88 -  also assume "a .= b"
    2.89 -  finally show "a' .= b" by simp
    2.90 -qed
    2.91 +  using assms by (meson elem_def trans subsetCE)
    2.92  
    2.93  lemma (in equivalence) elem_subsetD:
    2.94 -  assumes "A \<subseteq> B"
    2.95 -    and aA: "a .\<in> A"
    2.96 +  assumes "A \<subseteq> B" "a .\<in> A"
    2.97    shows "a .\<in> B"
    2.98 -using assms
    2.99 -by (fast intro: elemI elim: elemE dest: subsetD)
   2.100 +  using assms by (fast intro: elemI elim: elemE dest: subsetD)
   2.101  
   2.102  lemma (in equivalence) mem_imp_elem [simp, intro]:
   2.103 -  "\<lbrakk> x \<in> A; x \<in> carrier S \<rbrakk> \<Longrightarrow> x .\<in> A"
   2.104 -  unfolding elem_def by blast
   2.105 +  assumes "x \<in> carrier S"
   2.106 +  shows "x \<in> A \<Longrightarrow> x .\<in> A"
   2.107 +  using assms unfolding elem_def by blast
   2.108  
   2.109  lemma set_eqI:
   2.110    fixes R (structure)
   2.111 -  assumes ltr: "\<And>a. a \<in> A \<Longrightarrow> a .\<in> B"
   2.112 -    and rtl: "\<And>b. b \<in> B \<Longrightarrow> b .\<in> A"
   2.113 +  assumes "\<And>a. a \<in> A \<Longrightarrow> a .\<in> B"
   2.114 +    and   "\<And>b. b \<in> B \<Longrightarrow> b .\<in> A"
   2.115    shows "A {.=} B"
   2.116 -unfolding set_eq_def
   2.117 -by (fast intro: ltr rtl)
   2.118 +  using assms unfolding set_eq_def by auto
   2.119  
   2.120  lemma set_eqI2:
   2.121    fixes R (structure)
   2.122 -  assumes ltr: "\<And>a b. a \<in> A \<Longrightarrow> \<exists>b\<in>B. a .= b"
   2.123 -    and rtl: "\<And>b. b \<in> B \<Longrightarrow> \<exists>a\<in>A. b .= a"
   2.124 +  assumes "\<And>a. a \<in> A \<Longrightarrow> \<exists>b \<in> B. a .= b"
   2.125 +    and   "\<And>b. b \<in> B \<Longrightarrow> \<exists>a \<in> A. b .= a"
   2.126    shows "A {.=} B"
   2.127 -  by (intro set_eqI, unfold elem_def) (fast intro: ltr rtl)+
   2.128 +  using assms by (simp add: set_eqI elem_def)  
   2.129  
   2.130  lemma set_eqD1:
   2.131    fixes R (structure)
   2.132 -  assumes AA': "A {.=} A'"
   2.133 -    and "a \<in> A"
   2.134 +  assumes "A {.=} A'" and "a \<in> A"
   2.135    shows "\<exists>a'\<in>A'. a .= a'"
   2.136 -using assms
   2.137 -unfolding set_eq_def elem_def
   2.138 -by fast
   2.139 +  using assms by (simp add: set_eq_def elem_def)
   2.140  
   2.141  lemma set_eqD2:
   2.142    fixes R (structure)
   2.143 -  assumes AA': "A {.=} A'"
   2.144 -    and "a' \<in> A'"
   2.145 +  assumes "A {.=} A'" and "a' \<in> A'"
   2.146    shows "\<exists>a\<in>A. a' .= a"
   2.147 -using assms
   2.148 -unfolding set_eq_def elem_def
   2.149 -by fast
   2.150 +  using assms by (simp add: set_eq_def elem_def)
   2.151  
   2.152  lemma set_eqE:
   2.153    fixes R (structure)
   2.154 -  assumes AB: "A {.=} B"
   2.155 -    and r: "\<lbrakk>\<forall>a\<in>A. a .\<in> B; \<forall>b\<in>B. b .\<in> A\<rbrakk> \<Longrightarrow> P"
   2.156 +  assumes "A {.=} B"
   2.157 +    and "\<lbrakk> \<forall>a \<in> A. a .\<in> B; \<forall>b \<in> B. b .\<in> A \<rbrakk> \<Longrightarrow> P"
   2.158    shows "P"
   2.159 -using AB
   2.160 -unfolding set_eq_def
   2.161 -by (blast dest: r)
   2.162 +  using assms unfolding set_eq_def by blast
   2.163  
   2.164  lemma set_eqE2:
   2.165    fixes R (structure)
   2.166 -  assumes AB: "A {.=} B"
   2.167 -    and r: "\<lbrakk>\<forall>a\<in>A. (\<exists>b\<in>B. a .= b); \<forall>b\<in>B. (\<exists>a\<in>A. b .= a)\<rbrakk> \<Longrightarrow> P"
   2.168 +  assumes "A {.=} B"
   2.169 +    and "\<lbrakk> \<forall>a \<in> A. \<exists>b \<in> B. a .= b; \<forall>b \<in> B. \<exists>a \<in> A. b .= a \<rbrakk> \<Longrightarrow> P"
   2.170    shows "P"
   2.171 -using AB
   2.172 -unfolding set_eq_def elem_def
   2.173 -by (blast dest: r)
   2.174 +  using assms unfolding set_eq_def by (simp add: elem_def) 
   2.175  
   2.176  lemma set_eqE':
   2.177    fixes R (structure)
   2.178 -  assumes AB: "A {.=} B"
   2.179 -    and aA: "a \<in> A" and bB: "b \<in> B"
   2.180 -    and r: "\<And>a' b'. \<lbrakk>a' \<in> A; b .= a'; b' \<in> B; a .= b'\<rbrakk> \<Longrightarrow> P"
   2.181 +  assumes "A {.=} B" "a \<in> A" "b \<in> B"
   2.182 +    and "\<And>a' b'. \<lbrakk> a' \<in> A; b' \<in> B \<rbrakk> \<Longrightarrow> b .= a' \<Longrightarrow>  a .= b' \<Longrightarrow> P"
   2.183    shows "P"
   2.184 -proof -
   2.185 -  from AB aA
   2.186 -      have "\<exists>b'\<in>B. a .= b'" by (rule set_eqD1)
   2.187 -  from this obtain b'
   2.188 -      where b': "b' \<in> B" "a .= b'" by auto
   2.189 -
   2.190 -  from AB bB
   2.191 -      have "\<exists>a'\<in>A. b .= a'" by (rule set_eqD2)
   2.192 -  from this obtain a'
   2.193 -      where a': "a' \<in> A" "b .= a'" by auto
   2.194 -
   2.195 -  from a' b'
   2.196 -      show "P" by (rule r)
   2.197 -qed
   2.198 +  using assms by (meson set_eqE2)
   2.199  
   2.200  lemma (in equivalence) eq_elem_cong_r [trans]:
   2.201 -  assumes a: "a .\<in> A"
   2.202 -    and cong: "A {.=} A'"
   2.203 -    and carr: "a \<in> carrier S"
   2.204 -    and Carr: "A \<subseteq> carrier S" "A' \<subseteq> carrier S"
   2.205 -  shows "a .\<in> A'"
   2.206 -using a cong
   2.207 -proof (elim elemE set_eqE)
   2.208 -  fix b
   2.209 -  assume bA: "b \<in> A"
   2.210 -     and inA': "\<forall>b\<in>A. b .\<in> A'"
   2.211 -  note [simp] = carr Carr Carr[THEN subsetD] bA
   2.212 -  assume "a .= b"
   2.213 -  also from bA inA'
   2.214 -       have "b .\<in> A'" by fast
   2.215 -  finally
   2.216 -       show "a .\<in> A'" by simp
   2.217 -qed
   2.218 +  assumes "A \<subseteq> carrier S" "A' \<subseteq> carrier S" "A {.=} A'"
   2.219 +  shows "\<lbrakk> a \<in> carrier S \<rbrakk> \<Longrightarrow> a .\<in> A \<Longrightarrow> a .\<in> A'"
   2.220 +  using assms by (meson elemE elem_cong_l set_eqE subset_eq)
   2.221  
   2.222  lemma (in equivalence) set_eq_sym [sym]:
   2.223 -  assumes "A {.=} B"
   2.224 -  shows "B {.=} A"
   2.225 -using assms
   2.226 -unfolding set_eq_def elem_def
   2.227 -by fast
   2.228 +  assumes "A \<subseteq> carrier S" "B \<subseteq> carrier S"
   2.229 +  shows "A {.=} B \<Longrightarrow> B {.=} A"
   2.230 +  using assms unfolding set_eq_def elem_def by auto
   2.231  
   2.232  lemma (in equivalence) equal_set_eq_trans [trans]:
   2.233 -  assumes AB: "A = B" and BC: "B {.=} C"
   2.234 -  shows "A {.=} C"
   2.235 -  using AB BC by simp
   2.236 +  "\<lbrakk> A = B; B {.=} C \<rbrakk> \<Longrightarrow> A {.=} C"
   2.237 +  by simp
   2.238  
   2.239  lemma (in equivalence) set_eq_equal_trans [trans]:
   2.240 -  assumes AB: "A {.=} B" and BC: "B = C"
   2.241 -  shows "A {.=} C"
   2.242 -  using AB BC by simp
   2.243 +  "\<lbrakk> A {.=} B; B = C \<rbrakk> \<Longrightarrow> A {.=} C"
   2.244 +  by simp
   2.245  
   2.246 -lemma (in equivalence) set_eq_trans [trans]:
   2.247 -  assumes AB: "A {.=} B" and BC: "B {.=} C"
   2.248 -    and carr: "A \<subseteq> carrier S"  "B \<subseteq> carrier S"  "C \<subseteq> carrier S"
   2.249 +lemma (in equivalence) set_eq_trans_aux:
   2.250 +  assumes "A \<subseteq> carrier S" "B \<subseteq> carrier S" "C \<subseteq> carrier S"
   2.251 +    and "A {.=} B" "B {.=} C"
   2.252 +  shows "\<And>a. a \<in> A \<Longrightarrow> a .\<in> C"
   2.253 +  using assms by (simp add: eq_elem_cong_r subset_iff) 
   2.254 +
   2.255 +corollary (in equivalence) set_eq_trans [trans]:
   2.256 +  assumes "A \<subseteq> carrier S" "B \<subseteq> carrier S" "C \<subseteq> carrier S"
   2.257 +    and "A {.=} B" " B {.=} C"
   2.258    shows "A {.=} C"
   2.259  proof (intro set_eqI)
   2.260 -  fix a
   2.261 -  assume aA: "a \<in> A"
   2.262 -  with carr have "a \<in> carrier S" by fast
   2.263 -  note [simp] = carr this
   2.264 -
   2.265 -  from aA
   2.266 -       have "a .\<in> A" by (simp add: elem_exact)
   2.267 -  also note AB
   2.268 -  also note BC
   2.269 -  finally
   2.270 -       show "a .\<in> C" by simp
   2.271 +  show "\<And>a. a \<in> A \<Longrightarrow> a .\<in> C" using set_eq_trans_aux assms by blast 
   2.272  next
   2.273 -  fix c
   2.274 -  assume cC: "c \<in> C"
   2.275 -  with carr have "c \<in> carrier S" by fast
   2.276 -  note [simp] = carr this
   2.277 -
   2.278 -  from cC
   2.279 -       have "c .\<in> C" by (simp add: elem_exact)
   2.280 -  also note BC[symmetric]
   2.281 -  also note AB[symmetric]
   2.282 -  finally
   2.283 -       show "c .\<in> A" by simp
   2.284 +  show "\<And>b. b \<in> C \<Longrightarrow> b .\<in> A" using set_eq_trans_aux set_eq_sym assms by blast
   2.285  qed
   2.286  
   2.287 -lemma (in equivalence) set_eq_insert_aux:
   2.288 -  assumes x: "x .= x'"
   2.289 -      and carr: "x \<in> carrier S" "x' \<in> carrier S" "A \<subseteq> carrier S"
   2.290 -    shows "\<forall>a \<in> (insert x A). a .\<in> (insert x' A)"
   2.291 -proof
   2.292 -  fix a
   2.293 -  show "a \<in> insert x A \<Longrightarrow> a .\<in> insert x' A"
   2.294 -  proof cases
   2.295 -    assume "a \<in> A"
   2.296 -    thus "a .\<in> insert x' A"
   2.297 -      using carr(3) by blast
   2.298 -  next
   2.299 -    assume "a \<in> insert x A" "a \<notin> A"
   2.300 -    hence "a = x"
   2.301 -      by blast
   2.302 -    thus "a .\<in> insert x' A"
   2.303 -      by (meson x elemI insertI1)
   2.304 -  qed
   2.305 -qed
   2.306 -
   2.307 -lemma (in equivalence) set_eq_insert:
   2.308 -  assumes x: "x .= x'"
   2.309 -      and carr: "x \<in> carrier S" "x' \<in> carrier S" "A \<subseteq> carrier S"
   2.310 -    shows "insert x A {.=} insert x' A"
   2.311 -proof-
   2.312 -  have "(\<forall>a \<in> (insert x  A). a .\<in> (insert x' A)) \<and>
   2.313 -        (\<forall>a \<in> (insert x' A). a .\<in> (insert x  A))"
   2.314 -    using set_eq_insert_aux carr x sym by blast
   2.315 -  thus "insert x A {.=} insert x' A"
   2.316 -    using set_eq_def by blast
   2.317 -qed  
   2.318 -
   2.319 -lemma (in equivalence) set_eq_pairI:
   2.320 -  assumes xx': "x .= x'"
   2.321 -    and carr: "x \<in> carrier S" "x' \<in> carrier S" "y \<in> carrier S"
   2.322 -  shows "{x, y} {.=} {x', y}"
   2.323 -  using assms set_eq_insert by simp
   2.324 -
   2.325  lemma (in equivalence) is_closedI:
   2.326    assumes closed: "\<And>x y. \<lbrakk>x .= y; x \<in> A; y \<in> carrier S\<rbrakk> \<Longrightarrow> y \<in> A"
   2.327      and S: "A \<subseteq> carrier S"
   2.328 @@ -307,29 +224,28 @@
   2.329    by (blast dest: closed sym)
   2.330  
   2.331  lemma (in equivalence) closure_of_eq:
   2.332 -  "\<lbrakk>x .= x'; A \<subseteq> carrier S; x \<in> closure_of A; x' \<in> carrier S\<rbrakk> \<Longrightarrow> x' \<in> closure_of A"
   2.333 -  unfolding eq_closure_of_def elem_def
   2.334 -  by (blast intro: trans sym)
   2.335 +  assumes "A \<subseteq> carrier S" "x \<in> closure_of A"
   2.336 +  shows "\<lbrakk> x' \<in> carrier S; x .= x' \<rbrakk> \<Longrightarrow> x' \<in> closure_of A"
   2.337 +  using assms elem_cong_l sym unfolding eq_closure_of_def by blast 
   2.338  
   2.339  lemma (in equivalence) is_closed_eq [dest]:
   2.340 -  "\<lbrakk>x .= x'; x \<in> A; is_closed A; x \<in> carrier S; x' \<in> carrier S\<rbrakk> \<Longrightarrow> x' \<in> A"
   2.341 -  unfolding eq_is_closed_def
   2.342 -  using closure_of_eq [where A = A]
   2.343 -  by simp
   2.344 +  assumes "is_closed A" "x \<in> A"
   2.345 +  shows "\<lbrakk> x .= x'; x' \<in> carrier S \<rbrakk> \<Longrightarrow> x' \<in> A"
   2.346 +  using assms closure_of_eq [where A = A] unfolding eq_is_closed_def by simp
   2.347  
   2.348 -lemma (in equivalence) is_closed_eq_rev [dest]:
   2.349 -  "\<lbrakk>x .= x'; x' \<in> A; is_closed A; x \<in> carrier S; x' \<in> carrier S\<rbrakk> \<Longrightarrow> x \<in> A"
   2.350 -  by (meson subsetD eq_is_closed_def is_closed_eq sym)
   2.351 +corollary (in equivalence) is_closed_eq_rev [dest]:
   2.352 +  assumes "is_closed A" "x' \<in> A"
   2.353 +  shows "\<lbrakk> x .= x'; x \<in> carrier S \<rbrakk> \<Longrightarrow> x \<in> A"
   2.354 +  using sym is_closed_eq assms by (meson contra_subsetD eq_is_closed_def)
   2.355  
   2.356  lemma closure_of_closed [simp, intro]:
   2.357    fixes S (structure)
   2.358    shows "closure_of A \<subseteq> carrier S"
   2.359 -unfolding eq_closure_of_def
   2.360 -by fast
   2.361 +  unfolding eq_closure_of_def by auto
   2.362  
   2.363  lemma closure_of_memI:
   2.364    fixes S (structure)
   2.365 -  assumes "a .\<in> A" and "a \<in> carrier S"
   2.366 +  assumes "a .\<in> A" "a \<in> carrier S"
   2.367    shows "a \<in> closure_of A"
   2.368    by (simp add: assms eq_closure_of_def)
   2.369  
   2.370 @@ -351,67 +267,193 @@
   2.371    assumes "a \<in> closure_of A"
   2.372      and "\<And>a'. \<lbrakk>a \<in> carrier S; a' \<in> A; a .= a'\<rbrakk> \<Longrightarrow> P"
   2.373    shows "P"
   2.374 -  by (meson closure_of_memE elemE assms)
   2.375 +  using assms by (meson closure_of_memE elemE)
   2.376 +
   2.377 +
   2.378 +(* Lemmas by Paulo Emílio de Vilhena *)
   2.379 +
   2.380 +lemma (in partition) equivalence_from_partition:
   2.381 +  "equivalence \<lparr> carrier = A, eq = (\<lambda>x y. y \<in> (THE b. b \<in> B \<and> x \<in> b))\<rparr>"
   2.382 +    unfolding partition_def equivalence_def
   2.383 +proof (auto)
   2.384 +  let ?f = "\<lambda>x. THE b. b \<in> B \<and> x \<in> b"
   2.385 +  show "\<And>x. x \<in> A \<Longrightarrow> x \<in> ?f x"
   2.386 +    using unique_class by (metis (mono_tags, lifting) theI')
   2.387 +  show "\<And>x y. \<lbrakk> x \<in> A; y \<in> A \<rbrakk> \<Longrightarrow> y \<in> ?f x \<Longrightarrow> x \<in> ?f y"
   2.388 +    using unique_class by (metis (mono_tags, lifting) the_equality)
   2.389 +  show "\<And>x y z. \<lbrakk> x \<in> A; y \<in> A; z \<in> A \<rbrakk> \<Longrightarrow> y \<in> ?f x \<Longrightarrow> z \<in> ?f y \<Longrightarrow> z \<in> ?f x"
   2.390 +    using unique_class by (metis (mono_tags, lifting) the_equality)
   2.391 +qed
   2.392 +
   2.393 +lemma (in partition) partition_coverture: "\<Union>B = A"
   2.394 +  by (meson Sup_le_iff UnionI unique_class incl subsetI subset_antisym)
   2.395 +
   2.396 +lemma (in partition) disjoint_union:
   2.397 +  assumes "b1 \<in> B" "b2 \<in> B"
   2.398 +    and "b1 \<inter> b2 \<noteq> {}"
   2.399 +  shows "b1 = b2"
   2.400 +proof (rule ccontr)
   2.401 +  assume "b1 \<noteq> b2"
   2.402 +  obtain a where "a \<in> A" "a \<in> b1" "a \<in> b2"
   2.403 +    using assms(2-3) incl by blast
   2.404 +  thus False using unique_class \<open>b1 \<noteq> b2\<close> assms(1) assms(2) by blast
   2.405 +qed
   2.406 +
   2.407 +lemma partitionI:
   2.408 +  fixes A :: "'a set" and B :: "('a set) set"
   2.409 +  assumes "\<Union>B = A"
   2.410 +    and "\<And>b1 b2. \<lbrakk> b1 \<in> B; b2 \<in> B \<rbrakk> \<Longrightarrow> b1 \<inter> b2 \<noteq> {} \<Longrightarrow> b1 = b2"
   2.411 +  shows "partition A B"
   2.412 +proof
   2.413 +  show "\<And>a. a \<in> A \<Longrightarrow> \<exists>!b. b \<in> B \<and> a \<in> b"
   2.414 +  proof (rule ccontr)
   2.415 +    fix a assume "a \<in> A" "\<nexists>!b. b \<in> B \<and> a \<in> b"
   2.416 +    then obtain b1 b2 where "b1 \<in> B" "a \<in> b1"
   2.417 +                        and "b2 \<in> B" "a \<in> b2" "b1 \<noteq> b2" using assms(1) by blast
   2.418 +    thus False using assms(2) by blast
   2.419 +  qed
   2.420 +next
   2.421 +  show "\<And>b. b \<in> B \<Longrightarrow> b \<subseteq> A" using assms(1) by blast
   2.422 +qed
   2.423 +
   2.424 +lemma (in partition) remove_elem:
   2.425 +  assumes "b \<in> B"
   2.426 +  shows "partition (A - b) (B - {b})"
   2.427 +proof
   2.428 +  show "\<And>a. a \<in> A - b \<Longrightarrow> \<exists>!b'. b' \<in> B - {b} \<and> a \<in> b'"
   2.429 +    using unique_class by fastforce
   2.430 +next
   2.431 +  show "\<And>b'. b' \<in> B - {b} \<Longrightarrow> b' \<subseteq> A - b"
   2.432 +    using assms unique_class incl partition_axioms partition_coverture by fastforce
   2.433 +qed
   2.434 +
   2.435 +lemma disjoint_sum:
   2.436 +  "\<lbrakk> finite B; finite A; partition A B\<rbrakk> \<Longrightarrow> (\<Sum>b\<in>B. \<Sum>a\<in>b. f a) = (\<Sum>a\<in>A. f a)"
   2.437 +proof (induct arbitrary: A set: finite)
   2.438 +  case empty thus ?case using partition.unique_class by fastforce
   2.439 +next
   2.440 +  case (insert b B')
   2.441 +  have "(\<Sum>b\<in>(insert b B'). \<Sum>a\<in>b. f a) = (\<Sum>a\<in>b. f a) + (\<Sum>b\<in>B'. \<Sum>a\<in>b. f a)"
   2.442 +    by (simp add: insert.hyps(1) insert.hyps(2))
   2.443 +  also have "... = (\<Sum>a\<in>b. f a) + (\<Sum>a\<in>(A - b). f a)"
   2.444 +    using partition.remove_elem[of A "insert b B'" b] insert.hyps insert.prems
   2.445 +    by (metis Diff_insert_absorb finite_Diff insert_iff)
   2.446 +  finally show "(\<Sum>b\<in>(insert b B'). \<Sum>a\<in>b. f a) = (\<Sum>a\<in>A. f a)"
   2.447 +    using partition.remove_elem[of A "insert b B'" b] insert.prems
   2.448 +    by (metis add.commute insert_iff partition.incl sum.subset_diff)
   2.449 +qed
   2.450 +
   2.451 +lemma (in partition) disjoint_sum:
   2.452 +  assumes "finite A"
   2.453 +  shows "(\<Sum>b\<in>B. \<Sum>a\<in>b. f a) = (\<Sum>a\<in>A. f a)"
   2.454 +proof -
   2.455 +  have "finite B"
   2.456 +    by (simp add: assms finite_UnionD partition_coverture)
   2.457 +  thus ?thesis using disjoint_sum assms partition_axioms by blast
   2.458 +qed
   2.459 +
   2.460 +lemma (in equivalence) set_eq_insert_aux:
   2.461 +  assumes "A \<subseteq> carrier S"
   2.462 +    and "x \<in> carrier S" "x' \<in> carrier S" "x .= x'"
   2.463 +    and "y \<in> insert x A"
   2.464 +  shows "y .\<in> insert x' A"
   2.465 +  by (metis assms(1) assms(4) assms(5) contra_subsetD elemI elem_exact insert_iff)
   2.466 +
   2.467 +corollary (in equivalence) set_eq_insert:
   2.468 +  assumes "A \<subseteq> carrier S"
   2.469 +    and "x \<in> carrier S" "x' \<in> carrier S" "x .= x'"
   2.470 +  shows "insert x A {.=} insert x' A"
   2.471 +  by (meson set_eqI assms set_eq_insert_aux sym equivalence_axioms)
   2.472 +
   2.473 +lemma (in equivalence) set_eq_pairI:
   2.474 +  assumes xx': "x .= x'"
   2.475 +    and carr: "x \<in> carrier S" "x' \<in> carrier S" "y \<in> carrier S"
   2.476 +  shows "{x, y} {.=} {x', y}"
   2.477 +  using assms set_eq_insert by simp
   2.478  
   2.479  lemma (in equivalence) closure_inclusion:
   2.480    assumes "A \<subseteq> B"
   2.481    shows "closure_of A \<subseteq> closure_of B"
   2.482 -  unfolding eq_closure_of_def
   2.483 -proof
   2.484 -  fix x
   2.485 -  assume "x \<in> {y \<in> carrier S. y .\<in> A}"
   2.486 -  hence "x \<in> carrier S \<and> x .\<in> A"
   2.487 -    by blast
   2.488 -  hence "x \<in> carrier S \<and> x .\<in> B"
   2.489 -    using assms elem_subsetD by blast
   2.490 -  thus "x \<in> {y \<in> carrier S. y .\<in> B}"
   2.491 -    by simp
   2.492 -qed
   2.493 +  unfolding eq_closure_of_def using assms elem_subsetD by auto
   2.494  
   2.495  lemma (in equivalence) classes_small:
   2.496    assumes "is_closed B"
   2.497      and "A \<subseteq> B"
   2.498    shows "closure_of A \<subseteq> B"
   2.499 -proof-
   2.500 -  have "closure_of A \<subseteq> closure_of B"
   2.501 -    using closure_inclusion assms by simp
   2.502 -  thus "closure_of A \<subseteq> B"
   2.503 -    using assms(1) eq_is_closed_def by fastforce
   2.504 -qed
   2.505 +  by (metis assms closure_inclusion eq_is_closed_def)
   2.506  
   2.507  lemma (in equivalence) classes_eq:
   2.508    assumes "A \<subseteq> carrier S"
   2.509    shows "A {.=} closure_of A"
   2.510 -using assms
   2.511 -by (blast intro: set_eqI elem_exact closure_of_memI elim: closure_of_memE)
   2.512 +  using assms by (blast intro: set_eqI elem_exact closure_of_memI elim: closure_of_memE)
   2.513  
   2.514  lemma (in equivalence) complete_classes:
   2.515 -  assumes c: "is_closed A"
   2.516 +  assumes "is_closed A"
   2.517    shows "A = closure_of A"
   2.518    using assms by (simp add: eq_is_closed_def)
   2.519  
   2.520 -lemma (in equivalence) closure_idemp_weak:
   2.521 +lemma (in equivalence) closure_idem_weak:
   2.522    "closure_of (closure_of A) {.=} closure_of A"
   2.523    by (simp add: classes_eq set_eq_sym)
   2.524  
   2.525 -lemma (in equivalence) closure_idemp_strong:
   2.526 +lemma (in equivalence) closure_idem_strong:
   2.527    assumes "A \<subseteq> carrier S"
   2.528    shows "closure_of (closure_of A) = closure_of A"
   2.529    using assms closure_of_eq complete_classes is_closedI by auto
   2.530  
   2.531 -lemma (in equivalence) complete_classes2:
   2.532 +lemma (in equivalence) classes_consistent:
   2.533    assumes "A \<subseteq> carrier S"
   2.534    shows "is_closed (closure_of A)"
   2.535 -  using closure_idemp_strong by (simp add: assms eq_is_closed_def)
   2.536 +  using closure_idem_strong by (simp add: assms eq_is_closed_def)
   2.537  
   2.538 -lemma equivalence_subset:
   2.539 -  assumes "equivalence L" "A \<subseteq> carrier L"
   2.540 -  shows "equivalence (L\<lparr> carrier := A \<rparr>)"
   2.541 +lemma (in equivalence) classes_coverture:
   2.542 +  "\<Union>classes = carrier S"
   2.543 +proof
   2.544 +  show "\<Union>classes \<subseteq> carrier S"
   2.545 +    unfolding eq_classes_def eq_class_of_def by blast
   2.546 +next
   2.547 +  show "carrier S \<subseteq> \<Union>classes" unfolding eq_classes_def eq_class_of_def
   2.548 +  proof
   2.549 +    fix x assume "x \<in> carrier S"
   2.550 +    hence "x \<in> {y \<in> carrier S. x .= y}" using refl by simp
   2.551 +    thus "x \<in> \<Union>{{y \<in> carrier S. x .= y} |x. x \<in> carrier S}" by blast
   2.552 +  qed
   2.553 +qed
   2.554 +
   2.555 +lemma (in equivalence) disjoint_union:
   2.556 +  assumes "class1 \<in> classes" "class2 \<in> classes"
   2.557 +    and "class1 \<inter> class2 \<noteq> {}"
   2.558 +    shows "class1 = class2"
   2.559  proof -
   2.560 -  interpret L: equivalence L
   2.561 -    by (simp add: assms)
   2.562 -  show ?thesis
   2.563 -    by (unfold_locales, simp_all add: L.sym assms rev_subsetD, meson L.trans assms(2) contra_subsetD)
   2.564 +  obtain x y where x: "x \<in> carrier S" "class1 = class_of x"
   2.565 +               and y: "y \<in> carrier S" "class2 = class_of y"
   2.566 +    using assms(1-2) unfolding eq_classes_def by blast
   2.567 +  obtain z   where z: "z \<in> carrier S" "z \<in> class1 \<inter> class2"
   2.568 +    using assms classes_coverture by fastforce
   2.569 +  hence "x .= z \<and> y .= z" using x y unfolding eq_class_of_def by blast
   2.570 +  hence "x .= y" using x y z trans sym by meson
   2.571 +  hence "class_of x = class_of y"
   2.572 +    unfolding eq_class_of_def using local.sym trans x y by blast
   2.573 +  thus ?thesis using x y by simp
   2.574 +qed
   2.575 +
   2.576 +lemma (in equivalence) partition_from_equivalence:
   2.577 +  "partition (carrier S) classes"
   2.578 +proof (intro partitionI)
   2.579 +  show "\<Union>classes = carrier S" using classes_coverture by simp
   2.580 +next
   2.581 +  show "\<And>class1 class2. \<lbrakk> class1 \<in> classes; class2 \<in> classes \<rbrakk> \<Longrightarrow>
   2.582 +                          class1 \<inter> class2 \<noteq> {} \<Longrightarrow> class1 = class2"
   2.583 +    using disjoint_union by simp
   2.584 +qed
   2.585 +
   2.586 +lemma (in equivalence) disjoint_sum:
   2.587 +  assumes "finite (carrier S)"
   2.588 +  shows "(\<Sum>c\<in>classes. \<Sum>x\<in>c. f x) = (\<Sum>x\<in>(carrier S). f x)"
   2.589 +proof -
   2.590 +  have "finite classes"
   2.591 +    unfolding eq_classes_def using assms by auto
   2.592 +  thus ?thesis using disjoint_sum assms partition_from_equivalence by blast
   2.593  qed
   2.594    
   2.595  end
     3.1 --- a/src/HOL/Algebra/Coset.thy	Thu Jun 14 15:45:53 2018 +0200
     3.2 +++ b/src/HOL/Algebra/Coset.thy	Thu Jun 14 15:20:20 2018 +0100
     3.3 @@ -1,7 +1,6 @@
     3.4  (*  Title:      HOL/Algebra/Coset.thy
     3.5 -    Author:     Florian Kammueller
     3.6 -    Author:     L C Paulson
     3.7 -    Author:     Stephan Hohe
     3.8 +    Authors:     Florian Kammueller, L C Paulson, Stephan Hohe
     3.9 +With additional contributions from Martin Baillon and Paulo Emílio de Vilhena.
    3.10  *)
    3.11  
    3.12  theory Coset
    3.13 @@ -38,346 +37,321 @@
    3.14    normal_rel :: "['a set, ('a, 'b) monoid_scheme] \<Rightarrow> bool"  (infixl "\<lhd>" 60) where
    3.15    "H \<lhd> G \<equiv> normal H G"
    3.16  
    3.17 +(* ************************************************************************** *)
    3.18 +(* Next two lemmas contributed by Martin Baillon.                                  *)
    3.19 +
    3.20 +lemma l_coset_eq_set_mult:
    3.21 +  fixes G (structure)
    3.22 +  shows "x <# H = {x} <#> H"
    3.23 +  unfolding l_coset_def set_mult_def by simp 
    3.24 +
    3.25 +lemma r_coset_eq_set_mult:
    3.26 +  fixes G (structure)
    3.27 +  shows "H #> x = H <#> {x}"
    3.28 +  unfolding r_coset_def set_mult_def by simp
    3.29 +
    3.30 +(* ************************************************************************** *)
    3.31 +
    3.32 +
    3.33 +(* ************************************************************************** *)
    3.34 +(* Next five lemmas contributed by Paulo Emílio de Vilhena.                    *)
    3.35 +
    3.36 +lemma (in subgroup) rcosets_not_empty:
    3.37 +  assumes "R \<in> rcosets H"
    3.38 +  shows "R \<noteq> {}"
    3.39 +proof -
    3.40 +  obtain g where "g \<in> carrier G" "R = H #> g"
    3.41 +    using assms unfolding RCOSETS_def by blast
    3.42 +  hence "\<one> \<otimes> g \<in> R"
    3.43 +    using one_closed unfolding r_coset_def by blast
    3.44 +  thus ?thesis by blast
    3.45 +qed
    3.46 +
    3.47 +lemma (in group) diff_neutralizes:
    3.48 +  assumes "subgroup H G" "R \<in> rcosets H"
    3.49 +  shows "\<And>r1 r2. \<lbrakk> r1 \<in> R; r2 \<in> R \<rbrakk> \<Longrightarrow> r1 \<otimes> (inv r2) \<in> H"
    3.50 +proof -
    3.51 +  fix r1 r2 assume r1: "r1 \<in> R" and r2: "r2 \<in> R"
    3.52 +  obtain g where g: "g \<in> carrier G" "R = H #> g"
    3.53 +    using assms unfolding RCOSETS_def by blast
    3.54 +  then obtain h1 h2 where h1: "h1 \<in> H" "r1 = h1 \<otimes> g"
    3.55 +                      and h2: "h2 \<in> H" "r2 = h2 \<otimes> g"
    3.56 +    using r1 r2 unfolding r_coset_def by blast
    3.57 +  hence "r1 \<otimes> (inv r2) = (h1 \<otimes> g) \<otimes> ((inv g) \<otimes> (inv h2))"
    3.58 +    using inv_mult_group is_group assms(1) g(1) subgroup.mem_carrier by fastforce 
    3.59 +  also have " ... =  (h1 \<otimes> (g \<otimes> inv g) \<otimes> inv h2)"
    3.60 +    using h1 h2 assms(1) g(1) inv_closed m_closed monoid.m_assoc
    3.61 +          monoid_axioms subgroup.mem_carrier by smt
    3.62 +  finally have "r1 \<otimes> inv r2 = h1 \<otimes> inv h2"
    3.63 +    using assms(1) g(1) h1(1) subgroup.mem_carrier by fastforce
    3.64 +  thus "r1 \<otimes> inv r2 \<in> H" by (metis assms(1) h1(1) h2(1) subgroup_def)
    3.65 +qed
    3.66 +
    3.67 +
    3.68 +subsection \<open>Stable Operations for Subgroups\<close>
    3.69 +
    3.70 +lemma (in group) subgroup_set_mult_equality[simp]:
    3.71 +  assumes "subgroup H G" "I \<subseteq> H" "J \<subseteq> H"
    3.72 +  shows "I <#>\<^bsub>G \<lparr> carrier := H \<rparr>\<^esub> J = I <#> J"
    3.73 +  unfolding set_mult_def subgroup_mult_equality[OF assms(1)] by auto
    3.74 +
    3.75 +lemma (in group) subgroup_rcos_equality[simp]:
    3.76 +  assumes "subgroup H G" "I \<subseteq> H" "h \<in> H"
    3.77 +  shows "I #>\<^bsub>G \<lparr> carrier := H \<rparr>\<^esub> h = I #> h"
    3.78 +  using subgroup_set_mult_equality by (simp add: r_coset_eq_set_mult assms)
    3.79 +
    3.80 +lemma (in group) subgroup_lcos_equality[simp]:
    3.81 +  assumes "subgroup H G" "I \<subseteq> H" "h \<in> H"
    3.82 +  shows "h <#\<^bsub>G \<lparr> carrier := H \<rparr>\<^esub> I = h <# I"
    3.83 +  using subgroup_set_mult_equality by (simp add: l_coset_eq_set_mult assms)
    3.84 +
    3.85 +                                 
    3.86 +
    3.87 +subsection \<open>Basic Properties of set multiplication\<close>
    3.88 +
    3.89 +lemma (in group) setmult_subset_G:
    3.90 +  assumes "H \<subseteq> carrier G" "K \<subseteq> carrier G"
    3.91 +  shows "H <#> K \<subseteq> carrier G" using assms
    3.92 +  by (auto simp add: set_mult_def subsetD)
    3.93 +
    3.94 +lemma (in monoid) set_mult_closed:
    3.95 +  assumes "H \<subseteq> carrier G" "K \<subseteq> carrier G"
    3.96 +  shows "H <#> K \<subseteq> carrier G"
    3.97 +  using assms by (auto simp add: set_mult_def subsetD)
    3.98 +
    3.99 +(* Next lemma contributed by Martin Baillon.*)
   3.100 +lemma (in group) set_mult_assoc:
   3.101 +  assumes "M \<subseteq> carrier G" "H \<subseteq> carrier G" "K \<subseteq> carrier G"
   3.102 +  shows "(M <#> H) <#> K = M <#> (H <#> K)"
   3.103 +proof
   3.104 +  show "(M <#> H) <#> K \<subseteq> M <#> (H <#> K)"
   3.105 +  proof
   3.106 +    fix x assume "x \<in> (M <#> H) <#> K"
   3.107 +    then obtain m h k where x: "m \<in> M" "h \<in> H" "k \<in> K" "x = (m \<otimes> h) \<otimes> k"
   3.108 +      unfolding set_mult_def by blast
   3.109 +    hence "x = m \<otimes> (h \<otimes> k)"
   3.110 +      using assms m_assoc by blast
   3.111 +    thus "x \<in> M <#> (H <#> K)"
   3.112 +      unfolding set_mult_def using x by blast
   3.113 +  qed
   3.114 +next
   3.115 +  show "M <#> (H <#> K) \<subseteq> (M <#> H) <#> K"
   3.116 +  proof
   3.117 +    fix x assume "x \<in> M <#> (H <#> K)"
   3.118 +    then obtain m h k where x: "m \<in> M" "h \<in> H" "k \<in> K" "x = m \<otimes> (h \<otimes> k)"
   3.119 +      unfolding set_mult_def by blast
   3.120 +    hence "x = (m \<otimes> h) \<otimes> k"
   3.121 +      using assms m_assoc rev_subsetD by metis
   3.122 +    thus "x \<in> (M <#> H) <#> K"
   3.123 +      unfolding set_mult_def using x by blast
   3.124 +  qed
   3.125 +qed
   3.126 +
   3.127 +
   3.128  
   3.129  subsection \<open>Basic Properties of Cosets\<close>
   3.130  
   3.131  lemma (in group) coset_mult_assoc:
   3.132 -     "[| M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G |]
   3.133 -      ==> (M #> g) #> h = M #> (g \<otimes> h)"
   3.134 -by (force simp add: r_coset_def m_assoc)
   3.135 +  assumes "M \<subseteq> carrier G" "g \<in> carrier G" "h \<in> carrier G"
   3.136 +  shows "(M #> g) #> h = M #> (g \<otimes> h)"
   3.137 +  using assms by (force simp add: r_coset_def m_assoc)
   3.138 +
   3.139 +lemma (in group) coset_assoc:
   3.140 +  assumes "x \<in> carrier G" "y \<in> carrier G" "H \<subseteq> carrier G"
   3.141 +  shows "x <# (H #> y) = (x <# H) #> y"
   3.142 +  using set_mult_assoc[of "{x}" H "{y}"]
   3.143 +  by (simp add: l_coset_eq_set_mult r_coset_eq_set_mult assms)
   3.144  
   3.145  lemma (in group) coset_mult_one [simp]: "M \<subseteq> carrier G ==> M #> \<one> = M"
   3.146  by (force simp add: r_coset_def)
   3.147  
   3.148  lemma (in group) coset_mult_inv1:
   3.149 -     "[| M #> (x \<otimes> (inv y)) = M;  x \<in> carrier G ; y \<in> carrier G;
   3.150 -         M \<subseteq> carrier G |] ==> M #> x = M #> y"
   3.151 -apply (erule subst [of concl: "%z. M #> x = z #> y"])
   3.152 -apply (simp add: coset_mult_assoc m_assoc)
   3.153 -done
   3.154 +  assumes "M #> (x \<otimes> (inv y)) = M"
   3.155 +    and "x \<in> carrier G" "y \<in> carrier G" "M \<subseteq> carrier G"
   3.156 +  shows "M #> x = M #> y" using assms
   3.157 +  by (metis coset_mult_assoc group.inv_solve_right is_group subgroup_def subgroup_self)
   3.158  
   3.159  lemma (in group) coset_mult_inv2:
   3.160 -     "[| M #> x = M #> y;  x \<in> carrier G;  y \<in> carrier G;  M \<subseteq> carrier G |]
   3.161 -      ==> M #> (x \<otimes> (inv y)) = M "
   3.162 -apply (simp add: coset_mult_assoc [symmetric])
   3.163 -apply (simp add: coset_mult_assoc)
   3.164 -done
   3.165 +  assumes "M #> x = M #> y"
   3.166 +    and "x \<in> carrier G"  "y \<in> carrier G" "M \<subseteq> carrier G"
   3.167 +  shows "M #> (x \<otimes> (inv y)) = M " using assms
   3.168 +  by (metis group.coset_mult_assoc group.coset_mult_one inv_closed is_group r_inv) 
   3.169  
   3.170  lemma (in group) coset_join1:
   3.171 -     "[| H #> x = H;  x \<in> carrier G;  subgroup H G |] ==> x \<in> H"
   3.172 -apply (erule subst)
   3.173 -apply (simp add: r_coset_def)
   3.174 -apply (blast intro: l_one subgroup.one_closed sym)
   3.175 -done
   3.176 +  assumes "H #> x = H"
   3.177 +    and "x \<in> carrier G" "subgroup H G"
   3.178 +  shows "x \<in> H"
   3.179 +  using assms r_coset_def l_one subgroup.one_closed sym by fastforce
   3.180  
   3.181  lemma (in group) solve_equation:
   3.182 -    "\<lbrakk>subgroup H G; x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> \<exists>h\<in>H. y = h \<otimes> x"
   3.183 -apply (rule bexI [of _ "y \<otimes> (inv x)"])
   3.184 -apply (auto simp add: subgroup.m_closed subgroup.m_inv_closed m_assoc
   3.185 -                      subgroup.subset [THEN subsetD])
   3.186 -done
   3.187 +  assumes "subgroup H G" "x \<in> H" "y \<in> H"
   3.188 +  shows "\<exists>h \<in> H. y = h \<otimes> x"
   3.189 +proof -
   3.190 +  have "y = (y \<otimes> (inv x)) \<otimes> x" using assms
   3.191 +    by (simp add: m_assoc subgroup.mem_carrier)
   3.192 +  moreover have "y \<otimes> (inv x) \<in> H" using assms
   3.193 +    by (simp add: subgroup_def)
   3.194 +  ultimately show ?thesis by blast
   3.195 +qed
   3.196  
   3.197  lemma (in group) repr_independence:
   3.198 -     "\<lbrakk>y \<in> H #> x;  x \<in> carrier G; subgroup H G\<rbrakk> \<Longrightarrow> H #> x = H #> y"
   3.199 +  assumes "y \<in> H #> x" "x \<in> carrier G" "subgroup H G"
   3.200 +  shows "H #> x = H #> y" using assms
   3.201  by (auto simp add: r_coset_def m_assoc [symmetric]
   3.202                     subgroup.subset [THEN subsetD]
   3.203                     subgroup.m_closed solve_equation)
   3.204  
   3.205  lemma (in group) coset_join2:
   3.206 -     "\<lbrakk>x \<in> carrier G;  subgroup H G;  x\<in>H\<rbrakk> \<Longrightarrow> H #> x = H"
   3.207 +  assumes "x \<in> carrier G" "subgroup H G" "x \<in> H"
   3.208 +  shows "H #> x = H" using assms
   3.209    \<comment> \<open>Alternative proof is to put @{term "x=\<one>"} in \<open>repr_independence\<close>.\<close>
   3.210  by (force simp add: subgroup.m_closed r_coset_def solve_equation)
   3.211  
   3.212 +lemma (in group) coset_join3:
   3.213 +  assumes "x \<in> carrier G" "subgroup H G" "x \<in> H"
   3.214 +  shows "x <# H = H"
   3.215 +proof
   3.216 +  have "\<And>h. h \<in> H \<Longrightarrow> x \<otimes> h \<in> H" using assms
   3.217 +    by (simp add: subgroup.m_closed)
   3.218 +  thus "x <# H \<subseteq> H" unfolding l_coset_def by blast
   3.219 +next
   3.220 +  have "\<And>h. h \<in> H \<Longrightarrow> x \<otimes> ((inv x) \<otimes> h) = h"
   3.221 +    by (smt assms inv_closed l_one m_assoc r_inv subgroup.mem_carrier)
   3.222 +  moreover have "\<And>h. h \<in> H \<Longrightarrow> (inv x) \<otimes> h \<in> H"
   3.223 +    by (simp add: assms subgroup.m_closed subgroup.m_inv_closed)
   3.224 +  ultimately show "H \<subseteq> x <# H" unfolding l_coset_def by blast
   3.225 +qed
   3.226 +
   3.227  lemma (in monoid) r_coset_subset_G:
   3.228 -     "[| H \<subseteq> carrier G; x \<in> carrier G |] ==> H #> x \<subseteq> carrier G"
   3.229 +  "\<lbrakk> H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> H #> x \<subseteq> carrier G"
   3.230  by (auto simp add: r_coset_def)
   3.231  
   3.232  lemma (in group) rcosI:
   3.233 -     "[| h \<in> H; H \<subseteq> carrier G; x \<in> carrier G|] ==> h \<otimes> x \<in> H #> x"
   3.234 +  "\<lbrakk> h \<in> H; H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> h \<otimes> x \<in> H #> x"
   3.235  by (auto simp add: r_coset_def)
   3.236  
   3.237  lemma (in group) rcosetsI:
   3.238       "\<lbrakk>H \<subseteq> carrier G; x \<in> carrier G\<rbrakk> \<Longrightarrow> H #> x \<in> rcosets H"
   3.239  by (auto simp add: RCOSETS_def)
   3.240  
   3.241 -text\<open>Really needed?\<close>
   3.242 -lemma (in group) transpose_inv:
   3.243 -     "[| x \<otimes> y = z;  x \<in> carrier G;  y \<in> carrier G;  z \<in> carrier G |]
   3.244 -      ==> (inv x) \<otimes> z = y"
   3.245 -by (force simp add: m_assoc [symmetric])
   3.246 -
   3.247 -lemma (in group) rcos_self: "[| x \<in> carrier G; subgroup H G |] ==> x \<in> H #> x"
   3.248 -apply (simp add: r_coset_def)
   3.249 -apply (blast intro: sym l_one subgroup.subset [THEN subsetD]
   3.250 -                    subgroup.one_closed)
   3.251 -done
   3.252 +lemma (in group) rcos_self:
   3.253 +  "\<lbrakk> x \<in> carrier G; subgroup H G \<rbrakk> \<Longrightarrow> x \<in> H #> x"
   3.254 +  by (metis l_one rcosI subgroup_def)
   3.255  
   3.256  text (in group) \<open>Opposite of @{thm [source] "repr_independence"}\<close>
   3.257  lemma (in group) repr_independenceD:
   3.258 -  assumes "subgroup H G"
   3.259 -  assumes ycarr: "y \<in> carrier G"
   3.260 -      and repr:  "H #> x = H #> y"
   3.261 +  assumes "subgroup H G" "y \<in> carrier G"
   3.262 +    and "H #> x = H #> y"
   3.263    shows "y \<in> H #> x"
   3.264 -proof -
   3.265 -  interpret subgroup H G by fact
   3.266 -  show ?thesis  apply (subst repr)
   3.267 -  apply (intro rcos_self)
   3.268 -   apply (rule ycarr)
   3.269 -   apply (rule is_subgroup)
   3.270 -  done
   3.271 -qed
   3.272 +  using assms by (simp add: rcos_self)
   3.273  
   3.274  text \<open>Elements of a right coset are in the carrier\<close>
   3.275  lemma (in subgroup) elemrcos_carrier:
   3.276 -  assumes "group G"
   3.277 -  assumes acarr: "a \<in> carrier G"
   3.278 -    and a': "a' \<in> H #> a"
   3.279 +  assumes "group G" "a \<in> carrier G"
   3.280 +    and "a' \<in> H #> a"
   3.281    shows "a' \<in> carrier G"
   3.282 +  by (meson assms group.is_monoid monoid.r_coset_subset_G subset subsetCE)
   3.283 +
   3.284 +lemma (in subgroup) rcos_const:
   3.285 +  assumes "group G" "h \<in> H"
   3.286 +  shows "H #> h = H"
   3.287 +  using group.coset_join2[OF assms(1), of h H]
   3.288 +  by (simp add: assms(2) subgroup_axioms)
   3.289 +
   3.290 +lemma (in subgroup) rcos_module_imp:
   3.291 +  assumes "group G" "x \<in> carrier G"
   3.292 +    and "x' \<in> H #> x"
   3.293 +  shows "(x' \<otimes> inv x) \<in> H"
   3.294  proof -
   3.295 -  interpret group G by fact
   3.296 -  from subset and acarr
   3.297 -  have "H #> a \<subseteq> carrier G" by (rule r_coset_subset_G)
   3.298 -  from this and a'
   3.299 -  show "a' \<in> carrier G"
   3.300 -    by fast
   3.301 +  obtain h where h: "h \<in> H" "x' = h \<otimes> x"
   3.302 +    using assms(3) unfolding r_coset_def by blast
   3.303 +  hence "x' \<otimes> inv x = h"
   3.304 +    by (metis assms elemrcos_carrier group.inv_solve_right mem_carrier)
   3.305 +  thus ?thesis using h by blast
   3.306  qed
   3.307  
   3.308 -lemma (in subgroup) rcos_const:
   3.309 -  assumes "group G"
   3.310 -  assumes hH: "h \<in> H"
   3.311 -  shows "H #> h = H"
   3.312 -proof -
   3.313 -  interpret group G by fact
   3.314 -  show ?thesis apply (unfold r_coset_def)
   3.315 -    apply rule
   3.316 -    apply rule
   3.317 -    apply clarsimp
   3.318 -    apply (intro subgroup.m_closed)
   3.319 -    apply (rule is_subgroup)
   3.320 -    apply assumption
   3.321 -    apply (rule hH)
   3.322 -    apply rule
   3.323 -    apply simp
   3.324 -  proof -
   3.325 -    fix h'
   3.326 -    assume h'H: "h' \<in> H"
   3.327 -    note carr = hH[THEN mem_carrier] h'H[THEN mem_carrier]
   3.328 -    from carr
   3.329 -    have a: "h' = (h' \<otimes> inv h) \<otimes> h" by (simp add: m_assoc)
   3.330 -    from h'H hH
   3.331 -    have "h' \<otimes> inv h \<in> H" by simp
   3.332 -    from this and a
   3.333 -    show "\<exists>x\<in>H. h' = x \<otimes> h" by fast
   3.334 -  qed
   3.335 -qed
   3.336 -
   3.337 -text \<open>Step one for lemma \<open>rcos_module\<close>\<close>
   3.338 -lemma (in subgroup) rcos_module_imp:
   3.339 -  assumes "group G"
   3.340 -  assumes xcarr: "x \<in> carrier G"
   3.341 -      and x'cos: "x' \<in> H #> x"
   3.342 -  shows "(x' \<otimes> inv x) \<in> H"
   3.343 -proof -
   3.344 -  interpret group G by fact
   3.345 -  from xcarr x'cos
   3.346 -      have x'carr: "x' \<in> carrier G"
   3.347 -      by (rule elemrcos_carrier[OF is_group])
   3.348 -  from xcarr
   3.349 -      have ixcarr: "inv x \<in> carrier G"
   3.350 -      by simp
   3.351 -  from x'cos
   3.352 -      have "\<exists>h\<in>H. x' = h \<otimes> x"
   3.353 -      unfolding r_coset_def
   3.354 -      by fast
   3.355 -  from this
   3.356 -      obtain h
   3.357 -        where hH: "h \<in> H"
   3.358 -        and x': "x' = h \<otimes> x"
   3.359 -      by auto
   3.360 -  from hH and subset
   3.361 -      have hcarr: "h \<in> carrier G" by fast
   3.362 -  note carr = xcarr x'carr hcarr
   3.363 -  from x' and carr
   3.364 -      have "x' \<otimes> (inv x) = (h \<otimes> x) \<otimes> (inv x)" by fast
   3.365 -  also from carr
   3.366 -      have "\<dots> = h \<otimes> (x \<otimes> inv x)" by (simp add: m_assoc)
   3.367 -  also from carr
   3.368 -      have "\<dots> = h \<otimes> \<one>" by simp
   3.369 -  also from carr
   3.370 -      have "\<dots> = h" by simp
   3.371 -  finally
   3.372 -      have "x' \<otimes> (inv x) = h" by simp
   3.373 -  from hH this
   3.374 -      show "x' \<otimes> (inv x) \<in> H" by simp
   3.375 -qed
   3.376 -
   3.377 -text \<open>Step two for lemma \<open>rcos_module\<close>\<close>
   3.378  lemma (in subgroup) rcos_module_rev:
   3.379 -  assumes "group G"
   3.380 -  assumes carr: "x \<in> carrier G" "x' \<in> carrier G"
   3.381 -      and xixH: "(x' \<otimes> inv x) \<in> H"
   3.382 +  assumes "group G" "x \<in> carrier G" "x' \<in> carrier G"
   3.383 +    and "(x' \<otimes> inv x) \<in> H"
   3.384    shows "x' \<in> H #> x"
   3.385  proof -
   3.386 -  interpret group G by fact
   3.387 -  from xixH
   3.388 -      have "\<exists>h\<in>H. x' \<otimes> (inv x) = h" by fast
   3.389 -  from this
   3.390 -      obtain h
   3.391 -        where hH: "h \<in> H"
   3.392 -        and hsym: "x' \<otimes> (inv x) = h"
   3.393 -      by fast
   3.394 -  from hH subset have hcarr: "h \<in> carrier G" by simp
   3.395 -  note carr = carr hcarr
   3.396 -  from hsym[symmetric] have "h \<otimes> x = x' \<otimes> (inv x) \<otimes> x" by fast
   3.397 -  also from carr
   3.398 -      have "\<dots> = x' \<otimes> ((inv x) \<otimes> x)" by (simp add: m_assoc)
   3.399 -  also from carr
   3.400 -      have "\<dots> = x' \<otimes> \<one>" by simp
   3.401 -  also from carr
   3.402 -      have "\<dots> = x'" by simp
   3.403 -  finally
   3.404 -      have "h \<otimes> x = x'" by simp
   3.405 -  from this[symmetric] and hH
   3.406 -      show "x' \<in> H #> x"
   3.407 -      unfolding r_coset_def
   3.408 -      by fast
   3.409 +  obtain h where h: "h \<in> H" "x' \<otimes> inv x = h"
   3.410 +    using assms(4) unfolding r_coset_def by blast
   3.411 +  hence "x' = h \<otimes> x"
   3.412 +    by (metis assms group.inv_solve_right mem_carrier)
   3.413 +  thus ?thesis using h unfolding r_coset_def by blast
   3.414  qed
   3.415  
   3.416  text \<open>Module property of right cosets\<close>
   3.417  lemma (in subgroup) rcos_module:
   3.418 -  assumes "group G"
   3.419 -  assumes carr: "x \<in> carrier G" "x' \<in> carrier G"
   3.420 +  assumes "group G" "x \<in> carrier G" "x' \<in> carrier G"
   3.421    shows "(x' \<in> H #> x) = (x' \<otimes> inv x \<in> H)"
   3.422 -proof -
   3.423 -  interpret group G by fact
   3.424 -  show ?thesis proof  assume "x' \<in> H #> x"
   3.425 -    from this and carr
   3.426 -    show "x' \<otimes> inv x \<in> H"
   3.427 -      by (intro rcos_module_imp[OF is_group])
   3.428 -  next
   3.429 -    assume "x' \<otimes> inv x \<in> H"
   3.430 -    from this and carr
   3.431 -    show "x' \<in> H #> x"
   3.432 -      by (intro rcos_module_rev[OF is_group])
   3.433 +  using rcos_module_rev rcos_module_imp assms by blast
   3.434 +
   3.435 +text \<open>Right cosets are subsets of the carrier.\<close> 
   3.436 +lemma (in subgroup) rcosets_carrier:
   3.437 +  assumes "group G" "X \<in> rcosets H"
   3.438 +  shows "X \<subseteq> carrier G"
   3.439 +  using assms elemrcos_carrier singletonD
   3.440 +  subset_eq unfolding RCOSETS_def by force 
   3.441 +
   3.442 +
   3.443 +text \<open>Multiplication of general subsets\<close>
   3.444 +
   3.445 +lemma (in comm_group) mult_subgroups:
   3.446 +  assumes "subgroup H G" and "subgroup K G"
   3.447 +  shows "subgroup (H <#> K) G"
   3.448 +proof (rule subgroup.intro)
   3.449 +  show "H <#> K \<subseteq> carrier G"
   3.450 +    by (simp add: setmult_subset_G assms subgroup_imp_subset)
   3.451 +next
   3.452 +  have "\<one> \<otimes> \<one> \<in> H <#> K"
   3.453 +    unfolding set_mult_def using assms subgroup.one_closed by blast
   3.454 +  thus "\<one> \<in> H <#> K" by simp
   3.455 +next
   3.456 +  show "\<And>x. x \<in> H <#> K \<Longrightarrow> inv x \<in> H <#> K"
   3.457 +  proof -
   3.458 +    fix x assume "x \<in> H <#> K"
   3.459 +    then obtain h k where hk: "h \<in> H" "k \<in> K" "x = h \<otimes> k"
   3.460 +      unfolding set_mult_def by blast
   3.461 +    hence "inv x = (inv k) \<otimes> (inv h)"
   3.462 +      by (meson inv_mult_group assms subgroup.mem_carrier)
   3.463 +    hence "inv x = (inv h) \<otimes> (inv k)"
   3.464 +      by (metis hk inv_mult assms subgroup.mem_carrier)
   3.465 +    thus "inv x \<in> H <#> K"
   3.466 +      unfolding set_mult_def using hk assms
   3.467 +      by (metis (no_types, lifting) UN_iff singletonI subgroup_def)
   3.468 +  qed
   3.469 +next
   3.470 +  show "\<And>x y. x \<in> H <#> K \<Longrightarrow> y \<in> H <#> K \<Longrightarrow> x \<otimes> y \<in> H <#> K"
   3.471 +  proof -
   3.472 +    fix x y assume "x \<in> H <#> K" "y \<in> H <#> K"
   3.473 +    then obtain h1 k1 h2 k2 where h1k1: "h1 \<in> H" "k1 \<in> K" "x = h1 \<otimes> k1"
   3.474 +                              and h2k2: "h2 \<in> H" "k2 \<in> K" "y = h2 \<otimes> k2"
   3.475 +      unfolding set_mult_def by blast
   3.476 +    hence "x \<otimes> y = (h1 \<otimes> k1) \<otimes> (h2 \<otimes> k2)" by simp
   3.477 +    also have " ... = h1 \<otimes> (k1 \<otimes> h2) \<otimes> k2"
   3.478 +      by (smt h1k1 h2k2 m_assoc m_closed assms subgroup.mem_carrier)
   3.479 +    also have " ... = h1 \<otimes> (h2 \<otimes> k1) \<otimes> k2"
   3.480 +      by (metis (no_types, hide_lams) assms m_comm h1k1(2) h2k2(1) subgroup.mem_carrier)
   3.481 +    finally have "x \<otimes> y  = (h1 \<otimes> h2) \<otimes> (k1 \<otimes> k2)"
   3.482 +      by (smt assms h1k1 h2k2 m_assoc monoid.m_closed monoid_axioms subgroup.mem_carrier)
   3.483 +    thus "x \<otimes> y \<in> H <#> K" unfolding set_mult_def
   3.484 +      using subgroup.m_closed[OF assms(1) h1k1(1) h2k2(1)]
   3.485 +            subgroup.m_closed[OF assms(2) h1k1(2) h2k2(2)] by blast
   3.486    qed
   3.487  qed
   3.488  
   3.489 -text \<open>Right cosets are subsets of the carrier.\<close> 
   3.490 -lemma (in subgroup) rcosets_carrier:
   3.491 -  assumes "group G"
   3.492 -  assumes XH: "X \<in> rcosets H"
   3.493 -  shows "X \<subseteq> carrier G"
   3.494 -proof -
   3.495 -  interpret group G by fact
   3.496 -  from XH have "\<exists>x\<in> carrier G. X = H #> x"
   3.497 -      unfolding RCOSETS_def
   3.498 -      by fast
   3.499 -  from this
   3.500 -      obtain x
   3.501 -        where xcarr: "x\<in> carrier G"
   3.502 -        and X: "X = H #> x"
   3.503 -      by fast
   3.504 -  from subset and xcarr
   3.505 -      show "X \<subseteq> carrier G"
   3.506 -      unfolding X
   3.507 -      by (rule r_coset_subset_G)
   3.508 -qed
   3.509 -
   3.510 -text \<open>Multiplication of general subsets\<close>
   3.511 -lemma (in monoid) set_mult_closed:
   3.512 -  assumes Acarr: "A \<subseteq> carrier G"
   3.513 -      and Bcarr: "B \<subseteq> carrier G"
   3.514 -  shows "A <#> B \<subseteq> carrier G"
   3.515 -apply rule apply (simp add: set_mult_def, clarsimp)
   3.516 -proof -
   3.517 -  fix a b
   3.518 -  assume "a \<in> A"
   3.519 -  from this and Acarr
   3.520 -      have acarr: "a \<in> carrier G" by fast
   3.521 -
   3.522 -  assume "b \<in> B"
   3.523 -  from this and Bcarr
   3.524 -      have bcarr: "b \<in> carrier G" by fast
   3.525 -
   3.526 -  from acarr bcarr
   3.527 -      show "a \<otimes> b \<in> carrier G" by (rule m_closed)
   3.528 -qed
   3.529 -
   3.530 -lemma (in comm_group) mult_subgroups:
   3.531 -  assumes subH: "subgroup H G"
   3.532 -      and subK: "subgroup K G"
   3.533 -  shows "subgroup (H <#> K) G"
   3.534 -apply (rule subgroup.intro)
   3.535 -   apply (intro set_mult_closed subgroup.subset[OF subH] subgroup.subset[OF subK])
   3.536 -  apply (simp add: set_mult_def) apply clarsimp defer 1
   3.537 -  apply (simp add: set_mult_def) defer 1
   3.538 -  apply (simp add: set_mult_def, clarsimp) defer 1
   3.539 -proof -
   3.540 -  fix ha hb ka kb
   3.541 -  assume haH: "ha \<in> H" and hbH: "hb \<in> H" and kaK: "ka \<in> K" and kbK: "kb \<in> K"
   3.542 -  note carr = haH[THEN subgroup.mem_carrier[OF subH]] hbH[THEN subgroup.mem_carrier[OF subH]]
   3.543 -              kaK[THEN subgroup.mem_carrier[OF subK]] kbK[THEN subgroup.mem_carrier[OF subK]]
   3.544 -  from carr
   3.545 -      have "(ha \<otimes> ka) \<otimes> (hb \<otimes> kb) = ha \<otimes> (ka \<otimes> hb) \<otimes> kb" by (simp add: m_assoc)
   3.546 -  also from carr
   3.547 -      have "\<dots> = ha \<otimes> (hb \<otimes> ka) \<otimes> kb" by (simp add: m_comm)
   3.548 -  also from carr
   3.549 -      have "\<dots> = (ha \<otimes> hb) \<otimes> (ka \<otimes> kb)" by (simp add: m_assoc)
   3.550 -  finally
   3.551 -      have eq: "(ha \<otimes> ka) \<otimes> (hb \<otimes> kb) = (ha \<otimes> hb) \<otimes> (ka \<otimes> kb)" .
   3.552 -
   3.553 -  from haH hbH have hH: "ha \<otimes> hb \<in> H" by (simp add: subgroup.m_closed[OF subH])
   3.554 -  from kaK kbK have kK: "ka \<otimes> kb \<in> K" by (simp add: subgroup.m_closed[OF subK])
   3.555 -  
   3.556 -  from hH and kK and eq
   3.557 -      show "\<exists>h'\<in>H. \<exists>k'\<in>K. (ha \<otimes> ka) \<otimes> (hb \<otimes> kb) = h' \<otimes> k'" by fast
   3.558 -next
   3.559 -  have "\<one> = \<one> \<otimes> \<one>" by simp
   3.560 -  from subgroup.one_closed[OF subH] subgroup.one_closed[OF subK] this
   3.561 -      show "\<exists>h\<in>H. \<exists>k\<in>K. \<one> = h \<otimes> k" by fast
   3.562 -next
   3.563 -  fix h k
   3.564 -  assume hH: "h \<in> H"
   3.565 -     and kK: "k \<in> K"
   3.566 -
   3.567 -  from hH[THEN subgroup.mem_carrier[OF subH]] kK[THEN subgroup.mem_carrier[OF subK]]
   3.568 -      have "inv (h \<otimes> k) = inv h \<otimes> inv k" by (simp add: inv_mult_group m_comm)
   3.569 -
   3.570 -  from subgroup.m_inv_closed[OF subH hH] and subgroup.m_inv_closed[OF subK kK] and this
   3.571 -      show "\<exists>ha\<in>H. \<exists>ka\<in>K. inv (h \<otimes> k) = ha \<otimes> ka" by fast
   3.572 -qed
   3.573 -
   3.574  lemma (in subgroup) lcos_module_rev:
   3.575 -  assumes "group G"
   3.576 -  assumes carr: "x \<in> carrier G" "x' \<in> carrier G"
   3.577 -      and xixH: "(inv x \<otimes> x') \<in> H"
   3.578 +  assumes "group G" "x \<in> carrier G" "x' \<in> carrier G"
   3.579 +    and "(inv x \<otimes> x') \<in> H"
   3.580    shows "x' \<in> x <# H"
   3.581  proof -
   3.582 -  interpret group G by fact
   3.583 -  from xixH
   3.584 -      have "\<exists>h\<in>H. (inv x) \<otimes> x' = h" by fast
   3.585 -  from this
   3.586 -      obtain h
   3.587 -        where hH: "h \<in> H"
   3.588 -        and hsym: "(inv x) \<otimes> x' = h"
   3.589 -      by fast
   3.590 -
   3.591 -  from hH subset have hcarr: "h \<in> carrier G" by simp
   3.592 -  note carr = carr hcarr
   3.593 -  from hsym[symmetric] have "x \<otimes> h = x \<otimes> ((inv x) \<otimes> x')" by fast
   3.594 -  also from carr
   3.595 -      have "\<dots> = (x \<otimes> (inv x)) \<otimes> x'" by (simp add: m_assoc[symmetric])
   3.596 -  also from carr
   3.597 -      have "\<dots> = \<one> \<otimes> x'" by simp
   3.598 -  also from carr
   3.599 -      have "\<dots> = x'" by simp
   3.600 -  finally
   3.601 -      have "x \<otimes> h = x'" by simp
   3.602 -
   3.603 -  from this[symmetric] and hH
   3.604 -      show "x' \<in> x <# H"
   3.605 -      unfolding l_coset_def
   3.606 -      by fast
   3.607 +  obtain h where h: "h \<in> H" "inv x \<otimes> x' = h"
   3.608 +    using assms(4) unfolding l_coset_def by blast
   3.609 +  hence "x' = x \<otimes> h"
   3.610 +    by (metis assms group.inv_solve_left mem_carrier)
   3.611 +  thus ?thesis using h unfolding l_coset_def by blast
   3.612  qed
   3.613  
   3.614  
   3.615 @@ -391,21 +365,21 @@
   3.616    by (simp add: normal_def normal_axioms_def is_group)
   3.617  
   3.618  lemma (in normal) inv_op_closed1:
   3.619 -     "\<lbrakk>x \<in> carrier G; h \<in> H\<rbrakk> \<Longrightarrow> (inv x) \<otimes> h \<otimes> x \<in> H"
   3.620 -apply (insert coset_eq) 
   3.621 -apply (auto simp add: l_coset_def r_coset_def)
   3.622 -apply (drule bspec, assumption)
   3.623 -apply (drule equalityD1 [THEN subsetD], blast, clarify)
   3.624 -apply (simp add: m_assoc)
   3.625 -apply (simp add: m_assoc [symmetric])
   3.626 -done
   3.627 +  assumes "x \<in> carrier G" and "h \<in> H"
   3.628 +  shows "(inv x) \<otimes> h \<otimes> x \<in> H"
   3.629 +proof -
   3.630 +  have "h \<otimes> x \<in> x <# H"
   3.631 +    using assms coset_eq assms(1) unfolding r_coset_def by blast 
   3.632 +  then obtain h' where "h' \<in> H" "h \<otimes> x = x \<otimes> h'"
   3.633 +    unfolding l_coset_def by blast
   3.634 +  thus ?thesis by (metis assms inv_closed l_inv l_one m_assoc mem_carrier) 
   3.635 +qed
   3.636  
   3.637  lemma (in normal) inv_op_closed2:
   3.638 -     "\<lbrakk>x \<in> carrier G; h \<in> H\<rbrakk> \<Longrightarrow> x \<otimes> h \<otimes> (inv x) \<in> H"
   3.639 -apply (subgoal_tac "inv (inv x) \<otimes> h \<otimes> (inv x) \<in> H") 
   3.640 -apply (simp add: ) 
   3.641 -apply (blast intro: inv_op_closed1) 
   3.642 -done
   3.643 +  assumes "x \<in> carrier G" and "h \<in> H"
   3.644 +  shows "x \<otimes> h \<otimes> (inv x) \<in> H"
   3.645 +  using assms inv_op_closed1 by (metis inv_closed inv_inv) 
   3.646 +
   3.647  
   3.648  text\<open>Alternative characterization of normal subgroups\<close>
   3.649  lemma (in group) normal_inv_iff:
   3.650 @@ -455,74 +429,81 @@
   3.651    qed
   3.652  qed
   3.653  
   3.654 +corollary (in group) normal_invI:
   3.655 +  assumes "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"
   3.656 +  shows "N \<lhd> G"
   3.657 +  using assms normal_inv_iff by blast
   3.658  
   3.659 -subsection\<open>More Properties of Cosets\<close>
   3.660 +corollary (in group) normal_invE:
   3.661 +  assumes "N \<lhd> G" 
   3.662 +  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"
   3.663 +  using assms normal_inv_iff apply blast
   3.664 +  by (simp add: assms normal.inv_op_closed2) 
   3.665 +
   3.666 +
   3.667 +lemma (in group) one_is_normal :
   3.668 +   "{\<one>} \<lhd> G" 
   3.669 +proof(intro normal_invI )
   3.670 +  show "subgroup {\<one>} G"
   3.671 +    by (simp add: subgroup_def)
   3.672 +  show "\<And>x h. x \<in> carrier G \<Longrightarrow> h \<in> {\<one>} \<Longrightarrow> x \<otimes> h \<otimes> inv x \<in> {\<one>}" by simp
   3.673 +qed
   3.674 +
   3.675 +
   3.676 +subsection\<open>More Properties of Left Cosets\<close>
   3.677 +
   3.678 +lemma (in group) l_repr_independence:
   3.679 +  assumes "y \<in> x <# H" "x \<in> carrier G" "subgroup H G"
   3.680 +  shows "x <# H = y <# H"
   3.681 +proof -
   3.682 +  obtain h' where h': "h' \<in> H" "y = x \<otimes> h'"
   3.683 +    using assms(1) unfolding l_coset_def by blast
   3.684 +  hence "\<And> h. h \<in> H \<Longrightarrow> x \<otimes> h = y \<otimes> ((inv h') \<otimes> h)"
   3.685 +    by (smt assms(2-3) inv_closed inv_solve_right m_assoc m_closed subgroup.mem_carrier)
   3.686 +  hence "\<And> xh. xh \<in> x <# H \<Longrightarrow> xh \<in> y <# H"
   3.687 +    unfolding l_coset_def by (metis (no_types, lifting) UN_iff assms(3) h'(1) subgroup_def) 
   3.688 +  moreover have "\<And> h. h \<in> H \<Longrightarrow> y \<otimes> h = x \<otimes> (h' \<otimes> h)"
   3.689 +    using h' by (meson assms(2) assms(3) m_assoc subgroup.mem_carrier)
   3.690 +  hence "\<And> yh. yh \<in> y <# H \<Longrightarrow> yh \<in> x <# H"
   3.691 +    unfolding l_coset_def using subgroup.m_closed[OF assms(3) h'(1)] by blast
   3.692 +  ultimately show ?thesis by blast
   3.693 +qed
   3.694  
   3.695  lemma (in group) lcos_m_assoc:
   3.696 -     "[| M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G |]
   3.697 -      ==> g <# (h <# M) = (g \<otimes> h) <# M"
   3.698 +  "\<lbrakk> M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G \<rbrakk> \<Longrightarrow> g <# (h <# M) = (g \<otimes> h) <# M"
   3.699  by (force simp add: l_coset_def m_assoc)
   3.700  
   3.701 -lemma (in group) lcos_mult_one: "M \<subseteq> carrier G ==> \<one> <# M = M"
   3.702 +lemma (in group) lcos_mult_one: "M \<subseteq> carrier G \<Longrightarrow> \<one> <# M = M"
   3.703  by (force simp add: l_coset_def)
   3.704  
   3.705  lemma (in group) l_coset_subset_G:
   3.706 -     "[| H \<subseteq> carrier G; x \<in> carrier G |] ==> x <# H \<subseteq> carrier G"
   3.707 +  "\<lbrakk> H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> x <# H \<subseteq> carrier G"
   3.708  by (auto simp add: l_coset_def subsetD)
   3.709  
   3.710 +lemma (in group) l_coset_carrier:
   3.711 +  "\<lbrakk> y \<in> x <# H; x \<in> carrier G; subgroup H G \<rbrakk> \<Longrightarrow> y \<in> carrier G"
   3.712 +  by (auto simp add: l_coset_def m_assoc  subgroup.subset [THEN subsetD] subgroup.m_closed)
   3.713 +
   3.714  lemma (in group) l_coset_swap:
   3.715 -     "\<lbrakk>y \<in> x <# H;  x \<in> carrier G;  subgroup H G\<rbrakk> \<Longrightarrow> x \<in> y <# H"
   3.716 -proof (simp add: l_coset_def)
   3.717 -  assume "\<exists>h\<in>H. y = x \<otimes> h"
   3.718 -    and x: "x \<in> carrier G"
   3.719 -    and sb: "subgroup H G"
   3.720 -  then obtain h' where h': "h' \<in> H \<and> x \<otimes> h' = y" by blast
   3.721 -  show "\<exists>h\<in>H. x = y \<otimes> h"
   3.722 +  assumes "y \<in> x <# H" "x \<in> carrier G" "subgroup H G" 
   3.723 +  shows "x \<in> y <# H"
   3.724 +  using assms(2) l_repr_independence[OF assms] subgroup.one_closed[OF assms(3)]
   3.725 +  unfolding l_coset_def by fastforce
   3.726 +
   3.727 +lemma (in group) subgroup_mult_id:
   3.728 +  assumes "subgroup H G"
   3.729 +  shows "H <#> H = H"
   3.730 +proof
   3.731 +  show "H <#> H \<subseteq> H"
   3.732 +    unfolding set_mult_def using subgroup.m_closed[OF assms] by (simp add: UN_subset_iff)
   3.733 +  show "H \<subseteq> H <#> H"
   3.734    proof
   3.735 -    show "x = y \<otimes> inv h'" using h' x sb
   3.736 -      by (auto simp add: m_assoc subgroup.subset [THEN subsetD])
   3.737 -    show "inv h' \<in> H" using h' sb
   3.738 -      by (auto simp add: subgroup.subset [THEN subsetD] subgroup.m_inv_closed)
   3.739 +    fix x assume x: "x \<in> H" thus "x \<in> H <#> H" unfolding set_mult_def
   3.740 +      using subgroup.m_closed[OF assms subgroup.one_closed[OF assms] x] subgroup.one_closed[OF assms]
   3.741 +      by (smt UN_iff assms coset_join3 l_coset_def subgroup.mem_carrier)
   3.742    qed
   3.743  qed
   3.744  
   3.745 -lemma (in group) l_coset_carrier:
   3.746 -     "[| y \<in> x <# H;  x \<in> carrier G;  subgroup H G |] ==> y \<in> carrier G"
   3.747 -by (auto simp add: l_coset_def m_assoc
   3.748 -                   subgroup.subset [THEN subsetD] subgroup.m_closed)
   3.749 -
   3.750 -lemma (in group) l_repr_imp_subset:
   3.751 -  assumes y: "y \<in> x <# H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   3.752 -  shows "y <# H \<subseteq> x <# H"
   3.753 -proof -
   3.754 -  from y
   3.755 -  obtain h' where "h' \<in> H" "x \<otimes> h' = y" by (auto simp add: l_coset_def)
   3.756 -  thus ?thesis using x sb
   3.757 -    by (auto simp add: l_coset_def m_assoc
   3.758 -                       subgroup.subset [THEN subsetD] subgroup.m_closed)
   3.759 -qed
   3.760 -
   3.761 -lemma (in group) l_repr_independence:
   3.762 -  assumes y: "y \<in> x <# H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   3.763 -  shows "x <# H = y <# H"
   3.764 -proof
   3.765 -  show "x <# H \<subseteq> y <# H"
   3.766 -    by (rule l_repr_imp_subset,
   3.767 -        (blast intro: l_coset_swap l_coset_carrier y x sb)+)
   3.768 -  show "y <# H \<subseteq> x <# H" by (rule l_repr_imp_subset [OF y x sb])
   3.769 -qed
   3.770 -
   3.771 -lemma (in group) setmult_subset_G:
   3.772 -     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G\<rbrakk> \<Longrightarrow> H <#> K \<subseteq> carrier G"
   3.773 -by (auto simp add: set_mult_def subsetD)
   3.774 -
   3.775 -lemma (in group) subgroup_mult_id: "subgroup H G \<Longrightarrow> H <#> H = H"
   3.776 -apply (auto simp add: subgroup.m_closed set_mult_def Sigma_def)
   3.777 -apply (rule_tac x = x in bexI)
   3.778 -apply (rule bexI [of _ "\<one>"])
   3.779 -apply (auto simp add: subgroup.one_closed subgroup.subset [THEN subsetD])
   3.780 -done
   3.781 -
   3.782  
   3.783  subsubsection \<open>Set of Inverses of an \<open>r_coset\<close>.\<close>
   3.784  
   3.785 @@ -552,20 +533,21 @@
   3.786  subsubsection \<open>Theorems for \<open><#>\<close> with \<open>#>\<close> or \<open><#\<close>.\<close>
   3.787  
   3.788  lemma (in group) setmult_rcos_assoc:
   3.789 -     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk>
   3.790 -      \<Longrightarrow> H <#> (K #> x) = (H <#> K) #> x"
   3.791 -by (force simp add: r_coset_def set_mult_def m_assoc)
   3.792 +  "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk> \<Longrightarrow>
   3.793 +    H <#> (K #> x) = (H <#> K) #> x"
   3.794 +  using set_mult_assoc[of H K "{x}"] by (simp add: r_coset_eq_set_mult)
   3.795  
   3.796  lemma (in group) rcos_assoc_lcos:
   3.797 -     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk>
   3.798 -      \<Longrightarrow> (H #> x) <#> K = H <#> (x <# K)"
   3.799 -by (force simp add: r_coset_def l_coset_def set_mult_def m_assoc)
   3.800 +  "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk> \<Longrightarrow>
   3.801 +   (H #> x) <#> K = H <#> (x <# K)"
   3.802 +  using set_mult_assoc[of H "{x}" K]
   3.803 +  by (simp add: l_coset_eq_set_mult r_coset_eq_set_mult)
   3.804  
   3.805  lemma (in normal) rcos_mult_step1:
   3.806 -     "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   3.807 -      \<Longrightarrow> (H #> x) <#> (H #> y) = (H <#> (x <# H)) #> y"
   3.808 -by (simp add: setmult_rcos_assoc subset
   3.809 -              r_coset_subset_G l_coset_subset_G rcos_assoc_lcos)
   3.810 +  "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk> \<Longrightarrow>
   3.811 +   (H #> x) <#> (H #> y) = (H <#> (x <# H)) #> y"
   3.812 +  by (simp add: setmult_rcos_assoc r_coset_subset_G
   3.813 +                subset l_coset_subset_G rcos_assoc_lcos)
   3.814  
   3.815  lemma (in normal) rcos_mult_step2:
   3.816       "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   3.817 @@ -645,7 +627,7 @@
   3.818  lemma (in subgroup) l_coset_eq_rcong:
   3.819    assumes "group G"
   3.820    assumes a: "a \<in> carrier G"
   3.821 -  shows "a <# H = rcong H `` {a}"
   3.822 +  shows "a <# H = (rcong H) `` {a}"
   3.823  proof -
   3.824    interpret group G by fact
   3.825    show ?thesis by (force simp add: r_congruent_def l_coset_def m_assoc [symmetric] a ) 
   3.826 @@ -661,9 +643,7 @@
   3.827  proof -
   3.828    interpret subgroup H G by fact
   3.829    from p show ?thesis apply (rule_tac UN_I [of "hb \<otimes> ((inv ha) \<otimes> h)"])
   3.830 -    apply (simp add: )
   3.831 -    apply (simp add: m_assoc transpose_inv)
   3.832 -    done
   3.833 +    apply blast by (simp add: inv_solve_left m_assoc)
   3.834  qed
   3.835  
   3.836  lemma (in group) rcos_disjoint:
   3.837 @@ -793,28 +773,47 @@
   3.838      "\<lbrakk>H \<subseteq> carrier G;  a \<in> carrier G\<rbrakk> \<Longrightarrow> inj_on (\<lambda>y. y \<otimes> a) H"
   3.839  by (force simp add: inj_on_def subsetD)
   3.840  
   3.841 +(* ************************************************************************** *)
   3.842 +
   3.843  lemma (in group) card_cosets_equal:
   3.844 -     "\<lbrakk>c \<in> rcosets H;  H \<subseteq> carrier G; finite(carrier G)\<rbrakk>
   3.845 -      \<Longrightarrow> card c = card H"
   3.846 -apply (auto simp add: RCOSETS_def)
   3.847 -apply (rule card_bij_eq)
   3.848 -     apply (rule inj_on_f, assumption+)
   3.849 -    apply (force simp add: m_assoc subsetD r_coset_def)
   3.850 -   apply (rule inj_on_g, assumption+)
   3.851 -  apply (force simp add: m_assoc subsetD r_coset_def)
   3.852 - txt\<open>The sets @{term "H #> a"} and @{term "H"} are finite.\<close>
   3.853 - apply (simp add: r_coset_subset_G [THEN finite_subset])
   3.854 -apply (blast intro: finite_subset)
   3.855 -done
   3.856 +  assumes "R \<in> rcosets H" "H \<subseteq> carrier G"
   3.857 +  shows "\<exists>f. bij_betw f H R"
   3.858 +proof -
   3.859 +  obtain g where g: "g \<in> carrier G" "R = H #> g"
   3.860 +    using assms(1) unfolding RCOSETS_def by blast
   3.861 +
   3.862 +  let ?f = "\<lambda>h. h \<otimes> g"
   3.863 +  have "\<And>r. r \<in> R \<Longrightarrow> \<exists>h \<in> H. ?f h = r"
   3.864 +  proof -
   3.865 +    fix r assume "r \<in> R"
   3.866 +    then obtain h where "h \<in> H" "r = h \<otimes> g"
   3.867 +      using g unfolding r_coset_def by blast
   3.868 +    thus "\<exists>h \<in> H. ?f h = r" by blast
   3.869 +  qed
   3.870 +  hence "R \<subseteq> ?f ` H" by blast
   3.871 +  moreover have "?f ` H \<subseteq> R"
   3.872 +    using g unfolding r_coset_def by blast
   3.873 +  ultimately show ?thesis using inj_on_g unfolding bij_betw_def
   3.874 +    using assms(2) g(1) by auto 
   3.875 +qed
   3.876 +
   3.877 +corollary (in group) card_rcosets_equal:
   3.878 +  assumes "R \<in> rcosets H" "H \<subseteq> carrier G"
   3.879 +  shows "card H = card R"
   3.880 +  using card_cosets_equal assms bij_betw_same_card by blast
   3.881 +
   3.882 +corollary (in group) rcosets_finite:
   3.883 +  assumes "R \<in> rcosets H" "H \<subseteq> carrier G" "finite H"
   3.884 +  shows "finite R"
   3.885 +  using card_cosets_equal assms bij_betw_finite is_group by blast
   3.886 +
   3.887 +(* ************************************************************************** *)
   3.888  
   3.889  lemma (in group) rcosets_subset_PowG:
   3.890       "subgroup H G  \<Longrightarrow> rcosets H \<subseteq> Pow(carrier G)"
   3.891 -apply (simp add: RCOSETS_def)
   3.892 -apply (blast dest: r_coset_subset_G subgroup.subset)
   3.893 -done
   3.894 +  using rcosets_part_G by auto
   3.895  
   3.896 -
   3.897 -theorem (in group) lagrange:
   3.898 +proposition (in group) lagrange_finite:
   3.899       "\<lbrakk>finite(carrier G); subgroup H G\<rbrakk>
   3.900        \<Longrightarrow> card(rcosets H) * card(H) = order(G)"
   3.901  apply (simp (no_asm_simp) add: order_def rcosets_part_G [symmetric])
   3.902 @@ -822,10 +821,42 @@
   3.903  apply (rule card_partition)
   3.904     apply (simp add: rcosets_subset_PowG [THEN finite_subset])
   3.905    apply (simp add: rcosets_part_G)
   3.906 - apply (simp add: card_cosets_equal subgroup.subset)
   3.907 +  apply (simp add: card_rcosets_equal subgroup_imp_subset)
   3.908  apply (simp add: rcos_disjoint)
   3.909  done
   3.910  
   3.911 +theorem (in group) lagrange:
   3.912 +  assumes "subgroup H G"
   3.913 +  shows "card (rcosets H) * card H = order G"
   3.914 +proof (cases "finite (carrier G)")
   3.915 +  case True thus ?thesis using lagrange_finite assms by simp
   3.916 +next
   3.917 +  case False note inf_G = this
   3.918 +  thus ?thesis
   3.919 +  proof (cases "finite H")
   3.920 +    case False thus ?thesis using inf_G  by (simp add: order_def)  
   3.921 +  next
   3.922 +    case True note finite_H = this
   3.923 +    have "infinite (rcosets H)"
   3.924 +    proof (rule ccontr)
   3.925 +      assume "\<not> infinite (rcosets H)"
   3.926 +      hence finite_rcos: "finite (rcosets H)" by simp
   3.927 +      hence "card (\<Union>(rcosets H)) = (\<Sum>R\<in>(rcosets H). card R)"
   3.928 +        using card_Union_disjoint[of "rcosets H"] finite_H rcos_disjoint[OF assms(1)]
   3.929 +              rcosets_finite[where ?H = H] by (simp add: assms subgroup_imp_subset)
   3.930 +      hence "order G = (\<Sum>R\<in>(rcosets H). card R)"
   3.931 +        by (simp add: assms order_def rcosets_part_G)
   3.932 +      hence "order G = (\<Sum>R\<in>(rcosets H). card H)"
   3.933 +        using card_rcosets_equal by (simp add: assms subgroup_imp_subset)
   3.934 +      hence "order G = (card H) * (card (rcosets H))" by simp
   3.935 +      hence "order G \<noteq> 0" using finite_rcos finite_H assms ex_in_conv
   3.936 +                                rcosets_part_G subgroup.one_closed by fastforce
   3.937 +      thus False using inf_G order_gt_0_iff_finite by blast 
   3.938 +    qed
   3.939 +    thus ?thesis using inf_G by (simp add: order_def)
   3.940 +  qed
   3.941 +qed
   3.942 +
   3.943  
   3.944  subsection \<open>Quotient Groups: Factorization of a Group\<close>
   3.945  
   3.946 @@ -845,7 +876,7 @@
   3.947  lemma (in normal) rcosets_assoc:
   3.948       "\<lbrakk>M1 \<in> rcosets H; M2 \<in> rcosets H; M3 \<in> rcosets H\<rbrakk>
   3.949        \<Longrightarrow> M1 <#> M2 <#> M3 = M1 <#> (M2 <#> M3)"
   3.950 -by (auto simp add: RCOSETS_def rcos_sum m_assoc)
   3.951 +  by (simp add: group.set_mult_assoc is_group rcosets_carrier)
   3.952  
   3.953  lemma (in subgroup) subgroup_in_rcosets:
   3.954    assumes "group G"
   3.955 @@ -1016,10 +1047,253 @@
   3.956  
   3.957  text\<open>If @{term h} is a homomorphism from @{term G} onto @{term H}, then the
   3.958   quotient group @{term "G Mod (kernel G H h)"} is isomorphic to @{term H}.\<close>
   3.959 -theorem (in group_hom) FactGroup_iso:
   3.960 +theorem (in group_hom) FactGroup_iso_set:
   3.961    "h ` carrier G = carrier H
   3.962 -   \<Longrightarrow> (\<lambda>X. the_elem (h`X)) \<in> (G Mod (kernel G H h)) \<cong> H"
   3.963 +   \<Longrightarrow> (\<lambda>X. the_elem (h`X)) \<in> iso (G Mod (kernel G H h)) H"
   3.964  by (simp add: iso_def FactGroup_hom FactGroup_inj_on bij_betw_def 
   3.965                FactGroup_onto) 
   3.966  
   3.967 +corollary (in group_hom) FactGroup_iso :
   3.968 +  "h ` carrier G = carrier H
   3.969 +   \<Longrightarrow> (G Mod (kernel G H h))\<cong> H"
   3.970 +  using FactGroup_iso_set unfolding is_iso_def by auto
   3.971 +
   3.972 +
   3.973 +(* Next two lemmas contributed by Paulo Emílio de Vilhena. *)
   3.974 +
   3.975 +lemma (in group_hom) trivial_hom_iff:
   3.976 +  "(h ` (carrier G) = { \<one>\<^bsub>H\<^esub> }) = (kernel G H h = carrier G)"
   3.977 +  unfolding kernel_def using one_closed by force
   3.978 +
   3.979 +lemma (in group_hom) trivial_ker_imp_inj:
   3.980 +  assumes "kernel G H h = { \<one> }"
   3.981 +  shows "inj_on h (carrier G)"
   3.982 +proof (rule inj_onI)
   3.983 +  fix g1 g2 assume A: "g1 \<in> carrier G" "g2 \<in> carrier G" "h g1 = h g2"
   3.984 +  hence "h (g1 \<otimes> (inv g2)) = \<one>\<^bsub>H\<^esub>" by simp
   3.985 +  hence "g1 \<otimes> (inv g2) = \<one>"
   3.986 +    using A assms unfolding kernel_def by blast
   3.987 +  thus "g1 = g2"
   3.988 +    using A G.inv_equality G.inv_inv by blast
   3.989 +qed
   3.990 +
   3.991 +
   3.992 +(* Next subsection contributed by Martin Baillon. *)
   3.993 +
   3.994 +subsection \<open>Theorems about Factor Groups and Direct product\<close>
   3.995 +
   3.996 +lemma (in group) DirProd_normal :
   3.997 +  assumes "group K"
   3.998 +    and "H \<lhd> G"
   3.999 +    and "N \<lhd> K"
  3.1000 +  shows "H \<times> N \<lhd> G \<times>\<times> K"
  3.1001 +proof (intro group.normal_invI[OF DirProd_group[OF group_axioms assms(1)]])
  3.1002 +  show sub : "subgroup (H \<times> N) (G \<times>\<times> K)"
  3.1003 +    using DirProd_subgroups[OF group_axioms normal_imp_subgroup[OF assms(2)]assms(1)
  3.1004 +         normal_imp_subgroup[OF assms(3)]].
  3.1005 +  show "\<And>x h. x \<in> carrier (G\<times>\<times>K) \<Longrightarrow> h \<in> H\<times>N \<Longrightarrow> 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"
  3.1006 +  proof-
  3.1007 +    fix x h assume xGK : "x \<in> carrier (G \<times>\<times> K)" and hHN : " h \<in> H \<times> N"
  3.1008 +    hence hGK : "h \<in> carrier (G \<times>\<times> K)" using subgroup_imp_subset[OF sub] by auto
  3.1009 +    from xGK obtain x1 x2 where x1x2 :"x1 \<in> carrier G" "x2 \<in> carrier K" "x = (x1,x2)"
  3.1010 +      unfolding DirProd_def by fastforce
  3.1011 +    from hHN obtain h1 h2 where h1h2 : "h1 \<in> H" "h2 \<in> N" "h = (h1,h2)"
  3.1012 +      unfolding DirProd_def by fastforce
  3.1013 +    hence h1h2GK : "h1 \<in> carrier G" "h2 \<in> carrier K"
  3.1014 +      using normal_imp_subgroup subgroup_imp_subset assms apply blast+.
  3.1015 +    have "inv\<^bsub>G \<times>\<times> K\<^esub> x = (inv\<^bsub>G\<^esub> x1,inv\<^bsub>K\<^esub> x2)"
  3.1016 +      using inv_DirProd[OF group_axioms assms(1) x1x2(1)x1x2(2)] x1x2 by auto
  3.1017 +    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)"
  3.1018 +      using h1h2 x1x2 h1h2GK by auto
  3.1019 +    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"
  3.1020 +      using normal_invE group.normal_invE[OF assms(1)] assms x1x2 h1h2 apply auto.
  3.1021 +    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
  3.1022 +    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
  3.1023 +  qed
  3.1024 +qed
  3.1025 +
  3.1026 +lemma (in group) FactGroup_DirProd_multiplication_iso_set :
  3.1027 +  assumes "group K"
  3.1028 +    and "H \<lhd> G"
  3.1029 +    and "N \<lhd> K"
  3.1030 +  shows "(\<lambda> (X, Y). X \<times> Y) \<in> iso  ((G Mod H) \<times>\<times> (K Mod N)) (G \<times>\<times> K Mod H \<times> N)"
  3.1031 +
  3.1032 +proof-
  3.1033 +  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)"
  3.1034 +    unfolding r_coset_def Sigma_def DirProd_def FactGroup_def RCOSETS_def apply simp by blast
  3.1035 +  moreover have "(\<forall>x\<in>carrier (G Mod H). \<forall>y\<in>carrier (K Mod N). \<forall>xa\<in>carrier (G Mod H).
  3.1036 +                \<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)"
  3.1037 +    unfolding set_mult_def apply auto apply blast+.
  3.1038 +  moreover have "(\<forall>x\<in>carrier (G Mod H). \<forall>y\<in>carrier (K Mod N). \<forall>xa\<in>carrier (G Mod H).
  3.1039 +                 \<forall>ya\<in>carrier (K Mod N).  x \<times> y = xa \<times> ya \<longrightarrow> x = xa \<and> y = ya)"
  3.1040 +    unfolding  FactGroup_def using times_eq_iff subgroup.rcosets_not_empty
  3.1041 +    by (metis assms(2) assms(3) normal_def partial_object.select_convs(1))
  3.1042 +  moreover have "(\<lambda>(X, Y). X \<times> Y) ` (carrier (G Mod H) \<times> carrier (K Mod N)) = 
  3.1043 +                                     carrier (G \<times>\<times> K Mod H \<times> N)"
  3.1044 +    unfolding image_def  apply auto using R apply force
  3.1045 +    unfolding DirProd_def FactGroup_def RCOSETS_def r_coset_def apply auto apply force.
  3.1046 +  ultimately show ?thesis
  3.1047 +    unfolding iso_def hom_def bij_betw_def inj_on_def by simp
  3.1048 +qed
  3.1049 +
  3.1050 +corollary (in group) FactGroup_DirProd_multiplication_iso_1 :
  3.1051 +  assumes "group K"
  3.1052 +    and "H \<lhd> G"
  3.1053 +    and "N \<lhd> K"
  3.1054 +  shows "  ((G Mod H) \<times>\<times> (K Mod N)) \<cong> (G \<times>\<times> K Mod H \<times> N)"
  3.1055 +  unfolding is_iso_def using FactGroup_DirProd_multiplication_iso_set assms by auto
  3.1056 +
  3.1057 +corollary (in group) FactGroup_DirProd_multiplication_iso_2 :
  3.1058 +  assumes "group K"
  3.1059 +    and "H \<lhd> G"
  3.1060 +    and "N \<lhd> K"
  3.1061 +  shows "(G \<times>\<times> K Mod H \<times> N) \<cong> ((G Mod H) \<times>\<times> (K Mod N))"
  3.1062 +  using FactGroup_DirProd_multiplication_iso_1 group.iso_sym assms
  3.1063 +        DirProd_group[OF normal.factorgroup_is_group normal.factorgroup_is_group]
  3.1064 +  by blast
  3.1065 +
  3.1066 +subsubsection "More Lemmas about set multiplication"
  3.1067 +
  3.1068 +(*A group multiplied by a subgroup stays the same*)
  3.1069 +lemma (in group) set_mult_carrier_idem:
  3.1070 +  assumes "subgroup H G"
  3.1071 +  shows "(carrier G) <#> H = carrier G"
  3.1072 +proof
  3.1073 +  show "(carrier G)<#>H \<subseteq> carrier G" 
  3.1074 +    unfolding set_mult_def using subgroup_imp_subset assms by blast
  3.1075 +next
  3.1076 +  have " (carrier G) #>  \<one> = carrier G" unfolding set_mult_def r_coset_def group_axioms by simp
  3.1077 +  moreover have "(carrier G) #>  \<one> \<subseteq> (carrier G) <#> H" unfolding set_mult_def r_coset_def
  3.1078 +    using assms subgroup.one_closed[OF assms] by blast
  3.1079 +  ultimately show "carrier G \<subseteq> (carrier G) <#> H" by simp
  3.1080 +qed
  3.1081 +
  3.1082 +(*Same lemma as above, but everything is included in a subgroup*)
  3.1083 +lemma (in group) set_mult_subgroup_idem:
  3.1084 +  assumes "subgroup H G"
  3.1085 +    and "subgroup N (G\<lparr>carrier:=H\<rparr>)"
  3.1086 +  shows "H<#>N = H"
  3.1087 +  using group.set_mult_carrier_idem[OF subgroup_imp_group] subgroup_imp_subset assms
  3.1088 +  by (metis monoid.cases_scheme order_refl partial_object.simps(1)
  3.1089 +      partial_object.update_convs(1) subgroup_set_mult_equality)
  3.1090 +
  3.1091 +(*A normal subgroup is commutative with set_mult*)
  3.1092 +lemma (in group) commut_normal:
  3.1093 +  assumes "subgroup H G"
  3.1094 +    and "N\<lhd>G"
  3.1095 +  shows "H<#>N = N<#>H" 
  3.1096 +proof-
  3.1097 +  have aux1: "{H <#> N} = {\<Union>h\<in>H. h <# N }" unfolding set_mult_def l_coset_def by auto
  3.1098 +  also have "... = {\<Union>h\<in>H. N #> h }" using assms normal.coset_eq subgroup.mem_carrier by fastforce
  3.1099 +  moreover have aux2: "{N <#> H} = {\<Union>h\<in>H. N #> h }"unfolding set_mult_def r_coset_def by auto
  3.1100 +  ultimately show "H<#>N = N<#>H" by simp
  3.1101 +qed
  3.1102 +
  3.1103 +(*Same lemma as above, but everything is included in a subgroup*)
  3.1104 +lemma (in group) commut_normal_subgroup:
  3.1105 +  assumes "subgroup H G"
  3.1106 +    and "N\<lhd>(G\<lparr>carrier:=H\<rparr>)"
  3.1107 +    and "subgroup K (G\<lparr>carrier:=H\<rparr>)"
  3.1108 +  shows "K<#>N = N<#>K"
  3.1109 +proof-
  3.1110 +  have "N \<subseteq> carrier (G\<lparr>carrier := H\<rparr>)" using assms normal_imp_subgroup subgroup_imp_subset by blast
  3.1111 +  hence NH : "N \<subseteq> H" by simp
  3.1112 +  have "K \<subseteq> carrier(G\<lparr>carrier := H\<rparr>)" using subgroup_imp_subset assms by blast
  3.1113 +  hence KH : "K \<subseteq> H" by simp
  3.1114 +  have Egal : "K <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N = N <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> K"
  3.1115 +  using group.commut_normal[where ?G = "G\<lparr>carrier :=H\<rparr>", of K N,OF subgroup_imp_group[OF assms(1)]
  3.1116 +               assms(3) assms(2)] by auto
  3.1117 +  also have "... = N <#> K" using subgroup_set_mult_equality[of H N K, OF assms(1) NH KH] by auto
  3.1118 +  moreover have "K <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N = K <#> N"
  3.1119 +    using subgroup_set_mult_equality[of H K N, OF assms(1) KH NH] by auto
  3.1120 +  ultimately show "K<#>N = N<#>K" by auto
  3.1121 +qed
  3.1122 +
  3.1123 +
  3.1124 +
  3.1125 +subsubsection "Lemmas about intersection and normal subgroups"
  3.1126 +
  3.1127 +lemma (in group) normal_inter:
  3.1128 +  assumes "subgroup H G"
  3.1129 +    and "subgroup K G"
  3.1130 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>"
  3.1131 +  shows " (H1\<inter>K)\<lhd>(G\<lparr>carrier:= (H\<inter>K)\<rparr>)" 
  3.1132 +proof-
  3.1133 +  define HK and H1K and GH and GHK
  3.1134 +    where "HK = H\<inter>K" and "H1K=H1\<inter>K" and "GH =G\<lparr>carrier := H\<rparr>" and "GHK = (G\<lparr>carrier:= (H\<inter>K)\<rparr>)"
  3.1135 +  show "H1K\<lhd>GHK"
  3.1136 +  proof (intro group.normal_invI[of GHK H1K])
  3.1137 +    show "Group.group GHK"
  3.1138 +      using GHK_def subgroups_Inter_pair subgroup_imp_group assms by blast
  3.1139 +
  3.1140 +  next
  3.1141 +    have  H1K_incl:"subgroup H1K (G\<lparr>carrier:= (H\<inter>K)\<rparr>)"
  3.1142 +    proof(intro subgroup_incl)
  3.1143 +      show "subgroup H1K G"
  3.1144 +        using assms normal_imp_subgroup subgroups_Inter_pair incl_subgroup H1K_def by blast
  3.1145 +    next
  3.1146 +      show "subgroup (H\<inter>K) G" using HK_def subgroups_Inter_pair assms by auto
  3.1147 +    next
  3.1148 +      have "H1 \<subseteq> (carrier (G\<lparr>carrier:=H\<rparr>))" 
  3.1149 +        using  assms(3) normal_imp_subgroup subgroup_imp_subset by blast
  3.1150 +      also have "... \<subseteq> H" by simp
  3.1151 +      thus "H1K \<subseteq>H\<inter>K" 
  3.1152 +        using H1K_def calculation by auto
  3.1153 +    qed
  3.1154 +    thus "subgroup H1K GHK" using GHK_def by simp
  3.1155 +  next
  3.1156 +    show "\<And> x h. x\<in>carrier GHK \<Longrightarrow> h\<in>H1K \<Longrightarrow> x \<otimes>\<^bsub>GHK\<^esub> h \<otimes>\<^bsub>GHK\<^esub> inv\<^bsub>GHK\<^esub> x\<in> H1K"
  3.1157 +    proof-
  3.1158 +      have invHK: "\<lbrakk>y\<in>HK\<rbrakk> \<Longrightarrow> inv\<^bsub>GHK\<^esub> y = inv\<^bsub>GH\<^esub> y"
  3.1159 +        using subgroup_inv_equality assms HK_def GH_def GHK_def subgroups_Inter_pair by simp
  3.1160 +      have multHK : "\<lbrakk>x\<in>HK;y\<in>HK\<rbrakk> \<Longrightarrow>  x \<otimes>\<^bsub>(G\<lparr>carrier:=HK\<rparr>)\<^esub> y =  x \<otimes> y"
  3.1161 +        using HK_def by simp
  3.1162 +      fix x assume p: "x\<in>carrier GHK"
  3.1163 +      fix h assume p2 : "h:H1K"
  3.1164 +      have "carrier(GHK)\<subseteq>HK"
  3.1165 +        using GHK_def HK_def by simp
  3.1166 +      hence xHK:"x\<in>HK" using p by auto
  3.1167 +      hence invx:"inv\<^bsub>GHK\<^esub> x = inv\<^bsub>GH\<^esub> x"
  3.1168 +        using invHK assms GHK_def HK_def GH_def subgroup_inv_equality subgroups_Inter_pair by simp
  3.1169 +      have "H1\<subseteq>carrier(GH)"
  3.1170 +        using assms GH_def normal_imp_subgroup subgroup_imp_subset by blast
  3.1171 +      hence hHK:"h\<in>HK" 
  3.1172 +        using p2 H1K_def HK_def GH_def by auto
  3.1173 +      hence xhx_egal : "x \<otimes>\<^bsub>GHK\<^esub> h \<otimes>\<^bsub>GHK\<^esub> inv\<^bsub>GHK\<^esub>x =  x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x"
  3.1174 +        using invx invHK multHK GHK_def GH_def by auto
  3.1175 +      have xH:"x\<in>carrier(GH)" 
  3.1176 +        using xHK HK_def GH_def by auto 
  3.1177 +      have hH:"h\<in>carrier(GH)"
  3.1178 +        using hHK HK_def GH_def by auto 
  3.1179 +      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)"
  3.1180 +        using assms normal_invE GH_def normal.inv_op_closed2 by fastforce
  3.1181 +      hence INCL_1 : "x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> H1"
  3.1182 +        using  xH H1K_def p2 by blast
  3.1183 +      have " x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> HK"
  3.1184 +        using assms HK_def subgroups_Inter_pair hHK xHK
  3.1185 +        by (metis GH_def inf.cobounded1 subgroup_def subgroup_incl)
  3.1186 +      hence " x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> K" using HK_def by simp
  3.1187 +      hence " x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> H1K" using INCL_1 H1K_def by auto
  3.1188 +      thus  "x \<otimes>\<^bsub>GHK\<^esub> h \<otimes>\<^bsub>GHK\<^esub> inv\<^bsub>GHK\<^esub> x \<in> H1K" using xhx_egal by simp
  3.1189 +    qed
  3.1190 +  qed
  3.1191 +qed
  3.1192 +
  3.1193 +
  3.1194 +lemma (in group) normal_inter_subgroup:
  3.1195 +  assumes "subgroup H G"
  3.1196 +    and "N \<lhd> G"
  3.1197 +  shows "(N\<inter>H) \<lhd> (G\<lparr>carrier := H\<rparr>)"
  3.1198 +proof -
  3.1199 +  define K where "K = carrier G"
  3.1200 +  have "G\<lparr>carrier := K\<rparr> =  G" using K_def by auto
  3.1201 +  moreover have "subgroup K G" using K_def subgroup_self by blast
  3.1202 +  moreover have "normal N (G \<lparr>carrier :=K\<rparr>)" using assms K_def by simp
  3.1203 +  ultimately have "N \<inter> H \<lhd> G\<lparr>carrier := K \<inter> H\<rparr>"
  3.1204 +    using normal_inter[of K H N] assms(1) by blast
  3.1205 +  moreover have "K \<inter> H = H" using K_def assms subgroup_imp_subset by blast
  3.1206 +  ultimately show "normal (N\<inter>H) (G\<lparr>carrier := H\<rparr>)" by auto
  3.1207 +qed
  3.1208 +
  3.1209 +
  3.1210  end
     4.1 --- a/src/HOL/Algebra/FiniteProduct.thy	Thu Jun 14 15:45:53 2018 +0200
     4.2 +++ b/src/HOL/Algebra/FiniteProduct.thy	Thu Jun 14 15:20:20 2018 +0100
     4.3 @@ -332,15 +332,18 @@
     4.4    apply (auto simp add: finprod_def)
     4.5    done
     4.6  
     4.7 -lemma finprod_one [simp]: "(\<Otimes>i\<in>A. \<one>) = \<one>"
     4.8 +lemma finprod_one_eqI: "(\<And>x. x \<in> A \<Longrightarrow> f x = \<one>) \<Longrightarrow> finprod G f A = \<one>"
     4.9  proof (induct A rule: infinite_finite_induct)
    4.10    case empty show ?case by simp
    4.11  next
    4.12    case (insert a A)
    4.13 -  have "(%i. \<one>) \<in> A \<rightarrow> carrier G" by auto
    4.14 +  have "(\<lambda>i. \<one>) \<in> A \<rightarrow> carrier G" by auto
    4.15    with insert show ?case by simp
    4.16  qed simp
    4.17  
    4.18 +lemma finprod_one [simp]: "(\<Otimes>i\<in>A. \<one>) = \<one>"
    4.19 +  by (simp add: finprod_one_eqI)
    4.20 +
    4.21  lemma finprod_closed [simp]:
    4.22    fixes A
    4.23    assumes f: "f \<in> A \<rightarrow> carrier G" 
    4.24 @@ -524,4 +527,49 @@
    4.25  
    4.26  end
    4.27  
    4.28 +(* Jeremy Avigad. This should be generalized to arbitrary groups, not just commutative
    4.29 +   ones, using Lagrange's theorem. *)
    4.30 +
    4.31 +lemma (in comm_group) power_order_eq_one:
    4.32 +  assumes fin [simp]: "finite (carrier G)"
    4.33 +    and a [simp]: "a \<in> carrier G"
    4.34 +  shows "a [^] card(carrier G) = one G"
    4.35 +proof -
    4.36 +  have "(\<Otimes>x\<in>carrier G. x) = (\<Otimes>x\<in>carrier G. a \<otimes> x)"
    4.37 +    by (subst (2) finprod_reindex [symmetric],
    4.38 +      auto simp add: Pi_def inj_on_const_mult surj_const_mult)
    4.39 +  also have "\<dots> = (\<Otimes>x\<in>carrier G. a) \<otimes> (\<Otimes>x\<in>carrier G. x)"
    4.40 +    by (auto simp add: finprod_multf Pi_def)
    4.41 +  also have "(\<Otimes>x\<in>carrier G. a) = a [^] card(carrier G)"
    4.42 +    by (auto simp add: finprod_const)
    4.43 +  finally show ?thesis
    4.44 +(* uses the preceeding lemma *)
    4.45 +    by auto
    4.46 +qed
    4.47 +
    4.48 +
    4.49 +lemma (in comm_monoid) finprod_UN_disjoint:
    4.50 +  "finite I \<Longrightarrow> (\<forall>i\<in>I. finite (A i)) \<longrightarrow> (\<forall>i\<in>I. \<forall>j\<in>I. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}) \<longrightarrow>
    4.51 +    (\<forall>i\<in>I. \<forall>x \<in> A i. g x \<in> carrier G) \<longrightarrow>
    4.52 +    finprod G g (UNION I A) = finprod G (\<lambda>i. finprod G g (A i)) I"
    4.53 +  apply (induct set: finite)
    4.54 +   apply force
    4.55 +  apply clarsimp
    4.56 +  apply (subst finprod_Un_disjoint)
    4.57 +       apply blast
    4.58 +      apply (erule finite_UN_I)
    4.59 +      apply blast
    4.60 +     apply (fastforce)
    4.61 +    apply (auto intro!: funcsetI finprod_closed)
    4.62 +  done
    4.63 +
    4.64 +lemma (in comm_monoid) finprod_Union_disjoint:
    4.65 +  "finite C \<Longrightarrow>
    4.66 +    \<forall>A\<in>C. finite A \<and> (\<forall>x\<in>A. f x \<in> carrier G) \<Longrightarrow>
    4.67 +    \<forall>A\<in>C. \<forall>B\<in>C. A \<noteq> B \<longrightarrow> A \<inter> B = {} \<Longrightarrow>
    4.68 +    finprod G f (\<Union>C) = finprod G (finprod G f) C"
    4.69 +  apply (frule finprod_UN_disjoint [of C id f])
    4.70 +  apply auto
    4.71 +  done
    4.72 +
    4.73  end
     5.1 --- a/src/HOL/Algebra/Group.thy	Thu Jun 14 15:45:53 2018 +0200
     5.2 +++ b/src/HOL/Algebra/Group.thy	Thu Jun 14 15:20:20 2018 +0100
     5.3 @@ -2,6 +2,7 @@
     5.4      Author:     Clemens Ballarin, started 4 February 2003
     5.5  
     5.6  Based on work by Florian Kammueller, L C Paulson and Markus Wenzel.
     5.7 +With additional contributions from Martin Baillon and Paulo Emílio de Vilhena.
     5.8  *)
     5.9  
    5.10  theory Group
    5.11 @@ -52,7 +53,7 @@
    5.12    assumes m_closed [intro, simp]:
    5.13           "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk> \<Longrightarrow> x \<otimes> y \<in> carrier G"
    5.14        and m_assoc:
    5.15 -         "\<lbrakk>x \<in> carrier G; y \<in> carrier G; z \<in> carrier G\<rbrakk> 
    5.16 +         "\<lbrakk>x \<in> carrier G; y \<in> carrier G; z \<in> carrier G\<rbrakk>
    5.17            \<Longrightarrow> (x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"
    5.18        and one_closed [intro, simp]: "\<one> \<in> carrier G"
    5.19        and l_one [simp]: "x \<in> carrier G \<Longrightarrow> \<one> \<otimes> x = x"
    5.20 @@ -75,6 +76,12 @@
    5.21    "x \<in> Units G ==> x \<in> carrier G"
    5.22    by (unfold Units_def) fast
    5.23  
    5.24 +lemma (in monoid) one_unique:
    5.25 +  assumes "u \<in> carrier G"
    5.26 +    and "\<And>x. x \<in> carrier G \<Longrightarrow> u \<otimes> x = x"
    5.27 +  shows "u = \<one>"
    5.28 +  using assms(2)[OF one_closed] r_one[OF assms(1)] by simp
    5.29 +
    5.30  lemma (in monoid) inv_unique:
    5.31    assumes eq: "y \<otimes> x = \<one>"  "x \<otimes> y' = \<one>"
    5.32      and G: "x \<in> carrier G"  "y \<in> carrier G"  "y' \<in> carrier G"
    5.33 @@ -86,7 +93,7 @@
    5.34    finally show ?thesis .
    5.35  qed
    5.36  
    5.37 -lemma (in monoid) Units_m_closed [intro, simp]:
    5.38 +lemma (in monoid) Units_m_closed [simp, intro]:
    5.39    assumes x: "x \<in> Units G" and y: "y \<in> Units G"
    5.40    shows "x \<otimes> y \<in> Units G"
    5.41  proof -
    5.42 @@ -98,13 +105,7 @@
    5.43    moreover from x y xinv yinv have "x \<otimes> (y \<otimes> y') \<otimes> x' = \<one>" by simp
    5.44    moreover note x y
    5.45    ultimately show ?thesis unfolding Units_def
    5.46 -    \<comment> \<open>Must avoid premature use of \<open>hyp_subst_tac\<close>.\<close>
    5.47 -    apply (rule_tac CollectI)
    5.48 -    apply (rule)
    5.49 -    apply (fast)
    5.50 -    apply (rule bexI [where x = "y' \<otimes> x'"])
    5.51 -    apply (auto simp: m_assoc)
    5.52 -    done
    5.53 +    by simp (metis m_assoc m_closed)
    5.54  qed
    5.55  
    5.56  lemma (in monoid) Units_one_closed [intro, simp]:
    5.57 @@ -140,6 +141,10 @@
    5.58     apply (fast intro: inv_unique, fast)
    5.59    done
    5.60  
    5.61 +lemma (in monoid) inv_one [simp]:
    5.62 +  "inv \<one> = \<one>"
    5.63 +  by (metis Units_one_closed Units_r_inv l_one monoid.Units_inv_closed monoid_axioms)
    5.64 +
    5.65  lemma (in monoid) Units_inv_Units [intro, simp]:
    5.66    "x \<in> Units G ==> inv x \<in> Units G"
    5.67  proof -
    5.68 @@ -215,10 +220,23 @@
    5.69    "x \<in> carrier G ==> x [^] (n::nat) \<otimes> x [^] m = x [^] (n + m)"
    5.70    by (induct m) (simp_all add: m_assoc [THEN sym])
    5.71  
    5.72 +lemma (in monoid) nat_pow_comm:
    5.73 +  "x \<in> carrier G \<Longrightarrow> (x [^] (n::nat)) \<otimes> (x [^] (m :: nat)) = (x [^] m) \<otimes> (x [^] n)"
    5.74 +  using nat_pow_mult[of x n m] nat_pow_mult[of x m n] by (simp add: add.commute)
    5.75 +
    5.76 +lemma (in monoid) nat_pow_Suc2:
    5.77 +  "x \<in> carrier G \<Longrightarrow> x [^] (Suc n) = x \<otimes> (x [^] n)"
    5.78 +  using nat_pow_mult[of x 1 n] Suc_eq_plus1[of n]
    5.79 +  by (metis One_nat_def Suc_eq_plus1_left l_one nat.rec(1) nat_pow_Suc nat_pow_def)
    5.80 +
    5.81  lemma (in monoid) nat_pow_pow:
    5.82    "x \<in> carrier G ==> (x [^] n) [^] m = x [^] (n * m::nat)"
    5.83    by (induct m) (simp, simp add: nat_pow_mult add.commute)
    5.84  
    5.85 +lemma (in monoid) nat_pow_consistent:
    5.86 +  "x [^] (n :: nat) = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
    5.87 +  unfolding nat_pow_def by simp
    5.88 +
    5.89  
    5.90  (* Jacobson defines submonoid here. *)
    5.91  (* Jacobson defines the order of a monoid here. *)
    5.92 @@ -338,14 +356,6 @@
    5.93     (y \<otimes> x = z \<otimes> x) = (y = z)"
    5.94    by (metis inv_closed m_assoc r_inv r_one)
    5.95  
    5.96 -lemma (in group) inv_one [simp]:
    5.97 -  "inv \<one> = \<one>"
    5.98 -proof -
    5.99 -  have "inv \<one> = \<one> \<otimes> (inv \<one>)" by (simp del: r_inv Units_r_inv)
   5.100 -  moreover have "... = \<one>" by simp
   5.101 -  finally show ?thesis .
   5.102 -qed
   5.103 -
   5.104  lemma (in group) inv_inv [simp]:
   5.105    "x \<in> carrier G ==> inv (inv x) = x"
   5.106    using Units_inv_inv by simp
   5.107 @@ -416,6 +426,57 @@
   5.108      by (auto simp add: int_pow_def2 inv_solve_left inv_solve_right nat_add_distrib [symmetric] nat_pow_mult )
   5.109  qed
   5.110  
   5.111 +lemma (in group) nat_pow_inv:
   5.112 +  "x \<in> carrier G \<Longrightarrow> (inv x) [^] (i :: nat) = inv (x [^] i)"
   5.113 +proof (induction i)
   5.114 +  case 0 thus ?case by simp
   5.115 +next
   5.116 +  case (Suc i)
   5.117 +  have "(inv x) [^] Suc i = ((inv x) [^] i) \<otimes> inv x"
   5.118 +    by simp
   5.119 +  also have " ... = (inv (x [^] i)) \<otimes> inv x"
   5.120 +    by (simp add: Suc.IH Suc.prems)
   5.121 +  also have " ... = inv (x \<otimes> (x [^] i))"
   5.122 +    using inv_mult_group[OF Suc.prems nat_pow_closed[OF Suc.prems, of i]] by simp
   5.123 +  also have " ... = inv (x [^] (Suc i))"
   5.124 +    using Suc.prems nat_pow_Suc2 by auto
   5.125 +  finally show ?case .
   5.126 +qed
   5.127 +
   5.128 +lemma (in group) int_pow_inv:
   5.129 +  "x \<in> carrier G \<Longrightarrow> (inv x) [^] (i :: int) = inv (x [^] i)"
   5.130 +  by (simp add: nat_pow_inv int_pow_def2)
   5.131 +
   5.132 +lemma (in group) int_pow_pow:
   5.133 +  assumes "x \<in> carrier G"
   5.134 +  shows "(x [^] (n :: int)) [^] (m :: int) = x [^] (n * m :: int)"
   5.135 +proof (cases)
   5.136 +  assume n_ge: "n \<ge> 0" thus ?thesis
   5.137 +  proof (cases)
   5.138 +    assume m_ge: "m \<ge> 0" thus ?thesis
   5.139 +      using n_ge nat_pow_pow[OF assms, of "nat n" "nat m"] int_pow_def2
   5.140 +      by (simp add: mult_less_0_iff nat_mult_distrib)
   5.141 +  next
   5.142 +    assume m_lt: "\<not> m \<ge> 0" thus ?thesis
   5.143 +      using n_ge int_pow_def2 nat_pow_pow[OF assms, of "nat n" "nat (- m)"]
   5.144 +      by (smt assms group.int_pow_neg is_group mult_minus_right nat_mult_distrib split_mult_neg_le)
   5.145 +  qed
   5.146 +next
   5.147 +  assume n_lt: "\<not> n \<ge> 0" thus ?thesis
   5.148 +  proof (cases)
   5.149 +    assume m_ge: "m \<ge> 0" thus ?thesis
   5.150 +      using n_lt nat_pow_pow[OF assms, of "nat (- n)" "nat m"]
   5.151 +            nat_pow_inv[of "x [^] nat (- n)" "nat m"] int_pow_def2
   5.152 +      by (smt assms group.int_pow_closed group.int_pow_neg is_group mult_minus_right
   5.153 +          mult_nonpos_nonpos nat_mult_distrib_neg)
   5.154 +  next
   5.155 +    assume m_lt: "\<not> m \<ge> 0" thus ?thesis
   5.156 +      using n_lt nat_pow_pow[OF assms, of "nat (- n)" "nat (- m)"]
   5.157 +            nat_pow_inv[of "x [^] nat (- n)" "nat (- m)"] int_pow_def2
   5.158 +      by (smt assms inv_inv mult_nonpos_nonpos nat_mult_distrib_neg nat_pow_closed)
   5.159 +  qed
   5.160 +qed
   5.161 +
   5.162  lemma (in group) int_pow_diff:
   5.163    "x \<in> carrier G \<Longrightarrow> x [^] (n - m :: int) = x [^] n \<otimes> inv (x [^] m)"
   5.164  by(simp only: diff_conv_add_uminus int_pow_mult int_pow_neg)
   5.165 @@ -426,6 +487,70 @@
   5.166  lemma (in group) inj_on_cmult: "c \<in> carrier G \<Longrightarrow> inj_on (\<lambda>x. c \<otimes> x) (carrier G)"
   5.167  by(simp add: inj_on_def)
   5.168  
   5.169 +(*Following subsection contributed by Martin Baillon*)
   5.170 +subsection \<open>Submonoids\<close>
   5.171 +
   5.172 +locale submonoid =
   5.173 +  fixes H and G (structure)
   5.174 +  assumes subset: "H \<subseteq> carrier G"
   5.175 +    and m_closed [intro, simp]: "\<lbrakk>x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> x \<otimes> y \<in> H"
   5.176 +    and one_closed [simp]: "\<one> \<in> H"
   5.177 +
   5.178 +lemma (in submonoid) is_submonoid:
   5.179 +  "submonoid H G" by (rule submonoid_axioms)
   5.180 +
   5.181 +lemma (in submonoid) mem_carrier [simp]:
   5.182 +  "x \<in> H \<Longrightarrow> x \<in> carrier G"
   5.183 +  using subset by blast
   5.184 +
   5.185 +lemma submonoid_imp_subset:
   5.186 +  "submonoid H G \<Longrightarrow> H \<subseteq> carrier G"
   5.187 +  by (rule submonoid.subset)
   5.188 +
   5.189 +lemma (in submonoid) submonoid_is_monoid [intro]:
   5.190 +  assumes "monoid G"
   5.191 +  shows "monoid (G\<lparr>carrier := H\<rparr>)"
   5.192 +proof -
   5.193 +  interpret monoid G by fact
   5.194 +  show ?thesis
   5.195 +    by (simp add: monoid_def m_assoc)
   5.196 +qed
   5.197 +
   5.198 +lemma (in monoid) submonoidE:
   5.199 +  assumes "submonoid H G"
   5.200 +  shows "H \<subseteq> carrier G"
   5.201 +    and "H \<noteq> {}"
   5.202 +    and "\<And>a b. \<lbrakk>a \<in> H; b \<in> H\<rbrakk> \<Longrightarrow> a \<otimes> b \<in> H"
   5.203 +  using assms submonoid_imp_subset apply blast
   5.204 +  using assms submonoid_def apply auto[1]
   5.205 +  by (simp add: assms submonoid.m_closed)+
   5.206 +
   5.207 +lemma submonoid_nonempty:
   5.208 +  "~ submonoid {} G"
   5.209 +  by (blast dest: submonoid.one_closed)
   5.210 +
   5.211 +lemma (in submonoid) finite_monoid_imp_card_positive:
   5.212 +  "finite (carrier G) ==> 0 < card H"
   5.213 +proof (rule classical)
   5.214 +  assume "finite (carrier G)" and a: "~ 0 < card H"
   5.215 +  then have "finite H" by (blast intro: finite_subset [OF subset])
   5.216 +  with is_submonoid a have "submonoid {} G" by simp
   5.217 +  with submonoid_nonempty show ?thesis by contradiction
   5.218 +qed
   5.219 +
   5.220 +
   5.221 +lemma (in monoid) monoid_incl_imp_submonoid :
   5.222 +  assumes "H \<subseteq> carrier G"
   5.223 +and "monoid (G\<lparr>carrier := H\<rparr>)"
   5.224 +shows "submonoid H G"
   5.225 +proof (intro submonoid.intro[OF assms(1)])
   5.226 +  have ab_eq : "\<And> a b. a \<in> H \<Longrightarrow> b \<in> H \<Longrightarrow> a \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> b = a \<otimes> b" using assms by simp
   5.227 +  have "\<And>a b. a \<in> H \<Longrightarrow> b \<in> H \<Longrightarrow> a \<otimes> b \<in> carrier (G\<lparr>carrier := H\<rparr>) "
   5.228 +    using assms ab_eq unfolding group_def using monoid.m_closed by fastforce
   5.229 +  thus "\<And>a b. a \<in> H \<Longrightarrow> b \<in> H \<Longrightarrow> a \<otimes> b \<in> H" by simp
   5.230 +  show "\<one> \<in> H " using monoid.one_closed[OF assms(2)] assms by simp
   5.231 +qed
   5.232 +
   5.233  subsection \<open>Subgroups\<close>
   5.234  
   5.235  locale subgroup =
   5.236 @@ -444,6 +569,7 @@
   5.237    "x \<in> H \<Longrightarrow> x \<in> carrier G"
   5.238    using subset by blast
   5.239  
   5.240 +(*DELETE*)
   5.241  lemma subgroup_imp_subset:
   5.242    "subgroup H G \<Longrightarrow> H \<subseteq> carrier G"
   5.243    by (rule subgroup.subset)
   5.244 @@ -460,6 +586,40 @@
   5.245      done
   5.246  qed
   5.247  
   5.248 +lemma (in group) subgroup_inv_equality:
   5.249 +  assumes "subgroup H G" "x \<in> H"
   5.250 +  shows "m_inv (G \<lparr>carrier := H\<rparr>) x = inv x"
   5.251 +  unfolding m_inv_def apply auto
   5.252 +  using subgroup.m_inv_closed[OF assms] inv_equality
   5.253 +  by (metis (no_types, hide_lams) assms subgroup.mem_carrier)
   5.254 +
   5.255 +lemma (in group) int_pow_consistent: (* by Paulo *)
   5.256 +  assumes "subgroup H G" "x \<in> H"
   5.257 +  shows "x [^] (n :: int) = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
   5.258 +proof (cases)
   5.259 +  assume ge: "n \<ge> 0"
   5.260 +  hence "x [^] n = x [^] (nat n)"
   5.261 +    using int_pow_def2 by auto
   5.262 +  also have " ... = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (nat n)"
   5.263 +    using nat_pow_consistent by simp
   5.264 +  also have " ... = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
   5.265 +    using group.int_pow_def2[OF subgroup.subgroup_is_group[OF assms(1) is_group]] ge by auto
   5.266 +  finally show ?thesis .
   5.267 +next
   5.268 +  assume "\<not> n \<ge> 0" hence lt: "n < 0" by simp
   5.269 +  hence "x [^] n = inv (x [^] (nat (- n)))"
   5.270 +    using int_pow_def2 by auto
   5.271 +  also have " ... = (inv x) [^] (nat (- n))"
   5.272 +    by (metis assms nat_pow_inv subgroup.mem_carrier)
   5.273 +  also have " ... = (inv\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> x) [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (nat (- n))"
   5.274 +    using subgroup_inv_equality[OF assms] nat_pow_consistent by auto
   5.275 +  also have " ... = inv\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (nat (- n)))"
   5.276 +    using group.nat_pow_inv[OF subgroup.subgroup_is_group[OF assms(1) is_group]] assms(2) by auto
   5.277 +  also have " ... = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
   5.278 +    using group.int_pow_def2[OF subgroup.subgroup_is_group[OF assms(1) is_group]] lt by auto
   5.279 +  finally show ?thesis .
   5.280 +qed
   5.281 +
   5.282  text \<open>
   5.283    Since @{term H} is nonempty, it contains some element @{term x}.  Since
   5.284    it is closed under inverse, it contains \<open>inv x\<close>.  Since
   5.285 @@ -482,6 +642,17 @@
   5.286    show "\<one> \<in> H" by (rule one_in_subset) (auto simp only: assms)
   5.287  qed
   5.288  
   5.289 +
   5.290 +lemma (in group) subgroupE:
   5.291 +  assumes "subgroup H G"
   5.292 +  shows "H \<subseteq> carrier G"
   5.293 +    and "H \<noteq> {}"
   5.294 +    and "\<And>a. a \<in> H \<Longrightarrow> inv a \<in> H"
   5.295 +    and "\<And>a b. \<lbrakk>a \<in> H; b \<in> H\<rbrakk> \<Longrightarrow> a \<otimes> b \<in> H"
   5.296 +  using assms subgroup.subset apply blast
   5.297 +  using assms subgroup_def apply auto[1]
   5.298 +  by (simp add: assms subgroup.m_closed subgroup.m_inv_closed)+
   5.299 +
   5.300  declare monoid.one_closed [iff] group.inv_closed [simp]
   5.301    monoid.l_one [simp] monoid.r_one [simp] group.inv_inv [simp]
   5.302  
   5.303 @@ -498,10 +669,38 @@
   5.304    with subgroup_nonempty show ?thesis by contradiction
   5.305  qed
   5.306  
   5.307 -(*
   5.308 -lemma (in monoid) Units_subgroup:
   5.309 -  "subgroup (Units G) G"
   5.310 -*)
   5.311 +(*Following 3 lemmas contributed by Martin Baillon*)
   5.312 +
   5.313 +lemma (in subgroup) subgroup_is_submonoid :
   5.314 +  "submonoid H G"
   5.315 +  by (simp add: submonoid.intro subset)
   5.316 +
   5.317 +lemma (in group) submonoid_subgroupI :
   5.318 +  assumes "submonoid H G"
   5.319 +    and "\<And>a. a \<in> H \<Longrightarrow> inv a \<in> H"
   5.320 +  shows "subgroup H G"
   5.321 +  by (metis assms subgroup_def submonoid_def)
   5.322 +
   5.323 +lemma (in group) group_incl_imp_subgroup:
   5.324 +  assumes "H \<subseteq> carrier G"
   5.325 +    and "group (G\<lparr>carrier := H\<rparr>)"
   5.326 +  shows "subgroup H G"
   5.327 +proof (intro submonoid_subgroupI[OF monoid_incl_imp_submonoid[OF assms(1)]])
   5.328 +  show "monoid (G\<lparr>carrier := H\<rparr>)" using group_def assms by blast
   5.329 +  have ab_eq : "\<And> a b. a \<in> H \<Longrightarrow> b \<in> H \<Longrightarrow> a \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> b = a \<otimes> b" using assms by simp
   5.330 +  fix a  assume aH : "a \<in> H"
   5.331 +  have " inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a \<in> carrier G"
   5.332 +    using assms aH group.inv_closed[OF assms(2)] by auto
   5.333 +  moreover have "\<one>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> = \<one>" using assms monoid.one_closed ab_eq one_def by simp
   5.334 +  hence "a \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a= \<one>"
   5.335 +    using assms ab_eq aH  group.r_inv[OF assms(2)] by simp
   5.336 +  hence "a \<otimes> inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a= \<one>"
   5.337 +    using aH assms group.inv_closed[OF assms(2)] ab_eq by simp
   5.338 +  ultimately have "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a = inv a"
   5.339 +    by (smt aH assms(1) contra_subsetD group.inv_inv is_group local.inv_equality)
   5.340 +  moreover have "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a \<in> H" using aH group.inv_closed[OF assms(2)] by auto
   5.341 +  ultimately show "inv a \<in> H" by auto
   5.342 +qed
   5.343  
   5.344  
   5.345  subsection \<open>Direct Products\<close>
   5.346 @@ -520,7 +719,7 @@
   5.347    interpret G: monoid G by fact
   5.348    interpret H: monoid H by fact
   5.349    from assms
   5.350 -  show ?thesis by (unfold monoid_def DirProd_def, auto) 
   5.351 +  show ?thesis by (unfold monoid_def DirProd_def, auto)
   5.352  qed
   5.353  
   5.354  
   5.355 @@ -548,6 +747,10 @@
   5.356       "(g, h) \<otimes>\<^bsub>(G \<times>\<times> H)\<^esub> (g', h') = (g \<otimes>\<^bsub>G\<^esub> g', h \<otimes>\<^bsub>H\<^esub> h')"
   5.357    by (simp add: DirProd_def)
   5.358  
   5.359 +lemma DirProd_assoc :
   5.360 +"(G \<times>\<times> H \<times>\<times> I) = (G \<times>\<times> (H \<times>\<times> I))"
   5.361 +  by auto
   5.362 +
   5.363  lemma inv_DirProd [simp]:
   5.364    assumes "group G" and "group H"
   5.365    assumes g: "g \<in> carrier G"
   5.366 @@ -561,6 +764,22 @@
   5.367    show ?thesis by (simp add: Prod.inv_equality g h)
   5.368  qed
   5.369  
   5.370 +lemma DirProd_subgroups :
   5.371 +  assumes "group G"
   5.372 +    and "subgroup H G"
   5.373 +    and "group K"
   5.374 +    and "subgroup I K"
   5.375 +  shows "subgroup (H \<times> I) (G \<times>\<times> K)"
   5.376 +proof (intro group.group_incl_imp_subgroup[OF DirProd_group[OF assms(1)assms(3)]])
   5.377 +  have "H \<subseteq> carrier G" "I \<subseteq> carrier K" using subgroup.subset assms apply blast+.
   5.378 +  thus "(H \<times> I) \<subseteq> carrier (G \<times>\<times> K)" unfolding DirProd_def by auto
   5.379 +  have "Group.group ((G\<lparr>carrier := H\<rparr>) \<times>\<times> (K\<lparr>carrier := I\<rparr>))"
   5.380 +    using DirProd_group[OF subgroup.subgroup_is_group[OF assms(2)assms(1)]
   5.381 +        subgroup.subgroup_is_group[OF assms(4)assms(3)]].
   5.382 +  moreover have "((G\<lparr>carrier := H\<rparr>) \<times>\<times> (K\<lparr>carrier := I\<rparr>)) = ((G \<times>\<times> K)\<lparr>carrier := H \<times> I\<rparr>)"
   5.383 +    unfolding DirProd_def using assms apply simp.
   5.384 +  ultimately show "Group.group ((G \<times>\<times> K)\<lparr>carrier := H \<times> I\<rparr>)" by simp
   5.385 +qed
   5.386  
   5.387  subsection \<open>Homomorphisms and Isomorphisms\<close>
   5.388  
   5.389 @@ -575,31 +794,203 @@
   5.390  by (fastforce simp add: hom_def compose_def)
   5.391  
   5.392  definition
   5.393 -  iso :: "_ => _ => ('a => 'b) set" (infixr "\<cong>" 60)
   5.394 -  where "G \<cong> H = {h. h \<in> hom G H \<and> bij_betw h (carrier G) (carrier H)}"
   5.395 +  iso :: "_ => _ => ('a => 'b) set"
   5.396 +  where "iso G H = {h. h \<in> hom G H \<and> bij_betw h (carrier G) (carrier H)}"
   5.397  
   5.398 -lemma iso_refl: "(\<lambda>x. x) \<in> G \<cong> G"
   5.399 -by (simp add: iso_def hom_def inj_on_def bij_betw_def Pi_def)
   5.400 +definition
   5.401 +  is_iso :: "_ \<Rightarrow> _ \<Rightarrow> bool" (infixr "\<cong>" 60)
   5.402 +  where "G \<cong> H = (iso G H  \<noteq> {})"
   5.403  
   5.404 -lemma (in group) iso_sym:
   5.405 -     "h \<in> G \<cong> H \<Longrightarrow> inv_into (carrier G) h \<in> H \<cong> G"
   5.406 -apply (simp add: iso_def bij_betw_inv_into) 
   5.407 -apply (subgoal_tac "inv_into (carrier G) h \<in> carrier H \<rightarrow> carrier G") 
   5.408 - prefer 2 apply (simp add: bij_betw_imp_funcset [OF bij_betw_inv_into]) 
   5.409 +lemma iso_set_refl: "(\<lambda>x. x) \<in> iso G G"
   5.410 +  by (simp add: iso_def hom_def inj_on_def bij_betw_def Pi_def)
   5.411 +
   5.412 +corollary iso_refl : "G \<cong> G"
   5.413 +  using iso_set_refl unfolding is_iso_def by auto
   5.414 +
   5.415 +lemma (in group) iso_set_sym:
   5.416 +     "h \<in> iso G H \<Longrightarrow> inv_into (carrier G) h \<in> (iso H G)"
   5.417 +apply (simp add: iso_def bij_betw_inv_into)
   5.418 +apply (subgoal_tac "inv_into (carrier G) h \<in> carrier H \<rightarrow> carrier G")
   5.419 + prefer 2 apply (simp add: bij_betw_imp_funcset [OF bij_betw_inv_into])
   5.420  apply (simp add: hom_def bij_betw_def inv_into_f_eq f_inv_into_f Pi_def)
   5.421  done
   5.422  
   5.423 -lemma (in group) iso_trans: 
   5.424 -     "[|h \<in> G \<cong> H; i \<in> H \<cong> I|] ==> (compose (carrier G) i h) \<in> G \<cong> I"
   5.425 +corollary (in group) iso_sym :
   5.426 +"G \<cong> H \<Longrightarrow> H \<cong> G"
   5.427 +  using iso_set_sym unfolding is_iso_def by auto
   5.428 +
   5.429 +lemma (in group) iso_set_trans:
   5.430 +     "[|h \<in> iso G H; i \<in> iso H I|] ==> (compose (carrier G) i h) \<in> iso G I"
   5.431  by (auto simp add: iso_def hom_compose bij_betw_compose)
   5.432  
   5.433 -lemma DirProd_commute_iso:
   5.434 -  shows "(\<lambda>(x,y). (y,x)) \<in> (G \<times>\<times> H) \<cong> (H \<times>\<times> G)"
   5.435 +corollary (in group) iso_trans :
   5.436 +"\<lbrakk>G \<cong> H ; H \<cong> I\<rbrakk> \<Longrightarrow> G \<cong> I"
   5.437 +  using iso_set_trans unfolding is_iso_def by blast
   5.438 +
   5.439 +(* Next four lemmas contributed by Paulo. *)
   5.440 +
   5.441 +lemma (in monoid) hom_imp_img_monoid:
   5.442 +  assumes "h \<in> hom G H"
   5.443 +  shows "monoid (H \<lparr> carrier := h ` (carrier G), one := h \<one>\<^bsub>G\<^esub> \<rparr>)" (is "monoid ?h_img")
   5.444 +proof (rule monoidI)
   5.445 +  show "\<one>\<^bsub>?h_img\<^esub> \<in> carrier ?h_img"
   5.446 +    by auto
   5.447 +next
   5.448 +  fix x y z assume "x \<in> carrier ?h_img" "y \<in> carrier ?h_img" "z \<in> carrier ?h_img"
   5.449 +  then obtain g1 g2 g3
   5.450 +    where g1: "g1 \<in> carrier G" "x = h g1"
   5.451 +      and g2: "g2 \<in> carrier G" "y = h g2"
   5.452 +      and g3: "g3 \<in> carrier G" "z = h g3"
   5.453 +    using image_iff[where ?f = h and ?A = "carrier G"] by auto
   5.454 +  have aux_lemma:
   5.455 +    "\<And>a b. \<lbrakk> a \<in> carrier G; b \<in> carrier G \<rbrakk> \<Longrightarrow> h a \<otimes>\<^bsub>(?h_img)\<^esub> h b = h (a \<otimes> b)"
   5.456 +    using assms unfolding hom_def by auto
   5.457 +
   5.458 +  show "x \<otimes>\<^bsub>(?h_img)\<^esub> \<one>\<^bsub>(?h_img)\<^esub> = x"
   5.459 +    using aux_lemma[OF g1(1) one_closed] g1(2) r_one[OF g1(1)] by simp
   5.460 +
   5.461 +  show "\<one>\<^bsub>(?h_img)\<^esub> \<otimes>\<^bsub>(?h_img)\<^esub> x = x"
   5.462 +    using aux_lemma[OF one_closed g1(1)] g1(2) l_one[OF g1(1)] by simp
   5.463 +
   5.464 +  have "x \<otimes>\<^bsub>(?h_img)\<^esub> y = h (g1 \<otimes> g2)"
   5.465 +    using aux_lemma g1 g2 by auto
   5.466 +  thus "x \<otimes>\<^bsub>(?h_img)\<^esub> y \<in> carrier ?h_img"
   5.467 +    using g1(1) g2(1) by simp
   5.468 +
   5.469 +  have "(x \<otimes>\<^bsub>(?h_img)\<^esub> y) \<otimes>\<^bsub>(?h_img)\<^esub> z = h ((g1 \<otimes> g2) \<otimes> g3)"
   5.470 +    using aux_lemma g1 g2 g3 by auto
   5.471 +  also have " ... = h (g1 \<otimes> (g2 \<otimes> g3))"
   5.472 +    using m_assoc[OF g1(1) g2(1) g3(1)] by simp
   5.473 +  also have " ... = x \<otimes>\<^bsub>(?h_img)\<^esub> (y \<otimes>\<^bsub>(?h_img)\<^esub> z)"
   5.474 +    using aux_lemma g1 g2 g3 by auto
   5.475 +  finally show "(x \<otimes>\<^bsub>(?h_img)\<^esub> y) \<otimes>\<^bsub>(?h_img)\<^esub> z = x \<otimes>\<^bsub>(?h_img)\<^esub> (y \<otimes>\<^bsub>(?h_img)\<^esub> z)" .
   5.476 +qed
   5.477 +
   5.478 +lemma (in group) hom_imp_img_group:
   5.479 +  assumes "h \<in> hom G H"
   5.480 +  shows "group (H \<lparr> carrier := h ` (carrier G), one := h \<one>\<^bsub>G\<^esub> \<rparr>)" (is "group ?h_img")
   5.481 +proof -
   5.482 +  interpret monoid ?h_img
   5.483 +    using hom_imp_img_monoid[OF assms] .
   5.484 +
   5.485 +  show ?thesis
   5.486 +  proof (unfold_locales)
   5.487 +    show "carrier ?h_img \<subseteq> Units ?h_img"
   5.488 +    proof (auto simp add: Units_def)
   5.489 +      have aux_lemma:
   5.490 +        "\<And>g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow> h g1 \<otimes>\<^bsub>H\<^esub> h g2 = h (g1 \<otimes> g2)"
   5.491 +        using assms unfolding hom_def by auto
   5.492 +
   5.493 +      fix g1 assume g1: "g1 \<in> carrier G"
   5.494 +      thus "\<exists>g2 \<in> carrier G. (h g2) \<otimes>\<^bsub>H\<^esub> (h g1) = h \<one> \<and> (h g1) \<otimes>\<^bsub>H\<^esub> (h g2) = h \<one>"
   5.495 +        using aux_lemma[OF g1 inv_closed[OF g1]]
   5.496 +              aux_lemma[OF inv_closed[OF g1] g1]
   5.497 +              inv_closed by auto
   5.498 +    qed
   5.499 +  qed
   5.500 +qed
   5.501 +
   5.502 +lemma (in group) iso_imp_group:
   5.503 +  assumes "G \<cong> H" and "monoid H"
   5.504 +  shows "group H"
   5.505 +proof -
   5.506 +  obtain \<phi> where phi: "\<phi> \<in> iso G H" "inv_into (carrier G) \<phi> \<in> iso H G"
   5.507 +    using iso_set_sym assms unfolding is_iso_def by blast
   5.508 +  define \<psi> where psi_def: "\<psi> = inv_into (carrier G) \<phi>"
   5.509 +
   5.510 +  from phi
   5.511 +  have surj: "\<phi> ` (carrier G) = (carrier H)" "\<psi> ` (carrier H) = (carrier G)"
   5.512 +   and inj: "inj_on \<phi> (carrier G)" "inj_on \<psi> (carrier H)"
   5.513 +   and phi_hom: "\<And>g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow> \<phi> (g1 \<otimes> g2) = (\<phi> g1) \<otimes>\<^bsub>H\<^esub> (\<phi> g2)"
   5.514 +   and psi_hom: "\<And>h1 h2. \<lbrakk> h1 \<in> carrier H; h2 \<in> carrier H \<rbrakk> \<Longrightarrow> \<psi> (h1 \<otimes>\<^bsub>H\<^esub> h2) = (\<psi> h1) \<otimes> (\<psi> h2)"
   5.515 +   using psi_def unfolding iso_def bij_betw_def hom_def by auto
   5.516 +
   5.517 +  have phi_one: "\<phi> \<one> = \<one>\<^bsub>H\<^esub>"
   5.518 +  proof -
   5.519 +    have "(\<phi> \<one>) \<otimes>\<^bsub>H\<^esub> \<one>\<^bsub>H\<^esub> = (\<phi> \<one>) \<otimes>\<^bsub>H\<^esub> (\<phi> \<one>)"
   5.520 +      by (metis assms(2) image_eqI monoid.r_one one_closed phi_hom r_one surj(1))
   5.521 +    thus ?thesis
   5.522 +      by (metis (no_types, hide_lams) Units_eq Units_one_closed assms(2) f_inv_into_f imageI
   5.523 +          monoid.l_one monoid.one_closed phi_hom psi_def r_one surj)
   5.524 +  qed
   5.525 +
   5.526 +  have "carrier H \<subseteq> Units H"
   5.527 +  proof
   5.528 +    fix h assume h: "h \<in> carrier H"
   5.529 +    let ?inv_h = "\<phi> (inv (\<psi> h))"
   5.530 +    have "h \<otimes>\<^bsub>H\<^esub> ?inv_h = \<phi> (\<psi> h) \<otimes>\<^bsub>H\<^esub> ?inv_h"
   5.531 +      by (simp add: f_inv_into_f h psi_def surj(1))
   5.532 +    also have " ... = \<phi> ((\<psi> h) \<otimes> inv (\<psi> h))"
   5.533 +      by (metis h imageI inv_closed phi_hom surj(2))
   5.534 +    also have " ... = \<phi> \<one>"
   5.535 +      by (simp add: h inv_into_into psi_def surj(1))
   5.536 +    finally have 1: "h \<otimes>\<^bsub>H\<^esub> ?inv_h = \<one>\<^bsub>H\<^esub>"
   5.537 +      using phi_one by simp
   5.538 +
   5.539 +    have "?inv_h \<otimes>\<^bsub>H\<^esub> h = ?inv_h \<otimes>\<^bsub>H\<^esub> \<phi> (\<psi> h)"
   5.540 +      by (simp add: f_inv_into_f h psi_def surj(1))
   5.541 +    also have " ... = \<phi> (inv (\<psi> h) \<otimes> (\<psi> h))"
   5.542 +      by (metis h imageI inv_closed phi_hom surj(2))
   5.543 +    also have " ... = \<phi> \<one>"
   5.544 +      by (simp add: h inv_into_into psi_def surj(1))
   5.545 +    finally have 2: "?inv_h \<otimes>\<^bsub>H\<^esub> h = \<one>\<^bsub>H\<^esub>"
   5.546 +      using phi_one by simp
   5.547 +
   5.548 +    thus "h \<in> Units H" unfolding Units_def using 1 2 h surj by fastforce
   5.549 +  qed
   5.550 +  thus ?thesis unfolding group_def group_axioms_def using assms(2) by simp
   5.551 +qed
   5.552 +
   5.553 +corollary (in group) iso_imp_img_group:
   5.554 +  assumes "h \<in> iso G H"
   5.555 +  shows "group (H \<lparr> one := h \<one> \<rparr>)"
   5.556 +proof -
   5.557 +  let ?h_img = "H \<lparr> carrier := h ` (carrier G), one := h \<one> \<rparr>"
   5.558 +  have "h \<in> iso G ?h_img"
   5.559 +    using assms unfolding iso_def hom_def bij_betw_def by auto
   5.560 +  hence "G \<cong> ?h_img"
   5.561 +    unfolding is_iso_def by auto
   5.562 +  hence "group ?h_img"
   5.563 +    using iso_imp_group[of ?h_img] hom_imp_img_monoid[of h H] assms unfolding iso_def by simp
   5.564 +  moreover have "carrier H = carrier ?h_img"
   5.565 +    using assms unfolding iso_def bij_betw_def by simp
   5.566 +  hence "H \<lparr> one := h \<one> \<rparr> = ?h_img"
   5.567 +    by simp
   5.568 +  ultimately show ?thesis by simp
   5.569 +qed
   5.570 +
   5.571 +lemma DirProd_commute_iso_set:
   5.572 +  shows "(\<lambda>(x,y). (y,x)) \<in> iso (G \<times>\<times> H) (H \<times>\<times> G)"
   5.573 +  by (auto simp add: iso_def hom_def inj_on_def bij_betw_def)
   5.574 +
   5.575 +corollary DirProd_commute_iso :
   5.576 +"(G \<times>\<times> H) \<cong> (H \<times>\<times> G)"
   5.577 +  using DirProd_commute_iso_set unfolding is_iso_def by blast
   5.578 +
   5.579 +lemma DirProd_assoc_iso_set:
   5.580 +  shows "(\<lambda>(x,y,z). (x,(y,z))) \<in> iso (G \<times>\<times> H \<times>\<times> I) (G \<times>\<times> (H \<times>\<times> I))"
   5.581  by (auto simp add: iso_def hom_def inj_on_def bij_betw_def)
   5.582  
   5.583 -lemma DirProd_assoc_iso:
   5.584 -  shows "(\<lambda>(x,y,z). (x,(y,z))) \<in> (G \<times>\<times> H \<times>\<times> I) \<cong> (G \<times>\<times> (H \<times>\<times> I))"
   5.585 -by (auto simp add: iso_def hom_def inj_on_def bij_betw_def)
   5.586 +lemma (in group) DirProd_iso_set_trans:
   5.587 +  assumes "g \<in> iso G G2"
   5.588 +    and "h \<in> iso H I"
   5.589 +  shows "(\<lambda>(x,y). (g x, h y)) \<in> iso (G \<times>\<times> H) (G2 \<times>\<times> I)"
   5.590 +proof-
   5.591 +  have "(\<lambda>(x,y). (g x, h y)) \<in> hom (G \<times>\<times> H) (G2 \<times>\<times> I)"
   5.592 +    using assms unfolding iso_def hom_def by auto
   5.593 +  moreover have " inj_on (\<lambda>(x,y). (g x, h y)) (carrier (G \<times>\<times> H))"
   5.594 +    using assms unfolding iso_def DirProd_def bij_betw_def inj_on_def by auto
   5.595 +  moreover have "(\<lambda>(x, y). (g x, h y)) ` carrier (G \<times>\<times> H) = carrier (G2 \<times>\<times> I)"
   5.596 +    using assms unfolding iso_def bij_betw_def image_def DirProd_def by fastforce
   5.597 +  ultimately show "(\<lambda>(x,y). (g x, h y)) \<in> iso (G \<times>\<times> H) (G2 \<times>\<times> I)"
   5.598 +    unfolding iso_def bij_betw_def by auto
   5.599 +qed
   5.600 +
   5.601 +corollary (in group) DirProd_iso_trans :
   5.602 +  assumes "G \<cong> G2"
   5.603 +    and "H \<cong> I"
   5.604 +  shows "G \<times>\<times> H \<cong> G2 \<times>\<times> I"
   5.605 +  using DirProd_iso_set_trans assms unfolding is_iso_def by blast
   5.606  
   5.607  
   5.608  text\<open>Basis for homomorphism proofs: we assume two groups @{term G} and
   5.609 @@ -655,6 +1046,56 @@
   5.610    "x \<in> carrier G \<Longrightarrow> (([^]) x) \<in> hom \<lparr> carrier = UNIV, mult = (+), one = 0::int \<rparr> G "
   5.611    unfolding hom_def by (simp add: int_pow_mult)
   5.612  
   5.613 +(* Next six lemmas contributed by Paulo. *)
   5.614 +
   5.615 +lemma (in group_hom) img_is_subgroup: "subgroup (h ` (carrier G)) H"
   5.616 +  apply (rule subgroupI)
   5.617 +  apply (auto simp add: image_subsetI)
   5.618 +  apply (metis (no_types, hide_lams) G.inv_closed hom_inv image_iff)
   5.619 +  apply (smt G.monoid_axioms hom_mult image_iff monoid.m_closed)
   5.620 +  done
   5.621 +
   5.622 +lemma (in group_hom) subgroup_img_is_subgroup:
   5.623 +  assumes "subgroup I G"
   5.624 +  shows "subgroup (h ` I) H"
   5.625 +proof -
   5.626 +  have "h \<in> hom (G \<lparr> carrier := I \<rparr>) H"
   5.627 +    using G.subgroupE[OF assms] subgroup.mem_carrier[OF assms] homh
   5.628 +    unfolding hom_def by auto
   5.629 +  hence "group_hom (G \<lparr> carrier := I \<rparr>) H h"
   5.630 +    using subgroup.subgroup_is_group[OF assms G.is_group] is_group
   5.631 +    unfolding group_hom_def group_hom_axioms_def by simp
   5.632 +  thus ?thesis
   5.633 +    using group_hom.img_is_subgroup[of "G \<lparr> carrier := I \<rparr>" H h] by simp
   5.634 +qed
   5.635 +
   5.636 +lemma (in group_hom) induced_group_hom:
   5.637 +  assumes "subgroup I G"
   5.638 +  shows "group_hom (G \<lparr> carrier := I \<rparr>) (H \<lparr> carrier := h ` I \<rparr>) h"
   5.639 +proof -
   5.640 +  have "h \<in> hom (G \<lparr> carrier := I \<rparr>) (H \<lparr> carrier := h ` I \<rparr>)"
   5.641 +    using homh subgroup.mem_carrier[OF assms] unfolding hom_def by auto
   5.642 +  thus ?thesis
   5.643 +    unfolding group_hom_def group_hom_axioms_def
   5.644 +    using subgroup.subgroup_is_group[OF assms G.is_group]
   5.645 +          subgroup.subgroup_is_group[OF subgroup_img_is_subgroup[OF assms] is_group] by simp
   5.646 +qed
   5.647 +
   5.648 +lemma (in group) canonical_inj_is_hom:
   5.649 +  assumes "subgroup H G"
   5.650 +  shows "group_hom (G \<lparr> carrier := H \<rparr>) G id"
   5.651 +  unfolding group_hom_def group_hom_axioms_def hom_def
   5.652 +  using subgroup.subgroup_is_group[OF assms is_group]
   5.653 +        is_group subgroup.subset[OF assms] by auto
   5.654 +
   5.655 +lemma (in group_hom) nat_pow_hom:
   5.656 +  "x \<in> carrier G \<Longrightarrow> h (x [^] (n :: nat)) = (h x) [^]\<^bsub>H\<^esub> n"
   5.657 +  by (induction n) auto
   5.658 +
   5.659 +lemma (in group_hom) int_pow_hom:
   5.660 +  "x \<in> carrier G \<Longrightarrow> h (x [^] (n :: int)) = (h x) [^]\<^bsub>H\<^esub> n"
   5.661 +  using int_pow_def2 nat_pow_hom by (simp add: G.int_pow_def2)
   5.662 +
   5.663  
   5.664  subsection \<open>Commutative Structures\<close>
   5.665  
   5.666 @@ -693,7 +1134,7 @@
   5.667        "!!x y. [| x \<in> carrier G; y \<in> carrier G |] ==> x \<otimes> y = y \<otimes> x"
   5.668    shows "comm_monoid G"
   5.669    using l_one
   5.670 -    by (auto intro!: comm_monoid.intro comm_monoid_axioms.intro monoid.intro 
   5.671 +    by (auto intro!: comm_monoid.intro comm_monoid_axioms.intro monoid.intro
   5.672               intro: assms simp: m_closed one_closed m_comm)
   5.673  
   5.674  lemma (in monoid) monoid_comm_monoidI:
   5.675 @@ -716,6 +1157,18 @@
   5.676    (x \<otimes> y) [^] (n::nat) = x [^] n \<otimes> y [^] n"
   5.677    by (induct n) (simp, simp add: m_ac)
   5.678  
   5.679 +lemma (in comm_monoid) submonoid_is_comm_monoid :
   5.680 +  assumes "submonoid H G"
   5.681 +  shows "comm_monoid (G\<lparr>carrier := H\<rparr>)"
   5.682 +proof (intro monoid.monoid_comm_monoidI)
   5.683 +  show "monoid (G\<lparr>carrier := H\<rparr>)"
   5.684 +    using submonoid.submonoid_is_monoid assms comm_monoid_axioms comm_monoid_def by blast
   5.685 +  show "\<And>x y. x \<in> carrier (G\<lparr>carrier := H\<rparr>) \<Longrightarrow> y \<in> carrier (G\<lparr>carrier := H\<rparr>)
   5.686 +        \<Longrightarrow> x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y = y \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x" apply simp
   5.687 +    using  assms comm_monoid_axioms_def submonoid.mem_carrier
   5.688 +    by (metis m_comm)
   5.689 +qed
   5.690 +
   5.691  locale comm_group = comm_monoid + group
   5.692  
   5.693  lemma (in group) group_comm_groupI:
   5.694 @@ -739,10 +1192,109 @@
   5.695    shows "comm_group G"
   5.696    by (fast intro: group.group_comm_groupI groupI assms)
   5.697  
   5.698 +lemma comm_groupE:
   5.699 +  fixes G (structure)
   5.700 +  assumes "comm_group G"
   5.701 +  shows "\<And>x y. \<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<otimes> y \<in> carrier G"
   5.702 +    and "\<one> \<in> carrier G"
   5.703 +    and "\<And>x y z. \<lbrakk> x \<in> carrier G; y \<in> carrier G; z \<in> carrier G \<rbrakk> \<Longrightarrow> (x \<otimes> y) \<otimes> z = x \<otimes> (y \<otimes> z)"
   5.704 +    and "\<And>x y. \<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<otimes> y = y \<otimes> x"
   5.705 +    and "\<And>x. x \<in> carrier G \<Longrightarrow> \<one> \<otimes> x = x"
   5.706 +    and "\<And>x. x \<in> carrier G \<Longrightarrow> \<exists>y \<in> carrier G. y \<otimes> x = \<one>"
   5.707 +  apply (simp_all add: group.axioms assms comm_group.axioms comm_monoid.m_comm comm_monoid.m_ac(1))
   5.708 +  by (simp_all add: Group.group.axioms(1) assms comm_group.axioms(2) monoid.m_closed group.r_inv_ex)
   5.709 +
   5.710  lemma (in comm_group) inv_mult:
   5.711    "[| x \<in> carrier G; y \<in> carrier G |] ==> inv (x \<otimes> y) = inv x \<otimes> inv y"
   5.712    by (simp add: m_ac inv_mult_group)
   5.713  
   5.714 +(* Next three lemmas contributed by Paulo. *)
   5.715 +
   5.716 +lemma (in comm_monoid) hom_imp_img_comm_monoid:
   5.717 +  assumes "h \<in> hom G H"
   5.718 +  shows "comm_monoid (H \<lparr> carrier := h ` (carrier G), one := h \<one>\<^bsub>G\<^esub> \<rparr>)" (is "comm_monoid ?h_img")
   5.719 +proof (rule monoid.monoid_comm_monoidI)
   5.720 +  show "monoid ?h_img"
   5.721 +    using hom_imp_img_monoid[OF assms] .
   5.722 +next
   5.723 +  fix x y assume "x \<in> carrier ?h_img" "y \<in> carrier ?h_img"
   5.724 +  then obtain g1 g2
   5.725 +    where g1: "g1 \<in> carrier G" "x = h g1"
   5.726 +      and g2: "g2 \<in> carrier G" "y = h g2"
   5.727 +    by auto
   5.728 +  have "x \<otimes>\<^bsub>(?h_img)\<^esub> y = h (g1 \<otimes> g2)"
   5.729 +    using g1 g2 assms unfolding hom_def by auto
   5.730 +  also have " ... = h (g2 \<otimes> g1)"
   5.731 +    using m_comm[OF g1(1) g2(1)] by simp
   5.732 +  also have " ... = y \<otimes>\<^bsub>(?h_img)\<^esub> x"
   5.733 +    using g1 g2 assms unfolding hom_def by auto
   5.734 +  finally show "x \<otimes>\<^bsub>(?h_img)\<^esub> y = y \<otimes>\<^bsub>(?h_img)\<^esub> x" .
   5.735 +qed
   5.736 +
   5.737 +lemma (in comm_group) iso_imp_img_comm_group:
   5.738 +  assumes "h \<in> iso G H"
   5.739 +  shows "comm_group (H \<lparr> one := h \<one>\<^bsub>G\<^esub> \<rparr>)"
   5.740 +proof -
   5.741 +  let ?h_img = "H \<lparr> carrier := h ` (carrier G), one := h \<one> \<rparr>"
   5.742 +  have "comm_monoid ?h_img"
   5.743 +    using hom_imp_img_comm_monoid[of h H] assms unfolding iso_def by simp
   5.744 +  moreover have "carrier H = carrier ?h_img"
   5.745 +    using assms unfolding iso_def bij_betw_def by simp
   5.746 +  hence "H \<lparr> one := h \<one> \<rparr> = ?h_img"
   5.747 +    by simp
   5.748 +  ultimately have "comm_monoid (H \<lparr> one := h \<one>\<^bsub>G\<^esub> \<rparr>)"
   5.749 +    by simp
   5.750 +  thus ?thesis
   5.751 +    unfolding comm_group_def using iso_imp_img_group[OF assms] by simp
   5.752 +qed
   5.753 +
   5.754 +lemma (in comm_group) iso_imp_comm_group:
   5.755 +  assumes "G \<cong> H" "monoid H"
   5.756 +  shows "comm_group H"
   5.757 +proof -
   5.758 +  obtain h where h: "h \<in> iso G H"
   5.759 +    using assms(1) unfolding is_iso_def by auto
   5.760 +  hence comm_gr: "comm_group (H \<lparr> one := h \<one> \<rparr>)"
   5.761 +    using iso_imp_img_comm_group[of h H] by simp
   5.762 +  hence "\<And>x. x \<in> carrier H \<Longrightarrow> h \<one> \<otimes>\<^bsub>H\<^esub> x = x"
   5.763 +    using monoid.l_one[of "H \<lparr> one := h \<one> \<rparr>"] unfolding comm_group_def comm_monoid_def by simp
   5.764 +  moreover have "h \<one> \<in> carrier H"
   5.765 +    using h one_closed unfolding iso_def hom_def by auto
   5.766 +  ultimately have "h \<one> = \<one>\<^bsub>H\<^esub>"
   5.767 +    using monoid.one_unique[OF assms(2), of "h \<one>"] by simp
   5.768 +  hence "H = H \<lparr> one := h \<one> \<rparr>"
   5.769 +    by simp
   5.770 +  thus ?thesis
   5.771 +    using comm_gr by simp
   5.772 +qed
   5.773 +
   5.774 +(*A subgroup of a subgroup is a subgroup of the group*)
   5.775 +lemma (in group) incl_subgroup:
   5.776 +  assumes "subgroup J G"
   5.777 +    and "subgroup I (G\<lparr>carrier:=J\<rparr>)"
   5.778 +  shows "subgroup I G" unfolding subgroup_def
   5.779 +proof
   5.780 +  have H1: "I \<subseteq> carrier (G\<lparr>carrier:=J\<rparr>)" using assms(2) subgroup_imp_subset by blast
   5.781 +  also have H2: "...\<subseteq>J" by simp
   5.782 +  also  have "...\<subseteq>(carrier G)"  by (simp add: assms(1) subgroup_imp_subset)
   5.783 +  finally have H: "I \<subseteq> carrier G" by simp
   5.784 +  have "(\<And>x y. \<lbrakk>x \<in> I ; y \<in> I\<rbrakk> \<Longrightarrow> x \<otimes> y \<in> I)" using assms(2) by (auto simp add: subgroup_def)
   5.785 +  thus  "I \<subseteq> carrier G \<and> (\<forall>x y. x \<in> I \<longrightarrow> y \<in> I \<longrightarrow> x \<otimes> y \<in> I)"  using H by blast
   5.786 +  have K: "\<one> \<in> I" using assms(2) by (auto simp add: subgroup_def)
   5.787 +  have "(\<And>x. x \<in> I \<Longrightarrow> inv x \<in> I)" using assms  subgroup.m_inv_closed H
   5.788 +    by (metis H1 H2  subgroup_inv_equality subsetCE)
   5.789 +  thus "\<one> \<in> I \<and> (\<forall>x. x \<in> I \<longrightarrow> inv x \<in> I)" using K by blast
   5.790 +qed
   5.791 +
   5.792 +(*A subgroup included in another subgroup is a subgroup of the subgroup*)
   5.793 +lemma (in group) subgroup_incl:
   5.794 +  assumes "subgroup I G"
   5.795 +    and "subgroup J G"
   5.796 +    and "I\<subseteq>J"
   5.797 +  shows "subgroup I (G\<lparr>carrier:=J\<rparr>)"using assms subgroup_inv_equality
   5.798 +  by (auto simp add: subgroup_def)
   5.799 +
   5.800 +
   5.801  
   5.802  subsection \<open>The Lattice of Subgroups of a Group\<close>
   5.803  
   5.804 @@ -762,16 +1314,11 @@
   5.805  
   5.806  lemma (in group) is_monoid [intro, simp]:
   5.807    "monoid G"
   5.808 -  by (auto intro: monoid.intro m_assoc) 
   5.809 +  by (auto intro: monoid.intro m_assoc)
   5.810  
   5.811 -lemma (in group) subgroup_inv_equality:
   5.812 -  "[| subgroup H G; x \<in> H |] ==> m_inv (G \<lparr>carrier := H\<rparr>) x = inv x"
   5.813 -apply (rule_tac inv_equality [THEN sym])
   5.814 -  apply (rule group.l_inv [OF subgroup_imp_group, simplified], assumption+)
   5.815 - apply (rule subsetD [OF subgroup.subset], assumption+)
   5.816 -apply (rule subsetD [OF subgroup.subset], assumption)
   5.817 -apply (rule_tac group.inv_closed [OF subgroup_imp_group, simplified], assumption+)
   5.818 -done
   5.819 +lemma (in group) subgroup_mult_equality:
   5.820 +  "\<lbrakk> subgroup H G; h1 \<in> H; h2 \<in> H \<rbrakk> \<Longrightarrow>  h1 \<otimes>\<^bsub>G \<lparr> carrier := H \<rparr>\<^esub> h2 = h1 \<otimes> h2"
   5.821 +  unfolding subgroup_def by simp
   5.822  
   5.823  theorem (in group) subgroups_Inter:
   5.824    assumes subgr: "(\<And>H. H \<in> A \<Longrightarrow> subgroup H G)"
   5.825 @@ -793,6 +1340,11 @@
   5.826    show "x \<otimes> y \<in> \<Inter>A" by blast
   5.827  qed
   5.828  
   5.829 +lemma (in group) subgroups_Inter_pair :
   5.830 +  assumes  "subgroup I G"
   5.831 +    and  "subgroup J G"
   5.832 +  shows "subgroup (I\<inter>J) G" using subgroups_Inter[ where ?A = "{I,J}"] assms by auto
   5.833 +
   5.834  theorem (in group) subgroups_complete_lattice:
   5.835    "complete_lattice \<lparr>carrier = {H. subgroup H G}, eq = (=), le = (\<subseteq>)\<rparr>"
   5.836      (is "complete_lattice ?L")
   5.837 @@ -831,4 +1383,90 @@
   5.838    then show "\<exists>I. greatest ?L I (Lower ?L A)" ..
   5.839  qed
   5.840  
   5.841 +subsection\<open>Jeremy Avigad's @{text"More_Group"} material\<close>
   5.842 +
   5.843 +text \<open>
   5.844 +  Show that the units in any monoid give rise to a group.
   5.845 +
   5.846 +  The file Residues.thy provides some infrastructure to use
   5.847 +  facts about the unit group within the ring locale.
   5.848 +\<close>
   5.849 +
   5.850 +definition units_of :: "('a, 'b) monoid_scheme \<Rightarrow> 'a monoid"
   5.851 +  where "units_of G =
   5.852 +    \<lparr>carrier = Units G, Group.monoid.mult = Group.monoid.mult G, one  = one G\<rparr>"
   5.853 +
   5.854 +lemma (in monoid) units_group: "group (units_of G)"
   5.855 +  apply (unfold units_of_def)
   5.856 +  apply (rule groupI)
   5.857 +      apply auto
   5.858 +   apply (subst m_assoc)
   5.859 +      apply auto
   5.860 +  apply (rule_tac x = "inv x" in bexI)
   5.861 +   apply auto
   5.862 +  done
   5.863 +
   5.864 +lemma (in comm_monoid) units_comm_group: "comm_group (units_of G)"
   5.865 +  apply (rule group.group_comm_groupI)
   5.866 +   apply (rule units_group)
   5.867 +  apply (insert comm_monoid_axioms)
   5.868 +  apply (unfold units_of_def Units_def comm_monoid_def comm_monoid_axioms_def)
   5.869 +  apply auto
   5.870 +  done
   5.871 +
   5.872 +lemma units_of_carrier: "carrier (units_of G) = Units G"
   5.873 +  by (auto simp: units_of_def)
   5.874 +
   5.875 +lemma units_of_mult: "mult (units_of G) = mult G"
   5.876 +  by (auto simp: units_of_def)
   5.877 +
   5.878 +lemma units_of_one: "one (units_of G) = one G"
   5.879 +  by (auto simp: units_of_def)
   5.880 +
   5.881 +lemma (in monoid) units_of_inv: "x \<in> Units G \<Longrightarrow> m_inv (units_of G) x = m_inv G x"
   5.882 +  apply (rule sym)
   5.883 +  apply (subst m_inv_def)
   5.884 +  apply (rule the1_equality)
   5.885 +   apply (rule ex_ex1I)
   5.886 +    apply (subst (asm) Units_def)
   5.887 +    apply auto
   5.888 +     apply (erule inv_unique)
   5.889 +        apply auto
   5.890 +    apply (rule Units_closed)
   5.891 +    apply (simp_all only: units_of_carrier [symmetric])
   5.892 +    apply (insert units_group)
   5.893 +    apply auto
   5.894 +   apply (subst units_of_mult [symmetric])
   5.895 +   apply (subst units_of_one [symmetric])
   5.896 +   apply (erule group.r_inv, assumption)
   5.897 +  apply (subst units_of_mult [symmetric])
   5.898 +  apply (subst units_of_one [symmetric])
   5.899 +  apply (erule group.l_inv, assumption)
   5.900 +  done
   5.901 +
   5.902 +lemma (in group) inj_on_const_mult: "a \<in> carrier G \<Longrightarrow> inj_on (\<lambda>x. a \<otimes> x) (carrier G)"
   5.903 +  unfolding inj_on_def by auto
   5.904 +
   5.905 +lemma (in group) surj_const_mult: "a \<in> carrier G \<Longrightarrow> (\<lambda>x. a \<otimes> x) ` carrier G = carrier G"
   5.906 +  apply (auto simp add: image_def)
   5.907 +  apply (rule_tac x = "(m_inv G a) \<otimes> x" in bexI)
   5.908 +  apply auto
   5.909 +(* auto should get this. I suppose we need "comm_monoid_simprules"
   5.910 +   for ac_simps rewriting. *)
   5.911 +  apply (subst m_assoc [symmetric])
   5.912 +  apply auto
   5.913 +  done
   5.914 +
   5.915 +lemma (in group) l_cancel_one [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> x \<otimes> a = x \<longleftrightarrow> a = one G"
   5.916 +  by (metis Units_eq Units_l_cancel monoid.r_one monoid_axioms one_closed)
   5.917 +
   5.918 +lemma (in group) r_cancel_one [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> a \<otimes> x = x \<longleftrightarrow> a = one G"
   5.919 +  by (metis monoid.l_one monoid_axioms one_closed right_cancel)
   5.920 +
   5.921 +lemma (in group) l_cancel_one' [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> x = x \<otimes> a \<longleftrightarrow> a = one G"
   5.922 +  using l_cancel_one by fastforce
   5.923 +
   5.924 +lemma (in group) r_cancel_one' [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> x = a \<otimes> x \<longleftrightarrow> a = one G"
   5.925 +  using r_cancel_one by fastforce
   5.926 +
   5.927  end
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/HOL/Algebra/Group_Action.thy	Thu Jun 14 15:20:20 2018 +0100
     6.3 @@ -0,0 +1,925 @@
     6.4 +(* Title:      Group_Action.thy                                               *)
     6.5 +(* Author:     Paulo Emílio de Vilhena                                        *)
     6.6 +
     6.7 +theory Group_Action
     6.8 +imports Bij Coset Congruence
     6.9 +
    6.10 +begin
    6.11 +
    6.12 +section \<open>Group Actions\<close>
    6.13 +
    6.14 +locale group_action =
    6.15 +  fixes G (structure) and E and \<phi>
    6.16 +  assumes group_hom: "group_hom G (BijGroup E) \<phi>"
    6.17 +
    6.18 +definition
    6.19 +  orbit :: "[_, 'a \<Rightarrow> 'b \<Rightarrow> 'b, 'b] \<Rightarrow> 'b set"
    6.20 +  where "orbit G \<phi> x = {(\<phi> g) x | g. g \<in> carrier G}"
    6.21 +
    6.22 +definition
    6.23 +  orbits :: "[_, 'b set, 'a \<Rightarrow> 'b \<Rightarrow> 'b] \<Rightarrow> ('b set) set"
    6.24 +  where "orbits G E \<phi> = {orbit G \<phi> x | x. x \<in> E}"
    6.25 +
    6.26 +definition
    6.27 +  stabilizer :: "[_, 'a \<Rightarrow> 'b \<Rightarrow> 'b, 'b] \<Rightarrow> 'a set"
    6.28 +  where "stabilizer G \<phi> x = {g \<in> carrier G. (\<phi> g) x = x}"
    6.29 +
    6.30 +definition
    6.31 +  invariants :: "['b set, 'a \<Rightarrow> 'b \<Rightarrow> 'b, 'a] \<Rightarrow> 'b set"
    6.32 +  where "invariants E \<phi> g = {x \<in> E. (\<phi> g) x = x}"
    6.33 +
    6.34 +definition
    6.35 +  normalizer :: "[_, 'a set] \<Rightarrow> 'a set"
    6.36 +  where "normalizer G H =
    6.37 +         stabilizer G (\<lambda>g. \<lambda>H \<in> {H. H \<subseteq> carrier G}. g <#\<^bsub>G\<^esub> H #>\<^bsub>G\<^esub> (inv\<^bsub>G\<^esub> g)) H"
    6.38 +
    6.39 +locale faithful_action = group_action +
    6.40 +  assumes faithful: "inj_on \<phi> (carrier G)"
    6.41 +
    6.42 +locale transitive_action = group_action +
    6.43 +  assumes unique_orbit: "\<lbrakk> x \<in> E; y \<in> E \<rbrakk> \<Longrightarrow> \<exists>g \<in> carrier G. (\<phi> g) x = y"
    6.44 +
    6.45 +
    6.46 +
    6.47 +subsection \<open>Prelimineries\<close>
    6.48 +
    6.49 +text \<open>Some simple lemmas to make group action's properties more explicit\<close>
    6.50 +
    6.51 +lemma (in group_action) id_eq_one: "(\<lambda>x \<in> E. x) = \<phi> \<one>"
    6.52 +  by (metis BijGroup_def group_hom group_hom.hom_one select_convs(2))
    6.53 +
    6.54 +lemma (in group_action) bij_prop0:
    6.55 +  "\<And> g. g \<in> carrier G \<Longrightarrow> (\<phi> g) \<in> Bij E"
    6.56 +  by (metis BijGroup_def group_hom group_hom.hom_closed partial_object.select_convs(1))
    6.57 +
    6.58 +lemma (in group_action) surj_prop:
    6.59 +  "\<And> g. g \<in> carrier G \<Longrightarrow> (\<phi> g) ` E = E"
    6.60 +  using bij_prop0 by (simp add: Bij_def bij_betw_def)
    6.61 +
    6.62 +lemma (in group_action) inj_prop:
    6.63 +  "\<And> g. g \<in> carrier G \<Longrightarrow> inj_on (\<phi> g) E"
    6.64 +  using bij_prop0 by (simp add: Bij_def bij_betw_def)
    6.65 +
    6.66 +lemma (in group_action) bij_prop1:
    6.67 +  "\<And> g y. \<lbrakk> g \<in> carrier G; y \<in> E \<rbrakk> \<Longrightarrow>  \<exists>!x \<in> E. (\<phi> g) x = y"
    6.68 +proof -
    6.69 +  fix g y assume "g \<in> carrier G" "y \<in> E"
    6.70 +  hence "\<exists>x \<in> E. (\<phi> g) x = y"
    6.71 +    using surj_prop by force
    6.72 +  moreover have "\<And> x1 x2. \<lbrakk> x1 \<in> E; x2 \<in> E \<rbrakk> \<Longrightarrow> (\<phi> g) x1 = (\<phi> g) x2 \<Longrightarrow> x1 = x2"
    6.73 +    using inj_prop by (meson \<open>g \<in> carrier G\<close> inj_on_eq_iff)
    6.74 +  ultimately show "\<exists>!x \<in> E. (\<phi> g) x = y"
    6.75 +    by blast
    6.76 +qed
    6.77 +
    6.78 +lemma (in group_action) composition_rule:
    6.79 +  assumes "x \<in> E" "g1 \<in> carrier G" "g2 \<in> carrier G"
    6.80 +  shows "\<phi> (g1 \<otimes> g2) x = (\<phi> g1) (\<phi> g2 x)"
    6.81 +proof -
    6.82 +  have "\<phi> (g1 \<otimes> g2) x = ((\<phi> g1) \<otimes>\<^bsub>BijGroup E\<^esub> (\<phi> g2)) x"
    6.83 +    using assms(2) assms(3) group_hom group_hom.hom_mult by fastforce
    6.84 +  also have " ... = (compose E (\<phi> g1) (\<phi> g2)) x"
    6.85 +    unfolding BijGroup_def by (simp add: assms bij_prop0)
    6.86 +  finally show "\<phi> (g1 \<otimes> g2) x = (\<phi> g1) (\<phi> g2 x)"
    6.87 +    by (simp add: assms(1) compose_eq)
    6.88 +qed
    6.89 +
    6.90 +lemma (in group_action) element_image:
    6.91 +  assumes "g \<in> carrier G" and "x \<in> E" and "(\<phi> g) x = y"
    6.92 +  shows "y \<in> E"
    6.93 +  using surj_prop assms by blast
    6.94 +
    6.95 +
    6.96 +
    6.97 +subsection \<open>Orbits\<close>
    6.98 +
    6.99 +text\<open>We prove here that orbits form an equivalence relation\<close>
   6.100 +
   6.101 +lemma (in group_action) orbit_sym_aux:
   6.102 +  assumes "g \<in> carrier G"
   6.103 +    and "x \<in> E"
   6.104 +    and "(\<phi> g) x = y"
   6.105 +  shows "(\<phi> (inv g)) y = x"
   6.106 +proof -
   6.107 +  interpret group G
   6.108 +    using group_hom group_hom.axioms(1) by auto
   6.109 +  have "y \<in> E"
   6.110 +    using element_image assms by simp
   6.111 +  have "inv g \<in> carrier G"
   6.112 +    by (simp add: assms(1))
   6.113 +
   6.114 +  have "(\<phi> (inv g)) y = (\<phi> (inv g)) ((\<phi> g) x)"
   6.115 +    using assms(3) by simp
   6.116 +  also have " ... = compose E (\<phi> (inv g)) (\<phi> g) x"
   6.117 +    by (simp add: assms(2) compose_eq)
   6.118 +  also have " ... = ((\<phi> (inv g)) \<otimes>\<^bsub>BijGroup E\<^esub> (\<phi> g)) x"
   6.119 +    by (simp add: BijGroup_def assms(1) bij_prop0)
   6.120 +  also have " ... = (\<phi> ((inv g) \<otimes> g)) x"
   6.121 +    by (metis \<open>inv g \<in> carrier G\<close> assms(1) group_hom group_hom.hom_mult)
   6.122 +  finally show "(\<phi> (inv g)) y = x"
   6.123 +    by (metis assms(1) assms(2) id_eq_one l_inv restrict_apply)
   6.124 +qed
   6.125 +
   6.126 +lemma (in group_action) orbit_refl:
   6.127 +  "x \<in> E \<Longrightarrow> x \<in> orbit G \<phi> x"
   6.128 +proof -
   6.129 +  assume "x \<in> E" hence "(\<phi> \<one>) x = x"
   6.130 +    using id_eq_one by (metis restrict_apply')
   6.131 +  thus "x \<in> orbit G \<phi> x" unfolding orbit_def
   6.132 +    using group.is_monoid group_hom group_hom.axioms(1) by force 
   6.133 +qed
   6.134 +
   6.135 +lemma (in group_action) orbit_sym:
   6.136 +  assumes "x \<in> E" and "y \<in> E" and "y \<in> orbit G \<phi> x"
   6.137 +  shows "x \<in> orbit G \<phi> y"
   6.138 +proof -
   6.139 +  have "\<exists> g \<in> carrier G. (\<phi> g) x = y"
   6.140 +    by (smt assms(3) mem_Collect_eq orbit_def)
   6.141 +  then obtain g where g: "g \<in> carrier G \<and> (\<phi> g) x = y" by blast
   6.142 +  hence "(\<phi> (inv g)) y = x"
   6.143 +    using orbit_sym_aux by (simp add: assms(1))
   6.144 +  thus ?thesis
   6.145 +    using g group_hom group_hom.axioms(1) orbit_def by fastforce 
   6.146 +qed
   6.147 +
   6.148 +lemma (in group_action) orbit_trans:
   6.149 +  assumes "x \<in> E" "y \<in> E" "z \<in> E"
   6.150 +    and "y \<in> orbit G \<phi> x" "z \<in> orbit G \<phi> y" 
   6.151 +  shows "z \<in> orbit G \<phi> x"
   6.152 +proof -
   6.153 +  interpret group G
   6.154 +    using group_hom group_hom.axioms(1) by auto
   6.155 +
   6.156 +  have "\<exists> g1 \<in> carrier G. (\<phi> g1) x = y"
   6.157 +    by (smt assms mem_Collect_eq orbit_def)
   6.158 +  then obtain g1 where g1: "g1 \<in> carrier G \<and> (\<phi> g1) x = y" by blast
   6.159 +
   6.160 +  have "\<exists> g2 \<in> carrier G. (\<phi> g2) y = z"
   6.161 +    by (smt assms mem_Collect_eq orbit_def)
   6.162 +  then obtain g2 where g2: "g2 \<in> carrier G \<and> (\<phi> g2) y = z" by blast
   6.163 +  
   6.164 +  have "(\<phi> (g2 \<otimes> g1)) x = ((\<phi> g2) \<otimes>\<^bsub>BijGroup E\<^esub> (\<phi> g1)) x"
   6.165 +    using g1 g2 group_hom group_hom.hom_mult by fastforce
   6.166 +  also have " ... = (\<phi> g2) ((\<phi> g1) x)"
   6.167 +    using composition_rule assms(1) calculation g1 g2 by auto
   6.168 +  finally have "(\<phi> (g2 \<otimes> g1)) x = z"
   6.169 +    by (simp add: g1 g2)
   6.170 +  thus ?thesis
   6.171 +    using g1 g2 orbit_def by force 
   6.172 +qed
   6.173 +
   6.174 +lemma (in group_action) orbits_as_classes:
   6.175 +  "classes\<^bsub>\<lparr> carrier = E, eq = \<lambda>x. \<lambda>y. y \<in> orbit G \<phi> x \<rparr>\<^esub> = orbits G E \<phi>"
   6.176 +  unfolding eq_classes_def eq_class_of_def orbits_def apply simp
   6.177 +proof -
   6.178 +  have "\<And>x. x \<in> E \<Longrightarrow> {y \<in> E. y \<in> orbit G \<phi> x} = orbit G \<phi> x"
   6.179 +    by (smt Collect_cong element_image mem_Collect_eq orbit_def)
   6.180 +  thus "{{y \<in> E. y \<in> orbit G \<phi> x} |x. x \<in> E} = {orbit G \<phi> x |x. x \<in> E}" by blast
   6.181 +qed
   6.182 +
   6.183 +theorem (in group_action) orbit_partition:
   6.184 +  "partition E (orbits G E \<phi>)"
   6.185 +proof -
   6.186 +  have "equivalence \<lparr> carrier = E, eq = \<lambda>x. \<lambda>y. y \<in> orbit G \<phi> x \<rparr>"
   6.187 +  unfolding equivalence_def apply simp
   6.188 +  using orbit_refl orbit_sym orbit_trans by blast
   6.189 +  thus ?thesis using equivalence.partition_from_equivalence orbits_as_classes by fastforce
   6.190 +qed
   6.191 +
   6.192 +corollary (in group_action) orbits_coverture:
   6.193 +  "\<Union> (orbits G E \<phi>) = E"
   6.194 +  using partition.partition_coverture[OF orbit_partition] by simp
   6.195 +
   6.196 +corollary (in group_action) disjoint_union:
   6.197 +  assumes "orb1 \<in> (orbits G E \<phi>)" "orb2 \<in> (orbits G E \<phi>)"
   6.198 +  shows "(orb1 = orb2) \<or> (orb1 \<inter> orb2) = {}"
   6.199 +  using partition.disjoint_union[OF orbit_partition] assms by auto
   6.200 +
   6.201 +corollary (in group_action) disjoint_sum:
   6.202 +  assumes "finite E"
   6.203 +  shows "(\<Sum>orb\<in>(orbits G E \<phi>). \<Sum>x\<in>orb. f x) = (\<Sum>x\<in>E. f x)"
   6.204 +  using partition.disjoint_sum[OF orbit_partition] assms by auto
   6.205 +
   6.206 +
   6.207 +subsubsection \<open>Transitive Actions\<close>
   6.208 +
   6.209 +text \<open>Transitive actions have only one orbit\<close>
   6.210 +
   6.211 +lemma (in transitive_action) all_equivalent:
   6.212 +  "\<lbrakk> x \<in> E; y \<in> E \<rbrakk> \<Longrightarrow> x .=\<^bsub>\<lparr>carrier = E, eq = \<lambda>x y. y \<in> orbit G \<phi> x\<rparr>\<^esub> y"
   6.213 +proof -
   6.214 +  assume "x \<in> E" "y \<in> E"
   6.215 +  hence "\<exists> g \<in> carrier G. (\<phi> g) x = y"
   6.216 +    using unique_orbit  by blast
   6.217 +  hence "y \<in> orbit G \<phi> x"
   6.218 +    using orbit_def by fastforce
   6.219 +  thus "x .=\<^bsub>\<lparr>carrier = E, eq = \<lambda>x y. y \<in> orbit G \<phi> x\<rparr>\<^esub> y" by simp
   6.220 +qed
   6.221 +
   6.222 +proposition (in transitive_action) one_orbit:
   6.223 +  assumes "E \<noteq> {}"
   6.224 +  shows "card (orbits G E \<phi>) = 1"
   6.225 +proof -
   6.226 +  have "orbits G E \<phi> \<noteq> {}"
   6.227 +    using assms orbits_coverture by auto
   6.228 +  moreover have "\<And> orb1 orb2. \<lbrakk> orb1 \<in> (orbits G E \<phi>); orb2 \<in> (orbits G E \<phi>) \<rbrakk> \<Longrightarrow> orb1 = orb2"
   6.229 +  proof -
   6.230 +    fix orb1 orb2 assume orb1: "orb1 \<in> (orbits G E \<phi>)"
   6.231 +                     and orb2: "orb2 \<in> (orbits G E \<phi>)"
   6.232 +    then obtain x y where x: "orb1 = orbit G \<phi> x" and x_E: "x \<in> E" 
   6.233 +                      and y: "orb2 = orbit G \<phi> y" and y_E: "y \<in> E"
   6.234 +      unfolding orbits_def by blast
   6.235 +    hence "x \<in> orbit G \<phi> y" using all_equivalent by auto
   6.236 +    hence "orb1 \<inter> orb2 \<noteq> {}" using x y x_E orbit_refl by auto
   6.237 +    thus "orb1 = orb2" using disjoint_union[of orb1 orb2] orb1 orb2 by auto
   6.238 +  qed
   6.239 +  ultimately show "card (orbits G E \<phi>) = 1"
   6.240 +    by (meson is_singletonI' is_singleton_altdef)
   6.241 +qed
   6.242 +
   6.243 +
   6.244 +
   6.245 +subsection \<open>Stabilizers\<close>
   6.246 +
   6.247 +text \<open>We show that stabilizers are subgroups from the acting group\<close>
   6.248 +
   6.249 +lemma (in group_action) stabilizer_subset:
   6.250 +  "stabilizer G \<phi> x \<subseteq> carrier G"
   6.251 +  by (metis (no_types, lifting) mem_Collect_eq stabilizer_def subsetI)
   6.252 +
   6.253 +lemma (in group_action) stabilizer_m_closed:
   6.254 +  assumes "x \<in> E" "g1 \<in> (stabilizer G \<phi> x)" "g2 \<in> (stabilizer G \<phi> x)"
   6.255 +  shows "(g1 \<otimes> g2) \<in> (stabilizer G \<phi> x)"
   6.256 +proof -
   6.257 +  interpret group G
   6.258 +    using group_hom group_hom.axioms(1) by auto
   6.259 +  
   6.260 +  have "\<phi> g1 x = x"
   6.261 +    using assms stabilizer_def by fastforce
   6.262 +  moreover have "\<phi> g2 x = x"
   6.263 +    using assms stabilizer_def by fastforce
   6.264 +  moreover have g1: "g1 \<in> carrier G"
   6.265 +    by (meson assms contra_subsetD stabilizer_subset)
   6.266 +  moreover have g2: "g2 \<in> carrier G"
   6.267 +    by (meson assms contra_subsetD stabilizer_subset)
   6.268 +  ultimately have "\<phi> (g1 \<otimes> g2) x = x"
   6.269 +    using composition_rule assms by simp
   6.270 +
   6.271 +  thus ?thesis
   6.272 +    by (simp add: g1 g2 stabilizer_def) 
   6.273 +qed
   6.274 +
   6.275 +lemma (in group_action) stabilizer_one_closed:
   6.276 +  assumes "x \<in> E"
   6.277 +  shows "\<one> \<in> (stabilizer G \<phi> x)"
   6.278 +proof -
   6.279 +  have "\<phi> \<one> x = x"
   6.280 +    by (metis assms id_eq_one restrict_apply')
   6.281 +  thus ?thesis
   6.282 +    using group_def group_hom group_hom.axioms(1) stabilizer_def by fastforce
   6.283 +qed
   6.284 +
   6.285 +lemma (in group_action) stabilizer_m_inv_closed:
   6.286 +  assumes "x \<in> E" "g \<in> (stabilizer G \<phi> x)"
   6.287 +  shows "(inv g) \<in> (stabilizer G \<phi> x)"
   6.288 +proof -
   6.289 +  interpret group G
   6.290 +    using group_hom group_hom.axioms(1) by auto
   6.291 +
   6.292 +  have "\<phi> g x = x"
   6.293 +    using assms(2) stabilizer_def by fastforce
   6.294 +  moreover have g: "g \<in> carrier G"
   6.295 +    using assms(2) stabilizer_subset by blast
   6.296 +  moreover have inv_g: "inv g \<in> carrier G"
   6.297 +    by (simp add: g)
   6.298 +  ultimately have "\<phi> (inv g) x = x"
   6.299 +    using assms(1) orbit_sym_aux by blast
   6.300 +
   6.301 +  thus ?thesis by (simp add: inv_g stabilizer_def) 
   6.302 +qed
   6.303 +
   6.304 +theorem (in group_action) stabilizer_subgroup:
   6.305 +  assumes "x \<in> E"
   6.306 +  shows "subgroup (stabilizer G \<phi> x) G"
   6.307 +  unfolding subgroup_def
   6.308 +  using stabilizer_subset stabilizer_m_closed stabilizer_one_closed
   6.309 +        stabilizer_m_inv_closed assms by simp
   6.310 +
   6.311 +
   6.312 +
   6.313 +subsection \<open>The Orbit-Stabilizer Theorem\<close>
   6.314 +
   6.315 +text \<open>In this subsection, we prove the Orbit-Stabilizer theorem.
   6.316 +      Our approach is to show the existence of a bijection between
   6.317 +      "rcosets (stabilizer G phi x)" and "orbit G phi x". Then we use
   6.318 +      Lagrange's theorem to find the cardinal of the first set.\<close>
   6.319 +
   6.320 +subsubsection \<open>Rcosets - Supporting Lemmas\<close>
   6.321 +
   6.322 +corollary (in group_action) stab_rcosets_not_empty:
   6.323 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   6.324 +  shows "R \<noteq> {}"
   6.325 +  using subgroup.rcosets_not_empty[OF stabilizer_subgroup[OF assms(1)] assms(2)] by simp
   6.326 +
   6.327 +corollary (in group_action) diff_stabilizes:
   6.328 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   6.329 +  shows "\<And>g1 g2. \<lbrakk> g1 \<in> R; g2 \<in> R \<rbrakk> \<Longrightarrow> g1 \<otimes> (inv g2) \<in> stabilizer G \<phi> x"
   6.330 +  using group.diff_neutralizes[of G "stabilizer G \<phi> x" R] stabilizer_subgroup[OF assms(1)]
   6.331 +        assms(2) group_hom group_hom.axioms(1) by blast
   6.332 +
   6.333 +
   6.334 +subsubsection \<open>Bijection Between Rcosets and an Orbit - Definition and Supporting Lemmas\<close>
   6.335 +
   6.336 +(* This definition could be easier if lcosets were available, and it's indeed a considerable
   6.337 +   modification at Coset theory, since we could derive it easily from the definition of rcosets
   6.338 +   following the same idea we use here: f: rcosets \<rightarrow> lcosets, s.t. f R = (\<lambda>g. inv g) ` R
   6.339 +   is a bijection. *)
   6.340 +
   6.341 +definition
   6.342 +  orb_stab_fun :: "[_, ('a \<Rightarrow> 'b \<Rightarrow> 'b), 'a set, 'b] \<Rightarrow> 'b"
   6.343 +  where "orb_stab_fun G \<phi> R x = (\<phi> (inv\<^bsub>G\<^esub> (SOME h. h \<in> R))) x"
   6.344 +
   6.345 +lemma (in group_action) orbit_stab_fun_is_well_defined0:
   6.346 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   6.347 +  shows "\<And>g1 g2. \<lbrakk> g1 \<in> R; g2 \<in> R \<rbrakk> \<Longrightarrow> (\<phi> (inv g1)) x = (\<phi> (inv g2)) x"
   6.348 +proof -
   6.349 +  fix g1 g2 assume g1: "g1 \<in> R" and g2: "g2 \<in> R"
   6.350 +  have R_carr: "R \<subseteq> carrier G"
   6.351 +    using subgroup.rcosets_carrier[OF stabilizer_subgroup[OF assms(1)]]
   6.352 +          assms(2) group_hom group_hom.axioms(1) by auto
   6.353 +  from R_carr have g1_carr: "g1 \<in> carrier G" using g1 by blast
   6.354 +  from R_carr have g2_carr: "g2 \<in> carrier G" using g2 by blast
   6.355 +
   6.356 +  have "g1 \<otimes> (inv g2) \<in> stabilizer G \<phi> x"
   6.357 +    using diff_stabilizes[of x R g1 g2] assms g1 g2 by blast
   6.358 +  hence "\<phi> (g1 \<otimes> (inv g2)) x = x"
   6.359 +    by (simp add: stabilizer_def)
   6.360 +  hence "(\<phi> (inv g1)) x = (\<phi> (inv g1)) (\<phi> (g1 \<otimes> (inv g2)) x)" by simp
   6.361 +  also have " ... = \<phi> ((inv g1) \<otimes> (g1 \<otimes> (inv g2))) x"
   6.362 +    using group_def assms(1) composition_rule g1_carr g2_carr
   6.363 +          group_hom group_hom.axioms(1) monoid.m_closed by fastforce
   6.364 +  also have " ... = \<phi> (((inv g1) \<otimes> g1) \<otimes> (inv g2)) x"
   6.365 +    using group_def g1_carr g2_carr group_hom group_hom.axioms(1) monoid.m_assoc by fastforce
   6.366 +  finally show "(\<phi> (inv g1)) x = (\<phi> (inv g2)) x"
   6.367 +    using group_def g1_carr g2_carr group.l_inv group_hom group_hom.axioms(1) by fastforce
   6.368 +qed
   6.369 +
   6.370 +lemma (in group_action) orbit_stab_fun_is_well_defined1:
   6.371 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   6.372 +  shows "\<And>g. g \<in> R \<Longrightarrow> (\<phi> (inv (SOME h. h \<in> R))) x = (\<phi> (inv g)) x"
   6.373 +  by (meson assms orbit_stab_fun_is_well_defined0 someI_ex)
   6.374 +
   6.375 +lemma (in group_action) orbit_stab_fun_is_inj:
   6.376 +  assumes "x \<in> E"
   6.377 +    and "R1 \<in> rcosets (stabilizer G \<phi> x)"
   6.378 +    and "R2 \<in> rcosets (stabilizer G \<phi> x)"
   6.379 +    and "\<phi> (inv (SOME h. h \<in> R1)) x = \<phi> (inv (SOME h. h \<in> R2)) x"
   6.380 +  shows "R1 = R2"
   6.381 +proof -
   6.382 +  have "(\<exists>g1. g1 \<in> R1) \<and> (\<exists>g2. g2 \<in> R2)"
   6.383 +    using assms(1-3) stab_rcosets_not_empty by auto
   6.384 +  then obtain g1 g2 where g1: "g1 \<in> R1" and g2: "g2 \<in> R2" by blast
   6.385 +  hence g12_carr: "g1 \<in> carrier G \<and> g2 \<in> carrier G"
   6.386 +    using subgroup.rcosets_carrier assms(1-3) group_hom
   6.387 +          group_hom.axioms(1) stabilizer_subgroup by blast
   6.388 +
   6.389 +  then obtain r1 r2 where r1: "r1 \<in> carrier G" "R1 = (stabilizer G \<phi> x) #> r1"
   6.390 +                      and r2: "r2 \<in> carrier G" "R2 = (stabilizer G \<phi> x) #> r2"
   6.391 +    using assms(1-3) unfolding RCOSETS_def by blast
   6.392 +  then obtain s1 s2 where s1: "s1 \<in> (stabilizer G \<phi> x)" "g1 = s1 \<otimes> r1"
   6.393 +                      and s2: "s2 \<in> (stabilizer G \<phi> x)" "g2 = s2 \<otimes> r2"
   6.394 +    using g1 g2 unfolding r_coset_def by blast
   6.395 +
   6.396 +  have "\<phi> (inv g1) x = \<phi> (inv (SOME h. h \<in> R1)) x"
   6.397 +    using orbit_stab_fun_is_well_defined1[OF assms(1) assms(2) g1] by simp
   6.398 +  also have " ... = \<phi> (inv (SOME h. h \<in> R2)) x"
   6.399 +    using assms(4) by simp
   6.400 +  finally have "\<phi> (inv g1) x = \<phi> (inv g2) x"
   6.401 +    using orbit_stab_fun_is_well_defined1[OF assms(1) assms(3) g2] by simp
   6.402 +
   6.403 +  hence "\<phi> g2 (\<phi> (inv g1) x) = \<phi> g2 (\<phi> (inv g2) x)" by simp
   6.404 +  also have " ... = \<phi> (g2 \<otimes> (inv g2)) x"
   6.405 +    using assms(1) composition_rule g12_carr group_hom group_hom.axioms(1) by fastforce
   6.406 +  finally have "\<phi> g2 (\<phi> (inv g1) x) = x"
   6.407 +    using g12_carr assms(1) group.r_inv group_hom group_hom.axioms(1)
   6.408 +          id_eq_one restrict_apply by metis
   6.409 +  hence "\<phi> (g2 \<otimes> (inv g1)) x = x"
   6.410 +    using assms(1) composition_rule g12_carr group_hom group_hom.axioms(1) by fastforce
   6.411 +  hence "g2 \<otimes> (inv g1) \<in> (stabilizer G \<phi> x)"
   6.412 +    using g12_carr group.subgroup_self group_hom group_hom.axioms(1)
   6.413 +          mem_Collect_eq stabilizer_def subgroup_def by (metis (mono_tags, lifting))
   6.414 +  then obtain s where s: "s \<in> (stabilizer G \<phi> x)" "s = g2 \<otimes> (inv g1)" by blast
   6.415 +
   6.416 +  let ?h = "s \<otimes> g1"
   6.417 +  have "?h = s \<otimes> (s1 \<otimes> r1)" by (simp add: s1)
   6.418 +  hence "?h = (s \<otimes> s1) \<otimes> r1"
   6.419 +    using stabilizer_subgroup[OF assms(1)] group_def group_hom
   6.420 +          group_hom.axioms(1) monoid.m_assoc r1 s s1 subgroup.mem_carrier by fastforce
   6.421 +  hence inR1: "?h \<in> (stabilizer G \<phi> x) #> r1" unfolding r_coset_def
   6.422 +    using stabilizer_subgroup[OF assms(1)] assms(1) s s1 stabilizer_m_closed by auto
   6.423 +
   6.424 +  have "?h = g2" using s stabilizer_subgroup[OF assms(1)] g12_carr group.inv_solve_right
   6.425 +                       group_hom group_hom.axioms(1) subgroup.mem_carrier by metis
   6.426 +  hence inR2: "?h \<in> (stabilizer G \<phi> x) #> r2"
   6.427 +    using g2 r2 by blast
   6.428 +
   6.429 +  have "R1 \<inter> R2 \<noteq> {}" using inR1 inR2 r1 r2 by blast
   6.430 +  thus ?thesis using stabilizer_subgroup group.rcos_disjoint[of G "stabilizer G \<phi> x" R1 R2]
   6.431 +                     assms group_hom group_hom.axioms(1) by blast
   6.432 +qed
   6.433 +
   6.434 +lemma (in group_action) orbit_stab_fun_is_surj:
   6.435 +  assumes "x \<in> E" "y \<in> orbit G \<phi> x"
   6.436 +  shows "\<exists>R \<in> rcosets (stabilizer G \<phi> x). \<phi> (inv (SOME h. h \<in> R)) x = y"
   6.437 +proof -
   6.438 +  have "\<exists>g \<in> carrier G. (\<phi> g) x = y"
   6.439 +    using assms(2) unfolding orbit_def by blast
   6.440 +  then obtain g where g: "g \<in> carrier G \<and> (\<phi> g) x = y" by blast
   6.441 +  
   6.442 +  let ?R = "(stabilizer G \<phi> x) #> (inv g)"
   6.443 +  have R: "?R \<in> rcosets (stabilizer G \<phi> x)"
   6.444 +    unfolding RCOSETS_def using g group_hom group_hom.axioms(1) by fastforce
   6.445 +  moreover have "\<one> \<otimes> (inv g) \<in> ?R"
   6.446 +    unfolding r_coset_def using assms(1) stabilizer_one_closed by auto
   6.447 +  ultimately have "\<phi> (inv (SOME h. h \<in> ?R)) x = \<phi> (inv (\<one> \<otimes> (inv g))) x"
   6.448 +    using orbit_stab_fun_is_well_defined1[OF assms(1)] by simp
   6.449 +  also have " ... = (\<phi> g) x"
   6.450 +    using group_def g group_hom group_hom.axioms(1) monoid.l_one by fastforce
   6.451 +  finally have "\<phi> (inv (SOME h. h \<in> ?R)) x = y"
   6.452 +    using g by simp
   6.453 +  thus ?thesis using R by blast 
   6.454 +qed
   6.455 +
   6.456 +proposition (in group_action) orbit_stab_fun_is_bij:
   6.457 +  assumes "x \<in> E"
   6.458 +  shows "bij_betw (\<lambda>R. (\<phi> (inv (SOME h. h \<in> R))) x) (rcosets (stabilizer G \<phi> x)) (orbit G \<phi> x)"
   6.459 +  unfolding bij_betw_def
   6.460 +proof
   6.461 +  show "inj_on (\<lambda>R. \<phi> (inv (SOME h. h \<in> R)) x) (rcosets stabilizer G \<phi> x)"
   6.462 +    using orbit_stab_fun_is_inj[OF assms(1)] by (simp add: inj_on_def)
   6.463 +next
   6.464 +  have "\<And>R. R \<in> (rcosets stabilizer G \<phi> x) \<Longrightarrow> \<phi> (inv (SOME h. h \<in> R)) x \<in> orbit G \<phi> x "
   6.465 +  proof -
   6.466 +    fix R assume R: "R \<in> (rcosets stabilizer G \<phi> x)"
   6.467 +    then obtain g where g: "g \<in> R"
   6.468 +      using assms stab_rcosets_not_empty by auto
   6.469 +    hence "\<phi> (inv (SOME h. h \<in> R)) x = \<phi> (inv g) x"
   6.470 +      using R  assms orbit_stab_fun_is_well_defined1 by blast
   6.471 +    thus "\<phi> (inv (SOME h. h \<in> R)) x \<in> orbit G \<phi> x" unfolding orbit_def
   6.472 +      using subgroup.rcosets_carrier group_hom group_hom.axioms(1)
   6.473 +            g R assms stabilizer_subgroup by fastforce
   6.474 +  qed
   6.475 +  moreover have "orbit G \<phi> x \<subseteq> (\<lambda>R. \<phi> (inv (SOME h. h \<in> R)) x) ` (rcosets stabilizer G \<phi> x)"
   6.476 +    using assms orbit_stab_fun_is_surj by fastforce
   6.477 +  ultimately show "(\<lambda>R. \<phi> (inv (SOME h. h \<in> R)) x) ` (rcosets stabilizer G \<phi> x) = orbit G \<phi> x "
   6.478 +    using assms set_eq_subset by blast
   6.479 +qed
   6.480 +
   6.481 +
   6.482 +subsubsection \<open>The Theorem\<close>
   6.483 +
   6.484 +theorem (in group_action) orbit_stabilizer_theorem:
   6.485 +  assumes "x \<in> E"
   6.486 +  shows "card (orbit G \<phi> x) * card (stabilizer G \<phi> x) = order G"
   6.487 +proof -
   6.488 +  have "card (rcosets stabilizer G \<phi> x) = card (orbit G \<phi> x)"
   6.489 +    using orbit_stab_fun_is_bij[OF assms(1)] bij_betw_same_card by blast
   6.490 +  moreover have "card (rcosets stabilizer G \<phi> x) * card (stabilizer G \<phi> x) = order G"
   6.491 +    using stabilizer_subgroup assms group.lagrange group_hom group_hom.axioms(1) by blast
   6.492 +  ultimately show ?thesis by auto
   6.493 +qed
   6.494 +
   6.495 +
   6.496 +
   6.497 +subsection \<open>The Burnside's Lemma\<close>
   6.498 +
   6.499 +subsubsection \<open>Sums and Cardinals\<close>
   6.500 +
   6.501 +lemma card_as_sums:
   6.502 +  assumes "A = {x \<in> B. P x}" "finite B"
   6.503 +  shows "card A = (\<Sum>x\<in>B. (if P x then 1 else 0))"
   6.504 +proof -
   6.505 +  have "A \<subseteq> B" using assms(1) by blast
   6.506 +  have "card A = (\<Sum>x\<in>A. 1)" by simp
   6.507 +  also have " ... = (\<Sum>x\<in>A. (if P x then 1 else 0))"
   6.508 +    by (simp add: assms(1))
   6.509 +  also have " ... = (\<Sum>x\<in>A. (if P x then 1 else 0)) + (\<Sum>x\<in>(B - A). (if P x then 1 else 0))"
   6.510 +    using assms(1) by auto
   6.511 +  finally show "card A = (\<Sum>x\<in>B. (if P x then 1 else 0))"
   6.512 +    using \<open>A \<subseteq> B\<close> add.commute assms(2) sum.subset_diff by metis
   6.513 +qed
   6.514 +
   6.515 +lemma sum_invertion:
   6.516 +  "\<lbrakk> finite A; finite B \<rbrakk> \<Longrightarrow> (\<Sum>x\<in>A. \<Sum>y\<in>B. f x y) = (\<Sum>y\<in>B. \<Sum>x\<in>A. f x y)"
   6.517 +proof (induct set: finite)
   6.518 +  case empty thus ?case by simp
   6.519 +next
   6.520 +  case (insert x A')
   6.521 +  have "(\<Sum>x\<in>insert x A'. \<Sum>y\<in>B. f x y) = (\<Sum>y\<in>B. f x y) + (\<Sum>x\<in>A'. \<Sum>y\<in>B. f x y)"
   6.522 +    by (simp add: insert.hyps)
   6.523 +  also have " ... = (\<Sum>y\<in>B. f x y) + (\<Sum>y\<in>B. \<Sum>x\<in>A'. f x y)"
   6.524 +    using insert.hyps by (simp add: insert.prems)
   6.525 +  also have " ... = (\<Sum>y\<in>B. (f x y) + (\<Sum>x\<in>A'. f x y))"
   6.526 +    by (simp add: sum.distrib)
   6.527 +  finally have "(\<Sum>x\<in>insert x A'. \<Sum>y\<in>B. f x y) = (\<Sum>y\<in>B. \<Sum>x\<in>insert x A'. f x y)"
   6.528 +    using sum.swap by blast
   6.529 +  thus ?case by simp
   6.530 +qed
   6.531 +
   6.532 +lemma (in group_action) card_stablizer_sum:
   6.533 +  assumes "finite (carrier G)" "orb \<in> (orbits G E \<phi>)"
   6.534 +  shows "(\<Sum>x \<in> orb. card (stabilizer G \<phi> x)) = order G"
   6.535 +proof -
   6.536 +  obtain x where x:"x \<in> E" and orb:"orb = orbit G \<phi> x"
   6.537 +    using assms(2) unfolding orbits_def by blast
   6.538 +  have "\<And>y. y \<in> orb \<Longrightarrow> card (stabilizer G \<phi> x) = card (stabilizer G \<phi> y)"
   6.539 +  proof -
   6.540 +    fix y assume "y \<in> orb"
   6.541 +    hence y: "y \<in> E \<and> y \<in> orbit G \<phi> x"
   6.542 +      using x orb assms(2) orbits_coverture by auto 
   6.543 +    hence same_orbit: "(orbit G \<phi> x) = (orbit G \<phi> y)"
   6.544 +      using disjoint_union[of "orbit G \<phi> x" "orbit G \<phi> y"] orbit_refl x
   6.545 +      unfolding orbits_def by auto
   6.546 +    have "card (orbit G \<phi> x) * card (stabilizer G \<phi> x) =
   6.547 +          card (orbit G \<phi> y) * card (stabilizer G \<phi> y)"
   6.548 +      using y assms(1) x orbit_stabilizer_theorem by simp
   6.549 +    hence "card (orbit G \<phi> x) * card (stabilizer G \<phi> x) =
   6.550 +           card (orbit G \<phi> x) * card (stabilizer G \<phi> y)" using same_orbit by simp
   6.551 +    moreover have "orbit G \<phi> x \<noteq> {} \<and> finite (orbit G \<phi> x)"
   6.552 +      using y orbit_def[of G \<phi> x] assms(1) by auto
   6.553 +    hence "card (orbit G \<phi> x) > 0"
   6.554 +      by (simp add: card_gt_0_iff)
   6.555 +    ultimately show "card (stabilizer G \<phi> x) = card (stabilizer G \<phi> y)" by auto
   6.556 +  qed
   6.557 +  hence "(\<Sum>x \<in> orb. card (stabilizer G \<phi> x)) = (\<Sum>y \<in> orb. card (stabilizer G \<phi> x))" by auto
   6.558 +  also have " ... = card (stabilizer G \<phi> x) * (\<Sum>y \<in> orb. 1)" by simp
   6.559 +  also have " ... = card (stabilizer G \<phi> x) * card (orbit G \<phi> x)"
   6.560 +    using orb by auto
   6.561 +  finally show "(\<Sum>x \<in> orb. card (stabilizer G \<phi> x)) = order G"
   6.562 +    by (metis mult.commute orbit_stabilizer_theorem x)
   6.563 +qed
   6.564 +
   6.565 +
   6.566 +subsubsection \<open>The Lemma\<close>
   6.567 +
   6.568 +theorem (in group_action) burnside:
   6.569 +  assumes "finite (carrier G)" "finite E"
   6.570 +  shows "card (orbits G E \<phi>) * order G = (\<Sum>g \<in> carrier G. card(invariants E \<phi> g))"
   6.571 +proof -
   6.572 +  have "(\<Sum>g \<in> carrier G. card(invariants E \<phi> g)) =
   6.573 +        (\<Sum>g \<in> carrier G. \<Sum>x \<in> E. (if (\<phi> g) x = x then 1 else 0))"
   6.574 +    by (simp add: assms(2) card_as_sums invariants_def)
   6.575 +  also have " ... = (\<Sum>x \<in> E. \<Sum>g \<in> carrier G. (if (\<phi> g) x = x then 1 else 0))"
   6.576 +    using sum_invertion[where ?f = "\<lambda> g x. (if (\<phi> g) x = x then 1 else 0)"] assms by auto
   6.577 +  also have " ... = (\<Sum>x \<in> E. card (stabilizer G \<phi> x))"
   6.578 +    by (simp add: assms(1) card_as_sums stabilizer_def)
   6.579 +  also have " ... = (\<Sum>orbit \<in> (orbits G E \<phi>). \<Sum>x \<in> orbit. card (stabilizer G \<phi> x))"
   6.580 +    using disjoint_sum orbits_coverture assms(2) by metis
   6.581 +  also have " ... = (\<Sum>orbit \<in> (orbits G E \<phi>). order G)"
   6.582 +    by (simp add: assms(1) card_stablizer_sum)
   6.583 +  finally have "(\<Sum>g \<in> carrier G. card(invariants E \<phi> g)) = card (orbits G E \<phi>) * order G" by simp
   6.584 +  thus ?thesis by simp
   6.585 +qed
   6.586 +
   6.587 +
   6.588 +
   6.589 +subsection \<open>Action by Conjugation\<close>
   6.590 +
   6.591 +
   6.592 +subsubsection \<open>Action Over Itself\<close>
   6.593 +
   6.594 +text \<open>A Group Acts by Conjugation Over Itself\<close>
   6.595 +
   6.596 +lemma (in group) conjugation_is_inj:
   6.597 +  assumes "g \<in> carrier G" "h1 \<in> carrier G" "h2 \<in> carrier G"
   6.598 +    and "g \<otimes> h1 \<otimes> (inv g) = g \<otimes> h2 \<otimes> (inv g)"
   6.599 +    shows "h1 = h2"
   6.600 +  using assms by auto
   6.601 +
   6.602 +lemma (in group) conjugation_is_surj:
   6.603 +  assumes "g \<in> carrier G" "h \<in> carrier G"
   6.604 +  shows "g \<otimes> ((inv g) \<otimes> h \<otimes> g) \<otimes> (inv g) = h"
   6.605 +  using assms m_assoc inv_closed inv_inv m_closed monoid_axioms r_inv r_one
   6.606 +  by metis
   6.607 +
   6.608 +lemma (in group) conjugation_is_bij:
   6.609 +  assumes "g \<in> carrier G"
   6.610 +  shows "bij_betw (\<lambda>h \<in> carrier G. g \<otimes> h \<otimes> (inv g)) (carrier G) (carrier G)"
   6.611 +         (is "bij_betw ?\<phi> (carrier G) (carrier G)")
   6.612 +  unfolding bij_betw_def
   6.613 +proof
   6.614 +  show "inj_on ?\<phi> (carrier G)"
   6.615 +    using conjugation_is_inj by (simp add: assms inj_on_def) 
   6.616 +next
   6.617 +  have S: "\<And> h. h \<in> carrier G \<Longrightarrow> (inv g) \<otimes> h \<otimes> g \<in> carrier G"
   6.618 +    using assms by blast
   6.619 +  have "\<And> h. h \<in> carrier G \<Longrightarrow> ?\<phi> ((inv g) \<otimes> h \<otimes> g) = h"
   6.620 +    using assms by (simp add: conjugation_is_surj)
   6.621 +  hence "carrier G \<subseteq> ?\<phi> ` carrier G"
   6.622 +    using S image_iff by fastforce
   6.623 +  moreover have "\<And> h. h \<in> carrier G \<Longrightarrow> ?\<phi> h \<in> carrier G"
   6.624 +    using assms by simp
   6.625 +  hence "?\<phi> ` carrier G \<subseteq> carrier G" by blast
   6.626 +  ultimately show "?\<phi> ` carrier G = carrier G" by blast
   6.627 +qed
   6.628 +
   6.629 +lemma(in group) conjugation_is_hom:
   6.630 +  "(\<lambda>g. \<lambda>h \<in> carrier G. g \<otimes> h \<otimes> inv g) \<in> hom G (BijGroup (carrier G))"
   6.631 +  unfolding hom_def
   6.632 +proof -
   6.633 +  let ?\<psi> = "\<lambda>g. \<lambda>h. g \<otimes> h \<otimes> inv g"
   6.634 +  let ?\<phi> = "\<lambda>g. restrict (?\<psi> g) (carrier G)"
   6.635 +
   6.636 +  (* First, we prove that ?\<phi>: G \<rightarrow> Bij(G) is well defined *)
   6.637 +  have Step0: "\<And> g. g \<in> carrier G \<Longrightarrow> (?\<phi> g) \<in> Bij (carrier G)"
   6.638 +    using Bij_def conjugation_is_bij by fastforce
   6.639 +  hence Step1: "?\<phi>: carrier G \<rightarrow> carrier (BijGroup (carrier G))"
   6.640 +    unfolding BijGroup_def by simp
   6.641 +
   6.642 +  (* Second, we prove that ?\<phi> is a homomorphism *)
   6.643 +  have "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.644 +                  (\<And> h. h \<in> carrier G \<Longrightarrow> ?\<psi> (g1 \<otimes> g2) h = (?\<phi> g1) ((?\<phi> g2) h))"
   6.645 +  proof -
   6.646 +    fix g1 g2 h assume g1: "g1 \<in> carrier G" and g2: "g2 \<in> carrier G" and h: "h \<in> carrier G"
   6.647 +    have "inv (g1 \<otimes> g2) = (inv g2) \<otimes> (inv g1)"
   6.648 +      using g1 g2 by (simp add: inv_mult_group)
   6.649 +    thus "?\<psi> (g1 \<otimes> g2) h  = (?\<phi> g1) ((?\<phi> g2) h)"
   6.650 +      by (simp add: g1 g2 h m_assoc)
   6.651 +  qed
   6.652 +  hence "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.653 +         (\<lambda> h \<in> carrier G. ?\<psi> (g1 \<otimes> g2) h) = (\<lambda> h \<in> carrier G. (?\<phi> g1) ((?\<phi> g2) h))" by auto
   6.654 +  hence Step2: "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.655 +                ?\<phi> (g1 \<otimes> g2) = (?\<phi> g1) \<otimes>\<^bsub>BijGroup (carrier G)\<^esub> (?\<phi> g2)"
   6.656 +    unfolding BijGroup_def by (simp add: Step0 compose_def)
   6.657 +
   6.658 +  (* Finally, we combine both results to prove the lemma *)
   6.659 +  thus "?\<phi> \<in> {h: carrier G \<rightarrow> carrier (BijGroup (carrier G)).
   6.660 +              (\<forall>x \<in> carrier G. \<forall>y \<in> carrier G. h (x \<otimes> y) = h x \<otimes>\<^bsub>BijGroup (carrier G)\<^esub> h y)}"
   6.661 +    using Step1 Step2 by auto
   6.662 +qed
   6.663 +
   6.664 +theorem (in group) action_by_conjugation:
   6.665 +  "group_action G (carrier G) (\<lambda>g. (\<lambda>h \<in> carrier G. g \<otimes> h \<otimes> (inv g)))"
   6.666 +  unfolding group_action_def group_hom_def using conjugation_is_hom
   6.667 +  by (simp add: group_BijGroup group_hom_axioms.intro is_group)
   6.668 +
   6.669 +
   6.670 +subsubsection \<open>Action Over The Set of Subgroups\<close>
   6.671 +
   6.672 +text \<open>A Group Acts by Conjugation Over The Set of Subgroups\<close>
   6.673 +
   6.674 +lemma (in group) subgroup_conjugation_is_inj_aux:
   6.675 +  assumes "g \<in> carrier G" "H1 \<subseteq> carrier G" "H2 \<subseteq> carrier G"
   6.676 +    and "g <# H1 #> (inv g) = g <# H2 #> (inv g)"
   6.677 +    shows "H1 \<subseteq> H2"
   6.678 +proof
   6.679 +  fix h1 assume h1: "h1 \<in> H1"
   6.680 +  hence "g \<otimes> h1 \<otimes> (inv g) \<in> g <# H1 #> (inv g)"
   6.681 +    unfolding l_coset_def r_coset_def using assms by blast
   6.682 +  hence "g \<otimes> h1 \<otimes> (inv g) \<in> g <# H2 #> (inv g)"
   6.683 +    using assms by auto
   6.684 +  hence "\<exists>h2 \<in> H2. g \<otimes> h1 \<otimes> (inv g) = g \<otimes> h2 \<otimes> (inv g)"
   6.685 +      unfolding l_coset_def r_coset_def by blast
   6.686 +  then obtain h2 where "h2 \<in> H2 \<and> g \<otimes> h1 \<otimes> (inv g) = g \<otimes> h2 \<otimes> (inv g)" by blast
   6.687 +  thus "h1 \<in> H2"
   6.688 +    using assms conjugation_is_inj h1 by blast
   6.689 +qed
   6.690 +
   6.691 +lemma (in group) subgroup_conjugation_is_inj:
   6.692 +  assumes "g \<in> carrier G" "H1 \<subseteq> carrier G" "H2 \<subseteq> carrier G"
   6.693 +    and "g <# H1 #> (inv g) = g <# H2 #> (inv g)"
   6.694 +    shows "H1 = H2"
   6.695 +  using subgroup_conjugation_is_inj_aux assms set_eq_subset by metis
   6.696 +
   6.697 +lemma (in group) subgroup_conjugation_is_surj0:
   6.698 +  assumes "g \<in> carrier G" "H \<subseteq> carrier G"
   6.699 +  shows "g <# ((inv g) <# H #> g) #> (inv g) = H"
   6.700 +  using coset_assoc assms coset_mult_assoc l_coset_subset_G lcos_m_assoc
   6.701 +  by (simp add: lcos_mult_one)
   6.702 +
   6.703 +lemma (in group) subgroup_conjugation_is_surj1:
   6.704 +  assumes "g \<in> carrier G" "subgroup H G"
   6.705 +  shows "subgroup ((inv g) <# H #> g) G"
   6.706 +proof
   6.707 +  show "\<one> \<in> inv g <# H #> g"
   6.708 +  proof -
   6.709 +    have "\<one> \<in> H" by (simp add: assms(2) subgroup.one_closed)
   6.710 +    hence "inv g \<otimes> \<one> \<otimes> g \<in> inv g <# H #> g"
   6.711 +      unfolding l_coset_def r_coset_def by blast
   6.712 +    thus "\<one> \<in> inv g <# H #> g" using assms by simp
   6.713 +  qed
   6.714 +next
   6.715 +  show "inv g <# H #> g \<subseteq> carrier G"
   6.716 +  proof
   6.717 +    fix x assume "x \<in> inv g <# H #> g"
   6.718 +    hence "\<exists>h \<in> H. x = (inv g) \<otimes> h \<otimes> g"
   6.719 +      unfolding r_coset_def l_coset_def by blast
   6.720 +    hence "\<exists>h \<in> (carrier G). x = (inv g) \<otimes> h \<otimes> g"
   6.721 +      by (meson assms subgroup.mem_carrier)
   6.722 +    thus "x \<in> carrier G" using assms by blast
   6.723 +  qed
   6.724 +next
   6.725 +  show " \<And> x y. \<lbrakk> x \<in> inv g <# H #> g; y \<in> inv g <# H #> g \<rbrakk> \<Longrightarrow> x \<otimes> y \<in> inv g <# H #> g"
   6.726 +  proof -
   6.727 +    fix x y assume "x \<in> inv g <# H #> g"  "y \<in> inv g <# H #> g"
   6.728 +    hence "\<exists> h1 \<in> H. \<exists> h2 \<in> H. x = (inv g) \<otimes> h1 \<otimes> g \<and> y = (inv g) \<otimes> h2 \<otimes> g"
   6.729 +      unfolding l_coset_def r_coset_def by blast
   6.730 +    hence "\<exists> h1 \<in> H. \<exists> h2 \<in> H. x \<otimes> y = ((inv g) \<otimes> h1 \<otimes> g) \<otimes> ((inv g) \<otimes> h2 \<otimes> g)" by blast
   6.731 +    hence "\<exists> h1 \<in> H. \<exists> h2 \<in> H. x \<otimes> y = ((inv g) \<otimes> (h1 \<otimes> h2) \<otimes> g)"
   6.732 +      using assms is_group inv_closed l_one m_assoc m_closed
   6.733 +            monoid_axioms r_inv subgroup.mem_carrier by smt
   6.734 +    hence "\<exists> h \<in> H. x \<otimes> y = (inv g) \<otimes> h \<otimes> g"
   6.735 +      by (meson assms(2) subgroup_def)
   6.736 +    thus "x \<otimes> y \<in> inv g <# H #> g"
   6.737 +      unfolding l_coset_def r_coset_def by blast
   6.738 +  qed
   6.739 +next
   6.740 +  show "\<And>x. x \<in> inv g <# H #> g \<Longrightarrow> inv x \<in> inv g <# H #> g"
   6.741 +  proof -
   6.742 +    fix x assume "x \<in> inv g <# H #> g"
   6.743 +    hence "\<exists>h \<in> H. x = (inv g) \<otimes> h \<otimes> g"
   6.744 +      unfolding r_coset_def l_coset_def by blast
   6.745 +    then obtain h where h: "h \<in> H \<and> x = (inv g) \<otimes> h \<otimes> g" by blast
   6.746 +    hence "x \<otimes> (inv g) \<otimes> (inv h) \<otimes> g = \<one>"
   6.747 +      using assms inv_closed m_assoc m_closed monoid_axioms
   6.748 +            r_inv r_one subgroup.mem_carrier by smt
   6.749 +    hence "inv x = (inv g) \<otimes> (inv h) \<otimes> g"
   6.750 +      using assms h inv_closed inv_inv inv_mult_group m_assoc
   6.751 +            m_closed monoid_axioms subgroup.mem_carrier by smt
   6.752 +    moreover have "inv h \<in> H"
   6.753 +      by (simp add: assms h subgroup.m_inv_closed)
   6.754 +    ultimately show "inv x \<in> inv g <# H #> g" unfolding r_coset_def l_coset_def by blast
   6.755 +  qed
   6.756 +qed
   6.757 +
   6.758 +lemma (in group) subgroup_conjugation_is_surj2:
   6.759 +  assumes "g \<in> carrier G" "subgroup H G"
   6.760 +  shows "subgroup (g <# H #> (inv g)) G"
   6.761 +  using subgroup_conjugation_is_surj1 by (metis assms inv_closed inv_inv)
   6.762 +
   6.763 +lemma (in group) subgroup_conjugation_is_bij:
   6.764 +  assumes "g \<in> carrier G"
   6.765 +  shows "bij_betw (\<lambda>H \<in> {H. subgroup H G}. g <# H #> (inv g)) {H. subgroup H G} {H. subgroup H G}"
   6.766 +         (is "bij_betw ?\<phi> {H. subgroup H G} {H. subgroup H G}")
   6.767 +  unfolding bij_betw_def
   6.768 +proof
   6.769 +  show "inj_on ?\<phi> {H. subgroup H G}"
   6.770 +    using subgroup_conjugation_is_inj assms inj_on_def subgroup.subset
   6.771 +    by (metis (mono_tags, lifting) inj_on_restrict_eq mem_Collect_eq)
   6.772 +next
   6.773 +  have "\<And>H. H \<in> {H. subgroup H G} \<Longrightarrow> ?\<phi> ((inv g) <# H #> g) = H"
   6.774 +    by (simp add: assms subgroup.subset subgroup_conjugation_is_surj0
   6.775 +                  subgroup_conjugation_is_surj1 is_group)
   6.776 +  hence "\<And>H. H \<in> {H. subgroup H G} \<Longrightarrow> \<exists>H' \<in> {H. subgroup H G}. ?\<phi> H' = H"
   6.777 +    using assms subgroup_conjugation_is_surj1 by fastforce
   6.778 +  thus "?\<phi> ` {H. subgroup H G} = {H. subgroup H G}"
   6.779 +    using subgroup_conjugation_is_surj2 assms by auto
   6.780 +qed
   6.781 +
   6.782 +lemma (in group) subgroup_conjugation_is_hom:
   6.783 +  "(\<lambda>g. \<lambda>H \<in> {H. subgroup H G}. g <# H #> (inv g)) \<in> hom G (BijGroup {H. subgroup H G})"
   6.784 +  unfolding hom_def
   6.785 +proof -
   6.786 +  (* We follow the exact same structure of conjugation_is_hom's proof *)
   6.787 +  let ?\<psi> = "\<lambda>g. \<lambda>H. g <# H #> (inv g)"
   6.788 +  let ?\<phi> = "\<lambda>g. restrict (?\<psi> g) {H. subgroup H G}"
   6.789 +
   6.790 +  have Step0: "\<And> g. g \<in> carrier G \<Longrightarrow> (?\<phi> g) \<in> Bij {H. subgroup H G}"
   6.791 +    using Bij_def subgroup_conjugation_is_bij by fastforce
   6.792 +  hence Step1: "?\<phi>: carrier G \<rightarrow> carrier (BijGroup {H. subgroup H G})"
   6.793 +    unfolding BijGroup_def by simp
   6.794 +
   6.795 +  have "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.796 +                  (\<And> H. H \<in> {H. subgroup H G} \<Longrightarrow> ?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H))"
   6.797 +  proof -
   6.798 +    fix g1 g2 H assume g1: "g1 \<in> carrier G" and g2: "g2 \<in> carrier G" and H': "H \<in> {H. subgroup H G}"
   6.799 +    hence H: "subgroup H G" by simp
   6.800 +    have "(?\<phi> g1) ((?\<phi> g2) H) = g1 <# (g2 <# H #> (inv g2)) #> (inv g1)"
   6.801 +      by (simp add: H g2 subgroup_conjugation_is_surj2)
   6.802 +    also have " ... = g1 <# (g2 <# H) #> ((inv g2) \<otimes> (inv g1))"
   6.803 +      by (simp add: H coset_mult_assoc g1 g2 group.coset_assoc
   6.804 +                    is_group l_coset_subset_G subgroup.subset)
   6.805 +    also have " ... = g1 <# (g2 <# H) #> inv (g1 \<otimes> g2)"
   6.806 +      using g1 g2 by (simp add: inv_mult_group)
   6.807 +    finally have "(?\<phi> g1) ((?\<phi> g2) H) = ?\<psi> (g1 \<otimes> g2) H"
   6.808 +      by (simp add: H g1 g2 lcos_m_assoc subgroup.subset)
   6.809 +    thus "?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H)" by auto
   6.810 +  qed
   6.811 +  hence "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.812 +         (\<lambda>H \<in> {H. subgroup H G}. ?\<psi> (g1 \<otimes> g2) H) = (\<lambda>H \<in> {H. subgroup H G}. (?\<phi> g1) ((?\<phi> g2) H))"
   6.813 +    by (meson restrict_ext)
   6.814 +  hence Step2: "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.815 +                ?\<phi> (g1 \<otimes> g2) = (?\<phi> g1) \<otimes>\<^bsub>BijGroup {H. subgroup H G}\<^esub> (?\<phi> g2)"
   6.816 +    unfolding BijGroup_def by (simp add: Step0 compose_def)
   6.817 +
   6.818 +  show "?\<phi> \<in> {h: carrier G \<rightarrow> carrier (BijGroup {H. subgroup H G}).
   6.819 +              \<forall>x\<in>carrier G. \<forall>y\<in>carrier G. h (x \<otimes> y) = h x \<otimes>\<^bsub>BijGroup {H. subgroup H G}\<^esub> h y}"
   6.820 +    using Step1 Step2 by auto
   6.821 +qed
   6.822 +
   6.823 +theorem (in group) action_by_conjugation_on_subgroups_set:
   6.824 +  "group_action G {H. subgroup H G} (\<lambda>g. \<lambda>H \<in> {H. subgroup H G}. g <# H #> (inv g))"
   6.825 +  unfolding group_action_def group_hom_def using subgroup_conjugation_is_hom
   6.826 +  by (simp add: group_BijGroup group_hom_axioms.intro is_group)
   6.827 +
   6.828 +
   6.829 +subsubsection \<open>Action Over The Power Set\<close>
   6.830 +
   6.831 +text \<open>A Group Acts by Conjugation Over The Power Set\<close>
   6.832 +
   6.833 +lemma (in group) subset_conjugation_is_bij:
   6.834 +  assumes "g \<in> carrier G"
   6.835 +  shows "bij_betw (\<lambda>H \<in> {H. H \<subseteq> carrier G}. g <# H #> (inv g)) {H. H \<subseteq> carrier G} {H. H \<subseteq> carrier G}"
   6.836 +         (is "bij_betw ?\<phi> {H. H \<subseteq> carrier G} {H. H \<subseteq> carrier G}")
   6.837 +  unfolding bij_betw_def
   6.838 +proof
   6.839 +  show "inj_on ?\<phi> {H. H \<subseteq> carrier G}"
   6.840 +    using subgroup_conjugation_is_inj assms inj_on_def
   6.841 +    by (metis (mono_tags, lifting) inj_on_restrict_eq mem_Collect_eq)
   6.842 +next
   6.843 +  have "\<And>H. H \<in> {H. H \<subseteq> carrier G} \<Longrightarrow> ?\<phi> ((inv g) <# H #> g) = H"
   6.844 +    by (simp add: assms l_coset_subset_G r_coset_subset_G subgroup_conjugation_is_surj0)
   6.845 +  hence "\<And>H. H \<in> {H. H \<subseteq> carrier G} \<Longrightarrow> \<exists>H' \<in> {H. H \<subseteq> carrier G}. ?\<phi> H' = H"
   6.846 +    by (metis assms l_coset_subset_G mem_Collect_eq r_coset_subset_G subgroup_def subgroup_self)
   6.847 +  hence "{H. H \<subseteq> carrier G} \<subseteq> ?\<phi> ` {H. H \<subseteq> carrier G}" by blast
   6.848 +  moreover have "?\<phi> ` {H. H \<subseteq> carrier G} \<subseteq> {H. H \<subseteq> carrier G}"
   6.849 +    by (smt assms image_subsetI inv_closed l_coset_subset_G
   6.850 +            mem_Collect_eq r_coset_subset_G restrict_apply')
   6.851 +  ultimately show "?\<phi> ` {H. H \<subseteq> carrier G} = {H. H \<subseteq> carrier G}" by simp
   6.852 +qed
   6.853 +
   6.854 +lemma (in group) subset_conjugation_is_hom:
   6.855 +  "(\<lambda>g. \<lambda>H \<in> {H. H \<subseteq> carrier G}. g <# H #> (inv g)) \<in> hom G (BijGroup {H. H \<subseteq> carrier G})"
   6.856 +  unfolding hom_def
   6.857 +proof -
   6.858 +  (* We follow the exact same structure of conjugation_is_hom's proof *)
   6.859 +  let ?\<psi> = "\<lambda>g. \<lambda>H. g <# H #> (inv g)"
   6.860 +  let ?\<phi> = "\<lambda>g. restrict (?\<psi> g) {H. H \<subseteq> carrier G}"
   6.861 +
   6.862 +  have Step0: "\<And> g. g \<in> carrier G \<Longrightarrow> (?\<phi> g) \<in> Bij {H. H \<subseteq> carrier G}"
   6.863 +    using Bij_def subset_conjugation_is_bij by fastforce
   6.864 +  hence Step1: "?\<phi>: carrier G \<rightarrow> carrier (BijGroup {H. H \<subseteq> carrier G})"
   6.865 +    unfolding BijGroup_def by simp
   6.866 +
   6.867 +  have "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.868 +                  (\<And> H. H \<in> {H. H \<subseteq> carrier G} \<Longrightarrow> ?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H))"
   6.869 +  proof -
   6.870 +    fix g1 g2 H assume g1: "g1 \<in> carrier G" and g2: "g2 \<in> carrier G" and H: "H \<in> {H. H \<subseteq> carrier G}"
   6.871 +    hence "(?\<phi> g1) ((?\<phi> g2) H) = g1 <# (g2 <# H #> (inv g2)) #> (inv g1)"
   6.872 +      using l_coset_subset_G r_coset_subset_G by auto
   6.873 +    also have " ... = g1 <# (g2 <# H) #> ((inv g2) \<otimes> (inv g1))"
   6.874 +      using H coset_assoc coset_mult_assoc g1 g2 l_coset_subset_G by auto
   6.875 +    also have " ... = g1 <# (g2 <# H) #> inv (g1 \<otimes> g2)"
   6.876 +      using g1 g2 by (simp add: inv_mult_group)
   6.877 +    finally have "(?\<phi> g1) ((?\<phi> g2) H) = ?\<psi> (g1 \<otimes> g2) H"
   6.878 +      using H g1 g2 lcos_m_assoc by force
   6.879 +    thus "?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H)" by auto
   6.880 +  qed
   6.881 +  hence "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.882 +         (\<lambda>H \<in> {H. H \<subseteq> carrier G}. ?\<psi> (g1 \<otimes> g2) H) = (\<lambda>H \<in> {H. H \<subseteq> carrier G}. (?\<phi> g1) ((?\<phi> g2) H))"
   6.883 +    by (meson restrict_ext)
   6.884 +  hence Step2: "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   6.885 +                ?\<phi> (g1 \<otimes> g2) = (?\<phi> g1) \<otimes>\<^bsub>BijGroup {H. H \<subseteq> carrier G}\<^esub> (?\<phi> g2)"
   6.886 +    unfolding BijGroup_def by (simp add: Step0 compose_def)
   6.887 +
   6.888 +  show "?\<phi> \<in> {h: carrier G \<rightarrow> carrier (BijGroup {H. H \<subseteq> carrier G}).
   6.889 +              \<forall>x\<in>carrier G. \<forall>y\<in>carrier G. h (x \<otimes> y) = h x \<otimes>\<^bsub>BijGroup {H. H \<subseteq> carrier G}\<^esub> h y}"
   6.890 +    using Step1 Step2 by auto
   6.891 +qed
   6.892 +
   6.893 +theorem (in group) action_by_conjugation_on_power_set:
   6.894 +  "group_action G {H. H \<subseteq> carrier G} (\<lambda>g. \<lambda>H \<in> {H. H \<subseteq> carrier G}. g <# H #> (inv g))"
   6.895 +  unfolding group_action_def group_hom_def using subset_conjugation_is_hom
   6.896 +  by (simp add: group_BijGroup group_hom_axioms.intro is_group)
   6.897 +
   6.898 +corollary (in group) normalizer_imp_subgroup:
   6.899 +  assumes "H \<subseteq> carrier G"
   6.900 +  shows "subgroup (normalizer G H) G"
   6.901 +  unfolding normalizer_def
   6.902 +  using group_action.stabilizer_subgroup[OF action_by_conjugation_on_power_set] assms by auto
   6.903 +
   6.904 +
   6.905 +subsection \<open>Subgroup of an Acting Group\<close>
   6.906 +
   6.907 +text \<open>A Subgroup of an Acting Group Induces an Action\<close>
   6.908 +
   6.909 +lemma (in group_action) induced_homomorphism:
   6.910 +  assumes "subgroup H G"
   6.911 +  shows "\<phi> \<in> hom (G \<lparr>carrier := H\<rparr>) (BijGroup E)"
   6.912 +  unfolding hom_def apply simp
   6.913 +proof -
   6.914 +  have S0: "H \<subseteq> carrier G" by (meson assms subgroup_def)
   6.915 +  hence "\<phi>: H \<rightarrow> carrier (BijGroup E)"
   6.916 +    by (simp add: BijGroup_def bij_prop0 subset_eq)
   6.917 +  thus "\<phi>: H \<rightarrow> carrier (BijGroup E) \<and> (\<forall>x \<in> H. \<forall>y \<in> H. \<phi> (x \<otimes> y) = \<phi> x \<otimes>\<^bsub>BijGroup E\<^esub> \<phi> y)"
   6.918 +    by (simp add: S0  group_hom group_hom.hom_mult set_rev_mp)
   6.919 +qed
   6.920 +
   6.921 +theorem (in group_action) induced_action:
   6.922 +  assumes "subgroup H G"
   6.923 +  shows "group_action (G \<lparr>carrier := H\<rparr>) E \<phi>"
   6.924 +  unfolding group_action_def group_hom_def
   6.925 +  using induced_homomorphism assms group.subgroup_imp_group group_BijGroup
   6.926 +        group_hom group_hom.axioms(1) group_hom_axioms_def by blast
   6.927 +
   6.928 +end
   6.929 \ No newline at end of file
     7.1 --- a/src/HOL/Algebra/Ideal.thy	Thu Jun 14 15:45:53 2018 +0200
     7.2 +++ b/src/HOL/Algebra/Ideal.thy	Thu Jun 14 15:20:20 2018 +0100
     7.3 @@ -14,7 +14,7 @@
     7.4  
     7.5  locale ideal = additive_subgroup I R + ring R for I and R (structure) +
     7.6    assumes I_l_closed: "\<lbrakk>a \<in> I; x \<in> carrier R\<rbrakk> \<Longrightarrow> x \<otimes> a \<in> I"
     7.7 -    and I_r_closed: "\<lbrakk>a \<in> I; x \<in> carrier R\<rbrakk> \<Longrightarrow> a \<otimes> x \<in> I"
     7.8 +      and I_r_closed: "\<lbrakk>a \<in> I; x \<in> carrier R\<rbrakk> \<Longrightarrow> a \<otimes> x \<in> I"
     7.9  
    7.10  sublocale ideal \<subseteq> abelian_subgroup I R
    7.11    apply (intro abelian_subgroupI3 abelian_group.intro)
    7.12 @@ -29,7 +29,7 @@
    7.13  lemma idealI:
    7.14    fixes R (structure)
    7.15    assumes "ring R"
    7.16 -  assumes a_subgroup: "subgroup I \<lparr>carrier = carrier R, mult = add R, one = zero R\<rparr>"
    7.17 +  assumes a_subgroup: "subgroup I (add_monoid R)"
    7.18      and I_l_closed: "\<And>a x. \<lbrakk>a \<in> I; x \<in> carrier R\<rbrakk> \<Longrightarrow> x \<otimes> a \<in> I"
    7.19      and I_r_closed: "\<And>a x. \<lbrakk>a \<in> I; x \<in> carrier R\<rbrakk> \<Longrightarrow> a \<otimes> x \<in> I"
    7.20    shows "ideal I R"
    7.21 @@ -74,7 +74,7 @@
    7.22  
    7.23  locale maximalideal = ideal +
    7.24    assumes I_notcarr: "carrier R \<noteq> I"
    7.25 -    and I_maximal: "\<lbrakk>ideal J R; I \<subseteq> J; J \<subseteq> carrier R\<rbrakk> \<Longrightarrow> J = I \<or> J = carrier R"
    7.26 +    and I_maximal: "\<lbrakk>ideal J R; I \<subseteq> J; J \<subseteq> carrier R\<rbrakk> \<Longrightarrow> (J = I) \<or> (J = carrier R)"
    7.27  
    7.28  lemma (in maximalideal) is_maximalideal: "maximalideal I R"
    7.29    by (rule maximalideal_axioms)
    7.30 @@ -83,7 +83,7 @@
    7.31    fixes R
    7.32    assumes "ideal I R"
    7.33      and I_notcarr: "carrier R \<noteq> I"
    7.34 -    and I_maximal: "\<And>J. \<lbrakk>ideal J R; I \<subseteq> J; J \<subseteq> carrier R\<rbrakk> \<Longrightarrow> J = I \<or> J = carrier R"
    7.35 +    and I_maximal: "\<And>J. \<lbrakk>ideal J R; I \<subseteq> J; J \<subseteq> carrier R\<rbrakk> \<Longrightarrow> (J = I) \<or> (J = carrier R)"
    7.36    shows "maximalideal I R"
    7.37  proof -
    7.38    interpret ideal I R by fact
    7.39 @@ -143,26 +143,17 @@
    7.40  subsection \<open>Special Ideals\<close>
    7.41  
    7.42  lemma (in ring) zeroideal: "ideal {\<zero>} R"
    7.43 -  apply (intro idealI subgroup.intro)
    7.44 -        apply (rule is_ring)
    7.45 -       apply simp+
    7.46 -    apply (fold a_inv_def, simp)
    7.47 -   apply simp+
    7.48 -  done
    7.49 +  by (intro idealI subgroup.intro) (simp_all add: is_ring)
    7.50  
    7.51  lemma (in ring) oneideal: "ideal (carrier R) R"
    7.52    by (rule idealI) (auto intro: is_ring add.subgroupI)
    7.53  
    7.54  lemma (in "domain") zeroprimeideal: "primeideal {\<zero>} R"
    7.55 -  apply (intro primeidealI)
    7.56 -     apply (rule zeroideal)
    7.57 -    apply (rule domain.axioms, rule domain_axioms)
    7.58 -   defer 1
    7.59 -   apply (simp add: integral)
    7.60 -proof (rule ccontr, simp)
    7.61 -  assume "carrier R = {\<zero>}"
    7.62 -  then have "\<one> = \<zero>" by (rule one_zeroI)
    7.63 -  with one_not_zero show False by simp
    7.64 +proof -
    7.65 +  have "carrier R \<noteq> {\<zero>}"
    7.66 +    by (simp add: carrier_one_not_zero)
    7.67 +  then show ?thesis
    7.68 +    by (metis (no_types, lifting) domain_axioms domain_def integral primeidealI singleton_iff zeroideal)
    7.69  qed
    7.70  
    7.71  
    7.72 @@ -651,6 +642,46 @@
    7.73  qed
    7.74  
    7.75  
    7.76 +(* Next lemma contributed by Paulo Emílio de Vilhena. *)
    7.77 +
    7.78 +text \<open>This next lemma would be trivial if placed in a theory that imports QuotRing,
    7.79 +      but it makes more sense to have it here (easier to find and coherent with the
    7.80 +      previous developments).\<close>
    7.81 +
    7.82 +lemma (in cring) cgenideal_prod:
    7.83 +  assumes "a \<in> carrier R" "b \<in> carrier R"
    7.84 +  shows "(PIdl a) <#> (PIdl b) = PIdl (a \<otimes> b)"
    7.85 +proof -
    7.86 +  have "(carrier R #> a) <#> (carrier R #> b) = carrier R #> (a \<otimes> b)"
    7.87 +  proof
    7.88 +    show "(carrier R #> a) <#> (carrier R #> b) \<subseteq> carrier R #> a \<otimes> b"
    7.89 +    proof
    7.90 +      fix x assume "x \<in> (carrier R #> a) <#> (carrier R #> b)"
    7.91 +      then obtain r1 r2 where r1: "r1 \<in> carrier R" and r2: "r2 \<in> carrier R"
    7.92 +                          and "x = (r1 \<otimes> a) \<otimes> (r2 \<otimes> b)"
    7.93 +        unfolding set_mult_def r_coset_def by blast
    7.94 +      hence "x = (r1 \<otimes> r2) \<otimes> (a \<otimes> b)"
    7.95 +        by (simp add: assms local.ring_axioms m_lcomm ring.ring_simprules(11))
    7.96 +      thus "x \<in> carrier R #> a \<otimes> b"
    7.97 +        unfolding r_coset_def using r1 r2 assms by blast 
    7.98 +    qed
    7.99 +  next
   7.100 +    show "carrier R #> a \<otimes> b \<subseteq> (carrier R #> a) <#> (carrier R #> b)"
   7.101 +    proof
   7.102 +      fix x assume "x \<in> carrier R #> a \<otimes> b"
   7.103 +      then obtain r where r: "r \<in> carrier R" "x = r \<otimes> (a \<otimes> b)"
   7.104 +        unfolding r_coset_def by blast
   7.105 +      hence "x = (r \<otimes> a) \<otimes> (\<one> \<otimes> b)"
   7.106 +        using assms by (simp add: m_assoc)
   7.107 +      thus "x \<in> (carrier R #> a) <#> (carrier R #> b)"
   7.108 +        unfolding set_mult_def r_coset_def using assms r by blast
   7.109 +    qed
   7.110 +  qed
   7.111 +  thus ?thesis
   7.112 +    using cgenideal_eq_rcos[of a] cgenideal_eq_rcos[of b] cgenideal_eq_rcos[of "a \<otimes> b"] by simp
   7.113 +qed
   7.114 +
   7.115 +
   7.116  subsection \<open>Prime Ideals\<close>
   7.117  
   7.118  lemma (in ideal) primeidealCD:
   7.119 @@ -708,10 +739,7 @@
   7.120  qed
   7.121  
   7.122  corollary (in cring) domain_eq_zeroprimeideal: "domain R = primeideal {\<zero>} R"
   7.123 -  apply rule
   7.124 -   apply (erule domain.zeroprimeideal)
   7.125 -  apply (erule zeroprimeideal_domainI)
   7.126 -  done
   7.127 +  using domain.zeroprimeideal zeroprimeideal_domainI by blast
   7.128  
   7.129  
   7.130  subsection \<open>Maximal Ideals\<close>
   7.131 @@ -921,7 +949,7 @@
   7.132    qed
   7.133  qed (simp add: zeroideal oneideal)
   7.134  
   7.135 -\<comment> \<open>Jacobson Theorem 2.2\<close>
   7.136 +\<comment>\<open>"Jacobson Theorem 2.2"\<close>
   7.137  lemma (in cring) trivialideals_eq_field:
   7.138    assumes carrnzero: "carrier R \<noteq> {\<zero>}"
   7.139    shows "({I. ideal I R} = {{\<zero>}, carrier R}) = field R"
   7.140 @@ -963,9 +991,6 @@
   7.141  qed
   7.142  
   7.143  lemma (in cring) zeromaximalideal_eq_field: "maximalideal {\<zero>} R = field R"
   7.144 -  apply rule
   7.145 -   apply (erule zeromaximalideal_fieldI)
   7.146 -  apply (erule field.zeromaximalideal)
   7.147 -  done
   7.148 +  using field.zeromaximalideal zeromaximalideal_fieldI by blast
   7.149  
   7.150  end
     8.1 --- a/src/HOL/Algebra/More_Finite_Product.thy	Thu Jun 14 15:45:53 2018 +0200
     8.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.3 @@ -1,102 +0,0 @@
     8.4 -(*  Title:      HOL/Algebra/More_Finite_Product.thy
     8.5 -    Author:     Jeremy Avigad
     8.6 -*)
     8.7 -
     8.8 -section \<open>More on finite products\<close>
     8.9 -
    8.10 -theory More_Finite_Product
    8.11 -  imports More_Group
    8.12 -begin
    8.13 -
    8.14 -lemma (in comm_monoid) finprod_UN_disjoint:
    8.15 -  "finite I \<Longrightarrow> (\<forall>i\<in>I. finite (A i)) \<longrightarrow> (\<forall>i\<in>I. \<forall>j\<in>I. i \<noteq> j \<longrightarrow> A i \<inter> A j = {}) \<longrightarrow>
    8.16 -    (\<forall>i\<in>I. \<forall>x \<in> A i. g x \<in> carrier G) \<longrightarrow>
    8.17 -    finprod G g (UNION I A) = finprod G (\<lambda>i. finprod G g (A i)) I"
    8.18 -  apply (induct set: finite)
    8.19 -   apply force
    8.20 -  apply clarsimp
    8.21 -  apply (subst finprod_Un_disjoint)
    8.22 -       apply blast
    8.23 -      apply (erule finite_UN_I)
    8.24 -      apply blast
    8.25 -     apply (fastforce)
    8.26 -    apply (auto intro!: funcsetI finprod_closed)
    8.27 -  done
    8.28 -
    8.29 -lemma (in comm_monoid) finprod_Union_disjoint:
    8.30 -  "finite C \<Longrightarrow>
    8.31 -    \<forall>A\<in>C. finite A \<and> (\<forall>x\<in>A. f x \<in> carrier G) \<Longrightarrow>
    8.32 -    \<forall>A\<in>C. \<forall>B\<in>C. A \<noteq> B \<longrightarrow> A \<inter> B = {} \<Longrightarrow>
    8.33 -    finprod G f (\<Union>C) = finprod G (finprod G f) C"
    8.34 -  apply (frule finprod_UN_disjoint [of C id f])
    8.35 -  apply auto
    8.36 -  done
    8.37 -
    8.38 -lemma (in comm_monoid) finprod_one: "finite A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> f x = \<one>) \<Longrightarrow> finprod G f A = \<one>"
    8.39 -  by (induct set: finite) auto
    8.40 -
    8.41 -
    8.42 -(* need better simplification rules for rings *)
    8.43 -(* the next one holds more generally for abelian groups *)
    8.44 -
    8.45 -lemma (in cring) sum_zero_eq_neg: "x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> x \<oplus> y = \<zero> \<Longrightarrow> x = \<ominus> y"
    8.46 -  by (metis minus_equality)
    8.47 -
    8.48 -lemma (in domain) square_eq_one:
    8.49 -  fixes x
    8.50 -  assumes [simp]: "x \<in> carrier R"
    8.51 -    and "x \<otimes> x = \<one>"
    8.52 -  shows "x = \<one> \<or> x = \<ominus>\<one>"
    8.53 -proof -
    8.54 -  have "(x \<oplus> \<one>) \<otimes> (x \<oplus> \<ominus> \<one>) = x \<otimes> x \<oplus> \<ominus> \<one>"
    8.55 -    by (simp add: ring_simprules)
    8.56 -  also from \<open>x \<otimes> x = \<one>\<close> have "\<dots> = \<zero>"
    8.57 -    by (simp add: ring_simprules)
    8.58 -  finally have "(x \<oplus> \<one>) \<otimes> (x \<oplus> \<ominus> \<one>) = \<zero>" .
    8.59 -  then have "(x \<oplus> \<one>) = \<zero> \<or> (x \<oplus> \<ominus> \<one>) = \<zero>"
    8.60 -    by (intro integral) auto
    8.61 -  then show ?thesis
    8.62 -    apply auto
    8.63 -     apply (erule notE)
    8.64 -     apply (rule sum_zero_eq_neg)
    8.65 -       apply auto
    8.66 -    apply (subgoal_tac "x = \<ominus> (\<ominus> \<one>)")
    8.67 -     apply (simp add: ring_simprules)
    8.68 -    apply (rule sum_zero_eq_neg)
    8.69 -      apply auto
    8.70 -    done
    8.71 -qed
    8.72 -
    8.73 -lemma (in domain) inv_eq_self: "x \<in> Units R \<Longrightarrow> x = inv x \<Longrightarrow> x = \<one> \<or> x = \<ominus>\<one>"
    8.74 -  by (metis Units_closed Units_l_inv square_eq_one)
    8.75 -
    8.76 -
    8.77 -text \<open>
    8.78 -  The following translates theorems about groups to the facts about
    8.79 -  the units of a ring. (The list should be expanded as more things are
    8.80 -  needed.)
    8.81 -\<close>
    8.82 -
    8.83 -lemma (in ring) finite_ring_finite_units [intro]: "finite (carrier R) \<Longrightarrow> finite (Units R)"
    8.84 -  by (rule finite_subset) auto
    8.85 -
    8.86 -lemma (in monoid) units_of_pow:
    8.87 -  fixes n :: nat
    8.88 -  shows "x \<in> Units G \<Longrightarrow> x [^]\<^bsub>units_of G\<^esub> n = x [^]\<^bsub>G\<^esub> n"
    8.89 -  apply (induct n)
    8.90 -  apply (auto simp add: units_group group.is_monoid
    8.91 -    monoid.nat_pow_0 monoid.nat_pow_Suc units_of_one units_of_mult)
    8.92 -  done
    8.93 -
    8.94 -lemma (in cring) units_power_order_eq_one:
    8.95 -  "finite (Units R) \<Longrightarrow> a \<in> Units R \<Longrightarrow> a [^] card(Units R) = \<one>"
    8.96 -  apply (subst units_of_carrier [symmetric])
    8.97 -  apply (subst units_of_one [symmetric])
    8.98 -  apply (subst units_of_pow [symmetric])
    8.99 -   apply assumption
   8.100 -  apply (rule comm_group.power_order_eq_one)
   8.101 -    apply (rule units_comm_group)
   8.102 -   apply (unfold units_of_def, auto)
   8.103 -  done
   8.104 -
   8.105 -end
     9.1 --- a/src/HOL/Algebra/More_Group.thy	Thu Jun 14 15:45:53 2018 +0200
     9.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.3 @@ -1,115 +0,0 @@
     9.4 -(*  Title:      HOL/Algebra/More_Group.thy
     9.5 -    Author:     Jeremy Avigad
     9.6 -*)
     9.7 -
     9.8 -section \<open>More on groups\<close>
     9.9 -
    9.10 -theory More_Group
    9.11 -  imports Ring
    9.12 -begin
    9.13 -
    9.14 -text \<open>
    9.15 -  Show that the units in any monoid give rise to a group.
    9.16 -
    9.17 -  The file Residues.thy provides some infrastructure to use
    9.18 -  facts about the unit group within the ring locale.
    9.19 -\<close>
    9.20 -
    9.21 -definition units_of :: "('a, 'b) monoid_scheme \<Rightarrow> 'a monoid"
    9.22 -  where "units_of G =
    9.23 -    \<lparr>carrier = Units G, Group.monoid.mult = Group.monoid.mult G, one  = one G\<rparr>"
    9.24 -
    9.25 -lemma (in monoid) units_group: "group (units_of G)"
    9.26 -  apply (unfold units_of_def)
    9.27 -  apply (rule groupI)
    9.28 -      apply auto
    9.29 -   apply (subst m_assoc)
    9.30 -      apply auto
    9.31 -  apply (rule_tac x = "inv x" in bexI)
    9.32 -   apply auto
    9.33 -  done
    9.34 -
    9.35 -lemma (in comm_monoid) units_comm_group: "comm_group (units_of G)"
    9.36 -  apply (rule group.group_comm_groupI)
    9.37 -   apply (rule units_group)
    9.38 -  apply (insert comm_monoid_axioms)
    9.39 -  apply (unfold units_of_def Units_def comm_monoid_def comm_monoid_axioms_def)
    9.40 -  apply auto
    9.41 -  done
    9.42 -
    9.43 -lemma units_of_carrier: "carrier (units_of G) = Units G"
    9.44 -  by (auto simp: units_of_def)
    9.45 -
    9.46 -lemma units_of_mult: "mult (units_of G) = mult G"
    9.47 -  by (auto simp: units_of_def)
    9.48 -
    9.49 -lemma units_of_one: "one (units_of G) = one G"
    9.50 -  by (auto simp: units_of_def)
    9.51 -
    9.52 -lemma (in monoid) units_of_inv: "x \<in> Units G \<Longrightarrow> m_inv (units_of G) x = m_inv G x"
    9.53 -  apply (rule sym)
    9.54 -  apply (subst m_inv_def)
    9.55 -  apply (rule the1_equality)
    9.56 -   apply (rule ex_ex1I)
    9.57 -    apply (subst (asm) Units_def)
    9.58 -    apply auto
    9.59 -     apply (erule inv_unique)
    9.60 -        apply auto
    9.61 -    apply (rule Units_closed)
    9.62 -    apply (simp_all only: units_of_carrier [symmetric])
    9.63 -    apply (insert units_group)
    9.64 -    apply auto
    9.65 -   apply (subst units_of_mult [symmetric])
    9.66 -   apply (subst units_of_one [symmetric])
    9.67 -   apply (erule group.r_inv, assumption)
    9.68 -  apply (subst units_of_mult [symmetric])
    9.69 -  apply (subst units_of_one [symmetric])
    9.70 -  apply (erule group.l_inv, assumption)
    9.71 -  done
    9.72 -
    9.73 -lemma (in group) inj_on_const_mult: "a \<in> carrier G \<Longrightarrow> inj_on (\<lambda>x. a \<otimes> x) (carrier G)"
    9.74 -  unfolding inj_on_def by auto
    9.75 -
    9.76 -lemma (in group) surj_const_mult: "a \<in> carrier G \<Longrightarrow> (\<lambda>x. a \<otimes> x) ` carrier G = carrier G"
    9.77 -  apply (auto simp add: image_def)
    9.78 -  apply (rule_tac x = "(m_inv G a) \<otimes> x" in bexI)
    9.79 -  apply auto
    9.80 -(* auto should get this. I suppose we need "comm_monoid_simprules"
    9.81 -   for ac_simps rewriting. *)
    9.82 -  apply (subst m_assoc [symmetric])
    9.83 -  apply auto
    9.84 -  done
    9.85 -
    9.86 -lemma (in group) l_cancel_one [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> x \<otimes> a = x \<longleftrightarrow> a = one G"
    9.87 -  by (metis Units_eq Units_l_cancel monoid.r_one monoid_axioms one_closed)
    9.88 -
    9.89 -lemma (in group) r_cancel_one [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> a \<otimes> x = x \<longleftrightarrow> a = one G"
    9.90 -  by (metis monoid.l_one monoid_axioms one_closed right_cancel)
    9.91 -
    9.92 -lemma (in group) l_cancel_one' [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> x = x \<otimes> a \<longleftrightarrow> a = one G"
    9.93 -  using l_cancel_one by fastforce
    9.94 -
    9.95 -lemma (in group) r_cancel_one' [simp]: "x \<in> carrier G \<Longrightarrow> a \<in> carrier G \<Longrightarrow> x = a \<otimes> x \<longleftrightarrow> a = one G"
    9.96 -  using r_cancel_one by fastforce
    9.97 -
    9.98 -(* This should be generalized to arbitrary groups, not just commutative
    9.99 -   ones, using Lagrange's theorem. *)
   9.100 -
   9.101 -lemma (in comm_group) power_order_eq_one:
   9.102 -  assumes fin [simp]: "finite (carrier G)"
   9.103 -    and a [simp]: "a \<in> carrier G"
   9.104 -  shows "a [^] card(carrier G) = one G"
   9.105 -proof -
   9.106 -  have "(\<Otimes>x\<in>carrier G. x) = (\<Otimes>x\<in>carrier G. a \<otimes> x)"
   9.107 -    by (subst (2) finprod_reindex [symmetric],
   9.108 -      auto simp add: Pi_def inj_on_const_mult surj_const_mult)
   9.109 -  also have "\<dots> = (\<Otimes>x\<in>carrier G. a) \<otimes> (\<Otimes>x\<in>carrier G. x)"
   9.110 -    by (auto simp add: finprod_multf Pi_def)
   9.111 -  also have "(\<Otimes>x\<in>carrier G. a) = a [^] card(carrier G)"
   9.112 -    by (auto simp add: finprod_const)
   9.113 -  finally show ?thesis
   9.114 -(* uses the preceeding lemma *)
   9.115 -    by auto
   9.116 -qed
   9.117 -
   9.118 -end
    10.1 --- a/src/HOL/Algebra/More_Ring.thy	Thu Jun 14 15:45:53 2018 +0200
    10.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.3 @@ -1,74 +0,0 @@
    10.4 -(*  Title:      HOL/Algebra/More_Ring.thy
    10.5 -    Author:     Jeremy Avigad
    10.6 -*)
    10.7 -
    10.8 -section \<open>More on rings etc.\<close>
    10.9 -
   10.10 -theory More_Ring
   10.11 -  imports Ring
   10.12 -begin
   10.13 -
   10.14 -lemma (in cring) field_intro2: "\<zero>\<^bsub>R\<^esub> \<noteq> \<one>\<^bsub>R\<^esub> \<Longrightarrow> \<forall>x \<in> carrier R - {\<zero>\<^bsub>R\<^esub>}. x \<in> Units R \<Longrightarrow> field R"
   10.15 -  apply (unfold_locales)
   10.16 -    apply (use cring_axioms in auto)
   10.17 -   apply (rule trans)
   10.18 -    apply (subgoal_tac "a = (a \<otimes> b) \<otimes> inv b")
   10.19 -     apply assumption
   10.20 -    apply (subst m_assoc)
   10.21 -       apply auto
   10.22 -  apply (unfold Units_def)
   10.23 -  apply auto
   10.24 -  done
   10.25 -
   10.26 -lemma (in monoid) inv_char:
   10.27 -  "x \<in> carrier G \<Longrightarrow> y \<in> carrier G \<Longrightarrow> x \<otimes> y = \<one> \<Longrightarrow> y \<otimes> x = \<one> \<Longrightarrow> inv x = y"
   10.28 -  apply (subgoal_tac "x \<in> Units G")
   10.29 -   apply (subgoal_tac "y = inv x \<otimes> \<one>")
   10.30 -    apply simp
   10.31 -   apply (erule subst)
   10.32 -   apply (subst m_assoc [symmetric])
   10.33 -      apply auto
   10.34 -  apply (unfold Units_def)
   10.35 -  apply auto
   10.36 -  done
   10.37 -
   10.38 -lemma (in comm_monoid) comm_inv_char: "x \<in> carrier G \<Longrightarrow> y \<in> carrier G \<Longrightarrow> x \<otimes> y = \<one> \<Longrightarrow> inv x = y"
   10.39 -  apply (rule inv_char)
   10.40 -     apply auto
   10.41 -  apply (subst m_comm, auto)
   10.42 -  done
   10.43 -
   10.44 -lemma (in ring) inv_neg_one [simp]: "inv (\<ominus> \<one>) = \<ominus> \<one>"
   10.45 -  apply (rule inv_char)
   10.46 -     apply (auto simp add: l_minus r_minus)
   10.47 -  done
   10.48 -
   10.49 -lemma (in monoid) inv_eq_imp_eq: "x \<in> Units G \<Longrightarrow> y \<in> Units G \<Longrightarrow> inv x = inv y \<Longrightarrow> x = y"
   10.50 -  apply (subgoal_tac "inv (inv x) = inv (inv y)")
   10.51 -   apply (subst (asm) Units_inv_inv)+
   10.52 -    apply auto
   10.53 -  done
   10.54 -
   10.55 -lemma (in ring) Units_minus_one_closed [intro]: "\<ominus> \<one> \<in> Units R"
   10.56 -  apply (unfold Units_def)
   10.57 -  apply auto
   10.58 -  apply (rule_tac x = "\<ominus> \<one>" in bexI)
   10.59 -   apply auto
   10.60 -  apply (simp add: l_minus r_minus)
   10.61 -  done
   10.62 -
   10.63 -lemma (in monoid) inv_one [simp]: "inv \<one> = \<one>"
   10.64 -  apply (rule inv_char)
   10.65 -     apply auto
   10.66 -  done
   10.67 -
   10.68 -lemma (in ring) inv_eq_neg_one_eq: "x \<in> Units R \<Longrightarrow> inv x = \<ominus> \<one> \<longleftrightarrow> x = \<ominus> \<one>"
   10.69 -  apply auto
   10.70 -  apply (subst Units_inv_inv [symmetric])
   10.71 -   apply auto
   10.72 -  done
   10.73 -
   10.74 -lemma (in monoid) inv_eq_one_eq: "x \<in> Units G \<Longrightarrow> inv x = \<one> \<longleftrightarrow> x = \<one>"
   10.75 -  by (metis Units_inv_inv inv_one)
   10.76 -
   10.77 -end
    11.1 --- a/src/HOL/Algebra/Multiplicative_Group.thy	Thu Jun 14 15:45:53 2018 +0200
    11.2 +++ b/src/HOL/Algebra/Multiplicative_Group.thy	Thu Jun 14 15:20:20 2018 +0100
    11.3 @@ -7,8 +7,6 @@
    11.4  imports
    11.5    Complex_Main
    11.6    Group
    11.7 -  More_Group
    11.8 -  More_Finite_Product
    11.9    Coset
   11.10    UnivPoly
   11.11  begin
    12.1 --- a/src/HOL/Algebra/Ring.thy	Thu Jun 14 15:45:53 2018 +0200
    12.2 +++ b/src/HOL/Algebra/Ring.thy	Thu Jun 14 15:20:20 2018 +0100
    12.3 @@ -13,79 +13,100 @@
    12.4  
    12.5  record 'a ring = "'a monoid" +
    12.6    zero :: 'a ("\<zero>\<index>")
    12.7 -  add :: "['a, 'a] => 'a" (infixl "\<oplus>\<index>" 65)
    12.8 +  add :: "['a, 'a] \<Rightarrow> 'a" (infixl "\<oplus>\<index>" 65)
    12.9 +
   12.10 +abbreviation
   12.11 +  add_monoid :: "('a, 'm) ring_scheme \<Rightarrow> ('a, 'm) monoid_scheme"
   12.12 +  where "add_monoid R \<equiv> \<lparr> carrier = carrier R, mult = add R, one = zero R, \<dots> = (undefined :: 'm) \<rparr>"
   12.13  
   12.14  text \<open>Derived operations.\<close>
   12.15  
   12.16  definition
   12.17 -  a_inv :: "[('a, 'm) ring_scheme, 'a ] => 'a" ("\<ominus>\<index> _" [81] 80)
   12.18 -  where "a_inv R = m_inv \<lparr>carrier = carrier R, mult = add R, one = zero R\<rparr>"
   12.19 +  a_inv :: "[('a, 'm) ring_scheme, 'a ] \<Rightarrow> 'a" ("\<ominus>\<index> _" [81] 80)
   12.20 +  where "a_inv R = m_inv (add_monoid R)"
   12.21  
   12.22  definition
   12.23    a_minus :: "[('a, 'm) ring_scheme, 'a, 'a] => 'a" ("(_ \<ominus>\<index> _)" [65,66] 65)
   12.24 -  where "[| x \<in> carrier R; y \<in> carrier R |] ==> x \<ominus>\<^bsub>R\<^esub> y = x \<oplus>\<^bsub>R\<^esub> (\<ominus>\<^bsub>R\<^esub> y)"
   12.25 +  where "x \<ominus>\<^bsub>R\<^esub> y = x \<oplus>\<^bsub>R\<^esub> (\<ominus>\<^bsub>R\<^esub> y)"
   12.26 +
   12.27 +definition
   12.28 +  add_pow :: "[_, ('b :: semiring_1), 'a] \<Rightarrow> 'a" ("[_] \<cdot>\<index> _" [81, 81] 80)
   12.29 +  where "add_pow R k a = pow (add_monoid R) a k"
   12.30  
   12.31  locale abelian_monoid =
   12.32    fixes G (structure)
   12.33    assumes a_comm_monoid:
   12.34 -     "comm_monoid \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   12.35 +     "comm_monoid (add_monoid G)"
   12.36  
   12.37  definition
   12.38 -  finsum :: "[('b, 'm) ring_scheme, 'a => 'b, 'a set] => 'b" where
   12.39 -  "finsum G = finprod \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   12.40 +  finsum :: "[('b, 'm) ring_scheme, 'a \<Rightarrow> 'b, 'a set] \<Rightarrow> 'b" where
   12.41 +  "finsum G = finprod (add_monoid G)"
   12.42  
   12.43  syntax
   12.44 -  "_finsum" :: "index => idt => 'a set => 'b => 'b"
   12.45 +  "_finsum" :: "index \<Rightarrow> idt \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"
   12.46        ("(3\<Oplus>__\<in>_. _)" [1000, 0, 51, 10] 10)
   12.47  translations
   12.48 -  "\<Oplus>\<^bsub>G\<^esub>i\<in>A. b" \<rightleftharpoons> "CONST finsum G (%i. b) A"
   12.49 +  "\<Oplus>\<^bsub>G\<^esub>i\<in>A. b" \<rightleftharpoons> "CONST finsum G (\<lambda>i. b) A"
   12.50    \<comment> \<open>Beware of argument permutation!\<close>
   12.51  
   12.52  
   12.53  locale abelian_group = abelian_monoid +
   12.54    assumes a_comm_group:
   12.55 -     "comm_group \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   12.56 +     "comm_group (add_monoid G)"
   12.57  
   12.58  
   12.59  subsection \<open>Basic Properties\<close>
   12.60  
   12.61  lemma abelian_monoidI:
   12.62    fixes R (structure)
   12.63 -  assumes a_closed:
   12.64 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y \<in> carrier R"
   12.65 -    and zero_closed: "\<zero> \<in> carrier R"
   12.66 -    and a_assoc:
   12.67 -      "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |] ==>
   12.68 -      (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
   12.69 -    and l_zero: "!!x. x \<in> carrier R ==> \<zero> \<oplus> x = x"
   12.70 -    and a_comm:
   12.71 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y = y \<oplus> x"
   12.72 +  assumes "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
   12.73 +      and "\<zero> \<in> carrier R"
   12.74 +      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
   12.75 +      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
   12.76 +      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
   12.77    shows "abelian_monoid R"
   12.78    by (auto intro!: abelian_monoid.intro comm_monoidI intro: assms)
   12.79  
   12.80 +lemma abelian_monoidE:
   12.81 +  fixes R (structure)
   12.82 +  assumes "abelian_monoid R"
   12.83 +  shows "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
   12.84 +    and "\<zero> \<in> carrier R"
   12.85 +    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
   12.86 +    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
   12.87 +    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
   12.88 +  using assms unfolding abelian_monoid_def comm_monoid_def comm_monoid_axioms_def monoid_def by auto
   12.89 +
   12.90  lemma abelian_groupI:
   12.91    fixes R (structure)
   12.92 -  assumes a_closed:
   12.93 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y \<in> carrier R"
   12.94 -    and zero_closed: "zero R \<in> carrier R"
   12.95 -    and a_assoc:
   12.96 -      "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |] ==>
   12.97 -      (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
   12.98 -    and a_comm:
   12.99 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y = y \<oplus> x"
  12.100 -    and l_zero: "!!x. x \<in> carrier R ==> \<zero> \<oplus> x = x"
  12.101 -    and l_inv_ex: "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
  12.102 +  assumes "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
  12.103 +      and "\<zero> \<in> carrier R"
  12.104 +      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
  12.105 +      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
  12.106 +      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
  12.107 +      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
  12.108    shows "abelian_group R"
  12.109    by (auto intro!: abelian_group.intro abelian_monoidI
  12.110        abelian_group_axioms.intro comm_monoidI comm_groupI
  12.111      intro: assms)
  12.112  
  12.113 +lemma abelian_groupE:
  12.114 +  fixes R (structure)
  12.115 +  assumes "abelian_group R"
  12.116 +  shows "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
  12.117 +    and "\<zero> \<in> carrier R"
  12.118 +    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
  12.119 +    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
  12.120 +    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
  12.121 +    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
  12.122 +  using abelian_group.a_comm_group assms comm_groupE by fastforce+
  12.123 +
  12.124  lemma (in abelian_monoid) a_monoid:
  12.125 -  "monoid \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.126 +  "monoid (add_monoid G)"
  12.127  by (rule comm_monoid.axioms, rule a_comm_monoid) 
  12.128  
  12.129  lemma (in abelian_group) a_group:
  12.130 -  "group \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.131 +  "group (add_monoid G)"
  12.132    by (simp add: group_def a_monoid)
  12.133      (simp add: comm_group.axioms group.axioms a_comm_group)
  12.134  
  12.135 @@ -94,13 +115,15 @@
  12.136  text \<open>Transfer facts from multiplicative structures via interpretation.\<close>
  12.137  
  12.138  sublocale abelian_monoid <
  12.139 -  add: monoid "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.140 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
  12.141 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
  12.142 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
  12.143 -  by (rule a_monoid) auto
  12.144 +       add: monoid "(add_monoid G)"
  12.145 +  rewrites "carrier (add_monoid G) = carrier G"
  12.146 +       and "mult    (add_monoid G) = add G"
  12.147 +       and "one     (add_monoid G) = zero G"
  12.148 +       and "(\<lambda>a k. pow (add_monoid G) a k) = (\<lambda>a k. add_pow G k a)"
  12.149 +  by (rule a_monoid) (auto simp add: add_pow_def)
  12.150  
  12.151 -context abelian_monoid begin
  12.152 +context abelian_monoid
  12.153 +begin
  12.154  
  12.155  lemmas a_closed = add.m_closed 
  12.156  lemmas zero_closed = add.one_closed
  12.157 @@ -112,12 +135,13 @@
  12.158  end
  12.159  
  12.160  sublocale abelian_monoid <
  12.161 -  add: comm_monoid "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.162 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
  12.163 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
  12.164 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
  12.165 -    and "finprod \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = finsum G"
  12.166 -  by (rule a_comm_monoid) (auto simp: finsum_def)
  12.167 +  add: comm_monoid "(add_monoid G)"
  12.168 +  rewrites "carrier (add_monoid G) = carrier G"
  12.169 +       and "mult    (add_monoid G) = add G"
  12.170 +       and "one     (add_monoid G) = zero G"
  12.171 +       and "finprod (add_monoid G) = finsum G"
  12.172 +       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
  12.173 +  by (rule a_comm_monoid) (auto simp: finsum_def add_pow_def)
  12.174  
  12.175  context abelian_monoid begin
  12.176  
  12.177 @@ -168,12 +192,13 @@
  12.178  end
  12.179  
  12.180  sublocale abelian_group <
  12.181 -  add: group "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.182 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
  12.183 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
  12.184 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
  12.185 -    and "m_inv \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = a_inv G"
  12.186 -  by (rule a_group) (auto simp: m_inv_def a_inv_def)
  12.187 +        add: group "(add_monoid G)"
  12.188 +  rewrites "carrier (add_monoid G) = carrier G"
  12.189 +       and "mult    (add_monoid G) = add G"
  12.190 +       and "one     (add_monoid G) = zero G"
  12.191 +       and "m_inv   (add_monoid G) = a_inv G"
  12.192 +       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
  12.193 +  by (rule a_group) (auto simp: m_inv_def a_inv_def add_pow_def)
  12.194  
  12.195  context abelian_group
  12.196  begin
  12.197 @@ -186,7 +211,6 @@
  12.198  
  12.199  lemmas l_neg = add.l_inv [simp del]
  12.200  lemmas r_neg = add.r_inv [simp del]
  12.201 -lemmas minus_zero = add.inv_one
  12.202  lemmas minus_minus = add.inv_inv
  12.203  lemmas a_inv_inj = add.inv_inj
  12.204  lemmas minus_equality = add.inv_equality
  12.205 @@ -194,13 +218,14 @@
  12.206  end
  12.207  
  12.208  sublocale abelian_group <
  12.209 -  add: comm_group "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.210 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
  12.211 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
  12.212 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
  12.213 -    and "m_inv \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = a_inv G"
  12.214 -    and "finprod \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = finsum G"
  12.215 -  by (rule a_comm_group) (auto simp: m_inv_def a_inv_def finsum_def)
  12.216 +   add: comm_group "(add_monoid G)"
  12.217 +  rewrites "carrier (add_monoid G) = carrier G"
  12.218 +       and "mult    (add_monoid G) = add G"
  12.219 +       and "one     (add_monoid G) = zero G"
  12.220 +       and "m_inv   (add_monoid G) = a_inv G"
  12.221 +       and "finprod (add_monoid G) = finsum G"
  12.222 +       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
  12.223 +  by (rule a_comm_group) (auto simp: m_inv_def a_inv_def finsum_def add_pow_def)
  12.224  
  12.225  lemmas (in abelian_group) minus_add = add.inv_mult
  12.226   
  12.227 @@ -208,10 +233,10 @@
  12.228  
  12.229  lemma comm_group_abelian_groupI:
  12.230    fixes G (structure)
  12.231 -  assumes cg: "comm_group \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.232 +  assumes cg: "comm_group (add_monoid G)"
  12.233    shows "abelian_group G"
  12.234  proof -
  12.235 -  interpret comm_group "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
  12.236 +  interpret comm_group "(add_monoid G)"
  12.237      by (rule cg)
  12.238    show "abelian_group G" ..
  12.239  qed
  12.240 @@ -219,26 +244,21 @@
  12.241  
  12.242  subsection \<open>Rings: Basic Definitions\<close>
  12.243  
  12.244 -locale semiring = abelian_monoid R + monoid R for R (structure) +
  12.245 -  assumes l_distr: "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
  12.246 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.247 -    and r_distr: "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
  12.248 -      ==> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  12.249 -    and l_null[simp]: "x \<in> carrier R ==> \<zero> \<otimes> x = \<zero>"
  12.250 -    and r_null[simp]: "x \<in> carrier R ==> x \<otimes> \<zero> = \<zero>"
  12.251 +locale semiring = abelian_monoid (* for add *) R + monoid (* for mult *) R for R (structure) +
  12.252 +  assumes l_distr: "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.253 +      and r_distr: "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  12.254 +      and l_null[simp]: "x \<in> carrier R \<Longrightarrow> \<zero> \<otimes> x = \<zero>"
  12.255 +      and r_null[simp]: "x \<in> carrier R \<Longrightarrow> x \<otimes> \<zero> = \<zero>"
  12.256  
  12.257 -locale ring = abelian_group R + monoid R for R (structure) +
  12.258 -  assumes "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
  12.259 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.260 -    and "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
  12.261 -      ==> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  12.262 +locale ring = abelian_group (* for add *) R + monoid (* for mult *) R for R (structure) +
  12.263 +  assumes "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.264 +      and "\<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  12.265  
  12.266 -locale cring = ring + comm_monoid R
  12.267 +locale cring = ring + comm_monoid (* for mult *) R
  12.268  
  12.269  locale "domain" = cring +
  12.270    assumes one_not_zero [simp]: "\<one> \<noteq> \<zero>"
  12.271 -    and integral: "[| a \<otimes> b = \<zero>; a \<in> carrier R; b \<in> carrier R |] ==>
  12.272 -                  a = \<zero> \<or> b = \<zero>"
  12.273 +      and integral: "\<lbrakk> a \<otimes> b = \<zero>; a \<in> carrier R; b \<in> carrier R \<rbrakk> \<Longrightarrow> a = \<zero> \<or> b = \<zero>"
  12.274  
  12.275  locale field = "domain" +
  12.276    assumes field_Units: "Units R = carrier R - {\<zero>}"
  12.277 @@ -248,16 +268,23 @@
  12.278  
  12.279  lemma ringI:
  12.280    fixes R (structure)
  12.281 -  assumes abelian_group: "abelian_group R"
  12.282 -    and monoid: "monoid R"
  12.283 -    and l_distr: "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
  12.284 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.285 -    and r_distr: "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
  12.286 -      ==> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  12.287 +  assumes "abelian_group R"
  12.288 +      and "monoid R"
  12.289 +      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.290 +      and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  12.291    shows "ring R"
  12.292    by (auto intro: ring.intro
  12.293      abelian_group.axioms ring_axioms.intro assms)
  12.294  
  12.295 +lemma ringE:
  12.296 +  fixes R (structure)
  12.297 +  assumes "ring R"
  12.298 +  shows "abelian_group R"
  12.299 +    and "monoid R"
  12.300 +    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.301 +    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
  12.302 +  using assms unfolding ring_def ring_axioms_def by auto
  12.303 +
  12.304  context ring begin
  12.305  
  12.306  lemma is_abelian_group: "abelian_group R" ..
  12.307 @@ -269,15 +296,15 @@
  12.308    by (rule ring_axioms)
  12.309  
  12.310  end
  12.311 -
  12.312 +thm monoid_record_simps
  12.313  lemmas ring_record_simps = monoid_record_simps ring.simps
  12.314  
  12.315  lemma cringI:
  12.316    fixes R (structure)
  12.317    assumes abelian_group: "abelian_group R"
  12.318      and comm_monoid: "comm_monoid R"
  12.319 -    and l_distr: "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
  12.320 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.321 +    and l_distr: "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow>
  12.322 +                            (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.323    shows "cring R"
  12.324  proof (intro cring.intro ring.intro)
  12.325    show "ring_axioms R"
  12.326 @@ -300,20 +327,37 @@
  12.327  qed (auto intro: cring.intro
  12.328    abelian_group.axioms comm_monoid.axioms ring_axioms.intro assms)
  12.329  
  12.330 +lemma cringE:
  12.331 +  fixes R (structure)
  12.332 +  assumes "cring R"
  12.333 +  shows "comm_monoid R"
  12.334 +    and "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
  12.335 +  using assms cring_def apply auto by (simp add: assms cring.axioms(1) ringE(3))
  12.336 +
  12.337  (*
  12.338  lemma (in cring) is_comm_monoid:
  12.339    "comm_monoid R"
  12.340    by (auto intro!: comm_monoidI m_assoc m_comm)
  12.341  *)
  12.342 -
  12.343  lemma (in cring) is_cring:
  12.344    "cring R" by (rule cring_axioms)
  12.345  
  12.346 +lemma (in ring) minus_zero [simp]: "\<ominus> \<zero> = \<zero>"
  12.347 +  by (simp add: a_inv_def)
  12.348  
  12.349  subsubsection \<open>Normaliser for Rings\<close>
  12.350  
  12.351 +lemma (in abelian_group) r_neg1:
  12.352 +  "\<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> (\<ominus> x) \<oplus> (x \<oplus> y) = y"
  12.353 +proof -
  12.354 +  assume G: "x \<in> carrier G" "y \<in> carrier G"
  12.355 +  then have "(\<ominus> x \<oplus> x) \<oplus> y = y" 
  12.356 +    by (simp only: l_neg l_zero)
  12.357 +  with G show ?thesis by (simp add: a_ac)
  12.358 +qed
  12.359 +
  12.360  lemma (in abelian_group) r_neg2:
  12.361 -  "[| x \<in> carrier G; y \<in> carrier G |] ==> x \<oplus> (\<ominus> x \<oplus> y) = y"
  12.362 +  "\<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<oplus> ((\<ominus> x) \<oplus> y) = y"
  12.363  proof -
  12.364    assume G: "x \<in> carrier G" "y \<in> carrier G"
  12.365    then have "(x \<oplus> \<ominus> x) \<oplus> y = y"
  12.366 @@ -322,15 +366,6 @@
  12.367      by (simp add: a_ac)
  12.368  qed
  12.369  
  12.370 -lemma (in abelian_group) r_neg1:
  12.371 -  "[| x \<in> carrier G; y \<in> carrier G |] ==> \<ominus> x \<oplus> (x \<oplus> y) = y"
  12.372 -proof -
  12.373 -  assume G: "x \<in> carrier G" "y \<in> carrier G"
  12.374 -  then have "(\<ominus> x \<oplus> x) \<oplus> y = y" 
  12.375 -    by (simp only: l_neg l_zero)
  12.376 -  with G show ?thesis by (simp add: a_ac)
  12.377 -qed
  12.378 -
  12.379  context ring begin
  12.380  
  12.381  text \<open>
  12.382 @@ -358,7 +393,7 @@
  12.383  qed
  12.384  
  12.385  lemma l_minus:
  12.386 -  "[| x \<in> carrier R; y \<in> carrier R |] ==> \<ominus> x \<otimes> y = \<ominus> (x \<otimes> y)"
  12.387 +  "\<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> (\<ominus> x) \<otimes> y = \<ominus> (x \<otimes> y)"
  12.388  proof -
  12.389    assume R: "x \<in> carrier R" "y \<in> carrier R"
  12.390    then have "(\<ominus> x) \<otimes> y \<oplus> x \<otimes> y = (\<ominus> x \<oplus> x) \<otimes> y" by (simp add: l_distr)
  12.391 @@ -369,7 +404,7 @@
  12.392  qed
  12.393  
  12.394  lemma r_minus:
  12.395 -  "[| x \<in> carrier R; y \<in> carrier R |] ==> x \<otimes> \<ominus> y = \<ominus> (x \<otimes> y)"
  12.396 +  "\<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<otimes> (\<ominus> y) = \<ominus> (x \<otimes> y)"
  12.397  proof -
  12.398    assume R: "x \<in> carrier R" "y \<in> carrier R"
  12.399    then have "x \<otimes> (\<ominus> y) \<oplus> x \<otimes> y = x \<otimes> (\<ominus> y \<oplus> y)" by (simp add: r_distr)
  12.400 @@ -381,13 +416,13 @@
  12.401  
  12.402  end
  12.403  
  12.404 -lemma (in abelian_group) minus_eq:
  12.405 -  "[| x \<in> carrier G; y \<in> carrier G |] ==> x \<ominus> y = x \<oplus> \<ominus> y"
  12.406 -  by (simp only: a_minus_def)
  12.407 +lemma (in abelian_group) minus_eq: "x \<ominus> y = x \<oplus> (\<ominus> y)"
  12.408 +  by (rule a_minus_def)
  12.409  
  12.410  text \<open>Setup algebra method:
  12.411    compute distributive normal form in locale contexts\<close>
  12.412  
  12.413 +
  12.414  ML_file "ringsimp.ML"
  12.415  
  12.416  attribute_setup algebra = \<open>
  12.417 @@ -467,7 +502,7 @@
  12.418    fixes R (structure) and S (structure)
  12.419    assumes "ring R" "cring S"
  12.420    assumes RS: "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier S" "d \<in> carrier S"
  12.421 -  shows "a \<oplus> \<ominus> (a \<oplus> \<ominus> b) = b \<and> c \<otimes>\<^bsub>S\<^esub> d = d \<otimes>\<^bsub>S\<^esub> c"
  12.422 +  shows "a \<oplus> (\<ominus> (a \<oplus> (\<ominus> b))) = b \<and> c \<otimes>\<^bsub>S\<^esub> d = d \<otimes>\<^bsub>S\<^esub> c"
  12.423  proof -
  12.424    interpret ring R by fact
  12.425    interpret cring S by fact
  12.426 @@ -488,8 +523,8 @@
  12.427  subsubsection \<open>Sums over Finite Sets\<close>
  12.428  
  12.429  lemma (in semiring) finsum_ldistr:
  12.430 -  "[| finite A; a \<in> carrier R; f \<in> A \<rightarrow> carrier R |] ==>
  12.431 -   finsum R f A \<otimes> a = finsum R (%i. f i \<otimes> a) A"
  12.432 +  "\<lbrakk> finite A; a \<in> carrier R; f: A \<rightarrow> carrier R \<rbrakk> \<Longrightarrow>
  12.433 +    (\<Oplus> i \<in> A. (f i)) \<otimes> a = (\<Oplus> i \<in> A. ((f i) \<otimes> a))"
  12.434  proof (induct set: finite)
  12.435    case empty then show ?case by simp
  12.436  next
  12.437 @@ -497,25 +532,86 @@
  12.438  qed
  12.439  
  12.440  lemma (in semiring) finsum_rdistr:
  12.441 -  "[| finite A; a \<in> carrier R; f \<in> A \<rightarrow> carrier R |] ==>
  12.442 -   a \<otimes> finsum R f A = finsum R (%i. a \<otimes> f i) A"
  12.443 +  "\<lbrakk> finite A; a \<in> carrier R; f: A \<rightarrow> carrier R \<rbrakk> \<Longrightarrow>
  12.444 +   a \<otimes> (\<Oplus> i \<in> A. (f i)) = (\<Oplus> i \<in> A. (a \<otimes> (f i)))"
  12.445  proof (induct set: finite)
  12.446    case empty then show ?case by simp
  12.447  next
  12.448    case (insert x F) then show ?case by (simp add: Pi_def r_distr)
  12.449  qed
  12.450  
  12.451 +(* ************************************************************************** *)
  12.452 +(* Contributed by Paulo E. de Vilhena.                                        *)
  12.453 +
  12.454 +text \<open>A quick detour\<close>
  12.455 +
  12.456 +lemma add_pow_int_ge: "(k :: int) \<ge> 0 \<Longrightarrow> [ k ] \<cdot>\<^bsub>R\<^esub> a = [ nat k ] \<cdot>\<^bsub>R\<^esub> a"
  12.457 +  by (simp add: add_pow_def int_pow_def nat_pow_def)
  12.458 +
  12.459 +lemma add_pow_int_lt: "(k :: int) < 0 \<Longrightarrow> [ k ] \<cdot>\<^bsub>R\<^esub> a = \<ominus>\<^bsub>R\<^esub> ([ nat (- k) ] \<cdot>\<^bsub>R\<^esub> a)"
  12.460 +  by (simp add: int_pow_def nat_pow_def a_inv_def add_pow_def) 
  12.461 +
  12.462 +corollary (in semiring) add_pow_ldistr:
  12.463 +  assumes "a \<in> carrier R" "b \<in> carrier R"
  12.464 +  shows "([(k :: nat)] \<cdot> a) \<otimes> b = [k] \<cdot> (a \<otimes> b)"
  12.465 +proof -
  12.466 +  have "([k] \<cdot> a) \<otimes> b = (\<Oplus> i \<in> {..< k}. a) \<otimes> b"
  12.467 +    using add.finprod_const[OF assms(1), of "{..<k}"] by simp
  12.468 +  also have " ... = (\<Oplus> i \<in> {..< k}. (a \<otimes> b))"
  12.469 +    using finsum_ldistr[of "{..<k}" b "\<lambda>x. a"] assms by simp
  12.470 +  also have " ... = [k] \<cdot> (a \<otimes> b)"
  12.471 +    using add.finprod_const[of "a \<otimes> b" "{..<k}"] assms by simp
  12.472 +  finally show ?thesis .
  12.473 +qed
  12.474 +
  12.475 +corollary (in semiring) add_pow_rdistr:
  12.476 +  assumes "a \<in> carrier R" "b \<in> carrier R"
  12.477 +  shows "a \<otimes> ([(k :: nat)] \<cdot> b) = [k] \<cdot> (a \<otimes> b)"
  12.478 +proof -
  12.479 +  have "a \<otimes> ([k] \<cdot> b) = a \<otimes> (\<Oplus> i \<in> {..< k}. b)"
  12.480 +    using add.finprod_const[OF assms(2), of "{..<k}"] by simp
  12.481 +  also have " ... = (\<Oplus> i \<in> {..< k}. (a \<otimes> b))"
  12.482 +    using finsum_rdistr[of "{..<k}" a "\<lambda>x. b"] assms by simp
  12.483 +  also have " ... = [k] \<cdot> (a \<otimes> b)"
  12.484 +    using add.finprod_const[of "a \<otimes> b" "{..<k}"] assms by simp
  12.485 +  finally show ?thesis .
  12.486 +qed 
  12.487 +
  12.488 +(* For integers, we need the uniqueness of the additive inverse *)
  12.489 +lemma (in ring) add_pow_ldistr_int:
  12.490 +  assumes "a \<in> carrier R" "b \<in> carrier R"
  12.491 +  shows "([(k :: int)] \<cdot> a) \<otimes> b = [k] \<cdot> (a \<otimes> b)"
  12.492 +proof (cases "k \<ge> 0")
  12.493 +  case True thus ?thesis
  12.494 +    using add_pow_int_ge[of k R] add_pow_ldistr[OF assms] by auto
  12.495 +next
  12.496 +  case False thus ?thesis
  12.497 +    using add_pow_int_lt[of k R a] add_pow_int_lt[of k R "a \<otimes> b"]
  12.498 +          add_pow_ldistr[OF assms, of "nat (- k)"] assms l_minus by auto 
  12.499 +qed
  12.500 +
  12.501 +lemma (in ring) add_pow_rdistr_int:
  12.502 +  assumes "a \<in> carrier R" "b \<in> carrier R"
  12.503 +  shows "a \<otimes> ([(k :: int)] \<cdot> b) = [k] \<cdot> (a \<otimes> b)"
  12.504 +proof (cases "k \<ge> 0")
  12.505 +  case True thus ?thesis
  12.506 +    using add_pow_int_ge[of k R] add_pow_rdistr[OF assms] by auto
  12.507 +next
  12.508 +  case False thus ?thesis
  12.509 +    using add_pow_int_lt[of k R b] add_pow_int_lt[of k R "a \<otimes> b"]
  12.510 +          add_pow_rdistr[OF assms, of "nat (- k)"] assms r_minus by auto 
  12.511 +qed
  12.512 +
  12.513  
  12.514  subsection \<open>Integral Domains\<close>
  12.515  
  12.516  context "domain" begin
  12.517  
  12.518 -lemma zero_not_one [simp]:
  12.519 -  "\<zero> \<noteq> \<one>"
  12.520 +lemma zero_not_one [simp]: "\<zero> \<noteq> \<one>"
  12.521    by (rule not_sym) simp
  12.522  
  12.523  lemma integral_iff: (* not by default a simp rule! *)
  12.524 -  "[| a \<in> carrier R; b \<in> carrier R |] ==> (a \<otimes> b = \<zero>) = (a = \<zero> \<or> b = \<zero>)"
  12.525 +  "\<lbrakk> a \<in> carrier R; b \<in> carrier R \<rbrakk> \<Longrightarrow> (a \<otimes> b = \<zero>) = (a = \<zero> \<or> b = \<zero>)"
  12.526  proof
  12.527    assume "a \<in> carrier R" "b \<in> carrier R" "a \<otimes> b = \<zero>"
  12.528    then show "a = \<zero> \<or> b = \<zero>" by (simp add: integral)
  12.529 @@ -533,7 +629,7 @@
  12.530    with R have "a \<otimes> (b \<ominus> c) = \<zero>" by algebra
  12.531    with R have "a = \<zero> \<or> (b \<ominus> c) = \<zero>" by (simp add: integral_iff)
  12.532    with prem and R have "b \<ominus> c = \<zero>" by auto 
  12.533 -  with R have "b = b \<ominus> (b \<ominus> c)" by algebra 
  12.534 +  with R have "b = b \<ominus> (b \<ominus> c)" by algebra
  12.535    also from R have "b \<ominus> (b \<ominus> c) = c" by algebra
  12.536    finally show "b = c" .
  12.537  next
  12.538 @@ -556,6 +652,7 @@
  12.539  
  12.540  text \<open>Field would not need to be derived from domain, the properties
  12.541    for domain follow from the assumptions of field\<close>
  12.542 +
  12.543  lemma (in cring) cring_fieldI:
  12.544    assumes field_Units: "Units R = carrier R - {\<zero>}"
  12.545    shows "field R"
  12.546 @@ -614,49 +711,62 @@
  12.547  
  12.548  lemma ring_hom_memI:
  12.549    fixes R (structure) and S (structure)
  12.550 -  assumes hom_closed: "!!x. x \<in> carrier R ==> h x \<in> carrier S"
  12.551 -    and hom_mult: "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==>
  12.552 -      h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
  12.553 -    and hom_add: "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==>
  12.554 -      h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
  12.555 -    and hom_one: "h \<one> = \<one>\<^bsub>S\<^esub>"
  12.556 +  assumes "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
  12.557 +      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
  12.558 +      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
  12.559 +      and "h \<one> = \<one>\<^bsub>S\<^esub>"
  12.560    shows "h \<in> ring_hom R S"
  12.561    by (auto simp add: ring_hom_def assms Pi_def)
  12.562  
  12.563 +lemma ring_hom_memE:
  12.564 +  fixes R (structure) and S (structure)
  12.565 +  assumes "h \<in> ring_hom R S"
  12.566 +  shows "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
  12.567 +    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
  12.568 +    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
  12.569 +    and "h \<one> = \<one>\<^bsub>S\<^esub>"
  12.570 +  using assms unfolding ring_hom_def by auto
  12.571 +
  12.572  lemma ring_hom_closed:
  12.573 -  "[| h \<in> ring_hom R S; x \<in> carrier R |] ==> h x \<in> carrier S"
  12.574 +  "\<lbrakk> h \<in> ring_hom R S; x \<in> carrier R \<rbrakk> \<Longrightarrow> h x \<in> carrier S"
  12.575    by (auto simp add: ring_hom_def funcset_mem)
  12.576  
  12.577  lemma ring_hom_mult:
  12.578    fixes R (structure) and S (structure)
  12.579 -  shows
  12.580 -    "[| h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R |] ==>
  12.581 -    h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
  12.582 +  shows "\<lbrakk> h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
  12.583      by (simp add: ring_hom_def)
  12.584  
  12.585  lemma ring_hom_add:
  12.586    fixes R (structure) and S (structure)
  12.587 -  shows
  12.588 -    "[| h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R |] ==>
  12.589 -    h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
  12.590 +  shows "\<lbrakk> h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
  12.591      by (simp add: ring_hom_def)
  12.592  
  12.593  lemma ring_hom_one:
  12.594    fixes R (structure) and S (structure)
  12.595 -  shows "h \<in> ring_hom R S ==> h \<one> = \<one>\<^bsub>S\<^esub>"
  12.596 +  shows "h \<in> ring_hom R S \<Longrightarrow> h \<one> = \<one>\<^bsub>S\<^esub>"
  12.597    by (simp add: ring_hom_def)
  12.598  
  12.599 -locale ring_hom_cring = R?: cring R + S?: cring S
  12.600 -    for R (structure) and S (structure) +
  12.601 -  fixes h
  12.602 +lemma ring_hom_zero:
  12.603 +  fixes R (structure) and S (structure)
  12.604 +  assumes "h \<in> ring_hom R S" "ring R" "ring S"
  12.605 +  shows "h \<zero> = \<zero>\<^bsub>S\<^esub>"
  12.606 +proof -
  12.607 +  have "h \<zero> = h \<zero> \<oplus>\<^bsub>S\<^esub> h \<zero>"
  12.608 +    using ring_hom_add[OF assms(1), of \<zero> \<zero>] assms(2)
  12.609 +    by (simp add: ring.ring_simprules(2) ring.ring_simprules(15))
  12.610 +  thus ?thesis
  12.611 +    by (metis abelian_group.l_neg assms ring.is_abelian_group ring.ring_simprules(18) ring.ring_simprules(2) ring_hom_closed)
  12.612 +qed
  12.613 +
  12.614 +locale ring_hom_cring =
  12.615 +  R?: cring R + S?: cring S for R (structure) and S (structure) + fixes h
  12.616    assumes homh [simp, intro]: "h \<in> ring_hom R S"
  12.617    notes hom_closed [simp, intro] = ring_hom_closed [OF homh]
  12.618      and hom_mult [simp] = ring_hom_mult [OF homh]
  12.619      and hom_add [simp] = ring_hom_add [OF homh]
  12.620      and hom_one [simp] = ring_hom_one [OF homh]
  12.621  
  12.622 -lemma (in ring_hom_cring) hom_zero [simp]:
  12.623 -  "h \<zero> = \<zero>\<^bsub>S\<^esub>"
  12.624 +lemma (in ring_hom_cring) hom_zero [simp]: "h \<zero> = \<zero>\<^bsub>S\<^esub>"
  12.625  proof -
  12.626    have "h \<zero> \<oplus>\<^bsub>S\<^esub> h \<zero> = h \<zero> \<oplus>\<^bsub>S\<^esub> \<zero>\<^bsub>S\<^esub>"
  12.627      by (simp add: hom_add [symmetric] del: hom_add)
  12.628 @@ -664,7 +774,7 @@
  12.629  qed
  12.630  
  12.631  lemma (in ring_hom_cring) hom_a_inv [simp]:
  12.632 -  "x \<in> carrier R ==> h (\<ominus> x) = \<ominus>\<^bsub>S\<^esub> h x"
  12.633 +  "x \<in> carrier R \<Longrightarrow> h (\<ominus> x) = \<ominus>\<^bsub>S\<^esub> h x"
  12.634  proof -
  12.635    assume R: "x \<in> carrier R"
  12.636    then have "h x \<oplus>\<^bsub>S\<^esub> h (\<ominus> x) = h x \<oplus>\<^bsub>S\<^esub> (\<ominus>\<^bsub>S\<^esub> h x)"
  12.637 @@ -673,19 +783,131 @@
  12.638  qed
  12.639  
  12.640  lemma (in ring_hom_cring) hom_finsum [simp]:
  12.641 -  "f \<in> A \<rightarrow> carrier R \<Longrightarrow>
  12.642 -  h (finsum R f A) = finsum S (h \<circ> f) A"
  12.643 -  by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
  12.644 +  assumes "f: A \<rightarrow> carrier R"
  12.645 +  shows "h (\<Oplus> i \<in> A. f i) = (\<Oplus>\<^bsub>S\<^esub> i \<in> A. (h o f) i)"
  12.646 +  using assms by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
  12.647  
  12.648  lemma (in ring_hom_cring) hom_finprod:
  12.649 -  "f \<in> A \<rightarrow> carrier R \<Longrightarrow>
  12.650 -  h (finprod R f A) = finprod S (h \<circ> f) A"
  12.651 -  by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
  12.652 +  assumes "f: A \<rightarrow> carrier R"
  12.653 +  shows "h (\<Otimes> i \<in> A. f i) = (\<Otimes>\<^bsub>S\<^esub> i \<in> A. (h o f) i)"
  12.654 +  using assms by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
  12.655  
  12.656  declare ring_hom_cring.hom_finprod [simp]
  12.657  
  12.658 -lemma id_ring_hom [simp]:
  12.659 -  "id \<in> ring_hom R R"
  12.660 +lemma id_ring_hom [simp]: "id \<in> ring_hom R R"
  12.661    by (auto intro!: ring_hom_memI)
  12.662  
  12.663 +(* Next lemma contributed by Paulo Emílio de Vilhena. *)
  12.664 +
  12.665 +lemma ring_hom_trans:
  12.666 +  "\<lbrakk> f \<in> ring_hom R S; g \<in> ring_hom S T \<rbrakk> \<Longrightarrow> g \<circ> f \<in> ring_hom R T"
  12.667 +  by (rule ring_hom_memI) (auto simp add: ring_hom_closed ring_hom_mult ring_hom_add ring_hom_one)
  12.668 +
  12.669 +subsection\<open>Jeremy Avigad's @{text"More_Finite_Product"} material\<close>
  12.670 +
  12.671 +(* need better simplification rules for rings *)
  12.672 +(* the next one holds more generally for abelian groups *)
  12.673 +
  12.674 +lemma (in cring) sum_zero_eq_neg: "x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> x \<oplus> y = \<zero> \<Longrightarrow> x = \<ominus> y"
  12.675 +  by (metis minus_equality)
  12.676 +
  12.677 +lemma (in domain) square_eq_one:
  12.678 +  fixes x
  12.679 +  assumes [simp]: "x \<in> carrier R"
  12.680 +    and "x \<otimes> x = \<one>"
  12.681 +  shows "x = \<one> \<or> x = \<ominus>\<one>"
  12.682 +proof -
  12.683 +  have "(x \<oplus> \<one>) \<otimes> (x \<oplus> \<ominus> \<one>) = x \<otimes> x \<oplus> \<ominus> \<one>"
  12.684 +    by (simp add: ring_simprules)
  12.685 +  also from \<open>x \<otimes> x = \<one>\<close> have "\<dots> = \<zero>"
  12.686 +    by (simp add: ring_simprules)
  12.687 +  finally have "(x \<oplus> \<one>) \<otimes> (x \<oplus> \<ominus> \<one>) = \<zero>" .
  12.688 +  then have "(x \<oplus> \<one>) = \<zero> \<or> (x \<oplus> \<ominus> \<one>) = \<zero>"
  12.689 +    by (intro integral) auto
  12.690 +  then show ?thesis
  12.691 +    by (metis add.inv_closed add.inv_solve_right assms(1) l_zero one_closed zero_closed)
  12.692 +qed
  12.693 +
  12.694 +lemma (in domain) inv_eq_self: "x \<in> Units R \<Longrightarrow> x = inv x \<Longrightarrow> x = \<one> \<or> x = \<ominus>\<one>"
  12.695 +  by (metis Units_closed Units_l_inv square_eq_one)
  12.696 +
  12.697 +
  12.698 +text \<open>
  12.699 +  The following translates theorems about groups to the facts about
  12.700 +  the units of a ring. (The list should be expanded as more things are
  12.701 +  needed.)
  12.702 +\<close>
  12.703 +
  12.704 +lemma (in ring) finite_ring_finite_units [intro]: "finite (carrier R) \<Longrightarrow> finite (Units R)"
  12.705 +  by (rule finite_subset) auto
  12.706 +
  12.707 +lemma (in monoid) units_of_pow:
  12.708 +  fixes n :: nat
  12.709 +  shows "x \<in> Units G \<Longrightarrow> x [^]\<^bsub>units_of G\<^esub> n = x [^]\<^bsub>G\<^esub> n"
  12.710 +  apply (induct n)
  12.711 +  apply (auto simp add: units_group group.is_monoid
  12.712 +    monoid.nat_pow_0 monoid.nat_pow_Suc units_of_one units_of_mult)
  12.713 +  done
  12.714 +
  12.715 +lemma (in cring) units_power_order_eq_one:
  12.716 +  "finite (Units R) \<Longrightarrow> a \<in> Units R \<Longrightarrow> a [^] card(Units R) = \<one>"
  12.717 +  by (metis comm_group.power_order_eq_one units_comm_group units_of_carrier units_of_one units_of_pow)
  12.718 +
  12.719 +subsection\<open>Jeremy Avigad's @{text"More_Ring"} material\<close>
  12.720 +
  12.721 +lemma (in cring) field_intro2: "\<zero>\<^bsub>R\<^esub> \<noteq> \<one>\<^bsub>R\<^esub> \<Longrightarrow> \<forall>x \<in> carrier R - {\<zero>\<^bsub>R\<^esub>}. x \<in> Units R \<Longrightarrow> field R"
  12.722 +  apply (unfold_locales)
  12.723 +    apply (use cring_axioms in auto)
  12.724 +   apply (rule trans)
  12.725 +    apply (subgoal_tac "a = (a \<otimes> b) \<otimes> inv b")
  12.726 +     apply assumption
  12.727 +    apply (subst m_assoc)
  12.728 +       apply auto
  12.729 +  apply (unfold Units_def)
  12.730 +  apply auto
  12.731 +  done
  12.732 +
  12.733 +lemma (in monoid) inv_char:
  12.734 +  "x \<in> carrier G \<Longrightarrow> y \<in> carrier G \<Longrightarrow> x \<otimes> y = \<one> \<Longrightarrow> y \<otimes> x = \<one> \<Longrightarrow> inv x = y"
  12.735 +  apply (subgoal_tac "x \<in> Units G")
  12.736 +   apply (subgoal_tac "y = inv x \<otimes> \<one>")
  12.737 +    apply simp
  12.738 +   apply (erule subst)
  12.739 +   apply (subst m_assoc [symmetric])
  12.740 +      apply auto
  12.741 +  apply (unfold Units_def)
  12.742 +  apply auto
  12.743 +  done
  12.744 +
  12.745 +lemma (in comm_monoid) comm_inv_char: "x \<in> carrier G \<Longrightarrow> y \<in> carrier G \<Longrightarrow> x \<otimes> y = \<one> \<Longrightarrow> inv x = y"
  12.746 +  by (simp add: inv_char m_comm)
  12.747 +
  12.748 +lemma (in ring) inv_neg_one [simp]: "inv (\<ominus> \<one>) = \<ominus> \<one>"
  12.749 +  apply (rule inv_char)
  12.750 +     apply (auto simp add: l_minus r_minus)
  12.751 +  done
  12.752 +
  12.753 +lemma (in monoid) inv_eq_imp_eq: "x \<in> Units G \<Longrightarrow> y \<in> Units G \<Longrightarrow> inv x = inv y \<Longrightarrow> x = y"
  12.754 +  apply (subgoal_tac "inv (inv x) = inv (inv y)")
  12.755 +   apply (subst (asm) Units_inv_inv)+
  12.756 +    apply auto
  12.757 +  done
  12.758 +
  12.759 +lemma (in ring) Units_minus_one_closed [intro]: "\<ominus> \<one> \<in> Units R"
  12.760 +  apply (unfold Units_def)
  12.761 +  apply auto
  12.762 +  apply (rule_tac x = "\<ominus> \<one>" in bexI)
  12.763 +   apply auto
  12.764 +  apply (simp add: l_minus r_minus)
  12.765 +  done
  12.766 +
  12.767 +lemma (in ring) inv_eq_neg_one_eq: "x \<in> Units R \<Longrightarrow> inv x = \<ominus> \<one> \<longleftrightarrow> x = \<ominus> \<one>"
  12.768 +  apply auto
  12.769 +  apply (subst Units_inv_inv [symmetric])
  12.770 +   apply auto
  12.771 +  done
  12.772 +
  12.773 +lemma (in monoid) inv_eq_one_eq: "x \<in> Units G \<Longrightarrow> inv x = \<one> \<longleftrightarrow> x = \<one>"
  12.774 +  by (metis Units_inv_inv inv_one)
  12.775 +
  12.776  end
    13.1 --- a/src/HOL/Algebra/Sylow.thy	Thu Jun 14 15:45:53 2018 +0200
    13.2 +++ b/src/HOL/Algebra/Sylow.thy	Thu Jun 14 15:20:20 2018 +0100
    13.3 @@ -189,7 +189,7 @@
    13.4    using rcosetGM1g_subset_G finite_G M1_subset_G cosets_finite rcosetsI by blast
    13.5  
    13.6  lemma M1_cardeq_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> card (M1 #> g) = card M1"
    13.7 -  by (simp add: card_cosets_equal rcosetsI)
    13.8 +  by (metis M1_subset_G card_rcosets_equal rcosetsI)
    13.9  
   13.10  lemma M1_RelM_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> (M1, M1 #> g) \<in> RelM"
   13.11    apply (simp add: RelM_def calM_def card_M1)
   13.12 @@ -223,7 +223,7 @@
   13.13  
   13.14  lemma M_funcset_rcosets_H:
   13.15    "(\<lambda>x\<in>M. H #> (SOME g. g \<in> carrier G \<and> M1 #> g = x)) \<in> M \<rightarrow> rcosets H"
   13.16 -  by (metis (lifting) H_is_subgroup M_elem_map_carrier rcosetsI restrictI subgroup_imp_subset)
   13.17 +  by (metis (lifting) H_is_subgroup M_elem_map_carrier rcosetsI restrictI subgroup.subset)
   13.18  
   13.19  lemma inj_M_GmodH: "\<exists>f \<in> M \<rightarrow> rcosets H. inj_on f M"
   13.20    apply (rule bexI)
    14.1 --- a/src/HOL/Algebra/UnivPoly.thy	Thu Jun 14 15:45:53 2018 +0200
    14.2 +++ b/src/HOL/Algebra/UnivPoly.thy	Thu Jun 14 15:20:20 2018 +0100
    14.3 @@ -116,14 +116,15 @@
    14.4  proof
    14.5    assume R: "p \<in> up R"
    14.6    then obtain n where "bound \<zero> n p" by auto
    14.7 -  then have "bound \<zero> n (\<lambda>i. \<ominus> p i)" by auto
    14.8 +  then have "bound \<zero> n (\<lambda>i. \<ominus> p i)"
    14.9 +    by (simp add: bound_def minus_equality)
   14.10    then show "\<exists>n. bound \<zero> n (\<lambda>i. \<ominus> p i)" by auto
   14.11  qed auto
   14.12  
   14.13  lemma up_minus_closed:
   14.14    "[| p \<in> up R; q \<in> up R |] ==> (\<lambda>i. p i \<ominus> q i) \<in> up R"
   14.15 -  using mem_upD [of p R] mem_upD [of q R] up_add_closed up_a_inv_closed a_minus_def [of _ R]
   14.16 -  by auto
   14.17 +  unfolding a_minus_def
   14.18 +  using mem_upD [of p R] mem_upD [of q R] up_add_closed up_a_inv_closed  by auto
   14.19  
   14.20  lemma up_mult_closed:
   14.21    "[| p \<in> up R; q \<in> up R |] ==>
   14.22 @@ -695,7 +696,7 @@
   14.23  
   14.24  lemma monom_a_inv [simp]:
   14.25    "a \<in> carrier R ==> monom P (\<ominus> a) n = \<ominus>\<^bsub>P\<^esub> monom P a n"
   14.26 -  by (rule up_eqI) simp_all
   14.27 +  by (rule up_eqI) auto
   14.28  
   14.29  lemma monom_inj:
   14.30    "inj_on (\<lambda>a. monom P a n) (carrier R)"
   14.31 @@ -1462,9 +1463,9 @@
   14.32  subsection\<open>The long division algorithm: some previous facts.\<close>
   14.33  
   14.34  lemma coeff_minus [simp]:
   14.35 -  assumes p: "p \<in> carrier P" and q: "q \<in> carrier P" shows "coeff P (p \<ominus>\<^bsub>P\<^esub> q) n = coeff P p n \<ominus> coeff P q n"
   14.36 -  unfolding a_minus_def [OF p q] unfolding coeff_add [OF p a_inv_closed [OF q]] unfolding coeff_a_inv [OF q]
   14.37 -  using coeff_closed [OF p, of n] using coeff_closed [OF q, of n] by algebra
   14.38 +  assumes p: "p \<in> carrier P" and q: "q \<in> carrier P" 
   14.39 +  shows "coeff P (p \<ominus>\<^bsub>P\<^esub> q) n = coeff P p n \<ominus> coeff P q n"
   14.40 +  by (simp add: a_minus_def p q)
   14.41  
   14.42  lemma lcoeff_closed [simp]: assumes p: "p \<in> carrier P" shows "lcoeff p \<in> carrier R"
   14.43    using coeff_closed [OF p, of "deg R p"] by simp
   14.44 @@ -1719,10 +1720,7 @@
   14.45      and min_mon0_closed: "\<ominus>\<^bsub>P\<^esub> monom P a 0 \<in> carrier P"
   14.46      using a R.a_inv_closed by auto
   14.47    have "eval R R id a ?g = eval R R id a (monom P \<one> 1) \<ominus> eval R R id a (monom P a 0)"
   14.48 -    unfolding P.minus_eq [OF mon1_closed mon0_closed]
   14.49 -    unfolding hom_add [OF mon1_closed min_mon0_closed]
   14.50 -    unfolding hom_a_inv [OF mon0_closed]
   14.51 -    using R.minus_eq [symmetric] mon1_closed mon0_closed by auto
   14.52 +    by (simp add: a_minus_def mon0_closed)
   14.53    also have "\<dots> = a \<ominus> a"
   14.54      using eval_monom [OF R.one_closed a, of 1] using eval_monom [OF a a, of 0] using a by simp
   14.55    also have "\<dots> = \<zero>"
    15.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    15.2 +++ b/src/HOL/Algebra/Zassenhaus.thy	Thu Jun 14 15:20:20 2018 +0100
    15.3 @@ -0,0 +1,633 @@
    15.4 +theory Zassenhaus
    15.5 +  imports Coset Group_Action
    15.6 +begin
    15.7 +
    15.8 +
    15.9 +subsubsection \<open>Lemmas about normalizer\<close>
   15.10 +
   15.11 +
   15.12 +lemma (in group) subgroup_in_normalizer: 
   15.13 +  assumes "subgroup H G"
   15.14 +  shows "normal H (G\<lparr>carrier:= (normalizer G H)\<rparr>)"
   15.15 +proof(intro group.normal_invI)
   15.16 +  show "Group.group (G\<lparr>carrier := normalizer G H\<rparr>)"
   15.17 +    by (simp add: assms group.normalizer_imp_subgroup is_group subgroup_imp_group subgroup_imp_subset)
   15.18 +  have K:"H \<subseteq> (normalizer G H)" unfolding normalizer_def
   15.19 +  proof
   15.20 +    fix x assume xH: "x \<in> H"
   15.21 +    from xH have xG : "x \<in> carrier G" using subgroup_imp_subset assms by auto
   15.22 +    have "x <# H = H"
   15.23 +      by (metis \<open>x \<in> H\<close> assms group.lcos_mult_one is_group
   15.24 +         l_repr_independence one_closed subgroup_imp_subset)
   15.25 +    moreover have "H #> inv x = H" 
   15.26 +      by (simp add: xH assms is_group subgroup.rcos_const subgroup.m_inv_closed)
   15.27 +    ultimately have "x <# H #> (inv x) = H" by simp
   15.28 +    thus " x \<in> stabilizer G (\<lambda>g. \<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) H"
   15.29 +      using assms xG subgroup_imp_subset unfolding stabilizer_def by auto
   15.30 +  qed
   15.31 +  thus "subgroup H (G\<lparr>carrier:= (normalizer G H)\<rparr>)"
   15.32 +    using subgroup_incl normalizer_imp_subgroup assms by (simp add: subgroup_imp_subset)
   15.33 +  show  " \<And>x h. x \<in> carrier (G\<lparr>carrier := normalizer G H\<rparr>) \<Longrightarrow> h \<in> H \<Longrightarrow>
   15.34 +             x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h
   15.35 +               \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x \<in> H"
   15.36 +    proof-
   15.37 +    fix x h assume xnorm : "x \<in> carrier (G\<lparr>carrier := normalizer G H\<rparr>)" and hH : "h \<in> H"
   15.38 +    have xnormalizer:"x \<in> normalizer G H" using xnorm by simp
   15.39 +    moreover have hnormalizer:"h \<in> normalizer G H" using hH K by auto
   15.40 +    ultimately have "x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h = x \<otimes> h" by simp
   15.41 +    moreover have " inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x =  inv x"
   15.42 +      using xnormalizer
   15.43 +      by (simp add: assms normalizer_imp_subgroup subgroup_imp_subset subgroup_inv_equality)
   15.44 +    ultimately  have xhxegal: "x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h
   15.45 +                \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x
   15.46 +                  = x \<otimes>h \<otimes> inv x"
   15.47 +      using  hnormalizer by simp
   15.48 +    have  "x \<otimes>h \<otimes> inv x \<in> (x <# H #> inv x)"
   15.49 +      unfolding l_coset_def r_coset_def using hH  by auto
   15.50 +    moreover have "x <# H #> inv x = H"
   15.51 +      using xnormalizer assms subgroup_imp_subset[OF assms]
   15.52 +      unfolding normalizer_def stabilizer_def by auto
   15.53 +    ultimately have "x \<otimes>h \<otimes> inv x \<in> H" by simp
   15.54 +    thus  " x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h
   15.55 +               \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x \<in> H"
   15.56 +      using xhxegal hH xnorm by simp
   15.57 +  qed
   15.58 +qed
   15.59 +
   15.60 +
   15.61 +lemma (in group) normal_imp_subgroup_normalizer:
   15.62 +  assumes "subgroup H G"
   15.63 +    and "N \<lhd> (G\<lparr>carrier := H\<rparr>)"
   15.64 +  shows "subgroup H (G\<lparr>carrier := normalizer G N\<rparr>)" 
   15.65 +proof-
   15.66 +  have N_carrierG : "N \<subseteq> carrier(G)"
   15.67 +    using assms normal_imp_subgroup subgroup_imp_subset
   15.68 +    by (smt monoid.cases_scheme order_trans partial_object.simps(1) partial_object.update_convs(1))
   15.69 +  {have "H \<subseteq> normalizer G N" unfolding normalizer_def stabilizer_def
   15.70 +    proof
   15.71 +      fix x assume xH : "x \<in> H"
   15.72 +      hence xcarrierG : "x \<in> carrier(G)" using assms subgroup_imp_subset  by auto
   15.73 +      have "   N #> x = x <# N" using assms xH
   15.74 +        unfolding r_coset_def l_coset_def normal_def normal_axioms_def subgroup_imp_group by auto
   15.75 +      hence "x <# N #> inv x =(N #> x) #> inv x"
   15.76 +        by simp
   15.77 +      also have "... = N #> \<one>"
   15.78 +        using  assms r_inv xcarrierG coset_mult_assoc[OF N_carrierG] by simp  
   15.79 +      finally have "x <# N #> inv x = N" by (simp add: N_carrierG)
   15.80 +      thus "x \<in> {g \<in> carrier G. (\<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) N = N}"
   15.81 +        using xcarrierG by (simp add : N_carrierG)
   15.82 +    qed}
   15.83 +  thus "subgroup H (G\<lparr>carrier := normalizer G N\<rparr>)"
   15.84 +    using subgroup_incl[OF assms(1) normalizer_imp_subgroup]
   15.85 +      assms normal_imp_subgroup subgroup_imp_subset
   15.86 +    by (metis  group.incl_subgroup is_group)
   15.87 +qed
   15.88 +
   15.89 +
   15.90 +subsection \<open>Second Isomorphism Theorem\<close>
   15.91 +
   15.92 +lemma (in group) mult_norm_subgroup:
   15.93 +  assumes "normal N G"
   15.94 +    and "subgroup H G"
   15.95 +  shows "subgroup (N<#>H) G" unfolding subgroup_def
   15.96 +proof-
   15.97 +  have  A :"N <#> H \<subseteq> carrier G"
   15.98 +    using assms  setmult_subset_G by (simp add: normal_imp_subgroup subgroup_imp_subset)
   15.99 +
  15.100 +  have B :"\<And> x y. \<lbrakk>x \<in> (N <#> H); y \<in> (N <#> H)\<rbrakk> \<Longrightarrow> (x \<otimes> y) \<in> (N<#>H)"
  15.101 +  proof-
  15.102 +    fix x y assume B1a: "x \<in> (N <#> H)"  and B1b: "y \<in> (N <#> H)"
  15.103 +    obtain n1 h1 where B2:"n1 \<in> N \<and> h1 \<in> H \<and> n1\<otimes>h1 = x"
  15.104 +      using set_mult_def B1a by (metis (no_types, lifting) UN_E singletonD)
  15.105 +    obtain n2 h2 where B3:"n2 \<in> N \<and> h2 \<in> H \<and> n2\<otimes>h2 = y"
  15.106 +      using set_mult_def B1b by (metis (no_types, lifting) UN_E singletonD)
  15.107 +    have "N #> h1 = h1 <# N"
  15.108 +      using normalI B2 assms normal.coset_eq subgroup_imp_subset by blast
  15.109 +    hence "h1\<otimes>n2 \<in> N #> h1" 
  15.110 +      using B2 B3 assms l_coset_def by fastforce
  15.111 +    from this obtain y2 where y2_def:"y2 \<in> N" and y2_prop:"y2\<otimes>h1 = h1\<otimes>n2" 
  15.112 +      using singletonD by (metis (no_types, lifting) UN_E r_coset_def) 
  15.113 +    have " x\<otimes>y =  n1 \<otimes> y2 \<otimes> h1 \<otimes> h2" using y2_def B2 B3
  15.114 +      by (smt assms y2_prop m_assoc m_closed normal_imp_subgroup subgroup.mem_carrier)
  15.115 +    moreover have B4 :"n1 \<otimes> y2 \<in>N"
  15.116 +      using B2 y2_def assms normal_imp_subgroup by (metis subgroup_def)
  15.117 +    moreover have "h1 \<otimes> h2 \<in>H" using B2 B3 assms by (simp add: subgroup.m_closed)
  15.118 +    hence "(n1 \<otimes> y2) \<otimes> (h1 \<otimes> h2) \<in>(N<#>H) "
  15.119 +      using B4  unfolding set_mult_def by auto
  15.120 +    hence "n1 \<otimes> y2 \<otimes> h1 \<otimes> h2 \<in>(N<#>H)"
  15.121 +      using m_assoc B2 B3 assms  normal_imp_subgroup by (metis B4 subgroup.mem_carrier)
  15.122 +    ultimately show  "x \<otimes> y \<in> N <#> H" by auto
  15.123 +  qed
  15.124 +  have C :"\<And> x. x\<in>(N<#>H)  \<Longrightarrow> (inv x)\<in>(N<#>H)"
  15.125 +
  15.126 +  proof-
  15.127 +    fix x assume C1 : "x \<in> (N<#>H)"
  15.128 +    obtain n h where C2:"n \<in> N \<and> h \<in> H \<and> n\<otimes>h = x"
  15.129 +      using set_mult_def C1 by (metis (no_types, lifting) UN_E singletonD)
  15.130 +    have C3 :"inv(n\<otimes>h) = inv(h)\<otimes>inv(n)"
  15.131 +      by (meson C2  assms inv_mult_group normal_imp_subgroup subgroup.mem_carrier)
  15.132 +    hence "... \<otimes>h \<in> N"
  15.133 +      using assms C2
  15.134 +      by (meson normal.inv_op_closed1 normal_def subgroup.m_inv_closed subgroup.mem_carrier)
  15.135 +    hence  C4:"(inv h \<otimes> inv n \<otimes> h) \<otimes> inv h \<in> (N<#>H)" 
  15.136 +      using   C2 assms subgroup.m_inv_closed[of H G h] unfolding set_mult_def by auto
  15.137 +    have "inv h \<otimes> inv n \<otimes> h \<otimes> inv h = inv h \<otimes> inv n"
  15.138 +      using  subgroup_imp_subset[OF assms(2)] 
  15.139 +      by (metis A C1 C2 C3 inv_closed inv_solve_right m_closed subsetCE)
  15.140 +    thus "inv(x)\<in>N<#>H" using C4 C2 C3 by simp
  15.141 +  qed
  15.142 +
  15.143 +  have D : "\<one> \<in> N <#> H"
  15.144 +  proof-
  15.145 +    have D1 : "\<one> \<in> N"
  15.146 +      using assms by (simp add: normal_def subgroup.one_closed)
  15.147 +     have D2 :"\<one> \<in> H"
  15.148 +      using assms by (simp add: subgroup.one_closed)
  15.149 +    thus "\<one> \<in> (N <#> H)"
  15.150 +      using set_mult_def D1 assms by fastforce
  15.151 +  qed
  15.152 +  thus "(N <#> H \<subseteq> carrier G \<and> (\<forall>x y. x \<in> N <#> H \<longrightarrow> y \<in> N <#> H \<longrightarrow> x \<otimes> y \<in> N <#> H)) \<and>
  15.153 +    \<one> \<in> N <#> H \<and> (\<forall>x. x \<in> N <#> H \<longrightarrow> inv x \<in> N <#> H)" using A B C D assms by blast
  15.154 +qed
  15.155 +    
  15.156 +
  15.157 +lemma (in group) mult_norm_sub_in_sub:
  15.158 +  assumes "normal N (G\<lparr>carrier:=K\<rparr>)"
  15.159 +  assumes "subgroup H (G\<lparr>carrier:=K\<rparr>)"
  15.160 +  assumes "subgroup K G"
  15.161 +  shows  "subgroup (N<#>H) (G\<lparr>carrier:=K\<rparr>)"
  15.162 +proof-
  15.163 +  have Hyp:"subgroup (N <#>\<^bsub>G\<lparr>carrier := K\<rparr>\<^esub> H) (G\<lparr>carrier := K\<rparr>)"
  15.164 +    using group.mult_norm_subgroup[where ?G = "G\<lparr>carrier := K\<rparr>"] assms subgroup_imp_group by auto
  15.165 +  have "H \<subseteq> carrier(G\<lparr>carrier := K\<rparr>)" using assms subgroup_imp_subset by blast
  15.166 +  also have "... \<subseteq> K" by simp
  15.167 +  finally have Incl1:"H \<subseteq> K" by simp
  15.168 +  have "N \<subseteq> carrier(G\<lparr>carrier := K\<rparr>)" using assms normal_imp_subgroup subgroup_imp_subset by blast
  15.169 +  also have "... \<subseteq> K" by simp
  15.170 +  finally have Incl2:"N \<subseteq> K" by simp
  15.171 +  have "(N <#>\<^bsub>G\<lparr>carrier := K\<rparr>\<^esub> H) = (N <#> H)"
  15.172 +    using subgroup_set_mult_equality[of K] assms Incl1 Incl2 by simp
  15.173 +  thus "subgroup (N<#>H) (G\<lparr>carrier:=K\<rparr>)" using Hyp by auto
  15.174 +qed
  15.175 +
  15.176 +
  15.177 +lemma (in group) subgroup_of_normal_set_mult:
  15.178 +  assumes "normal N G"
  15.179 +and "subgroup H G"
  15.180 +shows "subgroup H (G\<lparr>carrier := N <#> H\<rparr>)"
  15.181 +proof-
  15.182 +  have "\<one> \<in> N" using normal_imp_subgroup assms(1) subgroup_def by blast
  15.183 +  hence "\<one> <# H \<subseteq> N <#> H" unfolding set_mult_def l_coset_def by blast
  15.184 +  hence H_incl : "H \<subseteq> N <#> H"
  15.185 +    by (metis assms(2) lcos_mult_one subgroup_def)
  15.186 +  show "subgroup H (G\<lparr>carrier := N <#> H\<rparr>)"
  15.187 +  using subgroup_incl[OF assms(2) mult_norm_subgroup[OF assms(1) assms(2)] H_incl] .
  15.188 +qed
  15.189 +
  15.190 +
  15.191 +lemma (in group) normal_in_normal_set_mult:
  15.192 +  assumes "normal N G"
  15.193 +and "subgroup H G"
  15.194 +shows "normal N (G\<lparr>carrier := N <#> H\<rparr>)"
  15.195 +proof-
  15.196 +  have "\<one> \<in> H" using  assms(2) subgroup_def by blast
  15.197 +  hence "N #> \<one>  \<subseteq> N <#> H" unfolding set_mult_def r_coset_def by blast
  15.198 +  hence N_incl : "N \<subseteq> N <#> H"
  15.199 +    by (metis assms(1) normal_imp_subgroup coset_mult_one subgroup_def)
  15.200 +  thus "normal N (G\<lparr>carrier := N <#> H\<rparr>)"
  15.201 +    using normal_inter_subgroup[OF mult_norm_subgroup[OF assms] assms(1)]
  15.202 +    by (simp add : inf_absorb1)
  15.203 +qed
  15.204 +
  15.205 +
  15.206 +proposition (in group) weak_snd_iso_thme:
  15.207 +  assumes "subgroup  H G" 
  15.208 +    and "N\<lhd>G"
  15.209 +  shows "(G\<lparr>carrier := N<#>H\<rparr> Mod N \<cong> G\<lparr>carrier:=H\<rparr> Mod (N\<inter>H))"
  15.210 +proof-
  15.211 +  define f where "f =  (#>) N"
  15.212 +  have GroupNH : "Group.group (G\<lparr>carrier := N<#>H\<rparr>)"
  15.213 +    using subgroup_imp_group assms mult_norm_subgroup by simp
  15.214 +  have  HcarrierNH :"H \<subseteq> carrier(G\<lparr>carrier := N<#>H\<rparr>)"
  15.215 +    using assms subgroup_of_normal_set_mult subgroup_imp_subset by blast
  15.216 +  hence HNH :"H \<subseteq> N<#>H" by simp
  15.217 +  have op_hom : "f \<in> hom (G\<lparr>carrier := H\<rparr>) (G\<lparr>carrier := N <#> H\<rparr> Mod N)" unfolding hom_def
  15.218 +  proof
  15.219 +    have "\<And>x . x \<in> carrier (G\<lparr>carrier :=H\<rparr>) \<Longrightarrow>
  15.220 +       (#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N x \<in>  carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
  15.221 +    proof-
  15.222 +      fix x assume  "x \<in> carrier (G\<lparr>carrier :=H\<rparr>)"
  15.223 +      hence xH : "x \<in> H" by simp
  15.224 +      hence "(#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N x \<in> rcosets\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub> N"
  15.225 +        using HcarrierNH RCOSETS_def[where ?G = "G\<lparr>carrier := N <#> H\<rparr>"] by blast
  15.226 +      thus "(#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N x \<in>  carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
  15.227 +        unfolding FactGroup_def by simp
  15.228 +    qed
  15.229 +    hence "(#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N \<in> carrier (G\<lparr>carrier :=H\<rparr>) \<rightarrow>
  15.230 +            carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)" by auto
  15.231 +    hence "f \<in> carrier (G\<lparr>carrier :=H\<rparr>) \<rightarrow> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
  15.232 +      unfolding r_coset_def f_def  by simp
  15.233 +    moreover have "\<And>x y. x\<in>carrier (G\<lparr>carrier := H\<rparr>) \<Longrightarrow> y\<in>carrier (G\<lparr>carrier := H\<rparr>) \<Longrightarrow>
  15.234 +                  f (x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y) =  f(x) \<otimes>\<^bsub>G\<lparr>carrier := N <#> H\<rparr> Mod N\<^esub> f(y)"
  15.235 +    proof-
  15.236 +      fix x y assume "x\<in>carrier (G\<lparr>carrier := H\<rparr>)" "y\<in>carrier (G\<lparr>carrier := H\<rparr>)"
  15.237 +      hence xHyH :"x \<in> H" "y \<in> H" by auto
  15.238 +      have Nxeq :"N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x = N #>x" unfolding r_coset_def by simp
  15.239 +      have Nyeq :"N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y = N #>y" unfolding r_coset_def by simp
  15.240 +
  15.241 +      have "x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y =x \<otimes>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y" by simp
  15.242 +      hence "N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y
  15.243 +             = N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x \<otimes>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y" by simp
  15.244 +      also have "... = (N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x) <#>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub>
  15.245 +                       (N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y)"
  15.246 +        using normal.rcos_sum[OF normal_in_normal_set_mult[OF assms(2) assms(1)], of x y]
  15.247 +             xHyH assms HcarrierNH by auto
  15.248 +      finally show "f (x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y) =  f(x) \<otimes>\<^bsub>G\<lparr>carrier := N <#> H\<rparr> Mod N\<^esub> f(y)"
  15.249 +        unfolding  FactGroup_def r_coset_def f_def  using Nxeq Nyeq  by auto
  15.250 +    qed
  15.251 +    hence "(\<forall>x\<in>carrier (G\<lparr>carrier := H\<rparr>). \<forall>y\<in>carrier (G\<lparr>carrier := H\<rparr>).
  15.252 +           f (x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y) =  f(x) \<otimes>\<^bsub>G\<lparr>carrier := N <#> H\<rparr> Mod N\<^esub> f(y))" by blast
  15.253 +    ultimately show  " f \<in> carrier (G\<lparr>carrier := H\<rparr>) \<rightarrow> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N) \<and>
  15.254 +    (\<forall>x\<in>carrier (G\<lparr>carrier := H\<rparr>). \<forall>y\<in>carrier (G\<lparr>carrier := H\<rparr>).
  15.255 +     f (x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y) =  f(x) \<otimes>\<^bsub>G\<lparr>carrier := N <#> H\<rparr> Mod N\<^esub> f(y))"
  15.256 +      by auto
  15.257 +  qed
  15.258 +  hence homomorphism : "group_hom (G\<lparr>carrier := H\<rparr>) (G\<lparr>carrier := N <#> H\<rparr> Mod N) f"
  15.259 +    unfolding group_hom_def group_hom_axioms_def using subgroup_imp_group[OF assms(1)]
  15.260 +             normal.factorgroup_is_group[OF normal_in_normal_set_mult[OF assms(2) assms(1)]] by auto
  15.261 +  moreover have im_f :  "(f  ` carrier(G\<lparr>carrier:=H\<rparr>)) = carrier(G\<lparr>carrier := N <#> H\<rparr> Mod N)"
  15.262 +  proof
  15.263 +    show  "f ` carrier (G\<lparr>carrier := H\<rparr>) \<subseteq> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
  15.264 +      using op_hom unfolding hom_def using funcset_image by blast
  15.265 +  next
  15.266 +    show "carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N) \<subseteq> f ` carrier (G\<lparr>carrier := H\<rparr>)"
  15.267 +    proof
  15.268 +      fix x assume p : " x \<in> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
  15.269 +      hence "x \<in> \<Union>{y. \<exists>x\<in>carrier (G\<lparr>carrier := N <#> H\<rparr>). y = {N #>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub> x}}"
  15.270 +        unfolding FactGroup_def RCOSETS_def by auto
  15.271 +      hence hyp :"\<exists>y. \<exists>h\<in>carrier (G\<lparr>carrier := N <#> H\<rparr>). y = {N #>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub> h} \<and> x \<in> y"
  15.272 +        using Union_iff by blast
  15.273 +      from hyp obtain nh where nhNH:"nh \<in>carrier (G\<lparr>carrier := N <#> H\<rparr>)"
  15.274 +                          and "x \<in> {N #>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub> nh}"
  15.275 +        by blast
  15.276 +      hence K: "x = (#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N nh" by simp
  15.277 +      have "nh \<in> N <#> H" using nhNH by simp
  15.278 +      from this obtain n h where nN : "n \<in> N" and hH : " h \<in> H" and nhnh: "n \<otimes> h = nh"
  15.279 +        unfolding set_mult_def by blast
  15.280 +      have  "x = (#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N (n \<otimes> h)" using K nhnh by simp
  15.281 +      hence  "x = (#>) N (n \<otimes> h)" using K nhnh unfolding r_coset_def by auto
  15.282 +      also have "... = (N #> n) #>h"
  15.283 +        using coset_mult_assoc hH nN assms subgroup_imp_subset normal_imp_subgroup
  15.284 +        by (metis subgroup.mem_carrier)
  15.285 +      finally have "x = (#>) N h"
  15.286 +        using coset_join2[of n N] nN assms by (simp add: normal_imp_subgroup subgroup.mem_carrier)
  15.287 +      thus "x \<in> f ` carrier (G\<lparr>carrier := H\<rparr>)" using hH unfolding f_def by simp
  15.288 +    qed
  15.289 +  qed
  15.290 +  moreover have ker_f :"kernel (G\<lparr>carrier := H\<rparr>) (G\<lparr>carrier := N<#>H\<rparr> Mod N) f  = N\<inter>H"
  15.291 +    unfolding kernel_def f_def
  15.292 +    proof-
  15.293 +      have "{x \<in> carrier (G\<lparr>carrier := H\<rparr>). N #> x = \<one>\<^bsub>G\<lparr>carrier := N <#> H\<rparr> Mod N\<^esub>} =
  15.294 +            {x \<in> carrier (G\<lparr>carrier := H\<rparr>). N #> x = N}" unfolding FactGroup_def by simp
  15.295 +      also have "... = {x \<in> carrier (G\<lparr>carrier := H\<rparr>). x \<in> N}"
  15.296 +        using coset_join1
  15.297 +        by (metis (no_types, lifting) assms group.subgroup_self incl_subgroup is_group
  15.298 +          normal_imp_subgroup subgroup.mem_carrier subgroup.rcos_const subgroup_imp_group)
  15.299 +      also have "... =N \<inter> (carrier(G\<lparr>carrier := H\<rparr>))" by auto
  15.300 +      finally show "{x \<in> carrier (G\<lparr>carrier := H\<rparr>). N#>x = \<one>\<^bsub>G\<lparr>carrier := N <#> H\<rparr> Mod N\<^esub>} = N \<inter> H"
  15.301 +        by simp
  15.302 +    qed
  15.303 +    ultimately have "(G\<lparr>carrier := H\<rparr> Mod N \<inter> H) \<cong> (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
  15.304 +      using group_hom.FactGroup_iso[OF homomorphism im_f] by auto
  15.305 +    hence "G\<lparr>carrier := N <#> H\<rparr> Mod N \<cong> G\<lparr>carrier := H\<rparr> Mod N \<inter> H"
  15.306 +      by (simp add: group.iso_sym assms normal.factorgroup_is_group normal_inter_subgroup)
  15.307 +    thus "G\<lparr>carrier := N <#> H\<rparr> Mod N \<cong> G\<lparr>carrier := H\<rparr> Mod N \<inter> H" by auto
  15.308 +qed
  15.309 +
  15.310 +
  15.311 +theorem (in group) snd_iso_thme:
  15.312 +  assumes "subgroup H G"
  15.313 +    and "subgroup N G"
  15.314 +    and "subgroup H (G\<lparr>carrier:= (normalizer G N)\<rparr>)"
  15.315 +  shows "(G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong> (G\<lparr>carrier:= H\<rparr> Mod (H\<inter>N))"
  15.316 +proof-
  15.317 +  have "G\<lparr>carrier := normalizer G N, carrier := H\<rparr>
  15.318 +       = G\<lparr>carrier := H\<rparr>"  by simp
  15.319 +  hence "G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H =
  15.320 +         G\<lparr>carrier := H\<rparr> Mod N \<inter> H" by auto
  15.321 +  moreover have "G\<lparr>carrier := normalizer G N,
  15.322 +                    carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> =
  15.323 +                G\<lparr>carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr>" by simp
  15.324 +  hence "G\<lparr>carrier := normalizer G N,
  15.325 +          carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N =
  15.326 +          G\<lparr>carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N" by auto
  15.327 +  hence "G\<lparr>carrier := normalizer G N,
  15.328 +          carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N  \<cong>
  15.329 +         G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H =
  15.330 +          (G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong>
  15.331 +         G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H" 
  15.332 +    using subgroup_set_mult_equality[OF  normalizer_imp_subgroup[OF subgroup_imp_subset[OF assms(2)]], of N H] 
  15.333 +          subgroup_imp_subset[OF assms(3)]
  15.334 +          subgroup_imp_subset[OF normal_imp_subgroup[OF subgroup_in_normalizer[OF assms(2)]]]
  15.335 +    by simp
  15.336 +  ultimately have "G\<lparr>carrier := normalizer G N,
  15.337 +                    carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N  \<cong>
  15.338 +                  G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H =
  15.339 +                 (G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong>  G\<lparr>carrier := H\<rparr> Mod N \<inter> H" by auto
  15.340 +  moreover have "G\<lparr>carrier := normalizer G N,
  15.341 +                    carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N  \<cong>
  15.342 +                  G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H"
  15.343 +    using group.weak_snd_iso_thme[OF subgroup_imp_group[OF normalizer_imp_subgroup[OF
  15.344 +          subgroup_imp_subset[OF assms(2)]]] assms(3) subgroup_in_normalizer[OF assms(2)]]
  15.345 +    by simp
  15.346 +  moreover have "H\<inter>N = N\<inter>H" using assms  by auto
  15.347 +  ultimately show "(G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong>  G\<lparr>carrier := H\<rparr> Mod H \<inter> N" by auto
  15.348 +qed
  15.349 + 
  15.350 +
  15.351 +corollary (in group) snd_iso_thme_recip :
  15.352 +  assumes "subgroup H G"
  15.353 +    and "subgroup N G"
  15.354 +    and "subgroup H (G\<lparr>carrier:= (normalizer G N)\<rparr>)"
  15.355 +  shows "(G\<lparr>carrier:= H<#>N\<rparr> Mod N)  \<cong> (G\<lparr>carrier:= H\<rparr> Mod (H\<inter>N))"
  15.356 +  by (metis assms commut_normal_subgroup group.subgroup_in_normalizer is_group subgroup_imp_subset
  15.357 +      normalizer_imp_subgroup snd_iso_thme)
  15.358 +
  15.359 +
  15.360 +subsection\<open>The Zassenhaus Lemma\<close>
  15.361 +
  15.362 +
  15.363 +lemma (in group) distinc:
  15.364 +  assumes "subgroup  H G" 
  15.365 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
  15.366 +    and  "subgroup K G" 
  15.367 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
  15.368 +  shows "subgroup (H\<inter>K) (G\<lparr>carrier:=(normalizer G (H1<#>(H\<inter>K1))) \<rparr>)"
  15.369 +proof (intro subgroup_incl[OF subgroups_Inter_pair[OF assms(1) assms(3)]])
  15.370 +  show "subgroup (normalizer G (H1 <#> H \<inter> K1)) G"
  15.371 +    using normalizer_imp_subgroup assms normal_imp_subgroup subgroup_imp_subset
  15.372 +    by (metis group.incl_subgroup is_group setmult_subset_G subgroups_Inter_pair)
  15.373 +next
  15.374 +  show "H \<inter> K \<subseteq> normalizer G (H1 <#> H \<inter> K1)" unfolding normalizer_def stabilizer_def
  15.375 +  proof
  15.376 +    fix x assume xHK : "x \<in> H \<inter> K"
  15.377 +    hence xG : "{x} \<subseteq> carrier G" "{inv x} \<subseteq> carrier G"
  15.378 +      using subgroup_imp_subset assms inv_closed xHK by auto
  15.379 +    have allG : "H \<subseteq> carrier G" "K \<subseteq> carrier G" "H1 \<subseteq> carrier G"  "K1 \<subseteq> carrier G"
  15.380 +      using assms subgroup_imp_subset normal_imp_subgroup incl_subgroup apply blast+ .
  15.381 +    have HK1_normal: "H\<inter>K1 \<lhd> (G\<lparr>carrier :=  H \<inter> K\<rparr>)" using normal_inter[OF assms(3)assms(1)assms(4)]
  15.382 +      by (simp add : inf_commute)
  15.383 +    have "H \<inter> K \<subseteq> normalizer G (H \<inter> K1)"
  15.384 +      using subgroup_imp_subset[OF normal_imp_subgroup_normalizer[OF subgroups_Inter_pair[OF
  15.385 +            assms(1)assms(3)]HK1_normal]] by auto
  15.386 +    hence "x <# (H \<inter> K1) #> inv x = (H \<inter> K1)"
  15.387 +      using xHK subgroup_imp_subset[OF subgroups_Inter_pair[OF assms(1) incl_subgroup[OF assms(3)
  15.388 +                                                            normal_imp_subgroup[OF assms(4)]]]]
  15.389 +      unfolding normalizer_def stabilizer_def by auto
  15.390 +    moreover have "H \<subseteq>  normalizer G H1"
  15.391 +      using subgroup_imp_subset[OF normal_imp_subgroup_normalizer[OF assms(1)assms(2)]] by auto
  15.392 +    hence "x <# H1 #> inv x = H1"
  15.393 +      using xHK subgroup_imp_subset[OF  incl_subgroup[OF assms(1) normal_imp_subgroup[OF assms(2)]]]
  15.394 +      unfolding normalizer_def stabilizer_def by auto
  15.395 +    ultimately have "H1 <#> H \<inter> K1 = (x <# H1 #> inv x) <#> (x <#  H \<inter> K1 #> inv x)" by auto
  15.396 +    also have "... = ({x} <#> H1) <#> {inv x} <#> ({x} <#>  H \<inter> K1 <#> {inv x})"
  15.397 +      by (simp add : r_coset_eq_set_mult l_coset_eq_set_mult)
  15.398 +    also have "... = ({x} <#> H1 <#> {inv x} <#> {x}) <#>  (H \<inter> K1 <#> {inv x})"
  15.399 +      by (smt Int_lower1 allG xG set_mult_assoc subset_trans setmult_subset_G)
  15.400 +    also have "... = ({x} <#> H1 <#> {\<one>}) <#>  (H \<inter> K1 <#> {inv x})"
  15.401 +      using allG xG coset_mult_assoc by (simp add: r_coset_eq_set_mult setmult_subset_G)
  15.402 +    also have "... =({x} <#> H1) <#>  (H \<inter> K1 <#> {inv x})"
  15.403 +      using coset_mult_one r_coset_eq_set_mult[of G H1 \<one>] set_mult_assoc[OF xG(1) allG(3)] allG
  15.404 +      by auto
  15.405 +    also have "... = {x} <#> (H1 <#> H \<inter> K1) <#> {inv x}"
  15.406 +      using allG xG set_mult_assoc setmult_subset_G by (metis inf.coboundedI2)
  15.407 +    finally have "H1 <#> H \<inter> K1 = x <# (H1 <#> H \<inter> K1) #> inv x" 
  15.408 +      using xG setmult_subset_G allG by (simp add: l_coset_eq_set_mult r_coset_eq_set_mult)
  15.409 +    thus "x \<in> {g \<in> carrier G. (\<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) (H1 <#> H \<inter> K1)
  15.410 +                                                                       = H1 <#> H \<inter> K1}"
  15.411 +      using xG allG setmult_subset_G[OF allG(3), where ?K = "H\<inter>K1"] xHK
  15.412 +      by auto
  15.413 +  qed
  15.414 +qed
  15.415 +
  15.416 +lemma (in group) preliminary1:
  15.417 +  assumes "subgroup  H G" 
  15.418 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
  15.419 +    and  "subgroup K G" 
  15.420 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
  15.421 +  shows " (H\<inter>K) \<inter> (H1<#>(H\<inter>K1)) = (H1\<inter>K)<#>(H\<inter>K1)"
  15.422 +proof
  15.423 +  have all_inclG : "H \<subseteq> carrier G" "H1 \<subseteq> carrier G" "K \<subseteq> carrier G" "K1 \<subseteq> carrier G"
  15.424 +    using assms subgroup_imp_subset normal_imp_subgroup incl_subgroup apply blast+.
  15.425 +  show "H \<inter> K \<inter> (H1 <#> H \<inter> K1) \<subseteq> H1 \<inter> K <#> H \<inter> K1"
  15.426 +  proof
  15.427 +    fix x assume x_def : "x \<in> (H \<inter> K) \<inter> (H1 <#> (H \<inter> K1))"
  15.428 +    from x_def have x_incl : "x \<in> H" "x \<in> K" "x \<in> (H1 <#> (H \<inter> K1))" by auto
  15.429 +    then obtain h1 hk1 where h1hk1_def : "h1 \<in> H1" "hk1 \<in> H \<inter> K1" "h1 \<otimes> hk1 = x"
  15.430 +      using assms unfolding set_mult_def by blast
  15.431 +    hence "hk1 \<in> H \<inter> K" using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(4)]] by auto
  15.432 +    hence "inv hk1 \<in> H \<inter> K" using subgroup.m_inv_closed[OF subgroups_Inter_pair] assms by auto
  15.433 +    moreover have "h1 \<otimes> hk1 \<in> H \<inter> K" using x_incl h1hk1_def by auto
  15.434 +    ultimately have "h1 \<otimes> hk1 \<otimes> inv hk1 \<in> H \<inter> K"
  15.435 +      using subgroup.m_closed[OF subgroups_Inter_pair] assms by auto
  15.436 +    hence "h1 \<in> H \<inter> K" using  h1hk1_def assms subgroup_imp_subset incl_subgroup normal_imp_subgroup
  15.437 +      by (metis Int_iff contra_subsetD inv_solve_right m_closed)
  15.438 +    hence "h1 \<in> H1 \<inter> H \<inter> K" using h1hk1_def by auto
  15.439 +    hence "h1 \<in> H1 \<inter> K" using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(2)]] by auto
  15.440 +    hence "h1 \<otimes> hk1 \<in> (H1\<inter>K)<#>(H\<inter>K1)"
  15.441 +      using h1hk1_def unfolding set_mult_def by auto
  15.442 +    thus " x \<in> (H1\<inter>K)<#>(H\<inter>K1)" using h1hk1_def x_def by auto
  15.443 +  qed
  15.444 +  show "H1 \<inter> K <#> H \<inter> K1 \<subseteq> H \<inter> K \<inter> (H1 <#> H \<inter> K1)"
  15.445 +  proof-
  15.446 +    have "H1 \<inter> K \<subseteq> H \<inter> K" using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(2)]] by auto
  15.447 +    moreover have "H \<inter> K1 \<subseteq> H \<inter> K"
  15.448 +      using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(4)]] by auto
  15.449 +    ultimately have "H1 \<inter> K <#> H \<inter> K1 \<subseteq> H \<inter> K" unfolding set_mult_def
  15.450 +      using subgroup.m_closed[OF subgroups_Inter_pair [OF assms(1)assms(3)]] by blast
  15.451 +    moreover have "H1 \<inter> K \<subseteq> H1" by auto
  15.452 +    hence "H1 \<inter> K <#> H \<inter> K1 \<subseteq> (H1 <#> H \<inter> K1)" unfolding set_mult_def by auto
  15.453 +    ultimately show "H1 \<inter> K <#> H \<inter> K1 \<subseteq> H \<inter> K \<inter> (H1 <#> H \<inter> K1)" by auto
  15.454 +  qed
  15.455 +qed
  15.456 +
  15.457 +lemma (in group) preliminary2:
  15.458 +  assumes "subgroup  H G" 
  15.459 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>"
  15.460 +    and  "subgroup K G" 
  15.461 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
  15.462 +  shows "(H1<#>(H\<inter>K1)) \<lhd> G\<lparr>carrier:=(H1<#>(H\<inter>K))\<rparr>"
  15.463 +proof-
  15.464 +  have all_inclG : "H \<subseteq> carrier G" "H1 \<subseteq> carrier G" "K \<subseteq> carrier G" "K1 \<subseteq> carrier G"
  15.465 +    using assms subgroup_imp_subset normal_imp_subgroup incl_subgroup apply blast+.
  15.466 +  have subH1:"subgroup (H1 <#> H \<inter> K) (G\<lparr>carrier := H\<rparr>)" 
  15.467 +    using mult_norm_sub_in_sub[OF assms(2)subgroup_incl[OF subgroups_Inter_pair[OF assms(1)assms(3)]
  15.468 +          assms(1)]] assms by auto
  15.469 +  have "Group.group (G\<lparr>carrier:=(H1<#>(H\<inter>K))\<rparr>)"
  15.470 +    using  subgroup_imp_group[OF incl_subgroup[OF assms(1) subH1]].
  15.471 +  moreover have subH2 : "subgroup (H1 <#> H \<inter> K1) (G\<lparr>carrier := H\<rparr>)"
  15.472 +    using mult_norm_sub_in_sub[OF assms(2) subgroup_incl[OF subgroups_Inter_pair[OF
  15.473 +           assms(1) incl_subgroup[OF assms(3)normal_imp_subgroup[OF assms(4)]]]]] assms by auto
  15.474 +  hence "(H\<inter>K1) \<subseteq> (H\<inter>K)"
  15.475 +    using assms subgroup_imp_subset normal_imp_subgroup monoid.cases_scheme
  15.476 +    by (metis inf.mono  partial_object.simps(1) partial_object.update_convs(1) subset_refl)
  15.477 +  hence incl:"(H1<#>(H\<inter>K1)) \<subseteq> H1<#>(H\<inter>K)" using assms subgroup_imp_subset normal_imp_subgroup
  15.478 +    unfolding set_mult_def by blast
  15.479 +  hence "subgroup (H1 <#> H \<inter> K1) (G\<lparr>carrier := (H1<#>(H\<inter>K))\<rparr>)"
  15.480 +    using assms subgroup_incl[OF incl_subgroup[OF assms(1)subH2]incl_subgroup[OF assms(1)
  15.481 +          subH1]] normal_imp_subgroup subgroup_imp_subset unfolding set_mult_def by blast
  15.482 +  moreover have " (\<And> x. x\<in>carrier (G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>) \<Longrightarrow>
  15.483 +        H1 <#> H\<inter>K1 #>\<^bsub>G\<lparr>carrier := H1 <#> H\<inter>K\<rparr>\<^esub> x = x <#\<^bsub>G\<lparr>carrier := H1 <#> H\<inter>K\<rparr>\<^esub> (H1 <#> H\<inter>K1))"
  15.484 +  proof-
  15.485 +    fix x assume  "x \<in>carrier (G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>)"
  15.486 +    hence x_def : "x \<in> H1 <#> H \<inter> K" by simp
  15.487 +    from this obtain h1 hk where h1hk_def :"h1 \<in> H1" "hk \<in> H \<inter> K" "h1 \<otimes> hk = x"
  15.488 +      unfolding set_mult_def by blast
  15.489 +    have xH : "x \<in> H" using subgroup_imp_subset[OF subH1] using x_def by auto
  15.490 +    hence allG : "h1 \<in> carrier G" "hk \<in> carrier G" "x \<in> carrier G"
  15.491 +      using assms subgroup_imp_subset h1hk_def normal_imp_subgroup incl_subgroup apply blast+.
  15.492 +    hence "x <#\<^bsub>G\<lparr>carrier := H1 <#> H\<inter>K\<rparr>\<^esub> (H1 <#> H\<inter>K1) =h1 \<otimes> hk <# (H1 <#> H\<inter>K1)"
  15.493 +      using subgroup_set_mult_equality subgroup_imp_subset xH h1hk_def by (simp add: l_coset_def)
  15.494 +    also have "... = h1 <# (hk <# (H1 <#> H\<inter>K1))"
  15.495 +      using lcos_m_assoc[OF subgroup_imp_subset[OF incl_subgroup[OF assms(1) subH1]]allG(1)allG(2)]
  15.496 +      by (metis allG(1) allG(2) assms(1) incl_subgroup lcos_m_assoc subH2 subgroup_imp_subset)
  15.497 +    also have "... = h1 <# (hk <# H1 <#> H\<inter>K1)"
  15.498 +      using set_mult_assoc all_inclG allG by (simp add: l_coset_eq_set_mult inf.coboundedI1)
  15.499 +    also have "... = h1 <# (hk <# H1 #> \<one> <#> H\<inter>K1 #> \<one>)"
  15.500 +      using coset_mult_one allG all_inclG l_coset_subset_G
  15.501 +      by (smt inf_le2 setmult_subset_G subset_trans)
  15.502 +    also have "... = h1 <# (hk <# H1 #> inv hk #> hk <#> H\<inter>K1 #> inv hk #> hk)"
  15.503 +      using all_inclG allG coset_mult_assoc l_coset_subset_G
  15.504 +      by (simp add: inf.coboundedI1 setmult_subset_G)
  15.505 +    finally  have "x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1) =
  15.506 +                    h1 <# ((hk <# H1 #> inv hk) <#> (hk <# H\<inter>K1 #> inv hk) #> hk)"
  15.507 +      using rcos_assoc_lcos allG all_inclG
  15.508 +      by (smt inf_le1 inv_closed l_coset_subset_G r_coset_subset_G setmult_rcos_assoc subset_trans)
  15.509 +    moreover have "H \<subseteq>  normalizer G H1"
  15.510 +      using assms h1hk_def subgroup_imp_subset[OF normal_imp_subgroup_normalizer] by simp
  15.511 +    hence "\<And>g. g \<in> H \<Longrightarrow>  g \<in> {g \<in> carrier G. (\<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) H1 = H1}"
  15.512 +      using all_inclG assms unfolding normalizer_def stabilizer_def by auto
  15.513 +    hence "\<And>g. g \<in> H \<Longrightarrow>  g <# H1 #> inv g = H1" using all_inclG by simp
  15.514 +    hence "(hk <# H1 #> inv hk) = H1" using h1hk_def all_inclG by simp
  15.515 +    moreover have "H\<inter>K \<subseteq> normalizer G (H\<inter>K1)"
  15.516 +      using normal_inter[OF assms(3)assms(1)assms(4)] assms subgroups_Inter_pair
  15.517 +            subgroup_imp_subset[OF normal_imp_subgroup_normalizer] by (simp add: inf_commute)
  15.518 +    hence "\<And>g. g\<in>H\<inter>K \<Longrightarrow> g\<in>{g\<in>carrier G. (\<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) (H\<inter>K1) = H\<inter>K1}"
  15.519 +      using all_inclG assms unfolding normalizer_def stabilizer_def by auto
  15.520 +    hence "\<And>g. g \<in> H\<inter>K \<Longrightarrow>  g <# (H\<inter>K1) #> inv g = H\<inter>K1"
  15.521 +      using subgroup_imp_subset[OF subgroups_Inter_pair[OF assms(1) incl_subgroup[OF
  15.522 +            assms(3)normal_imp_subgroup[OF assms(4)]]]] by auto
  15.523 +    hence "(hk <# H\<inter>K1 #> inv hk) = H\<inter>K1" using h1hk_def by simp
  15.524 +    ultimately have "x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1) = h1 <#(H1 <#> (H \<inter> K1)#> hk)"
  15.525 +      by auto
  15.526 +    also have "... = h1 <# H1 <#> ((H \<inter> K1)#> hk)"
  15.527 +      using set_mult_assoc[where ?M = "{h1}" and ?H = "H1" and ?K = "(H \<inter> K1)#> hk"] allG all_inclG
  15.528 +      by (simp add: l_coset_eq_set_mult inf.coboundedI2 r_coset_subset_G setmult_rcos_assoc)
  15.529 +    also have "... = H1 <#> ((H \<inter> K1)#> hk)"
  15.530 +      using coset_join3 allG incl_subgroup[OF assms(1)normal_imp_subgroup[OF assms(2)]] h1hk_def
  15.531 +      by auto
  15.532 +    finally have eq1 : "x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1) = H1 <#> (H \<inter> K1) #> hk"
  15.533 +      by (simp add: allG(2) all_inclG inf.coboundedI2 setmult_rcos_assoc)
  15.534 +    have "H1 <#> H \<inter> K1 #>\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> x = H1 <#> H \<inter> K1 #> (h1 \<otimes> hk)"
  15.535 +      using subgroup_set_mult_equality subgroup_imp_subset xH h1hk_def by (simp add: r_coset_def)
  15.536 +    also have "... = H1 <#> H \<inter> K1 #> h1 #> hk"
  15.537 +      using coset_mult_assoc by (simp add: allG all_inclG inf.coboundedI2 setmult_subset_G)
  15.538 +    also have"... =  H \<inter> K1 <#> H1 #> h1 #> hk"
  15.539 +      using commut_normal_subgroup[OF assms(1)assms(2)subgroup_incl[OF subgroups_Inter_pair[OF
  15.540 +           assms(1)incl_subgroup[OF assms(3)normal_imp_subgroup[OF assms(4)]]]assms(1)]] by simp
  15.541 +    also have "... = H \<inter> K1 <#> H1  #> hk"
  15.542 +      using coset_join2[OF allG(1)incl_subgroup[OF assms(1)normal_imp_subgroup]
  15.543 +            h1hk_def(1)] all_inclG allG assms by (metis inf.coboundedI2 setmult_rcos_assoc)
  15.544 +    finally  have "H1 <#> H \<inter> K1 #>\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> x =H1 <#> H \<inter> K1  #> hk"
  15.545 +      using commut_normal_subgroup[OF assms(1)assms(2)subgroup_incl[OF subgroups_Inter_pair[OF
  15.546 +           assms(1)incl_subgroup[OF assms(3)normal_imp_subgroup[OF assms(4)]]]assms(1)]] by simp
  15.547 +    thus " H1 <#> H \<inter> K1 #>\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> x = 
  15.548 +             x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1)" using eq1 by simp
  15.549 +  qed
  15.550 +  ultimately show "H1 <#> H \<inter> K1 \<lhd> G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>"
  15.551 +    unfolding normal_def normal_axioms_def by auto
  15.552 +qed
  15.553 +
  15.554 +
  15.555 +proposition (in group)  Zassenhaus_1:
  15.556 +  assumes "subgroup  H G" 
  15.557 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
  15.558 +    and  "subgroup K G" 
  15.559 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
  15.560 +  shows "(G\<lparr>carrier:= H1 <#> (H\<inter>K)\<rparr> Mod (H1<#>H\<inter>K1)) \<cong> (G\<lparr>carrier:= (H\<inter>K)\<rparr> Mod  ((H1\<inter>K)<#>(H\<inter>K1)))"
  15.561 +proof-
  15.562 +  define N  and N1 where "N = (H\<inter>K)" and "N1 =H1<#>(H\<inter>K1)"
  15.563 +  have normal_N_N1 : "subgroup N (G\<lparr>carrier:=(normalizer G N1)\<rparr>)"
  15.564 +    by (simp add: N1_def N_def assms distinc normal_imp_subgroup)
  15.565 +  have Hp:"(G\<lparr>carrier:= N<#>N1\<rparr> Mod N1)  \<cong> (G\<lparr>carrier:= N\<rparr> Mod (N\<inter>N1))"
  15.566 +  by (metis N1_def N_def assms incl_subgroup inf_le1 mult_norm_sub_in_sub
  15.567 +        normal_N_N1 normal_imp_subgroup snd_iso_thme_recip subgroup_incl subgroups_Inter_pair)
  15.568 +  have H_simp: "N<#>N1 = H1<#> (H\<inter>K)"
  15.569 +  proof-
  15.570 +    have H1_incl_G : "H1 \<subseteq> carrier G"
  15.571 +      using assms normal_imp_subgroup incl_subgroup subgroup_imp_subset by blast
  15.572 +    have K1_incl_G :"K1 \<subseteq> carrier G"
  15.573 +      using assms normal_imp_subgroup incl_subgroup subgroup_imp_subset by blast
  15.574 +    have "N<#>N1=  (H\<inter>K)<#> (H1<#>(H\<inter>K1))" by (auto simp add: N_def N1_def)
  15.575 +    also have "... = ((H\<inter>K)<#>H1) <#>(H\<inter>K1)"
  15.576 +      using set_mult_assoc[where ?M = "H\<inter>K"] K1_incl_G H1_incl_G assms
  15.577 +      by (simp add: inf.coboundedI2 subgroup_imp_subset)
  15.578 +    also have "... = (H1<#>(H\<inter>K))<#>(H\<inter>K1)" 
  15.579 +      using commut_normal_subgroup assms subgroup_incl subgroups_Inter_pair by auto
  15.580 +    also have "... =  H1 <#> ((H\<inter>K)<#>(H\<inter>K1))"
  15.581 +      using set_mult_assoc K1_incl_G H1_incl_G assms
  15.582 +      by (simp add: inf.coboundedI2 subgroup_imp_subset)
  15.583 +    also have " ((H\<inter>K)<#>(H\<inter>K1)) = (H\<inter>K)"
  15.584 +    proof (intro set_mult_subgroup_idem[where ?H = "H\<inter>K" and ?N="H\<inter>K1",
  15.585 +             OF subgroups_Inter_pair[OF assms(1) assms(3)]])
  15.586 +      show "subgroup (H \<inter> K1) (G\<lparr>carrier := H \<inter> K\<rparr>)"
  15.587 +        using subgroup_incl[where ?I = "H\<inter>K1" and ?J = "H\<inter>K",OF subgroups_Inter_pair[OF assms(1)
  15.588 +              incl_subgroup[OF assms(3) normal_imp_subgroup]] subgroups_Inter_pair] assms
  15.589 +              normal_imp_subgroup by (metis inf_commute normal_inter)
  15.590 +    qed
  15.591 +    hence " H1 <#> ((H\<inter>K)<#>(H\<inter>K1)) =  H1 <#> ((H\<inter>K))" 
  15.592 +      by simp
  15.593 +    thus "N <#> N1 = H1 <#> H \<inter> K"
  15.594 +      by (simp add: calculation)
  15.595 +  qed
  15.596 +
  15.597 +  have "N\<inter>N1 = (H1\<inter>K)<#>(H\<inter>K1)" 
  15.598 +    using preliminary1 assms N_def N1_def by simp 
  15.599 +  thus  "(G\<lparr>carrier:= H1 <#> (H\<inter>K)\<rparr> Mod N1)  \<cong> (G\<lparr>carrier:= N\<rparr> Mod  ((H1\<inter>K)<#>(H\<inter>K1)))"
  15.600 +    using H_simp Hp by auto
  15.601 +qed
  15.602 +
  15.603 +
  15.604 +theorem (in group) Zassenhaus:
  15.605 +  assumes "subgroup  H G" 
  15.606 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
  15.607 +    and  "subgroup K G" 
  15.608 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
  15.609 +  shows "(G\<lparr>carrier:= H1 <#> (H\<inter>K)\<rparr> Mod (H1<#>(H\<inter>K1)))  \<cong> 
  15.610 +         (G\<lparr>carrier:= K1 <#> (H\<inter>K)\<rparr> Mod (K1<#>(K\<inter>H1)))"
  15.611 +proof-
  15.612 +  define Gmod1 Gmod2 Gmod3 Gmod4
  15.613 +    where "Gmod1 = (G\<lparr>carrier:= H1 <#> (H\<inter>K)\<rparr> Mod (H1<#>(H\<inter>K1))) "
  15.614 +      and "Gmod2 = (G\<lparr>carrier:= K1 <#> (K\<inter>H)\<rparr> Mod (K1<#>(K\<inter>H1)))"
  15.615 +      and "Gmod3 = (G\<lparr>carrier:= (H\<inter>K)\<rparr> Mod  ((H1\<inter>K)<#>(H\<inter>K1)))"
  15.616 +      and "Gmod4 = (G\<lparr>carrier:= (K\<inter>H)\<rparr> Mod  ((K1\<inter>H)<#>(K\<inter>H1)))"
  15.617 +  have Hyp :  "Gmod1  \<cong> Gmod3" "Gmod2  \<cong>  Gmod4"
  15.618 +    using Zassenhaus_1 assms Gmod1_def Gmod2_def Gmod3_def Gmod4_def by auto
  15.619 +  have Hp : "Gmod3 = G\<lparr>carrier:= (K\<inter>H)\<rparr> Mod ((K\<inter>H1)<#>(K1\<inter>H))"
  15.620 +    by (simp add: Gmod3_def inf_commute)
  15.621 +  have "(K\<inter>H1)<#>(K1\<inter>H) = (K1\<inter>H)<#>(K\<inter>H1)"
  15.622 +  proof (intro commut_normal_subgroup[OF subgroups_Inter_pair[OF assms(1)assms(3)]])
  15.623 +    show "K1 \<inter> H \<lhd> G\<lparr>carrier := H \<inter> K\<rparr>"
  15.624 +      using normal_inter[OF assms(3)assms(1)assms(4)] by (simp add: inf_commute)
  15.625 +   next
  15.626 +    show "subgroup (K \<inter> H1) (G\<lparr>carrier := H \<inter> K\<rparr>)" 
  15.627 +      using subgroup_incl by (simp add: assms inf_commute normal_imp_subgroup normal_inter) 
  15.628 +  qed
  15.629 +  hence  "Gmod3  = Gmod4" using Hp Gmod4_def by simp
  15.630 +  hence "Gmod1 \<cong> Gmod2"
  15.631 +    using group.iso_sym group.iso_trans Hyp normal.factorgroup_is_group
  15.632 +    by (metis assms Gmod1_def Gmod2_def preliminary2)
  15.633 +  thus ?thesis using Gmod1_def Gmod2_def by (simp add: inf_commute)
  15.634 +qed
  15.635 +
  15.636 +end
    16.1 --- a/src/HOL/Number_Theory/Residues.thy	Thu Jun 14 15:45:53 2018 +0200
    16.2 +++ b/src/HOL/Number_Theory/Residues.thy	Thu Jun 14 15:20:20 2018 +0100
    16.3 @@ -10,9 +10,6 @@
    16.4  theory Residues
    16.5  imports
    16.6    Cong
    16.7 -  "HOL-Algebra.More_Group"
    16.8 -  "HOL-Algebra.More_Ring"
    16.9 -  "HOL-Algebra.More_Finite_Product"
   16.10    "HOL-Algebra.Multiplicative_Group"
   16.11    Totient
   16.12  begin
   16.13 @@ -355,7 +352,7 @@
   16.14       apply (metis Units_inv_inv)+
   16.15      done
   16.16    also have "\<dots> = \<one>"
   16.17 -    apply (rule finprod_one)
   16.18 +    apply (rule finprod_one_eqI)
   16.19       apply auto
   16.20      apply (subst finprod_insert)
   16.21          apply auto
    17.1 --- a/src/HOL/ROOT	Thu Jun 14 15:45:53 2018 +0200
    17.2 +++ b/src/HOL/ROOT	Thu Jun 14 15:20:20 2018 +0100
    17.3 @@ -294,20 +294,16 @@
    17.4    theories
    17.5      (* Orders and Lattices *)
    17.6      Galois_Connection    (* Knaster-Tarski theorem and Galois connections *)
    17.7 -
    17.8      (* Groups *)
    17.9      FiniteProduct        (* Product operator for commutative groups *)
   17.10      Sylow                (* Sylow's theorem *)
   17.11      Bij                  (* Automorphism Groups *)
   17.12 -    More_Group
   17.13 -    More_Finite_Product
   17.14      Multiplicative_Group
   17.15 -
   17.16 +    Zassenhaus            (* The Zassenhaus lemma *)
   17.17      (* Rings *)
   17.18      Divisibility         (* Rings *)
   17.19      IntRing              (* Ideals and residue classes *)
   17.20      UnivPoly             (* Polynomials *)
   17.21 -    More_Ring
   17.22    document_files "root.bib" "root.tex"
   17.23  
   17.24  session "HOL-Auth" (timing) in Auth = "HOL-Library" +