import category_theory.abelian.projective
import pseudo_normed_group.category
import topology.continuous_function.algebra

import algebra.group.ulift

import for_mathlib.abelian_sheaves.main
import for_mathlib.AddCommGroup.exact
import for_mathlib.types

import condensed.adjunctions
import condensed.top_comparison
import condensed.filtered_colimits

/-!
# Properties of the category of condensed abelian groups

-/

open category_theory category_theory.limits

universes v u

-- Move this!
-- @[simps obj map {fully_applied := ff}] -- we probably don't want these as global simp lemmas
/-- `Ab.ulift.{v u}` is the universe lifting functor sending the category of abelian groups in
  universe `u` into those in universe `max v u`. -/
def Ab.ulift : Ab.{u} ⥤ Ab.{max v u} :=
{ obj := λ M, AddCommGroup.of $ ulift.{v} M,
  map := λ M N f,
  { to_fun := λ x, ⟨f x.down⟩,
    map_zero' := by { ext1, apply f.map_zero },
    map_add' := λ x y, by { ext1, apply f.map_add } },
  map_id' := by { intros, ext, refl },
  map_comp' := by { intros, ext, refl } }

@[simp] lemma Ab.exact_ulift_map {A B C : Ab} (f : A ⟶ B) (g : B ⟶ C) :
  exact (Ab.ulift.map f) (Ab.ulift.map g) ↔ exact f g :=
begin
  let F := Ab.ulift.map f,
  let G := Ab.ulift.map g,
  change exact F G ↔ _,
  rw AddCommGroup.exact_iff,
  rw AddCommGroup.exact_iff,
  split,
  { intro h,
    apply le_antisymm,
    { rintros _ ⟨x,rfl⟩,
      have : ulift.up (f x) ∈ F.range := ⟨⟨x⟩, rfl⟩,
      rw h at this,
      change _ = _ at this,
      apply_fun (λ e, e.down) at this,
      exact this },
    { rintros x hx, change _ = _ at hx,
      have : ulift.up x ∈ G.ker, by { apply_fun ulift.up at hx, exact hx },
      rw ← h at this,
      obtain ⟨y,hy⟩ := this,
      apply_fun (λ e, e.down) at hy,
      rw ← hy,
      use [y.down, rfl] } },
  { intro h,
    apply le_antisymm,
    { rintros _ ⟨x,rfl⟩,
      ext,
      change _ ∈ g.ker,
      rw ← h,
      use [x.down, rfl] },
    { intros x hx,
      change _ = _ at hx,
      apply_fun (λ e, e.down) at hx,
      change _ ∈ g.ker at hx,
      rw ← h at hx,
      obtain ⟨y,hy⟩ := hx,
      use y,
      ext,
      exact hy } },
end

namespace Condensed

--instance : preadditive (Condensed Ab.{u+1}) := by admit

noncomputable theory

-- Sanity check
example {J : Type (u+1)} [small_category J] [is_filtered J] :
  limits.preserves_colimits_of_shape J (forget Ab.{u+1}) := by apply_instance

-- this is now available in `condensed/projective_resolutions.lean`...
--instance : enough_projectives (Condensed Ab.{u+1}) := by admit

instance : is_right_adjoint (Sheaf_to_presheaf _ _ : Condensed Ab.{u+1} ⥤ _) :=
{ left := presheaf_to_Sheaf _ _,
  adj := (sheafification_adjunction _ _) }

@[simps obj map {fully_applied := ff}]
def forget_to_CondensedType : Condensed Ab.{u+1} ⥤ CondensedSet :=
{ obj := λ F, ⟨F.val ⋙ forget _, begin
    cases F with F hF,
    rwa (presheaf.is_sheaf_iff_is_sheaf_forget _ _ (forget Ab)) at hF,
    apply_instance
  end ⟩,
  map := λ A B f, ⟨whisker_right f.val _⟩ }

instance : is_right_adjoint forget_to_CondensedType :=
{ left := CondensedSet_to_Condensed_Ab,
  adj := Condensed_Ab_CondensedSet_adjunction }

section

variables (A : Type u) [add_comm_group A] [topological_space A] [topological_add_group A]

def of_top_ab.presheaf : Profinite.{u}ᵒᵖ ⥤ Ab.{u} :=
{ obj := λ S, ⟨C(S.unop, A)⟩,
  map := λ S₁ S₂ f, add_monoid_hom.mk' (λ g, g.comp f.unop) $ λ g₁ g₂, rfl,
  map_id' := by { intros, ext, refl },
  map_comp' := by { intros, ext, refl } }

/-- The condensed abelian group associated with a topological abelian group -/
def of_top_ab : Condensed.{u} Ab.{u+1} :=
{ val := of_top_ab.presheaf A ⋙ Ab.ulift.{u+1},
  cond := begin
    rw category_theory.presheaf.is_sheaf_iff_is_sheaf_forget _ _ (forget Ab),
    swap, apply_instance,
    let B := Top.of A,
    change presheaf.is_sheaf _ B.to_Condensed.val,
    exact B.to_Condensed.cond,
  end }

variables {A} {B : Type u} [add_comm_group B] [topological_space B] [topological_add_group B]

def of_top_ab_map (f : A →+ B) (hf : continuous f) : of_top_ab A ⟶ of_top_ab B :=
{ val := whisker_right
  { app := λ S, begin
      refine add_monoid_hom.mk' (λ g, ⟨f ∘ (show C(↥(opposite.unop S), A), from g), hf.comp _⟩) _,
      { exact g.continuous },
      { intros, ext, exact f.map_add _ _, }
    end,
    naturality' := λ S T g, rfl, }
  Ab.ulift.{u+1} }

end

end Condensed

namespace CompHausFiltPseuNormGrp

open_locale nnreal
open pseudo_normed_group comphaus_filtered_pseudo_normed_group

def presheaf (A : CompHausFiltPseuNormGrp.{u}) (S : Profinite.{u}) : Type u :=
{ f : S → A // ∃ (c : ℝ≥0) (f₀ : S → filtration A c), continuous f₀ ∧ f = coe ∘ f₀ }

namespace presheaf

variables (A : CompHausFiltPseuNormGrp.{u}) (S : Profinite.{u})

@[ext]
lemma ext {A : CompHausFiltPseuNormGrp} {S : Profinite} (f g : presheaf A S) : f.1 = g.1 → f = g :=
subtype.ext

instance : has_zero (presheaf A S) := ⟨⟨0, 0, 0, continuous_zero, rfl⟩⟩

instance : has_neg (presheaf A S) :=
⟨λ f, ⟨-f.1,
  begin
    obtain ⟨_, c, f, hf, rfl⟩ := f,
    refine ⟨c, λ s, - f s, _, rfl⟩,
    exact (continuous_neg' c).comp hf
  end⟩⟩

instance : has_add (presheaf A S) :=
⟨λ f g, ⟨f.1 + g.1,
  begin
    obtain ⟨_, cf, f, hf, rfl⟩ := f,
    obtain ⟨_, cg, g, hg, rfl⟩ := g,
    refine ⟨cf + cg, λ s, ⟨f s + g s, add_mem_filtration (f s).2 (g s).2⟩, _, rfl⟩,
    have aux := (hf.prod_mk hg),
    exact (continuous_add' cf cg).comp aux,
  end⟩⟩

instance : has_sub (presheaf A S) :=
⟨λ f g, ⟨f.1 - g.1,
  begin
    obtain ⟨_, cf, f, hf, rfl⟩ := f,
    obtain ⟨_, cg, g, hg, rfl⟩ := g,
    refine ⟨cf + cg, λ s, ⟨f s - g s, sub_mem_filtration (f s).2 (g s).2⟩, _, rfl⟩,
    have aux := (hf.prod_mk ((continuous_neg' cg).comp hg)),
    simp only [sub_eq_add_neg],
    exact (continuous_add' cf cg).comp aux,
  end⟩⟩

variables {A S}

protected def nsmul (n : ℕ) (f : presheaf A S) : presheaf A S :=
⟨n • f.1,
begin
  obtain ⟨_, c, f, hf, rfl⟩ := f,
  refine ⟨n * c, λ s, ⟨n • f s, nat_smul_mem_filtration _ _ _ (f s).2⟩, _, rfl⟩,
  exact continuous_nsmul _ _ _ hf,
end⟩

protected def zsmul (n : ℤ) (f : presheaf A S) : presheaf A S :=
⟨n • f.1,
begin
  obtain ⟨_, c, f, hf, rfl⟩ := f,
  refine ⟨n.nat_abs * c, λ s, ⟨n • f s, int_smul_mem_filtration _ _ _ (f s).2⟩, _, rfl⟩,
  exact continuous_zsmul _ _ _ hf,
end⟩

variables (A S)

instance : add_comm_group (presheaf A S) :=
{ zero := 0,
  add := (+),
  nsmul := presheaf.nsmul,
  zsmul := presheaf.zsmul,
  add_assoc := by { intros, ext, exact add_assoc _ _ _ },
  zero_add := by { intros, ext, exact zero_add _ },
  add_zero := by { intros, ext, exact add_zero _ },
  add_comm := by { intros, ext, exact add_comm _ _ },
  add_left_neg := by { intros, ext, exact add_left_neg _ },
  sub_eq_add_neg := by { intros, ext, exact sub_eq_add_neg _ _ },
  nsmul_zero' := by { intros, ext, exact zero_nsmul _ },
  nsmul_succ' := by { intros, ext, exact succ_nsmul _ _ },
  zsmul_zero' := by { intros, ext, exact zero_zsmul _ },
  zsmul_succ' := by { intros, ext, exact add_comm_group.zsmul_succ' _ _ },
  zsmul_neg' := by { intros, ext, exact add_comm_group.zsmul_neg' _ _ },
  .. presheaf.has_sub A S, .. presheaf.has_neg A S }

@[simps apply {fully_applied := ff}]
def comap (A : CompHausFiltPseuNormGrp) {S T : Profinite} (φ : S ⟶ T) :
  presheaf A T →+ presheaf A S :=
{ to_fun := λ f, ⟨f.1 ∘ φ,
  begin
    obtain ⟨_, c, f, hf, rfl⟩ := f,
    refine ⟨c, f ∘ φ, hf.comp φ.continuous, rfl⟩,
  end⟩,
  map_zero' := rfl,
  map_add' := by { intros, refl } }

@[simps apply {fully_applied := ff}]
def map {A B : CompHausFiltPseuNormGrp} (φ : A ⟶ B) (S : Profinite) :
  presheaf A S →+ presheaf B S :=
{ to_fun := λ f, ⟨φ ∘ f.1,
  begin
    obtain ⟨_, c, f, hf, rfl⟩ := f,
    obtain ⟨d,hd⟩ := φ.bound,
    let e : filtration A c → filtration B (d * c) := λ t, ⟨φ t, hd t.2⟩,
    have he : continuous e,
    { apply φ.continuous, intros, refl },
    refine ⟨d * c, e ∘ f, he.comp hf, rfl⟩,
  end⟩,
  map_zero' := by { ext, exact φ.map_zero },
  map_add' := by { intros, ext, exact φ.map_add _ _ } }

end presheaf

open opposite

/--
Given `A : CompHausFiltPseuNormGrp`, this is the presheaf which sends a profinite set
`S` to the collection of functions `f : S → A` such that there exists some `r : ℝ≥0`
and some continuous map `g : S → A_{≤ r}`, where `f` is the composition of `g` with
the inclusion of `A_{≤ r}` into `A`.
This turns out to be a proetale sheaf, and thus defines a condensed abelian group.
See `to_Condensed` below.
-/
@[simps obj map {fully_applied := ff}]
def Presheaf (A : CompHausFiltPseuNormGrp.{u}) : Profinite.{u}ᵒᵖ ⥤ Ab :=
{ obj := λ S, ⟨presheaf A (unop S)⟩,
  map := λ S T φ, presheaf.comap A φ.unop,
  map_id' := by { intros, ext, refl },
  map_comp' := by { intros, ext, refl } }

@[simps app {fully_applied := ff}]
def Presheaf.map {A B : CompHausFiltPseuNormGrp} (φ : A ⟶ B) :
  Presheaf A ⟶ Presheaf B :=
{ app := λ S, presheaf.map φ (unop S),
  naturality' := by { intros, refl } }

@[simp]
lemma Presheaf.map_id (A : CompHausFiltPseuNormGrp) :
  Presheaf.map (𝟙 A) = 𝟙 _ := by { ext, refl }

@[simp]
lemma Presheaf.map_comp {A B C : CompHausFiltPseuNormGrp} (f : A ⟶ B) (g : B ⟶ C) :
  Presheaf.map (f ≫ g) = Presheaf.map f ≫ Presheaf.map g := by { ext, refl }

--set_option pp.universes true

lemma Presheaf_comp_ulift_is_sheaf_aux_equalizer
  (A : CompHausFiltPseuNormGrp.{u}) :
  (A.Presheaf ⋙ Ab.ulift.{u+1 u} ⋙ forget.{u+2 u+1 u+1} Ab.{u+1}).equalizer_condition :=
begin
  intros X B π hh,
  split,
  { rintros ⟨x⟩ ⟨y⟩ h,
    ext t,
    obtain ⟨t,rfl⟩ := hh t,
    apply_fun (λ e, e.val.down.val t) at h,
    exact h },
  { rintros ⟨⟨⟨t,c,t',ht',ht⟩⟩,h⟩,
    let E : Top := Top.of (filtration A c),
    let t'' : Profinite.to_Top.obj X ⟶ E := ⟨t',ht'⟩,
    have hw : Profinite.to_Top.{u}.map (Profinite.pullback.fst.{u} π π) ≫ t'' =
      Profinite.to_Top.{u}.map (Profinite.pullback.snd.{u} π π) ≫ t'',
    { dsimp at h,
      ext i,
      dsimp [Profinite.pullback.fst, Profinite.pullback.snd],
      apply_fun (λ e, e.down.val i) at h,
      change (coe ∘ t') i.val.fst = (coe ∘ t') i.val.snd,
      rw ← ht,
      exact h },
    let w := Profinite.descend_to_Top π t'' hh hw,
    refine ⟨⟨⟨_,c,w,w.2,rfl⟩⟩,_⟩,
    ext : 3,
    dsimp,
    rw ht,
    ext i,
    dsimp [CompHausFiltPseuNormGrp.Presheaf, Ab.ulift,
      functor.map_to_equalizer],
    have := Profinite.π_descend_to_Top π t'' hh hw,
    apply_fun (λ e, (e i).val) at this, exact this }
end

lemma Presheaf_comp_ulift_is_sheaf (A : CompHausFiltPseuNormGrp.{u}):
  presheaf.is_sheaf proetale_topology (Presheaf A ⋙ Ab.ulift.{u+1}) :=
begin
  rw category_theory.presheaf.is_sheaf_iff_is_sheaf_forget _ _ (forget Ab),
  swap, apply_instance,
  rw is_sheaf_iff_is_sheaf_of_type,
  erw (functor.is_proetale_sheaf_of_types_tfae
    (A.Presheaf ⋙ Ab.ulift.{u+1} ⋙ forget _)).out 0 5,
  refine ⟨_,_,_⟩,
  { dsimp [functor.empty_condition],
    split,
    { intros a b h, ext ⟨⟩ },
    { intros x, dsimp,
      refine ⟨⟨⟨λ x, x.elim, 0, λ x, x.elim, by continuity, _⟩⟩, _⟩,
      { ext ⟨⟩ },
      { cases x, refl } } },
  { intros X Y,
    split,
    { rintros ⟨x⟩ ⟨y⟩ h, dsimp at h,
      ext : 2,
      dsimp,
      ext (t|t),
      { apply_fun (λ e, e.fst.down.val t) at h, exact h },
      { apply_fun (λ e, e.snd.down.val t) at h, exact h } },
    { rintros ⟨⟨f,c,f',hf',hf⟩,⟨g,d,g',hg',hg⟩⟩,
      let p : X.sum Y → A := λ t, sum.rec_on t f g,
      let e : ℝ≥0 := c ⊔ d,
      haveI : fact (c ≤ e) := ⟨le_sup_left⟩,
      haveI : fact (d ≤ e) := ⟨le_sup_right⟩,
      let p' : X.sum Y → filtration A e :=
        λ t, sum.rec_on t (cast_le ∘ f') (cast_le ∘ g'),
      have hp' : continuous p',
      { have aux1 : p' ∘ sum.inl = cast_le ∘ f', by ext; refl,
        have aux2 : p' ∘ sum.inr = cast_le ∘ g', by ext; refl,
        simp only [continuous_sup_dom, continuous_coinduced_dom, aux1, aux2],
        exact ⟨(continuous_cast_le _ _).comp hf', (continuous_cast_le _ _).comp hg'⟩, },
      have hh : p = coe ∘ p',
      { ext (a|a),
        { apply_fun (λ u, u a) at hf, exact hf },
        { apply_fun (λ u, u a) at hg, exact hg } },
      refine ⟨⟨⟨p,e,p',hp',hh⟩⟩,_⟩,
      ext; refl } },
  { apply Presheaf_comp_ulift_is_sheaf_aux_equalizer }
end

/--
Given `A : CompHausFiltPseuNormGrp`, this is the condensed abeliian group
which, as a presheaf, sends a profinite set `S` to the collection of
functions `f : S → A` such that there exists some `r : ℝ≥0`
and some continuous map `g : S → A_{≤ r}`, where `f` is the composition of `g` with
the inclusion of `A_{≤ r}` into `A`.

NOTE: For silly universe reasons, we need to apply a `ulift` as well.
-/
@[simps obj map {fully_applied := ff}]
def to_Condensed : CompHausFiltPseuNormGrp.{u} ⥤ Condensed.{u} Ab.{u+1} :=
{ obj := λ A,
  { val := Presheaf A ⋙ Ab.ulift.{u+1},
    cond := Presheaf_comp_ulift_is_sheaf _ },
  map := λ A B f, ⟨whisker_right (Presheaf.map f) _⟩,
  map_id' := λ X, by { ext : 2, dsimp, simp },
  map_comp' := λ X Y Z f g, by { ext : 2, dsimp, simp } }

section

-- #check Top.to_Condensed

variables (A : CompHausFiltPseuNormGrp.{u})

@[simps]
def level : ℝ≥0 ⥤ CompHaus.{u} :=
{ obj := λ r, CompHaus.of $ filtration A r,
  map := λ r s h,
  { to_fun := cast_le' h.le,
    continuous_to_fun := by letI : fact (r ≤ s) := ⟨h.le⟩; exact continuous_cast_le _ _ },
  map_id' := λ r, by { ext, refl },
  map_comp' := λ r s t h1 h2, by { ext, refl } }

@[simps]
def level_Condensed_diagram : ℝ≥0 ⥤ CondensedSet.{u} :=
A.level ⋙ CompHaus_to_Top.{u} ⋙ Top_to_Condensed.{u}

@[simps]
def level_Condensed_diagram' : (as_small.{u+1} ℝ≥0) ⥤ CondensedSet.{u} :=
as_small.down ⋙ A.level_Condensed_diagram

def level_Condensed_diagram_cocone :
  cocone A.level_Condensed_diagram' :=
{ X := Condensed_Ab_to_CondensedSet.obj (to_Condensed.obj A),
  ι :=
  { app := λ r, Sheaf.hom.mk $
    { app := λ S f, ulift.up $ ⟨_, ulift.down r, f.down.1, f.down.2, rfl⟩,
      naturality' := λ S T f, by { ext, refl } },
    naturality' := λ r s h, by { ext, refl } } } .

def colimit_iso_Condensed_obj_aux_fun (X) :
let E := A.level_Condensed_diagram' ⋙ Sheaf_to_presheaf _ _ ⋙ (evaluation _ _).obj (op X) in
  (types.filtered_colimit_cocone E).X → A.presheaf X :=
let E := A.level_Condensed_diagram' ⋙ Sheaf_to_presheaf _ _ ⋙ (evaluation _ _).obj (op X) in
λ t, @quotient.lift_on' (Σ (j : as_small.{u+1} ℝ≥0), E.obj j) (A.presheaf X)
  (types.filtered_colimit_setoid E) t
  (λ f, ⟨_,ulift.down f.1, f.2.down.1, f.2.down.2, rfl⟩) begin
    rintros ⟨i,x⟩ ⟨j,y⟩ ⟨e,u,v,h⟩,
    ext q : 2,
    dsimp [level_Condensed_diagram, level_Condensed_diagram'] at *,
    apply_fun (λ e, (e.down q).1) at h, exact h
  end

lemma colimit_iso_Condensed_obj_aux_fun_bijective (X) :
  function.bijective (colimit_iso_Condensed_obj_aux_fun A X) :=
begin
  split,
  { rintros ⟨⟨⟨i⟩,f⟩⟩ ⟨⟨⟨j⟩,g⟩⟩ h, dsimp [colimit_iso_Condensed_obj_aux_fun] at h ⊢,
    simp only [subtype.mk_eq_mk] at h,
    apply quotient.sound',
    use [⟨i ⊔ j⟩, ⟨le_sup_left⟩, ⟨le_sup_right⟩],
    ext q,
    dsimp [level_Condensed_diagram'], apply_fun (λ e, e q) at h, exact h },
  { rintros ⟨f,c,g,hg,hf⟩,
    use quotient.mk' ⟨⟨c⟩,⟨⟨g,hg⟩⟩⟩, ext tt, dsimp, rw hf, refl }
end

-- We would have to use `some` to define the inverse of this equiv, so we may as well just use
-- `equiv.of_bijective`
@[simps]
def colimit_iso_Condensed_obj_aux (X) :
let E := A.level_Condensed_diagram' ⋙ Sheaf_to_presheaf _ _ ⋙ (evaluation _ _).obj (op X) in
  (types.filtered_colimit_cocone E).X ≃ A.presheaf X :=
equiv.of_bijective (A.colimit_iso_Condensed_obj_aux_fun X)
(A.colimit_iso_Condensed_obj_aux_fun_bijective X)

/-
let E := A.level_Condensed_diagram' ⋙ Sheaf_to_presheaf _ _ ⋙ (evaluation _ _).obj (op X) in
  (types.filtered_colimit_cocone E).X ≃ A.presheaf X :=
let E := A.level_Condensed_diagram' ⋙ Sheaf_to_presheaf _ _ ⋙ (evaluation _ _).obj (op X) in
equiv.of_bijective
(λ t, @quotient.lift_on' (Σ (j : as_small.{u+1} ℝ≥0), E.obj j) (A.presheaf X)
  (types.filtered_colimit_setoid E) t
  (λ f, ⟨_,ulift.down f.1, f.2.down.1, f.2.down.2, rfl⟩) begin
    rintros ⟨i,x⟩ ⟨j,y⟩ ⟨e,u,v,h⟩,
    ext q : 2,
    dsimp [level_Condensed_diagram, level_Condensed_diagram'] at *,
    apply_fun (λ e, (e.down q).1) at h, exact h
  end)
begin
  split,
  { rintros ⟨⟨⟨i⟩,f⟩⟩ ⟨⟨⟨j⟩,g⟩⟩ h, dsimp at h ⊢, apply quotient.sound',
    simp only [subtype.mk_eq_mk] at h, use [⟨i ⊔ j⟩, ⟨le_sup_left⟩, ⟨le_sup_right⟩],
    ext q,
    dsimp [level_Condensed_diagram'], apply_fun (λ e, e q) at h, exact h },
  { rintros ⟨f,c,g,hg,hf⟩,
    use quotient.mk' ⟨⟨c⟩,⟨⟨g,hg⟩⟩⟩, ext tt, dsimp, rw hf }
end
-/

def colimit_iso_Condensed_obj_aux_nat_iso :
  (filtered_cocone.{u} A.level_Condensed_diagram').X.val ≅
  (Condensed_Ab_to_CondensedSet.{u}.obj (to_Condensed.{u}.obj A)).val :=
  nat_iso.of_components (λ X,
    (is_colimit_of_preserves ((evaluation _ _).obj X)
      (colimit.is_colimit (A.level_Condensed_diagram' ⋙
        Sheaf_to_presheaf _ _))).cocone_point_unique_up_to_iso (colimit.is_colimit _) ≪≫
    (colimit.is_colimit _).cocone_point_unique_up_to_iso
    (types.filtered_colimit_cocone_is_colimit _) ≪≫
    equiv.to_iso ((A.colimit_iso_Condensed_obj_aux X.unop).trans equiv.ulift.symm)
  )
begin
  intros X Y f, dsimp [is_colimit.cocone_point_unique_up_to_iso],
  apply
    (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ (Type (u+1))).obj X)
    (colimit.is_colimit (A.level_Condensed_diagram' ⋙
    Sheaf_to_presheaf proetale_topology (Type (u+1))))).hom_ext,
  intros j, simp only [category.assoc],
  slice_lhs 0 1
  { dsimp, rw ← nat_trans.naturality },
  slice_lhs 2 3
  { erw ((is_colimit_of_preserves ((evaluation Profiniteᵒᵖ (Type (u+1))).obj Y)
      (colimit.is_colimit (A.level_Condensed_diagram' ⋙
      Sheaf_to_presheaf proetale_topology (Type (u+1)))))).fac },
  slice_lhs 2 3
  { erw colimit.ι_desc },
  slice_rhs 1 2
  { erw (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ (Type (u+1))).obj X)
    (colimit.is_colimit (A.level_Condensed_diagram' ⋙
    Sheaf_to_presheaf proetale_topology (Type (u+1))))).fac },
  slice_rhs 1 2
  { erw colimit.ι_desc },
  ext, refl
end

def colimit_iso_Condensed_obj :
  colimit A.level_Condensed_diagram' ≅ Condensed_Ab_to_CondensedSet.obj (to_Condensed.obj A) :=
(colimit.is_colimit _).cocone_point_unique_up_to_iso (filtered_cocone_is_colimit _) ≪≫
  Sheaf.iso.mk _ (Condensed_Ab_to_CondensedSet.{u}.obj (to_Condensed.{u}.obj A))
    A.colimit_iso_Condensed_obj_aux_nat_iso

def colimit_to_Condensed_obj :
  colimit A.level_Condensed_diagram' ⟶ Condensed_Ab_to_CondensedSet.obj (to_Condensed.obj A) :=
colimit.desc _ A.level_Condensed_diagram_cocone

instance is_iso_colimit_to_Condensed_obj : is_iso A.colimit_to_Condensed_obj :=
begin
  suffices : A.colimit_to_Condensed_obj =
    A.colimit_iso_Condensed_obj.hom, by { rw this, apply_instance },
  dsimp [colimit_iso_Condensed_obj, colimit_to_Condensed_obj],
  apply colimit.hom_ext, intros i,
  dsimp [is_colimit.cocone_point_unique_up_to_iso],
  rw [colimit.ι_desc, colimit.ι_desc_assoc],
  dsimp [Sheaf.iso.mk],
  ext T : 3, dsimp,
  rw ← nat_trans.comp_app,
  dsimp [colimit_iso_Condensed_obj_aux_nat_iso, nat_iso.of_components],
  slice_rhs 1 2
  { erw (is_colimit_of_preserves ((evaluation Profiniteᵒᵖ (Type (u+1))).obj T)
      (colimit.is_colimit (A.level_Condensed_diagram' ⋙
      Sheaf_to_presheaf proetale_topology (Type (u+1))))).fac },
  slice_rhs 1 2 { erw colimit.ι_desc },
  ext, refl,
end

end

end CompHausFiltPseuNormGrp

@[simps obj map {fully_applied := ff}]
def CompHausFiltPseuNormGrp₁.to_Condensed :
  CompHausFiltPseuNormGrp₁.{u} ⥤ Condensed.{u} Ab.{u+1} :=
CHFPNG₁_to_CHFPNGₑₗ ⋙ CompHausFiltPseuNormGrp.to_Condensed


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Quotient types.

! This file was ported from Lean 3 source module init.data.quot
! leanprover-community/mathlib commit de855f9965c69f6818f97edaea7d937e24ef678a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Sigma.Basic
import Leanbin.Init.Logic
import Leanbin.Init.Propext
import Leanbin.Init.Data.Setoid

-- We import propext here, otherwise we would need a quot.lift for propositions.
universe u v

-- iff can now be used to do substitutions in a calculation
@[subst]
theorem iff_subst {a b : Prop} {p : Prop → Prop} (h₁ : a ↔ b) (h₂ : p a) : p b :=
  Eq.subst (propext h₁) h₂
#align iff_subst iff_subst

namespace Quot

#print Quot.sound /-
axiom sound : ∀ {α : Sort u} {r : α → α → Prop} {a b : α}, r a b → Quot.mk r a = Quot.mk r b
#align quot.sound Quot.sound
-/

attribute [elab_as_elim] lift ind

/- warning: quot.lift_beta -> Quot.lift_mk is a dubious translation:
lean 3 declaration is
  forall {α : Sort.{u1}} {r : α -> α -> Prop} {β : Sort.{u2}} (f : α -> β) (c : forall (a : α) (b : α), (r a b) -> (Eq.{u2} β (f a) (f b))) (a : α), Eq.{u2} β (Quot.lift.{u1, u2} α (fun (a : α) (b : α) => r a b) β f c (Quot.mk.{u1} α r a)) (f a)
but is expected to have type
  forall {α : Sort.{u1}} {r : Sort.{u2}} {β : α -> α -> Prop} (f : α -> r) (c : forall (a : α) (b : α), (β a b) -> (Eq.{u2} r (f a) (f b))) (a : α), Eq.{u2} r (Quot.lift.{u1, u2} α (fun (a : α) (b : α) => β a b) r f c (Quot.mk.{u1} α β a)) (f a)
Case conversion may be inaccurate. Consider using '#align quot.lift_beta Quot.lift_mkₓ'. -/
protected theorem lift_mk {α : Sort u} {r : α → α → Prop} {β : Sort v} (f : α → β)
    (c : ∀ a b, r a b → f a = f b) (a : α) : lift f c (Quot.mk r a) = f a :=
  rfl
#align quot.lift_beta Quot.lift_mk

protected theorem ind_beta {α : Sort u} {r : α → α → Prop} {β : Quot r → Prop}
    (p : ∀ a, β (Quot.mk r a)) (a : α) : (ind p (Quot.mk r a) : β (Quot.mk r a)) = p a :=
  rfl
#align quot.ind_beta Quot.ind_beta

#print Quot.liftOn /-
@[reducible, elab_as_elim]
protected def liftOn {α : Sort u} {β : Sort v} {r : α → α → Prop} (q : Quot r) (f : α → β)
    (c : ∀ a b, r a b → f a = f b) : β :=
  lift f c q
#align quot.lift_on Quot.liftOn
-/

#print Quot.inductionOn /-
@[elab_as_elim]
protected theorem inductionOn {α : Sort u} {r : α → α → Prop} {β : Quot r → Prop} (q : Quot r)
    (h : ∀ a, β (Quot.mk r a)) : β q :=
  ind h q
#align quot.induction_on Quot.inductionOn
-/

#print Quot.exists_rep /-
theorem exists_rep {α : Sort u} {r : α → α → Prop} (q : Quot r) : ∃ a : α, Quot.mk r a = q :=
  Quot.inductionOn q fun a => ⟨a, rfl⟩
#align quot.exists_rep Quot.exists_rep
-/

section

variable {α : Sort u}

variable {r : α → α → Prop}

variable {β : Quot r → Sort v}

-- mathport name: «expr⟦ ⟧»
local notation:arg "⟦" a "⟧" => Quot.mk r a

#print Quot.indep /-
@[reducible]
protected def indep (f : ∀ a, β ⟦a⟧) (a : α) : PSigma β :=
  ⟨⟦a⟧, f a⟩
#align quot.indep Quot.indep
-/

protected theorem indep_coherent (f : ∀ a, β ⟦a⟧)
    (h : ∀ (a b : α) (p : r a b), (Eq.ndrec (f a) (sound p) : β ⟦b⟧) = f b) :
    ∀ a b, r a b → Quot.indep f a = Quot.indep f b := fun a b e => PSigma.eq (sound e) (h a b e)
#align quot.indep_coherent Quot.indep_coherent

protected theorem lift_indep_pr1 (f : ∀ a, β ⟦a⟧)
    (h : ∀ (a b : α) (p : r a b), (Eq.ndrec (f a) (sound p) : β ⟦b⟧) = f b) (q : Quot r) :
    (lift (Quot.indep f) (Quot.indep_coherent f h) q).1 = q :=
  Quot.ind (fun a : α => Eq.refl (Quot.indep f a).1) q
#align quot.lift_indep_pr1 Quot.lift_indep_pr1

#print Quot.rec /-
@[reducible, elab_as_elim]
protected def rec (f : ∀ a, β ⟦a⟧)
    (h : ∀ (a b : α) (p : r a b), (Eq.ndrec (f a) (sound p) : β ⟦b⟧) = f b) (q : Quot r) : β q :=
  Eq.recOn (Quot.lift_indep_pr1 f h q) (lift (Quot.indep f) (Quot.indep_coherent f h) q).2
#align quot.rec Quot.rec
-/

#print Quot.recOn' /-
@[reducible, elab_as_elim]
protected def recOn' (q : Quot r) (f : ∀ a, β ⟦a⟧)
    (h : ∀ (a b : α) (p : r a b), (Eq.ndrec (f a) (sound p) : β ⟦b⟧) = f b) : β q :=
  Quot.rec f h q
#align quot.rec_on Quot.recOn'
-/

#print Quot.recOnSubsingleton' /-
@[reducible, elab_as_elim]
protected def recOnSubsingleton' [h : ∀ a, Subsingleton (β ⟦a⟧)] (q : Quot r) (f : ∀ a, β ⟦a⟧) :
    β q :=
  Quot.rec f (fun a b h => Subsingleton.elim _ (f b)) q
#align quot.rec_on_subsingleton Quot.recOnSubsingleton'
-/

#print Quot.hrecOn /-
@[reducible, elab_as_elim]
protected def hrecOn (q : Quot r) (f : ∀ a, β ⟦a⟧) (c : ∀ (a b : α) (p : r a b), HEq (f a) (f b)) :
    β q :=
  Quot.recOn' q f fun a b p =>
    eq_of_hEq
      (calc
        HEq (Eq.ndrec (f a) (sound p) : β ⟦b⟧) (f a) := eq_rec_hEq (sound p) (f a)
        HEq _ (f b) := c a b p
        )
#align quot.hrec_on Quot.hrecOn
-/

end

end Quot

#print Quotient /-
def Quotient {α : Sort u} (s : Setoid α) :=
  @Quot α Setoid.r
#align quotient Quotient
-/

namespace Quotient

#print Quotient.mk' /-
protected def mk' {α : Sort u} [s : Setoid α] (a : α) : Quotient s :=
  Quot.mk Setoid.r a
#align quotient.mk Quotient.mk'
-/

-- mathport name: «expr⟦ ⟧»
notation:arg "⟦" a "⟧" => Quotient.mk' a

#print Quotient.sound /-
theorem sound {α : Sort u} [s : Setoid α] {a b : α} : a ≈ b → ⟦a⟧ = ⟦b⟧ :=
  Quot.sound
#align quotient.sound Quotient.sound
-/

#print Quotient.lift /-
@[reducible, elab_as_elim]
protected def lift {α : Sort u} {β : Sort v} [s : Setoid α] (f : α → β) :
    (∀ a b, a ≈ b → f a = f b) → Quotient s → β :=
  Quot.lift f
#align quotient.lift Quotient.lift
-/

#print Quotient.ind /-
@[elab_as_elim]
protected theorem ind {α : Sort u} [s : Setoid α] {β : Quotient s → Prop} :
    (∀ a, β ⟦a⟧) → ∀ q, β q :=
  Quot.ind
#align quotient.ind Quotient.ind
-/

#print Quotient.liftOn /-
@[reducible, elab_as_elim]
protected def liftOn {α : Sort u} {β : Sort v} [s : Setoid α] (q : Quotient s) (f : α → β)
    (c : ∀ a b, a ≈ b → f a = f b) : β :=
  Quot.liftOn q f c
#align quotient.lift_on Quotient.liftOn
-/

#print Quotient.inductionOn /-
@[elab_as_elim]
protected theorem inductionOn {α : Sort u} [s : Setoid α] {β : Quotient s → Prop} (q : Quotient s)
    (h : ∀ a, β ⟦a⟧) : β q :=
  Quot.inductionOn q h
#align quotient.induction_on Quotient.inductionOn
-/

#print Quotient.exists_rep /-
theorem exists_rep {α : Sort u} [s : Setoid α] (q : Quotient s) : ∃ a : α, ⟦a⟧ = q :=
  Quot.exists_rep q
#align quotient.exists_rep Quotient.exists_rep
-/

section

variable {α : Sort u}

variable [s : Setoid α]

variable {β : Quotient s → Sort v}

#print Quotient.rec /-
protected def rec (f : ∀ a, β ⟦a⟧)
    (h : ∀ (a b : α) (p : a ≈ b), (Eq.ndrec (f a) (Quotient.sound p) : β ⟦b⟧) = f b)
    (q : Quotient s) : β q :=
  Quot.rec f h q
#align quotient.rec Quotient.rec
-/

#print Quotient.recOn /-
@[reducible, elab_as_elim]
protected def recOn (q : Quotient s) (f : ∀ a, β ⟦a⟧)
    (h : ∀ (a b : α) (p : a ≈ b), (Eq.ndrec (f a) (Quotient.sound p) : β ⟦b⟧) = f b) : β q :=
  Quot.recOn' q f h
#align quotient.rec_on Quotient.recOn
-/

#print Quotient.recOnSubsingleton /-
@[reducible, elab_as_elim]
protected def recOnSubsingleton [h : ∀ a, Subsingleton (β ⟦a⟧)] (q : Quotient s) (f : ∀ a, β ⟦a⟧) :
    β q :=
  @Quot.recOnSubsingleton' _ _ _ h q f
#align quotient.rec_on_subsingleton Quotient.recOnSubsingleton
-/

#print Quotient.hrecOn /-
@[reducible, elab_as_elim]
protected def hrecOn (q : Quotient s) (f : ∀ a, β ⟦a⟧)
    (c : ∀ (a b : α) (p : a ≈ b), HEq (f a) (f b)) : β q :=
  Quot.hrecOn q f c
#align quotient.hrec_on Quotient.hrecOn
-/

end

section

universe u_a u_b u_c

variable {α : Sort u_a} {β : Sort u_b} {φ : Sort u_c}

variable [s₁ : Setoid α] [s₂ : Setoid β]

include s₁ s₂

#print Quotient.lift₂ /-
@[reducible, elab_as_elim]
protected def lift₂ (f : α → β → φ) (c : ∀ a₁ a₂ b₁ b₂, a₁ ≈ b₁ → a₂ ≈ b₂ → f a₁ a₂ = f b₁ b₂)
    (q₁ : Quotient s₁) (q₂ : Quotient s₂) : φ :=
  Quotient.lift
    (fun a₁ : α => Quotient.lift (f a₁) (fun a b : β => c a₁ a a₁ b (Setoid.refl a₁)) q₂)
    (fun (a b : α) (h : a ≈ b) =>
      @Quotient.ind β s₂
        (fun a_1 : Quotient s₂ =>
          Quotient.lift (f a) (fun a_1 b : β => c a a_1 a b (Setoid.refl a)) a_1 =
            Quotient.lift (f b) (fun a b_1 : β => c b a b b_1 (Setoid.refl b)) a_1)
        (fun a' : β => c a a' b a' h (Setoid.refl a')) q₂)
    q₁
#align quotient.lift₂ Quotient.lift₂
-/

#print Quotient.liftOn₂ /-
@[reducible, elab_as_elim]
protected def liftOn₂ (q₁ : Quotient s₁) (q₂ : Quotient s₂) (f : α → β → φ)
    (c : ∀ a₁ a₂ b₁ b₂, a₁ ≈ b₁ → a₂ ≈ b₂ → f a₁ a₂ = f b₁ b₂) : φ :=
  Quotient.lift₂ f c q₁ q₂
#align quotient.lift_on₂ Quotient.liftOn₂
-/

#print Quotient.ind₂ /-
@[elab_as_elim]
protected theorem ind₂ {φ : Quotient s₁ → Quotient s₂ → Prop} (h : ∀ a b, φ ⟦a⟧ ⟦b⟧)
    (q₁ : Quotient s₁) (q₂ : Quotient s₂) : φ q₁ q₂ :=
  Quotient.ind (fun a₁ => Quotient.ind (fun a₂ => h a₁ a₂) q₂) q₁
#align quotient.ind₂ Quotient.ind₂
-/

@[elab_as_elim]
protected theorem induction_on₂ {φ : Quotient s₁ → Quotient s₂ → Prop} (q₁ : Quotient s₁)
    (q₂ : Quotient s₂) (h : ∀ a b, φ ⟦a⟧ ⟦b⟧) : φ q₁ q₂ :=
  Quotient.ind (fun a₁ => Quotient.ind (fun a₂ => h a₁ a₂) q₂) q₁
#align quotient.induction_on₂ Quotient.induction_on₂

@[elab_as_elim]
protected theorem induction_on₃ [s₃ : Setoid φ] {δ : Quotient s₁ → Quotient s₂ → Quotient s₃ → Prop}
    (q₁ : Quotient s₁) (q₂ : Quotient s₂) (q₃ : Quotient s₃) (h : ∀ a b c, δ ⟦a⟧ ⟦b⟧ ⟦c⟧) :
    δ q₁ q₂ q₃ :=
  Quotient.ind (fun a₁ => Quotient.ind (fun a₂ => Quotient.ind (fun a₃ => h a₁ a₂ a₃) q₃) q₂) q₁
#align quotient.induction_on₃ Quotient.induction_on₃

end

section Exact

variable {α : Sort u}

variable [s : Setoid α]

include s

private def rel (q₁ q₂ : Quotient s) : Prop :=
  Quotient.liftOn₂ q₁ q₂ (fun a₁ a₂ => a₁ ≈ a₂) fun a₁ a₂ b₁ b₂ a₁b₁ a₂b₂ =>
    propext
      (Iff.intro (fun a₁a₂ => Setoid.trans (Setoid.symm a₁b₁) (Setoid.trans a₁a₂ a₂b₂)) fun b₁b₂ =>
        Setoid.trans a₁b₁ (Setoid.trans b₁b₂ (Setoid.symm a₂b₂)))
#align quotient.rel quotient.rel

-- mathport name: «expr ~ »
local infixl:50 " ~ " => Rel

private theorem rel.refl : ∀ q : Quotient s, q ~ q := fun q =>
  Quot.inductionOn q fun a => Setoid.refl a
#align quotient.rel.refl quotient.rel.refl

private theorem eq_imp_rel {q₁ q₂ : Quotient s} : q₁ = q₂ → q₁ ~ q₂ := fun h =>
  Eq.recOn h (Rel.refl q₁)
#align quotient.eq_imp_rel quotient.eq_imp_rel

#print Quotient.exact /-
theorem exact {a b : α} : ⟦a⟧ = ⟦b⟧ → a ≈ b := fun h => eq_imp_rel h
#align quotient.exact Quotient.exact
-/

end Exact

section

universe u_a u_b u_c

variable {α : Sort u_a} {β : Sort u_b}

variable [s₁ : Setoid α] [s₂ : Setoid β]

include s₁ s₂

#print Quotient.recOnSubsingleton₂ /-
@[reducible, elab_as_elim]
protected def recOnSubsingleton₂ {φ : Quotient s₁ → Quotient s₂ → Sort u_c}
    [h : ∀ a b, Subsingleton (φ ⟦a⟧ ⟦b⟧)] (q₁ : Quotient s₁) (q₂ : Quotient s₂)
    (f : ∀ a b, φ ⟦a⟧ ⟦b⟧) : φ q₁ q₂ :=
  @Quotient.recOnSubsingleton _ s₁ (fun q => φ q q₂) (fun a => Quotient.ind (fun b => h a b) q₂) q₁
    fun a => Quotient.recOnSubsingleton q₂ fun b => f a b
#align quotient.rec_on_subsingleton₂ Quotient.recOnSubsingleton₂
-/

end

end Quotient

section

variable {α : Type u}

variable (r : α → α → Prop)

#print EqvGen /-
inductive EqvGen : α → α → Prop
  | Rel : ∀ x y, r x y → EqvGen x y
  | refl : ∀ x, EqvGen x x
  | symm : ∀ x y, EqvGen x y → EqvGen y x
  | trans : ∀ x y z, EqvGen x y → EqvGen y z → EqvGen x z
#align eqv_gen EqvGen
-/

#print EqvGen.is_equivalence /-
theorem EqvGen.is_equivalence : Equivalence (@EqvGen α r) :=
  Equivalence.mk _ EqvGen.refl EqvGen.symm EqvGen.trans
#align eqv_gen.is_equivalence EqvGen.is_equivalence
-/

#print EqvGen.Setoid /-
def EqvGen.Setoid : Setoid α :=
  Setoid.mk _ (EqvGen.is_equivalence r)
#align eqv_gen.setoid EqvGen.Setoid
-/

#print Quot.exact /-
theorem Quot.exact {a b : α} (H : Quot.mk r a = Quot.mk r b) : EqvGen r a b :=
  @Quotient.exact _ (EqvGen.Setoid r) a b
    (@congr_arg _ _ _ _
      (Quot.lift (@Quotient.mk' _ (EqvGen.Setoid r)) fun x y h => Quot.sound (EqvGen.rel x y h)) H)
#align quot.exact Quot.exact
-/

#print Quot.EqvGen_sound /-
theorem Quot.EqvGen_sound {r : α → α → Prop} {a b : α} (H : EqvGen r a b) :
    Quot.mk r a = Quot.mk r b :=
  EqvGen.rec_on H (fun x y h => Quot.sound h) (fun x => rfl) (fun x y _ IH => Eq.symm IH)
    fun x y z _ _ IH₁ IH₂ => Eq.trans IH₁ IH₂
#align quot.eqv_gen_sound Quot.EqvGen_sound
-/

end

open Decidable

instance {α : Sort u} {s : Setoid α} [d : ∀ a b : α, Decidable (a ≈ b)] :
    DecidableEq (Quotient s) := fun q₁ q₂ : Quotient s =>
  Quotient.recOnSubsingleton₂ q₁ q₂ fun a₁ a₂ =>
    match d a₁ a₂ with
    | is_true h₁ => isTrue (Quotient.sound h₁)
    | is_false h₂ => isFalse fun h => absurd (Quotient.exact h) h₂


/-
Copyright (c) 2021 Luke Kershaw. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Luke Kershaw
-/
import category_theory.preadditive.additive_functor
import category_theory.shift
import category_theory.triangulated.rotate

/-!
# Pretriangulated Categories

This file contains the definition of pretriangulated categories and triangulated functors
between them.

## Implementation Notes

We work under the assumption that pretriangulated categories are preadditive categories,
but not necessarily additive categories, as is assumed in some sources.

TODO: generalise this to n-angulated categories as in https://arxiv.org/abs/1006.4592
-/

noncomputable theory

open category_theory
open category_theory.preadditive
open category_theory.limits

universes v v₀ v₁ v₂ u u₀ u₁ u₂

namespace category_theory.triangulated
open category_theory.category

/-
We work in an preadditive category `C` equipped with an additive shift.
-/
variables (C : Type u) [category.{v} C] [has_zero_object C] [has_shift C] [preadditive C]
  [functor.additive (shift C).functor]

/--
A preadditive category `C` with an additive shift, and a class of "distinguished triangles"
relative to that shift is called pretriangulated if the following hold:
* Any triangle that is isomorphic to a distinguished triangle is also distinguished.
* Any triangle of the form `(X,X,0,id,0,0)` is distinguished.
* For any morphism `f : X ⟶ Y` there exists a distinguished triangle of the form `(X,Y,Z,f,g,h)`.
* The triangle `(X,Y,Z,f,g,h)` is distinguished if and only if `(Y,Z,X⟦1⟧,g,h,-f⟦1⟧)` is.
* Given a diagram:
  ```
        f       g       h
    X  ───> Y  ───> Z  ───> X⟦1⟧
    │       │                │
    │a      │b               │a⟦1⟧'
    V       V                V
    X' ───> Y' ───> Z' ───> X'⟦1⟧
        f'      g'      h'
  ```
  where the left square commutes, and whose rows are distinguished triangles,
  there exists a morphism `c : Z ⟶ Z'` such that `(a,b,c)` is a triangle morphism.
See https://stacks.math.columbia.edu/tag/0145
-/
class pretriangulated :=
(distinguished_triangles [] : set (triangle C))
(isomorphic_distinguished : Π (T₁ ∈ distinguished_triangles) (T₂ : triangle C) (T₁ ≅ T₂),
  T₂ ∈ distinguished_triangles)
(contractible_distinguished : Π (X : C), (contractible_triangle C X) ∈ distinguished_triangles)
(distinguished_cocone_triangle : Π (X Y : C) (f: X ⟶ Y), (∃ (Z : C) (g : Y ⟶ Z) (h : Z ⟶ X⟦1⟧),
  triangle.mk _ f g h ∈ distinguished_triangles))
(rotate_distinguished_triangle : Π (T : triangle C),
  T ∈ distinguished_triangles ↔ T.rotate ∈ distinguished_triangles)
(complete_distinguished_triangle_morphism : Π (T₁ T₂ : triangle C)
  (h₁ : T₁ ∈ distinguished_triangles) (h₂ : T₂ ∈ distinguished_triangles) (a : T₁.obj₁ ⟶ T₂.obj₁)
  (b : T₁.obj₂ ⟶ T₂.obj₂) (comm₁ : T₁.mor₁ ≫ b = a ≫ T₂.mor₁),
  (∃ (c : T₁.obj₃ ⟶ T₂.obj₃), (T₁.mor₂ ≫ c = b ≫ T₂.mor₂) ∧ (T₁.mor₃ ≫ a⟦1⟧' = c ≫ T₂.mor₃) ))

namespace pretriangulated
variables [pretriangulated C]

notation `dist_triang`:20 C := distinguished_triangles C
/--
Given any distinguished triangle `T`, then we know `T.rotate` is also distinguished.
-/
lemma rot_of_dist_triangle (T ∈ dist_triang C) : (T.rotate ∈ dist_triang C) :=
(rotate_distinguished_triangle T).mp H

/--
Given any distinguished triangle `T`, then we know `T.inv_rotate` is also distinguished.
-/
lemma inv_rot_of_dist_triangle (T ∈ dist_triang C) : (T.inv_rotate ∈ dist_triang C) :=
(rotate_distinguished_triangle (T.inv_rotate)).mpr
  (isomorphic_distinguished T H (T.inv_rotate.rotate) T (inv_rot_comp_rot.symm.app T))

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `f ≫ g = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₁₂ (T ∈ dist_triang C) : T.mor₁ ≫ T.mor₂ = 0 :=
begin
  have h := contractible_distinguished T.obj₁,
  have f := complete_distinguished_triangle_morphism,
  specialize f (contractible_triangle C T.obj₁) T h H (𝟙 T.obj₁) T.mor₁,
  have t : (contractible_triangle C T.obj₁).mor₁ ≫ T.mor₁ = 𝟙 T.obj₁ ≫ T.mor₁,
    by refl,
  specialize f t,
  cases f with c f,
  rw ← f.left,
  simp only [limits.zero_comp, contractible_triangle_mor₂],
end -- TODO : tidy this proof up

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `g ≫ h = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₂₃  (T ∈ dist_triang C) : T.mor₂ ≫ T.mor₃ = 0 :=
comp_dist_triangle_mor_zero₁₂ C T.rotate (rot_of_dist_triangle C T H)

/--
Given any distinguished triangle
```
      f       g       h
  X  ───> Y  ───> Z  ───> X⟦1⟧
```
the composition `h ≫ f⟦1⟧ = 0`.
See https://stacks.math.columbia.edu/tag/0146
-/
lemma comp_dist_triangle_mor_zero₃₁ (T ∈ dist_triang C) :
  T.mor₃ ≫ ((shift C).functor.map T.mor₁) = 0 :=
have H₂ : _ := rot_of_dist_triangle C T.rotate (rot_of_dist_triangle C T H),
by simpa using comp_dist_triangle_mor_zero₁₂ C (T.rotate.rotate) H₂

/-
TODO: If `C` is pretriangulated with respect to a shift,
then `Cᵒᵖ` is pretriangulated with respect to the inverse shift.
-/
end pretriangulated
end category_theory.triangulated

namespace category_theory.triangulated
namespace pretriangulated

variables (C : Type u₁) [category.{v₁} C] [has_zero_object C] [has_shift C] [preadditive C]
[functor.additive (shift C).functor] [functor.additive (shift C).inverse]
variables (D : Type u₂) [category.{v₂} D] [has_zero_object D] [has_shift D] [preadditive D]
[functor.additive (shift D).functor] [functor.additive (shift D).inverse]

/--
The underlying structure of a triangulated functor between pretriangulated categories `C` and `D`
is a functor `F : C ⥤ D` together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧`.
-/
structure triangulated_functor_struct extends (C ⥤ D) :=
(comm_shift : (shift C).functor ⋙ to_functor ≅ to_functor ⋙ (shift D).functor)

instance : inhabited (triangulated_functor_struct C C) :=
⟨{ obj := λ X, X,
  map := λ _ _ f, f,
  comm_shift := by refl }⟩

variables {C D}
/--
Given a `triangulated_functor_struct` we can define a function from triangles of `C` to
triangles of `D`.
-/
@[simp]
def triangulated_functor_struct.map_triangle (F : triangulated_functor_struct C D)
  (T : triangle C) : triangle D :=
triangle.mk _ (F.map T.mor₁) (F.map T.mor₂) (F.map T.mor₃ ≫ F.comm_shift.hom.app T.obj₁)

variables (C D)
/--
A triangulated functor between pretriangulated categories `C` and `D` is a functor `F : C ⥤ D`
together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧` such that for every
distinguished triangle `(X,Y,Z,f,g,h)` of `C`, the triangle
`(F(X), F(Y), F(Z), F(f), F(g), F(h) ≫ (ξ X))` is a distinguished triangle of `D`.
See https://stacks.math.columbia.edu/tag/014V
-/
structure triangulated_functor [pretriangulated C] [pretriangulated D] extends
  triangulated_functor_struct C D :=
(map_distinguished' : Π (T: triangle C), (T ∈ dist_triang C) →
  (to_triangulated_functor_struct.map_triangle T ∈ dist_triang D) )

instance [pretriangulated C] : inhabited (triangulated_functor C C) :=
⟨{obj := λ X, X,
  map := λ _ _ f, f,
  comm_shift := by refl ,
  map_distinguished' := begin
    rintros ⟨_,_,_,_⟩ Tdt,
    dsimp at *,
    rwa category.comp_id,
  end }⟩

variables {C D} [pretriangulated C] [pretriangulated D]
/--
Given a `triangulated_functor` we can define a function from triangles of `C` to triangles of `D`.
-/
@[simp]
def triangulated_functor.map_triangle (F : triangulated_functor C D) (T : triangle C) :
  triangle D :=
triangle.mk _ (F.map T.mor₁) (F.map T.mor₂) (F.map T.mor₃ ≫ F.comm_shift.hom.app T.obj₁)

/--
Given a `triangulated_functor` and a distinguished triangle `T` of `C`, then the triangle it
maps onto in `D` is also distinguished.
-/
lemma triangulated_functor.map_distinguished (F : triangulated_functor C D) (T : triangle C)
  (h : T ∈ dist_triang C) : (F.map_triangle T) ∈ dist_triang D := F.map_distinguished' T h

end pretriangulated
end category_theory.triangulated


opaque test1 {α : Sort _} : α → Sort u_1
#check test1
def test2 {α : Sort _} : α → Sort u_1 := sorry
#check test2
variable {α : Sort _} in theorem test3 : α → Sort _ := sorry
#check test3


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mitchell Rowett, Scott Morrison, Johan Commelin, Mario Carneiro,
  Michael Howes
-/
import group_theory.subgroup.basic
import deprecated.submonoid
/-!
# Unbundled subgroups

This file defines unbundled multiplicative and additive subgroups `is_subgroup` and
`is_add_subgroup`. These are not the preferred way to talk about subgroups and should
not be used for any new projects. The preferred way in mathlib are the bundled
versions `subgroup G` and `add_subgroup G`.

## Main definitions

`is_add_subgroup (S : set G)` : the predicate that `S` is the underlying subset of an additive
subgroup of `G`. The bundled variant `add_subgroup G` should be used in preference to this.

`is_subgroup (S : set G)` : the predicate that `S` is the underlying subset of a subgroup
of `G`. The bundled variant `subgroup G` should be used in preference to this.

## Tags

subgroup, subgroups, is_subgroup
-/
open set function

variables {G : Type*} {H : Type*} {A : Type*} {a a₁ a₂ b c: G}

section group
variables [group G] [add_group A]

/-- `s` is an additive subgroup: a set containing 0 and closed under addition and negation. -/
structure is_add_subgroup (s : set A) extends is_add_submonoid s : Prop :=
(neg_mem {a} : a ∈ s → -a ∈ s)

/-- `s` is a subgroup: a set containing 1 and closed under multiplication and inverse. -/
@[to_additive]
structure is_subgroup (s : set G) extends is_submonoid s : Prop :=
(inv_mem {a} : a ∈ s → a⁻¹ ∈ s)

@[to_additive]
lemma is_subgroup.div_mem {s : set G} (hs : is_subgroup s) {x y : G} (hx : x ∈ s) (hy : y ∈ s) :
  x / y ∈ s :=
by simpa only [div_eq_mul_inv] using hs.mul_mem hx (hs.inv_mem hy)

lemma additive.is_add_subgroup
  {s : set G} (hs : is_subgroup s) : @is_add_subgroup (additive G) _ s :=
@is_add_subgroup.mk (additive G) _ _ (additive.is_add_submonoid hs.to_is_submonoid)
  hs.inv_mem

theorem additive.is_add_subgroup_iff
  {s : set G} : @is_add_subgroup (additive G) _ s ↔ is_subgroup s :=
⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @is_subgroup.mk G _ _ ⟨h₁, @h₂⟩ @h₃,
  λ h, by exactI additive.is_add_subgroup h⟩

lemma multiplicative.is_subgroup
  {s : set A} (hs : is_add_subgroup s) : @is_subgroup (multiplicative A) _ s :=
@is_subgroup.mk (multiplicative A) _ _ (multiplicative.is_submonoid hs.to_is_add_submonoid)
  hs.neg_mem

theorem multiplicative.is_subgroup_iff
  {s : set A} : @is_subgroup (multiplicative A) _ s ↔ is_add_subgroup s :=
⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @is_add_subgroup.mk A _ _ ⟨h₁, @h₂⟩ @h₃,
  λ h, by exactI multiplicative.is_subgroup h⟩

@[to_additive of_add_neg]
theorem is_subgroup.of_div (s : set G)
  (one_mem : (1:G) ∈ s) (div_mem : ∀{a b:G}, a ∈ s → b ∈ s → a * b⁻¹ ∈ s) :
  is_subgroup s :=
have inv_mem : ∀a, a ∈ s → a⁻¹ ∈ s, from
  assume a ha,
  have 1 * a⁻¹ ∈ s, from div_mem one_mem ha,
  by simpa,
{ inv_mem := inv_mem,
  mul_mem := assume a b ha hb,
    have a * b⁻¹⁻¹ ∈ s, from div_mem ha (inv_mem b hb),
    by simpa,
  one_mem := one_mem }

theorem is_add_subgroup.of_sub (s : set A)
  (zero_mem : (0:A) ∈ s) (sub_mem : ∀{a b:A}, a ∈ s → b ∈ s → a - b ∈ s) :
  is_add_subgroup s :=
is_add_subgroup.of_add_neg s zero_mem
  (λ x y hx hy, by simpa only [sub_eq_add_neg] using sub_mem hx hy)

@[to_additive]
lemma is_subgroup.inter {s₁ s₂ : set G} (hs₁ : is_subgroup s₁) (hs₂ : is_subgroup s₂) :
  is_subgroup (s₁ ∩ s₂) :=
{ inv_mem := λ x hx, ⟨hs₁.inv_mem hx.1, hs₂.inv_mem hx.2⟩,
  ..is_submonoid.inter hs₁.to_is_submonoid hs₂.to_is_submonoid}

@[to_additive]
lemma is_subgroup.Inter {ι : Sort*} {s : ι → set G} (hs : ∀ y : ι, is_subgroup (s y)) :
  is_subgroup (set.Inter s) :=
{ inv_mem := λ x h, set.mem_Inter.2 $ λ y, is_subgroup.inv_mem (hs _) (set.mem_Inter.1 h y),
  ..is_submonoid.Inter (λ y, (hs y).to_is_submonoid) }

@[to_additive]
lemma is_subgroup_Union_of_directed {ι : Type*} [hι : nonempty ι]
  {s : ι → set G} (hs : ∀ i, is_subgroup (s i))
  (directed : ∀ i j, ∃ k, s i ⊆ s k ∧ s j ⊆ s k) :
  is_subgroup (⋃i, s i) :=
{ inv_mem := λ a ha,
    let ⟨i, hi⟩ := set.mem_Union.1 ha in
    set.mem_Union.2 ⟨i, (hs i).inv_mem hi⟩,
  to_is_submonoid := is_submonoid_Union_of_directed (λ i, (hs i).to_is_submonoid) directed }

end group

namespace is_subgroup
open is_submonoid
variables [group G] {s : set G} (hs : is_subgroup s)

include hs

@[to_additive]
lemma inv_mem_iff : a⁻¹ ∈ s ↔ a ∈ s :=
⟨λ h, by simpa using hs.inv_mem h, inv_mem hs⟩

@[to_additive]
lemma mul_mem_cancel_right (h : a ∈ s) : b * a ∈ s ↔ b ∈ s :=
⟨λ hba, by simpa using hs.mul_mem hba (hs.inv_mem h), λ hb, hs.mul_mem hb h⟩

@[to_additive]
lemma mul_mem_cancel_left (h : a ∈ s) : a * b ∈ s ↔ b ∈ s :=
⟨λ hab, by simpa using hs.mul_mem (hs.inv_mem h) hab, hs.mul_mem h⟩

end is_subgroup

/-- `is_normal_add_subgroup (s : set A)` expresses the fact that `s` is a normal additive subgroup
of the additive group `A`. Important: the preferred way to say this in Lean is via bundled
subgroups `S : add_subgroup A` and `hs : S.normal`, and not via this structure. -/
structure is_normal_add_subgroup [add_group A] (s : set A) extends is_add_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : A, g + n + -g ∈ s)

/-- `is_normal_subgroup (s : set G)` expresses the fact that `s` is a normal subgroup
of the group `G`. Important: the preferred way to say this in Lean is via bundled
subgroups `S : subgroup G` and not via this structure. -/
@[to_additive]
structure is_normal_subgroup [group G] (s : set G) extends is_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : G, g * n * g⁻¹ ∈ s)

@[to_additive]
lemma is_normal_subgroup_of_comm_group [comm_group G] {s : set G} (hs : is_subgroup s) :
  is_normal_subgroup s :=
{ normal := λ n hn g, by rwa [mul_right_comm, mul_right_inv, one_mul],
  ..hs }

lemma additive.is_normal_add_subgroup [group G]
  {s : set G} (hs : is_normal_subgroup s) : @is_normal_add_subgroup (additive G) _ s :=
@is_normal_add_subgroup.mk (additive G) _ _
  (additive.is_add_subgroup hs.to_is_subgroup)
  (is_normal_subgroup.normal hs)

theorem additive.is_normal_add_subgroup_iff [group G]
  {s : set G} : @is_normal_add_subgroup (additive G) _ s ↔ is_normal_subgroup s :=
⟨by rintro ⟨h₁, h₂⟩; exact
    @is_normal_subgroup.mk G _ _ (additive.is_add_subgroup_iff.1 h₁) @h₂,
  λ h, by exactI additive.is_normal_add_subgroup h⟩

lemma multiplicative.is_normal_subgroup [add_group A]
  {s : set A} (hs : is_normal_add_subgroup s) : @is_normal_subgroup (multiplicative A) _ s :=
@is_normal_subgroup.mk (multiplicative A) _ _
  (multiplicative.is_subgroup hs.to_is_add_subgroup)
  (is_normal_add_subgroup.normal hs)

theorem multiplicative.is_normal_subgroup_iff [add_group A]
  {s : set A} : @is_normal_subgroup (multiplicative A) _ s ↔ is_normal_add_subgroup s :=
⟨by rintro ⟨h₁, h₂⟩; exact
    @is_normal_add_subgroup.mk A _ _ (multiplicative.is_subgroup_iff.1 h₁) @h₂,
  λ h, by exactI multiplicative.is_normal_subgroup h⟩

namespace is_subgroup
variable [group G]

-- Normal subgroup properties
@[to_additive]
lemma mem_norm_comm {s : set G} (hs : is_normal_subgroup s) {a b : G} (hab : a * b ∈ s) :
  b * a ∈ s :=
have h : a⁻¹ * (a * b) * a⁻¹⁻¹ ∈ s, from hs.normal (a * b) hab a⁻¹,
by simp at h; exact h

@[to_additive]
lemma mem_norm_comm_iff {s : set G} (hs : is_normal_subgroup s) {a b : G} : a * b ∈ s ↔ b * a ∈ s :=
⟨mem_norm_comm hs, mem_norm_comm hs⟩

/-- The trivial subgroup -/
@[to_additive "the trivial additive subgroup"]
def trivial (G : Type*) [group G] : set G := {1}

@[simp, to_additive]
lemma mem_trivial {g : G} : g ∈ trivial G ↔ g = 1 :=
mem_singleton_iff

@[to_additive]
lemma trivial_normal : is_normal_subgroup (trivial G) :=
by refine {..}; simp [trivial] {contextual := tt}

@[to_additive]
lemma eq_trivial_iff {s : set G} (hs : is_subgroup s) :
  s = trivial G ↔ (∀ x ∈ s, x = (1 : G)) :=
by simp only [set.ext_iff, is_subgroup.mem_trivial];
  exact ⟨λ h x, (h x).1, λ h x, ⟨h x, λ hx, hx.symm ▸ hs.to_is_submonoid.one_mem⟩⟩

@[to_additive]
lemma univ_subgroup : is_normal_subgroup (@univ G) :=
by refine {..}; simp

/-- The underlying set of the center of a group. -/
@[to_additive add_center "The underlying set of the center of an additive group."]
def center (G : Type*) [group G] : set G := {z | ∀ g, g * z = z * g}

@[to_additive mem_add_center]
lemma mem_center {a : G} : a ∈ center G ↔ ∀g, g * a = a * g := iff.rfl

@[to_additive add_center_normal]
lemma center_normal : is_normal_subgroup (center G) :=
{ one_mem := by simp [center],
  mul_mem := assume a b ha hb g,
    by rw [←mul_assoc, mem_center.2 ha g, mul_assoc, mem_center.2 hb g, ←mul_assoc],
  inv_mem := assume a ha g,
    calc
      g * a⁻¹ = a⁻¹ * (g * a) * a⁻¹ : by simp [ha g]
      ...     = a⁻¹ * g             : by rw [←mul_assoc, mul_assoc]; simp,
  normal := assume n ha g h,
    calc
      h * (g * n * g⁻¹) = h * n           : by simp [ha g, mul_assoc]
      ...               = g * g⁻¹ * n * h : by rw ha h; simp
      ...               = g * n * g⁻¹ * h : by rw [mul_assoc g, ha g⁻¹, ←mul_assoc] }

/-- The underlying set of the normalizer of a subset `S : set G` of a group `G`. That is,
  the elements `g : G` such that `g * S * g⁻¹ = S`. -/
@[to_additive add_normalizer "The underlying set of the normalizer of a subset `S : set A` of an
  additive group `A`. That is, the elements `a : A` such that `a + S - a = S`."]
def normalizer (s : set G) : set G :=
{g : G | ∀ n, n ∈ s ↔ g * n * g⁻¹ ∈ s}

@[to_additive]
lemma normalizer_is_subgroup (s : set G) : is_subgroup (normalizer s) :=
{ one_mem := by simp [normalizer],
  mul_mem := λ a b (ha : ∀ n, n ∈ s ↔ a * n * a⁻¹ ∈ s)
    (hb : ∀ n, n ∈ s ↔ b * n * b⁻¹ ∈ s) n,
    by rw [mul_inv_rev, ← mul_assoc, mul_assoc a, mul_assoc a, ← ha, ← hb],
  inv_mem := λ a (ha : ∀ n, n ∈ s ↔ a * n * a⁻¹ ∈ s) n,
    by rw [ha (a⁻¹ * n * a⁻¹⁻¹)];
    simp [mul_assoc] }

@[to_additive subset_add_normalizer]
lemma subset_normalizer {s : set G} (hs : is_subgroup s) : s ⊆ normalizer s :=
λ g hg n, by rw [is_subgroup.mul_mem_cancel_right hs ((is_subgroup.inv_mem_iff hs).2 hg),
  is_subgroup.mul_mem_cancel_left hs hg]

end is_subgroup

-- Homomorphism subgroups
namespace is_group_hom
open is_submonoid is_subgroup

/-- `ker f : set G` is the underlying subset of the kernel of a map `G → H`. -/
@[to_additive "`ker f : set A` is the underlying subset of the kernel of a map `A → B`"]
def ker [group H] (f : G → H) : set G := preimage f (trivial H)

@[to_additive]
lemma mem_ker [group H] (f : G → H) {x : G} : x ∈ ker f ↔ f x = 1 :=
mem_trivial

variables [group G] [group H]

@[to_additive]
lemma one_ker_inv {f : G → H} (hf : is_group_hom f) {a b : G} (h : f (a * b⁻¹) = 1) : f a = f b :=
begin
  rw [hf.map_mul, hf.map_inv] at h,
  rw [←inv_inv (f b), eq_inv_of_mul_eq_one h]
end

@[to_additive]
lemma one_ker_inv' {f : G → H} (hf : is_group_hom f) {a b : G} (h : f (a⁻¹ * b) = 1) : f a = f b :=
begin
  rw [hf.map_mul, hf.map_inv] at h,
  apply inv_injective,
  rw eq_inv_of_mul_eq_one h
end

@[to_additive]
lemma inv_ker_one {f : G → H} (hf : is_group_hom f) {a b : G} (h : f a = f b) : f (a * b⁻¹) = 1 :=
have f a * (f b)⁻¹ = 1, by rw [h, mul_right_inv],
by rwa [←hf.map_inv, ←hf.map_mul] at this

@[to_additive]
lemma inv_ker_one' {f : G → H} (hf : is_group_hom f) {a b : G} (h : f a = f b) : f (a⁻¹ * b) = 1 :=
have (f a)⁻¹ * f b = 1, by rw [h, mul_left_inv],
by rwa [←hf.map_inv, ←hf.map_mul] at this

@[to_additive]
lemma one_iff_ker_inv {f : G → H} (hf : is_group_hom f) (a b : G) : f a = f b ↔ f (a * b⁻¹) = 1 :=
⟨hf.inv_ker_one, hf.one_ker_inv⟩

@[to_additive]
lemma one_iff_ker_inv' {f : G → H} (hf : is_group_hom f) (a b : G) : f a = f b ↔ f (a⁻¹ * b) = 1 :=
⟨hf.inv_ker_one', hf.one_ker_inv'⟩

@[to_additive]
lemma inv_iff_ker {f : G → H} (hf : is_group_hom f) (a b : G) : f a = f b ↔ a * b⁻¹ ∈ ker f :=
by rw [mem_ker]; exact one_iff_ker_inv hf _ _

@[to_additive]
lemma inv_iff_ker' {f : G → H} (hf : is_group_hom f) (a b : G) : f a = f b ↔ a⁻¹ * b ∈ ker f :=
by rw [mem_ker]; exact one_iff_ker_inv' hf _ _

@[to_additive]
lemma image_subgroup {f : G → H} (hf : is_group_hom f) {s : set G} (hs : is_subgroup s) :
  is_subgroup (f '' s) :=
{ mul_mem := assume a₁ a₂ ⟨b₁, hb₁, eq₁⟩ ⟨b₂, hb₂, eq₂⟩,
             ⟨b₁ * b₂, hs.mul_mem hb₁ hb₂, by simp [eq₁, eq₂, hf.map_mul]⟩,
  one_mem := ⟨1, hs.to_is_submonoid.one_mem, hf.map_one⟩,
  inv_mem := assume a ⟨b, hb, eq⟩, ⟨b⁻¹, hs.inv_mem hb, by { rw hf.map_inv, simp * }⟩ }

@[to_additive]
lemma range_subgroup {f : G → H} (hf : is_group_hom f) : is_subgroup (set.range f) :=
@set.image_univ _ _ f ▸ hf.image_subgroup univ_subgroup.to_is_subgroup

local attribute [simp] one_mem inv_mem mul_mem is_normal_subgroup.normal

@[to_additive]
lemma preimage {f : G → H} (hf : is_group_hom f) {s : set H} (hs : is_subgroup s) :
  is_subgroup (f ⁻¹' s) :=
by { refine {..};
     simp [hs.one_mem, hs.mul_mem, hs.inv_mem, hf.map_mul, hf.map_one, hf.map_inv, @inv_mem H _ s]
     {contextual := tt} }

@[to_additive]
lemma preimage_normal {f : G → H} (hf : is_group_hom f) {s : set H} (hs : is_normal_subgroup s) :
  is_normal_subgroup (f ⁻¹' s) :=
{ one_mem := by simp [hf.map_one, hs.to_is_subgroup.one_mem],
  mul_mem := by simp [hf.map_mul, hs.to_is_subgroup.mul_mem] {contextual := tt},
  inv_mem := by simp [hf.map_inv, hs.to_is_subgroup.inv_mem] {contextual := tt},
  normal := by simp [hs.normal, hf.map_mul, hf.map_inv] {contextual := tt}}

@[to_additive]
lemma is_normal_subgroup_ker {f : G → H} (hf : is_group_hom f) : is_normal_subgroup (ker f) :=
hf.preimage_normal (trivial_normal)

@[to_additive]
lemma injective_of_trivial_ker {f : G → H} (hf : is_group_hom f) (h : ker f = trivial G) :
  function.injective f :=
begin
  intros a₁ a₂ hfa,
  simp [ext_iff, ker, is_subgroup.trivial] at h,
  have ha : a₁ * a₂⁻¹ = 1, by rw ←h; exact hf.inv_ker_one hfa,
  rw [eq_inv_of_mul_eq_one ha, inv_inv a₂]
end

@[to_additive]
lemma trivial_ker_of_injective {f : G → H} (hf : is_group_hom f) (h : function.injective f) :
  ker f = trivial G :=
set.ext $ assume x, iff.intro
  (assume hx,
    suffices f x = f 1, by simpa using h this,
    by simp [hf.map_one]; rwa [mem_ker] at hx)
  (by simp [mem_ker, hf.map_one] {contextual := tt})

@[to_additive]
lemma injective_iff_trivial_ker {f : G → H} (hf : is_group_hom f) :
  function.injective f ↔ ker f = trivial G :=
⟨hf.trivial_ker_of_injective, hf.injective_of_trivial_ker⟩

@[to_additive]
lemma trivial_ker_iff_eq_one {f : G → H} (hf : is_group_hom f) :
  ker f = trivial G ↔ ∀ x, f x = 1 → x = 1 :=
by rw set.ext_iff; simp [ker]; exact
⟨λ h x hx, (h x).1 hx, λ h x, ⟨h x, λ hx, by rw [hx, hf.map_one]⟩⟩

end is_group_hom

namespace add_group

variables [add_group A]

/-- If `A` is an additive group and `s : set A`, then `in_closure s : set A` is the underlying
subset of the subgroup generated by `s`. -/
inductive in_closure (s : set A) : A → Prop
| basic {a : A} : a ∈ s → in_closure a
| zero : in_closure 0
| neg {a : A} : in_closure a → in_closure (-a)
| add {a b : A} : in_closure a → in_closure b → in_closure (a + b)

end add_group

namespace group
open is_submonoid is_subgroup

variables [group G] {s : set G}

/-- If `G` is a group and `s : set G`, then `in_closure s : set G` is the underlying
subset of the subgroup generated by `s`. -/
@[to_additive]
inductive in_closure (s : set G) : G → Prop
| basic {a : G} : a ∈ s → in_closure a
| one : in_closure 1
| inv {a : G} : in_closure a → in_closure a⁻¹
| mul {a b : G} : in_closure a → in_closure b → in_closure (a * b)

/-- `group.closure s` is the subgroup generated by `s`, i.e. the smallest subgroup containg `s`. -/
@[to_additive "`add_group.closure s` is the additive subgroup generated by `s`, i.e., the
  smallest additive subgroup containing `s`."]
def closure (s : set G) : set G := {a | in_closure s a }

@[to_additive]
lemma mem_closure {a : G} : a ∈ s → a ∈ closure s := in_closure.basic

@[to_additive]
lemma closure.is_subgroup (s : set G) : is_subgroup (closure s) :=
{ one_mem := in_closure.one,
  mul_mem := assume a b, in_closure.mul,
  inv_mem := assume a, in_closure.inv }

@[to_additive]
theorem subset_closure {s : set G} : s ⊆ closure s := λ a, mem_closure

@[to_additive]
theorem closure_subset {s t : set G} (ht : is_subgroup t) (h : s ⊆ t) : closure s ⊆ t :=
assume a ha, by induction ha; simp [h _, *, ht.one_mem, ht.mul_mem, inv_mem_iff]

@[to_additive]
lemma closure_subset_iff {s t : set G} (ht : is_subgroup t) : closure s ⊆ t ↔ s ⊆ t :=
⟨assume h b ha, h (mem_closure ha), assume h b ha, closure_subset ht h ha⟩

@[to_additive]
theorem closure_mono {s t : set G} (h : s ⊆ t) : closure s ⊆ closure t :=
closure_subset (closure.is_subgroup _) $ set.subset.trans h subset_closure

@[simp, to_additive]
lemma closure_subgroup {s : set G} (hs : is_subgroup s) : closure s = s :=
set.subset.antisymm (closure_subset hs $ set.subset.refl s) subset_closure

@[to_additive]

@[to_additive]
lemma image_closure [group H] {f : G → H} (hf : is_group_hom f) (s : set G) :
  f '' closure s = closure (f '' s) :=
le_antisymm
  begin
    rintros _ ⟨x, hx, rfl⟩,
    apply in_closure.rec_on hx; intros,
    { solve_by_elim [subset_closure, set.mem_image_of_mem] },
    { rw [hf.to_is_monoid_hom.map_one],
      apply is_submonoid.one_mem (closure.is_subgroup _).to_is_submonoid, },
    { rw [hf.map_inv],
      apply is_subgroup.inv_mem (closure.is_subgroup _), assumption },
    { rw [hf.to_is_monoid_hom.map_mul],
      solve_by_elim [is_submonoid.mul_mem (closure.is_subgroup _).to_is_submonoid] }
  end
  (closure_subset (hf.image_subgroup $ closure.is_subgroup _) $ set.image_subset _ subset_closure)

@[to_additive]
theorem mclosure_subset {s : set G} : monoid.closure s ⊆ closure s :=
monoid.closure_subset (closure.is_subgroup _).to_is_submonoid $ subset_closure

@[to_additive]
theorem mclosure_inv_subset {s : set G} : monoid.closure (has_inv.inv ⁻¹' s) ⊆ closure s :=
monoid.closure_subset (closure.is_subgroup _).to_is_submonoid $ λ x hx,
  inv_inv x ▸ ((closure.is_subgroup _).inv_mem $ subset_closure hx)

@[to_additive]
theorem closure_eq_mclosure {s : set G} : closure s = monoid.closure (s ∪ has_inv.inv ⁻¹' s) :=
set.subset.antisymm
  (@closure_subset _ _ _ (monoid.closure (s ∪ has_inv.inv ⁻¹' s))
    { one_mem := (monoid.closure.is_submonoid _).one_mem,
      mul_mem := (monoid.closure.is_submonoid _).mul_mem,
      inv_mem := λ x hx, monoid.in_closure.rec_on hx
      (λ x hx, or.cases_on hx (λ hx, monoid.subset_closure $ or.inr $
        show x⁻¹⁻¹ ∈ s, from (inv_inv x).symm ▸ hx)
        (λ hx, monoid.subset_closure $ or.inl hx))
      ((@one_inv G _).symm ▸ is_submonoid.one_mem (monoid.closure.is_submonoid _))
      (λ x y hx hy ihx ihy,
        (mul_inv_rev x y).symm ▸ is_submonoid.mul_mem (monoid.closure.is_submonoid _) ihy ihx) }
    (set.subset.trans (set.subset_union_left _ _) monoid.subset_closure))
  (monoid.closure_subset (closure.is_subgroup _).to_is_submonoid $ set.union_subset subset_closure $
    λ x hx, inv_inv x ▸ (is_subgroup.inv_mem (closure.is_subgroup _) $ subset_closure hx))

@[to_additive]
theorem mem_closure_union_iff {G : Type*} [comm_group G] {s t : set G} {x : G} :
  x ∈ closure (s ∪ t) ↔ ∃ y ∈ closure s, ∃ z ∈ closure t, y * z = x :=
begin
  simp only [closure_eq_mclosure, monoid.mem_closure_union_iff, exists_prop, preimage_union], split,
  { rintro ⟨_, ⟨ys, hys, yt, hyt, rfl⟩, _, ⟨zs, hzs, zt, hzt, rfl⟩, rfl⟩,
    refine ⟨_, ⟨_, hys, _, hzs, rfl⟩, _, ⟨_, hyt, _, hzt, rfl⟩, _⟩,
    rw [mul_assoc, mul_assoc, mul_left_comm zs] },
  { rintro ⟨_, ⟨ys, hys, zs, hzs, rfl⟩, _, ⟨yt, hyt, zt, hzt, rfl⟩, rfl⟩,
    refine ⟨_, ⟨ys, hys, yt, hyt, rfl⟩, _, ⟨zs, hzs, zt, hzt, rfl⟩, _⟩,
    rw [mul_assoc, mul_assoc, mul_left_comm yt] }
end

end group

namespace is_subgroup
variable [group G]

@[to_additive]
lemma trivial_eq_closure : trivial G = group.closure ∅ :=
subset.antisymm
  (by simp [set.subset_def, (group.closure.is_subgroup _).one_mem])
  (group.closure_subset (trivial_normal).to_is_subgroup $ by simp)

end is_subgroup

/-The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/

namespace group
variables {s : set G} [group G]

lemma conjugates_of_subset {t : set G} (ht : is_normal_subgroup t) {a : G} (h : a ∈ t) :
  conjugates_of a ⊆ t :=
λ x hc,
begin
  obtain ⟨c, w⟩ := is_conj_iff.1 hc,
  have H := is_normal_subgroup.normal ht a h c,
  rwa ←w,
end

theorem conjugates_of_set_subset' {s t : set G} (ht : is_normal_subgroup t) (h : s ⊆ t) :
  conjugates_of_set s ⊆ t :=
set.bUnion_subset (λ x H, conjugates_of_subset ht (h H))

/-- The normal closure of a set s is the subgroup closure of all the conjugates of
elements of s. It is the smallest normal subgroup containing s. -/
def normal_closure (s : set G) : set G := closure (conjugates_of_set s)

theorem conjugates_of_set_subset_normal_closure : conjugates_of_set s ⊆ normal_closure s :=
subset_closure

theorem subset_normal_closure : s ⊆ normal_closure s :=
set.subset.trans subset_conjugates_of_set conjugates_of_set_subset_normal_closure

/-- The normal closure of a set is a subgroup. -/
lemma normal_closure.is_subgroup (s : set G) : is_subgroup (normal_closure s) :=
closure.is_subgroup (conjugates_of_set s)

/-- The normal closure of s is a normal subgroup. -/
lemma normal_closure.is_normal : is_normal_subgroup (normal_closure s) :=
{ normal := λ n h g,
begin
  induction h with x hx x hx ihx x y hx hy ihx ihy,
  {exact (conjugates_of_set_subset_normal_closure (conj_mem_conjugates_of_set hx))},
  {simpa using (normal_closure.is_subgroup s).one_mem},
  {rw ←conj_inv,
   exact ((normal_closure.is_subgroup _).inv_mem ihx)},
  {rw ←conj_mul,
   exact ((normal_closure.is_subgroup _).to_is_submonoid.mul_mem ihx ihy)},
end,
..normal_closure.is_subgroup _ }

/-- The normal closure of s is the smallest normal subgroup containing s. -/
theorem normal_closure_subset {s t : set G} (ht : is_normal_subgroup t) (h : s ⊆ t) :
  normal_closure s ⊆ t :=
λ a w,
begin
  induction w with x hx x hx ihx x y hx hy ihx ihy,
  {exact (conjugates_of_set_subset' ht h $ hx)},
  {exact ht.to_is_subgroup.to_is_submonoid.one_mem},
  {exact ht.to_is_subgroup.inv_mem ihx},
  {exact ht.to_is_subgroup.to_is_submonoid.mul_mem ihx ihy}
end

lemma normal_closure_subset_iff {s t : set G} (ht : is_normal_subgroup t) :
  s ⊆ t ↔ normal_closure s ⊆ t :=
⟨normal_closure_subset ht, set.subset.trans (subset_normal_closure)⟩

theorem normal_closure_mono {s t : set G} : s ⊆ t → normal_closure s ⊆ normal_closure t :=
λ h, normal_closure_subset normal_closure.is_normal (set.subset.trans h (subset_normal_closure))

end group

/-- Create a bundled subgroup from a set `s` and `[is_subgroup s]`. -/
@[to_additive "Create a bundled additive subgroup from a set `s` and `[is_add_subgroup s]`."]
def subgroup.of [group G] {s : set G} (h : is_subgroup s) : subgroup G :=
{ carrier := s,
  one_mem' := h.1.1,
  mul_mem' := h.1.2,
  inv_mem' := h.2 }

@[to_additive]
lemma subgroup.is_subgroup [group G] (K : subgroup G) : is_subgroup (K : set G) :=
{ one_mem := K.one_mem',
  mul_mem := K.mul_mem',
  inv_mem := K.inv_mem' }

-- this will never fire if it's an instance
@[to_additive]
lemma subgroup.of_normal [group G] (s : set G) (h : is_subgroup s) (n : is_normal_subgroup s) :
  subgroup.normal (subgroup.of h) :=
{ conj_mem := n.normal, }


import typ

namespace tts ------------------------------------------------------------------

/-- Grammar of type schemes -/
@[derive decidable_eq]
structure sch (V : Type) : Type :=
(vars : list V)
(type : typ V)
(vars_nodup : vars.nodup)

attribute [pp_using_anonymous_constructor] sch

namespace sch ------------------------------------------------------------------
variables {V : Type} [_root_.decidable_eq V] -- Type of variable names
variables {vs : list V} -- List of variable names
variables {nd : vs.nodup} -- No duplicate variables names
variables {x : tagged V} -- Variables
variables {xs : list (tagged V)} -- List of variables
variables {t tx : typ V} -- Types
variables {ts txs : list (typ V)} -- Lists of types

theorem eq_of_veq : ∀ {s₁ s₂ : sch V}, s₁.vars = s₂.vars → s₁.type = s₂.type → s₁ = s₂
| ⟨vs₁, t₁, nd₁⟩ ⟨vs₂, t₂, nd₂⟩ ha ht := by congr; solve_by_elim

def arity (s : sch V) : ℕ :=
s.vars.length

def of_typ (t : typ V) : sch V :=
⟨[], t, list.nodup_nil⟩

/-- Get the free variables of a scheme -/
def fv (s : sch V) : finset (tagged V) :=
typ.fv s.type

@[simp] theorem fv_mk : fv (mk vs t nd) = typ.fv t :=
rfl

/-- Open a type scheme with a list of types for bound variables -/
def open_typs (ts : list (typ V)) (s : sch V) : typ V :=
typ.open_typs ts s.type

@[simp] theorem open_typs_mk : open_typs ts (mk vs t nd) = typ.open_typs ts t :=
rfl

/-- Open a type scheme with a list of free variables for bound variables -/
def open_vars (xs : list (tagged V)) (s : sch V) : typ V :=
typ.open_vars xs s.type

@[simp] theorem open_vars_mk : open_vars xs (mk vs t nd) = typ.open_vars xs t :=
rfl

/-- Locally-closed type scheme -/
def lc (s : sch V) : Prop :=
typ.lc_body s.arity s.type

end /- namespace -/ sch --------------------------------------------------------
end /- namespace -/ tts --------------------------------------------------------


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.integral_closure
import Mathlib.data.polynomial.field_division
import Mathlib.ring_theory.polynomial.gauss_lemma
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Minimal polynomials

This file defines the minimal polynomial of an element `x` of an `A`-algebra `B`,
under the assumption that x is integral over `A`.

After stating the defining property we specialize to the setting of field extensions
and derive some well-known properties, amongst which the fact that minimal polynomials
are irreducible, and uniquely determined by their defining property.

-/

/-- Let `B` be an `A`-algebra, and `x` an element of `B` that is integral over `A`
so we have some term `hx : is_integral A x`.
The minimal polynomial `minpoly A x` of `x` is a monic polynomial of smallest degree
that has `x` as its root.
For instance, if `V` is a `K`-vector space for some field `K`, and `f : V →ₗ[K] V` then
the minimal polynomial of `f` is `minpoly f.is_integral`. -/
def minpoly (A : Type u_1) {B : Type u_2} [comm_ring A] [ring B] [algebra A B] (x : B) :
    polynomial A :=
  dite (is_integral A x)
    (fun (hx : is_integral A x) =>
      well_founded.min sorry
        (fun (p : polynomial A) => polynomial.monic p ∧ polynomial.eval₂ (algebra_map A B) x p = 0)
        hx)
    fun (hx : ¬is_integral A x) => 0

namespace minpoly

/--A minimal polynomial is monic.-/
theorem monic {A : Type u_1} {B : Type u_2} [comm_ring A] [ring B] [algebra A B] {x : B}
    (hx : is_integral A x) : polynomial.monic (minpoly A x) :=
  sorry

/-- A minimal polynomial is nonzero. -/
theorem ne_zero {A : Type u_1} {B : Type u_2} [comm_ring A] [ring B] [algebra A B] {x : B}
    [nontrivial A] (hx : is_integral A x) : minpoly A x ≠ 0 :=
  polynomial.ne_zero_of_monic (monic hx)

theorem eq_zero {A : Type u_1} {B : Type u_2} [comm_ring A] [ring B] [algebra A B] {x : B}
    (hx : ¬is_integral A x) : minpoly A x = 0 :=
  dif_neg hx

/--An element is a root of its minimal polynomial.-/
@[simp] theorem aeval (A : Type u_1) {B : Type u_2} [comm_ring A] [ring B] [algebra A B] (x : B) :
    coe_fn (polynomial.aeval x) (minpoly A x) = 0 :=
  sorry

theorem mem_range_of_degree_eq_one (A : Type u_1) {B : Type u_2} [comm_ring A] [ring B]
    [algebra A B] (x : B) (hx : polynomial.degree (minpoly A x) = 1) :
    x ∈ ring_hom.range (algebra_map A B) :=
  sorry

/--The defining property of the minimal polynomial of an element x:
it is the monic polynomial with smallest degree that has x as its root.-/
theorem min (A : Type u_1) {B : Type u_2} [comm_ring A] [ring B] [algebra A B] (x : B)
    {p : polynomial A} (pmonic : polynomial.monic p) (hp : coe_fn (polynomial.aeval x) p = 0) :
    polynomial.degree (minpoly A x) ≤ polynomial.degree p :=
  sorry

-- TODO(Commelin, Brasca): this is a duplicate

/-- If an element `x` is a root of a nonzero monic polynomial `p`,
then the degree of `p` is at least the degree of the minimal polynomial of `x`. -/
theorem degree_le_of_monic (A : Type u_1) {B : Type u_2} [comm_ring A] [ring B] [algebra A B]
    (x : B) {p : polynomial A} (hmonic : polynomial.monic p)
    (hp : coe_fn (polynomial.aeval x) p = 0) :
    polynomial.degree (minpoly A x) ≤ polynomial.degree p :=
  sorry

/-- The degree of a minimal polynomial is positive. -/
theorem degree_pos {A : Type u_1} {B : Type u_2} [integral_domain A] [ring B] [algebra A B]
    [nontrivial B] {x : B} [nontrivial A] (hx : is_integral A x) :
    0 < polynomial.degree (minpoly A x) :=
  sorry

/-- If `B/A` is an injective ring extension, and `a` is an element of `A`,
then the minimal polynomial of `algebra_map A B a` is `X - C a`. -/
theorem eq_X_sub_C_of_algebra_map_inj {A : Type u_1} {B : Type u_2} [integral_domain A] [ring B]
    [algebra A B] [nontrivial B] [nontrivial A] (a : A)
    (hf : function.injective ⇑(algebra_map A B)) :
    minpoly A (coe_fn (algebra_map A B) a) = polynomial.X - coe_fn polynomial.C a :=
  sorry

/-- A minimal polynomial is not a unit. -/
theorem not_is_unit (A : Type u_1) {B : Type u_2} [integral_domain A] [ring B] [algebra A B]
    [nontrivial B] (x : B) : ¬is_unit (minpoly A x) :=
  sorry

/-- If `a` strictly divides the minimal polynomial of `x`, then `x` cannot be a root for `a`. -/
theorem aeval_ne_zero_of_dvd_not_unit_minpoly {A : Type u_1} {B : Type u_2} [integral_domain A]
    [domain B] [algebra A B] {x : B} {a : polynomial A} (hx : is_integral A x)
    (hamonic : polynomial.monic a) (hdvd : dvd_not_unit a (minpoly A x)) :
    coe_fn (polynomial.aeval x) a ≠ 0 :=
  sorry

/--A minimal polynomial is irreducible.-/
theorem irreducible {A : Type u_1} {B : Type u_2} [integral_domain A] [domain B] [algebra A B]
    {x : B} (hx : is_integral A x) : irreducible (minpoly A x) :=
  sorry

/-- If an element `x` is a root of a nonzero polynomial `p`,
then the degree of `p` is at least the degree of the minimal polynomial of `x`. -/
theorem degree_le_of_ne_zero (A : Type u_1) {B : Type u_2} [field A] [ring B] [algebra A B] (x : B)
    {p : polynomial A} (pnz : p ≠ 0) (hp : coe_fn (polynomial.aeval x) p = 0) :
    polynomial.degree (minpoly A x) ≤ polynomial.degree p :=
  sorry

/-- The minimal polynomial of an element x is uniquely characterized by its defining property:
if there is another monic polynomial of minimal degree that has x as a root,
then this polynomial is equal to the minimal polynomial of x. -/
theorem unique (A : Type u_1) {B : Type u_2} [field A] [ring B] [algebra A B] (x : B)
    {p : polynomial A} (pmonic : polynomial.monic p) (hp : coe_fn (polynomial.aeval x) p = 0)
    (pmin :
      ∀ (q : polynomial A),
        polynomial.monic q →
          coe_fn (polynomial.aeval x) q = 0 → polynomial.degree p ≤ polynomial.degree q) :
    p = minpoly A x :=
  sorry

/-- If an element x is a root of a polynomial p,
then the minimal polynomial of x divides p. -/
theorem dvd (A : Type u_1) {B : Type u_2} [field A] [ring B] [algebra A B] (x : B)
    {p : polynomial A} (hp : coe_fn (polynomial.aeval x) p = 0) : minpoly A x ∣ p :=
  sorry

theorem dvd_map_of_is_scalar_tower (A : Type u_1) (K : Type u_2) {R : Type u_3} [comm_ring A]
    [field K] [comm_ring R] [algebra A K] [algebra A R] [algebra K R] [is_scalar_tower A K R]
    (x : R) : minpoly K x ∣ polynomial.map (algebra_map A K) (minpoly A x) :=
  sorry

theorem unique' {A : Type u_1} {B : Type u_2} [field A] [ring B] [algebra A B] {x : B}
    [nontrivial B] {p : polynomial A} (hx : is_integral A x) (hp1 : irreducible p)
    (hp2 : coe_fn (polynomial.aeval x) p = 0) (hp3 : polynomial.monic p) : p = minpoly A x :=
  sorry

/-- If `y` is the image of `x` in an extension, their minimal polynomials coincide.

We take `h : y = algebra_map L T x` as an argument because `rw h` typically fails
since `is_integral R y` depends on y.
-/
theorem eq_of_algebra_map_eq {K : Type u_1} {S : Type u_2} {T : Type u_3} [field K] [comm_ring S]
    [comm_ring T] [algebra K S] [algebra K T] [algebra S T] [is_scalar_tower K S T]
    (hST : function.injective ⇑(algebra_map S T)) {x : S} {y : T} (hx : is_integral K x)
    (h : y = coe_fn (algebra_map S T) x) : minpoly K x = minpoly K y :=
  sorry

/-- For GCD domains, the minimal polynomial over the ring is the same as the minimal polynomial
over the fraction field. -/
theorem gcd_domain_eq_field_fractions {A : Type u_1} {K : Type u_2} {R : Type u_3}
    [integral_domain A] [gcd_monoid A] [field K] [integral_domain R] (f : fraction_map A K)
    [algebra (localization_map.codomain f) R] [algebra A R]
    [is_scalar_tower A (localization_map.codomain f) R] {x : R} (hx : is_integral A x) :
    minpoly (localization_map.codomain f) x =
        polynomial.map (localization_map.to_ring_hom f) (minpoly A x) :=
  sorry

/-- The minimal polynomial over `ℤ` is the same as the minimal polynomial over `ℚ`. -/
--TODO use `gcd_domain_eq_field_fractions` directly when localizations are defined

-- in terms of algebras instead of `ring_hom`s

theorem over_int_eq_over_rat {A : Type u_1} [integral_domain A] {x : A} [hℚA : algebra ℚ A]
    (hx : is_integral ℤ x) : minpoly ℚ x = polynomial.map (int.cast_ring_hom ℚ) (minpoly ℤ x) :=
  sorry

/-- For GCD domains, the minimal polynomial divides any primitive polynomial that has the integral
element as root. -/
theorem gcd_domain_dvd {A : Type u_1} {K : Type u_2} {R : Type u_3} [integral_domain A]
    [gcd_monoid A] [field K] [integral_domain R] (f : fraction_map A K)
    [algebra (localization_map.codomain f) R] [algebra A R]
    [is_scalar_tower A (localization_map.codomain f) R] {x : R} (hx : is_integral A x)
    {P : polynomial A} (hprim : polynomial.is_primitive P)
    (hroot : coe_fn (polynomial.aeval x) P = 0) : minpoly A x ∣ P :=
  sorry

/-- The minimal polynomial over `ℤ` divides any primitive polynomial that has the integral element
as root. -/
-- TODO use `gcd_domain_dvd` directly when localizations are defined in terms of algebras

-- instead of `ring_hom`s

theorem integer_dvd {A : Type u_1} [integral_domain A] [algebra ℚ A] {x : A} (hx : is_integral ℤ x)
    {P : polynomial ℤ} (hprim : polynomial.is_primitive P)
    (hroot : coe_fn (polynomial.aeval x) P = 0) : minpoly ℤ x ∣ P :=
  sorry

/-- If `B/K` is a nontrivial algebra over a field, and `x` is an element of `K`,
then the minimal polynomial of `algebra_map K B x` is `X - C x`. -/
theorem eq_X_sub_C {A : Type u_1} (B : Type u_2) [field A] [ring B] [algebra A B] [nontrivial B]
    (a : A) : minpoly A (coe_fn (algebra_map A B) a) = polynomial.X - coe_fn polynomial.C a :=
  eq_X_sub_C_of_algebra_map_inj a (ring_hom.injective (algebra_map A B))

theorem eq_X_sub_C' {A : Type u_1} [field A] (a : A) :
    minpoly A a = polynomial.X - coe_fn polynomial.C a :=
  eq_X_sub_C A a

/-- The minimal polynomial of `0` is `X`. -/
@[simp] theorem zero (A : Type u_1) (B : Type u_2) [field A] [ring B] [algebra A B] [nontrivial B] :
    minpoly A 0 = polynomial.X :=
  sorry

/-- The minimal polynomial of `1` is `X - 1`. -/
@[simp] theorem one (A : Type u_1) (B : Type u_2) [field A] [ring B] [algebra A B] [nontrivial B] :
    minpoly A 1 = polynomial.X - 1 :=
  sorry

/-- A minimal polynomial is prime. -/
theorem prime {A : Type u_1} {B : Type u_2} [field A] [domain B] [algebra A B] {x : B}
    (hx : is_integral A x) : prime (minpoly A x) :=
  sorry

/-- If `L/K` is a field extension and an element `y` of `K` is a root of the minimal polynomial
of an element `x ∈ L`, then `y` maps to `x` under the field embedding. -/
theorem root {A : Type u_1} {B : Type u_2} [field A] [domain B] [algebra A B] {x : B}
    (hx : is_integral A x) {y : A} (h : polynomial.is_root (minpoly A x) y) :
    coe_fn (algebra_map A B) y = x :=
  sorry

/--The constant coefficient of the minimal polynomial of `x` is `0` if and only if `x = 0`. -/
@[simp] theorem coeff_zero_eq_zero {A : Type u_1} {B : Type u_2} [field A] [domain B] [algebra A B]
    {x : B} (hx : is_integral A x) : polynomial.coeff (minpoly A x) 0 = 0 ↔ x = 0 :=
  sorry

/--The minimal polynomial of a nonzero element has nonzero constant coefficient. -/
theorem coeff_zero_ne_zero {A : Type u_1} {B : Type u_2} [field A] [domain B] [algebra A B] {x : B}
    (hx : is_integral A x) (h : x ≠ 0) : polynomial.coeff (minpoly A x) 0 ≠ 0 :=
  sorry

end Mathlib