/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison, Adam Topaz

! This file was ported from Lean 3 source module algebraic_topology.simplicial_object
! leanprover-community/mathlib commit 5ed51dc37c6b891b79314ee11a50adc2b1df6fd6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.AlgebraicTopology.SimplexCategory
import Mathbin.CategoryTheory.Arrow
import Mathbin.CategoryTheory.Limits.FunctorCategory
import Mathbin.CategoryTheory.Opposites

/-!
# Simplicial objects in a category.

A simplicial object in a category `C` is a `C`-valued presheaf on `simplex_category`.
(Similarly a cosimplicial object is functor `simplex_category ⥤ C`.)

Use the notation `X _[n]` in the `simplicial` locale to obtain the `n`-th term of a
(co)simplicial object `X`, where `n` is a natural number.

-/

open Opposite

open CategoryTheory

open CategoryTheory.Limits

universe v u v' u'

namespace CategoryTheory

variable (C : Type u) [Category.{v} C]

/-- The category of simplicial objects valued in a category `C`.
This is the category of contravariant functors from `simplex_category` to `C`. -/
@[nolint has_nonempty_instance]
def SimplicialObject :=
  SimplexCategoryᵒᵖ ⥤ C deriving Category
#align category_theory.simplicial_object CategoryTheory.SimplicialObject

namespace SimplicialObject

-- mathport name: simplicial_object.at
scoped[Simplicial]
  notation:1000 X " _[" n "]" =>
    (X : CategoryTheory.SimplicialObject hole!).obj (Opposite.op (SimplexCategory.mk n))

instance {J : Type v} [SmallCategory J] [HasLimitsOfShape J C] :
    HasLimitsOfShape J (SimplicialObject C) :=
  by
  dsimp [simplicial_object]
  infer_instance

instance [HasLimits C] : HasLimits (SimplicialObject C) :=
  ⟨inferInstance⟩

instance {J : Type v} [SmallCategory J] [HasColimitsOfShape J C] :
    HasColimitsOfShape J (SimplicialObject C) :=
  by
  dsimp [simplicial_object]
  infer_instance

instance [HasColimits C] : HasColimits (SimplicialObject C) :=
  ⟨inferInstance⟩

variable {C} (X : SimplicialObject C)

/-- Face maps for a simplicial object. -/
def δ {n} (i : Fin (n + 2)) : X _[n + 1] ⟶ X _[n] :=
  X.map (SimplexCategory.δ i).op
#align category_theory.simplicial_object.δ CategoryTheory.SimplicialObject.δ

/-- Degeneracy maps for a simplicial object. -/
def σ {n} (i : Fin (n + 1)) : X _[n] ⟶ X _[n + 1] :=
  X.map (SimplexCategory.σ i).op
#align category_theory.simplicial_object.σ CategoryTheory.SimplicialObject.σ

/-- Isomorphisms from identities in ℕ. -/
def eqToIso {n m : ℕ} (h : n = m) : X _[n] ≅ X _[m] :=
  X.mapIso (eqToIso (by rw [h]))
#align category_theory.simplicial_object.eq_to_iso CategoryTheory.SimplicialObject.eqToIso

@[simp]
theorem eqToIso_refl {n : ℕ} (h : n = n) : X.eqToIso h = Iso.refl _ :=
  by
  ext
  simp [eq_to_iso]
#align category_theory.simplicial_object.eq_to_iso_refl CategoryTheory.SimplicialObject.eqToIso_refl

/-- The generic case of the first simplicial identity -/
@[reassoc.1]
theorem δ_comp_δ {n} {i j : Fin (n + 2)} (H : i ≤ j) :
    X.δ j.succ ≫ X.δ i = X.δ i.cast_succ ≫ X.δ j :=
  by
  dsimp [δ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_δ H]
#align category_theory.simplicial_object.δ_comp_δ CategoryTheory.SimplicialObject.δ_comp_δ

@[reassoc.1]
theorem δ_comp_δ' {n} {i : Fin (n + 2)} {j : Fin (n + 3)} (H : i.cast_succ < j) :
    X.δ j ≫ X.δ i =
      X.δ i.cast_succ ≫ X.δ (j.pred fun hj => by simpa only [hj, Fin.not_lt_zero] using H) :=
  by
  dsimp [δ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_δ' H]
#align category_theory.simplicial_object.δ_comp_δ' CategoryTheory.SimplicialObject.δ_comp_δ'

@[reassoc.1]
theorem δ_comp_δ'' {n} {i : Fin (n + 3)} {j : Fin (n + 2)} (H : i ≤ j.cast_succ) :
    X.δ j.succ ≫ X.δ (i.cast_lt (Nat.lt_of_le_of_lt (Fin.le_iff_val_le_val.mp H) j.is_lt)) =
      X.δ i ≫ X.δ j :=
  by
  dsimp [δ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_δ'' H]
#align category_theory.simplicial_object.δ_comp_δ'' CategoryTheory.SimplicialObject.δ_comp_δ''

/-- The special case of the first simplicial identity -/
@[reassoc.1]
theorem δ_comp_δ_self {n} {i : Fin (n + 2)} : X.δ i.cast_succ ≫ X.δ i = X.δ i.succ ≫ X.δ i :=
  by
  dsimp [δ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_δ_self]
#align category_theory.simplicial_object.δ_comp_δ_self CategoryTheory.SimplicialObject.δ_comp_δ_self

@[reassoc.1]
theorem δ_comp_δ_self' {n} {j : Fin (n + 3)} {i : Fin (n + 2)} (H : j = i.cast_succ) :
    X.δ j ≫ X.δ i = X.δ i.succ ≫ X.δ i := by
  subst H
  rw [δ_comp_δ_self]
#align category_theory.simplicial_object.δ_comp_δ_self' CategoryTheory.SimplicialObject.δ_comp_δ_self'

/-- The second simplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_of_le {n} {i : Fin (n + 2)} {j : Fin (n + 1)} (H : i ≤ j.cast_succ) :
    X.σ j.succ ≫ X.δ i.cast_succ = X.δ i ≫ X.σ j :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_σ_of_le H]
#align category_theory.simplicial_object.δ_comp_σ_of_le CategoryTheory.SimplicialObject.δ_comp_σ_of_le

/-- The first part of the third simplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_self {n} {i : Fin (n + 1)} : X.σ i ≫ X.δ i.cast_succ = 𝟙 _ :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_σ_self, op_id, X.map_id]
#align category_theory.simplicial_object.δ_comp_σ_self CategoryTheory.SimplicialObject.δ_comp_σ_self

@[reassoc.1]
theorem δ_comp_σ_self' {n} {j : Fin (n + 2)} {i : Fin (n + 1)} (H : j = i.cast_succ) :
    X.σ i ≫ X.δ j = 𝟙 _ := by
  subst H
  rw [δ_comp_σ_self]
#align category_theory.simplicial_object.δ_comp_σ_self' CategoryTheory.SimplicialObject.δ_comp_σ_self'

/-- The second part of the third simplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_succ {n} {i : Fin (n + 1)} : X.σ i ≫ X.δ i.succ = 𝟙 _ :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_σ_succ, op_id, X.map_id]
#align category_theory.simplicial_object.δ_comp_σ_succ CategoryTheory.SimplicialObject.δ_comp_σ_succ

@[reassoc.1]
theorem δ_comp_σ_succ' {n} {j : Fin (n + 2)} {i : Fin (n + 1)} (H : j = i.succ) :
    X.σ i ≫ X.δ j = 𝟙 _ := by
  subst H
  rw [δ_comp_σ_succ]
#align category_theory.simplicial_object.δ_comp_σ_succ' CategoryTheory.SimplicialObject.δ_comp_σ_succ'

/-- The fourth simplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_of_gt {n} {i : Fin (n + 2)} {j : Fin (n + 1)} (H : j.cast_succ < i) :
    X.σ j.cast_succ ≫ X.δ i.succ = X.δ i ≫ X.σ j :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_σ_of_gt H]
#align category_theory.simplicial_object.δ_comp_σ_of_gt CategoryTheory.SimplicialObject.δ_comp_σ_of_gt

@[reassoc.1]
theorem δ_comp_σ_of_gt' {n} {i : Fin (n + 3)} {j : Fin (n + 2)} (H : j.succ < i) :
    X.σ j ≫ X.δ i =
      X.δ (i.pred fun hi => by simpa only [Fin.not_lt_zero, hi] using H) ≫
        X.σ
          (j.cast_lt
            ((add_lt_add_iff_right 1).mp
              (lt_of_lt_of_le
                (by simpa only [[anonymous], ← Fin.val_succ] using fin.lt_iff_coe_lt_coe.mp H)
                i.is_le))) :=
  by
  dsimp [δ, σ]
  simpa only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_σ_of_gt' H]
#align category_theory.simplicial_object.δ_comp_σ_of_gt' CategoryTheory.SimplicialObject.δ_comp_σ_of_gt'

/-- The fifth simplicial identity -/
@[reassoc.1]
theorem σ_comp_σ {n} {i j : Fin (n + 1)} (H : i ≤ j) :
    X.σ j ≫ X.σ i.cast_succ = X.σ i ≫ X.σ j.succ :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.σ_comp_σ H]
#align category_theory.simplicial_object.σ_comp_σ CategoryTheory.SimplicialObject.σ_comp_σ

open Simplicial

@[simp, reassoc.1]
theorem δ_naturality {X' X : SimplicialObject C} (f : X ⟶ X') {n : ℕ} (i : Fin (n + 2)) :
    X.δ i ≫ f.app (op [n]) = f.app (op [n + 1]) ≫ X'.δ i :=
  f.naturality _
#align category_theory.simplicial_object.δ_naturality CategoryTheory.SimplicialObject.δ_naturality

@[simp, reassoc.1]
theorem σ_naturality {X' X : SimplicialObject C} (f : X ⟶ X') {n : ℕ} (i : Fin (n + 1)) :
    X.σ i ≫ f.app (op [n + 1]) = f.app (op [n]) ≫ X'.σ i :=
  f.naturality _
#align category_theory.simplicial_object.σ_naturality CategoryTheory.SimplicialObject.σ_naturality

variable (C)

/-- Functor composition induces a functor on simplicial objects. -/
@[simps]
def whiskering (D : Type _) [Category D] : (C ⥤ D) ⥤ SimplicialObject C ⥤ SimplicialObject D :=
  whiskeringRight _ _ _
#align category_theory.simplicial_object.whiskering CategoryTheory.SimplicialObject.whiskering

/-- Truncated simplicial objects. -/
@[nolint has_nonempty_instance]
def Truncated (n : ℕ) :=
  (SimplexCategory.Truncated n)ᵒᵖ ⥤ C deriving Category
#align category_theory.simplicial_object.truncated CategoryTheory.SimplicialObject.Truncated

variable {C}

namespace Truncated

instance {n} {J : Type v} [SmallCategory J] [HasLimitsOfShape J C] :
    HasLimitsOfShape J (SimplicialObject.Truncated C n) :=
  by
  dsimp [truncated]
  infer_instance

instance {n} [HasLimits C] : HasLimits (SimplicialObject.Truncated C n) :=
  ⟨inferInstance⟩

instance {n} {J : Type v} [SmallCategory J] [HasColimitsOfShape J C] :
    HasColimitsOfShape J (SimplicialObject.Truncated C n) :=
  by
  dsimp [truncated]
  infer_instance

instance {n} [HasColimits C] : HasColimits (SimplicialObject.Truncated C n) :=
  ⟨inferInstance⟩

variable (C)

/-- Functor composition induces a functor on truncated simplicial objects. -/
@[simps]
def whiskering {n} (D : Type _) [Category D] : (C ⥤ D) ⥤ Truncated C n ⥤ Truncated D n :=
  whiskeringRight _ _ _
#align category_theory.simplicial_object.truncated.whiskering CategoryTheory.SimplicialObject.Truncated.whiskering

variable {C}

end Truncated

section Skeleton

/-- The skeleton functor from simplicial objects to truncated simplicial objects. -/
def sk (n : ℕ) : SimplicialObject C ⥤ SimplicialObject.Truncated C n :=
  (whiskeringLeft _ _ _).obj SimplexCategory.Truncated.inclusion.op
#align category_theory.simplicial_object.sk CategoryTheory.SimplicialObject.sk

end Skeleton

variable (C)

/-- The constant simplicial object is the constant functor. -/
abbrev const : C ⥤ SimplicialObject C :=
  CategoryTheory.Functor.const _
#align category_theory.simplicial_object.const CategoryTheory.SimplicialObject.const

/-- The category of augmented simplicial objects, defined as a comma category. -/
@[nolint has_nonempty_instance]
def Augmented :=
  Comma (𝟭 (SimplicialObject C)) (const C)deriving Category
#align category_theory.simplicial_object.augmented CategoryTheory.SimplicialObject.Augmented

variable {C}

namespace Augmented

/-- Drop the augmentation. -/
@[simps]
def drop : Augmented C ⥤ SimplicialObject C :=
  Comma.fst _ _
#align category_theory.simplicial_object.augmented.drop CategoryTheory.SimplicialObject.Augmented.drop

/-- The point of the augmentation. -/
@[simps]
def point : Augmented C ⥤ C :=
  Comma.snd _ _
#align category_theory.simplicial_object.augmented.point CategoryTheory.SimplicialObject.Augmented.point

/-- The functor from augmented objects to arrows. -/
@[simps]
def toArrow : Augmented C ⥤ Arrow C
    where
  obj X :=
    { left := drop.obj X _[0]
      right := point.obj X
      Hom := X.Hom.app _ }
  map X Y η :=
    { left := (drop.map η).app _
      right := point.map η
      w' := by
        dsimp
        rw [← nat_trans.comp_app]
        erw [η.w]
        rfl }
#align category_theory.simplicial_object.augmented.to_arrow CategoryTheory.SimplicialObject.Augmented.toArrow

/-- The compatibility of a morphism with the augmentation, on 0-simplices -/
@[reassoc.1]
theorem w₀ {X Y : Augmented C} (f : X ⟶ Y) :
    (Augmented.drop.map f).app (op (SimplexCategory.mk 0)) ≫ Y.Hom.app (op (SimplexCategory.mk 0)) =
      X.Hom.app (op (SimplexCategory.mk 0)) ≫ Augmented.point.map f :=
  by convert congr_app f.w (op (SimplexCategory.mk 0))
#align category_theory.simplicial_object.augmented.w₀ CategoryTheory.SimplicialObject.Augmented.w₀

