diff --git a/thys/Finitely_Generated_Abelian_Groups/DirProds.thy b/thys/Finitely_Generated_Abelian_Groups/DirProds.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/DirProds.thy
@@ -0,0 +1,659 @@
+(*
+    File:     DirProds.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Direct group product\<close>
+
+theory DirProds
+  imports Finite_Product_Extend Group_Hom Finite_And_Cyclic_Groups
+begin
+
+notation integer_mod_group ("Z")
+
+text \<open>The direct group product is defined component-wise and provided in an indexed way.\<close>
+
+definition DirProds :: "('a \<Rightarrow> ('b, 'c) monoid_scheme) \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'b) monoid" where
+  "DirProds G I = \<lparr> carrier = Pi\<^sub>E I (carrier \<circ> G),
+                   monoid.mult = (\<lambda>x y. restrict (\<lambda>i. x i \<otimes>\<^bsub>G i\<^esub> y i) I),
+                   one = restrict (\<lambda>i. \<one>\<^bsub>G i\<^esub>) I \<rparr>"
+
+text \<open>Basic lemmas about \<open>DirProds\<close>.\<close>
+
+lemma DirProds_empty:
+  "carrier (DirProds f {}) = {\<one>\<^bsub>DirProds f {}\<^esub>}"
+  unfolding DirProds_def by auto
+
+lemma DirProds_order:
+  assumes "finite I"
+  shows "order (DirProds G I) = prod (order \<circ> G) I"
+  unfolding order_def DirProds_def using assms by (simp add: card_PiE)
+
+lemma DirProds_in_carrI:
+  assumes "\<And>i. i \<in> I \<Longrightarrow> x i \<in> carrier (G i)" "\<And>i. i \<notin> I \<Longrightarrow> x i = undefined"
+  shows "x \<in> carrier (DirProds G I)"
+  unfolding DirProds_def using assms by auto
+
+lemma comp_in_carr:
+  assumes "x \<in> carrier (DirProds G I)" "i \<in> I"
+  shows "x i \<in> carrier (G i)"
+  using assms unfolding DirProds_def by auto
+
+lemma comp_mult:
+  assumes "i \<in> I"
+  shows "(x \<otimes>\<^bsub>DirProds G I\<^esub> y) i = (x i \<otimes>\<^bsub>G i\<^esub> y i)"
+  using assms unfolding DirProds_def by simp
+
+lemma comp_exp_nat:
+  fixes k::nat
+  assumes "i \<in> I"
+  shows "(x [^]\<^bsub>DirProds G I\<^esub> k) i = x i [^]\<^bsub>G i\<^esub> k"
+proof (induction k)
+  case 0
+  then show ?case using assms unfolding DirProds_def by simp
+next
+  case i: (Suc k)
+  have "(x [^]\<^bsub>DirProds G I\<^esub> k \<otimes>\<^bsub>DirProds G I\<^esub> x) i = (x [^]\<^bsub>DirProds G I\<^esub> k) i \<otimes>\<^bsub>G i\<^esub> x i"
+    by(rule comp_mult[OF assms])
+  also from i have "\<dots> = x i [^]\<^bsub>G i\<^esub> k \<otimes>\<^bsub>G i\<^esub> x i" by simp
+  also have "\<dots> = x i [^]\<^bsub>G i\<^esub> Suc k" by simp
+  finally show ?case by simp
+qed
+
+lemma DirProds_m_closed:
+  assumes "x \<in> carrier (DirProds G I)" "y \<in> carrier (DirProds G I)" "\<And>i. i \<in> I \<Longrightarrow> group (G i)"
+  shows "x \<otimes>\<^bsub>DirProds G I\<^esub> y \<in> carrier (DirProds G I)"
+  using assms monoid.m_closed[OF group.is_monoid[OF assms(3)]] unfolding DirProds_def by fastforce
+
+lemma partial_restr:
+  assumes "a \<in> carrier (DirProds G I)" "J \<subseteq> I"
+  shows "restrict a J \<in> carrier (DirProds G J)"
+  using assms unfolding DirProds_def by auto 
+
+lemma eq_parts_imp_eq:
+  assumes "a \<in> carrier (DirProds G I)" "b \<in> carrier (DirProds G I)" "\<And>i. i \<in> I \<Longrightarrow> a i = b i"
+  shows "a = b"
+  using assms unfolding DirProds_def by fastforce
+
+lemma mult_restr:
+  assumes "a \<in> carrier (DirProds G I)" "b \<in> carrier (DirProds G I)" "J \<subseteq> I"
+  shows "a \<otimes>\<^bsub>DirProds G J\<^esub> b = restrict (a \<otimes>\<^bsub>DirProds G I\<^esub> b) J"
+  using assms unfolding DirProds_def by force
+
+lemma DirProds_one:
+  assumes "x \<in> carrier (DirProds G I)"
+  shows "(\<forall>i \<in> I. x i = \<one>\<^bsub>G i\<^esub>) \<longleftrightarrow> x = \<one>\<^bsub>DirProds G I\<^esub>"
+  using assms unfolding DirProds_def by fastforce
+
+lemma DirProds_one':
+  "i\<in>I \<Longrightarrow> \<one>\<^bsub>DirProds G I\<^esub> i = \<one>\<^bsub>G i\<^esub>"
+  unfolding DirProds_def by simp
+
+lemma DirProds_one'':
+  "\<one>\<^bsub>DirProds G I\<^esub> = restrict (\<lambda>i. \<one>\<^bsub>G i\<^esub>) I"
+  by (unfold DirProds_def, simp)
+
+lemma DirProds_mult:
+  "(\<otimes>\<^bsub>DirProds G I\<^esub>) = (\<lambda>x y. restrict (\<lambda>i. x i \<otimes>\<^bsub>G i\<^esub> y i) I)"
+  unfolding DirProds_def by simp
+
+lemma DirProds_one_iso: "(\<lambda>x. x G) \<in> iso (DirProds f {G}) (f G)"
+proof (intro isoI homI)
+  show "bij_betw (\<lambda>x. x G) (carrier (DirProds f {G})) (carrier (f G))"
+  proof (unfold bij_betw_def, rule)
+    show "inj_on (\<lambda>x. x G) (carrier (DirProds f {G}))"
+      by (intro inj_onI, unfold DirProds_def PiE_def Pi_def extensional_def, fastforce)
+    show "(\<lambda>x. x G) ` carrier (DirProds f {G}) = carrier (f G)"
+    proof(intro equalityI subsetI)
+      show "x \<in> carrier (f G)" if "x \<in> (\<lambda>x. x G) ` carrier (DirProds f {G})" for x
+        using that unfolding DirProds_def by auto
+      show "x \<in> (\<lambda>x. x G) ` carrier (DirProds f {G})" if xc: "x \<in> carrier (f G)" for x
+      proof
+        show "(\<lambda>k\<in>{G}. x) \<in> carrier (DirProds f {G})" unfolding DirProds_def using xc by auto
+        moreover show "x = (\<lambda>k\<in>{G}. x) G" by simp
+      qed
+    qed
+  qed
+qed (unfold DirProds_def PiE_def Pi_def extensional_def, auto)
+
+lemma DirProds_one_cong: "(DirProds f {G}) \<cong> (f G)"
+  using DirProds_one_iso is_isoI by fast
+
+lemma DirProds_one_iso_sym: "(\<lambda>x. (\<lambda>_\<in>{G}. x)) \<in> iso (f G) (DirProds f {G})"
+proof (intro isoI homI)
+  show "bij_betw (\<lambda>x. \<lambda>_\<in>{G}. x) (carrier (f G)) (carrier (DirProds f {G}))"
+  proof (unfold bij_betw_def, rule)
+    show "inj_on (\<lambda>x. (\<lambda>_\<in>{G}. x)) (carrier (f G))"
+      by (intro inj_onI, metis imageI image_constant image_restrict_eq member_remove remove_def)
+    show "(\<lambda>x. (\<lambda>_\<in>{G}. x)) ` carrier (f G) = carrier (DirProds f {G})"
+      unfolding DirProds_def by fastforce
+  qed
+qed (unfold DirProds_def, auto)
+
+lemma DirProds_one_cong_sym: "(f G) \<cong> (DirProds f {G})"
+  using DirProds_one_iso_sym is_isoI by fast
+
+text \<open>The direct product is a group iff all factors are groups.\<close>
+
+lemma DirProds_is_group:
+  assumes "\<And>i. i \<in> I \<Longrightarrow> group (G i)"
+  shows "group (DirProds G I)"
+proof(rule groupI)
+  show one_closed: "\<one>\<^bsub>DirProds G I\<^esub> \<in> carrier (DirProds G I)" unfolding DirProds_def
+    by (simp add: assms group.is_monoid)
+  fix x
+  assume x: "x \<in> carrier (DirProds G I)"
+  have one_: "\<And>i. i \<in> I \<Longrightarrow> \<one>\<^bsub>G i\<^esub> = \<one>\<^bsub>DirProds G I\<^esub> i" unfolding DirProds_def by simp
+  have "\<And>i. i \<in> I \<Longrightarrow> \<one>\<^bsub>DirProds G I\<^esub> i \<otimes>\<^bsub>G i\<^esub> x i = x i"
+  proof -
+    fix i
+    assume i: "i \<in> I"
+    interpret group "G i" using assms[OF i] .
+    have "x i \<in> carrier (G i)" using x i comp_in_carr by fast
+    thus "\<one>\<^bsub>DirProds G I\<^esub> i \<otimes>\<^bsub>G i\<^esub> x i = x i" by(subst one_[OF i, symmetric]; simp)
+  qed
+  with one_ x show "\<one>\<^bsub>DirProds G I\<^esub> \<otimes>\<^bsub>DirProds G I\<^esub> x = x" unfolding DirProds_def by force
+  have "restrict (\<lambda>i. inv\<^bsub>G i\<^esub> (x i)) I \<in> carrier (DirProds G I)" using x group.inv_closed[OF assms]
+    unfolding DirProds_def by fastforce 
+  moreover have "restrict (\<lambda>i. inv\<^bsub>G i\<^esub> (x i)) I \<otimes>\<^bsub>DirProds G I\<^esub> x = \<one>\<^bsub>DirProds G I\<^esub>"
+    using x group.l_inv[OF assms] unfolding DirProds_def by fastforce
+  ultimately show "\<exists>y\<in>carrier (DirProds G I). y \<otimes>\<^bsub>DirProds G I\<^esub> x = \<one>\<^bsub>DirProds G I\<^esub>" by blast
+  fix y
+  assume y: "y \<in> carrier (DirProds G I)"
+  from DirProds_m_closed[OF x y assms] show m_closed: "x \<otimes>\<^bsub>DirProds G I\<^esub> y \<in> carrier (DirProds G I)"
+    by blast
+  fix z
+  assume z: "z \<in> carrier (DirProds G I)"
+  have "\<And>i. i \<in> I \<Longrightarrow> (x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z) i
+                    = (x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)) i"
+  proof -
+    fix i
+    assume i: "i \<in> I"
+    have "(x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z) i = (x \<otimes>\<^bsub>DirProds G I\<^esub> y) i \<otimes>\<^bsub>G i\<^esub> z i"
+      using assms by (simp add: comp_mult i m_closed z)
+    also have "\<dots> = x i \<otimes>\<^bsub>G i\<^esub> y i \<otimes>\<^bsub>G i\<^esub> z i" by (simp add: assms comp_mult i x y)
+    also have "\<dots> = x i \<otimes>\<^bsub>G i\<^esub> (y i \<otimes>\<^bsub>G i\<^esub> z i)" using i assms x y z
+      by (meson Group.group_def comp_in_carr monoid.m_assoc)
+    also have "\<dots> = (x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)) i" by (simp add: DirProds_def i)
+    finally show "(x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z) i
+                = (x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)) i" .
+  qed
+  thus "x \<otimes>\<^bsub>DirProds G I\<^esub> y \<otimes>\<^bsub>DirProds G I\<^esub> z = x \<otimes>\<^bsub>DirProds G I\<^esub> (y \<otimes>\<^bsub>DirProds G I\<^esub> z)"
+    unfolding DirProds_def by auto
+qed
+
+lemma DirProds_obtain_elem_carr:
+  assumes "group (DirProds G I)" "i \<in> I" "x \<in> carrier (G i)"
+  obtains k where "k \<in> carrier (DirProds G I)" "k i = x"
+proof -
+  interpret DP: group "DirProds G I" by fact
+  from comp_in_carr[OF DP.one_closed] DirProds_one' have ao: "\<forall>j\<in>I. \<one>\<^bsub>G j\<^esub> \<in> carrier (G j)" by metis
+  let ?r = "restrict ((\<lambda>j. \<one>\<^bsub>G j\<^esub>)(i := x)) I"
+  have "?r \<in> carrier (DirProds G I)"
+    unfolding DirProds_def PiE_def Pi_def using assms(2, 3) ao by auto
+  moreover have "?r i = x" using assms(2) by simp
+  ultimately show "(\<And>k. \<lbrakk>k \<in> carrier (DirProds G I); k i = x\<rbrakk> \<Longrightarrow> thesis) \<Longrightarrow> thesis" by blast
+qed
+
+lemma DirProds_group_imp_groups:
+  assumes "group (DirProds G I)" and i: "i \<in> I"
+  shows "group (G i)"
+proof (intro groupI)
+  let ?DP = "DirProds G I"
+  interpret DP: group ?DP by fact
+  show "\<one>\<^bsub>G i\<^esub> \<in> carrier (G i)" using DirProds_one' comp_in_carr[OF DP.one_closed i] i by metis
+  show "x \<otimes>\<^bsub>G i\<^esub> y \<in> carrier (G i)" if "x \<in> carrier (G i)" "y \<in> carrier (G i)" for x y
+  proof -
+    from DirProds_obtain_elem_carr[OF assms that(1)] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
+    from DirProds_obtain_elem_carr[OF assms that(2)] obtain l where l: "l \<in> carrier ?DP" "l i = y" .
+    have "k \<otimes>\<^bsub>?DP\<^esub> l \<in> carrier ?DP" using k l by fast
+    from comp_in_carr[OF this i] comp_mult[OF i] show ?thesis using k l by metis
+  qed
+  show "x \<otimes>\<^bsub>G i\<^esub> y \<otimes>\<^bsub>G i\<^esub> z = x \<otimes>\<^bsub>G i\<^esub> (y \<otimes>\<^bsub>G i\<^esub> z)"
+    if x: "x \<in> carrier (G i)" and y: "y \<in> carrier (G i)" and z: "z \<in> carrier (G i)" for x y z
+  proof -
+    from DirProds_obtain_elem_carr[OF assms x] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
+    from DirProds_obtain_elem_carr[OF assms y] obtain l where l: "l \<in> carrier ?DP" "l i = y" .
+    from DirProds_obtain_elem_carr[OF assms z] obtain m where m: "m \<in> carrier ?DP" "m i = z" .
+    have "x \<otimes>\<^bsub>G i\<^esub> y \<otimes>\<^bsub>G i\<^esub> z = (k i) \<otimes>\<^bsub>G i\<^esub> (l i) \<otimes>\<^bsub>G i\<^esub> (m i)" using k l m by argo
+    also have "\<dots> = (k \<otimes>\<^bsub>?DP\<^esub> l \<otimes>\<^bsub>?DP\<^esub> m) i" using comp_mult[OF i] k l m by metis
+    also have "\<dots> = (k \<otimes>\<^bsub>?DP\<^esub> (l \<otimes>\<^bsub>?DP\<^esub> m)) i"
+    proof -
+      have "k \<otimes>\<^bsub>?DP\<^esub> l \<otimes>\<^bsub>?DP\<^esub> m = k \<otimes>\<^bsub>?DP\<^esub> (l \<otimes>\<^bsub>?DP\<^esub> m)" using DP.m_assoc[OF k(1) l(1) m(1)] .
+      thus ?thesis by simp
+    qed
+    also have "\<dots> = (k i) \<otimes>\<^bsub>G i\<^esub> ((l i) \<otimes>\<^bsub>G i\<^esub> (m i))" using comp_mult[OF i] k l m by metis
+    finally show ?thesis using k l m by blast
+  qed
+  show "\<one>\<^bsub>G i\<^esub> \<otimes>\<^bsub>G i\<^esub> x = x" if "x \<in> carrier (G i)" for x
+  proof -
+    from DirProds_obtain_elem_carr[OF assms that(1)] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
+    hence "\<one>\<^bsub>?DP\<^esub> \<otimes>\<^bsub>?DP\<^esub> k = k" by simp
+    with comp_mult k DirProds_one[OF DP.one_closed] that i show ?thesis by metis
+  qed
+  show "\<exists>y\<in>carrier (G i). y \<otimes>\<^bsub>G i\<^esub> x = \<one>\<^bsub>G i\<^esub>" if "x \<in> carrier (G i)" for x
+  proof -
+    from DirProds_obtain_elem_carr[OF assms that(1)] obtain k where k: "k \<in> carrier ?DP" "k i = x" .
+    hence ic: "inv\<^bsub>?DP\<^esub> k \<in> carrier ?DP" by simp
+    have "inv\<^bsub>?DP\<^esub> k \<otimes>\<^bsub>?DP\<^esub> k = \<one>\<^bsub>?DP\<^esub>" using k by simp
+    hence "(inv\<^bsub>?DP\<^esub> k) i \<otimes>\<^bsub>G i\<^esub> k i= \<one>\<^bsub>G i\<^esub>" using comp_mult[OF i] DirProds_one'[OF i] by metis
+    with k(2) comp_in_carr[OF ic i] show ?thesis by blast
+  qed
+qed
+
+lemma DirProds_group_iff: "group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. group (G i))"
+  using DirProds_is_group DirProds_group_imp_groups by metis
+
+lemma comp_inv:
+  assumes "group (DirProds G I)" and x: "x \<in> carrier (DirProds G I)" and i: "i \<in> I"
+  shows "(inv\<^bsub>(DirProds G I)\<^esub> x) i = inv\<^bsub>(G i)\<^esub> (x i)"
+proof -
+  interpret DP: group "DirProds G I" by fact
+  interpret Gi: group "G i" using DirProds_group_imp_groups[OF DP.is_group i] .
+  have ixc: "inv\<^bsub>(DirProds G I)\<^esub> x \<in> carrier (DirProds G I)" using x by blast
+  hence "inv\<^bsub>(DirProds G I)\<^esub> x \<otimes>\<^bsub>DirProds G I\<^esub> x = \<one>\<^bsub>DirProds G I\<^esub>" using x by simp
+  hence "(inv\<^bsub>(DirProds G I)\<^esub> x \<otimes>\<^bsub>DirProds G I\<^esub> x) i = \<one>\<^bsub>G i\<^esub>" by (simp add: DirProds_one' i)
+  moreover from comp_mult[OF i]
+  have "(inv\<^bsub>(DirProds G I)\<^esub> x \<otimes>\<^bsub>DirProds G I\<^esub> x) i = ((inv\<^bsub>(DirProds G I)\<^esub> x) i) \<otimes>\<^bsub>G i\<^esub> (x i)"
+    by blast
+  ultimately show ?thesis using x ixc by (simp add: comp_in_carr[OF _ i] group.inv_equality)
+qed
+
+text \<open>The same is true for abelian groups.\<close>
+
+lemma DirProds_is_comm_group:
+  assumes "\<And>i. i \<in> I \<Longrightarrow> comm_group (G i)"
+  shows "comm_group (DirProds G I)" (is "comm_group ?DP")
+proof
+  interpret group ?DP using assms DirProds_is_group unfolding comm_group_def by metis
+  show "carrier ?DP \<subseteq> Units ?DP" "\<one>\<^bsub>?DP\<^esub> \<in> carrier ?DP" by simp_all
+  fix x
+  assume x[simp]: "x \<in> carrier ?DP"
+  show "\<one>\<^bsub>?DP\<^esub> \<otimes>\<^bsub>?DP\<^esub> x = x" "x \<otimes>\<^bsub>?DP\<^esub> \<one>\<^bsub>?DP\<^esub> = x" by simp_all
+  fix y
+  assume y[simp]: "y \<in> carrier ?DP"
+  show "x \<otimes>\<^bsub>?DP\<^esub> y \<in> carrier ?DP" by simp
+  show "x \<otimes>\<^bsub>DirProds G I\<^esub> y = y \<otimes>\<^bsub>DirProds G I\<^esub> x"
+  proof (rule eq_parts_imp_eq[of _ G I])
+    show "x \<otimes>\<^bsub>?DP\<^esub> y \<in> carrier ?DP" by simp
+    show "y \<otimes>\<^bsub>?DP\<^esub> x \<in> carrier ?DP" by simp
+    show "\<And>i. i\<in>I \<Longrightarrow> (x \<otimes>\<^bsub>DirProds G I\<^esub> y) i = (y \<otimes>\<^bsub>DirProds G I\<^esub> x) i"
+    proof -
+      fix i
+      assume i: "i \<in> I"
+      interpret gi: comm_group "(G i)" using assms(1)[OF i] .
+      have "(x \<otimes>\<^bsub>?DP\<^esub> y) i = x i \<otimes>\<^bsub>G i\<^esub> y i"
+        by (intro comp_mult[OF i])
+      also have "\<dots> = y i \<otimes>\<^bsub>G i\<^esub> x i" using comp_in_carr[OF _ i] x y gi.m_comm by metis
+      also have "\<dots> = (y \<otimes>\<^bsub>?DP\<^esub> x) i" by (intro comp_mult[symmetric, OF i])
+      finally show "(x \<otimes>\<^bsub>DirProds G I\<^esub> y) i = (y \<otimes>\<^bsub>DirProds G I\<^esub> x) i" .
+    qed
+  qed
+  fix z
+  assume z[simp]: "z \<in> carrier ?DP"
+  show "x \<otimes>\<^bsub>?DP\<^esub> y \<otimes>\<^bsub>?DP\<^esub> z = x \<otimes>\<^bsub>?DP\<^esub> (y \<otimes>\<^bsub>?DP\<^esub> z)" using m_assoc by simp
+qed
+
+lemma DirProds_comm_group_imp_comm_groups:
+  assumes "comm_group (DirProds G I)" and i: "i \<in> I"
+  shows "comm_group (G i)"
+proof -
+  interpret DP: comm_group "DirProds G I" by fact
+  interpret Gi: group "G i" using DirProds_group_imp_groups[OF DP.is_group i] .
+  show "comm_group (G i)"
+  proof
+    show "x \<otimes>\<^bsub>G i\<^esub> y = y \<otimes>\<^bsub>G i\<^esub> x" if x: "x \<in> carrier (G i)" and y: "y \<in> carrier (G i)" for x y
+    proof -
+      obtain a where a[simp]: "a \<in> carrier (DirProds G I)" "a i = x"
+        using DirProds_obtain_elem_carr[OF DP.is_group i x] .
+      obtain b where b[simp]: "b \<in> carrier (DirProds G I)" "b i = y"
+        using DirProds_obtain_elem_carr[OF DP.is_group i y] .
+      have "a \<otimes>\<^bsub>DirProds G I\<^esub> b = b \<otimes>\<^bsub>DirProds G I\<^esub> a" using DP.m_comm by simp
+      hence "(a \<otimes>\<^bsub>DirProds G I\<^esub> b) i = (b \<otimes>\<^bsub>DirProds G I\<^esub> a) i" by argo
+      with comp_mult[OF i] have "a i \<otimes>\<^bsub>G i\<^esub> b i = b i \<otimes>\<^bsub>G i\<^esub> a i" by metis
+      with a b show "x \<otimes>\<^bsub>G i\<^esub> y = y \<otimes>\<^bsub>G i\<^esub> x" by blast
+    qed
+  qed
+qed
+
+lemma DirProds_comm_group_iff: "comm_group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. comm_group (G i))"
+  using DirProds_is_comm_group DirProds_comm_group_imp_comm_groups by metis
+
+text \<open>And also for finite groups.\<close>
+
+lemma DirProds_is_finite_group:
+  assumes "\<And>i. i\<in>I \<Longrightarrow> finite_group (G i)" "finite I"
+  shows "finite_group (DirProds G I)"
+proof -
+  have "group (G i)" if "i\<in>I" for i using assms(1)[OF that] unfolding finite_group_def by blast
+  from DirProds_is_group[OF this] interpret DP: group "DirProds G I" by fast
+  show ?thesis
+  proof(unfold_locales)
+    have "order (DirProds G I) \<noteq> 0"
+    proof(unfold DirProds_order[OF assms(2)])
+      have "(order \<circ> G) i \<noteq> 0" if "i\<in>I" for i
+        using assms(1)[OF that] by (simp add: finite_group.order_gt_0)
+      thus "prod (order \<circ> G) I \<noteq> 0" by (simp add: assms(2))
+    qed
+    thus "finite (carrier (DirProds G I))" unfolding order_def by (meson card.infinite)
+  qed
+qed
+
+lemma DirProds_finite_imp_finite_groups:
+  assumes "finite_group (DirProds G I)" "finite I"
+  shows "\<And>i. i\<in>I \<Longrightarrow> finite_group (G i)"
+proof -
+  fix i assume i: "i \<in> I"
+  interpret DP: finite_group "DirProds G I" by fact
+  interpret group "G i" by (rule DirProds_group_imp_groups[OF DP.is_group i])
+  show "finite_group (G i)"
+  proof(unfold_locales)
+    have oDP: "order (DirProds G I) \<noteq> 0" by blast
+    with DirProds_order[OF assms(2), of G] have "order (G i) \<noteq> 0" using i assms(2) by force
+    thus "finite (carrier (G i))" unfolding order_def by (meson card_eq_0_iff)
+  qed
+qed
+
+lemma DirProds_finite_group_iff:
+  assumes "finite I"
+  shows "finite_group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. finite_group (G i))"
+  using DirProds_is_finite_group DirProds_finite_imp_finite_groups assms by metis
+
+lemma DirProds_finite_comm_group_iff:
+  assumes "finite I"
+  shows "finite_comm_group (DirProds G I) \<longleftrightarrow> (\<forall>i\<in>I. finite_comm_group (G i))"
+  using DirProds_finite_group_iff[OF assms] DirProds_comm_group_iff unfolding finite_comm_group_def by fast
+
+text \<open>If a group is an internal direct product of a family of subgroups, it is isomorphic to the
+direct product of these subgroups.\<close>
+
+lemma (in comm_group) subgroup_iso_DirProds_IDirProds:
+  assumes "subgroup J G" "is_idirprod J S I" "finite I"
+  shows "(\<lambda>x. \<Otimes>\<^bsub>G\<^esub>i\<in>I. x i) \<in> iso (DirProds (\<lambda>i. G\<lparr>carrier := (S i)\<rparr>) I) (G\<lparr>carrier := J\<rparr>)"
+(is "?fp \<in> iso ?DP ?J")
+proof -
+  from assms(2) have assm: "J = IDirProds G S I"
+                           "compl_fam S I"
+    unfolding is_idirprod_def by auto
+  from assms(1, 2) have assm': "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) (G\<lparr>carrier := J\<rparr>)"
+    using normal_imp_subgroup subgroup_incl by (metis IDirProds_incl assms(2) is_idirprod_def)
+  interpret J: comm_group ?J using subgroup_is_comm_group[OF assms(1)] .
+  interpret DP: comm_group ?DP
+    by (intro DirProds_is_comm_group; use J.subgroup_is_comm_group[OF assm'] in simp)
+  have inJ: "S i \<subseteq> J" if "i \<in> I" for i using subgroup.subset[OF assm'[OF that]] by simp
+  have hom: "?fp \<in> hom ?DP ?J"
+  proof (rule homI)
+    fix x
+    assume x[simp]: "x \<in> carrier ?DP"
+    show "finprod G x I \<in> carrier ?J"
+    proof (subst finprod_subgroup[OF _ assms(1)])
+      show "x \<in> I \<rightarrow> J" using inJ comp_in_carr[OF x] by auto
+      thus "finprod ?J x I \<in> carrier ?J" by (intro J.finprod_closed; simp)
+    qed
+    fix y
+    assume y[simp]: "y \<in> carrier ?DP"
+    show "finprod G (x \<otimes>\<^bsub>?DP\<^esub> y) I = finprod G x I \<otimes>\<^bsub>?J\<^esub> finprod G y I"
+    proof(subst (1 2 3) finprod_subgroup[of _ _ J])
+      show xyJ: "x \<in> I \<rightarrow> J" "y \<in> I \<rightarrow> J" using x y inJ comp_in_carr[OF x] comp_in_carr[OF y]
+        by auto
+      show xyJ1: "x \<otimes>\<^bsub>?DP\<^esub> y \<in> I \<rightarrow> J" using inJ x y comp_in_carr[of "x \<otimes>\<^bsub>?DP\<^esub> y"] by fastforce
+      show "subgroup J G" using assms(1) .
+      show "finprod ?J (x \<otimes>\<^bsub>?DP\<^esub> y) I = finprod ?J x I \<otimes>\<^bsub>?J\<^esub> finprod ?J y I"
+      proof (rule J.finprod_cong_split)
+        show "x \<in> I \<rightarrow> carrier ?J" "y \<in> I \<rightarrow> carrier ?J" using xyJ by simp_all
+        show "x \<otimes>\<^bsub>?DP\<^esub> y \<in> I \<rightarrow> carrier ?J" using xyJ1 by simp
+        fix i
+        assume i: "i \<in> I"
+        then have "x i \<otimes>\<^bsub>G\<lparr>carrier := (S i) \<rparr>\<^esub> y i = (x \<otimes>\<^bsub>?DP\<^esub> y) i"
+          by (intro comp_mult[symmetric])
+        thus "x i \<otimes>\<^bsub>?J\<^esub> y i = (x \<otimes>\<^bsub>?DP\<^esub> y) i" by simp
+      qed
+    qed
+  qed
+  then interpret fp: group_hom ?DP ?J ?fp unfolding group_hom_def group_hom_axioms_def by blast
+  have s: "subgroup (S i) G" if "i \<in> I" for i using incl_subgroup[OF assms(1) assm'[OF that]] .
+  have "kernel ?DP ?J ?fp = {\<one>\<^bsub>?DP\<^esub>}"
+  proof -
+    have "a = \<one>\<^bsub>?DP\<^esub>" if "a \<in> kernel ?DP ?J ?fp" for a
+    proof -
+      from that have a: "finprod G a I = \<one>" "a \<in> carrier ?DP" unfolding kernel_def by simp_all
+      from compl_fam_imp_triv_finprod[OF assm(2) assms(3) s a(1)] comp_in_carr[OF a(2)]
+      have "\<forall>i\<in>I. a i = \<one>" by simp
+      then show ?thesis using DirProds_one[OF a(2)] by fastforce
+    qed
+    thus ?thesis using fp.one_in_kernel by blast
+  qed
+  moreover have "J \<subseteq> ?fp ` carrier ?DP"
+    using assm(1) IDirProds_eq_finprod_PiE[OF assms(3) incl_subgroup[OF assms(1) assm']]
+    unfolding DirProds_def PiE_def Pi_def by simp
+  ultimately show ?thesis using hom fp.iso_iff unfolding kernel_def by auto
+qed
+
+lemma (in comm_group) iso_DirProds_IDirProds:
+  assumes "is_idirprod (carrier G) S I" "finite I"
+  shows "(\<lambda>x. \<Otimes>\<^bsub>G\<^esub>i\<in>I. x i) \<in> iso (DirProds (\<lambda>i. G\<lparr>carrier := (S i)\<rparr>) I) G"
+  using subgroup_iso_DirProds_IDirProds[OF subgroup_self assms(1, 2)] by auto
+
+lemma (in comm_group) cong_DirProds_IDirProds:
+  assumes "is_idirprod (carrier G) S I" "finite I"
+  shows "DirProds (\<lambda>i. G\<lparr>carrier := (S i)\<rparr>) I \<cong> G"
+  by (intro is_isoI, use iso_DirProds_IDirProds[OF assms] in blast)
+
+text \<open>In order to prove the isomorphism between two direct products, the following lemmas provide
+some criterias.\<close>
+
+lemma DirProds_iso:
+  assumes "bij_betw f I J" "\<And>i. i\<in>I \<Longrightarrow> Gs i \<cong> Hs (f i)"
+          "\<And>i. i\<in>I \<Longrightarrow> group (Gs i)" "\<And>j. j\<in>J \<Longrightarrow> group (Hs j)"
+  shows "DirProds Gs I \<cong> DirProds Hs J"
+proof -
+  interpret DG: group "DirProds Gs I" using DirProds_is_group assms(3) by blast
+  interpret DH: group "DirProds Hs J" using DirProds_is_group assms(4) by blast
+  from assms(1) obtain g where g: "g = inv_into I f" "bij_betw g J I" by (meson bij_betw_inv_into)
+  hence fgi: "\<And>i. i \<in> I \<Longrightarrow> g (f i) = i" "\<And>j. j \<in> J \<Longrightarrow> f (g j) = j"
+    using assms(1) bij_betw_inv_into_left[OF assms(1)] bij_betw_inv_into_right[OF assms(1)] by auto
+  from assms(2) have "\<And>i. i \<in> I \<Longrightarrow> (\<exists>h. h \<in> iso (Gs i) (Hs (f i)))" unfolding is_iso_def by blast
+  then obtain h where h: "\<And>i. i \<in> I \<Longrightarrow> h i \<in> iso (Gs i) (Hs (f i))" by metis
+  let ?h = "(\<lambda>x. (\<lambda>j. if j\<in>J then (h (g j)) (x (g j)) else undefined))"
+  have hc: "?h x \<in> carrier (DirProds Hs J)" if "x \<in> carrier (DirProds Gs I)" for x
+  proof -
+    have xc: "x \<in> carrier (DirProds Gs I)" by fact
+    have "h (g j) (x (g j)) \<in> carrier (Hs j)" if "j \<in> J" for j
+    proof(intro iso_in_carr[OF _ comp_in_carr[OF xc], of "h (g j)" "g j" "Hs j"])
+      show "g j \<in> I" using g(2)[unfolded bij_betw_def] that by blast
+      from h[OF this] show "h (g j) \<in> Group.iso (Gs (g j)) (Hs j)" using fgi(2)[OF that] by simp
+    qed
+    thus ?thesis using xc unfolding DirProds_def PiE_def extensional_def by auto
+  qed
+  moreover have "?h (x \<otimes>\<^bsub>DirProds Gs I\<^esub> y)= ?h x \<otimes>\<^bsub>DirProds Hs J\<^esub> ?h y"
+    if "x \<in> carrier (DirProds Gs I)" "y \<in> carrier (DirProds Gs I)" for x y
+  proof(intro eq_parts_imp_eq[OF hc[OF DG.m_closed[OF that]] DH.m_closed[OF hc[OF that(1)] hc[OF that(2)]]])
+    fix j
+    assume j: "j \<in> J"
+    hence gj: "g j \<in> I" using g unfolding bij_betw_def by blast
+    from assms(3)[OF gj] assms(4)[OF j] have g: "group (Gs (g j))" "Group.group (Hs j)" .
+    from iso_imp_homomorphism[OF h[OF gj]] fgi(2)[OF j] g
+    interpret hjh: group_hom "Gs (g j)" "Hs j" "h (g j)"
+      unfolding group_hom_def group_hom_axioms_def by simp
+    show "(?h (x \<otimes>\<^bsub>DirProds Gs I\<^esub> y)) j = (?h x \<otimes>\<^bsub>DirProds Hs J\<^esub> ?h y) j"
+    proof(subst comp_mult)
+      show "(if j \<in> J then h (g j) (x (g j) \<otimes>\<^bsub>Gs (g j)\<^esub> y (g j)) else undefined)
+          = (?h x \<otimes>\<^bsub>DirProds Hs J\<^esub> ?h y) j"
+      proof(subst comp_mult)
+        have "h (g j) (x (g j) \<otimes>\<^bsub>Gs (g j)\<^esub> y (g j)) = h (g j) (x (g j)) \<otimes>\<^bsub>Hs j\<^esub> h (g j) (y (g j))"
+          using comp_in_carr[OF that(1) gj] comp_in_carr[OF that(2) gj] by simp
+        thus "(if j \<in> J then h (g j) (x (g j) \<otimes>\<^bsub>Gs (g j)\<^esub> y (g j)) else undefined) =
+              (if j \<in> J then h (g j) (x (g j)) else undefined)
+      \<otimes>\<^bsub>Hs j\<^esub> (if j \<in> J then h (g j) (y (g j)) else undefined)"
+          using j by simp
+      qed (use j g that hc in auto)
+    qed (use gj g that in auto)
+  qed
+  ultimately interpret hgh: group_hom "DirProds Gs I" "DirProds Hs J" ?h
+    unfolding group_hom_def group_hom_axioms_def by (auto intro: homI)
+  have "carrier (DirProds Hs J) \<subseteq> ?h ` carrier (DirProds Gs I)"
+  proof
+    show "x \<in> ?h ` carrier (DirProds Gs I)" if xc: "x \<in> carrier (DirProds Hs J)" for x
+    proof -
+      from h obtain k where k: "\<And>i. i\<in>I \<Longrightarrow> k i = inv_into (carrier (Gs i)) (h i)" by fast
+      hence kiso: "\<And>i. i\<in>I \<Longrightarrow> k i \<in> iso (Hs (f i)) (Gs i)"
+        using h by (simp add: assms(3) group.iso_set_sym)
+      hence hk: "y = (h (g j) \<circ> (k (g j))) y" if "j \<in> J" "y \<in> carrier (Hs j)" for j y
+      proof -
+        have gj: "g j \<in> I" using that g[unfolded bij_betw_def] by blast
+        thus ?thesis
+          using h[OF gj, unfolded iso_def] k[OF gj] that fgi(2)[OF that(1)] bij_betw_inv_into_right
+          unfolding comp_def by fastforce
+      qed
+      let ?k = "(\<lambda>i. if i\<in>I then k i else (\<lambda>_. undefined))"
+      let ?y = "(\<lambda>i. (?k i) (x (f i)))"
+      have "x j = (\<lambda>j. if j \<in> J then h (g j) (?y (g j)) else undefined) j" for j
+      proof (cases "j \<in> J")
+        case True
+        thus ?thesis using hk[OF True comp_in_carr[OF that True]]
+                           fgi(2)[OF True] g[unfolded bij_betw_def] by auto
+      next
+        case False
+        thus ?thesis using that[unfolded DirProds_def] by auto
+      qed
+      moreover have "?y \<in> carrier (DirProds Gs I)"
+      proof -
+        have "?y i \<in> carrier (Gs i)" if i: "i \<in> I" for i
+          using k[OF i] h[OF i] comp_in_carr[OF xc] assms(1) bij_betwE iso_in_carr kiso that
+          by fastforce
+        moreover have "?y i = undefined" if i: "i \<notin> I" for i using i by simp
+        ultimately show ?thesis unfolding DirProds_def PiE_def Pi_def extensional_def by simp
+      qed
+      ultimately show ?thesis by fast
+    qed
+  qed
+  moreover have "x = \<one>\<^bsub>DirProds Gs I\<^esub>"
+    if "x \<in> carrier (DirProds Gs I)" "?h x = \<one>\<^bsub>DirProds Hs J\<^esub>" for x
+  proof -
+    have "\<forall>i\<in>I. x i = \<one>\<^bsub>Gs i\<^esub>"
+    proof
+      fix i
+      assume i: "i \<in> I"
+      interpret gi: group "Gs i" using assms(3)[OF i] .
+      interpret hfi: group "Hs (f i)" using assms(4) i assms(1)[unfolded bij_betw_def] by blast
+      from h[OF i] interpret hi: group_hom "(Gs i)" "Hs (f i)" "h i"
+        unfolding group_hom_def group_hom_axioms_def iso_def by blast
+      from that have hx: "?h x \<in> carrier (DirProds Hs J)" by simp
+      from DirProds_one[OF this] that(2)
+      have "(if j \<in> J then h (g j) (x (g j)) else undefined) = \<one>\<^bsub>Hs j\<^esub>" if "j \<in> J" for j
+        using that by blast
+      hence "h (g (f i)) (x (g (f i))) = \<one>\<^bsub>Hs (f i)\<^esub>" using i assms(1)[unfolded bij_betw_def] by auto
+      hence "h i (x i) = \<one>\<^bsub>Hs (f i)\<^esub>" using fgi(1)[OF i] by simp
+      with hi.iso_iff h[OF i] comp_in_carr[OF that(1) i] show "x i = \<one>\<^bsub>Gs i\<^esub>" by fast
+    qed
+    with DirProds_one that show ?thesis using assms(3) by blast
+  qed
+  ultimately show ?thesis unfolding is_iso_def using hgh.iso_iff by blast
+qed
+
+lemma DirProds_iso1:
+  assumes "\<And>i. i\<in>I \<Longrightarrow> Gs i \<cong> (f \<circ> Gs) i" "\<And>i. i\<in>I \<Longrightarrow> group (Gs i)" "\<And>i. i\<in>I \<Longrightarrow> group ((f \<circ> Gs) i)"
+  shows "DirProds Gs I \<cong> DirProds (f \<circ> Gs) I"
+proof -
+  interpret DP: group "DirProds Gs I" using DirProds_is_group assms by metis
+  interpret fDP: group "DirProds (f \<circ> Gs) I" using DirProds_is_group assms by metis
+  from assms have "\<forall>i\<in>I. (\<exists>g. g \<in> iso (Gs i) ((f \<circ> Gs) i))" unfolding is_iso_def by blast
+  then obtain J where J: "\<forall>i\<in>I. J i \<in> iso (Gs i) ((f \<circ> Gs) i)" by metis
+  let ?J = "(\<lambda>i. if i\<in>I then J i else (\<lambda>_. undefined))"
+  from J obtain K where K: "\<forall>i\<in>I. K i = inv_into (carrier (Gs i)) (J i)" by fast
+  hence K_iso: "\<forall>i\<in>I. K i \<in> iso ((f \<circ> Gs) i) (Gs i)" using group.iso_set_sym assms J by metis
+  let ?K = "(\<lambda>i. if i\<in>I then K i else (\<lambda>_. undefined))"
+  have JKi: "(?J i) ((?K i) (x i)) = x i" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" for i x
+  proof -
+    have "(J i) ((K i) (x i)) = x i" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" "i \<in> I" for i x
+    proof -
+      from J that have "(J i) ` (carrier (Gs i)) = carrier ((f \<circ> Gs) i)"
+        unfolding iso_def bij_betw_def by blast
+      hence "\<exists>y. y \<in> carrier (Gs i) \<and> (J i) y = x i" using that by (metis comp_in_carr imageE)
+      with someI_ex[OF this] that show "(J i) ((K i) (x i)) = x i"
+        using K J K_iso unfolding inv_into_def by auto
+    qed
+    moreover have "(?J i) ((K i) (x i)) = x i" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" "i \<notin> I" for i x
+      using that unfolding DirProds_def PiE_def extensional_def by force
+    ultimately show ?thesis using that by simp
+  qed
+  let ?r = "(\<lambda>e. restrict (\<lambda>i. ?J i (e i)) I)"
+  have hom: "?r \<in> hom (DirProds Gs I) (DirProds (f \<circ> Gs) I)"
+  proof (intro homI)
+    show "?r x \<in> carrier (DirProds (f \<circ> Gs) I)" if "x \<in> carrier (DirProds Gs I)" for x
+      using that J comp_in_carr[OF that] unfolding DirProds_def iso_def bij_betw_def by fastforce
+    show "?r (x \<otimes>\<^bsub>DirProds Gs I\<^esub> y) = ?r x \<otimes>\<^bsub>DirProds (f \<circ> Gs) I\<^esub> ?r y"
+      if "x \<in> carrier (DirProds Gs I)" "y \<in> carrier (DirProds Gs I)" for x y
+      using that J comp_in_carr[OF that(1)] comp_in_carr[OF that(2)]
+      unfolding DirProds_def iso_def hom_def by force
+  qed
+  then interpret r: group_hom "(DirProds Gs I)" "(DirProds (f \<circ> Gs) I)" ?r
+    unfolding group_hom_def group_hom_axioms_def by blast
+  have "carrier (DirProds (f \<circ> Gs) I) \<subseteq> ?r ` carrier (DirProds Gs I)"
+  proof
+    show "x \<in> ?r ` carrier (DirProds Gs I)" if "x \<in> carrier (DirProds (f \<circ> Gs) I)" for x
+    proof
+      show "x = (\<lambda>i\<in>I. ?J i ((?K i) (x i)))"
+        using JKi[OF that] that unfolding DirProds_def PiE_def by (simp add: extensional_restrict)
+      show "(\<lambda>i. ?K i (x i)) \<in> carrier (DirProds Gs I)" using K_iso iso_in_carr that
+        unfolding DirProds_def PiE_def Pi_def extensional_def by fastforce
+    qed
+  qed
+  moreover have "x = \<one>\<^bsub>DirProds Gs I\<^esub>"
+    if "x \<in> carrier (DirProds Gs I)" "?r x = \<one>\<^bsub>DirProds (f \<circ> Gs) I\<^esub>" for x
+  proof -
+    have "\<forall>i\<in>I. x i = \<one>\<^bsub>Gs i\<^esub>"
+    proof
+      fix i
+      assume i: "i \<in> I"
+      with J assms interpret Ji: group_hom "(Gs i)" "(f \<circ> Gs) i" "J i"
+        unfolding group_hom_def group_hom_axioms_def iso_def by blast
+      from that have rx: "?r x \<in> carrier (DirProds (f \<circ> Gs) I)" by simp
+      from i DirProds_one[OF this] that
+      have "(\<lambda>i\<in>I. (if i \<in> I then J i else (\<lambda>_. undefined)) (x i)) i = \<one>\<^bsub>(f \<circ> Gs) i\<^esub>" by blast
+      hence "(J i) (x i) = \<one>\<^bsub>(f \<circ> Gs) i\<^esub>" using i by simp
+      with Ji.iso_iff mp[OF spec[OF J[unfolded Ball_def]] i] comp_in_carr[OF that(1) i]
+      show "x i = \<one>\<^bsub>Gs i\<^esub>" by fast
+    qed
+    with DirProds_one[OF that(1)] show ?thesis by blast
+  qed
+  ultimately show ?thesis unfolding is_iso_def using r.iso_iff by blast
+qed
+
+lemma DirProds_iso2:
+  assumes "inj_on f A" "group (DirProds g (f ` A))"
+  shows "DirProds (g \<circ> f) A \<cong> DirProds g (f ` A)"
+proof (intro DirProds_iso[of f])
+  show "bij_betw f A (f ` A)" using assms(1) unfolding bij_betw_def by blast
+  show "\<And>i. i \<in> A \<Longrightarrow> (g \<circ> f) i \<cong> g (f i)" unfolding comp_def using iso_refl by simp
+  from assms(2) show "\<And>i. i \<in> (f ` A) \<Longrightarrow> group (g i)" using DirProds_group_imp_groups by fast
+  with assms(1) show "\<And>i. i \<in> A \<Longrightarrow> group ((g \<circ> f) i)" by auto
+qed
+
+text \<open>The direct group product distributes when nested.\<close>
+
+lemma DirProds_Sigma:
+  "DirProds (\<lambda>i. DirProds (G i) (J i)) I \<cong> DirProds (\<lambda>(i,j). G i j) (Sigma I J)" (is "?L \<cong> ?R")
+proof (intro is_isoI isoI)
+  let ?f = "\<lambda>x. restrict (case_prod x) (Sigma I J)"
+  show hom: "?f \<in> hom ?L ?R"
+  proof(intro homI)
+    show "?f a \<in> carrier ?R" if "a \<in> carrier ?L" for a
+      using that unfolding DirProds_def PiE_def Pi_def extensional_def by auto
+    show "?f (a \<otimes>\<^bsub>?L\<^esub> b) = ?f a \<otimes>\<^bsub>?R\<^esub> ?f b" if "a \<in> carrier ?L" and "b \<in> carrier ?L" for a b
+      using that unfolding DirProds_def PiE_def Pi_def extensional_def by auto
+  qed
+  show "bij_betw ?f (carrier ?L) (carrier ?R)"
+  proof (intro bij_betwI)
+    let ?g = "\<lambda>x. (\<lambda>i. if i\<in>I then (\<lambda>j. if j\<in>(J i) then x(i, j) else undefined) else undefined)"
+    show "?f \<in> carrier ?L \<rightarrow> carrier ?R" unfolding DirProds_def by fastforce
+    show "?g \<in> carrier ?R \<rightarrow> carrier ?L" unfolding DirProds_def by fastforce
+    show "?f (?g x) = x" if "x \<in> carrier ?R" for x
+      using that unfolding DirProds_def PiE_def Pi_def extensional_def by auto
+    show "?g (?f x) = x" if "x \<in> carrier ?L" for x
+      using that unfolding DirProds_def PiE_def Pi_def extensional_def by force
+  qed
+qed
+
+no_notation integer_mod_group ("Z")
+
+end
diff --git a/thys/Finitely_Generated_Abelian_Groups/Finite_And_Cyclic_Groups.thy b/thys/Finitely_Generated_Abelian_Groups/Finite_And_Cyclic_Groups.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Finite_And_Cyclic_Groups.thy
@@ -0,0 +1,587 @@
+(*
+    File:     Finite_And_Cyclic_Groups.thy
+    Author:   Joseph Thommes, TU München; Manuel Eberl, TU München
+*)
+section \<open>Finite and cyclic groups\<close>
+
+theory Finite_And_Cyclic_Groups
+  imports Group_Hom Generated_Groups_Extend General_Auxiliary
+begin
+
+subsection \<open>Finite groups\<close>
+
+text \<open>We define the notion of finite groups and prove some trivial facts about them.\<close>
+
+locale finite_group = group +
+  assumes fin[simp]: "finite (carrier G)"
+
+(* Manuel Eberl *)
+lemma (in finite_group) ord_pos: 
+  assumes "x \<in> carrier G"
+  shows   "ord x > 0"
+  using ord_ge_1[of x] assms by auto
+
+lemma (in finite_group) order_gt_0 [simp,intro]: "order G > 0"
+  by (subst order_gt_0_iff_finite) auto
+
+lemma (in finite_group) finite_ord_conv_Least:
+  assumes "x \<in> carrier G"
+  shows "ord x = (LEAST n::nat. 0 < n \<and> x [^] n = \<one>)"
+  using pow_order_eq_1 order_gt_0_iff_finite ord_conv_Least assms by auto
+
+lemma (in finite_group) non_trivial_group_ord_gr_1:
+  assumes "carrier G \<noteq> {\<one>}"
+  shows "\<exists>e \<in> carrier G. ord e > 1"
+proof -
+  from one_closed obtain e where e: "e \<noteq> \<one>" "e \<in> carrier G" using assms carrier_not_empty by blast
+  thus ?thesis using ord_eq_1[of e] le_neq_implies_less ord_ge_1 by fastforce
+qed
+
+(* Manuel Eberl *)
+lemma (in finite_group) max_order_elem:
+  obtains a where "a \<in> carrier G" "\<forall>x \<in> carrier G. ord x \<le> ord a"
+proof -
+  have "\<exists>x. x \<in> carrier G \<and> (\<forall>y. y \<in> carrier G \<longrightarrow> ord y \<le> ord x)"
+  proof (rule ex_has_greatest_nat[of _ \<one> _ "order G + 1"], safe)
+    show "\<one> \<in> carrier G"
+      by auto
+  next
+    fix x assume "x \<in> carrier G"
+    hence "ord x \<le> order G"
+      by (intro ord_le_group_order fin)
+    also have "\<dots> < order G + 1"
+      by simp
+    finally show "ord x < order G + 1" .
+  qed
+  thus ?thesis using that by blast
+qed
+
+lemma (in finite_group) iso_imp_finite:
+  assumes "G \<cong> H" "group H"
+  shows "finite_group H"
+proof -
+  interpret H: group H by fact
+  show ?thesis
+  proof(unfold_locales)
+    show "finite (carrier H)" using iso_same_card[OF assms(1)]
+      by (metis card_gt_0_iff order_def order_gt_0)
+  qed
+qed
+
+lemma (in finite_group) finite_FactGroup:
+  assumes "H \<lhd> G"
+  shows "finite_group (G Mod H)"
+proof -
+  interpret H: normal H G by fact
+  interpret Mod: group "G Mod H" using H.factorgroup_is_group .
+  show ?thesis
+    by (unfold_locales, unfold FactGroup_def RCOSETS_def, simp)
+qed
+
+lemma (in finite_group) bigger_subgroup_is_group:
+  assumes "subgroup H G" "card H \<ge> order G"
+  shows "H = carrier G"
+  using subgroup.subset fin assms by (metis card_seteq order_def)
+
+text \<open>All generated subgroups of a finite group are obviously also finite.\<close>
+
+lemma (in finite_group) finite_generate:
+  assumes "A \<subseteq> carrier G"
+  shows "finite (generate G A)"
+  using generate_incl[of A] rev_finite_subset[of "carrier G" "generate G A"] assms by simp
+
+text \<open>We also provide an induction rule for finite groups inspired by Manuel Eberl's AFP entry
+"Dirichlet L-Functions and Dirichlet's Theorem" and the contained theory "Group\_Adjoin". A property
+that is true for a subgroup generated by some set and stays true when adjoining an element, is also
+true for the whole group.\<close>
+
+lemma (in finite_group) generate_induct[consumes 1, case_names base adjoin]:
+  assumes "A0 \<subseteq> carrier G"
+  assumes "A0 \<subseteq> carrier G \<Longrightarrow> P (G\<lparr>carrier := generate G A0\<rparr>)"
+  assumes "\<And>a A. \<lbrakk>A \<subseteq> carrier G; a \<in> carrier G - generate G A; A0 \<subseteq> A;
+           P (G\<lparr>carrier := generate G A\<rparr>)\<rbrakk> \<Longrightarrow> P (G\<lparr>carrier := generate G (A \<union> {a})\<rparr>)"
+  shows "P G"
+proof -
+  define A where A: "A = carrier G"
+  hence gA: "generate G A = carrier G"
+    using generate_incl[of "carrier G"] generate_sincl[of "carrier G"] by simp
+  hence "finite A" using fin A by argo
+  moreover have "A0 \<subseteq> A" using assms(1) A by argo
+  moreover have "A \<subseteq> carrier G" using A by simp
+  moreover have "generate G A0 \<subseteq> generate G A" using gA generate_incl[OF assms(1)] by argo
+  ultimately have "P (G\<lparr>carrier := generate G A\<rparr>)" using assms(2, 3)
+  proof (induction "A" taking: card rule: measure_induct_rule)
+    case (less A)
+    then show ?case
+    proof(cases "generate G A0 = generate G A")
+      case True
+      thus ?thesis using less by force
+    next
+      case gA0: False
+      with less(3) have s: "A0 \<subset> A" by blast
+      then obtain a where a: "a \<in> A - A0" by blast
+      have P1: "P (G\<lparr>carrier := generate G (A - {a})\<rparr>)"
+      proof(rule less(1))
+        show "card (A - {a}) < card A" using a less(2) by (meson DiffD1 card_Diff1_less)
+        show "A0 \<subseteq> A - {a}" using a s by blast
+        thus "generate G A0 \<subseteq> generate G (A - {a})" using mono_generate by presburger
+      qed (use less a s in auto)
+      show ?thesis
+      proof (cases "generate G A = generate G (A - {a})")
+        case True
+        then show ?thesis using P1 by simp
+      next
+        case False
+        have "a \<in> carrier G - generate G (A - {a})"
+        proof -
+          have "a \<notin> generate G (A - {a})"
+          proof
+            assume a2: "a \<in> generate G (A - {a})"
+            have "generate G (A - {a}) = generate G A"
+            proof (rule equalityI)
+              show "generate G (A - {a}) \<subseteq> generate G A" using mono_generate by auto
+              show "generate G A \<subseteq> generate G (A - {a})"
+              proof(subst (2) generate_idem[symmetric])
+                show "generate G A \<subseteq> generate G (generate G (A - {a}))"
+                  by (intro mono_generate, use generate_sincl[of "A - {a}"] a2 in blast)
+              qed (use less in auto)
+            qed
+            with False show False by argo
+          qed
+          with a less show ?thesis by fast
+        qed
+        from less(7)[OF _ this _ P1] less(4) s a have "P (G\<lparr>carrier := generate G (A - {a} \<union> {a})\<rparr>)"
+          by blast
+        moreover have "A - {a} \<union> {a} = A" using a by blast
+        ultimately show ?thesis by auto
+      qed
+    qed
+  qed
+  with gA show ?thesis by simp
+qed
+
+subsection \<open>Finite abelian groups\<close>
+
+text \<open>Another trivial locale: the finite abelian group with some trivial facts.\<close>
+
+locale finite_comm_group = finite_group + comm_group
+
+lemma (in finite_comm_group) iso_imp_finite_comm:
+  assumes "G \<cong> H" "group H"
+  shows "finite_comm_group H"
+proof -
+  interpret H: group H by fact
+  interpret H: comm_group H by (intro iso_imp_comm_group[OF assms(1)], unfold_locales)
+  interpret H: finite_group H by (intro iso_imp_finite[OF assms(1)], unfold_locales)
+  show ?thesis by unfold_locales
+qed
+
+lemma (in finite_comm_group) finite_comm_FactGroup:
+  assumes "subgroup H G"
+  shows "finite_comm_group (G Mod H)"
+  unfolding finite_comm_group_def
+proof(safe)
+  show "finite_group (G Mod H)" using finite_FactGroup[OF subgroup_imp_normal[OF assms]] .
+  show "comm_group (G Mod H)" by (simp add: abelian_FactGroup assms)
+qed
+
+(* Manuel Eberl *)
+lemma (in finite_comm_group) subgroup_imp_finite_comm_group:
+  assumes "subgroup H G"
+  shows   "finite_comm_group (G\<lparr>carrier := H\<rparr>)"
+proof -
+  interpret G': group "G\<lparr>carrier := H\<rparr>" by (intro subgroup_imp_group) fact+
+  interpret H: subgroup H G by fact
+  show ?thesis by standard (use finite_subset[OF H.subset] in \<open>auto simp: m_comm\<close>)
+qed
+
+
+subsection \<open>Cyclic groups\<close>
+
+text \<open>Now, the central notion of a cyclic group is introduced: a group generated
+by a single element.\<close>
+
+locale cyclic_group = group +
+  fixes gen :: "'a"
+  assumes gen_closed[intro, simp]: "gen \<in> carrier G"
+  assumes generator: "carrier G = generate G {gen}"
+
+lemma (in cyclic_group) elem_is_gen_pow:
+  assumes "x \<in> carrier G"
+  shows "\<exists>n :: int. x = gen [^] n"
+proof -
+  from generator have x_g:"x \<in> generate G {gen}" using assms by fast
+  with generate_pow[of gen] show ?thesis using gen_closed by blast
+qed
+
+text \<open>Every cyclic group is commutative/abelian.\<close>
+
+sublocale cyclic_group \<subseteq> comm_group
+proof(unfold_locales)
+  fix x y
+  assume "x \<in> carrier G" "y \<in> carrier G"
+  then obtain a b where ab:"x = gen [^] (a::int)" "y = gen [^] (b::int)"
+    using elem_is_gen_pow by presburger
+  then have "x \<otimes> y = gen [^] (a + b)" by (simp add: int_pow_mult)                 
+  also have "\<dots> = y \<otimes> x" using ab int_pow_mult
+    by (metis add.commute gen_closed)
+  finally show "x \<otimes> y = y \<otimes> x" .
+qed
+
+text \<open>Some trivial intro rules for showing that a group is cyclic.\<close>
+
+lemma (in group) cyclic_groupI0:
+  assumes "a \<in> carrier G" "carrier G = generate G {a}"
+  shows "cyclic_group G a"
+  using assms by (unfold_locales; auto) 
+
+lemma (in group) cyclic_groupI1:
+  assumes "a \<in> carrier G" "carrier G \<subseteq> generate G {a}"
+  shows "cyclic_group G a"
+  using assms by (unfold_locales, use generate_incl[of "{a}"] in auto)
+
+lemma (in group) cyclic_groupI2:
+  assumes "a \<in> carrier G"
+  shows "cyclic_group (G\<lparr>carrier := generate G {a}\<rparr>) a"
+proof (intro group.cyclic_groupI0)
+  show "group (G\<lparr>carrier := generate G {a}\<rparr>)"
+    by (intro subgroup.subgroup_is_group group.generate_is_subgroup, use assms in simp_all)
+  show "a \<in> carrier (G\<lparr>carrier := generate G {a}\<rparr>)" using generate.incl[of a "{a}"] by auto
+  show "carrier (G\<lparr>carrier := generate G {a}\<rparr>) = generate (G\<lparr>carrier := generate G {a}\<rparr>) {a}"
+    using assms
+    by (simp add: generate_consistent generate.incl group.generate_is_subgroup)
+qed
+
+text \<open>The order of the generating element is always the same as the group order.\<close>
+
+lemma (in cyclic_group) ord_gen_is_group_order:
+  shows "ord gen = order G"
+proof (cases "finite (carrier G)")
+  case True
+  with generator show "ord gen = order G"
+    using generate_pow_card[of gen] order_def[of G] gen_closed by simp
+next
+  case False
+  thus ?thesis
+    using generate_pow_card generator order_def[of G] card_eq_0_iff[of "carrier G"] by force
+qed
+
+text \<open>In the case of a finite group, it is sufficient to have one element of group order to know
+that the group is cyclic.\<close>
+
+lemma (in finite_group) element_ord_generates_cyclic:
+  assumes "a \<in> carrier G" "ord a = order G"
+  shows "cyclic_group G a"
+proof (unfold_locales)
+  show "a \<in> carrier G" using assms(1) by simp
+  show "carrier G = generate G {a}"
+    using assms bigger_subgroup_is_group[OF generate_is_subgroup]
+    by (metis empty_subsetI fin generate_pow_card insert_subset ord_le_group_order)
+qed
+
+text \<open>Another useful fact is that a group of prime order is also cyclic.\<close>
+
+lemma (in group) prime_order_group_is_cyc:
+  assumes "Factorial_Ring.prime (order G)"
+  obtains g where "cyclic_group G g"
+proof (unfold_locales)
+  obtain p where order_p: "order G = p" and p_prime: "Factorial_Ring.prime p" using assms by blast
+  then have "card (carrier G) \<ge> 2" by (simp add: order_def prime_ge_2_nat)
+  then obtain a where a_in: "a \<in> carrier G" and a_not_one: "a \<noteq> \<one>" using one_unique
+    by (metis (no_types, lifting) card_2_iff' obtain_subset_with_card_n subset_iff)
+  interpret fin: finite_group G
+    using assms order_gt_0_iff_finite unfolding order_def by unfold_locales auto
+  have "ord a dvd p" using a_in order_p ord_dvd_group_order by blast
+  hence "ord a = p" using prime_nat_iff[of p] p_prime ord_eq_1 a_in a_not_one by blast
+  then interpret cyclic_group G a
+    using fin.element_ord_generates_cyclic order_p a_in by simp
+  show ?thesis using that cyclic_group_axioms .
+qed
+
+text \<open>What follows is an induction principle for cyclic groups: a predicate is true for all elements
+of the group if it is true for all elements that can be formed by the generating element by just
+multiplication and if it also holds under the forming of the inverse (as we by this cover
+all elements of the group),\<close>
+
+(* Manuel Eberl *)
+lemma (in cyclic_group) generator_induct [consumes 1, case_names generate inv]:
+  assumes x: "x \<in> carrier G"
+  assumes IH1: "\<And>n::nat. P (gen [^] n)"
+  assumes IH2: "\<And>x. x \<in> carrier G \<Longrightarrow> P x \<Longrightarrow> P (inv x)"
+  shows   "P x"
+proof -
+  from x obtain n :: int where n: "x = gen [^] n"
+    using elem_is_gen_pow[of x] by auto
+  show ?thesis
+  proof (cases "n \<ge> 0")
+    case True
+    have "P (gen [^] nat n)"
+      by (rule IH1)
+    with True n show ?thesis by simp
+  next
+    case False
+    have "P (inv (gen [^] nat (-n)))"
+      by (intro IH1 IH2) auto
+    also have "gen [^] nat (-n) = gen [^] (-n)"
+      using False by simp
+    also have "inv \<dots> = x"
+      using n by (simp add: int_pow_neg)
+    finally show ?thesis .
+  qed
+qed
+
+
+subsection \<open>Finite cyclic groups\<close>
+
+text \<open>Additionally, the notion of the finite cyclic group is introduced.\<close>
+
+locale finite_cyclic_group = finite_group + cyclic_group
+
+sublocale finite_cyclic_group \<subseteq> finite_comm_group
+  by unfold_locales
+
+lemma (in finite_cyclic_group) ord_gen_gt_zero:
+  "ord gen > 0"
+  using ord_ge_1[OF fin gen_closed] by simp
+
+text \<open>In order to prove something about an element in a finite abelian group, it is possible to show
+this property for the neutral element or the generating element and inductively for the elements
+that are formed by multiplying with the generator.\<close>
+
+lemma (in finite_cyclic_group) generator_induct0 [consumes 1, case_names one step]:
+  assumes x: "x \<in> carrier G"
+  assumes IH1: "P \<one>"
+  assumes IH2: "\<And>x. \<lbrakk>x \<in> carrier G; P x\<rbrakk> \<Longrightarrow> P (x \<otimes> gen)"
+  shows   "P x"
+proof -
+  from ord_gen_gt_zero generate_nat_pow[OF _ gen_closed] obtain n::nat where n: "x = gen [^] n"
+    using generator x by blast
+  thus ?thesis by (induction n arbitrary: x, use assms in auto)
+qed
+
+lemma (in finite_cyclic_group) generator_induct1 [consumes 1, case_names gen step]:
+  assumes x: "x \<in> carrier G"
+  assumes IH1: "P gen"
+  assumes IH2: "\<And>x. \<lbrakk>x \<in> carrier G; P x\<rbrakk> \<Longrightarrow> P (x \<otimes> gen)"
+  shows   "P x"
+proof(rule generator_induct0[OF x])
+  show "\<And>x. \<lbrakk>x \<in> carrier G; P x\<rbrakk> \<Longrightarrow> P (x \<otimes> gen)" using IH2 by blast
+  have "P x" if "n > 0" "x = gen [^] n" for n::nat and x using that
+    by (induction n arbitrary: x; use assms in fastforce)
+  from this[OF ord_pos[OF gen_closed] pow_ord_eq_1[OF gen_closed, symmetric]] show "P \<one>" .
+qed
+
+subsection \<open>\<open>get_exp\<close> - discrete logarithm\<close>
+
+text \<open>What now follows is the discrete logarithm for groups. It is used at several times througout
+this entry and is initially used to show that two cyclic groups of the same order are isomorphic.\<close>
+
+definition (in group) get_exp where
+  "get_exp g = (\<lambda>a. SOME k::int. a = g [^] k)"
+
+text \<open>For each element with itself as the basis the discrete logarithm indeed does what expected.
+This is not the strongest possible statement, but sufficient for our needs.\<close>
+
+lemma (in group) get_exp_self_fulfills:
+  assumes "a \<in> carrier G"
+  shows "a = a [^] get_exp a a"
+proof -
+  have "a = a [^] (1::int)" using assms by auto
+  moreover have "a [^] (1::int) = a [^] (SOME x::int. a [^] (1::int) = a [^] x)"
+    by (intro someI_ex[of "\<lambda>x::int. a [^] (1::int) = a [^] x"]; blast)
+  ultimately show ?thesis unfolding get_exp_def by simp
+qed
+
+lemma (in group) get_exp_self:
+  assumes "a \<in> carrier G"
+  shows "get_exp a a mod ord a = (1::int) mod ord a"
+  by (intro pow_eq_int_mod[OF assms], use get_exp_self_fulfills[OF assms] assms in auto)
+
+text \<open>For cyclic groups, the discrete logarithm "works" for every element.\<close>
+
+lemma (in cyclic_group) get_exp_fulfills:
+  assumes "a \<in> carrier G"
+  shows "a = gen [^] get_exp gen a"
+proof -
+  from elem_is_gen_pow[OF assms] obtain k::int where k: "a = gen [^] k" by blast
+  moreover have "gen [^] k = gen [^] (SOME x::int. gen [^] k = gen [^] x)"
+    by(intro someI_ex[of "\<lambda>x::int. gen [^] k = gen [^] x"]; blast)
+  ultimately show ?thesis unfolding get_exp_def by blast
+qed
+
+lemma (in cyclic_group) get_exp_non_zero:
+  assumes"b \<in> carrier G" "b \<noteq> \<one>"
+  shows "get_exp gen b \<noteq> 0"
+  using assms get_exp_fulfills[OF assms(1)] by auto 
+
+text \<open>One well-known logarithmic identity.\<close>
+
+lemma (in cyclic_group) get_exp_mult_mod:
+  assumes "a \<in> carrier G" "b \<in> carrier G"
+  shows "get_exp gen (a \<otimes> b) mod (ord gen) = (get_exp gen a + get_exp gen b) mod (ord gen)"
+proof (intro pow_eq_int_mod[OF gen_closed])
+  from get_exp_fulfills[of "a \<otimes> b"] have "gen [^] get_exp gen (a \<otimes> b) = a \<otimes> b" using assms by simp
+  moreover have "gen [^] (get_exp gen a + get_exp gen b) = a \<otimes> b"
+  proof -
+    have "gen [^] (get_exp gen a + get_exp gen b) = gen [^] (get_exp gen a) \<otimes> gen [^] (get_exp gen b)"
+      using int_pow_mult by blast
+    with get_exp_fulfills assms show ?thesis by simp
+  qed
+  ultimately show "gen [^] get_exp gen (a \<otimes> b) = gen [^] (get_exp gen a + get_exp gen b)" by simp
+qed
+
+text \<open>We now show that all functions from a group generated by 'a' to a group generated by 'b'
+that map elements from $a^k$ to $b^k$ in the other group are in fact isomorphisms between these two
+groups.\<close>
+
+lemma (in group) iso_cyclic_groups_generate:
+  assumes "a \<in> carrier G" "b \<in> carrier H" "group.ord G a = group.ord H b" "group H"
+  shows "{f. \<forall>k \<in> (UNIV::int set). f (a [^] k) = b [^]\<^bsub>H\<^esub> k}
+         \<subseteq> iso (G\<lparr>carrier := generate G {a}\<rparr>) (H\<lparr>carrier := generate H {b}\<rparr>)"
+proof
+  interpret H: group H by fact
+  let ?A = "G\<lparr>carrier := generate G {a}\<rparr>"
+  let ?B = "H\<lparr>carrier := generate H {b}\<rparr>"
+  interpret A: cyclic_group ?A a by (intro group.cyclic_groupI2; use assms(1) in simp)
+  interpret B: cyclic_group ?B b by (intro group.cyclic_groupI2; use assms(2) in simp)
+  have sA: "subgroup (generate G {a}) G" by (intro generate_is_subgroup, use assms(1) in simp)
+  have sB: "subgroup (generate H {b}) H" by (intro H.generate_is_subgroup, use assms(2) in simp)
+  fix x
+  assume x: "x \<in> {f. \<forall>k\<in>(UNIV::int set). f (a [^] k) = b [^]\<^bsub>H\<^esub> k}"
+  have hom: "x \<in> hom ?A ?B"
+  proof (intro homI)
+    fix c
+    assume c: "c \<in> carrier ?A"
+    from A.elem_is_gen_pow[OF this] obtain k::int where k: "c = a [^] k"
+      using int_pow_consistent[OF sA generate.incl[of a]] by auto
+    with x have "x c = b [^]\<^bsub>H\<^esub> k" by blast
+    thus "x c \<in> carrier ?B"
+      using B.int_pow_closed H.int_pow_consistent[OF sB] generate.incl[of b "{b}" H] by simp
+    fix d
+    assume d: "d \<in> carrier ?A"
+    from A.elem_is_gen_pow[OF this] obtain l::int where l: "d = a [^] l"
+      using int_pow_consistent[OF sA generate.incl[of a]] by auto
+    with k have "c \<otimes> d = a [^] (k + l)" by (simp add: int_pow_mult assms(1))
+    with x have "x (c \<otimes>\<^bsub>?A\<^esub> d) = b [^]\<^bsub>H\<^esub> (k + l)" by simp
+    also have "\<dots> = b [^]\<^bsub>H\<^esub> k \<otimes>\<^bsub>H\<^esub> b [^]\<^bsub>H\<^esub> l" by (simp add: H.int_pow_mult assms(2))
+    finally show "x (c \<otimes>\<^bsub>?A\<^esub> d) = x c \<otimes>\<^bsub>?B\<^esub> x d" using x k l by simp
+  qed
+  then interpret xgh: group_hom ?A ?B x unfolding group_hom_def group_hom_axioms_def by blast
+  have "kernel ?A ?B x = {\<one>}"
+  proof(intro equalityI)
+    show "{\<one>} \<subseteq> kernel ?A ?B x" using xgh.one_in_kernel by auto
+    have "c = \<one>" if "c \<in> kernel ?A ?B x" for c
+    proof -
+      from that have c: "c \<in> carrier ?A" unfolding kernel_def by blast
+      from A.elem_is_gen_pow[OF this] obtain k::int where k: "c = a [^] k"
+        using int_pow_consistent[OF sA generate.incl[of a]] by auto
+      moreover have "x c = \<one>\<^bsub>H\<^esub>" using that x unfolding kernel_def by auto
+      ultimately have "\<one>\<^bsub>H\<^esub> = b [^]\<^bsub>H\<^esub> k" using x by simp
+      with assms(3) have "a [^] k = \<one>"
+        using int_pow_eq_id[OF assms(1), of k] H.int_pow_eq_id[OF assms(2), of k] by simp
+      thus "c = \<one>" using k by blast
+    qed
+    thus "kernel ?A ?B x \<subseteq> {\<one>}" by blast             
+  qed
+  moreover have "carrier ?B \<subseteq> x ` carrier ?A"
+  proof
+    fix c
+    assume c: "c \<in> carrier ?B"
+    from B.elem_is_gen_pow[OF this] obtain k::int where k: "c = b [^]\<^bsub>H\<^esub> k"
+      using H.int_pow_consistent[OF sB generate.incl[of b]] by auto
+    then have "x (a [^] k) = c" using x by blast
+    moreover have "a [^] k \<in> carrier ?A"
+      using int_pow_consistent[OF sA generate.incl[of a]] A.int_pow_closed generate.incl[of a]
+      by fastforce
+    ultimately show "c \<in> x ` carrier ?A" by blast
+  qed
+  ultimately show "x \<in> iso ?A ?B" using hom xgh.iso_iff unfolding kernel_def by auto
+qed
+
+text \<open>This is then used to derive the isomorphism of two cyclic groups of the same order as a
+direct consequence.\<close>
+
+lemma (in cyclic_group) iso_cyclic_groups_same_order:
+  assumes "cyclic_group H h" "order G = order H"
+  shows "G \<cong> H"
+proof(intro is_isoI)
+  interpret H: cyclic_group H h by fact
+  define f where "f = (\<lambda>a. h [^]\<^bsub>H\<^esub> get_exp gen a)"
+  from assms(2) have o: "ord gen = H.ord h" using ord_gen_is_group_order H.ord_gen_is_group_order
+    by simp
+  have "\<forall>k \<in> (UNIV::int set). f (gen [^] k) = h [^]\<^bsub>H\<^esub> k"
+  proof
+    fix k
+    assume k: "k \<in> (UNIV::int set)"
+    have "gen [^] k = gen [^] (SOME x::int. gen [^] k = gen [^] x)"
+      by(intro someI_ex[of "\<lambda>x::int. gen [^] k = gen [^] x"]; blast)
+    moreover have "(SOME x::int. gen [^] k = gen [^] x) = (SOME x::int. h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x)"
+    proof -
+      have "gen [^] k = gen [^] x \<longleftrightarrow> h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x" for x::int
+        by (simp add: o group.int_pow_eq)  
+      thus ?thesis by simp
+    qed
+    moreover have "h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> (SOME x::int. h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x)"
+      by(intro someI_ex[of "\<lambda>x::int. h [^]\<^bsub>H\<^esub> k = h [^]\<^bsub>H\<^esub> x"]; blast)
+    ultimately show "f (gen [^] k) = h [^]\<^bsub>H\<^esub> k" unfolding f_def get_exp_def by metis
+  qed
+  thus "f \<in> iso G H"
+    using iso_cyclic_groups_generate[OF gen_closed H.gen_closed o H.is_group]
+    by (auto simp flip: generator H.generator)
+qed
+
+subsection \<open>Integer modular groups\<close>
+
+text \<open>We show that \<open>integer_mod_group\<close> (written as \<open>Z n\<close>) is in fact a cyclic group.
+For $n \neq 1$ it is generated by $1$ and in the other case by $0$.\<close>
+
+notation integer_mod_group ("Z")
+
+lemma Zn_neq1_cyclic_group:
+  assumes "n \<noteq> 1"
+  shows "cyclic_group (Z n) 1"
+proof(unfold cyclic_group_def cyclic_group_axioms_def, safe)
+  show "group (Z n)" using group_integer_mod_group .
+  then interpret group "Z n" .
+  show oc: "1 \<in> carrier (Z n)"
+    unfolding integer_mod_group_def integer_group_def using assms by force
+  show "x \<in> generate (Z n) {1}" if "x \<in> carrier (Z n)" for x
+    using generate_pow[OF oc] that int_pow_integer_mod_group solve_equation subgroup_self
+    by fastforce
+  show "x \<in> carrier (Z n)" if "x \<in> generate (Z n) {1}" for x using generate_incl[of "{1}"] that oc
+    by fast
+qed
+
+lemma Z1_cyclic_group: "cyclic_group (Z 1) 0"
+proof(unfold cyclic_group_def cyclic_group_axioms_def, safe)
+  show "group (Z 1)" using group_integer_mod_group .
+  then interpret group "Z 1" .
+  show "0 \<in> carrier (Z 1)" unfolding integer_mod_group_def by simp
+  thus "x \<in> carrier (Z 1)" if "x \<in> generate (Z 1) {0}" for x using generate_incl[of "{0}"] that
+    by fast
+  show "x \<in> generate (Z 1) {0}" if "x \<in> carrier (Z 1)" for x
+  proof -
+    from that have "x = 0" unfolding integer_mod_group_def by auto
+    with generate.one[of "Z 1" "{0}"] show "x \<in> generate (Z 1) {0}" unfolding integer_mod_group_def
+      by simp
+  qed
+qed
+
+lemma Zn_cyclic_group:
+  obtains x where "cyclic_group (Z n) x"
+  using Z1_cyclic_group Zn_neq1_cyclic_group by metis
+
+text \<open>Moreover, its order is just $n$.\<close>
+
+lemma Zn_order: "order (Z n) = n"
+  by (unfold integer_mod_group_def integer_group_def order_def, auto)
+
+text \<open>Consequently, \<open>Z n\<close> is isomorphic to any cyclic group of order $n$.\<close>
+
+lemma (in cyclic_group) Zn_iso:
+  assumes "order G = n"
+  shows "G \<cong> Z n"
+  using Zn_order Zn_cyclic_group iso_cyclic_groups_same_order assms by metis
+
+no_notation integer_mod_group ("Z")
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/Finite_Product_Extend.thy b/thys/Finitely_Generated_Abelian_Groups/Finite_Product_Extend.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Finite_Product_Extend.thy
@@ -0,0 +1,739 @@
+(*
+    File:     Finite_Product_Extend.thy
+    Author:   Joseph Thommes, TU München; Manuel Eberl, TU München
+*)
+section \<open>Finite Product\<close>
+
+theory Finite_Product_Extend
+  imports IDirProds
+begin
+
+text \<open>In this section, some general facts about \<open>finprod\<close> as well as some tailored for the rest of
+this entry are proven.\<close>
+
+text \<open>It is often needed to split a product in a single factor and the rest. Thus these two lemmas.\<close>
+
+lemma (in comm_group) finprod_minus:
+  assumes "a \<in> A" "f \<in> A \<rightarrow> carrier G" "finite A"
+  shows "finprod G f A = f a \<otimes> finprod G f (A - {a})"
+proof -
+  from assms have "A = insert a (A - {a})" by blast
+  then have "finprod G f A = finprod G f (insert a (A - {a}))" by simp
+  also have "\<dots> = f a \<otimes> finprod G f (A - {a})" using assms by (intro finprod_insert, auto)
+  finally show ?thesis .
+qed
+
+lemma (in comm_group) finprod_minus_symm:
+  assumes "a \<in> A" "f \<in> A \<rightarrow> carrier G" "finite A"
+  shows "finprod G f A = finprod G f (A - {a}) \<otimes> f a"
+proof -
+  from assms have "A = insert a (A - {a})" by blast
+  then have "finprod G f A = finprod G f (insert a (A - {a}))" by simp
+  also have "\<dots> = f a \<otimes> finprod G f (A - {a})" using assms by (intro finprod_insert, auto)
+  also have "\<dots> = finprod G f (A - {a}) \<otimes> f a"
+    by (intro m_comm, use assms in blast, intro finprod_closed, use assms in blast)
+  finally show ?thesis .
+qed
+
+text \<open>This makes it very easy to show the following trivial fact.\<close>
+
+lemma (in comm_group) finprod_singleton:
+  assumes "f x \<in> carrier G" "finprod G f {x} = a"
+  shows "f x = a"
+proof -
+  have "finprod G f {x} = f x \<otimes> finprod G f {}" using finprod_minus[of x "{x}" f] assms by auto
+  thus ?thesis using assms by simp
+qed
+
+text \<open>The finite product is consistent and closed concerning subgroups.\<close>
+
+lemma (in comm_group) finprod_subgroup:
+  assumes "f \<in> S \<rightarrow> H" "subgroup H G"
+  shows "finprod G f S = finprod (G\<lparr>carrier := H\<rparr>) f S"
+proof (cases "finite S")
+  case True
+  interpret H: comm_group "G\<lparr>carrier := H\<rparr>" using subgroup_is_comm_group[OF assms(2)] .
+  show ?thesis using True assms
+  proof (induction S rule: finite_induct)
+    case empty
+    then show ?case using finprod_empty H.finprod_empty by simp
+  next
+    case i: (insert x F)
+    then have "finprod G f F = finprod (G\<lparr>carrier := H\<rparr>) f F" by blast
+    moreover have "finprod G f (insert x F) = f x \<otimes> finprod G f F"
+    proof(intro finprod_insert[OF i(1, 2), of f])
+      show "f \<in> F \<rightarrow> carrier G" "f x \<in> carrier G" using i(4) subgroup.subset[OF i(5)] by blast+
+    qed
+    ultimately have "finprod G f (insert x F) = f x \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> finprod (G\<lparr>carrier := H\<rparr>) f F"
+      by auto
+    moreover have "finprod (G\<lparr>carrier := H\<rparr>) f (insert x F) = \<dots>"
+    proof(intro H.finprod_insert[OF i(1, 2)])
+      show "f \<in> F \<rightarrow> carrier (G\<lparr>carrier := H\<rparr>)" "f x \<in> carrier (G\<lparr>carrier := H\<rparr>)" using i(4) by auto
+    qed
+    ultimately show ?case by simp
+  qed
+next
+  case False
+  then show ?thesis unfolding finprod_def by simp
+qed
+
+lemma (in comm_group) finprod_closed_subgroup:
+  assumes "subgroup H G" "f \<in> A \<rightarrow> H"
+  shows "finprod G f A \<in> H"
+  using assms(2)
+proof (induct A rule: infinite_finite_induct)
+case (infinite A)
+then show ?case using subgroup.one_closed[OF assms(1)] by auto
+next
+  case empty
+  then show ?case using subgroup.one_closed[OF assms(1)] by auto
+next
+  case i: (insert x F)
+  from finprod_insert[OF i(1, 2), of f] i have fi: "finprod G f (insert x F) = f x \<otimes> finprod G f F"
+    using subgroup.subset[OF assms(1)] by blast
+  from i have "finprod G f F \<in> H" "f x \<in> H" by blast+
+  with fi show ?case using subgroup.m_closed[OF assms(1)] by presburger 
+qed
+
+text \<open>It also does not matter if we exponentiate all elements taking part in the product or the
+result of the product.\<close>
+
+lemma (in comm_group) finprod_exp:
+  assumes "A \<subseteq> carrier G" "f \<in> A \<rightarrow> carrier G"
+  shows "(finprod G f A) [^] (k::int) = finprod G ((\<lambda>a. a [^] k) \<circ> f) A"
+  using assms
+proof(induction A rule: infinite_finite_induct)
+  case i: (insert x F)
+  hence ih: "finprod G f F [^] k = finprod G ((\<lambda>a. a [^] k) \<circ> f) F" by blast
+  have fpc: "finprod G f F \<in> carrier G" by (intro finprod_closed, use i in auto)
+  have fxc: "f x \<in> carrier G" using i by auto
+  have "finprod G f (insert x F) = f x \<otimes> finprod G f F" by (intro finprod_insert, use i in auto)
+  hence "finprod G f (insert x F) [^] k = (f x \<otimes> finprod G f F) [^] k" by simp
+  also have "\<dots> = f x [^] k \<otimes> finprod G f F [^] k" using fpc fxc int_pow_distrib by blast
+  also have "\<dots> = ((\<lambda>a. a [^] k) \<circ> f) x \<otimes> finprod G ((\<lambda>a. a [^] k) \<circ> f) F" using ih by simp
+  also have "\<dots> = finprod G ((\<lambda>a. a [^] k) \<circ> f) (insert x F)"
+    by (intro finprod_insert[symmetric], use i in auto)
+  finally show ?case .
+qed auto
+
+text \<open>Some lemmas concerning different combinations of functions in the usage of \<open>finprod\<close>.\<close>
+
+lemma (in comm_group) finprod_cong_split:
+  assumes "\<And>a. a \<in> A \<Longrightarrow> f a \<otimes> g a = h a"
+  and "f \<in> A \<rightarrow> carrier G" "g \<in> A \<rightarrow> carrier G" "h \<in> A \<rightarrow> carrier G"
+  shows "finprod G h A = finprod G f A \<otimes> finprod G g A" using assms
+proof(induct A rule: infinite_finite_induct)
+  case (infinite A)
+  then show ?case by simp
+next
+  case empty
+  then show ?case by simp
+next
+  case i: (insert x F)
+  then have iH: "finprod G h F = finprod G f F \<otimes> finprod G g F" by fast
+  have f: "finprod G f (insert x F) = f x \<otimes> finprod G f F"
+    by (intro finprod_insert[OF i(1, 2), of f]; use i(5) in simp)
+  have g: "finprod G g (insert x F) = g x \<otimes> finprod G g F"
+    by (intro finprod_insert[OF i(1, 2), of g]; use i(6) in simp)
+  have h: "finprod G h (insert x F) = h x \<otimes> finprod G h F"
+    by (intro finprod_insert[OF i(1, 2), of h]; use i(7) in simp)  
+  also have "\<dots> = h x \<otimes> (finprod G f F \<otimes> finprod G g F)" using iH by argo
+  also have "\<dots> = f x \<otimes> g x \<otimes> (finprod G f F \<otimes> finprod G g F)" using i(4) by simp
+  also have "\<dots> = f x \<otimes> finprod G f F \<otimes> (g x \<otimes> finprod G g F)" using m_comm m_assoc i(5-7) by simp
+  also have "\<dots> = finprod G f (insert x F) \<otimes> finprod G g (insert x F)" using f g by argo
+  finally show ?case .
+qed
+
+lemma (in comm_group) finprod_comp:
+  assumes "inj_on g A" "(f \<circ> g) ` A \<subseteq> carrier G"
+  shows "finprod G f (g ` A) = finprod G (f \<circ> g) A"
+  using finprod_reindex[OF _ assms(1), of f] using assms(2) unfolding comp_def by blast
+
+text \<open>The subgroup generated by a set of generators (in an abelian group) is exactly the set of
+elements that can be written as a finite product using only powers of these elements.\<close>
+
+lemma (in comm_group) generate_eq_finprod_PiE_image:
+  assumes "finite gs" "gs \<subseteq> carrier G"
+  shows "generate G gs = (\<lambda>x. finprod G x gs) ` Pi\<^sub>E gs (\<lambda>a. generate G {a})" (is "?g = ?fp")
+proof
+  show "?g \<subseteq> ?fp"
+  proof
+    fix x
+    assume x: "x \<in> ?g"
+    thus "x \<in> ?fp"
+    proof (induction rule: generate.induct)
+      case one
+      show ?case
+      proof
+        let ?r = "restrict (\<lambda>_. \<one>) gs"
+        show "?r \<in> (\<Pi>\<^sub>E a\<in>gs. generate G {a})" using generate.one by auto
+        show "\<one> = finprod G ?r gs" by(intro finprod_one_eqI[symmetric], simp)
+      qed
+    next
+      case g: (incl g)
+      show ?case
+      proof
+        let ?r = "restrict ((\<lambda>_. \<one>)(g := g)) gs"
+        show "?r \<in> (\<Pi>\<^sub>E a\<in>gs. generate G {a})" using generate.one generate.incl[of g "{g}" G]
+          by fastforce
+        show "g = finprod G ?r gs"
+        proof -
+          have "finprod G ?r gs = ?r g \<otimes> finprod G ?r (gs - {g})"
+            by (intro finprod_minus, use assms g in auto)
+          moreover have "?r g = g" using g by simp
+          moreover have "finprod G ?r (gs - {g}) = \<one>" by(rule finprod_one_eqI; use g in simp)
+          ultimately show ?thesis using assms g by auto
+        qed
+      qed
+    next
+      case g: (inv g)
+      show ?case
+      proof
+        let ?r = "restrict ((\<lambda>_. \<one>)(g := inv g)) gs"
+        show "?r \<in> (\<Pi>\<^sub>E a\<in>gs. generate G {a})" using generate.one generate.inv[of g "{g}" G]
+          by fastforce
+        show "inv g = finprod G ?r gs"
+        proof -
+          have "finprod G ?r gs = ?r g \<otimes> finprod G ?r (gs - {g})"
+            by (intro finprod_minus, use assms g in auto)
+          moreover have "?r g = inv g" using g by simp
+          moreover have "finprod G ?r (gs - {g}) = \<one>" by(rule finprod_one_eqI; use g in simp)
+          ultimately show ?thesis using assms g by auto
+        qed
+      qed
+    next
+      case gh: (eng g h)
+      from gh obtain i where i: "i \<in> (\<Pi>\<^sub>E a\<in>gs. generate G {a})" "g = finprod G i gs" by blast
+      from gh obtain j where j: "j \<in> (\<Pi>\<^sub>E a\<in>gs. generate G {a})" "h = finprod G j gs" by blast
+      from i j have "g \<otimes> h = finprod G i gs \<otimes> finprod G j gs" by blast
+      also have "\<dots> = finprod G (\<lambda>a. i a \<otimes> j a) gs"
+      proof(intro finprod_multf[symmetric]; rule)
+        fix x
+        assume x: "x \<in> gs"
+        have "i x \<in> generate G {x}" "j x \<in> generate G {x}"using i(1) j(1) x by blast+
+        thus "i x \<in> carrier G" "j x \<in> carrier G" using generate_incl[of "{x}"] x assms(2) by blast+
+      qed
+      also have "\<dots> = finprod G (restrict (\<lambda>a. i a \<otimes> j a) gs) gs"
+      proof(intro finprod_cong)
+        have ip: "i g \<in> generate G {g}" if "g \<in> gs" for g using i that by auto
+        have jp: "j g \<in> generate G {g}" if "g \<in> gs" for g using j that by auto
+        have "i g \<otimes> j g \<in> generate G {g}" if "g \<in> gs" for g
+          using generate.eng[OF ip[OF that] jp[OF that]] .
+        thus "((\<lambda>a. i a \<otimes> j a) \<in> gs \<rightarrow> carrier G) = True" using generate_incl assms(2) by blast
+      qed auto
+      finally have "g \<otimes> h = finprod G (restrict (\<lambda>a. i a \<otimes> j a) gs) gs" .
+      moreover have "(restrict (\<lambda>a. i a \<otimes> j a) gs) \<in> (\<Pi>\<^sub>E a\<in>gs. generate G {a})"
+      proof -
+        have ip: "i g \<in> generate G {g}" if "g \<in> gs" for g using i that by auto
+        have jp: "j g \<in> generate G {g}" if "g \<in> gs" for g using j that by auto
+        have "i g \<otimes> j g \<in> generate G {g}" if "g \<in> gs" for g
+          using generate.eng[OF ip[OF that] jp[OF that]] .
+        thus ?thesis by auto
+      qed
+      ultimately show ?case using i j by blast
+    qed
+  qed
+  show "?fp \<subseteq> ?g"
+  proof
+    fix x
+    assume x: "x \<in> ?fp"
+    then obtain f where f: "f \<in> (Pi\<^sub>E gs (\<lambda>a. generate G {a}))" "x = finprod G f gs" by blast
+    have sg: "subgroup ?g G" by(intro generate_is_subgroup, fact)
+    have "finprod G f gs \<in> ?g"
+    proof(intro finprod_closed_subgroup[OF sg])
+      have "f g \<in> generate G gs" if "g \<in> gs" for g
+      proof -
+        have "f g \<in> generate G {g}" using f(1) that by auto
+        moreover have "generate G {g} \<subseteq> generate G gs" by(intro mono_generate, use that in simp)
+        ultimately show ?thesis by fast
+      qed
+      thus "f \<in> gs \<rightarrow> generate G gs" by simp
+    qed
+    thus "x \<in> ?g" using f by blast
+  qed
+qed
+
+lemma (in comm_group) generate_eq_finprod_Pi_image:
+  assumes "finite gs" "gs \<subseteq> carrier G"
+  shows "generate G gs = (\<lambda>x. finprod G x gs) ` Pi gs (\<lambda>a. generate G {a})" (is "?g = ?fp")
+proof -
+  have "(\<lambda>x. finprod G x gs) ` Pi\<^sub>E gs (\<lambda>a. generate G {a})
+      = (\<lambda>x. finprod G x gs) ` Pi gs (\<lambda>a. generate G {a})"
+  proof
+    have "Pi\<^sub>E gs (\<lambda>a. generate G {a}) \<subseteq> Pi gs (\<lambda>a. generate G {a})" by blast
+    thus "(\<lambda>x. finprod G x gs) ` Pi\<^sub>E gs (\<lambda>a. generate G {a})
+        \<subseteq> (\<lambda>x. finprod G x gs) ` Pi gs (\<lambda>a. generate G {a})" by blast
+    show "(\<lambda>x. finprod G x gs) ` Pi gs (\<lambda>a. generate G {a})
+        \<subseteq> (\<lambda>x. finprod G x gs) ` Pi\<^sub>E gs (\<lambda>a. generate G {a})"
+    proof
+      fix x
+      assume x: "x \<in> (\<lambda>x. finprod G x gs) ` Pi gs (\<lambda>a. generate G {a})"
+      then obtain f where f: "x = finprod G f gs" "f \<in> Pi gs (\<lambda>a. generate G {a})" by blast
+      moreover have "finprod G f gs = finprod G (restrict f gs) gs"
+      proof(intro finprod_cong)
+        have "f g \<in> carrier G" if "g \<in> gs" for g
+          using that f(2) mono_generate[of "{g}" gs] generate_incl[OF assms(2)] by fast
+        thus "(f \<in> gs \<rightarrow> carrier G) = True" by blast
+      qed auto        
+      moreover have "restrict f gs \<in> Pi\<^sub>E gs (\<lambda>a. generate G {a})" using f(2) by simp
+      ultimately show "x \<in> (\<lambda>x. finprod G x gs) ` Pi\<^sub>E gs (\<lambda>a. generate G {a})" by blast
+    qed
+  qed
+  with generate_eq_finprod_PiE_image[OF assms] show ?thesis by auto
+qed
+
+lemma (in comm_group) generate_eq_finprod_Pi_int_image:
+  assumes "finite gs" "gs \<subseteq> carrier G"
+  shows "generate G gs = (\<lambda>x. finprod G (\<lambda>g. g [^] x g) gs) ` Pi gs (\<lambda>_. (UNIV::int set))"
+proof -
+  from generate_eq_finprod_Pi_image[OF assms]
+  have "generate G gs = (\<lambda>x. finprod G x gs) ` (\<Pi> a\<in>gs. generate G {a})" .
+  also have "\<dots> = (\<lambda>x. finprod G (\<lambda>g. g [^] x g) gs) ` Pi gs (\<lambda>_. (UNIV::int set))"
+  proof(rule; rule)
+    fix x
+    assume x: "x \<in> (\<lambda>x. finprod G x gs) ` (\<Pi> a\<in>gs. generate G {a})"
+    then obtain f where f: "f \<in> (\<Pi> a\<in>gs. generate G {a})" "x = finprod G f gs" by blast
+    hence "\<exists>k::int. f a = a [^] k" if "a \<in> gs" for a using generate_pow[of a] that assms(2) by blast
+    hence "\<exists>(h::'a \<Rightarrow> int). \<forall>a\<in>gs. f a = a [^] h a" by meson
+    then obtain h where h: "\<forall>a\<in>gs. f a = a [^] h a" "h \<in> gs \<rightarrow> (UNIV :: int set)" by auto
+    have "finprod G (\<lambda>g. g [^] h g) gs = finprod G f gs"
+      by (intro finprod_cong, use int_pow_closed h assms(2) in auto)
+    with f have "x = finprod G (\<lambda>g. g [^] h g) gs" by argo
+    with h(2) show "x \<in> (\<lambda>x. finprod G (\<lambda>g. g [^] x g) gs) ` (gs \<rightarrow> (UNIV::int set))" by auto
+  next
+    fix x
+    assume x: "x \<in> (\<lambda>x. finprod G (\<lambda>g. g [^] x g) gs) ` (gs \<rightarrow> (UNIV::int set))"
+    then obtain h where h: "x = finprod G (\<lambda>g. g [^] h g) gs" "h \<in> gs \<rightarrow> (UNIV :: int set)" by blast
+    hence "\<exists>k\<in>generate G {a}. a [^] h a = k" if "a \<in> gs" for a
+      using generate_pow[of a] that assms(2) by blast
+    then obtain f where f: "\<forall>a\<in>gs. a [^] h a = f a" "f \<in> (\<Pi> a\<in>gs. generate G {a})" by fast
+    have "finprod G f gs = finprod G (\<lambda>g. g [^] h g) gs"
+    proof(intro finprod_cong)
+      have "f a \<in> carrier G" if "a \<in> gs" for a
+        using generate_incl[of "{a}"] assms(2) that f(2) by fast
+      thus "(f \<in> gs \<rightarrow> carrier G) = True" by blast
+    qed (use f in auto)
+    with h have "x = finprod G f gs" by argo
+    with f(2) show "x \<in> (\<lambda>x. finprod G x gs) ` (\<Pi> a\<in>gs. generate G {a})" by blast
+  qed
+  finally show ?thesis .
+qed
+
+
+lemma (in comm_group) IDirProds_eq_finprod_PiE:
+  assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) G"
+  shows "IDirProds G S I = (\<lambda>x. finprod G x I) ` (Pi\<^sub>E I S)" (is "?DP = ?fp")
+proof
+  show "?fp \<subseteq> ?DP"
+  proof
+    fix x
+    assume x: "x \<in> ?fp"
+    then obtain f where f: "f \<in> (Pi\<^sub>E I S)" "x = finprod G f I" by blast
+    have sDP: "subgroup ?DP G"
+      by (intro IDirProds_is_subgroup; use subgroup.subset[OF assms(2)] in blast)
+    have "finprod G f I \<in> ?DP"
+    proof(intro finprod_closed_subgroup[OF sDP])
+      have "f i \<in> IDirProds G S I" if "i \<in> I" for i
+      proof
+        show "f i \<in> (S i)" using f(1) that by auto
+        show "(S i) \<subseteq> IDirProds G S I" by (intro IDirProds_incl[OF that])
+      qed
+      thus "f \<in> I \<rightarrow> IDirProds G S I" by simp
+    qed
+    thus "x \<in> ?DP" using f by blast
+  qed
+  show "?DP \<subseteq> ?fp"
+  proof(unfold IDirProds_def; rule subsetI)
+    fix x
+    assume x: "x \<in> generate G (\<Union>(S ` I))"
+    thus "x \<in> ?fp" using assms
+    proof (induction rule: generate.induct)
+      case one
+      define g where g: "g = (\<lambda>x. if x \<in> I then \<one> else undefined)"
+      then have "g \<in> Pi\<^sub>E I S"
+        using subgroup.one_closed[OF one(2)] by auto
+      moreover have "finprod G g I = \<one>" by (intro finprod_one_eqI; use g in simp)
+      ultimately show ?case unfolding image_def by (auto; metis)
+    next
+      case i: (incl h)
+      from i obtain j where j: "j \<in> I" "h \<in> (S j)" by blast
+      define hf where "hf = (\<lambda>x. (if x \<in> I then \<one> else undefined))(j := h)"
+      with j have "hf \<in> Pi\<^sub>E I S"
+        using subgroup.one_closed[OF i(3)] by force
+      moreover have "finprod G hf I = h"
+      proof -
+        have "finprod G hf I = hf j \<otimes> finprod G hf (I - {j})"
+          by (intro finprod_minus, use assms hf_def subgroup.subset[OF i(3)[OF j(1)]] j in auto)
+        moreover have "hf j = h" using hf_def by simp
+        moreover have "finprod G hf (I - {j}) = \<one>" by (rule finprod_one_eqI; use hf_def in simp)
+        ultimately show ?thesis using subgroup.subset[OF i(3)[OF j(1)]] j(2) by auto
+      qed
+      ultimately show ?case unfolding image_def by (auto; metis)
+    next
+      case i: (inv h)
+      from i obtain j where j: "j \<in> I" "h \<in> (S j)" by blast
+      have ih: "inv h \<in> (S j)" using subgroup.m_inv_closed[OF i(3)[OF j(1)] j(2)] .
+      define hf where "hf = (\<lambda>x. (if x \<in> I then \<one> else undefined))(j := inv h)"
+      with j ih have "hf \<in> Pi\<^sub>E I S"
+        using subgroup.one_closed[OF i(3)] by force
+      moreover have "finprod G hf I = inv h"
+      proof -
+        have "finprod G hf I = hf j \<otimes> finprod G hf (I - {j})"
+          by (intro finprod_minus, use assms hf_def subgroup.subset[OF i(3)[OF j(1)]] j in auto)
+        moreover have "hf j = inv h" using hf_def by simp
+        moreover have "finprod G hf (I - {j}) = \<one>" by (rule finprod_one_eqI; use hf_def in simp)
+        ultimately show ?thesis using subgroup.subset[OF i(3)[OF j(1)]] j(2) by auto
+      qed
+      ultimately show ?case unfolding image_def by (auto; metis)
+    next
+      case e: (eng a b)
+      from e obtain f where f: "f \<in> Pi\<^sub>E I S" "a = finprod G f I" by blast
+      from e obtain g where g: "g \<in> Pi\<^sub>E I S" "b = finprod G g I" by blast
+      from f g have "a \<otimes> b = finprod G f I \<otimes> finprod G g I" by blast
+      also have "\<dots> = finprod G (\<lambda>a. f a \<otimes> g a) I"
+      proof(intro finprod_multf[symmetric])
+        have "\<Union>(S ` I) \<subseteq> carrier G" using subgroup.subset[OF e(6)] by blast
+        thus "f \<in> I \<rightarrow> carrier G" "g \<in> I \<rightarrow> carrier G"
+          using f(1) g(1) unfolding PiE_def Pi_def by auto
+      qed
+      also have "\<dots> = finprod G (restrict (\<lambda>a. f a \<otimes> g a) I) I"
+      proof(intro finprod_cong)
+        show "I = I" by simp
+        show "\<And>i. i \<in> I =simp=> f i \<otimes> g i = (\<lambda>a\<in>I. f a \<otimes> g a) i" by simp
+        have fp: "f i \<in> (S i)" if "i \<in> I" for i using f that by auto
+        have gp: "g i \<in> (S i)" if "i \<in> I" for i using g that by auto
+        have "f i \<otimes> g i \<in> (S i)" if "i \<in> I" for i
+          using subgroup.m_closed[OF e(6)[OF that] fp[OF that] gp[OF that]] .
+        thus "((\<lambda>a. f a \<otimes> g a) \<in> I \<rightarrow> carrier G) = True" using subgroup.subset[OF e(6)] by auto
+      qed
+      finally have "a \<otimes> b = finprod G (restrict (\<lambda>a. f a \<otimes> g a) I) I" .
+      moreover have "(restrict (\<lambda>a. f a \<otimes> g a) I) \<in> Pi\<^sub>E I S"
+      proof -
+        have fp: "f i \<in> (S i)" if "i \<in> I" for i using f that by auto
+        have gp: "g i \<in> (S i)" if "i \<in> I" for i using g that by auto
+        have "f i \<otimes> g i \<in> (S i)" if "i \<in> I" for i
+          using subgroup.m_closed[OF e(6)[OF that] fp[OF that] gp[OF that]] .
+        thus ?thesis by auto
+      qed
+      ultimately show ?case using f g by blast
+    qed
+  qed
+qed
+
+lemma (in comm_group) IDirProds_eq_finprod_Pi:
+  assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) G"
+  shows "IDirProds G S I = (\<lambda>x. finprod G x I) ` (Pi I S)" (is "?DP = ?fp")
+proof -
+  have "(\<lambda>x. finprod G x I) ` (Pi I S) = (\<lambda>x. finprod G x I) ` (Pi\<^sub>E I S)"
+  proof
+    have "Pi\<^sub>E I S \<subseteq> Pi I S" by blast
+    thus "(\<lambda>x. finprod G x I) ` Pi\<^sub>E I S \<subseteq> (\<lambda>x. finprod G x I) ` Pi I S" by blast
+    show "(\<lambda>x. finprod G x I) ` Pi I S \<subseteq> (\<lambda>x. finprod G x I) ` Pi\<^sub>E I S"
+    proof
+      fix x
+      assume x: "x \<in> (\<lambda>x. finprod G x I) ` Pi I S"
+      then obtain f where f: "x = finprod G f I" "f \<in> Pi I S" by blast
+      moreover have "finprod G f I = finprod G (restrict f I) I"
+        by (intro finprod_cong; use f(2) subgroup.subset[OF assms(2)] in fastforce)
+      moreover have "restrict f I \<in> Pi\<^sub>E I S" using f(2) by simp
+      ultimately show "x \<in> (\<lambda>x. finprod G x I) ` Pi\<^sub>E I S" by blast
+    qed
+  qed
+  with IDirProds_eq_finprod_PiE[OF assms] show ?thesis by auto
+qed
+
+text \<open>If we switch one element from a set of generators, the generated set stays the same if both
+elements can be generated from the others together with the switched element respectively.\<close>
+
+lemma (in comm_group) generate_one_switched_exp_eqI:
+  assumes "A \<subseteq> carrier G" "a \<in> A" "B = (A - {a}) \<union> {b}"
+  and "f \<in> A \<rightarrow> (UNIV::int set)" "g \<in> B \<rightarrow> (UNIV::int set)"
+  and "a = finprod G (\<lambda>x. x [^] g x) B" "b = finprod G (\<lambda>x. x [^] f x) A"
+  shows "generate G A = generate G B"
+proof(intro generate_one_switched_eqI[OF assms(1, 2, 3)]; cases "finite A")
+  case True
+  hence fB: "finite B" using assms(3) by blast
+  have cB: "B \<subseteq> carrier G"
+  proof -
+    have "b \<in> carrier G"
+      by (subst assms(7), intro finprod_closed, use assms(1, 4) int_pow_closed in fast)
+    thus ?thesis using assms(1, 3) by blast
+  qed
+  show "a \<in> generate G B"
+  proof(subst generate_eq_finprod_Pi_image[OF fB cB], rule)
+    show "a = finprod G (\<lambda>x. x [^] g x) B" by fact
+    have "x [^] g x \<in> generate G {x}" if "x \<in> B" for x using generate_pow[of x] cB that by blast
+    thus "(\<lambda>x. x [^] g x) \<in> (\<Pi> a\<in>B. generate G {a})" unfolding Pi_def by blast
+  qed
+  show "b \<in> generate G A"
+  proof(subst generate_eq_finprod_Pi_image[OF True assms(1)], rule)
+    show "b = finprod G (\<lambda>x. x [^] f x) A" by fact
+    have "x [^] f x \<in> generate G {x}" if "x \<in> A" for x
+      using generate_pow[of x] assms(1) that by blast
+    thus "(\<lambda>x. x [^] f x) \<in> (\<Pi> a\<in>A. generate G {a})" unfolding Pi_def by blast
+  qed
+next
+  case False
+  hence b: "b = \<one>" using assms(7) unfolding finprod_def by simp
+  from False assms(3) have "infinite B" by simp
+  hence a: "a = \<one>" using assms(6) unfolding finprod_def by simp
+  show "a \<in> generate G B" using generate.one a by blast
+  show "b \<in> generate G A" using generate.one b by blast
+qed
+
+text \<open>We can characterize a complementary family of subgroups when the only way to form the neutral
+element as a product of picked elements from each subgroup is to pick the neutral element from each
+subgroup.\<close>
+
+lemma (in comm_group) compl_fam_imp_triv_finprod:
+  assumes "compl_fam S I" "finite I" "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) G"
+  and "finprod G f I = \<one>" "f \<in> Pi I S"
+  shows "\<forall>i\<in>I. f i = \<one>"
+proof (rule ccontr; clarify)
+  from assms(5) have f: "f i \<in> (S i)" if "i \<in> I" for i using that by fastforce
+  fix i
+  assume i: "i \<in> I"
+  have si: "subgroup (S i) G" using assms(3)[OF i] .
+  consider (triv) "(S i) = {\<one>}" | (not_triv) "(S i) \<noteq> {\<one>}" by blast
+  thus "f i = \<one>"
+  proof (cases)
+    case triv
+    then show ?thesis using f[OF i] by blast
+  next
+    case not_triv
+    show ?thesis
+    proof (rule ccontr)
+      have fc: "f i \<in> carrier G" using f[OF i] subgroup.subset[OF si] by blast
+      assume no: "f i \<noteq> \<one>"
+      have fH: "f i \<in> (S i)" using f[OF i] .
+      from subgroup.m_inv_closed[OF si this] have ifi: "inv (f i) \<in> (S i)" .
+      moreover have "inv (f i) \<noteq> \<one>" using no fc by simp
+      moreover have "inv (f i) = finprod G f (I - {i})"
+      proof -
+        have "\<one> = finprod G f I" using assms(4) by simp
+        also have "\<dots> = finprod G f (insert i (I - {i}))"
+        proof -
+          have "I = insert i (I - {i})" using i by fast
+          thus ?thesis by simp
+        qed
+        also have "\<dots> = f i \<otimes> finprod G f (I - {i})"
+        proof(intro finprod_insert)
+          show "finite (I - {i})" using assms(2) by blast
+          show "i \<notin> I - {i}" by blast
+          show "f \<in> I - {i} \<rightarrow> carrier G" using assms(3) f subgroup.subset by blast
+          show "f i \<in> carrier G" by fact
+        qed
+        finally have o: "\<one> = f i \<otimes> finprod G f (I - {i})" .
+        show ?thesis
+        proof(intro inv_equality)
+          show "f i \<in> carrier G" by fact
+          show "finprod G f (I - {i}) \<in> carrier G"
+            by (intro finprod_closed; use assms(3) f subgroup.subset in blast)
+          from m_comm[OF this fc] o show "finprod G f (I - {i}) \<otimes> f i = \<one>" by simp
+        qed
+      qed
+      moreover have "finprod G f (I - {i}) \<in> IDirProds G S (I - {i})"
+      proof (intro finprod_closed_subgroup IDirProds_is_subgroup)
+        show "\<Union> (S ` (I - {i})) \<subseteq> carrier G" using assms(3) subgroup.subset by auto
+        have "f j \<in> (IDirProds G S (I - {i}))" if "j \<in> (I - {i})" for j
+          using IDirProds_incl[OF that] f that by blast
+        thus "f \<in> I - {i} \<rightarrow> IDirProds G S (I - {i})" by blast
+      qed
+      ultimately have "\<not>complementary (S i) (IDirProds G S (I - {i}))"
+        unfolding complementary_def by auto
+      thus False using assms(1) i unfolding compl_fam_def by blast
+    qed
+  qed
+qed
+
+lemma (in comm_group) triv_finprod_imp_compl_fam:
+  assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) G"
+  and "\<forall>f \<in> Pi I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>)"
+  shows "compl_fam S I"
+proof (unfold compl_fam_def; rule)
+  fix k
+  assume k: "k \<in> I"
+  let ?DP = "IDirProds G S (I - {k})"
+  show "complementary (S k) ?DP"
+  proof (rule ccontr; unfold complementary_def)
+    have sk: "subgroup (S k) G" using assms(2)[OF k] .
+    have sDP: "subgroup ?DP G"
+      by (intro IDirProds_is_subgroup; use subgroup.subset[OF assms(2)] in blast)
+    assume a: "(S k) \<inter> IDirProds G S (I - {k}) \<noteq> {\<one>}"
+    then obtain x where x: "x \<in> (S k)" "x \<in> IDirProds G S (I - {k})" "x \<noteq> \<one>"
+      using subgroup.one_closed sk sDP by blast
+    then have "x \<in> (\<lambda>x. finprod G x (I - {k})) ` (Pi (I - {k}) S)"
+      using IDirProds_eq_finprod_Pi[of "(I - {k})"] assms(1, 2) by blast
+    then obtain ht where ht: "finprod G ht (I - {k}) = x" "ht \<in> Pi (I - {k}) S" by blast
+    define h where h: "h = (ht(k := inv x))"
+    then have hPi: "h \<in> Pi I S" using ht subgroup.m_inv_closed[OF assms(2)[OF k] x(1)] by auto
+    have "finprod G h (I - {k}) = x"
+    proof (subst ht(1)[symmetric], intro finprod_cong)
+      show "I - {k} = I - {k}" by simp
+      show "(h \<in> I - {k} \<rightarrow> carrier G) = True" using h ht(2) subgroup.subset[OF assms(2)]
+        unfolding Pi_def id_def by auto
+      show "\<And>i. i \<in> I - {k} =simp=> h i = ht i" using ht(2) h by simp
+    qed
+    moreover have "finprod G h I = h k \<otimes> finprod G h (I - {k})"
+      by (intro finprod_minus; use k assms hPi subgroup.subset[OF assms(2)] Pi_def in blast)
+    ultimately have "finprod G h I = inv x \<otimes> x" using h by simp
+    then have "finprod G h I = \<one>" using subgroup.subset[OF sk] x(1) by auto
+    moreover have "h k \<noteq> \<one>" using h x(3) subgroup.subset[OF sk] x(1) by force
+    ultimately show False using assms(3) k hPi by blast
+  qed
+qed
+
+lemma (in comm_group) triv_finprod_iff_compl_fam_Pi:
+  assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) G"
+  shows "compl_fam S I \<longleftrightarrow> (\<forall>f \<in> Pi I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>))"
+  using compl_fam_imp_triv_finprod triv_finprod_imp_compl_fam assms by blast
+
+lemma (in comm_group) triv_finprod_iff_compl_fam_PiE:
+  assumes "finite I" "\<And>i. i \<in> I \<Longrightarrow> subgroup (S i) G"
+  shows "compl_fam S I \<longleftrightarrow> (\<forall>f \<in> Pi\<^sub>E I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>))"
+proof
+  show "compl_fam S I \<Longrightarrow> \<forall>f\<in>Pi\<^sub>E I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>)"
+    using triv_finprod_iff_compl_fam_Pi[OF assms] by auto
+  have "\<forall>f\<in>Pi\<^sub>E I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>)
+    \<Longrightarrow> \<forall>f\<in>Pi I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>)"
+  proof(rule+)
+    fix f i
+    assume f: "f \<in> Pi I S" "finprod G f I = \<one>" and i: "i \<in> I"
+    assume allf: "\<forall>f\<in>Pi\<^sub>E I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>)"
+    have "f i = restrict f I i" using i by simp
+    moreover have "finprod G (restrict f I) I = finprod G f I"
+      using f subgroup.subset[OF assms(2)] unfolding Pi_def by (intro finprod_cong; auto)
+    moreover have "restrict f I \<in> Pi\<^sub>E I S" using f by simp
+    ultimately show "f i = \<one>" using allf f i by metis
+  qed
+  thus "\<forall>f\<in>Pi\<^sub>E I S. finprod G f I = \<one> \<longrightarrow> (\<forall>i\<in>I. f i = \<one>) \<Longrightarrow> compl_fam S I"
+    using triv_finprod_iff_compl_fam_Pi[OF assms] by presburger
+qed
+
+text \<open>The finite product also distributes when nested.\<close>
+
+(* Manuel Eberl, TODO: move to library *)
+lemma (in comm_monoid) finprod_Sigma:
+  assumes "finite A" "\<And>x. x \<in> A \<Longrightarrow> finite (B x)"
+  assumes "\<And>x y. x \<in> A \<Longrightarrow> y \<in> B x \<Longrightarrow> g x y \<in> carrier G"
+  shows   "(\<Otimes>x\<in>A. \<Otimes>y\<in>B x. g x y) = (\<Otimes>z\<in>Sigma A B. case z of (x, y) \<Rightarrow> g x y)"
+  using assms
+proof (induction A rule: finite_induct)
+  case (insert x A)
+  have "(\<Otimes>z\<in>Sigma (insert x A) B. case z of (x, y) \<Rightarrow> g x y) =
+          (\<Otimes>z\<in>Pair x ` B x. case z of (x, y) \<Rightarrow> g x y) \<otimes> (\<Otimes>z\<in>Sigma A B. case z of (x, y) \<Rightarrow> g x y)"
+    unfolding Sigma_insert using insert.prems insert.hyps
+    by (subst finprod_Un_disjoint) auto
+  also have "(\<Otimes>z\<in>Sigma A B. case z of (x, y) \<Rightarrow> g x y) = (\<Otimes>x\<in>A. \<Otimes>y\<in>B x. g x y)"
+    using insert.prems insert.hyps by (subst insert.IH [symmetric]) auto
+  also have "(\<Otimes>z\<in>Pair x ` B x. case z of (x, y) \<Rightarrow> g x y) = (\<Otimes>y\<in>B x. g x y)"
+    using insert.prems insert.hyps by (subst finprod_reindex) (auto intro: inj_onI)
+  finally show ?case
+    using insert.hyps insert.prems by simp
+qed auto
+
+text \<open>With the now proven facts, we are able to provide criterias to inductively construct a
+group that is the internal direct product of a set of generators.\<close>
+
+(* belongs to IDirProd, but uses finprod stuff *)
+lemma (in comm_group) idirprod_generate_ind:
+  assumes "finite gs" "gs \<subseteq> carrier G" "g \<in> carrier G"
+          "is_idirprod (generate G gs) (\<lambda>g. generate G {g}) gs"
+          "complementary (generate G {g}) (generate G gs)"
+  shows "is_idirprod (generate G (gs \<union> {g})) (\<lambda>g. generate G {g}) (gs \<union> {g})"
+proof(cases "g \<in> gs")
+  case True
+  hence "gs = (gs \<union> {g})" by blast
+  thus ?thesis using assms(4) by auto 
+next
+  case gngs: False
+  show ?thesis
+  proof (intro is_idirprod_subgroup_suffices)
+    have gsgc: "gs \<union> {g} \<subseteq> carrier G" using assms(2, 3) by blast
+    thus "generate G (gs \<union> {g}) = IDirProds G (\<lambda>g. generate G {g}) (gs \<union> {g})"
+      unfolding IDirProds_def using generate_idem_Un by presburger
+    show "\<forall>i\<in>gs \<union> {g}. subgroup (generate G {i}) G" using generate_is_subgroup gsgc by auto
+    have sg: "subgroup (generate G {g}) G" by (intro generate_is_subgroup, use assms(3) in blast)
+    from assms(4) is_idirprod_def have ih: "\<forall>x. x \<in> gs \<longrightarrow> generate G {x} \<lhd> G"
+                                           "compl_fam (\<lambda>g. generate G {g}) gs"
+      by fastforce+
+    hence ca: "complementary (generate G {a}) (generate G (gs - {a}))" if "a \<in> gs" for a
+      unfolding compl_fam_def IDirProds_def
+      using gsgc generate_idem_Un[of "gs - {a}"] that by fastforce
+    have aux: "gs \<union> {g} - {i} \<subseteq> carrier G" for i using gsgc by blast
+    show "compl_fam (\<lambda>g. generate G {g}) (gs \<union> {g})"
+    proof(unfold compl_fam_def IDirProds_def, subst generate_idem_Un[OF aux],
+          rule, rule ccontr)
+      fix h
+      assume h: "h \<in> gs \<union> {g}"
+      assume c: "\<not> complementary (generate G {h}) (generate G (gs \<union> {g} - {h}))"
+      show "False"
+      proof (cases "h = g")
+        case True
+        with c have "\<not> complementary (generate G {g}) (generate G (gs - {g}))" by auto
+        moreover have "complementary (generate G {g}) (generate G (gs - {g}))"
+          by (rule subgroup_subset_complementary[OF generate_is_subgroup generate_is_subgroup[of gs]
+                   generate_is_subgroup mono_generate], use assms(2, 3, 5) in auto)
+        ultimately show False by blast
+      next
+        case hng: False
+        hence h: "h \<in> gs" "h \<noteq> g" using h by blast+
+        hence "gs \<union> {g} - {h} = gs - {h} \<union> {g}" by blast
+        with c have c: "\<not> complementary (generate G {h}) (generate G (gs - {h} \<union> {g}))" by argo
+        then obtain k where k: "k \<in> generate G {h}" "k \<in> generate G (gs - {h} \<union> {g})" "k \<noteq> \<one>"
+          unfolding complementary_def using generate.one by blast 
+        with ca have kngh: "k \<notin> generate G (gs - {h})" using h unfolding complementary_def by blast
+        from k(2) generate_eq_finprod_PiE_image[of "gs - {h} \<union> {g}"] assms(1) gsgc
+        obtain f where f:
+          "k = finprod G f (gs - {h} \<union> {g})" "f \<in> (\<Pi>\<^sub>E a\<in>gs - {h} \<union> {g}. generate G {a})"
+          by blast
+        have fg: "f a \<in> generate G {a}" if "a \<in> (gs - {h} \<union> {g})" for a using that f(2) by blast
+        have fc: "f a \<in> carrier G" if "a \<in> (gs - {h} \<union> {g})" for a
+        proof -
+          have "generate G {a} \<subseteq> carrier G" if "a \<in> (gs - {h} \<union> {g})" for a
+            using that generate_incl[of "{a}"] gsgc by blast
+          thus "f a \<in> carrier G" using that fg by auto
+        qed
+        have kp: "k = f g \<otimes> finprod G f (gs - {h})"
+        proof -
+          have "(gs - {h} \<union> {g}) = insert g (gs - {h})" by fast
+          moreover have "finprod G f (insert g (gs - {h})) = f g \<otimes> finprod G f (gs - {h})"
+            by (intro finprod_insert, use fc assms(1) gngs in auto)
+          ultimately show ?thesis using f(1) by argo
+        qed
+        have fgsh: "finprod G f (gs - {h}) \<in> generate G (gs - {h})"
+        proof(intro finprod_closed_subgroup[OF generate_is_subgroup])
+          show "gs - {h} \<subseteq> carrier G" using gsgc by blast
+          have "f a \<in> generate G (gs - {h})" if "a \<in> (gs - {h})" for a
+            using mono_generate[of "{a}" "gs - {h}"] fg that by blast
+          thus "f \<in> gs - {h} \<rightarrow> generate G (gs - {h})" by blast
+        qed
+        have "f g \<otimes> finprod G f (gs - {h}) \<notin> generate G gs"
+        proof
+          assume fpgs: "f g \<otimes> finprod G f (gs - {h}) \<in> generate G gs"
+          from fgsh have fgsgs: "finprod G f (gs - {h}) \<in> generate G gs"
+            using mono_generate[of "gs - {h}" gs] by blast
+          have fPi: "f \<in> (\<Pi> a\<in>(gs - {h}). generate G {a})" using f by blast
+          have gI: "generate G (gs - {h})
+                  = (\<lambda>x. finprod G x (gs - {h})) ` (\<Pi> a\<in>gs - {h}. generate G {a})"
+            using generate_eq_finprod_Pi_image[of "gs - {h}"] assms(1, 2) by blast
+          have fgno: "f g \<noteq> \<one>"
+          proof (rule ccontr)
+            assume o: "\<not> f g \<noteq> \<one>"
+            hence kf: "k = finprod G f (gs - {h})" using kp finprod_closed fc by auto
+            hence "k \<in> generate G (gs - {h})" using fPi gI by blast
+            thus False using k ca h unfolding complementary_def by blast
+          qed
+          from fpgs have "f g \<in> generate G gs"
+            using subgroup.mult_in_cancel_right[OF generate_is_subgroup[OF assms(2)] fc[of g] fgsgs]
+            by blast
+          with fgno assms(5) fg[of g] show "False" unfolding complementary_def by blast
+        qed
+        moreover have "k \<in> generate G gs" using k(1) mono_generate[of "{h}" gs] h(1) by blast
+        ultimately show False using kp by blast
+      qed
+    qed
+  qed
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/Finitely_Generated_Abelian_Groups.thy b/thys/Finitely_Generated_Abelian_Groups/Finitely_Generated_Abelian_Groups.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Finitely_Generated_Abelian_Groups.thy
@@ -0,0 +1,982 @@
+(*
+    File:     Finitely_Generated_Abelian_Groups.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Fundamental Theorem of Finitely Generated Abelian Groups\<close>
+
+theory Finitely_Generated_Abelian_Groups
+  imports DirProds Group_Relations
+begin
+
+notation integer_mod_group ("Z")
+
+locale fin_gen_comm_group = comm_group +
+  fixes gen :: "'a set"
+  assumes gens_closed: "gen \<subseteq> carrier G"
+  and     fin_gen: "finite gen"
+  and     generators: "carrier G = generate G gen"
+
+text \<open>Every finite abelian group is also finitely generated.\<close>
+
+sublocale finite_comm_group \<subseteq> fin_gen_comm_group G "carrier G"
+  using generate_incl generate_sincl by (unfold_locales, auto)
+
+text \<open>This lemma contains the proof of Kemper from his lecture notes on algebra~\cite{kemper}.
+However, the proof is not done in the context of a finitely generated group but for a finitely
+generated subgroup in a commutative group.\<close>
+
+lemma (in comm_group) ex_idirgen:
+  fixes A :: "'a set"
+  assumes "finite A" "A \<subseteq> carrier G"
+  shows "\<exists>gs. set gs \<subseteq> generate G A \<and> distinct gs \<and> is_idirprod (generate G A) (\<lambda>g. generate G {g}) (set gs)
+            \<and> successively (dvd) (map ord gs) \<and> card (set gs) \<le> card A"
+  (is "?t A")
+  using assms
+proof (induction "card A" arbitrary: A rule: nat_less_induct)
+  case i: 1
+  show ?case
+  proof (cases "relations A = {restrict (\<lambda>_. 0::int) A}") (* only trivial relation *)
+    case True
+    have fi: "finite A" by fact
+    then obtain gs where gs: "set gs = A" "distinct gs" by (meson finite_distinct_list)
+    have o: "ord g = 0" if "g \<in> set gs" for g
+      by (intro relations_zero_imp_ord_zero[OF that], use i(3) that True gs in auto)
+    have m: "map ord gs = replicate (length gs) 0" using o
+      by (induction gs; auto)
+    show ?thesis
+    proof(intro exI conjI subsetI)
+      show "\<And>x. x \<in> set gs \<Longrightarrow> x \<in> generate G A" using gs generate.incl[of _ A G] by blast
+      show "distinct gs" by fact
+      show "is_idirprod (generate G A) (\<lambda>g. generate G {g}) (set gs)"
+      proof(unfold is_idirprod_def, intro conjI, rule)
+        show "generate G {g} \<lhd> G" if "g \<in> set gs" for g
+          by (intro subgroup_imp_normal, use that generate_is_subgroup i(3) gs in auto)
+        show "generate G A = IDirProds G (\<lambda>g. generate G {g}) (set gs)" unfolding IDirProds_def
+          by (subst gs(1), use generate_idem_Un i(3) in blast)
+        show "compl_fam (\<lambda>g. generate G {g}) (set gs)" using compl_fam_iff_relations_triv[OF i(2, 3)] o gs(1) True
+          by blast 
+      qed
+      show "successively (dvd) (map ord gs)" using m
+      proof (induction gs)
+        case c: (Cons a gs)
+        thus ?case by(cases gs; simp)
+      qed simp
+      show "card (set gs) \<le> card A" using gs by blast
+    qed
+  next
+    case ntrel: False
+    then have Ane: "A \<noteq> {}"
+      using i(2) triv_rel[of A] unfolding relations_def extensional_def by fastforce
+    from ntrel obtain a where a: "a \<in> A" "\<exists>r \<in>relations A. r a \<noteq> 0" using i(2) triv_rel[of A]
+      unfolding relations_def extensional_def by fastforce
+    hence ac: "a \<in> carrier G" using i(3) by blast
+    have iH: "\<And>B.\<lbrakk>card B < card A; finite B; B \<subseteq> carrier G\<rbrakk> \<Longrightarrow> ?t B"
+      using i(1) by blast
+    have iH2: "\<And>B. \<lbrakk>?t B; generate G A = generate G B; card B < card A\<rbrakk> \<Longrightarrow> ?t A"
+      by fastforce
+    show ?thesis
+    proof(cases "inv a \<in> (A - {a})")
+      case True
+      have "generate G A = generate G (A - {a})"
+      proof(intro generate_subset_eqI[OF i(3)])
+        show "A - (A - {a}) \<subseteq> generate G (A - {a})"
+        proof -
+          have "A - (A - {a}) = {a}" using a True by auto
+          also have "\<dots> \<subseteq> generate G {inv a}" using generate.inv[of "inv a" "{inv a}" G] ac by simp
+          also have "\<dots> \<subseteq> generate G (A - {a})" by (intro mono_generate, use True in simp)
+          finally show ?thesis .
+        qed
+      qed simp
+      moreover have "?t (A - {a})"
+        by (intro iH[of "A - {a}"], use i(2, 3) a(1) in auto, meson Ane card_gt_0_iff diff_Suc_less)
+      ultimately show ?thesis using card.remove[OF i(2) a(1)] by fastforce
+    next
+      case inv: False
+      define n where n: "n = card A"
+      define all_gens where
+        "all_gens = {gs\<in>Pow (generate G A). finite gs \<and> card gs \<le> n \<and> generate G gs = generate G A}"
+
+      define exps where "exps = (\<Union>gs'\<in>all_gens. \<Union>rel\<in>relations gs'. nat ` {e\<in>rel`gs'. e > 0})"
+      define min_exp where "min_exp = Inf exps"
+
+      have "exps \<noteq> {}"
+      proof -
+        let ?B = "A - {a} \<union> {inv a}"
+        have "A \<in> all_gens" unfolding all_gens_def using generate.incl n i(2) by fast
+        moreover have "?B \<in> all_gens"
+        proof -
+          have "card (A - {a}) = n - 1" using a n by (meson card_Diff_singleton_if i(2))
+          hence "card ?B = n" using inv i(2, 3) n a(1)
+            by (metis Un_empty_right Un_insert_right card.remove card_insert_disjoint finite_Diff) 
+          moreover have "generate G A = generate G ?B"
+          proof(intro generate_one_switched_eqI[OF i(3) a(1), of _ "inv a"])
+            show "inv a \<in> generate G A" using generate.inv[OF a(1), of G] .
+            show "a \<in> generate G ?B"
+            proof -
+              have "a \<in> generate G {inv a}" using generate.inv[of "inv a" "{inv a}" G] ac by simp
+              also have "\<dots> \<subseteq> generate G ?B" by (intro mono_generate, blast)
+              finally show ?thesis .
+            qed
+          qed simp
+          moreover hence "?B \<subseteq> generate G A" using generate_sincl by simp
+          ultimately show ?thesis unfolding all_gens_def using i(2) by blast
+        qed
+        moreover have "(\<exists>r \<in> relations A. r a > 0) \<or> (\<exists>r \<in> relations ?B. r (inv a) > 0)"
+        proof(cases "\<exists>r \<in> relations A. r a > 0")
+          case True
+          then show ?thesis by blast
+        next
+          case False
+          with a obtain r where r: "r \<in> relations A" "r a < 0" by force
+          have rc: "(\<lambda>x. x [^] r x) \<in> A \<rightarrow> carrier G" using i(3) int_pow_closed by fast
+          let ?r = "restrict (r(inv a := - r a)) ?B"
+          have "?r \<in> relations ?B"
+          proof
+            have "finprod G (\<lambda>x. x [^] ?r x) ?B = finprod G (\<lambda>x. x [^] r x) A"
+            proof -
+              have "finprod G (\<lambda>x. x [^] ?r x) ?B
+                  = finprod G (\<lambda>x. x [^] ?r x) (insert (inv a) (A - {a}))" by simp
+              also have "\<dots> = (inv a) [^] ?r (inv a) \<otimes> finprod G (\<lambda>x. x [^] ?r x) (A - {a})"
+              proof(intro finprod_insert[OF _ inv])
+                show "finite (A - {a})" using i(2) by fast
+                show "inv a [^] ?r (inv a) \<in> carrier G"
+                  using int_pow_closed[OF inv_closed[OF ac]] by fast
+                show "(\<lambda>x. x [^] ?r x) \<in> A - {a} \<rightarrow> carrier G" using int_pow_closed i(3) by fast
+              qed
+              also have "\<dots> = a [^] r a \<otimes> finprod G (\<lambda>x. x [^] r x) (A - {a})"
+              proof -
+                have "(inv a) [^] ?r (inv a) = a [^] r a"
+                  by (simp add: int_pow_inv int_pow_neg ac)
+                moreover have "finprod G (\<lambda>x. x [^] r x) (A - {a})
+                             = finprod G (\<lambda>x. x [^] ?r x) (A - {a})"
+                proof(intro finprod_cong)
+                  show "((\<lambda>x. x [^] r x) \<in> A - {a} \<rightarrow> carrier G) = True" using rc by blast
+                  have "i [^] r i = i [^] ?r i" if "i \<in> A - {a}" for i using that inv by auto
+                  thus "\<And>i. i \<in> A - {a} =simp=> i [^] r i = i [^] restrict (r(inv a := - r a)) (A - {a} \<union> {inv a}) i"
+                    by algebra
+                qed simp
+                ultimately show ?thesis by argo
+              qed
+              also have "\<dots> = finprod G (\<lambda>x. x [^] r x) A"
+                by (intro finprod_minus[symmetric, OF a(1) rc i(2)])
+              finally show ?thesis .
+            qed
+            also have "\<dots> = \<one>" using r unfolding relations_def by fast
+            finally show "finprod G (\<lambda>x. x [^] ?r x) ?B = \<one>" .
+          qed simp
+          then show ?thesis using r by fastforce
+        qed
+        ultimately show ?thesis unfolding exps_def using a by blast
+      qed
+      hence me: "min_exp \<in> exps"
+        unfolding min_exp_def using Inf_nat_def1 by force
+      from cInf_lower min_exp_def have le: "\<And>x. x \<in> exps \<Longrightarrow> min_exp \<le> x" by blast
+      from me obtain gs rel g
+        where gr: "gs \<in> all_gens" "rel \<in> relations gs" "g \<in> gs" "rel g = min_exp" "min_exp > 0"
+        unfolding exps_def by auto
+      from gr(1) have cgs: "card gs \<le> card A" unfolding all_gens_def n by blast
+      with gr(3) have cgsg: "card (gs - {g}) < card A"
+        by (metis Ane card.infinite card_Diff1_less card_gt_0_iff finite.emptyI
+                  finite.insertI finite_Diff2 i.prems(1) le_neq_implies_less less_trans)
+      from gr(1) have fgs: "finite gs" and gsg: "generate G gs = generate G A"
+        unfolding all_gens_def n using i(2) card.infinite Ane by force+
+      from gsg have gsc: "gs \<subseteq> carrier G" unfolding all_gens_def
+        using generate_incl[OF i(3)] generate_sincl[of gs] by simp
+      hence gc: "g \<in> carrier G" using gr(3) by blast
+      have ihgsg: "?t (gs - {g})"
+        by (intro iH, use cgs fgs gsc gr(3) cgsg in auto)
+      then obtain hs where
+        hs: "set hs \<subseteq> generate G (gs - {g})" "distinct hs"
+            "is_idirprod (generate G (gs - {g})) (\<lambda>g. generate G {g}) (set hs)"
+            "successively (dvd) (map ord hs)" "card (set hs) \<le> card (gs - {g})" by blast
+      hence hsc: "set hs \<subseteq> carrier G"
+        using generate_sincl[of "set hs"] generate_incl[of "gs - {g}"] gsc by blast
+      from hs(3) have ghs: "generate G (gs - {g}) = generate G (set hs)"
+        unfolding is_idirprod_def IDirProds_def using generate_idem_Un[OF hsc] by argo
+      have dvot: "?t A \<or> (\<forall>e\<in>rel`gs. rel g dvd e)"
+      proof(intro disjCI)
+        assume na: "\<not> (\<forall>e\<in>rel ` gs. rel g dvd e)"
+        have "\<And>x. \<lbrakk>x \<in> gs; \<not>rel g dvd rel x\<rbrakk> \<Longrightarrow> ?t A"
+        proof -
+          fix x
+          assume x: "x \<in> gs" "\<not> rel g dvd rel x"
+          hence xng: "x \<noteq> g" by auto
+          from x have xc: "x \<in> carrier G" using gsc by blast
+          have rg: "rel g > 0" using gr by simp
+          define r::int where r: "r = rel x mod rel g"
+          define q::int where q: "q = rel x div rel g"
+          from r rg x have "r > 0"
+            using mod_int_pos_iff[of "rel x" "rel g"] mod_eq_0_iff_dvd by force
+          moreover have "r < rel g" using r rg Euclidean_Division.pos_mod_bound by blast
+          moreover have "rel x = q * rel g + r" using r q by presburger
+          ultimately have rq: "rel x = q * (rel g) + r" "0 < r" "r < rel g" by auto
+          define t where t: "t = g \<otimes> x [^] q"
+          hence tc: "t \<in> carrier G" using gsc gr(3) x by fast
+          define s where s: "s = gs - {g} \<union> {t}"
+          hence fs: "finite s" using fgs by blast
+          have sc: "s \<subseteq> carrier G" using s tc gsc by blast
+          have g: "generate G gs = generate G s"
+          proof(unfold s, intro generate_one_switched_eqI[OF gsc gr(3), of _ t])
+            show "t \<in> generate G gs"
+            proof(unfold t, intro generate.eng)
+              show "g \<in> generate G gs" using gr(3) generate.incl by fast
+              show "x [^] q \<in> generate G gs"
+                using x generate_pow[OF xc] generate_sincl[of "{x}"] mono_generate[of "{x}" gs]
+                by fast
+            qed
+            show "g \<in> generate G (gs - {g} \<union> {t})"
+            proof -
+              have gti: "g = t \<otimes> inv (x [^] q)"
+                using inv_solve_right[OF gc tc int_pow_closed[OF xc, of q]] t by blast
+              moreover have "t \<in> generate G (gs - {g} \<union> {t})" by (intro generate.incl[of t], simp)
+              moreover have "inv (x [^] q) \<in> generate G (gs - {g})"
+              proof -
+                have "x [^] q \<in> generate G {x}" using generate_pow[OF xc] by blast
+                from generate_m_inv_closed[OF _ this] xc
+                have "inv (x [^] q) \<in> generate G {x}" by blast
+                moreover have "generate G {x} \<subseteq> generate G (gs - {g})"
+                  by (intro mono_generate, use x a in force)
+                finally show ?thesis .
+              qed
+              ultimately show ?thesis
+                using generate.eng mono_generate[of "gs - {g}" "gs - {g} \<union> {t}"] by fast
+            qed
+          qed simp
+          show "\<lbrakk>x \<in> gs; \<not> rel g dvd rel x\<rbrakk> \<Longrightarrow> ?t A"
+          proof (cases "t \<in> gs - {g}")
+            case xt: True
+            from xt have gts: "s = gs - {g}" using x s by auto
+            moreover have "card (gs - {g}) < card gs" using fgs gr(3) by (meson card_Diff1_less)
+            ultimately have "card (set hs) < card A" using hs(5) cgs by simp
+            moreover have "set hs \<subseteq> generate G (set hs)" using generate_sincl by simp
+            moreover have "distinct hs" by fact
+            moreover have "is_idirprod (generate G (set hs)) (\<lambda>g. generate G {g}) (set hs)"
+              using hs ghs unfolding is_idirprod_def by blast
+            moreover have "generate G A = generate G (set hs)" using g gts ghs gsg by argo
+            moreover have "successively (dvd) (map ord hs)" by fact
+            ultimately show "?t A" using iH2 by blast
+          next
+            case tngsg: False
+            hence xnt: "x \<noteq> t" using x xng by blast
+            have "rel g dvd rel x"
+            proof (rule ccontr)
+              have "nat r \<in> exps" unfolding exps_def
+              proof
+                show "s \<in> all_gens" unfolding all_gens_def
+                  using gsg g fgs generate_sincl[of s] switch_elem_card_le[OF gr(3), of t] cgs n s
+                  by auto
+                have xs: "x \<in> s" using s xng x(1) by blast
+                have ts: "t \<in> s" using s by fast
+                show "nat r \<in> (\<Union>rel\<in>relations s. nat ` {e \<in> rel ` s. 0 < e})"
+                proof
+                  let ?r = "restrict (rel(x := r, t := rel g)) s"
+                  show "?r \<in> relations s"
+                  proof
+                    have "finprod G (\<lambda>x. x [^] ?r x) s = finprod G (\<lambda>x. x [^] rel x) gs"
+                    proof -
+                      have "finprod G (\<lambda>x. x [^] ?r x) s = x [^] r \<otimes> (t [^] rel g \<otimes> finprod G (\<lambda>x. x [^] rel x) (gs - {g} - {x}))"
+                      proof -
+                        have "finprod G (\<lambda>x. x [^] ?r x) s = x [^] ?r x \<otimes> finprod G (\<lambda>x. x [^] ?r x) (s - {x})"
+                          by (intro finprod_minus[OF xs _ fs], use sc in auto) 
+                        moreover have "finprod G (\<lambda>x. x [^] ?r x) (s - {x}) = t [^] ?r t \<otimes> finprod G (\<lambda>x. x [^] ?r x) (s - {x} - {t})"
+                          by (intro finprod_minus, use ts xnt fs sc in auto)
+                        moreover have "finprod G (\<lambda>x. x [^] ?r x) (s - {x} - {t}) = finprod G (\<lambda>x. x [^] rel x) (s - {x} - {t})"
+                          unfolding s by (intro finprod_cong',  use gsc in auto)
+                        moreover have "s - {x} - {t} = gs - {g} - {x}" unfolding s using tngsg by blast
+                        moreover hence "finprod G (\<lambda>x. x [^] rel x) (s - {x} - {t}) = finprod G (\<lambda>x. x [^] rel x) (gs - {g} - {x})" by simp
+                        moreover have "x [^] ?r x = x [^] r" using xs xnt by auto
+                        moreover have "t [^] ?r t = t [^] rel g" using ts by simp
+                        ultimately show ?thesis by argo
+                      qed
+                      also have "\<dots> = x [^] r \<otimes> t [^] rel g \<otimes> finprod G (\<lambda>x. x [^] rel x) (gs - {g} - {x})"
+                        by (intro m_assoc[symmetric], use xc tc in simp_all, intro finprod_closed, use gsc in fast)
+                      also have "\<dots> = g [^] rel g \<otimes> x [^] rel x \<otimes> finprod G (\<lambda>x. x [^] rel x) (gs - {g} - {x})"
+                      proof -
+                        have "x [^] r \<otimes> t [^] rel g = g [^] rel g \<otimes> x [^] rel x"
+                        proof -
+                          have "x [^] r \<otimes> t [^] rel g = x [^] r \<otimes> (g \<otimes> x [^] q) [^] rel g" using t by blast
+                          also have "\<dots> = x [^] r \<otimes> x [^] (q * rel g) \<otimes> g [^] rel g"
+                          proof -
+                            have "(g \<otimes> x [^] q) [^] rel g = g [^] rel g \<otimes> (x [^] q) [^] rel g"
+                              using gc xc int_pow_distrib by auto
+                            moreover have "(x [^] q) [^] rel g = x [^] (q * rel g)" using xc int_pow_pow by auto
+                            moreover have "g [^] rel g \<otimes> x [^] (q * rel g) = x [^] (q * rel g) \<otimes> g [^] rel g"
+                              using m_comm[OF int_pow_closed[OF xc] int_pow_closed[OF gc]] by simp
+                            ultimately have "(g \<otimes> x [^] q) [^] rel g = x [^] (q * rel g) \<otimes> g [^] rel g" by argo
+                            thus ?thesis by (simp add: gc m_assoc xc)
+                          qed
+                          also have "\<dots> = x [^] rel x \<otimes> g [^] rel g"
+                          proof -
+                            have "x [^] r \<otimes> x [^] (q * rel g) = x [^] (q * rel g + r)"
+                              by (simp add: add.commute int_pow_mult xc)
+                            also have "\<dots> = x [^] rel x" using rq by argo
+                            finally show ?thesis by argo
+                          qed
+                          finally show ?thesis by (simp add: gc m_comm xc)
+                        qed
+                        thus ?thesis by simp
+                      qed
+                      also have "\<dots> = g [^] rel g \<otimes> (x [^] rel x \<otimes> finprod G (\<lambda>x. x [^] rel x) (gs - {g} - {x}))"
+                        by (intro m_assoc, use xc gc in simp_all, intro finprod_closed, use gsc in fast)
+                      also have "\<dots> = g [^] rel g \<otimes> finprod G (\<lambda>x. x [^] rel x) (gs - {g})"
+                      proof -
+                        have "finprod G (\<lambda>x. x [^] rel x) (gs - {g}) = x [^] rel x \<otimes> finprod G (\<lambda>x. x [^] rel x) (gs - {g} - {x})"
+                          by (intro finprod_minus, use xng x(1) fgs gsc in auto)
+                        thus ?thesis by argo
+                      qed
+                      also have "\<dots> = finprod G (\<lambda>x. x [^] rel x) gs" by (intro finprod_minus[symmetric, OF gr(3) _ fgs], use gsc in auto)
+                      finally show ?thesis .
+                    qed                        
+                    thus "finprod G (\<lambda>x. x [^] ?r x) s = \<one>" using gr(2) unfolding relations_def by simp
+                  qed auto
+                  show "nat r \<in> nat ` {e \<in> ?r ` s. 0 < e}" using xs xnt rq(2) by fastforce
+                qed
+              qed
+              from le[OF this] rq(3) gr(4, 5) show False by linarith
+            qed
+            thus "\<lbrakk>x \<in> gs; \<not> rel g dvd rel x\<rbrakk> \<Longrightarrow> ?t A" by blast
+          qed
+        qed
+        thus "?t A" using na by blast
+      qed
+      show "?t A"
+      proof (cases "\<forall>e\<in>rel`gs. rel g dvd e")
+        case dv: True
+        define tau where "tau = finprod G (\<lambda>x. x [^] ((rel x) div rel g)) gs"
+        have tc: "tau \<in> carrier G"
+          by (subst tau_def, intro finprod_closed[of "(\<lambda>x. x [^] ((rel x) div rel g))" gs], use gsc in fast) 
+        have gts: "generate G gs = generate G (gs - {g} \<union> {tau})"
+        proof(intro generate_one_switched_eqI[OF gsc gr(3), of _ tau])
+          show "tau \<in> generate G gs" by (subst generate_eq_finprod_Pi_int_image[OF fgs gsc], unfold tau_def, fast)
+          show "g \<in> generate G (gs - {g} \<union> {tau})"
+          proof -
+            have "tau = g \<otimes> finprod G (\<lambda>x. x [^] ((rel x) div rel g)) (gs - {g})"
+            proof -
+              have "finprod G (\<lambda>x. x [^] ((rel x) div rel g)) gs = g [^] (rel g div rel g) \<otimes> finprod G (\<lambda>x. x [^] ((rel x) div rel g)) (gs - {g})"
+                by (intro finprod_minus[OF gr(3) _ fgs], use gsc in fast)
+              moreover have "g [^] (rel g div rel g) = g" using gr gsc by auto
+              ultimately show ?thesis unfolding tau_def by argo
+            qed
+            hence gti: "g = tau \<otimes> inv finprod G (\<lambda>x. x [^] ((rel x) div rel g)) (gs - {g})"
+              using inv_solve_right[OF gc tc finprod_closed[of "(\<lambda>x. x [^] ((rel x) div rel g))" "gs - {g}"]] gsc
+              by fast
+            have "tau \<in> generate G (gs - {g} \<union> {tau})" by (intro generate.incl[of tau], simp)
+            moreover have "inv finprod G (\<lambda>x. x [^] ((rel x) div rel g)) (gs - {g}) \<in> generate G (gs - {g})"
+            proof -
+              have "finprod G (\<lambda>x. x [^] ((rel x) div rel g)) (gs - {g}) \<in> generate G (gs - {g})"
+                using generate_eq_finprod_Pi_int_image[of "gs - {g}"] fgs gsc by fast
+              from  generate_m_inv_closed[OF _ this] gsc show ?thesis by blast
+            qed
+            ultimately show ?thesis by (subst gti, intro generate.eng, use mono_generate[of "gs - {g}"] in auto)
+          qed
+        qed simp
+        with gr(1) have gt: "generate G (gs - {g} \<union> {tau}) = generate G A" unfolding all_gens_def by blast
+        have trgo: "tau [^] rel g = \<one>"
+        proof -
+          have "tau [^] rel g = finprod G (\<lambda>x. x [^] ((rel x) div rel g)) gs [^] rel g" unfolding tau_def by blast
+          also have "\<dots> = finprod G ((\<lambda>x. x [^] rel g) \<circ> (\<lambda>x. x [^] ((rel x) div rel g))) gs"
+            by (intro finprod_exp, use gsc in auto)
+          also have "\<dots> = finprod G (\<lambda>a. a [^] rel a) gs"
+          proof(intro finprod_cong')
+            show "((\<lambda>x. x [^] rel g) \<circ> (\<lambda>x. x [^] ((rel x) div rel g))) x = x [^] rel x" if "x \<in> gs" for x
+            proof -
+              have "((\<lambda>x. x [^] rel g) \<circ> (\<lambda>x. x [^] ((rel x) div rel g))) x = x [^] (((rel x) div rel g) * rel g)"
+                using that gsc int_pow_pow by auto
+              also have "\<dots> = x [^] rel x" using dv that by auto
+              finally show ?thesis .
+            qed
+          qed (use gsc in auto)
+          also have "\<dots> = \<one>" using gr(2) unfolding relations_def by blast
+          finally show ?thesis .
+        qed
+        hence otdrg: "ord tau dvd rel g" using tc int_pow_eq_id by force
+        have ot: "ord tau = rel g"
+        proof -
+          from gr(4, 5) have "rel g > 0" by simp
+          with otdrg have "ord tau \<le> rel g" by (meson zdvd_imp_le)
+          moreover have "\<not>ord tau < rel g" 
+          proof
+            assume a: "int (ord tau) < rel g"
+            define T where T: "T = gs - {g} \<union> {tau}"
+            hence tT: "tau \<in> T" by blast
+            let ?r = "restrict ((\<lambda>_.(0::int))(tau := int(ord tau))) T"
+            from T have "T \<in> all_gens"
+              using gt generate_sincl[of "gs - {g} \<union> {tau}"] switch_elem_card_le[OF gr(3), of tau] fgs cgs n
+              unfolding all_gens_def by auto
+            moreover have "?r \<in> relations T"
+            proof(intro in_relationsI finprod_one_eqI)
+              have "tau [^] int (ord tau) = \<one>" using tc pow_ord_eq_1[OF tc] int_pow_int by metis
+              thus "x [^] ?r x = \<one>" if "x \<in> T" for x using tT that by(cases "\<not>x = tau", auto)
+            qed auto
+            moreover have "?r tau = ord tau" using tT by auto
+            moreover have "ord tau > 0" using dvd_nat_bounds gr(4) gr(5) int_dvd_int_iff otdrg by presburger
+            ultimately have "ord tau \<in> exps" unfolding exps_def using tT by (auto, force)
+            with le a gr(4) show False by force
+          qed
+          ultimately show ?thesis by auto
+        qed
+        hence otnz: "ord tau \<noteq> 0" using gr me exps_def by linarith
+        define l where l: "l = tau#hs"
+        hence ls: "set l = set hs \<union> {tau}" by auto
+        with hsc tc have slc: "set l \<subseteq> carrier G" by auto
+        have gAhst: "generate G A = generate G (set hs \<union> {tau})"
+        proof -
+          have "generate G A = generate G (gs - {g} \<union> {tau})" using gt by simp
+          also have "\<dots> = generate G (set hs \<union> {tau})"
+            by (rule generate_subset_change_eqI, use hsc gsc tc ghs in auto)
+          finally show ?thesis .
+        qed
+        have glgA: "generate G (set l) = generate G A" using gAhst ls by simp
+        have lgA: "set l \<subseteq> generate G A"
+          using ls gt gts hs(1)
+                mono_generate[of "gs - {g}" gs] generate.incl[of tau "gs - {g} \<union> {tau}"]
+          by fast
+        show ?thesis
+        proof (cases "ord tau = 1")
+          case True
+          hence "tau = \<one>" using ord_eq_1 tc by blast
+          hence "generate G A = generate G (gs - {g})"
+            using gAhst generate_one_irrel hs(3) ghs by auto
+          from iH2[OF ihgsg this cgsg] show ?thesis .
+        next
+          case otau: False
+          consider (nd) "\<not>distinct l" | (ltn) "length l < n \<and> distinct l" | (dn) "length l = n \<and> distinct l"
+          proof -
+            have "length l \<le> n"
+            proof -
+              have "length l = length hs + 1" using l by simp
+              moreover have "length hs \<le> card (gs - {g})" using hs(2, 5) by (metis distinct_card)
+              moreover have "card (gs - {g}) + 1 \<le> n"
+                using n cgsg gr(3) fgs Ane i(2) by (simp add: card_gt_0_iff)
+              ultimately show ?thesis by linarith
+            qed
+            thus "\<lbrakk>\<not> distinct l \<Longrightarrow> thesis; length l < n \<and> distinct l \<Longrightarrow> thesis; length l = n \<and> distinct l \<Longrightarrow> thesis\<rbrakk> \<Longrightarrow> thesis"
+              by linarith 
+          qed
+          thus ?thesis
+          proof(cases)
+            case nd
+            with hs(2) l have ths: "set hs = set hs \<union> {tau}" by auto
+            hence "set l = set hs" using l by auto
+            hence "generate G (gs - {g}) = generate G A" using gAhst ths ghs by argo
+            moreover have "card (set hs) \<le> card A"
+              by (metis Diff_iff card_mono cgs dual_order.trans fgs hs(5) subsetI)
+            ultimately show ?thesis using hs by auto
+          next
+            case ltn
+            then have cl: "card (set l) < card A" using n by (metis distinct_card)
+            from iH[OF this] hsc tc ls have "?t (set l)" by blast
+            thus ?thesis by (subst (1 2) gAhst, use cl ls in fastforce)
+          next
+            case dn
+            hence ln: "length l = n" and dl: "distinct l" by auto
+            have c: "complementary (generate G {tau}) (generate G (gs - {g}))"
+            proof -
+              have "x = \<one>" if "x \<in> generate G {tau} \<inter> generate G (set hs)" for x
+              proof -
+                from that generate_incl[OF hsc] have xc: "x \<in> carrier G" by blast
+                from that have xgt: "x \<in> generate G {tau}" and xgs: "x \<in> generate G (set hs)"
+                  by auto
+                from generate_nat_pow[OF otnz tc] xgt have "\<exists>a. a \<ge> 0 \<and> a < ord tau \<and> x = tau [^] a"
+                  unfolding atLeastAtMost_def atLeast_def atMost_def
+                  by (auto, metis Suc_pred less_Suc_eq_le neq0_conv otnz)
+                then obtain a where a: "0 \<le> a" "a < ord tau" "x = tau [^] a" by blast
+                then have ix: "inv x \<in> generate G (set hs)"
+                  using xgs generate_m_inv_closed ghs hsc by blast
+                with generate_eq_finprod_Pi_int_image[OF _ hsc] obtain f where
+                  f: "f \<in> Pi (set hs) (\<lambda>_. (UNIV::int set))" "inv x = finprod G (\<lambda>g. g [^] f g) (set hs)"
+                  by blast
+                let ?f = "restrict (f(tau := a)) (set l)"
+                have fr: "?f \<in> relations (set l)"
+                proof(intro in_relationsI)
+                  from ls dl l have sh: "set hs = set l - {tau}" by auto
+                  have "finprod G (\<lambda>a. a [^] ?f a) (set l) = tau [^] ?f tau \<otimes> finprod G (\<lambda>a. a [^] ?f a) (set hs)"
+                    by (subst sh, intro finprod_minus, use l slc in auto)
+                  moreover have "tau [^] ?f tau = x" using a l int_pow_int by fastforce
+                  moreover have "finprod G (\<lambda>a. a [^] ?f a) (set hs) = finprod G (\<lambda>g. g [^] f g) (set hs)"
+                    by (intro finprod_cong', use slc dl l in auto)
+                  ultimately have "finprod G (\<lambda>a. a [^] ?f a) (set l) = x \<otimes> inv x" using f by argo
+                  thus "finprod G (\<lambda>a. a [^] ?f a) (set l) = \<one>" using xc by auto
+                qed blast
+                have "\<not>a > 0"
+                proof
+                  assume ag: "0 < a"
+                  have "set l \<in> all_gens" unfolding all_gens_def using glgA lgA dn distinct_card
+                    by fastforce
+                  moreover have "int a = ?f tau" using l by auto
+                  moreover have "tau \<in> set l" using l by simp
+                  ultimately have "a \<in> exps" using fr ag unfolding exps_def by (auto, force)
+                  from le[OF this] a(2) ot gr(4) show False by simp
+                qed
+                hence "a = 0" using a by blast
+                thus "x = \<one>" using tc a by force
+              qed
+              thus ?thesis unfolding complementary_def using generate.one ghs by blast
+            qed
+            moreover have idl: "is_idirprod (generate G A) (\<lambda>g. generate G {g}) (set l)" 
+            proof -
+              have "is_idirprod (generate G (set hs \<union> {tau})) (\<lambda>g. generate G {g}) (set hs \<union> {tau})"
+                by (intro idirprod_generate_ind, use tc hsc hs(3) ghs c in auto)
+              thus ?thesis using ls gAhst by auto
+            qed
+            moreover have "\<not>?t A \<Longrightarrow> successively (dvd) (map ord l)"
+            proof (cases hs)
+              case Nil
+              thus ?thesis using l by simp
+            next
+              case (Cons a list)
+              hence ac: "a \<in> carrier G" using hsc by auto
+              assume nA: "\<not>?t A"
+              have "ord tau dvd ord a"
+              proof (rule ccontr)
+                assume nd: "\<not> ord tau dvd ord a"
+                have "int (ord tau) > 0" using otnz by simp
+                with nd obtain r q::int where rq: "ord a = q * (ord tau) + r" "0 < r" "r < ord tau"
+                  using Euclidean_Division.pos_mod_bound div_mult_mod_eq mod_int_pos_iff mod_0_imp_dvd
+                  by (metis linorder_not_le of_nat_le_0_iff of_nat_mod)
+                define b where b: "b = tau \<otimes> a [^] q"
+                hence bc: "b \<in> carrier G" using hsc tc Cons by auto
+                have g: "generate G (set (b#hs)) = generate G (set l)"
+                proof -
+                  have se: "set (b#hs) = set l - {tau} \<union> {b}" using l Cons dl by auto
+                  show ?thesis
+                  proof(subst se, intro generate_one_switched_eqI[symmetric, of _ tau _ b])
+                    show "b \<in> generate G (set l)"
+                    proof -
+                      have "tau \<in> generate G (set l)" using l generate.incl[of tau "set l"] by auto
+                      moreover have "a [^] q \<in> generate G (set l)" 
+                        using mono_generate[of "{a}" "set l"] generate_pow[OF ac] Cons l by auto
+                      ultimately show ?thesis using b generate.eng by fast
+                    qed
+                    show "tau \<in> generate G (set l - {tau} \<union> {b})"
+                    proof -
+                      have "tau = b \<otimes> inv(a [^] q)" by (simp add: ac b m_assoc tc)
+                      moreover have "b \<in> generate G (set l - {tau} \<union> {b})"
+                        using generate.incl[of b "set l - {tau} \<union> {b}"] by blast
+                      moreover have "inv(a [^] q) \<in> generate G (set l - {tau} \<union> {b})"
+                      proof -
+                        have "generate G {a} \<subseteq> generate G (set l - {tau} \<union> {b})"
+                          using mono_generate[of "{a}" "set l - {tau} \<union> {b}"] dl Cons l by auto
+                        moreover have "inv(a [^] q) \<in> generate G {a}"
+                          by (subst generate_pow[OF ac], subst int_pow_neg[OF ac, of q, symmetric], blast)
+                        ultimately show ?thesis by fast
+                      qed
+                      ultimately show ?thesis using generate.eng by fast
+                    qed
+                  qed (use bc tc hsc dl Cons l in auto)
+                qed
+                show False
+                proof (cases "card (set (b#hs)) \<noteq> n")
+                  case True
+                  hence cln: "card (set (b#hs)) < n"
+                    using l Cons ln by (metis card_length list.size(4) nat_less_le)
+                  hence seq: "set (b#hs) = set hs"
+                  proof -
+                    from dn l Cons True have "b \<in> set hs"
+                      by (metis distinct.simps(2) distinct_card list.size(4))
+                    thus ?thesis by auto
+                  qed
+                  with cln have clA: "card (set hs) < card A" using n by auto
+                  moreover have "set hs \<subseteq> generate G (set hs)" using generate_sincl by simp
+                  moreover have "distinct hs" by fact
+                  moreover have "is_idirprod (generate G (set hs)) (\<lambda>g. generate G {g}) (set hs)"
+                    by (intro is_idirprod_generate, use hs[unfolded is_idirprod_def] hsc in auto)
+                  moreover have "generate G A = generate G (set hs)" using glgA g seq by argo
+                  moreover have "successively (dvd) (map ord hs)" by fact
+                  ultimately show False using iH2 nA by blast
+                next
+                  case False
+                  hence anb: "a \<noteq> b"
+                    by (metis card_distinct distinct_length_2_or_more l list.size(4) ln local.Cons)
+                  have "nat r \<in> exps" unfolding exps_def
+                  proof(rule)
+                    show "set (b#hs) \<in> all_gens" unfolding all_gens_def
+                      using gAhst g ls generate_sincl[of "set (b#hs)"] False by simp
+                    let ?r = "restrict ((\<lambda>_. 0::int)(b := ord tau, a := r)) (set (b#hs))"
+                    have "?r \<in> relations (set (b#hs))"
+                    proof(intro in_relationsI)
+                      show "finprod G (\<lambda>x. x [^] ?r x) (set (b#hs)) = \<one>"
+                      proof -
+                        have "finprod G (\<lambda>x. x [^] ?r x) (set (b#hs)) = b [^] ?r b \<otimes> finprod G (\<lambda>x. x[^] ?r x) (set (b#hs) - {b})"
+                          by (intro finprod_minus, use hsc Cons bc in auto)
+                        moreover have "finprod G (\<lambda>x. x[^] ?r x) (set (b#hs) - {b}) = a [^] ?r a \<otimes> finprod G (\<lambda>x. x[^] ?r x) (set (b#hs) - {b} - {a})"
+                          by (intro finprod_minus, use hsc Cons False n anb in auto)
+                        moreover have "finprod G (\<lambda>x. x[^] ?r x) (set (b#hs) - {b} - {a}) = \<one>"
+                          by (intro finprod_one_eqI, simp)
+                        ultimately have "finprod G (\<lambda>x. x [^] ?r x) (set (b#hs)) = b [^] ?r b \<otimes> (a [^] ?r a \<otimes> \<one>)"
+                          by argo
+                        also have "\<dots> = b [^] ?r b \<otimes> a [^] ?r a" using Cons hsc by simp
+                        also have "\<dots> = b [^] int(ord tau) \<otimes> a [^] r" using anb Cons by simp
+                        also have "\<dots> = \<one>"
+                        proof -
+                          have "b [^] int (ord tau) = tau [^] int (ord tau) \<otimes> (a [^] q) [^] int (ord tau)"
+                            using b bc hsc int_pow_distrib local.Cons tc by force
+                          also have "\<dots> = (a [^] q) [^] int (ord tau)"
+                            using trgo hsc local.Cons ot by force
+                          finally have "b [^] int (ord tau) \<otimes> a [^] r = (a [^] q) [^] int (ord tau) \<otimes> a [^] r"
+                            by argo
+                          also have "\<dots> = a [^] (q * int (ord tau) + r)" using Cons hsc
+                            by (metis comm_group_axioms comm_group_def group.int_pow_pow
+                                      int_pow_mult list.set_intros(1) subsetD)
+                          also have "\<dots> = a [^] int (ord a)" using rq by argo
+                          finally show ?thesis using Cons hsc int_pow_eq_id by simp
+                        qed
+                        finally show ?thesis .
+                      qed
+                    qed simp
+                    moreover have "r \<in> {e \<in> ?r ` set (b # hs). 0 < e}"
+                    proof (rule, rule, rule)
+                      show "0 < r" by fact
+                      show "a \<in> set (b#hs)" using Cons by simp
+                      thus "r = ?r a" by auto
+                    qed
+                    ultimately show "nat r \<in> (\<Union>rel\<in>relations (set (b # hs)). nat ` {e \<in> rel ` set (b # hs). 0 < e})"
+                      by fast
+                  qed
+                  moreover have "nat r < min_exp" using ot rq(2, 3) gr(4) by linarith
+                  ultimately show False using le by fastforce
+                qed
+              qed
+              thus ?thesis using hs(4) Cons l by simp
+            qed
+            ultimately show ?thesis using lgA n dn by (metis card_length)
+          qed
+        qed
+      qed (use dvot in blast)
+    qed
+  qed
+qed
+
+lemma (in comm_group) fundamental_subgr:
+  fixes A :: "'a set"
+  assumes "finite A" "A \<subseteq> carrier G"
+  obtains gs where
+    "set gs \<subseteq> generate G A" "distinct gs" "is_idirprod (generate G A) (\<lambda>g. generate G {g}) (set gs)"
+    "successively (dvd) (map ord gs)" "card (set gs) \<le> card A"
+  using assms ex_idirgen by meson
+
+text \<open>As every group is a subgroup of itself, the theorem follows directly. However, for reasons of
+convenience and uniqueness (although not completely proved), we strengthen the result by proving
+that the decomposition can be done without having the trivial factor in the product.
+We formulate the theorem in various ways: firstly, the invariant factor decomposition.\<close>
+
+theorem (in fin_gen_comm_group) invariant_factor_decomposition_idirprod:
+  obtains gs where
+    "set gs \<subseteq> carrier G" "distinct gs" "is_idirprod (carrier G) (\<lambda>g. generate G {g}) (set gs)"
+    "successively (dvd) (map ord gs)" "card (set gs) \<le> card gen" "\<one> \<notin> set gs"
+proof -
+  from fundamental_subgr[OF fin_gen gens_closed] obtain gs where
+  gs: "set gs \<subseteq> carrier G" "distinct gs" "is_idirprod (carrier G) (\<lambda>g. generate G {g}) (set gs)"
+    "successively (dvd) (map ord gs)" "card (set gs) \<le> card gen" using generators by auto
+  hence cf: "compl_fam (\<lambda>g. generate G {g}) (set gs)" by simp
+  let ?r = "remove1 \<one> gs"
+  have r: "set ?r = set gs - {\<one>}" using gs by auto
+  have "set ?r \<subseteq> carrier G" using gs by auto
+  moreover have "distinct ?r" using gs by auto
+  moreover have "is_idirprod (carrier G) (\<lambda>g. generate G {g}) (set ?r)"
+  proof (intro is_idirprod_generate)
+    show "set ?r \<subseteq> carrier G" using gs by auto
+    show "compl_fam (\<lambda>g. generate G {g}) (set (remove1 \<one> gs))"
+      by (rule compl_fam_generate_subset[OF cf gs(1)], use set_remove1_subset in fastforce)
+    show "carrier G = generate G (set ?r)"
+    proof -
+      have "generate G (set ?r) = generate G (set gs)" using generate_one_irrel' r by simp
+      with gs(3) show ?thesis by simp
+    qed
+  qed
+  moreover have "successively (dvd) (map ord ?r)"
+  proof (cases gs)
+    case (Cons a list)
+    have r: "(map ord (remove1 \<one> gs)) = remove1 1 (map ord gs)" using gs(1) 
+    proof(induction gs)
+      case (Cons a gs)
+      hence "a \<in> carrier G" by simp
+      with Cons ord_eq_1[OF this] show ?case by auto
+    qed simp
+    show ?thesis by (unfold r,
+                     rule transp_successively_remove1[OF _ gs(4), unfolded transp_def],
+                     auto)
+  qed simp
+  moreover have "card (set ?r) \<le> card gen" using gs(5) r
+    by (metis List.finite_set card_Diff1_le dual_order.trans)
+  moreover have "\<one> \<notin> set ?r" using gs(2) by auto
+  ultimately show ?thesis using that by blast
+qed
+
+corollary (in fin_gen_comm_group) invariant_factor_decomposition_dirprod:
+  obtains gs where
+    "set gs \<subseteq> carrier G" "distinct gs"
+    "DirProds (\<lambda>g. G\<lparr>carrier := generate G {g}\<rparr>) (set gs) \<cong> G"
+    "successively (dvd) (map ord gs)" "card (set gs) \<le> card gen"
+    "compl_fam (\<lambda>g. generate G {g}) (set gs)" "\<one> \<notin> set gs"
+proof -
+  from invariant_factor_decomposition_idirprod obtain gs where
+    gs: "set gs \<subseteq> carrier G" "distinct gs" "is_idirprod (carrier G) (\<lambda>g. generate G {g}) (set gs)"
+        "successively (dvd) (map ord gs)" "card (set gs) \<le> card gen" "\<one> \<notin> set gs" by blast
+  with cong_DirProds_IDirProds[OF gs(3)] gs 
+  have "DirProds (\<lambda>g. G\<lparr>carrier := generate G {g}\<rparr>) (set gs) \<cong> G" by blast
+  with gs that show ?thesis by auto
+qed
+
+corollary (in fin_gen_comm_group) invariant_factor_decomposition_dirprod_fam:
+  obtains Hs where
+    "\<And>H. H \<in> set Hs \<Longrightarrow> subgroup H G" "distinct Hs"
+    "DirProds (\<lambda>H. G\<lparr>carrier := H\<rparr>) (set Hs) \<cong> G" "successively (dvd) (map card Hs)"
+    "card (set Hs) \<le> card gen" "compl_fam id (set Hs)" "{\<one>} \<notin> set Hs"
+proof -
+  from invariant_factor_decomposition_dirprod obtain gs where
+  gs: "set gs \<subseteq> carrier G" "distinct gs"
+      "DirProds (\<lambda>g. G\<lparr>carrier := generate G {g}\<rparr>) (set gs) \<cong> G"
+      "successively (dvd) (map ord gs)" "card (set gs) \<le> card gen"
+      "compl_fam (\<lambda>g. generate G {g}) (set gs)" "\<one> \<notin> set gs" by blast
+  let ?gen = "(\<lambda>g. generate G {g})"
+  let ?Hs = "map (\<lambda>g. ?gen g) gs"
+  have "subgroup H G" if "H \<in> set ?Hs" for H using that gs by (auto intro: generate_is_subgroup)
+  moreover have "distinct ?Hs"
+    using compl_fam_imp_generate_inj[OF gs(1)] gs distinct_map by blast
+  moreover have "DirProds (\<lambda>H. G\<lparr>carrier := H\<rparr>) (set ?Hs) \<cong> G"
+  proof -
+    have gg: "group (G\<lparr>carrier := ?gen g\<rparr>)" if "g \<in> set gs" for g
+      by (use gs that in \<open>auto intro: subgroup.subgroup_is_group generate_is_subgroup\<close>)
+    then interpret og: group "DirProds (\<lambda>g. G\<lparr>carrier := ?gen g\<rparr>) (set gs)"
+      using DirProds_group_iff by blast
+    have "DirProds (\<lambda>g. G\<lparr>carrier := ?gen g\<rparr>) (set gs) \<cong> DirProds (\<lambda>H. G\<lparr>carrier := H\<rparr>) (set ?Hs)"
+    proof (intro DirProds_iso[of ?gen])
+      show "bij_betw ?gen (set gs) (set ?Hs)"
+        using \<open>distinct ?Hs\<close> gs(2) compl_fam_imp_generate_inj[OF gs(1, 6)]
+        by (simp add: bij_betw_def)
+      show "G\<lparr>carrier := ?gen g\<rparr> \<cong> G\<lparr>carrier := ?gen g\<rparr>" if "g \<in> set gs" for g by simp
+      show "group (G\<lparr>carrier := ?gen g\<rparr>)" if "g \<in> set gs" for g using that by fact
+      show "Group.group (G\<lparr>carrier := H\<rparr>)" if "H \<in> set ?Hs" for H
+        by (use gs that in \<open>auto intro: subgroup.subgroup_is_group generate_is_subgroup\<close>)
+    qed
+    from group.iso_sym[OF og.is_group this] show ?thesis using gs iso_trans by blast
+  qed
+  moreover have "successively (dvd) (map card ?Hs)"
+  proof -
+    have "card (generate G {g}) = ord g" if "g \<in> set gs" for g
+      using generate_pow_card that gs(1) by auto
+    hence "map card ?Hs = map ord gs" by simp
+    thus ?thesis using gs(4) by argo
+  qed
+  moreover have "card (set ?Hs) \<le> card gen" using gs
+    by (metis \<open>distinct ?Hs\<close> distinct_card length_map)
+  moreover have "compl_fam id (set ?Hs)"
+    using compl_fam_cong[OF _ compl_fam_imp_generate_inj[OF gs(1, 6)], of id] using gs by auto
+  moreover have "{\<one>} \<notin> set ?Hs" using generate_singleton_one gs by auto
+  ultimately show ?thesis using that by blast
+qed
+
+text \<open>Here, the invariant factor decomposition in its classical form.\<close>
+
+corollary (in fin_gen_comm_group) invariant_factor_decomposition_Zn:
+  obtains ns where
+    "DirProds (\<lambda>n. Z (ns!n)) {..<length ns} \<cong> G" "successively (dvd) ns" "length ns \<le> card gen"
+proof -
+  from invariant_factor_decomposition_dirprod obtain gs where
+      gs: "set gs \<subseteq> carrier G" "distinct gs"
+          "DirProds (\<lambda>g. G\<lparr>carrier := generate G {g}\<rparr>) (set gs) \<cong> G"
+          "successively (dvd) (map ord gs)" "card (set gs) \<le> card gen"
+          "compl_fam (\<lambda>g. generate G {g}) (set gs)" "\<one> \<notin> set gs" by blast
+  let ?DP = "DirProds (\<lambda>g. G\<lparr>carrier := generate G {g}\<rparr>) (set gs)"
+  have "\<exists>ns. DirProds (\<lambda>n. Z (ns!n)) {..<length ns} \<cong> G
+           \<and> successively (dvd) ns \<and> length ns \<le> card gen"
+  proof (cases gs, rule)
+    case Nil
+    from gs(3) Nil have co: "carrier ?DP = {\<one>\<^bsub>?DP\<^esub>}" unfolding DirProds_def by auto
+    let ?ns = "[]"
+    have "DirProds (\<lambda>n. Z ([] ! n)) {} \<cong> ?DP"
+    proof(intro triv_iso DirProds_is_group)
+      show "carrier (DirProds (\<lambda>n. Z ([] ! n)) {}) = {\<one>\<^bsub>DirProds (\<lambda>n. Z ([] ! n)) {}\<^esub>}"
+        using DirProds_empty by blast
+    qed (use co group_integer_mod_group Nil in auto)
+    from that[of ?ns] gs co iso_trans[OF this gs(3)]
+    show "DirProds (\<lambda>n. Z (?ns ! n)) {..<length ?ns} \<cong> G
+        \<and> successively (dvd) ?ns \<and> length ?ns \<le> card gen"
+      unfolding lessThan_def by simp
+  next
+    case c: (Cons a list)    
+    let ?l = "map ord gs"
+    from c have l: "length ?l > 0" by auto
+    have "DirProds (\<lambda>n. Z (?l ! n)) {..<length ?l} \<cong> G"
+    proof -
+      have "DirProds (\<lambda>n. Z (?l ! n)) {..<length ?l} \<cong> ?DP"
+      proof(intro DirProds_iso[where ?f = "\<lambda>n. gs!n"])
+        show "bij_betw ((!) gs) {..<length ?l} (set gs)" using gs
+          by (simp add: bij_betw_nth)
+        show "Z (map ord gs ! i) \<cong> G\<lparr>carrier := generate G {gs ! i}\<rparr>" if "i \<in> {..<length ?l}" for i
+        proof(rule group.iso_sym[OF subgroup.subgroup_is_group[OF generate_is_subgroup]
+                   cyclic_group.Zn_iso[OF cyclic_groupI2]])
+          show "order (G\<lparr>carrier := generate G {gs ! i}\<rparr>) = map ord gs ! i"
+            unfolding order_def using that generate_pow_card[of "gs ! i"] gs(1) by force
+        qed (use gs(1) that in auto)
+        show "Group.group (Z (map ord gs ! i))" if "i \<in> {..<length (map ord gs)}" for i
+          using group_integer_mod_group by blast
+        show "Group.group (G\<lparr>carrier := generate G {g}\<rparr>)" if "g \<in> set gs" for g
+          using that gs(1) subgroup.subgroup_is_group[OF generate_is_subgroup] by auto
+      qed
+      from iso_trans[OF this gs(3)] show ?thesis .
+    qed
+    moreover have "length ?l \<le> card gen" using gs by (metis distinct_card length_map)
+    ultimately show ?thesis using gs c by fastforce
+  qed
+  thus ?thesis using that by blast
+qed
+
+text \<open>As every \<open>integer_mod_group\<close> can be decomposed into a product of prime power groups,
+we obtain (by using the fact that the direct product does not care about nestedness)
+the primary decomposition.\<close>
+
+lemma Zn_iso_DirProds_prime_powers:
+  assumes "n \<noteq> 0"
+  shows "Z n \<cong> DirProds (\<lambda>p. Z (p ^ multiplicity p n)) (prime_factors n)" (is "Z n \<cong> ?DP")
+proof (cases "n = 1")
+  case True
+  show ?thesis by (intro triv_iso[OF group_integer_mod_group DirProds_is_group],
+                   use DirProds_empty carrier_integer_mod_group True in auto)
+next
+  case nno: False
+  interpret DP: group ?DP by (intro DirProds_is_group, use group_integer_mod_group in blast)
+  have "order ?DP = prod (order \<circ> (\<lambda>p. Z (p ^ multiplicity p n))) (prime_factors n)"
+    by (intro DirProds_order, blast)
+  also have "\<dots> = prod (\<lambda>p. p ^ multiplicity p n) (prime_factors n)" using Zn_order by simp
+  also have n: "\<dots> = n" using prod_prime_factors[OF assms] by simp
+  finally have oDP: "order ?DP = n" .
+  then interpret DP: finite_group ?DP
+    by (unfold_locales, unfold order_def, metis assms card.infinite)
+  let ?f = "\<lambda>p\<in>(prime_factors n). 1"
+  have fc: "?f \<in> carrier ?DP"
+  proof -
+    have p: "0 < multiplicity p n" if "p \<in> prime_factors n" for p
+      using prime_factors_multiplicity that by auto
+    have pk: "1 < p ^ k" if "Factorial_Ring.prime p" "0 < k" for p k::nat
+      using that one_less_power prime_gt_1_nat by blast
+    show ?thesis unfolding DirProds_def PiE_def
+      by(use carrier_integer_mod_group assms nno pk p in auto,
+         metis in_prime_factors_iff nat_int of_nat_power one_less_nat_eq)
+  qed
+  have of: "DP.ord ?f = n"
+  proof -
+    have "n dvd j" if j: "?f [^]\<^bsub>?DP\<^esub> j = \<one>\<^bsub>?DP\<^esub>" for j
+    proof (intro pairwise_coprime_dvd'[OF _ _ n[symmetric]])
+      show "finite (prime_factors n)" by simp
+      show "\<forall>a\<in>#prime_factorization n. a ^ multiplicity a n dvd j"
+      proof 
+        show "p ^ multiplicity p n dvd j" if "p \<in> prime_factors n" for p
+        proof -
+          from j have "(?f [^]\<^bsub>?DP\<^esub> j) p = 0"
+            using that unfolding DirProds_def one_integer_mod_group by auto
+          hence "?f p [^]\<^bsub>Z (p ^ multiplicity p n)\<^esub> j = 0" using comp_exp_nat[OF that] by metis
+          hence "group.ord (Z (p ^ multiplicity p n)) (?f p) dvd j" using comp_in_carr[OF fc that]
+            by (metis group.pow_eq_id group_integer_mod_group one_integer_mod_group)
+          moreover have "group.ord (Z (p ^ multiplicity p n)) (?f p) = p ^ multiplicity p n"
+            by (metis (no_types, lifting) Zn_neq1_cyclic_group Zn_order comp_in_carr
+                                          cyclic_group.ord_gen_is_group_order fc integer_mod_group_1
+                                          restrict_apply' that)
+          ultimately show ?thesis by simp
+        qed
+      qed
+      show "coprime (i ^ multiplicity i n) (j ^ multiplicity j n)"
+        if "i \<in># prime_factorization n" "j \<in># prime_factorization n" "i \<noteq> j" for i j
+        using that diff_prime_power_imp_coprime by blast
+    qed
+    thus ?thesis using fc DP.ord_dvd_group_order gcd_nat.asym oDP by force
+  qed
+  interpret DP: cyclic_group ?DP ?f by (intro DP.element_ord_generates_cyclic, use of oDP fc in auto)
+  show ?thesis using DP.iso_sym[OF DP.Zn_iso[OF oDP]] .
+qed
+
+lemma Zn_iso_DirProds_prime_powers':
+  assumes "n \<noteq> 0"
+  shows "Z n \<cong> DirProds (\<lambda>p. Z p) ((\<lambda>p. p ^ multiplicity p n) ` (prime_factors n))" (is "Z n \<cong> ?DP")
+proof -
+  have cp: "(\<lambda>p. Z (p ^ multiplicity p n)) = (\<lambda>p. Z p) \<circ> (\<lambda>p. p ^ multiplicity p n)" by auto
+  have "DirProds (\<lambda>p. Z (p ^ multiplicity p n)) (prime_factors n) \<cong> ?DP"
+  proof(subst cp, intro DirProds_iso2)
+    show "inj_on (\<lambda>p. p ^ multiplicity p n) (prime_factors n)"
+      by (intro inj_onI; simp add: prime_factors_multiplicity prime_power_inj'')
+    show "group (DirProds Z ((\<lambda>p. p ^ multiplicity p n) ` prime_factors n))"
+      by (intro DirProds_is_group, use group_integer_mod_group in auto)
+  qed
+  with Zn_iso_DirProds_prime_powers[OF assms] show ?thesis using Group.iso_trans by blast
+qed
+
+corollary (in fin_gen_comm_group) primary_decomposition_Zn:
+  obtains ns where
+    "DirProds (\<lambda>n. Z (ns!n)) {..<length ns} \<cong> G"
+    "\<forall>n\<in>set ns. n = 0 \<or> (\<exists>p k. Factorial_Ring.prime p \<and> k > 0 \<and> n = p ^ k)"
+proof -
+  from invariant_factor_decomposition_Zn obtain ms where
+    ms: "DirProds (\<lambda>m. Z (ms!m)) {..<length ms} \<cong> G" "successively (dvd) ms" "length ms \<le> card gen"
+    by blast
+  let ?I = "{..<length ms}"
+  let ?J = "\<lambda>i. if ms!i = 0 then {0} else (\<lambda>p. p ^ multiplicity p (ms!i)) ` (prime_factors (ms!i))"
+  let ?G = "\<lambda>i. Z"
+  let ?f = "\<lambda>i. DirProds (?G i) (?J i)"
+  have "DirProds (\<lambda>m. Z (ms!m)) {..<length ms} \<cong> DirProds ?f {..<length ms}"
+  proof (intro DirProds_iso[of id])
+    show "bij_betw id {..<length ms} {..<length ms}" by blast
+    show "Z (ms ! i) \<cong> ?f (id i)" if "i \<in> {..<length ms}" for i
+      by (cases "ms!i = 0",
+          simp add: DirProds_one_cong_sym,
+          auto intro: Zn_iso_DirProds_prime_powers')
+    show "\<And>i. i \<in> {..<length ms} \<Longrightarrow> group (Z (ms ! i))" by auto
+    show "group (?f j)" if "j \<in> {..<length ms}" for j by (auto intro: DirProds_is_group)
+  qed
+  also have "\<dots> \<cong> DirProds (\<lambda>(i,j). ?G i j) (Sigma ?I ?J)"
+    by(rule DirProds_Sigma)
+  finally have G1: "G \<cong> DirProds (\<lambda>(i,j). ?G i j) (Sigma ?I ?J)" using ms(1)
+    by (metis (no_types, lifting) DirProds_is_group Group.iso_trans group.iso_sym group_integer_mod_group)
+  have "\<exists>ps. set ps = Sigma ?I ?J \<and> distinct ps" by(intro finite_distinct_list, auto)
+  then obtain ps where ps: "set ps = Sigma ?I ?J" "distinct ps" by blast
+  define ns where ns: "ns = map snd ps"
+  have "DirProds (\<lambda>n. Z (ns!n)) {..<length ns} \<cong> DirProds (\<lambda>(i,j). ?G i j) (Sigma ?I ?J)"
+  proof -
+    obtain b::"nat \<Rightarrow> (nat \<times> nat)"
+      where b: "\<forall>i<length ns. ns!i = snd (b i)" "bij_betw b {..<length ns} (Sigma ?I ?J)"
+      using ns ps bij_betw_nth by fastforce
+    moreover have "Z (ns ! i) \<cong> (case b i of (i, x) \<Rightarrow> Z x)" if "i \<in> {..<length ns}" for i
+    proof -
+      have "ns ! i = snd (b i)" using b that by blast
+      thus ?thesis by (simp add: case_prod_beta)
+    qed
+    ultimately show ?thesis by (auto intro: DirProds_iso)
+  qed
+  with G1 have "DirProds (\<lambda>n. Z (ns!n)) {..<length ns} \<cong> G" using Group.iso_trans iso_sym by blast
+  moreover have "n = 0 \<or> (\<exists>p k. Factorial_Ring.prime p \<and> k > 0 \<and> n = p ^ k)" if "n\<in>set ns" for n
+  proof -
+    have "k = 0 \<or> (\<exists>p\<in>prime_factors (ms!i). k = p ^ multiplicity p (ms!i))" if "k \<in> ?J i" for k i
+      by (cases "ms!i = 0", use that in auto)
+    with that ns ps show ?thesis
+      by (auto, metis (no_types, lifting) mem_Collect_eq neq0_conv prime_factors_multiplicity)
+  qed
+  ultimately show
+  "(\<And>ns. \<lbrakk>DirProds (\<lambda>n. Z (ns ! n)) {..<length ns} \<cong> G;
+          \<forall>n\<in>set ns. n = 0 \<or> (\<exists>p k. Factorial_Ring.prime p \<and> k > 0 \<and> n = p ^ k)\<rbrakk> \<Longrightarrow> thesis)
+    \<Longrightarrow> thesis" by blast
+qed
+
+text \<open>As every finite group is also finitely generated, it follows that a finite group can be
+decomposed in a product of finite cyclic groups.\<close>
+
+lemma (in finite_comm_group) cyclic_product:
+  obtains ns where "DirProds (\<lambda>n. Z (ns!n)) {..<length ns} \<cong> G" "\<forall>n\<in>set ns. n\<noteq>0"
+proof -
+  from primary_decomposition_Zn obtain ns where
+    ns: "DirProds (\<lambda>n. Z (ns ! n)) {..<length ns} \<cong> G"
+        "\<forall>n\<in>set ns. n = 0 \<or> (\<exists>p k. normalization_semidom_class.prime p \<and> 0 < k \<and> n = p ^ k)"
+    by blast
+  have "False" if "n \<in> {..<length ns}" "ns!n = 0" for n
+  proof -
+    from that have "order (DirProds (\<lambda>n. Z (ns ! n)) {..<length ns}) = 0"
+      using DirProds_order[of "{..<length ns}" "\<lambda>n. Z (ns!n)"] Zn_order by auto
+    with fin iso_same_card[OF ns(1)] show False unfolding order_def by auto
+  qed
+  hence "\<forall>n\<in>set ns. n\<noteq>0"
+    by (metis in_set_conv_nth lessThan_iff)
+  with ns show ?thesis using that by blast
+qed
+
+no_notation integer_mod_group ("Z")
+
+end
diff --git a/thys/Finitely_Generated_Abelian_Groups/General_Auxiliary.thy b/thys/Finitely_Generated_Abelian_Groups/General_Auxiliary.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/General_Auxiliary.thy
@@ -0,0 +1,270 @@
+(*
+    File:     General_Auxiliary.thy
+    Author:   Joseph Thommes, TU München; Manuel Eberl, TU München
+*)
+section \<open>Auxiliary lemmas\<close>
+
+theory General_Auxiliary
+  imports "HOL-Algebra.Algebra"
+begin
+
+lemma inter_imp_subset: "A \<inter> B = A \<Longrightarrow> A \<subseteq> B"
+  by blast
+
+lemma card_inter_eq:
+  assumes "finite A" "card (A \<inter> B) = card A"
+  shows "A \<subseteq> B"
+proof -
+  have "A \<inter> B \<subseteq> A" by blast
+  with assms have "A \<inter> B = A" using card_subset_eq by blast
+  thus ?thesis by blast
+qed
+
+lemma coprime_eq_empty_prime_inter:
+  assumes "(n::nat) \<noteq> 0" "m \<noteq> 0"
+  shows "coprime n m \<longleftrightarrow> (prime_factors n) \<inter> (prime_factors m) = {}"
+proof
+  show "coprime n m \<Longrightarrow> prime_factors n \<inter> prime_factors m = {}"
+  proof (rule ccontr)
+    assume cp: "coprime n m"
+    assume pf: "prime_factors n \<inter> prime_factors m \<noteq> {}"
+    then obtain p where p: "p \<in> prime_factors n" "p \<in> prime_factors m" by blast
+    then have p_dvd: "p dvd n" "p dvd m" by blast+
+    moreover have "\<not>is_unit p" using p using not_prime_unit by blast
+    ultimately show "False" using cp unfolding coprime_def by simp
+  qed
+  assume assm: "prime_factors n \<inter> prime_factors m = {}"
+  show "coprime n m" unfolding coprime_def
+  proof
+    fix c
+    show "c dvd n \<longrightarrow> c dvd m \<longrightarrow> is_unit c"
+    proof(rule; rule)
+      assume c: "c dvd n" "c dvd m"
+      then have "prime_factors c \<subseteq> prime_factors n" "prime_factors c \<subseteq> prime_factors m"
+        using assms dvd_prime_factors by blast+
+      then have "prime_factors c = {}" using assm by blast
+      thus "is_unit c" using assms c
+        by (metis dvd_0_left_iff prime_factorization_empty_iff set_mset_eq_empty_iff)
+    qed
+  qed
+qed
+
+lemma prime_factors_Prod:
+  assumes "finite S" "\<And>a. a \<in> S \<Longrightarrow> f a \<noteq> 0"
+  shows "prime_factors (prod f S) = \<Union>(prime_factors ` f ` S)"
+  using assms
+proof(induction S rule: finite_induct)
+  case empty
+  then show ?case by simp
+next
+  case i: (insert x F)
+  from i have x: "f x \<noteq> 0" by blast
+  from i have F: "prod f F \<noteq> 0" by simp
+  from i have "prime_factors(prod f F) = \<Union> (prime_factors ` f ` F)" by blast
+  moreover have "prod f (insert x F) = (prod f F) * f x" using i mult.commute by force
+  ultimately
+  have "prime_factors (prod f (insert x F)) = (\<Union>(prime_factors ` f ` F)) \<union> prime_factors (f x)"
+    using prime_factors_product[OF F x] by argo
+  thus ?case by force
+qed
+
+lemma lcm_is_Min_multiple_nat:
+  assumes "c \<noteq> 0" "(a::nat) dvd c" "(b::nat) dvd c"
+  shows "c \<ge> lcm a b"
+  using lcm_least[of a c b] assms by fastforce
+
+lemma diff_prime_power_imp_coprime:
+  assumes "p \<noteq> q" "Factorial_Ring.prime (p::nat)" "Factorial_Ring.prime q"
+  shows "coprime (p ^ (n::nat)) (q ^ m)"
+  using assms
+  by (metis power_0 power_one_right prime_dvd_power prime_imp_power_coprime_nat
+            prime_nat_iff prime_power_inj'')
+
+lemma "finite (prime_factors x)"
+  using finite_set_mset by blast
+
+lemma card_ge_1_two_diff:
+  assumes "card A > 1"
+  obtains x y where "x \<in> A" "y \<in> A" "x \<noteq> y"
+proof -
+  have fA: "finite A" using assms by (metis card.infinite not_one_less_zero)
+  from assms obtain x where x: "x \<in> A" by fastforce
+  with assms fA have "card (A - {x}) > 0" by simp
+  then obtain y where y: "y \<in> (A - {x})" by (metis card_gt_0_iff ex_in_conv)
+  thus ?thesis using that[of x y] x by blast
+qed
+
+lemma infinite_two_diff:
+  assumes "infinite A"
+  obtains x y where "x \<in> A" "y \<in> A" "x \<noteq> y"
+proof -
+  from assms obtain x where x: "x \<in> A" by fastforce
+  from assms have "infinite (A - {x})" by simp
+  then obtain y where y: "y \<in> (A - {x})"
+    by (metis ex_in_conv finite.emptyI)
+  show ?thesis using that[of x y] using x y by blast
+qed
+
+lemma Inf_le:
+  "Inf A \<le> x" if "x \<in> (A::nat set)" for x
+proof (cases "A = {}")
+  case True
+  then show ?thesis using that by simp
+next
+  case False
+  hence "Inf A \<le> Inf {x}" using that by (simp add: cInf_lower)
+  also have "\<dots> = x" by simp
+  finally show "Inf A \<le> x" by blast
+qed
+
+lemma switch_elem_card_le:
+  assumes "a \<in> A"
+  shows "card (A - {a} \<union> {b}) \<le> card A"
+  using assms
+  by (metis Diff_insert_absorb Set.set_insert Un_commute card.infinite card_insert_disjoint
+            card_mono finite_insert insert_is_Un insert_subset order_refl)
+
+lemma pairwise_coprime_dvd:
+  assumes "finite A" "pairwise coprime A" "(n::nat) = prod id A" "\<forall>a\<in>A. a dvd j"
+  shows "n dvd j"
+  using assms
+proof (induction A arbitrary: n)
+  case i: (insert x F)
+  have "prod id F dvd j" "x dvd j" using i unfolding pairwise_def by auto
+  moreover have "coprime (prod id F) x"
+    by (metis i(2, 4) id_apply pairwise_insert prod_coprime_left)
+  ultimately show ?case using i(1, 2, 5) by (simp add: coprime_commute divides_mult)
+qed simp
+
+lemma pairwise_coprime_dvd':
+  assumes "finite A" "\<And>i j. \<lbrakk>i \<in> A; j \<in> A; i \<noteq> j\<rbrakk> \<Longrightarrow> coprime (f i) (f j)"
+          "(n::nat) = prod f A" "\<forall>a\<in>A. f a dvd j"
+  shows "n dvd j"
+  using assms
+proof (induction A arbitrary: n)
+  case i: (insert x F)
+  have "prod f F dvd j" "f x dvd j" using i unfolding pairwise_def by auto
+  moreover have "coprime (prod f F) (f x)" by(intro prod_coprime_left, use i in blast)
+  ultimately show ?case using i by (simp add: coprime_commute divides_mult)
+qed simp
+
+lemma transp_successively_remove1:
+  assumes "transp f" "successively f l"
+  shows "successively f (remove1 a l)" using assms(2)
+proof(induction l rule: induct_list012)
+  case (3 x y zs)
+  from 3(3)[unfolded successively.simps] have fs: "f x y" "successively f (y # zs)" by auto
+  moreover from this(2) successively.simps have s: "successively f zs" by(cases zs, auto)
+  ultimately have s2: "successively f (remove1 a zs)" "successively f (remove1 a (y # zs))"
+    using 3 by auto
+  consider (x) "x = a" | (y) "y = a \<and> x \<noteq> a" | (zs) "a \<noteq> x \<and> a \<noteq> y" by blast
+  thus ?case
+  proof (cases)
+    case x
+    then show ?thesis using 3 by simp
+  next
+    case y
+    then show ?thesis
+    proof (cases zs)
+      case Nil
+      then show ?thesis using fs by simp
+    next
+      case (Cons a list)
+      hence "f y a" using fs by simp
+      hence "f x a" using fs(1) assms(1)[unfolded transp_def] by blast
+      then show ?thesis using Cons y s by auto
+    qed
+  next
+    case zs
+    then show ?thesis using s2 fs by auto
+  qed
+qed auto
+
+
+lemma exp_one_2pi_iff:
+  fixes x::real shows "exp (2 * of_real pi * \<i> * x) = 1 \<longleftrightarrow> x \<in> \<int>"
+proof -
+  have c: "cis (2 * x * pi) = 1 \<longleftrightarrow> x \<in> \<int>"
+    by (auto simp: complex_eq_iff sin_times_pi_eq_0 cos_one_2pi_int, meson Ints_cases)
+  have "exp (2 * of_real pi * \<i> * x) = exp (\<i> * complex_of_real (2 * x * pi))"
+  proof -
+    have "2 * of_real pi * \<i> * x = \<i> * complex_of_real (2 * x * pi)" by simp
+    thus ?thesis by argo
+  qed
+  also from cis_conv_exp have "\<dots> = cis (2 * x * pi)" by simp
+  finally show ?thesis using c by simp
+qed
+
+(* Manuel Eberl *)
+lemma of_int_divide_in_Ints_iff:
+  assumes "b \<noteq> 0"
+  shows   "(of_int a / of_int b :: 'a :: field_char_0) \<in> \<int> \<longleftrightarrow> b dvd a"
+proof
+  assume *: "(of_int a / of_int b :: 'a :: field_char_0) \<in> \<int>"
+  from * obtain n where "of_int a / of_int b = (of_int n :: 'a)"
+    by (elim Ints_cases)
+  hence "of_int (b * n) = (of_int a :: 'a)"
+    using assms by (subst of_int_mult) (auto simp: field_simps)
+  hence "b * n = a"
+    by (subst (asm) of_int_eq_iff)
+  thus "b dvd a" by auto
+qed auto
+
+(* Manuel Eberl *)
+lemma of_nat_divide_in_Ints_iff:
+  assumes "b \<noteq> 0"
+  shows   "(of_nat a / of_nat b :: 'a :: field_char_0) \<in> \<int> \<longleftrightarrow> b dvd a"
+  using of_int_divide_in_Ints_iff[of "int b" "int a"] assms by simp
+
+lemma true_nth_unity_root:
+  fixes n::nat
+  obtains x::complex where "x ^ n = 1" "\<And>m. \<lbrakk>0<m; m<n\<rbrakk> \<Longrightarrow> x ^ m \<noteq> 1"
+proof(cases "n = 0")
+  case False
+  show ?thesis
+  proof (rule that)
+    show "cis (2 * pi / n) ^ n = 1"
+      by (simp add: DeMoivre)
+  next
+    fix m assume m: "m > 0" "m < n"
+    have "cis (2 * pi / n) ^ m = cis (2 * pi * m / n)"
+      by (simp add: DeMoivre algebra_simps)
+    also have "\<dots> = 1 \<longleftrightarrow> real m / real n \<in> \<int>"
+      using exp_one_2pi_iff[of "m / n"] by (simp add: cis_conv_exp algebra_simps)
+    also have "\<dots> \<longleftrightarrow> n dvd m"
+      using m by (subst of_nat_divide_in_Ints_iff) auto
+    also have "\<not>n dvd m"
+      using m by auto
+    finally show "cis (2 * pi / real n) ^ m \<noteq> 1" .
+  qed
+qed simp
+
+lemma finite_bij_betwI:
+  assumes "finite A" "finite B" "inj_on f A" "f \<in> A \<rightarrow> B" "card A = card B"
+  shows "bij_betw f A B"
+proof (intro bij_betw_imageI)
+  show "inj_on f A" by fact
+  show "f ` A = B"
+  proof -
+    have "card (f ` A) = card B" using assms by (simp add: card_image)
+    moreover have "f ` A \<subseteq> B" using assms by blast
+    ultimately show ?thesis using assms by (meson card_subset_eq)
+  qed
+qed
+
+lemma powi_mod:
+  "x powi m = x powi (m mod n)" if "x ^ n = 1" "n > 0" for x::complex and m::int
+proof -
+  have xnz: "x \<noteq> 0" using that by (metis zero_neq_one zero_power)
+  obtain k::int where k: "m = k*n + (m mod n)" using div_mod_decomp_int by blast
+  have "x powi m = x powi (k*n) * x powi (m mod n)" by (subst k, intro power_int_add, use xnz in auto)
+  moreover have "x powi (k*n) = 1" using that
+    by (metis mult.commute power_int_1_left power_int_mult power_int_of_nat)
+  ultimately show ?thesis by force
+qed
+
+(* Manuel Eberl *)
+lemma Sigma_insert: "Sigma (insert x A) B = (\<lambda>y. (x, y)) ` B x \<union> Sigma A B"
+  by auto
+
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/Generated_Groups_Extend.thy b/thys/Finitely_Generated_Abelian_Groups/Generated_Groups_Extend.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Generated_Groups_Extend.thy
@@ -0,0 +1,238 @@
+(*
+    File:     Generated_Groups_Extend.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Generated Groups\<close>
+
+theory Generated_Groups_Extend
+  imports Miscellaneous_Groups "HOL-Algebra.Algebra"
+begin
+
+text \<open>This section extends the lemmas and facts about \<open>generate\<close>. Starting with a basic fact.\<close>
+
+lemma (in group) generate_sincl:
+  "A \<subseteq> generate G A"
+  using generate.incl by fast
+
+text \<open>The following lemmas reflect some of the idempotence characteristics of \<open>generate\<close> and have
+proved useful at several occasions.\<close>
+
+lemma (in group) generate_idem:
+  assumes "A \<subseteq> carrier G"
+  shows "generate G (generate G A) = generate G A"
+  using assms generateI group.generate_is_subgroup by blast
+
+lemma (in group) generate_idem':
+  assumes "A \<subseteq> carrier G" "B \<subseteq> carrier G"
+  shows "generate G (generate G A \<union> B) = generate G (A \<union> B)"
+proof
+  show "generate G (generate G A \<union> B) \<subseteq> generate G (A \<union> B)"
+  proof -
+    have "generate G A \<union> B \<subseteq> generate G (A \<union> B)"
+    proof -
+      have "generate G A \<subseteq> generate G (A \<union> B)" using mono_generate by simp
+      moreover have "B \<subseteq> generate G (A \<union> B)" by (simp add: generate.incl subset_iff)
+      ultimately show ?thesis by simp
+    qed
+    then have "generate G (generate G A \<union> B) \<subseteq> generate G (generate G (A \<union> B))"
+      using mono_generate by auto
+    with generate_idem[of "A \<union> B"] show ?thesis using assms by simp
+  qed
+  show "generate G (A \<union> B) \<subseteq> generate G (generate G A \<union> B)"
+  proof -
+    have "A \<subseteq> generate G A" using generate.incl by fast
+    thus ?thesis using mono_generate[of "A \<union> B" "generate G A \<union> B"] by blast
+  qed
+qed
+
+lemma (in group) generate_idem'_right:
+  assumes "A \<subseteq> carrier G" "B \<subseteq> carrier G"
+  shows "generate G (A \<union> generate G B) = generate G (A \<union> B)"
+  using generate_idem'[OF assms(2) assms(1)] by (simp add: sup_commute)
+
+lemma (in group) generate_idem_Un:
+  assumes "A \<subseteq> carrier G"
+  shows "generate G (\<Union>x\<in>A. generate G {x}) = generate G A"
+proof
+  have "A \<subseteq> (\<Union>x\<in>A. generate G {x})" using generate.incl by force
+  thus "generate G A \<subseteq> generate G (\<Union>x\<in>A. generate G {x})" using mono_generate by presburger
+  have "\<And>x. x \<in> A \<Longrightarrow> generate G {x} \<subseteq> generate G A" using mono_generate by auto
+  hence "(\<Union>x\<in>A. generate G {x}) \<subseteq> generate G A" by blast
+  thus "generate G (\<Union>x\<in>A. generate G {x}) \<subseteq> generate G A"
+    using generate_idem[OF assms] mono_generate by blast
+qed
+
+lemma (in group) generate_idem_fUn:
+  assumes "f A \<subseteq> carrier G"
+  shows "generate G (\<Union> {generate G {x} |x. x \<in> f A}) = generate G (f A)"
+proof
+  have "f A \<subseteq> \<Union> {generate G {x} |x. x \<in> f A}"
+  proof
+    fix x
+    assume x: "x \<in> f A"
+    have "x \<in> generate G {x}" using generate.incl by fast
+    thus "x \<in> \<Union> {generate G {x} |x. x \<in> f A}" using x by blast
+  qed
+  thus "generate G (f A) \<subseteq> generate G (\<Union> {generate G {x} |x. x \<in> f A})" using mono_generate by auto
+  have "\<And>x. x \<in> f A \<Longrightarrow> generate G {x} \<subseteq> generate G (f A)" using mono_generate by simp
+  hence "(\<Union> {generate G {x} |x. x \<in> f A}) \<subseteq> generate G (f A)" by blast
+  with mono_generate[OF this] show "generate G (\<Union> {generate G {x} |x. x \<in> f A}) \<subseteq> generate G (f A)"
+    using generate_idem[OF assms] by simp
+qed
+
+lemma (in group) generate_idem_fim_Un:
+  assumes "\<Union>(f ` A) \<subseteq> carrier G"
+  shows "generate G (\<Union>S \<in> A. generate G (f S)) = generate G (\<Union> {generate G {x} |x. x \<in> \<Union> (f ` A)})"
+proof
+  
+  have "\<And>S. S \<in> A \<Longrightarrow> generate G (f S) = generate G (\<Union> {generate G {x} |x. x \<in> f S})"
+    using generate_idem_fUn[of f] assms by blast
+  then have "generate G (\<Union>S \<in> A. generate G (f S))
+           = generate G (\<Union>S \<in> A. generate G (\<Union> {generate G {x} |x. x \<in> f S}))" by simp
+
+  have "\<Union> {generate G {x} |x. x \<in> \<Union> (f ` A)} \<subseteq> (\<Union>S\<in>A. generate G (f S))"
+  proof
+    fix x
+    assume x: "x \<in> \<Union> {generate G {x} |x. x \<in> \<Union> (f ` A)}"
+    then obtain a where a: "x \<in> generate G {a}" "a \<in> \<Union> (f ` A)" by blast
+    then obtain M where M: "a \<in> f M" "M \<in> A" by blast
+    then have "generate G {a} \<subseteq> generate G (f M)"
+      using generate.incl[OF M(1), of G] mono_generate[of "{a}" "generate G (f M)"]
+            generate_idem assms by auto
+    then have "x \<in> generate G (f M)" using a by blast
+    thus "x \<in> (\<Union>S\<in>A. generate G (f S))" using M by blast
+  qed
+  thus "generate G (\<Union> {generate G {x} |x. x \<in> \<Union> (f ` A)}) \<subseteq> generate G (\<Union>S\<in>A. generate G (f S))"
+    using mono_generate by simp
+  have a: "generate G (\<Union>S\<in>A. generate G (f S)) \<subseteq> generate G (\<Union> (f ` A))"
+  proof -
+    have "\<And>S. S \<in> A \<Longrightarrow> generate G (f S) \<subseteq> generate G (\<Union> (f ` A))"
+      using mono_generate[of _ "\<Union> (f ` A)"] by blast
+    then have "(\<Union>S\<in>A. generate G (f S)) \<subseteq> generate G (\<Union> (f ` A))" by blast
+    then have "generate G (\<Union>S\<in>A. generate G (f S)) \<subseteq> generate G (generate G (\<Union> (f ` A)))"
+      using mono_generate by meson
+    thus "generate G (\<Union>S\<in>A. generate G (f S)) \<subseteq>  generate G (\<Union> (f ` A))"
+      using generate_idem assms by blast
+  qed
+  have "\<Union> {generate G {x} |x. x \<in> \<Union> (f ` A)} = (\<Union>x\<in>\<Union> (f ` A). generate G {x})" by blast
+  with generate_idem_Un[OF assms]
+  have "generate G (\<Union> {generate G {x} |x. x \<in> \<Union> (f ` A)}) = generate G (\<Union> (f ` A))" by simp
+  with a show "generate G (\<Union>S\<in>A. generate G (f S))
+             \<subseteq> generate G (\<Union> {generate G {x} |x. x \<in> \<Union> (f ` A)})" by blast
+qed
+
+text \<open>The following two rules allow for convenient proving of the equality of two generated sets.\<close>
+
+lemma (in group) generate_eqI:
+  assumes "A \<subseteq> carrier G" "B \<subseteq> carrier G" "A \<subseteq> generate G B" "B \<subseteq> generate G A"
+  shows "generate G A = generate G B"
+  using assms generate_idem by (metis generate_idem' inf_sup_aci(5) sup.absorb2)
+
+lemma (in group) generate_one_switched_eqI:
+  assumes "A \<subseteq> carrier G" "a \<in> A" "B = (A - {a}) \<union> {b}"
+  and "b \<in> generate G A" "a \<in> generate G B"
+  shows "generate G A = generate G B"
+proof(intro generate_eqI)
+  show "A \<subseteq> carrier G" by fact
+  show "B \<subseteq> carrier G" using assms generate_incl by blast
+  show "A \<subseteq> generate G B" using assms generate_sincl[of B] by blast
+  show "B \<subseteq> generate G A" using assms generate_sincl[of A] by blast
+qed
+
+lemma (in group) generate_subset_eqI:
+  assumes "A \<subseteq> carrier G" "B \<subseteq> A" "A - B \<subseteq> generate G B"
+  shows "generate G A = generate G B"
+proof
+  show "generate G B \<subseteq> generate G A" by (intro mono_generate, fact)
+  show "generate G A \<subseteq> generate G B"
+  proof(subst generate_idem[of "B", symmetric])
+    show "generate G A \<subseteq> generate G (generate G B)"
+      by (intro mono_generate, use assms generate_sincl[of B] in auto)
+  qed (use assms in blast)
+qed
+
+text \<open>Some smaller lemmas about \<open>generate\<close>.\<close>
+
+lemma (in group) generate_subset_change_eqI:
+  assumes "A \<subseteq> carrier G" "B \<subseteq> carrier G" "C \<subseteq> carrier G" "generate G A = generate G B"
+  shows "generate G (A \<union> C) = generate G (B \<union> C)"
+  by (metis assms generate_idem')
+
+lemma (in group) generate_subgroup_id:
+  assumes "subgroup H G"
+  shows "generate G H = H"
+  using assms generateI by auto
+
+lemma (in group) generate_consistent':
+  assumes "subgroup H G" "A \<subseteq> H"
+  shows "\<forall>x \<in> A. generate G {x} = generate (G\<lparr>carrier := H\<rparr>) {x}"
+  using generate_consistent assms by auto
+
+lemma (in group) generate_singleton_one:
+  assumes "generate G {a} = {\<one>}"
+  shows "a = \<one>"
+  using generate.incl[of a "{a}" G] assms by auto
+
+lemma (in group) generate_inv_eq:
+  assumes "a \<in> carrier G"
+  shows "generate G {a} = generate G {inv a}"
+  by (intro generate_eqI;
+      use assms generate.inv[of a] generate.inv[of "inv a" "{inv a}" G] inv_inv[OF assms] in auto)
+
+lemma (in group) generate_eq_imp_subset:
+  assumes "generate G A = generate G B"
+  shows "A \<subseteq> generate G B"
+  using generate.incl assms by fast
+
+
+text \<open>The neutral element does not play a role when generating a subgroup.\<close>
+
+lemma (in group) generate_one_irrel:
+  "generate G A = generate G (A \<union> {\<one>})"
+proof
+  show "generate G A \<subseteq> generate G (A \<union> {\<one>})" by (intro mono_generate, blast)
+  show "generate G (A \<union> {\<one>}) \<subseteq> generate G A"
+  proof(rule subsetI)
+    show "x \<in> generate G A" if "x \<in> generate G (A \<union> {\<one>})" for x using that
+      by (induction rule: generate.induct;
+          use generate.one generate.incl generate.inv generate.eng in auto)
+  qed
+qed
+
+lemma (in group) generate_one_irrel':
+  "generate G A = generate G (A - {\<one>})"
+  using generate_one_irrel by (metis Un_Diff_cancel2)
+
+text \<open>Also, we can express the subgroup generated by a singleton with finite order using just its
+powers up to its order.\<close>
+
+lemma (in group) generate_nat_pow:
+  assumes "ord a \<noteq> 0" "a \<in> carrier G"
+  shows "generate G {a} = {a [^] k |k. k \<in> {0..ord a - 1}}"
+  using assms generate_pow_nat ord_elems_inf_carrier by auto
+
+lemma (in group) generate_nat_pow':
+  assumes "ord a \<noteq> 0" "a \<in> carrier G"
+  shows "generate G {a} = {a [^] k |k. k \<in> {1..ord a}}"
+proof -
+  have "{a [^] k |k. k \<in> {1..ord a}} = {a [^] k |k. k \<in> {0..ord a - 1}}"
+  proof -
+    have "a [^] k \<in> {a [^] k |k. k \<in> {0..ord a - 1}}" if "k \<in> {1..ord a}" for k
+      using that pow_nat_mod_ord[OF assms(2, 1), of "ord a"] assms by (cases "k = ord a"; force)
+    moreover have "a [^] k \<in> {a [^] k |k. k \<in> {1..ord a}}" if "k \<in> {0..ord a - 1}" for k
+    proof(cases "k = 0")
+      case True
+      hence "a [^] k = a [^] ord a" using pow_ord_eq_1[OF assms(2)] by auto
+      moreover have "ord a \<in> {1..ord a}"
+        using assms unfolding atLeastAtMost_def atLeast_def atMost_def by auto
+      ultimately show ?thesis by blast
+    next
+      case False
+      then show ?thesis using that by auto
+    qed 
+    ultimately show ?thesis by blast
+  qed
+  with generate_nat_pow[OF assms] show ?thesis by simp
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/Group_Hom.thy b/thys/Finitely_Generated_Abelian_Groups/Group_Hom.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Group_Hom.thy
@@ -0,0 +1,210 @@
+(*
+    File:     Group_Hom.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Group Homomorphisms\<close>
+
+theory Group_Hom
+  imports Set_Multiplication
+begin
+
+text \<open>This section extends the already existing library about group homomorphisms in HOL-Algebra by
+some useful lemmas. These were mainly inspired by the needs that arised throughout the other proofs.\<close>
+
+lemma (in group_hom) generate_hom:
+  assumes "A \<subseteq> carrier G"
+  shows "h ` (generate G A) = generate H (h ` A)"
+  using assms group_hom.generate_img group_hom_axioms by blast
+
+text \<open>For two elements with the same image we can find an element in the kernel that maps one of the
+two elements on the other by multiplication.\<close>
+
+lemma (in group_hom) kernel_assoc_elem:
+  assumes "x \<in> carrier G" "y \<in> carrier G" "h x = h y"
+  obtains z where "x = y \<otimes>\<^bsub>G\<^esub> z" "z \<in> kernel G H h"
+proof -
+  have c: "inv y \<otimes>\<^bsub>G\<^esub> x \<in> carrier G" using assms by simp
+  then have e: "x = y \<otimes>\<^bsub>G\<^esub> (inv y \<otimes>\<^bsub>G\<^esub> x)" using assms G.m_assoc
+    using G.inv_solve_left by blast
+  then have "h x = h (y \<otimes>\<^bsub>G\<^esub> (inv y \<otimes>\<^bsub>G\<^esub> x))" by simp
+  then have "h x = h y \<otimes>\<^bsub>H\<^esub> h (inv y \<otimes>\<^bsub>G\<^esub> x)" using c assms by simp
+  then have "\<one>\<^bsub>H\<^esub> = h (inv y \<otimes>\<^bsub>G\<^esub> x)" using assms by simp
+  then have "(inv y \<otimes>\<^bsub>G\<^esub> x) \<in> kernel G H h" unfolding kernel_def using c by simp
+  thus ?thesis using e that by blast
+qed
+
+text \<open>This can then be used to characterize the pre-image of a set $A$ under homomorphism as a
+product of $A$ itself with the kernel of the homomorphism.\<close>
+
+lemma (in group_hom) vimage_eq_set_mult_kern_right:
+  assumes "A \<subseteq> carrier G"
+  shows "{x \<in> carrier G. h x \<in> h ` A} = A <#> kernel G H h"
+proof(intro equalityI subsetI)
+  fix x
+  assume assm: "x \<in> A <#> kernel G H h"
+  then have xc: "x \<in> carrier G" unfolding kernel_def set_mult_def using assms by blast
+  from assm obtain a b where ab: "a \<in> A" "b \<in> kernel G H h" "x = a \<otimes>\<^bsub>G\<^esub> b"
+    unfolding set_mult_def by blast
+  then have abc: "a \<in> carrier G" "b \<in> carrier G" unfolding kernel_def using assms by auto
+  from ab have "h x = h (a \<otimes>\<^bsub>G\<^esub> b)" by blast
+  also have "\<dots> = h a \<otimes>\<^bsub>H\<^esub> h b" using abc by simp
+  also have "\<dots> = h a \<otimes>\<^bsub>H\<^esub> \<one>\<^bsub>H\<^esub>" using ab(2) unfolding kernel_def by simp
+  also have "\<dots> = h a" using abc by simp
+  also have "\<dots> \<in> h ` A" using ab by blast 
+  finally have "h x \<in> h ` A" .
+  thus "x \<in> {x \<in> carrier G. h x \<in> h ` A}" using xc by blast
+next
+  fix x
+  assume "x \<in> {x \<in> carrier G. h x \<in> h ` A}"
+  then have x: "x \<in> carrier G" "h x \<in> h ` A" by simp+
+  then obtain y where y: "y \<in> A" "h x = h y" "y \<in> carrier G" using assms by auto
+  with kernel_assoc_elem obtain z where "x = y \<otimes>\<^bsub>G\<^esub> z" "z \<in> kernel G H h" using x by metis
+  thus "x \<in> A <#> kernel G H h" unfolding set_mult_def using y by blast
+qed
+
+lemma (in group_hom) vimage_subset_generate_kern:
+  assumes "A \<subseteq> carrier G"
+  shows "{x \<in> carrier G. h x \<in> h ` A} \<subseteq> generate G (A \<union> kernel G H h)"
+  using vimage_eq_set_mult_kern_right[of A] G.set_mult_subset_generate[of "A" "kernel G H h"] assms
+  unfolding kernel_def by blast
+
+text \<open>The preimage of a subgroup under a homomorphism is also a subgroup.\<close>
+
+lemma (in group_hom) subgroup_vimage_is_subgroup:
+  assumes "subgroup I H"
+  shows "subgroup {x \<in> carrier G. h x \<in> I} G" (is "subgroup ?J G")
+proof
+  show "?J \<subseteq> carrier G" by blast
+  show "\<one> \<in> ?J" using subgroup.one_closed[of I H] assms by simp
+  fix x
+  assume x: "x \<in> ?J"
+  then have hx: "h x \<in> I" by blast
+  show "inv x \<in> ?J"
+  proof -
+    from hx have "inv\<^bsub>H\<^esub> (h x) \<in> I" using subgroup.m_inv_closed assms by fast
+    moreover have "inv x \<in> carrier G" using x by simp
+    moreover have "inv\<^bsub>H\<^esub> (h x) = h (inv x)" using x by auto
+    ultimately show "inv x \<in> ?J" by simp
+  qed
+  fix y
+  assume y: "y \<in> ?J"
+  then have hy: "h y \<in> I" by blast
+  show "x \<otimes> y \<in> {x \<in> carrier G. h x \<in> I}"
+  proof -
+    have "h (x \<otimes> y) = h x \<otimes>\<^bsub>H\<^esub> h y" using x y by simp
+    also have "\<dots> \<in> I" using hx hy assms subgroup.m_closed by fast
+    finally have "h (x \<otimes> y) \<in> I" .
+    moreover have "x \<otimes> y \<in> carrier G" using x y by simp
+    ultimately show ?thesis by blast
+  qed
+qed
+
+lemma (in group_hom) iso_kernel:
+  assumes "h \<in> iso G H"
+  shows "kernel G H h = {\<one>\<^bsub>G\<^esub>}"
+  unfolding kernel_def using assms
+  using hom_one iso_iff by blast
+
+\<^marker>\<open>contributor \<open>Paulo Emílio de Vilhena\<close>\<close> (* adapted by Joseph Thommes *)
+lemma (in group_hom) induced_group_hom_same_group: 
+  assumes "subgroup I G"
+  shows "group_hom (G \<lparr> carrier := I \<rparr>) H h"
+proof -
+  have "h \<in> hom (G \<lparr> carrier := I \<rparr>) H"
+    using homh subgroup.mem_carrier[OF assms] unfolding hom_def by auto
+  thus ?thesis
+    unfolding group_hom_def group_hom_axioms_def
+    using subgroup.subgroup_is_group[OF assms G.is_group] by simp
+qed
+
+text \<open>The order of an element under a homomorphism divides the order of the element.\<close>
+
+lemma (in group_hom) hom_ord_dvd_ord:
+  assumes "a \<in> carrier G"
+  shows "H.ord (h a) dvd G.ord a"
+proof -
+  have "h a [^]\<^bsub>H\<^esub> (G.ord a) = h (a [^]\<^bsub>G\<^esub> G.ord a)"
+    using assms local.hom_nat_pow by presburger
+  also have "\<dots> = h (\<one>\<^bsub>G\<^esub>)" using G.pow_ord_eq_1 assms by simp
+  also have "\<dots> = \<one>\<^bsub>H\<^esub>" by simp
+  finally have "h a [^]\<^bsub>H\<^esub> G.ord a = \<one>\<^bsub>H\<^esub>" .
+  then show ?thesis using pow_eq_id assms by simp
+qed
+
+text \<open>In particular, this implies that the image of an element with a finite order also will have a
+finite order.\<close>
+
+lemma (in group_hom) finite_ord_stays_finite:
+  assumes "a \<in> carrier G" "G.ord a \<noteq> 0"
+  shows "H.ord (h a) \<noteq> 0"
+  using hom_ord_dvd_ord assms by fastforce
+
+text \<open>For injective homomorphisms, the order stays the same.\<close>
+
+lemma (in group_hom) inj_imp_ord_eq:
+  assumes "a \<in> carrier G" "inj_on h (carrier G)" "G.ord a \<noteq> 0"
+  shows "H.ord (h a) = G.ord a"
+proof (rule antisym)
+  show "H.ord (h a) \<le> G.ord a" using hom_ord_dvd_ord assms by force
+  show "G.ord a \<le> H.ord (h a)"
+  proof -
+    have "\<one>\<^bsub>H\<^esub> = h (a [^]\<^bsub>G\<^esub> H.ord(h a))" using H.pow_ord_eq_1 assms
+      by (simp add: local.hom_nat_pow)
+    then have "a [^]\<^bsub>G\<^esub> H.ord (h a) = \<one>\<^bsub>G\<^esub>" using assms inj_on_one_iff by simp
+    then have "G.ord a dvd H.ord (h a)" using G.pow_eq_id assms(1) by blast
+    thus ?thesis using assms finite_ord_stays_finite by fastforce
+  qed
+qed
+
+lemma (in group_hom) one_in_kernel:
+  "\<one> \<in> kernel G H h"
+  using subgroup.one_closed subgroup_kernel by blast
+
+lemma hom_in_carr:
+  assumes "f \<in> hom G H"
+  shows "\<And>x. x \<in> carrier G \<Longrightarrow> f x \<in> carrier H"
+  using assms unfolding hom_def bij_betw_def by blast
+
+lemma iso_in_carr:
+  assumes "f \<in> iso G H"
+  shows "\<And>x. x \<in> carrier G \<Longrightarrow> f x \<in> carrier H"
+  using assms unfolding iso_def bij_betw_def by blast
+
+lemma triv_iso:
+  assumes "group G" "group H" "carrier G = {\<one>\<^bsub>G\<^esub>}" "carrier H = {\<one>\<^bsub>H\<^esub>}"
+  shows "G \<cong> H"
+proof(unfold is_iso_def iso_def)
+  interpret G: group G by fact
+  interpret H: group H by fact
+  let ?f = "\<lambda>_. \<one>\<^bsub>H\<^esub>"
+  have "?f \<in> hom G H" by (intro homI, auto)
+  moreover have "bij_betw ?f (carrier G) (carrier H)" unfolding bij_betw_def
+    using assms(3, 4) by auto
+  ultimately show "{h \<in> hom G H. bij_betw h (carrier G) (carrier H)} \<noteq> {}" by blast
+qed
+
+text \<open>The cardinality of the image of a group homomorphism times the cardinality of its kernel is
+equal to the group order. This is basically another form of Lagrange's theorem.\<close>
+
+lemma (in group_hom) image_kernel_product: "card (h ` (carrier G)) * card (kernel G H h) = order G" 
+proof -
+  interpret G: group G by simp
+  interpret H: group H by simp
+  interpret ih: subgroup "h ` (carrier G)" H using img_is_subgroup by blast
+  interpret ih: group "H\<lparr>carrier := h ` (carrier G)\<rparr>" using subgroup.subgroup_is_group by blast
+  interpret h: group_hom G "H\<lparr>carrier := h ` (carrier G)\<rparr>"
+    by (unfold_locales, unfold hom_def, auto)
+  interpret k: subgroup "kernel G (H\<lparr>carrier := h ` carrier G\<rparr>) h" G using h.subgroup_kernel by blast
+  from h.FactGroup_iso
+  have "G Mod kernel G (H\<lparr>carrier := h ` carrier G\<rparr>) h \<cong> H\<lparr>carrier := h ` carrier G\<rparr>" by auto
+  hence "card (h ` (carrier G)) = order (G Mod kernel G (H\<lparr>carrier := h ` carrier G\<rparr>) h)"
+    using iso_same_card unfolding order_def by fastforce
+  moreover have "order (G Mod kernel G (H\<lparr>carrier := h ` carrier G\<rparr>) h)
+                 * card (kernel G (H\<lparr>carrier := h ` carrier G\<rparr>) h) = order G"
+    using G.lagrange[OF k.subgroup_axioms] unfolding order_def FactGroup_def by force
+  moreover have "kernel G (H\<lparr>carrier := h ` carrier G\<rparr>) h = kernel G H h"
+    unfolding kernel_def by auto
+  ultimately show ?thesis by argo
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/Group_Relations.thy b/thys/Finitely_Generated_Abelian_Groups/Group_Relations.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Group_Relations.thy
@@ -0,0 +1,222 @@
+(*
+    File:     Group_Relations.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Group relations\<close>
+
+theory Group_Relations
+  imports Finite_Product_Extend
+begin
+
+text \<open>We introduce the notion of a relation of a set of elements: a way to express the neutral
+element by using only powers of said elements. The following predicate describes the set of all the
+relations that one can construct from a set of elements.\<close>
+
+definition (in comm_group) relations :: "'a set \<Rightarrow> ('a \<Rightarrow> int) set" where
+  "relations A = {f. finprod G (\<lambda>a. a [^] f a) A = \<one>} \<inter> extensional A"
+
+text \<open>Now some basic lemmas about relations.\<close>
+
+lemma (in comm_group) in_relationsI[intro]:
+  assumes "finprod G (\<lambda>a. a [^] f a) A = \<one>" "f \<in> extensional A"
+  shows "f \<in> relations A"
+  unfolding relations_def using assms by blast
+
+lemma (in comm_group) triv_rel:
+  "restrict (\<lambda>_. 0::int) A \<in> relations A"
+proof
+  show "(\<Otimes>a\<in>A. a [^] (\<lambda>_\<in>A. 0::int) a) = \<one>" by (intro finprod_one_eqI, simp)
+qed simp
+
+lemma (in comm_group) not_triv_relI:
+  assumes "a \<in> A" "f a \<noteq> (0::int)"
+  shows "f \<noteq> (\<lambda>_\<in>A. 0::int)"
+  using assms by auto
+
+lemma (in comm_group) rel_in_carr:
+  assumes "A \<subseteq> carrier G" "r \<in> relations A"
+  shows "(\<lambda>a. a [^] r a) \<in> A \<rightarrow> carrier G"
+  by (meson Pi_I assms(1) int_pow_closed subsetD)
+
+text \<open>The following lemmas are of importance when proving the fundamental theorem of finitely
+generated abelian groups in the case that there is just the trivial relation between a set of
+generators. They all build up to the last lemma that then is actually used in the proof.\<close>
+
+lemma (in comm_group) relations_zero_imp_pow_not_one:
+  assumes "a \<in> A" "\<forall>f\<in>(relations A). f a = 0"
+  shows "\<forall>z::int \<noteq> 0. a [^] z \<noteq> \<one>"
+proof (rule ccontr; safe)
+  fix z::int
+  assume z: "z \<noteq> 0" "a [^] z = \<one>"
+  have "restrict ((\<lambda>x. 0)(a := z)) A \<in> relations A"
+    by (intro in_relationsI finprod_one_eqI, use z in auto)
+  thus False using z assms by auto
+qed
+
+lemma (in comm_group) relations_zero_imp_ord_zero:
+  assumes "a \<in> A" "\<forall>f\<in>(relations A). f a = 0"
+  and "a \<in> carrier G"
+  shows "ord a = 0"
+  using assms relations_zero_imp_pow_not_one[OF assms(1, 2)]
+  by (meson finite_cyclic_subgroup_int infinite_cyclic_subgroup_order)
+
+lemma (in comm_group) finprod_relations_triv_harder_better_stronger:
+  assumes "A \<subseteq> carrier G" "relations A = {(\<lambda>_\<in>A. 0::int)}"
+  shows "\<forall>f \<in> Pi\<^sub>E A (\<lambda>a. generate G {a}). finprod G f A = \<one> \<longrightarrow> (\<forall>a\<in>A. f a = \<one>)"
+proof(rule, rule)
+  fix f
+  assume f: "f \<in> (\<Pi>\<^sub>E a\<in>A. generate G {a})" "finprod G f A = \<one>"
+  with generate_pow assms(1) have "\<forall>a\<in>A. \<exists>k::int. f a = a [^] k" by auto
+  then obtain r::"'a \<Rightarrow> int" where r: "\<forall>a\<in>A. f a = a [^] r a" by metis
+  have "restrict r A \<in> relations A"
+  proof(intro in_relationsI)
+    have "(\<Otimes>a\<in>A. a [^] restrict r A a) = finprod G f A"
+      by (intro finprod_cong, use assms r in auto)
+    thus "(\<Otimes>a\<in>A. a [^] restrict r A a) = \<one>" using f by simp
+  qed simp
+  with assms(2) have z: "restrict r A = (\<lambda>_\<in>A. 0)" by blast
+  have "(restrict r A) a = r a" if "a \<in> A" for a using that by auto
+  with r z show "\<forall>a\<in>A. f a = \<one>" by auto
+qed
+
+lemma (in comm_group) stronger_PiE_finprod_imp:
+  assumes "A \<subseteq> carrier G" "\<forall>f \<in> Pi\<^sub>E A (\<lambda>a. generate G {a}). finprod G f A = \<one> \<longrightarrow> (\<forall>a\<in>A. f a = \<one>)"
+  shows "\<forall>f \<in> Pi\<^sub>E ((\<lambda>a. generate G {a}) ` A) id.
+         finprod G f ((\<lambda>a. generate G {a}) ` A) = \<one> \<longrightarrow> (\<forall>H\<in> (\<lambda>a. generate G {a}) ` A. f H = \<one>)"
+proof(rule, rule)
+  fix f
+  assume f: "f \<in> Pi\<^sub>E ((\<lambda>a. generate G {a}) ` A) id" "finprod G f ((\<lambda>a. generate G {a}) ` A) = \<one>"
+  define B where "B = inv_into A (\<lambda>a. generate G {a}) ` ((\<lambda>a. generate G {a}) ` A)"
+  have Bs: "B \<subseteq> A"
+  proof
+    fix x
+    assume x: "x \<in> B"
+    then obtain C where C: "C \<in> ((\<lambda>a. generate G {a}) ` A)" "x = inv_into A (\<lambda>a. generate G {a}) C"
+      unfolding B_def by blast
+    then obtain c where c: "C = generate G {c}" "c \<in> A" by blast
+    with C someI_ex[of "\<lambda>y. y \<in> A \<and> generate G {y} = C"] show "x \<in> A"
+      unfolding inv_into_def by blast
+  qed
+  have sI: "(\<lambda>x. generate G {x}) ` B = (\<lambda>x. generate G {x}) ` A"
+  proof
+    show "(\<lambda>x. generate G {x}) ` B \<subseteq> (\<lambda>x. generate G {x}) ` A" using Bs by blast
+    show "(\<lambda>x. generate G {x}) ` A \<subseteq> (\<lambda>x. generate G {x}) ` B"
+    proof
+      fix C
+      assume C: "C \<in> (\<lambda>x. generate G {x}) ` A"
+      then obtain x where x: "x = inv_into A (\<lambda>a. generate G {a}) C" unfolding B_def by blast
+      then obtain c where c: "C = generate G {c}" "c \<in> A" using C by blast
+      with C x someI_ex[of "\<lambda>y. y \<in> A \<and> generate G {y} = C"] have "generate G {x} = C"
+        unfolding inv_into_def by blast
+      with x C show "C \<in> (\<lambda>x. generate G {x}) ` B" unfolding B_def by blast
+    qed
+  qed
+  have fBc: "f (generate G {b}) \<in> carrier G" if "b \<in> B" for b
+  proof -
+    have "f (generate G {b}) \<in> generate G {b}" using f(1)
+      by (subst (asm) sI[symmetric], use that in fastforce)
+    moreover have "generate G {b} \<subseteq> carrier G" using assms(1) that Bs generate_incl by blast
+    ultimately show ?thesis by blast
+  qed
+  let ?r = "restrict (\<lambda>a. if a\<in>B then f (generate G {a}) else \<one>) A"
+  have "?r \<in> Pi\<^sub>E A (\<lambda>a. generate G {a})"
+  proof
+    show "?r x = undefined" if "x \<notin> A" for x using that by simp
+    show "?r x \<in> generate G {x}" if "x \<in> A" for x using that generate.one B_def f(1) by auto
+  qed
+  moreover have "finprod G ?r A = \<one>"
+  proof (cases "finite A")
+    case True
+    have "A = B \<union> (A - B)" using Bs by auto
+    then have "finprod G ?r A = finprod G ?r (B\<union>(A-B))" by auto
+    moreover have "\<dots> = finprod G ?r B \<otimes> finprod G ?r (A - B)"
+    proof(intro finprod_Un_disjoint)
+      from True Bs finite_subset show "finite B" "finite (A - B)" "B \<inter> (A - B) = {}" by auto
+      show "(\<lambda>a\<in>A. if a \<in> B then f (generate G {a}) else \<one>) \<in> A - B \<rightarrow> carrier G" using Bs by simp
+      from fBc show "(\<lambda>a\<in>A. if a \<in> B then f (generate G {a}) else \<one>) \<in> B \<rightarrow> carrier G"
+        using Bs by auto
+    qed
+    moreover have "finprod G ?r B = \<one>"
+    proof -
+      have "finprod G ?r B = finprod G (f \<circ> (\<lambda>a. generate G {a})) B"
+      proof(intro finprod_cong')
+        show "?r b = (f \<circ> (\<lambda>a. generate G {a})) b" if "b \<in> B" for b using that Bs by auto
+        show "f \<circ> (\<lambda>a. generate G {a}) \<in> B \<rightarrow> carrier G" using fBc by simp
+      qed simp
+      also have "\<dots> = finprod G f ((\<lambda>a. generate G {a}) ` B)"
+      proof(intro finprod_comp[symmetric])
+        show "(f \<circ> (\<lambda>a. generate G {a})) ` B \<subseteq> carrier G" using fBc by auto
+        show "inj_on (\<lambda>a. generate G {a}) B"
+          by (intro inj_onI, unfold B_def, metis (no_types, lifting) f_inv_into_f inv_into_into)
+      qed
+      also have "\<dots> = finprod G f ((\<lambda>a. generate G {a}) ` A)" using sI by argo
+      finally show ?thesis using f(2) by argo
+    qed
+    moreover have "finprod G ?r (A - B) = \<one>" by(intro finprod_one_eqI, simp)
+    ultimately show ?thesis by fastforce
+  next
+    case False
+    then show ?thesis unfolding finprod_def by simp
+  qed
+  ultimately have a: "\<forall>a\<in>A. ?r a = \<one>" using assms(2) by blast
+  then have BA: "\<forall>a\<in>B\<inter>A. ?r a = \<one>" by blast
+  from Bs sI have "\<forall>a\<in>A. (generate G {a}) \<in> ((\<lambda>x. generate G {x}) ` B)" by simp
+  then have "\<forall>a\<in>A. \<exists>b\<in>B. f (generate G {a}) = f (generate G {b})" by force
+  thus "\<forall>H\<in>(\<lambda>a. generate G {a}) ` A. f H = \<one>" using a BA Bs by fastforce
+qed
+
+lemma (in comm_group) finprod_relations_triv:
+  assumes "A \<subseteq> carrier G" "relations A = {(\<lambda>_\<in>A. 0::int)}"
+  shows "\<forall>f \<in> Pi\<^sub>E ((\<lambda>a. generate G {a}) ` A) id.
+         finprod G f ((\<lambda>a. generate G {a}) ` A) = \<one> \<longrightarrow> (\<forall>H\<in> (\<lambda>a. generate G {a}) ` A. f H = \<one>)"
+  using assms finprod_relations_triv_harder_better_stronger stronger_PiE_finprod_imp by presburger
+
+lemma (in comm_group) ord_zero_strong_imp_rel_triv:
+  assumes "A \<subseteq> carrier G" "\<forall>a \<in> A. ord a = 0"
+  and "\<forall>f \<in> Pi\<^sub>E A (\<lambda>a. generate G {a}). finprod G f A = \<one> \<longrightarrow> (\<forall>a\<in>A. f a = \<one>)"
+  shows "relations A = {(\<lambda>_\<in>A. 0::int)}"
+proof -
+  have "\<And>r. r \<in> relations A \<Longrightarrow> r = (\<lambda>_\<in>A. 0::int)"
+  proof
+    fix r x
+    assume r: "r \<in> relations A"
+    show "r x = (\<lambda>_\<in>A. 0::int) x"
+    proof (cases "x \<in> A")
+      case True
+      let ?r = "restrict (\<lambda>a. a [^] r a) A"
+      have rp: "?r \<in> Pi\<^sub>E A (\<lambda>a. generate G {a})"
+      proof -
+        have "?r \<in> extensional A" by blast
+        moreover have "?r \<in> Pi A (\<lambda>a. generate G {a})"
+        proof
+          fix a
+          assume a: "a \<in> A"
+          then have sga: "subgroup (generate G {a}) G" using generate_is_subgroup assms(1) by auto
+          show "a [^] r a \<in> generate G {a}"
+            using generate.incl[of a "{a}" G] subgroup_int_pow_closed[OF sga] by simp
+        qed
+        ultimately show ?thesis unfolding PiE_def by blast
+      qed
+      have "finprod G ?r A = (\<Otimes>a\<in>A. a [^] r a)" by(intro finprod_cong, use assms(1) in auto)
+      with r have "finprod G ?r A = \<one>" unfolding relations_def by simp
+      with assms(3) rp have "\<forall>a\<in>A. ?r a = \<one>" by fast
+      then have "\<forall>a\<in>A. a [^] r a = \<one>" by simp
+      with assms(1, 2) True have "r x = 0"
+        using finite_cyclic_subgroup_int infinite_cyclic_subgroup_order by blast
+      thus ?thesis using True by simp
+    next
+      case False
+      thus ?thesis using r unfolding relations_def extensional_def by simp
+    qed
+  qed
+  thus ?thesis using triv_rel by blast
+qed
+
+lemma (in comm_group) compl_fam_iff_relations_triv:
+  assumes "finite gs" "gs \<subseteq> carrier G" "\<forall>g\<in>gs. ord g = 0"
+  shows "relations gs = {(\<lambda>_\<in>gs. 0::int)} \<longleftrightarrow> compl_fam (\<lambda>g. generate G {g}) gs"
+  using triv_finprod_iff_compl_fam_PiE[of _ "\<lambda>g. generate G {g}", OF assms(1) generate_is_subgroup]
+        ord_zero_strong_imp_rel_triv[OF assms(2, 3)]
+        finprod_relations_triv_harder_better_stronger[OF assms(2)] assms by blast
+
+end
diff --git a/thys/Finitely_Generated_Abelian_Groups/IDirProds.thy b/thys/Finitely_Generated_Abelian_Groups/IDirProds.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/IDirProds.thy
@@ -0,0 +1,478 @@
+(*
+    File:     IDirProds.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Internal direct product\<close>
+
+theory IDirProds
+  imports Generated_Groups_Extend General_Auxiliary
+begin
+
+subsection \<open>Complementarity\<close>
+
+text \<open>We introduce the notion of complementarity, that plays a central role in the internal
+direct group product and prove some basic properties about it.\<close>
+
+definition (in group) complementary :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" where
+  "complementary H1 H2 \<longleftrightarrow> H1 \<inter> H2 = {\<one>}"
+
+lemma (in group) complementary_symm: "complementary A B \<longleftrightarrow> complementary B A"
+  unfolding complementary_def by blast
+
+lemma (in group) subgroup_carrier_complementary:
+  assumes "complementary H J" "subgroup I (G\<lparr>carrier := H\<rparr>)" "subgroup K (G\<lparr>carrier := J\<rparr>)"
+  shows "complementary I K"
+proof -
+  have "\<one> \<in> I"  "\<one> \<in> K" using subgroup.one_closed assms by fastforce+
+  moreover have "I \<inter> K \<subseteq> H \<inter> J" using subgroup.subset assms by force
+  ultimately show ?thesis using assms unfolding complementary_def by blast
+qed
+
+lemma (in group) subgroup_subset_complementary:
+  assumes "subgroup H G" "subgroup J G" "subgroup I G"
+  and "I \<subseteq> J" "complementary H J"
+shows "complementary H I"
+  by (intro subgroup_carrier_complementary[OF assms(5), of H I] subgroup_incl, use assms in auto)
+
+lemma (in group) complementary_subgroup_iff:
+  assumes "subgroup H G"
+  shows "complementary A B \<longleftrightarrow> group.complementary (G\<lparr>carrier := H\<rparr>) A B"
+proof -
+  interpret H: group "G\<lparr>carrier := H\<rparr>" using subgroup.subgroup_is_group assms by blast
+  have "\<one>\<^bsub>G\<^esub> = \<one>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub>" by simp
+  then show ?thesis unfolding complementary_def H.complementary_def by simp
+qed
+
+lemma (in group) subgroups_card_coprime_imp_compl:
+  assumes "subgroup H G" "subgroup J G" "coprime (card H) (card J)"
+  shows "complementary H J" unfolding complementary_def
+proof -
+  interpret JH: subgroup "(H \<inter> J)" G using assms subgroups_Inter_pair by blast
+  from subgroups_card_coprime_inter_card_one[OF assms] show "H \<inter> J = {\<one>}" using JH.one_closed
+    by (metis card_1_singletonE singletonD)
+qed
+
+lemma (in group) prime_power_complementary_groups:
+  assumes "Factorial_Ring.prime p" "Factorial_Ring.prime q" "p \<noteq> q"
+  and "subgroup P G" "card P = p ^ x"
+  and "subgroup Q G" "card Q = q ^ y"
+  shows "complementary P Q"
+proof -
+  from assms have "coprime (card P) (card Q)"
+    by (metis coprime_power_right_iff primes_coprime coprime_def)
+  then show ?thesis using subgroups_card_coprime_imp_compl assms complementary_def by blast
+qed
+
+text \<open>With the previous work from the theory about set multiplication we can characterize
+complementarity of two subgroups in abelian groups by the cardinality of their product.\<close>
+
+lemma (in comm_group) compl_imp_diff_cosets:
+  assumes "subgroup H G" "subgroup J G" "finite H" "finite J"
+  and "complementary H J"
+  shows "\<And>a b. \<lbrakk>a \<in> J; b \<in> J; a \<noteq> b\<rbrakk> \<Longrightarrow> (H #> a) \<noteq> (H #> b)"
+proof (rule ccontr; safe)
+  fix a b
+  assume ab: "a \<in> J" "b \<in> J" "a \<noteq> b"
+  then have [simp]: "a \<in> carrier G" "b \<in> carrier G" using assms subgroup.subset by auto
+  assume "H #> a = H #> b"
+  then have "a \<otimes> inv b \<in> H" using assms(1, 2) ab
+    by (metis comm_group_axioms comm_group_def rcos_self
+              subgroup.mem_carrier subgroup.rcos_module_imp)
+  moreover have "a \<otimes> inv b \<in> J"
+    by (rule subgroup.m_closed[OF assms(2) ab(1) subgroup.m_inv_closed[OF assms(2) ab(2)]])
+  moreover have "a \<otimes> inv b \<noteq> \<one>" using ab inv_equality by fastforce
+  ultimately have "H \<inter> J \<noteq> {\<one>}" by blast
+  thus False using assms(5) unfolding complementary_def by blast
+qed
+
+lemma (in comm_group) finite_sub_card_eq_mult_imp_comp:
+  assumes "subgroup H G" "subgroup J G" "finite H" "finite J"
+  and "card (H <#> J) = (card J * card H)"
+  shows "complementary H J"
+  unfolding complementary_def
+proof (rule ccontr)
+  assume "H \<inter> J \<noteq> {\<one>}"
+  have "\<one> \<in> H" using subgroup.one_closed assms(1) by blast
+  moreover have "\<one> \<in> J" using subgroup.one_closed assms(2) by blast
+  ultimately have "\<one> \<in> (H \<inter> J)" by blast
+
+  then obtain a where a_def: "a \<in> (H \<inter> J) \<and> a \<noteq> \<one>" using \<open>H \<inter> J \<noteq> {\<one>}\<close> by blast
+  then have aH: "a \<in> H" by blast
+  then have a_inv_H: "inv a \<in> H \<and> inv a \<noteq> \<one>" using assms(1)
+    by (meson a_def inv_eq_1_iff subgroup.mem_carrier subgroupE(3))
+  from a_def have aJ: "a \<in> J" by blast
+  then have a_inv_J: "inv a \<in> J \<and> inv a \<noteq> \<one>" using assms(2)
+    by (meson a_def inv_eq_1_iff subgroup.mem_carrier subgroupE(3))
+  from a_def have a_c: "a \<in> carrier G" using subgroup.subset[of J G] assms(2) by blast
+
+  from set_mult_card_eq_impl_empty_inter'[of H J]
+  have empty: "\<And>a b. \<lbrakk>a \<in> H; b \<in> H; a \<noteq> b\<rbrakk> \<Longrightarrow> (l_coset G a J) \<inter> (l_coset G b J) = {}"
+    using assms subgroup.subset[of _ G] by simp
+
+  have "\<one> \<in> \<one> <# J" using \<open>\<one> \<in> J\<close> unfolding l_coset_def by force
+  moreover have "\<one> \<in> a <# J" using a_inv_J aJ a_c assms \<open>\<one> \<in> J\<close> coset_join3 by blast
+  ultimately have "(l_coset G \<one> J) \<inter> (l_coset G a J) \<noteq> {}" by blast
+
+  then show "False" using empty[of "\<one>" a] a_def aH \<open>\<one> \<in> H\<close> by blast
+qed
+
+lemma (in comm_group) finite_sub_comp_imp_card_eq_mult:
+  assumes "subgroup H G" "subgroup J G" "finite H" "finite J"
+  and "complementary H J"
+shows "card (H <#> J) = card J * card H"
+proof -
+  have carr: "H \<subseteq> carrier G" "J \<subseteq> carrier G" using assms subgroup.subset by auto
+
+  from coset_neq_imp_empty_inter[OF assms(1)] compl_imp_diff_cosets[OF assms(1,2)]
+  have em_inter: "\<And>a b. \<lbrakk>a \<in> J; b \<in> J; a \<noteq> b\<rbrakk> \<Longrightarrow> (H #> a) \<inter> (H #> b) = {}"
+    by (meson assms subgroup.mem_carrier)
+
+  have "card (\<Union>a\<in>J. (H #> a)) = card J * card H" using assms(4) carr(2) em_inter
+  proof (induction J rule: finite_induct)
+    case empty
+    then show ?case by auto
+  next
+    case i: (insert x F)
+    then have cF:"card (\<Union> ((#>) H ` F)) = card F * card H" by blast
+    have xc[simp]: "x \<in> carrier G" using i(4) by simp
+    let ?J = "insert x F"
+    from i(2, 4, 5) have em:"(H #> x) \<inter> (\<Union>y\<in>F. (H #> y)) = {}" by auto
+    have "finite (H #> x)"
+      by (meson carr(1) rcosetsI rcosets_finite assms(3) xc)
+    moreover have "finite (H <#> F)" using set_mult_finite[OF assms(3) i(1) carr(1)] i(4) by blast
+    moreover have "H <#> F = (\<Union>a\<in>F. (H #> a))"
+      unfolding set_mult_def using r_coset_def[of G H] by auto
+    ultimately have "card(H #> x) + card(\<Union>y\<in>F. (H #> y))
+                   = card((H #> x) \<union> (\<Union>y\<in>F. (H #> y))) + card((H #> x) \<inter> (\<Union>y\<in>F. (H #> y)))"
+      using card_Un_Int by auto
+    then have "card(H #> x) + card(\<Union>y\<in>F. (H #> y)) = card((H #> x) \<union> (\<Union>y\<in>F. (H #> y)))"
+      using i(5) em by simp
+    moreover have "card (H #> x) = card H"
+      using card_rcosets_equal[of _ H] rcosetsI[of H] carr(1) xc by metis
+    moreover have "card (insert x F) * card H = card F * card H + card H"
+      by (simp add: i)
+    ultimately show ?case using cF by simp
+  qed
+  moreover have "H <#> J = (\<Union>a\<in>J. (H #> a))"
+    unfolding set_mult_def using r_coset_def[of G H] by auto
+  ultimately show "card (H <#> J) = card J * card H" by argo
+qed
+
+lemma (in comm_group) finite_sub_comp_iff_card_eq_mult:
+  assumes "subgroup H G" "subgroup J G" "finite H" "finite J"
+  shows "card (H <#> J) = card J * card H  \<longleftrightarrow> complementary H J"
+  using finite_sub_comp_imp_card_eq_mult[OF assms] finite_sub_card_eq_mult_imp_comp[OF assms]
+  by blast
+
+subsection \<open>\<open>IDirProd\<close> - binary internal direct product\<close>
+
+text \<open>We introduce the internal direct product formed by two subgroups (so in its binary form).\<close>
+
+definition IDirProd :: "('a, 'b) monoid_scheme \<Rightarrow> 'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" where
+  "IDirProd G Y Z = generate G (Y \<union> Z)"
+
+text \<open>Some trivial lemmas about the binary internal direct product.\<close>
+
+lemma (in group) IDirProd_comm:
+  "IDirProd G A B = IDirProd G B A"
+  unfolding IDirProd_def by (simp add: sup_commute)
+
+lemma (in group) IDirProd_empty_right:
+  assumes "A \<subseteq> carrier G"
+  shows "IDirProd G A {} = generate G A"
+  unfolding IDirProd_def by simp
+
+lemma (in group) IDirProd_empty_left:
+  assumes "A \<subseteq> carrier G"
+  shows "IDirProd G {} A = generate G A"
+  unfolding IDirProd_def by simp
+
+lemma (in group) IDirProd_one_right:
+  assumes "A \<subseteq> carrier G"
+  shows "IDirProd G A {\<one>} = generate G A"
+  unfolding IDirProd_def
+proof
+  interpret sA: subgroup "(generate G A)" G using assms generate_is_subgroup by simp
+  interpret sAone: subgroup "(generate G (A \<union> {\<one>}))" G using assms generate_is_subgroup by simp
+  show "generate G (A \<union> {\<one>}) \<subseteq> generate G A"
+    using generate_subgroup_incl[of "A \<union> {\<one>}" "generate G A"]
+          generate.incl assms sA.one_closed sA.subgroup_axioms by fast
+  show "generate G A \<subseteq> generate G (A \<union> {\<one>})"
+    using mono_generate[of A "A \<union> {\<one>}"] by blast
+qed
+
+lemma (in group) IDirProd_one_left:
+  assumes "A \<subseteq> carrier G"
+  shows "IDirProd G {\<one>} A = generate G A"
+  using IDirProd_one_right[of A] assms unfolding IDirProd_def by force
+
+lemma (in group) IDirProd_is_subgroup:
+  assumes "Y \<subseteq> carrier G" "Z \<subseteq> carrier G"
+  shows "subgroup (IDirProd G Y Z) G"
+  unfolding IDirProd_def using generate_is_subgroup[of "Y \<union> Z"] assms by simp
+
+
+text \<open>Using the theory about set multiplication we can also show the connection of the underlying
+set in the internal direct product with the set multiplication in the case of an abelian group.
+Together with the facts about complementarity and the set multiplication we can characterize
+complementarity by the cardinality of the internal direct product and vice versa.\<close>
+
+lemma (in comm_group) IDirProd_eq_subgroup_mult:
+  assumes "subgroup H G" "subgroup J G"
+  shows "IDirProd G H J = H <#> J"
+  unfolding IDirProd_def
+  by (rule set_mult_eq_generate_subgroup[OF assms])
+
+lemma (in comm_group) finite_sub_comp_iff_card_eq_IDirProd:
+  assumes "subgroup H G" "subgroup J G" "finite H" "finite J"
+  shows "card (IDirProd G H J) = card J * card H  \<longleftrightarrow> complementary H J"
+  using finite_sub_comp_iff_card_eq_mult IDirProd_eq_subgroup_mult assms by presburger
+
+subsection \<open>\<open>IDirProds\<close> - indexed internal direct product\<close>
+
+text \<open>The indexed version of the internal direct product acting on a family of subgroups.\<close>
+
+definition IDirProds :: "('a, 'b) monoid_scheme \<Rightarrow> ('c \<Rightarrow> 'a set) \<Rightarrow> 'c set \<Rightarrow> 'a set" where
+  "IDirProds G S I = generate G (\<Union>(S ` I))"
+
+text \<open>Lemmas about the indexed internal direct product.\<close>
+
+lemma (in group) IDirProds_incl:
+  assumes "i \<in> I"
+  shows "S i \<subseteq> IDirProds G S I"
+  unfolding IDirProds_def using assms generate.incl[of _ "\<Union>(S ` I)" G] by blast
+
+lemma (in group) IDirProds_empty:
+  "IDirProds G S {} = {\<one>}"
+  unfolding IDirProds_def using generate_empty by simp
+
+lemma (in group) IDirProds_is_subgroup:
+  assumes "\<Union>(S ` I) \<subseteq> (carrier G)"
+  shows "subgroup (IDirProds G S I) G"
+  unfolding IDirProds_def using generate_is_subgroup[of "\<Union>(S ` I)"] assms by auto
+
+lemma (in group) IDirProds_subgroup_id: "subgroup (S i) G \<Longrightarrow> IDirProds G S {i} = S i"
+  by (simp add: generate_subgroup_id IDirProds_def)
+
+lemma (in comm_group) IDirProds_Un:
+  assumes "\<forall>i\<in>A. subgroup (S i) G" "\<forall>j\<in>B. subgroup (S j) G"
+  shows   "IDirProds G S (A \<union> B) = IDirProds G S A <#> IDirProds G S B"
+proof -
+  have subset: "\<Union> (S ` A) \<subseteq> carrier G" "\<Union> (S ` B) \<subseteq> carrier G"
+    using subgroup.subset assms(1, 2) by blast+
+  have "IDirProds G S A <#> IDirProds G S B = IDirProd G (IDirProds G S A) (IDirProds G S B)"
+    using assms by (intro IDirProd_eq_subgroup_mult [symmetric] IDirProds_is_subgroup subset)
+  also have "\<dots> = generate G (\<Union> (S ` A) \<union> IDirProds G S B)"
+    unfolding IDirProds_def IDirProd_def by (intro generate_idem' generate_incl subset)
+  also have "\<dots> = generate G (\<Union>(S ` A) \<union> \<Union>(S ` B))"
+    unfolding IDirProds_def IDirProd_def
+    by (intro generate_idem'_right generate_incl subset)
+  also have "\<Union>(S ` A) \<union> \<Union>(S ` B) = \<Union>(S ` (A \<union> B))"
+    by blast
+  also have "generate G \<dots> = IDirProds G S (A \<union> B)"
+    unfolding IDirProds_def ..
+  finally show ?thesis ..
+qed
+
+lemma (in comm_group) IDirProds_finite:
+  assumes "finite I" "\<forall>i\<in>I. subgroup (S i) G" "\<forall>i\<in>I. finite (S i)"
+  shows "finite (IDirProds G S I)" using assms
+proof (induction I rule: finite_induct)
+  case empty
+  thus ?case using IDirProds_empty[of S] by simp
+next
+  case i: (insert x I)
+  interpret Sx: subgroup "S x" G using i by blast
+  have cx: "(S x) \<subseteq> carrier G" by force
+  have cI: "\<Union>(S ` I) \<subseteq> carrier G" using i subgroup.subset by blast
+  interpret subgroup "IDirProds G S I" G using IDirProds_is_subgroup[OF cI] .
+  have cIP: "(IDirProds G S I) \<subseteq> carrier G" by force
+  from i have f: "finite (S x)" "finite (IDirProds G S I)" "finite {x}" by blast+
+  from IDirProds_Un[of "{x}" S I]
+  have "IDirProds G S ({x} \<union> I) = IDirProds G S {x} <#> IDirProds G S I" using i by blast
+  also have "\<dots> = S x <#> IDirProds G S I"
+    using IDirProds_subgroup_id[of S x] Sx.subgroup_axioms by force
+  also have "finite (\<dots>)" using set_mult_finite[OF f(1, 2) cx cIP] .
+  finally show ?case unfolding insert_def by simp
+qed
+
+lemma (in comm_group) IDirProds_compl_imp_compl:
+  assumes "\<forall>i \<in> I. subgroup (S i) G" and "subgroup H G"
+  assumes "complementary H (IDirProds G S I)" "i \<in> I"
+  shows   "complementary H (S i)"
+proof -
+  have "S i \<subseteq> IDirProds G S I" using assms IDirProds_incl by fast
+  then have "H \<inter> (S i) \<subseteq> H \<inter> IDirProds G S I" by blast
+  moreover have "\<one> \<in> H \<inter> (S i)" using subgroup.one_closed assms by auto
+  ultimately show "complementary H (S i)" using assms(3) unfolding complementary_def by blast
+qed
+
+text \<open>Using the knowledge about the binary internal direct product, we can - in case that all
+subgroups in the family have coprime orders - also derive the cardinality of the indexed internal
+direct product.\<close>
+
+lemma (in comm_group) IDirProds_card:
+  assumes "finite I" "\<forall>i\<in>I. subgroup (S i) G"
+          "\<forall>i\<in>I. finite (S i)" "pairwise (\<lambda>x y. coprime (card (S x)) (card (S y))) I"
+  shows "card (IDirProds G S I) = (\<Prod>i \<in> I. card (S i))" using assms
+proof (induction I rule: finite_induct)
+  case empty
+  then show ?case using IDirProds_empty[of S] by simp
+next
+  case i: (insert x I)
+  have sx: "subgroup (S x) G" using i(4) by blast
+  have cx: "(S x) \<subseteq> carrier G" using subgroup.subset[OF sx] .
+  have fx: "finite (S x)" using i by blast
+  have cI: "\<Union>(S ` I) \<subseteq> carrier G" using subgroup.subset[of _ G] i(4) by blast
+  from generate_is_subgroup[OF this] have sIP: "subgroup (IDirProds G S I) G"
+    unfolding IDirProds_def .
+  then have cIP: "(IDirProds G S I) \<subseteq> carrier G" using subgroup.subset by blast
+  have fIP: "finite (IDirProds G S I)" using IDirProds_finite[OF i(1)] i by blast
+
+  from i have ih: "card (IDirProds G S I) = (\<Prod>i\<in>I. card (S i))" unfolding pairwise_def by blast
+  hence cop: "coprime (card (IDirProds G S I)) (card (S x))"
+  proof -
+    have cFI0: "card (IDirProds G S I) \<noteq> 0" using finite_subgroup_card_neq_0[OF sIP fIP] .
+    moreover have cx0: "card (S x) \<noteq> 0" using finite_subgroup_card_neq_0[OF sx fx] .
+    moreover have  "prime_factors (card (IDirProds G S I)) \<inter> prime_factors (card (S x)) = {}"
+    proof (rule ccontr)
+      have n0: "\<And>i. i \<in> I \<Longrightarrow> card (S i) \<noteq> 0" using finite_subgroup_card_neq_0 i(4, 5) by blast
+      assume "prime_factors (card (IDirProds G S I)) \<inter> prime_factors (card (S x)) \<noteq> {}"
+      moreover have "prime_factors (card (IDirProds G S I)) = \<Union>(prime_factors ` (card \<circ> S) ` I)"
+        using n0 prime_factors_Prod[OF i(1), of "card \<circ> S"] by (subst ih; simp)
+      moreover have "\<And>i. i \<in> I \<Longrightarrow> prime_factors (card (S i)) \<inter> prime_factors (card (S x)) = {}"
+      proof -
+        fix i
+        assume ind: "i \<in> I"
+        then have coPx: "coprime (card (S i)) (card (S x))"
+          using i(2, 6) unfolding pairwise_def by auto
+        have "card (S i) \<noteq> 0" using n0 ind by blast
+        from coprime_eq_empty_prime_inter[OF this cx0]
+        show "prime_factors (card (S i)) \<inter> prime_factors (card (S x)) = {}" using coPx by blast
+      qed
+      ultimately show "False" by auto
+    qed
+    ultimately show ?thesis using coprime_eq_empty_prime_inter by blast
+  qed
+  have "card (IDirProds G S (insert x I)) = card (S x) * card (IDirProds G S I)"
+  proof -
+    from finite_sub_comp_iff_card_eq_IDirProd[OF sIP sx fIP fx]
+         subgroups_card_coprime_imp_compl[OF sIP sx cop]
+    have "card (IDirProd G (IDirProds G S I) (S x)) = card (S x) * card (IDirProds G S I)" by blast
+    moreover have "generate G (\<Union> (S ` insert x I)) = generate G (generate G (\<Union> (S ` I)) \<union> S x)"
+      by (simp add: Un_commute cI cx generate_idem'_right)
+    ultimately show ?thesis unfolding IDirProds_def IDirProd_def by argo
+  qed
+  also have "\<dots> = card (S x) * prod (card \<circ> S) I" using ih by simp
+  also have "\<dots> = prod (card \<circ> S) ({x} \<union> I)" using i.hyps by auto
+  finally show ?case by simp
+qed
+
+subsection "Complementary family of subgroups"
+
+text \<open>The notion of a complementary family is introduced. Note that the subgroups are complementary
+not only to the other subgroups but to the product of the other subgroups.\<close>
+
+definition (in group) compl_fam :: "('c \<Rightarrow> 'a set) \<Rightarrow> 'c set \<Rightarrow> bool" where
+  "compl_fam S I = (\<forall>i \<in> I. complementary (S i) (IDirProds G S (I - {i})))"
+
+text \<open>Some lemmas about \<open>compl_fam\<close>.\<close>
+
+lemma (in group) compl_fam_empty[simp]: "compl_fam S {}"
+  unfolding compl_fam_def by simp
+
+lemma (in group) compl_fam_cong:
+  assumes "compl_fam (f \<circ> g) A" "inj_on g A"
+  shows "compl_fam f (g ` A)"
+proof -
+  have "((f \<circ> g) ` (A - {i})) =  (f ` (g ` A - {g i}))" if "i \<in> A" for i
+    using assms that unfolding inj_on_def comp_def by blast
+  thus ?thesis using assms unfolding compl_fam_def IDirProds_def complementary_def by simp
+qed
+
+text \<open>We now connect \<open>compl_fam\<close> with \<open>generate\<close> as this will be its main application.\<close>
+
+lemma (in comm_group) compl_fam_imp_generate_inj:
+  assumes "gs \<subseteq> carrier G" "compl_fam (\<lambda>g. generate G {g}) gs"
+  shows "inj_on (\<lambda>g. generate G {g}) gs"
+proof(rule, rule ccontr)
+  fix x y
+  assume xy: "x \<in> gs" "y \<in> gs" "x \<noteq> y"
+  have gen: "generate G (\<Union>g\<in>gs - {y}. generate G {g}) = generate G (gs - {y})"
+    by (intro generate_idem_Un, use assms in blast)
+  assume g: "generate G {x} = generate G {y}"
+  with xy have "generate G {y} \<subseteq> generate G (gs - {y})" using mono_generate[of "{x}" "gs - {y}"] by auto
+  with xy have gyo: "generate G {y} = {\<one>}" using assms(2) generate.one gen
+    unfolding compl_fam_def complementary_def IDirProds_def by blast
+  hence yo: "y = \<one>" using generate_singleton_one by simp
+  from gyo g generate_singleton_one have xo: "x = \<one>" by simp
+  from xy yo xo show False by blast
+qed  
+
+lemma (in comm_group) compl_fam_generate_subset:
+  assumes "compl_fam (\<lambda>g. generate G {g}) gs"
+          "gs \<subseteq> carrier G" "A \<subseteq> gs"
+  shows "compl_fam (\<lambda>g. generate G {g}) A"
+proof(unfold compl_fam_def complementary_def IDirProds_def, subst generate_idem_Un)
+  show "\<And>i. A - {i} \<subseteq> carrier G" using assms by blast
+  have "generate G {i} \<inter> generate G (A - {i}) = {\<one>}" if "i \<in> A" for i
+  proof -
+    have "\<one> \<in> generate G {i} \<inter> generate G (A - {i})" using generate.one by blast
+    moreover have "generate G (A - {i}) \<subseteq> generate G (gs - {i})"
+      by (intro mono_generate, use assms in fast)
+    moreover have "generate G {i} \<inter> generate G (gs - {i}) = {\<one>}"
+      using assms that generate_idem_Un[of "gs - {i}"]
+      unfolding compl_fam_def IDirProds_def complementary_def by blast
+    ultimately show ?thesis by blast
+  qed
+  thus "\<forall>i\<in>A. generate G {i} \<inter> generate G (A - {i}) = {\<one>}" by auto
+qed
+
+subsection \<open>\<open>is_idirprod\<close>\<close>
+
+text \<open>In order to identify a group as the internal direct product of a family of subgroups, they all
+have to be normal subgroups, complementary to the product of the rest of the subgroups and generate
+all of the group - this is captured in the definition of \<open>is_idirprod\<close>.\<close>
+
+definition (in group) is_idirprod :: "'a set \<Rightarrow> ('c \<Rightarrow> 'a set) \<Rightarrow> 'c set \<Rightarrow> bool" where
+  "is_idirprod A S I = ((\<forall>i \<in> I. S i \<lhd> G) \<and> A = IDirProds G S I \<and> compl_fam S I)"
+
+text \<open>Very basic lemmas about \<open>is_idirprod\<close>.\<close>
+
+lemma (in comm_group) is_idirprod_subgroup_suffices:
+  assumes "A = IDirProds G S I" "\<forall>i\<in>I. subgroup (S i) G" "compl_fam S I"
+  shows "is_idirprod A S I"
+  unfolding is_idirprod_def using assms subgroup_imp_normal by blast
+
+lemma (in comm_group) is_idirprod_generate:
+  assumes "A = generate G gs" "gs \<subseteq> carrier G" "compl_fam (\<lambda>g. generate G {g}) gs"
+  shows "is_idirprod A (\<lambda>g. generate G {g}) gs"
+proof(intro is_idirprod_subgroup_suffices)
+  show "A = IDirProds G (\<lambda>g. generate G {g}) gs"
+    using assms generate_idem_Un[OF assms(2)] unfolding IDirProds_def by argo
+  show "\<forall>i\<in>gs. subgroup (generate G {i}) G" using assms generate_is_subgroup by auto
+  show "compl_fam (\<lambda>g. generate G {g}) gs" by fact
+qed
+
+lemma (in comm_group) is_idirprod_imp_compl_fam[simp]:
+  assumes "is_idirprod A S I"
+  shows "compl_fam S I"
+  using assms unfolding is_idirprod_def by blast
+
+lemma (in comm_group) is_idirprod_generate_imp_generate[simp]:
+  assumes "is_idirprod A (\<lambda>g. generate G {g}) gs"
+  shows "A = generate G gs"
+proof -
+  have "gs \<subseteq> carrier G"
+  proof
+    show "g \<in> carrier G" if "g \<in> gs" for g
+    proof -
+      interpret g: subgroup "generate G {g}" G
+        using assms that normal_imp_subgroup unfolding is_idirprod_def by blast
+      show ?thesis using g.subset generate.incl by fast
+    qed
+  qed
+  thus ?thesis using assms generate_idem_Un unfolding is_idirprod_def IDirProds_def by presburger
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/Miscellaneous_Groups.thy b/thys/Finitely_Generated_Abelian_Groups/Miscellaneous_Groups.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Miscellaneous_Groups.thy
@@ -0,0 +1,239 @@
+(*
+    File:     Miscellaneous_Groups.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Miscellaneous group facts\<close>
+
+theory Miscellaneous_Groups
+  imports Set_Multiplication
+begin
+
+text \<open>As the name suggests, this section contains several smaller lemmas about groups.\<close>
+
+(* Manuel Eberl *)
+lemma (in subgroup) nat_pow_closed [simp,intro]: "a \<in> H \<Longrightarrow> pow G a (n::nat) \<in> H"
+  by (induction n) (auto simp: nat_pow_def)
+
+(* Manuel Eberl *)
+lemma nat_pow_modify_carrier: "a [^]\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> b = a [^]\<^bsub>G\<^esub> (b::nat)"
+  by (simp add: nat_pow_def)
+
+lemma (in group) subgroup_card_dvd_group_ord:
+  assumes "subgroup H G"
+  shows "card H dvd order G"
+  using Coset.group.lagrange[of G H] assms group_axioms by (metis dvd_triv_right)
+
+lemma (in group) subgroup_card_eq_order:
+  assumes "subgroup H G"
+  shows "card H = order (G\<lparr>carrier := H\<rparr>)"
+  unfolding order_def by simp
+
+lemma (in group) finite_subgroup_card_neq_0:
+  assumes "subgroup H G" "finite H"
+  shows "card H \<noteq> 0"
+  using subgroup_nonempty assms by auto
+
+lemma (in group) subgroup_order_dvd_group_order:
+  assumes "subgroup H G"
+  shows "order (G\<lparr>carrier := H\<rparr>) dvd order G"
+  by (metis subgroup_card_dvd_group_ord[of H] assms subgroup_card_eq_order)
+
+lemma (in group) sub_subgroup_dvd_card:
+  assumes "subgroup H G" "subgroup J G" "J \<subseteq> H"
+  shows "card J dvd card H"
+  by (metis subgroup_incl[of J H] subgroup_card_eq_order[of H]
+            group.subgroup_card_dvd_group_ord[of "(G\<lparr>carrier := H\<rparr>)" J] assms
+            subgroup.subgroup_is_group[of H G] group_axioms)
+
+lemma (in group) inter_subgroup_dvd_card:
+  assumes "subgroup H G" "subgroup J G"
+  shows "card (H \<inter> J) dvd card H"
+  using subgroups_Inter_pair[of H J] assms sub_subgroup_dvd_card[of H "H \<inter> J"] by blast
+
+lemma (in group) subgroups_card_coprime_inter_card_one:
+  assumes "subgroup H G" "subgroup J G" "coprime (card H) (card J)"
+  shows "card (H \<inter> J) = 1"
+proof -
+  from assms inter_subgroup_dvd_card have "is_unit (card (H \<inter> J))" unfolding coprime_def
+    by (meson Int_lower2 sub_subgroup_dvd_card subgroup_Int)
+  then show ?thesis by simp
+qed
+
+lemma (in group) coset_neq_imp_empty_inter:
+  assumes "subgroup H G" "a \<in> carrier G" "b \<in> carrier G"
+  shows "H #> a \<noteq> H #> b \<Longrightarrow> (H #> a) \<inter> (H #> b) = {}"
+  by (metis Int_emptyI assms repr_independence)
+
+lemma (in comm_group) subgroup_is_comm_group:
+  assumes "subgroup H G"
+  shows "comm_group (G\<lparr>carrier := H\<rparr>)" unfolding comm_group_def
+proof
+  interpret H: subgroup H G by fact
+  interpret H: submonoid H G using H.subgroup_is_submonoid .
+  show "Group.group (G\<lparr>carrier := H\<rparr>)" by blast
+  show "comm_monoid (G\<lparr>carrier := H\<rparr>)" using submonoid_is_comm_monoid H.submonoid_axioms by blast
+qed
+
+lemma (in group) pow_int_mod_ord:
+  assumes [simp]:"a \<in> carrier G" "ord a \<noteq> 0"
+  shows "a [^] (n::int) = a [^] (n mod ord a)"
+proof -
+  obtain q r where d: "q = n div ord a" "r = n mod ord a" "n = q * ord a + r"
+    using mod_div_decomp by blast
+  hence "a [^] n = (a [^] int (ord a)) [^] q \<otimes> a [^] r"
+    using assms(1) int_pow_mult int_pow_pow
+    by (metis mult_of_nat_commute)
+  also have "\<dots> = \<one> [^] q \<otimes> a [^] r"
+    by (simp add: int_pow_int)
+  also have "\<dots> = a [^] r" by simp
+  finally show ?thesis using d(2) by blast
+qed
+
+lemma (in group) pow_nat_mod_ord:
+  assumes [simp]:"a \<in> carrier G" "ord a \<noteq> 0"
+  shows "a [^] (n::nat) = a [^] (n mod ord a)"
+proof -
+  obtain q r where d: "q = n div ord a" "r = n mod ord a" "n = q * ord a + r"
+    using mod_div_decomp by blast
+  hence "a [^] n = (a [^] ord a) [^] q \<otimes> a [^] r"
+    using assms(1) nat_pow_mult nat_pow_pow by presburger
+  also have "\<dots> = \<one> [^] q \<otimes> a [^] r" by auto
+  also have "\<dots> = a [^] r" by simp
+  finally show ?thesis using d(2) by blast
+qed
+
+lemma (in group) ord_min:
+  assumes "m \<ge> 1" "x \<in> carrier G" "x [^] m = \<one>"
+  shows   "ord x \<le> m"
+  using assms pow_eq_id by auto
+
+(* Manuel Eberl *)
+lemma (in group) bij_betw_mult_left[intro]:
+  assumes [simp]: "x \<in> carrier G"
+  shows "bij_betw (\<lambda>y. x \<otimes> y) (carrier G) (carrier G)"
+  by (intro bij_betwI[where ?g = "\<lambda>y. inv x \<otimes> y"])
+     (auto simp: m_assoc [symmetric])
+
+(* Manuel Eberl *)
+lemma (in subgroup) inv_in_iff:
+  assumes "x \<in> carrier G" "group G"
+  shows   "inv x \<in> H \<longleftrightarrow> x \<in> H"
+proof safe
+  assume "inv x \<in> H"
+  hence "inv (inv x) \<in> H" by blast
+  also have "inv (inv x) = x"
+    by (intro group.inv_inv) (use assms in auto)
+  finally show "x \<in> H" .
+qed auto
+
+(* Manuel Eberl *)
+lemma (in subgroup) mult_in_cancel_left:
+  assumes "y \<in> carrier G" "x \<in> H" "group G"
+  shows   "x \<otimes> y \<in> H \<longleftrightarrow> y \<in> H"
+proof safe
+  assume "x \<otimes> y \<in> H"
+  hence "inv x \<otimes> (x \<otimes> y) \<in> H"
+    using assms by blast
+  also have "inv x \<otimes> (x \<otimes> y) = y"
+    using assms by (simp add: \<open>x \<otimes> y \<in> H\<close> group.inv_solve_left')
+  finally show "y \<in> H" .
+qed (use assms in auto)
+
+(* Manuel Eberl *)
+lemma (in subgroup) mult_in_cancel_right:
+  assumes "x \<in> carrier G" "y \<in> H" "group G"
+  shows   "x \<otimes> y \<in> H \<longleftrightarrow> x \<in> H"
+proof safe
+  assume "x \<otimes> y \<in> H"
+  hence "(x \<otimes> y) \<otimes> inv y \<in> H"
+    using assms by blast
+  also have "(x \<otimes> y) \<otimes> inv y = x"
+    using assms by (simp add: \<open>x \<otimes> y \<in> H\<close> group.inv_solve_right')
+  finally show "x \<in> H" .
+qed (use assms in auto)
+
+lemma (in group) (* Manuel Eberl *)
+  assumes "x \<in> carrier G" and "x [^] n = \<one>" and "n > 0"
+  shows   ord_le: "ord x \<le> n" and ord_pos: "ord x > 0"
+proof -
+  have "ord x dvd n"
+    using pow_eq_id[of x n] assms by auto
+  thus "ord x \<le> n" "ord x > 0"
+    using assms by (auto intro: dvd_imp_le)
+qed
+
+lemma (in group) ord_conv_Least: (* Manuel Eberl *)
+  assumes "x \<in> carrier G" "\<exists>n::nat > 0. x [^] n = \<one>"
+  shows   "ord x = (LEAST n::nat. 0 < n \<and> x [^] n = \<one>)"
+proof (rule antisym)
+  show "ord x \<le> (LEAST n::nat. 0 < n \<and> x [^] n = \<one>)"
+    using assms LeastI_ex[OF assms(2)] by (intro ord_le) auto
+  show "ord x \<ge> (LEAST n::nat. 0 < n \<and> x [^] n = \<one>)"
+    using assms by (intro Least_le) (auto intro: pow_ord_eq_1 ord_pos)
+qed
+
+lemma (in group) ord_conv_Gcd: (* Manuel Eberl *)
+  assumes "x \<in> carrier G"
+  shows   "ord x = Gcd {n. x [^] n = \<one>}"
+  by (rule sym, rule Gcd_eqI) (use assms in \<open>auto simp: pow_eq_id\<close>)
+
+lemma (in group) subgroup_ord_eq:
+  assumes "subgroup H G" "x \<in> H"
+  shows "group.ord (G\<lparr>carrier := H\<rparr>) x = ord x"
+  using nat_pow_consistent ord_def group.ord_def[of "(G\<lparr>carrier := H\<rparr>)" x]
+        subgroup.subgroup_is_group[of H G] assms by simp
+
+lemma (in group) ord_FactGroup:
+  assumes "subgroup P G" "group (G Mod P)"
+  shows "order (G Mod P) * card P = order G"
+  using lagrange[of P] FactGroup_def[of G P] assms order_def[of "(G Mod P)"] by fastforce
+
+lemma (in group) one_is_same:
+  assumes "subgroup H G"
+  shows "\<one>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> = \<one>"
+  by simp
+
+lemma (in group) kernel_FactGroup:
+  assumes "P \<lhd> G"
+  shows "kernel G (G Mod P) (\<lambda>x. P #> x) = P"
+proof(rule equalityI; rule subsetI)
+  fix x
+  assume "x \<in> kernel G (G Mod P) ((#>) P)"
+  then have "P #> x = \<one>\<^bsub>G Mod P\<^esub>" "x \<in> carrier G" unfolding kernel_def by simp+
+  with coset_join1[of P x] show "x \<in> P" using assms unfolding normal_def by simp
+next
+  fix x
+  assume x:"x \<in> P"
+  then have xc: "x \<in> carrier G" using assms subgroup.subset unfolding normal_def by fast
+  from x have "P #> x = P" using assms
+    by (simp add: normal_imp_subgroup subgroup.rcos_const) 
+  thus "x \<in> kernel G (G Mod P) ((#>) P)" unfolding kernel_def using xc by simp
+qed
+
+lemma (in group) sub_subgroup_coprime:
+  assumes "subgroup H G" "subgroup J G" "coprime (card H) (card J)"
+  and "subgroup sH G" "subgroup sJ G" "sH \<subseteq> H" "sJ \<subseteq> J"
+shows "coprime (card sH) (card sJ)"
+  using assms by (meson coprime_divisors sub_subgroup_dvd_card)
+
+lemma (in group) pow_eq_nat_mod:
+  assumes "a \<in> carrier G" "a [^] n = a [^] m"
+  shows "n mod (ord a) = m mod (ord a)"
+proof -
+  from assms have "a [^] (n - m) = \<one>" using pow_eq_div2 by blast
+  hence "ord a dvd n - m" using assms(1) pow_eq_id by blast
+  thus ?thesis
+    by (metis assms mod_eq_dvd_iff_nat nat_le_linear pow_eq_div2 pow_eq_id)
+qed
+
+lemma (in group) pow_eq_int_mod:
+  fixes n m::int
+  assumes "a \<in> carrier G" "a [^] n = a [^] m"
+  shows "n mod (ord a) = m mod (ord a)"
+proof -
+  from assms have "a [^] (n - m) = \<one>" using int_pow_closed int_pow_diff r_inv by presburger
+  hence "ord a dvd n - m" using assms(1) int_pow_eq_id by blast
+  thus ?thesis by (meson mod_eq_dvd_iff)
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/ROOT b/thys/Finitely_Generated_Abelian_Groups/ROOT
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/ROOT
@@ -0,0 +1,8 @@
+chapter AFP
+session "Finitely_Generated_Abelian_Groups" (AFP) = "HOL-Algebra" +
+  options [timeout = 600]
+  theories
+    Finitely_Generated_Abelian_Groups
+  document_files
+    "root.bib"
+    "root.tex"
diff --git a/thys/Finitely_Generated_Abelian_Groups/Set_Multiplication.thy b/thys/Finitely_Generated_Abelian_Groups/Set_Multiplication.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/Set_Multiplication.thy
@@ -0,0 +1,203 @@
+(*
+    File:     Set_Multiplication.thy
+    Author:   Joseph Thommes, TU München
+*)
+section \<open>Set Multiplication\<close>
+
+theory Set_Multiplication
+  imports "HOL-Algebra.Algebra"
+begin
+
+text \<open>This theory/section is of auxiliary nature and is mainly used to establish a connection
+between the set multiplication and the multiplication of subgroups via the \<open>IDirProd\<close> (although this
+particular notion is introduced later). However, as in every section of this entry, there are some
+lemmas that do not have any further usage in this entry, but are of interest just by themselves.\<close>
+
+lemma (in group) set_mult_union:
+  "A <#> (B \<union> C) = (A <#> B) \<union> (A <#> C)"
+  unfolding set_mult_def by auto
+
+lemma (in group) set_mult_card_single_el_eq:
+  assumes "J \<subseteq> carrier G" "x \<in> carrier G"
+  shows "card (l_coset G x J) = card J" unfolding l_coset_def
+proof -
+  have "card ((\<otimes>) x ` J) = card J"
+    using inj_on_cmult[of x] card_image[of "(\<otimes>) x" J] assms inj_on_subset[of "(\<otimes>) x" "carrier G" J]
+    by blast
+  moreover have "(\<Union>y\<in>J. {x \<otimes> y}) = (\<otimes>) x ` J" using image_def[of "(\<otimes>) x" J] by blast
+  ultimately show "card (\<Union>h\<in>J. {x \<otimes> h}) = card J" by presburger
+qed
+
+text \<open>We find an upper bound for the cardinality of a set product.\<close>
+
+lemma (in group) set_mult_card_le:
+  assumes "finite H" "H \<subseteq> carrier G" "J \<subseteq> carrier G"
+  shows "card (H <#> J) \<le> card H * card J"
+  using assms
+proof (induction "card H" arbitrary: H)
+  case 0
+  then have "H = {}" by force
+  then show ?case using set_mult_def[of G H J] by simp
+next
+  case (Suc n)
+  then obtain a where a_def: "a \<in> H" by fastforce
+  then have c_n: "card (H - {a}) = n" using Suc by force
+  then have "card ((H - {a}) <#> J) \<le> card (H - {a}) * card J" using Suc by blast
+  moreover have "card ({a} <#> J) = card J"
+    using Suc(4, 5) a_def set_mult_card_single_el_eq[of J a] l_coset_eq_set_mult[of G a J] by auto
+  moreover have "H <#> J = (H - {a} <#> J) \<union> ({a} <#> J)" using set_mult_def[of G _ J] a_def by auto
+  moreover have "card (H - {a}) * card J + card J = Suc n * card J" using c_n mult_Suc by presburger
+  ultimately show ?case using card_Un_le[of "H - {a} <#> J" "{a} <#> J"] c_n \<open>Suc n = card H\<close> by auto
+qed
+
+lemma (in group) set_mult_finite:
+  assumes "finite H" "finite J" "H \<subseteq> carrier G" "J \<subseteq> carrier G"
+  shows "finite (H <#> J)"
+  using assms set_mult_def[of G H J] by auto
+
+text \<open>The next lemma allows us to later to derive that two finite subgroups $J$ and $H$ are complementary
+if and only if their product has the cardinality $|J| \cdot |H|$.\<close>
+
+lemma (in group) set_mult_card_eq_impl_empty_inter:
+  assumes "finite H" "finite J" "H \<subseteq> carrier G" "J \<subseteq> carrier G" "card (H <#> J) = card H * card J"
+  shows "\<And>a b. \<lbrakk>a \<in> H; b \<in> H; a \<noteq> b\<rbrakk> \<Longrightarrow> ((\<otimes>) a ` J) \<inter> ((\<otimes>) b ` J) = {}"
+  using assms
+proof (induction H rule: finite_induct)
+  case empty
+  then show ?case by fast
+next
+  case step: (insert x H)
+  from step have x_c: "x \<in> carrier G" by simp
+  from step have H_c: "H \<subseteq> carrier G" by simp
+  from set_mult_card_single_el_eq[of J x] have card_x: "card ({x} <#> J) = card J"
+    using \<open>J \<subseteq> carrier G\<close> x_c l_coset_eq_set_mult by metis
+  moreover have ins: "(insert x H) <#> J = (H <#> J) \<union> ({x} <#> J)"
+    using set_mult_def[of G _ J] by auto
+  ultimately have "card (H <#> J) \<ge> card H * card J"
+    using card_Un_le[of "H <#> J" "{x} <#> J"] \<open>card (insert x H <#> J) = card (insert x H) * card J\<close>
+    by (simp add: step.hyps(1) step.hyps(2))
+  then have card_eq:"card (H <#> J) = card H * card J"
+    using set_mult_card_le[of H J] step H_c by linarith
+  then have ih: "\<And>a b. \<lbrakk>a \<in> H; b \<in> H; a \<noteq> b\<rbrakk> \<Longrightarrow> ((\<otimes>) a ` J) \<inter> ((\<otimes>) b ` J) = {}"
+    using step H_c by presburger
+
+  have "card (insert x H) * card J = card H * card J + card J" using \<open>x \<notin> H\<close> using step by simp
+  then have "({x} <#> J) \<inter> (H <#> J) = {}"
+    using card_eq card_x ins card_Un_Int[of "H <#> J" "{x} <#> J"] step set_mult_finite by auto
+  then have "\<And>a. a \<in> H \<Longrightarrow> (\<Union>y\<in>J. {a \<otimes> y}) \<inter> (\<Union>y\<in>J. {x \<otimes> y}) = {}" 
+    using set_mult_def[of G _ J] by blast
+  then have "\<And>a b. \<lbrakk>a \<in> (insert x H); b \<in> (insert x H); a \<noteq> b\<rbrakk> \<Longrightarrow> ((\<otimes>) a ` J) \<inter> ((\<otimes>) b ` J) = {}"
+    using \<open>x \<notin> H\<close> ih by blast
+  then show ?case using step by algebra
+qed
+
+lemma (in group) set_mult_card_eq_impl_empty_inter':
+  assumes "finite H" "finite J" "H \<subseteq> carrier G" "J \<subseteq> carrier G" "card (H <#> J) = card H * card J"
+  shows "\<And>a b. \<lbrakk>a \<in> H; b \<in> H; a \<noteq> b\<rbrakk> \<Longrightarrow> (l_coset G a J) \<inter> (l_coset G b J) = {}"
+  unfolding l_coset_def
+  using set_mult_card_eq_impl_empty_inter image_def[of "(\<otimes>) _" J] assms by blast
+
+lemma (in comm_group) set_mult_comm:
+  assumes "H \<subseteq> carrier G" "J \<subseteq> carrier G"
+  shows "(H <#> J) = (J <#> H)"
+  unfolding set_mult_def
+proof -
+  have 1: "\<And>a b. \<lbrakk>a \<in> carrier G; b \<in> carrier G\<rbrakk> \<Longrightarrow> {a \<otimes> b} = {b \<otimes> a}" using m_comm by simp
+  then have "\<And>a b.\<lbrakk>a \<in> H; b \<in> J\<rbrakk> \<Longrightarrow> {a \<otimes> b} = {b \<otimes> a}" using assms by auto
+  moreover have "\<And>a b.\<lbrakk>b \<in> H; a \<in> J\<rbrakk> \<Longrightarrow> {a \<otimes> b} = {b \<otimes> a}" using assms 1 by auto
+  ultimately show "(\<Union>h\<in>H. \<Union>k\<in>J. {h \<otimes> k}) = (\<Union>k\<in>J. \<Union>h\<in>H. {k \<otimes> h})"  by fast
+qed
+
+lemma (in group) set_mult_one_imp_inc:
+  assumes "\<one> \<in> A" "A \<subseteq> carrier G" "B \<subseteq> carrier G"
+  shows "B \<subseteq> (B <#> A)"
+proof
+  fix x
+  assume "x \<in> B"
+  thus "x \<in> (B <#> A)" using assms unfolding set_mult_def by force
+qed
+
+text \<open>In all cases, we know that the product of two sets is always contained in the subgroup
+generated by them.\<close>
+lemma (in group) set_mult_subset_generate:
+  assumes "A \<subseteq> carrier G" "B \<subseteq> carrier G"
+  shows "A <#> B \<subseteq> generate G (A \<union> B)"
+proof
+  fix x
+  assume "x \<in> A <#> B"
+  then obtain a b where ab: "a \<in> A" "b \<in> B" "x = a \<otimes> b" unfolding set_mult_def by blast
+  then have "a \<in> generate G (A \<union> B)" "b \<in> generate G (A \<union> B)"
+    using generate.incl[of _ "A \<union> B" G] by simp+
+  thus "x \<in> generate G (A \<union> B)" using ab generate.eng by metis
+qed
+
+text \<open>In the case of subgroups, the set product is just the subgroup generated by both
+of the subgroups.\<close>
+
+lemma (in comm_group) set_mult_eq_generate_subgroup:
+  assumes "subgroup H G" "subgroup J G"
+  shows "generate G (H \<union> J) = H <#> J" (is "?L = ?R")
+proof
+  show "?L \<subseteq> ?R"
+  proof
+    fix x
+    assume "x \<in> ?L"
+    then show "x \<in> ?R"
+    proof(induction rule: generate.induct)
+      case one
+      have "\<one> \<otimes> \<one> = \<one>" using nat_pow_one[of 2] by simp
+      thus ?case
+        using assms subgroup.one_closed[OF assms(1)]
+              subgroup.one_closed[OF assms(2)] set_mult_def[of G H J] by fastforce
+    next
+      case (incl x)
+      have H1: "\<one> \<in> H" using assms subgroup.one_closed by auto
+      have J1: "\<one> \<in> J" using assms subgroup.one_closed by auto
+      have lx: "x \<otimes> \<one> = x" using r_one[of x] incl subgroup.subset assms by blast
+      have rx: "\<one> \<otimes> x = x" using l_one[of x] incl subgroup.subset assms by blast
+      show ?case
+      proof (cases "x \<in> H")
+        case True
+        then show ?thesis using set_mult_def J1 lx by fastforce
+      next
+        case False
+        then show ?thesis using set_mult_def H1 rx incl by fastforce
+      qed
+    next
+      case (inv h)
+      then have inv_in:"(inv h) \<in> H \<union> J" (is "?iv \<in> H \<union> J")
+        using assms subgroup.m_inv_closed[of _ G h] by (cases "h \<in> H"; blast)
+      have H1: "\<one> \<in> H" using assms subgroup.one_closed by auto
+      have J1: "\<one> \<in> J" using assms subgroup.one_closed by auto
+      have lx: "?iv \<otimes> \<one> = ?iv" using r_one[of "?iv"] subgroup.subset inv_in assms by blast
+      have rx: "\<one> \<otimes> ?iv = ?iv" using l_one[of "?iv"] incl subgroup.subset inv_in assms by blast
+      show ?case 
+      proof (cases "?iv \<in> H")
+        case True
+        then show ?thesis using set_mult_def[of G H J] J1 lx by fastforce
+      next
+        case False
+        then show ?thesis using set_mult_def[of G H J] H1 rx inv_in by fastforce
+      qed
+    next
+      case (eng h g)
+      from eng(3) obtain a b where aH: "a \<in> H" and bJ: "b \<in> J" and h_def: "h = a \<otimes> b"
+        using set_mult_def[of G H J] by fast
+      have a_carr: "a \<in> carrier G" by (metis subgroup.mem_carrier assms(1) aH)
+      have b_carr: "b \<in> carrier G" by (metis subgroup.mem_carrier assms(2) bJ)
+      from eng(4) obtain c d where cH: "c \<in> H" and dJ: "d \<in> J" and g_def: "g = c \<otimes> d"
+        using set_mult_def[of G H J] by fast
+      have c_carr: "c \<in> carrier G" by (metis subgroup.mem_carrier assms(1) cH)
+      have d_carr: "d \<in> carrier G" by (metis subgroup.mem_carrier assms(2) dJ)
+      then have "h \<otimes> g = (a \<otimes> c) \<otimes> (b \<otimes> d)"
+        using a_carr b_carr c_carr d_carr g_def h_def m_assoc m_comm by force
+      moreover have "a \<otimes> c \<in> H" using assms(1) aH cH subgroup.m_closed by fast
+      moreover have "b \<otimes> d \<in> J" using assms(2) bJ dJ subgroup.m_closed by fast
+      ultimately show ?case using set_mult_def by fast
+    qed
+  qed
+next
+  show "?R \<subseteq> ?L" using set_mult_subset_generate[of H J] subgroup.subset assms by blast
+qed
+
+end
\ No newline at end of file
diff --git a/thys/Finitely_Generated_Abelian_Groups/document/root.bib b/thys/Finitely_Generated_Abelian_Groups/document/root.bib
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/document/root.bib
@@ -0,0 +1,7 @@
+@misc{kemper,
+  author        = {Gregor Kemper},
+  title         = {Lecture notes of Algebra},
+  month         = {04},
+  year          = {2020},
+  howpublished  = "\url{https://www.groups.ma.tum.de/fileadmin/w00ccg/algebra/people/kemper/lectureNotes/Algebra.pdf}"
+}
diff --git a/thys/Finitely_Generated_Abelian_Groups/document/root.tex b/thys/Finitely_Generated_Abelian_Groups/document/root.tex
new file mode 100644
--- /dev/null
+++ b/thys/Finitely_Generated_Abelian_Groups/document/root.tex
@@ -0,0 +1,70 @@
+\documentclass[11pt,a4paper]{article}
+\usepackage{isabelle,isabellesym}
+
+% further packages required for unusual symbols (see also
+% isabellesym.sty), use only when needed
+
+\usepackage{amsfonts, amsmath, amssymb}
+  %for \<leadsto>, \<box>, \<diamond>, \<sqsupset>, \<mho>, \<Join>,
+  %\<lhd>, \<lesssim>, \<greatersim>, \<lessapprox>, \<greaterapprox>,
+  %\<triangleq>, \<yen>, \<lozenge>
+
+%\usepackage{eurosym}
+  %for \<euro>
+
+%\usepackage[only,bigsqcap]{stmaryrd}
+  %for \<Sqinter>
+
+%\usepackage{eufrak}
+  %for \<AA> ... \<ZZ>, \<aa> ... \<zz> (also included in amssymb)
+
+%\usepackage{textcomp}
+  %for \<onequarter>, \<onehalf>, \<threequarters>, \<degree>, \<cent>,
+  %\<currency>
+
+% this should be the last package used
+\usepackage{pdfsetup}
+\usepackage[shortcuts]{extdash}
+
+% urls in roman style, theory text in math-similar italics
+\urlstyle{rm}
+\isabellestyle{rm}
+
+% for uniform font size
+%\renewcommand{\isastyle}{\isastyleminor}
+
+
+\begin{document}
+
+\title{Fundamental Theorem of Finitely Generated Abelian Groups}
+\author{Joseph Thommes, Manuel Eberl}
+\maketitle
+
+\begin{abstract}
+  This article deals with the formalisation of some group-theoretic results including the
+  fundamental theorem of finitely generated abelian groups characterising the structure
+  of these groups as a uniquely determined product of cyclic groups.
+  Both the invariant factor decomposition and the primary decomposition are covered.
+
+  Additional work includes results about the direct product, the internal direct product
+  and more group-theoretic lemmas.
+\end{abstract}
+
+\tableofcontents
+
+% sane default for proof documents
+\parindent 0pt\parskip 0.5ex
+
+% generated text of all theories
+\input{session}
+
+% optional bibliography
+\bibliographystyle{abbrv}
+\bibliography{root}
+
+\end{document}
+
+%%% Local Variables:
+%%% mode: latex
+%%% TeX-master: t
+%%% End:
diff --git a/thys/ROOTS b/thys/ROOTS
--- a/thys/ROOTS
+++ b/thys/ROOTS
@@ -1,608 +1,609 @@
 ADS_Functor
 AI_Planning_Languages_Semantics
 AODV
 AVL-Trees
 AWN
 Abortable_Linearizable_Modules
 Abs_Int_ITP2012
 Abstract-Hoare-Logics
 Abstract-Rewriting
 Abstract_Completeness
 Abstract_Soundness
 Adaptive_State_Counting
 Affine_Arithmetic
 Aggregation_Algebras
 Akra_Bazzi
 Algebraic_Numbers
 Algebraic_VCs
 Allen_Calculus
 Amicable_Numbers
 Amortized_Complexity
 AnselmGod
 Applicative_Lifting
 Approximation_Algorithms
 Architectural_Design_Patterns
 Aristotles_Assertoric_Syllogistic
 Arith_Prog_Rel_Primes
 ArrowImpossibilityGS
 Attack_Trees
 Auto2_HOL
 Auto2_Imperative_HOL
 AutoFocus-Stream
 Automated_Stateful_Protocol_Verification
 Automatic_Refinement
 AxiomaticCategoryTheory
 BDD
 BNF_CC
 BNF_Operations
 BTree
 Banach_Steinhaus
 Bell_Numbers_Spivey
 BenOr_Kozen_Reif
 Berlekamp_Zassenhaus
 Bernoulli
 Bertrands_Postulate
 Bicategory
 BinarySearchTree
 Binding_Syntax_Theory
 Binomial-Heaps
 Binomial-Queues
 BirdKMP
 Blue_Eyes
 Bondy
 Boolean_Expression_Checkers
 Bounded_Deducibility_Security
 Buchi_Complementation
 Budan_Fourier
 Buffons_Needle
 Buildings
 BytecodeLogicJmlTypes
 C2KA_DistributedSystems
 CAVA_Automata
 CAVA_LTL_Modelchecker
 CCS
 CISC-Kernel
 CRDT
 CSP_RefTK
 CYK
 CakeML
 CakeML_Codegen
 Call_Arity
 Card_Equiv_Relations
 Card_Multisets
 Card_Number_Partitions
 Card_Partitions
 Cartan_FP
 Case_Labeling
 Catalan_Numbers
 Category
 Category2
 Category3
 Cauchy
 Cayley_Hamilton
 Certification_Monads
 Chandy_Lamport
 Chord_Segments
 Circus
 Clean
 ClockSynchInst
 Closest_Pair_Points
 CofGroups
 Coinductive
 Coinductive_Languages
 Collections
 Combinatorics_Words
 Combinatorics_Words_Graph_Lemma
 Combinatorics_Words_Lyndon
 Comparison_Sort_Lower_Bound
 Compiling-Exceptions-Correctly
 Complete_Non_Orders
 Completeness
 Complex_Geometry
 Complx
 ComponentDependencies
 ConcurrentGC
 ConcurrentIMP
 Concurrent_Ref_Alg
 Concurrent_Revisions
 Consensus_Refined
 Constructive_Cryptography
 Constructive_Cryptography_CM
 Constructor_Funs
 Containers
 CoreC++
 Core_DOM
 Core_SC_DOM
 Count_Complex_Roots
 CryptHOL
 CryptoBasedCompositionalProperties
 DFS_Framework
 DOM_Components
 DPT-SAT-Solver
 DataRefinementIBP
 Datatype_Order_Generator
 Decl_Sem_Fun_PL
 Decreasing-Diagrams
 Decreasing-Diagrams-II
 Deep_Learning
 Delta_System_Lemma
 Density_Compiler
 Dependent_SIFUM_Refinement
 Dependent_SIFUM_Type_Systems
 Depth-First-Search
 Derangements
 Deriving
 Descartes_Sign_Rule
 Dict_Construction
 Differential_Dynamic_Logic
 Differential_Game_Logic
 Dijkstra_Shortest_Path
 Diophantine_Eqns_Lin_Hom
 Dirichlet_L
 Dirichlet_Series
 DiscretePricing
 Discrete_Summation
 DiskPaxos
 DynamicArchitectures
 Dynamic_Tables
 E_Transcendental
 Echelon_Form
 EdmondsKarp_Maxflow
 Efficient-Mergesort
 Elliptic_Curves_Group_Law
 Encodability_Process_Calculi
 Epistemic_Logic
 Ergodic_Theory
 Error_Function
 Euler_MacLaurin
 Euler_Partition
 Example-Submission
 Extended_Finite_State_Machine_Inference
 Extended_Finite_State_Machines
 FFT
 FLP
 FOL-Fitting
 FOL_Harrison
 FOL_Seq_Calc1
 Factored_Transition_System_Bounding
 Falling_Factorial_Sum
 Farkas
 FeatherweightJava
 Featherweight_OCL
 Fermat3_4
 FileRefinement
 FinFun
 Finger-Trees
 Finite-Map-Extras
 Finite_Automata_HF
+Finitely_Generated_Abelian_Groups
 First_Order_Terms
 First_Welfare_Theorem
 Fishburn_Impossibility
 Fisher_Yates
 Flow_Networks
 Floyd_Warshall
 Flyspeck-Tame
 FocusStreamsCaseStudies
 Forcing
 Formal_Puiseux_Series
 Formal_SSA
 Formula_Derivatives
 Fourier
 Free-Boolean-Algebra
 Free-Groups
 FunWithFunctions
 FunWithTilings
 Functional-Automata
 Functional_Ordered_Resolution_Prover
 Furstenberg_Topology
 GPU_Kernel_PL
 Gabow_SCC
 GaleStewart_Games
 Game_Based_Crypto
 Gauss-Jordan-Elim-Fun
 Gauss_Jordan
 Gauss_Sums
 Gaussian_Integers
 GenClock
 General-Triangle
 Generalized_Counting_Sort
 Generic_Deriving
 Generic_Join
 GewirthPGCProof
 Girth_Chromatic
 GoedelGod
 Goedel_HFSet_Semantic
 Goedel_HFSet_Semanticless
 Goedel_Incompleteness
 Goodstein_Lambda
 GraphMarkingIBP
 Graph_Saturation
 Graph_Theory
 Green
 Groebner_Bases
 Groebner_Macaulay
 Gromov_Hyperbolicity
 Grothendieck_Schemes
 Group-Ring-Module
 HOL-CSP
 HOLCF-Prelude
 HRB-Slicing
 Heard_Of
 Hello_World
 HereditarilyFinite
 Hermite
 Hermite_Lindemann
 Hidden_Markov_Models
 Higher_Order_Terms
 Hoare_Time
 Hood_Melville_Queue
 HotelKeyCards
 Huffman
 Hybrid_Logic
 Hybrid_Multi_Lane_Spatial_Logic
 Hybrid_Systems_VCs
 HyperCTL
 IEEE_Floating_Point
 IFC_Tracking
 IMAP-CRDT
 IMO2019
 IMP2
 IMP2_Binary_Heap
 IMP_Compiler
 IP_Addresses
 Imperative_Insertion_Sort
 Impossible_Geometry
 Incompleteness
 Incredible_Proof_Machine
 Inductive_Confidentiality
 Inductive_Inference
 InfPathElimination
 InformationFlowSlicing
 InformationFlowSlicing_Inter
 Integration
 Interpreter_Optimizations
 Interval_Arithmetic_Word32
 Iptables_Semantics
 Irrational_Series_Erdos_Straus
 Irrationality_J_Hancl
 IsaGeoCoq
 Isabelle_C
 Isabelle_Marries_Dirac
 Isabelle_Meta_Model
 Jacobson_Basic_Algebra
 Jinja
 JinjaDCI
 JinjaThreads
 JiveDataStoreModel
 Jordan_Hoelder
 Jordan_Normal_Form
 KAD
 KAT_and_DRA
 KBPs
 KD_Tree
 Key_Agreement_Strong_Adversaries
 Kleene_Algebra
 Knot_Theory
 Knuth_Bendix_Order
 Knuth_Morris_Pratt
 Koenigsberg_Friendship
 Kruskal
 Kuratowski_Closure_Complement
 LLL_Basis_Reduction
 LLL_Factorization
 LOFT
 LTL
 LTL_Master_Theorem
 LTL_Normal_Form
 LTL_to_DRA
 LTL_to_GBA
 Lam-ml-Normalization
 LambdaAuth
 LambdaMu
 Lambda_Free_EPO
 Lambda_Free_KBOs
 Lambda_Free_RPOs
 Lambert_W
 Landau_Symbols
 Laplace_Transform
 Latin_Square
 LatticeProperties
 Launchbury
 Laws_of_Large_Numbers
 Lazy-Lists-II
 Lazy_Case
 Lehmer
 Lifting_Definition_Option
 Lifting_the_Exponent
 LightweightJava
 LinearQuantifierElim
 Linear_Inequalities
 Linear_Programming
 Linear_Recurrences
 Liouville_Numbers
 List-Index
 List-Infinite
 List_Interleaving
 List_Inversions
 List_Update
 LocalLexing
 Localization_Ring
 Locally-Nameless-Sigma
 Lowe_Ontological_Argument
 Lower_Semicontinuous
 Lp
 Lucas_Theorem
 MFMC_Countable
 MFODL_Monitor_Optimized
 MFOTL_Monitor
 MSO_Regex_Equivalence
 Markov_Models
 Marriage
 Mason_Stothers
 Matrices_for_ODEs
 Matrix
 Matrix_Tensor
 Matroids
 Max-Card-Matching
 Median_Of_Medians_Selection
 Menger
 Mereology
 Mersenne_Primes
 Metalogic_ProofChecker
 MiniML
 MiniSail
 Minimal_SSA
 Minkowskis_Theorem
 Minsky_Machines
 Modal_Logics_for_NTS
 Modular_Assembly_Kit_Security
 Modular_arithmetic_LLL_and_HNF_algorithms
 Monad_Memo_DP
 Monad_Normalisation
 MonoBoolTranAlgebra
 MonoidalCategory
 Monomorphic_Monad
 MuchAdoAboutTwo
 Multi_Party_Computation
 Multirelations
 Myhill-Nerode
 Name_Carrying_Type_Inference
 Nash_Williams
 Nat-Interval-Logic
 Native_Word
 Nested_Multisets_Ordinals
 Network_Security_Policy_Verification
 Neumann_Morgenstern_Utility
 No_FTL_observers
 Nominal2
 Noninterference_CSP
 Noninterference_Concurrent_Composition
 Noninterference_Generic_Unwinding
 Noninterference_Inductive_Unwinding
 Noninterference_Ipurge_Unwinding
 Noninterference_Sequential_Composition
 NormByEval
 Nullstellensatz
 Octonions
 OpSets
 Open_Induction
 Optics
 Optimal_BST
 Orbit_Stabiliser
 Order_Lattice_Props
 Ordered_Resolution_Prover
 Ordinal
 Ordinal_Partitions
 Ordinals_and_Cardinals
 Ordinary_Differential_Equations
 PAC_Checker
 PCF
 PLM
 POPLmark-deBruijn
 PSemigroupsConvolution
 Padic_Ints
 Pairing_Heap
 Paraconsistency
 Parity_Game
 Partial_Function_MR
 Partial_Order_Reduction
 Password_Authentication_Protocol
 Pell
 Perfect-Number-Thm
 Perron_Frobenius
 Physical_Quantities
 Pi_Calculus
 Pi_Transcendental
 Planarity_Certificates
 Poincare_Bendixson
 Poincare_Disc
 Polynomial_Factorization
 Polynomial_Interpolation
 Polynomials
 Pop_Refinement
 Posix-Lexing
 Possibilistic_Noninterference
 Power_Sum_Polynomials
 Pratt_Certificate
 Presburger-Automata
 Prim_Dijkstra_Simple
 Prime_Distribution_Elementary
 Prime_Harmonic_Series
 Prime_Number_Theorem
 Priority_Queue_Braun
 Priority_Search_Trees
 Probabilistic_Noninterference
 Probabilistic_Prime_Tests
 Probabilistic_System_Zoo
 Probabilistic_Timed_Automata
 Probabilistic_While
 Program-Conflict-Analysis
 Progress_Tracking
 Projective_Geometry
 Projective_Measurements
 Promela
 Proof_Strategy_Language
 PropResPI
 Propositional_Proof_Systems
 Prpu_Maxflow
 PseudoHoops
 Psi_Calculi
 Ptolemys_Theorem
 Public_Announcement_Logic
 QHLProver
 QR_Decomposition
 Quantales
 Quaternions
 Quick_Sort_Cost
 RIPEMD-160-SPARK
 ROBDD
 RSAPSS
 Ramsey-Infinite
 Random_BSTs
 Random_Graph_Subgraph_Threshold
 Randomised_BSTs
 Randomised_Social_Choice
 Rank_Nullity_Theorem
 Real_Impl
 Recursion-Addition
 Recursion-Theory-I
 Refine_Imperative_HOL
 Refine_Monadic
 RefinementReactive
 Regex_Equivalence
 Regression_Test_Selection
 Regular-Sets
 Regular_Algebras
 Relation_Algebra
 Relational-Incorrectness-Logic
 Relational_Disjoint_Set_Forests
 Relational_Method
 Relational_Minimum_Spanning_Trees
 Relational_Paths
 Rep_Fin_Groups
 Residuated_Lattices
 Resolution_FOL
 Rewriting_Z
 Ribbon_Proofs
 Robbins-Conjecture
 Robinson_Arithmetic
 Root_Balanced_Tree
 Routing
 Roy_Floyd_Warshall
 SATSolverVerification
 SC_DOM_Components
 SDS_Impossibility
 SIFPL
 SIFUM_Type_Systems
 SPARCv8
 Safe_Distance
 Safe_OCL
 Saturation_Framework
 Saturation_Framework_Extensions
 Secondary_Sylow
 Security_Protocol_Refinement
 Selection_Heap_Sort
 SenSocialChoice
 Separata
 Separation_Algebra
 Separation_Logic_Imperative_HOL
 SequentInvertibility
 Shadow_DOM
 Shadow_SC_DOM
 Shivers-CFA
 ShortestPath
 Show
 Sigma_Commit_Crypto
 Signature_Groebner
 Simpl
 Simple_Firewall
 Simplex
 Skew_Heap
 Skip_Lists
 Slicing
 Sliding_Window_Algorithm
 Smith_Normal_Form
 Smooth_Manifolds
 Sort_Encodings
 Source_Coding_Theorem
 SpecCheck
 Special_Function_Bounds
 Splay_Tree
 Sqrt_Babylonian
 Stable_Matching
 Statecharts
 Stateful_Protocol_Composition_and_Typing
 Stellar_Quorums
 Stern_Brocot
 Stewart_Apollonius
 Stirling_Formula
 Stochastic_Matrices
 Stone_Algebras
 Stone_Kleene_Relation_Algebras
 Stone_Relation_Algebras
 Store_Buffer_Reduction
 Stream-Fusion
 Stream_Fusion_Code
 Strong_Security
 Sturm_Sequences
 Sturm_Tarski
 Stuttering_Equivalence
 Subresultants
 Subset_Boolean_Algebras
 SumSquares
 Sunflowers
 SuperCalc
 Surprise_Paradox
 Symmetric_Polynomials
 Syntax_Independent_Logic
 Szpilrajn
 TESL_Language
 TLA
 Tail_Recursive_Functions
 Tarskis_Geometry
 Taylor_Models
 Timed_Automata
 Topological_Semantics
 Topology
 TortoiseHare
 Transcendence_Series_Hancl_Rucki
 Transformer_Semantics
 Transition_Systems_and_Automata
 Transitive-Closure
 Transitive-Closure-II
 Treaps
 Tree-Automata
 Tree_Decomposition
 Triangle
 Trie
 Twelvefold_Way
 Tycon
 Types_Tableaus_and_Goedels_God
 UPF
 UPF_Firewall
 UTP
 Universal_Turing_Machine
 UpDown_Scheme
 Valuation
 Van_der_Waerden
 VectorSpace
 VeriComp
 Verified-Prover
 Verified_SAT_Based_AI_Planning
 VerifyThis2018
 VerifyThis2019
 Vickrey_Clarke_Groves
 VolpanoSmith
 WHATandWHERE_Security
 WOOT_Strong_Eventual_Consistency
 WebAssembly
 Weight_Balanced_Trees
 Well_Quasi_Orders
 Winding_Number_Eval
 Word_Lib
 WorkerWrapper
 XML
 ZFC_in_HOL
 Zeta_3_Irrational
 Zeta_Function
 pGCL