import Mathlib.Data.Nat.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Data.Int.Basic
import Mathlib.Data.String.Defs
import Mathlib.Data.String.Lemmas
import Mathlib.Data.Equiv.Basic
import Timelib.Util
import Timelib.Date.ScalarDate
import Timelib.Date.Convert
import Timelib.NanoPrecision.Duration.SignedDuration
import Timelib.NanoPrecision.Duration.UnsignedDuration
import Timelib.NanoPrecision.ClockTime.NaiveClockTime
import Lean.Data.Json

/--
If nonnegative, the number of nanoseconds since the epoch (midnight of 0001/Jan/01)
If negative, the number of nanoseconds until the epoch (midnight of 0001/Jan/01)
-/
structure NaiveDateTime where
  nanos : Int
deriving DecidableEq, Ord, Hashable, Repr, Lean.ToJson, Lean.FromJson

instance : Inhabited NaiveDateTime where
  default := ⟨0⟩

/-
Using `Int.fdiv`, because we have a positive denominator, and we want to round
down if `dt.nanos` is negative, up if it's nonnegative.
-/
def NaiveDateTime.toScalarDate (dt : NaiveDateTime) : ScalarDate := ⟨(dt.nanos.fdiv oneDayNanos) + 1⟩

def NaiveDateTime.dayOfWeek (dt : NaiveDateTime) : Int := dt.toScalarDate.dayOfWeek

/--
The `DateTime` as of midnight (00:00:00 uninterpreted) on the ymd.
We subtract one to account for the fact that `Date` is one day ahead of the zero-based `NaiveDateTime`.
-/
def NaiveDateTime.fromYmd
  (y : Year)
  (m : Month)
  (d : Nat)
  (hd : 1 <= d ∧ d <= m.numDays y := by decide) : NaiveDateTime :=
    ⟨oneDayNanos * ((Ymd.mk y m d hd.left hd.right).toScalarDate.day - 1)⟩

def NaiveDateTime.fromYmdsn
  (y : Year)
  (m : Month)
  (d : Nat)
  (s : Nat)
  (n : Nat)
  (hd : 1 <= d ∧ d <= m.numDays y := by decide) : NaiveDateTime :=
    ⟨(NaiveDateTime.fromYmd y m d hd).nanos + (oneSecondNanos * s) + n⟩

instance : Equiv Int NaiveDateTime where
  toFun := NaiveDateTime.mk
  invFun := NaiveDateTime.nanos
  left_inv := by simp [Function.LeftInverse]
  right_inv := by simp [Function.LeftInverse, Function.RightInverse]

theorem NaiveDateTime.eq_of_val_eq : ∀ {d1 d2 : NaiveDateTime} (h : d1.nanos = d2.nanos), d1 = d2
| ⟨_⟩, _, rfl => rfl

theorem NaiveDateTime.val_ne_of_ne : ∀ {d1 d2 : NaiveDateTime} (h : d1 ≠ d2), d1.nanos ≠ d2.nanos
| ⟨x⟩, ⟨y⟩, h => by intro hh; apply h; exact congrArg NaiveDateTime.mk hh

instance : LT NaiveDateTime where
  lt := InvImage Int.lt NaiveDateTime.nanos

instance : LE NaiveDateTime where
  le := InvImage Int.le NaiveDateTime.nanos

@[simp] theorem NaiveDateTime.le_def (d₁ d₂ : NaiveDateTime) : (d₁ <= d₂) = (d₁.nanos <= d₂.nanos) := rfl
@[simp] theorem NaiveDateTime.lt_def (d₁ d₂ : NaiveDateTime) : (d₁ < d₂) = (d₁.nanos < d₂.nanos) := rfl

instance instDecidableLENaiveDateTime (d₁ d₂ : NaiveDateTime) : Decidable (d₁ <= d₂) := inferInstanceAs (Decidable <| d₁.nanos <= d₂.nanos)
instance instDecidableLTNaiveDateTime (d₁ d₂ : NaiveDateTime) : Decidable (d₁ < d₂) := inferInstanceAs (Decidable <| d₁.nanos < d₂.nanos)

instance : LinearOrder NaiveDateTime where
  le_refl (a) := le_refl a.nanos
  le_trans (a b c) := Int.le_trans
  lt_iff_le_not_le (a b) := Int.lt_iff_le_not_le
  le_antisymm (a b h1 h2) := by
    apply NaiveDateTime.eq_of_val_eq
    exact le_antisymm h1 h2
  le_total := by simp [NaiveDateTime.le_def, le_total]
  decidable_le := inferInstance

def NaiveDateTime.seconds (d : NaiveDateTime) : Int := d.nanos / oneSecondNanos

def NaiveDateTime.fromNanos : Int → NaiveDateTime := NaiveDateTime.mk

def NaiveDateTime.toYmd (d : NaiveDateTime) : Ymd := d.toScalarDate.toYmd

def NaiveDateTime.year (d : NaiveDateTime) : Year := d.toScalarDate.year

instance : ToString NaiveDateTime where
  toString dt :=
    let ⟨y, m, d, _, _⟩ := dt.toYmd
    let t : String := ToString.toString <| NaiveClockTime.mk (Fin.ofInt'' (dt.nanos % (↑oneDayNanos)))
    s!"{y}/{m.toNat}/{d}; {t}"

@[reducible]
def NaiveDateTime.dateEq : NaiveDateTime → NaiveDateTime → Prop
| n₁, n₂ => n₁.toScalarDate = n₂.toScalarDate

def NaiveDateTime.dateEq.Equivalence : Equivalence NaiveDateTime.dateEq := {
  refl := fun _ => rfl
  symm := fun h => h.symm
  trans := fun h h' => Eq.trans h h'
}

instance instNaiveDateTimeSetoid : Setoid NaiveDateTime :=
  ⟨NaiveDateTime.dateEq, NaiveDateTime.dateEq.Equivalence⟩

instance (d₁ d₂ : NaiveDateTime) : Decidable <| d₁.dateEq d₂ := inferInstance

instance {n : Nat} : OfNat NaiveDateTime n where
  ofNat := ⟨n⟩

instance : HAdd NaiveDateTime SignedDuration NaiveDateTime where
  hAdd da du := ⟨da.nanos + du.val⟩

instance : HAdd SignedDuration NaiveDateTime NaiveDateTime where
  hAdd du da := da + du

theorem NaiveDateTime.hAdd_signed_def (d : NaiveDateTime) (dur : SignedDuration) : d + dur = ⟨d.nanos + dur.val⟩ := rfl
theorem NaiveDateTime.hAdd_signed_def_rev (d : NaiveDateTime) (dur : SignedDuration) : dur + d = ⟨d.nanos + dur.val⟩ := rfl

instance : HSub NaiveDateTime SignedDuration NaiveDateTime where
  hSub t dur := t + -dur

theorem NaiveDateTime.hSub_signed_def (d : NaiveDateTime) (dur : SignedDuration) : d - dur = d + -dur := rfl

theorem NaiveDateTime.hAdd_signed_sub_cancel (t : NaiveDateTime) (d : SignedDuration) : t + d - d = t := by
  apply NaiveDateTime.eq_of_val_eq
  simp [NaiveDateTime.hSub_signed_def, NaiveDateTime.hAdd_signed_def]
  apply Int.add_neg_cancel_right

theorem NaiveDateTime.hAdd_signed_sub_add_cancel (t : NaiveDateTime) (d : SignedDuration) : t - d + d = t := by
  simp [NaiveDateTime.hSub_signed_def, NaiveDateTime.hAdd_signed_def]
  exact NaiveDateTime.eq_of_val_eq (Int.sub_add_cancel t.nanos d.val)

theorem NaiveDateTime.hAdd_signed_comm (t : NaiveDateTime) (d : SignedDuration) : t + d = d + t := by
  simp [NaiveDateTime.hAdd_signed_def, NaiveDateTime.hAdd_signed_def_rev]

instance : HAdd NaiveDateTime UnsignedDuration NaiveDateTime where
  hAdd da du := ⟨da.nanos + du.val⟩

instance : HAdd UnsignedDuration NaiveDateTime NaiveDateTime where
  hAdd du da := da + du

theorem NaiveDateTime.hAdd_unsigned_def (d : NaiveDateTime) (dur : UnsignedDuration) : d + dur = ⟨d.nanos + dur.val⟩ := rfl

instance : HSub NaiveDateTime UnsignedDuration NaiveDateTime where
  hSub da du := ⟨da.nanos - du.val⟩

theorem NaiveDateTime.hSub_unsigned_def (d : NaiveDateTime) (dur : UnsignedDuration) : d - dur = ⟨d.nanos - dur.val⟩ := rfl

theorem NaiveDateTime.hAdd_unsigned_sub_cancel (t : NaiveDateTime) (d : UnsignedDuration) : t + d - d = t := NaiveDateTime.hAdd_signed_sub_cancel t d

theorem NaiveDateTime.hAdd_unsigned_sub_add_cancel (t : NaiveDateTime) (d : UnsignedDuration) : t - d + d = t := NaiveDateTime.hAdd_signed_sub_add_cancel t d

theorem NaiveDateTime.hAdd_unsigned_comm (t : NaiveDateTime) (d : UnsignedDuration) : t + d = d + t := NaiveDateTime.hAdd_signed_comm t d

/--
Set the clock time of the current day to `tgt`.
-/
@[reducible]
def NaiveDateTime.setClockTime (t : NaiveDateTime) (clockTime : NaiveClockTime) : NaiveDateTime :=
  let days := (t.nanos.fdiv oneDayNanos) * oneDayNanos
  ⟨days + clockTime.nanos.val⟩


import morphisms.closed_immersion
import for_mathlib.field
import topology.local_at_target

open opposite category_theory category_theory.limits topological_space

noncomputable theory

namespace algebraic_geometry

section fiber

universe u

variables {X Y : Scheme.{u}}

abbreviation Scheme.stalk_residue (X : Scheme) (x : X.carrier) :
  X.stalk x ⟶ X.residue_field x :=
local_ring.residue _

lemma is_iso_to_stalk_residue {R : Type*} [field R] (x) :
  is_iso (structure_sheaf.to_stalk R x ≫ (Scheme.Spec.obj $ op $ CommRing.of R).stalk_residue _) :=
begin
  apply_with (is_iso_of_reflects_iso _ (forget $ CommRing)) { instances := ff },
  rw is_iso_iff_bijective,
  refine ⟨ring_hom.injective _, _⟩,
  intro y,
  obtain ⟨y' : (Spec.structure_sheaf R).presheaf.stalk x, rfl⟩ := ideal.quotient.mk_surjective y,
  obtain ⟨y : R, s, rfl⟩ := is_localization.mk'_surjective x.as_ideal.prime_compl y',
  have : (s : R) ≠ 0 := λ e, s.prop (e.symm ▸ x.as_ideal.zero_mem),
  refine ⟨(y/s : _), _⟩,
  change ideal.quotient.mk _ _ = _,
  congr' 1,
  apply is_localization.eq_mk'_iff_mul_eq.mpr,
  refine ((map_mul _ _ _).symm.trans _),
  rw div_mul_cancel _ this,
  refl
