theorem ex {i j : Fin n} (h : i = j) : i.val = j.val :=
  h ▸ rfl

attribute [-app_unexpander] unexpandEqNDRec

#print ex


/-
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
-/

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 id_def : @id α = λ x, x := 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

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. -/
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, ¬ f a a) in
(iff_not_self (f D D)).1 $ iff_of_eq (congr_fun e D)

/-- **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 → U b) $
right_inverse.surjective (λ U, funext $ λ a, propext ⟨λ h, h U rfl, λ h' U' e, i e ▸ h'⟩)

/-- `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)

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 α']

/-- 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 (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. -/
def extend (f : α → β) (g : α → γ) (e' : β → γ) : β → γ :=
λ b, if h : ∃ a, f a = b then g (classical.some h) else e' b

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 }

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

@[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 apply_extend {δ} (hf : injective f) (F : γ → δ) (g : α → γ) (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 [extend_apply hf, extend_apply hf] },
  { rw [extend_apply' _ _ _ hb, extend_apply' _ _ _ hb] }
end

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

@[simp] lemma extend_comp (hf : injective f) (g : α → γ) (e' : β → γ) :
  extend f g e' ∘ f = g :=
funext $ λ a, extend_apply hf g e' a

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 `↿`: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

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.
-/
@[reducible] def injective2 {α β γ} (f : α → β → γ) : Prop :=
∀ ⦃a₁ a₂ b₁ b₂⦄, f a₁ b₁ = f a₂ b₂ → a₁ = a₂ ∧ b₁ = b₂

namespace injective2
variables {α β γ : Type*} (f : α → β → γ)

protected lemma left (hf : injective2 f) ⦃a₁ a₂ b₁ b₂⦄ (h : f a₁ b₁ = f a₂ b₂) : a₁ = a₂ :=
(hf h).1

protected lemma right (hf : injective2 f) ⦃a₁ a₂ b₁ b₂⦄ (h : f a₁ b₁ = f a₂ b₂) : b₁ = b₂ :=
(hf h).2

lemma eq_iff (hf : injective2 f) ⦃a₁ a₂ b₁ b₂⦄ : f a₁ b₁ = f a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
⟨λ h, hf h, λ⟨h1, h2⟩, congr_arg2 f h1 h2⟩

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

/-- 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 .basic
import .model
import .proof

namespace universal
variables {τ : Type} {σ : Type*} {sig : signature τ σ} {ι : Type} {ax : ι → identity sig}

namespace proof
variables {ι' : Type} {ax' : ι' → identity sig} (ht : Π (i : ι), proof ax' (ax i).lhs (ax i).rhs)

definition transfer {dom} : Π {cod} {t₁ t₂ : term sig dom cod} (p : proof ax t₁ t₂), proof ax' t₁ t₂
| _ _ _ (proof.ax i sub) := proof.subst sub (ht i)
| _ _ _ (proof.proj _) := proof.proj _
| _ _ _ (proof.func f ps) := proof.func f (λ i, transfer (ps i))
| _ _ _ (proof.eucl p₁ p₂) := proof.eucl (transfer p₁) (transfer p₂)

definition transfer_of_map (f : ι → ι') (hf : ∀ i, ax' (f i) = ax i) (i : ι) : proof ax' (ax i).lhs (ax i).rhs :=
eq.rec_on (hf i) $ proof.ax_id (f i)

end proof

definition proof.occurs {dom} : Π {cod} {t₁ t₂ : term sig dom cod}, proof ax t₁ t₂ → ι → Prop
| _ _ _ (proof.ax i _) j := i = j
| _ _ _ (proof.proj _) _ := false
| _ _ _ (proof.func _ ps) j := ∃ i, proof.occurs (ps i) j
| _ _ _ (proof.eucl p₁ p₂) j := proof.occurs p₁ j ∨ proof.occurs p₂ j

definition proof.use {dom} : Π {cod} {t₁ t₂ : term sig dom cod}, proof ax t₁ t₂ → list ι
| _ _ _ (proof.ax i _) := [i]
| _ _ _ (proof.proj _) := []
| _ _ _ (proof.func _ ps) := list.join $ index.dtup.to_list (λ i, proof.use (ps i))
| _ _ _ (proof.eucl p₁ p₂) := proof.use p₁ ++ proof.use p₂

theorem proof.mem_use_of_occurs {dom} : Π {cod} {t₁ t₂ : term sig dom cod} {p : proof ax t₁ t₂} {i : ι}, proof.occurs p i → i ∈ proof.use p
| _ _ _ (proof.ax i _) j h := eq.rec_on h (or.inl rfl)
| _ _ _ (proof.proj _) _ h := absurd h not_false
| _ _ _ (proof.func _ ps) j h :=
  exists.elim h $ λ i hi,
  let i' : index (index.dtup.to_list (λ i, proof.use (ps i))) := index.map _ (index.dtup.enum_index _ i) in
  have hi' : j ∈ i'.val, by { rw [index.val_map, index.dtup.enum_index_val], exact proof.mem_use_of_occurs hi },
  list.mem_join j i' hi'
| _ _ _ (proof.eucl p₁ p₂) j h :=  or.elim h (λ h, list.mem_append_left _ (proof.mem_use_of_occurs h)) (λ h, list.mem_append_right _ (proof.mem_use_of_occurs h))

definition proof.of_use {dom} : Π {cod} {t₁ t₂ : term sig dom cod} (p : proof ax t₁ t₂), proof (λ (i : index p.use), ax i.val) t₁ t₂
| _ t₁ t₂ p@(proof.ax i sub) := proof.subst sub $ proof.ax_id (index.head i [])
| _ _ _ (proof.proj _) := proof.proj _
| _ _ _ p@(@proof.func _ _ _ _ _ _ f lhs rhs ps) :=
  let m : Π (i : sig.index f) (j : index (ps i).use), index p.use :=
  λ i j, index.join_map _ (index.dtup.to_list_index _ i) $ eq.rec_on (index.dtup.to_list_index_val (λ i, (ps i).use) i).symm j in
  let ps : Π (i : sig.index f), proof (λ (i : index p.use), ax i.val) (lhs i) (rhs i) :=
  λ i, proof.transfer (proof.transfer_of_map (m i) (by {intro, simp})) (proof.of_use (ps i)) in
  proof.func f ps
| _ t₁ t₂ p@(@proof.eucl _ _ _ _ _ _ _ t _ _ p₁ p₂) :=
  let p₁ : proof (λ (i : index p.use), ax i.val) t t₁ :=
  proof.transfer (proof.transfer_of_map (index.append_left _ _) (by {intro, rw [index.append_left_val]})) (proof.of_use p₁) in
  let p₂ : proof (λ (i : index p.use), ax i.val) t t₂ :=
  proof.transfer (proof.transfer_of_map (index.append_right _ _) (by {intro, rw [index.append_right_val]})) (proof.of_use p₂) in
  proof.eucl p₁ p₂

theorem compactness (e : identity sig) : models ax e → ∃ (as : list ι), models (λ (i : index as), ax i.val) e :=
begin
intros hm,
cases completeness ax e hm with hp,
existsi hp.use,
apply soundness,
constructor,
exact proof.of_use hp,
end

end universal


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, ∃ N : ℤ, |y - (N : ℝ) * x| < 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  assume (y : ℝ) (h1 : y ∈ Icc 0 1),
  have h2 : ∀ (i j : ℤ), i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from by auto [hα, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat.def, is_rat
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by auto [abs_sub_lt_iff] using [linarith],

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by auto [lt_of_le_of_lt, le_max_left, le_max_right],

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by auto [h8, h10, h5, h9],

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by auto [h11] using [linarith],

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


/-
Copyright (c) 2021 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.Tactic.Basic
import Std.Tactic.Simpa
import Mathlib.Data.Array.Basic

structure UFModel (n) where
  parent : Fin n → Fin n
  rank : Nat → Nat
  rank_lt : ∀ i, (parent i).1 ≠ i → rank i < rank (parent i)

namespace UFModel

def empty : UFModel 0 where
  parent i := i.elim0
  rank _ := 0
  rank_lt i := i.elim0

def push {n} (m : UFModel n) (k) (le : n ≤ k) : UFModel k where
  parent i :=
    if h : i < n then
      let ⟨a, h'⟩ := m.parent ⟨i, h⟩
      ⟨a, lt_of_lt_of_le h' le⟩
    else i
  rank i := if i < n then m.rank i else 0
  rank_lt i := by
    simp; split <;> rename_i h
    · simp [(m.parent ⟨i, h⟩).2, h]; exact m.rank_lt _
    · intro.

def setParent {n} (m : UFModel n) (x y : Fin n) (h : m.rank x < m.rank y) : UFModel n where
  parent i := if x.1 = i then y else m.parent i
  rank := m.rank
  rank_lt i := by
    simp; split <;> rename_i h'
    · rw [← h']; exact fun _ ↦ h
    · exact m.rank_lt i

def setParentBump {n} (m : UFModel n) (x y : Fin n)
    (H : m.rank x ≤ m.rank y) (hroot : (m.parent y).1 = y) : UFModel n where
  parent i := if x.1 = i then y else m.parent i
  rank i := if y.1 = i ∧ m.rank x = m.rank y then m.rank y + 1 else m.rank i
  rank_lt i := by
    simp; split <;>
      (rename_i h₁; simp [h₁]; split <;> rename_i h₂ <;>
        (intro h; simp [h] at h₂ <;> simp [h₁, h₂, h]))
    · simp [← h₁]; split <;> rename_i h₃
      · rw [h₃]; apply Nat.lt_succ_self
      · exact lt_of_le_of_ne H h₃
    · have := Fin.eq_of_val_eq h₂.1; subst this
      simp [hroot] at h
    · have := m.rank_lt i h
      split <;> rename_i h₃
      · rw [h₃.1]; exact Nat.lt_succ_of_lt this
      · exact this

end UFModel

structure UFNode (α : Type _) where
  parent : Nat
  value : α
  rank : Nat

inductive UFModel.Agrees (arr : Array α) (f : α → β) : ∀ {n}, (Fin n → β) → Prop
| mk : Agrees arr f fun i ↦ f (arr.get i)

namespace UFModel.Agrees

theorem mk' {arr : Array α} {f : α → β} {n} {g : Fin n → β}
  (e : n = arr.size)
  (H : ∀ i h₁ h₂, f (arr.get ⟨i, h₁⟩) = g ⟨i, h₂⟩) :
  Agrees arr f g := by
    cases e
    have : (fun i ↦ f (arr.get i)) = g := by funext ⟨i, h⟩; apply H
    cases this; constructor

theorem get_eq {arr : Array α} {n} {m : Fin n → β} (H : Agrees arr f m) :
  ∀ i h₁ h₂, f (arr.get ⟨i, h₁⟩) = m ⟨i, h₂⟩ := by
  cases H; exact fun i h _ ↦ rfl

theorem get_eq' {arr : Array α} {m : Fin arr.size → β} (H : Agrees arr f m)
  (i) : f (arr.get i) = m i := H.get_eq ..

theorem empty {f : α → β} {g : Fin 0 → β} : Agrees #[] f g := mk' rfl λ.

theorem push {arr : Array α} {n} {m : Fin n → β} (H : Agrees arr f m)
  (k) (hk : k = n + 1) (x) (m' : Fin k → β)
  (hm₁ : ∀ (i : Fin k) (h : i < n), m' i = m ⟨i, h⟩)
  (hm₂ : ∀ (h : n < k), f x = m' ⟨n, h⟩) : Agrees (arr.push x) f m' := by
  cases H
  have : k = (arr.push x).size := by simp [hk]
  refine mk' this fun i h₁ h₂ ↦ ?_
  simp [Array.get_push]; split <;> (rename_i h; simp at hm₁ ⊢)
  · rw [← hm₁ ⟨i, h₂⟩]; assumption
  · cases show i = arr.size by apply le_antisymm <;> simp_all [Nat.lt_succ]
    rw [hm₂]

theorem set {arr : Array α} {n} {m : Fin n → β} (H : Agrees arr f m)
  {i : Fin arr.size} {x} {m' : Fin n → β}
  (hm₁ : ∀ (j : Fin n), j.1 ≠ i → m' j = m j)
  (hm₂ : ∀ (h : i < n), f x = m' ⟨i, h⟩) : Agrees (arr.set i x) f m' := by
  cases H
  refine mk' (by simp) fun j hj₁ hj₂ ↦ ?_
  suffices f (Array.set arr i x)[j] = m' ⟨j, hj₂⟩ by simp_all [Array.get_set]
  by_cases h : i = j
  · subst h; rw [Array.get_set_eq, ← hm₂]
  · rw [arr.get_set_ne _ _ _ h, hm₁ ⟨j, _⟩ (Ne.symm h)]; rfl

end UFModel.Agrees

def UFModel.Models (arr : Array (UFNode α)) {n} (m : UFModel n) :=
  UFModel.Agrees arr (·.parent) (fun i ↦ m.parent i) ∧
  UFModel.Agrees arr (·.rank) (fun i : Fin n ↦ m.rank i)

namespace UFModel.Models

theorem size_eq {arr : Array (UFNode α)} {n} {m : UFModel n} (H : m.Models arr) :
  n = arr.size := H.1.size_eq

theorem parent_eq {arr : Array (UFNode α)} {n} {m : UFModel n} (H : m.Models arr)
  (i : Nat) (h₁ : i < arr.size) (h₂) : arr[i].parent = m.parent ⟨i, h₂⟩ := H.1.get_eq ..

theorem parent_eq' {arr : Array (UFNode α)} {m : UFModel arr.size} (H : m.Models arr)
  (i : Fin arr.size) : (arr[i.1]).parent = m.parent i := H.parent_eq ..

theorem rank_eq {arr : Array (UFNode α)} {n} {m : UFModel n} (H : m.Models arr) (i : Nat)
    (h : i < arr.size) : arr[i].rank = m.rank i :=
  H.2.get_eq _ _ (by rw [H.size_eq]; exact h)

theorem empty : UFModel.empty.Models (α := α) #[] := ⟨Agrees.empty, Agrees.empty⟩

theorem push {arr : Array (UFNode α)} {n} {m : UFModel n} (H : m.Models arr)
  (k) (hk : k = n + 1) (x) :
  (m.push k (hk ▸ Nat.le_add_right ..)).Models (arr.push ⟨n, x, 0⟩) := by
  apply H.imp <;>
  · intro H
    refine H.push _ hk _ _ (fun i h ↦ ?_) (fun h ↦ ?_) <;>
    simp [UFModel.push, h, lt_irrefl]

theorem setParent {arr : Array (UFNode α)} {n} {m : UFModel n} (hm : m.Models arr)
  (i j H hi x) (hp : x.parent = j.1) (hrk : x.rank = arr[i].rank) :
  (m.setParent i j H).Models (arr.set ⟨i.1, hi⟩ x) :=
  ⟨hm.1.set
      (fun k (h : (k:ℕ) ≠ i) ↦ by simp [UFModel.setParent, h.symm])
      (fun h ↦ by simp [UFModel.setParent, hp]),
    hm.2.set (fun _ _ ↦ rfl) (fun _ ↦ hrk.trans $ hm.2.get_eq ..)⟩

end UFModel.Models

structure UnionFind (α) where
  arr : Array (UFNode α)
  model : ∃ (n : _) (m : UFModel n), m.Models arr

namespace UnionFind

def size (self : UnionFind α) := self.arr.size

theorem model' (self : UnionFind α) : ∃ (m : UFModel self.arr.size), m.Models self.arr := by
  let ⟨n, m, hm⟩ := self.model; cases hm.size_eq; exact ⟨m, hm⟩

def empty : UnionFind α where
  arr := #[]
  model := ⟨_, _, UFModel.Models.empty⟩

def mkEmpty (c : Nat) : UnionFind α where
  arr := Array.mkEmpty c
  model := ⟨_, _, UFModel.Models.empty⟩

def rank (self : UnionFind α) (i : Nat) : Nat :=
  if h : i < self.size then (self.arr.get ⟨i, h⟩).rank else 0

def rankMaxAux (self : UnionFind α) : ∀ (i : Nat),
  {k : Nat // ∀ j < i, ∀ h, (self.arr.get ⟨j, h⟩).rank ≤ k}
| 0 => ⟨0, λ.⟩
| i+1 => by
  let ⟨k, H⟩ := rankMaxAux self i
  refine ⟨max k (if h : _ then (self.arr.get ⟨i, h⟩).rank else 0), fun j hj h ↦ ?_⟩
  match j, lt_or_eq_of_le (Nat.le_of_lt_succ hj) with
  | j, Or.inl hj => exact le_trans (H _ hj h) (le_max_left _ _)
  | _, Or.inr rfl => simp [h, le_max_right]

def rankMax (self : UnionFind α) := (rankMaxAux self self.size).1 + 1

theorem lt_rankMax' (self : UnionFind α) (i : Fin self.size) :
  (self.arr.get i).rank < self.rankMax :=
  Nat.lt_succ.2 $ (rankMaxAux self self.size).2 _ i.2 _

theorem lt_rankMax (self : UnionFind α) (i : Nat) : self.rank i < self.rankMax := by
  simp [rank]; split; {apply lt_rankMax'}; apply Nat.succ_pos

theorem rank_eq (self : UnionFind α) {n} {m : UFModel n} (H : m.Models self.arr)
    {i} (h : i < self.size) : self.rank i = m.rank i := by
  simp [rank, h, H.rank_eq]

theorem rank_lt (self : UnionFind α) {i : Nat} (h) : self.arr[i].parent ≠ i →
  self.rank i < self.rank self.arr[i].parent := by
  let ⟨m, hm⟩ := self.model'
  simpa [hm.parent_eq, hm.rank_eq, rank, size, h, (m.parent ⟨i, h⟩).2] using m.rank_lt ⟨i, h⟩

theorem parent_lt (self : UnionFind α) (i : Nat) (h) : self.arr[i].parent < self.size := by
  let ⟨m, hm⟩ := self.model'
  simp [hm.parent_eq, size, (m.parent ⟨i, h⟩).2, h]

def push (self : UnionFind α) (x : α) : UnionFind α where
  arr := self.arr.push ⟨self.arr.size, x, 0⟩
  model := let ⟨_, hm⟩ := self.model'; ⟨_, _, hm.push _ rfl _⟩

def findAux (self : UnionFind α) (x : Fin self.size) :
  (s : Array (UFNode α)) ×' (root : Fin s.size) ×'
    ∃ n, ∃ (m : UFModel n) (m' : UFModel n),
      m.Models self.arr ∧ m'.Models s ∧ m'.rank = m.rank ∧
      (∃ hr, (m'.parent ⟨root, hr⟩).1 = root) ∧
      m.rank x ≤ m.rank root := by
  let y := self.arr[x].parent
  refine if h : y = x then ⟨self.arr, x, ?a'⟩ else
    have := Nat.sub_lt_sub_left (self.lt_rankMax x) (self.rank_lt _ h)
    let ⟨arr₁, root, H⟩ := self.findAux ⟨y, self.parent_lt _ x.2⟩
    have hx := ?hx
    let arr₂ := arr₁.set ⟨x, hx⟩ {arr₁.get ⟨x, hx⟩ with parent := root}
    ⟨arr₂, ⟨root, by simp [root.2]⟩, ?b'⟩
  -- start proof
  case a' => -- FIXME: hygiene bug causes `case a` to fail
    let ⟨m, hm⟩ := self.model'
    exact ⟨_, m, m, hm, hm, rfl, ⟨x.2, by rwa [← hm.parent_eq]⟩, le_refl _⟩
  all_goals let ⟨n, m, m', hm, hm', e, ⟨_, hr⟩, le⟩ := H
  case hx => exact hm'.size_eq ▸ hm.size_eq.symm ▸ x.2
  case b' =>
    let x' : Fin n := ⟨x, hm.size_eq ▸ x.2⟩
    let root : Fin n := ⟨root, hm'.size_eq.symm ▸ root.2⟩
    have hy : (UFModel.parent m x').1 = y := by rw [← hm.parent_eq x x.2 x'.2]; rfl
    have := m.rank_lt x'; rw [hy] at this
    have := lt_of_lt_of_le (this h) le
    refine ⟨n, m, _, hm,
      hm'.setParent x' root (by rw [e]; exact this) hx _ rfl rfl, e,
      ⟨root.2, ?_⟩, le_of_lt this⟩
    have : x.1 ≠ root := mt (congrArg _) (ne_of_lt this); dsimp only at this
    simp [UFModel.setParent, this, hr]
termination_by _ α self x => self.rankMax - self.rank x

def find (self : UnionFind α) (x : Fin self.size) :
  (s : UnionFind α) × (root : Fin s.size) ×'
    s.size = self.size ∧ (s.arr.get root).parent = root :=
  let ⟨s, root, H⟩ := self.findAux x
  have : _ ∧ s.size = self.size ∧ s[root.1].parent = root :=
    let ⟨n, _, m', hm, hm', _, ⟨_, hr⟩, _⟩ := H
    ⟨⟨n, m', hm'⟩, hm'.size_eq.symm.trans hm.size_eq, by rwa [hm'.parent_eq]⟩
  ⟨⟨s, this.1⟩, root, this.2⟩

def link (self : UnionFind α) (x y : Fin self.size)
  (yroot : (self.arr.get y).parent = y) : UnionFind α := by
  refine if ne : x.1 = y then self else
    let nx := self.arr[x]
    let ny := self.arr[y]
    if h : ny.rank < nx.rank then
      ⟨self.arr.set y {ny with parent := x}, ?a⟩
    else
      let arr₁ := self.arr.set x {nx with parent := y}
      let arr₂ := if nx.rank = ny.rank then
        arr₁.set ⟨y, by simp; exact y.2⟩ {ny with rank := ny.rank + 1}
      else arr₁
      ⟨arr₂, ?b⟩
  -- start proof
  case a =>
    let ⟨m, hm⟩ := self.model'
    exact ⟨_, _, hm.setParent y x (by simpa [hm.rank_eq] using h) _ _ rfl rfl⟩
  case b =>
    let ⟨m, hm⟩ := self.model'; let n := self.size
    refine ⟨_, m.setParentBump x y (by simpa [hm.rank_eq] using h)
      (by simpa [← hm.parent_eq'] using yroot), ?_⟩
    let parent (i : Fin n) := (if x.1 = i then y else m.parent i).1
    have : UFModel.Agrees arr₁ (·.parent) parent :=
      hm.1.set (fun i h ↦ by simp; rw [if_neg h.symm]) (fun h ↦ by simp)
    have H1 : UFModel.Agrees arr₂ (·.parent) parent := by
      simp; split
      · exact this.set (fun i h ↦ by simp [h.symm]) (fun h ↦ by simp [ne, hm.parent_eq'])
      · exact this
    have : UFModel.Agrees arr₁ (·.rank) (fun i : Fin n ↦ m.rank i) :=
      hm.2.set (fun i _ ↦ by simp) (fun _ ↦ by simp [hm.rank_eq])
    let rank (i : Fin n) := if y.1 = i ∧ m.rank x = m.rank y then m.rank y + 1 else m.rank i
    have H2 : UFModel.Agrees arr₂ (·.rank) rank := by
      simp; split <;> (rename_i xy; simp [hm.rank_eq] at xy; simp [xy])
      · exact this.set (fun i h ↦ by rw [if_neg h.symm]) (fun h ↦ by simp [hm.rank_eq])
      · exact this
    exact ⟨H1, H2⟩

def union (self : UnionFind α) (x y : Fin self.size) : UnionFind α :=
  let ⟨self₁, rx, e, _⟩ := self.find x
  let ⟨self₂, ry, e, hry⟩ := self₁.find ⟨y, by rw [e]; exact y.2⟩
  self₂.link ⟨rx, by rw [e]; exact rx.2⟩ ry hry


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn, Scott Morrison

! This file was ported from Lean 3 source module combinatorics.quiver.basic
! leanprover-community/mathlib commit 56adee5b5eef9e734d82272918300fca4f3e7cef
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Opposite

/-!
# Quivers

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

This module defines quivers. A quiver on a type `V` of vertices assigns to every
pair `a b : V` of vertices a type `a ⟶ b` of arrows from `a` to `b`. This
is a very permissive notion of directed graph.

## Implementation notes

Currently `quiver` is defined with `arrow : V → V → Sort v`.
This is different from the category theory setup,
where we insist that morphisms live in some `Type`.
There's some balance here: it's nice to allow `Prop` to ensure there are no multiple arrows,
but it is also results in error-prone universe signatures when constraints require a `Type`.
-/

open Opposite

-- We use the same universe order as in category theory.
-- See note [category_theory universes]
universe v v₁ v₂ u u₁ u₂

#print Quiver /-
/-- A quiver `G` on a type `V` of vertices assigns to every pair `a b : V` of vertices
a type `a ⟶ b` of arrows from `a` to `b`.

For graphs with no repeated edges, one can use `quiver.{0} V`, which ensures
`a ⟶ b : Prop`. For multigraphs, one can use `quiver.{v+1} V`, which ensures
`a ⟶ b : Type v`.

Because `category` will later extend this class, we call the field `hom`.
Except when constructing instances, you should rarely see this, and use the `⟶` notation instead.
-/
class Quiver (V : Type u) where
  Hom : V → V → Sort v
#align quiver Quiver
-/

-- mathport name: «expr ⟶ »
infixr:10 " ⟶ " => Quiver.Hom

/- warning: prefunctor -> Prefunctor is a dubious translation:
lean 3 declaration is
  forall (V : Type.{u3}) [_inst_1 : Quiver.{u1, u3} V] (W : Type.{u4}) [_inst_2 : Quiver.{u2, u4} W], Sort.{max (imax (succ u3) (succ u3) u1 u2) (succ u3) (succ u4)}
but is expected to have type
  forall (V : Type.{u3}) [_inst_1 : Quiver.{u1, u3} V] (W : Type.{u4}) [_inst_2 : Quiver.{u2, u4} W], Sort.{max (max (max (succ u3) (succ u4)) u1) u2}
Case conversion may be inaccurate. Consider using '#align prefunctor Prefunctorₓ'. -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`obj] [] -/
-- type as \h
/-- A morphism of quivers. As we will later have categorical functors extend this structure,
we call it a `prefunctor`.
-/
structure Prefunctor (V : Type u₁) [Quiver.{v₁} V] (W : Type u₂) [Quiver.{v₂} W] where
  obj : V → W
  map : ∀ {X Y : V}, (X ⟶ Y) → (obj X ⟶ obj Y)
