import .helpers
import .circuit

/-
This is correct and uses only mathlib, but I am leaving it as is for now and doing stuff in the
ncard folder, which uses nonconstructive cardinalities. I've just made a PR with an API for ncard,
so hopefully this will only be temporary.
-/

-- noncomputable theory
open_locale classical

open set

variables {E : Type*}

/--
  A predicate `P` on sets satisfies the exchange property if, for all `X` and `Y` satisfying `P`
  and all `a ∈ X \ Y`, there is some `b ∈ Y \ X` so that swapping `a` for `b` in `X` maintains `P`.
-/
def exchange_property (P : set E → Prop) : Prop :=
  ∀ X Y, P X → P Y → ∀ a, a ∈ X \ Y → ∃ b, b ∈ Y \ X ∧ P (X \ {a} ∪ {b})

/--
  A `matroid` is a nonempty collection of sets satisfying the exchange property. Each such set
  is called a `base` of the matroid.
-/
@[ext] structure matroid (E : Type*) :=
  (base : set E → Prop)
  (exists_base' : ∃ B, base B)
  (base_exchange' : exchange_property base)

namespace matroid

variables [fintype E] {B B' B₁ B₂ I I' J I₁ I₂ J' X Y Z : set E} {M M₁ M₂ : matroid E}

lemma exists_base (M : matroid E) : ∃ B, M.base B := M.exists_base'

lemma base_exchange {M : matroid E} {B₁ B₂ : set E} {x : E}
(hB₁ : M.base B₁) (hB₂ : M.base B₂) (hxB₁ : x ∈ B₁) (hxB₂ : x ∉ B₂) :
  ∃ y, (y ∈ B₂ ∧ y ∉ B₁) ∧ M.base (B₁ \ {x} ∪ {y})   :=
M.base_exchange' B₁ B₂ hB₁ hB₂ x ⟨hxB₁,hxB₂⟩

lemma base.card_eq_card_of_base (hB₁ : M.base B₁) (hB₂ : M.base B₂) :
  B₁.to_finset.card = B₂.to_finset.card :=
begin
  suffices h : ∀ i (B B' : finset E), M.base B → M.base B' → (B' \ B).card ≤ i →
    B'.card ≤ B.card,
  { exact (h _ B₂.to_finset B₁.to_finset (by simpa) (by simpa) rfl.le).antisymm
          (h _ B₁.to_finset B₂.to_finset (by simpa) (by simpa) rfl.le), },
  clear hB₁ B₁ hB₂ B₂,
  intro i,
  induction i with i IH,
  { rintros B B' - - h,
    simp only [le_zero_iff, finset.card_eq_zero, finset.sdiff_eq_empty_iff_subset] at h,
    apply finset.card_mono, exact finset.le_iff_subset.mpr h},
  refine λ B B' hB hB' hcard, le_of_not_lt (λ hlt, _ ) ,
  obtain ⟨x, hxB', hxB⟩ := finset.exists_mem_sdiff_of_card_lt_card hlt,

  obtain ⟨y, ⟨(hyB : y ∈ B), (hyB' : y ∉ B')⟩, hB''⟩ := base_exchange hB' hB hxB' hxB,

  have hcard := IH B (B' \ {x} ∪ {y})  hB (by simpa using hB'') _,
  { apply hlt.not_le,
    rwa [finset.union_comm, ← finset.insert_eq, finset.card_insert_of_not_mem,
      finset.sdiff_singleton_eq_erase, finset.card_erase_add_one hxB'] at hcard,
    simpa using hyB'},

  suffices hss : (B' \ {x} ∪ {y}) \ B ⊂ B' \ B,
  { exact nat.le_of_lt_succ ((finset.card_lt_card hss).trans_le hcard)},

  refine (finset.ssubset_iff_of_subset (λ a, _) ).mpr ⟨x,  _⟩,
  { simp only [finset.mem_sdiff, finset.mem_union, finset.mem_singleton, and_imp],
    rintros (⟨haB',hax⟩ | rfl) haB,  tauto, tauto},

  simp only [finset.mem_sdiff, finset.mem_union, finset.mem_singleton, eq_self_iff_true, not_true,
    and_false, false_or, not_and, not_not, exists_prop],

  refine ⟨⟨hxB', hxB⟩, _⟩,
  rintro rfl, exact hyB,
end

section indep

/-- A set is independent in a matroid if it is contained in a base.  -/
def indep {E : Type*} (M : matroid E) : set E → Prop := λ I, ∃ B, M.base B ∧ I ⊆ B

lemma indep_iff_subset_base :
  M.indep I ↔ ∃ B, M.base B ∧ I ⊆ B :=
iff.rfl

lemma empty_indep (M : matroid E) : M.indep ∅ :=
  exists.elim M.exists_base (λ B hB, ⟨_, hB, B.empty_subset⟩)

lemma indep_mono {M : matroid E} {I J : set E} (hIJ : I ⊆ J) (hJ : M.indep J) : M.indep I :=
by {obtain ⟨B, hB, hJB⟩ := hJ, exact ⟨B, hB, hIJ.trans hJB⟩}

lemma indep.subset (hJ : M.indep J) (hIJ : I ⊆ J) : M.indep I :=
by {obtain ⟨B, hB, hJB⟩ := hJ, exact ⟨B, hB, hIJ.trans hJB⟩}

/-- The independence augmentation axiom; given independent sets `I,J` with `I` smaller than `J`,
  there is an element `e` of `J \ I` whose insertion into `e` is an independent set.  -/
lemma indep.augment (hI : M.indep I) (hJ : M.indep J) (hIJ : I.to_finset.card < J.to_finset.card) :
  ∃ x ∈ J, x ∉ I ∧ M.indep (insert x I) :=
begin
  suffices h_mod : ∀ {p} {I₁ I₂ B₁ B₂}, M.base B₁ → M.base B₂ → I₁ ⊆ B₁ → I₂ ⊆ B₂ →
    I₁.to_finset.card < I₂.to_finset.card → (B₂ \ (I₂ ∪ B₁)).to_finset.card = p →
      ∃ x ∈ I₂, x ∉ I₁ ∧ M.indep (insert x I₁),
  { obtain ⟨⟨BI,hBI,hIBI⟩,⟨BJ, hBJ, hJBJ⟩⟩ := ⟨hI,hJ⟩,
    exact h_mod hBI hBJ hIBI hJBJ hIJ rfl },
  clear hI hJ hIJ I J,
  intro p, induction p with p IH,
  all_goals
  { intros _ _ _ _ hB₁ hB₂ hI₁B₁ hI₂B₂ h_lt h_le} ,
  { simp only [to_finset_diff, finset.card_eq_zero, finset.sdiff_eq_empty_iff_subset,
      to_finset_subset, coe_to_finset] at h_le,

    by_contradiction h_con, push_neg at h_con,

    have h₁₂ : B₂ \ B₁ = I₂ \ I₁,
    { apply subset_antisymm,
      {  calc _ ⊆ _  : diff_subset_diff_left h_le
            ... = _  : union_diff_right
             ... ⊆ _ : diff_subset_diff_right hI₁B₁},
      rintros x ⟨hxI₂, hxI₁⟩,
      exact ⟨mem_of_mem_of_subset hxI₂ hI₂B₂,
        λ hxB₁, h_con _ hxI₂ hxI₁ ⟨B₁, hB₁, insert_subset.mpr ⟨ hxB₁,hI₁B₁⟩⟩⟩},

    have hB₁ss : B₁ ⊆ I₁ ∪ B₂,
    { intros y hyB₁,
      rw [mem_union, or_iff_not_imp_right],
      intro hyB₂,
      obtain ⟨x,⟨hxB₂, hxB₁⟩, hB'⟩ := base_exchange hB₁ hB₂ hyB₁ hyB₂,
      obtain (hxI₂ | hxB₁') := mem_of_mem_of_subset hxB₂ h_le,
      swap, exact (hxB₁ hxB₁').elim,
      by_contradiction hyI₁,
      refine h_con x hxI₂ (not_mem_subset hI₁B₁ hxB₁)
        ⟨_, hB', insert_subset.mpr ⟨by simp, subset_union_of_subset_left _ _⟩⟩,
      apply subset_diff_singleton hI₁B₁ hyI₁},
    have hss₁ := calc B₁ \ B₂ ⊆ _       : diff_subset_diff_left hB₁ss
                          ... = _       : union_diff_right
                          ... ⊆ I₁ \ I₂ : diff_subset_diff_right hI₂B₂,

    rw [← to_finset_subset_to_finset, to_finset_diff, to_finset_diff] at hss₁,

    have hle₁ := finset.card_mono hss₁,
    simp_rw [finset.card_sdiff_eq_card_sdiff_iff_card_eq_card.mp (hB₁.card_eq_card_of_base hB₂),
      ← to_finset_diff, h₁₂, to_finset_diff, ← finset.card_le_card_iff_card_sdiff_le_card_sdiff]
      at hle₁,
    exact h_lt.not_le hle₁},
  have h_ne : (B₂ \ (I₂ ∪ B₁)).nonempty,
  { rw [← set.to_finset_nonempty, ←finset.card_pos, h_le], apply nat.succ_pos _},
  obtain ⟨x, hxB₂, hx'⟩ := h_ne,
  rw [set.mem_union, not_or_distrib] at hx', obtain ⟨hxI₂, hxB₁⟩:= hx',
  obtain ⟨y, ⟨hyB₁, hyB₂⟩, hB'⟩ := base_exchange hB₂ hB₁ hxB₂ hxB₁,
  have hI₂B' : I₂ ⊆ B₂ \ {x} ∪ {y},
  { apply set.subset_union_of_subset_left, apply subset_diff_singleton hI₂B₂ hxI₂},

  refine IH hB₁ hB' hI₁B₁ hI₂B' h_lt _,
  suffices h_set_eq : (B₂ \ {x} ∪ {y}) \ (I₂ ∪ B₁) = (B₂ \ (I₂ ∪ B₁)) \ {x},
  { simp_rw h_set_eq,  rw [to_finset_diff, finset.card_sdiff, h_le],
    { simp},
    simp only [to_finset_subset, coe_to_finset, singleton_subset_iff, mem_diff, mem_union],
    tauto},
  rw [union_singleton, insert_diff_of_mem _ (mem_union_right _ hyB₁)],
  rw [diff_diff_comm],
end

/-- The independence augmentation axiom in a form that finds a strict superset -/
lemma indep.ssubset_indep_of_card_lt (hI : M.indep I) (hJ : M.indep J)
(hIJ : I.to_finset.card < J.to_finset.card) :
  ∃ I', M.indep I' ∧ I ⊂ I' ∧ I' ⊆ I ∪ J :=
begin
  obtain ⟨e, heJ, heI, hI'⟩ := hI.augment hJ hIJ,
  exact ⟨_, hI', ssubset_insert heI, insert_subset.mpr ⟨or.inr heJ,subset_union_left _ _⟩⟩,
end

lemma base.indep (hB : M.base B) : M.indep B := ⟨B, hB, subset_rfl⟩

lemma base.subset_indep (hB : M.base B) (hIB : I ⊆ B) : M.indep I := hB.indep.subset hIB

lemma base.eq_of_subset_indep (hB : M.base B) (hI : M.indep I) (hBI : B ⊆ I) :
  B = I :=
begin
  refine to_finset_inj.mp (finset.eq_of_subset_of_card_le (by simpa) _),
  obtain ⟨B', hB', hIB'⟩ := hI,
  rw hB.card_eq_card_of_base hB',
  apply finset.card_mono,
  simpa,
end

lemma base.eq_of_subset_base (hB₁ : M.base B₁) (hB₂ : M.base B₂) (hB₁B₂ : B₁ ⊆ B₂) :
  B₁ = B₂ :=
hB₁.eq_of_subset_indep (hB₂.indep) hB₁B₂

lemma base_iff_maximal_indep : M.base B ↔ M.indep B ∧ ∀ I, M.indep I → B ⊆ I → B = I :=
begin
  refine ⟨λ h, ⟨h.indep, λ _, h.eq_of_subset_indep ⟩,λ h, _⟩,
  obtain ⟨⟨B', hB', hBB'⟩, h⟩ := h,
  rwa h _ hB'.indep hBB',
end

lemma eq_of_indep_iff_indep_forall (h : ∀ I, (M₁.indep I ↔ M₂.indep I)) :
  M₁ = M₂ :=
begin
  ext B,
  have hI : M₁.indep = M₂.indep, by { ext ,apply h},
  simp_rw [base_iff_maximal_indep, hI],
end

end indep

section basis

/-- A `basis` of a set `X` is a maximal independent subset of `X` -/
def basis {E : Type*} (M : matroid E) (I X : set E) :=
M.indep I ∧ I ⊆ X ∧ ∀ J, M.indep J → I ⊆ J → J ⊆ X → I = J

lemma basis.indep (hI : M.basis I X) : M.indep I := hI.1

lemma basis.subset (hI : M.basis I X) : I ⊆ X := hI.2.1

lemma basis_iff :
  M.basis I X ↔ M.indep I ∧ I ⊆ X ∧ ∀ J, M.indep J → I ⊆ J → J ⊆ X → I = J :=
iff.rfl

lemma basis.eq_of_subset_indep (hI : M.basis I X) {J : set E} (hJ : M.indep J) (hIJ : I ⊆ J)
(hJX : J ⊆ X) :
  I = J :=
hI.2.2 J hJ hIJ hJX

lemma indep.subset_basis_of_subset (hI₁ : M.indep I₁) (hI₁X : I₁ ⊆ X) :
  ∃ I, I₁ ⊆ I ∧ M.basis I X :=
begin
  set inds_of : finset (set E) := {I | M.indep I ∧ I₁ ⊆ I ∧ I ⊆ X}.to_finset with hbdef,
  have hne : inds_of.nonempty,
    from to_finset_nonempty.mp ⟨I₁,by {simp only [finset.mem_val, mem_to_finset, mem_set_of_eq],
      exact ⟨hI₁, subset_refl _, hI₁X⟩}⟩,
  have h' := inds_of.exists_max_image (λ I, I.to_finset.card) hne,
  simp only [mem_to_finset, mem_set_of_eq, and_imp, exists_prop] at h',
  obtain ⟨I, ⟨hI, hI₁I, hIX⟩,hJ⟩ := h',
  refine ⟨I, hI₁I, hI, hIX, λ I' hI' hII' hI'X, _⟩,
  simpa using finset.eq_of_subset_of_card_le _ (hJ _ hI' (hI₁I.trans hII') hI'X),
  simpa,
end

lemma indep.le_card_basis (hI : M.indep I) (hIX : I ⊆ X) (hJX : M.basis J X) :
  I.to_finset.card ≤ J.to_finset.card :=
begin
  refine le_of_not_lt (λ hlt, _),
  obtain ⟨I', hI'⟩ := hJX.indep.ssubset_indep_of_card_lt hI hlt,
  have := hJX.eq_of_subset_indep hI'.1 hI'.2.1.subset (hI'.2.2.trans (union_subset hJX.subset hIX)),
  subst this,
  exact hI'.2.1.ne rfl,
end

lemma exists_basis (M : matroid E) (X : set E) :
  ∃ I, M.basis I X :=
by {obtain ⟨I, -, hI⟩ := M.empty_indep.subset_basis_of_subset (empty_subset X), exact ⟨_,hI⟩, }

lemma base_iff_basis_univ :
  M.base B ↔ M.basis B univ :=
by {rw [base_iff_maximal_indep, basis], simp}

end basis

section rank

/-- The rank function of a matroid. This is defined using `nat.card`, to avoid a fintype instance
  so as not to carry around data (it has the junk value `0` if `X` is infinite) -/
noncomputable def r {E : Type*} (M : matroid E) : set E → ℕ :=
  λ X, nat.find_greatest (λ n, ∃ I, I ⊆ X ∧ M.indep I ∧ n = nat.card I) (nat.card X)

/-- The rank `M.rk` of a matroid `M` is the rank of its ground set -/
@[reducible] noncomputable def rk (M : matroid E) := M.r univ

/-- This is the useful definition of rank -/
lemma eq_r_iff {n : ℕ} : M.r X = n ↔ ∃ I, M.basis I X ∧ I.to_finset.card = n :=
begin
  simp_rw [matroid.r, nat.find_greatest_eq_iff, nat.card_eq_to_finset_card, ne.def,
    ←or_iff_not_imp_left, not_exists], push_neg,
  split,
  { rintros ⟨hnX, rfl | ⟨I, hIX, hI, rfl⟩, h⟩,
    { simp_rw [pos_iff_ne_zero, ←or_iff_not_imp_left] at h,
      obtain ⟨I, hI⟩ := M.exists_basis X,
      refine ⟨I, hI, (@h I.to_finset.card).elim id (λ h', _)⟩,
      exact (h' (finset.card_mono (by simpa using hI.subset)) I hI.subset hI.indep rfl).elim},
    refine ⟨I, ⟨hI, hIX, λ J hJ hIJ hJX,
      (eq_or_ssubset_of_subset hIJ).elim id (λ hIssJ, false.elim _)⟩, rfl⟩,
    exact h (finset.card_lt_card (to_finset_ssubset_to_finset.mpr hIssJ))
      (finset.card_le_of_subset (to_finset_subset_to_finset.mpr hJX)) J hJX hJ rfl},
  rintros ⟨I, ⟨hIX, rfl⟩⟩,
  refine ⟨finset.card_mono (by simpa using hIX.subset),or.inr ⟨I,hIX.subset,hIX.indep,rfl⟩,_⟩,
  rintro n hIn hnX J hJX hJ rfl,
  exact hIn.not_le (hJ.le_card_basis hJX hIX),
end

lemma le_r_iff {X : set E} {n : ℕ} : n ≤ M.r X ↔ ∃ I, M.indep I ∧ I ⊆ X ∧ I.to_finset.card = n :=
begin
  obtain ⟨J, hJ⟩ := eq_r_iff.mp (@rfl _ (M.r X)),
  refine ⟨λ h, _, λ h, _⟩,
  { obtain ⟨I', hI', rfl⟩ := finset.exists_smaller_set _ _ (h.trans_eq hJ.2.symm),
    rw [subset_to_finset] at hI',
    exact ⟨I', hJ.1.indep.subset hI', hI'.trans hJ.1.subset, by simp⟩},
  obtain ⟨I, hI, hIX, rfl⟩ := h,
  rw ←hJ.2,
  exact hI.le_card_basis hIX hJ.1,
end

lemma r_le_iff {X : set E} {n : ℕ} :
  M.r X ≤ n ↔ (∀ I, M.indep I → I ⊆ X → I.to_finset.card ≤ n) :=
begin
  obtain ⟨I, hIX, hI⟩ := eq_r_iff.mp (@rfl _ (M.r X)),
  refine ⟨λ h J hJ hJX, (hJ.le_card_basis hJX hIX).trans (by rwa hI), λ h, _⟩,
  have := h I hIX.indep hIX.subset, rwa ←hI,
end

lemma basis.card (hIX : M.basis I X) :
  I.to_finset.card = M.r X :=
by {rw [eq_comm, eq_r_iff], exact ⟨_, hIX, rfl⟩}

lemma indep.r (hI : M.indep I) :
  M.r I = I.to_finset.card :=
eq_r_iff.mpr ⟨I, ⟨hI, subset_refl _, λ _ _, subset_antisymm⟩, rfl⟩

lemma basis.r (hIX : M.basis I X) :
  M.r I = M.r X :=
by rw [←hIX.card, hIX.indep.r]

lemma indep_iff_r_eq_card :
  M.indep I ↔ M.r I = I.to_finset.card :=
begin
  refine ⟨indep.r ,λ h, _⟩,
  obtain ⟨J, hJ, hJI, hJcard⟩ := le_r_iff.mp h.symm.le,
  suffices hIJ : J = I, rwa ←hIJ,
  rw ← to_finset_inj,
  exact finset.eq_of_subset_of_card_le (by simpa) hJcard.symm.le,
end

@[simp] lemma r_empty (M : matroid E) :
  M.r ∅ = 0 :=
by rw [M.empty_indep.r, to_finset_empty, finset.card_empty]

lemma r_le_card (M : matroid E) (X : set E) :
  M.r X ≤ X.to_finset.card :=
r_le_iff.mpr (λ I hI hIX, finset.card_mono (by simpa))

lemma r_mono (M : matroid E) {X Y : set E} (hXY : X ⊆ Y) :
  M.r X ≤ M.r Y :=
by {simp_rw [r_le_iff, le_r_iff], exact λ I hI hIX, ⟨I,hI,hIX.trans hXY,rfl⟩}

lemma base.r (hB : M.base B) :
  M.r B = M.rk :=
by {rw [base_iff_basis_univ] at hB, rw hB.r}

lemma base_iff_indep_r :
  M.base B ↔ M.indep B ∧ M.r B = M.rk :=
begin
  refine ⟨λ h, ⟨h.indep, h.r⟩, λ h, base_iff_maximal_indep.mpr ⟨h.1, λ I hI hBI, _⟩⟩,
  refine eq_of_le_of_not_lt hBI (λ hBI' : B ⊂ I, _),
  cases h with hB hB',
  rw [hB.r] at hB',
  have := finset.card_lt_card (to_finset_ssubset_to_finset.mpr hBI'),
  rw [←hI.r, hB'] at this,
  exact (M.r_mono (subset_univ _)).not_lt this,
end

lemma basis.r_eq_r_union (hIX : M.basis I X) (Y : set E) :
  M.r (I ∪ Y) = M.r (X ∪ Y) :=
begin
  refine (M.r_mono (union_subset_union_left _ hIX.subset)).antisymm _,
  obtain ⟨I', hII', hI'⟩ :=
    hIX.indep.subset_basis_of_subset (hIX.subset.trans (subset_union_left _ Y)),
  rw [←hI'.r],
  refine M.r_mono (λ z hz, by_contra (λ hz', _)),
  rw [mem_union, decidable.not_or_iff_and_not] at hz',
  have hzX : z ∈ X, {cases (mem_of_mem_of_subset hz hI'.subset); tauto},

  have := hIX.eq_of_subset_indep
    (hI'.indep.subset (insert_subset.mpr ⟨hz,hII'⟩))
    (subset_insert z I) (insert_subset.mpr ⟨hzX, hIX.subset⟩),
  rw [eq_comm, insert_eq_self] at this,
  exact hz'.1 this,
end

/-- The submodularity axiom for the rank function -/
lemma r_inter_add_r_union_le_r_add_r (M : matroid E) (X Y : set E) :
  M.r (X ∩ Y) + M.r (X ∪ Y) ≤ M.r X + M.r Y :=
begin
  obtain ⟨Ii, hIi⟩ := M.exists_basis (X ∩ Y),
  obtain ⟨IX, hIX, hIX'⟩ :=
    hIi.indep.subset_basis_of_subset (hIi.subset.trans (inter_subset_left _ _)),
  obtain ⟨IY, hIY, hIY'⟩ :=
    hIi.indep.subset_basis_of_subset (hIi.subset.trans (inter_subset_right _ _)),
  rw [←hIX'.r_eq_r_union, union_comm, ←hIY'.r_eq_r_union, ←hIi.card, ←hIX'.card, ←hIY'.card,
    ←finset.card_inter_add_card_union, ←to_finset_inter, ←to_finset_union, union_comm],
  refine add_le_add
    (finset.card_mono (to_finset_subset_to_finset.mpr (subset_inter hIX hIY))) _,
  convert M.r_le_card (IX ∪ IY),
end

lemma eq_of_r_eq_r_forall (h : ∀ X, M₁.r X = M₂.r X) :
  M₁ = M₂ :=
eq_of_indep_iff_indep_forall (λ I, by simp_rw [indep_iff_r_eq_card,h I])

end rank

end matroid

section constructions

/-- Constructions of matroids from other descriptions -/

variables [finite E]

/-- A collection of sets satisfying the independence axioms determines a matroid -/
def matroid_of_indep (indep : set E → Prop)
(exists_ind : ∃ I, indep I)
(ind_mono : ∀ I J, I ⊆ J → indep J → indep I)
(ind_aug : ∀ I J, indep I → indep J → nat.card I < nat.card J →
  ∃ e ∈ J, e ∉ I ∧ indep (insert e I)) :
  matroid E :=
{ base := λ B, indep B ∧ ∀ X, indep X → B ⊆ X → X = B,
  exists_base' :=
    by exact
      (@set.finite.exists_maximal_wrt (set E) (set E) _ id indep (to_finite _) exists_ind).imp
      (λ B hB, exists.elim hB (λ hB h, ⟨hB, λ X hX hBX, (h X hX hBX).symm⟩)),
  base_exchange' :=
  begin
    haveI := fintype.of_finite E,
    simp_rw nat.card_eq_to_finset_card at ind_aug,
    set is_base := λ (B : set E), indep B ∧ ∀ X, indep X → B ⊆ X → X = B with hbase,
    rintro B₁ B₂ hB₁ hB₂ x ⟨hxB₁,hxB₂⟩,

    have h_base_iff : ∀ B B' (hB' : is_base B'),
      is_base B ↔ indep B ∧ B'.to_finset.card ≤ B.to_finset.card,
    { intros B B' hB', split,
      { refine λ hB, ⟨hB.1, le_of_not_lt (λ hlt, _)⟩,
        obtain ⟨e,heB,heB',he⟩ := ind_aug B B' hB.1 hB'.1 hlt,
        exact heB' (by simpa using hB.2 _ he (subset_insert _ _))},
      rintros ⟨hBI, hB'B⟩ ,
      refine ⟨hBI, λ J hJ hBJ, (hBJ.antisymm (by_contra (λhJB, _))).symm⟩,
      have hss := ssubset_of_subset_not_subset hBJ hJB,
      obtain ⟨e,heJ,heB',he⟩ :=
        ind_aug B' J hB'.1 hJ (hB'B.trans_lt (finset.card_lt_card (by simpa))),
      exact heB' (by simpa using hB'.2 _ he (subset_insert _ _))},

    simp_rw [h_base_iff _ _ hB₁, mem_diff, union_singleton],
    have hcard : (B₁ \ {x}).to_finset.card < B₂.to_finset.card,
    { rw [nat.lt_iff_add_one_le, to_finset_diff, to_finset_singleton,
      finset.sdiff_singleton_eq_erase, finset.card_erase_add_one (mem_to_finset.mpr hxB₁)],
      exact ((h_base_iff _ _ hB₁).mp hB₂).2},

    obtain ⟨e,heB₂,heB₁,he⟩ :=
      ind_aug (B₁ \ {x}) B₂ (ind_mono _ _ (diff_subset _ _) hB₁.1) hB₂.1 (by convert hcard),

    have hex : e ≠ x := by {rintro rfl, simpa using heB₁},
    have heB₁ : e ∉ B₁,
    { simp only [mem_diff, mem_singleton_iff, not_and, not_not] at heB₁,
      exact λ h, hex (heB₁ h)},

    refine ⟨e,⟨heB₂,heB₁⟩,he,_⟩,
    rw [to_finset_insert, finset.card_insert_of_not_mem, to_finset_diff, to_finset_singleton,
      finset.sdiff_singleton_eq_erase, finset.card_erase_add_one];
    simpa,
  end  }

@[simp] lemma matroid_of_indep_base_iff {indep : set E → Prop}
  (exists_ind : ∃ I, indep I)
  (ind_mono : ∀ I J, I ⊆ J → indep J → indep I)
  (ind_aug : ∀ I J, indep I → indep J → nat.card I < nat.card J →
    ∃ e ∈ J, e ∉ I ∧ indep (insert e I)) {B : set E }:
(matroid_of_indep indep exists_ind ind_mono ind_aug).base B ↔
  indep B ∧ ∀ X, indep X → B ⊆ X → X = B :=
iff.rfl

@[simp] lemma matroid_of_indep_apply {indep : set E → Prop}
  (exists_ind : ∃ I, indep I)
  (ind_mono : ∀ I J, I ⊆ J → indep J → indep I)
  (ind_aug : ∀ I J, indep I → indep J → nat.card I < nat.card J →
    ∃ e ∈ J, e ∉ I ∧ indep (insert e I)) :
  (matroid_of_indep indep exists_ind ind_mono ind_aug).indep = indep :=
begin
  haveI := fintype.of_finite E,
  ext I,
  simp_rw [matroid.indep_iff_subset_base, matroid_of_indep],
  split,
  { rintro ⟨B, ⟨hBi,hB⟩, hIB⟩,
    exact ind_mono _ _ hIB hBi},
  intro hI,
  obtain ⟨B,hBi, hB⟩ :=
    @set.finite.exists_maximal_wrt (set E) (set E) _ id {J | I ⊆ J ∧ indep J} (to_finite _)
    ⟨I, subset_refl I, hI⟩,
  simp only [mem_set_of_eq, id.def, le_eq_subset, and_imp] at hB hBi,
  exact ⟨B, ⟨hBi.2, λ X hX hBX, (hB _ (hBi.1.trans hBX) hX hBX).symm⟩, hBi.1⟩,
end

lemma r_eq_card_of_subset_of_r_le_card_submod (r : set E → ℕ) (r_le_card : ∀ X, r X ≤ nat.card X)
(r_submod : ∀ X Y, r (X ∩ Y) + r (X ∪ Y) ≤ r X + r Y)
{I J : set E} (hIJ : I ⊆ J) (hJ : r J = nat.card J) :
  r I = nat.card I :=
begin
  haveI := fintype.of_finite E,
  refine le_antisymm (r_le_card I) _,
  have rdiff := r_le_card (J \ I),
  rw [nat.card_eq_to_finset_card] at ⊢ hJ rdiff,
  rw [to_finset_diff] at rdiff,

  have h := r_submod I (J \ I),
  have r_empt : r ∅ = 0, simpa using ((r_le_card ∅).antisymm (by simp)),
  rw [inter_diff_self, r_empt, zero_add, union_diff_cancel hIJ, hJ] at h,
  have := finset.card_sdiff_add_card_eq_card (to_finset_subset_to_finset.mpr hIJ),
  linarith,
end

lemma extend_to_basis_of_r (r : set E → ℕ) (r_le_card : ∀ X, r X ≤ nat.card X)
(r_mono : ∀ X Y, X ⊆ Y → r X ≤ r Y) (r_submod : ∀ X Y, r (X ∩ Y) + r (X ∪ Y) ≤ r X + r Y)
(I X : set E) (hI : r I = nat.card I) (hIX : I ⊆ X) :
  ∃ J, I ⊆ J ∧ J ⊆ X ∧ r J = nat.card J ∧ r J = r X :=
begin
  haveI := fintype.of_finite E,
  obtain ⟨J, ⟨hIJ, hJX, hJ₀⟩, hJ'⟩ :=
   finite.exists_maximal (λ J, I ⊆ J ∧ J ⊆ X ∧ nat.card J ≤ r J) (⟨I, rfl.subset, hIX, hI.symm.le⟩),
  have hJ := hJ₀.antisymm' (r_le_card _),
  refine ⟨J, hIJ, hJX, hJ, hJX.ssubset_or_eq.elim (λ hJX', _) (congr_arg _)⟩,
  obtain ⟨Y, ⟨hJY,hYX,hYr⟩, hYmax⟩ :=
   finite.exists_maximal (λ Y, J ⊆ Y ∧ Y ⊆ X ∧ r Y ≤ r J) ⟨J, rfl.subset, hJX, rfl.le⟩,
  refine hYX.ssubset_or_eq.elim (λ hYX, false.elim _)
    (by {rintro rfl, exact (r_mono _  _ hJX).antisymm hYr,}),
  obtain ⟨e,heX,heY⟩ := exists_of_ssubset hYX,
  have heJ : e ∉ J := λ heJ, heY (mem_of_mem_of_subset heJ hJY),
  have hsm := r_submod (J ∪ {e}) Y,

  rw [inter_distrib_right, singleton_inter_eq_empty.mpr heY, union_empty,
    inter_eq_self_of_subset_left hJY, union_right_comm, union_eq_self_of_subset_left hJY] at hsm,

  have hYe : r Y < r (Y ∪ {e}),
  { rw [lt_iff_not_le],
    intro hYe,
    rw  hYmax (Y ∪ {e})
     ⟨hJY.trans (subset_union_left _ _),union_subset hYX.subset (singleton_subset_iff.mpr heX),
     (hYe.trans hYr)⟩ (subset_union_left _ _) at heY,
    simpa using heY},
  have hJe : r (J ∪ {e}) ≤ r J,
  { refine le_of_not_lt (λ h',  h'.ne _),
    rw ←(hJ' (J ∪ {e}) ⟨subset_union_of_subset_left hIJ _,union_subset hJX (by simpa),_⟩
      (subset_union_left _ _)),
    rwa [union_singleton, nat.card_eq_to_finset_card, to_finset_insert,
      finset.card_insert_of_not_mem (by simpa : e ∉ J.to_finset), nat.add_one_le_iff,
      ←nat.card_eq_to_finset_card, ←hJ, ←union_singleton ]},
  linarith,
end

/-- A function `r` satisfying the rank axioms determines a matroid -/
def matroid_of_r (r : set E → ℕ) (r_le_card : ∀ X, r X ≤ nat.card X)
(r_mono : ∀ X Y, X ⊆ Y → r X ≤ r Y) (r_submod : ∀ X Y, r (X ∩ Y) + r (X ∪ Y) ≤ r X + r Y) :
  matroid E :=
matroid_of_indep (λ I, r I = nat.card I)
⟨∅, (r_le_card _).antisymm (by simp)⟩
(λ _ _, r_eq_card_of_subset_of_r_le_card_submod r r_le_card r_submod)
(begin
  haveI := fintype.of_finite E,
  intros I J hI hJ hIJ,
  obtain ⟨K,hIK, hKIJ, hK, hrK⟩ :=
   extend_to_basis_of_r r r_le_card r_mono r_submod _ _ hI (subset_union_left _ J),
  refine (ssubset_or_eq_of_subset hIK).elim (λ hss, _) _,
  { refine (exists_of_ssubset hss).imp _,
    rintro e ⟨heK,heI⟩,
    simp only [nat.card_eq_fintype_card, fintype.card_of_finset, exists_prop,
      nat.card_eq_to_finset_card],
    have heJ : e ∈ J, { by_contra, cases (hKIJ heK); tauto },
    refine ⟨heJ, heI, _⟩,
    rw ←nat.card_eq_to_finset_card,
    exact r_eq_card_of_subset_of_r_le_card_submod r r_le_card r_submod
      (insert_subset.mpr ⟨heK, hIK⟩) hK},
  rintro rfl,
  simp_rw [←hI, ←hJ, hrK] at hIJ,
  exact (hIJ.not_le (r_mono _ _ (subset_union_right _ _))).elim,
end)

@[simp] lemma matroid_of_r_apply (r : set E → ℕ) (r_le_card : ∀ X, r X ≤ nat.card X)
(r_mono : ∀ X Y, X ⊆ Y → r X ≤ r Y) (r_submod : ∀ X Y, r (X ∩ Y) + r (X ∪ Y) ≤ r X + r Y) :
  (matroid_of_r r r_le_card r_mono r_submod).r = r :=
begin
  ext X,
  haveI := fintype.of_finite E,
  simp_rw [matroid_of_r, matroid.eq_r_iff, matroid.basis_iff, matroid_of_indep_apply],
  obtain ⟨I,-,hIX,hI,hIX'⟩ :=
   extend_to_basis_of_r r r_le_card r_mono r_submod ∅ X (by simpa using r_le_card ∅)
    (empty_subset _),
  refine ⟨I, ⟨⟨hI,hIX,λJ hJ hIJ hJX,
    (ssubset_or_eq_of_subset hIJ).elim (λ hIJ',false.elim _) id⟩,
      by rwa [←hIX', eq_comm, ←nat.card_eq_to_finset_card]⟩⟩,
  -- rw [nat.card_eq_to_finset_card] at hI hJ,
  have h' := r_mono _ _ hJX,
  have hlt := finset.card_lt_card (to_finset_ssubset_to_finset.mpr hIJ'),
  rw [←nat.card_eq_to_finset_card, ←nat.card_eq_to_finset_card, ←hI, ←hJ] at hlt,
  linarith,
end

end constructions


import BrownCs22.Library.Tactics

/-

In this file, we'll prove some of the identities from
https://brown-cs22.github.io/resources/math-resources/logic.pdf

Note that these identities are stated with the symbol `≡`,
meaning "the formula on the left is equivalent to the formula on the right."
In Lean, we can use iff (bi-implication, `↔`) to mean the same thing.

Remember the tactics we learned in Lecture 4.
We'll see a bit of new Lean syntax along the way.

Also remember that it doesn't matter what we name our hypotheses.
In our examples, we use patterns like `hp` for the hypothesis `p`,
`hnpq` for the hypothesis `¬ p ∧ q` (hnpq for "hypothesis not p q"), etc.
But this is just a custom. You can choose any names you want.
As they say, the hardest problem in computer science is naming variables.

Your task: fill in all the `sorry`s with proofs!

-/

variable (p q r : Prop)

-- ## Commutative Laws

-- We'll do the first for you, as an example.
-- Notice two things.
-- One, must of these problems will start with `split_goal`,
-- to turn the `iff` goal into two `implies` goals.
-- Two, we structure our proof by putting each *subproof* in `{...}`.
-- This isn't necessary but it helps with organization!
example : p ∧ q ↔ q ∧ p := by
  split_goal
  { intro hpq
    eliminate hpq with hp hq
    split_goal
    assumption
    assumption }
  { intro hqp
    eliminate hqp with hq hp
    split_goal
    assumption
    assumption }

example : p ∨ q ↔ q ∨ p := by
  sorry

-- ## Associative laws

-- Notice that Lean doesn't print parentheses unless it needs to.
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by
  sorry

-- This is getting a little repetitive.
-- To mix it up, we'll only do one direction of the iff this time.
-- You won't start with `split_goal`, but instead, ... what?
example : (p ∨ q) ∨ r → p ∨ (q ∨ r) := by
  sorry

-- ## Distributive laws

example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by
  sorry

-- Again, let's just do one direction.
-- When we're proving an implication `→`, we'll always start with `intro`.
-- This is such a common pattern that Lean gives us special syntax for it:
-- we can do the intro "in advance," before we start the proof,
-- by naming the hypothesis to the left of the `:`.
-- Notice that at the beginning of our proof, we already have the
-- hypothesis `hpqr` in our context.
example (hpqr : p ∨ (q ∧ r)) : (p ∨ q) ∧ (p ∨ r) := by
  sorry

-- ## Identity laws

/-

We'll do a few more together.

Let's sneak a new tactic in.
To prove a goal `True`, you can use the tactic `trivial`.
This is a sensible proof rule: trivially, you can always show `True` is true!
-/

example : p ∧ True ↔ p := by
  split_goal
  { intro hpT
    eliminate hpT
    assumption }
  { intro hpT
    split_goal
    assumption
    trivial }

-- Before, we saw `contradiction` would work if we had hypotheses
-- `p` and `¬ p` at the same time.
-- It also works if we have a hypothesis `False`!
example : p ∨ False ↔ p := by
  split_goal
  { intro hpF
    eliminate hpF with hp hF
    assumption
    contradiction }
  { intro hp
    left
    assumption }

/-

## Negation laws

If you're following along with the list of identities, you'll see that
we've come to some laws like `(p ∨ ¬ p) ↔ True`.

Unfortunately, we don't have the tools to prove these in Lean yet.

But, you can do the **Idempotent laws** and **Universal bound laws**.
Try stating and proving these yourself!

-/

/-

## De Morgan's Laws

These can be a bit of a challenge! Like the negation laws,
a few of the implications here will require some new tools.
But try out these directions.

Remember that to prove a negation `¬ X`, you can use a *proof by contradiction*:
add a hypothesis `h : X` using `intro h`, and then show a contradiction.

-/

example (hnpnq : ¬ p ∨ ¬ q) : ¬(p ∧ q) := by
  sorry

example (hnpnq : ¬ p ∧ ¬ q) : ¬ (p ∨ q) := by
  sorry

/-

That's it for the moment!
Try the **Absorption laws** and **Negation of True and False**
on your own, if you want to. Skip the definition laws for now.

-/


-- Introducción del cuantificador existencial
-- ==========================================

import tactic

-- ----------------------------------------------------
-- Ejercicio. Demostrar que
--    ∃ k : ℕ, 8 = 2*k
-- ----------------------------------------------------

-- 1ª demostración
example : ∃ k : ℕ, 8 = 2*k :=
begin
  use 4,
  refl,
end

-- 2ª demostración
example : ∃ k : ℕ, 8 = 2*k :=
exists.intro 4
  ( show 8 = 2 * 4,
      from rfl)

-- 3ª demostración
example : ∃ k : ℕ, 8 = 2*k :=
exists.intro 4 rfl


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intros P P',
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  by_cases h : P,
  {
    intro P'',
    exact h,
  },
  {
    intro P',
    contradiction,
  },
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  by_cases h : P,
  {
    intro P'',
    exact h,
  },
  {
    intro P',
    contradiction,
  },
  intros P P',
  contradiction,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro D,
  cases D,
  right,
  apply D,
  left,
  apply D,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro D,
  cases D,
  split,
  apply D_right,
  apply D_left,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro D,
  intro P,
  cases D,
  contradiction,
  apply D,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intros D P',
  cases D,
  contradiction,
  apply D,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intros D Q' P,
  have Q := D  P,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros D P,
  by_contra Q,
  have P' := D Q,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  intros D Q' P,
  have Q := D  P,
  contradiction,
  intros D P,
  by_contra Q,
  have P' := D Q,
  contradiction,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro D,
  by_cases h : P,
  {
    apply D,
    left,
    exact h,
  },
  {
    apply D,
    right,
    exact h,
  },
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intros h1 np,
  by_cases h : (P→Q),
  have p : P := h1 h,
  contradiction,
  have h2 : (P → Q),
  intro P,
  contradiction,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intros ha hb,
  cases hb,
  cases ha,
  apply hb_left,
  contradiction,
  apply hb_right,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intros ha hb,
  cases ha,
  cases hb,
  have boom := hb ha_left,
  exact boom,
  have boom := hb ha_right,
  exact boom,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro D,
  split,
  intro P,
  apply D,
  left,
  exact P,
  intro Q,
  apply D,
  right,
  exact Q,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intros ha hb,
  cases ha with ha_l ha_r,
  cases hb,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro h1,
  by_contradiction h2,
  have hp : (P∧Q),
  split,
  by_contradiction h3,
  apply h2,
  right,
  assumption,
  by_contradiction h3,
  apply h2,
  left,
  assumption,
  apply h1,
  contradiction,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intros h1 h2,
  cases h2,
  cases h1,
  contradiction,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  {
    intro h1,
    by_contradiction h2,
    have hp : (P∧Q),
    split,
    by_contradiction h3,
    apply h2,
    right,
    assumption,
    by_contradiction h3,
    apply h2,
    left,
    assumption,
    apply h1,
    contradiction,
  },
  {
    intros h1 h2,
    cases h2,
    cases h1,
    contradiction,
    contradiction,
  }
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  {
    intro D,
    split,
    intro P,
    apply D,
    left,
    exact P,
    intro Q,
    apply D,
    right,
    exact Q,
  },
  {
    intros ha hb,
    cases ha with ha_l ha_r,
    cases hb,
    contradiction,
    contradiction,
  }
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro h1,
  cases h1,
  cases h1_right,
  left,
  split,
  assumption,
  assumption,
  right,
  split,
  assumption,
  assumption,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h1,
  cases h1,
  {
    cases h1,
    split,
    assumption,
    left,
    assumption,
  },
  {
    cases h1,
    split,
    assumption,
    right,
    assumption,
  }
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro h1,
  cases h1,
  {
    split,
    left,
    assumption,
    left,
    assumption,
  },
  {
    cases h1,
    split,
    right,
    assumption,
    right,
    assumption,
  }
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h,
  cases h with hl hr,
  cases hl,
  left,
  assumption,
  cases hr,
  left,
  assumption,
  right,
  split,
  assumption,
  assumption,
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intros h1 h2 h3,
  apply h1,
  split,
  assumption,
  assumption,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intros h1 h2,
  cases h2,
  apply h1,
  assumption,
  assumption,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro P,
  exact P,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro P,
  left,
  exact P,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro Q,
  right,
  exact Q,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro h,
  cases h,
  assumption,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro h,
  cases h,
  assumption,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  {
    intro PD,
    cases PD,
    assumption,
  },
  {
    intro P,
    split,
    assumption,
    assumption,
  }
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  {
    intro P2,
    cases P2,
    assumption,
    assumption,
  },
  {
    intro P,
    left,
    assumption,
  }
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intros h1 x p,
  apply h1,
  existsi x,
  exact p,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intros h1 h2,
  cases h2 with x px,
  have h : ¬P x := h1 x,
  contradiction,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intros h1,
  by_contradiction h2,
  apply h1,
  intro u,
  by_contradiction h3,
  apply h2,
  existsi u,
  assumption,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intros h1 h2,
  cases h1 with x npx,
  have px : P x := h2 x,
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  {
    intros h1,
    by_contradiction h2,
    apply h1,
    intro u,
    by_contradiction h3,
    apply h2,
    existsi u,
    assumption,
  },
  {
    intros h1 h2,
    cases h1 with x npx,
    have px : P x := h2 x,
    contradiction,
  }
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  {
    intros h1 x p,
    apply h1,
    existsi x,
    exact p,
  },
  {
    intros h1 h2,
    cases h2 with x px,
    have h : ¬P x := h1 x,
    contradiction,
  }
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intros h1 h2,
  cases h1 with x px,
  have npx : ¬P x := h2 x,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intros h1 h2,
  cases h2 with x npx,
  have px : P x := h1 x,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intros h1 x,
  by_contradiction npu,
  apply h1,
  existsi x,
  assumption,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro h1,
  by_contradiction nepx,
  apply h1,
  intros x,
  by_contradiction px,
  apply nepx,
  existsi x,
  assumption,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  {
    intros h1 h2,
    cases h2 with x npx,
    have px : P x := h1 x,
    contradiction,
  },
  {
    intros h1 x,
    by_contradiction npu,
    apply h1,
    existsi x,
    assumption,
  }
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  {
    intros h1 h2,
    cases h1 with x px,
    have npx : ¬P x := h2 x,
    contradiction,
  },
  {
    intro h1,
    by_contradiction nepx,
    apply h1,
    intros x,
    by_contradiction px,
    apply nepx,
    existsi x,
    assumption,
  }
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro h1,
  split,
  {
    cases h1 with x pqx,
    cases pqx,
    existsi x,
    assumption,
  },
  {
    cases h1 with x pqx,
    cases pqx,
    existsi x,
    assumption,
  }
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro h1,
  cases h1 with x pqx,
  cases pqx,
  {
    left,
    existsi x,
    assumption,
  },
  {
    right,
    existsi x,
    assumption,
  }
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro h1,
  cases h1,
  {
    cases h1 with x px,
    existsi x,
    left,
    assumption,
  },
  {
    cases h1 with x qx,
    existsi x,
    right,
    assumption,
  }
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro h1,
  split,
  {
    intro x,
    have h : P x ∧ Q x := h1 x,
    cases h,
    assumption,
  },
  {
    intro x,
    have h : P x ∧ Q x := h1 x,
    cases h,
    assumption,
  }
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro h1,
  intro x,
  cases h1,
  split,
  {
    have h : P x := h1_left x,
    assumption,
  },
  {
    have h : Q x := h1_right x,
    assumption,
  }
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intros h1 x,
  cases h1,
  {
    left,
    have h : P x := h1 x,
    assumption,
  },
  {
    right,
    have h : Q x := h1 x,
    assumption,
  }
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


import data.set
import data.nat.basic

section question1and2
/-
Suppose < is a strict partial order on a domain A,
and define a≤b to mean that a<b or a=b.

Show that ≤ is a partial order.
Show that if < is moreover a strict total order, then ≤ is a total order.
-/

parameters {A : Type} {R : A → A → Prop}
parameter (irreflR : irreflexive R)
parameter (transR : transitive R)

local infix < := R

def R' (a b : A) : Prop := R a b ∨ a = b
local infix ≤ := R'

include transR irreflR
theorem partialR : reflexive R' ∧ transitive R' ∧ anti_symmetric R' :=
begin
    split,
        assume a,
        right,
        trivial,

        split,
            assume a b c,
            assume ab,
            assume bc,
            cases ab,
                cases bc,
                    left,
                    exact transR ab bc,

                    left,
                    rw ←bc,
                    assumption,

                    rw ab,
                    assumption,

            assume a b,
            assume h1 h2,
            cases h1,
                cases h2,
                    apply false.elim,
                        apply irreflR,
                            apply transR,
                                exact h1,
                                exact h2,

                    exact eq.symm h2,
                assumption,
end

example : ∀ a b : A, (a < b) ∨ (a = b) ∨ (b < a) → a ≤ b ∨ b ≤ a :=
begin
    assume a b,
    assume h,
    cases h,
        left, left, assumption,
        cases h,
            left, right, assumption,
            right, left, assumption
end

/-
Suppose < is a strict partial order on a domain A.
(In other words, it is transitive and asymmetric.)
Suppose that ≤ is defined so that a≤b if and only if a<b or a=b.
We saw in class that ≤ is a partial order on a domain A,
i.e.~it is reflexive, transitive, and antisymmetric.

Prove that for every a and b in A,
we have a<b iff a≤b and a≠b, using the facts above.
-/

example : ∀ a b, a < b ↔ a ≤ b ∧ a ≠ b :=
begin
    have partR := partialR,
    assume a b,
    split,
        assume h,
        split,
            left, assumption,

            assume ne,
            apply irreflR,
                rw ne at h,
                exact h,

        assume h,
        cases h.1,
            assumption,
            exact absurd h_1 h.2,
end

end question1and2

section question4
    parameters (T : Type) (R : T → T → Prop)
    parameter (reflR : reflexive R)
    parameter (symmR : symmetric R)
    parameter (transR : transitive R)

    local infix ≡ := R

    def equiv_class : T → set T := λ a, {c | R a c}

    local notation `[`a`]` : 50 := (equiv_class a)

    include reflR symmR transR
    theorem equiv' : ∀ a b, [a] = [b] ↔ a ≡ b :=
    begin
        assume a b,
        split,
            assume h,

            have : ∀ x : T, (x ∈ equiv_class a) ↔ (x ∈ equiv_class b),
                apply (set.ext_iff (equiv_class a) (equiv_class b)).1, assumption,

            apply (this b).2,
            apply reflR,

            assume h,
            apply set.ext,
                assume x,
                split,
                    assume h1,
                    apply transR,
                    exact symmR h,
                    assumption,

                    assume h1,
                    apply transR,
                    assumption,
                    assumption,
    end

    example : ∀ a b, [a] = [b] ↔ a ≡ b :=
        assume a b : T,
        iff.intro
            (
                assume h : [a] = [b],
                have this : ∀ x : T, (x ∈ [a]) ↔ (x ∈ [b]), from
                    (set.ext_iff [a] [b]).1 h,
                show a ≡ b, from (this b).2 (reflR b)
            )
            (
            assume h : a ≡ b,
            show [a] = [b], from set.ext (
                assume x : T,
                iff.intro
                    (
                        assume h1 : x ∈ [a],
                        show x ∈ [b], from transR (symmR h) h1
                    )
                    (
                        assume h1 : x ∈ [b],
                        show x ∈ [a], from transR h h1
                    )
                )
            )

end question4

section question7

/-
A binary relation ≤ on a domain A is said to be a preorder it is is reflexive and transitive.
This is weaker than saying it is a partial order;
we have removed the requirement that the relation is asymmetric.
An example is the ordering on people currently alive on the planet defined by setting x≤y if and only if x ‘s birth date is earlier than y ‘s.
Asymmetry fails, because different people can be born on the same day.
 But, prove that the following theorem holds:

Theorem. Let ≤ be a preorder on a domain A.
Define the relation ≡, where x≡y holds if and only if x≤y and y≤x.
Then ≡ is an equivalence relation on A.
-/

parameter {A : Type}
parameter {R : A → A → Prop}
parameter (transR : transitive R)
parameter (reflR : reflexive R)
local infix ≤ := R

def R'' (a b : A) : Prop := a ≤ b ∧ b ≤ a

local infix ≡ := R''

include reflR transR
example : reflexive R'' ∧ symmetric R'' ∧ transitive R'' :=
begin
    split,
        assume a,
        split,
            apply reflR,
            apply reflR,

        split,
            assume a b,
            assume h,
            cases h with ab ba,
            split,
                assumption,
                assumption,

            assume a b c,
            assume ab bc,
            cases ab with ab ba,
            cases bc with bc cb,
            split,
                apply transR,
                    exact ab,
                    assumption,
                apply transR,
                    exact cb,
                    assumption,
end

end question7


-- ---------------------------------------------------------------------
-- Ejercicio 1. Importar la teoría de anillos.
-- ----------------------------------------------------------------------

import algebra.ring

-- ---------------------------------------------------------------------
-- Ejercicio 2. Crear el espacio de nombre my_ring.
-- ----------------------------------------------------------------------

namespace my_ring

-- ---------------------------------------------------------------------
-- Ejercicio 3. Declara R una variable sobre anillos.
-- ----------------------------------------------------------------------

variables {R : Type*} [ring R]

-- ---------------------------------------------------------------------
-- Ejercicio 4. Declarar a y b como variables sobre R.
-- ----------------------------------------------------------------------

variables a b : R

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que
--     (a + b) + -b = a
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

theorem neg_add_cancel_right : (a + b) + -b = a :=
calc
  (a + b) + -b
      = a + (b + -b) : by rw add_assoc
  ... = a + 0        : by rw add_right_neg
  ... = a            : by rw add_zero

-- 2ª demostración
-- ===============

example : (a + b) + -b = a :=
begin
  rw add_assoc,
  rw add_right_neg,
  rw add_zero,
end

-- El desarrollo de la prueba es
--
--    R : Type u_1,
--    _inst_1 : ring R,
--    a b : R
--    ⊢ a + b + -b = a
-- rw add_assoc,
--    ⊢ a + (b + -b) = a
-- rw add_right_neg,
--    ⊢ a + 0 = a
-- rw add_zero,
--    no goals

-- 3ª demostración
-- ===============

example : (a + b) + -b = a :=
by rw [add_assoc, add_right_neg, add_zero]

-- ---------------------------------------------------------------------
-- Ejercicio 4. Cerrar la teoría my_ring
-- ----------------------------------------------------------------------

end my_ring


import MyNat.Definition
import MyNat.Inequality -- le_iff_exists_add
import AdvancedAdditionWorld.Level11 -- add_right_eq_zero
import Mathlib.Tactic.LeftRight
import InequalityWorld.Level4 -- zero_le
import InequalityWorld.Level8 -- succ_le_succ
namespace MyNat
open MyNat
/-!
# Inequality world.

## Level 9: `le_total`

## Lemma : le_total
For all naturals `a` and `b`, either `a ≤ b` or `b ≤ a`.
-/
theorem le_total (a b : MyNat) : a ≤ b ∨ b ≤ a := by
  revert a
  induction b with
  | zero =>
    intro a
    right
    exact zero_le a
  | succ d hd =>
    intro a
    cases a with
    | zero =>
      left
      exact zero_le _
    | succ a =>
      have h2 := hd a
      cases h2 with
      | inl h =>
        left
        exact succ_le_succ a d h
      | inr h =>
        right
        exact succ_le_succ d a h

/-!
See the [revert tactic](../Tactics/revert.lean.md)

Note in the above proof that `exact succ_le_succ a d h`
is just shorthand for:
`
apply succ_le_succ a d
exact h
`

Another collectible: the naturals are a linear order.

-- BUGBUG: collectibles
-- instance : linear_order MyNat := by structure_helper

Next up [Level 10](./Level10.lean.md)
-/


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module topology.metric_space.completion
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.UniformSpace.Completion
import Mathlib.Topology.MetricSpace.Isometry
import Mathlib.Topology.Instances.Real

/-!
# The completion of a metric space

Completion of uniform spaces are already defined in `Topology.UniformSpace.Completion`. We show
here that the uniform space completion of a metric space inherits a metric space structure,
by extending the distance to the completion and checking that it is indeed a distance, and that
it defines the same uniformity as the already defined uniform structure on the completion
-/

open Set Filter UniformSpace Metric

open Filter Topology Uniformity

noncomputable section

universe u v

variable {α : Type u} {β : Type v} [PseudoMetricSpace α]

namespace UniformSpace.Completion

/-- The distance on the completion is obtained by extending the distance on the original space,
by uniform continuity. -/
instance : Dist (Completion α) :=
  ⟨Completion.extension₂ dist⟩

/-- The new distance is uniformly continuous. -/
protected theorem uniformContinuous_dist :
    UniformContinuous fun p : Completion α × Completion α ↦ dist p.1 p.2 :=
  uniformContinuous_extension₂ dist
#align uniform_space.completion.uniform_continuous_dist UniformSpace.Completion.uniformContinuous_dist

/-- The new distance is continuous. -/
protected theorem continuous_dist [TopologicalSpace β] {f g : β → Completion α} (hf : Continuous f)
    (hg : Continuous g) : Continuous fun x ↦ dist (f x) (g x) :=
  Completion.uniformContinuous_dist.continuous.comp (hf.prod_mk hg : _)
#align uniform_space.completion.continuous_dist UniformSpace.Completion.continuous_dist

/-- The new distance is an extension of the original distance. -/
@[simp]
protected theorem dist_eq (x y : α) : dist (x : Completion α) y = dist x y :=
  Completion.extension₂_coe_coe uniformContinuous_dist _ _
#align uniform_space.completion.dist_eq UniformSpace.Completion.dist_eq

/- Let us check that the new distance satisfies the axioms of a distance, by starting from the
properties on α and extending them to `Completion α` by continuity. -/
protected theorem dist_self (x : Completion α) : dist x x = 0 := by
  refine' induction_on x _ _
  · refine' isClosed_eq _ continuous_const
    exact Completion.continuous_dist continuous_id continuous_id
  · intro a
    rw [Completion.dist_eq, dist_self]
#align uniform_space.completion.dist_self UniformSpace.Completion.dist_self

protected theorem dist_comm (x y : Completion α) : dist x y = dist y x := by
  refine' induction_on₂ x y _ _
  · exact isClosed_eq (Completion.continuous_dist continuous_fst continuous_snd)
        (Completion.continuous_dist continuous_snd continuous_fst)
  · intro a b
    rw [Completion.dist_eq, Completion.dist_eq, dist_comm]
#align uniform_space.completion.dist_comm UniformSpace.Completion.dist_comm

protected theorem dist_triangle (x y z : Completion α) : dist x z ≤ dist x y + dist y z := by
  refine' induction_on₃ x y z _ _
  · refine' isClosed_le _ (Continuous.add _ _) <;>
      apply_rules [Completion.continuous_dist, Continuous.fst, Continuous.snd, continuous_id]
  · intro a b c
    rw [Completion.dist_eq, Completion.dist_eq, Completion.dist_eq]
    exact dist_triangle a b c
#align uniform_space.completion.dist_triangle UniformSpace.Completion.dist_triangle

/-- Elements of the uniformity (defined generally for completions) can be characterized in terms
of the distance. -/
protected theorem mem_uniformity_dist (s : Set (Completion α × Completion α)) :
    s ∈ 𝓤 (Completion α) ↔ ∃ ε > 0, ∀ {a b}, dist a b < ε → (a, b) ∈ s := by
  constructor
  · /- Start from an entourage `s`. It contains a closed entourage `t`. Its pullback in `α` is an
      entourage, so it contains an `ε`-neighborhood of the diagonal by definition of the entourages
      in metric spaces. Then `t` contains an `ε`-neighborhood of the diagonal in `Completion α`, as
      closed properties pass to the completion. -/
    intro hs
    rcases mem_uniformity_isClosed hs with ⟨t, ht, ⟨tclosed, ts⟩⟩
    have A : { x : α × α | (↑x.1, ↑x.2) ∈ t } ∈ uniformity α :=
      uniformContinuous_def.1 (uniformContinuous_coe α) t ht
    rcases mem_uniformity_dist.1 A with ⟨ε, εpos, hε⟩
    refine' ⟨ε, εpos, @fun x y hxy ↦ _⟩
    have : ε ≤ dist x y ∨ (x, y) ∈ t := by
      refine' induction_on₂ x y _ _
      · have : { x : Completion α × Completion α | ε ≤ dist x.fst x.snd ∨ (x.fst, x.snd) ∈ t } =
               { p : Completion α × Completion α | ε ≤ dist p.1 p.2 } ∪ t := by ext; simp
        rw [this]
        apply IsClosed.union _ tclosed
        exact isClosed_le continuous_const Completion.uniformContinuous_dist.continuous
      · intro x y
        rw [Completion.dist_eq]
        by_cases h : ε ≤ dist x y
        · exact Or.inl h
        · have Z := hε (not_le.1 h)
          simp only [Set.mem_setOf_eq] at Z
          exact Or.inr Z
    simp only [not_le.mpr hxy, false_or_iff, not_le] at this
    exact ts this
  · /- Start from a set `s` containing an ε-neighborhood of the diagonal in `Completion α`. To show
        that it is an entourage, we use the fact that `dist` is uniformly continuous on
        `Completion α × Completion α` (this is a general property of the extension of uniformly
        continuous functions). Therefore, the preimage of the ε-neighborhood of the diagonal in ℝ
        is an entourage in `Completion α × Completion α`. Massaging this property, it follows that
        the ε-neighborhood of the diagonal is an entourage in `Completion α`, and therefore this is
        also the case of `s`. -/
    rintro ⟨ε, εpos, hε⟩
    let r : Set (ℝ × ℝ) := { p | dist p.1 p.2 < ε }
    have : r ∈ uniformity ℝ := Metric.dist_mem_uniformity εpos
    have T := uniformContinuous_def.1 (@Completion.uniformContinuous_dist α _) r this
    simp only [uniformity_prod_eq_prod, mem_prod_iff, exists_prop, Filter.mem_map,
      Set.mem_setOf_eq] at T
    rcases T with ⟨t1, ht1, t2, ht2, ht⟩
    refine' mem_of_superset ht1 _
    have A : ∀ a b : Completion α, (a, b) ∈ t1 → dist a b < ε := by
      intro a b hab
      have : ((a, b), (a, a)) ∈ t1 ×ˢ t2 := ⟨hab, refl_mem_uniformity ht2⟩
      have I := ht this
      simp [Completion.dist_self, Real.dist_eq, Completion.dist_comm] at I
      exact lt_of_le_of_lt (le_abs_self _) I
    show t1 ⊆ s
    · rintro ⟨a, b⟩ hp
      have : dist a b < ε := A a b hp
      exact hε this
#align uniform_space.completion.mem_uniformity_dist UniformSpace.Completion.mem_uniformity_dist

/-- If two points are at distance 0, then they coincide. -/
protected theorem eq_of_dist_eq_zero (x y : Completion α) (h : dist x y = 0) : x = y := by
  /- This follows from the separation of `Completion α` and from the description of
    entourages in terms of the distance. -/
  have : SeparatedSpace (Completion α) := by infer_instance
  refine' separated_def.1 this x y fun s hs ↦ _
  rcases (Completion.mem_uniformity_dist s).1 hs with ⟨ε, εpos, hε⟩
  rw [← h] at εpos
  exact hε εpos
#align uniform_space.completion.eq_of_dist_eq_zero UniformSpace.Completion.eq_of_dist_eq_zero

/-- Reformulate `Completion.mem_uniformity_dist` in terms that are suitable for the definition
of the metric space structure. -/
protected theorem uniformity_dist' :
    𝓤 (Completion α) = ⨅ ε : { ε : ℝ // 0 < ε }, 𝓟 { p | dist p.1 p.2 < ε.val } := by
  ext s; rw [mem_infᵢ_of_directed]
  · simp [Completion.mem_uniformity_dist, subset_def]
  · rintro ⟨r, hr⟩ ⟨p, hp⟩
    use ⟨min r p, lt_min hr hp⟩
    simp (config := { contextual := true }) [lt_min_iff]
#align uniform_space.completion.uniformity_dist' UniformSpace.Completion.uniformity_dist'

protected theorem uniformity_dist : 𝓤 (Completion α) = ⨅ ε > 0, 𝓟 { p | dist p.1 p.2 < ε } := by
  simpa [infᵢ_subtype] using @Completion.uniformity_dist' α _
#align uniform_space.completion.uniformity_dist UniformSpace.Completion.uniformity_dist

/-- Metric space structure on the completion of a pseudo_metric space. -/
instance : MetricSpace (Completion α) where
  dist_self := Completion.dist_self
  eq_of_dist_eq_zero := Completion.eq_of_dist_eq_zero _ _
  dist_comm := Completion.dist_comm
  dist_triangle := Completion.dist_triangle
  dist := dist
  toUniformSpace := by infer_instance
  uniformity_dist := Completion.uniformity_dist
  edist_dist := fun x y ↦ rfl

/-- The embedding of a metric space in its completion is an isometry. -/
theorem coe_isometry : Isometry ((↑) : α → Completion α) :=
  Isometry.of_dist_eq Completion.dist_eq
#align uniform_space.completion.coe_isometry UniformSpace.Completion.coe_isometry

@[simp]
protected theorem edist_eq (x y : α) : edist (x : Completion α) y = edist x y :=
  coe_isometry x y
#align uniform_space.completion.edist_eq UniformSpace.Completion.edist_eq

end UniformSpace.Completion

open UniformSpace Completion NNReal

theorem LipschitzWith.completion_extension [MetricSpace β] [CompleteSpace β] {f : α → β}
    {K : ℝ≥0} (h : LipschitzWith K f) : LipschitzWith K (Completion.extension f) :=
  LipschitzWith.of_dist_le_mul fun x y => induction_on₂ x y
    (isClosed_le (by continuity) (by continuity)) <| by
      simpa only [extension_coe h.uniformContinuous, Completion.dist_eq] using h.dist_le_mul

theorem LipschitzWith.completion_map [PseudoMetricSpace β] {f : α → β} {K : ℝ≥0}
    (h : LipschitzWith K f) : LipschitzWith K (Completion.map f) :=
  one_mul K ▸ (coe_isometry.lipschitz.comp h).completion_extension

theorem Isometry.completion_extension [MetricSpace β] [CompleteSpace β] {f : α → β}
    (h : Isometry f) : Isometry (Completion.extension f) :=
  Isometry.of_dist_eq fun x y => induction_on₂ x y
    (isClosed_eq (by continuity) (by continuity)) fun _ _ ↦ by
      simp only [extension_coe h.uniformContinuous, Completion.dist_eq, h.dist_eq]

theorem Isometry.completion_map [PseudoMetricSpace β] {f : α → β}
    (h : Isometry f) : Isometry (Completion.map f) :=
  (coe_isometry.comp h).completion_extension


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------
theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro hP,
  intro hnnP,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro  hnnP,
  by_cases hP : P,
  exact hP,
  contradiction,

end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  apply doubleneg_elim,
  apply doubleneg_intro,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro h,
  cases h with hP hQ,
    right,
    exact hP,
    left,
    exact hQ,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro h,
  cases h with hP hQ,
    split,
    exact hQ,
    exact hP,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intros h hp,
  cases h with hnP hQ,
    contradiction,
    exact hQ,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intros h hnP,
  cases h with hnP hQ,
    contradiction,
    exact hQ,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intros h hnQ hP,
  apply hnQ,
  apply h,
  exact hP,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intros h hP,
  by_contra hQ,
    apply h,
    exact hQ,
    exact hP,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  apply impl_as_contrapositive,
  apply impl_as_contrapositive_converse,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro h,
  apply h,

  by_cases hP : P,
    left,
    exact hP,
    right,
    exact hP,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro h,
  intro hnP,
  apply hnP,
  apply h,
  intro hp,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro h,
  intro hnPnQ,
  cases h with hP,
    cases hnPnQ with hnP hnQ,
      contradiction,
    cases hnPnQ with hnP hnQ,
      contradiction,

end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro h,
  intro hnPnQ,
  cases hnPnQ with hnP hnQ,
    cases h with hP hQ,
      contradiction,
    cases h with hP hQ,
      contradiction,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro h,
  split,
  intro hP,
  apply h,
  left,
  exact hP,
  intro hQ,
  apply h,
  right,
  exact hQ,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro h,
  intro hPQ,
  cases h with hnP hnQ,
    cases hPQ with hP hQ,
      contradiction,
      contradiction,
end
-- Prove de Morgan's.

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro hnPQ,
  by_cases hP : P,
    left,
    intro hQ,
    have hPQ : P ∧ Q, from and.intro hP hQ,
      contradiction,
  right,
  exact hP,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intros hOr hAnd,
  cases hOr,
  cases hAnd,
  apply hOr,
  exact hAnd_right,
  cases hAnd,
  apply hOr,
  exact hAnd_left,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  apply demorgan_conj,
  apply demorgan_conj_converse,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  apply demorgan_disj,
  apply demorgan_disj_converse,

end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro h,
  cases h with hP hQR,
    cases hQR with hQ hR,
        left,
        split,
        exact hP,
        exact hQ,
    right,
    split,
    exact hP,
    exact hR,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h,
  cases h with hPQ hPR,
    cases hPQ with hP hQ,
      split,
      exact hP,
      left,
      exact hQ,
    cases hPR with hP hR,
      split,
      exact hP,
      right,
      exact hR,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro h,
  split,
  cases h with hP hQR,
    left,
    exact hP,
    cases hQR with hQ hR,
      right,
      exact hQ,
  cases h with hP hQR,
    left,
    exact hP,
    right,
    cases hQR with hQ hR,
      exact hR,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h,
  cases h with hPQ hPR,
    cases hPR with hP hR,
      left,
      exact hP,
    cases hPQ with hP hQ,
        left,
        exact hP,
    have hQR : Q ∧ R, from and.intro hQ hR,
       right,
       exact hQR,

end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intros h hP hQ,
  apply h,
  split,
  exact hP,
  exact hQ,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intros h hPQ,
  cases hPQ with hP hQ,
    apply h,
    exact hP,
    exact hQ,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro hP,
  exact hP,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro hP,
  left,
  exact hP,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro hQ,
  right,
  exact hQ,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro hPQ,
  cases hPQ with hP hQ,
    exact hP,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro hPQ,
  cases hPQ with hP hQ,
    exact hQ,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro hPP,
  cases hPP with hP,
    exact hP,
    intro hP,
    split,
    exact hP,
    exact hP,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro hPP,
  cases hPP with hP,
    exact hP,
    exact hPP,
    intro hP,
    left,
    exact hP,
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q  : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro hnE,
  intro k,
  intro hP,
  apply hnE,
  existsi k,
  exact hP,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro hfAll,
  intro hE,
  cases hE with k hP,
    have hnPk : ¬P k := hfAll k,
      apply hnPk,
      exact hP,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro hnfAll,
  by_contra hnE,
    apply hnfAll,
    intro k,
  by_contra hnPk,
    apply hnE,
    existsi k,
  exact hnPk,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro hE,
  intro hnfAll,
  cases hE with k hnP,
    have hP : P k := hnfAll k,
      contradiction,

end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  apply demorgan_forall,
  apply demorgan_forall_converse,

end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  apply demorgan_exists,
  apply demorgan_exists_converse,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro hE,
  intro hnfAll,
  cases hE with k hP,
    have hnP : ¬P k := hnfAll k,
      contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro hfAll,
  intro hE,
  cases hE with k hnP,
    apply hnP,
    apply hfAll,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro hnE,
  intro k,
  by_contra hnP,
    apply hnE,
    existsi k,
    exact hnP,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intros hnfAll,
  by_contra hnE,
    apply hnfAll,
  intro k,
  intro hP,
  apply hnE,
  existsi k,
  exact hP,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  apply forall_as_neg_exists,
  apply forall_as_neg_exists_converse,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  apply exists_as_neg_forall,
  apply exists_as_neg_forall_converse,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intros hEAnd,
  cases hEAnd with k hPQ,
    cases hPQ with hP hQ,
      split,
      existsi k,
      exact hP,
      existsi k,
      exact hQ,

end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intros hEOr,
  cases hEOr with k hPQ,
    cases hPQ with hP hQ,
      left,
      existsi k,
      exact hP,
    right,
    existsi k,
    exact hQ,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro hEOr,
  cases hEOr with hEP hEQ,
    cases hEP with k hP,
      existsi k,
      left,
      exact hP,
    cases hEQ with k hQ,
      existsi k,
      right,
      exact hQ,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro hfAll,
  split,
  intro k,
  have hPQ : P k ∧ Q k := hfAll k,
    cases hPQ with hP hQ,
    exact hP,
  intro k,
  have hPQ : P k ∧ Q k := hfAll k,
    cases hPQ with hP hQ,
    exact hQ,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro hfAllAnd,
  cases hfAllAnd with hfP hfQ,
    intro k,
    split,
    apply hfP,
    apply hfQ,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro hfAllOr,
  intro k,
  cases hfAllOr with hfP hfQ,
    left,
    apply hfP,
    right,
    apply hfQ,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


variable { α β γ : Type }
-- variable (f : α → β) (g : β → γ)

def Injective (f : α → β) : Prop := ∀ a₁ a₂, f a₁ = f a₂ → a₁ = a₂

def Surjective (f : α → β) : Prop := ∀ b, ∃ a, f a = b

def Bijective (f : α → β) : Prop :=  Injective f ∧ Surjective f

theorem comp_inj (f : α → β) (g : β → γ) (h : Injective (g ∘ f)) : Injective f := by
  intro a₁ a₂ h₁
  have : g (f a₁) = g (f a₂) := congrArg g h₁
  exact h a₁ a₂ this

theorem comp_surj (f : α → β) (g : β → γ) (h : Surjective (g ∘ f)) : Surjective g := by
  intro c
  have ⟨a,h₁⟩ : ∃ a, g (f a) = c := h c
  exact ⟨f a, h₁⟩

def IsLeftInverse (f : α → β) (g : β → α) : Prop := g ∘ f = @id α

def IsRightInverse (f : α → β) (g : β → α) : Prop := f ∘ g = @id β

def IsInverse (f : α → β) (g : β → α) : Prop := IsLeftInverse f g ∧ IsRightInverse f g

theorem left_inv_right_inv (f: α → β) (g : β → α) (h : IsLeftInverse f g) : IsRightInverse g f := by
  exact h

def hasLeftInverse (f : α → β) : Prop := ∃ (g: β → α), IsLeftInverse f g

def hasRightInverse (f : α → β) : Prop := ∃ (g : β → α), IsRightInverse f g

theorem has_left_inv_injective (f : α → β) (h : hasLeftInverse f) : Injective f := by
  intro a₁ a₂ l₁
  have ⟨g,l₂⟩ := h
  have : (g ∘ f) a₁ = (g ∘ f) a₂ := congrArg g l₁
  rw [congrFun l₂] at this
  calc
    a₁ = id a₁        := by rfl
    _  = (g  ∘ f) a₂  := this
    _  = id a₂        := by rw [congrFun l₂]

#check Classical.propDecidable

#check dif_pos

theorem injective_has_left_inv (f : α → β) [l : Nonempty α] (h : Injective f) : hasLeftInverse f := by
  have (a₀ : α) := Classical.choice l
  let (g : β → α) := by
    intro b
    have : Decidable (∃ a, f a = b) := Classical.propDecidable (∃ a, f a = b)
    exact if s : ∃ a, f a = b then Classical.choose s else a₀
  have : IsLeftInverse f g := by
    apply funext
    intro a
    sorry
  exists g


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intro hd,
  intro hd,
  contradiction,
end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro d1,
  by_contradiction hboom,
  contradiction,
end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  exact doubleneg_elim P,
  exact doubleneg_intro P,
end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro h1,
  cases h1 with hp hq,

  right,
  exact hp,

  left,
  exact hq,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro d1,
  cases d1 with dp dq,
  split,
  exact dq,
  exact dp,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro d1,
  cases d1 with dnp dq,

  intro d2,

  contradiction,
  intro d2,
  exact dq,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro d1,
  cases d1 with dp dq,
  intro d2,
  contradiction,
  intro d2,
  exact dq,
end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro d1,
  intro d2,
  intro d3,
  have dq : Q := d1 d3,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro left,
  intro p,
  by_contradiction hboom,
  have np : ¬P := left hboom,
  contradiction,
end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,

  intro left,
  intro nq,
  intro np,
  have q : Q := left np,
  contradiction,

  intro left,
  intro p,
  by_contradiction hboom,
  have np : ¬P := left hboom,
  contradiction,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro hl,
  have g: (P∨¬P),
  right,
  intro p,
  have ll: (P∨¬P),
  left,
  exact p,
  contradiction,
  contradiction,
end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro hl,
  intro np,
  have g: (P → Q),
  intro p,
  contradiction,
  have p : P := hl g,
  contradiction,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro hl,
  intro npenq,
  cases npenq with np nq,
  cases hl with p q,
  contradiction,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro peq,
  intro npounq,
  cases peq with p q,
  cases npounq with np nq,
  contradiction,
  contradiction,
end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro npouq,
  split,
  intro p,
  have pouq: (P∨Q),
  left,
  exact p,
  contradiction,
  intro q,
  have pouq: (P∨Q),
  right,
  exact q,
  contradiction,
end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro npenq,
  intro peq,
  cases npenq with np nq,
  cases peq with p q,
  contradiction,
  contradiction,
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro npeq,
  by_cases vq: Q, --- lem sobre Q
  right,
  intro p,
  have peq: (P∧Q),
  split,
  exact p,
  exact vq,
  contradiction,
  left,
  exact vq,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro nqounp,
  intro peq,
  cases nqounp with nq np,
  cases peq with p q,
  contradiction,
  cases peq with p q,
  contradiction,
end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  exact demorgan_conj P Q,
  exact demorgan_conj_converse P Q,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  exact demorgan_disj P Q,
  exact demorgan_disj_converse P Q,
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro peqour,
  cases peqour with p qour,
  cases qour with q r,
  left,
  split,
  exact p,
  exact q,
  right,
  split,
  exact p,
  exact r,
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro hl,
  cases hl with peq per,
  cases peq with p q,
  split,
  exact p,
  left,
  exact q,
  cases per with p r,
  split,
  exact p,
  right,
  exact r,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro hl,
  cases hl with p qer,
  split,
  left,
  exact p,
  left,
  exact p,
  cases qer with q r,
  split,
  right,
  exact q,
  right,
  exact r,
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro hl,
  cases hl with pouq pour,
  cases pouq with p q,
  left,
  exact p,
  cases pour with p r,
  left,
  exact p,
  right,
  split,
  exact q,
  exact r,
end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro hl,
  intro p,
  intro q,
  have peq: (P∧Q),
  split,
  exact p,
  exact q,
  have r: R := hl peq,
  exact r,
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro left,
  intro peq,
  cases peq with p q,
  have qtor: Q→R := left p,
  have r: R := qtor q,
  exact r,
end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro p,
  exact p,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro p,
  left,
  exact p,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro q,
  right,
  exact q,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro peq,
  cases peq with p q,
  exact p,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro peq,
  cases peq with p q,
  exact q,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro pep,
  cases pep with pl pr,
  exact pl,
  intro p,
  split,
  exact p,
  exact p,
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro poup,
  cases poup with pl pr,
  exact pl,
  exact pr,
  intro p,
  left,
  exact p,
end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro hl,
  intro x,
  intro pdex,
  apply hl,
  existsi x,
  exact pdex,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro hl,
  intro d2,
  cases d2 with x pdex,
  exact hl x pdex,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro hl,
  by_contradiction hc,
  apply hl,
  intro u,
  by_contradiction hc',
  apply hc,
  existsi u,
  exact hc',
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro hl,
  intro hp,
  cases hl with h ha,
  have pdeh : P h := hp h, --- proposicao universal
  contradiction,
end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  apply demorgan_forall,
  apply demorgan_forall_converse,
end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  apply demorgan_exists,
  apply demorgan_exists_converse,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro hl,
  intro hq,
  cases hl with h ha,
  have npdeh : ¬P h := hq h,
  contradiction,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro hl,
  intro he,
  cases he with a ha,
  have pdex : P a := hl a,
  contradiction,
end

theorem forall_as_neg_exists_converse :
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro hl,
  intro e,
  by_contradiction,
  apply hl,
  existsi e,
  exact h,
end

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro hl,
  by_contradiction he,
  apply hl,
  intro a,
  intro ha,
  apply he,
  existsi a,
  exact ha,
end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  apply forall_as_neg_exists,
  apply forall_as_neg_exists_converse,
end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  apply exists_as_neg_forall,
  apply exists_as_neg_forall_converse,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro hl,
  split,
  cases hl with u hu,
  cases hu with hup huq,
  existsi u,
  exact hup,
  cases hl with u hu,
  cases hu with hup huq,
  existsi u,
  exact huq,
end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro hl,
  cases hl with u hu,
  cases hu,
  left,
  existsi u,
  exact hu,
  right,
  existsi u,
  exact hu,
end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro hl,
  cases hl,
  cases hl with u hu,
  existsi u,
  left,
  exact hu,
  cases hl with u hu,
  existsi u,
  right,
  exact hu,
end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro hl,
  split,
  intro u,
  have pxeqx : P u ∧ Q u := hl u,
  cases pxeqx with pu qu,
  exact pu,
  intro u,
  have pxeqx : P u ∧ Q u := hl u,
  cases pxeqx with pu qu,
  exact qu,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro hl,
  intro u,
  split,
  cases hl,
  have pu : P u := hl_left u,
  exact pu,
  cases hl,
  have qu : Q u := hl_right u,
  exact qu,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro hl,
  intro u,
  cases hl,
  have pu : P u := hl u,
  left,
  exact pu,
  have qu : Q u := hl u,
  right,
  exact qu,
end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
import data.nat
open nat

definition partial_sum : nat → nat
| 0        := 0
| (succ n) := succ n + partial_sum n

example : partial_sum 5 = 15 :=
rfl

example : partial_sum 6 = 21 :=
rfl

lemma two_mul_partial_sum_eq : ∀ n, 2 * partial_sum n = (succ n) * n
| 0        := by reflexivity
| (succ n) := calc
   2 * (succ n + partial_sum n) = 2 * succ n + 2 * partial_sum n  : left_distrib
                   ...   = 2 * succ n + succ n * n  : two_mul_partial_sum_eq
                   ...   = 2 * succ n + n * succ n  : mul.comm
                   ...   = (2 + n) * succ n         : right_distrib
                   ...   = (n + 2) * succ n         : add.comm
                   ...   = (succ (succ n)) * succ n : rfl

theorem partial_sum_eq : ∀ n, partial_sum n = ((n + 1) * n) / 2 :=
take n,
have h₁ : (2 * partial_sum n) / 2 = ((succ n) * n) / 2, by rewrite two_mul_partial_sum_eq,
have h₂ : (2:nat) > 0, from dec_trivial,
by rewrite [nat.mul_div_cancel_left _ h₂ at h₁]; exact h₁


import data.set.basic
import data.real.basic

/-
Also see LFTCM 2020 lecture:

  https://www.youtube.com/watch?v=qlJrCtYiEkI
-/

/- Sets versus Types

Lean distinguishes different notions of "set" and "containment"
which are often treated as the same in informal mathematics.

Lean            math
====            ====
X : Type        X is a set (e.g., a metric space or a vector space)
s : set X       s is a subset of X (e.g., an open ball)
x : X           x is an element/point of X
x ∈ s           x belongs to s
t ⊆ s           t is contained in s

-/

-- A `set α` is specified by its membership predicate:
-- for each element of α, we need to say whether it is in the set.

def myset (α : Type*) := α → Prop

-- Example: Unit interval [0, 1] as a subset of ℝ

-- def unit_interval : set ℝ := λ r, 0 ≤ r ∧ r ≤ 1
def unit_interval : set ℝ := {r : ℝ | 0 ≤ r ∧ r ≤ 1}

-- #check @set.mem_def

example : (1/2 : ℝ) ∈ unit_interval :=
begin
  unfold unit_interval,
  norm_num,
end

example : (2 : ℝ) ∉ unit_interval :=
begin
  unfold unit_interval,
  norm_num,
end

/- Operations on sets

  s ∩ t        set.inter s t
  s ∪ t        set.union s t
  s \ t        set.diff s t
  sᶜ           set.compl s
  ∅            set.empty
               set.univ
  s.prod t     set.prod s t

-/

variables {α β : Type*}

def myinter (s t : set α) : set α := {x | x ∈ s ∧ x ∈ t}

def myuniv : set α := {x | true}

def myprod (s : set α) (t : set β) : set (α × β) :=
{p : α × β | p.fst ∈ s ∧ p.snd ∈ t}

/- Set extensionality

Two sets `s t : set α` are equal if and only if they have the same members,
that is, `∀ x, x ∈ s ↔ x ∈ t`.

The `ext` tactic will automatically apply extensionality theorems like this one.

-/

example (s t : set α) : s ∩ t = t ∩ s := begin
  ext,
  finish,
end

lemma set.ne_empty_iff_exists_mem (s : set α) : s ≠ ∅ ↔ ∃ x, x ∈ s := begin
  sorry
end

/- Set containment: s ⊆ t -/
def mysubset (s t : set α) : Prop := ∀ x, x ∈ s → x ∈ t

/- Let's prove commutativity of ∩ again, using `set.subset.antisymm` this time. -/

lemma inter_comm_subset (s t : set α) : s ∩ t ⊆ t ∩ s := sorry

example (s t : set α) : s ∩ t = t ∩ s := begin
  apply set.subset.antisymm;
    apply inter_comm_subset,
end

/- Exercises: From Lean for the Curious Mathematician 2020.
See https://leanprover-community.github.io/lftcm2020/exercises.html
This lecture: tuesday/sets.lean
-/

/- Bonus exercises -/

#check @set.range

def diag (α : Type*) : set (α × α) := {p : α × α | p.fst = p.snd}

example : diag α = set.range (λ x, (x, x)) := begin
  sorry
end

example (s t : set α) : s.prod t ∩ diag α ≠ ∅ ↔ s ∩ t ≠ ∅ :=
begin
  sorry
end


-- * Level 1

theorem succ_inj' {a b : mynat} (hs : succ(a) = succ(b)) :  a = b :=

begin

induction b,
apply succ_inj,
exact hs,
apply succ_inj,
exact hs,

end

-- * Level 2

theorem succ_succ_inj {a b : mynat} (h : succ(succ(a)) = succ(succ(b))) :  a = b :=

begin

apply succ_inj,
apply succ_inj,
exact h,

end
-- * Level 3

theorem succ_eq_succ_of_eq {a b : mynat} : a = b → succ(a) = succ(b) :=

begin

intro,
rw a_1,
refl,

end
-- * Level 4

theorem succ_eq_succ_iff (a b : mynat) : succ a = succ b ↔ a = b :=

begin

split,
exact succ_inj,
exact succ_eq_succ_of_eq,

end

-- * Level 5

theorem add_right_cancel (a t b : mynat) : a + t = b + t → a = b :=

begin

intro h,
induction t,
repeat{rw add_zero at h},
exact h,
repeat {rw add_succ at h},
rw succ_eq_succ_iff at h,
exact t_ih(h),

end
-- * Level 6

theorem add_left_cancel (t a b : mynat) : t + a = t + b → a = b :=

begin

intro h,
rw add_comm at h,
rw add_comm t b at h,
apply add_right_cancel,
exact h,

end

-- * Level 7
theorem add_right_cancel_iff (t a b : mynat) :  a + t = b + t ↔ a = b :=

begin

intro h,
apply add_right_cancel,
exact h,

intro g,
rw g,
refl,

split,

end

-- * Level 8

lemma eq_zero_of_add_right_eq_self {a b : mynat} : a + b = a → b = 0 :=

begin

intro g,
rw <- add_zero (a) at g,
rw add_assoc at g,
rw zero_add b at g,
apply add_left_cancel,
exact g,

end

-- * Level 9
theorem succ_ne_zero (a : mynat) : succ a ≠ 0 :=
begin

symmetry,
exact zero_ne_succ a,

end
-- * Level 10

lemma add_left_eq_zero {{a b : mynat}} (H : a + b = 0) : b = 0 :=

begin

cases b,
rw add_zero at H,
refl,
rw add_succ at H,
exfalso,
apply succ_ne_zero,
exact H,

end

-- * Level 11
lemma add_right_eq_zero {a b : mynat} : a + b = 0 → a = 0 :=

begin

intro h,
rw add_comm at h,
exact add_left_eq_zero(h),

end
-- * Level 12

theorem add_one_eq_succ (d : mynat) : d + 1 = succ d :=

begin

symmetry,
rw succ_eq_add_one,
refl

end

-- * Level 13
lemma ne_succ_self (n : mynat) : n ≠ succ n :=

begin

symmetry at g,
have h := eq_zero_of_add_right_eq_self(g),
rw one_eq_succ_zero at h,
have h2 := succ_ne_zero(0),
intro g,
rw succ_eq_succ_iff at g,
rw <- add_one_eq_succ at g,
cases n,
apply zero_ne_succ 0,
exact h2(h)
end