/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Patrick Massot, Scott Morrison
-/
import category_theory.monad.limits
import topology.uniform_space.completion
import topology.category.Top.basic

/-!
# The category of uniform spaces

We construct the category of uniform spaces, show that the complete separated uniform spaces
form a reflective subcategory, and hence possess all limits that uniform spaces do.

TODO: show that uniform spaces actually have all limits!
-/

universes u

open category_theory

/-- A (bundled) uniform space. -/
def UniformSpace : Type (u+1) := bundled uniform_space

namespace UniformSpace

/-- The information required to build morphisms for `UniformSpace`. -/
instance : unbundled_hom @uniform_continuous :=
⟨@uniform_continuous_id, @uniform_continuous.comp⟩

attribute [derive [has_coe_to_sort, large_category, concrete_category]] UniformSpace

instance (x : UniformSpace) : uniform_space x := x.str

/-- Construct a bundled `UniformSpace` from the underlying type and the typeclass. -/
def of (α : Type u) [uniform_space α] : UniformSpace := ⟨α⟩

instance : inhabited UniformSpace := ⟨UniformSpace.of empty⟩

@[simp] lemma coe_of (X : Type u) [uniform_space X] : (of X : Type u) = X := rfl

instance (X Y : UniformSpace) : has_coe_to_fun (X ⟶ Y) :=
{ F := λ _, X → Y, coe := category_theory.functor.map (forget UniformSpace) }

@[simp] lemma coe_comp {X Y Z : UniformSpace} (f : X ⟶ Y) (g : Y ⟶ Z) :
  (f ≫ g : X → Z) = g ∘ f := rfl
@[simp] lemma coe_id (X : UniformSpace) : (𝟙 X : X → X) = id := rfl
@[simp] lemma coe_mk {X Y : UniformSpace} (f : X → Y) (hf : uniform_continuous f) :
  ((⟨f, hf⟩ : X ⟶ Y) : X → Y) = f := rfl

lemma hom_ext {X Y : UniformSpace} {f g : X ⟶ Y} : (f : X → Y) = g → f = g := subtype.eq

/-- The forgetful functor from uniform spaces to topological spaces. -/
instance has_forget_to_Top : has_forget₂ UniformSpace.{u} Top.{u} :=
{ forget₂ :=
  { obj := λ X, Top.of X,
    map := λ X Y f, { to_fun := f,
                      continuous_to_fun := uniform_continuous.continuous f.property }, }, }

end UniformSpace

/-- A (bundled) complete separated uniform space. -/
structure CpltSepUniformSpace :=
(α : Type u)
[is_uniform_space : uniform_space α]
[is_complete_space : complete_space α]
[is_separated : separated_space α]

namespace CpltSepUniformSpace

instance : has_coe_to_sort CpltSepUniformSpace :=
{ S := Type u, coe := CpltSepUniformSpace.α }

attribute [instance] is_uniform_space is_complete_space is_separated

def to_UniformSpace (X : CpltSepUniformSpace) : UniformSpace :=
UniformSpace.of X

instance complete_space (X : CpltSepUniformSpace) : complete_space ((to_UniformSpace X).α) :=
CpltSepUniformSpace.is_complete_space X

instance separated_space (X : CpltSepUniformSpace) : separated_space ((to_UniformSpace X).α) :=
CpltSepUniformSpace.is_separated X

/-- Construct a bundled `UniformSpace` from the underlying type and the appropriate typeclasses. -/
def of (X : Type u) [uniform_space X] [complete_space X] [separated_space X] :
CpltSepUniformSpace := ⟨X⟩

@[simp] lemma coe_of (X : Type u) [uniform_space X] [complete_space X] [separated_space X] :
  (of X : Type u) = X := rfl

instance : inhabited CpltSepUniformSpace :=
begin
  haveI : separated_space empty := separated_iff_t2.mpr (by apply_instance),
  exact ⟨CpltSepUniformSpace.of empty⟩
end

/-- The category instance on `CpltSepUniformSpace`. -/
instance category : large_category CpltSepUniformSpace :=
induced_category.category to_UniformSpace

/-- The concrete category instance on `CpltSepUniformSpace`. -/
instance concrete_category : concrete_category CpltSepUniformSpace :=
induced_category.concrete_category to_UniformSpace

instance has_forget_to_UniformSpace : has_forget₂ CpltSepUniformSpace UniformSpace :=
induced_category.has_forget₂ to_UniformSpace

end CpltSepUniformSpace

namespace UniformSpace

open uniform_space
open CpltSepUniformSpace

/-- The functor turning uniform spaces into complete separated uniform spaces. -/
noncomputable def completion_functor : UniformSpace ⥤ CpltSepUniformSpace :=
{ obj := λ X, CpltSepUniformSpace.of (completion X),
  map := λ X Y f, ⟨completion.map f.1, completion.uniform_continuous_map⟩,
  map_id' := λ X, subtype.eq completion.map_id,
  map_comp' := λ X Y Z f g, subtype.eq (completion.map_comp g.property f.property).symm, }.

/-- The inclusion of a uniform space into its completion. -/
def completion_hom (X : UniformSpace) :
  X ⟶ (forget₂ CpltSepUniformSpace UniformSpace).obj (completion_functor.obj X) :=
{ val := (coe : X → completion X),
  property := completion.uniform_continuous_coe X }

@[simp] lemma completion_hom_val (X : UniformSpace) (x) :
  (completion_hom X) x = (x : completion X) := rfl

/-- The mate of a morphism from a `UniformSpace` to a `CpltSepUniformSpace`. -/
noncomputable def extension_hom {X : UniformSpace} {Y : CpltSepUniformSpace}
  (f : X ⟶ (forget₂ CpltSepUniformSpace UniformSpace).obj Y) :
  completion_functor.obj X ⟶ Y :=
{ val := completion.extension f,
  property := completion.uniform_continuous_extension }

@[simp] lemma extension_hom_val {X : UniformSpace} {Y : CpltSepUniformSpace}
  (f : X ⟶ (forget₂ _ _).obj Y) (x) :
  (extension_hom f) x = completion.extension f x := rfl.

@[simp]

/-- The completion functor is left adjoint to the forgetful functor. -/
noncomputable def adj : completion_functor ⊣ forget₂ CpltSepUniformSpace UniformSpace :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  { to_fun := λ f, completion_hom X ≫ f,
    inv_fun := λ f, extension_hom f,
    left_inv := λ f, by { dsimp, erw extension_comp_coe },
    right_inv := λ f,
    begin
      apply subtype.eq, funext x, cases f,
      exact @completion.extension_coe _ _ _ _ _ (CpltSepUniformSpace.separated_space _) f_property _
    end },
  hom_equiv_naturality_left_symm' := λ X X' Y f g,
  begin
    apply hom_ext, funext x, dsimp,
    erw [coe_comp, ←completion.extension_map],
    refl, exact g.property, exact f.property,
  end }

noncomputable instance : is_right_adjoint (forget₂ CpltSepUniformSpace UniformSpace) :=
⟨completion_functor, adj⟩
noncomputable instance : reflective (forget₂ CpltSepUniformSpace UniformSpace) := {}

open category_theory.limits

-- TODO Once someone defines `has_limits UniformSpace`, turn this into an instance.
example [has_limits.{u} UniformSpace.{u}] : has_limits.{u} CpltSepUniformSpace.{u} :=
has_limits_of_reflective $ forget₂ CpltSepUniformSpace UniformSpace.{u}

end UniformSpace


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import category_theory.category.basic

/-!
# The Kleisli construction on the Type category

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

Define the Kleisli category for (control) monads.
`category_theory/monad/kleisli` defines the general version for a monad on `C`, and demonstrates
the equivalence between the two.

## TODO

Generalise this to work with category_theory.monad
-/

universes u v

namespace category_theory

/-- The Kleisli category on the (type-)monad `m`. Note that the monad is not assumed to be lawful
yet. -/
@[nolint unused_arguments]
def Kleisli (m : Type u → Type v) := Type u

/-- Construct an object of the Kleisli category from a type. -/
def Kleisli.mk (m) (α : Type u) : Kleisli m := α

instance Kleisli.category_struct {m} [monad.{u v} m] : category_struct (Kleisli m) :=
{ hom := λ α β, α → m β,
  id := λ α x, pure x,
  comp := λ X Y Z f g, f >=> g }

instance Kleisli.category {m} [monad.{u v} m] [is_lawful_monad m] : category (Kleisli m) :=
by refine { id_comp' := _, comp_id' := _, assoc' := _ };
   intros; ext; unfold_projs; simp only [(>=>)] with functor_norm

@[simp] lemma Kleisli.id_def {m} [monad m] (α : Kleisli m) :
  𝟙 α = @pure m _ α := rfl

lemma Kleisli.comp_def {m} [monad m] (α β γ : Kleisli m)
  (xs : α ⟶ β) (ys : β ⟶ γ) (a : α) :
  (xs ≫ ys) a = xs a >>= ys := rfl

instance : inhabited (Kleisli id) := ⟨punit⟩
instance {α : Type u} [inhabited α] : inhabited (Kleisli.mk id α) := ⟨show α, from default⟩
end category_theory


import measure_theory.integral.interval_integral
import order.filter.at_top_bot
import measure_theory.integral.integral_eq_improper

open measure_theory filter set topological_space
open_locale ennreal nnreal topological_space

namespace measure_theory

section ae_cover

variables {α ι : Type*} [measurable_space α] (μ : measure α) (l : filter ι)

variables {μ} {l}

section preorder_α

variables [linear_order α] [topological_space α] [order_closed_topology α]
  [opens_measurable_space α] [has_no_atoms μ] {a b : ι → α} {A B : α} (hab : A ≤ B)

lemma eventually_le_nhds
(a b : α) (hab : a < b)
:
∀ᶠ (x : α) in (nhds a), x ≤ b :=
begin
  rw eventually_iff,
  have : {x : α | x ≤ b} = Iic b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Iio b,
  exact ⟨Iio_subset_Iic_self, is_open_Iio, hab⟩,
end

lemma eventually_lt_nhds
(a b : α) (hab : a < b)
:
∀ᶠ (x : α) in (nhds a), x < b :=
begin
  rw eventually_iff,
  have : {x : α | x < b} = Iio b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Iio b,
  exact ⟨rfl.subset, is_open_Iio, hab⟩,
end

lemma eventually_ge_nhds
(a b : α) (hab : b < a)
:
∀ᶠ (x : α) in (nhds a), b ≤ x :=
begin
  rw eventually_iff,
  have : {x : α | b ≤ x} = Ici b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Ioi b,
  exact ⟨Ioi_subset_Ici_self, is_open_Ioi, hab⟩,
end

lemma eventually_gt_nhds
(a b : α) (hab : b < a)
:
∀ᶠ (x : α) in (nhds a), b < x :=
begin
  rw eventually_iff,
  have : {x : α | b < x} = Ioi b, ext, simp,
  rw this,
  rw mem_nhds_iff,
  use Ioi b,
  exact ⟨rfl.subset, is_open_Ioi, hab⟩,
end

/-! ### finite ae covers by finite intervals

TODO: Pull out the `of_Icc`'s into a `preorder` section since that's all that's required
-/

lemma ae_eq_restrict_aux
{s t : set α}
(hs : measurable_set s) (ht : measurable_set t)
(hst : s =ᵐ[μ] t)
{f : α → Prop} :
(∀ᵐ (x : α) ∂μ.restrict s, f x) → (∀ᵐ (x : α) ∂μ.restrict t, f x) :=
begin
  rw [ae_restrict_iff' hs, ae_restrict_iff' ht, ae_iff, ae_iff],
  simp only [not_forall, exists_prop],
  intros h,
  have aa : {a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ t ∧ ¬f a} = {a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ (t \ s) ∧ ¬f a},
  {
    ext,
    simp only [mem_union_eq, mem_set_of_eq, mem_diff],
    conv { congr, congr, rw and_comm, skip, rw and_comm, skip, congr, rw and_comm, skip, rw and_comm, },
    rw [←and_or_distrib_left, ←and_or_distrib_left, and.congr_right_iff],
    intros hf,
    rw [←mem_union, ←mem_diff, ←mem_union],
    conv { to_rhs, rw union_comm, rw diff_union_self, rw union_comm, },
  },
  have bb : {a : α | a ∈ t ∧ ¬f a} ⊆ {a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ t ∧ ¬f a}, simp,
  have cc : μ ({a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ t ∧ ¬f a}) = 0, {
    rw aa,
    have : μ ({a : α | a ∈ s ∧ ¬f a} ∪ {a : α | a ∈ (t \ s) ∧ ¬f a}) ≤ μ {a : α | a ∈ s ∧ ¬f a} + μ {a : α | a ∈ (t \ s) ∧ ¬f a}, exact measure_union_le _ _,
    rw h at this,
    rw ae_eq_set at hst,
    have dd : {a : α | a ∈ (t \ s) ∧ ¬f a} ⊆ t \ s, rw subset_def, simp, intros x ht hs _, exact ⟨ht, hs⟩,
    rw measure_mono_null dd hst.right at this,
    rw zero_add at this,
    rw nonpos_iff_eq_zero at this,
    exact this,
  },
  exact measure_mono_null bb cc,
end

lemma ae_eq_restrict
{s t : set α}
(hs : measurable_set s) (ht : measurable_set t)
(hst : s =ᵐ[μ] t)
{f : α → Prop} :
(∀ᵐ (x : α) ∂μ.restrict s, f x) ↔ (∀ᵐ (x : α) ∂μ.restrict t, f x) :=
begin
  split,
  exact ae_eq_restrict_aux hs ht hst,
  exact ae_eq_restrict_aux ht hs hst.symm,
end

lemma ae_cover_restrict_of_ae_eq_aux
{φ : ι → set α}
{s t : set α}
(hs : measurable_set s)
(ht : measurable_set t)
(hst : s =ᵐ[μ] t)
(h : ae_cover (μ.restrict s) l φ) :
ae_cover (μ.restrict t) l φ := {
  ae_eventually_mem := begin
    rw ←ae_eq_restrict hs ht hst,
    exact h.ae_eventually_mem,
  end,
  measurable := h.measurable,
}

lemma ae_cover_restrict_of_ae_eq
{φ : ι → set α}
{s t : set α}
(hs : measurable_set s)
(ht : measurable_set t)
(hst : s =ᵐ[μ] t) :
ae_cover (μ.restrict s) l φ ↔ ae_cover (μ.restrict t) l φ :=
⟨ae_cover_restrict_of_ae_eq_aux hs ht hst, ae_cover_restrict_of_ae_eq_aux ht hs hst.symm⟩

lemma ae_cover_Ioo_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Icc (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_le_nhds A x hx.left).mp $
      (hb.eventually $eventually_ge_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Icc, }

lemma ae_cover_Ioo_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ico (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_le_nhds A x hx.left).mp $
      (hb.eventually $ eventually_gt_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Ico, }

lemma ae_cover_Ioo_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ioc (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_lt_nhds A x hx.left).mp $
      (hb.eventually $ eventually_ge_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Ioc, }

lemma ae_cover_Ioo_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ioo (a i) (b i)) :=
{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
      ae_of_all μ (λ x hx,
      (ha.eventually $ eventually_lt_nhds A x hx.left).mp $
      (hb.eventually $ eventually_gt_nhds B x hx.right).mono $
      λ i hbi hai, ⟨hai, hbi⟩)),
  measurable := λ i, measurable_set_Ioo, }

