/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.asymptotics
import Mathlib.analysis.normed_space.ordered
import Mathlib.analysis.normed_space.bounded_linear_maps
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Asymptotic equivalence

In this file, we define the relation `is_equivalent u v l`, which means that `u-v` is little o of
`v` along the filter `l`.

Unlike `is_[oO]` relations, this one requires `u` and `v` to have the same codomaine `β`. While the
definition only requires `β` to be a `normed_group`, most interesting properties require it to be a
`normed_field`.

## Notations

We introduce the notation `u ~[l] v := is_equivalent u v l`, which you can use by opening the
`asymptotics` locale.

## Main results

If `β` is a `normed_group` :

- `_ ~[l] _` is an equivalence relation
- Equivalent statements for `u ~[l] const _ c` :
  - If `c ≠ 0`, this is true iff `tendsto u l (𝓝 c)` (see `is_equivalent_const_iff_tendsto`)
  - For `c = 0`, this is true iff `u =ᶠ[l] 0` (see `is_equivalent_zero_iff_eventually_zero`)

If `β` is a `normed_field` :

- Alternative characterization of the relation (see `is_equivalent_iff_exists_eq_mul`) :

  `u ~[l] v ↔ ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v`

- Provided some non-vanishing hypothesis, this can be seen as `u ~[l] v ↔ tendsto (u/v) l (𝓝 1)`
  (see `is_equivalent_iff_tendsto_one`)
- For any constant `c`, `u ~[l] v` implies `tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c)`
  (see `is_equivalent.tendsto_nhds_iff`)
- `*` and `/` are compatible with `_ ~[l] _` (see `is_equivalent.mul` and `is_equivalent.div`)

If `β` is a `normed_linear_ordered_field` :

- If `u ~[l] v`, we have `tendsto u l at_top ↔ tendsto v l at_top`
  (see `is_equivalent.tendsto_at_top_iff`)

-/

namespace asymptotics

/-- Two functions `u` and `v` are said to be asymptotically equivalent along a filter `l` when
    `u x - v x = o(v x)` as x converges along `l`. -/
def is_equivalent {α : Type u_1} {β : Type u_2} [normed_group β] (u : α → β) (v : α → β)
    (l : filter α) :=
  is_o (u - v) v l

theorem is_equivalent.is_o {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β} {v : α → β}
    {l : filter α} (h : is_equivalent u v l) : is_o (u - v) v l :=
  h

theorem is_equivalent.is_O {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β} {v : α → β}
    {l : filter α} (h : is_equivalent u v l) : is_O u v l :=
  iff.mp (is_O.congr_of_sub (is_O.symm (is_o.is_O h))) (is_O_refl (fun (x : α) => v x) l)

theorem is_equivalent.is_O_symm {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β}
    {v : α → β} {l : filter α} (h : is_equivalent u v l) : is_O v u l :=
  sorry

theorem is_equivalent.refl {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β}
    {l : filter α} : is_equivalent u u l :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_equivalent u u l)) (is_equivalent.equations._eqn_1 u u l)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_o (u - u) u l)) (sub_self u))) (is_o_zero u l))

theorem is_equivalent.symm {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β} {v : α → β}
    {l : filter α} (h : is_equivalent u v l) : is_equivalent v u l :=
  is_o.symm (is_o.trans_is_O (is_equivalent.is_o h) (is_equivalent.is_O_symm h))

theorem is_equivalent.trans {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β} {v : α → β}
    {w : α → β} {l : filter α} (huv : is_equivalent u v l) (hvw : is_equivalent v w l) :
    is_equivalent u w l :=
  is_o.triangle (is_o.trans_is_O (is_equivalent.is_o huv) (is_equivalent.is_O hvw))
    (is_equivalent.is_o hvw)

theorem is_equivalent_zero_iff_eventually_zero {α : Type u_1} {β : Type u_2} [normed_group β]
    {u : α → β} {l : filter α} : is_equivalent u 0 l ↔ filter.eventually_eq l u 0 :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (is_equivalent u 0 l ↔ filter.eventually_eq l u 0))
        (is_equivalent.equations._eqn_1 u 0 l)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_o (u - 0) 0 l ↔ filter.eventually_eq l u 0)) (sub_zero u)))
      is_o_zero_right_iff)

theorem is_equivalent_const_iff_tendsto {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β}
    {l : filter α} {c : β} (h : c ≠ 0) :
    is_equivalent u (function.const α c) l ↔ filter.tendsto u l (nhds c) :=
  sorry

theorem is_equivalent.tendsto_const {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β}
    {l : filter α} {c : β} (hu : is_equivalent u (function.const α c) l) :
    filter.tendsto u l (nhds c) :=
  sorry

theorem is_equivalent.tendsto_nhds {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β}
    {v : α → β} {l : filter α} {c : β} (huv : is_equivalent u v l)
    (hu : filter.tendsto u l (nhds c)) : filter.tendsto v l (nhds c) :=
  sorry

theorem is_equivalent.tendsto_nhds_iff {α : Type u_1} {β : Type u_2} [normed_group β] {u : α → β}
    {v : α → β} {l : filter α} {c : β} (huv : is_equivalent u v l) :
    filter.tendsto u l (nhds c) ↔ filter.tendsto v l (nhds c) :=
  { mp := is_equivalent.tendsto_nhds huv,
    mpr := is_equivalent.tendsto_nhds (is_equivalent.symm huv) }

theorem is_equivalent_iff_exists_eq_mul {α : Type u_1} {β : Type u_2} [normed_field β] {u : α → β}
    {v : α → β} {l : filter α} :
    is_equivalent u v l ↔
        ∃ (φ : α → β), ∃ (hφ : filter.tendsto φ l (nhds 1)), filter.eventually_eq l u (φ * v) :=
  sorry

theorem is_equivalent.exists_eq_mul {α : Type u_1} {β : Type u_2} [normed_field β] {u : α → β}
    {v : α → β} {l : filter α} (huv : is_equivalent u v l) :
    ∃ (φ : α → β), ∃ (hφ : filter.tendsto φ l (nhds 1)), filter.eventually_eq l u (φ * v) :=
  iff.mp is_equivalent_iff_exists_eq_mul huv

theorem is_equivalent_of_tendsto_one {α : Type u_1} {β : Type u_2} [normed_field β] {u : α → β}
    {v : α → β} {l : filter α} (hz : filter.eventually (fun (x : α) => v x = 0 → u x = 0) l)
    (huv : filter.tendsto (u / v) l (nhds 1)) : is_equivalent u v l :=
  sorry

theorem is_equivalent_of_tendsto_one' {α : Type u_1} {β : Type u_2} [normed_field β] {u : α → β}
    {v : α → β} {l : filter α} (hz : ∀ (x : α), v x = 0 → u x = 0)
    (huv : filter.tendsto (u / v) l (nhds 1)) : is_equivalent u v l :=
  is_equivalent_of_tendsto_one (filter.eventually_of_forall hz) huv

theorem is_equivalent_iff_tendsto_one {α : Type u_1} {β : Type u_2} [normed_field β] {u : α → β}
    {v : α → β} {l : filter α} (hz : filter.eventually (fun (x : α) => v x ≠ 0) l) :
    is_equivalent u v l ↔ filter.tendsto (u / v) l (nhds 1) :=
  sorry

theorem is_equivalent.smul {α : Type u_1} {E : Type u_2} {𝕜 : Type u_3} [normed_field 𝕜]
    [normed_group E] [normed_space 𝕜 E] {a : α → 𝕜} {b : α → 𝕜} {u : α → E} {v : α → E}
    {l : filter α} (hab : is_equivalent a b l) (huv : is_equivalent u v l) :
    is_equivalent (fun (x : α) => a x • u x) (fun (x : α) => b x • v x) l :=
  sorry

theorem is_equivalent.mul {α : Type u_1} {β : Type u_2} [normed_field β] {t : α → β} {u : α → β}
    {v : α → β} {w : α → β} {l : filter α} (htu : is_equivalent t u l) (hvw : is_equivalent v w l) :
    is_equivalent (t * v) (u * w) l :=
  is_equivalent.smul htu hvw

theorem is_equivalent.inv {α : Type u_1} {β : Type u_2} [normed_field β] {u : α → β} {v : α → β}
    {l : filter α} (huv : is_equivalent u v l) :
    is_equivalent (fun (x : α) => u x⁻¹) (fun (x : α) => v x⁻¹) l :=
  sorry

theorem is_equivalent.div {α : Type u_1} {β : Type u_2} [normed_field β] {t : α → β} {u : α → β}
    {v : α → β} {w : α → β} {l : filter α} (htu : is_equivalent t u l) (hvw : is_equivalent v w l) :
    is_equivalent (fun (x : α) => t x / v x) (fun (x : α) => u x / w x) l :=
  is_equivalent.mul htu (is_equivalent.inv hvw)

theorem is_equivalent.tendsto_at_top {α : Type u_1} {β : Type u_2} [normed_linear_ordered_field β]
    {u : α → β} {v : α → β} {l : filter α} [order_topology β] (huv : is_equivalent u v l)
    (hu : filter.tendsto u l filter.at_top) : filter.tendsto v l filter.at_top :=
  sorry

theorem is_equivalent.tendsto_at_top_iff {α : Type u_1} {β : Type u_2}
    [normed_linear_ordered_field β] {u : α → β} {v : α → β} {l : filter α} [order_topology β]
    (huv : is_equivalent u v l) :
    filter.tendsto u l filter.at_top ↔ filter.tendsto v l filter.at_top :=
  { mp := is_equivalent.tendsto_at_top huv,
    mpr := is_equivalent.tendsto_at_top (is_equivalent.symm huv) }

end Mathlib


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Arthur Paulino, Gabriel Ebner, Moritz Doll
-/

import Mathlib.Tactic.Basic

namespace Mathlib.Tactic

/--
`existsi e₁, e₂, ⋯` applies the tactic `refine ⟨e₁, e₂, ⋯, ?_⟩`. It's purpose is to instantiate
existential quantifiers.

Examples:

```lean
example : ∃ x : Nat, x = x := by
  existsi 42
  rfl

example : ∃ x : Nat, ∃ y : Nat, x = y := by
  existsi 42, 42
  rfl
```
-/