#align prefunctor Prefunctor

namespace Prefunctor

#print Prefunctor.ext /-
@[ext]
theorem ext {V : Type u} [Quiver.{v₁} V] {W : Type u₂} [Quiver.{v₂} W] {F G : Prefunctor V W}
    (h_obj : ∀ X, F.obj X = G.obj X)
    (h_map :
      ∀ (X Y : V) (f : X ⟶ Y),
        F.map f = Eq.recOn (h_obj Y).symm (Eq.recOn (h_obj X).symm (G.map f))) :
    F = G := by
  cases' F with F_obj _
  cases' G with G_obj _
  obtain rfl : F_obj = G_obj := by
    ext X
    apply h_obj
  congr
  funext X Y f
  simpa using h_map X Y f
#align prefunctor.ext Prefunctor.ext
-/

#print Prefunctor.id /-
/-- The identity morphism between quivers.
-/
@[simps]
def id (V : Type _) [Quiver V] : Prefunctor V V
    where
  obj := id
  map X Y f := f
#align prefunctor.id Prefunctor.id
-/

instance (V : Type _) [Quiver V] : Inhabited (Prefunctor V V) :=
  ⟨id V⟩

#print Prefunctor.comp /-
/-- Composition of morphisms between quivers.
-/
@[simps]
def comp {U : Type _} [Quiver U] {V : Type _} [Quiver V] {W : Type _} [Quiver W]
    (F : Prefunctor U V) (G : Prefunctor V W) : Prefunctor U W
    where
  obj X := G.obj (F.obj X)
  map X Y f := G.map (F.map f)