variable (C)

/-- Functor composition induces a functor on augmented simplicial objects. -/
@[simp]
def whiskeringObj (D : Type _) [Category D] (F : C ⥤ D) : Augmented C ⥤ Augmented D
    where
  obj X :=
    { left := ((whiskering _ _).obj F).obj (drop.obj X)
      right := F.obj (point.obj X)
      Hom := whiskerRight X.Hom F ≫ (Functor.constComp _ _ _).Hom }
  map X Y η :=
    { left := whiskerRight η.left _
      right := F.map η.right
      w' := by
        ext
        dsimp
        rw [category.comp_id, category.comp_id, ← F.map_comp, ← F.map_comp, ← nat_trans.comp_app]
        erw [η.w]
        rfl }
#align category_theory.simplicial_object.augmented.whiskering_obj CategoryTheory.SimplicialObject.Augmented.whiskeringObj

/-- Functor composition induces a functor on augmented simplicial objects. -/
@[simps]
def whiskering (D : Type u') [Category.{v'} D] : (C ⥤ D) ⥤ Augmented C ⥤ Augmented D
    where
  obj := whiskeringObj _ _
  map X Y η :=
    {
      app := fun A =>
        { left := whiskerLeft _ η
          right := η.app _
          w' := by
            ext n
            dsimp
            rw [category.comp_id, category.comp_id, η.naturality] } }
#align category_theory.simplicial_object.augmented.whiskering CategoryTheory.SimplicialObject.Augmented.whiskering

variable {C}

end Augmented

/-- Augment a simplicial object with an object. -/
@[simps]
def augment (X : SimplicialObject C) (X₀ : C) (f : X _[0] ⟶ X₀)
    (w : ∀ (i : SimplexCategory) (g₁ g₂ : [0] ⟶ i), X.map g₁.op ≫ f = X.map g₂.op ≫ f) :
    SimplicialObject.Augmented C where
  left := X
  right := X₀
  Hom :=
    { app := fun i => X.map (SimplexCategory.const i.unop 0).op ≫ f
      naturality' := by
        intro i j g
        dsimp
        rw [← g.op_unop]
        simpa only [← X.map_comp, ← category.assoc, category.comp_id, ← op_comp] using w _ _ _ }
#align category_theory.simplicial_object.augment CategoryTheory.SimplicialObject.augment

@[simp]
theorem augment_hom_zero (X : SimplicialObject C) (X₀ : C) (f : X _[0] ⟶ X₀) (w) :
    (X.augment X₀ f w).Hom.app (op [0]) = f := by
  dsimp
  rw [SimplexCategory.hom_zero_zero ([0].const 0), op_id, X.map_id, category.id_comp]
#align category_theory.simplicial_object.augment_hom_zero CategoryTheory.SimplicialObject.augment_hom_zero

end SimplicialObject

/-- Cosimplicial objects. -/
@[nolint has_nonempty_instance]
def CosimplicialObject :=
  SimplexCategory ⥤ C deriving Category
#align category_theory.cosimplicial_object CategoryTheory.CosimplicialObject

namespace CosimplicialObject

-- mathport name: cosimplicial_object.at
scoped[Simplicial]
  notation:1000 X " _[" n "]" =>
    (X : CategoryTheory.CosimplicialObject hole!).obj (SimplexCategory.mk n)

instance {J : Type v} [SmallCategory J] [HasLimitsOfShape J C] :
    HasLimitsOfShape J (CosimplicialObject C) :=
  by
  dsimp [cosimplicial_object]
  infer_instance

instance [HasLimits C] : HasLimits (CosimplicialObject C) :=
  ⟨inferInstance⟩

instance {J : Type v} [SmallCategory J] [HasColimitsOfShape J C] :
    HasColimitsOfShape J (CosimplicialObject C) :=
  by
  dsimp [cosimplicial_object]
  infer_instance

instance [HasColimits C] : HasColimits (CosimplicialObject C) :=
  ⟨inferInstance⟩

variable {C} (X : CosimplicialObject C)

/-- Coface maps for a cosimplicial object. -/
def δ {n} (i : Fin (n + 2)) : X _[n] ⟶ X _[n + 1] :=
  X.map (SimplexCategory.δ i)
#align category_theory.cosimplicial_object.δ CategoryTheory.CosimplicialObject.δ

/-- Codegeneracy maps for a cosimplicial object. -/
def σ {n} (i : Fin (n + 1)) : X _[n + 1] ⟶ X _[n] :=
  X.map (SimplexCategory.σ i)
#align category_theory.cosimplicial_object.σ CategoryTheory.CosimplicialObject.σ

/-- Isomorphisms from identities in ℕ. -/
def eqToIso {n m : ℕ} (h : n = m) : X _[n] ≅ X _[m] :=
  X.mapIso (eqToIso (by rw [h]))
#align category_theory.cosimplicial_object.eq_to_iso CategoryTheory.CosimplicialObject.eqToIso

@[simp]
theorem eqToIso_refl {n : ℕ} (h : n = n) : X.eqToIso h = Iso.refl _ :=
  by
  ext
  simp [eq_to_iso]
#align category_theory.cosimplicial_object.eq_to_iso_refl CategoryTheory.CosimplicialObject.eqToIso_refl

/-- The generic case of the first cosimplicial identity -/
@[reassoc.1]
theorem δ_comp_δ {n} {i j : Fin (n + 2)} (H : i ≤ j) :
    X.δ i ≫ X.δ j.succ = X.δ j ≫ X.δ i.cast_succ :=
  by
  dsimp [δ]
  simp only [← X.map_comp, SimplexCategory.δ_comp_δ H]
#align category_theory.cosimplicial_object.δ_comp_δ CategoryTheory.CosimplicialObject.δ_comp_δ

@[reassoc.1]
theorem δ_comp_δ' {n} {i : Fin (n + 2)} {j : Fin (n + 3)} (H : i.cast_succ < j) :
    X.δ i ≫ X.δ j =
      X.δ (j.pred fun hj => by simpa only [hj, Fin.not_lt_zero] using H) ≫ X.δ i.cast_succ :=
  by
  dsimp [δ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_δ' H]
#align category_theory.cosimplicial_object.δ_comp_δ' CategoryTheory.CosimplicialObject.δ_comp_δ'

@[reassoc.1]
theorem δ_comp_δ'' {n} {i : Fin (n + 3)} {j : Fin (n + 2)} (H : i ≤ j.cast_succ) :
    X.δ (i.cast_lt (Nat.lt_of_le_of_lt (Fin.le_iff_val_le_val.mp H) j.is_lt)) ≫ X.δ j.succ =
      X.δ j ≫ X.δ i :=
  by
  dsimp [δ]
  simp only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_δ'' H]
#align category_theory.cosimplicial_object.δ_comp_δ'' CategoryTheory.CosimplicialObject.δ_comp_δ''

/-- The special case of the first cosimplicial identity -/
@[reassoc.1]
theorem δ_comp_δ_self {n} {i : Fin (n + 2)} : X.δ i ≫ X.δ i.cast_succ = X.δ i ≫ X.δ i.succ :=
  by
  dsimp [δ]
  simp only [← X.map_comp, SimplexCategory.δ_comp_δ_self]
#align category_theory.cosimplicial_object.δ_comp_δ_self CategoryTheory.CosimplicialObject.δ_comp_δ_self

@[reassoc.1]
theorem δ_comp_δ_self' {n} {i : Fin (n + 2)} {j : Fin (n + 3)} (H : j = i.cast_succ) :
    X.δ i ≫ X.δ j = X.δ i ≫ X.δ i.succ := by
  subst H
  rw [δ_comp_δ_self]
#align category_theory.cosimplicial_object.δ_comp_δ_self' CategoryTheory.CosimplicialObject.δ_comp_δ_self'

/-- The second cosimplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_of_le {n} {i : Fin (n + 2)} {j : Fin (n + 1)} (H : i ≤ j.cast_succ) :
    X.δ i.cast_succ ≫ X.σ j.succ = X.σ j ≫ X.δ i :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, SimplexCategory.δ_comp_σ_of_le H]
#align category_theory.cosimplicial_object.δ_comp_σ_of_le CategoryTheory.CosimplicialObject.δ_comp_σ_of_le

/-- The first part of the third cosimplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_self {n} {i : Fin (n + 1)} : X.δ i.cast_succ ≫ X.σ i = 𝟙 _ :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, SimplexCategory.δ_comp_σ_self, X.map_id]
#align category_theory.cosimplicial_object.δ_comp_σ_self CategoryTheory.CosimplicialObject.δ_comp_σ_self

@[reassoc.1]
theorem δ_comp_σ_self' {n} {j : Fin (n + 2)} {i : Fin (n + 1)} (H : j = i.cast_succ) :
    X.δ j ≫ X.σ i = 𝟙 _ := by
  subst H
  rw [δ_comp_σ_self]
#align category_theory.cosimplicial_object.δ_comp_σ_self' CategoryTheory.CosimplicialObject.δ_comp_σ_self'

/-- The second part of the third cosimplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_succ {n} {i : Fin (n + 1)} : X.δ i.succ ≫ X.σ i = 𝟙 _ :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, SimplexCategory.δ_comp_σ_succ, X.map_id]
#align category_theory.cosimplicial_object.δ_comp_σ_succ CategoryTheory.CosimplicialObject.δ_comp_σ_succ

@[reassoc.1]
theorem δ_comp_σ_succ' {n} {j : Fin (n + 2)} {i : Fin (n + 1)} (H : j = i.succ) :
    X.δ j ≫ X.σ i = 𝟙 _ := by
  subst H
  rw [δ_comp_σ_succ]
#align category_theory.cosimplicial_object.δ_comp_σ_succ' CategoryTheory.CosimplicialObject.δ_comp_σ_succ'

/-- The fourth cosimplicial identity -/
@[reassoc.1]
theorem δ_comp_σ_of_gt {n} {i : Fin (n + 2)} {j : Fin (n + 1)} (H : j.cast_succ < i) :
    X.δ i.succ ≫ X.σ j.cast_succ = X.σ j ≫ X.δ i :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, SimplexCategory.δ_comp_σ_of_gt H]
#align category_theory.cosimplicial_object.δ_comp_σ_of_gt CategoryTheory.CosimplicialObject.δ_comp_σ_of_gt

@[reassoc.1]
theorem δ_comp_σ_of_gt' {n} {i : Fin (n + 3)} {j : Fin (n + 2)} (H : j.succ < i) :
    X.δ i ≫ X.σ j =
      X.σ
          (j.cast_lt
            ((add_lt_add_iff_right 1).mp
              (lt_of_lt_of_le
                (by simpa only [[anonymous], ← Fin.val_succ] using fin.lt_iff_coe_lt_coe.mp H)
                i.is_le))) ≫
        X.δ (i.pred fun hi => by simpa only [Fin.not_lt_zero, hi] using H) :=
  by
  dsimp [δ, σ]
  simpa only [← X.map_comp, ← op_comp, SimplexCategory.δ_comp_σ_of_gt' H]
#align category_theory.cosimplicial_object.δ_comp_σ_of_gt' CategoryTheory.CosimplicialObject.δ_comp_σ_of_gt'

/-- The fifth cosimplicial identity -/
@[reassoc.1]
theorem σ_comp_σ {n} {i j : Fin (n + 1)} (H : i ≤ j) :
    X.σ i.cast_succ ≫ X.σ j = X.σ j.succ ≫ X.σ i :=
  by
  dsimp [δ, σ]
  simp only [← X.map_comp, SimplexCategory.σ_comp_σ H]
#align category_theory.cosimplicial_object.σ_comp_σ CategoryTheory.CosimplicialObject.σ_comp_σ

@[simp, reassoc.1]
theorem δ_naturality {X' X : CosimplicialObject C} (f : X ⟶ X') {n : ℕ} (i : Fin (n + 2)) :
    X.δ i ≫ f.app (SimplexCategory.mk (n + 1)) = f.app (SimplexCategory.mk n) ≫ X'.δ i :=
  f.naturality _
#align category_theory.cosimplicial_object.δ_naturality CategoryTheory.CosimplicialObject.δ_naturality

@[simp, reassoc.1]
theorem σ_naturality {X' X : CosimplicialObject C} (f : X ⟶ X') {n : ℕ} (i : Fin (n + 1)) :
    X.σ i ≫ f.app (SimplexCategory.mk n) = f.app (SimplexCategory.mk (n + 1)) ≫ X'.σ i :=
  f.naturality _
#align category_theory.cosimplicial_object.σ_naturality CategoryTheory.CosimplicialObject.σ_naturality

variable (C)

/-- Functor composition induces a functor on cosimplicial objects. -/
@[simps]
def whiskering (D : Type _) [Category D] : (C ⥤ D) ⥤ CosimplicialObject C ⥤ CosimplicialObject D :=
  whiskeringRight _ _ _
#align category_theory.cosimplicial_object.whiskering CategoryTheory.CosimplicialObject.whiskering

/-- Truncated cosimplicial objects. -/
@[nolint has_nonempty_instance]
def Truncated (n : ℕ) :=
  SimplexCategory.Truncated n ⥤ C deriving Category
#align category_theory.cosimplicial_object.truncated CategoryTheory.CosimplicialObject.Truncated

variable {C}

namespace Truncated

instance {n} {J : Type v} [SmallCategory J] [HasLimitsOfShape J C] :
    HasLimitsOfShape J (CosimplicialObject.Truncated C n) :=
  by
  dsimp [truncated]
  infer_instance

instance {n} [HasLimits C] : HasLimits (CosimplicialObject.Truncated C n) :=
  ⟨inferInstance⟩

instance {n} {J : Type v} [SmallCategory J] [HasColimitsOfShape J C] :
    HasColimitsOfShape J (CosimplicialObject.Truncated C n) :=
  by
  dsimp [truncated]
  infer_instance

instance {n} [HasColimits C] : HasColimits (CosimplicialObject.Truncated C n) :=
  ⟨inferInstance⟩

variable (C)

/-- Functor composition induces a functor on truncated cosimplicial objects. -/
@[simps]
def whiskering {n} (D : Type _) [Category D] : (C ⥤ D) ⥤ Truncated C n ⥤ Truncated D n :=
  whiskeringRight _ _ _
#align category_theory.cosimplicial_object.truncated.whiskering CategoryTheory.CosimplicialObject.Truncated.whiskering

variable {C}

end Truncated

section Skeleton

/-- The skeleton functor from cosimplicial objects to truncated cosimplicial objects. -/
def sk (n : ℕ) : CosimplicialObject C ⥤ CosimplicialObject.Truncated C n :=
  (whiskeringLeft _ _ _).obj SimplexCategory.Truncated.inclusion
#align category_theory.cosimplicial_object.sk CategoryTheory.CosimplicialObject.sk

end Skeleton

variable (C)

/-- The constant cosimplicial object. -/
abbrev const : C ⥤ CosimplicialObject C :=
  CategoryTheory.Functor.const _
#align category_theory.cosimplicial_object.const CategoryTheory.CosimplicialObject.const

/-- Augmented cosimplicial objects. -/
@[nolint has_nonempty_instance]
def Augmented :=
  Comma (const C) (𝟭 (CosimplicialObject C))deriving Category
#align category_theory.cosimplicial_object.augmented CategoryTheory.CosimplicialObject.Augmented

variable {C}

namespace Augmented

/-- Drop the augmentation. -/
@[simps]
def drop : Augmented C ⥤ CosimplicialObject C :=
  Comma.snd _ _
#align category_theory.cosimplicial_object.augmented.drop CategoryTheory.CosimplicialObject.Augmented.drop

/-- The point of the augmentation. -/
@[simps]
def point : Augmented C ⥤ C :=
  Comma.fst _ _
#align category_theory.cosimplicial_object.augmented.point CategoryTheory.CosimplicialObject.Augmented.point

/-- The functor from augmented objects to arrows. -/
@[simps]
def toArrow : Augmented C ⥤ Arrow C
    where
  obj X :=
    { left := point.obj X
      right := drop.obj X _[0]
      Hom := X.Hom.app _ }
  map X Y η :=
    { left := point.map η
      right := (drop.map η).app _
      w' := by
        dsimp
        rw [← nat_trans.comp_app]
        erw [← η.w]
        rfl }
#align category_theory.cosimplicial_object.augmented.to_arrow CategoryTheory.CosimplicialObject.Augmented.toArrow

variable (C)

/-- Functor composition induces a functor on augmented cosimplicial objects. -/
@[simp]
def whiskeringObj (D : Type _) [Category D] (F : C ⥤ D) : Augmented C ⥤ Augmented D
    where
  obj X :=
    { left := F.obj (point.obj X)
      right := ((whiskering _ _).obj F).obj (drop.obj X)
      Hom := (Functor.constComp _ _ _).inv ≫ whiskerRight X.Hom F }
  map X Y η :=
    { left := F.map η.left
      right := whiskerRight η.right _
      w' := by
        ext
        dsimp
        rw [category.id_comp, category.id_comp, ← F.map_comp, ← F.map_comp, ← nat_trans.comp_app]
        erw [← η.w]
        rfl }
#align category_theory.cosimplicial_object.augmented.whiskering_obj CategoryTheory.CosimplicialObject.Augmented.whiskeringObj

/-- Functor composition induces a functor on augmented cosimplicial objects. -/
@[simps]
def whiskering (D : Type u') [Category.{v'} D] : (C ⥤ D) ⥤ Augmented C ⥤ Augmented D
    where
  obj := whiskeringObj _ _
  map X Y η :=
    {
      app := fun A =>
        { left := η.app _
          right := whiskerLeft _ η
          w' := by
            ext n
            dsimp
            rw [category.id_comp, category.id_comp, η.naturality] } }
