/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.eq_to_hom
import Mathlib.PostPort

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

namespace Mathlib

namespace category_theory

/--
`prod C D` gives the cartesian product of two categories.

See https://stacks.math.columbia.edu/tag/001K.
-/
protected instance prod (C : Type u₁) [category C] (D : Type u₂) [category D] : category (C × D) :=
  category.mk

-- rfl lemmas for category.prod

@[simp] theorem prod_id (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C) (Y : D) :
    𝟙 = (𝟙, 𝟙) :=
  rfl

@[simp] theorem prod_comp (C : Type u₁) [category C] (D : Type u₂) [category D] {P : C} {Q : C}
    {R : C} {S : D} {T : D} {U : D} (f : (P, S) ⟶ (Q, T)) (g : (Q, T) ⟶ (R, U)) :
    f ≫ g = (prod.fst f ≫ prod.fst g, prod.snd f ≫ prod.snd g) :=
  rfl

@[simp] theorem prod_id_fst (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) :
    prod.fst 𝟙 = 𝟙 :=
  rfl

@[simp] theorem prod_id_snd (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) :
    prod.snd 𝟙 = 𝟙 :=
  rfl

@[simp] theorem prod_comp_fst (C : Type u₁) [category C] (D : Type u₂) [category D] {X : C × D}
    {Y : C × D} {Z : C × D} (f : X ⟶ Y) (g : Y ⟶ Z) : prod.fst (f ≫ g) = prod.fst f ≫ prod.fst g :=
  rfl

@[simp] theorem prod_comp_snd (C : Type u₁) [category C] (D : Type u₂) [category D] {X : C × D}
    {Y : C × D} {Z : C × D} (f : X ⟶ Y) (g : Y ⟶ Z) : prod.snd (f ≫ g) = prod.snd f ≫ prod.snd g :=
  rfl

/--
`prod.category.uniform C D` is an additional instance specialised so both factors have the same
universe levels. This helps typeclass resolution.
-/
protected instance uniform_prod (C : Type u₁) [category C] (D : Type u₁) [category D] :
    category (C × D) :=
  category_theory.prod C D

-- Next we define the natural functors into and out of product categories. For now this doesn't

-- address the universal properties.

namespace prod

/-- `sectl C Z` is the functor `C ⥤ C × D` given by `X ↦ (X, Z)`. -/
@[simp] theorem sectl_obj (C : Type u₁) [category C] {D : Type u₂} [category D] (Z : D) (X : C) :
    functor.obj (sectl C Z) X = (X, Z) :=
  Eq.refl (functor.obj (sectl C Z) X)

/-- `sectr Z D` is the functor `D ⥤ C × D` given by `Y ↦ (Z, Y)` . -/
def sectr {C : Type u₁} [category C] (Z : C) (D : Type u₂) [category D] : D ⥤ C × D :=
  functor.mk (fun (X : D) => (Z, X)) fun (X Y : D) (f : X ⟶ Y) => (𝟙, f)

/-- `fst` is the functor `(X, Y) ↦ X`. -/
@[simp] theorem fst_obj (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) :
    functor.obj (fst C D) X = prod.fst X :=
  Eq.refl (functor.obj (fst C D) X)

/-- `snd` is the functor `(X, Y) ↦ Y`. -/
@[simp] theorem snd_map (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D)
    (Y : C × D) (f : X ⟶ Y) : functor.map (snd C D) f = prod.snd f :=
  Eq.refl (functor.map (snd C D) f)

/-- The functor swapping the factors of a cartesian product of categories, `C × D ⥤ D × C`. -/
@[simp] theorem swap_map (C : Type u₁) [category C] (D : Type u₂) [category D] (_x : C × D) :
    ∀ (_x_1 : C × D) (f : _x ⟶ _x_1), functor.map (swap C D) f = (prod.snd f, prod.fst f) :=
  fun (_x_1 : C × D) (f : _x ⟶ _x_1) => Eq.refl (functor.map (swap C D) f)

/--
Swapping the factors of a cartesion product of categories twice is naturally isomorphic
to the identity functor.
-/
@[simp] theorem symmetry_hom_app (C : Type u₁) [category C] (D : Type u₂) [category D] (X : C × D) :
    nat_trans.app (iso.hom (symmetry C D)) X = 𝟙 :=
  Eq.refl (nat_trans.app (iso.hom (symmetry C D)) X)

/--
The equivalence, given by swapping factors, between `C × D` and `D × C`.
-/
@[simp] theorem braiding_counit_iso_inv_app (C : Type u₁) [category C] (D : Type u₂) [category D]
    (X : D × C) :
    nat_trans.app (iso.inv (equivalence.counit_iso (braiding C D))) X =
        inv (eq_to_hom (braiding._proof_3 C D X)) :=
  Eq.refl (inv (eq_to_hom (braiding._proof_3 C D X)))

protected instance swap_is_equivalence (C : Type u₁) [category C] (D : Type u₂) [category D] :
    is_equivalence (swap C D) :=
  is_equivalence.of_equivalence (braiding C D)

end prod

/--
The "evaluation at `X`" functor, such that
`(evaluation.obj X).obj F = F.obj X`,
which is functorial in both `X` and `F`.
-/
def evaluation (C : Type u₁) [category C] (D : Type u₂) [category D] : C ⥤ (C ⥤ D) ⥤ D :=
  functor.mk
    (fun (X : C) =>
      functor.mk (fun (F : C ⥤ D) => functor.obj F X)
        fun (F G : C ⥤ D) (α : F ⟶ G) => nat_trans.app α X)
    fun (X Y : C) (f : X ⟶ Y) => nat_trans.mk fun (F : C ⥤ D) => functor.map F f

/--
The "evaluation of `F` at `X`" functor,
as a functor `C × (C ⥤ D) ⥤ D`.
-/
@[simp] theorem evaluation_uncurried_obj (C : Type u₁) [category C] (D : Type u₂) [category D]
    (p : C × (C ⥤ D)) :
    functor.obj (evaluation_uncurried C D) p = functor.obj (prod.snd p) (prod.fst p) :=
  Eq.refl (functor.obj (evaluation_uncurried C D) p)

namespace functor

/-- The cartesian product of two functors. -/
@[simp] theorem prod_obj {A : Type u₁} [category A] {B : Type u₂} [category B] {C : Type u₃}
    [category C] {D : Type u₄} [category D] (F : A ⥤ B) (G : C ⥤ D) (X : A × C) :
    obj (prod F G) X = (obj F (prod.fst X), obj G (prod.snd X)) :=
  Eq.refl (obj (prod F G) X)

/- Because of limitations in Lean 3's handling of notations, we do not setup a notation `F × G`.
   You can use `F.prod G` as a "poor man's infix", or just write `functor.prod F G`. -/

end functor

namespace nat_trans

/-- The cartesian product of two natural transformations. -/
@[simp] theorem prod_app {A : Type u₁} [category A] {B : Type u₂} [category B] {C : Type u₃}
    [category C] {D : Type u₄} [category D] {F : A ⥤ B} {G : A ⥤ B} {H : C ⥤ D} {I : C ⥤ D}
    (α : F ⟶ G) (β : H ⟶ I) (X : A × C) :
    app (prod α β) X = (app α (prod.fst X), app β (prod.snd X)) :=
  Eq.refl (app (prod α β) X)

end Mathlib


import .size
open nnf list

namespace list
universes u v w

variables {α : Type u} {β : Type v} {γ : Type w}

theorem mapp {p : β → Prop} (f : α → β) : Π (l : list α) (h : ∀ x∈l, p (f x)) x, x ∈ list.map f l → p x
| [] h x := by simp
| (hd::tl) h x :=
begin
  intro hmem, cases hmem,
  {rw hmem, apply h, simp},
  {apply mapp tl, intros a ha, apply h, simp [ha], exact hmem}
end

theorem pmapp {p : β → Prop} {q : α → Prop} (f : Π a, q a → β)  : Π (l : list α)
(h : ∀ y (hy : q y) (h₁ : y ∈ l), p (f y hy))
(hf : ∀ y ∈ l, q y) x, x ∈ list.pmap f l hf → p x
| [] h hf x := by simp
| (hd::tl) h hf x :=
begin
  intro hmem,
  cases hmem,
  {rw hmem, apply h, simp},
  {apply pmapp tl, intros a ha hamem,
   apply h, simp [ha], right, exact hamem, exact hmem}
end

@[simp] def ne_empty_head : Π l : list α, l ≠ [] → α
| []       h := by contradiction
| (a :: l) h := a

theorem mem_pmap_of_mem {p : α → Prop} (f : Π a, p a → β) {a : α} {l : list α} (h : a ∈ l) (hf : ∀ y ∈ l, p y) :
f a (hf a h) ∈ pmap f l hf :=
begin
  induction l with b l' ih,
  {cases h},
  {rcases h with rfl | h,
    {exact or.inl rfl},
    {apply or.inr,
     have hpy : ∀ (y : α), y ∈ l' → p y,
       {intros y hy, apply hf, right, exact hy},
     have := ih h hpy, exact this}}
end

end list

@[simp] def unbox : list nnf → list nnf
| [] := []
| ((box φ) :: l) := φ :: unbox l
| (e :: l) := unbox l

theorem unbox_iff : Π {Γ φ}, box φ ∈ Γ ↔ φ ∈ unbox Γ
| [] φ := begin split, repeat {intro h, simpa using h} end
| (hd::tl) φ :=
begin
  split,
  { intro h, cases h₁ : hd,
    case nnf.box : ψ
    { dsimp [unbox], cases h,
       {left, rw h₁ at h, injection h},
       {right, exact (@unbox_iff tl φ).1 h} },
    all_goals
    { dsimp [unbox], cases h,
       {rw h₁ at h, contradiction},
       {exact (@unbox_iff tl φ).1 h} } },
  { intro h, cases h₁ : hd,
    case nnf.box : ψ
    { rw h₁ at h, dsimp [unbox] at h, cases h,
       {simp [h]}, {right, exact (@unbox_iff tl φ).2 h} },
    all_goals
    { rw h₁ at h, dsimp [unbox] at h, right, exact (@unbox_iff tl φ).2 h } }
end

theorem unbox_size_aux : Π {Γ}, node_size (unbox Γ) ≤ node_size Γ
| [] := by simp
| (hd::tl) :=
begin
  cases h : hd,
  case nnf.box : ψ
  { dsimp, apply add_le_add,
     { dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
       rw add_comm, apply nat.le_succ },
     { apply unbox_size_aux } },
  all_goals
  { dsimp, apply le_add_of_nonneg_of_le,
    { dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof], rw add_comm, apply nat.zero_le },
    { apply unbox_size_aux } }
end

@[simp] def rebox : list nnf → list nnf
| [] := []
| (hd::tl) := box hd :: rebox tl

theorem rebox_unbox_of_mem : Π {Γ} (h : ∀ {φ}, φ ∈ unbox Γ → box φ ∈ Γ), rebox (unbox Γ) ⊆ Γ
| [] h := by simp
| (hd::tl) h :=
begin
  cases hψ : hd,
  case nnf.box : φ {dsimp, simp [cons_subset_cons], apply subset_cons_of_subset, apply rebox_unbox_of_mem, simp [unbox_iff]},
  all_goals {dsimp, apply subset_cons_of_subset, apply rebox_unbox_of_mem, simp [unbox_iff]}
end

theorem unbox_rebox : Π {Γ}, unbox (rebox Γ) = Γ
| [] := by simp
| (hd::tl) := by simp [unbox_rebox]

-- Just that I don't want to say ∃ φ s.t. ...
def box_only_rebox : Π {Γ}, box_only (rebox Γ)
| [] := {no_var := by simp,
         no_neg := by simp,
         no_and := by simp,
         no_or  := by simp,
         no_dia := by simp}
| (hd::tl) :=
begin
  cases h : hd,
  all_goals {
  exact { no_var := begin
                      intros n h, cases h, contradiction,
                      apply (@box_only_rebox tl).no_var, assumption
                    end,
          no_neg := begin
                      intros n h, cases h, contradiction,
                      apply (@box_only_rebox tl).no_neg, assumption
                    end,
          no_and := begin
                      intros φ ψ h, cases h, contradiction,
                      apply (@box_only_rebox tl).no_and, assumption
                    end,
          no_or := begin
                     intros φ ψ h, cases h, contradiction,
                     apply (@box_only_rebox tl).no_or, assumption
                   end,
          no_dia := begin
                      intros φ h, cases h, contradiction,
                      apply (@box_only_rebox tl).no_dia, assumption
                    end} }
end

theorem rebox_iff : Π {φ Γ}, box φ ∈ rebox Γ ↔ φ ∈ Γ
| φ [] := by simp
| φ (hd::tl) :=
begin
  split,
  {intro h, cases h₁ : hd,
   all_goals { cases h,
               {left, rw ←h₁, injection h},
               {right,  have := (@rebox_iff φ tl).1, exact this h } }},
  {intro h, cases h₁ : hd,
   all_goals { dsimp, cases h,
               {left, rw ←h₁, rw h},
               {right, have := (@rebox_iff φ tl).2, exact this h } } }
end

@[simp] def undia : list nnf → list nnf
| [] := []
| ((dia φ) :: l) := φ :: undia l
| (e :: l) := undia l

theorem undia_iff : Π {Γ φ}, dia φ ∈ Γ ↔ φ ∈ undia Γ
| [] φ := begin split, repeat {intro h, simpa using h} end
| (hd::tl) φ :=
begin
  split,
  { intro h, cases h₁ : hd,
    case nnf.dia : ψ
    { dsimp [undia], cases h,
       {left, rw h₁ at h, injection h},
       {right, exact (@undia_iff tl φ).1 h} },
    all_goals
    { dsimp [undia], cases h,
       {rw h₁ at h, contradiction},
       {exact (@undia_iff tl φ).1 h} } },
  { intro h, cases h₁ : hd,
    case nnf.dia : ψ
    { rw h₁ at h, dsimp [undia] at h, cases h,
       {simp [h]}, {right, exact (@undia_iff tl φ).2 h} },
    all_goals
    { rw h₁ at h, dsimp [undia] at h, right, exact (@undia_iff tl φ).2 h } }
end