end
.
instance (X : Scheme) (x) : epi (X.stalk_residue x) :=
begin
  refine (forget _).epi_of_epi_map _,
  rw epi_iff_surjective,
  exact ideal.quotient.mk_surjective
end

@[simp, reassoc]
lemma Scheme.stalk_residue_eq (X : Scheme) {x y : X.carrier} (e : x = y) :
  X.stalk_residue y ≫ X.residue_field_of_eq e =
    X.presheaf.stalk_specializes (specializes_of_eq e) ≫ X.stalk_residue x := rfl

@[simp, reassoc]
lemma Scheme.stalk_residue_map {X Y : Scheme} (f : X ⟶ Y) {x : X.carrier} :
  Y.stalk_residue _ ≫ f.map_residue_field x = PresheafedSpace.stalk_map f.1 x ≫ X.stalk_residue x :=
rfl

lemma is_affine.hom_ext {X Y : Scheme} [is_affine Y] (f g : X ⟶ Y) (e : Scheme.Γ.map f.op = Scheme.Γ.map g.op) :
  f = g :=
begin
  rw [← cancel_mono (Γ_Spec.adjunction.unit.app Y), ← Γ_Spec.adjunction.unit_naturality f, ← Γ_Spec.adjunction.unit_naturality g,
    functor.right_op_map, functor.right_op_map, e],
end

lemma is_affine_open.from_Spec_of_affine {R : CommRing} {U : opens (Scheme.Spec.obj $ op R).carrier} (h : is_affine_open U) :
  h.from_Spec = Scheme.Spec.map (eq_to_hom (by unfreezingI { cases R, refl }) ≫ structure_sheaf.to_open R U).op :=
begin
  apply is_affine.hom_ext,
  delta is_affine_open.from_Spec Scheme.iso_Spec,
  haveI : is_affine _ := h,
  have := @adjunction.left_triangle_components _ _ _ _ _ _ Γ_Spec.adjunction ((Scheme.Spec.obj (op R)).restrict U.open_embedding),
  rw [functor.right_op_map, ← quiver.hom.unop_inj.eq_iff, unop_comp, quiver.hom.unop_op] at this,
  have := is_iso.eq_inv_of_inv_hom_id this,
  apply quiver.hom.op_inj,
  simp only [quiver.hom.op_unop, functor.map_inv, op_inv, as_iso_inv, op_comp, category.assoc, functor.map_comp, unop_comp, ← this],
  erw Γ_Spec.adjunction.counit_naturality_assoc,
  rw [← is_iso.comp_inv_eq, ← cancel_mono (Γ_Spec.adjunction.counit.app $ op $ CommRing.of R)],
  conv_rhs { erw (Γ_Spec.adjunction.counit_naturality (structure_sheaf.to_open R U).op) },
  simp_rw [category.assoc],
  congr' 1,
  unfreezingI { cases R },
  slice_lhs 3 3 { simp only [eq_to_hom_op, eq_to_hom_map Scheme.Spec, eq_to_hom_map Scheme.Γ, inv_eq_to_hom] },
  apply quiver.hom.unop_inj,
  simp only [algebraic_geometry.Γ_Spec.LocallyRingedSpace_adjunction_counit, nat_trans.op_app, quiver.hom.unop_op,
    unop_inv, Scheme.Spec_map_2, Scheme.Γ_map, Spec_Γ_identity_inv_app, category.assoc,
    Γ_Spec.adjunction_counit_app, unop_comp, eq_to_hom_refl, to_Spec_Γ, is_iso.inv_id],
  dsimp,
  rw [category.id_comp, reassoc_of structure_sheaf.to_open_res, structure_sheaf.to_open_res]
end

@[elementwise, reassoc]
lemma Scheme.from_Spec_residue_field_map_residue_field {X : Scheme} (x) (s)  :
  X.residue_field_of_eq (Scheme.from_Spec_residue_field_base _ _)  ≫
    (X.from_Spec_residue_field x).map_residue_field s = structure_sheaf.to_stalk _ s ≫
    (Scheme.Spec.obj _).stalk_residue _ :=
begin
  apply quiver.hom.op_inj,
  apply Scheme.Spec.map_injective,
  rw [pullback.triplet.eq_from_Spec_residue_field_aux, Scheme.from_Spec_residue_field, op_comp, functor.map_comp],
  congr' 1,
  rw [← (top_is_affine_open _).from_Spec_stalk_eq],
  rotate, { trivial }, { apply_instance },
  delta is_affine_open.from_Spec_stalk structure_sheaf.to_stalk,
  rw [op_comp, functor.map_comp, is_affine_open.from_Spec_of_affine],
  refl
end

@[instance]
lemma is_iso_from_Spec_residue_field_map_residue {X : Scheme} (x) (s) :
  is_iso ((X.from_Spec_residue_field x).map_residue_field s) :=
begin
  apply_with (is_iso_of_reflects_iso _ (forget $ CommRing)) { instances := ff },
  rw is_iso_iff_bijective,
  refine ⟨ring_hom.injective _, _⟩,
  intro y,
  obtain ⟨y' : (Spec.structure_sheaf _).presheaf.stalk s, rfl⟩ := ideal.quotient.mk_surjective y,
  obtain ⟨y, rfl⟩ : ∃ y : X.residue_field x, structure_sheaf.to_stalk _ s y = y',
  { obtain ⟨y : X.residue_field x, t, rfl⟩ := is_localization.mk'_surjective s.as_ideal.prime_compl y',
    refine ⟨y/t.1, _⟩,
    apply is_localization.eq_mk'_iff_mul_eq.mpr,
    refine (map_mul _ _ _).symm.trans _,
    rw [subtype.val_eq_coe, div_mul_cancel],
    exacts [rfl, λ e, t.prop (e.symm ▸ s.as_ideal.zero_mem)] },
  refine ⟨X.residue_field_of_eq (Scheme.from_Spec_residue_field_base _ _) y, _⟩,
  refine (Scheme.from_Spec_residue_field_map_residue_field_apply x s y).trans _,
  refl
end

instance {X : Scheme} {x y} (e : x = y) : is_iso (X.residue_field_of_eq e) :=
⟨⟨X.residue_field_of_eq e.symm, by simp, by simp⟩⟩

def Scheme.hom.fiber (f : X ⟶ Y) (y : Y.carrier) : Scheme :=
pullback f (Y.from_Spec_residue_field y)

@[derive is_preimmersion]
def Scheme.hom.fiber_ι (f : X ⟶ Y) (y : Y.carrier) : f.fiber y ⟶ X :=
pullback.fst

def Scheme.hom.fiber_to_residue_field (f : X ⟶ Y) (y : Y.carrier) :
  f.fiber y ⟶ Scheme.Spec.obj (op $ Y.residue_field y) :=
pullback.snd

def Scheme.hom.fiber_residue_field_tensor_iso (f : X ⟶ Y) (y : Y.carrier)
  (T : pullback.triplet f (Y.from_Spec_residue_field y)) :
  T.residue_field_tensor ≅ X.residue_field T.x :=
(as_iso pushout.inl).symm

instance (f : X ⟶ Y) (y : Y.carrier)
  (T : pullback.triplet f (Y.from_Spec_residue_field y)) :
  field T.residue_field_tensor :=
(f.fiber_residue_field_tensor_iso y T).CommRing_iso_to_ring_equiv.symm.is_field.to_field