macro "existsi " es:term,+ : tactic =>
  `(tactic|refine ⟨$es,*, ?_⟩)


/-
Copyright (c) 2016 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import data.option.defs
import logic.nonempty
import tactic.cache

/-!
# Miscellaneous function constructions and lemmas

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

universes u v w

namespace function

section
variables {α β γ : Sort*} {f : α → β}

/-- Evaluate a function at an argument. Useful if you want to talk about the partially applied
  `function.eval x : (Π x, β x) → β x`. -/
@[reducible] def eval {β : α → Sort*} (x : α) (f : Π x, β x) : β x := f x

@[simp] lemma eval_apply {β : α → Sort*} (x : α) (f : Π x, β x) : eval x f = f x := rfl

lemma comp_apply {α : Sort u} {β : Sort v} {φ : Sort w} (f : β → φ) (g : α → β) (a : α) :
  (f ∘ g) a = f (g a) := rfl

lemma const_def {y : β} : (λ x : α, y) = const α y := rfl

@[simp] lemma const_apply {y : β} {x : α} : const α y x = y := rfl

@[simp] lemma const_comp {f : α → β} {c : γ} : const β c ∘ f = const α c := rfl

@[simp] lemma comp_const {f : β → γ} {b : β} : f ∘ const α b = const α (f b) := rfl

lemma const_injective [nonempty α] : injective (const α : β → α → β) :=
λ y₁ y₂ h, let ⟨x⟩ := ‹nonempty α› in congr_fun h x

@[simp] lemma const_inj [nonempty α] {y₁ y₂ : β} : const α y₁ = const α y₂ ↔ y₁ = y₂ :=
⟨λ h, const_injective h, λ h, h ▸ rfl⟩

lemma id_def : @id α = λ x, x := rfl

@[simp] lemma on_fun_apply (f : β → β → γ) (g : α → β) (a b : α) : on_fun f g a b = f (g a) (g b) :=
rfl

lemma hfunext {α α': Sort u} {β : α → Sort v} {β' : α' → Sort v} {f : Πa, β a} {f' : Πa, β' a}
  (hα : α = α') (h : ∀a a', a == a' → f a == f' a') : f == f' :=
begin
  subst hα,
  have : ∀a, f a == f' a,
  { intro a, exact h a a (heq.refl a) },
  have : β = β',
  { funext a, exact type_eq_of_heq (this a) },
  subst this,
  apply heq_of_eq,
  funext a,
  exact eq_of_heq (this a)
end

lemma funext_iff {β : α → Sort*} {f₁ f₂ : Π (x : α), β x} : f₁ = f₂ ↔ (∀ a, f₁ a = f₂ a) :=
iff.intro (assume h a, h ▸ rfl) funext

lemma ne_iff {β : α → Sort*} {f₁ f₂ : Π a, β a} : f₁ ≠ f₂ ↔ ∃ a, f₁ a ≠ f₂ a :=
funext_iff.not.trans not_forall

protected lemma bijective.injective {f : α → β} (hf : bijective f) : injective f := hf.1
protected lemma bijective.surjective {f : α → β} (hf : bijective f) : surjective f := hf.2

theorem injective.eq_iff (I : injective f) {a b : α} :
  f a = f b ↔ a = b :=
⟨@I _ _, congr_arg f⟩

theorem injective.eq_iff' (I : injective f) {a b : α} {c : β} (h : f b = c) :
  f a = c ↔ a = b :=
h ▸ I.eq_iff

lemma injective.ne (hf : injective f) {a₁ a₂ : α} : a₁ ≠ a₂ → f a₁ ≠ f a₂ :=
mt (assume h, hf h)

lemma injective.ne_iff (hf : injective f) {x y : α} : f x ≠ f y ↔ x ≠ y :=
⟨mt $ congr_arg f, hf.ne⟩

lemma injective.ne_iff' (hf : injective f) {x y : α} {z : β} (h : f y = z) :
  f x ≠ z ↔ x ≠ y :=
h ▸ hf.ne_iff

/-- If the co-domain `β` of an injective function `f : α → β` has decidable equality, then
the domain `α` also has decidable equality. -/
protected def injective.decidable_eq [decidable_eq β] (I : injective f) : decidable_eq α :=
λ a b, decidable_of_iff _ I.eq_iff

lemma injective.of_comp {g : γ → α} (I : injective (f ∘ g)) : injective g :=
λ x y h, I $ show f (g x) = f (g y), from congr_arg f h

lemma injective.of_comp_iff {f : α → β} (hf : injective f) (g : γ → α) :
  injective (f ∘ g) ↔ injective g :=
⟨injective.of_comp, hf.comp⟩

lemma injective.of_comp_iff' (f : α → β) {g : γ → α} (hg : bijective g) :
  injective (f ∘ g) ↔ injective f :=
⟨ λ h x y, let ⟨x', hx⟩ := hg.surjective x, ⟨y', hy⟩ := hg.surjective y in
    hx ▸ hy ▸ λ hf, h hf ▸ rfl,
  λ h, h.comp hg.injective⟩

/-- Composition by an injective function on the left is itself injective. -/
lemma injective.comp_left {g : β → γ} (hg : function.injective g) :
  function.injective ((∘) g : (α → β) → (α → γ)) :=
λ f₁ f₂ hgf, funext $ λ i, hg $ (congr_fun hgf i : _)

lemma injective_of_subsingleton [subsingleton α] (f : α → β) :
  injective f :=
λ a b ab, subsingleton.elim _ _

lemma injective.dite (p : α → Prop) [decidable_pred p]
  {f : {a : α // p a} → β} {f' : {a : α // ¬ p a} → β}
  (hf : injective f) (hf' : injective f')
  (im_disj : ∀ {x x' : α} {hx : p x} {hx' : ¬ p x'}, f ⟨x, hx⟩ ≠ f' ⟨x', hx'⟩) :
  function.injective (λ x, if h : p x then f ⟨x, h⟩ else f' ⟨x, h⟩) :=
λ x₁ x₂ h, begin
  dsimp only at h,
  by_cases h₁ : p x₁; by_cases h₂ : p x₂,
  { rw [dif_pos h₁, dif_pos h₂] at h, injection (hf h), },
  { rw [dif_pos h₁, dif_neg h₂] at h, exact (im_disj h).elim, },
  { rw [dif_neg h₁, dif_pos h₂] at h, exact (im_disj h.symm).elim, },
  { rw [dif_neg h₁, dif_neg h₂] at h, injection (hf' h), },
end

lemma surjective.of_comp {g : γ → α} (S : surjective (f ∘ g)) : surjective f :=
λ y, let ⟨x, h⟩ := S y in ⟨g x, h⟩

lemma surjective.of_comp_iff (f : α → β) {g : γ → α} (hg : surjective g) :
  surjective (f ∘ g) ↔ surjective f :=
⟨surjective.of_comp, λ h, h.comp hg⟩

lemma surjective.of_comp_iff' (hf : bijective f) (g : γ → α) :
  surjective (f ∘ g) ↔ surjective g :=
⟨λ h x, let ⟨x', hx'⟩ := h (f x) in ⟨x', hf.injective hx'⟩, hf.surjective.comp⟩

instance decidable_eq_pfun (p : Prop) [decidable p] (α : p → Type*)
  [Π hp, decidable_eq (α hp)] : decidable_eq (Π hp, α hp)
| f g := decidable_of_iff (∀ hp, f hp = g hp) funext_iff.symm

protected theorem surjective.forall (hf : surjective f) {p : β → Prop} :
  (∀ y, p y) ↔ ∀ x, p (f x) :=
⟨λ h x, h (f x), λ h y, let ⟨x, hx⟩ := hf y in hx ▸ h x⟩

protected theorem surjective.forall₂ (hf : surjective f) {p : β → β → Prop} :
  (∀ y₁ y₂, p y₁ y₂) ↔ ∀ x₁ x₂, p (f x₁) (f x₂) :=
hf.forall.trans $ forall_congr $ λ x, hf.forall

protected theorem surjective.forall₃ (hf : surjective f) {p : β → β → β → Prop} :
  (∀ y₁ y₂ y₃, p y₁ y₂ y₃) ↔ ∀ x₁ x₂ x₃, p (f x₁) (f x₂) (f x₃) :=
hf.forall.trans $ forall_congr $ λ x, hf.forall₂

protected theorem surjective.exists (hf : surjective f) {p : β → Prop} :
  (∃ y, p y) ↔ ∃ x, p (f x) :=
⟨λ ⟨y, hy⟩, let ⟨x, hx⟩ := hf y in ⟨x, hx.symm ▸ hy⟩, λ ⟨x, hx⟩, ⟨f x, hx⟩⟩

protected theorem surjective.exists₂ (hf : surjective f) {p : β → β → Prop} :
  (∃ y₁ y₂, p y₁ y₂) ↔ ∃ x₁ x₂, p (f x₁) (f x₂) :=
hf.exists.trans $ exists_congr $ λ x, hf.exists

protected theorem surjective.exists₃ (hf : surjective f) {p : β → β → β → Prop} :
  (∃ y₁ y₂ y₃, p y₁ y₂ y₃) ↔ ∃ x₁ x₂ x₃, p (f x₁) (f x₂) (f x₃) :=
hf.exists.trans $ exists_congr $ λ x, hf.exists₂

lemma surjective.injective_comp_right (hf : surjective f) :
  injective (λ g : β → γ, g ∘ f) :=
λ g₁ g₂ h, funext $ hf.forall.2 $ congr_fun h

protected lemma surjective.right_cancellable (hf : surjective f) {g₁ g₂ : β → γ} :
  g₁ ∘ f = g₂ ∘ f ↔ g₁ = g₂ :=
hf.injective_comp_right.eq_iff

lemma surjective_of_right_cancellable_Prop (h : ∀ g₁ g₂ : β → Prop, g₁ ∘ f = g₂ ∘ f → g₁ = g₂) :
  surjective f :=
begin
  specialize h (λ _, true) (λ y, ∃ x, f x = y) (funext $ λ x, _),
  { simp only [(∘), exists_apply_eq_apply] },
  { intro y,
    have : true = ∃ x, f x = y, from congr_fun h y,
    rw ← this, exact trivial }
end

lemma bijective_iff_exists_unique (f : α → β) : bijective f ↔
  ∀ b : β, ∃! (a : α), f a = b :=
⟨ λ hf b, let ⟨a, ha⟩ := hf.surjective b in ⟨a, ha, λ a' ha', hf.injective (ha'.trans ha.symm)⟩,
  λ he, ⟨
    λ a a' h, unique_of_exists_unique (he (f a')) h rfl,
    λ b, exists_of_exists_unique (he b) ⟩⟩

/-- Shorthand for using projection notation with `function.bijective_iff_exists_unique`. -/
protected lemma bijective.exists_unique {f : α → β} (hf : bijective f) (b : β) :
  ∃! (a : α), f a = b :=
(bijective_iff_exists_unique f).mp hf b

lemma bijective.exists_unique_iff {f : α → β} (hf : bijective f) {p : β → Prop} :
  (∃! y, p y) ↔ ∃! x, p (f x) :=
⟨λ ⟨y, hpy, hy⟩, let ⟨x, hx⟩ := hf.surjective y in ⟨x, by rwa hx,
  λ z (hz : p (f z)), hf.injective $ hx.symm ▸ hy _ hz⟩,
  λ ⟨x, hpx, hx⟩, ⟨f x, hpx, λ y hy,
    let ⟨z, hz⟩ := hf.surjective y in hz ▸ congr_arg f $ hx _ $ by rwa hz⟩⟩

lemma bijective.of_comp_iff (f : α → β) {g : γ → α} (hg : bijective g) :
  bijective (f ∘ g) ↔ bijective f :=
and_congr (injective.of_comp_iff' _ hg) (surjective.of_comp_iff _ hg.surjective)

lemma bijective.of_comp_iff' {f : α → β} (hf : bijective f) (g : γ → α) :
  function.bijective (f ∘ g) ↔ function.bijective g :=
and_congr (injective.of_comp_iff hf.injective _) (surjective.of_comp_iff' hf _)

/-- **Cantor's diagonal argument** implies that there are no surjective functions from `α`
to `set α`. -/
theorem cantor_surjective {α} (f : α → set α) : ¬ function.surjective f | h :=
let ⟨D, e⟩ := h {a | ¬ a ∈ f a} in
(iff_not_self (D ∈ f D)).1 $ iff_of_eq (congr_arg ((∈) D) e)

/-- **Cantor's diagonal argument** implies that there are no injective functions from `set α`
to `α`. -/
theorem cantor_injective {α : Type*} (f : set α → α) : ¬ function.injective f | i :=
cantor_surjective (λ a, {b | ∀ U, a = f U → b ∈ U}) $
right_inverse.surjective (λ U, funext $ λ a, propext ⟨λ h, h U rfl, λ h' U' e, i e ▸ h'⟩)

/-- There is no surjection from `α : Type u` into `Type u`. This theorem
  demonstrates why `Type : Type` would be inconsistent in Lean. -/
theorem not_surjective_Type {α : Type u} (f : α → Type (max u v)) :
  ¬ surjective f :=
begin
  intro hf,
  let T : Type (max u v) := sigma f,
  cases hf (set T) with U hU,
  let g : set T → T := λ s, ⟨U, cast hU.symm s⟩,
  have hg : injective g,
  { intros s t h,
    suffices : cast hU (g s).2 = cast hU (g t).2,
    { simp only [cast_cast, cast_eq] at this, assumption },
    { congr, assumption } },
  exact cantor_injective g hg
end

/-- `g` is a partial inverse to `f` (an injective but not necessarily
  surjective function) if `g y = some x` implies `f x = y`, and `g y = none`
  implies that `y` is not in the range of `f`. -/
def is_partial_inv {α β} (f : α → β) (g : β → option α) : Prop :=
∀ x y, g y = some x ↔ f x = y

theorem is_partial_inv_left {α β} {f : α → β} {g} (H : is_partial_inv f g) (x) : g (f x) = some x :=
(H _ _).2 rfl

theorem injective_of_partial_inv {α β} {f : α → β} {g} (H : is_partial_inv f g) : injective f :=
λ a b h, option.some.inj $ ((H _ _).2 h).symm.trans ((H _ _).2 rfl)

theorem injective_of_partial_inv_right {α β} {f : α → β} {g} (H : is_partial_inv f g)
 (x y b) (h₁ : b ∈ g x) (h₂ : b ∈ g y) : x = y :=
((H _ _).1 h₁).symm.trans ((H _ _).1 h₂)

theorem left_inverse.comp_eq_id {f : α → β} {g : β → α} (h : left_inverse f g) : f ∘ g = id :=
funext h

theorem left_inverse_iff_comp {f : α → β} {g : β → α} : left_inverse f g ↔ f ∘ g = id :=
⟨left_inverse.comp_eq_id, congr_fun⟩

theorem right_inverse.comp_eq_id {f : α → β} {g : β → α} (h : right_inverse f g) : g ∘ f = id :=
funext h

theorem right_inverse_iff_comp {f : α → β} {g : β → α} : right_inverse f g ↔ g ∘ f = id :=
⟨right_inverse.comp_eq_id, congr_fun⟩

theorem left_inverse.comp {f : α → β} {g : β → α} {h : β → γ} {i : γ → β}
  (hf : left_inverse f g) (hh : left_inverse h i) : left_inverse (h ∘ f) (g ∘ i) :=
assume a, show h (f (g (i a))) = a, by rw [hf (i a), hh a]

theorem right_inverse.comp {f : α → β} {g : β → α} {h : β → γ} {i : γ → β}
  (hf : right_inverse f g) (hh : right_inverse h i) : right_inverse (h ∘ f) (g ∘ i) :=
left_inverse.comp hh hf

theorem left_inverse.right_inverse {f : α → β} {g : β → α} (h : left_inverse g f) :
  right_inverse f g := h

theorem right_inverse.left_inverse {f : α → β} {g : β → α} (h : right_inverse g f) :
  left_inverse f g := h

theorem left_inverse.surjective {f : α → β} {g : β → α} (h : left_inverse f g) :
  surjective f :=
h.right_inverse.surjective

theorem right_inverse.injective {f : α → β} {g : β → α} (h : right_inverse f g) :
  injective f :=
h.left_inverse.injective

theorem left_inverse.right_inverse_of_injective {f : α → β} {g : β → α} (h : left_inverse f g)
  (hf : injective f) :
  right_inverse f g :=
λ x, hf $ h (f x)

theorem left_inverse.right_inverse_of_surjective {f : α → β} {g : β → α} (h : left_inverse f g)
  (hg : surjective g) :
  right_inverse f g :=
λ x, let ⟨y, hy⟩ := hg x in hy ▸ congr_arg g (h y)

lemma right_inverse.left_inverse_of_surjective {f : α → β} {g : β → α} :
  right_inverse f g → surjective f → left_inverse f g :=
left_inverse.right_inverse_of_surjective

lemma right_inverse.left_inverse_of_injective {f : α → β} {g : β → α} :
  right_inverse f g → injective g → left_inverse f g :=
left_inverse.right_inverse_of_injective

theorem left_inverse.eq_right_inverse {f : α → β} {g₁ g₂ : β → α} (h₁ : left_inverse g₁ f)
  (h₂ : right_inverse g₂ f) :
  g₁ = g₂ :=
calc g₁ = g₁ ∘ f ∘ g₂ : by rw [h₂.comp_eq_id, comp.right_id]
    ... = g₂          : by rw [← comp.assoc, h₁.comp_eq_id, comp.left_id]

local attribute [instance, priority 10] classical.prop_decidable

/-- We can use choice to construct explicitly a partial inverse for
  a given injective function `f`. -/
noncomputable def partial_inv {α β} (f : α → β) (b : β) : option α :=
if h : ∃ a, f a = b then some (classical.some h) else none

theorem partial_inv_of_injective {α β} {f : α → β} (I : injective f) :
  is_partial_inv f (partial_inv f) | a b :=
⟨λ h, if h' : ∃ a, f a = b then begin
    rw [partial_inv, dif_pos h'] at h,
    injection h with h, subst h,
    apply classical.some_spec h'
  end else by rw [partial_inv, dif_neg h'] at h; contradiction,
 λ e, e ▸ have h : ∃ a', f a' = f a, from ⟨_, rfl⟩,
   (dif_pos h).trans (congr_arg _ (I $ classical.some_spec h))⟩

theorem partial_inv_left {α β} {f : α → β} (I : injective f) : ∀ x, partial_inv f (f x) = some x :=
is_partial_inv_left (partial_inv_of_injective I)

end

section inv_fun

variables {α β : Sort*} [nonempty α] {f : α → β} {a : α} {b : β}
local attribute [instance, priority 10] classical.prop_decidable

/-- The inverse of a function (which is a left inverse if `f` is injective
  and a right inverse if `f` is surjective). -/
noncomputable def inv_fun (f : α → β) : β → α :=
λ y, if h : ∃ x, f x = y then h.some else classical.arbitrary α

theorem inv_fun_eq (h : ∃ a, f a = b) : f (inv_fun f b) = b :=
by simp only [inv_fun, dif_pos h, h.some_spec]

lemma inv_fun_neg (h : ¬ ∃ a, f a = b) : inv_fun f b = classical.choice ‹_› :=
dif_neg h

theorem inv_fun_eq_of_injective_of_right_inverse {g : β → α}
  (hf : injective f) (hg : right_inverse g f) : inv_fun f = g :=
funext $ assume b,
hf begin rw [hg b], exact inv_fun_eq ⟨g b, hg b⟩ end

lemma right_inverse_inv_fun (hf : surjective f) : right_inverse (inv_fun f) f :=
assume b, inv_fun_eq $ hf b

lemma left_inverse_inv_fun (hf : injective f) : left_inverse (inv_fun f) f :=
λ b, hf $ inv_fun_eq ⟨b, rfl⟩

lemma inv_fun_surjective (hf : injective f) : surjective (inv_fun f) :=
(left_inverse_inv_fun hf).surjective

lemma inv_fun_comp (hf : injective f) : inv_fun f ∘ f = id := funext $ left_inverse_inv_fun hf

lemma injective.has_left_inverse (hf : injective f) : has_left_inverse f :=
⟨inv_fun f, left_inverse_inv_fun hf⟩

lemma injective_iff_has_left_inverse : injective f ↔ has_left_inverse f :=
⟨injective.has_left_inverse, has_left_inverse.injective⟩

end inv_fun

section surj_inv
variables {α : Sort u} {β : Sort v} {γ : Sort w} {f : α → β}

/-- The inverse of a surjective function. (Unlike `inv_fun`, this does not require
  `α` to be inhabited.) -/
noncomputable def surj_inv {f : α → β} (h : surjective f) (b : β) : α := classical.some (h b)

lemma surj_inv_eq (h : surjective f) (b) : f (surj_inv h b) = b := classical.some_spec (h b)

lemma right_inverse_surj_inv (hf : surjective f) : right_inverse (surj_inv hf) f :=
surj_inv_eq hf

lemma left_inverse_surj_inv (hf : bijective f) : left_inverse (surj_inv hf.2) f :=
right_inverse_of_injective_of_left_inverse hf.1 (right_inverse_surj_inv hf.2)

lemma surjective.has_right_inverse (hf : surjective f) : has_right_inverse f :=
⟨_, right_inverse_surj_inv hf⟩

lemma surjective_iff_has_right_inverse : surjective f ↔ has_right_inverse f :=
⟨surjective.has_right_inverse, has_right_inverse.surjective⟩

lemma bijective_iff_has_inverse : bijective f ↔ ∃ g, left_inverse g f ∧ right_inverse g f :=
⟨λ hf, ⟨_, left_inverse_surj_inv hf, right_inverse_surj_inv hf.2⟩,
 λ ⟨g, gl, gr⟩, ⟨gl.injective,  gr.surjective⟩⟩

lemma injective_surj_inv (h : surjective f) : injective (surj_inv h) :=
(right_inverse_surj_inv h).injective

lemma surjective_to_subsingleton [na : nonempty α] [subsingleton β] (f : α → β) :
  surjective f :=
λ y, let ⟨a⟩ := na in ⟨a, subsingleton.elim _ _⟩

/-- Composition by an surjective function on the left is itself surjective. -/
lemma surjective.comp_left {g : β → γ} (hg : surjective g) :
  surjective ((∘) g : (α → β) → (α → γ)) :=
λ f, ⟨surj_inv hg ∘ f, funext $ λ x, right_inverse_surj_inv _ _⟩

/-- Composition by an bijective function on the left is itself bijective. -/
lemma bijective.comp_left {g : β → γ} (hg : bijective g) :
  bijective ((∘) g : (α → β) → (α → γ)) :=
⟨hg.injective.comp_left, hg.surjective.comp_left⟩

end surj_inv

section update
variables {α : Sort u} {β : α → Sort v} {α' : Sort w} [decidable_eq α] [decidable_eq α']
  {f g : Π a, β a} {a : α} {b : β a}

/-- Replacing the value of a function at a given point by a given value. -/
def update (f : Πa, β a) (a' : α) (v : β a') (a : α) : β a :=
if h : a = a' then eq.rec v h.symm else f a

/-- On non-dependent functions, `function.update` can be expressed as an `ite` -/
lemma update_apply {β : Sort*} (f : α → β) (a' : α) (b : β) (a : α) :
  update f a' b a = if a = a' then b else f a :=
begin
  dunfold update,
  congr,
  funext,
  rw eq_rec_constant,
end

@[simp] lemma update_same (a : α) (v : β a) (f : Πa, β a) : update f a v a = v :=
dif_pos rfl

lemma surjective_eval {α : Sort u} {β : α → Sort v} [h : Π a, nonempty (β a)] (a : α) :
  surjective (eval a : (Π a, β a) → β a) :=
λ b, ⟨@update _ _ (classical.dec_eq α) (λ a, (h a).some) a b,
  @update_same _ _ (classical.dec_eq α) _ _ _⟩

lemma update_injective (f : Πa, β a) (a' : α) : injective (update f a') :=
λ v v' h, have _ := congr_fun h a', by rwa [update_same, update_same] at this

@[simp] lemma update_noteq {a a' : α} (h : a ≠ a') (v : β a') (f : Πa, β a) :
  update f a' v a = f a :=
dif_neg h

lemma forall_update_iff (f : Π a, β a) {a : α} {b : β a} (p : Π a, β a → Prop) :
  (∀ x, p x (update f a b x)) ↔ p a b ∧ ∀ x ≠ a, p x (f x) :=
by { rw [← and_forall_ne a, update_same], simp { contextual := tt } }

lemma exists_update_iff (f : Π a, β a) {a : α} {b : β a} (p : Π a, β a → Prop) :
  (∃ x, p x (update f a b x)) ↔ p a b ∨ ∃ x ≠ a, p x (f x) :=
by { rw [← not_forall_not, forall_update_iff f (λ a b, ¬p a b)], simp [not_and_distrib] }

lemma update_eq_iff {a : α} {b : β a} {f g : Π a, β a} :
  update f a b = g ↔ b = g a ∧ ∀ x ≠ a, f x = g x :=
funext_iff.trans $ forall_update_iff _ (λ x y, y = g x)

lemma eq_update_iff {a : α} {b : β a} {f g : Π a, β a} :
  g = update f a b ↔ g a = b ∧ ∀ x ≠ a, g x = f x :=
funext_iff.trans $ forall_update_iff _ (λ x y, g x = y)

@[simp] lemma update_eq_self_iff : update f a b = f ↔ b = f a := by simp [update_eq_iff]
@[simp] lemma eq_update_self_iff : f = update f a b ↔ f a = b := by simp [eq_update_iff]

lemma ne_update_self_iff : f ≠ update f a b ↔ f a ≠ b := eq_update_self_iff.not
lemma update_ne_self_iff : update f a b ≠ f ↔ b ≠ f a := update_eq_self_iff.not

@[simp] lemma update_eq_self (a : α) (f : Πa, β a) : update f a (f a) = f :=
update_eq_iff.2 ⟨rfl, λ _ _, rfl⟩

lemma update_comp_eq_of_forall_ne' {α'} (g : Π a, β a) {f : α' → α} {i : α} (a : β i)
  (h : ∀ x, f x ≠ i) :
  (λ j, (update g i a) (f j)) = (λ j, g (f j)) :=
funext $ λ x, update_noteq (h _) _ _

/-- Non-dependent version of `function.update_comp_eq_of_forall_ne'` -/
lemma update_comp_eq_of_forall_ne {α β : Sort*} (g : α' → β) {f : α → α'} {i : α'} (a : β)
  (h : ∀ x, f x ≠ i) :
  (update g i a) ∘ f = g ∘ f :=
update_comp_eq_of_forall_ne' g a h

lemma update_comp_eq_of_injective' (g : Π a, β a) {f : α' → α} (hf : function.injective f)
  (i : α') (a : β (f i)) :
  (λ j, update g (f i) a (f j)) = update (λ i, g (f i)) i a :=
eq_update_iff.2 ⟨update_same _ _ _, λ j hj, update_noteq (hf.ne hj) _ _⟩

/-- Non-dependent version of `function.update_comp_eq_of_injective'` -/
lemma update_comp_eq_of_injective {β : Sort*} (g : α' → β) {f : α → α'}
  (hf : function.injective f) (i : α) (a : β) :
  (function.update g (f i) a) ∘ f = function.update (g ∘ f) i a :=
update_comp_eq_of_injective' g hf i a

lemma apply_update {ι : Sort*} [decidable_eq ι] {α β : ι → Sort*}
  (f : Π i, α i → β i) (g : Π i, α i) (i : ι) (v : α i) (j : ι) :
  f j (update g i v j) = update (λ k, f k (g k)) i (f i v) j :=
begin
  by_cases h : j = i,
  { subst j, simp },
  { simp [h] }
end

lemma apply_update₂ {ι : Sort*} [decidable_eq ι] {α β γ : ι → Sort*}
  (f : Π i, α i → β i → γ i) (g : Π i, α i) (h : Π i, β i) (i : ι) (v : α i) (w : β i) (j : ι) :
  f j (update g i v j) (update h i w j) = update (λ k, f k (g k) (h k)) i (f i v w) j :=
begin
  by_cases h : j = i,
  { subst j, simp },
  { simp [h] }
end

lemma comp_update {α' : Sort*} {β : Sort*} (f : α' → β) (g : α → α') (i : α) (v : α') :
  f ∘ (update g i v) = update (f ∘ g) i (f v) :=
funext $ apply_update _ _ _ _

theorem update_comm {α} [decidable_eq α] {β : α → Sort*}
  {a b : α} (h : a ≠ b) (v : β a) (w : β b) (f : Πa, β a) :
  update (update f a v) b w = update (update f b w) a v :=
begin
  funext c, simp only [update],
  by_cases h₁ : c = b; by_cases h₂ : c = a; try {simp [h₁, h₂]},
  cases h (h₂.symm.trans h₁),
end

@[simp] theorem update_idem {α} [decidable_eq α] {β : α → Sort*}
  {a : α} (v w : β a) (f : Πa, β a) : update (update f a v) a w = update f a w :=
by {funext b, by_cases b = a; simp [update, h]}

end update

section extend

noncomputable theory
local attribute [instance, priority 10] classical.prop_decidable

variables {α β γ : Sort*} {f : α → β}

/-- `extend f g e'` extends a function `g : α → γ`
along a function `f : α → β` to a function `β → γ`,
by using the values of `g` on the range of `f`
and the values of an auxiliary function `e' : β → γ` elsewhere.

Mostly useful when `f` is injective, more generally when `g.factors_through f`. -/
def extend (f : α → β) (g : α → γ) (e' : β → γ) : β → γ :=
λ b, if h : ∃ a, f a = b then g (classical.some h) else e' b

/-- g factors through f : `f a = f b → g a = g b` -/
def factors_through (g : α → γ) (f : α → β) : Prop :=
∀ ⦃a b⦄, f a = f b → g a = g b

lemma injective.factors_through (hf : injective f) (g : α → γ) : g.factors_through f :=
λ a b h, congr_arg g (hf h)

lemma extend_def (f : α → β) (g : α → γ) (e' : β → γ) (b : β) [decidable (∃ a, f a = b)] :
  extend f g e' b = if h : ∃ a, f a = b then g (classical.some h) else e' b :=
by { unfold extend, congr }

lemma factors_through.extend_apply {g : α → γ} (hf : g.factors_through f) (e' : β → γ) (a : α) :
  extend f g e' (f a) = g a :=
begin
  simp only [extend_def, dif_pos, exists_apply_eq_apply],
  exact hf (classical.some_spec (exists_apply_eq_apply f a)),
end

@[simp] lemma injective.extend_apply (hf : f.injective) (g : α → γ) (e' : β → γ) (a : α) :
  extend f g e' (f a) = g a :=
(hf.factors_through g).extend_apply e' a

@[simp] lemma extend_apply' (g : α → γ) (e' : β → γ) (b : β) (hb : ¬∃ a, f a = b) :
  extend f g e' b = e' b :=
by simp [function.extend_def, hb]

lemma factors_through_iff (g : α → γ) [nonempty γ] :
  g.factors_through f ↔ ∃ (e : β → γ), g = e ∘ f :=
⟨λ hf, ⟨extend f g (const β (classical.arbitrary γ)),
      funext (λ x, by simp only [comp_app, hf.extend_apply])⟩,
  λ h a b hf, by rw [classical.some_spec h, comp_apply, hf]⟩

lemma factors_through.apply_extend {δ} {g : α → γ} (hf : factors_through g f)
  (F : γ → δ) (e' : β → γ) (b : β) :
  F (extend f g e' b) = extend f (F ∘ g) (F ∘ e') b :=
begin
  by_cases hb : ∃ a, f a = b,
  { cases hb with a ha, subst b,
    rw [factors_through.extend_apply, factors_through.extend_apply],
    { intros a b h, simp only [comp_apply], apply congr_arg, exact hf h, },
    { exact hf, }, },
  { rw [extend_apply' _ _ _ hb, extend_apply' _ _ _ hb] }
end

lemma injective.apply_extend {δ} (hf : injective f) (F : γ → δ) (g : α → γ) (e' : β → γ) (b : β) :
  F (extend f g e' b) = extend f (F ∘ g) (F ∘ e') b :=
(hf.factors_through g).apply_extend F e' b

lemma extend_injective (hf : injective f) (e' : β → γ) :
  injective (λ g, extend f g e') :=
begin
  intros g₁ g₂ hg,
  refine funext (λ x, _),
  have H := congr_fun hg (f x),
  simp only [hf.extend_apply] at H,
  exact H
end

lemma factors_through.extend_comp {g : α → γ} (e' : β → γ)
  (hf : factors_through g f) :
  extend f g e' ∘ f = g :=
funext $ λ a, by simp only [comp_app, hf.extend_apply e']

@[simp] lemma extend_comp (hf : injective f) (g : α → γ) (e' : β → γ) :
  extend f g e' ∘ f = g :=
(hf.factors_through g).extend_comp e'

lemma injective.surjective_comp_right' (hf : injective f) (g₀ : β → γ) :
  surjective (λ g : β → γ, g ∘ f) :=
λ g, ⟨extend f g g₀, extend_comp hf _ _⟩

lemma injective.surjective_comp_right [nonempty γ] (hf : injective f) :
  surjective (λ g : β → γ, g ∘ f) :=
hf.surjective_comp_right' (λ _, classical.choice ‹_›)

lemma bijective.comp_right (hf : bijective f) :
  bijective (λ g : β → γ, g ∘ f) :=
⟨hf.surjective.injective_comp_right,
  λ g, ⟨g ∘ surj_inv hf.surjective,
    by simp only [comp.assoc g _ f, (left_inverse_surj_inv hf).comp_eq_id, comp.right_id]⟩⟩

end extend

lemma uncurry_def {α β γ} (f : α → β → γ) : uncurry f = (λp, f p.1 p.2) :=
rfl

@[simp] lemma uncurry_apply_pair {α β γ} (f : α → β → γ) (x : α) (y : β) :
  uncurry f (x, y) = f x y :=
rfl

@[simp] lemma curry_apply {α β γ} (f : α × β → γ) (x : α) (y : β) :
  curry f x y = f (x, y) :=
rfl

section bicomp
variables {α β γ δ ε : Type*}

/-- Compose a binary function `f` with a pair of unary functions `g` and `h`.
If both arguments of `f` have the same type and `g = h`, then `bicompl f g g = f on g`. -/
def bicompl (f : γ → δ → ε) (g : α → γ) (h : β → δ) (a b) :=
f (g a) (h b)

/-- Compose an unary function `f` with a binary function `g`. -/
def bicompr (f : γ → δ) (g : α → β → γ) (a b) :=
f (g a b)

-- Suggested local notation:
local notation f ` ∘₂ ` g := bicompr f g

lemma uncurry_bicompr (f : α → β → γ) (g : γ → δ) :
  uncurry (g ∘₂ f) = (g ∘ uncurry f) := rfl

end bicomp

section uncurry

variables {α β γ δ : Type*}

/-- Records a way to turn an element of `α` into a function from `β` to `γ`. The most generic use
is to recursively uncurry. For instance `f : α → β → γ → δ` will be turned into
`↿f : α × β × γ → δ`. One can also add instances for bundled maps. -/
class has_uncurry (α : Type*) (β : out_param Type*) (γ : out_param Type*) := (uncurry : α → (β → γ))

/-- Uncurrying operator. The most generic use is to recursively uncurry. For instance
`f : α → β → γ → δ` will be turned into `↿f : α × β × γ → δ`. One can also add instances
for bundled maps.-/
add_decl_doc has_uncurry.uncurry

notation (name := uncurry) `↿`:max x:max := has_uncurry.uncurry x

instance has_uncurry_base : has_uncurry (α → β) α β := ⟨id⟩

instance has_uncurry_induction [has_uncurry β γ δ] : has_uncurry (α → β) (α × γ) δ :=
⟨λ f p, ↿(f p.1) p.2⟩

end uncurry

/-- A function is involutive, if `f ∘ f = id`. -/
def involutive {α} (f : α → α) : Prop := ∀ x, f (f x) = x

lemma involutive_iff_iter_2_eq_id {α} {f : α → α} : involutive f ↔ (f^[2] = id) :=
funext_iff.symm

lemma _root_.bool.involutive_bnot : involutive bnot := bnot_bnot

namespace involutive
variables {α : Sort u} {f : α → α} (h : involutive f)
include h

@[simp]
lemma comp_self : f ∘ f = id := funext h

protected lemma left_inverse : left_inverse f f := h
protected lemma right_inverse : right_inverse f f := h

protected lemma injective : injective f := h.left_inverse.injective
protected lemma surjective : surjective f := λ x, ⟨f x, h x⟩
protected lemma bijective : bijective f := ⟨h.injective, h.surjective⟩

/-- Involuting an `ite` of an involuted value `x : α` negates the `Prop` condition in the `ite`. -/
protected lemma ite_not (P : Prop) [decidable P] (x : α) :
  f (ite P x (f x)) = ite (¬ P) x (f x) :=
by rw [apply_ite f, h, ite_not]

/-- An involution commutes across an equality. Compare to `function.injective.eq_iff`. -/
protected lemma eq_iff {x y : α} : f x = y ↔ x = f y :=
h.injective.eq_iff' (h y)

end involutive

/-- The property of a binary function `f : α → β → γ` being injective.
Mathematically this should be thought of as the corresponding function `α × β → γ` being injective.
-/
def injective2 {α β γ} (f : α → β → γ) : Prop :=
∀ ⦃a₁ a₂ b₁ b₂⦄, f a₁ b₁ = f a₂ b₂ → a₁ = a₂ ∧ b₁ = b₂

namespace injective2
variables {α β γ : Sort*} {f : α → β → γ}

/-- A binary injective function is injective when only the left argument varies. -/
protected lemma left (hf : injective2 f) (b : β) : function.injective (λ a, f a b) :=
λ a₁ a₂ h, (hf h).left

/-- A binary injective function is injective when only the right argument varies. -/
protected lemma right (hf : injective2 f) (a : α) : function.injective (f a) :=
λ a₁ a₂ h, (hf h).right

protected lemma uncurry {α β γ : Type*} {f : α → β → γ} (hf : injective2 f) :
  function.injective (uncurry f) :=
λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ h, and.elim (hf h) (congr_arg2 _)

/-- As a map from the left argument to a unary function, `f` is injective. -/
lemma left' (hf : injective2 f) [nonempty β] : function.injective f :=
λ a₁ a₂ h, let ⟨b⟩ := ‹nonempty β› in hf.left b $ (congr_fun h b : _)

/-- As a map from the right argument to a unary function, `f` is injective. -/
lemma right' (hf : injective2 f) [nonempty α] : function.injective (λ b a, f a b) :=
λ b₁ b₂ h, let ⟨a⟩ := ‹nonempty α› in hf.right a $ (congr_fun h a : _)

lemma eq_iff (hf : injective2 f) {a₁ a₂ b₁ b₂} : f a₁ b₁ = f a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
⟨λ h, hf h, and.rec $ congr_arg2 f⟩

end injective2

section sometimes
local attribute [instance, priority 10] classical.prop_decidable

/-- `sometimes f` evaluates to some value of `f`, if it exists. This function is especially
interesting in the case where `α` is a proposition, in which case `f` is necessarily a
constant function, so that `sometimes f = f a` for all `a`. -/
noncomputable def sometimes {α β} [nonempty β] (f : α → β) : β :=
if h : nonempty α then f (classical.choice h) else classical.choice ‹_›

theorem sometimes_eq {p : Prop} {α} [nonempty α] (f : p → α) (a : p) : sometimes f = f a :=
dif_pos ⟨a⟩

theorem sometimes_spec {p : Prop} {α} [nonempty α]
  (P : α → Prop) (f : p → α) (a : p) (h : P (f a)) : P (sometimes f) :=
by rwa sometimes_eq

end sometimes

end function

/-- `s.piecewise f g` is the function equal to `f` on the set `s`, and to `g` on its complement. -/
def set.piecewise {α : Type u} {β : α → Sort v} (s : set α) (f g : Πi, β i)
  [∀j, decidable (j ∈ s)] :
  Πi, β i :=
λi, if i ∈ s then f i else g i

/-! ### Bijectivity of `eq.rec`, `eq.mp`, `eq.mpr`, and `cast` -/

lemma eq_rec_on_bijective {α : Sort*} {C : α → Sort*} :
  ∀ {a a' : α} (h : a = a'), function.bijective (@eq.rec_on _ _ C _ h)
| _ _ rfl := ⟨λ x y, id, λ x, ⟨x, rfl⟩⟩

lemma eq_mp_bijective {α β : Sort*} (h : α = β) : function.bijective (eq.mp h) :=
eq_rec_on_bijective h

lemma eq_mpr_bijective {α β : Sort*} (h : α = β) : function.bijective (eq.mpr h) :=
eq_rec_on_bijective h.symm

lemma cast_bijective {α β : Sort*} (h : α = β) : function.bijective (cast h) :=
eq_rec_on_bijective h

/-! Note these lemmas apply to `Type*` not `Sort*`, as the latter interferes with `simp`, and
is trivial anyway.-/

@[simp]
lemma eq_rec_inj {α : Sort*} {a a' : α} (h : a = a') {C : α → Type*} (x y : C a) :
  (eq.rec x h : C a') = eq.rec y h ↔ x = y :=
(eq_rec_on_bijective h).injective.eq_iff

@[simp]
lemma cast_inj {α β : Type*} (h : α = β) {x y : α} : cast h x = cast h y ↔ x = y :=
(cast_bijective h).injective.eq_iff

lemma function.left_inverse.eq_rec_eq {α β : Sort*} {γ : β → Sort v} {f : α → β} {g : β → α}
  (h : function.left_inverse g f) (C : Π a : α, γ (f a)) (a : α) :
  (congr_arg f (h a)).rec (C (g (f a))) = C a :=
eq_of_heq $ (eq_rec_heq _ _).trans $ by rw h

lemma function.left_inverse.eq_rec_on_eq {α β : Sort*} {γ : β → Sort v} {f : α → β} {g : β → α}
  (h : function.left_inverse g f) (C : Π a : α, γ (f a)) (a : α) :
  (congr_arg f (h a)).rec_on (C (g (f a))) = C a :=
h.eq_rec_eq _ _

lemma function.left_inverse.cast_eq {α β : Sort*} {γ : β → Sort v} {f : α → β} {g : β → α}
  (h : function.left_inverse g f) (C : Π a : α, γ (f a)) (a : α) :
  cast (congr_arg (λ a, γ (f a)) (h a)) (C (g (f a))) = C a :=
eq_of_heq $ (eq_rec_heq _ _).trans $ by rw h

/-- A set of functions "separates points"
if for each pair of distinct points there is a function taking different values on them. -/
def set.separates_points {α β : Type*} (A : set (α → β)) : Prop :=
∀ ⦃x y : α⦄, x ≠ y → ∃ f ∈ A, (f x : β) ≠ f y

lemma is_symm_op.flip_eq {α β} (op) [is_symm_op α β op] : flip op = op :=
funext $ λ a, funext $ λ b, (is_symm_op.symm_op a b).symm

lemma inv_image.equivalence {α : Sort u} {β : Sort v} (r : β → β → Prop) (f : α → β)
  (h : equivalence r) : equivalence (inv_image r f) :=
⟨λ _, h.1 _, λ _ _ x, h.2.1 x, inv_image.trans r f h.2.2⟩


import tactic
import topology.continuous_function.compact

/-!
## Second hour
Things to know

Well I'm now rep for the class

OpenAI have been in touch with Buzzard, and want to give money
for people who formalise olympid questions on the Xena dicord

Check on Twitter of OpenAI for link to blog

And Meta (Facebook) want our emai;l address to have a meeting where they show off
their extension for VSCode to guess the next line of a Lean

PDF where fine for the project

Can Buzzard share the projects for:
- next year students
- to the world

And NOW
## Topology
check the sheets of the formalising course (section 7)

 -/

-- Let X and Y be topologycal spaces
variables (X Y : Type) [topological_space X] [topological_space Y]
variable (S : set X)

-- goal : f : X → Y and C ⊂ X compact implies f(C) compact

#check is_open S
#check is_compact S
#check is_closed S

variables (f : X → Y) (h : continuous f)

#check f '' S
-- `''` does something to handle set terms for types
example (hf : continuous f) : is_compact S → is_compact(f '' S) :=
begin
  intro h,
  /-
    What's the maths proof?
    Let Uᵢ : i ∈ I be an open cover of f(S)
    Let Vᵢ be a preimage of Uᵢ
    Vᵢ all open because f is continous
    S ⊆ union of the Vᵢ
    compactness implies finite subcover V₁, V₂, ..., Vₙ
    then U₁, U₂, ..., Uₙ work
  -/
  rw is_compact_iff_finite_subcover at *,
  -- finset is term of finite set
  -- Let Uᵢ : i ∈ I be an open cover of f(S)
  intros I U hU h,
  -- Let Vᵢ be a preimage of Uᵢ
  set V : I → set X := λ i, f⁻¹' (U i) with hV,
  have hVopen : ∀ i, is_open (V i),
  {
    intro i,
    rw hV,
    dsimp,
    apply continuous.is_open_preimage hf,
    apply hU,
  },
  -- S ⊆ union of the Vᵢ
  -- Needs to stop because time
  sorry,
end


import algebra.ring order.lattice canonical_isomorphism_nonsense

universes u v

theorem congr_arg₂ {α β γ : Type*} (f : α → β → γ) {x₁ x₂ : α} {y₁ y₂ : β}
  (Hx : x₁ = x₂) (Hy : y₁ = y₂) : f x₁ y₁ = f x₂ y₂ :=
eq.drec (eq.drec rfl Hy) Hx

open lattice

instance is_ring_hom.to_is_add_group_hom {α : Type*} {β : Type*} [ring α] [ring β]
  (f : α → β) [is_ring_hom f] : is_add_group_hom f :=
⟨λ _ _, is_ring_hom.map_add f⟩

variables {ι : out_param (Type u)} [inhabited ι] [semilattice_sup ι] {G : ι → Type v}

section add_comm_group

class directed_system (f : Π i j, i ≤ j → G i → G j) : Prop :=
(Hid : ∀ i x, f i i (le_refl i) x = x)
(Hcomp : ∀ i j k hij hjk x, f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x)

variables [∀ i, add_comm_group (G i)] (f : Π i j, i ≤ j → G i → G j)
variables [∀ i j h, is_add_group_hom (f i j h)] [directed_system f]

instance direct_limit.setoid : setoid (sigma G) :=
⟨λ i j, ∃ k (hik : i.1 ≤ k) (hjk : j.1 ≤ k), f i.1 k hik i.2 = f j.1 k hjk j.2,
 λ i, ⟨i.1, le_refl i.1, le_refl i.1, rfl⟩,
 λ i j ⟨k, hik, hjk, H⟩, ⟨k, hjk, hik, H.symm⟩,
 λ i j k ⟨ij, hiij, hjij, hij⟩ ⟨jk, hjjk, hkjk, hjk⟩,
   ⟨ij ⊔ jk, le_trans hiij le_sup_left, le_trans hkjk le_sup_right,
    calc  f i.1 (ij ⊔ jk) _ i.2
        = f ij (ij ⊔ jk) _ (f i.1 ij _ i.2) : eq.symm $ directed_system.Hcomp f _ _ _ _ _ _
    ... = f ij (ij ⊔ jk) _ (f j.1 ij _ j.2) : congr_arg _ hij
    ... = f j.1 (ij ⊔ jk) _ j.2 : directed_system.Hcomp f _ _ _ _ _ _
    ... = f jk (ij ⊔ jk) _ (f j.1 jk _ j.2) : eq.symm $ directed_system.Hcomp f _ _ _ _ _ _
    ... = f jk (ij ⊔ jk) _ (f k.1 jk _ k.2) : congr_arg _ hjk
    ... = f k.1 (ij ⊔ jk) _ k.2 : directed_system.Hcomp f _ _ _ _ _ _⟩⟩

def direct_limit : Type (max u v) :=
quotient (direct_limit.setoid f)

instance direct_limit.add_comm_group' : add_comm_group (quotient (direct_limit.setoid f)) :=
{ add := λ i j, quotient.lift_on₂ i j
    (λ xi xj, ⟦⟨xi.1 ⊔ xj.1, f xi.1 (xi.1 ⊔ xj.1) le_sup_left xi.2 +
      f xj.1 (xi.1 ⊔ xj.1) le_sup_right xj.2⟩⟧ : sigma G → sigma G → quotient (direct_limit.setoid f))
    (λ ⟨p, xp⟩ ⟨q, xq⟩ ⟨r, xr⟩ ⟨s, xs⟩ ⟨t, hpt, hrt, hprt⟩ ⟨u, hqu, hsu, hqsu⟩, quotient.sound $
      ⟨t ⊔ u,
       sup_le (le_trans hpt le_sup_left) (le_trans hqu le_sup_right),
       sup_le (le_trans hrt le_sup_left) (le_trans hsu le_sup_right),
       calc   f (p ⊔ q) (t ⊔ u) _
                (f p (p ⊔ q) le_sup_left xp + f q (p ⊔ q) le_sup_right xq)
          =   f (p ⊔ q) (t ⊔ u) _ (f p (p ⊔ q) le_sup_left xp)
            + f (p ⊔ q) (t ⊔ u) _ (f q (p ⊔ q) le_sup_right xq) :
        is_add_group_hom.add _ _ _
      ... =   f p (t ⊔ u) _ xp + f q (t ⊔ u) _ xq :
        congr_arg₂ (+) (directed_system.Hcomp f _ _ _ _ _ _) (directed_system.Hcomp f _ _ _ _ _ _)
      ... =   f p (t ⊔ u) (le_trans hpt le_sup_left) xp + f q (t ⊔ u) (le_trans hqu le_sup_right) xq : rfl
      ... =   f t (t ⊔ u) le_sup_left (f p t hpt xp) + f u (t ⊔ u) le_sup_right (f q u hqu xq) :
        congr_arg₂ (+) (directed_system.Hcomp f _ _ _ _ _ _).symm (directed_system.Hcomp f _ _ _ _ _ _).symm
      ... =   f t (t ⊔ u) le_sup_left (f r t hrt xr) + f u (t ⊔ u) le_sup_right (f s u hsu xs) :
        congr_arg₂ (+) (congr_arg _ hprt) (congr_arg _ hqsu)
      ... =   _ : congr_arg₂ (+) (directed_system.Hcomp f _ _ _ _ _ _) (directed_system.Hcomp f _ _ _ _ _ _)
      ... =   f r (t ⊔ u) (le_trans le_sup_left (sup_le (le_trans hrt le_sup_left) (le_trans hsu le_sup_right))) xr
            + f s (t ⊔ u) (le_trans le_sup_right (sup_le (le_trans hrt le_sup_left) (le_trans hsu le_sup_right))) xs : rfl
      ... =   _ : congr_arg₂ (+) (directed_system.Hcomp f _ _ _ _ _ _).symm (directed_system.Hcomp f _ _ _ _ _ _).symm
      ... =   f (r ⊔ s) (t ⊔ u) _ (f r (r ⊔ s) le_sup_left xr + f s (r ⊔ s) le_sup_right xs) :
        (is_add_group_hom.add _ _ _).symm ⟩),
  add_assoc := λ i j k, quotient.induction_on₃ i j k $ λ ⟨p, xp⟩ ⟨q, xq⟩ ⟨r, xr⟩, quotient.sound
    ⟨p ⊔ q ⊔ r, le_refl _, le_of_eq sup_assoc.symm, begin
      dsimp,
      rw is_add_group_hom.add (f (p ⊔ q) (p ⊔ q ⊔ r) le_sup_left),
      rw is_add_group_hom.add (f (q ⊔ r) (p ⊔ (q ⊔ r)) le_sup_right),
      rw is_add_group_hom.add (f (p ⊔ q ⊔ r) (p ⊔ q ⊔ r) (le_refl (p ⊔ q ⊔ r))),
      rw is_add_group_hom.add (f (p ⊔ q ⊔ r) (p ⊔ q ⊔ r) (le_refl (p ⊔ q ⊔ r))),
      rw is_add_group_hom.add (f (p ⊔ (q ⊔ r)) (p ⊔ q ⊔ r) (le_of_eq (eq.symm sup_assoc))),
      rw is_add_group_hom.add (f (p ⊔ (q ⊔ r)) (p ⊔ q ⊔ r) (le_of_eq (eq.symm sup_assoc))),
      repeat { rw directed_system.Hcomp f },
      apply add_assoc
    end⟩,
  zero := ⟦⟨default _, 0⟩⟧,
  zero_add := λ i, quotient.induction_on i $ λ ⟨p, xp⟩, quotient.sound
    ⟨default _ ⊔ p, le_refl _, le_sup_right, begin
      dsimp,
      rw is_add_group_hom.add (f (default ι ⊔ p) (default ι ⊔ p) (le_refl (default ι ⊔ p))),
      repeat { rw directed_system.Hcomp f },
      rw is_add_group_hom.zero (f (default ι) (default ι ⊔ p) (le_trans le_sup_left (le_refl (default ι ⊔ p)))),
      apply zero_add
    end⟩,
  add_zero := λ i, quotient.induction_on i $ λ ⟨p, xp⟩, quotient.sound
    ⟨p ⊔ default ι, le_refl _, le_sup_left, begin
      dsimp,
      rw is_add_group_hom.add (f (p ⊔ default ι) (p ⊔ default ι) (le_refl (p ⊔ default ι))),
      repeat { rw directed_system.Hcomp f },
      rw is_add_group_hom.zero (f (default ι) (p ⊔ default ι) (le_trans le_sup_right (le_refl (p ⊔ default ι)))),
      apply add_zero
    end⟩,
  neg := λ i, quotient.lift_on i (λ p, ⟦⟨p.1, -p.2⟩⟧ : sigma G → quotient (direct_limit.setoid f)) $
    λ ⟨p, xp⟩ ⟨q, xq⟩ ⟨t, hpt, hqt, hpqt⟩, quotient.sound $
    ⟨t, hpt, hqt, by dsimp at hpqt ⊢; rw [is_add_group_hom.neg (f p t hpt), is_add_group_hom.neg (f q t hqt), hpqt]⟩,
  add_left_neg := λ i, quotient.induction_on i $ λ ⟨p, xp⟩, quotient.sound $
    ⟨(p ⊔ p) ⊔ default ι, le_sup_left, le_sup_right, begin
      dsimp,
      rw is_add_group_hom.add (f (p ⊔ p) (p ⊔ p ⊔ default ι) le_sup_left),
      repeat { rw directed_system.Hcomp f },
      rw is_add_group_hom.neg (f p (p ⊔ p ⊔ default ι) (le_trans le_sup_left le_sup_left)),
      rw is_add_group_hom.zero (f (default ι) (p ⊔ p ⊔ default ι) le_sup_right),
      apply add_left_neg
    end⟩,
  add_comm := λ i j, quotient.induction_on₂ i j $ λ ⟨p, xp⟩ ⟨q, xq⟩, quotient.sound
    ⟨p ⊔ q, le_refl _, le_of_eq sup_comm, begin
      dsimp,
      rw is_add_group_hom.add (f (p ⊔ q) (p ⊔ q) (le_refl (p ⊔ q))),
      rw is_add_group_hom.add (f (q ⊔ p) (p ⊔ q) (le_of_eq sup_comm)),
      repeat { rw directed_system.Hcomp f },
      apply add_comm
    end⟩ }

instance direct_limit.add_comm_group : add_comm_group (direct_limit f) :=
direct_limit.add_comm_group' f

def direct_limit.of (i) (x : G i) : direct_limit f :=
⟦⟨i, x⟩⟧

instance direct_limit.of.is_add_group_hom {i} : is_add_group_hom (direct_limit.of f i) :=
⟨λ x y, quotient.sound ⟨i, le_refl _, sup_le (le_refl _) (le_refl _),
 begin
   dsimp,
   rw is_add_group_hom.add (f (i ⊔ i) i _),
   repeat { rw directed_system.Hcomp f },
   repeat { rw directed_system.Hid f },
   apply_instance
  end⟩⟩

theorem direct_limit.of.zero_exact {i x} (H : direct_limit.of f i x = 0) :
  ∃ p hp1, f i p hp1 x = (0 : G p) :=
let ⟨p, hp1, hp2, hp3⟩ := quotient.exact H in
⟨p, hp1, hp3.trans $ is_add_group_hom.zero _⟩

end add_comm_group

section ring

variables [∀ i, ring (G i)] (f : Π i j, i ≤ j → G i → G j)
variables [∀ i j h, is_ring_hom (f i j h)] [directed_system f]

instance direct_limit.ring' : ring (quotient (direct_limit.setoid f)) :=
{ mul := λ i j, quotient.lift_on₂ i j
    (λ xi xj, ⟦⟨xi.1 ⊔ xj.1, f xi.1 (xi.1 ⊔ xj.1) le_sup_left xi.2 *
      f xj.1 (xi.1 ⊔ xj.1) le_sup_right xj.2⟩⟧ : sigma G → sigma G → quotient (direct_limit.setoid f))
    (λ ⟨p, xp⟩ ⟨q, xq⟩ ⟨r, xr⟩ ⟨s, xs⟩ ⟨t, hpt, hrt, hprt⟩ ⟨u, hqu, hsu, hqsu⟩, quotient.sound $
      ⟨t ⊔ u,
       sup_le (le_trans hpt le_sup_left) (le_trans hqu le_sup_right),
       sup_le (le_trans hrt le_sup_left) (le_trans hsu le_sup_right),
       calc   f (p ⊔ q) (t ⊔ u) _
                (f p (p ⊔ q) le_sup_left xp * f q (p ⊔ q) le_sup_right xq)
          =   f (p ⊔ q) (t ⊔ u) _ (f p (p ⊔ q) le_sup_left xp)
            * f (p ⊔ q) (t ⊔ u) _ (f q (p ⊔ q) le_sup_right xq) :
        is_ring_hom.map_mul _
      ... =   f p (t ⊔ u) _ xp * f q (t ⊔ u) _ xq :
        congr_arg₂ (*) (directed_system.Hcomp f _ _ _ _ _ _) (directed_system.Hcomp f _ _ _ _ _ _)
      ... =   f p (t ⊔ u) (le_trans hpt le_sup_left) xp * f q (t ⊔ u) (le_trans hqu le_sup_right) xq : rfl
      ... =   f t (t ⊔ u) le_sup_left (f p t hpt xp) * f u (t ⊔ u) le_sup_right (f q u hqu xq) :
        congr_arg₂ (*) (directed_system.Hcomp f _ _ _ _ _ _).symm (directed_system.Hcomp f _ _ _ _ _ _).symm
      ... =   f t (t ⊔ u) le_sup_left (f r t hrt xr) * f u (t ⊔ u) le_sup_right (f s u hsu xs) :
        congr_arg₂ (*) (congr_arg _ hprt) (congr_arg _ hqsu)
      ... =   _ : congr_arg₂ (*) (directed_system.Hcomp f _ _ _ _ _ _) (directed_system.Hcomp f _ _ _ _ _ _)
      ... =   f r (t ⊔ u) (le_trans le_sup_left (sup_le (le_trans hrt le_sup_left) (le_trans hsu le_sup_right))) xr
            * f s (t ⊔ u) (le_trans le_sup_right (sup_le (le_trans hrt le_sup_left) (le_trans hsu le_sup_right))) xs : rfl
      ... =   _ : congr_arg₂ (*) (directed_system.Hcomp f _ _ _ _ _ _).symm (directed_system.Hcomp f _ _ _ _ _ _).symm
      ... =   f (r ⊔ s) (t ⊔ u) _ (f r (r ⊔ s) le_sup_left xr * f s (r ⊔ s) le_sup_right xs) :
        (is_ring_hom.map_mul _).symm ⟩),
  mul_assoc := λ i j k, quotient.induction_on₃ i j k $ λ ⟨p, xp⟩ ⟨q, xq⟩ ⟨r, xr⟩, quotient.sound
    ⟨p ⊔ q ⊔ r, le_refl _, le_of_eq sup_assoc.symm, begin
      dsimp,
      rw is_ring_hom.map_mul (f (p ⊔ q) (p ⊔ q ⊔ r) le_sup_left),
      rw is_ring_hom.map_mul (f (q ⊔ r) (p ⊔ (q ⊔ r)) le_sup_right),
      rw is_ring_hom.map_mul (f (p ⊔ q ⊔ r) (p ⊔ q ⊔ r) (le_refl (p ⊔ q ⊔ r))),
      rw is_ring_hom.map_mul (f (p ⊔ q ⊔ r) (p ⊔ q ⊔ r) (le_refl (p ⊔ q ⊔ r))),
      rw is_ring_hom.map_mul (f (p ⊔ (q ⊔ r)) (p ⊔ q ⊔ r) (le_of_eq (eq.symm sup_assoc))),
      rw is_ring_hom.map_mul (f (p ⊔ (q ⊔ r)) (p ⊔ q ⊔ r) (le_of_eq (eq.symm sup_assoc))),
      repeat { rw directed_system.Hcomp f },
      apply mul_assoc
    end⟩,
  one := ⟦⟨default _, 1⟩⟧,
  one_mul := λ i, quotient.induction_on i $ λ ⟨p, xp⟩, quotient.sound
    ⟨default _ ⊔ p, le_refl _, le_sup_right, begin
      dsimp,
      rw is_ring_hom.map_mul (f (default ι ⊔ p) (default ι ⊔ p) (le_refl (default ι ⊔ p))),
      repeat { rw directed_system.Hcomp f },
      rw is_ring_hom.map_one (f (default ι) (default ι ⊔ p) (le_trans le_sup_left (le_refl (default ι ⊔ p)))),
      apply one_mul
    end⟩,
  mul_one := λ i, quotient.induction_on i $ λ ⟨p, xp⟩, quotient.sound
    ⟨p ⊔ default ι, le_refl _, le_sup_left, begin
      dsimp,
      rw is_ring_hom.map_mul (f (p ⊔ default ι) (p ⊔ default ι) (le_refl (p ⊔ default ι))),
      repeat { rw directed_system.Hcomp f },
      rw is_ring_hom.map_one (f (default ι) (p ⊔ default ι) (le_trans le_sup_right (le_refl (p ⊔ default ι)))),
      apply mul_one
    end⟩,
  left_distrib := λ i j k, quotient.induction_on₃ i j k $ λ ⟨p, xp⟩ ⟨q, xq⟩ ⟨r, xr⟩, quotient.sound
    ⟨p ⊔ (q ⊔ r) ⊔ (p ⊔ q ⊔ (p ⊔ r)), le_sup_left, le_sup_right, begin
      dsimp,
      rw is_ring_hom.map_mul (f (p ⊔ (q ⊔ r)) (p ⊔ (q ⊔ r) ⊔ (p ⊔ q ⊔ (p ⊔ r))) le_sup_left),
      rw is_ring_hom.map_add (f (q ⊔ r) (p ⊔ (q ⊔ r)) le_sup_right),
      rw is_ring_hom.map_add (f (p ⊔ (q ⊔ r)) (p ⊔ (q ⊔ r) ⊔ (p ⊔ q ⊔ (p ⊔ r))) le_sup_left),
      rw is_ring_hom.map_mul (f (p ⊔ q) (p ⊔ q ⊔ (p ⊔ r)) _),
      rw is_ring_hom.map_mul (f (p ⊔ r) (p ⊔ q ⊔ (p ⊔ r)) _),
      rw is_ring_hom.map_add (f (p ⊔ q ⊔ (p ⊔ r)) (p ⊔ (q ⊔ r) ⊔ (p ⊔ q ⊔ (p ⊔ r))) le_sup_right),
      rw is_ring_hom.map_mul (f (p ⊔ q ⊔ (p ⊔ r)) (p ⊔ (q ⊔ r) ⊔ (p ⊔ q ⊔ (p ⊔ r))) le_sup_right),
      rw is_ring_hom.map_mul (f (p ⊔ q ⊔ (p ⊔ r)) (p ⊔ (q ⊔ r) ⊔ (p ⊔ q ⊔ (p ⊔ r))) le_sup_right),
      rw left_distrib,
      repeat { rw directed_system.Hcomp f },
      repeat { apply_instance }
    end⟩,
  right_distrib := λ i j k, quotient.induction_on₃ i j k $ λ ⟨p, xp⟩ ⟨q, xq⟩ ⟨r, xr⟩, quotient.sound
    ⟨p ⊔ q ⊔ r ⊔ (p ⊔ r ⊔ (q ⊔ r)), le_sup_left, le_sup_right, begin
      dsimp,
      rw is_ring_hom.map_mul (f (p ⊔ q ⊔ r) (p ⊔ q ⊔ r ⊔ (p ⊔ r ⊔ (q ⊔ r))) le_sup_left),
      rw is_ring_hom.map_add (f (p ⊔ q) (p ⊔ q ⊔ r) le_sup_left),
      rw is_ring_hom.map_add (f (p ⊔ q ⊔ r) (p ⊔ q ⊔ r ⊔ (p ⊔ r ⊔ (q ⊔ r))) le_sup_left),
      rw is_ring_hom.map_mul (f (p ⊔ r) (p ⊔ r ⊔ (q ⊔ r)) _),
      rw is_ring_hom.map_mul (f (q ⊔ r) (p ⊔ r ⊔ (q ⊔ r)) _),
      rw is_ring_hom.map_add (f (p ⊔ r ⊔ (q ⊔ r)) (p ⊔ q ⊔ r ⊔ (p ⊔ r ⊔ (q ⊔ r))) le_sup_right),
      rw is_ring_hom.map_mul (f (p ⊔ r ⊔ (q ⊔ r)) (p ⊔ q ⊔ r ⊔ (p ⊔ r ⊔ (q ⊔ r))) le_sup_right),
      rw is_ring_hom.map_mul (f (p ⊔ r ⊔ (q ⊔ r)) (p ⊔ q ⊔ r ⊔ (p ⊔ r ⊔ (q ⊔ r))) le_sup_right),
      rw right_distrib,
      repeat { rw directed_system.Hcomp f },
      repeat { apply_instance }
    end⟩,
  .. direct_limit.add_comm_group' f }

instance direct_limit.ring : ring (direct_limit f) :=
direct_limit.ring' f

instance direct_limit.of.is_ring_hom {i} : is_ring_hom (direct_limit.of f i) :=
{ map_add := is_add_group_hom.add _,
  map_mul := λ x y, quotient.sound ⟨i, le_refl _, sup_le (le_refl _) (le_refl _),
    begin
      dsimp,
      rw is_ring_hom.map_mul (f (i ⊔ i) i _),
      repeat { rw directed_system.Hcomp f },
      repeat { rw directed_system.Hid f },
      apply_instance
     end⟩,
  map_one := quotient.sound ⟨i ⊔ default _, le_sup_left, le_sup_right,
    begin
      dsimp,
      rw is_ring_hom.map_one (f i (i ⊔ default ι) le_sup_left),
      rw is_ring_hom.map_one (f (default ι) (i ⊔ default ι) le_sup_right)
    end⟩ }

end ring


/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import topology.sheaves.sheaf_condition.sites

/-!
# Presheaves on punit

Presheaves on punit satisfy sheaf condition iff its value at empty set is a terminal object.
-/

namespace Top.presheaf

universes u v w

open category_theory category_theory.limits Top opposite

variables {C : Type u} [category.{v} C]

lemma is_sheaf_of_is_terminal_of_indiscrete {X : Top.{w}} (hind : X.str = ⊤) (F : presheaf C X)
  (it : is_terminal $ F.obj $ op ⊥) : F.is_sheaf :=
λ c U s hs, begin
  obtain rfl | hne := eq_or_ne U ⊥,
  { intros _ _, rw @exists_unique_iff_exists _ ⟨λ _ _, _⟩,
    { refine ⟨it.from _, λ U hU hs, is_terminal.hom_ext _ _ _⟩, rwa le_bot_iff.1 hU.le },
    { apply it.hom_ext } },
  { convert presieve.is_sheaf_for_top_sieve _, rw ←sieve.id_mem_iff_eq_top,
    have := (U.eq_bot_or_top hind).resolve_left hne, subst this,
    obtain he | ⟨⟨x⟩⟩ := is_empty_or_nonempty X,
    { exact (hne $ set_like.ext'_iff.2 $ set.univ_eq_empty_iff.2 he).elim },
    obtain ⟨U, f, hf, hm⟩ := hs x trivial,
    obtain rfl | rfl := U.eq_bot_or_top hind,
    { cases hm }, { convert hf } },
end

lemma is_sheaf_iff_is_terminal_of_indiscrete {X : Top.{w}} (hind : X.str = ⊤)
  (F : presheaf C X) : F.is_sheaf ↔ nonempty (is_terminal $ F.obj $ op ⊥) :=
⟨λ h, ⟨sheaf.is_terminal_of_empty ⟨F, h⟩⟩, λ ⟨it⟩, is_sheaf_of_is_terminal_of_indiscrete hind F it⟩

lemma is_sheaf_on_punit_of_is_terminal (F : presheaf C (Top.of punit))
  (it : is_terminal $ F.obj $ op ⊥) : F.is_sheaf :=
is_sheaf_of_is_terminal_of_indiscrete (@subsingleton.elim (topological_space punit) _ _ _) F it

lemma is_sheaf_on_punit_iff_is_terminal (F : presheaf C (Top.of punit)) :
  F.is_sheaf ↔ nonempty (is_terminal $ F.obj $ op ⊥) :=
⟨λ h, ⟨sheaf.is_terminal_of_empty ⟨F, h⟩⟩, λ ⟨it⟩, is_sheaf_on_punit_of_is_terminal F it⟩

end Top.presheaf