/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn
-/
prelude
import init.datatypes init.reserved_notation init.tactic

definition id [reducible] [unfold_full] {A : Type} (a : A) : A :=
a

/- implication -/

definition implies (a b : Prop) := a → b

lemma implies.trans [trans] {p q r : Prop} (h₁ : implies p q) (h₂ : implies q r) : implies p r :=
assume hp, h₂ (h₁ hp)

definition trivial := true.intro

definition not (a : Prop) := a → false
prefix `¬` := not

definition absurd {a : Prop} {b : Type} (H1 : a) (H2 : ¬a) : b :=
false.rec b (H2 H1)

lemma not.intro [intro!] {a : Prop} (H : a → false) : ¬ a :=
H

theorem mt {a b : Prop} (H1 : a → b) (H2 : ¬b) : ¬a :=
assume Ha : a, absurd (H1 Ha) H2

definition implies.resolve {a b : Prop} (H : a → b) (nb : ¬ b) : ¬ a := assume Ha, nb (H Ha)

/- not -/

theorem not_false : ¬false :=
assume H : false, H

definition non_contradictory (a : Prop) : Prop := ¬¬a

theorem non_contradictory_intro {a : Prop} (Ha : a) : ¬¬a :=
assume Hna : ¬a, absurd Ha Hna

/- false -/

theorem false.elim {c : Prop} (H : false) : c :=
false.rec c H

/- eq -/

notation a = b := eq a b
definition rfl {A : Type} {a : A} : a = a := eq.refl a

definition id.def [defeq] {A : Type} (a : A) : id a = a := rfl

-- proof irrelevance is built in
theorem proof_irrel {a : Prop} (H₁ H₂ : a) : H₁ = H₂ :=
rfl

-- Remark: we provide the universe levels explicitly to make sure `eq.drec` has the same type of `eq.rec` in the HoTT library
protected theorem eq.drec.{l₁ l₂} {A : Type.{l₂}} {a : A} {C : Π (x : A), a = x → Type.{l₁}} (h₁ : C a (eq.refl a)) {b : A} (h₂ : a = b) : C b h₂ :=
eq.rec (λh₂ : a = a, show C a h₂, from h₁) h₂ h₂