def Scheme.hom.fiber_carrier (f : X ⟶ Y) (y : Y.carrier) :
  (f.fiber y).carrier ≃ₜ { x : X.carrier // f.1.base x = y } :=
begin
  refine (homeomorph.of_embedding _ (is_preimmersion.base_embedding $ f.fiber_ι y)).trans
    (homeomorph.set_congr _),
  ext x,
  rw [Scheme.hom.fiber_ι, pullback.range_fst, Scheme.range_from_Spec_residue_field],
  exact set.mem_singleton_iff
end

@[simp]
lemma Scheme.hom.fiber_carrier_apply (f : X ⟶ Y) (y : Y.carrier) (x) :
  (f.fiber_carrier y x : X.carrier) = (f.fiber_ι y).1.base x := rfl

lemma Scheme.hom.fiber_ι_coe (f : X ⟶ Y) (y : Y.carrier) :
  ⇑(f.fiber_ι y).1.base = (coe ∘ (f.fiber_carrier y) : _ → X.carrier) :=
funext $ λ x, (f.fiber_carrier_apply y x).symm

lemma Scheme.hom.range_fiber_ι (f : X ⟶ Y) (y : Y.carrier) :
  set.range (f.fiber_ι y).1.base = f.1.base ⁻¹' {y} :=
begin
  rw [Scheme.hom.fiber_ι_coe, set.range_comp, set.range_iff_surjective.mpr
    (f.fiber_carrier y).surjective, set.image_univ, subtype.range_coe],
  ext, rw [set.mem_preimage, set.mem_singleton_iff], refl,
end

def Scheme.hom.Spec_residue_field_to_fiber (f : X ⟶ Y) (x : X.carrier) :
  Scheme.Spec.obj (op $ X.residue_field x) ⟶ f.fiber (f.1.base x) :=
pullback.lift _ _ (f.map_residue_field_from_Spec_residue_field x).symm

@[simp, reassoc]
lemma Scheme.hom.Spec_residue_field_to_fiber_ι (f : X ⟶ Y) (x : X.carrier) :
  f.Spec_residue_field_to_fiber x ≫ f.fiber_ι _ = X.from_Spec_residue_field x :=
pullback.lift_fst _ _ _

@[simp, reassoc]
lemma Scheme.hom.Spec_residue_field_to_fiber_to_residue_field (f : X ⟶ Y) (x : X.carrier) :
  f.Spec_residue_field_to_fiber x ≫ f.fiber_to_residue_field _ =
    Scheme.Spec.map (f.map_residue_field x).op :=
pullback.lift_snd _ _ _

instance (f : X ⟶ Y) (x : X.carrier) : is_preimmersion (f.Spec_residue_field_to_fiber x) :=
begin
  haveI H : is_preimmersion (X.from_Spec_residue_field x) := infer_instance,
  rw ← f.Spec_residue_field_to_fiber_ι at H,
  exact @@is_preimmersion.of_comp _ _ H
end

end fiber

end algebraic_geometry


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.factorial
import Mathlib.PostPort

namespace Mathlib

/-!
# Binomial coefficients

This file contains a definition of binomial coefficients and simple lemmas (i.e. those not
requiring more imports).

## Main definition and results

- `nat.choose`: binomial coefficients, defined inductively
- `nat.choose_eq_factorial_div_factorial`: a proof that `choose n k = n! / (k! * (n - k)!)`
- `nat.choose_symm`: symmetry of binomial coefficients
- `nat.choose_le_succ_of_lt_half_left`: `choose n k` is increasing for small values of `k`
- `nat.choose_le_middle`: `choose n r` is maximised when `r` is `n/2`

-/

namespace nat

/-- `choose n k` is the number of `k`-element subsets in an `n`-element set. Also known as binomial
coefficients. -/
def choose : ℕ → ℕ → ℕ :=
  sorry

@[simp] theorem choose_zero_right (n : ℕ) : choose n 0 = 1 :=
  nat.cases_on n (Eq.refl (choose 0 0)) fun (n : ℕ) => Eq.refl (choose (Nat.succ n) 0)

@[simp] theorem choose_zero_succ (k : ℕ) : choose 0 (Nat.succ k) = 0 :=
  rfl

theorem choose_succ_succ (n : ℕ) (k : ℕ) : choose (Nat.succ n) (Nat.succ k) = choose n k + choose n (Nat.succ k) :=
  rfl

theorem choose_eq_zero_of_lt {n : ℕ} {k : ℕ} : n < k → choose n k = 0 := sorry

@[simp] theorem choose_self (n : ℕ) : choose n n = 1 := sorry

@[simp] theorem choose_succ_self (n : ℕ) : choose n (Nat.succ n) = 0 :=
  choose_eq_zero_of_lt (lt_succ_self n)

@[simp] theorem choose_one_right (n : ℕ) : choose n 1 = n := sorry

/- The `n+1`-st triangle number is `n` more than the `n`-th triangle number -/

theorem triangle_succ (n : ℕ) : (n + 1) * (n + 1 - 1) / bit0 1 = n * (n - 1) / bit0 1 + n := sorry

/-- `choose n 2` is the `n`-th triangle number. -/
theorem choose_two_right (n : ℕ) : choose n (bit0 1) = n * (n - 1) / bit0 1 := sorry

theorem choose_pos {n : ℕ} {k : ℕ} : k ≤ n → 0 < choose n k := sorry

theorem succ_mul_choose_eq (n : ℕ) (k : ℕ) : Nat.succ n * choose n k = choose (Nat.succ n) (Nat.succ k) * Nat.succ k := sorry

theorem choose_mul_factorial_mul_factorial {n : ℕ} {k : ℕ} : k ≤ n → choose n k * factorial k * factorial (n - k) = factorial n := sorry

theorem choose_eq_factorial_div_factorial {n : ℕ} {k : ℕ} (hk : k ≤ n) : choose n k = factorial n / (factorial k * factorial (n - k)) := sorry

theorem factorial_mul_factorial_dvd_factorial {n : ℕ} {k : ℕ} (hk : k ≤ n) : factorial k * factorial (n - k) ∣ factorial n := sorry

@[simp] theorem choose_symm {n : ℕ} {k : ℕ} (hk : k ≤ n) : choose n (n - k) = choose n k := sorry

theorem choose_symm_of_eq_add {n : ℕ} {a : ℕ} {b : ℕ} (h : n = a + b) : choose n a = choose n b := sorry

theorem choose_symm_add {a : ℕ} {b : ℕ} : choose (a + b) a = choose (a + b) b :=
  choose_symm_of_eq_add rfl

theorem choose_symm_half (m : ℕ) : choose (bit0 1 * m + 1) (m + 1) = choose (bit0 1 * m + 1) m := sorry

theorem choose_succ_right_eq (n : ℕ) (k : ℕ) : choose n (k + 1) * (k + 1) = choose n k * (n - k) := sorry

@[simp] theorem choose_succ_self_right (n : ℕ) : choose (n + 1) n = n + 1 := sorry

theorem choose_mul_succ_eq (n : ℕ) (k : ℕ) : choose n k * (n + 1) = choose (n + 1) k * (n + 1 - k) := sorry

/-! ### Inequalities -/

/-- Show that `nat.choose` is increasing for small values of the right argument. -/
theorem choose_le_succ_of_lt_half_left {r : ℕ} {n : ℕ} (h : r < n / bit0 1) : choose n r ≤ choose n (r + 1) := sorry

/-- Show that for small values of the right argument, the middle value is largest. -/
/-- `choose n r` is maximised when `r` is `n/2`. -/
theorem choose_le_middle (r : ℕ) (n : ℕ) : choose n r ≤ choose n (n / bit0 1) := sorry


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem algebra_2rootsintpoly_am10tap11eqasqpam110
  (a : ℂ) :
  (a - 10) * (a + 11) = a^2 + a - 110 :=
begin
  ring,
end


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.nat.cast.prod
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Cast.Basic
import Mathbin.Algebra.Group.Prod

/-!
# The product of two `add_monoid_with_one`s.

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

variable {α β : Type _}

namespace Prod

variable [AddMonoidWithOne α] [AddMonoidWithOne β]

instance : AddMonoidWithOne (α × β) :=
  { Prod.addMonoid, Prod.hasOne with
    natCast := fun n => (n, n)
    natCast_zero := congr_arg₂ Prod.mk Nat.cast_zero Nat.cast_zero
    natCast_succ := fun n => congr_arg₂ Prod.mk (Nat.cast_succ _) (Nat.cast_succ _) }

/- warning: prod.fst_nat_cast -> Prod.fst_natCast is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : AddMonoidWithOne.{u1} α] [_inst_2 : AddMonoidWithOne.{u2} β] (n : Nat), Eq.{succ u1} α (Prod.fst.{u1, u2} α β ((fun (a : Type) (b : Sort.{max (succ u1) (succ u2)}) [self : HasLiftT.{1, max (succ u1) (succ u2)} a b] => self.0) Nat (Prod.{u1, u2} α β) (HasLiftT.mk.{1, max (succ u1) (succ u2)} Nat (Prod.{u1, u2} α β) (CoeTCₓ.coe.{1, max (succ u1) (succ u2)} Nat (Prod.{u1, u2} α β) (Nat.castCoe.{max u1 u2} (Prod.{u1, u2} α β) (AddMonoidWithOne.toNatCast.{max u1 u2} (Prod.{u1, u2} α β) (Prod.addMonoidWithOne.{u1, u2} α β _inst_1 _inst_2))))) n)) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat α (HasLiftT.mk.{1, succ u1} Nat α (CoeTCₓ.coe.{1, succ u1} Nat α (Nat.castCoe.{u1} α (AddMonoidWithOne.toNatCast.{u1} α _inst_1)))) n)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : AddMonoidWithOne.{u2} α] [_inst_2 : AddMonoidWithOne.{u1} β] (n : Nat), Eq.{succ u2} α (Prod.fst.{u2, u1} α β (Nat.cast.{max u2 u1} (Prod.{u2, u1} α β) (AddMonoidWithOne.toNatCast.{max u2 u1} (Prod.{u2, u1} α β) (Prod.instAddMonoidWithOneProd.{u2, u1} α β _inst_1 _inst_2)) n)) (Nat.cast.{u2} α (AddMonoidWithOne.toNatCast.{u2} α _inst_1) n)
Case conversion may be inaccurate. Consider using '#align prod.fst_nat_cast Prod.fst_natCastₓ'. -/
@[simp]
theorem fst_natCast (n : ℕ) : (n : α × β).fst = n := by induction n <;> simp [*]
#align prod.fst_nat_cast Prod.fst_natCast

/- warning: prod.snd_nat_cast -> Prod.snd_natCast is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : AddMonoidWithOne.{u1} α] [_inst_2 : AddMonoidWithOne.{u2} β] (n : Nat), Eq.{succ u2} β (Prod.snd.{u1, u2} α β ((fun (a : Type) (b : Sort.{max (succ u1) (succ u2)}) [self : HasLiftT.{1, max (succ u1) (succ u2)} a b] => self.0) Nat (Prod.{u1, u2} α β) (HasLiftT.mk.{1, max (succ u1) (succ u2)} Nat (Prod.{u1, u2} α β) (CoeTCₓ.coe.{1, max (succ u1) (succ u2)} Nat (Prod.{u1, u2} α β) (Nat.castCoe.{max u1 u2} (Prod.{u1, u2} α β) (AddMonoidWithOne.toNatCast.{max u1 u2} (Prod.{u1, u2} α β) (Prod.addMonoidWithOne.{u1, u2} α β _inst_1 _inst_2))))) n)) ((fun (a : Type) (b : Type.{u2}) [self : HasLiftT.{1, succ u2} a b] => self.0) Nat β (HasLiftT.mk.{1, succ u2} Nat β (CoeTCₓ.coe.{1, succ u2} Nat β (Nat.castCoe.{u2} β (AddMonoidWithOne.toNatCast.{u2} β _inst_2)))) n)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : AddMonoidWithOne.{u1} α] [_inst_2 : AddMonoidWithOne.{u2} β] (n : Nat), Eq.{succ u2} β (Prod.snd.{u1, u2} α β (Nat.cast.{max u1 u2} (Prod.{u1, u2} α β) (AddMonoidWithOne.toNatCast.{max u1 u2} (Prod.{u1, u2} α β) (Prod.instAddMonoidWithOneProd.{u1, u2} α β _inst_1 _inst_2)) n)) (Nat.cast.{u2} β (AddMonoidWithOne.toNatCast.{u2} β _inst_2) n)
Case conversion may be inaccurate. Consider using '#align prod.snd_nat_cast Prod.snd_natCastₓ'. -/
@[simp]
theorem snd_natCast (n : ℕ) : (n : α × β).snd = n := by induction n <;> simp [*]
#align prod.snd_nat_cast Prod.snd_natCast

end Prod


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.matrix.notation
import Mathlib.field_theory.mv_polynomial
import Mathlib.field_theory.finite.polynomial
import Mathlib.number_theory.basic
import Mathlib.ring_theory.witt_vector.witt_polynomial
import Mathlib.PostPort

universes u_2 u_1

namespace Mathlib

/-!
# Witt structure polynomials

In this file we prove the main theorem that makes the whole theory of Witt vectors work.
Briefly, consider a polynomial `Φ : mv_polynomial idx ℤ` over the integers,
with polynomials variables indexed by an arbitrary type `idx`.

Then there exists a unique family of polynomials `φ : ℕ → mv_polynomial (idx × ℕ) Φ`
such that for all `n : ℕ` we have (`witt_structure_int_exists_unique`)
```
bind₁ φ (witt_polynomial p ℤ n) = bind₁ (λ i, (rename (prod.mk i) (witt_polynomial p ℤ n))) Φ
```
In other words: evaluating the `n`-th Witt polynomial on the family `φ`
is the same as evaluating `Φ` on the (appropriately renamed) `n`-th Witt polynomials.

N.b.: As far as we know, these polynomials do not have a name in the literature,
so we have decided to call them the “Witt structure polynomials”. See `witt_structure_int`.

## Special cases

With the main result of this file in place, we apply it to certain special polynomials.
For example, by taking `Φ = X tt + X ff` resp. `Φ = X tt * X ff`
we obtain families of polynomials `witt_add` resp. `witt_mul`
(with type `ℕ → mv_polynomial (bool × ℕ) ℤ`) that will be used in later files to define the
addition and multiplication on the ring of Witt vectors.

## Outline of the proof

The proof of `witt_structure_int_exists_unique` is rather technical, and takes up most of this file.

We start by proving the analogous version for polynomials with rational coefficients,
instead of integer coefficients.
In this case, the solution is rather easy,
since the Witt polynomials form a faithful change of coordinates
in the polynomial ring `mv_polynomial ℕ ℚ`.
We therefore obtain a family of polynomials `witt_structure_rat Φ`
for every `Φ : mv_polynomial idx ℚ`.

