/-
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.limits.shapes.types
! 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.Limits.Types
import Mathlib.CategoryTheory.Limits.Shapes.Products
import Mathlib.CategoryTheory.Limits.Shapes.BinaryProducts
import Mathlib.CategoryTheory.Limits.Shapes.Terminal
import Mathlib.CategoryTheory.ConcreteCategory.Basic
import Mathlib.Tactic.Elementwise

/-!
# Special shapes for limits in `Type`.

The general shape (co)limits defined in `CategoryTheory.Limits.Types`
are intended for use through the limits API,
and the actual implementation should mostly be considered "sealed".

In this file, we provide definitions of the "standard" special shapes of limits in `Type`,
giving the expected definitional implementation:
* the terminal object is `PUnit`
* the binary product of `X` and `Y` is `X × Y`
* the product of a family `f : J → Type` is `Π j, f j`
* the coproduct of a family `f : J → Type` is `Σ j, f j`
* the binary coproduct of `X` and `Y` is the sum type `X ⊕ Y`
* the equalizer of a pair of maps `(g, h)` is the subtype `{x : Y // g x = h x}`
* the coequalizer of a pair of maps `(f, g)` is the quotient of `Y` by `∀ x : Y, f x ~ g x`
* the pullback of `f : X ⟶ Z` and `g : Y ⟶ Z` is the subtype `{ p : X × Y // f p.1 = g p.2 }`
  of the product

We first construct terms of `IsLimit` and `LimitCone`, and then provide isomorphisms with the
types generated by the `HasLimit` API.

As an example, when setting up the monoidal category structure on `Type`
we use the `types_has_terminal` and `types_has_binary_products` instances.
-/

universe u v

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory.Limits.Types

-- attribute [local tidy] tactic.discrete_cases -- Porting note: no local, tidy or discrete_cases

/-- A restatement of `Types.Limit.lift_π_apply` that uses `Pi.π` and `Pi.lift`. -/
@[simp 1001]
theorem pi_lift_π_apply {β : Type u} (f : β → Type u) {P : Type u} (s : ∀ b, P ⟶ f b) (b : β)
    (x : P) : (Pi.π f b : (∏ f) → f b) (@Pi.lift β _ _ f _ P s x) = s b x :=
  congr_fun (limit.lift_π (Fan.mk P s) ⟨b⟩) x
#align category_theory.limits.types.pi_lift_π_apply CategoryTheory.Limits.Types.pi_lift_π_apply

/-- A restatement of `Types.Limit.map_π_apply` that uses `Pi.π` and `Pi.map`. -/
@[simp 1001]
theorem pi_map_π_apply {β : Type u} {f g : β → Type u} (α : ∀ j, f j ⟶ g j) (b : β) (x) :
    (Pi.π g b : (∏ g) → g b) (Pi.map α x) = α b ((Pi.π f b : (∏ f) → f b) x) :=
  Limit.map_π_apply' _ _ _
#align category_theory.limits.types.pi_map_π_apply CategoryTheory.Limits.Types.pi_map_π_apply

/-- The category of types has `PUnit` as a terminal object. -/
def terminalLimitCone : Limits.LimitCone (Functor.empty (Type u)) where
  -- porting note: tidy was able to fill the structure automatically
  cone :=
    { pt := PUnit
      π := (Functor.uniqueFromEmpty _).hom }
  isLimit :=
    { lift := fun _ _ => PUnit.unit
      fac := fun _ => by rintro ⟨⟨⟩⟩
      uniq := fun _ _ _ => by
        funext
        apply Subsingleton.elim }
#align category_theory.limits.types.terminal_limit_cone CategoryTheory.Limits.Types.terminalLimitCone

/-- The terminal object in `Type u` is `PUnit`. -/
noncomputable def terminalIso : ⊤_ Type u ≅ PUnit :=
  limit.isoLimitCone terminalLimitCone.{u, 0}
#align category_theory.limits.types.terminal_iso CategoryTheory.Limits.Types.terminalIso

/-- The terminal object in `Type u` is `PUnit`. -/
noncomputable def isTerminalPunit : IsTerminal (PUnit : Type u) :=
  terminalIsTerminal.ofIso terminalIso
#align category_theory.limits.types.is_terminal_punit CategoryTheory.Limits.Types.isTerminalPunit

/-- The category of types has `PEmpty` as an initial object. -/
def initialColimitCocone : Limits.ColimitCocone (Functor.empty (Type u)) where
  -- porting note: tidy was able to fill the structure automatically
  cocone :=
    { pt := PEmpty
      ι := (Functor.uniqueFromEmpty _).inv }
  isColimit :=
    { desc := fun _ => by rintro ⟨⟩
      fac := fun _ => by rintro ⟨⟨⟩⟩
      uniq := fun _ _ _ => by funext x; cases x }
#align category_theory.limits.types.initial_colimit_cocone CategoryTheory.Limits.Types.initialColimitCocone

/-- The initial object in `Type u` is `PEmpty`. -/
noncomputable def initialIso : ⊥_ Type u ≅ PEmpty :=
  colimit.isoColimitCocone initialColimitCocone.{u, 0}
#align category_theory.limits.types.initial_iso CategoryTheory.Limits.Types.initialIso

/-- The initial object in `Type u` is `PEmpty`. -/
noncomputable def isInitialPunit : IsInitial (PEmpty : Type u) :=
  initialIsInitial.ofIso initialIso
#align category_theory.limits.types.is_initial_punit CategoryTheory.Limits.Types.isInitialPunit

open CategoryTheory.Limits.WalkingPair

-- We manually generate the other projection lemmas since the simp-normal form for the legs is
-- otherwise not created correctly.
/-- The product type `X × Y` forms a cone for the binary product of `X` and `Y`. -/
@[simps! pt]
def binaryProductCone (X Y : Type u) : BinaryFan X Y :=
  BinaryFan.mk _root_.Prod.fst _root_.Prod.snd
#align category_theory.limits.types.binary_product_cone CategoryTheory.Limits.Types.binaryProductCone

@[simp]
theorem binaryProductCone_fst (X Y : Type u) : (binaryProductCone X Y).fst = _root_.Prod.fst :=
  rfl
#align category_theory.limits.types.binary_product_cone_fst CategoryTheory.Limits.Types.binaryProductCone_fst

@[simp]
theorem binaryProductCone_snd (X Y : Type u) : (binaryProductCone X Y).snd = _root_.Prod.snd :=
  rfl
#align category_theory.limits.types.binary_product_cone_snd CategoryTheory.Limits.Types.binaryProductCone_snd

/-- The product type `X × Y` is a binary product for `X` and `Y`. -/
@[simps]
def binaryProductLimit (X Y : Type u) : IsLimit (binaryProductCone X Y) where
  lift (s : BinaryFan X Y) x := (s.fst x, s.snd x)
  fac _ j := Discrete.recOn j fun j => WalkingPair.casesOn j rfl rfl
  uniq _ _ w := funext fun x => Prod.ext (congr_fun (w ⟨left⟩) x) (congr_fun (w ⟨right⟩) x)
#align category_theory.limits.types.binary_product_limit CategoryTheory.Limits.Types.binaryProductLimit

/-- The category of types has `X × Y`, the usual cartesian product,
as the binary product of `X` and `Y`.
-/
@[simps]
def binaryProductLimitCone (X Y : Type u) : Limits.LimitCone (pair X Y) :=
  ⟨_, binaryProductLimit X Y⟩
#align category_theory.limits.types.binary_product_limit_cone CategoryTheory.Limits.Types.binaryProductLimitCone

/-- The categorical binary product in `Type u` is cartesian product. -/
noncomputable def binaryProductIso (X Y : Type u) : Limits.prod X Y ≅ X × Y :=
  limit.isoLimitCone (binaryProductLimitCone X Y)
#align category_theory.limits.types.binary_product_iso CategoryTheory.Limits.Types.binaryProductIso

@[elementwise (attr := simp)]
theorem binaryProductIso_hom_comp_fst (X Y : Type u) :
    (binaryProductIso X Y).hom ≫ _root_.Prod.fst = Limits.prod.fst :=
  limit.isoLimitCone_hom_π (binaryProductLimitCone X Y) ⟨WalkingPair.left⟩
#align category_theory.limits.types.binary_product_iso_hom_comp_fst CategoryTheory.Limits.Types.binaryProductIso_hom_comp_fst

@[elementwise (attr := simp)]
theorem binaryProductIso_hom_comp_snd (X Y : Type u) :
    (binaryProductIso X Y).hom ≫ _root_.Prod.snd = Limits.prod.snd :=
  limit.isoLimitCone_hom_π (binaryProductLimitCone X Y) ⟨WalkingPair.right⟩
#align category_theory.limits.types.binary_product_iso_hom_comp_snd CategoryTheory.Limits.Types.binaryProductIso_hom_comp_snd

@[elementwise (attr := simp)]
theorem binaryProductIso_inv_comp_fst (X Y : Type u) :
    (binaryProductIso X Y).inv ≫ Limits.prod.fst = _root_.Prod.fst :=
  limit.isoLimitCone_inv_π (binaryProductLimitCone X Y) ⟨WalkingPair.left⟩
#align category_theory.limits.types.binary_product_iso_inv_comp_fst CategoryTheory.Limits.Types.binaryProductIso_inv_comp_fst

@[elementwise (attr := simp)]
theorem binaryProductIso_inv_comp_snd (X Y : Type u) :
    (binaryProductIso X Y).inv ≫ Limits.prod.snd = _root_.Prod.snd :=
  limit.isoLimitCone_inv_π (binaryProductLimitCone X Y) ⟨WalkingPair.right⟩
#align category_theory.limits.types.binary_product_iso_inv_comp_snd CategoryTheory.Limits.Types.binaryProductIso_inv_comp_snd

-- porting note: it was originally @[simps (config := { typeMd := reducible })]
-- We add the option `type_md` to tell `@[simps]` to not treat homomorphisms `X ⟶ Y` in `Type*` as
-- a function type
/-- The functor which sends `X, Y` to the product type `X × Y`. -/
@[simps]
def binaryProductFunctor : Type u ⥤ Type u ⥤ Type u where
  obj X :=
    { obj := fun Y => X × Y
      map := fun { Y₁ Y₂} f => (binaryProductLimit X Y₂).lift
        (BinaryFan.mk _root_.Prod.fst (_root_.Prod.snd ≫ f)) }
  map {X₁ X₂} f :=
    { app := fun Y =>
      (binaryProductLimit X₂ Y).lift (BinaryFan.mk (_root_.Prod.fst ≫ f) _root_.Prod.snd) }
#align category_theory.limits.types.binary_product_functor CategoryTheory.Limits.Types.binaryProductFunctor

/-- The product functor given by the instance `HasBinaryProducts (Type u)` is isomorphic to the
explicit binary product functor given by the product type.
-/
noncomputable def binaryProductIsoProd : binaryProductFunctor ≅ (prod.functor : Type u ⥤ _) := by
  refine' NatIso.ofComponents (fun X => _) (fun _ => _)
  · refine' NatIso.ofComponents (fun Y => _) (fun _ => _)
    · exact ((limit.isLimit _).conePointUniqueUpToIso (binaryProductLimit X Y)).symm
    . apply Limits.prod.hom_ext <;> dsimp <;> simp <;> rfl
  . ext : 2
    apply Limits.prod.hom_ext <;> dsimp <;> simp <;> rfl
#align category_theory.limits.types.binary_product_iso_prod CategoryTheory.Limits.Types.binaryProductIsoProd

/-- The sum type `X ⊕ Y` forms a cocone for the binary coproduct of `X` and `Y`. -/
@[simps!]
def binaryCoproductCocone (X Y : Type u) : Cocone (pair X Y) :=
  BinaryCofan.mk Sum.inl Sum.inr
#align category_theory.limits.types.binary_coproduct_cocone CategoryTheory.Limits.Types.binaryCoproductCocone

/-- The sum type `X ⊕ Y` is a binary coproduct for `X` and `Y`. -/
@[simps]
def binaryCoproductColimit (X Y : Type u) : IsColimit (binaryCoproductCocone X Y) where
  desc := fun s : BinaryCofan X Y => Sum.elim s.inl s.inr
  fac _ j := Discrete.recOn j fun j => WalkingPair.casesOn j rfl rfl
  uniq _ _ w := funext fun x => Sum.casesOn x (congr_fun (w ⟨left⟩)) (congr_fun (w ⟨right⟩))
#align category_theory.limits.types.binary_coproduct_colimit CategoryTheory.Limits.Types.binaryCoproductColimit

/-- The category of types has `X ⊕ Y`,
as the binary coproduct of `X` and `Y`.
-/
def binaryCoproductColimitCocone (X Y : Type u) : Limits.ColimitCocone (pair X Y) :=
  ⟨_, binaryCoproductColimit X Y⟩
#align category_theory.limits.types.binary_coproduct_colimit_cocone CategoryTheory.Limits.Types.binaryCoproductColimitCocone

/-- The categorical binary coproduct in `Type u` is the sum `X ⊕ Y`. -/
noncomputable def binaryCoproductIso (X Y : Type u) : Limits.coprod X Y ≅ Sum X Y :=
  colimit.isoColimitCocone (binaryCoproductColimitCocone X Y)
#align category_theory.limits.types.binary_coproduct_iso CategoryTheory.Limits.Types.binaryCoproductIso

--open CategoryTheory.Type

@[elementwise (attr := simp)]
theorem binaryCoproductIso_inl_comp_hom (X Y : Type u) :
    Limits.coprod.inl ≫ (binaryCoproductIso X Y).hom = Sum.inl :=
  colimit.isoColimitCocone_ι_hom (binaryCoproductColimitCocone X Y) ⟨WalkingPair.left⟩
