/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Andrew Zipperer, Haitao Zhang, Minchao Wu, Yury Kudryashov
-/
import data.set.prod
import logic.function.conjugate

/-!
# Functions over sets

## Main definitions

### Predicate

* `set.eq_on f₁ f₂ s` : functions `f₁` and `f₂` are equal at every point of `s`;
* `set.maps_to f s t` : `f` sends every point of `s` to a point of `t`;
* `set.inj_on f s` : restriction of `f` to `s` is injective;
* `set.surj_on f s t` : every point in `s` has a preimage in `s`;
* `set.bij_on f s t` : `f` is a bijection between `s` and `t`;
* `set.left_inv_on f' f s` : for every `x ∈ s` we have `f' (f x) = x`;
* `set.right_inv_on f' f t` : for every `y ∈ t` we have `f (f' y) = y`;
* `set.inv_on f' f s t` : `f'` is a two-side inverse of `f` on `s` and `t`, i.e.
  we have `set.left_inv_on f' f s` and `set.right_inv_on f' f t`.

### Functions

* `set.restrict f s` : restrict the domain of `f` to the set `s`;
* `set.cod_restrict f s h` : given `h : ∀ x, f x ∈ s`, restrict the codomain of `f` to the set `s`;
* `set.maps_to.restrict f s t h`: given `h : maps_to f s t`, restrict the domain of `f` to `s`
  and the codomain to `t`.
-/
universes u v w x y

variables {α : Type u} {β : Type v} {π : α → Type v} {γ : Type w} {ι : Sort x}

open function

namespace set

/-! ### Restrict -/

/-- Restrict domain of a function `f` to a set `s`. Same as `subtype.restrict` but this version
takes an argument `↥s` instead of `subtype s`. -/
def restrict (s : set α) (f : Π a : α, π a) : Π a : s, π a := λ x, f x

lemma restrict_eq (f : α → β) (s : set α) : s.restrict f = f ∘ coe := rfl

@[simp] lemma restrict_apply (f : α → β) (s : set α) (x : s) : s.restrict f x = f x := rfl

@[simp] lemma range_restrict (f : α → β) (s : set α) : set.range (s.restrict f) = f '' s :=
(range_comp _ _).trans $ congr_arg (('') f) subtype.range_coe

