/-
Copyright (c) 2022 Jun Yoshida. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import Mathlib.CategoryTheory.Category.Basic
import Mathlib.CategoryTheory.Functor.Basic
import Mathlib.CategoryTheory.Functor.Category
import Mathlib.CategoryTheory.NatTrans

import Moncalc.Data.DVect2.Basic
import Moncalc.CategoryTheory.List.Basic
import Moncalc.CategoryTheory.List.Functor

/-!
# The 2-monad structure on `(List,List.mapF)`

As shown in the file `CategoryTheory.List.Functor`, the pair `(List,List.mapF)` admits a structure of a 2-endofunctor on the 2-category Cat of (small) categories.
In this file, we further show that it also admits a 2-monad structure consisting of `List.join` on objects and `DVect2.join` on morphisms.

-/
namespace CategoryTheory.List

universe u v w

/-!
## Compatibility of `(List,List.mapF)` and `append`
-/
namespace appendF

variable {α : Type u} [Category α] {β : Type v} [Category β] (F : Functor α β)

/-
@[simp]
protected
theorem naturality_obj {β : Type v} [Category β] (F : Functor α β) : ∀ {as₁ as₂ : List α}, (mapF.obj F).obj (as₁ ++ as₂) = (mapF.obj F).obj as₁ ++ (mapF.obj F).obj as₂ :=
  List.map_append F.obj _ _
-/

protected
def naturatorLax : (as₁ as₂ : List α) → ((mapF.obj F).obj as₁ ++ (mapF.obj F).obj as₂ ⟶ (mapF.obj F).obj (as₁ ++ as₂))
| [], as₂ => 𝟙 ((mapF.obj F).obj as₂)
| (_::as₁), as₂ => DVect2.cons (𝟙 _) (appendF.naturatorLax as₁ as₂)

protected
lemma naturatorLax_naturality {as₁ as₂ bs₁ bs₂ : List α} {fs : as₁ ⟶ bs₁} {gs : as₂ ⟶ bs₂} : ((mapF.obj F).map fs ++ (mapF.obj F).map gs) ≫ appendF.naturatorLax F bs₁ bs₂ = appendF.naturatorLax F as₁ as₂ ≫ (mapF.obj F).map (fs ++ gs) := by
  induction fs
  case nil =>
    dsimp [appendF.naturatorLax]
    rw [Category.comp_id (Y:=(mapF.obj F).obj bs₂)]
    rw [Category.id_comp (X:=(mapF.obj F).obj as₂)]
    rfl
  case cons f fs h_ind =>
    dsimp [appendF.naturatorLax]
    conv =>
      lhs
      rw [DVect2.cons_append, comp_cons]
      rw [Category.comp_id]
    conv =>
      rhs
      rw [DVect2.cons_append]
      dsimp
      rw [Category.id_comp]
    rw [h_ind]

protected
def naturatorOplax : (as₁ as₂ : List α) → ((mapF.obj F).obj (as₁ ++ as₂) ⟶ (mapF.obj F).obj as₁ ++ (mapF.obj F).obj as₂)
| [], as₂ => 𝟙 ((mapF.obj F).obj as₂)
| (_::as₁), as₂ => DVect2.cons (𝟙 _) (appendF.naturatorOplax as₁ as₂)

protected
lemma naturatorOplax_naturality {as₁ as₂ bs₁ bs₂ : List α} {fs : as₁ ⟶ bs₁} {gs : as₂ ⟶ bs₂} : ((mapF.obj F).map (fs ++ gs)) ≫ appendF.naturatorOplax F bs₁ bs₂ = appendF.naturatorOplax F as₁ as₂ ≫ ((mapF.obj F).map fs ++ (mapF.obj F).map gs) := by
  induction fs
  case nil =>
    dsimp [appendF.naturatorOplax]
    rw [Category.comp_id, Category.id_comp]
    rfl
  case cons f fs h_ind =>
    dsimp [appendF.naturatorOplax]
    conv =>
      lhs
      rw [DVect2.cons_append]
      dsimp
      rw [Category.comp_id]
    conv =>
      rhs
      rw [DVect2.cons_append]
      dsimp
      rw [Category.id_comp]
    rw [h_ind]

@[simp]
protected
theorem naturator_lax_oplax (as₁ as₂ : List α) : appendF.naturatorLax F as₁ as₂ ≫ appendF.naturatorOplax F as₁ as₂ = 𝟙 ((mapF.obj F).obj as₁ ++ (mapF.obj F).obj as₂) := by
  induction as₁
  case nil =>
    dsimp [appendF.naturatorLax, appendF.naturatorOplax]
    rw [Category.id_comp (X:=(mapF.obj F).obj as₂)]
    rfl
  case cons a as₁ h_ind =>
    dsimp [appendF.naturatorLax, appendF.naturatorOplax]
    rw [Category.id_comp]
    rw [h_ind]

@[simp]
protected
theorem naturator_oplax_lax (as₁ as₂ : List α) : appendF.naturatorOplax F as₁ as₂ ≫ appendF.naturatorLax F as₁ as₂ = 𝟙 ((mapF.obj F).obj (as₁ ++ as₂)) := by
  induction as₁
  case nil =>
    dsimp [appendF.naturatorLax, appendF.naturatorOplax]
    rw [Category.id_comp]
  case cons a as₁ h_ind =>
    dsimp [appendF.naturatorLax, appendF.naturatorOplax]
    rw [Category.id_comp]
    rw [h_ind]

end appendF

namespace joinF

/-!
### Naturality of `List.joinF`
-/
section naturality

variable {α : Type u} [Category α] {β : Type v} [Category β] (F : Functor α β)

--- Naturality as an equality
protected
theorem naturality : mapF.obj (mapF.obj F) ⋙ joinF (α:=β) = joinF (α:=α) ⋙ mapF.obj F := by
  apply eqF_List
  . intro ass
    induction ass
    case a.nil => rfl
    case a.cons as ass h_ind =>
      dsimp at *
      have : ∀ (as bs : List α), (mapF.obj F).obj (as++bs) = (mapF.obj F).obj as ++ (mapF.obj F).obj bs :=
        λ as bs => List.map_append F.obj _ _
      rw [this, h_ind]
  . intros as₁ as₂ fs
    induction fs
    case a.nil => exact DVect2.Eq.nil_rfl
    case a.cons f fs h_ind =>
      dsimp
      have : ∀ {as₁ as₂ bs₁ bs₂ : List α} (fs₁ : as₁ ⟶ bs₁) (fs₂ : as₂ ⟶ bs₂), DVect2.Eq ((mapF.obj F).map (fs₁ ++ fs₂)) ((mapF.obj F).map fs₁ ++ (mapF.obj F).map fs₂) :=
        λ fs₁ fs₂ => DVect2.map_append F.obj F.obj F.map
      apply DVect2.Eq.trans _ (this f (joinF.map fs)).symm
      apply DVect2.eq_of_eq_append_eq (DVect2.Eq.of rfl) h_ind

set_option autoImplicit false

protected
def naturatorLax : (ass : List (List α)) → ((joinF (α:=α) ⋙ mapF.obj F).obj ass ⟶ (mapF.obj (mapF.obj F) ⋙ joinF (α:=β)).obj ass)
| [] => DVect2.nil
| (as::ass) =>
  appendF.naturatorOplax F as ((joinF (α:=α)).obj ass) ≫ ((mapF.obj F).map (𝟙 as) ++ joinF.naturatorLax ass)

protected
def naturatorOplax : (ass : List (List α)) → ((mapF.obj (mapF.obj F) ⋙ joinF (α:=β)).obj ass ⟶ (joinF (α:=α) ⋙ mapF.obj F).obj ass)
| [] => DVect2.nil
| (as::ass) => by
  dsimp
  exact ((mapF.obj F).map (𝟙 as) ++ joinF.naturatorOplax ass) ≫ appendF.naturatorLax F as ((joinF (α:=α)).obj ass)

--- Naturality as a natural isomorphism
protected
def naturator : joinF (α:=α) ⋙ mapF.obj F ≅ mapF.obj (mapF.obj F) ⋙ joinF (α:=β) where
  hom := {
    app := joinF.naturatorLax F
    naturality := by
      intro _ _ fss
      induction fss
      case nil => rfl
      case cons fs fss h_ind =>
        dsimp only [joinF.naturatorLax]
        conv =>
          lhs; rw [←Category.assoc]
          change ((mapF.obj F).map (fs ++ joinF.map fss) ≫ appendF.naturatorOplax F _ ((joinF (α:=α)).obj _)) ≫ (Prefunctor.map (Prefunctor.obj mapF.toPrefunctor F).toPrefunctor (𝟙 _) ++ joinF.naturatorLax F _)
          rw [appendF.naturatorOplax_naturality F (fs:=fs)]
          rw [Category.assoc]
          rhs
          rw [appendF.map_comp, (mapF.obj F).map_id, Category.comp_id]
          rhs
          change (joinF ⋙ mapF.obj F).map fss ≫ joinF.naturatorLax F _
          rw [h_ind]
        conv =>
          rhs; rw [Category.assoc]; rhs
          dsimp
          rw [appendF.map_comp, (mapF.obj F).map_id, Category.id_comp]
  }
  inv := {
    app := joinF.naturatorOplax F
    naturality := by
      intro _ _ fss
      induction fss
      case nil => rfl
      case cons fs fss h_ind =>
        dsimp [joinF.naturatorOplax]
        conv =>
          lhs; rw [←Category.assoc, appendF.map_comp, (mapF.obj F).map_id]
          rw [Category.comp_id]
          lhs; rhs
          change (mapF.obj (mapF.obj F) ⋙ joinF).map fss ≫ joinF.naturatorOplax F _
          rw [h_ind]
        conv =>
          rhs; rw [Category.assoc]
          rw [←appendF.naturatorLax_naturality F (fs:=fs)]
          rw [←Category.assoc]
          rw [appendF.map_comp, (mapF.obj F).map_id, Category.id_comp]
  }
  hom_inv_id := by
    ext ass; dsimp
    induction ass
    case nil => rfl
    case cons as ass h_ind =>
      dsimp [joinF.naturatorLax, joinF.naturatorOplax]
      conv =>
        lhs; rw [Category.assoc]; rhs; rw [←Category.assoc]; lhs
        rw [appendF.map_comp, (mapF.obj F).map_id, Category.id_comp]
        rw [h_ind, appendF.map_id]
      rw [Category.id_comp, appendF.naturator_oplax_lax]
  inv_hom_id := by
    ext ass; dsimp
    induction ass
    case nil => rfl
    case cons as ass h_ind =>
      dsimp [joinF.naturatorLax, joinF.naturatorOplax]
      conv =>
        lhs; rw [Category.assoc]; rhs; rw [←Category.assoc]; lhs
        rw [appendF.naturator_lax_oplax]
      rw [Category.id_comp]
      rw [appendF.map_comp, (mapF.obj F).map_id, h_ind, Category.id_comp]
      exact appendF.map_id

end naturality

end joinF

/-!
## `List.singletonF` the embedding of a category `α` into `List α`
-/