#align category_theory.limits.types.binary_coproduct_iso_inl_comp_hom CategoryTheory.Limits.Types.binaryCoproductIso_inl_comp_hom

@[elementwise (attr := simp)]
theorem binaryCoproductIso_inr_comp_hom (X Y : Type u) :
    Limits.coprod.inr ≫ (binaryCoproductIso X Y).hom = Sum.inr :=
  colimit.isoColimitCocone_ι_hom (binaryCoproductColimitCocone X Y) ⟨WalkingPair.right⟩
#align category_theory.limits.types.binary_coproduct_iso_inr_comp_hom CategoryTheory.Limits.Types.binaryCoproductIso_inr_comp_hom

@[elementwise (attr := simp)]
theorem binaryCoproductIso_inl_comp_inv (X Y : Type u) :
    ↾(Sum.inl : X ⟶ Sum X Y) ≫ (binaryCoproductIso X Y).inv = Limits.coprod.inl :=
  colimit.isoColimitCocone_ι_inv (binaryCoproductColimitCocone X Y) ⟨WalkingPair.left⟩
#align category_theory.limits.types.binary_coproduct_iso_inl_comp_inv CategoryTheory.Limits.Types.binaryCoproductIso_inl_comp_inv

@[elementwise (attr := simp)]
theorem binaryCoproductIso_inr_comp_inv (X Y : Type u) :
    ↾(Sum.inr : Y ⟶ Sum X Y) ≫ (binaryCoproductIso X Y).inv = Limits.coprod.inr :=
  colimit.isoColimitCocone_ι_inv (binaryCoproductColimitCocone X Y) ⟨WalkingPair.right⟩
#align category_theory.limits.types.binary_coproduct_iso_inr_comp_inv CategoryTheory.Limits.Types.binaryCoproductIso_inr_comp_inv

open Function (Injective)

theorem binaryCofan_isColimit_iff {X Y : Type u} (c : BinaryCofan X Y) :
    Nonempty (IsColimit c) ↔
      Injective c.inl ∧ Injective c.inr ∧ IsCompl (Set.range c.inl) (Set.range c.inr) := by
  classical
    constructor
    · rintro ⟨h⟩
      rw [← show _ = c.inl from
          h.comp_coconePointUniqueUpToIso_inv (binaryCoproductColimit X Y) ⟨WalkingPair.left⟩,
        ← show _ = c.inr from
          h.comp_coconePointUniqueUpToIso_inv (binaryCoproductColimit X Y) ⟨WalkingPair.right⟩]
      dsimp [binaryCoproductCocone]
      refine'
        ⟨(h.coconePointUniqueUpToIso (binaryCoproductColimit X Y)).symm.toEquiv.injective.comp
            Sum.inl_injective,
          (h.coconePointUniqueUpToIso (binaryCoproductColimit X Y)).symm.toEquiv.injective.comp
            Sum.inr_injective, _⟩
      erw [Set.range_comp, ← eq_compl_iff_isCompl, Set.range_comp _ Sum.inr, ←
        Set.image_compl_eq
          (h.coconePointUniqueUpToIso (binaryCoproductColimit X Y)).symm.toEquiv.bijective]
      simp
    · rintro ⟨h₁, h₂, h₃⟩
      have : ∀ x, x ∈ Set.range c.inl ∨ x ∈ Set.range c.inr := by
        rw [eq_compl_iff_isCompl.mpr h₃.symm]
        exact fun _ => or_not
      refine' ⟨BinaryCofan.IsColimit.mk _ _ _ _ _⟩
      · intro T f g x
        exact
          if h : x ∈ Set.range c.inl then f ((Equiv.ofInjective _ h₁).symm ⟨x, h⟩)
          else g ((Equiv.ofInjective _ h₂).symm ⟨x, (this x).resolve_left h⟩)
      · intro T f g
        funext x
        dsimp
        simp [h₁.eq_iff]
      · intro T f g
        funext x
        dsimp
        simp only [Set.mem_range, Equiv.ofInjective_symm_apply,
          dite_eq_right_iff, forall_exists_index]
        intro y e
        have : c.inr x ∈ Set.range c.inl ⊓ Set.range c.inr := ⟨⟨_, e⟩, ⟨_, rfl⟩⟩
        rw [disjoint_iff.mp h₃.1] at this
        exact this.elim
      · rintro T _ _ m rfl rfl
        funext x
        dsimp
        split_ifs <;> exact congr_arg _ (Equiv.apply_ofInjective_symm _ ⟨_, _⟩).symm
#align category_theory.limits.types.binary_cofan_is_colimit_iff CategoryTheory.Limits.Types.binaryCofan_isColimit_iff

/-- Any monomorphism in `Type` is an coproduct injection. -/
noncomputable def isCoprodOfMono {X Y : Type u} (f : X ⟶ Y) [Mono f] :
    IsColimit (BinaryCofan.mk f (Subtype.val : ↑(Set.range fᶜ) → Y)) := by
  apply Nonempty.some
  rw [binaryCofan_isColimit_iff]
  refine' ⟨(mono_iff_injective f).mp inferInstance, Subtype.val_injective, _⟩
  symm
  rw [← eq_compl_iff_isCompl]
  exact Subtype.range_val
#align category_theory.limits.types.is_coprod_of_mono CategoryTheory.Limits.Types.isCoprodOfMono

/-- The category of types has `Π j, f j` as the product of a type family `f : J → Type`.
-/
def productLimitCone {J : Type u} (F : J → Type max u v) :
    Limits.LimitCone (Discrete.functor F) where
  cone :=
    { pt := ∀ j, F j
      π := Discrete.natTrans (fun ⟨j⟩ f => f j) }
  isLimit :=
    { lift := fun s x j => s.π.app ⟨j⟩ x
      uniq := fun s m w => funext fun x => funext fun j => (congr_fun (w ⟨j⟩) x : _) }
#align category_theory.limits.types.product_limit_cone CategoryTheory.Limits.Types.productLimitCone

/-- The categorical product in `Type u` is the type theoretic product `Π j, F j`. -/
noncomputable def productIso {J : Type u} (F : J → Type max u v) :
  haveI : HasProduct F := hasLimit.{u,v} _; ∏ F ≅ ∀ j, F j :=
  haveI : HasProduct F := hasLimit.{u,v} _; limit.isoLimitCone (productLimitCone.{u, v} F)
#align category_theory.limits.types.product_iso CategoryTheory.Limits.Types.productIso

-- porting note: was `@[elementwise (attr := simp)]`, but it produces a trivial lemma.
@[simp]
theorem productIso_hom_comp_eval {J : Type u} (F : J → Type max u v) (j : J) :
     haveI : HasProduct F := hasLimit.{u,v} _;
    ((productIso.{u, v} F).hom ≫ fun f => f j) = Pi.π F j :=
  rfl
#align category_theory.limits.types.product_iso_hom_comp_eval CategoryTheory.Limits.Types.productIso_hom_comp_eval

@[elementwise (attr := simp)]
theorem productIso_inv_comp_π {J : Type u} (F : J → Type max u v) (j : J) :
    haveI : HasProduct F := hasLimit.{u,v} _;
    (productIso.{u, v} F).inv ≫ Pi.π F j = fun f => f j :=
  haveI : HasProduct F := hasLimit.{u,v} _;
  limit.isoLimitCone_inv_π (productLimitCone.{u, v} F) ⟨j⟩
#align category_theory.limits.types.product_iso_inv_comp_π CategoryTheory.Limits.Types.productIso_inv_comp_π

/-- The category of types has `Σ j, f j` as the coproduct of a type family `f : J → Type`.
-/
def coproductColimitCocone {J : Type u} (F : J → Type u) :
    Limits.ColimitCocone (Discrete.functor F) where
  cocone :=
    { pt := Σj, F j
      ι := Discrete.natTrans (fun ⟨j⟩ x => ⟨j, x⟩)}--{ app := fun j x => ⟨j.as, x⟩ } }
  isColimit :=
    { desc := fun s x => s.ι.app ⟨x.1⟩ x.2
      uniq := fun s m w => by
        funext ⟨j, x⟩
        exact congr_fun (w ⟨j⟩) x }
#align category_theory.limits.types.coproduct_colimit_cocone CategoryTheory.Limits.Types.coproductColimitCocone

/-- The categorical coproduct in `Type u` is the type theoretic coproduct `Σ j, F j`. -/
noncomputable def coproductIso {J : Type u} (F : J → Type u) : ∐ F ≅ Σj, F j :=
  colimit.isoColimitCocone (coproductColimitCocone F)
#align category_theory.limits.types.coproduct_iso CategoryTheory.Limits.Types.coproductIso

@[elementwise (attr := simp)]
theorem coproductIso_ι_comp_hom {J : Type u} (F : J → Type u) (j : J) :
    Sigma.ι F j ≫ (coproductIso F).hom = fun x : F j => (⟨j, x⟩ : Σj, F j) :=
  colimit.isoColimitCocone_ι_hom (coproductColimitCocone F) ⟨j⟩
#align category_theory.limits.types.coproduct_iso_ι_comp_hom CategoryTheory.Limits.Types.coproductIso_ι_comp_hom

-- porting note: was @[elementwise (attr := simp)], but it produces a trivial lemma
-- removed simp attribute because it seems it never applies
theorem coproductIso_mk_comp_inv {J : Type u} (F : J → Type u) (j : J) :
    (↾fun x : F j => (⟨j, x⟩ : Σj, F j)) ≫ (coproductIso F).inv = Sigma.ι F j :=
  rfl
#align category_theory.limits.types.coproduct_iso_mk_comp_inv CategoryTheory.Limits.Types.coproductIso_mk_comp_inv

section Fork

variable {X Y Z : Type u} (f : X ⟶ Y) {g h : Y ⟶ Z} (w : f ≫ g = f ≫ h)

/--
Show the given fork in `Type u` is an equalizer given that any element in the "difference kernel"
comes from `X`.
The converse of `unique_of_type_equalizer`.
-/
noncomputable def typeEqualizerOfUnique (t : ∀ y : Y, g y = h y → ∃! x : X, f x = y) :
    IsLimit (Fork.ofι _ w) :=
  Fork.IsLimit.mk' _ fun s => by
    refine' ⟨fun i => _, _, _⟩
    · apply Classical.choose (t (s.ι i) _)
      apply congr_fun s.condition i
    . funext i
      exact (Classical.choose_spec (t (s.ι i) (congr_fun s.condition i))).1
    . intro m hm
      funext i
      exact (Classical.choose_spec (t (s.ι i) (congr_fun s.condition i))).2 _ (congr_fun hm i)
#align category_theory.limits.types.type_equalizer_of_unique CategoryTheory.Limits.Types.typeEqualizerOfUnique

/-- The converse of `type_equalizer_of_unique`. -/
theorem unique_of_type_equalizer (t : IsLimit (Fork.ofι _ w)) (y : Y) (hy : g y = h y) :
    ∃! x : X, f x = y := by
  let y' : PUnit ⟶ Y := fun _ => y
  have hy' : y' ≫ g = y' ≫ h := funext fun _ => hy
  refine' ⟨(Fork.IsLimit.lift' t _ hy').1 ⟨⟩, congr_fun (Fork.IsLimit.lift' t y' _).2 ⟨⟩, _⟩
  intro x' hx'
  suffices : (fun _ : PUnit => x') = (Fork.IsLimit.lift' t y' hy').1
  rw [← this]
  apply Fork.IsLimit.hom_ext t
  funext ⟨⟩
  apply hx'.trans (congr_fun (Fork.IsLimit.lift' t _ hy').2 ⟨⟩).symm
#align category_theory.limits.types.unique_of_type_equalizer CategoryTheory.Limits.Types.unique_of_type_equalizer

theorem type_equalizer_iff_unique :
    Nonempty (IsLimit (Fork.ofι _ w)) ↔ ∀ y : Y, g y = h y → ∃! x : X, f x = y :=
  ⟨fun i => unique_of_type_equalizer _ _ (Classical.choice i), fun k =>
    ⟨typeEqualizerOfUnique f w k⟩⟩
#align category_theory.limits.types.type_equalizer_iff_unique CategoryTheory.Limits.Types.type_equalizer_iff_unique

