(*  Title:      Util_Nat.thy
    Date:       Oct 2006
    Author:     David Trachtenherz
*)

section \<open>Results for natural arithmetics\<close>

theory Util_Nat
imports Main
begin

subsection \<open>Some convenience arithmetic lemmata\<close>

lemma add_1_Suc_conv: "m + 1 = Suc m" by simp
lemma sub_Suc0_sub_Suc_conv: "b - a - Suc 0 = b - Suc a" by simp

lemma Suc_diff_Suc: "m < n \<Longrightarrow> Suc (n - Suc m) = n - m"
apply (rule subst[OF sub_Suc0_sub_Suc_conv])
apply (rule Suc_pred)
apply (simp only: zero_less_diff)
done

lemma nat_grSuc0_conv: "(Suc 0 < n) = (n \<noteq> 0 \<and> n \<noteq> Suc 0)"
by fastforce

lemma nat_geSucSuc0_conv: "(Suc (Suc 0) \<le> n) = (n \<noteq> 0 \<and> n \<noteq> Suc 0)"
by fastforce

lemma nat_lessSucSuc0_conv: "(n < Suc (Suc 0)) = (n = 0 \<or> n = Suc 0)"
by fastforce

lemma nat_leSuc0_conv: "(n \<le> Suc 0) = (n = 0 \<or> n = Suc 0)"
by fastforce

lemma mult_pred: "(m - Suc 0) * n = m * n - n"
by (simp add: diff_mult_distrib)

lemma mult_pred_right: "m * (n - Suc 0) = m * n - m"
by (simp add: diff_mult_distrib2)

lemma gr_implies_gr0: "m < (n::nat) \<Longrightarrow> 0 < n" by simp

corollary mult_cancel1_gr0: "
  (0::nat) < k \<Longrightarrow> (k * m = k * n) = (m = n)" by simp
corollary mult_cancel2_gr0: "
  (0::nat) < k \<Longrightarrow> (m * k = n * k) = (m = n)" by simp

corollary mult_le_cancel1_gr0: "
  (0::nat) < k \<Longrightarrow> (k * m \<le> k * n) = (m \<le> n)" by simp
corollary mult_le_cancel2_gr0: "
  (0::nat) < k \<Longrightarrow> (m * k \<le> n * k) = (m \<le> n)" by simp

lemma gr0_imp_self_le_mult1: "0 < (k::nat) \<Longrightarrow> m \<le> m * k"
by (drule Suc_leI, drule mult_le_mono[OF order_refl], simp)

lemma gr0_imp_self_le_mult2: "0 < (k::nat) \<Longrightarrow> m \<le> k * m"
by (subst mult.commute, rule gr0_imp_self_le_mult1)

lemma less_imp_Suc_mult_le: "m < n \<Longrightarrow> Suc m * k \<le> n * k"
by (rule mult_le_mono1, simp)

lemma less_imp_Suc_mult_pred_less: "\<lbrakk> m < n; 0 < k \<rbrakk> \<Longrightarrow> Suc m * k - Suc 0 < n * k"
apply (rule Suc_le_lessD)
apply (simp only: Suc_pred[OF nat_0_less_mult_iff[THEN iffD2, OF conjI, OF zero_less_Suc]])
apply (rule less_imp_Suc_mult_le, assumption)
done

lemma ord_zero_less_diff: "(0 < (b::'a::ordered_ab_group_add) - a) = (a < b)"
by (simp add: less_diff_eq)

lemma ord_zero_le_diff: "(0 \<le> (b::'a::ordered_ab_group_add) - a) = (a \<le> b)"
by (simp add: le_diff_eq)

text \<open>\<open>diff_diff_right\<close> in rule format\<close>
lemmas diff_diff_right = Nat.diff_diff_right[rule_format]

lemma less_add1: "(0::nat) < j \<Longrightarrow> i < i + j" by simp
lemma less_add2: "(0::nat) < j \<Longrightarrow> i < j + i" by simp

lemma add_lessD2: "i + j < (k::nat) \<Longrightarrow> j < k" by simp

lemma add_le_mono2: "i \<le> (j::nat) \<Longrightarrow> k + i \<le> k + j" by simp

lemma add_less_mono2: "i < (j::nat) \<Longrightarrow> k + i < k + j" by simp

lemma diff_less_self: "\<lbrakk> (0::nat) < i;  0 < j \<rbrakk> \<Longrightarrow> i - j < i" by simp

lemma
  ge_less_neq_conv: "((a::'a::linorder) \<le> n) = (\<forall>x. x < a \<longrightarrow> n \<noteq> x)" and
  le_greater_neq_conv: "(n \<le> (a::'a::linorder)) = (\<forall>x. a < x \<longrightarrow> n \<noteq> x)"
by (subst linorder_not_less[symmetric], blast)+
lemma
  greater_le_neq_conv: "((a::'a::linorder) < n) = (\<forall>x. x \<le> a \<longrightarrow> n \<noteq> x)" and
  less_ge_neq_conv: "(n < (a::'a::linorder)) = (\<forall>x. a \<le> x \<longrightarrow> n \<noteq> x)"
by (subst linorder_not_le[symmetric], blast)+

text \<open>Lemmas for @term{abs} function\<close>

lemma leq_pos_imp_abs_leq: "\<lbrakk> 0 \<le> (a::'a::ordered_ab_group_add_abs); a \<le> b \<rbrakk> \<Longrightarrow> \<bar>a\<bar> \<le> \<bar>b\<bar>"
by simp
lemma leq_neg_imp_abs_geq: "\<lbrakk> (a::'a::ordered_ab_group_add_abs) \<le> 0; b \<le> a \<rbrakk> \<Longrightarrow> \<bar>a\<bar> \<le> \<bar>b\<bar>"
by simp
lemma abs_range: "\<lbrakk> 0 \<le> (a::'a::{ordered_ab_group_add_abs,abs_if}); -a \<le> x; x \<le> a \<rbrakk> \<Longrightarrow> \<bar>x\<bar> \<le> a"
apply (clarsimp simp: abs_if)
apply (rule neg_le_iff_le[THEN iffD1], simp)
done

text \<open>Lemmas for @term{sgn} function\<close>

lemma sgn_abs:"(x::'a::linordered_idom) \<noteq> 0 \<Longrightarrow> \<bar>sgn x\<bar> = 1"
by (case_tac "x < 0", simp+)
lemma sgn_mult_abs:"\<bar>x\<bar> * \<bar>sgn (a::'a::linordered_idom)\<bar> = \<bar>x * sgn a\<bar>"
by (fastforce simp add: sgn_if abs_if)
lemma abs_imp_sgn_abs: "\<bar>a\<bar> = \<bar>b\<bar> \<Longrightarrow> \<bar>sgn (a::'a::linordered_idom)\<bar> = \<bar>sgn b\<bar>"
by (fastforce simp add: abs_if)
lemma sgn_mono: "a \<le> b \<Longrightarrow> sgn (a::'a::{linordered_idom,linordered_semidom}) \<le> sgn b"
by (auto simp add: sgn_if)

subsection \<open>Additional facts about inequalities\<close>

lemma add_diff_le: "k \<le> n \<Longrightarrow> m + k - n \<le> (m::nat)"
by (case_tac "m + k < n", simp_all)

lemma less_add_diff: "k < (n::nat) \<Longrightarrow> m < n + m - k"

by (rule add_less_imp_less_right[of _ k], simp)

lemma add_diff_less: "\<lbrakk> k < n; 0 < m \<rbrakk> \<Longrightarrow> m + k - n < (m::nat)"
by (case_tac "m + k < n", simp_all)

lemma add_le_imp_le_diff1: "i + k \<le> j \<Longrightarrow> i \<le> j - (k::nat)"
by (case_tac "k \<le> j", simp_all)

lemma add_le_imp_le_diff2: "k + i \<le> j \<Longrightarrow> i \<le> j - (k::nat)" by simp

lemma diff_less_imp_less_add: "j - (k::nat) < i \<Longrightarrow> j < i + k" by simp

lemma diff_less_conv: "0 < i \<Longrightarrow> (j - (k::nat) < i) = (j < i + k)"
by (safe, simp_all)

lemma diff_less_imp_swap: "\<lbrakk> 0 < (i::nat); k - i < j \<rbrakk> \<Longrightarrow> (k - j < i)" by simp
lemma diff_less_swap: "\<lbrakk> 0 < (i::nat); 0 < j \<rbrakk> \<Longrightarrow> (k - j < i) = (k - i < j)"
by (blast intro: diff_less_imp_swap)

lemma less_diff_imp_less: "(i::nat) < j - m \<Longrightarrow> i < j" by simp
lemma le_diff_imp_le: "(i::nat) \<le> j - m \<Longrightarrow> i \<le> j" by simp

lemma less_diff_le_imp_less: "\<lbrakk> (i::nat) < j - m; n \<le> m \<rbrakk> \<Longrightarrow> i < j - n" by simp
lemma le_diff_le_imp_le: "\<lbrakk> (i::nat) \<le> j - m; n \<le> m \<rbrakk> \<Longrightarrow> i \<le> j - n" by simp

lemma le_imp_diff_le: "(j::nat) \<le> k \<Longrightarrow> j - n \<le> k" by simp

subsection \<open>Inequalities for Suc and pred\<close>

corollary less_eq_le_pred: "0 < (n::nat) \<Longrightarrow> (m < n) = (m \<le> n - Suc 0)"
by (safe, simp_all)

corollary less_imp_le_pred: "m < n \<Longrightarrow> m \<le> n - Suc 0" by simp
corollary le_pred_imp_less: "\<lbrakk> 0 < n; m \<le> n - Suc 0 \<rbrakk> \<Longrightarrow> m < n" by simp

corollary pred_less_eq_le: "0 < m \<Longrightarrow> (m - Suc 0 < n) = (m \<le> n)"
by (safe, simp_all)
corollary pred_less_imp_le: "m - Suc 0 < n \<Longrightarrow> m \<le> n" by simp
corollary le_imp_pred_less: "\<lbrakk> 0 < m; m \<le> n \<rbrakk> \<Longrightarrow> m - Suc 0 < n" by simp

lemma diff_add_inverse_Suc: "n < m \<Longrightarrow> n + (m - Suc n) = m - Suc 0" by simp

lemma pred_mono: "\<lbrakk> m < n; 0 < m \<rbrakk> \<Longrightarrow> m - Suc 0 < n - Suc 0" by simp
corollary pred_Suc_mono: "\<lbrakk> m < Suc n; 0 < m \<rbrakk> \<Longrightarrow> m - Suc 0 < n" by simp

lemma Suc_less_pred_conv: "(Suc m < n) = (m < n - Suc 0)" by (safe, simp_all)
lemma Suc_le_pred_conv: "0 < n \<Longrightarrow> (Suc m \<le> n) = (m \<le> n - Suc 0)" by (safe, simp_all)
lemma Suc_le_imp_le_pred: "Suc m \<le> n \<Longrightarrow> m \<le> n - Suc 0" by simp

subsection \<open>Additional facts about cancellation in (in-)equalities\<close>

lemma diff_cancel_imp_eq: "\<lbrakk> 0 < (n::nat);  n + i - j = n \<rbrakk> \<Longrightarrow> i = j" by simp

lemma nat_diff_left_cancel_less: "k - m < k - (n::nat) \<Longrightarrow> n < m" by simp
lemma nat_diff_right_cancel_less: "n - k < (m::nat) - k \<Longrightarrow> n < m" by simp

