/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import category_theory.const
import category_theory.discrete_category
import category_theory.yoneda
import category_theory.reflects_isomorphisms

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

open category_theory

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

open category_theory
open category_theory.category
open category_theory.functor
open opposite

namespace category_theory

namespace functor
variables {J C} (F : J ⥤ C)

/--
`F.cones` is the functor assigning to an object `X` the type of
natural transformations from the constant functor with value `X` to `F`.
An object representing this functor is a limit of `F`.
-/
@[simps]
def cones : Cᵒᵖ ⥤ Type v := (const J).op ⋙ yoneda.obj F

/--
`F.cocones` is the functor assigning to an object `X` the type of
natural transformations from `F` to the constant functor with value `X`.
An object corepresenting this functor is a colimit of `F`.
-/
@[simps]
def cocones : C ⥤ Type v := const J ⋙ coyoneda.obj (op F)

end functor

section
variables (J C)

/--
Functorially associated to each functor `J ⥤ C`, we have the `C`-presheaf consisting of
cones with a given cone point.
-/
@[simps] def cones : (J ⥤ C) ⥤ (Cᵒᵖ ⥤ Type v) :=
{ obj := functor.cones,
  map := λ F G f, whisker_left (const J).op (yoneda.map f) }

/--
Contravariantly associated to each functor `J ⥤ C`, we have the `C`-copresheaf consisting of
cocones with a given cocone point.
-/
@[simps] def cocones : (J ⥤ C)ᵒᵖ ⥤ (C ⥤ Type v) :=
{ obj := λ F, functor.cocones (unop F),
  map := λ F G f, whisker_left (const J) (coyoneda.map f) }

end

namespace limits

/--
A `c : cone F` is:
* an object `c.X` and
* a natural transformation `c.π : c.X ⟶ F` from the constant `c.X` functor to `F`.

`cone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cones.obj X`.
-/
structure cone (F : J ⥤ C) :=
(X : C)
(π : (const J).obj X ⟶ F)

instance inhabited_cone (F : discrete punit ⥤ C) : inhabited (cone F) :=
⟨{ X := F.obj punit.star,
   π := { app := λ ⟨⟩, 𝟙 _ } }⟩

@[simp, reassoc] lemma cone.w {F : J ⥤ C} (c : cone F) {j j' : J} (f : j ⟶ j') :
  c.π.app j ≫ F.map f = c.π.app j' :=
by { rw ← c.π.naturality f, apply id_comp }

/--
A `c : cocone F` is
* an object `c.X` and
* a natural transformation `c.ι : F ⟶ c.X` from `F` to the constant `c.X` functor.

`cocone F` is equivalent, via `cone.equiv` below, to `Σ X, F.cocones.obj X`.
-/
structure cocone (F : J ⥤ C) :=
(X : C)
(ι : F ⟶ (const J).obj X)

instance inhabited_cocone (F : discrete punit ⥤ C) : inhabited (cocone F) :=
⟨{ X := F.obj punit.star,
   ι := { app := λ ⟨⟩, 𝟙 _ } }⟩

@[simp, reassoc] lemma cocone.w {F : J ⥤ C} (c : cocone F) {j j' : J} (f : j ⟶ j') :
  F.map f ≫ c.ι.app j' = c.ι.app j :=
by { rw c.ι.naturality f, apply comp_id }

variables {F : J ⥤ C}

namespace cone