#align category_theory.cosimplicial_object.augmented.whiskering CategoryTheory.CosimplicialObject.Augmented.whiskering

variable {C}

end Augmented

open Simplicial

/-- Augment a cosimplicial object with an object. -/
@[simps]
def augment (X : CosimplicialObject C) (X₀ : C) (f : X₀ ⟶ X.obj [0])
    (w : ∀ (i : SimplexCategory) (g₁ g₂ : [0] ⟶ i), f ≫ X.map g₁ = f ≫ X.map g₂) :
    CosimplicialObject.Augmented C where
  left := X₀
  right := X
  Hom :=
    { app := fun i => f ≫ X.map (SimplexCategory.const i 0)
      naturality' := by
        intro i j g
        dsimp
        simpa [← X.map_comp] using w _ _ _ }
#align category_theory.cosimplicial_object.augment CategoryTheory.CosimplicialObject.augment

@[simp]
theorem augment_hom_zero (X : CosimplicialObject C) (X₀ : C) (f : X₀ ⟶ X.obj [0]) (w) :
    (X.augment X₀ f w).Hom.app [0] = f := by
  dsimp
  rw [SimplexCategory.hom_zero_zero ([0].const 0), X.map_id, category.comp_id]
#align category_theory.cosimplicial_object.augment_hom_zero CategoryTheory.CosimplicialObject.augment_hom_zero

end CosimplicialObject

/-- The anti-equivalence between simplicial objects and cosimplicial objects. -/
@[simps]
def simplicialCosimplicialEquiv : (SimplicialObject C)ᵒᵖ ≌ CosimplicialObject Cᵒᵖ :=
  Functor.leftOpRightOpEquiv _ _
#align category_theory.simplicial_cosimplicial_equiv CategoryTheory.simplicialCosimplicialEquiv

/-- The anti-equivalence between cosimplicial objects and simplicial objects. -/
@[simps]
def cosimplicialSimplicialEquiv : (CosimplicialObject C)ᵒᵖ ≌ SimplicialObject Cᵒᵖ :=
  Functor.opUnopEquiv _ _
#align category_theory.cosimplicial_simplicial_equiv CategoryTheory.cosimplicialSimplicialEquiv

variable {C}

/-- Construct an augmented cosimplicial object in the opposite
category from an augmented simplicial object. -/
@[simps]
def SimplicialObject.Augmented.rightOp (X : SimplicialObject.Augmented C) :
    CosimplicialObject.Augmented Cᵒᵖ
    where
  left := Opposite.op X.right
  right := X.left.rightOp
  Hom := X.Hom.rightOp
#align category_theory.simplicial_object.augmented.right_op CategoryTheory.SimplicialObject.Augmented.rightOp

/-- Construct an augmented simplicial object from an augmented cosimplicial
object in the opposite category. -/
@[simps]
def CosimplicialObject.Augmented.leftOp (X : CosimplicialObject.Augmented Cᵒᵖ) :
    SimplicialObject.Augmented C where
  left := X.right.leftOp
  right := X.left.unop
  Hom := X.Hom.leftOp
#align category_theory.cosimplicial_object.augmented.left_op CategoryTheory.CosimplicialObject.Augmented.leftOp

/-- Converting an augmented simplicial object to an augmented cosimplicial
object and back is isomorphic to the given object. -/
@[simps]
def SimplicialObject.Augmented.rightOpLeftOpIso (X : SimplicialObject.Augmented C) :
    X.rightOp.leftOp ≅ X :=
  Comma.isoMk X.left.rightOpLeftOpIso (eqToIso <| by simp) (by tidy)
#align category_theory.simplicial_object.augmented.right_op_left_op_iso CategoryTheory.SimplicialObject.Augmented.rightOpLeftOpIso

/-- Converting an augmented cosimplicial object to an augmented simplicial
object and back is isomorphic to the given object. -/
@[simps]
def CosimplicialObject.Augmented.leftOpRightOpIso (X : CosimplicialObject.Augmented Cᵒᵖ) :
    X.leftOp.rightOp ≅ X :=
  Comma.isoMk (eqToIso <| by simp) X.right.leftOpRightOpIso (by tidy)
#align category_theory.cosimplicial_object.augmented.left_op_right_op_iso CategoryTheory.CosimplicialObject.Augmented.leftOpRightOpIso

variable (C)

/-- A functorial version of `simplicial_object.augmented.right_op`. -/
@[simps]
def simplicialToCosimplicialAugmented :
    (SimplicialObject.Augmented C)ᵒᵖ ⥤ CosimplicialObject.Augmented Cᵒᵖ
    where
  obj X := X.unop.rightOp
  map X Y f :=
    { left := f.unop.right.op
      right := f.unop.left.rightOp
      w' := by
        ext x
        dsimp
        simp_rw [← op_comp]
        congr 1
        exact (congr_app f.unop.w (op x)).symm }
#align category_theory.simplicial_to_cosimplicial_augmented CategoryTheory.simplicialToCosimplicialAugmented

/-- A functorial version of `cosimplicial_object.augmented.left_op`. -/
@[simps]
def cosimplicialToSimplicialAugmented :
    CosimplicialObject.Augmented Cᵒᵖ ⥤ (SimplicialObject.Augmented C)ᵒᵖ
    where
  obj X := Opposite.op X.leftOp
  map X Y f :=
    Quiver.Hom.op <|
      { left := f.right.leftOp
        right := f.left.unop
        w' := by
          ext x
          dsimp
          simp_rw [← unop_comp]
          congr 1
          exact (congr_app f.w x.unop).symm }
#align category_theory.cosimplicial_to_simplicial_augmented CategoryTheory.cosimplicialToSimplicialAugmented

/-- The contravariant categorical equivalence between augmented simplicial
objects and augmented cosimplicial objects in the opposite category. -/
@[simps Functor inverse]
def simplicialCosimplicialAugmentedEquiv :
    (SimplicialObject.Augmented C)ᵒᵖ ≌ CosimplicialObject.Augmented Cᵒᵖ :=
  Equivalence.mk (simplicialToCosimplicialAugmented _) (cosimplicialToSimplicialAugmented _)
    (NatIso.ofComponents (fun X => X.unop.rightOpLeftOpIso.op) fun X Y f =>
      by
      dsimp
      rw [← f.op_unop]
      simp_rw [← op_comp]
      congr 1
      tidy)
    ((NatIso.ofComponents fun X => X.leftOpRightOpIso) <| by tidy)
#align category_theory.simplicial_cosimplicial_augmented_equiv CategoryTheory.simplicialCosimplicialAugmentedEquiv

end CategoryTheory


/-
Copyright (c) 2022 Jeoff Lee. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeoff Lee
-/
import tactic.linear_combination
import ring_theory.roots_of_unity
import ring_theory.polynomial.cyclotomic.basic

/-!
# The Solution of a Cubic

This file proves Theorem 37 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

In this file, we give the solutions to the cubic equation `a * x^3 + b * x^2 + c * x + d = 0`
over a field `K` that has characteristic neither 2 nor 3, that has a third primitive root of
unity, and in which certain other quantities admit square and cube roots.

This is based on the [Cardano's Formula](https://en.wikipedia.org/wiki/Cubic_equation#Cardano's_formula).

## Main statements

- `cubic_eq_zero_iff` : gives the roots of the cubic equation
where the discriminant `p = 3 * a * c - b^2` is nonzero.
- `cubic_eq_zero_iff_of_p_eq_zero` : gives the roots of the cubic equation
where the discriminant equals zero.

## References

Originally ported from Isabelle/HOL. The
[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL-ex/Cubic_Quartic.html) was written by Amine Chaieb.

## Tags

polynomial, cubic, root
-/

section field

open polynomial

variables {K : Type*} [field K]
variables [invertible (2 : K)] [invertible (3 : K)]
variables (a b c d : K)
variables {ω p q r s t : K}

lemma cube_root_of_unity_sum (hω : is_primitive_root ω 3) : 1 + ω + ω^2 = 0 :=
begin
  convert hω.is_root_cyclotomic (nat.succ_pos _),
  simp only [cyclotomic_prime, eval_geom_sum],
  simp [finset.sum_range_succ]
end

/-- The roots of a monic cubic whose quadratic term is zero and whose discriminant is nonzero. -/
lemma cubic_basic_eq_zero_iff
  (hω : is_primitive_root ω 3)
  (hp_nonzero : p ≠ 0)
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  x^3 + 3 * p * x - 2 * q = 0 ↔
    x = s       - t        ∨
    x = s * ω   - t * ω^2  ∨
    x = s * ω^2 - t * ω    :=
begin
  have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0,
  { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] },
  rw h₁,
  refine eq.congr _ rfl,
  have hs_nonzero : s ≠ 0,
  { contrapose! hp_nonzero with hs_nonzero,
    linear_combination -1*ht + t*hs_nonzero },
  rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
  have H := cube_root_of_unity_sum hω,
  linear_combination
    hr +
    (- q + r + s ^ 3) * hs3 -
    (3 * x * s ^ 3 + (t * s) ^ 2 + (t * s) * p + p ^ 2) * ht +
    ((x ^ 2 * (s - t) + x * (- ω * (s ^ 2 + t ^ 2) + s * t * (3 + ω ^ 2 - ω))
        - (-(s ^ 3 - t ^ 3) * (ω - 1) + s^2 * t * ω ^ 2 - s * t^2 * ω ^ 2)) * s ^ 3) * H,

end

/-- Roots of a monic cubic whose discriminant is nonzero. -/
lemma cubic_monic_eq_zero_iff
  (hω : is_primitive_root ω 3)
  (hp : p = (3 * c - b^2) / 9)
  (hp_nonzero : p ≠ 0)
  (hq : q = (9 * b * c - 2 * b^3 - 27 * d) / 54)
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - t       - b / 3 ∨
    x = s * ω   - t * ω^2 - b / 3 ∨
    x = s * ω^2 - t * ω   - b / 3 :=
begin
  let y := x + b / 3,
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h9 : (9 : K) = 3^2 := by norm_num,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have h₁ : x^3 + b * x^2 + c * x + d = y^3 + 3 * p * y - 2 * q,
  { dsimp only [y],
    rw [hp, hq],
    field_simp [h9, h54], ring, },
  rw [h₁, cubic_basic_eq_zero_iff hω hp_nonzero hr hs3 ht y],
  dsimp only [y],
  simp_rw [eq_sub_iff_add_eq],
end

/-- **The Solution of Cubic**.
  The roots of a cubic polynomial whose discriminant is nonzero. -/
theorem cubic_eq_zero_iff (ha : a ≠ 0)
  (hω : is_primitive_root ω 3)
  (hp : p = (3 * a * c - b^2) / (9 * a^2))
  (hp_nonzero : p ≠ 0)
  (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3))
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  a * x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - t       - b / (3 * a) ∨
    x = s * ω   - t * ω^2 - b / (3 * a) ∨
    x = s * ω^2 - t * ω   - b / (3 * a) :=