--- The functorial embedding of `α` into `List α`.
def singletonF {α : Type u} [Category α] : Functor α (List α) where
  obj := λ a => [a]
  map := λ f => DVect2.cons f DVect2.nil

namespace singletonF

variable {α : Type u} [Category α] {β : Type v} [Category β] (F : Functor α β)

--- 2-naturality as equality
protected
theorem naturality : singletonF ⋙ mapF.obj F = F ⋙ singletonF := rfl

protected
def naturator : singletonF ⋙ mapF.obj F ≅ F ⋙ singletonF :=
  Iso.refl _

end singletonF

/-!
## 2-monad structure
-/

namespace joinF

variable {α : Type u} [Category α]

/-!
### Monad laws as equations
-/

--- Left unitality of `List.joinF` with respect to `List.singletonF` as an equality.
@[simp]
protected
theorem unit_left : singletonF (α:=List α) ⋙ joinF = 𝟭 (List α) := by
  dsimp [Functor.comp, Functor.id]
  dsimp [singletonF, joinF, DVect2.join]
  apply eqF_List
  . intro as
    dsimp
    exact List.append_nil as
  . intro as bs fs
    dsimp
    exact DVect2.append_nil _

--- Right unitality of `List.joinF` with respect to `List.singletonF` as an equality.
@[simp]
protected
theorem unit_right : mapF.obj singletonF ⋙ joinF = Functor.id (List α) := by
  dsimp [Functor.comp, Functor.id]
  dsimp [singletonF, joinF, mapF, DVect2.join]
  apply eqF_List <;> dsimp
  . intro as
    induction as
    case a.nil => rfl
    case a.cons a as h_ind => dsimp; rw [h_ind]
  . intro as bs fs
    induction fs
    case a.nil =>
      dsimp [DVect2.map, DVect2.join]
      exact DVect2.Eq.of rfl
    case a.cons a as b bs f fs h_ind =>
      dsimp [DVect2.map, DVect2.join]
      rw [DVect2.cons_append, DVect2.nil_append]
      exact DVect2.Eq.descend rfl h_ind

--- Two different ways to flatten `List (List (List α))` with the `joinF` functor result in (strictly) the same.
protected
theorem assoc : joinF (α:=List α) ⋙ joinF = mapF.obj joinF ⋙ joinF := by
  dsimp [Functor.comp, joinF, mapF]
  apply eqF_List <;> dsimp
  . intros; exact List.join_join _
  . intros; exact DVect2.join_join _

/-!
### Monad laws as natural isomorphisms
-/

protected
def unitorLeftLax : (as : List α) → (as ⟶ ((singletonF (α:=List α) ⋙ joinF).obj as))
| [] => 𝟙 []
| (a::as) => DVect2.cons (𝟙 a) (joinF.unitorLeftLax as)

protected
def unitorLeftOplax : (as : List α) → (((singletonF (α:=List α) ⋙ joinF).obj as) ⟶ as)
| [] => 𝟙 []
| (a::as) => DVect2.cons (𝟙 a) (joinF.unitorLeftOplax as)

@[simp]
protected
lemma unitorLeft_lax_oplax (as : List α) : joinF.unitorLeftLax as ≫ joinF.unitorLeftOplax as = 𝟙 as := by
  induction as
  case nil => rfl
  case cons a as h_ind =>
    dsimp [joinF.unitorLeftLax, joinF.unitorLeftOplax]
    rw [h_ind, Category.id_comp]

@[simp]
protected
lemma unitorLeft_oplax_lax (as : List α) : joinF.unitorLeftOplax as ≫ joinF.unitorLeftLax as = 𝟙 _ := by
  induction as
  case nil => rfl
  case cons a as h_ind =>
    dsimp [joinF.unitorLeftLax, joinF.unitorLeftOplax]
    rw [h_ind, Category.id_comp]
    rfl

--- Left unitality of `List.joinF` with respect to `List.singletonF` as a natural isomorphism
protected
def unitorLeft : 𝟭 (List α) ≅ singletonF (α:=List α) ⋙ joinF where
  hom := {
    app := joinF.unitorLeftLax
    naturality := by
      intro _ _ fs
      dsimp [Functor.id]
      induction fs
      case nil => rfl
      case cons f fs h_ind =>
        dsimp [joinF.unitorLeftLax, joinF.unitorLeftOplax]
        rw [Category.comp_id, h_ind]
        dsimp [singletonF, joinF, DVect2.join]
        rw [DVect2.cons_append, comp_cons, Category.id_comp]
  }
  inv := {
    app := joinF.unitorLeftOplax
    naturality := by
      intro _ _ fs
      dsimp [Functor.id]
      induction fs
      case nil => rfl
      case cons f fs h_ind =>
        dsimp [joinF.unitorLeftLax, joinF.unitorLeftOplax]
        dsimp [singletonF, joinF, DVect2.join] at *
        rw [DVect2.cons_append, comp_cons, Category.id_comp, Category.comp_id]
        rw [h_ind]
  }
  hom_inv_id := by ext; intros; simp
  inv_hom_id := by ext; intros; simp

protected
def unitorRightLax : (as : List α) → (as ⟶ (mapF.obj (singletonF (α:=α)) ⋙ joinF).obj as)
| [] => 𝟙 []
| (a::as) => DVect2.cons (𝟙 a) (joinF.unitorRightLax as)

protected
def unitorRightOplax : (as : List α) → ((mapF.obj (singletonF (α:=α)) ⋙ joinF).obj as ⟶ as)
| [] => 𝟙 []
| (a::as) => DVect2.cons (𝟙 a) (joinF.unitorRightOplax as)

@[simp]
protected
lemma unitorRight_lax_oplax (as : List α) : joinF.unitorRightLax as ≫ joinF.unitorRightOplax as = 𝟙 as := by
  induction as
  case nil => rfl
  case cons a as h_ind =>
    dsimp [joinF.unitorRightLax, joinF.unitorRightOplax]
    rw [Category.id_comp, h_ind]

@[simp]
protected
lemma unitorRight_oplax_lax (as : List α) : joinF.unitorRightOplax as ≫ joinF.unitorRightLax as = 𝟙 _ := by
  induction as
  case nil => rfl
  case cons a as h_ind =>
    dsimp [joinF.unitorRightLax, joinF.unitorRightOplax]
    rw [Category.id_comp, h_ind]
    rfl

protected
def unitorRight : 𝟭 (List α) ≅ mapF.obj (singletonF (α:=α)) ⋙ joinF where
  hom := {
    app := joinF.unitorRightLax
    naturality := by
      intro _ _ fs; dsimp
      induction fs
      case nil => rfl
      case cons f fs h_ind =>
        dsimp [joinF.unitorRightLax]
        rw [Category.comp_id, h_ind]
        dsimp [singletonF, HAppend.hAppend, DVect2.append]
        rw [Category.id_comp]
  }
  inv := {
    app := joinF.unitorRightOplax
    naturality := by
      intro _ _ fs; dsimp
      induction fs
      case nil => rfl
      case cons f fs h_ind =>
        dsimp [joinF.unitorRightOplax]
        rw [←h_ind]
        dsimp [singletonF, HAppend.hAppend, DVect2.append]
        rw [Category.comp_id, Category.id_comp]
  }
  hom_inv_id := by ext; intros; simp
  inv_hom_id := by ext; intros; simp

@[irreducible]
protected
def associatorLeft : (asss : List (List (List α))) → ((mapF.obj (joinF (α:=α)) ⋙ joinF).obj asss ⟶ (joinF (α:=List α) ⋙ joinF).obj asss) :=
  let rec aux : (as : List α) → (ass : List (List α)) → (asss : List (List (List α))) → ((mapF.obj (joinF (α:=α)) ⋙ joinF).obj ((as::ass)::asss) ⟶ (joinF (α:=List α) ⋙ joinF).obj ((as::ass)::asss))
  | [], [], [] => 𝟙 []
  | [], [], (ass::asss) => aux [] ass asss
  | [], (as::ass), asss => aux as ass asss
  | (a::as), ass, asss => DVect2.cons (𝟙 a) (aux as ass asss)
  aux [] []
termination_by aux as ass asss => (asss.length, ass.length, as.length)

@[simp]
protected
lemma associatorLeft_nil : joinF.associatorLeft (α:=α) [] = 𝟙 [] :=
  by unfold joinF.associatorLeft; rfl

@[simp]
protected
lemma associatorLeft_cons_nil {asss : List (List (List α))} : joinF.associatorLeft ([]::asss) = joinF.associatorLeft asss :=
  by unfold joinF.associatorLeft; rfl

@[simp]
protected
lemma associatorLeft_cons_cons_nil {ass : List (List α)} {asss : List (List (List α))} : joinF.associatorLeft (([]::ass)::asss) = joinF.associatorLeft (ass::asss) :=
by
  unfold joinF.associatorLeft
  conv => lhs; unfold associatorLeft.aux; unfold associatorLeft.aux

@[simp]
protected
lemma associatorLeft_cons_cons_cons {a : α} {as : List α} {ass : List (List α)} {asss : List (List (List α))} : joinF.associatorLeft (((a::as)::ass)::asss) = DVect2.cons (𝟙 a) (joinF.associatorLeft ((as::ass)::asss)) := by
  unfold joinF.associatorLeft
  unfold joinF.associatorLeft.aux
  unfold joinF.associatorLeft.aux
  conv => lhs; unfold joinF.associatorLeft.aux

@[irreducible]
protected
def associatorRight : (asss : List (List (List α))) → ((joinF (α:=List α) ⋙ joinF).obj asss ⟶ (mapF.obj (joinF (α:=α)) ⋙ joinF).obj asss) :=
  let rec aux : (as : List α) → (ass : List (List α)) → (asss : List (List (List α))) → ((joinF (α:=List α) ⋙ joinF).obj ((as::ass)::asss) ⟶ (mapF.obj (joinF (α:=α)) ⋙ joinF).obj ((as::ass)::asss))
  | [], [], [] => 𝟙 []
  | [], [], (ass::asss) => aux [] ass asss
  | [], (as::ass), asss => aux as ass asss
  | (a::as), ass, asss => DVect2.cons (𝟙 a) (aux as ass asss)
  aux [] []
termination_by aux as ass asss => (asss.length, ass.length, as.length)

@[simp]
protected
lemma associatorRight_nil : joinF.associatorRight (α:=α) [] = 𝟙 [] :=
  by unfold joinF.associatorRight; rfl

@[simp]
protected
lemma associatorRight_cons_nil {asss : List (List (List α))} : joinF.associatorRight ([]::asss) = joinF.associatorRight asss :=
  by unfold joinF.associatorRight; rfl

@[simp]
protected
lemma associatorRight_cons_cons_nil {ass : List (List α)} {asss : List (List (List α))} : joinF.associatorRight (([]::ass)::asss) = joinF.associatorRight (ass::asss) :=
by
  unfold joinF.associatorRight
  conv => lhs; unfold associatorRight.aux; unfold associatorRight.aux

@[simp]
protected
lemma associatorRight_cons_cons_cons {a : α} {as : List α} {ass : List (List α)} {asss : List (List (List α))} : joinF.associatorRight (((a::as)::ass)::asss) = DVect2.cons (𝟙 a) (joinF.associatorRight ((as::ass)::asss)) := by
  unfold joinF.associatorRight
  unfold joinF.associatorRight.aux
  unfold joinF.associatorRight.aux
  conv => lhs; unfold joinF.associatorRight.aux