#align prefunctor.comp Prefunctor.comp
-/

/- warning: prefunctor.comp_id -> Prefunctor.comp_id is a dubious translation:
lean 3 declaration is
  forall {U : Type.{u1}} [_inst_1 : Quiver.{u2, u1} U] {V : Type.{u3}} [_inst_2 : Quiver.{u4, u3} V] (F : Prefunctor.{u2, u4, u1, u3} U _inst_1 V _inst_2), Eq.{max (imax (succ u1) (succ u1) u2 u4) (succ u1) (succ u3)} (Prefunctor.{u2, u4, u1, u3} U _inst_1 V _inst_2) (Prefunctor.comp.{u1, u2, u3, u4, u3, u4} U _inst_1 V _inst_2 V _inst_2 F (Prefunctor.id.{u3, u4} V _inst_2)) F
but is expected to have type
  forall {U : Type.{u4}} {_inst_1 : Type.{u3}} [V : Quiver.{u2, u4} U] [_inst_2 : Quiver.{u1, u3} _inst_1] (F : Prefunctor.{u2, u1, u4, u3} U V _inst_1 _inst_2), Eq.{max (max (max (succ u4) (succ u3)) u2) u1} (Prefunctor.{u2, u1, u4, u3} U V _inst_1 _inst_2) (Prefunctor.comp.{u4, u2, u3, u1, u3, u1} U V _inst_1 _inst_2 _inst_1 _inst_2 F (Prefunctor.id.{u3, u1} _inst_1 _inst_2)) F