namespace eq
  variables {A : Type}
  variables {a b c a': A}

  protected theorem drec_on {a : A} {C : Π (x : A), a = x → Type} {b : A} (h₂ : a = b) (h₁ : C a (refl a)) : C b h₂ :=
  eq.drec h₁ h₂

  theorem subst {P : A → Prop} (H₁ : a = b) (H₂ : P a) : P b :=
  eq.rec H₂ H₁

  theorem trans (H₁ : a = b) (H₂ : b = c) : a = c :=
  subst H₂ H₁

  theorem symm : a = b → b = a :=
  eq.rec (refl a)

  theorem substr {P : A → Prop} (H₁ : b = a) : P a → P b :=
  subst (symm H₁)

  theorem mp {a b : Type} : (a = b) → a → b :=
  eq.rec_on

  theorem mpr {a b : Type} : (a = b) → b → a :=
  assume H₁ H₂, eq.rec_on (eq.symm H₁) H₂

  namespace ops
    notation H `⁻¹` := symm H --input with \sy or \-1 or \inv
    notation H1 ⬝ H2 := trans H1 H2
    notation H1 ▸ H2 := subst H1 H2
    notation H1 ▹ H2 := eq.rec H2 H1
  end ops
end eq

theorem congr {A B : Type} {f₁ f₂ : A → B} {a₁ a₂ : A} (H₁ : f₁ = f₂) (H₂ : a₁ = a₂) : f₁ a₁ = f₂ a₂ :=
eq.subst H₁ (eq.subst H₂ rfl)

theorem congr_fun {A : Type} {B : A → Type} {f g : Π x, B x} (H : f = g) (a : A) : f a = g a :=
eq.subst H (eq.refl (f a))

theorem congr_arg {A B : Type} {a₁ a₂ : A} (f : A → B) : a₁ = a₂ → f a₁ = f a₂ :=
congr rfl

section
  variables {A : Type} {a b c: A}
  open eq.ops

  theorem trans_rel_left (R : A → A → Prop) (H₁ : R a b) (H₂ : b = c) : R a c :=
  H₂ ▸ H₁

  theorem trans_rel_right (R : A → A → Prop) (H₁ : a = b) (H₂ : R b c) : R a c :=
  H₁⁻¹ ▸ H₂
end

section
  variable {p : Prop}
  open eq.ops

  theorem of_eq_true (H : p = true) : p :=
  H⁻¹ ▸ trivial

  theorem not_of_eq_false (H : p = false) : ¬p :=
  assume Hp, H ▸ Hp
end

attribute eq.subst [subst]
attribute eq.refl [refl]
attribute eq.trans [trans]
attribute eq.symm [symm]

definition cast {A B : Type} (H : A = B) (a : A) : B :=
eq.rec a H

theorem cast_proof_irrel {A B : Type} (H₁ H₂ : A = B) (a : A) : cast H₁ a = cast H₂ a :=
rfl

theorem cast_eq {A : Type} (H : A = A) (a : A) : cast H a = a :=
rfl

/- ne -/

definition ne [reducible] {A : Type} (a b : A) := ¬(a = b)
definition ne.def [defeq] {A : Type} (a b : A) : ne a b = ¬ (a = b) := rfl
notation a ≠ b := ne a b

namespace ne
  open eq.ops
  variable {A : Type}
  variables {a b : A}

  theorem intro (H : a = b → false) : a ≠ b := H

  theorem elim (H : a ≠ b) : a = b → false := H

  theorem irrefl (H : a ≠ a) : false := H rfl

  theorem symm (H : a ≠ b) : b ≠ a :=
  assume (H₁ : b = a), H (H₁⁻¹)
end ne

theorem false_of_ne {A : Type} {a : A} : a ≠ a → false := ne.irrefl

section
  open eq.ops
  variables {p : Prop}

  theorem ne_false_of_self : p → p ≠ false :=
  assume (Hp : p) (Heq : p = false), Heq ▸ Hp

  theorem ne_true_of_not : ¬p → p ≠ true :=
  assume (Hnp : ¬p) (Heq : p = true), (Heq ▸ Hnp) trivial

  theorem true_ne_false : ¬true = false :=
  ne_false_of_self trivial
end

infixl ` == `:50 := heq

section
universe variable u
variables {A B C : Type.{u}} {a a' : A} {b b' : B} {c : C}

theorem eq_of_heq (H : a == a') : a = a' :=
have H₁ : ∀ (Ht : A = A), eq.rec a Ht = a, from
  λ Ht, eq.refl a,
heq.rec H₁ H (eq.refl A)

theorem heq.elim {A : Type} {a : A} {P : A → Type} {b : A} (H₁ : a == b)
: P a → P b := eq.rec_on (eq_of_heq H₁)

theorem heq.subst {P : ∀T : Type, T → Prop} : a == b → P A a → P B b :=
heq.rec_on

theorem heq.symm (H : a == b) : b == a :=
heq.rec_on H (heq.refl a)

theorem heq_of_eq (H : a = a') : a == a' :=
eq.subst H (heq.refl a)

theorem heq.trans (H₁ : a == b) (H₂ : b == c) : a == c :=
heq.subst H₂ H₁

theorem heq_of_heq_of_eq (H₁ : a == b) (H₂ : b = b') : a == b' :=
heq.trans H₁ (heq_of_eq H₂)

theorem heq_of_eq_of_heq (H₁ : a = a') (H₂ : a' == b) : a == b :=
heq.trans (heq_of_eq H₁) H₂

definition type_eq_of_heq (H : a == b) : A = B :=
heq.rec_on H (eq.refl A)
end

open eq.ops
theorem eq_rec_heq {A : Type} {P : A → Type} {a a' : A} (H : a = a') (p : P a) : H ▹ p == p :=
eq.drec_on H !heq.refl

theorem heq_of_eq_rec_left {A : Type} {P : A → Type} : ∀ {a a' : A} {p₁ : P a} {p₂ : P a'} (e : a = a') (h₂ : e ▹ p₁ = p₂), p₁ == p₂
| a a p₁ p₂ (eq.refl a) h := eq.rec_on h !heq.refl

theorem heq_of_eq_rec_right {A : Type} {P : A → Type} : ∀ {a a' : A} {p₁ : P a} {p₂ : P a'} (e : a' = a) (h₂ : p₁ = e ▹ p₂), p₁ == p₂
| a a p₁ p₂ (eq.refl a) h := eq.rec_on h !heq.refl

theorem of_heq_true {a : Prop} (H : a == true) : a :=
of_eq_true (eq_of_heq H)

theorem eq_rec_compose : ∀ {A B C : Type} (p₁ : B = C) (p₂ : A = B) (a : A), p₁ ▹ (p₂ ▹ a : B) = (p₂ ⬝ p₁) ▹ a
| A A A (eq.refl A) (eq.refl A) a := calc
  eq.refl A ▹ eq.refl A ▹ a = eq.refl A ▹ a              : rfl
            ...             = (eq.refl A ⬝ eq.refl A) ▹ a : {proof_irrel (eq.refl A) (eq.refl A ⬝ eq.refl A)}

theorem eq_rec_eq_eq_rec {A₁ A₂ : Type} {p : A₁ = A₂} : ∀ {a₁ : A₁} {a₂ : A₂}, p ▹ a₁ = a₂ → a₁ = p⁻¹ ▹ a₂ :=
eq.drec_on p (λ a₁ a₂ h, eq.drec_on h rfl)

theorem eq_rec_of_heq_left : ∀ {A₁ A₂ : Type} {a₁ : A₁} {a₂ : A₂} (h : a₁ == a₂), type_eq_of_heq h ▹ a₁ = a₂
| A A a a (heq.refl a) := rfl

theorem eq_rec_of_heq_right {A₁ A₂ : Type} {a₁ : A₁} {a₂ : A₂} (h : a₁ == a₂) : a₁ = (type_eq_of_heq h)⁻¹ ▹ a₂ :=
eq_rec_eq_eq_rec (eq_rec_of_heq_left h)

attribute heq.refl [refl]
attribute heq.trans [trans]
attribute heq_of_heq_of_eq [trans]
attribute heq_of_eq_of_heq [trans]
attribute heq.symm [symm]

theorem cast_heq : ∀ {A B : Type} (H : A = B) (a : A), cast H a == a
| A A (eq.refl A) a := !heq.refl

/- and -/

notation a /\ b := and a b
notation a ∧ b  := and a b

variables {a b c d : Prop}

attribute and.rec [elim]
attribute and.intro [intro!]

theorem and.elim (H₁ : a ∧ b) (H₂ : a → b → c) : c :=
and.rec H₂ H₁

theorem and.swap : a ∧ b → b ∧ a :=
and.rec (λHa Hb, and.intro Hb Ha)

/- or -/

notation a \/ b := or a b
notation a ∨ b := or a b

attribute or.rec [elim]

namespace or
  theorem elim (H₁ : a ∨ b) (H₂ : a → c) (H₃ : b → c) : c :=
  or.rec H₂ H₃ H₁
end or

theorem non_contradictory_em (a : Prop) : ¬¬(a ∨ ¬a) :=
assume not_em : ¬(a ∨ ¬a),
  have neg_a : ¬a, from
    assume pos_a : a, absurd (or.inl pos_a) not_em,
  absurd (or.inr neg_a) not_em

theorem or.swap : a ∨ b → b ∨ a := or.rec or.inr or.inl

/- iff -/

definition iff (a b : Prop) := (a → b) ∧ (b → a)

notation a <-> b := iff a b
notation a ↔ b := iff a b

theorem iff.intro : (a → b) → (b → a) → (a ↔ b) := and.intro

attribute iff.intro [intro!]

theorem iff.elim : ((a → b) → (b → a) → c) → (a ↔ b) → c := and.rec

attribute iff.elim [recursor 5] [elim]

theorem iff.elim_left : (a ↔ b) → a → b := and.left

definition iff.mp := @iff.elim_left

theorem iff.elim_right : (a ↔ b) → b → a := and.right

definition iff.mpr := @iff.elim_right

theorem iff.refl [refl] (a : Prop) : a ↔ a :=
iff.intro (assume H, H) (assume H, H)

theorem iff.rfl {a : Prop} : a ↔ a :=
iff.refl a

theorem iff.trans [trans] (H₁ : a ↔ b) (H₂ : b ↔ c) : a ↔ c :=
iff.intro
  (assume Ha, iff.mp H₂ (iff.mp H₁ Ha))
  (assume Hc, iff.mpr H₁ (iff.mpr H₂ Hc))

theorem iff.symm [symm] (H : a ↔ b) : b ↔ a :=
iff.intro (iff.elim_right H) (iff.elim_left H)

theorem iff.comm : (a ↔ b) ↔ (b ↔ a) :=
iff.intro iff.symm iff.symm

theorem iff.of_eq {a b : Prop} (H : a = b) : a ↔ b :=
eq.rec_on H iff.rfl

theorem not_iff_not_of_iff (H₁ : a ↔ b) : ¬a ↔ ¬b :=
iff.intro
 (assume (Hna : ¬ a) (Hb : b), Hna (iff.elim_right H₁ Hb))
 (assume (Hnb : ¬ b) (Ha : a), Hnb (iff.elim_left H₁ Ha))

theorem of_iff_true (H : a ↔ true) : a :=
iff.mp (iff.symm H) trivial

theorem not_of_iff_false : (a ↔ false) → ¬a := iff.mp

theorem iff_true_intro (H : a) : a ↔ true :=
iff.intro
  (λ Hl, trivial)
  (λ Hr, H)

theorem iff_false_intro (H : ¬a) : a ↔ false :=
iff.intro H !false.rec

theorem not_non_contradictory_iff_absurd (a : Prop) : ¬¬¬a ↔ ¬a :=
iff.intro
  (λ (Hl : ¬¬¬a) (Ha : a), Hl (non_contradictory_intro Ha))
  absurd

theorem imp_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a → b) ↔ (c → d) :=
iff.intro
  (λHab Hc, iff.mp H2 (Hab (iff.mpr H1 Hc)))
  (λHcd Ha, iff.mpr H2 (Hcd (iff.mp H1 Ha)))

theorem imp_congr_right (H : a → (b ↔ c)) : (a → b) ↔ (a → c) :=
iff.intro
  (take Hab Ha, iff.elim_left (H Ha) (Hab Ha))
  (take Hab Ha, iff.elim_right (H Ha) (Hab Ha))

theorem not_not_intro (Ha : a) : ¬¬a :=
assume Hna : ¬a, Hna Ha

theorem not_of_not_not_not (H : ¬¬¬a) : ¬a :=
λ Ha, absurd (not_not_intro Ha) H

theorem not_true [simp] : (¬ true) ↔ false :=
iff_false_intro (not_not_intro trivial)

theorem not_false_iff [simp] : (¬ false) ↔ true :=
iff_true_intro not_false

theorem not_congr [congr] (H : a ↔ b) : ¬a ↔ ¬b :=
iff.intro (λ H₁ H₂, H₁ (iff.mpr H H₂)) (λ H₁ H₂, H₁ (iff.mp H H₂))

theorem ne_self_iff_false [simp] {A : Type} (a : A) : (not (a = a)) ↔ false :=
iff.intro false_of_ne false.elim

theorem eq_self_iff_true [simp] {A : Type} (a : A) : (a = a) ↔ true :=
iff_true_intro rfl

theorem heq_self_iff_true [simp] {A : Type} (a : A) : (a == a) ↔ true :=
iff_true_intro (heq.refl a)

theorem iff_not_self [simp] (a : Prop) : (a ↔ ¬a) ↔ false :=
iff_false_intro (λ H,
   have H' : ¬a, from (λ Ha, (iff.mp H Ha) Ha),
   H' (iff.mpr H H'))

theorem not_iff_self [simp] (a : Prop) : (¬a ↔ a) ↔ false :=
iff_false_intro (λ H,
   have H' : ¬a, from (λ Ha, (iff.mpr H Ha) Ha),
   H' (iff.mp H H'))

theorem true_iff_false [simp] : (true ↔ false) ↔ false :=
iff_false_intro (λ H, iff.mp H trivial)

theorem false_iff_true [simp] : (false ↔ true) ↔ false :=
iff_false_intro (λ H, iff.mpr H trivial)

theorem false_of_true_iff_false : (true ↔ false) → false :=
assume H, iff.mp H trivial

/- and simp rules -/
theorem and.imp (H₂ : a → c) (H₃ : b → d) : a ∧ b → c ∧ d :=
and.rec (λHa Hb, and.intro (H₂ Ha) (H₃ Hb))

theorem and_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a ∧ b) ↔ (c ∧ d) :=
iff.intro (and.imp (iff.mp H1) (iff.mp H2)) (and.imp (iff.mpr H1) (iff.mpr H2))

theorem and_congr_right (H : a → (b ↔ c)) : (a ∧ b) ↔ (a ∧ c) :=
iff.intro
  (take Hab, obtain `a` `b`, from Hab, and.intro `a` (iff.elim_left (H `a`) `b`))
  (take Hac, obtain `a` `c`, from Hac, and.intro `a` (iff.elim_right (H `a`) `c`))

theorem and.comm [simp] : a ∧ b ↔ b ∧ a :=
iff.intro and.swap and.swap

theorem and.assoc [simp] : (a ∧ b) ∧ c ↔ a ∧ (b ∧ c) :=
iff.intro
  (and.rec (λ H' Hc, and.rec (λ Ha Hb, and.intro Ha (and.intro Hb Hc)) H'))
  (and.rec (λ Ha, and.rec (λ Hb Hc, and.intro (and.intro Ha Hb) Hc)))

theorem and.left_comm [simp] : a ∧ (b ∧ c) ↔ b ∧ (a ∧ c) :=
iff.trans (iff.symm !and.assoc) (iff.trans (and_congr !and.comm !iff.refl) !and.assoc)

theorem and_iff_left {a b : Prop} (Hb : b) : (a ∧ b) ↔ a :=
iff.intro and.left (λHa, and.intro Ha Hb)

theorem and_iff_right {a b : Prop} (Ha : a) : (a ∧ b) ↔ b :=
iff.intro and.right (and.intro Ha)

theorem and_true [simp] (a : Prop) : a ∧ true ↔ a :=
and_iff_left trivial

theorem true_and [simp] (a : Prop) : true ∧ a ↔ a :=
and_iff_right trivial

theorem and_false [simp] (a : Prop) : a ∧ false ↔ false :=
iff_false_intro and.right

theorem false_and [simp] (a : Prop) : false ∧ a ↔ false :=
iff_false_intro and.left

theorem not_and_self [simp] (a : Prop) : (¬a ∧ a) ↔ false :=
iff_false_intro (λ H, and.elim H (λ H₁ H₂, absurd H₂ H₁))

theorem and_not_self [simp] (a : Prop) : (a ∧ ¬a) ↔ false :=
iff_false_intro (λ H, and.elim H (λ H₁ H₂, absurd H₁ H₂))

theorem and_self [simp] (a : Prop) : a ∧ a ↔ a :=
iff.intro and.left (assume H, and.intro H H)

/- or simp rules -/

theorem or.imp (H₂ : a → c) (H₃ : b → d) : a ∨ b → c ∨ d :=
or.rec (λ H, or.inl (H₂ H)) (λ H, or.inr (H₃ H))

theorem or.imp_left (H : a → b) : a ∨ c → b ∨ c :=
or.imp H id

theorem or.imp_right (H : a → b) : c ∨ a → c ∨ b :=
or.imp id H

theorem or_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a ∨ b) ↔ (c ∨ d) :=
iff.intro (or.imp (iff.mp H1) (iff.mp H2)) (or.imp (iff.mpr H1) (iff.mpr H2))

theorem or.comm [simp] : a ∨ b ↔ b ∨ a := iff.intro or.swap or.swap

theorem or.assoc [simp] : (a ∨ b) ∨ c ↔ a ∨ (b ∨ c) :=
iff.intro
  (or.rec (or.imp_right or.inl) (λ H, or.inr (or.inr H)))
  (or.rec (λ H, or.inl (or.inl H)) (or.imp_left or.inr))

theorem or.left_comm [simp] : a ∨ (b ∨ c) ↔ b ∨ (a ∨ c) :=
iff.trans (iff.symm !or.assoc) (iff.trans (or_congr !or.comm !iff.refl) !or.assoc)

theorem or_true [simp] (a : Prop) : a ∨ true ↔ true :=
iff_true_intro (or.inr trivial)

theorem true_or [simp] (a : Prop) : true ∨ a ↔ true :=
iff_true_intro (or.inl trivial)

theorem or_false [simp] (a : Prop) : a ∨ false ↔ a :=
iff.intro (or.rec id false.elim) or.inl

theorem false_or [simp] (a : Prop) : false ∨ a ↔ a :=
iff.trans or.comm !or_false

theorem or_self [simp] (a : Prop) : a ∨ a ↔ a :=
iff.intro (or.rec id id) or.inl

/- or resolution rulse -/

definition or.resolve_left {a b : Prop} (H : a ∨ b) (na : ¬ a) : b :=
  or.elim H (λ Ha, absurd Ha na) id

definition or.neg_resolve_left {a b : Prop} (H : ¬ a ∨ b) (Ha : a) : b :=
  or.elim H (λ na, absurd Ha na) id

definition or.resolve_right {a b : Prop} (H : a ∨ b) (nb : ¬ b) : a :=
  or.elim H id (λ Hb, absurd Hb nb)

definition or.neg_resolve_right {a b : Prop} (H : a ∨ ¬ b) (Hb : b) : a :=
  or.elim H id (λ nb, absurd Hb nb)

/- iff simp rules -/

theorem iff_true [simp] (a : Prop) : (a ↔ true) ↔ a :=
iff.intro (assume H, iff.mpr H trivial) iff_true_intro

theorem true_iff [simp] (a : Prop) : (true ↔ a) ↔ a :=
iff.trans iff.comm !iff_true

theorem iff_false [simp] (a : Prop) : (a ↔ false) ↔ ¬ a :=
iff.intro and.left iff_false_intro

theorem false_iff [simp] (a : Prop) : (false ↔ a) ↔ ¬ a :=
iff.trans iff.comm !iff_false

theorem iff_self [simp] (a : Prop) : (a ↔ a) ↔ true :=
iff_true_intro iff.rfl

theorem iff_congr [congr] (H1 : a ↔ c) (H2 : b ↔ d) : (a ↔ b) ↔ (c ↔ d) :=
and_congr (imp_congr H1 H2) (imp_congr H2 H1)

/- exists -/

inductive Exists {A : Type} (P : A → Prop) : Prop :=
intro : ∀ (a : A), P a → Exists P

attribute Exists.intro [intro]

definition exists.intro := @Exists.intro

notation `exists` binders `, ` r:(scoped P, Exists P) := r
notation `∃` binders `, ` r:(scoped P, Exists P) := r

attribute Exists.rec [elim]

theorem exists.elim {A : Type} {p : A → Prop} {B : Prop}
  (H1 : ∃x, p x) (H2 : ∀ (a : A), p a → B) : B :=
Exists.rec H2 H1

/- exists unique -/

definition exists_unique {A : Type} (p : A → Prop) :=
∃x, p x ∧ ∀y, p y → y = x

notation `∃!` binders `, ` r:(scoped P, exists_unique P) := r

theorem exists_unique.intro [intro] {A : Type} {p : A → Prop} (w : A) (H1 : p w) (H2 : ∀y, p y → y = w) :
  ∃!x, p x :=
exists.intro w (and.intro H1 H2)

theorem exists_unique.elim [recursor 4] [elim] {A : Type} {p : A → Prop} {b : Prop}
    (H2 : ∃!x, p x) (H1 : ∀x, p x → (∀y, p y → y = x) → b) : b :=
exists.elim H2 (λ w Hw, H1 w (and.left Hw) (and.right Hw))

theorem exists_unique_of_exists_of_unique {A : Type} {p : A → Prop}
    (Hex : ∃ x, p x) (Hunique : ∀ y₁ y₂, p y₁ → p y₂ → y₁ = y₂) :  ∃! x, p x :=
exists.elim Hex (λ x px, exists_unique.intro x px (take y, suppose p y, Hunique y x this px))

theorem exists_of_exists_unique {A : Type} {p : A → Prop} (H : ∃! x, p x) : ∃ x, p x :=
exists.elim H (λ x Hx, exists.intro x (and.left Hx))

theorem unique_of_exists_unique {A : Type} {p : A → Prop}
    (H : ∃! x, p x) {y₁ y₂ : A} (py₁ : p y₁) (py₂ : p y₂) : y₁ = y₂ :=
exists_unique.elim H
  (take x, suppose p x,
    assume unique : ∀ y, p y → y = x,
    show y₁ = y₂, from eq.trans (unique _ py₁) (eq.symm (unique _ py₂)))

/- exists, forall, exists unique congruences -/
section
variables {A : Type} {p₁ p₂ : A → Prop}

theorem forall_congr [congr] {A : Type} {P Q : A → Prop} (H : ∀a, (P a ↔ Q a)) : (∀a, P a) ↔ ∀a, Q a :=
iff.intro (λp a, iff.mp (H a) (p a)) (λq a, iff.mpr (H a) (q a))

theorem exists_imp_exists {A : Type} {P Q : A → Prop} (H : ∀a, (P a → Q a)) (p : ∃a, P a) : ∃a, Q a :=
exists.elim p (λa Hp, exists.intro a (H a Hp))

theorem exists_congr [congr] {A : Type} {P Q : A → Prop} (H : ∀a, (P a ↔ Q a)) : (∃a, P a) ↔ ∃a, Q a :=
iff.intro
  (exists_imp_exists (λa, iff.mp (H a)))
  (exists_imp_exists (λa, iff.mpr (H a)))

theorem exists_unique_congr [congr] (H : ∀ x, p₁ x ↔ p₂ x) : (∃! x, p₁ x) ↔ (∃! x, p₂ x) :=
exists_congr (λx, and_congr (H x) (forall_congr (λy, imp_congr (H y) iff.rfl)))
end

/- decidable -/

inductive decidable [class] (p : Prop) : Type :=
| inl :  p → decidable p
| inr : ¬p → decidable p

definition decidable_true [instance] : decidable true :=
decidable.inl trivial

definition decidable_false [instance] : decidable false :=
decidable.inr not_false

-- We use "dependent" if-then-else to be able to communicate the if-then-else condition
-- to the branches
definition dite (c : Prop) [H : decidable c] {A : Type} : (c → A) → (¬ c → A) → A :=
decidable.rec_on H

/- if-then-else -/

definition ite (c : Prop) [H : decidable c] {A : Type} (t e : A) : A :=
decidable.rec_on H (λ Hc, t) (λ Hnc, e)

namespace decidable
  variables {p q : Prop}

  definition rec_on_true [H : decidable p] {H1 : p → Type} {H2 : ¬p → Type} (H3 : p) (H4 : H1 H3)
      : decidable.rec_on H H1 H2 :=
  decidable.rec_on H (λh, H4) (λh, !false.rec (h H3))

  definition rec_on_false [H : decidable p] {H1 : p → Type} {H2 : ¬p → Type} (H3 : ¬p) (H4 : H2 H3)
      : decidable.rec_on H H1 H2 :=
  decidable.rec_on H (λh, false.rec _ (H3 h)) (λh, H4)

  definition by_cases {q : Type} [C : decidable p] : (p → q) → (¬p → q) → q := !dite

  theorem em (p : Prop) [decidable p] : p ∨ ¬p := by_cases or.inl or.inr

  theorem by_contradiction [decidable p] (H : ¬p → false) : p :=
  if H1 : p then H1 else false.rec _ (H H1)
end decidable

section
  variables {p q : Prop}
  open decidable
  definition  decidable_of_decidable_of_iff (Hp : decidable p) (H : p ↔ q) : decidable q :=
  if Hp : p then inl (iff.mp H Hp)
  else inr (iff.mp (not_iff_not_of_iff H) Hp)

  definition  decidable_of_decidable_of_eq (Hp : decidable p) (H : p = q) : decidable q :=
  decidable_of_decidable_of_iff Hp (iff.of_eq H)

  protected definition or.by_cases [decidable p] [decidable q] {A : Type}
                                   (h : p ∨ q) (h₁ : p → A) (h₂ : q → A) : A :=
  if hp : p then h₁ hp else
    if hq : q then h₂ hq else
      false.rec _ (or.elim h hp hq)
end

section
  variables {p q : Prop}
  open decidable (rec_on inl inr)

  definition decidable_and [instance] [decidable p] [decidable q] : decidable (p ∧ q) :=
  if hp : p then
    if hq : q then inl (and.intro hp hq)
    else inr (assume H : p ∧ q, hq (and.right H))
  else inr (assume H : p ∧ q, hp (and.left H))

  definition decidable_or [instance] [decidable p] [decidable q] : decidable (p ∨ q) :=
  if hp : p then inl (or.inl hp) else
    if hq : q then inl (or.inr hq) else
      inr (or.rec hp hq)

  definition decidable_not [instance] [decidable p] : decidable (¬p) :=
  if hp : p then inr (absurd hp) else inl hp

  definition decidable_implies [instance] [decidable p] [decidable q] : decidable (p → q) :=
  if hp : p then
    if hq : q then inl (assume H, hq)
    else inr (assume H : p → q, absurd (H hp) hq)
  else inl (assume Hp, absurd Hp hp)

  definition decidable_iff [instance] [decidable p] [decidable q] : decidable (p ↔ q) :=
  decidable_and

end

definition decidable_pred [reducible] {A : Type} (R : A   →   Prop) := Π (a   : A), decidable (R a)
definition decidable_rel  [reducible] {A : Type} (R : A → A → Prop) := Π (a b : A), decidable (R a b)
definition decidable_eq   [reducible] (A : Type) := decidable_rel (@eq A)
definition decidable_ne [instance] {A : Type} [decidable_eq A] (a b : A) : decidable (a ≠ b) :=
decidable_implies

namespace bool
  theorem ff_ne_tt : ff = tt → false
  | [none]
end bool

open bool
definition is_dec_eq {A : Type} (p : A → A → bool) : Prop   := ∀ ⦃x y : A⦄, p x y = tt → x = y
definition is_dec_refl {A : Type} (p : A → A → bool) : Prop := ∀x, p x x = tt

open decidable
protected definition bool.has_decidable_eq [instance] : ∀a b : bool, decidable (a = b)
| ff ff := inl rfl
| ff tt := inr ff_ne_tt
| tt ff := inr (ne.symm ff_ne_tt)
| tt tt := inl rfl

definition decidable_eq_of_bool_pred {A : Type} {p : A → A → bool} (H₁ : is_dec_eq p) (H₂ : is_dec_refl p) : decidable_eq A :=
take x y : A, if Hp : p x y = tt then inl (H₁ Hp)
 else inr (assume Hxy : x = y, (eq.subst Hxy Hp) (H₂ y))

theorem decidable_eq_inl_refl {A : Type} [H : decidable_eq A] (a : A) : H a a = inl (eq.refl a) :=
match H a a with
| inl e := rfl
| inr n := absurd rfl n
end

open eq.ops
theorem decidable_eq_inr_neg {A : Type} [H : decidable_eq A] {a b : A} : Π n : a ≠ b, H a b = inr n :=
assume n,
match H a b with
| inl e  := absurd e n
| inr n₁ := proof_irrel n n₁ ▸ rfl
end

/- inhabited -/

inductive inhabited [class] (A : Type) : Type :=
mk : A → inhabited A

protected definition inhabited.value {A : Type} : inhabited A → A :=
inhabited.rec (λa, a)

protected definition inhabited.destruct {A : Type} {B : Type} (H1 : inhabited A) (H2 : A → B) : B :=
inhabited.rec H2 H1

definition default (A : Type) [H : inhabited A] : A :=
inhabited.value H

definition arbitrary [irreducible] (A : Type) [H : inhabited A] : A :=
inhabited.value H

definition Prop.is_inhabited [instance] : inhabited Prop :=
inhabited.mk true

definition inhabited_fun [instance] (A : Type) {B : Type} [H : inhabited B] : inhabited (A → B) :=
inhabited.rec_on H (λb, inhabited.mk (λa, b))

definition inhabited_Pi [instance] (A : Type) {B : A → Type} [Πx, inhabited (B x)] :
  inhabited (Πx, B x) :=
inhabited.mk (λa, !default)

protected definition bool.is_inhabited [instance] : inhabited bool :=
inhabited.mk ff

protected definition pos_num.is_inhabited [instance] : inhabited pos_num :=
inhabited.mk pos_num.one

protected definition num.is_inhabited [instance] : inhabited num :=
inhabited.mk num.zero

inductive nonempty [class] (A : Type) : Prop :=
intro : A → nonempty A

protected definition nonempty.elim {A : Type} {B : Prop} (H1 : nonempty A) (H2 : A → B) : B :=
nonempty.rec H2 H1

theorem nonempty_of_inhabited [instance] {A : Type} [inhabited A] : nonempty A :=
nonempty.intro !default

theorem nonempty_of_exists {A : Type} {P : A → Prop} : (∃x, P x) → nonempty A :=
Exists.rec (λw H, nonempty.intro w)

/- subsingleton -/

inductive subsingleton [class] (A : Type) : Prop :=
intro : (∀ a b : A, a = b) → subsingleton A

protected definition subsingleton.elim {A : Type} [H : subsingleton A] : ∀(a b : A), a = b :=
subsingleton.rec (λp, p) H

protected definition subsingleton.helim {A B : Type} [H : subsingleton A] (h : A = B) (a : A) (b : B) : a == b :=
by induction h; apply heq_of_eq; apply subsingleton.elim

definition subsingleton_prop [instance] (p : Prop) : subsingleton p :=
subsingleton.intro (λa b, !proof_irrel)

definition subsingleton_decidable [instance] (p : Prop) : subsingleton (decidable p) :=
subsingleton.intro (λ d₁,
  match d₁ with
  | inl t₁ := (λ d₂,
    match d₂ with
    | inl t₂ := eq.rec_on (proof_irrel t₁ t₂) rfl
    | inr f₂ := absurd t₁ f₂
    end)
  | inr f₁ := (λ d₂,
    match d₂ with
    | inl t₂ := absurd t₂ f₁
    | inr f₂ := eq.rec_on (proof_irrel f₁ f₂) rfl
    end)
  end)

protected theorem rec_subsingleton {p : Prop} [H : decidable p]
    {H1 : p → Type} {H2 : ¬p → Type}
    [H3 : Π(h : p), subsingleton (H1 h)] [H4 : Π(h : ¬p), subsingleton (H2 h)]
  : subsingleton (decidable.rec_on H H1 H2) :=
decidable.rec_on H (λh, H3 h) (λh, H4 h) --this can be proven using dependent version of "by_cases"

theorem if_pos {c : Prop} [H : decidable c] (Hc : c) {A : Type} {t e : A} : (ite c t e) = t :=
decidable.rec
  (λ Hc : c,    eq.refl (@ite c (decidable.inl Hc) A t e))
  (λ Hnc : ¬c,  absurd Hc Hnc)
  H

theorem if_neg {c : Prop} [H : decidable c] (Hnc : ¬c) {A : Type} {t e : A} : (ite c t e) = e :=
decidable.rec
  (λ Hc : c,    absurd Hc Hnc)
  (λ Hnc : ¬c,  eq.refl (@ite c (decidable.inr Hnc) A t e))
  H

theorem if_t_t [simp] (c : Prop) [H : decidable c] {A : Type} (t : A) : (ite c t t) = t :=
decidable.rec
  (λ Hc  : c,  eq.refl (@ite c (decidable.inl Hc)  A t t))
  (λ Hnc : ¬c, eq.refl (@ite c (decidable.inr Hnc) A t t))
  H

theorem implies_of_if_pos {c t e : Prop} [decidable c] (h : ite c t e) : c → t :=
assume Hc, eq.rec_on (if_pos Hc) h

theorem implies_of_if_neg {c t e : Prop} [decidable c] (h : ite c t e) : ¬c → e :=
assume Hnc, eq.rec_on (if_neg Hnc) h

theorem if_ctx_congr {A : Type} {b c : Prop} [dec_b : decidable b] [dec_c : decidable c]
                     {x y u v : A}
                     (h_c : b ↔ c) (h_t : c → x = u) (h_e : ¬c → y = v) :
        ite b x y = ite c u v :=
decidable.rec_on dec_b
  (λ hp : b, calc
    ite b x y = x           : if_pos hp
         ...  = u           : h_t (iff.mp h_c hp)
         ...  = ite c u v : if_pos (iff.mp h_c hp))
  (λ hn : ¬b, calc
    ite b x y = y         : if_neg hn
         ...  = v         : h_e (iff.mp (not_iff_not_of_iff h_c) hn)
         ...  = ite c u v : if_neg (iff.mp (not_iff_not_of_iff h_c) hn))

theorem if_congr [congr] {A : Type} {b c : Prop} [dec_b : decidable b] [dec_c : decidable c]
                 {x y u v : A}
                 (h_c : b ↔ c) (h_t : x = u) (h_e : y = v) :
        ite b x y = ite c u v :=
@if_ctx_congr A b c dec_b dec_c x y u v h_c (λ h, h_t) (λ h, h_e)

theorem if_ctx_simp_congr {A : Type} {b c : Prop} [dec_b : decidable b] {x y u v : A}
                        (h_c : b ↔ c) (h_t : c → x = u) (h_e : ¬c → y = v) :
        ite b x y = (@ite c (decidable_of_decidable_of_iff dec_b h_c) A u v) :=
@if_ctx_congr A b c dec_b (decidable_of_decidable_of_iff dec_b h_c) x y u v h_c h_t h_e

theorem if_simp_congr [congr] {A : Type} {b c : Prop} [dec_b : decidable b] {x y u v : A}
                 (h_c : b ↔ c) (h_t : x = u) (h_e : y = v) :
        ite b x y = (@ite c (decidable_of_decidable_of_iff dec_b h_c) A u v) :=
@if_ctx_simp_congr A b c dec_b x y u v h_c (λ h, h_t) (λ h, h_e)

definition if_true [simp] {A : Type} (t e : A) : (if true then t else e) = t :=
if_pos trivial

definition if_false [simp] {A : Type} (t e : A) : (if false then t else e) = e :=
if_neg not_false

theorem if_ctx_congr_prop {b c x y u v : Prop} [dec_b : decidable b] [dec_c : decidable c]
                      (h_c : b ↔ c) (h_t : c → (x ↔ u)) (h_e : ¬c → (y ↔ v)) :
        ite b x y ↔ ite c u v :=
decidable.rec_on dec_b
  (λ hp : b, calc
    ite b x y ↔ x         : iff.of_eq (if_pos hp)
         ...  ↔ u         : h_t (iff.mp h_c hp)
         ...  ↔ ite c u v : iff.of_eq (if_pos (iff.mp h_c hp)))
  (λ hn : ¬b, calc
    ite b x y ↔ y         : iff.of_eq (if_neg hn)
         ...  ↔ v         : h_e (iff.mp (not_iff_not_of_iff h_c) hn)
         ...  ↔ ite c u v : iff.of_eq (if_neg (iff.mp (not_iff_not_of_iff h_c) hn)))

theorem if_congr_prop [congr] {b c x y u v : Prop} [dec_b : decidable b] [dec_c : decidable c]
                      (h_c : b ↔ c) (h_t : x ↔ u) (h_e : y ↔ v) :
        ite b x y ↔ ite c u v :=
if_ctx_congr_prop h_c (λ h, h_t) (λ h, h_e)

theorem if_ctx_simp_congr_prop {b c x y u v : Prop} [dec_b : decidable b]
                               (h_c : b ↔ c) (h_t : c → (x ↔ u)) (h_e : ¬c → (y ↔ v)) :
        ite b x y ↔ (@ite c (decidable_of_decidable_of_iff dec_b h_c) Prop u v) :=
@if_ctx_congr_prop b c x y u v dec_b (decidable_of_decidable_of_iff dec_b h_c) h_c h_t h_e

theorem if_simp_congr_prop [congr] {b c x y u v : Prop} [dec_b : decidable b]
                           (h_c : b ↔ c) (h_t : x ↔ u) (h_e : y ↔ v) :
        ite b x y ↔ (@ite c (decidable_of_decidable_of_iff dec_b h_c) Prop u v) :=
@if_ctx_simp_congr_prop b c x y u v dec_b h_c (λ h, h_t) (λ h, h_e)

theorem dif_pos {c : Prop} [H : decidable c] (Hc : c) {A : Type} {t : c → A} {e : ¬ c → A} : dite c t e = t Hc :=
decidable.rec
  (λ Hc : c,    eq.refl (@dite c (decidable.inl Hc) A t e))
  (λ Hnc : ¬c,  absurd Hc Hnc)
  H

theorem dif_neg {c : Prop} [H : decidable c] (Hnc : ¬c) {A : Type} {t : c → A} {e : ¬ c → A} : dite c t e = e Hnc :=
decidable.rec
  (λ Hc : c,    absurd Hc Hnc)
  (λ Hnc : ¬c,  eq.refl (@dite c (decidable.inr Hnc) A t e))
  H

theorem dif_ctx_congr {A : Type} {b c : Prop} [dec_b : decidable b] [dec_c : decidable c]
                      {x : b → A} {u : c → A} {y : ¬b → A} {v : ¬c → A}
                      (h_c : b ↔ c)
                      (h_t : ∀ (h : c),    x (iff.mpr h_c h)                      = u h)
                      (h_e : ∀ (h : ¬c),   y (iff.mpr (not_iff_not_of_iff h_c) h) = v h) :
        (@dite b dec_b A x y) = (@dite c dec_c A u v) :=
decidable.rec_on dec_b
  (λ hp : b, calc
    dite b x y = x hp                            : dif_pos hp
          ...  = x (iff.mpr h_c (iff.mp h_c hp)) : proof_irrel
          ...  = u (iff.mp h_c hp)               : h_t
          ...  = dite c u v                      : dif_pos (iff.mp h_c hp))
  (λ hn : ¬b, let h_nc : ¬b ↔ ¬c := not_iff_not_of_iff h_c in calc
    dite b x y = y hn                              : dif_neg hn
          ...  = y (iff.mpr h_nc (iff.mp h_nc hn)) : proof_irrel
          ...  = v (iff.mp h_nc hn)                : h_e
          ...  = dite c u v                        : dif_neg (iff.mp h_nc hn))

theorem dif_ctx_simp_congr {A : Type} {b c : Prop} [dec_b : decidable b]
                         {x : b → A} {u : c → A} {y : ¬b → A} {v : ¬c → A}
                         (h_c : b ↔ c)
                         (h_t : ∀ (h : c),    x (iff.mpr h_c h)                      = u h)
                         (h_e : ∀ (h : ¬c),   y (iff.mpr (not_iff_not_of_iff h_c) h) = v h) :
        (@dite b dec_b A x y) = (@dite c (decidable_of_decidable_of_iff dec_b h_c) A u v) :=
@dif_ctx_congr A b c dec_b (decidable_of_decidable_of_iff dec_b h_c) x u y v h_c h_t h_e

-- Remark: dite and ite are "definitionally equal" when we ignore the proofs.
theorem dite_ite_eq (c : Prop) [decidable c] {A : Type} (t : A) (e : A) : dite c (λh, t) (λh, e) = ite c t e :=
rfl

definition is_true (c : Prop) [decidable c] : Prop :=
if c then true else false

definition is_false (c : Prop) [decidable c] : Prop :=
if c then false else true

definition of_is_true {c : Prop} [H₁ : decidable c] (H₂ : is_true c) : c :=
decidable.rec_on H₁ (λ Hc, Hc) (λ Hnc, !false.rec (if_neg Hnc ▸ H₂))

notation `dec_trivial` := of_is_true trivial

theorem not_of_not_is_true {c : Prop} [decidable c] (H : ¬ is_true c) : ¬ c :=
if Hc : c then absurd trivial (if_pos Hc ▸ H) else Hc

theorem not_of_is_false {c : Prop} [decidable c] (H : is_false c) : ¬ c :=
if Hc : c then !false.rec (if_pos Hc ▸ H) else Hc

theorem of_not_is_false {c : Prop} [decidable c] (H : ¬ is_false c) : c :=
if Hc : c then Hc else absurd trivial (if_neg Hc ▸ H)

-- The following symbols should not be considered in the pattern inference procedure used by
-- heuristic instantiation.
attribute and or not iff ite dite eq ne heq [no_pattern]

-- namespace used to collect congruence rules for "contextual simplification"
namespace contextual
  attribute if_ctx_simp_congr      [congr]
  attribute if_ctx_simp_congr_prop [congr]
  attribute dif_ctx_simp_congr     [congr]
end contextual


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

Given a poset `P`, we define `subdiv P` to be the poset of
finite nonempty chains `s ⊆ P`.  Any such `s` has a largest
element, and the map `max : (subdiv P) → P` is a morphism
of posets.  There is an approach to the homotopy theory of
finite complexes based on finite posets, and the above map
`max` plays a key role in this.
-/

import data.list.sort data.fintype.basic
import poset.basic order.sort_rank

universes uP uQ uR uS

variables (P : Type uP) [partial_order P] [decidable_eq P]
variables (Q : Type uQ) [partial_order Q] [decidable_eq Q]
variables (R : Type uR) [partial_order R] [decidable_eq R]
variables (S : Type uS) [partial_order S] [decidable_eq S]

variable [decidable_rel (has_le.le : P → P → Prop)]
variable [decidable_rel (has_le.le : Q → Q → Prop)]
variable [decidable_rel (has_le.le : R → R → Prop)]
variable [decidable_rel (has_le.le : S → S → Prop)]

namespace poset
open poset

variables {P} [fintype P]

/-- Definition of chains
  LaTeX: defn-subdiv
-/
def is_chain (s : finset P) : Prop :=
 ∀ (p ∈ s) (q ∈ s), (p ≤ q ∨ q ≤ p)

instance decidable_is_chain (s : finset P) : decidable (is_chain s) :=
by { unfold is_chain, apply_instance }

/-- Definition of simplices as nonempty chains
  LaTeX: defn-subdiv
-/
def is_simplex (s : finset P) : Prop := s.nonempty ∧ (is_chain s)

instance decidable_is_simplex (s : finset P) : decidable (is_simplex s) :=
by { unfold is_simplex, unfold finset.nonempty, apply_instance }

variable (P)

/-- Definition of subdiv P as a type
  LaTeX: defn-subdiv
-/
def subdiv := {s : finset P // is_simplex s}

instance : has_coe (subdiv P) (finset P) := ⟨subtype.val⟩

/-- Vertices as 0-simplices -/
variable {P}
def vertex (p : P) : subdiv P := ⟨
{p},
begin
  split,
  {exact ⟨p,finset.mem_singleton_self p⟩},
  {intros x hx y hy,
   rw [finset.mem_singleton.mp hx, finset.mem_singleton.mp hy],
   left, exact le_refl p }
end⟩
variable (P)

namespace subdiv

instance : decidable_eq (subdiv P) :=
  by { unfold subdiv, apply_instance }

/-- Definition of the partial order on subdiv P
  LaTeX: defn-subdiv
-/
instance : partial_order (subdiv P) :=
{ le := λ s t, s.val ⊆ t.val,
  le_refl := λ s, (le_refl s.val),
  le_antisymm := λ s t hst hts, subtype.eq (le_antisymm hst hts),
  le_trans := λ s t u (hst : s.val ⊆ t.val) (htu : t.val ⊆ u.val) p hs,
                (htu (hst hs)) }

instance decidable_le : decidable_rel
 (has_le.le : (subdiv P) → (subdiv P) → Prop) :=
  λ s t, by { apply_instance }

variable {P}

/-- Definition of the dimension of a simplex, as one less than
  the cardinality.  We use the predecessor operation on
  natural numbers, which sends zero to zero.  Because of this,
  we need a small argument to show that the cardinality is
  strictly positive and thus equal to one more than the dimension.

  LaTeX: defn-subdiv
-/
def dim (s : subdiv P) : ℕ := (s : finset P).card.pred

lemma card_eq (s : subdiv P) : (s : finset P).card = s.dim.succ :=
begin
  by_cases h : s.val.card = 0,
  { exfalso,
    have h₀ := s.property.left, rw[finset.card_eq_zero.mp h] at h₀,
    exact finset.not_nonempty_empty h₀},
  { replace h := nat.pos_of_ne_zero h,
    exact (nat.succ_pred_eq_of_pos h).symm }
end

/-- The dimension function dim : subdiv P → ℕ is monotone. -/
lemma dim_mono : monotone (dim : (subdiv P) → ℕ) :=
begin
  intros s t hst,
  let h : (s : finset P).card ≤ (t : finset P).card := finset.card_le_of_subset hst,
  rw[card_eq,card_eq] at h,
  exact nat.le_of_succ_le_succ h
end

/-- If we have simplices s ≤ t with dim s ≥ dim t then s = t. -/
lemma eq_of_le_of_dim_ge (s t : subdiv P)
 (hst : s ≤ t) (hd : s.dim ≥ t.dim) : s = t :=
begin
  let hc := nat.succ_le_succ hd,
  rw [← card_eq, ← card_eq] at hc,
  exact subtype.eq (finset.eq_of_subset_of_card_le hst hc)
end

/-- This allows us to treat a simplex as a type in its own right. -/
instance : has_coe_to_sort (subdiv P) (Type uP) := ⟨λ s, {p : P // p ∈ s.val}⟩

section els

variable (s : subdiv P)

instance els_decidable_eq : decidable_eq s := by { apply_instance }
instance els_fintype : fintype s           := by { apply_instance }

lemma card_eq' : fintype.card s = s.dim.succ := begin
 rw[← s.card_eq], rw[← fintype.card_coe],congr
end

/-- If s is a simplex, we can treat it as a linearly ordered set. -/
instance els_order : linear_order s :=
{ le := λ p q,p.val ≤ q.val,
  le_refl := λ p, ((le_refl (p.val : P)) : p.val ≤ p.val),
  le_antisymm := λ p q (hpq : p.val ≤ q.val) (hqp : q.val ≤ p.val),
                 subtype.eq (le_antisymm hpq hqp),
  le_trans := λ p q r (hpq : p.val ≤ q.val) (hqr : q.val ≤ r.val),
                 le_trans hpq hqr,
  le_total := λ p q,s.property.right p.val p.property q.val q.property,
  lt := λ p q,p.val < q.val,
  lt_iff_le_not_le := λ p q,
  begin
    change p.val < q.val ↔ p.val ≤ q.val ∧ ¬ q.val ≤ p.val,
    apply lt_iff_le_not_le,
  end,
  decidable_le := λ p q, by { apply_instance } }

variable {s}

/-- The inclusion of a simplex in the full poset P. -/
def inc : s → P := λ p, p.val

/-- The inclusion map is injective. -/
lemma inc_inj (p₀ p₁ : s) : (inc p₀) = (inc p₁) → p₀ = p₁ := subtype.eq

/-- The inclusion map is monotone. -/
lemma inc_mono : monotone (inc : s → P) := λ p₀ p₁ hp, hp

variable (s)
variables {d : ℕ} (e : s.dim = d)

/-- If dim s = d, then we have a canonical bijection from s
  to the set  fin d.succ = { 0,1,...,d }.  We define
  rank_equiv s to be a package consisting of this bijection
  and its inverse.  We define seq s and rank s to be
  auxiliary functions defined in terms of rank_equiv s,
  and we prove some lemmas about the behaviour of these.
-/

def rank_equiv : s ≃ fin d.succ :=
 fintype.rank_equiv (s.card_eq'.trans (congr_arg nat.succ e))

def seq : (fin d.succ) → P := λ i, inc ((rank_equiv s e).inv_fun i)

def rank (p : P) (hp : p ∈ s.val) : fin d.succ :=
 (rank_equiv s e).to_fun ⟨p,hp⟩

lemma seq_mem (i : fin d.succ) : seq s e i ∈ s.val :=
  ((rank_equiv s e).inv_fun i).property

lemma seq_rank (p : P) (hp : p ∈ s.val) :
 seq s e (rank s e p hp) = p :=
  congr_arg inc ((rank_equiv s e).left_inv ⟨p,hp⟩)

lemma seq_eq (i : fin d.succ) :
 ((rank_equiv s e).symm i) = ⟨seq s e i,seq_mem s e i⟩ :=
  by { apply subtype.eq, refl }

lemma rank_seq (i : fin d.succ) :
 rank s e (seq s e i) (seq_mem s e i) = i :=
begin
  dsimp [rank],
  rw [← (seq_eq s e i)],
  exact (rank_equiv s e).right_inv i,
end

lemma seq_le (i₀ i₁ : fin d.succ) :
 i₀ ≤ i₁ ↔ seq s e i₀ ≤ seq s e i₁ :=
  fintype.seq_le (s.card_eq'.trans (congr_arg nat.succ e)) i₀ i₁

lemma seq_lt (i₀ i₁ : fin d.succ) :
 i₀ < i₁ ↔ seq s e i₀ < seq s e i₁ :=
  fintype.seq_lt (s.card_eq'.trans (congr_arg nat.succ e)) i₀ i₁

variables {P Q} [fintype Q]

def map (f : poset.hom P Q) : (poset.hom (subdiv P) (subdiv Q)) :=
begin
  let sf : subdiv P → subdiv Q := λ s,
  begin
    let t0 : finset Q := s.val.image f.val,
    have : is_simplex t0 :=
    begin
      split,
      { rcases s.property.1 with ⟨p,p_in_s⟩,
        exact ⟨_,(finset.mem_image_of_mem f.val p_in_s)⟩ },
      { intros q₀ hq₀ q₁ hq₁,
        rcases finset.mem_image.mp hq₀ with ⟨p₀,hp₀,hfp₀⟩,
        rcases finset.mem_image.mp hq₁ with ⟨p₁,hp₁,hfp₁⟩,
        rw [← hfp₀, ← hfp₁],
        rcases s.property.2 p₀ hp₀ p₁ hp₁ with h₀₁ | h₁₀,
        { left,  exact f.property h₀₁ },
        { right, exact f.property h₁₀ } }
    end,
    exact ⟨t0,this⟩
  end,
  have : monotone sf := λ s₀ s₁ hs,
  begin
    change s₀.val.image f.val ⊆ s₁.val.image f.val,
    intros q hq,
    rcases finset.mem_image.mp hq with ⟨p,hp,hfp⟩,
    exact finset.mem_image.mpr ⟨p,hs hp,hfp⟩
  end,
  exact ⟨sf, this⟩
end

lemma map_val (f : poset.hom P Q) (s : subdiv P) :
 ((subdiv.map f).val s).val = s.val.image f.val := rfl

section interleave

variables [fintype P] {f g : poset.hom P Q} (hfg : f ≤ g)
include hfg

def interleave :
 ∀ (r : fin_ranking P) (m : ℕ), hom (subdiv P) (subdiv Q)
| ⟨n,r,r_mono⟩ m :=
  ⟨ λ (σ : subdiv P),
    ⟨ ((σ.val.filter (λ p, 2 * (r p).val < m)).image f) ∪
      ((σ.val.filter (λ p, 2 * (r p).val + 1 ≥ m)).image g),
      begin
        split,
        { rcases σ.property.1 with ⟨p, p_in_σ⟩,
          by_cases h : 2 * (r p).val < m,
          { use f p,
            apply finset.mem_union_left,
            apply finset.mem_image_of_mem,
            rw [finset.mem_filter],
            exact ⟨p_in_σ, h⟩ },
          { replace h := le_trans (le_of_not_gt h) (nat.le_succ _),
            use (g p),
            apply finset.mem_union_right,
            apply finset.mem_image_of_mem,
            rw [finset.mem_filter],
            exact ⟨p_in_σ, h⟩ } },
        { intros q₀ h₀ q₁ h₁,
          rcases finset.mem_union.mp h₀ with h₀ | h₀;
          rcases finset.mem_union.mp h₁ with h₁ | h₁;
          rcases finset.mem_image.mp h₀ with ⟨p₀,hf₀,he₀⟩;
          rcases finset.mem_image.mp h₁ with ⟨p₁,hf₁,he₁⟩;
          rw [finset.mem_filter] at hf₀ hf₁;
          rw [← he₀, ← he₁];
          let r₀ := (r p₀).val ; let r₁ := (r p₁).val ;
          rcases σ.property.right p₀ hf₀.1 p₁ hf₁.1 with hpp | hpp;
          let hfpp := f.property hpp;
          let hgpp := g.property hpp,
          { left , exact hfpp },
          { right, exact hfpp },
          { left , exact le_trans hfpp (hfg p₁) },
          { by_cases hrr : r₀ = r₁,
            { rw [r.injective (fin.eq_of_veq hrr)],
              left, exact hfg p₁ },
            { exfalso,
              change r₀ ≠ r₁ at hrr,
              replace hrr : r₁ < r₀ := lt_of_le_of_ne (r_mono hpp) hrr.symm,
              change r₁ + 1 ≤ r₀ at hrr,
              have := calc
                2 * r₁ + 2 = 2 * (r₁ + 1) : by rw [mul_add, mul_one]
                ... ≤ 2 * r₀ : nat.mul_le_mul_left 2 hrr
                ... < m : hf₀.2
                ... ≤ 2 * r₁ + 1 : hf₁.2
                ... < 2 * r₁ + 2 : nat.lt_succ_self _,
              exact lt_irrefl _ this } },
          { by_cases hrr : r₀ = r₁,
            { rw [r.injective (fin.eq_of_veq hrr)],
              right, exact hfg p₁ },
            { exfalso,
              change r₀ ≠ r₁ at hrr,
              replace hrr : r₀ < r₁ := lt_of_le_of_ne (r_mono hpp) hrr,
              change r₀ + 1 ≤ r₁ at hrr,
              have := calc
                2 * r₁ < m : hf₁.2
                ... ≤ 2 * r₀ + 1 : hf₀.2
                ... < 2 * r₀ + 2 : nat.lt_succ_self _
                ... = 2 * (r₀ + 1) : by rw [mul_add, mul_one]
                ... ≤ 2 * r₁ : nat.mul_le_mul_left 2 hrr,
              exact lt_irrefl _ this } },
          { right, exact le_trans hfpp (hfg p₀) },
          { left , exact hgpp },
          { right, exact hgpp } }
      end ⟩,
      begin
        intros σ₀ σ₁ h_le q hq,
        rw [finset.mem_union] at hq ⊢,
        rcases hq with hq | hq;
        rcases finset.mem_image.mp hq with ⟨p,hm,he⟩;
        rw [← he];
        rw [finset.mem_filter] at hm;
        replace hm := and.intro (h_le hm.1) hm.2,
        { left , apply finset.mem_image_of_mem,
          rw [finset.mem_filter], exact hm },
        { right, apply finset.mem_image_of_mem,
          rw [finset.mem_filter], exact hm }
      end ⟩

lemma interleave_start :
 ∀ (r : fin_ranking P), interleave hfg r 0 = subdiv.map g
| ⟨n,r,r_mono⟩ :=
begin
  ext1 σ,
  apply subtype.eq,
  change _ ∪ _ = σ.val.image g.val,
  ext q,
  have : σ.val.filter (λ (p : P), 2 * (r p).val < 0) = ∅ :=
  begin
    ext p, rw [finset.mem_filter],
    simp [nat.not_lt_zero, finset.not_mem_empty]
  end,
  rw [this, finset.image_empty],
  have : σ.val.filter (λ (p : P), 2 * (r p).val + 1 ≥ 0) = σ.val :=
  begin
    ext p, rw [finset.mem_filter],
    have : _ ≥ 0 := nat.zero_le (2 * (r p).val + 1),
    simp only [this, and_true]
  end,
  rw [this, finset.mem_union],
  have : (g : P → Q) = g.val := rfl, rw [this],
  simp [finset.not_mem_empty],
end

lemma interleave_end :
 ∀ (r : fin_ranking P) (m : ℕ) (hm : m ≥ 2 * r.card),
  interleave hfg r m = subdiv.map f
| ⟨n,r,r_mono⟩ m hm :=
begin
  change m ≥ 2 * n at hm,
  ext1 σ,
  apply subtype.eq,
  change _ ∪ _ = σ.val.image f.val,
  ext q,
  have : σ.val.filter (λ (p : P), 2 * (r p).val < m) = σ.val :=
  begin
    ext p, rw [finset.mem_filter],
    have := calc
      2 * (r p).val < 2 * n :
        nat.mul_lt_mul_of_pos_left (r p).is_lt (dec_trivial : 2 > 0)
      ... ≤ m : hm,
    simp only [this,and_true],
  end,
  rw [this],
  have : σ.val.filter (λ (p : P), 2 * (r p).val + 1 ≥ m) = ∅ :=
  begin
    ext p, rw [finset.mem_filter],
    have := calc
      2 * (r p).val + 1 < 2 * (r p).val + 2 : nat.lt_succ_self _
      ... = 2 * ((r p).val + 1) : by rw [mul_add, mul_one]
      ... ≤ 2 * n : nat.mul_le_mul_left 2 (r p).is_lt
      ... ≤ m : hm,
    have : ¬ (_ ≥ m) := not_le_of_gt this,
    simp only [this, finset.not_mem_empty, and_false]
  end,
  rw [this, finset.image_empty, finset.union_empty],
  have : (f : P → Q) = f.val := rfl, rw [this]
end

lemma interleave_even_step :
 ∀ (r : fin_ranking P) (k : ℕ),
  interleave hfg r (2 * k) ≤ interleave hfg r (2 * k + 1)
| ⟨n,r,r_mono⟩ k :=
begin
  intros σ q h,
  change q ∈ _ ∪ _ at h,
  change q ∈ _ ∪ _,
  rw [finset.mem_union] at h ⊢,
  rcases h with h | h;
  rcases finset.mem_image.mp h with ⟨p,hf,he⟩;
  rw [finset.mem_filter] at hf;
  rw [← he],
  { left,
    apply finset.mem_image_of_mem,
    rw [finset.mem_filter],
    exact ⟨hf.1, lt_trans hf.2 (nat.lt_succ_self _)⟩ },
  { right,
    apply finset.mem_image_of_mem,
    rw [finset.mem_filter],
    rcases le_or_gt k (r p).val with hk | hk,
    { exact ⟨hf.1, nat.succ_le_succ (nat.mul_le_mul_left 2 hk)⟩ },
    { exfalso,
      have := calc
        2 * (r p).val + 2 = 2 * ((r p).val + 1) : by rw [mul_add, mul_one]
        ... ≤ 2 * k : nat.mul_le_mul_left 2 hk
        ... ≤ 2 * (r p).val + 1 : hf.2
        ... < 2 * (r p).val + 2 : nat.lt_succ_self _,
      exact lt_irrefl _ this } }
end

lemma interleave_odd_step :
 ∀ (r : fin_ranking P) (k : ℕ),
  interleave hfg r (2 * k + 2) ≤ interleave hfg r (2 * k + 1)
| ⟨n,r,r_mono⟩ k :=
begin
  intros σ q h,
  change q ∈ _ ∪ _ at h,
  change q ∈ _ ∪ _,
  rw [finset.mem_union] at h ⊢,
  rcases h with h | h;
  rcases finset.mem_image.mp h with ⟨p,hf,he⟩;
  rw [finset.mem_filter] at hf;
  rw [← he],
  { left,
    apply finset.mem_image_of_mem,
    rw [finset.mem_filter],
    rcases le_or_gt (r p).val k with hk | hk,
    { have := calc
       2 * (r p).val ≤ 2 * k : nat.mul_le_mul_left 2 hk
       ... < 2 * k + 1 : nat.lt_succ_self _,
      exact ⟨hf.1, this⟩ },
    { exfalso,
      have := calc
        2 * k + 2 = 2 * (k + 1) : by rw [mul_add, mul_one]
        ... ≤ 2 * (r p).val : nat.mul_le_mul_left 2 hk
        ... < 2 * k + 2 : hf.2,
      exact lt_irrefl _ this } },
  { right,
    apply finset.mem_image_of_mem,
    rw [finset.mem_filter],
    exact ⟨hf.1, le_trans (le_of_lt (nat.lt_succ_self (2 * k + 1))) hf.2⟩ }
end

lemma interleave_component (r : fin_ranking P) (m : ℕ) :
  component (interleave hfg r m) = component (interleave hfg r 0) :=
zigzag (interleave hfg r)
  (interleave_even_step hfg r)
  (interleave_odd_step hfg r) m

end interleave

def subdiv.mapₕ [fintype P] :
  π₀ (hom P Q) → π₀ (hom (subdiv P) (subdiv Q)) :=
π₀.lift (λ f, component (subdiv.map f))
begin
  intros f g hfg,
  rcases exists_fin_ranking P with ⟨r⟩,
  let n := r.card,
  let c := interleave hfg r,
  have : c 0 = subdiv.map g := interleave_start hfg r,
  rw [← this],
  have : c (2 * n) = subdiv.map f := interleave_end hfg r (2 * n) (le_refl _),
  rw [← this],
  apply interleave_component
end

/-- For a simplex s, we define max s to be the largest element. -/

def max₀ : P := seq s rfl (fin.last s.dim)

lemma max₀_mem : s.max₀ ∈ s.val := seq_mem s rfl (fin.last s.dim)

lemma le_max₀ (p : P) (hp : p ∈ s.val) : p ≤ s.max₀ :=
begin
  rw [← seq_rank s rfl p hp],
  apply (seq_le s rfl (rank s rfl p hp) (fin.last s.dim)).mp,
  apply fin.le_last
end

end els

/-- The function max : subdiv P → P is monotone. -/
lemma max₀_mono : monotone (max₀ : subdiv P → P) :=
  λ s t hst, t.le_max₀ s.max₀ (hst s.max₀_mem)

variable (P)

def max : hom (subdiv P) P := ⟨max₀,max₀_mono⟩

lemma max_mem (s : subdiv P) : max P s ∈ s.val := max₀_mem s

lemma le_max (s : subdiv P) (p : P) (hp : p ∈ s.val) : p ≤ max P s :=
le_max₀ s p hp

lemma max_vertex (p : P) : max P (vertex p) = p :=
 finset.mem_singleton.mp (max₀_mem (vertex p))

lemma max_cofinal : cofinalₕ (max P) :=
begin
  intro p,
  let C := comma (max P) p,
  let c : C := ⟨vertex p,by {rw[max_vertex]}⟩,
  let T := punit.{uP + 1},
  let f : hom C T := const C punit.star,
  let g : hom T C := const T c,
  have hfg : comp f g = id T :=
  by { ext t, rcases t, refl },
  let m₀ : C → C := λ x,
  begin
    let τ₀ := x.val.val ∪ {p},
    have h₀ : τ₀.nonempty := ⟨_,(finset.mem_union_right _ (finset.mem_singleton_self p))⟩,
    have h₁ : is_chain τ₀ := λ a ha b hb,
    begin
      rcases finset.mem_union.mp ha with hax | hap;
      rcases finset.mem_union.mp hb with hbx | hbp,
      { exact x.val.property.2 a hax b hbx },
      { left,
        rw [finset.mem_singleton.mp hbp],
        exact le_trans (le_max P x.val a hax) x.property },
      { right,
        rw [finset.mem_singleton.mp hap],
        exact le_trans (le_max P x.val b hbx) x.property },
      { left,
        rw [finset.mem_singleton.mp hbp],
        rw [finset.mem_singleton.mp hap] }
    end,
    let τ : subdiv P := ⟨τ₀,⟨h₀,h₁⟩⟩,
    have h₂ : max P τ ≤ p :=
    begin
      rcases finset.mem_union.mp (max_mem P τ) with h | h,
      { exact le_trans (le_max P x.val _ h) x.property },
      { rw [finset.mem_singleton.mp h] }
    end,
    exact ⟨τ,h₂⟩
  end,
  have m₀_mono : monotone m₀ := λ x₀ x₁ h,
  begin
    change x₀.val.val ⊆ x₁.val.val at h,
    change x₀.val.val ∪ {p} ⊆ x₁.val.val ∪ {p},
    intros a ha,
    rcases finset.mem_union.mp ha with hax | hap,
    { exact finset.mem_union_left _ (h hax) },
    { exact finset.mem_union_right _ hap }
  end,
  let m : hom C C := ⟨m₀,m₀_mono⟩,
  have hm₀ : comp g f ≤ m := λ x a ha,
  begin
    change a ∈ {p} at ha,
    change a ∈ x.val.val ∪ {p},
    exact finset.mem_union_right _ ha
  end,
  have hm₁ : id C ≤ m := λ x a ha,
  begin
    change a ∈ x.val.val at ha,
    change a ∈ x.val.val ∪ {p},
    exact finset.mem_union_left _ ha
  end,
  let hgf := (π₀.sound hm₀).trans (π₀.sound hm₁).symm,
  have e : equivₕ C T :=
  { to_fun := component f,
    inv_fun := component g,
    left_inv := hgf,
    right_inv := congr_arg component hfg },
  exact ⟨e⟩
end

end subdiv

end poset


import data.nat.basic

inductive weekday : Type
| sunday : weekday
| monday : weekday
| tuesday : weekday
| wednesday : weekday
| thursday : weekday
| friday : weekday
| saturday : weekday

#check weekday.sunday
#check weekday.monday

open weekday

#check sunday
#check monday

#check weekday.rec
#check weekday.rec_on
#check weekday.cases_on

namespace weekday
  @[reducible]
  private def cases_on := @weekday.cases_on

  def number_of_day (d : weekday) : nat :=
  cases_on d 1 2 3 4 5 6 7

 def next (d : weekday) : weekday :=
  weekday.cases_on d monday tuesday wednesday thursday friday
    saturday sunday

  def previous (d : weekday) : weekday :=
  weekday.cases_on d saturday sunday monday tuesday wednesday
    thursday friday

  #reduce next (next tuesday)
  #reduce next (previous tuesday)

  example : next (previous tuesday) = tuesday := rfl

  theorem next_previous (d: weekday) : next (previous d) = d :=
    by apply weekday.cases_on d; refl
end weekday

#reduce weekday.number_of_day weekday.sunday

open weekday (renaming cases_on → cases_on)

#reduce number_of_day sunday
#check cases_on

#check @nat.cases_on
#check @nat.rec_on

open nat

theorem zero_add' (n : ℕ) : 0 + n = n :=
nat.rec_on n rfl (λ n ih, by rw [add_succ, ih])

theorem zero_add'' (n : ℕ) : 0 + n = n :=
begin
apply n.rec_on,
  refl,
intros n ih,
calc
  0 + succ n = succ (0 + n) : rfl
  ... = succ n : by rw ih
end

theorem zero_add''' (n : ℕ) : 0 + n = n :=
begin
apply n.rec_on,
  refl,
intros n ih,
have : 0 + succ n = succ (0 + n),
  refl,
rw this,
rw ih
end

theorem add_assoc'' (m n k : ℕ) : m + n + k = m + (n + k) :=
begin
apply k.rec_on,
  refl,
intros k ih,
calc
  m + n + succ k = succ (m + n + k) : rfl
  ... = succ (m + (n + k)) : by rw ih
end

#print add_succ

theorem succ_add' (m n : nat) : succ m + n = succ (m + n) :=
begin
apply n.rec_on,
  refl,
intros n ih,
rw add_succ,
rw ih
end

theorem add_comm' (m n : nat) : m + n = n + m :=
begin
apply n.rec_on,
  rw add_zero,
  rw zero_add,
intros n ih,
rw succ_add',
rw ←ih
end

#check @list.rec
#check @list.rec_on

universe u

inductive list' (α : Type u)
| nil {} : list'
| cons : α → list' → list'

namespace list'

notation `⦃` l:(foldr `,` (h t, cons h t) nil) `⦄` := l

section
  open nat
  #check ([1, 2, 3, 4, 5] : list int)
end

end list'

variable p : ℕ → Prop

example (hz : p 0) (hs : ∀ n, p (succ n)) : ∀ n, p n :=
begin
  intro n,
  cases n,
  { exact hz },  -- goal is p 0
  apply hs       -- goal is a : ℕ ⊢ p (succ a)
end

example (n : ℕ) (h : n ≠ 0) : succ (pred n) = n :=
begin
  cases n with m,
  -- first goal: h : 0 ≠ 0 ⊢ succ (pred 0) = 0
    { apply (absurd rfl h) },
  -- second goal: h : succ m ≠ 0 ⊢ succ (pred (succ a)) = succ a
  reflexivity
end

example (hz : p 0) (hs : ∀ n, p (succ n)) (m k : ℕ) :
  p (m + 3 * k) :=
begin
  cases (m + 3 * k),
  { exact hz },  -- goal is p 0
  apply hs       -- goal is a : ℕ ⊢ p (succ a)
end

theorem zero_add_t (n : ℕ) : 0 + n = n :=
begin
induction n,
  case succ : n ih {
    rw add_succ,
    rw ih
  },

  case zero {
    refl
  }
end

example (m n k : ℕ) (h : succ (succ m) = succ (succ n)) :
  n + k = m + k :=
begin
  injection h with h',
  injection h' with h'',
  rw h''
end

example (m n k : ℕ) (h : succ (succ m) = succ (succ n)) :
  n + k = m + k :=
begin
  injections with h' h'',
  rw h''
end

example (m n : ℕ) (h : succ m = 0) : n = n + 7 :=
by injections

example (m n : ℕ) (h : succ m = 0) : n = n + 7 :=
by contradiction

example (h : 7 = 4) : false :=
by injections

mutual inductive even, odd
with even : ℕ → Prop
| even_zero : even 0
| even_succ : ∀ n, odd n → even (n + 1)
with odd : ℕ → Prop
| odd_succ : ∀ n, even n → odd (n + 1)

#print even
#print odd


import tactic
import analysis.normed_space.basic
import analysis.complex.basic
import analysis.calculus.deriv
import measure_theory.integral.interval_integral
noncomputable theory

section order

variables {α : Type*}[linear_order α]

lemma Ioo_subset_interval {a b :α}:
set.Ioo a b ⊆ set.interval a b :=
set.subset.trans set.Ioo_subset_Icc_self set.Icc_subset_interval

lemma Iio_inter_Icc {a b: α}:
set.Iio b ∩ set.Icc a b = set.Ico a b :=
by {rw subset_antisymm_iff, split,
rw [set.Iio, set.Icc, set.Ico], intros x x_in,
simp at x_in, simp, split, exact x_in.2.1,
exact x_in.1, rw set.subset_inter_iff, split,
exact set.Ico_subset_Iio_self,
exact set.Ico_subset_Icc_self,}

end order

section topology

universes u v

variables {α : Type u}{β : Type v}
variables [topological_space α]

-- modified from eventually_nhds_iff
lemma eventually_nhds_eq_iff {a : α} {f g : α → β} :
  (∀ᶠ x in nhds a, f x = g x) ↔ ∃ (t : set α), (∀ x ∈ t, f x = g x) ∧ is_open t ∧ a ∈ t :=
  mem_nhds_iff.trans $ by simp only [set.subset_def, exists_prop, set.mem_set_of_eq]

end topology

section complex

lemma continuous_on_log_of_upper_plane:
  continuous_on complex.log {z : ℂ | 0 ≤ z.im ∧ z≠ 0}:=
begin
  intros z z_in,
  simp at z_in,
  by_cases him:z.im=0,
  by_cases hre:z.re<0,
  {
    apply continuous_within_at.mono,
    exact complex.continuous_within_at_log_of_re_neg_of_im_zero
      hre him,
    simp, intros a a_in_1 a_in_2, exact a_in_1,
  },
  {
    apply continuous_at.continuous_within_at,
    apply continuous_at_clog,
    left, simp at hre, by_cases z.re=0,
    exfalso, exact z_in.2 (complex.ext h him),
    exact (ne.symm h).lt_of_le hre,
  },
  {
    apply continuous_at.continuous_within_at,
    apply continuous_at_clog,
    right, exact him,
  },
end

end complex

section integral

variables {E : Type}
[normed_add_comm_group E] [normed_space ℂ E] [complete_space E]

lemma interval_integrable_iff_integrable_Ico_of_le {μ:measure_theory.measure ℝ}
{f : ℝ → E} {a b : ℝ} (hab : a ≤ b) [measure_theory.has_no_atoms μ] :
  interval_integrable f μ a b ↔ measure_theory.integrable_on f (set.Ico a b) μ :=
begin
  rw interval_integrable_iff',
  split,
  have hinc: set.interval a b = (set.Ico a b) ∪ {b} := by rw [set.interval_of_le hab, set.Ico_union_right hab],
  rw hinc,
  intro condition,
  exact measure_theory.integrable_on.left_of_union condition,
  intro condition,
  apply integrable_on_Icc_iff_integrable_on_Ioo.2,
  have minab:min a b=a:= by rw [min_eq_left hab],
  have maxab:max a b=b:= by rw [max_eq_right hab],
  rw minab,
  rw maxab,
  cases decidable.em (a = b) with heq hneq,
  {rw [heq, set.Ioo_eq_empty _], simp, simp,},
  {
    have h : a < b := ne.lt_of_le hneq hab,
    have hinc:set.Ico a b= set.Ioo a b ∪ {a} := by rw [←set.Ioo_union_left h],
    rw hinc at condition,
    exact measure_theory.integrable_on.left_of_union condition,
  },
  exact _inst_4,
end

lemma interval_integrable_iff_integrable_Ioo_of_le {μ:measure_theory.measure ℝ}
{f : ℝ → E} {a b : ℝ} (hab : a ≤ b) [measure_theory.has_no_atoms μ] :
  interval_integrable f μ a b ↔ measure_theory.integrable_on f (set.Ioo a b) μ :=
begin
  rw interval_integrable_iff_integrable_Icc_of_le hab,
  exact integrable_on_Icc_iff_integrable_on_Ioo,
  exact _inst_4,
end

lemma integral_congr'''{μ:measure_theory.measure ℝ}{a b : ℝ}
{f g : ℝ → E} (hab : a ≤ b) (h : set.eq_on f g (set.Ioo a b))
[measure_theory.has_no_atoms μ] :
  ∫ x in a..b, f x ∂μ = ∫ x in a..b, g x ∂μ :=
begin
  repeat {rw interval_integral.integral_of_le hab,},
  repeat {rw measure_theory.set_integral_congr_set_ae
    measure_theory.Ioo_ae_eq_Ioc.symm,},
  exact measure_theory.set_integral_congr measurable_set_Ioo h,
  exact _inst_4, exact _inst_4,
end

lemma integral_congr' {μ:measure_theory.measure ℝ}{a b : ℝ}
{f g : ℝ → E} (hab : a ≤ b) (h : set.eq_on f g (set.Ioc a b)) :
  ∫ x in a..b, f x ∂μ = ∫ x in a..b, g x ∂μ :=
begin
let ha : ∫ (x : ℝ) in set.Ioc a b, f x ∂μ = ∫ (x : ℝ) in set.Ioc a b, g x ∂μ := measure_theory.set_integral_congr measurable_set_Ioc h,
  simp [interval_integral, hab],
  simp at ha,
  exact ha,
end

lemma integral_congr''  {a b : ℝ}{f g : ℝ → E}{a b : ℝ}
(hab : a ≤ b) (h : set.eq_on f g (set.Ico a b)) :
  ∫ x in a..b, f x = ∫ x in a..b, g x :=
begin
  let f' := λ x, f (- x),
  let g' := λ x, g (- x),
  have hf' : (λ x, f (- x))= (λ x, f' x) := by simp,
  have hg' : (λ x, g (- x))= (λ x, g' x) := by simp,
  have h1 : set.eq_on f' g' (set.Ioc (- b) (- a)) :=
    begin
      unfold set.eq_on,
      simp,
      intro x,
      let y := - x,
      have h_ : x = - y := by simp,
      rw h_,
      intros hy1 hy2,
      have hf' : f' (- y) = f y := by simp,
      have hg' : g' (- y) = g y := by simp,
      rw [hf', hg'],
      unfold set.eq_on at h,
      have hy1' := (iff.elim_right (mul_lt_mul_right_of_neg neg_one_lt_zero)) hy1,
      simp only [neg_mul_neg,mul_one] at hy1',
      have hy2' := (iff.elim_right (mul_le_mul_right_of_neg neg_one_lt_zero)) hy2,
      simp only [neg_mul_neg,mul_one] at hy2',
      have hy : y ∈ set.Ico a b :=
        begin
          unfold set.Ico,
          simp,
          exact and.intro hy2' hy1',
        end,
      exact h hy,
    end,
  have hba := (iff.elim_right (mul_le_mul_right_of_neg neg_one_lt_zero)) hab,
  simp only [mul_neg_one] at hba,
  have h2 : ∫ (x : ℝ) in -b..-a, f' x = ∫ (x : ℝ) in -b..-a, g' x := integral_congr' hba h1,
  rw [←hf', ←hg'] at h2,
  rw[interval_integral.integral_comp_neg] at h2,
  rw[interval_integral.integral_comp_neg] at h2,
  simp at h2,
  exact h2,
end

lemma volume_add_right (a : ℝ) :
  measure_theory.measure.map ((+) a) measure_theory.measure_space.volume =
  measure_theory.measure_space.volume :=
begin
  have t:=real.is_add_left_invariant_real_volume.map_add_left_eq_self,
  exact t a,
end

lemma integrable_comp_add_left {f:ℝ → E}{a b:ℝ}
(hf : interval_integrable f measure_theory.measure_space.volume a b)
(h : ℝ) :
  interval_integrable (λ x, f (h+x)) measure_theory.measure_space.volume (a-h) (b-h) :=
begin
  rw interval_integrable_iff' at hf ⊢,
  have A : measurable_embedding (λ x, (-h)+x) :=
    measurable_embedding_add_left (-h),
  rw [←volume_add_right (-h), measure_theory.integrable_on,
      ←measure_theory.integrable_on, measurable_embedding.integrable_on_map_iff A],
  convert hf using 1,
  { ext, simp, },
  { simp,},
end

/- The following codes are from Oliver Nash and Bhavik Mehta.
See Zulip discussion https://leanprover.zulipchat.com/#narrow/stream/217875-Is-there-code-for-X.3F/topic/ae.20measurable.20condition
-/
lemma interval_integrable_norm_iff {f : ℝ → E} {μ : measure_theory.measure ℝ} {a b : ℝ}
  (hf : measure_theory.ae_strongly_measurable f (μ.restrict (set.interval_oc a b))) :
  interval_integrable (λ t, ∥f t∥) μ a b ↔ interval_integrable f μ a b :=
begin
  simp_rw [interval_integrable_iff, measure_theory.integrable_on],
  exact measure_theory.integrable_norm_iff hf,
end

lemma smul_continuous_on
{μ : measure_theory.measure ℝ} {a b : ℝ} {f : ℝ → ℂ} {g : ℝ → E}
  (hf : measure_theory.ae_strongly_measurable f (μ.restrict (set.interval_oc a b)))
  (hg : continuous_on g (set.interval a b)) :
  measure_theory.ae_strongly_measurable (λ x, f x • g x) (μ.restrict (set.interval_oc a b)) :=
hf.smul ((hg.mono set.Ioc_subset_Icc_self).ae_strongly_measurable measurable_set_interval_oc)

lemma interval_integrable.smul_continuous_on
{μ : measure_theory.measure ℝ} {a b : ℝ} {f : ℝ → ℂ} {g : ℝ → E}
  (hf : interval_integrable f μ a b)
  (hg : continuous_on g (set.interval a b)) :
  interval_integrable (λ x, f x • g x) μ a b :=
begin
have hf' : measure_theory.ae_strongly_measurable (λ (t : ℝ), f t) (μ.restrict (set.interval_oc a b)),
  { -- Missing lemma for `Ioc a b` case.
    rcases le_or_gt a b with h | h,
    { convert hf.ae_strongly_measurable,
      exact set.interval_oc_of_le h, },
    { convert hf.ae_strongly_measurable',
      rw set.interval_oc_swap, -- Missing lemma `interval_oc_of_ge`
      exact set.interval_oc_of_le (le_of_lt h), }, },
  rw ← interval_integrable_norm_iff,
  { simp_rw norm_smul,
    refine interval_integrable.mul_continuous_on _ (continuous_norm.comp_continuous_on hg),
    simp at hf',
    rw interval_integrable_norm_iff hf',
    assumption, },
  exact smul_continuous_on hf' hg,
end

end integral


-- See: https://leanprover.github.io/logic_and_proof/first_order_logic_in_lean.html

-- My "hello, world" in Lean
-- Here "love" refers to romantic attraction only

constant Person : Type
  -- Domain of discourse

constant Loves : Person → Person → Prop
  -- (Loves a b) means "a loves b"

constant BetterThan : Person → Person → Person → Prop
  -- (BetterThan a b c) means "a thinks that b is better than c"

constant QZR : Person
  -- Me.

axiom exclusiveness :
  ∀(x y : Person), Loves x y → (∀z : Person, z ≠ y → ¬(Loves x z))
  -- Exclusiveness: Everyone loves at most one person.

axiom preference :
  ∀(x y z : Person), BetterThan x y z → (Loves x z → Loves x y)
  -- Preference: if x thinks that y is better than z,
  --             that means x will also fall in love with y if x appreciates z.

axiom shadowing :
  ∃y : Person, (y ≠ QZR ∧ (∀x : Person, BetterThan x y QZR))
  -- Shadowing: there is someone who is better than QZR in everyone's eyes.

theorem no_one_loves_QZR : ¬(∃x : Person, Loves x QZR) :=
-- (Tactic mode proof)
begin
  intros hx,
  cases hx with x hx,
  cases shadowing with y hy,
  cases hy with hy₁ hy₂,
  specialize hy₂ x,
  have hnxy : ¬Loves x y, {
    have hx₁ := (exclusiveness x QZR) hx,
    specialize hx₁ y,
    exact hx₁ hy₁,
  },
  have hxy : Loves x y, {
    have hy₃ := (preference x y QZR) hy₂ hx,
    exact hy₃,
  },
  exact hnxy hxy,
end

theorem no_one_loves_QZR' : ¬(∃x : Person, Loves x QZR) :=
-- (Term mode proof)
  λ ⟨x, hx⟩,
    let ⟨z, hz₁, hz₂⟩ := shadowing in
      (exclusiveness x QZR hx) z hz₁ (preference x z QZR (hz₂ x) hx)


import data.complex.basic
import data.fintype.basic
import data.matrix.basic
import linear_algebra.determinant
import linear_algebra.nonsingular_inverse
import tactic

noncomputable theory
open_locale classical
open_locale matrix
open_locale big_operators

universes u u'
variables {m n l : Type u} [fintype m] [fintype n] [fintype l]

local notation `Euc` := (n → ℂ)

namespace matrix
/-- Complex conjugate of a vector.-/
def conj (M : matrix m n ℂ) : matrix m n ℂ :=
λ i j, complex.conj (M i j)

@[simp]
lemma conj_val (M : matrix m n ℂ) (i j) : conj M i j = complex.conj (M i j) := rfl

def complex_transpose (M : matrix m n ℂ) : matrix n m ℂ :=
M.transpose.conj
end matrix

section complex_transpose
open complex matrix
/--
  Tell `simp` what the entries are in a transposed matrix.
-/
@[simp] lemma complex_transpose_val (M : matrix m n ℂ) (i j) : M.complex_transpose j i = complex.conj (M i j) := rfl

@[simp] lemma complex_transpose_transpose (M : matrix m n ℂ) :
  M.complex_transpose.complex_transpose = M :=
by ext; simp

@[simp] lemma complex_transpose_zero : (0 : matrix m n ℂ).complex_transpose = 0 :=
by ext; simp

@[simp] lemma complex_transpose_one [decidable_eq n] : (1 : matrix n n ℂ).complex_transpose = 1 :=
by ext; simp [matrix.one_val]; split_ifs; simp; cc

@[simp] lemma complex_transpose_add (M : matrix m n ℂ) (N : matrix m n ℂ) :
  (M + N).complex_transpose = M.complex_transpose + N.complex_transpose  :=
by ext; simp

@[simp] lemma complex_transpose_neg (M : matrix m n ℂ) :
  (- M).complex_transpose = - M.complex_transpose  :=
by ext; simp

@[simp] lemma complex_transpose_sub (M : matrix m n ℂ) (N : matrix m n ℂ) :
  (M - N).complex_transpose = M.complex_transpose - N.complex_transpose  :=
by ext; simp

@[simp] lemma complex_transpose_mul (M : matrix m n ℂ) (N : matrix n l ℂ) :
  (M ⬝ N).complex_transpose = N.complex_transpose ⬝ M.complex_transpose  :=
begin
  ext; simp, delta matrix.mul, delta matrix.dot_product, simp,
  -- rw add_monoid_hom.map_sum, -- I think this would work if re were a bundled hom
  {sorry},
  {sorry}
end

@[simp] lemma complex_transpose_smul (c : ℂ) (M : matrix m n ℂ) :
  (c • M).complex_transpose = complex.conj c • M.complex_transpose :=
by ext; simp

lemma det_complex_conj {M : matrix n n ℂ} :
  M.conj.det = M.det.conj :=
sorry

@[simp]
lemma det_complex_transpose {M : matrix n n ℂ} :
M.complex_transpose.det = complex.conj (M.det) :=
by {unfold matrix.complex_transpose, rw [det_complex_conj, matrix.det_transpose]}

end complex_transpose


-- Las irreflexivas y transitivas son asimétricas
-- ==============================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar que las relaciones irreflexivas y
-- transitivas son asimétricas.
-- ----------------------------------------------------

variable A : Type
variable R : A → A → Prop

-- #reduce irreflexive R
-- #reduce transitive R

-- 1ª demostración
example
  (h1 : irreflexive R)
  (h2 : transitive R)
  : ∀ x y, R x y → ¬ R y x :=
begin
  intros x y h3 h4,
  apply h1 x,
  apply h2 h3 h4,
end

-- 2ª demostración
example
  (h1 : irreflexive R)
  (h2 : transitive R)
  : ∀ x y, R x y → ¬ R y x :=
begin
  intros x y h3 h4,
  apply (h1 x) (h2 h3 h4),
end

-- 3ª demostración
example
  (h1 : irreflexive R)
  (h2 : transitive R)
  : ∀ x y, R x y → ¬ R y x :=
λ x y h3 h4, (h1 x) (h2 h3 h4)

-- 4ª demostración
example
  (h1 : irreflexive R)
  (h2 : transitive R)
  : ∀ x y, R x y → ¬ R y x :=
assume x y,
assume h3 : R x y,
assume h4 : R y x,
have h5 : R x x, from h2 h3 h4,
have h6 : ¬ R x x, from h1 x,
show false, from h6 h5


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Wrenna Robson
-/

import algebra.big_operators.basic
import linear_algebra.vandermonde
import ring_theory.polynomial.basic

/-!
# Lagrange interpolation

## Main definitions
* In everything that follows, `s : finset ι` is a finite set of indexes, with `v : ι → F` an
indexing of the field over some type. We call the image of v on s the interpolation nodes,
though strictly unique nodes are only defined when v is injective on s.
* `lagrange.basis_divisor x y`, with `x y : F`. These are the normalised irreducible factors of
the Lagrange basis polynomials. They evaluate to `1` at `x` and `0` at `y` when `x` and `y`
are distinct.
* `lagrange.basis v i` with `i : ι`: the Lagrange basis polynomial that evaluates to `1` at `v i`
and `0` at `v j` for `i ≠ j`.
* `lagrange.interpolate v r` where `r : ι → F` is a function from the fintype to the field: the
Lagrange interpolant that evaluates to `r i` at `x i` for all `i : ι`. The `r i` are the _values_
associated with the _nodes_`x i`.
* `lagrange.interpolate_at v f`, where `v : ι ↪ F` and `ι` is a fintype, and `f : F → F` is a
function from the field to itself: this is the Lagrange interpolant that evaluates to `f (x i)`
at `x i`, and so approximates the function `f`. This is just a special case of the general
interpolation, where the values are given by a known function `f`.
-/

open_locale polynomial big_operators

section polynomial_determination

namespace polynomial
variables {R : Type*} [comm_ring R] [is_domain R] {f g : R[X]}

section finset
open function fintype
variables (s : finset R)

theorem eq_zero_of_degree_lt_of_eval_finset_eq_zero (degree_f_lt : f.degree < s.card)
  (eval_f : ∀ x ∈ s, f.eval x = 0) : f = 0 :=
begin
  rw ← mem_degree_lt at degree_f_lt,
  simp_rw eval_eq_sum_degree_lt_equiv degree_f_lt at eval_f,
  rw ← degree_lt_equiv_eq_zero_iff_eq_zero degree_f_lt,
  exact matrix.eq_zero_of_forall_index_sum_mul_pow_eq_zero
    (injective.comp (embedding.subtype _).inj' (equiv_fin_of_card_eq (card_coe _)).symm.injective)
    (λ _, eval_f _ (finset.coe_mem _))
end

theorem eq_of_degree_sub_lt_of_eval_finset_eq (degree_fg_lt : (f - g).degree < s.card)
  (eval_fg : ∀ x ∈ s, f.eval x = g.eval x) : f = g :=
begin
  rw ← sub_eq_zero,
  refine eq_zero_of_degree_lt_of_eval_finset_eq_zero _ degree_fg_lt _,
  simp_rw [eval_sub, sub_eq_zero],
  exact eval_fg
end

theorem eq_of_degrees_lt_of_eval_finset_eq (degree_f_lt : f.degree < s.card)
  (degree_g_lt : g.degree < s.card) (eval_fg : ∀ x ∈ s, f.eval x = g.eval x) : f = g :=
begin
  rw ← mem_degree_lt at degree_f_lt degree_g_lt,
  refine eq_of_degree_sub_lt_of_eval_finset_eq _ _ eval_fg,
  rw ← mem_degree_lt, exact submodule.sub_mem _ degree_f_lt degree_g_lt
end

end finset

section indexed
open finset
variables {ι : Type*} {v : ι → R} (s : finset ι)

theorem eq_zero_of_degree_lt_of_eval_index_eq_zero (hvs : set.inj_on v s)
  (degree_f_lt : f.degree < s.card) (eval_f : ∀ i ∈ s, f.eval (v i) = 0) : f = 0 :=
begin
  classical,
  rw ← card_image_of_inj_on hvs at degree_f_lt,
  refine eq_zero_of_degree_lt_of_eval_finset_eq_zero _ degree_f_lt _,
  intros x hx,
  rcases mem_image.mp hx with ⟨_, hj, rfl⟩,
  exact eval_f _ hj
end

theorem eq_of_degree_sub_lt_of_eval_index_eq (hvs : set.inj_on v s)
  (degree_fg_lt : (f - g).degree < s.card) (eval_fg : ∀ i ∈ s, f.eval (v i) = g.eval (v i)) :
  f = g :=
begin
  rw ← sub_eq_zero,
  refine eq_zero_of_degree_lt_of_eval_index_eq_zero _ hvs degree_fg_lt _,
  simp_rw [eval_sub, sub_eq_zero],
  exact eval_fg
end

theorem eq_of_degrees_lt_of_eval_index_eq (hvs : set.inj_on v s) (degree_f_lt : f.degree < s.card)
  (degree_g_lt : g.degree < s.card) (eval_fg : ∀ i ∈ s, f.eval (v i) = g.eval (v i)) : f = g :=
begin
  refine eq_of_degree_sub_lt_of_eval_index_eq _ hvs _ eval_fg,
  rw ← mem_degree_lt at degree_f_lt degree_g_lt ⊢,
  exact submodule.sub_mem _ degree_f_lt degree_g_lt
end

end indexed

end polynomial

end polynomial_determination

noncomputable theory

namespace lagrange
open polynomial
variables {F : Type*} [field F]

section basis_divisor
variables {x y : F}
/-- `basis_divisor x y` is the unique linear or constant polynomial such that
when evaluated at `x` it gives `1` and `y` it gives `0` (where when `x = y` it is identically `0`).
Such polynomials are the building blocks for the Lagrange interpolants. -/
def basis_divisor (x y : F) : F[X] := C ((x - y)⁻¹) * (X - C (y))

lemma basis_divisor_self : basis_divisor x x = 0 :=
by simp only [basis_divisor, sub_self, inv_zero, map_zero, zero_mul]

lemma basis_divisor_inj (hxy : basis_divisor x y = 0) : x = y :=
begin
  simp_rw [basis_divisor, mul_eq_zero, X_sub_C_ne_zero, or_false,
            C_eq_zero, inv_eq_zero, sub_eq_zero] at hxy,
  exact hxy
end

@[simp] lemma basis_divisor_eq_zero_iff : basis_divisor x y = 0 ↔ x = y :=
⟨basis_divisor_inj, λ H, H ▸ basis_divisor_self⟩

lemma basis_divisor_ne_zero_iff : basis_divisor x y ≠ 0 ↔ x ≠ y :=
by rw [ne.def, basis_divisor_eq_zero_iff]

lemma degree_basis_divisor_of_ne (hxy : x ≠ y) : (basis_divisor x y).degree = 1 :=
begin
  rw [basis_divisor, degree_mul, degree_X_sub_C, degree_C, zero_add],
  exact inv_ne_zero (sub_ne_zero_of_ne hxy)
end

@[simp] lemma degree_basis_divisor_self : (basis_divisor x x).degree = ⊥ :=
by rw [basis_divisor_self, degree_zero]

lemma nat_degree_basis_divisor_self : (basis_divisor x x).nat_degree = 0 :=
by rw [basis_divisor_self, nat_degree_zero]

lemma nat_degree_basis_divisor_of_ne (hxy : x ≠ y) : (basis_divisor x y).nat_degree = 1 :=
nat_degree_eq_of_degree_eq_some (degree_basis_divisor_of_ne hxy)

@[simp] lemma eval_basis_divisor_right : eval y (basis_divisor x y) = 0 :=
by simp only [basis_divisor, eval_mul, eval_C, eval_sub, eval_X, sub_self, mul_zero]

lemma eval_basis_divisor_left_of_ne (hxy : x ≠ y) : eval x (basis_divisor x y) = 1 :=
begin
  simp only [basis_divisor, eval_mul, eval_C, eval_sub, eval_X],
  exact inv_mul_cancel (sub_ne_zero_of_ne hxy)
end

end basis_divisor

section basis
open finset
variables {ι : Type*} [decidable_eq ι] {s : finset ι} {v : ι → F} {i j : ι}

/-- Lagrange basis polynomials indexed by `s : finset ι`, defined at nodes `v i` for a
map `v : ι → F`. For `i, j ∈ s`, `basis s v i` evaluates to 0 at `v j` for `i ≠ j`. When
`v` is injective on `s`, `basis s v i` evaluates to 1 at `v i`. -/
protected def basis (s : finset ι) (v : ι → F) (i : ι) : F[X] :=
∏ j in s.erase i, basis_divisor (v i) (v j)

@[simp] theorem basis_empty : lagrange.basis ∅ v i = 1 := rfl

@[simp] theorem basis_singleton (i : ι) : lagrange.basis {i} v i = 1 :=
by rw [lagrange.basis, erase_singleton, prod_empty]

@[simp] theorem basis_pair_left (hij : i ≠ j) :
  lagrange.basis {i, j} v i = basis_divisor (v i) (v j) :=
by simp only [lagrange.basis, hij, erase_insert_eq_erase, erase_eq_of_not_mem,
              mem_singleton, not_false_iff, prod_singleton]

@[simp] theorem basis_pair_right (hij : i ≠ j) :
  lagrange.basis {i, j} v j = basis_divisor (v j) (v i) :=
by { rw pair_comm, exact basis_pair_left hij.symm }

lemma basis_ne_zero (hvs : set.inj_on v s) (hi : i ∈ s) : lagrange.basis s v i ≠ 0 :=
begin
  simp_rw [lagrange.basis, prod_ne_zero_iff, ne.def, mem_erase],
  rintros j ⟨hij, hj⟩,
  rw [basis_divisor_eq_zero_iff, hvs.eq_iff hi hj],
  exact hij.symm
end

@[simp] theorem eval_basis_self (hvs : set.inj_on v s) (hi : i ∈ s) :
  (lagrange.basis s v i).eval (v i) = 1 :=
begin
  rw [lagrange.basis, eval_prod],
  refine prod_eq_one (λ j H, _),
  rw eval_basis_divisor_left_of_ne,
  rcases mem_erase.mp H with ⟨hij, hj⟩,
  exact mt (hvs hi hj) hij.symm
end

@[simp] theorem eval_basis_of_ne (hij : i ≠ j) (hj : j ∈ s) :
  (lagrange.basis s v i).eval (v j) = 0 :=
begin
  simp_rw [lagrange.basis, eval_prod, prod_eq_zero_iff],
  exact ⟨j, ⟨mem_erase.mpr ⟨hij.symm, hj⟩, eval_basis_divisor_right⟩⟩
end

@[simp] theorem nat_degree_basis (hvs : set.inj_on v s) (hi : i ∈ s) :
  (lagrange.basis s v i).nat_degree = s.card - 1 :=
begin
  have H : ∀ j, j ∈ s.erase i → basis_divisor (v i) (v j) ≠ 0,
  { simp_rw [ne.def, mem_erase, basis_divisor_eq_zero_iff],
    exact λ j ⟨hij₁, hj⟩ hij₂, hij₁ (hvs hj hi hij₂.symm) },
  rw [← card_erase_of_mem hi, card_eq_sum_ones],
  convert nat_degree_prod _ _ H using 1,
  refine sum_congr rfl (λ j hj, (nat_degree_basis_divisor_of_ne _).symm),
  rw [ne.def, ← basis_divisor_eq_zero_iff],
  exact H _ hj
end

theorem degree_basis (hvs : set.inj_on v s) (hi : i ∈ s) :
  (lagrange.basis s v i).degree = ↑(s.card - 1) :=
by rw [degree_eq_nat_degree (basis_ne_zero hvs hi), nat_degree_basis hvs hi]

lemma sum_basis (hvs : set.inj_on v s) (hs : s.nonempty) : ∑ j in s, (lagrange.basis s v j) = 1 :=
begin
  refine eq_of_degrees_lt_of_eval_index_eq s hvs (lt_of_le_of_lt (degree_sum_le _ _) _) _ _,
  { rw finset.sup_lt_iff (with_bot.bot_lt_coe s.card),
    intros i hi,
    rw [degree_basis hvs hi, with_bot.coe_lt_coe],
    exact nat.pred_lt (card_ne_zero_of_mem hi) },
  { rw [degree_one, ← with_bot.coe_zero, with_bot.coe_lt_coe],
    exact nonempty.card_pos hs },
  { intros i hi,
    rw [eval_finset_sum, eval_one, ← add_sum_erase _ _ hi,
        eval_basis_self hvs hi, add_right_eq_self],
    refine sum_eq_zero (λ j hj, _),
    rcases mem_erase.mp hj with ⟨hij, hj⟩,
    rw eval_basis_of_ne hij hi }
end

lemma basis_divisor_add_symm {x y : F} (hxy : x ≠ y) : basis_divisor x y + basis_divisor y x = 1 :=
begin
  classical,
  rw [←sum_basis (set.inj_on_of_injective function.injective_id _) ⟨x, mem_insert_self _ {y}⟩,
      sum_insert (not_mem_singleton.mpr hxy), sum_singleton, basis_pair_left hxy,
      basis_pair_right hxy, id, id]
end

end basis

section interpolate
open finset
variables {ι : Type*} [decidable_eq ι] {s t : finset ι} {i j : ι} {v : ι → F} (r r' : ι → F)

/-- Lagrange interpolation: given a finset `s : finset ι`, a nodal map  `v : ι → F` injective on
`s` and a value function `r : ι → F`,  `interpolate s v r` is the unique
polynomial of degree `< s.card` that takes value `r i` on `v i` for all `i` in `s`. -/
@[simps]
def interpolate (s : finset ι) (v : ι → F) : (ι → F) →ₗ[F] F[X] :=
{ to_fun := λ r, ∑ i in s, C (r i) * (lagrange.basis s v i),
  map_add' := λ f g, by simp_rw [← finset.sum_add_distrib, ← add_mul,
                                 ← C_add, pi.add_apply],
  map_smul' := λ c f, by simp_rw [finset.smul_sum, C_mul', smul_smul,
                                  pi.smul_apply, ring_hom.id_apply, smul_eq_mul] }

@[simp] theorem interpolate_empty : interpolate ∅ v r = 0 :=
by rw [interpolate_apply, sum_empty]

@[simp] theorem interpolate_singleton : interpolate {i} v r = C (r i) :=
by rw [interpolate_apply, sum_singleton, basis_singleton, mul_one]

theorem interpolate_one (hvs : set.inj_on v s) (hs : s.nonempty) : interpolate s v 1 = 1 :=
by { simp_rw [interpolate_apply, pi.one_apply, map_one, one_mul], exact sum_basis hvs hs }

theorem eval_interpolate_at_node (hvs : set.inj_on v s) (hi : i ∈ s) :
  eval (v i) (interpolate s v r) = r i :=
begin
  rw [interpolate_apply, eval_finset_sum, ← add_sum_erase _ _ hi],
  simp_rw [eval_mul, eval_C, eval_basis_self hvs hi, mul_one, add_right_eq_self],
  refine sum_eq_zero (λ j H, _),
  rw [eval_basis_of_ne (mem_erase.mp H).1 hi, mul_zero]
end

theorem degree_interpolate_le (hvs : set.inj_on v s) : (interpolate s v r).degree ≤ ↑(s.card - 1) :=
begin
  refine (degree_sum_le _ _).trans _,
  rw finset.sup_le_iff,
  intros i hi,
  rw [degree_mul, degree_basis hvs hi],
  by_cases hr : r i = 0,
  { simpa only [hr, map_zero, degree_zero, with_bot.bot_add] using bot_le },
  { rw [degree_C hr, zero_add, with_bot.coe_le_coe] }
end

theorem degree_interpolate_lt (hvs : set.inj_on v s) : (interpolate s v r).degree < s.card :=
begin
  rcases eq_empty_or_nonempty s with rfl | h,
  { rw [interpolate_empty, degree_zero, card_empty],
    exact with_bot.bot_lt_coe _ },
  { refine lt_of_le_of_lt (degree_interpolate_le _ hvs) _,
    rw with_bot.coe_lt_coe,
    exact nat.sub_lt (nonempty.card_pos h) zero_lt_one }
end

theorem degree_interpolate_erase_lt (hvs : set.inj_on v s) (hi : i ∈ s) :
  (interpolate (s.erase i) v r).degree < ↑(s.card - 1) :=
begin
  rw ← finset.card_erase_of_mem hi,
  exact degree_interpolate_lt _ (set.inj_on.mono (coe_subset.mpr (erase_subset _ _)) hvs),
end

theorem values_eq_on_of_interpolate_eq (hvs : set.inj_on v s)
  (hrr' : interpolate s v r = interpolate s v r') : ∀ i ∈ s, r i = r' i :=
λ _ hi, by rw [← eval_interpolate_at_node r hvs hi, hrr', eval_interpolate_at_node r' hvs hi]

theorem interpolate_eq_of_values_eq_on (hrr' : ∀ i ∈ s, r i = r' i) :
  interpolate s v r = interpolate s v r' :=
sum_congr rfl (λ i hi, (by rw hrr' _ hi))

theorem interpolate_eq_iff_values_eq_on (hvs : set.inj_on v s) :
  interpolate s v r = interpolate s v r' ↔ ∀ i ∈ s, r i = r' i :=
⟨values_eq_on_of_interpolate_eq _ _ hvs, interpolate_eq_of_values_eq_on _ _⟩

theorem eq_interpolate {f : F[X]} (hvs : set.inj_on v s) (degree_f_lt : f.degree < s.card) :
  f = interpolate s v (λ i, f.eval (v i)) :=
eq_of_degrees_lt_of_eval_index_eq _ hvs degree_f_lt (degree_interpolate_lt _ hvs) $
λ i hi, (eval_interpolate_at_node _ hvs hi).symm

theorem eq_interpolate_of_eval_eq {f : F[X]} (hvs : set.inj_on v s)
  (degree_f_lt : f.degree < s.card) (eval_f : ∀ i ∈ s, f.eval (v i) = r i) :
  f = interpolate s v r :=
by { rw eq_interpolate hvs degree_f_lt, exact interpolate_eq_of_values_eq_on _ _ eval_f }

/--
This is the characteristic property of the interpolation: the interpolation is the
unique polynomial of `degree < fintype.card ι` which takes the value of the `r i` on the `v i`.
-/
theorem eq_interpolate_iff {f : F[X]} (hvs : set.inj_on v s) :
  (f.degree < s.card ∧ ∀ i ∈ s, eval (v i) f = r i) ↔ f = interpolate s v r :=
begin
  split; intro h,
  { exact eq_interpolate_of_eval_eq _ hvs h.1 h.2 },
  { rw h, exact ⟨degree_interpolate_lt _ hvs, λ _ hi, eval_interpolate_at_node _ hvs hi⟩ }
end

/-- Lagrange interpolation induces isomorphism between functions from `s`
and polynomials of degree less than `fintype.card ι`.-/
def fun_equiv_degree_lt (hvs : set.inj_on v s) : degree_lt F s.card ≃ₗ[F] (s → F) :=
{ to_fun := λ f i, f.1.eval (v i),
  map_add' := λ f g, funext $ λ v, eval_add,
  map_smul' := λ c f, funext $ by simp,
  inv_fun := λ r, ⟨interpolate s v (λ x, if hx : x ∈ s then r ⟨x, hx⟩ else 0),
                   mem_degree_lt.2 $ degree_interpolate_lt _ hvs⟩,
  left_inv :=
  begin
    rintros ⟨f, hf⟩,
    simp only [subtype.mk_eq_mk, subtype.coe_mk, dite_eq_ite],
    rw mem_degree_lt at hf,
    nth_rewrite_rhs 0 eq_interpolate hvs hf,
    exact interpolate_eq_of_values_eq_on _ _ (λ _ hi, if_pos hi)
  end,
  right_inv :=
  begin
    intro f,
    ext ⟨i, hi⟩,
    simp only [subtype.coe_mk, eval_interpolate_at_node _ hvs hi],
    exact dif_pos hi,
  end }

theorem interpolate_eq_sum_interpolate_insert_sdiff (hvt : set.inj_on v t) (hs : s.nonempty)
  (hst : s ⊆ t) : interpolate t v r =
  ∑ i in s, (interpolate (insert i (t \ s)) v r) * lagrange.basis s v i :=
begin
  symmetry,
  refine eq_interpolate_of_eval_eq _ hvt (lt_of_le_of_lt (degree_sum_le _ _) _) (λ i hi, _),
  { simp_rw [(finset.sup_lt_iff (with_bot.bot_lt_coe t.card)), degree_mul],
    intros i hi,
    have hs : 1 ≤ s.card := nonempty.card_pos ⟨_, hi⟩,
    have hst' : s.card ≤ t.card := card_le_of_subset hst,
    have H : t.card = (1 + (t.card - s.card)) + (s.card - 1),
    { rw [add_assoc, tsub_add_tsub_cancel hst' hs, ← add_tsub_assoc_of_le (hs.trans hst'),
          nat.succ_add_sub_one, zero_add] },
    rw [degree_basis (set.inj_on.mono hst hvt) hi, H, with_bot.coe_add,
        with_bot.add_lt_add_iff_right (@with_bot.coe_ne_bot _ (s.card - 1))],
    convert degree_interpolate_lt _ (hvt.mono (coe_subset.mpr (insert_subset.mpr
      ⟨hst hi, sdiff_subset _ _⟩))),
    rw [card_insert_of_not_mem (not_mem_sdiff_of_mem_right hi), card_sdiff hst, add_comm] },

  { simp_rw [eval_finset_sum, eval_mul],
    by_cases hi' : i ∈ s,
    { rw [← add_sum_erase _ _ hi', eval_basis_self (hvt.mono hst) hi',
          eval_interpolate_at_node _ (hvt.mono (coe_subset.mpr
            (insert_subset.mpr ⟨hi, sdiff_subset _ _⟩))) (mem_insert_self _ _),
          mul_one, add_right_eq_self],
      refine sum_eq_zero (λ j hj, _),
      rcases mem_erase.mp hj with ⟨hij, hj⟩,
      rw [eval_basis_of_ne hij hi', mul_zero] },
    { have H : ∑ j in s, eval (v i) (lagrange.basis s v j) = 1,
      { rw [← eval_finset_sum, sum_basis (hvt.mono hst) hs, eval_one] },
      rw [← mul_one (r i), ← H, mul_sum],
      refine sum_congr rfl (λ j hj, _),
      congr,
      exact eval_interpolate_at_node _ (hvt.mono (insert_subset.mpr ⟨hst hj, sdiff_subset _ _⟩))
                                (mem_insert.mpr (or.inr (mem_sdiff.mpr ⟨hi, hi'⟩))) } }
end

end interpolate

section nodal
open finset polynomial
variables {ι : Type*} {s : finset ι} {v : ι → F} {i : ι} (r : ι → F) {x : F}

/--
`nodal s v` is the unique monic polynomial whose roots are the nodes defined by `v` and `s`.

That is, the roots of `nodal s v` are exactly the image of `v` on `s`,
with appropriate multiplicity.

We can use `nodal` to define the barycentric forms of the evaluated interpolant.
-/
def nodal (s : finset ι) (v : ι → F) : F[X] := ∏ i in s, (X - C (v i))

lemma nodal_eq (s : finset ι) (v : ι → F) : nodal s v = ∏ i in s, (X - C (v i)) := rfl

@[simp] lemma nodal_empty : nodal ∅ v = 1 := rfl

lemma degree_nodal : (nodal s v).degree = s.card :=
by simp_rw [nodal, degree_prod, degree_X_sub_C, sum_const, nat.smul_one_eq_coe]

lemma eval_nodal {x : F} : (nodal s v).eval x = ∏ i in s, (x - v i) :=
by simp_rw [nodal, eval_prod, eval_sub, eval_X, eval_C]

lemma eval_nodal_at_node (hi : i ∈ s) : eval (v i) (nodal s v) = 0 :=
by { rw [eval_nodal, prod_eq_zero_iff], exact ⟨i, hi, sub_eq_zero_of_eq rfl⟩ }

lemma eval_nodal_not_at_node (hx : ∀ i ∈ s, x ≠ v i) : eval x (nodal s v) ≠ 0 :=
by { simp_rw [nodal, eval_prod, prod_ne_zero_iff, eval_sub, eval_X, eval_C, sub_ne_zero], exact hx }

lemma nodal_eq_mul_nodal_erase [decidable_eq ι] (hi : i ∈ s) :
  nodal s v = (X - C (v i)) * nodal (s.erase i) v := by simp_rw [nodal, mul_prod_erase _ _ hi]

lemma X_sub_C_dvd_nodal (v : ι → F) (hi : i ∈ s) : (X - C (v i)) ∣ nodal s v :=
⟨_, by { classical, exact nodal_eq_mul_nodal_erase hi }⟩

variable [decidable_eq ι]

lemma nodal_erase_eq_nodal_div (hi : i ∈ s) :
  nodal (s.erase i) v = nodal s v / (X - C (v i)) :=
begin
  rw [nodal_eq_mul_nodal_erase hi, euclidean_domain.mul_div_cancel_left],
  exact X_sub_C_ne_zero _
end

lemma nodal_insert_eq_nodal (hi : i ∉ s) :
  nodal (insert i s) v = (X - C (v i)) * (nodal s v) := by simp_rw [nodal, prod_insert hi]

lemma derivative_nodal : (nodal s v).derivative = ∑ i in s, nodal (s.erase i) v :=
begin
  refine finset.induction_on s _ (λ _ _ hit IH, _),
  { rw [nodal_empty, derivative_one, sum_empty] },
  { rw [nodal_insert_eq_nodal hit, derivative_mul, IH, derivative_sub,
        derivative_X, derivative_C, sub_zero, one_mul, sum_insert hit,
        mul_sum, erase_insert hit, add_right_inj],
    refine sum_congr rfl (λ j hjt, _),
    rw [nodal_erase_eq_nodal_div (mem_insert_of_mem hjt), nodal_insert_eq_nodal hit,
        euclidean_domain.mul_div_assoc _ (X_sub_C_dvd_nodal v hjt),
        nodal_erase_eq_nodal_div hjt] }
end

lemma eval_nodal_derivative_eval_node_eq (hi : i ∈ s) :
  eval (v i) (nodal s v).derivative = eval (v i) (nodal (s.erase i) v) :=
begin
  rw [derivative_nodal, eval_finset_sum, ← add_sum_erase _ _ hi, add_right_eq_self],
  refine sum_eq_zero (λ j hj, _),
  simp_rw [nodal, eval_prod, eval_sub, eval_X, eval_C, prod_eq_zero_iff, mem_erase],
  exact ⟨i, ⟨(mem_erase.mp hj).1.symm, hi⟩, sub_eq_zero_of_eq rfl⟩
end

/-- This defines the nodal weight for a given set of node indexes and node mapping function `v`. -/
def nodal_weight (s : finset ι) (v : ι → F) (i : ι) := ∏ j in s.erase i, (v i - v j)⁻¹

lemma nodal_weight_eq_eval_nodal_erase_inv : nodal_weight s v i =
  (eval (v i) (nodal (s.erase i) v))⁻¹ :=
by rw [eval_nodal, nodal_weight, prod_inv_distrib]

lemma nodal_weight_eq_eval_nodal_derative (hi : i ∈ s) : nodal_weight s v i =
  (eval (v i) (nodal s v).derivative)⁻¹ :=
by rw [eval_nodal_derivative_eval_node_eq hi, nodal_weight_eq_eval_nodal_erase_inv]

lemma nodal_weight_ne_zero (hvs : set.inj_on v s) (hi : i ∈ s) : nodal_weight s v i ≠ 0 :=
begin
  rw [nodal_weight, prod_ne_zero_iff],
  intros j hj,
  rcases mem_erase.mp hj with ⟨hij, hj⟩,
  refine inv_ne_zero (sub_ne_zero_of_ne (mt (hvs.eq_iff hi hj).mp hij.symm)),
end

lemma basis_eq_prod_sub_inv_mul_nodal_div (hi : i ∈ s) :
  lagrange.basis s v i = C (nodal_weight s v i) * ( nodal s v / (X - C (v i)) )  :=
by simp_rw [lagrange.basis, basis_divisor, nodal_weight, prod_mul_distrib,
            map_prod, ← nodal_erase_eq_nodal_div hi, nodal]

lemma eval_basis_not_at_node (hi : i ∈ s) (hxi : x ≠ v i) :
  eval x (lagrange.basis s v i) = (eval x (nodal s v)) * (nodal_weight s v i * (x - v i)⁻¹)  :=
by rw [mul_comm, basis_eq_prod_sub_inv_mul_nodal_div hi, eval_mul, eval_C,
       ← nodal_erase_eq_nodal_div hi, eval_nodal, eval_nodal, mul_assoc, ← mul_prod_erase _ _ hi,
       ← mul_assoc (x - v i)⁻¹, inv_mul_cancel (sub_ne_zero_of_ne hxi), one_mul]

lemma interpolate_eq_nodal_weight_mul_nodal_div_X_sub_C :
  interpolate s v r = ∑ i in s, C (nodal_weight s v i) * (nodal s v / (X - C (v i))) * C (r i) :=
sum_congr rfl (λ j hj, by rw [mul_comm, basis_eq_prod_sub_inv_mul_nodal_div hj])

/-- This is the first barycentric form of the Lagrange interpolant. -/
lemma eval_interpolate_not_at_node (hx : ∀ i ∈ s, x ≠ v i) : eval x (interpolate s v r) =
  eval x (nodal s v) * ∑ i in s, nodal_weight s v i * (x - v i)⁻¹ * r i :=
begin
  simp_rw [interpolate_apply, mul_sum, eval_finset_sum, eval_mul, eval_C],
  refine sum_congr rfl (λ i hi, _),
  rw [← mul_assoc, mul_comm, eval_basis_not_at_node hi (hx _ hi)]
end

lemma sum_nodal_weight_mul_inv_sub_ne_zero (hvs : set.inj_on v s)
  (hx : ∀ i ∈ s, x ≠ v i) (hs : s.nonempty) :
  ∑ i in s, nodal_weight s v i * (x - v i)⁻¹ ≠ 0 :=
@right_ne_zero_of_mul_eq_one  _ _ _ (eval x (nodal s v)) _ $
  by simpa only [pi.one_apply, interpolate_one hvs hs, eval_one, mul_one]
    using (eval_interpolate_not_at_node 1 hx).symm

/-- This is the second barycentric form of the Lagrange interpolant. -/
lemma eval_interpolate_not_at_node' (hvs : set.inj_on v s) (hs : s.nonempty)
  (hx : ∀ i ∈ s, x ≠ v i) : eval x (interpolate s v r) =
  (∑ i in s, nodal_weight s v i * (x - v i)⁻¹ * r i) /
  ∑ i in s, nodal_weight s v i * (x - v i)⁻¹ :=
begin
  rw [← div_one (eval x (interpolate s v r)), ← @eval_one _ _ x, ← interpolate_one hvs hs,
      eval_interpolate_not_at_node r hx, eval_interpolate_not_at_node 1 hx],
  simp only [mul_div_mul_left _ _ (eval_nodal_not_at_node hx), pi.one_apply, mul_one]
end

end nodal

end lagrange


-- Las_clases_de_equivalencia_son_iguales_a_las_de_sus_elementos.lean
-- Las clases de equivalencia son iguales a las de sus elementos
-- José A. Alonso Jiménez
-- Sevilla, 4 de octubre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Este ejercicio es el 5º de una serie, que comenzó con el [ejercicio
-- del 30 de septiembre](https://bit.ly/2YfsvBZ), cuyo objetivo es
-- demostrar que el tipo de las particiones de un conjunto `X` es
-- isomorfo al tipo de las relaciones de equivalencia sobre `X`.
--
-- El ejercicio consiste en demostrar que si C es una clase de
-- equivalencia y a ∈ C, entonces la clase de equivalencia de a es C.
-- ---------------------------------------------------------------------

import tactic

variable {A : Type}
variable (R : A → A → Prop)

def clase (a : A) :=
  {b : A | R b a}

-- Se usarán los siguientes dos lemas auxiliares
lemma pertenece_clase_syss
  {a b : A}
  : b ∈ clase R a ↔ R b a :=
by refl

lemma subclase_si_pertenece
  {R : A → A → Prop}
  (hR: equivalence R)
  {a b : A}
  : a ∈ clase R b → clase R a ⊆ clase R b :=
λ hab z hza, hR.2.2 hza hab

-- 1ª demostración
example
  (hR: equivalence R)
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
begin
  intro hab,
  apply set.subset.antisymm,
  { apply subclase_si_pertenece hR hab, },
  { apply subclase_si_pertenece hR,
    rcases hR with ⟨-, hsymm, -⟩,
    exact hsymm hab }
end

-- 2ª demostración
example
  (hR: equivalence R)
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
begin
  intro hab,
  apply set.subset.antisymm,
  { exact subclase_si_pertenece hR hab, },
  { exact subclase_si_pertenece hR (hR.2.1 hab), }
end

-- 3ª demostración
example
  (hR: equivalence R)
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
begin
  intro hab,
  exact set.subset.antisymm
         (subclase_si_pertenece hR hab)
         (subclase_si_pertenece hR (hR.2.1 hab))
end

-- 4ª demostración
lemma clases_iguales_si_pertenece
  (hR: equivalence R)
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
λ hab, set.subset.antisymm
        (subclase_si_pertenece hR hab)
        (subclase_si_pertenece hR (hR.2.1 hab))