@[simp]
protected
lemma associator_left_right (asss : List (List (List α))) : joinF.associatorLeft asss ≫ joinF.associatorRight asss = 𝟙 _ := by
  induction asss
  case nil => rfl
  case cons ass asss h_indsss =>
    induction ass
    case nil => simp; exact h_indsss
    case cons as ass h_indss =>
      induction as
      case nil => simp; exact h_indss
      case cons a as h_inds => simp; rw [h_inds]; rfl

@[simp]
protected
lemma associator_right_left (asss : List (List (List α))) : joinF.associatorRight asss ≫ joinF.associatorLeft asss = 𝟙 _ := by
  induction asss
  case nil => rfl
  case cons ass asss h_indsss =>
    induction ass
    case nil => simp; exact h_indsss
    case cons as ass h_indss =>
      induction as
      case nil => simp; exact h_indss
      case cons a as h_inds => simp; rw [h_inds]; rfl

protected
def associator : (mapF.obj joinF ⋙ joinF) ≅ (joinF (α:=List α) ⋙ joinF) where
  hom := {
    app := joinF.associatorLeft
    naturality := by
      intro _ _ fsss
      induction fsss
      case nil => rfl
      case cons fss fsss h_indss =>
        induction fss
        case nil =>
          conv => lhs; lhs; simp; change (mapF.obj joinF ⋙ joinF).map fsss
          simp only [joinF.associatorLeft_cons_nil]
          rw [h_indss]
          rfl
        case cons fs fss h_inds  =>
          induction fs
          case nil =>
            conv =>
              lhs; lhs; simp; rw [DVect2.nil_append]; simp
              change (mapF.obj joinF ⋙ joinF).map (DVect2.cons fss fsss)
            simp only [joinF.associatorLeft_cons_cons_nil]
            rw [h_inds]
            rfl
          case cons f fs h_ind =>
            conv =>
              lhs; lhs; simp; rw [DVect2.cons_append]; simp
              rw [DVect2.cons_append]
              change DVect2.cons f ((mapF.obj joinF ⋙ joinF).map (DVect2.cons (DVect2.cons fs fss) fsss))
            conv =>
              rhs; rhs; change DVect2.cons f ((joinF ⋙ joinF).map (DVect2.cons (DVect2.cons fs fss) fsss))
            simp only [joinF.associatorLeft_cons_cons_cons]
            rw [comp_cons, comp_cons]
            rw [h_ind, Category.comp_id, Category.id_comp]
  }
  inv := {
    app := joinF.associatorRight
    naturality := by
      intro _ _ fsss
      induction fsss
      case nil => rfl
      case cons fss fsss h_indss =>
        induction fss
        case nil =>
          conv => lhs; lhs; simp; change (joinF ⋙ joinF).map fsss
          simp only [joinF.associatorRight_cons_nil]
          rw [h_indss]
          rfl
        case cons fs fss h_inds  =>
          induction fs
          case nil =>
            conv =>
              lhs; lhs; simp; rw [DVect2.cons_append]; simp
              change (joinF ⋙ joinF).map (DVect2.cons fss fsss)
            simp only [joinF.associatorRight_cons_cons_nil]
            rw [h_inds]
            rfl
          case cons f fs h_ind =>
            conv =>
              lhs; lhs; simp; rw [DVect2.cons_append]; simp
              rw [DVect2.cons_append]
              change DVect2.cons f ((joinF ⋙ joinF).map (DVect2.cons (DVect2.cons fs fss) fsss))
            conv =>
              rhs; rhs; change DVect2.cons f ((mapF.obj joinF ⋙ joinF).map (DVect2.cons (DVect2.cons fs fss) fsss))
            simp only [joinF.associatorRight_cons_cons_cons]
            rw [comp_cons, comp_cons]
            rw [h_ind, Category.comp_id, Category.id_comp]
  }
  hom_inv_id := by ext; intros; simp
  inv_hom_id := by ext; intros; simp

end joinF

end CategoryTheory.List


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.types
import category_theory.functor.currying
import category_theory.limits.functor_category

/-!
# The morphism comparing a colimit of limits with the corresponding limit of colimits.

For `F : J × K ⥤ C` there is always a morphism $\colim_k \lim_j F(j,k) → \lim_j \colim_k F(j, k)$.
While it is not usually an isomorphism, with additional hypotheses on `J` and `K` it may be,
in which case we say that "colimits commute with limits".

The prototypical example, proved in `category_theory.limits.filtered_colimit_commutes_finite_limit`,
is that when `C = Type`, filtered colimits commute with finite limits.