/-- The isomorphism between a cone on `F` and an element of the functor `F.cones`. -/
@[simps]
def equiv (F : J ⥤ C) : cone F ≅ Σ X, F.cones.obj X :=
{ hom := λ c, ⟨op c.X, c.π⟩,
  inv := λ c, { X := c.1.unop, π := c.2 },
  hom_inv_id' := by { ext1, cases x, refl },
  inv_hom_id' := by { ext1, cases x, refl } }

/-- A map to the vertex of a cone naturally induces a cone by composition. -/
@[simps] def extensions (c : cone F) :
  yoneda.obj c.X ⟶ F.cones :=
{ app := λ X f, (const J).map f ≫ c.π }

/-- A map to the vertex of a cone induces a cone by composition. -/
@[simps] def extend (c : cone F) {X : C} (f : X ⟶ c.X) : cone F :=
{ X := X,
  π := c.extensions.app (op X) f }

/-- Whisker a cone by precomposition of a functor. -/
@[simps] def whisker (E : K ⥤ J) (c : cone F) : cone (E ⋙ F) :=
{ X := c.X,
  π := whisker_left E c.π }

end cone

namespace cocone

/-- The isomorphism between a cocone on `F` and an element of the functor `F.cocones`. -/
def equiv (F : J ⥤ C) : cocone F ≅ Σ X, F.cocones.obj X :=
{ hom := λ c, ⟨c.X, c.ι⟩,
  inv := λ c, { X := c.1, ι := c.2 },
  hom_inv_id' := by { ext1, cases x, refl },
  inv_hom_id' := by { ext1, cases x, refl } }

/-- A map from the vertex of a cocone naturally induces a cocone by composition. -/
@[simps] def extensions (c : cocone F) : coyoneda.obj (op c.X) ⟶ F.cocones :=
{ app := λ X f, c.ι ≫ (const J).map f }

/-- A map from the vertex of a cocone induces a cocone by composition. -/
@[simps] def extend (c : cocone F) {X : C} (f : c.X ⟶ X) : cocone F :=
{ X := X,
  ι := c.extensions.app X f }

/--
Whisker a cocone by precomposition of a functor. See `whiskering` for a functorial
version.
-/
@[simps] def whisker (E : K ⥤ J) (c : cocone F) : cocone (E ⋙ F) :=
{ X := c.X,
  ι := whisker_left E c.ι }

end cocone

/-- A cone morphism between two cones for the same diagram is a morphism of the cone points which
commutes with the cone legs. -/
@[ext] structure cone_morphism (A B : cone F) :=
(hom : A.X ⟶ B.X)
(w'  : ∀ j : J, hom ≫ B.π.app j = A.π.app j . obviously)

restate_axiom cone_morphism.w'
attribute [simp, reassoc] cone_morphism.w

instance inhabited_cone_morphism (A : cone F) : inhabited (cone_morphism A A) :=
⟨{ hom := 𝟙 _ }⟩

/-- The category of cones on a given diagram. -/
@[simps] instance cone.category : category (cone F) :=
{ hom  := λ A B, cone_morphism A B,
  comp := λ X Y Z f g, { hom := f.hom ≫ g.hom },
  id   := λ B, { hom := 𝟙 B.X } }

namespace cones
/-- To give an isomorphism between cones, it suffices to give an
  isomorphism between their vertices which commutes with the cone
  maps. -/
@[ext, simps] def ext {c c' : cone F}
  (φ : c.X ≅ c'.X) (w : ∀ j, c.π.app j = φ.hom ≫ c'.π.app j) : c ≅ c' :=
{ hom := { hom := φ.hom },
  inv := { hom := φ.inv, w' := λ j, φ.inv_comp_eq.mpr (w j) } }

/--
Given a cone morphism whose object part is an isomorphism, produce an
isomorphism of cones.
-/
lemma cone_iso_of_hom_iso {K : J ⥤ C} {c d : cone K} (f : c ⟶ d) [i : is_iso f.hom] :
  is_iso f :=
⟨⟨{ hom := inv f.hom,
    w' := λ j, (as_iso f.hom).inv_comp_eq.2 (f.w j).symm }, by tidy⟩⟩

/--
Functorially postcompose a cone for `F` by a natural transformation `F ⟶ G` to give a cone for `G`.
-/
@[simps] def postcompose {G : J ⥤ C} (α : F ⟶ G) : cone F ⥤ cone G :=
{ obj := λ c, { X := c.X, π := c.π ≫ α },
  map := λ c₁ c₂ f, { hom := f.hom } }

/-- Postcomposing a cone by the composite natural transformation `α ≫ β` is the same as
postcomposing by `α` and then by `β`. -/
@[simps]
def postcompose_comp {G H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
  postcompose (α ≫ β) ≅ postcompose α ⋙ postcompose β :=
nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy)

/-- Postcomposing by the identity does not change the cone up to isomorphism. -/
@[simps]
def postcompose_id : postcompose (𝟙 F) ≅ 𝟭 (cone F) :=
nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy)

/--
If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cones.
-/
@[simps]
def postcompose_equivalence {G : J ⥤ C} (α : F ≅ G) : cone F ≌ cone G :=
{ functor := postcompose α.hom,
  inverse := postcompose α.inv,
  unit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy) }

/--
Whiskering on the left by `E : K ⥤ J` gives a functor from `cone F` to `cone (E ⋙ F)`.
-/
@[simps]
def whiskering (E : K ⥤ J) : cone F ⥤ cone (E ⋙ F) :=
{ obj := λ c, c.whisker E,
  map := λ c c' f, { hom := f.hom } }

/--
Whiskering by an equivalence gives an equivalence between categories of cones.
-/
@[simps]
def whiskering_equivalence (e : K ≌ J) :
  cone F ≌ cone (e.functor ⋙ F) :=
{ functor := whiskering e.functor,
  inverse := whiskering e.inverse ⋙ postcompose (e.inv_fun_id_assoc F).hom,
  unit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cones.ext (iso.refl _)
  (begin
    intro k,
    dsimp, -- See library note [dsimp, simp]
    simpa [e.counit_app_functor] using s.w (e.unit_inv.app k),
  end)) (by tidy), }

/--
The categories of cones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
@[simps functor inverse unit_iso counit_iso]
def equivalence_of_reindexing {G : K ⥤ C}
  (e : K ≌ J) (α : e.functor ⋙ F ≅ G) : cone F ≌ cone G :=
(whiskering_equivalence e).trans (postcompose_equivalence α)

section
variable (F)

/-- Forget the cone structure and obtain just the cone point. -/
@[simps]
def forget : cone F ⥤ C :=
{ obj := λ t, t.X, map := λ s t f, f.hom }

variables (G : C ⥤ D)

/-- A functor `G : C ⥤ D` sends cones over `F` to cones over `F ⋙ G` functorially. -/
@[simps] def functoriality : cone F ⥤ cone (F ⋙ G) :=
{ obj := λ A,
  { X := G.obj A.X,
    π := { app := λ j, G.map (A.π.app j), naturality' := by intros; erw ←G.map_comp; tidy } },
  map := λ X Y f,
  { hom := G.map f.hom,
    w' := λ j, by simp [-cone_morphism.w, ←f.w j] } }

instance functoriality_full [full G] [faithful G] : full (functoriality F G) :=
{ preimage := λ X Y t,
  { hom := G.preimage t.hom,
    w' := λ j, G.map_injective (by simpa using t.w j) } }

instance functoriality_faithful [faithful G] : faithful (cones.functoriality F G) :=
{ map_injective' := λ X Y f g e, by { ext1, injection e, apply G.map_injective h_1 } }

/--
If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cones over `F` and cones over `F ⋙ e.functor`.
-/
@[simps]
def functoriality_equivalence (e : C ≌ D) : cone F ≌ cone (F ⋙ e.functor) :=
let f : (F ⋙ e.functor) ⋙ e.inverse ≅ F :=
  functor.associator _ _ _ ≪≫ iso_whisker_left _ (e.unit_iso).symm ≪≫ functor.right_unitor _ in
{ functor := functoriality F e.functor,
  inverse := (functoriality (F ⋙ e.functor) e.inverse) ⋙
    (postcompose_equivalence f).functor,
  unit_iso := nat_iso.of_components (λ c, cones.ext (e.unit_iso.app _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c, cones.ext (e.counit_iso.app _) (by tidy)) (by tidy), }

/--
If `F` reflects isomorphisms, then `cones.functoriality F` reflects isomorphisms
as well.
-/
instance reflects_cone_isomorphism (F : C ⥤ D) [reflects_isomorphisms F] (K : J ⥤ C) :
  reflects_isomorphisms (cones.functoriality K F) :=
begin
  constructor,
  introsI,
  haveI : is_iso (F.map f.hom) :=
    (cones.forget (K ⋙ F)).map_is_iso ((cones.functoriality K F).map f),
  haveI := reflects_isomorphisms.reflects F f.hom,
  apply cone_iso_of_hom_iso
end

end

end cones

/-- A cocone morphism between two cocones for the same diagram is a morphism of the cocone points
which commutes with the cocone legs. -/
@[ext] structure cocone_morphism (A B : cocone F) :=
(hom : A.X ⟶ B.X)
(w'  : ∀ j : J, A.ι.app j ≫ hom = B.ι.app j . obviously)

instance inhabited_cocone_morphism (A : cocone F) : inhabited (cocone_morphism A A) :=
⟨{ hom := 𝟙 _ }⟩

restate_axiom cocone_morphism.w'
attribute [simp, reassoc] cocone_morphism.w

@[simps] instance cocone.category : category (cocone F) :=
{ hom  := λ A B, cocone_morphism A B,
  comp := λ _ _ _ f g,
  { hom := f.hom ≫ g.hom },
  id   := λ B, { hom := 𝟙 B.X } }

namespace cocones
/-- To give an isomorphism between cocones, it suffices to give an
  isomorphism between their vertices which commutes with the cocone
  maps. -/
@[ext, simps] def ext {c c' : cocone F}
  (φ : c.X ≅ c'.X) (w : ∀ j, c.ι.app j ≫ φ.hom = c'.ι.app j) : c ≅ c' :=
{ hom := { hom := φ.hom },
  inv := { hom := φ.inv, w' := λ j, φ.comp_inv_eq.mpr (w j).symm } }

/--
Given a cocone morphism whose object part is an isomorphism, produce an
isomorphism of cocones.
-/
lemma cocone_iso_of_hom_iso {K : J ⥤ C} {c d : cocone K} (f : c ⟶ d) [i : is_iso f.hom] :
  is_iso f :=
⟨⟨{ hom := inv f.hom,
    w' := λ j, (as_iso f.hom).comp_inv_eq.2 (f.w j).symm }, by tidy⟩⟩

/-- Functorially precompose a cocone for `F` by a natural transformation `G ⟶ F` to give a cocone
for `G`. -/
@[simps] def precompose {G : J ⥤ C} (α : G ⟶ F) : cocone F ⥤ cocone G :=
{ obj := λ c, { X := c.X, ι := α ≫ c.ι },
  map := λ c₁ c₂ f, { hom := f.hom } }

/-- Precomposing a cocone by the composite natural transformation `α ≫ β` is the same as
precomposing by `β` and then by `α`. -/
def precompose_comp {G H : J ⥤ C} (α : F ⟶ G) (β : G ⟶ H) :
  precompose (α ≫ β) ≅ precompose β ⋙ precompose α :=
nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy)

/-- Precomposing by the identity does not change the cocone up to isomorphism. -/
def precompose_id : precompose (𝟙 F) ≅ 𝟭 (cocone F) :=
nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy)

/--
If `F` and `G` are naturally isomorphic functors, then they have equivalent categories of
cocones.
-/
@[simps]
def precompose_equivalence {G : J ⥤ C} (α : G ≅ F) : cocone F ≌ cocone G :=
{ functor := precompose α.hom,
  inverse := precompose α.inv,
  unit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy) }

/--
Whiskering on the left by `E : K ⥤ J` gives a functor from `cocone F` to `cocone (E ⋙ F)`.
-/
@[simps]
def whiskering (E : K ⥤ J) : cocone F ⥤ cocone (E ⋙ F) :=
{ obj := λ c, c.whisker E,
  map := λ c c' f, { hom := f.hom, } }

/--
Whiskering by an equivalence gives an equivalence between categories of cones.
-/
@[simps]
def whiskering_equivalence (e : K ≌ J) :
  cocone F ≌ cocone (e.functor ⋙ F) :=
{ functor := whiskering e.functor,
  inverse := whiskering e.inverse ⋙
    precompose ((functor.left_unitor F).inv ≫ (whisker_right (e.counit_iso).inv F) ≫
      (functor.associator _ _ _).inv),
  unit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ s, cocones.ext (iso.refl _)
  (begin
    intro k,
    dsimp,
    simpa [e.counit_inv_app_functor k] using s.w (e.unit.app k),
  end)) (by tidy), }

/--
The categories of cocones over `F` and `G` are equivalent if `F` and `G` are naturally isomorphic
(possibly after changing the indexing category by an equivalence).
-/
@[simps functor_obj]
def equivalence_of_reindexing {G : K ⥤ C}
  (e : K ≌ J) (α : e.functor ⋙ F ≅ G) : cocone F ≌ cocone G :=
(whiskering_equivalence e).trans (precompose_equivalence α.symm)

section
variable (F)

/-- Forget the cocone structure and obtain just the cocone point. -/
@[simps]
def forget : cocone F ⥤ C :=
{ obj := λ t, t.X, map := λ s t f, f.hom }

variables (G : C ⥤ D)

/-- A functor `G : C ⥤ D` sends cocones over `F` to cocones over `F ⋙ G` functorially. -/
@[simps] def functoriality : cocone F ⥤ cocone (F ⋙ G) :=
{ obj := λ A,
  { X := G.obj A.X,
    ι := { app := λ j, G.map (A.ι.app j), naturality' := by intros; erw ←G.map_comp; tidy } },
  map := λ _ _ f,
  { hom := G.map f.hom,
    w'  := by intros; rw [←functor.map_comp, cocone_morphism.w] } }

instance functoriality_full [full G] [faithful G] : full (functoriality F G) :=
{ preimage := λ X Y t,
  { hom := G.preimage t.hom,
    w' := λ j, G.map_injective (by simpa using t.w j) } }

instance functoriality_faithful [faithful G] : faithful (functoriality F G) :=
{ map_injective' := λ X Y f g e, by { ext1, injection e, apply G.map_injective h_1 } }

/--
If `e : C ≌ D` is an equivalence of categories, then `functoriality F e.functor` induces an
equivalence between cocones over `F` and cocones over `F ⋙ e.functor`.
-/
@[simps]
def functoriality_equivalence (e : C ≌ D) : cocone F ≌ cocone (F ⋙ e.functor) :=
let f : (F ⋙ e.functor) ⋙ e.inverse ≅ F :=
  functor.associator _ _ _ ≪≫ iso_whisker_left _ (e.unit_iso).symm ≪≫ functor.right_unitor _ in
{ functor := functoriality F e.functor,
  inverse := (functoriality (F ⋙ e.functor) e.inverse) ⋙
    (precompose_equivalence f.symm).functor,
  unit_iso := nat_iso.of_components (λ c, cocones.ext (e.unit_iso.app _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c, cocones.ext (e.counit_iso.app _)
  begin
    -- Unfortunately this doesn't work by `tidy`.
    -- In this configuration `simp` reaches a dead-end and needs help.
    intros j,
    dsimp,
    simp only [←equivalence.counit_inv_app_functor, iso.inv_hom_id_app, map_comp,
      equivalence.fun_inv_map, assoc, id_comp, iso.inv_hom_id_app_assoc],
    dsimp, simp, -- See note [dsimp, simp].
  end)
  (λ c c' f, by { ext, dsimp, simp, dsimp, simp, }), }

/--
If `F` reflects isomorphisms, then `cocones.functoriality F` reflects isomorphisms
as well.
-/
instance reflects_cocone_isomorphism (F : C ⥤ D) [reflects_isomorphisms F] (K : J ⥤ C) :
  reflects_isomorphisms (cocones.functoriality K F) :=
begin
  constructor,
  introsI,
  haveI : is_iso (F.map f.hom) :=
    (cocones.forget (K ⋙ F)).map_is_iso ((cocones.functoriality K F).map f),
  haveI := reflects_isomorphisms.reflects F f.hom,
  apply cocone_iso_of_hom_iso
end

end
end cocones

end limits

namespace functor

variables {F : J ⥤ C} {G : J ⥤ C} (H : C ⥤ D)

open category_theory.limits

/-- The image of a cone in C under a functor G : C ⥤ D is a cone in D. -/
@[simps]
def map_cone   (c : cone F)   : cone (F ⋙ H)   := (cones.functoriality F H).obj c
/-- The image of a cocone in C under a functor G : C ⥤ D is a cocone in D. -/
@[simps]
def map_cocone (c : cocone F) : cocone (F ⋙ H) := (cocones.functoriality F H).obj c

/-- Given a cone morphism `c ⟶ c'`, construct a cone morphism on the mapped cones functorially.  -/
def map_cone_morphism   {c c' : cone F}   (f : c ⟶ c')   :
  H.map_cone c ⟶ H.map_cone c' := (cones.functoriality F H).map f

/-- Given a cocone morphism `c ⟶ c'`, construct a cocone morphism on the mapped cocones
functorially. -/
def map_cocone_morphism {c c' : cocone F} (f : c ⟶ c') :
  H.map_cocone c ⟶ H.map_cocone c' := (cocones.functoriality F H).map f

/-- If `H` is an equivalence, we invert `H.map_cone` and get a cone for `F` from a cone
for `F ⋙ H`.-/
def map_cone_inv [is_equivalence H]
  (c : cone (F ⋙ H)) : cone F :=
(limits.cones.functoriality_equivalence F (as_equivalence H)).inverse.obj c

/-- `map_cone` is the left inverse to `map_cone_inv`. -/
def map_cone_map_cone_inv {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cone (F ⋙ H)) :
  map_cone H (map_cone_inv H c) ≅ c :=
(limits.cones.functoriality_equivalence F (as_equivalence H)).counit_iso.app c

/-- `map_cone` is the right inverse to `map_cone_inv`. -/
def map_cone_inv_map_cone {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cone F) :
  map_cone_inv H (map_cone H c) ≅ c :=
(limits.cones.functoriality_equivalence F (as_equivalence H)).unit_iso.symm.app c
/-- If `H` is an equivalence, we invert `H.map_cone` and get a cone for `F` from a cone
for `F ⋙ H`.-/

def map_cocone_inv [is_equivalence H]
  (c : cocone (F ⋙ H)) : cocone F :=
(limits.cocones.functoriality_equivalence F (as_equivalence H)).inverse.obj c

/-- `map_cocone` is the left inverse to `map_cocone_inv`. -/
def map_cocone_map_cocone_inv {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cocone (F ⋙ H)) :
  map_cocone H (map_cocone_inv H c) ≅ c :=
(limits.cocones.functoriality_equivalence F (as_equivalence H)).counit_iso.app c

/-- `map_cocone` is the right inverse to `map_cocone_inv`. -/
def map_cocone_inv_map_cocone {F : J ⥤ D} (H : D ⥤ C) [is_equivalence H] (c : cocone F) :
  map_cocone_inv H (map_cocone H c) ≅ c :=
(limits.cocones.functoriality_equivalence F (as_equivalence H)).unit_iso.symm.app c

/-- `functoriality F _ ⋙ postcompose (whisker_left F _)` simplifies to `functoriality F _`. -/
@[simps]
def functoriality_comp_postcompose {H H' : C ⥤ D} (α : H ≅ H') :
  cones.functoriality F H ⋙ cones.postcompose (whisker_left F α.hom) ≅ cones.functoriality F H' :=
nat_iso.of_components (λ c, cones.ext (α.app _) (by tidy)) (by tidy)

/--
For `F : J ⥤ C`, given a cone `c : cone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the postcomposition of the cone `H.map_cone` using the isomorphism `α` is
isomorphic to the cone `H'.map_cone`.
-/
@[simps]
def postcompose_whisker_left_map_cone {H H' : C ⥤ D} (α : H ≅ H') (c : cone F) :
  (cones.postcompose (whisker_left F α.hom : _)).obj (H.map_cone c) ≅ H'.map_cone c :=
(functoriality_comp_postcompose α).app c

/--
`map_cone` commutes with `postcompose`. In particular, for `F : J ⥤ C`, given a cone `c : cone F`, a
natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious ways of producing
a cone over `G ⋙ H`, and they are both isomorphic.
-/
@[simps]
def map_cone_postcompose {α : F ⟶ G} {c} :
  H.map_cone ((cones.postcompose α).obj c) ≅
  (cones.postcompose (whisker_right α H : _)).obj (H.map_cone c) :=
cones.ext (iso.refl _) (by tidy)

/--
`map_cone` commutes with `postcompose_equivalence`
-/
@[simps]
def map_cone_postcompose_equivalence_functor {α : F ≅ G} {c} :
  H.map_cone ((cones.postcompose_equivalence α).functor.obj c) ≅
    (cones.postcompose_equivalence (iso_whisker_right α H : _)).functor.obj (H.map_cone c) :=
cones.ext (iso.refl _) (by tidy)

/-- `functoriality F _ ⋙ precompose (whisker_left F _)` simplifies to `functoriality F _`. -/
@[simps]
def functoriality_comp_precompose {H H' : C ⥤ D} (α : H ≅ H') :
   cocones.functoriality F H ⋙ cocones.precompose (whisker_left F α.inv)
 ≅ cocones.functoriality F H' :=
nat_iso.of_components (λ c, cocones.ext (α.app _) (by tidy)) (by tidy)

/--
For `F : J ⥤ C`, given a cocone `c : cocone F`, and a natural isomorphism `α : H ≅ H'` for functors
`H H' : C ⥤ D`, the precomposition of the cocone `H.map_cocone` using the isomorphism `α` is
isomorphic to the cocone `H'.map_cocone`.
-/
@[simps]
def precompose_whisker_left_map_cocone {H H' : C ⥤ D} (α : H ≅ H') (c : cocone F) :
  (cocones.precompose (whisker_left F α.inv : _)).obj (H.map_cocone c) ≅ H'.map_cocone c :=
(functoriality_comp_precompose α).app c

/--
`map_cocone` commutes with `precompose`. In particular, for `F : J ⥤ C`, given a cocone
`c : cocone F`, a natural transformation `α : F ⟶ G` and a functor `H : C ⥤ D`, we have two obvious
ways of producing a cocone over `G ⋙ H`, and they are both isomorphic.
-/
@[simps]
def map_cocone_precompose {α : F ⟶ G} {c} :
  H.map_cocone ((cocones.precompose α).obj c) ≅
  (cocones.precompose (whisker_right α H : _)).obj (H.map_cocone c) :=
cocones.ext (iso.refl _) (by tidy)

/--
`map_cocone` commutes with `precompose_equivalence`
-/
@[simps]
def map_cocone_precompose_equivalence_functor {α : F ≅ G} {c} :
  H.map_cocone ((cocones.precompose_equivalence α).functor.obj c) ≅
    (cocones.precompose_equivalence (iso_whisker_right α H : _)).functor.obj (H.map_cocone c) :=
cocones.ext (iso.refl _) (by tidy)

/--
`map_cone` commutes with `whisker`
-/
@[simps]
def map_cone_whisker {E : K ⥤ J} {c : cone F} :
  H.map_cone (c.whisker E) ≅ (H.map_cone c).whisker E :=
cones.ext (iso.refl _) (by tidy)

/--
`map_cocone` commutes with `whisker`
-/
@[simps]
def map_cocone_whisker {E : K ⥤ J} {c : cocone F} :
  H.map_cocone (c.whisker E) ≅ (H.map_cocone c).whisker E :=
cocones.ext (iso.refl _) (by tidy)

end functor

end category_theory

namespace category_theory.limits

section
variables {F : J ⥤ C}

/-- Change a `cocone F` into a `cone F.op`. -/
@[simps] def cocone.op (c : cocone F) : cone F.op :=
{ X := op c.X,
  π :=
  { app := λ j, (c.ι.app (unop j)).op,
    naturality' := λ j j' f, quiver.hom.unop_inj (by tidy) } }

/-- Change a `cone F` into a `cocone F.op`. -/
@[simps] def cone.op (c : cone F) : cocone F.op :=
{ X := op c.X,
  ι :=
  { app := λ j, (c.π.app (unop j)).op,
    naturality' := λ j j' f, quiver.hom.unop_inj (by tidy) } }

/-- Change a `cocone F.op` into a `cone F`. -/
@[simps] def cocone.unop (c : cocone F.op) : cone F :=
{ X := unop c.X,
  π :=
  { app := λ j, (c.ι.app (op j)).unop,
    naturality' := λ j j' f, quiver.hom.op_inj (c.ι.naturality f.op).symm } }

/-- Change a `cone F.op` into a `cocone F`. -/
@[simps] def cone.unop (c : cone F.op) : cocone F :=
{ X := unop c.X,
  ι :=
  { app := λ j, (c.π.app (op j)).unop,
    naturality' := λ j j' f, quiver.hom.op_inj (c.π.naturality f.op).symm } }

variables (F)

/--
The category of cocones on `F`
is equivalent to the opposite category of
the category of cones on the opposite of `F`.
-/
@[simps]
def cocone_equivalence_op_cone_op : cocone F ≌ (cone F.op)ᵒᵖ :=
{ functor :=
  { obj := λ c, op (cocone.op c),
    map := λ X Y f, quiver.hom.op
    { hom := f.hom.op,
      w' := λ j, by { apply quiver.hom.unop_inj, dsimp, simp, }, } },
  inverse :=
  { obj := λ c, cone.unop (unop c),
    map := λ X Y f,
    { hom := f.unop.hom.unop,
      w' := λ j, by { apply quiver.hom.op_inj, dsimp, simp, }, } },
  unit_iso := nat_iso.of_components (λ c, cocones.ext (iso.refl _) (by tidy)) (by tidy),
  counit_iso := nat_iso.of_components (λ c,
    by { op_induction c, dsimp, apply iso.op, exact cones.ext (iso.refl _) (by tidy), })
    begin
      intros,
      have hX : X = op (unop X) := rfl,
      revert hX,
      generalize : unop X = X',
      rintro rfl,
      have hY : Y = op (unop Y) := rfl,
      revert hY,
      generalize : unop Y = Y',
      rintro rfl,
      apply quiver.hom.unop_inj,
      apply cone_morphism.ext,
      dsimp, simp,
    end,
  functor_unit_iso_comp' := λ c, begin apply quiver.hom.unop_inj, ext, dsimp, simp, end }

end

section
variables {F : J ⥤ Cᵒᵖ}

/-- Change a cocone on `F.left_op : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
-- Here and below we only automatically generate the `@[simp]` lemma for the `X` field,
-- as we can write a simpler `rfl` lemma for the components of the natural transformation by hand.
@[simps {rhs_md := semireducible, simp_rhs := tt}]
def cone_of_cocone_left_op (c : cocone F.left_op) : cone F :=
{ X := op c.X,
  π := nat_trans.remove_left_op (c.ι ≫ (const.op_obj_unop (op c.X)).hom) }

/-- Change a cone on `F : J ⥤ Cᵒᵖ` to a cocone on `F.left_op : Jᵒᵖ ⥤ C`. -/
@[simps {rhs_md := semireducible, simp_rhs := tt}]
def cocone_left_op_of_cone (c : cone F) : cocone (F.left_op) :=
{ X := unop c.X,
  ι := nat_trans.left_op c.π }

/-- Change a cone on `F.left_op : Jᵒᵖ ⥤ C` to a cocone on `F : J ⥤ Cᵒᵖ`. -/
/- When trying use `@[simps]` to generate the `ι_app` field of this definition, `@[simps]` tries to
  reduce the RHS using `expr.dsimp` and `expr.simp`, but for some reason the expression is not
  being simplified properly. -/
@[simps X]
def cocone_of_cone_left_op (c : cone F.left_op) : cocone F :=
{ X := op c.X,
  ι := nat_trans.remove_left_op ((const.op_obj_unop (op c.X)).hom ≫ c.π) }

@[simp] lemma cocone_of_cone_left_op_ι_app (c : cone F.left_op) (j) :
  (cocone_of_cone_left_op c).ι.app j = (c.π.app (op j)).op :=
by { dsimp [cocone_of_cone_left_op], simp }

/-- Change a cocone on `F : J ⥤ Cᵒᵖ` to a cone on `F.left_op : Jᵒᵖ ⥤ C`. -/
@[simps {rhs_md := semireducible, simp_rhs := tt}]
def cone_left_op_of_cocone (c : cocone F) : cone (F.left_op) :=
{ X := unop c.X,
  π := nat_trans.left_op c.ι }

end

end category_theory.limits

namespace category_theory.functor

open category_theory.limits

variables {F : J ⥤ C}

section
variables (G : C ⥤ D)

/-- The opposite cocone of the image of a cone is the image of the opposite cocone. -/
@[simps {rhs_md := semireducible}]
def map_cone_op (t : cone F) : (G.map_cone t).op ≅ (G.op.map_cocone t.op) :=
cocones.ext (iso.refl _) (by tidy)

/-- The opposite cone of the image of a cocone is the image of the opposite cone. -/
@[simps {rhs_md := semireducible}]
def map_cocone_op {t : cocone F} : (G.map_cocone t).op ≅ (G.op.map_cone t.op) :=
cones.ext (iso.refl _) (by tidy)

end

end category_theory.functor


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Yury Kudryashov.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.prod
import Mathlib.algebra.group.type_tags
import Mathlib.algebra.group.pi
import Mathlib.algebra.pointwise
import Mathlib.data.equiv.basic
import Mathlib.data.set.finite
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4 u v w

namespace Mathlib

/-!
# Torsors of additive group actions

This file defines torsors of additive group actions.

## Notations

The group elements are referred to as acting on points.  This file
defines the notation `+ᵥ` for adding a group element to a point and
`-ᵥ` for subtracting two points to produce a group element.

## Implementation notes

Affine spaces are the motivating example of torsors of additive group actions. It may be appropriate
to refactor in terms of the general definition of group actions, via `to_additive`, when there is a
use for multiplicative torsors (currently mathlib only develops the theory of group actions for
multiplicative group actions).

## Notations

* `v +ᵥ p` is a notation for `has_vadd.vadd`, the left action of an additive monoid;

* `p₁ -ᵥ p₂` is a notation for `has_vsub.vsub`, difference between two points in an additive torsor
  as an element of the corresponding additive group;

## References

* https://en.wikipedia.org/wiki/Principal_homogeneous_space
* https://en.wikipedia.org/wiki/Affine_space

-/

/-- Type class for the `+ᵥ` notation. -/
class has_vadd (G : Type u_1) (P : Type u_2) where
  vadd : G → P → P

/-- Type class for the `-ᵥ` notation. -/
class has_vsub (G : outParam (Type u_1)) (P : Type u_2) where
  vsub : P → P → G

infixl:65 " +ᵥ " => Mathlib.has_vadd.vadd

infixl:65 " -ᵥ " => Mathlib.has_vsub.vsub

/-- Type class for additive monoid actions. -/
class add_action (G : Type u_1) (P : Type u_2) [add_monoid G] extends has_vadd G P where
  zero_vadd' : ∀ (p : P), 0 +ᵥ p = p
  vadd_assoc' : ∀ (g1 g2 : G) (p : P), g1 +ᵥ (g2 +ᵥ p) = g1 + g2 +ᵥ p

/-- An `add_torsor G P` gives a structure to the nonempty type `P`,
acted on by an `add_group G` with a transitive and free action given
by the `+ᵥ` operation and a corresponding subtraction given by the
`-ᵥ` operation. In the case of a vector space, it is an affine
space. -/
class add_torsor (G : outParam (Type u_1)) (P : Type u_2) [outParam (add_group G)]
    extends has_vsub G P, add_action G P where
  nonempty : Nonempty P
  vsub_vadd' : ∀ (p1 p2 : P), p1 -ᵥ p2 +ᵥ p2 = p1
  vadd_vsub' : ∀ (g : G) (p : P), g +ᵥ p -ᵥ p = g

/-- An `add_group G` is a torsor for itself. -/
protected instance add_group_is_add_torsor (G : Type u_1) [add_group G] : add_torsor G G :=
  add_torsor.mk Add.add sorry sorry Sub.sub sub_add_cancel add_sub_cancel

/-- Simplify addition for a torsor for an `add_group G` over
itself. -/
@[simp] theorem vadd_eq_add {G : Type u_1} [add_group G] (g1 : G) (g2 : G) : g1 +ᵥ g2 = g1 + g2 :=
  rfl

/-- Simplify subtraction for a torsor for an `add_group G` over
itself. -/
@[simp] theorem vsub_eq_sub {G : Type u_1} [add_group G] (g1 : G) (g2 : G) : g1 -ᵥ g2 = g1 - g2 :=
  rfl

/-- Adding the zero group element to a point gives the same point. -/
@[simp] theorem zero_vadd (G : Type u_1) {P : Type u_2} [add_monoid G] [A : add_action G P]
    (p : P) : 0 +ᵥ p = p :=
  add_action.zero_vadd' p

/-- Adding two group elements to a point produces the same result as
adding their sum. -/
theorem vadd_assoc {G : Type u_1} {P : Type u_2} [add_monoid G] [A : add_action G P] (g1 : G)
    (g2 : G) (p : P) : g1 +ᵥ (g2 +ᵥ p) = g1 + g2 +ᵥ p :=
  add_action.vadd_assoc' g1 g2 p

/-- Adding two group elements to a point produces the same result in either
order. -/
theorem vadd_comm (G : Type u_1) {P : Type u_2} [add_comm_monoid G] [A : add_action G P] (p : P)
    (g1 : G) (g2 : G) : g1 +ᵥ (g2 +ᵥ p) = g2 +ᵥ (g1 +ᵥ p) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (g1 +ᵥ (g2 +ᵥ p) = g2 +ᵥ (g1 +ᵥ p))) (vadd_assoc g1 g2 p)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (g1 + g2 +ᵥ p = g2 +ᵥ (g1 +ᵥ p))) (vadd_assoc g2 g1 p)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (g1 + g2 +ᵥ p = g2 + g1 +ᵥ p)) (add_comm g1 g2)))
        (Eq.refl (g2 + g1 +ᵥ p))))

/-- If the same group element added to two points produces equal results,
those points are equal. -/
theorem vadd_left_cancel {G : Type u_1} {P : Type u_2} [add_group G] [A : add_action G P] {p1 : P}
    {p2 : P} (g : G) (h : g +ᵥ p1 = g +ᵥ p2) : p1 = p2 :=
  sorry

@[simp] theorem vadd_left_cancel_iff {G : Type u_1} {P : Type u_2} [add_group G]
    [A : add_action G P] {p₁ : P} {p₂ : P} (g : G) : g +ᵥ p₁ = g +ᵥ p₂ ↔ p₁ = p₂ :=
  { mp := vadd_left_cancel g, mpr := fun (h : p₁ = p₂) => h ▸ rfl }

/-- Adding the group element `g` to a point is an injective function. -/
theorem vadd_left_injective {G : Type u_1} (P : Type u_2) [add_group G] [A : add_action G P]
    (g : G) : function.injective (has_vadd.vadd g) :=
  fun (p1 p2 : P) => vadd_left_cancel g

/-- Adding the result of subtracting from another point produces that
point. -/
@[simp] theorem vsub_vadd {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] (p1 : P)
    (p2 : P) : p1 -ᵥ p2 +ᵥ p2 = p1 :=
  add_torsor.vsub_vadd' p1 p2

/-- Adding a group element then subtracting the original point
produces that group element. -/
@[simp] theorem vadd_vsub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] (g : G)
    (p : P) : g +ᵥ p -ᵥ p = g :=
  add_torsor.vadd_vsub' g p

/-- If the same point added to two group elements produces equal
results, those group elements are equal. -/
theorem vadd_right_cancel {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {g1 : G}
    {g2 : G} (p : P) (h : g1 +ᵥ p = g2 +ᵥ p) : g1 = g2 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (g1 = g2)) (Eq.symm (vadd_vsub g1 p))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (g1 +ᵥ p -ᵥ p = g2)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (g2 +ᵥ p -ᵥ p = g2)) (vadd_vsub g2 p))) (Eq.refl g2)))

@[simp] theorem vadd_right_cancel_iff {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] {g1 : G} {g2 : G} (p : P) : g1 +ᵥ p = g2 +ᵥ p ↔ g1 = g2 :=
  { mp := vadd_right_cancel p, mpr := fun (h : g1 = g2) => h ▸ rfl }

/-- Adding a group element to the point `p` is an injective
function. -/
theorem vadd_right_injective {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (p : P) : function.injective fun (_x : G) => _x +ᵥ p :=
  fun (g1 g2 : G) => vadd_right_cancel p

/-- Adding a group element to a point, then subtracting another point,
produces the same result as subtracting the points then adding the
group element. -/
theorem vadd_vsub_assoc {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] (g : G)
    (p1 : P) (p2 : P) : g +ᵥ p1 -ᵥ p2 = g + (p1 -ᵥ p2) :=
  sorry

/-- Subtracting a point from itself produces 0. -/
@[simp] theorem vsub_self {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] (p : P) :
    p -ᵥ p = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (p -ᵥ p = 0)) (Eq.symm (zero_add (p -ᵥ p)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 + (p -ᵥ p) = 0)) (Eq.symm (vadd_vsub_assoc 0 p p))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 +ᵥ p -ᵥ p = 0)) (vadd_vsub 0 p))) (Eq.refl 0)))

/-- If subtracting two points produces 0, they are equal. -/
theorem eq_of_vsub_eq_zero {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {p1 : P}
    {p2 : P} (h : p1 -ᵥ p2 = 0) : p1 = p2 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (p1 = p2)) (Eq.symm (vsub_vadd p1 p2))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (p1 -ᵥ p2 +ᵥ p2 = p2)) h))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 +ᵥ p2 = p2)) (zero_vadd G p2))) (Eq.refl p2)))

/-- Subtracting two points produces 0 if and only if they are
equal. -/
@[simp] theorem vsub_eq_zero_iff_eq {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    {p1 : P} {p2 : P} : p1 -ᵥ p2 = 0 ↔ p1 = p2 :=
  { mp := eq_of_vsub_eq_zero, mpr := fun (h : p1 = p2) => h ▸ vsub_self p1 }

/-- Cancellation adding the results of two subtractions. -/
@[simp] theorem vsub_add_vsub_cancel {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] (p1 : P) (p2 : P) (p3 : P) : p1 -ᵥ p2 + (p2 -ᵥ p3) = p1 -ᵥ p3 :=
  sorry

/-- Subtracting two points in the reverse order produces the negation
of subtracting them. -/
@[simp] theorem neg_vsub_eq_vsub_rev {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] (p1 : P) (p2 : P) : -(p1 -ᵥ p2) = p2 -ᵥ p1 :=
  sorry

/-- Subtracting the result of adding a group element produces the same result
as subtracting the points and subtracting that group element. -/
theorem vsub_vadd_eq_vsub_sub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (p1 : P) (p2 : P) (g : G) : p1 -ᵥ (g +ᵥ p2) = p1 -ᵥ p2 - g :=
  sorry

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] theorem vsub_sub_vsub_cancel_right {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] (p1 : P) (p2 : P) (p3 : P) : p1 -ᵥ p3 - (p2 -ᵥ p3) = p1 -ᵥ p2 :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (p1 -ᵥ p3 - (p2 -ᵥ p3) = p1 -ᵥ p2))
        (Eq.symm (vsub_vadd_eq_vsub_sub p1 p3 (p2 -ᵥ p3)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (p1 -ᵥ (p2 -ᵥ p3 +ᵥ p3) = p1 -ᵥ p2)) (vsub_vadd p2 p3)))
      (Eq.refl (p1 -ᵥ p2)))

/-- Convert between an equality with adding a group element to a point
and an equality of a subtraction of two points with a group
element. -/
theorem eq_vadd_iff_vsub_eq {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (p1 : P) (g : G) (p2 : P) : p1 = g +ᵥ p2 ↔ p1 -ᵥ p2 = g :=
  { mp := fun (h : p1 = g +ᵥ p2) => Eq.symm h ▸ vadd_vsub g p2,
    mpr := fun (h : p1 -ᵥ p2 = g) => h ▸ Eq.symm (vsub_vadd p1 p2) }

theorem vadd_eq_vadd_iff_neg_add_eq_vsub {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] {v₁ : G} {v₂ : G} {p₁ : P} {p₂ : P} :
    v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ -v₁ + v₂ = p₁ -ᵥ p₂ :=
  sorry

namespace set

protected instance has_vsub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] :
    has_vsub (set G) (set P) :=
  has_vsub.mk (image2 has_vsub.vsub)

@[simp] theorem vsub_empty {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (s : set P) : s -ᵥ ∅ = ∅ :=
  image2_empty_right

@[simp] theorem empty_vsub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (s : set P) : ∅ -ᵥ s = ∅ :=
  image2_empty_left

@[simp] theorem singleton_vsub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (s : set P) (p : P) : singleton p -ᵥ s = has_vsub.vsub p '' s :=
  image2_singleton_left

@[simp] theorem vsub_singleton {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (s : set P) (p : P) : s -ᵥ singleton p = (fun (_x : P) => _x -ᵥ p) '' s :=
  image2_singleton_right

@[simp] theorem singleton_vsub_self {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (p : P) : singleton p -ᵥ singleton p = singleton 0 :=
  sorry

/-- `vsub` of a finite set is finite. -/
theorem finite.vsub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {s : set P}
    {t : set P} (hs : finite s) (ht : finite t) : finite (s -ᵥ t) :=
  finite.image2 (fun (a b : P) => a -ᵥ b) hs ht

/-- Each pairwise difference is in the `vsub` set. -/
theorem vsub_mem_vsub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {s : set P}
    {t : set P} {ps : P} {pt : P} (hs : ps ∈ s) (ht : pt ∈ t) : ps -ᵥ pt ∈ s -ᵥ t :=
  mem_image2_of_mem hs ht

/-- `s -ᵥ t` is monotone in both arguments. -/
theorem vsub_subset_vsub {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    {s : set P} {t : set P} {s' : set P} {t' : set P} (hs : s ⊆ s') (ht : t ⊆ t') :
    s -ᵥ t ⊆ s' -ᵥ t' :=
  image2_subset hs ht

theorem vsub_self_mono {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {s : set P}
    {t : set P} (h : s ⊆ t) : s -ᵥ s ⊆ t -ᵥ t :=
  vsub_subset_vsub h h

theorem vsub_subset_iff {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {s : set P}
    {t : set P} {u : set G} : s -ᵥ t ⊆ u ↔ ∀ (x : P), x ∈ s → ∀ (y : P), y ∈ t → x -ᵥ y ∈ u :=
  image2_subset_iff

protected instance add_action {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] :
    add_action (set G) (set P) :=
  add_action.mk (image2 has_vadd.vadd) sorry sorry

theorem vadd_subset_vadd {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    {s : set G} {s' : set G} {t : set P} {t' : set P} (hs : s ⊆ s') (ht : t ⊆ t') :
    s +ᵥ t ⊆ s' +ᵥ t' :=
  image2_subset hs ht

@[simp] theorem vadd_singleton {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (s : set G) (p : P) : s +ᵥ singleton p = (fun (_x : G) => _x +ᵥ p) '' s :=
  image2_singleton_right

@[simp] theorem singleton_vadd {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (v : G) (s : set P) : singleton v +ᵥ s = has_vadd.vadd v '' s :=
  image2_singleton_left

theorem finite.vadd {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {s : set G}
    {t : set P} (hs : finite s) (ht : finite t) : finite (s +ᵥ t) :=
  finite.image2 (fun (a : G) (b : P) => a +ᵥ b) hs ht

end set

@[simp] theorem vadd_vsub_vadd_cancel_right {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] (v₁ : G) (v₂ : G) (p : P) : v₁ +ᵥ p -ᵥ (v₂ +ᵥ p) = v₁ - v₂ :=
  sorry

/-- If the same point subtracted from two points produces equal
results, those points are equal. -/
theorem vsub_left_cancel {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {p1 : P}
    {p2 : P} {p : P} (h : p1 -ᵥ p = p2 -ᵥ p) : p1 = p2 :=
  eq.mp (Eq._oldrec (Eq.refl (p1 -ᵥ p2 = 0)) (propext vsub_eq_zero_iff_eq))
    (eq.mp (Eq._oldrec (Eq.refl (p1 -ᵥ p - (p2 -ᵥ p) = 0)) (vsub_sub_vsub_cancel_right p1 p2 p))
      (eq.mp (Eq._oldrec (Eq.refl (p1 -ᵥ p = p2 -ᵥ p)) (Eq.symm (propext sub_eq_zero))) h))

/-- The same point subtracted from two points produces equal results
if and only if those points are equal. -/
@[simp] theorem vsub_left_cancel_iff {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] {p1 : P} {p2 : P} {p : P} : p1 -ᵥ p = p2 -ᵥ p ↔ p1 = p2 :=
  { mp := vsub_left_cancel, mpr := fun (h : p1 = p2) => h ▸ rfl }

/-- Subtracting the point `p` is an injective function. -/
theorem vsub_left_injective {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (p : P) : function.injective fun (_x : P) => _x -ᵥ p :=
  fun (p2 p3 : P) => vsub_left_cancel

/-- If subtracting two points from the same point produces equal
results, those points are equal. -/
theorem vsub_right_cancel {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P] {p1 : P}
    {p2 : P} {p : P} (h : p -ᵥ p1 = p -ᵥ p2) : p1 = p2 :=
  sorry

/-- Subtracting two points from the same point produces equal results
if and only if those points are equal. -/
@[simp] theorem vsub_right_cancel_iff {G : Type u_1} {P : Type u_2} [add_group G]
    [T : add_torsor G P] {p1 : P} {p2 : P} {p : P} : p -ᵥ p1 = p -ᵥ p2 ↔ p1 = p2 :=
  { mp := vsub_right_cancel, mpr := fun (h : p1 = p2) => h ▸ rfl }

/-- Subtracting a point from the point `p` is an injective
function. -/
theorem vsub_right_injective {G : Type u_1} {P : Type u_2} [add_group G] [T : add_torsor G P]
    (p : P) : function.injective (has_vsub.vsub p) :=
  fun (p2 p3 : P) => vsub_right_cancel

/-- Cancellation subtracting the results of two subtractions. -/
@[simp] theorem vsub_sub_vsub_cancel_left {G : Type u_1} {P : Type u_2} [add_comm_group G]
    [add_torsor G P] (p1 : P) (p2 : P) (p3 : P) : p3 -ᵥ p2 - (p3 -ᵥ p1) = p1 -ᵥ p2 :=
  sorry

@[simp] theorem vadd_vsub_vadd_cancel_left {G : Type u_1} {P : Type u_2} [add_comm_group G]
    [add_torsor G P] (v : G) (p1 : P) (p2 : P) : v +ᵥ p1 -ᵥ (v +ᵥ p2) = p1 -ᵥ p2 :=
  sorry

theorem vsub_vadd_comm {G : Type u_1} {P : Type u_2} [add_comm_group G] [add_torsor G P] (p1 : P)
    (p2 : P) (p3 : P) : p1 -ᵥ p2 +ᵥ p3 = p3 -ᵥ p2 +ᵥ p1 :=
  sorry

theorem vadd_eq_vadd_iff_sub_eq_vsub {G : Type u_1} {P : Type u_2} [add_comm_group G]
    [add_torsor G P] {v₁ : G} {v₂ : G} {p₁ : P} {p₂ : P} :
    v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ v₂ - v₁ = p₁ -ᵥ p₂ :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (v₁ +ᵥ p₁ = v₂ +ᵥ p₂ ↔ v₂ - v₁ = p₁ -ᵥ p₂))
        (propext vadd_eq_vadd_iff_neg_add_eq_vsub)))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (-v₁ + v₂ = p₁ -ᵥ p₂ ↔ v₂ - v₁ = p₁ -ᵥ p₂)) (neg_add_eq_sub v₁ v₂)))
      (iff.refl (v₂ - v₁ = p₁ -ᵥ p₂)))

theorem vsub_sub_vsub_comm {G : Type u_1} {P : Type u_2} [add_comm_group G] [add_torsor G P]
    (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) : p₁ -ᵥ p₂ - (p₃ -ᵥ p₄) = p₁ -ᵥ p₃ - (p₂ -ᵥ p₄) :=
  sorry

namespace prod

protected instance add_torsor {G : Type u_1} {P : Type u_2} {G' : Type u_3} {P' : Type u_4}
    [add_group G] [add_group G'] [add_torsor G P] [add_torsor G' P'] :
    add_torsor (G × G') (P × P') :=
  add_torsor.mk (fun (v : G × G') (p : P × P') => (fst v +ᵥ fst p, snd v +ᵥ snd p)) sorry sorry
    (fun (p₁ p₂ : P × P') => (fst p₁ -ᵥ fst p₂, snd p₁ -ᵥ snd p₂)) sorry sorry

@[simp] theorem fst_vadd {G : Type u_1} {P : Type u_2} {G' : Type u_3} {P' : Type u_4} [add_group G]
    [add_group G'] [add_torsor G P] [add_torsor G' P'] (v : G × G') (p : P × P') :
    fst (v +ᵥ p) = fst v +ᵥ fst p :=
  rfl

@[simp] theorem snd_vadd {G : Type u_1} {P : Type u_2} {G' : Type u_3} {P' : Type u_4} [add_group G]
    [add_group G'] [add_torsor G P] [add_torsor G' P'] (v : G × G') (p : P × P') :
    snd (v +ᵥ p) = snd v +ᵥ snd p :=
  rfl

@[simp] theorem mk_vadd_mk {G : Type u_1} {P : Type u_2} {G' : Type u_3} {P' : Type u_4}
    [add_group G] [add_group G'] [add_torsor G P] [add_torsor G' P'] (v : G) (v' : G') (p : P)
    (p' : P') : (v, v') +ᵥ (p, p') = (v +ᵥ p, v' +ᵥ p') :=
  rfl

@[simp] theorem fst_vsub {G : Type u_1} {P : Type u_2} {G' : Type u_3} {P' : Type u_4} [add_group G]
    [add_group G'] [add_torsor G P] [add_torsor G' P'] (p₁ : P × P') (p₂ : P × P') :
    fst (p₁ -ᵥ p₂) = fst p₁ -ᵥ fst p₂ :=
  rfl

@[simp] theorem snd_vsub {G : Type u_1} {P : Type u_2} {G' : Type u_3} {P' : Type u_4} [add_group G]
    [add_group G'] [add_torsor G P] [add_torsor G' P'] (p₁ : P × P') (p₂ : P × P') :
    snd (p₁ -ᵥ p₂) = snd p₁ -ᵥ snd p₂ :=
  rfl

@[simp] theorem mk_vsub_mk {G : Type u_1} {P : Type u_2} {G' : Type u_3} {P' : Type u_4}
    [add_group G] [add_group G'] [add_torsor G P] [add_torsor G' P'] (p₁ : P) (p₂ : P) (p₁' : P')
    (p₂' : P') : (p₁, p₁') -ᵥ (p₂, p₂') = (p₁ -ᵥ p₂, p₁' -ᵥ p₂') :=
  rfl

end prod

namespace pi

/-- A product of `add_torsor`s is an `add_torsor`. -/
protected instance add_torsor {I : Type u} {fg : I → Type v} [(i : I) → add_group (fg i)]
    {fp : I → Type w} [T : (i : I) → add_torsor (fg i) (fp i)] :
    add_torsor ((i : I) → fg i) ((i : I) → fp i) :=
  add_torsor.mk (fun (g : (i : I) → fg i) (p : (i : I) → fp i) (i : I) => g i +ᵥ p i) sorry sorry
    (fun (p₁ p₂ : (i : I) → fp i) (i : I) => p₁ i -ᵥ p₂ i) sorry sorry

/-- Addition in a product of `add_torsor`s. -/
@[simp] theorem vadd_apply {I : Type u} {fg : I → Type v} [(i : I) → add_group (fg i)]
    {fp : I → Type w} [T : (i : I) → add_torsor (fg i) (fp i)] (x : (i : I) → fg i)
    (y : (i : I) → fp i) {i : I} : has_vadd.vadd x y i = x i +ᵥ y i :=
  rfl

end pi

namespace equiv

/-- `v ↦ v +ᵥ p` as an equivalence. -/
def vadd_const {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P] (p : P) : G ≃ P :=
  mk (fun (v : G) => v +ᵥ p) (fun (p' : P) => p' -ᵥ p) sorry sorry

@[simp] theorem coe_vadd_const {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P]
    (p : P) : ⇑(vadd_const p) = fun (v : G) => v +ᵥ p :=
  rfl

@[simp] theorem coe_vadd_const_symm {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P]
    (p : P) : ⇑(equiv.symm (vadd_const p)) = fun (p' : P) => p' -ᵥ p :=
  rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P] (p : P) : P ≃ G :=
  mk (has_vsub.vsub p) (fun (v : G) => -v +ᵥ p) sorry sorry

@[simp] theorem coe_const_vsub {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P]
    (p : P) : ⇑(const_vsub p) = has_vsub.vsub p :=
  rfl

@[simp] theorem coe_const_vsub_symm {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P]
    (p : P) : ⇑(equiv.symm (const_vsub p)) = fun (v : G) => -v +ᵥ p :=
  rfl

/-- The permutation given by `p ↦ v +ᵥ p`. -/
def const_vadd {G : Type u_1} (P : Type u_2) [add_group G] [add_torsor G P] (v : G) : perm P :=
  mk (has_vadd.vadd v) (has_vadd.vadd (-v)) sorry sorry

@[simp] theorem coe_const_vadd {G : Type u_1} (P : Type u_2) [add_group G] [add_torsor G P]
    (v : G) : ⇑(const_vadd P v) = has_vadd.vadd v :=
  rfl

@[simp] theorem const_vadd_zero (G : Type u_1) (P : Type u_2) [add_group G] [add_torsor G P] :
    const_vadd P 0 = 1 :=
  ext (zero_vadd G)

@[simp] theorem const_vadd_add {G : Type u_1} (P : Type u_2) [add_group G] [add_torsor G P] (v₁ : G)
    (v₂ : G) : const_vadd P (v₁ + v₂) = const_vadd P v₁ * const_vadd P v₂ :=
  ext fun (p : P) => Eq.symm (vadd_assoc v₁ v₂ p)

/-- `equiv.const_vadd` as a homomorphism from `multiplicative G` to `equiv.perm P` -/
def const_vadd_hom {G : Type u_1} (P : Type u_2) [add_group G] [add_torsor G P] :
    multiplicative G →* perm P :=
  monoid_hom.mk (fun (v : multiplicative G) => const_vadd P (coe_fn multiplicative.to_add v))
    (const_vadd_zero G P) sorry

/-- Point reflection in `x` as a permutation. -/
def point_reflection {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P] (x : P) :
    perm P :=
  equiv.trans (const_vsub x) (vadd_const x)

theorem point_reflection_apply {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P] (x : P)
    (y : P) : coe_fn (point_reflection x) y = x -ᵥ y +ᵥ x :=
  rfl

@[simp] theorem point_reflection_symm {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P]
    (x : P) : equiv.symm (point_reflection x) = point_reflection x :=
  sorry

@[simp] theorem point_reflection_self {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P]
    (x : P) : coe_fn (point_reflection x) x = x :=
  vsub_vadd x x

theorem point_reflection_involutive {G : Type u_1} {P : Type u_2} [add_group G] [add_torsor G P]
    (x : P) : function.involutive ⇑(point_reflection x) :=
  sorry

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
theorem point_reflection_fixed_iff_of_injective_bit0 {G : Type u_1} {P : Type u_2} [add_group G]
    [add_torsor G P] {x : P} {y : P} (h : function.injective bit0) :
    coe_fn (point_reflection x) y = y ↔ y = x :=
  sorry

theorem injective_point_reflection_left_of_injective_bit0 {G : Type u_1} {P : Type u_2}
    [add_comm_group G] [add_torsor G P] (h : function.injective bit0) (y : P) :
    function.injective fun (x : P) => coe_fn (point_reflection x) y :=
  sorry

end Mathlib


/-
Copyright (c) Ian Riley. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ian Riley
-/
import common

inductive big_step : (stmt × scope) → scope → Prop
| skip {s : scope} : big_step (stmt.skip, s) s
| assign {x : string} {a : scope → Prop} {s : scope} :
    big_step (stmt.assign x a, s) (s{x ↦ a s})
| comp {S T : stmt} {s t u : scope} (hS : big_step (S, s) t)
    (hT : big_step (T, t) u) : big_step (S ;; T, s) u
| ite_true {b : scope → Prop} {S T : stmt} {s t : scope} (hcond : b s)
    (hbody : big_step (S, s) t) : big_step (stmt.ite b S T, s) t
| ite_false {b : scope → Prop} {S T : stmt} {s t : scope} (hcond : ¬ b s)
    (hbody : big_step (T, s) t) : big_step (stmt.ite b S T, s) t
| while_true {b : scope → Prop} {S : stmt} {s t u: scope} (hcond : b s)
    (hbody : big_step (S, s) t) (hrest : big_step (stmt.while b S, t) u) :
        big_step (stmt.while b S, s) u
| while_false {b : scope → Prop} {S : stmt} {s : scope} (hcond : ¬ b s) :
    big_step (stmt.while b S, s) s
| call {f : string} {v₀ v₁ : scope → Prop} {F : stmt} {s t : scope}
    {σ : scope → scope} (args : (v₀ s) ∧ (v₁ s)) (hF : big_step (F, (σ s)) t)
        : big_step (stmt.call f v₀ v₁ σ F, s) t

infix ` ⟹ `:110 := big_step -- ⟹ \==>

/-
Instructions for how to use big_step and its notation

Big step semantics are used to represent the scope change of an instruction or
composition of instructions that is executed synchronously/deterministically.
A big_step can be defined using the following notation

                                (S, s) ⟹ t

where S is a statement (from common.stmt) and s t are each a
scope (from common.basic). This notation constructs an instance of big_step
that represents the execution of stmt S with scope s that results in scope t.
-/
namespace big_step

/-
Sequent:

        Skip    _______________

                (skip, s) ⟹ s
-/
@[simp] lemma skip_iff {s t : scope} : (stmt.skip, s) ⟹ t ↔ t = s :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        refl,
    },
    {
        intro h₂,
        rw h₂,
        exact big_step.skip,
    }
end

/-
Sequent:

        Assign  __________________________

                {x := a, s) ⟹ s{x ↦ a s}
-/
@[simp] lemma assign_iff {x : string} {a : scope → Prop} {s t : scope} :
    (stmt.assign x a, s) ⟹ t ↔ t = (s{x ↦ a s}) :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        refl,
    },
    {
        intro h₂,
        rw h₂,
        exact big_step.assign,
    }
end

/-
Sequent:

                (S, s) ⟹ t  (T, t) ⟹ u
        Comp    ________________________

                    (S ;; T, s) ⟹ u
-/
@[simp] lemma comp_iff {S T : stmt} {s u : scope} :
    (S ;; T, s) ⟹ u ↔ (∃ (t : scope), (S, s) ⟹ t ∧ (T, t) ⟹ u) :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        apply exists.intro,
        apply and.intro h₁_hS h₁_hT,
    },
    {
        intro h₂,
        cases h₂,
        cases h₂_h,
        apply big_step.comp h₂_h_left h₂_h_right,
    }
end

/-
Sequent:

                        (b s) ∧ (S, s) ⟹ t     ¬ (b s) ∧ (T, s) ⟹ t
        If-Then-Else    _____________________________________________

                                  (if b then S else T, s) ⟹ t
-/
@[simp] lemma ite_iff {b : scope → Prop} {S T : stmt} {s t : scope} :
    (stmt.ite b S T, s) ⟹ t ↔ (b s ∧ (S, s) ⟹ t) ∨ (¬ b s ∧ (T, s) ⟹ t) :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        {
            apply or.intro_left,
            apply and.intro h₁_hcond h₁_hbody,
        },
        {
            apply or.intro_right,
            apply and.intro h₁_hcond h₁_hbody,
        }
    },
    {
        intro h₂,
        cases h₂,
        {
            cases h₂,
            apply big_step.ite_true h₂_left h₂_right,
        },
        {
            cases h₂,
            apply big_step.ite_false h₂_left h₂_right,
        }
    }
end

/-
Sequent:

                                    (S, s) ⟹ t
        If-Then-Else-True   _____________________________ (b s) is TRUE

                            (if b then S else T, s) ⟹ t
-/
@[simp] lemma ite_true_iff {b : scope → Prop} {S T : stmt} {s t : scope}
    (hcond : b s) : (stmt.ite b S T, s) ⟹ t ↔ (S, s) ⟹ t :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        {
            exact h₁_hbody,
        },
        {
            exfalso,
            apply h₁_hcond hcond,
        }
    },
    {
        intro h₂,
        apply big_step.ite_true hcond h₂,
    }
end

/-
Sequent:

                                    (T, s) ⟹ t
        If-Then-Else-False  _____________________________ (b s) is FALSE

                            (if b then S else T, s) ⟹ t
-/
@[simp] lemma ite_false_iff {b : scope → Prop} {S T : stmt} {s t : scope}
    (hcond : ¬ b s) : (stmt.ite b S T, s) ⟹ t ↔ (T, s) ⟹ t :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        {
            exfalso,
            apply hcond h₁_hcond,
        },
        {
            exact h₁_hbody,
        }
    },
    {
        intro h₂,
        apply big_step.ite_false hcond h₂,
    }
end

/-
Sequent:

        (b s) ∧ (S, s) ⟹ t  (b s) ∧ (while b do S, t) ⟹ u   ¬ (b s) ∧ u = s
While   _____________________________________________________________________

                            (while b do S, s) ⟹ u
-/
lemma while_iff {b : scope → Prop} {S : stmt} {s u : scope} :
    (stmt.while b S, s) ⟹ u ↔ (b s ∧ (∃ (t : scope), (S, s) ⟹ t
        ∧ (stmt.while b S, t) ⟹ u)) ∨ (¬ b s ∧ u = s) :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        {
            apply or.intro_left,
            split,
                exact h₁_hcond,
            apply exists.intro h₁_t,
            apply and.intro h₁_hbody h₁_hrest,
        },
        {
            apply or.intro_right,
            apply and.intro h₁_hcond (rfl),
        }
    },
    {
        intro h₂,
        cases h₂,
        case or.inl {
            cases h₂ with hb h₂,
            cases h₂ with t h₂,
            cases h₂ with hS hwhile,
            exact big_step.while_true hb hS hwhile,
        },
        case or.inr {
            cases h₂ with hb h₂,
            rw h₂,
            apply big_step.while_false hb,
        }
    }
end

/-
Sequent:

                    (S, s) ⟹ t      (while b do S, t) ⟹ u
        While-True  _______________________________________ (b s) is TRUE

                            (while b do S, s) ⟹ u
-/
lemma while_true_iff {b : scope → Prop} {S : stmt} {s u : scope}
    (hcond : b s) : (stmt.while b S, s) ⟹ u ↔
        (∃ (t : scope), (S, s) ⟹ t ∧ (stmt.while b S, t) ⟹ u) :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        {
            apply exists.intro h₁_t,
            apply and.intro h₁_hbody h₁_hrest,
        },
        {
            exfalso,
            apply h₁_hcond hcond,
        }
    },
    {
        intro h₂,
        cases h₂ with t h₂,
        cases h₂ with hS hwhile,
        apply big_step.while_true hcond hS hwhile,
    }
end

/-
Sequent:

        While-False     ______________________ (b s) is FALSE

                        (while b do S, s) ⟹ s
-/
@[simp] lemma while_false_iff {b : scope → Prop} {S : stmt} {s t:  scope}
    (hcond : ¬ b s) : (stmt.while b S, s) ⟹ t ↔ t = s :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        {
            exfalso,
            apply hcond h₁_hcond,
        },
        {
            refl,
        }
    },
    {
        intro h₂,
        rw h₂,
        apply big_step.while_false hcond,
    }
end

/-
Sequent:

                  (F, (σ s)) ⟹ t
    Call    __________________________ ∀ args, args = (v₀ s) ∧ (v₁ s)

            (call f v₀ v₁ σ F, s) ⟹ t
-/
@[simp] lemma call_iff {f : string} {v₀ v₁ : scope → Prop} {F : stmt}
    {s t : scope} {σ : scope → scope} (args : (v₀ s) ∧ (v₁ s)) :
        (stmt.call f v₀ v₁ σ F, s) ⟹ t ↔ ((F, (σ s)) ⟹ t) :=
begin
    apply iff.intro,
    {
        intro h₁,
        cases h₁,
        exact h₁_hF,
    },
    {
        intro h₂,
        apply big_step.call args h₂,
    }
end

end big_step


#check
  let_fun f x := x * 2
  let_fun x := 1
  let_fun y := x + 1
  f (y + x)

example (a b : Nat) (h1 : a = 0) (h2 : b = 0) : (let_fun x := a + 1; x + x) > b := by
  simp (config := { beta := false }) [h1]
  trace_state
  simp [h2]


import data.finset.nat_antidiagonal
import analysis.normed_space.basic
import analysis.specific_limits.basic
import laurent_measures.aux_lemmas

/-  These lemmas seem to no longer be needed for Theorem 6.9 or anywhere else in LTE. I ([FAE])
wonder if they might be useful somewhere-/

open aux_thm69
open metric finset normed_field
open_locale nnreal classical big_operators topological_space

def equiv_Ico_nat_neg {d : ℤ} (hd : d < 0) : {y : {x : ℤ // d ≤ x } // y ∉ T hd} ≃ ℕ :=
begin
  fconstructor,
  { rintro ⟨⟨a, ha⟩, hx⟩,
    exact int.to_nat a },
  { intro n,
    refine ⟨⟨n, hd.le.trans (int.coe_zero_le n)⟩, _⟩,
    apply (not_iff_not_of_iff mem_Ico).mpr,
    simp only [subtype.mk_lt_mk, not_and, not_lt, int.coe_nat_nonneg, implies_true_iff] },
    { rintros ⟨⟨x, dx⟩, hx⟩,
      simp [int.to_nat_of_nonneg (T.zero_le hd hx)] },
    { exact λ n, by simp only [int.to_nat_coe_nat] }
end

lemma equiv_Ico_nat_neg_apply {d : ℤ} (hd : d < 0) {y : {x : ℤ // d ≤ x}} (h : y ∉ T hd) : y.1 = (equiv_Ico_nat_neg hd) ⟨y, h⟩ :=
by { cases y, simp [equiv_Ico_nat_neg, T.zero_le hd h] }

/-  This lemma seems to not be used anywhere. -/
lemma summable_iff_on_nat {f : ℤ → ℝ} {ρ : ℝ≥0} (d : ℤ) (h : ∀ n : ℤ, n < d → f n = 0) :
  summable (λ n, ∥ f n ∥ * ρ ^ n) ↔ summable (λ n : ℕ, ∥ f n ∥ * ρ ^ (n : ℤ)) :=
iff.trans (summable_iff_on_nat_less d (λ n nd, by simp [h _ nd])) iff.rfl

/-  This lemma seems to not be used anywhere. -/
lemma aux_summable_iff_on_nat {f : ℤ → ℝ} {ρ : ℝ≥0} (d : ℤ) (h : ∀ n : ℤ, n < d → f n = 0) :
  summable (λ n, ∥ f n ∥ * ρ ^ n) ↔ summable (λ n : ℕ, ∥ f (n + d) ∥ * ρ ^ (n + d : ℤ)) :=
begin
  have hf : function.support (λ n : ℤ, ∥ f n ∥ * ρ ^ n) ⊆ { a : ℤ | d ≤ a},
  { rw function.support_subset_iff,
    intro x,
    rw [← not_imp_not, not_not, mul_eq_zero],
    intro hx,
    simp only [not_le, set.mem_set_of_eq] at hx,
    apply or.intro_left,
    rw norm_eq_zero,
    exact h x hx },
  have h1 := λ a : ℝ,
    @has_sum_subtype_iff_of_support_subset ℝ ℤ _ _ (λ n : ℤ, ∥ f n ∥ * ρ ^ n) _ _ hf,
  have h2 := λ a : ℝ,
    @equiv.has_sum_iff ℝ {b : ℤ // d ≤ b} ℕ _ _ ((λ n, ∥ f n ∥ * ρ ^ n) ∘ coe) _
    (equiv_bdd_integer_nat d),
  exact exists_congr (λ a, ((h2 a).trans (h1 a)).symm),
end


import completeness.filtered_modelC
import syntax.CLCLemmas

local attribute [instance] classical.prop_decidable

open set formCLC

namespace canonical

----------------------------------------------------------
-- Truth Lemma
----------------------------------------------------------

-- 2. CGψ ∈ sf ⇒ ∀sn ∈ S that are reachable from sf by some path sf ∼f i1 sf1 ∼fi2 ... ∼f in sfn,
--       where {i1, i2..in} ⊆ G, then ψ ∈ sfn and CGψ ∈ sfn
lemma truth_C_helper' {agents : Type} [ha : nonempty agents] [hN : fintype agents]
  {φ ψ : formCLC agents} {sf: S_f φ} {sfs : list (S_f φ)} {G : set (agents)} {is : list (agents)}
  (hG : ∀ i, i ∈ is → i ∈ G) (hC : (C G ψ) ∈ sf)
  (hcl : ψ ∈ cl φ) (hcl' : c G ψ ∈ cl φ) (hcl'' : ∀ i ∈ G, (K i (C G ψ)) ∈ cl φ) :
  ∀ tf : (S_f φ), (@C_path agents (filtered_model_CLC φ) is sfs sf tf) → (ψ ∈ tf ∧ (C G ψ) ∈ tf):=
begin
    -- This proof is by induction on the length of the path.
    obtain ⟨s, hs⟩ := s_f_to_s φ sf,
    induction' is with i is ih,
    { simp [C_path], },
    { simp only [list.mem_cons_iff, forall_eq_or_imp] at hG,
      -- simp [hs, ht, hcl, hcl'] at *,
      cases sfs with tf sfs,
      { intros tf htf,
        obtain ⟨t, ht⟩ := @s_f_to_s agents ha hN φ tf,unfold C_path at htf,
        dsimp at htf,
        simp[ext_iff] at htf,
        -- specialize htf ψ,
        specialize hcl'' i hG.left,
        -- specialize htf _ (hcl'' i hG.left),
        -- simp [hcl''] at htf,
        have hkt : k i (C G ψ) ∈ tf, from
        begin
          -- specialize htf _ (hcl'' i hG.left),
          apply (htf _ ).mp,
          simp [hs, ht, hcl, hcl'] at *,
          split,
          apply @max_ax_contains_by_set_proof _ _ (@formula_axCLC _ hN) _ _ _ s.2 hC,
          exact @c_imp_kc _ hN _ _ (@formula_axCLC _ hN) _ _ ψ G i hG.left,
          exact hcl'',
        end,
        simp [hs, ht, hcl, hcl'] at *,
        have hct : (C G ψ) ∈ t,
          from by apply @max_ax_contains_by_set_proof _ _ (@formula_axCLC _ hN) _ _ _ t.2 hkt.left (@axCLC.T _ hN _ _),
        have ht : ψ ∈ t,
          from by apply @max_ax_contains_by_set_proof _ _ (@formula_axCLC _ hN) _ _ _ t.2 hct
            (@c_imp _ hN _ _ (@formula_axCLC _ hN) _ _ ψ G i hG.left),
        exact and.intro ht hct, },
      { -- 2.2. Inductive step: length (n) = m + 1
        -- 2.2.1. Inductive Hypothesis: ∀sf m′ ∈ Sf if there exists some path sf ∼fi1 sf1 ∼fi2 ... ∼f im′ sfm′ ,
          --  where {i1, i2..im′ } ⊆ G and m′ ≤ m then ψ ∈ sfm′ and CGψ ∈ sfm′ .
        -- 2.2.2. Assume CGψ ∈ sf .
        intros uf huf,
        obtain ⟨t, ht⟩ := @s_f_to_s agents ha hN φ tf,
        obtain ⟨u, hu⟩ := @s_f_to_s agents ha hN φ uf,
        simp only [C_path] at *,
        cases huf with hst htu,
        dsimp at hst,
        simp[ext_iff] at hst,
        have hkt : k i (C G ψ) ∈ tf, from
        begin
          apply (hst _ ).mp,
          simp [hs, ht, hcl, hcl'] at *,
          split,
          apply @max_ax_contains_by_set_proof _ _ (@formula_axCLC _ hN) _ _ _ s.2 hC,
          exact @c_imp_kc _ hN _ _ (@formula_axCLC _ hN) _ _ ψ G i hG.left,
          exact hcl'' i hG.left,
        end,
        simp [hs, ht, hcl, hcl'] at hkt,
        have hct : (C G ψ) ∈ tf, from
        begin
          simp [hs, ht, hcl, hcl'] at *,
          apply @max_ax_contains_by_set_proof _ _ (@formula_axCLC _ hN) _ _ _ t.2 hkt.left (@axCLC.T _ hN _ _),
        end,
        -- 2.2.3. ψ ∈ sfm and CGψ ∈ sfm, from 2.2.1.
        -- specialize @ih i hN ψ _ (t :: ss) G hC hG.right u,
        -- specialize @ih_s ψ t G hC i is hG.left hG.right ih u,
        apply @ih ha,
        -- apply ih hct hG.right uf htu,
        exact hct,
        repeat { assumption, },
        exact hG.right,

        -- exact @ih ha hN _ _ _ _ _ _ _ _ _ i hN ψ tf (sfs) G hct hG.right uf htu,
        -- 2.2.4. Kim+1 CGψ ∈ sfm, by Axiom C, from 2.2.3.
        -- 2.2.5. Kim+1 CGψ ∈ sfm+1, by definition ∼f (given that sfm ∼im+1sfm+1), from 2.2.4.
        -- 2.2.6. CGψ ∈ sfm+1, by Axiom T, from 6.2.6.
        -- 2.2.7. ψ ∈ sfm+1, by Axioms c & T, from 6.2.7.
    }, },
end

-- lemma anouther C_helper  {agents : Type} [ha : nonempty agents] [hN : fintype agents]
--   {φ ψ : formCLC agents} {sf: S_f φ} {G : set (agents)}
--   (hcl : ψ ∈ cl φ) (hcl' : c G ψ ∈ cl φ) (hcl'' : ∀ i ∈ G, (K i (C G ψ)) ∈ cl φ)

lemma not_everyone_knows_consistent_list {agents : Type} [hN : fintype agents] [ha : nonempty agents]
  {φ : formCLC agents} {is : list (agents)} {s : (canonical_model_CLC agents).f.states}
  (hfa : ∀ (x : agents), x ∈ is → (¬ (k x φ)) ∉ s) : finite_conjunction (list.map (λ (i : agents), k i φ) is) ∈ s
 :=
begin
  induction is with i is ih,
  { simp,
    apply max_ax_contains_by_empty_proof s.2 prtrue, },
  { simp [finite_conjunction],
    simp at hfa,
    apply max_ax_contains_by_set_proof_2h s.2 _ _ (p4 _ _),
    { apply max_ax_contains_by_set_proof s.2 _ dne,
      exact not_in_from_notin s.2 hfa.left, },
    { apply ih,
    exact hfa.right, } },
end

lemma not_everyone_knows_consistent {agents : Type} [hN : fintype agents] [ha : nonempty agents]
  {φ : formCLC agents} {G : set (agents)} {s : (canonical_model_CLC agents).f.states}
  (h : (¬ e G φ) ∈ s) : ∃ i ∈ G, (¬ (k i φ)) ∈ s :=
begin
  by_contradiction hfa,
  simp at hfa,
  apply in_from_not_notin s.2 h,
  apply max_ax_contains_by_set_proof s.2 _ dni,
  apply not_everyone_knows_consistent_list,
  intros i hi,
  apply hfa,
  simp [finite.mem_to_finset] at hi,
  exact hi,
end

lemma phi_set_imp_e {agents : Type} [ha : nonempty agents] [hN : fintype agents]
  {φ ψ : formCLC agents} {G : set (agents)} {Γ : set (S_f φ)} -- (hG : G.nonempty)
  (hΓ : Γ = {sf : S_f φ | ∀ (tf : (S_f φ)) (is), (∀ i, i ∈ is → i ∈ G) →
    ∀ sfs, @C_path agents (filtered_model_CLC φ) is sfs sf tf → (ψ ∈ tf)}) :
  ax ((phi_X_set φ Γ) ~> e G (phi_X_set φ Γ)) :=
begin
  -- By contradiction assume (¬ ((phi_X_set φ Γ) → e G (phi_X_set φ Γ))) is consistent
  by_contradiction,
  have := comphelper h,
  obtain ⟨s', hexn, htn⟩ := exists_max_ax_consistent_neg_mem h,
  let s : (canonical_model_CLC agents).f.states := ⟨s', hexn⟩,
  have hsn : ¬' (phi_X_set φ Γ~>e G (phi_X_set φ Γ)) ∈ s, from by apply htn,
  -- ((phi_X_set φ Γ) ∧ ¬ (e G (phi_X_set φ Γ))) is consistent
  have hs1 : phi_X_set φ Γ ∧' ¬' (e G (phi_X_set φ Γ)) ∈ s,
    from by apply max_ax_contains_by_set_proof s.2 htn (iff_l demorgans''''),
  -- There exists some tf ∈ Sf, such that ((phi_s_f φ tf) ∧ ¬ (e G (phi_X_set φ Γ))) is consistent
  have hs2 : phi_X_set φ Γ ∈ s,
    from by apply max_ax_contains_by_set_proof s.2 hs1 (p5 _ _),
  have hs3 : ∃ uf ∈ Γ, phi_s_f φ uf ∈ s, from phi_X_set_exists hs2,
  cases hs3 with tf hs3, cases hs3 with htf hs3,
  -- There exists some i ∈ G, such that ((phi_s_f φ tf) ∧ (¬ k i (phi_X_set φ Γ))) is consistent
  have hs4 : ¬' (e G (phi_X_set φ Γ)) ∈ s,
    from by apply max_ax_contains_by_set_proof s.2 hs1 (p6 _ _),
  have hs5 : ∃ i ∈ G, (¬ k i (phi_X_set φ Γ)) ∈ s,
    from not_everyone_knows_consistent hs4,
  cases hs5 with i hs5, cases hs5 with hi hs5,

  -- ((phi_s_f φ tf) ∧ (¬ k i ¬ (phi_X_set φ Γᶜ))) is consistent
  have hs6 : (¬ (k i (¬ (phi_X_set φ Γᶜ)))) ∈ s, from
  begin
    apply max_ax_contains_by_set_proof s.2 hs5,
    apply @nk_imp_nk _ hN,
    apply (phi_X_set_disjunct_of_disjuncts φ _ _).mpr,
    rw (compl_union_self Γ),
    apply univ_disjunct_provability,
    exact canonical.nonempty_S_f φ,
  end,

  -- ((phi_s_f φ tf) ∧ (V_{sf ∈ Γᶜ} ¬ k i ¬ (phi_s_f φ sf))) is consistent
  unfold phi_X_set phi_X_finset at hs6,
  have hs7 : _ ∈ s,
    from by apply max_ax_contains_by_set_proof s.2 hs6 (by apply @nk_disjunction _ hN),

  -- There exists some uf ∈ Γᶜ, such that ((phi_s_f φ tf) ∧ (¬ k i ¬ (phi_s_f φ uf))) is consistent
  have hs8 : ∃ uf ∈ Γᶜ, (¬' (K' i (¬' (phi_s_f φ uf)))) ∈ s, from
    begin
      by_contradiction hfa,
      simp only [exists_prop, not_exists, not_and] at hfa,
      apply in_from_not_notin s.2 hs7,
      apply @nk_phi_X_list_exists agents hN ha φ i _ s _,
      intros sf hsf,
      apply hfa,
      simp [finite.mem_to_finset] at hsf,
      exact hsf,
    end,
  cases hs8 with uf hs8, cases hs8 with huf hs8,
  simp [hΓ] at huf htf,
  cases huf with vf huf, cases huf with is huf, cases huf with his huf, cases huf with sfs hvf, cases sfs with sfs hsfs,

  -- tf ~a uf,
  have htu : uf ∈ (filtered_model_CLC φ).f.rel i tf, from
  begin
    simp,
    ext1,
    split,
    { intro hxtf,
      by_contradiction hxuf,
      simp at hxtf hxuf,
      obtain ⟨χ, hχ, hiffχ⟩ := s_f_closed hxuf (finset.subset_iff.mp (s_f_subset_cl φ _) hxtf),
      have haxknuf : ax (K' i x →' ¬' (phi_s_f φ uf)), from
      begin
        apply cut dni,
        apply cut (iff_l (@iff_not (formCLC agents) _ _ _ _ hiffχ)),
        apply notin_nphi_s_f hχ,
      end,
      have hs9 : (¬' (K' i (K' i (x)))) ∈ s,
        from by apply max_ax_contains_by_set_proof s.2 hs8 (nk_imp_nk haxknuf),
      have hs10 : ((K' i (K' i (x)))) ∈ s,
        from by apply max_ax_contains_by_set_proof s.2 hs3
          (cut (phi_s_f_forall_imp _ hxtf) axCLC.Four),
      apply contra_containts_pr_false s.2 hs10 hs9,
    },
    { intro hxuf,
      by_contradiction hxtf,
      simp at hxtf hxuf,
      obtain ⟨χ, hχ, hiffχ⟩ := s_f_closed hxtf (finset.subset_iff.mp (s_f_subset_cl φ _) hxuf),
      have haxknuf : ax ((¬' (K' i x)) →' ¬' (phi_s_f φ uf)), from notin_nphi_s_f hxuf,
      have hs9 : (¬' (K' i ¬ (K' i (x)))) ∈ s,
        from by apply max_ax_contains_by_set_proof s.2 hs8 (nk_imp_nk haxknuf),
      have hs10 : ((K' i (x))) ∈ s,
        from by apply max_ax_contains_by_set_proof s.2 hs9 nnk_imp_k,
      have hs11 : ((¬' (K' i (x)))) ∈ s,
        from by apply max_ax_contains_by_set_proof s.2 hs3
          (cut (phi_s_f_forall_imp _ hχ) (iff_l hiffχ)),
      apply contra_containts_pr_false s.2 hs10 hs11,
    },
  end,

  -- Contradiction because there is a path tf ~i uf ~cG vf such that φ ∉ vf, but tf ∈ Γ,
  apply hvf,
  apply htf _ (i :: is) _ (uf :: sfs),
  { simp only [C_path],
    exact and.intro htu hsfs, },
  { simp,
    exact and.intro hi his, },
end

lemma truth_C_helper'' {agents : Type} [ha : nonempty agents] [hN : fintype agents]
  {φ ψ : formCLC agents} {sf: S_f φ} {G : set (agents)}
  (hcl : ψ ∈ cl φ) (hcl' : c G ψ ∈ cl φ) (hcl'' : ∀ i ∈ G, (K i (C G ψ)) ∈ cl φ)
  (h : ∀ (tf : (S_f φ)) (is), (∀ i, i ∈ is → i ∈ G) →
    ∀ sfs, @C_path agents (filtered_model_CLC φ) is sfs sf tf → (ψ ∈ tf))
  -- , (∀ (a : agents), a ∈ x → a ∈ G) → ∀ (x_1 : list (filtered_model_CLC χ).f.to_frameCL.states), C_path x x_1 sf t → φ ∈ t
  :
  (C G ψ) ∈ sf :=
begin
    -- 3.1. Assume ∀sfn ∈ Sf if there exists some path sf ∼fi1 sf1 ∼fi2 ... ∼fin sfn,where {i1, i2..in} ⊆ G then ψ ∈ sfn
    -- 3.2. let Σ be the set of all tf ∈ Sf,
      -- such that for every state tfn if that tf n is reachable from tf through some path tf ∼f i1 tf 1 ∼fi2 ... ∼fin tf n,
      -- where {i1, i2..in} ⊆ G, then ψ ∈ tf .
    let Γ := {sf : S_f φ | ∀ (tf : (S_f φ)) (is), (∀ i, i ∈ is → i ∈ G) →
      ∀ sfs, @C_path agents (filtered_model_CLC φ) is sfs sf tf → (ψ ∈ tf)},
    -- 3.3. sf ∈ Σ, from 2.3.1 and 2.3.2.
    have hsfΓ : sf ∈ Γ, from h,
    -- 3.4. ⊢ φsf→ φΣ , by propositional logic, from 2.3.3.
    have hax1 : axCLC ((phi_s_f φ sf) ~> (phi_X_set φ Γ)), from ax_phi_s_f_imp_phi_X_set_of_mem' hsfΓ,
    -- 3.5. ⊢ φΣ → ψ, by propositional logic, because all t ∈ Σ, ψ ∈ t.
    -- 3.6. ⊢ φΣ → EGφΣ , from 2.3.2.
    have hax1' : ∀ sf, sf ∈ Γ → axCLC ((phi_s_f φ sf) ~> (phi_X_set φ Γ)),
      from λ sf h, ax_phi_s_f_imp_phi_X_set_of_mem' h,
    -- 3.7. ⊢ φsf → CGψ, by Axiom RC, from 2.3.4, 2.3.5 & 2.3.6.
    have hψΓ : (∃ i, i ∈ G) → ∀ sf ∈ Γ, ψ ∈ sf, from
    begin
      intros hi sf hsf,
      cases hi with i hi,
      simp [Γ] at hsf,
      apply hsf sf (i :: list.nil) (by simp [hi]) (list.nil),
      unfold C_path,
      exact rfl,
    end,
    have hax2 : axCLC ((phi_X_set φ Γ) ~> e G (ψ & (phi_X_set φ Γ))), from
    begin
      cases (em (G = ∅)) with hempty hnempty,
      { apply axCLC.MP,
        apply axCLC.Prop1,
        rw hempty,
        apply @everyone_empty _ hN (formCLC agents), },
      { have hnempty : G.nonempty, from ne_empty_iff_nonempty.mp hnempty,
        rw nonempty_def at hnempty,
        specialize hψΓ hnempty,
        cases hnempty with i hi,

        have hax3 : axCLC ((phi_X_set φ Γ) ~> ψ), from
        begin
          apply @cut (formCLC agents),
          apply iff_l,
          unfold phi_X_set phi_X_finset,
          apply phi_X_list_conj_contains,
          { intros sf hsf,
            apply hψΓ,
            simp [Γ] at *,
            exact hsf, },
          exact p5 _ _,
        end,

        have hax4 : ax ((phi_X_set φ Γ) ~> e G (phi_X_set φ Γ)), from phi_set_imp_e (by simp [Γ]),

        apply @cut (formCLC agents),
        exact hax4,
        apply mp,
        apply @K_everyone _ hN _ _ (@formula_axCLC _ hN),
        apply everyone_knows_pr,
        apply imp_imp_and,
        apply hax3,
        exact iden,
      },
    end,
    -- 3.8. CGψ ∈ sf , from 2.3.7.
    have hax3 : axCLC ((phi_X_set φ Γ) ~> C G ψ), from axCLC.RC hax2,
    obtain ⟨s, hs⟩ := s_f_to_s φ sf,
    -- simp [hs, hcl'],
    have hs_f_sf := s_f_to_s_to_s_f @hs,
    simp [hs, hcl'] at *,
    apply max_ax_contains_by_set_proof s.2 (phi_s_f_in_s φ s),
    rw hs_f_sf,
    exact cut hax1 hax3,
end

lemma truth_lemma_CLC {agents : Type} [ha : nonempty agents] [hN : fintype agents]
  (χ : formCLC agents) (sf : (S_f χ)) (φ) (hχ : subformula φ χ) :
  (s_entails_CLC (@filtered_model_CLC agents hN ha χ) sf φ) ↔ (φ ∈ sf) :=
begin
  -- This proof is by induction on φ.
  induction' φ fixing ha hN φ with n φ ψ _ _ φ ψ _ _, -- sf needs to vary for the modal operators
  all_goals
  { have hs := s_f_to_s χ sf,
    cases hs with s hs, },

  { -- case bot
    simp [s_entails_CLC],
    apply s_f_n_contains,
    exact @hs,
    apply or.intro_left,
    exact @bot_not_mem_of_ax_consistent (formCLC agents) _ _ s.1 s.2.1, },

  { -- case var
    simpa [s_entails_CLC], },

  { -- case and
    have hφ := subformula.trans (subformula.and_left _ _) hχ,
    have hψ := subformula.trans (subformula.and_right _ _) hχ,
    specialize ih_φ _ sf hφ,
    specialize ih_ψ _ sf hψ,
    unfold s_entails_CLC at *,
    rw [ih_φ, ih_ψ, hs, hs, hs],
    simp only [hφ.mem_cl, hψ.mem_cl, hχ.mem_cl, and_true],
    split,
    { rintro ⟨hφs, hψs⟩,
      apply max_ax_contains_by_set_proof_2h s.2 hφs hψs axCLC.Prop4 },
    { intro hφψs,
      split,
      { apply max_ax_contains_by_set_proof s.2 hφψs axCLC.Prop5 },
      { apply max_ax_contains_by_set_proof s.2 hφψs axCLC.Prop6 } } },

  { -- case imp
    have hφ := subformula.trans (subformula.imp_left _ _) hχ,
    have hψ := subformula.trans (subformula.imp_right _ _) hχ,
    specialize ih_φ _ sf hφ,
    specialize ih_ψ _ sf hψ,
    unfold s_entails_CLC at *,
    rw [ih_φ, ih_ψ, hs, hs, hs],
    simp only [hφ.mem_cl, hψ.mem_cl, hχ.mem_cl, and_true],
    split,

    { intro h,
      exact max_ax_contains_imp_by_proof s.2 h, },

    { intros h hφ,
      exact max_ax_contains_by_set_proof_2h s.2 hφ h likemp, }, },

  { -- case [G] ψ
    -- have hE : (filtered_model_CLC χ).f.E.E = E_f, from rfl,
    have hφ := subformula.trans (subformula.effectivity _ _) hχ,
    let ih := λ sf, ih _ sf hφ,
    cases em (G = univ) with hG hG,
    { -- case [G]ψ, where G = N :
      calc s_entails_CLC (filtered_model_CLC χ) sf ([G]φ)
          -- ↔ {sf ∈ Sf | M f , sf ⊨ ψ} ∈ E(sf )(N ), by definition ⊨
          ↔ {t | s_entails_CLC (filtered_model_CLC χ) t φ} ∈ (filtered_model_CLC χ).f.to_frameCL.E.E sf G :
            by unfold s_entails_CLC at *
          -- ↔ ∃t ∈ S, sf = tf and  ̃φ{sf ∈Sf |M f ,sf ⊨ψ} ∈ E(t)(N ), by definition E.
      ... ↔ ∃ t, (∀ x, x ∈ sf ↔ x ∈ t ∧ x ∈ cl χ) ∧ tilde (phi_X_set χ ({sf | s_entails_CLC (filtered_model_CLC χ) sf φ})) ∈ (canonical_model_CLC agents).f.to_frameCL.E.E t (univ) :
          begin
            simp [E_f, hG] { eta := ff },
            split,
            repeat { intro h, apply h, },
          end
          -- ↔ ∃t ∈ S, sf = tf and  ̃φ{sf ∈Sf |ψ∈sf } ∈ E(t)(N ), , by the inductive hypothesis: ∀sf ∈ Sf , M f , sf ⊨ ψ iff ψ ∈ sf .
      ... ↔ ∃ t, (∀ x, x ∈ sf ↔ x ∈ t ∧ x ∈ cl χ) ∧ tilde (phi_X_set χ ({sf | φ ∈ sf} : set (S_f χ))) ∈ (canonical_model_CLC agents).f.to_frameCL.E.E t (univ) :
          by simp only [ih]
          -- ↔ ∃t ∈ S, sf = tf and  ̃ψ ∈ E(t)(N ), by Lemma 6.
      ... ↔ ∃ t, (∀ x, x ∈ sf ↔ x ∈ t ∧ x ∈ cl χ) ∧ tilde φ ∈ (canonical_model_CLC agents).f.to_frameCL.E.E t (univ) :
          by rw tilde_ax_iff χ (phi_X_contains_iff_psi χ φ (subformula.mem_cl hφ))
          -- ↔ ∃t ∈ S, sf = tf and [N ]ψ ∈ E(t)(N ), by Lemma 7.
          -- ↔ [N ]ψ ∈ sf , by definition Sf .
      ... ↔ ([G] φ) ∈ sf :
          begin
            rw hG,
            split,
            { intro h,
              cases h with t h,
              rw E_s_contains_tilde_iff_E_in_s χ φ t univ at *,
              cases h with heq h,
              apply (heq ([univ] φ)).mpr,
              split,
              { exact h, },
              { simp [hG] at hχ,
                exact subformula.mem_cl hχ, }, },
            { intro h,
              apply exists.intro s,
              split,
              { simp at hs,
                exact @hs, },
              { simp [@hs] at h,
                rw E_s_contains_tilde_iff_E_in_s χ φ s univ at *,
                exact h.left, }, },
          end, },
    { calc s_entails_CLC (filtered_model_CLC χ) sf ([G]φ)
          -- ↔ {sf ∈ Sf | M f , sf ⊨ ψ} ∈ E(sf )(G), by definition ⊨
          ↔ {t | s_entails_CLC (filtered_model_CLC χ) t φ} ∈ (filtered_model_CLC χ).f.to_frameCL.E.E sf G :
            by unfold s_entails_CLC at *
          -- ↔ ∀t ∈ S, sf = tf ⇒  ̃φ{sf ∈Sf |M f ,sf ⊨ψ} ∈ E(t)(G), by definition E.
      ... ↔ ∀ t, (∀ x, x ∈ sf ↔ x ∈ t ∧ x ∈ cl χ) → tilde (phi_X_set χ ({sf | s_entails_CLC (filtered_model_CLC χ) sf φ})) ∈ (canonical_model_CLC agents).f.to_frameCL.E.E t (G) :
          begin
            simp [E_f, hG] { eta := ff },
            split,
            repeat { intro h, apply h, }
          end
          -- ↔ ∀t ∈ S, sf = tf ⇒  ̃φ{sf ∈Sf |M f ,ψ∈sf } ∈ E(t)(G), by the inductive hypothesis: ∀sf ∈ Sf , M f , sf ⊨ ψ iff ψ ∈ sf .
      ... ↔ ∀ t, (∀ x, x ∈ sf ↔ x ∈ t ∧ x ∈ cl χ) → tilde (phi_X_set χ ({sf | φ ∈ sf})) ∈ (canonical_model_CLC agents).f.to_frameCL.E.E t (G) :
          by simp only [ih]
          -- ↔ ∀t ∈ S, sf = tf ⇒  ̃ψ ∈ E(t)(G), by Lemma 6.
      ... ↔ ∀ t, (∀ x, x ∈ sf ↔ x ∈ t ∧ x ∈ cl χ) → tilde φ ∈ (canonical_model_CLC agents).f.to_frameCL.E.E t (G) :
          by rw tilde_ax_iff χ (phi_X_contains_iff_psi χ φ (subformula.mem_cl hφ))
          -- ↔ ∀t ∈ S, sf = tf ⇒ [G]ψ ∈ t, by Lemma 7.
          -- ↔ [G]ψ ∈ sf , by definition Sf .
      ... ↔ ([G] φ) ∈ sf :
          begin
            split,
            { intro h,
              specialize h s @hs,
              rw E_s_contains_tilde_iff_E_in_s χ φ s G at h,
              simp only [@hs, subformula.mem_cl hχ, and_true],
              exact h, },
            { intros h t ht,
              rw E_s_contains_tilde_iff_E_in_s χ φ t G,
              apply and.elim_left,
              exact (ht _).mp h, },
          end, }, },

  -- case K
  {
    -- have hK : (filtered_model_CLC χ).f.rel = λ i : agents, λ s : (@filtered_model_CLC agents hN ha χ).f.states,
  --   {t : (@filtered_model_CLC agents hN ha χ).f.states | {φ : formCLC agents| ((K' i φ) : formCLC agents) ∈ s} = {φ | (K' i φ) ∈ t}},
  --     from rfl,
    have hφ := subformula.trans (subformula.knows _ _) hχ,
    let ih := λ sf, ih _ sf hφ,
    -- unfold s_entails_CLC at *
    split,
    { -- ⇒
      simp only [@hs, hφ.mem_cl, hχ.mem_cl, and_true],
      -- 1. Let M f , sf ⊨ Kiψ
      intro h,
      -- 2. ∀tf ∈ Sf , sf ∼fi tf ⇒ M f , tf ⊨ ψ, by the definition of ⊨, from 1.
      unfold s_entails_CLC at h ih,
      -- 3. ∀tf ∈ Sf , sf ∼fi tf ⇒ ψ ∈ tf , by the induction hypothesis, from 2.
      simp only [ih] at h,
      -- 4. Assume by contradiction that ¬Kiψ ∈ s.
      by_contradiction hnin,
      have hnk := not_in_from_notin s.2 hnin,
      -- 5. Consider the set Σ = {φ | φ is of the shape Kiχ and φ ∈ sf }.
      let Γ := {ψ : formCLC agents | k a ψ ∈ s},
      -- 6. Σ ∪ {¬ ψ} is consistent.
      have hcon : ax_consistent (Γ ∪ {¬ φ}), from
      begin
        -- 6.1. Assume by contradiction Σ ∪ {¬ψ} is inconsistent.
        by_contradiction hncon,
        -- 6.2. ⊢ (φΣ ∧ ¬ψ) → ⊥, from 6.1.
        have hncon' := five Γ (¬ φ) hncon,
        cases hncon' with ψs hncon',
        -- 6.3. ⊢ φΣ → ψ, by propositional logic, from 6.2.
        cases hncon' with hΓ hax,
        -- 6.4. ⊢ Ki(φΣ → ψ), by Axiom RN, from 6.3.
        -- 6.5. ⊢ (KiφΣ ) → (Kiψ), by Axiom K, from 6.4.
        have h5 : axCLC ((finite_conjunction (list.map (K a) ψs)) ~> k a (φ)), from by
        begin
          apply @cut (formCLC agents),
          apply @knows_conjunction agents hN (formCLC agents) _,
          apply axCLC.MP axCLC.K,
          apply axCLC.RN,
          simp at hax,
          apply @cut (formCLC agents),
          exact hax,
          exact dne,
        end,
        -- 6.6. ⊢ φΣ → KiφΣ , by Axiom K, and propositional logic.
        have h6 := exercise1,
        -- 6.7. φΣ ∈ s, by definition Sigma, from 5.
        -- 6.8. Kiψ ∈ s, from 6.5, 6.6 & 6.7.
        have h7 : ∀ ψ ∈ (list.map (K a) ψs), ψ ∈ s, from
        begin
          intros ψ h8, simp at *, cases h8 with a h8,
          cases h8 with h8l h8r,
          subst h8r, exact hΓ a h8l,
        end,
        specialize h6 s.2 h7 h5,
        have h8 := (max_ax_contains_phi_xor_neg s.1 (max_imp_ax s.2)).mp s.2 (K a (φ)),
        cases h8 with h8l h8r, simp at *,
        -- 6.9. Contradiction from 4 and 6.8.
        apply (h8r h6),
        exact hnk,
      end,
      -- 7. ∃u ∈ S, sf ∼fi u and ¬ψ ∈ uf , from 6, based on the definitions of ∼fi and Σ.
      obtain ⟨t', ht, hsub⟩ := lindenbaum hcon,
      let t : (canonical_model_CLC agents).f.to_frameCL.states := ⟨t', ht⟩,
      have h5 := set.union_subset_iff.mp hsub,
      simp at h5,
      cases h5,
      have hnin : (¬ φ) ∈ t, from h5_right,
      simp at hnin,
      obtain ⟨tf, htf⟩ := s_to_s_f χ t,
      have hrel : tf ∈ (filtered_model_CLC χ).f.rel a sf, from
      begin
        simp,
        ext1,
        split,
        { simp [@hs, htf],
          intros hks hcl,
          split,
          { apply mem_of_mem_of_subset _ h5_left,
            simp only [Γ],
            apply max_ax_contains_by_set_proof s.2 hks axCLC.Four, },
          { exact hcl, },
        },
        { simp [@hs, htf],
          intros hkt hcl,
          split,
          { by_contradiction hnks,
            have hnks' := not_in_from_notin s.2 hnks,
            have hknks := max_ax_contains_by_set_proof s.2 hnks' axCLC.Five,
            have hnkΓ : (¬ k a x) ∈ Γ, from hknks,
            have hnkt : (¬ k a x) ∈ t.1, from mem_of_mem_of_subset hnkΓ h5_left,
            exact contra_containts_pr_false t.2 hkt hnkt, },
          { exact hcl, },
        },
      end,
      specialize h tf hrel,
      simp [@hs, htf] at h,
      -- 8. Contradiction from 3 & 7.
      apply contra_containts_pr_false t.2 h.left hnin, },
    {  -- ⇐
      -- 1. Let Kiψ ∈ sf .
      intro h,
      -- 2. Consider any tf ∈ Sf , such that sf ∼f i tf .
      -- 3. {χ | Kiχ ∈ sf } = {χ | Kiχ ∈ tf }, by definition ∼f i , from 2.
      unfold s_entails_CLC at *,
      dsimp,
      intros tf htf,
      obtain ⟨t, ht⟩ := s_f_to_s χ tf,
      -- simp at tf,
      -- 4. Kiψ ∈ tf , from 1 & 3.
      have hkt : (K' a φ) ∈ tf, from
      begin
        simp [ext_iff] at htf,
        exact (htf φ).mp h,
      end,
      -- 5. ψ ∈ tf , by Axiom T, from 4.
      have hφt : φ ∈ tf, from
      begin
        simp only [ht, hφ.mem_cl, hχ.mem_cl, and_true] at *,
        exact max_ax_contains_by_set_proof t.2 hkt.left axCLC.T,
      end,
      -- 6. ∀tf ∈ Sf , sf ∼fi tf ⇒ ψ ∈ tf , from 2 & 5.
      -- 7. ∀tf ∈ Sf , sf ∼fi tf ⇒ M f , tf ⊨ ψ, by the induction hypothesis, from 6.
      simp only [ih],
      -- 8. M f , sf ⊨ Kiψ, by the definition of ⊨, from 7.
      exact hφt, }, },

  -- case C
  { have hφ := subformula.trans (subformula.common_know _ _) hχ,
    let ih := λ sf, ih _ sf hφ,
    unfold s_entails_CLC at *,
    simp [ih],
    have hcl : φ ∈ cl χ, from subformula.mem_cl hφ,
    have hcl' : c G φ ∈ cl χ, from subformula.mem_cl hχ,
    have hcl'' : ∀ i ∈ G, (K i (C G φ)) ∈ cl χ,
      from λ i hi, finset.subset_iff.mp (subformula.cl_subset hχ) (by simp [cl, cl_C, hi]),

    -- 2. CGψ ∈ sf ⇒ ∀sn ∈ S that are reachable from sf by some path sf ∼f i1 sf1 ∼fi2 ... ∼f in sfn,
      -- where {i1, i2..in} ⊆ G, then ψ ∈ sfn and CGψ ∈ sfn
    -- have hl := truth_C_helper' _ _ hcl hcl' hcl'',
    -- have hr := truth_C_helper'' hcl hcl' hcl'',

    -- 3. (∀sn ∈ S that are reachable from sf by some path sf ∼fi1 sf1 ∼fi2 ... ∼finsfn, where {i1, i2..in} ⊆ G, then ψ ∈ sfn) ⇒ CGψ ∈ sf .
    -- 4. CGψ ∈ sf ⇔ ∀sn ∈ S if sf n is reachable from sf by some path sf ∼fi1 sf1 ∼fi2 ... ∼fin sf n,
      -- where {i1, i2..in} ⊆ G, then ψ ∈ sfn, from 2 & 3.
    split,
    { intros h,
      exact truth_C_helper'' hcl hcl' hcl'' h, },
    { intros hsf tf is his sfs hC,
      exact (truth_C_helper' his hsf hcl hcl' hcl'' tf hC).left, },
    -- 5. CGψ ∈ sf ⇔ ∀sn ∈ S if sfn is reachable from sf by some path sf ∼fi1 sf1 ∼fi2 ... ∼f in sfn, where {i1, i2..in} ⊆ G, then M f , sfn ⊨ ψ, from 1 & 4.
    -- 6. CGψ ∈ sf ⇔ M f , sf ⊨ CGψ, by definition ⊨, from 5.
  },
end

----------------------------------------------------------
-- Completeness
----------------------------------------------------------

-- Completeness
----------------------------------------------------------
theorem completenessCLC {agents : Type} [h : fintype agents] (φ : formCLC agents) [ha : nonempty agents] :
  global_valid φ → axCLC φ :=
begin
  -- rw from contrapositive
  rw ←not_imp_not,
  -- assume ¬ ⊢ φ
  intro hnax,
  -- from ¬ ⊢ φ, have that {¬ φ} is a consistent set
  obtain ⟨s, hmax, hnφ⟩ := @exists_max_ax_consistent_neg_mem (formCLC agents) _ _ _ hnax,
  -- show that φ is not globally valid,
  -- by showing that there exists some model where φ is not valid.
  simp[global_valid],
  -- let that model be the canonical model
  apply exists.intro (filtered_model_CLC φ),
  -- in the canonical model (M) there exists some state (s) where ¬ M s ⊨ φ
  simp[valid_m],
  -- let that state (s) be the maximally consistent set extended from {¬ φ}
  obtain ⟨sf, hsf⟩ := s_to_s_f φ (subtype.mk s hmax),
  apply exists.intro sf,
  -- assume by contradiction that M s ⊨ φ
  intro hf,
  -- by the truth lemma φ ∈ s
  have hsub: subformula φ φ, from subformula.refl φ,
  have hφ, from (truth_lemma_CLC φ _ φ hsub).mp hf,
  -- in that state (s), φ ∈ s, so we do not have ¬ φ ∈ s (by consistency)
  -- contradiction with hnφ
  rw hsf at hφ,
  simp at hφ,
  apply contra_containts_pr_false hmax hφ.left hnφ,
end

end canonical