Theory Uniform_Structure

✐‹creator "Niklas Krofta"›
section ‹Uniform spaces›
theory Uniform_Structure
  imports "HOL-Analysis.Abstract_Topology" "HOL-Analysis.Abstract_Metric_Spaces"
begin

paragraph ‹Summary›
text ‹
  This section introduces a set-based notion of uniformities and connects it to the
  @{class "uniform_space"} type class.
›

subsection ‹Definitions and basic results›

definition uniformity_on :: "'a set  (('a × 'a) set  bool)  bool" where
"uniformity_on X   
  (E.  E)  
  (E.  E  E  X × X  Id_on X  E   (E¯)  (F.  F  F O F  E)  
    (F. E  F  F  X × X   F)) 
  (E F.  E   F   (E  F))"

typedef 'a uniformity = "{(X :: 'a set, ). uniformity_on X }"
  morphisms uniformity_rep uniformity
proof -
  have "uniformity_on UNIV (λE. E = UNIV × UNIV)" 
    unfolding uniformity_on_def Id_on_def relcomp_def by auto
  then show ?thesis by fast
qed

definition uspace :: "'a uniformity  'a set" where
"uspace Φ = (let (X, ) = uniformity_rep Φ in X)"

definition entourage_in :: "'a uniformity  ('a × 'a) set  bool" where
"entourage_in Φ = (let (X, ) = uniformity_rep Φ in )"

lemma uniformity_inverse'[simp]:
  assumes "uniformity_on X "
  shows "uspace (uniformity (X, )) = X  entourage_in (uniformity (X, )) = "
proof -
  from assms have "uniformity_rep (uniformity (X, )) = (X, )" 
    using uniformity_inverse by blast
  then show ?thesis by (auto simp: prod.splits uspace_def entourage_in_def)
qed

lemma uniformity_entourages:
  shows "uniformity_on (uspace Φ) (entourage_in Φ)"
  by (metis Product_Type.Collect_case_prodD entourage_in_def split_beta uspace_def uniformity_rep)

lemma entourages_exist: "E. entourage_in Φ E"
  using uniformity_entourages unfolding uniformity_on_def by blast

lemma entourage_in_space[elim]: "entourage_in Φ E  E  uspace Φ × uspace Φ"
  using uniformity_entourages unfolding uniformity_on_def by metis

lemma entourage_superset[intro]: 
  "entourage_in Φ E  E  F  F  uspace Φ × uspace Φ  entourage_in Φ F"
  using uniformity_entourages unfolding uniformity_on_def by blast

lemma entourage_intersection[intro]: "entourage_in Φ E  entourage_in Φ F  entourage_in Φ (E  F)"
  using uniformity_entourages unfolding uniformity_on_def by metis

lemma entourage_converse[intro]: "entourage_in Φ E  entourage_in Φ (E¯)"
  using uniformity_entourages unfolding uniformity_on_def by fast

lemma entourage_diagonal[dest]:
  assumes entourage: "entourage_in Φ E" and in_space: "x  uspace Φ"
  shows "(x,x)  E"
proof -
  have "Id_on (uspace Φ)  E" 
    using uniformity_entourages entourage unfolding uniformity_on_def by fast
  then show ?thesis using Id_onI[OF in_space] by blast
qed

lemma smaller_entourage:
  assumes entourage: "entourage_in Φ E"
  shows "F. entourage_in Φ F  (x y z. (x,y)  F  (y,z)  F  (x,z)  E)"
proof -
  from entourage obtain F where "entourage_in Φ F  F O F  E"
    using uniformity_entourages entourage unfolding uniformity_on_def by meson
  moreover from this have "(x,z)  E" if "(x,y)  F  (y,z)  F" for x y z using that by blast
  ultimately show ?thesis by blast
qed

lemma entire_space_entourage: "entourage_in Φ (uspace Φ × uspace Φ)"
  by (metis entourages_exist entourage_in_space entourage_superset subset_refl)

definition utopology :: "'a uniformity  'a topology" where
"utopology Φ = topology (λU. U  uspace Φ  (xU. E. entourage_in Φ E  E``{x}  U))"

lemma openin_utopology [iff]:
  fixes Φ :: "'a uniformity"
  defines "uopen U  U  uspace Φ  (xU. E. entourage_in Φ E  E``{x}  U)"
  shows "openin (utopology Φ) = uopen"
proof -
  have "uopen (U  V)" if hUV: "uopen U  uopen V" for U V
  proof -
    have "E. entourage_in Φ E  E``{x}  U  V" if hx: "x  U  V" for x 
    proof -
      from hUV hx obtain E1 E2 where 
        "entourage_in Φ E1  entourage_in Φ E2  E1``{x}  U  E2``{x}  V" unfolding uopen_def by blast
      then have "entourage_in Φ (E1  E2)  (E1  E2)``{x}  U  V" by blast
      then show ?thesis by fast
    qed
    then show ?thesis using le_infI1 hUV unfolding uopen_def by auto
  qed
  moreover have "uopen (𝒰)" if h𝒰: "U𝒰. uopen U" for 𝒰
  proof -
    have "E. entourage_in Φ E  E``{x}  𝒰" if hx: "x  𝒰" for x
    proof -
      from hx obtain U where hU: "U  𝒰  x  U" by blast
      from this h𝒰 obtain E where "entourage_in Φ E  E``{x}  U" unfolding uopen_def by fast
      moreover from this hU have "E``{x}  𝒰" by fast
      ultimately show ?thesis by blast
    qed
    then show ?thesis using Union_least h𝒰 unfolding uopen_def by auto
  qed
  ultimately have "istopology uopen" unfolding istopology_def by presburger
  from topology_inverse'[OF this] show ?thesis unfolding utopology_def uopen_def by blast