begin
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h9 : (9 : K) = 3^2 := by norm_num,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have h₁ : a * x^3 + b * x^2 + c * x + d = a * (x^3 + b/a * x^2 + c/a * x + d/a),
  { field_simp, ring },
  have h₂ : ∀ x, a * x = 0 ↔ x = 0, { intros x, simp [ha], },
  have hp' : p = (3 * (c/a) - (b/a) ^ 2) / 9, { field_simp [hp, h9], ring_nf },
  have hq' : q = (9 * (b/a) * (c/a) - 2 * (b/a) ^ 3 - 27 * (d/a)) / 54,
  { field_simp [hq, h54], ring_nf },
  rw [h₁, h₂, cubic_monic_eq_zero_iff (b/a) (c/a) (d/a) hω hp' hp_nonzero hq' hr hs3 ht x],
  have h₄ := calc b / a / 3 = b / (a * 3) : by { field_simp [ha] }
                        ... = b / (3 * a) : by rw mul_comm,
  rw [h₄],
end

/-- the solution of the cubic equation when p equals zero. -/
lemma cubic_eq_zero_iff_of_p_eq_zero (ha : a ≠ 0)
  (hω : is_primitive_root ω 3)
  (hpz : 3 * a * c - b^2 = 0)
  (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3))
  (hs3 : s^3 = 2 * q)
  (x : K) :
  a * x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - b / (3 * a) ∨
    x = s * ω   - b / (3 * a) ∨
    x = s * ω^2 - b / (3 * a) :=
begin
  have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0,
  { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] },
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have hb2 : b^2 = 3 * a * c, { rw sub_eq_zero at hpz, rw hpz },
  have hb3 : b^3 = 3 * a * b * c, { rw [pow_succ, hb2], ring },
  have h₂ :=
    calc  a * x^3 + b * x^2 + c * x + d
        = a * (x + b/(3*a))^3 + (c - b^2/(3*a)) * x + (d - b^3*a/(3*a)^3)
          : by { field_simp, ring }
    ... = a * (x + b/(3*a))^3 + (d - (9*a*b*c-2*b^3)*a/(3*a)^3)
          : by { simp only [hb2, hb3], field_simp, ring }
    ... = a * ((x + b/(3*a))^3 - s^3)
          : by { rw [hs3, hq], field_simp [h54], ring, },
  have h₃ : ∀ x, a * x = 0 ↔ x = 0, { intro x, simp [ha] },
  have h₄ : ∀ x : K, x^3 - s^3 = (x - s) * (x - s * ω) * (x - s * ω^2),
  { intro x,
    calc  x^3 - s^3
        = (x - s) * (x^2 + x*s + s^2) : by ring
    ... = (x - s) * (x^2 - (ω+ω^2)*x*s + (1+ω+ω^2)*x*s + s^2) : by ring
    ... = (x - s) * (x^2 - (ω+ω^2)*x*s + ω^3*s^2)
        : by { rw [hω.pow_eq_one, cube_root_of_unity_sum hω], simp, }
    ... = (x - s) * (x - s * ω) * (x - s * ω^2) : by ring },
  rw [h₁, h₂, h₃, h₄ (x + b/(3*a))],
  ring_nf,
end

end field


import inner_product_spaces.complex_ip.ip_normed_space

noncomputable theory

variables {α : Type*}
variables [decidable_eq α] [add_comm_group α] [vector_space ℂ α] [ℂ_inner_product_space α]

open complex

theorem ip_parallelogram_law (x y : α) : ∥x+y∥^2+∥x-y∥^2=2*∥x∥^2+2*∥y∥^2 :=
begin
    simp,
    dsimp [ip_self],
    have w : (x†-y).re = -(x†y).re, begin
        rw [←neg_one_smul ℂ y],
        have k : ((-1 : ℝ) : ℂ) = (-1 : ℂ), begin
            rw [ext_iff],
            split,

            refl,

            dsimp [(-1 : ℂ)],
            simp only [neg_zero],
        end,
        rw [←k, mul_re_in_snd],
        ring,
    end,
    rw [w],
    simp,
    ring,
end

class ℂ_parallelopotamus (β : Type*) [add_comm_group β] [vector_space ℂ β] extends normed_space ℂ β :=
(parallelogram_law : ∀ (x y : β), ∥x+y∥^2+∥x-y∥^2=2*∥x∥^2+2*∥y∥^2)

variables {β : Type*}
variables [decidable_eq β] [add_comm_group β] [vector_space ℂ β] [normed_space ℂ β]
variables [ℂ_parallelopotamus β] [has_norm β]

def par_inner_product (x y : β) : ℂ := 1/4*(∥x+y∥^2 + ∥x-y∥^2 + I*∥x+I•y∥^2 + -I*∥x-I•y∥^2)

instance par_has_inner_product : has_ℂ_inner_product β := ⟨par_inner_product⟩

lemma ip_self_eq_norm_sq (x : β) : (x†x).re = ∥x∥^2 :=
begin
    have w : x†x = (∥x∥^2 : ℂ) → (x†x).re = ∥x∥^2, begin
        intros h,
        have w₁ := (ext_iff.1 h).left,
        have w₂ : (∥x∥^2 : ℂ).re = ∥x∥^2, by sorry,
        rw [w₂] at w₁,
        exact w₁,
    end,
    apply w,
    dsimp [(†), par_inner_product],
    sorry,
end


import mynat.definition
import mynat.add
import world2.level4
import world8.level5

namespace mynat

theorem add_left_cancel (a t b : mynat) : t + a = t + b → a = b :=
begin [nat_num_game]
    rw add_comm t a,
    rw add_comm t b,
    exact add_right_cancel a t b,
end

end mynat


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johan Commelin
-/
import algebra.group.with_one.defs
import algebra.hom.equiv.basic

/-!
# More operations on `with_one` and `with_zero`

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

This file defines various bundled morphisms on `with_one` and `with_zero`
that were not available in `algebra/group/with_one/defs`.

## Main definitions

* `with_one.lift`, `with_zero.lift`
* `with_one.map`, `with_zero.map`
-/

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

namespace with_one

section
-- workaround: we make `with_one`/`with_zero` irreducible for this definition, otherwise `simps`
-- will unfold it in the statement of the lemma it generates.
local attribute [irreducible] with_one with_zero
/-- `coe` as a bundled morphism -/
@[to_additive "`coe` as a bundled morphism", simps apply]
def coe_mul_hom [has_mul α] : α →ₙ* (with_one α) :=
{ to_fun := coe, map_mul' := λ x y, rfl }

end

section lift

local attribute [semireducible] with_one with_zero

variables [has_mul α] [mul_one_class β]

/-- Lift a semigroup homomorphism `f` to a bundled monoid homorphism. -/
@[to_additive "Lift an add_semigroup homomorphism `f` to a bundled add_monoid homorphism."]
def lift : (α →ₙ* β) ≃ (with_one α →* β) :=
{ to_fun := λ f,
  { to_fun := λ x, option.cases_on x 1 f,
    map_one' := rfl,
    map_mul' := λ x y,
      with_one.cases_on x (by { rw one_mul, exact (one_mul _).symm }) $ λ x,
      with_one.cases_on y (by { rw mul_one, exact (mul_one _).symm }) $ λ y,
      f.map_mul x y },
  inv_fun := λ F, F.to_mul_hom.comp coe_mul_hom,
  left_inv := λ f, mul_hom.ext $ λ x, rfl,
  right_inv := λ F, monoid_hom.ext $ λ x, with_one.cases_on x F.map_one.symm $ λ x, rfl }

variables (f : α →ₙ* β)

@[simp, to_additive]
lemma lift_coe (x : α) : lift f x = f x := rfl

@[simp, to_additive]
lemma lift_one : lift f 1 = 1 := rfl

@[to_additive]
theorem lift_unique (f : with_one α →* β) : f = lift (f.to_mul_hom.comp coe_mul_hom) :=
(lift.apply_symm_apply f).symm

end lift

section map

variables [has_mul α] [has_mul β] [has_mul γ]

/-- Given a multiplicative map from `α → β` returns a monoid homomorphism
  from `with_one α` to `with_one β` -/
@[to_additive "Given an additive map from `α → β` returns an add_monoid homomorphism
  from `with_zero α` to `with_zero β`"]
def map (f : α →ₙ* β) : with_one α →* with_one β :=
lift (coe_mul_hom.comp f)

@[simp, to_additive] lemma map_coe (f : α →ₙ* β) (a : α) : map f (a : with_one α) = f a :=
lift_coe _ _

@[simp, to_additive]
lemma map_id : map (mul_hom.id α) = monoid_hom.id (with_one α) :=
by { ext, induction x using with_one.cases_on; refl }

@[to_additive]
lemma map_map (f : α →ₙ* β) (g : β →ₙ* γ) (x) :
  map g (map f x) = map (g.comp f) x :=
by { induction x using with_one.cases_on; refl }

@[simp, to_additive]
lemma map_comp (f : α →ₙ* β) (g : β →ₙ* γ) :
  map (g.comp f) = (map g).comp (map f) :=
monoid_hom.ext $ λ x, (map_map f g x).symm

/-- A version of `equiv.option_congr` for `with_one`. -/
@[to_additive "A version of `equiv.option_congr` for `with_zero`.", simps apply]
def _root_.mul_equiv.with_one_congr (e : α ≃* β) : with_one α ≃* with_one β :=
{ to_fun := map e.to_mul_hom,
  inv_fun := map e.symm.to_mul_hom,
  left_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp },
  right_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp },
  .. map e.to_mul_hom }

@[simp]
lemma _root_.mul_equiv.with_one_congr_refl : (mul_equiv.refl α).with_one_congr = mul_equiv.refl _ :=
mul_equiv.to_monoid_hom_injective map_id

@[simp]
lemma _root_.mul_equiv.with_one_congr_symm (e : α ≃* β) :
  e.with_one_congr.symm = e.symm.with_one_congr := rfl

@[simp]
lemma _root_.mul_equiv.with_one_congr_trans (e₁ : α ≃* β) (e₂ : β ≃* γ) :
  e₁.with_one_congr.trans e₂.with_one_congr = (e₁.trans e₂).with_one_congr :=
mul_equiv.to_monoid_hom_injective (map_comp _ _).symm

end map

end with_one


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import Init.SizeOf
import Init.Data.Nat.Basic

universe u v

set_option codegen false

inductive Acc {α : Sort u} (r : α → α → Prop) : α → Prop where
  | intro (x : α) (h : (y : α) → r y x → Acc r y) : Acc r x

abbrev Acc.ndrec.{u1, u2} {α : Sort u2} {r : α → α → Prop} {C : α → Sort u1}
    (m : (x : α) → ((y : α) → r y x → Acc r y) → ((y : α) → (a : r y x) → C y) → C x)
    {a : α} (n : Acc r a) : C a :=
Acc.rec (motive := fun α _ => C α) m n

abbrev Acc.ndrecOn.{u1, u2} {α : Sort u2} {r : α → α → Prop} {C : α → Sort u1}
    {a : α} (n : Acc r a)
    (m : (x : α) → ((y : α) → r y x → Acc r y) → ((y : α) → (a : r y x) → C y) → C x)
    : C a :=
Acc.rec (motive := fun α _ => C α) m n

namespace Acc
variable {α : Sort u} {r : α → α → Prop}

def inv {x y : α} (h₁ : Acc r x) (h₂ : r y x) : Acc r y :=
Acc.recOn (motive := fun (x : α) _ => r y x → Acc r y)
  h₁ (fun x₁ ac₁ ih h₂ => ac₁ y h₂) h₂

end Acc

inductive WellFounded {α : Sort u} (r : α → α → Prop) : Prop where
  | intro (h : ∀ a, Acc r a) : WellFounded r

class WellFoundedRelation (α : Sort u) : Type u where
  r : α → α → Prop
  wf : WellFounded r

namespace WellFounded
def apply {α : Sort u} {r : α → α → Prop} (wf : WellFounded r) (a : α) : Acc r a :=
  WellFounded.recOn (motive := fun x => (y : α) → Acc r y)
    wf (fun p => p) a

section
variable {α : Sort u} {r : α → α → Prop} (hwf : WellFounded r)

theorem recursion {C : α → Sort v} (a : α) (h : ∀ x, (∀ y, r y x → C y) → C x) : C a := by
  induction (apply hwf a) with
  | intro x₁ ac₁ ih => exact h x₁ ih

theorem induction {C : α → Prop} (a : α) (h : ∀ x, (∀ y, r y x → C y) → C x) : C a :=
  recursion hwf a h

variable {C : α → Sort v}
variable (F : ∀ x, (∀ y, r y x → C y) → C x)

def fixF (x : α) (a : Acc r x) : C x := by
  induction a with
  | intro x₁ ac₁ ih => exact F x₁ ih

def fixFEq (x : α) (acx : Acc r x) : fixF F x acx = F x (fun (y : α) (p : r y x) => fixF F y (Acc.inv acx p)) := by
  induction acx with
  | intro x r ih => exact rfl

end

variable {α : Sort u} {C : α → Sort v} {r : α → α → Prop}

-- Well-founded fixpoint
def fix (hwf : WellFounded r) (F : ∀ x, (∀ y, r y x → C y) → C x) (x : α) : C x :=
  fixF F x (apply hwf x)

-- Well-founded fixpoint satisfies fixpoint equation
theorem fixEq (hwf : WellFounded r) (F : ∀ x, (∀ y, r y x → C y) → C x) (x : α) :
    fix hwf F x = F x (fun y h => fix hwf F y) :=
  fixFEq F x (apply hwf x)
end WellFounded

open WellFounded

-- Empty relation is well-founded
def emptyWf {α : Sort u} : WellFounded (@emptyRelation α) := by
  apply WellFounded.intro
  intro a
  apply Acc.intro a
  intro b h
  cases h

-- Subrelation of a well-founded relation is well-founded
namespace Subrelation
variable {α : Sort u} {r q : α → α → Prop}

def accessible {a : α} (h₁ : Subrelation q r) (ac : Acc r a) : Acc q a := by
  induction ac with
  | intro x ax ih =>
    apply Acc.intro
    intro y h
    exact ih y (h₁ h)

def wf (h₁ : Subrelation q r) (h₂ : WellFounded r) : WellFounded q :=
  ⟨fun a => accessible @h₁ (apply h₂ a)⟩
end Subrelation

-- The inverse image of a well-founded relation is well-founded
namespace InvImage
variable {α : Sort u} {β : Sort v} {r : β → β → Prop}

private def accAux (f : α → β) {b : β} (ac : Acc r b) : (x : α) → f x = b → Acc (InvImage r f) x := by
  induction ac with
  | intro x acx ih =>
    intro z e
    apply Acc.intro
    intro y lt
    subst x
    apply ih (f y) lt y rfl