lemma nat_diff_left_cancel_le1: "\<lbrakk> k - m \<le> k - (n::nat); m < k \<rbrakk> \<Longrightarrow> n \<le> m" by simp
lemma nat_diff_left_cancel_le2: "\<lbrakk> k - m \<le> k - (n::nat); n \<le> k \<rbrakk> \<Longrightarrow> n \<le> m" by simp

lemma nat_diff_right_cancel_le1: "\<lbrakk> m - k \<le> n - (k::nat); k < m \<rbrakk> \<Longrightarrow> m \<le> n" by simp
lemma nat_diff_right_cancel_le2: "\<lbrakk> m - k \<le> n - (k::nat); k \<le> n \<rbrakk> \<Longrightarrow> m \<le> n" by simp

lemma nat_diff_left_cancel_eq1: "\<lbrakk> k - m = k - (n::nat); m < k \<rbrakk> \<Longrightarrow> m = n" by simp
lemma nat_diff_left_cancel_eq2: "\<lbrakk> k - m = k - (n::nat); n < k \<rbrakk> \<Longrightarrow> m = n" by simp

lemma nat_diff_right_cancel_eq1: "\<lbrakk> m - k = n - (k::nat); k < m \<rbrakk> \<Longrightarrow> m = n" by simp
lemma nat_diff_right_cancel_eq2: "\<lbrakk> m - k = n - (k::nat); k < n \<rbrakk> \<Longrightarrow> m = n" by simp

lemma eq_diff_left_iff: "\<lbrakk> (m::nat) \<le> k; n \<le> k\<rbrakk> \<Longrightarrow> (k - m = k - n) = (m = n)"
by (safe, simp_all)

lemma eq_imp_diff_eq: "m = (n::nat) \<Longrightarrow> m - k = n - k" by simp

text \<open>List of definitions and lemmas\<close>

thm
  Nat.add_Suc_right
  add_1_Suc_conv
  sub_Suc0_sub_Suc_conv

thm
  Nat.mult_cancel1
  Nat.mult_cancel2
  mult_cancel1_gr0
  mult_cancel2_gr0

thm
  Nat.add_lessD1
  add_lessD2

thm
  Nat.zero_less_diff
  ord_zero_less_diff
  ord_zero_le_diff

thm
  Nat.le_add_diff
  add_diff_le
  less_add_diff
  add_diff_less

thm
  Nat.le_diff_conv Nat.le_diff_conv2
  Nat.less_diff_conv
  diff_less_imp_less_add
  diff_less_conv

thm
  le_diff_swap
  diff_less_imp_swap
  diff_less_swap

thm
  less_diff_imp_less
  le_diff_imp_le

thm
  less_diff_le_imp_less
  le_diff_le_imp_le

thm
  Nat.less_imp_diff_less
  le_imp_diff_le

thm
  Nat.less_Suc_eq_le
  less_eq_le_pred
  less_imp_le_pred
  le_pred_imp_less

thm
  Nat.Suc_le_eq
  pred_less_eq_le
  pred_less_imp_le
  le_imp_pred_less

thm
  diff_cancel_imp_eq
thm
  diff_add_inverse_Suc
thm
  Nat.nat_add_left_cancel_less
  Nat.nat_add_left_cancel_le
  Nat.nat_add_right_cancel
  Nat.nat_add_left_cancel
  Nat.eq_diff_iff
  Nat.less_diff_iff
  Nat.le_diff_iff
thm
  nat_diff_left_cancel_less
  nat_diff_right_cancel_less
thm
  nat_diff_left_cancel_le1
  nat_diff_left_cancel_le2
  nat_diff_right_cancel_le1
  nat_diff_right_cancel_le2
thm
  nat_diff_left_cancel_eq1
  nat_diff_left_cancel_eq2
  nat_diff_right_cancel_eq1
  nat_diff_right_cancel_eq2

thm
  Nat.eq_diff_iff
  eq_diff_left_iff

thm
  Nat.nat_add_right_cancel Nat.nat_add_left_cancel
  Nat.diff_le_mono
  eq_imp_diff_eq

end


(*  Title:      Additional Facts about Subgroups and Normal Subgroups
    Author:     Jakob von Raumer, Karlsruhe Institute of Technology
    Maintainer: Jakob von Raumer <jakob.raumer@student.kit.edu>
*)

theory SubgroupsAndNormalSubgroups
imports
  "Coset"
  "../Secondary_Sylow/SndSylow"
  "SndIsomorphismGrp"
begin

section {* Preliminary lemmas *}

text {* A group of order 1 is always the trivial group. *}

lemma (in group) order_one_triv_iff:
  shows "(order G = 1) = (carrier G = {\<one>})"
proof
  assume order:"order G = 1"
  then obtain x where x:"carrier G = {x}" unfolding order_def by (auto simp add: card_Suc_eq)
  hence "\<one> = x" using one_closed by auto
  with x show "carrier G = {\<one>}" by simp
next
  assume "carrier G = {\<one>}"
  thus "order G = 1" unfolding order_def by auto
qed

lemma (in group) finite_pos_order:
  assumes finite:"finite (carrier G)"
  shows "0 < order G"
proof -
  from one_closed finite show ?thesis unfolding order_def by (metis card_gt_0_iff subgroup_nonempty subgroup_self)
qed

lemma iso_order_closed:
  assumes "\<phi> \<in> G \<cong> H"
  shows "order G = order H"
using assms
unfolding order_def iso_def by (metis (no_types) bij_betw_same_card mem_Collect_eq)

section {* More Facts about Subgroups *}

lemma (in subgroup) subgroup_of_restricted_group:
  assumes "subgroup U (G\<lparr> carrier := H\<rparr>)"
  shows "U \<subseteq> H"
using assms subgroup_imp_subset by force

lemma (in subgroup) subgroup_of_subgroup:
  assumes "group G"
  assumes "subgroup U (G\<lparr> carrier := H\<rparr>)"
  shows "subgroup U G"
proof
  from assms(2) have "U \<subseteq> H" by (rule subgroup_of_restricted_group)
  thus "U \<subseteq> carrier G" by (auto simp:subset)
next
  fix x y
  have a:"x \<otimes> y = x \<otimes>\<^bsub>G\<lparr> carrier := H\<rparr>\<^esub> y" by simp
  assume "x \<in> U" "y \<in> U"
  with assms a show " x \<otimes> y \<in> U" by (metis subgroup.m_closed)
next
  have "\<one>\<^bsub>G\<lparr> carrier := H\<rparr>\<^esub> = \<one>" by simp
  with assms show "\<one> \<in> U" by (metis subgroup.one_closed)
next
  have "subgroup H G"..
  fix x
  assume "x \<in> U"
  with assms(2) have "inv\<^bsub>G\<lparr> carrier := H\<rparr>\<^esub> x \<in> U" by (rule subgroup.m_inv_closed)
  moreover from assms `x \<in> U` have "x \<in> H" by (metis in_mono subgroup_of_restricted_group)
  with assms(1) `subgroup H G` have "inv\<^bsub>G\<lparr> carrier := H\<rparr>\<^esub> x = inv x" by (rule group.subgroup_inv_equality)
  ultimately show "inv x \<in> U" by simp
qed

text {* Being a subgroup is preserved by surjective homomorphisms *}

lemma (in subgroup) surj_hom_subgroup:
  assumes \<phi>:"group_hom G F \<phi>"
  assumes \<phi>surj:"\<phi> ` (carrier G) = carrier F"
  shows "subgroup (\<phi> ` H) F"
proof
  from \<phi>surj show img_subset:"\<phi> ` H \<subseteq> carrier F" unfolding iso_def bij_betw_def by auto
next
  fix f f'
	assume h:"f \<in> \<phi> ` H" and h':"f' \<in> \<phi> ` H"
	with \<phi>surj obtain g g' where g:"g \<in> H" "f = \<phi> g" and g':"g' \<in> H" "f' = \<phi> g'" by auto
	hence "g \<otimes>\<^bsub>G\<^esub> g' \<in> H" by (metis m_closed)
  hence "\<phi> (g \<otimes>\<^bsub>G\<^esub> g') \<in> \<phi> ` H" by simp
  with g g' \<phi> show "f \<otimes>\<^bsub>F\<^esub> f' \<in> \<phi> ` H"  using group_hom.hom_mult by fastforce
next
  have "\<phi> \<one> \<in> \<phi> ` H" by auto
  with \<phi> show  "\<one>\<^bsub>F\<^esub> \<in> \<phi> ` H" by (metis group_hom.hom_one)
next
  fix f
  assume f:"f \<in> \<phi> ` H"
  then obtain g where g:"g \<in> H" "f = \<phi> g" by auto
  hence "inv g \<in> H" by auto
  hence "\<phi> (inv g) \<in> \<phi> ` H" by auto
  with \<phi> g subset show "inv\<^bsub>F\<^esub> f \<in> \<phi> ` H" using group_hom.hom_inv by fastforce
qed

text {* ... and thus of course by isomorphisms of groups. *}

lemma iso_subgroup:
  assumes groups:"group G" "group F"
  assumes HG:"subgroup H G"
  assumes \<phi>:"\<phi> \<in> G \<cong> F"
  shows "subgroup (\<phi> ` H) F"
proof -
  from groups \<phi> have "group_hom G F \<phi>" unfolding group_hom_def group_hom_axioms_def iso_def by auto
  moreover from \<phi> have "\<phi> ` (carrier G) = carrier F" unfolding iso_def bij_betw_def by simp
  moreover note HG
  ultimately show ?thesis by (metis subgroup.surj_hom_subgroup)
qed

text {* An isomorphism restricts to an isomorphism of subgroups. *}

lemma iso_restrict:
  assumes groups:"group G" "group F"
  assumes HG:"subgroup H G"
  assumes \<phi>:"\<phi> \<in> G \<cong> F"
  shows "(restrict \<phi> H) \<in> (G\<lparr>carrier := H\<rparr>) \<cong> (F\<lparr>carrier := \<phi> ` H\<rparr>)"
unfolding iso_def hom_def bij_betw_def inj_on_def
proof auto
  fix g h
  assume "g \<in> H" "h \<in> H"
  hence "g \<in> carrier G" "h \<in> carrier G" by (metis HG subgroup.mem_carrier)+
  thus "\<phi> (g \<otimes>\<^bsub>G\<^esub> h) = \<phi> g \<otimes>\<^bsub>F\<^esub> \<phi> h" using \<phi> unfolding iso_def hom_def by auto
next
  fix g h
  assume "g \<in> H" "h \<in> H" "g \<otimes>\<^bsub>G\<^esub> h \<notin> H"
  hence "False" using HG unfolding subgroup_def by auto
  thus "undefined = \<phi> g \<otimes>\<^bsub>F\<^esub> \<phi> h" by auto
next
  fix g h
  assume g:"g \<in> H" and h:"h \<in> H" and eq:"\<phi> g = \<phi> h"
  hence "g \<in> carrier G" "h \<in> carrier G" by (metis HG subgroup.mem_carrier)+
  with eq show "g = h" using \<phi> unfolding iso_def bij_betw_def inj_on_def by auto
qed

text {* The intersection of two subgroups is, again, a subgroup *}

lemma (in group) subgroup_intersect:
  assumes "subgroup H G"
  assumes "subgroup H' G"
  shows "subgroup (H \<inter> H') G"
