/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.limits.comma
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Arrow
import Mathlib.CategoryTheory.Limits.Constructions.EpiMono
import Mathlib.CategoryTheory.Limits.Creates
import Mathlib.CategoryTheory.Limits.Unit
import Mathlib.CategoryTheory.StructuredArrow

/-!
# Limits and colimits in comma categories

We build limits in the comma category `Comma L R` provided that the two source categories have
limits and `R` preserves them.
This is used to construct limits in the arrow category, structured arrow category and under
category, and show that the appropriate forgetful functors create limits.

The duals of all the above are also given.
-/

namespace CategoryTheory

open Category Limits

universe w' w v u₁ u₂ u₃

variable {J : Type w} [Category.{w'} J]

variable {A : Type u₁} [Category.{v} A]

variable {B : Type u₂} [Category.{v} B]

variable {T : Type u₃} [Category.{v} T]

namespace Comma

variable {L : A ⥤ T} {R : B ⥤ T}

variable (F : J ⥤ Comma L R)

/-- (Implementation). An auxiliary cone which is useful in order to construct limits
in the comma category. -/
@[simps!]
def limitAuxiliaryCone (c₁ : Cone (F ⋙ fst L R)) : Cone ((F ⋙ snd L R) ⋙ R) :=
  (Cones.postcompose (whiskerLeft F (Comma.natTrans L R) : _)).obj (L.mapCone c₁)
#align category_theory.comma.limit_auxiliary_cone CategoryTheory.Comma.limitAuxiliaryCone

/-- If `R` preserves the appropriate limit, then given a cone for `F ⋙ fst L R : J ⥤ L` and a
limit cone for `F ⋙ snd L R : J ⥤ R` we can build a cone for `F` which will turn out to be a limit
cone.
-/
@[simps]
def coneOfPreserves [PreservesLimit (F ⋙ snd L R) R] (c₁ : Cone (F ⋙ fst L R))
    {c₂ : Cone (F ⋙ snd L R)} (t₂ : IsLimit c₂) : Cone F
    where
  pt :=
    { left := c₁.pt
      right := c₂.pt
      hom := (isLimitOfPreserves R t₂).lift (limitAuxiliaryCone _ c₁) }
  π :=
    { app := fun j =>
        { left := c₁.π.app j
          right := c₂.π.app j
          w := ((isLimitOfPreserves R t₂).fac (limitAuxiliaryCone F c₁) j).symm }
      naturality := fun j₁ j₂ t => by
        ext
        . simp [← c₁.w t]
        . simp [← c₂.w t] }
#align category_theory.comma.cone_of_preserves CategoryTheory.Comma.coneOfPreserves

/-- Provided that `R` preserves the appropriate limit, then the cone in `coneOfPreserves` is a
limit. -/
def coneOfPreservesIsLimit [PreservesLimit (F ⋙ snd L R) R] {c₁ : Cone (F ⋙ fst L R)}
    (t₁ : IsLimit c₁) {c₂ : Cone (F ⋙ snd L R)} (t₂ : IsLimit c₂) :
    IsLimit (coneOfPreserves F c₁ t₂) where
  lift s :=
    { left := t₁.lift ((fst L R).mapCone s)
      right := t₂.lift ((snd L R).mapCone s)
      w :=
        (isLimitOfPreserves R t₂).hom_ext fun j => by
          rw [coneOfPreserves_pt_hom, assoc, assoc, (isLimitOfPreserves R t₂).fac,
            limitAuxiliaryCone_π_app, ← L.map_comp_assoc, t₁.fac, R.mapCone_π_app,
            ← R.map_comp, t₂.fac]
          exact (s.π.app j).w }
  uniq s m w := by
    apply CommaMorphism.ext
    . exact t₁.uniq ((fst L R).mapCone s) _ (fun j => by simp [← w])
    . exact t₂.uniq ((snd L R).mapCone s) _ (fun j => by simp [← w])
#align category_theory.comma.cone_of_preserves_is_limit CategoryTheory.Comma.coneOfPreservesIsLimit

/-- (Implementation). An auxiliary cocone which is useful in order to construct colimits
in the comma category. -/
@[simps!]
def colimitAuxiliaryCocone (c₂ : Cocone (F ⋙ snd L R)) : Cocone ((F ⋙ fst L R) ⋙ L) :=
  (Cocones.precompose (whiskerLeft F (Comma.natTrans L R) : _)).obj (R.mapCocone c₂)
#align category_theory.comma.colimit_auxiliary_cocone CategoryTheory.Comma.colimitAuxiliaryCocone

/--
If `L` preserves the appropriate colimit, then given a colimit cocone for `F ⋙ fst L R : J ⥤ L` and
a cocone for `F ⋙ snd L R : J ⥤ R` we can build a cocone for `F` which will turn out to be a
colimit cocone.
-/
@[simps]
def coconeOfPreserves [PreservesColimit (F ⋙ fst L R) L] {c₁ : Cocone (F ⋙ fst L R)}
    (t₁ : IsColimit c₁) (c₂ : Cocone (F ⋙ snd L R)) : Cocone F
    where
  pt :=
    { left := c₁.pt
      right := c₂.pt
      hom := (isColimitOfPreserves L t₁).desc (colimitAuxiliaryCocone _ c₂) }
  ι :=
    { app := fun j =>
        { left := c₁.ι.app j
          right := c₂.ι.app j
          w := (isColimitOfPreserves L t₁).fac (colimitAuxiliaryCocone _ c₂) j }
      naturality := fun j₁ j₂ t => by
        ext
        . simp [← c₁.w t]
        . simp [← c₂.w t] }
#align category_theory.comma.cocone_of_preserves CategoryTheory.Comma.coconeOfPreserves

/-- Provided that `L` preserves the appropriate colimit, then the cocone in `coconeOfPreserves` is
a colimit. -/
def coconeOfPreservesIsColimit [PreservesColimit (F ⋙ fst L R) L] {c₁ : Cocone (F ⋙ fst L R)}
    (t₁ : IsColimit c₁) {c₂ : Cocone (F ⋙ snd L R)} (t₂ : IsColimit c₂) :
    IsColimit (coconeOfPreserves F t₁ c₂)  where
  desc s :=
    { left := t₁.desc ((fst L R).mapCocone s)
      right := t₂.desc ((snd L R).mapCocone s)
      w :=
        (isColimitOfPreserves L t₁).hom_ext fun j =>
          by
          rw [coconeOfPreserves_pt_hom, (isColimitOfPreserves L t₁).fac_assoc,
            colimitAuxiliaryCocone_ι_app, assoc, ← R.map_comp, t₂.fac, L.mapCocone_ι_app, ←
            L.map_comp_assoc, t₁.fac]
          exact (s.ι.app j).w }
  uniq s m w := by
    apply CommaMorphism.ext
    . exact t₁.uniq ((fst L R).mapCocone s) _ (fun j => by simp [← w])
    . exact t₂.uniq ((snd L R).mapCocone s) _ (fun j => by simp [← w])
#align category_theory.comma.cocone_of_preserves_is_colimit CategoryTheory.Comma.coconeOfPreservesIsColimit

instance hasLimit (F : J ⥤ Comma L R) [HasLimit (F ⋙ fst L R)] [HasLimit (F ⋙ snd L R)]
    [PreservesLimit (F ⋙ snd L R) R] : HasLimit F :=
  HasLimit.mk ⟨_, coneOfPreservesIsLimit _ (limit.isLimit _) (limit.isLimit _)⟩
#align category_theory.comma.has_limit CategoryTheory.Comma.hasLimit

instance hasLimitsOfShape [HasLimitsOfShape J A] [HasLimitsOfShape J B]
    [PreservesLimitsOfShape J R] : HasLimitsOfShape J (Comma L R) where
#align category_theory.comma.has_limits_of_shape CategoryTheory.Comma.hasLimitsOfShape

instance hasLimits [HasLimits A] [HasLimits B] [PreservesLimits R] : HasLimits (Comma L R) :=
  ⟨fun _ _ => inferInstance⟩
#align category_theory.comma.has_limits CategoryTheory.Comma.hasLimits

instance hasColimit (F : J ⥤ Comma L R) [HasColimit (F ⋙ fst L R)] [HasColimit (F ⋙ snd L R)]
    [PreservesColimit (F ⋙ fst L R) L] : HasColimit F :=
  HasColimit.mk ⟨_, coconeOfPreservesIsColimit _ (colimit.isColimit _) (colimit.isColimit _)⟩
#align category_theory.comma.has_colimit CategoryTheory.Comma.hasColimit

instance hasColimitsOfShape [HasColimitsOfShape J A] [HasColimitsOfShape J B]
    [PreservesColimitsOfShape J L] : HasColimitsOfShape J (Comma L R) where
#align category_theory.comma.has_colimits_of_shape CategoryTheory.Comma.hasColimitsOfShape

instance hasColimits [HasColimits A] [HasColimits B] [PreservesColimits L] :
    HasColimits (Comma L R) :=
  ⟨fun _ _ => inferInstance⟩
#align category_theory.comma.has_colimits CategoryTheory.Comma.hasColimits

end Comma

namespace Arrow

instance hasLimit (F : J ⥤ Arrow T) [i₁ : HasLimit (F ⋙ leftFunc)] [i₂ : HasLimit (F ⋙ rightFunc)] :
    HasLimit F := by
  haveI : HasLimit (F ⋙ Comma.fst _ _) := i₁
  haveI : HasLimit (F ⋙ Comma.snd _ _) := i₂
  apply Comma.hasLimit
#align category_theory.arrow.has_limit CategoryTheory.Arrow.hasLimit

instance hasLimitsOfShape [HasLimitsOfShape J T] : HasLimitsOfShape J (Arrow T) where
#align category_theory.arrow.has_limits_of_shape CategoryTheory.Arrow.hasLimitsOfShape

instance hasLimits [HasLimits T] : HasLimits (Arrow T) :=
  ⟨fun _ _ => inferInstance⟩
#align category_theory.arrow.has_limits CategoryTheory.Arrow.hasLimits

instance hasColimit (F : J ⥤ Arrow T) [i₁ : HasColimit (F ⋙ leftFunc)]
    [i₂ : HasColimit (F ⋙ rightFunc)] : HasColimit F := by
  haveI : HasColimit (F ⋙ Comma.fst _ _) := i₁
  haveI : HasColimit (F ⋙ Comma.snd _ _) := i₂
  apply Comma.hasColimit
#align category_theory.arrow.has_colimit CategoryTheory.Arrow.hasColimit

instance hasColimitsOfShape [HasColimitsOfShape J T] : HasColimitsOfShape J (Arrow T) where
#align category_theory.arrow.has_colimits_of_shape CategoryTheory.Arrow.hasColimitsOfShape

instance hasColimits [HasColimits T] : HasColimits (Arrow T) :=
  ⟨fun _ _ => inferInstance⟩
#align category_theory.arrow.has_colimits CategoryTheory.Arrow.hasColimits

end Arrow

namespace StructuredArrow

variable {X : T} {G : A ⥤ T} (F : J ⥤ StructuredArrow X G)

instance hasLimit [i₁ : HasLimit (F ⋙ proj X G)] [i₂ : PreservesLimit (F ⋙ proj X G) G] :
    HasLimit F := by
  haveI : HasLimit (F ⋙ Comma.snd (Functor.fromPUnit X) G) := i₁
  haveI : PreservesLimit (F ⋙ Comma.snd (Functor.fromPUnit X) G) _ := i₂
  apply Comma.hasLimit
#align category_theory.structured_arrow.has_limit CategoryTheory.StructuredArrow.hasLimit

instance hasLimitsOfShape [HasLimitsOfShape J A] [PreservesLimitsOfShape J G] :
    HasLimitsOfShape J (StructuredArrow X G) where
#align category_theory.structured_arrow.has_limits_of_shape CategoryTheory.StructuredArrow.hasLimitsOfShape

instance hasLimits [HasLimits A] [PreservesLimits G] : HasLimits (StructuredArrow X G) :=
  ⟨fun J hJ => by infer_instance⟩
#align category_theory.structured_arrow.has_limits CategoryTheory.StructuredArrow.hasLimits

noncomputable instance createsLimit [i : PreservesLimit (F ⋙ proj X G) G] :
    CreatesLimit F (proj X G) :=
  letI : PreservesLimit (F ⋙ Comma.snd (Functor.fromPUnit X) G) G := i
  createsLimitOfReflectsIso fun _ t =>
    { liftedCone := Comma.coneOfPreserves F pUnitCone t
      makesLimit := Comma.coneOfPreservesIsLimit _ pUnitConeIsLimit _
      validLift := Cones.ext (Iso.refl _) fun _ => (id_comp _).symm }
#align category_theory.structured_arrow.creates_limit CategoryTheory.StructuredArrow.createsLimit

noncomputable instance createsLimitsOfShape [PreservesLimitsOfShape J G] :
    CreatesLimitsOfShape J (proj X G) where
#align category_theory.structured_arrow.creates_limits_of_shape CategoryTheory.StructuredArrow.createsLimitsOfShape

noncomputable instance createsLimits [PreservesLimits G] : CreatesLimits (proj X G : _) where

#align category_theory.structured_arrow.creates_limits CategoryTheory.StructuredArrow.createsLimits

instance mono_right_of_mono [HasPullbacks A] [PreservesLimitsOfShape WalkingCospan G]
    {Y Z : StructuredArrow X G} (f : Y ⟶ Z) [Mono f] : Mono f.right :=
  show Mono ((proj X G).map f) from inferInstance
#align category_theory.structured_arrow.mono_right_of_mono CategoryTheory.StructuredArrow.mono_right_of_mono

theorem mono_iff_mono_right [HasPullbacks A] [PreservesLimitsOfShape WalkingCospan G]
    {Y Z : StructuredArrow X G} (f : Y ⟶ Z) : Mono f ↔ Mono f.right :=
  ⟨fun _ => inferInstance, fun _ => mono_of_mono_right f⟩
#align category_theory.structured_arrow.mono_iff_mono_right CategoryTheory.StructuredArrow.mono_iff_mono_right

end StructuredArrow

namespace CostructuredArrow

variable {G : A ⥤ T} {X : T} (F : J ⥤ CostructuredArrow G X)

instance hasColimit [i₁ : HasColimit (F ⋙ proj G X)] [i₂ : PreservesColimit (F ⋙ proj G X) G] :
    HasColimit F := by
  haveI : HasColimit (F ⋙ Comma.fst G (Functor.fromPUnit X)) := i₁
  haveI : PreservesColimit (F ⋙ Comma.fst G (Functor.fromPUnit X)) _ := i₂
  apply Comma.hasColimit
#align category_theory.costructured_arrow.has_colimit CategoryTheory.CostructuredArrow.hasColimit

instance hasColimitsOfShape [HasColimitsOfShape J A] [PreservesColimitsOfShape J G] :
    HasColimitsOfShape J (CostructuredArrow G X) where
#align category_theory.costructured_arrow.has_colimits_of_shape CategoryTheory.CostructuredArrow.hasColimitsOfShape

instance hasColimits [HasColimits A] [PreservesColimits G] : HasColimits (CostructuredArrow G X) :=
  ⟨fun _ _ => inferInstance⟩
#align category_theory.costructured_arrow.has_colimits CategoryTheory.CostructuredArrow.hasColimits

noncomputable instance createsColimit [i : PreservesColimit (F ⋙ proj G X) G] :
    CreatesColimit F (proj G X) :=
  letI : PreservesColimit (F ⋙ Comma.fst G (Functor.fromPUnit X)) G := i
  createsColimitOfReflectsIso fun _ t =>
    { liftedCocone := Comma.coconeOfPreserves F t pUnitCocone
      makesColimit := Comma.coconeOfPreservesIsColimit _ _ pUnitCoconeIsColimit
      validLift := Cocones.ext (Iso.refl _) fun _ => comp_id _ }
#align category_theory.costructured_arrow.creates_colimit CategoryTheory.CostructuredArrow.createsColimit

noncomputable instance createsColimitsOfShape [PreservesColimitsOfShape J G] :
    CreatesColimitsOfShape J (proj G X) where
#align category_theory.costructured_arrow.creates_colimits_of_shape CategoryTheory.CostructuredArrow.createsColimitsOfShape

noncomputable instance createsColimits [PreservesColimits G] : CreatesColimits (proj G X : _) where
#align category_theory.costructured_arrow.creates_colimits CategoryTheory.CostructuredArrow.createsColimits

instance epi_left_of_epi [HasPushouts A] [PreservesColimitsOfShape WalkingSpan G]
    {Y Z : CostructuredArrow G X} (f : Y ⟶ Z) [Epi f] : Epi f.left :=
  show Epi ((proj G X).map f) from inferInstance
#align category_theory.costructured_arrow.epi_left_of_epi CategoryTheory.CostructuredArrow.epi_left_of_epi

theorem epi_iff_epi_left [HasPushouts A] [PreservesColimitsOfShape WalkingSpan G]
    {Y Z : CostructuredArrow G X} (f : Y ⟶ Z) : Epi f ↔ Epi f.left :=
  ⟨fun _ => inferInstance, fun _ => epi_of_epi_left f⟩
#align category_theory.costructured_arrow.epi_iff_epi_left CategoryTheory.CostructuredArrow.epi_iff_epi_left

end CostructuredArrow

end CategoryTheory


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module category_theory.concrete_category.reflects_isomorphisms
! leanprover-community/mathlib commit 73dd4b5411ec8fafb18a9d77c9c826907730af80
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.ConcreteCategory.Basic
import Mathlib.CategoryTheory.Functor.ReflectsIso

/-!
A `forget₂ C D` forgetful functor between concrete categories `C` and `D`
whose forgetful functors both reflect isomorphisms, itself reflects isomorphisms.
-/

universe u

namespace CategoryTheory

instance : ReflectsIsomorphisms (forget (Type u)) where reflects _ _ _ {i} := i

variable (C : Type (u + 1)) [Category C] [ConcreteCategory.{u} C]

variable (D : Type (u + 1)) [Category D] [ConcreteCategory.{u} D]

-- This should not be an instance, as it causes a typeclass loop
-- with `CategoryTheory.hasForgetToType`.
/-- A `forget₂ C D` forgetful functor between concrete categories `C` and `D`
where `forget C` reflects isomorphisms, itself reflects isomorphisms.
-/
theorem reflectsIsomorphisms_forget₂ [HasForget₂ C D] [ReflectsIsomorphisms (forget C)] :
    ReflectsIsomorphisms (forget₂ C D) :=
  { reflects := fun X Y f {i} => by
      skip
      haveI i' : IsIso ((forget D).map ((forget₂ C D).map f)) := Functor.map_isIso (forget D) _
      haveI : IsIso ((forget C).map f) :=
        by
        have := @HasForget₂.forget_comp C D
        rw [← this]
        exact i'
      apply isIso_of_reflects_iso f (forget C) }
#align category_theory.reflects_isomorphisms_forget₂ CategoryTheory.reflectsIsomorphisms_forget₂

end CategoryTheory


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.star.basic
import algebra.ring.pi

/-!
# `star` on pi types

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We put a `has_star` structure on pi types that operates elementwise, such that it describes the
complex conjugation of vectors.
-/

universes u v w
variable {I : Type u}     -- The indexing type
variable {f : I → Type v} -- The family of types already equipped with instances

namespace pi

instance [Π i, has_star (f i)] : has_star (Π i, f i) :=
{ star := λ x i, star (x i) }

@[simp] lemma star_apply [Π i, has_star (f i)] (x : Π i, f i) (i : I) : star x i = star (x i) := rfl

lemma star_def [Π i, has_star (f i)] (x : Π i, f i) : star x = λ i, star (x i) := rfl

instance [Π i, has_star (f i)] [∀ i, has_trivial_star (f i)] : has_trivial_star (Π i, f i) :=
{ star_trivial  := λ _, funext $ λ _, star_trivial _ }

instance [Π i, has_involutive_star (f i)] : has_involutive_star (Π i, f i) :=
{ star_involutive := λ _, funext $ λ _, star_star _ }

instance [Π i, semigroup (f i)] [Π i, star_semigroup (f i)] : star_semigroup (Π i, f i) :=
{ star_mul := λ _ _, funext $ λ _, star_mul _ _ }

instance [Π i, add_monoid (f i)] [Π i, star_add_monoid (f i)] : star_add_monoid (Π i, f i) :=
{ star_add := λ _ _, funext $ λ _, star_add _ _ }

instance [Π i, non_unital_semiring (f i)] [Π i, star_ring (f i)] : star_ring (Π i, f i) :=
{ ..pi.star_add_monoid, ..(pi.star_semigroup : star_semigroup (Π i, f i)) }

instance {R : Type w}
  [Π i, has_smul R (f i)] [has_star R] [Π i, has_star (f i)] [Π i, star_module R (f i)] :
  star_module R (Π i, f i) :=
{ star_smul := λ r x, funext $ λ i, star_smul r (x i) }

lemma single_star [Π i, add_monoid (f i)] [Π i, star_add_monoid (f i)] [decidable_eq I]
  (i : I) (a : f i) :
  pi.single i (star a) = star (pi.single i a) :=
single_op (λ i, @star (f i) _) (λ i, star_zero _) i a

end pi

namespace function

lemma update_star [Π i, has_star (f i)] [decidable_eq I]
  (h : Π (i : I), f i) (i : I) (a : f i) :
  function.update (star h) i (star a) = star (function.update h i a) :=
funext $ λ j, (apply_update (λ i, star) h i a j).symm

lemma star_sum_elim {I J α : Type*} (x : I → α) (y : J → α) [has_star α] :
  star (sum.elim x y) = sum.elim (star x) (star y) :=
by { ext x, cases x; simp }

end function


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang, Yury G. Kudryashov
-/
import topology.continuous_on
import data.setoid.basic
import tactic.tfae

/-!
# Inseparable points in a topological space

In this file we define

* `specializes` (notation: `x ⤳ y`) : a relation saying that `𝓝 x ≤ 𝓝 y`;

* `inseparable`: a relation saying that two points in a topological space have the same
  neighbourhoods; equivalently, they can't be separated by an open set;

* `inseparable_setoid X`: same relation, as a `setoid`;

* `separation_quotient X`: the quotient of `X` by its `inseparable_setoid`.

We also prove various basic properties of the relation `inseparable`.

## Notations

- `x ⤳ y`: notation for `specializes x y`;
- `x ~ y` is used as a local notation for `inseparable x y`;
- `𝓝 x` is the neighbourhoods filter `nhds x` of a point `x`, defined elsewhere.

## Tags

topological space, separation setoid
-/

open set filter function
open_locale topological_space

variables {X Y : Type*} [topological_space X] [topological_space Y] {x y z : X}
  {s : set X} {f : X → Y}

/-!
### `specializes` relation
-/

/-- `x` specializes to `y` (notation: `x ⤳ y`) if either of the following equivalent properties
hold:

* `𝓝 x ≤ 𝓝 y`; this property is used as the definition;
* `pure x ≤ 𝓝 y`; in other words, any neighbourhood of `y` contains `x`;
* `y ∈ closure {x}`;
* `closure {y} ⊆ closure {x}`;
* for any closed set `s` we have `x ∈ s → y ∈ s`;
* for any open set `s` we have `y ∈ s → x ∈ s`;
* `y` is a cluster point of the filter `pure x = 𝓟 {x}`.

This relation defines a `preorder` on `X`. If `X` is a T₀ space, then this preorder is a partial
order. If `X` is a T₁ space, then this partial order is trivial : `x ⤳ y ↔ x = y`. -/
def specializes (x y : X) : Prop := 𝓝 x ≤ 𝓝 y

infix ` ⤳ `:300 := specializes

/-- A collection of equivalent definitions of `x ⤳ y`. The public API is given by `iff` lemmas
below. -/
lemma specializes_tfae (x y : X) :
  tfae [x ⤳ y,
    pure x ≤ 𝓝 y,
    ∀ s : set X, is_open s → y ∈ s → x ∈ s,
    ∀ s : set X, is_closed s → x ∈ s → y ∈ s,
    y ∈ closure ({x} : set X),
    closure ({y} : set X) ⊆ closure {x},
    cluster_pt y (pure x)] :=
begin
  tfae_have : 1 → 2, from (pure_le_nhds _).trans,
  tfae_have : 2 → 3, from λ h s hso hy, h (hso.mem_nhds hy),
  tfae_have : 3 → 4, from λ h s hsc hx, of_not_not $ λ hy, h sᶜ hsc.is_open_compl hy hx,
  tfae_have : 4 → 5, from λ h, h _ is_closed_closure (subset_closure $ mem_singleton _),
  tfae_have : 6 ↔ 5, from is_closed_closure.closure_subset_iff.trans singleton_subset_iff,
  tfae_have : 5 ↔ 7, by rw [mem_closure_iff_cluster_pt, principal_singleton],
  tfae_have : 5 → 1,
  { refine λ h, (nhds_basis_opens _).ge_iff.2 _,
    rintro s ⟨hy, ho⟩,
    rcases mem_closure_iff.1 h s ho hy with ⟨z, hxs, (rfl : z = x)⟩,
    exact ho.mem_nhds hxs },
  tfae_finish
end

lemma specializes_iff_nhds : x ⤳ y ↔ 𝓝 x ≤ 𝓝 y := iff.rfl
lemma specializes_iff_pure : x ⤳ y ↔ pure x ≤ 𝓝 y := (specializes_tfae x y).out 0 1

alias specializes_iff_nhds ↔ specializes.nhds_le_nhds _
alias specializes_iff_pure ↔ specializes.pure_le_nhds _

lemma specializes_iff_forall_open : x ⤳ y ↔ ∀ s : set X, is_open s → y ∈ s → x ∈ s :=
(specializes_tfae x y).out 0 2

lemma specializes.mem_open (h : x ⤳ y) (hs : is_open s) (hy : y ∈ s) : x ∈ s :=
specializes_iff_forall_open.1 h s hs hy

lemma is_open.not_specializes (hs : is_open s) (hx : x ∉ s) (hy : y ∈ s) : ¬ x ⤳ y :=
λ h, hx $ h.mem_open hs hy

lemma specializes_iff_forall_closed : x ⤳ y ↔ ∀ s : set X, is_closed s → x ∈ s → y ∈ s :=
(specializes_tfae x y).out 0 3

lemma specializes.mem_closed (h : x ⤳ y) (hs : is_closed s) (hx : x ∈ s) : y ∈ s :=
specializes_iff_forall_closed.1 h s hs hx

lemma is_closed.not_specializes (hs : is_closed s) (hx : x ∈ s) (hy : y ∉ s) : ¬ x ⤳ y :=
λ h, hy $ h.mem_closed hs hx

lemma specializes_iff_mem_closure : x ⤳ y ↔ y ∈ closure ({x} : set X) :=
(specializes_tfae x y).out 0 4

alias specializes_iff_mem_closure ↔ specializes.mem_closure _

lemma specializes_iff_closure_subset :
  x ⤳ y ↔ closure ({y} : set X) ⊆ closure {x} :=
(specializes_tfae x y).out 0 5

alias specializes_iff_closure_subset ↔ specializes.closure_subset _

lemma specializes_rfl : x ⤳ x := le_rfl

@[refl] lemma specializes_refl (x : X) : x ⤳ x := specializes_rfl

@[trans] lemma specializes.trans : x ⤳ y → y ⤳ z → x ⤳ z := le_trans

lemma specializes_of_nhds_within (h₁ : 𝓝[s] x ≤ 𝓝[s] y) (h₂ : x ∈ s) : x ⤳ y :=
specializes_iff_pure.2 $
calc pure x ≤ 𝓝[s] x : le_inf (pure_le_nhds _) (le_principal_iff.2 h₂)
        ... ≤ 𝓝[s] y : h₁
        ... ≤ 𝓝 y    : inf_le_left

lemma specializes.map_of_continuous_at (h : x ⤳ y) (hy : continuous_at f y) : f x ⤳ f y :=
specializes_iff_pure.2 $ λ s hs, mem_pure.2 $ mem_preimage.1 $ mem_of_mem_nhds $ hy.mono_left h hs

lemma specializes.map (h : x ⤳ y) (hf : continuous f) : f x ⤳ f y :=
h.map_of_continuous_at hf.continuous_at

lemma inducing.specializes_iff (hf : inducing f) : f x ⤳ f y ↔ x ⤳ y :=
by simp only [specializes_iff_mem_closure, hf.closure_eq_preimage_closure_image, image_singleton,
  mem_preimage]

lemma subtype_specializes_iff {p : X → Prop} (x y : subtype p) : x ⤳ y ↔ (x : X) ⤳ y :=
inducing_coe.specializes_iff.symm

variable (X)

/-- Specialization forms a preorder on the topological space. -/
def specialization_preorder : preorder X :=
{ le := λ x y, y ⤳ x,
  lt := λ x y, y ⤳ x ∧ ¬(x ⤳ y),
  .. preorder.lift (order_dual.to_dual ∘ 𝓝) }

variable {X}

/-- A continuous function is monotone with respect to the specialization preorders on the domain and
the codomain. -/
lemma continuous.specialization_monotone (hf : continuous f) :
  @monotone _ _ (specialization_preorder X) (specialization_preorder Y) f :=
λ x y h, h.map hf

/-!
### `inseparable` relation
-/

/-- Two points `x` and `y` in a topological space are `inseparable` if any of the following
equivalent properties hold:

- `𝓝 x = 𝓝 y`; we use this property as the definition;
- for any open set `s`, `x ∈ s ↔ y ∈ s`, see `inseparable_iff_open`;
- for any closed set `s`, `x ∈ s ↔ y ∈ s`, see `inseparable_iff_closed`;
- `x ∈ closure {y}` and `y ∈ closure {x}`, see `inseparable_iff_mem_closure`;
- `closure {x} = closure {y}`, see `inseparable_iff_closure_eq`.
-/
def inseparable (x y : X) : Prop := 𝓝 x = 𝓝 y

local infix ` ~ ` := inseparable

lemma inseparable_def : x ~ y ↔ 𝓝 x = 𝓝 y := iff.rfl

lemma inseparable_iff_specializes_and : x ~ y ↔ x ⤳ y ∧ y ⤳ x := le_antisymm_iff

lemma inseparable.specializes (h : x ~ y) : x ⤳ y := h.le

lemma inseparable.specializes' (h : x ~ y) : y ⤳ x := h.ge

lemma specializes.antisymm (h₁ : x ⤳ y) (h₂ : y ⤳ x) : x ~ y := le_antisymm h₁ h₂

lemma inseparable_iff_forall_open : x ~ y ↔ ∀ s : set X, is_open s → (x ∈ s ↔ y ∈ s) :=
by simp only [inseparable_iff_specializes_and, specializes_iff_forall_open, ← forall_and_distrib,
  ← iff_def, iff.comm]

lemma not_inseparable_iff_exists_open : ¬(x ~ y) ↔ ∃ s : set X, is_open s ∧ xor (x ∈ s) (y ∈ s) :=
by simp [inseparable_iff_forall_open, ← xor_iff_not_iff]

lemma inseparable_iff_forall_closed : x ~ y ↔ ∀ s : set X, is_closed s → (x ∈ s ↔ y ∈ s) :=
by simp only [inseparable_iff_specializes_and, specializes_iff_forall_closed, ← forall_and_distrib,
  ← iff_def]

lemma inseparable_iff_mem_closure :
  x ~ y ↔ x ∈ closure ({y} : set X) ∧ y ∈ closure ({x} : set X) :=
inseparable_iff_specializes_and.trans $ by simp only [specializes_iff_mem_closure, and_comm]

lemma inseparable_iff_closure_eq : x ~ y ↔ closure ({x} : set X) = closure {y} :=
by simp only [inseparable_iff_specializes_and, specializes_iff_closure_subset,
  ← subset_antisymm_iff, eq_comm]

lemma inseparable_of_nhds_within_eq (hx : x ∈ s) (hy : y ∈ s) (h : 𝓝[s] x = 𝓝[s] y) : x ~ y :=
(specializes_of_nhds_within h.le hx).antisymm (specializes_of_nhds_within h.ge hy)

lemma inducing.inseparable_iff (hf : inducing f) : f x ~ f y ↔ x ~ y :=
by simp only [inseparable_iff_specializes_and, hf.specializes_iff]

lemma subtype_inseparable_iff {p : X → Prop} (x y : subtype p) : x ~ y ↔ (x : X) ~ y :=
inducing_coe.inseparable_iff.symm

namespace inseparable

@[refl] lemma refl (x : X) : x ~ x := eq.refl (𝓝 x)

lemma rfl : x ~ x := refl x

@[symm] lemma symm (h : x ~ y) : y ~ x := h.symm

@[trans] lemma trans (h₁ : x ~ y) (h₂ : y ~ z) : x ~ z := h₁.trans h₂

lemma nhds_eq (h : x ~ y) : 𝓝 x = 𝓝 y := h

lemma mem_open_iff (h : x ~ y) (hs : is_open s) : x ∈ s ↔ y ∈ s :=
inseparable_iff_forall_open.1 h s hs

lemma mem_closed_iff (h : x ~ y) (hs : is_closed s) : x ∈ s ↔ y ∈ s :=
inseparable_iff_forall_closed.1 h s hs

lemma map_of_continuous_at (h : x ~ y) (hx : continuous_at f x) (hy : continuous_at f y) :
  f x ~ f y :=
(h.specializes.map_of_continuous_at hy).antisymm (h.specializes'.map_of_continuous_at hx)

lemma map (h : x ~ y) (hf : continuous f) : f x ~ f y :=
h.map_of_continuous_at hf.continuous_at hf.continuous_at

end inseparable

lemma is_closed.not_inseparable (hs : is_closed s) (hx : x ∈ s) (hy : y ∉ s) : ¬x ~ y :=
λ h, hy $ (h.mem_closed_iff hs).1 hx

lemma is_open.not_inseparable (hs : is_open s) (hx : x ∈ s) (hy : y ∉ s) : ¬x ~ y :=
λ h, hy $ (h.mem_open_iff hs).1 hx

/-!
### Separation quotient

In this section we define the quotient of a topological space by the `inseparable` relation.
-/

variable (X)

/-- A `setoid` version of `inseparable`, used to define the `separation_quotient`. -/
def inseparable_setoid : setoid X :=
{ r := (~),
  .. setoid.comap 𝓝 ⊥ }

/-- The quotient of a topological space by its `inseparable_setoid`. This quotient is guaranteed to
be a T₀ space. -/
@[derive topological_space]
def separation_quotient := quotient (inseparable_setoid X)

variable {X}

namespace separation_quotient

/-- The natural map from a topological space to its separation quotient. -/
def mk : X → separation_quotient X := quotient.mk'

lemma quotient_map_mk : quotient_map (mk : X → separation_quotient X) :=
quotient_map_quot_mk

lemma continuous_mk : continuous (mk : X → separation_quotient X) :=
continuous_quot_mk

@[simp] lemma mk_eq_mk : mk x = mk y ↔ x ~ y := quotient.eq'

lemma surjective_mk : surjective (mk : X → separation_quotient X) :=
surjective_quot_mk _

@[simp] lemma range_mk : range (mk : X → separation_quotient X) = univ :=
surjective_mk.range_eq

instance [nonempty X] : nonempty (separation_quotient X) := nonempty.map mk ‹_›
instance [inhabited X] : inhabited (separation_quotient X) := ⟨mk default⟩
instance [subsingleton X] : subsingleton (separation_quotient X) := surjective_mk.subsingleton

lemma preimage_image_mk_open (hs : is_open s) : mk ⁻¹' (mk '' s) = s :=
begin
  refine subset.antisymm _ (subset_preimage_image _ _),
  rintro x ⟨y, hys, hxy⟩,
  exact ((mk_eq_mk.1 hxy).mem_open_iff hs).1 hys
end

lemma is_open_map_mk : is_open_map (mk : X → separation_quotient X) :=
λ s hs, quotient_map_mk.is_open_preimage.1 $ by rwa preimage_image_mk_open hs

lemma preimage_image_mk_closed (hs : is_closed s) : mk ⁻¹' (mk '' s) = s :=
begin
  refine subset.antisymm _ (subset_preimage_image _ _),
  rintro x ⟨y, hys, hxy⟩,
  exact ((mk_eq_mk.1 hxy).mem_closed_iff hs).1 hys
end

lemma inducing_mk : inducing (mk : X → separation_quotient X) :=
⟨le_antisymm (continuous_iff_le_induced.1 continuous_mk)
  (λ s hs, ⟨mk '' s, is_open_map_mk s hs, preimage_image_mk_open hs⟩)⟩

lemma is_closed_map_mk : is_closed_map (mk : X → separation_quotient X) :=
inducing_mk.is_closed_map $ by { rw [range_mk], exact is_closed_univ }

lemma map_mk_nhds : map mk (𝓝 x) = 𝓝 (mk x) :=
by rw [inducing_mk.nhds_eq_comap, map_comap_of_surjective surjective_mk]

end separation_quotient


/- Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------
# HW 13
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import lectures.lec18_nat_trans
import tactic.basic

open PROOFS
open PROOFS.STR

open category_str

--infixr ` ⟶ `:10 := precategory_str.hom -- type as \h
--notation `𝟙` := precategory_str.id -- type as \b1
-- infixr ` ⊚ `:80 := precategory_str.comp-- type as \oo
local notation f ` ⊚ `:80 g:80 := precategory_str.comp g f

universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄
variables {𝓒 : Type u₁} [category_str.{v₁} 𝓒] {𝓓 : Type u₂} [category_str.{v₂} 𝓓]

/-! ## Q1. Construct the type of all groups.
Show that this type admits the structure of a (large) category where
morphisms are group homomorphisms.-/

structure mult_Group' :=
(carrier : Type)
(str : mult_group_str carrier )

#check mult_Group' -- type of all groups, carrier type equipped with a multiplicative group strucutre

structure bundled (C : Type v₁ → Type u₁) :=
(carrier : Type*)
(str : C carrier )

instance (M : mult_Group') : mult_group_str M.carrier := M.str

-- OUR GOAL IS FIRST TO DEFINE A CATEGORY WHERE MORPHISMS ARE GROUP HOMOMORPHISMS

@[ext] -- first we define a class of morphisms between group structures
--  A group morphism between groups `M` and `N` is given by a function `f : M → N` which preserves the multiplication operation.
class mult_Group.morphism (M : Type u₁) (N : Type u₁) [mult_group_str M] [mult_group_str N] :=
(to_fun : M → N) -- f : M → N -- the underlying function of morphism
(resp_one : to_fun 1 = 1) -- f (1_M ) = 1_N
(resp_mul : ∀ x y : M, to_fun (x * y) = to_fun x * to_fun y)

#check mult_Group.morphism

-- first we defined an identity morphism between group structures
def mult_group.morphism.id {M : Type}[mult_group_str M] : mult_Group.morphism M M:=
{
  to_fun := id, -- in order to define an identity function, we provide id
  resp_one := by { -- our goal is to prove `id 1 = 1`
    refl, -- By defintion `id 1` and `1` are equal
    },
  resp_mul := by { -- our goal is to prove `∀ (x y : M), id ( x * y) = id x * id y`
  intros x y, -- First, we fix ` x y : M ` in the context
  simp,}, -- since ` id x = x ` by defintion, ` id y = y ` by defintion, and ` id ( x * y ) = x * y `  by defintion, the goal can be written as ` x * y = x * y ` which is resolved since both sides are defintionally equal
}

-- next we must define composition of group morphisms
@[simp]
def mult_Group.morphism.comp {L M N : Type} [mult_group_str L] [mult_group_str M] [mult_group_str N] (g : mult_Group.morphism M N) (f : mult_Group.morphism L M) : mult_Group.morphism L N :=
{ to_fun := g.to_fun ∘ f.to_fun, -- composotion of group morphisms is defined as the composition of the to_fun component of each group morphism
  resp_one := by { -- our goal is to prove `(morphism.to_fun ∘ morphism.to_fun) 1 = 1`
  dsimp, -- through simplification, the composition is simplified so that the goal turns into ` morphism.to_fun (morphism.to_fun 1) = 1`
  rw mult_Group.morphism.resp_one, -- our goal is to resolve `morphism.to_fun (morphism.to_fun 1) = 1` and there exists a mult_Group.morphism on g and f, a property of this morphism is that it respects one, therefore this property can be invoked
  rw mult_Group.morphism.resp_one,}, -- our goal is to resolve ` morphism.to_fun 1 = 1 ` and since there exists a mult_Group.morphism on g and f, this resolves a property of this morphsim which resolves the goal
  resp_mul := by { -- our goal is to prove `∀ (x y : L), (morphism.to_fun ∘ morphism.to_fun) (x * y) = (morphism.to_fun ∘ morphism.to_fun) x * (morphism.to_fun ∘ morphism.to_fun) y`
  intros x y, -- we fix ` x y : L ` in the context
  dsimp, -- through simplification, the composition is simplified so that the goal turns into `morphism.to_fun (morphism.to_fun (x * y)) = morphism.to_fun (morphism.to_fun x) * morphism.to_fun (morphism.to_fun y`
  rw mult_Group.morphism.resp_mul, -- our goal is to resolve `morphism.to_fun (morphism.to_fun (x * y)) = morphism.to_fun (morphism.to_fun x) * morphism.to_fun (morphism.to_fun y` and since there exists a mult_Group.morphism on g and f, this resolves a property of this morphsim which resolves the goal
  rw mult_Group.morphism.resp_mul, }, -- our goalis to resolve ` morphism.to_fun (morphism.to_fun x * morphism.to_fun y) = morphism.to_fun (morphism.to_fun x) * morphism.to_fun (morphism.to_fun y` and since there exists a mult_Group.morphism on g and f, this resolves a property of this morphsim which resolves the goal
}

-- in order to admit a category whose morphisms are group morphisms, we create lemmas which satifisy the fields of a category_str
@[simp]
lemma mult_group.morphism.id_comp {L M : Type} [mult_group_str L] [mult_group_str M]  (f : mult_Group.morphism L M)  :
  mult_Group.morphism.comp f (mult_group.morphism.id) = f :=
begin 3
  ext, -- By extensionality, it is sufficient to prove the to_fun components of the morphism f and id when composed yields the original to_fun function
  refl, -- Our goal is transformed to `morphism.to_fun x = morphism.to_fun x` and both sides are definitionally equal
end

@[simp]
lemma mult_group.morphism.comp_id {L M : Type} [mult_group_str L] [mult_group_str M]  (f : mult_Group.morphism L M)  :
  mult_Group.morphism.comp (mult_group.morphism.id) f = f :=
begin
  ext, -- By extenstionality, it is sufficient to prove the to_fun components of the morphism f and id when composed yields the original to_fun function
  refl, -- Our goal is transformed to `morphism.to_fun x = morphism.to_fun x` and both sides are definitonally equal
end

@[simp]
def mult_group.morphism.comp_assoc {K L M N: Type} [mult_group_str K] [mult_group_str L] [mult_group_str M] [mult_group_str N] (f : mult_Group.morphism K L) (g : mult_Group.morphism L M) (h : mult_Group.morphism M N) :
  mult_Group.morphism.comp (mult_Group.morphism.comp h g) f =  mult_Group.morphism.comp h (mult_Group.morphism.comp g f) :=
begin
  refl, -- The goal is resolved since both sides of the equal sign are defintionally equal
end

instance cat_of_groups : large_category_str (mult_Group') :=
{ hom := λ X, λ Y, mult_Group.morphism X.carrier Y.carrier, -- we first must provide a function which takes `mult_Group' → mult_Group' → Type`
  id := λ X, mult_group.morphism.id,  -- we first fix ` X : mult_Group' ` and next we provide a function ` X.carrier → X.carrier `
  comp := λ X Y Z, λ f g , mult_Group.morphism.comp g f, -- we first fix ` X Y Z : mult_Group'` in the context and ` f: mult_Group.morphism X.carrier Y.carrier` and ` g : mult_Group.morphism Y.carrier Z.carrier ` in the context as well, we then must define composition of multiplicative group structures which is given by `mult_Group.morphism.comp g f`
  id_comp' := by { -- our goal is to prove `∀ {X Y : mult_Group'} (f : X ⟶ Y), f ⊚ 𝟙 X = f`
    intros X Y, -- we fix `X Y : mult_Group` in the context
    exact mult_group.morphism.id_comp}, -- in order to prove composition with the id function yields the original function, we use the previously defined lemma
  comp_id' := by { -- our goal is to prove `∀ {X Y : mult_Group'} (f : X ⟶ Y), 𝟙 Y ⊚ f = f`
    intros X Y, -- we fix `X Y : mult_Group'` in the context
    exact mult_group.morphism.comp_id}, -- in order to prove composition with the id function yields the original function, we use the previously defined lemma
  comp_assoc' := by { -- our goal is to prove `∀ {W X Y Z : mult_Group'} (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z), h ⊚ g ⊚ f = h ⊚ (g ⊚ f)`
    intros W X Y Z, -- we fix ` W X Y Z : mult_Group' ` in the context
    exact mult_group.morphism.comp_assoc,} -- in order to prove composition is associative, we use the previously defined lemma
    }

/-! ## Q2  Show that a monoid action gives rise to a functor from the
delooping category of the monoid to the category of types.
You can show that by filling in for the sorry placeholder in below. -/

def delooping_monoid_action (A : Type) [M : mult_Monoid] [mult_monoid_action M.carrier A] :
(delooping_cat M).carrier ⥤  Type* :=
{ obj := λ X, A, -- for this field we must provide an instance `(delooping_cat M).carrier → Type `
  mor := λ X Y, _inst_3.smul, -- we fix ` X Y : (delooping_cat M).carrier → Type` in the context, we then provide a function from `mult_monoid_action M.carrier A`
  resp_id' := by { -- our goal is to solve ` ∀ (X : (delooping_cat M).carrier), mult_monoid_action.smul (𝟙 X) = 𝟙 A`
  intro X, -- we fix ` X : (delooping_cat M).carrier ` in the context
  simp [precategory_str.id], -- through simplification, ` 𝟙 A ` is reduced to `id`
  have h₃: ∀ (x : A), mult_monoid_action.smul ( 1 : M.carrier ) x = x, by {exact _inst_3.one_smul'}, -- we create a proof in the context which proves the propostion `∀ (x : A), mult_monoid_action.smul 1 x = x` . The proof of this proposition derives from a property associated with mult_monoid_action
  funext,  -- since we are proving equality of functions, we evoke function extenstionality
  simp, -- Through simplificatioin ` id x ` is reduced to ` x `
  have h₅ : 𝟙 X = ( 1 : M.carrier), by {refl,}, -- we introduce a proof in the context which proves `𝟙 X` and `( 1 : M.carrier)` are equal since this is known by defintion
  rw h₅, -- there is `𝟙 X` in the goal and we want to replace it by `1` to prove that `mult_monoid_action.smul 1 x = x` since we know `h₅` says something about the goal
  exact h₃ x,  -- the goal is resolved by invoking the proposition found in the context
  },
  resp_comp' := by { -- our goal is to prove `∀ {X Y Z : (delooping_cat M).carrier} (f : X ⟶ Y) (g : Y ⟶ Z), mult_monoid_action.smul (g ⊚ f) = mult_monoid_action.smul g ⊚ mult_monoid_action.smul f`
  intros X Y Z f g, -- we fix ` X Y Z : (delooping_cat M).carrier → Type` and ` f : X ⟶ Y ` and `g : Y ⟶ Z` in the context
  funext y,
  rw ← _inst_3.mul_smul' f g y,

  }
  }

/-! ## Question 4: The Arrow Category
Given a category 𝓒 we want to construct a new category whose objects are morphisms of 𝓒 and whose morphisms are commutative squares in 𝓒.
 -/

@[ext]
structure arrow_type (𝓒 : Type*) [small_category_str 𝓒] :=
(dom : 𝓒)
(cod : 𝓒)
(arrow : dom ⟶ cod)

#check arrow_type

local notation `𝔸𝕣` : 10 := arrow_type

@[ext]
structure arrow_type_hom {𝓒 : Type*}[small_category_str 𝓒] (α β : 𝔸𝕣 𝓒 ) :=
(top : α.dom ⟶ β.dom)
(bot : α.cod ⟶ β.cod)
(eq : β.arrow ⊚ top = bot ⊚ α.arrow)

#check arrow_type_hom

/-
Show that we can equip `𝓒[→]` with the structure of a category where morphisms of 𝓒 and whose morphisms are commutative squares in 𝓒.
-/

instance arrow_cat (𝓒 : Type*)[small_category_str 𝓒] : small_category_str (𝔸𝕣 𝓒) :=
{ hom := λ α, λ β, arrow_type_hom α β ,
  id := λ α, ⟨𝟙 α.dom, 𝟙 α.cod, by {simp,}⟩ ,
  comp := λ X Y Z, λ f, λ g, ⟨  -- we must define composition of arrow_type_hom and in order to do this we fix ` X Y Z : 𝔸𝕣 𝓒 ` and ` f : arrow_type_hom X Y` and ` g : arrow_type_hom Y Z` in the context and provide an instance of type arrow_type_hom which defines composition
    precategory_str.comp f.top g.top, -- for the first field, we compose the top function of the homomorphisms of f g
  precategory_str.comp f.bot g.bot, -- for the second field, we compose the top function of the homomorphisms of f g
  by { -- our goal is to prove `Z.arrow ⊚ (g.top ⊚ f.top) = g.bot ⊚ f.bot ⊚ X.arrow`
  simp, -- through simplificaiton, the associativity of composition is utlized, in order to rewrite the goal as `Z.arrow ⊚ (g.top ⊚ f.top) = g.bot ⊚ (f.bot ⊚ X.arrow)`
  have h₂: Y.arrow ⊚ f.top = f.bot ⊚ X.arrow , by {exact arrow_type_hom.eq f}, -- we create a proof in the context which proves the proposition ` Y.arrow ⊚ f.top = f.bot ⊚ X.arrow` which is proven by the `eq` property associated with the arrow_type_hom structure
  have h₃: Z.arrow ⊚ g.top = g.bot ⊚ Y.arrow, by {exact arrow_type_hom.eq g}, -- we create a proof in the context which proves the proposition `Z.arrow ⊚ g.top = g.bot ⊚ Y.arrow` which is proven by the `eq` property associated ith the arrow_type_hom structure
  rw ← h₂, -- there is `f.bot ⊚ X.arrow` in h₂ and we want to replace it by `Y.arrow ⊚ f.top` to prove that `Z.arrow ⊚ (g.top ⊚ f.top) = g.bot ⊚ (Y.arrow ⊚ f.top)` since we know `h₂` says something about the goal
  have h₄: (Z.arrow ⊚ g.top) ⊚ f.top = Z.arrow ⊚ (g.top ⊚ f.top), by {exact category_str.comp_assoc f.top g.top Z.arrow},  -- we create a proof in the context that proves the associativity of composition which is a property associated with category_str
  rw ← h₄, -- there is `Z.arrow ⊚ (g.top ⊚ f.top)` in the goal and we want to replace it by `(Z.arrow ⊚ g.top) ⊚ f.top` to prove that `Z.arrow ⊚ g.top ⊚ f.top = g.bot (Y.arrow ⊚ f.top)` since we know `h₄` says something about the goal
  rw h₃, -- there is `Z.arrow ⊚ g.top` in the goal and we want to replace it by `g.bot ⊚ Y.arrow` to prove that `g.bot ⊚ Y.arrow ⊚ f.top = g.bot ⊚ (Y.arrow ⊚ f.top)` since we know `h₃` says something about the goal
  exact category_str.comp_assoc f.top Y.arrow g.bot,  -- a property associated with category_str is the associativity of composition which is required to resolve the goal
   }
   ⟩ ,
  id_comp' := by { -- our goal is to prove `∀ {X Y : 𝔸𝕣 𝓒} (f : X ⟶ Y), f ⊚ 𝟙 X = f`
  intros X Y f,  -- we fix ` X Y : 𝔸𝕣 𝓒` and ` f : X ⟶ Y ` in the context
  simp, -- Through simplification, properties concerning the composition of 𝟙 and the components of the arrow_type_hom is broken down
  ext, -- By extensionality, we can prove the homomorphisms are equal by proving the f.top functions are equal and the f.bottom functions are equal
  {
    refl, -- Both sides of the propostion are definitionally equal, therefore the goal is resolved
  } ,
  {
    refl, -- Both sides of the propostion are definitionally equal, therefore the goal is resolved
  },
   },
  comp_id' := by { -- our goal is to prove `∀ {X Y : 𝔸𝕣 𝓒} (f : X ⟶ Y), 𝟙 Y ⊚ f = f`
  intros X Y f, -- we fix ` X Y : 𝔸𝕣 𝓒` and ` f : X ⟶ Y ` in the context
  simp,  -- Through simplification, properties concerning the composition of 𝟙 and the components of the arrow_type_hom is broken down
  ext,  -- By extensionality, we can prove the homomorphisms are equal by proving the f.top functions are equal and the f.bottom functions are equal
  {
    refl, -- Both sides of the propostion are definitionally equal, therefore the goal is resolved
  } ,
  {
    refl, -- Both sides of the propostion are definitionally equal, therefore the goal is resolved
  },
  },
  comp_assoc' := by { -- our goal is to prove ` ∀ {W X Y Z : 𝔸𝕣 𝓒} (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z), h ⊚ g ⊚ f = h ⊚ (g ⊚ f)`
  intros Q X Y Z f g h, -- we fix ` Q X Y Z : 𝔸𝕣 𝓒 ` and ` f : W ⟶ X`  `g :X ⟶ Y`  `h :  Y ⟶ Z`  in the context
  ext,  -- By extensionality, we can prove the homomorphisms are equal by proving the f.top functions are equal and the f.bottom functions are equal
  {
    exact category_str.comp_assoc f.top g.top h.top, -- we invoke the property that composition is associative associated with category_str
  },
  {
    exact category_str.comp_assoc f.bot g.bot h.bot, -- we invoke the property that composition is associative associated with category_str
  },
  },
  }