def accessible {a : α} (f : α → β) (ac : Acc r (f a)) : Acc (InvImage r f) a :=
  accAux f ac a rfl

def wf (f : α → β) (h : WellFounded r) : WellFounded (InvImage r f) :=
  ⟨fun a => accessible f (apply h (f a))⟩
end InvImage

-- The transitive closure of a well-founded relation is well-founded
namespace TC
variable {α : Sort u} {r : α → α → Prop}

def accessible {z : α} (ac : Acc r z) : Acc (TC r) z := by
  induction ac with
  | intro x acx ih =>
    apply Acc.intro x
    intro y rel
    induction rel with
    | base a b rab => exact ih a rab
    | trans a b c rab rbc ih₁ ih₂ => apply Acc.inv (ih₂ acx ih) rab

def wf (h : WellFounded r) : WellFounded (TC r) :=
  ⟨fun a => accessible (apply h a)⟩
end TC

-- less-than is well-founded
def Nat.ltWf : WellFounded Nat.lt := by
  apply WellFounded.intro
  intro n
  induction n with
  | zero      =>
    apply Acc.intro 0
    intro _ h
    apply absurd h (Nat.notLtZero _)
  | succ n ih =>
    apply Acc.intro (Nat.succ n)
    intro m h
    have : m = n ∨ m < n := Nat.eqOrLtOfLe (Nat.leOfSuccLeSucc h)
    match this with
    | Or.inl e => subst e; assumption
    | Or.inr e => exact Acc.inv ih e

def measure {α : Sort u} : (α → Nat) → α → α → Prop :=
  InvImage (fun a b => a < b)

def measureWf {α : Sort u} (f : α → Nat) : WellFounded (measure f) :=
  InvImage.wf f Nat.ltWf

def sizeofMeasure (α : Sort u) [SizeOf α] : α → α → Prop :=
  measure sizeOf

def sizeofMeasureWf (α : Sort u) [SizeOf α] : WellFounded (sizeofMeasure α) :=
  measureWf sizeOf

instance hasWellFoundedOfSizeOf (α : Sort u) [SizeOf α] : WellFoundedRelation α where
  r := sizeofMeasure α
  wf := sizeofMeasureWf α

namespace Prod
open WellFounded

section
variable {α : Type u} {β : Type v}
variable  (ra  : α → α → Prop)
variable  (rb  : β → β → Prop)

-- Lexicographical order based on ra and rb
inductive Lex : α × β → α × β → Prop where
  | left  {a₁} (b₁) {a₂} (b₂) (h : ra a₁ a₂) : Lex (a₁, b₁) (a₂, b₂)
  | right (a) {b₁ b₂} (h : rb b₁ b₂)         : Lex (a, b₁)  (a, b₂)

-- relational product based on ra and rb
inductive Rprod : α × β → α × β → Prop where
  | intro {a₁ b₁ a₂ b₂} (h₁ : ra a₁ a₂) (h₂ : rb b₁ b₂) : Rprod (a₁, b₁) (a₂, b₂)
end

section

variable {α : Type u} {β : Type v}
variable {ra  : α → α → Prop} {rb  : β → β → Prop}

def lexAccessible (aca : (a : α) → Acc ra a) (acb : (b : β) → Acc rb b) (a : α) (b : β) : Acc (Lex ra rb) (a, b) := by
  induction (aca a) generalizing b with
  | intro xa aca iha =>
    induction (acb b) with
    | intro xb acb ihb =>
      apply Acc.intro (xa, xb)
      intro p lt
      cases lt with
      | left  _ _ h => apply iha _ h
      | right _ h   => apply ihb _ h

-- The lexicographical order of well founded relations is well-founded
def lexWf (ha : WellFounded ra) (hb : WellFounded rb) : WellFounded (Lex ra rb) :=
  ⟨fun (a, b) => lexAccessible (WellFounded.apply ha) (WellFounded.apply hb) a b⟩

-- relational product is a Subrelation of the Lex
def rprodSubLex (a : α × β) (b : α × β) (h : Rprod ra rb a b) : Lex ra rb a b := by
  cases h with
  | intro h₁ h₂ => exact Lex.left _ _ h₁

-- The relational product of well founded relations is well-founded
def rprodWf (ha : WellFounded ra) (hb : WellFounded rb) : WellFounded (Rprod ra rb) := by
  apply Subrelation.wf (r := Lex ra rb) (h₂ := lexWf ha hb)
  intro a b h
  exact rprodSubLex a b h

end

instance {α : Type u} {β : Type v} [s₁ : WellFoundedRelation α] [s₂ : WellFoundedRelation β] : WellFoundedRelation (α × β) where
  r  := Lex s₁.r s₂.r
  wf := lexWf s₁.wf s₂.wf

end Prod

namespace PSigma
section
variable {α : Sort u} {β : α → Sort v}
variable  (r  : α → α → Prop)
variable  (s  : ∀ a, β a → β a → Prop)

-- Lexicographical order based on r and s
inductive Lex : PSigma β → PSigma β → Prop where
  | left  : ∀ {a₁ : α} (b₁ : β a₁) {a₂ : α} (b₂ : β a₂), r a₁ a₂ → Lex ⟨a₁, b₁⟩ ⟨a₂, b₂⟩
  | right : ∀ (a : α)  {b₁ b₂ : β a}, s a b₁ b₂ → Lex ⟨a, b₁⟩ ⟨a, b₂⟩
end

section
variable {α : Sort u} {β : α → Sort v}
variable {r  : α → α → Prop} {s : ∀ (a : α), β a → β a → Prop}

def lexAccessible {a} (aca : Acc r a) (acb : (a : α) → WellFounded (s a)) (b : β a) : Acc (Lex r s) ⟨a, b⟩ := by
  induction aca with
  | intro xa aca iha =>
    induction (WellFounded.apply (acb xa) b) with
    | intro xb acb ihb =>
      apply Acc.intro
      intro p lt
      cases lt with
      | left  => apply iha; assumption
      | right => apply ihb; assumption

-- The lexicographical order of well founded relations is well-founded
def lexWf (ha : WellFounded r) (hb : (x : α) → WellFounded (s x)) : WellFounded (Lex r s) :=
  WellFounded.intro fun ⟨a, b⟩ => lexAccessible (WellFounded.apply ha a) hb b
end

section
variable {α : Sort u} {β : Sort v}

def lexNdep (r : α → α → Prop) (s : β → β → Prop) :=
  Lex r (fun a => s)

def lexNdepWf {r  : α → α → Prop} {s : β → β → Prop} (ha : WellFounded r) (hb : WellFounded s) : WellFounded (lexNdep r s) :=
  WellFounded.intro fun ⟨a, b⟩ => lexAccessible (WellFounded.apply ha a) (fun x => hb) b
end

section
variable {α : Sort u} {β : Sort v}

-- Reverse lexicographical order based on r and s
inductive RevLex (r  : α → α → Prop) (s  : β → β → Prop) : @PSigma α (fun a => β) → @PSigma α (fun a => β) → Prop where
  | left  : {a₁ a₂ : α} → (b : β) → r a₁ a₂ → RevLex r s ⟨a₁, b⟩ ⟨a₂, b⟩
  | right : (a₁ : α) → {b₁ : β} → (a₂ : α) → {b₂ : β} → s b₁ b₂ → RevLex r s ⟨a₁, b₁⟩ ⟨a₂, b₂⟩
end

section
open WellFounded
variable {α : Sort u} {β : Sort v}
variable {r  : α → α → Prop} {s : β → β → Prop}

def revLexAccessible {b} (acb : Acc s b) (aca : (a : α) → Acc r a): (a : α) → Acc (RevLex r s) ⟨a, b⟩ := by
  induction acb with
  | intro xb acb ihb =>
    intro a
    induction (aca a) with
    | intro xa aca iha =>
      apply Acc.intro
      intro p lt
      cases lt with
      | left  => apply iha; assumption
      | right => apply ihb; assumption

def revLexWf (ha : WellFounded r) (hb : WellFounded s) : WellFounded (RevLex r s) :=
  WellFounded.intro fun ⟨a, b⟩ => revLexAccessible (apply hb b) (WellFounded.apply ha) a
end

section
def skipLeft (α : Type u) {β : Type v} (s : β → β → Prop) : @PSigma α (fun a => β) → @PSigma α (fun a => β) → Prop :=
  RevLex emptyRelation s

def skipLeftWf (α : Type u) {β : Type v} {s : β → β → Prop} (hb : WellFounded s) : WellFounded (skipLeft α s) :=
  revLexWf emptyWf hb

def mkSkipLeft {α : Type u} {β : Type v} {b₁ b₂ : β} {s : β → β → Prop} (a₁ a₂ : α) (h : s b₁ b₂) : skipLeft α s ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ :=
  RevLex.right _ _ h
end

instance WellFoundedRelation {α : Type u} {β : α → Type v} [s₁ : WellFoundedRelation α] [s₂ : ∀ a, WellFoundedRelation (β a)] : WellFoundedRelation (PSigma β) where
  r  := Lex s₁.r (fun a => (s₂ a).r)
  wf := lexWf s₁.wf (fun a => (s₂ a).wf)

end PSigma


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.category.CommRing.basic
import Mathlib.data.mv_polynomial.default
import Mathlib.PostPort

universes u u_1 u_2

namespace Mathlib

/-!
Multivariable polynomials on a type is the left adjoint of the
forgetful functor from commutative rings to types.
-/

namespace CommRing

/--
The free functor `Type u ⥤ CommRing` sending a type `X` to the multivariable (commutative)
polynomials with variables `x : X`.
-/
def free : Type u ⥤ CommRing :=
  category_theory.functor.mk (fun (α : Type u) => of (mv_polynomial α ℤ))
    fun (X Y : Type u) (f : X ⟶ Y) => ↑(mv_polynomial.rename f)

@[simp] theorem free_obj_coe {α : Type u} :
    ↥(category_theory.functor.obj free α) = mv_polynomial α ℤ :=
  rfl

@[simp] theorem free_map_coe {α : Type u} {β : Type u} {f : α → β} :
    ⇑(category_theory.functor.map free f) = ⇑(mv_polynomial.rename f) :=
  rfl

/--
The free-forgetful adjunction for commutative rings.
-/
def adj : free ⊣ category_theory.forget CommRing :=
  category_theory.adjunction.mk_of_hom_equiv
    (category_theory.adjunction.core_hom_equiv.mk
      fun (X : Type (max u_1 u_2)) (R : CommRing) => mv_polynomial.hom_equiv)

end Mathlib


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Yury Kudryashov
-/
import algebra.group.opposite

/-!
# Monoid, group etc structures on `M × N`

In this file we define one-binop (`monoid`, `group` etc) structures on `M × N`. We also prove
trivial `simp` lemmas, and define the following operations on `monoid_hom`s:

* `fst M N : M × N →* M`, `snd M N : M × N →* N`: projections `prod.fst` and `prod.snd`
  as `monoid_hom`s;
* `inl M N : M →* M × N`, `inr M N : N →* M × N`: inclusions of first/second monoid
  into the product;