If `Φ` has integer coefficients, then the polynomials `witt_structure_rat Φ n` do so as well.
Proving this claim is the essential core of this file, and culminates in
`map_witt_structure_int`, which proves that upon mapping the coefficients
of `witt_structure_int Φ n` from the integers to the rationals,
one obtains `witt_structure_rat Φ n`.
Ultimately, the proof of `map_witt_structure_int` relies on
```
dvd_sub_pow_of_dvd_sub {R : Type*} [comm_ring R] {p : ℕ} {a b : R} :
    (p : R) ∣ a - b → ∀ (k : ℕ), (p : R) ^ (k + 1) ∣ a ^ p ^ k - b ^ p ^ k
```

## Main results

* `witt_structure_rat Φ`: the family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℚ`
  associated with `Φ : mv_polynomial idx ℚ` and satisfying the property explained above.
* `witt_structure_rat_prop`: the proof that `witt_structure_rat` indeed satisfies the property.
* `witt_structure_int Φ`: the family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℤ`
  associated with `Φ : mv_polynomial idx ℤ` and satisfying the property explained above.
* `map_witt_structure_int`: the proof that the integral polynomials `with_structure_int Φ`
  are equal to `witt_structure_rat Φ` when mapped to polynomials with rational coefficients.
* `witt_structure_int_prop`: the proof that `witt_structure_int` indeed satisfies the property.
* Five families of polynomials that will be used to define the ring structure
  on the ring of Witt vectors:
  - `witt_vector.witt_zero`
  - `witt_vector.witt_one`
  - `witt_vector.witt_add`
  - `witt_vector.witt_mul`
  - `witt_vector.witt_neg`
  (We also define `witt_vector.witt_sub`, and later we will prove that it describes subtraction,
  which is defined as `λ a b, a + -b`. See `witt_vector.sub_coeff` for this proof.)

-/

-- This lemma reduces a bundled morphism to a "mere" function,

-- and consequently the simplifier cannot use a lot of powerful simp-lemmas.

-- We disable this locally, and probably it should be disabled globally in mathlib.

