import data.set

import .formula
import .derivations
import .tactics
import .logics
import .consistency
import .enumeration

open_locale classical

reserve prefix `□⁻¹` :40
reserve prefix `◇⁻¹` :40

notation □⁻¹Γ := {a | (□a) ∈ Γ}
notation ◇⁻¹Γ := {a | (◇a) ∈ Γ}
notation □Γ := {(□a) | a ∈ Γ}
notation ◇Γ := {(◇a) | a ∈ Γ}

/-- As set `s` is complete if, for any formula `x`, either `x` or `¬x` is contained in `s`. -/
def set.complete (s : set formula) := ∀x, x ∈ s ∨ (¬x) ∈ s

/-- As set `s` is complete `Σ`-consistent if it is complete and `Σ`-consistent. -/
def set.complete_consistent (s : set formula) (axms) := s.consistent axms ∧ s.complete

@[simp] lemma set.complete_consistent.not_mem_iff {axms : set formula} {Γ : set formula} (hcc : Γ.complete_consistent axms) {a : formula} :
  a ∉ Γ ↔ (¬a) ∈ Γ :=
begin
  apply iff.intro,
  { intro h,
    cases hcc with _ hc,
    rw set.complete at hc,
    apply or.resolve_left (hc a) h, },
  { intro h,
    cases hcc with hc _,
    rw set.consistent at hc,
    by_contradiction ha,
    apply hc,
    have hdna := derivable.reflexivity h,
    apply derivable.from.mp a,
    { apply derivable.from.mp ¬a,
      { derive_taut, },
      { exact hdna, }, },
    apply derivable.reflexivity ha, },
end

lemma set.complete_consistent.deductive_closure {axms : set formula} {Γ : set formula} (hcc : Γ.complete_consistent axms) (a : formula) :
  (Γ ⊢[axms] a) → a ∈ Γ :=
begin
  intro ha,
  by_contradiction,
  rw set.complete_consistent.not_mem_iff at h,
  { cases hcc with h₁ h₂,
    apply h₁,
    apply derivable.from.mp a,
    { apply derivable.from.mp ¬a,
      { derive_taut, },
      { apply derivable.reflexivity,
        assumption, }, },
    assumption, },
  assumption,
end

lemma set.complete_consistent.not_mem_bot {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) :
  formula.bottom ∉ Γ :=
begin
  by_contradiction,
  apply hΓ.elim_left,
  exact derivable.reflexivity h,
end

lemma set.complete_consistent.mem_top {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) :
  formula.top ∈ Γ :=
begin
  apply set.complete_consistent.deductive_closure hΓ,
  derive_taut,
end

lemma set.complete_consistent.mem_and {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) {a b : formula} :
  (a ∧ b) ∈ Γ ↔ a ∈ Γ ∧ b ∈ Γ :=
begin
  apply iff.intro,
  { intro h,
    split,
    repeat {
      apply set.complete_consistent.deductive_closure hΓ,
      apply derivable.from.mp (a ∧ b) _ _ (derivable.reflexivity h),
      derive_taut,
    }, },
  { intro h,
    apply set.complete_consistent.deductive_closure hΓ,
    apply derivable.from.mp a,
    apply derivable.from.mp b,
    derive_taut,
    exact derivable.reflexivity (and.elim_right h),
    exact derivable.reflexivity (and.elim_left h), },
end

lemma set.complete_consistent.mem_or {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) {a b : formula} :
  (a ∨ b) ∈ Γ ↔ a ∈ Γ ∨ b ∈ Γ :=
begin
  apply iff.intro,
  { intro h,
    { by_contradiction h',
      apply not.elim _ h,
      rw set.complete_consistent.not_mem_iff hΓ,
      apply set.complete_consistent.deductive_closure hΓ,
      apply derivable.from.mp (¬a),
      apply derivable.from.mp (¬b),
      derive_taut,
      repeat {
        apply derivable.reflexivity,
        rw ←set.complete_consistent.not_mem_iff hΓ,
        tauto,
      }, }, },
  { intro h,
    apply set.complete_consistent.deductive_closure hΓ,
    cases h,
    { apply derivable.from.mp _ _ _ (derivable.reflexivity h),
      derive_taut, },
    { apply derivable.from.mp _ _ _ (derivable.reflexivity h),
      derive_taut, }, },
end

lemma set.complete_consistent.mem_imp {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) {a b : formula} :
  (a ⟶ b) ∈ Γ ↔ a ∈ Γ → b ∈ Γ :=
begin
  apply iff.intro,
  { intro h,
    { by_contradiction h',
      apply not.elim _ h,
      rw set.complete_consistent.not_mem_iff hΓ,
      apply set.complete_consistent.deductive_closure hΓ,
      apply derivable.from.mp a,
      apply derivable.from.mp (¬b),
      derive_taut,
      { apply derivable.reflexivity,
        rw ←set.complete_consistent.not_mem_iff hΓ,
        tauto, },
      { apply derivable.reflexivity,
        tauto, }, }, },
  { intro h,
    apply set.complete_consistent.deductive_closure hΓ,
    have h := not_or_of_imp h,
    cases h,
    { rw set.complete_consistent.not_mem_iff hΓ at h_1,
      apply derivable.from.mp _ _ _ (derivable.reflexivity h_1),
      derive_taut, },
    { apply derivable.from.mp _ _ _ (derivable.reflexivity h_1),
      derive_taut, }, },
end

lemma set.complete_consistent.mem_iff {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) {a b : formula} :
  (a ↔ b) ∈ Γ ↔ (a ∈ Γ ↔ b ∈ Γ) :=