/-
We shall define two functors form `𝔸𝕣 𝓒` to `𝓒`: `Dom` and `Cod`. `Dom` takes an arrow `f : X ⟶ Y` to its domain `X` and `Cod` takes `f` to `Y`.
-/

def Dom (𝓒 : Type*)[small_category_str 𝓒] :
  (𝔸𝕣 𝓒) ⥤ 𝓒 :=
{ obj := λ α, α.dom,
  mor := λ X Y, λ f, arrow_type_hom.top f, -- we fix ` X Y : 𝔸𝕣 𝓒` in the context `f : X ⟶ Y` and provide a function from `X.dom ⟶ Y.dom` which is satisfied through the top function associated with arrow_type_hom structure
  resp_id' := by {-- our goal is to prove ` ∀ (X : 𝔸𝕣 𝓒), (𝟙 X).top = 𝟙 X.dom`
    intro X, -- we fix ` X : 𝔸𝕣 𝓒 ` in the context
  simp only [precategory_str.id]}, -- we resolve the goal through simplification of the id function associatiated with the precategory_str
  resp_comp' := by { -- our goal is to prove `∀ {X Y Z : 𝔸𝕣 𝓒} (f : X ⟶ Y) (g : Y ⟶ Z), (g ⊚ f).top = g.top ⊚ f.top`
    intros A B C f g, -- we fix ` A B C : 𝔸𝕣 𝓒 ` in the context ` f: A  ⟶ B ` and ` g : B ⟶ C ` in the context
    simp only [precategory_str.comp],}, } -- we resolve the goal through simplification of the defntion of composition associated with the pre_category_str