using assms unfolding subgroup_def by auto

section {* Facts about Normal Subgroups *}

lemma (in normal) is_normal:
  shows "H \<lhd> G"
by (metis coset_eq is_subgroup normalI)

text {* Being a normal subgroup is preserved by surjective homomorphisms. *}

lemma (in normal) surj_hom_normal_subgroup:
  assumes \<phi>:"group_hom G F \<phi>"
  assumes \<phi>surj:"\<phi> ` (carrier G) = carrier F"
  shows "(\<phi> ` H) \<lhd> F"
proof (rule group.normalI)
  from \<phi> show "group F" unfolding group_hom_def group_hom_axioms_def by simp
next
  from \<phi> \<phi>surj show "subgroup (\<phi> ` H) F" by (rule surj_hom_subgroup)
next
  show "\<forall>x\<in>carrier F. \<phi> ` H #>\<^bsub>F\<^esub> x = x <#\<^bsub>F\<^esub> \<phi> ` H"
  proof
    fix f
    assume f:"f \<in> carrier F"
    with \<phi>surj obtain g where g:"g \<in> carrier G" "f = \<phi> g" by auto
    hence "\<phi> ` H #>\<^bsub>F\<^esub> f = \<phi> ` H #>\<^bsub>F\<^esub> \<phi> g" by simp
    also have "... = (\<lambda>x. (\<phi> x) \<otimes>\<^bsub>F\<^esub> (\<phi> g)) ` H" unfolding r_coset_def image_def by auto
    also have "... = (\<lambda>x. \<phi> (x \<otimes> g)) ` H" using subset g \<phi> group_hom.hom_mult unfolding image_def by fastforce
    also have "... = \<phi> ` (H #> g)" using \<phi> unfolding r_coset_def by auto
    also have "... = \<phi> ` (g <# H)" by (metis coset_eq g(1))
    also have "... = (\<lambda>x. \<phi> (g \<otimes> x)) ` H" using \<phi> unfolding l_coset_def by auto
    also have "... = (\<lambda>x. (\<phi> g) \<otimes>\<^bsub>F\<^esub> (\<phi> x)) ` H" using subset g \<phi> group_hom.hom_mult by fastforce
    also have "... = \<phi> g <#\<^bsub>F\<^esub> \<phi> ` H" unfolding l_coset_def image_def by auto
    also have "... = f <#\<^bsub>F\<^esub> \<phi> ` H" using g by simp
    finally show "\<phi> ` H #>\<^bsub>F\<^esub> f = f <#\<^bsub>F\<^esub> \<phi> ` H".
  qed
qed

text {* Being a normal subgroup is preserved by group isomorphisms. *}

lemma iso_normal_subgroup:
  assumes groups:"group G" "group F"
  assumes HG:"H \<lhd> G"
  assumes \<phi>:"\<phi> \<in> G \<cong> F"
  shows "(\<phi> ` H) \<lhd> F"
proof -
  from groups \<phi> have "group_hom G F \<phi>" unfolding group_hom_def group_hom_axioms_def iso_def by auto
  moreover from \<phi> have "\<phi> ` (carrier G) = carrier F" unfolding iso_def bij_betw_def by simp
  moreover note HG
  ultimately show ?thesis using normal.surj_hom_normal_subgroup by metis
qed

text {* The trivial subgroup is a subgroup: *}

lemma (in group) triv_subgroup:
  shows "subgroup {\<one>} G"
unfolding subgroup_def by auto

text {* The cardinality of the right cosets of the trivial subgroup is the cardinality of the group itself: *}

lemma (in group) card_rcosets_triv:
  assumes "finite (carrier G)"
  shows "card (rcosets {\<one>}) = order G"
proof -
  have "subgroup {\<one>} G" by (rule triv_subgroup)
  with assms have "card (rcosets {\<one>}) * card {\<one>} = order G" by (rule lagrange)
  thus ?thesis by (auto simp:card_Suc_eq)
qed

text {* The intersection of two normal subgroups is, again, a normal subgroup. *}

lemma (in group) normal_subgroup_intersect:
  assumes "M \<lhd> G" and "N \<lhd> G"
  shows "M \<inter> N \<lhd> G"
using assms subgroup_intersect is_group normal_inv_iff by simp

text {* The set product of two normal subgroups is a normal subgroup. *}