/-- `witt_structure_rat Φ` is a family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℚ`
that are uniquely characterised by the property that
```
bind₁ (witt_structure_rat p Φ) (witt_polynomial p ℚ n) =
bind₁ (λ i, (rename (prod.mk i) (witt_polynomial p ℚ n))) Φ
```
In other words: evaluating the `n`-th Witt polynomial on the family `witt_structure_rat Φ`
is the same as evaluating `Φ` on the (appropriately renamed) `n`-th Witt polynomials.

See `witt_structure_rat_prop` for this property,
and `witt_structure_rat_exists_unique` for the fact that `witt_structure_rat`
gives the unique family of polynomials with this property.

These polynomials turn out to have integral coefficients,
but it requires some effort to show this.
See `witt_structure_int` for the version with integral coefficients,
and `map_witt_structure_int` for the fact that it is equal to `witt_structure_rat`
when mapped to polynomials over the rationals. -/
def witt_structure_rat (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℚ) (n : ℕ) : mv_polynomial (idx × ℕ) ℚ :=
  coe_fn
    (mv_polynomial.bind₁
      fun (k : ℕ) =>
        coe_fn (mv_polynomial.bind₁ fun (i : idx) => coe_fn (mv_polynomial.rename (Prod.mk i)) (witt_polynomial p ℚ k)) Φ)
    (X_in_terms_of_W p ℚ n)

theorem witt_structure_rat_prop (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℚ) (n : ℕ) : coe_fn (mv_polynomial.bind₁ (witt_structure_rat p Φ)) (witt_polynomial p ℚ n) =
  coe_fn (mv_polynomial.bind₁ fun (i : idx) => coe_fn (mv_polynomial.rename (Prod.mk i)) (witt_polynomial p ℚ n)) Φ := sorry

theorem witt_structure_rat_exists_unique (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℚ) : exists_unique
  fun (φ : ℕ → mv_polynomial (idx × ℕ) ℚ) =>
    ∀ (n : ℕ),
      coe_fn (mv_polynomial.bind₁ φ) (witt_polynomial p ℚ n) =
        coe_fn (mv_polynomial.bind₁ fun (i : idx) => coe_fn (mv_polynomial.rename (Prod.mk i)) (witt_polynomial p ℚ n))
          Φ := sorry

theorem witt_structure_rat_rec_aux (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℚ) (n : ℕ) : witt_structure_rat p Φ n * coe_fn mv_polynomial.C (↑p ^ n) =
  coe_fn
      (mv_polynomial.bind₁ fun (b : idx) => coe_fn (mv_polynomial.rename fun (i : ℕ) => (b, i)) (witt_polynomial p ℚ n))
      Φ -
    finset.sum (finset.range n) fun (i : ℕ) => coe_fn mv_polynomial.C (↑p ^ i) * witt_structure_rat p Φ i ^ p ^ (n - i) := sorry

/-- Write `witt_structure_rat p φ n` in terms of `witt_structure_rat p φ i` for `i < n`. -/
theorem witt_structure_rat_rec (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℚ) (n : ℕ) : witt_structure_rat p Φ n =
  coe_fn mv_polynomial.C (1 / ↑p ^ n) *
    (coe_fn
        (mv_polynomial.bind₁
          fun (b : idx) => coe_fn (mv_polynomial.rename fun (i : ℕ) => (b, i)) (witt_polynomial p ℚ n))
        Φ -
      finset.sum (finset.range n)
        fun (i : ℕ) => coe_fn mv_polynomial.C (↑p ^ i) * witt_structure_rat p Φ i ^ p ^ (n - i)) := sorry

/-- `witt_structure_int Φ` is a family of polynomials `ℕ → mv_polynomial (idx × ℕ) ℚ`
that are uniquely characterised by the property that
```
bind₁ (witt_structure_int p Φ) (witt_polynomial p ℚ n) =
bind₁ (λ i, (rename (prod.mk i) (witt_polynomial p ℚ n))) Φ
```
In other words: evaluating the `n`-th Witt polynomial on the family `witt_structure_int Φ`
is the same as evaluating `Φ` on the (appropriately renamed) `n`-th Witt polynomials.

See `witt_structure_int_prop` for this property,
and `witt_structure_int_exists_unique` for the fact that `witt_structure_int`
gives the unique family of polynomials with this property. -/
def witt_structure_int (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (n : ℕ) : mv_polynomial (idx × ℕ) ℤ :=
  finsupp.map_range rat.num sorry (witt_structure_rat p (coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) Φ) n)

theorem bind₁_rename_expand_witt_polynomial {p : ℕ} {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (n : ℕ) (IH : ∀ (m : ℕ),
  m < n + 1 →
    coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) (witt_structure_int p Φ m) =
      witt_structure_rat p (coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) Φ) m) : coe_fn
    (mv_polynomial.bind₁
      fun (b : idx) =>
        coe_fn (mv_polynomial.rename fun (i : ℕ) => (b, i)) (coe_fn (mv_polynomial.expand p) (witt_polynomial p ℤ n)))
    Φ =
  coe_fn (mv_polynomial.bind₁ fun (i : ℕ) => coe_fn (mv_polynomial.expand p) (witt_structure_int p Φ i))
    (witt_polynomial p ℤ n) := sorry

theorem C_p_pow_dvd_bind₁_rename_witt_polynomial_sub_sum {p : ℕ} {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (n : ℕ) (IH : ∀ (m : ℕ),
  m < n →
    coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) (witt_structure_int p Φ m) =
      witt_structure_rat p (coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) Φ) m) : coe_fn mv_polynomial.C ↑(p ^ n) ∣
  coe_fn
      (mv_polynomial.bind₁ fun (b : idx) => coe_fn (mv_polynomial.rename fun (i : ℕ) => (b, i)) (witt_polynomial p ℤ n))
      Φ -
    finset.sum (finset.range n) fun (i : ℕ) => coe_fn mv_polynomial.C (↑p ^ i) * witt_structure_int p Φ i ^ p ^ (n - i) := sorry

@[simp] theorem map_witt_structure_int (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (n : ℕ) : coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) (witt_structure_int p Φ n) =
  witt_structure_rat p (coe_fn (mv_polynomial.map (int.cast_ring_hom ℚ)) Φ) n := sorry

theorem witt_structure_int_prop (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (n : ℕ) : coe_fn (mv_polynomial.bind₁ (witt_structure_int p Φ)) (witt_polynomial p ℤ n) =
  coe_fn (mv_polynomial.bind₁ fun (i : idx) => coe_fn (mv_polynomial.rename (Prod.mk i)) (witt_polynomial p ℤ n)) Φ := sorry

theorem eq_witt_structure_int (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (φ : ℕ → mv_polynomial (idx × ℕ) ℤ) (h : ∀ (n : ℕ),
  coe_fn (mv_polynomial.bind₁ φ) (witt_polynomial p ℤ n) =
    coe_fn (mv_polynomial.bind₁ fun (i : idx) => coe_fn (mv_polynomial.rename (Prod.mk i)) (witt_polynomial p ℤ n)) Φ) : φ = witt_structure_int p Φ := sorry

theorem witt_structure_int_exists_unique (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) : exists_unique
  fun (φ : ℕ → mv_polynomial (idx × ℕ) ℤ) =>
    ∀ (n : ℕ),
      coe_fn (mv_polynomial.bind₁ φ) (witt_polynomial p ℤ n) =
        coe_fn (mv_polynomial.bind₁ fun (i : idx) => coe_fn (mv_polynomial.rename (Prod.mk i)) (witt_polynomial p ℤ n))
          Φ :=
  Exists.intro (witt_structure_int p Φ) { left := witt_structure_int_prop p Φ, right := eq_witt_structure_int p Φ }

theorem witt_structure_prop (p : ℕ) {R : Type u_1} {idx : Type u_2} [comm_ring R] [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (n : ℕ) : coe_fn (mv_polynomial.aeval fun (i : ℕ) => coe_fn (mv_polynomial.map (int.cast_ring_hom R)) (witt_structure_int p Φ i))
    (witt_polynomial p ℤ n) =
  coe_fn (mv_polynomial.aeval fun (i : idx) => coe_fn (mv_polynomial.rename (Prod.mk i)) (witt_polynomial p R n)) Φ := sorry

theorem witt_structure_int_rename (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] {σ : Type u_1} (Φ : mv_polynomial idx ℤ) (f : idx → σ) (n : ℕ) : witt_structure_int p (coe_fn (mv_polynomial.rename f) Φ) n =
  coe_fn (mv_polynomial.rename (prod.map f id)) (witt_structure_int p Φ n) := sorry

@[simp] theorem constant_coeff_witt_structure_rat_zero (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℚ) : coe_fn mv_polynomial.constant_coeff (witt_structure_rat p Φ 0) = coe_fn mv_polynomial.constant_coeff Φ := sorry

theorem constant_coeff_witt_structure_rat (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℚ) (h : coe_fn mv_polynomial.constant_coeff Φ = 0) (n : ℕ) : coe_fn mv_polynomial.constant_coeff (witt_structure_rat p Φ n) = 0 := sorry

@[simp] theorem constant_coeff_witt_structure_int_zero (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) : coe_fn mv_polynomial.constant_coeff (witt_structure_int p Φ 0) = coe_fn mv_polynomial.constant_coeff Φ := sorry

theorem constant_coeff_witt_structure_int (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] (Φ : mv_polynomial idx ℤ) (h : coe_fn mv_polynomial.constant_coeff Φ = 0) (n : ℕ) : coe_fn mv_polynomial.constant_coeff (witt_structure_int p Φ n) = 0 := sorry

-- we could relax the fintype on `idx`, but then we need to cast from finset to set.

-- for our applications `idx` is always finite.

theorem witt_structure_rat_vars (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] [fintype idx] (Φ : mv_polynomial idx ℚ) (n : ℕ) : mv_polynomial.vars (witt_structure_rat p Φ n) ⊆ finset.product finset.univ (finset.range (n + 1)) := sorry

-- we could relax the fintype on `idx`, but then we need to cast from finset to set.

-- for our applications `idx` is always finite.

theorem witt_structure_int_vars (p : ℕ) {idx : Type u_2} [hp : fact (nat.prime p)] [fintype idx] (Φ : mv_polynomial idx ℤ) (n : ℕ) : mv_polynomial.vars (witt_structure_int p Φ n) ⊆ finset.product finset.univ (finset.range (n + 1)) := sorry


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.num.basic
import Mathlib.data.bitvec.core
import Mathlib.PostPort

universes l u_1

namespace Mathlib

/-!
# Bitwise operations using binary representation of integers

## Definitions

* bitwise operations for `pos_num` and `num`,
* `snum`, a type that represents integers as a bit string with a sign bit at the end,
* arithmetic operations for `snum`.
-/

namespace pos_num

def lor : pos_num → pos_num → pos_num := sorry

def land : pos_num → pos_num → num := sorry

def ldiff : pos_num → pos_num → num := sorry

def lxor : pos_num → pos_num → num := sorry

def test_bit : pos_num → ℕ → Bool := sorry

def one_bits : pos_num → ℕ → List ℕ := sorry

def shiftl (p : pos_num) : ℕ → pos_num := sorry

def shiftr : pos_num → ℕ → num := sorry

end pos_num

namespace num

def lor : num → num → num := sorry

def land : num → num → num := sorry

def ldiff : num → num → num := sorry

def lxor : num → num → num := sorry

def shiftl : num → ℕ → num := sorry

def shiftr : num → ℕ → num := sorry

def test_bit : num → ℕ → Bool := sorry

def one_bits : num → List ℕ := sorry

end num

/-- This is a nonzero (and "non minus one") version of `snum`.
    See the documentation of `snum` for more details. -/
inductive nzsnum where
| msb : Bool → nzsnum
| bit : Bool → nzsnum → nzsnum

/-- Alternative representation of integers using a sign bit at the end.
  The convention on sign here is to have the argument to `msb` denote
  the sign of the MSB itself, with all higher bits set to the negation
  of this sign. The result is interpreted in two's complement.

     13  = ..0001101(base 2) = nz (bit1 (bit0 (bit1 (msb tt))))
     -13 = ..1110011(base 2) = nz (bit1 (bit1 (bit0 (msb ff))))

  As with `num`, a special case must be added for zero, which has no msb,
  but by two's complement symmetry there is a second special case for -1.
  Here the `bool` field indicates the sign of the number.

     0  = ..0000000(base 2) = zero ff
     -1 = ..1111111(base 2) = zero tt -/
inductive snum where
| zero : Bool → snum
| nz : nzsnum → snum

protected instance snum.has_coe : has_coe nzsnum snum := has_coe.mk snum.nz

protected instance snum.has_zero : HasZero snum := { zero := snum.zero false }

protected instance nzsnum.has_one : HasOne nzsnum := { one := nzsnum.msb tt }

protected instance snum.has_one : HasOne snum := { one := snum.nz 1 }

protected instance nzsnum.inhabited : Inhabited nzsnum := { default := 1 }

protected instance snum.inhabited : Inhabited snum := { default := 0 }

infixr:67 " :: " => Mathlib.nzsnum.bit

/-!
The `snum` representation uses a bit string, essentially a list of 0 (`ff`) and 1 (`tt`) bits,
and the negation of the MSB is sign-extended to all higher bits.
-/

namespace nzsnum

def sign : nzsnum → Bool := sorry

def not : nzsnum → nzsnum := sorry

prefix:40 "~" => Mathlib.nzsnum.not

def bit0 : nzsnum → nzsnum := bit false

def bit1 : nzsnum → nzsnum := bit tt

def head : nzsnum → Bool := sorry

def tail : nzsnum → snum := sorry

end nzsnum

namespace snum

def sign : snum → Bool := sorry

def not : snum → snum := sorry

prefix:40 "~" => Mathlib.snum.not

def bit : Bool → snum → snum := sorry

infixr:67 " :: " => Mathlib.snum.bit

def bit0 : snum → snum := bit false

def bit1 : snum → snum := bit tt

theorem bit_zero (b : Bool) : b :: zero b = zero b :=
  bool.cases_on b (Eq.refl (false :: zero false)) (Eq.refl (tt :: zero tt))

theorem bit_one (b : Bool) : b :: zero (!b) = ↑(nzsnum.msb b) :=
  bool.cases_on b (Eq.refl (false :: zero (!false))) (Eq.refl (tt :: zero (!tt)))

end snum

namespace nzsnum

def drec' {C : snum → Sort u_1} (z : (b : Bool) → C (snum.zero b))
    (s : (b : Bool) → (p : snum) → C p → C (b :: p)) (p : nzsnum) : C ↑p :=
  sorry

end nzsnum

namespace snum

def head : snum → Bool := sorry

def tail : snum → snum := sorry

def drec' {C : snum → Sort u_1} (z : (b : Bool) → C (zero b))
    (s : (b : Bool) → (p : snum) → C p → C (b :: p)) (p : snum) : C p :=
  sorry

def rec' {α : Sort u_1} (z : Bool → α) (s : Bool → snum → α → α) : snum → α := drec' z s

def test_bit : ℕ → snum → Bool := sorry

def succ : snum → snum :=
  rec' (fun (b : Bool) => cond b 0 1)
    fun (b : Bool) (p succp : snum) => cond b (false :: succp) (tt :: p)

def pred : snum → snum :=
  rec' (fun (b : Bool) => cond b (~1) (~0))
    fun (b : Bool) (p predp : snum) => cond b (false :: p) (tt :: predp)

protected def neg (n : snum) : snum := succ (~n)

protected instance has_neg : Neg snum := { neg := snum.neg }

def czadd : Bool → Bool → snum → snum := sorry

end snum

namespace snum

/-- `a.bits n` is the vector of the `n` first bits of `a` (starting from the LSB). -/
def bits : snum → (n : ℕ) → vector Bool n := sorry

def cadd : snum → snum → Bool → snum :=
  rec' (fun (a : Bool) (p : snum) (c : Bool) => czadd c a p)
    fun (a : Bool) (p : snum) (IH : snum → Bool → snum) =>
      rec' (fun (b c : Bool) => czadd c b (a :: p))
        fun (b : Bool) (q : snum) (_x : Bool → snum) (c : Bool) =>
          bitvec.xor3 a b c :: IH q (bitvec.carry a b c)

/-- Add two `snum`s. -/
protected def add (a : snum) (b : snum) : snum := cadd a b false

protected instance has_add : Add snum := { add := snum.add }

/-- Substract two `snum`s. -/
protected def sub (a : snum) (b : snum) : snum := a + -b

protected instance has_sub : Sub snum := { sub := snum.sub }

/-- Multiply two `snum`s. -/
protected def mul (a : snum) : snum → snum :=
  rec' (fun (b : Bool) => cond b (-a) 0)
    fun (b : Bool) (q IH : snum) => cond b (bit0 IH + a) (bit0 IH)

protected instance has_mul : Mul snum := { mul := snum.mul }

end Mathlib


import Playlean4.Group.Basic
import Playlean4.Group.Subgroup
import Playlean4.Group.LRClasses
import Playlean4.Group.OnSet

namespace Group

namespace Subgroup

variable {G : Type} (law : G → G → G) [grp : Group G law]

local infixl:70 " * " => id' law
@[appUnexpander id'] def normal.UnexpandGMul : Lean.PrettyPrinter.Unexpander
  | `(id' law $x $y) => `($x * $y)
  | _ => throw ()
local notation "one" => grp.one' -- HACK
local notation g"⁻¹" => grp.inv g

section

variable (H : Set G) [sg : Subgroup G law H]

local infixl:70 " * " => id' (subgroupLaw law H)
@[appUnexpander id'] def normal.unexpandHMul : Lean.PrettyPrinter.Unexpander
  | `(id' (subgroupLaw law H) $x $y) => `($x * $y)
  | _ => throw ()

class Normal where
  stable : ∀ (g : G), ∀ {h}, h ∈ H → (g * h * g⁻¹) ∈ H

end

end Subgroup

-- Start with the simple things : the kernel is always normal
namespace Morphism

variable {G : Type} {lawG : G → G → G} [grpG : Group G lawG]
variable {H : Type} {lawH : H → H → H} [grpH : Group H lawH]
variable (φ : Morphism G lawG H lawH)

local infixl:70 " * " => id' lawG
local notation g"⁻¹" => grpG.inv g
local infix:70 " * " => id' lawH
local notation g"⁻¹" => grpH.inv g

def kernel : Set G := λ g => φ g = grpH.one'

def kernelIsSubgroup : Subgroup G lawG (kernel φ) := Subgroup.ofInhabitedMulInvStable lawG
  (⟨ grpG.one', φ.respectOne ⟩)
  (λ {h} hIn h' h'In => by simp [kernel, Set.mem]; rw [hIn, h'In]; simp )

instance kernelIsNormal : Subgroup.Normal lawG (φ.kernel) where
  stable := λ g k kIn => by
    suffices p : φ (g * (k : G) * g⁻¹) = grpH.one'
    by exact p
    have p : φ k = grpH.one' := kIn
    simp [φ.respectMul, p]

end Morphism

namespace Subgroup

variable {G : Type} {law : G → G → G} [grp : Group G law]

local infixl:70 " * " => id' law
@[appUnexpander id'] def normal.UnexpandGMul' : Lean.PrettyPrinter.Unexpander
  | `(id' law $x $y) => `($x * $y)
  | _ => throw ()
local notation "one" => grp.one' -- HACK
local notation g"⁻¹" => grp.inv g

-- Now prove the converse : a normal subgroup is the kernel of some function
namespace Normal

variable (H : Set G) [sg : Subgroup G law H]

local infixl:70 " * " => id' (subgroupLaw law H)
@[appUnexpander id'] def normal.unexpandHMul : Lean.PrettyPrinter.Unexpander
  | `(id' Magma.law H $x $y) => `($x * $y)
  | _ => throw ()

theorem normalIff.lemma₁ :
  (∀ (g : G), ∀ {h}, h ∈ H → g * h * g⁻¹ ∈ H) ↔
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h = h' * g) :=
by
  apply Iff.intro
  focus
    intro p g h hIn
    suffices p : ∃ h', h' ∈ H ∧ g * h * g⁻¹ = h'
    from match p with
      | ⟨ h', ⟨ h'In, p ⟩ ⟩ => ⟨ h', ⟨ h'In, by simp [p.symm] ⟩ ⟩
    exact ⟨ g * h * g⁻¹, ⟨ p g hIn, rfl ⟩ ⟩
  focus
    intro p g h hIn
    match p g hIn with
    | ⟨ h', ⟨ h'In, p ⟩ ⟩ =>
      rw [show g * h * g⁻¹ = h' by simp [p]]
      simp [h'In]

theorem normalIff.lemma₂ :
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h = h' * g) →
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h' = h * g) :=
by
  intro h g h₀ h₀In
  match h (g⁻¹) (sg.invMem h₀In) with
  | ⟨ h', ⟨ h'In, p ⟩ ⟩ =>
    have ∀ k k' : G, k = k' → k⁻¹ = k'⁻¹ by intro _ _ h; rw [h]
    have p' := this _ _ p
    simp at p'
    exact ⟨ h'⁻¹, ⟨ sg.invMem h'In, p'.symm ⟩ ⟩

theorem normalIff.lemma₃ :
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h = h' * g) →
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h' = h * g) →
  ∀ (P : G → Prop), P ∈ leftClasses law H → P ∈ rightClasses law H :=
by
  intro h₀ h₁ p h'
  match h' with
  | ⟨ g, h' ⟩ =>
    apply Exists.intro g
    rw [h']
    simp [Action.Remarkable.onSelf]
    exact funext <| λ x => propext ⟨ (λ h'' => match h'' with
      | ⟨ k, ⟨ kIn, h'' ⟩ ⟩ => match h₀ g kIn with
        | ⟨ k', ⟨ k'In, h''' ⟩ ⟩ => ⟨ k', ⟨ k'In,
          by rw [h'']; simp [id'] at h'''; simp [id']; rw [h''']; rfl ⟩ ⟩),
      (λ h'' => match h'' with
      | ⟨ k, ⟨ kIn, h'' ⟩ ⟩ => match h₁ g kIn with
        | ⟨ k', ⟨ k'In, h''' ⟩ ⟩ => ⟨ k', ⟨ k'In,
          by rw [h'']; simp [id'] at h'''; simp [id']; rw [h''']; rfl ⟩ ⟩) ⟩

theorem normalIff.lemma₄ :
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h = h' * g) →
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h' = h * g) →
  ∀ (P : G → Prop), P ∈ rightClasses law H → P ∈ leftClasses law H :=
by
  rw [← leftClassesOnOp, ← rightClassesOnOp]
  exact λ h₁ h₂ p h => @normalIff.lemma₃ _ (lawᵒᵖ) _ H
    (λ g h hIn => match h₂ g hIn with
      | ⟨ k, ⟨ kIn, h₂ ⟩ ⟩ => ⟨ k, ⟨ kIn, h₂.symm ⟩ ⟩)
    (λ g h hIn => match h₁ g hIn with
      | ⟨ k, ⟨ kIn, h₁ ⟩ ⟩ => ⟨ k, ⟨ kIn, h₁.symm ⟩ ⟩)
    p h

theorem normalIff.lemma₅ :
  (∀ (P : Set G), P ∈ rightClasses law H ↔ P ∈ leftClasses law H) →
  (∀ (g : G), ∀ {h}, h ∈ H → ∃ h', h' ∈ H ∧ g * h = h' * g) :=
by
  intro h g h₀ h₀In
  have p := ((leftClassOf law H g).property)
  rw [← h] at p
  have p₁ := leftClassMemIff law H ((leftClassOf law H g).2)
    (memOfLeftClassOf law H g) (g * h₀)
  have p₂ := rightClassMemIff law H p
    (memOfLeftClassOf law H g) (g * h₀)
  exact (p₁.trans p₂).1 ⟨ h₀, ⟨ h₀In, rfl ⟩ ⟩

section

variable [normal : Normal law H]

open Action.Remarkable.OnSet

local infix:70 " •ₗ " => leftTranslationOnSet law
local notation:70 lhs:70 " •ᵣ " rhs:70 => rightTranslationOnSet law rhs lhs
local infix:70 " ••  " => conjugationOnSet law
local infixl:70 " ** " => mulOnSet law

theorem conjH (g : G) : g •• H = H :=
by
  funext h
  apply propext
  suffices (∃ h', h' ∈ H ∧ h = g * h' * g⁻¹) ↔ h ∈ H by exact this
  exact ⟨ λ p => match p with
    | ⟨ h', ⟨ h'In, p ⟩ ⟩ => p ▸ normal.stable g h'In,
    λ p => ⟨ (g⁻¹ * h * (g⁻¹⁻¹)), ⟨ normal.stable (g⁻¹) p, by simp ⟩ ⟩ ⟩

theorem moveLeft (g : G) : H •ᵣ g = g •ₗ H :=
by
  rw [show H •ᵣ g = (g •• H) •ᵣ g by rw [conjH]]
  rw [conjugationCompat, ← rightTranslationCompat, invCancelLeft, rightTranslationIdentity]

theorem neutralRight (g : G) : (g •ₗ H) ** H = g •ₗ H :=
by
  funext x
  apply propext
  apply Iff.intro
  exact λ h => match h with
  | ⟨ res, ⟨ h₁, h₁In, resEq ⟩, h₂, h₂In, h₂Eq ⟩ =>
    ⟨ h₁ * h₂, sg.mulMem h₁In h₂In, by
      rw [h₂Eq, resEq]
      suffices g * h₁ * h₂ = g * (h₁ * h₂) by exact this
      simp ⟩
  exact λ h => match h with
    | ⟨ h, hIn, xEq ⟩ =>
      ⟨ g * h, ⟨ h, hIn, rfl ⟩, one, oneMem, by
        rw [xEq]
        suffices g * h = g * h * one by exact this
        simp ⟩

/-! "pseudo morphism" because there is no notion of magma morphisms (yet !) -/
theorem pseudoMorphism (g : G) (g' : G) : (g •ₗ H) ** (g' •ₗ H) = (g * g') •ₗ H :=
by
  have p : g •ₗ (g' •ₗ H) = (g * g') •ₗ H
  from ((leftActionOnSet law).compat g g' H).symm
  rw [mulOnSetCompat₁, translationCompat, moveLeft, p, neutralRight]

theorem leftClassesStable {P Q : Set G}
  (PIn : P ∈ leftClasses law H) (QIn : Q ∈ leftClasses law H) : P ** Q ∈ leftClasses law H :=
by
  rw [leftClassIff] at PIn
  rw [leftClassIff] at QIn
  rw [leftClassIff]
  match PIn, QIn with
  | ⟨ g, PIs ⟩, ⟨ g', QIs ⟩ =>
    rw [PIs, QIs]
    rw [pseudoMorphism]
    exact ⟨ g * g', rfl ⟩

def quotientLaw : leftClasses law H → leftClasses law H → leftClasses law H :=
  λ P Q => ⟨ P ** Q, leftClassesStable H P.2 Q.2 ⟩

instance quotientGroup : Group (leftClasses law H) (quotientLaw H) where
  one' := subgroupAsLeftClass law H
  assoc := λ P₁ P₂ P₃ => by
    apply Subtype.eq
    simp [id', quotientLaw]
    match (leftClassIff law _ _).2 P₁.2,
      (leftClassIff law _ _).2 P₂.2,
      (leftClassIff law _ _).2 P₃.2 with
    | ⟨ g₁, (P₁Is : P₁ = g₁ •ₗ H) ⟩,
      ⟨ g₂, (P₂Is : P₂ = g₂ •ₗ H) ⟩,
      ⟨ g₃, (P₃Is : P₃ = g₃ •ₗ H) ⟩ =>
      rw [P₁Is, P₂Is, P₃Is]
      simp [pseudoMorphism]
  oneNeutralRight := λ P => by
    apply Subtype.eq
    simp only [id', quotientLaw]
    exact match (leftClassIff law _ _).2 P.2 with
    | ⟨ g, PIs ⟩ => PIs ▸ neutralRight _ _
  invertible := λ P => by
    simp only [id', quotientLaw]
    match (leftClassIff law _ _).2 P.2 with
    | ⟨ g, (PIs : P = g •ₗ H)⟩ =>
      apply Exists.intro (leftClassOf law H (g⁻¹))
      apply Subtype.eq
      suffices P.1 ** (g⁻¹ •ₗ H) = H by exact this
      rw [PIs]
      simp only [pseudoMorphism, invCancelRight]
      exact (leftActionOnSet law).identity H

def canonicalSurjection : Morphism G law (leftClasses law H) (quotientLaw H) where
  f := λ g => ⟨ g •ₗ H, by
    rw [leftClassIff]
    exact ⟨ g, rfl ⟩ ⟩
  respectMul' := λ g g' => Subtype.eq <| (pseudoMorphism H _ _).symm

end

end Normal

end Subgroup

end Group


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.discrete_category

/-!
# The empty category

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

Defines a category structure on `pempty`, and the unique functor `pempty ⥤ C` for any category `C`.
-/

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

namespace category_theory
namespace functor

variables (C : Type u) [category.{v} C]

/-- Equivalence between two empty categories. -/
def empty_equivalence : discrete.{w} pempty ≌ discrete.{v} pempty :=
equivalence.mk
{ obj := pempty.elim ∘ discrete.as, map := λ x, x.as.elim }
{ obj := pempty.elim ∘ discrete.as, map := λ x, x.as.elim }
(by tidy) (by tidy)

/-- The canonical functor out of the empty category. -/
def empty : discrete.{w} pempty ⥤ C := discrete.functor pempty.elim

variable {C}
/-- Any two functors out of the empty category are isomorphic. -/
def empty_ext (F G : discrete.{w} pempty ⥤ C) : F ≅ G :=
discrete.nat_iso (λ x, x.as.elim)

/--
Any functor out of the empty category is isomorphic to the canonical functor from the empty
category.
-/
def unique_from_empty (F : discrete.{w} pempty ⥤ C) : F ≅ empty C :=
empty_ext _ _

/--
Any two functors out of the empty category are *equal*. You probably want to use
`empty_ext` instead of this.
-/
lemma empty_ext' (F G : discrete.{w} pempty ⥤ C) : F = G :=
functor.ext (λ x, x.as.elim) (λ x _ _, x.as.elim)

end functor

end category_theory


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.big_operators.basic
import algebra.big_operators.pi
import category_theory.limits.shapes.biproducts
import category_theory.preadditive
import category_theory.preadditive.additive_functor
import data.matrix.dmatrix
import data.matrix.basic
import category_theory.Fintype
import category_theory.preadditive.single_obj
import algebra.opposites

/-!
# Matrices over a category.

When `C` is a preadditive category, `Mat_ C` is the preadditive category
whose objects are finite tuples of objects in `C`, and
whose morphisms are matrices of morphisms from `C`.

There is a functor `Mat_.embedding : C ⥤ Mat_ C` sending morphisms to one-by-one matrices.

`Mat_ C` has finite biproducts.

## The additive envelope

We show that this construction is the "additive envelope" of `C`,
in the sense that any additive functor `F : C ⥤ D` to a category `D` with biproducts
lifts to a functor `Mat_.lift F : Mat_ C ⥤ D`,
Moreover, this functor is unique (up to natural isomorphisms) amongst functors `L : Mat_ C ⥤ D`
such that `embedding C ⋙ L ≅ F`.
(As we don't have 2-category theory, we can't explicitly state that `Mat_ C` is
the initial object in the 2-category of categories under `C` which have biproducts.)

As a consequence, when `C` already has finite biproducts we have `Mat_ C ≌ C`.

## Future work

We should provide a more convenient `Mat R`, when `R` is a ring,
as a category with objects `n : FinType`,
and whose morphisms are matrices with components in `R`.

Ideally this would conveniently interact with both `Mat_` and `matrix`.

-/

open category_theory category_theory.preadditive
open_locale big_operators classical
noncomputable theory

namespace category_theory

universes w v₁ v₂ u₁ u₂
variables (C : Type u₁) [category.{v₁} C] [preadditive C]

/--
An object in `Mat_ C` is a finite tuple of objects in `C`.
-/
structure Mat_ : Type (max (v₁+1) u₁) :=
(ι : Type v₁)
[F : fintype ι]
(X : ι → C)

attribute [instance] Mat_.F

namespace Mat_

variables {C}

/-- A morphism in `Mat_ C` is a dependently typed matrix of morphisms. -/
@[nolint has_inhabited_instance]
def hom (M N : Mat_ C) : Type v₁ := dmatrix M.ι N.ι (λ i j, M.X i ⟶ N.X j)

namespace hom

/-- The identity matrix consists of identity morphisms on the diagonal, and zeros elsewhere. -/
def id (M : Mat_ C) : hom M M := λ i j, if h : i = j then eq_to_hom (congr_arg M.X h) else 0

/-- Composition of matrices using matrix multiplication. -/
def comp {M N K : Mat_ C} (f : hom M N) (g : hom N K) : hom M K :=
λ i k, ∑ j : N.ι, f i j ≫ g j k

end hom

section
local attribute [simp] hom.id hom.comp

instance : category.{v₁} (Mat_ C) :=
{ hom := hom,
  id := hom.id,
  comp := λ M N K f g, f.comp g,
  id_comp' := λ M N f, by simp [dite_comp],
  comp_id' := λ M N f, by simp [comp_dite],
  assoc' := λ M N K L f g h, begin
    ext i k,
    simp_rw [hom.comp, sum_comp, comp_sum, category.assoc],
    rw finset.sum_comm,
  end, }.

lemma id_def (M : Mat_ C) :
  (𝟙 M : hom M M) = λ i j, if h : i = j then eq_to_hom (congr_arg M.X h) else 0 :=
rfl

lemma id_apply (M : Mat_ C) (i j : M.ι) :
  (𝟙 M : hom M M) i j = if h : i = j then eq_to_hom (congr_arg M.X h) else 0 :=
rfl

@[simp] lemma id_apply_self (M : Mat_ C) (i : M.ι) :
  (𝟙 M : hom M M) i i = 𝟙 _ :=
by simp [id_apply]

@[simp] lemma id_apply_of_ne (M : Mat_ C) (i j : M.ι) (h : i ≠ j) :
  (𝟙 M : hom M M) i j = 0 :=
by simp [id_apply, h]

lemma comp_def {M N K : Mat_ C} (f : M ⟶ N) (g : N ⟶ K) :
  (f ≫ g) = λ i k, ∑ j : N.ι, f i j ≫ g j k := rfl

@[simp] lemma comp_apply {M N K : Mat_ C} (f : M ⟶ N) (g : N ⟶ K) (i k) :
  (f ≫ g) i k = ∑ j : N.ι, f i j ≫ g j k := rfl

instance (M N : Mat_ C) : inhabited (M ⟶ N) := ⟨λ i j, (0 : M.X i ⟶ N.X j)⟩

end

instance : preadditive (Mat_ C) :=
{ hom_group := λ M N, by { change add_comm_group (dmatrix M.ι N.ι _), apply_instance, },
  add_comp' := λ M N K f f' g, by { ext, simp [finset.sum_add_distrib], },
  comp_add' := λ M N K f g g', by { ext, simp [finset.sum_add_distrib], }, }

@[simp] lemma add_apply {M N : Mat_ C} (f g : M ⟶ N) (i j) : (f + g) i j = f i j + g i j := rfl

open category_theory.limits

/--
We now prove that `Mat_ C` has finite biproducts.

Be warned, however, that `Mat_ C` is not necessarily Krull-Schmidt,
and so the internal indexing of a biproduct may have nothing to do with the external indexing,
even though the construction we give uses a sigma type.
See however `iso_biproduct_embedding`.
-/
instance has_finite_biproducts : has_finite_biproducts (Mat_ C) :=
{ has_biproducts_of_shape := λ J 𝒟, by exactI
  { has_biproduct := λ f,
    has_biproduct_of_total
    { X := ⟨Σ j : J, (f j).ι, λ p, (f p.1).X p.2⟩,
      π := λ j x y,
      begin
        dsimp at x ⊢,
        refine if h : x.1 = j then _ else 0,
        refine if h' : (@eq.rec J x.1 (λ j, (f j).ι) x.2 _ h) = y then _ else 0,
        apply eq_to_hom,
        substs h h', -- Notice we were careful not to use `subst` until we had a goal in `Prop`.
      end,
      ι := λ j x y,
      begin
        dsimp at y ⊢,
        refine if h : y.1 = j then _ else 0,
        refine if h' : (@eq.rec J y.1 (λ j, (f j).ι) y.2 _ h) = x then _ else 0,
        apply eq_to_hom,
        substs h h',
      end,
      ι_π := λ j j',
      begin
        ext x y,
        dsimp,
        simp_rw [dite_comp, comp_dite],
        simp only [if_t_t, dite_eq_ite, dif_ctx_congr, limits.comp_zero, limits.zero_comp,
          eq_to_hom_trans, finset.sum_congr],
        erw finset.sum_sigma,
        dsimp,
        simp only [if_congr, if_true, dif_ctx_congr, finset.sum_dite_irrel, finset.mem_univ,
          finset.sum_const_zero, finset.sum_congr, finset.sum_dite_eq'],
        split_ifs with h h',
        { substs h h',
          simp only [category_theory.eq_to_hom_refl, category_theory.Mat_.id_apply_self], },
        { subst h,
          simp only [id_apply_of_ne _ _ _ h', category_theory.eq_to_hom_refl], },
        { refl, },
      end, }
    begin
      dsimp,
      funext i₁,
      dsimp at i₁ ⊢,
      rcases i₁ with ⟨j₁, i₁⟩,
      -- I'm not sure why we can't just `simp` by `finset.sum_apply`: something doesn't quite match
      convert finset.sum_apply _ _ _ using 1,
      { refl, },
      { apply heq_of_eq,
        symmetry,
        funext i₂,
        rcases i₂ with ⟨j₂, i₂⟩,
        simp only [comp_apply, dite_comp, comp_dite,
          if_t_t, dite_eq_ite, if_congr, if_true, dif_ctx_congr,
          finset.sum_dite_irrel, finset.sum_dite_eq, finset.mem_univ, finset.sum_const_zero,
          finset.sum_congr, finset.sum_dite_eq, finset.sum_apply,
          limits.comp_zero, limits.zero_comp, eq_to_hom_trans, Mat_.id_apply],
        by_cases h : j₁ = j₂,
        { subst h, simp, },
        { simp [h], }, },
    end }}.

end Mat_

namespace functor
variables {C} {D : Type*} [category.{v₁} D] [preadditive D]

local attribute [simp] Mat_.id_apply eq_to_hom_map

/--
A functor induces a functor of matrix categories.
-/
@[simps]
def map_Mat_ (F : C ⥤ D) [functor.additive F] : Mat_ C ⥤ Mat_ D :=
{ obj := λ M, ⟨M.ι, λ i, F.obj (M.X i)⟩,
  map := λ M N f i j, F.map (f i j),
  map_comp' := λ M N K f g, by { ext i k, simp,}, }

/--
The identity functor induces the identity functor on matrix categories.
-/
@[simps]
def map_Mat_id : (𝟭 C).map_Mat_ ≅ 𝟭 (Mat_ C) :=
nat_iso.of_components (λ M, eq_to_iso (by { cases M, refl, }))
(λ M N f, begin
  ext i j,
  cases M, cases N,
  simp [comp_dite, dite_comp],
end)

/--
Composite functors induce composite functors on matrix categories.
-/
@[simps]
def map_Mat_comp {E : Type*} [category.{v₁} E] [preadditive E]
  (F : C ⥤ D) [functor.additive F] (G : D ⥤ E) [functor.additive G] :
  (F ⋙ G).map_Mat_ ≅ F.map_Mat_ ⋙ G.map_Mat_ :=
nat_iso.of_components (λ M, eq_to_iso (by { cases M, refl, }))
(λ M N f, begin
  ext i j,
  cases M, cases N,
  simp [comp_dite, dite_comp],
end)

end functor

namespace Mat_

variables (C)

/-- The embedding of `C` into `Mat_ C` as one-by-one matrices.
(We index the summands by `punit`.) -/
@[simps]
def embedding : C ⥤ Mat_ C :=
{ obj := λ X, ⟨punit, λ _, X⟩,
  map := λ X Y f, λ _ _, f,
  map_id' := λ X, by { ext ⟨⟩ ⟨⟩, simp, },
  map_comp' := λ X Y Z f g, by { ext ⟨⟩ ⟨⟩, simp, }, }

namespace embedding

instance : faithful (embedding C) :=
{ map_injective' := λ X Y f g h, congr_fun (congr_fun h punit.star) punit.star, }

instance : full (embedding C) :=
{ preimage := λ X Y f, f punit.star punit.star, }

instance : functor.additive (embedding C) := {}

end embedding

instance [inhabited C] : inhabited (Mat_ C) := ⟨(embedding C).obj default⟩

open category_theory.limits

variables {C}

/--
Every object in `Mat_ C` is isomorphic to the biproduct of its summands.
-/
@[simps]
def iso_biproduct_embedding (M : Mat_ C) : M ≅ ⨁ (λ i, (embedding C).obj (M.X i)) :=
{ hom := biproduct.lift (λ i j k, if h : j = i then eq_to_hom (congr_arg M.X h) else 0),
  inv := biproduct.desc (λ i j k, if h : i = k then eq_to_hom (congr_arg M.X h) else 0),
  hom_inv_id' :=
  begin
    simp only [biproduct.lift_desc],
    funext i,
    dsimp,
    convert finset.sum_apply _ _ _,
    { dsimp, refl, },
    { apply heq_of_eq,
      symmetry,
      funext j,
      simp only [finset.sum_apply],
      dsimp,
      simp [dite_comp, comp_dite, Mat_.id_apply], }
  end,
  inv_hom_id' :=
  begin
    apply biproduct.hom_ext,
    intro i,
    apply biproduct.hom_ext',
    intro j,
    simp only [category.id_comp, category.assoc,
      biproduct.lift_π, biproduct.ι_desc_assoc, biproduct.ι_π],
    ext ⟨⟩ ⟨⟩,
    simp [dite_comp, comp_dite],
    split_ifs,
    { subst h, simp, },
    { simp [h], },
  end, }.

variables {D : Type u₁} [category.{v₁} D] [preadditive D]

/-- Every `M` is a direct sum of objects from `C`, and `F` preserves biproducts. -/
@[simps]
def additive_obj_iso_biproduct (F : Mat_ C ⥤ D) [functor.additive F] (M : Mat_ C) :
  F.obj M ≅ ⨁ (λ i, F.obj ((embedding C).obj (M.X i))) :=
(F.map_iso (iso_biproduct_embedding M)) ≪≫ (F.map_biproduct _)

variables [has_finite_biproducts D]

@[reassoc] lemma additive_obj_iso_biproduct_naturality (F : Mat_ C ⥤ D) [functor.additive F]
  {M N : Mat_ C} (f : M ⟶ N) :
  F.map f ≫ (additive_obj_iso_biproduct F N).hom =
    (additive_obj_iso_biproduct F M).hom ≫
      biproduct.matrix (λ i j, F.map ((embedding C).map (f i j))) :=
begin
  -- This is disappointingly tedious.
  ext,
  simp only [additive_obj_iso_biproduct_hom, category.assoc, biproduct.lift_π, functor.map_bicone_π,
    biproduct.bicone_π, biproduct.lift_matrix],
  dsimp [embedding],
  simp only [←F.map_comp, biproduct.lift_π, biproduct.matrix_π, category.assoc],
  simp only [←F.map_comp, ←F.map_sum, biproduct.lift_desc, biproduct.lift_π_assoc, comp_sum],
  simp only [comp_def, comp_dite, comp_zero, finset.sum_dite_eq', finset.mem_univ, if_true],
  dsimp,
  simp only [finset.sum_singleton, dite_comp, zero_comp],
  congr,
  symmetry,
  convert finset.sum_fn _ _, -- It's hard to use this as a simp lemma!
  simp only [finset.sum_fn, finset.sum_dite_eq],
  ext,
  simp,
end

@[reassoc] lemma additive_obj_iso_biproduct_naturality' (F : Mat_ C ⥤ D) [functor.additive F]
  {M N : Mat_ C} (f : M ⟶ N) :
  (additive_obj_iso_biproduct F M).inv ≫ F.map f =
    biproduct.matrix (λ i j, F.map ((embedding C).map (f i j)) : _) ≫
      (additive_obj_iso_biproduct F N).inv :=
by rw [iso.inv_comp_eq, ←category.assoc, iso.eq_comp_inv, additive_obj_iso_biproduct_naturality]

/-- Any additive functor `C ⥤ D` to a category `D` with finite biproducts extends to
a functor `Mat_ C ⥤ D`. -/
@[simps]
def lift (F : C ⥤ D) [functor.additive F] : Mat_ C ⥤ D :=
{ obj := λ X, ⨁ (λ i, F.obj (X.X i)),
  map := λ X Y f, biproduct.matrix (λ i j, F.map (f i j)),
  map_id' := λ X, begin
    ext i j,
    by_cases h : i = j,
    { subst h, simp, },
    { simp [h, Mat_.id_apply], },
  end,
  map_comp' := λ X Y Z f g, by { ext i j, simp, }, }.

instance lift_additive (F : C ⥤ D) [functor.additive F] : functor.additive (lift F) := {}

/-- An additive functor `C ⥤ D` factors through its lift to `Mat_ C ⥤ D`. -/
@[simps]
def embedding_lift_iso (F : C ⥤ D) [functor.additive F] : embedding C ⋙ lift F ≅ F :=
nat_iso.of_components (λ X,
  { hom := biproduct.desc (λ P, 𝟙 (F.obj X)),
    inv := biproduct.lift (λ P, 𝟙 (F.obj X)), })
(λ X Y f, begin
  dsimp,
  ext,
  simp only [category.id_comp, biproduct.ι_desc_assoc],
  erw biproduct.ι_matrix_assoc, -- Not sure why this doesn't fire via `simp`.
  simp,
end).

/--
`Mat_.lift F` is the unique additive functor `L : Mat_ C ⥤ D` such that `F ≅ embedding C ⋙ L`.
-/
def lift_unique (F : C ⥤ D) [functor.additive F] (L : Mat_ C ⥤ D) [functor.additive L]
  (α : embedding C ⋙ L ≅ F) :
  L ≅ lift F :=
nat_iso.of_components
  (λ M, (additive_obj_iso_biproduct L M) ≪≫
    (biproduct.map_iso (λ i, α.app (M.X i))) ≪≫
    (biproduct.map_iso (λ i, (embedding_lift_iso F).symm.app (M.X i))) ≪≫
    (additive_obj_iso_biproduct (lift F) M).symm)
(λ M N f, begin
  dsimp only [iso.trans_hom, iso.symm_hom, biproduct.map_iso_hom],
  simp only [additive_obj_iso_biproduct_naturality_assoc],
  simp only [biproduct.matrix_map_assoc, category.assoc],
  simp only [additive_obj_iso_biproduct_naturality'],
  simp only [biproduct.map_matrix_assoc, category.assoc],
  congr,
  ext j k ⟨⟩,
  dsimp, simp,
  exact α.hom.naturality (f j k),
end).

-- TODO is there some uniqueness statement for the natural isomorphism in `lift_unique`?

/-- Two additive functors `Mat_ C ⥤ D` are naturally isomorphic if
their precompositions with `embedding C` are naturally isomorphic as functors `C ⥤ D`. -/
@[ext]
def ext {F G : Mat_ C ⥤ D} [functor.additive F] [functor.additive G]
  (α : embedding C ⋙ F ≅ embedding C ⋙ G) : F ≅ G :=
(lift_unique (embedding C ⋙ G) _ α) ≪≫ (lift_unique _ _ (iso.refl _)).symm

/--
Natural isomorphism needed in the construction of `equivalence_self_of_has_finite_biproducts`.
-/
def equivalence_self_of_has_finite_biproducts_aux [has_finite_biproducts C] :
  embedding C ⋙ 𝟭 (Mat_ C) ≅ embedding C ⋙ lift (𝟭 C) ⋙ embedding C :=
functor.right_unitor _ ≪≫
  (functor.left_unitor _).symm ≪≫
  (iso_whisker_right (embedding_lift_iso _).symm _) ≪≫
  functor.associator _ _ _

/--
A preadditive category that already has finite biproducts is equivalent to its additive envelope.

Note that we only prove this for a large category;
otherwise there are universe issues that I haven't attempted to sort out.
-/
def equivalence_self_of_has_finite_biproducts
  (C : Type (u₁+1)) [large_category C] [preadditive C] [has_finite_biproducts C] :
  Mat_ C ≌ C :=
equivalence.mk -- I suspect this is already an adjoint equivalence, but it seems painful to verify.
  (lift (𝟭 C))
  (embedding C)
  (ext equivalence_self_of_has_finite_biproducts_aux)
  (embedding_lift_iso (𝟭 C))

@[simp] lemma equivalence_self_of_has_finite_biproducts_functor
  {C : Type (u₁+1)} [large_category C] [preadditive C] [has_finite_biproducts C] :
  (equivalence_self_of_has_finite_biproducts C).functor = lift (𝟭 C) :=
rfl

@[simp] lemma equivalence_self_of_has_finite_biproducts_inverse
  {C : Type (u₁+1)} [large_category C] [preadditive C] [has_finite_biproducts C] :
  (equivalence_self_of_has_finite_biproducts C).inverse = embedding C :=
rfl

end Mat_

universe u

/-- A type synonym for `Fintype`, which we will equip with a category structure
where the morphisms are matrices with components in `R`. -/
@[nolint unused_arguments, derive inhabited]
def Mat (R : Type u) := Fintype.{u}

instance (R : Type u) : has_coe_to_sort (Mat R) (Type u) := bundled.has_coe_to_sort

open_locale classical matrix

instance (R : Type u) [semiring R] : category (Mat R) :=
{ hom := λ X Y, matrix X Y R,
  id := λ X, 1,
  comp := λ X Y Z f g, f ⬝ g,
  assoc' := by { intros, simp [matrix.mul_assoc], }, }

namespace Mat

section
variables (R : Type u) [semiring R]

lemma id_def (M : Mat R) :
  𝟙 M = λ i j, if h : i = j then 1 else 0 :=
rfl

lemma id_apply (M : Mat R) (i j : M) :
  (𝟙 M : matrix M M R) i j = if h : i = j then 1 else 0 :=
rfl

@[simp] lemma id_apply_self (M : Mat R) (i : M) :
  (𝟙 M : matrix M M R) i i = 1 :=
by simp [id_apply]

@[simp] lemma id_apply_of_ne (M : Mat R) (i j : M) (h : i ≠ j) :
  (𝟙 M : matrix M M R) i j = 0 :=
by simp [id_apply, h]

lemma comp_def {M N K : Mat R} (f : M ⟶ N) (g : N ⟶ K) :
  (f ≫ g) = λ i k, ∑ j : N, f i j * g j k := rfl

@[simp] lemma comp_apply {M N K : Mat R} (f : M ⟶ N) (g : N ⟶ K) (i k) :
  (f ≫ g) i k = ∑ j : N, f i j * g j k := rfl

instance (M N : Mat R) : inhabited (M ⟶ N) := ⟨λ (i : M) (j : N), (0 : R)⟩

end

variables (R : Type u) [ring R]

open opposite

/-- Auxiliary definition for `category_theory.Mat.equivalence_single_obj`. -/
@[simps]
def equivalence_single_obj_inverse : Mat_ (single_obj Rᵐᵒᵖ) ⥤ Mat R :=
{ obj := λ X, Fintype.of X.ι,
  map := λ X Y f i j, mul_opposite.unop (f i j),
  map_id' := λ X, by { ext i j, simp [id_def, Mat_.id_def], split_ifs; refl, }, }

instance : faithful (equivalence_single_obj_inverse R) :=
{ map_injective' := λ X Y f g w, begin
    ext i j,
    apply_fun mul_opposite.unop using mul_opposite.unop_injective,
    exact (congr_fun (congr_fun w i) j),
  end }

instance : full (equivalence_single_obj_inverse R) :=
{ preimage := λ X Y f i j, mul_opposite.op (f i j), }

instance : ess_surj (equivalence_single_obj_inverse R) :=
{ mem_ess_image := λ X,
  ⟨{ ι := X, X := λ _, punit.star }, ⟨eq_to_iso (by { dsimp, cases X, congr, })⟩⟩, }

/-- The categorical equivalence between the category of matrices over a ring,
and the category of matrices over that ring considered as a single-object category. -/
def equivalence_single_obj : Mat R ≌ Mat_ (single_obj Rᵐᵒᵖ) :=
begin
  haveI := equivalence.of_fully_faithfully_ess_surj (equivalence_single_obj_inverse R),
  exact (equivalence_single_obj_inverse R).as_equivalence.symm,
end

instance : preadditive (Mat R) :=
{ add_comp' := by { intros, ext, simp [add_mul, finset.sum_add_distrib], },
  comp_add' := by { intros, ext, simp [mul_add, finset.sum_add_distrib], }, }

-- TODO show `Mat R` has biproducts, and that `biprod.map` "is" forming a block diagonal matrix.

end Mat

end category_theory