(*  Title:       The Graceful Recursive Path Order for Lambda-Free Higher-Order Terms
    Author:      Jasmin Blanchette <jasmin.blanchette at inria.fr>, 2016
    Author:      Uwe Waldmann <waldmann at mpi-inf.mpg.de>, 2016
    Author:      Daniel Wand <dwand at mpi-inf.mpg.de>, 2016
    Maintainer:  Jasmin Blanchette <jasmin.blanchette at inria.fr>
*)

section \<open>The Graceful Recursive Path Order for Lambda-Free Higher-Order Terms\<close>

theory Lambda_Free_RPO_Std
imports Lambda_Free_Term Extension_Orders Nested_Multisets_Ordinals.Multiset_More
abbrevs ">t" = ">\<^sub>t"
  and "\<ge>t" = "\<ge>\<^sub>t"
begin

text \<open>
This theory defines the graceful recursive path order (RPO) for \<open>\<lambda>\<close>-free
higher-order terms.
\<close>

subsection \<open>Setup\<close>

locale rpo_basis = ground_heads "(>\<^sub>s)" arity_sym arity_var
    for
      gt_sym :: "'s \<Rightarrow> 's \<Rightarrow> bool" (infix ">\<^sub>s" 50) and
      arity_sym :: "'s \<Rightarrow> enat" and
      arity_var :: "'v \<Rightarrow> enat" +
  fixes
    extf :: "'s \<Rightarrow> (('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool) \<Rightarrow> ('s, 'v) tm list \<Rightarrow> ('s, 'v) tm list \<Rightarrow> bool"
  assumes
    extf_ext_trans_before_irrefl: "ext_trans_before_irrefl (extf f)" and
    extf_ext_compat_cons: "ext_compat_cons (extf f)" and
    extf_ext_compat_list: "ext_compat_list (extf f)"
begin

lemma extf_ext_trans: "ext_trans (extf f)"
  by (rule ext_trans_before_irrefl.axioms(1)[OF extf_ext_trans_before_irrefl])

lemma extf_ext: "ext (extf f)"
  by (rule ext_trans.axioms(1)[OF extf_ext_trans])

lemmas extf_mono_strong = ext.mono_strong[OF extf_ext]
lemmas extf_mono = ext.mono[OF extf_ext, mono]
lemmas extf_map = ext.map[OF extf_ext]
lemmas extf_trans = ext_trans.trans[OF extf_ext_trans]
lemmas extf_irrefl_from_trans =
  ext_trans_before_irrefl.irrefl_from_trans[OF extf_ext_trans_before_irrefl]
lemmas extf_compat_append_left = ext_compat_cons.compat_append_left[OF extf_ext_compat_cons]
lemmas extf_compat_list = ext_compat_list.compat_list[OF extf_ext_compat_list]

definition chkvar :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
  [simp]: "chkvar t s \<longleftrightarrow> vars_hd (head s) \<subseteq> vars t"

end

locale rpo = rpo_basis _ _ arity_sym arity_var
  for
    arity_sym :: "'s \<Rightarrow> enat" and
    arity_var :: "'v \<Rightarrow> enat"
begin

subsection \<open>Inductive Definitions\<close>

definition
  chksubs :: "(('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool) \<Rightarrow> ('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool"
where
  [simp]: "chksubs gt t s \<longleftrightarrow> (case s of App s1 s2 \<Rightarrow> gt t s1 \<and> gt t s2 | _ \<Rightarrow> True)"

lemma chksubs_mono[mono]: "gt \<le> gt' \<Longrightarrow> chksubs gt \<le> chksubs gt'"
  by (auto simp: tm.case_eq_if) force+

inductive gt :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" (infix ">\<^sub>t" 50) where
  gt_sub: "is_App t \<Longrightarrow> (fun t >\<^sub>t s \<or> fun t = s) \<or> (arg t >\<^sub>t s \<or> arg t = s) \<Longrightarrow> t >\<^sub>t s"
| gt_diff: "head t >\<^sub>h\<^sub>d head s \<Longrightarrow> chkvar t s \<Longrightarrow> chksubs (>\<^sub>t) t s \<Longrightarrow> t >\<^sub>t s"
| gt_same: "head t = head s \<Longrightarrow> chksubs (>\<^sub>t) t s \<Longrightarrow>
    (\<forall>f \<in> ground_heads (head t). extf f (>\<^sub>t) (args t) (args s)) \<Longrightarrow> t >\<^sub>t s"

abbreviation ge :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" (infix "\<ge>\<^sub>t" 50) where
  "t \<ge>\<^sub>t s \<equiv> t >\<^sub>t s \<or> t = s"

inductive gt_sub :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
  gt_subI: "is_App t \<Longrightarrow> fun t \<ge>\<^sub>t s \<or> arg t \<ge>\<^sub>t s \<Longrightarrow> gt_sub t s"

inductive gt_diff :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
  gt_diffI: "head t >\<^sub>h\<^sub>d head s \<Longrightarrow> chkvar t s \<Longrightarrow> chksubs (>\<^sub>t) t s \<Longrightarrow> gt_diff t s"

inductive gt_same :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" where
  gt_sameI: "head t = head s \<Longrightarrow> chksubs (>\<^sub>t) t s \<Longrightarrow>
    (\<forall>f \<in> ground_heads (head t). extf f (>\<^sub>t) (args t) (args s)) \<Longrightarrow> gt_same t s"

lemma gt_iff_sub_diff_same: "t >\<^sub>t s \<longleftrightarrow> gt_sub t s \<or> gt_diff t s \<or> gt_same t s"
  by (subst gt.simps) (auto simp: gt_sub.simps gt_diff.simps gt_same.simps)

subsection \<open>Transitivity\<close>

lemma gt_fun_imp: "fun t >\<^sub>t s \<Longrightarrow> t >\<^sub>t s"
  by (cases t) (auto intro: gt_sub)

lemma gt_arg_imp: "arg t >\<^sub>t s \<Longrightarrow> t >\<^sub>t s"
  by (cases t) (auto intro: gt_sub)

lemma gt_imp_vars: "t >\<^sub>t s \<Longrightarrow> vars t \<supseteq> vars s"
proof (simp only: atomize_imp,
    rule measure_induct_rule[of "\<lambda>(t, s). size t + size s"
      "\<lambda>(t, s). t >\<^sub>t s \<longrightarrow> vars t \<supseteq> vars s" "(t, s)", simplified prod.case],
    simp only: split_paired_all prod.case atomize_imp[symmetric])
  fix t s
  assume
    ih: "\<And>ta sa. size ta + size sa < size t + size s \<Longrightarrow> ta >\<^sub>t sa \<Longrightarrow> vars ta \<supseteq> vars sa" and
    t_gt_s: "t >\<^sub>t s"
  show "vars t \<supseteq> vars s"
    using t_gt_s
  proof cases
    case gt_sub
    thus ?thesis
      using ih[of "fun t" s] ih[of "arg t" s]
      by (meson add_less_cancel_right subsetD size_arg_lt size_fun_lt subsetI tm.set_sel(5,6))
  next
    case gt_diff
    show ?thesis
    proof (cases s)
      case Hd
      thus ?thesis
        using gt_diff(2) by (auto elim: hd.set_cases(2))
    next
      case (App s1 s2)
      thus ?thesis
        using gt_diff(3) ih[of t s1] ih[of t s2] by simp
    qed
  next
    case gt_same
    show ?thesis
    proof (cases s)
      case Hd
      thus ?thesis
        using gt_same(1) vars_head_subseteq by fastforce
    next
      case (App s1 s2)
      thus ?thesis
        using gt_same(2) ih[of t s1] ih[of t s2] by simp
    qed
  qed
qed

theorem gt_trans: "u >\<^sub>t t \<Longrightarrow> t >\<^sub>t s \<Longrightarrow> u >\<^sub>t s"
proof (simp only: atomize_imp,
    rule measure_induct_rule[of "\<lambda>(u, t, s). {#size u, size t, size s#}"
        "\<lambda>(u, t, s). u >\<^sub>t t \<longrightarrow> t >\<^sub>t s \<longrightarrow> u >\<^sub>t s" "(u, t, s)",
      simplified prod.case],
    simp only: split_paired_all prod.case atomize_imp[symmetric])
  fix u t s
  assume
    ih: "\<And>ua ta sa. {#size ua, size ta, size sa#} < {#size u, size t, size s#} \<Longrightarrow>
      ua >\<^sub>t ta \<Longrightarrow> ta >\<^sub>t sa \<Longrightarrow> ua >\<^sub>t sa" and
    u_gt_t: "u >\<^sub>t t" and t_gt_s: "t >\<^sub>t s"

  have chkvar: "chkvar u s"
    by clarsimp (meson u_gt_t t_gt_s gt_imp_vars hd.set_sel(2) vars_head_subseteq subsetCE)

  have chk_u_s_if: "chksubs (>\<^sub>t) u s" if chk_t_s: "chksubs (>\<^sub>t) t s"
  proof (cases s)
    case (App s1 s2)
    thus ?thesis
      using chk_t_s by (auto intro: ih[of _ _ s1, OF _ u_gt_t] ih[of _ _ s2, OF _ u_gt_t])
  qed auto

  have
    fun_u_lt_etc: "is_App u \<Longrightarrow> {#size (fun u), size t, size s#} < {#size u, size t, size s#}" and
    arg_u_lt_etc: "is_App u \<Longrightarrow> {#size (arg u), size t, size s#} < {#size u, size t, size s#}"
    by (simp_all add: size_fun_lt size_arg_lt)

  have u_gt_s_if_ui: "is_App u \<Longrightarrow> fun u \<ge>\<^sub>t t \<or> arg u \<ge>\<^sub>t t \<Longrightarrow> u >\<^sub>t s"
    using ih[of "fun u" t s, OF fun_u_lt_etc] ih[of "arg u" t s, OF arg_u_lt_etc] gt_arg_imp
      gt_fun_imp t_gt_s by blast

  show "u >\<^sub>t s"
    using t_gt_s
  proof cases
    case gt_sub_t_s: gt_sub

    have u_gt_s_if_chk_u_t: ?thesis if chk_u_t: "chksubs (>\<^sub>t) u t"
      using gt_sub_t_s(1)
    proof (cases t)
      case t: (App t1 t2)
      show ?thesis
        using ih[of u t1 s] ih[of u t2 s] gt_sub_t_s(2) chk_u_t unfolding t by auto
    qed auto

    show ?thesis
      using u_gt_t by cases (auto intro: u_gt_s_if_ui u_gt_s_if_chk_u_t)
  next
    case gt_diff_t_s: gt_diff
    show ?thesis
      using u_gt_t
    proof cases
      case gt_diff_u_t: gt_diff
      have "head u >\<^sub>h\<^sub>d head s"
        using gt_diff_u_t(1) gt_diff_t_s(1) by (auto intro: gt_hd_trans)
      thus ?thesis
        by (rule gt_diff[OF _ chkvar chk_u_s_if[OF gt_diff_t_s(3)]])
    next
      case gt_same_u_t: gt_same
      have "head u >\<^sub>h\<^sub>d head s"
        using gt_diff_t_s(1) gt_same_u_t(1) by auto
      thus ?thesis
        by (rule gt_diff[OF _ chkvar chk_u_s_if[OF gt_diff_t_s(3)]])
    qed (auto intro: u_gt_s_if_ui)
  next
    case gt_same_t_s: gt_same
    show ?thesis
      using u_gt_t
    proof cases
      case gt_diff_u_t: gt_diff
      have "head u >\<^sub>h\<^sub>d head s"
        using gt_diff_u_t(1) gt_same_t_s(1) by simp
      thus ?thesis
        by (rule gt_diff[OF _ chkvar chk_u_s_if[OF gt_same_t_s(2)]])
    next
      case gt_same_u_t: gt_same
      have hd_u_s: "head u = head s"
        using gt_same_u_t(1) gt_same_t_s(1) by simp

      let ?S = "set (args u) \<union> set (args t) \<union> set (args s)"

      have gt_trans_args: "\<forall>ua \<in> ?S. \<forall>ta \<in> ?S. \<forall>sa \<in> ?S. ua >\<^sub>t ta \<longrightarrow> ta >\<^sub>t sa \<longrightarrow> ua >\<^sub>t sa"
      proof clarify
        fix sa ta ua
        assume
          ua_in: "ua \<in> ?S" and ta_in: "ta \<in> ?S" and sa_in: "sa \<in> ?S" and
          ua_gt_ta: "ua >\<^sub>t ta" and ta_gt_sa: "ta >\<^sub>t sa"
        show "ua >\<^sub>t sa"
          by (auto intro!: ih[OF Max_lt_imp_lt_mset ua_gt_ta ta_gt_sa])
            (meson ua_in ta_in sa_in Un_iff max.strict_coboundedI1 max.strict_coboundedI2
               size_in_args)+
      qed

      have "\<forall>f \<in> ground_heads (head u). extf f (>\<^sub>t) (args u) (args s)"
      proof (clarify, rule extf_trans[OF _ _ _ gt_trans_args])
        fix f
        assume f_in_grounds: "f \<in> ground_heads (head u)"
        show "extf f (>\<^sub>t) (args u) (args t)"
          using f_in_grounds gt_same_u_t(3) by blast
        show "extf f (>\<^sub>t) (args t) (args s)"
          using f_in_grounds gt_same_t_s(3) unfolding gt_same_u_t(1) by blast
      qed auto
      thus ?thesis
        by (rule gt_same[OF hd_u_s chk_u_s_if[OF gt_same_t_s(2)]])
    qed (auto intro: u_gt_s_if_ui)
  qed
qed

subsection \<open>Irreflexivity\<close>

theorem gt_irrefl: "\<not> s >\<^sub>t s"
proof (standard, induct s rule: measure_induct_rule[of size])
  case (less s)
  note ih = this(1) and s_gt_s = this(2)

  show False
    using s_gt_s
  proof cases
    case _: gt_sub
    note is_app = this(1) and si_ge_s = this(2)
    have s_gt_fun_s: "s >\<^sub>t fun s" and s_gt_arg_s: "s >\<^sub>t arg s"
      using is_app by (simp_all add: gt_sub)

    have "fun s >\<^sub>t s \<or> arg s >\<^sub>t s"
      using si_ge_s is_app s_gt_arg_s s_gt_fun_s by auto
    moreover
    {
      assume fun_s_gt_s: "fun s >\<^sub>t s"
      have "fun s >\<^sub>t fun s"
        by (rule gt_trans[OF fun_s_gt_s s_gt_fun_s])
      hence False
        using ih[of "fun s"] is_app size_fun_lt by blast
    }
    moreover
    {
      assume arg_s_gt_s: "arg s >\<^sub>t s"
      have "arg s >\<^sub>t arg s"
        by (rule gt_trans[OF arg_s_gt_s s_gt_arg_s])
      hence False
        using ih[of "arg s"] is_app size_arg_lt by blast
    }
    ultimately show False
      by sat
  next
    case gt_diff
    thus False
      by (cases "head s") (auto simp: gt_hd_irrefl)
  next
    case gt_same
    note in_grounds = this(3)

    obtain si where si_in_args: "si \<in> set (args s)" and si_gt_si: "si >\<^sub>t si"
      using in_grounds
      by (metis (full_types) all_not_in_conv extf_irrefl_from_trans ground_heads_nonempty gt_trans)
    have "size si < size s"
      by (rule size_in_args[OF si_in_args])
    thus False
      by (rule ih[OF _ si_gt_si])
  qed