lemma ae_cover_Ioc_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Icc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Icc ha hb,
end

lemma ae_cover_Ioc_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ico (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ico ha hb,
end

lemma ae_cover_Ioc_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ioc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioc ha hb,
end

lemma ae_cover_Ioc_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ioo (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ioc A B, exact Ioo_ae_eq_Ioc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ioc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioo ha hb,
end

lemma ae_cover_Ico_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Icc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Icc ha hb,
end

lemma ae_cover_Ico_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Ico (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ico ha hb,
end

lemma ae_cover_Ico_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Ioc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioc ha hb,
end

lemma ae_cover_Ico_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Ico A B) l (λ i, Ioo (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Ico A B, exact Ioo_ae_eq_Ico,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Ico measurable_set_Ioo  this.symm),
  exact ae_cover_Ioo_of_Ioo ha hb,
end

lemma ae_cover_Icc_of_Icc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Icc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Icc ha hb,
end

lemma ae_cover_Icc_of_Ico (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Ico (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ico ha hb,
end

lemma ae_cover_Icc_of_Ioc (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Ioc (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioc ha hb,
end

lemma ae_cover_Icc_of_Ioo (ha : tendsto a l (nhds A)) (hb : tendsto b l (nhds B)) :
  ae_cover (μ.restrict $ Icc A B) l (λ i, Ioo (a i) (b i)) :=
begin
  have : Ioo A B =ᵐ[μ] Icc A B, exact Ioo_ae_eq_Icc,
  rw (ae_cover_restrict_of_ae_eq measurable_set_Icc measurable_set_Ioo this.symm),
  exact ae_cover_Ioo_of_Ioo ha hb,
end

end preorder_α
end ae_cover
end measure_theory


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module data.nat.part_enat
! leanprover-community/mathlib commit 114ff8a4a7935cb7531062200bff375e7b1d6d85
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Equiv.Basic
import Mathlib.Data.Part
import Mathlib.Data.ENat.Lattice
import Mathlib.Tactic.NormNum

/-!
# Natural numbers with infinity

The natural numbers and an extra `top` element `⊤`. This implementation uses `part ℕ` as an
implementation. Use `ℕ∞` instead unless you care about computability.

## Main definitions

The following instances are defined:

* `OrderedAddCommMonoid PartENat`
* `CanonicallyOrderedAddMonoid PartENat`
* `CompleteLinearOrder PartENat`

There is no additive analogue of `MonoidWithZero`; if there were then `PartENat` could
be an `AddMonoidWithTop`.

* `toWithTop` : the map from `PartENat` to `ℕ∞`, with theorems that it plays well
with `+` and `≤`.

* `withTopAddEquiv : PartENat ≃+ ℕ∞`
* `withTopOrderIso : PartENat ≃o ℕ∞`

## Implementation details

`PartENat` is defined to be `Part ℕ`.

`+` and `≤` are defined on `PartENat`, but there is an issue with `*` because it's not
clear what `0 * ⊤` should be. `mul` is hence left undefined. Similarly `⊤ - ⊤` is ambiguous
so there is no `-` defined on `PartENat`.

Before the `open Classical` line, various proofs are made with decidability assumptions.
This can cause issues -- see for example the non-simp lemma `toWithTopZero` proved by `rfl`,
followed by `@[simp] lemma toWithTopZero'` whose proof uses `convert`.

## Tags

PartENat, ℕ∞
-/

open Part hiding some

/-- Type of natural numbers with infinity (`⊤`) -/
def PartENat : Type :=
  Part ℕ
#align part_enat PartENat

namespace PartENat

/-- The computable embedding `ℕ → PartENat`.

This coincides with the coercion `coe : ℕ → PartENat`, see `PartENat.some_eq_natCast`. -/
@[coe]
def some : ℕ → PartENat :=
  Part.some
#align part_enat.some PartENat.some

instance : Zero PartENat :=
  ⟨some 0⟩

instance : Inhabited PartENat :=
  ⟨0⟩

instance : One PartENat :=
  ⟨some 1⟩

instance : Add PartENat :=
  ⟨fun x y => ⟨x.Dom ∧ y.Dom, fun h => get x h.1 + get y h.2⟩⟩

instance (n : ℕ) : Decidable (some n).Dom :=
  isTrue trivial

@[simp]
theorem dom_some (x : ℕ) : (some x).Dom :=
  trivial
#align part_enat.dom_some PartENat.dom_some

instance addCommMonoid : AddCommMonoid PartENat where
  add := (· + ·)
  zero := 0
  add_comm x y := Part.ext' and_comm fun _ _ => add_comm _ _
  zero_add x := Part.ext' (true_and_iff _) fun _ _ => zero_add _
  add_zero x := Part.ext' (and_true_iff _) fun _ _ => add_zero _
  add_assoc x y z := Part.ext' and_assoc fun _ _ => add_assoc _ _ _

instance : AddCommMonoidWithOne PartENat :=
  { PartENat.addCommMonoid with
    one := 1
    natCast := some
    natCast_zero := rfl
    natCast_succ := fun _ => Part.ext' (true_and_iff _).symm fun _ _ => rfl }

theorem some_eq_natCast (n : ℕ) : some n = n :=
  rfl
#align part_enat.some_eq_coe PartENat.some_eq_natCast

@[simp, norm_cast]
theorem natCast_inj {x y : ℕ} : (x : PartENat) = y ↔ x = y :=
  Part.some_inj
#align part_enat.coe_inj PartENat.natCast_inj

@[simp]
theorem dom_natCast (x : ℕ) : (x : PartENat).Dom :=
  trivial
#align part_enat.dom_coe PartENat.dom_natCast

instance : CanLift PartENat ℕ (↑) Dom :=
  ⟨fun n hn => ⟨n.get hn, Part.some_get _⟩⟩

instance : LE PartENat :=
  ⟨fun x y => ∃ h : y.Dom → x.Dom, ∀ hy : y.Dom, x.get (h hy) ≤ y.get hy⟩

instance : Top PartENat :=
  ⟨none⟩

instance : Bot PartENat :=
  ⟨0⟩

instance : Sup PartENat :=
  ⟨fun x y => ⟨x.Dom ∧ y.Dom, fun h => x.get h.1 ⊔ y.get h.2⟩⟩

theorem le_def (x y : PartENat) :
    x ≤ y ↔ ∃ h : y.Dom → x.Dom, ∀ hy : y.Dom, x.get (h hy) ≤ y.get hy :=
  Iff.rfl
#align part_enat.le_def PartENat.le_def

@[elab_as_elim]
protected theorem casesOn' {P : PartENat → Prop} :
    ∀ a : PartENat, P ⊤ → (∀ n : ℕ, P (some n)) → P a :=
  Part.induction_on
#align part_enat.cases_on' PartENat.casesOn'

@[elab_as_elim]
protected theorem casesOn {P : PartENat → Prop} : ∀ a : PartENat, P ⊤ → (∀ n : ℕ, P n) → P a := by
  exact PartENat.casesOn'
#align part_enat.cases_on PartENat.casesOn

-- Porting note : The last instance in this file (`LinearOrderedAddCommMonoidWithTop`)
-- causes the linter to complain here because with that instance `simp` could
-- proof `top_add`. Therefore the linter has been silenced here.
@[nolint simpNF, simp]
theorem top_add (x : PartENat) : ⊤ + x = ⊤ :=
  Part.ext' (false_and_iff _) fun h => h.left.elim
#align part_enat.top_add PartENat.top_add

-- Porting note : The last instance in this file (`LinearOrderedAddCommMonoidWithTop`)
-- causes the linter to complain here because with that instance `simp` could
-- proof `add_top`. Therefore the linter has been silenced here.@[nolint simpNF, simp]
@[nolint simpNF, simp]
theorem add_top (x : PartENat) : x + ⊤ = ⊤ := by rw [add_comm, top_add]
#align part_enat.add_top PartENat.add_top

@[simp]
theorem natCast_get {x : PartENat} (h : x.Dom) : (x.get h : PartENat) = x := by
  exact Part.ext' (iff_of_true trivial h) fun _ _ => rfl
#align part_enat.coe_get PartENat.natCast_get

@[simp, norm_cast]
theorem get_natCast' (x : ℕ) (h : (x : PartENat).Dom) : get (x : PartENat) h = x := by
  rw [← natCast_inj, natCast_get]
#align part_enat.get_coe' PartENat.get_natCast'

theorem get_natCast {x : ℕ} : get (x : PartENat) (dom_natCast x) = x :=
  get_natCast' _ _
#align part_enat.get_coe PartENat.get_natCast

theorem coe_add_get {x : ℕ} {y : PartENat} (h : ((x : PartENat) + y).Dom) :
    get ((x : PartENat) + y) h = x + get y h.2 := by
  rfl
#align part_enat.coe_add_get PartENat.coe_add_get

@[simp]
theorem get_add {x y : PartENat} (h : (x + y).Dom) : get (x + y) h = x.get h.1 + y.get h.2 :=
  rfl
#align part_enat.get_add PartENat.get_add

@[simp]
theorem get_zero (h : (0 : PartENat).Dom) : (0 : PartENat).get h = 0 :=
  rfl
#align part_enat.get_zero PartENat.get_zero

@[simp]
theorem get_one (h : (1 : PartENat).Dom) : (1 : PartENat).get h = 1 :=
  rfl
#align part_enat.get_one PartENat.get_one

nonrec theorem get_eq_iff_eq_some {a : PartENat} {ha : a.Dom} {b : ℕ} : a.get ha = b ↔ a = some b :=
  get_eq_iff_eq_some
#align part_enat.get_eq_iff_eq_some PartENat.get_eq_iff_eq_some

theorem get_eq_iff_eq_coe {a : PartENat} {ha : a.Dom} {b : ℕ} : a.get ha = b ↔ a = b := by
  rw [get_eq_iff_eq_some]
  rfl
#align part_enat.get_eq_iff_eq_coe PartENat.get_eq_iff_eq_coe

theorem dom_of_le_of_dom {x y : PartENat} : x ≤ y → y.Dom → x.Dom := fun ⟨h, _⟩ => h
#align part_enat.dom_of_le_of_dom PartENat.dom_of_le_of_dom

theorem dom_of_le_some {x : PartENat} {y : ℕ} (h : x ≤ some y) : x.Dom :=
  dom_of_le_of_dom h trivial
#align part_enat.dom_of_le_some PartENat.dom_of_le_some

theorem dom_of_le_natCast {x : PartENat} {y : ℕ} (h : x ≤ y) : x.Dom := by
  exact dom_of_le_some h
#align part_enat.dom_of_le_coe PartENat.dom_of_le_natCast

instance decidableLe (x y : PartENat) [Decidable x.Dom] [Decidable y.Dom] : Decidable (x ≤ y) :=
  if hx : x.Dom then
    decidable_of_decidable_of_iff (by rw [le_def])
  else
    if hy : y.Dom then isFalse fun h => hx <| dom_of_le_of_dom h hy
    else isTrue ⟨fun h => (hy h).elim, fun h => (hy h).elim⟩
#align part_enat.decidable_le PartENat.decidableLe

/-- The coercion `ℕ → partENat` preserves `0` and addition. -/
def natCast_AddMonoidHom : ℕ →+ PartENat where
  toFun := some
  map_zero' := Nat.cast_zero
  map_add' := Nat.cast_add
#align part_enat.coe_hom PartENat.natCast_AddMonoidHom

@[simp]
theorem coe_coeHom : natCast_AddMonoidHom = some :=
  rfl
#align part_enat.coe_coe_hom PartENat.coe_coeHom

instance partialOrder : PartialOrder PartENat where
  le := (· ≤ ·)
  le_refl _ := ⟨id, fun _ => le_rfl⟩
  le_trans := fun _ _ _ ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩ =>
    ⟨hxy₁ ∘ hyz₁, fun _ => le_trans (hxy₂ _) (hyz₂ _)⟩
  lt_iff_le_not_le _ _ := Iff.rfl
  le_antisymm := fun _ _ ⟨hxy₁, hxy₂⟩ ⟨hyx₁, hyx₂⟩ =>
    Part.ext' ⟨hyx₁, hxy₁⟩ fun _ _ => le_antisymm (hxy₂ _) (hyx₂ _)

theorem lt_def (x y : PartENat) : x < y ↔ ∃ hx : x.Dom, ∀ hy : y.Dom, x.get hx < y.get hy := by
  rw [lt_iff_le_not_le, le_def, le_def, not_exists]
  constructor
  · rintro ⟨⟨hyx, H⟩, h⟩
    by_cases hx : x.Dom
    · use hx
      intro hy
      specialize H hy
      specialize h fun _ => hy
      rw [not_forall] at h
      cases' h with hx' h
      rw [not_le] at h
      exact h
    · specialize h fun hx' => (hx hx').elim
      rw [not_forall] at h
      cases' h with hx' h
      exact (hx hx').elim
  · rintro ⟨hx, H⟩
    exact ⟨⟨fun _ => hx, fun hy => (H hy).le⟩, fun hxy h => not_lt_of_le (h _) (H _)⟩
#align part_enat.lt_def PartENat.lt_def

@[simp, norm_cast]
theorem coe_le_coe {x y : ℕ} : (x : PartENat) ≤ y ↔ x ≤ y := by
  exact ⟨fun ⟨_, h⟩ => h trivial, fun h => ⟨fun _ => trivial, fun _ => h⟩⟩
#align part_enat.coe_le_coe PartENat.coe_le_coe

@[simp, norm_cast]
theorem coe_lt_coe {x y : ℕ} : (x : PartENat) < y ↔ x < y := by
  rw [lt_iff_le_not_le, lt_iff_le_not_le, coe_le_coe, coe_le_coe]
#align part_enat.coe_lt_coe PartENat.coe_lt_coe

@[simp]
theorem get_le_get {x y : PartENat} {hx : x.Dom} {hy : y.Dom} : x.get hx ≤ y.get hy ↔ x ≤ y := by
  conv =>
    lhs
    rw [← coe_le_coe, natCast_get, natCast_get]
#align part_enat.get_le_get PartENat.get_le_get

theorem le_coe_iff (x : PartENat) (n : ℕ) : x ≤ n ↔ ∃ h : x.Dom, x.get h ≤ n := by
  show (∃ h : True → x.Dom, _) ↔ ∃ h : x.Dom, x.get h ≤ n
  simp only [forall_prop_of_true, dom_natCast, get_natCast']
#align part_enat.le_coe_iff PartENat.le_coe_iff

theorem lt_coe_iff (x : PartENat) (n : ℕ) : x < n ↔ ∃ h : x.Dom, x.get h < n := by
  simp only [lt_def, forall_prop_of_true, get_natCast', dom_natCast]
#align part_enat.lt_coe_iff PartENat.lt_coe_iff

theorem coe_le_iff (n : ℕ) (x : PartENat) : (n : PartENat) ≤ x ↔ ∀ h : x.Dom, n ≤ x.get h := by
  rw [← some_eq_natCast]
  simp only [le_def, exists_prop_of_true, dom_some, forall_true_iff]
  rfl
#align part_enat.coe_le_iff PartENat.coe_le_iff

theorem coe_lt_iff (n : ℕ) (x : PartENat) : (n : PartENat) < x ↔ ∀ h : x.Dom, n < x.get h := by
  rw [← some_eq_natCast]
  simp only [lt_def, exists_prop_of_true, dom_some, forall_true_iff]
  rfl
#align part_enat.coe_lt_iff PartENat.coe_lt_iff

instance NeZero.one : NeZero (1 : PartENat) :=
  ⟨natCast_inj.not.mpr (by decide)⟩
#align part_enat.ne_zero.one PartENat.NeZero.one

instance semilatticeSup : SemilatticeSup PartENat :=
  { PartENat.partialOrder with
    sup := (· ⊔ ·)
    le_sup_left := fun _ _ => ⟨And.left, fun _ => le_sup_left⟩
    le_sup_right := fun _ _ => ⟨And.right, fun _ => le_sup_right⟩
    sup_le := fun _ _ _ ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩ =>
      ⟨fun hz => ⟨hx₁ hz, hy₁ hz⟩, fun _ => sup_le (hx₂ _) (hy₂ _)⟩ }
#align part_enat.semilattice_sup PartENat.semilatticeSup

instance orderBot : OrderBot PartENat where
  bot := ⊥
  bot_le _ := ⟨fun _ => trivial, fun _ => Nat.zero_le _⟩
#align part_enat.order_bot PartENat.orderBot

instance orderTop : OrderTop PartENat where
  top := ⊤
  le_top _ := ⟨fun h => False.elim h, fun hy => False.elim hy⟩
#align part_enat.order_top PartENat.orderTop

nonrec theorem eq_zero_iff {x : PartENat} : x = 0 ↔ x ≤ 0 :=
  eq_bot_iff
#align part_enat.eq_zero_iff PartENat.eq_zero_iff

theorem ne_zero_iff {x : PartENat} : x ≠ 0 ↔ ⊥ < x :=
  bot_lt_iff_ne_bot.symm
#align part_enat.ne_zero_iff PartENat.ne_zero_iff

theorem dom_of_lt {x y : PartENat} : x < y → x.Dom :=
  PartENat.casesOn x not_top_lt fun _ _ => dom_natCast _
#align part_enat.dom_of_lt PartENat.dom_of_lt

theorem top_eq_none : (⊤ : PartENat) = Part.none :=
  rfl
#align part_enat.top_eq_none PartENat.top_eq_none

@[simp]
theorem natCast_lt_top (x : ℕ) : (x : PartENat) < ⊤ :=
  Ne.lt_top fun h => absurd (congr_arg Dom h) <| by simp only [dom_natCast]; exact true_ne_false
#align part_enat.coe_lt_top PartENat.natCast_lt_top

@[simp]
theorem natCast_ne_top (x : ℕ) : (x : PartENat) ≠ ⊤ :=
  ne_of_lt (natCast_lt_top x)
#align part_enat.coe_ne_top PartENat.natCast_ne_top

theorem not_isMax_natCast (x : ℕ) : ¬IsMax (x : PartENat) :=
  not_isMax_of_lt (natCast_lt_top x)
#align part_enat.not_is_max_coe PartENat.not_isMax_natCast

theorem ne_top_iff {x : PartENat} : x ≠ ⊤ ↔ ∃ n : ℕ, x = n := by
  simpa only [← some_eq_natCast] using Part.ne_none_iff
#align part_enat.ne_top_iff PartENat.ne_top_iff

theorem ne_top_iff_dom {x : PartENat} : x ≠ ⊤ ↔ x.Dom := by
  classical exact not_iff_comm.1 Part.eq_none_iff'.symm
#align part_enat.ne_top_iff_dom PartENat.ne_top_iff_dom

theorem not_dom_iff_eq_top {x : PartENat} : ¬x.Dom ↔ x = ⊤ :=
  Iff.not_left ne_top_iff_dom.symm
#align part_enat.not_dom_iff_eq_top PartENat.not_dom_iff_eq_top

theorem eq_top_iff_forall_lt (x : PartENat) : x = ⊤ ↔ ∀ n : ℕ, (n : PartENat) < x := by
  constructor
  · rintro rfl n
    exact natCast_lt_top _
  · -- Porting note: was `contrapose!`
    contrapose
    rw [←Ne, ne_top_iff, not_forall]
    rintro ⟨n, rfl⟩
    exact ⟨n, irrefl _⟩
#align part_enat.eq_top_iff_forall_lt PartENat.eq_top_iff_forall_lt

theorem eq_top_iff_forall_le (x : PartENat) : x = ⊤ ↔ ∀ n : ℕ, (n : PartENat) ≤ x :=
  (eq_top_iff_forall_lt x).trans
    ⟨fun h n => (h n).le, fun h n => lt_of_lt_of_le (coe_lt_coe.mpr n.lt_succ_self) (h (n + 1))⟩
#align part_enat.eq_top_iff_forall_le PartENat.eq_top_iff_forall_le

theorem pos_iff_one_le {x : PartENat} : 0 < x ↔ 1 ≤ x :=
  PartENat.casesOn x
    (by simp only [iff_true_iff, le_top, natCast_lt_top, ← @Nat.cast_zero PartENat])
    fun n =>
    by
    rw [← Nat.cast_zero, ← Nat.cast_one, PartENat.coe_lt_coe, PartENat.coe_le_coe]
    rfl
#align part_enat.pos_iff_one_le PartENat.pos_iff_one_le

instance isTotal: IsTotal PartENat (· ≤ ·) where
  total x y :=
    PartENat.casesOn (P := fun z => z ≤ y ∨ y ≤ z) x (Or.inr le_top)
      (PartENat.casesOn y (fun _ => Or.inl le_top) fun x y =>
        (le_total x y).elim (Or.inr ∘ coe_le_coe.2) (Or.inl ∘ coe_le_coe.2))

noncomputable instance linearOrder: LinearOrder PartENat :=
  { PartENat.partialOrder with
    le_total := IsTotal.total
    decidable_le := Classical.decRel _
    max := (· ⊔ ·)
    -- Porting note: was `max_def := @sup_eq_maxDefault _ _ (id _) _ }`
    max_def := fun a b => by
      change (fun a b => a ⊔ b) a b = _
      rw [@sup_eq_maxDefault PartENat _ (id _) _]
      rfl }

instance boundedOrder: BoundedOrder PartENat :=
  { PartENat.orderTop, PartENat.orderBot with }

noncomputable instance lattice: Lattice PartENat :=
  { PartENat.semilatticeSup with
    inf := min
    inf_le_left := min_le_left
    inf_le_right := min_le_right
    le_inf := fun _ _ _ => le_min }

noncomputable instance orderedAddCommMonoid: OrderedAddCommMonoid PartENat :=
  { PartENat.linearOrder, PartENat.addCommMonoid with
    add_le_add_left := fun a b ⟨h₁, h₂⟩ c =>
      PartENat.casesOn c (by simp) fun c =>
        ⟨fun h => And.intro (dom_natCast _) (h₁ h.2), fun h => by
          simpa only [coe_add_get] using add_le_add_left (h₂ _) c⟩ }

noncomputable instance : CanonicallyOrderedAddMonoid PartENat :=
  { PartENat.semilatticeSup, PartENat.orderBot,
    PartENat.orderedAddCommMonoid with
    le_self_add := fun a b =>
      PartENat.casesOn b (le_top.trans_eq (add_top _).symm) fun b =>
        PartENat.casesOn a (top_add _).ge fun a =>
          (coe_le_coe.2 le_self_add).trans_eq (Nat.cast_add _ _)
    exists_add_of_le := fun {a b} =>
      PartENat.casesOn b (fun _ => ⟨⊤, (add_top _).symm⟩) fun b =>
        PartENat.casesOn a (fun h => ((natCast_lt_top _).not_le h).elim) fun a h =>
          ⟨(b - a : ℕ), by
            rw [← Nat.cast_add, natCast_inj, add_comm, tsub_add_cancel_of_le (coe_le_coe.1 h)]⟩ }

theorem eq_natCast_sub_of_add_eq_natCast {x y : PartENat} {n : ℕ} (h : x + y = n) :
    x = ↑(n - y.get (dom_of_le_natCast ((le_add_left le_rfl).trans_eq h))) := by
  lift x to ℕ using dom_of_le_natCast ((le_add_right le_rfl).trans_eq h)
  lift y to ℕ using dom_of_le_natCast ((le_add_left le_rfl).trans_eq h)
  rw [← Nat.cast_add, natCast_inj] at h
  rw [get_natCast, natCast_inj, eq_tsub_of_add_eq h]
#align part_enat.eq_coe_sub_of_add_eq_coe PartENat.eq_natCast_sub_of_add_eq_natCast

protected theorem add_lt_add_right {x y z : PartENat} (h : x < y) (hz : z ≠ ⊤) : x + z < y + z := by
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩
  rcases ne_top_iff.mp hz with ⟨k, rfl⟩
  induction' y using PartENat.casesOn with n
  · rw [top_add]
    -- Porting note: was apply_mod_cast natCast_lt_top
    norm_cast; apply natCast_lt_top
  norm_cast at h
  -- Porting note: was `apply_mod_cast add_lt_add_right h`
  norm_cast; apply add_lt_add_right h
#align part_enat.add_lt_add_right PartENat.add_lt_add_right

protected theorem add_lt_add_iff_right {x y z : PartENat} (hz : z ≠ ⊤) : x + z < y + z ↔ x < y :=
  ⟨lt_of_add_lt_add_right, fun h => PartENat.add_lt_add_right h hz⟩
#align part_enat.add_lt_add_iff_right PartENat.add_lt_add_iff_right

protected theorem add_lt_add_iff_left {x y z : PartENat} (hz : z ≠ ⊤) : z + x < z + y ↔ x < y := by
  rw [add_comm z, add_comm z, PartENat.add_lt_add_iff_right hz]
#align part_enat.add_lt_add_iff_left PartENat.add_lt_add_iff_left

protected theorem lt_add_iff_pos_right {x y : PartENat} (hx : x ≠ ⊤) : x < x + y ↔ 0 < y := by
  conv_rhs => rw [← PartENat.add_lt_add_iff_left hx]
  rw [add_zero]
#align part_enat.lt_add_iff_pos_right PartENat.lt_add_iff_pos_right

theorem lt_add_one {x : PartENat} (hx : x ≠ ⊤) : x < x + 1 := by
  rw [PartENat.lt_add_iff_pos_right hx]
  norm_cast
#align part_enat.lt_add_one PartENat.lt_add_one

theorem le_of_lt_add_one {x y : PartENat} (h : x < y + 1) : x ≤ y := by
  induction' y using PartENat.casesOn with n
  · apply le_top
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩
  -- Porting note: was `apply_mod_cast Nat.le_of_lt_succ; apply_mod_cast h`
  norm_cast; apply Nat.le_of_lt_succ; norm_cast at h
#align part_enat.le_of_lt_add_one PartENat.le_of_lt_add_one

theorem add_one_le_of_lt {x y : PartENat} (h : x < y) : x + 1 ≤ y := by
  induction' y using PartENat.casesOn with n
  · apply le_top
  rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩
  -- Porting note: was `apply_mod_cast Nat.succ_le_of_lt; apply_mod_cast h`
  norm_cast; apply Nat.succ_le_of_lt; norm_cast at h
#align part_enat.add_one_le_of_lt PartENat.add_one_le_of_lt

theorem add_one_le_iff_lt {x y : PartENat} (hx : x ≠ ⊤) : x + 1 ≤ y ↔ x < y := by
  refine ⟨fun h => ?_, add_one_le_of_lt⟩
  rcases ne_top_iff.mp hx with ⟨m, rfl⟩
  induction' y using PartENat.casesOn with n
  · apply natCast_lt_top
  -- Porting note: was `apply_mod_cast Nat.lt_of_succ_le; apply_mod_cast h`
  norm_cast; apply Nat.lt_of_succ_le; norm_cast at h
#align part_enat.add_one_le_iff_lt PartENat.add_one_le_iff_lt

theorem lt_add_one_iff_lt {x y : PartENat} (hx : x ≠ ⊤) : x < y + 1 ↔ x ≤ y := by
  refine ⟨le_of_lt_add_one, fun h => ?_⟩
  rcases ne_top_iff.mp hx with ⟨m, rfl⟩
  induction' y using PartENat.casesOn with n
  · rw [top_add]
    apply natCast_lt_top
  -- Porting note: was `apply_mod_cast Nat.lt_succ_of_le; apply_mod_cast h`
  norm_cast; apply Nat.lt_succ_of_le; norm_cast at h
#align part_enat.lt_add_one_iff_lt PartENat.lt_add_one_iff_lt

theorem add_eq_top_iff {a b : PartENat} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := by
  refine PartENat.casesOn a ?_ ?_
  <;> refine PartENat.casesOn b ?_ ?_
  <;> simp
  simp only [←Nat.cast_add, PartENat.natCast_ne_top, forall_const]
#align part_enat.add_eq_top_iff PartENat.add_eq_top_iff

protected theorem add_right_cancel_iff {a b c : PartENat} (hc : c ≠ ⊤) : a + c = b + c ↔ a = b := by
  rcases ne_top_iff.1 hc with ⟨c, rfl⟩
  refine PartENat.casesOn a ?_ ?_
  <;> refine PartENat.casesOn b ?_ ?_
  <;> simp [add_eq_top_iff, natCast_ne_top, @eq_comm _ (⊤ : PartENat)]
  simp only [←Nat.cast_add, add_left_cancel_iff, PartENat.natCast_inj, add_comm, forall_const]
#align part_enat.add_right_cancel_iff PartENat.add_right_cancel_iff

protected theorem add_left_cancel_iff {a b c : PartENat} (ha : a ≠ ⊤) : a + b = a + c ↔ b = c := by
  rw [add_comm a, add_comm a, PartENat.add_right_cancel_iff ha]
#align part_enat.add_left_cancel_iff PartENat.add_left_cancel_iff

section WithTop

/-- Computably converts an `PartENat` to a `ℕ∞`. -/
def toWithTop (x : PartENat) [Decidable x.Dom] : ℕ∞ :=
  x.toOption
#align part_enat.to_with_top PartENat.toWithTop

theorem toWithTop_top :
    have : Decidable (⊤ : PartENat).Dom := Part.noneDecidable
    toWithTop ⊤ = ⊤ :=
  rfl
#align part_enat.to_with_top_top PartENat.toWithTop_top

@[simp]
theorem toWithTop_top' {h : Decidable (⊤ : PartENat).Dom} : toWithTop ⊤ = ⊤ := by
  convert toWithTop_top
#align part_enat.to_with_top_top' PartENat.toWithTop_top'

theorem toWithTop_zero :
    have : Decidable (0 : PartENat).Dom := someDecidable 0
    toWithTop 0 = 0 :=
  rfl
#align part_enat.to_with_top_zero PartENat.toWithTop_zero

@[simp]
theorem toWithTop_zero' {h : Decidable (0 : PartENat).Dom} : toWithTop 0 = 0 := by
  convert toWithTop_zero
#align part_enat.to_with_top_zero' PartENat.toWithTop_zero'

theorem toWithTop_some (n : ℕ) : toWithTop (some n) = n :=
  rfl
#align part_enat.to_with_top_some PartENat.toWithTop_some

theorem toWithTop_natCast (n : ℕ) {_ : Decidable (n : PartENat).Dom} : toWithTop n = n := by
  simp only [← toWithTop_some]
  congr
#align part_enat.to_with_top_coe PartENat.toWithTop_natCast

@[simp]
theorem toWithTop_natCast' (n : ℕ) {h : Decidable (n : PartENat).Dom} :
    toWithTop (n : PartENat) = n := by
  rw [toWithTop_natCast n]
#align part_enat.to_with_top_coe' PartENat.toWithTop_natCast'

-- Porting note: statement changed. Mathlib 3 statement was
-- ```
-- @[simp] lemma to_with_top_le {x y : part_enat} :
--   Π [decidable x.dom] [decidable y.dom], by exactI to_with_top x ≤ to_with_top y ↔ x ≤ y :=
-- ```
-- This used to be really slow to typecheck when the definition of `ENat`
-- was still `deriving AddCommMonoidWithOne`. Now that I removed that it is fine.
-- (The problem was that the last `simp` got stuck at `CharZero ℕ∞ ≟ CharZero ℕ∞` where
-- one side used `instENatAddCommMonoidWithOne` and the other used
-- `NonAssocSemiring.toAddCommMonoidWithOne`. Now the former doesn't exist anymore.)
@[simp]
theorem toWithTop_le {x y : PartENat} [hx : Decidable x.Dom] [hy : Decidable y.Dom] :
    toWithTop x ≤ toWithTop y ↔ x ≤ y := by
  induction y using PartENat.casesOn generalizing hy
  · simp
  induction x using PartENat.casesOn generalizing hx
  · simp
  · simp -- Porting note: this takes too long.
#align part_enat.to_with_top_le PartENat.toWithTop_le

/-
Porting note: As part of the investigation above, I noticed that Lean4 does not
find the following two instances which it could find in Lean3 automatically:
```
#synth Decidable (⊤ : PartENat).Dom
variable {n : ℕ}
#synth Decidable (n : PartENat).Dom
```
-/

@[simp]
theorem toWithTop_lt {x y : PartENat} [Decidable x.Dom] [Decidable y.Dom] :
    toWithTop x < toWithTop y ↔ x < y :=
  lt_iff_lt_of_le_iff_le toWithTop_le
#align part_enat.to_with_top_lt PartENat.toWithTop_lt

end WithTop

-- Porting note : new, extracted from `withTopEquiv`.
/-- Coersion from `ℕ∞` to `PartENat`. -/
@[coe]
def ofENat : ℕ∞ → PartENat :=
  fun x => match x with
  | Option.none => none
  | Option.some n => some n

-- Porting note : new
instance : Coe ℕ∞ PartENat := ⟨ofENat⟩

-- Porting note: new. This could probably be moved to tests or removed.
example (n : ℕ) : ((n : ℕ∞) : PartENat) = ↑n := rfl

-- Porting note : new
@[simp]
lemma ofENat_none : ofENat Option.none = ⊤ := by rfl

-- Porting note : new
@[simp]
lemma ofENat_some (n : ℕ) : ofENat (Option.some n) = ↑n := by rfl

-- Porting note : new
@[simp, norm_cast]
theorem toWithTop_ofENat (n : ℕ∞) {_ : Decidable (n : PartENat).Dom} : toWithTop (↑n) = n := by
  induction n with
  | none => simp
  | some n =>
    simp only [toWithTop_natCast', ofENat_some]
    rfl

section WithTopEquiv

open Classical

@[simp]
theorem toWithTop_add {x y : PartENat} : toWithTop (x + y) = toWithTop x + toWithTop y := by
  refine PartENat.casesOn y ?_ ?_ <;> refine PartENat.casesOn x ?_ ?_
  --Porting note: was `simp [← Nat.cast_add, ← ENat.coe_add]`
  · simp only [add_top, toWithTop_top', _root_.add_top]
  · simp only [add_top, toWithTop_top', toWithTop_natCast', _root_.add_top, forall_const]
  · simp only [top_add, toWithTop_top', toWithTop_natCast', _root_.top_add, forall_const]
  · simp_rw [toWithTop_natCast', ← Nat.cast_add, toWithTop_natCast', forall_const]
#align part_enat.to_with_top_add PartENat.toWithTop_add

-- Porting note: The old proof of `right_inv` didn't work.
-- (`by cases x; simp [with_top_equiv._match_1]; refl`)
-- In order to get it to work, I introduced some new statements (see above),
-- in particular `toWithTop_ofENat`.
/-- `Equiv` between `PartENat` and `ℕ∞` (for the order isomorphism see
`withTopOrderIso`). -/
noncomputable def withTopEquiv : PartENat ≃ ℕ∞ where
  toFun x := toWithTop x
  invFun x := ↑x
  left_inv x := by
    induction x using PartENat.casesOn <;>
    intros <;>
    simp <;>
    rfl
  right_inv x := by
    simp [toWithTop_ofENat]
#align part_enat.with_top_equiv PartENat.withTopEquiv

@[simp]
theorem withTopEquiv_top : withTopEquiv ⊤ = ⊤ :=
  toWithTop_top'
#align part_enat.with_top_equiv_top PartENat.withTopEquiv_top

@[simp]
theorem withTopEquiv_natCast (n : Nat) : withTopEquiv n = n :=
  toWithTop_natCast' _
#align part_enat.with_top_equiv_coe PartENat.withTopEquiv_natCast

@[simp]
theorem withTopEquiv_zero : withTopEquiv 0 = 0 := by
  simpa only [Nat.cast_zero] using withTopEquiv_natCast 0
#align part_enat.with_top_equiv_zero PartENat.withTopEquiv_zero

@[simp]
theorem withTopEquiv_le {x y : PartENat} : withTopEquiv x ≤ withTopEquiv y ↔ x ≤ y :=
  toWithTop_le
#align part_enat.with_top_equiv_le PartENat.withTopEquiv_le

@[simp]
theorem withTopEquiv_lt {x y : PartENat} : withTopEquiv x < withTopEquiv y ↔ x < y :=
  toWithTop_lt
#align part_enat.with_top_equiv_lt PartENat.withTopEquiv_lt

/-- `to_WithTop` induces an order isomorphism between `PartENat` and `ℕ∞`. -/
noncomputable def withTopOrderIso : PartENat ≃o ℕ∞ :=
  { withTopEquiv with map_rel_iff' := @fun _ _ => withTopEquiv_le }
#align part_enat.with_top_order_iso PartENat.withTopOrderIso

@[simp]
theorem withTopEquiv_symm_top : withTopEquiv.symm ⊤ = ⊤ :=
  rfl
#align part_enat.with_top_equiv_symm_top PartENat.withTopEquiv_symm_top

@[simp]
theorem withTopEquiv_symm_coe (n : Nat) : withTopEquiv.symm n = n :=
  rfl
#align part_enat.with_top_equiv_symm_coe PartENat.withTopEquiv_symm_coe

@[simp]
theorem withTopEquiv_symm_zero : withTopEquiv.symm 0 = 0 :=
  rfl
#align part_enat.with_top_equiv_symm_zero PartENat.withTopEquiv_symm_zero

@[simp]
theorem withTopEquiv_symm_le {x y : ℕ∞} : withTopEquiv.symm x ≤ withTopEquiv.symm y ↔ x ≤ y := by
  rw [← withTopEquiv_le]
  simp
#align part_enat.with_top_equiv_symm_le PartENat.withTopEquiv_symm_le

@[simp]
theorem withTopEquiv_symm_lt {x y : ℕ∞} : withTopEquiv.symm x < withTopEquiv.symm y ↔ x < y := by
  rw [← withTopEquiv_lt]
  simp
#align part_enat.with_top_equiv_symm_lt PartENat.withTopEquiv_symm_lt

/-- `toWithTop` induces an additive monoid isomorphism between `PartENat` and `ℕ∞`. -/
noncomputable def withTopAddEquiv : PartENat ≃+ ℕ∞ :=
  { withTopEquiv with
    map_add' := fun x y => by
      simp only [withTopEquiv]
      exact toWithTop_add }
#align part_enat.with_top_add_equiv PartENat.withTopAddEquiv

end WithTopEquiv

theorem lt_wf : @WellFounded PartENat (· < ·) := by
  classical
    change WellFounded fun a b : PartENat => a < b
    simp_rw [← withTopEquiv_lt]
    exact InvImage.wf _ (WithTop.wellFounded_lt Nat.lt_wfRel.wf)
#align part_enat.lt_wf PartENat.lt_wf

instance : WellFoundedLT PartENat :=
  ⟨lt_wf⟩

instance isWellOrder: IsWellOrder PartENat (· < ·) := {}

instance wellFoundedRelation: WellFoundedRelation PartENat :=
  ⟨(· < ·), lt_wf⟩

section Find

variable (P : ℕ → Prop) [DecidablePred P]

/-- The smallest `PartENat` satisfying a (decidable) predicate `P : ℕ → Prop` -/
def find : PartENat :=
  ⟨∃ n, P n, Nat.find⟩
#align part_enat.find PartENat.find

@[simp]
theorem find_get (h : (find P).Dom) : (find P).get h = Nat.find h :=
  rfl
#align part_enat.find_get PartENat.find_get

theorem find_dom (h : ∃ n, P n) : (find P).Dom :=
  h
#align part_enat.find_dom PartENat.find_dom

theorem lt_find (n : ℕ) (h : ∀ m ≤ n, ¬P m) : (n : PartENat) < find P := by
  rw [coe_lt_iff]
  intro h₁
  rw [find_get]
  have h₂ := @Nat.find_spec P _ h₁
  revert h₂
  contrapose
  intro h₂
  rw [not_lt] at h₂
  exact h _ h₂
#align part_enat.lt_find PartENat.lt_find

theorem lt_find_iff (n : ℕ) : (n : PartENat) < find P ↔ ∀ m ≤ n, ¬P m := by
  refine' ⟨_, lt_find P n⟩
  intro h m hm
  by_cases H : (find P).Dom
  · apply Nat.find_min H
    rw [coe_lt_iff] at h
    specialize h H
    exact lt_of_le_of_lt hm h
  · exact not_exists.mp H m
#align part_enat.lt_find_iff PartENat.lt_find_iff

theorem find_le (n : ℕ) (h : P n) : find P ≤ n := by
  rw [le_coe_iff]
  refine' ⟨⟨_, h⟩, @Nat.find_min' P _ _ _ h⟩
#align part_enat.find_le PartENat.find_le

theorem find_eq_top_iff : find P = ⊤ ↔ ∀ n, ¬P n :=
  (eq_top_iff_forall_lt _).trans
    ⟨fun h n => (lt_find_iff P n).mp (h n) _ le_rfl, fun h n => lt_find P n fun _ _ => h _⟩
#align part_enat.find_eq_top_iff PartENat.find_eq_top_iff

end Find

noncomputable instance : LinearOrderedAddCommMonoidWithTop PartENat :=
  { PartENat.linearOrder, PartENat.orderedAddCommMonoid, PartENat.orderTop with
    top_add' := top_add }

noncomputable instance : CompleteLinearOrder PartENat :=
  { PartENat.lattice, withTopOrderIso.symm.toGaloisInsertion.liftCompleteLattice,
    PartENat.linearOrder with
    inf := (· ⊓ ·)
    sup := (· ⊔ ·)
    top := ⊤
    bot := ⊥
    le := (· ≤ ·)
    lt := (· < ·) }

end PartENat


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Jeremy Avigad, Simon Hudon
-/
import data.part
import data.rel

/-!
# Partial functions

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

This file defines partial functions. Partial functions are like functions, except they can also be
"undefined" on some inputs. We define them as functions `α → part β`.

## Definitions

* `pfun α β`: Type of partial functions from `α` to `β`. Defined as `α → part β` and denoted
  `α →. β`.
* `pfun.dom`: Domain of a partial function. Set of values on which it is defined. Not to be confused
  with the domain of a function `α → β`, which is a type (`α` presently).
* `pfun.fn`: Evaluation of a partial function. Takes in an element and a proof it belongs to the
  partial function's `dom`.
* `pfun.as_subtype`: Returns a partial function as a function from its `dom`.
* `pfun.to_subtype`: Restricts the codomain of a function to a subtype.
* `pfun.eval_opt`: Returns a partial function with a decidable `dom` as a function `a → option β`.
* `pfun.lift`: Turns a function into a partial function.
* `pfun.id`: The identity as a partial function.
* `pfun.comp`: Composition of partial functions.
* `pfun.restrict`: Restriction of a partial function to a smaller `dom`.
* `pfun.res`: Turns a function into a partial function with a prescribed domain.
* `pfun.fix` : First return map of a partial function `f : α →. β ⊕ α`.
* `pfun.fix_induction`: A recursion principle for `pfun.fix`.

### Partial functions as relations

Partial functions can be considered as relations, so we specialize some `rel` definitions to `pfun`:
* `pfun.image`: Image of a set under a partial function.
* `pfun.ran`: Range of a partial function.
* `pfun.preimage`: Preimage of a set under a partial function.
* `pfun.core`: Core of a set under a partial function.
* `pfun.graph`: Graph of a partial function `a →. β`as a `set (α × β)`.
* `pfun.graph'`: Graph of a partial function `a →. β`as a `rel α β`.

### `pfun α` as a monad

Monad operations:
* `pfun.pure`: The monad `pure` function, the constant `x` function.
* `pfun.bind`: The monad `bind` function, pointwise `part.bind`
* `pfun.map`: The monad `map` function, pointwise `part.map`.
-/

open function

/-- `pfun α β`, or `α →. β`, is the type of partial functions from
  `α` to `β`. It is defined as `α → part β`. -/
def pfun (α β : Type*) := α → part β

infixr ` →. `:25 := pfun

namespace pfun
variables {α β γ δ ε ι : Type*}

instance : inhabited (α →. β) := ⟨λ a, part.none⟩

/-- The domain of a partial function -/
def dom (f : α →. β) : set α := {a | (f a).dom}

@[simp] lemma mem_dom (f : α →. β) (x : α) : x ∈ dom f ↔ ∃ y, y ∈ f x :=
by simp [dom, part.dom_iff_mem]

@[simp] lemma dom_mk (p : α → Prop) (f : Π a, p a → β) : pfun.dom (λ x, ⟨p x, f x⟩) = {x | p x} :=
rfl

theorem dom_eq (f : α →. β) : dom f = {x | ∃ y, y ∈ f x} :=
set.ext (mem_dom f)

/-- Evaluate a partial function -/
def fn (f : α →. β) (a : α) : dom f a → β := (f a).get

@[simp] lemma fn_apply (f : α →. β) (a : α) : f.fn a = (f a).get := rfl

/-- Evaluate a partial function to return an `option` -/
def eval_opt (f : α →. β) [D : decidable_pred (∈ dom f)] (x : α) : option β :=
@part.to_option _ _ (D x)

/-- Partial function extensionality -/
theorem ext' {f g : α →. β}
  (H1 : ∀ a, a ∈ dom f ↔ a ∈ dom g)
  (H2 : ∀ a p q, f.fn a p = g.fn a q) : f = g :=
funext $ λ a, part.ext' (H1 a) (H2 a)

theorem ext {f g : α →. β} (H : ∀ a b, b ∈ f a ↔ b ∈ g a) : f = g :=
funext $ λ a, part.ext (H a)

/-- Turns a partial function into a function out of its domain. -/
def as_subtype (f : α →. β) (s : f.dom) : β := f.fn s s.2

/-- The type of partial functions `α →. β` is equivalent to
the type of pairs `(p : α → Prop, f : subtype p → β)`. -/
def equiv_subtype : (α →. β) ≃ (Σ p : α → Prop, subtype p → β) :=
⟨λ f, ⟨λ a, (f a).dom, as_subtype f⟩,
 λ f x, ⟨f.1 x, λ h, f.2 ⟨x, h⟩⟩,
 λ f, funext $ λ a, part.eta _,
 λ ⟨p, f⟩, by dsimp; congr; funext a; cases a; refl⟩

theorem as_subtype_eq_of_mem {f : α →. β} {x : α} {y : β} (fxy : y ∈ f x) (domx : x ∈ f.dom) :
  f.as_subtype ⟨x, domx⟩ = y :=
part.mem_unique (part.get_mem _) fxy

/-- Turn a total function into a partial function. -/
protected def lift (f : α → β) : α →. β := λ a, part.some (f a)

instance : has_coe (α → β) (α →. β) := ⟨pfun.lift⟩

@[simp] theorem lift_eq_coe (f : α → β) : pfun.lift f = f := rfl

@[simp] theorem coe_val (f : α → β) (a : α) :
  (f : α →. β) a = part.some (f a) := rfl

@[simp] lemma dom_coe (f : α → β) : (f : α →. β).dom = set.univ := rfl

lemma coe_injective : injective (coe : (α → β) → α →. β) :=
λ f g h, funext $ λ a, part.some_injective $ congr_fun h a

/-- Graph of a partial function `f` as the set of pairs `(x, f x)` where `x` is in the domain of
`f`. -/
def graph (f : α →. β) : set (α × β) := {p | p.2 ∈ f p.1}

/-- Graph of a partial function as a relation. `x` and `y` are related iff `f x` is defined and
"equals" `y`. -/
def graph' (f : α →. β) : rel α β := λ x y, y ∈ f x

/-- The range of a partial function is the set of values
  `f x` where `x` is in the domain of `f`. -/
def ran (f : α →. β) : set β := {b | ∃ a, b ∈ f a}

/-- Restrict a partial function to a smaller domain. -/
def restrict (f : α →. β) {p : set α} (H : p ⊆ f.dom) : α →. β :=
λ x, (f x).restrict (x ∈ p) (@H x)

@[simp]
theorem mem_restrict {f : α →. β} {s : set α} (h : s ⊆ f.dom) (a : α) (b : β) :
  b ∈ f.restrict h a ↔ a ∈ s ∧ b ∈ f a :=
by simp [restrict]

/-- Turns a function into a partial function with a prescribed domain. -/
def res (f : α → β) (s : set α) : α →. β :=
(pfun.lift f).restrict s.subset_univ

theorem mem_res (f : α → β) (s : set α) (a : α) (b : β) :
  b ∈ res f s a ↔ (a ∈ s ∧ f a = b) :=
by simp [res, @eq_comm _ b]

theorem res_univ (f : α → β) : pfun.res f set.univ = f :=
rfl

theorem dom_iff_graph (f : α →. β) (x : α) : x ∈ f.dom ↔ ∃ y, (x, y) ∈ f.graph :=
part.dom_iff_mem

theorem lift_graph {f : α → β} {a b} : (a, b) ∈ (f : α →. β).graph ↔ f a = b :=
show (∃ (h : true), f a = b) ↔ f a = b, by simp

/-- The monad `pure` function, the total constant `x` function -/
protected def pure (x : β) : α →. β := λ _, part.some x

/-- The monad `bind` function, pointwise `part.bind` -/
def bind (f : α →. β) (g : β → α →. γ) : α →. γ :=
λ a, (f a).bind (λ b, g b a)

@[simp] lemma bind_apply (f : α →. β) (g : β → α →. γ) (a : α) :
  f.bind g a = (f a).bind (λ b, g b a) := rfl

/-- The monad `map` function, pointwise `part.map` -/
def map (f : β → γ) (g : α →. β) : α →. γ :=
λ a, (g a).map f

instance : monad (pfun α) :=
{ pure := @pfun.pure _,
  bind := @pfun.bind _,
  map := @pfun.map _ }

instance : is_lawful_monad (pfun α) :=
{ bind_pure_comp_eq_map := λ β γ f x, funext $ λ a, part.bind_some_eq_map _ _,
  id_map := λ β f, by funext a; dsimp [functor.map, pfun.map]; cases f a; refl,
  pure_bind := λ β γ x f, funext $ λ a, part.bind_some.{u_1 u_2} _ (f x),
  bind_assoc := λ β γ δ f g k,
    funext $ λ a, (f a).bind_assoc (λ b, g b a) (λ b, k b a) }

theorem pure_defined (p : set α) (x : β) : p ⊆ (@pfun.pure α _ x).dom := p.subset_univ

theorem bind_defined {α β γ} (p : set α) {f : α →. β} {g : β → α →. γ}
  (H1 : p ⊆ f.dom) (H2 : ∀ x, p ⊆ (g x).dom) : p ⊆ (f >>= g).dom :=
λ a ha, (⟨H1 ha, H2 _ ha⟩ : (f >>= g).dom a)

/-- First return map. Transforms a partial function `f : α →. β ⊕ α` into the partial function
`α →. β` which sends `a : α` to the first value in `β` it hits by iterating `f`, if such a value
exists. By abusing notation to illustrate, either `f a` is in the `β` part of `β ⊕ α` (in which
case `f.fix a` returns `f a`), or it is undefined (in which case `f.fix a` is undefined as well), or
it is in the `α` part of `β ⊕ α` (in which case we repeat the procedure, so `f.fix a` will return
`f.fix (f a)`). -/
def fix (f : α →. β ⊕ α) : α →. β := λ a,
part.assert (acc (λ x y, sum.inr x ∈ f y) a) $ λ h,
@well_founded.fix_F _ (λ x y, sum.inr x ∈ f y) _
  (λ a IH, part.assert (f a).dom $ λ hf,
    by cases e : (f a).get hf with b a';
      [exact part.some b, exact IH _ ⟨hf, e⟩])
  a h

theorem dom_of_mem_fix {f : α →. β ⊕ α} {a : α} {b : β}
  (h : b ∈ f.fix a) : (f a).dom :=
let ⟨h₁, h₂⟩ := part.mem_assert_iff.1 h in
by rw well_founded.fix_F_eq at h₂; exact h₂.fst.fst

theorem mem_fix_iff {f : α →. β ⊕ α} {a : α} {b : β} :
  b ∈ f.fix a ↔ sum.inl b ∈ f a ∨ ∃ a', sum.inr a' ∈ f a ∧ b ∈ f.fix a' :=
⟨λ h, let ⟨h₁, h₂⟩ := part.mem_assert_iff.1 h in
  begin
    rw well_founded.fix_F_eq at h₂,
    simp at h₂,
    cases h₂ with h₂ h₃,
    cases e : (f a).get h₂ with b' a'; simp [e] at h₃,
    { subst b', refine or.inl ⟨h₂, e⟩ },
    { exact or.inr ⟨a', ⟨_, e⟩, part.mem_assert _ h₃⟩ }
  end,
λ h, begin
  simp [fix],
  rcases h with ⟨h₁, h₂⟩ | ⟨a', h, h₃⟩,
  { refine ⟨⟨_, λ y h', _⟩, _⟩,
    { injection part.mem_unique ⟨h₁, h₂⟩ h' },
    { rw well_founded.fix_F_eq, simp [h₁, h₂] } },
  { simp [fix] at h₃, cases h₃ with h₃ h₄,
    refine ⟨⟨_, λ y h', _⟩, _⟩,
    { injection part.mem_unique h h' with e,
      exact e ▸ h₃ },
    { cases h with h₁ h₂,
      rw well_founded.fix_F_eq, simp [h₁, h₂, h₄] } }
end⟩

/-- If advancing one step from `a` leads to `b : β`, then `f.fix a = b` -/
theorem fix_stop {f : α →. β ⊕ α} {b : β} {a : α} (hb : sum.inl b ∈ f a) : b ∈ f.fix a :=
by { rw [pfun.mem_fix_iff], exact or.inl hb, }

/-- If advancing one step from `a` on `f` leads to `a' : α`, then `f.fix a = f.fix a'` -/
theorem fix_fwd_eq {f : α →. β ⊕ α} {a a' : α} (ha' : sum.inr a' ∈ f a) :
  f.fix a = f.fix a' :=
begin
  ext b, split,
  { intro h, obtain h' | ⟨a, h', e'⟩ := mem_fix_iff.1 h; cases part.mem_unique ha' h', exact e', },
  { intro h, rw pfun.mem_fix_iff, right, use a', exact ⟨ha', h⟩, }
end

theorem fix_fwd {f : α →. β ⊕ α} {b : β} {a a' : α} (hb : b ∈ f.fix a) (ha' : sum.inr a' ∈ f a) :
  b ∈ f.fix a' :=
by rwa [← fix_fwd_eq ha']

/-- A recursion principle for `pfun.fix`. -/
@[elab_as_eliminator]
def fix_induction {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α} (h : b ∈ f.fix a)
  (H : ∀ a', b ∈ f.fix a' → (∀ a'', sum.inr a'' ∈ f a' → C a'') → C a') : C a :=
begin
  have h₂ := (part.mem_assert_iff.1 h).snd, generalize_proofs h₁ at h₂, clear h,
  induction h₁ with a ha IH,
  have h : b ∈ f.fix a := part.mem_assert_iff.2 ⟨⟨a, ha⟩, h₂⟩,
  exact H a h (λ a' fa', IH a' fa' ((part.mem_assert_iff.1 (fix_fwd h fa')).snd)),
end

lemma fix_induction_spec {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α} (h : b ∈ f.fix a)
  (H : ∀ a', b ∈ f.fix a' → (∀ a'', sum.inr a'' ∈ f a' → C a'') → C a') :
  @fix_induction _ _ C _ _ _ h H = H a h (λ a' h', fix_induction (fix_fwd h h') H) :=
by { unfold fix_induction, generalize_proofs ha, induction ha, refl, }

/--
Another induction lemma for `b ∈ f.fix a` which allows one to prove a predicate `P` holds for
`a` given that `f a` inherits `P` from `a` and `P` holds for preimages of `b`.
-/
@[elab_as_eliminator]
def fix_induction' {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α} (h : b ∈ f.fix a)
  (hbase : ∀ a_final : α, sum.inl b ∈ f a_final → C a_final)
  (hind : ∀ a₀ a₁ : α, b ∈ f.fix a₁ → sum.inr a₁ ∈ f a₀ → C a₁ → C a₀) : C a :=
begin
  refine fix_induction h (λ a' h ih, _),
  cases e : (f a').get (dom_of_mem_fix h) with b' a''; replace e : _ ∈ f a' := ⟨_, e⟩,
  { apply hbase, convert e, exact part.mem_unique h (fix_stop e), },
  { exact hind _ _ (fix_fwd h e) e (ih _ e), },
end

lemma fix_induction'_stop {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α}
  (h : b ∈ f.fix a) (fa : sum.inl b ∈ f a)
  (hbase : ∀ a_final : α, sum.inl b ∈ f a_final → C a_final)
  (hind : ∀ a₀ a₁ : α, b ∈ f.fix a₁ → sum.inr a₁ ∈ f a₀ → C a₁ → C a₀) :
  @fix_induction' _ _ C _ _ _ h hbase hind = hbase a fa :=
by { unfold fix_induction', rw [fix_induction_spec], simp [part.get_eq_of_mem fa], }

lemma fix_induction'_fwd {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a a' : α}
  (h : b ∈ f.fix a) (h' : b ∈ f.fix a') (fa : sum.inr a' ∈ f a)
  (hbase : ∀ a_final : α, sum.inl b ∈ f a_final → C a_final)
  (hind : ∀ a₀ a₁ : α, b ∈ f.fix a₁ → sum.inr a₁ ∈ f a₀ → C a₁ → C a₀) :
  @fix_induction' _ _ C _ _ _ h hbase hind = hind a a' h' fa (fix_induction' h' hbase hind) :=
by { unfold fix_induction', rw [fix_induction_spec], simpa [part.get_eq_of_mem fa], }

variables (f : α →. β)

/-- Image of a set under a partial function. -/
def image (s : set α) : set β := f.graph'.image s

lemma image_def (s : set α) : f.image s = {y | ∃ x ∈ s, y ∈ f x} := rfl

lemma mem_image (y : β) (s : set α) : y ∈ f.image s ↔ ∃ x ∈ s, y ∈ f x :=
iff.rfl

lemma image_mono {s t : set α} (h : s ⊆ t) : f.image s ⊆ f.image t :=
rel.image_mono _ h

lemma image_inter (s t : set α) : f.image (s ∩ t) ⊆ f.image s ∩ f.image t :=
rel.image_inter _ s t

lemma image_union (s t : set α) : f.image (s ∪ t) = f.image s ∪ f.image t :=
rel.image_union _ s t

/-- Preimage of a set under a partial function. -/
def preimage (s : set β) : set α := rel.image (λ x y, x ∈ f y) s

lemma preimage_def (s : set β) : f.preimage s = {x | ∃ y ∈ s, y ∈ f x} := rfl

@[simp] lemma mem_preimage (s : set β) (x : α) : x ∈ f.preimage s ↔ ∃ y ∈ s, y ∈ f x := iff.rfl

lemma preimage_subset_dom (s : set β) : f.preimage s ⊆ f.dom :=
λ x ⟨y, ys, fxy⟩, part.dom_iff_mem.mpr ⟨y, fxy⟩

lemma preimage_mono {s t : set β} (h : s ⊆ t) : f.preimage s ⊆ f.preimage t :=
rel.preimage_mono _ h

lemma preimage_inter (s t : set β) : f.preimage (s ∩ t) ⊆ f.preimage s ∩ f.preimage t :=
rel.preimage_inter _ s t

lemma preimage_union (s t : set β) : f.preimage (s ∪ t) = f.preimage s ∪ f.preimage t :=
rel.preimage_union _ s t

lemma preimage_univ : f.preimage set.univ = f.dom :=
by ext; simp [mem_preimage, mem_dom]

lemma coe_preimage (f : α → β) (s : set β) : (f : α →. β).preimage s = f ⁻¹' s :=
by ext; simp

/-- Core of a set `s : set β` with respect to a partial function `f : α →. β`. Set of all `a : α`
such that `f a ∈ s`, if `f a` is defined. -/
def core (s : set β) : set α := f.graph'.core s

lemma core_def (s : set β) : f.core s = {x | ∀ y, y ∈ f x → y ∈ s} := rfl

@[simp] lemma mem_core (x : α) (s : set β) : x ∈ f.core s ↔ ∀ y, y ∈ f x → y ∈ s := iff.rfl

lemma compl_dom_subset_core (s : set β) : f.domᶜ ⊆ f.core s :=
λ x hx y fxy,
absurd ((mem_dom f x).mpr ⟨y, fxy⟩) hx

lemma core_mono {s t : set β} (h : s ⊆ t) : f.core s ⊆ f.core t :=
rel.core_mono _ h

lemma core_inter (s t : set β) : f.core (s ∩ t) = f.core s ∩ f.core t :=
rel.core_inter _ s t

lemma mem_core_res (f : α → β) (s : set α) (t : set β) (x : α) :
  x ∈ (res f s).core t ↔ x ∈ s → f x ∈ t :=
by simp [mem_core, mem_res]

section
open_locale classical

lemma core_res (f : α → β) (s : set α) (t : set β) : (res f s).core t = sᶜ ∪ f ⁻¹' t :=
by { ext, rw mem_core_res, by_cases h : x ∈ s; simp [h] }

end

lemma core_restrict (f : α → β) (s : set β) : (f : α →. β).core s = s.preimage f :=
by ext x; simp [core_def]

lemma preimage_subset_core (f : α →. β) (s : set β) : f.preimage s ⊆ f.core s :=
λ x ⟨y, ys, fxy⟩ y' fxy',
have y = y', from part.mem_unique fxy fxy',
this ▸ ys

lemma preimage_eq (f : α →. β) (s : set β) : f.preimage s = f.core s ∩ f.dom :=
set.eq_of_subset_of_subset
  (set.subset_inter (f.preimage_subset_core s) (f.preimage_subset_dom s))
  (λ x ⟨xcore, xdom⟩,
    let y := (f x).get xdom in
    have ys : y ∈ s, from xcore _ (part.get_mem _),
    show x ∈ f.preimage s, from  ⟨(f x).get xdom, ys, part.get_mem _⟩)

lemma core_eq (f : α →. β) (s : set β) : f.core s = f.preimage s ∪ f.domᶜ :=
by rw [preimage_eq, set.union_distrib_right, set.union_comm (dom f), set.compl_union_self,
        set.inter_univ, set.union_eq_self_of_subset_right (f.compl_dom_subset_core s)]

lemma preimage_as_subtype (f : α →. β) (s : set β) :
  f.as_subtype ⁻¹' s = subtype.val ⁻¹' f.preimage s :=
begin
  ext x,
  simp only [set.mem_preimage, set.mem_set_of_eq, pfun.as_subtype, pfun.mem_preimage],
  show f.fn (x.val) _ ∈ s ↔ ∃ y ∈ s, y ∈ f (x.val),
  exact iff.intro
    (λ h, ⟨_, h, part.get_mem _⟩)
    (λ ⟨y, ys, fxy⟩,
      have f.fn x.val x.property ∈ f x.val := part.get_mem _,
      part.mem_unique fxy this ▸ ys)
end

/-- Turns a function into a partial function to a subtype. -/
def to_subtype (p : β → Prop) (f : α → β) : α →. subtype p := λ a, ⟨p (f a), subtype.mk _⟩

@[simp] lemma dom_to_subtype (p : β → Prop) (f : α → β) : (to_subtype p f).dom = {a | p (f a)} :=
rfl

@[simp] lemma to_subtype_apply (p : β → Prop) (f : α → β) (a : α) :
  to_subtype p f a = ⟨p (f a), subtype.mk _⟩ := rfl

lemma dom_to_subtype_apply_iff {p : β → Prop} {f : α → β} {a : α} :
  (to_subtype p f a).dom ↔ p (f a) := iff.rfl

lemma mem_to_subtype_iff {p : β → Prop} {f : α → β} {a : α} {b : subtype p} :
  b ∈ to_subtype p f a ↔ ↑b = f a :=
by rw [to_subtype_apply, part.mem_mk_iff, exists_subtype_mk_eq_iff, eq_comm]

/-- The identity as a partial function -/
protected def id (α : Type*) : α →. α := part.some

@[simp] lemma coe_id (α : Type*) : ((id : α → α) : α →. α) = pfun.id α := rfl
@[simp] lemma id_apply (a : α) : pfun.id α a = part.some a := rfl

/-- Composition of partial functions as a partial function. -/
def comp (f : β →. γ) (g : α →. β) : α →. γ := λ a, (g a).bind f

@[simp]

@[simp] lemma dom_comp (f : β →. γ) (g : α →. β) : (f.comp g).dom = g.preimage f.dom :=
begin
  ext,
  simp_rw [mem_preimage, mem_dom, comp_apply, part.mem_bind_iff, exists_prop,
    ←exists_and_distrib_right],
  rw exists_comm,
  simp_rw and.comm,
end

@[simp] lemma preimage_comp (f : β →. γ) (g : α →. β) (s :set γ) :
  (f.comp g).preimage s = g.preimage (f.preimage s) :=
begin
  ext,
  simp_rw [mem_preimage, comp_apply, part.mem_bind_iff, exists_prop, ←exists_and_distrib_right,
    ←exists_and_distrib_left],
  rw exists_comm,
  simp_rw [and_assoc, and.comm],
end

@[simp] lemma _root_.part.bind_comp (f : β →. γ) (g : α →. β) (a : part α) :
  a.bind (f.comp g) = (a.bind g).bind f :=
begin
  ext c,
  simp_rw [part.mem_bind_iff, comp_apply, part.mem_bind_iff, exists_prop, ←exists_and_distrib_right,
    ←exists_and_distrib_left],
  rw exists_comm,
  simp_rw and_assoc,
end

@[simp] lemma comp_assoc (f : γ →. δ) (g : β →. γ) (h : α →. β) :
  (f.comp g).comp h = f.comp (g.comp h) :=
ext $ λ _ _, by simp only [comp_apply, part.bind_comp]

-- This can't be `simp`
lemma coe_comp (g : β → γ) (f : α → β) : ((g ∘ f : α → γ) : α →. γ) = (g : β →. γ).comp f :=
ext $ λ _ _, by simp only [coe_val, comp_apply, part.bind_some]

/-- Product of partial functions. -/
def prod_lift (f : α →. β) (g : α →. γ) : α →. β × γ :=
λ x, ⟨(f x).dom ∧ (g x).dom, λ h, ((f x).get h.1, (g x).get h.2)⟩

@[simp] lemma dom_prod_lift (f : α →. β) (g : α →. γ) :
  (f.prod_lift g).dom = {x | (f x).dom ∧ (g x).dom} := rfl

lemma get_prod_lift (f : α →. β) (g : α →. γ) (x : α) (h) :
  (f.prod_lift g x).get h = ((f x).get h.1, (g x).get h.2) := rfl

@[simp] lemma prod_lift_apply (f : α →. β) (g : α →. γ) (x : α) :
  f.prod_lift g x = ⟨(f x).dom ∧ (g x).dom, λ h, ((f x).get h.1, (g x).get h.2)⟩ := rfl

lemma mem_prod_lift {f : α →. β} {g : α →. γ} {x : α} {y : β × γ} :
  y ∈ f.prod_lift g x ↔ y.1 ∈ f x ∧ y.2 ∈ g x :=
begin
  transitivity ∃ hp hq, (f x).get hp = y.1 ∧ (g x).get hq = y.2,
  { simp only [prod_lift, part.mem_mk_iff, and.exists, prod.ext_iff] },
  { simpa only [exists_and_distrib_left, exists_and_distrib_right] }
end

/-- Product of partial functions. -/
def prod_map (f : α →. γ) (g : β →. δ) : α × β →. γ × δ :=
λ x, ⟨(f x.1).dom ∧ (g x.2).dom, λ h, ((f x.1).get h.1, (g x.2).get h.2)⟩

@[simp] lemma dom_prod_map (f : α →. γ) (g : β →. δ) :
  (f.prod_map g).dom = {x | (f x.1).dom ∧ (g x.2).dom} := rfl

lemma get_prod_map (f : α →. γ) (g : β →. δ) (x : α × β) (h) :
  (f.prod_map g x).get h = ((f x.1).get h.1, (g x.2).get h.2) := rfl

@[simp] lemma prod_map_apply (f : α →. γ) (g : β →. δ) (x : α × β) :
  f.prod_map g x = ⟨(f x.1).dom ∧ (g x.2).dom, λ h, ((f x.1).get h.1, (g x.2).get h.2)⟩ := rfl

lemma mem_prod_map {f : α →. γ} {g : β →. δ} {x : α × β} {y : γ × δ} :
  y ∈ f.prod_map g x ↔ y.1 ∈ f x.1 ∧ y.2 ∈ g x.2 :=
begin
  transitivity ∃ hp hq, (f x.1).get hp = y.1 ∧ (g x.2).get hq = y.2,
  { simp only [prod_map, part.mem_mk_iff, and.exists, prod.ext_iff] },
  { simpa only [exists_and_distrib_left, exists_and_distrib_right] }
end

@[simp] lemma prod_lift_fst_comp_snd_comp (f : α →. γ) (g : β →. δ) :
  prod_lift (f.comp ((prod.fst : α × β → α) : α × β →. α))
    (g.comp ((prod.snd : α × β → β) : α × β →. β)) = prod_map f g :=
ext $ λ a, by simp

@[simp] lemma prod_map_id_id : (pfun.id α).prod_map (pfun.id β) = pfun.id _ :=
ext $ λ _ _, by simp [eq_comm]

@[simp] lemma prod_map_comp_comp (f₁ : α →. β) (f₂ : β →. γ) (g₁ : δ →. ε) (g₂ : ε →. ι) :
  (f₂.comp f₁).prod_map (g₂.comp g₁) = (f₂.prod_map g₂).comp (f₁.prod_map g₁) :=
ext $ λ _ _, by tidy

end pfun


variables {p11 p21 p31 p12 p22 p32 : Prop}

-- esses dois lemas, que eu chamo de segundos, fazem o processo de eliminação para p31 e p32.
-- O processo nas três eliminações é o mesmo.

lemma second_elim2 (h: (p11 ∨ p12) ∧ (p21 ∨ p22) ∧ (p31 ∨ p32)) (h1: p12) (h2: p21) :
            (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32) :=
show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
from or.elim (h.right.right)
    (assume : p31,
    show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
        from or.inr (or.inr (or.inl (and.intro h2 this))))
    (assume : p32,
    show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
        from or.inr (or.inr (or.inr (or.inr (or.inl (and.intro h1 this))))))

lemma second_elim1 (h: (p11 ∨ p12) ∧ (p21 ∨ p22) ∧ (p31 ∨ p32)) (h1: p11) (h2: p22) :
            (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32) :=
show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
from or.elim (h.right.right)
    (assume : p31,
    show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
        from or.inr (or.inl (and.intro h1 this)))
    (assume : p32,
    show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
        from or.inr (or.inr (or.inr (or.inr (or.inr (and.intro h2 this))))))

-- Demonstro supondo p11 no primeiro e p12 no segundo.
-- Mais uma vez utilizo a ideia da eliminação da união, agora de p21, p22
-- Note que as introduçõs tornam-se complexas pois tenho que inserir um ou no meio de outros.

lemma first_elim2 (h: (p11 ∨ p12) ∧ (p21 ∨ p22) ∧ (p31 ∨ p32)) (h1: p12) :
            (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32) :=
show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
    from or.elim (h.right.left)
        (assume : p21,
        show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
            from second_elim2 h h1 this)
        (assume : p22,
        show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
            from or.inr (or.inr (or.inr (or.inl (and.intro h1 this)))))

lemma first_elim1 (h: (p11 ∨ p12) ∧ (p21 ∨ p22) ∧ (p31 ∨ p32)) (h1: p11) :
            (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32) :=
show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
    from or.elim (h.right.left)
        (assume : p21,
        show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
            from or.inl (and.intro h1 this))
        (assume : p22,
        show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
            from second_elim1 h h1 this)

-- Eu quero provar a seguinte aplicação. A ideia é utilizar a eliminação da união de p11 e p12.
-- Para cada um deles, abrir nas possibilidades onde p21 e p22 passam pelo mesmo processo.

theorem pigeons3: (p11 ∨ p12) ∧ (p21 ∨ p22) ∧ (p31 ∨ p32) →
         (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨  (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32) :=
assume h: (p11 ∨ p12) ∧ (p21 ∨ p22) ∧ (p31 ∨ p32),
show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
    from or.elim (h.left)
        (assume : p11,
        show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
            from first_elim1 h this)
        (assume : p12,
        show (p11 ∧ p21) ∨ (p11 ∧ p31) ∨ (p21 ∧ p31) ∨ (p12 ∧ p22) ∨ (p12 ∧ p32) ∨ (p22 ∧ p32),
            from first_elim2 h this)


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Devon Tuma
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.submonoid.operations
import Mathlib.group_theory.submonoid.membership
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Non-zero divisors

In this file we define the submonoid `non_zero_divisors` of a `monoid_with_zero`.
-/

/-- The submonoid of non-zero-divisors of a `monoid_with_zero` `R`. -/
def non_zero_divisors (R : Type u_1) [monoid_with_zero R] : submonoid R :=
  submonoid.mk (set_of fun (x : R) => ∀ (z : R), z * x = 0 → z = 0) sorry sorry

theorem mul_mem_non_zero_divisors {R : Type u_1} [comm_ring R] {a : R} {b : R} :
    a * b ∈ non_zero_divisors R ↔ a ∈ non_zero_divisors R ∧ b ∈ non_zero_divisors R :=
  sorry

theorem eq_zero_of_ne_zero_of_mul_right_eq_zero {A : Type u_2} [integral_domain A] {x : A} {y : A}
    (hnx : x ≠ 0) (hxy : y * x = 0) : y = 0 :=
  or.resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero hxy) hnx

theorem eq_zero_of_ne_zero_of_mul_left_eq_zero {A : Type u_2} [integral_domain A] {x : A} {y : A}
    (hnx : x ≠ 0) (hxy : x * y = 0) : y = 0 :=
  or.resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero hxy) hnx

theorem mem_non_zero_divisors_iff_ne_zero {A : Type u_2} [integral_domain A] {x : A} :
    x ∈ non_zero_divisors A ↔ x ≠ 0 :=
  sorry

theorem map_ne_zero_of_mem_non_zero_divisors {R : Type u_1} [comm_ring R] [nontrivial R]
    {B : Type u_2} [ring B] {g : R →+* B} (hg : function.injective ⇑g)
    {x : ↥(non_zero_divisors R)} : coe_fn g ↑x ≠ 0 :=
  fun (h0 : coe_fn g ↑x = 0) =>
    one_ne_zero
      (subtype.property x 1
        (Eq.symm (one_mul (subtype.val x)) ▸ hg (trans h0 (Eq.symm (ring_hom.map_zero g)))))

theorem map_mem_non_zero_divisors {A : Type u_2} [integral_domain A] {B : Type u_1}
    [integral_domain B] {g : A →+* B} (hg : function.injective ⇑g) {x : ↥(non_zero_divisors A)} :
    coe_fn g ↑x ∈ non_zero_divisors B :=
  fun (z : B) (hz : z * coe_fn g ↑x = 0) =>
    eq_zero_of_ne_zero_of_mul_right_eq_zero (map_ne_zero_of_mem_non_zero_divisors hg) hz

theorem le_non_zero_divisors_of_domain {A : Type u_2} [integral_domain A] {M : submonoid A}
    (hM : ¬↑0 ∈ M) : M ≤ non_zero_divisors A :=
  fun (x : A) (hx : x ∈ M) (y : A) (hy : y * x = 0) =>
    or.rec_on (eq_zero_or_eq_zero_of_mul_eq_zero hy) (fun (h : y = 0) => h)
      fun (h : x = 0) => absurd (h ▸ hx) hM

theorem powers_le_non_zero_divisors_of_domain {A : Type u_2} [integral_domain A] {a : A}
    (ha : a ≠ 0) : submonoid.powers a ≤ non_zero_divisors A :=
  le_non_zero_divisors_of_domain
    fun (h : ↑0 ∈ submonoid.powers a) =>
      absurd (Exists.rec_on h fun (_x : ℕ) (hn : a ^ _x = ↑0) => pow_eq_zero hn) ha

theorem map_le_non_zero_divisors_of_injective {A : Type u_2} [integral_domain A] {B : Type u_1}
    [integral_domain B] {f : A →+* B} (hf : function.injective ⇑f) {M : submonoid A}
    (hM : M ≤ non_zero_divisors A) : submonoid.map (↑f) M ≤ non_zero_divisors B :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Justus Springer
-/
import order.complete_lattice
import category_theory.limits.shapes.pullbacks
import category_theory.category.preorder
import category_theory.limits.shapes.products
import category_theory.limits.shapes.finite_limits

/-!
# Limits in lattice categories are given by infimums and supremums.
-/

universes w u

open category_theory
open category_theory.limits

namespace category_theory.limits.complete_lattice

section semilattice

variables {α : Type u}

variables {J : Type w} [small_category J] [fin_category J]

/--
The limit cone over any functor from a finite diagram into a `semilattice_inf` with `order_top`.
-/
def finite_limit_cone [semilattice_inf α] [order_top α] (F : J ⥤ α) : limit_cone F :=
{ cone :=
  { X := finset.univ.inf F.obj,
    π := { app := λ j, hom_of_le (finset.inf_le (fintype.complete _)) } },
  is_limit := { lift := λ s, hom_of_le (finset.le_inf (λ j _, (s.π.app j).down.down)) } }

/--
The colimit cocone over any functor from a finite diagram into a `semilattice_sup` with `order_bot`.
-/
def finite_colimit_cocone [semilattice_sup α] [order_bot α] (F : J ⥤ α) : colimit_cocone F :=
{ cocone :=
  { X := finset.univ.sup F.obj,
    ι := { app := λ i, hom_of_le (finset.le_sup (fintype.complete _)) } },
  is_colimit := { desc := λ s, hom_of_le (finset.sup_le (λ j _, (s.ι.app j).down.down)) } }

@[priority 100] -- see Note [lower instance priority]
instance has_finite_limits_of_semilattice_inf_order_top [semilattice_inf α] [order_top α] :
  has_finite_limits α :=
⟨λ J 𝒥₁ 𝒥₂, by exactI { has_limit := λ F, has_limit.mk (finite_limit_cone F) }⟩

@[priority 100] -- see Note [lower instance priority]
instance has_finite_colimits_of_semilattice_sup_order_bot [semilattice_sup α] [order_bot α] :
  has_finite_colimits α :=
⟨λ J 𝒥₁ 𝒥₂, by exactI { has_colimit := λ F, has_colimit.mk (finite_colimit_cocone F) }⟩

/--
The limit of a functor from a finite diagram into a `semilattice_inf` with `order_top` is the
infimum of the objects in the image.
-/
lemma finite_limit_eq_finset_univ_inf [semilattice_inf α] [order_top α] (F : J ⥤ α) :
  limit F = finset.univ.inf F.obj :=
(is_limit.cone_point_unique_up_to_iso (limit.is_limit F)
  (finite_limit_cone F).is_limit).to_eq

/--
The colimit of a functor from a finite diagram into a `semilattice_sup` with `order_bot`
is the supremum of the objects in the image.
-/
lemma finite_colimit_eq_finset_univ_sup [semilattice_sup α] [order_bot α] (F : J ⥤ α) :
  colimit F = finset.univ.sup F.obj :=
(is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F)
  (finite_colimit_cocone F).is_colimit).to_eq

/--
A finite product in the category of a `semilattice_inf` with `order_top` is the same as the infimum.
-/
lemma finite_product_eq_finset_inf [semilattice_inf α] [order_top α] {ι : Type u}
  [fintype ι] (f : ι → α) : (∏ f) = (fintype.elems ι).inf f :=
begin
  transitivity,
  exact (is_limit.cone_point_unique_up_to_iso (limit.is_limit _)
    (finite_limit_cone (discrete.functor f)).is_limit).to_eq,
  change finset.univ.inf (f ∘ discrete_equiv.to_embedding) = (fintype.elems ι).inf f,
  simp only [←finset.inf_map, finset.univ_map_equiv_to_embedding],
  refl,
end

/--
A finite coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the
supremum.
-/
lemma finite_coproduct_eq_finset_sup [semilattice_sup α] [order_bot α] {ι : Type u}
  [fintype ι] (f : ι → α) : (∐ f) = (fintype.elems ι).sup f :=
begin
  transitivity,
  exact (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
    (finite_colimit_cocone (discrete.functor f)).is_colimit).to_eq,
  change finset.univ.sup (f ∘ discrete_equiv.to_embedding) = (fintype.elems ι).sup f,
  simp only [←finset.sup_map, finset.univ_map_equiv_to_embedding],
  refl,
end

@[priority 100] -- see Note [lower instance priority]
instance [semilattice_inf α] [order_top α] : has_binary_products α :=
begin
  haveI : ∀ (x y : α), has_limit (pair x y),
  { letI := has_finite_limits_of_has_finite_limits_of_size.{u} α, apply_instance },
  apply has_binary_products_of_has_limit_pair
end

/--
The binary product in the category of a `semilattice_inf` with `order_top` is the same as the
infimum.
-/
@[simp]
lemma prod_eq_inf [semilattice_inf α] [order_top α] (x y : α) : limits.prod x y = x ⊓ y :=
calc limits.prod x y = limit (pair x y) : rfl
... = finset.univ.inf (pair x y).obj : by rw finite_limit_eq_finset_univ_inf (pair.{u} x y)
... = x ⊓ (y ⊓ ⊤) : rfl -- Note: finset.inf is realized as a fold, hence the definitional equality
... = x ⊓ y : by rw inf_top_eq

@[priority 100] -- see Note [lower instance priority]
instance [semilattice_sup α] [order_bot α] : has_binary_coproducts α :=
begin
  haveI : ∀ (x y : α), has_colimit (pair x y),
  { letI := has_finite_colimits_of_has_finite_colimits_of_size.{u} α, apply_instance },
  apply has_binary_coproducts_of_has_colimit_pair
end

/--
The binary coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the
supremum.
-/
@[simp]
lemma coprod_eq_sup [semilattice_sup α] [order_bot α] (x y : α) : limits.coprod x y = x ⊔ y :=
calc limits.coprod x y = colimit (pair x y) : rfl
... = finset.univ.sup (pair x y).obj : by rw finite_colimit_eq_finset_univ_sup (pair x y)
... = x ⊔ (y ⊔ ⊥) : rfl -- Note: finset.sup is realized as a fold, hence the definitional equality
... = x ⊔ y : by rw sup_bot_eq

/--
The pullback in the category of a `semilattice_inf` with `order_top` is the same as the infimum
over the objects.
-/
@[simp]
lemma pullback_eq_inf [semilattice_inf α] [order_top α] {x y z : α} (f : x ⟶ z) (g : y ⟶ z) :
  pullback f g = x ⊓ y :=
calc pullback f g = limit (cospan f g) : rfl
... = finset.univ.inf (cospan f g).obj : by rw finite_limit_eq_finset_univ_inf
... = z ⊓ (x ⊓ (y ⊓ ⊤)) : rfl
... = z ⊓ (x ⊓ y) : by rw inf_top_eq
... = x ⊓ y : inf_eq_right.mpr (inf_le_of_left_le f.le)

/--
The pushout in the category of a `semilattice_sup` with `order_bot` is the same as the supremum
over the objects.
-/
@[simp]
lemma pushout_eq_sup [semilattice_sup α] [order_bot α] (x y z : α) (f : z ⟶ x) (g : z ⟶ y) :
  pushout f g = x ⊔ y :=
calc pushout f g = colimit (span f g) : rfl
... = finset.univ.sup (span f g).obj : by rw finite_colimit_eq_finset_univ_sup
... = z ⊔ (x ⊔ (y ⊔ ⊥)) : rfl
... = z ⊔ (x ⊔ y) : by rw sup_bot_eq
... = x ⊔ y : sup_eq_right.mpr (le_sup_of_le_left f.le)

end semilattice

variables {α : Type u} [complete_lattice α]
variables {J : Type u} [small_category J]

/--
The limit cone over any functor into a complete lattice.
-/
def limit_cone (F : J ⥤ α) : limit_cone F :=
{ cone :=
  { X := infi F.obj,
    π :=
    { app := λ j, hom_of_le (complete_lattice.Inf_le _ _ (set.mem_range_self _)) } },
  is_limit :=
  { lift := λ s, hom_of_le (complete_lattice.le_Inf _ _
    begin rintros _ ⟨j, rfl⟩, exact (s.π.app j).le, end) } }

/--
The colimit cocone over any functor into a complete lattice.
-/
def colimit_cocone (F : J ⥤ α) : colimit_cocone F :=
{ cocone :=
  { X := supr F.obj,
    ι :=
    { app := λ j, hom_of_le (complete_lattice.le_Sup _ _ (set.mem_range_self _)) } },
  is_colimit :=
  { desc := λ s, hom_of_le (complete_lattice.Sup_le _ _
    begin rintros _ ⟨j, rfl⟩, exact (s.ι.app j).le, end) } }

-- It would be nice to only use the `Inf` half of the complete lattice, but
-- this seems not to have been described separately.
@[priority 100] -- see Note [lower instance priority]
instance has_limits_of_complete_lattice : has_limits α :=
{ has_limits_of_shape := λ J 𝒥, by exactI
  { has_limit := λ F, has_limit.mk (limit_cone F) } }

@[priority 100] -- see Note [lower instance priority]
instance has_colimits_of_complete_lattice : has_colimits α :=
{ has_colimits_of_shape := λ J 𝒥, by exactI
  { has_colimit := λ F, has_colimit.mk (colimit_cocone F) } }

/--
The limit of a functor into a complete lattice is the infimum of the objects in the image.
-/
lemma limit_eq_infi (F : J ⥤ α) : limit F = infi F.obj :=
(is_limit.cone_point_unique_up_to_iso (limit.is_limit F)
  (limit_cone F).is_limit).to_eq

/--
The colimit of a functor into a complete lattice is the supremum of the objects in the image.
-/
lemma colimit_eq_supr (F : J ⥤ α) : colimit F = supr F.obj :=
(is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F)
  (colimit_cocone F).is_colimit).to_eq

end category_theory.limits.complete_lattice


import .defs
import .sequences
import .bolzano_weierstrass

open espace_metrique
open_locale classical
noncomputable theory

section suites

variables {X:Type} [espace_metrique X]
variables {Y:Type} [espace_metrique Y]
variables {Z:Type} [espace_metrique Z]

def fonction_distance (x : ℕ → X) (y: X) (n: ℕ) := d (x n) y

lemma cauchy_est_bornee {x: ℕ → X} : cauchy x → bornee x :=
begin
intros cauch y,
obtain ⟨ N, H ⟩ : ∃ N, ∀ p ≥ N, ∀ q ≥ N, ((d (x p) (x q)) < 1),
apply cauch, linarith,
set Limage := { M: ℝ | ∃ n ≤ N, M = d (x n) y },
have limage_finiteness: Limage.finite := begin
  have: ((fonction_distance x y) '' ({ i: ℕ | i ≤ N })) = Limage := begin
    {
      ext,
      split,
      intro h1,
      simp,
      simp at h1,
      cases h1 with n h1,
      rw fonction_distance at h1,
      use n,
      cc,
      intro h2,
      simp,
      simp at h2,
      cases h2 with n h2,
      rw ← fonction_distance at h2,
      use n,
      cc,
    }
  end,
  rw ← this,
  apply set.finite_image,
  exact set.finite_le_nat N,
  end,
have limage_nonempty: Limage.nonempty := begin
  use (d (x 0) y),
  simp,
  use 0,
  split,
  exact zero_le N,
  refl,
end,
have sup_est_atteint: Sup Limage ∈ Limage
  := set.finite.has_a_reached_sup limage_finiteness limage_nonempty,
  -- f : n → d (x n) y
  -- f : ℕ → ℝ
  -- f([[0, N]]).finite <=> [[0, N]].finite
simp at sup_est_atteint,
obtain ⟨ n, hn, sup_atteint ⟩ := sup_est_atteint,
use (max (d (x n) y) (1 + d (x N) y)), -- max(d(x_n, y), 1 + d(x_N, y))
split,
refine lt_max_iff.mpr _,
right,
apply add_pos_of_pos_of_nonneg,
exact zero_lt_one,
exact d_pos _ _,
intro p,
by_cases (p ≥ N),
have h1: d (x p) (x N) + d (x N) y ≤ max (d (x n) y) (1 + d (x N) y) := begin
    {
      transitivity,
      apply add_le_add,
      apply le_of_lt,
      apply H _ h N (le_refl _),
      exact le_refl (d (x N) y),
      exact le_max_right _ _,
    }
  end,
have h2: d (x p) y ≤ d (x p) (x N) + d (x N) y := triangle (x p) (x N) y,
exact le_trans h2 h1,
refine le_max_iff.mpr _,
left,
simp at h,
rw ← sup_atteint,
apply le_cSup,
apply set.bdd_above_finite,
exact limage_finiteness,
simp,
use p,
split,
exact le_of_lt h,
refl,
end

lemma dist_lt_of_ne {x: X} {y: X} : d x y ≠ 0 → d x y > 0 :=
begin
intro dnnz,
simp,
refine lt_of_le_of_ne _ (ne.symm dnnz),
apply espace_metrique.d_pos,
end

lemma eq_of_dist_lt {x: X} {y: X} : (∀ ε > 0, d x y < ε) → x = y := begin
  contrapose!,
  intro hnnz,
  use ((d x y)/2),
  split,
  apply div_pos_of_pos_of_pos,
  apply dist_lt_of_ne,
  revert hnnz,
  contrapose!,
  exact espace_metrique.sep x y,
  exact zero_lt_two,
  apply le_of_lt,
  apply div_two_lt_of_pos,
  apply dist_lt_of_ne,
  revert hnnz,
  contrapose!,
  exact espace_metrique.sep x y,
end

lemma cauchy_admet_une_va {x: ℕ → X} : cauchy x → ∀ l₁ : X, ∀ l₂ : X, adhere x l₁ ∧ adhere x l₂ → l₁ = l₂ :=
begin
intros cauch l1 l2 h,
apply eq_of_dist_lt,
intros ε hε,
have hε3 : ε/3 > 0 := by linarith,
obtain ⟨ n₀, h_cauchy ⟩ := cauch (ε/3) hε3,
obtain ⟨ p₁ , ⟨ hp₁, hl₁ ⟩ ⟩ := h.1 (ε/3) hε3 (n₀),
obtain ⟨ p₂ , ⟨ hp₂ , hl₂ ⟩ ⟩ := h.2 (ε/3) hε3 (n₀),
calc
  d l1 l2 ≤ d l1 (x p₁) + d (x p₁) l2 : espace_metrique.triangle _ _ _
    ... = d l1 (x p₁) + d (x p₁) l2 : by rw espace_metrique.sym l1 (x p₁)
    ... < ε/3 + d (x p₁) l2 : add_lt_add_right hl₁ (d (x p₁) l2)
    ... ≤ ε/3 + d (x p₁) (x p₂) + d (x p₂) l2 : begin have := espace_metrique.triangle (x p₁) (x p₂ ) l2, rw add_assoc (ε/3)  (d (x p₁) (x p₂)) (d (x p₂) l2), exact add_le_add_left this (ε/3), end
    ... < ε/3 + ε/3 + d (x p₂) l2 : begin have := h_cauchy p₁ hp₁ p₂ hp₂, rw add_comm (ε/3) (d (x p₁) (x p₂)), rw add_assoc, rw add_assoc, exact add_lt_add_right this (ε / 3 + d (x p₂) l2), end
    ... = ε/3 + ε/3 + d l2 (x p₂) : by rw espace_metrique.sym _ _
    ... < ε/3 + ε/3 + ε/3 : add_lt_add_left hl₂ (ε/3 + ε/3)
    ... = ε : by ring,
end

lemma converge_of_va_for_cauchy {x: ℕ → X} {l: X} : adhere x l → cauchy x → converge x l :=
begin
  intros hadh hc,
  intros ε hε,
  obtain ⟨ N, hc ⟩ := hc (ε/2) (by linarith),
  use N,
  obtain ⟨ M, ⟨ hM, hadh ⟩ ⟩ := hadh (ε/2) (by linarith) N,
  intros n hN,
  have hc := hc M hM n hN,
  calc
    d l (x n) ≤ d l (x M) + d (x M) (x n) : espace_metrique.triangle _ _ _
    ... < ε/2 + d (x M) (x n) : add_lt_add_right hadh _
    ... < ε/2 + ε/2 : add_lt_add_left hc _
    ... = ε : by ring
end

lemma converge_of_unicite_va (H: complete X) {x: ℕ → X} {l: X}: adhere x l → (∀ l', adhere x l' → l = l') → converge x l :=
  sorry

lemma unicite_limite (x: ℕ → X) (l₁ : X) (l₂ : X) :
 (converge x l₁) → (converge x l₂) → l₁ = l₂ :=
begin
intros hconv1 hconv2,
apply eq_of_dist_lt,
intros ε hε,
obtain ⟨ N₀, hcc1 ⟩ := hconv1 (ε/2) (by linarith),
obtain ⟨ N₁, hcc2 ⟩ := hconv2 (ε/2) (by linarith),
set N₂ := max N₀ N₁,
calc
  d l₁ l₂ ≤ d l₁ (x N₂) + d (x N₂) l₂ : espace_metrique.triangle _ _ _
  ... = d l₁ (x N₂) + d l₂ (x N₂) : by rw espace_metrique.sym (x N₂) l₂
  ... < d l₁ (x N₂) + ε/2 : add_lt_add_left (hcc2 N₂ (le_max_right _ _)) _
  ... < ε/2 + ε/2 : add_lt_add_right (hcc1 N₂ (le_max_left _ _)) _
  ... ≤ ε : by simp
end

theorem R_is_complete : complete ℝ :=
begin
 intros x c,
 have := bolzano_weierstrass (cauchy_est_bornee c),
 obtain ⟨ l ⟩ := this,
 use l,
 exact converge_of_va_for_cauchy this_h c,
end

-- On définit la suite des distances entre deux suites,
-- appelée le pre_ecart --

def pre_ecart (x : ℕ → X) (y : ℕ → X) : ℕ → ℝ  :=
 λ n : ℕ, d (x n) (y n)
-- d(d(x, y), d(z, t)) ≤ d(x, z) + d(y, t)
-- idée: |d(x, y) - d(z,t)| ≤ d(x, z) + d(y, t)
-- 1er cas: d(x, y) ≤ d(z, t)
-- DONC: d(z, t) ≤ d(x, y) + d(x, z) + d(y, t)
-- d(z, t) ≤ d(z, x) + d(x, y) + d(y, t) (inégalité trig)
-- 2ème cas: d(x, y) ≤ d(y, t) + d(t, z) + d(z, x)
-- or: d(x, y) ≤ d(x, z) + d(z, t) + d(t, y) (inég trig)
-- 2 coups d'inégalité triangulaires, en distiguant sur le signe de d(x,y) - d(z,t).
lemma dist_ineg_utile (x y z t:X) : d (d x y)  (d z t) ≤ d x z + d y t:=
begin
rw real.dist_eq,
apply abs_le_of_le_of_neg_le,
rw sub_le_iff_le_add,
calc
  d x y ≤ d x z + d z y : espace_metrique.triangle _ _ _
  ... ≤ d x z + (d z t + d t y) : add_le_add_left (espace_metrique.triangle z t y) _
  ... = d x z + d z t + d y t : by rw [espace_metrique.sym t y, ← add_assoc]
  ... = d x z + d y t + d z t : by ring, -- there must be something better.
simp,
rw sub_le_iff_le_add,
calc
  d z t ≤ d z x + d x t : espace_metrique.triangle _ _ _
  ... ≤ d z x + (d x y + d y t) : add_le_add_left (espace_metrique.triangle x y t) _
  ... = d x z + d x y + d y t : by rw [espace_metrique.sym z x, ← add_assoc]
  ... = d x z + d y t + d x y : by ring
end

/-- on démontre que le pré-écart est une suite de Cauchy --/
-- montrer que (d(x_n, y_n))_n est de Cauchy
-- i.e. pour tout eps > 0,
-- pour tout (n, m) assez grands, d(d(x_n, y_n), d(x_m, y_m)) < eps
-- or: d(d(x_n, y_n), d(x_m, y_m)) ≤ d(x_n, x_m) + d(y_n, y_m) ≤ 2eps

lemma pre_ecart_cauchy (x y : ℕ →  X) (h1 : cauchy x) (h2 : cauchy y):
  cauchy (pre_ecart x y):=
 begin
  set Cxy := pre_ecart x y with hceq,
  intros ε hε,
  obtain ⟨ N, hc1 ⟩ := h1 (ε/2) (by linarith),
  obtain ⟨ M, hc2 ⟩ := h2 (ε/2) (by linarith),
  use (max N M),
  intros p hp q hq,
  rw [hceq, pre_ecart],
  simp,
  calc
    d (d (x p) (y p)) (d (x q) (y q)) ≤ d (x p) (x q) + d (y p) (y q) : dist_ineg_utile _ _ _ _
    ... < ε/2 + d (y p) (y q) : add_lt_add_right (hc1 p (le_of_max_le_left hp) q (le_of_max_le_left hq)) _
    ... < ε/2 + ε/2 : add_lt_add_left (hc2 p (le_of_max_le_right hp) q (le_of_max_le_right hq)) _
    ... = ε : by simp,
 end

 lemma pre_ecart.triangle (x y z: ℕ → X):
  ∀ n, pre_ecart x z n ≤ pre_ecart x y n + pre_ecart y z n := begin
  intro n,
  rw pre_ecart,
  rw pre_ecart,
  rw pre_ecart,
  simp,
  exact espace_metrique.triangle _ _ _,
end

def cauchy.limit (x: ℕ → ℝ) (H: cauchy x): ℝ := classical.some (R_is_complete x H)
lemma cauchy.converge_of_limit (x: ℕ → ℝ) (H: cauchy x): converge x (cauchy.limit x H) :=
  classical.some_spec (R_is_complete x H)

lemma cauchy.limit_ge_of_seq_ge (x: ℕ → ℝ) (H: cauchy x) (a: ℝ): (∀ n, x n ≥ a) → (cauchy.limit x H) ≥ a :=
begin
intro Hineq,
set l := cauchy.limit x H with hl,
by_contra hla,
push_neg at hla,
set ε := a - l with hε,
obtain ⟨ N, hcv ⟩ := cauchy.converge_of_limit x H (ε/2) (by linarith),
rw ← hl at hcv,
have hcv_N: (x N) - l < ε/2 := by calc
    (x N) - l ≤ abs ((x N) - l) : le_abs_self _
    ... = abs (l - (x N)) : abs_sub _ _
    ... < ε/2 : hcv N (by simp),
have Hineq_N: (x N) ≥ l + ε := by calc
    (x N) ≥ a : Hineq _
    ... = l + ε : by linarith,
  linarith,
end

lemma cauchy.limit_le_of_seq_le (x: ℕ → ℝ) (H: cauchy x) (a: ℝ): (∀ n, x n ≤ a) → (cauchy.limit x H) ≤ a :=
begin
intro Hineq,
set l := cauchy.limit x H with hl,
by_contra hla,
push_neg at hla,
set ε := l - a with hε,
obtain ⟨ N, hcv ⟩ := cauchy.converge_of_limit x H (ε/2) (by linarith),
rw ← hl at hcv,
have hcv_N: l - (x N) < ε/2 := by calc
    l - (x N) ≤ abs (l - (x N)) : le_abs_self _
    ... < ε/2 : hcv N (by simp),
have Hineq_N: (x N) ≤ l - ε := by calc
  (x N) ≤ a : Hineq _
  ... = l - ε: by linarith,
  linarith,
end

lemma cauchy.cauchy_of_add {x y: ℕ → ℝ} (Hx: cauchy x) (Hy: cauchy y): cauchy (x + y) := begin
  intros ε hε,
  obtain ⟨ N, hX ⟩ := Hx (ε/2) (by linarith),
  obtain ⟨ M, hY ⟩ := Hy (ε/2) (by linarith),
  use (max N M),
  intros p hNMp q hNMq,
  rw real.dist_eq,
  calc
    abs ((x + y) p - (x + y) q) = abs ((x p + y p) - (x q + y q)) : by simp
    ... = abs (x p - x q + (y p - y q)) : by rw add_sub_comm _ _ _ _
    ... ≤ abs (x p - x q) + abs (y p - y q) : abs_add _ _
    ... = d (x p) (x q) + d (y p) (y q) : by rw [← real.dist_eq (x p) (x q), ← real.dist_eq (y p) (y q)]
    ... < ε/2 + ε/2 :
      add_lt_add (hX p (le_of_max_le_left hNMp) q (le_of_max_le_left hNMq)) (hY p (le_of_max_le_right hNMp) q (le_of_max_le_right hNMq))
    ... = ε : by simp,
end

lemma cauchy.cauchy_of_neg {x: ℕ → ℝ} (Hx: cauchy x):
  cauchy (-x) := begin
  intros ε hε,
  obtain ⟨ N, hN ⟩ := Hx ε hε,
  use N,
  intros p hp q hq,
  rw real.dist_eq,
  simp,
  rw ← real.dist_eq,
  rw espace_metrique.sym _ _,
  exact hN p hp q hq,
end

lemma cauchy.cauchy_of_sub {x y: ℕ → ℝ} (Hx: cauchy x) (Hy: cauchy y): cauchy (x - y) := begin
  rw sub_eq_add_neg,
  apply cauchy.cauchy_of_add,
  exact Hx,
  exact cauchy.cauchy_of_neg Hy,
end

@[simp]
lemma cauchy.limit_add_eq_add_limit {x y: ℕ → ℝ} (Hx: cauchy x) (Hy: cauchy y):
  cauchy.limit (x + y) (cauchy.cauchy_of_add Hx Hy) = cauchy.limit x Hx + cauchy.limit y Hy := begin
  apply unicite_limite (x + y),
  exact cauchy.converge_of_limit _ _,
  apply add_converge_add,
  split,
  repeat {exact cauchy.converge_of_limit _ _},
end

@[simp]
lemma cauchy.limit_neg_eq_neg_limit {x: ℕ → ℝ} (Hx: cauchy x): cauchy.limit (-x) (cauchy.cauchy_of_neg Hx) = - cauchy.limit x Hx :=
begin
  apply unicite_limite (-x),
  exact cauchy.converge_of_limit _ _,
  apply neg_converge,
  exact cauchy.converge_of_limit _ _,
end

lemma cauchy.limit_sub_eq_sub_limit (x y: ℕ → ℝ) (Hx: cauchy x) (Hy: cauchy y):
  cauchy.limit (x - y) (cauchy.cauchy_of_sub Hx Hy) = cauchy.limit x Hx - cauchy.limit y Hy := begin
  conv {
    congr,
    congr,
    rw sub_eq_add_neg x y,
    skip,
    skip,
  },
  rw cauchy.limit_add_eq_add_limit Hx (cauchy.cauchy_of_neg Hy),
  rw cauchy.limit_neg_eq_neg_limit Hy,
  rw sub_eq_add_neg,
end

lemma cauchy.limit_le_of_limit_le {x y: ℕ → ℝ} (Hx: cauchy x) (Hy: cauchy y):
  (∀ n: ℕ, x n ≤ y n) → (cauchy.limit x Hx) ≤ (cauchy.limit y Hy) := begin
  intro Hc,
  rw ← sub_nonpos,
  rw ← cauchy.limit_sub_eq_sub_limit,
  apply cauchy.limit_le_of_seq_le,
  simp,
  exact Hc,
end

lemma cauchy.limit_le_of_add_seq_le {x y z: ℕ → ℝ} (Hx: cauchy x) (Hy: cauchy y) (Hz: cauchy z):
  (∀ n: ℕ, x n ≤ y n + z n) → (cauchy.limit x Hx) ≤ (cauchy.limit y Hy) + (cauchy.limit z Hz) := begin
  intro Hc,
  rw ← cauchy.limit_add_eq_add_limit Hy Hz,
  apply cauchy.limit_le_of_limit_le,
  exact Hc,
end

lemma cauchy.cauchy_of_constant_real_seq (c: ℝ): cauchy (λ n, c) := begin
intros ε hε,
simp,
use 0,
intros p hq q hp,
rw espace_metrique.presep,
exact hε,
refl,
end

lemma cauchy.converge_of_constant (c: ℝ): converge (λ x, c) c := begin
intros ε hε,
use 0,
intros n hn,
simp,
rw espace_metrique.presep,
exact hε,
refl,
end

lemma cauchy.constant_limit (c: ℝ): cauchy.limit (λ x, c) (cauchy.cauchy_of_constant_real_seq c) = c := begin
apply unicite_limite (λ x, c),
exact cauchy.converge_of_limit _ _,
exact cauchy.converge_of_constant _,
end

lemma cauchy.pre_ecart_sym (x y: ℕ → X): pre_ecart x y = pre_ecart y x := begin
rw pre_ecart,
rw pre_ecart,
ext,
exact espace_metrique.sym _ _,
end

end suites