author paulson Tue Jun 12 16:09:12 2018 +0100 (12 days ago) changeset 68444 ff61cbfb3f2d 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.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.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.88 @@ -90,8 +84,7 @@
1.90    fixes G (structure)
1.91    shows "H <+> K \<equiv> \<Union>h\<in>H. \<Union>k\<in>K. {h \<oplus> k}"
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.111 +  rewrites "carrier (add_monoid G) =   carrier 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.127 +
1.128 +(*
1.139 +*)
1.140 +
1.141 +end
1.142 +
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.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.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.209 @@ -191,7 +211,7 @@
1.210
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.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.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.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.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.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.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.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.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.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.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.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.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.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.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.900 - apply (simp add: card_cosets_equal subgroup.subset)
3.901 +  apply (simp add: card_rcosets_equal subgroup_imp_subset)
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.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.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.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.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.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.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.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.146 +  rewrites "carrier (add_monoid G) = carrier 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.151
7.152 -context abelian_monoid begin
7.153 +context abelian_monoid
7.154 +begin
7.155
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.169 +  rewrites "carrier (add_monoid G) = carrier 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.189 +  rewrites "carrier (add_monoid G) = carrier 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.210 +  rewrites "carrier (add_monoid G) = carrier 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.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.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.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.450 +
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.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.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.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.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.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.565
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.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.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.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.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.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.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.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 *)
```