def get_contra : Π Γ : list nnf,
                 psum {p : nat // var p ∈ Γ ∧ neg p ∈ Γ}
                      (∀ n, var n ∈ Γ → neg n ∉ Γ)
| []             := psum.inr $ λ _ h, absurd h $ not_mem_nil _
| (hd :: tl)     :=
begin
  cases h : hd,
  case nnf.var : n
  {apply dite (neg n ∈ tl),
    {intro t,
     exact psum.inl ⟨n, ⟨mem_cons_self _ _, mem_cons_of_mem _ t⟩⟩},
    {intro e,
     cases (get_contra tl),
     {left, constructor, constructor,
     apply mem_cons_of_mem, exact val.2.1,
     apply mem_cons_of_mem, exact val.2.2},
     {right,
      intros m hm hin,
      by_cases eq : m=n,
      {apply e, cases hin, contradiction, rw ←eq, assumption},
      {cases hm, apply eq, injection hm, apply val, exact hm,
       cases hin, contradiction, assumption} } }
  },
  case nnf.neg : n
  { apply dite (var n ∈ tl),
    { intro t,
      exact psum.inl ⟨n, ⟨mem_cons_of_mem _ t, mem_cons_self _ _⟩⟩ },
    { intro e,
      cases (get_contra tl),
      {left, constructor, constructor,
      apply mem_cons_of_mem, exact val.2.1,
      apply mem_cons_of_mem, exact val.2.2 },
      { right,
        intros m hm hin,
        by_cases eq : m=n,
        { apply e, cases hm, contradiction, rw ←eq, assumption },
        { cases hin, apply eq, injection hin, apply val,
          swap, exact hin, cases hm, contradiction, assumption }
      }
    }
  },
  all_goals
  {
  cases (get_contra tl),
  { left, constructor, constructor,
    apply mem_cons_of_mem, exact val.2.1,
    apply mem_cons_of_mem, exact val.2.2  },
  { right,
    intros m hm hin,
    {apply val, swap 3, exact m,
    cases hm, contradiction, assumption,
    cases hin, contradiction, assumption} }
  }
end

def get_contra_seqt : Π Γ : sseqt,
                 psum {p : nat // var p ∈ Γ.m ∧ neg p ∈ Γ.m}
                      (∀ n, var n ∈ Γ.m → neg n ∉ Γ.m)
:= λ Γ, get_contra Γ.m

def get_and : Π Γ : list nnf,
              psum {p : nnf × nnf // and p.1 p.2 ∈ Γ}
                   (∀ φ ψ, nnf.and φ ψ ∉ Γ)
| []               := psum.inr $ λ _ _, not_mem_nil _
| (hd :: tl)       :=
begin
  cases h : hd,
  case nnf.and : φ ψ { left, constructor,swap,
                       constructor, exact φ, exact ψ, simp
                     },
  all_goals
  { cases (get_and tl),
    {left,
    constructor,
    apply mem_cons_of_mem,
    exact val.2},
    {right, intros γ ψ h,
     cases h, contradiction,
    apply val, assumption }
  }
end

def get_and_seqt : Π Γ : sseqt,
              psum {p : nnf × nnf // and p.1 p.2 ∈ Γ.m}
                   (∀ φ ψ, nnf.and φ ψ ∉ Γ.m)
:= λ Γ, get_and Γ.m

def get_or : Π Γ : list nnf,
              psum {p : nnf × nnf // or p.1 p.2 ∈ Γ}
                   (∀ φ ψ, nnf.or φ ψ ∉ Γ)
| []               := psum.inr $ λ _ _, not_mem_nil _
| (hd :: tl)       :=
begin
  cases h : hd,
  case nnf.or : φ ψ { left, constructor,swap,
                       constructor, exact φ, exact ψ, simp },
  all_goals
  { cases (get_or tl),
    {left,
    constructor,
    apply mem_cons_of_mem,
    exact val.2},
    {right, intros γ ψ h,
     cases h, contradiction,
    apply val, assumption}
  }
end

def get_or_seqt : Π Γ : sseqt,
              psum {p : nnf × nnf // or p.1 p.2 ∈ Γ.m}
                   (∀ φ ψ, nnf.or φ ψ ∉ Γ.m)
:= λ Γ, get_or Γ.m

def get_dia : Π Γ : list nnf,
              psum {p : nnf // dia p ∈ Γ}
                   (∀ φ, nnf.dia φ ∉ Γ)
| []               := psum.inr $ λ _, not_mem_nil _
| (hd :: tl)       :=
begin
  cases h : hd,
  case nnf.dia : φ { left, constructor, swap, exact φ, simp },
  all_goals
  { cases (get_dia tl),
    {left,
    constructor,
    apply mem_cons_of_mem,
    exact val.2},
    {right, intros γ h,
     cases h, contradiction,
     apply val, assumption } }
end

def get_dia_seqt : Π Γ : sseqt,
              psum {p : nnf // dia p ∈ Γ.m}
                   (∀ φ, nnf.dia φ ∉ Γ.m)
:= λ Γ, get_dia Γ.m

def get_box : Π Γ : list nnf,
              psum {l : nnf // box l ∈ Γ}
                   (∀ φ, nnf.box φ ∉ Γ)
| [] := psum.inr $ λ _, not_mem_nil _
| (hd :: tl) :=
begin
  cases h : hd,
  case nnf.box : φ { left, constructor, swap, exact φ, simp },
  all_goals
  { cases (get_box tl),
    {left,
    constructor,
    apply mem_cons_of_mem,
    exact val.2},
    {right, intros γ h,
     cases h, contradiction,
     apply val, assumption } }
end

def get_box_seqt : Π Γ : sseqt,
              psum {p : nnf // box p ∈ Γ.m}
                   (∀ φ, nnf.box φ ∉ Γ.m)
:= λ Γ, get_box Γ.m

@[simp] def get_var : list nnf → list ℕ
| [] := []
| ((var n) :: l) := n :: get_var l
| (e :: l) := get_var l

theorem get_var_iff : Π {Γ n}, var n ∈ Γ ↔ n ∈ get_var Γ
| [] φ := begin split, repeat {intro h, simpa using h} end
| (hd::tl) φ :=
begin
  split,
  { intro h, cases h₁ : hd,
    case nnf.var : n
    { dsimp, cases h,
       {left, rw h₁ at h, injection h},
       {right, exact (@get_var_iff tl φ).1 h} },
    all_goals
    { dsimp, cases h,
       {rw h₁ at h, contradiction},
       {exact (@get_var_iff tl φ).1 h} } },
  { intro h, cases h₁ : hd,
    case nnf.var : n
    { rw h₁ at h, dsimp at h, cases h,
       {simp [h]}, {right, exact (@get_var_iff tl φ).2 h} },
    all_goals
    { rw h₁ at h, dsimp [undia] at h, right, exact (@get_var_iff tl φ).2 h } }
end


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import order.filter.basic
import data.set.countable

/-!
# Filters with countable intersection property

In this file we define `countable_Inter_filter` to be the class of filters with the following
property: for any countable collection of sets `s ∈ l` their intersection belongs to `l` as well.

Two main examples are the `residual` filter defined in `topology.metric_space.baire` and
the `measure.ae` filter defined in `measure_theory.measure_space`.
-/

open set filter
open_locale filter

variables {ι α : Type*}

/-- A filter `l` has the countable intersection property if for any countable collection
of sets `s ∈ l` their intersection belongs to `l` as well. -/
class countable_Inter_filter (l : filter α) : Prop :=
(countable_sInter_mem_sets' :
  ∀ {S : set (set α)} (hSc : countable S) (hS : ∀ s ∈ S, s ∈ l), ⋂₀ S ∈ l)

variables {l : filter α} [countable_Inter_filter l]

lemma countable_sInter_mem_sets {S : set (set α)} (hSc : countable S) :
  ⋂₀ S ∈ l ↔ ∀ s ∈ S, s ∈ l :=
⟨λ hS s hs, mem_of_superset hS (sInter_subset_of_mem hs),
  countable_Inter_filter.countable_sInter_mem_sets' hSc⟩

lemma countable_Inter_mem_sets [encodable ι] {s : ι → set α} :
  (⋂ i, s i) ∈ l ↔ ∀ i, s i ∈ l :=
sInter_range s ▸ (countable_sInter_mem_sets (countable_range _)).trans forall_range_iff

lemma countable_bInter_mem {S : set ι} (hS : countable S) {s : Π i ∈ S, set α} :
  (⋂ i ∈ S, s i ‹_›) ∈ l ↔  ∀ i ∈ S, s i ‹_› ∈ l :=
begin
  rw [bInter_eq_Inter],
  haveI := hS.to_encodable,
  exact countable_Inter_mem_sets.trans subtype.forall
end

lemma eventually_countable_forall [encodable ι] {p : α → ι → Prop} :
  (∀ᶠ x in l, ∀ i, p x i) ↔ ∀ i, ∀ᶠ x in l, p x i :=
by simpa only [filter.eventually, set_of_forall]
  using @countable_Inter_mem_sets _ _ l _ _ (λ i, {x | p x i})

lemma eventually_countable_ball {S : set ι} (hS : countable S) {p : Π (x : α) (i ∈ S), Prop} :
  (∀ᶠ x in l, ∀ i ∈ S, p x i ‹_›) ↔ ∀ i ∈ S, ∀ᶠ x in l, p x i ‹_› :=
by simpa only [filter.eventually, set_of_forall]
  using @countable_bInter_mem _ _ l _ _ hS (λ i hi, {x | p x i hi})

lemma eventually_le.countable_Union [encodable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
  (⋃ i, s i) ≤ᶠ[l] ⋃ i, t i :=
(eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Union.2 $
  (mem_Union.1 hs).imp hst

lemma eventually_eq.countable_Union [encodable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
  (⋃ i, s i) =ᶠ[l] ⋃ i, t i :=
(eventually_le.countable_Union (λ i, (h i).le)).antisymm
  (eventually_le.countable_Union (λ i, (h i).symm.le))

lemma eventually_le.countable_bUnion {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) : (⋃ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
begin
  simp only [bUnion_eq_Union],
  haveI := hS.to_encodable,
  exact eventually_le.countable_Union (λ i, h i i.2)
end

lemma eventually_eq.countable_bUnion {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) : (⋃ i ∈ S, s i ‹_›) =ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
(eventually_le.countable_bUnion hS (λ i hi, (h i hi).le)).antisymm
  (eventually_le.countable_bUnion hS (λ i hi, (h i hi).symm.le))

lemma eventually_le.countable_Inter [encodable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
  (⋂ i, s i) ≤ᶠ[l] ⋂ i, t i :=
(eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Inter.2 $ λ i, hst _ (mem_Inter.1 hs i)

lemma eventually_eq.countable_Inter [encodable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
  (⋂ i, s i) =ᶠ[l] ⋂ i, t i :=
(eventually_le.countable_Inter (λ i, (h i).le)).antisymm
  (eventually_le.countable_Inter (λ i, (h i).symm.le))

lemma eventually_le.countable_bInter {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) : (⋂ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
begin
  simp only [bInter_eq_Inter],
  haveI := hS.to_encodable,
  exact eventually_le.countable_Inter (λ i, h i i.2)
end

lemma eventually_eq.countable_bInter {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
  (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) : (⋂ i ∈ S, s i ‹_›) =ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
(eventually_le.countable_bInter hS (λ i hi, (h i hi).le)).antisymm
  (eventually_le.countable_bInter hS (λ i hi, (h i hi).symm.le))

instance countable_Inter_filter_principal (s : set α) : countable_Inter_filter (𝓟 s) :=
⟨λ S hSc hS, subset_sInter hS⟩

instance countable_Inter_filter_bot : countable_Inter_filter (⊥ : filter α) :=
by { rw ← principal_empty, apply countable_Inter_filter_principal }

instance countable_Inter_filter_top : countable_Inter_filter (⊤ : filter α) :=
by { rw ← principal_univ, apply countable_Inter_filter_principal }

/-- Infimum of two `countable_Inter_filter`s is a `countable_Inter_filter`. This is useful, e.g.,
to automatically get an instance for `residual α ⊓ 𝓟 s`. -/
instance countable_Inter_filter_inf (l₁ l₂ : filter α) [countable_Inter_filter l₁]
  [countable_Inter_filter l₂] :
  countable_Inter_filter (l₁ ⊓ l₂) :=
begin
  refine ⟨λ S hSc hS, _⟩,
  choose s hs t ht hst using hS,
  replace hs : (⋂ i ∈ S, s i ‹_›) ∈ l₁ := (countable_bInter_mem hSc).2 hs,
  replace ht : (⋂ i ∈ S, t i ‹_›) ∈ l₂ := (countable_bInter_mem hSc).2 ht,
  refine mem_of_superset (inter_mem_inf hs ht) (subset_sInter $ λ i hi, _),
  rw hst i hi,
  apply inter_subset_inter ; exact Inter_subset_of_subset i (Inter_subset _ _)
end

/-- Supremum of two `countable_Inter_filter`s is a `countable_Inter_filter`. -/
instance countable_Inter_filter_sup (l₁ l₂ : filter α) [countable_Inter_filter l₁]
  [countable_Inter_filter l₂] :
  countable_Inter_filter (l₁ ⊔ l₂) :=
begin
  refine ⟨λ S hSc hS, ⟨_, _⟩⟩; refine (countable_sInter_mem_sets hSc).2 (λ s hs, _),
  exacts [(hS s hs).1, (hS s hs).2]
end


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.meta.rb_map
import Mathlib.tactic.ring
import Mathlib.tactic.linarith.lemmas
import Mathlib.PostPort

universes l

namespace Mathlib

/-!
# Datatypes for `linarith`

Some of the data structures here are used in multiple parts of the tactic.
We split them into their own file.

This file also contains a few convenient auxiliary functions.
-/

namespace linarith

/-- A shorthand for tracing when the `trace.linarith` option is set to true. -/
/--
A shorthand for tracing the types of a list of proof terms
when the `trace.linarith` option is set to true.
-/
/-! ### Linear expressions -/

/--
A linear expression is a list of pairs of variable indices and coefficients,
representing the sum of the products of each coefficient with its corresponding variable.

Some functions on `linexp` assume that `n : ℕ` occurs at most once as the first element of a pair,
and that the list is sorted in decreasing order of the first argument.
This is not enforced by the type but the operations here preserve it.
-/
def linexp :=
  List (ℕ × ℤ)

namespace linexp

/--
Add two `linexp`s together componentwise.
Preserves sorting and uniqueness of the first argument.
-/
/-- `l.scale c` scales the values in `l` by `c` without modifying the order or keys. -/
def scale (c : ℤ) (l : linexp) : linexp :=
  ite (c = 0) [] (ite (c = 1) l (list.map (fun (_x : ℕ × ℤ) => sorry) l))

/--
`l.get n` returns the value in `l` associated with key `n`, if it exists, and `none` otherwise.
This function assumes that `l` is sorted in decreasing order of the first argument,
that is, it will return `none` as soon as it finds a key smaller than `n`.
-/
def get (n : ℕ) : linexp → Option ℤ :=
  sorry

/--
`l.contains n` is true iff `n` is the first element of a pair in `l`.
-/
def contains (n : ℕ) : linexp → Bool :=
  option.is_some ∘ get n

/--
`l.zfind n` returns the value associated with key `n` if there is one, and 0 otherwise.
-/
def zfind (n : ℕ) (l : linexp) : ℤ :=
  sorry

/-- `l.vars` returns the list of variables that occur in `l`. -/
def vars (l : linexp) : List ℕ :=
  list.map prod.fst l

/--
Defines a lex ordering on `linexp`. This function is performance critical.
-/
def cmp : linexp → linexp → ordering :=
  sorry

end linexp

/-! ### Inequalities -/

/-- The three-element type `ineq` is used to represent the strength of a comparison between terms. -/
inductive ineq
where
| eq : ineq
| le : ineq
| lt : ineq

namespace ineq

/--
`max R1 R2` computes the strength of the sum of two inequalities. If `t1 R1 0` and `t2 R2 0`,
then `t1 + t2 (max R1 R2) 0`.
-/
def max : ineq → ineq → ineq :=
  sorry

/-- `ineq` is ordered `eq < le < lt`. -/
def cmp : ineq → ineq → ordering :=
  sorry

/-- Prints an `ineq` as the corresponding infix symbol. -/
def to_string : ineq → string :=
  sorry

/-- Finds the name of a multiplicative lemma corresponding to an inequality strength. -/
protected instance has_to_string : has_to_string ineq :=
  has_to_string.mk to_string

end ineq

/-! ### Comparisons with 0 -/

/--
The main datatype for FM elimination.
Variables are represented by natural numbers, each of which has an integer coefficient.
Index 0 is reserved for constants, i.e. `coeffs.find 0` is the coefficient of 1.
The represented term is `coeffs.sum (λ ⟨k, v⟩, v * Var[k])`.
str determines the strength of the comparison -- is it < 0, ≤ 0, or = 0?
-/
structure comp
where
  str : ineq
  coeffs : linexp

/-- `c.vars` returns the list of variables that appear in the linear expression contained in `c`. -/
def comp.vars : comp → List ℕ :=
  linexp.vars ∘ comp.coeffs

/-- `comp.coeff_of c a` projects the coefficient of variable `a` out of `c`. -/
def comp.coeff_of (c : comp) (a : ℕ) : ℤ :=
  linexp.zfind a (comp.coeffs c)

/-- `comp.scale c n` scales the coefficients of `c` by `n`. -/
def comp.scale (c : comp) (n : ℕ) : comp :=
  comp.mk (comp.str c) (linexp.scale (↑n) (comp.coeffs c))

/--
`comp.add c1 c2` adds the expressions represented by `c1` and `c2`.
The coefficient of variable `a` in `c1.add c2`
is the sum of the coefficients of `a` in `c1` and `c2`.
 -/
/-- `comp` has a lex order. First the `ineq`s are compared, then the `coeff`s. -/
/--
A `comp` represents a contradiction if its expression has no coefficients and its strength is <,
that is, it represents the fact `0 < 0`.
 -/
/-! ### Parsing into linear form -/

/-! ### Control -/

/--
A preprocessor transforms a proof of a proposition into a proof of a different propositon.
The return type is `list expr`, since some preprocessing steps may create multiple new hypotheses,
and some may remove a hypothesis from the list.
A "no-op" preprocessor should return its input as a singleton list.
-/
/--
Some preprocessors need to examine the full list of hypotheses instead of working item by item.
As with `preprocessor`, the input to a `global_preprocessor` is replaced by, not added to, its output.
-/
/--
Some preprocessors perform branching case splits. A `branch` is used to track one of these case
splits. The first component, an `expr`, is the goal corresponding to this branch of the split,
given as a metavariable. The `list expr` component is the list of hypotheses for `linarith`
in this branch. Every `expr` in this list should be type correct in the context of the associated goal.
-/
/--
Some preprocessors perform branching case splits.
A `global_branching_preprocessor` produces a list of branches to run.
Each branch is independent, so hypotheses that appear in multiple branches should be duplicated.
The preprocessor is responsible for making sure that each branch contains the correct goal
metavariable.
-/
/--
A `preprocessor` lifts to a `global_preprocessor` by folding it over the input list.
-/
/--
A `global_preprocessor` lifts to a `global_branching_preprocessor` by producing only one branch.
-/
/--
`process pp l` runs `pp.transform` on `l` and returns the result,
tracing the result if `trace.linarith` is on.
-/
/--
A `certificate_oracle` is a function `produce_certificate : list comp → ℕ → tactic (rb_map ℕ ℕ)`.
`produce_certificate hyps max_var` tries to derive a contradiction from the comparisons in `hyps`
by eliminating all variables ≤ `max_var`.
If successful, it returns a map `coeff : ℕ → ℕ` as a certificate.
This map represents that we can find a contradiction by taking the sum  `∑ (coeff i) * hyps[i]`.

The default `certificate_oracle` used by `linarith` is `linarith.fourier_motzkin.produce_certificate`
-/
/-- A configuration object for `linarith`. -/


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Init.SimpLemmas
import Init.Data.Nat.Basic
open Decidable List

universe u v w

variable {α : Type u} {β : Type v} {γ : Type w}

namespace List

@[simp] theorem length_nil : length ([] : List α) = 0 :=
  rfl

def reverseAux : List α → List α → List α
  | [],   r => r
  | a::l, r => reverseAux l (a::r)

def reverse (as : List α) :List α :=
  reverseAux as []

protected def append (as bs : List α) : List α :=
  reverseAux as.reverse bs

instance : Append (List α) := ⟨List.append⟩

theorem reverseAux_reverseAux_nil (as bs : List α) : reverseAux (reverseAux as bs) [] = reverseAux bs as := by
  induction as generalizing bs with
  | nil => rfl
  | cons a as ih => simp [reverseAux, ih]

@[simp] theorem nil_append (as : List α) : [] ++ as = as := rfl

@[simp] theorem append_nil (as : List α) : as ++ [] = as := by
  show reverseAux (reverseAux as []) [] = as
  simp [reverseAux_reverseAux_nil, reverseAux]

theorem reverseAux_reverseAux (as bs cs : List α) : reverseAux (reverseAux as bs) cs = reverseAux bs (reverseAux (reverseAux as []) cs) := by
  induction as generalizing bs cs with
  | nil => rfl
  | cons a as ih => simp [reverseAux, ih (a::bs), ih [a]]

@[simp] theorem cons_append (a : α) (as bs : List α) : (a::as) ++ bs = a::(as ++ bs) :=
  reverseAux_reverseAux as [a] bs

theorem append_assoc (as bs cs : List α) : (as ++ bs) ++ cs = as ++ (bs ++ cs) := by
  induction as with
  | nil => rfl
  | cons a as ih => simp [ih]

instance : EmptyCollection (List α) := ⟨List.nil⟩

protected def erase {α} [BEq α] : List α → α → List α
  | [],    b => []
  | a::as, b => match a == b with
    | true  => as
    | false => a :: List.erase as b

def eraseIdx : List α → Nat → List α
  | [],    _   => []
  | a::as, 0   => as
  | a::as, n+1 => a :: eraseIdx as n

def isEmpty : List α → Bool
  | []     => true
  | _ :: _ => false

@[specialize] def map (f : α → β) : List α → List β
  | []    => []
  | a::as => f a :: map f as

@[specialize] def map₂ (f : α → β → γ) : List α → List β → List γ
  | [],    _     => []
  | _,     []    => []
  | a::as, b::bs => f a b :: map₂ f as bs

def join : List (List α) → List α
  | []      => []
  | a :: as => a ++ join as

@[specialize] def filterMap (f : α → Option β) : List α → List β
  | []   => []
  | a::as =>
    match f a with
    | none   => filterMap f as
    | some b => b :: filterMap f as

@[specialize] def filterAux (p : α → Bool) : List α → List α → List α
  | [],    rs => rs.reverse
  | a::as, rs => match p a with
     | true  => filterAux p as (a::rs)
     | false => filterAux p as rs

@[inline] def filter (p : α → Bool) (as : List α) : List α :=
  filterAux p as []

@[specialize] def partitionAux (p : α → Bool) : List α → List α × List α → List α × List α
  | [],    (bs, cs) => (bs.reverse, cs.reverse)
  | a::as, (bs, cs) =>
    match p a with
    | true  => partitionAux p as (a::bs, cs)
    | false => partitionAux p as (bs, a::cs)

@[inline] def partition (p : α → Bool) (as : List α) : List α × List α :=
  partitionAux p as ([], [])

def dropWhile (p : α → Bool) : List α → List α
  | []   => []
  | a::l => match p a with
    | true  => dropWhile p l
    | false =>  a::l

def find? (p : α → Bool) : List α → Option α
  | []    => none
  | a::as => match p a with
    | true  => some a
    | false => find? p as

def findSome? (f : α → Option β) : List α → Option β
  | []    => none
  | a::as => match f a with
    | some b => some b
    | none   => findSome? f as

def replace [BEq α] : List α → α → α → List α
  | [],    _, _ => []
  | a::as, b, c => match a == b with
    | true  => c::as
    | false => a :: (replace as b c)

def elem [BEq α] (a : α) : List α → Bool
  | []    => false
  | b::bs => match a == b with
    | true  => true
    | false => elem a bs

def notElem [BEq α] (a : α) (as : List α) : Bool :=
  !(as.elem a)

abbrev contains [BEq α] (as : List α) (a : α) : Bool :=
  elem a as

def eraseDupsAux {α} [BEq α] : List α → List α → List α
  | [],    bs => bs.reverse
  | a::as, bs => match bs.elem a with
    | true  => eraseDupsAux as bs
    | false => eraseDupsAux as (a::bs)

def eraseDups {α} [BEq α] (as : List α) : List α :=
  eraseDupsAux as []

def eraseRepsAux {α} [BEq α] : α → List α → List α → List α
  | a, [], rs => (a::rs).reverse
  | a, a'::as, rs => match a == a' with
    | true  => eraseRepsAux a as rs
    | false => eraseRepsAux a' as (a::rs)

/-- Erase repeated adjacent elements. -/
def eraseReps {α} [BEq α] : List α → List α
  | []    => []
  | a::as => eraseRepsAux a as []

@[specialize] def spanAux (p : α → Bool) : List α → List α → List α × List α
  | [],    rs => (rs.reverse, [])
  | a::as, rs => match p a with
    | true  => spanAux p as (a::rs)
    | false => (rs.reverse, a::as)

@[inline] def span (p : α → Bool) (as : List α) : List α × List α :=
  spanAux p as []

@[specialize] def groupByAux (eq : α → α → Bool) : List α → List (List α) → List (List α)
  | a::as, (ag::g)::gs => match eq a ag with
    | true  => groupByAux eq as ((a::ag::g)::gs)
    | false => groupByAux eq as ([a]::(ag::g).reverse::gs)
  | _, gs => gs.reverse

@[specialize] def groupBy (p : α → α → Bool) : List α → List (List α)
  | []    => []
  | a::as => groupByAux p as [[a]]

def lookup [BEq α] : α → List (α × β) → Option β
  | _, []        => none
  | a, (k,b)::es => match a == k with
    | true  => some b
    | false => lookup a es

def removeAll [BEq α] (xs ys : List α) : List α :=
  xs.filter (fun x => ys.notElem x)

def drop : Nat → List α → List α
  | 0,   a     => a
  | n+1, []    => []
  | n+1, a::as => drop n as

def take : Nat → List α → List α
  | 0,   a     => []
  | n+1, []    => []
  | n+1, a::as => a :: take n as

@[specialize] def foldr (f : α → β → β) (init : β) : List α → β
  | []     => init
  | a :: l => f a (foldr f init l)

@[inline] def any (l : List α) (p : α → Bool) : Bool :=
  foldr (fun a r => p a || r) false l

@[inline] def all (l : List α) (p : α → Bool) : Bool :=
  foldr (fun a r => p a && r) true l

def or  (bs : List Bool) : Bool := bs.any id

def and (bs : List Bool) : Bool := bs.all id

def zipWith (f : α → β → γ) : List α → List β → List γ
  | x::xs, y::ys => f x y :: zipWith f xs ys
  | _,     _     => []

def zip : List α → List β → List (Prod α β) :=
  zipWith Prod.mk

def unzip : List (α × β) → List α × List β
  | []          => ([], [])
  | (a, b) :: t => match unzip t with | (al, bl) => (a::al, b::bl)

def rangeAux : Nat → List Nat → List Nat
  | 0,   ns => ns
  | n+1, ns => rangeAux n (n::ns)

def range (n : Nat) : List Nat :=
  rangeAux n []

def iota : Nat → List Nat
  | 0       => []
  | m@(n+1) => m :: iota n

def enumFrom : Nat → List α → List (Nat × α)
  | n, [] => nil
  | n, x :: xs   => (n, x) :: enumFrom (n + 1) xs

def enum : List α → List (Nat × α) := enumFrom 0

def init : List α → List α
  | []   => []
  | [a]  => []
  | a::l => a::init l

def intersperse (sep : α) : List α → List α
  | []    => []
  | [x]   => [x]
  | x::xs => x :: sep :: intersperse sep xs

def intercalate (sep : List α) (xs : List (List α)) : List α :=
  join (intersperse sep xs)

@[inline] protected def bind {α : Type u} {β : Type v} (a : List α) (b : α → List β) : List β := join (map b a)

@[inline] protected def pure {α : Type u} (a : α) : List α := [a]

inductive lt [LT α] : List α → List α → Prop where
  | nil  (b : α) (bs : List α) : lt [] (b::bs)
  | head {a : α} (as : List α) {b : α} (bs : List α) : a < b → lt (a::as) (b::bs)
  | tail {a : α} {as : List α} {b : α} {bs : List α} : ¬ a < b → ¬ b < a → lt as bs → lt (a::as) (b::bs)

instance [LT α] : LT (List α) := ⟨List.lt⟩

instance hasDecidableLt [LT α] [h : DecidableRel (α:=α) (·<·)] : (l₁ l₂ : List α) → Decidable (l₁ < l₂)
  | [],    []    => isFalse (fun h => nomatch h)
  | [],    b::bs => isTrue (List.lt.nil _ _)
  | a::as, []    => isFalse (fun h => nomatch h)
  | a::as, b::bs =>
    match h a b with
    | isTrue h₁  => isTrue (List.lt.head _ _ h₁)
    | isFalse h₁ =>
      match h b a with
      | isTrue h₂  => isFalse (fun h => match h with
         | List.lt.head _ _ h₁' => absurd h₁' h₁
         | List.lt.tail _ h₂' _ => absurd h₂ h₂')
      | isFalse h₂ =>
        match hasDecidableLt as bs with
        | isTrue h₃  => isTrue (List.lt.tail h₁ h₂ h₃)
        | isFalse h₃ => isFalse (fun h => match h with
           | List.lt.head _ _ h₁' => absurd h₁' h₁
           | List.lt.tail _ _ h₃' => absurd h₃' h₃)

@[reducible] protected def le [LT α] (a b : List α) : Prop := ¬ b < a

instance [LT α] : LE (List α) := ⟨List.le⟩

instance [LT α] [h : DecidableRel ((· < ·) : α → α → Prop)] : (l₁ l₂ : List α) → Decidable (l₁ ≤ l₂) :=
  fun a b => inferInstanceAs (Decidable (Not _))

/--  `isPrefixOf l₁ l₂` returns `true` Iff `l₁` is a prefix of `l₂`. -/
def isPrefixOf [BEq α] : List α → List α → Bool
  | [],    _     => true
  | _,     []    => false
  | a::as, b::bs => a == b && isPrefixOf as bs

/--  `isSuffixOf l₁ l₂` returns `true` Iff `l₁` is a suffix of `l₂`. -/
def isSuffixOf [BEq α] (l₁ l₂ : List α) : Bool :=
  isPrefixOf l₁.reverse l₂.reverse

@[specialize] def isEqv : List α → List α → (α → α → Bool) → Bool
  | [],    [],    _   => true
  | a::as, b::bs, eqv => eqv a b && isEqv as bs eqv
  | _,     _,     eqv => false

protected def beq [BEq α] : List α → List α → Bool
  | [],    []    => true
  | a::as, b::bs => a == b && List.beq as bs
  | _,     _     => false

instance [BEq α] : BEq (List α) := ⟨List.beq⟩

def replicate {α : Type u} (n : Nat) (a : α) : List α :=
  let rec loop : Nat → List α → List α
    | 0, as => as
    | n+1, as => loop n (a::as)
  loop n []

def dropLast {α} : List α → List α
  | []    => []
  | [a]   => []
  | a::as => a :: dropLast as

@[simp] theorem length_replicate (n : Nat) (a : α) : (replicate n a).length = n :=
  let rec aux (n : Nat) (as : List α) : (replicate.loop a n as).length = n + as.length := by
    induction n generalizing as with
    | zero => simp [replicate.loop]
    | succ n ih => simp [replicate.loop, ih, Nat.succ_add, Nat.add_succ]
  aux n []

@[simp] theorem length_concat (as : List α) (a : α) : (concat as a).length = as.length + 1 := by
  induction as with
  | nil => rfl
  | cons x xs ih => simp [concat, ih]

@[simp] theorem length_set (as : List α) (i : Nat) (a : α) : (as.set i a).length = as.length := by
  induction as generalizing i with
  | nil => rfl
  | cons x xs ih =>
    cases i with
    | zero => rfl
    | succ i => simp [set, ih]

@[simp] theorem length_dropLast (as : List α) : as.dropLast.length = as.length - 1 := by
  match as with
  | []       => rfl
  | [a]      => rfl
  | a::b::as =>
    have ih := length_dropLast (b::as)
    simp[dropLast, ih]
    rfl

def maximum? [LT α] [DecidableRel (@LT.lt α _)] : List α → Option α
  | []    => none
  | a::as => some <| as.foldl max a

def minimum? [LE α] [DecidableRel (@LE.le α _)] : List α → Option α
  | []    => none
  | a::as => some <| as.foldl min a

end List


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

Without loss of generality tactic.
-/
import data.list.perm

open expr
setup_tactic_parser

namespace tactic

private meta def update_pp_name : expr → name → expr
| (local_const n _ bi d) pp := local_const n pp bi d
| e n := e

private meta def elim_or : ℕ → expr → tactic (list expr)
| 0       h := fail "zero cases"
| 1       h := return [h]
| (n + 1) h := do
  [(_, [hl], []), (_, [hr], [])] ← induction h, -- there should be no dependent terms
  [gl, gr] ← get_goals,
  set_goals [gr],
  hsr ← elim_or n hr,
  gsr ← get_goals,
  set_goals (gl :: gsr),
  return (hl :: hsr)

private meta def dest_or : expr → tactic (list expr) | e := do
  `(%%a ∨ %%b) ← whnf e | return [e],
  lb ← dest_or b,
  return (a :: lb)

private meta def match_perms (pat : pattern) : expr → tactic (list $ list expr) | t :=
  (do
    m ← match_pattern pat t,
    guard (m.2.all expr.is_local_constant),
    return [m.2]) <|>
  (do
    `(%%l ∨ %%r) ← whnf t,
    m ← match_pattern pat l,
    rs ← match_perms r,
    return (m.2 :: rs))

meta def wlog (vars' : list expr) (h_cases fst_case : expr) (perms : list (list expr)) :
  tactic unit := do
  guard h_cases.is_local_constant,

  -- reorder s.t. context is Γ ⬝ vars ⬝ cases ⊢ ∀deps, …
  nr ← revert_lst (vars' ++ [h_cases]),
  vars ← intron' vars'.length,
  h_cases ← intro h_cases.local_pp_name,

  cases ← infer_type h_cases,
  h_fst_case ←
    mk_local_def h_cases.local_pp_name
      (fst_case.instantiate_locals $ (vars'.zip vars).map $ λ⟨o, n⟩, (o.local_uniq_name, n)),
  ((), pr) ← solve_aux cases (repeat $ exact h_fst_case <|> left >> skip),

  t ← target,
  fixed_vars ← vars.mmap update_type,
  let t' := (instantiate_local h_cases.local_uniq_name pr t).pis (fixed_vars ++ [h_fst_case]),

  (h, [g]) ← local_proof `this t' (do
    clear h_cases,
    vars.mmap clear,
    intron nr),

  h₀ :: hs ← elim_or perms.length h_cases,

  solve1 (do
    exact (h.mk_app $ vars ++ [h₀])),

  focus ((hs.zip perms.tail).map $ λ⟨h_case, perm⟩, do
    let p_v := (vars'.zip vars).map (λ⟨p, v⟩, (p.local_uniq_name, v)),
    let p := perm.map (λp, p.instantiate_locals p_v),
    note `this none (h.mk_app $ p ++ [h_case]),
    clear h,
    return ()),
  gs ← get_goals,
  set_goals (g :: gs)

namespace interactive
open interactive interactive.types expr

private meta def parse_permutations : option (list (list name)) → tactic (list (list expr))
| none                    := return []
| (some [])               := return []
| (some perms@(p₀ :: ps)) := do
  (guard p₀.nodup <|> fail
    "No permutation `xs_i` in `using [xs_1, …, xs_n]` should contain the same variable twice."),
  (guard (perms.all $ λp, p.perm p₀) <|>
    fail ("The permutations `xs_i` in `using [xs_1, …, xs_n]` must be permutations of the same" ++
      " variables.")),
  perms.mmap (λp, p.mmap get_local)

/-- Without loss of generality: reduces to one goal under variables permutations.

Given a goal of the form `g xs`, a predicate `p` over a set of variables, as well as variable
permutations `xs_i`. Then `wlog` produces goals of the form

The case goal, i.e. the permutation `xs_i` covers all possible cases:
  `⊢ p xs_0 ∨ ⋯ ∨ p xs_n`
The main goal, i.e. the goal reduced to `xs_0`:
  `(h : p xs_0) ⊢ g xs_0`
The invariant goals, i.e. `g` is invariant under `xs_i`:
  `(h : p xs_i) (this : g xs_0) ⊢ gs xs_i`

Either the permutation is provided, or a proof of the disjunction is provided to compute the
permutation. The disjunction need to be in assoc normal form, e.g. `p₀ ∨ (p₁ ∨ p₂)`. In many cases
the invariant goals can be solved by AC rewriting using `cc` etc.

Example:
  On a state `(n m : ℕ) ⊢ p n m` the tactic `wlog h : n ≤ m using [n m, m n]` produces the following
  states:
    `(n m : ℕ) ⊢ n ≤ m ∨ m ≤ n`
    `(n m : ℕ) (h : n ≤ m) ⊢ p n m`
    `(n m : ℕ) (h : m ≤ n) (this : p n m) ⊢ p m n`

`wlog` supports different calling conventions. The name `h` is used to give a name to the introduced
case hypothesis. If the name is avoided, the default will be `case`.

(1) `wlog : p xs0 using [xs0, …, xsn]`
  Results in the case goal `p xs0 ∨ ⋯ ∨ ps xsn`, the main goal `(case : p xs0) ⊢ g xs0` and the
  invariance goals `(case : p xsi) (this : g xs0) ⊢ g xsi`.

(2) `wlog : p xs0 := r using xs0`
  The expression `r` is a proof of the shape `p xs0 ∨ ⋯ ∨ p xsi`, it is also used to compute the
  variable permutations.

(3) `wlog := r using xs0`
  The expression `r` is a proof of the shape `p xs0 ∨ ⋯ ∨ p xsi`, it is also used to compute the
  variable permutations. This is not as stable as (2), for example `p` cannot be a disjunction.

(4) `wlog : R x y using x y` and `wlog : R x y`
  Produces the case `R x y ∨ R y x`. If `R` is ≤, then the disjunction discharged using linearity.
  If `using x y` is avoided then `x` and `y` are the last two variables appearing in the
  expression `R x y`. -/
meta def wlog
  (h : parse ident?)
  (pat : parse (tk ":" *> texpr)?)
  (cases : parse (tk ":=" *> texpr)?)
  (perms : parse (tk "using" *> (list_of (ident*) <|> (λx, [x]) <$> ident*))?)
  (discharger : tactic unit :=
    (tactic.solve_by_elim <|> tactic.tautology {classical := tt} <|>
      using_smt (smt_tactic.intros >> smt_tactic.solve_goals))) :
  tactic unit := do
perms ← parse_permutations perms,
(pat, cases_pr, cases_goal, vars, perms) ← (match cases with
| some r := do
  vars::_ ← return perms |
    fail "At least one set of variables expected, i.e. `using x y` or `using [x y, y x]`.",
  cases_pr ← to_expr r,
  cases_pr ← (if cases_pr.is_local_constant
    then return $ match h with some n := update_pp_name cases_pr n | none := cases_pr end
    else do
      note (h.get_or_else `case) none cases_pr),
  cases ← infer_type cases_pr,
  (pat, perms') ← match pat with
  | some pat := do
    pat ← to_expr pat,
    let vars' := vars.filter $ λv, v.occurs pat,
    case_pat ← mk_pattern [] vars' pat [] vars',
    perms' ← match_perms case_pat cases,
    return (pat, perms')
  | none := do
    (p :: ps) ← dest_or cases,
    let vars' := vars.filter $ λv, v.occurs p,
    case_pat ← mk_pattern [] vars' p [] vars',
    perms' ← (p :: ps).mmap (λp, do m ← match_pattern case_pat p, return m.2),
    return (p, perms')
  end,
  let vars_name := vars.map local_uniq_name,
  guard (perms'.all $ λp, p.all $ λv, v.is_local_constant ∧ v.local_uniq_name ∈ vars_name) <|>
    fail "Cases contains variables not declared in `using x y z`",
  perms ← (if perms.length = 1
    then do
      return (perms'.map $ λ p,
        p ++ vars.filter (λ v, p.all (λ v', v'.local_uniq_name ≠ v.local_uniq_name)))
    else do
      guard (perms.length = perms'.length) <|>
        fail "The provided permutation list has a different length then the provided cases.",
      return perms),
  return (pat, cases_pr, @none expr, vars, perms)

| none   := do
  let name_h := h.get_or_else `case,
  some pat ← return pat | fail "Either specify cases or a pattern with permutations",
  pat ← to_expr pat,
  (do
    [x, y] ← match perms with
    | []  := return pat.list_local_consts
    | [l] := return l
    | _   := failed
    end,
    let cases := mk_or_lst
      [pat, pat.instantiate_locals [(x.local_uniq_name, y), (y.local_uniq_name, x)]],
    (do
      `(%%x' ≤ %%y') ← return pat,
      (cases_pr, []) ← local_proof name_h cases (exact ``(le_total %%x' %%y')),
      return (pat, cases_pr, none, [x, y], [[x, y], [y, x]]))
    <|>
    (do
      (cases_pr, [g]) ← local_proof name_h cases skip,
      return (pat, cases_pr, some g, [x, y], [[x, y], [y, x]]))) <|>
  (do
    guard (perms.length ≥ 2) <|>
      fail ("To generate cases at least two permutations are required, i.e. `using [x y, y x]`" ++
        " or exactly 0 or 2 variables"),
    (vars :: perms') ← return perms,
    let names := vars.map local_uniq_name,
    let cases := mk_or_lst (pat :: perms'.map (λp, pat.instantiate_locals (names.zip p))),
    (cases_pr, [g]) ← local_proof name_h cases skip,
    return (pat, cases_pr, some g, vars, perms))
end),
let name_fn := if perms.length = 2 then λ _, `invariant else
  λ i, mk_simple_name ("invariant_" ++ to_string (i + 1)),
with_enable_tags $ tactic.focus1 $ do
  t ← get_main_tag,
  tactic.wlog vars cases_pr pat perms,
  tactic.focus (set_main_tag (mk_num_name `_case 0 :: `main :: t) ::
    (list.range (perms.length - 1)).map (λi, do
      set_main_tag (mk_num_name `_case 0 :: name_fn i :: t),
      try discharger)),
  match cases_goal with
  | some g := do
    set_tag g (mk_num_name `_case 0 :: `cases :: t),
    gs ← get_goals,
    set_goals (g :: gs)
  | none := skip
  end

add_tactic_doc
{ name := "wlog",
  category := doc_category.tactic,
  decl_names := [``wlog],
  tags := ["logic"] }

end interactive

end tactic


import set_theory.cardinal
import Rings.ToMathlib.fol
import data.W.cardinal

universes u v

namespace fol

variables {L : Language.{u}}

open_locale cardinal

open fol.Language

def bounded_term.rec2_aux {n} {C : bounded_term L n → Sort v}
  (hvar : ∀(k : fin n), C &k)
  (hfunc : Π {l} (f : L.functions l) (ts : dvector (bounded_term L n) l)
    (ih_ts : ∀t, ts.pmem t → C t), C (bd_apps (bd_func f) ts)) :
  Π {l} (t : bounded_preterm L n l) (ts : dvector (bounded_term L n) l)
  (ih_ts : ∀s, ts.pmem s → C s), C (bd_apps t ts)
| l (bd_var k) dvector.nil := λ _, hvar k
| l (bd_func f)  ts := λ hs, hfunc f ts hs
| l (bd_app t s) ts := λ hs, bounded_term.rec2_aux t (dvector.cons s ts) $
  λ r hr, psum.cases_on hr
    (λ hrs, eq.rec_on hrs.symm (bounded_term.rec2_aux s dvector.nil $
      λ s₀ hs₀, false.elim $ by {cases hs₀}))
    (hs _)

def bounded_term.rec2 {n} {C : bounded_term L n → Sort v}
  (hvar : ∀(k : fin n), C &k)
  (hfunc : Π {l} (f : L.functions l) (ts : dvector (bounded_term L n) l)
    (ih_ts : ∀t, ts.pmem t → C t), C (bd_apps (bd_func f) ts)) :
  ∀(t : bounded_term L n), C t :=
λt, bounded_term.rec2_aux hvar (λ _, hfunc) t dvector.nil (λ s hs, false.elim $ by {cases hs})

-- have h : ∀{n l} (f : bounded_preformula L n l) (ts : dvector (bounded_term L n) l),
--   C n (bd_apps_rel f ts),
-- begin
--   intros, induction f; try {rw ts.zero_eq},
--   apply hfalsum, apply hequal, apply hrel, apply f_ih (f_t::ts),
--   exact himp (f_ih_f₁ ([])) (f_ih_f₂ ([])), exact hall (f_ih ([]))
-- end,
-- λn f, h f ([])

def bounded_formula.rec2_aux {C : Πn, bounded_formula L n → Sort v}
  (hfalsum : Π {n}, C n ⊥)
  (hequal : Π {n} (t₁ t₂ : bounded_term L n), C n (t₁ ≃ t₂))
  (hrel : Π {n l : ℕ} (R : L.relations l) (ts : dvector (bounded_term L n) l),
    C n (bd_apps_rel (bd_rel R) ts))
  (himp : Π {n} {f₁ f₂ : bounded_formula L n} (ih₁ : C n f₁) (ih₂ : C n f₂), C n (f₁ ⟹ f₂))
  (hall : Π {n} {f : bounded_formula L (n+1)} (ih : C (n+1) f), C n (∀' f)) :
  ∀{n l} (f : bounded_preformula L n l) (ts : dvector (bounded_term L n) l),
  C n (bd_apps_rel f ts)
| _ _ bd_falsum dvector.nil := hfalsum
| _ _ (t₁ ≃ t₂) dvector.nil := hequal _ _
| _ _ (bd_rel R)         ts := hrel _ _
| _ _ (bd_apprel f t)    ts := by {let x := bounded_formula.rec2_aux f (dvector.cons t ts),
  dsimp [bd_apps_rel] at x, exact x }
| _ _ (f₁ ⟹ f₂) dvector.nil := himp (bounded_formula.rec2_aux f₁ dvector.nil)
  (bounded_formula.rec2_aux f₂ dvector.nil)
| _ _ (∀' f)    dvector.nil := hall (bounded_formula.rec2_aux f dvector.nil)

def bounded_formula.rec2 {C : Πn, bounded_formula L n → Sort v}
  (hfalsum : Π {n}, C n ⊥)
  (hequal : Π {n} (t₁ t₂ : bounded_term L n), C n (t₁ ≃ t₂))
  (hrel : Π {n l : ℕ} (R : L.relations l) (ts : dvector (bounded_term L n) l),
    C n (bd_apps_rel (bd_rel R) ts))
  (himp : Π {n} {f₁ f₂ : bounded_formula L n} (ih₁ : C n f₁) (ih₂ : C n f₂), C n (f₁ ⟹ f₂))
  (hall : Π {n} {f : bounded_formula L (n+1)} (ih : C (n+1) f), C n (∀' f)) :
  ∀{n : ℕ} (f : bounded_formula L n), C n f :=
λ n f, bounded_formula.rec2_aux (λ _, hfalsum) (λ _, hequal) (λ _ _, hrel) (λ _ _ _, himp)
  (λ _ _, hall) f dvector.nil

-- lemma bounded_term.rec2_aux_bd_apps {n} {C : bounded_term L n → Sort v}
--   (hvar : ∀(k : fin n), C &k)
--   (hfunc : Π {l} (f : L.functions l) (ts : dvector (bounded_term L n) l)
--     (ih_ts : ∀t, ts.pmem t → C t), C (bd_apps (bd_func f) ts)) :
--   ∀ {l} (t : bounded_preterm L n l) (ts : dvector (bounded_term L n) l)
--     (ih_ts : ∀t, ts.pmem t → C t),
--   bounded_term.rec2_aux hvar (λ _, hfunc) (bd_apps t ts)
--     = sorry :=
-- begin
--   sorry
--   -- intros l t,
--   -- induction t,
--   -- {
--   --   intro ts,
--   --   -- induction ts,

--   -- },
--   -- {sorry},
-- end

lemma bounded_term.rec2_bd_var {n} {C : bounded_term L n → Sort v}
  (hvar : ∀(k : fin n), C &k)
  (hfunc : Π {l} (f : L.functions l) (ts : dvector (bounded_term L n) l)
    (ih_ts : ∀t, ts.pmem t → C t), C (bd_apps (bd_func f) ts)) :
  ∀ (k : fin n),
  bounded_term.rec2 hvar (λ _, hfunc) &k = hvar k := λ k, rfl

lemma bounded_term.rec2_bd_apps {n} {C : bounded_term L n → Sort v}
  (hvar : ∀(k : fin n), C &k)
  (hfunc : Π {l} (f : L.functions l) (ts : dvector (bounded_term L n) l)
    (ih_ts : ∀t, ts.pmem t → C t), C (bd_apps (bd_func f) ts)) :
  ∀ {l} (f : L.functions l) (ts : dvector (bounded_term L n) l)
    (ih_ts : ∀t, ts.pmem t → C t),
  bounded_term.rec2 hvar (λ _, hfunc) (bd_apps (bd_func f) ts)
    = hfunc f ts ih_ts :=
begin
  intros l f ts,
  induction ts with a b c hind e f g,
  { intro ih_ts,
    dsimp [bounded_term.rec2, bounded_term.rec2_aux],
    apply congr_arg,
    ext _ a,
    cases a },
  {
    intro ih_ts,
    dsimp [bd_apps, bounded_term.rec2, bounded_term.rec2_aux],
    sorry,

  },
end

namespace cardinal

variables (L) (n : ℕ)

/-- We make `bounded_term L n` as a `W_type`, viewing the `W_type` as an inductive type
  the constructors would be indexed by the following definition.
  For each `k < n` we have a variable `xₙ` (with arity zero given by `pempty`)
  For each `⟨ n , f ⟩ : Σ n : ℕ, L.functions n` we have a function application (with arity `n`) -/
@[reducible] def term_α := ulift.{u} (fin n) ⊕ Σ m : ulift.{u} ℕ, L.functions m.down

/-- To define the arities in the `W_type` for `closed_term`.
  For each `n : ℕ` we have a variable `xₙ` (with arity zero given by `pempty`)
  For each `⟨ n , f ⟩ : Σ n : ℕ, L.functions n` we have a function application (with arity `n`) -/
@[reducible] def term_β : Π (c : term_α.{u} L n), Type u
| (sum.inl m) := pempty.{u+1}
| (sum.inr ⟨ m , f ⟩) := ulift.{u} (fin m.down)

variable {L}

/-- The forward map of the equivalence `W_type_term_β_equiv_closed_term` -/
@[reducible] def bounded_term_of_W_type_term_β : W_type (term_β L n) → bounded_term L n
| ⟨ sum.inl m , b ⟩ := x_ m.down
| ⟨ sum.inr (⟨ n , f ⟩) , b ⟩ := bd_apps (bd_func f)
  (dvector.of_fn (λ k, bounded_term_of_W_type_term_β $ b (ulift.up k)))

/-- The forward map of the equivalence `W_type_term_β_equiv_closed_term` -/
@[reducible] def W_type_term_β_of_bounded_term : bounded_term L n → W_type (term_β L n) :=
  bounded_term.rec2
    (λ m, ⟨ sum.inl ⟨m⟩ , pempty.elim ⟩) $
    λ l f ts rec,
    ⟨ sum.inr ⟨ ulift.up l , f ⟩, λ k : ulift (fin l), rec (dvector.nth' ts $ k.down) dvector.pmem_nth' ⟩

lemma bounded_term_of_W_type_term_β_right_inv : ∀ t : bounded_term L n,
  bounded_term_of_W_type_term_β n (W_type_term_β_of_bounded_term n t) = t :=
begin
  apply bounded_term.rec2,
  { intro k, refl },
  { intros l f ts hind,
    dsimp only [W_type_term_β_of_bounded_term],
    rw bounded_term.rec2_bd_apps _ _ _ _ (λ t _, W_type_term_β_of_bounded_term n t),
    dsimp [bounded_term_of_W_type_term_β],
    congr,
    rw dvector.ext,
    intro i,
    simp [dvector.nth'_of_fn],
    apply hind,
    exact dvector.pmem_nth' },
end

/- This is really an equivalence, but we only need surjectivity -/
lemma bounded_term_of_W_type_term_β_surjective :
  function.surjective (@bounded_term_of_W_type_term_β L n) :=
begin
  intros t,
  use W_type_term_β_of_bounded_term n t,
  exact bounded_term_of_W_type_term_β_right_inv _ _,
end

lemma fintype_term_β : Π (a : term_α L n), fintype (term_β L n a)
| (sum.inl ⟨ m ⟩) := by apply_instance
| (sum.inr ⟨ m , f ⟩) := fintype.of_equiv (fin m.down) equiv.ulift.symm

local attribute [instance] fintype_term_β

lemma bounded_term_le_functions : #(bounded_term L n) ≤
  max (cardinal.sum (λ n : ulift.{u} (ℕ), #(L.functions n.down))) ω :=
calc #(bounded_term L n)
      ≤ #(W_type (term_β.{u} L n)) :
    cardinal.mk_le_of_surjective (bounded_term_of_W_type_term_β_surjective n)
  ... ≤ max (# (ulift.{u} (fin n) ⊕ Σ (m : ulift.{u} ℕ), L.functions m.down)) ω :
    W_type.cardinal_mk_le_max_omega_of_fintype
  ... ≤ max (#(Σ n : ulift.{u} ℕ, L.functions n.down)) ω :
  begin
    apply max_le _ (le_max_right _ _),
    simp only [cardinal.mk_sum],
    apply le_trans (cardinal.add_le_max _ _),
    apply max_le _ (le_max_right _ _),
    apply max_le (le_max_of_le_right _) (le_max_of_le_left _),
    { apply le_of_lt, simp [cardinal.lt_omega] },
    { simp },
  end
  ... = max (cardinal.sum (λ n : ulift.{u} ℕ, #(L.functions n.down))) ω :
    by {rw cardinal.mk_sigma _}

/- We show that the formulas are bounded above by the terms.
  We first construct a `W_type` for each `bounded_formula L n` as follows
  ```
  | constructor | multiplicity         | arity |
  |-------------+----------------------+-------|
  | ⊥           | unit                 | empty |
  | t₁ ≃ t₂     | (bounded_term L n)²  | empty |
  | ⟹           | unit                 | bool  |
  ```
  This gives us a way of injecting `bounded_formula L n`
  into `W_type β n ⊕ bounded_formula L (n+1)` (to account for `∀`) (there are no relations).
  This ultimately gives us
  `bounded_formula L 0 ↪ Σ n : ℕ, W_type β n ` where instead of
  mapping into `bounded_formula L (n+1)` we map into the next `W_type β (n+1)`.
  We have bounds on each `W_type β n`, namely by `unit`, `(bounded_term L n)²` and `ω`.
  Finally we can remove `unit` and the squaring.

  The difference with the case of terms is `bd_all`
  and the induction is captured in the following example
  ```
  inductive box : ℕ → Type u
  | base {n} : box n
  | drop {n} (f : box (n+1)) : box n
  ```
-/

variable (L)

/-- We inject `bounded_formula L n` into the `W_type` built from this `⊕` `bounded_formula L (n+1)`.
  This could be generalized to when `L` has relation symbols,
  in which case more constructors should be added.
  -/
def formula_α : Type u := punit.{u+1} ⊕ ((bounded_term L n) × (bounded_term L n)) ⊕ punit.{u+1}

/-- The arities of the constructors `formula_α` for the `W_type` -/
def formula_β : formula_α L n → Type u
| (sum.inl x)           := pempty.{u+1}
| (sum.inr (sum.inl x)) := pempty.{u+1}
| (sum.inr (sum.inr x)) := ulift.{u} bool

variable {L}

/-- For the recursion to work, first map to the `W_type` in
  `W_type_sum_bounded_formula_succ_of_bounded_formula` -/
@[simp, reducible] def W_type_of_bounded_formula [is_algebraic L] {n} :
  bounded_formula L n → W_type (formula_β L n) :=
bounded_formula.rec2
  (λ _, ⟨ sum.inl punit.star , pempty.elim ⟩) -- bd_falsum
  (λ _ t s, ⟨ sum.inr $ sum.inl ⟨ t , s ⟩ , pempty.elim ⟩) -- t ≃ s
  (λ _ l r, false.elim $ Language.is_algebraic.empty_relations l r) -- there are no relation symbols
  (λ _ f₁ f₂ recf₁ recf₂, ⟨ sum.inr $ sum.inr punit.star , λ ⟨b⟩, bool.rec_on b recf₁ recf₂ ⟩ )
    -- bd_imp
  (λ _ _ _, ⟨ sum.inl punit.star , pempty.elim ⟩) -- bd_all degenerate case

/-- For all `n` we make a characterizing type for `bounded_formula L n`,
  in the sense that this should be an equivalence.
  For the recursion to work in the `⟹` case,
  it is important to define it without the `∀` first.
  For the recursion to work in the `∀` case,
  it is important to define it for all `n` at once. -/
@[simp, reducible] def W_type_sum_bounded_formula_succ_of_bounded_formula [is_algebraic L] {n} :
  bounded_formula L n → W_type (formula_β L n) ⊕ bounded_formula L (n+1) :=
bounded_formula.rec2
  (λ k, sum.inl (W_type_of_bounded_formula ⊥)) -- bd_falsum
  (λ _ t s, sum.inl (W_type_of_bounded_formula (t ≃ s))) -- t ≃ s
  (λ _ l r, false.elim $ Language.is_algebraic.empty_relations l r) -- there are no relation symbols
  (λ _ f₁ f₂ recf₁ recf₂, sum.inl (W_type_of_bounded_formula (f₁ ⟹ f₂))) -- bd_imp
  (λ _ f _, sum.inr f)

/-- Mapping `W_type_oplus_bounded_formula_succ_of_bounded_formula` just on the W_type -/
@[simp, reducible] def bounded_formula_of_W_type {n} :
  W_type (formula_β L n) → bounded_formula L n
| ⟨ (sum.inl x) , y ⟩ := ⊥
| ⟨ (sum.inr (sum.inl ⟨ t , s ⟩)) , y ⟩ := t ≃ s
| ⟨ (sum.inr (sum.inr x)) , y ⟩ :=
  bounded_formula_of_W_type (y $ ⟨ tt ⟩) ⟹
  bounded_formula_of_W_type (y $ ⟨ ff ⟩)

/-- The supposed inverse of `W_type_oplus_bounded_formula_succ_of_bounded_formula`.
  we want this to be surjective. -/
@[simp, reducible] def bounded_formula_of_W_type_sum_bounded_formula_succ {n} :
  W_type (formula_β L n) ⊕ bounded_formula L (n+1) → bounded_formula L n
| (sum.inl x) := bounded_formula_of_W_type x
| (sum.inr f) := ∀' f

lemma bounded_formula_of_W_type_right_inv
  [is_algebraic L] {n} : ∀ f : bounded_formula L n,
  ((∀ g : bounded_formula L (n+1), f ≠ ∀' g) →
    bounded_formula_of_W_type (W_type_of_bounded_formula f) = f) :=
begin
  apply @bounded_formula.rec2 _
    (λ (n : ℕ) f : bounded_formula L n, (∀ g : bounded_formula L (n+1), f ≠ ∀' g) →
    bounded_formula_of_W_type (W_type_of_bounded_formula f) = f),
  { intros,
    simp [bounded_formula.rec2, bounded_formula.rec2_aux] },
  { intros,
    simp [bounded_formula.rec2, bounded_formula.rec2_aux] },
  { intros n l r,
    exfalso,
    exact Language.is_algebraic.empty_relations l r },
  { intros _ _ _ h1 h2 _,
    simp only [bounded_formula_of_W_type_sum_bounded_formula_succ,
      bounded_formula_of_W_type, W_type_of_bounded_formula,
      W_type_sum_bounded_formula_succ_of_bounded_formula,
      bounded_formula.rec2, bounded_formula.rec2_aux],
    split,
    {
      convert h1,

}
  },
  sorry,
end

lemma bounded_formula_of_W_type_sum_bounded_formula_right_inv
  [is_algebraic L] {n} : ∀ f : bounded_formula L n,
  bounded_formula_of_W_type_sum_bounded_formula_succ
    (W_type_sum_bounded_formula_succ_of_bounded_formula f) = f :=
begin
  apply bounded_formula.rec2,
  { intro,
    simp [bounded_formula.rec2, bounded_formula.rec2_aux] },
  { intros,
    simp [bounded_formula.rec2, bounded_formula.rec2_aux] },
  { intros n l r,
    exfalso,
    exact Language.is_algebraic.empty_relations l r },
  { intros _ _ _ h1 h2,
    simp only [bounded_formula_of_W_type_sum_bounded_formula_succ,
      bounded_formula_of_W_type, W_type_of_bounded_formula,
      W_type_sum_bounded_formula_succ_of_bounded_formula,
      bounded_formula.rec2, bounded_formula.rec2_aux],
    split,
    {
      convert h1,
      sorry,
      -- simp [bounded_formula_of_W_type_sum_bounded_formula_succ,
      --   bounded_formula_of_W_type, W_type_of_bounded_formula,
      --   W_type_sum_bounded_formula_succ_of_bounded_formula,
      --   bounded_formula.rec2, bounded_formula.rec2_aux],
      -- sorry,
    },
    { sorry }
    },
  {sorry},
end

lemma bounded_formula_of_W_type_sum_bounded_formula_succ_surjective [is_algebraic L] {n}:
  function.surjective $ @bounded_formula_of_W_type_sum_bounded_formula_succ L n :=
begin
  intro f,
  use W_type_sum_bounded_formula_succ_of_bounded_formula f,
  -- cases f,
  sorry
end

-- lemma W_type_oplus_bounded_formula_succ_of_bounded_formula_injective [is_algebraic L] {n} :
--   function.injective $ @W_type_oplus_bounded_formula_succ_of_bounded_formula L _ n :=
-- begin
--   intros f₁ f₂,

-- end

-- def W_type_oplus_bounded_formula_succ_of_bounded_formula

lemma bounded_formula_le_bounded_term :
  #(bounded_formula L 0) ≤ max (cardinal.sum (λ n : ulift.{u} ℕ, #(bounded_term L n.down))) ω :=
sorry

lemma sentence_le_functions :
  #(bounded_formula L 0) ≤ max (cardinal.sum (λ n : ulift.{u} ℕ, #(L.functions n.down))) ω :=
begin
  apply le_trans (bounded_formula_le_bounded_term),
  apply max_le _ (le_max_right _ _),
  apply le_trans (cardinal.sum_le_sup _),
  simp only [cardinal.mk_denumerable],
  apply le_trans (cardinal.mul_le_max _ _),
  apply max_le _ (le_max_right _ _),
  apply max_le (le_max_right _ _),
  rw cardinal.sup_le,
  intro i,
  apply bounded_term_le_functions,
end

variable (L)

/-- Applying `∀` is an injection downwards. -/
def bounded_formula_bd_all : bounded_formula L (n+1) → (bounded_formula L n) :=
λ ϕ, ∀' ϕ

/-- Applying `∀` n times is an injection. "Dropbox" -/
def bounded_formula_bd_alls : Π n, bounded_formula L n → (bounded_formula L 0)
| 0 := id
| (n+1) := (bounded_formula_bd_alls n) ∘ bounded_formula_bd_all L n

variable {L}

lemma bounded_formula_bd_all_injective : function.injective (bounded_formula_bd_all L n) :=
λ ϕ ψ, bounded_preformula.bd_all.inj

lemma bounded_formula_bd_alls_injective : Π n, function.injective (bounded_formula_bd_alls L n)
| 0 := function.injective_id
| (n+1) := function.injective.comp (bounded_formula_bd_alls_injective n) (bounded_formula_bd_all_injective n)

/- Using ∀ we can embed `bounded_formula L (n+1)` into `bounded_formula L n`,
  hence showing they are all bounded by the function symbols
 -/
lemma bounded_formula_le_functions (n : ℕ) :
  #(bounded_formula L n) ≤ max (cardinal.sum (λ n : ulift.{u} ℕ, #(L.functions n.down))) ω :=
calc #(bounded_formula L n) ≤ #(bounded_formula L 0) : cardinal.mk_le_of_injective (bounded_formula_bd_alls_injective _)
                        ... ≤ max (cardinal.sum (λ n : ulift.{u} ℕ, #(L.functions n.down))) ω :
                        sentence_le_functions

end cardinal

end fol


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

A basic theory of Cauchy sequences, used in the construction of the reals.
Where applicable, lemmas that will be reused in other contexts have
been stated in extra generality.
-/
import algebra.big_operators algebra.ordered_field

class is_absolute_value {α} [discrete_linear_ordered_field α]
  {β} [ring β] (f : β → α) : Prop :=
(abv_nonneg : ∀ x, 0 ≤ f x)
(abv_eq_zero : ∀ {x}, f x = 0 ↔ x = 0)
(abv_add : ∀ x y, f (x + y) ≤ f x + f y)
(abv_mul : ∀ x y, f (x * y) = f x * f y)

namespace is_absolute_value
variables {α : Type*} [discrete_linear_ordered_field α]
  {β : Type*} [ring β] (abv : β → α) [is_absolute_value abv]

theorem abv_zero : abv 0 = 0 := (abv_eq_zero abv).2 rfl

theorem abv_one' (h : (1:β) ≠ 0) : abv 1 = 1 :=
(domain.mul_left_inj $ mt (abv_eq_zero abv).1 h).1 $
by rw [← abv_mul abv, mul_one, mul_one]

theorem abv_one
  {β : Type*} [domain β] (abv : β → α) [is_absolute_value abv] :
  abv 1 = 1 := abv_one' abv one_ne_zero

theorem abv_pos {a : β} : 0 < abv a ↔ a ≠ 0 :=
by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [abv_eq_zero abv, abv_nonneg abv]

theorem abv_neg (a : β) : abv (-a) = abv a :=
by rw [← mul_self_inj_of_nonneg (abv_nonneg abv _) (abv_nonneg abv _),
  ← abv_mul abv, ← abv_mul abv]; simp

theorem abv_sub (a b : β) : abv (a - b) = abv (b - a) :=
by rw [← neg_sub, abv_neg abv]

theorem abv_inv
  {β : Type*} [discrete_field β] (abv : β → α) [is_absolute_value abv]
  (a : β) : abv a⁻¹ = (abv a)⁻¹ :=
classical.by_cases
  (λ h : a = 0, by simp [h, abv_zero abv])
  (λ h, (domain.mul_left_inj (mt (abv_eq_zero abv).1 h)).1 $
    by rw [← abv_mul abv]; simp [h, mt (abv_eq_zero abv).1 h, abv_one abv])

theorem abv_div
  {β : Type*} [discrete_field β] (abv : β → α) [is_absolute_value abv]
  (a b : β) : abv (a / b) = abv a / abv b :=
by rw [division_def, abv_mul abv, abv_inv abv]; refl

lemma abv_sub_le (a b c : β) : abv (a - c) ≤ abv (a - b) + abv (b - c) :=
by simpa using abv_add abv (a - b) (b - c)

lemma sub_abv_le_abv_sub (a b : β) : abv a - abv b ≤ abv (a - b) :=
sub_le_iff_le_add.2 $ by simpa using abv_add abv (a - b) b

lemma abs_abv_sub_le_abv_sub (a b : β) :
  abs (abv a - abv b) ≤ abv (a - b) :=
abs_sub_le_iff.2 ⟨sub_abv_le_abv_sub abv _ _,
  by rw abv_sub abv; apply sub_abv_le_abv_sub abv⟩

end is_absolute_value

instance abs_is_absolute_value {α} [discrete_linear_ordered_field α] :
  is_absolute_value (abs : α → α) :=
{ abv_nonneg  := abs_nonneg,
  abv_eq_zero := λ _, abs_eq_zero,
  abv_add     := abs_add,
  abv_mul     := abs_mul }

open is_absolute_value

theorem exists_forall_ge_and {α} [linear_order α] {P Q : α → Prop} :
  (∃ i, ∀ j ≥ i, P j) → (∃ i, ∀ j ≥ i, Q j) →
  ∃ i, ∀ j ≥ i, P j ∧ Q j
| ⟨a, h₁⟩ ⟨b, h₂⟩ := let ⟨c, ac, bc⟩ := exists_ge_of_linear a b in
  ⟨c, λ j hj, ⟨h₁ _ (le_trans ac hj), h₂ _ (le_trans bc hj)⟩⟩

section
variables {α : Type*} [discrete_linear_ordered_field α]
  {β : Type*} [ring β] (abv : β → α) [is_absolute_value abv]

theorem rat_add_continuous_lemma
  {ε : α} (ε0 : 0 < ε) : ∃ δ > 0, ∀ {a₁ a₂ b₁ b₂ : β},
  abv (a₁ - b₁) < δ → abv (a₂ - b₂) < δ → abv (a₁ + a₂ - (b₁ + b₂)) < ε :=
⟨ε / 2, half_pos ε0, λ a₁ a₂ b₁ b₂ h₁ h₂,
  by simpa [add_halves] using lt_of_le_of_lt (abv_add abv _ _) (add_lt_add h₁ h₂)⟩

theorem rat_mul_continuous_lemma
  {ε K₁ K₂ : α} (ε0 : 0 < ε) (K₁0 : 0 < K₁) (K₂0 : 0 < K₂) :
  ∃ δ > 0, ∀ {a₁ a₂ b₁ b₂ : β}, abv a₁ < K₁ → abv b₂ < K₂ →
  abv (a₁ - b₁) < δ → abv (a₂ - b₂) < δ → abv (a₁ * a₂ - b₁ * b₂) < ε :=
begin
  have K0 := lt_of_lt_of_le K₁0 (le_max_left _ K₂),
  have εK := div_pos (half_pos ε0) K0,
  refine ⟨_, εK, λ a₁ a₂ b₁ b₂ ha₁ hb₂ h₁ h₂, _⟩,
  replace ha₁ := lt_of_lt_of_le ha₁ (le_max_left _ K₂),
  replace hb₂ := lt_of_lt_of_le hb₂ (le_max_right K₁ _),
  have := add_lt_add
    (mul_lt_mul' (le_of_lt h₁) hb₂ (abv_nonneg abv _) εK)
    (mul_lt_mul' (le_of_lt h₂) ha₁ (abv_nonneg abv _) εK),
  rw [← abv_mul abv, mul_comm, div_mul_cancel _ (ne_of_gt K0), ← abv_mul abv, add_halves] at this,
  simpa [mul_add, add_mul] using lt_of_le_of_lt (abv_add abv _ _) this
end

theorem rat_inv_continuous_lemma
  {β : Type*} [discrete_field β] (abv : β → α) [is_absolute_value abv]
  {ε K : α} (ε0 : 0 < ε) (K0 : 0 < K) :
  ∃ δ > 0, ∀ {a b : β}, K ≤ abv a → K ≤ abv b →
  abv (a - b) < δ → abv (a⁻¹ - b⁻¹) < ε :=
begin
  have KK := mul_pos K0 K0,
  have εK := mul_pos ε0 KK,
  refine ⟨_, εK, λ a b ha hb h, _⟩,
  have a0 := lt_of_lt_of_le K0 ha,
  have b0 := lt_of_lt_of_le K0 hb,
  rw [inv_sub_inv ((abv_pos abv).1 a0) ((abv_pos abv).1 b0),
      abv_div abv, abv_mul abv, mul_comm, abv_sub abv,
      ← mul_div_cancel ε (ne_of_gt KK)],
  exact div_lt_div h
    (mul_le_mul hb ha (le_of_lt K0) (abv_nonneg abv _))
    (le_of_lt $ mul_pos ε0 KK) KK
end
end

def is_cau_seq {α : Type*} [discrete_linear_ordered_field α]
  {β : Type*} [ring β] (abv : β → α) [is_absolute_value abv] (f : ℕ → β) :=
∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j - f i) < ε

namespace is_cau_seq
variables {α : Type*} [discrete_linear_ordered_field α]
  {β : Type*} [ring β] {abv : β → α} [is_absolute_value abv] {f : ℕ → β}

theorem cauchy₂ (hf : is_cau_seq abv f) {ε:α} (ε0 : ε > 0) :
  ∃ i, ∀ j k ≥ i, abv (f j - f k) < ε :=
begin
  refine (hf _ (half_pos ε0)).imp (λ i hi j k ij ik, _),
  rw ← add_halves ε,
  refine lt_of_le_of_lt (abv_sub_le abv _ _ _) (add_lt_add (hi _ ij) _),
  rw abv_sub abv, exact hi _ ik
end

theorem cauchy₃ (hf : is_cau_seq abv f) {ε:α} (ε0 : ε > 0) :
  ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - f j) < ε :=
let ⟨i, H⟩ := hf.cauchy₂ ε0 in ⟨i, λ j ij k jk, H _ _ (le_trans ij jk) ij⟩

end is_cau_seq

def cau_seq {α : Type*} [discrete_linear_ordered_field α]
  (β : Type*) [ring β] (abv : β → α) [is_absolute_value abv] :=
{f : ℕ → β // is_cau_seq abv f}

namespace cau_seq
variables {α : Type*} [discrete_linear_ordered_field α]

section ring
variables {β : Type*} [ring β] {abv : β → α} [is_absolute_value abv]

instance : has_coe_to_fun (cau_seq β abv) := ⟨_, subtype.val⟩

@[simp] theorem mk_to_fun (f) (hf : is_cau_seq abv f) :
  @coe_fn (cau_seq β abv) _ ⟨f, hf⟩ = f := rfl

theorem ext {f g : cau_seq β abv} (h : ∀ i, f i = g i) : f = g :=
subtype.eq (funext h)

theorem is_cau (f : cau_seq β abv) : is_cau_seq abv f := f.2

theorem cauchy (f : cau_seq β abv) :
  ∀ {ε}, ε > 0 → ∃ i, ∀ j ≥ i, abv (f j - f i) < ε := f.2

theorem cauchy₂ (f : cau_seq β abv) {ε:α} : ε > 0 →
  ∃ i, ∀ j k ≥ i, abv (f j - f k) < ε := f.2.cauchy₂

theorem cauchy₃ (f : cau_seq β abv) {ε:α} : ε > 0 →
  ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - f j) < ε := f.2.cauchy₃

theorem bounded (f : cau_seq β abv) : ∃ r, ∀ i, abv (f i) < r :=
begin
  cases f.cauchy zero_lt_one with i h,
  let R := (finset.range (i+1)).sum (λ j, abv (f j)),
  have : ∀ j ≤ i, abv (f j) ≤ R,
  { intros j ij, change (λ j, abv (f j)) j ≤ R,
    apply finset.single_le_sum,
    { intros, apply abv_nonneg abv },
    { rwa [finset.mem_range, nat.lt_succ_iff] } },
  refine ⟨R + 1, λ j, _⟩,
  cases lt_or_le j i with ij ij,
  { exact lt_of_le_of_lt (this _ (le_of_lt ij)) (lt_add_one _) },
  { have := lt_of_le_of_lt (abv_add abv _ _)
      (add_lt_add_of_le_of_lt (this _ (le_refl _)) (h _ ij)),
    rw [add_sub, add_comm] at this, simpa }
end

theorem bounded' (f : cau_seq β abv) (x : α) : ∃ r > x, ∀ i, abv (f i) < r :=
let ⟨r, h⟩ := f.bounded in
⟨max r (x+1), lt_of_lt_of_le (lt_add_one _) (le_max_right _ _),
  λ i, lt_of_lt_of_le (h i) (le_max_left _ _)⟩

def of_eq (f : cau_seq β abv) (g : ℕ → β) (e : ∀ i, f i = g i) : cau_seq β abv :=
⟨g, λ ε, by rw [show g = f, from (funext e).symm]; exact f.cauchy⟩

instance : has_add (cau_seq β abv) :=
⟨λ f g, ⟨λ i, (f i + g i : β), λ ε ε0,
  let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abv ε0,
      ⟨i, H⟩ := exists_forall_ge_and (f.cauchy₃ δ0) (g.cauchy₃ δ0) in
  ⟨i, λ j ij, let ⟨H₁, H₂⟩ := H _ (le_refl _) in Hδ (H₁ _ ij) (H₂ _ ij)⟩⟩⟩

@[simp] theorem add_apply (f g : cau_seq β abv) (i : ℕ) : (f + g) i = f i + g i := rfl

variable (abv)
def const (x : β) : cau_seq β abv :=
⟨λ i, x, λ ε ε0, ⟨0, λ j ij, by simpa [abv_zero abv] using ε0⟩⟩
variable {abv}

local notation `const` := const abv

@[simp] theorem const_apply (x : β) (i : ℕ) : (const x : ℕ → β) i = x := rfl

theorem const_inj {x y : β} : (const x : cau_seq β abv) = const y ↔ x = y :=
⟨λ h, congr_arg (λ f:cau_seq β abv, (f:ℕ→β) 0) h, congr_arg _⟩

instance : has_zero (cau_seq β abv) := ⟨const 0⟩
instance : has_one (cau_seq β abv) := ⟨const 1⟩

@[simp] theorem zero_apply (i) : (0 : cau_seq β abv) i = 0 := rfl
@[simp] theorem one_apply (i) : (1 : cau_seq β abv) i = 1 := rfl

theorem const_add (x y : β) : const (x + y) = const x + const y :=
ext $ λ i, rfl

instance : has_mul (cau_seq β abv) :=
⟨λ f g, ⟨λ i, (f i * g i : β), λ ε ε0,
  let ⟨F, F0, hF⟩ := f.bounded' 0, ⟨G, G0, hG⟩ := g.bounded' 0,
      ⟨δ, δ0, Hδ⟩ := rat_mul_continuous_lemma abv ε0 F0 G0,
      ⟨i, H⟩ := exists_forall_ge_and (f.cauchy₃ δ0) (g.cauchy₃ δ0) in
  ⟨i, λ j ij, let ⟨H₁, H₂⟩ := H _ (le_refl _) in
    Hδ (hF j) (hG i) (H₁ _ ij) (H₂ _ ij)⟩⟩⟩

@[simp] theorem mul_apply (f g : cau_seq β abv) (i : ℕ) : (f * g) i = f i * g i := rfl

theorem const_mul (x y : β) : const (x * y) = const x * const y :=
ext $ λ i, rfl

instance : has_neg (cau_seq β abv) :=
⟨λ f, of_eq (const (-1) * f) (λ x, -f x) (λ i, by simp)⟩

@[simp] theorem neg_apply (f : cau_seq β abv) (i) : (-f) i = -f i := rfl

theorem const_neg (x : β) : const (-x) = -const x :=
ext $ λ i, rfl

instance : ring (cau_seq β abv) :=
by refine {neg := has_neg.neg, add := (+), zero := 0, mul := (*), one := 1, ..};
   { intros, apply ext, simp [mul_add, mul_assoc, add_mul] }

instance {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv] : comm_ring (cau_seq β abv) :=
{ mul_comm := by intros; apply ext; simp [mul_left_comm, mul_comm],
  ..cau_seq.ring }

theorem const_sub (x y : β) : const (x - y) = const x - const y :=
by rw [sub_eq_add_neg, const_add, const_neg, sub_eq_add_neg]

@[simp] theorem sub_apply (f g : cau_seq β abv) (i : ℕ) : (f - g) i = f i - g i := rfl

def lim_zero (f : cau_seq β abv) := ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j) < ε

theorem add_lim_zero {f g : cau_seq β abv}
  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f + g)
| ε ε0 := (exists_forall_ge_and
    (hf _ $ half_pos ε0) (hg _ $ half_pos ε0)).imp $
  λ i H j ij, let ⟨H₁, H₂⟩ := H _ ij in
    by simpa [add_halves ε] using lt_of_le_of_lt (abv_add abv _ _) (add_lt_add H₁ H₂)

theorem mul_lim_zero (f : cau_seq β abv) {g}
  (hg : lim_zero g) : lim_zero (f * g)
| ε ε0 := let ⟨F, F0, hF⟩ := f.bounded' 0 in
  (hg _ $ div_pos ε0 F0).imp $ λ i H j ij,
  by have := mul_lt_mul' (le_of_lt $ hF j) (H _ ij) (abv_nonneg abv _) F0;
     rwa [mul_comm F, div_mul_cancel _ (ne_of_gt F0), ← abv_mul abv] at this

theorem neg_lim_zero {f : cau_seq β abv} (hf : lim_zero f) : lim_zero (-f) :=
by rw ← neg_one_mul; exact mul_lim_zero _ hf

theorem sub_lim_zero {f g : cau_seq β abv}
  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f - g) :=
add_lim_zero hf (neg_lim_zero hg)

theorem zero_lim_zero : lim_zero (0 : cau_seq β abv)
| ε ε0 := ⟨0, λ j ij, by simpa [abv_zero abv] using ε0⟩

theorem const_lim_zero {x : β} : lim_zero (const x) ↔ x = 0 :=
⟨λ H, (abv_eq_zero abv).1 $
  eq_of_le_of_forall_le_of_dense (abv_nonneg abv _) $
  λ ε ε0, let ⟨i, hi⟩ := H _ ε0 in le_of_lt $ hi _ (le_refl _),
λ e, e.symm ▸ zero_lim_zero⟩

instance equiv : setoid (cau_seq β abv) :=
⟨λ f g, lim_zero (f - g),
⟨λ f, by simp [zero_lim_zero],
 λ f g h, by simpa using neg_lim_zero h,
 λ f g h fg gh, by simpa using add_lim_zero fg gh⟩⟩

theorem equiv_def₃ {f g : cau_seq β abv} (h : f ≈ g) {ε:α} (ε0 : 0 < ε) :
  ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - g j) < ε :=
(exists_forall_ge_and (h _ $ half_pos ε0) (f.cauchy₃ $ half_pos ε0)).imp $
λ i H j ij k jk, let ⟨h₁, h₂⟩ := H _ ij in
by have := lt_of_le_of_lt (abv_add abv (f j - g j) _) (add_lt_add h₁ (h₂ _ jk));
   rwa [sub_add_sub_cancel', add_halves] at this

theorem lim_zero_congr {f g : cau_seq β abv} (h : f ≈ g) : lim_zero f ↔ lim_zero g :=
⟨λ l, by simpa using add_lim_zero (setoid.symm h) l,
 λ l, by simpa using add_lim_zero h l⟩

theorem abv_pos_of_not_lim_zero {f : cau_seq β abv} (hf : ¬ lim_zero f) :
  ∃ K > 0, ∃ i, ∀ j ≥ i, K ≤ abv (f j) :=
begin
  haveI := classical.prop_decidable,
  by_contra nk,
  refine hf (λ ε ε0, _),
  simp [not_forall] at nk,
  cases f.cauchy₃ (half_pos ε0) with i hi,
  rcases nk _ (half_pos ε0) i with ⟨j, ij, hj⟩,
  refine ⟨j, λ k jk, _⟩,
  have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add (hi j ij k jk) hj),
  rwa [sub_add_cancel, add_halves] at this
end

theorem of_near (f : ℕ → β) (g : cau_seq β abv)
  (h : ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j - g j) < ε) : is_cau_seq abv f
| ε ε0 :=
  let ⟨i, hi⟩ := exists_forall_ge_and
    (h _ (half_pos $ half_pos ε0)) (g.cauchy₃ $ half_pos ε0) in
  ⟨i, λ j ij, begin
    cases hi _ (le_refl _) with h₁ h₂, rw abv_sub abv at h₁,
    have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add (hi _ ij).1 h₁),
    have := lt_of_le_of_lt (abv_add abv _ _) (add_lt_add this (h₂ _ ij)),
    rwa [add_halves, add_halves, add_right_comm,
         sub_add_sub_cancel, sub_add_sub_cancel] at this
  end⟩

lemma not_lim_zero_of_not_congr_zero {f : cau_seq _ abv} (hf : ¬ f ≈ 0) : ¬ lim_zero f :=
assume : lim_zero f,
have lim_zero (f - 0), by simpa,
hf this

lemma mul_equiv_zero  (g : cau_seq _ abv) {f : cau_seq _ abv} (hf : f ≈ 0) : g * f ≈ 0 :=
have lim_zero (f - 0), from hf,
have lim_zero (g*f), from mul_lim_zero _ $ by simpa,
show lim_zero (g*f - 0), by simpa

lemma mul_not_equiv_zero {f g : cau_seq _ abv} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : ¬ (f * g) ≈ 0 :=
assume : lim_zero (f*g - 0),
have hlz : lim_zero (f*g), by simpa,
have hf' : ¬ lim_zero f, by simpa using (show ¬ lim_zero (f - 0), from hf),
have hg' : ¬ lim_zero g, by simpa using (show ¬ lim_zero (g - 0), from hg),
begin
  rcases abv_pos_of_not_lim_zero hf' with ⟨a1, ha1, N1, hN1⟩,
  rcases abv_pos_of_not_lim_zero hg' with ⟨a2, ha2, N2, hN2⟩,
  have : a1 * a2 > 0, from mul_pos ha1 ha2,
  cases hlz _ this with N hN,
  let i := max N (max N1 N2),
  have hN' := hN i (le_max_left _ _),
  have hN1' := hN1 i (le_trans (le_max_left _ _) (le_max_right _ _)),
  have hN1' := hN2 i (le_trans (le_max_right _ _) (le_max_right _ _)),
  apply not_le_of_lt hN',
  change _ ≤ abv (_ * _),
  rw is_absolute_value.abv_mul abv,
  apply mul_le_mul; try { assumption },
    { apply le_of_lt ha2 },
    { apply is_absolute_value.abv_nonneg abv }
end

end ring

section comm_ring
variables {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv]

lemma mul_equiv_zero' (g : cau_seq _ abv) {f : cau_seq _ abv} (hf : f ≈ 0) : f * g ≈ 0 :=
by rw mul_comm; apply mul_equiv_zero _ hf

end comm_ring

section integral_domain
variables {β : Type*} [integral_domain β] (abv : β → α) [is_absolute_value abv]

lemma one_not_equiv_zero : ¬ (const abv 1) ≈ (const abv 0) :=
assume h,
have ∀ ε > 0, ∃ i, ∀ k, k ≥ i → abv (1 - 0) < ε, from h,
have h1 : abv 1 ≤ 0, from le_of_not_gt $
  assume h2 : abv 1 > 0,
  exists.elim (this _ h2) $ λ i hi,
    lt_irrefl (abv 1) $ by simpa using hi _ (le_refl _),
have h2 : abv 1 ≥ 0, from is_absolute_value.abv_nonneg _ _,
have abv 1 = 0, from le_antisymm h1 h2,
have (1 : β) = 0, from (is_absolute_value.abv_eq_zero abv).1 this,
absurd this one_ne_zero

end integral_domain

section discrete_field
variables {β : Type*} [discrete_field β] {abv : β → α} [is_absolute_value abv]

theorem inv_aux {f : cau_seq β abv} (hf : ¬ lim_zero f) :
  ∀ ε > 0, ∃ i, ∀ j ≥ i, abv ((f j)⁻¹ - (f i)⁻¹) < ε | ε ε0 :=
let ⟨K, K0, HK⟩ := abv_pos_of_not_lim_zero hf,
    ⟨δ, δ0, Hδ⟩ := rat_inv_continuous_lemma abv ε0 K0,
    ⟨i, H⟩ := exists_forall_ge_and HK (f.cauchy₃ δ0) in
⟨i, λ j ij, let ⟨iK, H'⟩ := H _ (le_refl _) in Hδ (H _ ij).1 iK (H' _ ij)⟩

def inv (f) (hf : ¬ lim_zero f) : cau_seq β abv := ⟨_, inv_aux hf⟩

@[simp] theorem inv_apply {f : cau_seq β abv} (hf i) : inv f hf i = (f i)⁻¹ := rfl

theorem inv_mul_cancel {f : cau_seq β abv} (hf) : inv f hf * f ≈ 1 :=
λ ε ε0, let ⟨K, K0, i, H⟩ := abv_pos_of_not_lim_zero hf in
⟨i, λ j ij,
  by simpa [(abv_pos abv).1 (lt_of_lt_of_le K0 (H _ ij)),
    abv_zero abv] using ε0⟩

theorem const_inv {x : β} (hx : x ≠ 0) : const abv (x⁻¹) = inv (const abv x) (by rwa const_lim_zero) :=
ext (assume n, by simp[inv_apply, const_apply])

end discrete_field

section abs
local notation `const` := const abs

def pos (f : cau_seq α abs) : Prop := ∃ K > 0, ∃ i, ∀ j ≥ i, K ≤ f j

theorem not_lim_zero_of_pos {f : cau_seq α abs} : pos f → ¬ lim_zero f
| ⟨F, F0, hF⟩ H :=
  let ⟨i, h⟩ := exists_forall_ge_and hF (H _ F0),
      ⟨h₁, h₂⟩ := h _ (le_refl _) in
  not_lt_of_le h₁ (abs_lt.1 h₂).2

theorem const_pos {x : α} : pos (const x) ↔ 0 < x :=
⟨λ ⟨K, K0, i, h⟩, lt_of_lt_of_le K0 (h _ (le_refl _)),
 λ h, ⟨x, h, 0, λ j _, le_refl _⟩⟩

theorem add_pos {f g : cau_seq α abs} : pos f → pos g → pos (f + g)
| ⟨F, F0, hF⟩ ⟨G, G0, hG⟩ :=
  let ⟨i, h⟩ := exists_forall_ge_and hF hG in
  ⟨_, _root_.add_pos F0 G0, i,
    λ j ij, let ⟨h₁, h₂⟩ := h _ ij in add_le_add h₁ h₂⟩

theorem pos_add_lim_zero {f g : cau_seq α abs} : pos f → lim_zero g → pos (f + g)
| ⟨F, F0, hF⟩ H :=
  let ⟨i, h⟩ := exists_forall_ge_and hF (H _ (half_pos F0)) in
  ⟨_, half_pos F0, i, λ j ij, begin
    cases h j ij with h₁ h₂,
    have := add_le_add h₁ (le_of_lt (abs_lt.1 h₂).1),
    rwa [← sub_eq_add_neg, sub_self_div_two] at this
  end⟩

theorem mul_pos {f g : cau_seq α abs} : pos f → pos g → pos (f * g)
| ⟨F, F0, hF⟩ ⟨G, G0, hG⟩ :=
  let ⟨i, h⟩ := exists_forall_ge_and hF hG in
  ⟨_, _root_.mul_pos F0 G0, i,
    λ j ij, let ⟨h₁, h₂⟩ := h _ ij in
    mul_le_mul h₁ h₂ (le_of_lt G0) (le_trans (le_of_lt F0) h₁)⟩

theorem trichotomy (f : cau_seq α abs) : pos f ∨ lim_zero f ∨ pos (-f) :=
begin
  cases classical.em (lim_zero f); simp *,
  rcases abv_pos_of_not_lim_zero h with ⟨K, K0, hK⟩,
  rcases exists_forall_ge_and hK (f.cauchy₃ K0) with ⟨i, hi⟩,
  refine (le_total 0 (f i)).imp _ _;
    refine (λ h, ⟨K, K0, i, λ j ij, _⟩);
    have := (hi _ ij).1;
    cases hi _ (le_refl _) with h₁ h₂,
  { rwa abs_of_nonneg at this,
    rw abs_of_nonneg h at h₁,
    exact (le_add_iff_nonneg_right _).1
      (le_trans h₁ $ neg_le_sub_iff_le_add'.1 $
        le_of_lt (abs_lt.1 $ h₂ _ ij).1) },
  { rwa abs_of_nonpos at this,
    rw abs_of_nonpos h at h₁,
    rw [← sub_le_sub_iff_right, zero_sub],
    exact le_trans (le_of_lt (abs_lt.1 $ h₂ _ ij).2) h₁ }
end

instance : has_lt (cau_seq α abs) := ⟨λ f g, pos (g - f)⟩
instance : has_le (cau_seq α abs) := ⟨λ f g, f < g ∨ f ≈ g⟩

theorem lt_of_lt_of_eq {f g h : cau_seq α abs}
  (fg : f < g) (gh : g ≈ h) : f < h :=
by simpa using pos_add_lim_zero fg (neg_lim_zero gh)

theorem lt_of_eq_of_lt {f g h : cau_seq α abs}
  (fg : f ≈ g) (gh : g < h) : f < h :=
by have := pos_add_lim_zero gh (neg_lim_zero fg);
   rwa [← sub_eq_add_neg, sub_sub_sub_cancel_right] at this

theorem lt_trans {f g h : cau_seq α abs} (fg : f < g) (gh : g < h) : f < h :=
by simpa using add_pos fg gh

theorem lt_irrefl {f : cau_seq α abs} : ¬ f < f
| h := not_lim_zero_of_pos h (by simp [zero_lim_zero])

instance : preorder (cau_seq α abs) :=
{ lt := (<),
  le := λ f g, f < g ∨ f ≈ g,
  le_refl := λ f, or.inr (setoid.refl _),
  le_trans := λ f g h fg, match fg with
    | or.inl fg, or.inl gh := or.inl $ lt_trans fg gh
    | or.inl fg, or.inr gh := or.inl $ lt_of_lt_of_eq fg gh
    | or.inr fg, or.inl gh := or.inl $ lt_of_eq_of_lt fg gh
    | or.inr fg, or.inr gh := or.inr $ setoid.trans fg gh
    end,
  lt_iff_le_not_le := λ f g,
    ⟨λ h, ⟨or.inl h,
      not_or (mt (lt_trans h) lt_irrefl) (not_lim_zero_of_pos h)⟩,
    λ ⟨h₁, h₂⟩, h₁.resolve_right
      (mt (λ h, or.inr (setoid.symm h)) h₂)⟩ }

theorem le_antisymm {f g : cau_seq α abs} (fg : f ≤ g) (gf : g ≤ f) : f ≈ g :=
fg.resolve_left (not_lt_of_le gf)

theorem lt_total (f g : cau_seq α abs) : f < g ∨ f ≈ g ∨ g < f :=
(trichotomy (g - f)).imp_right
  (λ h, h.imp (λ h, setoid.symm h) (λ h, by rwa neg_sub at h))

theorem le_total (f g : cau_seq α abs) : f ≤ g ∨ g ≤ f :=
(or.assoc.2 (lt_total f g)).imp_right or.inl

theorem const_lt {x y : α} : const x < const y ↔ x < y :=
show pos _ ↔ _, by rw [← const_sub, const_pos, sub_pos]

theorem const_equiv {x y : α} : const x ≈ const y ↔ x = y :=
show lim_zero _ ↔ _, by rw [← const_sub, const_lim_zero, sub_eq_zero]

theorem const_le {x y : α} : const x ≤ const y ↔ x ≤ y :=
by rw le_iff_lt_or_eq; exact or_congr const_lt const_equiv

theorem exists_gt (f : cau_seq α abs) : ∃ a : α, f < const a :=
let ⟨K, H⟩ := f.bounded in
⟨K + 1, 1, zero_lt_one, 0, λ i _, begin
  rw [sub_apply, const_apply, le_sub_iff_add_le', add_le_add_iff_right],
  exact le_of_lt (abs_lt.1 (H _)).2
end⟩

theorem exists_lt (f : cau_seq α abs) : ∃ a : α, const a < f :=
let ⟨a, h⟩ := (-f).exists_gt in ⟨-a, show pos _,
  by rwa [const_neg, sub_neg_eq_add, add_comm, ← sub_neg_eq_add]⟩

end abs

end cau_seq


import syntax.syntaxCLC
import semantics.playability
import semantics.model
import data.fintype.basic
import logic.relation

local attribute [instance] classical.prop_decidable

open formCLC set

---------------------- Semantics ----------------------

-- def disjunct_rel {agents : Type} {m : modelCLK agents} (G : set agents) :
--   m.f.states →  m.f.states → Prop :=
-- λ s t, ∃ i ∈ G, t ∈ (m.f.rel i s)

def C_path {agents : Type}  {m : modelCLK agents} :
  list agents → list m.f.states →  m.f.states →  m.f.states → Prop
  | list.nil  _        s t := false
  | (i :: is) list.nil s t := t ∈ (m.f.rel i s)
  | (i :: is)(u :: us) s t := (u ∈ (m.f.rel i s) ∧ (C_path is us u t))

def C_path_nil {agents : Type} {m : modelCLK agents} {ss : list m.f.states} {s t : m.f.states} :
  C_path list.nil ss s t → false :=
begin
  intro hC,
  induction ss,
  repeat
  { simp[C_path] at hC,
    exact hC, },
end

-- @[simp]
-- protected def formCLC.sizeof' (agents : Type) [agents_inst : has_sizeof agents] : formCLC agents → ℕ
-- | bot := 1
-- | (var n) := 1 + sizeof n
-- | (imp φ ψ) := 1 + formCLC.sizeof' φ + formCLC.sizeof' ψ
-- | (and φ ψ) := 1 + formCLC.sizeof' φ + formCLC.sizeof' ψ
-- | ([G] φ) := 1 + sizeof G + formCLC.sizeof' φ
-- | (k i φ) := 1 + sizeof i + formCLC.sizeof' φ
-- | (e i φ) := 1 + sizeof i + formCLC.sizeof' φ + 1 -- Make recursion from E' to K' possible
-- | (c i φ) := 1 + sizeof i + formCLC.sizeof' φ

-- def formCLC.has_sizeof' {agents} : has_sizeof (formCLC agents) := ⟨formCLC.sizeof' _⟩
-- local attribute [instance] formCLC.has_sizeof'

-- Definition of semantic entailment
-- Order of arguments is swapped to help the equation compiler find the recursive parameter
def s_entails_CLC {agents : Type}  : Π (m : modelCLK agents), m.f.states → formCLC agents → Prop
  | m s bot       := false
  | m s (var n)   := s ∈ m.v n
  | m s (imp φ ψ) := (s_entails_CLC m s φ) → (s_entails_CLC m s ψ)
  | m s (and φ ψ) := (s_entails_CLC m s φ) ∧ (s_entails_CLC m s ψ)
  | m s ([G] φ)   := {t : m.f.states | s_entails_CLC m t φ} ∈ m.f.E.E (s) (G)
  | m s (k i φ)   := ∀ t : m.f.states, t ∈ (m.f.rel i s) → s_entails_CLC m t φ
  -- | m (e G φ)   s := ∀ i ∈ G, (s_entails_CLC.aux m (k i φ) s)
  | m s (c G φ)   := ∀ t : m.f.states, (∃ la, (∀ a ∈ la, a ∈ G) ∧ ∃ ls, C_path la ls s t) →
                        s_entails_CLC m t φ
  -- | m (c G φ)   s := ∀ t : m.f.states, (relation.trans_gen (disjunct_rel G) s t) → s_entails_CLC.aux m φ t

-- -- Definition of semantic entailment
-- def s_entails_CLC {agents : Type} (m : modelCLK agents) (s : m.f.states) (φ : formCLC agents) : Prop :=
-- s_entails_CLC.aux m φ s

-- def tilde (m: modelCLC agents) (φ : formCLC agents)  :=
-- {t: m.f.states | s_entails m t φ}
lemma s_entails_CLC_conjunction {agents : Type} {m : modelCLK agents} {s : m.f.states}
  {φs : list (formCLC agents)} :
  s_entails_CLC m s (finite_conjunction φs) ↔ ∀ φ ∈ φs, s_entails_CLC m s φ :=
begin
  induction φs with φ φs ih,
  { simp [finite_conjunction],
    show s_entails_CLC m s ⊤,
    simp [s_entails_CLC], },
  { unfold finite_conjunction,
    show s_entails_CLC m s (φ & finite_conjunction φs) ↔ _,
    simp [s_entails_CLC],
    intros h,
    exact ih, },
end

variables {agents : Type}

-- φ is valid in a model M = (f,v)
def valid_m (m: modelCLK agents) (φ : formCLC agents) :=
  ∀ s, s_entails_CLC m s φ

def global_valid (φ : formCLC agents) :=
  ∀ m, valid_m m φ

-- -- φ is valid in a frame f
-- def f_valid (φ : formCL agents) (f : frame agents) :=
--   ∀ v s, s_entails f v s φ

-- -- φ is valid in a class of frames F
-- def F_valid (φ : formCL agents) (F : set (frame agents)) :=
--   ∀ f ∈ F, ∀ v s, s_entails f v s φ

-- -- φ is universally valid (valid in all frames)
-- def u_valid (φ : formCL agents) :=
--   ∀ f v s, s_entails f v s φ

-- A context is true at a world in a model if each
-- formula of the context is true at that world in that model
-- def s_entails_ctx (m : modelCL agents)
--   := ∀ φ, ∀ s, s_entails m s φ

-- Global semantic consequence
-- def global_sem_csq (φ : formCL agents) :=
--   ∀ m s, s_entails m s φ

lemma not_s_entails_imp (m : modelCLK agents) : ∀ s φ,
  (¬ (s_entails_CLC m s φ)) ↔ (s_entails_CLC m s (¬ φ)) :=
begin
  intros s φ,
  unfold s_entails_CLC,
  refl
end

-- lemma s_entails_exists {f : frame} {v : nat → f.states → Prop} {x : f.states} {φ : form} :
--   s_entails f v x (◇φ) ↔ ∃ y : f.states, (f.rel x y ∧ s_entails f v y φ) :=
-- begin
-- split, intro h1,
-- repeat {rw s_entails at h1},
-- have h2 := not_or_of_imp h1,
-- cases h2, push_neg at h2,
-- cases h2 with y h2, cases h2 with h2 h3,
-- existsi (y : f.states), split, exact h2,
-- have h4 := (not_s_entails_imp f v y (¬φ)).mp h3,
-- repeat {rw s_entails at h4}, repeat {rw imp_false at h4},
-- rw not_not at h4, exact h4,
-- exact false.elim h2,
-- intro h1, cases h1 with y h1,
-- cases h1 with h1 h2,
-- intro h3,
-- exact absurd h2 (h3 y h1)
-- ends


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import category_theory.opposites

/-!
# Morphisms from equations between objects.

When working categorically, sometimes one encounters an equation `h : X = Y` between objects.

Your initial aversion to this is natural and appropriate:
you're in for some trouble, and if there is another way to approach the problem that won't
rely on this equality, it may be worth pursuing.

You have two options:
1. Use the equality `h` as one normally would in Lean (e.g. using `rw` and `subst`).
   This may immediately cause difficulties, because in category theory everything is dependently
   typed, and equations between objects quickly lead to nasty goals with `eq.rec`.
2. Promote `h` to a morphism using `eq_to_hom h : X ⟶ Y`, or `eq_to_iso h : X ≅ Y`.

This file introduces various `simp` lemmas which in favourable circumstances
result in the various `eq_to_hom` morphisms to drop out at the appropriate moment!
-/

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

namespace category_theory
open opposite

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

/--
An equality `X = Y` gives us a morphism `X ⟶ Y`.

It is typically better to use this, rather than rewriting by the equality then using `𝟙 _`
which usually leads to dependent type theory hell.
-/
def eq_to_hom {X Y : C} (p : X = Y) : X ⟶ Y := by rw p; exact 𝟙 _

@[simp] lemma eq_to_hom_refl (X : C) (p : X = X) : eq_to_hom p = 𝟙 X := rfl
@[simp, reassoc] lemma eq_to_hom_trans {X Y Z : C} (p : X = Y) (q : Y = Z) :
  eq_to_hom p ≫ eq_to_hom q = eq_to_hom (p.trans q) :=
by { cases p, cases q, simp, }

/--
If we (perhaps unintentionally) perform equational rewriting on
the source object of a morphism,
we can replace the resulting `_.mpr f` term by a composition with an `eq_to_hom`.

It may be advisable to introduce any necessary `eq_to_hom` morphisms manually,
rather than relying on this lemma firing.
-/
@[simp]
lemma congr_arg_mpr_hom_left {X Y Z : C} (p : X = Y) (q : Y ⟶ Z) :
  (congr_arg (λ W : C, W ⟶ Z) p).mpr q = eq_to_hom p ≫ q :=
by { cases p, simp, }

/--
If we (perhaps unintentionally) perform equational rewriting on
the target object of a morphism,
we can replace the resulting `_.mpr f` term by a composition with an `eq_to_hom`.

It may be advisable to introduce any necessary `eq_to_hom` morphisms manually,
rather than relying on this lemma firing.
-/
@[simp]
lemma congr_arg_mpr_hom_right {X Y Z : C} (p : X ⟶ Y) (q : Z = Y) :
  (congr_arg (λ W : C, X ⟶ W) q).mpr p = p ≫ eq_to_hom q.symm :=
by { cases q, simp, }

/--
An equality `X = Y` gives us an isomorphism `X ≅ Y`.

It is typically better to use this, rather than rewriting by the equality then using `iso.refl _`
which usually leads to dependent type theory hell.
-/
def eq_to_iso {X Y : C} (p : X = Y) : X ≅ Y :=
⟨eq_to_hom p, eq_to_hom p.symm, by simp, by simp⟩

@[simp] lemma eq_to_iso.hom {X Y : C} (p : X = Y) : (eq_to_iso p).hom = eq_to_hom p :=
rfl
@[simp] lemma eq_to_iso.inv {X Y : C} (p : X = Y) : (eq_to_iso p).inv = eq_to_hom p.symm :=
rfl

@[simp]

@[simp] lemma eq_to_hom_op {X Y : C} (h : X = Y) :
  (eq_to_hom h).op = eq_to_hom (congr_arg op h.symm) :=
by { cases h, refl, }

@[simp] lemma eq_to_hom_unop {X Y : Cᵒᵖ} (h : X = Y) :
  (eq_to_hom h).unop = eq_to_hom (congr_arg unop h.symm) :=
by { cases h, refl, }

instance {X Y : C} (h : X = Y) : is_iso (eq_to_hom h) := is_iso.of_iso (eq_to_iso h)

@[simp] lemma inv_eq_to_hom {X Y : C} (h : X = Y) : inv (eq_to_hom h) = eq_to_hom h.symm :=
by { ext, simp, }

variables {D : Type u₂} [category.{v₂} D]

namespace functor

/-- Proving equality between functors. This isn't an extensionality lemma,
  because usually you don't really want to do this. -/
lemma ext {F G : C ⥤ D} (h_obj : ∀ X, F.obj X = G.obj X)
  (h_map : ∀ X Y f, F.map f = eq_to_hom (h_obj X) ≫ G.map f ≫ eq_to_hom (h_obj Y).symm) :
  F = G :=
begin
  cases F with F_obj _ _ _, cases G with G_obj _ _ _,
  have : F_obj = G_obj, by ext X; apply h_obj,
  subst this,
  congr,
  funext X Y f,
  simpa using h_map X Y f
end

/-- Proving equality between functors using heterogeneous equality. -/
lemma hext {F G : C ⥤ D} (h_obj : ∀ X, F.obj X = G.obj X)
  (h_map : ∀ X Y (f : X ⟶ Y), F.map f == G.map f) : F = G :=
begin
  cases F with F_obj _ _ _, cases G with G_obj _ _ _,
  have : F_obj = G_obj, by ext X; apply h_obj,
  subst this,
  congr,
  funext X Y f,
  exact eq_of_heq (h_map X Y f)
end

-- Using equalities between functors.

lemma congr_obj {F G : C ⥤ D} (h : F = G) (X) : F.obj X = G.obj X :=
by subst h

lemma congr_hom {F G : C ⥤ D} (h : F = G) {X Y} (f : X ⟶ Y) :
  F.map f = eq_to_hom (congr_obj h X) ≫ G.map f ≫ eq_to_hom (congr_obj h Y).symm :=
by subst h; simp

end functor

@[simp] lemma eq_to_hom_map (F : C ⥤ D) {X Y : C} (p : X = Y) :
  F.map (eq_to_hom p) = eq_to_hom (congr_arg F.obj p) :=
by cases p; simp

@[simp] lemma eq_to_iso_map (F : C ⥤ D) {X Y : C} (p : X = Y) :
  F.map_iso (eq_to_iso p) = eq_to_iso (congr_arg F.obj p) :=
by ext; cases p; simp

@[simp] lemma eq_to_hom_app {F G : C ⥤ D} (h : F = G) (X : C) :
  (eq_to_hom h : F ⟶ G).app X = eq_to_hom (functor.congr_obj h X) :=
by subst h; refl

lemma nat_trans.congr {F G : C ⥤ D} (α : F ⟶ G) {X Y : C} (h : X = Y) :
  α.app X = F.map (eq_to_hom h) ≫ α.app Y ≫ G.map (eq_to_hom h.symm) :=
by { rw [α.naturality_assoc], simp }

lemma eq_conj_eq_to_hom {X Y : C} (f : X ⟶ Y) :
  f = eq_to_hom rfl ≫ f ≫ eq_to_hom rfl :=
by simp only [category.id_comp, eq_to_hom_refl, category.comp_id]

end category_theory