## References
* Borceux, Handbook of categorical algebra 1, Section 2.13
* [Stacks: Filtered colimits](https://stacks.math.columbia.edu/tag/002W)
-/

universes v u

open category_theory

namespace category_theory.limits

variables {J K : Type v} [small_category J] [small_category K]
variables {C : Type u} [category.{v} C]

variables (F : J × K ⥤ C)

open category_theory.prod

lemma map_id_left_eq_curry_map {j : J} {k k' : K} {f : k ⟶ k'} :
  F.map ((𝟙 j, f) : (j, k) ⟶ (j, k')) = ((curry.obj F).obj j).map f :=
rfl

lemma map_id_right_eq_curry_swap_map {j j' : J} {f : j ⟶ j'} {k : K} :
  F.map ((f, 𝟙 k) : (j, k) ⟶ (j', k)) = ((curry.obj (swap K J ⋙ F)).obj k).map f :=
rfl

variables [has_limits_of_shape J C]
variables [has_colimits_of_shape K C]

/--
The universal morphism
$\colim_k \lim_j F(j,k) → \lim_j \colim_k F(j, k)$.
-/
noncomputable
def colimit_limit_to_limit_colimit :
  colimit ((curry.obj (swap K J ⋙ F)) ⋙ lim) ⟶ limit ((curry.obj F) ⋙ colim) :=
limit.lift ((curry.obj F) ⋙ colim)
{ X := _,
  π :=
  { app := λ j, colimit.desc ((curry.obj (swap K J ⋙ F)) ⋙ lim)
    { X := _,
      ι :=
      { app := λ k,
          limit.π ((curry.obj (swap K J ⋙ F)).obj k) j ≫ colimit.ι ((curry.obj F).obj j) k,
        naturality' :=
        begin
          dsimp,
          intros k k' f,
          simp only [functor.comp_map, curry.obj_map_app, limits.lim_map_π_assoc, swap_map,
            category.comp_id, map_id_left_eq_curry_map, colimit.w],
        end }, },
    naturality' :=
    begin
      dsimp,
      intros j j' f,
      ext k,
      simp only [limits.colimit.ι_map, curry.obj_map_app, limits.colimit.ι_desc_assoc,
        limits.colimit.ι_desc, category.id_comp, category.assoc, map_id_right_eq_curry_swap_map,
        limit.w_assoc],
    end } }

/--
Since `colimit_limit_to_limit_colimit` is a morphism from a colimit to a limit,
this lemma characterises it.
-/
@[simp, reassoc] lemma ι_colimit_limit_to_limit_colimit_π (j) (k) :
  colimit.ι _ k ≫ colimit_limit_to_limit_colimit F ≫ limit.π _ j =
    limit.π ((curry.obj (swap K J ⋙ F)).obj k) j ≫ colimit.ι ((curry.obj F).obj j) k :=
by { dsimp [colimit_limit_to_limit_colimit], simp, }

@[simp] lemma ι_colimit_limit_to_limit_colimit_π_apply (F : J × K ⥤ Type v) (j) (k) (f) :
   limit.π ((curry.obj F) ⋙ colim) j
     (colimit_limit_to_limit_colimit F (colimit.ι ((curry.obj (swap K J ⋙ F)) ⋙ lim) k f)) =
     colimit.ι ((curry.obj F).obj j) k (limit.π ((curry.obj (swap K J ⋙ F)).obj k) j f) :=
by { dsimp [colimit_limit_to_limit_colimit], simp, }

/-- The map `colimit_limit_to_limit_colimit` realized as a map of cones. -/
@[simps] noncomputable def colimit_limit_to_limit_colimit_cone (G : J ⥤ K ⥤ C) [has_limit G] :
  colim.map_cone (limit.cone G) ⟶ limit.cone (G ⋙ colim) :=
{ hom := colim.map (limit_iso_swap_comp_lim G).hom ≫
    colimit_limit_to_limit_colimit (uncurry.obj G : _) ≫
    lim.map (whisker_right (currying.unit_iso.app G).inv colim),
  w' := λ j,
  begin
    ext1 k,
    simp only [limit_obj_iso_limit_comp_evaluation_hom_π_assoc, iso.app_inv,
      ι_colimit_limit_to_limit_colimit_π_assoc, whisker_right_app,
      colimit.ι_map, functor.map_cone_π_app, category.id_comp,
      eq_to_hom_refl, eq_to_hom_app, colimit.ι_map_assoc, limit.cone_π,
      lim_map_π_assoc, lim_map_π, category.assoc, currying_unit_iso_inv_app_app_app,
      limit_iso_swap_comp_lim_hom_app, lim_map_eq_lim_map],
    dsimp,
    simp only [category.id_comp],
    erw limit_obj_iso_limit_comp_evaluation_hom_π_assoc,
  end }

end category_theory.limits


import number_theory.bernoulli

--OUTPUT 1
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1),
    {
      rw polynomial.bernoulli,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    simp,
    ring,
  },
  {
    have h1 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h2 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h3 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h4 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h5 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h6 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h7 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h8 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h9 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h10 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h11 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h12 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h13 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h14 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h15 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h16 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h17 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h18 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h19 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h20 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h21 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h22 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h23 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h24 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h25 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h26 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h27 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h28 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h29 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h30 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h31 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h32 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h33 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl,
    have h34 : (d + 1) * (1 + x)^d - (d + 1) * x^d = (d + 1) * (1 + x)^d - (d + 1) * x^d, from rfl
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
begin
  induction n with d hd,
  {
    show (polynomial.bernoulli 0).eval (1 + x) = (polynomial.bernoulli 0).eval x + 0 * x^(0 - 1), from by {
      rw polynomial.bernoulli,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval_C,
      rw polynomial.eval
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Bernoulli polynomial evaluation
Given a natural number $n$ and a rational $x$, let $B_n (x)$ denote the $n$-th Bernoulli polynomial evaluated at $x$. Then, $$B_n (1 + x) = B_n (x) + n x^{n - 1}$$
`proof`
We apply strong induction on $n$. So, for all $m < d$, we have $B_{m} (1 + x) = B_{m} (x) + m x^{m - 1}$ and we want to show that $$B_{d} (1 + x) = B_{d} (x) + d x^{d - 1}$$
Multiplying both sides by $d + 1$, and using the fact that, for all $l \in \mathbb{N}$, $\sum_{k = 0}^{l} {l + 1 \choose k} B_k = (l + 1) X^l$ (where $B_k$ is the $k$-th Bernoulli number), we get that
$$ (d + 1) (1 + x)^d - (d + 1) x^d = \sum_{l = 0}^{d} {d + 1 \choose l} l x^{l - 1} $$
The conclusion then follows easily.

QED

-/
theorem  bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
  (polynomial.bernoulli n).eval (1 + x) = (polynomial.bernoulli n).eval x + n * x^(n - 1) :=
FEW SHOT PROMPTS TO CODEX(END)-/


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

import linear_algebra.tensor_product
import algebra.direct_sum.module

/-!
# Tensor products of direct sums

This file shows that taking `tensor_product`s commutes with taking `direct_sum`s in both arguments.

## Main results

* `tensor_product.direct_sum`
* `tensor_product.direct_sum_left`
* `tensor_product.direct_sum_right`
-/

section ring

namespace tensor_product

open_locale tensor_product
open_locale direct_sum
open linear_map
local attribute [ext] tensor_product.ext

variables (R : Type*) [comm_ring R]
variables {ι₁ : Type*} {ι₂ : Type*}
variables [decidable_eq ι₁] [decidable_eq ι₂]
variables (M₁ : ι₁ → Type*) (M₁' : Type*) (M₂ : ι₂ → Type*) (M₂' : Type*)
variables [Π i₁, add_comm_group (M₁ i₁)] [add_comm_group M₁']
variables [Π i₂, add_comm_group (M₂ i₂)] [add_comm_group M₂']
variables [Π i₁, module R (M₁ i₁)] [module R M₁'] [Π i₂, module R (M₂ i₂)] [module R M₂']

/-- The linear equivalence `(⨁ i₁, M₁ i₁) ⊗ (⨁ i₂, M₂ i₂) ≃ (⨁ i₁, ⨁ i₂, M₁ i₁ ⊗ M₂ i₂)`, i.e.
"tensor product distributes over direct sum". -/
protected def direct_sum :
  (⨁ i₁, M₁ i₁) ⊗[R] (⨁ i₂, M₂ i₂) ≃ₗ[R] (⨁ (i : ι₁ × ι₂), M₁ i.1 ⊗[R] M₂ i.2) :=
begin
  refine linear_equiv.of_linear
    (lift $ direct_sum.to_module R _ _ $ λ i₁, flip $ direct_sum.to_module R _ _ $ λ i₂,
      flip $ curry $ direct_sum.lof R (ι₁ × ι₂) (λ i, M₁ i.1 ⊗[R] M₂ i.2) (i₁, i₂))
    (direct_sum.to_module R _ _ $ λ i, map (direct_sum.lof R _ _ _) (direct_sum.lof R _ _ _))
    _ _; [ext ⟨i₁, i₂⟩ x₁ x₂ : 4, ext i₁ i₂ x₁ x₂ : 5],
  repeat { rw compr₂_apply <|> rw comp_apply <|> rw id_apply <|> rw mk_apply <|>
    rw direct_sum.to_module_lof <|> rw map_tmul <|> rw lift.tmul <|> rw flip_apply <|>
    rw curry_apply },
end

/-- Tensor products distribute over a direct sum on the left . -/
def direct_sum_left : (⨁ i₁, M₁ i₁) ⊗[R] M₂' ≃ₗ[R] (⨁ i, M₁ i ⊗[R] M₂') :=
linear_equiv.of_linear
  (lift $ direct_sum.to_module R _ _ $ λ i, (mk R _ _).compr₂ $
    (direct_sum.lof R ι₁ (λ i, M₁ i ⊗[R] M₂') _))
  (direct_sum.to_module R _ _ $ λ i, rtensor _ (direct_sum.lof R ι₁ _ _))
  (direct_sum.linear_map_ext R $ λ i, tensor_product.ext $ linear_map.ext₂ $ λ m₁ m₂, begin
    dsimp only [comp_apply, compr₂_apply, id_apply, mk_apply],
    simp_rw [direct_sum.to_module_lof, rtensor_tmul, lift.tmul, direct_sum.to_module_lof,
      compr₂_apply, mk_apply],
  end)
  (tensor_product.ext $ direct_sum.linear_map_ext R $ λ i, linear_map.ext₂ $ λ m₁ m₂, begin
    dsimp only [comp_apply, compr₂_apply, id_apply, mk_apply],
    simp_rw [direct_sum.to_module_lof, lift.tmul, direct_sum.to_module_lof, compr₂_apply, mk_apply,
      direct_sum.to_module_lof, rtensor_tmul],
  end)

/-- Tensor products distribute over a direct sum on the right. -/
def direct_sum_right : M₁' ⊗[R] (⨁ i, M₂ i) ≃ₗ[R] (⨁ i, M₁' ⊗[R] M₂ i) :=
(tensor_product.comm R _ _) ≪≫ₗ (direct_sum_left R M₂ M₁') ≪≫ₗ
  (dfinsupp.map_range.linear_equiv $ λ i, (tensor_product.comm R _ _))

variables {M₁ M₁' M₂ M₂'}

@[simp] theorem direct_sum_lof_tmul_lof (i₁ : ι₁) (m₁ : M₁ i₁) (i₂ : ι₂) (m₂ : M₂ i₂) :
  tensor_product.direct_sum R M₁ M₂ (direct_sum.lof R ι₁ M₁ i₁ m₁ ⊗ₜ direct_sum.lof R ι₂ M₂ i₂ m₂) =
    direct_sum.lof R (ι₁ × ι₂) (λ i, M₁ i.1 ⊗[R] M₂ i.2) (i₁, i₂) (m₁ ⊗ₜ m₂) :=
by simp [tensor_product.direct_sum]

@[simp] lemma direct_sum_left_tmul_lof (i : ι₁) (x : M₁ i) (y : M₂') :
  direct_sum_left R M₁ M₂' (direct_sum.lof R _ _ i x ⊗ₜ[R] y)
    = direct_sum.lof R _ _ i (x ⊗ₜ[R] y) :=
begin
  dsimp only [direct_sum_left, linear_equiv.of_linear_apply, lift.tmul],
  rw direct_sum.to_module_lof R i,
  refl,
end

@[simp] lemma direct_sum_left_symm_lof_tmul (i : ι₁) (x : M₁ i) (y : M₂') :
  (direct_sum_left R M₁ M₂').symm (direct_sum.lof R _ _ i (x ⊗ₜ[R] y))
    = direct_sum.lof R _ _ i x ⊗ₜ[R] y :=
by rw [linear_equiv.symm_apply_eq, direct_sum_left_tmul_lof]

@[simp] lemma direct_sum_right_tmul_lof (x : M₁') (i : ι₂) (y : M₂ i) :
  direct_sum_right R M₁' M₂ (x ⊗ₜ[R] direct_sum.lof R _ _ i y)
    = direct_sum.lof R _ _ i (x ⊗ₜ[R] y) :=
begin
  dsimp only [direct_sum_right, linear_equiv.trans_apply, tensor_product.comm_tmul],
  rw direct_sum_left_tmul_lof,
  exact dfinsupp.map_range_single,
end

@[simp] lemma direct_sum_right_symm_lof_tmul (x : M₁') (i : ι₂) (y : M₂ i):
  (direct_sum_right R M₁' M₂).symm (direct_sum.lof R _ _ i (x ⊗ₜ[R] y))
    = x ⊗ₜ[R] direct_sum.lof R _ _ i y :=
by rw [linear_equiv.symm_apply_eq, direct_sum_right_tmul_lof]

end tensor_product

end ring


import game.modify.basic  game.value

open game
open list

/-- the values of two games, that differ in exactly one component by at most d
d, differ by at most d-/
theorem MITM (G1 G2 : game 2) (d : ℤ) (p : game.modify G1 G2 d):
 abs(G1.value - G2.value) ≤ d :=
begin
  revert G1,
  revert G2,
  -- induction on size of G2 (using our recursor)
  apply @game.rec_on_size2 (λ G2, ∀ G1, modify G1 G2 d →
  abs (game.value G1 - game.value G2) ≤ d),
    { -- base case : G2 = zero 2
    intros G1 p,
    have hx : G1.size2 = (zero 2).size2 := eq_size_of_modify p, -- see game.modify.basic
    rw size2_zero at hx, -- (zero 2).size2 = 0
    have hy := eq_zero_of_size2_zero _ hx, -- hy is G1 = zero 2  (true by hx)
    rw hy,
    show  0 ≤ d, -- as by defintions of abs abd value, abs (value (zero 2) - value (zero 2)) = 0
    exact abs_le_nonneg p.hl.bound,}, -- see misc_lemmas

    { -- inductive step : G2 has size n + 1
         /- in the following we switched the names of G1 and G2, so now G1 is
            initially assumed to have size n + 1-/
      intros n H G1 h1 G2 p, -- H is the inductive hypothesis and h1 says G1.size2 = n + 1
      have h2 := eq_size_of_modify p, -- h2 is size2 G2 = size2 G1 (see game.modify.basic)
      rw h1 at h2, -- so now h2 is size2 G2 = n + 1, the parallel hypothesis to h1
      /- now that we have h1 and h2, we can use our simplified value definition
         (other arguments inferred)-/
      rw game.value_def _ _ h2,
      rw game.value_def _ _ h1,
      apply list.min_change, -- se list.min.basic
        /- necessary hypothesis for list.min : the lengths of the lists are the same
           (whivh ia true because the sizes of the games are the same) -/
        { rw length_bind, dsimp,
          rw [length_of_fn, length_of_fn],
          rw length_bind, dsimp,
          rw [length_of_fn, length_of_fn],
          show G2.size = G1.size,
          rw size_eq_size2,
          rw size_eq_size2,
          rw [h1, h2]},

        /- because list.min takes as an argument, that the list we take the minimum
           of is non-empty, these hypotheses for list.min_change are inferred from those
           and need not be proved again-/

        -- now we just need to prove hdist (see list.min.basic)

           /- intuitively, we know this is true because G1 and G2 are modified games-/

        intros i hiL hiM,
        rw length_bind at hiL hiM,
        dsimp at hiL hiM, /-because hiM and hiL are needed by nth_le, simplifying creates
                            new hypotheses -/
        rw [length_of_fn, length_of_fn] at hiL_1 hiM_1,
        rw sum_list2 at hiL_1,
        rw sum_list2 at hiM_1,

        /- now hiL_1 is : i < length (G2.f 0) + length (G2.f 1),
           and hiM_1 is the similare statement for G1 -/

        simp only [list.bind_fin2],

        /- we just simplified a bit. Now as we viewed the lists of components
           as the lists of chains and loops as bound together with list.bind we
           need to consider two cases. Either the component considered is a chain
           ( ie. i < length (G2.f 0)) or it is a loop. That is important,
           because we will case by case consider where G1 and G2 are modified-/

        by_cases hi2 : i < length (G2.f 0),

        { -- hi2 : i < length (G2.f 0)
            /- as the games are modified their chain and loop lists have the same lengths,
               hence :-/
          have lengthf0 : length (G2.f 0) = length (G1.f 0),
            {apply eq_list_lengths_of_modify p},
          have hi1 : i < length (G1.f 0),
            {rw ←lengthf0, exact hi2},

          /- so we can use this to show the elements we are comparing for hdist are both
             chains and we can get rid of the appension of the list of values in case
              we opened a loop-/
          rw nth_le_append _ _,
          swap,
          { rw length_of_fn,
            exact hi2,
          },
          rw nth_le_append _ _,
          swap,
          { rw length_of_fn,
            exact hi1,
          },
          -- simplifying (see list.lemmas.simple)
          rw nth_le_of_fn' _ _ hi2,
          rw nth_le_of_fn' _ _ hi1,

          /- now the goal is just
             abs(nth_le (G2.f 0) (⟨i, hi2⟩.val) _ - (2 * ↑(0.val) + 2) +
             abs (2 * ↑(0.val) + 2 - value (remove G2 0 ⟨i, hi2⟩)) -
             (nth_le (G1.f 0) (⟨i, hi1⟩.val) _ - (2 * ↑(0.val) + 2) +
             abs (2 * ↑(0.val) + 2 - value (remove G1 0 ⟨i, hi1⟩)))) ≤ d

             Now we dive into the case by case consideration, of whether a chain
             or a loop has been modified-/

          by_cases hj : p.j = 0,

          { -- hj is p.j = 0 (ie. a chain has been modified)
            set pl := p.hl with hpl,
            set pn := pl.n with pln,

            /- now either i stands for exacty the modified chain p.n (= pn)
               or not-/
            by_cases hni : pn = i,

            { -- hni : pn = i (i stands for the modified chain)
                 /- in that case removing component i makes the games exactly
                    the same, giving the following-/
              have hG1G2 : game.remove G1 0 ⟨i, hi1⟩ = game.remove G2 0 ⟨i, hi2⟩,
              { apply game.ext, -- see game.basic
                intros a ha,
                cases a with a,
                { -- a = 0
                  unfold game.remove,
                  dsimp,
                  -- the if-condition in game.remove evaluates to true as ⟨0, ha⟩ = 0
                  rw dif_pos, swap, refl,
                  rw dif_pos, swap, refl,
                  rw ←hni,
                  rw pln,
                  convert pl.heq.symm; rw hj, -- this is then true by field heq of p.hl and hj
                },
                { -- nat.succ a (a = 1, as a < 2 as it is a value of some object of type fin 2)
                  cases a with a,
                  swap,
                    {-- nat.succ (nat.succ a), which contradicts ha
                     cases ha,
                     cases ha_a,
                     cases ha_a_a}, -- do cases until Lean trivially sees the contradiction
                  -- a = 1
                  unfold game.remove,
                  dsimp,
                  -- the if-condition in game.remove is false, as we do not have ⟨1, ha⟩ = 0
                  rw dif_neg, swap, exact dec_trivial,
                  rw dif_neg, swap, exact dec_trivial,
                  /- so we just need to prove G1.f ⟨1, ha⟩ = G2.f ⟨1, ha⟩
                     as we are modifying a chain, this is true by field hj of p-/
                  convert (p.hj 1 _).symm using 1,
                  rw hj,
                  exact dec_trivial,
                }
              },
              rw hG1G2,
               /- with the resulting games after playing in component i being the same,
                  we just have to show the ith components differ by at most d.
                  That is basically what p.hl.bound says-/
              convert pl.bound using 1,
              apply congr_arg,
              dsimp,
              simp only [pln.symm, hni, hj],
              ring
            },
            { -- hni : ¬ (pn = i) (i does not stand for the modified chain)

              /- in this case nth_le (G2.f 0) i _ = nth_le (G1.f 0) i _
                 and we can use the inductive hypothesis -/

              have nth_le_eq : nth_le (G2.f 0) i hi2 = nth_le (G1.f 0) i hi1,
                {apply list.modify_same _ i hi2 hi1 _, -- see list.modify.basic
                  -- an integer d
                  {exact d},
                  -- modify (G2.f 0) (G1.f 0) d
                  {simp only [hj] at pl,
                  exact pl},
                  /-(eq.mp _ pl).n ≠ i  (basically just pl.n ≠ i, but we have a duplicate naming issue
                   for hypotheses which basically say the same (because of the simp only at pl, which
                   created a new pl, as the old one in that exact form was needed elsewhere))-/
                  convert hni,
                  rw eq_comm,
                  exact hj,
                  rw eq_comm,
                  exact hj,
                  -- prove eq.mp _ pl == pl, ie just the duplicate naming issue
                  -- one-line proof lean constructed by searchin through the library
                  exact cast_heq
                  ((λ (A A_1 : list ℤ) (e_1 : A = A_1) (B B_1 : list ℤ) (e_2 : B = B_1) (d d_1 : ℤ) (e_3 : d = d_1),
                      congr (congr (congr_arg list.modify e_1) e_2) e_3)
                      (G2.f (p.j))
                      (G2.f 0)
                      ((λ (c c_1 : game 2) (e_1 : c = c_1) (a a_1 : fin 2) (e_2 : a = a_1), congr (congr_arg f e_1) e_2) G2 G2
                        (eq.refl G2)
                        (p.j)
                        0
                        hj)
                      (G1.f (p.j))
                      (G1.f 0)
                      ((λ (c c_1 : game 2) (e_1 : c = c_1) (a a_1 : fin 2) (e_2 : a = a_1), congr (congr_arg f e_1) e_2) G1 G1
                        (eq.refl G1)
                        (p.j)
                        0
                        hj)
                      d
                      d
                      (eq.refl d))
                  pl},--up to here by library_search

              rw nth_le_eq,

              /- so it suffices to prove the absolute value terms differ by at most d-/

              suffices : abs
                (abs (2 - game.value (game.remove G2 0 ⟨i, hi2⟩)) -
                abs (2 - game.value (game.remove G1 0 ⟨i, hi1⟩))) ≤ d,
                { -- proof that this actually implies the result
                  convert this using 2,
                  rw [(show ((0 : fin 2).val : ℤ) = 0, by norm_cast), mul_zero, zero_add],
                  ring,
                },
              apply le_trans (abs_abs_sub_abs_le _ _), -- see misc_lemmas

              /- now by using game.remove_of_modify we can prove the games with chain i
                 removed are also modified versions of each other, and then as they have sizen,
                 the inductive hypothesis and some term cancelling solve the goal-/

            -- need the following as argument for game.remove_of_modify
            have ho : 0 ≠ p.j ∨ (0 = p.j ∧ ((⟨i, hi2⟩ : fin (length (G2.f 0))).val) ≠ p.hl.n),
              {right, -- the right side of the ∨ is true
              split,
                exact hj.symm, -- 0 = p.j
                rw eq_comm at hni,
                exact hni,}, /-((⟨i, hi2⟩ : fin (length (G2.f 0))).val) ≠ p.hl.n
                                          which is what hni says-/

            have hmod := (game.remove_of_modify_symm p 0 ⟨i, hi2⟩ ⟨i, hi1⟩ (by refl) ho), -- the reduced games are modified
            have Hind := (H (game.remove G2 0 ⟨i, hi2⟩) _ (game.remove G1 0 ⟨i, hi1⟩) hmod), -- result of inductive hypothesis
            swap,
              -- proving size2 (remove G2 0 ⟨i, hi2⟩) = n   (necessary hypothesis for H)
              {rw game.size2_remove, -- size2 (remove G2 0 ⟨i, hi2⟩) = size2 G2 - 1
              rw h2,
              exact nat.add_sub_cancel n 1,
              },
              convert Hind using 2, -- goal is basically Hind (subject to terms cancelling)
              ring, -- using that (ℤ,*,+) is a ring (commutativity and associativity, etc.)
            },
          },
          /- This concludes the case where a chain has been modified. If a loop has been
             modified, the chains are all exactly the same. So just as before,
             nth_le (G2.f 0) i hi2 = nth_le (G1.f 0) i hi1 and we can use the inductive
             hypothesis-/

          { -- hj is ¬ (p.j = 0) (ie. a loop has been modified)
            have G1G2_1 : G2.f 0 = G1.f 0,
              {rw eq_comm at hj,
              exact p.hj 0 hj},
            simp only [G1G2_1], -- simp only because of nth_le
            { have ho : 0 ≠ p.j ∨ (0 = p.j ∧ ((⟨i, hi2⟩ : fin (length (G2.f 0))).val) ≠ p.hl.n),
                {left, -- the left side of ∨ is true
                rw eq_comm at hj,
                exact hj,},
            have hmod := (game.remove_of_modify_symm p 0 ⟨i, hi2⟩ ⟨i, hi1⟩ (by refl) ho),
            have Hind := (H (game.remove G2 0 ⟨i, hi2⟩) _ (game.remove G1 0 ⟨i, hi1⟩) hmod),
            swap,
              {rw game.size2_remove,
              rw h2,
              exact nat.add_sub_cancel n 1,
              },
            suffices : abs
                (abs (2 - game.value (game.remove G2 0 ⟨i, hi2⟩)) -
                abs (2 - game.value (game.remove G1 0 ⟨i, hi1⟩))) ≤ d,
              { convert this using 2,
                rw [(show ((0 : fin 2).val : ℤ) = 0, by norm_cast), mul_zero, zero_add],
                ring,
              },
              apply le_trans (abs_abs_sub_abs_le _ _),
              convert Hind using 2,
              ring,
            },
            },

            },
        /-This concludes the proof in the case that i represented a chain, now we consider
          i to represent a loop -/

        { -- hi2 : ¬ (i < length (G2.f 0)) (we are considering a loop)
          push_neg at hi2, -- hi2 is length (G2.f 0) ≤ i
          /- similar to the other case, we can get rid of the lists of values
              in case we opened a chain, which the other values are appended to in
              the goal, by adjusting the index (subtracting the length of the first list)-/
          rw nth_le_append_right _ _,
          swap,
          { rw length_of_fn,
            exact hi2,
          },
          rw nth_le_append_right _ _,
          swap,
          { rw length_of_fn,
            convert hi2 using 1,
            symmetry,
            apply eq_list_lengths_of_modify p,
          },

          -- through hiL_1, hi2 and the fact the games are modied, we have the following hypotheses
          have hi_new2 : i - length (G2.f 0) < length (G2.f 1),
                { rwa [nat.sub_lt_right_iff_lt_add hi2, add_comm],},
          have h1length : length (G2.f 1) = length (G1.f 1),
                {apply eq_list_lengths_of_modify p},
          have hi_new1 : i - length (G2.f 0) < length (G1.f 1),
                {rw ←h1length,
                exact hi_new2},
          have hi_new1' : i - length (G1.f 0) < length (G1.f 1),
                {convert hi_new1 using 2,
                symmetry,
                apply eq_list_lengths_of_modify p},
          have h0length : length (G2.f 0) = length (G1.f 0),
                {apply eq_list_lengths_of_modify p},

          /- hi_new1, hi_new1' and h_new2 are what we will need instead of hi1 and
             hi2 in this case, as the index has been shifted, when we got rid of the
             pre-appended list  -/

          simp only [length_of_fn],
           -- simplifying (see list.lemmas.simple)
          rw nth_le_of_fn' _ _ hi_new2,
          rw nth_le_of_fn' _ _ hi_new1',

          /- now the goal is just
             abs (nth_le (G2.f 1) (⟨i - length (G2.f 0), hi_new2⟩.val) _ - (2 * ↑(1.val) + 2) +
             abs (2 * ↑(1.val) + 2 - value (remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩)) -
             (nth_le (G1.f 1) (⟨i - length (G1.f 0), hi_new1'⟩.val) _ - (2 * ↑(1.val) + 2) +
             abs (2 * ↑(1.val) + 2 - value (remove G1 1 ⟨i - length (G1.f 0), hi_new1'⟩)))) ≤ d

             Now, again, we dive into the case by case consideration, of whether a chain
             or a loop has been modified-/

          by_cases hj : p.j = 1,
          { -- hj is p.j = 1 (ie. a loop has been modified)
            set pl := p.hl with hpl,
            set pn := pl.n with pln,

            /- now either i stands for exacty the modified loop p.n (= pn)
               or not (i was the index in (chains ++ loops), so the index
               is this time i - length (G2.f 0)-/

            by_cases hni : pn = i - length (G2.f 0),
            { -- hni : pn = i - length (G2.f 0) (i stands for the modified loop)
                 /- in that case removing component i makes the games exactly
                    the same, giving the following-/
              have hG1G2 : game.remove G1 1 ⟨i - length (G1.f 0), hi_new1'⟩ =
                           game.remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩,
              { apply game.ext, -- see game.basic
                intros a ha,
                cases a with a,
                { -- a = 0
                  unfold game.remove,
                  dsimp,
                  /- the if-condition in game.remove evaluates to false as we do
                     not have ⟨0, ha⟩ = 1 -/
                  rw dif_neg, swap, exact dec_trivial,
                  rw dif_neg, swap, exact dec_trivial,
                  /- so we just need to prove G1.f ⟨0, ha⟩ = G2.f ⟨0, ha⟩
                     as we are modifying a chain, this is true by field hj of p-/
                  convert (p.hj 0 _).symm using 1,
                  rw hj,
                  exact dec_trivial,
                },
                { -- nat.succ a (a = 1, as a < 2 as it is a value of some object of type fin 2)
                  cases a with a,
                  swap,
                    { -- nat.succ (nat.succ a) , contradicts ha
                     cases ha,
                     cases ha_a,
                     cases ha_a_a}, -- do cases until Lean trivially sees the contradiction
                  unfold game.remove,
                  dsimp,
                  -- the if-condition in game.remove evaluates to true as ⟨1, ha⟩ = 1
                  rw dif_pos, swap, refl,
                  rw dif_pos, swap, refl,
                  rw ← eq_list_lengths_of_modify p 0,
                  rw ←hni,
                  rw pln,
                  convert pl.heq.symm; rw ← hj, -- this is then true by field heq of p.hl and hj
                }
              },
              rw hG1G2,
              /- with the resulting games after playing in component i being the same,
                  we just have to show the ith components differ by at most d.
                  That is basically what p.hl.bound says-/
              convert pl.bound using 1,
              apply congr_arg,
              dsimp,
              simp only [pln.symm, hni, hj],
              simp only [eq_list_lengths_of_modify p 0],
              ring,
            },
            { -- hni : ¬ (pn = i) (i does not stand for the modified chain)

              /- in this case nth_le (G2.f 1) (i - length (G2.f 0)) _ =
                 (G1.f 1) (i - length (G2.f 0)) _ ,
                 and we can use the inductive hypothesis -/

              have nth_le_eq : nth_le (G2.f 1) (i - length (G2.f 0)) hi_new2
                             = nth_le (G1.f 1) (i - length (G2.f 0)) hi_new1,
                {apply list.modify_same _ (i - length (G2.f 0)) hi_new2 hi_new1 _, -- see list.modify.basic
                -- an integer d
                {exact d},
                -- modify (G2.f 1) (G1.f 1) d
                {simp only [hj] at pl,
                exact pl},
                /-(eq.mp _ pl).n ≠ i - length (G2.f 0)   (basically just pl.n ≠ i - length (G2.f 0),
                  but we have a duplicate naming issue for hypotheses which basically says the same
                  (because of the simp only at pl, which created a new pl, as the old one in that exact
                  form was needed elsewhere)-/
                convert hni,
                rw eq_comm,
                exact hj,
                rw eq_comm,
                exact hj,
                -- prove eq.mp _ pl == pl, ie just the duplicate naming issue
                -- one-line proof lean constructed by searchin through the library
                exact cast_heq
                ((λ (A A_1 : list ℤ) (e_1 : A = A_1) (B B_1 : list ℤ) (e_2 : B = B_1) (d d_1 : ℤ) (e_3 : d = d_1),
                    congr (congr (congr_arg list.modify e_1) e_2) e_3)
                  (G2.f (p.j))
                  (G2.f 1)
                  ((λ (c c_1 : game 2) (e_1 : c = c_1) (a a_1 : fin 2) (e_2 : a = a_1), congr (congr_arg f e_1) e_2) G2 G2
                      (eq.refl G2)
                      (p.j)
                      1
                      hj)
                  (G1.f (p.j))
                  (G1.f 1)
                  ((λ (c c_1 : game 2) (e_1 : c = c_1) (a a_1 : fin 2) (e_2 : a = a_1), congr (congr_arg f e_1) e_2) G1 G1
                      (eq.refl G1)
                      (p.j)
                      1
                      hj)
                  d
                  d
                  (eq.refl d))
                pl},--up to here by library_search

              rw nth_le_eq,

              /- so it suffices to prove the absolute value terms differ by at most d-/

              suffices : abs (
                abs (4 - game.value (game.remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩))
                - abs (4 - game.value (game.remove G1 1 ⟨i - length (G1.f 0), hi_new1'⟩))
              ) ≤ d,
              { -- proof that this actually implies the result
                convert this using 2,
                rw (show (((1 : fin 2).val) : ℤ) = 1, by norm_cast),
                simp only [h0length],
                ring,
              },

              refine le_trans (abs_abs_sub_abs_le _ _) _, -- see misc_lemmas (le_trans is transitivity of ≤ )

              /- now by using game.remove_of_modify we can prove the games with loop (i - length (G2.f 0))
                 removed are also modified versions of each other, and then as they have size n,
                 the inductive hypothesis and some term cancelling solve the goal-/

              -- need the following as argument for game.remove_of_modify

              have ho : 1 ≠ p.j ∨ (1 = p.j ∧ ((⟨i - length (G2.f 0), hi_new2⟩: fin (length (G2.f 1))).val) ≠ p.hl.n),
                {right, -- the right side of the ∨ is true
                split,
                exact hj.symm, -- 1 = p.j
                rw eq_comm at hni,
                exact hni,}, /-((⟨i - length (G2.f 0), hi_new2⟩: fin (length (G2.f 1))).val) ≠ p.hl.n
                                          which is what hni says-/

              have hmod := (game.remove_of_modify_symm p 1 ⟨i - length (G2.f 0), hi_new2⟩ ⟨i - length (G1.f 0), hi_new1'⟩ _ ho),  -- the reduced games are modified
                 swap,
                  {simp only [h0length],}, /- proving ⟨i - length (G2.f 0), hi_new2⟩.val = ⟨i - length (G1.f 0), hi_new1'⟩.val
                                              (necessary hypothesis for game.remove_of_modify_symm)-/
              have Hind := (H (game.remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩) _ (game.remove G1 1 ⟨i - length (G1.f 0), hi_new1'⟩) hmod), -- result of inductive hypothesis
                { -- goal is basically Hind (subject to terms cancelling)
                  convert Hind using 2,
                  ring, -- using that (ℤ,*,+) is a ring (commutativity and associativity, etc.)
                },
                { -- proving size2 (remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩) = n  (necessary hypothesis for H)
                  rw game.size2_remove, -- size2 (remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩) = size2 G2 - 1
                  rw h2,
                  exact nat.add_sub_cancel n 1,
                },
              },
          },

          /- This concludes the case where a loop has been modified. If a chain has been
             modified, the loops are all exactly the same. So just as before,
             nth_le (G2.f 1) (i - length (G2.f 0)) hi_new2 = nth_le (G1.f 1) (i - length (G2.f 0)) hi_new1
             and we can use the inductive hypothesis-/

          { -- hj is ¬ (p.j = 1) (ie. a chain has been modified)
            have G1G2_1 : G2.f 1 = G1.f 1,
              {rw eq_comm at hj,
              exact p.hj 1 hj},
            simp only [G1G2_1], --simp only because of nth_le
            suffices : abs (
                abs (4 - game.value (game.remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩))
                - abs (4 - game.value (game.remove G1 1 ⟨i - length (G1.f 0), hi_new1'⟩))
              ) ≤ d,
              { convert this using 2,
                rw (show (((1 : fin 2).val) : ℤ) = 1, by norm_cast),
                simp only [h0length],
                ring,
              },

              refine le_trans (abs_abs_sub_abs_le _ _) _,

            have ho : 1 ≠ p.j ∨ (1 = p.j ∧ ((⟨i - length (G2.f 0), hi_new2⟩: fin (length (G2.f 1))).val) ≠ p.hl.n),
              {left, -- the left side of the ∨ is true
              rw eq_comm at hj,
              exact hj,},
            have hmod := (game.remove_of_modify_symm p 1 ⟨i - length (G2.f 0), hi_new2⟩ ⟨i - length (G1.f 0), hi_new1'⟩ _ ho),
            have Hind := (H (game.remove G2 1 ⟨i - length (G2.f 0), hi_new2⟩) _ (game.remove G1 1 ⟨i - length (G1.f 0), hi_new1'⟩) hmod),
              { convert Hind using 2,
                ring,
              },
              {rw game.size2_remove,
              rw h2,
              exact nat.add_sub_cancel n 1,
              },
              {simp only [h0length],},

          },

        },

    },
end


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

! This file was ported from Lean 3 source module data.finset.sum
! leanprover-community/mathlib commit e04043d6bf7264a3c84bc69711dc354958ca4516
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Multiset.Sum
import Mathbin.Data.Finset.Card

/-!
# Disjoint sum of finsets

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines the disjoint sum of two finsets as `finset (α ⊕ β)`. Beware not to confuse with
the `finset.sum` operation which computes the additive sum.

## Main declarations

* `finset.disj_sum`: `s.disj_sum t` is the disjoint sum of `s` and `t`.
-/

open Function Multiset Sum

namespace Finset

variable {α β : Type _} (s : Finset α) (t : Finset β)

#print Finset.disjSum /-
/-- Disjoint sum of finsets. -/
def disjSum : Finset (Sum α β) :=
  ⟨s.1.disjSum t.1, s.2.disjSum t.2⟩
#align finset.disj_sum Finset.disjSum
-/

/- warning: finset.val_disj_sum -> Finset.val_disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α) (t : Finset.{u2} β), Eq.{succ (max u1 u2)} (Multiset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.val.{max u1 u2} (Sum.{u1, u2} α β) (Finset.disjSum.{u1, u2} α β s t)) (Multiset.disjSum.{u1, u2} α β (Finset.val.{u1} α s) (Finset.val.{u2} β t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Finset.{u2} α) (t : Finset.{u1} β), Eq.{max (succ u2) (succ u1)} (Multiset.{max u2 u1} (Sum.{u2, u1} α β)) (Finset.val.{max u2 u1} (Sum.{u2, u1} α β) (Finset.disjSum.{u2, u1} α β s t)) (Multiset.disjSum.{u2, u1} α β (Finset.val.{u2} α s) (Finset.val.{u1} β t))
Case conversion may be inaccurate. Consider using '#align finset.val_disj_sum Finset.val_disjSumₓ'. -/
@[simp]
theorem val_disjSum : (s.disjSum t).1 = s.1.disjSum t.1 :=
  rfl
#align finset.val_disj_sum Finset.val_disjSum

/- warning: finset.empty_disj_sum -> Finset.empty_disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (t : Finset.{u2} β), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.disjSum.{u1, u2} α β (EmptyCollection.emptyCollection.{u1} (Finset.{u1} α) (Finset.hasEmptyc.{u1} α)) t) (Finset.map.{u2, max u1 u2} β (Sum.{u1, u2} α β) (Function.Embedding.inr.{u1, u2} α β) t)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (t : Finset.{u1} β), Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.disjSum.{u2, u1} α β (EmptyCollection.emptyCollection.{u2} (Finset.{u2} α) (Finset.instEmptyCollectionFinset.{u2} α)) t) (Finset.map.{u1, max u1 u2} β (Sum.{u2, u1} α β) (Function.Embedding.inr.{u2, u1} α β) t)
Case conversion may be inaccurate. Consider using '#align finset.empty_disj_sum Finset.empty_disjSumₓ'. -/
@[simp]
theorem empty_disjSum : (∅ : Finset α).disjSum t = t.map Embedding.inr :=
  val_inj.1 <| Multiset.zero_disjSum _
#align finset.empty_disj_sum Finset.empty_disjSum

/- warning: finset.disj_sum_empty -> Finset.disjSum_empty is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.disjSum.{u1, u2} α β s (EmptyCollection.emptyCollection.{u2} (Finset.{u2} β) (Finset.hasEmptyc.{u2} β))) (Finset.map.{u1, max u1 u2} α (Sum.{u1, u2} α β) (Function.Embedding.inl.{u1, u2} α β) s)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Finset.{u2} α), Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.disjSum.{u2, u1} α β s (EmptyCollection.emptyCollection.{u1} (Finset.{u1} β) (Finset.instEmptyCollectionFinset.{u1} β))) (Finset.map.{u2, max u1 u2} α (Sum.{u2, u1} α β) (Function.Embedding.inl.{u2, u1} α β) s)
Case conversion may be inaccurate. Consider using '#align finset.disj_sum_empty Finset.disjSum_emptyₓ'. -/
@[simp]
theorem disjSum_empty : s.disjSum (∅ : Finset β) = s.map Embedding.inl :=
  val_inj.1 <| Multiset.disjSum_zero _
#align finset.disj_sum_empty Finset.disjSum_empty

/- warning: finset.card_disj_sum -> Finset.card_disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α) (t : Finset.{u2} β), Eq.{1} Nat (Finset.card.{max u1 u2} (Sum.{u1, u2} α β) (Finset.disjSum.{u1, u2} α β s t)) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Finset.card.{u1} α s) (Finset.card.{u2} β t))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Finset.{u2} α) (t : Finset.{u1} β), Eq.{1} Nat (Finset.card.{max u2 u1} (Sum.{u2, u1} α β) (Finset.disjSum.{u2, u1} α β s t)) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Finset.card.{u2} α s) (Finset.card.{u1} β t))
Case conversion may be inaccurate. Consider using '#align finset.card_disj_sum Finset.card_disjSumₓ'. -/
@[simp]
theorem card_disjSum : (s.disjSum t).card = s.card + t.card :=
  Multiset.card_disjSum _ _
#align finset.card_disj_sum Finset.card_disjSum

/- warning: finset.disjoint_map_inl_map_inr -> Finset.disjoint_map_inl_map_inr is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α) (t : Finset.{u2} β), Disjoint.{max u1 u2} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.orderBot.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.map.{u1, max u1 u2} α (Sum.{u1, u2} α β) (Function.Embedding.inl.{u1, u2} α β) s) (Finset.map.{u2, max u1 u2} β (Sum.{u1, u2} α β) (Function.Embedding.inr.{u1, u2} α β) t)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α) (t : Finset.{u2} β), Disjoint.{max u2 u1} (Finset.{max u2 u1} (Sum.{u1, u2} α β)) (Finset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.map.{u1, max u2 u1} α (Sum.{u1, u2} α β) (Function.Embedding.inl.{u1, u2} α β) s) (Finset.map.{u2, max u1 u2} β (Sum.{u1, u2} α β) (Function.Embedding.inr.{u1, u2} α β) t)
Case conversion may be inaccurate. Consider using '#align finset.disjoint_map_inl_map_inr Finset.disjoint_map_inl_map_inrₓ'. -/
theorem disjoint_map_inl_map_inr : Disjoint (s.map Embedding.inl) (t.map Embedding.inr) :=
  by
  simp_rw [disjoint_left, mem_map]
  rintro x ⟨a, _, rfl⟩ ⟨b, _, ⟨⟩⟩
#align finset.disjoint_map_inl_map_inr Finset.disjoint_map_inl_map_inr

/- warning: finset.map_inl_disj_union_map_inr -> Finset.map_inl_disjUnion_map_inr is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α) (t : Finset.{u2} β), Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.disjUnion.{max u1 u2} (Sum.{u1, u2} α β) (Finset.map.{u1, max u1 u2} α (Sum.{u1, u2} α β) (Function.Embedding.inl.{u1, u2} α β) s) (Finset.map.{u2, max u1 u2} β (Sum.{u1, u2} α β) (Function.Embedding.inr.{u1, u2} α β) t) (Finset.disjoint_map_inl_map_inr.{u1, u2} α β s t)) (Finset.disjSum.{u1, u2} α β s t)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Finset.{u2} α) (t : Finset.{u1} β), Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (Sum.{u2, u1} α β)) (Finset.disjUnion.{max u2 u1} (Sum.{u2, u1} α β) (Finset.map.{u2, max u1 u2} α (Sum.{u2, u1} α β) (Function.Embedding.inl.{u2, u1} α β) s) (Finset.map.{u1, max u2 u1} β (Sum.{u2, u1} α β) (Function.Embedding.inr.{u2, u1} α β) t) (Finset.disjoint_map_inl_map_inr.{u2, u1} α β s t)) (Finset.disjSum.{u2, u1} α β s t)
Case conversion may be inaccurate. Consider using '#align finset.map_inl_disj_union_map_inr Finset.map_inl_disjUnion_map_inrₓ'. -/
@[simp]
theorem map_inl_disjUnion_map_inr :
    (s.map Embedding.inl).disjUnion (t.map Embedding.inr) (disjoint_map_inl_map_inr _ _) =
      s.disjSum t :=
  rfl
#align finset.map_inl_disj_union_map_inr Finset.map_inl_disjUnion_map_inr

variable {s t} {s₁ s₂ : Finset α} {t₁ t₂ : Finset β} {a : α} {b : β} {x : Sum α β}

/- warning: finset.mem_disj_sum -> Finset.mem_disjSum is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s : Finset.{u1} α} {t : Finset.{u2} β} {x : Sum.{u1, u2} α β}, Iff (Membership.Mem.{max u1 u2, max u1 u2} (Sum.{u1, u2} α β) (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.hasMem.{max u1 u2} (Sum.{u1, u2} α β)) x (Finset.disjSum.{u1, u2} α β s t)) (Or (Exists.{succ u1} α (fun (a : α) => And (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) (Eq.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β) (Sum.inl.{u1, u2} α β a) x))) (Exists.{succ u2} β (fun (b : β) => And (Membership.Mem.{u2, u2} β (Finset.{u2} β) (Finset.hasMem.{u2} β) b t) (Eq.{max (succ u1) (succ u2)} (Sum.{u1, u2} α β) (Sum.inr.{u1, u2} α β b) x))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s : Finset.{u2} α} {t : Finset.{u1} β} {x : Sum.{u2, u1} α β}, Iff (Membership.mem.{max u2 u1, max u2 u1} (Sum.{u2, u1} α β) (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.instMembershipFinset.{max u2 u1} (Sum.{u2, u1} α β)) x (Finset.disjSum.{u2, u1} α β s t)) (Or (Exists.{succ u2} α (fun (a : α) => And (Membership.mem.{u2, u2} α (Finset.{u2} α) (Finset.instMembershipFinset.{u2} α) a s) (Eq.{max (succ u2) (succ u1)} (Sum.{u2, u1} α β) (Sum.inl.{u2, u1} α β a) x))) (Exists.{succ u1} β (fun (b : β) => And (Membership.mem.{u1, u1} β (Finset.{u1} β) (Finset.instMembershipFinset.{u1} β) b t) (Eq.{max (succ u2) (succ u1)} (Sum.{u2, u1} α β) (Sum.inr.{u2, u1} α β b) x))))
Case conversion may be inaccurate. Consider using '#align finset.mem_disj_sum Finset.mem_disjSumₓ'. -/
theorem mem_disjSum : x ∈ s.disjSum t ↔ (∃ a, a ∈ s ∧ inl a = x) ∨ ∃ b, b ∈ t ∧ inr b = x :=
  Multiset.mem_disjSum
#align finset.mem_disj_sum Finset.mem_disjSum

#print Finset.inl_mem_disjSum /-
@[simp]
theorem inl_mem_disjSum : inl a ∈ s.disjSum t ↔ a ∈ s :=
  inl_mem_disjSum
#align finset.inl_mem_disj_sum Finset.inl_mem_disjSum
-/

#print Finset.inr_mem_disjSum /-
@[simp]
theorem inr_mem_disjSum : inr b ∈ s.disjSum t ↔ b ∈ t :=
  inr_mem_disjSum
#align finset.inr_mem_disj_sum Finset.inr_mem_disjSum
-/

/- warning: finset.disj_sum_mono -> Finset.disjSum_mono is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s₁ : Finset.{u1} α} {s₂ : Finset.{u1} α} {t₁ : Finset.{u2} β} {t₂ : Finset.{u2} β}, (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) s₁ s₂) -> (HasSubset.Subset.{u2} (Finset.{u2} β) (Finset.hasSubset.{u2} β) t₁ t₂) -> (HasSubset.Subset.{max u1 u2} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.hasSubset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.disjSum.{u1, u2} α β s₁ t₁) (Finset.disjSum.{u1, u2} α β s₂ t₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s₁ : Finset.{u2} α} {s₂ : Finset.{u2} α} {t₁ : Finset.{u1} β} {t₂ : Finset.{u1} β}, (HasSubset.Subset.{u2} (Finset.{u2} α) (Finset.instHasSubsetFinset.{u2} α) s₁ s₂) -> (HasSubset.Subset.{u1} (Finset.{u1} β) (Finset.instHasSubsetFinset.{u1} β) t₁ t₂) -> (HasSubset.Subset.{max u2 u1} (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.instHasSubsetFinset.{max u2 u1} (Sum.{u2, u1} α β)) (Finset.disjSum.{u2, u1} α β s₁ t₁) (Finset.disjSum.{u2, u1} α β s₂ t₂))
Case conversion may be inaccurate. Consider using '#align finset.disj_sum_mono Finset.disjSum_monoₓ'. -/
theorem disjSum_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁.disjSum t₁ ⊆ s₂.disjSum t₂ :=
  val_le_iff.1 <| disjSum_mono (val_le_iff.2 hs) (val_le_iff.2 ht)
#align finset.disj_sum_mono Finset.disjSum_mono

#print Finset.disjSum_mono_left /-
theorem disjSum_mono_left (t : Finset β) : Monotone fun s : Finset α => s.disjSum t :=
  fun s₁ s₂ hs => disjSum_mono hs Subset.rfl
#align finset.disj_sum_mono_left Finset.disjSum_mono_left
-/

/- warning: finset.disj_sum_mono_right -> Finset.disjSum_mono_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α), Monotone.{u2, max u1 u2} (Finset.{u2} β) (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u2} (Finset.{u2} β) (Finset.partialOrder.{u2} β)) (PartialOrder.toPreorder.{max u1 u2} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β))) (Finset.disjSum.{u1, u2} α β s)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Finset.{u2} α), Monotone.{u1, max u2 u1} (Finset.{u1} β) (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (PartialOrder.toPreorder.{u1} (Finset.{u1} β) (Finset.partialOrder.{u1} β)) (PartialOrder.toPreorder.{max u2 u1} (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.partialOrder.{max u2 u1} (Sum.{u2, u1} α β))) (Finset.disjSum.{u2, u1} α β s)
Case conversion may be inaccurate. Consider using '#align finset.disj_sum_mono_right Finset.disjSum_mono_rightₓ'. -/
theorem disjSum_mono_right (s : Finset α) : Monotone (s.disjSum : Finset β → Finset (Sum α β)) :=
  fun t₁ t₂ => disjSum_mono Subset.rfl
#align finset.disj_sum_mono_right Finset.disjSum_mono_right

/- warning: finset.disj_sum_ssubset_disj_sum_of_ssubset_of_subset -> Finset.disjSum_ssubset_disjSum_of_ssubset_of_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s₁ : Finset.{u1} α} {s₂ : Finset.{u1} α} {t₁ : Finset.{u2} β} {t₂ : Finset.{u2} β}, (HasSSubset.SSubset.{u1} (Finset.{u1} α) (Finset.hasSsubset.{u1} α) s₁ s₂) -> (HasSubset.Subset.{u2} (Finset.{u2} β) (Finset.hasSubset.{u2} β) t₁ t₂) -> (HasSSubset.SSubset.{max u1 u2} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.hasSsubset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.disjSum.{u1, u2} α β s₁ t₁) (Finset.disjSum.{u1, u2} α β s₂ t₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s₁ : Finset.{u2} α} {s₂ : Finset.{u2} α} {t₁ : Finset.{u1} β} {t₂ : Finset.{u1} β}, (HasSSubset.SSubset.{u2} (Finset.{u2} α) (Finset.instHasSSubsetFinset.{u2} α) s₁ s₂) -> (HasSubset.Subset.{u1} (Finset.{u1} β) (Finset.instHasSubsetFinset.{u1} β) t₁ t₂) -> (HasSSubset.SSubset.{max u2 u1} (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.instHasSSubsetFinset.{max u2 u1} (Sum.{u2, u1} α β)) (Finset.disjSum.{u2, u1} α β s₁ t₁) (Finset.disjSum.{u2, u1} α β s₂ t₂))
Case conversion may be inaccurate. Consider using '#align finset.disj_sum_ssubset_disj_sum_of_ssubset_of_subset Finset.disjSum_ssubset_disjSum_of_ssubset_of_subsetₓ'. -/
theorem disjSum_ssubset_disjSum_of_ssubset_of_subset (hs : s₁ ⊂ s₂) (ht : t₁ ⊆ t₂) :
    s₁.disjSum t₁ ⊂ s₂.disjSum t₂ :=
  val_lt_iff.1 <| disjSum_lt_disjSum_of_lt_of_le (val_lt_iff.2 hs) (val_le_iff.2 ht)
#align finset.disj_sum_ssubset_disj_sum_of_ssubset_of_subset Finset.disjSum_ssubset_disjSum_of_ssubset_of_subset

/- warning: finset.disj_sum_ssubset_disj_sum_of_subset_of_ssubset -> Finset.disjSum_ssubset_disjSum_of_subset_of_ssubset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {s₁ : Finset.{u1} α} {s₂ : Finset.{u1} α} {t₁ : Finset.{u2} β} {t₂ : Finset.{u2} β}, (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) s₁ s₂) -> (HasSSubset.SSubset.{u2} (Finset.{u2} β) (Finset.hasSsubset.{u2} β) t₁ t₂) -> (HasSSubset.SSubset.{max u1 u2} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.hasSsubset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.disjSum.{u1, u2} α β s₁ t₁) (Finset.disjSum.{u1, u2} α β s₂ t₂))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} {s₁ : Finset.{u2} α} {s₂ : Finset.{u2} α} {t₁ : Finset.{u1} β} {t₂ : Finset.{u1} β}, (HasSubset.Subset.{u2} (Finset.{u2} α) (Finset.instHasSubsetFinset.{u2} α) s₁ s₂) -> (HasSSubset.SSubset.{u1} (Finset.{u1} β) (Finset.instHasSSubsetFinset.{u1} β) t₁ t₂) -> (HasSSubset.SSubset.{max u2 u1} (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.instHasSSubsetFinset.{max u2 u1} (Sum.{u2, u1} α β)) (Finset.disjSum.{u2, u1} α β s₁ t₁) (Finset.disjSum.{u2, u1} α β s₂ t₂))
Case conversion may be inaccurate. Consider using '#align finset.disj_sum_ssubset_disj_sum_of_subset_of_ssubset Finset.disjSum_ssubset_disjSum_of_subset_of_ssubsetₓ'. -/
theorem disjSum_ssubset_disjSum_of_subset_of_ssubset (hs : s₁ ⊆ s₂) (ht : t₁ ⊂ t₂) :
    s₁.disjSum t₁ ⊂ s₂.disjSum t₂ :=
  val_lt_iff.1 <| disjSum_lt_disjSum_of_le_of_lt (val_le_iff.2 hs) (val_lt_iff.2 ht)
#align finset.disj_sum_ssubset_disj_sum_of_subset_of_ssubset Finset.disjSum_ssubset_disjSum_of_subset_of_ssubset

#print Finset.disjSum_strictMono_left /-
theorem disjSum_strictMono_left (t : Finset β) : StrictMono fun s : Finset α => s.disjSum t :=
  fun s₁ s₂ hs => disjSum_ssubset_disjSum_of_ssubset_of_subset hs Subset.rfl
#align finset.disj_sum_strict_mono_left Finset.disjSum_strictMono_left
-/

/- warning: finset.disj_sum_strict_mono_right -> Finset.disj_sum_strictMono_right is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Finset.{u1} α), StrictMono.{u2, max u1 u2} (Finset.{u2} β) (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (PartialOrder.toPreorder.{u2} (Finset.{u2} β) (Finset.partialOrder.{u2} β)) (PartialOrder.toPreorder.{max u1 u2} (Finset.{max u1 u2} (Sum.{u1, u2} α β)) (Finset.partialOrder.{max u1 u2} (Sum.{u1, u2} α β))) (Finset.disjSum.{u1, u2} α β s)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Finset.{u2} α), StrictMono.{u1, max u2 u1} (Finset.{u1} β) (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (PartialOrder.toPreorder.{u1} (Finset.{u1} β) (Finset.partialOrder.{u1} β)) (PartialOrder.toPreorder.{max u2 u1} (Finset.{max u1 u2} (Sum.{u2, u1} α β)) (Finset.partialOrder.{max u2 u1} (Sum.{u2, u1} α β))) (Finset.disjSum.{u2, u1} α β s)
Case conversion may be inaccurate. Consider using '#align finset.disj_sum_strict_mono_right Finset.disj_sum_strictMono_rightₓ'. -/
theorem disj_sum_strictMono_right (s : Finset α) :
    StrictMono (s.disjSum : Finset β → Finset (Sum α β)) := fun s₁ s₂ =>
  disjSum_ssubset_disjSum_of_subset_of_ssubset Subset.rfl
#align finset.disj_sum_strict_mono_right Finset.disj_sum_strictMono_right

end Finset


import .ltl
       galois.temporal.fixpoint

universes u v

open temporal lattice

namespace sequent

lemma eventually_cut {T : Type u} {P Q : tProp T}
  : rlist.nil & ◇ P & □ (P => ◇ Q) ⊢ ◇ Q
:= begin
repeat {sequent.revert},
rw tautology_iff, apply temporal.eventually_cut,
end

lemma now_until_eventually {T : Type u}
  {P Q : tProp T}
  : rlist.nil & P & ((◯ P) 𝓤 Q) ⊢ ◇ (P ∩ Q)
:= begin
repeat {sequent.revert},
rw tautology_iff, apply temporal.now_until_eventually,
end

lemma eventually_strengthen_until {T : Type u}
  {P Q : tProp T}
  [decidable_pred Q]
  : rlist.nil & ◇ Q & (P 𝓦 Q) ⊢ (P 𝓤 Q)
:= begin
repeat {sequent.revert},
rw tautology_iff, apply temporal.eventually_strengthen_until,
end

--notation a `&\n` b `]` := a & b

lemma well_founded_LTL_template (A : Type v) (P Q X : tProp A)
  [decidable_pred Q]
  : rlist.nil
    & ◇ Q
    & P
    & ((◯ P) 𝓦 Q)
    & (□ ((P ∩ Q) => ◇ X))
    ⊢ ◇ X
:= begin
sequent.apply eventually_cut,
tactic.swap, sequent.assumption,
sequent.apply now_until_eventually,
sequent.assumption,
sequent.apply eventually_strengthen_until;
  sequent.assumption,
end

lemma until_always_mono {T : Type u}
  {A B P : tProp T} :
  rlist.nil & (□ (A ⇒ B)) & (A 𝓤 P) ⊢ (B 𝓤 P)
:= begin
repeat { sequent.revert },
rw tautology_iff,
apply until_always_mono,
end

lemma example1 {A B P X : tProp ℕ} :
  rlist.nil & (□ (A ⇒ B)) & X & (A 𝓤 P) ⊢ (B 𝓤 P)
:= begin
sequent.revert, sequent.intros,
sequent.apply until_always_mono;
sequent.assumption,
end

lemma example2 {A B C D : tProp ℕ}
  (H : rlist.nil & A & B & A & C ⊢ D)
  : rlist.nil & A & B & C ⊢ D
:= begin
sequent.apply H; sequent.assumption
end

lemma example3 {P Q R : tProp ℕ} :
  rlist.nil & P & Q ⊢ (R ⊓ P) ⊔ (Q ⊓ P)
:= begin
sequent.right, sequent.split, sequent.assumption,
sequent.assumption,
end

--lemma example4 {P Q R : tProp ℕ} :
--  rlist.nil & P & Q ⊢ (R ⊓ P) ⊔ (Q ⊓ P)
--:= begin
--sequent.reify_goal, sequent.entails_tactic formula_entails_auto,
--end

end sequent