lemma (in group) setmult_lcos_assoc:
     "\<lbrakk>H \<subseteq> carrier G; K \<subseteq> carrier G; x \<in> carrier G\<rbrakk>
      \<Longrightarrow> (x <# H) <#> K = x <# (H <#> K)"
by (force simp add: l_coset_def set_mult_def m_assoc)

lemma (in group) normal_subgroup_set_mult_closed:
  assumes "M \<lhd> G" and "N \<lhd> G"
  shows "M <#> N \<lhd> G"
proof (rule normalI)
  from assms show "subgroup (M <#> N) G"
    using second_isomorphism_grp.normal_set_mult_subgroup normal_imp_subgroup
    unfolding second_isomorphism_grp_def second_isomorphism_grp_axioms_def by force
next
  show "\<forall>x\<in>carrier G. M <#> N #> x = x <# (M <#> N)"
  proof
    fix x
    assume x:"x \<in> carrier G"
    have "M <#> N #> x = M <#> (N #> x)" by (metis assms(1,2) normal_inv_iff setmult_rcos_assoc subgroup_imp_subset x)
    also have "\<dots> = M <#> (x <# N)" by (metis assms(2) normal.coset_eq x)
    also have "\<dots> = (M #> x) <#> N" by (metis assms(1,2) normal_imp_subgroup rcos_assoc_lcos subgroup_imp_subset x)
    also have "\<dots> = (x <# M) <#> N" by (metis assms(1) normal.coset_eq x)
    also have "\<dots> = x <# (M <#> N)" by (metis assms(1,2) normal_imp_subgroup setmult_lcos_assoc subgroup_imp_subset x)
    finally show "M <#> N #> x = x <# (M <#> N)".
  qed
qed

text {* The following is a very basic lemma about subgroups: If restricting the carrier of
  a group yields a group it's a subgroup of the group we've started with. *}

lemma (in group) restrict_group_imp_subgroup:
  assumes "H \<subseteq> carrier G" "group (G\<lparr>carrier := H\<rparr>)"
  shows "subgroup H G"
proof
  from assms(1) show "H \<subseteq> carrier G" .
next
  fix x y
  assume "x \<in> H" "y \<in> H"
  hence "x \<in> carrier (G\<lparr>carrier := H\<rparr>)" "y \<in> carrier (G\<lparr>carrier := H\<rparr>)" by auto
  with assms(2) show "x \<otimes> y \<in> H" using assms(2) group.is_monoid monoid.m_closed by fastforce
next
  show "\<one> \<in> H" using assms(2) group.is_monoid monoid.one_closed by fastforce
next
  fix x
  assume "x \<in> H"
  hence x:"x \<in> carrier (G\<lparr>carrier := H\<rparr>)" by auto
  hence "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x \<in> carrier (G\<lparr>carrier := H\<rparr>)" using assms(2) group.inv_closed by fastforce
  hence "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x \<in> carrier G" using x assms(1) by auto
  moreover have "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x \<otimes> x = \<one>" using assms(2) group.l_inv x by fastforce
  moreover have "x \<in> carrier G" using x assms(1) by auto
  ultimately have "inv\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> x = inv x" using inv_equality[symmetric] by auto
  thus "inv x \<in> H" using assms(2) group.inv_closed x by fastforce
qed

text {* A subgroup relation survives factoring by a normal subgroup. *}

lemma (in group) normal_subgroup_factorize:
  assumes "N \<lhd> G" and "N \<subseteq> H" and "subgroup H G"
  shows "subgroup (rcosets\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N) (G Mod N)"
proof -
  interpret GModN: group "G Mod N" using assms(1) by (rule normal.factorgroup_is_group)
  have "N \<lhd> G\<lparr>carrier := H\<rparr>" using assms by (metis normal_restrict_supergroup)
  hence grpHN:"group (G\<lparr>carrier := H\<rparr> Mod N)" by (rule normal.factorgroup_is_group)
  have "op <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> = (\<lambda>U K. (\<Union>h\<in>U. \<Union>k\<in>K. {h \<otimes>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> k}))" using set_mult_def by metis
  moreover have "\<dots> = (\<lambda>U K. (\<Union>h\<in>U. \<Union>k\<in>K. {h \<otimes>\<^bsub>G\<^esub> k}))" by auto
  moreover have "op <#> = (\<lambda>U K. (\<Union>h\<in>U. \<Union>k\<in>K. {h \<otimes> k}))" using set_mult_def by metis
  ultimately have "op <#>\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> = op <#>\<^bsub>G\<^esub>" by simp
  with grpHN have "group ((G Mod N)\<lparr>carrier := (rcosets\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N)\<rparr>)" unfolding FactGroup_def by auto
  moreover have "rcosets\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N \<subseteq> carrier (G Mod N)" unfolding FactGroup_def RCOSETS_def r_coset_def
    using assms(3) subgroup_imp_subset by fastforce
  ultimately show ?thesis using GModN.is_group group.restrict_group_imp_subgroup by auto
qed

text {* A normality relation survives factoring by a normal subgroup. *}

lemma (in group) normality_factorization:
  assumes NG:"N \<lhd> G" and NH:"N \<subseteq> H" and HG:"H \<lhd> G"
  shows "(rcosets\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N) \<lhd> (G Mod N)"
proof -
  from assms(1) interpret GModN: group "G Mod N" by (metis normal.factorgroup_is_group)
  show ?thesis
  proof (auto simp: GModN.normal_inv_iff)
    from assms show "subgroup (rcosets\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N) (G Mod N)" using normal_imp_subgroup normal_subgroup_factorize by force
  next
    fix U V
    assume U:"U \<in> carrier (G Mod N)" and V:"V \<in> rcosets\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N"
    then obtain g where g:"g \<in> carrier G" "U = N #> g" unfolding FactGroup_def RCOSETS_def by auto
    from V obtain h where h:"h \<in> H" "V = N #> h" unfolding FactGroup_def RCOSETS_def r_coset_def by auto
    hence hG:"h \<in> carrier G" using HG normal_imp_subgroup subgroup.mem_carrier by force
    hence ghG:"g \<otimes> h \<in> carrier G" using g m_closed by auto
    from g h have "g \<otimes> h \<otimes> inv g \<in> H" using HG normal_inv_iff by auto
    moreover have "U <#> V <#> inv\<^bsub>G Mod N\<^esub> U = N #> (g \<otimes> h \<otimes> inv g)"
    proof -
      from g U have "inv\<^bsub>G Mod N\<^esub> U = N #> inv g" using NG normal.inv_FactGroup normal.rcos_inv by fastforce
      hence "U <#> V <#> inv\<^bsub>G Mod N\<^esub> U = (N #> g) <#> (N #> h) <#> (N #> inv g)" using g h by simp
      also have "\<dots> = N #> (g \<otimes> h) <#> (N #> inv g)" using g hG NG normal.rcos_sum by force
      also have "\<dots> = N #> (g \<otimes> h \<otimes> inv g)" using g inv_closed ghG NG normal.rcos_sum by force
      finally show ?thesis .
    qed
    ultimately show "U <#> V <#> inv\<^bsub>G Mod N\<^esub> U \<in> rcosets\<^bsub>G\<lparr>carrier := H\<rparr>\<^esub> N" unfolding RCOSETS_def r_coset_def by auto
  qed
qed

text {* Factoring by a normal subgroups yields the trivial group iff the subgroup is the whole group. *}

lemma (in normal) fact_group_trivial_iff:
  assumes "finite (carrier G)"
  shows "(carrier (G Mod H) = {\<one>\<^bsub>G Mod H\<^esub>}) = (H = carrier G)"
proof
  assume "carrier (G Mod H) = {\<one>\<^bsub>G Mod H\<^esub>}"
  moreover with assms lagrange have "order (G Mod H) * card H = order G" unfolding FactGroup_def order_def using is_subgroup by force
  ultimately have "card H = order G" unfolding order_def by auto
  thus "H = carrier G" using subgroup_imp_subset is_subgroup assms card_subset_eq unfolding order_def
    by metis
next
  from assms have ordergt0:"order G > 0" unfolding order_def by (metis subgroup.finite_imp_card_positive subgroup_self)
  assume "H = carrier G"
  hence "card H = order G" unfolding order_def by simp
  with assms is_subgroup lagrange have "card (rcosets H) * order G = order G" by metis
  with ordergt0 have "card (rcosets H) = 1" by (metis mult_eq_self_implies_10 mult.commute neq0_conv)
  hence "order (G Mod H) = 1" unfolding order_def FactGroup_def by auto
  thus "carrier (G Mod H) = {\<one>\<^bsub>G Mod H\<^esub>}" using factorgroup_is_group by (metis group.order_one_triv_iff)
qed

text {* Finite groups have finite quotients. *}

lemma (in normal) factgroup_finite:
  assumes "finite (carrier G)"
  shows "finite (rcosets H)"
using assms unfolding RCOSETS_def by auto

text {* The union of all the cosets contained in a subgroup of a quotient group acts as a represenation for that subgroup. *}

lemma (in normal) factgroup_subgroup_union_char:
  assumes "subgroup A (G Mod H)"
  shows "(\<Union>A) = {x \<in> carrier G. H #> x \<in> A}"
proof
  show "\<Union>A \<subseteq> {x \<in> carrier G. H #> x \<in> A}"
  proof
    fix x
    assume x:"x \<in> \<Union>A"
    then obtain a where a:"a \<in> A" "x \<in> a" by auto
    with assms have xx:"x \<in> carrier G" using subgroup_imp_subset unfolding FactGroup_def RCOSETS_def r_coset_def by force
    from assms a obtain y where y:"y \<in> carrier G" "a = H #> y" using subgroup_imp_subset unfolding FactGroup_def RCOSETS_def by force
    with a have "x \<in> H #> y" by simp
    hence "H #> y = H #> x" using y is_subgroup repr_independence by auto
    with y(2) a(1) have "H #> x \<in> A" by auto
    with xx show "x \<in> {x \<in> carrier G. H #> x \<in> A}" by simp
  qed
next
  show "{x \<in> carrier G. H #> x \<in> A} \<subseteq> \<Union>A"
  proof
    fix x
    assume x:"x \<in> {x \<in> carrier G. H #> x \<in> A}"
    hence xx:"x \<in> carrier G" "H #> x \<in> A" by auto
    moreover have "x \<in> H #> x" by (metis is_subgroup rcos_self xx(1))
    ultimately show "x \<in> \<Union>A" by auto
  qed
qed

lemma (in normal) factgroup_subgroup_union_subgroup:
  assumes "subgroup A (G Mod H)"
  shows "subgroup (\<Union>A) G"
proof -
  have "subgroup {x \<in> carrier G. H #> x \<in> A} G"
  proof
    show "{x \<in> carrier G. H #> x \<in> A} \<subseteq> carrier G" by auto
  next
    fix x y
    assume "x \<in> {x \<in> carrier G. H #> x \<in> A}" and "y \<in> {x \<in> carrier G. H #> x \<in> A}"
    hence x:"x \<in> carrier G" "H #> x \<in> A" and y:"y \<in> carrier G" "H #> y \<in> A" by auto
    hence xyG:"x \<otimes> y \<in> carrier G" by (metis m_closed)
    from assms x y have "(H #> x) <#> (H #> y) \<in> A" using subgroup.m_closed unfolding FactGroup_def by fastforce
    hence "H #> (x \<otimes> y) \<in> A" by (metis rcos_sum x(1) y(1))
    with xyG show "x \<otimes> y \<in> {x \<in> carrier G. H #> x \<in> A}" by simp
  next
    have "H #> \<one> \<in> A" using assms subgroup.one_closed unfolding FactGroup_def by (metis coset_mult_one monoid.select_convs(2) subset)
    with assms one_closed show "\<one> \<in> {x \<in> carrier G. H #> x \<in> A}" by simp
  next
    fix x
    assume "x \<in> {x \<in> carrier G. H #> x \<in> A}"
    hence x:"x \<in> carrier G" "H #> x \<in> A" by auto
    hence invx:"inv x \<in> carrier G" using inv_closed by simp
    from assms x have "set_inv (H #> x) \<in> A" using subgroup.m_inv_closed by (metis inv_FactGroup subgroup.mem_carrier)
    hence "H #> (inv x) \<in> A" by (metis rcos_inv x(1))
    with invx show "inv x \<in> {x \<in> carrier G. H #> x \<in> A}" by simp
  qed
  with assms factgroup_subgroup_union_char show ?thesis by auto
qed

lemma (in normal) factgroup_subgroup_union_normal:
  assumes "A \<lhd> (G Mod H)"
  shows "\<Union>A \<lhd> G"
proof -
  have "{x \<in> carrier G. H #> x \<in> A} \<lhd> G"
  unfolding normal_def normal_axioms_def
  proof auto (*(auto del: equalityI)*)
    from assms show "subgroup {x \<in> carrier G. H #> x \<in> A} G"
      by (metis (full_types) factgroup_subgroup_union_char factgroup_subgroup_union_subgroup normal_imp_subgroup)
  next
    show "group G" by (rule is_group)
  next
    interpret Anormal: normal A "(G Mod H)" using assms by simp
    fix x y
    assume x:"x \<in> carrier G" "y \<in> {x \<in> carrier G. H #> x \<in> A} #> x"
    then obtain x' where "x' \<in> {x \<in> carrier G. H #> x \<in> A}" "y = x' \<otimes> x" unfolding r_coset_def by auto
    hence x':"x' \<in> carrier G" "H #> x' \<in> A" by auto
    from x(1) have Hx:"H #> x \<in> carrier (G Mod H)" unfolding FactGroup_def RCOSETS_def by force
    with x' have "(inv\<^bsub>G Mod H\<^esub> (H #> x)) \<otimes>\<^bsub>G Mod H\<^esub> (H #> x') \<otimes>\<^bsub>G Mod H\<^esub> (H #> x) \<in> A" using Anormal.inv_op_closed1 by auto
    hence "(set_inv (H #> x)) <#> (H #> x') <#> (H #> x) \<in> A" using inv_FactGroup Hx unfolding FactGroup_def by auto
    hence "(H #> (inv x)) <#> (H #> x') <#> (H #> x) \<in> A" using x(1) by (metis rcos_inv)
    hence "(H #> (inv x \<otimes> x')) <#> (H #> x) \<in> A" by (metis inv_closed rcos_sum x'(1) x(1))
    hence "H #> (inv x \<otimes> x' \<otimes> x) \<in> A" by (metis inv_closed m_closed rcos_sum x'(1) x(1))
    moreover have "inv x \<otimes> x' \<otimes> x \<in> carrier G" using x x' by (metis inv_closed m_closed)
    ultimately have "inv x \<otimes> x' \<otimes> x \<in> {x \<in> carrier G. H #> x \<in> A}" by auto
    hence xcoset:"x \<otimes> (inv x \<otimes> x' \<otimes> x) \<in> x <# {x \<in> carrier G. H #> x \<in> A}" unfolding l_coset_def using x(1) by auto
    have "x \<otimes> (inv x \<otimes> x' \<otimes> x) = (x \<otimes> inv x) \<otimes> x' \<otimes> x" by (metis Units_eq Units_inv_Units m_assoc m_closed x'(1) x(1))
    also have "\<dots> = x' \<otimes> x" by (metis l_one r_inv x'(1) x(1))
    also have "\<dots> = y" by (metis `y = x' \<otimes> x`)
    finally have "x \<otimes> (inv x \<otimes> x' \<otimes> x) = y".
    with xcoset show "y \<in> x <# {x \<in> carrier G. H #> x \<in> A}" by auto
  next
    interpret Anormal: normal A "(G Mod H)" using assms by simp
    fix x y
    assume x:"x \<in> carrier G" "y \<in> x <# {x \<in> carrier G. H #> x \<in> A}"
    then obtain x' where "x' \<in> {x \<in> carrier G. H #> x \<in> A}" "y = x \<otimes> x'" unfolding l_coset_def by auto
    hence x':"x' \<in> carrier G" "H #> x' \<in> A" by auto
    from x(1) have invx:"inv x \<in> carrier G" by (rule inv_closed)
    hence Hinvx:"H #> (inv x) \<in> carrier (G Mod H)" unfolding FactGroup_def RCOSETS_def by force
    with x' have "(inv\<^bsub>G Mod H\<^esub> (H #> inv x)) \<otimes>\<^bsub>G Mod H\<^esub> (H #> x') \<otimes>\<^bsub>G Mod H\<^esub> (H #> inv x) \<in> A" using invx Anormal.inv_op_closed1 by auto
    hence "(set_inv (H #> inv x)) <#> (H #> x') <#> (H #> inv x) \<in> A" using inv_FactGroup Hinvx unfolding FactGroup_def by auto
    hence "(H #> inv (inv x)) <#> (H #> x') <#> (H #> inv x) \<in> A" using invx by (metis rcos_inv)
    hence "(H #> x) <#> (H #> x') <#> (H #> inv x) \<in> A" by (metis inv_inv x(1))
    hence "(H #> (x \<otimes> x')) <#> (H #> inv x) \<in> A" by (metis rcos_sum x'(1) x(1))
    hence "H #> (x \<otimes> x' \<otimes> inv x) \<in> A" by (metis inv_closed m_closed rcos_sum x'(1) x(1))
    moreover have "x \<otimes> x' \<otimes> inv x \<in> carrier G" using x x' by (metis inv_closed m_closed)
    ultimately have "x \<otimes> x' \<otimes> inv x \<in> {x \<in> carrier G. H #> x \<in> A}" by auto
    hence xcoset:"(x \<otimes> x' \<otimes> inv x) \<otimes> x \<in> {x \<in> carrier G. H #> x \<in> A} #> x" unfolding r_coset_def using invx by auto
    have "(x \<otimes> x' \<otimes> inv x) \<otimes> x = (x \<otimes> x') \<otimes> (inv x \<otimes> x)" by (metis Units_eq Units_inv_Units m_assoc m_closed x'(1) x(1))
    also have "\<dots> = x \<otimes> x'" using x(1) l_inv x'(1) m_closed r_one by auto
    also have "\<dots> = y" by (metis `y = x \<otimes> x'`)
    finally have "x \<otimes> x' \<otimes> inv x \<otimes> x = y".
    with xcoset show "y \<in> {x \<in> carrier G. H #> x \<in> A} #> x" by auto
  qed
  with assms show ?thesis by (metis (full_types) factgroup_subgroup_union_char normal_imp_subgroup)
qed

lemma (in normal) factgroup_subgroup_union_factor:
  assumes "subgroup A (G Mod H)"
  shows "A = rcosets\<^bsub>G\<lparr>carrier := \<Union>A\<rparr>\<^esub> H"
proof -
  have "A = rcosets\<^bsub>G\<lparr>carrier := {x \<in> carrier G. H #> x \<in> A}\<rparr>\<^esub> H"
  proof auto
    fix U
    assume U:"U \<in> A"
    then obtain x' where x':"x' \<in> carrier G" "U = H #> x'" using assms subgroup_imp_subset unfolding FactGroup_def RCOSETS_def by force
    with U have "H #> x' \<in> A" by simp
    with x' show "U \<in> rcosets\<^bsub>G\<lparr>carrier := {x \<in> carrier G. H #> x \<in> A}\<rparr>\<^esub> H" unfolding RCOSETS_def r_coset_def by auto
  next
    fix U
    assume U:"U \<in> rcosets\<^bsub>G\<lparr>carrier := {x \<in> carrier G. H #> x \<in> A}\<rparr>\<^esub> H"
    then obtain x' where x':"x' \<in> {x \<in> carrier G. H #> x \<in> A}" "U = H #> x'" unfolding RCOSETS_def r_coset_def by auto
    hence "x' \<in> carrier G" "H #> x' \<in> A" by auto
    with x' show "U \<in> A" by simp
  qed
  with assms show ?thesis using factgroup_subgroup_union_char by auto
qed

section  {* Flattening the type of group carriers *}

text {* Flattening here means to convert the type of group elements from 'a set to 'a.
This is possible whenever the empty set is not an element of the group. *}

definition flatten where
  "flatten (G::('a set, 'b) monoid_scheme) rep = \<lparr>carrier=(rep ` (carrier G)),
      mult=(\<lambda> x y. rep ((the_inv_into (carrier G) rep x) \<otimes>\<^bsub>G\<^esub> (the_inv_into (carrier G) rep y))), one=rep \<one>\<^bsub>G\<^esub> \<rparr>"

lemma flatten_set_group_hom:
  assumes group:"group G"
  assumes inj:"inj_on rep (carrier G)"
  shows "rep \<in> hom G (flatten G rep)"
unfolding hom_def
proof auto
  fix g
  assume g:"g \<in> carrier G"
  thus "rep g \<in> carrier (flatten G rep)" unfolding flatten_def by auto
next
  fix g h
  assume g:"g \<in> carrier G" and h:"h \<in> carrier G"
  hence "rep g \<in> carrier (flatten G rep)" "rep h \<in> carrier (flatten G rep)" unfolding flatten_def by auto
  hence "rep g \<otimes>\<^bsub>flatten G rep\<^esub> rep h
    = rep (the_inv_into (carrier G) rep (rep g) \<otimes>\<^bsub>G\<^esub> the_inv_into (carrier G) rep (rep h))" unfolding flatten_def by auto
  also have "\<dots> = rep (g \<otimes>\<^bsub>G\<^esub> h)" using inj g h by (metis the_inv_into_f_f)
  finally show "rep (g \<otimes>\<^bsub>G\<^esub> h) = rep g \<otimes>\<^bsub>flatten G rep\<^esub> rep h"..
qed

lemma flatten_set_group:
  assumes group:"group G"
  assumes inj:"inj_on rep (carrier G)"
  shows "group (flatten G rep)"
proof (rule groupI)
  fix x y
  assume x:"x \<in> carrier (flatten G rep)" and y:"y \<in> carrier (flatten G rep)"
  def g \<equiv> "the_inv_into (carrier G) rep x" and h \<equiv> "the_inv_into (carrier G) rep y"
  hence "x \<otimes>\<^bsub>flatten G rep\<^esub> y = rep (g \<otimes>\<^bsub>G\<^esub> h)" unfolding flatten_def by auto
  moreover from g_def h_def have "g \<in> carrier G" "h \<in> carrier G"
    using inj x y the_inv_into_into unfolding flatten_def by (metis partial_object.select_convs(1) subset_refl)+
  hence "g \<otimes>\<^bsub>G\<^esub> h \<in> carrier G" by (metis group group.is_monoid monoid.m_closed)
  hence "rep (g \<otimes>\<^bsub>G\<^esub> h) \<in> carrier (flatten G rep)" unfolding flatten_def by simp
  ultimately show "x \<otimes>\<^bsub>flatten G rep\<^esub> y \<in> carrier (flatten G rep)" by simp
next
  show "\<one>\<^bsub>flatten G rep\<^esub> \<in> carrier (flatten G rep)" unfolding flatten_def by (simp add: group group.is_monoid)
next
  fix x y z
  assume x:"x \<in> carrier (flatten G rep)" and y:"y \<in> carrier (flatten G rep)" and z:"z \<in> carrier (flatten G rep)"
  def g \<equiv> "the_inv_into (carrier G) rep x" and h \<equiv> "the_inv_into (carrier G) rep y" and k \<equiv> "the_inv_into (carrier G) rep z"
  hence "x \<otimes>\<^bsub>flatten G rep\<^esub> y \<otimes>\<^bsub>flatten G rep\<^esub> z = (rep (g \<otimes>\<^bsub>G\<^esub> h)) \<otimes> \<^bsub>flatten G rep\<^esub> z" unfolding flatten_def by auto
  also have "\<dots> = rep (the_inv_into (carrier G) rep (rep (g \<otimes>\<^bsub>G\<^esub> h)) \<otimes>\<^bsub>G\<^esub> k)" using k_def unfolding flatten_def by auto
  also from g_def h_def k_def have ghkG:"g \<in> carrier G" "h \<in> carrier G" "k \<in> carrier G"
    using inj x y z the_inv_into_into unfolding flatten_def by fastforce+
  hence gh:"g \<otimes>\<^bsub>G\<^esub> h \<in> carrier G" and hk:"h \<otimes>\<^bsub>G\<^esub> k \<in> carrier G" by (metis group group.is_monoid monoid.m_closed)+
  hence "rep (the_inv_into (carrier G) rep (rep (g \<otimes>\<^bsub>G\<^esub> h)) \<otimes>\<^bsub>G\<^esub> k) = rep ((g \<otimes>\<^bsub>G\<^esub> h) \<otimes>\<^bsub>G\<^esub> k)"
    unfolding flatten_def using inj the_inv_into_f_f by fastforce
  also have "\<dots> = rep (g \<otimes>\<^bsub>G\<^esub> (h \<otimes>\<^bsub>G\<^esub> k))" using group group.is_monoid ghkG monoid.m_assoc by fastforce
  also have "\<dots> = x \<otimes>\<^bsub>flatten G rep\<^esub> (rep (h \<otimes>\<^bsub>G\<^esub> k))" unfolding g_def flatten_def using hk inj the_inv_into_f_f by fastforce
  also have "\<dots> = x \<otimes>\<^bsub>flatten G rep\<^esub> (y \<otimes>\<^bsub>flatten G rep\<^esub> z)" unfolding h_def k_def flatten_def using x y by force
  finally show "x \<otimes>\<^bsub>flatten G rep\<^esub> y \<otimes>\<^bsub>flatten G rep\<^esub> z = x \<otimes>\<^bsub>flatten G rep\<^esub> (y \<otimes>\<^bsub>flatten G rep\<^esub> z)".
next
  fix x
  assume x:"x \<in> carrier (flatten G rep)"
  def g \<equiv> "the_inv_into (carrier G) rep x"
  hence gG:"g \<in> carrier G" using inj x unfolding flatten_def using the_inv_into_into by force
  have "\<one>\<^bsub>G\<^esub> \<in> (carrier G)" by (simp add: group group.is_monoid)
  hence "the_inv_into (carrier G) rep (\<one>\<^bsub>flatten G rep\<^esub>) = \<one>\<^bsub>G\<^esub>" unfolding flatten_def using the_inv_into_f_f inj by force
  hence "\<one>\<^bsub>flatten G rep\<^esub> \<otimes>\<^bsub>flatten G rep\<^esub> x = rep (\<one>\<^bsub>G\<^esub> \<otimes>\<^bsub>G\<^esub> g)" unfolding flatten_def g_def by simp
  also have "\<dots> = rep g" using gG group by (metis group.is_monoid monoid.l_one)
  also have "\<dots> = x" unfolding g_def using inj x f_the_inv_into_f unfolding flatten_def by force
  finally show "\<one>\<^bsub>flatten G rep\<^esub> \<otimes>\<^bsub>flatten G rep\<^esub> x = x".
next
  from group inj have hom:"rep \<in> hom G (flatten G rep)" using flatten_set_group_hom by auto
  fix x
  assume x:"x \<in> carrier (flatten G rep)"
  def g \<equiv> "the_inv_into (carrier G) rep x"
  hence gG:"g \<in> carrier G" using inj x unfolding flatten_def using the_inv_into_into by force
  hence invG:"inv\<^bsub>G\<^esub> g \<in> carrier G" by (metis group group.inv_closed)
  hence "rep (inv\<^bsub>G\<^esub> g) \<in> carrier (flatten G rep)" unfolding flatten_def by auto
  moreover have "rep (inv\<^bsub>G\<^esub> g) \<otimes>\<^bsub>flatten G rep\<^esub> x = rep (inv\<^bsub>G\<^esub> g) \<otimes>\<^bsub>flatten G rep\<^esub> (rep g)"
    unfolding g_def using f_the_inv_into_f inj x unfolding flatten_def by fastforce
  hence "rep (inv\<^bsub>G\<^esub> g) \<otimes>\<^bsub>flatten G rep\<^esub> x = rep (inv\<^bsub>G\<^esub> g \<otimes>\<^bsub>G\<^esub> g)"
    using hom unfolding hom_def using gG invG hom_def by auto
  hence "rep (inv\<^bsub>G\<^esub> g) \<otimes>\<^bsub>flatten G rep\<^esub> x = rep \<one>\<^bsub>G\<^esub>" using invG gG by (metis group group.l_inv)
  hence "rep (inv\<^bsub>G\<^esub> g) \<otimes>\<^bsub>flatten G rep\<^esub> x = \<one>\<^bsub>flatten G rep\<^esub>" unfolding flatten_def by auto
  ultimately show "\<exists>y\<in>carrier (flatten G rep). y \<otimes>\<^bsub>flatten G rep\<^esub> x = \<one>\<^bsub>flatten G rep\<^esub>" by auto
qed

lemma (in normal) flatten_set_group_mod_inj:
  shows "inj_on (\<lambda>U. SOME g. g \<in> U) (carrier (G Mod H))"
proof (rule inj_onI)
  fix U V
  assume U:"U \<in> carrier (G Mod H)" and V:"V \<in> carrier (G Mod H)"
  then obtain g h where g:"U = H #> g" "g \<in> carrier G" and h:"V = H #> h" "h \<in> carrier G"
    unfolding FactGroup_def RCOSETS_def by auto
  hence notempty:"U \<noteq> {}" "V \<noteq> {}" by (metis empty_iff is_subgroup rcos_self)+
  assume "(SOME g. g \<in> U) = (SOME g. g \<in> V)"
  with notempty have "(SOME g. g \<in> U) \<in> U \<inter> V" by (metis IntI ex_in_conv someI)
  thus "U = V" by (metis Int_iff g h is_subgroup repr_independence)
qed

lemma (in normal) flatten_set_group_mod:
  shows "group (flatten (G Mod H) (\<lambda>U. SOME g. g \<in> U))"
using factorgroup_is_group flatten_set_group_mod_inj by (rule flatten_set_group)

lemma (in normal) flatten_set_group_mod_iso:
  shows "(\<lambda>U. SOME g. g \<in> U) \<in> (G Mod H) \<cong> (flatten (G Mod H) (\<lambda>U. SOME g. g \<in> U))"
unfolding iso_def bij_betw_def
apply (auto)
 apply (metis flatten_set_group_mod_inj factorgroup_is_group flatten_set_group_hom)
 apply (rule flatten_set_group_mod_inj)
 unfolding flatten_def apply (auto)
done

end


(*  Title:    HOL/Analysis/Integral_Test.thy
    Author:   Manuel Eberl, TU München
*)

section \<open>Integral Test for Summability\<close>

theory Integral_Test
imports Henstock_Kurzweil_Integration
begin

text \<open>
  The integral test for summability. We show here that for a decreasing non-negative
  function, the infinite sum over that function evaluated at the natural numbers
  converges iff the corresponding integral converges.

  As a useful side result, we also provide some results on the difference between
  the integral and the partial sum. (This is useful e.g. for the definition of the
  Euler-Mascheroni constant)
\<close>

(* TODO: continuous_in \<rightarrow> integrable_on *)
locale antimono_fun_sum_integral_diff =
  fixes f :: "real \<Rightarrow> real"
  assumes dec: "\<And>x y. x \<ge> 0 \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<ge> f y"
  assumes nonneg: "\<And>x. x \<ge> 0 \<Longrightarrow> f x \<ge> 0"
  assumes cont: "continuous_on {0..} f"
begin

definition "sum_integral_diff_series n = (\<Sum>k\<le>n. f (of_nat k)) - (integral {0..of_nat n} f)"

lemma sum_integral_diff_series_nonneg:
  "sum_integral_diff_series n \<ge> 0"
proof -
  note int = integrable_continuous_real[OF continuous_on_subset[OF cont]]
  let ?int = "\<lambda>a b. integral {of_nat a..of_nat b} f"
  have "-sum_integral_diff_series n = ?int 0 n - (\<Sum>k\<le>n. f (of_nat k))"
    by (simp add: sum_integral_diff_series_def)
  also have "?int 0 n = (\<Sum>k<n. ?int k (Suc k))"
  proof (induction n)
    case (Suc n)
    have "?int 0 (Suc n) = ?int 0 n + ?int n (Suc n)"
      by (intro integral_combine[symmetric] int) simp_all
    with Suc show ?case by simp
  qed simp_all
  also have "... \<le> (\<Sum>k<n. integral {of_nat k..of_nat (Suc k)} (\<lambda>_::real. f (of_nat k)))"
    by (intro sum_mono integral_le int) (auto intro: dec)
  also have "... = (\<Sum>k<n. f (of_nat k))" by simp
  also have "\<dots> - (\<Sum>k\<le>n. f (of_nat k)) = -(\<Sum>k\<in>{..n} - {..<n}. f (of_nat k))"
    by (subst sum_diff) auto
  also have "\<dots> \<le> 0" by (auto intro!: sum_nonneg nonneg)
  finally show "sum_integral_diff_series n \<ge> 0" by simp
qed

lemma sum_integral_diff_series_antimono:
  assumes "m \<le> n"
  shows   "sum_integral_diff_series m \<ge> sum_integral_diff_series n"
proof -
  let ?int = "\<lambda>a b. integral {of_nat a..of_nat b} f"
  note int = integrable_continuous_real[OF continuous_on_subset[OF cont]]
  have d_mono: "sum_integral_diff_series (Suc n) \<le> sum_integral_diff_series n" for n
  proof -
    fix n :: nat
    have "sum_integral_diff_series (Suc n) - sum_integral_diff_series n =
            f (of_nat (Suc n)) + (?int 0 n - ?int 0 (Suc n))"
      unfolding sum_integral_diff_series_def by (simp add: algebra_simps)
    also have "?int 0 n - ?int 0 (Suc n) = -?int n (Suc n)"
      by (subst integral_combine [symmetric, of "of_nat 0" "of_nat n" "of_nat (Suc n)"])
         (auto intro!: int simp: algebra_simps)
    also have "?int n (Suc n) \<ge> integral {of_nat n..of_nat (Suc n)} (\<lambda>_::real. f (of_nat (Suc n)))"
      by (intro integral_le int) (auto intro: dec)
    hence "f (of_nat (Suc n)) + -?int n (Suc n) \<le> 0" by (simp add: algebra_simps)
    finally show "sum_integral_diff_series (Suc n) \<le> sum_integral_diff_series n" by simp
  qed
  with assms show ?thesis
    by (induction rule: inc_induct) (auto intro: order.trans[OF _ d_mono])
qed

lemma sum_integral_diff_series_Bseq: "Bseq sum_integral_diff_series"
proof -
  from sum_integral_diff_series_nonneg and sum_integral_diff_series_antimono
    have "norm (sum_integral_diff_series n) \<le> sum_integral_diff_series 0" for n by simp
  thus "Bseq sum_integral_diff_series" by (rule BseqI')
qed

lemma sum_integral_diff_series_monoseq: "monoseq sum_integral_diff_series"
  using sum_integral_diff_series_antimono unfolding monoseq_def by blast

lemma sum_integral_diff_series_convergent: "convergent sum_integral_diff_series"
  using sum_integral_diff_series_Bseq sum_integral_diff_series_monoseq
  by (blast intro!: Bseq_monoseq_convergent)

lemma integral_test:
  "summable (\<lambda>n. f (of_nat n)) \<longleftrightarrow> convergent (\<lambda>n. integral {0..of_nat n} f)"
proof -
  have "summable (\<lambda>n. f (of_nat n)) \<longleftrightarrow> convergent (\<lambda>n. \<Sum>k\<le>n. f (of_nat k))"
    by (simp add: summable_iff_convergent')
  also have "... \<longleftrightarrow> convergent (\<lambda>n. integral {0..of_nat n} f)"
  proof
    assume "convergent (\<lambda>n. \<Sum>k\<le>n. f (of_nat k))"
    from convergent_diff[OF this sum_integral_diff_series_convergent]
      show "convergent (\<lambda>n. integral {0..of_nat n} f)"
        unfolding sum_integral_diff_series_def by simp
  next
    assume "convergent (\<lambda>n. integral {0..of_nat n} f)"
    from convergent_add[OF this sum_integral_diff_series_convergent]
      show "convergent (\<lambda>n. \<Sum>k\<le>n. f (of_nat k))" unfolding sum_integral_diff_series_def by simp
  qed
  finally show ?thesis by simp
qed

end

end


(*  Title:      HOL/Nonstandard_Analysis/HSEQ.thy
    Author:     Jacques D. Fleuriot
    Copyright:  1998  University of Cambridge

Convergence of sequences and series.

Conversion to Isar and new proofs by Lawrence C Paulson, 2004
Additional contributions by Jeremy Avigad and Brian Huffman.
*)

section \<open>Sequences and Convergence (Nonstandard)\<close>

theory HSEQ
  imports Limits NatStar
  abbrevs "--->" = "\<longlonglongrightarrow>\<^sub>N\<^sub>S"
begin

definition
  NSLIMSEQ :: "[nat => 'a::real_normed_vector, 'a] => bool"
    ("((_)/ \<longlonglongrightarrow>\<^sub>N\<^sub>S (_))" [60, 60] 60) where
    \<comment>\<open>Nonstandard definition of convergence of sequence\<close>
  "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L = (\<forall>N \<in> HNatInfinite. ( *f* X) N \<approx> star_of L)"

definition
  nslim :: "(nat => 'a::real_normed_vector) => 'a" where
    \<comment>\<open>Nonstandard definition of limit using choice operator\<close>
  "nslim X = (THE L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"

definition
  NSconvergent :: "(nat => 'a::real_normed_vector) => bool" where
    \<comment>\<open>Nonstandard definition of convergence\<close>
  "NSconvergent X = (\<exists>L. X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"

definition
  NSBseq :: "(nat => 'a::real_normed_vector) => bool" where
    \<comment>\<open>Nonstandard definition for bounded sequence\<close>
  "NSBseq X = (\<forall>N \<in> HNatInfinite. ( *f* X) N : HFinite)"

definition
  NSCauchy :: "(nat => 'a::real_normed_vector) => bool" where
    \<comment>\<open>Nonstandard definition\<close>
  "NSCauchy X = (\<forall>M \<in> HNatInfinite. \<forall>N \<in> HNatInfinite. ( *f* X) M \<approx> ( *f* X) N)"

subsection \<open>Limits of Sequences\<close>

lemma NSLIMSEQ_iff:
    "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S L) = (\<forall>N \<in> HNatInfinite. ( *f* X) N \<approx> star_of L)"
by (simp add: NSLIMSEQ_def)

lemma NSLIMSEQ_I:
  "(\<And>N. N \<in> HNatInfinite \<Longrightarrow> starfun X N \<approx> star_of L) \<Longrightarrow> X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
by (simp add: NSLIMSEQ_def)

lemma NSLIMSEQ_D:
  "\<lbrakk>X \<longlonglongrightarrow>\<^sub>N\<^sub>S L; N \<in> HNatInfinite\<rbrakk> \<Longrightarrow> starfun X N \<approx> star_of L"
by (simp add: NSLIMSEQ_def)

lemma NSLIMSEQ_const: "(%n. k) \<longlonglongrightarrow>\<^sub>N\<^sub>S k"
by (simp add: NSLIMSEQ_def)

lemma NSLIMSEQ_add:
      "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n + Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + b"
by (auto intro: approx_add simp add: NSLIMSEQ_def starfun_add [symmetric])

lemma NSLIMSEQ_add_const: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S a ==> (%n.(f n + b)) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + b"
by (simp only: NSLIMSEQ_add NSLIMSEQ_const)

lemma NSLIMSEQ_mult:
  fixes a b :: "'a::real_normed_algebra"
  shows "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n * Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a * b"
by (auto intro!: approx_mult_HFinite simp add: NSLIMSEQ_def)

lemma NSLIMSEQ_minus: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a ==> (%n. -(X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S -a"
by (auto simp add: NSLIMSEQ_def)

lemma NSLIMSEQ_minus_cancel: "(%n. -(X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S -a ==> X \<longlonglongrightarrow>\<^sub>N\<^sub>S a"
by (drule NSLIMSEQ_minus, simp)

lemma NSLIMSEQ_diff:
     "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n - Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a - b"
  using NSLIMSEQ_add [of X a "- Y" "- b"] by (simp add: NSLIMSEQ_minus fun_Compl_def)

(* FIXME: delete *)
lemma NSLIMSEQ_add_minus:
     "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> (%n. X n + -Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a + -b"
  by (simp add: NSLIMSEQ_diff)

lemma NSLIMSEQ_diff_const: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S a ==> (%n.(f n - b)) \<longlonglongrightarrow>\<^sub>N\<^sub>S a - b"
by (simp add: NSLIMSEQ_diff NSLIMSEQ_const)

lemma NSLIMSEQ_inverse:
  fixes a :: "'a::real_normed_div_algebra"
  shows "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a;  a ~= 0 |] ==> (%n. inverse(X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S inverse(a)"
by (simp add: NSLIMSEQ_def star_of_approx_inverse)

lemma NSLIMSEQ_mult_inverse:
  fixes a b :: "'a::real_normed_field"
  shows
     "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a;  Y \<longlonglongrightarrow>\<^sub>N\<^sub>S b;  b ~= 0 |] ==> (%n. X n / Y n) \<longlonglongrightarrow>\<^sub>N\<^sub>S a/b"
by (simp add: NSLIMSEQ_mult NSLIMSEQ_inverse divide_inverse)

lemma starfun_hnorm: "\<And>x. hnorm (( *f* f) x) = ( *f* (\<lambda>x. norm (f x))) x"
by transfer simp

lemma NSLIMSEQ_norm: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S a \<Longrightarrow> (\<lambda>n. norm (X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S norm a"
by (simp add: NSLIMSEQ_def starfun_hnorm [symmetric] approx_hnorm)

text\<open>Uniqueness of limit\<close>
lemma NSLIMSEQ_unique: "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S a; X \<longlonglongrightarrow>\<^sub>N\<^sub>S b |] ==> a = b"
apply (simp add: NSLIMSEQ_def)
apply (drule HNatInfinite_whn [THEN [2] bspec])+
apply (auto dest: approx_trans3)
done

lemma NSLIMSEQ_pow [rule_format]:
  fixes a :: "'a::{real_normed_algebra,power}"
  shows "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S a) --> ((%n. (X n) ^ m) \<longlonglongrightarrow>\<^sub>N\<^sub>S a ^ m)"
apply (induct "m")
apply (auto simp add: power_Suc intro: NSLIMSEQ_mult NSLIMSEQ_const)
done

text\<open>We can now try and derive a few properties of sequences,
     starting with the limit comparison property for sequences.\<close>

lemma NSLIMSEQ_le:
       "[| f \<longlonglongrightarrow>\<^sub>N\<^sub>S l; g \<longlonglongrightarrow>\<^sub>N\<^sub>S m;
           \<exists>N. \<forall>n \<ge> N. f(n) \<le> g(n)
        |] ==> l \<le> (m::real)"
apply (simp add: NSLIMSEQ_def, safe)
apply (drule starfun_le_mono)
apply (drule HNatInfinite_whn [THEN [2] bspec])+
apply (drule_tac x = whn in spec)
apply (drule bex_Infinitesimal_iff2 [THEN iffD2])+
apply clarify
apply (auto intro: hypreal_of_real_le_add_Infininitesimal_cancel2)
done

lemma NSLIMSEQ_le_const: "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S (r::real); \<forall>n. a \<le> X n |] ==> a \<le> r"
by (erule NSLIMSEQ_le [OF NSLIMSEQ_const], auto)

lemma NSLIMSEQ_le_const2: "[| X \<longlonglongrightarrow>\<^sub>N\<^sub>S (r::real); \<forall>n. X n \<le> a |] ==> r \<le> a"
by (erule NSLIMSEQ_le [OF _ NSLIMSEQ_const], auto)

text\<open>Shift a convergent series by 1:
  By the equivalence between Cauchiness and convergence and because
  the successor of an infinite hypernatural is also infinite.\<close>

lemma NSLIMSEQ_Suc: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S l ==> (%n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l"
apply (unfold NSLIMSEQ_def, safe)
apply (drule_tac x="N + 1" in bspec)
apply (erule HNatInfinite_add)
apply (simp add: starfun_shift_one)
done

lemma NSLIMSEQ_imp_Suc: "(%n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l ==> f \<longlonglongrightarrow>\<^sub>N\<^sub>S l"
apply (unfold NSLIMSEQ_def, safe)
apply (drule_tac x="N - 1" in bspec)
apply (erule Nats_1 [THEN [2] HNatInfinite_diff])
apply (simp add: starfun_shift_one one_le_HNatInfinite)
done

lemma NSLIMSEQ_Suc_iff: "((%n. f(Suc n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S l) = (f \<longlonglongrightarrow>\<^sub>N\<^sub>S l)"
by (blast intro: NSLIMSEQ_imp_Suc NSLIMSEQ_Suc)

subsubsection \<open>Equivalence of @{term LIMSEQ} and @{term NSLIMSEQ}\<close>

lemma LIMSEQ_NSLIMSEQ:
  assumes X: "X \<longlonglongrightarrow> L" shows "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L"
proof (rule NSLIMSEQ_I)
  fix N assume N: "N \<in> HNatInfinite"
  have "starfun X N - star_of L \<in> Infinitesimal"
  proof (rule InfinitesimalI2)
    fix r::real assume r: "0 < r"
    from LIMSEQ_D [OF X r]
    obtain no where "\<forall>n\<ge>no. norm (X n - L) < r" ..
    hence "\<forall>n\<ge>star_of no. hnorm (starfun X n - star_of L) < star_of r"
      by transfer
    thus "hnorm (starfun X N - star_of L) < star_of r"
      using N by (simp add: star_of_le_HNatInfinite)
  qed
  thus "starfun X N \<approx> star_of L"
    by (unfold approx_def)
qed

lemma NSLIMSEQ_LIMSEQ:
  assumes X: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L" shows "X \<longlonglongrightarrow> L"
proof (rule LIMSEQ_I)
  fix r::real assume r: "0 < r"
  have "\<exists>no. \<forall>n\<ge>no. hnorm (starfun X n - star_of L) < star_of r"
  proof (intro exI allI impI)
    fix n assume "whn \<le> n"
    with HNatInfinite_whn have "n \<in> HNatInfinite"
      by (rule HNatInfinite_upward_closed)
    with X have "starfun X n \<approx> star_of L"
      by (rule NSLIMSEQ_D)
    hence "starfun X n - star_of L \<in> Infinitesimal"
      by (unfold approx_def)
    thus "hnorm (starfun X n - star_of L) < star_of r"
      using r by (rule InfinitesimalD2)
  qed
  thus "\<exists>no. \<forall>n\<ge>no. norm (X n - L) < r"
    by transfer
qed

theorem LIMSEQ_NSLIMSEQ_iff: "(f \<longlonglongrightarrow> L) = (f \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
by (blast intro: LIMSEQ_NSLIMSEQ NSLIMSEQ_LIMSEQ)

subsubsection \<open>Derived theorems about @{term NSLIMSEQ}\<close>

text\<open>We prove the NS version from the standard one, since the NS proof
   seems more complicated than the standard one above!\<close>
lemma NSLIMSEQ_norm_zero: "((\<lambda>n. norm (X n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0) = (X \<longlonglongrightarrow>\<^sub>N\<^sub>S 0)"
by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] tendsto_norm_zero_iff)

lemma NSLIMSEQ_rabs_zero: "((%n. \<bar>f n\<bar>) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0) = (f \<longlonglongrightarrow>\<^sub>N\<^sub>S (0::real))"
by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] tendsto_rabs_zero_iff)

text\<open>Generalization to other limits\<close>
lemma NSLIMSEQ_imp_rabs: "f \<longlonglongrightarrow>\<^sub>N\<^sub>S (l::real) ==> (%n. \<bar>f n\<bar>) \<longlonglongrightarrow>\<^sub>N\<^sub>S \<bar>l\<bar>"
apply (simp add: NSLIMSEQ_def)
apply (auto intro: approx_hrabs
            simp add: starfun_abs)
done

lemma NSLIMSEQ_inverse_zero:
     "\<forall>y::real. \<exists>N. \<forall>n \<ge> N. y < f(n)
      ==> (%n. inverse(f n)) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_zero)

lemma NSLIMSEQ_inverse_real_of_nat: "(%n. inverse(real(Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_real_of_nat del: of_nat_Suc)

lemma NSLIMSEQ_inverse_real_of_nat_add:
     "(%n. r + inverse(real(Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric] LIMSEQ_inverse_real_of_nat_add del: of_nat_Suc)

lemma NSLIMSEQ_inverse_real_of_nat_add_minus:
     "(%n. r + -inverse(real(Suc n))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  using LIMSEQ_inverse_real_of_nat_add_minus by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric])

lemma NSLIMSEQ_inverse_real_of_nat_add_minus_mult:
     "(%n. r*( 1 + -inverse(real(Suc n)))) \<longlonglongrightarrow>\<^sub>N\<^sub>S r"
  using LIMSEQ_inverse_real_of_nat_add_minus_mult by (simp add: LIMSEQ_NSLIMSEQ_iff [symmetric])

subsection \<open>Convergence\<close>

lemma nslimI: "X \<longlonglongrightarrow>\<^sub>N\<^sub>S L ==> nslim X = L"
apply (simp add: nslim_def)
apply (blast intro: NSLIMSEQ_unique)
done

lemma lim_nslim_iff: "lim X = nslim X"
by (simp add: lim_def nslim_def LIMSEQ_NSLIMSEQ_iff)

lemma NSconvergentD: "NSconvergent X ==> \<exists>L. (X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
by (simp add: NSconvergent_def)

lemma NSconvergentI: "(X \<longlonglongrightarrow>\<^sub>N\<^sub>S L) ==> NSconvergent X"
by (auto simp add: NSconvergent_def)

lemma convergent_NSconvergent_iff: "convergent X = NSconvergent X"
by (simp add: convergent_def NSconvergent_def LIMSEQ_NSLIMSEQ_iff)

lemma NSconvergent_NSLIMSEQ_iff: "NSconvergent X = (X \<longlonglongrightarrow>\<^sub>N\<^sub>S nslim X)"
by (auto intro: theI NSLIMSEQ_unique simp add: NSconvergent_def nslim_def)

subsection \<open>Bounded Monotonic Sequences\<close>

lemma NSBseqD: "[| NSBseq X;  N: HNatInfinite |] ==> ( *f* X) N : HFinite"
by (simp add: NSBseq_def)

lemma Standard_subset_HFinite: "Standard \<subseteq> HFinite"
unfolding Standard_def by auto

lemma NSBseqD2: "NSBseq X \<Longrightarrow> ( *f* X) N \<in> HFinite"
apply (cases "N \<in> HNatInfinite")
apply (erule (1) NSBseqD)
apply (rule subsetD [OF Standard_subset_HFinite])
apply (simp add: HNatInfinite_def Nats_eq_Standard)
done

lemma NSBseqI: "\<forall>N \<in> HNatInfinite. ( *f* X) N : HFinite ==> NSBseq X"
by (simp add: NSBseq_def)

text\<open>The standard definition implies the nonstandard definition\<close>

lemma Bseq_NSBseq: "Bseq X ==> NSBseq X"
proof (unfold NSBseq_def, safe)
  assume X: "Bseq X"
  fix N assume N: "N \<in> HNatInfinite"
  from BseqD [OF X] obtain K where "\<forall>n. norm (X n) \<le> K" by fast
  hence "\<forall>N. hnorm (starfun X N) \<le> star_of K" by transfer
  hence "hnorm (starfun X N) \<le> star_of K" by simp
  also have "star_of K < star_of (K + 1)" by simp
  finally have "\<exists>x\<in>Reals. hnorm (starfun X N) < x" by (rule bexI, simp)
  thus "starfun X N \<in> HFinite" by (simp add: HFinite_def)
qed

text\<open>The nonstandard definition implies the standard definition\<close>

lemma SReal_less_omega: "r \<in> \<real> \<Longrightarrow> r < \<omega>"
apply (insert HInfinite_omega)
apply (simp add: HInfinite_def)
apply (simp add: order_less_imp_le)
done

lemma NSBseq_Bseq: "NSBseq X \<Longrightarrow> Bseq X"
proof (rule ccontr)
  let ?n = "\<lambda>K. LEAST n. K < norm (X n)"
  assume "NSBseq X"
  hence finite: "( *f* X) (( *f* ?n) \<omega>) \<in> HFinite"
    by (rule NSBseqD2)
  assume "\<not> Bseq X"
  hence "\<forall>K>0. \<exists>n. K < norm (X n)"
    by (simp add: Bseq_def linorder_not_le)
  hence "\<forall>K>0. K < norm (X (?n K))"
    by (auto intro: LeastI_ex)
  hence "\<forall>K>0. K < hnorm (( *f* X) (( *f* ?n) K))"
    by transfer
  hence "\<omega> < hnorm (( *f* X) (( *f* ?n) \<omega>))"
    by simp
  hence "\<forall>r\<in>\<real>. r < hnorm (( *f* X) (( *f* ?n) \<omega>))"
    by (simp add: order_less_trans [OF SReal_less_omega])
  hence "( *f* X) (( *f* ?n) \<omega>) \<in> HInfinite"
    by (simp add: HInfinite_def)
  with finite show "False"
    by (simp add: HFinite_HInfinite_iff)
qed

text\<open>Equivalence of nonstandard and standard definitions
  for a bounded sequence\<close>
lemma Bseq_NSBseq_iff: "(Bseq X) = (NSBseq X)"
by (blast intro!: NSBseq_Bseq Bseq_NSBseq)

text\<open>A convergent sequence is bounded:
 Boundedness as a necessary condition for convergence.
 The nonstandard version has no existential, as usual\<close>

lemma NSconvergent_NSBseq: "NSconvergent X ==> NSBseq X"
apply (simp add: NSconvergent_def NSBseq_def NSLIMSEQ_def)
apply (blast intro: HFinite_star_of approx_sym approx_HFinite)
done

text\<open>Standard Version: easily now proved using equivalence of NS and
 standard definitions\<close>

lemma convergent_Bseq: "convergent X ==> Bseq (X::nat \<Rightarrow> _::real_normed_vector)"
by (simp add: NSconvergent_NSBseq convergent_NSconvergent_iff Bseq_NSBseq_iff)

subsubsection\<open>Upper Bounds and Lubs of Bounded Sequences\<close>

lemma NSBseq_isUb: "NSBseq X ==> \<exists>U::real. isUb UNIV {x. \<exists>n. X n = x} U"
by (simp add: Bseq_NSBseq_iff [symmetric] Bseq_isUb)

lemma NSBseq_isLub: "NSBseq X ==> \<exists>U::real. isLub UNIV {x. \<exists>n. X n = x} U"
by (simp add: Bseq_NSBseq_iff [symmetric] Bseq_isLub)

subsubsection\<open>A Bounded and Monotonic Sequence Converges\<close>

text\<open>The best of both worlds: Easier to prove this result as a standard
   theorem and then use equivalence to "transfer" it into the
   equivalent nonstandard form if needed!\<close>

lemma Bmonoseq_NSLIMSEQ: "\<forall>n \<ge> m. X n = X m ==> \<exists>L. (X \<longlonglongrightarrow>\<^sub>N\<^sub>S L)"
by (auto dest!: Bmonoseq_LIMSEQ simp add: LIMSEQ_NSLIMSEQ_iff)

lemma NSBseq_mono_NSconvergent:
     "[| NSBseq X; \<forall>m. \<forall>n \<ge> m. X m \<le> X n |] ==> NSconvergent (X::nat=>real)"
by (auto intro: Bseq_mono_convergent
         simp add: convergent_NSconvergent_iff [symmetric]
                   Bseq_NSBseq_iff [symmetric])

subsection \<open>Cauchy Sequences\<close>

lemma NSCauchyI:
  "(\<And>M N. \<lbrakk>M \<in> HNatInfinite; N \<in> HNatInfinite\<rbrakk> \<Longrightarrow> starfun X M \<approx> starfun X N)
   \<Longrightarrow> NSCauchy X"
by (simp add: NSCauchy_def)

lemma NSCauchyD:
  "\<lbrakk>NSCauchy X; M \<in> HNatInfinite; N \<in> HNatInfinite\<rbrakk>
   \<Longrightarrow> starfun X M \<approx> starfun X N"
by (simp add: NSCauchy_def)

subsubsection\<open>Equivalence Between NS and Standard\<close>

lemma Cauchy_NSCauchy:
  assumes X: "Cauchy X" shows "NSCauchy X"
proof (rule NSCauchyI)
  fix M assume M: "M \<in> HNatInfinite"
  fix N assume N: "N \<in> HNatInfinite"
  have "starfun X M - starfun X N \<in> Infinitesimal"
  proof (rule InfinitesimalI2)
    fix r :: real assume r: "0 < r"
    from CauchyD [OF X r]
    obtain k where "\<forall>m\<ge>k. \<forall>n\<ge>k. norm (X m - X n) < r" ..
    hence "\<forall>m\<ge>star_of k. \<forall>n\<ge>star_of k.
           hnorm (starfun X m - starfun X n) < star_of r"
      by transfer
    thus "hnorm (starfun X M - starfun X N) < star_of r"
      using M N by (simp add: star_of_le_HNatInfinite)
  qed
  thus "starfun X M \<approx> starfun X N"
    by (unfold approx_def)
qed

lemma NSCauchy_Cauchy:
  assumes X: "NSCauchy X" shows "Cauchy X"
proof (rule CauchyI)
  fix r::real assume r: "0 < r"
  have "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. hnorm (starfun X m - starfun X n) < star_of r"
  proof (intro exI allI impI)
    fix M assume "whn \<le> M"
    with HNatInfinite_whn have M: "M \<in> HNatInfinite"
      by (rule HNatInfinite_upward_closed)
    fix N assume "whn \<le> N"
    with HNatInfinite_whn have N: "N \<in> HNatInfinite"
      by (rule HNatInfinite_upward_closed)
    from X M N have "starfun X M \<approx> starfun X N"
      by (rule NSCauchyD)
    hence "starfun X M - starfun X N \<in> Infinitesimal"
      by (unfold approx_def)
    thus "hnorm (starfun X M - starfun X N) < star_of r"
      using r by (rule InfinitesimalD2)
  qed
  thus "\<exists>k. \<forall>m\<ge>k. \<forall>n\<ge>k. norm (X m - X n) < r"
    by transfer
qed

theorem NSCauchy_Cauchy_iff: "NSCauchy X = Cauchy X"
by (blast intro!: NSCauchy_Cauchy Cauchy_NSCauchy)

subsubsection \<open>Cauchy Sequences are Bounded\<close>

text\<open>A Cauchy sequence is bounded -- nonstandard version\<close>

lemma NSCauchy_NSBseq: "NSCauchy X ==> NSBseq X"
by (simp add: Cauchy_Bseq Bseq_NSBseq_iff [symmetric] NSCauchy_Cauchy_iff)

subsubsection \<open>Cauchy Sequences are Convergent\<close>

text\<open>Equivalence of Cauchy criterion and convergence:
  We will prove this using our NS formulation which provides a
  much easier proof than using the standard definition. We do not
  need to use properties of subsequences such as boundedness,
  monotonicity etc... Compare with Harrison's corresponding proof
  in HOL which is much longer and more complicated. Of course, we do
  not have problems which he encountered with guessing the right
  instantiations for his 'espsilon-delta' proof(s) in this case
  since the NS formulations do not involve existential quantifiers.\<close>

lemma NSconvergent_NSCauchy: "NSconvergent X \<Longrightarrow> NSCauchy X"
apply (simp add: NSconvergent_def NSLIMSEQ_def NSCauchy_def, safe)
apply (auto intro: approx_trans2)
done

lemma real_NSCauchy_NSconvergent:
  fixes X :: "nat \<Rightarrow> real"
  shows "NSCauchy X \<Longrightarrow> NSconvergent X"
apply (simp add: NSconvergent_def NSLIMSEQ_def)
apply (frule NSCauchy_NSBseq)
apply (simp add: NSBseq_def NSCauchy_def)
apply (drule HNatInfinite_whn [THEN [2] bspec])
apply (drule HNatInfinite_whn [THEN [2] bspec])
apply (auto dest!: st_part_Ex simp add: SReal_iff)
apply (blast intro: approx_trans3)
done

lemma NSCauchy_NSconvergent:
  fixes X :: "nat \<Rightarrow> 'a::banach"
  shows "NSCauchy X \<Longrightarrow> NSconvergent X"
apply (drule NSCauchy_Cauchy [THEN Cauchy_convergent])
apply (erule convergent_NSconvergent_iff [THEN iffD1])
done

lemma NSCauchy_NSconvergent_iff:
  fixes X :: "nat \<Rightarrow> 'a::banach"
  shows "NSCauchy X = NSconvergent X"
by (fast intro: NSCauchy_NSconvergent NSconvergent_NSCauchy)

subsection \<open>Power Sequences\<close>

text\<open>The sequence @{term "x^n"} tends to 0 if @{term "0\<le>x"} and @{term
"x<1"}.  Proof will use (NS) Cauchy equivalence for convergence and
  also fact that bounded and monotonic sequence converges.\<close>

text\<open>We now use NS criterion to bring proof of theorem through\<close>

lemma NSLIMSEQ_realpow_zero:
  "[| 0 \<le> (x::real); x < 1 |] ==> (%n. x ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
apply (simp add: NSLIMSEQ_def)
apply (auto dest!: convergent_realpow simp add: convergent_NSconvergent_iff)
apply (frule NSconvergentD)
apply (auto simp add: NSLIMSEQ_def NSCauchy_NSconvergent_iff [symmetric] NSCauchy_def starfun_pow)
apply (frule HNatInfinite_add_one)
apply (drule bspec, assumption)
apply (drule bspec, assumption)
apply (drule_tac x = "N + (1::hypnat) " in bspec, assumption)
apply (simp add: hyperpow_add)
apply (drule approx_mult_subst_star_of, assumption)
apply (drule approx_trans3, assumption)
apply (auto simp del: star_of_mult simp add: star_of_mult [symmetric])
done

lemma NSLIMSEQ_rabs_realpow_zero: "\<bar>c\<bar> < (1::real) ==> (%n. \<bar>c\<bar> ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
by (simp add: LIMSEQ_rabs_realpow_zero LIMSEQ_NSLIMSEQ_iff [symmetric])

lemma NSLIMSEQ_rabs_realpow_zero2: "\<bar>c\<bar> < (1::real) ==> (%n. c ^ n) \<longlonglongrightarrow>\<^sub>N\<^sub>S 0"
by (simp add: LIMSEQ_rabs_realpow_zero2 LIMSEQ_NSLIMSEQ_iff [symmetric])

(***---------------------------------------------------------------
    Theorems proved by Harrison in HOL that we do not need
    in order to prove equivalence between Cauchy criterion
    and convergence:
 -- Show that every sequence contains a monotonic subsequence
Goal "\<exists>f. subseq f & monoseq (%n. s (f n))"
 -- Show that a subsequence of a bounded sequence is bounded
Goal "Bseq X ==> Bseq (%n. X (f n))";
 -- Show we can take subsequential terms arbitrarily far
    up a sequence
Goal "subseq f ==> n \<le> f(n)";
Goal "subseq f ==> \<exists>n. N1 \<le> n & N2 \<le> f(n)";
 ---------------------------------------------------------------***)

end