/-
Introduction rule requires a witness where a predicate
can be proven to be true for that witness
-/
def existsIntro
  (T: Type)
  (pred: T → Prop)
  (witness : T)
  (proof : pred witness)
  : ∃(w: T), pred w
  := exists.intro witness proof

example{T: Type}{witness: T}
  {predicate: T → Prop}
  {proof: predicate witness}:
  ∃ m, predicate m :=
    ⟨ witness, proof ⟩

def isEven(n : nat) : Prop :=
  ∃(m : nat), m + m = n

lemma pf8is4twice: 4 + 4 = 8 := rfl

theorem even8: isEven 8 :=
  exists.intro 4 pf8is4twice

theorem even8': ∃(m : nat), m + m = 8 :=
  exists.intro 4 pf8is4twice

theorem even8'': isEven 8 :=
  ⟨ 4, pf8is4twice ⟩

theorem even8''' : isEven 8 :=
begin
  unfold isEven, -- not necessary
  exact ⟨ 4, pf8is4twice ⟩
end

theorem isNonZ : exists n : nat, 0 ≠ n :=
  exists.intro 1 (λ pf : (0 = 1),
    nat.no_confusion pf)

theorem isNonZ' : exists n : nat, 0 ≠ n :=
begin
  have pf0isnt1: (0 ≠ 1),
    apply nat.no_confusion,

  exact ⟨ 1, pf0isnt1 ⟩,
end

theorem isNonZ'' : exists n : nat, 0 ≠ n :=
begin
  have pf0isnt1: (0 ≠ 1) :=
  begin
    apply nat.no_confusion,
  end,

  exact ⟨ 1, pf0isnt1 ⟩,
end

def existsElim
  { Q : Prop }
  { T : Type }
  { P : T → Prop }
  ( ex : exists x, P x)
  ( pw2q : ∀ a : T, P a → Q)
  : Q
  := exists.elim ex pw2q

theorem forgetAProperty'{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, P n) :=
   -- here Q, the conclusion, is
   -- (exists n, P n)
begin
  assume ex,
  apply exists.elim ex,
  assume w Pw,
  exact ⟨w, Pw.left⟩,
end

theorem forgetAProperty{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, P n) :=
   -- here Q, the conclusion, is (exists n, P n)
begin
  assume ex,
  show ∃ (n : ℕ), P n,
  from
    begin
      apply exists.elim ex, -- give one arg, build other
      assume w Pw, -- assume w and proof of P w
      show ∃ (n : ℕ), P n,
      from exists.intro w Pw.left,
    end,
end

example: ∀(P Q: Prop), P → Q → P ∧ Q
:= begin
  assume P Q,
  assume pfP pfQ,
  exact ⟨pfP, pfQ⟩,
end

theorem reverseProperty{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, S n ∧ P n) :=
begin
  assume ex,
  apply exists.elim ex,
  assume w Pw,
  have pfWReverse: S w ∧ P w :=
    and.intro Pw.right Pw.left,
  exact exists.intro w pfWReverse,
end

theorem reverseProperty'{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, S n ∧ P n) :=
begin
  assume ex,
  apply exists.elim ex,
  assume w Pw,
  apply exists.intro w,
  exact and.intro Pw.right Pw.left,
end

theorem reverseProperty''{P S: ℕ → Prop}:
  (∃ n, P n ∧ S n) → (∃ n, S n ∧ P n) :=
begin
  assume ex,
  have pfw2q: ∀(w : ℕ), P w ∧ S w →
     (∃ (n : ℕ), S n ∧ P n) :=
  begin
    assume w Pw,
    have pfWReverse: S w ∧ P w :=
      and.intro Pw.right Pw.left,
    exact ⟨w, pfWReverse⟩,
  end,
  exact exists.elim ex pfw2q,
end

def isASquare: ℕ → Prop :=
  λ n, exists m, n = m ^ 2

def isASquare'(n: ℕ) :=
  ∃ m, n = m ^ 2

theorem isPS9 : isASquare 9 :=
begin
  unfold isASquare,
  exact exists.intro 3 (eq.refl 9),
end

axiom mypred: ℕ → Prop
#reduce (λ n, mypred n) 3

theorem not_exists_t_iff_always_not_t
  {T: Type}{pred: (T → Prop)}:
    (¬(∃ t: T, pred(t))) ↔
      ∀ t: T, ¬pred(t) :=
begin
  apply iff.intro,
    -- ¬(∃ t: T, pred(t)) → ∀ t: T, ¬pred(t)
    assume pf_not_exists_t,
    assume t,
    assume Q,
    have pf_exists_t := exists.intro t Q,
    contradiction,

    -- ∀ t: T, ¬pred(t) → ¬(∃ t: T, pred(t))
    assume pf_forall_t_not,
    assume pf_exists_t,
    apply exists.elim pf_exists_t,
    assume w,
    assume pf_w,
    have pf_not_w := pf_forall_t_not w,
    contradiction,
end

example: ∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ ¬Q) :=
begin
  apply exists.intro true,
  apply exists.intro false,
  have pf_not_f := λ(f: false), f,
  have pf_not_t_or_not_f :=
    or.intro_right (¬true) pf_not_f,
  have pf_t_or_f :=
    or.intro_left false true.intro,
  have pf_t_or_f' : true ∨ false :=
    or.inl true.intro,
  exact and.intro pf_t_or_f pf_not_t_or_not_f,
end

example: ∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) :=
begin
  apply exists.intro false,
  apply exists.intro true,
  split,
    -- P ∨ Q
    exact or.inr true.intro,
    split,
      -- ¬P ∨ ¬Q
      apply or.inl,
      assume f,
      assumption,
      -- ¬P ∨ Q
      apply or.inr,
      exact true.intro,
end

example: ¬(∃(P Q: Prop),
  (P ∨ Q) ∧ (¬P ∨ ¬Q) ∧ (¬P ∨ Q) ∧ (¬Q)) :=
begin
  assume pf_exists,
  apply exists.elim pf_exists,
  assume P pw',
  apply exists.elim pw',
  assume Q pw,
  have pf_not_q := pw.right.right.right,
  have pf_not_p_or_q := pw.right.right.left,
  cases pf_not_p_or_q with pf_not_p pf_q,
    -- ¬P
    have pf_p_or_q := pw.left,
    cases pf_p_or_q with pf_p pf_q,
      -- P
      contradiction,
      -- Q
      contradiction,
    -- Q
    contradiction,
end

example: ∃(P Q R: Prop),
  (P ∨ Q ∨ R) ∧ (¬P ∨ ¬Q ∨ ¬R) ∧
    (¬P ∨ Q ∨ R) ∧ (¬Q ∨ ¬R) :=
begin
  apply exists.intro false,
  apply exists.intro true,
  apply exists.intro false,
  split,
    -- P ∨ Q ∨ R
    exact or.inr (or.inl true.intro),
    have f := λ(f: false), f,
    split,
      -- ¬P ∨ ¬Q ∨ ¬R
      exact or.inl f,
      split,
        -- ¬P ∨ Q ∨ R
        exact or.inl f,
        -- ¬Q ∨ ¬R
        exact or.inr f,
end

example: ∀(T: Type)(pred: T → Prop),
  ¬(∃(t: T), pred t) ↔
    ∀(t: T), ¬(pred t) :=
begin
  intros,
  split,
    -- forward
    assume pf_notexists,
    assume t,
    assume pf_predt,
    have pf_exists := exists.intro t pf_predt,
    contradiction,
    -- backward
    assume pf_forall,
    assume pf_exists,
    apply exists.elim pf_exists,
    assume w pw,
    have pf_npredw := pf_forall w,
    contradiction,
end

axiom em: ∀(P: Prop), P ∨ ¬P

example: ∀(T: Type)(pred: T → Prop),
  ¬(∀(t: T), pred t) ↔
    ∃(t: T), ¬(pred t) :=
begin
  intros,
  split,
    -- forward
    assume pf_notforall,
    cases (em (∃ (t : T), ¬pred t)) with
        pf_exists pf_notexists,
      -- exists
      assumption,
      -- doesn't exist
      have pf_forall_doubleneg: ∀(t: T), ¬¬(pred t) :=
      begin
        assume t,
        assume pf_neg,
        have pf_exists := exists.intro t pf_neg,
        contradiction,
      end,
      have pf_forall: ∀(t: T), pred t :=
      begin
        assume t,
        have pf_doubleneg := pf_forall_doubleneg t,
        cases (em (pred t)) with pf_pred pf_npred,
          -- pred t
          assumption,
          -- ¬pred t
          contradiction,
      end,
     contradiction,
    -- backward
    assume pf_existsnot,
    assume pf_forall,
    apply exists.elim pf_existsnot,
    assume w pw,
    have pf_predw := pf_forall w,
    contradiction,
end


section propositional

variables P Q R : Prop

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

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

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro h,
  by_contradiction hboom,
  have hq : false := h hboom,
  exact hq,
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,
  repeat {assumption},
end

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

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro h,
  intro hp,
  cases h,
  contradiction,
  exact h,
end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro h,
  intro hnp,
  cases h,
  contradiction,
  exact h,
end

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

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro h,
  intro hq,
  intro nq,
  have hpq: Q := h nq,
  contradiction,
end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin
  intro h,
  intro hp,
  by_contradiction hboom,
  have hpq: ¬P := h hboom,
  contradiction,
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 P,
  left,
  exact h,
  right,
  exact h,
end

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

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

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

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro h,
  intro hnpnq,
  cases h with hp hq,
  cases hnpnq,
  contradiction,
  cases hnpnq,
  contradiction,
end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro h,
  intro hp,
  cases h,
  cases hp,
  repeat {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,
  cases h,
  intro hpq,
  cases hpq,
  repeat {contradiction},
end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro h,
  by_cases hp: P,
  left,
  intro hq,
  apply h,
  apply and.intro hp hq,
  right,
  exact hp,
end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro h,
  cases h,
  intro hpq,
    cases hpq with hp hq,
    contradiction,
  intro hpq,
    cases hpq with hp hq,
    contradiction,
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,
  left,
  split,
  repeat {assumption},
  right,
  split,
  repeat {assumption},
end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h,
  split,
  cases h,
  repeat {
    cases h with hp hq,
    exact hp,
  },
  cases h,
  left,
  cases h with hp hq,
  exact hq,
  right,
  cases h with hq hr,
  exact hr,
end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro h,
  split,
  repeat {
    cases h,
    left,
    exact h,
    right,
    cases h with hq hr,
    assumption,
  }
end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h,
  cases h with hpq hqr,
  cases hpq,
  left,
  exact hpq,

  cases hqr,
  left,
  exact hqr,
  right,
  split,
  repeat {assumption},

end

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

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro h,
  intro hp,
  intro hq,
  apply h,
  split,
  repeat {assumption},
end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intro h,
  intro hpq,
  apply h,
  repeat {
    cases hpq with hp hq,
    assumption
  },
end

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

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

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

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

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

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro h,
  cases h with hp hq,
  exact hp,
end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro h,
  cases h with hp hq,
  exact hq,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,
  intro h,
    cases h,
    exact h_left,
  intro h,
  split,
  repeat {exact h},
end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,
  intro h,
    cases h,
    repeat {exact h},
  intro h,
  left,
  exact h,
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 h,
  intro u,
  intro hp,
  apply h,
  existsi u,
  exact hp,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro h,
  intro hp,
  cases hp with u hu,
  apply h u,
  exact hu,
end

theorem demorgan_forall :
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro h,
  by_contradiction hboom,
  apply h,
  intro u,
  by_contra,
  apply hboom,
  existsi u,
  exact h,
end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro h,
  intro hp,
  cases h with u hu,
  apply hu,
  apply hp u,
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 h,
  intro hp,
  cases h with u hu,
  apply hp u,
  exact hu,
end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro h,
  intro hp,
  cases hp with u hu,
  apply hu,
  apply h u,
end

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

theorem exists_as_neg_forall_converse :
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro h,
  by_contradiction hboom,
  apply h,
  intro u,
  intro pu,
  apply hboom,
  existsi u,
  exact pu,
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 h,
  cases h with u hu,
  cases hu with hp hq,
  split,
  repeat {
    existsi u,
    assumption,
  },

end

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

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

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro h,
  split,
  intro u,
  apply (h u).left,
  intro v,
  apply (h v).right,
end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro h,
  intro u,
  cases h with hp hq,
  split,
  apply hp,
  apply hq,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro h,
  intro u,
  cases h,
  left,
  apply h,
  right,
  apply h,
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) 2021 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.W.basic
import set_theory.cardinal.ordinal

/-!
# Cardinality of W-types

This file proves some theorems about the cardinality of W-types. The main result is
`cardinal_mk_le_max_aleph_0_of_fintype` which says that if for any `a : α`,
`β a` is finite, then the cardinality of `W_type β` is at most the maximum of the
cardinality of `α` and `ℵ₀`.
This can be used to prove theorems about the cardinality of algebraic constructions such as
polynomials. There is a surjection from a `W_type` to `mv_polynomial` for example, and
this surjection can be used to put an upper bound on the cardinality of `mv_polynomial`.

## Tags

W, W type, cardinal, first order
-/
universe u

variables {α : Type u} {β : α → Type u}

noncomputable theory

namespace W_type

open_locale cardinal

open cardinal

lemma cardinal_mk_eq_sum : #(W_type β) = sum (λ a : α, #(W_type β) ^ #(β a)) :=
begin
  simp only [cardinal.power_def, ← cardinal.mk_sigma],
  exact mk_congr (equiv_sigma β)
end

/-- `#(W_type β)` is the least cardinal `κ` such that `sum (λ a : α, κ ^ #(β a)) ≤ κ` -/
lemma cardinal_mk_le_of_le {κ : cardinal.{u}} (hκ : sum (λ a : α, κ ^ #(β a)) ≤ κ) :
  #(W_type β) ≤ κ :=
begin
  induction κ using cardinal.induction_on with γ,
  simp only [cardinal.power_def, ← cardinal.mk_sigma, cardinal.le_def] at hκ,
  cases hκ,
  exact cardinal.mk_le_of_injective (elim_injective _ hκ.1 hκ.2)
end

/-- If, for any `a : α`, `β a` is finite, then the cardinality of `W_type β`
  is at most the maximum of the cardinality of `α` and `ℵ₀`  -/
lemma cardinal_mk_le_max_aleph_0_of_fintype [Π a, fintype (β a)] : #(W_type β) ≤ max (#α) ℵ₀ :=
(is_empty_or_nonempty α).elim
  (begin
    introI h,
    rw [cardinal.mk_eq_zero (W_type β)],
    exact zero_le _
  end) $
λ hn, let m := max (#α) ℵ₀ in cardinal_mk_le_of_le $
calc cardinal.sum (λ a, m ^ #(β a))
    ≤ #α * ⨆ a, m ^ #(β a) : cardinal.sum_le_supr _
... ≤ m * ⨆ a, m ^ #(β a) : mul_le_mul' (le_max_left _ _) le_rfl
... = m : mul_eq_left.{u} (le_max_right _ _)
  (csupr_le' $ λ i, pow_le (le_max_right _ _) (lt_aleph_0_of_fintype _)) $
  pos_iff_ne_zero.1 $ order.succ_le_iff.1
    begin
      rw succ_zero,
      obtain ⟨a⟩ : nonempty α, from hn,
      refine le_trans _ (le_csupr (bdd_above_range.{u u} _) a),
      rw ←power_zero,
      exact power_le_power_left (pos_iff_ne_zero.1
        (aleph_0_pos.trans_le (le_max_right _ _))) (zero_le _)
    end

end W_type


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Infinite unions and intersections

If `X : Type` and `A B : set X` are subsets of `X`, then we've
seen that Lean understands the notation `A ∪ B`. Furthermore,
if `x : X` is a term of type `X` then `x ∈ A ∪ B` is
definitionally equal to `x ∈ A ∨ x ∈ B`, and `x ∈ A ∩ B` is
definitionally `x ∈ A ∧ x ∈ B`.

But what about infinite unions and intersections? Turns out
that there are *three* ways to do them in Lean, all with
slightly different notations. There are also ways to switch
between these things.

## `Union` : indexed union over a type.

Say `A₀, A₁, A₂, ...` are infinitely many subsets of `X`.
In Lean we would model this as `A : ℕ → set X`, a function
from the naturals to subsets of `X` sending `i` to `Aᵢ`.
More generally we could have an arbitrary "index type" `ι : Type`
(that's an "iota", the notation typically used for index types)
and a function `A : ι → set X`, corresponding to subsets `Aᵢ` of `X`
as `i` varies through `ι`.

The way to take the union of these sets is `set.Union A` (note the capital U;
small u means union of two things, capital means union of arbitrary
number of things). But you should use the notation for this function,
which is `⋃ (i : ι), A i`. Here is some code and a couple of examples
for you to try.

-/

section Union

-- Let `Aᵢ` for `i : ι` be a collection of subsets of `X`
variables (X : Type) (ι : Type) (A : ι → set X)

-- The union of the Aᵢ

example : set X := ⋃ (i : ι), A i

example : set.Union A = ⋃ (i : ι), A i :=
begin
  -- RHS is notation for LHS; in fact they're syntactically equal
  refl
end

-- A term `x : X` is in the Union if and only if it's in one of the `Aᵢ`

-- The below lemma is not `refl`. It's `set.mem_Union`.

example (x : X) : (x ∈ ⋃ (i : ι), A i) ↔ ∃ i : ι, x ∈ A i :=
begin
  exact set.mem_Union,
end

-- Of course mem_Union is very useful for rewriting, even though it's
-- definitional.

-- You can take the union over more than index type,
-- if have sets `Bᵢₖ` indexed by two variables.

example (ι κ : Type) (B : ι → κ → set X) : set X :=
⋃ (i : ι) (k : κ), B i k

-- This is just implemented as a Union of a Union (just like
-- `∀ a n : ℕ, ...` is internally `∀ a : ℕ, ∀ b : ℕ, ...`)

example (ι κ : Type) (B : ι → κ → set X) :
  (⋃ (i : ι) (k : κ), B i k) = ⋃ (i : ι), ⋃ (k : κ), B i k :=
begin
  -- note that they're actually syntactically equal
  refl
end

/-

## Inter : indexed intersection over a type

Here's the story for the intersection: It's called Inter,
it has all the same syntax.

-/

example : set X := ⋂ (i : ι), A i

example (x : X) : (x ∈ ⋂ (i : ι), A i) ↔ ∀ i : ι, x ∈ A i :=
begin
  exact set.mem_Inter, -- also not `refl`.
end

-- Now try these exercises.

variable (Y : Type)

example (F : ι → set X) (f : X → Y) :
  f '' (⋃ (i : ι), F i) = ⋃ (i : ι), f '' (F i) :=
begin
  -- Try a proof from first principles starting with `ext y`
  -- Also try `library_search`.
  sorry
end

example (G : ι → set Y) (f : X → Y) :
  f ⁻¹' (⋃ (i : ι), G i) = ⋃ (i : ι), f ⁻¹' (G i) :=
begin
  -- If you tried `library_search` last time, try
  -- guessing the name of the theorem this time
  sorry
end

example (G : ι → set Y) (f : X → Y) :
  f ⁻¹' (⋂ (i : ι), G i) = ⋂ (i : ι), f ⁻¹' (G i) :=
begin
  -- If you don't want to do it, can you guess the name?
  sorry
end

-- What do you think about `set.image_Inter` by the way?
-- Try stating what it should say. Is it true?

-- NB note the brackets around the LHS; Lean seems to
-- eat the equality and keep eating when trying to figure
-- out the ⋃ notation otherwise

-- Here's a couple more for you to try
example (S : set X) : (⋃ i, A i) ⊆ S ↔ (∀ i, A i ⊆ S) :=
begin
  sorry
end

example (κ : Type) (B : ι → κ → set X) :
  (⋃ (i : ι) (k : κ), B i k) = ⋃ (k : κ) (i : ι), B i k :=
begin
  sorry,
end

-- Feel free to make some up yourselves if you want abstract practice;
-- however you might just want to get to the topology.

end Union

/-

## `bUnion` : union of indexed sets satisfying a condition

What if we still have our family of sets `A₀`, `A₁`, `A₂` indexed over the
naturals, but we want to only take the union over the `Aᵢ` with `i` even,
or with `i` prime? More generally, what if we have `A : ι → set X` and some
subset `S : set ι` and we want to take the union of `Aᵢ` for `i ∈ S`?

Lean calls this concept `set.bUnion`. The actual definition `set.bUnion`
doesn't exist, but the lemmas about it all have this name.

-/

section bUnion

-- Let `Aᵢ` for `i : ι` be a collection of subsets of `X`
variables (X : Type) (ι : Type) (A : ι → set X) (S : set ι)

-- The union of the Aᵢ for which P(i) is true

example : set X := ⋃ (i ∈ S), A i

-- here's what the notation expands to
example : (⋃ (i ∈ S), A i) = ⋃ (i : ι) (h : i ∈ S), A i := rfl

-- So get this; it's taking a union over all i of a union over all proofs
-- that `i ∈ S` of Aᵢ. This works! If `i : ι` then if you take the
-- union over all proofs that `i ∈ S` of `A i` then either there's no
-- proofs (because it's false) and the union is empty, or there's
-- at least one proof (because it's true) and so you get `A i`. Now
-- take the union over all `i` and it works!

-- A term `x : X` is in the sUnion if and only if it's in one of the
-- elements of S

-- The below lemma can be proved with `refl`. It's `set.mem_sUnion`
-- (even if it's true by definition, having name is useful for rewriting)

example (x : X) : x ∈ (⋃ (i ∈ S), A i) ↔ ∃ (i : ι) (h : i ∈ S), x ∈ A i :=
begin
  -- not refl
  exact set.mem_bUnion_iff, -- it's slightly sad that mem_bUnion
  -- is only one implication and mem_bUnion_iff is the iff statement.
  -- This isn't like the mem_Union situation.
end

/-

## bInter : indexed intersection over a subset of an index set.

Here's the story:

-/

example : set X := ⋂ (i ∈ S), A i

example (x : X) : x ∈ (⋂ (i ∈ S), A i) ↔ ∀ (i : ι) (h : i ∈ S), x ∈ A i :=
begin
  -- not refl
  exact set.mem_bInter_iff,
end

-- Some exercises

variable (Y : Type)

example (f : X → Y) :
  f '' (⋃ (i ∈ S), A i) = ⋃ (i ∈ S), f '' (A i) :=
begin
  -- If you can guess what it's called you don't need to prove it ;-)
  sorry
end

example (B : ι → set Y) (f : X → Y) :
  f ⁻¹' (⋂ (i ∈ S), B i) = ⋂ (i ∈ S), f ⁻¹' (B i) :=
begin
  sorry
end

end bUnion

/-

## sUnion : union of a set of subsets

Sometimes we don't have a natural indexing type to take an arbitrary union
over; for example the interior of a subset `A` of a topological space is the
union of the open sets contained in `A`.

So here the setup is we have `S : set (set X)`, i.e. a collection of
subsets of `X` (like the open sets in a topology for example),
and we want to take the union of these sets. This union is `set.sUnion S`,
and it has notation `⋃₀`. More precisely:
-/

section sUnion

-- Let `S` be a set of subsets of `X`
variables (X : Type) (S : set (set X))

-- The union of the elements of S
example : set X := ⋃₀ S

example : set.sUnion S = ⋃₀ S :=
begin
  -- RHS is notation for LHS; in fact they're syntactically equal
  refl
end

-- A term `x : X` is in the sUnion if and only if it's in one of the
-- elements of S

-- The below lemma can be proved with `refl`. It's `set.mem_sUnion`
-- (even if it's true by definition, having name is useful for rewriting)

example (x : X) : (x ∈ ⋃₀ S) ↔ ∃ s ∈ S, x ∈ s :=
begin
  exact set.mem_sUnion, -- this
end

-- In fact sUnion is a special case of bUnion, where the index set is `set X`.
example : (⋃₀ S) = ⋃ (s ∈ S), s :=
begin
  exact set.sUnion_eq_bUnion
end

/-

## sInter : intersection of a set of sets

Here's the story:

-/

example : set X := ⋂₀ S

example : set.sInter S = ⋂₀ S :=
begin
  -- RHS is notation for LHS; in fact they're syntactically equal
  refl
end

-- A term `x : X` is in the sInter if and only if it's in all of the
-- elements of S. Can be proved with `refl`. It's `set.mem_sInter`

example (x : X) : (x ∈ ⋂₀ S) ↔ ∀ s ∈ S, x ∈ s :=
begin
  exact set.mem_sInter, -- this is definitional
end

-- Some exercises

variable (Y : Type)

example (S : set (set X)) (f : X → Y) :
  f '' (⋃₀ S) = ⋃₀ ((set.image f) '' S) :=
begin
  -- This should be set.image_sUnion but it doesn't seem to be there?
  sorry
end

example (S : set (set X)) (U : set X) (hU : U ∈ S) :
  ⋂₀ S ⊆ U :=
begin
  -- If you don't want to do it, can you guess the name?
  sorry
end

end sUnion


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics
import data.real.basic -- the reals

/-!

# Sets in Lean, sheet 6 : pushforward and pullback

## Pushforward of a set along a map

If `f : X → Y` then given a subset `S : set X` of `X` we can push it
forward to make a subset `f(S) : set Y` of `Y`. The definition
of `f(S)` is `{y : Y | ∃ x : X, x ∈ S ∧ f x = y}`.

However `f(S)` doesn't make sense in Lean, because `f` eats
terms of type `X` and not `S`, which has type `set X`.
In Lean we use the notation `f '' S` for this. This is notation
for `set.image` and if you need any API for this, it's likely
to use the word `image`.

## Pullback of a set along a map

If `f : X → Y` then given a subset `T : set Y` of `Y` we can
pull it back to make a subset `f⁻¹(T) : set X` of `X`. The definition
of `f⁻¹(T)` is `{x : X | f x ∈ T}`.

However `f⁻¹(T)` doesn't make sense in Lean either, because
`⁻¹` is notation for `has_inv.inv`, whose type in Lean
is `α → α`. In other words, if `x` has a certain type, then
`x⁻¹` *must* have the same type. The notation was basically designed
for group theory. In Lean we use the notation `f ⁻¹' T` for this pullback.

-/

variables (X Y : Type) (f : X → Y) (S : set X) (T : set Y)

example : S ⊆ f ⁻¹' (f '' S) :=
begin
  intros x hx,
  exact ⟨x, hx, rfl⟩, -- use x, etc etc also works
end

example : f '' (f ⁻¹' T) ⊆ T :=
begin
  rintros - ⟨x, hx, rfl⟩,
  exact hx,
end

theorem gc : f '' S ⊆ T ↔ S ⊆ f ⁻¹' T :=
begin
  split,
  { intros h x hxS,
    refine h ⟨x, hxS, rfl⟩ },
  { rintro h - ⟨x, hx, rfl⟩,
    refine h hx }
end

-- image and preimage form a Galois connection
-- look up Galois connections in the mathlib docs to learn about what these are
-- right click on `galois_connection` or do `unfold galois_connection` to
-- find out what this question's asking
-- NB `≤` on subsets is defined to be `⊆`
example : galois_connection (λ S, f '' S) (λ T, f ⁻¹' T) :=
begin
  apply gc,
end


/-
Copyright (c) 2022 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu

! This file was ported from Lean 3 source module logic.hydra
! leanprover-community/mathlib commit e9b8651eb1ad354f4de6be35a38ef31efcd2cfaa
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finsupp.Lex
import Mathbin.Data.Finsupp.Multiset
import Mathbin.Order.GameAdd

/-!
# Termination of a hydra game

This file deals with the following version of the hydra game: each head of the hydra is
labelled by an element in a type `α`, and when you cut off one head with label `a`, it
grows back an arbitrary but finite number of heads, all labelled by elements smaller than
`a` with respect to a well-founded relation `r` on `α`. We show that no matter how (in
what order) you choose cut off the heads, the game always terminates, i.e. all heads will
eventually be cut off (but of course it can last arbitrarily long, i.e. takes an
arbitrary finite number of steps).

This result is stated as the well-foundedness of the `cut_expand` relation defined in
this file: we model the heads of the hydra as a multiset of elements of `α`, and the
valid "moves" of the game are modelled by the relation `cut_expand r` on `multiset α`:
`cut_expand r s' s` is true iff `s'` is obtained by removing one head `a ∈ s` and
adding back an arbitrary multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.

We follow the proof by Peter LeFanu Lumsdaine at https://mathoverflow.net/a/229084/3332.

TODO: formalize the relations corresponding to more powerful (e.g. Kirby–Paris and Buchholz)
hydras, and prove their well-foundedness.
-/

namespace Relation

open Multiset Prod

variable {α : Type _}

/-- The relation that specifies valid moves in our hydra game. `cut_expand r s' s`
  means that `s'` is obtained by removing one head `a ∈ s` and adding back an arbitrary
  multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.

  This is most directly translated into `s' = s.erase a + t`, but `multiset.erase` requires
  `decidable_eq α`, so we use the equivalent condition `s' + {a} = s + t` instead, which
  is also easier to verify for explicit multisets `s'`, `s` and `t`.

  We also don't include the condition `a ∈ s` because `s' + {a} = s + t` already
  guarantees `a ∈ s + t`, and if `r` is irreflexive then `a ∉ t`, which is the
  case when `r` is well-founded, the case we are primarily interested in.

  The lemma `relation.cut_expand_iff` below converts between this convenient definition
  and the direct translation when `r` is irreflexive. -/
def CutExpand (r : α → α → Prop) (s' s : Multiset α) : Prop :=
  ∃ (t : Multiset α)(a : α), (∀ a' ∈ t, r a' a) ∧ s' + {a} = s + t
#align relation.cut_expand Relation.CutExpand

variable {r : α → α → Prop}

theorem cutExpand_le_invImage_lex [hi : IsIrrefl α r] :
    CutExpand r ≤ InvImage (Finsupp.Lex (rᶜ ⊓ (· ≠ ·)) (· < ·)) toFinsupp :=
  fun s t ⟨u, a, hr, he⟩ => by
  classical
    refine' ⟨a, fun b h => _, _⟩ <;> simp_rw [to_finsupp_apply]
    · apply_fun count b  at he
      simp_rw [count_add] at he
      convert he <;> convert(add_zero _).symm <;> rw [count_eq_zero] <;> intro hb
      exacts[h.2 (mem_singleton.1 hb), h.1 (hr b hb)]
    · apply_fun count a  at he
      simp_rw [count_add, count_singleton_self] at he
      apply Nat.lt_of_succ_le
      convert he.le
      convert(add_zero _).symm
      exact count_eq_zero.2 fun ha => hi.irrefl a <| hr a ha
#align relation.cut_expand_le_inv_image_lex Relation.cutExpand_le_invImage_lex

theorem cutExpand_singleton {s x} (h : ∀ x' ∈ s, r x' x) : CutExpand r s {x} :=
  ⟨s, x, h, add_comm s _⟩
#align relation.cut_expand_singleton Relation.cutExpand_singleton

theorem cutExpand_singleton_singleton {x' x} (h : r x' x) : CutExpand r {x'} {x} :=
  cutExpand_singleton fun a h => by rwa [mem_singleton.1 h]
#align relation.cut_expand_singleton_singleton Relation.cutExpand_singleton_singleton

theorem cutExpand_add_left {t u} (s) : CutExpand r (s + t) (s + u) ↔ CutExpand r t u :=
  exists₂_congr fun _ _ => and_congr Iff.rfl <| by rw [add_assoc, add_assoc, add_left_cancel_iff]
#align relation.cut_expand_add_left Relation.cutExpand_add_left

theorem cutExpand_iff [DecidableEq α] [IsIrrefl α r] {s' s : Multiset α} :
    CutExpand r s' s ↔
      ∃ (t : Multiset α)(a : _), (∀ a' ∈ t, r a' a) ∧ a ∈ s ∧ s' = s.eraseₓ a + t :=
  by
  simp_rw [cut_expand, add_singleton_eq_iff]
  refine' exists₂_congr fun t a => ⟨_, _⟩
  · rintro ⟨ht, ha, rfl⟩
    obtain h | h := mem_add.1 ha
    exacts[⟨ht, h, t.erase_add_left_pos h⟩, (@irrefl α r _ a (ht a h)).elim]
  · rintro ⟨ht, h, rfl⟩
    exact ⟨ht, mem_add.2 (Or.inl h), (t.erase_add_left_pos h).symm⟩
#align relation.cut_expand_iff Relation.cutExpand_iff

theorem not_cutExpand_zero [IsIrrefl α r] (s) : ¬CutExpand r s 0 := by
  classical
    rw [cut_expand_iff]
    rintro ⟨_, _, _, ⟨⟩, _⟩
#align relation.not_cut_expand_zero Relation.not_cutExpand_zero

/-- For any relation `r` on `α`, multiset addition `multiset α × multiset α → multiset α` is a
  fibration between the game sum of `cut_expand r` with itself and `cut_expand r` itself. -/
theorem cutExpand_fibration (r : α → α → Prop) :
    Fibration (GameAdd (CutExpand r) (CutExpand r)) (CutExpand r) fun s => s.1 + s.2 :=
  by
  rintro ⟨s₁, s₂⟩ s ⟨t, a, hr, he⟩; dsimp at he⊢
  classical
    obtain ⟨ha, rfl⟩ := add_singleton_eq_iff.1 he
    rw [add_assoc, mem_add] at ha
    obtain h | h := ha
    · refine' ⟨(s₁.erase a + t, s₂), game_add.fst ⟨t, a, hr, _⟩, _⟩
      · rw [add_comm, ← add_assoc, singleton_add, cons_erase h]
      · rw [add_assoc s₁, erase_add_left_pos _ h, add_right_comm, add_assoc]
    · refine' ⟨(s₁, (s₂ + t).eraseₓ a), game_add.snd ⟨t, a, hr, _⟩, _⟩
      · rw [add_comm, singleton_add, cons_erase h]
      · rw [add_assoc, erase_add_right_pos _ h]
#align relation.cut_expand_fibration Relation.cutExpand_fibration

/-- A multiset is accessible under `cut_expand` if all its singleton subsets are,
  assuming `r` is irreflexive. -/
theorem acc_of_singleton [IsIrrefl α r] {s : Multiset α} :
    (∀ a ∈ s, Acc (CutExpand r) {a}) → Acc (CutExpand r) s :=
  by
  refine' Multiset.induction _ _ s
  · exact fun _ => Acc.intro 0 fun s h => (not_cut_expand_zero s h).elim
  · intro a s ih hacc
    rw [← s.singleton_add a]
    exact
      ((hacc a <| s.mem_cons_self a).prod_gameAdd <|
            ih fun a ha => hacc a <| mem_cons_of_mem ha).of_fibration
        _ (cut_expand_fibration r)
#align relation.acc_of_singleton Relation.acc_of_singleton

/-- A singleton `{a}` is accessible under `cut_expand r` if `a` is accessible under `r`,
  assuming `r` is irreflexive. -/
theorem Acc.cutExpand [IsIrrefl α r] {a : α} (hacc : Acc r a) : Acc (CutExpand r) {a} :=
  by
  induction' hacc with a h ih
  refine' Acc.intro _ fun s => _
  classical
    rw [cut_expand_iff]
    rintro ⟨t, a, hr, rfl | ⟨⟨⟩⟩, rfl⟩
    refine' acc_of_singleton fun a' => _
    rw [erase_singleton, zero_add]
    exact ih a' ∘ hr a'
#align acc.cut_expand Acc.cutExpand

/-- `cut_expand r` is well-founded when `r` is. -/
theorem WellFounded.cutExpand (hr : WellFounded r) : WellFounded (CutExpand r) :=
  ⟨letI h := hr.is_irrefl
    fun s => acc_of_singleton fun a _ => (hr.apply a).CutExpand⟩
#align well_founded.cut_expand WellFounded.cutExpand

end Relation


/- This file contains the basic definitions needed to talk about matroid union and matroid
intersection.-/

import matroid.submatroid.projection prelim.minmax

open_locale classical
noncomputable theory
open matroid set

variables {α : Type*} [fintype α]

-- setting up the various types we are minimizing/maximizing over, and associated nonempty/fintype
-- instances
section prelim

/-- property of a pair of independent sets in M₁, M₂ respectively  -/
def is_indep_pair (M₁ M₂ : matroid α) := λ (p : set α × set α), M₁.is_indep p.1 ∧ M₂.is_indep p.2

/-- property of being bases of both M₁ M₂  -/
def is_basis_pair (M₁ M₂ : matroid α) := λ (p : set α × set α), M₁.is_basis p.1 ∧ M₂.is_basis p.2

/-- type of disjoint pairs of sets in α -/
def is_disjoint (pair : (set α × set α)) := pair.1 ∩ pair.2 = ∅

/-- type of pairs of independent sets of M₁,M₂ respectively -/
def indep_pair (M₁ M₂ : matroid α) := {p : set α × set α // is_indep_pair M₁ M₂ p }

/-- type of pairs of bases of M₁, M₂ -/
def basis_pair (M₁ M₂ : matroid α) := {p : set α × set α // is_basis_pair M₁ M₂ p }

/-- type of pairs of independent sets that are both contained in a subset X -/
def indep_pair_of_subset (M₁ M₂ : matroid α) (X : set α) :=
  {p : set α × set α // is_indep_pair M₁ M₂ p ∧ (p.1 ⊆ X ∧ p.2 ⊆ X) }

/-- size of the intersection of a pair of sets -/
def inter_size (pair : (set α × set α)) : ℤ := size (pair.1 ∩ pair.2)

/-- size of the union of a pair of sets -/
def union_size (pair : (set α × set α)) : ℤ := size (pair.1 ∪ pair.2)

/-- type of pairs of disjoint independent sets of M₁,M₂ respectively -/
def disjoint_indep_pair (M₁ M₂ : matroid α) := {pair : indep_pair M₁ M₂ // is_disjoint pair.1}

/-- type of pairs of disjoint bases of M₁,M₂ respectively -/
def disjoint_basis_pair (M₁ M₂ : matroid α) := {pair : basis_pair M₁ M₂ // is_disjoint pair.1}

/-- is the intersection of a basis of M₁ and a basis of M₂ -/
def is_inter_bases (M₁ M₂ : matroid α) :=
  λ X, ∃ B₁ B₂, is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∩ B₂ = X

/-- type of sets that are the intersection of a basis of M₁ and a basis of M₂-/
def inter_bases (M₁ M₂ : matroid α) := {X : set α // is_inter_bases M₁ M₂ X}

/-- is contained in the intersection of a basis of M₁ and a basis of M₂-/
def is_subset_inter_bases (M₁ M₂ : matroid α) :=
  λ X, ∃ Y, is_inter_bases M₁ M₂ Y ∧ X ⊆ Y

/-- is the union of an independent set of M₁ and an independent set of M₂-/
def is_union_two_indep (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ I₁ I₂, is_indep M₁ I₁ ∧ is_indep M₂ I₂ ∧ X = I₁ ∪ I₂

/-- has a partition into an independent set of M₁ and an independent set of M₂-/
def is_two_partitionable (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ I₁ I₂, is_indep M₁ I₁ ∧ is_indep M₂ I₂ ∧ X = I₁ ∪ I₂ ∧ I₁ ∩ I₂ = ∅

/-- has a partition into a basis of M₁ and a basis set of M₂-/
def is_two_basis_partitionable (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ B₁ B₂ , is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∪ B₂ = X ∧ B₁ ∩ B₂ = ∅

/-- is the union of a basis of M₁ and a basis of M₂ -/
def is_union_two_bases (M₁ M₂ : matroid α) : set α → Prop :=
  λ X, ∃ B₁ B₂, is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∪ B₂ = X

/--independence in both M₁ and M₂ -/
def is_common_ind (M₁ M₂ : matroid α) :=
  λ X, is_indep M₁ X ∧ is_indep M₂ X

/-- subtype of common independent sets -/
def common_ind (M₁ M₂ : matroid α) := {X : set α // is_common_ind M₁ M₂ X}

-- All the types above are trivially finite, and nonempty because bases/independent sets exist

instance indep_pair_fintype {M₁ M₂ : matroid α} : fintype (indep_pair M₁ M₂) :=
  by {unfold indep_pair, apply_instance }

instance basis_pair_fintype {M₁ M₂ : matroid α} : fintype (basis_pair M₁ M₂) :=
  by {unfold basis_pair, apply_instance }

instance indep_pair_nonempty {M₁ M₂ : matroid α} : nonempty (indep_pair M₁ M₂) :=
begin
  simp only [indep_pair, nonempty_subtype, prod.exists],
  from ⟨∅, ∅, ⟨M₁.empty_indep, M₂.empty_indep⟩ ⟩ ,
end

instance indep_pair_of_subset_nonempty {M₁ M₂ : matroid α} {X : set α} :
  nonempty (indep_pair_of_subset M₁ M₂ X) :=
begin
  simp only [indep_pair_of_subset, nonempty_subtype, prod.exists],
  from ⟨∅, ∅, ⟨M₁.empty_indep, M₂.empty_indep⟩, ⟨empty_subset _, empty_subset _⟩ ⟩ ,
end

instance indep_pair_of_subset_fintype {M₁ M₂ : matroid α} {X : set α} :
  fintype (indep_pair_of_subset M₁ M₂ X) :=
begin
  unfold indep_pair_of_subset, apply_instance,
end

instance basis_pair_nonempty {M₁ M₂ : matroid α} : nonempty (basis_pair M₁ M₂) :=
begin
  simp only [basis_pair, exists_and_distrib_right, nonempty_subtype, exists_and_distrib_left,
  prod.exists],
  cases exists_basis M₁ with B₁ hB₁,
  cases exists_basis M₂ with B₂ hB₂,
  from ⟨B₁, B₂, hB₁, hB₂⟩,
end

lemma exists_inter_bases (M₁ M₂ : matroid α) :
  ∃ I, (is_inter_bases M₁ M₂ I) :=
begin
  cases exists_basis M₁ with B₁ hB₁,
  cases exists_basis M₂ with B₂ hB₂,
  from ⟨B₁ ∩ B₂, ⟨B₁,B₂,hB₁,hB₂,rfl⟩⟩,
end

instance inter_bases_nonempty (M₁ M₂ : matroid α) : nonempty (inter_bases M₁ M₂) :=
by {apply nonempty_subtype.mpr, apply exists_inter_bases, }

instance inter_bases_fintype (M₁ M₂ : matroid α) : fintype (inter_bases M₁ M₂) :=
by {unfold inter_bases, apply_instance,}

instance disjoint_indep_pair_nonempty (M₁ M₂ : matroid α) :
  nonempty (disjoint_indep_pair M₁ M₂) :=
by {unfold disjoint_indep_pair, refine nonempty_subtype.mpr _,
     use ⟨⟨∅,∅⟩, ⟨empty_indep M₁, empty_indep M₂⟩⟩, tidy,  }

instance nonempty_common_ind (M₁ M₂ : matroid α) : nonempty (common_ind M₁ M₂) :=
by {apply nonempty_subtype.mpr, from ⟨∅, ⟨empty_indep M₁, empty_indep M₂⟩⟩}

instance fintype_common_ind (M₁ M₂ : matroid α ) : fintype (common_ind M₁ M₂):=
  by {unfold common_ind, apply_instance}

instance coe_common_ind (M₁ M₂ : matroid α) : has_coe (common_ind M₁ M₂) (set α) :=
  ⟨λ X, X.val⟩

end prelim

section params

/-- size of largest common independent set of M₁ and M₂ -/
def ν (M₁ M₂ : matroid α) : ℤ :=
  max_val (λ (X : common_ind M₁ M₂), size X.val)

/-- size of the largest set that is the union of independent sets of M₁ and M₂-/
def π₂ (M₁ M₂ : matroid α) : ℤ :=
  max_val (λ (Ip : indep_pair M₁ M₂), union_size Ip.val)

end params

section lists

open_locale big_operators

variables {n : ℕ}

def is_indep_tuple (Ms : fin n → matroid α) (Xs : fin n → set α) :=
  ∀ i, (Ms i).is_indep (Xs i)

def indep_tuple (Ms : fin n → matroid α) :=
  {Is : fin n → set α // is_indep_tuple Ms Is}

instance indep_tuple_nonempty (Ms : fin n → matroid α) : nonempty (indep_tuple Ms) :=
  by {apply nonempty_subtype.mpr, exact ⟨λ i, ∅, λ i, (Ms i).empty_indep⟩,}

instance indep_tuple_fintype (Ms : fin n → matroid α) : fintype (indep_tuple Ms) :=
  by {unfold indep_tuple, apply_instance,  }

/-- size of largest partitionable set wrt a tuple of matroids -/
def π {n : ℕ} (Ms : fin n → matroid α) : ℤ :=
  max_val (λ Is : (indep_tuple Ms), size (set.Union Is.val))

def is_union_indep_tuple {n : ℕ} (Ms : fin n → matroid α) : (set α) → Prop :=
  λ X, ∃ (Is : indep_tuple Ms), X = set.Union Is.val

end lists
/-
/- property of a pair (M,X) that X is indep in M -/
def is_matroid_indep_pair : (matroid α) × (set α) → Prop := λ p, is_indep p.1 p.2

/- rank in M of X, given a pair (M,X) -/
def matroid_set_pair_to_rank : (matroid α) × (set α) → ℤ := λ p, p.1.r p.2

/- property of being a list of independent sets wrt a list of matroids -/
def is_indep_list (Ms : list (matroid α)) : list (set α) → Prop :=
  λ Xs, Xs.length = Ms.length ∧ (∀ MX ∈ Ms.zip Xs, is_matroid_indep_pair MX)

/- type of indep lists of a list of matroids -/
def indep_list (Ms : list (matroid α)) := {Xs : list (set α) // is_indep_list Ms Xs}

/- property of being the union of an indep list (equivalent to partitionability) -/
def is_union_indep_list'' (Ms : list (matroid α)) : (set α) → Prop :=
  λ Y, ∃ (Xs : indep_list Ms), list_union Xs.val = Y

def is_indep_pair_list : list (matroid α × set α) → Prop :=
  λ Ps, (∀ p ∈ Ps, is_matroid_indep_pair p)

def indep_pair_list := {Ps : list (matroid α × set α) // is_indep_pair_list Ps}

def is_union_indep_list' (Ms : list (matroid α)) : set α → Prop :=
  λ Y, ∃ (Ps : indep_pair_list), Ps.val.unzip.1 = Ms ∧ list_union Ps.val.unzip.2 = Y

/- sum of ranks of a list of sets in a list of matroids -/
def sum_of_ranks_of_sets (Ms : list (matroid α)) (Xs : list (set α)) : ℤ :=
  list.sum (list.map (matroid_set_pair_to_rank) (Ms.zip Xs))

/- sum of ranks of a fixed set in a list of matroids -/
def sum_of_ranks_of_set (Ms : list (matroid α)) (X : set α) :ℤ :=
  sum_of_ranks_of_sets Ms (list.repeat X Ms.length)

@[simp] lemma sum_ranks_sets_empty_list (X : list (set α)) :
  sum_of_ranks_of_sets (list.nil) X = 0 :=
by {unfold sum_of_ranks_of_sets, simp, }

@[simp] lemma sum_ranks_set_empty_list (X : set α) :
  sum_of_ranks_of_set (list.nil) X = 0 :=
by {unfold sum_of_ranks_of_set, simp, }

instance indep_list_nonempty (Ms : list (matroid α)) : nonempty (indep_list Ms) :=
begin
  apply nonempty_subtype.mpr,
  unfold is_indep_list,
  induction Ms,
  from ⟨list.nil, by dec_trivial⟩,
  rcases Ms_ih with ⟨Ms',⟨h1,h2⟩⟩ ,
  refine ⟨Ms'.cons ∅, ⟨by simp [h1], λ MX, _⟩⟩,
  simp only [list.mem_cons_iff, list.zip_cons_cons],
  rintro ⟨c1, c2⟩,
  apply empty_indep, apply h2, from H,
  -- I imagine this shouldn't be so hard
end

instance indep_list_fintype (Ms : list (matroid α)) : fintype (indep_list Ms) :=
begin
  set f : indep_list Ms → vector (set α) (Ms.length) := λ Xs, ⟨Xs.val, Xs.property.1⟩ with hf,
  refine fintype.of_injective f (λ x x' hxx', _),
  dsimp [f] at hxx', cases x, cases x',
  rw subtype.mk_eq_mk at ⊢ hxx', from hxx',
  -- likewise
end

lemma indep_list_nil_elim {Xs : list (set α)} :
  is_indep_list (list.nil : list (matroid α)) Xs → Xs = list.nil :=
by {rintros ⟨hx,hx'⟩, simp [list.length_eq_zero] at hx, from hx,}

lemma indep_list_nil_iff_nil {Xs : list (set α)} :
  is_indep_list (list.nil : list (matroid α)) Xs ↔ Xs = list.nil :=
by {refine ⟨λ h, indep_list_nil_elim h, λ h,_⟩, unfold is_indep_list, rw h, simp, }

lemma indep_list_nil_elim_subtype (Xs : indep_list (list.nil : list (matroid α))) :
  Xs.val = list.nil :=
indep_list_nil_elim Xs.property

instance indep_nil_list_subsingleton :
  subsingleton (indep_list (list.nil : list (matroid α))) :=
⟨λ x y, by {cases x, cases y, rw [subtype.mk_eq_mk], rw [indep_list_nil_elim x_property, indep_list_nil_elim y_property],  }⟩

-- These next two lemmas are TODO - they should be provable and useful. Commented to avoid sorries

/-lemma indep_list_iff_exists_zip (Ms : list (matroid α)) (X : set α) :
  is_union_indep_list Ms X ↔
    (∃ zMs : list ((matroid α) × (set α)),
    (
      ∀ p ∈ zMs, is_matroid_indep_pair p) ∧
      (list.unzip zMs).1 = Ms ∧
      list_union (list.unzip zMs).2 = X
    ) :=
begin

end

lemma union_of_indep_cons (Ms : list (matroid α)) (N : matroid α) (X : set α) :
  is_union_indep_list (N :: Ms) X ↔ ∃ Y X₀, is_indep N Y ∧ is_union_indep_list Ms X₀ ∧ Y ∪ X₀ = X :=
begin
  unfold is_union_indep_list,
  simp only [exists_exists_eq_and, exists_and_distrib_left, subtype.val_eq_coe],
  refine ⟨λ h, _, λ h, _⟩,
  rcases h with ⟨⟨Xs, hXs⟩, hu⟩,
  induction Xs with Xhd Xtl, simp at hu,
end-/

/-
@[simp] lemma union_fin_zero (a : fin 0 → set α) :
  (⋃ i, a i) = ∅ :=

-/

-/


/-
CS 2102 F19, Homework #8, Predicate Logic & Proofs.
-/

namespace hw8

/-
#1. Equality and proofs of equality.
-/

/-
A. [10 points] Fill in the blank.

When we say that the binary equality relation,
=, on objects of any type, α, is reflexive, we
mean that for any value, a, of type, α, _______.

ANSWER:
a = a
-/

/-
B. [10 points]
Complete the following definition in Lean
to formalize the proposition that 1 equals
1.
-/

def one_eq_one : Prop :=
    -- ANSWER
    1 = 1

/-
C. [10 points]
Give an English language proof of the
proposition that 1 = 1 by completing the
following incomplete proof.

To obtain a proof of 1 = 1 we apply the ________
property of the ________ relation to the specific
value, _________.

ANSWER:
    reflexive, equals, 1
-/

/-
D. [10 points]
Give a formal proof of this proposition
by completing the following definition.
-/

def proof_that_one_eq_one : one_eq_one :=
    -- ANSWER
    eq.refl 1

/- [10 points]
E. Complete the following test case to produce
an example that suggests (correctly) that Lean
will accept a proof that two *different terms* are
equal as long as they reduce to the same value.
-/

-- ANSWER: Give a proposition and proof in Lean

def two_plus_two_eq_four : Prop :=
    (2+2)=4

def proof_that_two_plus_two_eq_four : two_plus_two_eq_four :=
    eq.refl (2+2)
-- ANSWER Does eq.refl work as suggested? _____
--Yes, the refletive prop works the way I would expect it to

/-
#2. Predicates and Properties

A predicate is a parameterized proposition. By
applying a predicate to different arguments, we get
different propositions. Such a propopsition can
be said to be "about" the argument to which it was
applied.

We interpret such a proposition as asserting that
its argument has a *property* of interest. If the
proposition has a proof (is true), the object does
have the asserted property, and if the proposition
is not true, the object doesn't have that property.

In the  following set of problems, we will take the
property of a natural number "being even" as a case
in point.

In natural language, we will say that a natural
number, n, is even if and only if (1) it is zero,
or, (2) it is two more than another even number.

Think about this inductive definition. Why does it
cover all possible cases -- an infinitude of cases?
(No need for an answer here.)
-/

/-

A. [10 points]

We have accepted as *axioms* in our definition
of evennness that zero is even and that any number
that is two more than another even number is even.
These are the only axioms you may use in giving a
proof that four is even. Give a natural language
proof now. Hint, start by saying the following:

Proof: To prove that four is even, *it will suffice*
to show that 2 is even, because if two is even then,
given that 4 is two more than two, if two is even
then so is four, by rule (2). Now all that remains
to be proved is that _______________.

Give the rest of your natural language proof here,
and be sure to indicate which of the two rules you
are applying at each step in your reasoning.

ANSWER:
All that remains to be proved is that 2 is even. This
can be done by showing that 0 is even and that 2 is
two more than zero. We know that 0 is even because it is
even rule 1. We know that two is even because it is two more
than zero (2)
-/

/-
B. [10 points]

We formalize a predicate, such as is_even, as a
family of "inductive propositions" given by a
function from argument values to propositions.
Such an inductive definition thus has the type,
α → Prop, where α is the type of argument to
which the predicate is applied.

Please see the first line of the definition of
is_even that follows for an example.

Having specified the *type* of a predicate, in
this case from ℕ → Prop, we then define the set
of constructors to define the logical rules that
can be used to construct proofs of any such
proposition.

These rules are the (formal) axioms that can be
used to construct proofs. The first one (below)
states that the term, pf_zero_is_even, is to be
accepted as a proof of is_even 0 (which is how
we write the application of a predicate to a value
to obtain a proposition, here that "0 is even").

The second constructor/axiom/rule provides a way
to build a proof of (is_even 2+n) by applying the
constructor to any n along with a proof that that
particular n is even. (Yes: the ∀ specifies the
first argument to pf_even_plus_two_is_even. This
is necessary to give the argument a name, here n,
so that that name can be used in defining the rest
of the constructor's type).
-/

inductive is_even : ℕ → Prop
| pf_zero_is_even : (is_even 0)
| pf_even_plus_two_is_even :
    ∀ (n : ℕ), is_even n → is_even (nat.succ (nat.succ n))

/-
Give formal proofs for each of the following
propositions. (Notice how we obtain different
propositions by applying the predicate, is_even,
to different argument values. This is what we
mean when we say that a predicate defines a
family of propositions.)
-/

open is_even

theorem zero_even   : is_even 0 :=
    -- ANSWER
    pf_zero_is_even

/-
In this case, give a proof term without using
a begin/end proof script.
-/
theorem two_even    : is_even 2 :=
    -- ANSWER
    pf_even_plus_two_is_even 0 zero_even

/-
In this case, give a proof using a begin/end
proof script.
-/
theorem eight_even  : is_even 8 :=
begin
    apply pf_even_plus_two_is_even,
    apply pf_even_plus_two_is_even,  -- replace this with answer
    apply pf_even_plus_two_is_even,
    exact two_even                   -- exact is the answer
end

/-
C. [10 points]

Formally specify a predicate, is_odd, on the
natural numbers.  You can reason about any
natural number being odd using two rules, just
as for being even. Once you've defined your
predicate (an inductive family of proposition,
just like is_even), formally state and prove
the following propositions (however you wish).

- 1 is odd
- 7 is odd

-/

-- ANSWER
inductive is_odd : ℕ → Prop
| pf_one_is_odd : (is_odd (nat.succ 0))
| pf_odd_plus_two_is_odd :
    ∀ (n : ℕ), is_odd n → is_odd (nat.succ (nat.succ n))
open is_odd

-- ANSWER
theorem one_odd : is_odd 1 :=
    pf_one_is_odd

-- ANSWER
theorem seven_odd : is_odd 7 :=
begin
    apply pf_odd_plus_two_is_odd,
    apply pf_odd_plus_two_is_odd,
    apply pf_odd_plus_two_is_odd,
    exact one_odd
end

/-
Introducing an important concept. In the preceding
problems, we've seen that we can think of a predicate
with one argument as defining a property objects, such
as the property of being even. Now we shift perspective
from the concept of a property, per se, to the concept
of "the set of objects that have a given property." The
set of objects that have the is_even property, for
example, could be written as

    evens = {0, 2, 4, 6, 8, 10, ...}

or more formally as

    evens = { n : ℕ | is_even n}

The elements of these sets are all, and only,
the values that "satisfy" the is_even predicate.
A value satisfies its predicate if, when plugged
in, the resulting proposition has a proof (and so
is true). The key conclusion is that a predicate
with a single argument defines a *set*, namely
the set of all and only those objects that have
that property.
-/

/-
#4. Predicates and binary relations

Mathematicians define *binary relations* as sets
of ordered pairs. For example, the equality relation
on natural numbers comprises the set of of all pairs
of natural numbers such that the first and second
elements are the same. We could write this set like
this:

    equals = { (0,0), (1,1), (2,2), ...},

or like this:

    equals = { (m : ℕ, n : ℕ) | m = n }

We formalize binary relations as predicates with
*two* arguments. The type of such a predicate in
Lean is thus α → β → Prop, where α and β are the
types of the arguments.

In our example, we have a two-place predicate that
defines the set of ordered pairs of natural numbers
where the two elements of each pair are co-equal.

Study and understand the following specification
of this binary relation. Look at the construtor,
mk, in particular: it says that you can construct
a proof that a pair of values, n and m, is in our
id_nat_relation if you have a proof of n = m. (In
other words, it suffices to show that n = m using
Lean's built in equality relation to construct a
proof that (n, m) is in our id_nat_relation.)
-/

inductive id_nat_relation : ℕ → ℕ → Prop
| mk : ∀ (n m : ℕ), n = m → id_nat_relation n m
| sy : ∀ (n m : ℕ), n = m ∧ m = n → id_nat_relation n m
| tr : ∀ (n m c : ℕ), (n = m ∧ m = c ) → n = c → id_nat_relation n m

/-
A. [10 points]

Give a formal proof that id_nat_relation contains
the pair, (3, 3). Do it by completing the following
proof. Think carefully about the third argument: you
need a *value* of what type here? What do we call a
value of a logical type?
-/

theorem three_three_in_id : id_nat_relation 3 3 :=
    -- ANSWER (apply a constructor, of course)
    id_nat_relation.mk 3 3 (eq.refl 3)

/-
B. [10 points]

Explain in just a few words why it is not
possible to prove that (3,5) is in this relation.
-/

-- ANSWER
-- 3 and 5 are not reflexive

/-
EXTRA CREDIT.
-/

/-
Here's a definition of what it means for a
relation to be reflexive.
-/

def reflexive {α : Type} (r : α → α → Prop) :=
    ∀ (a : α), r a a

/-
A. Formally state and prove that id_nat_relation
is reflexive. Hint: use a script and start it
with "assume (a : ℕ)". Remember that to prove a ∀
proposition, we *assume* that we're given some
arbitrary but specific value of the given type,
then we prove the rest of the proposition about
it. But because we didn't say anything about
the element we picked, we can conclude that the
statement must be true of any element of the type.
-/

-- ANSWER

theorem id_nat_refl : reflexive id_nat_relation :=
begin
assume (a : ℕ),
    apply id_nat_relation.mk a a,
    exact eq.refl a
end

/-
B. [Double extra credit.]

Formally define what we mean by a relation being
symmetric and transitive, in the style of the above
definition of reflexive, and formally state and show
that our id_nat_reflexive relation is also symmetric
and transitive.
-/

def symmetric {α : Type} (r : α → α → Prop) :=
    ∀ (a b : α), r a b ↔ r b a

def transitive {α : Type} (r : α → α →  Prop) :=
    ∀ (a b c: α), (r a b ∧ r b c) → r a c

theorem id_nat_symm : symmetric id_nat_relation :=
begin
assume (a : ℕ),
    apply id_nat_relation.sy
end
end hw8


-- Chapter 1. Overview

#check "hello, world!"

-- page 6
namespace hide

inductive nat: Type
| zero: nat
| succ: nat → nat

def add: nat → nat → nat
| m nat.zero := m
| m (nat.succ n) := nat.succ (add m n)

#eval add nat.zero (nat.succ (nat.succ nat.zero))

end hide

def double (n: ℕ) : ℕ := n + n

#check double
#print double
#eval double 2

-- page 7
section
  variables (G : Type) [group G]
  variables g₁ g₂ : G

  #check g₂⁻¹ * g₁ * g₂
  #check g₁⁻¹ * g₁
end

-- page 8
/- An important feature of dependent type theory is that every expression
  has a computational interpretation, which is to say, there are rules
  that specify how they can be /reduced/ to a normal form.
  Moreover, expressions in a computationally pure fragment of the language
  evaluate to /values/ in the way you would expect.
  For example, assuming the definition does not depend on nonconstructive
  components in an essential way, every closed term of type =ℕ= evaluates
  to a numeral. Lean's kernel can carry out this evaluation: -/

#eval (27 + 9) * 33

/- As part of the kernel, the results of this evaluation can be highly trusted.
  The evaluator is not very efficient, however, and is not intended to be used
  for substantial computational tasks. For that purpose, Lean also generates
  bytecode for every definition of a computable object, and can evaluate it on
  demand. To process the bytecode quickly, it uses an efficient /virtual machine/,
  similar to the ones used to interpret OCaml and Python. -/

def double (n : ℕ) : ℕ := n + n

#eval (27 + 9) * 33
#eval (2227 + 9999) * 33
#eval double 9999
#eval [(1, 2), (3, 4), (5, 6)] ++ [(7, 8), (9, 10)]

/- Relying on results from the bytecode evaluator requires a higher level
  of trust than relying on the kernel. For example, for efficiency, the
  bytecode evaluator uses the GNU multiple precision library to carry out
  numerical computations involving the natural numbers and integers, so
  the correctness of those computations are no longer underwritten by
  the axiomatic foundation. -/

/- This points to a second intended use of Lean, namely, as a
  /programming language/. Because dependent type theory is so
  expressive, we can make use of all the usual methods and techniques of
  functional programming, including higher types, type classes, records,
  monads, and other abstractions.

  For example, we can write a generic sort procedure that sorts elements
  of a list according to a specified binary relation =r= on an arbitrary
  type =α=, assuming only that we can determine computationally when =r= holds. -/

section sort
  universe u
  parameters {α : Type u} (r : α → α → Prop) [decidable_rel r]
  local infix `≼` : 50 := r

  def ordered_insert (a : α) : list α → list α
  | []       := [a]
  | (b :: l) := if a ≼ b then a :: (b :: l) else b :: ordered_insert l

  def insertion_sort : list α → list α
  | []       := []
  | (b :: l) := ordered_insert b (insertion_sort l)

-- We can run the procedure above on a list of natural numbers, using the usual ordering:

#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end sort

-- Substantial programs can be written in Lean and run by the bytecode interpreter.

-- page 9
section
def even (n : ℕ) : Prop := ∃ m, n = 2 * m
#check even 10
#check even 11
#check ∀ n, even n ∨ even (n + 1)
#check ∀ n m, even n → even m → even (n + m)

-- Here is how we prove 10 is even.
example: even 10 := ⟨5, rfl⟩

/- To prove an existential statement, it is enough to present a witness to the
   existential quantifier and then show that the claim is true of that witness.
   The Unicode angle brackets just package this data together; enter them in emacs
   with \< and \>, or use the ASCII equivalents, (| and |). -/

-- Here is a proof that the sum of two evens is even.
theorem even_add : ∀ m n, even m → even n → even (m + n) :=
take m n
assume ⟨k, (Hk : m = 2 * k)⟩
assume ⟨l, (Hl : n = 2 * l)⟩
have m + n = 2 * (k + l),
  by simp [Hk, Hl, mul_add]
show even (m + n),
  from ⟨ _ , this⟩

end


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# `equiv`

Let `X` and `Y` be types. Here's the definition of `X ≃ Y`
(which is notation for `equiv X Y`):

```

structure equiv (X : Type) (Y : Type) :=
(to_fun    : X → Y)
(inv_fun   : Y → X)
(left_inv  : ∀ x : X, inv_fun (to_fun x) = x)
(right_inv : ∀ y : Y, to_fun (inv_fun y) = y)

-- notation
infix ` ≃ `:25 := equiv

```

Here's an example: the identity bijection
between a type and itself:
-/

-- this is called `equiv.refl` in `mathlib`
example (X : Type) : X ≃ X :=
{ to_fun := λ x, x, -- x ↦ x
  inv_fun := λ y, y,-- y ↦ y
  left_inv := begin
    -- got to check that `∀ x, inv_fun (to_fun x) = x`
    intro x,
    dsimp, -- if you want to check the goal is definitionally `x = x`
    refl,
  end,
  right_inv := begin
    -- goal is definitionally `∀ y, to_fun (inv_fun y) = y`.
    intro y,
    refl,
  end }

-- now let's see you define `equiv.symm` and `equiv.trans`.
-- Let's start with `equiv.symm`.
-- Note that if `e : X ≃ Y` then `e.to_fun : X → Y`
-- and `e.left_inv` is a proof of `∀ x : X, e.inv_fun (e.to_fun x) = x` etc

example (X Y : Type) (e : X ≃ Y) : Y ≃ X :=
{ to_fun := e.inv_fun,
  inv_fun := e.to_fun,
  left_inv := begin exact e.right_inv end,
  right_inv := e.left_inv }

-- can you build `equiv.trans` yourself?
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
{ to_fun := λ x, eYZ.to_fun (eXY.to_fun x),
  inv_fun := λ z, eXY.inv_fun (eYZ.inv_fun z), -- ditto
  left_inv := begin
    intro x,
    dsimp only,
    rw [eYZ.left_inv, eXY.left_inv],
  end,
  right_inv := begin
    intro z,
    dsimp only,
    rw [eXY.right_inv, eYZ.right_inv],
  end }

-- here's the library's version
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
equiv.trans eXY eYZ

-- here it is again using dot notation
example (X Y Z : Type) (eXY : X ≃ Y) (eYZ : Y ≃ Z) : X ≃ Z :=
eXY.trans eYZ

-- See if you can make the following bijection using dot notation
example (A B C X : Type) (eAX : A ≃ X) (eBX : B ≃ X) : A ≃ B :=
eAX.trans eBX.symm

--sorry -- don't use tactic mode, see if you can find a one-liner
-- using `equiv.symm` and `equiv.trans`

-- We already have `equiv.refl ℚ : ℚ ≃ ℚ`, the identity bijection
-- between `ℚ` and itself. See if you can finish making a different one:

example : ℚ ≃ ℚ :=
{ to_fun := λ x, 3 * x + 4,
  inv_fun := λ y, (y-4)/3,
  left_inv := begin
    intro x,
    simp,
    ring,
  end,
  right_inv := begin
    intro y,
    dsimp,
    ring,
  end }

/-

Note that `equiv` is *data* -- `X ≃ Y` doesn't say "`X` bijects with `Y`";
that statement is a true-false statement. A term of type `X ≃ Y`
is *explicit functions* `X → Y` and `Y → X`, together with proofs
that they're inverse bijections.

Clearly there's an equivalence relation going on *somewhere* though:
here it is.

If `X : Type` then `∃ x : X, true` is just the statement that `X`
is nonempty. It's a proposition. So this works:

-/

-- Two types `X` and `Y` satisfy `R X Y` iff there *exists*
-- a bijection `X ≃ Y`.
def R (X Y : Type) : Prop := ∃ e : X ≃ Y, true

example : equivalence R :=
begin
  refine ⟨_, _, _⟩,
  { intro X,
    use equiv.refl X },
  { rintros X Y ⟨e, he⟩,
    use e.symm },
  { rintros X Y Z ⟨eXY, -⟩ ⟨eYZ, -⟩,
    use eXY.trans eYZ,
  }
end

-- Remark: the equivalence classes of `R` are called *cardinals*.


/- Exercise 2.1: Functional Programming — Lists -/

/- Question 1: Counting elements -/

/- 1.1. Define a function `count` that counts the number of occurrences of an element in a list. It
should be similar to `bcount` from the lecture, except that it takes a value `α` instead of a
predicate `α → bool`.

`decidable_eq` is the type class of types whose equality is decidable. -/

def count {α : Type} (a : α) [decidable_eq α] : list α → ℕ
| [] := 0
| (x :: xs) := count xs + (if x = a then 1 else count xs)

def reverse {α: Type}: list α → list α
| [] := []
| (x :: xs) := reverse xs ++ [x]

lemma count_reverse_eq_count {α: Type} (a: α) (xs: list α) [decidable_eq α]: count a (reverse xs) = count xs
begin

end

/- 1.2. Test your definition of `count` on a few examples to convince yourself that it is
correct. This is something you should always do regardless of whether we ask for it.

You can use `#reduce` or (if `#reduce` fails) `#eval` to do this. -/

#reduce count "a" ["a", "a"]
#reduce count 2 [2,2,2,2,2]
#reduce count 0 [0,0,0,0]
#reduce count 9 []

/- 1.3. Complete the following proof (or replace it with a new proof structure of your own).

Hints: Some of the following lemmas might be useful to reason about `≤`. Moreover, if it helps you
carry out the proof, you could reconsider revising your answer to question 1.1. -/

#check nat.le_add_left
#check nat.le_add_right
#check add_le_add_left
#check add_le_add_right

lemma count_le_length {α : Type} (a : α) [decidable_eq α] :
  ∀xs : list α, count a xs ≤ list.length xs
| [] := by refl
| (x :: xs) :=
  calc count a (x :: xs) = count a xs + (if x = a then 1 else 0) :
    by refl
  ... ≤ list.length xs + (if x = a then 1 else 0) :
    begin
      apply add_le_add_right,
      simp[count_le_length xs]
    end
  ... ≤ list.length (x :: xs) :
    begin
      apply add_le_add_left,
      by_cases (x=a),
      simp[h, list.length],
      simp[h, list.length],
      apply nat.le_add_left
    end

/- Question 2: Removing duplicates -/

/- 2.1. Define a predicate `mem x xs` that returns true if `x` is an element of `xs`. -/

def mem {α: Type} (x: α) [decidable_eq α]: list α → bool
| [] := false
| (xs :: xss):= if (xs = x) then true else mem xss

#reduce mem 2 [7,1]

/- The above `mem` predicate is not quite as convenient as the predefined `list.mem`, for which
theorems and a nice notation (infix `∈`) are available, including a proof of decidability. Let's use
`list.mem` from now on.  -/

#print list.has_mem
#check list.mem
#check list.decidable_mem

/- 2.2. Define a function `remdups` that removes duplicate elements in a list. For example,
`remdups [1, 2, 1, 3]` could return either `[1, 2, 3]` or `[2, 1, 3]`, depending of which of the two
occurrences of `1` is kept.

Hint: One of the two behaviors is easier to implement. -/

def remdumps {α: Type} [decidable_eq α]: list α → list α
| [] := []
| (x :: xs) := if list.mem x xs then remdumps xs else x :: remdumps xs

/- 2.3. Test your implementation on more than two input values, using `#reduce` or `#eval`, and put
the expected value in a comment. -/

#reduce remdumps [2,2,2,3,4,4,4] --Expect 2,3,4

/- Do you find yourself copy-pasting the outcome of `#reduce` into the comment? If so, this defeats
the point of writing a test. You should first think for yourself of the expected result, write it
down, and then compare the actual result with it. -/

/- 2.4. Define a function `remdups_adj` that compresses adjacent duplicates. For example, it would
leave `[1, 2, 1, 3]` unchanged but compress `[1, 1, 2, 2, 2, 1, 3, 3]` to `[1, 2, 1, 3]`. -/

def remdumps_adj {α: Type} [decidable_eq α]: list α → list α
| [] := []
| (x :: xs) := if list.mem x xs && (list.take (list.length xs - list.length(remdumps_adj xs)) = x then remdumps_adj xs else x :: remdumps_adj xs

/- 2.5. Test your implementation on the same values as you used for question 2.3. -/

#reduce remdumps_adj [2,2,2,3,4,3,4]

/- Do the tests detect any difference in behavior between `remdups` and `remdups_adj`? If the answer
is no, this is a strong indication that your tests were incomplete to start with. -/

/- 2.6. Prove that `remdups` does not influence the behavior of `list.mem`.

Hint: Use `by_cases` to distinguish between the case where a given element is kept and the case
where it is removed. -/

@[simp] lemma mem_remdups {α : Type} (a : α) [decidable_eq α] :
  ∀xs : list α, a ∈ remdumps xs ↔ a ∈ xs
| [] := by refl
| (x :: xs) := begin simp[remdumps], by_cases list.mem x xs, { simp [h, mem_remdups xs],
      apply iff.intro,
      { intro, apply or.intro_right, assumption },
      { intro hor,
        apply hor.elim,
        { intro a_eq_x, rw a_eq_x, assumption },
        { intro, assumption } } },
    { simp [h, mem_remdups xs] } end

-- begin
-- intro xs,
-- apply iff.intro,
-- intro l,
-- by_cases a ∈ xs,
-- assumption,
-- cases xs,
-- simp,
-- apply l,

-- end

/- 2.7. State and prove that `remdups_adj` does not influence the behavior of `list.mem`. -/
lemma test {α: Type} (xs: list α) (x: α) [decidable_eq α]: remdumps_adj xs = xs :=
begin
cases xs,
refl,
simp[remdumps_adj],
by_cases
end

/- 2.8. State and prove that `remdups` is idempotent (i.e., that applying it twice has the same
effect as applying it only once). -/

-- enter your answer here

/- 2.9 (**optional bonus**). State and prove that `remdups_adj` is idempotent.

Warning: This one is difficult. -/

-- enter your answer here


-- Valor_absoluto_del_producto_menor_media_de_cuadrados.lean
-- Si a, b ∈ ℝ, entonces |ab| ≤ (a^2 + b^2)/2
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 28-septiembre-2022
-- ---------------------------------------------------------------------

import data.real.basic
import tactic

variables a b : ℝ

-- 1ª demostración
example : abs (a*b) ≤ (a^2 + b^2) / 2 :=
begin
  apply abs_le.mpr,
  split,
  { have h1 : 0 ≤ a^2 + 2*a*b + b^2,
      calc 0 ≤ (a+b)^2                : by exact pow_two_nonneg (a + b)
         ... = a^2+2*a*b+b^2          : by ring,
    have h2 : -2*(a*b) ≤ a^2 + b^2,
      calc -2*(a*b)
           ≤ -2*(a*b)+(a^2+2*a*b+b^2) : by exact le_add_of_nonneg_right h1
       ... = a^2 + b^2                : by ring,
    show -((a^2 + b^2) / 2) ≤ a*b,      by linarith [h2] },
  { have h3 : 0 ≤ a^2 - 2*a*b + b^2,
      calc 0 ≤ (a-b)^2                : by exact pow_two_nonneg (a - b)
         ... = a^2-2*a*b+b^2          : by ring,
    have h4 : 2*(a*b) ≤ a^2 + b^2,
      calc 2*(a*b)
           ≤ 2*(a*b)+(a^2-2*a*b+b^2)  : by exact le_add_of_nonneg_right h3
       ... = a^2 + b^2                : by ring,
    show a * b ≤ (a^2 + b^2)/2,         by linarith [h4] },
end

-- 2ª demostración
example : abs (a*b) ≤ (a^2 + b^2) / 2 :=
begin
  apply abs_le.mpr,
  split,
  { have h1 : 0 ≤ a^2 + 2*a*b + b^2,
      calc 0 ≤ (a+b)^2                : by exact pow_two_nonneg (a + b)
         ... = a^2+2*a*b+b^2          : by ring,
    have h2 : -2*(a*b) ≤ a^2 + b^2,
      calc -2*(a*b)
           ≤ -2*(a*b)+(a^2+2*a*b+b^2) : by exact le_add_of_nonneg_right h1
       ... = a^2 + b^2                : by ring,
    show -((a^2 + b^2) / 2) ≤ a*b,      by linarith [h2] },
  { have h4 : 2*a*b ≤ a^2 + b^2       := two_mul_le_add_sq a b,
    show a * b ≤ (a^2 + b^2)/2,         by linarith [h4] },
end

-- 3ª demostración
example : abs (a*b) ≤ (a^2 + b^2) / 2 :=
begin
  apply abs_le.mpr,
  split,
  { have h1 : 0 ≤ a^2 + 2*a*b + b^2,
      calc 0 ≤ (a+b)^2                : by exact pow_two_nonneg (a + b)
         ... = a^2+2*a*b+b^2          : by ring,
    have h2 : -2*(a*b) ≤ a^2 + b^2,
      calc -2*(a*b)
           ≤ -2*(a*b)+(a^2+2*a*b+b^2) : by exact le_add_of_nonneg_right h1
       ... = a^2 + b^2                : by ring,
    show -((a^2 + b^2) / 2) ≤ a*b,      by linarith [h2] },
  { show a * b ≤ (a^2 + b^2)/2,         by linarith [two_mul_le_add_sq a b] },
end


/-
Copyright (c) 2021 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 3 : "not" (`¬`)

We learn about how to manipulate `¬ P` in Lean.

# Important : the definition of `¬ P`

In Lean, `¬ P` is *defined* to mean `P → false`. So `¬ P` and `P → false`
are *definitionally equal*. Check out the explanation of definitional
equality in the "equality" section of Part B of the course notes.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following tactics:

* `change`
* `by_contra`
* `by_cases`

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : ¬ true → false :=
begin
  intro h,
  change true → false at h,
  apply h,
  triv,
end

example : false → ¬ true :=
begin
  intro h,
  intro h2,
  exact h,
end

example : ¬ false → true :=
begin
  intro h,
  triv,
end

example : true → ¬ false :=
begin
  intro h,
  intro h2,
  exact h2,
end

example : false → ¬ P :=
begin
  intro h,
  intro hP,
  exact h,
end

example : P → ¬ P → false :=
begin
  intro hP,
  intro hnP,
  apply hnP,
  exact hP,
end

example : P → ¬ (¬ P) :=
begin
  intro hP,
  intro hnP,
  apply hnP,
  exact hP,
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  intros hPQ hnQ hP,
  apply hnQ,
  apply hPQ,
  assumption,
end

example : ¬ ¬ false → false :=
begin
  intro h,
  apply h,
  intro h2,
  exact h2,
end

example : ¬ ¬ P → P :=
begin
  intro h,
  by_contra h2,
  apply h,
  exact h2,
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  intros h hP,
  change (Q → false) → (P → false) at h,
  by_contra hnQ,
  apply h,
  { exact hnQ, },
  { exact hP }
end


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.nat.parity
import order.filter.at_top_bot

/-!
# Numbers are frequently modeq to fixed numbers

In this file we prove that `m ≡ d [MOD n]` frequently as `m → ∞`.
-/

open filter

namespace nat

/-- Infinitely many natural numbers are equal to `d` mod `n`. -/

lemma frequently_mod_eq {d n : ℕ} (h : d < n) : ∃ᶠ m in at_top, m % n = d :=
by simpa only [nat.modeq, mod_eq_of_lt h] using frequently_modeq h.ne_bot d

lemma frequently_even : ∃ᶠ m : ℕ in at_top, even m :=
by simpa only [even_iff] using frequently_mod_eq zero_lt_two

lemma frequently_odd : ∃ᶠ m : ℕ in at_top, odd m :=
by simpa only [odd_iff] using frequently_mod_eq one_lt_two

end nat


import Mathlib.Algebra.Ring.Basic
import Mathlib.Tactic.Ring
import Playground.Data.Fin.Family.Basic

namespace Fin.Family
section
  def sum {α n} [Add α] (a : α) (l : Family α n) : α := foldr Add.add a l

  theorem sum_eq_add_sum {α n} [Add α] (a : α) (l : Family α (n + 1))
  : l.sum a = l.head + l.tail.sum a := rfl

  theorem sum_ge {n} (l : Family ℕ n) : ∀ k, l.sum 0 ≥ l k :=
    match n with
    | 0 => f0
    | n + 1 => λ k => match k with
      | ⟨0, _⟩ => show l.head + l.tail.sum _ ≥ l.head from Nat.le_add_right l.head _
      | ⟨k + 1, c⟩ =>
        have := l.tail.sum_ge ⟨k, Nat.lt_of_succ_lt_succ c⟩
        show l.head + l.tail.sum _ ≥ l.tail ⟨k, Nat.lt_of_succ_lt_succ c⟩ from
        (Nat.zero_add (l.tail _)).symm ▸ Nat.add_le_add (Nat.zero_le _) this

  theorem sum_add_eq_add_sum {α n} [CommSemiring α] (f g : Family α n)
  : (of λ i => f i + g i).sum 0 = f.sum 0 + g.sum 0 :=
    match n with
    | 0 => (zero_add (0 : α)).symm ▸ rfl
    | n + 1 =>
      show (f.head + g.head) + (of λ i => f i + g i).tail.sum 0
        = f.head + f.tail.sum 0 + (g.head + g.tail.sum 0) from
      sum_add_eq_add_sum f.tail g.tail ▸ by ring
end
end Fin.Family


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker

! This file was ported from Lean 3 source module data.polynomial.degree.lemmas
! leanprover-community/mathlib commit 728baa2f54e6062c5879a3e397ac6bac323e506f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.Eval

/-!
# Theory of degrees of polynomials

Some of the main results include
- `natDegree_comp_le` : The degree of the composition is at most the product of degrees

-/

noncomputable section

open Classical Polynomial

open Finsupp Finset

namespace Polynomial

universe u v w

variable {R : Type u} {S : Type v} {ι : Type w} {a b : R} {m n : ℕ}

section Semiring

variable [Semiring R] {p q r : R[X]}

section Degree

theorem natDegree_comp_le : natDegree (p.comp q) ≤ natDegree p * natDegree q :=
  if h0 : p.comp q = 0 then by rw [h0, natDegree_zero]; exact Nat.zero_le _
  else
    WithBot.coe_le_coe.1 <|
      calc
        ↑(natDegree (p.comp q)) = degree (p.comp q) := (degree_eq_natDegree h0).symm
        _ = _ := (congr_arg degree comp_eq_sum_left)
        _ ≤ _ := (degree_sum_le _ _)
        _ ≤ _ :=
          Finset.sup_le fun n hn =>
            calc
              degree (C (coeff p n) * q ^ n) ≤ degree (C (coeff p n)) + degree (q ^ n) :=
                degree_mul_le _ _
              _ ≤ natDegree (C (coeff p n)) + n • degree q :=
                (add_le_add degree_le_natDegree (degree_pow_le _ _))
              _ ≤ natDegree (C (coeff p n)) + n • ↑(natDegree q) :=
                (add_le_add_left (nsmul_le_nsmul_of_le_right (@degree_le_natDegree _ _ q) n) _)
              _ = (n * natDegree q : ℕ) := by
                rw [natDegree_C, Nat.cast_zero, zero_add, nsmul_eq_mul];
                  simp
              _ ≤ (natDegree p * natDegree q : ℕ) :=
                WithBot.coe_le_coe.2 <|
                  mul_le_mul_of_nonneg_right (le_natDegree_of_ne_zero (mem_support_iff.1 hn))
                    (Nat.zero_le _)
#align polynomial.nat_degree_comp_le Polynomial.natDegree_comp_le

theorem degree_pos_of_root {p : R[X]} (hp : p ≠ 0) (h : IsRoot p a) : 0 < degree p :=
  lt_of_not_ge fun hlt => by
    have := eq_C_of_degree_le_zero hlt
    rw [IsRoot, this, eval_C] at h
    simp only [h, RingHom.map_zero] at this
    exact hp this
#align polynomial.degree_pos_of_root Polynomial.degree_pos_of_root

theorem natDegree_le_iff_coeff_eq_zero : p.natDegree ≤ n ↔ ∀ N : ℕ, n < N → p.coeff N = 0 := by
  simp_rw [natDegree_le_iff_degree_le, degree_le_iff_coeff_zero, Nat.cast_withBot,
    WithBot.coe_lt_coe]
#align polynomial.nat_degree_le_iff_coeff_eq_zero Polynomial.natDegree_le_iff_coeff_eq_zero

theorem natDegree_add_le_iff_left {n : ℕ} (p q : R[X]) (qn : q.natDegree ≤ n) :
    (p + q).natDegree ≤ n ↔ p.natDegree ≤ n := by
  refine' ⟨fun h => _, fun h => natDegree_add_le_of_degree_le h qn⟩
  refine' natDegree_le_iff_coeff_eq_zero.mpr fun m hm => _
  convert natDegree_le_iff_coeff_eq_zero.mp h m hm using 1
  rw [coeff_add, natDegree_le_iff_coeff_eq_zero.mp qn _ hm, add_zero]
#align polynomial.nat_degree_add_le_iff_left Polynomial.natDegree_add_le_iff_left

theorem natDegree_add_le_iff_right {n : ℕ} (p q : R[X]) (pn : p.natDegree ≤ n) :
    (p + q).natDegree ≤ n ↔ q.natDegree ≤ n := by
  rw [add_comm]
  exact natDegree_add_le_iff_left _ _ pn
#align polynomial.nat_degree_add_le_iff_right Polynomial.natDegree_add_le_iff_right

theorem natDegree_C_mul_le (a : R) (f : R[X]) : (C a * f).natDegree ≤ f.natDegree :=
  calc
    (C a * f).natDegree ≤ (C a).natDegree + f.natDegree := natDegree_mul_le
    _ = 0 + f.natDegree := by rw [natDegree_C a]
    _ = f.natDegree := zero_add _
set_option linter.uppercaseLean3 false in
#align polynomial.nat_degree_C_mul_le Polynomial.natDegree_C_mul_le

theorem natDegree_mul_C_le (f : R[X]) (a : R) : (f * C a).natDegree ≤ f.natDegree :=
  calc
    (f * C a).natDegree ≤ f.natDegree + (C a).natDegree := natDegree_mul_le
    _ = f.natDegree + 0 := by rw [natDegree_C a]
    _ = f.natDegree := add_zero _
set_option linter.uppercaseLean3 false in
#align polynomial.nat_degree_mul_C_le Polynomial.natDegree_mul_C_le

theorem eq_natDegree_of_le_mem_support (pn : p.natDegree ≤ n) (ns : n ∈ p.support) :
    p.natDegree = n :=
  le_antisymm pn (le_natDegree_of_mem_supp _ ns)
#align polynomial.eq_nat_degree_of_le_mem_support Polynomial.eq_natDegree_of_le_mem_support

theorem natDegree_C_mul_eq_of_mul_eq_one {ai : R} (au : ai * a = 1) :
    (C a * p).natDegree = p.natDegree :=
  le_antisymm (natDegree_C_mul_le a p)
    (calc
      p.natDegree = (1 * p).natDegree := by nth_rw 1 [← one_mul p]
      _ = (C ai * (C a * p)).natDegree := by rw [← C_1, ← au, RingHom.map_mul, ← mul_assoc]
      _ ≤ (C a * p).natDegree := natDegree_C_mul_le ai (C a * p))
set_option linter.uppercaseLean3 false in
#align polynomial.nat_degree_C_mul_eq_of_mul_eq_one Polynomial.natDegree_C_mul_eq_of_mul_eq_one

theorem natDegree_mul_C_eq_of_mul_eq_one {ai : R} (au : a * ai = 1) :
    (p * C a).natDegree = p.natDegree :=
  le_antisymm (natDegree_mul_C_le p a)
    (calc
      p.natDegree = (p * 1).natDegree := by nth_rw 1 [← mul_one p]
      _ = (p * C a * C ai).natDegree := by rw [← C_1, ← au, RingHom.map_mul, ← mul_assoc]
      _ ≤ (p * C a).natDegree := natDegree_mul_C_le (p * C a) ai)
set_option linter.uppercaseLean3 false in
#align polynomial.nat_degree_mul_C_eq_of_mul_eq_one Polynomial.natDegree_mul_C_eq_of_mul_eq_one

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_mul_C_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
-/
theorem natDegree_mul_c_eq_of_mul_ne_zero (h : p.leadingCoeff * a ≠ 0) :
    (p * C a).natDegree = p.natDegree := by
  refine' eq_natDegree_of_le_mem_support (natDegree_mul_C_le p a) _
  refine' mem_support_iff.mpr _
  rwa [coeff_mul_C]
set_option linter.uppercaseLean3 false in
#align polynomial.nat_degree_mul_C_eq_of_mul_ne_zero Polynomial.natDegree_mul_c_eq_of_mul_ne_zero

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_C_mul_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
-/
theorem natDegree_c_mul_eq_of_mul_ne_zero (h : a * p.leadingCoeff ≠ 0) :
    (C a * p).natDegree = p.natDegree := by
  refine' eq_natDegree_of_le_mem_support (natDegree_C_mul_le a p) _
  refine' mem_support_iff.mpr _
  rwa [coeff_C_mul]
set_option linter.uppercaseLean3 false in
#align polynomial.nat_degree_C_mul_eq_of_mul_ne_zero Polynomial.natDegree_c_mul_eq_of_mul_ne_zero

theorem natDegree_add_coeff_mul (f g : R[X]) :
    (f * g).coeff (f.natDegree + g.natDegree) = f.coeff f.natDegree * g.coeff g.natDegree := by
  simp only [coeff_natDegree, coeff_mul_degree_add_degree]
#align polynomial.nat_degree_add_coeff_mul Polynomial.natDegree_add_coeff_mul

theorem natDegree_lt_coeff_mul (h : p.natDegree + q.natDegree < m + n) :
    (p * q).coeff (m + n) = 0 :=
  coeff_eq_zero_of_natDegree_lt (natDegree_mul_le.trans_lt h)
#align polynomial.nat_degree_lt_coeff_mul Polynomial.natDegree_lt_coeff_mul

theorem coeff_mul_of_natDegree_le (pm : p.natDegree ≤ m) (qn : q.natDegree ≤ n) :
    (p * q).coeff (m + n) = p.coeff m * q.coeff n := by
  rcases eq_or_lt_of_le pm with (rfl | hm) <;> rcases eq_or_lt_of_le qn with (rfl | hn)
  · exact natDegree_add_coeff_mul _ _
  · rw [coeff_eq_zero_of_natDegree_lt hn, mul_zero]
    exact natDegree_lt_coeff_mul (add_lt_add_left hn _)
  · rw [coeff_eq_zero_of_natDegree_lt hm, zero_mul]
    exact natDegree_lt_coeff_mul (add_lt_add_right hm _)
  · rw [coeff_eq_zero_of_natDegree_lt hn, mul_zero]
    exact natDegree_lt_coeff_mul (add_lt_add hm hn)
#align polynomial.coeff_mul_of_nat_degree_le Polynomial.coeff_mul_of_natDegree_le

theorem coeff_pow_of_natDegree_le (pn : p.natDegree ≤ n) : (p ^ m).coeff (n * m) = p.coeff n ^ m :=
  by
  induction' m with m hm
  · simp
  · rw [pow_succ', pow_succ', ← hm, Nat.mul_succ, coeff_mul_of_natDegree_le _ pn]
    refine' natDegree_pow_le.trans (le_trans _ (mul_comm _ _).le)
    exact mul_le_mul_of_nonneg_left pn m.zero_le
#align polynomial.coeff_pow_of_nat_degree_le Polynomial.coeff_pow_of_natDegree_le

theorem coeff_add_eq_left_of_lt (qn : q.natDegree < n) : (p + q).coeff n = p.coeff n :=
  (coeff_add _ _ _).trans <|
    (congr_arg _ <| coeff_eq_zero_of_natDegree_lt <| qn).trans <| add_zero _
#align polynomial.coeff_add_eq_left_of_lt Polynomial.coeff_add_eq_left_of_lt

theorem coeff_add_eq_right_of_lt (pn : p.natDegree < n) : (p + q).coeff n = q.coeff n := by
  rw [add_comm]
  exact coeff_add_eq_left_of_lt pn
#align polynomial.coeff_add_eq_right_of_lt Polynomial.coeff_add_eq_right_of_lt

theorem degree_sum_eq_of_disjoint (f : S → R[X]) (s : Finset S)
    (h : Set.Pairwise { i | i ∈ s ∧ f i ≠ 0 } (Ne on degree ∘ f)) :
    degree (s.sum f) = s.sup fun i => degree (f i) := by
  induction' s using Finset.induction_on with x s hx IH
  · simp
  · simp only [hx, Finset.sum_insert, not_false_iff, Finset.sup_insert]
    specialize IH (h.mono fun _ => by simp (config := { contextual := true }))
    rcases lt_trichotomy (degree (f x)) (degree (s.sum f)) with (H | H | H)
    · rw [← IH, sup_eq_right.mpr H.le, degree_add_eq_right_of_degree_lt H]
    · rcases s.eq_empty_or_nonempty with (rfl | hs)
      · simp
      obtain ⟨y, hy, hy'⟩ := Finset.exists_mem_eq_sup s hs fun i => degree (f i)
      rw [IH, hy'] at H
      by_cases hx0 : f x = 0
      · simp [hx0, IH]
      have hy0 : f y ≠ 0 := by
        contrapose! H
        simpa [H, degree_eq_bot] using hx0
      refine' absurd H (h _ _ fun H => hx _)
      · simp [hx0]
      · simp [hy, hy0]
      · exact H.symm ▸ hy
    · rw [← IH, sup_eq_left.mpr H.le, degree_add_eq_left_of_degree_lt H]
#align polynomial.degree_sum_eq_of_disjoint Polynomial.degree_sum_eq_of_disjoint

theorem natDegree_sum_eq_of_disjoint (f : S → R[X]) (s : Finset S)
    (h : Set.Pairwise { i | i ∈ s ∧ f i ≠ 0 } (Ne on natDegree ∘ f)) :
    natDegree (s.sum f) = s.sup fun i => natDegree (f i) := by
  by_cases H : ∃ x ∈ s, f x ≠ 0
  · obtain ⟨x, hx, hx'⟩ := H
    have hs : s.Nonempty := ⟨x, hx⟩
    refine' natDegree_eq_of_degree_eq_some _
    rw [degree_sum_eq_of_disjoint]
    · dsimp
      rw [← Finset.sup'_eq_sup hs, ← Finset.sup'_eq_sup hs,
        Nat.cast_withBot, Finset.coe_sup' hs, ←
        Finset.sup'_eq_sup hs]
      refine' le_antisymm _ _
      · rw [Finset.sup'_le_iff]
        intro b hb
        by_cases hb' : f b = 0
        · simpa [hb'] using hs
        rw [degree_eq_natDegree hb', Nat.cast_withBot]
        exact Finset.le_sup' (fun i : S => (natDegree (f i) : WithBot ℕ)) hb
      · rw [Finset.sup'_le_iff]
        intro b hb
        simp only [Finset.le_sup'_iff, exists_prop, Function.comp_apply]
        by_cases hb' : f b = 0
        · refine' ⟨x, hx, _⟩
          contrapose! hx'
          simpa [← Nat.cast_withBot, hb', degree_eq_bot] using hx'
        exact ⟨b, hb, (degree_eq_natDegree hb').ge⟩
    · exact h.imp fun x y hxy hxy' => hxy (natDegree_eq_of_degree_eq hxy')
  · push_neg  at H
    rw [Finset.sum_eq_zero H, natDegree_zero, eq_comm, show 0 = ⊥ from rfl, Finset.sup_eq_bot_iff]
    intro x hx
    simp [H x hx]
#align polynomial.nat_degree_sum_eq_of_disjoint Polynomial.natDegree_sum_eq_of_disjoint

set_option linter.deprecated false in

set_option linter.deprecated false in
theorem natDegree_bit1 (a : R[X]) : (bit1 a).natDegree ≤ a.natDegree :=
  (natDegree_add_le _ _).trans (by simp [natDegree_bit0])
#align polynomial.nat_degree_bit1 Polynomial.natDegree_bit1

variable [Semiring S]

theorem natDegree_pos_of_eval₂_root {p : R[X]} (hp : p ≠ 0) (f : R →+* S) {z : S}
    (hz : eval₂ f z p = 0) (inj : ∀ x : R, f x = 0 → x = 0) : 0 < natDegree p :=
  lt_of_not_ge fun hlt =>
    by
    have A : p = C (p.coeff 0) := eq_C_of_natDegree_le_zero hlt
    rw [A, eval₂_C] at hz
    simp only [inj (p.coeff 0) hz, RingHom.map_zero] at A
    exact hp A
#align polynomial.nat_degree_pos_of_eval₂_root Polynomial.natDegree_pos_of_eval₂_root

theorem degree_pos_of_eval₂_root {p : R[X]} (hp : p ≠ 0) (f : R →+* S) {z : S}
    (hz : eval₂ f z p = 0) (inj : ∀ x : R, f x = 0 → x = 0) : 0 < degree p :=
  natDegree_pos_iff_degree_pos.mp (natDegree_pos_of_eval₂_root hp f hz inj)
#align polynomial.degree_pos_of_eval₂_root Polynomial.degree_pos_of_eval₂_root

@[simp]
theorem coe_lt_degree {p : R[X]} {n : ℕ} : (n : WithBot ℕ) < degree p ↔ n < natDegree p := by
  by_cases h : p = 0
  · simp [h]
  simp [degree_eq_natDegree h, Nat.cast_withBot, WithBot.coe_lt_coe]
#align polynomial.coe_lt_degree Polynomial.coe_lt_degree

end Degree

end Semiring

section Ring

variable [Ring R] {p q : R[X]}

theorem natDegree_sub : (p - q).natDegree = (q - p).natDegree := by rw [← natDegree_neg, neg_sub]
#align polynomial.nat_degree_sub Polynomial.natDegree_sub

theorem natDegree_sub_le_iff_left (qn : q.natDegree ≤ n) :
    (p - q).natDegree ≤ n ↔ p.natDegree ≤ n := by
  rw [← natDegree_neg] at qn
  rw [sub_eq_add_neg, natDegree_add_le_iff_left _ _ qn]
#align polynomial.nat_degree_sub_le_iff_left Polynomial.natDegree_sub_le_iff_left

theorem natDegree_sub_le_iff_right (pn : p.natDegree ≤ n) :
    (p - q).natDegree ≤ n ↔ q.natDegree ≤ n := by rwa [natDegree_sub, natDegree_sub_le_iff_left]
#align polynomial.nat_degree_sub_le_iff_right Polynomial.natDegree_sub_le_iff_right

theorem coeff_sub_eq_left_of_lt (dg : q.natDegree < n) : (p - q).coeff n = p.coeff n := by
  rw [← natDegree_neg] at dg
  rw [sub_eq_add_neg, coeff_add_eq_left_of_lt dg]
#align polynomial.coeff_sub_eq_left_of_lt Polynomial.coeff_sub_eq_left_of_lt

theorem coeff_sub_eq_neg_right_of_lt (df : p.natDegree < n) : (p - q).coeff n = -q.coeff n := by
  rwa [sub_eq_add_neg, coeff_add_eq_right_of_lt, coeff_neg]
#align polynomial.coeff_sub_eq_neg_right_of_lt Polynomial.coeff_sub_eq_neg_right_of_lt

end Ring

section NoZeroDivisors

variable [Semiring R] [NoZeroDivisors R] {p q : R[X]}

theorem degree_mul_C (a0 : a ≠ 0) : (p * C a).degree = p.degree := by
  rw [degree_mul, degree_C a0, add_zero]
set_option linter.uppercaseLean3 false in
#align polynomial.degree_mul_C Polynomial.degree_mul_C

theorem degree_C_mul (a0 : a ≠ 0) : (C a * p).degree = p.degree := by
  rw [degree_mul, degree_C a0, zero_add]
set_option linter.uppercaseLean3 false in
#align polynomial.degree_C_mul Polynomial.degree_C_mul

theorem natDegree_mul_C (a0 : a ≠ 0) : (p * C a).natDegree = p.natDegree := by
  simp only [natDegree, degree_mul_C a0]
set_option linter.uppercaseLean3 false in
#align polynomial.natDegree_mul_C Polynomial.natDegree_mul_C

theorem natDegree_C_mul (a0 : a ≠ 0) : (C a * p).natDegree = p.natDegree := by
  simp only [natDegree, degree_C_mul a0]
set_option linter.uppercaseLean3 false in
#align polynomial.nat_degree_C_mul Polynomial.natDegree_C_mul

theorem natDegree_comp : natDegree (p.comp q) = natDegree p * natDegree q := by
  by_cases q0 : q.natDegree = 0
  ·
    rw [degree_le_zero_iff.mp (natDegree_eq_zero_iff_degree_le_zero.mp q0), comp_C, natDegree_C,
      natDegree_C, mul_zero]
  · by_cases p0 : p = 0
    · simp only [p0, zero_comp, natDegree_zero, zero_mul]
    refine' le_antisymm natDegree_comp_le (le_natDegree_of_ne_zero _)
    simp only [coeff_comp_degree_mul_degree q0, p0, mul_eq_zero, leadingCoeff_eq_zero, or_self_iff,
      ne_zero_of_natDegree_gt (Nat.pos_of_ne_zero q0), pow_ne_zero, Ne.def, not_false_iff]
#align polynomial.nat_degree_comp Polynomial.natDegree_comp

@[simp]
theorem natDegree_iterate_comp (k : ℕ) :
    ((p.comp^[k]) q).natDegree = p.natDegree ^ k * q.natDegree := by
  induction' k with k IH
  · simp
  · rw [Function.iterate_succ_apply', natDegree_comp, IH, pow_succ, mul_assoc]
#align polynomial.nat_degree_iterate_comp Polynomial.natDegree_iterate_comp

theorem leadingCoeff_comp (hq : natDegree q ≠ 0) :
    leadingCoeff (p.comp q) = leadingCoeff p * leadingCoeff q ^ natDegree p := by
  rw [← coeff_comp_degree_mul_degree hq, ← natDegree_comp, coeff_natDegree]
#align polynomial.leading_coeff_comp Polynomial.leadingCoeff_comp

end NoZeroDivisors

end Polynomial


import tactic.group

variables {G : Type} [group G]

example (a b c d : G) : c *(a*b)*(b⁻¹*a⁻¹)*c = c*c :=
by group

example (a b c d : G) : (b*c⁻¹)*c *(a*b)*(b⁻¹*a⁻¹)*c = b*c :=
by group

example (a b c d : G) : c⁻¹*(b*c⁻¹)*c *(a*b)*(b⁻¹*a⁻¹*b⁻¹)*c = 1 :=
by group

def commutator {G} [group G] : G → G → G := λ g h, g * h * g⁻¹ * h⁻¹

def commutator3 {G} [group G] : G → G → G → G := λ g h k, commutator (commutator g h) k

-- The following is known as the Hall-Witt identity,
-- see e.g.
-- https://en.wikipedia.org/wiki/Three_subgroups_lemma#Proof_and_the_Hall%E2%80%93Witt_identity
example (g h k : G) :
  g * (commutator3 g⁻¹ h k) * g⁻¹ * k * (commutator3 k⁻¹ g h) * k⁻¹ *
    h * (commutator3 h⁻¹ k g) * h⁻¹ = 1 :=
by { dsimp [commutator3, commutator], group }

example (a : G) : a^2*a = a^3 :=
by group

example (n m : ℕ) (a : G) : a^n*a^m = a^(n+m) :=
by group

example (a b c d : G) : c *(a*b^2)*((b*b)⁻¹*a⁻¹)*c = c*c :=
by group

example (n m : ℕ) (a : G) : a^n*(a⁻¹)^n = 1 :=
by group

example (n m : ℕ) (a : G) : a^2*a⁻¹*a⁻¹ = 1 :=
by group

example (n m : ℕ) (a : G) : a^n*a^m = a^(m+n) :=
by group

example (n : ℕ) (a : G) : a^(n-n) = 1 :=
by group

example (n : ℤ) (a : G) : a^(n-n) = 1 :=
by group

example (n : ℤ) (a : G) (h : a^(n*(n+1)-n -n^2) = a) : a = 1 :=
begin
 group at h,
 exact h.symm,
 end

example (a b c d : G) (h : c = (a*b^2)*((b*b)⁻¹*a⁻¹)*d) : a*c*d⁻¹ = a :=
begin
  group at h,
  rw h,
  group,
end

-- The next example can be expand to require an arbitrarily high number of alternation
-- between simp and ring

example (n m : ℤ) (a b : G) : a^n*b^n*a^n*a^n*a^-n*a^-n*b^-n*a^-n = 1 :=
by group

-- Test that group deals with `1⁻¹` properly

example (x y : G) : (x⁻¹ * (x * y) * y⁻¹)⁻¹ = 1 :=
by group

example (x : G) (h : x = 1) : x = 1 :=
begin
  group,
  exact h,
end


-- import solutions to level 1
import complex.kb_solutions.I

/-!

# Level 2: Complex conjugation

-/

namespace complex

-- First complete the definition using `complex.mk` or `⟨x, y⟩` notation

/-- The complex conjugate of a complex number -/
def conj (z : ℂ) : ℂ := ⟨re(z), -im(z)⟩

-- Now prove how it interacts with everything else

/-! ## Real and imaginary parts -/

@[simp] lemma conj_re (z : ℂ) : re(conj z) = re(z) := rfl -- short for "begin refl end"
@[simp] lemma conj_im (z : ℂ) : im(conj z) = -im(z) := rfl

/-! ## Behaviour with respect to 0, 1 and I -/

@[simp] lemma conj_zero : conj 0 = 0 := by ext; simp -- short for "begin ext; simp end"
@[simp] lemma conj_one : conj 1 = 1 := by ext; simp
@[simp] lemma conj_I : conj I = -I := by ext; simp
@[simp] lemma conj_neg_I : conj (-I) = I := by ext; simp

/-! # Behaviour with respect to +, - and * -/

@[simp] lemma conj_add (z w : ℂ) : conj (z + w) = conj z + conj w :=
by ext; -- check on real and imag parts
   simp; -- question becomes to check that a+b=b+a for certain real numbers a and b
   ring -- true because this is obvious in a ring

@[simp] lemma conj_neg (z : ℂ) : conj (-z) = -conj z :=
by ext; -- check on real and imag parts
   refl -- happens to be true by definition

@[simp] lemma conj_mul (z w : ℂ) : conj (z * w) = conj z * conj w :=
by ext; -- check on real and imag parts
   simp; -- it's some random statement involving ring theory of the real numbers
   ring -- solve it

/-! # Properties of the `conj` map -/

@[simp] lemma conj_conj (z : ℂ) : conj (conj z) = z :=
by ext; -- check on real and imag parts
   simp -- ext had reduced question to -(-x)=x for reals

attribute [simp] ext_iff -- cheeky trick to make the next proof work

lemma conj_inj {z w : ℂ} : conj z = conj w ↔ z = w :=
begin
  simp * at *
end

@[simp] lemma conj_eq_zero {z : ℂ} : conj z = 0 ↔ z = 0 :=
begin
  simp * at *
end

/-- the ring homomorphism complex conjugation -/
def Conj : ℂ →+* ℂ :=
{ to_fun := conj,
  map_zero' := conj_zero,
  map_one' := conj_one,
  map_add' := conj_add,
  map_mul' := conj_mul,
}

open function

lemma conj_involutive : involutive conj := conj_conj

lemma conj_bijective : bijective conj := conj_involutive.bijective

end complex