begin
  apply iff.intro,
  { intro h,
    apply iff.intro,
    repeat {
      intro h',
      apply set.complete_consistent.deductive_closure hΓ,
      apply derivable.from.mp _ _ _ (derivable.reflexivity h'),
      apply derivable.from.mp _ _ _ (derivable.reflexivity h),
      derive_taut,
    }, },
  { intro h,
    apply set.complete_consistent.deductive_closure hΓ,
    by_cases ha : a ∈ Γ,
    { apply derivable.from.mp _ _ _ (derivable.reflexivity ha),
      apply derivable.from.mp _ _ _ (derivable.reflexivity (h.mp ha)),
      derive_taut, },
    { have hna := (set.complete_consistent.not_mem_iff hΓ).mp ha,
      have hnb := (set.complete_consistent.not_mem_iff hΓ).mp ((iff_false_left ha).mp h),
      apply derivable.from.mp _ _ _ (derivable.reflexivity hna),
      apply derivable.from.mp _ _ _ (derivable.reflexivity hnb),
      derive_taut, }, },
end

lemma derive_imp_derive_box {axms} {Γ : set formula} {a : formula} :
  (Γ ⊢[axms] a) → (□Γ ⊢[axms] □a) :=
begin
  intro hda,
  cases hda with xs hxs,
  cases hxs with hxs hda,
  apply exists.intro (xs.map (λa, □a)),
  split,
  { intros x hx,
    simp * at *,
    cases hx with a ha,
    apply exists.intro a,
    simp *, },
  { exact derivable.RK hda, },
end

lemma debox_derive_imp_derive_box {axms} {Γ : set formula} {a : formula} :
  (□⁻¹Γ ⊢[axms] a) → (Γ ⊢[axms] □a) :=
begin
  intro hda,
  cases hda with xs hxs,
  cases hxs with hxs hda,
  apply exists.intro (xs.map (λa, □a)),
  split,
  { intros x hx,
    simp * at *,
    cases hx with a ha,
    rw ←ha.elim_right,
    apply hxs,
    exact ha.elim_left, },
  { exact derivable.RK hda, },
end

def ccₙ (s axms : set formula) : ℕ → set formula
| 0 := s
| (n + 1) := if (ccₙ n ∪ {enumerate n}).consistent axms
  then ccₙ n ∪ {enumerate n}
  else ccₙ n ∪ {¬enumerate n}

/-- `cc s Σ` constructs a complete, `Σ`-consistent set built upon `s`. -/
def cc (s : set formula) (axms) : set formula := ⋃n, ccₙ s axms n

lemma ccₙ_sub_cc (s) (axms) (n : ℕ) : ccₙ s axms n ⊆ cc s axms :=
begin
  intros x hn,
  rw cc,
  rw set.mem_Union,
  apply exists.intro n,
  assumption,
end

lemma ccₙ_sub_ccₘ' (s axms) (n m) : ccₙ s axms n ⊆ ccₙ s axms (n + m) :=
begin
  intros x hn,
  induction m,
  { assumption, },
  { rw nat.add_succ,
    rw ccₙ,
    by_cases (ccₙ s axms (n + m_n) ∪ {enumerate (n + m_n)}).consistent axms,
    { simp [h, m_ih], },
    { simp [h, m_ih], }, },
end

lemma ccₙ_sub_ccₘ (s axms) (n m : ℕ) (hm : m ≥ n) : ccₙ s axms n ⊆ ccₙ s axms m :=
begin
  have h := ccₙ_sub_ccₘ' s axms n (m - n),
  simp [nat.add_sub_of_le hm] at h,
  assumption,
end

lemma ccₙ_consistent (s axms : set formula) (n : ℕ) (h₀ : s.consistent axms) :
  (ccₙ s axms n).consistent axms :=
begin
  induction n,
  { simp [ccₙ, h₀], },
  { rw ccₙ,
    by_cases (ccₙ s axms n_n ∪ {enumerate n_n}).consistent axms;
    have h' := consistent_extensible (ccₙ s axms n_n) axms n_ih (enumerate n_n),
    { simp [h] at *,
      assumption, },
    { simp [h] at *,
      exact or.resolve_left h' h, }, },
end

lemma minimal_ccₙ (s axms : set formula) (xs : list formula) (hxs : ∀x ∈ xs, x ∈ cc s axms) :
  ∃n, ∀x ∈ xs, x ∈ ccₙ s axms n :=
begin
  induction xs with _ _ ih,
  { simp, },
  { have hxs' : ∀ (x : formula), x ∈ xs_tl → x ∈ cc s axms := begin
      intros x hx,
      apply hxs,
      apply or.intro_right,
      exact hx,
    end,
    apply exists.elim (ih hxs'),
    intros n hn,
    have hx := hxs xs_hd (or.intro_left _ (by refl)),
    rw [cc, set.mem_Union] at hx,
    apply exists.elim hx,
    intros n' hn',
    apply exists.intro (max n n'),
    intros a ha,
    cases ha,
    { apply ccₙ_sub_ccₘ s axms n' _,
      { simp, },
      { simp [ha, hn'], }, },
    { apply ccₙ_sub_ccₘ s axms n _,
      { simp },
      { apply hn,
        exact ha, }, }, },
end

lemma cc_consistent (s axms : set formula) (h₀ : s.consistent axms) :
  (cc s axms).consistent axms :=
begin
  by_contradiction,
  simp [set.consistent] at h,
  apply exists.elim h,
  intros xs hxs,
  clear h,
  cases hxs with hxs hdb,
  have h := minimal_ccₙ s axms xs hxs,
  apply exists.elim h,
  intros n hn,
  have hnc := ccₙ_consistent s axms n h₀,
  apply not.elim hnc,
  apply exists.intro xs,
  split,
  assumption',
end

/-- For any `Σ` consistent set `s`, there exists a complete, `Σ`-consistent set built upon `s`. -/
theorem lindenbaum {axms : set formula} {s : set formula} (hcc : s.consistent axms) :
  ∃s' ⊇ s, s'.complete_consistent axms :=
begin
  apply exists.intro (cc s axms),
  split,
  { intros x hx,
    rw [cc, set.mem_Union],
    apply exists.intro 0,
    rw ccₙ,
    assumption, },
  { split,
    { exact cc_consistent s axms hcc, },
    { rw set.complete,
      intros x,
      apply exists.elim (enumerate.complete x),
      intros n hn,
      rw [cc, set.mem_Union, set.mem_Union],
      cases classical.em (((ccₙ s axms n) ∪ {x}).consistent axms),
      { apply or.intro_left,
        apply exists.intro (n + 1),
        simp at h,
        simp [ccₙ, hn, h], },
      { apply or.intro_right,
        apply exists.intro (n + 1),
        simp at h,
        simp [ccₙ, hn, h], }, }, },
end

lemma derivable_iff_mem_cc (axms Γ : set formula) (a : formula) :
  (Γ ⊢[axms] a) ↔ (∀Δ ⊇ Γ, Δ.complete_consistent axms → a ∈ Δ) :=
begin
  apply iff.intro,
  { intros hda Δ hΔ hcc,
    by_contradiction,
    cases hcc with hconsistent hcomplete,
    apply hconsistent,
    apply derivable.from.mp a,
    { apply derivable.from.mp ¬a,
      { derive_taut, },
      { rw set.complete at hcomplete,
        apply derivable.reflexivity,
        exact or.resolve_left (hcomplete a) h, }, },
    { exact derivable.monotonicity Γ Δ hΔ hda, }, },
  { intros h,
    by_contradiction hnc,
    rw [derivable_iff_not_consistent, not_not] at hnc,
    cases lindenbaum hnc with Δ hΔ,
    cases hΔ with hΔ hΔcc,
    apply @not.elim (a ∈ Δ),
    { rw set.complete_consistent.not_mem_iff hΔcc,
      apply set.mem_of_subset_of_mem hΔ,
      simp, },
    { refine h Δ _ hΔcc,
      intros x hx,
      exact hΔ (or.intro_left _ hx), }, },
end

lemma set.complete_consistent.mem_box {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) {a : formula} :
  (□a) ∈ Γ ↔ ∀Δ : set formula, Δ.complete_consistent axms → (□⁻¹Γ) ⊆ Δ → a ∈ Δ :=
begin
  apply iff.intro,
  { intros hba Δ hΔcc hΔ,
    apply hΔ,
    exact hba, },
  { contrapose,
    intros hnba h,
    have hndba : ¬(Γ ⊢[axms] □a) := begin
      by_contradiction,
      apply hnba,
      exact set.complete_consistent.deductive_closure hΓ _ h,
    end,
    have hndba' : ¬(□⁻¹Γ ⊢[axms] a) := begin
      by_contradiction,
      apply hndba,
      exact debox_derive_imp_derive_box h,
    end,
    have hnc := (iff_false_left hndba').mp derivable_iff_not_consistent,
    rw not_not at hnc,
    cases lindenbaum hnc with Δ hΔ,
    cases hΔ with hΔ hΔcc,
    apply not.elim,
    { change a ∉ Δ,
      intro ha,
      apply hΔcc.elim_left,
      apply derivable.from.mp a _ _ (derivable.reflexivity ha),
      apply derivable.from.mp ¬a,
      derive_taut,
      apply derivable.reflexivity,
      apply hΔ,
      simp, },
    { apply h Δ hΔcc,
      intros x hx,
      apply hΔ,
      exact or.intro_left _ hx, }, },
end

lemma set.complete_consistent.debox_subset_iff {axms} {Γ Δ : set formula}
    (hΓ : Γ.complete_consistent axms) (hΔ : Δ.complete_consistent axms) :
  (□⁻¹Γ) ⊆ Δ ↔ (◇Δ) ⊆ Γ :=
begin
  apply iff.intro,
  { intros h x hx,
    cases hx with a ha,
    cases ha with ha hx,
    rw ←hx at *,
    clear hx x,
    apply set.complete_consistent.deductive_closure hΓ,
    apply derivable.from.mp ¬□¬a,
    { apply derivable.from.mp (dual a),
      { derive_taut, },
      { ignore_premises,
        apply derivable.dual, }, },
    { apply derivable.reflexivity,
      apply (hΓ.elim_right _).resolve_left,
      by_contradiction h',
      apply not.elim _ ha,
      rw set.complete_consistent.not_mem_iff hΔ,
      exact h h', }, },
  { intros h a,
    simp at h,
    contrapose,
    intro ha,
    change (□a) ∉ Γ,
    rw set.complete_consistent.not_mem_iff hΓ,
    apply set.complete_consistent.deductive_closure hΓ,
    { rw derivable.from.not_box_iff_diamond_not,
      apply derivable.reflexivity,
      rw set.complete_consistent.not_mem_iff hΔ at ha,
      apply h,
      simp,
      exact ha, }, },
end

lemma set.complete_consistent.mem_diamond {axms} {Γ : set formula} (hΓ : Γ.complete_consistent axms) {a : formula} :
  (◇a) ∈ Γ ↔ ∃Δ : set formula, Δ.complete_consistent axms ∧ (◇Δ) ⊆ Γ ∧ a ∈ Δ :=
begin
  -- have h₁ : (◇a) ∈ Γ ↔ (¬□¬a) ∈ Γ := sorry,
  -- have h₂ : (¬□¬a) ∈ Γ ↔ (□¬a) ∉ Γ := sorry,
  -- have h₃ := set.complete_consistent.mem_box hΓ,
  sorry
end

def set.canonical_model (axms : set formula) : model :=
{
  world := set formula,
  w := {Δ | Δ.complete_consistent axms},
  r := λΔ Δ', (□⁻¹Δ) ⊆ Δ',
  v := λp, {Δ | formula.symbol p ∈ Δ},
}

@[simp] lemma set.canonical_model.w (axms : set formula) : axms.canonical_model.w = {Δ | Δ.complete_consistent axms} :=
by refl

@[simp] lemma set.canonical_model.world (axms : set formula) : axms.canonical_model.world = set formula :=
by refl

@[simp] lemma set.canonical_model.v {axms : set formula} : axms.canonical_model.v = λp : symbol, {Δ : set formula | formula.symbol p ∈ Δ} :=
by refl

@[simp] lemma set.canonical_model.r {axms : set formula} : axms.canonical_model.r = λΔ Δ' : set formula, (□⁻¹Δ) ⊆ Δ' :=
by refl

/-- The Truth Lemma: a world `Δ` in the canonical model of a system makes a formula true
    iff the formula is contained in `Δ`. -/
theorem truth_lemma {axms : set formula} {Δ : set formula} {hΔ : Δ ∈ axms.canonical_model.w} :
  ∀a, (⟨axms.canonical_model, Δ⟩ ⊩ a) ↔ a ∈ Δ :=
begin
  intros a,
  simp * at *,
  induction a generalizing Δ,
  { simp,
    exact set.complete_consistent.not_mem_bot hΔ, },
  { simp,
    exact set.complete_consistent.mem_top hΔ, },
  { simp, exact iff.rfl, },
  { simp * at *,
    apply set.complete_consistent.not_mem_iff hΔ, },
  { simp * at *,
    exact iff.symm (set.complete_consistent.mem_and hΔ), },
  { simp * at *,
    exact iff.symm (set.complete_consistent.mem_or hΔ), },
  { simp * at *,
    exact iff.symm (set.complete_consistent.mem_imp hΔ), },
  { simp * at *,
    exact iff.symm (set.complete_consistent.mem_iff hΔ), },
  { apply iff.intro,
    { intro hba,
      simp at hba,
      apply (set.complete_consistent.mem_box hΔ).mpr,
      intros Δ' hΔ'cc hΔ',
      rw ←a_ih hΔ'cc,
      exact hba Δ' hΔ'cc hΔ', },
    { intro hba,
      intros Δ' hΔ' hrΔ',
      rw a_ih hΔ',
      apply hrΔ',
      exact hba, }, },
  { apply iff.intro,
    { intro hda,
      simp at hda,
      apply (set.complete_consistent.mem_diamond hΔ).mpr,
      cases hda with Δ' hΔ',
      cases hΔ' with hΔ'cc hΔ',
      cases hΔ' with hΔ' hΔ'a,
      apply exists.intro Δ',
      split,
      exact hΔ'cc,
      split,
      { intros x hx,
        rw set.complete_consistent.debox_subset_iff hΔ hΔ'cc at hΔ',
        apply hΔ',
        exact hx, },
      { rw ←a_ih hΔ'cc,
        exact hΔ'a, }, },
    { contrapose,
      intro hnda,
      rw set.complete_consistent.not_mem_iff hΔ,
      have hbna : ⟨axms.canonical_model, Δ⟩ ⊩ □¬a_a := begin
        intros Δ' hΔ' hΔ'r,
        by_contradiction,
        apply hnda,
        apply exists.intro Δ',
        apply exists.intro hΔ',
        split,
        exact hΔ'r,
        simp at h,
        exact h,
      end,
      apply set.complete_consistent.deductive_closure hΔ,
      sorry }, },
end

/-- Determination: the canonical model for `Σ` satisfies a formula iff the formula is `Σ`-derivable. -/
theorem determination (axms : set formula) : ∀a, (axms.canonical_model ⊩ a) ↔ (axms ⊢ a) :=
begin
  intro a,
  apply iff.intro,
  { intro ha,
    rw [←derivable.from.no_premises, derivable_iff_mem_cc],
    intros s _ hs,
    rw ←truth_lemma,
    apply ha,
    assumption', },
  { intros h w hw,
    rw truth_lemma,
    apply set.complete_consistent.deductive_closure,
    { simp at hw,
      exact hw, },
    { apply derivable.monotonicity ∅,
      { tauto, },
      { rw derivable.from.no_premises,
        assumption, }, },
    assumption, },
end

/-- A system `Σ` is complete for a set `𝒞` of models iff for any formula `a`, `𝒞 ⊨ a → Σ ⊢ a`. -/
class complete (axms : set formula) (𝒞 : set model) :=
(complete : ∀a, (𝒞 ⊨ a) → (axms ⊢ a))

/-- The normal modal logic `K` is complete with respect to the set of all models. -/
instance logic.k.complete : complete logic.k set.univ :=
{ complete :=
  begin
    intro a,
    contrapose,
    rw ←determination,
    intro h,
    tautology,
  end }


import tactic
import ssyt

/-

Defining "row_bump_step": one step of row insertion

Given an ssyt T and natural numbers i, k, we "bump" k into row i
while preserving semistandardness. In particular k goes after any existing k's
and either replaces the leftmost larger entry, or if there are no entries > k, it is
added at the end of the row.

An assumption is necessary (to preserve column strictness) for this to be legal.
  [ssyt.rbs_cert]
  [ssyt.rbs_cert.legal_of_cert]

The bump position is defined using nat.find.
  [ssyt.rbc]

The bump itself is either ssyt.legal.replace or ssyt.legal.add.
  [ssyt.rbs]
  [ssyt.rbs_end]

Two key lemmas are:
  1. The removed entry from row i is itself legal for bumping into row i+1.
    [ssyt.rbs_cert.next_cert]
  2. If so, the (i+1)st row bump column is ≤ the ith row bump column.
    [ssyt.rbs_cert.next_rbc_le]
  3. If we insert k, followed by k' ≥ k, in the same row, the k' bump column is
    *strictly* to the right (larger) than the k column, and the bumped-out
    entry is weakly larger than the first bumped-out entry.
    [ssyt.rbs_cert.rbc_lt_rbc]
    [ssyt.rbs_cert.rbc_out_le_rbc_out]
Lemma 2 is proven in more generality. Lemmas 1-2 are used to define
row insertion by successive row bump steps.
Lemma 3 is used to prove that the recording tableau is semistandard,
which is currently a hard proof (see [row_bump.lean/ssyt.rbs_cert.rbwf_pieri]).

Various independence lemmas are shown for later use:
 * the insertion only affects row i
    [ssyt.rbs_entry_eq_of_ne_row]
    [ssyt.rbs_cert.rbs_end_shape_eq_of_ne_row]
    [ssyt.rbs_cert.rbs_end_entry_eq_of_ne_row]
 * the insertion column only depends on row i
    [ssyt.rbc_eq_of_eq_row]
 * the extra assumption for column-strictness only depends on rows ≤ i
    [ssyt.rbs_cert.copy]
    [ssyt.rbs_cert.copy']
 * commutativity of two rbs steps in different rows:
    [ssyt.rbs_cert.rbs_comm]
   Note: this is _not_ currently used anywhere, but it might be possible to
    use it to golf [row_bump.lean/ssyt.rbs_cert.rbwf_pieri].

Finally, auxiliary facts are shown about the size and weight of the tableau.
  [ssyt.rbs_cert.rbs_wt]
  [ssyt.rbs_cert.rbs_end_size]
  [ssyt.rbs_cert.rbs_end_wt]
-/

section row_bump_column

lemma ssyt.rbc_aux {μ : young_diagram} (T : ssyt μ) (i val : ℕ) :
  ∃ j, (i, j) ∈ μ → val < T i j :=
by { obtain ⟨j, hj⟩ := μ.row_len_aux i, use j }

def ssyt.rbc {μ : young_diagram} (T : ssyt μ) (i val : ℕ) : ℕ :=
  nat.find $ T.rbc_aux i val

lemma ssyt.lt_rbc_iff {μ : young_diagram} (T : ssyt μ) {i j val: ℕ} :
  j < T.rbc i val ↔ (i, j) ∈ μ ∧ T i j ≤ val :=
begin
  rw [ssyt.rbc, nat.lt_find_iff], push_neg,
  exact ⟨λ h, h _ (le_refl _),
         λ h _ hm, ⟨μ.nw_of (le_refl _) hm h.1, (T.row_weak' hm h.1).trans h.2⟩⟩
end

lemma ssyt.rbc_le_iff {μ : young_diagram} (T : ssyt μ) {i j val: ℕ} :
  T.rbc i val ≤ j ↔ (i, j) ∈ μ → val < T i j :=
begin
  rw ← not_iff_not, push_neg, apply ssyt.lt_rbc_iff
end

lemma ssyt.rbc_not_cell_or_val_lt {μ : young_diagram} (T : ssyt μ) (i val: ℕ) :
  (i, T.rbc i val) ∈ μ → val < T i (T.rbc i val) :=
nat.find_spec (T.rbc_aux i val)

lemma ssyt.rbc_eq_iff {μ : young_diagram} (T : ssyt μ) {i j val: ℕ} :
  T.rbc i val = j ↔
  ((i, j) ∈ μ → val < T i j) ∧ (∀ j' < j, (i, j') ∈ μ ∧ T i j' ≤ val) :=
begin
  convert nat.find_eq_iff (T.rbc_aux i val), push_neg, refl,
end

lemma ssyt.rbc_eq_of_eq_row
  {μ ν : young_diagram} (T : ssyt μ) (T' : ssyt ν) {i val : ℕ}
  (eq_cell : ∀ {j}, (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_row : ∀ {j}, T i j = T' i j) :
  T.rbc i val = T'.rbc i val :=
begin
  rw T.rbc_eq_iff,
  -- change first statement
  rw [eq_cell, eq_row],
  -- change second statement
  simp_rw [eq_cell, eq_row],
  rw ← T'.rbc_eq_iff,
end

-- section old_rbc

-- lemma ssyt.rbc_aux {μ : young_diagram} (T : ssyt μ) (i val : ℕ) :
--   ∃ j, (i, j) ∉ μ ∨ val < T i j :=
-- exists_or_distrib.mpr $ or.inl $ μ.row_len_aux i

-- def ssyt.rbc {μ : young_diagram} (T : ssyt μ) (i val : ℕ) : ℕ :=
--   nat.find $ T.rbc_aux i val

-- lemma ssyt.lt_rbc_iff {μ : young_diagram} (T : ssyt μ) {i j val: ℕ} :
--   j < T.rbc i val ↔ (i, j) ∈ μ ∧ T i j ≤ val :=
-- begin
--   rw [ssyt.rbc, nat.lt_find_iff], push_neg,
--   exact ⟨λ h, h _ (le_refl _),
--          λ h _ hm, ⟨μ.nw_of (le_refl _) hm h.1, (T.row_weak' hm h.1).trans h.2⟩⟩
-- end

-- lemma ssyt.rbc_le_iff {μ : young_diagram} (T : ssyt μ) {i j val: ℕ} :
--   T.rbc i val ≤ j ↔ (i, j) ∉ μ ∨ val < T i j :=
-- begin
--   rw ← not_iff_not, push_neg, apply ssyt.lt_rbc_iff
-- end

-- lemma ssyt.rbc_not_cell_or_val_lt {μ : young_diagram} (T : ssyt μ) (i val: ℕ) :
--   (i, T.rbc i val) ∉ μ ∨ val < T i (T.rbc i val) :=
-- nat.find_spec (T.rbc_aux i val)

-- lemma ssyt.rbc_eq_iff {μ : young_diagram} (T : ssyt μ) {i j val: ℕ} :
--   T.rbc i val = j ↔
--   ((i, j) ∉ μ ∨ val < T i j) ∧ (∀ j' < j, (i, j') ∈ μ ∧ T i j' ≤ val) :=
-- begin
--   convert nat.find_eq_iff (T.rbc_aux i val), push_neg, refl,
-- end

-- lemma ssyt.rbc_eq_of_eq_row
--   {μ ν : young_diagram} (T : ssyt μ) (T' : ssyt ν) {i val : ℕ}
--   (eq_cell : ∀ {j}, (i, j) ∈ μ ↔ (i, j) ∈ ν)
--   (eq_row : ∀ {j}, T i j = T' i j) :
--   T.rbc i val = T'.rbc i val :=
-- begin
--   rw T.rbc_eq_iff,
--   -- change first statement
--   rw [eq_cell, eq_row],
--   -- change second statement
--   simp_rw [eq_cell, eq_row],
--   rw ← T'.rbc_eq_iff,
-- end

-- end old_rbc

end row_bump_column

section row_bump_step

section rbs_cert

structure ssyt.rbs_cert {μ : young_diagram} (T : ssyt μ) :=
  (i val : ℕ)
  (cell_up : ∀ {i'} (hi' : i' < i), (i', T.rbc i val) ∈ μ)
  (up : ∀ {i'} (hi' : i' < i), T i' (T.rbc i val) < val)

def ssyt.rbs_start_cert {μ : young_diagram} (T : ssyt μ) (val : ℕ) : T.rbs_cert :=
{ i := 0,
  val := val,
  cell_up := λ _ h, false.rec _ $ nat.not_lt_zero _ h,
  up := λ _ h, false.rec _ $ nat.not_lt_zero _ h,
}

@[reducible]
def ssyt.rbs_cert.j {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert) : ℕ :=
  T.rbc h.i h.val

@[reducible]
def ssyt.rbs_cert.out {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert) : ℕ :=
  T h.i h.j

lemma ssyt.rbs_cert.val_lt_out
  {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (cell : (h.i, h.j) ∈ μ) : h.val < h.out :=
T.rbc_not_cell_or_val_lt _ _ cell

@[simps]
def ssyt.rbs_cert.legal_of_cert {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert) :
  T.legal :=
{ i := h.i,
  j := h.j,
  val := h.val,
  cell_up := h.cell_up,
  cell_left := λ j' hj', (T.lt_rbc_iff.mp hj').1,
  left := λ j' hj', (T.lt_rbc_iff.mp hj').2,
  right := λ j' hj' hcell',
    le_of_lt $ T.rbc_le_iff.mp (le_of_lt hj') hcell',
  up := h.up,
  down := λ i' hi' hcell', begin
    apply (h.val_lt_out _).trans,
    exact T.col_strict hi' hcell',
    exact μ.nw_of (le_of_lt hi') (by refl) hcell',
  end,
}

@[simps]
def ssyt.rbs_cert.copy {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  {ν : young_diagram} (T' : ssyt ν)
  (eq_cell : ∀ i j (hi : i ≤ h.i), (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_le_row : ∀ i j (hi : i ≤ h.i), T i j = T' i j) : T'.rbs_cert :=
{ i := h.i,
  val := h.val,
  cell_up := λ i' hi', begin
    rw [← eq_cell _ _ (le_of_lt hi'),
        ← T.rbc_eq_of_eq_row T'
          (λ j, eq_cell _ _ (le_refl _)) (λ j, eq_le_row _ _ (le_refl _))],
    exact h.cell_up hi',
  end,
  up := λ i' hi', begin
    rw [← eq_le_row _ _ (le_of_lt hi'),
        ← T.rbc_eq_of_eq_row T'
          (λ j, eq_cell _ _ (le_refl _)) (λ j, eq_le_row _ _ (le_refl _))],
    exact h.up hi',
  end,
}

lemma ssyt.rbs_cert.copy_j {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  {ν : young_diagram} (T' : ssyt ν)
  (eq_cell : ∀ i j (hi : i ≤ h.i), (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_le_row : ∀ i j (hi : i ≤ h.i), T i j = T' i j) :
  (h.copy T' eq_cell eq_le_row).j = h.j :=
begin
  apply ssyt.rbc_eq_of_eq_row,
  intro j, rw eq_cell, refl,
  intro j, rw eq_le_row, refl
end

lemma ssyt.rbs_cert.copy_out {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  {ν : young_diagram} (T' : ssyt ν)
  (eq_cell : ∀ i j (hi : i ≤ h.i), (i, j) ∈ μ ↔ (i, j) ∈ ν)
  (eq_le_row : ∀ i j (hi : i ≤ h.i), T i j = T' i j) :
  (h.copy T' eq_cell eq_le_row).out = h.out :=
begin
  rw [ssyt.rbs_cert.out, ssyt.rbs_cert.out],
  rw ssyt.rbs_cert.copy_j,
  rw eq_le_row; refl
end

@[simps]
def ssyt.rbs_cert.copy' {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  {ν : young_diagram} (T' : ssyt ν)
  (subset_cell_lt_row : ∀ i j (hi : i < h.i), (i, j) ∈ μ → (i, j) ∈ ν)
  (eq_cell_row : ∀ j, (h.i, j) ∈ μ ↔ (h.i, j) ∈ ν)
  (le_lt_row : ∀ i j (hi : i < h.i), T' i j ≤ T i j)
  (eq_eq_row : ∀ j, T h.i j = T' h.i j) : T'.rbs_cert :=
{ i := h.i,
  val := h.val,
  cell_up := λ i' hi', begin
    apply subset_cell_lt_row _ _ hi',
    rw [← T.rbc_eq_of_eq_row T' eq_cell_row eq_eq_row],
    exact h.cell_up hi',
  end,
  up := λ i' hi', begin
    apply lt_of_le_of_lt (le_lt_row _ _ hi'),
    rw [← T.rbc_eq_of_eq_row T' eq_cell_row eq_eq_row],
    exact h.up hi',
  end,
}

lemma ssyt.rbs_cert.copy'_j {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  {ν : young_diagram} (T' : ssyt ν)
  (subset_cell_lt_row : ∀ i j (hi : i < h.i), (i, j) ∈ μ → (i, j) ∈ ν)
  (eq_cell_row : ∀ j, (h.i, j) ∈ μ ↔ (h.i, j) ∈ ν)
  (le_lt_row : ∀ i j (hi : i < h.i), T' i j ≤ T i j)
  (eq_eq_row : ∀ j, T h.i j = T' h.i j) :
(h.copy' T' subset_cell_lt_row eq_cell_row le_lt_row eq_eq_row).j = h.j :=
begin
  symmetry, apply ssyt.rbc_eq_of_eq_row,
  intro j, rw eq_cell_row,
  intro j, rw eq_eq_row,
end

lemma ssyt.rbs_cert.copy'_out {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  {ν : young_diagram} (T' : ssyt ν)
  (subset_cell_lt_row : ∀ i j (hi : i < h.i), (i, j) ∈ μ → (i, j) ∈ ν)
  (eq_cell_row : ∀ j, (h.i, j) ∈ μ ↔ (h.i, j) ∈ ν)
  (le_lt_row : ∀ i j (hi : i < h.i), T' i j ≤ T i j)
  (eq_eq_row : ∀ j, T h.i j = T' h.i j) :
(h.copy' T' subset_cell_lt_row eq_cell_row le_lt_row eq_eq_row).out = h.out :=
begin
  rw [ssyt.rbs_cert.out, ssyt.rbs_cert.out],
  rw ssyt.rbs_cert.copy'_j,
  rw eq_eq_row; refl
end

end rbs_cert

section rbs

def ssyt.rbs_cert.rbs {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (cell : (h.i, h.j) ∈ μ) : ssyt μ := h.legal_of_cert.replace cell

def ssyt.rbs_cert.rbs_end {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (not_cell : (h.i, h.j) ∉ μ) := h.legal_of_cert.add not_cell

@[reducible]
def ssyt.rbs_cert.rbs_end_corner {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (not_cell : (h.i, h.j) ∉ μ) : μ.outer_corner := (h.legal_of_cert.to_outer not_cell)
@[reducible]
def ssyt.rbs_cert.rbs_end_shape {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (not_cell : (h.i, h.j) ∉ μ) : young_diagram := (h.rbs_end_corner not_cell).add

lemma ssyt.rbs_cert.rbs_end_shape_eq_of_ne_row {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (not_cell : (h.i, h.j) ∉ μ) {i j : ℕ} (h_ne : i ≠ h.i) :
(i, j) ∈ h.rbs_end_shape not_cell ↔ (i, j) ∈ μ :=
begin
  rw young_diagram.outer_corner.mem_add,
  apply or_iff_right,
  rw prod.mk.inj_iff, exact λ h_eq, h_ne h_eq.1,
end

lemma ssyt.rbs_cert.rbs_entry {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (cell : (h.i, h.j) ∈ μ) {i j : ℕ} :
h.rbs cell i j = ite ((i, j) = (h.i, h.j)) h.val (T i j) := rfl

lemma ssyt.rbs_cert.rbs_end_entry {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (not_cell : (h.i, h.j) ∉ μ) {i j : ℕ} :
h.rbs_end not_cell i j = ite ((i, j) = (h.i, h.j)) h.val (T i j) := rfl

lemma ssyt.rbs_cert.rbs_entry_eq_of_ne_row {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) {i j : ℕ} (h_ne : i ≠ h.i) :
h.rbs cell i j = T i j :=
begin
  rw [h.rbs_entry, if_neg], rintro ⟨⟩, exact h_ne rfl
end

lemma ssyt.rbs_cert.rbs_end_entry_eq_of_ne_row {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (not_cell : (h.i, h.j) ∉ μ) {i j : ℕ} (h_ne : i ≠ h.i) :
h.rbs_end not_cell i j = T i j :=
begin
  rw [h.rbs_end_entry, if_neg], rintro ⟨rfl, _⟩, exact h_ne rfl
end

lemma ssyt.rbs_cert.rbs_entry_le {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) {i j : ℕ} :
h.rbs cell i j ≤ T i j :=
begin
  rw h.rbs_entry, split_ifs,
  cases h_1,
  exact le_of_lt (h.val_lt_out cell),
  refl
end

lemma ssyt.rbs_cert.next_rbc_le {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) :
 (h.rbs cell).rbc h.i.succ h.out ≤ h.j :=
begin
  rw ssyt.rbc_le_iff, intro cell',
  rw [h.rbs_entry_eq_of_ne_row _ (nat.succ_ne_self _)],
  apply T.col_strict (lt_add_one _) cell',
end

lemma ssyt.rbs_cert.next_cert_cell_up {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) :
let j' := (h.rbs cell).rbc h.i.succ h.out in
∀ i' (hi' : i' < h.i.succ), (i', j') ∈ μ :=
begin
  intros j' i' hi',
  rw nat.lt_succ_iff at hi',
  apply μ.nw_of hi' (h.next_rbc_le _) cell,
end

lemma ssyt.rbs_cert.next_cert_up {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) :
let j' := (h.rbs cell).rbc h.i.succ h.out in
∀ i' (hi' : i' < h.i.succ), (h.rbs cell) i' j' < h.out :=
begin
  intros j' i' hi',
  rw nat.lt_succ_iff at hi',
  rw h.rbs_entry,
  split_ifs with h1,
  { exact h.val_lt_out cell },
    cases lt_or_eq_of_le hi',
    { calc T i' j' < T h.i j'  : T.col_strict ‹i' < h.i› _
      ...          ≤ T h.i h.j : T.row_weak' (h.next_rbc_le cell) cell,
      exact μ.nw_of (le_refl _) (h.next_rbc_le cell) cell },
    { subst i', rw [prod.mk.inj_iff, eq_self_iff_true, true_and] at h1,
      calc T h.i j' ≤ h.val : (T.lt_rbc_iff.mp _).2
      ...           < h.out : h.val_lt_out cell,
      exact lt_of_le_of_ne (h.next_rbc_le cell) ‹j' ≠ h.j› }
end

@[simps]
def ssyt.rbs_cert.next_cert {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) : (h.rbs cell).rbs_cert :=
{ i := h.i.succ,
  val := h.out,
  cell_up := h.next_cert_cell_up cell,
  up := h.next_cert_up cell,
}

-- if we bump in an equal or larger value into the same row,
-- the resulting column is strictly further to the right
lemma ssyt.rbs_cert.rbc_lt_rbc {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ)
  {val' : ℕ} (hval : h.val ≤ val') :
h.j < (h.rbs cell).rbc h.i val' :=
begin
  rw ssyt.lt_rbc_iff, split, exact cell,
  rw [h.rbs_entry, if_pos rfl], exact hval,
end

-- if we bump in an equal or larger value into the same row,
-- the resulting output entry is weakly larger
lemma ssyt.rbs_cert.rbc_out_le_rbc_out {μ : young_diagram} {T : ssyt μ}
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ)
  {val' : ℕ} (hval : h.val ≤ val')
  (cell' : (h.i, (h.rbs cell).rbc h.i val') ∈ μ) :
h.out ≤ (h.rbs cell) h.i ((h.rbs cell).rbc h.i val') :=
begin
  rw [ssyt.rbs_cert.out, h.rbs_entry, if_neg],
  exact T.row_weak (h.rbc_lt_rbc cell hval) cell',
  rw [prod.mk.inj_iff, eq_self_iff_true, true_and],
  exact ne_of_gt (h.rbc_lt_rbc cell hval),
end

end rbs

section size_wt

lemma ssyt.rbs_cert.rbs_end_size {μ : young_diagram} {T : ssyt μ} (h : T.rbs_cert)
  (not_cell : (h.i, h.j) ∉ μ) :
  (h.legal_of_cert.to_outer not_cell).add.size = μ.size + 1 :=
by apply young_diagram.outer_corner.add_size

lemma ssyt.rbs_cert.rbs_wt {μ : young_diagram} (T : ssyt μ) (val : ℕ)
  (h : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) :
  (h.rbs cell).wt val + ite (val = T h.i h.j) 1 0 =
  T.wt val + ite (val = h.val) 1 0 :=
by apply ssyt.wt_replace

lemma ssyt.rbs_cert.rbs_end_wt {μ : young_diagram} (T : ssyt μ) (val : ℕ)
  (h : T.rbs_cert) (not_cell : (h.i, h.j) ∉ μ) :
  (h.rbs_end not_cell).wt val = T.wt val + ite (val = h.val) 1 0 :=
by apply ssyt.wt_add

end size_wt

end row_bump_step

section commutativity

/-
Commutativity:

T  →h1  T1
↓h      ↓h'
T' →h1' Tf

gives the same result, assuming the bumps are in different rows.
-/
lemma ssyt.rbs_cert.rbs_comm {μ : young_diagram}
  {T : ssyt μ} (h h1 : T.rbs_cert) (cell : (h.i, h.j) ∈ μ) (cell1 : (h1.i, h1.j) ∈ μ)
  (h_h1_i : h1.i ≠ h.i)
  (h' : (h1.rbs cell1).rbs_cert) (hi : h'.i = h.i) (hval : h'.val = h.val)
  (h1' : (h.rbs cell).rbs_cert) (h1i : h1'.i = h1.i) (h1val : h1'.val = h1.val)
  (cell' : (h'.i, h'.j) ∈ μ := by {
    rwa [hi, (_ : h'.j = h.j)],
    rw [ssyt.rbs_cert.j, hi, hval, ssyt.rbc_eq_of_eq_row],
    exact λ _, iff.rfl,
    intro j, rw h1.rbs_entry_eq_of_ne_row, exact h_h1_i.symm })
  (cell1' : (h1'.i, h1'.j) ∈ μ := by {
    rwa [h1i, (_ : h1'.j = h1.j)],
    rw [ssyt.rbs_cert.j, h1i, h1val, ssyt.rbc_eq_of_eq_row],
    exact λ _, iff.rfl,
    intro j, rw h.rbs_entry_eq_of_ne_row, exact h_h1_i })
  (i j : ℕ) : h1'.rbs cell1' i j = h'.rbs cell' i j :=
begin
  have hj : h'.j = h.j := by {
    rw [ssyt.rbs_cert.j, hi, hval, ssyt.rbc_eq_of_eq_row],
    exact λ _, iff.rfl,
    intro j, rw h1.rbs_entry_eq_of_ne_row, exact h_h1_i.symm },
  have h1j : h1'.j = h1.j := by {
    rw [ssyt.rbs_cert.j, h1i, h1val, ssyt.rbc_eq_of_eq_row],
    exact λ _, iff.rfl,
    intro j, rw h.rbs_entry_eq_of_ne_row, exact h_h1_i },
  cases ne_or_eq i h.i,
    rw h'.rbs_entry_eq_of_ne_row,
    rw [h1'.rbs_entry, h1i, h1val, h1j, h.rbs_entry_eq_of_ne_row], refl,
    exact h_1, rwa hi,
  cases h_1,
    rw h1'.rbs_entry_eq_of_ne_row,
    rw [h'.rbs_entry, hi, hval, hj, h1.rbs_entry_eq_of_ne_row], refl,
    exact h_h1_i.symm, rw h1i, exact h_h1_i.symm,
end

end commutativity

section examples

-- #eval (μ5331.lowest_ssyt.rbs_start_cert 0).rbs sorry
-- #eval (μ5331.lowest_ssyt.rbs_start_cert 2).rbs sorry
-- #eval (μ5331.lowest_ssyt.rbs_start_cert 4).rbs_end sorry

end examples


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

! This file was ported from Lean 3 source module tactic.lift
! leanprover-community/mathlib commit 801c013fed96f0d3d9c15e23fe3ddad4481960a8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Rcases

/-!
# lift tactic

This file defines the `lift` tactic, allowing the user to lift elements from one type to another
under a specified condition.

## Tags

lift, tactic
-/

#print CanLift /-
/-- A class specifying that you can lift elements from `α` to `β` assuming `cond` is true.
  Used by the tactic `lift`. -/
class CanLift (α β : Sort _) (coe : outParam <| β → α) (cond : outParam <| α → Prop) where
  prf : ∀ x : α, cond x → ∃ y : β, coe y = x
#align can_lift CanLift
-/

instance : CanLift ℤ ℕ coe ((· ≤ ·) 0) :=
  ⟨fun n hn => ⟨n.natAbs, Int.natAbs_of_nonneg hn⟩⟩

#print Pi.canLift /-
/-- Enable automatic handling of pi types in `can_lift`. -/
instance Pi.canLift (ι : Sort _) (α β : ι → Sort _) (coe : ∀ i, β i → α i) (P : ∀ i, α i → Prop)
    [∀ i : ι, CanLift (α i) (β i) (coe i) (P i)] :
    CanLift (∀ i : ι, α i) (∀ i : ι, β i) (fun f i => coe i (f i)) fun f => ∀ i, P i (f i)
    where prf f hf :=
    ⟨fun i => Classical.choose (CanLift.prf (f i) (hf i)),
      funext fun i => Classical.choose_spec (CanLift.prf (f i) (hf i))⟩
#align pi.can_lift Pi.canLift
-/

/- warning: subtype.exists_pi_extension -> Subtype.exists_pi_extension is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : ι -> Sort.{u2}} [ne : forall (i : ι), Nonempty.{u2} (α i)] {p : ι -> Prop} (f : forall (i : Subtype.{u1} ι p), α ((fun (a : Sort.{max 1 u1}) (b : Sort.{u1}) [self : HasLiftT.{max 1 u1, u1} a b] => self.0) (Subtype.{u1} ι p) ι (HasLiftT.mk.{max 1 u1, u1} (Subtype.{u1} ι p) ι (CoeTCₓ.coe.{max 1 u1, u1} (Subtype.{u1} ι p) ι (coeBase.{max 1 u1, u1} (Subtype.{u1} ι p) ι (coeSubtype.{u1} ι (fun (x : ι) => p x))))) i)), Exists.{imax u1 u2} (forall (i : ι), α i) (fun (g : forall (i : ι), α i) => Eq.{imax (max 1 u1) u2} (forall (i : Subtype.{u1} ι p), α ((fun (a : Sort.{max 1 u1}) (b : Sort.{u1}) [self : HasLiftT.{max 1 u1, u1} a b] => self.0) (Subtype.{u1} ι p) ι (HasLiftT.mk.{max 1 u1, u1} (Subtype.{u1} ι p) ι (CoeTCₓ.coe.{max 1 u1, u1} (Subtype.{u1} ι p) ι (coeBase.{max 1 u1, u1} (Subtype.{u1} ι p) ι (coeSubtype.{u1} ι (fun (x : ι) => p x))))) i)) (fun (i : Subtype.{u1} ι p) => g ((fun (a : Sort.{max 1 u1}) (b : Sort.{u1}) [self : HasLiftT.{max 1 u1, u1} a b] => self.0) (Subtype.{u1} ι p) ι (HasLiftT.mk.{max 1 u1, u1} (Subtype.{u1} ι p) ι (CoeTCₓ.coe.{max 1 u1, u1} (Subtype.{u1} ι p) ι (coeBase.{max 1 u1, u1} (Subtype.{u1} ι p) ι (coeSubtype.{u1} ι (fun (x : ι) => p x))))) i)) f)
but is expected to have type
  forall {ι : Sort.{u2}} {α : ι -> Sort.{u1}} [ne : forall (i : ι), Nonempty.{u1} (α i)] {p : ι -> Prop} (f : forall (i : Subtype.{u2} ι p), α (Subtype.val.{u2} ι p i)), Exists.{imax u2 u1} (forall (i : ι), α i) (fun (g : forall (i : ι), α i) => Eq.{imax (max 1 u2) u1} (forall (i : Subtype.{u2} ι p), α (Subtype.val.{u2} ι p i)) (fun (i : Subtype.{u2} ι p) => g (Subtype.val.{u2} ι p i)) f)
Case conversion may be inaccurate. Consider using '#align subtype.exists_pi_extension Subtype.exists_pi_extensionₓ'. -/
theorem Subtype.exists_pi_extension {ι : Sort _} {α : ι → Sort _} [ne : ∀ i, Nonempty (α i)]
    {p : ι → Prop} (f : ∀ i : Subtype p, α i) :
    ∃ g : ∀ i : ι, α i, (fun i : Subtype p => g i) = f := by
  classical
    refine' ⟨fun i => if hi : p i then f ⟨i, hi⟩ else Classical.choice (Ne i), funext _⟩
    rintro ⟨i, hi⟩
    exact dif_pos hi
#align subtype.exists_pi_extension Subtype.exists_pi_extension

#print PiSubtype.canLift /-
instance PiSubtype.canLift (ι : Sort _) (α : ι → Sort _) [ne : ∀ i, Nonempty (α i)] (p : ι → Prop) :
    CanLift (∀ i : Subtype p, α i) (∀ i, α i) (fun f i => f i) fun _ => True
    where prf f _ := Subtype.exists_pi_extension f
#align pi_subtype.can_lift PiSubtype.canLift
-/

#print PiSubtype.canLift' /-
instance PiSubtype.canLift' (ι : Sort _) (α : Sort _) [ne : Nonempty α] (p : ι → Prop) :
    CanLift (Subtype p → α) (ι → α) (fun f i => f i) fun _ => True :=
  PiSubtype.canLift ι (fun _ => α) p
#align pi_subtype.can_lift' PiSubtype.canLift'
-/

#print Subtype.canLift /-
instance Subtype.canLift {α : Sort _} (p : α → Prop) : CanLift α { x // p x } coe p
    where prf a ha := ⟨⟨a, ha⟩, rfl⟩
#align subtype.can_lift Subtype.canLift
-/

open Tactic

namespace Tactic

/-- Construct the proof of `cond x` in the lift tactic.
*  `e` is the expression being lifted and `h` is the specified proof of `can_lift.cond e`.
*  `old_tp` and `new_tp` are the arguments to `can_lift` and `inst` is the `can_lift`-instance.
*  `s` and `to_unfold` contain the information of the simp set used to simplify.

If the proof was specified, we check whether it has the correct type.
If it doesn't have the correct type, we display an error message.

If the proof was not specified, we create assert it as a local constant.
(The name of this local constant doesn't matter, since `lift` will remove it from the context.)
-/
unsafe def get_lift_prf (h : Option pexpr) (e P : expr) : tactic (expr × Bool) := do
  let expected_prf_ty := P.app e
  let expected_prf_ty ← simp_lemmas.mk.dsimplify [] expected_prf_ty { failIfUnchanged := false }
  match h with
    | some h => do
      let e ← decorate_error "lift tactic failed." (i_to_expr ``(($(h) : $(expected_prf_ty))))
      return (e, tt)
    | none => do
      let prf_nm ← get_unused_name
      let prf ← assert prf_nm expected_prf_ty
      swap
      return (prf, ff)
#align tactic.get_lift_prf tactic.get_lift_prf

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      Lift the expression `p` to the type `t`, with proof obligation given by `h`.
        The list `n` is used for the two newly generated names, and to specify whether `h` should
        remain in the local context. See the doc string of `tactic.interactive.lift` for more information.
        -/
    unsafe
  def
    lift
    ( p : pexpr ) ( t : pexpr ) ( h : Option pexpr ) ( n : List Name ) : tactic Unit
    :=
      do
        propositional_goal
            <|>
            fail "lift tactic failed. Tactic is only applicable when the target is a proposition."
          let e ← i_to_expr p
          let old_tp ← infer_type e
          let new_tp ← i_to_expr ` `( ( $ ( t ) : Sort _ ) )
          let coe ← i_to_expr ` `( $ ( new_tp ) → $ ( old_tp ) ) >>= mk_meta_var
          let P ← i_to_expr ` `( $ ( old_tp ) → Prop ) >>= mk_meta_var
          let inst_type ← mk_app ` ` CanLift [ old_tp , new_tp , coe , P ]
          let
            inst
              ←
              mk_instance inst_type
                <|>
                (
                    f!
                      "Failed to find a lift from {
                        ( ← old_tp )
                        } to {
                        ( ← new_tp )
                        }. Provide an instance of
                          { ← inst_type }"
                    )
                  >>=
                  fail
          let inst ← instantiate_mvars inst
          let coe ← instantiate_mvars coe
          let P ← instantiate_mvars P
          let ( prf_cond , b ) ← get_lift_prf h e P
          let prf_nm := if prf_cond . is_local_constant then some prf_cond . local_pp_name else none
          let prf_ex0 ← mk_mapp `can_lift.prf [ old_tp , new_tp , coe , P , inst , e ]
          let prf_ex := prf_ex0 prf_cond
          let
            new_nm
              ←
              if
                n ≠ [ ]
                then
                return n . headI
                else
                if e . is_local_constant then return e . local_pp_name else get_unused_name
          let
            eq_nm
              ←
              if
                hn
                :
                1 < n . length
                then
                return ( n . nthLe 1 hn )
                else
                if e . is_local_constant then return `rfl else get_unused_name `h
          let temp_nm ← get_unused_name
          let temp_e ← note temp_nm none prf_ex
          dsimp_hyp temp_e none [ ] { failIfUnchanged := ff }
          rcases none ( pexpr.of_expr temp_e )
            <|
            rcases_patt.tuple ( [ new_nm , eq_nm ] . map rcases_patt.one )
          when
            ( ¬ e )
              (
                get_local eq_nm
                  >>=
                  fun
                    e
                      =>
                      interactive.rw
                        ⟨ [ ⟨ ⟨ 0 , 0 ⟩ , tt , pexpr.of_expr e ⟩ ] , none ⟩ Interactive.Loc.wildcard
                )
          if
            h_prf_nm
            :
            prf_nm ∧ n 2 ≠ prf_nm
            then
            get_local ( Option.get h_prf_nm . 1 ) >>= clear
            else
            skip
          if b then skip else swap
#align tactic.lift tactic.lift

/- ./././Mathport/Syntax/Translate/Tactic/Mathlib/Core.lean:38:34: unsupported: setup_tactic_parser -/
/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `parser.optional -/
/-- Parses an optional token "using" followed by a trailing `pexpr`. -/
unsafe def using_texpr :=
  parser.optional (tk "using" *> texpr)
#align tactic.using_texpr tactic.using_texpr

/-- Parses a token "to" followed by a trailing `pexpr`. -/
unsafe def to_texpr :=
  tk "to" *> texpr
#align tactic.to_texpr tactic.to_texpr

namespace Interactive

/-- Lift an expression to another type.
* Usage: `'lift' expr 'to' expr ('using' expr)? ('with' id (id id?)?)?`.
* If `n : ℤ` and `hn : n ≥ 0` then the tactic `lift n to ℕ using hn` creates a new
  constant of type `ℕ`, also named `n` and replaces all occurrences of the old variable `(n : ℤ)`
  with `↑n` (where `n` in the new variable). It will remove `n` and `hn` from the context.
  + So for example the tactic `lift n to ℕ using hn` transforms the goal
    `n : ℤ, hn : n ≥ 0, h : P n ⊢ n = 3` to `n : ℕ, h : P ↑n ⊢ ↑n = 3`
    (here `P` is some term of type `ℤ → Prop`).
* The argument `using hn` is optional, the tactic `lift n to ℕ` does the same, but also creates a
  new subgoal that `n ≥ 0` (where `n` is the old variable).
  This subgoal will be placed at the top of the goal list.
  + So for example the tactic `lift n to ℕ` transforms the goal
    `n : ℤ, h : P n ⊢ n = 3` to two goals
    `n : ℤ, h : P n ⊢ n ≥ 0` and `n : ℕ, h : P ↑n ⊢ ↑n = 3`.
* You can also use `lift n to ℕ using e` where `e` is any expression of type `n ≥ 0`.
* Use `lift n to ℕ with k` to specify the name of the new variable.
* Use `lift n to ℕ with k hk` to also specify the name of the equality `↑k = n`. In this case, `n`
  will remain in the context. You can use `rfl` for the name of `hk` to substitute `n` away
  (i.e. the default behavior).
* You can also use `lift e to ℕ with k hk` where `e` is any expression of type `ℤ`.
  In this case, the `hk` will always stay in the context, but it will be used to rewrite `e` in
  all hypotheses and the target.
  + So for example the tactic `lift n + 3 to ℕ using hn with k hk` transforms the goal
    `n : ℤ, hn : n + 3 ≥ 0, h : P (n + 3) ⊢ n + 3 = 2 * n` to the goal
    `n : ℤ, k : ℕ, hk : ↑k = n + 3, h : P ↑k ⊢ ↑k = 2 * n`.
* The tactic `lift n to ℕ using h` will remove `h` from the context. If you want to keep it,
  specify it again as the third argument to `with`, like this: `lift n to ℕ using h with n rfl h`.
* More generally, this can lift an expression from `α` to `β` assuming that there is an instance
  of `can_lift α β`. In this case the proof obligation is specified by `can_lift.cond`.
* Given an instance `can_lift β γ`, it can also lift `α → β` to `α → γ`; more generally, given
  `β : Π a : α, Type*`, `γ : Π a : α, Type*`, and `[Π a : α, can_lift (β a) (γ a)]`, it
  automatically generates an instance `can_lift (Π a, β a) (Π a, γ a)`.

`lift` is in some sense dual to the `zify` tactic. `lift (z : ℤ) to ℕ` will change the type of an
integer `z` (in the supertype) to `ℕ` (the subtype), given a proof that `z ≥ 0`;
propositions concerning `z` will still be over `ℤ`. `zify` changes propositions about `ℕ` (the
subtype) to propositions about `ℤ` (the supertype), without changing the type of any variable.
-/
unsafe def lift (p : parse texpr) (t : parse to_texpr) (h : parse using_texpr)
    (n : parse with_ident_list) : tactic Unit :=
  tactic.lift p t h n
#align tactic.interactive.lift tactic.interactive.lift

add_tactic_doc
  { Name := "lift"
    category := DocCategory.tactic
    declNames := [`tactic.interactive.lift]
    tags := ["coercions"] }

end Interactive

end Tactic


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.basic
import ring_theory.noetherian

/-!
# Lie subalgebras

This file defines Lie subalgebras of a Lie algebra and provides basic related definitions and
results.

## Main definitions

  * `lie_subalgebra`
  * `lie_subalgebra.incl`
  * `lie_subalgebra.map`
  * `lie_hom.range`
  * `lie_equiv.of_injective`
  * `lie_equiv.of_eq`
  * `lie_equiv.of_subalgebra`
  * `lie_equiv.of_subalgebras`

## Tags

lie algebra, lie subalgebra
-/

universes u v w w₁ w₂

section lie_subalgebra

variables (R : Type u) (L : Type v) [comm_ring R] [lie_ring L] [lie_algebra R L]

/-- A Lie subalgebra of a Lie algebra is submodule that is closed under the Lie bracket.
This is a sufficient condition for the subset itself to form a Lie algebra. -/
structure lie_subalgebra extends submodule R L :=
(lie_mem' : ∀ {x y}, x ∈ carrier → y ∈ carrier → ⁅x, y⁆ ∈ carrier)

attribute [nolint doc_blame] lie_subalgebra.to_submodule

/-- The zero algebra is a subalgebra of any Lie algebra. -/
instance : has_zero (lie_subalgebra R L) :=
⟨{ lie_mem' := λ x y hx hy, by { rw [((submodule.mem_bot R).1 hx), zero_lie],
                                exact submodule.zero_mem (0 : submodule R L), },
   ..(0 : submodule R L) }⟩

instance : inhabited (lie_subalgebra R L) := ⟨0⟩
instance : has_coe (lie_subalgebra R L) (submodule R L) := ⟨lie_subalgebra.to_submodule⟩

namespace lie_subalgebra

instance : set_like (lie_subalgebra R L) L :=
{ coe := λ L', L',
  coe_injective' := λ L' L'' h, by { rcases L' with ⟨⟨⟩⟩, rcases L'' with ⟨⟨⟩⟩, congr' } }

instance : add_subgroup_class (lie_subalgebra R L) L :=
{ add_mem := λ L', L'.add_mem',
  zero_mem := λ L', L'.zero_mem',
  neg_mem := λ L' x hx, show -x ∈ (L' : submodule R L), from neg_mem hx }

/-- A Lie subalgebra forms a new Lie ring. -/
instance (L' : lie_subalgebra R L) : lie_ring L' :=
{ bracket      := λ x y, ⟨⁅x.val, y.val⁆, L'.lie_mem' x.property y.property⟩,
  lie_add      := by { intros, apply set_coe.ext, apply lie_add, },
  add_lie      := by { intros, apply set_coe.ext, apply add_lie, },
  lie_self     := by { intros, apply set_coe.ext, apply lie_self, },
  leibniz_lie  := by { intros, apply set_coe.ext, apply leibniz_lie, } }

section

variables {R₁ : Type*} [semiring R₁]

/-- A Lie subalgebra inherits module structures from `L`. -/
instance [has_scalar R₁ R] [module R₁ L] [is_scalar_tower R₁ R L]
  (L' : lie_subalgebra R L) : module R₁ L' :=
L'.to_submodule.module'

instance [has_scalar R₁ R] [has_scalar R₁ᵐᵒᵖ R] [module R₁ L] [module R₁ᵐᵒᵖ L]
  [is_scalar_tower R₁ R L] [is_scalar_tower R₁ᵐᵒᵖ R L] [is_central_scalar R₁ L]
  (L' : lie_subalgebra R L) : is_central_scalar R₁ L' :=
L'.to_submodule.is_central_scalar

instance [has_scalar R₁ R] [module R₁ L] [is_scalar_tower R₁ R L]
  (L' : lie_subalgebra R L) : is_scalar_tower R₁ R L' :=
L'.to_submodule.is_scalar_tower

end

/-- A Lie subalgebra forms a new Lie algebra. -/
instance (L' : lie_subalgebra R L) : lie_algebra R L' :=
{ lie_smul := by { intros, apply set_coe.ext, apply lie_smul } }

variables {R L} (L' : lie_subalgebra R L)

@[simp] protected lemma zero_mem : (0 : L) ∈ L' := zero_mem L'
protected lemma add_mem {x y : L} : x ∈ L' → y ∈ L' → (x + y : L) ∈ L' := add_mem
protected lemma sub_mem {x y : L} : x ∈ L' → y ∈ L' → (x - y : L) ∈ L' := sub_mem

lemma smul_mem (t : R) {x : L} (h : x ∈ L') : t • x ∈ L' := (L' : submodule R L).smul_mem t h

lemma lie_mem {x y : L} (hx : x ∈ L') (hy : y ∈ L') : (⁅x, y⁆ : L) ∈ L' := L'.lie_mem' hx hy

@[simp] lemma mem_carrier {x : L} : x ∈ L'.carrier ↔ x ∈ (L' : set L) := iff.rfl

@[simp] lemma mem_mk_iff (S : set L) (h₁ h₂ h₃ h₄) {x : L} :
  x ∈ (⟨⟨S, h₁, h₂, h₃⟩, h₄⟩ : lie_subalgebra R L) ↔ x ∈ S :=
iff.rfl

@[simp] lemma mem_coe_submodule {x : L} : x ∈ (L' : submodule R L) ↔ x ∈ L' := iff.rfl

lemma mem_coe {x : L} : x ∈ (L' : set L) ↔ x ∈ L' := iff.rfl

@[simp, norm_cast] lemma coe_bracket (x y : L') : (↑⁅x, y⁆ : L) = ⁅(↑x : L), ↑y⁆ := rfl

lemma ext_iff (x y : L') : x = y ↔ (x : L) = y := subtype.ext_iff

lemma coe_zero_iff_zero (x : L') : (x : L) = 0 ↔ x = 0 := (ext_iff L' x 0).symm

@[ext] lemma ext (L₁' L₂' : lie_subalgebra R L) (h : ∀ x, x ∈ L₁' ↔ x ∈ L₂') :
  L₁' = L₂' :=
set_like.ext h

lemma ext_iff' (L₁' L₂' : lie_subalgebra R L) : L₁' = L₂' ↔ ∀ x, x ∈ L₁' ↔ x ∈ L₂' :=
set_like.ext_iff

@[simp] lemma mk_coe (S : set L) (h₁ h₂ h₃ h₄) :
  ((⟨⟨S, h₁, h₂, h₃⟩, h₄⟩ : lie_subalgebra R L) : set L) = S := rfl

@[simp] lemma coe_to_submodule_mk (p : submodule R L) (h) :
  (({lie_mem' := h, ..p} : lie_subalgebra R L) : submodule R L) = p :=
by { cases p, refl, }

lemma coe_injective : function.injective (coe : lie_subalgebra R L → set L) :=
set_like.coe_injective

@[norm_cast] theorem coe_set_eq (L₁' L₂' : lie_subalgebra R L) :
  (L₁' : set L) = L₂' ↔ L₁' = L₂' := set_like.coe_set_eq

lemma to_submodule_injective :
  function.injective (coe : lie_subalgebra R L → submodule R L) :=
λ L₁' L₂' h, by { rw set_like.ext'_iff at h, rw ← coe_set_eq, exact h, }

@[simp] lemma coe_to_submodule_eq_iff (L₁' L₂' : lie_subalgebra R L) :
  (L₁' : submodule R L) = (L₂' : submodule R L) ↔ L₁' = L₂' :=
to_submodule_injective.eq_iff

@[norm_cast]
lemma coe_to_submodule : ((L' : submodule R L) : set L) = L' := rfl

section lie_module

variables {M : Type w} [add_comm_group M] [lie_ring_module L M]
variables {N : Type w₁} [add_comm_group N] [lie_ring_module L N] [module R N] [lie_module R L N]

/-- Given a Lie algebra `L` containing a Lie subalgebra `L' ⊆ L`, together with a Lie ring module
`M` of `L`, we may regard `M` as a Lie ring module of `L'` by restriction. -/
instance : lie_ring_module L' M :=
{ bracket     := λ x m, ⁅(x : L), m⁆,
  add_lie     := λ x y m, add_lie x y m,
  lie_add     := λ x y m, lie_add x y m,
  leibniz_lie := λ x y m, leibniz_lie x y m, }

@[simp] lemma coe_bracket_of_module (x : L') (m : M) : ⁅x, m⁆ = ⁅(x : L), m⁆ := rfl

variables [module R M] [lie_module R L M]

/-- Given a Lie algebra `L` containing a Lie subalgebra `L' ⊆ L`, together with a Lie module `M` of
`L`, we may regard `M` as a Lie module of `L'` by restriction. -/
instance : lie_module R L' M :=
{ smul_lie := λ t x m, by simp only [coe_bracket_of_module, smul_lie, submodule.coe_smul_of_tower],
  lie_smul := λ t x m, by simp only [coe_bracket_of_module, lie_smul], }

/-- An `L`-equivariant map of Lie modules `M → N` is `L'`-equivariant for any Lie subalgebra
`L' ⊆ L`. -/
def _root_.lie_module_hom.restrict_lie (f : M →ₗ⁅R,L⁆ N) (L' : lie_subalgebra R L) : M →ₗ⁅R,L'⁆ N :=
{ map_lie' := λ x m, f.map_lie ↑x m,
  .. (f : M →ₗ[R] N)}

@[simp] lemma _root_.lie_module_hom.coe_restrict_lie (f : M →ₗ⁅R,L⁆ N) :
  ⇑(f.restrict_lie L') = f :=
rfl

end lie_module

/-- The embedding of a Lie subalgebra into the ambient space as a morphism of Lie algebras. -/
def incl : L' →ₗ⁅R⁆ L :=
{ map_lie' := λ x y, by { simp only [linear_map.to_fun_eq_coe, submodule.subtype_apply], refl, },
  .. (L' : submodule R L).subtype, }

@[simp] lemma coe_incl : ⇑L'.incl = coe := rfl

/-- The embedding of a Lie subalgebra into the ambient space as a morphism of Lie modules. -/
def incl' : L' →ₗ⁅R,L'⁆ L :=
{ map_lie' := λ x y, by simp only [coe_bracket_of_module, linear_map.to_fun_eq_coe,
    submodule.subtype_apply, coe_bracket],
  .. (L' : submodule R L).subtype, }

@[simp] lemma coe_incl' : ⇑L'.incl' = coe := rfl

end lie_subalgebra

variables {R L} {L₂ : Type w} [lie_ring L₂] [lie_algebra R L₂]
variables (f : L →ₗ⁅R⁆ L₂)

namespace lie_hom

/-- The range of a morphism of Lie algebras is a Lie subalgebra. -/
def range : lie_subalgebra R L₂ :=
{ lie_mem' := λ x y,
    show x ∈ f.to_linear_map.range → y ∈ f.to_linear_map.range → ⁅x, y⁆ ∈ f.to_linear_map.range,
    by { repeat { rw linear_map.mem_range }, rintros ⟨x', hx⟩ ⟨y', hy⟩, refine ⟨⁅x', y'⁆, _⟩,
         rw [←hx, ←hy], change f ⁅x', y'⁆ = ⁅f x', f y'⁆, rw map_lie, },
  ..(f : L →ₗ[R] L₂).range }

@[simp] lemma range_coe : (f.range : set L₂) = set.range f :=
linear_map.range_coe ↑f

@[simp] lemma mem_range (x : L₂) : x ∈ f.range ↔ ∃ (y : L), f y = x := linear_map.mem_range

lemma mem_range_self (x : L) : f x ∈ f.range := linear_map.mem_range_self f x

/-- We can restrict a morphism to a (surjective) map to its range. -/
def range_restrict : L →ₗ⁅R⁆ f.range :=
{ map_lie' := λ x y, by { apply subtype.ext, exact f.map_lie x y, },
  ..(f : L →ₗ[R] L₂).range_restrict, }

@[simp] lemma range_restrict_apply (x : L) : f.range_restrict x = ⟨f x, f.mem_range_self x⟩ := rfl

lemma surjective_range_restrict : function.surjective (f.range_restrict) :=
begin
  rintros ⟨y, hy⟩,
  erw mem_range at hy, obtain ⟨x, rfl⟩ := hy,
  use x,
  simp only [subtype.mk_eq_mk, range_restrict_apply],
end

/-- A Lie algebra is equivalent to its range under an injective Lie algebra morphism. -/
noncomputable def equiv_range_of_injective (h : function.injective f) : L ≃ₗ⁅R⁆ f.range :=
lie_equiv.of_bijective f.range_restrict (λ x y hxy,
begin
  simp only [subtype.mk_eq_mk, range_restrict_apply] at hxy,
  exact h hxy,
end) f.surjective_range_restrict

@[simp] lemma equiv_range_of_injective_apply (h : function.injective f) (x : L) :
  f.equiv_range_of_injective h x = ⟨f x, mem_range_self f x⟩ :=
rfl

end lie_hom

lemma submodule.exists_lie_subalgebra_coe_eq_iff (p : submodule R L) :
  (∃ (K : lie_subalgebra R L), ↑K = p) ↔ ∀ (x y : L), x ∈ p → y ∈ p → ⁅x, y⁆ ∈ p :=
begin
  split,
  { rintros ⟨K, rfl⟩, exact K.lie_mem', },
  { intros h, use { lie_mem' := h, ..p }, exact lie_subalgebra.coe_to_submodule_mk p _, },
end

namespace lie_subalgebra

variables (K K' : lie_subalgebra R L) (K₂ : lie_subalgebra R L₂)

@[simp] lemma incl_range : K.incl.range = K :=
by { rw ← coe_to_submodule_eq_iff, exact (K : submodule R L).range_subtype, }

/-- The image of a Lie subalgebra under a Lie algebra morphism is a Lie subalgebra of the
codomain. -/
def map : lie_subalgebra R L₂ :=
{ lie_mem' := λ x y hx hy, by
  { erw submodule.mem_map at hx, rcases hx with ⟨x', hx', hx⟩, rw ←hx,
    erw submodule.mem_map at hy, rcases hy with ⟨y', hy', hy⟩, rw ←hy,
    erw submodule.mem_map,
    exact ⟨⁅x', y'⁆, K.lie_mem hx' hy', f.map_lie x' y'⟩, },
..((K : submodule R L).map (f : L →ₗ[R] L₂)) }

@[simp] lemma mem_map (x : L₂) : x ∈ K.map f ↔ ∃ (y : L), y ∈ K ∧ f y = x := submodule.mem_map

-- TODO Rename and state for homs instead of equivs.
@[simp] lemma mem_map_submodule (e : L ≃ₗ⁅R⁆ L₂) (x : L₂) :
  x ∈ K.map (e : L →ₗ⁅R⁆ L₂) ↔ x ∈ (K : submodule R L).map (e : L →ₗ[R] L₂) :=
iff.rfl

/-- The preimage of a Lie subalgebra under a Lie algebra morphism is a Lie subalgebra of the
domain. -/
def comap : lie_subalgebra R L :=
{ lie_mem' := λ x y hx hy, by
    { suffices : ⁅f x, f y⁆ ∈ K₂, by { simp [this], }, exact K₂.lie_mem hx hy, },
  ..((K₂ : submodule R L₂).comap (f : L →ₗ[R] L₂)), }

section lattice_structure

open set

instance : partial_order (lie_subalgebra R L) :=
{ le := λ N N', ∀ ⦃x⦄, x ∈ N → x ∈ N', -- Overriding `le` like this gives a better defeq.
  ..partial_order.lift (coe : lie_subalgebra R L → set L) coe_injective }

lemma le_def : K ≤ K' ↔ (K : set L) ⊆ K' := iff.rfl

@[simp, norm_cast] lemma coe_submodule_le_coe_submodule : (K : submodule R L) ≤ K' ↔ K ≤ K' :=
iff.rfl

instance : has_bot (lie_subalgebra R L) := ⟨0⟩

@[simp] lemma bot_coe : ((⊥ : lie_subalgebra R L) : set L) = {0} := rfl

@[simp] lemma bot_coe_submodule : ((⊥ : lie_subalgebra R L) : submodule R L) = ⊥ := rfl

@[simp] lemma mem_bot (x : L) : x ∈ (⊥ : lie_subalgebra R L) ↔ x = 0 := mem_singleton_iff

instance : has_top (lie_subalgebra R L) :=
⟨{ lie_mem' := λ x y hx hy, mem_univ ⁅x, y⁆,
   ..(⊤ : submodule R L) }⟩

@[simp] lemma top_coe : ((⊤ : lie_subalgebra R L) : set L) = univ := rfl

@[simp] lemma top_coe_submodule : ((⊤ : lie_subalgebra R L) : submodule R L) = ⊤ := rfl

@[simp] lemma mem_top (x : L) : x ∈ (⊤ : lie_subalgebra R L) := mem_univ x

lemma _root_.lie_hom.range_eq_map : f.range = map f ⊤ :=
by { ext, simp }

instance : has_inf (lie_subalgebra R L) :=
⟨λ K K', { lie_mem' := λ x y hx hy, mem_inter (K.lie_mem hx.1 hy.1) (K'.lie_mem hx.2 hy.2),
            ..(K ⊓ K' : submodule R L) }⟩

instance : has_Inf (lie_subalgebra R L) :=
⟨λ S, { lie_mem' := λ x y hx hy, by
        { simp only [submodule.mem_carrier, mem_Inter, submodule.Inf_coe, mem_set_of_eq,
            forall_apply_eq_imp_iff₂, exists_imp_distrib] at *,
          intros K hK, exact K.lie_mem (hx K hK) (hy K hK), },
        ..Inf {(s : submodule R L) | s ∈ S} }⟩

@[simp] theorem inf_coe : (↑(K ⊓ K') : set L) = K ∩ K' := rfl

@[simp] lemma Inf_coe_to_submodule (S : set (lie_subalgebra R L)) :
  (↑(Inf S) : submodule R L) = Inf {(s : submodule R L) | s ∈ S} := rfl

@[simp] lemma Inf_coe (S : set (lie_subalgebra R L)) : (↑(Inf S) : set L) = ⋂ s ∈ S, (s : set L) :=
begin
  rw [← coe_to_submodule, Inf_coe_to_submodule, submodule.Inf_coe],
  ext x,
  simpa only [mem_Inter, mem_set_of_eq, forall_apply_eq_imp_iff₂, exists_imp_distrib],
end

lemma Inf_glb (S : set (lie_subalgebra R L)) : is_glb S (Inf S) :=
begin
  have h : ∀ (K K' : lie_subalgebra R L), (K : set L) ≤ K' ↔ K ≤ K', { intros, exact iff.rfl, },
  apply is_glb.of_image h,
  simp only [Inf_coe],
  exact is_glb_binfi
end

/-- The set of Lie subalgebras of a Lie algebra form a complete lattice.

We provide explicit values for the fields `bot`, `top`, `inf` to get more convenient definitions
than we would otherwise obtain from `complete_lattice_of_Inf`. -/
instance : complete_lattice (lie_subalgebra R L) :=
{ bot          := ⊥,
  bot_le       := λ N _ h, by { rw mem_bot at h, rw h, exact N.zero_mem', },
  top          := ⊤,
  le_top       := λ _ _ _, trivial,
  inf          := (⊓),
  le_inf       := λ N₁ N₂ N₃ h₁₂ h₁₃ m hm, ⟨h₁₂ hm, h₁₃ hm⟩,
  inf_le_left  := λ _ _ _, and.left,
  inf_le_right := λ _ _ _, and.right,
  ..complete_lattice_of_Inf _ Inf_glb }

instance : add_comm_monoid (lie_subalgebra R L) :=
{ add       := (⊔),
  add_assoc := λ _ _ _, sup_assoc,
  zero      := ⊥,
  zero_add  := λ _, bot_sup_eq,
  add_zero  := λ _, sup_bot_eq,
  add_comm  := λ _ _, sup_comm, }

instance : canonically_ordered_add_monoid (lie_subalgebra R L) :=
{ add_le_add_left := λ a b, sup_le_sup_left,
  exists_add_of_le := λ a b h, ⟨b, (sup_eq_right.2 h).symm⟩,
  le_self_add := λ a b, le_sup_left,
  ..lie_subalgebra.add_comm_monoid,
  ..lie_subalgebra.complete_lattice }

@[simp] lemma add_eq_sup : K + K' = K ⊔ K' := rfl

@[norm_cast, simp] lemma inf_coe_to_submodule :
  (↑(K ⊓ K') : submodule R L) = (K : submodule R L) ⊓ (K' : submodule R L) := rfl

@[simp] lemma mem_inf (x : L) : x ∈ K ⊓ K' ↔ x ∈ K ∧ x ∈ K' :=
by rw [← mem_coe_submodule, ← mem_coe_submodule, ← mem_coe_submodule, inf_coe_to_submodule,
  submodule.mem_inf]

lemma eq_bot_iff : K = ⊥ ↔ ∀ (x : L), x ∈ K → x = 0 :=
by { rw eq_bot_iff, exact iff.rfl, }

-- TODO[gh-6025]: make this an instance once safe to do so
lemma subsingleton_of_bot : subsingleton (lie_subalgebra R ↥(⊥ : lie_subalgebra R L)) :=
begin
  apply subsingleton_of_bot_eq_top,
  ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw submodule.mem_bot at hx, subst hx,
  simp only [true_iff, eq_self_iff_true, submodule.mk_eq_zero, mem_bot],
end

lemma subsingleton_bot : subsingleton ↥(⊥ : lie_subalgebra R L) :=
show subsingleton ((⊥ : lie_subalgebra R L) : set L), by simp

variables (R L)

lemma well_founded_of_noetherian [is_noetherian R L] :
  well_founded ((>) : lie_subalgebra R L → lie_subalgebra R L → Prop) :=
  let f : ((>) : lie_subalgebra R L → lie_subalgebra R L → Prop) →r
          ((>) : submodule R L → submodule R L → Prop) :=
  { to_fun       := coe,
    map_rel' := λ N N' h, h, }
in rel_hom_class.well_founded f (is_noetherian_iff_well_founded.mp infer_instance)

variables {R L K K' f}

section nested_subalgebras

variables (h : K ≤ K')

/-- Given two nested Lie subalgebras `K ⊆ K'`, the inclusion `K ↪ K'` is a morphism of Lie
algebras. -/
def hom_of_le : K →ₗ⁅R⁆ K' :=
{ map_lie' := λ x y, rfl,
  ..submodule.of_le h }

@[simp] lemma coe_hom_of_le (x : K) : (hom_of_le h x : L) = x := rfl

lemma hom_of_le_apply (x : K) : hom_of_le h x = ⟨x.1, h x.2⟩ := rfl

lemma hom_of_le_injective : function.injective (hom_of_le h) :=
λ x y, by simp only [hom_of_le_apply, imp_self, subtype.mk_eq_mk, set_like.coe_eq_coe,
  subtype.val_eq_coe]

/-- Given two nested Lie subalgebras `K ⊆ K'`, we can view `K` as a Lie subalgebra of `K'`,
regarded as Lie algebra in its own right. -/
def of_le : lie_subalgebra R K' := (hom_of_le h).range

@[simp] lemma mem_of_le (x : K') : x ∈ of_le h ↔ (x : L) ∈ K :=
begin
  simp only [of_le, hom_of_le_apply, lie_hom.mem_range],
  split,
  { rintros ⟨y, rfl⟩, exact y.property, },
  { intros h, use ⟨(x : L), h⟩, simp, },
end

lemma of_le_eq_comap_incl : of_le h = K.comap K'.incl :=
by { ext, rw mem_of_le, refl, }

@[simp] lemma coe_of_le : (of_le h : submodule R K') = (submodule.of_le h).range := rfl

/-- Given nested Lie subalgebras `K ⊆ K'`, there is a natural equivalence from `K` to its image in
`K'`.  -/
noncomputable def equiv_of_le : K ≃ₗ⁅R⁆ of_le h :=
(hom_of_le h).equiv_range_of_injective (hom_of_le_injective h)

@[simp]

end nested_subalgebras

lemma map_le_iff_le_comap {K : lie_subalgebra R L} {K' : lie_subalgebra R L₂} :
  map f K ≤ K' ↔ K ≤ comap f K' := set.image_subset_iff

lemma gc_map_comap : galois_connection (map f) (comap f) := λ K K', map_le_iff_le_comap

end lattice_structure

section lie_span

variables (R L) (s : set L)

/-- The Lie subalgebra of a Lie algebra `L` generated by a subset `s ⊆ L`. -/
def lie_span : lie_subalgebra R L := Inf {N | s ⊆ N}

variables {R L s}

lemma mem_lie_span {x : L} : x ∈ lie_span R L s ↔ ∀ K : lie_subalgebra R L, s ⊆ K → x ∈ K :=
by { change x ∈ (lie_span R L s : set L) ↔ _, erw Inf_coe, exact set.mem_Inter₂, }

lemma subset_lie_span : s ⊆ lie_span R L s :=
by { intros m hm, erw mem_lie_span, intros K hK, exact hK hm, }

lemma submodule_span_le_lie_span : submodule.span R s ≤ lie_span R L s :=
by { rw submodule.span_le, apply subset_lie_span, }

lemma lie_span_le {K} : lie_span R L s ≤ K ↔ s ⊆ K :=
begin
  split,
  { exact set.subset.trans subset_lie_span, },
  { intros hs m hm, rw mem_lie_span at hm, exact hm _ hs, },
end

lemma lie_span_mono {t : set L} (h : s ⊆ t) : lie_span R L s ≤ lie_span R L t :=
by { rw lie_span_le, exact set.subset.trans h subset_lie_span, }

lemma lie_span_eq : lie_span R L (K : set L) = K :=
le_antisymm (lie_span_le.mpr rfl.subset) subset_lie_span

lemma coe_lie_span_submodule_eq_iff {p : submodule R L} :
  (lie_span R L (p : set L) : submodule R L) = p ↔ ∃ (K : lie_subalgebra R L), ↑K = p :=
begin
  rw p.exists_lie_subalgebra_coe_eq_iff, split; intros h,
  { intros x m hm, rw [← h, mem_coe_submodule], exact lie_mem _ (subset_lie_span hm), },
  { rw [← coe_to_submodule_mk p h, coe_to_submodule, coe_to_submodule_eq_iff, lie_span_eq], },
end

variables (R L)

/-- `lie_span` forms a Galois insertion with the coercion from `lie_subalgebra` to `set`. -/
protected def gi : galois_insertion (lie_span R L : set L → lie_subalgebra R L) coe :=
{ choice    := λ s _, lie_span R L s,
  gc        := λ s t, lie_span_le,
  le_l_u    := λ s, subset_lie_span,
  choice_eq := λ s h, rfl }

@[simp] lemma span_empty : lie_span R L (∅ : set L) = ⊥ :=
(lie_subalgebra.gi R L).gc.l_bot

@[simp] lemma span_univ : lie_span R L (set.univ : set L) = ⊤ :=
eq_top_iff.2 $ set_like.le_def.2 $ subset_lie_span

variables {L}

lemma span_union (s t : set L) : lie_span R L (s ∪ t) = lie_span R L s ⊔ lie_span R L t :=
(lie_subalgebra.gi R L).gc.l_sup

lemma span_Union {ι} (s : ι → set L) : lie_span R L (⋃ i, s i) = ⨆ i, lie_span R L (s i) :=
(lie_subalgebra.gi R L).gc.l_supr

end lie_span

end lie_subalgebra

end lie_subalgebra

namespace lie_equiv

variables {R : Type u} {L₁ : Type v} {L₂ : Type w}
variables [comm_ring R] [lie_ring L₁] [lie_ring L₂] [lie_algebra R L₁] [lie_algebra R L₂]

/-- An injective Lie algebra morphism is an equivalence onto its range. -/
noncomputable def of_injective (f : L₁ →ₗ⁅R⁆ L₂) (h : function.injective f) :
  L₁ ≃ₗ⁅R⁆ f.range :=
{ map_lie' := λ x y, by { apply set_coe.ext, simpa },
  .. linear_equiv.of_injective (f : L₁ →ₗ[R] L₂) $ by rwa [lie_hom.coe_to_linear_map] }

@[simp] lemma of_injective_apply (f : L₁ →ₗ⁅R⁆ L₂) (h : function.injective f) (x : L₁) :
  ↑(of_injective f h x) = f x := rfl

variables (L₁' L₁'' : lie_subalgebra R L₁) (L₂' : lie_subalgebra R L₂)

/-- Lie subalgebras that are equal as sets are equivalent as Lie algebras. -/
def of_eq (h : (L₁' : set L₁) = L₁'') : L₁' ≃ₗ⁅R⁆ L₁'' :=
{ map_lie' := λ x y, by { apply set_coe.ext, simp, },
  ..(linear_equiv.of_eq ↑L₁' ↑L₁''
      (by {ext x, change x ∈ (L₁' : set L₁) ↔ x ∈ (L₁'' : set L₁), rw h, } )) }

@[simp] lemma of_eq_apply (L L' : lie_subalgebra R L₁) (h : (L : set L₁) = L') (x : L) :
  (↑(of_eq L L' h x) : L₁) = x := rfl

variables (e : L₁ ≃ₗ⁅R⁆ L₂)

/-- An equivalence of Lie algebras restricts to an equivalence from any Lie subalgebra onto its
image. -/
def lie_subalgebra_map : L₁'' ≃ₗ⁅R⁆ (L₁''.map e : lie_subalgebra R L₂) :=
{ map_lie' := λ x y, by { apply set_coe.ext, exact lie_hom.map_lie (↑e : L₁ →ₗ⁅R⁆ L₂) ↑x ↑y, }
  ..(linear_equiv.submodule_map (e : L₁ ≃ₗ[R] L₂) ↑L₁'') }

@[simp] lemma lie_subalgebra_map_apply (x : L₁'') : ↑(e.lie_subalgebra_map _  x) = e x := rfl

/-- An equivalence of Lie algebras restricts to an equivalence from any Lie subalgebra onto its
image. -/
def of_subalgebras (h : L₁'.map ↑e = L₂') : L₁' ≃ₗ⁅R⁆ L₂' :=
{ map_lie' := λ x y, by { apply set_coe.ext, exact lie_hom.map_lie (↑e : L₁ →ₗ⁅R⁆ L₂) ↑x ↑y, },
  ..(linear_equiv.of_submodules (e : L₁ ≃ₗ[R] L₂) ↑L₁' ↑L₂' (by { rw ←h, refl, })) }

@[simp] lemma of_subalgebras_apply (h : L₁'.map ↑e = L₂') (x : L₁') :
  ↑(e.of_subalgebras _ _ h x) = e x := rfl

@[simp] lemma of_subalgebras_symm_apply (h : L₁'.map ↑e = L₂') (x : L₂') :
  ↑((e.of_subalgebras _ _ h).symm x) = e.symm x := rfl

end lie_equiv


import data.real.basic
import data.real.cau_seq
import computability.halting
import computability.partrec_code
import computability.primrec
import data.nat.gcd
import data.int.cast
import data.equiv.encodable.basic
open_locale classical

def nnseqR := {u : ℕ → ℝ // ∀ (n : ℕ), u n ≥ 0}
def nnseqQ := {u : ℕ → ℚ // ∀ (n : ℕ), u n ≥ 0}

def RoC (φ: ℕ  → ℕ ) (α : nnseqR) := ∀ k > (0 : ℕ ), ∀ n m ≥ φ k , abs((α.1 m) - (α.1 n)) < (1/k)

def temp: ∀ ε>(0:ℝ), ∃ k > (0: ℕ ) , (1/k :ℝ) < ε:=
begin
intros,
use  nat.ceil(1 / ε) + 1,
have h₁: (1/ε)< nat.ceil(1 / ε) + 1,
  calc (1/ε) ≤ nat.ceil(1 / ε): by exact nat.le_ceil (1/ε)
  ... < nat.ceil(1 / ε) + 1: by exact lt_add_one (nat.ceil(1 / ε)),
have h₂ : 0 < (nat.ceil(1 / ε):ℝ ) + 1,
  calc 0 < (1/ε) :by exact one_div_pos.mpr H
  ... < nat.ceil(1 / ε) + 1 : by exact h₁,
simp at h₁,
split,
norm_num,
simp,
exact inv_lt_of_inv_lt H h₁,
end
def tempQ: ∀ ε>(0:ℚ), ∃ k > (0: ℕ ) , (1/k :ℚ) < ε:=
begin
intros,
use  nat.ceil(1 / ε) + 1,
have h₁: (1/ε) < (nat.ceil(1 / ε):ℚ) + 1,
  calc (1/ε) ≤ nat.ceil(1 / ε): by exact nat.le_ceil (1/ε)
  ... < nat.ceil(1 / ε) + 1: by exact lt_add_one (nat.ceil(1 / ε)),
have h₂ : 0 < (nat.ceil(1 / ε):ℚ)  + 1,
  calc 0 < (1/ε) :by exact one_div_pos.mpr H
  ... < nat.ceil(1 / ε) + 1 : by exact h₁,
simp at h₁,
split,
norm_num,
simp,
exact inv_lt_of_inv_lt H h₁,
end

def RoM (φ: ℕ → (ℕ → ℕ) → ℕ )(α : nnseqR) := ∀ k > (0 : ℕ), ∀ (g: ℕ → ℕ), ∃ n <φ k g, ∀ i ∈  {i :ℕ  | i ≥  n ∧ i ≤  (n  + (g n))}, ∀ j ∈  {i :ℕ  | i ≥  n ∧ i ≤  (n  + (g n))} , abs((α.1 i) - (α.1 j)) < (1/k)

theorem RoC_implies_cauchy {α : nnseqR} (h: ∃ (φ: ℕ → ℕ ), RoC φ α) : (is_cau_seq abs α.1) :=
begin
intros ε h₁,
cases h with φ h₂,
have h₄ :∃ k > (0 : ℕ) , (1/k :ℝ) < ε,
exact temp ε h₁,
cases h₄ with k h₅,
cases h₅ with h₆ h₇,
use φ k,
specialize h₂ k h₆ (φ k),
intros j h₃,
have h₈ : |α.val j - α.val (φ k)| < (1/k),
exact h₂ j (by norm_num) h₃,
calc |α.val j - α.val (φ k)| < (1/k) : by exact h₈
... < ε : by exact h₇,
end

theorem RoM_implies_cauchy {α : nnseqR} (h: ∃ (φ: ℕ  → (ℕ → ℕ) → ℕ ), RoM φ α) : (is_cau_seq abs α.1) :=
begin
intros ε h₁,
cases h with φ h₂,
intros,
by_contradiction h₃,
push_neg at h₃,
cases classical.axiom_of_choice h₃ with f h₄,
let g : ℕ → ℕ  := λ x, f x - x,
have h₅ :∃ k > (0 : ℕ) , (1/k :ℝ) < ε,
exact temp ε h₁,
cases h₅ with k h₆,
cases h₆ with h₇ q,
specialize h₂ k h₇ g,
cases h₂ with n h₅,
cases h₅ with h₆ h₇,
have h₈ : n ∈  {i :ℕ  | i ≥  n ∧ i ≤  (n  + (g n))},
simp,
have h₉ : f n ∈  {i :ℕ  | i ≥  n ∧ i ≤  (n  + (g n))},
simp,
split,
exact (h₄ n).1,
rw ←  nat.add_sub_assoc (h₄ n).1,
rw add_comm n (f n),
rw nat.add_sub_assoc,
simp,
specialize h₇ n h₈ (f n) h₉,
specialize h₄ n,
rw abs_sub_comm at h₇,
have p : ¬ |α.val (f n) - α.val n| < ε,
push_neg,
exact h₄.2,
have p :|α.val (f n) - α.val n| < ε,
calc |α.val (f n) - α.val n| < 1 / ↑k : by exact h₇
... < ε : by exact q,
contradiction,
end

open computable part nat.partrec (code) nat.partrec.code

def  s_prop(n :ℕ ) : ℕ → Prop:= (λ (m : ℕ),
       m ≤ n ∧
         (∃ (x : ℕ), evaln n (of_nat_code m) 0 = some x) ∧
           ∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code m) 0 = some w)

@[instance] def s_decideable (n :ℕ) :decidable_pred (s_prop n) :=
begin
unfold decidable_pred,
intros,
have h₁: decidable (a ≤ n),
exact nat.decidable_le a n,
have h₂ : ∀ o : option ℕ, decidable( ∃ x, o = some x),
--exact option.decidable_forall_mem,
intros,
apply option.rec_on o, simp,
exact decidable.false, intros, simp, exact decidable.true,
specialize h₂ (evaln n (of_nat_code a) 0),
have h₃ : decidable(∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code a) 0 = some w),
let P : fin n → Prop := λ l, ∀ (w : ℕ), ¬evaln l (of_nat_code a) 0 = some w,
have h₄ : decidable_pred P,
unfold decidable_pred,
intros l,
simp[P],
have h₅ : ∀ o : option ℕ, decidable( ∀ (w : ℕ), ¬ o =some w),
intros,
apply option.rec_on o, simp, exact decidable.true, intros, simp,
have p₁: ¬ ∀ (w : ℕ), ¬val = w,
push_neg, use val, exact is_false p₁,
exact h₅ (evaln l (of_nat_code a) 0),
have h₆ : decidable(∀ l : fin n, P l),
exact @nat.decidable_forall_fin n P h₄,
simp[P] at h₆,
dsimp[ fin] at h₆,
have h₇: ∀ Q : ℕ → Prop, (∀ l : fin n, Q l) ↔ (∀ l < n, Q l),
intros,split,intros Q₁ l Q₂, exact Q₁ ⟨ l, Q₂⟩, intros Q₁ l, exact Q₁ l.1 l.2,
specialize h₇ (λl, ∀ (w : ℕ), ¬evaln l (of_nat_code a) 0 = some w), simp at h₇,
exact  decidable_of_decidable_of_iff h₆ h₇,
have h₈ : decidable ((∃ x, (evaln n (of_nat_code a) 0) = some x) ∧  (∀ l < n,  ∀ w, ¬ (evaln l (of_nat_code a) 0) = some w)),
exact @and.decidable (∃ x, (evaln n (of_nat_code a) 0) = some x)  (∀ l < n,  ∀ w, ¬ (evaln l (of_nat_code a) 0) = some w) h₂ h₃,
exact @and.decidable (a ≤ n) ((∃ x, (evaln n (of_nat_code a) 0) = some x) ∧ ∀ l < n,  ∀ w, ¬ (evaln l (of_nat_code a) 0) = some w) h₁ h₈,

end

@[instance] def s_exist_decidable (n : ℕ ): decidable (∃ (m : ℕ), s_prop n m):=
begin
unfold s_prop,
let P : ℕ → Prop:= λ m, (∃ (x : ℕ), evaln n (of_nat_code m) 0 = some x) ∧ ∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code m) 0 = some w,
have h₁ : decidable_pred P,
unfold decidable_pred,
intros,
simp[P],
have h₂ : ∀ o : option ℕ, decidable( ∃ x, o = some x),
intros,
apply option.rec_on o, simp,
exact decidable.false, intros, simp, exact decidable.true,
specialize h₂ (evaln n (of_nat_code a) 0),
have h₃ : decidable(∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code a) 0 = some w),
let P : fin n → Prop := λ l, ∀ (w : ℕ), ¬evaln l (of_nat_code a) 0 = some w,
have h₄ : decidable_pred P,
unfold decidable_pred,
intros l,
simp[P],
have h₅ : ∀ o : option ℕ, decidable( ∀ (w : ℕ), ¬ o =some w),
intros,
apply option.rec_on o, simp, exact decidable.true, intros, simp,
have p₁: ¬ ∀ (w : ℕ), ¬val = w,
push_neg, use val, exact is_false p₁,
exact h₅ (evaln l (of_nat_code a) 0),
have h₆ : decidable(∀ l : fin n, P l),
exact @nat.decidable_forall_fin n P h₄,
simp[P] at h₆,
dsimp[ fin] at h₆,
have h₇: ∀ Q : ℕ → Prop, (∀ l : fin n, Q l) ↔ (∀ l < n, Q l),
intros,split,intros Q₁ l Q₂, exact Q₁ ⟨ l, Q₂⟩, intros Q₁ l, exact Q₁ l.1 l.2,
specialize h₇ (λl, ∀ (w : ℕ), ¬evaln l (of_nat_code a) 0 = some w), simp at h₇,
exact  decidable_of_decidable_of_iff h₆ h₇,
have h₈ : decidable ((∃ x, (evaln n (of_nat_code a) 0) = some x) ∧  (∀ l < n,  ∀ w, ¬ (evaln l (of_nat_code a) 0) = some w)),
exact @and.decidable (∃ x, (evaln n (of_nat_code a) 0) = some x)  (∀ l < n,  ∀ w, ¬ (evaln l (of_nat_code a) 0) = some w) h₂ h₃,
exact h₈,
have h₂ : decidable_pred(λx, ∃ (m : ℕ), m < x ∧ P m ),
exact @nat.decidable_exists_lt P h₁,
simp[decidable_pred] at h₂, specialize h₂ (n+1), simp[P] at h₂,
have h₃ : (∃ m , m < (n + 1) ∧ (∃ (x : ℕ), evaln n (of_nat_code m) 0 = some x) ∧
∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code m) 0 = some w) ↔
(∃ (m : ℕ), m ≤ n  ∧ (∃ (x : ℕ), evaln n (of_nat_code m) 0 = some x) ∧
∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code m) 0 = some w),
split, intro H, cases H with m H, use m, split, rw ← nat.lt_add_one_iff, exact H.1, exact H.2,
intro H, cases H with m H, use m, split, rw  nat.lt_add_one_iff, exact H.1, exact H.2,
exact  decidable_of_decidable_of_iff h₂ h₃,
end
def Specker_seq (α: nnseqR):= ∀ φ: ℕ → ℕ, (RoC φ α) → ¬ computable(φ)
@[reducible]
def s (α: nnseqQ): ℕ → ℚ :=
λ n, if h: ∃ m : ℕ, s_prop n m then α.1 (nat.find h) else 0

theorem s_converges (α: nnseqQ)(h₁ : ∀ n m, n < m → α.1 n > α.1 m)(h₂: ∀ ε > (0 :ℝ), ∃ N : ℕ, ∀n≥N, (α.1 n: ℝ) < ε ): ∀ ε > (0 :ℝ), ∃ N : ℕ, ∀n≥N, (s α n : ℝ) < ε :=
begin
intros,
specialize h₂ ε H ,
cases h₂  with N h₃,
by_cases ∃ i < N, ∃ x,  x ∈ (eval (of_nat_code i) 0),
cases h with i h₄, cases h₄ with  h₄ h₅,
let S := {j ∈ finset.range N | ∃ x, x ∈ (eval ( of_nat_code j) 0)},
have p₁: finset.nonempty S,
unfold finset.nonempty,use i,simp[S],split,exact h₄,exact h₅,
let f : ℕ → ℕ := λj, if r : ∃ k: ℕ,  ∃ x, x ∈ (evaln k (of_nat_code j) 0) then (nat.find r) else 0,let S₁ := S.image f,
have p₂: finset.nonempty S₁,
simp,exact p₁,
have p₃ : ∃ x, x ∈ S₁.max,
exact finset.max_of_nonempty p₂,
cases p₃ with k k_h,
use k + 1,
intros,
unfold s,
split_ifs,
swap, simp,
exact H,
let z := nat.find h,
have p₄ : N ≤ z,
by_contradiction q,
push_neg at q,
have p₅ : z ∈ S,
simp[S],
split,
use z,
split,
exact q,
exact nat.find_spec h,
have h' : z ≤ n ∧  (∃ (x : ℕ), evaln n (of_nat_code z) 0 = some x) ∧ ∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code z) 0 = some w,
exact nat.find_spec h,
cases h' with bounded h',
cases h' with h'₁ h'₂,
cases h'₁ with x h'₁,
use x,
have h''₁ : ∃ k, x ∈ evaln k (of_nat_code z) 0,
use n,
exact h'₁,
rw evaln_complete,
exact h''₁,
have p₆ : f z ∈ S₁,
simp[S₁],
use z,
split,
exact p₅, simp,
have p₇: f z ≤ k,
exact finset.le_max_of_mem p₆ k_h,
have p₈ : n ≤ f z,
by_contradiction q₁,
push_neg at q₁,
have h' : z ≤ n ∧ (∃ (x : ℕ), evaln n (of_nat_code z) 0 = some x) ∧ ∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code z) 0 = some w,
exact nat.find_spec h,
cases h' with bounded h',
have h'₁ :  ∀(l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code z) 0 = some w,
exact h'.2,
specialize h'₁ (f z),
have q₂ :∃ (w : ℕ), evaln (f z) (of_nat_code z) 0 = some w,
simp[f],
split_ifs,
have h_1': ∃ (a_2 : ℕ), evaln (nat.find h_1) (of_nat_code z) 0 = some a_2,
exact nat.find_spec h_1,
exact h_1',
have h_1_contra : ∃ (a a_1 : ℕ), evaln a (of_nat_code z) 0 = some a_1,
use n, exact h'.1,
contradiction,
have h'₁_contra : ¬ ∃ (w : ℕ), evaln (f z) (of_nat_code z) 0 = some w,
push_neg,
exact h'₁ q₁,
contradiction,
have q₃ : k + 1 ≤ k,
calc k + 1 ≤ n : by exact H_1
... ≤ f z : by exact p₈
... ≤ k : by exact p₇,
have q₃' : ¬  k + 1 ≤ k,
push_neg,
exact lt_add_one k,
contradiction,
exact h₃ z p₄,
push_neg at h,
use 0,
intros,
unfold s,
split_ifs,
swap,simp, exact H,
let z := nat.find h_1,
have h_1' :  z ≤ n ∧ (∃ (x : ℕ), evaln n (of_nat_code z) 0 = some x) ∧ ∀ (l : ℕ), l < n → ∀ (w : ℕ), ¬evaln l (of_nat_code z) 0 = some w,
exact nat.find_spec h_1,
have q : ¬ z < N,
by_contradiction q,
specialize h z,
have q₁ :∀ (x : ℕ), ¬  x ∈ eval (of_nat_code z) 0 ,
exact h q,
have q₂ : ∃ (x : ℕ), evaln n (of_nat_code z) 0 = some x,
exact h_1'.2.1,
cases q₂ with x q₂,
specialize q₁ x,
have q₃ : x ∈ evaln n (of_nat_code z) 0,
simp,
exact q₂,
have q₃': ∃ k, x ∈ evaln k (of_nat_code z) 0,
use n, exact q₃,
rw ← evaln_complete at q₃',
contradiction,
push_neg at q,
exact h₃ z q,

end

theorem bound (n: ℕ) {P : ℕ → Prop} [decidable_pred P] (hP: primrec_pred P):
primrec_pred(λ x :ℕ , ∀ x ≤ n, P x):=
begin
unfold primrec_pred,

end

 --def coprime_prim: ∀ n : ℕ , primrec_pred(λ d, n.coprime d):=

instance : primcodable ℚ := primcodable.of_equiv (Σ n : ℤ, {d : ℕ // 0 < d ∧ n.nat_abs.coprime d})
  ⟨λ ⟨a, b, c, d⟩, ⟨a, b, c, d⟩, λ⟨a, b, c, d⟩, ⟨a, b, c, d⟩,
   λ ⟨a, b, c, d⟩, rfl, λ⟨a, b, c, d⟩, rfl⟩

instance PrimcodeQ : primcodable ℚ:= sorry

theorem s_specker (α: nnseqQ)(h₀: computable α.1)(h₁ : ∀ n m, n < m → α.1 n > α.1 m)(h₂: ∀ ε > (0 :ℝ), ∃ N : ℕ, ∀n≥N, (α.1 n :ℝ) < ε ):
 ∀ φ: ℚ → ℕ, (∀ ε  > (0 : ℚ), ∀ n > φ ε , ((s α) n) < ε ) → ¬ computable(φ) :=
 begin
 intros φ h₃,
 by_contradiction,
 have h₄ : ∀ n, α.1 n > 0,
intros,
by_contradiction p,
push_neg at p,
have p₁: α.1 (n + 1) < 0,
calc α.1 (n + 1) < α.1 n : by exact h₁ n (n+1) (lt_add_one n)
...  ≤ 0 : by exact p,
have p₂ : ¬ α.1 (n + 1) < 0,
push_neg,
exact (α.2(n +1)),
contradiction,
--have h₅: ∀ n, ∃ k > (0: ℕ ) , (1/k :ℚ) < α.1 n,
--intro, exact tempQ (α.1 n) (h₄ n),
--let r := λn, nat.find (h₅ n),
let max_halt: ℕ → ℕ  := λ n, max_default n (φ (α.1 (n + 1))),
have h₆ : ∀ n, (∃ x, x ∈ evaln (max_halt n) (of_nat_code n) 0) ↔ (∃ x, x ∈ eval (of_nat_code n) 0),
intros n, split,swap, intro p₁,
cases p₁ with x,
have p₂ : ∃ k, x ∈ evaln k (of_nat_code n) 0,
rw ←  evaln_complete, exact p₁_h,
have p₂': ∃ k, ∃ x, x ∈ evaln k (of_nat_code n) 0,
cases p₂ with k, use k, use x, exact p₂_h,
let k:= nat.find p₂',
have p₃ : k ≤ max_halt n,
by_contradiction p₃, push_neg at p₃,
have p₄: n ≤ max_halt n,
simp[max_halt], unfold max_default, split_ifs, simp, simp at h_1, exact le_of_lt h_1,
have p₅: n < k,
calc n ≤ max_halt n : by exact p₄
... < k: by exact p₃,
have p₆:s_prop k n,
unfold s_prop,split,exact le_of_lt p₅,split, exact nat.find_spec p₂',
intro,
have min: l < k → ¬∃(w : ℕ),evaln l (of_nat_code n) 0 = some w,
exact nat.find_min p₂',push_neg at min, exact min,
have p₇: s α k ≥ α.1 n,
unfold s, split_ifs,
have p₈: nat.find h_1 ≤ n, exact nat.find_min' h_1 p₆,
have p₈': nat.find h_1 < n ∨ nat.find h_1 = n,
exact lt_or_eq_of_le p₈, cases p₈',
exact le_of_lt (h₁ (nat.find h_1) n p₈'), exact (congr_arg α.val p₈').ge,
push_neg at h_1,specialize h_1 n, contradiction,
have p₈ : α.val n > α.val (n + 1),
exact h₁ n (n+1) (lt_add_one n),
have p₉ : s α k > α.val (n + 1),
calc s α k ≥ α.1 n : by exact p₇
... > α.val (n + 1) : by exact p₈,
have q₁ : φ (α.1 (n + 1)) ≤ max_halt n,
simp[max_halt], unfold max_default, split_ifs, exact  h_1, simp,
have q₂:  φ (α.1 (n + 1)) < k,
calc φ (α.1 (n + 1)) ≤ max_halt n : by exact q₁
...< k : by exact p₃,
rw ← gt_iff_lt at q₂,
have h₉': s α k < α.val (n + 1),
exact h₃ (α.1 (n+1)) (h₄ (n + 1)) k q₂,
have h₉'': ¬ s α k < α.val (n + 1),
push_neg, exact le_of_lt p₉, contradiction,
have spec: ∃ x, x ∈ evaln k (of_nat_code n) 0,
exact nat.find_spec p₂',
cases spec with x,
use x, exact evaln_mono p₃ spec_h,
intro h₅,cases h₅ with x,
use x,
have h₆ : ∃ k, x ∈ evaln k (of_nat_code n) 0,
use (max_halt n), exact h₅_h,
rw evaln_complete, exact h₆,
have p₁ : computable (λ n, φ ( α.1 (n+1))),
exact computable.comp h (computable.comp h₀ computable.succ),
have p₂ : computable(λn, max_halt n),
simp[max_halt], exact computable₂.comp primrec.nat_max.to_comp computable.id p₁,
have p₃ : computable(λ n, of_nat_code n),
rw ← of_nat_code_eq, exact computable.of_nat code,
let evalnmap:= λ (a : (ℕ × code) × ℕ), evaln a.1.1 a.1.2 a.2,
have p₄ : computable(evalnmap),
exact evaln_prim.to_comp,
let evalnmap':= λ (a : ℕ × code) , evalnmap (⟨ a, 0⟩),
have p₅ : computable(evalnmap'),
exact computable.comp p₄ (computable.pair computable.id (primrec.to_comp (primrec₂.const 0))),
let E:= λ n, evalnmap' (((max_halt n), (of_nat_code n))),
have p₆ : computable E,
simp[E], exact computable.comp p₅ (computable.pair p₂ p₃),
simp[E] at p₆,simp[evalnmap'] at p₆, simp[evalnmap] at p₆, simp at p₆,
have p₇ : computable_pred (λ n, option.is_some (evaln (max_halt n) (of_nat_code n) 0)),
simp[computable_pred],
refine ⟨by apply_instance, _⟩,
exact computable.comp primrec.option_is_some.to_comp p₆,
have p₈ : ∀ n,option.is_some (evaln (max_halt n) (of_nat_code n) 0) ↔ (∃ x, x ∈ evaln (max_halt n) (of_nat_code n) 0) ,
intros,exact option.is_some_iff_exists,
have p₉ : computable_pred(λn, ∃ x, x ∈ evaln (max_halt n) (of_nat_code n) 0),
exact computable_pred.of_eq p₇ p₈,
have q₁: computable_pred(λ n, ∃ (x : ℕ), x ∈ (of_nat_code n).eval 0),
exact computable_pred.of_eq p₉ h₆,
have q₂ : ∀ n ,(∃ (x : ℕ), x ∈ (of_nat_code n).eval 0) ↔ ((of_nat_code n).eval 0).dom,
intros, rw ←  dom_iff_mem,
have q₃ : computable_pred( λ n, ((of_nat_code n).eval 0).dom),
exact computable_pred.of_eq q₁ q₂,
have q₄ : computable_pred(λ c : code, ((eval (of_nat_code (encode_code c))) 0).dom),
casesI q₃,
refine ⟨by apply_instance, _⟩,
rw ← encode_code_eq,
exact computable.comp q₃_h computable.encode,
rw ← encode_code_eq at q₄,rw ← of_nat_code_eq at q₄, simp at q₄,
exact (computable_pred.halting_problem 0) q₄,
end


import tactic --hide

/-
If you're sad that the game is over, here is some bonus content to keep you going.
-/

/-Lemma
A long chain of implications.
-/
lemma lemma_6 (P Q R S T : Prop) : (P → R) → (S → Q) → (R → T) → (Q → R) → S → T :=
begin
  intros hPR hSQ hRT hQR hS,
  apply hRT,
  apply hQR,
  apply hSQ,
  exact hS,

end