qed

lemma topspace_utopology[simp]:
  shows "topspace (utopology Φ) = uspace Φ"
proof -
  let ?T = "utopology Φ"
  have "topspace ?T  uspace Φ"
    using openin_topspace openin_utopology by meson
  moreover have "openin ?T (uspace Φ)" 
    unfolding openin_utopology by (auto intro: entire_space_entourage)
  ultimately show ?thesis using topspace_def by fast
qed

definition ucontinuous :: "'a uniformity  'b uniformity  ('a  'b)  bool" where
"ucontinuous Φ Ψ f  
  f  uspace Φ  uspace Ψ 
  (E. entourage_in Ψ E  entourage_in Φ {(x, y)  uspace Φ × uspace Φ. (f x, f y)  E})"

lemma ucontinuous_image_subset [dest]: "ucontinuous Φ Ψ f  f`(uspace Φ)  uspace Ψ"
  unfolding ucontinuous_def by blast

lemma entourage_preimage_ucontinuous [dest]: 
  assumes "ucontinuous Φ Ψ f" and "entourage_in Ψ E" 
  shows "entourage_in Φ {(x, y)  uspace Φ × uspace Φ. (f x, f y)  E}"
  using assms unfolding ucontinuous_def by blast

lemma ucontinuous_imp_continuous:
  assumes "ucontinuous Φ Ψ f"
  shows "continuous_map (utopology Φ) (utopology Ψ) f"
proof (unfold continuous_map_def, intro conjI allI impI)
  show "f  topspace (utopology Φ)  topspace (utopology Ψ)"
    using assms unfolding ucontinuous_def by auto
next
  fix U assume hU: "openin (utopology Ψ) U"
  let ?V = "{x  topspace (utopology Φ). f x  U}"
  have "F. entourage_in Φ F  F``{x}  ?V" if hx: "x  uspace Φ  f x  U" for x
  proof -
    from that hU obtain E where hE: "entourage_in Ψ E  E``{f x}  U"
      unfolding openin_utopology by blast
    let ?F = "{(x, y)  uspace Φ × uspace Φ. (f x, f y)  E}"
    have "?F``{x} = {y  uspace Φ. f y  E``{f x}}" unfolding Image_def using hx by auto
    then have "?F``{x}  ?V" using hE by auto
    moreover have "entourage_in Φ ?F" 
      using assms entourage_preimage_ucontinuous hE unfolding topspace_utopology by blast
    ultimately show ?thesis by blast
  qed
  then show "openin (utopology Φ) ?V" unfolding openin_utopology by force
qed

subsection ‹Metric spaces as uniform spaces›

context Metric_space 
begin 

abbreviation mentourage :: "real  ('a × 'a) set" where
"mentourage ε  {(x,y)  M × M. d x y < ε}"

definition muniformity :: "'a uniformity" where
"muniformity = uniformity (M, λE. E  M × M  (ε > 0. mentourage ε  E))"

lemma
  uspace_muniformity[simp]: "uspace muniformity = M" and 
  entourage_muniformity: "entourage_in muniformity = (λE. E  M × M  (ε > 0. mentourage ε  E))"
proof -
  have "uniformity_on M (λE. E  M × M  (ε > 0. mentourage ε  E))" 
    unfolding uniformity_on_def Id_on_def converse_def
  proof (intro conjI allI impI, goal_cases)
    case 1
    then show ?case by (rule exI[of _ "mentourage 1"]) force
  next
    case (5 E)
    then obtain ε where : "ε > 0  mentourage ε  E" by blast
    then have "{(y, x). (x, y)  mentourage ε}  E" using commute by auto
    then have "mentourage ε  E¯" by blast
    then show ?case using  by auto
  next
    case (6 E)
    then obtain ε where : "ε > 0  mentourage ε  E" by blast
    let ?F = "mentourage (ε/2)"
    have "(x,z)  E" if "(x,y)  ?F  (y,z)  ?F" for x y z
    proof -
      have "d x z < ε" using that triangle by fastforce
      then show ?thesis using that  by blast
    qed
    then have "?F  M × M  ?F O ?F  E" by blast 
    then show ?case by (meson  order_refl zero_less_divide_iff zero_less_numeral)
  next
    case (8 E F)
    then show ?case by fast
  next
    case (10 E F)
    then obtain ε δ where
      "ε > 0  mentourage ε  E" and
      "δ > 0  mentourage δ  F" by presburger
    then have "min ε δ > 0  mentourage (min ε δ)  E  F" by auto
    then show ?case by blast
  qed (auto)
  then show 
    "uspace muniformity = M" and 
    "entourage_in muniformity = (λE. E  M × M  (ε > 0. mentourage ε  E))"
    unfolding muniformity_def using uniformity_inverse' by auto