Case conversion may be inaccurate. Consider using '#align prefunctor.comp_id Prefunctor.comp_idₓ'. -/
@[simp]
theorem comp_id {U : Type _} [Quiver U] {V : Type _} [Quiver V] (F : Prefunctor U V) :
    F.comp (id _) = F := by
  cases F
  rfl
#align prefunctor.comp_id Prefunctor.comp_id

/- warning: prefunctor.id_comp -> Prefunctor.id_comp is a dubious translation:
lean 3 declaration is
  forall {U : Type.{u1}} [_inst_1 : Quiver.{u2, u1} U] {V : Type.{u3}} [_inst_2 : Quiver.{u4, u3} V] (F : Prefunctor.{u2, u4, u1, u3} U _inst_1 V _inst_2), Eq.{max (imax (succ u1) (succ u1) u2 u4) (succ u1) (succ u3)} (Prefunctor.{u2, u4, u1, u3} U _inst_1 V _inst_2) (Prefunctor.comp.{u1, u2, u1, u2, u3, u4} U _inst_1 U _inst_1 V _inst_2 (Prefunctor.id.{u1, u2} U _inst_1) F) F
but is expected to have type
  forall {U : Type.{u4}} {_inst_1 : Type.{u3}} [V : Quiver.{u2, u4} U] [_inst_2 : Quiver.{u1, u3} _inst_1] (F : Prefunctor.{u2, u1, u4, u3} U V _inst_1 _inst_2), Eq.{max (max (max (succ u4) (succ u3)) u2) u1} (Prefunctor.{u2, u1, u4, u3} U V _inst_1 _inst_2) (Prefunctor.comp.{u4, u2, u4, u2, u3, u1} U V U V _inst_1 _inst_2 (Prefunctor.id.{u4, u2} U V) F) F
Case conversion may be inaccurate. Consider using '#align prefunctor.id_comp Prefunctor.id_compₓ'. -/
@[simp]
theorem id_comp {U : Type _} [Quiver U] {V : Type _} [Quiver V] (F : Prefunctor U V) :
    (id _).comp F = F := by
  cases F
  rfl
#align prefunctor.id_comp Prefunctor.id_comp

/- warning: prefunctor.comp_assoc -> Prefunctor.comp_assoc is a dubious translation:
lean 3 declaration is
  forall {U : Type.{u1}} {V : Type.{u2}} {W : Type.{u3}} {Z : Type.{u4}} [_inst_1 : Quiver.{u5, u1} U] [_inst_2 : Quiver.{u6, u2} V] [_inst_3 : Quiver.{u7, u3} W] [_inst_4 : Quiver.{u8, u4} Z] (F : Prefunctor.{u5, u6, u1, u2} U _inst_1 V _inst_2) (G : Prefunctor.{u6, u7, u2, u3} V _inst_2 W _inst_3) (H : Prefunctor.{u7, u8, u3, u4} W _inst_3 Z _inst_4), Eq.{max (imax (succ u1) (succ u1) u5 u8) (succ u1) (succ u4)} (Prefunctor.{u5, u8, u1, u4} U _inst_1 Z _inst_4) (Prefunctor.comp.{u1, u5, u3, u7, u4, u8} U _inst_1 W _inst_3 Z _inst_4 (Prefunctor.comp.{u1, u5, u2, u6, u3, u7} U _inst_1 V _inst_2 W _inst_3 F G) H) (Prefunctor.comp.{u1, u5, u2, u6, u4, u8} U _inst_1 V _inst_2 Z _inst_4 F (Prefunctor.comp.{u2, u6, u3, u7, u4, u8} V _inst_2 W _inst_3 Z _inst_4 G H))
but is expected to have type
  forall {U : Type.{u8}} {V : Type.{u7}} {W : Type.{u6}} {Z : Type.{u5}} [_inst_1 : Quiver.{u4, u8} U] [_inst_2 : Quiver.{u3, u7} V] [_inst_3 : Quiver.{u2, u6} W] [_inst_4 : Quiver.{u1, u5} Z] (F : Prefunctor.{u4, u3, u8, u7} U _inst_1 V _inst_2) (G : Prefunctor.{u3, u2, u7, u6} V _inst_2 W _inst_3) (H : Prefunctor.{u2, u1, u6, u5} W _inst_3 Z _inst_4), Eq.{max (max (max (succ u8) (succ u5)) u4) u1} (Prefunctor.{u4, u1, u8, u5} U _inst_1 Z _inst_4) (Prefunctor.comp.{u8, u4, u6, u2, u5, u1} U _inst_1 W _inst_3 Z _inst_4 (Prefunctor.comp.{u8, u4, u7, u3, u6, u2} U _inst_1 V _inst_2 W _inst_3 F G) H) (Prefunctor.comp.{u8, u4, u7, u3, u5, u1} U _inst_1 V _inst_2 Z _inst_4 F (Prefunctor.comp.{u7, u3, u6, u2, u5, u1} V _inst_2 W _inst_3 Z _inst_4 G H))
Case conversion may be inaccurate. Consider using '#align prefunctor.comp_assoc Prefunctor.comp_assocₓ'. -/
@[simp]
theorem comp_assoc {U V W Z : Type _} [Quiver U] [Quiver V] [Quiver W] [Quiver Z]
    (F : Prefunctor U V) (G : Prefunctor V W) (H : Prefunctor W Z) :
    (F.comp G).comp H = F.comp (G.comp H) :=
  rfl
#align prefunctor.comp_assoc Prefunctor.comp_assoc

-- mathport name: «expr ⥤q »
infixl:50 " ⥤q " => Prefunctor

-- mathport name: «expr ⋙q »
infixl:60 " ⋙q " => Prefunctor.comp

-- mathport name: «expr𝟭q»
notation "𝟭q" => id

end Prefunctor

namespace Quiver

#print Quiver.opposite /-
/-- `Vᵒᵖ` reverses the direction of all arrows of `V`. -/
instance opposite {V} [Quiver V] : Quiver Vᵒᵖ :=
  ⟨fun a b => unop b ⟶ unop a⟩
#align quiver.opposite Quiver.opposite
-/

#print Quiver.Hom.op /-
/-- The opposite of an arrow in `V`.
-/
def Hom.op {V} [Quiver V] {X Y : V} (f : X ⟶ Y) : op Y ⟶ op X :=
  f
#align quiver.hom.op Quiver.Hom.op
-/

#print Quiver.Hom.unop /-
/-- Given an arrow in `Vᵒᵖ`, we can take the "unopposite" back in `V`.
-/
def Hom.unop {V} [Quiver V] {X Y : Vᵒᵖ} (f : X ⟶ Y) : unop Y ⟶ unop X :=
  f
#align quiver.hom.unop Quiver.Hom.unop
-/

#print Quiver.Empty /-
/-- A type synonym for a quiver with no arrows. -/
@[nolint has_nonempty_instance]
def Empty (V) : Type u :=
  V
#align quiver.empty Quiver.Empty
-/