* `f.prod g : `M →* N × P`: sends `x` to `(f x, g x)`;
* `f.coprod g : M × N →* P`: sends `(x, y)` to `f x * g y`;
* `f.prod_map g : M × N → M' × N'`: `prod.map f g` as a `monoid_hom`,
  sends `(x, y)` to `(f x, g y)`.

## Main declarations

* `mul_mul_hom`/`mul_monoid_hom`/`mul_monoid_with_zero_hom`: Multiplication bundled as a
  multiplicative/monoid/monoid with zero homomorphism.
* `div_monoid_hom`/`div_monoid_with_zero_hom`: Division bundled as a monoid/monoid with zero
  homomorphism.
-/

variables {A : Type*} {B : Type*} {G : Type*} {H : Type*} {M : Type*} {N : Type*} {P : Type*}

namespace prod

@[to_additive]
instance [has_mul M] [has_mul N] : has_mul (M × N) := ⟨λ p q, ⟨p.1 * q.1, p.2 * q.2⟩⟩

@[simp, to_additive]
lemma fst_mul [has_mul M] [has_mul N] (p q : M × N) : (p * q).1 = p.1 * q.1 := rfl
@[simp, to_additive]
lemma snd_mul [has_mul M] [has_mul N] (p q : M × N) : (p * q).2 = p.2 * q.2 := rfl
@[simp, to_additive]
lemma mk_mul_mk [has_mul M] [has_mul N] (a₁ a₂ : M) (b₁ b₂ : N) :
  (a₁, b₁) * (a₂, b₂) = (a₁ * a₂, b₁ * b₂) := rfl
@[to_additive]
lemma mul_def [has_mul M] [has_mul N] (p q : M × N) : p * q = (p.1 * q.1, p.2 * q.2) := rfl

@[to_additive]
instance [has_one M] [has_one N] : has_one (M × N) := ⟨(1, 1)⟩

@[simp, to_additive]
lemma fst_one [has_one M] [has_one N] : (1 : M × N).1 = 1 := rfl
@[simp, to_additive]
lemma snd_one [has_one M] [has_one N] : (1 : M × N).2 = 1 := rfl
@[to_additive]
lemma one_eq_mk [has_one M] [has_one N] : (1 : M × N) = (1, 1) := rfl
@[simp, to_additive]
lemma mk_eq_one [has_one M] [has_one N] {x : M} {y : N} : (x, y) = 1 ↔ x = 1 ∧ y = 1 :=
mk.inj_iff

@[to_additive]
lemma fst_mul_snd [mul_one_class M] [mul_one_class N] (p : M × N) :
  (p.fst, 1) * (1, p.snd) = p :=
ext (mul_one p.1) (one_mul p.2)

@[to_additive]
instance [has_inv M] [has_inv N] : has_inv (M × N) := ⟨λp, (p.1⁻¹, p.2⁻¹)⟩

@[simp, to_additive]
lemma fst_inv [has_inv G] [has_inv H] (p : G × H) : (p⁻¹).1 = (p.1)⁻¹ := rfl
@[simp, to_additive]
lemma snd_inv [has_inv G] [has_inv H] (p : G × H) : (p⁻¹).2 = (p.2)⁻¹ := rfl
@[simp, to_additive]
lemma inv_mk [has_inv G] [has_inv H] (a : G) (b : H) : (a, b)⁻¹ = (a⁻¹, b⁻¹) := rfl

@[to_additive]
instance [has_div M] [has_div N] : has_div (M × N) := ⟨λ p q, ⟨p.1 / q.1, p.2 / q.2⟩⟩

@[simp] lemma fst_sub [add_group A] [add_group B] (a b : A × B) : (a - b).1 = a.1 - b.1 := rfl
@[simp] lemma snd_sub [add_group A] [add_group B] (a b : A × B) : (a - b).2 = a.2 - b.2 := rfl
@[simp] lemma mk_sub_mk [add_group A] [add_group B] (x₁ x₂ : A) (y₁ y₂ : B) :
(x₁, y₁) - (x₂, y₂) = (x₁ - x₂, y₁ - y₂) := rfl

instance [mul_zero_class M] [mul_zero_class N] : mul_zero_class (M × N) :=
{ zero_mul := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨zero_mul _, zero_mul _⟩,
  mul_zero := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨mul_zero _, mul_zero _⟩,
  .. prod.has_zero, .. prod.has_mul }

@[to_additive]
instance [semigroup M] [semigroup N] : semigroup (M × N) :=
{ mul_assoc := assume a b c, mk.inj_iff.mpr ⟨mul_assoc _ _ _, mul_assoc _ _ _⟩,
  .. prod.has_mul }

instance [semigroup_with_zero M] [semigroup_with_zero N] : semigroup_with_zero (M × N) :=
{ .. prod.mul_zero_class, .. prod.semigroup }

@[to_additive]
instance [mul_one_class M] [mul_one_class N] : mul_one_class (M × N) :=
{ one_mul := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨one_mul _, one_mul _⟩,
  mul_one := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨mul_one _, mul_one _⟩,
  .. prod.has_mul, .. prod.has_one }

@[to_additive]
instance [monoid M] [monoid N] : monoid (M × N) :=
{ npow := λ z a, ⟨monoid.npow z a.1, monoid.npow z a.2⟩,
  npow_zero' := λ z, ext (monoid.npow_zero' _) (monoid.npow_zero' _),
  npow_succ' := λ z a, ext (monoid.npow_succ' _ _) (monoid.npow_succ' _ _),
  .. prod.semigroup, .. prod.mul_one_class }

@[to_additive]
instance [div_inv_monoid G] [div_inv_monoid H] : div_inv_monoid (G × H) :=
{ div_eq_mul_inv := λ a b, mk.inj_iff.mpr ⟨div_eq_mul_inv _ _, div_eq_mul_inv _ _⟩,
  zpow := λ z a, ⟨div_inv_monoid.zpow z a.1, div_inv_monoid.zpow z a.2⟩,
  zpow_zero' := λ z, ext (div_inv_monoid.zpow_zero' _) (div_inv_monoid.zpow_zero' _),
  zpow_succ' := λ z a, ext (div_inv_monoid.zpow_succ' _ _) (div_inv_monoid.zpow_succ' _ _),
  zpow_neg' := λ z a, ext (div_inv_monoid.zpow_neg' _ _) (div_inv_monoid.zpow_neg' _ _),
  .. prod.monoid, .. prod.has_inv, .. prod.has_div }

@[to_additive]
instance [group G] [group H] : group (G × H) :=
{ mul_left_inv := assume a, mk.inj_iff.mpr ⟨mul_left_inv _, mul_left_inv _⟩,
  .. prod.div_inv_monoid }

@[to_additive]
instance [comm_semigroup G] [comm_semigroup H] : comm_semigroup (G × H) :=
{ mul_comm := assume a b, mk.inj_iff.mpr ⟨mul_comm _ _, mul_comm _ _⟩,
  .. prod.semigroup }

@[to_additive]
instance [left_cancel_semigroup G] [left_cancel_semigroup H] :
  left_cancel_semigroup (G × H) :=
{ mul_left_cancel := λ a b c h, prod.ext (mul_left_cancel (prod.ext_iff.1 h).1)
    (mul_left_cancel (prod.ext_iff.1 h).2),
  .. prod.semigroup }

@[to_additive]
instance [right_cancel_semigroup G] [right_cancel_semigroup H] :
  right_cancel_semigroup (G × H) :=
{ mul_right_cancel := λ a b c h, prod.ext (mul_right_cancel (prod.ext_iff.1 h).1)
    (mul_right_cancel (prod.ext_iff.1 h).2),
  .. prod.semigroup }

@[to_additive]
instance [left_cancel_monoid M] [left_cancel_monoid N] : left_cancel_monoid (M × N) :=
{ .. prod.left_cancel_semigroup, .. prod.monoid }

@[to_additive]
instance [right_cancel_monoid M] [right_cancel_monoid N] : right_cancel_monoid (M × N) :=
{ .. prod.right_cancel_semigroup, .. prod.monoid }

@[to_additive]
instance [cancel_monoid M] [cancel_monoid N] : cancel_monoid (M × N) :=
{ .. prod.right_cancel_monoid, .. prod.left_cancel_monoid }

@[to_additive]
instance [comm_monoid M] [comm_monoid N] : comm_monoid (M × N) :=
{ .. prod.comm_semigroup, .. prod.monoid }

@[to_additive]
instance [cancel_comm_monoid M] [cancel_comm_monoid N] : cancel_comm_monoid (M × N) :=
{ .. prod.left_cancel_monoid, .. prod.comm_monoid }

instance [mul_zero_one_class M] [mul_zero_one_class N] : mul_zero_one_class (M × N) :=
{ .. prod.mul_zero_class, .. prod.mul_one_class }

instance [monoid_with_zero M] [monoid_with_zero N] : monoid_with_zero (M × N) :=
{ .. prod.monoid, .. prod.mul_zero_one_class }

instance [comm_monoid_with_zero M] [comm_monoid_with_zero N] : comm_monoid_with_zero (M × N) :=
{ .. prod.comm_monoid, .. prod.monoid_with_zero }

@[to_additive]
instance [comm_group G] [comm_group H] : comm_group (G × H) :=
{ .. prod.comm_semigroup, .. prod.group }

end prod

namespace monoid_hom

variables (M N) [mul_one_class M] [mul_one_class N]

/-- Given monoids `M`, `N`, the natural projection homomorphism from `M × N` to `M`.-/
@[to_additive "Given additive monoids `A`, `B`, the natural projection homomorphism
from `A × B` to `A`"]
def fst : M × N →* M := ⟨prod.fst, rfl, λ _ _, rfl⟩

/-- Given monoids `M`, `N`, the natural projection homomorphism from `M × N` to `N`.-/
@[to_additive "Given additive monoids `A`, `B`, the natural projection homomorphism
from `A × B` to `B`"]
def snd : M × N →* N := ⟨prod.snd, rfl, λ _ _, rfl⟩

/-- Given monoids `M`, `N`, the natural inclusion homomorphism from `M` to `M × N`. -/
@[to_additive "Given additive monoids `A`, `B`, the natural inclusion homomorphism
from `A` to `A × B`."]
def inl : M →* M × N :=
⟨λ x, (x, 1), rfl, λ _ _, prod.ext rfl (one_mul 1).symm⟩

/-- Given monoids `M`, `N`, the natural inclusion homomorphism from `N` to `M × N`. -/
@[to_additive "Given additive monoids `A`, `B`, the natural inclusion homomorphism
from `B` to `A × B`."]
def inr : N →* M × N :=
⟨λ y, (1, y), rfl, λ _ _, prod.ext (one_mul 1).symm rfl⟩

variables {M N}

@[simp, to_additive] lemma coe_fst : ⇑(fst M N) = prod.fst := rfl
@[simp, to_additive] lemma coe_snd : ⇑(snd M N) = prod.snd := rfl

@[simp, to_additive] lemma inl_apply (x) : inl M N x = (x, 1) := rfl
@[simp, to_additive] lemma inr_apply (y) : inr M N y = (1, y) := rfl

@[simp, to_additive] lemma fst_comp_inl : (fst M N).comp (inl M N) = id M := rfl
@[simp, to_additive] lemma snd_comp_inl : (snd M N).comp (inl M N) = 1 := rfl
@[simp, to_additive] lemma fst_comp_inr : (fst M N).comp (inr M N) = 1 := rfl
@[simp, to_additive] lemma snd_comp_inr : (snd M N).comp (inr M N) = id N := rfl

section prod

variable [mul_one_class P]

/-- Combine two `monoid_hom`s `f : M →* N`, `g : M →* P` into `f.prod g : M →* N × P`
given by `(f.prod g) x = (f x, g x)` -/
@[to_additive prod "Combine two `add_monoid_hom`s `f : M →+ N`, `g : M →+ P` into
`f.prod g : M →+ N × P` given by `(f.prod g) x = (f x, g x)`"]
protected def prod (f : M →* N) (g : M →* P) : M →* N × P :=
{ to_fun := λ x, (f x, g x),
  map_one' := prod.ext f.map_one g.map_one,
  map_mul' := λ x y, prod.ext (f.map_mul x y) (g.map_mul x y) }

@[simp, to_additive prod_apply]

@[simp, to_additive fst_comp_prod]
lemma fst_comp_prod (f : M →* N) (g : M →* P) : (fst N P).comp (f.prod g) = f :=
ext $ λ x, rfl

@[simp, to_additive snd_comp_prod]
lemma snd_comp_prod (f : M →* N) (g : M →* P) : (snd N P).comp (f.prod g) = g :=
ext $ λ x, rfl

@[simp, to_additive prod_unique]
lemma prod_unique (f : M →* N × P) :
  ((fst N P).comp f).prod ((snd N P).comp f) = f :=
ext $ λ x, by simp only [prod_apply, coe_fst, coe_snd, comp_apply, prod.mk.eta]

end prod

section prod_map

variables {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N'] [mul_one_class P]
  (f : M →* M') (g : N →* N')

/-- `prod.map` as a `monoid_hom`. -/
@[to_additive prod_map "`prod.map` as an `add_monoid_hom`"]
def prod_map : M × N →* M' × N' := (f.comp (fst M N)).prod (g.comp (snd M N))

@[to_additive prod_map_def]
lemma prod_map_def : prod_map f g = (f.comp (fst M N)).prod (g.comp (snd M N)) := rfl

@[simp, to_additive coe_prod_map]
lemma coe_prod_map : ⇑(prod_map f g) = prod.map f g := rfl

@[to_additive prod_comp_prod_map]
lemma prod_comp_prod_map (f : P →* M) (g : P →* N) (f' : M →* M') (g' : N →* N') :
  (f'.prod_map g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
rfl

end prod_map

section coprod

variables [comm_monoid P] (f : M →* P) (g : N →* P)

/-- Coproduct of two `monoid_hom`s with the same codomain:
`f.coprod g (p : M × N) = f p.1 * g p.2`. -/
@[to_additive "Coproduct of two `add_monoid_hom`s with the same codomain:
`f.coprod g (p : M × N) = f p.1 + g p.2`."]
def coprod : M × N →* P := f.comp (fst M N) * g.comp (snd M N)

@[simp, to_additive]
lemma coprod_apply (p : M × N) : f.coprod g p = f p.1 * g p.2 := rfl

@[simp, to_additive]
lemma coprod_comp_inl : (f.coprod g).comp (inl M N) = f :=
ext $ λ x, by simp [coprod_apply]

@[simp, to_additive]
lemma coprod_comp_inr : (f.coprod g).comp (inr M N) = g :=
ext $ λ x, by simp [coprod_apply]

@[simp, to_additive] lemma coprod_unique (f : M × N →* P) :
  (f.comp (inl M N)).coprod (f.comp (inr M N)) = f :=
ext $ λ x, by simp [coprod_apply, inl_apply, inr_apply, ← map_mul]

@[simp, to_additive] lemma coprod_inl_inr {M N : Type*} [comm_monoid M] [comm_monoid N] :
  (inl M N).coprod (inr M N) = id (M × N) :=
coprod_unique (id $ M × N)

lemma comp_coprod {Q : Type*} [comm_monoid Q] (h : P →* Q) (f : M →* P) (g : N →* P) :
  h.comp (f.coprod g) = (h.comp f).coprod (h.comp g) :=
ext $ λ x, by simp

end coprod

end monoid_hom

namespace mul_equiv

section
variables {M N} [mul_one_class M] [mul_one_class N]

/-- The equivalence between `M × N` and `N × M` given by swapping the components
is multiplicative. -/
@[to_additive prod_comm "The equivalence between `M × N` and `N × M` given by swapping the
components is additive."]
def prod_comm : M × N ≃* N × M :=
{ map_mul' := λ ⟨x₁, y₁⟩ ⟨x₂, y₂⟩, rfl, ..equiv.prod_comm M N }

@[simp, to_additive coe_prod_comm] lemma coe_prod_comm :
  ⇑(prod_comm : M × N ≃* N × M) = prod.swap := rfl

@[simp, to_additive coe_prod_comm_symm] lemma coe_prod_comm_symm :
  ⇑((prod_comm : M × N ≃* N × M).symm) = prod.swap := rfl

end

section
variables {M N} [monoid M] [monoid N]

/-- The monoid equivalence between units of a product of two monoids, and the product of the
    units of each monoid. -/
@[to_additive prod_add_units "The additive monoid equivalence between additive units of a product
of two additive monoids, and the product of the additive units of each additive monoid."]
def prod_units : (M × N)ˣ ≃* Mˣ × Nˣ :=
{ to_fun := (units.map (monoid_hom.fst M N)).prod (units.map (monoid_hom.snd M N)),
  inv_fun := λ u, ⟨(u.1, u.2), (↑u.1⁻¹, ↑u.2⁻¹), by simp, by simp⟩,
  left_inv := λ u, by simp,
  right_inv := λ ⟨u₁, u₂⟩, by simp [units.map],
  map_mul' := monoid_hom.map_mul _ }

end

end mul_equiv

section units

open mul_opposite

/-- Canonical homomorphism of monoids from `αˣ` into `α × αᵐᵒᵖ`.
Used mainly to define the natural topology of `αˣ`. -/
def embed_product (α : Type*) [monoid α] : αˣ →* α × αᵐᵒᵖ :=
{ to_fun := λ x, ⟨x, op ↑x⁻¹⟩,
  map_one' := by simp only [one_inv, eq_self_iff_true, units.coe_one, op_one, prod.mk_eq_one,
    and_self],
  map_mul' := λ x y, by simp only [mul_inv_rev, op_mul, units.coe_mul, prod.mk_mul_mk] }

end units

/-! ### Multiplication and division as homomorphisms -/

section bundled_mul_div
variables {α : Type*}

/-- Multiplication as a multiplicative homomorphism. -/
@[to_additive "Addition as an additive homomorphism.", simps]
def mul_mul_hom [comm_semigroup α] : mul_hom (α × α) α :=
{ to_fun := λ a, a.1 * a.2,
  map_mul' := λ a b, mul_mul_mul_comm _ _ _ _ }

/-- Multiplication as a monoid homomorphism. -/
@[to_additive "Addition as an additive monoid homomorphism.", simps]
def mul_monoid_hom [comm_monoid α] : α × α →* α :=
{ map_one' := mul_one _,
  .. mul_mul_hom }

/-- Multiplication as a multiplicative homomorphism with zero. -/
@[simps]
def mul_monoid_with_zero_hom [comm_monoid_with_zero α] : α × α →*₀ α :=
{ map_zero' := mul_zero _,
  .. mul_monoid_hom }

/-- Division as a monoid homomorphism. -/
@[to_additive "Subtraction as an additive monoid homomorphism.", simps]
def div_monoid_hom [comm_group α] : α × α →* α :=
{ to_fun := λ a, a.1 / a.2,
  map_one' := div_one' _,
  map_mul' := λ a b, mul_div_comm' _ _ _ _ }

/-- Division as a multiplicative homomorphism with zero. -/
@[simps]
def div_monoid_with_zero_hom [comm_group_with_zero α] : α × α →*₀ α :=
{ to_fun := λ a, a.1 / a.2,
  map_zero' := zero_div _,
  map_one' := div_one _,
  map_mul' := λ a b, (div_mul_div _ _ _ _).symm }

end bundled_mul_div


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek

! This file was ported from Lean 3 source module tactic.omega.coeffs
! leanprover-community/mathlib commit 53b216bcc1146df1c4a0a86877890ea9f1f01589
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.List.Func
import Mathbin.Tactic.Ring
import Mathbin.Tactic.Omega.Misc

/-
Non-constant terms of linear constraints are represented
by storing their coefficients in integer lists.
-/
namespace Omega

namespace Coeffs

open List.Func

variable {v : Nat → Int}

/-- `val_between v as l o` is the value (under valuation `v`) of the term
    obtained taking the term represented by `(0, as)` and dropping all
    subterms that include variables outside the range `[l,l+o)` -/
@[simp]
def valBetween (v : Nat → Int) (as : List Int) (l : Nat) : Nat → Int
  | 0 => 0
  | o + 1 => val_between o + get (l + o) as * v (l + o)
#align omega.coeffs.val_between Omega.Coeffs.valBetween

@[simp]
theorem valBetween_nil {l : Nat} : ∀ m, valBetween v [] l m = 0
  | 0 => by simp only [val_between]
  | m + 1 => by
    simp only [val_between_nil m, Omega.Coeffs.valBetween, get_nil, zero_add, MulZeroClass.zero_mul,
      Int.default_eq_zero]
#align omega.coeffs.val_between_nil Omega.Coeffs.valBetween_nil

/-- Evaluation of the nonconstant component of a normalized linear arithmetic term. -/
def val (v : Nat → Int) (as : List Int) : Int :=
  valBetween v as 0 as.length
#align omega.coeffs.val Omega.Coeffs.val

@[simp]
theorem val_nil : val v [] = 0 :=
  rfl
#align omega.coeffs.val_nil Omega.Coeffs.val_nil

theorem valBetween_eq_of_le {as : List Int} {l : Nat} :
    ∀ m, as.length ≤ l + m → valBetween v as l m = valBetween v as l (as.length - l)
  | 0, h1 => by
    rw [add_zero] at h1
    rw [tsub_eq_zero_iff_le.mpr h1]
  | m + 1, h1 => by
    rw [le_iff_eq_or_lt] at h1
    cases h1
    · rw [h1, add_comm l, add_tsub_cancel_right]
    have h2 : List.length as ≤ l + m := by
      rw [← Nat.lt_succ_iff]
      apply h1
    simpa [get_eq_default_of_le _ h2, MulZeroClass.zero_mul, add_zero, val_between] using
      val_between_eq_of_le _ h2
#align omega.coeffs.val_between_eq_of_le Omega.Coeffs.valBetween_eq_of_le

theorem val_eq_of_le {as : List Int} {k : Nat} : as.length ≤ k → val v as = valBetween v as 0 k :=
  by
  intro h1; unfold val
  rw [val_between_eq_of_le k _]; rfl
  rw [zero_add]; exact h1
#align omega.coeffs.val_eq_of_le Omega.Coeffs.val_eq_of_le

theorem valBetween_eq_valBetween {v w : Nat → Int} {as bs : List Int} {l : Nat} :
    ∀ {m},
      (∀ x, l ≤ x → x < l + m → v x = w x) →
        (∀ x, l ≤ x → x < l + m → get x as = get x bs) → valBetween v as l m = valBetween w bs l m
  | 0, h1, h2 => rfl
  | m + 1, h1, h2 => by
    unfold val_between
    have h3 : l + m < l + (m + 1) := by
      rw [← add_assoc]
      apply lt_add_one
    apply fun_mono_2
    apply val_between_eq_val_between <;> intro x h4 h5
    · apply h1 _ h4 (lt_trans h5 h3)
    · apply h2 _ h4 (lt_trans h5 h3)
    rw [h1 _ _ h3, h2 _ _ h3] <;> apply Nat.le_add_right
#align omega.coeffs.val_between_eq_val_between Omega.Coeffs.valBetween_eq_valBetween

open List.Func

theorem valBetween_set {a : Int} {l n : Nat} :
    ∀ {m}, l ≤ n → n < l + m → valBetween v ([] {n ↦ a}) l m = a * v n
  | 0, h1, h2 => by exfalso; apply lt_irrefl l (lt_of_le_of_lt h1 h2)
  | m + 1, h1, h2 => by
    rw [← add_assoc, Nat.lt_succ_iff, le_iff_eq_or_lt] at h2
    cases h2 <;> unfold val_between
    · have h3 : val_between v ([] {l + m ↦ a}) l m = 0 :=
        by
        apply @Eq.trans _ _ (val_between v [] l m)
        · apply val_between_eq_val_between
          · intros
            rfl
          · intro x h4 h5
            rw [get_nil, get_set_eq_of_ne, get_nil]
            apply ne_of_lt h5
        apply val_between_nil
      rw [h2]
      simp only [h3, zero_add, List.Func.get_set]
    · have h3 : l + m ≠ n := by apply ne_of_gt h2
      rw [@val_between_set m h1 h2, get_set_eq_of_ne _ _ h3]
      simp only [h3, get_nil, add_zero, MulZeroClass.zero_mul, Int.default_eq_zero]
#align omega.coeffs.val_between_set Omega.Coeffs.valBetween_set

@[simp]
theorem val_set {m : Nat} {a : Int} : val v ([] {m ↦ a}) = a * v m :=
  by
  apply val_between_set (zero_le _)
  rw [length_set, zero_add]
  exact lt_max_of_lt_right (lt_add_one _)
#align omega.coeffs.val_set Omega.Coeffs.val_set

theorem valBetween_neg {as : List Int} {l : Nat} :
    ∀ {o}, valBetween v (neg as) l o = -valBetween v as l o
  | 0 => rfl
  | o + 1 => by
    unfold val_between
    rw [neg_add, neg_mul_eq_neg_mul]
    apply fun_mono_2
    apply val_between_neg
    apply fun_mono_2 _ rfl
    apply get_neg
#align omega.coeffs.val_between_neg Omega.Coeffs.valBetween_neg

@[simp]
theorem val_neg {as : List Int} : val v (neg as) = -val v as := by
  simpa only [val, length_neg] using val_between_neg
#align omega.coeffs.val_neg Omega.Coeffs.val_neg

theorem valBetween_add {is js : List Int} {l : Nat} :
    ∀ m, valBetween v (add is js) l m = valBetween v is l m + valBetween v js l m
  | 0 => rfl
  | m + 1 => by
    simp only [val_between, val_between_add m, List.Func.get, get_add]
    ring
#align omega.coeffs.val_between_add Omega.Coeffs.valBetween_add

@[simp]
theorem val_add {is js : List Int} : val v (add is js) = val v is + val v js :=
  by
  unfold val
  rw [val_between_add];
  apply fun_mono_2 <;> apply val_between_eq_of_le <;> rw [zero_add, length_add]
  apply le_max_left; apply le_max_right
#align omega.coeffs.val_add Omega.Coeffs.val_add

theorem valBetween_sub {is js : List Int} {l : Nat} :
    ∀ m, valBetween v (sub is js) l m = valBetween v is l m - valBetween v js l m
  | 0 => rfl
  | m + 1 => by
    simp only [val_between, val_between_sub m, List.Func.get, get_sub]
    ring
#align omega.coeffs.val_between_sub Omega.Coeffs.valBetween_sub

@[simp]
theorem val_sub {is js : List Int} : val v (sub is js) = val v is - val v js :=
  by
  unfold val
  rw [val_between_sub]
  apply fun_mono_2 <;> apply val_between_eq_of_le <;> rw [zero_add, length_sub]
  apply le_max_left
  apply le_max_right
#align omega.coeffs.val_sub Omega.Coeffs.val_sub

/-- `val_except k v as` is the value (under valuation `v`) of the term
    obtained taking the term represented by `(0, as)` and dropping the
    subterm that includes the `k`th variable. -/
def valExcept (k : Nat) (v : Nat → Int) (as) :=
  valBetween v as 0 k + valBetween v as (k + 1) (as.length - (k + 1))
#align omega.coeffs.val_except Omega.Coeffs.valExcept

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x «expr ≠ » k) -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x «expr ≠ » k) -/
theorem valExcept_eq_valExcept {k : Nat} {is js : List Int} {v w : Nat → Int} :
    (∀ (x) (_ : x ≠ k), v x = w x) →
      (∀ (x) (_ : x ≠ k), get x is = get x js) → valExcept k v is = valExcept k w js :=
  by
  intro h1 h2; unfold val_except
  apply fun_mono_2
  ·
    apply val_between_eq_val_between <;> intro x h3 h4 <;> [· apply h1, · apply h2] <;>
          apply ne_of_lt <;>
        rw [zero_add] at h4 <;>
      apply h4
  · repeat' rw [← val_between_eq_of_le (max is.length js.length - (k + 1))]
    ·
      apply val_between_eq_val_between <;> intro x h3 h4 <;> [· apply h1, · apply h2] <;>
              apply Ne.symm <;>
            apply ne_of_lt <;>
          rw [Nat.lt_iff_add_one_le] <;>
        exact h3
    · refine' le_trans (le_max_right _ _) le_add_tsub
    · refine' le_trans (le_max_left _ _) le_add_tsub
#align omega.coeffs.val_except_eq_val_except Omega.Coeffs.valExcept_eq_valExcept

open Omega

theorem valExcept_update_set {n : Nat} {as : List Int} {i j : Int} :
    valExcept n (v ⟨n ↦ i⟩) (as {n ↦ j}) = valExcept n v as := by
  apply val_except_eq_val_except update_eq_of_ne (get_set_eq_of_ne _)
#align omega.coeffs.val_except_update_set Omega.Coeffs.valExcept_update_set

theorem valBetween_add_valBetween {as : List Int} {l m : Nat} :
    ∀ {n}, valBetween v as l m + valBetween v as (l + m) n = valBetween v as l (m + n)
  | 0 => by simp only [val_between, add_zero]
  | n + 1 => by
    rw [← add_assoc]
    unfold val_between
    rw [add_assoc]
    rw [← @val_between_add_val_between n]
    ring
#align omega.coeffs.val_between_add_val_between Omega.Coeffs.valBetween_add_valBetween

theorem valExcept_add_eq (n : Nat) {as : List Int} : valExcept n v as + get n as * v n = val v as :=
  by
  unfold val_except
  unfold val
  cases' le_total (n + 1) as.length with h1 h1
  · have h4 := @val_between_add_val_between v as 0 (n + 1) (as.length - (n + 1))
    have h5 : n + 1 + (as.length - (n + 1)) = as.length := by
      rw [add_comm, tsub_add_cancel_of_le h1]
    rw [h5] at h4
    apply Eq.trans _ h4
    simp only [val_between, zero_add]
    ring
  have h2 : List.length as - (n + 1) = 0 := tsub_eq_zero_iff_le.mpr h1
  have h3 : val_between v as 0 (List.length as) = val_between v as 0 (n + 1) := by
    simpa only [val] using @val_eq_of_le v as (n + 1) h1
  simp only [add_zero, val_between, zero_add, h2, h3]
#align omega.coeffs.val_except_add_eq Omega.Coeffs.valExcept_add_eq

@[simp]
theorem valBetween_map_mul {i : Int} {as : List Int} {l : Nat} :
    ∀ {m}, valBetween v (List.map ((· * ·) i) as) l m = i * valBetween v as l m
  | 0 => by simp only [val_between, MulZeroClass.mul_zero, List.map]
  | m + 1 => by
    unfold val_between
    rw [@val_between_map_mul m, mul_add]
    apply fun_mono_2 rfl
    by_cases h1 : l + m < as.length
    · rw [get_map h1, mul_assoc]
    rw [not_lt] at h1
    rw [get_eq_default_of_le, get_eq_default_of_le] <;> try simp <;> apply h1
#align omega.coeffs.val_between_map_mul Omega.Coeffs.valBetween_map_mul

theorem forall_val_dvd_of_forall_mem_dvd {i : Int} {as : List Int} :
    (∀ x ∈ as, i ∣ x) → ∀ n, i ∣ get n as
  | h1, n => by
    apply forall_val_of_forall_mem _ h1
    apply dvd_zero
#align omega.coeffs.forall_val_dvd_of_forall_mem_dvd Omega.Coeffs.forall_val_dvd_of_forall_mem_dvd

theorem dvd_valBetween {i} {as : List Int} {l : Nat} :
    ∀ {m}, (∀ x ∈ as, i ∣ x) → i ∣ valBetween v as l m
  | 0, h1 => dvd_zero _
  | m + 1, h1 => by
    unfold val_between
    apply dvd_add
    apply dvd_val_between h1
    apply dvd_mul_of_dvd_left
    by_cases h2 : get (l + m) as = 0
    · rw [h2]
      apply dvd_zero
    apply h1; apply mem_get_of_ne_zero h2
#align omega.coeffs.dvd_val_between Omega.Coeffs.dvd_valBetween

theorem dvd_val {as : List Int} {i : Int} : (∀ x ∈ as, i ∣ x) → i ∣ val v as := by
  apply dvd_val_between
#align omega.coeffs.dvd_val Omega.Coeffs.dvd_val

@[simp]
theorem valBetween_map_div {as : List Int} {i : Int} {l : Nat} (h1 : ∀ x ∈ as, i ∣ x) :
    ∀ {m}, valBetween v (List.map (fun x => x / i) as) l m = valBetween v as l m / i
  | 0 => by simp only [Int.zero_div, val_between, List.map]
  | m + 1 => by
    unfold val_between
    rw [@val_between_map_div m, Int.add_ediv_of_dvd_right]
    apply fun_mono_2 rfl
    ·
      apply
        calc
          get (l + m) (List.map (fun x : ℤ => x / i) as) * v (l + m) =
              get (l + m) as / i * v (l + m) :=
            by
            apply fun_mono_2 _ rfl
            rw [get_map']
            apply Int.zero_div
          _ = get (l + m) as * v (l + m) / i :=
            by
            repeat' rw [mul_comm _ (v (l + m))]
            rw [Int.mul_ediv_assoc]
            apply forall_val_dvd_of_forall_mem_dvd h1

    apply dvd_mul_of_dvd_left
    apply forall_val_dvd_of_forall_mem_dvd h1
#align omega.coeffs.val_between_map_div Omega.Coeffs.valBetween_map_div

@[simp]
theorem val_map_div {as : List Int} {i : Int} :
    (∀ x ∈ as, i ∣ x) → val v (List.map (fun x => x / i) as) = val v as / i :=
  by
  intro h1
  simpa only [val, List.length_map] using val_between_map_div h1
#align omega.coeffs.val_map_div Omega.Coeffs.val_map_div

theorem valBetween_eq_zero {is : List Int} {l : Nat} :
    ∀ {m}, (∀ x : Int, x ∈ is → x = 0) → valBetween v is l m = 0
  | 0, h1 => rfl
  | m + 1, h1 => by
    have h2 := @forall_val_of_forall_mem _ _ is (fun x => x = 0) rfl h1
    simpa only [val_between, h2 (l + m), MulZeroClass.zero_mul, add_zero] using
      @val_between_eq_zero m h1
#align omega.coeffs.val_between_eq_zero Omega.Coeffs.valBetween_eq_zero

theorem val_eq_zero {is : List Int} : (∀ x : Int, x ∈ is → x = 0) → val v is = 0 := by
  apply val_between_eq_zero
#align omega.coeffs.val_eq_zero Omega.Coeffs.val_eq_zero

end Coeffs

end Omega


import data.option .logic

variables {α β : Type}

open tactic

namespace option

lemma orelse_eq_none_iff {α : Type} {f g : option α} :
((f <|> g) = none) ↔ (f = none ∧ g = none) :=
begin
  cases h1 : f; cases h2 : g,
  apply iff_of_left_of_right; exact_dec_trivial,
  repeat { apply iff_of_not_of_not; exact_dec_trivial }
end

@[reducible] def is_none' : option α → Prop
| none     := true
| (some _) := false

def is_some' : option α → Prop
| none     := false
| (some _) := true

instance is_none'.decidable :
  ∀ x : option α, decidable x.is_none'
| none     := decidable.true
| (some _) := decidable.false

instance is_some'.decidable :
  ∀ x : option α, decidable x.is_some'
| none     := decidable.false
| (some _) := decidable.true

lemma is_none_iff_eq_none' {o : option α} : is_none' o ↔ o = none :=
by cases o; exact_dec_trivial

lemma not_is_none' {α : Type} {f : option α} :
  ¬ f.is_none' ↔ f.is_some' := by cases f; exact_dec_trivial

lemma not_is_some' {α : Type} {f : option α} :
  ¬ f.is_some' ↔ f.is_none' := by cases f; exact_dec_trivial

lemma orelse_is_none' {α : Type} {f g : option α} :
(f <|> g).is_none' ↔ f.is_none' ∧ g.is_none' :=
begin
  cases h1 : f; cases h2 : g,
  { apply iff_of_left_of_right; exact_dec_trivial },
  repeat { apply iff_of_not_of_not; exact_dec_trivial },
end

lemma orelse_is_some'_of_right {α : Type} {f g : option α} :
g.is_some' → (f <|> g).is_some' :=
begin intro h1, cases f, simp, apply h1, trivial end

lemma orelse_eq (x y : option α) :
  (x <|> y) = x ∨ (x <|> y) = y :=
begin
  cases h1 : x,
  { right, cases y; refl },
  { left, refl }
end

lemma orelse_eq' {x y z : option α} :
  (x <|> y) = z → (x = z ∨ y = z) :=
begin
  intro h1, cases (orelse_eq x y) with h2 h2;
  rw h2 at h1; [left, right]; assumption
end

end option


/-
Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ashvni Narayanan, Anne Baanen

! This file was ported from Lean 3 source module number_theory.number_field.basic
! leanprover-community/mathlib commit 641b6a82006416ec431b2987b354af9311fed4f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Algebra
import Mathbin.RingTheory.DedekindDomain.IntegralClosure

/-!
# Number fields
This file defines a number field and the ring of integers corresponding to it.

## Main definitions
 - `number_field` defines a number field as a field which has characteristic zero and is finite
    dimensional over ℚ.
 - `ring_of_integers` defines the ring of integers (or number ring) corresponding to a number field
    as the integral closure of ℤ in the number field.

## Implementation notes
The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice.

## References
* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [P. Samuel, *Algebraic Theory of Numbers*][samuel1970algebraic]

## Tags
number field, ring of integers
-/

/-- A number field is a field which has characteristic zero and is finite
dimensional over ℚ. -/
class NumberField (K : Type _) [Field K] : Prop where
  [to_charZero : CharZero K]
  [to_finiteDimensional : FiniteDimensional ℚ K]
#align number_field NumberField

open Function Module

open Classical BigOperators nonZeroDivisors

/-- `ℤ` with its usual ring structure is not a field. -/
theorem Int.not_isField : ¬IsField ℤ := fun h =>
  Int.not_even_one <|
    (h.mul_inv_cancel two_ne_zero).imp fun a => by rw [← two_mul] <;> exact Eq.symm
#align int.not_is_field Int.not_isField

namespace NumberField

variable (K L : Type _) [Field K] [Field L] [nf : NumberField K]

include nf

-- See note [lower instance priority]
attribute [instance] NumberField.to_charZero NumberField.to_finiteDimensional

protected theorem isAlgebraic : Algebra.IsAlgebraic ℚ K :=
  Algebra.isAlgebraic_of_finite _ _
#align number_field.is_algebraic NumberField.isAlgebraic

omit nf

/-- The ring of integers (or number ring) corresponding to a number field
is the integral closure of ℤ in the number field. -/
def ringOfIntegers :=
  integralClosure ℤ K
#align number_field.ring_of_integers NumberField.ringOfIntegers

-- mathport name: ring_of_integers
scoped notation "𝓞" => NumberField.ringOfIntegers

theorem mem_ringOfIntegers (x : K) : x ∈ 𝓞 K ↔ IsIntegral ℤ x :=
  Iff.rfl
#align number_field.mem_ring_of_integers NumberField.mem_ringOfIntegers

theorem isIntegral_of_mem_ringOfIntegers {K : Type _} [Field K] {x : K} (hx : x ∈ 𝓞 K) :
    IsIntegral ℤ (⟨x, hx⟩ : 𝓞 K) := by
  obtain ⟨P, hPm, hP⟩ := hx
  refine' ⟨P, hPm, _⟩
  rw [← Polynomial.aeval_def, ← Subalgebra.coe_eq_zero, Polynomial.aeval_subalgebra_coe,
    Polynomial.aeval_def, Subtype.coe_mk, hP]
#align number_field.is_integral_of_mem_ring_of_integers NumberField.isIntegral_of_mem_ringOfIntegers

/-- Given an algebra between two fields, create an algebra between their two rings of integers.

For now, this is not an instance by default as it creates an equal-but-not-defeq diamond with
`algebra.id` when `K = L`. This is caused by `x = ⟨x, x.prop⟩` not being defeq on subtypes. This
will likely change in Lean 4. -/
def ringOfIntegersAlgebra [Algebra K L] : Algebra (𝓞 K) (𝓞 L) :=
  RingHom.toAlgebra
    { toFun := fun k => ⟨algebraMap K L k, IsIntegral.algebraMap k.2⟩
      map_zero' := Subtype.ext <| by simp only [Subtype.coe_mk, Subalgebra.coe_zero, map_zero]
      map_one' := Subtype.ext <| by simp only [Subtype.coe_mk, Subalgebra.coe_one, map_one]
      map_add' := fun x y =>
        Subtype.ext <| by simp only [map_add, Subalgebra.coe_add, Subtype.coe_mk]
      map_mul' := fun x y =>
        Subtype.ext <| by simp only [Subalgebra.coe_mul, map_mul, Subtype.coe_mk] }
#align number_field.ring_of_integers_algebra NumberField.ringOfIntegersAlgebra

namespace RingOfIntegers

variable {K}

instance [NumberField K] : IsFractionRing (𝓞 K) K :=
  integralClosure.isFractionRing_of_finite_extension ℚ _

instance : IsIntegralClosure (𝓞 K) ℤ K :=
  integralClosure.isIntegralClosure _ _

instance [NumberField K] : IsIntegrallyClosed (𝓞 K) :=
  integralClosure.isIntegrallyClosedOfFiniteExtension ℚ

theorem isIntegral_coe (x : 𝓞 K) : IsIntegral ℤ (x : K) :=
  x.2
#align number_field.ring_of_integers.is_integral_coe NumberField.ringOfIntegers.isIntegral_coe

theorem map_mem {F L : Type _} [Field L] [CharZero K] [CharZero L] [AlgHomClass F ℚ K L] (f : F)
    (x : 𝓞 K) : f x ∈ 𝓞 L :=
  (mem_ringOfIntegers _ _).2 <| map_isIntegral_int f <| ringOfIntegers.isIntegral_coe x
#align number_field.ring_of_integers.map_mem NumberField.ringOfIntegers.map_mem

/-- The ring of integers of `K` are equivalent to any integral closure of `ℤ` in `K` -/
protected noncomputable def equiv (R : Type _) [CommRing R] [Algebra R K]
    [IsIntegralClosure R ℤ K] : 𝓞 K ≃+* R :=
  (IsIntegralClosure.equiv ℤ R K _).symm.toRingEquiv
#align number_field.ring_of_integers.equiv NumberField.ringOfIntegers.equiv

variable (K)

include nf

instance : CharZero (𝓞 K) :=
  CharZero.of_module _ K

instance : IsNoetherian ℤ (𝓞 K) :=
  IsIntegralClosure.isNoetherian _ ℚ K _

/-- The ring of integers of a number field is not a field. -/
theorem not_isField : ¬IsField (𝓞 K) :=
  by
  have h_inj : Function.Injective ⇑(algebraMap ℤ (𝓞 K)) :=
    RingHom.injective_int (algebraMap ℤ (𝓞 K))
  intro hf
  exact
    Int.not_isField (((IsIntegralClosure.isIntegral_algebra ℤ K).isField_iff_isField h_inj).mpr hf)
#align number_field.ring_of_integers.not_is_field NumberField.ringOfIntegers.not_isField

instance : IsDedekindDomain (𝓞 K) :=
  IsIntegralClosure.isDedekindDomain ℤ ℚ K _

instance : Free ℤ (𝓞 K) :=
  IsIntegralClosure.module_free ℤ ℚ K (𝓞 K)

instance : IsLocalization (Algebra.algebraMapSubmonoid (𝓞 K) ℤ⁰) K :=
  IsIntegralClosure.isLocalization ℤ ℚ K (𝓞 K)

/-- A ℤ-basis of the ring of integers of `K`. -/
noncomputable def basis : Basis (Free.ChooseBasisIndex ℤ (𝓞 K)) ℤ (𝓞 K) :=
  Free.chooseBasis ℤ (𝓞 K)
#align number_field.ring_of_integers.basis NumberField.ringOfIntegers.basis

end RingOfIntegers

include nf

/-- A basis of `K` over `ℚ` that is also a basis of `𝓞 K` over `ℤ`. -/
noncomputable def integralBasis : Basis (Free.ChooseBasisIndex ℤ (𝓞 K)) ℚ K :=
  Basis.localizationLocalization ℚ (nonZeroDivisors ℤ) K (ringOfIntegers.basis K)
#align number_field.integral_basis NumberField.integralBasis

@[simp]
theorem integralBasis_apply (i : Free.ChooseBasisIndex ℤ (𝓞 K)) :
    integralBasis K i = algebraMap (𝓞 K) K (ringOfIntegers.basis K i) :=
  Basis.localizationLocalization_apply ℚ (nonZeroDivisors ℤ) K (ringOfIntegers.basis K) i
#align number_field.integral_basis_apply NumberField.integralBasis_apply

theorem ringOfIntegers.rank : FiniteDimensional.finrank ℤ (𝓞 K) = FiniteDimensional.finrank ℚ K :=
  IsIntegralClosure.rank ℤ ℚ K (𝓞 K)
#align number_field.ring_of_integers.rank NumberField.ringOfIntegers.rank

end NumberField

namespace Rat

open NumberField

instance numberField : NumberField ℚ
    where
  to_charZero := inferInstance
  to_finiteDimensional :=-- The vector space structure of `ℚ` over itself can arise in multiple ways:
  -- all fields are vector spaces over themselves (used in `rat.finite_dimensional`)
  -- all char 0 fields have a canonical embedding of `ℚ` (used in `number_field`).
  -- Show that these coincide:
  by convert(inferInstance : FiniteDimensional ℚ ℚ)
#align rat.number_field Rat.numberField

/-- The ring of integers of `ℚ` as a number field is just `ℤ`. -/
noncomputable def ringOfIntegersEquiv : ringOfIntegers ℚ ≃+* ℤ :=
  ringOfIntegers.equiv ℤ
#align rat.ring_of_integers_equiv Rat.ringOfIntegersEquiv

end Rat

namespace AdjoinRoot

section

open Polynomial

attribute [-instance] algebraRat

/-- The quotient of `ℚ[X]` by the ideal generated by an irreducible polynomial of `ℚ[X]`
is a number field. -/
instance {f : ℚ[X]} [hf : Fact (Irreducible f)] : NumberField (AdjoinRoot f)
    where
  to_charZero := charZero_of_injective_algebraMap (algebraMap ℚ _).Injective
  to_finiteDimensional := by convert(AdjoinRoot.powerBasis hf.out.ne_zero).FiniteDimensional

end

end AdjoinRoot