def Cod (𝓒 : Type*)[small_category_str 𝓒] :
  (𝔸𝕣 𝓒) ⥤ 𝓒 :=
{ obj := λ α, α.cod,
  mor := λ X Y, λ f, arrow_type_hom.bot f, -- we fix ` X Y : 𝔸𝕣 𝓒` in the context `f : X ⟶ Y` and provide a function from `X.cod → Y.cod` which is satisfied through the top function associated with arrow_type_hom structure
  resp_id' := by { -- our goal is to prove `∀ (X : 𝔸𝕣 𝓒), (𝟙 X).bot = 𝟙 X.cod`
  intro X, -- we fix ` X :  𝔸𝕣 𝓒 ` in the context
  simp only [precategory_str.id]}, -- we resolve the goal through simplification of the id function associatiated with the precategory_str
  resp_comp' := by { -- our goal is to prove `∀ {X Y Z : 𝔸𝕣 𝓒} (f : X ⟶ Y) (g : Y ⟶ Z), (g ⊚ f).bot = g.bot ⊚ f.bot`
  intros A B C f g,  -- we fix ` A B C : 𝔸𝕣 𝓒 ` in the context ` f: A  ⟶ B ` and ` g : B ⟶ C ` in the context
  simp only [precategory_str.comp], --  -- we resolve the goal through simplification of the defntion of composition associated with the pre_category_str
  }, }