#print Quiver.emptyQuiver /-
instance emptyQuiver (V : Type u) : Quiver.{u} (Empty V) :=
  ⟨fun a b => PEmpty⟩
#align quiver.empty_quiver Quiver.emptyQuiver
-/

#print Quiver.empty_arrow /-
@[simp]
theorem empty_arrow {V : Type u} (a b : Empty V) : (a ⟶ b) = PEmpty :=
  rfl
#align quiver.empty_arrow Quiver.empty_arrow
-/

#print Quiver.IsThin /-
/-- A quiver is thin if it has no parallel arrows. -/
@[reducible]
def IsThin (V : Type u) [Quiver V] :=
  ∀ a b : V, Subsingleton (a ⟶ b)
#align quiver.is_thin Quiver.IsThin
-/

end Quiver


import data.set.lattice
import data.set.function
import tactic

open set
open function

/- TEXT:
.. _the_schroeder_bernstein_theorem:

The Schröder-Bernstein Theorem
------------------------------

We close this chapter with an elementary but nontrivial theorem of set theory.
Let :math:`\alpha` and :math:`\beta` be sets.
(In our formalization, they will actually be types.)
Suppose :math:`f : \alpha → \beta` and :math:`g : \beta → \alpha`
are both injective.
Intuitively, this means that :math:`\alpha` is no bigger than :math:`\beta` and vice-versa.
If :math:`\alpha` and :math:`\beta` are finite, this implies that
they have the same cardinality, which is equivalent to saying that there
is a bijection between them.
In the nineteenth century, Cantor stated that same result holds even in the
case where :math:`\alpha` and :math:`\beta` are infinite.
This was eventually established by Dedekind, Schröder, and Bernstein
independently.

Our formalization will introduce some new methods that we will explain
in greater detail in chapters to come.
Don't worry if they go by too quickly here.
Our goal is to show you that you already have the skills to contribute
to the formal proof of a real mathematical result.

To understand the idea behind the proof, consider the image of the map
:math:`g` in :math:`\alpha`.
On that image, the inverse of :math:`g` is defined and is a bijection
with :math:`\beta`.

.. image:: /figures/schroeder_bernstein1.*
   :height: 150 px
   :alt: the Schröder Bernstein theorem
   :align: center

The problem is that the bijection does not include the shaded region
in the diagram, which is nonempty if :math:`g` is not surjective.
Alternatively, we can use :math:`f` to map all of
:math:`\alpha` to :math:`\beta`,
but in that case the problem is that if :math:`f` is not surjective,
it will miss some elements of :math:`\beta`.

.. image:: /figures/schroeder_bernstein2.*
   :height: 150 px
   :alt: the Schröder Bernstein theorem
   :align: center

But now consider the composition :math:`g \circ f` from :math:`\alpha` to
itself. Because the composition is injective, it forms a bijection between
:math:`\alpha` and its image, yielding a scaled-down copy of :math:`\alpha`
inside itself.

.. image:: /figures/schroeder_bernstein3.*
   :height: 150 px
   :alt: the Schröder Bernstein theorem
   :align: center

This composition maps the inner shaded ring to yet another such
set, which we can think of as an even smaller concentric shaded ring,
and so on.
This yields a
concentric sequence of shaded rings, each of which is in
bijective correspondence with the next.
If we map each ring to the next and leave the unshaded
parts of :math:`\alpha` alone,
we have a bijection of :math:`\alpha` with the image of :math:`g`.
Composing with :math:`g^{-1}`, this yields the desired
bijection between :math:`\alpha` and :math:`\beta`.

We can describe this bijection more simply.
Let :math:`A` be the union of the sequence of shaded regions, and
define :math:`h : \alpha \to \beta` as follows:

.. math::

  h(x) = \begin{cases}
    f(x) & \text{if $x \in A$} \\
    g^{-1}(x) & \text{otherwise.}
  \end{cases}

In other words, we use :math:`f` on the shaded parts,
and we use the inverse of :math:`g` everywhere else.
The resulting map :math:`h` is injective
because each component is injective
and the images of the two components are disjoint.
To see that it is surjective,
suppose we are given a :math:`y` in :math:`\beta`, and
consider :math:`g(y)`.
If :math:`g(y)` is in one of the shaded regions,
it cannot be in the first ring, so we have :math:`g(y) = g(f(x))`
for some :math:`x` is in the previous ring.
By the injectivity of :math:`g`, we have :math:`h(x) = f(x) = y`.
If :math:`g(y)` is not in the shaded region,
then by the definition of :math:`h`, we have :math:`h(g(y))= y`.
Either way, :math:`y` is in the image of :math:`h`.

This argument should sound plausible, but the details are delicate.
Formalizing the proof will not only improve our confidence in the
result, but also help us understand it better.
Because the proof uses classical logic, we tell Lean that our definitions
will generally not be computable.
BOTH: -/
-- QUOTE:
noncomputable theory
open_locale classical

variables {α β : Type*} [nonempty β]
-- QUOTE.

/- TEXT:
The annotation ``[nonempty β]`` specifies that ``β`` is nonempty.
We use it because the mathlib primitive that we will use to
construct :math:`g^{-1}` requires it.
The case of the theorem where :math:`\beta` is empty is trivial,
and even though it would not be hard to generalize the formalization to cover
that case as well, we will not bother.
Specifically, we need the hypothesis ``[nonempty β]`` for the operation
``inv_fun`` that is defined in mathlib.
Given ``x : α``, ``inv_fun g x`` chooses a preimage of ``x``
in ``β`` if there is one,
and returns an arbitrary element of ``β`` otherwise.
The function ``inv_fun g`` is always a left inverse if ``g`` is injective
and a right inverse if ``g`` is surjective.

-- LITERALINCLUDE: inv_fun g

We define the set corresponding to the union of the shaded regions as follows.

BOTH: -/
section
-- QUOTE:
variables (f : α → β) (g : β → α)

def sb_aux : ℕ → set α
| 0       := univ \ (g '' univ)
| (n + 1) := g '' (f '' sb_aux n)

def sb_set := ⋃ n, sb_aux f g n
-- QUOTE.

/- TEXT:
The definition ``sb_aux`` is an example of a *recursive definition*,
which we will explain in the next chapter.
It defines a sequence of sets

.. math::

  S_0 &= \alpha ∖ g(\beta) \\
  S_{n+1} &= g(f(S_n)).

The definition ``sb_set`` corresponds to the set
:math:`A = \bigcup_{n \in \mathbb{N}} S_n` in our proof sketch.
The function :math:`h` described above is now defined as follows:
BOTH: -/
-- QUOTE:
def sb_fun (x : α) : β := if x ∈ sb_set f g then f x else inv_fun g x
-- QUOTE.

/- TEXT:
We will need the fact that our definition of :math:`g^{-1}` is a
right inverse on the complement of :math:`A`,
which is to say, on the non-shaded regions of :math:`\alpha`.
This is so because the outermost ring, :math:`S_0`, is equal to
:math:`\alpha \setminus g(\beta)`, so the complement of :math:`A` is
contained in :math:`g(\beta)`.
As a result, for every :math:`x` in the complement of :math:`A`,
there is a :math:`y` such that :math:`g(y) = x`.
(By the injectivity of :math:`g`, this :math:`y` is unique,
but next theorem says only that ``inv_fun g x`` returns some ``y``
such that ``g y = x``.)

Step through the proof below, make sure you understand what is going on,
and fill in the remaining parts.
You will need to use ``inv_fun_eq`` at the end.
Notice that rewriting with ``sb_aux`` here replaces ``sb_aux f g 0``
with the right-hand side of the corresponding defining equation.
BOTH: -/
-- QUOTE:
theorem sb_right_inv {x : α} (hx : x ∉ sb_set f g) :
    g (inv_fun g x) = x :=
begin
  have : x ∈ g '' univ,
  { contrapose! hx,
    rw [sb_set, mem_Union],
    use [0],
    rw [sb_aux, mem_diff],
/- EXAMPLES:
    sorry },
SOLUTIONS: -/
    exact ⟨mem_univ _, hx⟩ },
-- BOTH:
  have : ∃ y, g y = x,
/- EXAMPLES:
  { sorry },
  sorry
SOLUTIONS: -/
  { simp at this, assumption },
  exact inv_fun_eq this
-- BOTH:
end
-- QUOTE.

/- TEXT:
We now turn to the proof that :math:`h` is injective.
Informally, the proof goes as follows.
First, suppose :math:`h(x_1) = h(x_2)`.
If :math:`x_1` is in :math:`A`, then :math:`h(x_1) = f(x_1)`,
and we can show that :math:`x_2` is in :math:`A` as follows.
If it isn't, then we have :math:`h(x_2) = g^{-1}(x_2)`.
From :math:`f(x_1) = h(x_1) = h(x_2)` we have :math:`g(f(x_1)) = x_2`.
From the definition of :math:`A`, since :math:`x_1` is in :math:`A`,
:math:`x_2` is in :math:`A` as well, a contradiction.
Hence, if :math:`x_1` is in :math:`A`, so is :math:`x_2`,
in which case we have :math:`f(x_1) = h(x_1) = h(x_2) = f(x_2)`.
The injectivity of :math:`f` then implies :math:`x_1 = x_2`.
The symmetric argument shows that if :math:`x_2` is in :math:`A`,
then so is :math:`x_1`, which again implies :math:`x_1 = x_2`.