/-- Show that the subtype `{x : Y // g x = h x}` is an equalizer for the pair `(g,h)`. -/
def equalizerLimit : Limits.LimitCone (parallelPair g h) where
  cone := Fork.ofι (Subtype.val : { x : Y // g x = h x } → Y) (funext Subtype.prop)
  isLimit :=
    Fork.IsLimit.mk' _ fun s =>
      ⟨fun i => ⟨s.ι i, by apply congr_fun s.condition i⟩, rfl, fun hm =>
        funext fun x => Subtype.ext (congr_fun hm x)⟩
#align category_theory.limits.types.equalizer_limit CategoryTheory.Limits.Types.equalizerLimit

variable (g h)

/-- The categorical equalizer in `Type u` is `{x : Y // g x = h x}`. -/
noncomputable def equalizerIso : equalizer g h ≅ { x : Y // g x = h x } :=
  limit.isoLimitCone equalizerLimit
#align category_theory.limits.types.equalizer_iso CategoryTheory.Limits.Types.equalizerIso

-- porting note: was @[elementwise], but it produces a trivial lemma
@[simp]
theorem equalizerIso_hom_comp_subtype : (equalizerIso g h).hom ≫ Subtype.val = equalizer.ι g h := by
  rfl
#align category_theory.limits.types.equalizer_iso_hom_comp_subtype CategoryTheory.Limits.Types.equalizerIso_hom_comp_subtype

@[elementwise (attr := simp)]
theorem equalizerIso_inv_comp_ι : (equalizerIso g h).inv ≫ equalizer.ι g h = Subtype.val :=
  limit.isoLimitCone_inv_π equalizerLimit WalkingParallelPair.zero
#align category_theory.limits.types.equalizer_iso_inv_comp_ι CategoryTheory.Limits.Types.equalizerIso_inv_comp_ι

end Fork

section Cofork

variable {X Y Z : Type u} (f g : X ⟶ Y)

/-- (Implementation) The relation to be quotiented to obtain the coequalizer. -/
inductive CoequalizerRel : Y → Y → Prop
  | Rel (x : X) : CoequalizerRel (f x) (g x)
#align category_theory.limits.types.coequalizer_rel CategoryTheory.Limits.Types.CoequalizerRel

/-- Show that the quotient by the relation generated by `f(x) ~ g(x)`
is a coequalizer for the pair `(f, g)`.
-/
def coequalizerColimit : Limits.ColimitCocone (parallelPair f g) where
  cocone :=
    Cofork.ofπ (Quot.mk (CoequalizerRel f g)) (funext fun x => Quot.sound (CoequalizerRel.Rel x))
  isColimit :=
    Cofork.IsColimit.mk _
      (fun s => Quot.lift s.π
        (fun a b (h : CoequalizerRel f g a b) => by
          cases h
          apply congr_fun s.condition))
      (fun s => rfl)
      (fun s m hm => funext (fun x => Quot.inductionOn x (congr_fun hm)))
#align category_theory.limits.types.coequalizer_colimit CategoryTheory.Limits.Types.coequalizerColimit

/-- If `π : Y ⟶ Z` is an equalizer for `(f, g)`, and `U ⊆ Y` such that `f ⁻¹' U = g ⁻¹' U`,
then `π ⁻¹' (π '' U) = U`.
-/
theorem coequalizer_preimage_image_eq_of_preimage_eq (π : Y ⟶ Z) (e : f ≫ π = g ≫ π)
    (h : IsColimit (Cofork.ofπ π e)) (U : Set Y) (H : f ⁻¹' U = g ⁻¹' U) : π ⁻¹' (π '' U) = U := by
  have lem : ∀ x y, CoequalizerRel f g x y → (x ∈ U ↔ y ∈ U) := by
    rintro _ _ ⟨x⟩
    change x ∈ f ⁻¹' U ↔ x ∈ g ⁻¹' U
    rw [H]
  -- porting note: tidy was able to fill the structure automatically
  have eqv : _root_.Equivalence fun x y => x ∈ U ↔ y ∈ U :=
    { refl := by tauto
      symm := by tauto
      trans := by tauto }
  ext
  constructor
  · rw [←
      show _ = π from
        h.comp_coconePointUniqueUpToIso_inv (coequalizerColimit f g).2
          WalkingParallelPair.one]
    rintro ⟨y, hy, e'⟩
    dsimp at e'
    replace e' :=
      (mono_iff_injective
            (h.coconePointUniqueUpToIso (coequalizerColimit f g).isColimit).inv).mp
        inferInstance e'
    exact (eqv.eqvGen_iff.mp (EqvGen.mono lem (Quot.exact _ e'))).mp hy
  · exact fun hx => ⟨_, hx, rfl⟩
#align category_theory.limits.types.coequalizer_preimage_image_eq_of_preimage_eq CategoryTheory.Limits.Types.coequalizer_preimage_image_eq_of_preimage_eq

/-- The categorical coequalizer in `Type u` is the quotient by `f g ~ g x`. -/
noncomputable def coequalizerIso : coequalizer f g ≅ _root_.Quot (CoequalizerRel f g) :=
  colimit.isoColimitCocone (coequalizerColimit f g)
#align category_theory.limits.types.coequalizer_iso CategoryTheory.Limits.Types.coequalizerIso

@[elementwise (attr := simp)]
theorem coequalizerIso_π_comp_hom :
    coequalizer.π f g ≫ (coequalizerIso f g).hom = Quot.mk (CoequalizerRel f g) :=
  colimit.isoColimitCocone_ι_hom (coequalizerColimit f g) WalkingParallelPair.one
#align category_theory.limits.types.coequalizer_iso_π_comp_hom CategoryTheory.Limits.Types.coequalizerIso_π_comp_hom

-- porting note: was @[elementwise], but it produces a trivial lemma
@[simp]
theorem coequalizerIso_quot_comp_inv :
    ↾Quot.mk (CoequalizerRel f g) ≫ (coequalizerIso f g).inv = coequalizer.π f g :=
  rfl
#align category_theory.limits.types.coequalizer_iso_quot_comp_inv CategoryTheory.Limits.Types.coequalizerIso_quot_comp_inv

end Cofork

section Pullback

open CategoryTheory.Limits.WalkingPair

open CategoryTheory.Limits.WalkingCospan

open CategoryTheory.Limits.WalkingCospan.Hom

variable {W X Y Z : Type u}

variable (f : X ⟶ Z) (g : Y ⟶ Z)

-- porting note: removed @[nolint has_nonempty_instance]
/-- The usual explicit pullback in the category of types, as a subtype of the product.
The full `LimitCone` data is bundled as `pullbackLimitCone f g`.
-/
abbrev PullbackObj : Type u :=
  { p : X × Y // f p.1 = g p.2 }
#align category_theory.limits.types.pullback_obj CategoryTheory.Limits.Types.PullbackObj

-- `PullbackObj f g` comes with a coercion to the product type `X × Y`.
example (p : PullbackObj f g) : X × Y :=
  p

/-- The explicit pullback cone on `PullbackObj f g`.
This is bundled with the `IsLimit` data as `pullbackLimitCone f g`.
-/
abbrev pullbackCone : Limits.PullbackCone f g :=
  PullbackCone.mk (fun p : PullbackObj f g => p.1.1) (fun p => p.1.2) (funext fun p => p.2)
#align category_theory.limits.types.pullback_cone CategoryTheory.Limits.Types.pullbackCone

/-- The explicit pullback in the category of types, bundled up as a `LimitCone`
for given `f` and `g`.
-/
@[simps]
def pullbackLimitCone (f : X ⟶ Z) (g : Y ⟶ Z) : Limits.LimitCone (cospan f g) where
  cone := pullbackCone f g
  isLimit :=
    PullbackCone.isLimitAux _ (fun s x => ⟨⟨s.fst x, s.snd x⟩, congr_fun s.condition x⟩)
      (by aesop) (by aesop) fun s m w =>
      funext fun x =>
        Subtype.ext <|
          Prod.ext (congr_fun (w WalkingCospan.left) x) (congr_fun (w WalkingCospan.right) x)
#align category_theory.limits.types.pullback_limit_cone CategoryTheory.Limits.Types.pullbackLimitCone

/-- The pullback cone given by the instance `HasPullbacks (Type u)` is isomorphic to the
explicit pullback cone given by `pullbacklimitCone`.
-/
noncomputable def pullbackConeIsoPullback : limit.cone (cospan f g) ≅ pullbackCone f g :=
  (limit.isLimit _).uniqueUpToIso (pullbackLimitCone f g).isLimit
#align category_theory.limits.types.pullback_cone_iso_pullback CategoryTheory.Limits.Types.pullbackConeIsoPullback

/-- The pullback given by the instance `HasPullbacks (Type u)` is isomorphic to the
explicit pullback object given by `PullbackObj`.
-/
noncomputable def pullbackIsoPullback : pullback f g ≅ PullbackObj f g :=
  (Cones.forget _).mapIso <| pullbackConeIsoPullback f g
#align category_theory.limits.types.pullback_iso_pullback CategoryTheory.Limits.Types.pullbackIsoPullback

@[simp]

@[simp]
theorem pullbackIsoPullback_hom_snd (p : pullback f g) :
    ((pullbackIsoPullback f g).hom p : X × Y).snd = (pullback.snd : _ ⟶ Y) p :=
  congr_fun ((pullbackConeIsoPullback f g).hom.w right) p
#align category_theory.limits.types.pullback_iso_pullback_hom_snd CategoryTheory.Limits.Types.pullbackIsoPullback_hom_snd

@[simp]
theorem pullbackIsoPullback_inv_fst :
    (pullbackIsoPullback f g).inv ≫ pullback.fst = fun p => (p.1 : X × Y).fst :=
  (pullbackConeIsoPullback f g).inv.w left
#align category_theory.limits.types.pullback_iso_pullback_inv_fst CategoryTheory.Limits.Types.pullbackIsoPullback_inv_fst

@[simp]
theorem pullbackIsoPullback_inv_snd :
    (pullbackIsoPullback f g).inv ≫ pullback.snd = fun p => (p.1 : X × Y).snd :=
  (pullbackConeIsoPullback f g).inv.w right
#align category_theory.limits.types.pullback_iso_pullback_inv_snd CategoryTheory.Limits.Types.pullbackIsoPullback_inv_snd

end Pullback

end CategoryTheory.Limits.Types


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
-/
import data.int.succ_pred
import data.nat.succ_pred
import order.partial_sups
import order.succ_pred.relation
import topology.subset_properties

/-!
# Connected subsets of topological spaces

In this file we define connected subsets of a topological spaces and various other properties and
classes related to connectivity.

## Main definitions

We define the following properties for sets in a topological space:

* `is_connected`: a nonempty set that has no non-trivial open partition.
  See also the section below in the module doc.
* `connected_component` is the connected component of an element in the space.
* `is_totally_disconnected`: all of its connected components are singletons.
* `is_totally_separated`: any two points can be separated by two disjoint opens that cover the set.

For each of these definitions, we also have a class stating that the whole space
satisfies that property:
`connected_space`, `totally_disconnected_space`, `totally_separated_space`.

## On the definition of connected sets/spaces

In informal mathematics, connected spaces are assumed to be nonempty.
We formalise the predicate without that assumption as `is_preconnected`.
In other words, the only difference is whether the empty space counts as connected.
There are good reasons to consider the empty space to be “too simple to be simple”
See also https://ncatlab.org/nlab/show/too+simple+to+be+simple,
and in particular
https://ncatlab.org/nlab/show/too+simple+to+be+simple#relationship_to_biased_definitions.
-/

open set function topological_space relation
open_locale classical topological_space

universes u v
variables {α : Type u} {β : Type v} {ι : Type*} {π : ι → Type*} [topological_space α]
  {s t u v : set α}

section preconnected

/-- A preconnected set is one where there is no non-trivial open partition. -/
def is_preconnected (s : set α) : Prop :=
∀ (u v : set α), is_open u → is_open v → s ⊆ u ∪ v →
  (s ∩ u).nonempty → (s ∩ v).nonempty → (s ∩ (u ∩ v)).nonempty

/-- A connected set is one that is nonempty and where there is no non-trivial open partition. -/
def is_connected (s : set α) : Prop :=
s.nonempty ∧ is_preconnected s

lemma is_connected.nonempty {s : set α} (h : is_connected s) :
  s.nonempty := h.1

lemma is_connected.is_preconnected {s : set α} (h : is_connected s) :
  is_preconnected s := h.2

theorem is_preirreducible.is_preconnected {s : set α} (H : is_preirreducible s) :
  is_preconnected s :=
λ _ _ hu hv _, H _ _ hu hv

theorem is_irreducible.is_connected {s : set α} (H : is_irreducible s) : is_connected s :=
⟨H.nonempty, H.is_preirreducible.is_preconnected⟩

theorem is_preconnected_empty : is_preconnected (∅ : set α) :=
is_preirreducible_empty.is_preconnected

theorem is_connected_singleton {x} : is_connected ({x} : set α) :=
is_irreducible_singleton.is_connected

theorem is_preconnected_singleton {x} : is_preconnected ({x} : set α) :=
is_connected_singleton.is_preconnected

theorem set.subsingleton.is_preconnected {s : set α} (hs : s.subsingleton) :
  is_preconnected s :=
hs.induction_on is_preconnected_empty (λ x, is_preconnected_singleton)

/-- If any point of a set is joined to a fixed point by a preconnected subset,
then the original set is preconnected as well. -/
theorem is_preconnected_of_forall {s : set α} (x : α)
  (H : ∀ y ∈ s, ∃ t ⊆ s, x ∈ t ∧ y ∈ t ∧ is_preconnected t) :
  is_preconnected s :=
begin
  rintros u v hu hv hs ⟨z, zs, zu⟩ ⟨y, ys, yv⟩,
  have xs : x ∈ s, by { rcases H y ys with ⟨t, ts, xt, yt, ht⟩, exact ts xt },
  wlog xu : x ∈ u := hs xs using [u v y z, v u z y],
  rcases H y ys with ⟨t, ts, xt, yt, ht⟩,
  have := ht u v hu hv(subset.trans ts hs) ⟨x, xt, xu⟩ ⟨y, yt, yv⟩,
  exact this.imp (λ z hz, ⟨ts hz.1, hz.2⟩)
end

/-- If any two points of a set are contained in a preconnected subset,
then the original set is preconnected as well. -/
theorem is_preconnected_of_forall_pair {s : set α}
  (H : ∀ x y ∈ s, ∃ t ⊆ s, x ∈ t ∧ y ∈ t ∧ is_preconnected t) :
  is_preconnected s :=
begin
  rcases eq_empty_or_nonempty s with (rfl|⟨x, hx⟩),
  exacts [is_preconnected_empty, is_preconnected_of_forall x $ λ y, H x hx y],
end

/-- A union of a family of preconnected sets with a common point is preconnected as well. -/
theorem is_preconnected_sUnion (x : α) (c : set (set α)) (H1 : ∀ s ∈ c, x ∈ s)
  (H2 : ∀ s ∈ c, is_preconnected s) : is_preconnected (⋃₀ c) :=
begin
  apply is_preconnected_of_forall x,
  rintros y ⟨s, sc, ys⟩,
  exact ⟨s, subset_sUnion_of_mem sc, H1 s sc, ys, H2 s sc⟩
end

theorem is_preconnected_Union {ι : Sort*} {s : ι → set α} (h₁ : (⋂ i, s i).nonempty)
  (h₂ : ∀ i, is_preconnected (s i)) :
  is_preconnected (⋃ i, s i) :=
exists.elim h₁ $ λ f hf, is_preconnected_sUnion f _ hf (forall_range_iff.2 h₂)

theorem is_preconnected.union (x : α) {s t : set α} (H1 : x ∈ s) (H2 : x ∈ t)
  (H3 : is_preconnected s) (H4 : is_preconnected t) : is_preconnected (s ∪ t) :=
sUnion_pair s t ▸ is_preconnected_sUnion x {s, t}
  (by rintro r (rfl | rfl | h); assumption)
  (by rintro r (rfl | rfl | h); assumption)

theorem is_preconnected.union' {s t : set α} (H : (s ∩ t).nonempty)
  (hs : is_preconnected s) (ht : is_preconnected t) : is_preconnected (s ∪ t) :=
by { rcases H with ⟨x, hxs, hxt⟩, exact hs.union x hxs hxt ht }

theorem is_connected.union {s t : set α} (H : (s ∩ t).nonempty)
  (Hs : is_connected s) (Ht : is_connected t) : is_connected (s ∪ t) :=
begin
  rcases H with ⟨x, hx⟩,
  refine ⟨⟨x, mem_union_left t (mem_of_mem_inter_left hx)⟩, _⟩,
  exact is_preconnected.union x (mem_of_mem_inter_left hx) (mem_of_mem_inter_right hx)
    Hs.is_preconnected Ht.is_preconnected
end

/-- The directed sUnion of a set S of preconnected subsets is preconnected. -/
theorem is_preconnected.sUnion_directed {S : set (set α)}
  (K : directed_on (⊆) S)
  (H : ∀ s ∈ S, is_preconnected s) : is_preconnected (⋃₀ S) :=
begin
  rintros u v hu hv Huv ⟨a, ⟨s, hsS, has⟩, hau⟩ ⟨b, ⟨t, htS, hbt⟩, hbv⟩,
  obtain ⟨r, hrS, hsr, htr⟩ : ∃ r ∈ S, s ⊆ r ∧ t ⊆ r := K s hsS t htS,
  have Hnuv : (r ∩ (u ∩ v)).nonempty,
  from H _ hrS u v hu hv ((subset_sUnion_of_mem hrS).trans Huv)
    ⟨a, hsr has, hau⟩ ⟨b, htr hbt, hbv⟩,
  have Kruv : r ∩ (u ∩ v) ⊆ ⋃₀ S ∩ (u ∩ v),
  from inter_subset_inter_left _ (subset_sUnion_of_mem hrS),
  exact Hnuv.mono Kruv
end

/-- The bUnion of a family of preconnected sets is preconnected if the graph determined by
whether two sets intersect is preconnected. -/
theorem is_preconnected.bUnion_of_refl_trans_gen {ι : Type*} {t : set ι} {s : ι → set α}
  (H : ∀ i ∈ t, is_preconnected (s i))
  (K : ∀ i j ∈ t, refl_trans_gen (λ i j : ι, (s i ∩ s j).nonempty ∧ i ∈ t) i j) :
  is_preconnected (⋃ n ∈ t, s n) :=
begin
  let R := λ i j : ι, (s i ∩ s j).nonempty ∧ i ∈ t,
  have P : ∀ (i j ∈ t), refl_trans_gen R i j →
    ∃ (p ⊆ t), i ∈ p ∧ j ∈ p ∧ is_preconnected (⋃ j ∈ p, s j),
  { intros i hi j hj h,
    induction h,
    case refl
    { refine ⟨{i}, singleton_subset_iff.mpr hi, mem_singleton i, mem_singleton i, _⟩,
      rw [bUnion_singleton],
      exact H i hi },
    case tail : j k hij hjk ih
    { obtain ⟨p, hpt, hip, hjp, hp⟩ := ih hjk.2,
      refine ⟨insert k p, insert_subset.mpr ⟨hj, hpt⟩, mem_insert_of_mem k hip, mem_insert k p, _⟩,
      rw [bUnion_insert],
      refine (H k hj).union' _ hp,
      refine hjk.1.mono _,
      rw [inter_comm],
      refine inter_subset_inter subset.rfl (subset_bUnion_of_mem hjp) } },
  refine is_preconnected_of_forall_pair _,
  intros x hx y hy,
  obtain ⟨i: ι, hi : i ∈ t, hxi : x ∈ s i⟩ := mem_Union₂.1 hx,
  obtain ⟨j: ι, hj : j ∈ t, hyj : y ∈ s j⟩ := mem_Union₂.1 hy,
  obtain ⟨p, hpt, hip, hjp, hp⟩ := P i hi j hj (K i hi j hj),
  exact ⟨⋃ j ∈ p, s j, bUnion_subset_bUnion_left hpt, mem_bUnion hip hxi, mem_bUnion hjp hyj, hp⟩
end

/-- The bUnion of a family of preconnected sets is preconnected if the graph determined by
whether two sets intersect is preconnected. -/
theorem is_connected.bUnion_of_refl_trans_gen {ι : Type*} {t : set ι} {s : ι → set α}
  (ht : t.nonempty)
  (H : ∀ i ∈ t, is_connected (s i))
  (K : ∀ i j ∈ t, refl_trans_gen (λ i j : ι, (s i ∩ s j).nonempty ∧ i ∈ t) i j) :
  is_connected (⋃ n ∈ t, s n) :=
⟨nonempty_bUnion.2 $ ⟨ht.some, ht.some_mem, (H _ ht.some_mem).nonempty⟩,
  is_preconnected.bUnion_of_refl_trans_gen (λ i hi, (H i hi).is_preconnected) K⟩

/-- Preconnectedness of the Union of a family of preconnected sets
indexed by the vertices of a preconnected graph,
where two vertices are joined when the corresponding sets intersect. -/
theorem is_preconnected.Union_of_refl_trans_gen {ι : Type*} {s : ι → set α}
  (H : ∀ i, is_preconnected (s i))
  (K : ∀ i j, refl_trans_gen (λ i j : ι, (s i ∩ s j).nonempty) i j) :
  is_preconnected (⋃ n, s n) :=
by { rw [← bUnion_univ], exact is_preconnected.bUnion_of_refl_trans_gen (λ i _, H i)
  (λ i _ j _, by simpa [mem_univ] using K i j) }

theorem is_connected.Union_of_refl_trans_gen {ι : Type*} [nonempty ι] {s : ι → set α}
  (H : ∀ i, is_connected (s i))
  (K : ∀ i j, refl_trans_gen (λ i j : ι, (s i ∩ s j).nonempty) i j) :
  is_connected (⋃ n, s n) :=
⟨nonempty_Union.2 $ nonempty.elim ‹_› $ λ i : ι, ⟨i, (H _).nonempty⟩,
  is_preconnected.Union_of_refl_trans_gen (λ i, (H i).is_preconnected) K⟩

section succ_order
open succ_order

variables [linear_order β] [succ_order β] [is_succ_archimedean β]

/-- The Union of connected sets indexed by a type with an archimedean successor (like `ℕ` or `ℤ`)
  such that any two neighboring sets meet is preconnected. -/
theorem is_preconnected.Union_of_chain {s : β → set α}
  (H : ∀ n, is_preconnected (s n))
  (K : ∀ n, (s n ∩ s (succ n)).nonempty) :
  is_preconnected (⋃ n, s n) :=
is_preconnected.Union_of_refl_trans_gen H $
  λ i j, refl_trans_gen_of_succ _ (λ i _, K i) $ λ i _, by { rw inter_comm, exact K i }

/-- The Union of connected sets indexed by a type with an archimedean successor (like `ℕ` or `ℤ`)
  such that any two neighboring sets meet is connected. -/
theorem is_connected.Union_of_chain [nonempty β] {s : β → set α}
  (H : ∀ n, is_connected (s n))
  (K : ∀ n, (s n ∩ s (succ n)).nonempty) :
  is_connected (⋃ n, s n) :=
is_connected.Union_of_refl_trans_gen H $
  λ i j, refl_trans_gen_of_succ _ (λ i _, K i) $ λ i _, by { rw inter_comm, exact K i }

/-- The Union of preconnected sets indexed by a subset of a type with an archimedean successor
  (like `ℕ` or `ℤ`) such that any two neighboring sets meet is preconnected. -/
theorem is_preconnected.bUnion_of_chain
  {s : β → set α} {t : set β} (ht : ord_connected t)
  (H : ∀ n ∈ t, is_preconnected (s n))
  (K : ∀ n : β, n ∈ t → succ n ∈ t → (s n ∩ s (succ n)).nonempty) :
  is_preconnected (⋃ n ∈ t, s n) :=
begin
  have h1 : ∀ {i j k : β}, i ∈ t → j ∈ t → k ∈ Ico i j → k ∈ t :=
    λ i j k hi hj hk, ht.out hi hj (Ico_subset_Icc_self hk),
  have h2 : ∀ {i j k : β}, i ∈ t → j ∈ t → k ∈ Ico i j → succ k ∈ t := λ i j k hi hj hk,
    ht.out hi hj ⟨hk.1.trans $ le_succ k, succ_le_of_lt hk.2⟩,
  have h3 : ∀ {i j k : β}, i ∈ t → j ∈ t → k ∈ Ico i j → (s k ∩ s (succ k)).nonempty :=
    λ i j k hi hj hk, K _ (h1 hi hj hk) (h2 hi hj hk),
  refine is_preconnected.bUnion_of_refl_trans_gen H (λ i hi j hj, _),
  exact refl_trans_gen_of_succ _ (λ k hk, ⟨h3 hi hj hk, h1 hi hj hk⟩)
    (λ k hk, ⟨by { rw [inter_comm], exact h3 hj hi hk }, h2 hj hi hk⟩),
end

/-- The Union of connected sets indexed by a subset of a type with an archimedean successor
  (like `ℕ` or `ℤ`) such that any two neighboring sets meet is preconnected. -/
theorem is_connected.bUnion_of_chain
  {s : β → set α} {t : set β} (hnt : t.nonempty) (ht : ord_connected t)
  (H : ∀ n ∈ t, is_connected (s n))
  (K : ∀ n : β, n ∈ t → succ n ∈ t → (s n ∩ s (succ n)).nonempty) :
  is_connected (⋃ n ∈ t, s n) :=
⟨nonempty_bUnion.2 $ ⟨hnt.some, hnt.some_mem, (H _ hnt.some_mem).nonempty⟩,
  is_preconnected.bUnion_of_chain ht (λ i hi, (H i hi).is_preconnected) K⟩

end succ_order

/-- Theorem of bark and tree :
if a set is within a (pre)connected set and its closure,
then it is (pre)connected as well. -/
theorem is_preconnected.subset_closure {s : set α} {t : set α}
  (H : is_preconnected s) (Kst : s ⊆ t) (Ktcs : t ⊆ closure s) :
  is_preconnected t :=
λ u v hu hv htuv ⟨y, hyt, hyu⟩ ⟨z, hzt, hzv⟩,
let ⟨p, hpu, hps⟩ := mem_closure_iff.1 (Ktcs hyt) u hu hyu,
    ⟨q, hqv, hqs⟩ := mem_closure_iff.1 (Ktcs hzt) v hv hzv,
    ⟨r, hrs, hruv⟩ := H u v hu hv (subset.trans Kst htuv) ⟨p, hps, hpu⟩ ⟨q, hqs, hqv⟩ in
  ⟨r, Kst hrs, hruv⟩

theorem is_connected.subset_closure {s : set α} {t : set α}
  (H : is_connected s) (Kst : s ⊆ t) (Ktcs : t ⊆ closure s): is_connected t :=
let hsne := H.left,
    ht := Kst,
    htne := nonempty.mono ht hsne in
    ⟨nonempty.mono Kst H.left, is_preconnected.subset_closure H.right Kst Ktcs ⟩

/-- The closure of a (pre)connected set is (pre)connected as well. -/
theorem is_preconnected.closure {s : set α} (H : is_preconnected s) :
  is_preconnected (closure s) :=
is_preconnected.subset_closure H subset_closure $ subset.refl $ closure s

theorem is_connected.closure {s : set α} (H : is_connected s) :
  is_connected (closure s) :=
is_connected.subset_closure H subset_closure $ subset.refl $ closure s

/-- The image of a (pre)connected set is (pre)connected as well. -/
theorem is_preconnected.image [topological_space β] {s : set α} (H : is_preconnected s)
  (f : α → β) (hf : continuous_on f s) : is_preconnected (f '' s) :=
begin
  -- Unfold/destruct definitions in hypotheses
  rintros u v hu hv huv ⟨_, ⟨x, xs, rfl⟩, xu⟩ ⟨_, ⟨y, ys, rfl⟩, yv⟩,
  rcases continuous_on_iff'.1 hf u hu with ⟨u', hu', u'_eq⟩,
  rcases continuous_on_iff'.1 hf v hv with ⟨v', hv', v'_eq⟩,
  -- Reformulate `huv : f '' s ⊆ u ∪ v` in terms of `u'` and `v'`
  replace huv : s ⊆ u' ∪ v',
  { rw [image_subset_iff, preimage_union] at huv,
    replace huv := subset_inter huv (subset.refl _),
    rw [inter_distrib_right, u'_eq, v'_eq, ← inter_distrib_right] at huv,
    exact (subset_inter_iff.1 huv).1 },
  -- Now `s ⊆ u' ∪ v'`, so we can apply `‹is_preconnected s›`
  obtain ⟨z, hz⟩ : (s ∩ (u' ∩ v')).nonempty,
  { refine H u' v' hu' hv' huv ⟨x, _⟩ ⟨y, _⟩; rw inter_comm,
    exacts [u'_eq ▸ ⟨xu, xs⟩, v'_eq ▸ ⟨yv, ys⟩] },
  rw [← inter_self s, inter_assoc, inter_left_comm s u', ← inter_assoc,
    inter_comm s, inter_comm s, ← u'_eq, ← v'_eq] at hz,
  exact ⟨f z, ⟨z, hz.1.2, rfl⟩, hz.1.1, hz.2.1⟩
end

theorem is_connected.image [topological_space β] {s : set α} (H : is_connected s)
  (f : α → β) (hf : continuous_on f s) : is_connected (f '' s) :=
⟨nonempty_image_iff.mpr H.nonempty, H.is_preconnected.image f hf⟩

theorem is_preconnected_closed_iff {s : set α} :
  is_preconnected s ↔ ∀ t t', is_closed t → is_closed t' → s ⊆ t ∪ t' →
    (s ∩ t).nonempty → (s ∩ t').nonempty → (s ∩ (t ∩ t')).nonempty :=
⟨begin
  rintros h t t' ht ht' htt' ⟨x, xs, xt⟩ ⟨y, ys, yt'⟩,
  by_contradiction h',
  rw [← ne_empty_iff_nonempty, ne.def, not_not, ← subset_compl_iff_disjoint, compl_inter] at h',
  have xt' : x ∉ t', from (h' xs).elim (absurd xt) id,
  have yt : y ∉ t, from (h' ys).elim id (absurd yt'),
  have := ne_empty_iff_nonempty.2 (h tᶜ t'ᶜ (is_open_compl_iff.2 ht)
    (is_open_compl_iff.2 ht') h' ⟨y, ys, yt⟩ ⟨x, xs, xt'⟩),
  rw [ne.def, ← compl_union, ← subset_compl_iff_disjoint, compl_compl] at this,
  contradiction
end,
begin
  rintros h u v hu hv huv ⟨x, xs, xu⟩ ⟨y, ys, yv⟩,
  by_contradiction h',
  rw [← ne_empty_iff_nonempty, ne.def, not_not,
    ← subset_compl_iff_disjoint, compl_inter] at h',
  have xv : x ∉ v, from (h' xs).elim (absurd xu) id,
  have yu : y ∉ u, from (h' ys).elim id (absurd yv),
  have := ne_empty_iff_nonempty.2 (h uᶜ vᶜ (is_closed_compl_iff.2 hu)
    (is_closed_compl_iff.2 hv) h' ⟨y, ys, yu⟩ ⟨x, xs, xv⟩),
  rw [ne.def, ← compl_union, ← subset_compl_iff_disjoint, compl_compl] at this,
  contradiction
end⟩

lemma inducing.is_preconnected_image [topological_space β] {s : set α} {f : α → β}
  (hf : inducing f) : is_preconnected (f '' s) ↔ is_preconnected s :=
begin
  refine ⟨λ h, _, λ h, h.image _ hf.continuous.continuous_on⟩,
  rintro u v hu' hv' huv ⟨x, hxs, hxu⟩ ⟨y, hys, hyv⟩,
  rcases hf.is_open_iff.1 hu' with ⟨u, hu, rfl⟩,
  rcases hf.is_open_iff.1 hv' with ⟨v, hv, rfl⟩,
  replace huv : f '' s ⊆ u ∪ v, by rwa image_subset_iff,
  rcases h u v hu hv huv ⟨f x, mem_image_of_mem _ hxs, hxu⟩ ⟨f y, mem_image_of_mem _ hys, hyv⟩
    with ⟨_, ⟨z, hzs, rfl⟩, hzuv⟩,
  exact ⟨z, hzs, hzuv⟩
end

/- TODO: The following lemmas about connection of preimages hold more generally for strict maps
(the quotient and subspace topologies of the image agree) whose fibers are preconnected. -/

lemma is_preconnected.preimage_of_open_map [topological_space β] {s : set β}
  (hs : is_preconnected s) {f : α → β} (hinj : function.injective f) (hf : is_open_map f)
  (hsf : s ⊆ range f) :
  is_preconnected (f ⁻¹' s) :=
λ u v hu hv hsuv hsu hsv,
begin
  obtain ⟨b, hbs, hbu, hbv⟩ := hs (f '' u) (f '' v) (hf u hu) (hf v hv) _ _ _,
  obtain ⟨a, rfl⟩ := hsf hbs,
  rw hinj.mem_set_image at hbu hbv,
  exact ⟨a, hbs, hbu, hbv⟩,
  { have := image_subset f hsuv,
    rwa [set.image_preimage_eq_of_subset hsf, image_union] at this },
  { obtain ⟨x, hx1, hx2⟩ := hsu,
    exact ⟨f x, hx1, x, hx2, rfl⟩ },
  { obtain ⟨y, hy1, hy2⟩ := hsv,
    exact ⟨f y, hy1, y, hy2, rfl⟩ }
end

lemma is_preconnected.preimage_of_closed_map [topological_space β] {s : set β}
  (hs : is_preconnected s) {f : α → β} (hinj : function.injective f) (hf : is_closed_map f)
  (hsf : s ⊆ range f) :
  is_preconnected (f ⁻¹' s) :=
is_preconnected_closed_iff.2 $ λ u v hu hv hsuv hsu hsv,
begin
  obtain ⟨b, hbs, hbu, hbv⟩ :=
    is_preconnected_closed_iff.1 hs (f '' u) (f '' v) (hf u hu) (hf v hv) _ _ _,
  obtain ⟨a, rfl⟩ := hsf hbs,
  rw hinj.mem_set_image at hbu hbv,
  exact ⟨a, hbs, hbu, hbv⟩,
  { have := image_subset f hsuv,
    rwa [set.image_preimage_eq_of_subset hsf, image_union] at this },
  { obtain ⟨x, hx1, hx2⟩ := hsu,
    exact ⟨f x, hx1, x, hx2, rfl⟩ },
  { obtain ⟨y, hy1, hy2⟩ := hsv,
    exact ⟨f y, hy1, y, hy2, rfl⟩ }
end

lemma is_connected.preimage_of_open_map [topological_space β] {s : set β} (hs : is_connected s)
  {f : α → β} (hinj : function.injective f) (hf : is_open_map f) (hsf : s ⊆ range f) :
  is_connected (f ⁻¹' s) :=
⟨hs.nonempty.preimage' hsf, hs.is_preconnected.preimage_of_open_map hinj hf hsf⟩

lemma is_connected.preimage_of_closed_map [topological_space β] {s : set β} (hs : is_connected s)
  {f : α → β} (hinj : function.injective f) (hf : is_closed_map f) (hsf : s ⊆ range f) :
  is_connected (f ⁻¹' s) :=
⟨hs.nonempty.preimage' hsf, hs.is_preconnected.preimage_of_closed_map hinj hf hsf⟩

lemma is_preconnected.subset_or_subset (hu : is_open u) (hv : is_open v) (huv : disjoint u v)
  (hsuv : s ⊆ u ∪ v) (hs : is_preconnected s) :
  s ⊆ u ∨ s ⊆ v :=
begin
  specialize hs u v hu hv hsuv,
  obtain hsu | hsu := (s ∩ u).eq_empty_or_nonempty,
  { exact or.inr ((set.disjoint_iff_inter_eq_empty.2 hsu).subset_right_of_subset_union hsuv) },
  { replace hs := mt (hs hsu),
    simp_rw [set.not_nonempty_iff_eq_empty, ←set.disjoint_iff_inter_eq_empty,
      disjoint_iff_inter_eq_empty.1 huv] at hs,
    exact or.inl ((hs s.disjoint_empty).subset_left_of_subset_union hsuv) }
end

lemma is_preconnected.subset_left_of_subset_union (hu : is_open u) (hv : is_open v)
  (huv : disjoint u v) (hsuv : s ⊆ u ∪ v) (hsu : (s ∩ u).nonempty) (hs : is_preconnected s) :
  s ⊆ u :=
disjoint.subset_left_of_subset_union hsuv
begin
  by_contra hsv,
  rw not_disjoint_iff_nonempty_inter at hsv,
  obtain ⟨x, _, hx⟩ := hs u v hu hv hsuv hsu hsv,
  exact set.disjoint_iff.1 huv hx,
end

lemma is_preconnected.subset_right_of_subset_union (hu : is_open u) (hv : is_open v)
  (huv : disjoint u v) (hsuv : s ⊆ u ∪ v) (hsv : (s ∩ v).nonempty) (hs : is_preconnected s) :
  s ⊆ v :=
hs.subset_left_of_subset_union hv hu huv.symm (union_comm u v ▸ hsuv) hsv

theorem is_preconnected.prod [topological_space β] {s : set α} {t : set β}
  (hs : is_preconnected s) (ht : is_preconnected t) :
  is_preconnected (s ×ˢ t) :=
begin
  apply is_preconnected_of_forall_pair,
  rintro ⟨a₁, b₁⟩ ⟨ha₁, hb₁⟩ ⟨a₂, b₂⟩ ⟨ha₂, hb₂⟩,
  refine ⟨prod.mk a₁ '' t ∪ flip prod.mk b₂ '' s, _,
    or.inl ⟨b₁, hb₁, rfl⟩, or.inr ⟨a₂, ha₂, rfl⟩, _⟩,
  { rintro _ (⟨y, hy, rfl⟩|⟨x, hx, rfl⟩),
    exacts [⟨ha₁, hy⟩, ⟨hx, hb₂⟩] },
  { exact (ht.image _ (continuous.prod.mk _).continuous_on).union (a₁, b₂) ⟨b₂, hb₂, rfl⟩
      ⟨a₁, ha₁, rfl⟩ (hs.image _ (continuous_id.prod_mk continuous_const).continuous_on) }
end

theorem is_connected.prod [topological_space β] {s : set α} {t : set β}
  (hs : is_connected s) (ht : is_connected t) : is_connected (s ×ˢ t) :=
⟨hs.1.prod ht.1, hs.2.prod ht.2⟩

theorem is_preconnected_univ_pi [Π i, topological_space (π i)] {s : Π i, set (π i)}
  (hs : ∀ i, is_preconnected (s i)) :
  is_preconnected (pi univ s) :=
begin
  rintros u v uo vo hsuv ⟨f, hfs, hfu⟩ ⟨g, hgs, hgv⟩,
  rcases exists_finset_piecewise_mem_of_mem_nhds (uo.mem_nhds hfu) g with ⟨I, hI⟩,
  induction I using finset.induction_on with i I hi ihI,
  { refine ⟨g, hgs, ⟨_, hgv⟩⟩, simpa using hI },
  { rw [finset.piecewise_insert] at hI,
    have := I.piecewise_mem_set_pi hfs hgs,
    refine (hsuv this).elim ihI (λ h, _),
    set S := update (I.piecewise f g) i '' (s i),
    have hsub : S ⊆ pi univ s,
    { refine image_subset_iff.2 (λ z hz, _),
      rwa update_preimage_univ_pi,
      exact λ j hj, this j trivial },
    have hconn : is_preconnected S,
      from (hs i).image _ (continuous_const.update i continuous_id).continuous_on,
    have hSu : (S ∩ u).nonempty,
      from ⟨_, mem_image_of_mem _ (hfs _ trivial), hI⟩,
    have hSv : (S ∩ v).nonempty,
      from ⟨_, ⟨_, this _ trivial, update_eq_self _ _⟩, h⟩,
    refine (hconn u v uo vo (hsub.trans hsuv) hSu hSv).mono _,
    exact inter_subset_inter_left _ hsub }
end

@[simp] theorem is_connected_univ_pi [Π i, topological_space (π i)] {s : Π i, set (π i)} :
  is_connected (pi univ s) ↔ ∀ i, is_connected (s i) :=
begin
  simp only [is_connected, ← univ_pi_nonempty_iff, forall_and_distrib, and.congr_right_iff],
  refine λ hne, ⟨λ hc i, _, is_preconnected_univ_pi⟩,
  rw [← eval_image_univ_pi hne],
  exact hc.image _ (continuous_apply _).continuous_on
end

lemma sigma.is_connected_iff [Π i, topological_space (π i)] {s : set (Σ i, π i)} :
  is_connected s ↔ ∃ i t, is_connected t ∧ s = sigma.mk i '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { obtain ⟨⟨i, x⟩, hx⟩ := hs.nonempty,
    have : s ⊆ range (sigma.mk i),
    { have h : range (sigma.mk i) = sigma.fst ⁻¹' {i}, by { ext, simp },
      rw h,
      exact is_preconnected.subset_left_of_subset_union
        (is_open_sigma_fst_preimage _) (is_open_sigma_fst_preimage {x | x ≠ i})
        (set.disjoint_iff.2 $ λ x hx, hx.2 hx.1)
        (λ y hy, by simp [classical.em]) ⟨⟨i, x⟩, hx, rfl⟩ hs.2 },
    exact ⟨i, sigma.mk i ⁻¹' s,
      hs.preimage_of_open_map sigma_mk_injective is_open_map_sigma_mk this,
      (set.image_preimage_eq_of_subset this).symm⟩ },
  { rintro ⟨i, t, ht, rfl⟩,
    exact ht.image _ continuous_sigma_mk.continuous_on }
end

lemma sigma.is_preconnected_iff [hι : nonempty ι] [Π i, topological_space (π i)]
  {s : set (Σ i, π i)} :
  is_preconnected s ↔ ∃ i t, is_preconnected t ∧ s = sigma.mk i '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { obtain rfl | h := s.eq_empty_or_nonempty,
    { exact ⟨classical.choice hι, ∅, is_preconnected_empty, (set.image_empty _).symm⟩ },
    { obtain ⟨a, t, ht, rfl⟩ := sigma.is_connected_iff.1 ⟨h, hs⟩,
      refine ⟨a, t, ht.is_preconnected, rfl⟩ } },
  { rintro ⟨a, t, ht, rfl⟩,
    exact ht.image _ continuous_sigma_mk.continuous_on }
end

lemma sum.is_connected_iff [topological_space β] {s : set (α ⊕ β)} :
  is_connected s ↔
    (∃ t, is_connected t ∧ s = sum.inl '' t) ∨ ∃ t, is_connected t ∧ s = sum.inr '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { let u : set (α ⊕ β):= range sum.inl,
    let v : set (α ⊕ β) := range sum.inr,
    have hu : is_open u, exact is_open_range_inl,
    obtain ⟨x | x, hx⟩ := hs.nonempty,
    { have h := is_preconnected.subset_left_of_subset_union
        is_open_range_inl is_open_range_inr is_compl_range_inl_range_inr.disjoint
        (show s ⊆ range sum.inl ∪ range sum.inr, by simp) ⟨sum.inl x, hx, x, rfl⟩ hs.2,
      refine or.inl ⟨sum.inl ⁻¹' s, _, _⟩,
      { exact hs.preimage_of_open_map sum.inl_injective open_embedding_inl.is_open_map h },
      { exact (set.image_preimage_eq_of_subset h).symm } },
    { have h := is_preconnected.subset_right_of_subset_union
        is_open_range_inl is_open_range_inr is_compl_range_inl_range_inr.disjoint
        (show s ⊆ range sum.inl ∪ range sum.inr, by simp) ⟨sum.inr x, hx, x, rfl⟩ hs.2,
      refine or.inr ⟨sum.inr ⁻¹' s, _, _⟩,
      { exact hs.preimage_of_open_map sum.inr_injective open_embedding_inr.is_open_map h },
      { exact (set.image_preimage_eq_of_subset h).symm } } },
  { rintro (⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩),
    { exact ht.image _ continuous_inl.continuous_on },
    { exact ht.image _ continuous_inr.continuous_on } }
end

lemma sum.is_preconnected_iff [topological_space β] {s : set (α ⊕ β)} :
  is_preconnected s ↔
    (∃ t, is_preconnected t ∧ s = sum.inl '' t) ∨ ∃ t, is_preconnected t ∧ s = sum.inr '' t :=
begin
  refine ⟨λ hs, _, _⟩,
  { obtain rfl | h := s.eq_empty_or_nonempty,
    { exact or.inl ⟨∅, is_preconnected_empty, (set.image_empty _).symm⟩ },
    obtain ⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩ := sum.is_connected_iff.1 ⟨h, hs⟩,
    { exact or.inl ⟨t, ht.is_preconnected, rfl⟩ },
    { exact or.inr ⟨t, ht.is_preconnected, rfl⟩ } },
  { rintro (⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩),
    { exact ht.image _ continuous_inl.continuous_on },
    { exact ht.image _ continuous_inr.continuous_on } }
end

/-- The connected component of a point is the maximal connected set
that contains this point. -/
def connected_component (x : α) : set α :=
⋃₀ { s : set α | is_preconnected s ∧ x ∈ s }

/-- The connected component of a point inside a set. -/
def connected_component_in (F : set α) (x : F) : set α := coe '' (connected_component x)

theorem mem_connected_component {x : α} : x ∈ connected_component x :=
mem_sUnion_of_mem (mem_singleton x) ⟨is_connected_singleton.is_preconnected, mem_singleton x⟩

theorem is_preconnected_connected_component {x : α} : is_preconnected (connected_component x) :=
is_preconnected_sUnion x _ (λ _, and.right) (λ _, and.left)

theorem is_connected_connected_component {x : α} : is_connected (connected_component x) :=
⟨⟨x, mem_connected_component⟩, is_preconnected_connected_component⟩

theorem is_preconnected.subset_connected_component {x : α} {s : set α}
  (H1 : is_preconnected s) (H2 : x ∈ s) : s ⊆ connected_component x :=
λ z hz, mem_sUnion_of_mem hz ⟨H1, H2⟩

theorem is_connected.subset_connected_component {x : α} {s : set α}
  (H1 : is_connected s) (H2 : x ∈ s) : s ⊆ connected_component x :=
H1.2.subset_connected_component H2

theorem connected_component_eq {x y : α} (h : y ∈ connected_component x) :
  connected_component x = connected_component y :=
eq_of_subset_of_subset
  (is_connected_connected_component.subset_connected_component h)
  (is_connected_connected_component.subset_connected_component
    (set.mem_of_mem_of_subset mem_connected_component
      (is_connected_connected_component.subset_connected_component h)))

lemma connected_component_disjoint {x y : α} (h : connected_component x ≠ connected_component y) :
  disjoint (connected_component x) (connected_component y) :=
set.disjoint_left.2 (λ a h1 h2, h
  ((connected_component_eq h1).trans (connected_component_eq h2).symm))

theorem is_closed_connected_component {x : α} :
  is_closed (connected_component x) :=
closure_eq_iff_is_closed.1 $ subset.antisymm
  (is_connected_connected_component.closure.subset_connected_component
    (subset_closure mem_connected_component))
  subset_closure

lemma continuous.image_connected_component_subset [topological_space β] {f : α → β}
  (h : continuous f) (a : α) : f '' connected_component a ⊆ connected_component (f a) :=
(is_connected_connected_component.image f h.continuous_on).subset_connected_component
  ((mem_image f (connected_component a) (f a)).2 ⟨a, mem_connected_component, rfl⟩)

lemma continuous.maps_to_connected_component [topological_space β] {f : α → β}
  (h : continuous f) (a : α) : maps_to f (connected_component a) (connected_component (f a)) :=
maps_to'.2 $ h.image_connected_component_subset a

theorem irreducible_component_subset_connected_component {x : α} :
  irreducible_component x ⊆ connected_component x :=
is_irreducible_irreducible_component.is_connected.subset_connected_component
  mem_irreducible_component

/-- A preconnected space is one where there is no non-trivial open partition. -/
class preconnected_space (α : Type u) [topological_space α] : Prop :=
(is_preconnected_univ : is_preconnected (univ : set α))

export preconnected_space (is_preconnected_univ)

/-- A connected space is a nonempty one where there is no non-trivial open partition. -/
class connected_space (α : Type u) [topological_space α] extends preconnected_space α : Prop :=
(to_nonempty : nonempty α)

attribute [instance, priority 50] connected_space.to_nonempty -- see Note [lower instance priority]

lemma is_preconnected_range [topological_space β] [preconnected_space α] {f : α → β}
  (h : continuous f) : is_preconnected (range f) :=
@image_univ _ _ f ▸ is_preconnected_univ.image _ h.continuous_on

lemma is_connected_range [topological_space β] [connected_space α] {f : α → β} (h : continuous f) :
  is_connected (range f) :=
⟨range_nonempty f, is_preconnected_range h⟩

lemma dense_range.preconnected_space [topological_space β] [preconnected_space α] {f : α → β}
  (hf : dense_range f) (hc : continuous f) :
  preconnected_space β :=
⟨hf.closure_eq ▸ (is_preconnected_range hc).closure⟩

lemma connected_space_iff_connected_component :
  connected_space α ↔ ∃ x : α, connected_component x = univ :=
begin
  split,
  { rintros ⟨h, ⟨x⟩⟩,
    exactI ⟨x, eq_univ_of_univ_subset $
      is_preconnected_univ.subset_connected_component (mem_univ x)⟩ },
  { rintros ⟨x, h⟩,
    haveI : preconnected_space α := ⟨by { rw ← h, exact is_preconnected_connected_component }⟩,
    exact ⟨⟨x⟩⟩ }
end

lemma preconnected_space_iff_connected_component :
  preconnected_space α ↔ ∀ x : α, connected_component x = univ :=
begin
  split,
  { intros h x,
    exactI (eq_univ_of_univ_subset $
      is_preconnected_univ.subset_connected_component (mem_univ x)) },
  { intros h,
    casesI is_empty_or_nonempty α with hα hα,
    { exact ⟨by { rw (univ_eq_empty_iff.mpr hα), exact is_preconnected_empty }⟩ },
    { exact ⟨by { rw ← h (classical.choice hα), exact is_preconnected_connected_component }⟩ } }
end

@[simp] lemma preconnected_space.connected_component_eq_univ {X : Type*} [topological_space X]
  [h : preconnected_space X] (x : X) : connected_component x = univ :=
preconnected_space_iff_connected_component.mp h x

instance [topological_space β] [preconnected_space α] [preconnected_space β] :
  preconnected_space (α × β) :=
⟨by { rw ← univ_prod_univ, exact is_preconnected_univ.prod is_preconnected_univ }⟩

instance [topological_space β] [connected_space α] [connected_space β] :
  connected_space (α × β) :=
⟨prod.nonempty⟩

instance [Π i, topological_space (π i)] [∀ i, preconnected_space (π i)] :
  preconnected_space (Π i, π i) :=
⟨by { rw ← pi_univ univ, exact is_preconnected_univ_pi (λ i, is_preconnected_univ) }⟩

instance [Π i, topological_space (π i)] [∀ i, connected_space (π i)] : connected_space (Π i, π i) :=
⟨classical.nonempty_pi.2 $ λ i, by apply_instance⟩

@[priority 100] -- see Note [lower instance priority]
instance preirreducible_space.preconnected_space (α : Type u) [topological_space α]
  [preirreducible_space α] : preconnected_space α :=
⟨(preirreducible_space.is_preirreducible_univ α).is_preconnected⟩

@[priority 100] -- see Note [lower instance priority]
instance irreducible_space.connected_space (α : Type u) [topological_space α]
  [irreducible_space α] : connected_space α :=
{ to_nonempty := irreducible_space.to_nonempty α }

theorem nonempty_inter [preconnected_space α] {s t : set α} :
  is_open s → is_open t → s ∪ t = univ → s.nonempty → t.nonempty → (s ∩ t).nonempty :=
by simpa only [univ_inter, univ_subset_iff] using
  @preconnected_space.is_preconnected_univ α _ _ s t

theorem is_clopen_iff [preconnected_space α] {s : set α} : is_clopen s ↔ s = ∅ ∨ s = univ :=
⟨λ hs, classical.by_contradiction $ λ h,
  have h1 : s ≠ ∅ ∧ sᶜ ≠ ∅, from ⟨mt or.inl h,
    mt (λ h2, or.inr $ (by rw [← compl_compl s, h2, compl_empty] : s = univ)) h⟩,
  let ⟨_, h2, h3⟩ := nonempty_inter hs.1 hs.2.is_open_compl (union_compl_self s)
    (ne_empty_iff_nonempty.1 h1.1) (ne_empty_iff_nonempty.1 h1.2) in
  h3 h2,
by rintro (rfl | rfl); [exact is_clopen_empty, exact is_clopen_univ]⟩

lemma eq_univ_of_nonempty_clopen [preconnected_space α] {s : set α}
  (h : s.nonempty) (h' : is_clopen s) : s = univ :=
by { rw is_clopen_iff at h', exact h'.resolve_left h.ne_empty }

lemma subtype.preconnected_space {s : set α} (h : is_preconnected s) :
  preconnected_space s :=
{ is_preconnected_univ := by rwa [← embedding_subtype_coe.to_inducing.is_preconnected_image,
    image_univ, subtype.range_coe] }

lemma subtype.connected_space {s : set α} (h : is_connected s) :
  connected_space s :=
{ to_preconnected_space := subtype.preconnected_space h.is_preconnected,
  to_nonempty := h.nonempty.to_subtype }

lemma is_preconnected_iff_preconnected_space {s : set α} :
  is_preconnected s ↔ preconnected_space s :=
⟨subtype.preconnected_space,
 begin
   introI,
   simpa using is_preconnected_univ.image (coe : s → α) continuous_subtype_coe.continuous_on
 end⟩

lemma is_connected_iff_connected_space {s : set α} : is_connected s ↔ connected_space s :=
⟨subtype.connected_space,
 λ h, ⟨nonempty_subtype.mp h.2, is_preconnected_iff_preconnected_space.mpr h.1⟩⟩

/-- A set `s` is preconnected if and only if
for every cover by two open sets that are disjoint on `s`,
it is contained in one of the two covering sets. -/
lemma is_preconnected_iff_subset_of_disjoint {s : set α} :
  is_preconnected s ↔
  ∀ (u v : set α) (hu : is_open u) (hv : is_open v) (hs : s ⊆ u ∪ v) (huv : s ∩ (u ∩ v) = ∅),
  s ⊆ u ∨ s ⊆ v :=
begin
  split; intro h,
  { intros u v hu hv hs huv,
    specialize h u v hu hv hs,
    contrapose! huv,
    rw ne_empty_iff_nonempty,
    simp [not_subset] at huv,
    rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
    have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
    have hyu : y ∈ u := or_iff_not_imp_right.mp (hs hys) hyv,
    exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
  { intros u v hu hv hs hsu hsv,
    rw ← ne_empty_iff_nonempty,
    intro H,
    specialize h u v hu hv hs H,
    contrapose H,
    apply ne_empty_iff_nonempty.mpr,
    cases h,
    { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
    { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
end

/-- A set `s` is connected if and only if
for every cover by a finite collection of open sets that are pairwise disjoint on `s`,
it is contained in one of the members of the collection. -/
lemma is_connected_iff_sUnion_disjoint_open {s : set α} :
  is_connected s ↔
  ∀ (U : finset (set α)) (H : ∀ (u v : set α), u ∈ U → v ∈ U → (s ∩ (u ∩ v)).nonempty → u = v)
  (hU : ∀ u ∈ U, is_open u) (hs : s ⊆ ⋃₀ ↑U),
  ∃ u ∈ U, s ⊆ u :=
begin
  rw [is_connected, is_preconnected_iff_subset_of_disjoint],
  split; intro h,
  { intro U, apply finset.induction_on U,
    { rcases h.left,
      suffices : s ⊆ ∅ → false, { simpa },
      intro, solve_by_elim },
    { intros u U hu IH hs hU H,
      rw [finset.coe_insert, sUnion_insert] at H,
      cases h.2 u (⋃₀ ↑U) _ _ H _ with hsu hsU,
      { exact ⟨u, finset.mem_insert_self _ _, hsu⟩ },
      { rcases IH _ _ hsU with ⟨v, hvU, hsv⟩,
        { exact ⟨v, finset.mem_insert_of_mem hvU, hsv⟩ },
        { intros, apply hs; solve_by_elim [finset.mem_insert_of_mem] },
        { intros, solve_by_elim [finset.mem_insert_of_mem] } },
      { solve_by_elim [finset.mem_insert_self] },
      { apply is_open_sUnion,
        intros, solve_by_elim [finset.mem_insert_of_mem] },
      { apply eq_empty_of_subset_empty,
        rintro x ⟨hxs, hxu, hxU⟩,
        rw mem_sUnion at hxU,
        rcases hxU with ⟨v, hvU, hxv⟩,
        rcases hs u v (finset.mem_insert_self _ _) (finset.mem_insert_of_mem hvU) _ with rfl,
        { contradiction },
        { exact ⟨x, hxs, hxu, hxv⟩ } } } },
  { split,
    { rw ← ne_empty_iff_nonempty,
      by_contradiction hs, subst hs,
      simpa using h ∅ _ _ _; simp },
    intros u v hu hv hs hsuv,
    rcases h {u, v} _ _ _ with ⟨t, ht, ht'⟩,
    { rw [finset.mem_insert, finset.mem_singleton] at ht,
      rcases ht with rfl|rfl; tauto },
    { intros t₁ t₂ ht₁ ht₂ hst,
      rw ← ne_empty_iff_nonempty at hst,
      rw [finset.mem_insert, finset.mem_singleton] at ht₁ ht₂,
      rcases ht₁ with rfl|rfl; rcases ht₂ with rfl|rfl,
      all_goals { refl <|> contradiction <|> skip },
      rw inter_comm t₁ at hst, contradiction },
    { intro t,
      rw [finset.mem_insert, finset.mem_singleton],
      rintro (rfl|rfl); assumption },
    { simpa using hs } }
end

/-- Preconnected sets are either contained in or disjoint to any given clopen set. -/
theorem is_preconnected.subset_clopen {s t : set α} (hs : is_preconnected s) (ht : is_clopen t)
  (hne : (s ∩ t).nonempty) : s ⊆ t :=
begin
  by_contra h,
  have : (s ∩ tᶜ).nonempty := inter_compl_nonempty_iff.2 h,
  obtain ⟨x, -, hx, hx'⟩ : (s ∩ (t ∩ tᶜ)).nonempty,
    from hs t tᶜ ht.is_open ht.compl.is_open (λ x hx, em _) hne this,
  exact hx' hx
end

/-- Preconnected sets are either contained in or disjoint to any given clopen set. -/
theorem disjoint_or_subset_of_clopen {s t : set α} (hs : is_preconnected s) (ht : is_clopen t) :
  disjoint s t ∨ s ⊆ t :=
(disjoint_or_nonempty_inter s t).imp_right $ hs.subset_clopen ht

/-- A set `s` is preconnected if and only if
for every cover by two closed sets that are disjoint on `s`,
it is contained in one of the two covering sets. -/
theorem is_preconnected_iff_subset_of_disjoint_closed :
  is_preconnected s ↔
    ∀ (u v : set α) (hu : is_closed u) (hv : is_closed v) (hs : s ⊆ u ∪ v) (huv : s ∩ (u ∩ v) = ∅),
      s ⊆ u ∨ s ⊆ v :=
begin
  split; intro h,
  { intros u v hu hv hs huv,
    rw is_preconnected_closed_iff at h,
    specialize h u v hu hv hs,
    contrapose! huv,
    rw ne_empty_iff_nonempty,
    simp [not_subset] at huv,
    rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
    have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
    have hyu : y ∈ u := or_iff_not_imp_right.mp (hs hys) hyv,
    exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
  { rw is_preconnected_closed_iff,
    intros u v hu hv hs hsu hsv,
    rw ← ne_empty_iff_nonempty,
    intro H,
    specialize h u v hu hv hs H,
    contrapose H,
    apply ne_empty_iff_nonempty.mpr,
    cases h,
    { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
    { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
end

/-- A closed set `s` is preconnected if and only if
for every cover by two closed sets that are disjoint,
it is contained in one of the two covering sets. -/
theorem is_preconnected_iff_subset_of_fully_disjoint_closed {s : set α} (hs : is_closed s) :
  is_preconnected s ↔
  ∀ (u v : set α) (hu : is_closed u) (hv : is_closed v) (hss : s ⊆ u ∪ v) (huv : u ∩ v = ∅),
  s ⊆ u ∨ s ⊆ v :=
begin
  split,
  { intros h u v hu hv hss huv,
    apply is_preconnected_iff_subset_of_disjoint_closed.1 h u v hu hv hss,
    rw huv,
    exact inter_empty s },
  intro H,
  rw is_preconnected_iff_subset_of_disjoint_closed,
  intros u v hu hv hss huv,
  have H1 := H (u ∩ s) (v ∩ s),
  rw [subset_inter_iff, subset_inter_iff] at H1,
  simp only [subset.refl, and_true] at H1,
  apply H1 (is_closed.inter hu hs) (is_closed.inter hv hs),
  { rw ←inter_distrib_right,
    apply subset_inter_iff.2,
    exact ⟨hss, subset.refl s⟩ },
  { rw [inter_comm v s, inter_assoc, ←inter_assoc s, inter_self s,
        inter_comm, inter_assoc, inter_comm v u, huv] }
end

lemma is_clopen.connected_component_subset {x} (hs : is_clopen s) (hx : x ∈ s) :
  connected_component x ⊆ s :=
is_preconnected_connected_component.subset_clopen hs ⟨x, mem_connected_component, hx⟩

/-- The connected component of a point is always a subset of the intersection of all its clopen
neighbourhoods. -/
lemma connected_component_subset_Inter_clopen {x : α} :
  connected_component x ⊆ ⋂ Z : {Z : set α // is_clopen Z ∧ x ∈ Z}, Z :=
subset_Inter $ λ Z, Z.2.1.connected_component_subset Z.2.2

/-- A clopen set is the union of its connected components. -/
lemma is_clopen.bUnion_connected_component_eq {Z : set α} (h : is_clopen Z) :
  (⋃ x ∈ Z, connected_component x) = Z :=
subset.antisymm (Union₂_subset $ λ x, h.connected_component_subset) $
  λ x hx, mem_Union₂_of_mem hx mem_connected_component

/-- The preimage of a connected component is preconnected if the function has connected fibers
and a subset is closed iff the preimage is. -/
lemma preimage_connected_component_connected [topological_space β] {f : α → β}
  (connected_fibers : ∀ t : β, is_connected (f ⁻¹' {t}))
  (hcl : ∀ (T : set β), is_closed T ↔ is_closed (f ⁻¹' T)) (t : β) :
  is_connected (f ⁻¹' connected_component t) :=
begin
  -- The following proof is essentially https://stacks.math.columbia.edu/tag/0377
  -- although the statement is slightly different
  have hf : surjective f := surjective.of_comp (λ t : β, (connected_fibers t).1),

  split,
  { cases hf t with s hs,
    use s,
    rw [mem_preimage, hs],
    exact mem_connected_component },

  have hT : is_closed (f ⁻¹' connected_component t) :=
    (hcl (connected_component t)).1 is_closed_connected_component,

  -- To show it's preconnected we decompose (f ⁻¹' connected_component t) as a subset of two
  -- closed disjoint sets in α. We want to show that it's a subset of either.
  rw is_preconnected_iff_subset_of_fully_disjoint_closed hT,
  intros u v hu hv huv uv_disj,

  -- To do this we decompose connected_component t into T₁ and T₂
  -- we will show that connected_component t is a subset of either and hence
  -- (f ⁻¹' connected_component t) is a subset of u or v
  let T₁ := {t' ∈ connected_component t | f ⁻¹' {t'} ⊆ u},
  let T₂ := {t' ∈ connected_component t | f ⁻¹' {t'} ⊆ v},

  have fiber_decomp : ∀ t' ∈ connected_component t, f ⁻¹' {t'} ⊆ u ∨ f ⁻¹' {t'} ⊆ v,
  { intros t' ht',
    apply is_preconnected_iff_subset_of_disjoint_closed.1 (connected_fibers t').2 u v hu hv,
    { exact subset.trans (hf.preimage_subset_preimage_iff.2 (singleton_subset_iff.2 ht')) huv },
    rw uv_disj,
    exact inter_empty _ },

  have T₁_u : f ⁻¹' T₁ = (f ⁻¹' connected_component t) ∩ u,
  { apply eq_of_subset_of_subset,
    { rw ←bUnion_preimage_singleton,
      refine Union₂_subset (λ t' ht', subset_inter _ ht'.2),
      rw [hf.preimage_subset_preimage_iff, singleton_subset_iff],
      exact ht'.1 },
    rintros a ⟨hat, hau⟩,
    constructor,
    { exact mem_preimage.1 hat },
    dsimp only,
    cases fiber_decomp (f a) (mem_preimage.1 hat),
    { exact h },
    { exfalso,
      rw ←not_nonempty_iff_eq_empty at uv_disj,
      exact uv_disj (nonempty_of_mem (mem_inter hau (h rfl))) } },
  -- This proof is exactly the same as the above (modulo some symmetry)
  have T₂_v : f ⁻¹' T₂ = (f ⁻¹' connected_component t) ∩ v,
  { apply eq_of_subset_of_subset,
    { rw ←bUnion_preimage_singleton,
      refine Union₂_subset (λ t' ht', subset_inter _ ht'.2),
      rw [hf.preimage_subset_preimage_iff, singleton_subset_iff],
      exact ht'.1 },
    rintros a ⟨hat, hav⟩,
    constructor,
    { exact mem_preimage.1 hat },
    dsimp only,
    cases fiber_decomp (f a) (mem_preimage.1 hat),
    { exfalso,
      rw ←not_nonempty_iff_eq_empty at uv_disj,
      exact uv_disj (nonempty_of_mem (mem_inter (h rfl) hav)) },
    { exact h } },

  -- Now we show T₁, T₂ are closed, cover connected_component t and are disjoint.
  have hT₁ : is_closed T₁ := ((hcl T₁).2 (T₁_u.symm ▸ (is_closed.inter hT hu))),
  have hT₂ : is_closed T₂ := ((hcl T₂).2 (T₂_v.symm ▸ (is_closed.inter hT hv))),

  have T_decomp : connected_component t ⊆ T₁ ∪ T₂,
  { intros t' ht',
    rw mem_union t' T₁ T₂,
    cases fiber_decomp t' ht' with htu htv,
    { left, exact ⟨ht', htu⟩ },
    right, exact ⟨ht', htv⟩ },

  have T_disjoint : T₁ ∩ T₂ = ∅,
  { rw ←image_preimage_eq (T₁ ∩ T₂) hf,
    suffices : f ⁻¹' (T₁ ∩ T₂) = ∅,
    { rw this, exact image_empty _ },
    rw [preimage_inter, T₁_u, T₂_v],
    rw inter_comm at uv_disj,
    conv
    { congr,
      rw [inter_assoc],
      congr, skip,
      rw [←inter_assoc, inter_comm, ←inter_assoc, uv_disj, empty_inter], },
    exact inter_empty _ },

  -- Now we do cases on whether (connected_component t) is a subset of T₁ or T₂ to show
  -- that the preimage is a subset of u or v.
  cases (is_preconnected_iff_subset_of_fully_disjoint_closed is_closed_connected_component).1
    is_preconnected_connected_component T₁ T₂ hT₁ hT₂ T_decomp T_disjoint,
  { left,
    rw subset.antisymm_iff at T₁_u,
    suffices : f ⁻¹' connected_component t ⊆ f ⁻¹' T₁,
    { exact subset.trans (subset.trans this T₁_u.1) (inter_subset_right _ _) },
    exact preimage_mono h },
  right,
  rw subset.antisymm_iff at T₂_v,
  suffices : f ⁻¹' connected_component t ⊆ f ⁻¹' T₂,
  { exact subset.trans (subset.trans this T₂_v.1) (inter_subset_right _ _) },
  exact preimage_mono h,
end

lemma quotient_map.preimage_connected_component [topological_space β] {f : α → β}
  (hf : quotient_map f) (h_fibers : ∀ y : β, is_connected (f ⁻¹' {y})) (a : α) :
  f ⁻¹' connected_component (f a) = connected_component a :=
((preimage_connected_component_connected h_fibers
  (λ _, hf.is_closed_preimage.symm) _).subset_connected_component mem_connected_component).antisymm
  (hf.continuous.maps_to_connected_component a)

lemma quotient_map.image_connected_component [topological_space β] {f : α → β}
  (hf : quotient_map f) (h_fibers : ∀ y : β, is_connected (f ⁻¹' {y})) (a : α) :
  f '' connected_component a = connected_component (f a) :=
by rw [← hf.preimage_connected_component h_fibers, image_preimage_eq _ hf.surjective]

end preconnected

section totally_disconnected

/-- A set `s` is called totally disconnected if every subset `t ⊆ s` which is preconnected is
a subsingleton, ie either empty or a singleton.-/
def is_totally_disconnected (s : set α) : Prop :=
∀ t, t ⊆ s → is_preconnected t → t.subsingleton

theorem is_totally_disconnected_empty : is_totally_disconnected (∅ : set α) :=
λ _ ht _ _ x_in _ _, (ht x_in).elim

theorem is_totally_disconnected_singleton {x} : is_totally_disconnected ({x} : set α) :=
λ _ ht _, subsingleton.mono subsingleton_singleton ht

/-- A space is totally disconnected if all of its connected components are singletons. -/
class totally_disconnected_space (α : Type u) [topological_space α] : Prop :=
(is_totally_disconnected_univ : is_totally_disconnected (univ : set α))

lemma is_preconnected.subsingleton [totally_disconnected_space α]
  {s : set α} (h : is_preconnected s) : s.subsingleton :=
totally_disconnected_space.is_totally_disconnected_univ s (subset_univ s) h

instance pi.totally_disconnected_space {α : Type*} {β : α → Type*}
  [t₂ : Πa, topological_space (β a)] [∀a, totally_disconnected_space (β a)] :
  totally_disconnected_space (Π (a : α), β a) :=
⟨λ t h1 h2,
  have this : ∀ a, is_preconnected ((λ x : Π a, β a, x a) '' t),
    from λ a, h2.image (λ x, x a) (continuous_apply a).continuous_on,
  λ x x_in y y_in, funext $ λ a, (this a).subsingleton ⟨x, x_in, rfl⟩ ⟨y, y_in, rfl⟩⟩

instance prod.totally_disconnected_space [topological_space β]
  [totally_disconnected_space α] [totally_disconnected_space β] :
  totally_disconnected_space (α × β) :=
⟨λ t h1 h2,
have H1 : is_preconnected (prod.fst '' t), from h2.image prod.fst continuous_fst.continuous_on,
have H2 : is_preconnected (prod.snd '' t), from h2.image prod.snd continuous_snd.continuous_on,
λ x hx y hy, prod.ext
  (H1.subsingleton ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩)
  (H2.subsingleton ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩)⟩

instance [topological_space β] [totally_disconnected_space α] [totally_disconnected_space β] :
  totally_disconnected_space (α ⊕ β) :=
begin
  refine ⟨λ s _ hs, _⟩,
  obtain (⟨t, ht, rfl⟩ | ⟨t, ht, rfl⟩) := sum.is_preconnected_iff.1 hs,
  { exact ht.subsingleton.image _ },
  { exact ht.subsingleton.image _ }
end

instance [Π i, topological_space (π i)] [∀ i, totally_disconnected_space (π i)] :
  totally_disconnected_space (Σ i, π i) :=
begin
  refine ⟨λ s _ hs, _⟩,
  obtain rfl | h := s.eq_empty_or_nonempty,
  { exact subsingleton_empty },
  { obtain ⟨a, t, ht, rfl⟩ := sigma.is_connected_iff.1 ⟨h, hs⟩,
    exact ht.is_preconnected.subsingleton.image _ }
end

/-- A space is totally disconnected iff its connected components are subsingletons. -/
lemma totally_disconnected_space_iff_connected_component_subsingleton :
  totally_disconnected_space α ↔ ∀ x : α, (connected_component x).subsingleton :=
begin
  split,
  { intros h x,
    apply h.1,
    { exact subset_univ _ },
    exact is_preconnected_connected_component },
  intro h, constructor,
  intros s s_sub hs,
  rcases eq_empty_or_nonempty s with rfl | ⟨x, x_in⟩,
  { exact subsingleton_empty },
  { exact (h x).mono (hs.subset_connected_component x_in) }
end

/-- A space is totally disconnected iff its connected components are singletons. -/
lemma totally_disconnected_space_iff_connected_component_singleton :
  totally_disconnected_space α ↔ ∀ x : α, connected_component x = {x} :=
begin
  rw totally_disconnected_space_iff_connected_component_subsingleton,
  apply forall_congr (λ x, _),
  rw subsingleton_iff_singleton,
  exact mem_connected_component
end

/-- The image of a connected component in a totally disconnected space is a singleton. -/
@[simp] lemma continuous.image_connected_component_eq_singleton {β : Type*} [topological_space β]
  [totally_disconnected_space β] {f : α → β} (h : continuous f) (a : α) :
  f '' connected_component a = {f a} :=
(set.subsingleton_iff_singleton $ mem_image_of_mem f mem_connected_component).mp
  (is_preconnected_connected_component.image f h.continuous_on).subsingleton

lemma is_totally_disconnected_of_totally_disconnected_space [totally_disconnected_space α]
  (s : set α) : is_totally_disconnected s :=
λ t hts ht, totally_disconnected_space.is_totally_disconnected_univ _ t.subset_univ ht

lemma is_totally_disconnected_of_image [topological_space β] {f : α → β} (hf : continuous_on f s)
  (hf' : injective f) (h : is_totally_disconnected (f '' s)) : is_totally_disconnected s :=
λ t hts ht x x_in y y_in, hf' $ h _ (image_subset f hts) (ht.image f $ hf.mono hts)
  (mem_image_of_mem f x_in) (mem_image_of_mem f y_in)

lemma embedding.is_totally_disconnected [topological_space β] {f : α → β} (hf : embedding f)
  {s : set α} (h : is_totally_disconnected (f '' s)) : is_totally_disconnected s :=
is_totally_disconnected_of_image hf.continuous.continuous_on hf.inj h

instance subtype.totally_disconnected_space {α : Type*} {p : α → Prop} [topological_space α]
  [totally_disconnected_space α] : totally_disconnected_space (subtype p) :=
⟨embedding_subtype_coe.is_totally_disconnected
  (is_totally_disconnected_of_totally_disconnected_space _)⟩

end totally_disconnected

section totally_separated

/-- A set `s` is called totally separated if any two points of this set can be separated
by two disjoint open sets covering `s`. -/
def is_totally_separated (s : set α) : Prop :=
∀ x ∈ s, ∀ y ∈ s, x ≠ y → ∃ u v : set α, is_open u ∧ is_open v ∧
  x ∈ u ∧ y ∈ v ∧ s ⊆ u ∪ v ∧ u ∩ v = ∅

theorem is_totally_separated_empty : is_totally_separated (∅ : set α) :=
λ x, false.elim

theorem is_totally_separated_singleton {x} : is_totally_separated ({x} : set α) :=
λ p hp q hq hpq, (hpq $ (eq_of_mem_singleton hp).symm ▸ (eq_of_mem_singleton hq).symm).elim

theorem is_totally_disconnected_of_is_totally_separated {s : set α}
  (H : is_totally_separated s) : is_totally_disconnected s :=
begin
  intros t hts ht x x_in y y_in,
  by_contra h,
  obtain ⟨u : set α, v : set α, hu : is_open u, hv : is_open v,
          hxu : x ∈ u, hyv : y ∈ v, hs : s ⊆ u ∪ v, huv : u ∩ v = ∅⟩ :=
    H x (hts x_in) y (hts y_in) h,
  have : (t ∩ u).nonempty → (t ∩ v).nonempty → (t ∩ (u ∩ v)).nonempty :=
    ht _ _ hu hv (subset.trans hts hs),
  obtain ⟨z, hz : z ∈ t ∩ (u ∩ v)⟩ := this ⟨x, x_in, hxu⟩ ⟨y, y_in, hyv⟩,
  simpa [huv] using hz
end

alias is_totally_disconnected_of_is_totally_separated ← is_totally_separated.is_totally_disconnected

/-- A space is totally separated if any two points can be separated by two disjoint open sets
covering the whole space. -/
class totally_separated_space (α : Type u) [topological_space α] : Prop :=
(is_totally_separated_univ [] : is_totally_separated (univ : set α))

@[priority 100] -- see Note [lower instance priority]
instance totally_separated_space.totally_disconnected_space (α : Type u) [topological_space α]
  [totally_separated_space α] : totally_disconnected_space α :=
⟨is_totally_disconnected_of_is_totally_separated $
  totally_separated_space.is_totally_separated_univ α⟩

@[priority 100] -- see Note [lower instance priority]
instance totally_separated_space.of_discrete
  (α : Type*) [topological_space α] [discrete_topology α] : totally_separated_space α :=
⟨λ a _ b _ h, ⟨{b}ᶜ, {b}, is_open_discrete _, is_open_discrete _, by simpa⟩⟩

lemma exists_clopen_of_totally_separated {α : Type*} [topological_space α]
  [totally_separated_space α] {x y : α} (hxy : x ≠ y) :
  ∃ (U : set α) (hU : is_clopen U), x ∈ U ∧ y ∈ Uᶜ :=
begin
  obtain ⟨U, V, hU, hV, Ux, Vy, f, disj⟩ :=
    totally_separated_space.is_totally_separated_univ α x (set.mem_univ x) y (set.mem_univ y) hxy,
  have clopen_U := is_clopen_inter_of_disjoint_cover_clopen (is_clopen_univ) f hU hV disj,
  rw univ_inter _ at clopen_U,
  rw [←set.subset_compl_iff_disjoint, subset_compl_comm] at disj,
  exact ⟨U, clopen_U, Ux, disj Vy⟩,
end

end totally_separated

section connected_component_setoid

/-- The setoid of connected components of a topological space -/
def connected_component_setoid (α : Type*) [topological_space α] : setoid α :=
⟨λ x y, connected_component x = connected_component y,
  ⟨λ x, by trivial, λ x y h1, h1.symm, λ x y z h1 h2, h1.trans h2⟩⟩

/-- The quotient of a space by its connected components -/
def connected_components (α : Type u) [topological_space α] :=
quotient (connected_component_setoid α)

instance : has_coe_t α (connected_components α) := ⟨quotient.mk'⟩

namespace connected_components

@[simp] lemma coe_eq_coe {x y : α} :
  (x : connected_components α) = y ↔ connected_component x = connected_component y :=
quotient.eq'

lemma coe_ne_coe {x y : α} :
  (x : connected_components α) ≠ y ↔ connected_component x ≠ connected_component y :=
not_congr coe_eq_coe

lemma coe_eq_coe' {x y : α} :
  (x : connected_components α) = y ↔ x ∈ connected_component y :=
coe_eq_coe.trans ⟨λ h, h ▸ mem_connected_component, λ h, (connected_component_eq h).symm⟩

instance [inhabited α] : inhabited (connected_components α) := ⟨↑(default : α)⟩

instance : topological_space (connected_components α) :=
quotient.topological_space

lemma surjective_coe : surjective (coe : α → connected_components α) := surjective_quot_mk _
lemma quotient_map_coe : quotient_map (coe : α → connected_components α) := quotient_map_quot_mk

@[continuity]
lemma continuous_coe : continuous (coe : α → connected_components α) := quotient_map_coe.continuous

@[simp] lemma range_coe : range (coe : α → connected_components α)= univ :=
surjective_coe.range_eq

end connected_components

variables [topological_space β] [totally_disconnected_space β] {f : α → β}

lemma continuous.image_eq_of_connected_component_eq (h : continuous f) (a b : α)
  (hab : connected_component a = connected_component b) : f a = f b :=
singleton_eq_singleton_iff.1 $
  h.image_connected_component_eq_singleton a ▸
  h.image_connected_component_eq_singleton b ▸ hab ▸ rfl

/--
The lift to `connected_components α` of a continuous map from `α` to a totally disconnected space
-/
def continuous.connected_components_lift (h : continuous f) :
  connected_components α → β :=
λ x, quotient.lift_on' x f h.image_eq_of_connected_component_eq

@[continuity] lemma continuous.connected_components_lift_continuous (h : continuous f) :
  continuous h.connected_components_lift :=
continuous_quotient_lift_on' h.image_eq_of_connected_component_eq h

@[simp] lemma continuous.connected_components_lift_apply_coe (h : continuous f) (x : α) :
  h.connected_components_lift x = f x := rfl

@[simp] lemma continuous.connected_components_lift_comp_coe (h : continuous f) :
  h.connected_components_lift ∘ coe = f := rfl

lemma connected_components_lift_unique' {β : Sort*} {g₁ g₂ : connected_components α → β}
  (hg : g₁ ∘ (coe : α → connected_components α) = g₂ ∘ coe) :
  g₁ = g₂ :=
connected_components.surjective_coe.injective_comp_right hg

lemma continuous.connected_components_lift_unique (h : continuous f)
  (g : connected_components α → β) (hg : g ∘ coe = f) : g = h.connected_components_lift :=
connected_components_lift_unique' $ hg.trans h.connected_components_lift_comp_coe.symm

/-- The preimage of a singleton in `connected_components` is the connected component
of an element in the equivalence class. -/
lemma connected_components_preimage_singleton {x : α} :
  coe ⁻¹' ({x} : set (connected_components α)) = connected_component x :=
by { ext y, simp [connected_components.coe_eq_coe'] }

/-- The preimage of the image of a set under the quotient map to `connected_components α`
is the union of the connected components of the elements in it. -/
lemma connected_components_preimage_image (U : set α) :
  coe ⁻¹' (coe '' U : set (connected_components α)) = ⋃ x ∈ U, connected_component x :=
by simp only [connected_components_preimage_singleton, preimage_Union₂, image_eq_Union]

instance connected_components.totally_disconnected_space :
  totally_disconnected_space (connected_components α) :=
begin
  rw totally_disconnected_space_iff_connected_component_singleton,
  refine connected_components.surjective_coe.forall.2 (λ x, _),
  rw [← connected_components.quotient_map_coe.image_connected_component,
    ← connected_components_preimage_singleton,
    image_preimage_eq _ connected_components.surjective_coe],
  refine connected_components.surjective_coe.forall.2 (λ y, _),
  rw connected_components_preimage_singleton,
  exact is_connected_connected_component
end

/-- Functoriality of `connected_components` -/
def continuous.connected_components_map {β : Type*} [topological_space β] {f : α → β}
  (h : continuous f) : connected_components α → connected_components β :=
continuous.connected_components_lift (continuous_quotient_mk.comp h)

lemma continuous.connected_components_map_continuous {β : Type*} [topological_space β] {f : α → β}
  (h : continuous f) : continuous h.connected_components_map :=
continuous.connected_components_lift_continuous (continuous_quotient_mk.comp h)

end connected_component_setoid