qed

lemma uniformity_induces_mtopology [simp]: "utopology muniformity = mtopology"
proof -
  have mentourage_image: "mball x ε = (mentourage ε)``{x}" for x ε unfolding mball_def by auto
  have "openin (utopology muniformity) U  openin mtopology U" for U
  proof
    assume hU: "openin (utopology muniformity) U"
    have "ε > 0. mball x ε  U" if "x  U" for x
    proof -
      from hU that obtain E where hE: "entourage_in muniformity E  E``{x}  U" unfolding openin_utopology by blast
      then obtain ε where : "ε > 0  mentourage ε  E" unfolding entourage_muniformity by presburger
      then have "(mentourage ε)``{x}  U" using hE by fast
      then show ?thesis using mentourage_image  by auto
    qed
    then show "openin mtopology U" unfolding openin_mtopology using hU openin_subset by fastforce
  next
    assume hU: "openin mtopology U"
    have "E. entourage_in muniformity E  E``{x}  U" if "x  U" for x
    proof -
      from hU that obtain ε where "ε > 0  mball x ε  U" unfolding openin_mtopology by blast
      then show ?thesis unfolding mentourage_image entourage_muniformity by auto
    qed
    then show "openin (utopology muniformity) U" unfolding openin_utopology using hU openin_subset by fastforce
  qed
  then show ?thesis using topology_eq by blast
qed

subsection ‹Connection to type class›

end

text ‹The following connects the @{class "uniform_space"} class to the set based notion 
@{term "uniformity_on"}.

Given a type @{typ "'a"} which is an instance of the class @{class "uniform_space"}, it is possible
to introduce an @{typ "'a uniformity"} on the entire universe: @{term "UNIV"}:›

definition uniformity_of_space :: "('a :: uniform_space) uniformity" where
  "uniformity_of_space = uniformity (UNIV :: 'a set, (λS. F x in uniformity_class.uniformity. xS))"

text ‹The induced uniformity fulfills the required conditions, i.e., the class based notion implies 
the set-based notion.›

lemma uniformity_on_uniformity_of_space_aux:
  "uniformity_on (UNIV :: ('a :: uniform_space) set) (λS. F x in uniformity_class.uniformity. xS)"
proof -
  let ?u = " uniformity_class.uniformity :: ('a × 'a) filter"

  have "S. (F x in ?u.x  S)" by (intro exI[where x="UNIV × UNIV"]) simp
  moreover have "(F x in ?u.x  E  F)" if "(F x in ?u.x  E)" "(F x in ?u.x  F)" for E F
    using that eventually_conj by auto
  moreover have "Id_on UNIV  E" if "F x in ?u. x  E" for E
  proof -
    have "(x,x)  E" for x using uniformity_refl[OF that] by auto
    thus ?thesis unfolding Id_on_def by auto
  qed
  moreover have "(F x in ?u. x  E¯)" if "F x in ?u. x  E" for E 
    using uniformity_sym[OF that] by (simp add: converse_unfold)
  moreover have "F. (F x in ?u. x  F)  F O F  E" if "F x in ?u. x  E" for E
  proof -
    from uniformity_trans[OF that]
    obtain D where "eventually D ?u" "(x y z. D (x, y)  D (y, z)  (x, z)  E)" by auto
    thus ?thesis by (intro exI[where x="Collect D"]) auto
  qed
  moreover have "F x in ?u. x  F" if "F x in ?u. x  E" "E  F" for E F
    using that(2) by (intro eventually_mono[OF that(1)]) auto
  ultimately show ?thesis
    unfolding uniformity_on_def by auto
qed

lemma uniformity_rep_uniformity_of_space:
  "uniformity_rep uniformity_of_space = (UNIV, (λS. F x in uniformity_class.uniformity. x  S))"
  unfolding uniformity_of_space_def using uniformity_on_uniformity_of_space_aux
  by (intro uniformity_inverse) auto

lemma uspace_uniformity_space [simp, iff]:
  "uspace uniformity_of_space = UNIV"
  unfolding uspace_def uniformity_rep_uniformity_of_space by simp

lemma entourage_in_uniformity_space:
  "entourage_in uniformity_of_space S =(F x in uniformity_class.uniformity. x  S)"
  unfolding entourage_in_def uniformity_rep_uniformity_of_space by simp

text ‹Compatibility of the @{term "Metric_space.muniformity"} with the uniformity based on
the class based hierarchy.›

lemma "(uniformity_of_space :: ('a :: metric_space) uniformity) = Met_TC.muniformity"
proof -
  have "(x y. dist x y < ε  (x, y)  E) = ({(x, y). dist x y < ε}  E)" 
    for ε and E :: "('a × 'a) set" 
    by auto
  thus ?thesis
    unfolding Met_TC.muniformity_def uniformity_of_space_def eventually_uniformity_metric by simp
qed

end