qed

lemma gt_antisym: "t >\<^sub>t s \<Longrightarrow> \<not> s >\<^sub>t t"
  using gt_irrefl gt_trans by blast

subsection \<open>Subterm Property\<close>

lemma
  gt_sub_fun: "App s t >\<^sub>t s" and
  gt_sub_arg: "App s t >\<^sub>t t"
  by (auto intro: gt_sub)

theorem gt_proper_sub: "proper_sub s t \<Longrightarrow> t >\<^sub>t s"
  by (induct t) (auto intro: gt_sub_fun gt_sub_arg gt_trans)

subsection \<open>Compatibility with Functions\<close>

lemma gt_compat_fun:
  assumes t'_gt_t: "t' >\<^sub>t t"
  shows "App s t' >\<^sub>t App s t"
proof -
  have t'_ne_t: "t' \<noteq> t"
    using gt_antisym t'_gt_t by blast
  have extf_args_single: "\<forall>f \<in> ground_heads (head s). extf f (>\<^sub>t) (args s @ [t']) (args s @ [t])"
    by (simp add: extf_compat_list t'_gt_t t'_ne_t)
  show ?thesis
    by (rule gt_same) (auto simp: gt_sub gt_sub_fun t'_gt_t intro!: extf_args_single)
qed

theorem gt_compat_fun_strong:
  assumes t'_gt_t: "t' >\<^sub>t t"
  shows "apps s (t' # us) >\<^sub>t apps s (t # us)"
proof (induct us rule: rev_induct)
  case Nil
  show ?case
    using t'_gt_t by (auto intro!: gt_compat_fun)
next
  case (snoc u us)
  note ih = snoc

  let ?v' = "apps s (t' # us @ [u])"
  let ?v = "apps s (t # us @ [u])"

  show ?case
  proof (rule gt_same)
    show "chksubs (>\<^sub>t) ?v' ?v"
      using ih by (auto intro: gt_sub gt_sub_arg)
  next
    show "\<forall>f \<in> ground_heads (head ?v'). extf f (>\<^sub>t) (args ?v') (args ?v)"
      by (metis args_apps extf_compat_list gt_irrefl t'_gt_t)
  qed simp
qed

subsection \<open>Compatibility with Arguments\<close>

theorem gt_diff_same_compat_arg:
  assumes
    extf_compat_snoc: "\<And>f. ext_compat_snoc (extf f)" and
    diff_same: "gt_diff s' s \<or> gt_same s' s"
  shows "App s' t >\<^sub>t App s t"
proof -
  {
    assume "s' >\<^sub>t s"
    hence "App s' t >\<^sub>t s"
      using gt_sub_fun gt_trans by blast
    moreover have "App s' t >\<^sub>t t"
      by (simp add: gt_sub_arg)
    ultimately have "chksubs (>\<^sub>t) (App s' t) (App s t)"
      by auto
  }
  note chk_s't_st = this

  show ?thesis
    using diff_same
  proof
    assume "gt_diff s' s"
    hence
      s'_gt_s: "s' >\<^sub>t s" and
      hd_s'_gt_s: "head s' >\<^sub>h\<^sub>d head s" and
      chkvar_s'_s: "chkvar s' s" and
      chk_s'_s: "chksubs (>\<^sub>t) s' s"
      using gt_diff.cases by (auto simp: gt_iff_sub_diff_same)

    have chkvar_s't_st: "chkvar (App s' t) (App s t)"
      using chkvar_s'_s by auto
    show ?thesis
      by (rule gt_diff[OF _ chkvar_s't_st chk_s't_st[OF s'_gt_s]])
        (simp add: hd_s'_gt_s[simplified])
  next
    assume "gt_same s' s"
    hence
      s'_gt_s: "s' >\<^sub>t s" and
      hd_s'_eq_s: "head s' = head s" and
      chk_s'_s: "chksubs (>\<^sub>t) s' s" and
      gts_args: "\<forall>f \<in> ground_heads (head s'). extf f (>\<^sub>t) (args s') (args s)"
      using gt_same.cases by (auto simp: gt_iff_sub_diff_same, metis)

    have gts_args_t:
      "\<forall>f \<in> ground_heads (head (App s' t)). extf f (>\<^sub>t) (args (App s' t)) (args (App s t))"
      using gts_args ext_compat_snoc.compat_append_right[OF extf_compat_snoc] by simp

    show ?thesis
      by (rule gt_same[OF _ chk_s't_st[OF s'_gt_s] gts_args_t]) (simp add: hd_s'_eq_s)
  qed
qed

subsection \<open>Stability under Substitution\<close>

lemma gt_imp_chksubs_gt:
  assumes t_gt_s: "t >\<^sub>t s"
  shows "chksubs (>\<^sub>t) t s"
proof -
  have "is_App s \<Longrightarrow> t >\<^sub>t fun s \<and> t >\<^sub>t arg s"
    using t_gt_s by (meson gt_sub gt_trans)
  thus ?thesis
    by (simp add: tm.case_eq_if)
qed

theorem gt_subst:
  assumes wary_\<rho>: "wary_subst \<rho>"
  shows "t >\<^sub>t s \<Longrightarrow> subst \<rho> t >\<^sub>t subst \<rho> s"
proof (simp only: atomize_imp,
    rule measure_induct_rule[of "\<lambda>(t, s). {#size t, size s#}"
        "\<lambda>(t, s). t >\<^sub>t s \<longrightarrow> subst \<rho> t >\<^sub>t subst \<rho> s" "(t, s)",
      simplified prod.case],
    simp only: split_paired_all prod.case atomize_imp[symmetric])
  fix t s
  assume
    ih: "\<And>ta sa. {#size ta, size sa#} < {#size t, size s#} \<Longrightarrow> ta >\<^sub>t sa \<Longrightarrow>
      subst \<rho> ta >\<^sub>t subst \<rho> sa" and
    t_gt_s: "t >\<^sub>t s"

  {
    assume chk_t_s: "chksubs (>\<^sub>t) t s"
    have "chksubs (>\<^sub>t) (subst \<rho> t) (subst \<rho> s)"
    proof (cases s)
      case s: (Hd \<zeta>)
      show ?thesis
      proof (cases \<zeta>)
        case \<zeta>: (Var x)
        have psub_x_t: "proper_sub (Hd (Var x)) t"
          using \<zeta> s t_gt_s gt_imp_vars gt_irrefl in_vars_imp_sub by fastforce
        show ?thesis
          unfolding \<zeta> s
          by (rule gt_imp_chksubs_gt[OF gt_proper_sub[OF proper_sub_subst]]) (rule psub_x_t)
      qed (auto simp: s)
    next
      case s: (App s1 s2)
      have "t >\<^sub>t s1" and "t >\<^sub>t s2"
        using s chk_t_s by auto
      thus ?thesis
        using s by (auto intro!: ih[of t s1] ih[of t s2])
    qed
  }
  note chk_\<rho>t_\<rho>s_if = this

  show "subst \<rho> t >\<^sub>t subst \<rho> s"
    using t_gt_s
  proof cases
    case gt_sub_t_s: gt_sub
    obtain t1 t2 where t: "t = App t1 t2"
      using gt_sub_t_s(1) by (metis tm.collapse(2))
    show ?thesis
      using gt_sub ih[of t1 s] ih[of t2 s] gt_sub_t_s(2) t by auto
  next
    case gt_diff_t_s: gt_diff
    have "head (subst \<rho> t) >\<^sub>h\<^sub>d head (subst \<rho> s)"
      by (meson wary_subst_ground_heads gt_diff_t_s(1) gt_hd_def subsetCE wary_\<rho>)
    moreover have "chkvar (subst \<rho> t) (subst \<rho> s)"
      unfolding chkvar_def using vars_subst_subseteq[OF gt_imp_vars[OF t_gt_s]] vars_head_subseteq
      by force
    ultimately show ?thesis
      by (rule gt_diff[OF _ _ chk_\<rho>t_\<rho>s_if[OF gt_diff_t_s(3)]])
  next
    case gt_same_t_s: gt_same

    have hd_\<rho>t_eq_\<rho>s: "head (subst \<rho> t) = head (subst \<rho> s)"
      using gt_same_t_s(1) by simp

    {
      fix f
      assume f_in_grounds: "f \<in> ground_heads (head (subst \<rho> t))"

      let ?S = "set (args t) \<union> set (args s)"

      have extf_args_s_t: "extf f (>\<^sub>t) (args t) (args s)"
        using gt_same_t_s(3) f_in_grounds wary_\<rho> wary_subst_ground_heads by blast
      have "extf f (>\<^sub>t) (map (subst \<rho>) (args t)) (map (subst \<rho>) (args s))"
      proof (rule extf_map[of ?S, OF _ _ _ _ _ _ extf_args_s_t])
        have sz_a: "\<forall>ta \<in> ?S. \<forall>sa \<in> ?S. {#size ta, size sa#} < {#size t, size s#}"
          by (fastforce intro: Max_lt_imp_lt_mset dest: size_in_args)
        show "\<forall>ta \<in> ?S. \<forall>sa \<in> ?S. ta >\<^sub>t sa \<longrightarrow> subst \<rho> ta >\<^sub>t subst \<rho> sa"
          using ih sz_a size_in_args by fastforce
      qed (auto intro!: gt_irrefl elim!: gt_trans)
      hence "extf f (>\<^sub>t) (args (subst \<rho> t)) (args (subst \<rho> s))"
        by (auto simp: gt_same_t_s(1) intro: extf_compat_append_left)
    }
    hence "\<forall>f \<in> ground_heads (head (subst \<rho> t)).
      extf f (>\<^sub>t) (args (subst \<rho> t)) (args (subst \<rho> s))"
      by blast
    thus ?thesis
      by (rule gt_same[OF hd_\<rho>t_eq_\<rho>s chk_\<rho>t_\<rho>s_if[OF gt_same_t_s(2)]])
  qed
qed

subsection \<open>Totality on Ground Terms\<close>

theorem gt_total_ground:
  assumes extf_total: "\<And>f. ext_total (extf f)"
  shows "ground t \<Longrightarrow> ground s \<Longrightarrow> t >\<^sub>t s \<or> s >\<^sub>t t \<or> t = s"
proof (simp only: atomize_imp,
    rule measure_induct_rule[of "\<lambda>(t, s). {# size t, size s #}"
      "\<lambda>(t, s). ground t \<longrightarrow> ground s \<longrightarrow> t >\<^sub>t s \<or> s >\<^sub>t t \<or> t = s" "(t, s)", simplified prod.case],
    simp only: split_paired_all prod.case atomize_imp[symmetric])
  fix t s :: "('s, 'v) tm"
  assume
    ih: "\<And>ta sa. {# size ta, size sa #} < {# size t, size s #} \<Longrightarrow> ground ta \<Longrightarrow> ground sa \<Longrightarrow>
      ta >\<^sub>t sa \<or> sa >\<^sub>t ta \<or> ta = sa" and
    gr_t: "ground t" and gr_s: "ground s"

  let ?case = "t >\<^sub>t s \<or> s >\<^sub>t t \<or> t = s"

  have "chksubs (>\<^sub>t) t s \<or> s >\<^sub>t t"
    unfolding chksubs_def tm.case_eq_if using ih[of t "fun s"] ih[of t "arg s"] mset_lt_single_iff
    by (metis add_mset_lt_right_lt gr_s gr_t ground_arg ground_fun gt_sub size_arg_lt size_fun_lt)
  moreover have "chksubs (>\<^sub>t) s t \<or> t >\<^sub>t s"
    unfolding chksubs_def tm.case_eq_if using ih[of "fun t" s] ih[of "arg t" s]
    by (metis add_mset_lt_left_lt gr_s gr_t ground_arg ground_fun gt_sub size_arg_lt size_fun_lt)
  moreover
  {
    assume
      chksubs_t_s: "chksubs (>\<^sub>t) t s" and
      chksubs_s_t: "chksubs (>\<^sub>t) s t"

    obtain g where g: "head t = Sym g"
      using gr_t by (metis ground_head hd.collapse(2))
    obtain f where f: "head s = Sym f"
      using gr_s by (metis ground_head hd.collapse(2))

    have chkvar_t_s: "chkvar t s" and chkvar_s_t: "chkvar s t"
      using g f by simp_all

    {
      assume g_gt_f: "g >\<^sub>s f"
      have "t >\<^sub>t s"
        by (rule gt_diff[OF _ chkvar_t_s chksubs_t_s]) (simp add: g f gt_sym_imp_hd[OF g_gt_f])
    }
    moreover
    {
      assume f_gt_g: "f >\<^sub>s g"
      have "s >\<^sub>t t"
        by (rule gt_diff[OF _ chkvar_s_t chksubs_s_t]) (simp add: g f gt_sym_imp_hd[OF f_gt_g])
    }
    moreover
    {
      assume g_eq_f: "g = f"
      hence hd_t: "head t = head s"
        using g f by auto

      let ?ts = "args t"
      let ?ss = "args s"

      have gr_ts: "\<forall>ta \<in> set ?ts. ground ta"
        using ground_args[OF _ gr_t] by blast
      have gr_ss: "\<forall>sa \<in> set ?ss. ground sa"
        using ground_args[OF _ gr_s] by blast

      {
        assume ts_eq_ss: "?ts = ?ss"
        have "t = s"
          using hd_t ts_eq_ss by (rule tm_expand_apps)
      }
      moreover
      {
        assume ts_gt_ss: "extf g (>\<^sub>t) ?ts ?ss"
        have "t >\<^sub>t s"
          by (rule gt_same[OF hd_t chksubs_t_s]) (auto simp: g ts_gt_ss)
      }
      moreover
      {
        assume ss_gt_ts: "extf g (>\<^sub>t) ?ss ?ts"
        have "s >\<^sub>t t"
          by (rule gt_same[OF hd_t[symmetric] chksubs_s_t]) (auto simp: f[folded g_eq_f] ss_gt_ts)
      }
      ultimately have ?case
        using ih gr_ss gr_ts
          ext_total.total[OF extf_total, rule_format, of "set ?ts \<union> set ?ss" "(>\<^sub>t)" ?ts ?ss g]
        by (metis Un_iff in_listsI less_multiset_doubletons size_in_args)
    }
    ultimately have ?case
      using gt_sym_total by blast
  }
  ultimately show ?case
    by fast
qed

subsection \<open>Well-foundedness\<close>

abbreviation gtg :: "('s, 'v) tm \<Rightarrow> ('s, 'v) tm \<Rightarrow> bool" (infix ">\<^sub>t\<^sub>g" 50) where
  "(>\<^sub>t\<^sub>g) \<equiv> \<lambda>t s. ground t \<and> t >\<^sub>t s"

theorem gt_wf:
  assumes extf_wf: "\<And>f. ext_wf (extf f)"
  shows "wfP (\<lambda>s t. t >\<^sub>t s)"
proof -
  have ground_wfP: "wfP (\<lambda>s t. t >\<^sub>t\<^sub>g s)"
    unfolding wfP_iff_no_inf_chain
  proof
    assume "\<exists>f. inf_chain (>\<^sub>t\<^sub>g) f"
    then obtain t where t_bad: "bad (>\<^sub>t\<^sub>g) t"
      unfolding inf_chain_def bad_def by blast

    let ?ff = "worst_chain (>\<^sub>t\<^sub>g) (\<lambda>t s. size t > size s)"
    let ?U_of = "\<lambda>i. if is_App (?ff i) then {fun (?ff i)} \<union> set (args (?ff i)) else {}"

    note wf_sz = wf_app[OF wellorder_class.wf, of size, simplified]

    define U where "U = (\<Union>i. ?U_of i)"

    have gr: "\<And>i. ground (?ff i)"
      using worst_chain_bad[OF wf_sz t_bad, unfolded inf_chain_def] by fast
    have gr_fun: "\<And>i. ground (fun (?ff i))"
      by (rule ground_fun[OF gr])
    have gr_args: "\<And>i s. s \<in> set (args (?ff i)) \<Longrightarrow> ground s"
      by (rule ground_args[OF _ gr])
    have gr_u: "\<And>u. u \<in> U \<Longrightarrow> ground u"
      unfolding U_def by (auto dest: gr_args) (metis (lifting) empty_iff gr_fun)

    have "\<not> bad (>\<^sub>t\<^sub>g) u" if u_in: "u \<in> ?U_of i" for u i
    proof
      let ?ti = "?ff i"

      assume u_bad: "bad (>\<^sub>t\<^sub>g) u"
      have sz_u: "size u < size ?ti"
      proof (cases "?ff i")
        case Hd
        thus ?thesis
          using u_in size_in_args by fastforce
      next
        case App
        thus ?thesis
          using u_in size_in_args insert_iff size_fun_lt by fastforce
      qed

      show False
      proof (cases i)
        case 0
        thus False
          using sz_u min_worst_chain_0[OF wf_sz u_bad] by simp
      next
        case Suc
        hence "?ff (i - 1) >\<^sub>t ?ff i"
          using worst_chain_pred[OF wf_sz t_bad] by simp
        moreover have "?ff i >\<^sub>t u"
        proof -
          have u_in: "u \<in> ?U_of i"
            using u_in by blast
          have ffi_ne_u: "?ff i \<noteq> u"
            using sz_u by fastforce
          hence "is_App (?ff i) \<Longrightarrow> \<not> sub u (?ff i) \<Longrightarrow> ?ff i >\<^sub>t u"
            using u_in gt_sub sub_args by auto
          thus "?ff i >\<^sub>t u"
            using ffi_ne_u u_in gt_proper_sub sub_args by fastforce
        qed
        ultimately have "?ff (i - 1) >\<^sub>t u"
          by (rule gt_trans)
        thus False
          using Suc sz_u min_worst_chain_Suc[OF wf_sz u_bad] gr by fastforce
      qed
    qed
    hence u_good: "\<And>u. u \<in> U \<Longrightarrow> \<not> bad (>\<^sub>t\<^sub>g) u"
      unfolding U_def by blast

    have bad_diff_same: "inf_chain (\<lambda>t s. ground t \<and> (gt_diff t s \<or> gt_same t s)) ?ff"
      unfolding inf_chain_def
    proof (intro allI conjI)
      fix i

      show "ground (?ff i)"
        by (rule gr)

      have gt: "?ff i >\<^sub>t ?ff (Suc i)"
        using worst_chain_pred[OF wf_sz t_bad] by blast

      have "\<not> gt_sub (?ff i) (?ff (Suc i))"
      proof
        assume a: "gt_sub (?ff i) (?ff (Suc i))"
        hence fi_app: "is_App (?ff i)" and
          fun_or_arg_fi_ge: "fun (?ff i) \<ge>\<^sub>t ?ff (Suc i) \<or> arg (?ff i) \<ge>\<^sub>t ?ff (Suc i)"
          unfolding gt_sub.simps by blast+
        have "fun (?ff i) \<in> ?U_of i"
          unfolding U_def using fi_app by auto
        moreover have "arg (?ff i) \<in> ?U_of i"
          unfolding U_def using fi_app arg_in_args by force
        ultimately obtain uij where uij_in: "uij \<in> U" and uij_cases: "uij \<ge>\<^sub>t ?ff (Suc i)"
          unfolding U_def using fun_or_arg_fi_ge by blast

        have "\<And>n. ?ff n >\<^sub>t ?ff (Suc n)"
          by (rule worst_chain_pred[OF wf_sz t_bad, THEN conjunct2])
        hence uij_gt_i_plus_3: "uij >\<^sub>t ?ff (Suc (Suc i))"
          using gt_trans uij_cases by blast

        have "inf_chain (>\<^sub>t\<^sub>g) (\<lambda>j. if j = 0 then uij else ?ff (Suc (i + j)))"
          unfolding inf_chain_def
          by (auto intro!: gr gr_u[OF uij_in] uij_gt_i_plus_3 worst_chain_pred[OF wf_sz t_bad])
        hence "bad (>\<^sub>t\<^sub>g) uij"
          unfolding bad_def by fastforce
        thus False
          using u_good[OF uij_in] by sat
      qed
      thus "gt_diff (?ff i) (?ff (Suc i)) \<or> gt_same (?ff i) (?ff (Suc i))"
        using gt unfolding gt_iff_sub_diff_same by sat
    qed

    have "wf {(s, t). ground s \<and> ground t \<and> sym (head t) >\<^sub>s sym (head s)}"
      using gt_sym_wf unfolding wfP_def wf_iff_no_infinite_down_chain by fast
    moreover have "{(s, t). ground t \<and> gt_diff t s}
      \<subseteq> {(s, t). ground s \<and> ground t \<and> sym (head t) >\<^sub>s sym (head s)}"
    proof (clarsimp, intro conjI)
      fix s t
      assume gr_t: "ground t" and gt_diff_t_s: "gt_diff t s"
      thus gr_s: "ground s"
        using gt_iff_sub_diff_same gt_imp_vars by fastforce

      show "sym (head t) >\<^sub>s sym (head s)"
        using gt_diff_t_s ground_head[OF gr_s] ground_head[OF gr_t]
        by (cases; cases "head s"; cases "head t") (auto simp: gt_hd_def)
    qed
    ultimately have wf_diff: "wf {(s, t). ground t \<and> gt_diff t s}"
      by (rule wf_subset)

    have diff_O_same: "{(s, t). ground t \<and> gt_diff t s} O {(s, t). ground t \<and> gt_same t s}
      \<subseteq> {(s, t). ground t \<and> gt_diff t s}"
      unfolding gt_diff.simps gt_same.simps
      by clarsimp (metis chksubs_def empty_subsetI gt_diff[unfolded chkvar_def] gt_imp_chksubs_gt
        gt_same gt_trans)

    have diff_same_as_union: "{(s, t). ground t \<and> (gt_diff t s \<or> gt_same t s)} =
      {(s, t). ground t \<and> gt_diff t s} \<union> {(s, t). ground t \<and> gt_same t s}"
      by auto

    obtain k where bad_same: "inf_chain (\<lambda>t s. ground t \<and> gt_same t s) (\<lambda>i. ?ff (i + k))"
      using wf_infinite_down_chain_compatible[OF wf_diff _ diff_O_same, of ?ff] bad_diff_same
      unfolding inf_chain_def diff_same_as_union[symmetric] by auto
    hence hd_sym: "\<And>i. is_Sym (head (?ff (i + k)))"
      unfolding inf_chain_def by (simp add: ground_head)

    define f where "f = sym (head (?ff k))"

    have hd_eq_f: "head (?ff (i + k)) = Sym f" for i
    proof (induct i)
      case 0
      thus ?case
        by (auto simp: f_def hd.collapse(2)[OF hd_sym, of 0, simplified])
    next
      case (Suc ia)
      thus ?case
        using bad_same unfolding inf_chain_def gt_same.simps by simp
    qed

    let ?gtu = "\<lambda>t s. t \<in> U \<and> t >\<^sub>t s"

    have "t \<in> set (args (?ff i)) \<Longrightarrow> t \<in> ?U_of i" for t i
      unfolding U_def
      by (cases "is_App (?ff i)", simp_all,
        metis (lifting) neq_iff size_in_args sub.cases sub_args tm.discI(2))
    moreover have "\<And>i. extf f (>\<^sub>t) (args (?ff (i + k))) (args (?ff (Suc i + k)))"
      using bad_same hd_eq_f unfolding inf_chain_def gt_same.simps by auto
    ultimately have "\<And>i. extf f ?gtu (args (?ff (i + k))) (args (?ff (Suc i + k)))"
      using extf_mono_strong[of _ _ "(>\<^sub>t)" "\<lambda>t s. t \<in> U \<and> t >\<^sub>t s"] unfolding U_def by blast
    hence "inf_chain (extf f ?gtu) (\<lambda>i. args (?ff (i + k)))"
      unfolding inf_chain_def by blast
    hence nwf_ext: "\<not> wfP (\<lambda>xs ys. extf f ?gtu ys xs)"
      unfolding wfP_iff_no_inf_chain by fast

    have gtu_le_gtg: "?gtu \<le> (>\<^sub>t\<^sub>g)"
      by (auto intro!: gr_u)

    have "wfP (\<lambda>s t. ?gtu t s)"
      unfolding wfP_iff_no_inf_chain
    proof (intro notI, elim exE)
      fix f
      assume bad_f: "inf_chain ?gtu f"
      hence bad_f0: "bad ?gtu (f 0)"
        by (rule inf_chain_bad)

      have "f 0 \<in> U"
        using bad_f unfolding inf_chain_def by blast
      hence good_f0: "\<not> bad ?gtu (f 0)"
        using u_good bad_f inf_chain_bad inf_chain_subset[OF _ gtu_le_gtg] by blast

      show False
        using bad_f0 good_f0 by sat
    qed
    hence wf_ext: "wfP (\<lambda>xs ys. extf f ?gtu ys xs)"
      by (rule ext_wf.wf[OF extf_wf, rule_format])

    show False
      using nwf_ext wf_ext by blast
  qed

  let ?subst = "subst grounding_\<rho>"

  have "wfP (\<lambda>s t. ?subst t >\<^sub>t\<^sub>g ?subst s)"
    by (rule wfP_app[OF ground_wfP])
  hence "wfP (\<lambda>s t. ?subst t >\<^sub>t ?subst s)"
    by (simp add: ground_grounding_\<rho>)
  thus ?thesis
    by (auto intro: wfP_subset gt_subst[OF wary_grounding_\<rho>])
qed

end

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics written for Isabelle/Isar.

    Copyright (C) 2020  Daniel de la Concepcion

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES LOSS OF USE, DATA, OR PROFITS OR
BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Topological groups - uniformity\<close>

theory TopologicalGroup_Uniformity_ZF imports TopologicalGroup_ZF UniformSpace_ZF_1

begin
text\<open> Each topological group is a uniform space.
  This theory is about the unifomities that are naturally defined by a topological group structure. \<close>

subsection\<open>Natural uniformities in topological groups: definitions and notation\<close>

text\<open>There are two basic uniformities that can be defined on a topological group. \<close>

text\<open>Definition of left uniformity\<close>

definition (in topgroup) leftUniformity
 where "leftUniformity \<equiv> {V\<in>Pow(G\<times>G).\<exists>U\<in> \<N>\<^sub>0. {\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>U} \<subseteq> V}"

text\<open>Definition of right uniformity\<close>

definition (in topgroup) rightUniformity
 where "rightUniformity \<equiv> {V\<in>Pow(G\<times>G).\<exists>U\<in> \<N>\<^sub>0. {\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>U}\<subseteq> V}"

text\<open>Right and left uniformities are indeed uniformities. \<close>

lemma (in topgroup) side_uniformities:
    shows "leftUniformity {is a uniformity on} G" and "rightUniformity {is a uniformity on} G"
proof-
  {
    assume "0 \<in> leftUniformity"
    then obtain U where U:"U\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>U}\<subseteq>0" unfolding leftUniformity_def
      by auto
    have "\<langle>\<zero>,\<zero>\<rangle>:G\<times>G" using zero_in_tgroup by auto
    moreover have "(\<rm>\<zero>)\<ra>\<zero> = \<zero>"
      using group0_valid_in_tgroup group0.group_inv_of_one group0.group0_2_L2 zero_in_tgroup
      by auto
    moreover have "\<zero>\<in>int(U)" using U(1) by auto
    then have "\<zero>\<in>U" using Top_2_L1 by auto
    ultimately have "\<langle>\<zero>,\<zero>\<rangle>\<in>{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>U}" by auto
    with U(2) have "\<langle>\<zero>,\<zero>\<rangle>\<in>0" by blast
    hence False by auto
  }
  hence "0\<notin>leftUniformity" by auto
  moreover  have "leftUniformity \<subseteq> Pow(G\<times>G)" unfolding leftUniformity_def by auto
  moreover
  {
    have "G\<times>G\<in>Pow(G\<times>G)" by auto moreover
    have "{\<langle>s,t\<rangle>:G\<times>G. (\<rm>s)\<ra>t:G} \<subseteq> G\<times>G" by auto moreover
    note zneigh_not_empty
    ultimately have "G\<times>G\<in>leftUniformity" unfolding leftUniformity_def by auto
  }
  moreover
  {
    fix A B assume as:"A\<in>leftUniformity" "B\<in>leftUniformity"
    from as(1) obtain AU where AU:"AU\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>AU}\<subseteq> A" "A\<in>Pow(G\<times>G)"
      unfolding leftUniformity_def by auto
    from as(2) obtain BU where BU:"BU\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>BU}\<subseteq> B" "B\<in>Pow(G\<times>G)"
      unfolding leftUniformity_def by auto
    from AU(1) BU(1) have "\<zero>\<in>int(AU)\<inter>int(BU)" by auto
    moreover from AU BU have op:"int(AU)\<inter>int(BU)\<in>T" using Top_2_L2 topSpaceAssum IsATopology_def
      by auto
    moreover
    have "int(AU)\<inter>int(BU) \<subseteq> AU\<inter>BU" using Top_2_L1 by auto
    with op have "int(AU)\<inter>int(BU)\<subseteq>int(AU\<inter>BU)" using Top_2_L5 by auto
    moreover note AU(1) BU(1)
    ultimately have "AU\<inter>BU: \<N>\<^sub>0" unfolding zerohoods_def by auto
    moreover have "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>AU\<inter>BU}\<subseteq>{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>AU}" by auto
    with AU(2) BU(2) have "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>AU\<inter>BU}\<subseteq>A\<inter>B" by auto
    ultimately have "A\<inter>B \<in> {V\<in>Pow(G\<times>G).\<exists>U\<in> \<N>\<^sub>0. {\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>U} \<subseteq> V}"
      using AU(3) BU(3) by blast
    then have "A\<inter>B\<in>leftUniformity" unfolding leftUniformity_def by simp
  }
  hence "\<forall>A\<in>leftUniformity. \<forall>B\<in>leftUniformity. A \<inter> B \<in> leftUniformity" by auto
  moreover
  {
    fix B C assume as:"B\<in>leftUniformity" "C\<in>Pow(G \<times> G)" "B \<subseteq> C"
    from as(1) obtain BU where BU:"BU\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> BU}\<subseteq>B"
      unfolding leftUniformity_def by blast
    from as(3) BU(2) have "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> BU}\<subseteq>C" by auto
    with as(2) BU(1) have "C \<in> {V\<in>Pow(G\<times>G).\<exists>U\<in> \<N>\<^sub>0. {\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in>U} \<subseteq> V}"
      by auto
    then have "C \<in> leftUniformity"  unfolding leftUniformity_def by auto
  }
  then have "\<forall>B\<in>leftUniformity. \<forall>C\<in>Pow(G\<times>G). B\<subseteq>C \<longrightarrow> C\<in>leftUniformity" by auto
  ultimately have leftFilter:"leftUniformity {is a filter on} (G\<times>G)" unfolding IsFilter_def
    by auto
  {
    assume "0\<in>rightUniformity"
    then obtain U where U:"U\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>U}\<subseteq>0" unfolding rightUniformity_def
      by auto
    have "\<langle>\<zero>,\<zero>\<rangle>:G\<times>G" using zero_in_tgroup by auto
    moreover have "\<zero>\<ra>(\<rm>\<zero>) = \<zero>"
      using group0_valid_in_tgroup group0.group_inv_of_one group0.group0_2_L2 zero_in_tgroup
      by auto
    moreover
    have "\<zero>\<in>int(U)" using U(1) by auto
    then have "\<zero>\<in>U" using Top_2_L1 by auto
    ultimately have "\<langle>\<zero>,\<zero>\<rangle>\<in>{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>U}" by auto
    with U(2) have "\<langle>\<zero>,\<zero>\<rangle>\<in>0" by blast
    hence False by auto
  }
  then have "0\<notin>rightUniformity" by auto
  moreover  have "rightUniformity \<subseteq> Pow(G\<times>G)" unfolding rightUniformity_def by auto
  moreover
  {
    have "G\<times>G\<in>Pow(G\<times>G)" by auto
    moreover have "{\<langle>s,t\<rangle>:G\<times>G. (\<rm>s)\<ra>t:G} \<subseteq> G\<times>G" by auto
    moreover note zneigh_not_empty
    ultimately have "G\<times>G \<in> rightUniformity" unfolding rightUniformity_def by auto
  }
  moreover
  {
    fix A B assume as:"A\<in>rightUniformity" "B\<in>rightUniformity"
    from as(1) obtain AU where AU:"AU\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>AU}\<subseteq> A" "A\<in>Pow(G\<times>G)"
      unfolding rightUniformity_def by auto
    from as(2) obtain BU where BU:"BU\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>BU}\<subseteq> B" "B\<in>Pow(G\<times>G)"
      unfolding rightUniformity_def by auto
    from AU(1) BU(1) have "\<zero>\<in>int(AU)\<inter>int(BU)" by auto
    moreover from AU BU have op:"int(AU)\<inter>int(BU)\<in>T"
      using Top_2_L2 topSpaceAssum IsATopology_def by auto
    moreover
    have "int(AU)\<inter>int(BU) \<subseteq> AU\<inter>BU" using Top_2_L1 by auto
    with op have "int(AU)\<inter>int(BU)\<subseteq>int(AU\<inter>BU)" using Top_2_L5 by auto
    moreover note AU(1) BU(1)
    ultimately have "AU\<inter>BU: \<N>\<^sub>0" unfolding zerohoods_def by auto
    moreover have "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>AU\<inter>BU}\<subseteq>{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>AU}" by auto
    with AU(2) BU(2) have "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>AU\<inter>BU}\<subseteq>A\<inter>B" by auto
    ultimately have "A\<inter>B \<in> {V\<in>Pow(G\<times>G).\<exists>U\<in> \<N>\<^sub>0. {\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in>U}\<subseteq> V}"
      using AU(3) BU(3) by blast
    then have "A\<inter>B \<in> rightUniformity" unfolding rightUniformity_def by simp
  }
  hence "\<forall>A\<in>rightUniformity. \<forall>B\<in>rightUniformity. A\<inter>B \<in> rightUniformity" by auto
  moreover
  {
    fix B C assume as:"B\<in>rightUniformity" "C\<in>Pow(G \<times> G)" "B \<subseteq> C"
    from as(1) obtain BU where BU:"BU\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> BU}\<subseteq>B"
      unfolding rightUniformity_def by blast
    from as(3) BU(2) have "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> BU}\<subseteq>C" by auto
    then have "C \<in> rightUniformity" using as(2) BU(1) unfolding rightUniformity_def by auto
  }
  then have "\<forall>B\<in>rightUniformity. \<forall>C\<in>Pow(G\<times>G). B\<subseteq>C \<longrightarrow> C\<in>rightUniformity" by auto
  ultimately have rightFilter:"rightUniformity {is a filter on} (G\<times>G)" unfolding IsFilter_def
    by auto
  {
    fix U assume as:"U\<in>leftUniformity"
    from as obtain V where V:"V\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> V} \<subseteq> U"
      unfolding leftUniformity_def by auto
    then have "V\<subseteq>G" by auto
    {
      fix x assume as2:"x\<in>id(G)"
      from as obtain V where V:"V\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> V} \<subseteq> U"
        unfolding leftUniformity_def by auto
      from V(1) have "\<zero>\<in>int(V)" by auto
      then have V0:"\<zero>\<in>V" using Top_2_L1 by auto
      from as2 obtain t where t:"x=\<langle>t,t\<rangle>" "t:G" by auto
      from t(2) have "(\<rm>t)\<ra>t =\<zero>" using group0_valid_in_tgroup group0.group0_2_L6
        by auto
      with V0 t V(2) have "x\<in>U" by auto
    }
    then have "id(G)\<subseteq>U" by auto
    moreover
    {
      {
        fix x assume ass:"x\<in>{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> \<sm>V}"
        then obtain s t where as:"s\<in>G" "t\<in>G" "(\<rm>s)\<ra>t \<in> \<sm>V" "x=\<langle>s,t\<rangle>" by force
        from as(3) \<open>V\<subseteq>G\<close> have "(\<rm>s)\<ra>t\<in>{\<rm>q. q\<in>V}" using ginv_image_add by simp
        then obtain q where q: "q\<in>V" "(\<rm>s)\<ra>t = \<rm>q" by auto
        with \<open>V\<subseteq>G\<close> have "q\<in>G" by auto
        with \<open>s\<in>G\<close> \<open>t\<in>G\<close> \<open>(\<rm>s)\<ra>t = \<rm>q\<close> have "q=(\<rm>t)\<ra>s"
          using simple_equation1_add by blast
        with q(1) have "(\<rm>t)\<ra>s \<in> V" by auto
        with as(1,2) have "\<langle>t,s\<rangle> \<in> U" using V(2) by auto
        then have "\<langle>s,t\<rangle> \<in> converse(U)" by auto
        with as(4) have "x \<in> converse(U)" by auto
      }
      then have "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> \<sm>V} \<subseteq> converse(U)" by auto
      moreover have "(\<sm>V):\<N>\<^sub>0" using neg_neigh_neigh V(1) by auto
      moreover note as
      ultimately have "converse(U) \<in> leftUniformity" unfolding leftUniformity_def by auto
    }
    moreover
    {
      from V(1) obtain W where W:"W:\<N>\<^sub>0" "W \<sad> W \<subseteq>V" using exists_procls_zerohood by blast
      {
        fix x assume as:"x \<in> {\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> W} O {\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> W}"
        then obtain x\<^sub>1 x\<^sub>2 x\<^sub>3 where
          x:"x\<^sub>1\<in>G" "x\<^sub>2\<in>G" "x\<^sub>3\<in>G" "(\<rm>x\<^sub>1)\<ra>x\<^sub>2 \<in> W" "(\<rm>x\<^sub>2)\<ra>x\<^sub>3 \<in> W" "x=\<langle>x\<^sub>1,x\<^sub>3\<rangle>"
          unfolding comp_def by auto
        from W(1) have "W\<sad>W = f``(W\<times>W)" using interval_add(2) by auto
        moreover from W(1) have WW:"W\<times>W\<subseteq>G\<times>G" by auto
        moreover
        from x(4,5) have "\<langle>(\<rm>x\<^sub>1)\<ra>x\<^sub>2,(\<rm>x\<^sub>2)\<ra>x\<^sub>3\<rangle>:W\<times>W" by auto
        with WW have "f`(\<langle>(\<rm>x\<^sub>1)\<ra>x\<^sub>2,(\<rm>x\<^sub>2)\<ra>x\<^sub>3\<rangle>):f``(W\<times>W)"
          using func_imagedef topgroup_f_binop by auto
        ultimately have "((\<rm>x\<^sub>1)\<ra>x\<^sub>2)\<ra>((\<rm>x\<^sub>2)\<ra>x\<^sub>3) :W\<sad>W" by auto
        moreover from x(1,2,3) have "((\<rm>x\<^sub>1)\<ra>x\<^sub>2)\<ra>((\<rm>x\<^sub>2)\<ra>x\<^sub>3) = (\<rm>x\<^sub>1)\<ra> x\<^sub>3"
          using cancel_middle_add(2) by simp
        ultimately have "(\<rm>x\<^sub>1)\<ra> x\<^sub>3\<in>W\<sad>W" by auto
        with W(2) have "(\<rm>x\<^sub>1)\<ra> x\<^sub>3\<in>V" by auto
        with x(1,3,6) have "x:{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> V}" by auto
      }
      then have "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> W} O {\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> W} \<subseteq> U"
        using V(2) by auto moreover
      have "{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> W}\<in>leftUniformity"
        unfolding leftUniformity_def using W(1) by auto
      ultimately have "\<exists>Z\<in>leftUniformity. Z O Z\<subseteq>U" by auto
    }
    ultimately have "id(G)\<subseteq>U \<and> (\<exists>Z\<in>leftUniformity. Z O Z\<subseteq>U) \<and> converse(U)\<in>leftUniformity"
      by blast
  }
  then have
    "\<forall>U\<in>leftUniformity. id(G)\<subseteq>U \<and> (\<exists>Z\<in>leftUniformity. Z O Z\<subseteq>U) \<and> converse(U)\<in>leftUniformity"
    by auto
  with leftFilter show "leftUniformity {is a uniformity on} G" unfolding IsUniformity_def by auto
  {
    fix U assume as:"U\<in>rightUniformity"
    from as obtain V where V:"V\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> V} \<subseteq> U"
      unfolding rightUniformity_def by auto
    {
      fix x assume as2:"x\<in>id(G)"
      from as obtain V where V:"V\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> V} \<subseteq> U"
        unfolding rightUniformity_def by auto
      from V(1) have "\<zero>\<in>int(V)" by auto
      then have V0:"\<zero>\<in>V" using Top_2_L1 by auto
      from as2 obtain t where t:"x=\<langle>t,t\<rangle>" "t:G" by auto
      from t(2) have "t\<ra>(\<rm>t) =\<zero>" using group0_valid_in_tgroup group0.group0_2_L6
        by auto
      with V0 t V(2) have "x\<in>U" by auto
    }
    then have "id(G)\<subseteq>U" by auto
    moreover
    {
      {
        fix x assume ass:"x\<in>{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> \<sm>V}"
        then obtain s t where as:"s\<in>G" "t\<in>G" "s\<ra>(\<rm>t) \<in> \<sm>V" "x=\<langle>s,t\<rangle>"
          by force
        from as(3) V(1) have "s\<ra>(\<rm>t) \<in> {\<rm>q. q\<in>V}"
          using ginv_image_add by simp
        then obtain q where q:"q\<in>V" "s\<ra>(\<rm>t) = \<rm>q" by auto
        with \<open>V\<in>\<N>\<^sub>0\<close> have "q\<in>G" by auto
        with as(1,2) q(1,2) have "t\<ra>(\<rm>s) \<in> V" using simple_equation0_add
          by blast
        with as(1,2,4) V(2) have "x \<in> converse(U)" by auto
      }
      then have "{\<langle>s,t\<rangle>\<in>G\<times>G.  s\<ra>(\<rm>t) \<in> \<sm>V} \<subseteq> converse(U)" by auto
      moreover from V(1) have "(\<sm>V) \<in> \<N>\<^sub>0" using neg_neigh_neigh by auto
      ultimately have "converse(U) \<in> rightUniformity" using as rightUniformity_def
        by auto
    }
    moreover
    {
      from V(1) obtain W where W:"W:\<N>\<^sub>0" "W \<sad> W \<subseteq>V" using exists_procls_zerohood by blast
      {
        fix x assume as:"x:{\<langle>s,t\<rangle>\<in>G\<times>G.  s\<ra>(\<rm>t) \<in> W} O {\<langle>s,t\<rangle>\<in>G\<times>G.  s\<ra>(\<rm>t) \<in> W}"
        then obtain x\<^sub>1 x\<^sub>2 x\<^sub>3 where
          x:"x\<^sub>1:G" "x\<^sub>2\<in>G" "x\<^sub>3\<in>G" "x\<^sub>1\<ra>(\<rm>x\<^sub>2) \<in> W" "x\<^sub>2\<ra>(\<rm>x\<^sub>3) \<in> W" "x=\<langle>x\<^sub>1,x\<^sub>3\<rangle>"
          unfolding comp_def by auto
        from W(1) have "W\<sad>W = f``(W\<times>W)" using interval_add(2) by auto
        moreover from W(1) have WW:"W\<times>W\<subseteq>G\<times>G" by auto
        moreover
        from x(4,5) have "\<langle>x\<^sub>1\<ra>(\<rm>x\<^sub>2),x\<^sub>2\<ra>(\<rm>x\<^sub>3)\<rangle> \<in> W\<times>W" by auto
        with WW have "f`(\<langle>x\<^sub>1\<ra>(\<rm>x\<^sub>2),x\<^sub>2\<ra>(\<rm>x\<^sub>3)\<rangle>) \<in> f``(W\<times>W)"
          using func_imagedef topgroup_f_binop  by auto
        ultimately have "(x\<^sub>1\<ra>(\<rm>x\<^sub>2))\<ra>(x\<^sub>2\<ra>(\<rm>x\<^sub>3)) \<in> W\<sad>W" by auto
        moreover from x(1,2,3) have "(x\<^sub>1\<ra>(\<rm>x\<^sub>2))\<ra>(x\<^sub>2\<ra>(\<rm>x\<^sub>3)) = x\<^sub>1\<ra> (\<rm>x\<^sub>3)"
          using cancel_middle_add(1) by simp
        ultimately have "x\<^sub>1\<ra>(\<rm>x\<^sub>3) \<in> W\<sad>W" by auto
        with W(2) have "x\<^sub>1\<ra>(\<rm>x\<^sub>3) \<in> V" by auto
        then have "x \<in> {\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> V}" using x(1,3,6) by auto
      }
      with V(2) have "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> W} O {\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> W} \<subseteq> U"
        by auto
      moreover from W(1) have "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t) \<in> W} \<in> rightUniformity"
        unfolding rightUniformity_def  by auto
      ultimately have "\<exists>Z\<in>rightUniformity. Z O Z\<subseteq>U" by auto
    }
    ultimately have "id(G)\<subseteq>U \<and> (\<exists>Z\<in>rightUniformity. Z O Z\<subseteq>U) \<and> converse(U)\<in>rightUniformity"
      by blast
  }
  then have
    "\<forall>U\<in>rightUniformity. id(G)\<subseteq>U \<and> (\<exists>Z\<in>rightUniformity. Z O Z\<subseteq>U) \<and> converse(U)\<in>rightUniformity"
    by auto
  with rightFilter show "rightUniformity {is a uniformity on} G" unfolding IsUniformity_def
    by auto
qed

text\<open> The topologies generated by the right and left uniformities are the original group topology. \<close>

lemma (in topgroup) top_generated_side_uniformities:
  shows "UniformTopology(leftUniformity,G) = T" and "UniformTopology(rightUniformity,G) = T"
proof-
  let ?M = "{\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle>. t\<in>G}"
  have fun:"?M:G\<rightarrow>Pow(Pow(G))" using neigh_from_uniformity side_uniformities(1) IsNeighSystem_def
    by auto
  let ?N = "{\<langle>t, {V `` {t} . V \<in> rightUniformity}\<rangle>. t\<in>G}"
  have funN:"?N:G\<rightarrow>Pow(Pow(G))" using neigh_from_uniformity side_uniformities(2) IsNeighSystem_def
    by auto
  {
    fix U assume op:"U\<in>T"
    hence "U\<subseteq>G" by auto
    {
      fix x assume x:"x\<in>U"
      with op have xg:"x\<in>G" and "(\<rm>x) \<in> G" using neg_in_tgroup by auto
      then have "\<langle>x, {V``{x}. V \<in> leftUniformity}\<rangle> \<in> {\<langle>t, {V``{t}. V \<in> leftUniformity}\<rangle>. t\<in>G}"
        by auto
      with fun have app:"?M`(x) = {V``{x}. V \<in> leftUniformity}" using ZF_fun_from_tot_val
        by auto
      have "(\<rm>x)\<ltr>U : \<N>\<^sub>0" using open_trans_neigh op x by auto
      then have V:"{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t\<in>((\<rm>x)\<ltr>U)} \<in> leftUniformity"
        unfolding leftUniformity_def by auto
      with xg have
        N:"\<forall>t\<in>G. t:{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t\<in>((\<rm>x)\<ltr>U)}``{x} \<longleftrightarrow> (\<rm>x)\<ra>t\<in>((\<rm>x)\<ltr>U)"
        using image_iff by auto
      {
        fix t assume t:"t\<in>G"
        {
          assume as:"(\<rm>x)\<ra>t\<in>((\<rm>x)\<ltr>U)"
          then have "(\<rm>x)\<ra>t\<in>LeftTranslation(G,f,\<rm>x)``U" by auto
          then obtain q where q:"q\<in>U" "\<langle>q,(\<rm>x)\<ra>t\<rangle>\<in>LeftTranslation(G,f,\<rm>x)"
            using image_iff by auto
          with op have "q\<in>G" by auto
          from q(2) have "(\<rm>x)\<ra>q = (\<rm>x)\<ra>t" unfolding LeftTranslation_def
            by auto
          with \<open>(\<rm>x) \<in> G\<close> \<open>q\<in>G\<close> \<open>t\<in>G\<close> have "q = t" using neg_in_tgroup cancel_left_add
            by blast
          with q(1) have "t\<in>U" by auto
        }
        moreover
        {
          assume t:"t\<in>U"
          with \<open>U\<subseteq>G\<close> \<open>(\<rm>x)\<in>G\<close> have "(\<rm>x)\<ra>t \<in> ((\<rm>x)\<ltr>U)"
            using lrtrans_image(1) by auto
        }
        ultimately have "(\<rm>x)\<ra>t\<in>((\<rm>x)\<ltr>U) \<longleftrightarrow> t:U" by blast
      }
      with N have "\<forall>t\<in>G. t:{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t \<in> ((\<rm>x)\<ltr>U)}``{x} \<longleftrightarrow> t\<in>U"
        by blast
      with op have "\<forall>t. t:{\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t\<in>((\<rm>x)\<ltr>U)}``{x} \<longleftrightarrow> t:U"
        by auto
      hence "U = {\<langle>s,t\<rangle>\<in>G\<times>G. (\<rm>s)\<ra>t\<in>((\<rm>x)\<ltr>U)}``{x}" by auto
      with V have "\<exists>V\<in>leftUniformity. U=V``{x}" by blast
      with app have "U \<in> {\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle> . t \<in> G}`(x)" by auto
      moreover from \<open>x\<in>G\<close> funN have app:"?N`(x) = {V``{x}. V \<in> rightUniformity}"
        using ZF_fun_from_tot_val by simp
      moreover
      from x op have openTrans:"U\<rtr>(\<rm>x): \<N>\<^sub>0" using open_trans_neigh_2 by auto
      then have V:"{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t)\<in>(U\<rtr>(\<rm>x))} \<in> rightUniformity"
        unfolding rightUniformity_def by auto
      with xg have
        N:"\<forall>t\<in>G. t:{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t)\<in>(U\<rtr>(\<rm>x))}-``{x} \<longleftrightarrow> t\<ra>(\<rm>x)\<in>(U\<rtr>(\<rm>x))"
        using vimage_iff by auto
      moreover
      {
        fix t assume t:"t\<in>G"
        {
          assume as:"t\<ra>(\<rm>x)\<in>(U\<rtr>(\<rm>x))"
          hence "t\<ra>(\<rm>x)\<in>RightTranslation(G,f,\<rm>x)``U" by auto
          then obtain q where q:"q\<in>U" "\<langle>q,t\<ra>(\<rm>x)\<rangle>\<in>RightTranslation(G,f,\<rm>x)"
            using image_iff by auto
          with op have "q\<in>G" by auto
          from q(2) have "q\<ra>(\<rm>x) = t\<ra>(\<rm>x)" unfolding RightTranslation_def by auto
          with \<open>q\<in>G\<close> \<open>(\<rm>x) \<in> G\<close> \<open>t\<in>G\<close> have "q = t" using cancel_right_add by simp
          with q(1) have "t\<in>U" by auto
        }
        moreover
        {
          assume "t\<in>U"
          with \<open>(\<rm>x)\<in>G\<close> \<open>U\<subseteq>G\<close> have "t\<ra>(\<rm>x)\<in>(U\<rtr>(\<rm>x))" using lrtrans_image(2)
            by auto
        } ultimately have "t\<ra>(\<rm>x)\<in>(U\<rtr>(\<rm>x)) \<longleftrightarrow> t:U" by blast
      } with N have "\<forall>t\<in>G. t:{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t)\<in>(U\<rtr>(\<rm>x))}-``{x} \<longleftrightarrow> t:U"
        by blast
      with op have "\<forall>t. t:{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t)\<in>(U\<rtr>(\<rm>x))}-``{x} \<longleftrightarrow> t:U"
        by auto
      hence "{\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t)\<in>(U\<rtr>(\<rm>x))}-``{x} = U" by auto
      then have "U = converse({\<langle>s,t\<rangle>\<in>G\<times>G. s\<ra>(\<rm>t)\<in>(U\<rtr>(\<rm>x))})``{x}"
        unfolding vimage_def by simp
      with V app have "U \<in> {\<langle>t, {V `` {t} . V \<in> rightUniformity}\<rangle> . t \<in> G}`(x)"
        using side_uniformities(2) IsUniformity_def by auto
      ultimately have
        "U \<in> {\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle> . t \<in> G}`(x)" and
        "U \<in> {\<langle>t, {V `` {t} . V \<in> rightUniformity}\<rangle> . t \<in> G}`(x)"
        by auto
    }
    hence
      "\<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle> . t \<in> G} ` x" and
      "\<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> rightUniformity}\<rangle> . t \<in> G} ` x"
      by auto
  }
  hence
    "T\<subseteq>{U \<in> Pow(G) . \<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle> . t \<in> G} ` x}" and
    "T\<subseteq>{U \<in> Pow(G) . \<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> rightUniformity}\<rangle> . t \<in> G} ` x}"
    by auto
  moreover
  {
    fix U assume as:"U \<in> Pow(G)" "\<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle> . t \<in> G}`(x)"
    {
      fix x assume x:"x\<in>U"
      with as(1) have xg:"x\<in>G" by auto
      from x as(2) have "U\<in>{\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle> . t \<in> G}`(x)" by auto
      with xg fun have "U\<in>{V `` {x} . V \<in> leftUniformity}" using apply_equality by auto
      then obtain V where V:"U=V``{x}" "V\<in>leftUniformity" by auto
      from V(2) obtain W where W:"W\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>:G\<times>G. (\<rm>s)\<ra>t:W}\<subseteq>V"
        unfolding leftUniformity_def by auto
      from W(2) have A:"{\<langle>s,t\<rangle>:G\<times>G. (\<rm>s)\<ra>t:W}``{x}\<subseteq>V``{x}" by auto
      from xg have "\<forall>q\<in>G. q\<in>({\<langle>s,t\<rangle>:G\<times>G. (\<rm>s)\<ra>t:W}``{x}) \<longleftrightarrow> (\<rm>x)\<ra>q:W"
        using image_iff by auto
      hence B:"{\<langle>s,t\<rangle>:G\<times>G. (\<rm>s)\<ra>t:W}``{x} = {t\<in>G. (\<rm>x)\<ra>t:W}" by auto
      from W(1) have WG:"W\<subseteq>G" by auto
      {
        fix t assume t:"t \<in> x\<ltr>W"
        then have "t \<in> LeftTranslation(G,f,x)``W" by auto
        then obtain s where s:"s\<in>W" "\<langle>s,t\<rangle>\<in>LeftTranslation(G,f,x)" using image_iff by auto
        with \<open>W\<subseteq>G\<close> have "s\<in>G" by auto
        from s(2) have "t=x\<ra>s" "t\<in>G" unfolding LeftTranslation_def by auto
        with \<open>x\<in>G\<close> \<open>s\<in>G\<close> have "(\<rm>x)\<ra>t = s" using put_on_the_other_side(2) by simp
        with s(1) have "(\<rm>x)\<ra>t\<in>W" by auto
        with \<open>t\<in>G\<close> have "t \<in> {s\<in>G. (\<rm>x)\<ra>s:W}" by auto
      }
      then have "x\<ltr>W \<subseteq> {t\<in>G. (\<rm>x)\<ra>t\<in>W}" by auto
      with B have "x \<ltr> W \<subseteq> {\<langle>s,t\<rangle> \<in> G \<times> G . (\<rm> s) \<ra> t \<in> W} `` {x}" by auto
      with A have "x \<ltr> W \<subseteq> V`` {x}" by blast
      with V(1) have "x \<ltr> W \<subseteq> U" by auto
      then have "int(x \<ltr> W) \<subseteq> U" using Top_2_L1 by blast
      moreover from xg W(1) have "x\<in>int(x \<ltr> W)" using elem_in_int_ltrans(1) by auto
      moreover have "int(x \<ltr> W)\<in>T" using Top_2_L2 by auto
      ultimately have "\<exists>Y\<in>T. x\<in>Y \<and> Y\<subseteq>U" by auto
    }
    then have "U\<in>T" using open_neigh_open by auto
  } hence  "{U \<in> Pow(G) . \<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> leftUniformity}\<rangle> . t \<in> G} ` x} \<subseteq> T"
    by auto
  moreover
  {
    fix U assume as:"U \<in> Pow(G)" "\<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> rightUniformity}\<rangle> . t \<in> G} ` x"
    {
      fix x assume x:"x\<in>U"
      with as(1) have xg:"x\<in>G" by auto
      from x as(2) have "U\<in>{\<langle>t, {V `` {t} . V \<in> rightUniformity}\<rangle> . t \<in> G} ` x" by auto
      with xg funN have "U\<in>{V `` {x} . V \<in> rightUniformity}" using apply_equality
        by auto
      then obtain V where V:"U=V``{x}" "V \<in> rightUniformity" by auto
      then have "converse(V) \<in> rightUniformity" using side_uniformities(2) IsUniformity_def
        by auto
      then obtain W where W:"W\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>:G\<times>G. s\<ra>(\<rm>t):W}\<subseteq>converse(V)"
        unfolding rightUniformity_def by auto
      from W(2) have A:"{\<langle>s,t\<rangle>:G\<times>G. s\<ra>(\<rm>t):W}-``{x}\<subseteq>V``{x}" by auto
      from xg have "\<forall>q\<in>G. q\<in>({\<langle>s,t\<rangle>:G\<times>G. s\<ra>(\<rm>t):W}-``{x}) \<longleftrightarrow> q\<ra>(\<rm>x):W"
        using image_iff by auto
      hence B:"{\<langle>s,t\<rangle>:G\<times>G. s\<ra>(\<rm>t):W}-``{x} = {t\<in>G. t\<ra>(\<rm>x):W}" by auto
      from W(1) have WG:"W\<subseteq>G" by auto
      {
        fix t assume "t \<in> W\<rtr>x"
        with \<open>x\<in>G\<close> \<open>W\<subseteq>G\<close> obtain s where "s\<in>W" and "t=s\<ra>x" using lrtrans_image(2)
          by auto
        with \<open>W\<subseteq>G\<close> have "s\<in>G" by auto
        with \<open>x\<in>G\<close> \<open>t=s\<ra>x\<close> have "t\<in>G" using group_op_closed_add by simp
        from \<open>x\<in>G\<close> \<open>s\<in>G\<close> \<open>t=s\<ra>x\<close> have "t\<ra>(\<rm>x) = s" using put_on_the_other_side
          by simp
        with \<open>s\<in>W\<close> \<open>t\<in>G\<close> have "t \<in> {s\<in>G. s\<ra>(\<rm>x) \<in> W}" by auto
      }
      then have "W\<rtr>x \<subseteq> {t:G. t\<ra>(\<rm>x):W}" by auto
      with B have "W \<rtr> x \<subseteq> {\<langle>s,t\<rangle> \<in> G \<times> G . s \<ra> (\<rm> t) \<in> W}-``{x}" by auto
      with A have "W \<rtr> x \<subseteq> V`` {x}" by blast
      with V(1) have "W \<rtr> x \<subseteq> U" by auto
      then have "int(W \<rtr> x) \<subseteq> U" using Top_2_L1 by blast
      moreover
      from xg W(1) have "x\<in>int(W \<rtr> x)" using elem_in_int_rtrans(1) by auto
      moreover have "int(W \<rtr> x)\<in>T" using Top_2_L2 by auto
      ultimately have "\<exists>Y\<in>T. x\<in>Y \<and> Y\<subseteq>U" by auto
    }
    then have "U\<in>T" using open_neigh_open by auto
  }
  ultimately have
  "{U \<in> Pow(G). \<forall>x\<in>U. U \<in> {\<langle>t, {V``{t} . V \<in> leftUniformity}\<rangle>. t \<in> G}`(x)} = T"
  "{U \<in> Pow(G). \<forall>x\<in>U. U \<in> {\<langle>t, {V``{t} . V \<in> rightUniformity}\<rangle>. t \<in> G}`(x)} = T"
    by auto
  then show "UniformTopology(leftUniformity,G) = T" and "UniformTopology(rightUniformity,G) = T"
    using uniftop_def_alt by auto
qed

text\<open> The side uniformities are called this way because of how they affect left and right translations.
 In the next lemma we show that left translations are uniformly continuous with respect to the left uniformity. \<close>

lemma (in topgroup) left_mult_uniformity: assumes "x\<in>G"
  shows
    "LeftTranslation(G,f,x) {is uniformly continuous between} leftUniformity {and} leftUniformity"
proof -
  let ?P = "ProdFunction(LeftTranslation(G, f, x), LeftTranslation(G, f, x))"
  from assms have L: "LeftTranslation(G,f,x):G\<rightarrow>G" and "leftUniformity {is a uniformity on} G"
    using group0_5_L1 side_uniformities(1) by auto
  moreover have "\<forall>V \<in> leftUniformity. ?P-``(V) \<in> leftUniformity"
  proof -
    { fix V assume "V \<in> leftUniformity"
      then obtain U where "U \<in> \<N>\<^sub>0" and "{\<langle>s,t\<rangle> \<in> G \<times> G . (\<rm> s) \<ra> t \<in> U} \<subseteq> V"
        unfolding leftUniformity_def by auto
      with \<open>V \<in> leftUniformity\<close> have
        as:"V \<subseteq> G \<times> G" "U \<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle> \<in> G \<times> G . (\<rm> s) \<ra> t \<in> U} \<subseteq> V"
        unfolding leftUniformity_def by auto
      { fix z assume z:"z \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . (\<rm> s) \<ra> t \<in> U}"
        then obtain s t where st:"z=\<langle>s,t\<rangle>" "s\<in>G" "t\<in>G" by auto
        from st(1) z have st2: "(\<rm> s) \<ra> t \<in> U" by auto
        from assms st have
          "?P`(z) = \<langle>LeftTranslation(G, f, x)`(s), LeftTranslation(G, f, x)`(t)\<rangle>"
          using prodFunctionApp group0_5_L1(2) by blast
        with assms st(2,3) have "?P`(z) = \<langle>x\<ra>s,x\<ra>t\<rangle>" using group0_5_L2(2)
          by auto
        moreover
        from \<open>x\<in>G\<close> \<open>s\<in>G\<close> \<open>t\<in>G\<close> have "(\<rm> (x\<ra>s)) \<ra> (x\<ra>t) = (\<rm>s)\<ra>t"
          using cancel_middle_add(3) by simp
        with st2 have "(\<rm> (x\<ra>s)) \<ra> (x\<ra>t) \<in> U" by auto
        ultimately have "?P`(z) \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . (\<rm> s) \<ra> t \<in> U}"
          using assms st(2,3) group_op_closed by auto
        with as(3) have "?P`(z) \<in> V" by force
        with L z have "z \<in> ?P-``(V)" using prodFunction func1_1_L5A vimage_iff
          by blast
      }
      with as(2) have "\<exists>U\<in>\<N>\<^sub>0. {\<langle>s,t\<rangle> \<in> G \<times> G . (\<rm> s) \<ra> t \<in> U} \<subseteq> ?P-``(V)"
        by blast
      with \<open>LeftTranslation(G,f,x):G\<rightarrow>G\<close> \<open>V \<subseteq> G \<times> G\<close> have "?P-``(V) \<in> leftUniformity"
        unfolding leftUniformity_def using prodFunction func1_1_L6A by blast
    } thus ?thesis by simp
  qed
  ultimately show ?thesis using IsUniformlyCont_def by auto
qed

text\<open> Right translations are uniformly continuous with respect to the right uniformity. \<close>

lemma (in topgroup) right_mult_uniformity: assumes "x\<in>G"
  shows
    "RightTranslation(G,f,x) {is uniformly continuous between} rightUniformity {and} rightUniformity"
proof -
  let ?P = "ProdFunction(RightTranslation(G, f, x), RightTranslation(G, f, x))"
  from assms have R: "RightTranslation(G,f,x):G\<rightarrow>G" and "rightUniformity {is a uniformity on} G"
    using group0_5_L1 side_uniformities(2) by auto
  moreover have "\<forall>V \<in> rightUniformity. ?P-``(V) \<in> rightUniformity"
  proof -
    { fix V assume "V \<in> rightUniformity"
      then obtain U where "U \<in> \<N>\<^sub>0" and "{\<langle>s,t\<rangle> \<in> G \<times> G . s \<ra> (\<rm> t) \<in> U} \<subseteq> V"
        unfolding rightUniformity_def by auto
      with \<open>V \<in> rightUniformity\<close> have
        as:"V \<subseteq> G \<times> G" "U \<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle> \<in> G \<times> G . s \<ra> (\<rm> t) \<in> U} \<subseteq> V"
        unfolding rightUniformity_def by auto
      { fix z assume z:"z \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . s \<ra> (\<rm> t) \<in> U}"
        then obtain s t where st:"z=\<langle>s,t\<rangle>" "s\<in>G" "t\<in>G" by auto
        from st(1) z have st2: "s \<ra> (\<rm>t) \<in> U" by auto
        from assms st have "?P`(z) = \<langle>RightTranslation(G, f, x)`(s), RightTranslation(G, f, x)`(t)\<rangle>"
          using prodFunctionApp group0_5_L1(1) by blast
        with assms st(2,3) have "?P`(z) = \<langle>s\<ra>x,t\<ra>x\<rangle>" using group0_5_L2(1)
          by auto
        moreover
        from \<open>x\<in>G\<close> \<open>s\<in>G\<close> \<open>t\<in>G\<close> have "(s\<ra>x) \<ra> (\<rm>(t\<ra>x)) =s\<ra> (\<rm>t)"
          using cancel_middle_add(4) by simp
        with st2 have "(s\<ra>x) \<ra> (\<rm>(t\<ra>x)) \<in> U" by auto
        ultimately have "?P`(z) \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . s \<ra> (\<rm> t) \<in> U}"
          using assms st(2,3) group_op_closed by auto
        with as(3) have "?P`(z) \<in> V" by force
        with R z have "z \<in> ?P-``(V)" using prodFunction func1_1_L5A vimage_iff
          by blast
      }
      with as(2) have "\<exists>U\<in>\<N>\<^sub>0. {\<langle>s,t\<rangle> \<in> G \<times> G . s \<ra> (\<rm> t) \<in> U} \<subseteq> ?P-``(V)"
        by blast
      with \<open>RightTranslation(G,f,x):G\<rightarrow>G\<close> \<open>V \<subseteq> G \<times> G\<close> have "?P-``(V) \<in> rightUniformity"
        unfolding rightUniformity_def using prodFunction func1_1_L6A by blast
    } thus ?thesis by simp
  qed
  ultimately show ?thesis using IsUniformlyCont_def by auto
qed

text\<open> The third uniformity important on topological groups is called the uniformity of Roelcke. \<close>

definition(in topgroup) roelckeUniformity
 where "roelckeUniformity \<equiv> {V\<in>Pow(G\<times>G). \<exists>U\<in> \<N>\<^sub>0. {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(U\<rtr>s)\<sad>U}\<subseteq> V}"

text\<open>The Roelcke uniformity is indeed a uniformity on the group. \<close>

lemma (in topgroup) roelcke_uniformity:
  shows "roelckeUniformity {is a uniformity on} G"
proof -
  let ?\<Phi> = "roelckeUniformity"
  have "\<forall>U \<in> ?\<Phi>. id(G)\<subseteq>U \<and> (\<exists>V\<in>?\<Phi>. V O V \<subseteq> U) \<and> converse(U) \<in> ?\<Phi>"
  proof
    fix U assume U:"U \<in> roelckeUniformity"
    then obtain V where V:"{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(V\<rtr>s)\<sad>V} \<subseteq> U" "V\<in> \<N>\<^sub>0" "U:Pow(G\<times>G)"
      unfolding roelckeUniformity_def by auto
    from V(2) have VG:"V\<subseteq>G" by auto
    have "id(G) \<subseteq> U"
    proof -
      from V(2) have "\<zero>\<in>int(V)" by auto
      then have V0:"\<zero>\<in>V" using Top_2_L1 by auto
      { fix x assume x:"x\<in>G"
        with \<open>V\<in>\<N>\<^sub>0\<close> have "x \<in> V\<rtr>x" using elem_in_int_rtrans(1) Top_2_L1 by blast
        with \<open>V\<subseteq>G\<close> \<open>x\<in>G\<close> \<open>\<zero>\<in>V\<close> have "x\<ra>\<zero> : (V\<rtr>x)\<sad>V"
          using lrtrans_in_group_add(2) interval_add(4) by auto
        with \<open>x\<in>G\<close>  have "x: (V\<rtr>x)\<sad>V" using group0_2_L2 by auto
        with \<open>x\<in>G\<close> have "\<langle>x,x\<rangle>:{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(V\<rtr>s)\<sad>V}" by auto
        with V(1) have "\<langle>x,x\<rangle>\<in>U" by auto
      } thus "id(G) \<subseteq> U" by auto
    qed
    moreover have "converse(U) \<in> ?\<Phi>"
    proof -
      { fix l assume "l \<in> {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>((\<sm>V)\<rtr>s)\<sad>(\<sm>V)}"
        then obtain s t where st:"s\<in>G" "t\<in>G" "t \<in>((\<sm>V)\<rtr>s)\<sad>(\<sm>V)" "l=\<langle>s,t\<rangle>"
          by force
        from \<open>V\<subseteq>G\<close> have smG:"(\<sm>V) \<subseteq> G" using ginv_image_add(1) by simp
        with \<open>s\<in>G\<close> have VxG:"(\<sm>V)\<rtr>s \<subseteq> G" using lrtrans_in_group_add(2) by simp
        from \<open>V\<subseteq>G\<close> \<open>t\<in>G\<close> have VsG:"V\<rtr>t \<subseteq> G" using lrtrans_in_group_add(2) by simp
        from st(3) VxG smG obtain x y where xy:"t = x\<ra>y" "x \<in> (\<sm>V)\<rtr>s" "y\<in>(\<sm>V)"
          using elements_in_set_sum by blast
        from xy(2) smG st(1) obtain z where z:"x = z\<ra>s" "z\<in>(\<sm>V)" using elements_in_rtrans
          by blast
        with \<open>y\<in>(\<sm>V)\<close> \<open>(\<sm>V)\<subseteq>G\<close> \<open>s\<in>G\<close> \<open>t = x\<ra>y\<close>
        have ts:"(\<rm>z)\<ra>t\<ra>(\<rm>y) = s" using cancel_middle_add(5) by blast
        {
          fix u assume "u\<in>(\<sm>V)"
          with \<open>V\<subseteq>G\<close> have "(\<rm>u) \<in> V" using ginv_image_el_add by simp
        } hence R:"\<forall>u\<in>(\<sm>V).(\<rm>u) \<in> V" by simp
        with z(2) xy(3) have zy:"(\<rm>z)\<in>V" "(\<rm>y)\<in>V" by auto
        from zy(1) VG st(2) have "(\<rm>z)\<ra>t : V\<rtr>t" using lrtrans_image(2) by auto
        with zy(2) VG VsG have "(\<rm>z)\<ra>t\<ra>(\<rm>y) : (V\<rtr>t)\<sad>V"
          using interval_add(4) by auto
        with ts have "s:(V\<rtr>t)\<sad>V" by auto
        with st(1,2) have "\<langle>s,t\<rangle> \<in> converse({\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(V\<rtr>s)\<sad>V})"
          using converse_iff by auto
        with V(1) have "\<langle>s,t\<rangle> \<in>  converse(U)" by auto
        with st(4) have "l \<in> converse(U)" by auto
      } then have "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>((\<sm>V)\<rtr>s)\<sad>(\<sm>V)} \<subseteq> converse(U)" by auto
      moreover from V(2) have "(\<sm>V): \<N>\<^sub>0" using neg_neigh_neigh by auto
      ultimately have "\<exists>V\<in> \<N>\<^sub>0. {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(V\<rtr>s)\<sad>V} \<subseteq> converse(U)" by auto
      moreover
      from V(3) have "converse(U) \<subseteq> G\<times>G" unfolding converse_def by auto
      ultimately show "converse(U) \<in> roelckeUniformity" unfolding roelckeUniformity_def by auto
    qed
    moreover have "\<exists>Z\<in>?\<Phi>. Z O Z \<subseteq> U"
    proof -
      from V(2) obtain W where W:"W\<in>\<N>\<^sub>0" "W\<sad>W \<subseteq> V" using exists_procls_zerohood by blast
      then have WG:"W\<subseteq>G" by auto
      moreover
      { fix k assume as:"k:{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(W\<rtr>s)\<sad>W} O {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(W\<rtr>s)\<sad>W}"
        then obtain x\<^sub>1 x\<^sub>2 x\<^sub>3 where
          x:"x\<^sub>1\<in>G" "x\<^sub>2\<in>G" "x\<^sub>3\<in>G" "x\<^sub>2 \<in> (W\<rtr>x\<^sub>1)\<sad>W" "x\<^sub>3 \<in> (W\<rtr>x\<^sub>2)\<sad>W" "k=\<langle>x\<^sub>1,x\<^sub>3\<rangle>"
          unfolding comp_def by auto
        from \<open>x\<^sub>1\<in>G\<close> have VsG:"W\<rtr>x\<^sub>1 \<subseteq> G" and Vx1G:"V\<rtr>x\<^sub>1 \<subseteq> G"
          using lrtrans_in_group_add(2) by auto
        from x(4) VsG WG obtain x y where xy:"x\<^sub>2 = x\<ra>y" "x \<in> W\<rtr>x\<^sub>1" "y\<in>W"
          using elements_in_set_sum by blast
        from xy(2) WG x(1) obtain z where z:"x = z\<ra>x\<^sub>1" "z\<in>W" using elements_in_rtrans
          by blast
        from z(2) xy(3) WG have yzG:"y\<in>G" "z\<in>G" by auto
        from x(2) have VsG:"W\<rtr>x\<^sub>2 \<subseteq> G" using lrtrans_in_group_add by simp
        from x(5) VsG WG obtain x' y' where xy2:"x\<^sub>3 = x'\<ra>y'" "x'\<in> W\<rtr>x\<^sub>2" "y'\<in>W"
          using elements_in_set_sum by blast
        from xy2(2) WG x(2) obtain z' where z2:"x' = z'\<ra>x\<^sub>2" "z'\<in>W" using elements_in_rtrans
          by blast
        from z2(2) xy2(3) WG have yzG2:"y'\<in>G" "z'\<in>G" by auto
        from xy(1) z(1) xy2(1) z2(1) have "x\<^sub>3 = (z'\<ra>(z\<ra>x\<^sub>1\<ra>y))\<ra>y'" by auto
        with yzG yzG2 x(1) have x3:"x\<^sub>3 = ((z'\<ra>z)\<ra>x\<^sub>1)\<ra>(y\<ra>y')"
          using group_oper_assoc group_op_closed by simp
        from xy(3) z(2) xy2(3) z2(2) WG have "z'\<ra>z \<in>  W\<sad>W" "y\<ra>y' \<in> W\<sad>W"
          using interval_add(4) by auto
        with W(2) have yzV:"z'\<ra>z \<in> V" "y\<ra>y' \<in> V" by auto
        from yzV(1) VG x(1) have "(z'\<ra>z)\<ra>x\<^sub>1 \<in> V\<rtr>x\<^sub>1" using lrtrans_image(2) by auto
        with yzV(2) Vx1G VG have "((z'\<ra>z)\<ra>x\<^sub>1)\<ra>(y\<ra>y') \<in> (V\<rtr>x\<^sub>1)\<sad>V"
          using interval_add(4) by auto
        with x3 have "x\<^sub>3 \<in> (V\<rtr>x\<^sub>1)\<sad>V" by auto
        with x(1,3,6) have "k:{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(V\<rtr>s)\<sad>V}" by auto
      }
      with V(1) have "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(W\<rtr>s)\<sad>W} O {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(W\<rtr>s)\<sad>W}\<subseteq>U"
        by auto
      moreover from W(1) have "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(W\<rtr>s)\<sad>W}\<in>roelckeUniformity"
        unfolding roelckeUniformity_def by auto
      ultimately show "\<exists>Z\<in>roelckeUniformity. Z O Z \<subseteq> U" by auto
    qed
    ultimately show "id(G)\<subseteq>U \<and> (\<exists>V\<in>?\<Phi>. V O V \<subseteq> U) \<and> converse(U) \<in> ?\<Phi>" by simp
  qed
  moreover
  have "roelckeUniformity {is a filter on} (G \<times> G)"
  proof -
    {
      assume "0 \<in> roelckeUniformity"
      then obtain W where U:"W\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(W\<rtr>s)\<sad>W}\<subseteq>0"
        unfolding roelckeUniformity_def by auto
      have "\<langle>\<zero>,\<zero>\<rangle>:G\<times>G" using zero_in_tgroup by auto
      moreover have "\<zero> = \<zero>\<ra>\<zero>\<ra>\<zero>" using group0_2_L2 zero_in_tgroup by auto
      moreover
      from U(1) have "\<zero>\<in>int(W)" by auto
      then have "\<zero>\<in>W" using Top_2_L1 by auto
      with \<open>W\<in>\<N>\<^sub>0\<close> have "\<zero>\<ra>\<zero>\<ra>\<zero> \<in> (W\<rtr>\<zero>)\<sad>W"
        using  group0_2_L2 group_op_closed trans_neutral_image interval_add_zero
        by auto
      ultimately have "\<langle>\<zero>,\<zero>\<rangle>\<in>{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(W\<rtr>s)\<sad>W}" by auto
      with U(2) have False by blast
    }
    moreover
    {
      fix x xa assume as:"x \<in> roelckeUniformity" "xa\<in>x"
      have "roelckeUniformity \<subseteq> Pow(G\<times>G)" unfolding roelckeUniformity_def by auto
      with as have "xa \<in> G\<times>G" by auto
    }
    moreover
    {
      have "G\<times>G\<in>Pow(G\<times>G)" by auto
      moreover
      have "{\<langle>s,t\<rangle>:G\<times>G.  t \<in>(G\<rtr>s)\<sad>G} \<subseteq> G\<times>G" by auto
      moreover note zneigh_not_empty
      ultimately have "G\<times>G\<in>roelckeUniformity" unfolding roelckeUniformity_def by auto
    }
    moreover
    {
      fix A B assume as:"A\<in>roelckeUniformity" "B\<in>roelckeUniformity"
      from as(1) obtain AU where
        AU:"AU\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(AU\<rtr>s)\<sad>AU}\<subseteq> A" "A\<in>Pow(G\<times>G)"
        unfolding roelckeUniformity_def by auto
      from as(2) obtain BU where
        BU:"BU\<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(BU\<rtr>s)\<sad>BU}\<subseteq> B" "B\<in>Pow(G\<times>G)"
        unfolding roelckeUniformity_def by auto
      from AU(1) BU(1) have "\<zero> \<in> int(AU)\<inter>int(BU)" by auto
      moreover have op:"int(AU)\<inter>int(BU)\<in>T" using Top_2_L2 topSpaceAssum unfolding IsATopology_def
        by auto
      moreover
      have "int(AU)\<inter>int(BU) \<subseteq> AU\<inter>BU" using Top_2_L1 by auto
      with op have "int(AU)\<inter>int(BU)\<subseteq>int(AU\<inter>BU)" using Top_2_L5
        by auto
      moreover note AU(1) BU(1)
      ultimately have interNeigh:"AU\<inter>BU \<in> \<N>\<^sub>0" unfolding zerohoods_def by auto
      moreover
      {
        fix z assume "z \<in> {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>((AU\<inter>BU)\<rtr>s)\<sad>(AU\<inter>BU)}"
        then obtain s t where
          z:"z=\<langle>s,t\<rangle>" "s\<in>G" "t\<in>G" "t \<in> ((AU\<inter>BU)\<rtr>s)\<sad>(AU\<inter>BU)"
          by force
        from \<open>AU\<inter>BU \<in> \<N>\<^sub>0\<close> \<open>s\<in>G\<close> have "AU\<inter>BU \<subseteq> G" and "(AU\<inter>BU)\<rtr>s \<subseteq>G"
          using lrtrans_in_group_add(2) by auto
        with z(4) obtain  x y where t:"t=x\<ra>y" "x\<in>(AU\<inter>BU)\<rtr>s" "y\<in>AU\<inter>BU"
          using elements_in_set_sum by blast
        from t(2) z(2) interNeigh obtain q where x:"x=q\<ra>s" "q \<in> AU\<inter>BU" using lrtrans_image(2)
          by auto
        with AU(1) BU(1) z(2) have "x \<in> AU\<rtr>s" "x \<in> BU\<rtr>s" using lrtrans_image(2) by auto
        with \<open>y \<in> AU\<inter>BU\<close> \<open>AU\<in> \<N>\<^sub>0\<close> \<open>BU\<in> \<N>\<^sub>0\<close> \<open>s \<in> G\<close> \<open>t=x\<ra>y\<close> have
          "t \<in> (AU\<rtr>s)\<sad>AU" and "t \<in> (BU\<rtr>s)\<sad>BU"
          using lrtrans_in_group_add(2) elements_in_set_sum_inv by auto
        with z(1,2,3) have
          "z \<in> {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(AU\<rtr>s)\<sad>AU}" and "z \<in>{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(BU\<rtr>s)\<sad>BU}"
          by auto
      }
      then have
        "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>((AU\<inter>BU)\<rtr>s)\<sad>(AU\<inter>BU)} \<subseteq>
        {\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(AU\<rtr>s)\<sad>AU}\<inter>{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(BU\<rtr>s)\<sad>BU}"
        by auto
      with AU(2) BU(2) have "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>((AU\<inter>BU)\<rtr>s)\<sad>(AU\<inter>BU)}\<subseteq>A\<inter>B" by blast
      ultimately have "A\<inter>B \<in> roelckeUniformity" using AU(3) BU(3) unfolding roelckeUniformity_def
        by blast
    }
    moreover
    {
      fix B C assume as:"B\<in>roelckeUniformity" "C\<subseteq>(G \<times> G)" "B \<subseteq> C"
      from as(1) obtain BU where BU:"BU\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(BU\<rtr>s)\<sad>BU}\<subseteq>B"
        unfolding roelckeUniformity_def by blast
      from as(3) BU(2) have "{\<langle>s,t\<rangle>\<in>G\<times>G. t \<in>(BU\<rtr>s)\<sad>BU}\<subseteq>C" by auto
      then have "C \<in> roelckeUniformity" using as(2) BU(1) unfolding roelckeUniformity_def
        by auto
    }
    ultimately show ?thesis unfolding IsFilter_def by auto
  qed
  ultimately show ?thesis using IsUniformity_def by auto
qed

text\<open> The topology given by the roelcke uniformity is the original topology \<close>

lemma (in topgroup) top_generated_roelcke_uniformity:
  shows "UniformTopology(roelckeUniformity,G) = T"
proof -
  let ?M = "{\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G}"
  have fun:"?M:G\<rightarrow>Pow(Pow(G))" using IsNeighSystem_def neigh_from_uniformity roelcke_uniformity
    by auto
  {
    fix U assume as:"U \<in> {U \<in> Pow(G). \<forall>x\<in>U. U \<in> ?M`x}"
    {
      fix x assume x:"x\<in>U"
      with as have xg:"x\<in>G" by auto
      from x as have "U \<in> {\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G}`(x)" by auto
      with fun \<open>x\<in>G\<close> have "U \<in> {V `` {x} . V \<in> roelckeUniformity}" using ZF_fun_from_tot_val
        by simp
      then obtain V where V:"U=V``{x}" "V \<in> roelckeUniformity" by auto
      from V(2) obtain W where W:"W\<in>\<N>\<^sub>0" "{\<langle>s,t\<rangle>\<in>G\<times>G. t\<in> (W\<rtr>s)\<sad>W}\<subseteq>V"
        unfolding roelckeUniformity_def by auto
      from W(1) have WG:"W\<subseteq>G" by auto
      from W(2) have A:"{\<langle>s,t\<rangle>:G\<times>G. t:(W\<rtr>s)\<sad>W}``{x} \<subseteq> V``{x}" by auto
      have "{\<langle>s,t\<rangle> \<in> G\<times>G. t \<in> (W\<rtr>s)\<sad>W}``{x} = (W\<rtr>x)\<sad>W"
      proof -
        let ?A = "{\<langle>s,t\<rangle>:G\<times>G. t \<in> (W\<rtr>s)\<sad>W}"
        from \<open>W\<subseteq>G\<close>  \<open>x\<in>G\<close> have I:"(W\<rtr>x)\<sad>W \<subseteq> G"
            using  lrtrans_in_group_add interval_add(1) by auto
        have "?A``{x} = {t\<in>G.\<langle>x,t\<rangle> \<in> ?A}" by blast
        moreover have "{t\<in>G. \<langle>x,t\<rangle> \<in> ?A} \<subseteq> (W\<rtr>x)\<sad>W" by auto
        moreover from \<open>W\<subseteq>G\<close>  \<open>x\<in>G\<close> I have "(W\<rtr>x)\<sad>W \<subseteq> {t\<in>G. \<langle>x,t\<rangle> \<in> ?A}" by auto
        ultimately show ?thesis by auto
      qed
      with A V(1) have WU:"(W\<rtr>x)\<sad>W \<subseteq> U" by auto
      have "int(W)\<rtr>x \<subseteq> W\<rtr>x" using image_mono Top_2_L1 by simp
      then have "(int(W)\<rtr>x)\<times>(int(W)) \<subseteq> (W\<rtr>x)\<times>W" using Top_2_L1 by auto
      then have "f``((int(W)\<rtr>x)\<times>(int(W))) \<subseteq> f``((W\<rtr>x)\<times>W)" using image_mono by auto
      moreover
      from xg WG have
        "\<langle>int(W)\<rtr>x,int(W)\<rangle> \<in> Pow(G)\<times>Pow(G)" and "\<langle>(W\<rtr>x),W\<rangle> \<in> Pow(G)\<times>Pow(G)"
        using Top_2_L2 lrtrans_in_group_add(2) by auto
      then have
        "(int(W)\<rtr>x)\<sad>(int(W)) = f``((int(W)\<rtr>x)\<times>(int(W)))" and
        "(W\<rtr>x)\<sad>W = f``((W\<rtr>x)\<times>W)"
        using interval_add(2) by auto
      ultimately have "(int(W)\<rtr>x)\<sad>(int(W)) \<subseteq> (W\<rtr>x)\<sad>W" by auto
      with xg WG have "int(W\<rtr>x)\<sad>(int(W)) \<subseteq> (W\<rtr>x)\<sad>W" using rtrans_interior
        by auto
      moreover
      {
        have "int(W\<rtr>x)\<sad>(int(W)) = (\<Union>t\<in>int(W\<rtr>x). t\<ltr>(int(W)))"
          using interval_add(3) Top_2_L2 by auto
        moreover have "\<forall>t\<in>int(W\<rtr>x). t\<ltr>(int(W)) = int(t\<ltr>W)"
        proof -
          { fix t assume "t \<in> int(W\<rtr>x)"
            from \<open>x\<in>G\<close> have "(W\<rtr>x) \<subseteq> G" using lrtrans_in_group_add(2) by simp
            with \<open>t \<in> int(W\<rtr>x)\<close> have "t\<in>G" using Top_2_L2 by auto
            with \<open>W\<subseteq>G\<close> have "t \<ltr> int(W) = int(t\<ltr>W)" using ltrans_interior by simp
          } thus ?thesis by simp
        qed
        ultimately have "int(W\<rtr>x)\<sad>(int(W)) = (\<Union>t\<in>int(W\<rtr>x). int(t\<ltr>W))"
          by auto
        with topSpaceAssum have "int(W\<rtr>x)\<sad>(int(W)) \<in> T" using Top_2_L2 union_open
          by auto
      }
      moreover from \<open>x\<in>G\<close> \<open>W\<in>\<N>\<^sub>0\<close> have "x \<in> int(W\<rtr>x)\<sad>(int(W))"
        using elem_in_int_rtrans(2) by simp
      moreover note WU
      ultimately have "\<exists>Y\<in>T. x\<in>Y \<and> Y\<subseteq>U" by auto
    }
    then have "U\<in>T" using open_neigh_open by auto
  }
  then have "{U \<in> Pow(G). \<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G}`(x)} \<subseteq> T"
    by auto
  moreover
  {
    fix U assume op:"U\<in>T"
    {
      fix x assume x:"x\<in>U"
      with op have xg:"x\<in>G" by auto
      have "(\<rm>x)\<ltr>U \<in> \<N>\<^sub>0" using open_trans_neigh op x by auto
      then obtain W where W:"W\<in>\<N>\<^sub>0" "W \<sad> W \<subseteq>(\<rm>x)\<ltr>U" using exists_procls_zerohood
        by blast
      let ?V = "x\<ltr>(W\<rtr>(\<rm>x)) \<inter> W"
      from \<open>W \<in> \<N>\<^sub>0\<close> \<open>x\<in>G\<close> have  xWx:"x\<ltr>(W\<rtr>(\<rm>x)) :\<N>\<^sub>0" using lrtrans_neigh
        by simp
      from W(1) have WG:"W\<subseteq>G" by auto
      from xWx W(1) have "\<zero>\<in>int(x\<ltr>(W\<rtr>(\<rm>x)))\<inter>int(W)" by auto
      have int:"int(x\<ltr>(W\<rtr>(\<rm>x)))\<inter>int(W)\<in>T"
        using Top_2_L2 topSpaceAssum  unfolding IsATopology_def by auto
      have "int(x\<ltr>(W\<rtr>(\<rm>x)))\<inter>int(W) \<subseteq> (x\<ltr>(W\<rtr>(\<rm>x)))\<inter>W" using Top_2_L1
        by auto
      with int have "int(x\<ltr>(W\<rtr>(\<rm>x)))\<inter>int(W)\<subseteq>int((x\<ltr>(W\<rtr>(\<rm>x)))\<inter>W)"
        using Top_2_L5 by auto
      moreover note xWx W(1)
      ultimately have V_NEIG:"?V \<in> \<N>\<^sub>0" unfolding zerohoods_def by auto
      {
        fix z assume z:"z \<in> (?V\<rtr>x)\<sad>?V"
        from W(1) have VG:"?V \<subseteq> G" by auto
        with \<open>x\<in>G\<close> have VxG:"?V\<rtr>x \<subseteq> G" using lrtrans_in_group_add(2) by simp
        from z VG VxG W(1) obtain a\<^sub>1 b\<^sub>1 where ab:"z=a\<^sub>1\<ra>b\<^sub>1" "a\<^sub>1 \<in> ?V\<rtr>x" "b\<^sub>1 \<in> ?V"
          using elements_in_set_sum by blast
        from ab(2) xg VG obtain c\<^sub>1 where c:"a\<^sub>1=c\<^sub>1\<ra>x" "c\<^sub>1 \<in> ?V" using elements_in_rtrans
          by blast
        from ab(3) c(2) have bc:"b\<^sub>1\<in>W" "c\<^sub>1 \<in> x\<ltr>(W\<rtr>(\<rm>x))" by auto
        from \<open>x\<in>G\<close> have "x\<ltr>(W\<rtr>(\<rm>x)) = {x\<ra>y. y\<in>(W\<rtr>(\<rm>x))}"
          using neg_in_tgroup lrtrans_in_group_add lrtrans_image by auto
        with \<open>c\<^sub>1 \<in> x\<ltr>(W\<rtr>(\<rm>x))\<close> obtain d where d:"c\<^sub>1=x\<ra>d" "d \<in> W\<rtr>(\<rm>x)"
          by auto
        from \<open>x\<in>G\<close> \<open>W\<in>\<N>\<^sub>0\<close> \<open>d \<in> W\<rtr>(\<rm>x)\<close> obtain e where e:"d=e\<ra>(\<rm>x)" "e\<in>W"
          using neg_in_tgroup lrtrans_in_group lrtrans_image(2) by auto
        from e(2) WG have eG:"e\<in>G" by auto
        from \<open>e\<in>W\<close> \<open>W\<subseteq>G\<close> \<open>b\<^sub>1\<in>W\<close> have "e\<in>G" "b\<^sub>1\<in>G" by auto
        from \<open>z = a\<^sub>1\<ra>b\<^sub>1\<close> \<open>a\<^sub>1 = c\<^sub>1\<ra>x\<close>  \<open>c\<^sub>1 = x\<ra>d\<close> \<open>d = e\<ra>(\<rm>x)\<close>
        have "z = x \<ra> (e\<ra>(\<rm>x)) \<ra> x \<ra> b\<^sub>1" by simp
        with \<open>x\<in>G\<close> \<open>e\<in>G\<close> have "z=(x\<ra>e)\<ra>b\<^sub>1" using cancel_middle(4) by simp
        with \<open>x\<in>G\<close> \<open>e\<in>G\<close> \<open>b\<^sub>1\<in>G\<close> have "z = x\<ra>(e\<ra>b\<^sub>1)" using group_oper_assoc by simp
        moreover from e(2) ab(3) WG have "e\<ra>b\<^sub>1 \<in> W\<sad>W" using elements_in_set_sum_inv
          by auto
        moreover note xg WG
        ultimately have "z\<in>x\<ltr>(W\<sad>W)" using elements_in_ltrans_inv interval_add(1)
          by auto
        moreover
        from \<open>W\<subseteq>G\<close> \<open>U\<in>T\<close> have "W \<sad> W \<subseteq> G" and "U\<subseteq>G" using interval_add(1) by auto
        with \<open>W \<sad> W \<subseteq>(\<rm>x)\<ltr>U\<close> \<open>x\<in>G\<close> have  "x\<ltr>(W\<sad>W) \<subseteq> U" using trans_subset
          by simp
        ultimately have "z\<in>U" by auto
      }
      then have sub:"(?V\<rtr>x)\<sad>?V \<subseteq> U" by auto
      moreover from V_NEIG have unif:"{\<langle>s,t\<rangle> \<in> G\<times>G. t : (?V\<rtr>s)\<sad>?V} \<in> roelckeUniformity"
        unfolding roelckeUniformity_def by auto
      moreover from xg have
        "\<forall>q. q\<in>{\<langle>s,t\<rangle> \<in> G\<times>G. t : (?V\<rtr>s)\<sad>?V}``{x} \<longleftrightarrow> q\<in>((?V\<rtr>x)\<sad>?V)\<inter>G"
        by auto
      then have "{\<langle>s,t\<rangle> \<in> G\<times>G. t \<in> (?V\<rtr>s)\<sad>?V}``{x} = ((?V\<rtr>x)\<sad>?V)\<inter>G"
        by auto
      ultimately have basic:"{\<langle>s,t\<rangle> \<in> G\<times>G. t : (?V\<rtr>s)\<sad>?V}``{x} \<subseteq> U" using op
        by auto
      have add:"({x}\<times>U)``{x} =U" by auto
      from basic add have "({\<langle>s,t\<rangle> \<in> G\<times>G. t \<in> (?V\<rtr>s)\<sad>?V}\<union>({x}\<times>U))``{x} = U"
        by auto
      moreover have R:"\<forall>B\<in>roelckeUniformity.(\<forall> C\<in>Pow(G \<times> G).  B \<subseteq> C \<longrightarrow> C \<in> roelckeUniformity)"
        using roelcke_uniformity unfolding IsUniformity_def IsFilter_def by auto
      moreover from op xg have GG:"({\<langle>s,t\<rangle> \<in> G\<times>G. t \<in> (?V\<rtr>s)\<sad>?V}\<union>({x}\<times>U)):Pow(G\<times>G)" by auto
      moreover have
        "{\<langle>s,t\<rangle> \<in> G\<times>G. t\<in>(?V\<rtr>s)\<sad>?V} \<subseteq> ({\<langle>s,t\<rangle> \<in> G\<times>G. t\<in>(?V\<rtr>s)\<sad>?V}\<union>({x}\<times>U))"
        by auto
      moreover from R unif GG have
        "({\<langle>s,t\<rangle> \<in> G\<times>G. t \<in> (?V\<rtr>s)\<sad>?V}\<union>({x}\<times>U)) \<in> roelckeUniformity" by auto
      ultimately have "\<exists>V\<in>roelckeUniformity. V``{x} = U" by auto
      then have "U \<in> {V `` {x} . V \<in> roelckeUniformity}" by auto
      with xg fun have "U \<in> {\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G} ` x"
        using apply_equality by auto
    } hence "\<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G} ` x" by auto
    with op have "U:{U \<in> Pow(G). \<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G}`(x)}"
      by auto
  } then have "T \<subseteq> {U \<in> Pow(G). \<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G}`(x)}"
    by auto
  ultimately have
    "{U \<in> Pow(G). \<forall>x\<in>U. U \<in> {\<langle>t, {V `` {t} . V \<in> roelckeUniformity}\<rangle> . t \<in> G}`(x)} = T" by auto
  then show ?thesis using uniftop_def_alt by simp
qed

text\<open>The inverse map is uniformly continuous in the Roelcke uniformity\<close>

theorem (in topgroup) inv_uniform_roelcke:
  shows
    "GroupInv(G,f) {is uniformly continuous between} roelckeUniformity {and} roelckeUniformity"
proof -
  let ?P = "ProdFunction(GroupInv(G,f), GroupInv(G,f))"
  have L: "GroupInv(G,f):G\<rightarrow>G" and R:"roelckeUniformity {is a uniformity on} G"
    using groupAssum group0_2_T2 roelcke_uniformity by auto
  have "\<forall>V \<in> roelckeUniformity. ?P-``(V) \<in> roelckeUniformity"
  proof
    fix V assume v:"V\<in> roelckeUniformity"
    then obtain U where "U \<in> \<N>\<^sub>0" and "{\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> U \<rtr> s \<sad> U} \<subseteq> V"
      unfolding roelckeUniformity_def by auto
    with \<open>V \<in> roelckeUniformity\<close> have
      as:"V \<subseteq> G \<times> G" "U \<in> \<N>\<^sub>0" "{\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> U \<rtr> s \<sad> U} \<subseteq> V"
      unfolding roelckeUniformity_def by auto
    from as(2) obtain W where w:"W \<in> \<N>\<^sub>0" "W \<subseteq> U" "(\<sm>W) = W" using exists_sym_zerohood by blast
    from w(1) have wg:"W\<subseteq>G" by auto
    {
      fix z assume z:"z \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> W \<rtr> s \<sad> W}"
      then obtain s t where st:"z=\<langle>s,t\<rangle>" "s\<in>G" "t\<in>G" by auto
      from st(1) z have st2: "t \<in> W \<rtr> s \<sad> W" by auto
      with \<open>W \<in> \<N>\<^sub>0\<close> st(2) obtain u v where uv:"t=u\<ra>v" "u\<in>W\<rtr>s" "v\<in>W"
        using interval_add(4) lrtrans_in_group_add(2)  by auto
      from \<open>W\<subseteq>G\<close> \<open>s\<in>G\<close> \<open>u\<in>W\<rtr>s\<close> obtain q where q:"q\<in>W" "u=q\<ra>s" using elements_in_rtrans
        by blast
      from w(2) as(2) q st(2) have "u\<in>U\<rtr>s" using lrtrans_image(2) by auto
      with w(2) uv(1,3) as(2) st(2) have "t\<in>U \<rtr> s \<sad> U" using interval_add(4)
        lrtrans_in_group_add(2) by auto
      with st have "z \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> U \<rtr> s \<sad> U}" by auto
    }
    then have
      sub:"{\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> W \<rtr> s \<sad> W} \<subseteq> {\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> U \<rtr> s \<sad> U}"
      by auto
    {
      fix z assume z:"z \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> W \<rtr> s \<sad> W}"
      then obtain s t where st:"z=\<langle>s,t\<rangle>" "s\<in>G" "t\<in>G" by auto
      from st(1) z have st2: "t \<in> W \<rtr> s \<sad> W" by auto
      with \<open>W \<in> \<N>\<^sub>0\<close> obtain u v where uv:"t=u\<ra>v" "u\<in>W\<rtr>s" "v\<in>W"
        using interval_add(4) lrtrans_in_group_add(2) st(2) by auto
      from \<open>W\<subseteq>G\<close> \<open>s\<in>G\<close> \<open>u\<in>W\<rtr>s\<close> obtain q where q:"q\<in>W" "u=q\<ra>s" using elements_in_rtrans
        by blast
      from \<open>W\<subseteq>G\<close> \<open>q\<in>W\<close> \<open>v\<in>W\<close> have "q\<in>G" "v\<in>G" by auto
      with \<open>q\<in>G\<close> \<open>v\<in>G\<close> \<open>u=q\<ra>s\<close> st(2) uv(1) q(2) have "t=q\<ra>(s\<ra>v)"
        using group_op_closed_add group_oper_assoc by auto
      with st(2) \<open>q\<in>G\<close> \<open>v\<in>G\<close> have minust:"(\<rm>t) = (\<rm>v)\<ra>(\<rm>s)\<ra>(\<rm>q)"
        using group_inv_of_two group_op_closed group_inv_of_two by auto
      from q(1) wg have "(\<rm>q)\<in>\<sm>W" using ginv_image_add(2) by auto
      with w(3) have minusq:"(\<rm>q)\<in>W" by auto
      from uv(3) wg have "(\<rm>v)\<in>\<sm>W" using ginv_image_add(2) by auto
      with w(3) have minusv:"(\<rm>v)\<in>W" by auto
      with st(2) wg have "(\<rm>v)\<ra>(\<rm>s) \<in> W\<rtr>(\<rm>s)"
        using lrtrans_image(2) inverse_in_group by auto
      with minust minusq st(2) wg have "(\<rm>t)\<in>(W\<rtr>(\<rm>s))\<sad>W"
        using interval_add(4) inverse_in_group lrtrans_in_group_add(2) by auto
      moreover
      from st groupAssum have "?P`(z) = \<langle>GroupInv(G,f)`(s), GroupInv(G,f)`(t)\<rangle>"
        using prodFunctionApp group0_2_T2 by blast
      with st(2,3) have "?P`(z) = \<langle>\<rm>s,\<rm>t\<rangle>" by auto
      ultimately have "?P`(z) \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> W \<rtr> s \<sad> W}"
        using st(2,3) inverse_in_group by auto
      with sub have "?P`(z) \<in> {\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> U \<rtr> s \<sad> U}" by force
      with as(3) have "?P`(z) \<in> V" by force
      with z L have "z \<in> ?P-``(V)" using prodFunction func1_1_L5A vimage_iff
        by blast
    }
    with w(1) have "\<exists>U\<in>\<N>\<^sub>0. {\<langle>s,t\<rangle> \<in> G \<times> G . t \<in> U \<rtr> s \<sad> U} \<subseteq> ?P-``(V)"
      by blast
    with L show "?P-``(V) \<in> roelckeUniformity"
      unfolding roelckeUniformity_def using prodFunction func1_1_L6A by blast
  qed
  with L R show ?thesis using IsUniformlyCont_def by auto
qed

end


theory MiniFormulas_Sema
imports MiniFormulas Sema
begin

lemma "A \<Turnstile> F \<longleftrightarrow> A \<Turnstile> to_mini_formula F"
  by(induction F) auto

end


(*  Title:      CTT/ex/Typechecking.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1991  University of Cambridge
*)

section \<open>Easy examples: type checking and type deduction\<close>

theory Typechecking
imports "../CTT"
begin

subsection \<open>Single-step proofs: verifying that a type is well-formed\<close>

schematic_goal "?A type"
  by (rule form_rls)

schematic_goal "?A type"
  apply (rule form_rls)
  back
   apply (rule form_rls)
  apply (rule form_rls)
  done

schematic_goal "\<Prod>z:?A . N + ?B(z) type"
  apply (rule form_rls)
   apply (rule form_rls)
  apply (rule form_rls)
   apply (rule form_rls)
  apply (rule form_rls)
  done

subsection \<open>Multi-step proofs: Type inference\<close>

lemma "\<Prod>w:N. N + N type"
  by form

schematic_goal "<0, succ(0)> : ?A"
  apply intr done

schematic_goal "\<Prod>w:N . Eq(?A,w,w) type"
  apply typechk done

schematic_goal "\<Prod>x:N . \<Prod>y:N . Eq(?A,x,y) type"
  apply typechk done

text \<open>typechecking an application of fst\<close>
schematic_goal "(\<^bold>\<lambda>u. split(u, \<lambda>v w. v)) ` <0, succ(0)> : ?A"
  apply typechk done

text \<open>typechecking the predecessor function\<close>
schematic_goal "\<^bold>\<lambda>n. rec(n, 0, \<lambda>x y. x) : ?A"
  apply typechk done

text \<open>typechecking the addition function\<close>
schematic_goal "\<^bold>\<lambda>n. \<^bold>\<lambda>m. rec(n, m, \<lambda>x y. succ(y)) : ?A"
  apply typechk done

text \<open>Proofs involving arbitrary types.
  For concreteness, every type variable left over is forced to be @{term N}\<close>
method_setup N =
  \<open>Scan.succeed (fn ctxt => SIMPLE_METHOD (TRYALL (resolve_tac ctxt @{thms NF})))\<close>

schematic_goal "\<^bold>\<lambda>w. <w,w> : ?A"
  apply typechk
  apply N
  done

schematic_goal "\<^bold>\<lambda>x. \<^bold>\<lambda>y. x : ?A"
  apply typechk
   apply N
  done

text \<open>typechecking fst (as a function object)\<close>
schematic_goal "\<^bold>\<lambda>i. split(i, \<lambda>j k. j) : ?A"
  apply typechk
   apply N
  done

end