merged
authorpaulson
Tue Jun 12 16:09:12 2018 +0100 (12 days ago)
changeset 68444ff61cbfb3f2d
parent 68428 46beee72fb66
parent 68443 43055b016688
child 68445 c183a6a69f2d
merged
     1.1 --- a/src/HOL/Algebra/AbelCoset.thy	Tue Jun 12 16:21:52 2018 +0200
     1.2 +++ b/src/HOL/Algebra/AbelCoset.thy	Tue Jun 12 16:09:12 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	Tue Jun 12 16:21:52 2018 +0200
     2.2 +++ b/src/HOL/Algebra/Congruence.thy	Tue Jun 12 16:09:12 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	Tue Jun 12 16:21:52 2018 +0200
     3.2 +++ b/src/HOL/Algebra/Coset.thy	Tue Jun 12 16:09:12 2018 +0100
     3.3 @@ -38,346 +38,325 @@
     3.4    normal_rel :: "['a set, ('a, 'b) monoid_scheme] \<Rightarrow> bool"  (infixl "\<lhd>" 60) where
     3.5    "H \<lhd> G \<equiv> normal H G"
     3.6  
     3.7 +(* ************************************************************************** *)
     3.8 +(* Next two lemmas contributed by Martin Baillon.                                  *)
     3.9 +
    3.10 +lemma l_coset_eq_set_mult:
    3.11 +  fixes G (structure)
    3.12 +  shows "x <# H = {x} <#> H"
    3.13 +  unfolding l_coset_def set_mult_def by simp 
    3.14 +
    3.15 +lemma r_coset_eq_set_mult:
    3.16 +  fixes G (structure)
    3.17 +  shows "H #> x = H <#> {x}"
    3.18 +  unfolding r_coset_def set_mult_def by simp
    3.19 +
    3.20 +(* ************************************************************************** *)
    3.21 +
    3.22 +
    3.23 +(* ************************************************************************** *)
    3.24 +(* Next five lemmas contributed by Paulo Emílio de Vilhena.                    *)
    3.25 +
    3.26 +lemma (in subgroup) rcosets_not_empty:
    3.27 +  assumes "R \<in> rcosets H"
    3.28 +  shows "R \<noteq> {}"
    3.29 +proof -
    3.30 +  obtain g where "g \<in> carrier G" "R = H #> g"
    3.31 +    using assms unfolding RCOSETS_def by blast
    3.32 +  hence "\<one> \<otimes> g \<in> R"
    3.33 +    using one_closed unfolding r_coset_def by blast
    3.34 +  thus ?thesis by blast
    3.35 +qed
    3.36 +
    3.37 +lemma (in group) diff_neutralizes:
    3.38 +  assumes "subgroup H G" "R \<in> rcosets H"
    3.39 +  shows "\<And>r1 r2. \<lbrakk> r1 \<in> R; r2 \<in> R \<rbrakk> \<Longrightarrow> r1 \<otimes> (inv r2) \<in> H"
    3.40 +proof -
    3.41 +  fix r1 r2 assume r1: "r1 \<in> R" and r2: "r2 \<in> R"
    3.42 +  obtain g where g: "g \<in> carrier G" "R = H #> g"
    3.43 +    using assms unfolding RCOSETS_def by blast
    3.44 +  then obtain h1 h2 where h1: "h1 \<in> H" "r1 = h1 \<otimes> g"
    3.45 +                      and h2: "h2 \<in> H" "r2 = h2 \<otimes> g"
    3.46 +    using r1 r2 unfolding r_coset_def by blast
    3.47 +  hence "r1 \<otimes> (inv r2) = (h1 \<otimes> g) \<otimes> ((inv g) \<otimes> (inv h2))"
    3.48 +    using inv_mult_group is_group assms(1) g(1) subgroup.mem_carrier by fastforce 
    3.49 +  also have " ... =  (h1 \<otimes> (g \<otimes> inv g) \<otimes> inv h2)"
    3.50 +    using h1 h2 assms(1) g(1) inv_closed m_closed monoid.m_assoc
    3.51 +          monoid_axioms subgroup.mem_carrier by smt
    3.52 +  finally have "r1 \<otimes> inv r2 = h1 \<otimes> inv h2"
    3.53 +    using assms(1) g(1) h1(1) subgroup.mem_carrier by fastforce
    3.54 +  thus "r1 \<otimes> inv r2 \<in> H" by (metis assms(1) h1(1) h2(1) subgroup_def)
    3.55 +qed
    3.56 +
    3.57 +
    3.58 +subsection \<open>Stable Operations for Subgroups\<close>
    3.59 +
    3.60 +lemma (in group) subgroup_set_mult_equality[simp]:
    3.61 +  assumes "subgroup H G" "I \<subseteq> H" "J \<subseteq> H"
    3.62 +  shows "I <#>\<^bsub>G \<lparr> carrier := H \<rparr>\<^esub> J = I <#> J"
    3.63 +  unfolding set_mult_def subgroup_mult_equality[OF assms(1)] by auto
    3.64 +
    3.65 +lemma (in group) subgroup_rcos_equality[simp]:
    3.66 +  assumes "subgroup H G" "I \<subseteq> H" "h \<in> H"
    3.67 +  shows "I #>\<^bsub>G \<lparr> carrier := H \<rparr>\<^esub> h = I #> h"
    3.68 +  using subgroup_set_mult_equality by (simp add: r_coset_eq_set_mult assms)
    3.69 +
    3.70 +lemma (in group) subgroup_lcos_equality[simp]:
    3.71 +  assumes "subgroup H G" "I \<subseteq> H" "h \<in> H"
    3.72 +  shows "h <#\<^bsub>G \<lparr> carrier := H \<rparr>\<^esub> I = h <# I"
    3.73 +  using subgroup_set_mult_equality by (simp add: l_coset_eq_set_mult assms)
    3.74 +
    3.75 +(* ************************************************************************** *)
    3.76 +                                 
    3.77 +
    3.78 +subsection \<open>Basic Properties of set_mult\<close>
    3.79 +
    3.80 +lemma (in group) setmult_subset_G:
    3.81 +  assumes "H \<subseteq> carrier G" "K \<subseteq> carrier G"
    3.82 +  shows "H <#> K \<subseteq> carrier G" using assms
    3.83 +  by (auto simp add: set_mult_def subsetD)
    3.84 +
    3.85 +lemma (in monoid) set_mult_closed:
    3.86 +  assumes "H \<subseteq> carrier G" "K \<subseteq> carrier G"
    3.87 +  shows "H <#> K \<subseteq> carrier G"
    3.88 +  using assms by (auto simp add: set_mult_def subsetD)
    3.89 +
    3.90 +(* ************************************************************************** *)
    3.91 +(* Next lemma contributed by Martin Baillon.                                  *)
    3.92 +
    3.93 +lemma (in group) set_mult_assoc:
    3.94 +  assumes "M \<subseteq> carrier G" "H \<subseteq> carrier G" "K \<subseteq> carrier G"
    3.95 +  shows "(M <#> H) <#> K = M <#> (H <#> K)"
    3.96 +proof
    3.97 +  show "(M <#> H) <#> K \<subseteq> M <#> (H <#> K)"
    3.98 +  proof
    3.99 +    fix x assume "x \<in> (M <#> H) <#> K"
   3.100 +    then obtain m h k where x: "m \<in> M" "h \<in> H" "k \<in> K" "x = (m \<otimes> h) \<otimes> k"
   3.101 +      unfolding set_mult_def by blast
   3.102 +    hence "x = m \<otimes> (h \<otimes> k)"
   3.103 +      using assms m_assoc by blast
   3.104 +    thus "x \<in> M <#> (H <#> K)"
   3.105 +      unfolding set_mult_def using x by blast
   3.106 +  qed
   3.107 +next
   3.108 +  show "M <#> (H <#> K) \<subseteq> (M <#> H) <#> K"
   3.109 +  proof
   3.110 +    fix x assume "x \<in> M <#> (H <#> K)"
   3.111 +    then obtain m h k where x: "m \<in> M" "h \<in> H" "k \<in> K" "x = m \<otimes> (h \<otimes> k)"
   3.112 +      unfolding set_mult_def by blast
   3.113 +    hence "x = (m \<otimes> h) \<otimes> k"
   3.114 +      using assms m_assoc rev_subsetD by metis
   3.115 +    thus "x \<in> (M <#> H) <#> K"
   3.116 +      unfolding set_mult_def using x by blast
   3.117 +  qed
   3.118 +qed
   3.119 +
   3.120 +(* ************************************************************************** *)
   3.121 +
   3.122  
   3.123  subsection \<open>Basic Properties of Cosets\<close>
   3.124  
   3.125  lemma (in group) coset_mult_assoc:
   3.126 -     "[| M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G |]
   3.127 -      ==> (M #> g) #> h = M #> (g \<otimes> h)"
   3.128 -by (force simp add: r_coset_def m_assoc)
   3.129 +  assumes "M \<subseteq> carrier G" "g \<in> carrier G" "h \<in> carrier G"
   3.130 +  shows "(M #> g) #> h = M #> (g \<otimes> h)"
   3.131 +  using assms by (force simp add: r_coset_def m_assoc)
   3.132 +
   3.133 +lemma (in group) coset_assoc:
   3.134 +  assumes "x \<in> carrier G" "y \<in> carrier G" "H \<subseteq> carrier G"
   3.135 +  shows "x <# (H #> y) = (x <# H) #> y"
   3.136 +  using set_mult_assoc[of "{x}" H "{y}"]
   3.137 +  by (simp add: l_coset_eq_set_mult r_coset_eq_set_mult assms)
   3.138  
   3.139  lemma (in group) coset_mult_one [simp]: "M \<subseteq> carrier G ==> M #> \<one> = M"
   3.140  by (force simp add: r_coset_def)
   3.141  
   3.142  lemma (in group) coset_mult_inv1:
   3.143 -     "[| M #> (x \<otimes> (inv y)) = M;  x \<in> carrier G ; y \<in> carrier G;
   3.144 -         M \<subseteq> carrier G |] ==> M #> x = M #> y"
   3.145 -apply (erule subst [of concl: "%z. M #> x = z #> y"])
   3.146 -apply (simp add: coset_mult_assoc m_assoc)
   3.147 -done
   3.148 +  assumes "M #> (x \<otimes> (inv y)) = M"
   3.149 +    and "x \<in> carrier G" "y \<in> carrier G" "M \<subseteq> carrier G"
   3.150 +  shows "M #> x = M #> y" using assms
   3.151 +  by (metis coset_mult_assoc group.inv_solve_right is_group subgroup_def subgroup_self)
   3.152  
   3.153  lemma (in group) coset_mult_inv2:
   3.154 -     "[| M #> x = M #> y;  x \<in> carrier G;  y \<in> carrier G;  M \<subseteq> carrier G |]
   3.155 -      ==> M #> (x \<otimes> (inv y)) = M "
   3.156 -apply (simp add: coset_mult_assoc [symmetric])
   3.157 -apply (simp add: coset_mult_assoc)
   3.158 -done
   3.159 +  assumes "M #> x = M #> y"
   3.160 +    and "x \<in> carrier G"  "y \<in> carrier G" "M \<subseteq> carrier G"
   3.161 +  shows "M #> (x \<otimes> (inv y)) = M " using assms
   3.162 +  by (metis group.coset_mult_assoc group.coset_mult_one inv_closed is_group r_inv) 
   3.163  
   3.164  lemma (in group) coset_join1:
   3.165 -     "[| H #> x = H;  x \<in> carrier G;  subgroup H G |] ==> x \<in> H"
   3.166 -apply (erule subst)
   3.167 -apply (simp add: r_coset_def)
   3.168 -apply (blast intro: l_one subgroup.one_closed sym)
   3.169 -done
   3.170 +  assumes "H #> x = H"
   3.171 +    and "x \<in> carrier G" "subgroup H G"
   3.172 +  shows "x \<in> H"
   3.173 +  using assms r_coset_def l_one subgroup.one_closed sym by fastforce
   3.174  
   3.175  lemma (in group) solve_equation:
   3.176 -    "\<lbrakk>subgroup H G; x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> \<exists>h\<in>H. y = h \<otimes> x"
   3.177 -apply (rule bexI [of _ "y \<otimes> (inv x)"])
   3.178 -apply (auto simp add: subgroup.m_closed subgroup.m_inv_closed m_assoc
   3.179 -                      subgroup.subset [THEN subsetD])
   3.180 -done
   3.181 +  assumes "subgroup H G" "x \<in> H" "y \<in> H"
   3.182 +  shows "\<exists>h \<in> H. y = h \<otimes> x"
   3.183 +proof -
   3.184 +  have "y = (y \<otimes> (inv x)) \<otimes> x" using assms
   3.185 +    by (simp add: m_assoc subgroup.mem_carrier)
   3.186 +  moreover have "y \<otimes> (inv x) \<in> H" using assms
   3.187 +    by (simp add: subgroup_def)
   3.188 +  ultimately show ?thesis by blast
   3.189 +qed
   3.190  
   3.191  lemma (in group) repr_independence:
   3.192 -     "\<lbrakk>y \<in> H #> x;  x \<in> carrier G; subgroup H G\<rbrakk> \<Longrightarrow> H #> x = H #> y"
   3.193 +  assumes "y \<in> H #> x" "x \<in> carrier G" "subgroup H G"
   3.194 +  shows "H #> x = H #> y" using assms
   3.195  by (auto simp add: r_coset_def m_assoc [symmetric]
   3.196                     subgroup.subset [THEN subsetD]
   3.197                     subgroup.m_closed solve_equation)
   3.198  
   3.199  lemma (in group) coset_join2:
   3.200 -     "\<lbrakk>x \<in> carrier G;  subgroup H G;  x\<in>H\<rbrakk> \<Longrightarrow> H #> x = H"
   3.201 +  assumes "x \<in> carrier G" "subgroup H G" "x \<in> H"
   3.202 +  shows "H #> x = H" using assms
   3.203    \<comment> \<open>Alternative proof is to put @{term "x=\<one>"} in \<open>repr_independence\<close>.\<close>
   3.204  by (force simp add: subgroup.m_closed r_coset_def solve_equation)
   3.205  
   3.206 +lemma (in group) coset_join3:
   3.207 +  assumes "x \<in> carrier G" "subgroup H G" "x \<in> H"
   3.208 +  shows "x <# H = H"
   3.209 +proof
   3.210 +  have "\<And>h. h \<in> H \<Longrightarrow> x \<otimes> h \<in> H" using assms
   3.211 +    by (simp add: subgroup.m_closed)
   3.212 +  thus "x <# H \<subseteq> H" unfolding l_coset_def by blast
   3.213 +next
   3.214 +  have "\<And>h. h \<in> H \<Longrightarrow> x \<otimes> ((inv x) \<otimes> h) = h"
   3.215 +    by (smt assms inv_closed l_one m_assoc r_inv subgroup.mem_carrier)
   3.216 +  moreover have "\<And>h. h \<in> H \<Longrightarrow> (inv x) \<otimes> h \<in> H"
   3.217 +    by (simp add: assms subgroup.m_closed subgroup.m_inv_closed)
   3.218 +  ultimately show "H \<subseteq> x <# H" unfolding l_coset_def by blast
   3.219 +qed
   3.220 +
   3.221  lemma (in monoid) r_coset_subset_G:
   3.222 -     "[| H \<subseteq> carrier G; x \<in> carrier G |] ==> H #> x \<subseteq> carrier G"
   3.223 +  "\<lbrakk> H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> H #> x \<subseteq> carrier G"
   3.224  by (auto simp add: r_coset_def)
   3.225  
   3.226  lemma (in group) rcosI:
   3.227 -     "[| h \<in> H; H \<subseteq> carrier G; x \<in> carrier G|] ==> h \<otimes> x \<in> H #> x"
   3.228 +  "\<lbrakk> h \<in> H; H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> h \<otimes> x \<in> H #> x"
   3.229  by (auto simp add: r_coset_def)
   3.230  
   3.231  lemma (in group) rcosetsI:
   3.232       "\<lbrakk>H \<subseteq> carrier G; x \<in> carrier G\<rbrakk> \<Longrightarrow> H #> x \<in> rcosets H"
   3.233  by (auto simp add: RCOSETS_def)
   3.234  
   3.235 -text\<open>Really needed?\<close>
   3.236 -lemma (in group) transpose_inv:
   3.237 -     "[| x \<otimes> y = z;  x \<in> carrier G;  y \<in> carrier G;  z \<in> carrier G |]
   3.238 -      ==> (inv x) \<otimes> z = y"
   3.239 -by (force simp add: m_assoc [symmetric])
   3.240 -
   3.241 -lemma (in group) rcos_self: "[| x \<in> carrier G; subgroup H G |] ==> x \<in> H #> x"
   3.242 -apply (simp add: r_coset_def)
   3.243 -apply (blast intro: sym l_one subgroup.subset [THEN subsetD]
   3.244 -                    subgroup.one_closed)
   3.245 -done
   3.246 +lemma (in group) rcos_self:
   3.247 +  "\<lbrakk> x \<in> carrier G; subgroup H G \<rbrakk> \<Longrightarrow> x \<in> H #> x"
   3.248 +  by (metis l_one rcosI subgroup_def)
   3.249  
   3.250  text (in group) \<open>Opposite of @{thm [source] "repr_independence"}\<close>
   3.251  lemma (in group) repr_independenceD:
   3.252 -  assumes "subgroup H G"
   3.253 -  assumes ycarr: "y \<in> carrier G"
   3.254 -      and repr:  "H #> x = H #> y"
   3.255 +  assumes "subgroup H G" "y \<in> carrier G"
   3.256 +    and "H #> x = H #> y"
   3.257    shows "y \<in> H #> x"
   3.258 -proof -
   3.259 -  interpret subgroup H G by fact
   3.260 -  show ?thesis  apply (subst repr)
   3.261 -  apply (intro rcos_self)
   3.262 -   apply (rule ycarr)
   3.263 -   apply (rule is_subgroup)
   3.264 -  done
   3.265 -qed
   3.266 +  using assms by (simp add: rcos_self)
   3.267  
   3.268  text \<open>Elements of a right coset are in the carrier\<close>
   3.269  lemma (in subgroup) elemrcos_carrier:
   3.270 -  assumes "group G"
   3.271 -  assumes acarr: "a \<in> carrier G"
   3.272 -    and a': "a' \<in> H #> a"
   3.273 +  assumes "group G" "a \<in> carrier G"
   3.274 +    and "a' \<in> H #> a"
   3.275    shows "a' \<in> carrier G"
   3.276 +  by (meson assms group.is_monoid monoid.r_coset_subset_G subset subsetCE)
   3.277 +
   3.278 +lemma (in subgroup) rcos_const:
   3.279 +  assumes "group G" "h \<in> H"
   3.280 +  shows "H #> h = H"
   3.281 +  using group.coset_join2[OF assms(1), of h H]
   3.282 +  by (simp add: assms(2) subgroup_axioms)
   3.283 +
   3.284 +lemma (in subgroup) rcos_module_imp:
   3.285 +  assumes "group G" "x \<in> carrier G"
   3.286 +    and "x' \<in> H #> x"
   3.287 +  shows "(x' \<otimes> inv x) \<in> H"
   3.288  proof -
   3.289 -  interpret group G by fact
   3.290 -  from subset and acarr
   3.291 -  have "H #> a \<subseteq> carrier G" by (rule r_coset_subset_G)
   3.292 -  from this and a'
   3.293 -  show "a' \<in> carrier G"
   3.294 -    by fast
   3.295 +  obtain h where h: "h \<in> H" "x' = h \<otimes> x"
   3.296 +    using assms(3) unfolding r_coset_def by blast
   3.297 +  hence "x' \<otimes> inv x = h"
   3.298 +    by (metis assms elemrcos_carrier group.inv_solve_right mem_carrier)
   3.299 +  thus ?thesis using h by blast
   3.300  qed
   3.301  
   3.302 -lemma (in subgroup) rcos_const:
   3.303 -  assumes "group G"
   3.304 -  assumes hH: "h \<in> H"
   3.305 -  shows "H #> h = H"
   3.306 -proof -
   3.307 -  interpret group G by fact
   3.308 -  show ?thesis apply (unfold r_coset_def)
   3.309 -    apply rule
   3.310 -    apply rule
   3.311 -    apply clarsimp
   3.312 -    apply (intro subgroup.m_closed)
   3.313 -    apply (rule is_subgroup)
   3.314 -    apply assumption
   3.315 -    apply (rule hH)
   3.316 -    apply rule
   3.317 -    apply simp
   3.318 -  proof -
   3.319 -    fix h'
   3.320 -    assume h'H: "h' \<in> H"
   3.321 -    note carr = hH[THEN mem_carrier] h'H[THEN mem_carrier]
   3.322 -    from carr
   3.323 -    have a: "h' = (h' \<otimes> inv h) \<otimes> h" by (simp add: m_assoc)
   3.324 -    from h'H hH
   3.325 -    have "h' \<otimes> inv h \<in> H" by simp
   3.326 -    from this and a
   3.327 -    show "\<exists>x\<in>H. h' = x \<otimes> h" by fast
   3.328 -  qed
   3.329 -qed
   3.330 -
   3.331 -text \<open>Step one for lemma \<open>rcos_module\<close>\<close>
   3.332 -lemma (in subgroup) rcos_module_imp:
   3.333 -  assumes "group G"
   3.334 -  assumes xcarr: "x \<in> carrier G"
   3.335 -      and x'cos: "x' \<in> H #> x"
   3.336 -  shows "(x' \<otimes> inv x) \<in> H"
   3.337 -proof -
   3.338 -  interpret group G by fact
   3.339 -  from xcarr x'cos
   3.340 -      have x'carr: "x' \<in> carrier G"
   3.341 -      by (rule elemrcos_carrier[OF is_group])
   3.342 -  from xcarr
   3.343 -      have ixcarr: "inv x \<in> carrier G"
   3.344 -      by simp
   3.345 -  from x'cos
   3.346 -      have "\<exists>h\<in>H. x' = h \<otimes> x"
   3.347 -      unfolding r_coset_def
   3.348 -      by fast
   3.349 -  from this
   3.350 -      obtain h
   3.351 -        where hH: "h \<in> H"
   3.352 -        and x': "x' = h \<otimes> x"
   3.353 -      by auto
   3.354 -  from hH and subset
   3.355 -      have hcarr: "h \<in> carrier G" by fast
   3.356 -  note carr = xcarr x'carr hcarr
   3.357 -  from x' and carr
   3.358 -      have "x' \<otimes> (inv x) = (h \<otimes> x) \<otimes> (inv x)" by fast
   3.359 -  also from carr
   3.360 -      have "\<dots> = h \<otimes> (x \<otimes> inv x)" by (simp add: m_assoc)
   3.361 -  also from carr
   3.362 -      have "\<dots> = h \<otimes> \<one>" by simp
   3.363 -  also from carr
   3.364 -      have "\<dots> = h" by simp
   3.365 -  finally
   3.366 -      have "x' \<otimes> (inv x) = h" by simp
   3.367 -  from hH this
   3.368 -      show "x' \<otimes> (inv x) \<in> H" by simp
   3.369 -qed
   3.370 -
   3.371 -text \<open>Step two for lemma \<open>rcos_module\<close>\<close>
   3.372  lemma (in subgroup) rcos_module_rev:
   3.373 -  assumes "group G"
   3.374 -  assumes carr: "x \<in> carrier G" "x' \<in> carrier G"
   3.375 -      and xixH: "(x' \<otimes> inv x) \<in> H"
   3.376 +  assumes "group G" "x \<in> carrier G" "x' \<in> carrier G"
   3.377 +    and "(x' \<otimes> inv x) \<in> H"
   3.378    shows "x' \<in> H #> x"
   3.379  proof -
   3.380 -  interpret group G by fact
   3.381 -  from xixH
   3.382 -      have "\<exists>h\<in>H. x' \<otimes> (inv x) = h" by fast
   3.383 -  from this
   3.384 -      obtain h
   3.385 -        where hH: "h \<in> H"
   3.386 -        and hsym: "x' \<otimes> (inv x) = h"
   3.387 -      by fast
   3.388 -  from hH subset have hcarr: "h \<in> carrier G" by simp
   3.389 -  note carr = carr hcarr
   3.390 -  from hsym[symmetric] have "h \<otimes> x = x' \<otimes> (inv x) \<otimes> x" by fast
   3.391 -  also from carr
   3.392 -      have "\<dots> = x' \<otimes> ((inv x) \<otimes> x)" by (simp add: m_assoc)
   3.393 -  also from carr
   3.394 -      have "\<dots> = x' \<otimes> \<one>" by simp
   3.395 -  also from carr
   3.396 -      have "\<dots> = x'" by simp
   3.397 -  finally
   3.398 -      have "h \<otimes> x = x'" by simp
   3.399 -  from this[symmetric] and hH
   3.400 -      show "x' \<in> H #> x"
   3.401 -      unfolding r_coset_def
   3.402 -      by fast
   3.403 +  obtain h where h: "h \<in> H" "x' \<otimes> inv x = h"
   3.404 +    using assms(4) unfolding r_coset_def by blast
   3.405 +  hence "x' = h \<otimes> x"
   3.406 +    by (metis assms group.inv_solve_right mem_carrier)
   3.407 +  thus ?thesis using h unfolding r_coset_def by blast
   3.408  qed
   3.409  
   3.410  text \<open>Module property of right cosets\<close>
   3.411  lemma (in subgroup) rcos_module:
   3.412 -  assumes "group G"
   3.413 -  assumes carr: "x \<in> carrier G" "x' \<in> carrier G"
   3.414 +  assumes "group G" "x \<in> carrier G" "x' \<in> carrier G"
   3.415    shows "(x' \<in> H #> x) = (x' \<otimes> inv x \<in> H)"
   3.416 -proof -
   3.417 -  interpret group G by fact
   3.418 -  show ?thesis proof  assume "x' \<in> H #> x"
   3.419 -    from this and carr
   3.420 -    show "x' \<otimes> inv x \<in> H"
   3.421 -      by (intro rcos_module_imp[OF is_group])
   3.422 -  next
   3.423 -    assume "x' \<otimes> inv x \<in> H"
   3.424 -    from this and carr
   3.425 -    show "x' \<in> H #> x"
   3.426 -      by (intro rcos_module_rev[OF is_group])
   3.427 +  using rcos_module_rev rcos_module_imp assms by blast
   3.428 +
   3.429 +text \<open>Right cosets are subsets of the carrier.\<close> 
   3.430 +lemma (in subgroup) rcosets_carrier:
   3.431 +  assumes "group G" "X \<in> rcosets H"
   3.432 +  shows "X \<subseteq> carrier G"
   3.433 +  using assms elemrcos_carrier singletonD
   3.434 +  subset_eq unfolding RCOSETS_def by force 
   3.435 +
   3.436 +
   3.437 +text \<open>Multiplication of general subsets\<close>
   3.438 +
   3.439 +lemma (in comm_group) mult_subgroups:
   3.440 +  assumes "subgroup H G" and "subgroup K G"
   3.441 +  shows "subgroup (H <#> K) G"
   3.442 +proof (rule subgroup.intro)
   3.443 +  show "H <#> K \<subseteq> carrier G"
   3.444 +    by (simp add: setmult_subset_G assms subgroup_imp_subset)
   3.445 +next
   3.446 +  have "\<one> \<otimes> \<one> \<in> H <#> K"
   3.447 +    unfolding set_mult_def using assms subgroup.one_closed by blast
   3.448 +  thus "\<one> \<in> H <#> K" by simp
   3.449 +next
   3.450 +  show "\<And>x. x \<in> H <#> K \<Longrightarrow> inv x \<in> H <#> K"
   3.451 +  proof -
   3.452 +    fix x assume "x \<in> H <#> K"
   3.453 +    then obtain h k where hk: "h \<in> H" "k \<in> K" "x = h \<otimes> k"
   3.454 +      unfolding set_mult_def by blast
   3.455 +    hence "inv x = (inv k) \<otimes> (inv h)"
   3.456 +      by (meson inv_mult_group assms subgroup.mem_carrier)
   3.457 +    hence "inv x = (inv h) \<otimes> (inv k)"
   3.458 +      by (metis hk inv_mult assms subgroup.mem_carrier)
   3.459 +    thus "inv x \<in> H <#> K"
   3.460 +      unfolding set_mult_def using hk assms
   3.461 +      by (metis (no_types, lifting) UN_iff singletonI subgroup_def)
   3.462 +  qed
   3.463 +next
   3.464 +  show "\<And>x y. x \<in> H <#> K \<Longrightarrow> y \<in> H <#> K \<Longrightarrow> x \<otimes> y \<in> H <#> K"
   3.465 +  proof -
   3.466 +    fix x y assume "x \<in> H <#> K" "y \<in> H <#> K"
   3.467 +    then obtain h1 k1 h2 k2 where h1k1: "h1 \<in> H" "k1 \<in> K" "x = h1 \<otimes> k1"
   3.468 +                              and h2k2: "h2 \<in> H" "k2 \<in> K" "y = h2 \<otimes> k2"
   3.469 +      unfolding set_mult_def by blast
   3.470 +    hence "x \<otimes> y = (h1 \<otimes> k1) \<otimes> (h2 \<otimes> k2)" by simp
   3.471 +    also have " ... = h1 \<otimes> (k1 \<otimes> h2) \<otimes> k2"
   3.472 +      by (smt h1k1 h2k2 m_assoc m_closed assms subgroup.mem_carrier)
   3.473 +    also have " ... = h1 \<otimes> (h2 \<otimes> k1) \<otimes> k2"
   3.474 +      by (metis (no_types, hide_lams) assms m_comm h1k1(2) h2k2(1) subgroup.mem_carrier)
   3.475 +    finally have "x \<otimes> y  = (h1 \<otimes> h2) \<otimes> (k1 \<otimes> k2)"
   3.476 +      by (smt assms h1k1 h2k2 m_assoc monoid.m_closed monoid_axioms subgroup.mem_carrier)
   3.477 +    thus "x \<otimes> y \<in> H <#> K" unfolding set_mult_def
   3.478 +      using subgroup.m_closed[OF assms(1) h1k1(1) h2k2(1)]
   3.479 +            subgroup.m_closed[OF assms(2) h1k1(2) h2k2(2)] by blast
   3.480    qed
   3.481  qed
   3.482  
   3.483 -text \<open>Right cosets are subsets of the carrier.\<close> 
   3.484 -lemma (in subgroup) rcosets_carrier:
   3.485 -  assumes "group G"
   3.486 -  assumes XH: "X \<in> rcosets H"
   3.487 -  shows "X \<subseteq> carrier G"
   3.488 -proof -
   3.489 -  interpret group G by fact
   3.490 -  from XH have "\<exists>x\<in> carrier G. X = H #> x"
   3.491 -      unfolding RCOSETS_def
   3.492 -      by fast
   3.493 -  from this
   3.494 -      obtain x
   3.495 -        where xcarr: "x\<in> carrier G"
   3.496 -        and X: "X = H #> x"
   3.497 -      by fast
   3.498 -  from subset and xcarr
   3.499 -      show "X \<subseteq> carrier G"
   3.500 -      unfolding X
   3.501 -      by (rule r_coset_subset_G)
   3.502 -qed
   3.503 -
   3.504 -text \<open>Multiplication of general subsets\<close>
   3.505 -lemma (in monoid) set_mult_closed:
   3.506 -  assumes Acarr: "A \<subseteq> carrier G"
   3.507 -      and Bcarr: "B \<subseteq> carrier G"
   3.508 -  shows "A <#> B \<subseteq> carrier G"
   3.509 -apply rule apply (simp add: set_mult_def, clarsimp)
   3.510 -proof -
   3.511 -  fix a b
   3.512 -  assume "a \<in> A"
   3.513 -  from this and Acarr
   3.514 -      have acarr: "a \<in> carrier G" by fast
   3.515 -
   3.516 -  assume "b \<in> B"
   3.517 -  from this and Bcarr
   3.518 -      have bcarr: "b \<in> carrier G" by fast
   3.519 -
   3.520 -  from acarr bcarr
   3.521 -      show "a \<otimes> b \<in> carrier G" by (rule m_closed)
   3.522 -qed
   3.523 -
   3.524 -lemma (in comm_group) mult_subgroups:
   3.525 -  assumes subH: "subgroup H G"
   3.526 -      and subK: "subgroup K G"
   3.527 -  shows "subgroup (H <#> K) G"
   3.528 -apply (rule subgroup.intro)
   3.529 -   apply (intro set_mult_closed subgroup.subset[OF subH] subgroup.subset[OF subK])
   3.530 -  apply (simp add: set_mult_def) apply clarsimp defer 1
   3.531 -  apply (simp add: set_mult_def) defer 1
   3.532 -  apply (simp add: set_mult_def, clarsimp) defer 1
   3.533 -proof -
   3.534 -  fix ha hb ka kb
   3.535 -  assume haH: "ha \<in> H" and hbH: "hb \<in> H" and kaK: "ka \<in> K" and kbK: "kb \<in> K"
   3.536 -  note carr = haH[THEN subgroup.mem_carrier[OF subH]] hbH[THEN subgroup.mem_carrier[OF subH]]
   3.537 -              kaK[THEN subgroup.mem_carrier[OF subK]] kbK[THEN subgroup.mem_carrier[OF subK]]
   3.538 -  from carr
   3.539 -      have "(ha \<otimes> ka) \<otimes> (hb \<otimes> kb) = ha \<otimes> (ka \<otimes> hb) \<otimes> kb" by (simp add: m_assoc)
   3.540 -  also from carr
   3.541 -      have "\<dots> = ha \<otimes> (hb \<otimes> ka) \<otimes> kb" by (simp add: m_comm)
   3.542 -  also from carr
   3.543 -      have "\<dots> = (ha \<otimes> hb) \<otimes> (ka \<otimes> kb)" by (simp add: m_assoc)
   3.544 -  finally
   3.545 -      have eq: "(ha \<otimes> ka) \<otimes> (hb \<otimes> kb) = (ha \<otimes> hb) \<otimes> (ka \<otimes> kb)" .
   3.546 -
   3.547 -  from haH hbH have hH: "ha \<otimes> hb \<in> H" by (simp add: subgroup.m_closed[OF subH])
   3.548 -  from kaK kbK have kK: "ka \<otimes> kb \<in> K" by (simp add: subgroup.m_closed[OF subK])
   3.549 -  
   3.550 -  from hH and kK and eq
   3.551 -      show "\<exists>h'\<in>H. \<exists>k'\<in>K. (ha \<otimes> ka) \<otimes> (hb \<otimes> kb) = h' \<otimes> k'" by fast
   3.552 -next
   3.553 -  have "\<one> = \<one> \<otimes> \<one>" by simp
   3.554 -  from subgroup.one_closed[OF subH] subgroup.one_closed[OF subK] this
   3.555 -      show "\<exists>h\<in>H. \<exists>k\<in>K. \<one> = h \<otimes> k" by fast
   3.556 -next
   3.557 -  fix h k
   3.558 -  assume hH: "h \<in> H"
   3.559 -     and kK: "k \<in> K"
   3.560 -
   3.561 -  from hH[THEN subgroup.mem_carrier[OF subH]] kK[THEN subgroup.mem_carrier[OF subK]]
   3.562 -      have "inv (h \<otimes> k) = inv h \<otimes> inv k" by (simp add: inv_mult_group m_comm)
   3.563 -
   3.564 -  from subgroup.m_inv_closed[OF subH hH] and subgroup.m_inv_closed[OF subK kK] and this
   3.565 -      show "\<exists>ha\<in>H. \<exists>ka\<in>K. inv (h \<otimes> k) = ha \<otimes> ka" by fast
   3.566 -qed
   3.567 -
   3.568  lemma (in subgroup) lcos_module_rev:
   3.569 -  assumes "group G"
   3.570 -  assumes carr: "x \<in> carrier G" "x' \<in> carrier G"
   3.571 -      and xixH: "(inv x \<otimes> x') \<in> H"
   3.572 +  assumes "group G" "x \<in> carrier G" "x' \<in> carrier G"
   3.573 +    and "(inv x \<otimes> x') \<in> H"
   3.574    shows "x' \<in> x <# H"
   3.575  proof -
   3.576 -  interpret group G by fact
   3.577 -  from xixH
   3.578 -      have "\<exists>h\<in>H. (inv x) \<otimes> x' = h" by fast
   3.579 -  from this
   3.580 -      obtain h
   3.581 -        where hH: "h \<in> H"
   3.582 -        and hsym: "(inv x) \<otimes> x' = h"
   3.583 -      by fast
   3.584 -
   3.585 -  from hH subset have hcarr: "h \<in> carrier G" by simp
   3.586 -  note carr = carr hcarr
   3.587 -  from hsym[symmetric] have "x \<otimes> h = x \<otimes> ((inv x) \<otimes> x')" by fast
   3.588 -  also from carr
   3.589 -      have "\<dots> = (x \<otimes> (inv x)) \<otimes> x'" by (simp add: m_assoc[symmetric])
   3.590 -  also from carr
   3.591 -      have "\<dots> = \<one> \<otimes> x'" by simp
   3.592 -  also from carr
   3.593 -      have "\<dots> = x'" by simp
   3.594 -  finally
   3.595 -      have "x \<otimes> h = x'" by simp
   3.596 -
   3.597 -  from this[symmetric] and hH
   3.598 -      show "x' \<in> x <# H"
   3.599 -      unfolding l_coset_def
   3.600 -      by fast
   3.601 +  obtain h where h: "h \<in> H" "inv x \<otimes> x' = h"
   3.602 +    using assms(4) unfolding l_coset_def by blast
   3.603 +  hence "x' = x \<otimes> h"
   3.604 +    by (metis assms group.inv_solve_left mem_carrier)
   3.605 +  thus ?thesis using h unfolding l_coset_def by blast
   3.606  qed
   3.607  
   3.608  
   3.609 @@ -391,21 +370,21 @@
   3.610    by (simp add: normal_def normal_axioms_def is_group)
   3.611  
   3.612  lemma (in normal) inv_op_closed1:
   3.613 -     "\<lbrakk>x \<in> carrier G; h \<in> H\<rbrakk> \<Longrightarrow> (inv x) \<otimes> h \<otimes> x \<in> H"
   3.614 -apply (insert coset_eq) 
   3.615 -apply (auto simp add: l_coset_def r_coset_def)
   3.616 -apply (drule bspec, assumption)
   3.617 -apply (drule equalityD1 [THEN subsetD], blast, clarify)
   3.618 -apply (simp add: m_assoc)
   3.619 -apply (simp add: m_assoc [symmetric])
   3.620 -done
   3.621 +  assumes "x \<in> carrier G" and "h \<in> H"
   3.622 +  shows "(inv x) \<otimes> h \<otimes> x \<in> H"
   3.623 +proof -
   3.624 +  have "h \<otimes> x \<in> x <# H"
   3.625 +    using assms coset_eq assms(1) unfolding r_coset_def by blast 
   3.626 +  then obtain h' where "h' \<in> H" "h \<otimes> x = x \<otimes> h'"
   3.627 +    unfolding l_coset_def by blast
   3.628 +  thus ?thesis by (metis assms inv_closed l_inv l_one m_assoc mem_carrier) 
   3.629 +qed
   3.630  
   3.631  lemma (in normal) inv_op_closed2:
   3.632 -     "\<lbrakk>x \<in> carrier G; h \<in> H\<rbrakk> \<Longrightarrow> x \<otimes> h \<otimes> (inv x) \<in> H"
   3.633 -apply (subgoal_tac "inv (inv x) \<otimes> h \<otimes> (inv x) \<in> H") 
   3.634 -apply (simp add: ) 
   3.635 -apply (blast intro: inv_op_closed1) 
   3.636 -done
   3.637 +  assumes "x \<in> carrier G" and "h \<in> H"
   3.638 +  shows "x \<otimes> h \<otimes> (inv x) \<in> H"
   3.639 +  using assms inv_op_closed1 by (metis inv_closed inv_inv) 
   3.640 +
   3.641  
   3.642  text\<open>Alternative characterization of normal subgroups\<close>
   3.643  lemma (in group) normal_inv_iff:
   3.644 @@ -455,74 +434,81 @@
   3.645    qed
   3.646  qed
   3.647  
   3.648 +corollary (in group) normal_invI:
   3.649 +  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.650 +  shows "N \<lhd> G"
   3.651 +  using assms normal_inv_iff by blast
   3.652  
   3.653 -subsection\<open>More Properties of Cosets\<close>
   3.654 +corollary (in group) normal_invE:
   3.655 +  assumes "N \<lhd> G" 
   3.656 +  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.657 +  using assms normal_inv_iff apply blast
   3.658 +  by (simp add: assms normal.inv_op_closed2) 
   3.659 +
   3.660 +
   3.661 +lemma (in group) one_is_normal :
   3.662 +   "{\<one>} \<lhd> G" 
   3.663 +proof(intro normal_invI )
   3.664 +  show "subgroup {\<one>} G"
   3.665 +    by (simp add: subgroup_def)
   3.666 +  show "\<And>x h. x \<in> carrier G \<Longrightarrow> h \<in> {\<one>} \<Longrightarrow> x \<otimes> h \<otimes> inv x \<in> {\<one>}" by simp
   3.667 +qed
   3.668 +
   3.669 +
   3.670 +subsection\<open>More Properties of Left Cosets\<close>
   3.671 +
   3.672 +lemma (in group) l_repr_independence:
   3.673 +  assumes "y \<in> x <# H" "x \<in> carrier G" "subgroup H G"
   3.674 +  shows "x <# H = y <# H"
   3.675 +proof -
   3.676 +  obtain h' where h': "h' \<in> H" "y = x \<otimes> h'"
   3.677 +    using assms(1) unfolding l_coset_def by blast
   3.678 +  hence "\<And> h. h \<in> H \<Longrightarrow> x \<otimes> h = y \<otimes> ((inv h') \<otimes> h)"
   3.679 +    by (smt assms(2-3) inv_closed inv_solve_right m_assoc m_closed subgroup.mem_carrier)
   3.680 +  hence "\<And> xh. xh \<in> x <# H \<Longrightarrow> xh \<in> y <# H"
   3.681 +    unfolding l_coset_def by (metis (no_types, lifting) UN_iff assms(3) h'(1) subgroup_def) 
   3.682 +  moreover have "\<And> h. h \<in> H \<Longrightarrow> y \<otimes> h = x \<otimes> (h' \<otimes> h)"
   3.683 +    using h' by (meson assms(2) assms(3) m_assoc subgroup.mem_carrier)
   3.684 +  hence "\<And> yh. yh \<in> y <# H \<Longrightarrow> yh \<in> x <# H"
   3.685 +    unfolding l_coset_def using subgroup.m_closed[OF assms(3) h'(1)] by blast
   3.686 +  ultimately show ?thesis by blast
   3.687 +qed
   3.688  
   3.689  lemma (in group) lcos_m_assoc:
   3.690 -     "[| M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G |]
   3.691 -      ==> g <# (h <# M) = (g \<otimes> h) <# M"
   3.692 +  "\<lbrakk> M \<subseteq> carrier G; g \<in> carrier G; h \<in> carrier G \<rbrakk> \<Longrightarrow> g <# (h <# M) = (g \<otimes> h) <# M"
   3.693  by (force simp add: l_coset_def m_assoc)
   3.694  
   3.695 -lemma (in group) lcos_mult_one: "M \<subseteq> carrier G ==> \<one> <# M = M"
   3.696 +lemma (in group) lcos_mult_one: "M \<subseteq> carrier G \<Longrightarrow> \<one> <# M = M"
   3.697  by (force simp add: l_coset_def)
   3.698  
   3.699  lemma (in group) l_coset_subset_G:
   3.700 -     "[| H \<subseteq> carrier G; x \<in> carrier G |] ==> x <# H \<subseteq> carrier G"
   3.701 +  "\<lbrakk> H \<subseteq> carrier G; x \<in> carrier G \<rbrakk> \<Longrightarrow> x <# H \<subseteq> carrier G"
   3.702  by (auto simp add: l_coset_def subsetD)
   3.703  
   3.704 +lemma (in group) l_coset_carrier:
   3.705 +  "\<lbrakk> y \<in> x <# H; x \<in> carrier G; subgroup H G \<rbrakk> \<Longrightarrow> y \<in> carrier G"
   3.706 +  by (auto simp add: l_coset_def m_assoc  subgroup.subset [THEN subsetD] subgroup.m_closed)
   3.707 +
   3.708  lemma (in group) l_coset_swap:
   3.709 -     "\<lbrakk>y \<in> x <# H;  x \<in> carrier G;  subgroup H G\<rbrakk> \<Longrightarrow> x \<in> y <# H"
   3.710 -proof (simp add: l_coset_def)
   3.711 -  assume "\<exists>h\<in>H. y = x \<otimes> h"
   3.712 -    and x: "x \<in> carrier G"
   3.713 -    and sb: "subgroup H G"
   3.714 -  then obtain h' where h': "h' \<in> H \<and> x \<otimes> h' = y" by blast
   3.715 -  show "\<exists>h\<in>H. x = y \<otimes> h"
   3.716 +  assumes "y \<in> x <# H" "x \<in> carrier G" "subgroup H G" 
   3.717 +  shows "x \<in> y <# H"
   3.718 +  using assms(2) l_repr_independence[OF assms] subgroup.one_closed[OF assms(3)]
   3.719 +  unfolding l_coset_def by fastforce
   3.720 +
   3.721 +lemma (in group) subgroup_mult_id:
   3.722 +  assumes "subgroup H G"
   3.723 +  shows "H <#> H = H"
   3.724 +proof
   3.725 +  show "H <#> H \<subseteq> H"
   3.726 +    unfolding set_mult_def using subgroup.m_closed[OF assms] by (simp add: UN_subset_iff)
   3.727 +  show "H \<subseteq> H <#> H"
   3.728    proof
   3.729 -    show "x = y \<otimes> inv h'" using h' x sb
   3.730 -      by (auto simp add: m_assoc subgroup.subset [THEN subsetD])
   3.731 -    show "inv h' \<in> H" using h' sb
   3.732 -      by (auto simp add: subgroup.subset [THEN subsetD] subgroup.m_inv_closed)
   3.733 +    fix x assume x: "x \<in> H" thus "x \<in> H <#> H" unfolding set_mult_def
   3.734 +      using subgroup.m_closed[OF assms subgroup.one_closed[OF assms] x] subgroup.one_closed[OF assms]
   3.735 +      by (smt UN_iff assms coset_join3 l_coset_def subgroup.mem_carrier)
   3.736    qed
   3.737  qed
   3.738  
   3.739 -lemma (in group) l_coset_carrier:
   3.740 -     "[| y \<in> x <# H;  x \<in> carrier G;  subgroup H G |] ==> y \<in> carrier G"
   3.741 -by (auto simp add: l_coset_def m_assoc
   3.742 -                   subgroup.subset [THEN subsetD] subgroup.m_closed)
   3.743 -
   3.744 -lemma (in group) l_repr_imp_subset:
   3.745 -  assumes y: "y \<in> x <# H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   3.746 -  shows "y <# H \<subseteq> x <# H"
   3.747 -proof -
   3.748 -  from y
   3.749 -  obtain h' where "h' \<in> H" "x \<otimes> h' = y" by (auto simp add: l_coset_def)
   3.750 -  thus ?thesis using x sb
   3.751 -    by (auto simp add: l_coset_def m_assoc
   3.752 -                       subgroup.subset [THEN subsetD] subgroup.m_closed)
   3.753 -qed
   3.754 -
   3.755 -lemma (in group) l_repr_independence:
   3.756 -  assumes y: "y \<in> x <# H" and x: "x \<in> carrier G" and sb: "subgroup H G"
   3.757 -  shows "x <# H = y <# H"
   3.758 -proof
   3.759 -  show "x <# H \<subseteq> y <# H"
   3.760 -    by (rule l_repr_imp_subset,
   3.761 -        (blast intro: l_coset_swap l_coset_carrier y x sb)+)
   3.762 -  show "y <# H \<subseteq> x <# H" by (rule l_repr_imp_subset [OF y x sb])
   3.763 -qed
   3.764 -
   3.765 -lemma (in group) setmult_subset_G:
   3.766 -     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G\<rbrakk> \<Longrightarrow> H <#> K \<subseteq> carrier G"
   3.767 -by (auto simp add: set_mult_def subsetD)
   3.768 -
   3.769 -lemma (in group) subgroup_mult_id: "subgroup H G \<Longrightarrow> H <#> H = H"
   3.770 -apply (auto simp add: subgroup.m_closed set_mult_def Sigma_def)
   3.771 -apply (rule_tac x = x in bexI)
   3.772 -apply (rule bexI [of _ "\<one>"])
   3.773 -apply (auto simp add: subgroup.one_closed subgroup.subset [THEN subsetD])
   3.774 -done
   3.775 -
   3.776  
   3.777  subsubsection \<open>Set of Inverses of an \<open>r_coset\<close>.\<close>
   3.778  
   3.779 @@ -552,20 +538,21 @@
   3.780  subsubsection \<open>Theorems for \<open><#>\<close> with \<open>#>\<close> or \<open><#\<close>.\<close>
   3.781  
   3.782  lemma (in group) setmult_rcos_assoc:
   3.783 -     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk>
   3.784 -      \<Longrightarrow> H <#> (K #> x) = (H <#> K) #> x"
   3.785 -by (force simp add: r_coset_def set_mult_def m_assoc)
   3.786 +  "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk> \<Longrightarrow>
   3.787 +    H <#> (K #> x) = (H <#> K) #> x"
   3.788 +  using set_mult_assoc[of H K "{x}"] by (simp add: r_coset_eq_set_mult)
   3.789  
   3.790  lemma (in group) rcos_assoc_lcos:
   3.791 -     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk>
   3.792 -      \<Longrightarrow> (H #> x) <#> K = H <#> (x <# K)"
   3.793 -by (force simp add: r_coset_def l_coset_def set_mult_def m_assoc)
   3.794 +  "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk> \<Longrightarrow>
   3.795 +   (H #> x) <#> K = H <#> (x <# K)"
   3.796 +  using set_mult_assoc[of H "{x}" K]
   3.797 +  by (simp add: l_coset_eq_set_mult r_coset_eq_set_mult)
   3.798  
   3.799  lemma (in normal) rcos_mult_step1:
   3.800 -     "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   3.801 -      \<Longrightarrow> (H #> x) <#> (H #> y) = (H <#> (x <# H)) #> y"
   3.802 -by (simp add: setmult_rcos_assoc subset
   3.803 -              r_coset_subset_G l_coset_subset_G rcos_assoc_lcos)
   3.804 +  "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk> \<Longrightarrow>
   3.805 +   (H #> x) <#> (H #> y) = (H <#> (x <# H)) #> y"
   3.806 +  by (simp add: setmult_rcos_assoc r_coset_subset_G
   3.807 +                subset l_coset_subset_G rcos_assoc_lcos)
   3.808  
   3.809  lemma (in normal) rcos_mult_step2:
   3.810       "\<lbrakk>x \<in> carrier G; y \<in> carrier G\<rbrakk>
   3.811 @@ -645,7 +632,7 @@
   3.812  lemma (in subgroup) l_coset_eq_rcong:
   3.813    assumes "group G"
   3.814    assumes a: "a \<in> carrier G"
   3.815 -  shows "a <# H = rcong H `` {a}"
   3.816 +  shows "a <# H = (rcong H) `` {a}"
   3.817  proof -
   3.818    interpret group G by fact
   3.819    show ?thesis by (force simp add: r_congruent_def l_coset_def m_assoc [symmetric] a ) 
   3.820 @@ -661,9 +648,7 @@
   3.821  proof -
   3.822    interpret subgroup H G by fact
   3.823    from p show ?thesis apply (rule_tac UN_I [of "hb \<otimes> ((inv ha) \<otimes> h)"])
   3.824 -    apply (simp add: )
   3.825 -    apply (simp add: m_assoc transpose_inv)
   3.826 -    done
   3.827 +    apply blast by (simp add: inv_solve_left m_assoc)
   3.828  qed
   3.829  
   3.830  lemma (in group) rcos_disjoint:
   3.831 @@ -793,28 +778,47 @@
   3.832      "\<lbrakk>H \<subseteq> carrier G;  a \<in> carrier G\<rbrakk> \<Longrightarrow> inj_on (\<lambda>y. y \<otimes> a) H"
   3.833  by (force simp add: inj_on_def subsetD)
   3.834  
   3.835 +(* ************************************************************************** *)
   3.836 +
   3.837  lemma (in group) card_cosets_equal:
   3.838 -     "\<lbrakk>c \<in> rcosets H;  H \<subseteq> carrier G; finite(carrier G)\<rbrakk>
   3.839 -      \<Longrightarrow> card c = card H"
   3.840 -apply (auto simp add: RCOSETS_def)
   3.841 -apply (rule card_bij_eq)
   3.842 -     apply (rule inj_on_f, assumption+)
   3.843 -    apply (force simp add: m_assoc subsetD r_coset_def)
   3.844 -   apply (rule inj_on_g, assumption+)
   3.845 -  apply (force simp add: m_assoc subsetD r_coset_def)
   3.846 - txt\<open>The sets @{term "H #> a"} and @{term "H"} are finite.\<close>
   3.847 - apply (simp add: r_coset_subset_G [THEN finite_subset])
   3.848 -apply (blast intro: finite_subset)
   3.849 -done
   3.850 +  assumes "R \<in> rcosets H" "H \<subseteq> carrier G"
   3.851 +  shows "\<exists>f. bij_betw f H R"
   3.852 +proof -
   3.853 +  obtain g where g: "g \<in> carrier G" "R = H #> g"
   3.854 +    using assms(1) unfolding RCOSETS_def by blast
   3.855 +
   3.856 +  let ?f = "\<lambda>h. h \<otimes> g"
   3.857 +  have "\<And>r. r \<in> R \<Longrightarrow> \<exists>h \<in> H. ?f h = r"
   3.858 +  proof -
   3.859 +    fix r assume "r \<in> R"
   3.860 +    then obtain h where "h \<in> H" "r = h \<otimes> g"
   3.861 +      using g unfolding r_coset_def by blast
   3.862 +    thus "\<exists>h \<in> H. ?f h = r" by blast
   3.863 +  qed
   3.864 +  hence "R \<subseteq> ?f ` H" by blast
   3.865 +  moreover have "?f ` H \<subseteq> R"
   3.866 +    using g unfolding r_coset_def by blast
   3.867 +  ultimately show ?thesis using inj_on_g unfolding bij_betw_def
   3.868 +    using assms(2) g(1) by auto 
   3.869 +qed
   3.870 +
   3.871 +corollary (in group) card_rcosets_equal:
   3.872 +  assumes "R \<in> rcosets H" "H \<subseteq> carrier G"
   3.873 +  shows "card H = card R"
   3.874 +  using card_cosets_equal assms bij_betw_same_card by blast
   3.875 +
   3.876 +corollary (in group) rcosets_finite:
   3.877 +  assumes "R \<in> rcosets H" "H \<subseteq> carrier G" "finite H"
   3.878 +  shows "finite R"
   3.879 +  using card_cosets_equal assms bij_betw_finite is_group by blast
   3.880 +
   3.881 +(* ************************************************************************** *)
   3.882  
   3.883  lemma (in group) rcosets_subset_PowG:
   3.884       "subgroup H G  \<Longrightarrow> rcosets H \<subseteq> Pow(carrier G)"
   3.885 -apply (simp add: RCOSETS_def)
   3.886 -apply (blast dest: r_coset_subset_G subgroup.subset)
   3.887 -done
   3.888 +  using rcosets_part_G by auto
   3.889  
   3.890 -
   3.891 -theorem (in group) lagrange:
   3.892 +proposition (in group) lagrange_finite:
   3.893       "\<lbrakk>finite(carrier G); subgroup H G\<rbrakk>
   3.894        \<Longrightarrow> card(rcosets H) * card(H) = order(G)"
   3.895  apply (simp (no_asm_simp) add: order_def rcosets_part_G [symmetric])
   3.896 @@ -822,10 +826,42 @@
   3.897  apply (rule card_partition)
   3.898     apply (simp add: rcosets_subset_PowG [THEN finite_subset])
   3.899    apply (simp add: rcosets_part_G)
   3.900 - apply (simp add: card_cosets_equal subgroup.subset)
   3.901 +  apply (simp add: card_rcosets_equal subgroup_imp_subset)
   3.902  apply (simp add: rcos_disjoint)
   3.903  done
   3.904  
   3.905 +theorem (in group) lagrange:
   3.906 +  assumes "subgroup H G"
   3.907 +  shows "card (rcosets H) * card H = order G"
   3.908 +proof (cases "finite (carrier G)")
   3.909 +  case True thus ?thesis using lagrange_finite assms by simp
   3.910 +next
   3.911 +  case False note inf_G = this
   3.912 +  thus ?thesis
   3.913 +  proof (cases "finite H")
   3.914 +    case False thus ?thesis using inf_G  by (simp add: order_def)  
   3.915 +  next
   3.916 +    case True note finite_H = this
   3.917 +    have "infinite (rcosets H)"
   3.918 +    proof (rule ccontr)
   3.919 +      assume "\<not> infinite (rcosets H)"
   3.920 +      hence finite_rcos: "finite (rcosets H)" by simp
   3.921 +      hence "card (\<Union>(rcosets H)) = (\<Sum>R\<in>(rcosets H). card R)"
   3.922 +        using card_Union_disjoint[of "rcosets H"] finite_H rcos_disjoint[OF assms(1)]
   3.923 +              rcosets_finite[where ?H = H] by (simp add: assms subgroup_imp_subset)
   3.924 +      hence "order G = (\<Sum>R\<in>(rcosets H). card R)"
   3.925 +        by (simp add: assms order_def rcosets_part_G)
   3.926 +      hence "order G = (\<Sum>R\<in>(rcosets H). card H)"
   3.927 +        using card_rcosets_equal by (simp add: assms subgroup_imp_subset)
   3.928 +      hence "order G = (card H) * (card (rcosets H))" by simp
   3.929 +      hence "order G \<noteq> 0" using finite_rcos finite_H assms ex_in_conv
   3.930 +                                rcosets_part_G subgroup.one_closed by fastforce
   3.931 +      thus False using inf_G order_gt_0_iff_finite by blast 
   3.932 +    qed
   3.933 +    thus ?thesis using inf_G by (simp add: order_def)
   3.934 +  qed
   3.935 +qed
   3.936 +
   3.937  
   3.938  subsection \<open>Quotient Groups: Factorization of a Group\<close>
   3.939  
   3.940 @@ -845,7 +881,7 @@
   3.941  lemma (in normal) rcosets_assoc:
   3.942       "\<lbrakk>M1 \<in> rcosets H; M2 \<in> rcosets H; M3 \<in> rcosets H\<rbrakk>
   3.943        \<Longrightarrow> M1 <#> M2 <#> M3 = M1 <#> (M2 <#> M3)"
   3.944 -by (auto simp add: RCOSETS_def rcos_sum m_assoc)
   3.945 +  by (simp add: group.set_mult_assoc is_group rcosets_carrier)
   3.946  
   3.947  lemma (in subgroup) subgroup_in_rcosets:
   3.948    assumes "group G"
   3.949 @@ -1016,10 +1052,111 @@
   3.950  
   3.951  text\<open>If @{term h} is a homomorphism from @{term G} onto @{term H}, then the
   3.952   quotient group @{term "G Mod (kernel G H h)"} is isomorphic to @{term H}.\<close>
   3.953 -theorem (in group_hom) FactGroup_iso:
   3.954 +theorem (in group_hom) FactGroup_iso_set:
   3.955    "h ` carrier G = carrier H
   3.956 -   \<Longrightarrow> (\<lambda>X. the_elem (h`X)) \<in> (G Mod (kernel G H h)) \<cong> H"
   3.957 +   \<Longrightarrow> (\<lambda>X. the_elem (h`X)) \<in> iso (G Mod (kernel G H h)) H"
   3.958  by (simp add: iso_def FactGroup_hom FactGroup_inj_on bij_betw_def 
   3.959                FactGroup_onto) 
   3.960  
   3.961 +corollary (in group_hom) FactGroup_iso :
   3.962 +  "h ` carrier G = carrier H
   3.963 +   \<Longrightarrow> (G Mod (kernel G H h))\<cong> H"
   3.964 +  using FactGroup_iso_set unfolding is_iso_def by auto
   3.965 +
   3.966 +
   3.967 +(* Next two lemmas contributed by Paulo Emílio de Vilhena. *)
   3.968 +
   3.969 +lemma (in group_hom) trivial_hom_iff:
   3.970 +  "(h ` (carrier G) = { \<one>\<^bsub>H\<^esub> }) = (kernel G H h = carrier G)"
   3.971 +  unfolding kernel_def using one_closed by force
   3.972 +
   3.973 +lemma (in group_hom) trivial_ker_imp_inj:
   3.974 +  assumes "kernel G H h = { \<one> }"
   3.975 +  shows "inj_on h (carrier G)"
   3.976 +proof (rule inj_onI)
   3.977 +  fix g1 g2 assume A: "g1 \<in> carrier G" "g2 \<in> carrier G" "h g1 = h g2"
   3.978 +  hence "h (g1 \<otimes> (inv g2)) = \<one>\<^bsub>H\<^esub>" by simp
   3.979 +  hence "g1 \<otimes> (inv g2) = \<one>"
   3.980 +    using A assms unfolding kernel_def by blast
   3.981 +  thus "g1 = g2"
   3.982 +    using A G.inv_equality G.inv_inv by blast
   3.983 +qed
   3.984 +
   3.985 +
   3.986 +(* Next subsection contributed by Martin Baillon. *)
   3.987 +
   3.988 +subsection \<open>Theorems about Factor Groups and Direct product\<close>
   3.989 +
   3.990 +
   3.991 +lemma (in group) DirProd_normal :
   3.992 +  assumes "group K"
   3.993 +    and "H \<lhd> G"
   3.994 +    and "N \<lhd> K"
   3.995 +  shows "H \<times> N \<lhd> G \<times>\<times> K"
   3.996 +proof (intro group.normal_invI[OF DirProd_group[OF group_axioms assms(1)]])
   3.997 +  show sub : "subgroup (H \<times> N) (G \<times>\<times> K)"
   3.998 +    using DirProd_subgroups[OF group_axioms normal_imp_subgroup[OF assms(2)]assms(1)
   3.999 +         normal_imp_subgroup[OF assms(3)]].
  3.1000 +  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.1001 +  proof-
  3.1002 +    fix x h assume xGK : "x \<in> carrier (G \<times>\<times> K)" and hHN : " h \<in> H \<times> N"
  3.1003 +    hence hGK : "h \<in> carrier (G \<times>\<times> K)" using subgroup_imp_subset[OF sub] by auto
  3.1004 +    from xGK obtain x1 x2 where x1x2 :"x1 \<in> carrier G" "x2 \<in> carrier K" "x = (x1,x2)"
  3.1005 +      unfolding DirProd_def by fastforce
  3.1006 +    from hHN obtain h1 h2 where h1h2 : "h1 \<in> H" "h2 \<in> N" "h = (h1,h2)"
  3.1007 +      unfolding DirProd_def by fastforce
  3.1008 +    hence h1h2GK : "h1 \<in> carrier G" "h2 \<in> carrier K"
  3.1009 +      using normal_imp_subgroup subgroup_imp_subset assms apply blast+.
  3.1010 +    have "inv\<^bsub>G \<times>\<times> K\<^esub> x = (inv\<^bsub>G\<^esub> x1,inv\<^bsub>K\<^esub> x2)"
  3.1011 +      using inv_DirProd[OF group_axioms assms(1) x1x2(1)x1x2(2)] x1x2 by auto
  3.1012 +    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.1013 +      using h1h2 x1x2 h1h2GK by auto
  3.1014 +    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.1015 +      using normal_invE group.normal_invE[OF assms(1)] assms x1x2 h1h2 apply auto.
  3.1016 +    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.1017 +    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.1018 +  qed
  3.1019 +qed
  3.1020 +
  3.1021 +lemma (in group) FactGroup_DirProd_multiplication_iso_set :
  3.1022 +  assumes "group K"
  3.1023 +    and "H \<lhd> G"
  3.1024 +    and "N \<lhd> K"
  3.1025 +  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.1026 +
  3.1027 +proof-
  3.1028 +  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.1029 +    unfolding r_coset_def Sigma_def DirProd_def FactGroup_def RCOSETS_def apply simp by blast
  3.1030 +  moreover have "(\<forall>x\<in>carrier (G Mod H). \<forall>y\<in>carrier (K Mod N). \<forall>xa\<in>carrier (G Mod H).
  3.1031 +                \<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.1032 +    unfolding set_mult_def apply auto apply blast+.
  3.1033 +  moreover have "(\<forall>x\<in>carrier (G Mod H). \<forall>y\<in>carrier (K Mod N). \<forall>xa\<in>carrier (G Mod H).
  3.1034 +                 \<forall>ya\<in>carrier (K Mod N).  x \<times> y = xa \<times> ya \<longrightarrow> x = xa \<and> y = ya)"
  3.1035 +    unfolding  FactGroup_def using times_eq_iff subgroup.rcosets_not_empty
  3.1036 +    by (metis assms(2) assms(3) normal_def partial_object.select_convs(1))
  3.1037 +  moreover have "(\<lambda>(X, Y). X \<times> Y) ` (carrier (G Mod H) \<times> carrier (K Mod N)) = 
  3.1038 +                                     carrier (G \<times>\<times> K Mod H \<times> N)"
  3.1039 +    unfolding image_def  apply auto using R apply force
  3.1040 +    unfolding DirProd_def FactGroup_def RCOSETS_def r_coset_def apply auto apply force.
  3.1041 +  ultimately show ?thesis
  3.1042 +    unfolding iso_def hom_def bij_betw_def inj_on_def by simp
  3.1043 +qed
  3.1044 +
  3.1045 +corollary (in group) FactGroup_DirProd_multiplication_iso_1 :
  3.1046 +  assumes "group K"
  3.1047 +    and "H \<lhd> G"
  3.1048 +    and "N \<lhd> K"
  3.1049 +  shows "  ((G Mod H) \<times>\<times> (K Mod N)) \<cong> (G \<times>\<times> K Mod H \<times> N)"
  3.1050 +  unfolding is_iso_def using FactGroup_DirProd_multiplication_iso_set assms by auto
  3.1051 +
  3.1052 +corollary (in group) FactGroup_DirProd_multiplication_iso_2 :
  3.1053 +  assumes "group K"
  3.1054 +    and "H \<lhd> G"
  3.1055 +    and "N \<lhd> K"
  3.1056 +  shows "(G \<times>\<times> K Mod H \<times> N) \<cong> ((G Mod H) \<times>\<times> (K Mod N))"
  3.1057 +  using FactGroup_DirProd_multiplication_iso_1 group.iso_sym assms
  3.1058 +        DirProd_group[OF normal.factorgroup_is_group normal.factorgroup_is_group]
  3.1059 +  by blast
  3.1060 +
  3.1061 +
  3.1062  end
     4.1 --- a/src/HOL/Algebra/Group.thy	Tue Jun 12 16:21:52 2018 +0200
     4.2 +++ b/src/HOL/Algebra/Group.thy	Tue Jun 12 16:09:12 2018 +0100
     4.3 @@ -75,6 +75,12 @@
     4.4    "x \<in> Units G ==> x \<in> carrier G"
     4.5    by (unfold Units_def) fast
     4.6  
     4.7 +lemma (in monoid) one_unique:
     4.8 +  assumes "u \<in> carrier G"
     4.9 +    and "\<And>x. x \<in> carrier G \<Longrightarrow> u \<otimes> x = x"
    4.10 +  shows "u = \<one>"
    4.11 +  using assms(2)[OF one_closed] r_one[OF assms(1)] by simp
    4.12 +
    4.13  lemma (in monoid) inv_unique:
    4.14    assumes eq: "y \<otimes> x = \<one>"  "x \<otimes> y' = \<one>"
    4.15      and G: "x \<in> carrier G"  "y \<in> carrier G"  "y' \<in> carrier G"
    4.16 @@ -86,7 +92,7 @@
    4.17    finally show ?thesis .
    4.18  qed
    4.19  
    4.20 -lemma (in monoid) Units_m_closed [intro, simp]:
    4.21 +lemma (in monoid) Units_m_closed [simp, intro]:
    4.22    assumes x: "x \<in> Units G" and y: "y \<in> Units G"
    4.23    shows "x \<otimes> y \<in> Units G"
    4.24  proof -
    4.25 @@ -215,10 +221,23 @@
    4.26    "x \<in> carrier G ==> x [^] (n::nat) \<otimes> x [^] m = x [^] (n + m)"
    4.27    by (induct m) (simp_all add: m_assoc [THEN sym])
    4.28  
    4.29 +lemma (in monoid) nat_pow_comm:
    4.30 +  "x \<in> carrier G \<Longrightarrow> (x [^] (n::nat)) \<otimes> (x [^] (m :: nat)) = (x [^] m) \<otimes> (x [^] n)"
    4.31 +  using nat_pow_mult[of x n m] nat_pow_mult[of x m n] by (simp add: add.commute) 
    4.32 +
    4.33 +lemma (in monoid) nat_pow_Suc2:
    4.34 +  "x \<in> carrier G \<Longrightarrow> x [^] (Suc n) = x \<otimes> (x [^] n)"
    4.35 +  using nat_pow_mult[of x 1 n] Suc_eq_plus1[of n]
    4.36 +  by (metis One_nat_def Suc_eq_plus1_left l_one nat.rec(1) nat_pow_Suc nat_pow_def) 
    4.37 +
    4.38  lemma (in monoid) nat_pow_pow:
    4.39    "x \<in> carrier G ==> (x [^] n) [^] m = x [^] (n * m::nat)"
    4.40    by (induct m) (simp, simp add: nat_pow_mult add.commute)
    4.41  
    4.42 +lemma (in monoid) nat_pow_consistent:
    4.43 +  "x [^] (n :: nat) = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
    4.44 +  unfolding nat_pow_def by simp
    4.45 +  
    4.46  
    4.47  (* Jacobson defines submonoid here. *)
    4.48  (* Jacobson defines the order of a monoid here. *)
    4.49 @@ -416,6 +435,57 @@
    4.50      by (auto simp add: int_pow_def2 inv_solve_left inv_solve_right nat_add_distrib [symmetric] nat_pow_mult )
    4.51  qed
    4.52  
    4.53 +lemma (in group) nat_pow_inv:
    4.54 +  "x \<in> carrier G \<Longrightarrow> (inv x) [^] (i :: nat) = inv (x [^] i)"
    4.55 +proof (induction i)
    4.56 +  case 0 thus ?case by simp
    4.57 +next
    4.58 +  case (Suc i)
    4.59 +  have "(inv x) [^] Suc i = ((inv x) [^] i) \<otimes> inv x"
    4.60 +    by simp
    4.61 +  also have " ... = (inv (x [^] i)) \<otimes> inv x"
    4.62 +    by (simp add: Suc.IH Suc.prems)
    4.63 +  also have " ... = inv (x \<otimes> (x [^] i))"
    4.64 +    using inv_mult_group[OF Suc.prems nat_pow_closed[OF Suc.prems, of i]] by simp
    4.65 +  also have " ... = inv (x [^] (Suc i))"
    4.66 +    using Suc.prems nat_pow_Suc2 by auto
    4.67 +  finally show ?case . 
    4.68 +qed
    4.69 +
    4.70 +lemma (in group) int_pow_inv:
    4.71 +  "x \<in> carrier G \<Longrightarrow> (inv x) [^] (i :: int) = inv (x [^] i)"
    4.72 +  by (simp add: nat_pow_inv int_pow_def2)
    4.73 +
    4.74 +lemma (in group) int_pow_pow:
    4.75 +  assumes "x \<in> carrier G"
    4.76 +  shows "(x [^] (n :: int)) [^] (m :: int) = x [^] (n * m :: int)"
    4.77 +proof (cases)
    4.78 +  assume n_ge: "n \<ge> 0" thus ?thesis
    4.79 +  proof (cases)
    4.80 +    assume m_ge: "m \<ge> 0" thus ?thesis
    4.81 +      using n_ge nat_pow_pow[OF assms, of "nat n" "nat m"] int_pow_def2
    4.82 +      by (simp add: mult_less_0_iff nat_mult_distrib)
    4.83 +  next
    4.84 +    assume m_lt: "\<not> m \<ge> 0" thus ?thesis
    4.85 +      using n_ge int_pow_def2 nat_pow_pow[OF assms, of "nat n" "nat (- m)"]
    4.86 +      by (smt assms group.int_pow_neg is_group mult_minus_right nat_mult_distrib split_mult_neg_le)
    4.87 +  qed
    4.88 +next
    4.89 +  assume n_lt: "\<not> n \<ge> 0" thus ?thesis
    4.90 +  proof (cases)
    4.91 +    assume m_ge: "m \<ge> 0" thus ?thesis
    4.92 +      using n_lt nat_pow_pow[OF assms, of "nat (- n)" "nat m"]
    4.93 +            nat_pow_inv[of "x [^] nat (- n)" "nat m"] int_pow_def2
    4.94 +      by (smt assms group.int_pow_closed group.int_pow_neg is_group mult_minus_right
    4.95 +          mult_nonpos_nonpos nat_mult_distrib_neg)
    4.96 +  next
    4.97 +    assume m_lt: "\<not> m \<ge> 0" thus ?thesis
    4.98 +      using n_lt nat_pow_pow[OF assms, of "nat (- n)" "nat (- m)"]
    4.99 +            nat_pow_inv[of "x [^] nat (- n)" "nat (- m)"] int_pow_def2
   4.100 +      by (smt assms inv_inv mult_nonpos_nonpos nat_mult_distrib_neg nat_pow_closed)
   4.101 +  qed
   4.102 +qed
   4.103 +
   4.104  lemma (in group) int_pow_diff:
   4.105    "x \<in> carrier G \<Longrightarrow> x [^] (n - m :: int) = x [^] n \<otimes> inv (x [^] m)"
   4.106  by(simp only: diff_conv_add_uminus int_pow_mult int_pow_neg)
   4.107 @@ -426,6 +496,70 @@
   4.108  lemma (in group) inj_on_cmult: "c \<in> carrier G \<Longrightarrow> inj_on (\<lambda>x. c \<otimes> x) (carrier G)"
   4.109  by(simp add: inj_on_def)
   4.110  
   4.111 +(*Following subsection contributed by Martin Baillon*)
   4.112 +subsection \<open>Submonoids\<close>
   4.113 +
   4.114 +locale submonoid =
   4.115 +  fixes H and G (structure)
   4.116 +  assumes subset: "H \<subseteq> carrier G"
   4.117 +    and m_closed [intro, simp]: "\<lbrakk>x \<in> H; y \<in> H\<rbrakk> \<Longrightarrow> x \<otimes> y \<in> H"
   4.118 +    and one_closed [simp]: "\<one> \<in> H"
   4.119 +
   4.120 +lemma (in submonoid) is_submonoid:
   4.121 +  "submonoid H G" by (rule submonoid_axioms)
   4.122 +
   4.123 +lemma (in submonoid) mem_carrier [simp]:
   4.124 +  "x \<in> H \<Longrightarrow> x \<in> carrier G"
   4.125 +  using subset by blast
   4.126 +
   4.127 +lemma submonoid_imp_subset:
   4.128 +  "submonoid H G \<Longrightarrow> H \<subseteq> carrier G"
   4.129 +  by (rule submonoid.subset)
   4.130 +
   4.131 +lemma (in submonoid) submonoid_is_monoid [intro]:
   4.132 +  assumes "monoid G"
   4.133 +  shows "monoid (G\<lparr>carrier := H\<rparr>)"
   4.134 +proof -
   4.135 +  interpret monoid G by fact
   4.136 +  show ?thesis
   4.137 +    by (simp add: monoid_def m_assoc)
   4.138 +qed
   4.139 +
   4.140 +lemma (in monoid) submonoidE:
   4.141 +  assumes "submonoid H G"
   4.142 +  shows "H \<subseteq> carrier G"
   4.143 +    and "H \<noteq> {}"
   4.144 +    and "\<And>a b. \<lbrakk>a \<in> H; b \<in> H\<rbrakk> \<Longrightarrow> a \<otimes> b \<in> H"
   4.145 +  using assms submonoid_imp_subset apply blast
   4.146 +  using assms submonoid_def apply auto[1]
   4.147 +  by (simp add: assms submonoid.m_closed)+
   4.148 +
   4.149 +lemma submonoid_nonempty:
   4.150 +  "~ submonoid {} G"
   4.151 +  by (blast dest: submonoid.one_closed)
   4.152 +
   4.153 +lemma (in submonoid) finite_monoid_imp_card_positive:
   4.154 +  "finite (carrier G) ==> 0 < card H"
   4.155 +proof (rule classical)
   4.156 +  assume "finite (carrier G)" and a: "~ 0 < card H"
   4.157 +  then have "finite H" by (blast intro: finite_subset [OF subset])
   4.158 +  with is_submonoid a have "submonoid {} G" by simp
   4.159 +  with submonoid_nonempty show ?thesis by contradiction
   4.160 +qed
   4.161 +
   4.162 +
   4.163 +lemma (in monoid) monoid_incl_imp_submonoid :
   4.164 +  assumes "H \<subseteq> carrier G"
   4.165 +and "monoid (G\<lparr>carrier := H\<rparr>)"
   4.166 +shows "submonoid H G"
   4.167 +proof (intro submonoid.intro[OF assms(1)])
   4.168 +  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
   4.169 +  have "\<And>a b. a \<in> H \<Longrightarrow> b \<in> H \<Longrightarrow> a \<otimes> b \<in> carrier (G\<lparr>carrier := H\<rparr>) "
   4.170 +    using assms ab_eq unfolding group_def using monoid.m_closed by fastforce
   4.171 +  thus "\<And>a b. a \<in> H \<Longrightarrow> b \<in> H \<Longrightarrow> a \<otimes> b \<in> H" by simp
   4.172 +  show "\<one> \<in> H " using monoid.one_closed[OF assms(2)] assms by simp
   4.173 +qed
   4.174 +
   4.175  subsection \<open>Subgroups\<close>
   4.176  
   4.177  locale subgroup =
   4.178 @@ -460,6 +594,40 @@
   4.179      done
   4.180  qed
   4.181  
   4.182 +lemma (in group) m_inv_consistent:
   4.183 +  assumes "subgroup H G" "x \<in> H"
   4.184 +  shows "inv x = inv\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> x"
   4.185 +  unfolding m_inv_def apply auto
   4.186 +  using subgroup.m_inv_closed[OF assms] inv_equality
   4.187 +  by (metis (no_types, hide_lams) assms subgroup.mem_carrier)
   4.188 +
   4.189 +lemma (in group) int_pow_consistent: (* by Paulo *)
   4.190 +  assumes "subgroup H G" "x \<in> H"
   4.191 +  shows "x [^] (n :: int) = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
   4.192 +proof (cases)
   4.193 +  assume ge: "n \<ge> 0"
   4.194 +  hence "x [^] n = x [^] (nat n)"
   4.195 +    using int_pow_def2 by auto
   4.196 +  also have " ... = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (nat n)"
   4.197 +    using nat_pow_consistent by simp
   4.198 +  also have " ... = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
   4.199 +    using group.int_pow_def2[OF subgroup.subgroup_is_group[OF assms(1) is_group]] ge by auto
   4.200 +  finally show ?thesis .
   4.201 +next 
   4.202 +  assume "\<not> n \<ge> 0" hence lt: "n < 0" by simp
   4.203 +  hence "x [^] n = inv (x [^] (nat (- n)))"
   4.204 +    using int_pow_def2 by auto
   4.205 +  also have " ... = (inv x) [^] (nat (- n))"
   4.206 +    by (metis assms nat_pow_inv subgroup.mem_carrier)
   4.207 +  also have " ... = (inv\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> x) [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (nat (- n))"
   4.208 +    using m_inv_consistent[OF assms] nat_pow_consistent by auto
   4.209 +  also have " ... = inv\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> (nat (- n)))"
   4.210 +    using group.nat_pow_inv[OF subgroup.subgroup_is_group[OF assms(1) is_group]] assms(2) by auto
   4.211 +  also have " ... = x [^]\<^bsub>(G \<lparr> carrier := H \<rparr>)\<^esub> n"
   4.212 +    using group.int_pow_def2[OF subgroup.subgroup_is_group[OF assms(1) is_group]] lt by auto
   4.213 +  finally show ?thesis .
   4.214 +qed
   4.215 +
   4.216  text \<open>
   4.217    Since @{term H} is nonempty, it contains some element @{term x}.  Since
   4.218    it is closed under inverse, it contains \<open>inv x\<close>.  Since
   4.219 @@ -482,6 +650,17 @@
   4.220    show "\<one> \<in> H" by (rule one_in_subset) (auto simp only: assms)
   4.221  qed
   4.222  
   4.223 +
   4.224 +lemma (in group) subgroupE:
   4.225 +  assumes "subgroup H G"
   4.226 +  shows "H \<subseteq> carrier G"
   4.227 +    and "H \<noteq> {}"
   4.228 +    and "\<And>a. a \<in> H \<Longrightarrow> inv a \<in> H"
   4.229 +    and "\<And>a b. \<lbrakk>a \<in> H; b \<in> H\<rbrakk> \<Longrightarrow> a \<otimes> b \<in> H"
   4.230 +  using assms subgroup_imp_subset apply blast
   4.231 +  using assms subgroup_def apply auto[1]
   4.232 +  by (simp add: assms subgroup.m_closed subgroup.m_inv_closed)+
   4.233 +
   4.234  declare monoid.one_closed [iff] group.inv_closed [simp]
   4.235    monoid.l_one [simp] monoid.r_one [simp] group.inv_inv [simp]
   4.236  
   4.237 @@ -498,12 +677,44 @@
   4.238    with subgroup_nonempty show ?thesis by contradiction
   4.239  qed
   4.240  
   4.241 +(*Following 3 lemmas contributed by Martin Baillon*)
   4.242 +
   4.243 +lemma (in subgroup) subgroup_is_submonoid :
   4.244 +  "submonoid H G"
   4.245 +  by (simp add: submonoid.intro subset)
   4.246 +
   4.247 +lemma (in group) submonoid_subgroupI :
   4.248 +  assumes "submonoid H G"
   4.249 +    and "\<And>a. a \<in> H \<Longrightarrow> inv a \<in> H"
   4.250 +  shows "subgroup H G"
   4.251 +  by (metis assms subgroup_def submonoid_def)
   4.252 +
   4.253 +lemma (in group) group_incl_imp_subgroup:
   4.254 +  assumes "H \<subseteq> carrier G"
   4.255 +and "group (G\<lparr>carrier := H\<rparr>)"
   4.256 +shows "subgroup H G"
   4.257 +proof (intro submonoid_subgroupI[OF monoid_incl_imp_submonoid[OF assms(1)]])
   4.258 +  show "monoid (G\<lparr>carrier := H\<rparr>)" using group_def assms by blast
   4.259 +  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
   4.260 +  fix a  assume aH : "a \<in> H" 
   4.261 +  have " inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a \<in> carrier G"
   4.262 +    using assms aH group.inv_closed[OF assms(2)] by auto
   4.263 +  moreover have "\<one>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> = \<one>" using assms monoid.one_closed ab_eq one_def by simp
   4.264 +  hence "a \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a= \<one>"
   4.265 +    using assms ab_eq aH  group.r_inv[OF assms(2)] by simp
   4.266 +  hence "a \<otimes> inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a= \<one>"
   4.267 +    using aH assms group.inv_closed[OF assms(2)] ab_eq by simp
   4.268 +  ultimately have "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a = inv a"
   4.269 +    by (smt aH assms(1) contra_subsetD group.inv_inv is_group local.inv_equality)
   4.270 +  moreover have "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> a \<in> H" using aH group.inv_closed[OF assms(2)] by auto
   4.271 +  ultimately show "inv a \<in> H" by auto
   4.272 +qed
   4.273 +
   4.274  (*
   4.275  lemma (in monoid) Units_subgroup:
   4.276    "subgroup (Units G) G"
   4.277  *)
   4.278  
   4.279 -
   4.280  subsection \<open>Direct Products\<close>
   4.281  
   4.282  definition
   4.283 @@ -548,6 +759,10 @@
   4.284       "(g, h) \<otimes>\<^bsub>(G \<times>\<times> H)\<^esub> (g', h') = (g \<otimes>\<^bsub>G\<^esub> g', h \<otimes>\<^bsub>H\<^esub> h')"
   4.285    by (simp add: DirProd_def)
   4.286  
   4.287 +lemma DirProd_assoc :
   4.288 +"(G \<times>\<times> H \<times>\<times> I) = (G \<times>\<times> (H \<times>\<times> I))"
   4.289 +  by auto
   4.290 +
   4.291  lemma inv_DirProd [simp]:
   4.292    assumes "group G" and "group H"
   4.293    assumes g: "g \<in> carrier G"
   4.294 @@ -561,6 +776,22 @@
   4.295    show ?thesis by (simp add: Prod.inv_equality g h)
   4.296  qed
   4.297  
   4.298 +lemma DirProd_subgroups :
   4.299 +  assumes "group G"
   4.300 +and "subgroup H G"
   4.301 +and "group K"
   4.302 +and "subgroup I K"
   4.303 +shows "subgroup (H \<times> I) (G \<times>\<times> K)"
   4.304 +proof (intro group.group_incl_imp_subgroup[OF DirProd_group[OF assms(1)assms(3)]])
   4.305 +  have "H \<subseteq> carrier G" "I \<subseteq> carrier K" using subgroup_imp_subset assms apply blast+.
   4.306 +  thus "(H \<times> I) \<subseteq> carrier (G \<times>\<times> K)" unfolding DirProd_def by auto
   4.307 +  have "Group.group ((G\<lparr>carrier := H\<rparr>) \<times>\<times> (K\<lparr>carrier := I\<rparr>))"
   4.308 +    using DirProd_group[OF subgroup.subgroup_is_group[OF assms(2)assms(1)]
   4.309 +                           subgroup.subgroup_is_group[OF assms(4)assms(3)]].
   4.310 +  moreover have "((G\<lparr>carrier := H\<rparr>) \<times>\<times> (K\<lparr>carrier := I\<rparr>)) = ((G \<times>\<times> K)\<lparr>carrier := H \<times> I\<rparr>)"
   4.311 +    unfolding DirProd_def using assms apply simp.
   4.312 +  ultimately show "Group.group ((G \<times>\<times> K)\<lparr>carrier := H \<times> I\<rparr>)" by simp
   4.313 +qed
   4.314  
   4.315  subsection \<open>Homomorphisms and Isomorphisms\<close>
   4.316  
   4.317 @@ -575,31 +806,203 @@
   4.318  by (fastforce simp add: hom_def compose_def)
   4.319  
   4.320  definition
   4.321 -  iso :: "_ => _ => ('a => 'b) set" (infixr "\<cong>" 60)
   4.322 -  where "G \<cong> H = {h. h \<in> hom G H \<and> bij_betw h (carrier G) (carrier H)}"
   4.323 +  iso :: "_ => _ => ('a => 'b) set" 
   4.324 +  where "iso G H = {h. h \<in> hom G H \<and> bij_betw h (carrier G) (carrier H)}"
   4.325  
   4.326 -lemma iso_refl: "(\<lambda>x. x) \<in> G \<cong> G"
   4.327 -by (simp add: iso_def hom_def inj_on_def bij_betw_def Pi_def)
   4.328 +definition
   4.329 +  is_iso :: "_ \<Rightarrow> _ \<Rightarrow> bool" (infixr "\<cong>" 60)
   4.330 +  where "G \<cong> H = (iso G H  \<noteq> {})" 
   4.331  
   4.332 -lemma (in group) iso_sym:
   4.333 -     "h \<in> G \<cong> H \<Longrightarrow> inv_into (carrier G) h \<in> H \<cong> G"
   4.334 +lemma iso_set_refl: "(\<lambda>x. x) \<in> iso G G"
   4.335 +  by (simp add: iso_def hom_def inj_on_def bij_betw_def Pi_def)
   4.336 +
   4.337 +corollary iso_refl : "G \<cong> G"
   4.338 +  using iso_set_refl unfolding is_iso_def by auto
   4.339 +
   4.340 +lemma (in group) iso_set_sym:
   4.341 +     "h \<in> iso G H \<Longrightarrow> inv_into (carrier G) h \<in> (iso H G)"
   4.342  apply (simp add: iso_def bij_betw_inv_into) 
   4.343  apply (subgoal_tac "inv_into (carrier G) h \<in> carrier H \<rightarrow> carrier G") 
   4.344   prefer 2 apply (simp add: bij_betw_imp_funcset [OF bij_betw_inv_into]) 
   4.345  apply (simp add: hom_def bij_betw_def inv_into_f_eq f_inv_into_f Pi_def)
   4.346  done
   4.347  
   4.348 -lemma (in group) iso_trans: 
   4.349 -     "[|h \<in> G \<cong> H; i \<in> H \<cong> I|] ==> (compose (carrier G) i h) \<in> G \<cong> I"
   4.350 +corollary (in group) iso_sym :
   4.351 +"G \<cong> H \<Longrightarrow> H \<cong> G"
   4.352 +  using iso_set_sym unfolding is_iso_def by auto
   4.353 +
   4.354 +lemma (in group) iso_set_trans: 
   4.355 +     "[|h \<in> iso G H; i \<in> iso H I|] ==> (compose (carrier G) i h) \<in> iso G I"
   4.356  by (auto simp add: iso_def hom_compose bij_betw_compose)
   4.357  
   4.358 -lemma DirProd_commute_iso:
   4.359 -  shows "(\<lambda>(x,y). (y,x)) \<in> (G \<times>\<times> H) \<cong> (H \<times>\<times> G)"
   4.360 +corollary (in group) iso_trans :
   4.361 +"\<lbrakk>G \<cong> H ; H \<cong> I\<rbrakk> \<Longrightarrow> G \<cong> I"
   4.362 +  using iso_set_trans unfolding is_iso_def by blast
   4.363 +
   4.364 +(* Next four lemmas contributed by Paulo Emílio de Vilhena. *)
   4.365 +
   4.366 +lemma (in monoid) hom_imp_img_monoid:
   4.367 +  assumes "h \<in> hom G H"
   4.368 +  shows "monoid (H \<lparr> carrier := h ` (carrier G), one := h \<one>\<^bsub>G\<^esub> \<rparr>)" (is "monoid ?h_img")
   4.369 +proof (rule monoidI)
   4.370 +  show "\<one>\<^bsub>?h_img\<^esub> \<in> carrier ?h_img"
   4.371 +    by auto
   4.372 +next
   4.373 +  fix x y z assume "x \<in> carrier ?h_img" "y \<in> carrier ?h_img" "z \<in> carrier ?h_img"
   4.374 +  then obtain g1 g2 g3
   4.375 +    where g1: "g1 \<in> carrier G" "x = h g1"
   4.376 +      and g2: "g2 \<in> carrier G" "y = h g2"
   4.377 +      and g3: "g3 \<in> carrier G" "z = h g3"
   4.378 +    using image_iff[where ?f = h and ?A = "carrier G"] by auto
   4.379 +  have aux_lemma:
   4.380 +    "\<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)"
   4.381 +    using assms unfolding hom_def by auto
   4.382 +
   4.383 +  show "x \<otimes>\<^bsub>(?h_img)\<^esub> \<one>\<^bsub>(?h_img)\<^esub> = x"
   4.384 +    using aux_lemma[OF g1(1) one_closed] g1(2) r_one[OF g1(1)] by simp
   4.385 +
   4.386 +  show "\<one>\<^bsub>(?h_img)\<^esub> \<otimes>\<^bsub>(?h_img)\<^esub> x = x"
   4.387 +    using aux_lemma[OF one_closed g1(1)] g1(2) l_one[OF g1(1)] by simp
   4.388 +
   4.389 +  have "x \<otimes>\<^bsub>(?h_img)\<^esub> y = h (g1 \<otimes> g2)"
   4.390 +    using aux_lemma g1 g2 by auto
   4.391 +  thus "x \<otimes>\<^bsub>(?h_img)\<^esub> y \<in> carrier ?h_img"
   4.392 +    using g1(1) g2(1) by simp
   4.393 +
   4.394 +  have "(x \<otimes>\<^bsub>(?h_img)\<^esub> y) \<otimes>\<^bsub>(?h_img)\<^esub> z = h ((g1 \<otimes> g2) \<otimes> g3)"
   4.395 +    using aux_lemma g1 g2 g3 by auto
   4.396 +  also have " ... = h (g1 \<otimes> (g2 \<otimes> g3))"
   4.397 +    using m_assoc[OF g1(1) g2(1) g3(1)] by simp
   4.398 +  also have " ... = x \<otimes>\<^bsub>(?h_img)\<^esub> (y \<otimes>\<^bsub>(?h_img)\<^esub> z)"
   4.399 +    using aux_lemma g1 g2 g3 by auto
   4.400 +  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)" .
   4.401 +qed
   4.402 +
   4.403 +lemma (in group) hom_imp_img_group:
   4.404 +  assumes "h \<in> hom G H"
   4.405 +  shows "group (H \<lparr> carrier := h ` (carrier G), one := h \<one>\<^bsub>G\<^esub> \<rparr>)" (is "group ?h_img")
   4.406 +proof -
   4.407 +  interpret monoid ?h_img
   4.408 +    using hom_imp_img_monoid[OF assms] .
   4.409 +
   4.410 +  show ?thesis
   4.411 +  proof (unfold_locales)
   4.412 +    show "carrier ?h_img \<subseteq> Units ?h_img"
   4.413 +    proof (auto simp add: Units_def)
   4.414 +      have aux_lemma:
   4.415 +        "\<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)"
   4.416 +        using assms unfolding hom_def by auto
   4.417 +
   4.418 +      fix g1 assume g1: "g1 \<in> carrier G"
   4.419 +      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>"
   4.420 +        using aux_lemma[OF g1 inv_closed[OF g1]]
   4.421 +              aux_lemma[OF inv_closed[OF g1] g1]
   4.422 +              inv_closed by auto
   4.423 +    qed
   4.424 +  qed
   4.425 +qed
   4.426 +
   4.427 +lemma (in group) iso_imp_group:
   4.428 +  assumes "G \<cong> H" and "monoid H"
   4.429 +  shows "group H"
   4.430 +proof -
   4.431 +  obtain \<phi> where phi: "\<phi> \<in> iso G H" "inv_into (carrier G) \<phi> \<in> iso H G"
   4.432 +    using iso_set_sym assms unfolding is_iso_def by blast
   4.433 +  define \<psi> where psi_def: "\<psi> = inv_into (carrier G) \<phi>"
   4.434 +  
   4.435 +  from phi
   4.436 +  have surj: "\<phi> ` (carrier G) = (carrier H)" "\<psi> ` (carrier H) = (carrier G)"
   4.437 +   and inj: "inj_on \<phi> (carrier G)" "inj_on \<psi> (carrier H)"
   4.438 +   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)"
   4.439 +   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)"
   4.440 +   using psi_def unfolding iso_def bij_betw_def hom_def by auto
   4.441 +
   4.442 +  have phi_one: "\<phi> \<one> = \<one>\<^bsub>H\<^esub>"
   4.443 +  proof -
   4.444 +    have "(\<phi> \<one>) \<otimes>\<^bsub>H\<^esub> \<one>\<^bsub>H\<^esub> = (\<phi> \<one>) \<otimes>\<^bsub>H\<^esub> (\<phi> \<one>)"
   4.445 +      by (metis assms(2) image_eqI monoid.r_one one_closed phi_hom r_one surj(1))
   4.446 +    thus ?thesis
   4.447 +      by (metis (no_types, hide_lams) Units_eq Units_one_closed assms(2) f_inv_into_f imageI
   4.448 +          monoid.l_one monoid.one_closed phi_hom psi_def r_one surj)
   4.449 +  qed
   4.450 +
   4.451 +  have "carrier H \<subseteq> Units H"
   4.452 +  proof
   4.453 +    fix h assume h: "h \<in> carrier H"
   4.454 +    let ?inv_h = "\<phi> (inv (\<psi> h))"
   4.455 +    have "h \<otimes>\<^bsub>H\<^esub> ?inv_h = \<phi> (\<psi> h) \<otimes>\<^bsub>H\<^esub> ?inv_h"
   4.456 +      by (simp add: f_inv_into_f h psi_def surj(1))
   4.457 +    also have " ... = \<phi> ((\<psi> h) \<otimes> inv (\<psi> h))"
   4.458 +      by (metis h imageI inv_closed phi_hom surj(2))
   4.459 +    also have " ... = \<phi> \<one>"
   4.460 +      by (simp add: h inv_into_into psi_def surj(1))
   4.461 +    finally have 1: "h \<otimes>\<^bsub>H\<^esub> ?inv_h = \<one>\<^bsub>H\<^esub>"
   4.462 +      using phi_one by simp
   4.463 +
   4.464 +    have "?inv_h \<otimes>\<^bsub>H\<^esub> h = ?inv_h \<otimes>\<^bsub>H\<^esub> \<phi> (\<psi> h)"
   4.465 +      by (simp add: f_inv_into_f h psi_def surj(1))
   4.466 +    also have " ... = \<phi> (inv (\<psi> h) \<otimes> (\<psi> h))"
   4.467 +      by (metis h imageI inv_closed phi_hom surj(2))
   4.468 +    also have " ... = \<phi> \<one>"
   4.469 +      by (simp add: h inv_into_into psi_def surj(1))
   4.470 +    finally have 2: "?inv_h \<otimes>\<^bsub>H\<^esub> h = \<one>\<^bsub>H\<^esub>"
   4.471 +      using phi_one by simp
   4.472 +
   4.473 +    thus "h \<in> Units H" unfolding Units_def using 1 2 h surj by fastforce
   4.474 +  qed
   4.475 +  thus ?thesis unfolding group_def group_axioms_def using assms(2) by simp
   4.476 +qed
   4.477 +
   4.478 +corollary (in group) iso_imp_img_group:
   4.479 +  assumes "h \<in> iso G H"
   4.480 +  shows "group (H \<lparr> one := h \<one> \<rparr>)"
   4.481 +proof -
   4.482 +  let ?h_img = "H \<lparr> carrier := h ` (carrier G), one := h \<one> \<rparr>"
   4.483 +  have "h \<in> iso G ?h_img"
   4.484 +    using assms unfolding iso_def hom_def bij_betw_def by auto
   4.485 +  hence "G \<cong> ?h_img"
   4.486 +    unfolding is_iso_def by auto
   4.487 +  hence "group ?h_img"
   4.488 +    using iso_imp_group[of ?h_img] hom_imp_img_monoid[of h H] assms unfolding iso_def by simp
   4.489 +  moreover have "carrier H = carrier ?h_img"
   4.490 +    using assms unfolding iso_def bij_betw_def by simp
   4.491 +  hence "H \<lparr> one := h \<one> \<rparr> = ?h_img"
   4.492 +    by simp
   4.493 +  ultimately show ?thesis by simp
   4.494 +qed
   4.495 +
   4.496 +lemma DirProd_commute_iso_set:
   4.497 +  shows "(\<lambda>(x,y). (y,x)) \<in> iso (G \<times>\<times> H) (H \<times>\<times> G)"
   4.498 +  by (auto simp add: iso_def hom_def inj_on_def bij_betw_def)
   4.499 +
   4.500 +corollary DirProd_commute_iso :
   4.501 +"(G \<times>\<times> H) \<cong> (H \<times>\<times> G)"
   4.502 +  using DirProd_commute_iso_set unfolding is_iso_def by blast
   4.503 +
   4.504 +lemma DirProd_assoc_iso_set:
   4.505 +  shows "(\<lambda>(x,y,z). (x,(y,z))) \<in> iso (G \<times>\<times> H \<times>\<times> I) (G \<times>\<times> (H \<times>\<times> I))"
   4.506  by (auto simp add: iso_def hom_def inj_on_def bij_betw_def)
   4.507  
   4.508 -lemma DirProd_assoc_iso:
   4.509 -  shows "(\<lambda>(x,y,z). (x,(y,z))) \<in> (G \<times>\<times> H \<times>\<times> I) \<cong> (G \<times>\<times> (H \<times>\<times> I))"
   4.510 -by (auto simp add: iso_def hom_def inj_on_def bij_betw_def)
   4.511 +lemma (in group) DirProd_iso_set_trans: 
   4.512 +  assumes "g \<in> iso G G2"
   4.513 +    and "h \<in> iso H I"
   4.514 +  shows "(\<lambda>(x,y). (g x, h y)) \<in> iso (G \<times>\<times> H) (G2 \<times>\<times> I)"
   4.515 +proof-
   4.516 +  have "(\<lambda>(x,y). (g x, h y)) \<in> hom (G \<times>\<times> H) (G2 \<times>\<times> I)"
   4.517 +    using assms unfolding iso_def hom_def by auto
   4.518 +  moreover have " inj_on (\<lambda>(x,y). (g x, h y)) (carrier (G \<times>\<times> H))"
   4.519 +    using assms unfolding iso_def DirProd_def bij_betw_def inj_on_def by auto
   4.520 +  moreover have "(\<lambda>(x, y). (g x, h y)) ` carrier (G \<times>\<times> H) = carrier (G2 \<times>\<times> I)"
   4.521 +    using assms unfolding iso_def bij_betw_def image_def DirProd_def by fastforce
   4.522 +  ultimately show "(\<lambda>(x,y). (g x, h y)) \<in> iso (G \<times>\<times> H) (G2 \<times>\<times> I)"
   4.523 +    unfolding iso_def bij_betw_def by auto
   4.524 +qed
   4.525 +
   4.526 +corollary (in group) DirProd_iso_trans :
   4.527 +  assumes "G \<cong> G2"
   4.528 +    and "H \<cong> I"
   4.529 +  shows "G \<times>\<times> H \<cong> G2 \<times>\<times> I"
   4.530 +  using DirProd_iso_set_trans assms unfolding is_iso_def by blast
   4.531  
   4.532  
   4.533  text\<open>Basis for homomorphism proofs: we assume two groups @{term G} and
   4.534 @@ -655,6 +1058,56 @@
   4.535    "x \<in> carrier G \<Longrightarrow> (([^]) x) \<in> hom \<lparr> carrier = UNIV, mult = (+), one = 0::int \<rparr> G "
   4.536    unfolding hom_def by (simp add: int_pow_mult)
   4.537  
   4.538 +(* Next six lemmas contributed by Paulo Emílio de Vilhena. *)
   4.539 +
   4.540 +lemma (in group_hom) img_is_subgroup: "subgroup (h ` (carrier G)) H"
   4.541 +  apply (rule subgroupI)
   4.542 +  apply (auto simp add: image_subsetI)
   4.543 +  apply (metis (no_types, hide_lams) G.inv_closed hom_inv image_iff)
   4.544 +  apply (smt G.monoid_axioms hom_mult image_iff monoid.m_closed)
   4.545 +  done
   4.546 +
   4.547 +lemma (in group_hom) subgroup_img_is_subgroup:
   4.548 +  assumes "subgroup I G"
   4.549 +  shows "subgroup (h ` I) H"
   4.550 +proof -
   4.551 +  have "h \<in> hom (G \<lparr> carrier := I \<rparr>) H"
   4.552 +    using G.subgroupE[OF assms] subgroup.mem_carrier[OF assms] homh
   4.553 +    unfolding hom_def by auto
   4.554 +  hence "group_hom (G \<lparr> carrier := I \<rparr>) H h"
   4.555 +    using subgroup.subgroup_is_group[OF assms G.is_group] is_group
   4.556 +    unfolding group_hom_def group_hom_axioms_def by simp
   4.557 +  thus ?thesis
   4.558 +    using group_hom.img_is_subgroup[of "G \<lparr> carrier := I \<rparr>" H h] by simp
   4.559 +qed
   4.560 +
   4.561 +lemma (in group_hom) induced_group_hom:
   4.562 +  assumes "subgroup I G"
   4.563 +  shows "group_hom (G \<lparr> carrier := I \<rparr>) (H \<lparr> carrier := h ` I \<rparr>) h"
   4.564 +proof -
   4.565 +  have "h \<in> hom (G \<lparr> carrier := I \<rparr>) (H \<lparr> carrier := h ` I \<rparr>)"
   4.566 +    using homh subgroup.mem_carrier[OF assms] unfolding hom_def by auto
   4.567 +  thus ?thesis
   4.568 +    unfolding group_hom_def group_hom_axioms_def
   4.569 +    using subgroup.subgroup_is_group[OF assms G.is_group]
   4.570 +          subgroup.subgroup_is_group[OF subgroup_img_is_subgroup[OF assms] is_group] by simp
   4.571 +qed
   4.572 +
   4.573 +lemma (in group) canonical_inj_is_hom:
   4.574 +  assumes "subgroup H G"
   4.575 +  shows "group_hom (G \<lparr> carrier := H \<rparr>) G id"
   4.576 +  unfolding group_hom_def group_hom_axioms_def hom_def
   4.577 +  using subgroup.subgroup_is_group[OF assms is_group]
   4.578 +        is_group subgroup_imp_subset[OF assms] by auto
   4.579 +
   4.580 +lemma (in group_hom) nat_pow_hom:
   4.581 +  "x \<in> carrier G \<Longrightarrow> h (x [^] (n :: nat)) = (h x) [^]\<^bsub>H\<^esub> n"
   4.582 +  by (induction n) auto
   4.583 +
   4.584 +lemma (in group_hom) int_pow_hom:
   4.585 +  "x \<in> carrier G \<Longrightarrow> h (x [^] (n :: int)) = (h x) [^]\<^bsub>H\<^esub> n"
   4.586 +  using int_pow_def2 nat_pow_hom by (simp add: G.int_pow_def2)
   4.587 +
   4.588  
   4.589  subsection \<open>Commutative Structures\<close>
   4.590  
   4.591 @@ -716,6 +1169,18 @@
   4.592    (x \<otimes> y) [^] (n::nat) = x [^] n \<otimes> y [^] n"
   4.593    by (induct n) (simp, simp add: m_ac)
   4.594  
   4.595 +lemma (in comm_monoid) submonoid_is_comm_monoid :
   4.596 +  assumes "submonoid H G"
   4.597 +  shows "comm_monoid (G\<lparr>carrier := H\<rparr>)"
   4.598 +proof (intro monoid.monoid_comm_monoidI)
   4.599 +  show "monoid (G\<lparr>carrier := H\<rparr>)"
   4.600 +    using submonoid.submonoid_is_monoid assms comm_monoid_axioms comm_monoid_def by blast
   4.601 +  show "\<And>x y. x \<in> carrier (G\<lparr>carrier := H\<rparr>) \<Longrightarrow> y \<in> carrier (G\<lparr>carrier := H\<rparr>)
   4.602 +        \<Longrightarrow> x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y = y \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x" apply simp
   4.603 +    using  assms comm_monoid_axioms_def submonoid.mem_carrier
   4.604 +    by (metis m_comm)
   4.605 +qed
   4.606 +
   4.607  locale comm_group = comm_monoid + group
   4.608  
   4.609  lemma (in group) group_comm_groupI:
   4.610 @@ -739,10 +1204,83 @@
   4.611    shows "comm_group G"
   4.612    by (fast intro: group.group_comm_groupI groupI assms)
   4.613  
   4.614 +lemma comm_groupE:
   4.615 +  fixes G (structure)
   4.616 +  assumes "comm_group G"
   4.617 +  shows "\<And>x y. \<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<otimes> y \<in> carrier G"
   4.618 +    and "\<one> \<in> carrier G"
   4.619 +    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)"
   4.620 +    and "\<And>x y. \<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<otimes> y = y \<otimes> x"
   4.621 +    and "\<And>x. x \<in> carrier G \<Longrightarrow> \<one> \<otimes> x = x"
   4.622 +    and "\<And>x. x \<in> carrier G \<Longrightarrow> \<exists>y \<in> carrier G. y \<otimes> x = \<one>"
   4.623 +  apply (simp_all add: group.axioms assms comm_group.axioms comm_monoid.m_comm comm_monoid.m_ac(1))
   4.624 +  by (simp_all add: Group.group.axioms(1) assms comm_group.axioms(2) monoid.m_closed group.r_inv_ex)
   4.625 +
   4.626  lemma (in comm_group) inv_mult:
   4.627    "[| x \<in> carrier G; y \<in> carrier G |] ==> inv (x \<otimes> y) = inv x \<otimes> inv y"
   4.628    by (simp add: m_ac inv_mult_group)
   4.629  
   4.630 +(* Next three lemmas contributed by Paulo Emílio de Vilhena. *)
   4.631 +
   4.632 +lemma (in comm_monoid) hom_imp_img_comm_monoid:
   4.633 +  assumes "h \<in> hom G H"
   4.634 +  shows "comm_monoid (H \<lparr> carrier := h ` (carrier G), one := h \<one>\<^bsub>G\<^esub> \<rparr>)" (is "comm_monoid ?h_img")
   4.635 +proof (rule monoid.monoid_comm_monoidI)
   4.636 +  show "monoid ?h_img"
   4.637 +    using hom_imp_img_monoid[OF assms] .
   4.638 +next
   4.639 +  fix x y assume "x \<in> carrier ?h_img" "y \<in> carrier ?h_img"
   4.640 +  then obtain g1 g2
   4.641 +    where g1: "g1 \<in> carrier G" "x = h g1"
   4.642 +      and g2: "g2 \<in> carrier G" "y = h g2"
   4.643 +    by auto
   4.644 +  have "x \<otimes>\<^bsub>(?h_img)\<^esub> y = h (g1 \<otimes> g2)"
   4.645 +    using g1 g2 assms unfolding hom_def by auto
   4.646 +  also have " ... = h (g2 \<otimes> g1)"
   4.647 +    using m_comm[OF g1(1) g2(1)] by simp
   4.648 +  also have " ... = y \<otimes>\<^bsub>(?h_img)\<^esub> x"
   4.649 +    using g1 g2 assms unfolding hom_def by auto
   4.650 +  finally show "x \<otimes>\<^bsub>(?h_img)\<^esub> y = y \<otimes>\<^bsub>(?h_img)\<^esub> x" .
   4.651 +qed
   4.652 +
   4.653 +lemma (in comm_group) iso_imp_img_comm_group:
   4.654 +  assumes "h \<in> iso G H"
   4.655 +  shows "comm_group (H \<lparr> one := h \<one>\<^bsub>G\<^esub> \<rparr>)"
   4.656 +proof -
   4.657 +  let ?h_img = "H \<lparr> carrier := h ` (carrier G), one := h \<one> \<rparr>"
   4.658 +  have "comm_monoid ?h_img"
   4.659 +    using hom_imp_img_comm_monoid[of h H] assms unfolding iso_def by simp
   4.660 +  moreover have "carrier H = carrier ?h_img"
   4.661 +    using assms unfolding iso_def bij_betw_def by simp
   4.662 +  hence "H \<lparr> one := h \<one> \<rparr> = ?h_img"
   4.663 +    by simp
   4.664 +  ultimately have "comm_monoid (H \<lparr> one := h \<one>\<^bsub>G\<^esub> \<rparr>)"
   4.665 +    by simp
   4.666 +  thus ?thesis
   4.667 +    unfolding comm_group_def using iso_imp_img_group[OF assms] by simp
   4.668 +qed
   4.669 +
   4.670 +lemma (in comm_group) iso_imp_comm_group:
   4.671 +  assumes "G \<cong> H" "monoid H"
   4.672 +  shows "comm_group H"
   4.673 +proof -
   4.674 +  obtain h where h: "h \<in> iso G H"
   4.675 +    using assms(1) unfolding is_iso_def by auto
   4.676 +  hence comm_gr: "comm_group (H \<lparr> one := h \<one> \<rparr>)"
   4.677 +    using iso_imp_img_comm_group[of h H] by simp
   4.678 +  hence "\<And>x. x \<in> carrier H \<Longrightarrow> h \<one> \<otimes>\<^bsub>H\<^esub> x = x"
   4.679 +    using monoid.l_one[of "H \<lparr> one := h \<one> \<rparr>"] unfolding comm_group_def comm_monoid_def by simp
   4.680 +  moreover have "h \<one> \<in> carrier H"
   4.681 +    using h one_closed unfolding iso_def hom_def by auto
   4.682 +  ultimately have "h \<one> = \<one>\<^bsub>H\<^esub>"
   4.683 +    using monoid.one_unique[OF assms(2), of "h \<one>"] by simp
   4.684 +  hence "H = H \<lparr> one := h \<one> \<rparr>"
   4.685 +    by simp
   4.686 +  thus ?thesis
   4.687 +    using comm_gr by simp
   4.688 +qed
   4.689 +
   4.690 +
   4.691  
   4.692  subsection \<open>The Lattice of Subgroups of a Group\<close>
   4.693  
   4.694 @@ -773,6 +1311,10 @@
   4.695  apply (rule_tac group.inv_closed [OF subgroup_imp_group, simplified], assumption+)
   4.696  done
   4.697  
   4.698 +lemma (in group) subgroup_mult_equality:
   4.699 +  "\<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"
   4.700 +  unfolding subgroup_def by simp
   4.701 +
   4.702  theorem (in group) subgroups_Inter:
   4.703    assumes subgr: "(\<And>H. H \<in> A \<Longrightarrow> subgroup H G)"
   4.704      and not_empty: "A \<noteq> {}"
   4.705 @@ -793,6 +1335,11 @@
   4.706    show "x \<otimes> y \<in> \<Inter>A" by blast
   4.707  qed
   4.708  
   4.709 +lemma (in group) subgroups_Inter_pair :
   4.710 +  assumes  "subgroup I G" 
   4.711 +    and  "subgroup J G"
   4.712 +  shows "subgroup (I\<inter>J) G" using subgroups_Inter[ where ?A = "{I,J}"] assms by auto
   4.713 +
   4.714  theorem (in group) subgroups_complete_lattice:
   4.715    "complete_lattice \<lparr>carrier = {H. subgroup H G}, eq = (=), le = (\<subseteq>)\<rparr>"
   4.716      (is "complete_lattice ?L")
     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/HOL/Algebra/Group_Action.thy	Tue Jun 12 16:09:12 2018 +0100
     5.3 @@ -0,0 +1,927 @@
     5.4 +(* ************************************************************************** *)
     5.5 +(* Title:      Group_Action.thy                                               *)
     5.6 +(* Author:     Paulo Emílio de Vilhena                                        *)
     5.7 +(* ************************************************************************** *)
     5.8 +
     5.9 +theory Group_Action
    5.10 +imports Bij Coset Congruence
    5.11 +
    5.12 +begin
    5.13 +
    5.14 +section \<open>Group Actions\<close>
    5.15 +
    5.16 +locale group_action =
    5.17 +  fixes G (structure) and E and \<phi>
    5.18 +  assumes group_hom: "group_hom G (BijGroup E) \<phi>"
    5.19 +
    5.20 +definition
    5.21 +  orbit :: "[_, 'a \<Rightarrow> 'b \<Rightarrow> 'b, 'b] \<Rightarrow> 'b set"
    5.22 +  where "orbit G \<phi> x = {(\<phi> g) x | g. g \<in> carrier G}"
    5.23 +
    5.24 +definition
    5.25 +  orbits :: "[_, 'b set, 'a \<Rightarrow> 'b \<Rightarrow> 'b] \<Rightarrow> ('b set) set"
    5.26 +  where "orbits G E \<phi> = {orbit G \<phi> x | x. x \<in> E}"
    5.27 +
    5.28 +definition
    5.29 +  stabilizer :: "[_, 'a \<Rightarrow> 'b \<Rightarrow> 'b, 'b] \<Rightarrow> 'a set"
    5.30 +  where "stabilizer G \<phi> x = {g \<in> carrier G. (\<phi> g) x = x}"
    5.31 +
    5.32 +definition
    5.33 +  invariants :: "['b set, 'a \<Rightarrow> 'b \<Rightarrow> 'b, 'a] \<Rightarrow> 'b set"
    5.34 +  where "invariants E \<phi> g = {x \<in> E. (\<phi> g) x = x}"
    5.35 +
    5.36 +definition
    5.37 +  normalizer :: "[_, 'a set] \<Rightarrow> 'a set"
    5.38 +  where "normalizer G H =
    5.39 +         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"
    5.40 +
    5.41 +locale faithful_action = group_action +
    5.42 +  assumes faithful: "inj_on \<phi> (carrier G)"
    5.43 +
    5.44 +locale transitive_action = group_action +
    5.45 +  assumes unique_orbit: "\<lbrakk> x \<in> E; y \<in> E \<rbrakk> \<Longrightarrow> \<exists>g \<in> carrier G. (\<phi> g) x = y"
    5.46 +
    5.47 +
    5.48 +
    5.49 +subsection \<open>Prelimineries\<close>
    5.50 +
    5.51 +text \<open>Some simple lemmas to make group action's properties more explicit\<close>
    5.52 +
    5.53 +lemma (in group_action) id_eq_one: "(\<lambda>x \<in> E. x) = \<phi> \<one>"
    5.54 +  by (metis BijGroup_def group_hom group_hom.hom_one select_convs(2))
    5.55 +
    5.56 +lemma (in group_action) bij_prop0:
    5.57 +  "\<And> g. g \<in> carrier G \<Longrightarrow> (\<phi> g) \<in> Bij E"
    5.58 +  by (metis BijGroup_def group_hom group_hom.hom_closed partial_object.select_convs(1))
    5.59 +
    5.60 +lemma (in group_action) surj_prop:
    5.61 +  "\<And> g. g \<in> carrier G \<Longrightarrow> (\<phi> g) ` E = E"
    5.62 +  using bij_prop0 by (simp add: Bij_def bij_betw_def)
    5.63 +
    5.64 +lemma (in group_action) inj_prop:
    5.65 +  "\<And> g. g \<in> carrier G \<Longrightarrow> inj_on (\<phi> g) E"
    5.66 +  using bij_prop0 by (simp add: Bij_def bij_betw_def)
    5.67 +
    5.68 +lemma (in group_action) bij_prop1:
    5.69 +  "\<And> g y. \<lbrakk> g \<in> carrier G; y \<in> E \<rbrakk> \<Longrightarrow>  \<exists>!x \<in> E. (\<phi> g) x = y"
    5.70 +proof -
    5.71 +  fix g y assume "g \<in> carrier G" "y \<in> E"
    5.72 +  hence "\<exists>x \<in> E. (\<phi> g) x = y"
    5.73 +    using surj_prop by force
    5.74 +  moreover have "\<And> x1 x2. \<lbrakk> x1 \<in> E; x2 \<in> E \<rbrakk> \<Longrightarrow> (\<phi> g) x1 = (\<phi> g) x2 \<Longrightarrow> x1 = x2"
    5.75 +    using inj_prop by (meson \<open>g \<in> carrier G\<close> inj_on_eq_iff)
    5.76 +  ultimately show "\<exists>!x \<in> E. (\<phi> g) x = y"
    5.77 +    by blast
    5.78 +qed
    5.79 +
    5.80 +lemma (in group_action) composition_rule:
    5.81 +  assumes "x \<in> E" "g1 \<in> carrier G" "g2 \<in> carrier G"
    5.82 +  shows "\<phi> (g1 \<otimes> g2) x = (\<phi> g1) (\<phi> g2 x)"
    5.83 +proof -
    5.84 +  have "\<phi> (g1 \<otimes> g2) x = ((\<phi> g1) \<otimes>\<^bsub>BijGroup E\<^esub> (\<phi> g2)) x"
    5.85 +    using assms(2) assms(3) group_hom group_hom.hom_mult by fastforce
    5.86 +  also have " ... = (compose E (\<phi> g1) (\<phi> g2)) x"
    5.87 +    unfolding BijGroup_def by (simp add: assms bij_prop0)
    5.88 +  finally show "\<phi> (g1 \<otimes> g2) x = (\<phi> g1) (\<phi> g2 x)"
    5.89 +    by (simp add: assms(1) compose_eq)
    5.90 +qed
    5.91 +
    5.92 +lemma (in group_action) element_image:
    5.93 +  assumes "g \<in> carrier G" and "x \<in> E" and "(\<phi> g) x = y"
    5.94 +  shows "y \<in> E"
    5.95 +  using surj_prop assms by blast
    5.96 +
    5.97 +
    5.98 +
    5.99 +subsection \<open>Orbits\<close>
   5.100 +
   5.101 +text\<open>We prove here that orbits form an equivalence relation\<close>
   5.102 +
   5.103 +lemma (in group_action) orbit_sym_aux:
   5.104 +  assumes "g \<in> carrier G"
   5.105 +    and "x \<in> E"
   5.106 +    and "(\<phi> g) x = y"
   5.107 +  shows "(\<phi> (inv g)) y = x"
   5.108 +proof -
   5.109 +  interpret group G
   5.110 +    using group_hom group_hom.axioms(1) by auto
   5.111 +  have "y \<in> E"
   5.112 +    using element_image assms by simp
   5.113 +  have "inv g \<in> carrier G"
   5.114 +    by (simp add: assms(1))
   5.115 +
   5.116 +  have "(\<phi> (inv g)) y = (\<phi> (inv g)) ((\<phi> g) x)"
   5.117 +    using assms(3) by simp
   5.118 +  also have " ... = compose E (\<phi> (inv g)) (\<phi> g) x"
   5.119 +    by (simp add: assms(2) compose_eq)
   5.120 +  also have " ... = ((\<phi> (inv g)) \<otimes>\<^bsub>BijGroup E\<^esub> (\<phi> g)) x"
   5.121 +    by (simp add: BijGroup_def assms(1) bij_prop0)
   5.122 +  also have " ... = (\<phi> ((inv g) \<otimes> g)) x"
   5.123 +    by (metis \<open>inv g \<in> carrier G\<close> assms(1) group_hom group_hom.hom_mult)
   5.124 +  finally show "(\<phi> (inv g)) y = x"
   5.125 +    by (metis assms(1) assms(2) id_eq_one l_inv restrict_apply)
   5.126 +qed
   5.127 +
   5.128 +lemma (in group_action) orbit_refl:
   5.129 +  "x \<in> E \<Longrightarrow> x \<in> orbit G \<phi> x"
   5.130 +proof -
   5.131 +  assume "x \<in> E" hence "(\<phi> \<one>) x = x"
   5.132 +    using id_eq_one by (metis restrict_apply')
   5.133 +  thus "x \<in> orbit G \<phi> x" unfolding orbit_def
   5.134 +    using group.is_monoid group_hom group_hom.axioms(1) by force 
   5.135 +qed
   5.136 +
   5.137 +lemma (in group_action) orbit_sym:
   5.138 +  assumes "x \<in> E" and "y \<in> E" and "y \<in> orbit G \<phi> x"
   5.139 +  shows "x \<in> orbit G \<phi> y"
   5.140 +proof -
   5.141 +  have "\<exists> g \<in> carrier G. (\<phi> g) x = y"
   5.142 +    by (smt assms(3) mem_Collect_eq orbit_def)
   5.143 +  then obtain g where g: "g \<in> carrier G \<and> (\<phi> g) x = y" by blast
   5.144 +  hence "(\<phi> (inv g)) y = x"
   5.145 +    using orbit_sym_aux by (simp add: assms(1))
   5.146 +  thus ?thesis
   5.147 +    using g group_hom group_hom.axioms(1) orbit_def by fastforce 
   5.148 +qed
   5.149 +
   5.150 +lemma (in group_action) orbit_trans:
   5.151 +  assumes "x \<in> E" "y \<in> E" "z \<in> E"
   5.152 +    and "y \<in> orbit G \<phi> x" "z \<in> orbit G \<phi> y" 
   5.153 +  shows "z \<in> orbit G \<phi> x"
   5.154 +proof -
   5.155 +  interpret group G
   5.156 +    using group_hom group_hom.axioms(1) by auto
   5.157 +
   5.158 +  have "\<exists> g1 \<in> carrier G. (\<phi> g1) x = y"
   5.159 +    by (smt assms mem_Collect_eq orbit_def)
   5.160 +  then obtain g1 where g1: "g1 \<in> carrier G \<and> (\<phi> g1) x = y" by blast
   5.161 +
   5.162 +  have "\<exists> g2 \<in> carrier G. (\<phi> g2) y = z"
   5.163 +    by (smt assms mem_Collect_eq orbit_def)
   5.164 +  then obtain g2 where g2: "g2 \<in> carrier G \<and> (\<phi> g2) y = z" by blast
   5.165 +  
   5.166 +  have "(\<phi> (g2 \<otimes> g1)) x = ((\<phi> g2) \<otimes>\<^bsub>BijGroup E\<^esub> (\<phi> g1)) x"
   5.167 +    using g1 g2 group_hom group_hom.hom_mult by fastforce
   5.168 +  also have " ... = (\<phi> g2) ((\<phi> g1) x)"
   5.169 +    using composition_rule assms(1) calculation g1 g2 by auto
   5.170 +  finally have "(\<phi> (g2 \<otimes> g1)) x = z"
   5.171 +    by (simp add: g1 g2)
   5.172 +  thus ?thesis
   5.173 +    using g1 g2 orbit_def by force 
   5.174 +qed
   5.175 +
   5.176 +lemma (in group_action) orbits_as_classes:
   5.177 +  "classes\<^bsub>\<lparr> carrier = E, eq = \<lambda>x. \<lambda>y. y \<in> orbit G \<phi> x \<rparr>\<^esub> = orbits G E \<phi>"
   5.178 +  unfolding eq_classes_def eq_class_of_def orbits_def apply simp
   5.179 +proof -
   5.180 +  have "\<And>x. x \<in> E \<Longrightarrow> {y \<in> E. y \<in> orbit G \<phi> x} = orbit G \<phi> x"
   5.181 +    by (smt Collect_cong element_image mem_Collect_eq orbit_def)
   5.182 +  thus "{{y \<in> E. y \<in> orbit G \<phi> x} |x. x \<in> E} = {orbit G \<phi> x |x. x \<in> E}" by blast
   5.183 +qed
   5.184 +
   5.185 +theorem (in group_action) orbit_partition:
   5.186 +  "partition E (orbits G E \<phi>)"
   5.187 +proof -
   5.188 +  have "equivalence \<lparr> carrier = E, eq = \<lambda>x. \<lambda>y. y \<in> orbit G \<phi> x \<rparr>"
   5.189 +  unfolding equivalence_def apply simp
   5.190 +  using orbit_refl orbit_sym orbit_trans by blast
   5.191 +  thus ?thesis using equivalence.partition_from_equivalence orbits_as_classes by fastforce
   5.192 +qed
   5.193 +
   5.194 +corollary (in group_action) orbits_coverture:
   5.195 +  "\<Union> (orbits G E \<phi>) = E"
   5.196 +  using partition.partition_coverture[OF orbit_partition] by simp
   5.197 +
   5.198 +corollary (in group_action) disjoint_union:
   5.199 +  assumes "orb1 \<in> (orbits G E \<phi>)" "orb2 \<in> (orbits G E \<phi>)"
   5.200 +  shows "(orb1 = orb2) \<or> (orb1 \<inter> orb2) = {}"
   5.201 +  using partition.disjoint_union[OF orbit_partition] assms by auto
   5.202 +
   5.203 +corollary (in group_action) disjoint_sum:
   5.204 +  assumes "finite E"
   5.205 +  shows "(\<Sum>orb\<in>(orbits G E \<phi>). \<Sum>x\<in>orb. f x) = (\<Sum>x\<in>E. f x)"
   5.206 +  using partition.disjoint_sum[OF orbit_partition] assms by auto
   5.207 +
   5.208 +
   5.209 +subsubsection \<open>Transitive Actions\<close>
   5.210 +
   5.211 +text \<open>Transitive actions have only one orbit\<close>
   5.212 +
   5.213 +lemma (in transitive_action) all_equivalent:
   5.214 +  "\<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"
   5.215 +proof -
   5.216 +  assume "x \<in> E" "y \<in> E"
   5.217 +  hence "\<exists> g \<in> carrier G. (\<phi> g) x = y"
   5.218 +    using unique_orbit  by blast
   5.219 +  hence "y \<in> orbit G \<phi> x"
   5.220 +    using orbit_def by fastforce
   5.221 +  thus "x .=\<^bsub>\<lparr>carrier = E, eq = \<lambda>x y. y \<in> orbit G \<phi> x\<rparr>\<^esub> y" by simp
   5.222 +qed
   5.223 +
   5.224 +proposition (in transitive_action) one_orbit:
   5.225 +  assumes "E \<noteq> {}"
   5.226 +  shows "card (orbits G E \<phi>) = 1"
   5.227 +proof -
   5.228 +  have "orbits G E \<phi> \<noteq> {}"
   5.229 +    using assms orbits_coverture by auto
   5.230 +  moreover have "\<And> orb1 orb2. \<lbrakk> orb1 \<in> (orbits G E \<phi>); orb2 \<in> (orbits G E \<phi>) \<rbrakk> \<Longrightarrow> orb1 = orb2"
   5.231 +  proof -
   5.232 +    fix orb1 orb2 assume orb1: "orb1 \<in> (orbits G E \<phi>)"
   5.233 +                     and orb2: "orb2 \<in> (orbits G E \<phi>)"
   5.234 +    then obtain x y where x: "orb1 = orbit G \<phi> x" and x_E: "x \<in> E" 
   5.235 +                      and y: "orb2 = orbit G \<phi> y" and y_E: "y \<in> E"
   5.236 +      unfolding orbits_def by blast
   5.237 +    hence "x \<in> orbit G \<phi> y" using all_equivalent by auto
   5.238 +    hence "orb1 \<inter> orb2 \<noteq> {}" using x y x_E orbit_refl by auto
   5.239 +    thus "orb1 = orb2" using disjoint_union[of orb1 orb2] orb1 orb2 by auto
   5.240 +  qed
   5.241 +  ultimately show "card (orbits G E \<phi>) = 1"
   5.242 +    by (meson is_singletonI' is_singleton_altdef)
   5.243 +qed
   5.244 +
   5.245 +
   5.246 +
   5.247 +subsection \<open>Stabilizers\<close>
   5.248 +
   5.249 +text \<open>We show that stabilizers are subgroups from the acting group\<close>
   5.250 +
   5.251 +lemma (in group_action) stabilizer_subset:
   5.252 +  "stabilizer G \<phi> x \<subseteq> carrier G"
   5.253 +  by (metis (no_types, lifting) mem_Collect_eq stabilizer_def subsetI)
   5.254 +
   5.255 +lemma (in group_action) stabilizer_m_closed:
   5.256 +  assumes "x \<in> E" "g1 \<in> (stabilizer G \<phi> x)" "g2 \<in> (stabilizer G \<phi> x)"
   5.257 +  shows "(g1 \<otimes> g2) \<in> (stabilizer G \<phi> x)"
   5.258 +proof -
   5.259 +  interpret group G
   5.260 +    using group_hom group_hom.axioms(1) by auto
   5.261 +  
   5.262 +  have "\<phi> g1 x = x"
   5.263 +    using assms stabilizer_def by fastforce
   5.264 +  moreover have "\<phi> g2 x = x"
   5.265 +    using assms stabilizer_def by fastforce
   5.266 +  moreover have g1: "g1 \<in> carrier G"
   5.267 +    by (meson assms contra_subsetD stabilizer_subset)
   5.268 +  moreover have g2: "g2 \<in> carrier G"
   5.269 +    by (meson assms contra_subsetD stabilizer_subset)
   5.270 +  ultimately have "\<phi> (g1 \<otimes> g2) x = x"
   5.271 +    using composition_rule assms by simp
   5.272 +
   5.273 +  thus ?thesis
   5.274 +    by (simp add: g1 g2 stabilizer_def) 
   5.275 +qed
   5.276 +
   5.277 +lemma (in group_action) stabilizer_one_closed:
   5.278 +  assumes "x \<in> E"
   5.279 +  shows "\<one> \<in> (stabilizer G \<phi> x)"
   5.280 +proof -
   5.281 +  have "\<phi> \<one> x = x"
   5.282 +    by (metis assms id_eq_one restrict_apply')
   5.283 +  thus ?thesis
   5.284 +    using group_def group_hom group_hom.axioms(1) stabilizer_def by fastforce
   5.285 +qed
   5.286 +
   5.287 +lemma (in group_action) stabilizer_m_inv_closed:
   5.288 +  assumes "x \<in> E" "g \<in> (stabilizer G \<phi> x)"
   5.289 +  shows "(inv g) \<in> (stabilizer G \<phi> x)"
   5.290 +proof -
   5.291 +  interpret group G
   5.292 +    using group_hom group_hom.axioms(1) by auto
   5.293 +
   5.294 +  have "\<phi> g x = x"
   5.295 +    using assms(2) stabilizer_def by fastforce
   5.296 +  moreover have g: "g \<in> carrier G"
   5.297 +    using assms(2) stabilizer_subset by blast
   5.298 +  moreover have inv_g: "inv g \<in> carrier G"
   5.299 +    by (simp add: g)
   5.300 +  ultimately have "\<phi> (inv g) x = x"
   5.301 +    using assms(1) orbit_sym_aux by blast
   5.302 +
   5.303 +  thus ?thesis by (simp add: inv_g stabilizer_def) 
   5.304 +qed
   5.305 +
   5.306 +theorem (in group_action) stabilizer_subgroup:
   5.307 +  assumes "x \<in> E"
   5.308 +  shows "subgroup (stabilizer G \<phi> x) G"
   5.309 +  unfolding subgroup_def
   5.310 +  using stabilizer_subset stabilizer_m_closed stabilizer_one_closed
   5.311 +        stabilizer_m_inv_closed assms by simp
   5.312 +
   5.313 +
   5.314 +
   5.315 +subsection \<open>The Orbit-Stabilizer Theorem\<close>
   5.316 +
   5.317 +text \<open>In this subsection, we prove the Orbit-Stabilizer theorem.
   5.318 +      Our approach is to show the existence of a bijection between
   5.319 +      "rcosets (stabilizer G \<phi> x)" and "orbit G \<phi> x". Then we use
   5.320 +      Lagrange's theorem to find the cardinal of the first set.\<close>
   5.321 +
   5.322 +subsubsection \<open>Rcosets - Supporting Lemmas\<close>
   5.323 +
   5.324 +corollary (in group_action) stab_rcosets_not_empty:
   5.325 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   5.326 +  shows "R \<noteq> {}"
   5.327 +  using subgroup.rcosets_not_empty[OF stabilizer_subgroup[OF assms(1)] assms(2)] by simp
   5.328 +
   5.329 +corollary (in group_action) diff_stabilizes:
   5.330 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   5.331 +  shows "\<And>g1 g2. \<lbrakk> g1 \<in> R; g2 \<in> R \<rbrakk> \<Longrightarrow> g1 \<otimes> (inv g2) \<in> stabilizer G \<phi> x"
   5.332 +  using group.diff_neutralizes[of G "stabilizer G \<phi> x" R] stabilizer_subgroup[OF assms(1)]
   5.333 +        assms(2) group_hom group_hom.axioms(1) by blast
   5.334 +
   5.335 +
   5.336 +subsubsection \<open>Bijection Between Rcosets and an Orbit - Definition and Supporting Lemmas\<close>
   5.337 +
   5.338 +(* This definition could be easier if lcosets were available, and it's indeed a considerable
   5.339 +   modification at Coset theory, since we could derive it easily from the definition of rcosets
   5.340 +   following the same idea we use here: f: rcosets \<rightarrow> lcosets, s.t. f R = (\<lambda>g. inv g) ` R
   5.341 +   is a bijection. *)
   5.342 +
   5.343 +definition
   5.344 +  orb_stab_fun :: "[_, ('a \<Rightarrow> 'b \<Rightarrow> 'b), 'a set, 'b] \<Rightarrow> 'b"
   5.345 +  where "orb_stab_fun G \<phi> R x = (\<phi> (inv\<^bsub>G\<^esub> (SOME h. h \<in> R))) x"
   5.346 +
   5.347 +lemma (in group_action) orbit_stab_fun_is_well_defined0:
   5.348 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   5.349 +  shows "\<And>g1 g2. \<lbrakk> g1 \<in> R; g2 \<in> R \<rbrakk> \<Longrightarrow> (\<phi> (inv g1)) x = (\<phi> (inv g2)) x"
   5.350 +proof -
   5.351 +  fix g1 g2 assume g1: "g1 \<in> R" and g2: "g2 \<in> R"
   5.352 +  have R_carr: "R \<subseteq> carrier G"
   5.353 +    using subgroup.rcosets_carrier[OF stabilizer_subgroup[OF assms(1)]]
   5.354 +          assms(2) group_hom group_hom.axioms(1) by auto
   5.355 +  from R_carr have g1_carr: "g1 \<in> carrier G" using g1 by blast
   5.356 +  from R_carr have g2_carr: "g2 \<in> carrier G" using g2 by blast
   5.357 +
   5.358 +  have "g1 \<otimes> (inv g2) \<in> stabilizer G \<phi> x"
   5.359 +    using diff_stabilizes[of x R g1 g2] assms g1 g2 by blast
   5.360 +  hence "\<phi> (g1 \<otimes> (inv g2)) x = x"
   5.361 +    by (simp add: stabilizer_def)
   5.362 +  hence "(\<phi> (inv g1)) x = (\<phi> (inv g1)) (\<phi> (g1 \<otimes> (inv g2)) x)" by simp
   5.363 +  also have " ... = \<phi> ((inv g1) \<otimes> (g1 \<otimes> (inv g2))) x"
   5.364 +    using group_def assms(1) composition_rule g1_carr g2_carr
   5.365 +          group_hom group_hom.axioms(1) monoid.m_closed by fastforce
   5.366 +  also have " ... = \<phi> (((inv g1) \<otimes> g1) \<otimes> (inv g2)) x"
   5.367 +    using group_def g1_carr g2_carr group_hom group_hom.axioms(1) monoid.m_assoc by fastforce
   5.368 +  finally show "(\<phi> (inv g1)) x = (\<phi> (inv g2)) x"
   5.369 +    using group_def g1_carr g2_carr group.l_inv group_hom group_hom.axioms(1) by fastforce
   5.370 +qed
   5.371 +
   5.372 +lemma (in group_action) orbit_stab_fun_is_well_defined1:
   5.373 +  assumes "x \<in> E" "R \<in> rcosets (stabilizer G \<phi> x)"
   5.374 +  shows "\<And>g. g \<in> R \<Longrightarrow> (\<phi> (inv (SOME h. h \<in> R))) x = (\<phi> (inv g)) x"
   5.375 +  by (meson assms orbit_stab_fun_is_well_defined0 someI_ex)
   5.376 +
   5.377 +lemma (in group_action) orbit_stab_fun_is_inj:
   5.378 +  assumes "x \<in> E"
   5.379 +    and "R1 \<in> rcosets (stabilizer G \<phi> x)"
   5.380 +    and "R2 \<in> rcosets (stabilizer G \<phi> x)"
   5.381 +    and "\<phi> (inv (SOME h. h \<in> R1)) x = \<phi> (inv (SOME h. h \<in> R2)) x"
   5.382 +  shows "R1 = R2"
   5.383 +proof -
   5.384 +  have "(\<exists>g1. g1 \<in> R1) \<and> (\<exists>g2. g2 \<in> R2)"
   5.385 +    using assms(1-3) stab_rcosets_not_empty by auto
   5.386 +  then obtain g1 g2 where g1: "g1 \<in> R1" and g2: "g2 \<in> R2" by blast
   5.387 +  hence g12_carr: "g1 \<in> carrier G \<and> g2 \<in> carrier G"
   5.388 +    using subgroup.rcosets_carrier assms(1-3) group_hom
   5.389 +          group_hom.axioms(1) stabilizer_subgroup by blast
   5.390 +
   5.391 +  then obtain r1 r2 where r1: "r1 \<in> carrier G" "R1 = (stabilizer G \<phi> x) #> r1"
   5.392 +                      and r2: "r2 \<in> carrier G" "R2 = (stabilizer G \<phi> x) #> r2"
   5.393 +    using assms(1-3) unfolding RCOSETS_def by blast
   5.394 +  then obtain s1 s2 where s1: "s1 \<in> (stabilizer G \<phi> x)" "g1 = s1 \<otimes> r1"
   5.395 +                      and s2: "s2 \<in> (stabilizer G \<phi> x)" "g2 = s2 \<otimes> r2"
   5.396 +    using g1 g2 unfolding r_coset_def by blast
   5.397 +
   5.398 +  have "\<phi> (inv g1) x = \<phi> (inv (SOME h. h \<in> R1)) x"
   5.399 +    using orbit_stab_fun_is_well_defined1[OF assms(1) assms(2) g1] by simp
   5.400 +  also have " ... = \<phi> (inv (SOME h. h \<in> R2)) x"
   5.401 +    using assms(4) by simp
   5.402 +  finally have "\<phi> (inv g1) x = \<phi> (inv g2) x"
   5.403 +    using orbit_stab_fun_is_well_defined1[OF assms(1) assms(3) g2] by simp
   5.404 +
   5.405 +  hence "\<phi> g2 (\<phi> (inv g1) x) = \<phi> g2 (\<phi> (inv g2) x)" by simp
   5.406 +  also have " ... = \<phi> (g2 \<otimes> (inv g2)) x"
   5.407 +    using assms(1) composition_rule g12_carr group_hom group_hom.axioms(1) by fastforce
   5.408 +  finally have "\<phi> g2 (\<phi> (inv g1) x) = x"
   5.409 +    using g12_carr assms(1) group.r_inv group_hom group_hom.axioms(1)
   5.410 +          id_eq_one restrict_apply by metis
   5.411 +  hence "\<phi> (g2 \<otimes> (inv g1)) x = x"
   5.412 +    using assms(1) composition_rule g12_carr group_hom group_hom.axioms(1) by fastforce
   5.413 +  hence "g2 \<otimes> (inv g1) \<in> (stabilizer G \<phi> x)"
   5.414 +    using g12_carr group.subgroup_self group_hom group_hom.axioms(1)
   5.415 +          mem_Collect_eq stabilizer_def subgroup_def by (metis (mono_tags, lifting))
   5.416 +  then obtain s where s: "s \<in> (stabilizer G \<phi> x)" "s = g2 \<otimes> (inv g1)" by blast
   5.417 +
   5.418 +  let ?h = "s \<otimes> g1"
   5.419 +  have "?h = s \<otimes> (s1 \<otimes> r1)" by (simp add: s1)
   5.420 +  hence "?h = (s \<otimes> s1) \<otimes> r1"
   5.421 +    using stabilizer_subgroup[OF assms(1)] group_def group_hom
   5.422 +          group_hom.axioms(1) monoid.m_assoc r1 s s1 subgroup.mem_carrier by fastforce
   5.423 +  hence inR1: "?h \<in> (stabilizer G \<phi> x) #> r1" unfolding r_coset_def
   5.424 +    using stabilizer_subgroup[OF assms(1)] assms(1) s s1 stabilizer_m_closed by auto
   5.425 +
   5.426 +  have "?h = g2" using s stabilizer_subgroup[OF assms(1)] g12_carr group.inv_solve_right
   5.427 +                       group_hom group_hom.axioms(1) subgroup.mem_carrier by metis
   5.428 +  hence inR2: "?h \<in> (stabilizer G \<phi> x) #> r2"
   5.429 +    using g2 r2 by blast
   5.430 +
   5.431 +  have "R1 \<inter> R2 \<noteq> {}" using inR1 inR2 r1 r2 by blast
   5.432 +  thus ?thesis using stabilizer_subgroup group.rcos_disjoint[of G "stabilizer G \<phi> x" R1 R2]
   5.433 +                     assms group_hom group_hom.axioms(1) by blast
   5.434 +qed
   5.435 +
   5.436 +lemma (in group_action) orbit_stab_fun_is_surj:
   5.437 +  assumes "x \<in> E" "y \<in> orbit G \<phi> x"
   5.438 +  shows "\<exists>R \<in> rcosets (stabilizer G \<phi> x). \<phi> (inv (SOME h. h \<in> R)) x = y"
   5.439 +proof -
   5.440 +  have "\<exists>g \<in> carrier G. (\<phi> g) x = y"
   5.441 +    using assms(2) unfolding orbit_def by blast
   5.442 +  then obtain g where g: "g \<in> carrier G \<and> (\<phi> g) x = y" by blast
   5.443 +  
   5.444 +  let ?R = "(stabilizer G \<phi> x) #> (inv g)"
   5.445 +  have R: "?R \<in> rcosets (stabilizer G \<phi> x)"
   5.446 +    unfolding RCOSETS_def using g group_hom group_hom.axioms(1) by fastforce
   5.447 +  moreover have "\<one> \<otimes> (inv g) \<in> ?R"
   5.448 +    unfolding r_coset_def using assms(1) stabilizer_one_closed by auto
   5.449 +  ultimately have "\<phi> (inv (SOME h. h \<in> ?R)) x = \<phi> (inv (\<one> \<otimes> (inv g))) x"
   5.450 +    using orbit_stab_fun_is_well_defined1[OF assms(1)] by simp
   5.451 +  also have " ... = (\<phi> g) x"
   5.452 +    using group_def g group_hom group_hom.axioms(1) monoid.l_one by fastforce
   5.453 +  finally have "\<phi> (inv (SOME h. h \<in> ?R)) x = y"
   5.454 +    using g by simp
   5.455 +  thus ?thesis using R by blast 
   5.456 +qed
   5.457 +
   5.458 +proposition (in group_action) orbit_stab_fun_is_bij:
   5.459 +  assumes "x \<in> E"
   5.460 +  shows "bij_betw (\<lambda>R. (\<phi> (inv (SOME h. h \<in> R))) x) (rcosets (stabilizer G \<phi> x)) (orbit G \<phi> x)"
   5.461 +  unfolding bij_betw_def
   5.462 +proof
   5.463 +  show "inj_on (\<lambda>R. \<phi> (inv (SOME h. h \<in> R)) x) (rcosets stabilizer G \<phi> x)"
   5.464 +    using orbit_stab_fun_is_inj[OF assms(1)] by (simp add: inj_on_def)
   5.465 +next
   5.466 +  have "\<And>R. R \<in> (rcosets stabilizer G \<phi> x) \<Longrightarrow> \<phi> (inv (SOME h. h \<in> R)) x \<in> orbit G \<phi> x "
   5.467 +  proof -
   5.468 +    fix R assume R: "R \<in> (rcosets stabilizer G \<phi> x)"
   5.469 +    then obtain g where g: "g \<in> R"
   5.470 +      using assms stab_rcosets_not_empty by auto
   5.471 +    hence "\<phi> (inv (SOME h. h \<in> R)) x = \<phi> (inv g) x"
   5.472 +      using R  assms orbit_stab_fun_is_well_defined1 by blast
   5.473 +    thus "\<phi> (inv (SOME h. h \<in> R)) x \<in> orbit G \<phi> x" unfolding orbit_def
   5.474 +      using subgroup.rcosets_carrier group_hom group_hom.axioms(1)
   5.475 +            g R assms stabilizer_subgroup by fastforce
   5.476 +  qed
   5.477 +  moreover have "orbit G \<phi> x \<subseteq> (\<lambda>R. \<phi> (inv (SOME h. h \<in> R)) x) ` (rcosets stabilizer G \<phi> x)"
   5.478 +    using assms orbit_stab_fun_is_surj by fastforce
   5.479 +  ultimately show "(\<lambda>R. \<phi> (inv (SOME h. h \<in> R)) x) ` (rcosets stabilizer G \<phi> x) = orbit G \<phi> x "
   5.480 +    using assms set_eq_subset by blast
   5.481 +qed
   5.482 +
   5.483 +
   5.484 +subsubsection \<open>The Theorem\<close>
   5.485 +
   5.486 +theorem (in group_action) orbit_stabilizer_theorem:
   5.487 +  assumes "x \<in> E"
   5.488 +  shows "card (orbit G \<phi> x) * card (stabilizer G \<phi> x) = order G"
   5.489 +proof -
   5.490 +  have "card (rcosets stabilizer G \<phi> x) = card (orbit G \<phi> x)"
   5.491 +    using orbit_stab_fun_is_bij[OF assms(1)] bij_betw_same_card by blast
   5.492 +  moreover have "card (rcosets stabilizer G \<phi> x) * card (stabilizer G \<phi> x) = order G"
   5.493 +    using stabilizer_subgroup assms group.lagrange group_hom group_hom.axioms(1) by blast
   5.494 +  ultimately show ?thesis by auto
   5.495 +qed
   5.496 +
   5.497 +
   5.498 +
   5.499 +subsection \<open>The Burnside's Lemma\<close>
   5.500 +
   5.501 +subsubsection \<open>Sums and Cardinals\<close>
   5.502 +
   5.503 +lemma card_as_sums:
   5.504 +  assumes "A = {x \<in> B. P x}" "finite B"
   5.505 +  shows "card A = (\<Sum>x\<in>B. (if P x then 1 else 0))"
   5.506 +proof -
   5.507 +  have "A \<subseteq> B" using assms(1) by blast
   5.508 +  have "card A = (\<Sum>x\<in>A. 1)" by simp
   5.509 +  also have " ... = (\<Sum>x\<in>A. (if P x then 1 else 0))"
   5.510 +    by (simp add: assms(1))
   5.511 +  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))"
   5.512 +    using assms(1) by auto
   5.513 +  finally show "card A = (\<Sum>x\<in>B. (if P x then 1 else 0))"
   5.514 +    using \<open>A \<subseteq> B\<close> add.commute assms(2) sum.subset_diff by metis
   5.515 +qed
   5.516 +
   5.517 +lemma sum_invertion:
   5.518 +  "\<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)"
   5.519 +proof (induct set: finite)
   5.520 +  case empty thus ?case by simp
   5.521 +next
   5.522 +  case (insert x A')
   5.523 +  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)"
   5.524 +    by (simp add: insert.hyps)
   5.525 +  also have " ... = (\<Sum>y\<in>B. f x y) + (\<Sum>y\<in>B. \<Sum>x\<in>A'. f x y)"
   5.526 +    using insert.hyps by (simp add: insert.prems)
   5.527 +  also have " ... = (\<Sum>y\<in>B. (f x y) + (\<Sum>x\<in>A'. f x y))"
   5.528 +    by (simp add: sum.distrib)
   5.529 +  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)"
   5.530 +    using sum.swap by blast
   5.531 +  thus ?case by simp
   5.532 +qed
   5.533 +
   5.534 +lemma (in group_action) card_stablizer_sum:
   5.535 +  assumes "finite (carrier G)" "orb \<in> (orbits G E \<phi>)"
   5.536 +  shows "(\<Sum>x \<in> orb. card (stabilizer G \<phi> x)) = order G"
   5.537 +proof -
   5.538 +  obtain x where x:"x \<in> E" and orb:"orb = orbit G \<phi> x"
   5.539 +    using assms(2) unfolding orbits_def by blast
   5.540 +  have "\<And>y. y \<in> orb \<Longrightarrow> card (stabilizer G \<phi> x) = card (stabilizer G \<phi> y)"
   5.541 +  proof -
   5.542 +    fix y assume "y \<in> orb"
   5.543 +    hence y: "y \<in> E \<and> y \<in> orbit G \<phi> x"
   5.544 +      using x orb assms(2) orbits_coverture by auto 
   5.545 +    hence same_orbit: "(orbit G \<phi> x) = (orbit G \<phi> y)"
   5.546 +      using disjoint_union[of "orbit G \<phi> x" "orbit G \<phi> y"] orbit_refl x
   5.547 +      unfolding orbits_def by auto
   5.548 +    have "card (orbit G \<phi> x) * card (stabilizer G \<phi> x) =
   5.549 +          card (orbit G \<phi> y) * card (stabilizer G \<phi> y)"
   5.550 +      using y assms(1) x orbit_stabilizer_theorem by simp
   5.551 +    hence "card (orbit G \<phi> x) * card (stabilizer G \<phi> x) =
   5.552 +           card (orbit G \<phi> x) * card (stabilizer G \<phi> y)" using same_orbit by simp
   5.553 +    moreover have "orbit G \<phi> x \<noteq> {} \<and> finite (orbit G \<phi> x)"
   5.554 +      using y orbit_def[of G \<phi> x] assms(1) by auto
   5.555 +    hence "card (orbit G \<phi> x) > 0"
   5.556 +      by (simp add: card_gt_0_iff)
   5.557 +    ultimately show "card (stabilizer G \<phi> x) = card (stabilizer G \<phi> y)" by auto
   5.558 +  qed
   5.559 +  hence "(\<Sum>x \<in> orb. card (stabilizer G \<phi> x)) = (\<Sum>y \<in> orb. card (stabilizer G \<phi> x))" by auto
   5.560 +  also have " ... = card (stabilizer G \<phi> x) * (\<Sum>y \<in> orb. 1)" by simp
   5.561 +  also have " ... = card (stabilizer G \<phi> x) * card (orbit G \<phi> x)"
   5.562 +    using orb by auto
   5.563 +  finally show "(\<Sum>x \<in> orb. card (stabilizer G \<phi> x)) = order G"
   5.564 +    by (metis mult.commute orbit_stabilizer_theorem x)
   5.565 +qed
   5.566 +
   5.567 +
   5.568 +subsubsection \<open>The Lemma\<close>
   5.569 +
   5.570 +theorem (in group_action) burnside:
   5.571 +  assumes "finite (carrier G)" "finite E"
   5.572 +  shows "card (orbits G E \<phi>) * order G = (\<Sum>g \<in> carrier G. card(invariants E \<phi> g))"
   5.573 +proof -
   5.574 +  have "(\<Sum>g \<in> carrier G. card(invariants E \<phi> g)) =
   5.575 +        (\<Sum>g \<in> carrier G. \<Sum>x \<in> E. (if (\<phi> g) x = x then 1 else 0))"
   5.576 +    by (simp add: assms(2) card_as_sums invariants_def)
   5.577 +  also have " ... = (\<Sum>x \<in> E. \<Sum>g \<in> carrier G. (if (\<phi> g) x = x then 1 else 0))"
   5.578 +    using sum_invertion[where ?f = "\<lambda> g x. (if (\<phi> g) x = x then 1 else 0)"] assms by auto
   5.579 +  also have " ... = (\<Sum>x \<in> E. card (stabilizer G \<phi> x))"
   5.580 +    by (simp add: assms(1) card_as_sums stabilizer_def)
   5.581 +  also have " ... = (\<Sum>orbit \<in> (orbits G E \<phi>). \<Sum>x \<in> orbit. card (stabilizer G \<phi> x))"
   5.582 +    using disjoint_sum orbits_coverture assms(2) by metis
   5.583 +  also have " ... = (\<Sum>orbit \<in> (orbits G E \<phi>). order G)"
   5.584 +    by (simp add: assms(1) card_stablizer_sum)
   5.585 +  finally have "(\<Sum>g \<in> carrier G. card(invariants E \<phi> g)) = card (orbits G E \<phi>) * order G" by simp
   5.586 +  thus ?thesis by simp
   5.587 +qed
   5.588 +
   5.589 +
   5.590 +
   5.591 +subsection \<open>Action by Conjugation\<close>
   5.592 +
   5.593 +
   5.594 +subsubsection \<open>Action Over Itself\<close>
   5.595 +
   5.596 +text \<open>A Group Acts by Conjugation Over Itself\<close>
   5.597 +
   5.598 +lemma (in group) conjugation_is_inj:
   5.599 +  assumes "g \<in> carrier G" "h1 \<in> carrier G" "h2 \<in> carrier G"
   5.600 +    and "g \<otimes> h1 \<otimes> (inv g) = g \<otimes> h2 \<otimes> (inv g)"
   5.601 +    shows "h1 = h2"
   5.602 +  using assms by auto
   5.603 +
   5.604 +lemma (in group) conjugation_is_surj:
   5.605 +  assumes "g \<in> carrier G" "h \<in> carrier G"
   5.606 +  shows "g \<otimes> ((inv g) \<otimes> h \<otimes> g) \<otimes> (inv g) = h"
   5.607 +  using assms m_assoc inv_closed inv_inv m_closed monoid_axioms r_inv r_one
   5.608 +  by metis
   5.609 +
   5.610 +lemma (in group) conjugation_is_bij:
   5.611 +  assumes "g \<in> carrier G"
   5.612 +  shows "bij_betw (\<lambda>h \<in> carrier G. g \<otimes> h \<otimes> (inv g)) (carrier G) (carrier G)"
   5.613 +         (is "bij_betw ?\<phi> (carrier G) (carrier G)")
   5.614 +  unfolding bij_betw_def
   5.615 +proof
   5.616 +  show "inj_on ?\<phi> (carrier G)"
   5.617 +    using conjugation_is_inj by (simp add: assms inj_on_def) 
   5.618 +next
   5.619 +  have S: "\<And> h. h \<in> carrier G \<Longrightarrow> (inv g) \<otimes> h \<otimes> g \<in> carrier G"
   5.620 +    using assms by blast
   5.621 +  have "\<And> h. h \<in> carrier G \<Longrightarrow> ?\<phi> ((inv g) \<otimes> h \<otimes> g) = h"
   5.622 +    using assms by (simp add: conjugation_is_surj)
   5.623 +  hence "carrier G \<subseteq> ?\<phi> ` carrier G"
   5.624 +    using S image_iff by fastforce
   5.625 +  moreover have "\<And> h. h \<in> carrier G \<Longrightarrow> ?\<phi> h \<in> carrier G"
   5.626 +    using assms by simp
   5.627 +  hence "?\<phi> ` carrier G \<subseteq> carrier G" by blast
   5.628 +  ultimately show "?\<phi> ` carrier G = carrier G" by blast
   5.629 +qed
   5.630 +
   5.631 +lemma(in group) conjugation_is_hom:
   5.632 +  "(\<lambda>g. \<lambda>h \<in> carrier G. g \<otimes> h \<otimes> inv g) \<in> hom G (BijGroup (carrier G))"
   5.633 +  unfolding hom_def
   5.634 +proof -
   5.635 +  let ?\<psi> = "\<lambda>g. \<lambda>h. g \<otimes> h \<otimes> inv g"
   5.636 +  let ?\<phi> = "\<lambda>g. restrict (?\<psi> g) (carrier G)"
   5.637 +
   5.638 +  (* First, we prove that ?\<phi>: G \<rightarrow> Bij(G) is well defined *)
   5.639 +  have Step0: "\<And> g. g \<in> carrier G \<Longrightarrow> (?\<phi> g) \<in> Bij (carrier G)"
   5.640 +    using Bij_def conjugation_is_bij by fastforce
   5.641 +  hence Step1: "?\<phi>: carrier G \<rightarrow> carrier (BijGroup (carrier G))"
   5.642 +    unfolding BijGroup_def by simp
   5.643 +
   5.644 +  (* Second, we prove that ?\<phi> is a homomorphism *)
   5.645 +  have "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.646 +                  (\<And> h. h \<in> carrier G \<Longrightarrow> ?\<psi> (g1 \<otimes> g2) h = (?\<phi> g1) ((?\<phi> g2) h))"
   5.647 +  proof -
   5.648 +    fix g1 g2 h assume g1: "g1 \<in> carrier G" and g2: "g2 \<in> carrier G" and h: "h \<in> carrier G"
   5.649 +    have "inv (g1 \<otimes> g2) = (inv g2) \<otimes> (inv g1)"
   5.650 +      using g1 g2 by (simp add: inv_mult_group)
   5.651 +    thus "?\<psi> (g1 \<otimes> g2) h  = (?\<phi> g1) ((?\<phi> g2) h)"
   5.652 +      by (simp add: g1 g2 h m_assoc)
   5.653 +  qed
   5.654 +  hence "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.655 +         (\<lambda> h \<in> carrier G. ?\<psi> (g1 \<otimes> g2) h) = (\<lambda> h \<in> carrier G. (?\<phi> g1) ((?\<phi> g2) h))" by auto
   5.656 +  hence Step2: "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.657 +                ?\<phi> (g1 \<otimes> g2) = (?\<phi> g1) \<otimes>\<^bsub>BijGroup (carrier G)\<^esub> (?\<phi> g2)"
   5.658 +    unfolding BijGroup_def by (simp add: Step0 compose_def)
   5.659 +
   5.660 +  (* Finally, we combine both results to prove the lemma *)
   5.661 +  thus "?\<phi> \<in> {h: carrier G \<rightarrow> carrier (BijGroup (carrier G)).
   5.662 +              (\<forall>x \<in> carrier G. \<forall>y \<in> carrier G. h (x \<otimes> y) = h x \<otimes>\<^bsub>BijGroup (carrier G)\<^esub> h y)}"
   5.663 +    using Step1 Step2 by auto
   5.664 +qed
   5.665 +
   5.666 +theorem (in group) action_by_conjugation:
   5.667 +  "group_action G (carrier G) (\<lambda>g. (\<lambda>h \<in> carrier G. g \<otimes> h \<otimes> (inv g)))"
   5.668 +  unfolding group_action_def group_hom_def using conjugation_is_hom
   5.669 +  by (simp add: group_BijGroup group_hom_axioms.intro is_group)
   5.670 +
   5.671 +
   5.672 +subsubsection \<open>Action Over The Set of Subgroups\<close>
   5.673 +
   5.674 +text \<open>A Group Acts by Conjugation Over The Set of Subgroups\<close>
   5.675 +
   5.676 +lemma (in group) subgroup_conjugation_is_inj_aux:
   5.677 +  assumes "g \<in> carrier G" "H1 \<subseteq> carrier G" "H2 \<subseteq> carrier G"
   5.678 +    and "g <# H1 #> (inv g) = g <# H2 #> (inv g)"
   5.679 +    shows "H1 \<subseteq> H2"
   5.680 +proof
   5.681 +  fix h1 assume h1: "h1 \<in> H1"
   5.682 +  hence "g \<otimes> h1 \<otimes> (inv g) \<in> g <# H1 #> (inv g)"
   5.683 +    unfolding l_coset_def r_coset_def using assms by blast
   5.684 +  hence "g \<otimes> h1 \<otimes> (inv g) \<in> g <# H2 #> (inv g)"
   5.685 +    using assms by auto
   5.686 +  hence "\<exists>h2 \<in> H2. g \<otimes> h1 \<otimes> (inv g) = g \<otimes> h2 \<otimes> (inv g)"
   5.687 +      unfolding l_coset_def r_coset_def by blast
   5.688 +  then obtain h2 where "h2 \<in> H2 \<and> g \<otimes> h1 \<otimes> (inv g) = g \<otimes> h2 \<otimes> (inv g)" by blast
   5.689 +  thus "h1 \<in> H2"
   5.690 +    using assms conjugation_is_inj h1 by blast
   5.691 +qed
   5.692 +
   5.693 +lemma (in group) subgroup_conjugation_is_inj:
   5.694 +  assumes "g \<in> carrier G" "H1 \<subseteq> carrier G" "H2 \<subseteq> carrier G"
   5.695 +    and "g <# H1 #> (inv g) = g <# H2 #> (inv g)"
   5.696 +    shows "H1 = H2"
   5.697 +  using subgroup_conjugation_is_inj_aux assms set_eq_subset by metis
   5.698 +
   5.699 +lemma (in group) subgroup_conjugation_is_surj0:
   5.700 +  assumes "g \<in> carrier G" "H \<subseteq> carrier G"
   5.701 +  shows "g <# ((inv g) <# H #> g) #> (inv g) = H"
   5.702 +  using coset_assoc assms coset_mult_assoc l_coset_subset_G lcos_m_assoc
   5.703 +  by (simp add: lcos_mult_one)
   5.704 +
   5.705 +lemma (in group) subgroup_conjugation_is_surj1:
   5.706 +  assumes "g \<in> carrier G" "subgroup H G"
   5.707 +  shows "subgroup ((inv g) <# H #> g) G"
   5.708 +proof
   5.709 +  show "\<one> \<in> inv g <# H #> g"
   5.710 +  proof -
   5.711 +    have "\<one> \<in> H" by (simp add: assms(2) subgroup.one_closed)
   5.712 +    hence "inv g \<otimes> \<one> \<otimes> g \<in> inv g <# H #> g"
   5.713 +      unfolding l_coset_def r_coset_def by blast
   5.714 +    thus "\<one> \<in> inv g <# H #> g" using assms by simp
   5.715 +  qed
   5.716 +next
   5.717 +  show "inv g <# H #> g \<subseteq> carrier G"
   5.718 +  proof
   5.719 +    fix x assume "x \<in> inv g <# H #> g"
   5.720 +    hence "\<exists>h \<in> H. x = (inv g) \<otimes> h \<otimes> g"
   5.721 +      unfolding r_coset_def l_coset_def by blast
   5.722 +    hence "\<exists>h \<in> (carrier G). x = (inv g) \<otimes> h \<otimes> g"
   5.723 +      by (meson assms subgroup.mem_carrier)
   5.724 +    thus "x \<in> carrier G" using assms by blast
   5.725 +  qed
   5.726 +next
   5.727 +  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"
   5.728 +  proof -
   5.729 +    fix x y assume "x \<in> inv g <# H #> g"  "y \<in> inv g <# H #> g"
   5.730 +    hence "\<exists> h1 \<in> H. \<exists> h2 \<in> H. x = (inv g) \<otimes> h1 \<otimes> g \<and> y = (inv g) \<otimes> h2 \<otimes> g"
   5.731 +      unfolding l_coset_def r_coset_def by blast
   5.732 +    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
   5.733 +    hence "\<exists> h1 \<in> H. \<exists> h2 \<in> H. x \<otimes> y = ((inv g) \<otimes> (h1 \<otimes> h2) \<otimes> g)"
   5.734 +      using assms is_group inv_closed l_one m_assoc m_closed
   5.735 +            monoid_axioms r_inv subgroup.mem_carrier by smt
   5.736 +    hence "\<exists> h \<in> H. x \<otimes> y = (inv g) \<otimes> h \<otimes> g"
   5.737 +      by (meson assms(2) subgroup_def)
   5.738 +    thus "x \<otimes> y \<in> inv g <# H #> g"
   5.739 +      unfolding l_coset_def r_coset_def by blast
   5.740 +  qed
   5.741 +next
   5.742 +  show "\<And>x. x \<in> inv g <# H #> g \<Longrightarrow> inv x \<in> inv g <# H #> g"
   5.743 +  proof -
   5.744 +    fix x assume "x \<in> inv g <# H #> g"
   5.745 +    hence "\<exists>h \<in> H. x = (inv g) \<otimes> h \<otimes> g"
   5.746 +      unfolding r_coset_def l_coset_def by blast
   5.747 +    then obtain h where h: "h \<in> H \<and> x = (inv g) \<otimes> h \<otimes> g" by blast
   5.748 +    hence "x \<otimes> (inv g) \<otimes> (inv h) \<otimes> g = \<one>"
   5.749 +      using assms inv_closed m_assoc m_closed monoid_axioms
   5.750 +            r_inv r_one subgroup.mem_carrier by smt
   5.751 +    hence "inv x = (inv g) \<otimes> (inv h) \<otimes> g"
   5.752 +      using assms h inv_closed inv_inv inv_mult_group m_assoc
   5.753 +            m_closed monoid_axioms subgroup.mem_carrier by smt
   5.754 +    moreover have "inv h \<in> H"
   5.755 +      by (simp add: assms h subgroup.m_inv_closed)
   5.756 +    ultimately show "inv x \<in> inv g <# H #> g" unfolding r_coset_def l_coset_def by blast
   5.757 +  qed
   5.758 +qed
   5.759 +
   5.760 +lemma (in group) subgroup_conjugation_is_surj2:
   5.761 +  assumes "g \<in> carrier G" "subgroup H G"
   5.762 +  shows "subgroup (g <# H #> (inv g)) G"
   5.763 +  using subgroup_conjugation_is_surj1 by (metis assms inv_closed inv_inv)
   5.764 +
   5.765 +lemma (in group) subgroup_conjugation_is_bij:
   5.766 +  assumes "g \<in> carrier G"
   5.767 +  shows "bij_betw (\<lambda>H \<in> {H. subgroup H G}. g <# H #> (inv g)) {H. subgroup H G} {H. subgroup H G}"
   5.768 +         (is "bij_betw ?\<phi> {H. subgroup H G} {H. subgroup H G}")
   5.769 +  unfolding bij_betw_def
   5.770 +proof
   5.771 +  show "inj_on ?\<phi> {H. subgroup H G}"
   5.772 +    using subgroup_conjugation_is_inj assms inj_on_def subgroup_imp_subset
   5.773 +    by (metis (mono_tags, lifting) inj_on_restrict_eq mem_Collect_eq)
   5.774 +next
   5.775 +  have "\<And>H. H \<in> {H. subgroup H G} \<Longrightarrow> ?\<phi> ((inv g) <# H #> g) = H"
   5.776 +    by (simp add: assms subgroup_imp_subset subgroup_conjugation_is_surj0
   5.777 +                  subgroup_conjugation_is_surj1 is_group)
   5.778 +  hence "\<And>H. H \<in> {H. subgroup H G} \<Longrightarrow> \<exists>H' \<in> {H. subgroup H G}. ?\<phi> H' = H"
   5.779 +    using assms subgroup_conjugation_is_surj1 by fastforce
   5.780 +  thus "?\<phi> ` {H. subgroup H G} = {H. subgroup H G}"
   5.781 +    using subgroup_conjugation_is_surj2 assms by auto
   5.782 +qed
   5.783 +
   5.784 +lemma (in group) subgroup_conjugation_is_hom:
   5.785 +  "(\<lambda>g. \<lambda>H \<in> {H. subgroup H G}. g <# H #> (inv g)) \<in> hom G (BijGroup {H. subgroup H G})"
   5.786 +  unfolding hom_def
   5.787 +proof -
   5.788 +  (* We follow the exact same structure of conjugation_is_hom's proof *)
   5.789 +  let ?\<psi> = "\<lambda>g. \<lambda>H. g <# H #> (inv g)"
   5.790 +  let ?\<phi> = "\<lambda>g. restrict (?\<psi> g) {H. subgroup H G}"
   5.791 +
   5.792 +  have Step0: "\<And> g. g \<in> carrier G \<Longrightarrow> (?\<phi> g) \<in> Bij {H. subgroup H G}"
   5.793 +    using Bij_def subgroup_conjugation_is_bij by fastforce
   5.794 +  hence Step1: "?\<phi>: carrier G \<rightarrow> carrier (BijGroup {H. subgroup H G})"
   5.795 +    unfolding BijGroup_def by simp
   5.796 +
   5.797 +  have "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.798 +                  (\<And> H. H \<in> {H. subgroup H G} \<Longrightarrow> ?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H))"
   5.799 +  proof -
   5.800 +    fix g1 g2 H assume g1: "g1 \<in> carrier G" and g2: "g2 \<in> carrier G" and H': "H \<in> {H. subgroup H G}"
   5.801 +    hence H: "subgroup H G" by simp
   5.802 +    have "(?\<phi> g1) ((?\<phi> g2) H) = g1 <# (g2 <# H #> (inv g2)) #> (inv g1)"
   5.803 +      by (simp add: H g2 subgroup_conjugation_is_surj2)
   5.804 +    also have " ... = g1 <# (g2 <# H) #> ((inv g2) \<otimes> (inv g1))"
   5.805 +      by (simp add: H coset_mult_assoc g1 g2 group.coset_assoc
   5.806 +                    is_group l_coset_subset_G subgroup_imp_subset)
   5.807 +    also have " ... = g1 <# (g2 <# H) #> inv (g1 \<otimes> g2)"
   5.808 +      using g1 g2 by (simp add: inv_mult_group)
   5.809 +    finally have "(?\<phi> g1) ((?\<phi> g2) H) = ?\<psi> (g1 \<otimes> g2) H"
   5.810 +      by (simp add: H g1 g2 lcos_m_assoc subgroup_imp_subset)
   5.811 +    thus "?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H)" by auto
   5.812 +  qed
   5.813 +  hence "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.814 +         (\<lambda>H \<in> {H. subgroup H G}. ?\<psi> (g1 \<otimes> g2) H) = (\<lambda>H \<in> {H. subgroup H G}. (?\<phi> g1) ((?\<phi> g2) H))"
   5.815 +    by (meson restrict_ext)
   5.816 +  hence Step2: "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.817 +                ?\<phi> (g1 \<otimes> g2) = (?\<phi> g1) \<otimes>\<^bsub>BijGroup {H. subgroup H G}\<^esub> (?\<phi> g2)"
   5.818 +    unfolding BijGroup_def by (simp add: Step0 compose_def)
   5.819 +
   5.820 +  show "?\<phi> \<in> {h: carrier G \<rightarrow> carrier (BijGroup {H. subgroup H G}).
   5.821 +              \<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}"
   5.822 +    using Step1 Step2 by auto
   5.823 +qed
   5.824 +
   5.825 +theorem (in group) action_by_conjugation_on_subgroups_set:
   5.826 +  "group_action G {H. subgroup H G} (\<lambda>g. \<lambda>H \<in> {H. subgroup H G}. g <# H #> (inv g))"
   5.827 +  unfolding group_action_def group_hom_def using subgroup_conjugation_is_hom
   5.828 +  by (simp add: group_BijGroup group_hom_axioms.intro is_group)
   5.829 +
   5.830 +
   5.831 +subsubsection \<open>Action Over The Power Set\<close>
   5.832 +
   5.833 +text \<open>A Group Acts by Conjugation Over The Power Set\<close>
   5.834 +
   5.835 +lemma (in group) subset_conjugation_is_bij:
   5.836 +  assumes "g \<in> carrier G"
   5.837 +  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}"
   5.838 +         (is "bij_betw ?\<phi> {H. H \<subseteq> carrier G} {H. H \<subseteq> carrier G}")
   5.839 +  unfolding bij_betw_def
   5.840 +proof
   5.841 +  show "inj_on ?\<phi> {H. H \<subseteq> carrier G}"
   5.842 +    using subgroup_conjugation_is_inj assms inj_on_def
   5.843 +    by (metis (mono_tags, lifting) inj_on_restrict_eq mem_Collect_eq)
   5.844 +next
   5.845 +  have "\<And>H. H \<in> {H. H \<subseteq> carrier G} \<Longrightarrow> ?\<phi> ((inv g) <# H #> g) = H"
   5.846 +    by (simp add: assms l_coset_subset_G r_coset_subset_G subgroup_conjugation_is_surj0)
   5.847 +  hence "\<And>H. H \<in> {H. H \<subseteq> carrier G} \<Longrightarrow> \<exists>H' \<in> {H. H \<subseteq> carrier G}. ?\<phi> H' = H"
   5.848 +    by (metis assms l_coset_subset_G mem_Collect_eq r_coset_subset_G subgroup_def subgroup_self)
   5.849 +  hence "{H. H \<subseteq> carrier G} \<subseteq> ?\<phi> ` {H. H \<subseteq> carrier G}" by blast
   5.850 +  moreover have "?\<phi> ` {H. H \<subseteq> carrier G} \<subseteq> {H. H \<subseteq> carrier G}"
   5.851 +    by (smt assms image_subsetI inv_closed l_coset_subset_G
   5.852 +            mem_Collect_eq r_coset_subset_G restrict_apply')
   5.853 +  ultimately show "?\<phi> ` {H. H \<subseteq> carrier G} = {H. H \<subseteq> carrier G}" by simp
   5.854 +qed
   5.855 +
   5.856 +lemma (in group) subset_conjugation_is_hom:
   5.857 +  "(\<lambda>g. \<lambda>H \<in> {H. H \<subseteq> carrier G}. g <# H #> (inv g)) \<in> hom G (BijGroup {H. H \<subseteq> carrier G})"
   5.858 +  unfolding hom_def
   5.859 +proof -
   5.860 +  (* We follow the exact same structure of conjugation_is_hom's proof *)
   5.861 +  let ?\<psi> = "\<lambda>g. \<lambda>H. g <# H #> (inv g)"
   5.862 +  let ?\<phi> = "\<lambda>g. restrict (?\<psi> g) {H. H \<subseteq> carrier G}"
   5.863 +
   5.864 +  have Step0: "\<And> g. g \<in> carrier G \<Longrightarrow> (?\<phi> g) \<in> Bij {H. H \<subseteq> carrier G}"
   5.865 +    using Bij_def subset_conjugation_is_bij by fastforce
   5.866 +  hence Step1: "?\<phi>: carrier G \<rightarrow> carrier (BijGroup {H. H \<subseteq> carrier G})"
   5.867 +    unfolding BijGroup_def by simp
   5.868 +
   5.869 +  have "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.870 +                  (\<And> H. H \<in> {H. H \<subseteq> carrier G} \<Longrightarrow> ?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H))"
   5.871 +  proof -
   5.872 +    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}"
   5.873 +    hence "(?\<phi> g1) ((?\<phi> g2) H) = g1 <# (g2 <# H #> (inv g2)) #> (inv g1)"
   5.874 +      using l_coset_subset_G r_coset_subset_G by auto
   5.875 +    also have " ... = g1 <# (g2 <# H) #> ((inv g2) \<otimes> (inv g1))"
   5.876 +      using H coset_assoc coset_mult_assoc g1 g2 l_coset_subset_G by auto
   5.877 +    also have " ... = g1 <# (g2 <# H) #> inv (g1 \<otimes> g2)"
   5.878 +      using g1 g2 by (simp add: inv_mult_group)
   5.879 +    finally have "(?\<phi> g1) ((?\<phi> g2) H) = ?\<psi> (g1 \<otimes> g2) H"
   5.880 +      using H g1 g2 lcos_m_assoc by force
   5.881 +    thus "?\<psi> (g1 \<otimes> g2) H = (?\<phi> g1) ((?\<phi> g2) H)" by auto
   5.882 +  qed
   5.883 +  hence "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.884 +         (\<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))"
   5.885 +    by (meson restrict_ext)
   5.886 +  hence Step2: "\<And> g1 g2. \<lbrakk> g1 \<in> carrier G; g2 \<in> carrier G \<rbrakk> \<Longrightarrow>
   5.887 +                ?\<phi> (g1 \<otimes> g2) = (?\<phi> g1) \<otimes>\<^bsub>BijGroup {H. H \<subseteq> carrier G}\<^esub> (?\<phi> g2)"
   5.888 +    unfolding BijGroup_def by (simp add: Step0 compose_def)
   5.889 +
   5.890 +  show "?\<phi> \<in> {h: carrier G \<rightarrow> carrier (BijGroup {H. H \<subseteq> carrier G}).
   5.891 +              \<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}"
   5.892 +    using Step1 Step2 by auto
   5.893 +qed
   5.894 +
   5.895 +theorem (in group) action_by_conjugation_on_power_set:
   5.896 +  "group_action G {H. H \<subseteq> carrier G} (\<lambda>g. \<lambda>H \<in> {H. H \<subseteq> carrier G}. g <# H #> (inv g))"
   5.897 +  unfolding group_action_def group_hom_def using subset_conjugation_is_hom
   5.898 +  by (simp add: group_BijGroup group_hom_axioms.intro is_group)
   5.899 +
   5.900 +corollary (in group) normalizer_imp_subgroup:
   5.901 +  assumes "H \<subseteq> carrier G"
   5.902 +  shows "subgroup (normalizer G H) G"
   5.903 +  unfolding normalizer_def
   5.904 +  using group_action.stabilizer_subgroup[OF action_by_conjugation_on_power_set] assms by auto
   5.905 +
   5.906 +
   5.907 +subsection \<open>Subgroup of an Acting Group\<close>
   5.908 +
   5.909 +text \<open>A Subgroup of an Acting Group Induces an Action\<close>
   5.910 +
   5.911 +lemma (in group_action) induced_homomorphism:
   5.912 +  assumes "subgroup H G"
   5.913 +  shows "\<phi> \<in> hom (G \<lparr>carrier := H\<rparr>) (BijGroup E)"
   5.914 +  unfolding hom_def apply simp
   5.915 +proof -
   5.916 +  have S0: "H \<subseteq> carrier G" by (meson assms subgroup_def)
   5.917 +  hence "\<phi>: H \<rightarrow> carrier (BijGroup E)"
   5.918 +    by (simp add: BijGroup_def bij_prop0 subset_eq)
   5.919 +  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)"
   5.920 +    by (simp add: S0  group_hom group_hom.hom_mult set_rev_mp)
   5.921 +qed
   5.922 +
   5.923 +theorem (in group_action) induced_action:
   5.924 +  assumes "subgroup H G"
   5.925 +  shows "group_action (G \<lparr>carrier := H\<rparr>) E \<phi>"
   5.926 +  unfolding group_action_def group_hom_def
   5.927 +  using induced_homomorphism assms group.subgroup_imp_group group_BijGroup
   5.928 +        group_hom group_hom.axioms(1) group_hom_axioms_def by blast
   5.929 +
   5.930 +end
   5.931 \ No newline at end of file
     6.1 --- a/src/HOL/Algebra/Ideal.thy	Tue Jun 12 16:21:52 2018 +0200
     6.2 +++ b/src/HOL/Algebra/Ideal.thy	Tue Jun 12 16:09:12 2018 +0100
     6.3 @@ -29,7 +29,7 @@
     6.4  lemma idealI:
     6.5    fixes R (structure)
     6.6    assumes "ring R"
     6.7 -  assumes a_subgroup: "subgroup I \<lparr>carrier = carrier R, mult = add R, one = zero R\<rparr>"
     6.8 +  assumes a_subgroup: "subgroup I (add_monoid R)"
     6.9      and I_l_closed: "\<And>a x. \<lbrakk>a \<in> I; x \<in> carrier R\<rbrakk> \<Longrightarrow> x \<otimes> a \<in> I"
    6.10      and I_r_closed: "\<And>a x. \<lbrakk>a \<in> I; x \<in> carrier R\<rbrakk> \<Longrightarrow> a \<otimes> x \<in> I"
    6.11    shows "ideal I R"
    6.12 @@ -708,10 +708,7 @@
    6.13  qed
    6.14  
    6.15  corollary (in cring) domain_eq_zeroprimeideal: "domain R = primeideal {\<zero>} R"
    6.16 -  apply rule
    6.17 -   apply (erule domain.zeroprimeideal)
    6.18 -  apply (erule zeroprimeideal_domainI)
    6.19 -  done
    6.20 +  using domain.zeroprimeideal zeroprimeideal_domainI by blast
    6.21  
    6.22  
    6.23  subsection \<open>Maximal Ideals\<close>
    6.24 @@ -963,9 +960,6 @@
    6.25  qed
    6.26  
    6.27  lemma (in cring) zeromaximalideal_eq_field: "maximalideal {\<zero>} R = field R"
    6.28 -  apply rule
    6.29 -   apply (erule zeromaximalideal_fieldI)
    6.30 -  apply (erule field.zeromaximalideal)
    6.31 -  done
    6.32 +  using field.zeromaximalideal zeromaximalideal_fieldI by blast
    6.33  
    6.34  end
     7.1 --- a/src/HOL/Algebra/Ring.thy	Tue Jun 12 16:21:52 2018 +0200
     7.2 +++ b/src/HOL/Algebra/Ring.thy	Tue Jun 12 16:09:12 2018 +0100
     7.3 @@ -13,79 +13,101 @@
     7.4  
     7.5  record 'a ring = "'a monoid" +
     7.6    zero :: 'a ("\<zero>\<index>")
     7.7 -  add :: "['a, 'a] => 'a" (infixl "\<oplus>\<index>" 65)
     7.8 +  add :: "['a, 'a] \<Rightarrow> 'a" (infixl "\<oplus>\<index>" 65)
     7.9 +
    7.10 +abbreviation
    7.11 +  add_monoid :: "('a, 'm) ring_scheme \<Rightarrow> ('a, 'm) monoid_scheme"
    7.12 +  where "add_monoid R \<equiv> \<lparr> carrier = carrier R, mult = add R, one = zero R, \<dots> = (undefined :: 'm) \<rparr>"
    7.13  
    7.14  text \<open>Derived operations.\<close>
    7.15  
    7.16  definition
    7.17 -  a_inv :: "[('a, 'm) ring_scheme, 'a ] => 'a" ("\<ominus>\<index> _" [81] 80)
    7.18 -  where "a_inv R = m_inv \<lparr>carrier = carrier R, mult = add R, one = zero R\<rparr>"
    7.19 +  a_inv :: "[('a, 'm) ring_scheme, 'a ] \<Rightarrow> 'a" ("\<ominus>\<index> _" [81] 80)
    7.20 +  where "a_inv R = m_inv (add_monoid R)"
    7.21 +
    7.22  
    7.23  definition
    7.24    a_minus :: "[('a, 'm) ring_scheme, 'a, 'a] => 'a" ("(_ \<ominus>\<index> _)" [65,66] 65)
    7.25 -  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)"
    7.26 +  where "\<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<ominus>\<^bsub>R\<^esub> y = x \<oplus>\<^bsub>R\<^esub> (\<ominus>\<^bsub>R\<^esub> y)"
    7.27 +
    7.28 +definition
    7.29 +  add_pow :: "[_, ('b :: semiring_1), 'a] \<Rightarrow> 'a" ("[_] \<cdot>\<index> _" [81, 81] 80)
    7.30 +  where "add_pow R k a = pow (add_monoid R) a k"
    7.31  
    7.32  locale abelian_monoid =
    7.33    fixes G (structure)
    7.34    assumes a_comm_monoid:
    7.35 -     "comm_monoid \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
    7.36 +     "comm_monoid (add_monoid G)"
    7.37  
    7.38  definition
    7.39 -  finsum :: "[('b, 'm) ring_scheme, 'a => 'b, 'a set] => 'b" where
    7.40 -  "finsum G = finprod \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
    7.41 +  finsum :: "[('b, 'm) ring_scheme, 'a \<Rightarrow> 'b, 'a set] \<Rightarrow> 'b" where
    7.42 +  "finsum G = finprod (add_monoid G)"
    7.43  
    7.44  syntax
    7.45 -  "_finsum" :: "index => idt => 'a set => 'b => 'b"
    7.46 +  "_finsum" :: "index \<Rightarrow> idt \<Rightarrow> 'a set \<Rightarrow> 'b \<Rightarrow> 'b"
    7.47        ("(3\<Oplus>__\<in>_. _)" [1000, 0, 51, 10] 10)
    7.48  translations
    7.49 -  "\<Oplus>\<^bsub>G\<^esub>i\<in>A. b" \<rightleftharpoons> "CONST finsum G (%i. b) A"
    7.50 +  "\<Oplus>\<^bsub>G\<^esub>i\<in>A. b" \<rightleftharpoons> "CONST finsum G (\<lambda>i. b) A"
    7.51    \<comment> \<open>Beware of argument permutation!\<close>
    7.52  
    7.53  
    7.54  locale abelian_group = abelian_monoid +
    7.55    assumes a_comm_group:
    7.56 -     "comm_group \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
    7.57 +     "comm_group (add_monoid G)"
    7.58  
    7.59  
    7.60  subsection \<open>Basic Properties\<close>
    7.61  
    7.62  lemma abelian_monoidI:
    7.63    fixes R (structure)
    7.64 -  assumes a_closed:
    7.65 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y \<in> carrier R"
    7.66 -    and zero_closed: "\<zero> \<in> carrier R"
    7.67 -    and a_assoc:
    7.68 -      "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |] ==>
    7.69 -      (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
    7.70 -    and l_zero: "!!x. x \<in> carrier R ==> \<zero> \<oplus> x = x"
    7.71 -    and a_comm:
    7.72 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y = y \<oplus> x"
    7.73 +  assumes "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
    7.74 +      and "\<zero> \<in> carrier R"
    7.75 +      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)"
    7.76 +      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
    7.77 +      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
    7.78    shows "abelian_monoid R"
    7.79    by (auto intro!: abelian_monoid.intro comm_monoidI intro: assms)
    7.80  
    7.81 +lemma abelian_monoidE:
    7.82 +  fixes R (structure)
    7.83 +  assumes "abelian_monoid R"
    7.84 +  shows "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
    7.85 +    and "\<zero> \<in> carrier R"
    7.86 +    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)"
    7.87 +    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
    7.88 +    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
    7.89 +  using assms unfolding abelian_monoid_def comm_monoid_def comm_monoid_axioms_def monoid_def by auto
    7.90 +
    7.91  lemma abelian_groupI:
    7.92    fixes R (structure)
    7.93 -  assumes a_closed:
    7.94 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y \<in> carrier R"
    7.95 -    and zero_closed: "zero R \<in> carrier R"
    7.96 -    and a_assoc:
    7.97 -      "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |] ==>
    7.98 -      (x \<oplus> y) \<oplus> z = x \<oplus> (y \<oplus> z)"
    7.99 -    and a_comm:
   7.100 -      "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==> x \<oplus> y = y \<oplus> x"
   7.101 -    and l_zero: "!!x. x \<in> carrier R ==> \<zero> \<oplus> x = x"
   7.102 -    and l_inv_ex: "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
   7.103 +  assumes "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
   7.104 +      and "\<zero> \<in> carrier R"
   7.105 +      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)"
   7.106 +      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
   7.107 +      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
   7.108 +      and "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
   7.109    shows "abelian_group R"
   7.110    by (auto intro!: abelian_group.intro abelian_monoidI
   7.111        abelian_group_axioms.intro comm_monoidI comm_groupI
   7.112      intro: assms)
   7.113  
   7.114 +lemma abelian_groupE:
   7.115 +  fixes R (structure)
   7.116 +  assumes "abelian_group R"
   7.117 +  shows "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y \<in> carrier R"
   7.118 +    and "\<zero> \<in> carrier R"
   7.119 +    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)"
   7.120 +    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<oplus> y = y \<oplus> x"
   7.121 +    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<zero> \<oplus> x = x"
   7.122 +    and "\<And>x. x \<in> carrier R \<Longrightarrow> \<exists>y \<in> carrier R. y \<oplus> x = \<zero>"
   7.123 +  using abelian_group.a_comm_group assms comm_groupE by fastforce+
   7.124 +
   7.125  lemma (in abelian_monoid) a_monoid:
   7.126 -  "monoid \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.127 +  "monoid (add_monoid G)"
   7.128  by (rule comm_monoid.axioms, rule a_comm_monoid) 
   7.129  
   7.130  lemma (in abelian_group) a_group:
   7.131 -  "group \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.132 +  "group (add_monoid G)"
   7.133    by (simp add: group_def a_monoid)
   7.134      (simp add: comm_group.axioms group.axioms a_comm_group)
   7.135  
   7.136 @@ -94,13 +116,15 @@
   7.137  text \<open>Transfer facts from multiplicative structures via interpretation.\<close>
   7.138  
   7.139  sublocale abelian_monoid <
   7.140 -  add: monoid "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.141 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
   7.142 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
   7.143 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
   7.144 -  by (rule a_monoid) auto
   7.145 +       add: monoid "(add_monoid G)"
   7.146 +  rewrites "carrier (add_monoid G) = carrier G"
   7.147 +       and "mult    (add_monoid G) = add G"
   7.148 +       and "one     (add_monoid G) = zero G"
   7.149 +       and "(\<lambda>a k. pow (add_monoid G) a k) = (\<lambda>a k. add_pow G k a)"
   7.150 +  by (rule a_monoid) (auto simp add: add_pow_def)
   7.151  
   7.152 -context abelian_monoid begin
   7.153 +context abelian_monoid
   7.154 +begin
   7.155  
   7.156  lemmas a_closed = add.m_closed 
   7.157  lemmas zero_closed = add.one_closed
   7.158 @@ -112,12 +136,13 @@
   7.159  end
   7.160  
   7.161  sublocale abelian_monoid <
   7.162 -  add: comm_monoid "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.163 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
   7.164 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
   7.165 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
   7.166 -    and "finprod \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = finsum G"
   7.167 -  by (rule a_comm_monoid) (auto simp: finsum_def)
   7.168 +  add: comm_monoid "(add_monoid G)"
   7.169 +  rewrites "carrier (add_monoid G) = carrier G"
   7.170 +       and "mult    (add_monoid G) = add G"
   7.171 +       and "one     (add_monoid G) = zero G"
   7.172 +       and "finprod (add_monoid G) = finsum G"
   7.173 +       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
   7.174 +  by (rule a_comm_monoid) (auto simp: finsum_def add_pow_def)
   7.175  
   7.176  context abelian_monoid begin
   7.177  
   7.178 @@ -168,12 +193,13 @@
   7.179  end
   7.180  
   7.181  sublocale abelian_group <
   7.182 -  add: group "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.183 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
   7.184 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
   7.185 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
   7.186 -    and "m_inv \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = a_inv G"
   7.187 -  by (rule a_group) (auto simp: m_inv_def a_inv_def)
   7.188 +        add: group "(add_monoid G)"
   7.189 +  rewrites "carrier (add_monoid G) = carrier G"
   7.190 +       and "mult    (add_monoid G) = add G"
   7.191 +       and "one     (add_monoid G) = zero G"
   7.192 +       and "m_inv   (add_monoid G) = a_inv G"
   7.193 +       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
   7.194 +  by (rule a_group) (auto simp: m_inv_def a_inv_def add_pow_def)
   7.195  
   7.196  context abelian_group
   7.197  begin
   7.198 @@ -194,13 +220,14 @@
   7.199  end
   7.200  
   7.201  sublocale abelian_group <
   7.202 -  add: comm_group "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.203 -  rewrites "carrier \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = carrier G"
   7.204 -    and "mult \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = add G"
   7.205 -    and "one \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = zero G"
   7.206 -    and "m_inv \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = a_inv G"
   7.207 -    and "finprod \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr> = finsum G"
   7.208 -  by (rule a_comm_group) (auto simp: m_inv_def a_inv_def finsum_def)
   7.209 +   add: comm_group "(add_monoid G)"
   7.210 +  rewrites "carrier (add_monoid G) = carrier G"
   7.211 +       and "mult    (add_monoid G) = add G"
   7.212 +       and "one     (add_monoid G) = zero G"
   7.213 +       and "m_inv   (add_monoid G) = a_inv G"
   7.214 +       and "finprod (add_monoid G) = finsum G"
   7.215 +       and "pow     (add_monoid G) = (\<lambda>a k. add_pow G k a)"
   7.216 +  by (rule a_comm_group) (auto simp: m_inv_def a_inv_def finsum_def add_pow_def)
   7.217  
   7.218  lemmas (in abelian_group) minus_add = add.inv_mult
   7.219   
   7.220 @@ -208,10 +235,10 @@
   7.221  
   7.222  lemma comm_group_abelian_groupI:
   7.223    fixes G (structure)
   7.224 -  assumes cg: "comm_group \<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.225 +  assumes cg: "comm_group (add_monoid G)"
   7.226    shows "abelian_group G"
   7.227  proof -
   7.228 -  interpret comm_group "\<lparr>carrier = carrier G, mult = add G, one = zero G\<rparr>"
   7.229 +  interpret comm_group "(add_monoid G)"
   7.230      by (rule cg)
   7.231    show "abelian_group G" ..
   7.232  qed
   7.233 @@ -219,26 +246,21 @@
   7.234  
   7.235  subsection \<open>Rings: Basic Definitions\<close>
   7.236  
   7.237 -locale semiring = abelian_monoid R + monoid R for R (structure) +
   7.238 -  assumes l_distr: "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
   7.239 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
   7.240 -    and r_distr: "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
   7.241 -      ==> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
   7.242 -    and l_null[simp]: "x \<in> carrier R ==> \<zero> \<otimes> x = \<zero>"
   7.243 -    and r_null[simp]: "x \<in> carrier R ==> x \<otimes> \<zero> = \<zero>"
   7.244 +locale semiring = abelian_monoid (* for add *) R + monoid (* for mult *) R for R (structure) +
   7.245 +  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"
   7.246 +      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"
   7.247 +      and l_null[simp]: "x \<in> carrier R \<Longrightarrow> \<zero> \<otimes> x = \<zero>"
   7.248 +      and r_null[simp]: "x \<in> carrier R \<Longrightarrow> x \<otimes> \<zero> = \<zero>"
   7.249  
   7.250 -locale ring = abelian_group R + monoid R for R (structure) +
   7.251 -  assumes "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
   7.252 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
   7.253 -    and "[| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
   7.254 -      ==> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
   7.255 +locale ring = abelian_group (* for add *) R + monoid (* for mult *) R for R (structure) +
   7.256 +  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"
   7.257 +      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"
   7.258  
   7.259 -locale cring = ring + comm_monoid R
   7.260 +locale cring = ring + comm_monoid (* for mult *) R
   7.261  
   7.262  locale "domain" = cring +
   7.263    assumes one_not_zero [simp]: "\<one> \<noteq> \<zero>"
   7.264 -    and integral: "[| a \<otimes> b = \<zero>; a \<in> carrier R; b \<in> carrier R |] ==>
   7.265 -                  a = \<zero> \<or> b = \<zero>"
   7.266 +      and integral: "\<lbrakk> a \<otimes> b = \<zero>; a \<in> carrier R; b \<in> carrier R \<rbrakk> \<Longrightarrow> a = \<zero> \<or> b = \<zero>"
   7.267  
   7.268  locale field = "domain" +
   7.269    assumes field_Units: "Units R = carrier R - {\<zero>}"
   7.270 @@ -248,16 +270,23 @@
   7.271  
   7.272  lemma ringI:
   7.273    fixes R (structure)
   7.274 -  assumes abelian_group: "abelian_group R"
   7.275 -    and monoid: "monoid R"
   7.276 -    and l_distr: "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
   7.277 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
   7.278 -    and r_distr: "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
   7.279 -      ==> z \<otimes> (x \<oplus> y) = z \<otimes> x \<oplus> z \<otimes> y"
   7.280 +  assumes "abelian_group R"
   7.281 +      and "monoid R"
   7.282 +      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"
   7.283 +      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"
   7.284    shows "ring R"
   7.285    by (auto intro: ring.intro
   7.286      abelian_group.axioms ring_axioms.intro assms)
   7.287  
   7.288 +lemma ringE:
   7.289 +  fixes R (structure)
   7.290 +  assumes "ring R"
   7.291 +  shows "abelian_group R"
   7.292 +    and "monoid R"
   7.293 +    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"
   7.294 +    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"
   7.295 +  using assms unfolding ring_def ring_axioms_def by auto
   7.296 +
   7.297  context ring begin
   7.298  
   7.299  lemma is_abelian_group: "abelian_group R" ..
   7.300 @@ -269,15 +298,15 @@
   7.301    by (rule ring_axioms)
   7.302  
   7.303  end
   7.304 -
   7.305 +thm monoid_record_simps
   7.306  lemmas ring_record_simps = monoid_record_simps ring.simps
   7.307  
   7.308  lemma cringI:
   7.309    fixes R (structure)
   7.310    assumes abelian_group: "abelian_group R"
   7.311      and comm_monoid: "comm_monoid R"
   7.312 -    and l_distr: "!!x y z. [| x \<in> carrier R; y \<in> carrier R; z \<in> carrier R |]
   7.313 -      ==> (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
   7.314 +    and l_distr: "\<And>x y z. \<lbrakk> x \<in> carrier R; y \<in> carrier R; z \<in> carrier R \<rbrakk> \<Longrightarrow>
   7.315 +                            (x \<oplus> y) \<otimes> z = x \<otimes> z \<oplus> y \<otimes> z"
   7.316    shows "cring R"
   7.317  proof (intro cring.intro ring.intro)
   7.318    show "ring_axioms R"
   7.319 @@ -300,20 +329,35 @@
   7.320  qed (auto intro: cring.intro
   7.321    abelian_group.axioms comm_monoid.axioms ring_axioms.intro assms)
   7.322  
   7.323 +lemma cringE:
   7.324 +  fixes R (structure)
   7.325 +  assumes "cring R"
   7.326 +  shows "comm_monoid R"
   7.327 +    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"
   7.328 +  using assms cring_def apply auto by (simp add: assms cring.axioms(1) ringE(3))
   7.329 +
   7.330  (*
   7.331  lemma (in cring) is_comm_monoid:
   7.332    "comm_monoid R"
   7.333    by (auto intro!: comm_monoidI m_assoc m_comm)
   7.334  *)
   7.335 -
   7.336  lemma (in cring) is_cring:
   7.337    "cring R" by (rule cring_axioms)
   7.338  
   7.339  
   7.340  subsubsection \<open>Normaliser for Rings\<close>
   7.341  
   7.342 +lemma (in abelian_group) r_neg1:
   7.343 +  "\<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> (\<ominus> x) \<oplus> (x \<oplus> y) = y"
   7.344 +proof -
   7.345 +  assume G: "x \<in> carrier G" "y \<in> carrier G"
   7.346 +  then have "(\<ominus> x \<oplus> x) \<oplus> y = y" 
   7.347 +    by (simp only: l_neg l_zero)
   7.348 +  with G show ?thesis by (simp add: a_ac)
   7.349 +qed
   7.350 +
   7.351  lemma (in abelian_group) r_neg2:
   7.352 -  "[| x \<in> carrier G; y \<in> carrier G |] ==> x \<oplus> (\<ominus> x \<oplus> y) = y"
   7.353 +  "\<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<oplus> ((\<ominus> x) \<oplus> y) = y"
   7.354  proof -
   7.355    assume G: "x \<in> carrier G" "y \<in> carrier G"
   7.356    then have "(x \<oplus> \<ominus> x) \<oplus> y = y"
   7.357 @@ -322,15 +366,6 @@
   7.358      by (simp add: a_ac)
   7.359  qed
   7.360  
   7.361 -lemma (in abelian_group) r_neg1:
   7.362 -  "[| x \<in> carrier G; y \<in> carrier G |] ==> \<ominus> x \<oplus> (x \<oplus> y) = y"
   7.363 -proof -
   7.364 -  assume G: "x \<in> carrier G" "y \<in> carrier G"
   7.365 -  then have "(\<ominus> x \<oplus> x) \<oplus> y = y" 
   7.366 -    by (simp only: l_neg l_zero)
   7.367 -  with G show ?thesis by (simp add: a_ac)
   7.368 -qed
   7.369 -
   7.370  context ring begin
   7.371  
   7.372  text \<open>
   7.373 @@ -358,7 +393,7 @@
   7.374  qed
   7.375  
   7.376  lemma l_minus:
   7.377 -  "[| x \<in> carrier R; y \<in> carrier R |] ==> \<ominus> x \<otimes> y = \<ominus> (x \<otimes> y)"
   7.378 +  "\<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> (\<ominus> x) \<otimes> y = \<ominus> (x \<otimes> y)"
   7.379  proof -
   7.380    assume R: "x \<in> carrier R" "y \<in> carrier R"
   7.381    then have "(\<ominus> x) \<otimes> y \<oplus> x \<otimes> y = (\<ominus> x \<oplus> x) \<otimes> y" by (simp add: l_distr)
   7.382 @@ -369,7 +404,7 @@
   7.383  qed
   7.384  
   7.385  lemma r_minus:
   7.386 -  "[| x \<in> carrier R; y \<in> carrier R |] ==> x \<otimes> \<ominus> y = \<ominus> (x \<otimes> y)"
   7.387 +  "\<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> x \<otimes> (\<ominus> y) = \<ominus> (x \<otimes> y)"
   7.388  proof -
   7.389    assume R: "x \<in> carrier R" "y \<in> carrier R"
   7.390    then have "x \<otimes> (\<ominus> y) \<oplus> x \<otimes> y = x \<otimes> (\<ominus> y \<oplus> y)" by (simp add: r_distr)
   7.391 @@ -382,12 +417,13 @@
   7.392  end
   7.393  
   7.394  lemma (in abelian_group) minus_eq:
   7.395 -  "[| x \<in> carrier G; y \<in> carrier G |] ==> x \<ominus> y = x \<oplus> \<ominus> y"
   7.396 +  "\<lbrakk> x \<in> carrier G; y \<in> carrier G \<rbrakk> \<Longrightarrow> x \<ominus> y = x \<oplus> (\<ominus> y)"
   7.397    by (simp only: a_minus_def)
   7.398  
   7.399  text \<open>Setup algebra method:
   7.400    compute distributive normal form in locale contexts\<close>
   7.401  
   7.402 +
   7.403  ML_file "ringsimp.ML"
   7.404  
   7.405  attribute_setup algebra = \<open>
   7.406 @@ -467,7 +503,7 @@
   7.407    fixes R (structure) and S (structure)
   7.408    assumes "ring R" "cring S"
   7.409    assumes RS: "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier S" "d \<in> carrier S"
   7.410 -  shows "a \<oplus> \<ominus> (a \<oplus> \<ominus> b) = b \<and> c \<otimes>\<^bsub>S\<^esub> d = d \<otimes>\<^bsub>S\<^esub> c"
   7.411 +  shows "a \<oplus> (\<ominus> (a \<oplus> (\<ominus> b))) = b \<and> c \<otimes>\<^bsub>S\<^esub> d = d \<otimes>\<^bsub>S\<^esub> c"
   7.412  proof -
   7.413    interpret ring R by fact
   7.414    interpret cring S by fact
   7.415 @@ -488,8 +524,8 @@
   7.416  subsubsection \<open>Sums over Finite Sets\<close>
   7.417  
   7.418  lemma (in semiring) finsum_ldistr:
   7.419 -  "[| finite A; a \<in> carrier R; f \<in> A \<rightarrow> carrier R |] ==>
   7.420 -   finsum R f A \<otimes> a = finsum R (%i. f i \<otimes> a) A"
   7.421 +  "\<lbrakk> finite A; a \<in> carrier R; f: A \<rightarrow> carrier R \<rbrakk> \<Longrightarrow>
   7.422 +    (\<Oplus> i \<in> A. (f i)) \<otimes> a = (\<Oplus> i \<in> A. ((f i) \<otimes> a))"
   7.423  proof (induct set: finite)
   7.424    case empty then show ?case by simp
   7.425  next
   7.426 @@ -497,25 +533,87 @@
   7.427  qed
   7.428  
   7.429  lemma (in semiring) finsum_rdistr:
   7.430 -  "[| finite A; a \<in> carrier R; f \<in> A \<rightarrow> carrier R |] ==>
   7.431 -   a \<otimes> finsum R f A = finsum R (%i. a \<otimes> f i) A"
   7.432 +  "\<lbrakk> finite A; a \<in> carrier R; f: A \<rightarrow> carrier R \<rbrakk> \<Longrightarrow>
   7.433 +   a \<otimes> (\<Oplus> i \<in> A. (f i)) = (\<Oplus> i \<in> A. (a \<otimes> (f i)))"
   7.434  proof (induct set: finite)
   7.435    case empty then show ?case by simp
   7.436  next
   7.437    case (insert x F) then show ?case by (simp add: Pi_def r_distr)
   7.438  qed
   7.439  
   7.440 +(* ************************************************************************** *)
   7.441 +(* Contributed by Paulo E. de Vilhena.                                        *)
   7.442 +
   7.443 +text \<open>A quick detour\<close>
   7.444 +
   7.445 +lemma add_pow_int_ge: "(k :: int) \<ge> 0 \<Longrightarrow> [ k ] \<cdot>\<^bsub>R\<^esub> a = [ nat k ] \<cdot>\<^bsub>R\<^esub> a"
   7.446 +  by (simp add: add_pow_def int_pow_def nat_pow_def)
   7.447 +
   7.448 +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)"
   7.449 +  by (simp add: int_pow_def nat_pow_def a_inv_def add_pow_def) 
   7.450 +
   7.451 +corollary (in semiring) add_pow_ldistr:
   7.452 +  assumes "a \<in> carrier R" "b \<in> carrier R"
   7.453 +  shows "([(k :: nat)] \<cdot> a) \<otimes> b = [k] \<cdot> (a \<otimes> b)"
   7.454 +proof -
   7.455 +  have "([k] \<cdot> a) \<otimes> b = (\<Oplus> i \<in> {..< k}. a) \<otimes> b"
   7.456 +    using add.finprod_const[OF assms(1), of "{..<k}"] by simp
   7.457 +  also have " ... = (\<Oplus> i \<in> {..< k}. (a \<otimes> b))"
   7.458 +    using finsum_ldistr[of "{..<k}" b "\<lambda>x. a"] assms by simp
   7.459 +  also have " ... = [k] \<cdot> (a \<otimes> b)"
   7.460 +    using add.finprod_const[of "a \<otimes> b" "{..<k}"] assms by simp
   7.461 +  finally show ?thesis .
   7.462 +qed
   7.463 +
   7.464 +corollary (in semiring) add_pow_rdistr:
   7.465 +  assumes "a \<in> carrier R" "b \<in> carrier R"
   7.466 +  shows "a \<otimes> ([(k :: nat)] \<cdot> b) = [k] \<cdot> (a \<otimes> b)"
   7.467 +proof -
   7.468 +  have "a \<otimes> ([k] \<cdot> b) = a \<otimes> (\<Oplus> i \<in> {..< k}. b)"
   7.469 +    using add.finprod_const[OF assms(2), of "{..<k}"] by simp
   7.470 +  also have " ... = (\<Oplus> i \<in> {..< k}. (a \<otimes> b))"
   7.471 +    using finsum_rdistr[of "{..<k}" a "\<lambda>x. b"] assms by simp
   7.472 +  also have " ... = [k] \<cdot> (a \<otimes> b)"
   7.473 +    using add.finprod_const[of "a \<otimes> b" "{..<k}"] assms by simp
   7.474 +  finally show ?thesis .
   7.475 +qed 
   7.476 +
   7.477 +(* For integers, we need the uniqueness of the additive inverse *)
   7.478 +lemma (in ring) add_pow_ldistr_int:
   7.479 +  assumes "a \<in> carrier R" "b \<in> carrier R"
   7.480 +  shows "([(k :: int)] \<cdot> a) \<otimes> b = [k] \<cdot> (a \<otimes> b)"
   7.481 +proof (cases "k \<ge> 0")
   7.482 +  case True thus ?thesis
   7.483 +    using add_pow_int_ge[of k R] add_pow_ldistr[OF assms] by auto
   7.484 +next
   7.485 +  case False thus ?thesis
   7.486 +    using add_pow_int_lt[of k R a] add_pow_int_lt[of k R "a \<otimes> b"]
   7.487 +          add_pow_ldistr[OF assms, of "nat (- k)"] assms l_minus by auto 
   7.488 +qed
   7.489 +
   7.490 +lemma (in ring) add_pow_rdistr_int:
   7.491 +  assumes "a \<in> carrier R" "b \<in> carrier R"
   7.492 +  shows "a \<otimes> ([(k :: int)] \<cdot> b) = [k] \<cdot> (a \<otimes> b)"
   7.493 +proof (cases "k \<ge> 0")
   7.494 +  case True thus ?thesis
   7.495 +    using add_pow_int_ge[of k R] add_pow_rdistr[OF assms] by auto
   7.496 +next
   7.497 +  case False thus ?thesis
   7.498 +    using add_pow_int_lt[of k R b] add_pow_int_lt[of k R "a \<otimes> b"]
   7.499 +          add_pow_rdistr[OF assms, of "nat (- k)"] assms r_minus by auto 
   7.500 +qed
   7.501 +(* ************************************************************************** *)
   7.502 +
   7.503  
   7.504  subsection \<open>Integral Domains\<close>
   7.505  
   7.506  context "domain" begin
   7.507  
   7.508 -lemma zero_not_one [simp]:
   7.509 -  "\<zero> \<noteq> \<one>"
   7.510 +lemma zero_not_one [simp]: "\<zero> \<noteq> \<one>"
   7.511    by (rule not_sym) simp
   7.512  
   7.513  lemma integral_iff: (* not by default a simp rule! *)
   7.514 -  "[| a \<in> carrier R; b \<in> carrier R |] ==> (a \<otimes> b = \<zero>) = (a = \<zero> \<or> b = \<zero>)"
   7.515 +  "\<lbrakk> a \<in> carrier R; b \<in> carrier R \<rbrakk> \<Longrightarrow> (a \<otimes> b = \<zero>) = (a = \<zero> \<or> b = \<zero>)"
   7.516  proof
   7.517    assume "a \<in> carrier R" "b \<in> carrier R" "a \<otimes> b = \<zero>"
   7.518    then show "a = \<zero> \<or> b = \<zero>" by (simp add: integral)
   7.519 @@ -556,6 +654,7 @@
   7.520  
   7.521  text \<open>Field would not need to be derived from domain, the properties
   7.522    for domain follow from the assumptions of field\<close>
   7.523 +
   7.524  lemma (in cring) cring_fieldI:
   7.525    assumes field_Units: "Units R = carrier R - {\<zero>}"
   7.526    shows "field R"
   7.527 @@ -614,49 +713,62 @@
   7.528  
   7.529  lemma ring_hom_memI:
   7.530    fixes R (structure) and S (structure)
   7.531 -  assumes hom_closed: "!!x. x \<in> carrier R ==> h x \<in> carrier S"
   7.532 -    and hom_mult: "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==>
   7.533 -      h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
   7.534 -    and hom_add: "!!x y. [| x \<in> carrier R; y \<in> carrier R |] ==>
   7.535 -      h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
   7.536 -    and hom_one: "h \<one> = \<one>\<^bsub>S\<^esub>"
   7.537 +  assumes "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
   7.538 +      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"
   7.539 +      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"
   7.540 +      and "h \<one> = \<one>\<^bsub>S\<^esub>"
   7.541    shows "h \<in> ring_hom R S"
   7.542    by (auto simp add: ring_hom_def assms Pi_def)
   7.543  
   7.544 +lemma ring_hom_memE:
   7.545 +  fixes R (structure) and S (structure)
   7.546 +  assumes "h \<in> ring_hom R S"
   7.547 +  shows "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
   7.548 +    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"
   7.549 +    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"
   7.550 +    and "h \<one> = \<one>\<^bsub>S\<^esub>"
   7.551 +  using assms unfolding ring_hom_def by auto
   7.552 +
   7.553  lemma ring_hom_closed:
   7.554 -  "[| h \<in> ring_hom R S; x \<in> carrier R |] ==> h x \<in> carrier S"
   7.555 +  "\<lbrakk> h \<in> ring_hom R S; x \<in> carrier R \<rbrakk> \<Longrightarrow> h x \<in> carrier S"
   7.556    by (auto simp add: ring_hom_def funcset_mem)
   7.557  
   7.558  lemma ring_hom_mult:
   7.559    fixes R (structure) and S (structure)
   7.560 -  shows
   7.561 -    "[| h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R |] ==>
   7.562 -    h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
   7.563 +  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"
   7.564      by (simp add: ring_hom_def)
   7.565  
   7.566  lemma ring_hom_add:
   7.567    fixes R (structure) and S (structure)
   7.568 -  shows
   7.569 -    "[| h \<in> ring_hom R S; x \<in> carrier R; y \<in> carrier R |] ==>
   7.570 -    h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
   7.571 +  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"
   7.572      by (simp add: ring_hom_def)
   7.573  
   7.574  lemma ring_hom_one:
   7.575    fixes R (structure) and S (structure)
   7.576 -  shows "h \<in> ring_hom R S ==> h \<one> = \<one>\<^bsub>S\<^esub>"
   7.577 +  shows "h \<in> ring_hom R S \<Longrightarrow> h \<one> = \<one>\<^bsub>S\<^esub>"
   7.578    by (simp add: ring_hom_def)
   7.579  
   7.580 -locale ring_hom_cring = R?: cring R + S?: cring S
   7.581 -    for R (structure) and S (structure) +
   7.582 -  fixes h
   7.583 +lemma ring_hom_zero:
   7.584 +  fixes R (structure) and S (structure)
   7.585 +  assumes "h \<in> ring_hom R S" "ring R" "ring S"
   7.586 +  shows "h \<zero> = \<zero>\<^bsub>S\<^esub>"
   7.587 +proof -
   7.588 +  have "h \<zero> = h \<zero> \<oplus>\<^bsub>S\<^esub> h \<zero>"
   7.589 +    using ring_hom_add[OF assms(1), of \<zero> \<zero>] assms(2)
   7.590 +    by (simp add: ring.ring_simprules(2) ring.ring_simprules(15))
   7.591 +  thus ?thesis
   7.592 +    by (metis abelian_group.l_neg assms ring.is_abelian_group ring.ring_simprules(18) ring.ring_simprules(2) ring_hom_closed)
   7.593 +qed
   7.594 +
   7.595 +locale ring_hom_cring =
   7.596 +  R?: cring R + S?: cring S for R (structure) and S (structure) + fixes h
   7.597    assumes homh [simp, intro]: "h \<in> ring_hom R S"
   7.598    notes hom_closed [simp, intro] = ring_hom_closed [OF homh]
   7.599      and hom_mult [simp] = ring_hom_mult [OF homh]
   7.600      and hom_add [simp] = ring_hom_add [OF homh]
   7.601      and hom_one [simp] = ring_hom_one [OF homh]
   7.602  
   7.603 -lemma (in ring_hom_cring) hom_zero [simp]:
   7.604 -  "h \<zero> = \<zero>\<^bsub>S\<^esub>"
   7.605 +lemma (in ring_hom_cring) hom_zero [simp]: "h \<zero> = \<zero>\<^bsub>S\<^esub>"
   7.606  proof -
   7.607    have "h \<zero> \<oplus>\<^bsub>S\<^esub> h \<zero> = h \<zero> \<oplus>\<^bsub>S\<^esub> \<zero>\<^bsub>S\<^esub>"
   7.608      by (simp add: hom_add [symmetric] del: hom_add)
   7.609 @@ -664,7 +776,7 @@
   7.610  qed
   7.611  
   7.612  lemma (in ring_hom_cring) hom_a_inv [simp]:
   7.613 -  "x \<in> carrier R ==> h (\<ominus> x) = \<ominus>\<^bsub>S\<^esub> h x"
   7.614 +  "x \<in> carrier R \<Longrightarrow> h (\<ominus> x) = \<ominus>\<^bsub>S\<^esub> h x"
   7.615  proof -
   7.616    assume R: "x \<in> carrier R"
   7.617    then have "h x \<oplus>\<^bsub>S\<^esub> h (\<ominus> x) = h x \<oplus>\<^bsub>S\<^esub> (\<ominus>\<^bsub>S\<^esub> h x)"
   7.618 @@ -673,19 +785,24 @@
   7.619  qed
   7.620  
   7.621  lemma (in ring_hom_cring) hom_finsum [simp]:
   7.622 -  "f \<in> A \<rightarrow> carrier R \<Longrightarrow>
   7.623 -  h (finsum R f A) = finsum S (h \<circ> f) A"
   7.624 -  by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
   7.625 +  assumes "f: A \<rightarrow> carrier R"
   7.626 +  shows "h (\<Oplus> i \<in> A. f i) = (\<Oplus>\<^bsub>S\<^esub> i \<in> A. (h o f) i)"
   7.627 +  using assms by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
   7.628  
   7.629  lemma (in ring_hom_cring) hom_finprod:
   7.630 -  "f \<in> A \<rightarrow> carrier R \<Longrightarrow>
   7.631 -  h (finprod R f A) = finprod S (h \<circ> f) A"
   7.632 -  by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
   7.633 +  assumes "f: A \<rightarrow> carrier R"
   7.634 +  shows "h (\<Otimes> i \<in> A. f i) = (\<Otimes>\<^bsub>S\<^esub> i \<in> A. (h o f) i)"
   7.635 +  using assms by (induct A rule: infinite_finite_induct, auto simp: Pi_def)
   7.636  
   7.637  declare ring_hom_cring.hom_finprod [simp]
   7.638  
   7.639 -lemma id_ring_hom [simp]:
   7.640 -  "id \<in> ring_hom R R"
   7.641 +lemma id_ring_hom [simp]: "id \<in> ring_hom R R"
   7.642    by (auto intro!: ring_hom_memI)
   7.643  
   7.644 +(* Next lemma contributed by Paulo Emílio de Vilhena. *)
   7.645 +
   7.646 +lemma ring_hom_trans:
   7.647 +  "\<lbrakk> f \<in> ring_hom R S; g \<in> ring_hom S T \<rbrakk> \<Longrightarrow> g \<circ> f \<in> ring_hom R T"
   7.648 +  by (rule ring_hom_memI) (auto simp add: ring_hom_closed ring_hom_mult ring_hom_add ring_hom_one)
   7.649 +
   7.650  end
     8.1 --- a/src/HOL/Algebra/Sylow.thy	Tue Jun 12 16:21:52 2018 +0200
     8.2 +++ b/src/HOL/Algebra/Sylow.thy	Tue Jun 12 16:09:12 2018 +0100
     8.3 @@ -189,7 +189,7 @@
     8.4    using rcosetGM1g_subset_G finite_G M1_subset_G cosets_finite rcosetsI by blast
     8.5  
     8.6  lemma M1_cardeq_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> card (M1 #> g) = card M1"
     8.7 -  by (simp add: card_cosets_equal rcosetsI)
     8.8 +  by (metis M1_subset_G card_rcosets_equal rcosetsI)
     8.9  
    8.10  lemma M1_RelM_rcosetGM1g: "g \<in> carrier G \<Longrightarrow> (M1, M1 #> g) \<in> RelM"
    8.11    apply (simp add: RelM_def calM_def card_M1)
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/HOL/Algebra/Zassenhaus.thy	Tue Jun 12 16:09:12 2018 +0100
     9.3 @@ -0,0 +1,846 @@
     9.4 +theory Zassenhaus
     9.5 +  imports Coset Group_Action
     9.6 +begin
     9.7 +
     9.8 +subsection "fundamental lemmas"
     9.9 +
    9.10 +
    9.11 +text "Lemmas about subgroups"
    9.12 +
    9.13 +
    9.14 +(*A subgroup included in another subgroup is a subgroup of the subgroup*)
    9.15 +lemma (in group) subgroup_incl :
    9.16 +  assumes "subgroup I G"
    9.17 +    and "subgroup J G"
    9.18 +    and "I\<subseteq>J"
    9.19 +  shows "subgroup I (G\<lparr>carrier:=J\<rparr>)"using assms subgroup_inv_equality
    9.20 +  by (auto simp add: subgroup_def)
    9.21 +
    9.22 +(*A subgroup of a subgroup is a subgroup of the group*)
    9.23 +lemma (in group) incl_subgroup :
    9.24 +  assumes "subgroup J G"
    9.25 +    and "subgroup I (G\<lparr>carrier:=J\<rparr>)"
    9.26 +  shows "subgroup I G" unfolding subgroup_def
    9.27 +proof
    9.28 +  have H1: "I \<subseteq> carrier (G\<lparr>carrier:=J\<rparr>)" using assms(2) subgroup_imp_subset by blast
    9.29 +  also have H2: "...\<subseteq>J" by simp
    9.30 +  also  have "...\<subseteq>(carrier G)"  by (simp add: assms(1) subgroup_imp_subset)
    9.31 +  finally have H: "I \<subseteq> carrier G" by simp
    9.32 +  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)
    9.33 +  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
    9.34 +  have K: "\<one> \<in> I" using assms(2) by (auto simp add: subgroup_def)
    9.35 +  have "(\<And>x. x \<in> I \<Longrightarrow> inv x \<in> I)" using assms  subgroup.m_inv_closed H
    9.36 +    by (metis H1 H2  subgroup_inv_equality subsetCE)
    9.37 +  thus "\<one> \<in> I \<and> (\<forall>x. x \<in> I \<longrightarrow> inv x \<in> I)" using K by blast
    9.38 +qed
    9.39 +
    9.40 +
    9.41 +text "Lemmas about set_mult"
    9.42 +
    9.43 +
    9.44 +lemma (in group) set_mult_same_law :
    9.45 +  assumes "subgroup H G"
    9.46 +and "K1 \<subseteq> H"
    9.47 +and "K2 \<subseteq> H"
    9.48 +shows "K1<#>\<^bsub>(G\<lparr>carrier:=H\<rparr>)\<^esub>K2 = K1<#>K2"
    9.49 +proof 
    9.50 +  show "K1 <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> K2 \<subseteq> K1 <#> K2"
    9.51 +  proof
    9.52 +    fix h assume Hyph : "h\<in>K1<#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub>K2"
    9.53 +    then obtain k1 k2 where Hyp : "k1\<in>K1 \<and> k2\<in>K2 \<and> k1\<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub>k2 = h"
    9.54 +      unfolding set_mult_def by blast
    9.55 +    hence "k1\<in>H" using assms by blast
    9.56 +    moreover have  "k2\<in>H" using Hyp assms by blast
    9.57 +    ultimately have EGAL : "k1 \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> k2 = k1 \<otimes>\<^bsub>G\<^esub> k2" by simp
    9.58 +    have "k1 \<otimes>\<^bsub>G\<^esub> k2 \<in> K1<#>K2" unfolding  set_mult_def using Hyp by blast
    9.59 +    hence "k1 \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> k2 \<in> K1<#>K2" using EGAL by auto
    9.60 +    thus "h \<in> K1<#>K2 " using Hyp by blast
    9.61 +  qed
    9.62 +  show "K1 <#> K2 \<subseteq> K1 <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> K2"
    9.63 +  proof
    9.64 +    fix h assume Hyph : "h\<in>K1<#>K2"
    9.65 +    then obtain k1 k2 where Hyp : "k1\<in>K1 \<and> k2\<in>K2 \<and> k1\<otimes>k2 = h" unfolding set_mult_def by blast
    9.66 +    hence k1H: "k1\<in>H" using assms by blast
    9.67 +    have  k2H: "k2\<in>H" using Hyp assms by blast
    9.68 +    have EGAL : "k1 \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> k2 = k1 \<otimes>\<^bsub>G\<^esub> k2" using k1H k2H by simp
    9.69 +    have "k1 \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> k2 \<in> K1<#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub>K2" unfolding  set_mult_def using Hyp by blast
    9.70 +    hence "k1 \<otimes> k2 \<in> K1<#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub>K2" using EGAL by auto
    9.71 +    thus "h \<in> K1<#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub>K2 " using Hyp by blast
    9.72 +  qed
    9.73 +qed
    9.74 +
    9.75 +
    9.76 +(*A group multiplied by a subgroup stays the same*)
    9.77 +lemma (in group) set_mult_carrier_idem :
    9.78 +  assumes "subgroup H G"
    9.79 +  shows "(carrier G)<#>H = carrier G"
    9.80 +proof
    9.81 +  show "(carrier G)<#>H \<subseteq> carrier G" unfolding set_mult_def using subgroup_imp_subset assms by blast
    9.82 +next
    9.83 +  have " (carrier G) #>  \<one> = carrier G" unfolding set_mult_def r_coset_def group_axioms by simp
    9.84 +  moreover have "(carrier G) #>  \<one> \<subseteq> (carrier G) <#> H" unfolding set_mult_def r_coset_def
    9.85 +    using assms subgroup.one_closed[OF assms] by blast
    9.86 +  ultimately show "carrier G \<subseteq> (carrier G) <#> H" by simp
    9.87 +qed
    9.88 +
    9.89 +(*Same lemma as above, but everything is included in a subgroup*)
    9.90 +lemma (in group) set_mult_subgroup_idem :
    9.91 +  assumes "subgroup H G"
    9.92 +    and "subgroup N (G\<lparr>carrier:=H\<rparr>)"
    9.93 +  shows "H<#>N = H"
    9.94 +  using group.set_mult_carrier_idem[OF subgroup_imp_group] subgroup_imp_subset assms
    9.95 +  by (metis monoid.cases_scheme order_refl partial_object.simps(1)
    9.96 +      partial_object.update_convs(1) set_mult_same_law)
    9.97 +
    9.98 +(*A normal subgroup is commutative with set_mult*)
    9.99 +lemma (in group) commut_normal :
   9.100 +  assumes "subgroup H G"
   9.101 +    and "N\<lhd>G"
   9.102 +  shows "H<#>N = N<#>H" 
   9.103 +proof-
   9.104 +  have aux1 : "{H <#> N} = {\<Union>h\<in>H. h <# N }" unfolding set_mult_def l_coset_def by auto
   9.105 +  also have "... = {\<Union>h\<in>H. N #> h }" using assms normal.coset_eq subgroup.mem_carrier by fastforce
   9.106 +  moreover have aux2 : "{N <#> H} = {\<Union>h\<in>H. N #> h }"unfolding set_mult_def r_coset_def by auto
   9.107 +  ultimately show "H<#>N = N<#>H" by simp
   9.108 +qed
   9.109 +
   9.110 +(*Same lemma as above, but everything is included in a subgroup*)
   9.111 +lemma (in group) commut_normal_subgroup :
   9.112 +  assumes "subgroup H G"
   9.113 +    and "N\<lhd>(G\<lparr>carrier:=H\<rparr>)"
   9.114 +    and "subgroup K (G\<lparr>carrier:=H\<rparr>)"
   9.115 +  shows "K<#>N = N<#>K"
   9.116 +proof-
   9.117 +  have "N \<subseteq> carrier (G\<lparr>carrier := H\<rparr>)" using assms normal_imp_subgroup subgroup_imp_subset by blast
   9.118 +  hence NH : "N \<subseteq> H" by simp
   9.119 +  have "K \<subseteq> carrier(G\<lparr>carrier := H\<rparr>)" using subgroup_imp_subset assms by blast
   9.120 +  hence KH : "K \<subseteq> H" by simp
   9.121 +  have Egal : "K <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N = N <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> K"
   9.122 +  using group.commut_normal[where ?G = "G\<lparr>carrier :=H\<rparr>", of K N,OF subgroup_imp_group[OF assms(1)]
   9.123 +               assms(3) assms(2)] by auto
   9.124 +  also have "... = N <#> K" using set_mult_same_law[of H N K, OF assms(1) NH KH] by auto
   9.125 +  moreover have "K <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N = K <#> N"
   9.126 +    using set_mult_same_law[of H K N, OF assms(1) KH NH] by auto
   9.127 +  ultimately show "K<#>N = N<#>K" by auto
   9.128 +qed
   9.129 +
   9.130 +
   9.131 +
   9.132 +text "Lemmas about intersection and normal subgroups"
   9.133 +
   9.134 +
   9.135 +
   9.136 +lemma (in group) normal_inter:
   9.137 +  assumes "subgroup H G"
   9.138 +    and "subgroup K G"
   9.139 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>"
   9.140 +  shows " (H1\<inter>K)\<lhd>(G\<lparr>carrier:= (H\<inter>K)\<rparr>)" 
   9.141 +proof-
   9.142 +  define HK and H1K and GH and GHK
   9.143 +    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>)"
   9.144 +  show "H1K\<lhd>GHK"
   9.145 +  proof (intro group.normal_invI[of GHK H1K])
   9.146 +    show "Group.group GHK"
   9.147 +      using GHK_def subgroups_Inter_pair subgroup_imp_group assms by blast
   9.148 +
   9.149 +  next
   9.150 +    have  H1K_incl:"subgroup H1K (G\<lparr>carrier:= (H\<inter>K)\<rparr>)"
   9.151 +    proof(intro subgroup_incl)
   9.152 +          show "subgroup H1K G"
   9.153 +            using assms normal_imp_subgroup subgroups_Inter_pair incl_subgroup H1K_def by blast
   9.154 +        next
   9.155 +          show "subgroup (H\<inter>K) G" using HK_def subgroups_Inter_pair assms by auto
   9.156 +        next
   9.157 +          have "H1 \<subseteq> (carrier (G\<lparr>carrier:=H\<rparr>))" 
   9.158 +            using  assms(3) normal_imp_subgroup subgroup_imp_subset by blast
   9.159 +          also have "... \<subseteq> H" by simp
   9.160 +          thus "H1K \<subseteq>H\<inter>K" 
   9.161 +            using H1K_def calculation by auto
   9.162 +        qed
   9.163 +        thus "subgroup H1K GHK" using GHK_def by simp
   9.164 +
   9.165 +  next
   9.166 +    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"
   9.167 +        proof-
   9.168 +          have invHK: "\<lbrakk>y\<in>HK\<rbrakk> \<Longrightarrow> inv\<^bsub>GHK\<^esub> y = inv\<^bsub>GH\<^esub> y"
   9.169 +            using subgroup_inv_equality assms HK_def GH_def GHK_def subgroups_Inter_pair by simp
   9.170 +          have multHK : "\<lbrakk>x\<in>HK;y\<in>HK\<rbrakk> \<Longrightarrow>  x \<otimes>\<^bsub>(G\<lparr>carrier:=HK\<rparr>)\<^esub> y =  x \<otimes> y"
   9.171 +            using HK_def by simp
   9.172 +          fix x assume p: "x\<in>carrier GHK"
   9.173 +            fix h assume p2 : "h:H1K"
   9.174 +            have "carrier(GHK)\<subseteq>HK"
   9.175 +              using GHK_def HK_def by simp
   9.176 +            hence xHK:"x\<in>HK" using p by auto
   9.177 +            hence invx:"inv\<^bsub>GHK\<^esub> x = inv\<^bsub>GH\<^esub> x"
   9.178 +              using invHK assms GHK_def HK_def GH_def subgroup_inv_equality subgroups_Inter_pair by simp
   9.179 +            have "H1\<subseteq>carrier(GH)"
   9.180 +              using assms GH_def normal_imp_subgroup subgroup_imp_subset by blast
   9.181 +            hence hHK:"h\<in>HK" 
   9.182 +              using p2 H1K_def HK_def GH_def by auto
   9.183 +            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"
   9.184 +              using invx invHK multHK GHK_def GH_def by auto
   9.185 +            have xH:"x\<in>carrier(GH)" 
   9.186 +              using xHK HK_def GH_def by auto 
   9.187 +            have hH:"h\<in>carrier(GH)"
   9.188 +              using hHK HK_def GH_def by auto 
   9.189 +            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)"
   9.190 +              using assms normal_invE GH_def normal.inv_op_closed2 by fastforce
   9.191 +            hence INCL_1 : "x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> H1"
   9.192 +              using  xH H1K_def p2 by blast
   9.193 +            have " x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> HK"
   9.194 +              using assms HK_def subgroups_Inter_pair hHK xHK
   9.195 +              by (metis GH_def inf.cobounded1 subgroup_def subgroup_incl)
   9.196 +            hence " x \<otimes>\<^bsub>GH\<^esub> h \<otimes>\<^bsub>GH\<^esub> inv\<^bsub>GH\<^esub> x \<in> K" using HK_def by simp
   9.197 +            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
   9.198 +            thus  "x \<otimes>\<^bsub>GHK\<^esub> h \<otimes>\<^bsub>GHK\<^esub> inv\<^bsub>GHK\<^esub> x \<in> H1K" using xhx_egal by simp
   9.199 +          qed
   9.200 +    qed
   9.201 +qed
   9.202 +
   9.203 +
   9.204 +lemma (in group) normal_inter_subgroup :
   9.205 +  assumes "subgroup H G"
   9.206 +    and "N \<lhd> G"
   9.207 +  shows "(N\<inter>H) \<lhd> (G\<lparr>carrier := H\<rparr>)"
   9.208 +proof -
   9.209 +  define K where "K = carrier G"
   9.210 +  have "G\<lparr>carrier := K\<rparr> =  G" using K_def by auto
   9.211 +  moreover have "subgroup K G" using K_def subgroup_self by blast
   9.212 +  moreover have "normal N (G \<lparr>carrier :=K\<rparr>)" using assms K_def by simp
   9.213 +  ultimately have "N \<inter> H \<lhd> G\<lparr>carrier := K \<inter> H\<rparr>"
   9.214 +    using normal_inter[of K H N] assms(1) by blast
   9.215 +  moreover have "K \<inter> H = H" using K_def assms subgroup_imp_subset by blast
   9.216 +  ultimately show "normal (N\<inter>H) (G\<lparr>carrier := H\<rparr>)" by auto
   9.217 +qed
   9.218 +
   9.219 +
   9.220 +
   9.221 +text \<open>Lemmas about normalizer\<close>
   9.222 +
   9.223 +
   9.224 +lemma (in group) subgroup_in_normalizer: 
   9.225 +  assumes "subgroup H G"
   9.226 +  shows "normal H (G\<lparr>carrier:= (normalizer G H)\<rparr>)"
   9.227 +proof(intro group.normal_invI)
   9.228 +  show "Group.group (G\<lparr>carrier := normalizer G H\<rparr>)"
   9.229 +    by (simp add: assms group.normalizer_imp_subgroup is_group subgroup_imp_group subgroup_imp_subset)
   9.230 +  have K:"H \<subseteq> (normalizer G H)" unfolding normalizer_def
   9.231 +  proof
   9.232 +    fix x assume xH: "x \<in> H"
   9.233 +    from xH have xG : "x \<in> carrier G" using subgroup_imp_subset assms by auto
   9.234 +    have "x <# H = H"
   9.235 +      by (metis \<open>x \<in> H\<close> assms group.lcos_mult_one is_group
   9.236 +         l_repr_independence one_closed subgroup_imp_subset)
   9.237 +    moreover have "H #> inv x = H" 
   9.238 +      by (simp add: xH assms is_group subgroup.rcos_const subgroup.m_inv_closed)
   9.239 +    ultimately have "x <# H #> (inv x) = H" by simp
   9.240 +    thus " x \<in> stabilizer G (\<lambda>g. \<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) H"
   9.241 +      using assms xG subgroup_imp_subset unfolding stabilizer_def by auto
   9.242 +  qed
   9.243 +  thus "subgroup H (G\<lparr>carrier:= (normalizer G H)\<rparr>)"
   9.244 +    using subgroup_incl normalizer_imp_subgroup assms by (simp add: subgroup_imp_subset)
   9.245 +  show  " \<And>x h. x \<in> carrier (G\<lparr>carrier := normalizer G H\<rparr>) \<Longrightarrow> h \<in> H \<Longrightarrow>
   9.246 +             x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h
   9.247 +               \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x \<in> H"
   9.248 +    proof-
   9.249 +    fix x h assume xnorm : "x \<in> carrier (G\<lparr>carrier := normalizer G H\<rparr>)" and hH : "h \<in> H"
   9.250 +    have xnormalizer:"x \<in> normalizer G H" using xnorm by simp
   9.251 +    moreover have hnormalizer:"h \<in> normalizer G H" using hH K by auto
   9.252 +    ultimately have "x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h = x \<otimes> h" by simp
   9.253 +    moreover have " inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x =  inv x"
   9.254 +      using xnormalizer
   9.255 +      by (simp add: assms normalizer_imp_subgroup subgroup_imp_subset subgroup_inv_equality)
   9.256 +    ultimately  have xhxegal: "x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h
   9.257 +                \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x
   9.258 +                  = x \<otimes>h \<otimes> inv x"
   9.259 +      using  hnormalizer by simp
   9.260 +    have  "x \<otimes>h \<otimes> inv x \<in> (x <# H #> inv x)"
   9.261 +      unfolding l_coset_def r_coset_def using hH  by auto
   9.262 +    moreover have "x <# H #> inv x = H"
   9.263 +      using xnormalizer assms subgroup_imp_subset[OF assms]
   9.264 +      unfolding normalizer_def stabilizer_def by auto
   9.265 +    ultimately have "x \<otimes>h \<otimes> inv x \<in> H" by simp
   9.266 +    thus  " x \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> h
   9.267 +               \<otimes>\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> inv\<^bsub>G\<lparr>carrier := normalizer G H\<rparr>\<^esub> x \<in> H"
   9.268 +      using xhxegal hH xnorm by simp
   9.269 +  qed
   9.270 +qed
   9.271 +
   9.272 +
   9.273 +lemma (in group) normal_imp_subgroup_normalizer :
   9.274 +  assumes "subgroup H G"
   9.275 +and "N \<lhd> (G\<lparr>carrier := H\<rparr>)"
   9.276 +shows "subgroup H (G\<lparr>carrier := normalizer G N\<rparr>)" 
   9.277 +proof-
   9.278 +  have N_carrierG : "N \<subseteq> carrier(G)"
   9.279 +    using assms normal_imp_subgroup subgroup_imp_subset
   9.280 +    by (smt monoid.cases_scheme order_trans partial_object.simps(1) partial_object.update_convs(1))
   9.281 +  {have "H \<subseteq> normalizer G N" unfolding normalizer_def stabilizer_def
   9.282 +    proof
   9.283 +    fix x assume xH : "x \<in> H"
   9.284 +    hence xcarrierG : "x \<in> carrier(G)" using assms subgroup_imp_subset  by auto
   9.285 +    have "   N #> x = x <# N" using assms xH
   9.286 +      unfolding r_coset_def l_coset_def normal_def normal_axioms_def subgroup_imp_group by auto
   9.287 +    hence "x <# N #> inv x =(N #> x) #> inv x"
   9.288 +      by simp
   9.289 +    also have "... = N #> \<one>"
   9.290 +      using  assms r_inv xcarrierG coset_mult_assoc[OF N_carrierG] by simp  
   9.291 +    finally have "x <# N #> inv x = N" by (simp add: N_carrierG)
   9.292 +    thus "x \<in> {g \<in> carrier G. (\<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) N = N}"
   9.293 +      using xcarrierG by (simp add : N_carrierG)
   9.294 +  qed}
   9.295 +  thus "subgroup H (G\<lparr>carrier := normalizer G N\<rparr>)"
   9.296 +    using subgroup_incl[OF assms(1) normalizer_imp_subgroup]
   9.297 +         assms normal_imp_subgroup subgroup_imp_subset
   9.298 +    by (metis  group.incl_subgroup is_group)
   9.299 +qed
   9.300 +
   9.301 +
   9.302 +subsection \<open>Second Isomorphism Theorem\<close>
   9.303 +
   9.304 +
   9.305 +lemma (in group) mult_norm_subgroup :
   9.306 +  assumes "normal N G"
   9.307 +    and "subgroup H G"
   9.308 +  shows "subgroup (N<#>H) G" unfolding subgroup_def
   9.309 +proof-
   9.310 +  have  A :"N <#> H \<subseteq> carrier G"
   9.311 +    using assms  setmult_subset_G by (simp add: normal_imp_subgroup subgroup_imp_subset)
   9.312 +
   9.313 +  have B :"\<And> x y. \<lbrakk>x \<in> (N <#> H); y \<in> (N <#> H)\<rbrakk> \<Longrightarrow> (x \<otimes> y) \<in> (N<#>H)"
   9.314 +  proof-
   9.315 +    fix x y assume B1a: "x \<in> (N <#> H)"  and B1b: "y \<in> (N <#> H)"
   9.316 +    obtain n1 h1 where B2:"n1 \<in> N \<and> h1 \<in> H \<and> n1\<otimes>h1 = x"
   9.317 +      using set_mult_def B1a by (metis (no_types, lifting) UN_E singletonD)
   9.318 +    obtain n2 h2 where B3:"n2 \<in> N \<and> h2 \<in> H \<and> n2\<otimes>h2 = y"
   9.319 +      using set_mult_def B1b by (metis (no_types, lifting) UN_E singletonD)
   9.320 +    have "N #> h1 = h1 <# N"
   9.321 +      using normalI B2 assms normal.coset_eq subgroup_imp_subset by blast
   9.322 +    hence "h1\<otimes>n2 \<in> N #> h1" 
   9.323 +      using B2 B3 assms l_coset_def by fastforce
   9.324 +    from this obtain y2 where y2_def:"y2 \<in> N" and y2_prop:"y2\<otimes>h1 = h1\<otimes>n2" 
   9.325 +      using singletonD by (metis (no_types, lifting) UN_E r_coset_def) 
   9.326 +    have " x\<otimes>y =  n1 \<otimes> y2 \<otimes> h1 \<otimes> h2" using y2_def B2 B3
   9.327 +      by (smt assms y2_prop m_assoc m_closed normal_imp_subgroup subgroup.mem_carrier)
   9.328 +    moreover have B4 :"n1 \<otimes> y2 \<in>N"
   9.329 +      using B2 y2_def assms normal_imp_subgroup by (metis subgroup_def)
   9.330 +    moreover have "h1 \<otimes> h2 \<in>H" using B2 B3 assms by (simp add: subgroup.m_closed)
   9.331 +    hence "(n1 \<otimes> y2) \<otimes> (h1 \<otimes> h2) \<in>(N<#>H) "
   9.332 +      using B4  unfolding set_mult_def by auto
   9.333 +    hence "n1 \<otimes> y2 \<otimes> h1 \<otimes> h2 \<in>(N<#>H)"
   9.334 +      using m_assoc B2 B3 assms  normal_imp_subgroup by (metis B4 subgroup.mem_carrier)
   9.335 +    ultimately show  "x \<otimes> y \<in> N <#> H" by auto
   9.336 +  qed
   9.337 +  have C :"\<And> x. x\<in>(N<#>H)  \<Longrightarrow> (inv x)\<in>(N<#>H)"
   9.338 +
   9.339 +  proof-
   9.340 +    fix x assume C1 : "x \<in> (N<#>H)"
   9.341 +    obtain n h where C2:"n \<in> N \<and> h \<in> H \<and> n\<otimes>h = x"
   9.342 +      using set_mult_def C1 by (metis (no_types, lifting) UN_E singletonD)
   9.343 +    have C3 :"inv(n\<otimes>h) = inv(h)\<otimes>inv(n)"
   9.344 +      by (meson C2  assms inv_mult_group normal_imp_subgroup subgroup.mem_carrier)
   9.345 +    hence "... \<otimes>h \<in> N"
   9.346 +      using assms C2
   9.347 +      by (meson normal.inv_op_closed1 normal_def subgroup.m_inv_closed subgroup.mem_carrier)
   9.348 +    hence  C4:"(inv h \<otimes> inv n \<otimes> h) \<otimes> inv h \<in> (N<#>H)" 
   9.349 +      using   C2 assms subgroup.m_inv_closed[of H G h] unfolding set_mult_def by auto
   9.350 +    have "inv h \<otimes> inv n \<otimes> h \<otimes> inv h = inv h \<otimes> inv n"
   9.351 +      using  subgroup_imp_subset[OF assms(2)] 
   9.352 +      by (metis A C1 C2 C3 inv_closed inv_solve_right m_closed subsetCE)
   9.353 +    thus "inv(x)\<in>N<#>H" using C4 C2 C3 by simp
   9.354 +  qed
   9.355 +
   9.356 +  have D : "\<one> \<in> N <#> H"
   9.357 +  proof-
   9.358 +    have D1 : "\<one> \<in> N"
   9.359 +      using assms by (simp add: normal_def subgroup.one_closed)
   9.360 +     have D2 :"\<one> \<in> H"
   9.361 +      using assms by (simp add: subgroup.one_closed)
   9.362 +    thus "\<one> \<in> (N <#> H)"
   9.363 +      using set_mult_def D1 assms by fastforce
   9.364 +  qed
   9.365 +  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>
   9.366 +    \<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
   9.367 +qed
   9.368 +    
   9.369 +
   9.370 +lemma (in group) mult_norm_sub_in_sub :
   9.371 +  assumes "normal N (G\<lparr>carrier:=K\<rparr>)"
   9.372 +  assumes "subgroup H (G\<lparr>carrier:=K\<rparr>)"
   9.373 +  assumes "subgroup K G"
   9.374 +  shows  "subgroup (N<#>H) (G\<lparr>carrier:=K\<rparr>)"
   9.375 +proof-
   9.376 +  have Hyp:"subgroup (N <#>\<^bsub>G\<lparr>carrier := K\<rparr>\<^esub> H) (G\<lparr>carrier := K\<rparr>)"
   9.377 +    using group.mult_norm_subgroup[where ?G = "G\<lparr>carrier := K\<rparr>"] assms subgroup_imp_group by auto
   9.378 +  have "H \<subseteq> carrier(G\<lparr>carrier := K\<rparr>)" using assms subgroup_imp_subset by blast
   9.379 +  also have "... \<subseteq> K" by simp
   9.380 +  finally have Incl1:"H \<subseteq> K" by simp
   9.381 +  have "N \<subseteq> carrier(G\<lparr>carrier := K\<rparr>)" using assms normal_imp_subgroup subgroup_imp_subset by blast
   9.382 +  also have "... \<subseteq> K" by simp
   9.383 +  finally have Incl2:"N \<subseteq> K" by simp
   9.384 +  have "(N <#>\<^bsub>G\<lparr>carrier := K\<rparr>\<^esub> H) = (N <#> H)"
   9.385 +    using set_mult_same_law[of K] assms Incl1 Incl2 by simp
   9.386 +  thus "subgroup (N<#>H) (G\<lparr>carrier:=K\<rparr>)" using Hyp by auto
   9.387 +qed
   9.388 +
   9.389 +
   9.390 +lemma (in group) subgroup_of_normal_set_mult :
   9.391 +  assumes "normal N G"
   9.392 +and "subgroup H G"
   9.393 +shows "subgroup H (G\<lparr>carrier := N <#> H\<rparr>)"
   9.394 +proof-
   9.395 +  have "\<one> \<in> N" using normal_imp_subgroup assms(1) subgroup_def by blast
   9.396 +  hence "\<one> <# H \<subseteq> N <#> H" unfolding set_mult_def l_coset_def by blast
   9.397 +  hence H_incl : "H \<subseteq> N <#> H"
   9.398 +    by (metis assms(2) lcos_mult_one subgroup_def)
   9.399 +  show "subgroup H (G\<lparr>carrier := N <#> H\<rparr>)"
   9.400 +  using subgroup_incl[OF assms(2) mult_norm_subgroup[OF assms(1) assms(2)] H_incl] .
   9.401 +qed
   9.402 +
   9.403 +
   9.404 +lemma (in group) normal_in_normal_set_mult :
   9.405 +  assumes "normal N G"
   9.406 +and "subgroup H G"
   9.407 +shows "normal N (G\<lparr>carrier := N <#> H\<rparr>)"
   9.408 +proof-
   9.409 +  have "\<one> \<in> H" using  assms(2) subgroup_def by blast
   9.410 +  hence "N #> \<one>  \<subseteq> N <#> H" unfolding set_mult_def r_coset_def by blast
   9.411 +  hence N_incl : "N \<subseteq> N <#> H"
   9.412 +    by (metis assms(1) normal_imp_subgroup coset_mult_one subgroup_def)
   9.413 +  thus "normal N (G\<lparr>carrier := N <#> H\<rparr>)"
   9.414 +    using normal_inter_subgroup[OF mult_norm_subgroup[OF assms] assms(1)]
   9.415 +    by (simp add : inf_absorb1)
   9.416 +qed
   9.417 +
   9.418 +
   9.419 +proposition (in group) weak_snd_iso_thme :
   9.420 +  assumes "subgroup  H G" 
   9.421 +    and "N\<lhd>G"
   9.422 +  shows "(G\<lparr>carrier := N<#>H\<rparr> Mod N \<cong> G\<lparr>carrier:=H\<rparr> Mod (N\<inter>H))"
   9.423 +proof-
   9.424 +  define f where "f =  (#>) N"
   9.425 +  have GroupNH : "Group.group (G\<lparr>carrier := N<#>H\<rparr>)"
   9.426 +    using subgroup_imp_group assms mult_norm_subgroup by simp
   9.427 +  have  HcarrierNH :"H \<subseteq> carrier(G\<lparr>carrier := N<#>H\<rparr>)"
   9.428 +    using assms subgroup_of_normal_set_mult subgroup_imp_subset by blast
   9.429 +  hence HNH :"H \<subseteq> N<#>H" by simp
   9.430 +  have op_hom : "f \<in> hom (G\<lparr>carrier := H\<rparr>) (G\<lparr>carrier := N <#> H\<rparr> Mod N)" unfolding hom_def
   9.431 +  proof
   9.432 +    have "\<And>x . x \<in> carrier (G\<lparr>carrier :=H\<rparr>) \<Longrightarrow>
   9.433 +       (#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N x \<in>  carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
   9.434 +    proof-
   9.435 +      fix x assume  "x \<in> carrier (G\<lparr>carrier :=H\<rparr>)"
   9.436 +      hence xH : "x \<in> H" by simp
   9.437 +      hence "(#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N x \<in> rcosets\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub> N"
   9.438 +        using HcarrierNH RCOSETS_def[where ?G = "G\<lparr>carrier := N <#> H\<rparr>"] by blast
   9.439 +      thus "(#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N x \<in>  carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
   9.440 +        unfolding FactGroup_def by simp
   9.441 +    qed
   9.442 +    hence "(#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N \<in> carrier (G\<lparr>carrier :=H\<rparr>) \<rightarrow>
   9.443 +            carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)" by auto
   9.444 +    hence "f \<in> carrier (G\<lparr>carrier :=H\<rparr>) \<rightarrow> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
   9.445 +      unfolding r_coset_def f_def  by simp
   9.446 +    moreover have "\<And>x y. x\<in>carrier (G\<lparr>carrier := H\<rparr>) \<Longrightarrow> y\<in>carrier (G\<lparr>carrier := H\<rparr>) \<Longrightarrow>
   9.447 +                  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)"
   9.448 +    proof-
   9.449 +      fix x y assume "x\<in>carrier (G\<lparr>carrier := H\<rparr>)" "y\<in>carrier (G\<lparr>carrier := H\<rparr>)"
   9.450 +      hence xHyH :"x \<in> H" "y \<in> H" by auto
   9.451 +      have Nxeq :"N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x = N #>x" unfolding r_coset_def by simp
   9.452 +      have Nyeq :"N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y = N #>y" unfolding r_coset_def by simp
   9.453 +
   9.454 +      have "x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y =x \<otimes>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y" by simp
   9.455 +      hence "N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> y
   9.456 +             = N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x \<otimes>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y" by simp
   9.457 +      also have "... = (N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> x) <#>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub>
   9.458 +                       (N #>\<^bsub>G\<lparr>carrier := N<#>H\<rparr>\<^esub> y)"
   9.459 +        using normal.rcos_sum[OF normal_in_normal_set_mult[OF assms(2) assms(1)], of x y]
   9.460 +             xHyH assms HcarrierNH by auto
   9.461 +      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)"
   9.462 +        unfolding  FactGroup_def r_coset_def f_def  using Nxeq Nyeq  by auto
   9.463 +    qed
   9.464 +    hence "(\<forall>x\<in>carrier (G\<lparr>carrier := H\<rparr>). \<forall>y\<in>carrier (G\<lparr>carrier := H\<rparr>).
   9.465 +           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
   9.466 +    ultimately show  " f \<in> carrier (G\<lparr>carrier := H\<rparr>) \<rightarrow> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N) \<and>
   9.467 +    (\<forall>x\<in>carrier (G\<lparr>carrier := H\<rparr>). \<forall>y\<in>carrier (G\<lparr>carrier := H\<rparr>).
   9.468 +     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))"
   9.469 +      by auto
   9.470 +  qed
   9.471 +  hence homomorphism : "group_hom (G\<lparr>carrier := H\<rparr>) (G\<lparr>carrier := N <#> H\<rparr> Mod N) f"
   9.472 +    unfolding group_hom_def group_hom_axioms_def using subgroup_imp_group[OF assms(1)]
   9.473 +             normal.factorgroup_is_group[OF normal_in_normal_set_mult[OF assms(2) assms(1)]] by auto
   9.474 +  moreover have im_f :  "(f  ` carrier(G\<lparr>carrier:=H\<rparr>)) = carrier(G\<lparr>carrier := N <#> H\<rparr> Mod N)"
   9.475 +  proof
   9.476 +    show  "f ` carrier (G\<lparr>carrier := H\<rparr>) \<subseteq> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
   9.477 +      using op_hom unfolding hom_def using funcset_image by blast
   9.478 +  next
   9.479 +    show "carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N) \<subseteq> f ` carrier (G\<lparr>carrier := H\<rparr>)"
   9.480 +    proof
   9.481 +      fix x assume p : " x \<in> carrier (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
   9.482 +      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}}"
   9.483 +        unfolding FactGroup_def RCOSETS_def by auto
   9.484 +      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"
   9.485 +        using Union_iff by blast
   9.486 +      from hyp obtain nh where nhNH:"nh \<in>carrier (G\<lparr>carrier := N <#> H\<rparr>)"
   9.487 +                          and "x \<in> {N #>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub> nh}"
   9.488 +        by blast
   9.489 +      hence K: "x = (#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N nh" by simp
   9.490 +      have "nh \<in> N <#> H" using nhNH by simp
   9.491 +      from this obtain n h where nN : "n \<in> N" and hH : " h \<in> H" and nhnh: "n \<otimes> h = nh"
   9.492 +        unfolding set_mult_def by blast
   9.493 +      have  "x = (#>\<^bsub>G\<lparr>carrier := N <#> H\<rparr>\<^esub>) N (n \<otimes> h)" using K nhnh by simp
   9.494 +      hence  "x = (#>) N (n \<otimes> h)" using K nhnh unfolding r_coset_def by auto
   9.495 +      also have "... = (N #> n) #>h"
   9.496 +        using coset_mult_assoc hH nN assms subgroup_imp_subset normal_imp_subgroup
   9.497 +        by (metis subgroup.mem_carrier)
   9.498 +      finally have "x = (#>) N h"
   9.499 +        using coset_join2[of n N] nN assms by (simp add: normal_imp_subgroup subgroup.mem_carrier)
   9.500 +      thus "x \<in> f ` carrier (G\<lparr>carrier := H\<rparr>)" using hH unfolding f_def by simp
   9.501 +    qed
   9.502 +  qed
   9.503 +  moreover have ker_f :"kernel (G\<lparr>carrier := H\<rparr>) (G\<lparr>carrier := N<#>H\<rparr> Mod N) f  = N\<inter>H"
   9.504 +    unfolding kernel_def f_def
   9.505 +    proof-
   9.506 +      have "{x \<in> carrier (G\<lparr>carrier := H\<rparr>). N #> x = \<one>\<^bsub>G\<lparr>carrier := N <#> H\<rparr> Mod N\<^esub>} =
   9.507 +            {x \<in> carrier (G\<lparr>carrier := H\<rparr>). N #> x = N}" unfolding FactGroup_def by simp
   9.508 +      also have "... = {x \<in> carrier (G\<lparr>carrier := H\<rparr>). x \<in> N}"
   9.509 +        using coset_join1
   9.510 +        by (metis (no_types, lifting) assms group.subgroup_self incl_subgroup is_group
   9.511 +          normal_imp_subgroup subgroup.mem_carrier subgroup.rcos_const subgroup_imp_group)
   9.512 +      also have "... =N \<inter> (carrier(G\<lparr>carrier := H\<rparr>))" by auto
   9.513 +      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"
   9.514 +        by simp
   9.515 +    qed
   9.516 +    ultimately have "(G\<lparr>carrier := H\<rparr> Mod N \<inter> H) \<cong> (G\<lparr>carrier := N <#> H\<rparr> Mod N)"
   9.517 +      using group_hom.FactGroup_iso[OF homomorphism im_f] by auto
   9.518 +    hence "G\<lparr>carrier := N <#> H\<rparr> Mod N \<cong> G\<lparr>carrier := H\<rparr> Mod N \<inter> H"
   9.519 +      by (simp add: group.iso_sym assms normal.factorgroup_is_group normal_inter_subgroup)
   9.520 +    thus "G\<lparr>carrier := N <#> H\<rparr> Mod N \<cong> G\<lparr>carrier := H\<rparr> Mod N \<inter> H" by auto
   9.521 +qed
   9.522 +
   9.523 +
   9.524 +theorem (in group) snd_iso_thme :
   9.525 +  assumes "subgroup H G"
   9.526 +    and "subgroup N G"
   9.527 +    and "subgroup H (G\<lparr>carrier:= (normalizer G N)\<rparr>)"
   9.528 +  shows "(G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong> (G\<lparr>carrier:= H\<rparr> Mod (H\<inter>N))"
   9.529 +proof-
   9.530 +  have "G\<lparr>carrier := normalizer G N, carrier := H\<rparr>
   9.531 +       = G\<lparr>carrier := H\<rparr>"  by simp
   9.532 +  hence "G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H =
   9.533 +         G\<lparr>carrier := H\<rparr> Mod N \<inter> H" by auto
   9.534 +  moreover have "G\<lparr>carrier := normalizer G N,
   9.535 +                    carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> =
   9.536 +                G\<lparr>carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr>" by simp
   9.537 +  hence "G\<lparr>carrier := normalizer G N,
   9.538 +          carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N =
   9.539 +          G\<lparr>carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N" by auto
   9.540 +  hence "G\<lparr>carrier := normalizer G N,
   9.541 +          carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N  \<cong>
   9.542 +         G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H =
   9.543 +          (G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong>
   9.544 +         G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H" 
   9.545 +    using set_mult_same_law[OF  normalizer_imp_subgroup[OF subgroup_imp_subset[OF assms(2)]], of N H] 
   9.546 +          subgroup_imp_subset[OF assms(3)]
   9.547 +          subgroup_imp_subset[OF normal_imp_subgroup[OF subgroup_in_normalizer[OF assms(2)]]]
   9.548 +    by simp
   9.549 +  ultimately have "G\<lparr>carrier := normalizer G N,
   9.550 +                    carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N  \<cong>
   9.551 +                  G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H =
   9.552 +                 (G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong>  G\<lparr>carrier := H\<rparr> Mod N \<inter> H" by auto
   9.553 +  moreover have "G\<lparr>carrier := normalizer G N,
   9.554 +                    carrier := N <#>\<^bsub>G\<lparr>carrier := normalizer G N\<rparr>\<^esub> H\<rparr> Mod N  \<cong>
   9.555 +                  G\<lparr>carrier := normalizer G N, carrier := H\<rparr> Mod N \<inter> H"
   9.556 +    using group.weak_snd_iso_thme[OF subgroup_imp_group[OF normalizer_imp_subgroup[OF
   9.557 +          subgroup_imp_subset[OF assms(2)]]] assms(3) subgroup_in_normalizer[OF assms(2)]]
   9.558 +    by simp
   9.559 +  moreover have "H\<inter>N = N\<inter>H" using assms  by auto
   9.560 +  ultimately show "(G\<lparr>carrier:= N<#>H\<rparr> Mod N)  \<cong>  G\<lparr>carrier := H\<rparr> Mod H \<inter> N" by auto
   9.561 +qed
   9.562 + 
   9.563 +
   9.564 +corollary (in group) snd_iso_thme_recip :
   9.565 +  assumes "subgroup H G"
   9.566 +    and "subgroup N G"
   9.567 +    and "subgroup H (G\<lparr>carrier:= (normalizer G N)\<rparr>)"
   9.568 +  shows "(G\<lparr>carrier:= H<#>N\<rparr> Mod N)  \<cong> (G\<lparr>carrier:= H\<rparr> Mod (H\<inter>N))"
   9.569 +  by (metis assms commut_normal_subgroup group.subgroup_in_normalizer is_group subgroup_imp_subset
   9.570 +      normalizer_imp_subgroup snd_iso_thme)
   9.571 +
   9.572 +
   9.573 +subsection\<open>The Zassenhaus Lemma\<close>
   9.574 +
   9.575 +
   9.576 +lemma (in group) distinc :
   9.577 +  assumes "subgroup  H G" 
   9.578 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
   9.579 +    and  "subgroup K G" 
   9.580 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
   9.581 +  shows "subgroup (H\<inter>K) (G\<lparr>carrier:=(normalizer G (H1<#>(H\<inter>K1))) \<rparr>)"
   9.582 +proof (intro subgroup_incl[OF subgroups_Inter_pair[OF assms(1) assms(3)]])
   9.583 +  show "subgroup (normalizer G (H1 <#> H \<inter> K1)) G"
   9.584 +    using normalizer_imp_subgroup assms normal_imp_subgroup subgroup_imp_subset
   9.585 +    by (metis group.incl_subgroup is_group setmult_subset_G subgroups_Inter_pair)
   9.586 +next
   9.587 +  show "H \<inter> K \<subseteq> normalizer G (H1 <#> H \<inter> K1)" unfolding normalizer_def stabilizer_def
   9.588 +  proof
   9.589 +    fix x assume xHK : "x \<in> H \<inter> K"
   9.590 +    hence xG : "{x} \<subseteq> carrier G" "{inv x} \<subseteq> carrier G"
   9.591 +      using subgroup_imp_subset assms inv_closed xHK by auto
   9.592 +    have allG : "H \<subseteq> carrier G" "K \<subseteq> carrier G" "H1 \<subseteq> carrier G"  "K1 \<subseteq> carrier G"
   9.593 +      using assms subgroup_imp_subset normal_imp_subgroup incl_subgroup apply blast+ .
   9.594 +    have HK1_normal: "H\<inter>K1 \<lhd> (G\<lparr>carrier :=  H \<inter> K\<rparr>)" using normal_inter[OF assms(3)assms(1)assms(4)]
   9.595 +      by (simp add : inf_commute)
   9.596 +    have "H \<inter> K \<subseteq> normalizer G (H \<inter> K1)"
   9.597 +      using subgroup_imp_subset[OF normal_imp_subgroup_normalizer[OF subgroups_Inter_pair[OF
   9.598 +            assms(1)assms(3)]HK1_normal]] by auto
   9.599 +    hence "x <# (H \<inter> K1) #> inv x = (H \<inter> K1)"
   9.600 +      using xHK subgroup_imp_subset[OF subgroups_Inter_pair[OF assms(1) incl_subgroup[OF assms(3)
   9.601 +                                                            normal_imp_subgroup[OF assms(4)]]]]
   9.602 +      unfolding normalizer_def stabilizer_def by auto
   9.603 +    moreover have "H \<subseteq>  normalizer G H1"
   9.604 +      using subgroup_imp_subset[OF normal_imp_subgroup_normalizer[OF assms(1)assms(2)]] by auto
   9.605 +    hence "x <# H1 #> inv x = H1"
   9.606 +      using xHK subgroup_imp_subset[OF  incl_subgroup[OF assms(1) normal_imp_subgroup[OF assms(2)]]]
   9.607 +      unfolding normalizer_def stabilizer_def by auto
   9.608 +    ultimately have "H1 <#> H \<inter> K1 = (x <# H1 #> inv x) <#> (x <#  H \<inter> K1 #> inv x)" by auto
   9.609 +    also have "... = ({x} <#> H1) <#> {inv x} <#> ({x} <#>  H \<inter> K1 <#> {inv x})"
   9.610 +      by (simp add : r_coset_eq_set_mult l_coset_eq_set_mult)
   9.611 +    also have "... = ({x} <#> H1 <#> {inv x} <#> {x}) <#>  (H \<inter> K1 <#> {inv x})"
   9.612 +      by (smt Int_lower1 allG xG set_mult_assoc subset_trans setmult_subset_G)
   9.613 +    also have "... = ({x} <#> H1 <#> {\<one>}) <#>  (H \<inter> K1 <#> {inv x})"
   9.614 +      using allG xG coset_mult_assoc by (simp add: r_coset_eq_set_mult setmult_subset_G)
   9.615 +    also have "... =({x} <#> H1) <#>  (H \<inter> K1 <#> {inv x})"
   9.616 +      using coset_mult_one r_coset_eq_set_mult[of G H1 \<one>] set_mult_assoc[OF xG(1) allG(3)] allG
   9.617 +      by auto
   9.618 +    also have "... = {x} <#> (H1 <#> H \<inter> K1) <#> {inv x}"
   9.619 +      using allG xG set_mult_assoc setmult_subset_G by (metis inf.coboundedI2)
   9.620 +    finally have "H1 <#> H \<inter> K1 = x <# (H1 <#> H \<inter> K1) #> inv x" 
   9.621 +      using xG setmult_subset_G allG by (simp add: l_coset_eq_set_mult r_coset_eq_set_mult)
   9.622 +    thus "x \<in> {g \<in> carrier G. (\<lambda>H\<in>{H. H \<subseteq> carrier G}. g <# H #> inv g) (H1 <#> H \<inter> K1)
   9.623 +                                                                       = H1 <#> H \<inter> K1}"
   9.624 +      using xG allG setmult_subset_G[OF allG(3), where ?K = "H\<inter>K1"] xHK
   9.625 +      by auto
   9.626 +  qed
   9.627 +qed
   9.628 +
   9.629 +lemma (in group) preliminary1 :
   9.630 +  assumes "subgroup  H G" 
   9.631 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
   9.632 +    and  "subgroup K G" 
   9.633 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
   9.634 +  shows " (H\<inter>K) \<inter> (H1<#>(H\<inter>K1)) = (H1\<inter>K)<#>(H\<inter>K1)"
   9.635 +proof
   9.636 +  have all_inclG : "H \<subseteq> carrier G" "H1 \<subseteq> carrier G" "K \<subseteq> carrier G" "K1 \<subseteq> carrier G"
   9.637 +    using assms subgroup_imp_subset normal_imp_subgroup incl_subgroup apply blast+.
   9.638 +  show "H \<inter> K \<inter> (H1 <#> H \<inter> K1) \<subseteq> H1 \<inter> K <#> H \<inter> K1"
   9.639 +  proof
   9.640 +    fix x assume x_def : "x \<in> (H \<inter> K) \<inter> (H1 <#> (H \<inter> K1))"
   9.641 +    from x_def have x_incl : "x \<in> H" "x \<in> K" "x \<in> (H1 <#> (H \<inter> K1))" by auto
   9.642 +    then obtain h1 hk1 where h1hk1_def : "h1 \<in> H1" "hk1 \<in> H \<inter> K1" "h1 \<otimes> hk1 = x"
   9.643 +      using assms unfolding set_mult_def by blast
   9.644 +    hence "hk1 \<in> H \<inter> K" using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(4)]] by auto
   9.645 +    hence "inv hk1 \<in> H \<inter> K" using subgroup.m_inv_closed[OF subgroups_Inter_pair] assms by auto
   9.646 +    moreover have "h1 \<otimes> hk1 \<in> H \<inter> K" using x_incl h1hk1_def by auto
   9.647 +    ultimately have "h1 \<otimes> hk1 \<otimes> inv hk1 \<in> H \<inter> K"
   9.648 +      using subgroup.m_closed[OF subgroups_Inter_pair] assms by auto
   9.649 +    hence "h1 \<in> H \<inter> K" using  h1hk1_def assms subgroup_imp_subset incl_subgroup normal_imp_subgroup
   9.650 +      by (metis Int_iff contra_subsetD inv_solve_right m_closed)
   9.651 +    hence "h1 \<in> H1 \<inter> H \<inter> K" using h1hk1_def by auto
   9.652 +    hence "h1 \<in> H1 \<inter> K" using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(2)]] by auto
   9.653 +    hence "h1 \<otimes> hk1 \<in> (H1\<inter>K)<#>(H\<inter>K1)"
   9.654 +      using h1hk1_def unfolding set_mult_def by auto
   9.655 +    thus " x \<in> (H1\<inter>K)<#>(H\<inter>K1)" using h1hk1_def x_def by auto
   9.656 +  qed
   9.657 +  show "H1 \<inter> K <#> H \<inter> K1 \<subseteq> H \<inter> K \<inter> (H1 <#> H \<inter> K1)"
   9.658 +  proof-
   9.659 +    have "H1 \<inter> K \<subseteq> H \<inter> K" using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(2)]] by auto
   9.660 +    moreover have "H \<inter> K1 \<subseteq> H \<inter> K"
   9.661 +      using subgroup_imp_subset[OF normal_imp_subgroup[OF assms(4)]] by auto
   9.662 +    ultimately have "H1 \<inter> K <#> H \<inter> K1 \<subseteq> H \<inter> K" unfolding set_mult_def
   9.663 +      using subgroup.m_closed[OF subgroups_Inter_pair [OF assms(1)assms(3)]] by blast
   9.664 +    moreover have "H1 \<inter> K \<subseteq> H1" by auto
   9.665 +    hence "H1 \<inter> K <#> H \<inter> K1 \<subseteq> (H1 <#> H \<inter> K1)" unfolding set_mult_def by auto
   9.666 +    ultimately show "H1 \<inter> K <#> H \<inter> K1 \<subseteq> H \<inter> K \<inter> (H1 <#> H \<inter> K1)" by auto
   9.667 +  qed
   9.668 +qed
   9.669 +
   9.670 +lemma (in group) preliminary2 :
   9.671 +  assumes "subgroup  H G" 
   9.672 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>"
   9.673 +    and  "subgroup K G" 
   9.674 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
   9.675 +  shows "(H1<#>(H\<inter>K1)) \<lhd> G\<lparr>carrier:=(H1<#>(H\<inter>K))\<rparr>"
   9.676 +proof-
   9.677 +  have all_inclG : "H \<subseteq> carrier G" "H1 \<subseteq> carrier G" "K \<subseteq> carrier G" "K1 \<subseteq> carrier G"
   9.678 +    using assms subgroup_imp_subset normal_imp_subgroup incl_subgroup apply blast+.
   9.679 +  have subH1:"subgroup (H1 <#> H \<inter> K) (G\<lparr>carrier := H\<rparr>)" 
   9.680 +    using mult_norm_sub_in_sub[OF assms(2)subgroup_incl[OF subgroups_Inter_pair[OF assms(1)assms(3)]
   9.681 +          assms(1)]] assms by auto
   9.682 +  have "Group.group (G\<lparr>carrier:=(H1<#>(H\<inter>K))\<rparr>)"
   9.683 +    using  subgroup_imp_group[OF incl_subgroup[OF assms(1) subH1]].
   9.684 +  moreover have subH2 : "subgroup (H1 <#> H \<inter> K1) (G\<lparr>carrier := H\<rparr>)"
   9.685 +    using mult_norm_sub_in_sub[OF assms(2) subgroup_incl[OF subgroups_Inter_pair[OF
   9.686 +           assms(1) incl_subgroup[OF assms(3)normal_imp_subgroup[OF assms(4)]]]]] assms by auto
   9.687 +  hence "(H\<inter>K1) \<subseteq> (H\<inter>K)"
   9.688 +    using assms subgroup_imp_subset normal_imp_subgroup monoid.cases_scheme
   9.689 +    by (metis inf.mono  partial_object.simps(1) partial_object.update_convs(1) subset_refl)
   9.690 +  hence incl:"(H1<#>(H\<inter>K1)) \<subseteq> H1<#>(H\<inter>K)" using assms subgroup_imp_subset normal_imp_subgroup
   9.691 +    unfolding set_mult_def by blast
   9.692 +  hence "subgroup (H1 <#> H \<inter> K1) (G\<lparr>carrier := (H1<#>(H\<inter>K))\<rparr>)"
   9.693 +    using assms subgroup_incl[OF incl_subgroup[OF assms(1)subH2]incl_subgroup[OF assms(1)
   9.694 +          subH1]] normal_imp_subgroup subgroup_imp_subset unfolding set_mult_def by blast
   9.695 +  moreover have " (\<And> x. x\<in>carrier (G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>) \<Longrightarrow>
   9.696 +        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))"
   9.697 +  proof-
   9.698 +    fix x assume  "x \<in>carrier (G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>)"
   9.699 +    hence x_def : "x \<in> H1 <#> H \<inter> K" by simp
   9.700 +    from this obtain h1 hk where h1hk_def :"h1 \<in> H1" "hk \<in> H \<inter> K" "h1 \<otimes> hk = x"
   9.701 +      unfolding set_mult_def by blast
   9.702 +    have xH : "x \<in> H" using subgroup_imp_subset[OF subH1] using x_def by auto
   9.703 +    hence allG : "h1 \<in> carrier G" "hk \<in> carrier G" "x \<in> carrier G"
   9.704 +      using assms subgroup_imp_subset h1hk_def normal_imp_subgroup incl_subgroup apply blast+.
   9.705 +    hence "x <#\<^bsub>G\<lparr>carrier := H1 <#> H\<inter>K\<rparr>\<^esub> (H1 <#> H\<inter>K1) =h1 \<otimes> hk <# (H1 <#> H\<inter>K1)"
   9.706 +      using set_mult_same_law subgroup_imp_subset xH h1hk_def by (simp add: l_coset_def)
   9.707 +    also have "... = h1 <# (hk <# (H1 <#> H\<inter>K1))"
   9.708 +      using lcos_m_assoc[OF subgroup_imp_subset[OF incl_subgroup[OF assms(1) subH1]]allG(1)allG(2)]
   9.709 +      by (metis allG(1) allG(2) assms(1) incl_subgroup lcos_m_assoc subH2 subgroup_imp_subset)
   9.710 +    also have "... = h1 <# (hk <# H1 <#> H\<inter>K1)"
   9.711 +      using set_mult_assoc all_inclG allG by (simp add: l_coset_eq_set_mult inf.coboundedI1)
   9.712 +    also have "... = h1 <# (hk <# H1 #> \<one> <#> H\<inter>K1 #> \<one>)"
   9.713 +      using coset_mult_one allG all_inclG l_coset_subset_G
   9.714 +      by (smt inf_le2 setmult_subset_G subset_trans)
   9.715 +    also have "... = h1 <# (hk <# H1 #> inv hk #> hk <#> H\<inter>K1 #> inv hk #> hk)"
   9.716 +      using all_inclG allG coset_mult_assoc l_coset_subset_G
   9.717 +      by (simp add: inf.coboundedI1 setmult_subset_G)
   9.718 +    finally  have "x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1) =
   9.719 +                    h1 <# ((hk <# H1 #> inv hk) <#> (hk <# H\<inter>K1 #> inv hk) #> hk)"
   9.720 +      using rcos_assoc_lcos allG all_inclG
   9.721 +      by (smt inf_le1 inv_closed l_coset_subset_G r_coset_subset_G setmult_rcos_assoc subset_trans)
   9.722 +    moreover have "H \<subseteq>  normalizer G H1"
   9.723 +      using assms h1hk_def subgroup_imp_subset[OF normal_imp_subgroup_normalizer] by simp
   9.724 +    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}"
   9.725 +      using all_inclG assms unfolding normalizer_def stabilizer_def by auto
   9.726 +    hence "\<And>g. g \<in> H \<Longrightarrow>  g <# H1 #> inv g = H1" using all_inclG by simp
   9.727 +    hence "(hk <# H1 #> inv hk) = H1" using h1hk_def all_inclG by simp
   9.728 +    moreover have "H\<inter>K \<subseteq> normalizer G (H\<inter>K1)"
   9.729 +      using normal_inter[OF assms(3)assms(1)assms(4)] assms subgroups_Inter_pair
   9.730 +            subgroup_imp_subset[OF normal_imp_subgroup_normalizer] by (simp add: inf_commute)
   9.731 +    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}"
   9.732 +      using all_inclG assms unfolding normalizer_def stabilizer_def by auto
   9.733 +    hence "\<And>g. g \<in> H\<inter>K \<Longrightarrow>  g <# (H\<inter>K1) #> inv g = H\<inter>K1"
   9.734 +      using subgroup_imp_subset[OF subgroups_Inter_pair[OF assms(1) incl_subgroup[OF
   9.735 +            assms(3)normal_imp_subgroup[OF assms(4)]]]] by auto
   9.736 +    hence "(hk <# H\<inter>K1 #> inv hk) = H\<inter>K1" using h1hk_def by simp
   9.737 +    ultimately have "x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1) = h1 <#(H1 <#> (H \<inter> K1)#> hk)"
   9.738 +      by auto
   9.739 +    also have "... = h1 <# H1 <#> ((H \<inter> K1)#> hk)"
   9.740 +      using set_mult_assoc[where ?M = "{h1}" and ?H = "H1" and ?K = "(H \<inter> K1)#> hk"] allG all_inclG
   9.741 +      by (simp add: l_coset_eq_set_mult inf.coboundedI2 r_coset_subset_G setmult_rcos_assoc)
   9.742 +    also have "... = H1 <#> ((H \<inter> K1)#> hk)"
   9.743 +      using coset_join3 allG incl_subgroup[OF assms(1)normal_imp_subgroup[OF assms(2)]] h1hk_def
   9.744 +      by auto
   9.745 +    finally have eq1 : "x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1) = H1 <#> (H \<inter> K1) #> hk"
   9.746 +      by (simp add: allG(2) all_inclG inf.coboundedI2 setmult_rcos_assoc)
   9.747 +    have "H1 <#> H \<inter> K1 #>\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> x = H1 <#> H \<inter> K1 #> (h1 \<otimes> hk)"
   9.748 +      using set_mult_same_law subgroup_imp_subset xH h1hk_def by (simp add: r_coset_def)
   9.749 +    also have "... = H1 <#> H \<inter> K1 #> h1 #> hk"
   9.750 +      using coset_mult_assoc by (simp add: allG all_inclG inf.coboundedI2 setmult_subset_G)
   9.751 +    also have"... =  H \<inter> K1 <#> H1 #> h1 #> hk"
   9.752 +      using commut_normal_subgroup[OF assms(1)assms(2)subgroup_incl[OF subgroups_Inter_pair[OF
   9.753 +           assms(1)incl_subgroup[OF assms(3)normal_imp_subgroup[OF assms(4)]]]assms(1)]] by simp
   9.754 +    also have "... = H \<inter> K1 <#> H1  #> hk"
   9.755 +      using coset_join2[OF allG(1)incl_subgroup[OF assms(1)normal_imp_subgroup]
   9.756 +            h1hk_def(1)] all_inclG allG assms by (metis inf.coboundedI2 setmult_rcos_assoc)
   9.757 +    finally  have "H1 <#> H \<inter> K1 #>\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> x =H1 <#> H \<inter> K1  #> hk"
   9.758 +      using commut_normal_subgroup[OF assms(1)assms(2)subgroup_incl[OF subgroups_Inter_pair[OF
   9.759 +           assms(1)incl_subgroup[OF assms(3)normal_imp_subgroup[OF assms(4)]]]assms(1)]] by simp
   9.760 +    thus " H1 <#> H \<inter> K1 #>\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> x = 
   9.761 +             x <#\<^bsub>G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>\<^esub> (H1 <#> H \<inter> K1)" using eq1 by simp
   9.762 +  qed
   9.763 +  ultimately show "H1 <#> H \<inter> K1 \<lhd> G\<lparr>carrier := H1 <#> H \<inter> K\<rparr>"
   9.764 +    unfolding normal_def normal_axioms_def by auto
   9.765 +qed
   9.766 +
   9.767 +
   9.768 +proposition (in group)  Zassenhaus_1 :
   9.769 +  assumes "subgroup  H G" 
   9.770 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
   9.771 +    and  "subgroup K G" 
   9.772 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
   9.773 +  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)))"
   9.774 +proof-
   9.775 +  define N  and N1 where "N = (H\<inter>K)" and "N1 =H1<#>(H\<inter>K1)"
   9.776 +  have normal_N_N1 : "subgroup N (G\<lparr>carrier:=(normalizer G N1)\<rparr>)"
   9.777 +    by (simp add: N1_def N_def assms distinc normal_imp_subgroup)
   9.778 +  have Hp:"(G\<lparr>carrier:= N<#>N1\<rparr> Mod N1)  \<cong> (G\<lparr>carrier:= N\<rparr> Mod (N\<inter>N1))"
   9.779 +  by (metis N1_def N_def assms incl_subgroup inf_le1 mult_norm_sub_in_sub
   9.780 +        normal_N_N1 normal_imp_subgroup snd_iso_thme_recip subgroup_incl subgroups_Inter_pair)
   9.781 +  have H_simp: "N<#>N1 = H1<#> (H\<inter>K)"
   9.782 +  proof-
   9.783 +    have H1_incl_G : "H1 \<subseteq> carrier G"
   9.784 +      using assms normal_imp_subgroup incl_subgroup subgroup_imp_subset by blast
   9.785 +    have K1_incl_G :"K1 \<subseteq> carrier G"
   9.786 +      using assms normal_imp_subgroup incl_subgroup subgroup_imp_subset by blast
   9.787 +    have "N<#>N1=  (H\<inter>K)<#> (H1<#>(H\<inter>K1))" by (auto simp add: N_def N1_def)
   9.788 +    also have "... = ((H\<inter>K)<#>H1) <#>(H\<inter>K1)"
   9.789 +      using set_mult_assoc[where ?M = "H\<inter>K"] K1_incl_G H1_incl_G assms
   9.790 +      by (simp add: inf.coboundedI2 subgroup_imp_subset)
   9.791 +    also have "... = (H1<#>(H\<inter>K))<#>(H\<inter>K1)" 
   9.792 +      using commut_normal_subgroup assms subgroup_incl subgroups_Inter_pair by auto
   9.793 +    also have "... =  H1 <#> ((H\<inter>K)<#>(H\<inter>K1))"
   9.794 +      using set_mult_assoc K1_incl_G H1_incl_G assms
   9.795 +      by (simp add: inf.coboundedI2 subgroup_imp_subset)
   9.796 +    also have " ((H\<inter>K)<#>(H\<inter>K1)) = (H\<inter>K)"
   9.797 +    proof (intro set_mult_subgroup_idem[where ?H = "H\<inter>K" and ?N="H\<inter>K1",
   9.798 +             OF subgroups_Inter_pair[OF assms(1) assms(3)]])
   9.799 +      show "subgroup (H \<inter> K1) (G\<lparr>carrier := H \<inter> K\<rparr>)"
   9.800 +        using subgroup_incl[where ?I = "H\<inter>K1" and ?J = "H\<inter>K",OF subgroups_Inter_pair[OF assms(1)
   9.801 +              incl_subgroup[OF assms(3) normal_imp_subgroup]] subgroups_Inter_pair] assms
   9.802 +              normal_imp_subgroup by (metis inf_commute normal_inter)
   9.803 +    qed
   9.804 +    hence " H1 <#> ((H\<inter>K)<#>(H\<inter>K1)) =  H1 <#> ((H\<inter>K))" 
   9.805 +      by simp
   9.806 +    thus "N <#> N1 = H1 <#> H \<inter> K"
   9.807 +      by (simp add: calculation)
   9.808 +  qed
   9.809 +
   9.810 +  have "N\<inter>N1 = (H1\<inter>K)<#>(H\<inter>K1)" 
   9.811 +    using preliminary1 assms N_def N1_def by simp 
   9.812 +  thus  "(G\<lparr>carrier:= H1 <#> (H\<inter>K)\<rparr> Mod N1)  \<cong> (G\<lparr>carrier:= N\<rparr> Mod  ((H1\<inter>K)<#>(H\<inter>K1)))"
   9.813 +    using H_simp Hp by auto
   9.814 +qed
   9.815 +
   9.816 +
   9.817 +theorem (in group) Zassenhaus :
   9.818 +  assumes "subgroup  H G" 
   9.819 +    and "H1\<lhd>G\<lparr>carrier := H\<rparr>" 
   9.820 +    and  "subgroup K G" 
   9.821 +    and "K1\<lhd>G\<lparr>carrier:=K\<rparr>"
   9.822 +  shows "(G\<lparr>carrier:= H1 <#> (H\<inter>K)\<rparr> Mod (H1<#>(H\<inter>K1)))  \<cong> 
   9.823 +         (G\<lparr>carrier:= K1 <#> (H\<inter>K)\<rparr> Mod (K1<#>(K\<inter>H1)))"
   9.824 +proof-
   9.825 +  define Gmod1 Gmod2 Gmod3 Gmod4
   9.826 +    where "Gmod1 = (G\<lparr>carrier:= H1 <#> (H\<inter>K)\<rparr> Mod (H1<#>(H\<inter>K1))) "
   9.827 +      and "Gmod2 = (G\<lparr>carrier:= K1 <#> (K\<inter>H)\<rparr> Mod (K1<#>(K\<inter>H1)))"
   9.828 +      and "Gmod3 = (G\<lparr>carrier:= (H\<inter>K)\<rparr> Mod  ((H1\<inter>K)<#>(H\<inter>K1)))"
   9.829 +      and "Gmod4 = (G\<lparr>carrier:= (K\<inter>H)\<rparr> Mod  ((K1\<inter>H)<#>(K\<inter>H1)))"
   9.830 +  have Hyp :  "Gmod1  \<cong> Gmod3" "Gmod2  \<cong>  Gmod4"
   9.831 +    using Zassenhaus_1 assms Gmod1_def Gmod2_def Gmod3_def Gmod4_def by auto
   9.832 +  have Hp : "Gmod3 = G\<lparr>carrier:= (K\<inter>H)\<rparr> Mod ((K\<inter>H1)<#>(K1\<inter>H))"
   9.833 +    by (simp add: Gmod3_def inf_commute)
   9.834 +  have "(K\<inter>H1)<#>(K1\<inter>H) = (K1\<inter>H)<#>(K\<inter>H1)"
   9.835 +  proof (intro commut_normal_subgroup[OF subgroups_Inter_pair[OF assms(1)assms(3)]])
   9.836 +    show "K1 \<inter> H \<lhd> G\<lparr>carrier := H \<inter> K\<rparr>"
   9.837 +      using normal_inter[OF assms(3)assms(1)assms(4)] by (simp add: inf_commute)
   9.838 +   next
   9.839 +    show "subgroup (K \<inter> H1) (G\<lparr>carrier := H \<inter> K\<rparr>)" 
   9.840 +      using subgroup_incl by (simp add: assms inf_commute normal_imp_subgroup normal_inter) 
   9.841 +  qed
   9.842 +  hence  "Gmod3  = Gmod4" using Hp Gmod4_def by simp
   9.843 +  hence "Gmod1 \<cong> Gmod2"
   9.844 +    using group.iso_sym group.iso_trans Hyp normal.factorgroup_is_group
   9.845 +    by (metis assms Gmod1_def Gmod2_def preliminary2)
   9.846 +  thus ?thesis using Gmod1_def Gmod2_def by (simp add: inf_commute)
   9.847 +qed
   9.848 +
   9.849 +end
    10.1 --- a/src/HOL/ROOT	Tue Jun 12 16:21:52 2018 +0200
    10.2 +++ b/src/HOL/ROOT	Tue Jun 12 16:09:12 2018 +0100
    10.3 @@ -302,6 +302,8 @@
    10.4      More_Group
    10.5      More_Finite_Product
    10.6      Multiplicative_Group
    10.7 +    Zassenhaus            (* The Zassenhaus lemma *)
    10.8 +
    10.9  
   10.10      (* Rings *)
   10.11      Divisibility         (* Rings *)