The only remaining possibility is that neither :math:`x_1` nor :math:`x_2`
is in :math:`A`. In that case, we have
:math:`g^{-1}(x_1) = h(x_1) = h(x_2) = g^{-1}(x_2)`.
Applying :math:`g` to both sides yields :math:`x_1 = x_2`.

Once again, we encourage you to step through the following proof
to see how the argument plays out in Lean.
See if you can finish off the proof using ``sb_right_inv``.
BOTH: -/
-- QUOTE:
theorem sb_injective (hf: injective f) (hg : injective g) :
  injective (sb_fun f g) :=
begin
  set A := sb_set f g with A_def,
  set h := sb_fun f g with h_def,
  intros x₁ x₂,
  assume hxeq : h x₁ = h x₂,
  show x₁ = x₂,
  simp only [h_def, sb_fun, ←A_def] at hxeq,
  by_cases xA : x₁ ∈ A ∨ x₂ ∈ A,
  { wlog : x₁ ∈ A := xA using [x₁ x₂, x₂ x₁],
    have x₂A : x₂ ∈ A,
    { apply not_imp_self.mp,
      assume x₂nA : x₂ ∉ A,
      rw [if_pos xA, if_neg x₂nA] at hxeq,
      rw [A_def, sb_set, mem_Union] at xA,
      have x₂eq : x₂ = g (f x₁),
/- EXAMPLES:
      { sorry },
SOLUTIONS: -/
      { rw [hxeq, sb_right_inv f g x₂nA] },
-- BOTH:
      rcases xA with ⟨n, hn⟩,
      rw [A_def, sb_set, mem_Union],
      use n + 1,
      simp [sb_aux],
      exact ⟨x₁, hn, x₂eq.symm⟩ },
/- EXAMPLES:
    sorry },
SOLUTIONS: -/
    rw [if_pos xA, if_pos x₂A] at hxeq,
    exact hf hxeq },
-- BOTH:
  push_neg at xA,
/- EXAMPLES:
  sorry
SOLUTIONS: -/
  rw [if_neg xA.1, if_neg xA.2] at hxeq,
  rw [←sb_right_inv f g xA.1, hxeq, sb_right_inv f g xA.2]
-- BOTH:
end
-- QUOTE.

/- TEXT:
The proof introduces some new tactics.
To start with, notice the ``set`` tactic, which introduces abbreviations
``A`` and ``h`` for ``sb_set f g`` and ``sb_fun f g`` respectively.
We name the corresponding defining equations ``A_def`` and ``h_def``.
The abbreviations are definitional, which is to say, Lean will sometimes
unfold them automatically when needed.
But not always; for example, when using ``rw``, we generally need to
use ``A_def`` and ``h_def`` explicitly.
So the definitions bring a tradeoff: they can make expressions shorter
and more readable, but they sometimes require us to do more work.

A more interesting tactic is the ``wlog`` tactic, which encapsulates
the symmetry argument in the informal proof above.
We will not dwell on it now, but notice that it does exactly what we want.
If you hover over the tactic you can take a look at its documentation.

The argument for surjectivity is even easier.
Given :math:`y` in :math:`\beta`,
we consider two cases, depending on whether :math:`g(y)` is in :math:`A`.
If it is, it can't be in :math:`S_0`, the outermost ring,
because by definition that is disjoint from the image of :math:`g`.
Thus it is an element of :math:`S_{n+1}` for some :math:`n`.
This means that it is of the form :math:`g(f(x))` for some
:math:`x` in :math:`S_n`.
By the injectivity of :math:`g`, we have :math:`f(x) = y`.
In the case where :math:`g(y)` is in the complement of :math:`A`,
we immediately have :math:`h(g(y))= y`, and we are done.

Once again, we encourage you to step through the proof and fill in
the missing parts.
The tactic ``cases n with n`` splits on the cases ``g y ∈ sb_aux f g 0``
and ``g y ∈ sb_aux f g n.succ``.
In both cases, calling the simplifier with ``simp [sb_aux]``
applies the corresponding defining equation of ``sb_aux``.
BOTH: -/
-- QUOTE:
theorem sb_surjective (hf: injective f) (hg : injective g) :
  surjective (sb_fun f g) :=
begin
  set A := sb_set f g with A_def,
  set h := sb_fun f g with h_def,
  intro y,
  by_cases gyA : g y ∈ A,
  { rw [A_def, sb_set, mem_Union] at gyA,
    rcases gyA with ⟨n, hn⟩,
    cases n with n,
    { simp [sb_aux] at hn,
      contradiction },
    simp [sb_aux] at hn,
    rcases hn with ⟨x, xmem, hx⟩,
    use x,
    have : x ∈ A,
    { rw [A_def, sb_set, mem_Union],
      exact ⟨n, xmem⟩ },
    simp only [h_def, sb_fun, if_pos this],
    exact hg hx },
/- EXAMPLES:
  sorry
SOLUTIONS: -/
  use g y,
  simp only [h_def, sb_fun, if_neg gyA],
  apply left_inverse_inv_fun hg
-- BOTH:
end
-- QUOTE.

end

/- TEXT:
We can now put it all together. The final statement is short and sweet,
and the proof uses the fact that ``bijective h`` unfolds to
``injective h ∧ surjective h``.
EXAMPLES: -/
-- QUOTE:
theorem schroeder_bernstein {f : α → β} {g : β → α}
    (hf: injective f) (hg : injective g) :
  ∃ h : α → β, bijective h :=
⟨sb_fun f g, sb_injective f g hf hg, sb_surjective f g hf hg⟩
-- QUOTE.

/- Auxliary information -/

section

variables  (g : β → α) (x : α)

-- TAG: inv_fun g
#check (inv_fun g : α → β)

#check (left_inverse_inv_fun : injective g → left_inverse (inv_fun g) g)
#check (left_inverse_inv_fun : injective g → ∀ y, inv_fun g (g y) = y)

#check (inv_fun_eq : (∃ y, g y = x) → g (inv_fun g x) = x)
-- TAG: end
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.normed_space.multilinear
import Mathlib.ring_theory.power_series.basic
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5

namespace Mathlib

/-!
# Formal multilinear series

In this file we define `formal_multilinear_series 𝕜 E F` to be a family of `n`-multilinear maps for
all `n`, designed to model the sequence of derivatives of a function. In other files we use this
notion to define `C^n` functions (called `times_cont_diff` in `mathlib`) and analytic functions.

## Notations

We use the notation `E [×n]→L[𝕜] F` for the space of continuous multilinear maps on `E^n` with
values in `F`. This is the space in which the `n`-th derivative of a function from `E` to `F` lives.

## Tags

multilinear, formal series
-/

/-- A formal multilinear series over a field `𝕜`, from `E` to `F`, is given by a family of
multilinear maps from `E^n` to `F` for all `n`. -/
def formal_multilinear_series (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] (E : Type u_2)
    [normed_group E] [normed_space 𝕜 E] (F : Type u_3) [normed_group F] [normed_space 𝕜 F] :=
  (n : ℕ) → continuous_multilinear_map 𝕜 (fun (i : fin n) => E) F

protected instance formal_multilinear_series.inhabited {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] : Inhabited (formal_multilinear_series 𝕜 E F) :=
  { default := 0 }

/- `derive` is not able to find the module structure, probably because Lean is confused by the
dependent types. We register it explicitly. -/

protected instance formal_multilinear_series.module {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] : module 𝕜 (formal_multilinear_series 𝕜 E F) :=
  let _inst : (n : ℕ) → module 𝕜 (continuous_multilinear_map 𝕜 (fun (i : fin n) => E) F) :=
    fun (n : ℕ) => continuous_multilinear_map.semimodule;
  pi.semimodule ℕ (fun (n : ℕ) => continuous_multilinear_map 𝕜 (fun (i : fin n) => E) F) 𝕜

namespace formal_multilinear_series