/- Theorem:
For functors `F G : 𝓒 ⥤ 𝓓`, the type of natural transformations `F ⟶ G` is equivalent to the type of functors `𝓒 ⥤ 𝔸𝕣 𝓓`  whose composition with `Dom` and `Cod` are equal to `F` and `G` respectively.

Therefore, the arrow category classifies natural transformations.
-/

local notation F ` ⊚⊚ `:80 G:80 := category_str.functor.comp G F

def arrow_cat_classifies_nat_trans {𝓒 𝓓 : Type*}[small_category_str 𝓒] [small_category_str 𝓓] (F G : 𝓒 ⥤ 𝓓) :
(F ⟶ G) ≅ { H : 𝓒 ⥤ 𝔸𝕣 𝓓 // ( (Dom 𝓓) ⊚⊚ H = F ) ∧ ((Cod 𝓓) ⊚⊚ H = G) }  :=
{ to_mor := λ f,
⟨ {
  obj := λ a, ⟨F.obj a, G.obj a, nat_trans.cmpt F.obj G.obj⟩ ,
  mor := λ X Y f, sorry,
  resp_id' := sorry,
  resp_comp' := sorry,
},
by {split,
{

},
{

},
}
⟩,
  inv_mor := λ f,
⟨ {
  obj := λ a,,
  mor := λ X Y f, sorry,
  resp_id' := sorry,
  resp_comp' := sorry,
},
by {split,
{

},
{

},
}
⟩,
,
  left_inv := _,
  right_inv := _ }

/-! ## Question 3: Yoneda Problem -/

open nat_trans

def Yoneda (X Y : 𝓒) (α : ℍom.obj X ≅  ℍom.obj Y) :
  X ≅ Y :=
{
  to_mor := α.to_mor.cmpt (op X) (𝟙 X),
  inv_mor := α.inv_mor.cmpt (op Y) (𝟙 Y),
  left_inv := by { have h₁, from α.inv_mor.naturality (α.to_mor.cmpt (op X) (𝟙 X)),
  simp at h₁,

  sorry, },
  right_inv := sorry,
}


/-

Noetherian topological spaces

-/

-- this import gives us irreducible topological spaces
import topology.subset_properties

-- this gives us the type of open sets in a top space
import topology.opens

open set

open_locale classical

@[simp]
lemma irred_iff_not_union_closed {X : Type*} [topological_space X] (Y : set X) :
is_irreducible Y ↔ Y.nonempty ∧ ∀ C₁ C₂ : set X,
  is_closed C₁ → is_closed C₂ → Y ⊆ C₁ ∪ C₂ → Y ⊆ C₁ ∨ Y ⊆ C₂ :=
begin
  split,
  { rintro ⟨h0, h⟩,
    split, exact h0,
    rwa ←is_preirreducible_iff_closed_union_closed,
  },
  { rintro ⟨h0, h⟩,
    split, assumption,
    rwa is_preirreducible_iff_closed_union_closed,
  }
end

/-- A non-empty Y is irreducible iff every non-empty open subset of Y is dense -/
lemma irred_iff_nonempty_open_dense {X : Type*} [topological_space X] (Y : set X):
is_irreducible Y ↔ Y.nonempty ∧
  ∀ U₁ U₂ : set X, is_open U₁ → is_open U₂ →
  (Y ∩ U₁).nonempty → (Y ∩ U₂).nonempty → (Y ∩ (U₁ ∩ U₂)).nonempty := iff.rfl

/-
Corollary 5.3. Let S be a irreducible topological space and U ⊆ S a non-empty
open subset. Then U is irreducible (in the subspace topology).
-/

lemma open_irred {X : Type*} [topological_space X]
  (S : set X) (hiS : is_irreducible S) (V : set X) (hV : is_open V) :
  (V ∩ S).nonempty → is_irreducible (V ∩ S) :=
begin
  rintro ⟨x, hx⟩,
  rw irred_iff_nonempty_open_dense,
  split, use x, assumption,
  intros U₁ U₂ oU₁ oU₂ hne₁ hne₂,
  rw irred_iff_nonempty_open_dense at hiS,
  rcases hiS with ⟨h3, h4⟩,
  replace h4 := h4 (V ∩ U₁) (V ∩ U₂)
    (is_open_inter hV oU₁) (is_open_inter hV oU₂),
  convert h4 (by convert hne₁ using 1; ac_refl) (by convert hne₂ using 1; ac_refl) using 1,
  ext, split; finish,
end

/-

A topological space is Noetherian if it satisfies the descending chain
condition for open subsets

Alternatively, we have upwards induction on closed sets.
-/

namespace topological_space

open_locale classical

variables {X : Type*} [topological_space X]

instance for_ken : partial_order (closeds X) := subtype.partial_order _

def is_noetherian (X : Type*) [topological_space X] : Prop :=
well_founded ((<) : closeds X → closeds X → Prop)

-- factorises means expressable as finite union of closed irreducibles.
def factorises {X : Type*} [topological_space X] (C : closeds X) :=
∃ ι : finset (set X), sUnion (↑ι : set _) = C.1 ∧
(∀ Ci ∈ ι, is_irreducible Ci) ∧ (∀ Ci ∈ ι, is_closed Ci)

lemma inter_ssubet_of_not_subset {X : Type*} {A B : set X}
(A_not_sub_B : ¬ A ⊆ B) : A ∩ B ⊂ A := ⟨inter_subset_left _ _,
  not_subset.2 $ let ⟨a,a_in_A,a_not_in_B⟩ := not_subset.1 A_not_sub_B in
  ⟨a,a_in_A, λ a_in_A_inter_B, a_not_in_B a_in_A_inter_B.2⟩
⟩

lemma eq_union_inter_of_subset_union {X : Type*} {A B C : set X}
(A_subset_B_union_C : A ⊆ B ∪ C) : A = (A ∩ B) ∪ (A ∩ C) :=
inter_distrib_left A B C ▸ eq_of_subset_of_subset
(subset_inter (subset.refl _) (A_subset_B_union_C))
(inter_subset_left _ _)

lemma induction_step {X : Type*} [topological_space X]
{Y : set X} (Y_closed : is_closed Y)
(Y_not_irreducible : ¬ is_irreducible Y) :
Y = ∅ ∨
∃ C1 C2 : set X, is_closed C1 ∧ is_closed C2 ∧ Y = C1 ∪ C2 ∧ C1 < Y ∧ C2 < Y
:= begin
  cases (classical.em (Y.nonempty)) with Y_nonempty Y_not_nonempty,
  -- Case of Y nonempty,
  apply or.inr,
  simp at Y_not_irreducible, -- Tell lean to expand on Y not irreducible.
  have not_forall, from Y_not_irreducible Y_nonempty,
  push_neg at not_forall, -- Makes the not forall statement usable.
  rcases not_forall with ⟨X1, X2, X1_closed, X2_closed,
  Y_subset_X1_union_X2, not_Y_subset_X1, not_Y_subset_X2⟩,
  use Y ∩ X1, use Y ∩ X2, -- These are the desired two closed sets.
  split, exact (is_closed_inter Y_closed X1_closed), -- Y ∩ X1 closed
  split, exact (is_closed_inter Y_closed X2_closed), -- Y ∩ X2 closed
  split, exact eq_union_inter_of_subset_union Y_subset_X1_union_X2, -- Y = Y ∩ X1 ∪ Y ∩ X2
  split, exact (inter_ssubet_of_not_subset not_Y_subset_X1), -- Y ∩ X1 ⊂ Y
  exact (inter_ssubet_of_not_subset not_Y_subset_X2), -- Y ∩ X2 ⊂ Y
  -- Case of Y empty
  apply or.inl,
  apply eq_empty_iff_forall_not_mem.2,
  apply forall_not_of_not_exists Y_not_nonempty,
end
/-- In a Noetherian top space X,
every closed subset C can be "factorised",
that is expressable as a finite union of irreducible closed subsets C_i.
Note that emptyset has a factorisation, the empty union,
analogous to 1 being empty product of primes. --/
theorem finite_union_irreducibles {X : Type*} [topological_space X]
(X_noetherian : is_noetherian X) :
∀ C : closeds X, factorises C :=
  -- We prove factorisation of closed sets by induction.
  @well_founded.fix _ (λ C : closeds X, factorises C) _ X_noetherian $
  -- Let Y be a closed set of X, and assume the induction hypothesis,
  -- all closed sets strictly smaller than Y factorises.
  λ Y : closeds X, λ induction_hypothesis,
  -- We do cases on whether Y is irreducible.
  or.elim (classical.em (is_irreducible Y.1))
  (-- Case of Y being irreducible.
    λ Y_irreducible,
    -- Since Y is irreducible, Y gives a factorisation of Y.
    ⟨{Y.1},  -- The finset containing only
      sUnion_singleton Y.1, -- Proof that union of sets in {Y} is Y.
      -- Proof that everything in {Y} is irreducible.
      λ (Y1 : set X) Y1_in_finset, -- Take a set in {Y}
        have Y1_eq_Y : Y1 = Y.1, from eq_of_mem_singleton Y1_in_finset,
        Y1_eq_Y.symm ▸ Y_irreducible,  -- Y1 = Y is irreducible, so done.
      -- Proof that everything in {Y} is irreducible.
      λ (Y1 : set X) Y1_in_finset, -- Take a set in {Y}
        have Y1_eq_Y : Y1 = Y.1, from eq_of_mem_singleton Y1_in_finset,
        Y1_eq_Y.symm ▸ Y.2,  -- Y1 = Y is closed, so done.
    ⟩
  )
  (-- Case of Y being not irreducible.
    λ Y_not_irreducible,
      -- If Y is not irreducible,
      -- it is empty or union of two strictly smaller closed sets.
      or.elim (induction_step Y.2 Y_not_irreducible)
      (λ Y_empty, -- If Y is empty, empty union works.
        ⟨ ∅,
          Y_empty.symm ▸ sUnion_empty, -- Empty union is empty
          λ C C_in_empty_finset, -- Everything in empty set is irreducible
            begin cases C_in_empty_finset, end,
          λ C C_in_empty_finset, -- Everything in empty set is closed
            begin cases C_in_empty_finset, end,
        ⟩)
      (-- Let C1, C2 be two closed sets that union to Y,
        -- but are strictly smaller than Y.
        λ ⟨C1, C2, C1_closed, C2_closed, Y_eq_C1_union_C2,
        C1_ssub_Y, C2_ssub_Y⟩,
        have C1_factorises : factorises ⟨C1,C1_closed⟩,
          from induction_hypothesis ⟨C1,C1_closed⟩ C1_ssub_Y,
        have C2_factorises : factorises ⟨C2,C2_closed⟩,
          from induction_hypothesis ⟨C2,C2_closed⟩ C2_ssub_Y,
        let ⟨ι1, union_ι1_eq_C1, ι1_irr, ι1_closed⟩ := C1_factorises in
        let ⟨ι2, union_ι2_eq_C2, ι2_irr, ι2_closed⟩ := C2_factorises in
        ⟨-- the factorisation of Y is the union of factorisation of C1, C2.
          ι1 ∪ ι2, -- the factorisation
          calc ⋃₀ (↑(ι1 ∪ ι2) : set _)-- Proof of union of factorisations is Y
              = ⋃₀ ( (↑ι1 : set _) ∪ (↑ι2 : set _) ) : by simp
          ... = ⋃₀ ι1.to_set ∪ ⋃₀ ι2.to_set : sUnion_union _ _
          ... = C1 ∪ ⋃₀ finset.to_set ι2 : union_ι1_eq_C1.symm ▸ rfl
          ... = C1 ∪ C2 : union_ι2_eq_C2.symm ▸ rfl
          ... = Y.1 : Y_eq_C1_union_C2.symm,
          λ (Ci : set X) (Ci_in_ι1_union_ι2), -- Proof of "factors" irreducible
            or.elim (finset.mem_union.1 Ci_in_ι1_union_ι2)
            (λ Ci_in_ι1, ι1_irr Ci Ci_in_ι1)
            (λ Ci_in_ι2, ι2_irr Ci Ci_in_ι2),
          λ (Ci : set X) (Ci_in_ι1_union_ι2), -- Proof of "factors" closed
            or.elim (finset.mem_union.1 Ci_in_ι1_union_ι2)
            (λ Ci_in_ι1, ι1_closed Ci Ci_in_ι1)
            (λ Ci_in_ι2, ι2_closed Ci Ci_in_ι2)
        ⟩
      )
    )
end topological_space

/-

Hartshorne 1.5: in a Noetherian top space X, every nonempty closed subset Y
can be expressed as a finite union of irred closed subsets Y_i. If we
require that Y_i ¬⊆ Y_j for i ≠ j then the Y_i are uniquely determined.
They're called the irred cpts of Y.

-/

/-
Proof: existence: the set of non-empty closed subsets which can't be written
as a finite union of irreds is empty because it can't have a minimal
member.

Throwing away some Y_i we can assume i ≠ j → ¬ Y_i ⊆ Y_j.

Now say we have 2 reps . Then Z_1 ⊆ ∪ Y_j so Z_1 = ∪ (Z_1 ∩ Y_j), but
Z_1 is irred so Z_1 ⊆ Y_j for some j. Similarly Y_j ⊆ Z_k so k=1
and now replacing Y by the closure of Y - Z_1 we're done by induction on
the number of Z_i
-/

namespace topological_space

def closeds.compl {X : Type*} [topological_space X] : closeds X → opens X :=
λ C, ⟨-C.1, is_open_compl_iff.2 C.2⟩

def opens.compl {X : Type*} [topological_space X] : opens X → closeds X :=
λ C, ⟨-C.1, is_closed_compl_iff.2 C.2⟩

lemma continuous.subtype {X : Type*} [topological_space X] {Y : set X} :
  continuous (subtype.val : Y → X) := λ U hU, ⟨U, hU, rfl⟩

def closeds.comap {X : Type*} [topological_space X] (Y : set X) :
  closeds X → closeds Y :=
λ C, (continuous.subtype.comap (C.compl)).compl

lemma is_noetherian_subset (X : Type*) [topological_space X]
  (hX : is_noetherian X) (Y : set X) : is_noetherian Y :=
begin
  sorry
end

end topological_space

/-

Proposition 5.4. Let V be an affine algebraic set. Then:
(1) The union of the irreducible components of V is all of V .
(2) V has only finitely many irreducible components.

Lemma 5.5. Every affine algebraic set can be written as a union of finitely many
irreducible closed subsets.

Proposition 5.6. Let V be an affine algebraic set. Write V = V 1 ∪ · · · ∪ V r , where
the V i are irreducible closed subsets and ¬ V i ⊆ V j for ¬ i = j.
Then V 1 , . . . , V r are precisely the irreducible components of V .

-/


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module measure_theory.constructions.polish
! leanprover-community/mathlib commit bcfa726826abd57587355b4b5b7e78ad6527b7e4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.MetricSpace.Polish
import Mathbin.MeasureTheory.Constructions.BorelSpace

/-!
# The Borel sigma-algebra on Polish spaces

We discuss several results pertaining to the relationship between the topology and the Borel
structure on Polish spaces.

## Main definitions and results

First, we define the class of analytic sets and establish its basic properties.

* `measure_theory.analytic_set s`: a set in a topological space is analytic if it is the continuous
  image of a Polish space. Equivalently, it is empty, or the image of `ℕ → ℕ`.
* `measure_theory.analytic_set.image_of_continuous`: a continuous image of an analytic set is
  analytic.
* `measurable_set.analytic_set`: in a Polish space, any Borel-measurable set is analytic.

Then, we show Lusin's theorem that two disjoint analytic sets can be separated by Borel sets.

* `measurably_separable s t` states that there exists a measurable set containing `s` and disjoint
  from `t`.
* `analytic_set.measurably_separable` shows that two disjoint analytic sets are separated by a
  Borel set.

Finally, we prove the Lusin-Souslin theorem that a continuous injective image of a Borel subset of
a Polish space is Borel. The proof of this nontrivial result relies on the above results on
analytic sets.

* `measurable_set.image_of_continuous_on_inj_on` asserts that, if `s` is a Borel measurable set in
  a Polish space, then the image of `s` under a continuous injective map is still Borel measurable.
* `continuous.measurable_embedding` states that a continuous injective map on a Polish space
  is a measurable embedding for the Borel sigma-algebra.
* `continuous_on.measurable_embedding` is the same result for a map restricted to a measurable set
  on which it is continuous.
* `measurable.measurable_embedding` states that a measurable injective map from a Polish space
  to a second-countable topological space is a measurable embedding.
* `is_clopenable_iff_measurable_set`: in a Polish space, a set is clopenable (i.e., it can be made
  open and closed by using a finer Polish topology) if and only if it is Borel-measurable.
-/

open Set Function PolishSpace PiNat TopologicalSpace Metric Filter

open Topology MeasureTheory Filter

variable {α : Type _} [TopologicalSpace α] {ι : Type _}

namespace MeasureTheory

/-! ### Analytic sets -/

/-- An analytic set is a set which is the continuous image of some Polish space. There are several
equivalent characterizations of this definition. For the definition, we pick one that avoids
universe issues: a set is analytic if and only if it is a continuous image of `ℕ → ℕ` (or if it
is empty). The above more usual characterization is given
in `analytic_set_iff_exists_polish_space_range`.

Warning: these are analytic sets in the context of descriptive set theory (which is why they are
registered in the namespace `measure_theory`). They have nothing to do with analytic sets in the
context of complex analysis. -/
irreducible_def AnalyticSet (s : Set α) : Prop :=
  s = ∅ ∨ ∃ f : (ℕ → ℕ) → α, Continuous f ∧ range f = s
#align measure_theory.analytic_set MeasureTheory.AnalyticSet

theorem analyticSet_empty : AnalyticSet (∅ : Set α) :=
  by
  rw [analytic_set]
  exact Or.inl rfl
#align measure_theory.analytic_set_empty MeasureTheory.analyticSet_empty

theorem analyticSet_range_of_polishSpace {β : Type _} [TopologicalSpace β] [PolishSpace β]
    {f : β → α} (f_cont : Continuous f) : AnalyticSet (range f) :=
  by
  cases isEmpty_or_nonempty β
  · rw [range_eq_empty]
    exact analytic_set_empty
  · rw [analytic_set]
    obtain ⟨g, g_cont, hg⟩ : ∃ g : (ℕ → ℕ) → β, Continuous g ∧ surjective g :=
      exists_nat_nat_continuous_surjective β
    refine' Or.inr ⟨f ∘ g, f_cont.comp g_cont, _⟩
    rwa [hg.range_comp]
#align measure_theory.analytic_set_range_of_polish_space MeasureTheory.analyticSet_range_of_polishSpace

/-- The image of an open set under a continuous map is analytic. -/
theorem IsOpen.analyticSet_image {β : Type _} [TopologicalSpace β] [PolishSpace β] {s : Set β}
    (hs : IsOpen s) {f : β → α} (f_cont : Continuous f) : AnalyticSet (f '' s) :=
  by
  rw [image_eq_range]
  haveI : PolishSpace s := hs.polish_space
  exact analytic_set_range_of_polish_space (f_cont.comp continuous_subtype_val)
#align is_open.analytic_set_image IsOpen.analyticSet_image

/-- A set is analytic if and only if it is the continuous image of some Polish space. -/
theorem analyticSet_iff_exists_polishSpace_range {s : Set α} :
    AnalyticSet s ↔
      ∃ (β : Type)(h : TopologicalSpace β)(h' : @PolishSpace β h)(f : β → α),
        @Continuous _ _ h _ f ∧ range f = s :=
  by
  constructor
  · intro h
    rw [analytic_set] at h
    cases h
    · refine' ⟨Empty, by infer_instance, by infer_instance, Empty.elim, continuous_bot, _⟩
      rw [h]
      exact range_eq_empty _
    · exact ⟨ℕ → ℕ, by infer_instance, by infer_instance, h⟩
  · rintro ⟨β, h, h', f, f_cont, f_range⟩
    skip
    rw [← f_range]
    exact analytic_set_range_of_polish_space f_cont
#align measure_theory.analytic_set_iff_exists_polish_space_range MeasureTheory.analyticSet_iff_exists_polishSpace_range

/-- The continuous image of an analytic set is analytic -/
theorem AnalyticSet.image_of_continuousOn {β : Type _} [TopologicalSpace β] {s : Set α}
    (hs : AnalyticSet s) {f : α → β} (hf : ContinuousOn f s) : AnalyticSet (f '' s) :=
  by
  rcases analytic_set_iff_exists_polish_space_range.1 hs with ⟨γ, γtop, γpolish, g, g_cont, gs⟩
  skip
  have : f '' s = range (f ∘ g) := by rw [range_comp, gs]
  rw [this]
  apply analytic_set_range_of_polish_space
  apply hf.comp_continuous g_cont fun x => _
  rw [← gs]
  exact mem_range_self _
#align measure_theory.analytic_set.image_of_continuous_on MeasureTheory.AnalyticSet.image_of_continuousOn

theorem AnalyticSet.image_of_continuous {β : Type _} [TopologicalSpace β] {s : Set α}
    (hs : AnalyticSet s) {f : α → β} (hf : Continuous f) : AnalyticSet (f '' s) :=
  hs.image_of_continuousOn hf.ContinuousOn
#align measure_theory.analytic_set.image_of_continuous MeasureTheory.AnalyticSet.image_of_continuous

/-- A countable intersection of analytic sets is analytic. -/
theorem AnalyticSet.interᵢ [hι : Nonempty ι] [Countable ι] [T2Space α] {s : ι → Set α}
    (hs : ∀ n, AnalyticSet (s n)) : AnalyticSet (⋂ n, s n) :=
  by
  rcases hι with ⟨i₀⟩
  /- For the proof, write each `s n` as the continuous image under a map `f n` of a
    Polish space `β n`. The product space `γ = Π n, β n` is also Polish, and so is the subset
    `t` of sequences `x n` for which `f n (x n)` is independent of `n`. The set `t` is Polish, and the
    range of `x ↦ f 0 (x 0)` on `t` is exactly `⋂ n, s n`, so this set is analytic. -/
  choose β hβ h'β f f_cont f_range using fun n =>
    analytic_set_iff_exists_polish_space_range.1 (hs n)
  skip
  let γ := ∀ n, β n
  let t : Set γ := ⋂ n, { x | f n (x n) = f i₀ (x i₀) }
  have t_closed : IsClosed t := by
    apply isClosed_interᵢ
    intro n
    exact
      isClosed_eq ((f_cont n).comp (continuous_apply n)) ((f_cont i₀).comp (continuous_apply i₀))
  haveI : PolishSpace t := t_closed.polish_space
  let F : t → α := fun x => f i₀ ((x : γ) i₀)
  have F_cont : Continuous F := (f_cont i₀).comp ((continuous_apply i₀).comp continuous_subtype_val)
  have F_range : range F = ⋂ n : ι, s n :=
    by
    apply subset.antisymm
    · rintro y ⟨x, rfl⟩
      apply mem_Inter.2 fun n => _
      have : f n ((x : γ) n) = F x := (mem_Inter.1 x.2 n : _)
      rw [← this, ← f_range n]
      exact mem_range_self _
    · intro y hy
      have A : ∀ n, ∃ x : β n, f n x = y := by
        intro n
        rw [← mem_range, f_range n]
        exact mem_Inter.1 hy n
      choose x hx using A
      have xt : x ∈ t := by
        apply mem_Inter.2 fun n => _
        simp [hx]
      refine' ⟨⟨x, xt⟩, _⟩
      exact hx i₀
  rw [← F_range]
  exact analytic_set_range_of_polish_space F_cont
#align measure_theory.analytic_set.Inter MeasureTheory.AnalyticSet.interᵢ

/-- A countable union of analytic sets is analytic. -/
theorem AnalyticSet.unionᵢ [Countable ι] {s : ι → Set α} (hs : ∀ n, AnalyticSet (s n)) :
    AnalyticSet (⋃ n, s n) :=
  by
  /- For the proof, write each `s n` as the continuous image under a map `f n` of a
    Polish space `β n`. The union space `γ = Σ n, β n` is also Polish, and the map `F : γ → α` which
    coincides with `f n` on `β n` sends it to `⋃ n, s n`. -/
  choose β hβ h'β f f_cont f_range using fun n =>
    analytic_set_iff_exists_polish_space_range.1 (hs n)
  skip
  let γ := Σn, β n
  let F : γ → α := by
    rintro ⟨n, x⟩
    exact f n x
  have F_cont : Continuous F := continuous_sigma f_cont
  have F_range : range F = ⋃ n, s n :=
    by
    rw [range_sigma_eq_Union_range]
    congr
    ext1 n
    rw [← f_range n]
  rw [← F_range]
  exact analytic_set_range_of_polish_space F_cont
#align measure_theory.analytic_set.Union MeasureTheory.AnalyticSet.unionᵢ

theorem IsClosed.analyticSet [PolishSpace α] {s : Set α} (hs : IsClosed s) : AnalyticSet s :=
  by
  haveI : PolishSpace s := hs.polish_space
  rw [← @Subtype.range_val α s]
  exact analytic_set_range_of_polish_space continuous_subtype_val
#align is_closed.analytic_set IsClosed.analyticSet

/-- Given a Borel-measurable set in a Polish space, there exists a finer Polish topology making
it clopen. This is in fact an equivalence, see `is_clopenable_iff_measurable_set`. -/
theorem MeasurableSet.isClopenable [PolishSpace α] [MeasurableSpace α] [BorelSpace α] {s : Set α}
    (hs : MeasurableSet s) : IsClopenable s :=
  by
  revert s
  apply MeasurableSet.induction_on_open
  · exact fun u hu => hu.IsClopenable
  · exact fun u hu h'u => h'u.compl
  · exact fun f f_disj f_meas hf => is_clopenable.Union hf
#align measurable_set.is_clopenable MeasurableSet.isClopenable

theorem MeasurableSet.analyticSet {α : Type _} [t : TopologicalSpace α] [PolishSpace α]
    [MeasurableSpace α] [BorelSpace α] {s : Set α} (hs : MeasurableSet s) : AnalyticSet s :=
  by
  /- For a short proof (avoiding measurable induction), one sees `s` as a closed set for a finer
    topology `t'`. It is analytic for this topology. As the identity from `t'` to `t` is continuous
    and the image of an analytic set is analytic, it follows that `s` is also analytic for `t`. -/
  obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
    ∃ t' : TopologicalSpace α, t' ≤ t ∧ @PolishSpace α t' ∧ is_closed[t'] s ∧ is_open[t'] s :=
    hs.is_clopenable
  have A := @IsClosed.analyticSet α t' t'_polish s s_closed
  convert@analytic_set.image_of_continuous α t' α t s A id (continuous_id_of_le t't)
  simp only [id.def, image_id']
#align measurable_set.analytic_set MeasurableSet.analyticSet

/-- Given a Borel-measurable function from a Polish space to a second-countable space, there exists
a finer Polish topology on the source space for which the function is continuous. -/
theorem Measurable.exists_continuous {α β : Type _} [t : TopologicalSpace α] [PolishSpace α]
    [MeasurableSpace α] [BorelSpace α] [tβ : TopologicalSpace β] [SecondCountableTopology β]
    [MeasurableSpace β] [BorelSpace β] {f : α → β} (hf : Measurable f) :
    ∃ t' : TopologicalSpace α, t' ≤ t ∧ @Continuous α β t' tβ f ∧ @PolishSpace α t' :=
  by
  obtain ⟨b, b_count, -, hb⟩ : ∃ b : Set (Set β), b.Countable ∧ ∅ ∉ b ∧ is_topological_basis b :=
    exists_countable_basis β
  haveI : Encodable b := b_count.to_encodable
  have : ∀ s : b, is_clopenable (f ⁻¹' s) := by
    intro s
    apply MeasurableSet.isClopenable
    exact hf (hb.is_open s.2).MeasurableSet
  choose T Tt Tpolish Tclosed Topen using this
  obtain ⟨t', t'T, t't, t'_polish⟩ :
    ∃ t' : TopologicalSpace α, (∀ i, t' ≤ T i) ∧ t' ≤ t ∧ @PolishSpace α t' :=
    exists_polish_space_forall_le T Tt Tpolish
  refine' ⟨t', t't, _, t'_polish⟩
  apply hb.continuous _ fun s hs => _
  exact t'T ⟨s, hs⟩ _ (Topen ⟨s, hs⟩)
#align measurable.exists_continuous Measurable.exists_continuous

/-! ### Separating sets with measurable sets -/

/-- Two sets `u` and `v` in a measurable space are measurably separable if there
exists a measurable set containing `u` and disjoint from `v`.
This is mostly interesting for Borel-separable sets. -/
def MeasurablySeparable {α : Type _} [MeasurableSpace α] (s t : Set α) : Prop :=
  ∃ u, s ⊆ u ∧ Disjoint t u ∧ MeasurableSet u
#align measure_theory.measurably_separable MeasureTheory.MeasurablySeparable

theorem MeasurablySeparable.unionᵢ [Countable ι] {α : Type _} [MeasurableSpace α] {s t : ι → Set α}
    (h : ∀ m n, MeasurablySeparable (s m) (t n)) : MeasurablySeparable (⋃ n, s n) (⋃ m, t m) :=
  by
  choose u hsu htu hu using h
  refine' ⟨⋃ m, ⋂ n, u m n, _, _, _⟩
  · refine' Union_subset fun m => subset_Union_of_subset m _
    exact subset_Inter fun n => hsu m n
  · simp_rw [disjoint_Union_left, disjoint_Union_right]
    intro n m
    apply Disjoint.mono_right _ (htu m n)
    apply Inter_subset
  · refine' MeasurableSet.unionᵢ fun m => _
    exact MeasurableSet.interᵢ fun n => hu m n
#align measure_theory.measurably_separable.Union MeasureTheory.MeasurablySeparable.unionᵢ

/-- The hard part of the Lusin separation theorem saying that two disjoint analytic sets are
contained in disjoint Borel sets (see the full statement in `analytic_set.measurably_separable`).
Here, we prove this when our analytic sets are the ranges of functions from `ℕ → ℕ`.
-/
theorem measurablySeparable_range_of_disjoint [T2Space α] [MeasurableSpace α] [BorelSpace α]
    {f g : (ℕ → ℕ) → α} (hf : Continuous f) (hg : Continuous g) (h : Disjoint (range f) (range g)) :
    MeasurablySeparable (range f) (range g) :=
  by
  /- We follow [Kechris, *Classical Descriptive Set Theory* (Theorem 14.7)][kechris1995].
    If the ranges are not Borel-separated, then one can find two cylinders of length one whose images
    are not Borel-separated, and then two smaller cylinders of length two whose images are not
    Borel-separated, and so on. One thus gets two sequences of cylinders, that decrease to two
    points `x` and `y`. Their images are different by the disjointness assumption, hence contained
    in two disjoint open sets by the T2 property. By continuity, long enough cylinders around `x`
    and `y` have images which are separated by these two disjoint open sets, a contradiction.
    -/
  by_contra hfg
  have I :
    ∀ n x y,
      ¬measurably_separable (f '' cylinder x n) (g '' cylinder y n) →
        ∃ x' y',
          x' ∈ cylinder x n ∧
            y' ∈ cylinder y n ∧
              ¬measurably_separable (f '' cylinder x' (n + 1)) (g '' cylinder y' (n + 1)) :=
    by
    intro n x y
    contrapose!
    intro H
    rw [← Union_cylinder_update x n, ← Union_cylinder_update y n, image_Union, image_Union]
    refine' measurably_separable.Union fun i j => _
    exact H _ _ (update_mem_cylinder _ _ _) (update_mem_cylinder _ _ _)
  -- consider the set of pairs of cylinders of some length whose images are not Borel-separated
  let A :=
    { p : ℕ × (ℕ → ℕ) × (ℕ → ℕ) //
      ¬measurably_separable (f '' cylinder p.2.1 p.1) (g '' cylinder p.2.2 p.1) }
  -- for each such pair, one can find longer cylinders whose images are not Borel-separated either
  have :
    ∀ p : A,
      ∃ q : A,
        q.1.1 = p.1.1 + 1 ∧ q.1.2.1 ∈ cylinder p.1.2.1 p.1.1 ∧ q.1.2.2 ∈ cylinder p.1.2.2 p.1.1 :=
    by
    rintro ⟨⟨n, x, y⟩, hp⟩
    rcases I n x y hp with ⟨x', y', hx', hy', h'⟩
    exact ⟨⟨⟨n + 1, x', y'⟩, h'⟩, rfl, hx', hy'⟩
  choose F hFn hFx hFy using this
  let p0 : A := ⟨⟨0, fun n => 0, fun n => 0⟩, by simp [hfg]⟩
  -- construct inductively decreasing sequences of cylinders whose images are not separated
  let p : ℕ → A := fun n => (F^[n]) p0
  have prec : ∀ n, p (n + 1) = F (p n) := fun n => by simp only [p, iterate_succ']
  -- check that at the `n`-th step we deal with cylinders of length `n`
  have pn_fst : ∀ n, (p n).1.1 = n := by
    intro n
    induction' n with n IH
    · rfl
    · simp only [prec, hFn, IH]
  -- check that the cylinders we construct are indeed decreasing, by checking that the coordinates
  -- are stationary.
  have Ix : ∀ m n, m + 1 ≤ n → (p n).1.2.1 m = (p (m + 1)).1.2.1 m :=
    by
    intro m
    apply Nat.le_induction
    · rfl
    intro n hmn IH
    have I : (F (p n)).val.snd.fst m = (p n).val.snd.fst m :=
      by
      apply hFx (p n) m
      rw [pn_fst]
      exact hmn
    rw [prec, I, IH]
  have Iy : ∀ m n, m + 1 ≤ n → (p n).1.2.2 m = (p (m + 1)).1.2.2 m :=
    by
    intro m
    apply Nat.le_induction
    · rfl
    intro n hmn IH
    have I : (F (p n)).val.snd.snd m = (p n).val.snd.snd m :=
      by
      apply hFy (p n) m
      rw [pn_fst]
      exact hmn
    rw [prec, I, IH]
  -- denote by `x` and `y` the limit points of these two sequences of cylinders.
  set x : ℕ → ℕ := fun n => (p (n + 1)).1.2.1 n with hx
  set y : ℕ → ℕ := fun n => (p (n + 1)).1.2.2 n with hy
  -- by design, the cylinders around these points have images which are not Borel-separable.
  have M : ∀ n, ¬measurably_separable (f '' cylinder x n) (g '' cylinder y n) :=
    by
    intro n
    convert(p n).2 using 3
    · rw [pn_fst, ← mem_cylinder_iff_eq, mem_cylinder_iff]
      intro i hi
      rw [hx]
      exact (Ix i n hi).symm
    · rw [pn_fst, ← mem_cylinder_iff_eq, mem_cylinder_iff]
      intro i hi
      rw [hy]
      exact (Iy i n hi).symm
  -- consider two open sets separating `f x` and `g y`.
  obtain ⟨u, v, u_open, v_open, xu, yv, huv⟩ :
    ∃ u v : Set α, IsOpen u ∧ IsOpen v ∧ f x ∈ u ∧ g y ∈ v ∧ Disjoint u v :=
    by
    apply t2_separation
    exact disjoint_iff_forall_ne.1 h _ (mem_range_self _) _ (mem_range_self _)
  letI : MetricSpace (ℕ → ℕ) := metric_space_nat_nat
  obtain ⟨εx, εxpos, hεx⟩ : ∃ (εx : ℝ)(H : εx > 0), Metric.ball x εx ⊆ f ⁻¹' u :=
    by
    apply Metric.mem_nhds_iff.1
    exact hf.continuous_at.preimage_mem_nhds (u_open.mem_nhds xu)
  obtain ⟨εy, εypos, hεy⟩ : ∃ (εy : ℝ)(H : εy > 0), Metric.ball y εy ⊆ g ⁻¹' v :=
    by
    apply Metric.mem_nhds_iff.1
    exact hg.continuous_at.preimage_mem_nhds (v_open.mem_nhds yv)
  obtain ⟨n, hn⟩ : ∃ n : ℕ, (1 / 2 : ℝ) ^ n < min εx εy :=
    exists_pow_lt_of_lt_one (lt_min εxpos εypos) (by norm_num)
  -- for large enough `n`, these open sets separate the images of long cylinders around `x` and `y`
  have B : measurably_separable (f '' cylinder x n) (g '' cylinder y n) :=
    by
    refine' ⟨u, _, _, u_open.measurable_set⟩
    · rw [image_subset_iff]
      apply subset.trans _ hεx
      intro z hz
      rw [mem_cylinder_iff_dist_le] at hz
      exact hz.trans_lt (hn.trans_le (min_le_left _ _))
    · refine' Disjoint.mono_left _ huv.symm
      change g '' cylinder y n ⊆ v
      rw [image_subset_iff]
      apply subset.trans _ hεy
      intro z hz
      rw [mem_cylinder_iff_dist_le] at hz
      exact hz.trans_lt (hn.trans_le (min_le_right _ _))
  -- this is a contradiction.
  exact M n B
#align measure_theory.measurably_separable_range_of_disjoint MeasureTheory.measurablySeparable_range_of_disjoint

/-- The Lusin separation theorem: if two analytic sets are disjoint, then they are contained in
disjoint Borel sets. -/
theorem AnalyticSet.measurablySeparable [T2Space α] [MeasurableSpace α] [BorelSpace α] {s t : Set α}
    (hs : AnalyticSet s) (ht : AnalyticSet t) (h : Disjoint s t) : MeasurablySeparable s t :=
  by
  rw [analytic_set] at hs ht
  rcases hs with (rfl | ⟨f, f_cont, rfl⟩)
  · refine' ⟨∅, subset.refl _, by simp, MeasurableSet.empty⟩
  rcases ht with (rfl | ⟨g, g_cont, rfl⟩)
  · exact ⟨univ, subset_univ _, by simp, MeasurableSet.univ⟩
  exact measurably_separable_range_of_disjoint f_cont g_cont h
#align measure_theory.analytic_set.measurably_separable MeasureTheory.AnalyticSet.measurablySeparable

/-! ### Injective images of Borel sets -/

variable {γ : Type _} [tγ : TopologicalSpace γ] [PolishSpace γ]

include tγ

/-- The Lusin-Souslin theorem: the range of a continuous injective function defined on a Polish
space is Borel-measurable. -/
theorem measurableSet_range_of_continuous_injective {β : Type _} [TopologicalSpace β] [T2Space β]
    [MeasurableSpace β] [BorelSpace β] {f : γ → β} (f_cont : Continuous f) (f_inj : Injective f) :
    MeasurableSet (range f) :=
  by
  /- We follow [Fremlin, *Measure Theory* (volume 4, 423I)][fremlin_vol4].
    Let `b = {s i}` be a countable basis for `α`. When `s i` and `s j` are disjoint, their images are
    disjoint analytic sets, hence by the separation theorem one can find a Borel-measurable set
    `q i j` separating them.
    Let `E i = closure (f '' s i) ∩ ⋂ j, q i j \ q j i`. It contains `f '' (s i)` and it is
    measurable. Let `F n = ⋃ E i`, where the union is taken over those `i` for which `diam (s i)`
    is bounded by some number `u n` tending to `0` with `n`.
    We claim that `range f = ⋂ F n`, from which the measurability is obvious. The inclusion `⊆` is
    straightforward. To show `⊇`, consider a point `x` in the intersection. For each `n`, it belongs
    to some `E i` with `diam (s i) ≤ u n`. Pick a point `y i ∈ s i`. We claim that for such `i`
    and `j`, the intersection `s i ∩ s j` is nonempty: if it were empty, then thanks to the
    separating set `q i j` in the definition of `E i` one could not have `x ∈ E i ∩ E j`.
    Since these two sets have small diameter, it follows that `y i` and `y j` are close.
    Thus, `y` is a Cauchy sequence, converging to a limit `z`. We claim that `f z = x`, completing
    the proof.
    Otherwise, one could find open sets `v` and `w` separating `f z` from `x`. Then, for large `n`,
    the image `f '' (s i)` would be included in `v` by continuity of `f`, so its closure would be
    contained in the closure of `v`, and therefore it would be disjoint from `w`. This is a
    contradiction since `x` belongs both to this closure and to `w`. -/
  letI := upgradePolishSpace γ
  obtain ⟨b, b_count, b_nonempty, hb⟩ :
    ∃ b : Set (Set γ), b.Countable ∧ ∅ ∉ b ∧ is_topological_basis b := exists_countable_basis γ
  haveI : Encodable b := b_count.to_encodable
  let A := { p : b × b // Disjoint (p.1 : Set γ) p.2 }
  -- for each pair of disjoint sets in the topological basis `b`, consider Borel sets separating
  -- their images, by injectivity of `f` and the Lusin separation theorem.
  have :
    ∀ p : A,
      ∃ q : Set β, f '' (p.1.1 : Set γ) ⊆ q ∧ Disjoint (f '' (p.1.2 : Set γ)) q ∧ MeasurableSet q :=
    by
    intro p
    apply
      analytic_set.measurably_separable ((hb.is_open p.1.1.2).analyticSet_image f_cont)
        ((hb.is_open p.1.2.2).analyticSet_image f_cont)
    exact Disjoint.image p.2 (f_inj.inj_on univ) (subset_univ _) (subset_univ _)
  choose q hq1 hq2 q_meas using this
  -- define sets `E i` and `F n` as in the proof sketch above
  let E : b → Set β := fun s =>
    closure (f '' s) ∩ ⋂ (t : b) (ht : Disjoint s.1 t.1), q ⟨(s, t), ht⟩ \ q ⟨(t, s), ht.symm⟩
  obtain ⟨u, u_anti, u_pos, u_lim⟩ :
    ∃ u : ℕ → ℝ, StrictAnti u ∧ (∀ n : ℕ, 0 < u n) ∧ tendsto u at_top (𝓝 0) :=
    exists_seq_strictAnti_tendsto (0 : ℝ)
  let F : ℕ → Set β := fun n => ⋃ (s : b) (hs : bounded s.1 ∧ diam s.1 ≤ u n), E s
  -- it is enough to show that `range f = ⋂ F n`, as the latter set is obviously measurable.
  suffices range f = ⋂ n, F n
    by
    have E_meas : ∀ s : b, MeasurableSet (E s) :=
      by
      intro b
      refine' is_closed_closure.measurable_set.inter _
      refine' MeasurableSet.interᵢ fun s => _
      exact MeasurableSet.interᵢ fun hs => (q_meas _).diffₓ (q_meas _)
    have F_meas : ∀ n, MeasurableSet (F n) := by
      intro n
      refine' MeasurableSet.unionᵢ fun s => _
      exact MeasurableSet.unionᵢ fun hs => E_meas _
    rw [this]
    exact MeasurableSet.interᵢ fun n => F_meas n
  -- we check both inclusions.
  apply subset.antisymm
  -- we start with the easy inclusion `range f ⊆ ⋂ F n`. One just needs to unfold the definitions.
  · rintro x ⟨y, rfl⟩
    apply mem_Inter.2 fun n => _
    obtain ⟨s, sb, ys, hs⟩ : ∃ (s : Set γ)(H : s ∈ b), y ∈ s ∧ s ⊆ ball y (u n / 2) :=
      by
      apply hb.mem_nhds_iff.1
      exact ball_mem_nhds _ (half_pos (u_pos n))
    have diam_s : diam s ≤ u n :=
      by
      apply (diam_mono hs bounded_ball).trans
      convert diam_ball (half_pos (u_pos n)).le
      ring
    refine' mem_Union.2 ⟨⟨s, sb⟩, _⟩
    refine' mem_Union.2 ⟨⟨Metric.Bounded.mono hs bounded_ball, diam_s⟩, _⟩
    apply mem_inter (subset_closure (mem_image_of_mem _ ys))
    refine' mem_Inter.2 fun t => mem_Inter.2 fun ht => ⟨_, _⟩
    · apply hq1
      exact mem_image_of_mem _ ys
    · apply disjoint_left.1 (hq2 ⟨(t, ⟨s, sb⟩), ht.symm⟩)
      exact mem_image_of_mem _ ys
  -- Now, let us prove the harder inclusion `⋂ F n ⊆ range f`.
  · intro x hx
    -- pick for each `n` a good set `s n` of small diameter for which `x ∈ E (s n)`.
    have C1 : ∀ n, ∃ (s : b)(hs : bounded s.1 ∧ diam s.1 ≤ u n), x ∈ E s := fun n => by
      simpa only [mem_Union] using mem_Inter.1 hx n
    choose s hs hxs using C1
    have C2 : ∀ n, (s n).1.Nonempty := by
      intro n
      rw [nonempty_iff_ne_empty]
      intro hn
      have := (s n).2
      rw [hn] at this
      exact b_nonempty this
    -- choose a point `y n ∈ s n`.
    choose y hy using C2
    have I : ∀ m n, ((s m).1 ∩ (s n).1).Nonempty :=
      by
      intro m n
      rw [← not_disjoint_iff_nonempty_inter]
      by_contra' h
      have A : x ∈ q ⟨(s m, s n), h⟩ \ q ⟨(s n, s m), h.symm⟩ :=
        haveI := mem_Inter.1 (hxs m).2 (s n)
        (mem_Inter.1 this h : _)
      have B : x ∈ q ⟨(s n, s m), h.symm⟩ \ q ⟨(s m, s n), h⟩ :=
        haveI := mem_Inter.1 (hxs n).2 (s m)
        (mem_Inter.1 this h.symm : _)
      exact A.2 B.1
    -- the points `y n` are nearby, and therefore they form a Cauchy sequence.
    have cauchy_y : CauchySeq y :=
      by
      have : tendsto (fun n => 2 * u n) at_top (𝓝 0) := by
        simpa only [MulZeroClass.mul_zero] using u_lim.const_mul 2
      apply cauchySeq_of_le_tendsto_0' (fun n => 2 * u n) (fun m n hmn => _) this
      rcases I m n with ⟨z, zsm, zsn⟩
      calc
        dist (y m) (y n) ≤ dist (y m) z + dist z (y n) := dist_triangle _ _ _
        _ ≤ u m + u n :=
          (add_le_add ((dist_le_diam_of_mem (hs m).1 (hy m) zsm).trans (hs m).2)
            ((dist_le_diam_of_mem (hs n).1 zsn (hy n)).trans (hs n).2))
        _ ≤ 2 * u m := by linarith [u_anti.antitone hmn]

    haveI : Nonempty γ := ⟨y 0⟩
    -- let `z` be its limit.
    let z := limUnder at_top y
    have y_lim : tendsto y at_top (𝓝 z) := cauchy_y.tendsto_lim
    suffices f z = x by
      rw [← this]
      exact mem_range_self _
    -- assume for a contradiction that `f z ≠ x`.
    by_contra' hne
    -- introduce disjoint open sets `v` and `w` separating `f z` from `x`.
    obtain ⟨v, w, v_open, w_open, fzv, xw, hvw⟩ := t2_separation hne
    obtain ⟨δ, δpos, hδ⟩ : ∃ δ > (0 : ℝ), ball z δ ⊆ f ⁻¹' v :=
      by
      apply Metric.mem_nhds_iff.1
      exact f_cont.continuous_at.preimage_mem_nhds (v_open.mem_nhds fzv)
    obtain ⟨n, hn⟩ : ∃ n, u n + dist (y n) z < δ :=
      haveI : tendsto (fun n => u n + dist (y n) z) at_top (𝓝 0) := by
        simpa only [add_zero] using u_lim.add (tendsto_iff_dist_tendsto_zero.1 y_lim)
      ((tendsto_order.1 this).2 _ δpos).exists
    -- for large enough `n`, the image of `s n` is contained in `v`, by continuity of `f`.
    have fsnv : f '' s n ⊆ v := by
      rw [image_subset_iff]
      apply subset.trans _ hδ
      intro a ha
      calc
        dist a z ≤ dist a (y n) + dist (y n) z := dist_triangle _ _ _
        _ ≤ u n + dist (y n) z :=
          (add_le_add_right ((dist_le_diam_of_mem (hs n).1 ha (hy n)).trans (hs n).2) _)
        _ < δ := hn

    -- as `x` belongs to the closure of `f '' (s n)`, it belongs to the closure of `v`.
    have : x ∈ closure v := closure_mono fsnv (hxs n).1
    -- this is a contradiction, as `x` is supposed to belong to `w`, which is disjoint from
    -- the closure of `v`.
    exact disjoint_left.1 (hvw.closure_left w_open) this xw
#align measure_theory.measurable_set_range_of_continuous_injective MeasureTheory.measurableSet_range_of_continuous_injective

theorem IsClosed.measurableSet_image_of_continuousOn_injOn {β : Type _} [TopologicalSpace β]
    [T2Space β] [MeasurableSpace β] [BorelSpace β] {s : Set γ} (hs : IsClosed s) {f : γ → β}
    (f_cont : ContinuousOn f s) (f_inj : InjOn f s) : MeasurableSet (f '' s) :=
  by
  rw [image_eq_range]
  haveI : PolishSpace s := IsClosed.polishSpace hs
  apply measurable_set_range_of_continuous_injective
  · rwa [continuousOn_iff_continuous_restrict] at f_cont
  · rwa [inj_on_iff_injective] at f_inj
#align is_closed.measurable_set_image_of_continuous_on_inj_on IsClosed.measurableSet_image_of_continuousOn_injOn

variable [MeasurableSpace γ] [hγb : BorelSpace γ] {β : Type _} [tβ : TopologicalSpace β] [T2Space β]
  [MeasurableSpace β] [BorelSpace β] {s : Set γ} {f : γ → β}

include tβ hγb

/-- The Lusin-Souslin theorem: if `s` is Borel-measurable in a Polish space, then its image under
a continuous injective map is also Borel-measurable. -/
theorem MeasurableSet.image_of_continuousOn_injOn (hs : MeasurableSet s) (f_cont : ContinuousOn f s)
    (f_inj : InjOn f s) : MeasurableSet (f '' s) :=
  by
  obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
    ∃ t' : TopologicalSpace γ, t' ≤ tγ ∧ @PolishSpace γ t' ∧ is_closed[t'] s ∧ is_open[t'] s :=
    hs.is_clopenable
  exact
    @IsClosed.measurableSet_image_of_continuousOn_injOn γ t' t'_polish β _ _ _ _ s s_closed f
      (f_cont.mono_dom t't) f_inj
#align measurable_set.image_of_continuous_on_inj_on MeasurableSet.image_of_continuousOn_injOn

/-- The Lusin-Souslin theorem: if `s` is Borel-measurable in a Polish space, then its image under
a measurable injective map taking values in a second-countable topological space
is also Borel-measurable. -/
theorem MeasurableSet.image_of_measurable_injOn [SecondCountableTopology β] (hs : MeasurableSet s)
    (f_meas : Measurable f) (f_inj : InjOn f s) : MeasurableSet (f '' s) :=
  by
  -- for a finer Polish topology, `f` is continuous. Therefore, one may apply the corresponding
  -- result for continuous maps.
  obtain ⟨t', t't, f_cont, t'_polish⟩ :
    ∃ t' : TopologicalSpace γ, t' ≤ tγ ∧ @Continuous γ β t' tβ f ∧ @PolishSpace γ t' :=
    f_meas.exists_continuous
  have M : measurable_set[@borel γ t'] s :=
    @Continuous.measurable γ γ t' (@borel γ t')
      (@BorelSpace.opens_measurable γ t' (@borel γ t')
        (by
          constructor
          rfl))
      tγ _ _ _ (continuous_id_of_le t't) s hs
  exact
    @MeasurableSet.image_of_continuousOn_injOn γ t' t'_polish (@borel γ t')
      (by
        constructor
        rfl)
      β _ _ _ _ s f M (@Continuous.continuousOn γ β t' tβ f s f_cont) f_inj
#align measurable_set.image_of_measurable_inj_on MeasurableSet.image_of_measurable_injOn

/-- An injective continuous function on a Polish space is a measurable embedding. -/
theorem Continuous.measurableEmbedding (f_cont : Continuous f) (f_inj : Injective f) :
    MeasurableEmbedding f :=
  { Injective := f_inj
    Measurable := f_cont.Measurable
    measurableSet_image' := fun u hu =>
      hu.image_of_continuousOn_injOn f_cont.ContinuousOn (f_inj.InjOn _) }
#align continuous.measurable_embedding Continuous.measurableEmbedding

/-- If `s` is Borel-measurable in a Polish space and `f` is continuous injective on `s`, then
the restriction of `f` to `s` is a measurable embedding. -/
theorem ContinuousOn.measurableEmbedding (hs : MeasurableSet s) (f_cont : ContinuousOn f s)
    (f_inj : InjOn f s) : MeasurableEmbedding (s.restrict f) :=
  { Injective := injOn_iff_injective.1 f_inj
    Measurable := (continuousOn_iff_continuous_restrict.1 f_cont).Measurable
    measurableSet_image' := by
      intro u hu
      have A : MeasurableSet ((coe : s → γ) '' u) :=
        (MeasurableEmbedding.subtype_coe hs).measurableSet_image.2 hu
      have B : MeasurableSet (f '' ((coe : s → γ) '' u)) :=
        A.image_of_continuous_on_inj_on (f_cont.mono (Subtype.coe_image_subset s u))
          (f_inj.mono (Subtype.coe_image_subset s u))
      rwa [← image_comp] at B }
#align continuous_on.measurable_embedding ContinuousOn.measurableEmbedding

/-- An injective measurable function from a Polish space to a second-countable topological space
is a measurable embedding. -/
theorem Measurable.measurableEmbedding [SecondCountableTopology β] (f_meas : Measurable f)
    (f_inj : Injective f) : MeasurableEmbedding f :=
  { Injective := f_inj
    Measurable := f_meas
    measurableSet_image' := fun u hu => hu.image_of_measurable_injOn f_meas (f_inj.InjOn _) }
#align measurable.measurable_embedding Measurable.measurableEmbedding

omit tβ

/-- In a Polish space, a set is clopenable if and only if it is Borel-measurable. -/
theorem isClopenable_iff_measurableSet : IsClopenable s ↔ MeasurableSet s :=
  by
  -- we already know that a measurable set is clopenable. Conversely, assume that `s` is clopenable.
  refine' ⟨fun hs => _, fun hs => hs.IsClopenable⟩
  -- consider a finer topology `t'` in which `s` is open and closed.
  obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
    ∃ t' : TopologicalSpace γ, t' ≤ tγ ∧ @PolishSpace γ t' ∧ is_closed[t'] s ∧ is_open[t'] s := hs
  -- the identity is continuous from `t'` to `tγ`.
  have C : @Continuous γ γ t' tγ id := continuous_id_of_le t't
  -- therefore, it is also a measurable embedding, by the Lusin-Souslin theorem
  have E :=
    @Continuous.measurableEmbedding γ t' t'_polish (@borel γ t')
      (by
        constructor
        rfl)
      γ tγ (PolishSpace.t2Space γ) _ _ id C injective_id
  -- the set `s` is measurable for `t'` as it is closed.
  have M : @MeasurableSet γ (@borel γ t') s :=
    @IsClosed.measurableSet γ s t' (@borel γ t')
      (@BorelSpace.opens_measurable γ t' (@borel γ t')
        (by
          constructor
          rfl))
      s_closed
  -- therefore, its image under the measurable embedding `id` is also measurable for `tγ`.
  convert E.measurable_set_image.2 M
  simp only [id.def, image_id']
#align measure_theory.is_clopenable_iff_measurable_set MeasureTheory.isClopenable_iff_measurableSet

omit hγb

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- The set of points for which a measurable sequence of functions converges is measurable. -/
@[measurability]
theorem measurableSet_exists_tendsto [hγ : OpensMeasurableSpace γ] [Countable ι] {l : Filter ι}
    [l.IsCountablyGenerated] {f : ι → β → γ} (hf : ∀ i, Measurable (f i)) :
    MeasurableSet { x | ∃ c, Tendsto (fun n => f n x) l (𝓝 c) } :=
  by
  by_cases hl : l.ne_bot
  swap;
  · rw [not_ne_bot] at hl
    simp [hl]
  letI := upgradePolishSpace γ
  rcases l.exists_antitone_basis with ⟨u, hu⟩
  simp_rw [← cauchy_map_iff_exists_tendsto]
  change MeasurableSet { x | _ ∧ _ }
  have :
    ∀ x,
      (map (fun i => f i x) l ×ᶠ map (fun i => f i x) l).HasAntitoneBasis fun n =>
        ((fun i => f i x) '' u n) ×ˢ ((fun i => f i x) '' u n) :=
    fun x => hu.map.prod hu.map
  simp_rw [and_iff_right (hl.map _),
    Filter.HasBasis.le_basis_iff (this _).to_hasBasis Metric.uniformity_basis_dist_inv_nat_succ,
    Set.setOf_forall]
  refine' MeasurableSet.binterᵢ Set.countable_univ fun K _ => _
  simp_rw [Set.setOf_exists]
  refine' MeasurableSet.bunionᵢ Set.countable_univ fun N hN => _
  simp_rw [prod_image_image_eq, image_subset_iff, prod_subset_iff, Set.setOf_forall]
  exact
    MeasurableSet.binterᵢ (to_countable (u N)) fun i _ =>
      MeasurableSet.binterᵢ (to_countable (u N)) fun j _ =>
        measurableSet_lt (Measurable.dist (hf i) (hf j)) measurable_const
#align measure_theory.measurable_set_exists_tendsto MeasureTheory.measurableSet_exists_tendsto

end MeasureTheory


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.cast
import algebra.char_zero

/-!
# Injectivity of `int.cast` into characteristic zero rings.

-/

variables {α : Type*}

open nat

namespace int

@[simp]
theorem cast_eq_zero [add_group α] [has_one α] [char_zero α] {n : ℤ} : (n : α) = 0 ↔ n = 0 :=
⟨λ h, begin cases n,
  { exact congr_arg coe (nat.cast_eq_zero.1 h) },
  { rw [cast_neg_succ_of_nat, neg_eq_zero, ← cast_succ, nat.cast_eq_zero] at h,
    contradiction }
end, λ h, by rw [h, cast_zero]⟩

@[simp, norm_cast] theorem cast_inj [add_group α] [has_one α] [char_zero α] {m n : ℤ} :
  (m : α) = n ↔ m = n :=
by rw [← sub_eq_zero, ← cast_sub, cast_eq_zero, sub_eq_zero]

theorem cast_injective [add_group α] [has_one α] [char_zero α] : function.injective (coe : ℤ → α)
| m n := cast_inj.1

theorem cast_ne_zero [add_group α] [has_one α] [char_zero α] {n : ℤ} : (n : α) ≠ 0 ↔ n ≠ 0 :=
not_congr cast_eq_zero

end int

lemma ring_hom.injective_int {α : Type*} [ring α] (f : ℤ →+* α) [char_zero α] :
  function.injective f :=
subsingleton.elim (int.cast_ring_hom _) f ▸ int.cast_injective