lemma image_restrict (f : α → β) (s t : set α) : s.restrict f '' (coe ⁻¹' t) = f '' (t ∩ s) :=
by rw [restrict, image_comp, image_preimage_eq_inter_range, subtype.range_coe]

@[simp] lemma restrict_dite {s : set α} [∀ x, decidable (x ∈ s)] (f : Π a ∈ s, β) (g : Π a ∉ s, β) :
  s.restrict (λ a, if h : a ∈ s then f a h else g a h) = λ a, f a a.2 :=
funext $ λ a, dif_pos a.2

@[simp] lemma restrict_dite_compl {s : set α} [∀ x, decidable (x ∈ s)] (f : Π a ∈ s, β)
  (g : Π a ∉ s, β) :
  sᶜ.restrict (λ a, if h : a ∈ s then f a h else g a h) = λ a, g a a.2 :=
funext $ λ a, dif_neg a.2

@[simp] lemma restrict_ite (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  s.restrict (λ a, if a ∈ s then f a else g a) = s.restrict f :=
restrict_dite _ _

@[simp] lemma restrict_ite_compl (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  sᶜ.restrict (λ a, if a ∈ s then f a else g a) = sᶜ.restrict g :=
restrict_dite_compl _ _

@[simp] lemma restrict_piecewise (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  s.restrict (piecewise s f g) = s.restrict f :=
restrict_ite _ _ _

@[simp] lemma restrict_piecewise_compl (f g : α → β) (s : set α) [∀ x, decidable (x ∈ s)] :
  sᶜ.restrict (piecewise s f g) = sᶜ.restrict g :=
restrict_ite_compl _ _ _

lemma restrict_extend_range (f : α → β) (g : α → γ) (g' : β → γ) :
  (range f).restrict (extend f g g') = λ x, g x.coe_prop.some :=
by convert restrict_dite _ _

@[simp] lemma restrict_extend_compl_range (f : α → β) (g : α → γ) (g' : β → γ) :
  (range f)ᶜ.restrict (extend f g g')  = g' ∘ coe :=
by convert restrict_dite_compl _ _

lemma range_extend_subset (f : α → β) (g : α → γ) (g' : β → γ) :
  range (extend f g g') ⊆ range g ∪ g' '' (range f)ᶜ :=
begin
  classical,
  rintro _ ⟨y, rfl⟩,
  rw extend_def, split_ifs,
  exacts [or.inl (mem_range_self _), or.inr (mem_image_of_mem _ h)]
end

lemma range_extend {f : α → β} (hf : injective f) (g : α → γ) (g' : β → γ) :
  range (extend f g g') = range g ∪ g' '' (range f)ᶜ :=
begin
  refine (range_extend_subset _ _ _).antisymm _,
  rintro z (⟨x, rfl⟩|⟨y, hy, rfl⟩),
  exacts [⟨f x, extend_apply hf _ _ _⟩, ⟨y, extend_apply' _ _ _ hy⟩]
end

/-- Restrict codomain of a function `f` to a set `s`. Same as `subtype.coind` but this version
has codomain `↥s` instead of `subtype s`. -/
def cod_restrict (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) : α → s :=
λ x, ⟨f x, h x⟩

@[simp] lemma coe_cod_restrict_apply (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) (x : α) :
  (cod_restrict f s h x : β) = f x :=
rfl

@[simp] lemma restrict_comp_cod_restrict {f : α → β} {g : β → γ} {b : set β}
  (h : ∀ x, f x ∈ b) : (b.restrict g) ∘ (b.cod_restrict f h) = g ∘ f := rfl

variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {p : set γ} {f f₁ f₂ f₃ : α → β} {g g₁ g₂ : β → γ}
  {f' f₁' f₂' : β → α} {g' : γ → β}

@[simp] lemma injective_cod_restrict (h : ∀ x, f x ∈ t) :
  injective (cod_restrict f t h) ↔ injective f :=
by simp only [injective, subtype.ext_iff, coe_cod_restrict_apply]

alias injective_cod_restrict ↔ _ function.injective.cod_restrict

/-! ### Equality on a set -/

/-- Two functions `f₁ f₂ : α → β` are equal on `s`
  if `f₁ x = f₂ x` for all `x ∈ a`. -/
def eq_on (f₁ f₂ : α → β) (s : set α) : Prop :=
∀ ⦃x⦄, x ∈ s → f₁ x = f₂ x

@[simp] lemma eq_on_empty (f₁ f₂ : α → β) : eq_on f₁ f₂ ∅ := λ x, false.elim

@[symm] lemma eq_on.symm (h : eq_on f₁ f₂ s) : eq_on f₂ f₁ s :=
λ x hx, (h hx).symm

lemma eq_on_comm : eq_on f₁ f₂ s ↔ eq_on f₂ f₁ s :=
⟨eq_on.symm, eq_on.symm⟩

@[refl] lemma eq_on_refl (f : α → β) (s : set α) : eq_on f f s :=
λ _ _, rfl

@[trans] lemma eq_on.trans (h₁ : eq_on f₁ f₂ s) (h₂ : eq_on f₂ f₃ s) : eq_on f₁ f₃ s :=
λ x hx, (h₁ hx).trans (h₂ hx)

theorem eq_on.image_eq (heq : eq_on f₁ f₂ s) : f₁ '' s = f₂ '' s :=
image_congr heq

theorem eq_on.inter_preimage_eq (heq : eq_on f₁ f₂ s) (t : set β) : s ∩ f₁ ⁻¹' t = s ∩ f₂ ⁻¹' t :=
ext $ λ x, and.congr_right_iff.2 $ λ hx, by rw [mem_preimage, mem_preimage, heq hx]

lemma eq_on.mono (hs : s₁ ⊆ s₂) (hf : eq_on f₁ f₂ s₂) : eq_on f₁ f₂ s₁ :=
λ x hx, hf (hs hx)

lemma eq_on.comp_left (h : s.eq_on f₁ f₂) : s.eq_on (g ∘ f₁) (g ∘ f₂) := λ a ha, congr_arg _ $ h ha

lemma comp_eq_of_eq_on_range {ι : Sort*} {f : ι → α} {g₁ g₂ : α → β} (h : eq_on g₁ g₂ (range f)) :
  g₁ ∘ f = g₂ ∘ f :=
funext $ λ x, h $ mem_range_self _

/-! ### Congruence lemmas -/

section order
variables [preorder α] [preorder β]

lemma _root_.monotone_on.congr (h₁ : monotone_on f₁ s) (h : s.eq_on f₁ f₂) : monotone_on f₂ s :=
begin
  intros a ha b hb hab,
  rw [←h ha, ←h hb],
  exact h₁ ha hb hab,
end

lemma _root_.antitone_on.congr (h₁ : antitone_on f₁ s) (h : s.eq_on f₁ f₂) : antitone_on f₂ s :=
h₁.dual_right.congr h

lemma _root_.strict_mono_on.congr (h₁ : strict_mono_on f₁ s) (h : s.eq_on f₁ f₂) :
  strict_mono_on f₂ s :=
begin
  intros a ha b hb hab,
  rw [←h ha, ←h hb],
  exact h₁ ha hb hab,
end

lemma _root_.strict_anti_on.congr (h₁ : strict_anti_on f₁ s) (h : s.eq_on f₁ f₂) :
  strict_anti_on f₂ s :=
h₁.dual_right.congr h

lemma eq_on.congr_monotone_on (h : s.eq_on f₁ f₂) : monotone_on f₁ s ↔ monotone_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

lemma eq_on.congr_antitone_on (h : s.eq_on f₁ f₂) : antitone_on f₁ s ↔ antitone_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

lemma eq_on.congr_strict_mono_on (h : s.eq_on f₁ f₂) : strict_mono_on f₁ s ↔ strict_mono_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

lemma eq_on.congr_strict_anti_on (h : s.eq_on f₁ f₂) : strict_anti_on f₁ s ↔ strict_anti_on f₂ s :=
⟨λ h₁, h₁.congr h, λ h₂, h₂.congr h.symm⟩

end order

/-! ### maps to -/

/-- `maps_to f a b` means that the image of `a` is contained in `b`. -/
def maps_to (f : α → β) (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ s → f x ∈ t

/-- Given a map `f` sending `s : set α` into `t : set β`, restrict domain of `f` to `s`
and the codomain to `t`. Same as `subtype.map`. -/
def maps_to.restrict (f : α → β) (s : set α) (t : set β) (h : maps_to f s t) :
  s → t :=
subtype.map f h

@[simp] lemma maps_to.coe_restrict_apply (h : maps_to f s t) (x : s) :
  (h.restrict f s t x : β) = f x := rfl

lemma maps_to_iff_exists_map_subtype : maps_to f s t ↔ ∃ g : s → t, ∀ x : s, f x = g x :=
⟨λ h, ⟨h.restrict f s t, λ _, rfl⟩,
  λ ⟨g, hg⟩ x hx, by { erw [hg ⟨x, hx⟩], apply subtype.coe_prop }⟩

theorem maps_to' : maps_to f s t ↔ f '' s ⊆ t :=
image_subset_iff.symm

@[simp] theorem maps_to_singleton {x : α} : maps_to f {x} t ↔ f x ∈ t := singleton_subset_iff

theorem maps_to_empty (f : α → β) (t : set β) : maps_to f ∅ t := empty_subset _

theorem maps_to.image_subset (h : maps_to f s t) : f '' s ⊆ t :=
maps_to'.1 h

theorem maps_to.congr (h₁ : maps_to f₁ s t) (h : eq_on f₁ f₂ s) :
  maps_to f₂ s t :=
λ x hx, h hx ▸ h₁ hx

lemma eq_on.comp_right (hg : t.eq_on g₁ g₂) (hf : s.maps_to f t) : s.eq_on (g₁ ∘ f) (g₂ ∘ f) :=
λ a ha, hg $ hf ha

theorem eq_on.maps_to_iff (H : eq_on f₁ f₂ s) : maps_to f₁ s t ↔ maps_to f₂ s t :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

theorem maps_to.comp (h₁ : maps_to g t p) (h₂ : maps_to f s t) : maps_to (g ∘ f) s p :=
λ x h, h₁ (h₂ h)

theorem maps_to_id (s : set α) : maps_to id s s := λ x, id

theorem maps_to.iterate {f : α → α} {s : set α} (h : maps_to f s s) :
  ∀ n, maps_to (f^[n]) s s
| 0 := λ _, id
| (n+1) := (maps_to.iterate n).comp h

theorem maps_to.iterate_restrict {f : α → α} {s : set α} (h : maps_to f s s) (n : ℕ) :
  (h.restrict f s s^[n]) = (h.iterate n).restrict _ _ _ :=
begin
  funext x,
  rw [subtype.ext_iff, maps_to.coe_restrict_apply],
  induction n with n ihn generalizing x,
  { refl },
  { simp [nat.iterate, ihn] }
end

theorem maps_to.mono (hf : maps_to f s₁ t₁) (hs : s₂ ⊆ s₁) (ht : t₁ ⊆ t₂) :
  maps_to f s₂ t₂ :=
λ x hx, ht (hf $ hs hx)

theorem maps_to.mono_left (hf : maps_to f s₁ t) (hs : s₂ ⊆ s₁) : maps_to f s₂ t :=
λ x hx, hf (hs hx)

theorem maps_to.mono_right (hf : maps_to f s t₁) (ht : t₁ ⊆ t₂) : maps_to f s t₂ :=
λ x hx, ht (hf hx)

theorem maps_to.union_union (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
  maps_to f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
λ x hx, hx.elim (λ hx, or.inl $ h₁ hx) (λ hx, or.inr $ h₂ hx)

theorem maps_to.union (h₁ : maps_to f s₁ t) (h₂ : maps_to f s₂ t) :
  maps_to f (s₁ ∪ s₂) t :=
union_self t ▸ h₁.union_union h₂

@[simp] theorem maps_to_union : maps_to f (s₁ ∪ s₂) t ↔ maps_to f s₁ t ∧ maps_to f s₂ t :=
⟨λ h, ⟨h.mono (subset_union_left s₁ s₂) (subset.refl t),
  h.mono (subset_union_right s₁ s₂) (subset.refl t)⟩, λ h, h.1.union h.2⟩

theorem maps_to.inter (h₁ : maps_to f s t₁) (h₂ : maps_to f s t₂) :
  maps_to f s (t₁ ∩ t₂) :=
λ x hx, ⟨h₁ hx, h₂ hx⟩

theorem maps_to.inter_inter (h₁ : maps_to f s₁ t₁) (h₂ : maps_to f s₂ t₂) :
  maps_to f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
λ x hx, ⟨h₁ hx.1, h₂ hx.2⟩

@[simp] theorem maps_to_inter : maps_to f s (t₁ ∩ t₂) ↔ maps_to f s t₁ ∧ maps_to f s t₂ :=
⟨λ h, ⟨h.mono (subset.refl s) (inter_subset_left t₁ t₂),
  h.mono (subset.refl s) (inter_subset_right t₁ t₂)⟩, λ h, h.1.inter h.2⟩

theorem maps_to_univ (f : α → β) (s : set α) : maps_to f s univ := λ x h, trivial

theorem maps_to_image (f : α → β) (s : set α) : maps_to f s (f '' s) := by rw maps_to'

theorem maps_to_preimage (f : α → β) (t : set β) : maps_to f (f ⁻¹' t) t := subset.refl _

theorem maps_to_range (f : α → β) (s : set α) : maps_to f s (range f) :=
(maps_to_image f s).mono (subset.refl s) (image_subset_range _ _)

@[simp] lemma maps_image_to (f : α → β) (g : γ → α) (s : set γ) (t : set β) :
  maps_to f (g '' s) t ↔ maps_to (f ∘ g) s t :=
⟨λ h c hc, h ⟨c, hc, rfl⟩, λ h d ⟨c, hc⟩, hc.2 ▸ h hc.1⟩

@[simp] lemma maps_univ_to (f : α → β) (s : set β) :
  maps_to f univ s ↔ ∀ a, f a ∈ s :=
⟨λ h a, h (mem_univ _), λ h x _, h x⟩

@[simp] lemma maps_range_to (f : α → β) (g : γ → α) (s : set β) :
  maps_to f (range g) s ↔ maps_to (f ∘ g) univ s :=
by rw [←image_univ, maps_image_to]

theorem surjective_maps_to_image_restrict (f : α → β) (s : set α) :
  surjective ((maps_to_image f s).restrict f s (f '' s)) :=
λ ⟨y, x, hs, hxy⟩, ⟨⟨x, hs⟩, subtype.ext hxy⟩

theorem maps_to.mem_iff (h : maps_to f s t) (hc : maps_to f sᶜ tᶜ) {x} : f x ∈ t ↔ x ∈ s :=
⟨λ ht, by_contra $ λ hs, hc hs ht, λ hx, h hx⟩

/-! ### Injectivity on a set -/

/-- `f` is injective on `a` if the restriction of `f` to `a` is injective. -/
def inj_on (f : α → β) (s : set α) : Prop :=
∀ ⦃x₁ : α⦄, x₁ ∈ s → ∀ ⦃x₂ : α⦄, x₂ ∈ s → f x₁ = f x₂ → x₁ = x₂

theorem subsingleton.inj_on (hs : s.subsingleton) (f : α → β) : inj_on f s :=
λ x hx y hy h, hs hx hy

@[simp] theorem inj_on_empty (f : α → β) : inj_on f ∅ :=
subsingleton_empty.inj_on f

@[simp] theorem inj_on_singleton (f : α → β) (a : α) : inj_on f {a} :=
subsingleton_singleton.inj_on f

theorem inj_on.eq_iff {x y} (h : inj_on f s) (hx : x ∈ s) (hy : y ∈ s) :
  f x = f y ↔ x = y :=
⟨h hx hy, λ h, h ▸ rfl⟩

theorem inj_on.congr (h₁ : inj_on f₁ s) (h : eq_on f₁ f₂ s) :
  inj_on f₂ s :=
λ x hx y hy, h hx ▸ h hy ▸ h₁ hx hy

theorem eq_on.inj_on_iff (H : eq_on f₁ f₂ s) : inj_on f₁ s ↔ inj_on f₂ s :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

theorem inj_on.mono (h : s₁ ⊆ s₂) (ht : inj_on f s₂) : inj_on f s₁ :=
λ x hx y hy H, ht (h hx) (h hy) H

theorem inj_on_union (h : disjoint s₁ s₂) :
  inj_on f (s₁ ∪ s₂) ↔ inj_on f s₁ ∧ inj_on f s₂ ∧ ∀ (x ∈ s₁) (y ∈ s₂), f x ≠ f y :=
begin
  refine ⟨λ H, ⟨H.mono $ subset_union_left _ _, H.mono $ subset_union_right _ _, _⟩, _⟩,
  { intros x hx y hy hxy,
    obtain rfl : x = y, from H (or.inl hx) (or.inr hy) hxy,
    exact h ⟨hx, hy⟩ },
  { rintro ⟨h₁, h₂, h₁₂⟩,
    rintro x (hx|hx) y (hy|hy) hxy,
    exacts [h₁ hx hy hxy, (h₁₂ _ hx _ hy hxy).elim, (h₁₂ _ hy _ hx hxy.symm).elim, h₂ hx hy hxy] }
end

theorem inj_on_insert {f : α → β} {s : set α} {a : α} (has : a ∉ s) :
  set.inj_on f (insert a s) ↔ set.inj_on f s ∧ f a ∉ f '' s :=
have disjoint s {a}, from λ x ⟨hxs, (hxa : x = a)⟩, has (hxa ▸ hxs),
by { rw [← union_singleton, inj_on_union this], simp }

lemma injective_iff_inj_on_univ : injective f ↔ inj_on f univ :=
⟨λ h x hx y hy hxy, h hxy, λ h _ _ heq, h trivial trivial heq⟩

lemma inj_on_of_injective (h : injective f) (s : set α) : inj_on f s :=
λ x hx y hy hxy, h hxy

alias inj_on_of_injective ← function.injective.inj_on

theorem inj_on.comp (hg : inj_on g t) (hf: inj_on f s) (h : maps_to f s t) :
  inj_on (g ∘ f) s :=
λ x hx y hy heq, hf hx hy $ hg (h hx) (h hy) heq

lemma inj_on_iff_injective : inj_on f s ↔ injective (s.restrict f) :=
⟨λ H a b h, subtype.eq $ H a.2 b.2 h,
 λ H a as b bs h, congr_arg subtype.val $ @H ⟨a, as⟩ ⟨b, bs⟩ h⟩

alias inj_on_iff_injective ↔ set.inj_on.injective _

lemma inj_on_preimage {B : set (set β)} (hB : B ⊆ 𝒫 (range f)) :
  inj_on (preimage f) B :=
λ s hs t ht hst, (preimage_eq_preimage' (hB hs) (hB ht)).1 hst

lemma inj_on.mem_of_mem_image {x} (hf : inj_on f s) (hs : s₁ ⊆ s) (h : x ∈ s) (h₁ : f x ∈ f '' s₁) :
  x ∈ s₁ :=
let ⟨x', h', eq⟩ := h₁ in hf (hs h') h eq ▸ h'

lemma inj_on.mem_image_iff {x} (hf : inj_on f s) (hs : s₁ ⊆ s) (hx : x ∈ s) :
  f x ∈ f '' s₁ ↔ x ∈ s₁ :=
⟨hf.mem_of_mem_image hs hx, mem_image_of_mem f⟩

lemma inj_on.preimage_image_inter (hf : inj_on f s) (hs : s₁ ⊆ s) :
  f ⁻¹' (f '' s₁) ∩ s = s₁ :=
ext $ λ x, ⟨λ ⟨h₁, h₂⟩, hf.mem_of_mem_image hs h₂ h₁, λ h, ⟨mem_image_of_mem _ h, hs h⟩⟩

lemma eq_on.cancel_left (h : s.eq_on (g ∘ f₁) (g ∘ f₂)) (hg : t.inj_on g) (hf₁ : s.maps_to f₁ t)
  (hf₂ : s.maps_to f₂ t) :
  s.eq_on f₁ f₂ :=
λ a ha, hg (hf₁ ha) (hf₂ ha) (h ha)

lemma inj_on.cancel_left (hg : t.inj_on g) (hf₁ : s.maps_to f₁ t) (hf₂ : s.maps_to f₂ t) :
  s.eq_on (g ∘ f₁) (g ∘ f₂) ↔ s.eq_on f₁ f₂ :=
⟨λ h, h.cancel_left hg hf₁ hf₂, eq_on.comp_left⟩

/-! ### Surjectivity on a set -/

/-- `f` is surjective from `a` to `b` if `b` is contained in the image of `a`. -/
def surj_on (f : α → β) (s : set α) (t : set β) : Prop := t ⊆ f '' s

theorem surj_on.subset_range (h : surj_on f s t) : t ⊆ range f :=
subset.trans h $ image_subset_range f s

lemma surj_on_iff_exists_map_subtype :
  surj_on f s t ↔ ∃ (t' : set β) (g : s → t'), t ⊆ t' ∧ surjective g ∧ ∀ x : s, f x = g x :=
⟨λ h, ⟨_, (maps_to_image f s).restrict f s _, h, surjective_maps_to_image_restrict _ _, λ _, rfl⟩,
  λ ⟨t', g, htt', hg, hfg⟩ y hy, let ⟨x, hx⟩ := hg ⟨y, htt' hy⟩ in
    ⟨x, x.2, by rw [hfg, hx, subtype.coe_mk]⟩⟩

theorem surj_on_empty (f : α → β) (s : set α) : surj_on f s ∅ := empty_subset _

theorem surj_on_image (f : α → β) (s : set α) : surj_on f s (f '' s) := subset.rfl

theorem surj_on.comap_nonempty (h : surj_on f s t) (ht : t.nonempty) : s.nonempty :=
(ht.mono h).of_image

theorem surj_on.congr (h : surj_on f₁ s t) (H : eq_on f₁ f₂ s) : surj_on f₂ s t :=
by rwa [surj_on, ← H.image_eq]

theorem eq_on.surj_on_iff (h : eq_on f₁ f₂ s) : surj_on f₁ s t ↔ surj_on f₂ s t :=
⟨λ H, H.congr h, λ H, H.congr h.symm⟩

theorem surj_on.mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) (hf : surj_on f s₁ t₂) : surj_on f s₂ t₁ :=
subset.trans ht $ subset.trans hf $ image_subset _ hs

theorem surj_on.union (h₁ : surj_on f s t₁) (h₂ : surj_on f s t₂) : surj_on f s (t₁ ∪ t₂) :=
λ x hx, hx.elim (λ hx, h₁ hx) (λ hx, h₂ hx)

theorem surj_on.union_union (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂) :
  surj_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
(h₁.mono (subset_union_left _ _) (subset.refl _)).union
  (h₂.mono (subset_union_right _ _) (subset.refl _))

theorem surj_on.inter_inter (h₁ : surj_on f s₁ t₁) (h₂ : surj_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  surj_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
begin
  intros y hy,
  rcases h₁ hy.1 with ⟨x₁, hx₁, rfl⟩,
  rcases h₂ hy.2 with ⟨x₂, hx₂, heq⟩,
  have : x₁ = x₂, from h (or.inl hx₁) (or.inr hx₂) heq.symm,
  subst x₂,
  exact mem_image_of_mem f ⟨hx₁, hx₂⟩
end

theorem surj_on.inter (h₁ : surj_on f s₁ t) (h₂ : surj_on f s₂ t) (h : inj_on f (s₁ ∪ s₂)) :
  surj_on f (s₁ ∩ s₂) t :=
inter_self t ▸ h₁.inter_inter h₂ h

theorem surj_on.comp (hg : surj_on g t p) (hf : surj_on f s t) : surj_on (g ∘ f) s p :=
subset.trans hg $ subset.trans (image_subset g hf) $ (image_comp g f s) ▸ subset.refl _

lemma surjective_iff_surj_on_univ : surjective f ↔ surj_on f univ univ :=
by simp [surjective, surj_on, subset_def]

lemma surj_on_iff_surjective : surj_on f s univ ↔ surjective (s.restrict f) :=
⟨λ H b, let ⟨a, as, e⟩ := @H b trivial in ⟨⟨a, as⟩, e⟩,
 λ H b _, let ⟨⟨a, as⟩, e⟩ := H b in ⟨a, as, e⟩⟩

lemma surj_on.image_eq_of_maps_to (h₁ : surj_on f s t) (h₂ : maps_to f s t) :
  f '' s = t :=
eq_of_subset_of_subset h₂.image_subset h₁

lemma image_eq_iff_surj_on_maps_to : f '' s = t ↔ s.surj_on f t ∧ s.maps_to f t :=
begin
  refine ⟨_, λ h, h.1.image_eq_of_maps_to h.2⟩,
  rintro rfl,
  exact ⟨s.surj_on_image f, s.maps_to_image f⟩,
end

lemma surj_on.maps_to_compl (h : surj_on f s t) (h' : injective f) : maps_to f sᶜ tᶜ :=
λ x hs ht, let ⟨x', hx', heq⟩ := h ht in hs $ h' heq ▸ hx'

lemma maps_to.surj_on_compl (h : maps_to f s t) (h' : surjective f) : surj_on f sᶜ tᶜ :=
h'.forall.2 $ λ x ht, mem_image_of_mem _ $ λ hs, ht (h hs)

lemma eq_on.cancel_right (hf : s.eq_on (g₁ ∘ f) (g₂ ∘ f)) (hf' : s.surj_on f t) : t.eq_on g₁ g₂ :=
begin
  intros b hb,
  obtain ⟨a, ha, rfl⟩ := hf' hb,
  exact hf ha,
end

lemma surj_on.cancel_right (hf : s.surj_on f t) (hf' : s.maps_to f t) :
  s.eq_on (g₁ ∘ f) (g₂ ∘ f) ↔ t.eq_on g₁ g₂ :=
⟨λ h, h.cancel_right hf, λ h, h.comp_right hf'⟩

lemma eq_on_comp_right_iff : s.eq_on (g₁ ∘ f) (g₂ ∘ f) ↔ (f '' s).eq_on g₁ g₂ :=
(s.surj_on_image f).cancel_right $ s.maps_to_image f

/-! ### Bijectivity -/

/-- `f` is bijective from `s` to `t` if `f` is injective on `s` and `f '' s = t`. -/
def bij_on (f : α → β) (s : set α) (t : set β) : Prop :=
maps_to f s t ∧ inj_on f s ∧ surj_on f s t

lemma bij_on.maps_to (h : bij_on f s t) : maps_to f s t := h.left

lemma bij_on.inj_on (h : bij_on f s t) : inj_on f s := h.right.left

lemma bij_on.surj_on (h : bij_on f s t) : surj_on f s t := h.right.right

lemma bij_on.mk (h₁ : maps_to f s t) (h₂ : inj_on f s) (h₃ : surj_on f s t) :
      bij_on f s t :=
⟨h₁, h₂, h₃⟩

lemma bij_on_empty (f : α → β) : bij_on f ∅ ∅ :=
⟨maps_to_empty f ∅, inj_on_empty f, surj_on_empty f ∅⟩

lemma bij_on.inter (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
⟨h₁.maps_to.inter_inter h₂.maps_to, h₁.inj_on.mono $ inter_subset_left _ _,
  h₁.surj_on.inter_inter h₂.surj_on h⟩

lemma bij_on.union (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
  bij_on f (s₁ ∪ s₂) (t₁ ∪ t₂) :=
⟨h₁.maps_to.union_union h₂.maps_to, h, h₁.surj_on.union_union h₂.surj_on⟩

theorem bij_on.subset_range (h : bij_on f s t) : t ⊆ range f :=
h.surj_on.subset_range

lemma inj_on.bij_on_image (h : inj_on f s) : bij_on f s (f '' s) :=
bij_on.mk (maps_to_image f s) h (subset.refl _)

theorem bij_on.congr (h₁ : bij_on f₁ s t) (h : eq_on f₁ f₂ s) :
  bij_on f₂ s t :=
bij_on.mk (h₁.maps_to.congr h) (h₁.inj_on.congr h) (h₁.surj_on.congr h)

theorem eq_on.bij_on_iff (H : eq_on f₁ f₂ s) : bij_on f₁ s t ↔ bij_on f₂ s t :=
⟨λ h, h.congr H, λ h, h.congr H.symm⟩

lemma bij_on.image_eq (h : bij_on f s t) :
  f '' s = t :=
h.surj_on.image_eq_of_maps_to h.maps_to

theorem bij_on.comp (hg : bij_on g t p) (hf : bij_on f s t) : bij_on (g ∘ f) s p :=
bij_on.mk (hg.maps_to.comp hf.maps_to) (hg.inj_on.comp hf.inj_on hf.maps_to)
  (hg.surj_on.comp hf.surj_on)

theorem bij_on.bijective (h : bij_on f s t) :
  bijective (t.cod_restrict (s.restrict f) $ λ x, h.maps_to x.val_prop) :=
⟨λ x y h', subtype.ext $ h.inj_on x.2 y.2 $ subtype.ext_iff.1 h',
  λ ⟨y, hy⟩, let ⟨x, hx, hxy⟩ := h.surj_on hy in ⟨⟨x, hx⟩, subtype.eq hxy⟩⟩

lemma bijective_iff_bij_on_univ : bijective f ↔ bij_on f univ univ :=
iff.intro
(λ h, let ⟨inj, surj⟩ := h in
⟨maps_to_univ f _, inj.inj_on _, iff.mp surjective_iff_surj_on_univ surj⟩)
(λ h, let ⟨map, inj, surj⟩ := h in
⟨iff.mpr injective_iff_inj_on_univ inj, iff.mpr surjective_iff_surj_on_univ surj⟩)

lemma bij_on.compl (hst : bij_on f s t) (hf : bijective f) : bij_on f sᶜ tᶜ :=
⟨hst.surj_on.maps_to_compl hf.1, hf.1.inj_on _, hst.maps_to.surj_on_compl hf.2⟩

/-! ### left inverse -/

/-- `g` is a left inverse to `f` on `a` means that `g (f x) = x` for all `x ∈ a`. -/
def left_inv_on (f' : β → α) (f : α → β) (s : set α) : Prop :=
∀ ⦃x⦄, x ∈ s → f' (f x) = x

lemma left_inv_on.eq_on (h : left_inv_on f' f s) : eq_on (f' ∘ f) id s := h

lemma left_inv_on.eq (h : left_inv_on f' f s) {x} (hx : x ∈ s) : f' (f x) = x := h hx

lemma left_inv_on.congr_left (h₁ : left_inv_on f₁' f s)
  {t : set β} (h₁' : maps_to f s t) (heq : eq_on f₁' f₂' t) : left_inv_on f₂' f s :=
λ x hx, heq (h₁' hx) ▸ h₁ hx

theorem left_inv_on.congr_right (h₁ : left_inv_on f₁' f₁ s) (heq : eq_on f₁ f₂ s) :
  left_inv_on f₁' f₂ s :=
λ x hx, heq hx ▸ h₁ hx

theorem left_inv_on.inj_on (h : left_inv_on f₁' f s) : inj_on f s :=
λ x₁ h₁ x₂ h₂ heq,
calc
  x₁    = f₁' (f x₁) : eq.symm $ h h₁
  ...   = f₁' (f x₂) : congr_arg f₁' heq
  ...   = x₂         : h h₂

theorem left_inv_on.surj_on (h : left_inv_on f' f s) (hf : maps_to f s t) : surj_on f' t s :=
λ x hx, ⟨f x, hf hx, h hx⟩

theorem left_inv_on.maps_to (h : left_inv_on f' f s) (hf : surj_on f s t) : maps_to f' t s :=
λ y hy, let ⟨x, hs, hx⟩ := hf hy in by rwa [← hx, h hs]

theorem left_inv_on.comp
  (hf' : left_inv_on f' f s) (hg' : left_inv_on g' g t) (hf : maps_to f s t) :
  left_inv_on (f' ∘ g') (g ∘ f) s :=
λ x h,
calc
  (f' ∘ g') ((g ∘ f) x) = f' (f x) : congr_arg f' (hg' (hf h))
  ...                   = x        : hf' h

theorem left_inv_on.mono (hf : left_inv_on f' f s) (ht : s₁ ⊆ s) : left_inv_on f' f s₁ :=
λ x hx, hf (ht hx)

theorem left_inv_on.image_inter' (hf : left_inv_on f' f s) :
  f '' (s₁ ∩ s) = f' ⁻¹' s₁ ∩ f '' s :=
begin
  apply subset.antisymm,
  { rintro _ ⟨x, ⟨h₁, h⟩, rfl⟩, exact ⟨by rwa [mem_preimage, hf h], mem_image_of_mem _ h⟩ },
  { rintro _ ⟨h₁, ⟨x, h, rfl⟩⟩, exact mem_image_of_mem _ ⟨by rwa ← hf h, h⟩ }
end

theorem left_inv_on.image_inter (hf : left_inv_on f' f s) :
  f '' (s₁ ∩ s) = f' ⁻¹' (s₁ ∩ s) ∩ f '' s :=
begin
  rw hf.image_inter',
  refine subset.antisymm _ (inter_subset_inter_left _ (preimage_mono $ inter_subset_left _ _)),
  rintro _ ⟨h₁, x, hx, rfl⟩, exact ⟨⟨h₁, by rwa hf hx⟩, mem_image_of_mem _ hx⟩
end

theorem left_inv_on.image_image (hf : left_inv_on f' f s) :
  f' '' (f '' s) = s :=
by rw [image_image, image_congr hf, image_id']

theorem left_inv_on.image_image' (hf : left_inv_on f' f s) (hs : s₁ ⊆ s) :
  f' '' (f '' s₁) = s₁ :=
(hf.mono hs).image_image

/-! ### Right inverse -/

/-- `g` is a right inverse to `f` on `b` if `f (g x) = x` for all `x ∈ b`. -/
@[reducible] def right_inv_on (f' : β → α) (f : α → β) (t : set β) : Prop :=
left_inv_on f f' t

lemma right_inv_on.eq_on (h : right_inv_on f' f t) : eq_on (f ∘ f') id t := h

lemma right_inv_on.eq (h : right_inv_on f' f t) {y} (hy : y ∈ t) : f (f' y) = y := h hy

lemma left_inv_on.right_inv_on_image (h : left_inv_on f' f s) : right_inv_on f' f (f '' s) :=
λ y ⟨x, hx, eq⟩, eq ▸ congr_arg f $ h.eq hx

theorem right_inv_on.congr_left (h₁ : right_inv_on f₁' f t) (heq : eq_on f₁' f₂' t) :
  right_inv_on f₂' f t :=
h₁.congr_right heq

theorem right_inv_on.congr_right (h₁ : right_inv_on f' f₁ t) (hg : maps_to f' t s)
  (heq : eq_on f₁ f₂ s) : right_inv_on f' f₂ t :=
left_inv_on.congr_left h₁ hg heq

theorem right_inv_on.surj_on (hf : right_inv_on f' f t) (hf' : maps_to f' t s) :
  surj_on f s t :=
hf.surj_on hf'

theorem right_inv_on.maps_to (h : right_inv_on f' f t) (hf : surj_on f' t s) : maps_to f s t :=
h.maps_to hf

theorem right_inv_on.comp (hf : right_inv_on f' f t) (hg : right_inv_on g' g p)
  (g'pt : maps_to g' p t) : right_inv_on (f' ∘ g') (g ∘ f) p :=
hg.comp hf g'pt

theorem right_inv_on.mono (hf : right_inv_on f' f t) (ht : t₁ ⊆ t) : right_inv_on f' f t₁ :=
hf.mono ht

theorem inj_on.right_inv_on_of_left_inv_on (hf : inj_on f s) (hf' : left_inv_on f f' t)
    (h₁ : maps_to f s t) (h₂ : maps_to f' t s) :
  right_inv_on f f' s :=
λ x h, hf (h₂ $ h₁ h) h (hf' (h₁ h))

theorem eq_on_of_left_inv_on_of_right_inv_on (h₁ : left_inv_on f₁' f s) (h₂ : right_inv_on f₂' f t)
  (h : maps_to f₂' t s) : eq_on f₁' f₂' t :=
λ y hy,
calc f₁' y = (f₁' ∘ f ∘ f₂') y : congr_arg f₁' (h₂ hy).symm
      ...  = f₂' y              : h₁ (h hy)

theorem surj_on.left_inv_on_of_right_inv_on (hf : surj_on f s t) (hf' : right_inv_on f f' s) :
  left_inv_on f f' t :=
λ y hy, let ⟨x, hx, heq⟩ := hf hy in by rw [← heq, hf' hx]

/-! ### Two-side inverses -/

/-- `g` is an inverse to `f` viewed as a map from `a` to `b` -/
def inv_on (g : β → α) (f : α → β) (s : set α) (t : set β) : Prop :=
left_inv_on g f s ∧ right_inv_on g f t

lemma inv_on.symm (h : inv_on f' f s t) : inv_on f f' t s := ⟨h.right, h.left⟩

lemma inv_on.mono (h : inv_on f' f s t) (hs : s₁ ⊆ s) (ht : t₁ ⊆ t) : inv_on f' f s₁ t₁ :=
⟨h.1.mono hs, h.2.mono ht⟩

/-- If functions `f'` and `f` are inverse on `s` and `t`, `f` maps `s` into `t`, and `f'` maps `t`
into `s`, then `f` is a bijection between `s` and `t`. The `maps_to` arguments can be deduced from
`surj_on` statements using `left_inv_on.maps_to` and `right_inv_on.maps_to`. -/
theorem inv_on.bij_on (h : inv_on f' f s t) (hf : maps_to f s t) (hf' : maps_to f' t s) :
  bij_on f s t :=
⟨hf, h.left.inj_on, h.right.surj_on hf'⟩

end set

/-! ### `inv_fun_on` is a left/right inverse -/

namespace function

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

/-- Construct the inverse for a function `f` on domain `s`. This function is a right inverse of `f`
on `f '' s`. For a computable version, see `function.injective.inv_of_mem_range`. -/
noncomputable def inv_fun_on (f : α → β) (s : set α) (b : β) : α :=
if h : ∃a, a ∈ s ∧ f a = b then classical.some h else classical.choice ‹nonempty α›

theorem inv_fun_on_pos (h : ∃a∈s, f a = b) : inv_fun_on f s b ∈ s ∧ f (inv_fun_on f s b) = b :=
by rw [bex_def] at h; rw [inv_fun_on, dif_pos h]; exact classical.some_spec h

theorem inv_fun_on_mem (h : ∃a∈s, f a = b) : inv_fun_on f s b ∈ s := (inv_fun_on_pos h).left

theorem inv_fun_on_eq (h : ∃a∈s, f a = b) : f (inv_fun_on f s b) = b := (inv_fun_on_pos h).right

theorem inv_fun_on_neg (h : ¬ ∃a∈s, f a = b) : inv_fun_on f s b = classical.choice ‹nonempty α› :=
by rw [bex_def] at h; rw [inv_fun_on, dif_neg h]

end function

namespace set
open function

variables {s s₁ s₂ : set α} {t : set β} {f : α → β}

theorem inj_on.left_inv_on_inv_fun_on [nonempty α] (h : inj_on f s) :
  left_inv_on (inv_fun_on f s) f s :=
λ a ha, have ∃a'∈s, f a' = f a, from ⟨a, ha, rfl⟩,
  h (inv_fun_on_mem this) ha (inv_fun_on_eq this)

lemma inj_on.inv_fun_on_image [nonempty α] (h : inj_on f s₂) (ht : s₁ ⊆ s₂) :
  (inv_fun_on f s₂) '' (f '' s₁) = s₁ :=
h.left_inv_on_inv_fun_on.image_image' ht

theorem surj_on.right_inv_on_inv_fun_on [nonempty α] (h : surj_on f s t) :
  right_inv_on (inv_fun_on f s) f t :=
λ y hy, inv_fun_on_eq $ mem_image_iff_bex.1 $ h hy

theorem bij_on.inv_on_inv_fun_on [nonempty α] (h : bij_on f s t) :
  inv_on (inv_fun_on f s) f s t :=
⟨h.inj_on.left_inv_on_inv_fun_on, h.surj_on.right_inv_on_inv_fun_on⟩

theorem surj_on.inv_on_inv_fun_on [nonempty α] (h : surj_on f s t) :
  inv_on (inv_fun_on f s) f (inv_fun_on f s '' t) t :=
begin
  refine ⟨_, h.right_inv_on_inv_fun_on⟩,
  rintros _ ⟨y, hy, rfl⟩,
  rw [h.right_inv_on_inv_fun_on hy]
end

theorem surj_on.maps_to_inv_fun_on [nonempty α] (h : surj_on f s t) :
  maps_to (inv_fun_on f s) t s :=
λ y hy, mem_preimage.2 $ inv_fun_on_mem $ mem_image_iff_bex.1 $ h hy

theorem surj_on.bij_on_subset [nonempty α] (h : surj_on f s t) :
  bij_on f (inv_fun_on f s '' t) t :=
begin
  refine h.inv_on_inv_fun_on.bij_on _ (maps_to_image _ _),
  rintros _ ⟨y, hy, rfl⟩,
  rwa [h.right_inv_on_inv_fun_on hy]
end

theorem surj_on_iff_exists_bij_on_subset :
  surj_on f s t ↔ ∃ s' ⊆ s, bij_on f s' t :=
begin
  split,
  { rcases eq_empty_or_nonempty t with rfl|ht,
    { exact λ _, ⟨∅, empty_subset _, bij_on_empty f⟩ },
    { assume h,
      haveI : nonempty α := ⟨classical.some (h.comap_nonempty ht)⟩,
      exact ⟨_, h.maps_to_inv_fun_on.image_subset, h.bij_on_subset⟩ }},
  { rintros ⟨s', hs', hfs'⟩,
    exact hfs'.surj_on.mono hs' (subset.refl _) }
end

lemma preimage_inv_fun_of_mem [n : nonempty α] {f : α → β} (hf : injective f) {s : set α}
  (h : classical.choice n ∈ s) : inv_fun f ⁻¹' s = f '' s ∪ (range f)ᶜ :=
begin
  ext x,
  rcases em (x ∈ range f) with ⟨a, rfl⟩|hx,
  { simp [left_inverse_inv_fun hf _, hf.mem_set_image] },
  { simp [mem_preimage, inv_fun_neg hx, h, hx] }
end

lemma preimage_inv_fun_of_not_mem [n : nonempty α] {f : α → β} (hf : injective f)
  {s : set α} (h : classical.choice n ∉ s) : inv_fun f ⁻¹' s = f '' s :=
begin
  ext x,
  rcases em (x ∈ range f) with ⟨a, rfl⟩|hx,
  { rw [mem_preimage, left_inverse_inv_fun hf, hf.mem_set_image] },
  { have : x ∉ f '' s, from λ h', hx (image_subset_range _ _ h'),
    simp only [mem_preimage, inv_fun_neg hx, h, this] },
end

end set

/-! ### Monotone -/

namespace monotone

variables [preorder α] [preorder β] {f : α → β}

protected lemma restrict (h : monotone f) (s : set α) : monotone (s.restrict f) :=
λ x y hxy, h hxy

protected lemma cod_restrict (h : monotone f) {s : set β} (hs : ∀ x, f x ∈ s) :
  monotone (s.cod_restrict f hs) := h

protected lemma range_factorization (h : monotone f) : monotone (set.range_factorization f) := h

end monotone

/-! ### Piecewise defined function -/

namespace set

variables {δ : α → Sort y} (s : set α) (f g : Πi, δ i)

@[simp] lemma piecewise_empty [∀i : α, decidable (i ∈ (∅ : set α))] : piecewise ∅ f g = g :=
by { ext i, simp [piecewise] }

@[simp] lemma piecewise_univ [∀i : α, decidable (i ∈ (set.univ : set α))] :
  piecewise set.univ f g = f :=
by { ext i, simp [piecewise] }

@[simp] lemma piecewise_insert_self {j : α} [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g j = f j :=
by simp [piecewise]

variable [∀j, decidable (j ∈ s)]

instance compl.decidable_mem (j : α) : decidable (j ∈ sᶜ) := not.decidable

lemma piecewise_insert [decidable_eq α] (j : α) [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g = function.update (s.piecewise f g) j (f j) :=
begin
  simp [piecewise],
  ext i,
  by_cases h : i = j,
  { rw h, simp },
  { by_cases h' : i ∈ s; simp [h, h'] }
end

@[simp, priority 990]
lemma piecewise_eq_of_mem {i : α} (hi : i ∈ s) : s.piecewise f g i = f i := if_pos hi

@[simp, priority 990]
lemma piecewise_eq_of_not_mem {i : α} (hi : i ∉ s) : s.piecewise f g i = g i := if_neg hi

lemma piecewise_singleton (x : α) [Π y, decidable (y ∈ ({x} : set α))] [decidable_eq α]
  (f g : α → β) : piecewise {x} f g = function.update g x (f x) :=
by { ext y, by_cases hy : y = x, { subst y, simp }, { simp [hy] } }

lemma piecewise_eq_on (f g : α → β) : eq_on (s.piecewise f g) f s :=
λ _, piecewise_eq_of_mem _ _ _

lemma piecewise_eq_on_compl (f g : α → β) : eq_on (s.piecewise f g) g sᶜ :=
λ _, piecewise_eq_of_not_mem _ _ _

lemma piecewise_le {δ : α → Type*} [Π i, preorder (δ i)] {s : set α} [Π j, decidable (j ∈ s)]
  {f₁ f₂ g : Π i, δ i} (h₁ : ∀ i ∈ s, f₁ i ≤ g i) (h₂ : ∀ i ∉ s, f₂ i ≤ g i) :
  s.piecewise f₁ f₂ ≤ g :=
λ i, if h : i ∈ s then by simp * else by simp *

lemma le_piecewise {δ : α → Type*} [Π i, preorder (δ i)] {s : set α} [Π j, decidable (j ∈ s)]
  {f₁ f₂ g : Π i, δ i} (h₁ : ∀ i ∈ s, g i ≤ f₁ i) (h₂ : ∀ i ∉ s, g i ≤ f₂ i) :
  g ≤ s.piecewise f₁ f₂ :=
@piecewise_le α (λ i, order_dual (δ i)) _ s _ _ _ _ h₁ h₂

lemma piecewise_le_piecewise {δ : α → Type*} [Π i, preorder (δ i)] {s : set α}
  [Π j, decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : Π i, δ i} (h₁ : ∀ i ∈ s, f₁ i ≤ g₁ i)
  (h₂ : ∀ i ∉ s, f₂ i ≤ g₂ i) :
  s.piecewise f₁ f₂ ≤ s.piecewise g₁ g₂ :=
by apply piecewise_le; intros; simp *

@[simp, priority 990]
lemma piecewise_insert_of_ne {i j : α} (h : i ≠ j) [∀i, decidable (i ∈ insert j s)] :
  (insert j s).piecewise f g i = s.piecewise f g i :=
by simp [piecewise, h]

@[simp] lemma piecewise_compl [∀ i, decidable (i ∈ sᶜ)] : sᶜ.piecewise f g = s.piecewise g f :=
funext $ λ x, if hx : x ∈ s then by simp [hx] else by simp [hx]

@[simp] lemma piecewise_range_comp {ι : Sort*} (f : ι → α) [Π j, decidable (j ∈ range f)]
  (g₁ g₂ : α → β) :
  (range f).piecewise g₁ g₂ ∘ f = g₁ ∘ f :=
comp_eq_of_eq_on_range $ piecewise_eq_on _ _ _

theorem maps_to.piecewise_ite {s s₁ s₂ : set α} {t t₁ t₂ : set β} {f₁ f₂ : α → β}
  [∀ i, decidable (i ∈ s)]
  (h₁ : maps_to f₁ (s₁ ∩ s) (t₁ ∩ t)) (h₂ : maps_to f₂ (s₂ ∩ sᶜ) (t₂ ∩ tᶜ)) :
  maps_to (s.piecewise f₁ f₂) (s.ite s₁ s₂) (t.ite t₁ t₂) :=
begin
  refine (h₁.congr _).union_union (h₂.congr _),
  exacts [(piecewise_eq_on s f₁ f₂).symm.mono (inter_subset_right _ _),
    (piecewise_eq_on_compl s f₁ f₂).symm.mono (inter_subset_right _ _)]
end

theorem eq_on_piecewise {f f' g : α → β} {t} :
  eq_on (s.piecewise f f') g t ↔ eq_on f g (t ∩ s) ∧ eq_on f' g (t ∩ sᶜ) :=
begin
  simp only [eq_on, ← forall_and_distrib],
  refine forall_congr (λ a, _), by_cases a ∈ s; simp *
end

theorem eq_on.piecewise_ite' {f f' g : α → β} {t t'} (h : eq_on f g (t ∩ s))
  (h' : eq_on f' g (t' ∩ sᶜ)) :
  eq_on (s.piecewise f f') g (s.ite t t') :=
by simp [eq_on_piecewise, *]

lemma piecewise_preimage (f g : α → β) (t) :
  s.piecewise f g ⁻¹' t = s.ite (f ⁻¹' t) (g ⁻¹' t) :=
ext $ λ x, by by_cases x ∈ s; simp [*, set.ite]

lemma apply_piecewise {δ' : α → Sort*} (h : Π i, δ i → δ' i) {x : α} :
  h x (s.piecewise f g x) = s.piecewise (λ x, h x (f x)) (λ x, h x (g x)) x :=
by by_cases hx : x ∈ s; simp [hx]

lemma apply_piecewise₂ {δ' δ'' : α → Sort*} (f' g' : Π i, δ' i) (h : Π i, δ i → δ' i → δ'' i)
  {x : α} :
  h x (s.piecewise f g x) (s.piecewise f' g' x) =
    s.piecewise (λ x, h x (f x) (f' x)) (λ x, h x (g x) (g' x)) x :=
by by_cases hx : x ∈ s; simp [hx]

lemma piecewise_op {δ' : α → Sort*} (h : Π i, δ i → δ' i) :
  s.piecewise (λ x, h x (f x)) (λ x, h x (g x)) = λ x, h x (s.piecewise f g x) :=
funext $ λ x, (apply_piecewise _ _ _ _).symm

lemma piecewise_op₂ {δ' δ'' : α → Sort*} (f' g' : Π i, δ' i) (h : Π i, δ i → δ' i → δ'' i) :
  s.piecewise (λ x, h x (f x) (f' x)) (λ x, h x (g x) (g' x)) =
    λ x, h x (s.piecewise f g x) (s.piecewise f' g' x) :=
funext $ λ x, (apply_piecewise₂ _ _ _ _ _ _).symm

@[simp] lemma piecewise_same : s.piecewise f f = f :=
by { ext x, by_cases hx : x ∈ s; simp [hx] }

lemma range_piecewise (f g : α → β) : range (s.piecewise f g) = f '' s ∪ g '' sᶜ :=
begin
  ext y, split,
  { rintro ⟨x, rfl⟩, by_cases h : x ∈ s;[left, right]; use x; simp [h] },
  { rintro (⟨x, hx, rfl⟩|⟨x, hx, rfl⟩); use x; simp * at * }
end

lemma injective_piecewise_iff {f g : α → β} :
  injective (s.piecewise f g) ↔ inj_on f s ∧ inj_on g sᶜ ∧ (∀ (x ∈ s) (y ∉ s), f x ≠ g y) :=
begin
  rw [injective_iff_inj_on_univ, ← union_compl_self s, inj_on_union (@disjoint_compl_right _ s _),
    (piecewise_eq_on s f g).inj_on_iff, (piecewise_eq_on_compl s f g).inj_on_iff],
  refine and_congr iff.rfl (and_congr iff.rfl $ forall₄_congr $ λ x hx y hy, _),
  rw [piecewise_eq_of_mem s f g hx, piecewise_eq_of_not_mem s f g hy]
end

lemma piecewise_mem_pi {δ : α → Type*} {t : set α} {t' : Π i, set (δ i)}
  {f g} (hf : f ∈ pi t t') (hg : g ∈ pi t t') :
  s.piecewise f g ∈ pi t t' :=
by { intros i ht, by_cases hs : i ∈ s; simp [hf i ht, hg i ht, hs] }

@[simp] lemma pi_piecewise {ι : Type*} {α : ι → Type*} (s s' : set ι)
  (t t' : Π i, set (α i)) [Π x, decidable (x ∈ s')] :
  pi s (s'.piecewise t t') = pi (s ∩ s') t ∩ pi (s \ s') t' :=
begin
  ext x,
  simp only [mem_pi, mem_inter_eq, ← forall_and_distrib],
  refine forall_congr (λ i, _),
  by_cases hi : i ∈ s'; simp *
end

lemma univ_pi_piecewise {ι : Type*} {α : ι → Type*} (s : set ι)
  (t : Π i, set (α i)) [Π x, decidable (x ∈ s)] :
  pi univ (s.piecewise t (λ _, univ)) = pi s t :=
by simp

end set

lemma strict_mono_on.inj_on [linear_order α] [preorder β] {f : α → β} {s : set α}
  (H : strict_mono_on f s) :
  s.inj_on f :=
λ x hx y hy hxy, show ordering.eq.compares x y, from (H.compares hx hy).1 hxy

lemma strict_anti_on.inj_on [linear_order α] [preorder β] {f : α → β} {s : set α}
  (H : strict_anti_on f s) :
  s.inj_on f :=
@strict_mono_on.inj_on α (order_dual β) _ _ f s H

lemma strict_mono_on.comp [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_mono_on g t)
  (hf : strict_mono_on f s) (hs : set.maps_to f s t) :
  strict_mono_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hx) (hs hy) $ hf hx hy hxy

lemma strict_mono_on.comp_strict_anti_on [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_mono_on g t)
  (hf : strict_anti_on f s) (hs : set.maps_to f s t) :
  strict_anti_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hy) (hs hx) $ hf hx hy hxy

lemma strict_anti_on.comp [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_anti_on g t)
  (hf : strict_anti_on f s) (hs : set.maps_to f s t) :
  strict_mono_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hy) (hs hx) $ hf hx hy hxy

lemma strict_anti_on.comp_strict_mono_on [preorder α] [preorder β] [preorder γ]
  {g : β → γ} {f : α → β} {s : set α} {t : set β} (hg : strict_anti_on g t)
  (hf : strict_mono_on f s) (hs : set.maps_to f s t) :
  strict_anti_on (g ∘ f) s :=
λ x hx y hy hxy, hg (hs hx) (hs hy) $ hf hx hy hxy

lemma strict_mono.cod_restrict [preorder α] [preorder β] {f : α → β} (hf : strict_mono f)
  {s : set β} (hs : ∀ x, f x ∈ s) :
  strict_mono (set.cod_restrict f s hs) :=
hf

namespace function

open set

variables {fa : α → α} {fb : β → β} {f : α → β} {g : β → γ} {s t : set α}

lemma injective.comp_inj_on (hg : injective g) (hf : s.inj_on f) : s.inj_on (g ∘ f) :=
(hg.inj_on univ).comp hf (maps_to_univ _ _)

lemma surjective.surj_on (hf : surjective f) (s : set β) :
  surj_on f univ s :=
(surjective_iff_surj_on_univ.1 hf).mono (subset.refl _) (subset_univ _)

lemma left_inverse.left_inv_on {g : β → α} (h : left_inverse f g) (s : set β) :
  left_inv_on f g s :=
λ x hx, h x

lemma right_inverse.right_inv_on {g : β → α} (h : right_inverse f g) (s : set α) :
  right_inv_on f g s :=
λ x hx, h x

lemma left_inverse.right_inv_on_range {g : β → α} (h : left_inverse f g) :
  right_inv_on f g (range g) :=
forall_range_iff.2 $ λ i, congr_arg g (h i)

namespace semiconj

lemma maps_to_image (h : semiconj f fa fb) (ha : maps_to fa s t) :
  maps_to fb (f '' s) (f '' t) :=
λ y ⟨x, hx, hy⟩, hy ▸ ⟨fa x, ha hx, h x⟩

lemma maps_to_range (h : semiconj f fa fb) : maps_to fb (range f) (range f) :=
λ y ⟨x, hy⟩, hy ▸ ⟨fa x, h x⟩

lemma surj_on_image (h : semiconj f fa fb) (ha : surj_on fa s t) :
  surj_on fb (f '' s) (f '' t) :=
begin
  rintros y ⟨x, hxt, rfl⟩,
  rcases ha hxt with ⟨x, hxs, rfl⟩,
  rw [h x],
  exact mem_image_of_mem _ (mem_image_of_mem _ hxs)
end

lemma surj_on_range (h : semiconj f fa fb) (ha : surjective fa) :
  surj_on fb (range f) (range f) :=
by { rw ← image_univ, exact h.surj_on_image (ha.surj_on univ) }

lemma inj_on_image (h : semiconj f fa fb) (ha : inj_on fa s) (hf : inj_on f (fa '' s)) :
  inj_on fb (f '' s) :=
begin
  rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ H,
  simp only [← h.eq] at H,
  exact congr_arg f (ha hx hy $ hf (mem_image_of_mem fa hx) (mem_image_of_mem fa hy) H)
end

lemma inj_on_range (h : semiconj f fa fb) (ha : injective fa) (hf : inj_on f (range fa)) :
  inj_on fb (range f) :=
by { rw ← image_univ at *, exact h.inj_on_image (ha.inj_on univ) hf }

lemma bij_on_image (h : semiconj f fa fb) (ha : bij_on fa s t) (hf : inj_on f t) :
  bij_on fb (f '' s) (f '' t) :=
⟨h.maps_to_image ha.maps_to, h.inj_on_image ha.inj_on (ha.image_eq.symm ▸ hf),
  h.surj_on_image ha.surj_on⟩

lemma bij_on_range (h : semiconj f fa fb) (ha : bijective fa) (hf : injective f) :
  bij_on fb (range f) (range f) :=
begin
  rw [← image_univ],
  exact h.bij_on_image (bijective_iff_bij_on_univ.1 ha) (hf.inj_on univ)
end

lemma maps_to_preimage (h : semiconj f fa fb) {s t : set β} (hb : maps_to fb s t) :
  maps_to fa (f ⁻¹' s) (f ⁻¹' t) :=
λ x hx, by simp only [mem_preimage, h x, hb hx]

lemma inj_on_preimage (h : semiconj f fa fb) {s : set β} (hb : inj_on fb s)
  (hf : inj_on f (f ⁻¹' s)) :
  inj_on fa (f ⁻¹' s) :=
begin
  intros x hx y hy H,
  have := congr_arg f H,
  rw [h.eq, h.eq] at this,
  exact hf hx hy (hb hx hy this)
end

end semiconj

lemma update_comp_eq_of_not_mem_range' {α β : Sort*} {γ : β → Sort*} [decidable_eq β]
  (g : Π b, γ b) {f : α → β} {i : β} (a : γ i) (h : i ∉ set.range f) :
  (λ j, (function.update g i a) (f j)) = (λ j, g (f j)) :=
update_comp_eq_of_forall_ne' _ _ $ λ x hx, h ⟨x, hx⟩

/-- Non-dependent version of `function.update_comp_eq_of_not_mem_range'` -/
lemma update_comp_eq_of_not_mem_range {α β γ : Sort*} [decidable_eq β]
  (g : β → γ) {f : α → β} {i : β} (a : γ) (h : i ∉ set.range f) :
  (function.update g i a) ∘ f = g ∘ f :=
update_comp_eq_of_not_mem_range' g a h

lemma insert_inj_on (s : set α) : sᶜ.inj_on (λ a, insert a s) := λ a ha b _, (insert_inj ha).1

end function


/- Entering Tactic Mode -/

namespace etm
  theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
    apply And.intro
    exact hp
    apply And.intro
    exact hq
    exact hp

  #print test

  theorem test1 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
    apply And.intro hp; apply And.intro hq hp

  #print test1

  theorem test2 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
    apply And.intro
    case right =>
      apply And.intro
      exact hq
      exact hp
    case left => exact hp

  theorem test3 (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
    apply And.intro
    . exact hp
    . apply And.intro
      . exact hq
      . exact hp
end etm

/- Basic Tactics -/

namespace basic
  example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
    apply Iff.intro
    . intro h
      apply Or.elim (h.right)
      . intro hq
        exact Or.inl (And.intro h.left hq)
      . intro hr
        exact Or.inr (And.intro h.left hr)
    . intro h
      apply Or.elim h
      . intro hpq
        exact And.intro hpq.left (Or.inl hpq.right)
      . intro hpr
        exact And.intro hpr.left (Or.inr hpr.right)

  example (α : Type) : ∀ x : α, x = x := by
    intro a
    exact rfl

  example : ∀ a b c : Nat, a = b → a = c → b = c := by
    intro a b c h1 h2
    exact h1.symm.trans h2

  example (α : Type) (p q : α → Prop) : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x := by
    intro (Exists.intro w h)
    exact Exists.intro w (And.intro h.right h.left)

  example (α : Type) (p q : α → Prop) : (∃ x, p x ∨ q x) → ∃ x, q x ∨ p x := by
    intro
    | (Exists.intro w (Or.inl hp)) => exact (Exists.intro w (Or.inr hp))
    | (Exists.intro w (Or.inr hq)) => exact (Exists.intro w (Or.inl hq))

  example (x y z w : Nat) (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w := by
    apply Eq.trans h₁
    apply Eq.trans h₂
    assumption

  example (x y z w : Nat) (h₁ : x = y) (h₂ : y = z) (h₃ : z = w) : x = w := by
    apply Eq.trans
    assumption
    apply Eq.trans
    assumption
    assumption

  example : ∀ a b c : Nat, a = b → a = c → c = b := by
    intros
    apply Eq.trans
    apply Eq.symm
    assumption
    assumption

  example : ∀ a b c : Nat, a = b → a = c → c = b := by unhygienic
    intros
    apply Eq.trans
    apply Eq.symm
    exact a_2
    exact a_1

  example : ∀ a b c : Nat, a = b → a = c → c = b := by
    intros
    apply Eq.trans
    apply Eq.symm
    repeat assumption

  example (x : Nat) : x = x := by
    revert x -- ∀ x, x = x
    intro y -- y = y
    rfl

  example (x y : Nat) (h : x = y) : y = x := by
    revert h  -- x = y → y = x
    intro h1 -- y = x
    apply Eq.symm
    assumption

  example (x y : Nat) (h : x = y) : y = x := by
    revert x y -- x = y → y = x
    intros
    apply Eq.symm
    assumption

  example : 3 = 3 := by
    generalize 3 = x  -- x = x
    revert x  -- ∀ x, x = x
    intro y -- y = y
    rfl

  example : 2 + 3 = 5 := by
    generalize h : 3 = x  -- 2 + x = 5
    rw [←h]

end basic

/- More Tactics -/

namespace more_t

  example (p q : Prop) : p ∨ q → q ∨ p := by
    intro h
    cases h with
    | inl hp => exact Or.inr hp
    | inr hq => exact Or.inl hq

  example (p : Prop) : p ∨ p → p := by
    intro h
    cases h
    repeat assumption

  example (p : Prop) : p ∨ p → p := by
    intro h
    cases h <;> assumption

  example (p q : Prop) : p ∨ q → q ∨ p := by
    intro h
    cases h
    . apply Or.inr
      assumption
    . apply Or.inl
      assumption

  example (p q : Prop) : p ∧ q → q ∧ p := by
    intro h
    cases h with
    | intro hp hq => constructor; exact hq; exact hp

  example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
    apply Iff.intro
    . intro h
      cases h with
      | intro hp hqr =>
        cases hqr
        . apply Or.inl; constructor <;> assumption
        . apply Or.inr; constructor <;> assumption
    . intro h
      cases h with
      | inl hpq =>
        cases hpq with
        | intro hp hq => constructor; exact hp; apply Or.inl; exact hq
      | inr hpr =>
        cases hpr with
        | intro hp hr => constructor; exact hp; apply Or.inr; exact hr

  example (p q : Nat → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x := by
    intro h
    cases h with
    | intro x px => constructor; apply Or.inl; exact px

  def swap_pair : α × β → β × α := by
    intro p
    cases p
    constructor <;> assumption

  example (P : Nat → Prop) (h0 : P 0) (h1 : ∀ n, P (Nat.succ n)) (m : Nat) : P m := by
    cases m with
    | zero => exact h0
    | succ m' => exact h1 m'

  example (p q : Prop) : p ∧ ¬ p → q := by
    intro h
    cases h
    contradiction

end more_t

/- Structuring Tactic Proofs -/

namespace struc

  example (n : Nat) : n + 1 = n.succ := by
    show n.succ = n.succ
    rfl

  example : ∃ x, x + 2 = 8 := by
    let a : Nat := 6
    exists a
    rfl

  /-
  apply foo
  . <proof of first goal>
  . <proof of second goal>
  . <proof of third goal>
  . <proof of final goal>

  apply foo
  case <tag of first goal>  => <proof of first goal>
  case <tag of second goal> => <proof of second goal>
  case <tag of third goal>  => <proof of third goal>
  case <tag of final goal>  => <proof of final goal>

  apply foo
  { <proof of first goal>  }
  { <proof of second goal> }
  { <proof of third goal>  }
  { <proof of final goal>  }

  -/
end struc

/- Tactic Combinators -/

namespace tacomb

  example (p q : Prop) (hp : p) (hq : q) : p ∧ q := by
    constructor <;> assumption

  example (p q r : Prop) (hr : r) : p ∨ q ∨ r := by
    repeat (first | apply Or.inl; assumption | apply Or.inr | assumption)

  example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r := by
    constructor <;> (try constructor) <;> assumption

  example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r := by
    constructor
    all_goals (try constructor)
    all_goals assumption

  example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r := by
    constructor
    any_goals constructor
    all_goals assumption

  example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
      p ∧ ((p ∧ q) ∧ r) ∧ (q ∧ r ∧ p) := by
    repeat (any_goals constructor)
    all_goals assumption

  example (p q r : Prop) (hp : p) (hq : q) (hr : r) :
      p ∧ ((p ∧ q) ∧ r) ∧ (q ∧ r ∧ p) := by
    repeat (first | constructor | assumption)
end tacomb

/- Rewriting -/

namespace rew

  example (f : Nat → Nat) (h1 : f 0 = 0) (h2 : k = 0) : f k = 0 := by
    rw [h2, h1]

  example (x y : Nat) (p : Nat → Prop) (q : Prop) (h : q → x = y)
        (h' : p y) (hq : q) : p x := by
    rw [h hq]; assumption

  example (f : Nat → Nat) (a : Nat) (h : a + 0 = 0) : f a = f 0 := by
    rw [Nat.add_zero] at h
    rw [h]

  def Tuple (α : Type) (n : Nat) :=
    { as : List α // as.length = n }

  example (n : Nat) (h : n = 0) (t : Tuple α n) : Tuple α 0 := by
    rw [h] at t
    assumption

end rew

/- Using simplifier -/

namespace usimp

  example (x y z : Nat) (p : Nat → Prop) (h : p (x * y))
        : p ((x + 0) * (0 + y * 1 + z * 0)) := by
    simp; assumption

  example (xs : List Nat) : List.reverse (xs ++ [1, 2, 3]) = [3, 2, 1] ++ List.reverse xs := by
    simp

  example (x y z : Nat) (p : Nat → Prop)
        (h : p ((x + 0) * (0 + y * 1 + z * 0))) : p (x * y) := by
    simp at h; assumption

  attribute [local simp] Nat.mul_comm Nat.mul_assoc Nat.mul_left_comm
  attribute [local simp] Nat.add_assoc Nat.add_comm Nat.add_left_comm

  example (x y z : Nat) (p : Nat → Prop)
        (h₁ : p (1 * x + y)) (h₂ : p  (x * z * 1))
        : p (y + 0 + x) ∧ p (z * x) := by
    simp at *; constructor <;> assumption

  def f (m n : Nat) : Nat := m + n + m

  example {m n : Nat} (h : 0 = m) : (f m n) = n := by
    simp [f, ←h]

  example (f : Nat → Nat) (k : Nat) (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 := by
    simp [*]

  example (p q : Prop) (hp : p) : p ∧ q ↔ q := by
    simp [*]

  example (u w x x' y y' z : Nat)
        (h₁ : x + 0 = x') (h₂ : y + 0 = y')
        : x + y + 0 = x' + y' := by
    simp at *
    simp [*]

  def mk_symm (xs : List α) := xs ++ xs.reverse

  @[simp] theorem reverse_mk_symm (xs : List α)
        : (mk_symm xs).reverse = mk_symm xs := by
    simp [mk_symm]

  example (xs ys : List α)
        : (xs ++ mk_symm ys).reverse = mk_symm ys ++ xs.reverse := by
    simp

  example : if x = 0 then x + y = y else x ≠ 0 := by
    simp (config := {contextual := true})

  example : ∀ (x : Nat) (h : x = 0), y + x = y := by
    simp (config := {contextual := true})

  example : 0 < x + 1 ∧ x + y + 2 ≥ y + 1 := by
    simp_arith

end usimp

/- Split -/

namespace split_t
  def f (x y z : Nat) :=
    match x, y , z with
    | 5, _, _ => y
    | _, 5, _ => y
    | _, _, 5 => y
    | _, _, _ => 1

  example (x y z : Nat) : x ≠ 5 → y ≠ 5 → z ≠ 5 → z = w → f x y w = 1 := by
    intros
    simp [f]
    split
    . contradiction
    . contradiction
    . contradiction
    . rfl

  example (x y z : Nat) : x ≠ 5 → y ≠ 5 → z ≠ 5 → z = w → f x y w = 1 := by
    intros
    simp [f]
    split
    <;> first | contradiction | rfl
end split_t

/- Extensible Tactics -/

namespace ext
  -- Define notation
  syntax "triv" : tactic

  macro_rules
  | `(tactic| triv) => `(tactic| assumption)

  macro_rules
  | `(tactic| triv) => `(tactic| rfl)

  example (hp : p) : p := by
    triv

  example (x : α) : x = x := by
    triv

  example (x : α) (h : p) : x = x ∧ p := by
    apply And.intro <;> triv

  macro_rules
  | `(tactic| triv) => `(tactic| apply And.intro <;> triv)

  example (x : α) (h : p) : x = x ∧ p := by
    triv

end ext


/- Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------
# Morphisms of Functors: Natural Transformations
😺 🐈 😼 🐈⬛ 😸 🐈 🙀 😻 🐈 😹
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import lectures.lec17_functors
import tactic.basic

open category_str

/-!
## Natural transformations

Consider the collection of functors from category `𝓒` to category `𝓓`. This collection is prima facie a type. But we shall give it the structure of a category whose objects are functors `𝓒 → 𝓓` and whose morphisms are what we call __natural transformations__ between functors. To talk about the natural transformations, we just write `F ⟶ G` using the usual "morphism" arrow.

So, what is a naturan transformation?

A __natural transformation__ `α : nat_trans F G` consists of morphisms `α.app X : F.obj X ⟶ G.obj X`,
and the naturality squares `α.naturality f : F.map f ≫ α.app Y = α.app X ≫ G.map f`, where `f : X ⟶ Y`.

F.obj X ---> F.obj Y
  |             |
  |             |
  |             |
  v             v
G.obj X ---> G.obj Y

or even more informally,

F X ----> F Y
 |         |
 |         |
 v         v
G X ----> G Y

-/

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

universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

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

@[ext]
structure nat_trans (F G : 𝓒 ⥤ 𝓓) : Type (max u₁ v₂) :=
(cmpt : Π X : 𝓒, F.obj X ⟶ G.obj X) -- "cmp" short for "component"
(naturality' : ∀ ⦃X Y : 𝓒⦄ (f : X ⟶ Y), cmpt Y ⊚ (F.mor f) = (G.mor f)  ⊚ cmpt X . obviously) -- the naturality condition which says the square above commutes

#check nat_trans
#check @nat_trans

#check nat_trans.cmpt

restate_axiom nat_trans.naturality'

/-
Note that we make `nat_trans.naturality` a simp lemma, with the preferred simp normal form pushing components of natural transformations to the left.
-/

attribute [simp] nat_trans.naturality

section test --testing our definition and notation
variables
variables F G : 𝓒 ⥤ 𝓓 -- `F` and `G` are functors
#check F.obj  -- our informal notation for this was `F₀`
#check F.mor  -- our informal notation for this was `F₁`

variables {X Y Z : 𝓒}
variable f : X ⟶ Y
variable g : Y ⟶ Z

#check (F.mor f : F.obj X ⟶ F.obj Y)
#check  (G.mor f : G.obj X ⟶ G.obj Y)

variable θ : nat_trans F G

#check (θ.cmpt : Π (X : 𝓒), F.obj X ⟶ G.obj X)

#check (θ.cmpt X : F.obj X ⟶ G.obj X) --the component of natural transformation `θ` at object `X` . If `θ : F ⟶ G`, then `θ.cmpt X` is the component at `X`, i.e. a morphism `F.obj X ⟶ G.obj X`.

#check (θ.cmpt Y : F.obj Y ⟶ G.obj Y) --the component of natural transformation `θ` at object `Y`,

#check θ.naturality

/-              F.mor f
          F X ---------> F Y
          |               |
 θ.cmpt X |               | θ.cmpt Y
          v               v
          G X ---------> G Y
                 G.mor f
-/

example :
  (θ.cmpt Y) ⊚ (F.mor f) = (G.mor f) ⊚ (θ.cmpt X) :=
begin
  rw [θ.naturality],
end

end test

namespace nat_trans

/- Let's prove that if two natural transforamtions are equal then all of their components are equal. -/

lemma congr_cmpt {F G : 𝓒 ⥤ 𝓓} {α β : nat_trans F G} (h : α = β) (X : 𝓒) :
  α.cmpt X = β.cmpt X :=
begin
 have h₁ :  α.cmpt = β.cmpt , from congr_arg nat_trans.cmpt h,
 apply congr_fun h₁,
end

/- The __identity__ natural transformation on a functor `
`F`. -/

def id (F : 𝓒 ⥤ 𝓓) : nat_trans F F :=
{
  cmpt := λ X, 𝟙 (F.obj X),
  naturality' := by {
                      intros X Y f,
                      simp only [id_comp, comp_id],
                    },
}

#check nat_trans.id

@[simp]
lemma id_cmpt {F: 𝓒 ⥤ 𝓓} (X : 𝓒) :
  (nat_trans.id F).cmpt X = 𝟙 (F.obj X) :=
begin
  refl,
end

/-! ## Composition of Natural Transformations

Natural transformations have two kinds of compositions:

1. The vertical composition, and
2. The horizontal composition

The vertical composition is easier to describe, so we start from that.
-/

/-! ### Vertical Composition of Natural Transformations

Given functors `F G : 𝓒 ⥤ 𝓓` and natural transformations
`α : nat_trans F G ` and  `β : nat_trans G H`, for any object `X` in category `𝓒` we obtain the comutative diagram

F X ----> F Y
 |         |
 |         |
 v         v
G X ----> G Y
 |         |
 |         |
 v         v
H X ----> H Y

The vertical composition of `α` and `β` has at its `X` components the composite morphism `(β.cmpt X) ⊚ (α.cmpt X)`.
-/

/-- `vcomp α β` is the __vertical__ compositions of natural transformations. -/

variables {F G H : 𝓒 ⥤ 𝓓}

-- def vcomp (α : nat_trans F G) (β : nat_trans G H) : nat_trans F H :=
-- { cmpt := λ X, (β.cmpt X) ⊚ (α.cmpt X), -- composition of morphisms in 𝓓
--   naturality' := by {intros X Y f, simp, } }

@[simp]
def vcomp (α : nat_trans F G) (β : nat_trans G H) : nat_trans F H :=
{
  cmpt := λ X, (β.cmpt X) ⊚ (α.cmpt X),
  naturality' := by { intros X Y f,
                      rw category_str.comp_assoc,
                      simp only [α.naturality],
                      rw ← category_str.comp_assoc,
                      simp only [β.naturality],
                      rw category_str.comp_assoc,
                      } ,
}

#check vcomp

--@[simp]
lemma vcomp_cmpt (α : nat_trans F G) (β : nat_trans G H) (X : 𝓒) :
  (vcomp α β).cmpt X = (β.cmpt X) ⊚ (α.cmpt X)  :=
begin
  refl,
end

/- Challenge: prove that that the naturality square of `g ⊚ f` is derived from the naturality square of `f` and `g`.

   F(f)      F(g)
F X ----> F Y ----> F Z
 |         |         |
 | α(X)    | α(Y)    | α(U)
 v         v         v
G X ----> G Y ----> G Z
    G(f)      G(g)
-/

/-
As a simple exercise let's prove that if we vertically compose any natural transformation `θ` with `nat_trans.id`, we get `θ`.
-/

/-
- Functions are the way we map one type into another.
For types `X Y : Type` we have the type `X → Y` of functions from `X` to `Y`

- Functors are the way we map one category into another.
For categories `𝓒 𝓓` we construct a category structures on functors `𝓒 ⥤ 𝓓`. We call this the __functor category__ of `𝓒` and `𝓓`.

`functor_cat 𝓒 𝓓` gives the category structure on functors and natural transformations
between categories `𝓒` and `D`.

Notice that if `𝓒` and `𝓓` are both small categories at the same universe level, this is another small category at that level.

However if `𝓒` and `𝓓` are both large categories at the same universe level,
this is a small category at the next higher level.
-/

#check 𝓒 ⥤ 𝓓

instance functor.cat : category_str.{(max u₁ v₂)} (𝓒 ⥤ 𝓓) :=
{
  hom     := λ F G, nat_trans F G,
  id      := λ F, nat_trans.id F,
  comp    := λ _ _ _ α β, vcomp α β,
  id_comp' := by {intros F G θ, ext, simp, },
  comp_id' := by {intros F G θ, ext, simp,},
  comp_assoc' := by {intros F G H K α β γ, ext, simp only [vcomp_cmpt], rw [comp_assoc], },
}

/-
Take a functor `F : 𝓒 ⥤ 𝓓`. This is an object of the functor category `𝓒 ⥤ 𝓓`. Therefore, we have an idenity morphism `𝟙 F : F ⟶ F` in the functors category `𝓒 ⥤ 𝓓`. This is the identity natural transformation.
-/

--@[simp]
lemma functor.cat.id_eq_id_trans :
  (𝟙 F : F ⟶ F) = nat_trans.id F :=
begin
  refl,
end

@[simp]
lemma functor.cat.vcomp_eq_comp (α : F ⟶ G) (β : G ⟶ H) :
  vcomp α β =  β  ⊚ α :=
begin
  refl,  -- by definition of `vcomp` and the category structure on 𝓒 ⥤ 𝓓
end

@[simp]
lemma functor.cat.id_cmpt (F : 𝓒 ⥤ 𝓓) (X : 𝓒) :
  (𝟙 F : F ⟶ F).cmpt X = 𝟙 (F.obj X) := rfl

@[simp] lemma functor.cat.comp_cmpt {F G H : 𝓒 ⥤ 𝓓} (α : F ⟶ G) (β : G ⟶ H) (X : 𝓒) :
  (β ⊚ α).cmpt X = β.cmpt X ⊚ α.cmpt X :=
  --these two compositions happen in different categories. Can you guess where?
begin
  refl, -- by definition
end

#check functor.representable

local notation ` 𝓙 ` : 15 :=  functor.representable
local notation ` c𝓙 ` : 15 :=  functor.corepresentable

@[simp]
lemma corep_obj (X : 𝓒) (Y : 𝓒ᵒᵖ) :
  (c𝓙 X).obj Y =  (unop Y ⟶ X) :=
begin
  refl,
end

@[simp]
lemma corep_mor (X : 𝓒) (Y Z : 𝓒ᵒᵖ) (f : Y ⟶ Z) :
   (c𝓙 X).mor f =  λ g, g ⊚ (hom.unop f) :=
begin
  refl,
end

def ℍom : 𝓒 ⥤ (𝓒ᵒᵖ ⥤ Type v₁) :=
{
  -- the action of ℍom on objects of 𝓒
  obj := λ X, c𝓙 X,
  -- the action of ℍom on morphisms of 𝓒
  mor := λ X Y, λ f, { cmpt := λ W, λ g, f ⊚ g,
                       naturality' :=
                       by {
                             intros U V k,
                             dsimp,
                             funext x,
                             change f ⊚ (x ⊚ (hom.unop k)) = (f ⊚ x) ⊚ (hom.unop k),
                             simp only [comp_assoc],
                          },
                      },
  -- ℍom is functorial, it respects identities and compositions in 𝓒.
  resp_id' := by {intro X, ext Y, simp, refl, },
  resp_comp' := by {
                      intros X Y Z f g,
                      ext U,
                      simp,
                      refl,
                    },
  }

notation ` ≅ ` : 90 := category_str.equiv

def Yoneda (X Y : 𝓒) (α : category_str.equiv (ℍom.obj X)  (ℍom.obj Y) ):
  category_str.equiv X Y :=
{
  to_mor := α.to_mor.cmpt (op X) (𝟙 X),
  inv_mor := α.inv_mor.cmpt (op Y) (𝟙 Y),
  left_inv := sorry,
  right_inv := sorry,
}

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

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

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

#check arrow_type

local notation `𝔸𝕣` : 10 := arrow_type

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

#check arrow_type_hom

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

@[simp]
def arrow_type_hom.comp {𝓒 : Type*}[small_category_str 𝓒] {α β γ : 𝔸𝕣 𝓒 }
(f : arrow_type_hom α β) (g : arrow_type_hom β γ) : arrow_type_hom α γ :=
⟨g.top ⊚ f.top, g.bot ⊚ f.bot, by {rw ← comp_assoc, rw [g.eq, comp_assoc, f.eq, ← comp_assoc],  }⟩

@[simp]
lemma arrow_type_hom.comp.top {𝓒 : Type*}[small_category_str 𝓒] (α β γ : 𝔸𝕣 𝓒 )
(f : arrow_type_hom α β) (g : arrow_type_hom β γ) :
  (arrow_type_hom.comp f g).top = g.top ⊚ f.top :=
begin
  refl,
end

-- @[simp]
-- lemma arrow_type_hom.top {𝓒 : Type*}[small_category_str 𝓒] (α β γ : 𝔸𝕣 𝓒 ) (f : α ⟶ β) (g : β ⟶ γ) :
-- (g ⊚ f).top = g.top ⊚ f.top :=

instance arrow_cat (𝓒 : Type*)[small_category_str 𝓒] : small_category_str (𝔸𝕣 𝓒) :=
{
  hom := λ α, λ β, arrow_type_hom α β ,
  id := λ α, ⟨𝟙 α.dom, 𝟙 α.cod, by {simp,}⟩ ,
  comp := λ α β γ, λ f g, ⟨g.top ⊚ f.top, g.bot ⊚ f.bot, by {rw ← comp_assoc, rw [g.eq, comp_assoc, f.eq, ← comp_assoc],  }⟩ ,
  id_comp' := by {intros α β f, ext; simp, },
  comp_id' := by {intros α β f, ext; simp, },
  comp_assoc' := by {intros α β γ δ f g h, ext, repeat {simp only [comp_assoc]}},
}

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

def Dom (𝓒 : Type*)[small_category_str 𝓒] :
  (𝔸𝕣 𝓒) ⥤ 𝓒 :=
{
  obj := λ α, α.dom,
  mor := λ α β, λ f, f.top,
  resp_id' := by { intro α, refl, },
  resp_comp' := by { intros α β γ f g, refl,  },
}

def Cod (𝓒 : Type*)[small_category_str 𝓒] :
  (𝔸𝕣 𝓒) ⥤ 𝓒 :=
{
  obj := λ α, α.cod,
  mor := λ α β, λ f, f.bot,
  resp_id' := by { intro α, refl, },
  resp_comp' := by { intros α β γ f g, refl,  },
}

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

Therefore, the arrow category classifies natural transformations.
-/

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

open PROOFS.STR
def arrow_cat_classifies_nat_trans {𝓒 𝓓 : Type*}[small_category_str 𝓒] [small_category_str 𝓓] (F G : 𝓒 ⥤ 𝓓) :
fun_equiv (F ⟶ G)  ({ H : 𝓒 ⥤ 𝔸𝕣 𝓓 // ( (Dom 𝓓) ⊚⊚ H = F ) ∧ ((Cod 𝓓) ⊚⊚ H = G) })  :=
{ to_fun := λ θ,
  {
  val := {
            obj := λ X, ⟨F.obj X, G.obj X, θ.cmpt X⟩ ,
            mor := λ X Y f, ⟨ F.mor f, G.mor f,
            θ.naturality' f⟩  ,
            resp_id' := by {intro X, simp, refl, },
            resp_comp' := by {intros X Y Z f g, ext; simp; refl, },
          },
  property := by {
                    split,

                 },
  },
  inv_fun := _,
  left_inv := _,
  right_inv := _ }

-- def arrow_cat_classifies_nat_trans₀ {𝓒 𝓓 : Type*}[small_category_str 𝓒] [small_category_str 𝓓] (H : 𝓒 ⥤ 𝔸𝕣 𝓓)  :
-- nat_trans ((Dom 𝓓) ⊚⊚ H : 𝓒 ⥤ 𝓓) ((Cod 𝓓) ⊚⊚ H : 𝓒 ⥤ 𝓓 ) :=
-- sorry

-- F ⟶ G ≅ {// ( (Dom 𝓓) ⊚⊚ H = F ) ∧ ((Cod 𝓓) ⊚⊚ H = G) }

end nat_trans


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/

/-
Definition of linear constrain clauses.
-/

import tactic.omega.term

namespace omega

/-- (([t₁,...tₘ],[s₁,...,sₙ]) : clause) encodes the constraints
0 = ⟦t₁⟧ ∧ ... ∧ 0 = ⟦tₘ⟧ ∧ 0 ≤ ⟦s₁⟧ ∧ ... ∧ 0 ≤ ⟦sₙ⟧, where
⟦t⟧ is the value of (t : term). -/
@[reducible] def clause := (list term) × (list term)

namespace clause

/-- holds v c := clause c holds under valuation v -/
def holds (v : nat → int) : clause → Prop
| (eqs,les) :=
  ( (∀ t : term, t ∈ eqs → 0 = term.val v t)
    ∧ (∀ t : term, t ∈ les → 0 ≤ term.val v t) )

/-- sat c := there exists a valuation v under which c holds -/
def sat (c : clause) : Prop :=
  ∃ v : nat → int, holds v c

/-- unsat c := there is no valuation v under which c holds -/
def unsat (c : clause) : Prop := ¬ c.sat

/-- append two clauses by elementwise appending -/
def append (c1 c2 : clause) : clause :=
(c1.fst ++ c2.fst, c1.snd ++ c2.snd)

lemma holds_append {v : nat → int} {c1 c2 : clause} :
holds v c1 → holds v c2 → holds v (append c1 c2) :=
begin
  intros h1 h2,
  cases c1 with eqs1 les1,
  cases c2 with eqs2 les2,
  cases h1, cases h2,
  constructor; rw list.forall_mem_append;
  constructor; assumption,
end

end clause

/-- There exists a satisfiable clause c in argument -/
def clauses.sat (cs : list clause) : Prop :=
∃ c ∈ cs, clause.sat c

/-- There is no satisfiable clause c in argument -/
def clauses.unsat (cs : list clause) : Prop := ¬ clauses.sat cs

lemma clauses.unsat_nil : clauses.unsat [] :=
begin intro h1, rcases h1 with ⟨c,h1,h2⟩, cases h1 end

lemma clauses.unsat_cons (c : clause) (cs : list clause) :
  clause.unsat c → clauses.unsat cs →
  clauses.unsat (c::cs) | h1 h2 h3 :=
begin
  unfold clauses.sat at h3,
  rw list.exists_mem_cons_iff at h3,
  cases h3; contradiction,
end

end omega


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.abelian.exact
import category_theory.over

/-!
# Pseudoelements in abelian categories

A *pseudoelement* of an object `X` in an abelian category `C` is an equivalence class of arrows
ending in `X`, where two arrows are considered equivalent if we can find two epimorphisms with a
common domain making a commutative square with the two arrows. While the construction shows that
pseudoelements are actually subobjects of `X` rather than "elements", it is possible to chase these
pseudoelements through commutative diagrams in an abelian category to prove exactness properties.
This is done using some "diagram-chasing metatheorems" proved in this file. In many cases, a proof
in the category of abelian groups can more or less directly be converted into a proof using
pseudoelements.

A classic application of pseudoelements are diagram lemmas like the four lemma or the snake lemma.

Pseudoelements are in some ways weaker than actual elements in a concrete category. The most
important limitation is that there is no extensionality principle: If `f g : X ⟶ Y`, then
`∀ x ∈ X, f x = g x` does not necessarily imply that `f = g` (however, if `f = 0` or `g = 0`,
it does). A corollary of this is that we can not define arrows in abelian categories by dictating
their action on pseudoelements. Thus, a usual style of proofs in abelian categories is this:
First, we construct some morphism using universal properties, and then we use diagram chasing
of pseudoelements to verify that is has some desirable property such as exactness.

It should be noted that the Freyd-Mitchell embedding theorem gives a vastly stronger notion of
pseudoelement (in particular one that gives extensionality). However, this theorem is quite
difficult to prove and probably out of reach for a formal proof for the time being.

## Main results

We define the type of pseudoelements of an object and, in particular, the zero pseudoelement.

We prove that every morphism maps the zero pseudoelement to the zero pseudoelement (`apply_zero`)
and that a zero morphism maps every pseudoelement to the zero pseudoelement (`zero_apply`)

Here are the metatheorems we provide:
* A morphism `f` is zero if and only if it is the zero function on pseudoelements.
* A morphism `f` is an epimorphism if and only if it is surjective on pseudoelements.
* A morphism `f` is a monomorphism if and only if it is injective on pseudoelements
  if and only if `∀ a, f a = 0 → f = 0`.
* A sequence `f, g` of morphisms is exact if and only if
  `∀ a, g (f a) = 0` and `∀ b, g b = 0 → ∃ a, f a = b`.
* If `f` is a morphism and `a, a'` are such that `f a = f a'`, then there is some
  pseudoelement `a''` such that `f a'' = 0` and for every `g` we have
  `g a' = 0 → g a = g a''`. We can think of `a''` as `a - a'`, but don't get too carried away
  by that: pseudoelements of an object do not form an abelian group.

## Notations

We introduce coercions from an object of an abelian category to the set of its pseudoelements
and from a morphism to the function it induces on pseudoelements.

These coercions must be explicitly enabled via local instances:
`local attribute [instance] object_to_sort hom_to_fun`

## Implementation notes

It appears that sometimes the coercion from morphisms to functions does not work, i.e.,
writing `g a` raises a "function expected" error. This error can be fixed by writing
`(g : X ⟶ Y) a`.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

open category_theory
open category_theory.limits
open category_theory.abelian
open category_theory.preadditive

universes v u

namespace category_theory.abelian

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

local attribute [instance] over.coe_from_hom

/-- This is just composition of morphisms in `C`. Another way to express this would be
    `(over.map f).obj a`, but our definition has nicer definitional properties. -/
def app {P Q : C} (f : P ⟶ Q) (a : over P) : over Q :=
a.hom ≫ f

@[simp] lemma app_hom {P Q : C} (f : P ⟶ Q) (a : over P) : (app f a).hom = a.hom ≫ f := rfl

/-- Two arrows `f : X ⟶ P` and `g : Y ⟶ P` are called pseudo-equal if there is some object
    `R` and epimorphisms `p : R ⟶ X` and `q : R ⟶ Y` such that `p ≫ f = q ≫ g`. -/
def pseudo_equal (P : C) (f g : over P) : Prop :=
∃ (R : C) (p : R ⟶ f.1) (q : R ⟶ g.1) [epi p] [epi q], p ≫ f.hom = q ≫ g.hom

lemma pseudo_equal_refl {P : C} : reflexive (pseudo_equal P) :=
λ f, ⟨f.1, 𝟙 f.1, 𝟙 f.1, by apply_instance, by apply_instance, by simp⟩

lemma pseudo_equal_symm {P : C} : symmetric (pseudo_equal P) :=
λ f g ⟨R, p, q, ep, eq, comm⟩, ⟨R, q, p, eq, ep, comm.symm⟩

variables [abelian.{v} C]

section

/-- Pseudoequality is transitive: Just take the pullback. The pullback morphisms will
    be epimorphisms since in an abelian category, pullbacks of epimorphisms are epimorphisms. -/
lemma pseudo_equal_trans {P : C} : transitive (pseudo_equal P) :=
λ f g h ⟨R, p, q, ep, eq, comm⟩ ⟨R', p', q', ep', eq', comm'⟩,
begin
  refine ⟨pullback q p', pullback.fst ≫ p, pullback.snd ≫ q', _, _, _⟩,
  { resetI, exact epi_comp _ _ },
  { resetI, exact epi_comp _ _ },
  { rw [category.assoc, comm, ←category.assoc, pullback.condition,
      category.assoc, comm', category.assoc] }
end

end

/-- The arrows with codomain `P` equipped with the equivalence relation of being pseudo-equal. -/
def pseudoelement.setoid (P : C) : setoid (over P) :=
⟨_, ⟨pseudo_equal_refl, pseudo_equal_symm, pseudo_equal_trans⟩⟩

local attribute [instance] pseudoelement.setoid

/-- A `pseudoelement` of `P` is just an equivalence class of arrows ending in `P` by being
    pseudo-equal. -/
def pseudoelement (P : C) : Type (max u v) := quotient (pseudoelement.setoid P)

namespace pseudoelement

/-- A coercion from an object of an abelian category to its pseudoelements. -/
def object_to_sort : has_coe_to_sort C :=
{ S := Type (max u v),
  coe := λ P, pseudoelement P }

local attribute [instance] object_to_sort

/-- A coercion from an arrow with codomain `P` to its associated pseudoelement. -/
def over_to_sort {P : C} : has_coe (over P) (pseudoelement P) :=
⟨quot.mk (pseudo_equal P)⟩

local attribute [instance] over_to_sort

lemma over_coe_def {P Q : C} (a : Q ⟶ P) : (a : pseudoelement P) = ⟦a⟧ := rfl

/-- If two elements are pseudo-equal, then their composition with a morphism is, too. -/
lemma pseudo_apply_aux {P Q : C} (f : P ⟶ Q) (a b : over P) :
  a ≈ b → app f a ≈ app f b :=
λ ⟨R, p, q, ep, eq, comm⟩,
  ⟨R, p, q, ep, eq, show p ≫ a.hom ≫ f = q ≫ b.hom ≫ f, by rw reassoc_of comm⟩

/-- A morphism `f` induces a function `pseudo_apply f` on pseudoelements. -/
def pseudo_apply {P Q : C} (f : P ⟶ Q) : P → Q :=
quotient.map (λ (g : over P), app f g) (pseudo_apply_aux f)

/-- A coercion from morphisms to functions on pseudoelements -/
def hom_to_fun {P Q : C} : has_coe_to_fun (P ⟶ Q) := ⟨_, pseudo_apply⟩

local attribute [instance] hom_to_fun

lemma pseudo_apply_mk {P Q : C} (f : P ⟶ Q) (a : over P) : f ⟦a⟧ = ⟦a.hom ≫ f⟧ :=
rfl

/-- Applying a pseudoelement to a composition of morphisms is the same as composing
    with each morphism. Sadly, this is not a definitional equality, but at least it is
    true. -/
theorem comp_apply {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) (a : P) : (f ≫ g) a = g (f a) :=
quotient.induction_on a $ λ x, quotient.sound $
by { unfold app, rw [←category.assoc, over.coe_hom] }

/-- Composition of functions on pseudoelements is composition of morphisms. -/
theorem comp_comp {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) : g ∘ f = f ≫ g :=
funext $ λ x, (comp_apply _ _ _).symm

section zero
/-!
In this section we prove that for every `P` there is an equivalence class that contains
precisely all the zero morphisms ending in `P` and use this to define *the* zero
pseudoelement.
-/

section
local attribute [instance] has_binary_biproducts.of_has_binary_products

/-- The arrows pseudo-equal to a zero morphism are precisely the zero morphisms -/
lemma pseudo_zero_aux {P : C} (Q : C) (f : over P) : f ≈ (0 : Q ⟶ P) ↔ f.hom = 0 :=
⟨λ ⟨R, p, q, ep, eq, comm⟩, by exactI zero_of_epi_comp p (by simp [comm]),
  λ hf, ⟨biprod f.1 Q, biprod.fst, biprod.snd, by apply_instance, by apply_instance,
    by rw [hf, over.coe_hom, has_zero_morphisms.comp_zero, has_zero_morphisms.comp_zero]⟩⟩

end

lemma zero_eq_zero' {P Q R : C} :
  ⟦((0 : Q ⟶ P) : over P)⟧ = ⟦((0 : R ⟶ P) : over P)⟧ :=
quotient.sound $ (pseudo_zero_aux R _).2 rfl

/-- The zero pseudoelement is the class of a zero morphism -/
def pseudo_zero {P : C} : P := ⟦(0 : P ⟶ P)⟧

instance {P : C} : has_zero P := ⟨pseudo_zero⟩
instance {P : C} : inhabited (pseudoelement P) := ⟨0⟩

lemma pseudo_zero_def {P : C} : (0 : pseudoelement P) = ⟦(0 : P ⟶ P)⟧ := rfl
@[simp] lemma zero_eq_zero {P Q : C} : ⟦((0 : Q ⟶ P) : over P)⟧ = (0 : pseudoelement P) :=
zero_eq_zero'

/-- The pseudoelement induced by an arrow is zero precisely when that arrow is zero -/
lemma pseudo_zero_iff {P : C} (a : over P) : (a : P) = 0 ↔ a.hom = 0 :=
by { rw ←pseudo_zero_aux P a, exact quotient.eq }

end zero

/-- Morphisms map the zero pseudoelement to the zero pseudoelement -/
@[simp] theorem apply_zero {P Q : C} (f : P ⟶ Q) : f 0 = 0 :=
by { rw [pseudo_zero_def, pseudo_apply_mk], simp  }

/-- The zero morphism maps every pseudoelement to 0. -/
@[simp] theorem zero_apply {P : C} (Q : C) (a : P) : (0 : P ⟶ Q) a = 0 :=
quotient.induction_on a $ λ a',
  by { rw [pseudo_zero_def, pseudo_apply_mk], simp }

/-- An extensionality lemma for being the zero arrow. -/
@[ext] theorem zero_morphism_ext {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0) → f = 0 :=
λ h, by { rw ←category.id_comp f, exact (pseudo_zero_iff ((𝟙 P ≫ f) : over Q)).1 (h (𝟙 P)) }

@[ext] theorem zero_morphism_ext' {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0) → 0 = f :=
eq.symm ∘ zero_morphism_ext f

theorem eq_zero_iff {P Q : C} (f : P ⟶ Q) : f = 0 ↔ ∀ a, f a = 0 :=
⟨λ h a, by simp [h], zero_morphism_ext _⟩

/-- A monomorphism is injective on pseudoelements. -/
theorem pseudo_injective_of_mono {P Q : C} (f : P ⟶ Q) [mono f] : function.injective f :=
λ abar abar', quotient.induction_on₂ abar abar' $ λ a a' ha, quotient.sound $
  have ⟦(a.hom ≫ f : over Q)⟧ = ⟦a'.hom ≫ f⟧, by convert ha,
  match quotient.exact this with ⟨R, p, q, ep, eq, comm⟩ :=
    ⟨R, p, q, ep, eq, (cancel_mono f).1 $ by { simp only [category.assoc], exact comm }⟩
  end

/-- A morphism that is injective on pseudoelements only maps the zero element to zero. -/
lemma zero_of_map_zero {P Q : C} (f : P ⟶ Q) : function.injective f → ∀ a, f a = 0 → a = 0 :=
λ h a ha, by { rw ←apply_zero f at ha, exact h ha }

/-- A morphism that only maps the zero pseudoelement to zero is a monomorphism. -/
theorem mono_of_zero_of_map_zero {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0 → a = 0) → mono f :=
λ h, (mono_iff_cancel_zero _).2 $ λ R g hg, (pseudo_zero_iff (g : over P)).1 $ h _ $
  show f g = 0, from (pseudo_zero_iff (g ≫ f : over Q)).2 hg

section

/-- An epimorphism is surjective on pseudoelements. -/
theorem pseudo_surjective_of_epi {P Q : C} (f : P ⟶ Q) [epi f] : function.surjective f :=
λ qbar, quotient.induction_on qbar $ λ q, ⟨((pullback.fst : pullback f q.hom ⟶ P) : over P),
  quotient.sound $ ⟨pullback f q.hom, 𝟙 (pullback f q.hom), pullback.snd, by apply_instance,
    by apply_instance, by rw [category.id_comp, ←pullback.condition, app_hom, over.coe_hom]⟩⟩

end

/-- A morphism that is surjective on pseudoelements is an epimorphism. -/
theorem epi_of_pseudo_surjective {P Q : C} (f : P ⟶ Q) : function.surjective f → epi f :=
λ h, match h (𝟙 Q) with ⟨pbar, hpbar⟩ :=
  match quotient.exists_rep pbar with ⟨p, hp⟩ :=
    have ⟦(p.hom ≫ f : over Q)⟧ = ⟦𝟙 Q⟧, by { rw ←hp at hpbar, exact hpbar },
    match quotient.exact this with ⟨R, x, y, ex, ey, comm⟩ :=
      @epi_of_epi_fac _ _ _ _ _ (x ≫ p.hom) f y ey $
        by { dsimp at comm, rw [category.assoc, comm], apply category.comp_id }
    end
  end
end

section

/-- Two morphisms in an exact sequence are exact on pseudoelements. -/
theorem pseudo_exact_of_exact {P Q R : C} {f : P ⟶ Q} {g : Q ⟶ R} [exact f g] :
  (∀ a, g (f a) = 0) ∧ (∀ b, g b = 0 → ∃ a, f a = b) :=
⟨λ a, by { rw [←comp_apply, exact.w], exact zero_apply _ _ },
  λ b', quotient.induction_on b' $ λ b hb,
    have hb' : b.hom ≫ g = 0, from (pseudo_zero_iff _).1 hb,
    begin
      -- By exactness, b factors through im f = ker g via some c
      obtain ⟨c, hc⟩ := kernel_fork.is_limit.lift' (is_limit_image f g) _ hb',

      -- We compute the pullback of the map into the image and c.
      -- The pseudoelement induced by the first pullback map will be our preimage.
      use (pullback.fst : pullback (images.factor_thru_image f) c ⟶ P),

      -- It remains to show that the image of this element under f is pseudo-equal to b.
      apply quotient.sound,

      -- pullback.snd is an epimorphism because the map onto the image is!
      refine ⟨pullback (images.factor_thru_image f) c, 𝟙 _, pullback.snd,
        by apply_instance, by apply_instance, _⟩,

      -- Now we can verify that the diagram commutes.
      calc 𝟙 (pullback (images.factor_thru_image f) c) ≫ pullback.fst ≫ f = pullback.fst ≫ f
                : category.id_comp _
        ... = pullback.fst ≫ images.factor_thru_image f ≫ kernel.ι (cokernel.π f)
                : by rw images.image.fac
        ... = (pullback.snd ≫ c) ≫ kernel.ι (cokernel.π f)
                : by rw [←category.assoc, pullback.condition]
        ... = pullback.snd ≫ b.hom
                : by { rw category.assoc, congr' }
    end⟩

end

lemma apply_eq_zero_of_comp_eq_zero {P Q R : C} (f : Q ⟶ R) (a : P ⟶ Q) : a ≫ f = 0 → f a = 0 :=
λ h, by simp [over_coe_def, pseudo_apply_mk, over.coe_hom, h]

section

/-- If two morphisms are exact on pseudoelements, they are exact. -/
theorem exact_of_pseudo_exact {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) :
  (∀ a, g (f a) = 0) ∧ (∀ b, g b = 0 → ∃ a, f a = b) → exact f g :=
λ ⟨h₁, h₂⟩, (abelian.exact_iff _ _).2 ⟨zero_morphism_ext _ $ λ a, by rw [comp_apply, h₁ a],
begin
  -- If we apply g to the pseudoelement induced by its kernel, we get 0 (of course!).
  have : g (kernel.ι g) = 0 := apply_eq_zero_of_comp_eq_zero _ _ (kernel.condition _),

  -- By pseudo-exactness, we get a preimage.
  obtain ⟨a', ha⟩ := h₂ _ this,
  obtain ⟨a, ha'⟩ := quotient.exists_rep a',
  rw ←ha' at ha,
  obtain ⟨Z, r, q, er, eq, comm⟩ := quotient.exact ha,

  -- Consider the pullback of kernel.ι (cokernel.π f) and kernel.ι g.
  -- The commutative diagram given by the pseudo-equality f a = b induces
  -- a cone over this pullback, so we get a factorization z.
  obtain ⟨z, hz₁, hz₂⟩ := @pullback.lift' _ _ _ _ _ _ (kernel.ι (cokernel.π f)) (kernel.ι g) _
    (r ≫ a.hom ≫ images.factor_thru_image f) q
      (by { simp only [category.assoc, images.image.fac], exact comm }),

  -- Let's give a name to the second pullback morphism.
  let j : pullback (kernel.ι (cokernel.π f)) (kernel.ι g) ⟶ kernel g := pullback.snd,

  -- Since q is an epimorphism, in particular this means that j is an epimorphism.
  haveI pe : epi j := by exactI epi_of_epi_fac hz₂,

  -- But is is also a monomorphism, because kernel.ι (cokernel.π f) is: A kernel is
  -- always a monomorphism and the pullback of a monomorphism is a monomorphism.
  -- But mono + epi = iso, so j is an isomorphism.
  haveI : is_iso j := is_iso_of_mono_of_epi _,

  -- But then kernel.ι g can be expressed using all of the maps of the pullback square, and we
  -- are done.
  rw (iso.eq_inv_comp (as_iso j)).2 pullback.condition.symm,
  simp only [category.assoc, kernel.condition, has_zero_morphisms.comp_zero]
end⟩

end

/-- If two pseudoelements `x` and `y` have the same image under some morphism `f`, then we can form
    their "difference" `z`. This pseudoelement has the properties that `f z = 0` and for all
    morphisms `g`, if `g y = 0` then `g z = g x`. -/
theorem sub_of_eq_image {P Q : C} (f : P ⟶ Q) (x y : P) : f x = f y →
  ∃ z, f z = 0 ∧ ∀ (R : C) (g : P ⟶ R), (g : P ⟶ R) y = 0 → g z = g x :=
quotient.induction_on₂ x y $ λ a a' h,
match quotient.exact h with ⟨R, p, q, ep, eq, comm⟩ :=
  let a'' : R ⟶ P := p ≫ a.hom - q ≫ a'.hom in ⟨a'',
    ⟨show ⟦((p ≫ a.hom - q ≫ a'.hom) ≫ f : over Q)⟧ = ⟦(0 : Q ⟶ Q)⟧,
      by { dsimp at comm, simp [sub_eq_zero.2 comm] },
      λ Z g hh,
      begin
        obtain ⟨X, p', q', ep', eq', comm'⟩ := quotient.exact hh,

        have : a'.hom ≫ g = 0,
        { apply (epi_iff_cancel_zero _).1 ep' _ (a'.hom ≫ g),
          simpa using comm' },

        apply quotient.sound,

        -- Can we prevent quotient.sound from giving us this weird `coe_b` thingy?
        change app g (a'' : over P) ≈ app g a,

        exact ⟨R, 𝟙 R, p, by apply_instance, ep, by simp [sub_eq_add_neg, this]⟩
      end⟩⟩
end

variable [limits.has_pullbacks C]
/-- If `f : P ⟶ R` and `g : Q ⟶ R` are morphisms and `p : P` and `q : Q` are pseudoelements such
    that `f p = g q`, then there is some `s : pullback f g` such that `fst s = p` and `snd s = q`.

    Remark: Borceux claims that `s` is unique. I was unable to transform his proof sketch into
    a pen-and-paper proof of this fact, so naturally I was not able to formalize the proof. -/
theorem pseudo_pullback {P Q R : C} {f : P ⟶ R} {g : Q ⟶ R} {p : P} {q : Q} : f p = g q →
  ∃ s, (pullback.fst : pullback f g ⟶ P) s = p ∧ (pullback.snd : pullback f g ⟶ Q) s = q :=
quotient.induction_on₂ p q $ λ x y h,
begin
  obtain ⟨Z, a, b, ea, eb, comm⟩ := quotient.exact h,

  obtain ⟨l, hl₁, hl₂⟩ := @pullback.lift' _ _ _ _ _ _ f g _ (a ≫ x.hom) (b ≫ y.hom)
    (by { simp only [category.assoc], exact comm }),

  exact ⟨l, ⟨quotient.sound ⟨Z, 𝟙 Z, a, by apply_instance, ea, by rwa category.id_comp⟩,
    quotient.sound ⟨Z, 𝟙 Z, b, by apply_instance, eb, by rwa category.id_comp⟩⟩⟩
end

end pseudoelement
end category_theory.abelian