/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Devon Tuma
-/

import group_theory.submonoid.operations
import group_theory.submonoid.membership

/-!
# Non-zero divisors

In this file we define the submonoid `non_zero_divisors` of a `monoid_with_zero`.

## Notations

This file declares the notation `R⁰` for the submonoid of non-zero-divisors of `R`,
in the locale `non_zero_divisors`. Use the statement `open_locale non_zero_divisors`
to access this notation in your own code.

-/

section non_zero_divisors

/-- The submonoid of non-zero-divisors of a `monoid_with_zero` `R`. -/
def non_zero_divisors (R : Type*) [monoid_with_zero R] : submonoid R :=
{ carrier := {x | ∀ z, z * x = 0 → z = 0},
  one_mem' := λ z hz, by rwa mul_one at hz,
  mul_mem' := λ x₁ x₂ hx₁ hx₂ z hz,
    have z * x₁ * x₂ = 0, by rwa mul_assoc,
    hx₁ z $ hx₂ (z * x₁) this }

localized "notation R`⁰`:9000 := non_zero_divisors R" in non_zero_divisors

variables {M M' M₁ R R' F : Type*} [monoid_with_zero M] [monoid_with_zero M']
  [comm_monoid_with_zero M₁] [ring R] [comm_ring R']

lemma mem_non_zero_divisors_iff {r : M} : r ∈ M⁰ ↔ ∀ x, x * r = 0 → x = 0 := iff.rfl

lemma mul_right_mem_non_zero_divisors_eq_zero_iff {x r : M} (hr : r ∈ M⁰) :
  x * r = 0 ↔ x = 0 :=
⟨hr _, by simp {contextual := tt}⟩

@[simp] lemma mul_right_coe_non_zero_divisors_eq_zero_iff {x : M} {c : M⁰} :
  x * c = 0 ↔ x = 0 :=
mul_right_mem_non_zero_divisors_eq_zero_iff c.prop

lemma mul_left_mem_non_zero_divisors_eq_zero_iff {r x : M₁} (hr : r ∈ M₁⁰) :
  r * x = 0 ↔ x = 0 :=
by rw [mul_comm, mul_right_mem_non_zero_divisors_eq_zero_iff hr]

@[simp] lemma mul_left_coe_non_zero_divisors_eq_zero_iff {c : M₁⁰} {x : M₁} :
  (c : M₁) * x = 0 ↔ x = 0 :=
mul_left_mem_non_zero_divisors_eq_zero_iff c.prop

lemma mul_cancel_right_mem_non_zero_divisor {x y r : R} (hr : r ∈ R⁰) :
  x * r = y * r ↔ x = y :=
begin
  refine ⟨λ h, _, congr_arg _⟩,
  rw [←sub_eq_zero, ←mul_right_mem_non_zero_divisors_eq_zero_iff hr, sub_mul, h, sub_self]
end

lemma mul_cancel_right_coe_non_zero_divisor {x y : R} {c : R⁰} :
  x * c = y * c ↔ x = y :=
mul_cancel_right_mem_non_zero_divisor c.prop

@[simp] lemma mul_cancel_left_mem_non_zero_divisor {x y r : R'} (hr : r ∈ R'⁰) :
  r * x = r * y ↔ x = y :=
by simp_rw [mul_comm r, mul_cancel_right_mem_non_zero_divisor hr]

lemma mul_cancel_left_coe_non_zero_divisor {x y : R'} {c : R'⁰} :
  (c : R') * x = c * y ↔ x = y :=
mul_cancel_left_mem_non_zero_divisor c.prop

lemma non_zero_divisors.ne_zero [nontrivial M] {x} (hx : x ∈ M⁰) : x ≠ 0 :=
λ h, one_ne_zero (hx _ $ (one_mul _).trans h)

lemma non_zero_divisors.coe_ne_zero [nontrivial M] (x : M⁰) : (x : M) ≠ 0 :=
non_zero_divisors.ne_zero x.2

lemma mul_mem_non_zero_divisors {a b : M₁} :
  a * b ∈ M₁⁰ ↔ a ∈ M₁⁰ ∧ b ∈ M₁⁰ :=
begin
  split,
  { intro h,
    split; intros x h'; apply h,
    { rw [←mul_assoc, h', zero_mul] },
    { rw [mul_comm a b, ←mul_assoc, h', zero_mul] } },
  { rintros ⟨ha, hb⟩ x hx,
    apply ha,
    apply hb,
    rw [mul_assoc, hx] },
end

lemma is_unit_of_mem_non_zero_divisors {G₀ : Type*} [group_with_zero G₀]
  {x : G₀} (hx : x ∈ non_zero_divisors G₀) : is_unit x :=
⟨⟨x, x⁻¹, mul_inv_cancel (non_zero_divisors.ne_zero hx),
  inv_mul_cancel (non_zero_divisors.ne_zero hx)⟩, rfl⟩

lemma eq_zero_of_ne_zero_of_mul_right_eq_zero [no_zero_divisors M]
  {x y : M} (hnx : x ≠ 0) (hxy : y * x = 0) : y = 0 :=
or.resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero hxy) hnx

lemma eq_zero_of_ne_zero_of_mul_left_eq_zero [no_zero_divisors M]
  {x y : M} (hnx : x ≠ 0) (hxy : x * y = 0) : y = 0 :=
or.resolve_left (eq_zero_or_eq_zero_of_mul_eq_zero hxy) hnx

lemma mem_non_zero_divisors_of_ne_zero [no_zero_divisors M] {x : M} (hx : x ≠ 0) : x ∈ M⁰ :=
λ _, eq_zero_of_ne_zero_of_mul_right_eq_zero hx

lemma mem_non_zero_divisors_iff_ne_zero [no_zero_divisors M] [nontrivial M] {x : M} :
  x ∈ M⁰ ↔ x ≠ 0 :=
⟨non_zero_divisors.ne_zero, mem_non_zero_divisors_of_ne_zero⟩

lemma map_ne_zero_of_mem_non_zero_divisors [nontrivial M] [zero_hom_class F M M']
  (g : F) (hg : function.injective (g : M → M')) {x : M} (h : x ∈ M⁰) : g x ≠ 0 :=
λ h0, one_ne_zero (h 1 ((one_mul x).symm ▸ (hg (trans h0 (map_zero g).symm))))

lemma map_mem_non_zero_divisors [nontrivial M] [no_zero_divisors M'] [zero_hom_class F M M']
  (g : F) (hg : function.injective g) {x : M} (h : x ∈ M⁰) : g x ∈ M'⁰ :=
λ z hz, eq_zero_of_ne_zero_of_mul_right_eq_zero
  (map_ne_zero_of_mem_non_zero_divisors g hg h) hz

lemma le_non_zero_divisors_of_no_zero_divisors [no_zero_divisors M] {S : submonoid M}
  (hS : (0 : M) ∉ S) : S ≤ M⁰ :=
λ x hx y hy, or.rec_on (eq_zero_or_eq_zero_of_mul_eq_zero hy)
  (λ h, h) (λ h, absurd (h ▸ hx : (0 : M) ∈ S) hS)

lemma powers_le_non_zero_divisors_of_no_zero_divisors [no_zero_divisors M]
  {a : M} (ha : a ≠ 0) : submonoid.powers a ≤ M⁰ :=
le_non_zero_divisors_of_no_zero_divisors (λ h, absurd (h.rec_on (λ _ hn, pow_eq_zero hn)) ha)

lemma map_le_non_zero_divisors_of_injective [no_zero_divisors M']
  [monoid_with_zero_hom_class F M M'] (f : F) (hf : function.injective f) {S : submonoid M}
  (hS : S ≤ M⁰) : S.map ↑f ≤ M'⁰ :=
begin
  casesI subsingleton_or_nontrivial M,
  { simp [subsingleton.elim S ⊥] },
  { exact le_non_zero_divisors_of_no_zero_divisors (λ h, let ⟨x, hx, hx0⟩ := h in
      zero_ne_one (hS (hf (trans hx0 ((map_zero f).symm)) ▸ hx : 0 ∈ S) 1 (mul_zero 1)).symm) }
end

lemma non_zero_divisors_le_comap_non_zero_divisors_of_injective [no_zero_divisors M']
  [monoid_with_zero_hom_class F M M'] (f : F) (hf : function.injective f) : M⁰ ≤ M'⁰.comap f :=
submonoid.le_comap_of_map_le _ (map_le_non_zero_divisors_of_injective _ hf le_rfl)

lemma prod_zero_iff_exists_zero [no_zero_divisors M₁] [nontrivial M₁]
  {s : multiset M₁} : s.prod = 0 ↔ ∃ (r : M₁) (hr : r ∈ s), r = 0 :=
begin
  split, swap,
  { rintros ⟨r, hrs, rfl⟩,
    exact multiset.prod_eq_zero hrs, },
  refine multiset.induction _ (λ a s ih, _) s,
  { intro habs,
    simpa using habs, },
  { rw multiset.prod_cons,
    intro hprod,
    replace hprod := eq_zero_or_eq_zero_of_mul_eq_zero hprod,
    cases hprod with ha,
    { exact ⟨a, multiset.mem_cons_self a s, ha⟩ },
    { apply (ih hprod).imp _,
      rintros b ⟨hb₁, hb₂⟩,
      exact ⟨multiset.mem_cons_of_mem hb₁, hb₂⟩, }, },
end

end non_zero_divisors


/-
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.limits.is_limit

/-!
# Existence of limits and colimits

In `category_theory.limits.is_limit` we defined `is_limit c`,
the data showing that a cone `c` is a limit cone.

The two main structures defined in this file are:
* `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`.

`has_limit` is a propositional typeclass
(it's important that it is a proposition merely asserting the existence of a limit,
as otherwise we would have non-defeq problems from incompatible instances).

While `has_limit` only asserts the existence of a limit cone,
we happily use the axiom of choice in mathlib,
so there are convenience functions all depending on `has_limit F`:
* `limit F : C`, producing some limit object (of course all such are isomorphic)
* `limit.π F j : limit F ⟶ F.obj j`, the morphisms out of the limit,
* `limit.lift F c : c.X ⟶ limit F`, the universal morphism from any other `c : cone F`, etc.

Key to using the `has_limit` interface is that there is an `@[ext]` lemma stating that
to check `f = g`, for `f g : Z ⟶ limit F`, it suffices to check `f ≫ limit.π F j = g ≫ limit.π F j`
for every `j`.
This, combined with `@[simp]` lemmas, makes it possible to prove many easy facts about limits using
automation (e.g. `tidy`).

There are abbreviations `has_limits_of_shape J C` and `has_limits C`
asserting the existence of classes of limits.
Later more are introduced, for finite limits, special shapes of limits, etc.

Ideally, many results about limits should be stated first in terms of `is_limit`,
and then a result in terms of `has_limit` derived from this.
At this point, however, this is far from uniformly achieved in mathlib ---
often statements are only written in terms of `has_limit`.

## 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

-- morphism levels before object levels. See note [category_theory universes].
universes v u u' u'' w

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

variables {F : J ⥤ C}

section limit

/-- `limit_cone F` contains a cone over `F` together with the information that it is a limit. -/
@[nolint has_inhabited_instance]
structure limit_cone (F : J ⥤ C) :=
(cone : cone F)
(is_limit : is_limit cone)

/-- `has_limit F` represents the mere existence of a limit for `F`. -/
class has_limit (F : J ⥤ C) : Prop :=
mk' :: (exists_limit : nonempty (limit_cone F))

lemma has_limit.mk {F : J ⥤ C} (d : limit_cone F) : has_limit F :=
⟨nonempty.intro d⟩

/-- Use the axiom of choice to extract explicit `limit_cone F` from `has_limit F`. -/
def get_limit_cone (F : J ⥤ C) [has_limit F] : limit_cone F :=
classical.choice $ has_limit.exists_limit

variables (J C)

/-- `C` has limits of shape `J` if there exists a limit for every functor `F : J ⥤ C`. -/
class has_limits_of_shape : Prop :=
(has_limit : Π F : J ⥤ C, has_limit F . tactic.apply_instance)

/-- `C` has all (small) limits if it has limits of every shape. -/
class has_limits : Prop :=
(has_limits_of_shape :
  Π (J : Type v) [𝒥 : small_category J], has_limits_of_shape J C . tactic.apply_instance)

variables {J C}

@[priority 100] -- see Note [lower instance priority]
instance has_limit_of_has_limits_of_shape
  {J : Type v} [small_category J] [H : has_limits_of_shape J C] (F : J ⥤ C) : has_limit F :=
has_limits_of_shape.has_limit F

@[priority 100] -- see Note [lower instance priority]
instance has_limits_of_shape_of_has_limits
  {J : Type v} [small_category J] [H : has_limits C] : has_limits_of_shape J C :=
has_limits.has_limits_of_shape J

/- Interface to the `has_limit` class. -/

/-- An arbitrary choice of limit cone for a functor. -/
def limit.cone (F : J ⥤ C) [has_limit F] : cone F := (get_limit_cone F).cone

/-- An arbitrary choice of limit object of a functor. -/
def limit (F : J ⥤ C) [has_limit F] := (limit.cone F).X

/-- The projection from the limit object to a value of the functor. -/
def limit.π (F : J ⥤ C) [has_limit F] (j : J) : limit F ⟶ F.obj j :=
(limit.cone F).π.app j

@[simp] lemma limit.cone_X {F : J ⥤ C} [has_limit F] :
  (limit.cone F).X = limit F := rfl

@[simp] lemma limit.cone_π {F : J ⥤ C} [has_limit F] :
  (limit.cone F).π.app = limit.π _ := rfl

@[simp, reassoc] lemma limit.w (F : J ⥤ C) [has_limit F] {j j' : J} (f : j ⟶ j') :
  limit.π F j ≫ F.map f = limit.π F j' := (limit.cone F).w f

/-- Evidence that the arbitrary choice of cone provied by `limit.cone F` is a limit cone. -/
def limit.is_limit (F : J ⥤ C) [has_limit F] : is_limit (limit.cone F) :=
(get_limit_cone F).is_limit

/-- The morphism from the cone point of any other cone to the limit object. -/
def limit.lift (F : J ⥤ C) [has_limit F] (c : cone F) : c.X ⟶ limit F :=
(limit.is_limit F).lift c

@[simp] lemma limit.is_limit_lift {F : J ⥤ C} [has_limit F] (c : cone F) :
  (limit.is_limit F).lift c = limit.lift F c := rfl

@[simp, reassoc] lemma limit.lift_π {F : J ⥤ C} [has_limit F] (c : cone F) (j : J) :
  limit.lift F c ≫ limit.π F j = c.π.app j :=
is_limit.fac _ c j

/--
Functoriality of limits.

Usually this morphism should be accessed through `lim.map`,
but may be needed separately when you have specified limits for the source and target functors,
but not necessarily for all functors of shape `J`.
-/
def lim_map {F G : J ⥤ C} [has_limit F] [has_limit G] (α : F ⟶ G) : limit F ⟶ limit G :=
is_limit.map _ (limit.is_limit G) α

@[simp, reassoc] lemma lim_map_π {F G : J ⥤ C} [has_limit F] [has_limit G] (α : F ⟶ G) (j : J) :
  lim_map α ≫ limit.π G j = limit.π F j ≫ α.app j :=
limit.lift_π _ j

/-- The cone morphism from any cone to the arbitrary choice of limit cone. -/
def limit.cone_morphism {F : J ⥤ C} [has_limit F] (c : cone F) :
  c ⟶ limit.cone F :=
(limit.is_limit F).lift_cone_morphism c

@[simp] lemma limit.cone_morphism_hom {F : J ⥤ C} [has_limit F] (c : cone F) :
  (limit.cone_morphism c).hom = limit.lift F c := rfl
lemma limit.cone_morphism_π {F : J ⥤ C} [has_limit F] (c : cone F) (j : J) :
  (limit.cone_morphism c).hom ≫ limit.π F j = c.π.app j :=
by simp

@[simp, reassoc] lemma limit.cone_point_unique_up_to_iso_hom_comp {F : J ⥤ C} [has_limit F]
  {c : cone F} (hc : is_limit c) (j : J) :
  (is_limit.cone_point_unique_up_to_iso hc (limit.is_limit _)).hom ≫ limit.π F j = c.π.app j :=
is_limit.cone_point_unique_up_to_iso_hom_comp _ _ _

@[simp, reassoc] lemma limit.cone_point_unique_up_to_iso_inv_comp {F : J ⥤ C} [has_limit F]
  {c : cone F} (hc : is_limit c) (j : J) :
  (is_limit.cone_point_unique_up_to_iso (limit.is_limit _) hc).inv ≫ limit.π F j = c.π.app j :=
is_limit.cone_point_unique_up_to_iso_inv_comp _ _ _

/--
Given any other limit cone for `F`, the chosen `limit F` is isomorphic to the cone point.
-/
def limit.iso_limit_cone {F : J ⥤ C} [has_limit F] (t : limit_cone F) :
  limit F ≅ t.cone.X :=
is_limit.cone_point_unique_up_to_iso (limit.is_limit F) t.is_limit

@[simp, reassoc] lemma limit.iso_limit_cone_hom_π
  {F : J ⥤ C} [has_limit F] (t : limit_cone F) (j : J) :
  (limit.iso_limit_cone t).hom ≫ t.cone.π.app j = limit.π F j :=
by { dsimp [limit.iso_limit_cone, is_limit.cone_point_unique_up_to_iso], tidy, }

@[simp, reassoc] lemma limit.iso_limit_cone_inv_π
  {F : J ⥤ C} [has_limit F] (t : limit_cone F) (j : J) :
  (limit.iso_limit_cone t).inv ≫ limit.π F j = t.cone.π.app j :=
by { dsimp [limit.iso_limit_cone, is_limit.cone_point_unique_up_to_iso], tidy, }

@[ext] lemma limit.hom_ext {F : J ⥤ C} [has_limit F] {X : C} {f f' : X ⟶ limit F}
  (w : ∀ j, f ≫ limit.π F j = f' ≫ limit.π F j) : f = f' :=
(limit.is_limit F).hom_ext w

@[simp] lemma limit.lift_map {F G : J ⥤ C} [has_limit F] [has_limit G] (c : cone F) (α : F ⟶ G) :
  limit.lift F c ≫ lim_map α = limit.lift G ((cones.postcompose α).obj c) :=
by { ext, rw [assoc, lim_map_π, limit.lift_π_assoc, limit.lift_π], refl }

@[simp] lemma limit.lift_cone {F : J ⥤ C} [has_limit F] :
  limit.lift F (limit.cone F) = 𝟙 (limit F) :=
(limit.is_limit _).lift_self

/--
The isomorphism (in `Type`) between
morphisms from a specified object `W` to the limit object,
and cones with cone point `W`.
-/
def limit.hom_iso (F : J ⥤ C) [has_limit F] (W : C) : (W ⟶ limit F) ≅ (F.cones.obj (op W)) :=
(limit.is_limit F).hom_iso W

@[simp] lemma limit.hom_iso_hom (F : J ⥤ C) [has_limit F] {W : C} (f : W ⟶ limit F) :
  (limit.hom_iso F W).hom f = (const J).map f ≫ (limit.cone F).π :=
(limit.is_limit F).hom_iso_hom f

/--
The isomorphism (in `Type`) between
morphisms from a specified object `W` to the limit object,
and an explicit componentwise description of cones with cone point `W`.
-/
def limit.hom_iso' (F : J ⥤ C) [has_limit F] (W : C) :
  ((W ⟶ limit F) : Type v) ≅
    { p : Π j, W ⟶ F.obj j // ∀ {j j' : J} (f : j ⟶ j'), p j ≫ F.map f = p j' } :=
(limit.is_limit F).hom_iso' W

lemma limit.lift_extend {F : J ⥤ C} [has_limit F] (c : cone F) {X : C} (f : X ⟶ c.X) :
  limit.lift F (c.extend f) = f ≫ limit.lift F c :=
by obviously

/--
If a functor `F` has a limit, so does any naturally isomorphic functor.
-/
lemma has_limit_of_iso {F G : J ⥤ C} [has_limit F] (α : F ≅ G) : has_limit G :=
has_limit.mk
{ cone := (cones.postcompose α.hom).obj (limit.cone F),
  is_limit :=
  { lift := λ s, limit.lift F ((cones.postcompose α.inv).obj s),
    fac' := λ s j,
    begin
      rw [cones.postcompose_obj_π, nat_trans.comp_app, limit.cone_π, ←category.assoc, limit.lift_π],
      simp
    end,
    uniq' := λ s m w,
    begin
      apply limit.hom_ext, intro j,
      rw [limit.lift_π, cones.postcompose_obj_π, nat_trans.comp_app, ←nat_iso.app_inv,
        iso.eq_comp_inv],
      simpa using w j
    end } }

/-- If a functor `G` has the same collection of cones as a functor `F`
which has a limit, then `G` also has a limit. -/
-- See the construction of limits from products and equalizers
-- for an example usage.
lemma has_limit.of_cones_iso {J K : Type v} [small_category J] [small_category K] (F : J ⥤ C)
  (G : K ⥤ C) (h : F.cones ≅ G.cones) [has_limit F] : has_limit G :=
has_limit.mk ⟨_, is_limit.of_nat_iso ((is_limit.nat_iso (limit.is_limit F)) ≪≫ h)⟩

/--
The limits of `F : J ⥤ C` and `G : J ⥤ C` are isomorphic,
if the functors are naturally isomorphic.
-/
def has_limit.iso_of_nat_iso {F G : J ⥤ C} [has_limit F] [has_limit G] (w : F ≅ G) :
  limit F ≅ limit G :=
is_limit.cone_points_iso_of_nat_iso (limit.is_limit F) (limit.is_limit G) w

@[simp, reassoc]

@[simp, reassoc]
lemma has_limit.lift_iso_of_nat_iso_hom {F G : J ⥤ C} [has_limit F] [has_limit G] (t : cone F)
  (w : F ≅ G) :
  limit.lift F t ≫ (has_limit.iso_of_nat_iso w).hom =
    limit.lift G ((cones.postcompose w.hom).obj _) :=
is_limit.lift_comp_cone_points_iso_of_nat_iso_hom _ _ _

/--
The limits of `F : J ⥤ C` and `G : K ⥤ C` are isomorphic,
if there is an equivalence `e : J ≌ K` making the triangle commute up to natural isomorphism.
-/
def has_limit.iso_of_equivalence {F : J ⥤ C} [has_limit F] {G : K ⥤ C} [has_limit G]
   (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : limit F ≅ limit G :=
is_limit.cone_points_iso_of_equivalence (limit.is_limit F) (limit.is_limit G) e w

@[simp]
lemma has_limit.iso_of_equivalence_hom_π {F : J ⥤ C} [has_limit F] {G : K ⥤ C} [has_limit G]
   (e : J ≌ K) (w : e.functor ⋙ G ≅ F) (k : K) :
  (has_limit.iso_of_equivalence e w).hom ≫ limit.π G k =
    limit.π F (e.inverse.obj k) ≫ w.inv.app (e.inverse.obj k) ≫ G.map (e.counit.app k) :=
begin
  simp only [has_limit.iso_of_equivalence, is_limit.cone_points_iso_of_equivalence_hom],
  dsimp,
  simp,
end

@[simp]
lemma has_limit.iso_of_equivalence_inv_π {F : J ⥤ C} [has_limit F] {G : K ⥤ C} [has_limit G]
   (e : J ≌ K) (w : e.functor ⋙ G ≅ F) (j : J) :
  (has_limit.iso_of_equivalence e w).inv ≫ limit.π F j =
    limit.π G (e.functor.obj j) ≫ w.hom.app j :=
begin
  simp only [has_limit.iso_of_equivalence, is_limit.cone_points_iso_of_equivalence_hom],
  dsimp,
  simp,
end

section pre
variables (F) [has_limit F] (E : K ⥤ J) [has_limit (E ⋙ F)]

/--
The canonical morphism from the limit of `F` to the limit of `E ⋙ F`.
-/
def limit.pre : limit F ⟶ limit (E ⋙ F) :=
limit.lift (E ⋙ F) ((limit.cone F).whisker E)

@[simp, reassoc] lemma limit.pre_π (k : K) :
  limit.pre F E ≫ limit.π (E ⋙ F) k = limit.π F (E.obj k) :=
by { erw is_limit.fac, refl }

@[simp] lemma limit.lift_pre (c : cone F) :
  limit.lift F c ≫ limit.pre F E = limit.lift (E ⋙ F) (c.whisker E) :=
by ext; simp

variables {L : Type v} [small_category L]
variables (D : L ⥤ K) [has_limit (D ⋙ E ⋙ F)]

@[simp] lemma limit.pre_pre : limit.pre F E ≫ limit.pre (E ⋙ F) D = limit.pre F (D ⋙ E) :=
by ext j; erw [assoc, limit.pre_π, limit.pre_π, limit.pre_π]; refl

variables {E F}

/---
If we have particular limit cones available for `E ⋙ F` and for `F`,
we obtain a formula for `limit.pre F E`.
-/
lemma limit.pre_eq (s : limit_cone (E ⋙ F)) (t : limit_cone F) :
  limit.pre F E =
    (limit.iso_limit_cone t).hom ≫ s.is_limit.lift ((t.cone).whisker E) ≫
      (limit.iso_limit_cone s).inv :=
by tidy

end pre

section post
variables {D : Type u'} [category.{v} D]

variables (F) [has_limit F] (G : C ⥤ D) [has_limit (F ⋙ G)]

/--
The canonical morphism from `G` applied to the limit of `F` to the limit of `F ⋙ G`.
-/
def limit.post : G.obj (limit F) ⟶ limit (F ⋙ G) :=
limit.lift (F ⋙ G) (G.map_cone (limit.cone F))

@[simp, reassoc] lemma limit.post_π (j : J) :
  limit.post F G ≫ limit.π (F ⋙ G) j = G.map (limit.π F j) :=
by { erw is_limit.fac, refl }

@[simp] lemma limit.lift_post (c : cone F) :
  G.map (limit.lift F c) ≫ limit.post F G = limit.lift (F ⋙ G) (G.map_cone c) :=
by { ext, rw [assoc, limit.post_π, ←G.map_comp, limit.lift_π, limit.lift_π], refl }

@[simp] lemma limit.post_post
  {E : Type u''} [category.{v} E] (H : D ⥤ E) [has_limit ((F ⋙ G) ⋙ H)] :
/- H G (limit F) ⟶ H (limit (F ⋙ G)) ⟶ limit ((F ⋙ G) ⋙ H) equals -/
/- H G (limit F) ⟶ limit (F ⋙ (G ⋙ H)) -/
  H.map (limit.post F G) ≫ limit.post (F ⋙ G) H = limit.post F (G ⋙ H) :=
by ext; erw [assoc, limit.post_π, ←H.map_comp, limit.post_π, limit.post_π]; refl

end post

lemma limit.pre_post {D : Type u'} [category.{v} D]
  (E : K ⥤ J) (F : J ⥤ C) (G : C ⥤ D)
  [has_limit F] [has_limit (E ⋙ F)] [has_limit (F ⋙ G)] [has_limit ((E ⋙ F) ⋙ G)] :
/- G (limit F) ⟶ G (limit (E ⋙ F)) ⟶ limit ((E ⋙ F) ⋙ G) vs -/
/- G (limit F) ⟶ limit F ⋙ G ⟶ limit (E ⋙ (F ⋙ G)) or -/
  G.map (limit.pre F E) ≫ limit.post (E ⋙ F) G = limit.post F G ≫ limit.pre (F ⋙ G) E :=
by ext; erw [assoc, limit.post_π, ←G.map_comp, limit.pre_π, assoc, limit.pre_π, limit.post_π]; refl

open category_theory.equivalence
instance has_limit_equivalence_comp (e : K ≌ J) [has_limit F] : has_limit (e.functor ⋙ F) :=
has_limit.mk { cone := cone.whisker e.functor (limit.cone F),
  is_limit := is_limit.whisker_equivalence (limit.is_limit F) e, }

local attribute [elab_simple] inv_fun_id_assoc -- not entirely sure why this is needed

/--
If a `E ⋙ F` has a limit, and `E` is an equivalence, we can construct a limit of `F`.
-/
lemma has_limit_of_equivalence_comp (e : K ≌ J) [has_limit (e.functor ⋙ F)] : has_limit F :=
begin
  haveI : has_limit (e.inverse ⋙ e.functor ⋙ F) := limits.has_limit_equivalence_comp e.symm,
  apply has_limit_of_iso (e.inv_fun_id_assoc F),
end

-- `has_limit_comp_equivalence` and `has_limit_of_comp_equivalence`
-- are proved in `category_theory/adjunction/limits.lean`.

section lim_functor

variables [has_limits_of_shape J C]

section

/-- `limit F` is functorial in `F`, when `C` has all limits of shape `J`. -/
@[simps obj]
def lim : (J ⥤ C) ⥤ C :=
{ obj := λ F, limit F,
  map := λ F G α, lim_map α,
  map_id' := λ F, by { ext, erw [lim_map_π, category.id_comp, category.comp_id] },
  map_comp' := λ F G H α β,
    by ext; erw [assoc, is_limit.fac, is_limit.fac, ←assoc, is_limit.fac, assoc]; refl }
end

variables {F} {G : J ⥤ C} (α : F ⟶ G)

-- We generate this manually since `simps` gives it a weird name.
@[simp] lemma lim_map_eq_lim_map : lim.map α = lim_map α := rfl

lemma limit.map_pre [has_limits_of_shape K C] (E : K ⥤ J) :
  lim.map α ≫ limit.pre G E = limit.pre F E ≫ lim.map (whisker_left E α) :=
by { ext, simp }

lemma limit.map_pre' [has_limits_of_shape K C]
  (F : J ⥤ C) {E₁ E₂ : K ⥤ J} (α : E₁ ⟶ E₂) :
  limit.pre F E₂ = limit.pre F E₁ ≫ lim.map (whisker_right α F) :=
by ext1; simp [← category.assoc]

lemma limit.id_pre (F : J ⥤ C) :
limit.pre F (𝟭 _) = lim.map (functor.left_unitor F).inv := by tidy

lemma limit.map_post {D : Type u'} [category.{v} D] [has_limits_of_shape J D] (H : C ⥤ D) :
/- H (limit F) ⟶ H (limit G) ⟶ limit (G ⋙ H) vs
   H (limit F) ⟶ limit (F ⋙ H) ⟶ limit (G ⋙ H) -/
  H.map (lim_map α) ≫ limit.post G H = limit.post F H ≫ lim_map (whisker_right α H) :=
begin
  ext,
  simp only [whisker_right_app, lim_map_π, assoc, limit.post_π_assoc, limit.post_π, ← H.map_comp],
end

/--
The isomorphism between
morphisms from `W` to the cone point of the limit cone for `F`
and cones over `F` with cone point `W`
is natural in `F`.
-/
def lim_yoneda : lim ⋙ yoneda ≅ category_theory.cones J C :=
nat_iso.of_components (λ F, nat_iso.of_components (λ W, limit.hom_iso F (unop W)) (by tidy))
  (by tidy)

end lim_functor

/--
We can transport limits of shape `J` along an equivalence `J ≌ J'`.
-/
lemma has_limits_of_shape_of_equivalence {J' : Type v} [small_category J']
  (e : J ≌ J') [has_limits_of_shape J C] : has_limits_of_shape J' C :=
by { constructor, intro F, apply has_limit_of_equivalence_comp e, apply_instance }

end limit

section colimit

/-- `colimit_cocone F` contains a cocone over `F` together with the information that it is a
    colimit. -/
@[nolint has_inhabited_instance]
structure colimit_cocone (F : J ⥤ C) :=
(cocone : cocone F)
(is_colimit : is_colimit cocone)

/-- `has_colimit F` represents the mere existence of a colimit for `F`. -/
class has_colimit (F : J ⥤ C) : Prop :=
mk' :: (exists_colimit : nonempty (colimit_cocone F))

lemma has_colimit.mk {F : J ⥤ C} (d : colimit_cocone F) : has_colimit F :=
⟨nonempty.intro d⟩

/-- Use the axiom of choice to extract explicit `colimit_cocone F` from `has_colimit F`. -/
def get_colimit_cocone (F : J ⥤ C) [has_colimit F] : colimit_cocone F :=
classical.choice $ has_colimit.exists_colimit

variables (J C)

/-- `C` has colimits of shape `J` if there exists a colimit for every functor `F : J ⥤ C`. -/
class has_colimits_of_shape : Prop :=
(has_colimit : Π F : J ⥤ C, has_colimit F . tactic.apply_instance)

/-- `C` has all (small) colimits if it has colimits of every shape. -/
class has_colimits : Prop :=
(has_colimits_of_shape :
  Π (J : Type v) [𝒥 : small_category J], has_colimits_of_shape J C . tactic.apply_instance)

variables {J C}

@[priority 100] -- see Note [lower instance priority]
instance has_colimit_of_has_colimits_of_shape
  {J : Type v} [small_category J] [H : has_colimits_of_shape J C] (F : J ⥤ C) : has_colimit F :=
has_colimits_of_shape.has_colimit F

@[priority 100] -- see Note [lower instance priority]
instance has_colimits_of_shape_of_has_colimits
  {J : Type v} [small_category J] [H : has_colimits C] : has_colimits_of_shape J C :=
has_colimits.has_colimits_of_shape J

/- Interface to the `has_colimit` class. -/

/-- An arbitrary choice of colimit cocone of a functor. -/
def colimit.cocone (F : J ⥤ C) [has_colimit F] : cocone F := (get_colimit_cocone F).cocone

/-- An arbitrary choice of colimit object of a functor. -/
def colimit (F : J ⥤ C) [has_colimit F] := (colimit.cocone F).X

/-- The coprojection from a value of the functor to the colimit object. -/
def colimit.ι (F : J ⥤ C) [has_colimit F] (j : J) : F.obj j ⟶ colimit F :=
(colimit.cocone F).ι.app j

@[simp] lemma colimit.cocone_ι {F : J ⥤ C} [has_colimit F] (j : J) :
  (colimit.cocone F).ι.app j = colimit.ι _ j := rfl

@[simp] lemma colimit.cocone_X {F : J ⥤ C} [has_colimit F] :
  (colimit.cocone F).X = colimit F := rfl

@[simp, reassoc] lemma colimit.w (F : J ⥤ C) [has_colimit F] {j j' : J} (f : j ⟶ j') :
  F.map f ≫ colimit.ι F j' = colimit.ι F j := (colimit.cocone F).w f

/-- Evidence that the arbitrary choice of cocone is a colimit cocone. -/
def colimit.is_colimit (F : J ⥤ C) [has_colimit F] : is_colimit (colimit.cocone F) :=
(get_colimit_cocone F).is_colimit

/-- The morphism from the colimit object to the cone point of any other cocone. -/
def colimit.desc (F : J ⥤ C) [has_colimit F] (c : cocone F) : colimit F ⟶ c.X :=
(colimit.is_colimit F).desc c

@[simp] lemma colimit.is_colimit_desc {F : J ⥤ C} [has_colimit F] (c : cocone F) :
  (colimit.is_colimit F).desc c = colimit.desc F c := rfl

/--
We have lots of lemmas describing how to simplify `colimit.ι F j ≫ _`,
and combined with `colimit.ext` we rely on these lemmas for many calculations.

However, since `category.assoc` is a `@[simp]` lemma, often expressions are
right associated, and it's hard to apply these lemmas about `colimit.ι`.

We thus use `reassoc` to define additional `@[simp]` lemmas, with an arbitrary extra morphism.
(see `tactic/reassoc_axiom.lean`)
 -/
@[simp, reassoc] lemma colimit.ι_desc {F : J ⥤ C} [has_colimit F] (c : cocone F) (j : J) :
  colimit.ι F j ≫ colimit.desc F c = c.ι.app j :=
is_colimit.fac _ c j

/--
Functoriality of colimits.

Usually this morphism should be accessed through `colim.map`,
but may be needed separately when you have specified colimits for the source and target functors,
but not necessarily for all functors of shape `J`.
-/
def colim_map {F G : J ⥤ C} [has_colimit F] [has_colimit G] (α : F ⟶ G) : colimit F ⟶ colimit G :=
is_colimit.map (colimit.is_colimit F) _ α

@[simp, reassoc]
lemma ι_colim_map {F G : J ⥤ C} [has_colimit F] [has_colimit G] (α : F ⟶ G) (j : J) :
  colimit.ι F j ≫ colim_map α = α.app j ≫ colimit.ι G j :=
colimit.ι_desc _ j

/-- The cocone morphism from the arbitrary choice of colimit cocone to any cocone. -/
def colimit.cocone_morphism {F : J ⥤ C} [has_colimit F] (c : cocone F) :
  (colimit.cocone F) ⟶ c :=
(colimit.is_colimit F).desc_cocone_morphism c

@[simp] lemma colimit.cocone_morphism_hom {F : J ⥤ C} [has_colimit F] (c : cocone F) :
  (colimit.cocone_morphism c).hom = colimit.desc F c := rfl
lemma colimit.ι_cocone_morphism {F : J ⥤ C} [has_colimit F] (c : cocone F) (j : J) :
  colimit.ι F j ≫ (colimit.cocone_morphism c).hom = c.ι.app j :=
by simp

@[simp, reassoc] lemma colimit.comp_cocone_point_unique_up_to_iso_hom {F : J ⥤ C} [has_colimit F]
  {c : cocone F} (hc : is_colimit c) (j : J) :
  colimit.ι F j ≫ (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) hc).hom =
    c.ι.app j :=
is_colimit.comp_cocone_point_unique_up_to_iso_hom _ _ _

@[simp, reassoc] lemma colimit.comp_cocone_point_unique_up_to_iso_inv {F : J ⥤ C} [has_colimit F]
  {c : cocone F} (hc : is_colimit c) (j : J) :
  colimit.ι F j ≫ (is_colimit.cocone_point_unique_up_to_iso hc (colimit.is_colimit _)).inv =
    c.ι.app j :=
is_colimit.comp_cocone_point_unique_up_to_iso_inv _ _ _

/--
Given any other colimit cocone for `F`, the chosen `colimit F` is isomorphic to the cocone point.
-/
def colimit.iso_colimit_cocone {F : J ⥤ C} [has_colimit F] (t : colimit_cocone F) :
  colimit F ≅ t.cocone.X :=
is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F) t.is_colimit

@[simp, reassoc] lemma colimit.iso_colimit_cocone_ι_hom
  {F : J ⥤ C} [has_colimit F] (t : colimit_cocone F) (j : J) :
  colimit.ι F j ≫ (colimit.iso_colimit_cocone t).hom = t.cocone.ι.app j :=
by { dsimp [colimit.iso_colimit_cocone, is_colimit.cocone_point_unique_up_to_iso], tidy, }

@[simp, reassoc] lemma colimit.iso_colimit_cocone_ι_inv
  {F : J ⥤ C} [has_colimit F] (t : colimit_cocone F) (j : J) :
  t.cocone.ι.app j ≫ (colimit.iso_colimit_cocone t).inv = colimit.ι F j :=
by { dsimp [colimit.iso_colimit_cocone, is_colimit.cocone_point_unique_up_to_iso], tidy, }

@[ext] lemma colimit.hom_ext {F : J ⥤ C} [has_colimit F] {X : C} {f f' : colimit F ⟶ X}
  (w : ∀ j, colimit.ι F j ≫ f = colimit.ι F j ≫ f') : f = f' :=
(colimit.is_colimit F).hom_ext w

@[simp] lemma colimit.desc_cocone {F : J ⥤ C} [has_colimit F] :
  colimit.desc F (colimit.cocone F) = 𝟙 (colimit F) :=
(colimit.is_colimit _).desc_self

/--
The isomorphism (in `Type`) between
morphisms from the colimit object to a specified object `W`,
and cocones with cone point `W`.
-/
def colimit.hom_iso (F : J ⥤ C) [has_colimit F] (W : C) : (colimit F ⟶ W) ≅ (F.cocones.obj W) :=
(colimit.is_colimit F).hom_iso W

@[simp] lemma colimit.hom_iso_hom (F : J ⥤ C) [has_colimit F] {W : C} (f : colimit F ⟶ W) :
  (colimit.hom_iso F W).hom f = (colimit.cocone F).ι ≫ (const J).map f :=
(colimit.is_colimit F).hom_iso_hom f

/--
The isomorphism (in `Type`) between
morphisms from the colimit object to a specified object `W`,
and an explicit componentwise description of cocones with cone point `W`.
-/
def colimit.hom_iso' (F : J ⥤ C) [has_colimit F] (W : C) :
  ((colimit F ⟶ W) : Type v) ≅
    { p : Π j, F.obj j ⟶ W // ∀ {j j'} (f : j ⟶ j'), F.map f ≫ p j' = p j } :=
(colimit.is_colimit F).hom_iso' W

lemma colimit.desc_extend (F : J ⥤ C) [has_colimit F] (c : cocone F) {X : C} (f : c.X ⟶ X) :
  colimit.desc F (c.extend f) = colimit.desc F c ≫ f :=
begin
  ext1, rw [←category.assoc], simp
end

/--
If `F` has a colimit, so does any naturally isomorphic functor.
-/
-- This has the isomorphism pointing in the opposite direction than in `has_limit_of_iso`.
-- This is intentional; it seems to help with elaboration.
lemma has_colimit_of_iso {F G : J ⥤ C} [has_colimit F] (α : G ≅ F) : has_colimit G :=
has_colimit.mk
{ cocone := (cocones.precompose α.hom).obj (colimit.cocone F),
  is_colimit :=
  { desc := λ s, colimit.desc F ((cocones.precompose α.inv).obj s),
    fac' := λ s j,
    begin
      rw [cocones.precompose_obj_ι, nat_trans.comp_app, colimit.cocone_ι],
      rw [category.assoc, colimit.ι_desc, ←nat_iso.app_hom, ←iso.eq_inv_comp], refl
    end,
    uniq' := λ s m w,
    begin
      apply colimit.hom_ext, intro j,
      rw [colimit.ι_desc, cocones.precompose_obj_ι, nat_trans.comp_app, ←nat_iso.app_inv,
        iso.eq_inv_comp],
      simpa using w j
    end } }

/-- If a functor `G` has the same collection of cocones as a functor `F`
which has a colimit, then `G` also has a colimit. -/
lemma has_colimit.of_cocones_iso {J K : Type v} [small_category J] [small_category K] (F : J ⥤ C)
  (G : K ⥤ C) (h : F.cocones ≅ G.cocones) [has_colimit F] : has_colimit G :=
has_colimit.mk ⟨_, is_colimit.of_nat_iso ((is_colimit.nat_iso (colimit.is_colimit F)) ≪≫ h)⟩

/--
The colimits of `F : J ⥤ C` and `G : J ⥤ C` are isomorphic,
if the functors are naturally isomorphic.
-/
def has_colimit.iso_of_nat_iso {F G : J ⥤ C} [has_colimit F] [has_colimit G] (w : F ≅ G) :
  colimit F ≅ colimit G :=
is_colimit.cocone_points_iso_of_nat_iso (colimit.is_colimit F) (colimit.is_colimit G) w

@[simp, reassoc]
lemma has_colimit.iso_of_nat_iso_ι_hom {F G : J ⥤ C} [has_colimit F] [has_colimit G]
  (w : F ≅ G) (j : J) :
  colimit.ι F j ≫ (has_colimit.iso_of_nat_iso w).hom = w.hom.app j ≫ colimit.ι G j :=
is_colimit.comp_cocone_points_iso_of_nat_iso_hom _ _ _ _

@[simp, reassoc]
lemma has_colimit.iso_of_nat_iso_hom_desc {F G : J ⥤ C} [has_colimit F] [has_colimit G]
  (t : cocone G) (w : F ≅ G) :
  (has_colimit.iso_of_nat_iso w).hom ≫ colimit.desc G t =
    colimit.desc F ((cocones.precompose w.hom).obj _) :=
is_colimit.cocone_points_iso_of_nat_iso_hom_desc _ _ _

/--
The colimits of `F : J ⥤ C` and `G : K ⥤ C` are isomorphic,
if there is an equivalence `e : J ≌ K` making the triangle commute up to natural isomorphism.
-/
def has_colimit.iso_of_equivalence {F : J ⥤ C} [has_colimit F] {G : K ⥤ C} [has_colimit G]
   (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : colimit F ≅ colimit G :=
is_colimit.cocone_points_iso_of_equivalence (colimit.is_colimit F) (colimit.is_colimit G) e w

@[simp]
lemma has_colimit.iso_of_equivalence_hom_π {F : J ⥤ C} [has_colimit F] {G : K ⥤ C} [has_colimit G]
   (e : J ≌ K) (w : e.functor ⋙ G ≅ F) (j : J) :
  colimit.ι F j ≫ (has_colimit.iso_of_equivalence e w).hom =
     F.map (e.unit.app j) ≫ w.inv.app _ ≫ colimit.ι G _ :=
begin
  simp [has_colimit.iso_of_equivalence, is_colimit.cocone_points_iso_of_equivalence_inv],
  dsimp,
  simp,
end

@[simp]
lemma has_colimit.iso_of_equivalence_inv_π {F : J ⥤ C} [has_colimit F] {G : K ⥤ C} [has_colimit G]
   (e : J ≌ K) (w : e.functor ⋙ G ≅ F) (k : K) :
  colimit.ι G k ≫ (has_colimit.iso_of_equivalence e w).inv =
     G.map (e.counit_inv.app k) ≫ w.hom.app (e.inverse.obj k) ≫ colimit.ι F (e.inverse.obj k) :=
begin
  simp [has_colimit.iso_of_equivalence, is_colimit.cocone_points_iso_of_equivalence_inv],
  dsimp,
  simp,
end

section pre
variables (F) [has_colimit F] (E : K ⥤ J) [has_colimit (E ⋙ F)]

/--
The canonical morphism from the colimit of `E ⋙ F` to the colimit of `F`.
-/
def colimit.pre : colimit (E ⋙ F) ⟶ colimit F :=
colimit.desc (E ⋙ F) ((colimit.cocone F).whisker E)

@[simp, reassoc] lemma colimit.ι_pre (k : K) :
  colimit.ι (E ⋙ F) k ≫ colimit.pre F E = colimit.ι F (E.obj k) :=
by { erw is_colimit.fac, refl, }

@[simp] lemma colimit.pre_desc (c : cocone F) :
  colimit.pre F E ≫ colimit.desc F c = colimit.desc (E ⋙ F) (c.whisker E) :=
by ext; rw [←assoc, colimit.ι_pre]; simp

variables {L : Type v} [small_category L]
variables (D : L ⥤ K) [has_colimit (D ⋙ E ⋙ F)]

@[simp] lemma colimit.pre_pre : colimit.pre (E ⋙ F) D ≫ colimit.pre F E = colimit.pre F (D ⋙ E) :=
begin
  ext j,
  rw [←assoc, colimit.ι_pre, colimit.ι_pre],
  letI : has_colimit ((D ⋙ E) ⋙ F) := show has_colimit (D ⋙ E ⋙ F), by apply_instance,
  exact (colimit.ι_pre F (D ⋙ E) j).symm
end

variables {E F}

/---
If we have particular colimit cocones available for `E ⋙ F` and for `F`,
we obtain a formula for `colimit.pre F E`.
-/
lemma colimit.pre_eq (s : colimit_cocone (E ⋙ F)) (t : colimit_cocone F) :
  colimit.pre F E =
    (colimit.iso_colimit_cocone s).hom ≫ s.is_colimit.desc ((t.cocone).whisker E) ≫
      (colimit.iso_colimit_cocone t).inv :=
by tidy

end pre

section post
variables {D : Type u'} [category.{v} D]

variables (F) [has_colimit F] (G : C ⥤ D) [has_colimit (F ⋙ G)]

/--
The canonical morphism from `G` applied to the colimit of `F ⋙ G`
to `G` applied to the colimit of `F`.
-/
def colimit.post : colimit (F ⋙ G) ⟶ G.obj (colimit F) :=
colimit.desc (F ⋙ G) (G.map_cocone (colimit.cocone F))

@[simp, reassoc] lemma colimit.ι_post (j : J) :
  colimit.ι (F ⋙ G) j ≫ colimit.post F G  = G.map (colimit.ι F j) :=
by { erw is_colimit.fac, refl, }

@[simp] lemma colimit.post_desc (c : cocone F) :
  colimit.post F G ≫ G.map (colimit.desc F c) = colimit.desc (F ⋙ G) (G.map_cocone c) :=
by { ext, rw [←assoc, colimit.ι_post, ←G.map_comp, colimit.ι_desc, colimit.ι_desc], refl }

@[simp] lemma colimit.post_post
  {E : Type u''} [category.{v} E] (H : D ⥤ E) [has_colimit ((F ⋙ G) ⋙ H)] :
/- H G (colimit F) ⟶ H (colimit (F ⋙ G)) ⟶ colimit ((F ⋙ G) ⋙ H) equals -/
/- H G (colimit F) ⟶ colimit (F ⋙ (G ⋙ H)) -/
  colimit.post (F ⋙ G) H ≫ H.map (colimit.post F G) = colimit.post F (G ⋙ H) :=
begin
  ext,
  rw [←assoc, colimit.ι_post, ←H.map_comp, colimit.ι_post],
  exact (colimit.ι_post F (G ⋙ H) j).symm
end

end post

lemma colimit.pre_post {D : Type u'} [category.{v} D]
  (E : K ⥤ J) (F : J ⥤ C) (G : C ⥤ D)
  [has_colimit F] [has_colimit (E ⋙ F)] [has_colimit (F ⋙ G)] [has_colimit ((E ⋙ F) ⋙ G)] :
/- G (colimit F) ⟶ G (colimit (E ⋙ F)) ⟶ colimit ((E ⋙ F) ⋙ G) vs -/
/- G (colimit F) ⟶ colimit F ⋙ G ⟶ colimit (E ⋙ (F ⋙ G)) or -/
  colimit.post (E ⋙ F) G ≫ G.map (colimit.pre F E) = colimit.pre (F ⋙ G) E ≫ colimit.post F G :=
begin
  ext,
  rw [←assoc, colimit.ι_post, ←G.map_comp, colimit.ι_pre, ←assoc],
  letI : has_colimit (E ⋙ F ⋙ G) := show has_colimit ((E ⋙ F) ⋙ G), by apply_instance,
  erw [colimit.ι_pre (F ⋙ G) E j, colimit.ι_post]
end

open category_theory.equivalence
instance has_colimit_equivalence_comp (e : K ≌ J) [has_colimit F] : has_colimit (e.functor ⋙ F) :=
has_colimit.mk { cocone := cocone.whisker e.functor (colimit.cocone F),
  is_colimit := is_colimit.whisker_equivalence (colimit.is_colimit F) e, }

/--
If a `E ⋙ F` has a colimit, and `E` is an equivalence, we can construct a colimit of `F`.
-/
lemma has_colimit_of_equivalence_comp (e : K ≌ J) [has_colimit (e.functor ⋙ F)] : has_colimit F :=
begin
  haveI : has_colimit (e.inverse ⋙ e.functor ⋙ F) := limits.has_colimit_equivalence_comp e.symm,
  apply has_colimit_of_iso (e.inv_fun_id_assoc F).symm,
end

section colim_functor

variables [has_colimits_of_shape J C]

section
local attribute [simp] colim_map

/-- `colimit F` is functorial in `F`, when `C` has all colimits of shape `J`. -/
@[simps obj]
def colim : (J ⥤ C) ⥤ C :=
{ obj := λ F, colimit F,
  map := λ F G α, colim_map α,
  map_id' := λ F, by { ext, erw [ι_colim_map, id_comp, comp_id] },
  map_comp' := λ F G H α β,
    by { ext, erw [←assoc, is_colimit.fac, is_colimit.fac, assoc, is_colimit.fac, ←assoc], refl } }

end

variables {F} {G : J ⥤ C} (α : F ⟶ G)

@[simp, reassoc] lemma colimit.ι_map (j : J) :
  colimit.ι F j ≫ colim.map α = α.app j ≫ colimit.ι G j :=
by apply is_colimit.fac

@[simp] lemma colimit.map_desc (c : cocone G) :
  colim.map α ≫ colimit.desc G c = colimit.desc F ((cocones.precompose α).obj c) :=
by ext; rw [←assoc, colimit.ι_map, assoc, colimit.ι_desc, colimit.ι_desc]; refl

lemma colimit.pre_map [has_colimits_of_shape K C] (E : K ⥤ J) :
  colimit.pre F E ≫ colim.map α = colim.map (whisker_left E α) ≫ colimit.pre G E :=
by ext; rw [←assoc, colimit.ι_pre, colimit.ι_map, ←assoc, colimit.ι_map, assoc, colimit.ι_pre]; refl

lemma colimit.pre_map' [has_colimits_of_shape K C]
  (F : J ⥤ C) {E₁ E₂ : K ⥤ J} (α : E₁ ⟶ E₂) :
  colimit.pre F E₁ = colim.map (whisker_right α F) ≫ colimit.pre F E₂ :=
by ext1; simp [← category.assoc]

lemma colimit.pre_id (F : J ⥤ C) :
colimit.pre F (𝟭 _) = colim.map (functor.left_unitor F).hom := by tidy

lemma colimit.map_post {D : Type u'} [category.{v} D] [has_colimits_of_shape J D] (H : C ⥤ D) :
/- H (colimit F) ⟶ H (colimit G) ⟶ colimit (G ⋙ H) vs
   H (colimit F) ⟶ colimit (F ⋙ H) ⟶ colimit (G ⋙ H) -/
  colimit.post F H ≫ H.map (colim.map α) = colim.map (whisker_right α H) ≫ colimit.post G H:=
begin
  ext,
  rw [←assoc, colimit.ι_post, ←H.map_comp, colimit.ι_map, H.map_comp],
  rw [←assoc, colimit.ι_map, assoc, colimit.ι_post],
  refl
end

/--
The isomorphism between
morphisms from the cone point of the colimit cocone for `F` to `W`
and cocones over `F` with cone point `W`
is natural in `F`.
-/
def colim_coyoneda : colim.op ⋙ coyoneda ≅ category_theory.cocones J C :=
nat_iso.of_components (λ F, nat_iso.of_components (colimit.hom_iso (unop F)) (by tidy))
  (by tidy)

end colim_functor

/--
We can transport colimits of shape `J` along an equivalence `J ≌ J'`.
-/
lemma has_colimits_of_shape_of_equivalence {J' : Type v} [small_category J']
  (e : J ≌ J') [has_colimits_of_shape J C] : has_colimits_of_shape J' C :=
by { constructor, intro F, apply has_colimit_of_equivalence_comp e, apply_instance }

end colimit

section opposite

/--
If `t : cone F` is a limit cone, then `t.op : cocone F.op` is a colimit cocone.
-/
def is_limit.op {t : cone F} (P : is_limit t) : is_colimit t.op :=
{ desc := λ s, (P.lift s.unop).op,
  fac' := λ s j, congr_arg quiver.hom.op (P.fac s.unop (unop j)),
  uniq' := λ s m w,
  begin
    rw ← P.uniq s.unop m.unop,
    { refl, },
    { dsimp, intro j, rw ← w, refl, }
  end }

/--
If `t : cocone F` is a colimit cocone, then `t.op : cone F.op` is a limit cone.
-/
def is_colimit.op {t : cocone F} (P : is_colimit t) : is_limit t.op :=
{ lift := λ s, (P.desc s.unop).op,
  fac' := λ s j, congr_arg quiver.hom.op (P.fac s.unop (unop j)),
  uniq' := λ s m w,
  begin
    rw ← P.uniq s.unop m.unop,
    { refl, },
    { dsimp, intro j, rw ← w, refl, }
  end }

/--
If `t : cone F.op` is a limit cone, then `t.unop : cocone F` is a colimit cocone.
-/
def is_limit.unop {t : cone F.op} (P : is_limit t) : is_colimit t.unop :=
{ desc := λ s, (P.lift s.op).unop,
  fac' := λ s j, congr_arg quiver.hom.unop (P.fac s.op (op j)),
  uniq' := λ s m w,
  begin
    rw ← P.uniq s.op m.op,
    { refl, },
    { dsimp, intro j, rw ← w, refl, }
  end }

/--
If `t : cocone F.op` is a colimit cocone, then `t.unop : cone F.` is a limit cone.
-/
def is_colimit.unop {t : cocone F.op} (P : is_colimit t) : is_limit t.unop :=
{ lift := λ s, (P.desc s.op).unop,
  fac' := λ s j, congr_arg quiver.hom.unop (P.fac s.op (op j)),
  uniq' := λ s m w,
  begin
    rw ← P.uniq s.op m.op,
    { refl, },
    { dsimp, intro j, rw ← w, refl, }
  end }

/--
`t : cone F` is a limit cone if and only is `t.op : cocone F.op` is a colimit cocone.
-/
def is_limit_equiv_is_colimit_op {t : cone F} : is_limit t ≃ is_colimit t.op :=
equiv_of_subsingleton_of_subsingleton
  is_limit.op (λ P, P.unop.of_iso_limit (cones.ext (iso.refl _) (by tidy)))

/--
`t : cocone F` is a colimit cocone if and only is `t.op : cone F.op` is a limit cone.
-/
def is_colimit_equiv_is_limit_op {t : cocone F} : is_colimit t ≃ is_limit t.op :=
equiv_of_subsingleton_of_subsingleton
  is_colimit.op (λ P, P.unop.of_iso_colimit (cocones.ext (iso.refl _) (by tidy)))

end opposite

end category_theory.limits


import Mathlib.Data.Nat.GCD.Basic
import Mathlib.Tactic.Ring
import Std
import Demo.Util
import Smt
import Aesop

--set_option smt.solver.path "/home/avigad/projects/verification_demo/bin/cvc5"
-- set_option smt.solver.kind "vampire"

example (n m : Int) (h : 0 < m) : n % m < m := by
  smt [h]
  sorry

example (n m k l : Int) : (n - m) * k + l = n*k - m*k + l := by
  smt
  sorry

example (n m k l : Int) (hN : n ≤ m) (hK : k ≤ l) : n + k ≤ m + l := by
  smt [hN, hK]
  sorry

theorem cong (x y : Int) (f : Int → Int) : x = y → f x = f y := by
  smt
  simp_all

@[aesop safe]
def fib : Nat → Nat
  | 0 => 0
  | 1 => 1
  | n + 2 => fib (n + 1) + fib n

@[aesop safe]
theorem fib_zero : fib 0 = 0 := rfl

@[aesop safe]
theorem fib_one : fib 1 = 1 := rfl

@[aesop safe]
theorem fib_add_two (n : ℕ) : fib (n + 2) = fib n + fib (n + 1) := by
  simp [fib, add_comm]

lemma fib_add (m n : ℕ) :
    fib (m + n + 1) = fib m * fib n + fib (m + 1) * fib (n + 1) := by
  induction n generalizing m
  · case zero =>
    simp [fib]
  · case succ n ih =>
    intros
    specialize ih (m + 1)
    rw [add_assoc m 1 n, add_comm 1 n] at ih
    simp only [fib_add_two, ih]
    ring

-- lemma fib_add' (m n : ℕ) :
--     fib (m + n + 1) = fib m * fib n + fib (m + 1) * fib (n + 1) := by
--   induction n generalizing m
--   · case zero =>
--     smt [fib_zero, fib_one]
--     sorry
--   · case succ n ih =>
--     intros
--     specialize ih (m + 1)
--     smt [fib_zero, fib_one, fib_add_two, ih]
--     rw [add_assoc m 1 n, add_comm 1 n] at ih
--     simp only [fib_add_two, ih]
--     ring

lemma fib_add'' (m n : ℕ) :
    fib (m + n + 1) = fib m * fib n + fib (m + 1) * fib (n + 1) := by
  induction n generalizing m
  · case zero =>
    aesop
  · case succ n ih =>
    intros
    specialize ih (m + 1)
    rw [add_assoc m 1 n, add_comm 1 n] at ih
    simp only [fib_add_two, ih]
    ring

def fib₀ : Nat → Nat
  | 0 => 0
  | n + 1 => (aux n).2
where
  aux : Nat → Nat × Nat
    | 0 => (0, 1)
    | n + 1 =>
      let (a, b) := aux n
      (b, a + b)

#eval List.range 20 |>.map fib₀

lemma fib₀_aux_eq (n : Nat) : fib₀.aux n = (fib n, fib (n + 1)) := by
  induction n
  . smt [fib_zero, fib_one, fib_add_two]
  . next _ ih =>
    simp [fib₀.aux, fib, ih, add_comm]

lemma fib₀_aux_eq_alt (n : Nat) : fib₀.aux n = (fib n, fib (n + 1)) := by
  induction n <;> simp [*, fib, fib₀.aux, add_comm]


/-
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
-/
import topology.metric_space.basic
import topology.algebra.order.archimedean
import topology.instances.int
import topology.instances.nat
import topology.instances.real
/-!
# Topology on the ratonal numbers

The structure of a metric space on `ℚ` is introduced in this file, induced from `ℝ`.
-/
noncomputable theory
open metric set filter

namespace rat

instance : metric_space ℚ :=
metric_space.induced coe rat.cast_injective real.metric_space

theorem dist_eq (x y : ℚ) : dist x y = |x - y| := rfl

@[norm_cast, simp] lemma dist_cast (x y : ℚ) : dist (x : ℝ) y = dist x y := rfl

theorem uniform_continuous_coe_real : uniform_continuous (coe : ℚ → ℝ) :=
uniform_continuous_comap

theorem dense_embedding_coe_real : dense_embedding (coe : ℚ → ℝ) :=
uniform_embedding_coe_real.dense_embedding rat.dense_range_cast

theorem embedding_coe_real : embedding (coe : ℚ → ℝ) := dense_embedding_coe_real.to_embedding

theorem continuous_coe_real : continuous (coe : ℚ → ℝ) := uniform_continuous_coe_real.continuous

end rat

@[norm_cast, simp] theorem nat.dist_cast_rat (x y : ℕ) : dist (x : ℚ) y = dist x y :=
by rw [← nat.dist_cast_real, ← rat.dist_cast]; congr' 1; norm_cast

lemma nat.uniform_embedding_coe_rat : uniform_embedding (coe : ℕ → ℚ) :=
uniform_embedding_bot_of_pairwise_le_dist zero_lt_one $ by simpa using nat.pairwise_one_le_dist

lemma nat.closed_embedding_coe_rat : closed_embedding (coe : ℕ → ℚ) :=
closed_embedding_of_pairwise_le_dist zero_lt_one $ by simpa using nat.pairwise_one_le_dist

@[norm_cast, simp] theorem int.dist_cast_rat (x y : ℤ) : dist (x : ℚ) y = dist x y :=
by rw [← int.dist_cast_real, ← rat.dist_cast]; congr' 1; norm_cast

lemma int.uniform_embedding_coe_rat : uniform_embedding (coe : ℤ → ℚ) :=
uniform_embedding_bot_of_pairwise_le_dist zero_lt_one $ by simpa using int.pairwise_one_le_dist

lemma int.closed_embedding_coe_rat : closed_embedding (coe : ℤ → ℚ) :=
closed_embedding_of_pairwise_le_dist zero_lt_one $ by simpa using int.pairwise_one_le_dist

instance : noncompact_space ℚ := int.closed_embedding_coe_rat.noncompact_space

-- TODO(Mario): Find a way to use rat_add_continuous_lemma
theorem rat.uniform_continuous_add : uniform_continuous (λp : ℚ × ℚ, p.1 + p.2) :=
rat.uniform_embedding_coe_real.to_uniform_inducing.uniform_continuous_iff.2 $
  by simp only [(∘), rat.cast_add]; exact real.uniform_continuous_add.comp
    (rat.uniform_continuous_coe_real.prod_map rat.uniform_continuous_coe_real)

theorem rat.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℚ _) :=
metric.uniform_continuous_iff.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
  by rw dist_comm at h; simpa [rat.dist_eq] using h⟩

instance : uniform_add_group ℚ :=
uniform_add_group.mk' rat.uniform_continuous_add rat.uniform_continuous_neg

instance : topological_add_group ℚ := by apply_instance

instance : order_topology ℚ :=
induced_order_topology _ (λ x y, rat.cast_lt) (@exists_rat_btwn _ _ _)

lemma rat.uniform_continuous_abs : uniform_continuous (abs : ℚ → ℚ) :=
metric.uniform_continuous_iff.2 $ λ ε ε0,
  ⟨ε, ε0, λ a b h, lt_of_le_of_lt
    (by simpa [rat.dist_eq] using abs_abs_sub_abs_le_abs_sub _ _) h⟩

lemma rat.continuous_mul : continuous (λp : ℚ × ℚ, p.1 * p.2) :=
rat.embedding_coe_real.continuous_iff.2 $ by simp [(∘)]; exact
real.continuous_mul.comp ((rat.continuous_coe_real.prod_map rat.continuous_coe_real))

instance : topological_ring ℚ :=
{ continuous_mul := rat.continuous_mul, ..rat.topological_add_group }

lemma rat.totally_bounded_Icc (a b : ℚ) : totally_bounded (Icc a b) :=
begin
  have := totally_bounded_preimage rat.uniform_embedding_coe_real (totally_bounded_Icc a b),
  rwa (set.ext (λ q, _) : Icc _ _ = _), simp
end


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import ring_seminorm
import analysis.special_functions.pow

/-!
# Equivalent power-multiplicative norms

In this file, we prove [BGR, Proposition 3.1.5/1]: if `R` is a normed commutative ring and `f₁` and
`f₂` are two power-multiplicative `R`-algebra norms on `S`, then if `f₁` and `f₂` are equivalent on
every subring `R[y]` for `y : S`, it follows that `f₁ = f₂`.

## Main Definitions
* `algebra_norm.restriction` : The restriction of an algebra norm to a subalgebra.
* `ring_hom.is_bounded_wrt` :A ring homomorphism `f : α →+* β` is bounded with respect to the
  functions `nα : α → ℝ` and `nβ : β → ℝ` if there exists a positive constant `C` such that for all
  `x` in `α`, `nβ (f x) ≤ C * nα x`.

## Main Results
* `eq_of_pow_mult_faithful` : the proof of [BGR, Proposition 3.1.5/1].

## References
* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags

norm, equivalent, power-multiplicative
-/

open_locale topological_space

/-- A homomorphism `f` between semi_normed_rings is bounded if there exists a positive
  constant `C` such that for all `x` in `α`, `norm (f x) ≤ C * norm x`. -/
def ring_hom.is_bounded {α : Type*} [semi_normed_ring α] {β : Type*} [semi_normed_ring β]
  (f : α →+* β) : Prop := ∃ C : ℝ, 0 < C ∧ ∀ x : α, norm (f x) ≤ C * norm x

/-- A ring homomorphism `f : α →+* β` is bounded with respect to the functions `nα : α → ℝ` and
  `nβ : β → ℝ` if there exists a positive constant `C` such that for all `x` in `α`,
  `nβ (f x) ≤ C * nα x`. -/
def ring_hom.is_bounded_wrt {α : Type*} [ring α] {β : Type*} [ring β] (nα : α → ℝ) (nβ : β → ℝ)
  (f : α →+* β) : Prop :=
∃ C : ℝ, 0 < C ∧ ∀ x : α, nβ (f x) ≤ C * nα x

/-- If `f : α →+* β` is bounded with respect to a ring seminorm `nα` on `α` and a
  power-multiplicative function `nβ : β → ℝ`, then `∀ x : α, nβ (f x) ≤ nα x`. -/
lemma contraction_of_is_pm_wrt {F : Type*} {α : out_param(Type*)} [ring α]
  [ring_seminorm_class F α] {β : Type*} [ring β] (nα : F) {nβ : β → ℝ} (hβ : is_pow_mul nβ)
  {f : α →+* β} (hf : f.is_bounded_wrt nα nβ) (x : α) :
  nβ (f x) ≤ nα x :=
begin
  obtain ⟨C, hC0, hC⟩ := hf,
  have hlim : filter.tendsto (λ n : ℕ, C ^ (1 / (n : ℝ)) * nα x) filter.at_top (𝓝 (nα x)),
  { have : (𝓝 (nα x)) = (𝓝 (1 * (nα x))) := by rw one_mul,
    rw this,
    apply filter.tendsto.mul,
    { apply filter.tendsto.comp _ (tendsto_const_div_at_top_nhds_0_nat 1),
      rw ← real.rpow_zero C,
      apply continuous_at.tendsto (real.continuous_at_const_rpow (ne_of_gt hC0)), },
    exact tendsto_const_nhds, },
  apply ge_of_tendsto hlim,
  simp only [filter.eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  have h : (C^(1/n : ℝ))^n  = C,
  { have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt hn),
      rw [← real.rpow_nat_cast, ← real.rpow_mul (le_of_lt hC0), one_div, inv_mul_cancel hn0,
        real.rpow_one], },
  apply le_of_pow_le_pow n
    (mul_nonneg (real.rpow_nonneg_of_nonneg (le_of_lt hC0) _) (map_nonneg _ _)) hn,
  { rw [mul_pow, h, ← hβ _ hn, ← ring_hom.map_pow],
    apply le_trans (hC (x^n)),
    rw mul_le_mul_left hC0,
    exact map_pow_le_pow _ _ (nat.one_le_iff_ne_zero.mp hn), },
end

/-- Given a bounded `f : α →+* β` between seminormed rings, is the seminorm on `β` is
  power-multiplicative, then `f` is a contraction. -/
lemma contraction_of_is_pm {α : Type*} [semi_normed_ring α] {β : Type*} [semi_normed_ring β]
  (hβ : is_pow_mul (norm : β → ℝ)) {f : α →+* β} (hf : f.is_bounded) (x : α) :
  norm (f x) ≤ norm x :=
contraction_of_is_pm_wrt (seminormed_ring.to_ring_seminorm α) hβ hf x

/-- Given two power-multiplicative ring seminorms `f, g` on `α`, if `f` is bounded by a positive
  multiple of `g` and viceversa, then `f = g`. -/
lemma eq_seminorms {F : Type*}  {α : out_param(Type*)} [ring α] [ring_seminorm_class F α]
  (f g : F) (hfpm : is_pow_mul f) (hgpm : is_pow_mul g)
  (hfg : ∃ (r : ℝ) (hr : 0 < r), ∀ (a : α), f a ≤ r * g a)
  (hgf : ∃ (r : ℝ) (hr : 0 < r), ∀ (a : α), g a ≤ r * f a) : f = g :=
begin
  obtain ⟨r, hr0, hr⟩ := hfg,
  obtain ⟨s, hs0, hs⟩ := hgf,
  have hle : ring_hom.is_bounded_wrt f g (ring_hom.id _) := ⟨s, hs0, hs⟩,
  have hge : ring_hom.is_bounded_wrt g f (ring_hom.id _) := ⟨r, hr0, hr⟩,
  rw ← function.injective.eq_iff (ring_seminorm_class.coe_injective'),
  ext x,
  exact le_antisymm (contraction_of_is_pm_wrt g hfpm hge x) (contraction_of_is_pm_wrt f hgpm hle x)
end

variables {R S : Type*} [normed_comm_ring R] [comm_ring S] [algebra R S]

/-- The restriction of a power-multiplicative function to a subalgebra is power-multiplicative. -/
lemma is_pow_mul.restriction (A : subalgebra R S) {f : S → ℝ} (hf_pm : is_pow_mul f) :
  is_pow_mul (λ x : A, (f x.val)) :=
λ x n hn, by simpa [subtype.val_eq_coe,subsemiring_class.coe_pow] using (hf_pm ↑x hn)

/-- The restriction of an algebra norm to a subalgebra. -/
def algebra_norm.restriction (A : subalgebra R S) (f : algebra_norm R S) : algebra_norm R A :=
{ to_fun    := λ x : A, f x.val,
  map_zero' := map_zero f,
  add_le'   := λ x y, map_add_le_add _ _ _,
  neg'      := λ x, map_neg_eq_map _ _,
  mul_le'   := λ x y, map_mul_le_mul _ _ _,
  eq_zero_of_map_eq_zero' :=
  λ x hx, by {rw ← zero_mem_class.coe_eq_zero; exact eq_zero_of_map_eq_zero f hx},
  smul'      := λ r x, map_smul_eq_mul _ _ _ }

/-- If `R` is a normed commutative ring and `f₁` and `f₂` are two power-multiplicative `R`-algebra
  norms on `S`, then if `f₁` and `f₂` are equivalent on every  subring `R[y]` for `y : S`, it
  follows that `f₁ = f₂` [BGR, Proposition 3.1.5/1].  -/
lemma eq_of_pow_mult_faithful (f₁ : algebra_norm R S) (hf₁_pm : is_pow_mul f₁)
  (f₂ : algebra_norm R S) (hf₂_pm : is_pow_mul f₂)
  (h_eq : ∀ (y : S), ∃ (C₁ C₂ : ℝ) (hC₁ : 0 < C₁) (hC₂ : 0 < C₂), ∀ (x : (algebra.adjoin R {y})),
    f₁ x.val ≤ C₁ * (f₂ x.val) ∧ f₂ x.val ≤ C₂ * (f₁ x.val) ) :
  f₁ = f₂ :=
begin
  ext x,
  set g₁ : algebra_norm R (algebra.adjoin R ({x} : set S)) := algebra_norm.restriction _ f₁,
  set g₂ : algebra_norm R (algebra.adjoin R ({x} : set S)) := algebra_norm.restriction _ f₂,
  have hg₁_pm : is_pow_mul g₁ := is_pow_mul.restriction _ hf₁_pm,
  have hg₂_pm : is_pow_mul g₂ := is_pow_mul.restriction _ hf₂_pm,
  let y : algebra.adjoin R ({x} : set S) := ⟨x, algebra.self_mem_adjoin_singleton R x⟩,
  have hy : x = y.val := rfl,
  have h1 : f₁ y.val = g₁ y := rfl,
  have h2 : f₂ y.val = g₂ y := rfl,
  obtain ⟨C₁, C₂, hC₁_pos, hC₂_pos, hC⟩ := h_eq x,
  obtain ⟨hC₁, hC₂⟩ := forall_and_distrib.mp hC,
  rw [hy, h1, h2, eq_seminorms g₁ g₂ hg₁_pm  hg₂_pm ⟨C₁, hC₁_pos, hC₁⟩ ⟨C₂, hC₂_pos, hC₂⟩],
end


import tactic data.finset
open_locale classical

namespace finset

variables {α : Type*} {β : Type*} [decidable_eq α]

def size{β : Type*} (X: finset β) := ((card X) : ℤ)

def subset_fintype{β: Type*} (hβ : fintype β) (X: finset β) := fintype

@[simp] lemma empt_size{β : Type*} : size (∅ : finset β) = 0 :=
begin
    sorry,
end

@[simp] lemma partition_univ {β : Type*} [fintype β] (X: finset β) : X ∪ Xᶜ = univ :=
begin
    apply subset.antisymm,
    exact subset_univ _,
    intros x hx,
    simp only [mem_union],
    by_cases x ∈ X,
    left,
    exact h,
    right,
    rw compl_eq_univ_sdiff,
    apply mem_sdiff.mpr,
    split,
    exact hx,
    exact h,
    --yuck....
end

@[simp] lemma size_subtype{β : Type*} {Y: set β} {X : finset Y} : size (X.image subtype.val)  = size X :=
begin
    unfold size,
    simp only [int.coe_nat_inj'],
    apply card_image_of_injective,
    exact subtype.val_injective
end

lemma union_subset_union_left{A B C : finset α} : (A ⊆ B) → ((A ∪ C) ⊆ (B ∪ C)) :=
begin
    intros hAB,
    intros x hx,
    simp only [mem_union],
    simp only [mem_union] at hx,
    cases hx,
    left,
    exact hAB hx,
    right,
    exact hx,
end

@[simp] lemma union_unions{X Y A: finset α} :(X ∪ A) ∪ (Y ∪ A) = (X ∪ Y ∪ A) :=
begin
    sorry,
end

@[simp] lemma inter_unions{X Y A: finset α} :(X ∪ A) ∩ (Y ∪ A) = (X ∩ Y) ∪ A :=
begin
    sorry,
end

end finset


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import algebra.order.chebyshev
import analysis.special_functions.pow
import order.partition.equipartition

/-!
# Numerical bounds for Szemerédi Regularity Lemma

This file gathers the numerical facts required by the proof of Szemerédi's regularity lemma.

This entire file is internal to the proof of Szemerédi Regularity Lemma.

## Main declarations

* `szemeredi_regularity.step_bound`: During the inductive step, a partition of size `n` is blown to
  size at most `step_bound n`.
* `szemeredi_regularity.initial_bound`: The size of the partition we start the induction with.
* `szemeredi_regularity.bound`: The upper bound on the size of the partition produced by our version
  of Szemerédi's regularity lemma.
-/

open finset fintype function real
open_locale big_operators

namespace szemeredi_regularity

/-- Auxiliary function for Szemerédi's regularity lemma. Blowing up a partition of size `n` during
the induction results in a partition of size at most `step_bound n`. -/
def step_bound (n : ℕ) : ℕ := n * 4 ^ n

lemma le_step_bound : id ≤ step_bound := λ n, nat.le_mul_of_pos_right $ pow_pos (by norm_num) n

lemma step_bound_mono : monotone step_bound :=
λ a b h, nat.mul_le_mul h $ nat.pow_le_pow_of_le_right (by norm_num) h

lemma step_bound_pos_iff {n : ℕ} : 0 < step_bound n ↔ 0 < n := zero_lt_mul_right $ by positivity

alias step_bound_pos_iff ↔ _ step_bound_pos

end szemeredi_regularity

open szemeredi_regularity

variables {α : Type*} [decidable_eq α] [fintype α] {P : finpartition (univ : finset α)}
  {u : finset α} {ε : ℝ}

local notation `m` := (card α/step_bound P.parts.card : ℕ)
local notation `a` := (card α/P.parts.card - m * 4^P.parts.card : ℕ)

namespace tactic
open positivity

private lemma eps_pos {ε : ℝ} {n : ℕ} (h : 100 ≤ 4 ^ n * ε^5) : 0 < ε :=
pow_bit1_pos_iff.1 $ pos_of_mul_pos_right (h.trans_lt' $ by norm_num) $ by positivity

private lemma m_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : 0 < m :=
nat.div_pos ((nat.mul_le_mul_left _ $ nat.pow_le_pow_of_le_left (by norm_num) _).trans hPα) $
  step_bound_pos (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos

/-- Local extension for the `positivity` tactic: A few facts that are needed many times for the
proof of Szemerédi's regularity lemma. -/
meta def positivity_szemeredi_regularity : expr → tactic strictness
| `(%%n / step_bound (finpartition.parts %%P).card) := do
    p ← to_expr
      ``((finpartition.parts %%P).card * 16^(finpartition.parts %%P).card ≤ %%n)
      >>= find_assumption,
    positive <$> mk_app ``m_pos [p]
| ε := do
    typ ← infer_type ε,
    unify typ `(ℝ),
    p ← to_expr ``(100 ≤ 4 ^ _ * %%ε ^ 5) >>= find_assumption,
    positive <$> mk_app ``eps_pos [p]

end tactic

local attribute [positivity] tactic.positivity_szemeredi_regularity

namespace szemeredi_regularity

lemma m_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : 0 < m := by positivity

lemma coe_m_add_one_pos : 0 < (m : ℝ) + 1 := by positivity

lemma one_le_m_coe [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : (1 : ℝ) ≤ m :=
nat.one_le_cast.2 $ m_pos hPα

lemma eps_pow_five_pos (hPε : 100 ≤ 4^P.parts.card * ε^5) : 0 < ε^5 :=
pos_of_mul_pos_right ((by norm_num : (0 : ℝ) < 100).trans_le hPε) $ pow_nonneg (by norm_num) _

lemma eps_pos (hPε : 100 ≤ 4^P.parts.card * ε^5) : 0 < ε :=
pow_bit1_pos_iff.1 $ eps_pow_five_pos hPε

lemma hundred_div_ε_pow_five_le_m [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α)
  (hPε : 100 ≤ 4^P.parts.card * ε^5) :
  100 / ε^5 ≤ m :=
(div_le_of_nonneg_of_le_mul (eps_pow_five_pos hPε).le (by positivity) hPε).trans
begin
  norm_cast,
  rwa [nat.le_div_iff_mul_le'(step_bound_pos (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos),
    step_bound, mul_left_comm, ←mul_pow],
end

lemma hundred_le_m [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α)
  (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε : ε ≤ 1) : 100 ≤ m :=
by exact_mod_cast (hundred_div_ε_pow_five_le_m hPα hPε).trans'
  (le_div_self (by norm_num) (by positivity) $ pow_le_one _ (by positivity) hε)

lemma a_add_one_le_four_pow_parts_card : a + 1 ≤ 4^P.parts.card :=
begin
  have h : 1 ≤ 4^P.parts.card := one_le_pow_of_one_le (by norm_num) _,
  rw [step_bound, ←nat.div_div_eq_div_mul, ←nat.le_sub_iff_right h, tsub_le_iff_left,
    ←nat.add_sub_assoc h],
  exact nat.le_pred_of_lt (nat.lt_div_mul_add h),
end

lemma card_aux₁ (hucard : u.card = m * 4^P.parts.card + a) :
  (4^P.parts.card - a) * m + a * (m + 1) = u.card :=
by rw [hucard, mul_add, mul_one, ←add_assoc, ←add_mul, nat.sub_add_cancel
  ((nat.le_succ _).trans a_add_one_le_four_pow_parts_card), mul_comm]

lemma card_aux₂ (hP : P.is_equipartition) (hu : u ∈ P.parts)
  (hucard : ¬u.card = m * 4^P.parts.card + a) :
  (4^P.parts.card - (a + 1)) * m + (a + 1) * (m + 1) = u.card :=
begin
  have : m * 4 ^ P.parts.card ≤ card α / P.parts.card,
  { rw [step_bound, ←nat.div_div_eq_div_mul],
    exact nat.div_mul_le_self _ _ },
  rw nat.add_sub_of_le this at hucard,
  rw [(hP.card_parts_eq_average hu).resolve_left hucard, mul_add, mul_one, ←add_assoc, ←add_mul,
    nat.sub_add_cancel a_add_one_le_four_pow_parts_card, ←add_assoc, mul_comm,
    nat.add_sub_of_le this, card_univ],
end

lemma pow_mul_m_le_card_part (hP : P.is_equipartition) (hu : u ∈ P.parts) :
  (4 : ℝ) ^ P.parts.card * m ≤ u.card :=
begin
  norm_cast,
  rw [step_bound, ←nat.div_div_eq_div_mul],
  exact (nat.mul_div_le _ _).trans (hP.average_le_card_part hu),
end

variables (P ε) (l : ℕ)

/-- Auxiliary function for Szemerédi's regularity lemma. The size of the partition by which we start
blowing. -/
noncomputable def initial_bound : ℕ := max 7 $ max l $ ⌊log (100 / ε^5) / log 4⌋₊ + 1

lemma le_initial_bound : l ≤ initial_bound ε l := (le_max_left _ _).trans $ le_max_right _ _
lemma seven_le_initial_bound : 7 ≤ initial_bound ε l := le_max_left _ _
lemma initial_bound_pos : 0 < initial_bound ε l :=
nat.succ_pos'.trans_le $ seven_le_initial_bound _ _

lemma hundred_lt_pow_initial_bound_mul {ε : ℝ} (hε : 0 < ε) (l : ℕ) :
  100 < 4^initial_bound ε l * ε^5 :=
begin
  rw [←rpow_nat_cast 4, ←div_lt_iff (pow_pos hε 5), lt_rpow_iff_log_lt _ zero_lt_four,
    ←div_lt_iff, initial_bound, nat.cast_max, nat.cast_max],
  { push_cast, exact lt_max_of_lt_right (lt_max_of_lt_right $ nat.lt_floor_add_one _) },
  { exact log_pos (by norm_num) },
  { exact div_pos (by norm_num) (pow_pos hε 5) }
end

/-- An explicit bound on the size of the equipartition whose existence is given by Szemerédi's
regularity lemma. -/
noncomputable def bound : ℕ :=
(step_bound^[⌊4 / ε^5⌋₊] $ initial_bound ε l) * 16 ^ (step_bound^[⌊4 / ε^5⌋₊] $ initial_bound ε l)

lemma initial_bound_le_bound : initial_bound ε l ≤ bound ε l :=
(id_le_iterate_of_id_le le_step_bound _ _).trans $ nat.le_mul_of_pos_right $ by positivity

lemma le_bound : l ≤ bound ε l := (le_initial_bound ε l).trans $ initial_bound_le_bound ε l
lemma bound_pos : 0 < bound ε l := (initial_bound_pos ε l).trans_le $ initial_bound_le_bound ε l

variables {ι 𝕜 : Type*} [linear_ordered_field 𝕜] (r : ι → ι → Prop) [decidable_rel r]
  {s t : finset ι} {x : 𝕜}

lemma mul_sq_le_sum_sq (hst : s ⊆ t) (f : ι → 𝕜) (hs : x^2 ≤ ((∑ i in s, f i) / s.card) ^ 2)
  (hs' : (s.card : 𝕜) ≠ 0) :
  (s.card : 𝕜) * x ^ 2 ≤ ∑ i in t, f i ^ 2 :=
(mul_le_mul_of_nonneg_left (hs.trans sum_div_card_sq_le_sum_sq_div_card) $
  nat.cast_nonneg _).trans $ (mul_div_cancel' _ hs').le.trans $ sum_le_sum_of_subset_of_nonneg hst $
    λ i _ _, sq_nonneg _

lemma add_div_le_sum_sq_div_card (hst : s ⊆ t) (f : ι → 𝕜) (d : 𝕜) (hx : 0 ≤ x)
  (hs : x ≤ |(∑ i in s, f i)/s.card - (∑ i in t, f i)/t.card|)
  (ht : d ≤ ((∑ i in t, f i)/t.card)^2) :
  d + s.card/t.card * x^2 ≤ (∑ i in t, f i^2)/t.card :=
begin
  obtain hscard | hscard := (s.card.cast_nonneg : (0 : 𝕜) ≤ s.card).eq_or_lt,
  { simpa [←hscard] using ht.trans sum_div_card_sq_le_sum_sq_div_card },
  have htcard : (0:𝕜) < t.card := hscard.trans_le (nat.cast_le.2 (card_le_of_subset hst)),
  have h₁ : x^2 ≤ ((∑ i in s, f i)/s.card - (∑ i in t, f i)/t.card)^2 :=
    sq_le_sq.2 (by rwa [abs_of_nonneg hx]),
  have h₂ : x^2 ≤ ((∑ i in s, (f i - (∑ j in t, f j)/t.card))/s.card)^2,
  { apply h₁.trans,
    rw [sum_sub_distrib, sum_const, nsmul_eq_mul, sub_div, mul_div_cancel_left _ hscard.ne'] },
  apply (add_le_add_right ht _).trans,
  rw [←mul_div_right_comm, le_div_iff htcard, add_mul, div_mul_cancel _ htcard.ne'],
  have h₃ := mul_sq_le_sum_sq hst (λ i, f i - (∑ j in t, f j) / t.card) h₂ hscard.ne',
  apply (add_le_add_left h₃ _).trans,
  simp [←mul_div_right_comm _ (t.card : 𝕜), sub_div' _ _ _ htcard.ne', ←sum_div, ←add_div, mul_pow,
    div_le_iff (sq_pos_of_ne_zero _ htcard.ne'), sub_sq, sum_add_distrib, ←sum_mul, ←mul_sum],
  ring_nf,
end

end szemeredi_regularity

namespace tactic
open positivity szemeredi_regularity

/-- Extension for the `positivity` tactic: `szemeredi_regularity.initial_bound` and
`szemeredi_regularity.bound` are always positive. -/
@[positivity]
meta def positivity_szemeredi_regularity_bound : expr → tactic strictness
| `(szemeredi_regularity.initial_bound %%ε %%l) := positive <$> mk_app ``initial_bound_pos [ε, l]
| `(szemeredi_regularity.bound %%ε %%l) := positive <$> mk_app ``bound_pos [ε, l]
| e := pp e >>= fail ∘ format.bracket "The expression `"
 "` isn't of the form `szemeredi_regularity.initial_bound ε l` nor `szemeredi_regularity.bound ε l`"

example (ε : ℝ) (l : ℕ) : 0 < szemeredi_regularity.initial_bound ε l := by positivity
example (ε : ℝ) (l : ℕ) : 0 < szemeredi_regularity.bound ε l := by positivity

end tactic