/-- Forgetting the zeroth term in a formal multilinear series, and interpreting the following terms
as multilinear maps into `E →L[𝕜] F`. If `p` corresponds to the Taylor series of a function, then
`p.shift` is the Taylor series of the derivative of the function. -/
def shift {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (p : formal_multilinear_series 𝕜 E F) :
    formal_multilinear_series 𝕜 E (continuous_linear_map 𝕜 E F) :=
  fun (n : ℕ) => continuous_multilinear_map.curry_right (p (Nat.succ n))

/-- Adding a zeroth term to a formal multilinear series taking values in `E →L[𝕜] F`. This
corresponds to starting from a Taylor series for the derivative of a function, and building a Taylor
series for the function itself. -/
def unshift {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (q : formal_multilinear_series 𝕜 E (continuous_linear_map 𝕜 E F)) (z : F) :
    formal_multilinear_series 𝕜 E F :=
  sorry

/-- Killing the zeroth coefficient in a formal multilinear series -/
def remove_zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (p : formal_multilinear_series 𝕜 E F) : formal_multilinear_series 𝕜 E F :=
  sorry

@[simp] theorem remove_zero_coeff_zero {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (p : formal_multilinear_series 𝕜 E F) : remove_zero p 0 = 0 :=
  rfl

@[simp] theorem remove_zero_coeff_succ {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (p : formal_multilinear_series 𝕜 E F) (n : ℕ) : remove_zero p (n + 1) = p (n + 1) :=
  rfl

theorem remove_zero_of_pos {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (p : formal_multilinear_series 𝕜 E F) {n : ℕ} (h : 0 < n) : remove_zero p n = p n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (remove_zero p n = p n)) (Eq.symm (nat.succ_pred_eq_of_pos h))))
    (Eq.refl (remove_zero p (Nat.succ (Nat.pred n))))

/-- Convenience congruence lemma stating in a dependent setting that, if the arguments to a formal
multilinear series are equal, then the values are also equal. -/
theorem congr {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E]
    [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    (p : formal_multilinear_series 𝕜 E F) {m : ℕ} {n : ℕ} {v : fin m → E} {w : fin n → E}
    (h1 : m = n)
    (h2 :
      ∀ (i : ℕ) (him : i < m) (hin : i < n),
        v { val := i, property := him } = w { val := i, property := hin }) :
    coe_fn (p m) v = coe_fn (p n) w :=
  sorry

/-- Composing each term `pₙ` in a formal multilinear series with `(u, ..., u)` where `u` is a fixed
continuous linear map, gives a new formal multilinear series `p.comp_continuous_linear_map u`. -/
def comp_continuous_linear_map {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    {G : Type u_4} [normed_group G] [normed_space 𝕜 G] (p : formal_multilinear_series 𝕜 F G)
    (u : continuous_linear_map 𝕜 E F) : formal_multilinear_series 𝕜 E G :=
  fun (n : ℕ) => continuous_multilinear_map.comp_continuous_linear_map (p n) fun (i : fin n) => u

@[simp] theorem comp_continuous_linear_map_apply {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜]
    {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F]
    [normed_space 𝕜 F] {G : Type u_4} [normed_group G] [normed_space 𝕜 G]
    (p : formal_multilinear_series 𝕜 F G) (u : continuous_linear_map 𝕜 E F) (n : ℕ)
    (v : fin n → E) : coe_fn (comp_continuous_linear_map p u n) v = coe_fn (p n) (⇑u ∘ v) :=
  rfl

/-- Reinterpret a formal `𝕜'`-multilinear series as a formal `𝕜`-multilinear series, where `𝕜'` is a
normed algebra over `𝕜`. -/
@[simp] protected def restrict_scalars (𝕜 : Type u_1) [nondiscrete_normed_field 𝕜] {E : Type u_2}
    [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F]
    {𝕜' : Type u_5} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] [normed_space 𝕜' E]
    [is_scalar_tower 𝕜 𝕜' E] [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F]
    (p : formal_multilinear_series 𝕜' E F) : formal_multilinear_series 𝕜 E F :=
  fun (n : ℕ) => continuous_multilinear_map.restrict_scalars 𝕜 (p n)

end Mathlib


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.endomorphism
import Mathlib.category_theory.category.Cat
import Mathlib.algebra.category.Mon.basic
import Mathlib.PostPort

universes u v w u_1

namespace Mathlib

/-!
# Single-object category

Single object category with a given monoid of endomorphisms.  It is defined to facilitate transfering
some definitions and lemmas (e.g., conjugacy etc.) from category theory to monoids and groups.

## Main definitions

Given a type `α` with a monoid structure, `single_obj α` is `unit` type with `category` structure
such that `End (single_obj α).star` is the monoid `α`.  This can be extended to a functor `Mon ⥤
Cat`.

If `α` is a group, then `single_obj α` is a groupoid.

An element `x : α` can be reinterpreted as an element of `End (single_obj.star α)` using
`single_obj.to_End`.

## Implementation notes

- `category_struct.comp` on `End (single_obj.star α)` is `flip (*)`, not `(*)`. This way
  multiplication on `End` agrees with the multiplication on `α`.

- By default, Lean puts instances into `category_theory` namespace instead of
  `category_theory.single_obj`, so we give all names explicitly.
-/

namespace category_theory

/-- Type tag on `unit` used to define single-object categories and groupoids. -/
def single_obj (α : Type u) :=
  Unit

namespace single_obj

/-- One and `flip (*)` become `id` and `comp` for morphisms of the single object category. -/
protected instance category_struct (α : Type u) [HasOne α] [Mul α] : category_struct (single_obj α) :=
  category_struct.mk (fun (_x : single_obj α) => 1)
    fun (_x _x_1 _x_2 : single_obj α) (x : _x ⟶ _x_1) (y : _x_1 ⟶ _x_2) => y * x

/-- Monoid laws become category laws for the single object category. -/
protected instance category (α : Type u) [monoid α] : category (single_obj α) :=
  category.mk

/--
Groupoid structure on `single_obj α`.

See https://stacks.math.columbia.edu/tag/0019.
-/
protected instance groupoid (α : Type u) [group α] : groupoid (single_obj α) :=
  groupoid.mk fun (_x _x_1 : single_obj α) (x : _x ⟶ _x_1) => x⁻¹

/-- The single object in `single_obj α`. -/
protected def star (α : Type u) : single_obj α :=
  Unit.unit

/-- The endomorphisms monoid of the only object in `single_obj α` is equivalent to the original
     monoid α. -/
def to_End (α : Type u) [monoid α] : α ≃* End (single_obj.star α) :=
  mul_equiv.mk (equiv.to_fun (equiv.refl α)) (equiv.inv_fun (equiv.refl α)) sorry sorry sorry

theorem to_End_def (α : Type u) [monoid α] (x : α) : coe_fn (to_End α) x = x :=
  rfl

/-- There is a 1-1 correspondence between monoid homomorphisms `α → β` and functors between the
    corresponding single-object categories. It means that `single_obj` is a fully faithful
    functor.

See https://stacks.math.columbia.edu/tag/001F --
although we do not characterize when the functor is full or faithful.
-/
def map_hom (α : Type u) (β : Type v) [monoid α] [monoid β] : (α →* β) ≃ single_obj α ⥤ single_obj β :=
  equiv.mk (fun (f : α →* β) => functor.mk id fun (_x _x : single_obj α) => ⇑f)
    (fun (f : single_obj α ⥤ single_obj β) => monoid_hom.mk (functor.map f) sorry sorry) sorry sorry

theorem map_hom_id (α : Type u) [monoid α] : coe_fn (map_hom α α) (monoid_hom.id α) = 𝟭 :=
  rfl

theorem map_hom_comp {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β) {γ : Type w} [monoid γ] (g : β →* γ) : coe_fn (map_hom α γ) (monoid_hom.comp g f) = coe_fn (map_hom α β) f ⋙ coe_fn (map_hom β γ) g :=
  rfl

end single_obj

end category_theory

namespace monoid_hom

/-- Reinterpret a monoid homomorphism `f : α → β` as a functor `(single_obj α) ⥤ (single_obj β)`.
See also `category_theory.single_obj.map_hom` for an equivalence between these types. -/
def to_functor {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β) : category_theory.single_obj α ⥤ category_theory.single_obj β :=
  coe_fn (category_theory.single_obj.map_hom α β) f

@[simp] theorem id_to_functor (α : Type u) [monoid α] : to_functor (id α) = 𝟭 :=
  rfl

@[simp] theorem comp_to_functor {α : Type u} {β : Type v} [monoid α] [monoid β] (f : α →* β) {γ : Type w} [monoid γ] (g : β →* γ) : to_functor (comp g f) = to_functor f ⋙ to_functor g :=
  rfl

end monoid_hom

namespace units

/--
The units in a monoid are (multiplicatively) equivalent to
the automorphisms of `star` when we think of the monoid as a single-object category. -/
def to_Aut (α : Type u) [monoid α] : units α ≃* category_theory.Aut (category_theory.single_obj.star α) :=
  mul_equiv.trans (map_equiv (category_theory.single_obj.to_End α))
    (category_theory.Aut.units_End_equiv_Aut (category_theory.single_obj.star α))

@[simp] theorem to_Aut_hom (α : Type u) [monoid α] (x : units α) : category_theory.iso.hom (coe_fn (to_Aut α) x) = coe_fn (category_theory.single_obj.to_End α) ↑x :=
  rfl

@[simp] theorem to_Aut_inv (α : Type u) [monoid α] (x : units α) : category_theory.iso.inv (coe_fn (to_Aut α) x) = coe_fn (category_theory.single_obj.to_End α) ↑(x⁻¹) :=
  rfl

end units

namespace Mon

/-- The fully faithful functor from `Mon` to `Cat`. -/
def to_Cat : Mon ⥤ category_theory.Cat :=
  category_theory.functor.mk (fun (x : Mon) => category_theory.Cat.of (category_theory.single_obj ↥x))
    fun (x y : Mon) (f : x ⟶ y) => coe_fn (category_theory.single_obj.map_hom ↥x ↥y) f

protected instance to_Cat_full : category_theory.full to_Cat :=
  category_theory.full.mk fun (x y : Mon) => equiv.inv_fun (category_theory.single_obj.map_hom ↥x ↥y)

protected instance to_Cat_faithful : category_theory.faithful to_Cat :=
  category_theory.faithful.mk


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl

Continuous linear functions -- functions between normed vector spaces which are bounded and linear.
-/
import algebra.field
import tactic.norm_num
import analysis.normed_space.basic
import analysis.asymptotics

@[simp] lemma mul_inv_eq' {α} [discrete_field α] (a b : α) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
classical.by_cases (assume : a = 0, by simp [this]) $ assume ha,
classical.by_cases (assume : b = 0, by simp [this]) $ assume hb,
mul_inv_eq hb ha

noncomputable theory
local attribute [instance] classical.prop_decidable

local notation f ` →_{`:50 a `} `:0 b := filter.tendsto f (nhds a) (nhds b)

open filter (tendsto)
open metric

variables {k : Type*} [normed_field k]
variables {E : Type*} [normed_space k E]
variables {F : Type*} [normed_space k F]
variables {G : Type*} [normed_space k G]

structure is_bounded_linear_map (k : Type*)
  [normed_field k] {E : Type*} [normed_space k E] {F : Type*} [normed_space k F] (L : E → F)
  extends is_linear_map k L : Prop :=
(bound : ∃ M, M > 0 ∧ ∀ x : E, ∥ L x ∥ ≤ M * ∥ x ∥)

include k

lemma is_linear_map.with_bound
  {L : E → F} (hf : is_linear_map k L) (M : ℝ) (h : ∀ x : E, ∥ L x ∥ ≤ M * ∥ x ∥) :
  is_bounded_linear_map k L :=
⟨ hf, classical.by_cases
  (assume : M ≤ 0, ⟨1, zero_lt_one, assume x,
    le_trans (h x) $ mul_le_mul_of_nonneg_right (le_trans this zero_le_one) (norm_nonneg x)⟩)
  (assume : ¬ M ≤ 0, ⟨M, lt_of_not_ge this, h⟩)⟩

namespace is_bounded_linear_map

def to_linear_map (f : E → F) (h : is_bounded_linear_map k f) : E →ₗ[k] F :=
(is_linear_map.mk' _ h.to_is_linear_map)

lemma zero : is_bounded_linear_map k (λ (x:E), (0:F)) :=
(0 : E →ₗ F).is_linear.with_bound 0 $ by simp [le_refl]

lemma id : is_bounded_linear_map k (λ (x:E), x) :=
linear_map.id.is_linear.with_bound 1 $ by simp [le_refl]

set_option class.instance_max_depth 43
lemma smul {f : E → F} (c : k) : is_bounded_linear_map k f → is_bounded_linear_map k (λ e, c • f e)
| ⟨hf, ⟨M, hM, h⟩⟩ := (c • hf.mk' f).is_linear.with_bound (∥c∥ * M) $ assume x,
  calc ∥c • f x∥ = ∥c∥ * ∥f x∥ : norm_smul c (f x)
    ... ≤ ∥c∥ * (M * ∥x∥) : mul_le_mul_of_nonneg_left (h x) (norm_nonneg c)
    ... = (∥c∥ * M) * ∥x∥ : (mul_assoc _ _ _).symm

lemma neg {f : E → F} (hf : is_bounded_linear_map k f) : is_bounded_linear_map k (λ e, -f e) :=
begin
  rw show (λ e, -f e) = (λ e, (-1 : k) • f e), { funext, simp },
  exact smul (-1) hf
end

lemma add {f : E → F} {g : E → F} :
  is_bounded_linear_map k f → is_bounded_linear_map k g → is_bounded_linear_map k (λ e, f e + g e)
| ⟨hlf, Mf, hMf, hf⟩  ⟨hlg, Mg, hMg, hg⟩ := (hlf.mk' _ + hlg.mk' _).is_linear.with_bound (Mf + Mg) $ assume x,
  calc ∥f x + g x∥ ≤ ∥f x∥ + ∥g x∥ : norm_triangle _ _
    ... ≤ Mf * ∥x∥ + Mg * ∥x∥ : add_le_add (hf x) (hg x)
    ... ≤ (Mf + Mg) * ∥x∥ : by rw add_mul

lemma sub {f : E → F} {g : E → F} (hf : is_bounded_linear_map k f) (hg : is_bounded_linear_map k g) :
  is_bounded_linear_map k (λ e, f e - g e) := add hf (neg hg)

lemma comp {f : E → F} {g : F → G} :
  is_bounded_linear_map k g → is_bounded_linear_map k f → is_bounded_linear_map k (g ∘ f)
| ⟨hlg, Mg, hMg, hg⟩ ⟨hlf, Mf, hMf, hf⟩ := ((hlg.mk' _).comp (hlf.mk' _)).is_linear.with_bound (Mg * Mf) $ assume x,
  calc ∥g (f x)∥ ≤ Mg * ∥f x∥ : hg _
    ... ≤ Mg * (Mf * ∥x∥) : mul_le_mul_of_nonneg_left (hf _) (le_of_lt hMg)
    ... = Mg * Mf * ∥x∥ : (mul_assoc _ _ _).symm

lemma tendsto {L : E → F} (x : E) : is_bounded_linear_map k L → L →_{x} (L x)
| ⟨hL, M, hM, h_ineq⟩ := tendsto_iff_norm_tendsto_zero.2 $
  squeeze_zero (assume e, norm_nonneg _)
    (assume e, calc ∥L e - L x∥ = ∥hL.mk' L (e - x)∥ : by rw (hL.mk' _).map_sub e x; refl
      ... ≤ M*∥e-x∥ : h_ineq (e-x))
    (suffices (λ (e : E), M * ∥e - x∥) →_{x} (M * 0), by simpa,
      tendsto_mul tendsto_const_nhds (lim_norm _))

lemma continuous {L : E → F} (hL : is_bounded_linear_map k L) : continuous L :=
continuous_iff_continuous_at.2 $ assume x, hL.tendsto x

lemma lim_zero_bounded_linear_map {L : E → F} (H : is_bounded_linear_map k L) : (L →_{0} 0) :=
(H.1.mk' _).map_zero ▸ continuous_iff_continuous_at.1 H.continuous 0

section
open asymptotics filter

theorem is_O_id {L : E → F} (h : is_bounded_linear_map k L) (l : filter E) :
  is_O L (λ x, x) l :=
let ⟨M, Mpos, hM⟩ := h.bound in
⟨M, Mpos, mem_sets_of_superset univ_mem_sets (λ x _, hM x)⟩

theorem is_O_comp {L : F → G} (h : is_bounded_linear_map k L)
  {f : E → F} (l : filter E) : is_O (λ x', L (f x')) f l :=
((h.is_O_id ⊤).comp _).mono (map_le_iff_le_comap.mp lattice.le_top)

theorem is_O_sub {L : E → F} (h : is_bounded_linear_map k L) (l : filter E) (x : E) :
  is_O (λ x', L (x' - x)) (λ x', x' - x) l :=
is_O_comp h l

end

end is_bounded_linear_map

set_option class.instance_max_depth 34

-- Next lemma is stated for real normed space but it would work as soon as the base field is an extension of ℝ
lemma bounded_continuous_linear_map
  {E : Type*} [normed_space ℝ E] {F : Type*} [normed_space ℝ F] {L : E → F}
  (lin : is_linear_map ℝ L) (cont : continuous L) : is_bounded_linear_map ℝ L :=
let ⟨δ, δ_pos, hδ⟩ := exists_delta_of_continuous cont zero_lt_one 0 in
have HL0 : L 0 = 0, from (lin.mk' _).map_zero,
have H : ∀{a}, ∥a∥ ≤ δ → ∥L a∥ < 1, by simpa only [HL0, dist_zero_right] using hδ,
lin.with_bound (δ⁻¹) $ assume x,
classical.by_cases (assume : x = 0, by simp only [this, HL0, norm_zero, mul_zero]) $
assume h : x ≠ 0,
let p := ∥x∥ * δ⁻¹, q := p⁻¹ in
have p_inv : p⁻¹ = δ*∥x∥⁻¹, by simp,

have norm_x_pos : ∥x∥ > 0 := (norm_pos_iff x).2 h,
have norm_x : ∥x∥ ≠ 0 := mt (norm_eq_zero x).1 h,

have p_pos : p > 0 := mul_pos norm_x_pos (inv_pos δ_pos),
have p0 : _ := ne_of_gt p_pos,
have q_pos : q > 0 := inv_pos p_pos,
have q0 : _ := ne_of_gt q_pos,

have ∥p⁻¹ • x∥ = δ := calc
  ∥p⁻¹ • x∥ = abs p⁻¹ * ∥x∥ : by rw norm_smul; refl
  ... = p⁻¹ * ∥x∥ : by rw [abs_of_nonneg $ le_of_lt q_pos]
  ... = δ : by simp [mul_assoc, inv_mul_cancel norm_x],

calc ∥L x∥ = (p * q) * ∥L x∥ : begin dsimp [q], rw [mul_inv_cancel p0, one_mul] end
  ... = p * ∥L (q • x)∥ : by simp [lin.smul, norm_smul, real.norm_eq_abs, abs_of_pos q_pos, mul_assoc]
  ... ≤ p * 1 : mul_le_mul_of_nonneg_left (le_of_lt $ H $ le_of_eq $ this) (le_of_lt p_pos)
  ... = δ⁻¹ * ∥x∥ : by rw [mul_one, mul_comm]