/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Mario Carneiro, Scott Morrison, Floris van Doorn
-/
import category_theory.adjunction.basic
import category_theory.limits.cones

/-!
# Limits and colimits

We set up the general theory of limits and colimits in a category.
In this introduction we only describe the setup for limits;
it is repeated, with slightly different names, for colimits.

The main structures defined in this file is
* `is_limit c`, for `c : cone F`, `F : J ⥤ C`, expressing that `c` is a limit cone,

See also `category_theory.limits.has_limits` which further builds:
* `limit_cone F`, which consists of a choice of cone for `F` and the fact it is a limit cone, and
* `has_limit F`, asserting the mere existence of some limit cone for `F`.

## Implementation
At present we simply say everything twice, in order to handle both limits and colimits.
It would be highly desirable to have some automation support,
e.g. a `@[dualize]` attribute that behaves similarly to `@[to_additive]`.

## References
* [Stacks: Limits and colimits](https://stacks.math.columbia.edu/tag/002D)

-/

noncomputable theory

open category_theory category_theory.category category_theory.functor opposite

namespace category_theory.limits

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

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

variables {F : J ⥤ C}

/--
A cone `t` on `F` is a limit cone if each cone on `F` admits a unique
cone morphism to `t`.

See https://stacks.math.columbia.edu/tag/002E.
  -/
@[nolint has_inhabited_instance]
structure is_limit (t : cone F) :=
(lift  : Π (s : cone F), s.X ⟶ t.X)
(fac'  : ∀ (s : cone F) (j : J), lift s ≫ t.π.app j = s.π.app j . obviously)
(uniq' : ∀ (s : cone F) (m : s.X ⟶ t.X) (w : ∀ j : J, m ≫ t.π.app j = s.π.app j),
  m = lift s . obviously)

restate_axiom is_limit.fac'
attribute [simp, reassoc] is_limit.fac
restate_axiom is_limit.uniq'

namespace is_limit

instance subsingleton {t : cone F} : subsingleton (is_limit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cone point
of any cone over `F` to the cone point of a limit cone over `G`. -/
def map {F G : J ⥤ C} (s : cone F) {t : cone G} (P : is_limit t)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.lift ((cones.postcompose α).obj s)

@[simp, reassoc] lemma map_π {F G : J ⥤ C} (c : cone F) {d : cone G} (hd : is_limit d)
  (α : F ⟶ G) (j : J) : hd.map c α ≫ d.π.app j = c.π.app j ≫ α.app j :=
fac _ _ _

lemma lift_self {c : cone F} (t : is_limit c) : t.lift c = 𝟙 c.X :=
(t.uniq _ _ (λ j, id_comp _)).symm

/- Repackaging the definition in terms of cone morphisms. -/

/-- The universal morphism from any other cone to a limit cone. -/
@[simps]
def lift_cone_morphism {t : cone F} (h : is_limit t) (s : cone F) : s ⟶ t :=
{ hom := h.lift s }

lemma uniq_cone_morphism {s t : cone F} (h : is_limit t) {f f' : s ⟶ t} :
  f = f' :=
have ∀ {g : s ⟶ t}, g = h.lift_cone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/-- Restating the definition of a limit cone in terms of the ∃! operator. -/
lemma exists_unique {t : cone F} (h : is_limit t) (s : cone F) :
  ∃! (l : s.X ⟶ t.X), ∀ j, l ≫ t.π.app j = s.π.app j :=
⟨h.lift s, h.fac s, h.uniq s⟩

/-- Noncomputably make a colimit cocone from the existence of unique factorizations. -/
def of_exists_unique {t : cone F}
  (ht : ∀ s : cone F, ∃! l : s.X ⟶ t.X, ∀ j, l ≫ t.π.app j = s.π.app j) : is_limit t :=
by { choose s hs hs' using ht, exact ⟨s, hs, hs'⟩ }

/--
Alternative constructor for `is_limit`,
providing a morphism of cones rather than a morphism between the cone points
and separately the factorisation condition.
-/
@[simps]
def mk_cone_morphism {t : cone F}
  (lift : Π (s : cone F), s ⟶ t)
  (uniq' : ∀ (s : cone F) (m : s ⟶ t), m = lift s) : is_limit t :=
{ lift := λ s, (lift s).hom,
  uniq' := λ s m w,
    have cone_morphism.mk m w = lift s, by apply uniq',
    congr_arg cone_morphism.hom this }

/-- Limit cones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s ≅ t :=
{ hom := Q.lift_cone_morphism s,
  inv := P.lift_cone_morphism t,
  hom_inv_id' := P.uniq_cone_morphism,
  inv_hom_id' := Q.uniq_cone_morphism }

/-- Any cone morphism between limit cones is an isomorphism. -/
lemma hom_is_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) (f : s ⟶ t) : is_iso f :=
⟨⟨P.lift_cone_morphism t, ⟨P.uniq_cone_morphism, Q.uniq_cone_morphism⟩⟩⟩

/-- Limits of `F` are unique up to isomorphism. -/
def cone_point_unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s.X ≅ t.X :=
(cones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma cone_point_unique_up_to_iso_hom_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).hom ≫ t.π.app j = s.π.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma cone_point_unique_up_to_iso_inv_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).inv ≫ s.π.app j = t.π.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_hom {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  P.lift r ≫ (cone_point_unique_up_to_iso P Q).hom = Q.lift r :=
Q.uniq _ _ (by simp)

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_inv {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  Q.lift r ≫ (cone_point_unique_up_to_iso P Q).inv = P.lift r :=
P.uniq _ _ (by simp)

/-- Transport evidence that a cone is a limit cone across an isomorphism of cones. -/
def of_iso_limit {r t : cone F} (P : is_limit r) (i : r ≅ t) : is_limit t :=
is_limit.mk_cone_morphism
  (λ s, P.lift_cone_morphism s ≫ i.hom)
  (λ s m, by rw ←i.comp_inv_eq; apply P.uniq_cone_morphism)

@[simp] lemma of_iso_limit_lift {r t : cone F} (P : is_limit r) (i : r ≅ t) (s) :
  (P.of_iso_limit i).lift s = P.lift s ≫ i.hom.hom :=
rfl

/-- Isomorphism of cones preserves whether or not they are limiting cones. -/
def equiv_iso_limit {r t : cone F} (i : r ≅ t) : is_limit r ≃ is_limit t :=
{ to_fun := λ h, h.of_iso_limit i,
  inv_fun := λ h, h.of_iso_limit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_limit_apply {r t : cone F} (i : r ≅ t) (P : is_limit r) :
  equiv_iso_limit i P = P.of_iso_limit i := rfl

@[simp] lemma equiv_iso_limit_symm_apply {r t : cone F} (i : r ≅ t) (P : is_limit t) :
  (equiv_iso_limit i).symm P = P.of_iso_limit i.symm := rfl

/--
If the canonical morphism from a cone point to a limiting cone point is an iso, then the
first cone was limiting also.
-/
def of_point_iso {r t : cone F} (P : is_limit r) [i : is_iso (P.lift t)] : is_limit t :=
of_iso_limit P
begin
  haveI : is_iso (P.lift_cone_morphism t).hom := i,
  haveI : is_iso (P.lift_cone_morphism t) := cones.cone_iso_of_hom_iso _,
  symmetry,
  apply as_iso (P.lift_cone_morphism t),
end

variables {t : cone F}

lemma hom_lift (h : is_limit t) {W : C} (m : W ⟶ t.X) :
  m = h.lift { X := W, π := { app := λ b, m ≫ t.π.app b } } :=
h.uniq { X := W, π := { app := λ b, m ≫ t.π.app b } } m (λ b, rfl)

/-- Two morphisms into a limit are equal if their compositions with
  each cone morphism are equal. -/
lemma hom_ext (h : is_limit t) {W : C} {f f' : W ⟶ t.X}
  (w : ∀ j, f ≫ t.π.app j = f' ≫ t.π.app j) : f = f' :=
by rw [h.hom_lift f, h.hom_lift f']; congr; exact funext w

/--
Given a right adjoint functor between categories of cones,
the image of a limit cone is a limit cone.
-/
def of_right_adjoint {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ⥤ cone F) [is_right_adjoint h] {c : cone G} (t : is_limit c) :
  is_limit (h.obj c) :=
mk_cone_morphism
  (λ s, (adjunction.of_right_adjoint h).hom_equiv s c (t.lift_cone_morphism _))
  (λ s m, (adjunction.eq_hom_equiv_apply _ _ _).2 t.uniq_cone_morphism)

/--
Given two functors which have equivalent categories of cones, we can transport a limiting cone
across the equivalence.
-/
def of_cone_equiv {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} :
  is_limit (h.functor.obj c) ≃ is_limit c :=
{ to_fun := λ P, of_iso_limit (of_right_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_right_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cone_equiv_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} (P : is_limit (h.functor.obj c)) (s) :
  (of_cone_equiv h P).lift s =
    ((h.unit_iso.hom.app s).hom ≫
      (h.functor.inv.map (P.lift_cone_morphism (h.functor.obj s))).hom) ≫
      (h.unit_iso.inv.app c).hom :=
rfl

@[simp]

/--
A cone postcomposed with a natural isomorphism is a limit cone if and only if the original cone is.
-/
def postcompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone F) :
  is_limit ((cones.postcompose α.hom).obj c) ≃ is_limit c :=
of_cone_equiv (cones.postcompose_equivalence α)

/--
A cone postcomposed with the inverse of a natural isomorphism is a limit cone if and only if
the original cone is.
-/
def postcompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone G) :
  is_limit ((cones.postcompose α.inv).obj c) ≃ is_limit c :=
postcompose_hom_equiv α.symm c

/--
Constructing an equivalence `is_limit c ≃ is_limit d` from a natural isomorphism
between the underlying functors, and then an isomorphism between `c` transported along this and `d`.
-/
def equiv_of_nat_iso_of_iso {F G : J ⥤ C} (α : F ≅ G) (c : cone F) (d : cone G)
  (w : (cones.postcompose α.hom).obj c ≅ d) :
  is_limit c ≃ is_limit d :=
(postcompose_hom_equiv α _).symm.trans (equiv_iso_limit w)

/--
The cone points of two limit cones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := Q.map s w.hom,
  inv := P.map t w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy), }

@[reassoc]
lemma cone_points_iso_of_nat_iso_hom_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).hom ≫ t.π.app j = s.π.app j ≫ w.hom.app j :=
by simp

@[reassoc]
lemma cone_points_iso_of_nat_iso_inv_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).inv ≫ s.π.app j = t.π.app j ≫ w.inv.app j :=
by simp

@[reassoc]
lemma lift_comp_cone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {r s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) :
  P.lift r ≫ (cone_points_iso_of_nat_iso P Q w).hom = Q.map r w.hom :=
Q.hom_ext (by simp)

@[reassoc]
lemma lift_comp_cone_points_iso_of_nat_iso_inv {F G : J ⥤ C} {r s : cone G} {t : cone F}
  (P : is_limit t) (Q : is_limit s) (w : F ≅ G) :
  Q.lift r ≫ (cone_points_iso_of_nat_iso P Q w).inv = P.map r w.inv :=
P.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cone F` is a limit cone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cone F} (P : is_limit s) (e : K ≌ J) :
  is_limit (s.whisker e.functor) :=
of_right_adjoint (cones.whiskering_equivalence e).functor P

/--
If `s : cone F` whiskered by an equivalence `e` is a limit cone, so is `s`.
-/
def of_whisker_equivalence {s : cone F} (e : K ≌ J) (P : is_limit (s.whisker e.functor)) :
  is_limit s :=
equiv_iso_limit ((cones.whiskering_equivalence e).unit_iso.app s).symm
  (of_right_adjoint (cones.whiskering_equivalence e).inverse P : _)

/--
Given an equivalence of diagrams `e`, `s` is a limit cone iff `s.whisker e.functor` is.
-/
def whisker_equivalence_equiv {s : cone F} (e : K ≌ J) :
  is_limit s ≃ is_limit (s.whisker e.functor) :=
⟨λ h, h.whisker_equivalence e, of_whisker_equivalence e, by tidy, by tidy⟩

/--
We can prove two cone points `(s : cone F).X` and `(t.cone G).X` are isomorphic if
* both cones are limit cones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cone_points_iso_of_equivalence {F : J ⥤ C} {s : cone F} {G : K ⥤ C} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := Q.lift ((cones.equivalence_of_reindexing e.symm w').functor.obj s),
  inv := P.lift ((cones.equivalence_of_reindexing e w).functor.obj t),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cone.whisker_π, limits.cones.postcompose_obj_π, fac, whisker_left_app,
      assoc, id_comp, inv_fun_id_assoc_hom_app, fac_assoc, nat_trans.comp_app],
    rw [counit_app_functor, ←functor.comp_map, w.hom.naturality],
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a limit cone: a map `W ⟶ X` is the same as
  a cone on `F` with vertex `W`. -/
def hom_iso (h : is_limit t) (W : C) : ulift.{u₁} (W ⟶ t.X : Type v₃) ≅ (const J).obj W ⟶ F :=
{ hom := λ f, (t.extend f.down).π,
  inv := λ π, ⟨h.lift { X := W, π := π }⟩,
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_limit t) {W : C} (f : ulift.{u₁} (W ⟶ t.X)) :
  (is_limit.hom_iso h W).hom f = (t.extend f.down).π := rfl

/-- The limit of `F` represents the functor taking `W` to
  the set of cones on `F` with vertex `W`. -/
def nat_iso (h : is_limit t) : yoneda.obj t.X ⋙ ulift_functor.{u₁} ≅ F.cones :=
nat_iso.of_components (λ W, is_limit.hom_iso h (unop W)) (by tidy).

/--
Another, more explicit, formulation of the universal property of a limit cone.
See also `hom_iso`.
-/
def hom_iso' (h : is_limit t) (W : C) :
  ulift.{u₁} ((W ⟶ t.X) : Type v₃) ≅
    { p : Π j, W ⟶ F.obj j // ∀ {j j'} (f : j ⟶ j'), p j ≫ F.map f = p j' } :=
h.hom_iso W ≪≫
{ hom := λ π,
  ⟨λ j, π.app j, λ j j' f,
   by convert ←(π.naturality f).symm; apply id_comp⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [id_comp], exact (p.2 f).symm end } }

/-- If G : C → D is a faithful functor which sends t to a limit cone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cone F} {D : Type u₄} [category.{v₄} D] (G : C ⥤ D) [faithful G]
  (ht : is_limit (G.map_cone t)) (lift : Π (s : cone F), s.X ⟶ t.X)
  (h : ∀ s, G.map (lift s) = ht.lift (G.map_cone s)) : is_limit t :=
{ lift := lift,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a limit implies
`G.map_cone c` is also a limit.
-/
def map_cone_equiv {D : Type u₄} [category.{v₄} D]
  {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G) {c : cone K}
  (t : is_limit (F.map_cone c)) : is_limit (G.map_cone c) :=
begin
  apply postcompose_inv_equiv (iso_whisker_left K h : _) (G.map_cone c) _,
  apply t.of_iso_limit (postcompose_whisker_left_map_cone h.symm c).symm,
end

/--
A cone is a limit cone exactly if
there is a unique cone morphism from any other cone.
-/
def iso_unique_cone_morphism {t : cone F} :
  is_limit t ≅ Π s, unique (s ⟶ t) :=
{ hom := λ h s,
  { default := h.lift_cone_morphism s,
    uniq := λ _, h.uniq_cone_morphism },
  inv := λ h,
  { lift := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : yoneda.obj X ⋙ ulift_functor.{u₁} ≅ F.cones)

/-- If `F.cones` is represented by `X`, each morphism `f : Y ⟶ X` gives a cone with cone point
`Y`. -/
def cone_of_hom {Y : C} (f : Y ⟶ X) : cone F :=
{ X := Y, π := h.hom.app (op Y) ⟨f⟩ }

/-- If `F.cones` is represented by `X`, each cone `s` gives a morphism `s.X ⟶ X`. -/
def hom_of_cone (s : cone F) : s.X ⟶ X := (h.inv.app (op s.X) s.π).down

@[simp] lemma cone_of_hom_of_cone (s : cone F) : cone_of_hom h (hom_of_cone h s) = s :=
begin
  dsimp [cone_of_hom, hom_of_cone], cases s, congr, dsimp,
  convert congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) (op s_X)) s_π,
  exact ulift.up_down _
end

@[simp] lemma hom_of_cone_of_hom {Y : C} (f : Y ⟶ X) : hom_of_cone h (cone_of_hom h f) = f :=
congr_arg ulift.down (congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) (op Y)) ⟨f⟩ : _)

/-- If `F.cones` is represented by `X`, the cone corresponding to the identity morphism on `X`
will be a limit cone. -/
def limit_cone : cone F :=
cone_of_hom h (𝟙 X)

/-- If `F.cones` is represented by `X`, the cone corresponding to a morphism `f : Y ⟶ X` is
the limit cone extended by `f`. -/
lemma cone_of_hom_fac {Y : C} (f : Y ⟶ X) :
cone_of_hom h f = (limit_cone h).extend f :=
begin
  dsimp [cone_of_hom, limit_cone, cone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f.op) ⟨𝟙 X⟩,
  dsimp at t,
  simp only [comp_id] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cones` is represented by `X`, any cone is the extension of the limit cone by the
corresponding morphism. -/
lemma cone_fac (s : cone F) : (limit_cone h).extend (hom_of_cone h s) = s :=
begin
  rw ←cone_of_hom_of_cone h s,
  conv_lhs { simp only [hom_of_cone_of_hom] },
  apply (cone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cones` is representable, then the cone corresponding to the identity morphism on
the representing object is a limit cone.
-/
def of_nat_iso {X : C} (h : yoneda.obj X ⋙ ulift_functor.{u₁} ≅ F.cones) :
  is_limit (limit_cone h) :=
{ lift := λ s, hom_of_cone h s,
  fac' := λ s j,
  begin
    have h := cone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cone_of_hom h m,
    congr,
    rw cone_of_hom_fac,
    dsimp [cone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_limit

/--
A cocone `t` on `F` is a colimit cocone if each cocone on `F` admits a unique
cocone morphism from `t`.

See https://stacks.math.columbia.edu/tag/002F.
-/
@[nolint has_inhabited_instance]
structure is_colimit (t : cocone F) :=
(desc  : Π (s : cocone F), t.X ⟶ s.X)
(fac'  : ∀ (s : cocone F) (j : J), t.ι.app j ≫ desc s = s.ι.app j . obviously)
(uniq' : ∀ (s : cocone F) (m : t.X ⟶ s.X) (w : ∀ j : J, t.ι.app j ≫ m = s.ι.app j),
  m = desc s . obviously)

restate_axiom is_colimit.fac'
attribute [simp,reassoc] is_colimit.fac
restate_axiom is_colimit.uniq'

namespace is_colimit

instance subsingleton {t : cocone F} : subsingleton (is_colimit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cocone point
of a colimit cocone over `F` to the cocone point of any cocone over `G`. -/
def map {F G : J ⥤ C} {s : cocone F} (P : is_colimit s) (t : cocone G)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.desc ((cocones.precompose α).obj t)

@[simp, reassoc]
lemma ι_map {F G : J ⥤ C} {c : cocone F} (hc : is_colimit c) (d : cocone G) (α : F ⟶ G)
  (j : J) : c.ι.app j ≫ is_colimit.map hc d α = α.app j ≫ d.ι.app j :=
fac _ _ _

@[simp]
lemma desc_self {t : cocone F} (h : is_colimit t) : h.desc t = 𝟙 t.X :=
(h.uniq _ _ (λ j, comp_id _)).symm

/- Repackaging the definition in terms of cocone morphisms. -/

/-- The universal morphism from a colimit cocone to any other cocone. -/
@[simps]
def desc_cocone_morphism {t : cocone F} (h : is_colimit t) (s : cocone F) : t ⟶ s :=
{ hom := h.desc s }

lemma uniq_cocone_morphism {s t : cocone F} (h : is_colimit t) {f f' : t ⟶ s} :
  f = f' :=
have ∀ {g : t ⟶ s}, g = h.desc_cocone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/-- Restating the definition of a colimit cocone in terms of the ∃! operator. -/
lemma exists_unique {t : cocone F} (h : is_colimit t) (s : cocone F) :
  ∃! (d : t.X ⟶ s.X), ∀ j, t.ι.app j ≫ d = s.ι.app j :=
⟨h.desc s, h.fac s, h.uniq s⟩

/-- Noncomputably make a colimit cocone from the existence of unique factorizations. -/
def of_exists_unique {t : cocone F}
  (ht : ∀ s : cocone F, ∃! d : t.X ⟶ s.X, ∀ j, t.ι.app j ≫ d = s.ι.app j) : is_colimit t :=
by { choose s hs hs' using ht, exact ⟨s, hs, hs'⟩ }

/--
Alternative constructor for `is_colimit`,
providing a morphism of cocones rather than a morphism between the cocone points
and separately the factorisation condition.
-/
@[simps]
def mk_cocone_morphism {t : cocone F}
  (desc : Π (s : cocone F), t ⟶ s)
  (uniq' : ∀ (s : cocone F) (m : t ⟶ s), m = desc s) : is_colimit t :=
{ desc := λ s, (desc s).hom,
  uniq' := λ s m w,
    have cocone_morphism.mk m w = desc s, by apply uniq',
    congr_arg cocone_morphism.hom this }

/-- Colimit cocones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) : s ≅ t :=
{ hom := P.desc_cocone_morphism t,
  inv := Q.desc_cocone_morphism s,
  hom_inv_id' := P.uniq_cocone_morphism,
  inv_hom_id' := Q.uniq_cocone_morphism }

/-- Any cocone morphism between colimit cocones is an isomorphism. -/
lemma hom_is_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) (f : s ⟶ t) : is_iso f :=
⟨⟨Q.desc_cocone_morphism s, ⟨P.uniq_cocone_morphism, Q.uniq_cocone_morphism⟩⟩⟩

/-- Colimits of `F` are unique up to isomorphism. -/
def cocone_point_unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) :
  s.X ≅ t.X :=
(cocones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_hom {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : s.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).hom = t.ι.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_inv {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : t.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).inv = s.ι.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_hom_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).hom ≫ Q.desc r = P.desc r :=
P.uniq _ _ (by simp)

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_inv_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).inv ≫ P.desc r = Q.desc r :=
Q.uniq _ _ (by simp)

/-- Transport evidence that a cocone is a colimit cocone across an isomorphism of cocones. -/
def of_iso_colimit {r t : cocone F} (P : is_colimit r) (i : r ≅ t) : is_colimit t :=
is_colimit.mk_cocone_morphism
  (λ s, i.inv ≫ P.desc_cocone_morphism s)
  (λ s m, by rw i.eq_inv_comp; apply P.uniq_cocone_morphism)

@[simp] lemma of_iso_colimit_desc {r t : cocone F} (P : is_colimit r) (i : r ≅ t) (s) :
  (P.of_iso_colimit i).desc s = i.inv.hom ≫ P.desc s :=
rfl

/-- Isomorphism of cocones preserves whether or not they are colimiting cocones. -/
def equiv_iso_colimit {r t : cocone F} (i : r ≅ t) : is_colimit r ≃ is_colimit t :=
{ to_fun := λ h, h.of_iso_colimit i,
  inv_fun := λ h, h.of_iso_colimit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_colimit_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit r) :
  equiv_iso_colimit i P = P.of_iso_colimit i := rfl

@[simp] lemma equiv_iso_colimit_symm_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit t) :
  (equiv_iso_colimit i).symm P = P.of_iso_colimit i.symm := rfl

/--
If the canonical morphism to a cocone point from a colimiting cocone point is an iso, then the
first cocone was colimiting also.
-/
def of_point_iso {r t : cocone F} (P : is_colimit r) [i : is_iso (P.desc t)] : is_colimit t :=
of_iso_colimit P
begin
  haveI : is_iso (P.desc_cocone_morphism t).hom := i,
  haveI : is_iso (P.desc_cocone_morphism t) := cocones.cocone_iso_of_hom_iso _,
  apply as_iso (P.desc_cocone_morphism t),
end

variables {t : cocone F}

lemma hom_desc (h : is_colimit t) {W : C} (m : t.X ⟶ W) :
  m = h.desc { X := W, ι := { app := λ b, t.ι.app b ≫ m,
    naturality' := by intros; erw [←assoc, t.ι.naturality, comp_id, comp_id] } } :=
h.uniq { X := W, ι := { app := λ b, t.ι.app b ≫ m, naturality' := _ } } m (λ b, rfl)

/-- Two morphisms out of a colimit are equal if their compositions with
  each cocone morphism are equal. -/
lemma hom_ext (h : is_colimit t) {W : C} {f f' : t.X ⟶ W}
  (w : ∀ j, t.ι.app j ≫ f = t.ι.app j ≫ f') : f = f' :=
by rw [h.hom_desc f, h.hom_desc f']; congr; exact funext w

/--
Given a left adjoint functor between categories of cocones,
the image of a colimit cocone is a colimit cocone.
-/
def of_left_adjoint {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ⥤ cocone F) [is_left_adjoint h] {c : cocone G} (t : is_colimit c) :
  is_colimit (h.obj c) :=
mk_cocone_morphism
  (λ s, ((adjunction.of_left_adjoint h).hom_equiv c s).symm (t.desc_cocone_morphism _))
  (λ s m, (adjunction.hom_equiv_apply_eq _ _ _).1 t.uniq_cocone_morphism)

/--
Given two functors which have equivalent categories of cocones,
we can transport a colimiting cocone across the equivalence.
-/
def of_cocone_equiv {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} :
  is_colimit (h.functor.obj c) ≃ is_colimit c :=
{ to_fun := λ P, of_iso_colimit (of_left_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_left_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cocone_equiv_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit (h.functor.obj c)) (s) :
  (of_cocone_equiv h P).desc s =
    (h.unit.app c).hom ≫
    (h.inverse.map (P.desc_cocone_morphism (h.functor.obj s))).hom ≫
    (h.unit_inv.app s).hom :=
rfl

@[simp] lemma of_cocone_equiv_symm_apply_desc {D : Type u₄} [category.{v₄} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit c) (s) :
  ((of_cocone_equiv h).symm P).desc s =
    (h.functor.map (P.desc_cocone_morphism (h.inverse.obj s))).hom ≫ (h.counit.app s).hom :=
rfl

/--
A cocone precomposed with a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone G) :
  is_colimit ((cocones.precompose α.hom).obj c) ≃ is_colimit c :=
of_cocone_equiv (cocones.precompose_equivalence α)

/--
A cocone precomposed with the inverse of a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone F) :
  is_colimit ((cocones.precompose α.inv).obj c) ≃ is_colimit c :=
precompose_hom_equiv α.symm c

/--
Constructing an equivalence `is_colimit c ≃ is_colimit d` from a natural isomorphism
between the underlying functors, and then an isomorphism between `c` transported along this and `d`.
-/
def equiv_of_nat_iso_of_iso {F G : J ⥤ C} (α : F ≅ G) (c : cocone F) (d : cocone G)
  (w : (cocones.precompose α.inv).obj c ≅ d) :
  is_colimit c ≃ is_colimit d :=
(precompose_inv_equiv α _).symm.trans (equiv_iso_colimit w)

/--
The cocone points of two colimit cocones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cocone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := P.map t w.hom,
  inv := Q.map s w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy) }

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  s.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).hom = w.hom.app j ≫ t.ι.app j :=
by simp

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_inv {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  t.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).inv = w.inv.app j ≫ s.ι.app j :=
by simp

@[reassoc]
lemma cocone_points_iso_of_nat_iso_hom_desc {F G : J ⥤ C} {s : cocone F} {r t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) :
  (cocone_points_iso_of_nat_iso P Q w).hom ≫ Q.desc r = P.map _ w.hom :=
P.hom_ext (by simp)

@[reassoc]
lemma cocone_points_iso_of_nat_iso_inv_desc {F G : J ⥤ C} {s : cocone G} {r t : cocone F}
  (P : is_colimit t) (Q : is_colimit s) (w : F ≅ G) :
  (cocone_points_iso_of_nat_iso P Q w).inv ≫ P.desc r = Q.map _ w.inv :=
Q.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cocone F` is a colimit cocone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cocone F} (P : is_colimit s) (e : K ≌ J) :
  is_colimit (s.whisker e.functor) :=
of_left_adjoint (cocones.whiskering_equivalence e).functor P

/--
If `s : cocone F` whiskered by an equivalence `e` is a colimit cocone, so is `s`.
-/
def of_whisker_equivalence {s : cocone F} (e : K ≌ J) (P : is_colimit (s.whisker e.functor)) :
  is_colimit s :=
equiv_iso_colimit ((cocones.whiskering_equivalence e).unit_iso.app s).symm
  (of_left_adjoint (cocones.whiskering_equivalence e).inverse P : _)

/--
Given an equivalence of diagrams `e`, `s` is a colimit cocone iff `s.whisker e.functor` is.
-/
def whisker_equivalence_equiv {s : cocone F} (e : K ≌ J) :
  is_colimit s ≃ is_colimit (s.whisker e.functor) :=
⟨λ h, h.whisker_equivalence e, of_whisker_equivalence e, by tidy, by tidy⟩

/--
We can prove two cocone points `(s : cocone F).X` and `(t.cocone G).X` are isomorphic if
* both cocones are colimit cocones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cocone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cocone_points_iso_of_equivalence {F : J ⥤ C} {s : cocone F} {G : K ⥤ C} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := P.desc ((cocones.equivalence_of_reindexing e w).functor.obj t),
  inv := Q.desc ((cocones.equivalence_of_reindexing e.symm w').functor.obj s),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cocone.whisker_ι, fac, inv_fun_id_assoc_inv_app, whisker_left_app, assoc,
      comp_id, limits.cocones.precompose_obj_ι, fac_assoc, nat_trans.comp_app],
    rw [counit_inv_app_functor, ←functor.comp_map, ←w.inv.naturality_assoc],
    dsimp,
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a colimit cocone: a map `X ⟶ W` is the same as
  a cocone on `F` with vertex `W`. -/
def hom_iso (h : is_colimit t) (W : C) : ulift.{u₁} (t.X ⟶ W : Type v₃) ≅ (F ⟶ (const J).obj W) :=
{ hom := λ f, (t.extend f.down).ι,
  inv := λ ι, ⟨h.desc { X := W, ι := ι }⟩,
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_colimit t) {W : C} (f : ulift (t.X ⟶ W)) :
  (is_colimit.hom_iso h W).hom f = (t.extend f.down).ι := rfl

/-- The colimit of `F` represents the functor taking `W` to
  the set of cocones on `F` with vertex `W`. -/
def nat_iso (h : is_colimit t) : coyoneda.obj (op t.X) ⋙ ulift_functor.{u₁} ≅ F.cocones :=
nat_iso.of_components (is_colimit.hom_iso h) (by intros; ext; dsimp; rw ←assoc; refl)

/--
Another, more explicit, formulation of the universal property of a colimit cocone.
See also `hom_iso`.
-/
def hom_iso' (h : is_colimit t) (W : C) :
  ulift.{u₁} ((t.X ⟶ W) : Type v₃) ≅
    { p : Π j, F.obj j ⟶ W // ∀ {j j' : J} (f : j ⟶ j'), F.map f ≫ p j' = p j } :=
h.hom_iso W ≪≫
{ hom := λ ι,
  ⟨λ j, ι.app j, λ j j' f,
   by convert ←(ι.naturality f); apply comp_id⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [comp_id], exact (p.2 f) end } }

/-- If G : C → D is a faithful functor which sends t to a colimit cocone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cocone F} {D : Type u₄} [category.{v₄} D] (G : C ⥤ D) [faithful G]
  (ht : is_colimit (G.map_cocone t)) (desc : Π (s : cocone F), t.X ⟶ s.X)
  (h : ∀ s, G.map (desc s) = ht.desc (G.map_cocone s)) : is_colimit t :=
{ desc := desc,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cocone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a colimit implies
`G.map_cone c` is also a colimit.
-/
def map_cocone_equiv {D : Type u₄} [category.{v₄} D] {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G)
  {c : cocone K} (t : is_colimit (F.map_cocone c)) : is_colimit (G.map_cocone c) :=
begin
  apply is_colimit.of_iso_colimit _ (precompose_whisker_left_map_cocone h c),
  apply (precompose_inv_equiv (iso_whisker_left K h : _) _).symm t,
end

/--
A cocone is a colimit cocone exactly if
there is a unique cocone morphism from any other cocone.
-/
def iso_unique_cocone_morphism {t : cocone F} :
  is_colimit t ≅ Π s, unique (t ⟶ s) :=
{ hom := λ h s,
  { default := h.desc_cocone_morphism s,
    uniq := λ _, h.uniq_cocone_morphism },
  inv := λ h,
  { desc := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cocone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : coyoneda.obj (op X) ⋙ ulift_functor.{u₁} ≅ F.cocones)

/-- If `F.cocones` is corepresented by `X`, each morphism `f : X ⟶ Y` gives a cocone with cone
point `Y`. -/
def cocone_of_hom {Y : C} (f : X ⟶ Y) : cocone F :=
{ X := Y, ι := h.hom.app Y ⟨f⟩ }

/-- If `F.cocones` is corepresented by `X`, each cocone `s` gives a morphism `X ⟶ s.X`. -/
def hom_of_cocone (s : cocone F) : X ⟶ s.X := (h.inv.app s.X s.ι).down

@[simp] lemma cocone_of_hom_of_cocone (s : cocone F) : cocone_of_hom h (hom_of_cocone h s) = s :=
begin
  dsimp [cocone_of_hom, hom_of_cocone], cases s, congr, dsimp,
  convert congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) s_X) s_ι,
  exact ulift.up_down _
end

@[simp] lemma hom_of_cocone_of_hom {Y : C} (f : X ⟶ Y) : hom_of_cocone h (cocone_of_hom h f) = f :=
congr_arg ulift.down (congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) Y) ⟨f⟩ : _)

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to the identity morphism on `X`
will be a colimit cocone. -/
def colimit_cocone : cocone F :=
cocone_of_hom h (𝟙 X)

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to a morphism `f : Y ⟶ X` is
the colimit cocone extended by `f`. -/
lemma cocone_of_hom_fac {Y : C} (f : X ⟶ Y) :
cocone_of_hom h f = (colimit_cocone h).extend f :=
begin
  dsimp [cocone_of_hom, colimit_cocone, cocone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f) ⟨𝟙 X⟩,
  dsimp at t,
  simp only [id_comp] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cocones` is corepresented by `X`, any cocone is the extension of the colimit cocone by the
corresponding morphism. -/
lemma cocone_fac (s : cocone F) : (colimit_cocone h).extend (hom_of_cocone h s) = s :=
begin
  rw ←cocone_of_hom_of_cocone h s,
  conv_lhs { simp only [hom_of_cocone_of_hom] },
  apply (cocone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cocones` is corepresentable, then the cocone corresponding to the identity morphism on
the representing object is a colimit cocone.
-/
def of_nat_iso {X : C} (h : coyoneda.obj (op X) ⋙ ulift_functor.{u₁} ≅ F.cocones) :
  is_colimit (colimit_cocone h) :=
{ desc := λ s, hom_of_cocone h s,
  fac' := λ s j,
  begin
    have h := cocone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cocone_of_hom h m,
    congr,
    rw cocone_of_hom_fac,
    dsimp [cocone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_colimit

end category_theory.limits


/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
Ported by: Scott Morrison
-/
import Mathlib.Tactic.Linarith.Lemmas
import Mathlib.Tactic.Ring
import Mathlib.Util.SynthesizeUsing

/-!
# Datatypes for `linarith`

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

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

open Lean Elab Tactic Meta

initialize registerTraceClass `linarith
initialize registerTraceClass `linarith.detail

namespace Linarith

/--
A shorthand for tracing the types of a list of proof terms
when the `trace.linarith` option is set to true.
-/
def linarithTraceProofs {α} [ToMessageData α] (s : α) (l : List Expr) : MetaM Unit := do
  trace[linarith] "{s}"
  trace[linarith] (← l.mapM fun e => do instantiateMVars (← inferType e))

/-! ### Linear expressions -/

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

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

namespace Linexp
/--
Add two `Linexp`s together componentwise.
Preserves sorting and uniqueness of the first argument.
-/
partial def add : Linexp → Linexp → Linexp
| [], a => a
| a, [] => a
| (a@(n1,z1)::t1), (b@(n2,z2)::t2) =>
  if n1 < n2 then b::add (a::t1) t2
  else if n2 < n1 then a::add t1 (b::t2)
  else
    let sum := z1 + z2
    if sum = 0 then add t1 t2 else (n1, sum)::add t1 t2

/-- `l.scale c` scales the values in `l` by `c` without modifying the order or keys. -/
def scale (c : Int) (l : Linexp) : Linexp :=
  if c = 0 then []
  else if c = 1 then l
  else l.map $ fun ⟨n, z⟩ => (n, z*c)

/--
`l.get n` returns the value in `l` associated with key `n`, if it exists, and `none` otherwise.
This function assumes that `l` is sorted in decreasing order of the first argument,
that is, it will return `none` as soon as it finds a key smaller than `n`.
-/
def get (n : Nat) : Linexp → Option Int
| [] => none
| ((a, b)::t) =>
  if a < n then none
  else if a = n then some b
  else get n t

/--
`l.contains n` is true iff `n` is the first element of a pair in `l`.
-/
def contains (n : Nat) : Linexp → Bool := Option.isSome ∘ get n

/--
`l.zfind n` returns the value associated with key `n` if there is one, and 0 otherwise.
-/
def zfind (n : Nat) (l : Linexp) : Int :=
match l.get n with
| none => 0
| some v => v

/-- `l.vars` returns the list of variables that occur in `l`. -/
def vars (l : Linexp) : List Nat :=
  l.map Prod.fst

/--
Defines a lex ordering on `Linexp`. This function is performance critical.
-/
def cmp : Linexp → Linexp → Ordering
| [], [] => Ordering.eq
| [], _ => Ordering.lt
| _, [] => Ordering.gt
| ((n1,z1)::t1), ((n2,z2)::t2) =>
  if n1 < n2 then Ordering.lt
  else if n2 < n1 then Ordering.gt
  else if z1 < z2 then Ordering.lt
  else if z2 < z1 then Ordering.gt
  else cmp t1 t2

end Linexp

/-! ### Inequalities -/

/-- The three-element type `Ineq` is used to represent the strength of a comparison between
terms. -/
inductive Ineq : Type
| eq | le | lt
deriving DecidableEq, Inhabited, Repr

namespace Ineq

/--
`max R1 R2` computes the strength of the sum of two inequalities. If `t1 R1 0` and `t2 R2 0`,
then `t1 + t2 (max R1 R2) 0`.
-/
def max : Ineq → Ineq → Ineq
| lt, _ => lt
| _, lt => lt
| le, _ => le
| _, le => le
| eq, eq => eq

/-- `Ineq` is ordered `eq < le < lt`. -/
def cmp : Ineq → Ineq → Ordering
| eq, eq => Ordering.eq
| eq, _ => Ordering.lt
| le, le => Ordering.eq
| le, lt => Ordering.lt
| lt, lt => Ordering.eq
| _, _ => Ordering.gt

/-- Prints an `Ineq` as the corresponding infix symbol. -/
def toString : Ineq → String
| eq => "="
| le => "≤"
| lt => "<"

/-- Finds the name of a multiplicative lemma corresponding to an inequality strength. -/
def toConstMulName : Ineq → Name
| lt => ``mul_neg
| le => ``mul_nonpos
| eq => ``mul_eq

instance : ToString Ineq := ⟨toString⟩

instance : ToFormat Ineq := ⟨fun i => Ineq.toString i⟩

end Ineq

/-! ### Comparisons with 0 -/

/--
The main datatype for FM elimination.
Variables are represented by natural numbers, each of which has an integer coefficient.
Index 0 is reserved for constants, i.e. `coeffs.find 0` is the coefficient of 1.
The represented term is `coeffs.sum (λ ⟨k, v⟩, v * Var[k])`.
str determines the strength of the comparison -- is it < 0, ≤ 0, or = 0?
-/
structure Comp : Type where
  /-- The strength of the comparison, `<`, `≤`, or `=`. -/
  str : Ineq
  /-- The coefficients of the comparison, stored as list of pairs `(i, a)`,
  where `i` is the index of a recorded atom, and `a` is the coefficient. -/
  coeffs : Linexp
deriving Inhabited, Repr

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

/-- `c.coeffOf a` projects the coefficient of variable `a` out of `c`. -/
def Comp.coeffOf (c : Comp) (a : Nat) : Int :=
  c.coeffs.zfind a

/-- `c.scale n` scales the coefficients of `c` by `n`. -/
def Comp.scale (c : Comp) (n : Nat) : Comp :=
  { c with coeffs := c.coeffs.scale n }

/--
`Comp.add c1 c2` adds the expressions represented by `c1` and `c2`.
The coefficient of variable `a` in `c1.add c2`
is the sum of the coefficients of `a` in `c1` and `c2`.
 -/
def Comp.add (c1 c2 : Comp) : Comp :=
  ⟨c1.str.max c2.str, c1.coeffs.add c2.coeffs⟩

/-- `Comp` has a lex order. First the `ineq`s are compared, then the `coeff`s. -/
def Comp.cmp : Comp → Comp → Ordering
| ⟨str1, coeffs1⟩, ⟨str2, coeffs2⟩ =>
  match str1.cmp str2 with
  | Ordering.lt => Ordering.lt
  | Ordering.gt => Ordering.gt
  | Ordering.eq => coeffs1.cmp coeffs2

/--
A `Comp` represents a contradiction if its expression has no coefficients and its strength is <,
that is, it represents the fact `0 < 0`.
 -/
def Comp.isContr (c : Comp) : Bool := c.coeffs.isEmpty && c.str = Ineq.lt

instance Comp.ToFormat : ToFormat Comp :=
  ⟨fun p => format p.coeffs ++ toString p.str ++ "0"⟩

/-! ### Parsing into linear form -/

/-! ### Control -/

/--
A preprocessor transforms a proof of a proposition into a proof of a different propositon.
The return type is `List Expr`, since some preprocessing steps may create multiple new hypotheses,
and some may remove a hypothesis from the list.
A "no-op" preprocessor should return its input as a singleton list.
-/
structure Preprocessor : Type where
  /-- The name of the preprocessor, used in trace output. -/
  name : String
  /-- Replace a hypothesis by a list of hypotheses. These expressions are the proof terms. -/
  transform : Expr → MetaM (List Expr)

/--
Some preprocessors need to examine the full list of hypotheses instead of working item by item.
As with `Preprocessor`, the input to a `GlobalPreprocessor` is replaced by, not added to, its
output.
-/
structure GlobalPreprocessor : Type where
  /-- The name of the global preprocessor, used in trace output. -/
  name : String
  /-- Replace the collection of all hypotheses with new hypotheses.
  These expressions are proof terms. -/
  transform : List Expr → MetaM (List Expr)

/--
Some preprocessors perform branching case splits. A `Branch` is used to track one of these case
splits. The first component, an `MVarId`, is the goal corresponding to this branch of the split,
given as a metavariable. The `List Expr` component is the list of hypotheses for `linarith`
in this branch.
-/
def Branch : Type := MVarId × List Expr

/--
Some preprocessors perform branching case splits.
A `GlobalBranchingPreprocessor` produces a list of branches to run.
Each branch is independent, so hypotheses that appear in multiple branches should be duplicated.
The preprocessor is responsible for making sure that each branch contains the correct goal
metavariable.
-/
structure GlobalBranchingPreprocessor : Type where
  /-- The name of the global branching preprocessor, used in trace output. -/
  name : String
  /-- Given a goal, and a list of hypotheses,
  produce a list of pairs (consisting of a goal and list of hypotheses). -/
  transform : MVarId → List Expr → MetaM (List Branch)

/--
A `Preprocessor` lifts to a `GlobalPreprocessor` by folding it over the input list.
-/
def Preprocessor.globalize (pp : Preprocessor) : GlobalPreprocessor :=
{ name := pp.name,
  transform := List.foldrM (fun e ret => do return (← pp.transform e) ++ ret) [] }

/--
A `GlobalPreprocessor` lifts to a `GlobalBranchingPreprocessor` by producing only one branch.
-/
def GlobalPreprocessor.branching (pp : GlobalPreprocessor) : GlobalBranchingPreprocessor :=
{ name := pp.name,
  transform := fun g l => do return [⟨g, ← pp.transform l⟩] }

/--
`process pp l` runs `pp.transform` on `l` and returns the result,
tracing the result if `trace.linarith` is on.
-/
def GlobalBranchingPreprocessor.process (pp : GlobalBranchingPreprocessor)
  (g : MVarId) (l : List Expr) : MetaM (List Branch) := do
  let branches ← pp.transform g l
  if (branches.length > 1) then
    trace[linarith] m!"Preprocessing: {pp.name} has branched, with branches:"
  for ⟨goal, hyps⟩ in branches do
    goal.withContext do
      linarithTraceProofs m!"Preprocessing: {pp.name}" hyps
  return branches

instance PreprocessorToGlobalBranchingPreprocessor :
    Coe Preprocessor GlobalBranchingPreprocessor :=
  ⟨GlobalPreprocessor.branching ∘ Preprocessor.globalize⟩

instance GlobalPreprocessorToGlobalBranchingPreprocessor :
    Coe GlobalPreprocessor GlobalBranchingPreprocessor :=
  ⟨GlobalPreprocessor.branching⟩

/--
A `CertificateOracle` is a function
`produceCertificate : List Comp → Nat → MetaM (HashMap Nat Nat)`.
`produceCertificate hyps max_var` tries to derive a contradiction from the comparisons in `hyps`
by eliminating all variables ≤ `max_var`.
If successful, it returns a map `coeff : Nat → Nat` as a certificate.
This map represents that we can find a contradiction by taking the sum  `∑ (coeff i) * hyps[i]`.

The default `CertificateOracle` used by `linarith` is
`Linarith.FourierMotzkin.produceCertificate`.
-/
def CertificateOracle : Type :=
  List Comp → Nat → MetaM (Std.HashMap Nat Nat)

open Meta

/-- A configuration object for `linarith`. -/
structure LinarithConfig : Type where
  /-- Discharger to prove that a candidate linear combination of hypothesis is zero. -/
  -- TODO There should be a def for this, rather than calling `evalTactic`?
  discharger : TacticM Unit := do evalTactic (←`(tactic| ring))
  -- We can't actually store a `Type` here,
  -- as we want `LinarithConfig : Type` rather than ` : Type 1`,
  -- so that we can define `elabLinarithConfig : Lean.Syntax → Lean.Elab.TermElabM LinarithConfig`.
  -- For now, we simply don't support restricting the type.
  -- (restrict_type : Option Type := none)
  /-- Prove goals which are not linear comparisons by first calling `exfalso`. -/
  exfalso : Bool := true
  /-- Transparency mode for identifying atomic expressions in comparisons. -/
  transparency : TransparencyMode := .reducible
  /-- Split conjunctions in hypotheses. -/
  split_hypotheses : Bool := true
  /-- Split `≠` in hypotheses, by branching in cases `<` and `>`. -/
  split_ne : Bool := false
  /-- Override the list of preprocessors. -/
  preprocessors : Option (List GlobalBranchingPreprocessor) := none
  /-- Specify an oracle for identifying candidate contradictions.
  The only implementation here is Fourier-Motzkin elimination. -/
  oracle : Option CertificateOracle := none

/--
`cfg.updateReducibility reduce_default` will change the transparency setting of `cfg` to
`default` if `reduce_default` is true. In this case, it also sets the discharger to `ring!`,
since this is typically needed when using stronger unification.
-/
def LinarithConfig.updateReducibility (cfg : LinarithConfig) (reduce_default : Bool) :
    LinarithConfig :=
  if reduce_default then
    { cfg with transparency := .default, discharger := do evalTactic (←`(tactic| ring!)) }
  else cfg

/-!
### Auxiliary functions

These functions are used by multiple modules, so we put them here for accessibility.
-/

/--
`getRelSides e` returns the left and right hand sides of `e` if `e` is a comparison,
and fails otherwise.
This function is more naturally in the `Option` monad, but it is convenient to put in `MetaM`
for compositionality.
 -/
def getRelSides (e : Expr) : MetaM (Expr × Expr) := do
  let e ← instantiateMVars e
  match e.getAppFnArgs with
  | (``LT.lt, #[_, _, a, b]) => return (a, b)
  | (``LE.le, #[_, _, a, b]) => return (a, b)
  | (``Eq, #[_, a, b]) => return (a, b)
  | (``GE.ge, #[_, _, a, b]) => return (a, b)
  | (``GT.gt, #[_, _, a, b]) => return (a, b)
  | _ => throwError "Not a comparison (getRelSides) : {e}"

/--
`parseCompAndExpr e` checks if `e` is of the form `t < 0`, `t ≤ 0`, or `t = 0`.
If it is, it returns the comparison along with `t`.
-/
def parseCompAndExpr (e : Expr) : MetaM (Ineq × Expr) := do
  let e ← instantiateMVars e
  match e.getAppFnArgs with
  | (``LT.lt, #[_, _, e, z]) => if z.zero? then return (Ineq.lt, e) else throwNotZero z
  | (``LE.le, #[_, _, e, z]) => if z.zero? then return (Ineq.le, e) else throwNotZero z
  | (``Eq, #[_, e, z]) => if z.zero? then return (Ineq.eq, e) else throwNotZero z
  | _ => throwError "invalid comparison: {e}"
  where /-- helper function for error message -/
  throwNotZero (z : Expr) := throwError "invalid comparison, rhs not zero: {z}"

/--
`mkSingleCompZeroOf c h` assumes that `h` is a proof of `t R 0`.
It produces a pair `(R', h')`, where `h'` is a proof of `c*t R' 0`.
Typically `R` and `R'` will be the same, except when `c = 0`, in which case `R'` is `=`.
If `c = 1`, `h'` is the same as `h` -- specifically, it does *not* change the type to `1*t R 0`.
-/
def mkSingleCompZeroOf (c : Nat) (h : Expr) : MetaM (Ineq × Expr) := do
  let tp ← inferType h
  let (iq, e) ← parseCompAndExpr tp
  if c = 0 then do
    let e' ← mkAppM ``zero_mul #[e]
    return (Ineq.eq, e')
  else if c = 1 then return (iq, h)
  else do
    let tp ← inferType (← getRelSides (← inferType h)).2
    let cpos ← mkAppM ``GT.gt #[(← tp.ofNat c), (← tp.ofNat 0)]
    -- TODO There should be a def for this, rather than using `evalTactic`.
    let ex ← synthesizeUsing cpos (do evalTactic (←`(tactic| norm_num; done)))
    let e' ← mkAppM iq.toConstMulName #[h, ex]
    return (iq, e')


/- # LoVe Preface
## Proof Assistants
Proof assistants (also called interactive theorem provers)
* check and help develop formal proofs;
* can be used to prove big theorems, not only logic puzzles;
* can be tedious to use;
* are highly addictive (think video games).
A selection of proof assistants, classified by logical foundations:
* set theory: Isabelle/ZF, Metamath, Mizar;
* simple type theory: HOL4, HOL Light, Isabelle/HOL;
* **dependent type theory**: Agda, Coq, **Lean**, Matita, PVS.
## Success Stories
Mathematics:
* the four-color theorem (in Coq);
* the odd-order theorem (in Coq);
* the Kepler conjecture (in HOL Light and Isabelle/HOL).
Computer science:
* hardware
* operating systems
* programming language theory
* compilers
* security
## Lean
Lean is a proof assistant developed primarily by Leonardo de Moura (Microsoft
Research) since 2012.
Its mathematical library, `mathlib`, is developed under the leadership of
Jeremy Avigad (Carnegie Mellon University).
We use community version 3.20.0. We use its basic libraries, `mathlib`, and
`LoVelib`. Lean is a research project.
Strengths:
* highly expressive logic based on a dependent type theory called the
  **calculus of inductive constructions**;
* extended with classical axioms and quotient types;
* metaprogramming framework;
* modern user interface;
* documentation;
* open source;
* endless source of puns (Lean Forward, Lean Together, Boolean, …).
## This Course
### Web Site
    https://lean-forward.github.io/logical-verification/2020/index.html
### Installation Instructions
    https://github.com/blanchette/logical_verification_2020/blob/master/README.md#logical-verification-2020---installation-instructions
### Repository (Demos, Exercises, Homework)
    https://github.com/blanchette/logical_verification_2020
The file you are currently looking at is a demo. There are
* 13 demo files;
* 13 exercise sheets;
* 11 homework sheets (10 points each);
* 1 project (20 points).
You may submit at most 10 homework, or at most 8 homework and the project.
Homework, including the project, must be done individually. The homework builds
on the exercises, which build on the demos.
### The Hitchhiker's Guide to Logical Verification
    https://github.com/blanchette/logical_verification_2020/blob/master/hitchhikers_guide.pdf
    https://github.com/blanchette/logical_verification_2020/blob/master/hitchhikers_guide_tablet.pdf
The lecture notes consist of a preface and 13 chapters. They cover the same
material as the corresponding lectures but with more details. Sometimes there
will not be enough time to cover everything in class, so reading the lecture
notes will be necessary.
### Final Exam
The course aims at teaching concepts, not syntax. Therefore, the final exam is
on paper.
## Our Goal
We want you to
* master fundamental theory and techniques in interactive theorem proving;
* familiarize yourselves with some application areas;
* develop some practical skills you can apply on a larger project (as a hobby,
  for an MSc or PhD, or in industry);
* feel ready to move to another proof assistant and apply what you have learned;
* understand the domain well enough to start reading scientific papers.
This course is neither a pure logical foundations course nor a Lean tutorial.
Lean is our vehicle, not an end in itself.
# LoVe Demo 1: Definitions and Statements
We introduce the basics of Lean and proof assistants, without trying to carry
out actual proofs yet. We focus on specifying objects and statements of their
intended properties. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## A View of Lean
In a first approximation:
    Lean = functional programming + logic
In today's lecture, we cover inductive types, recursive functions, and lemma
statements.
If you are not familiar with typed functional programming (e.g., Haskell, ML,
OCaml, Scala), we recommend that you study a tutorial, such as the first
chapters of the online tutorial __Learn You a Haskell for Great Good!__:
    http://learnyouahaskell.com/chapters
Make sure to at least reach the section titled "Lambdas".
## Types and Terms
Similar to simply typed λ-calculus or typed functional programming languages
(ML, OCaml, Haskell).
Types `σ`, `τ`, `υ`:
* type variables `α`;
* basic types `T`;
* complex types `T σ1 … σN`.
Some type constructors `T` are written infix, e.g., `→` (function type).
The function arrow is right-associative:
`σ₁ → σ₂ → σ₃ → τ` = `σ₁ → (σ₂ → (σ₃ → τ))`.
Polymorphic types are also possible. In Lean, the type variables must be bound
using `∀`, e.g., `∀α, α → α`.
Terms `t`, `u`:
* constants `c`;
* variables `x`;
* applications `t u`;
* λ-expressions `λx, t`.
__Currying__: functions can be
* fully applied (e.g., `f x y z` if `f` is ternary);
* partially applied (e.g., `f x y`, `f x`);
* left unapplied (e.g., `f`).
Application is left-associative: `f x y z` = `((f x) y) z`. -/

#check ℕ
#check ℤ

#check empty
#check unit
#check bool

#check ℕ → ℤ
#check ℤ → ℕ
#check bool → ℕ → ℤ
#check (bool → ℕ) → ℤ
#check ℕ → (bool → ℕ) → ℤ

#check λx : ℕ, x
#check λf : ℕ → ℕ, λg : ℕ → ℕ, λh : ℕ → ℕ, λx : ℕ, h (g (f x))
#check λ(f g h : ℕ → ℕ) (x : ℕ), h (g (f x))

constants a b : ℤ
constant f : ℤ → ℤ
constant g : ℤ → ℤ → ℤ

#check λx : ℤ, g (f (g a x)) (g x b)
#check λx, g (f (g a x)) (g x b)

#check λx, x

constant trool : Type
constants trool.true trool.false trool.maybe : trool

/- ### Type Checking and Type Inference
Type checking and type inference are decidable problems, but this property is
quickly lost if features such as overloading or subtyping are added.
Type judgment: `C ⊢ t : σ`, meaning `t` has type `σ` in local context `C`.
Typing rules:
    —————————— Cst   if c is declared with type σ
    C ⊢ c : σ
    —————————— Var   if x : σ occurs in C
    C ⊢ x : σ
    C ⊢ t : σ → τ    C ⊢ u : σ
    ——————————————————————————— App
    C ⊢ t u : τ
    C, x : σ ⊢ t : τ
    ———————————————————————— Lam
    C ⊢ (λx : σ, t) : σ → τ
### Type Inhabitation
Given a type `σ`, the __type inhabitation__ problem consists of finding a term
of that type.
Recursive procedure:
1. If `σ` is of the form `τ → υ`, a candidate inhabitant is an anonymous
   function of the form `λx, _`.
2. Alternatively, you can use any constant or variable `x : τ₁ → ⋯ → τN → σ` to
   build the term `x _ … _`. -/

constants α β γ : Type

def some_fun_of_type : (α → β → γ) → ((β → α) → β) → α → γ :=
λf g a, f a (g (λb, a))

/- ## Type Definitions
An __inductive type__ (also called __inductive datatype__,
__algebraic datatype__, or just __datatype__) is a type that consists all the
values that can be built using a finite number of applications of its
__constructors__, and only those.
### Natural Numbers -/

namespace my_nat

/- Definition of type `nat` (= `ℕ`) of natural numbers, using Peano-style unary
notation: -/

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

#check nat
#check nat.zero
#check nat.succ

end my_nat

#print nat
#print ℕ

/- ### Arithmetic Expressions -/

inductive aexp : Type
| num : ℤ → aexp
| var : string → aexp
| add : aexp → aexp → aexp
| sub : aexp → aexp → aexp
| mul : aexp → aexp → aexp
| div : aexp → aexp → aexp

/- ### Lists -/

namespace my_list

inductive list (α : Type) : Type
| nil  : list
| cons : α → list → list

#check list.nil
#check list.cons

end my_list

#print list

/- ## Function Definitions
The syntax for defining a function operating on an inductive type is very
compact: We define a single function and use __pattern matching__ to extract the
arguments to the constructors. -/

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

#eval add 2 7
#reduce add 2 7

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

#eval mul 2 7

#print mul
#print mul._main

def power : ℕ → ℕ → ℕ
| _ nat.zero     := 1
| m (nat.succ n) := m * power m n

#eval power 2 5

def power₂ (m : ℕ) : ℕ → ℕ
| nat.zero     := 1
| (nat.succ n) := m * power₂ n

#eval power₂ 2 5

def iter (α : Type) (z : α) (f : α → α) : ℕ → α
| nat.zero     := z
| (nat.succ n) := f (iter n)

#check iter

def power₃ (m n : ℕ) : ℕ :=
iter ℕ 1 (λl, m * l) n

#eval power₃ 2 5

def append (α : Type) : list α → list α → list α
| list.nil         ys := ys
| (list.cons x xs) ys := list.cons x (append xs ys)

#check append
#eval append _ [3, 1] [4, 1, 5]

/- Aliases:
    `[]`          := `nil`
    `x :: xs`     := `cons x xs`
    `[x₁, …, xN]` := `x₁ :: … :: xN :: []` -/

def append₂ {α : Type} : list α → list α → list α
| list.nil         ys := ys
| (list.cons x xs) ys := list.cons x (append₂ xs ys)

#check append₂
#eval append₂ [3, 1] [4, 1, 5]

#check @append₂
#eval @append₂ _ [3, 1] [4, 1, 5]

def append₃ {α : Type} : list α → list α → list α
| []        ys := ys
| (x :: xs) ys := x :: append₃ xs ys

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

def eval (env : string → ℤ) : aexp → ℤ
| (aexp.num i)     := i
| (aexp.var x)     := env x
| (aexp.add e₁ e₂) := eval e₁ + eval e₂
| (aexp.sub e₁ e₂) := eval e₁ - eval e₂
| (aexp.mul e₁ e₂) := eval e₁ * eval e₂
| (aexp.div e₁ e₂) := eval e₁ / eval e₂

/- Lean only accepts the function definitions for which it can prove
termination. In particular, it accepts __structurally recursive__ functions,
which peel off exactly one constructor at a time.
## Lemma Statements
Notice the similarity with `def` commands. -/

namespace sorry_lemmas

lemma add_comm (m n : ℕ) :
  add m n = add n m :=
sorry

lemma add_assoc (l m n : ℕ) :
  add (add l m) n = add l (add m n) :=
sorry

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
sorry

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
sorry

lemma mul_add (l m n : ℕ) :
  mul l (add m n) = add (mul l m) (mul l n) :=
sorry

lemma reverse_reverse {α : Type} (xs : list α) :
  reverse (reverse xs) = xs :=
sorry

/- Axioms are like lemmas but without proofs (`:= …`). Constant declarations
are like definitions but without bodies (`:= …`). -/

constants a b : ℤ

axiom a_less_b :
  a < b

end sorry_lemmas

end LoVe


import algebra.group.defs

universe u

def incl {α : Type u} [has_mul α] (a b : α) : Prop :=
∃ c, a * c = b

infix ` ≼ `:50 := incl

instance {α : Type u} [has_mul α] : has_mul (option α) :=
⟨option.lift_or_get (*)⟩

@[simp] lemma none_mul {α : Type u} [has_mul α] (a : option α) : none * a = a :=
by cases a; refl

@[simp] lemma mul_none {α : Type u} [has_mul α] (a : option α) : a * none = a :=
by cases a; refl

@[simp] lemma some_mul_some {α : Type u} [has_mul α] (a b : α) :
some a * some b = some (a * b) := rfl

instance option.comm_semigroup {α : Type u} [comm_semigroup α] : comm_semigroup (option α) := {
  mul_assoc := begin
    intros a b c,
    cases a,
    { rw [none_mul, none_mul], },
    cases b,
    { rw [none_mul, mul_none], },
    cases c,
    { rw [mul_none, mul_none], },
    rw [some_mul_some, some_mul_some, some_mul_some, some_mul_some, mul_assoc],
  end,
  mul_comm := begin
    intros a b,
    cases a,
    { rw [none_mul, mul_none], },
    cases b,
    { rw [none_mul, mul_none], },
    rw [some_mul_some, some_mul_some, mul_comm],
  end,
  ..option.has_mul,
}

@[simp] lemma none_incl {α : Type u} [comm_semigroup α] (a : option α) : none ≼ a :=
⟨a, none_mul a⟩

@[simp, refl] lemma incl_refl {α : Type u} [monoid α] (a : α) : a ≼ a :=
⟨1, mul_one a⟩

@[simp, trans] lemma incl_trans {α : Type u} [semigroup α] (a b c : α) :
  a ≼ b → b ≼ c → a ≼ c :=
begin
  rintro ⟨d, rfl⟩ ⟨e, rfl⟩,
  refine ⟨d * e, _⟩,
  rw mul_assoc,
end

@[simp] lemma option.some_incl_some {α : Type u} [monoid α] {a b : α} :
  some a ≼ some b ↔ a ≼ b :=
begin
  split,
  { rintro ⟨c, hc⟩,
    cases c,
    cases hc, refl,
    refine ⟨c, _⟩, cases hc, refl, },
  { rintro ⟨c, hc⟩,
    refine ⟨some c, _⟩, rw ← hc, refl, },
end

class resource_algebra (α : Type u) extends comm_semigroup α :=
(valid : set α)
(core : α → option α)
(core_mul_self (a : α) {ca : α} : core a = some ca → ca * a = a)
(core_core (a : α) {ca : α} : core a = some ca → core ca = some ca)
(core_mono_some (a b : α) {ca : α} : core a = some ca → a ≼ b → ∃ cb, core b = some cb)
(core_mono (a b : α) {ca : α} : core a = some ca → a ≼ b → core a ≼ core b)
(valid_mul (a b : α) : valid (a * b) → valid a)

prefix `✓ `:40 := resource_algebra.valid

structure frame {α : Type u} [resource_algebra α] (a : α) :=
(val : α)
(prop : ✓ val * a)

def resource_algebra.can_update
  {α : Type u} [resource_algebra α] (a : α) (b : set α) : Prop :=
∀ f : frame a, ∃ f' : frame f.val, f'.val ∈ b

infixr ` ↝ᵣₐ `:25 := resource_algebra.can_update

lemma can_update_iff {α : Type u} [resource_algebra α] (a : α) (b : set α) :
  a ↝ᵣₐ b ↔ ∀ f : α, ✓ f * a → ∃ f' ∈ b, ✓ f' * f :=
begin
  split,
  { intros h f hf,
    obtain ⟨f', hf'⟩ := h ⟨f, hf⟩,
    exact ⟨f'.val, hf', f'.prop⟩, },
  { intros h f,
    obtain ⟨f', hf₁, hf₂⟩ := h f.val f.prop,
    exact ⟨⟨f', hf₂⟩, hf₁⟩, },
end


lemma eq_zero_of_add_right_eq_self {a b : ℕ} : a + b = a → b = 0 :=
begin
    intro h,

    induction a with d hd,
    rw nat.zero_add at h,
    exact h,

    rw nat.succ_add at h,
    rw hd,
    rw nat.succ.inj h,
end


-- Implementation of Wireworld.

-- Cell states 'cellT' are represented as follows.
--   'empty'
--   'ehead' for electron head
--   'etail' for electron tail
--   'condu' for conductor
-- The definition 'mk_hpp' builds an instance of HPP
-- from an initial configuration of cell states.

import cell_automaton utils data.vector
open utils

namespace ww

section ww

-- empty | electron head | electron tail | conductor
@[derive decidable_eq]
inductive cellT | empty | ehead | etail | condu

open cellT

def cellT_str : cellT → string
    | empty := " "
    | ehead := "H"
    | etail := "T"
    | condu := "X"

instance cellT_to_str : has_to_string cellT := ⟨cellT_str⟩

instance cellT_repr : has_repr cellT := ⟨cellT_str⟩

attribute [reducible]
def ww := cell_automaton cellT

def step : cellT → ℕ → cellT
  | empty _ := empty
  | ehead _ := etail
  | etail _ := condu
  | condu c := if c = 1 ∨ c = 2 then ehead else condu

def ww_step (cell : cellT) (neigh : list cellT) :=
      step cell $ count_at_single neigh ehead

def mk_ww (g : vec_grid₀ cellT) : ww :=
    ⟨g, empty, cell_automatons.moore, ww_step, cell_automatons.ext_id⟩

def wire_g :=
  vec_grid₀.mk ⟨1, 5, dec_trivial,
              ⟨[etail, ehead, condu, condu, condu], rfl⟩⟩
                        ⟨0, 1⟩

def wire : ww := mk_ww wire_g

def or_g_10 :=
    vec_grid₀.mk ⟨5, 6, dec_trivial,
                        ⟨[etail, ehead, empty, empty, empty, empty,
                          empty, empty, condu, empty, empty, empty,
                            empty, condu, condu, condu, condu, condu,
                            empty, empty, condu, empty, empty, empty,
                            condu, condu, empty, empty, empty, empty], rfl⟩⟩
                        ⟨0, 1⟩

def or_10 : ww := mk_ww or_g_10

def or_g_01 :=
    vec_grid₀.mk ⟨5, 6, dec_trivial,
                        ⟨[condu, condu, empty, empty, empty, empty,
                          empty, empty, condu, empty, empty, empty,
                            empty, condu, condu, condu, condu, condu,
                            empty, empty, condu, empty, empty, empty,
                            etail, ehead, empty, empty, empty, empty], rfl⟩⟩
                        ⟨0, 1⟩

def or_01 : ww := mk_ww or_g_01

open cardinals

section ww_or

def or_gate' :=
    vec_grid₀.mk ⟨5, 6, dec_trivial,
                        ⟨[condu, condu, empty, empty, empty, empty,
                          empty, empty, condu, empty, empty, empty,
                            empty, condu, condu, condu, condu, condu,
                            empty, empty, condu, empty, empty, empty,
                            etail, ehead, empty, empty, empty, empty], rfl⟩⟩
                        ⟨-5, -5⟩

def or_gate : ww := mk_ww or_gate'

def write_input (i₁ : bool) (i₂ : bool) :=
    let (b₁, b₂) := if i₁ then (etail, ehead) else (condu, condu) in
    let (b₃, b₄) := if i₂ then (etail, ehead) else (condu, condu) in
    mod_many
        [(⟨-5, -10⟩, b₁), (⟨-4, -10⟩, b₂), (⟨-5, -6⟩, b₃), (⟨-4, -6⟩, b₄)]
        or_gate

def sim_or (i₁ i₂ : bool) : bool :=
    let sim := step_n (write_input i₁ i₂) 3 in
        yield_at sim ⟨-8, -2⟩ = etail ∧ yield_at sim ⟨-8, -1⟩ = ehead

end ww_or

section ww_xor

inductive direction | N | W | E | S

open direction

structure inout :=
    (p₁ : point)
    (p₂ : point)
    (dir : direction)

structure ww₁ :=
    (aut : ww)
    (ins : list inout)
    (ous : list inout)

def str_of_ww₁ : ww₁ → string
  | ⟨aut, _, _⟩ := to_string aut

instance ww₁_to_str : has_to_string ww₁ := ⟨str_of_ww₁⟩

instance ww₁_repr : has_repr ww₁ := ⟨str_of_ww₁⟩

def mk_ww₁ (g : vec_grid₀ cellT) (inputs outputs : list inout) : ww₁ :=
    ⟨mk_ww g, inputs, outputs⟩

def write (a : ww₁) (n : ℕ) (b : bool) : ww₁ :=
    let input := list.nth a.ins n in
    match input with
        | none := a
        | some ⟨p₁, p₂, dir⟩ :=
            if b then
            match dir with
                | N :=
                    ww₁.mk (mod_many [(up p₁ p₂, ehead), (down p₁ p₂, etail)] a.aut)
                           a.ins a.ous
                | S :=
                    ww₁.mk (mod_many [(down p₁ p₂, ehead), (up p₁ p₂, etail)] a.aut)
                                 a.ins a.ous
                | W :=
                  ww₁.mk (mod_many [(left p₁ p₂, ehead), (right p₁ p₂, etail)] a.aut)
                                 a.ins a.ous
                | E :=
                    ww₁.mk (mod_many [(right p₁ p₂, ehead), (left p₁ p₂, etail)] a.aut)
                                 a.ins a.ous
            end
            else ww₁.mk (mod_many [(p₁, condu), (p₂, condu)] a.aut) a.ins a.ous
    end

def read (a : ww₁) (n : ℕ) : bool :=
    let output := list.nth a.ous n in
    match output with
        | none := ff
        | some ⟨p₁, p₂, dir⟩ :=
        match dir with
            | N := yield_at a.aut (up p₁ p₂) = ehead ∧
                         yield_at a.aut (down p₁ p₂) = etail
            | S := yield_at a.aut (up p₁ p₂) = etail ∧
                         yield_at a.aut (down p₁ p₂) = ehead
            | W := yield_at a.aut (left p₁ p₂) = ehead ∧
                         yield_at a.aut (right p₁ p₂) = etail
            | E := yield_at a.aut (left p₁ p₂) = etail ∧
                         yield_at a.aut (right p₁ p₂) = ehead
        end
    end

def xor_gate' :=
    vec_grid₀.mk ⟨7, 7, dec_trivial,
      ⟨[condu, condu, empty, empty, empty, empty, empty,
        empty, empty, condu, empty, empty, empty, empty,
          empty, condu, condu, condu, condu, empty, empty,
          empty, condu, empty, empty, condu, condu, condu,
          empty, condu, condu, condu, condu, empty, empty,
          empty, empty, condu, empty, empty, empty, empty,
          condu, condu, empty, empty, empty, empty, empty], rfl⟩⟩
      ⟨0, 0⟩

def xor_gate_inputs : list inout := [⟨⟨0, 6⟩, ⟨1, 6⟩, E⟩, ⟨⟨0, 0⟩, ⟨1, 0⟩, E⟩]

def xor_gate_outputs : list inout := [⟨⟨5, 3⟩, ⟨6, 3⟩, E⟩]

def mk_xor (a : ww) : ww₁ := ⟨a, xor_gate_inputs, xor_gate_outputs⟩

def xor_gate_w : ww := mk_ww xor_gate'

def xor_gate : ww₁ := mk_xor xor_gate_w

def xor' (b₁ b₂ : bool) : bool :=
    read (mk_xor (step_n (write (write xor_gate 0 b₂) 1 b₁).aut 5)) 0

theorem xor_iff_xor' {b₁ b₂} : bxor b₁ b₂ ↔ xor' b₁ b₂ :=
begin
  cases b₁; cases b₂; split; intros h,
  {
    dsimp at h, contradiction
  },
  {
    have : xor' ff ff = ff, from dec_trivial,
    rw this at h,
    contradiction
  },
  {
    exact dec_trivial
  },
  {
    dsimp, unfold_coes
  },
  {
    exact dec_trivial
  },
  {
    dsimp, unfold_coes
  },
  {
    dsimp at h, contradiction
  },
  {
    have : xor' tt tt = ff, from dec_trivial,
    rw this at h,
    contradiction
  }
end

end ww_xor

end ww

end ww


import GMLInit.Logic.Basic

namespace Function

abbrev curry {α} {β : α → Sort _} {γ : (a : α) ×' β a → Sort _} (f : (p : (a : α) ×' β a) → γ p) (a : α) (b : β a) : γ ⟨a, b⟩ := f ⟨a, b⟩

abbrev uncurry {α} {β : α → Sort _} {γ : {a : α} → β a → Sort _} (f : (a : α) → (b : β a) → γ b) (ab : (a : α) ×' β a) : γ ab.snd := f ab.fst ab.snd

syntax (name := curryNum) "curry." noWs num term : term
macro_rules
| `(curry.$n:num $f:term) =>
  match Lean.Syntax.isNatLit? n with
  | some 0 => `($f)
  | some (n+1) =>
    let n := Lean.Syntax.mkNumLit (toString n)
    `(curry.$n (Function.curry $f))
  | _ => Lean.Macro.throwUnsupported

syntax (name := uncurryNum) "uncurry." noWs num term : term
macro_rules
| `(uncurry.$n:num $f:term) =>
  match Lean.Syntax.isNatLit? n with
  | some 0 => `($f)
  | some (n+1) =>
    let n := Lean.Syntax.mkNumLit (toString n)
    `(uncurry.$n (Function.uncurry $f))
  | _ => Lean.Macro.throwUnsupported

class InjectiveTC {α β} (f : α → β) : Prop where
  protected inj {lhs rhs} : f lhs = f rhs → lhs = rhs

class Injective {α β} (f : α → β) extends InjectiveTC f : Prop

def inj {α β} (f : α → β) [self : InjectiveTC f] {lhs rhs} : f lhs = f rhs → lhs = rhs := self.inj

theorem inj_iff {α β} (f : α → β) [InjectiveTC f] {lhs rhs : α} : f lhs = f rhs ↔ lhs = rhs := Iff.intro (inj f) (congrArg f)

theorem inj_eq {α β} (f : α → β) [InjectiveTC f] {lhs rhs : α} : (f lhs = f rhs) = (lhs = rhs) := propext (inj_iff f)

namespace Injective

instance {α β γ} (g : α → β) (f : β → γ) [Injective f] [InjectiveTC g] : InjectiveTC (λ x => f (g x)) where
  inj h := inj g (inj f h)

instance (α) : Injective (id : α → α) where inj := id
instance (α β) : Injective (Sum.inl : α → Sum α β) where inj | rfl => rfl
instance (α β) : Injective (Sum.inr : β → Sum α β) where inj | rfl => rfl
instance (α β) (b : β) : Injective ((.,b) : α → α × β) where inj | rfl => rfl
instance (α β) (a : α) : Injective ((a,.) : β → α × β) where inj | rfl => rfl
instance (α) (β : α → Type _) (a : α) : Injective (Sigma.mk a : β a → Sigma β) where inj | rfl => rfl
instance (a : α) : Injective (a::.) where inj | rfl => rfl
instance (as : List α) : Injective (.::as) where inj | rfl => rfl
instance (α) : Injective (some : α → Option α) where inj | rfl => rfl
instance : Injective Nat.succ where inj | rfl => rfl
instance (n : Nat) : Injective (n+.: Nat → Nat) where inj := Nat.add_left_cancel
instance (n : Nat) : Injective (.+n: Nat → Nat) where inj := Nat.add_right_cancel

end Injective

end Function


-- things not defined in the standard library (but which should be)

universes u v

variables {α : Sort u} {β : Sort v}

lemma inv_image.equivalence (r : β → β → Prop) (f : α → β) (h : equivalence r) : equivalence (inv_image r f) :=
mk_equivalence _
(by intro x; apply h.1)
(by intros x y; apply h.2.1)
(by intros x y z; apply h.2.2)


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

Injective functions.
-/
import data.equiv.basic

universes u v w x

namespace function

structure embedding (α : Sort*) (β : Sort*) :=
(to_fun : α → β)
(inj    : injective to_fun)

infixr ` ↪ `:25 := embedding

instance {α : Sort u} {β : Sort v} : has_coe_to_fun (α ↪ β) := ⟨_, embedding.to_fun⟩

end function

protected def equiv.to_embedding {α : Sort u} {β : Sort v} (f : α ≃ β) : α ↪ β :=
⟨f, f.bijective.1⟩

@[simp] theorem equiv.to_embedding_coe_fn {α : Sort u} {β : Sort v} (f : α ≃ β) :
  (f.to_embedding : α → β) = f := rfl

namespace function
namespace embedding

@[simp] theorem to_fun_eq_coe {α β} (f : α ↪ β) : to_fun f = f := rfl

@[simp] theorem coe_fn_mk {α β} (f : α → β) (i) :
  (@mk _ _ f i : α → β) = f := rfl

theorem inj' {α β} : ∀ (f : α ↪ β), injective f
| ⟨f, hf⟩ := hf

@[refl] protected def refl (α : Sort*) : α ↪ α :=
⟨id, injective_id⟩

@[trans] protected def trans {α β γ} (f : α ↪ β) (g : β ↪ γ) : α ↪ γ :=
⟨_, injective_comp g.inj' f.inj'⟩

@[simp] theorem refl_apply {α} (x : α) : embedding.refl α x = x := rfl

@[simp] theorem trans_apply {α β γ} (f : α ↪ β) (g : β ↪ γ) (a : α) :
  (f.trans g) a = g (f a) := rfl

protected def congr {α : Sort u} {β : Sort v} {γ : Sort w} {δ : Sort x}
  (e₁ : α ≃ β) (e₂ : γ ≃ δ) (f : α ↪ γ) : (β ↪ δ) :=
(equiv.to_embedding e₁.symm).trans (f.trans e₂.to_embedding)

protected noncomputable def of_surjective {α β} {f : β → α} (hf : surjective f) :
  α ↪ β :=
⟨surj_inv hf, injective_surj_inv _⟩

protected noncomputable def equiv_of_surjective {α β} (f : α ↪ β) (hf : surjective f) :
  α ≃ β :=
equiv.of_bijective ⟨f.inj, hf⟩

protected def of_not_nonempty {α β} (hα : ¬ nonempty α) : α ↪ β :=
⟨λa, (hα ⟨a⟩).elim, assume a, (hα ⟨a⟩).elim⟩

noncomputable def set_value {α β} (f : α ↪ β) (a : α) (b : β) : α ↪ β :=
by haveI := classical.dec; exact
if h : ∃ a', f a' = b then
  (equiv.swap a (classical.some h)).to_embedding.trans f
else
  ⟨λ a', if a' = a then b else f a',
   λ a₁ a₂ e, begin
    simp at e, split_ifs at e with h₁ h₂,
    { cc },
    { cases h ⟨_, e.symm⟩ },
    { cases h ⟨_, e⟩ },
    { exact f.2 e }
   end⟩

theorem set_value_eq {α β} (f : α ↪ β) (a : α) (b : β) : set_value f a b a = b :=
begin
  rw [set_value],
  cases classical.dec (∃ a', f a' = b);
    dsimp [dite], {simp},
  simp [equiv.swap_apply_left],
  apply classical.some_spec h
end

/-- Embedding into `option` -/
protected def some {α} : α ↪ option α :=
⟨some, option.injective_some α⟩

def subtype {α} (p : α → Prop) : subtype p ↪ α :=
⟨subtype.val, λ _ _, subtype.eq'⟩

/-- Restrict the codomain of an embedding. -/
def cod_restrict {α β} (p : set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
⟨λ a, ⟨f a, H a⟩, λ a b h, f.inj (@congr_arg _ _ _ _ subtype.val h)⟩

@[simp] theorem cod_restrict_apply {α β} (p) (f : α ↪ β) (H a) :
  cod_restrict p f H a = ⟨f a, H a⟩ := rfl

def prod_congr {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α × γ ↪ β × δ :=
⟨assume ⟨a, b⟩, (e₁ a, e₂ b),
  assume ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ h,
  have a₁ = a₂ ∧ b₁ = b₂, from (prod.mk.inj h).imp (assume h, e₁.inj h) (assume h, e₂.inj h),
  this.left ▸ this.right ▸ rfl⟩

section sum
open sum

def sum_congr {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α ⊕ γ ↪ β ⊕ δ :=
⟨assume s, match s with inl a := inl (e₁ a) | inr b := inr (e₂ b) end,
    assume s₁ s₂ h, match s₁, s₂, h with
    | inl a₁, inl a₂, h := congr_arg inl $ e₁.inj $ inl.inj h
    | inr b₁, inr b₂, h := congr_arg inr $ e₂.inj $ inr.inj h
    end⟩

@[simp] theorem sum_congr_apply_inl {α β γ δ}
  (e₁ : α ↪ β) (e₂ : γ ↪ δ) (a) : sum_congr e₁ e₂ (inl a) = inl (e₁ a) := rfl

@[simp] theorem sum_congr_apply_inr {α β γ δ}
  (e₁ : α ↪ β) (e₂ : γ ↪ δ) (b) : sum_congr e₁ e₂ (inr b) = inr (e₂ b) := rfl

end sum

section sigma
open sigma

def sigma_congr_right {α : Type*} {β γ : α → Type*} (e : ∀ a, β a ↪ γ a) : sigma β ↪ sigma γ :=
⟨λ ⟨a, b⟩, ⟨a, e a b⟩, λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ h, begin
  injection h with h₁ h₂, subst a₂,
  congr,
  exact (e a₁).2 (eq_of_heq h₂)
end⟩

end sigma

def Pi_congr_right {α : Sort*} {β γ : α → Sort*} (e : ∀ a, β a ↪ γ a) : (Π a, β a) ↪ (Π a, γ a) :=
⟨λf a, e a (f a), λ f₁ f₂ h, funext $ λ a, (e a).inj (congr_fun h a)⟩

def arrow_congr_left {α : Sort u} {β : Sort v} {γ : Sort w}
  (e : α ↪ β) : (γ → α) ↪ (γ → β) :=
Pi_congr_right (λ _, e)

noncomputable def arrow_congr_right {α : Sort u} {β : Sort v} {γ : Sort w} [inhabited γ]
  (e : α ↪ β) : (α → γ) ↪ (β → γ) :=
by haveI := classical.prop_decidable; exact
let f' : (α → γ) → (β → γ) := λf b, if h : ∃c, e c = b then f (classical.some h) else default γ in
⟨f', assume f₁ f₂ h, funext $ assume c,
  have ∃c', e c' = e c, from ⟨c, rfl⟩,
  have eq' : f' f₁ (e c) = f' f₂ (e c), from congr_fun h _,
  have eq_b : classical.some this = c, from e.inj $ classical.some_spec this,
  by simp [f', this, if_pos, eq_b] at eq'; assumption⟩

end embedding
end function

namespace set

/-- The injection map is an embedding between subsets. -/
def embedding_of_subset {α} {s t : set α} (h : s ⊆ t) : s ↪ t :=
⟨λ x, ⟨x.1, h x.2⟩, λ ⟨x, hx⟩ ⟨y, hy⟩ h, by congr; injection h⟩

end set


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fintype.basic
import Mathlib.algebra.big_operators.ring
import Mathlib.PostPort

universes u_1 u_4 u_2 u_3 u_5 u_6

namespace Mathlib

/-!
Results about "big operations" over a `fintype`, and consequent
results about cardinalities of certain types.

## Implementation note
This content had previously been in `data.fintype`, but was moved here to avoid
requiring `algebra.big_operators` (and hence many other imports) as a
dependency of `fintype`.
-/

namespace fintype

theorem prod_bool {α : Type u_1} [comm_monoid α] (f : Bool → α) : (finset.prod finset.univ fun (b : Bool) => f b) = f tt * f false := sorry

theorem card_eq_sum_ones {α : Type u_1} [fintype α] : card α = finset.sum finset.univ fun (a : α) => 1 :=
  finset.card_eq_sum_ones finset.univ

theorem prod_extend_by_one {α : Type u_1} {ι : Type u_4} [DecidableEq ι] [fintype ι] [comm_monoid α] (s : finset ι) (f : ι → α) : (finset.prod finset.univ fun (i : ι) => ite (i ∈ s) (f i) 1) = finset.prod s fun (i : ι) => f i := sorry

theorem sum_eq_zero {α : Type u_1} {M : Type u_4} [fintype α] [add_comm_monoid M] (f : α → M) (h : ∀ (a : α), f a = 0) : (finset.sum finset.univ fun (a : α) => f a) = 0 :=
  finset.sum_eq_zero fun (a : α) (ha : a ∈ finset.univ) => h a

theorem sum_congr {α : Type u_1} {M : Type u_4} [fintype α] [add_comm_monoid M] (f : α → M) (g : α → M) (h : ∀ (a : α), f a = g a) : (finset.sum finset.univ fun (a : α) => f a) = finset.sum finset.univ fun (a : α) => g a :=
  finset.sum_congr rfl fun (a : α) (ha : a ∈ finset.univ) => h a

theorem sum_eq_single {α : Type u_1} {M : Type u_4} [fintype α] [add_comm_monoid M] {f : α → M} (a : α) (h : ∀ (x : α), x ≠ a → f x = 0) : (finset.sum finset.univ fun (x : α) => f x) = f a :=
  finset.sum_eq_single a (fun (x : α) (_x : x ∈ finset.univ) (hx : x ≠ a) => h x hx)
    fun (ha : ¬a ∈ finset.univ) => false.elim (ha (finset.mem_univ a))

theorem sum_unique {β : Type u_2} {M : Type u_4} [add_comm_monoid M] [unique β] (f : β → M) : (finset.sum finset.univ fun (x : β) => f x) = f Inhabited.default := sorry

/-- If a product of a `finset` of a subsingleton type has a given
value, so do the terms in that product. -/
theorem eq_of_subsingleton_of_sum_eq {M : Type u_4} [add_comm_monoid M] {ι : Type u_1} [subsingleton ι] {s : finset ι} {f : ι → M} {b : M} (h : (finset.sum s fun (i : ι) => f i) = b) (i : ι) (H : i ∈ s) : f i = b :=
  finset.eq_of_card_le_one_of_sum_eq (finset.card_le_one_of_subsingleton s) h

end fintype

theorem is_compl.prod_mul_prod {α : Type u_1} {M : Type u_4} [fintype α] [DecidableEq α] [comm_monoid M] {s : finset α} {t : finset α} (h : is_compl s t) (f : α → M) : ((finset.prod s fun (i : α) => f i) * finset.prod t fun (i : α) => f i) = finset.prod finset.univ fun (i : α) => f i := sorry

theorem finset.prod_mul_prod_compl {α : Type u_1} {M : Type u_4} [fintype α] [DecidableEq α] [comm_monoid M] (s : finset α) (f : α → M) : ((finset.prod s fun (i : α) => f i) * finset.prod (sᶜ) fun (i : α) => f i) = finset.prod finset.univ fun (i : α) => f i :=
  is_compl.prod_mul_prod is_compl_compl f

theorem finset.sum_compl_add_sum {α : Type u_1} {M : Type u_4} [fintype α] [DecidableEq α] [add_comm_monoid M] (s : finset α) (f : α → M) : ((finset.sum (sᶜ) fun (i : α) => f i) + finset.sum s fun (i : α) => f i) = finset.sum finset.univ fun (i : α) => f i :=
  is_compl.sum_add_sum (is_compl.symm is_compl_compl) f

theorem fin.prod_univ_def {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin n → β) : (finset.prod finset.univ fun (i : fin n) => f i) = list.prod (list.map f (list.fin_range n)) := sorry

theorem fin.sum_of_fn {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin n → β) : list.sum (list.of_fn f) = finset.sum finset.univ fun (i : fin n) => f i := sorry

/-- A product of a function `f : fin 0 → β` is `1` because `fin 0` is empty -/
@[simp] theorem fin.prod_univ_zero {β : Type u_2} [comm_monoid β] (f : fin 0 → β) : (finset.prod finset.univ fun (i : fin 0) => f i) = 1 :=
  rfl

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f x`, for some `x : fin (n + 1)` times the remaining product -/
theorem fin.prod_univ_succ_above {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) (x : fin (n + 1)) : (finset.prod finset.univ fun (i : fin (n + 1)) => f i) =
  f x * finset.prod finset.univ fun (i : fin n) => f (coe_fn (fin.succ_above x) i) := sorry

/-- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f x`, for some `x : fin (n + 1)` plus the remaining product -/
theorem fin.sum_univ_succ_above {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) (x : fin (n + 1)) : (finset.sum finset.univ fun (i : fin (n + 1)) => f i) =
  f x + finset.sum finset.univ fun (i : fin n) => f (coe_fn (fin.succ_above x) i) :=
  fin.prod_univ_succ_above (fun (i : fin (n + 1)) => f i) x

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f 0` plus the remaining product -/
theorem fin.prod_univ_succ {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) : (finset.prod finset.univ fun (i : fin (n + 1)) => f i) = f 0 * finset.prod finset.univ fun (i : fin n) => f (fin.succ i) :=
  fin.prod_univ_succ_above f 0

/-- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f 0` plus the remaining product -/
theorem fin.sum_univ_succ {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) : (finset.sum finset.univ fun (i : fin (n + 1)) => f i) = f 0 + finset.sum finset.univ fun (i : fin n) => f (fin.succ i) :=
  fin.sum_univ_succ_above f 0

/-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the product of `f (fin.last n)` plus the remaining product -/
theorem fin.prod_univ_cast_succ {β : Type u_2} [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) : (finset.prod finset.univ fun (i : fin (n + 1)) => f i) =
  (finset.prod finset.univ fun (i : fin n) => f (coe_fn fin.cast_succ i)) * f (fin.last n) := sorry

/-- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)`
is the sum of `f (fin.last n)` plus the remaining sum -/
theorem fin.sum_univ_cast_succ {β : Type u_2} [add_comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) : (finset.sum finset.univ fun (i : fin (n + 1)) => f i) =
  (finset.sum finset.univ fun (i : fin n) => f (coe_fn fin.cast_succ i)) + f (fin.last n) :=
  fin.prod_univ_cast_succ fun (i : fin (n + 1)) => f i

@[simp] theorem fintype.card_sigma {α : Type u_1} (β : α → Type u_2) [fintype α] [(a : α) → fintype (β a)] : fintype.card (sigma β) = finset.sum finset.univ fun (a : α) => fintype.card (β a) :=
  finset.card_sigma finset.univ fun (a : α) => (fun (_x : α) => finset.univ) a

-- FIXME ouch, this should be in the main file.

@[simp] theorem fintype.card_sum (α : Type u_1) (β : Type u_2) [fintype α] [fintype β] : fintype.card (α ⊕ β) = fintype.card α + fintype.card β := sorry

@[simp] theorem finset.card_pi {α : Type u_1} [DecidableEq α] {δ : α → Type u_2} (s : finset α) (t : (a : α) → finset (δ a)) : finset.card (finset.pi s t) = finset.prod s fun (a : α) => finset.card (t a) :=
  multiset.card_pi (finset.val s) fun (a : α) => (fun (a : α) => finset.val (t a)) a

@[simp] theorem fintype.card_pi_finset {α : Type u_1} [DecidableEq α] [fintype α] {δ : α → Type u_2} (t : (a : α) → finset (δ a)) : finset.card (fintype.pi_finset t) = finset.prod finset.univ fun (a : α) => finset.card (t a) := sorry

@[simp] theorem fintype.card_pi {α : Type u_1} {β : α → Type u_2} [DecidableEq α] [fintype α] [f : (a : α) → fintype (β a)] : fintype.card ((a : α) → β a) = finset.prod finset.univ fun (a : α) => fintype.card (β a) :=
  fintype.card_pi_finset fun (_x : α) => finset.univ

-- FIXME ouch, this should be in the main file.

@[simp] theorem fintype.card_fun {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype α] [fintype β] : fintype.card (α → β) = fintype.card β ^ fintype.card α := sorry

@[simp] theorem card_vector {α : Type u_1} [fintype α] (n : ℕ) : fintype.card (vector α n) = fintype.card α ^ n := sorry

@[simp] theorem finset.prod_attach_univ {α : Type u_1} {β : Type u_2} [fintype α] [comm_monoid β] (f : (Subtype fun (a : α) => a ∈ finset.univ) → β) : (finset.prod (finset.attach finset.univ) fun (x : Subtype fun (a : α) => a ∈ finset.univ) => f x) =
  finset.prod finset.univ fun (x : α) => f { val := x, property := finset.mem_univ x } := sorry

/-- Taking a product over `univ.pi t` is the same as taking the product over `fintype.pi_finset t`.
  `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`, but differ
  in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and
  `fintype.pi_finset t` is a `finset (Π a, t a)`. -/
theorem finset.prod_univ_pi {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype α] [comm_monoid β] {δ : α → Type u_3} {t : (a : α) → finset (δ a)} (f : ((a : α) → a ∈ finset.univ → δ a) → β) : (finset.prod (finset.pi finset.univ t) fun (x : (a : α) → a ∈ finset.univ → δ a) => f x) =
  finset.prod (fintype.pi_finset t) fun (x : (a : α) → δ a) => f fun (a : α) (_x : a ∈ finset.univ) => x a := sorry

/-- The product over `univ` of a sum can be written as a sum over the product of sets,
  `fintype.pi_finset`. `finset.prod_sum` is an alternative statement when the product is not
  over `univ` -/
theorem finset.prod_univ_sum {α : Type u_1} {β : Type u_2} [DecidableEq α] [fintype α] [comm_semiring β] {δ : α → Type u_1} [(a : α) → DecidableEq (δ a)] {t : (a : α) → finset (δ a)} {f : (a : α) → δ a → β} : (finset.prod finset.univ fun (a : α) => finset.sum (t a) fun (b : δ a) => f a b) =
  finset.sum (fintype.pi_finset t) fun (p : (a : α) → δ a) => finset.prod finset.univ fun (x : α) => f x (p x) := sorry

/-- Summing `a^s.card * b^(n-s.card)` over all finite subsets `s` of a fintype of cardinality `n`
gives `(a + b)^n`. The "good" proof involves expanding along all coordinates using the fact that
`x^n` is multilinear, but multilinear maps are only available now over rings, so we give instead
a proof reducing to the usual binomial theorem to have a result over semirings. -/
theorem fintype.sum_pow_mul_eq_add_pow (α : Type u_1) [fintype α] {R : Type u_2} [comm_semiring R] (a : R) (b : R) : (finset.sum finset.univ fun (s : finset α) => a ^ finset.card s * b ^ (fintype.card α - finset.card s)) =
  (a + b) ^ fintype.card α :=
  finset.sum_pow_mul_eq_add_pow a b finset.univ

theorem fin.sum_pow_mul_eq_add_pow {n : ℕ} {R : Type u_1} [comm_semiring R] (a : R) (b : R) : (finset.sum finset.univ fun (s : finset (fin n)) => a ^ finset.card s * b ^ (n - finset.card s)) = (a + b) ^ n := sorry

theorem function.bijective.sum_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [fintype α] [fintype β] [add_comm_monoid γ] {f : α → β} (hf : function.bijective f) (g : β → γ) : (finset.sum finset.univ fun (i : α) => g (f i)) = finset.sum finset.univ fun (i : β) => g i := sorry

theorem equiv.sum_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} [fintype α] [fintype β] [add_comm_monoid γ] (e : α ≃ β) (f : β → γ) : (finset.sum finset.univ fun (i : α) => f (coe_fn e i)) = finset.sum finset.univ fun (i : β) => f i :=
  function.bijective.sum_comp (equiv.bijective e) f

/-- It is equivalent to sum a function over `fin n` or `finset.range n`. -/
theorem fin.sum_univ_eq_sum_range {α : Type u_1} [add_comm_monoid α] (f : ℕ → α) (n : ℕ) : (finset.sum finset.univ fun (i : fin n) => f ↑i) = finset.sum (finset.range n) fun (i : ℕ) => f i := sorry

theorem finset.prod_fin_eq_prod_range {β : Type u_2} [comm_monoid β] {n : ℕ} (c : fin n → β) : (finset.prod finset.univ fun (i : fin n) => c i) =
  finset.prod (finset.range n)
    fun (i : ℕ) => dite (i < n) (fun (h : i < n) => c { val := i, property := h }) fun (h : ¬i < n) => 1 := sorry

theorem finset.prod_subtype {α : Type u_1} {M : Type u_2} [comm_monoid M] {p : α → Prop} {F : fintype (Subtype p)} (s : finset α) (h : ∀ (x : α), x ∈ s ↔ p x) (f : α → M) : (finset.prod s fun (a : α) => f a) = finset.prod finset.univ fun (a : Subtype p) => f ↑a := sorry

theorem finset.sum_to_finset_eq_subtype {α : Type u_1} {M : Type u_2} [add_comm_monoid M] [fintype α] (p : α → Prop) [decidable_pred p] (f : α → M) : (finset.sum (set.to_finset (set_of fun (x : α) => p x)) fun (a : α) => f a) =
  finset.sum finset.univ fun (a : Subtype p) => f ↑a := sorry

theorem finset.prod_fiberwise {α : Type u_1} {β : Type u_2} {γ : Type u_3} [DecidableEq β] [fintype β] [comm_monoid γ] (s : finset α) (f : α → β) (g : α → γ) : (finset.prod finset.univ fun (b : β) => finset.prod (finset.filter (fun (a : α) => f a = b) s) fun (a : α) => g a) =
  finset.prod s fun (a : α) => g a :=
  finset.prod_fiberwise_of_maps_to (fun (x : α) (_x : x ∈ s) => finset.mem_univ (f x)) fun (a : α) => g a

theorem fintype.prod_fiberwise {α : Type u_1} {β : Type u_2} {γ : Type u_3} [fintype α] [DecidableEq β] [fintype β] [comm_monoid γ] (f : α → β) (g : α → γ) : (finset.prod finset.univ fun (b : β) => finset.prod finset.univ fun (a : Subtype fun (a : α) => f a = b) => g ↑a) =
  finset.prod finset.univ fun (a : α) => g a := sorry

theorem fintype.prod_dite {α : Type u_1} {β : Type u_2} [fintype α] {p : α → Prop} [decidable_pred p] [comm_monoid β] (f : (a : α) → p a → β) (g : (a : α) → ¬p a → β) : (finset.prod finset.univ fun (a : α) => dite (p a) (f a) (g a)) =
  (finset.prod finset.univ fun (a : Subtype fun (a : α) => p a) => f (↑a) (subtype.property a)) *
    finset.prod finset.univ fun (a : Subtype fun (a : α) => ¬p a) => g (↑a) (subtype.property a) := sorry

theorem fintype.sum_sum_elim {α₁ : Type u_4} {α₂ : Type u_5} {M : Type u_6} [fintype α₁] [fintype α₂] [add_comm_monoid M] (f : α₁ → M) (g : α₂ → M) : (finset.sum finset.univ fun (x : α₁ ⊕ α₂) => sum.elim f g x) =
  (finset.sum finset.univ fun (a₁ : α₁) => f a₁) + finset.sum finset.univ fun (a₂ : α₂) => g a₂ := sorry

theorem fintype.prod_sum_type {α₁ : Type u_4} {α₂ : Type u_5} {M : Type u_6} [fintype α₁] [fintype α₂] [comm_monoid M] (f : α₁ ⊕ α₂ → M) : (finset.prod finset.univ fun (x : α₁ ⊕ α₂) => f x) =
  (finset.prod finset.univ fun (a₁ : α₁) => f (sum.inl a₁)) * finset.prod finset.univ fun (a₂ : α₂) => f (sum.inr a₂) := sorry

namespace list

theorem prod_take_of_fn {α : Type u_1} [comm_monoid α] {n : ℕ} (f : fin n → α) (i : ℕ) : prod (take i (of_fn f)) =
  finset.prod (finset.filter (fun (j : fin n) => subtype.val j < i) finset.univ) fun (j : fin n) => f j := sorry

-- `to_additive` does not work on `prod_take_of_fn` because of `0 : ℕ` in the proof.

-- Use `multiplicative` instead.

theorem sum_take_of_fn {α : Type u_1} [add_comm_monoid α] {n : ℕ} (f : fin n → α) (i : ℕ) : sum (take i (of_fn f)) =
  finset.sum (finset.filter (fun (j : fin n) => subtype.val j < i) finset.univ) fun (j : fin n) => f j :=
  prod_take_of_fn f i

theorem prod_of_fn {α : Type u_1} [comm_monoid α] {n : ℕ} {f : fin n → α} : prod (of_fn f) = finset.prod finset.univ fun (i : fin n) => f i := sorry

theorem alternating_sum_eq_finset_sum {G : Type u_1} [add_comm_group G] (L : List G) : alternating_sum L = finset.sum finset.univ fun (i : fin (length L)) => (-1) ^ ↑i •ℤ nth_le L (↑i) (fin.is_lt i) := sorry

theorem alternating_prod_eq_finset_prod {G : Type u_1} [comm_group G] (L : List G) : alternating_prod L = finset.prod finset.univ fun (i : fin (length L)) => nth_le L (↑i) (subtype.property i) ^ (-1) ^ ↑i := sorry