/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module algebra.graded_monoid
! leanprover-community/mathlib commit 008205aa645b3f194c1da47025c5f110c8406eab
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.InjSurj
import Mathlib.Data.List.BigOperators.Basic
import Mathlib.Data.List.FinRange
import Mathlib.GroupTheory.GroupAction.Defs
import Mathlib.GroupTheory.Submonoid.Basic
import Mathlib.Data.SetLike.Basic
import Mathlib.Data.Sigma.Basic
import Lean.Elab.Tactic

/-!
# Additively-graded multiplicative structures

This module provides a set of heterogeneous typeclasses for defining a multiplicative structure
over the sigma type `GradedMonoid A` such that `(*) : A i → A j → A (i + j)`; that is to say, `A`
forms an additively-graded monoid. The typeclasses are:

* `GradedMonoid.GOne A`
* `GradedMonoid.GMul A`
* `GradedMonoid.GMonoid A`
* `GradedMonoid.GCommMonoid A`

With the `SigmaGraded` locale open, these respectively imbue:

* `One (GradedMonoid A)`
* `Mul (GradedMonoid A)`
* `Monoid (GradedMonoid A)`
* `CommMonoid (GradedMonoid A)`

the base type `A 0` with:

* `GradedMonoid.GradeZero.One`
* `GradedMonoid.GradeZero.Mul`
* `GradedMonoid.GradeZero.Monoid`
* `GradedMonoid.GradeZero.CommMonoid`

and the `i`th grade `A i` with `A 0`-actions (`•`) defined as left-multiplication:

* (nothing)
* `GradedMonoid.GradeZero.SMul (A 0)`
* `GradedMonoid.GradeZero.MulAction (A 0)`
* (nothing)

For now, these typeclasses are primarily used in the construction of `DirectSum.Ring` and the rest
of that file.

## Dependent graded products

This also introduces `List.dProd`, which takes the (possibly non-commutative) product of a list
of graded elements of type `A i`. This definition primarily exist to allow `GradedMonoid.mk`
and `DirectSum.of` to be pulled outside a product, such as in `GradedMonoid.mk_list_dProd` and
`DirectSum.of_list_dProd`.

## Internally graded monoids

In addition to the above typeclasses, in the most frequent case when `A` is an indexed collection of
`SetLike` subobjects (such as `AddSubmonoid`s, `AddSubgroup`s, or `Submodule`s), this file
provides the `Prop` typeclasses:

* `SetLike.GradedOne A` (which provides the obvious `GradedMonoid.GOne A` instance)
* `SetLike.GradedMul A` (which provides the obvious `GradedMonoid.GMul A` instance)
* `SetLike.GradedMonoid A` (which provides the obvious `GradedMonoid.GMonoid A` and
  `GradedMonoid.GCommMonoid A` instances)

which respectively provide the API lemmas

* `SetLike.one_mem_graded`
* `SetLike.mul_mem_graded`
* `SetLike.pow_mem_graded`, `SetLike.list_prod_map_mem_graded`

Strictly this last class is unecessary as it has no fields not present in its parents, but it is
included for convenience. Note that there is no need for `SetLike.GradedRing` or similar, as all
the information it would contain is already supplied by `GradedMonoid` when `A` is a collection
of objects satisfying `AddSubmonoidClass` such as `Submodule`s. These constructions are explored
in `Algebra.DirectSum.Internal`.

This file also defines:

* `SetLike.isHomogeneous A` (which says that `a` is homogeneous iff `a ∈ A i` for some `i : ι`)
* `SetLike.HomogeneouSubmonoid A`, which is, as the name suggests, the submonoid consisting of
  all the homogeneous elements.

## tags

graded monoid
-/

variable {ι : Type _}

/-- A type alias of sigma types for graded monoids. -/
def GradedMonoid (A : ι → Type _) :=
  Sigma A
#align graded_monoid GradedMonoid

namespace GradedMonoid

instance {A : ι → Type _} [Inhabited ι] [Inhabited (A default)] : Inhabited (GradedMonoid A) where
  default := Sigma.instInhabitedSigma.default

/-- Construct an element of a graded monoid. -/
def mk {A : ι → Type _} : ∀ i, A i → GradedMonoid A :=
  Sigma.mk
#align graded_monoid.mk GradedMonoid.mk

/-! ### Typeclasses -/

section Defs

variable (A : ι → Type _)

/-- A graded version of `One`, which must be of grade 0. -/
class GOne [Zero ι] where
  /-- The term `one` of grade 0 -/
  one : A 0
#align graded_monoid.ghas_one GradedMonoid.GOne

/-- `GOne` implies `One (GradedMonoid A)` -/
instance GOne.toOne [Zero ι] [GOne A] : One (GradedMonoid A) :=
  ⟨⟨_, GOne.one⟩⟩
#align graded_monoid.ghas_one.to_has_one GradedMonoid.GOne.toOne

/-- A graded version of `Mul`. Multiplication combines grades additively, like
`AddMonoidAlgebra`. -/
class GMul [Add ι] where
  /-- The homogeneous multiplication map `mul` -/
  mul {i j} : A i → A j → A (i + j)
#align graded_monoid.ghas_mul GradedMonoid.GMul

/-- `GMul` implies `Mul (GradedMonoid A)`. -/
instance GMul.toMul [Add ι] [GMul A] : Mul (GradedMonoid A) :=
  ⟨fun x y : GradedMonoid A => ⟨_, GMul.mul x.snd y.snd⟩⟩
#align graded_monoid.ghas_mul.to_has_mul GradedMonoid.GMul.toMul

theorem mk_mul_mk [Add ι] [GMul A] {i j} (a : A i) (b : A j) :
    mk i a * mk j b = mk (i + j) (GMul.mul a b) :=
  rfl
#align graded_monoid.mk_mul_mk GradedMonoid.mk_mul_mk

namespace GMonoid

variable {A} [AddMonoid ι] [GMul A] [GOne A]

/-- A default implementation of power on a graded monoid, like `npowRec`.
`GMonoid.gnpow` should be used instead. -/
def gnpowRec : ∀ (n : ℕ) {i}, A i → A (n • i)
  | 0, i, _ => cast (congr_arg A (zero_nsmul i).symm) GOne.one
  | n + 1, i, a => cast (congr_arg A (succ_nsmul i n).symm) (GMul.mul a <| gnpowRec _ a)
#align graded_monoid.gmonoid.gnpow_rec GradedMonoid.GMonoid.gnpowRec

@[simp]
theorem gnpowRec_zero (a : GradedMonoid A) : GradedMonoid.mk _ (gnpowRec 0 a.snd) = 1 :=
  Sigma.ext (zero_nsmul _) (heq_of_cast_eq _ rfl).symm
#align graded_monoid.gmonoid.gnpow_rec_zero GradedMonoid.GMonoid.gnpowRec_zero

@[simp]
theorem gnpowRec_succ (n : ℕ) (a : GradedMonoid A) :
    (GradedMonoid.mk _ <| gnpowRec n.succ a.snd) = a * ⟨_, gnpowRec n a.snd⟩ :=
  Sigma.ext (succ_nsmul _ _) (heq_of_cast_eq _ rfl).symm
#align graded_monoid.gmonoid.gnpow_rec_succ GradedMonoid.GMonoid.gnpowRec_succ

end GMonoid

/-- A tactic to for use as an optional value for `Gmonoid.gnpow_zero'' -/
macro "apply_gmonoid_gnpowRec_zero_tac" : tactic => `(tactic | apply GMonoid.gnpowRec_zero)
/-- A tactic to for use as an optional value for `Gmonoid.gnpow_succ'' -/
macro "apply_gmonoid_gnpowRec_succ_tac" : tactic => `(tactic | apply GMonoid.gnpowRec_succ)

/-- A graded version of `monoid`

Like `Monoid.npow`, this has an optional `GMonoid.gnpow` field to allow definitional control of
natural powers of a graded monoid. -/
class GMonoid [AddMonoid ι] extends GMul A, GOne A where
  /-- Muliplication by `one` on the left is the identity -/
  one_mul (a : GradedMonoid A) : 1 * a = a
  /-- Muliplication by `one` on the right is the identity -/
  mul_one (a : GradedMonoid A) : a * 1 = a
  /-- Multiplication is associative -/
  mul_assoc (a b c : GradedMonoid A) : a * b * c = a * (b * c)
  /-- Optional field to allow definitional control of natural powers -/
  gnpow : ∀ (n : ℕ) {i}, A i → A (n • i) := GMonoid.gnpowRec
  /-- The zeroth power will yield 1 -/
  gnpow_zero' : ∀ a : GradedMonoid A, GradedMonoid.mk _ (gnpow 0 a.snd) = 1 := by
    apply_gmonoid_gnpowRec_zero_tac
  /-- Successor powers behave as expected -/
  gnpow_succ' :
    ∀ (n : ℕ) (a : GradedMonoid A),
      (GradedMonoid.mk _ <| gnpow n.succ a.snd) = a * ⟨_, gnpow n a.snd⟩ := by
    apply_gmonoid_gnpowRec_succ_tac
#align graded_monoid.gmonoid GradedMonoid.GMonoid

/-- `GMonoid` implies a `Monoid (GradedMonoid A)`. -/
instance GMonoid.toMonoid [AddMonoid ι] [GMonoid A] : Monoid (GradedMonoid A)
    where
  one := 1
  mul := (· * ·)
  npow n a := GradedMonoid.mk _ (GMonoid.gnpow n a.snd)
  npow_zero a := GMonoid.gnpow_zero' a
  npow_succ n a := GMonoid.gnpow_succ' n a
  one_mul := GMonoid.one_mul
  mul_one := GMonoid.mul_one
  mul_assoc := GMonoid.mul_assoc
#align graded_monoid.gmonoid.to_monoid GradedMonoid.GMonoid.toMonoid

theorem mk_pow [AddMonoid ι] [GMonoid A] {i} (a : A i) (n : ℕ) :
    mk i a ^ n = mk (n • i) (GMonoid.gnpow _ a) :=
  by
  match n with
  | 0 =>
    rw [pow_zero]
    exact (GMonoid.gnpow_zero' ⟨_, a⟩).symm
  | n+1 =>
    rw [pow_succ, mk_pow a n, mk_mul_mk]
    exact (GMonoid.gnpow_succ' n ⟨_, a⟩).symm
#align graded_monoid.mk_pow GradedMonoid.mk_pow

/-- A graded version of `CommMonoid`. -/
class GCommMonoid [AddCommMonoid ι] extends GMonoid A where
  /-- Multiplication is commutative -/
  mul_comm (a : GradedMonoid A) (b : GradedMonoid A) : a * b = b * a
#align graded_monoid.gcomm_monoid GradedMonoid.GCommMonoid

/-- `GCommMonoid` implies a `CommMonoid (GradedMonoid A)`, although this is only used as an
instance locally to define notation in `gmonoid` and similar typeclasses. -/
instance GCommMonoid.toCommMonoid [AddCommMonoid ι] [GCommMonoid A] : CommMonoid (GradedMonoid A) :=
  { GMonoid.toMonoid A with mul_comm := GCommMonoid.mul_comm }
#align graded_monoid.gcomm_monoid.to_comm_monoid GradedMonoid.GCommMonoid.toCommMonoid

end Defs

/-! ### Instances for `A 0`

The various `g*` instances are enough to promote the `AddCommMonoid (A 0)` structure to various
types of multiplicative structure.
-/

section GradeZero

variable (A : ι → Type _)

section One

variable [Zero ι] [GOne A]

/-- `1 : A 0` is the value provided in `GOne.one`. -/
@[nolint unusedArguments]
instance GradeZero.one : One (A 0) :=
  ⟨GOne.one⟩
#align graded_monoid.grade_zero.has_one GradedMonoid.GradeZero.one

end One

section Mul

variable [AddZeroClass ι] [GMul A]

/-- `(•) : A 0 → A i → A i` is the value provided in `GradedMonoid.GMul.mul`, composed with
an `Eq.rec` to turn `A (0 + i)` into `A i`.
-/
instance GradeZero.smul (i : ι) : SMul (A 0) (A i)
    where smul x y := @Eq.rec ι (0+i) (fun a _ => A a) (GMul.mul x y) i (zero_add i)
#align graded_monoid.grade_zero.has_smul GradedMonoid.GradeZero.smul

/-- `(*) : A 0 → A 0 → A 0` is the value provided in `GradedMonoid.GMul.mul`, composed with
an `Eq.rec` to turn `A (0 + 0)` into `A 0`.
-/
instance GradeZero.mul : Mul (A 0) where mul := (· • ·)
#align graded_monoid.grade_zero.has_mul GradedMonoid.GradeZero.mul

variable {A}

@[simp]
theorem mk_zero_smul {i} (a : A 0) (b : A i) : mk _ (a • b) = mk _ a * mk _ b :=
  Sigma.ext (zero_add _).symm <| eq_rec_heq _ _
#align graded_monoid.mk_zero_smul GradedMonoid.mk_zero_smul

@[simp]
theorem GradeZero.smul_eq_mul (a b : A 0) : a • b = a * b :=
  rfl
#align graded_monoid.grade_zero.smul_eq_mul GradedMonoid.GradeZero.smul_eq_mul

end Mul

section Monoid

variable [AddMonoid ι] [GMonoid A]

instance : Pow (A 0) ℕ where
  pow x n := @Eq.rec ι (n • (0:ι)) (fun a _ => A a) (GMonoid.gnpow n x) 0 (nsmul_zero n)

variable {A}

@[simp]
theorem mk_zero_pow (a : A 0) (n : ℕ) : mk _ (a ^ n) = mk _ a ^ n :=
  Sigma.ext (nsmul_zero n).symm <| eq_rec_heq _ _
#align graded_monoid.mk_zero_pow GradedMonoid.mk_zero_pow

variable (A)

/-- The `Monoid` structure derived from `GMonoid A`. -/
instance GradeZero.monoid : Monoid (A 0) :=
  Function.Injective.monoid (mk 0) sigma_mk_injective rfl mk_zero_smul mk_zero_pow
#align graded_monoid.grade_zero.monoid GradedMonoid.GradeZero.monoid

end Monoid

section Monoid

variable [AddCommMonoid ι] [GCommMonoid A]

/-- The `CommMonoid` structure derived from `GCommMonoid A`. -/
instance GradeZero.commMonoid : CommMonoid (A 0) :=
  Function.Injective.commMonoid (mk 0) sigma_mk_injective rfl mk_zero_smul mk_zero_pow
#align graded_monoid.grade_zero.comm_monoid GradedMonoid.GradeZero.commMonoid

end Monoid

section MulAction

variable [AddMonoid ι] [GMonoid A]

/-- `GradedMonoid.mk 0` is a `MonoidHom`, using the `GradedMonoid.GradeZero.monoid` structure.
-/
def mkZeroMonoidHom : A 0 →* GradedMonoid A
    where
  toFun := mk 0
  map_one' := rfl
  map_mul' := mk_zero_smul
#align graded_monoid.mk_zero_monoid_hom GradedMonoid.mkZeroMonoidHom

/-- Each grade `A i` derives a `A 0`-action structure from `GMonoid A`. -/
instance GradeZero.mulAction {i} : MulAction (A 0) (A i) :=
  letI := MulAction.compHom (GradedMonoid A) (mkZeroMonoidHom A)
  Function.Injective.mulAction (mk i) sigma_mk_injective mk_zero_smul
#align graded_monoid.grade_zero.mul_action GradedMonoid.GradeZero.mulAction

end MulAction

end GradeZero

end GradedMonoid

/-! ### Dependent products of graded elements -/

section DProd

variable {α : Type _} {A : ι → Type _} [AddMonoid ι] [GradedMonoid.GMonoid A]

/-- The index used by `List.dProd`. Propositionally this is equal to `(l.map fι).Sum`, but
definitionally it needs to have a different form to avoid introducing `Eq.rec`s in `List.dProd`. -/
def List.dProdIndex (l : List α) (fι : α → ι) : ι :=
  l.foldr (fun i b => fι i + b) 0
#align list.dprod_index List.dProdIndex

@[simp]
theorem List.dProdIndex_nil (fι : α → ι) : ([] : List α).dProdIndex fι = 0 :=
  rfl
#align list.dprod_index_nil List.dProdIndex_nil

@[simp]
theorem List.dProdIndex_cons (a : α) (l : List α) (fι : α → ι) :
    (a :: l).dProdIndex fι = fι a + l.dProdIndex fι :=
  rfl
#align list.dprod_index_cons List.dProdIndex_cons

theorem List.dProdIndex_eq_map_sum (l : List α) (fι : α → ι) : l.dProdIndex fι = (l.map fι).sum :=
  by
  match l with
  | [] => simp
  | head::tail => simp [List.dProdIndex_eq_map_sum tail fι]
#align list.dprod_index_eq_map_sum List.dProdIndex_eq_map_sum

/-- A dependent product for graded monoids represented by the indexed family of types `A i`.
This is a dependent version of `(l.map fA).prod`.

For a list `l : list α`, this computes the product of `fA a` over `a`, where each `fA` is of type
`A (fι a)`. -/
def List.dProd (l : List α) (fι : α → ι) (fA : ∀ a, A (fι a)) : A (l.dProdIndex fι) :=
  l.foldrRecOn _ _ GradedMonoid.GOne.one fun _ x a _ => GradedMonoid.GMul.mul (fA a) x
#align list.dprod List.dProd

@[simp]
theorem List.dProd_nil (fι : α → ι) (fA : ∀ a, A (fι a)) :
    (List.nil : List α).dProd fι fA = GradedMonoid.GOne.one :=
  rfl
#align list.dprod_nil List.dProd_nil

-- the `( : _)` in this lemma statement results in the type on the RHS not being unfolded, which
-- is nicer in the goal view.
@[simp]
theorem List.dProd_cons (fι : α → ι) (fA : ∀ a, A (fι a)) (a : α) (l : List α) :
    (a :: l).dProd fι fA = (GradedMonoid.GMul.mul (fA a) (l.dProd fι fA) : _) :=
  rfl
#align list.dprod_cons List.dProd_cons

theorem GradedMonoid.mk_list_dProd (l : List α) (fι : α → ι) (fA : ∀ a, A (fι a)) :
    GradedMonoid.mk _ (l.dProd fι fA) = (l.map fun a => GradedMonoid.mk (fι a) (fA a)).prod :=
  by
  match l with
  | [] => simp; rfl
  | head::tail =>
    simp[← GradedMonoid.mk_list_dProd tail _ _, GradedMonoid.mk_mul_mk, List.prod_cons]
#align graded_monoid.mk_list_dprod GradedMonoid.mk_list_dProd

/-- A variant of `GradedMonoid.mk_list_dProd` for rewriting in the other direction. -/
theorem GradedMonoid.list_prod_map_eq_dProd (l : List α) (f : α → GradedMonoid A) :
    (l.map f).prod = GradedMonoid.mk _ (l.dProd (fun i => (f i).1) fun i => (f i).2) :=
  by
  rw [GradedMonoid.mk_list_dProd, GradedMonoid.mk]
  simp_rw [Sigma.eta]
#align graded_monoid.list_prod_map_eq_dprod GradedMonoid.list_prod_map_eq_dProd

theorem GradedMonoid.list_prod_ofFn_eq_dProd {n : ℕ} (f : Fin n → GradedMonoid A) :
    (List.ofFn f).prod =
      GradedMonoid.mk _ ((List.finRange n).dProd (fun i => (f i).1) fun i => (f i).2) :=
  by rw [List.ofFn_eq_map, GradedMonoid.list_prod_map_eq_dProd]
#align graded_monoid.list_prod_of_fn_eq_dprod GradedMonoid.list_prod_ofFn_eq_dProd

end DProd

/-! ### Concrete instances -/

section

variable (ι) {R : Type _}

@[simps one]
instance One.gOne [Zero ι] [One R] : GradedMonoid.GOne fun _ : ι => R where one := 1
#align has_one.ghas_one One.gOne

@[simps mul]
instance Mul.gMul [Add ι] [Mul R] : GradedMonoid.GMul fun _ : ι => R where mul x y := x * y
#align has_mul.ghas_mul Mul.gMul

/-- If all grades are the same type and themselves form a monoid, then there is a trivial grading
structure. -/
@[simps gnpow]
instance Monoid.gMonoid [AddMonoid ι] [Monoid R] : GradedMonoid.GMonoid fun _ : ι => R :=
  -- { Mul.gMul ι, One.gOne ι with
  { One.gOne ι with
    mul := fun x y => x * y
    one_mul := fun _ => Sigma.ext (zero_add _) (heq_of_eq (one_mul _))
    mul_one := fun _ => Sigma.ext (add_zero _) (heq_of_eq (mul_one _))
    mul_assoc := fun _ _ _ => Sigma.ext (add_assoc _ _ _) (heq_of_eq (mul_assoc _ _ _))
    gnpow := fun n _ a => a ^ n
    gnpow_zero' := fun _ => Sigma.ext (zero_nsmul _) (heq_of_eq (Monoid.npow_zero _))
    gnpow_succ' := fun _ ⟨_, _⟩ => Sigma.ext (succ_nsmul _ _) (heq_of_eq (Monoid.npow_succ _ _)) }
#align monoid.gmonoid Monoid.gMonoid
#align monoid.gmonoid_gnpow Monoid.gMonoid_gnpow

/-- If all grades are the same type and themselves form a commutative monoid, then there is a
trivial grading structure. -/
instance CommMonoid.gCommMonoid [AddCommMonoid ι] [CommMonoid R] :
    GradedMonoid.GCommMonoid fun _ : ι => R :=
  { Monoid.gMonoid ι with
    mul_comm := fun _ _ => Sigma.ext (add_comm _ _) (heq_of_eq (mul_comm _ _)) }
#align comm_monoid.gcomm_monoid CommMonoid.gCommMonoid

/-- When all the indexed types are the same, the dependent product is just the regular product. -/
@[simp]
theorem List.dProd_monoid {α} [AddMonoid ι] [Monoid R] (l : List α) (fι : α → ι) (fA : α → R) :
    @List.dProd _ _ (fun _:ι => R) _ _ l fι fA = (l.map fA).prod  :=
  by
  match l with
  | [] =>
    rw [List.dProd_nil, List.map_nil, List.prod_nil]
    rfl
  | head::tail =>
    rw [List.dProd_cons, List.map_cons, List.prod_cons, List.dProd_monoid tail _ _]
    rfl
#align list.dprod_monoid List.dProd_monoid

end

/-! ### Shorthands for creating instance of the above typeclasses for collections of subobjects -/

section Subobjects

variable {R : Type _}

/-- A version of `GradedMonoid.GOne` for internally graded objects. -/
class SetLike.GradedOne {S : Type _} [SetLike S R] [One R] [Zero ι] (A : ι → S) : Prop where
  /-- One has grade zero -/
  one_mem : (1 : R) ∈ A 0
#align set_like.has_graded_one SetLike.GradedOne

theorem SetLike.one_mem_graded {S : Type _} [SetLike S R] [One R] [Zero ι] (A : ι → S)
    [SetLike.GradedOne A] : (1 : R) ∈ A 0 :=
  SetLike.GradedOne.one_mem
#align set_like.one_mem_graded SetLike.one_mem_graded

instance SetLike.gOne {S : Type _} [SetLike S R] [One R] [Zero ι] (A : ι → S)
    [SetLike.GradedOne A] : GradedMonoid.GOne fun i => A i
    where one := ⟨1, SetLike.one_mem_graded _⟩
#align set_like.ghas_one SetLike.gOne

@[simp]
theorem SetLike.coe_gOne {S : Type _} [SetLike S R] [One R] [Zero ι] (A : ι → S)
    [SetLike.GradedOne A] : ↑(@GradedMonoid.GOne.one _ (fun i => A i) _ _) = (1 : R) :=
  rfl
#align set_like.coe_ghas_one SetLike.coe_gOne

/-- A version of `GradedMonoid.ghas_one` for internally graded objects. -/
class SetLike.GradedMul {S : Type _} [SetLike S R] [Mul R] [Add ι] (A : ι → S) : Prop where
  /-- Multiplication is homogeneous -/
  mul_mem : ∀ ⦃i j⦄ {gi gj}, gi ∈ A i → gj ∈ A j → gi * gj ∈ A (i + j)
#align set_like.has_graded_mul SetLike.GradedMul

theorem SetLike.mul_mem_graded {S : Type _} [SetLike S R] [Mul R] [Add ι] {A : ι → S}
    [SetLike.GradedMul A] ⦃i j⦄ {gi gj} (hi : gi ∈ A i) (hj : gj ∈ A j) : gi * gj ∈ A (i + j) :=
  SetLike.GradedMul.mul_mem hi hj
#align set_like.mul_mem_graded SetLike.mul_mem_graded

instance SetLike.gMul {S : Type _} [SetLike S R] [Mul R] [Add ι] (A : ι → S)
    [SetLike.GradedMul A] : GradedMonoid.GMul fun i => A i
    where mul := fun a b => ⟨(a * b : R), SetLike.mul_mem_graded a.prop b.prop⟩
#align set_like.ghas_mul SetLike.gMul

/-
Porting note: simpNF linter returns

"Left-hand side does not simplify, when using the simp lemma on itself."

However, simp does indeed solve the following. Possibly related std#71,std#78

example {S : Type _} [SetLike S R] [Mul R] [Add ι] (A : ι → S)
    [SetLike.GradedMul A] {i j : ι} (x : A i) (y : A j) :
    ↑(@GradedMonoid.GMul.mul _ (fun i => A i) _ _ _ _ x y) = (x * y : R) := by simp

-/
@[simp,nolint simpNF]
theorem SetLike.coe_gMul {S : Type _} [SetLike S R] [Mul R] [Add ι] (A : ι → S)
    [SetLike.GradedMul A] {i j : ι} (x : A i) (y : A j) :
    ↑(@GradedMonoid.GMul.mul _ (fun i => A i) _ _ _ _ x y) = (x * y : R) :=
  rfl
#align set_like.coe_ghas_mul SetLike.coe_gMul

/-- A version of `GradedMonoid.GMonoid` for internally graded objects. -/
class SetLike.GradedMonoid {S : Type _} [SetLike S R] [Monoid R] [AddMonoid ι] (A : ι → S) extends
  SetLike.GradedOne A, SetLike.GradedMul A : Prop
#align set_like.graded_monoid SetLike.GradedMonoid

namespace SetLike

variable {S : Type _} [SetLike S R] [Monoid R] [AddMonoid ι]

variable {A : ι → S} [SetLike.GradedMonoid A]

theorem pow_mem_graded (n : ℕ) {r : R} {i : ι} (h : r ∈ A i) : r ^ n ∈ A (n • i) :=
  by
  match n with
  | 0 =>
    rw [pow_zero, zero_nsmul]
    exact one_mem_graded _
  | n+1 =>
    rw [pow_succ', succ_nsmul']
    exact mul_mem_graded (pow_mem_graded n h) h
#align set_like.pow_mem_graded SetLike.pow_mem_graded

theorem list_prod_map_mem_graded {ι'} (l : List ι') (i : ι' → ι) (r : ι' → R)
    (h : ∀ j ∈ l, r j ∈ A (i j)) : (l.map r).prod ∈ A (l.map i).sum :=
  by
  match l with
  | [] =>
    rw [List.map_nil, List.map_nil, List.prod_nil, List.sum_nil]
    exact one_mem_graded _
  | head::tail =>
    rw [List.map_cons, List.map_cons, List.prod_cons, List.sum_cons]
    exact
      mul_mem_graded (h _ <| List.mem_cons_self _ _)
        (list_prod_map_mem_graded tail _ _ <| fun j hj => h _ <| List.mem_cons_of_mem _ hj)
#align set_like.list_prod_map_mem_graded SetLike.list_prod_map_mem_graded

theorem list_prod_ofFn_mem_graded {n} (i : Fin n → ι) (r : Fin n → R) (h : ∀ j, r j ∈ A (i j)) :
    (List.ofFn r).prod ∈ A (List.ofFn i).sum :=
  by
  rw [List.ofFn_eq_map, List.ofFn_eq_map]
  exact list_prod_map_mem_graded _ _ _ fun _ _ => h _
#align set_like.list_prod_of_fn_mem_graded SetLike.list_prod_ofFn_mem_graded

end SetLike

/-- Build a `GMonoid` instance for a collection of subobjects. -/
instance SetLike.gMonoid {S : Type _} [SetLike S R] [Monoid R] [AddMonoid ι] (A : ι → S)
    [SetLike.GradedMonoid A] : GradedMonoid.GMonoid fun i => A i :=
  { SetLike.gOne A,
    SetLike.gMul A with
    one_mul := fun ⟨_, _, _⟩ => Sigma.subtype_ext (zero_add _) (one_mul _)
    mul_one := fun ⟨_, _, _⟩ => Sigma.subtype_ext (add_zero _) (mul_one _)
    mul_assoc := fun ⟨_, _, _⟩ ⟨_, _, _⟩ ⟨_, _, _⟩ =>
      Sigma.subtype_ext (add_assoc _ _ _) (mul_assoc _ _ _)
    gnpow := fun n _ a => ⟨(a:R)^n, SetLike.pow_mem_graded n a.prop⟩
    gnpow_zero' := fun _ => Sigma.subtype_ext (zero_nsmul _) (pow_zero _)
    gnpow_succ' := fun _ _ => Sigma.subtype_ext (succ_nsmul _ _) (pow_succ _ _) }
#align set_like.gmonoid SetLike.gMonoid

/-
Porting note: simpNF linter returns

"Left-hand side does not simplify, when using the simp lemma on itself."

However, simp does indeed solve the following. Possibly related std#71,std#78

example {S : Type _} [SetLike S R] [Monoid R] [AddMonoid ι] (A : ι → S)
    [SetLike.GradedMonoid A] {i : ι} (x : A i) (n : ℕ) :
    ↑(@GradedMonoid.GMonoid.gnpow _ (fun i => A i) _ _ n _ x) = (x:R)^n := by simp

-/
@[simp,nolint simpNF]
theorem SetLike.coe_gnpow {S : Type _} [SetLike S R] [Monoid R] [AddMonoid ι] (A : ι → S)
    [SetLike.GradedMonoid A] {i : ι} (x : A i) (n : ℕ) :
    ↑(@GradedMonoid.GMonoid.gnpow _ (fun i => A i) _ _ n _ x) = (x:R)^n :=
  rfl
#align set_like.coe_gnpow SetLike.coe_gnpow

/-- Build a `GCommMonoid` instance for a collection of subobjects. -/
instance SetLike.gCommMonoid {S : Type _} [SetLike S R] [CommMonoid R] [AddCommMonoid ι] (A : ι → S)
    [SetLike.GradedMonoid A] : GradedMonoid.GCommMonoid fun i => A i :=
  { SetLike.gMonoid A with
    mul_comm := fun ⟨_, _, _⟩ ⟨_, _, _⟩ => Sigma.subtype_ext (add_comm _ _) (mul_comm _ _) }
#align set_like.gcomm_monoid SetLike.gCommMonoid

section DProd

open SetLike SetLike.GradedMonoid

variable {α S : Type _} [SetLike S R] [Monoid R] [AddMonoid ι]

/-
Porting note: simpNF linter returns

"Left-hand side does not simplify, when using the simp lemma on itself."

However, simp does indeed solve the following. Possibly related std#71,std#78

example (A : ι → S) [SetLike.GradedMonoid A] (fι : α → ι)
    (fA : ∀ a, A (fι a)) (l : List α) : ↑(@List.dProd _ _ (fun i => ↥(A i)) _ _ l fι fA)
    = (List.prod (l.map fun a => fA a) : R) := by simp
-/
/-- Coercing a dependent product of subtypes is the same as taking the regular product of the
coercions. -/
@[simp,nolint simpNF]
theorem SetLike.coe_list_dProd (A : ι → S) [SetLike.GradedMonoid A] (fι : α → ι)
    (fA : ∀ a, A (fι a)) (l : List α) : ↑(@List.dProd _ _ (fun i => ↥(A i)) _ _ l fι fA)
    = (List.prod (l.map fun a => fA a) : R) := by
  match l with
  | [] =>
    rw [List.dProd_nil, coe_gOne, List.map_nil, List.prod_nil]
  | head::tail =>
    rw [List.dProd_cons, coe_gMul, List.map_cons, List.prod_cons,
      SetLike.coe_list_dProd _ _ _ tail]
#align set_like.coe_list_dprod SetLike.coe_list_dProd

/-- A version of `List.coe_dProd_set_like` with `Subtype.mk`. -/
theorem SetLike.list_dProd_eq (A : ι → S) [SetLike.GradedMonoid A] (fι : α → ι) (fA : ∀ a, A (fι a))
    (l : List α) :
    (@List.dProd _ _ (fun i => ↥(A i)) _ _ l fι fA ) =
      ⟨List.prod (l.map fun a => fA a),
        (l.dProdIndex_eq_map_sum fι).symm ▸
          list_prod_map_mem_graded l _ _ fun i _ => (fA i).prop⟩ :=
  Subtype.ext <| SetLike.coe_list_dProd _ _ _ _
#align set_like.list_dprod_eq SetLike.list_dProd_eq

end DProd

end Subobjects

section HomogeneousElements

variable {R S : Type _} [SetLike S R]

/-- An element `a : R` is said to be homogeneous if there is some `i : ι` such that `a ∈ A i`. -/
def SetLike.Homogeneous (A : ι → S) (a : R) : Prop :=
  ∃ i, a ∈ A i
#align set_like.is_homogeneous SetLike.Homogeneous

@[simp]
theorem SetLike.homogeneous_coe {A : ι → S} {i} (x : A i) : SetLike.Homogeneous A (x : R) :=
  ⟨i, x.prop⟩
#align set_like.is_homogeneous_coe SetLike.homogeneous_coe

theorem SetLike.homogeneous_one [Zero ι] [One R] (A : ι → S) [SetLike.GradedOne A] :
    SetLike.Homogeneous A (1 : R) :=
  ⟨0, SetLike.one_mem_graded _⟩
#align set_like.is_homogeneous_one SetLike.homogeneous_one

theorem SetLike.homogeneous_mul [Add ι] [Mul R] {A : ι → S} [SetLike.GradedMul A] {a b : R} :
    SetLike.Homogeneous A a → SetLike.Homogeneous A b → SetLike.Homogeneous A (a * b)
  | ⟨i, hi⟩, ⟨j, hj⟩ => ⟨i + j, SetLike.mul_mem_graded hi hj⟩
#align set_like.is_homogeneous.mul SetLike.homogeneous_mul

/-- When `A` is a `SetLike.GradedMonoid A`, then the homogeneous elements forms a submonoid. -/
def SetLike.homogeneousSubmonoid [AddMonoid ι] [Monoid R] (A : ι → S) [SetLike.GradedMonoid A] :
    Submonoid R where
  carrier := { a | SetLike.Homogeneous A a }
  one_mem' := SetLike.homogeneous_one A
  mul_mem' a b := SetLike.homogeneous_mul a b
#align set_like.homogeneous_submonoid SetLike.homogeneousSubmonoid

end HomogeneousElements


import finsum.fin_api
import prelim.collections prelim.embed prelim.size prelim.induction prelim.minmax
import .parallel .simple matroid.constructions.partition matroid.submatroid.projection

noncomputable theory
open_locale classical big_operators

open set matroid

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

/-- the 'parallel class matroid' on α in which the rank of a set is the number of parallel
classes of M that it intersects-/
def pc_matroid (M : matroid α) :=
  presetoid_matroid.M M.ps

lemma pc_matroid_def (M : matroid α) :
  pc_matroid M = presetoid_matroid.M M.ps :=
rfl

/-- the number of parallel classes that intersect a set X. -/
def matroid.ε (M : matroid α) (X : set α) := (pc_matroid M).r X

lemma ε_eq_pc_matroid_r (M : matroid α) (X : set α) :
  M.ε X = (pc_matroid M).r X :=
rfl

lemma pc_matroid_indep_iff (M : matroid α) (X : set α) :
  (pc_matroid M).is_indep X ↔ M.is_simple_set X  :=
begin
  rw [pc_matroid_def, presetoid_matroid.indep_iff, simple_set_iff_no_loops_or_parallel_pairs,
  ps_kernel_eq_loops, loopless_set_iff_all_nonloops, disjoint_left],

  simp_rw [← nonloop_iff_not_mem_loops, ← parallel_refl_iff_nonloop, ← ps_rel_eq_parallel,
  size_le_one_iff_mem_unique, mem_inter_iff, presetoid.mem_classes_iff],

  convert iff.rfl,
  refine iff_iff_eq.mp ⟨λ h P hP e f he hf, h _ _ he.1 hf.1 _,
                        λ h e f he hf hef, h (M.ps.cl e) _ e f ⟨he, _⟩ ⟨hf,_⟩ ⟩,
  { obtain ⟨a, ha, rfl⟩ := hP, exact presetoid.rel_of_mems_cl he.2 hf.2  },
  { exact ⟨e, presetoid.rel_self_of_rel hef, rfl⟩ },
  { rw presetoid.mem_cl_iff, exact  presetoid.rel_self_of_rel hef},
  rw presetoid.mem_cl_iff, symmetry, assumption,
end

lemma ε_eq_largest_simple_subset (M : matroid α) (X : set α) :
  M.ε X = max_val (λ (S : M.simple_subset_of X), size (S : set α)) :=
begin
  rw [ε_eq_pc_matroid_r, rank_as_indep],
  let e : ((pc_matroid M).indep_subset_of X) ≃ (M.simple_subset_of X) :=
  equiv.subtype_equiv_right
    (λ X, by {rw [← pc_matroid_indep_iff, and_comm], refl, }),
  exact (max_reindex e.to_fun e.surjective (λ X, size (X : set α))),
end

lemma r_le_ε (M : matroid α) (X : set α) :
  M.r X ≤ M.ε X :=
begin
  rw ε_eq_largest_simple_subset,
  obtain ⟨⟨Y, hYX, hYs⟩, hY', hY''⟩ := max_spec (λ (S : M.simple_subset_of X), size (S : set α)),
  obtain ⟨B, hB ⟩ := M.exists_basis_of X,
  rw [← hY', ← hB.size_eq_r],
  convert hY'' ⟨B, ⟨simple_of_indep hB.indep, hB.is_subset_of⟩⟩,
end

lemma ε_univ_eq_largest_simple_set (M : matroid α):
  M.ε univ = max_val (λ (S : M.simple_set), size (S : set α)) :=
begin
  rw ε_eq_largest_simple_subset,
  exact max_reindex
    (λ (S : M.simple_subset_of univ), (⟨S.1, S.2.1⟩ : M.simple_set))
    (λ S, ⟨⟨S.1, S.2, subset_univ _⟩, by simp⟩)
    (λ S, size (S : set α)),
end

lemma ε_eq_size_of_simple_matroid {M : matroid α} (hM : M.is_simple) (X : set α) :
  M.ε X = size X :=
begin
  rw [ε_eq_largest_simple_subset],
  let X' : M.simple_subset_of X :=
    ⟨X, ⟨simple_of_subset_simple hM (subset_univ _), subset_refl _⟩⟩,
  exact attained_ub_is_max' _ X' (size X) rfl.le (λ Y, size_monotone Y.2.2),
end

lemma ε_eq_size_iff_simple_set {M : matroid α} {X : set α} :
  M.ε X = size X ↔ M.is_simple_set X :=
by rw [ε_eq_pc_matroid_r, ← indep_iff_r, pc_matroid_indep_iff]

lemma ε_eq_size_univ_iff_simple {M : matroid α} :
  M.ε univ = size (univ : set α) ↔ M.is_simple :=
ε_eq_size_iff_simple_set

lemma ε_eq_num_parallel_classes_inter (M : matroid α) (X : set α) :
  M.ε X = size {P : M.parallel_class | (X ∩ P).nonempty } :=
begin
  simp_rw [ε_eq_pc_matroid_r, pc_matroid_def, presetoid_matroid.r_eq],
  exact (size_set_subtype_eq_size_set _ _).symm,
end

lemma ε_eq_r_of_r_le_one {M : matroid α} {X : set α} (h : M.r X ≤ 1):
  M.ε X = M.r X :=
begin
  refine le_antisymm _ (r_le_ε _ _),
  rw [ε_eq_num_parallel_classes_inter],
  by_cases hX : M.r X < 1,
  { have hX' : M.r X = 0, linarith [M.rank_nonneg X],
    rw [hX', size_le_zero_iff_has_no_mem],
    simp only [not_exists, mem_set_of_eq],
    rintros ⟨P,hP⟩,
    by_contra hn,
    obtain ⟨e,⟨he₁,he₂⟩⟩ := hn,
    apply nonloop_iff_not_loop.mp (nonloop_of_mem_parallel_class he₂ hP),
    apply loop_of_mem_rank_zero he₁ hX'},

  have hX' : M.r X = 1 := le_antisymm h (le_of_not_lt hX),
  rw [hX', size_le_one_iff_mem_unique],
  refine λ P P' hP hP', _,
  rcases P with ⟨P,hPp⟩, rcases P' with ⟨P', hPp'⟩,
  obtain ⟨e, he, rfl⟩ := rep_parallel_class hPp,
  obtain ⟨e', he', rfl⟩ := rep_parallel_class hPp',
  obtain ⟨⟨x,⟨hx,hxp⟩⟩,⟨x',⟨hx',hxp'⟩⟩⟩ := ⟨hP,hP'⟩,
  rw [subtype.mk_eq_mk],
  apply parallel_cl_eq_of_parallel,
  rw [subtype.coe_mk, mem_parallel_cl] at hxp hxp',
  have := parallel_of_rank_le_one hxp.nonloop_left hxp'.nonloop_left _,
  { exact (hxp.symm.trans this).trans hxp',  },
  rw ← hX', apply rank_mono,
  intros a ha,
  simp only [mem_singleton_iff, mem_insert_iff] at ha,
  rcases ha with (rfl | rfl); tauto,
end

lemma ε_eq_r_of_ε_le_one {M : matroid α} {X : set α} (h : M.ε X ≤ 1):
  M.ε X = M.r X :=
ε_eq_r_of_r_le_one (le_trans (r_le_ε _ _) h)

lemma ε_eq_ε_inter_nonloops {M : matroid α} {X : set α}:
  M.ε X = M.ε (X ∩ M.nonloops) :=
begin
  rw [nonloops_eq_compl_loops, ← diff_eq],
  convert (rank_eq_rank_diff_rank_zero X _).symm,
  rw rank_zero_iff_subset_loops,
  intros e he,
  rw [← loop_iff_mem_loops, loop_iff_r, ← ε_eq_pc_matroid_r, ε_eq_r_of_r_le_one],
  { rwa [← loop_iff_r, loop_iff_mem_loops],},

  exact rank_single_ub M e,
  -- What the hell? VVV
  recover, apply_instance,
end

lemma ε_eq_num_points_inter (M : matroid α) (X : set α) :
  M.ε X = size {P : M.point | ((P.val \ M.loops) ∩ X).nonempty } :=
begin
  rw ε_eq_num_parallel_classes_inter,
  convert (size_image_inj M.parallel_class_point_equiv.injective _).symm,
  ext P, cases P with P hP,
  simp only [mem_set_of_eq, subtype.val_eq_coe],
  split,
  { rintros ⟨x,hx⟩,
    rw [mem_inter_iff, mem_diff, ← nonloop_iff_not_mem_loops] at hx,
    refine ⟨parallel_class_of x hx.1.2, ⟨⟨x,mem_inter hx.2 _⟩,_⟩⟩,
    { exact mem_parallel_class_of hx.1.2,},
    refine subtype.mk_eq_mk.mpr _,
    simp only [coe_parallel_class_of, subtype.val_eq_coe, ← point_eq_cl_mem hP hx.1.2 hx.1.1],
    rw cl_eq_parallel_cl_union_loops,},
  simp only [and_imp, exists_imp_distrib],
  rintros ⟨Q,hQ⟩ ⟨x, hx⟩ hxQ,
  simp only [subtype.mk_eq_mk, parallel_class_point_equiv_apply] at hxQ,
  subst hxQ,
  refine ⟨x, _⟩,
  simp only [mem_union, mem_inter_iff, mem_diff,
  subtype.coe_mk, ← nonloop_iff_not_mem_loops] at ⊢ hx,
  have := nonloop_of_mem_parallel_class hx.2 hQ, tauto,
end

lemma ε_flat_eq_num_points {M : matroid α} {F : set α} (hF : M.is_flat F):
  M.ε F = size {P : set α | M.is_point P ∧ P ⊆ F} :=
begin
  simp only [ε_eq_num_points_inter M F, ← size_set_of_push] ,
  convert rfl,
  ext P,
  cases P with P hP,
  refine ⟨λ h, (nonempty_of_r_nonzero M _), _⟩,
  { have hPF : P \ M.loops ⊆ F := subset.trans (diff_subset _ _) h,
    rw [subset_iff_inter_eq_left.mp hPF, rank_eq_rank_diff_loops, hP.r],
    norm_num },
  obtain ⟨e,he,rfl⟩ := point_iff_cl_nonloop.mp hP,
  rintros ⟨x, ⟨ ⟨hxP, hxL⟩ , hxF⟩ ⟩,
  apply (subset_flat _ _ _ hF),
  rw singleton_subset_iff,
  exact mem_flat_of_parallel hF (parallel_of_mem_cl hxP (nonloop_iff_not_mem_loops.mpr hxL)) hxF,
end

lemma ε_univ_eq_num_points (M : matroid α):
  M.ε univ = type_size M.point :=
begin
  rw [point, type_size_type_of_eq_size_set_of],
  convert ε_flat_eq_num_points M.univ_is_flat,
  ext P,
  exact ⟨λ h, ⟨h, subset_univ _⟩, λ h, h.1⟩,
end

lemma ε_univ_eq_size_set_of_points (M : matroid α):
  M.ε univ = size { P : set α | M.is_point P } :=
by {rw [ε_univ_eq_num_points, point, type_size_type_of_eq_size_set_of]}

lemma ε_proj_nonloop (M : matroid α) {e : α} (he : M.is_nonloop e):
  (M ⟋ {e}).ε univ = size { L | M.is_line L ∧ e ∈ L} :=
begin
  rw [ε_univ_eq_num_points, point, type_size_type_of_eq_size_set_of],
  convert rfl, ext, rwa [point_project_nonloop_iff],
end

/-- this is the workhorse for Kung's Theorem - it gives a formula for the number of points of M
in terms of the lengths of lines of M through e -/
lemma ε_as_ε_proj_nonloop {M : matroid α} {e : α} (he : M.is_nonloop e):
  M.ε univ = 1 + ∑ᶠ L in { L | M.is_line L ∧ e ∈ L}, (M.ε L - 1) :=
begin
  set lines := {L : set α | M.is_line L ∧ e ∈ L},
  have hcle : ∀ L ∈ lines, disjoint {P | M.is_point P ∧ P ⊆ L ∧ P ≠ M.cl {e}} {M.cl {e}},
  { intros L hL, simp, },
  have h₁ : ∀ L ∈ lines, M.ε L - 1 = size {P | M.is_point P ∧ P ⊆ L ∧ P ≠ M.cl {e}},
  { intros L hL,
    rw [ε_flat_eq_num_points (hL.1.flat),  sub_eq_iff_eq_add,
    ←size_singleton (M.cl {e}), ← size_union_of_disjoint (hcle L hL)],
    congr',
    ext X,
    rw [mem_def, mem_union, mem_set_of_eq, mem_singleton_iff],
    refine ⟨λ h, by {by_cases h' : X = M.cl {e}; tauto, } , λ h, _⟩,
    rcases h with (h₁ | rfl), tauto,
    exact ⟨point_of_cl_nonloop he, subset_flat _ _ (singleton_subset_iff.mpr hL.2) (hL.1.flat)⟩},

  rw [finsum_in_eq_of_eq h₁, ← size_bUnion, ← size_singleton (M.cl {e} : set α),
   ← size_union_of_disjoint, ε_univ_eq_size_set_of_points], rotate,
  { rw [disjoint_iff_inter_eq_empty, inter_bUnion],
    ext x,
    rw [mem_bUnion_iff],
    conv in (_ ∩ _) {rw [inter_comm], rw (disjoint_iff_inter_eq_empty.mp (hcle _ h))},
    tauto},
  { rintros x y ⟨hx, hxL⟩ ⟨hy, hyL⟩ hxy,
    simp only [disjoint_right, and_imp, not_and, not_not, mem_set_of_eq, ne.def],
    rintros a ha hay - - hax,
    obtain ⟨f, hf, rfl⟩ := point_iff_cl_nonloop.mp ha,
    rw [cl_eq_cl_iff_parallel_cl_eq_parallel_cl, ← parallel_iff_parallel_cl_eq_left hf],
    apply parallel_of_rank_le_one hf he,
    refine le_trans (M.rank_mono _) (rank_inter_lines_le_one hx hy hxy),
    have := singleton_subset_iff.mp (subset.trans (M.subset_cl {f}) hay),
    have := singleton_subset_iff.mp (subset.trans (M.subset_cl {f}) hax),
    intro z,
    simp only [mem_singleton_iff, mem_inter_eq, mem_insert_iff],
    rintro (rfl | rfl); tauto,},

  convert rfl,
  ext P,
  simp only [exists_prop, mem_Union, singleton_union, mem_set_of_eq, mem_insert_iff, ne.def],
  refine ⟨by { rintros (rfl | h), exact point_of_cl_nonloop he, tauto, }, λ h, _⟩,

  obtain ⟨f, hf, rfl⟩ := point_iff_cl_nonloop.mp h,
  simp only [cl_eq_cl_iff_parallel_cl_eq_parallel_cl, ← parallel_iff_parallel_cl_eq_left hf],

  by_cases hef : M.parallel f e, left, assumption, right,

  refine ⟨M.cl {e,f}, ⟨⟨cl_is_flat _ _,_⟩,_⟩ , _, _, hef⟩,
  { rw [rank_cl, pair_comm, rank_two_of_not_parallel hf he hef] },
  { exact mem_of_mem_of_subset (mem_insert _ _) (subset_cl _ _) },
  { exact point_of_cl_nonloop hf},
  simp [cl_monotone],
end

/- This should be changed to being stated in terms of M ⟍ {f} rather than M ⟍ {e}  to be consistent
with other lemmas -/
lemma ε_loopify_parallel (M : matroid α) {e f : α} (hef : e ≠ f) (hpara : M.parallel e f) :
  (M ⟍ {e}).ε univ = M.ε univ :=
begin
  rw eq_comm, repeat {rw ε_univ_eq_largest_simple_set},
  obtain ⟨⟨S,hS⟩,  hS', hS''⟩ := max_spec (λ (S : M.simple_set), size (S : set α)),
  rw [← hS', eq_comm],
  dsimp only [subtype.coe_mk],
  by_cases he : e ∈ S,
  { have hf : f ∉ S, from λ hf,
    by {rw simple_set_iff_no_loops_or_parallel_pairs at hS, exact hef (hS.2 _ _ he hf hpara)},
    set S' := (S \ {e}) ∪ {f} with hS'_def,
    have hS' : (M ⟍ {e}).is_simple_set S',
    { rw [loopify_simple_iff_simple_disjoint, disjoint_singleton_right, hS'_def],
      refine ⟨simple_set_exchange hS he hpara, λ he, _⟩,
      rw [mem_union, mem_diff_iff, mem_singleton_iff, mem_singleton_iff] at he, tauto},
    refine attained_ub_is_max' _ ⟨S', hS'⟩ _ _ _,
    { rw [subtype.coe_mk, hS'_def, size_remove_union_singleton he hf]},
    rintros ⟨S₀, hS₀⟩,
    rw loopify_simple_iff_simple_disjoint at hS₀,
    exact hS'' ⟨S₀, hS₀.1⟩},
  refine attained_ub_is_max' _ ⟨S, _⟩ _ (le_of_eq rfl) _,
  { exact loopify_simple_iff_simple_disjoint.mpr ⟨hS, by rwa disjoint_singleton_right⟩},
  rintros ⟨S₀, hS₀⟩,
  rw loopify_simple_iff_simple_disjoint at hS₀,
  exact hS'' ⟨S₀, hS₀.1⟩,
end

lemma ε_loopify_to_eq_ε (M : matroid α) (X : set α) :
  (M ‖ X).ε univ = M.ε X :=
begin
  repeat {rw ε_eq_largest_simple_subset},
  set φ : (M ‖ X).simple_subset_of univ → M.simple_subset_of X :=
    λ S, ⟨S.val, by {obtain ⟨S, hS₁, hS₂⟩ := S, dsimp only, rwa  ←simple_loopify_to_iff, }⟩ with hφ,
  have hsurj : function.surjective φ,
  { rintro ⟨S, hS₁, hS₂⟩, exact ⟨⟨S, ⟨simple_loopify_to_iff.mpr ⟨hS₁, hS₂⟩, subset_univ _⟩⟩, rfl⟩},
  convert max_reindex φ hsurj (λ (S : M.simple_subset_of X), size ↑S),
  ext, refl,
end


import tactic
import order.filter.n_ary
import order.filter.partial
import order.filter.ultrafilter
import order.filter.bases
import algebra.support
import category_theory.concrete_category.bundled

noncomputable theory
open set function filter classical option category_theory prod
open_locale classical filter

universe w

variables {α α₁ α₂ β β₁ β₂ γ : Type*}

/-!
### Definition
-/

/-- A convergence structure on `α`. -/
@[ext] class convergence_space (α : Type*) :=
(converges : filter α → α → Prop)
(pure_converges : ∀ x, converges (pure x) x)
(le_converges : ∀ {f g}, f ≤ g → ∀ {x}, converges g x → converges f x)

open convergence_space

section
variables (p : convergence_space α)
@[simp] def converges_ (f : filter α) (x : α) : Prop := @converges _ p f x
@[simp] def pure_converges_ (x : α) : converges (pure x) x := @pure_converges _ p x
@[simp] def le_converges_ ⦃f g : filter α⦄ (hle : f ≤ g) {x : α}
  (hconv : converges g x) : converges f x :=
@le_converges _ p _ _ hle _ hconv
end

/- N.B. In any convergence space, the bottom filter converges to every point. -/
lemma bot_converges [convergence_space α] (x : α) : converges ⊥ x :=
le_converges bot_le (pure_converges x)

/-!
### Ordering
-/

/-- The ordering on convergence structures on the type `α`.
  `p ≤ q` if p-convergence implies q-convergence (`p` is finer than `q`
  or `q` is coarser than `p`). -/

instance : has_le (convergence_space α) :=
⟨λ p q, ∀ {f x}, converges_ p f x → converges_ q f x⟩

instance : partial_order (convergence_space α) :=
{ le_refl := by { unfold has_le.le, intros, assumption },
  le_trans := by { assume p q r hpq hqr f x hconv, exact (hqr (hpq hconv)) },
  le_antisymm := by { assume p q hpq hqp, ext f x, exact iff.intro hpq hqp },
  ..convergence_space.has_le }

/-!
### Initial convergence
-/

def convergence_space.initial {ι : Type*} {β : ι → Type*}
  (p : ∀ i : ι, convergence_space (β i)) (m : ∀ i : ι, α → β i) : convergence_space α :=
{ converges := λ f x, ∀ i : ι, converges_ (p i) (map (m i) f) ((m i) x),
  pure_converges := λ x i, by rw filter.map_pure; exact pure_converges_ (p i) ((m i) x),
  le_converges := λ f g hle x hconv i, le_converges_ (p i) (filter.map_mono hle) (hconv i) }

/-!
### Lattice of convergence structures
-/

/-- Convergence structures on `α` form a complete lattice, with `⊥` the discrete convergence
  structure (where only pure filters and the bottom filter converge) and `⊤` the indiscrete
  convergence structure (where every filter converges). The infimum of a non-empty collection
  `ps` is defined so that `converges f x` means `∀ p ∈ ps, converges_ p f x`, while the
  supremum is defined so that `converges f x` means `∃ p ∈ ps, converges_ p f x`. -/

instance : has_bot (convergence_space α) :=
{ bot :=
  { converges := λ f x, f ≤ pure x,
    pure_converges := by tauto,
    le_converges := by tauto }}

instance : has_top (convergence_space α) :=
{ top :=
  { converges := λ f x, true,
    pure_converges := by tauto,
    le_converges := by tauto }}

instance : has_inf (convergence_space α) :=
{ inf := λ p q,
  { converges := λ f x, (converges_ p f x) ∧ (converges_ q f x),
    pure_converges := λ x, and.intro (pure_converges_ p x) (pure_converges_ q x),
    le_converges := λ f g hle x hconv,
      and.intro (le_converges_ p hle hconv.left) (le_converges_ q hle hconv.right)
    }}

instance : has_sup (convergence_space α) :=
{ sup := λ p q,
  { converges := λ f x, (converges_ p f x) ∨ (converges_ q f x),
    pure_converges := λ x, or.inl (pure_converges_ p x),
    le_converges := λ f g hle x hconv, or.elim hconv
      (assume hl, or.inl (le_converges_ p hle hl))
      (assume hr, or.inr (le_converges_ q hle hr)) }}

instance : has_Inf (convergence_space α) :=
{ Inf := λ ps,
  { converges := λ f x, ∀ {p : convergence_space α}, p ∈ ps → converges_ p f x,
    pure_converges := λ x p ps, pure_converges_ p x,
    le_converges := λ f g hle x hconv p hmem, le_converges_ p hle (hconv hmem) }}

instance : has_Sup (convergence_space α) :=
{ Sup := λ ps,
  { converges := λ f x, f ≤ pure x ∨
      ∃ p : convergence_space α, p ∈ ps ∧ converges_ p f x,
    pure_converges := by tauto,
    le_converges :=
    begin
      assume f g hle x hor,
      rcases hor with hle'|⟨p, hmem, hconv⟩,
      { exact or.inl (le_trans hle hle') },
      { refine or.inr ⟨p, hmem, le_converges_ p hle hconv⟩, },
    end }}

instance : semilattice_inf (convergence_space α) :=
{ inf_le_left := λ p q f x hconv, hconv.left,
  inf_le_right := λ p q f x hconv, hconv.right,
  le_inf := λ p q r hle hle' f x hp, and.intro (hle hp) (hle' hp),
  ..convergence_space.partial_order,
  ..convergence_space.has_inf }

instance : semilattice_sup (convergence_space α) :=
{ le_sup_left := λ p q f x hconv, or.inl hconv,
  le_sup_right := λ p q f x hconv, or.inr hconv,
  sup_le := λ p q r hle hle' f x hconv, hconv.elim hle hle',
  ..convergence_space.partial_order,
  ..convergence_space.has_sup }

instance : complete_semilattice_Inf (convergence_space α) :=
{ Inf_le := λ ps p hmem f x hconv, hconv hmem,
  le_Inf := λ ps q hle f x hconv p hmem, (hle p hmem) hconv,
  ..convergence_space.partial_order,
  ..convergence_space.has_Inf }

instance : complete_semilattice_Sup (convergence_space α) :=
{ le_Sup := λ ps p hmem f x hconv, or.inr (exists.intro p (and.intro hmem hconv)),
  Sup_le := λ qs p hle f x hconv,
    hconv.elim
      (assume hle', le_converges_ p hle' (pure_converges_ p x))
      (assume hexists, exists.elim hexists (assume q hconv', (hle q hconv'.left) hconv'.right)),
  ..convergence_space.partial_order,
  ..convergence_space.has_Sup }

instance : lattice (convergence_space α) :=
{ ..convergence_space.semilattice_sup,
  ..convergence_space.semilattice_inf }

instance : complete_lattice (convergence_space α) :=
{ bot_le := λ p f x hconv, le_converges_ p hconv (pure_converges_ p x),
  le_top := by intros; tauto,
  ..convergence_space.has_bot,
  ..convergence_space.has_top,
  ..convergence_space.lattice,
  ..convergence_space.complete_semilattice_Inf,
  ..convergence_space.complete_semilattice_Sup }

/-!
### Continuity
-/

/-- A function `m` between converges spaces is continuous at a point `x`
  if whenever a filter converges to `x`, it's image under `m` converges to `m x`. --/
def continuous_at [convergence_space α] [convergence_space β] (m : α → β) (x : α) :=
∀ ⦃f⦄, converges f x → converges (map m f) (m x)

def continuous [convergence_space α] [convergence_space β] (m : α → β) : Prop :=
∀ ⦃x⦄, continuous_at m x

def continuous_ (p : convergence_space α) (q : convergence_space β)
  (m : α → β) : Prop :=
@continuous α β p q m

lemma continuous.comp [convergence_space α] [convergence_space β]
  [convergence_space γ] {m' : β → γ} {m : α → β} (hcont' : continuous m')
  (hcont : continuous m) : continuous (m' ∘ m) :=
λ x f hconv, by convert (hcont' (hcont hconv))

lemma continuous_id [convergence_space α] : continuous (id : α → α) :=
λ x f hconv, by simpa [filter.map_id]

lemma continuous_id' {α : Type*} [convergence_space α] : continuous (λ x : α, x) :=
continuous_id

lemma continuous_const [convergence_space α] [convergence_space β] {y : β} :
  continuous (λ (x : α), y) :=
λ x f hconv, le_converges (tendsto_const_pure) (pure_converges y)

lemma continuous_le_dom {p p' : convergence_space α} {q : convergence_space β}
  {m : α → β} (hle : p' ≤ p) (hcont : continuous_ p q m) :
  continuous_ p' q m :=
λ x f hconv, hcont (hle hconv)

lemma continuous_inf_dom_left {p p' : convergence_space α}
  {q : convergence_space β} {m : α → β} :
  continuous_ p q m → continuous_ (p ⊓ p') q m :=
continuous_le_dom inf_le_left

lemma continuous_inf_dom_right {p p' : convergence_space α}
  {q : convergence_space β} {m : α → β} :
  continuous_ p' q m → continuous_ (p ⊓ p') q m :=
continuous_le_dom inf_le_right

lemma continuous_inf_rng [p : convergence_space α] {q q' : convergence_space β} {m : α → β}
  (hcont : continuous_ p q m) (hcont' : continuous_ p q' m) : continuous_ p (q ⊓ q') m :=
λ x f hp, and.intro (hcont hp) (hcont' hp)

structure homeomorph (α β : Type*) [convergence_space α] [convergence_space β]
  extends α ≃ β :=
(continuous_to_fun : continuous to_fun)
(continuous_inv_fun : continuous inv_fun)

/-!
### Induced convergence structure
-/

/-- Given `m : α → β`, where `β` is a convergence space, the induced convergence
  structure on `α` is the greatest (coarsest) convergence structure making `m`
  continuous. -/
def convergence_space.induced (m : α → β) [convergence_space β] :
  convergence_space α :=
{ converges := λ f x, converges (map m f) (m x),
  pure_converges := by simp [filter.map_pure, pure_converges],
  le_converges := λ f g hle x hconv, le_converges (map_mono hle) hconv }

lemma continuous.induced_le (m : α → β) [p : convergence_space α]
  [convergence_space β] (hm : continuous m) :
  p ≤ convergence_space.induced m :=
λ f x hconv, hm hconv

lemma continuous_induced_dom {m : α → β} {q : convergence_space β} :
  continuous_ (@convergence_space.induced α β m q) q m :=
λ x f hconv, hconv

lemma continuous_induced_rng {m₁ : α → β} {m₂ : β → γ}
  [p : convergence_space α] [q : convergence_space β] [r : convergence_space γ]
  (hcont : continuous (m₂ ∘ m₁)) : continuous_ p (convergence_space.induced m₂) m₁ :=
λ x f hconv, hcont hconv

/-!
### Coinduced convergence structure
-/

/-- Given `m : α → β`, where `α` is a convergence space, the coinduced convergence
  structure on `β` is the least (finest) convergence structure making `m` continuous. -/
def convergence_space.coinduced (m : α → β) [convergence_space α] :
  convergence_space β :=
{ converges := λ g y, (g ≤ pure y) ∨
    ∃ f x, (g ≤ map m f) ∧ (m x = y) ∧ (converges f x),
  pure_converges := λ b, or.inl (le_refl (pure b)),
  le_converges := λ g₁ g₂ hle y hconv,
    or.elim hconv
      (λ hle' : g₂ ≤ pure y, or.inl (le_trans hle hle'))
      (λ ⟨f, x, hle', heq, hconv'⟩,
        or.inr ⟨f, x, le_trans hle hle', heq, hconv'⟩) }

lemma continuous.le_coinduced (m : α → β) [convergence_space α]
  [q : convergence_space β] (hm : continuous m) :
  convergence_space.coinduced m ≤ q :=
λ g y hconv, hconv.elim
  (λ hle, le_converges_ q hle (pure_converges_ q y))
  (λ ⟨f, x, h₀, h₁, h₂⟩, by { rw ← h₁, exact le_converges_ q h₀ (hm h₂) })

lemma coinduced_id [p : convergence_space α] : convergence_space.coinduced id = p :=
begin
  ext f x, split,
  { assume hconv, cases hconv,
    { exact le_converges_ p hconv (pure_converges_ p x) },
    { obtain ⟨g, y, hle, heq, hconv'⟩ := hconv,
      simp at *, rw ← heq, exact le_converges_ p hle hconv' }},
  { assume hconv : converges_ p f x,
    exact or.inr ⟨f, x, le_refl f, rfl, hconv⟩, }
end

lemma continuous_iff_coinduced_le {m : α → β}
  [convergence_space α] [q : convergence_space β]  :
  continuous m ↔ convergence_space.coinduced m ≤ q :=
begin
  split,
  { assume hcont g y hconv, cases hconv,
    { exact le_converges_ q hconv (pure_converges_ q y) },
    { obtain ⟨f, x, hle, heq, hconv'⟩ := hconv,
      rw ← heq, exact le_converges_ q hle (hcont hconv') }},
  { assume hle x f hconv, exact hle (or.inr ⟨f, x, le_refl (map m f), rfl, hconv⟩) }
end

lemma coinduced_compose [convergence_space α]
  {m₁ : α → β} {m₂ : β → γ} :
  @convergence_space.coinduced _ _ m₂ (convergence_space.coinduced m₁) =
  convergence_space.coinduced (m₂ ∘ m₁) :=
begin
  ext h z, split,
  { assume hconv, cases hconv,
    { exact or.inl hconv },
    { obtain ⟨g, y, hg₁, hg₂, hg₃⟩ := hconv,
      cases hg₃,
      { have : h ≤ pure z, from calc
            h ≤ map m₂ g : hg₁
            ... ≤ map m₂ (pure y) : map_mono hg₃
            ... = pure (m₂ y) : by rw filter.map_pure
            ... = pure z : by rw hg₂,
        exact or.inl this },
      { obtain ⟨f, x, hf₁, hf₂, hf₃⟩ := hg₃,
          have hle : h ≤ map (m₂ ∘ m₁) f, from calc
            h ≤ map m₂ (map m₁ f) : le_trans hg₁ (map_mono hf₁)
            ... = map (m₂ ∘ m₁) f : by rw filter.map_map,
          have heq : (m₂ ∘ m₁) x = z, by simp [hf₂, hg₂],
          exact or.inr ⟨f, x, hle, heq, hf₃⟩ }}},
  { assume hconv, cases hconv,
    { exact or.inl hconv },
    { obtain ⟨f, x, hf₁, hf₂, hf₃⟩ := hconv,
      let g : filter β := map m₁ f,
      let y : β := m₁ x,
      let hg₁ : h ≤ map m₂ g := by tauto,
      let hg₂ : m₂ y = z := by tauto,
      let hg₃ : converges_ (convergence_space.coinduced m₁) g y :=
        or.inr ⟨f, x, le_refl (map m₁ f), rfl, hf₃⟩,
      exact or.inr ⟨g, y, hg₁, hg₂, hg₃⟩ }}
end

lemma continuous_coinduced_rng [p : convergence_space α]
  {m : α → β} : continuous_ p (convergence_space.coinduced m) m :=
λ x f hconv, or.inr ⟨f, x, le_refl (map m f), rfl, hconv⟩

/-!
### More definitions
-/

section

variables [convergence_space α]

/-- The set of all limits of a filter. -/
def lim (f : filter α) : set α := { x | converges f x }

/-- A filter is convergent if it has a limit. -/
def convergent (f : filter α) : Prop := ∃ x, converges f x

/-- A point `x` adheres to a filter `f` if there is some non-trivial filter
  smaller than `f` that converges to `x`. -/
def adheres (f : filter α) (x : α) : Prop :=
∃ (g : filter α) [ne_bot g], g ≤ f ∧ converges g x

lemma adheres.exists_ultrafilter (f : filter α) (x : α) :
  adheres f x ↔ ∃ (g : ultrafilter α), ↑g ≤ f ∧ converges ↑g x :=
begin
  split,
  { rintros ⟨g, hnb, hle, hconv⟩,
    haveI : g.ne_bot := hnb,
    obtain ⟨g', hle'⟩ := filter.exists_ultrafilter_le g,
    exact ⟨g', le_trans hle' hle, le_converges hle' hconv⟩ },
  { rintros ⟨g, hle, hconv⟩,
    exact ⟨↑g, g.ne_bot, hle, hconv⟩ }
end

/-- The set of all points that adhere to a filter. -/
def adh (f : filter α) : set α := { x | adheres f x }

/-- The interior of a set `s` consists of those points `x ∈ s` with the property
  that every non-trivial filter converging to `x` contains `s`.  -/
def interior (s : set α) : set α :=
{ x ∈ s | ∀ (f : filter α) [ne_bot f], converges f x → s ∈ f }

/-- A set is open if it equals its interior. -/
def is_open (s : set α) : Prop := s = interior s

/-- The closure of a set `s` consists of all those points that are the limits of
  the non-trivial filters containing `s`. -/
def closure (s : set α) : set α :=
{ x | ∃ (f : filter α) [ne_bot f], converges f x ∧ s ∈ f }

/-- A set is closed if it equals its closure. -/
def is_closed (s : set α) : Prop := s = closure s

/-- A set `s` is dense if every point in the space belongs to `closure s`. -/
def is_dense (s : set α) : Prop := ∀ x, x ∈ closure s

/-- `cl f` is the filter generated by the closure of all the sets of `f`. -/
def cl (f : filter α) : filter α := filter.generate (closure '' f.sets)

/-- A set `s` is strictly dense if `converges f x` implies there is a filter `g`
  that contains `s`, converges to `x` and satisfies `f ≤ cl g`. -/
def is_strictly_dense (s : set α) : Prop :=
∀ {x : α} {f : filter α}, converges f x → ∃ g, (s ∈ g) ∧ (converges g x) ∧ (f ≤ cl g)

/-- The neighborhood filter of `x` is the infimum of all filters converging to `x`. -/
def nhds (x : α) : filter α := ⨅ f ∈ { g | converges g x }, f

end

/-!
### Product spaces
-/

section

variables [convergence_space α] [convergence_space β]

instance : convergence_space (α × β) :=
convergence_space.induced fst ⊓ convergence_space.induced snd

lemma continuous_fst : continuous (@fst α β) :=
continuous_inf_dom_left continuous_induced_dom

lemma continuous_snd : continuous (@snd α β) :=
continuous_inf_dom_right continuous_induced_dom

lemma prod.converges {f : filter α} {g : filter β} {x : α} {y : β}
  (hf : converges f x) (hg : converges g y) : converges (f ×ᶠ g) (x, y) :=
and.intro
  (le_converges tendsto_fst hf : converges (map fst (f ×ᶠ g)) x)
  (le_converges tendsto_snd hg : converges (map snd (f ×ᶠ g)) y)

lemma continuous.prod_mk [convergence_space α] [convergence_space β₁]
  [convergence_space β₂] {m₁ : α → β₁} {m₂ : α → β₂}
  (hcont₁ : continuous m₁) (hcont₂ : continuous m₂) : continuous (λx, (m₁ x, m₂ x)) :=
continuous_inf_rng (continuous_induced_rng hcont₁) (continuous_induced_rng hcont₂)

lemma continuous.prod.mk [convergence_space α] [convergence_space β] (x : α) :
  continuous (prod.mk x : β → α × β) :=
continuous_const.prod_mk continuous_id'

def continuous2 [convergence_space α] [convergence_space β] [convergence_space γ]
  (m : α → β → γ) : Prop :=
∀ ⦃x y f g⦄, converges f x → converges g y → converges (map₂ m f g) (m x y)

lemma continuous2_continuous_iff [convergence_space α] [convergence_space β] [convergence_space γ]
  {m : α → β → γ} : continuous2 m ↔ continuous (uncurry m) :=
begin
  split,
  { rintros hcont2 ⟨x, y⟩ h ⟨hconv₁, hconv₂⟩,
    have : converges (map₂ m (map fst h) (map snd h)) (m x y),
      from hcont2 hconv₁ hconv₂,
    rw ← map_prod_eq_map₂ at this,
    exact le_converges (map_mono le_prod_map_fst_snd) this },
  { intros hcont x y f g hf hg,
    rw ← map_prod_eq_map₂,
    exact hcont (prod.converges hf hg) },
end

end

/-!
### Other convergence spaces constructions
-/

instance {p : α → Prop} [convergence_space α] : convergence_space (subtype p) :=
convergence_space.induced (coe : subtype p → α)

instance {r : α → α → Prop} [convergence_space α] : convergence_space (quot r) :=
convergence_space.coinduced (quot.mk r)

instance [convergence_space α] : convergence_space (option α) :=
convergence_space.coinduced some

instance [convergence_space α] : convergence_space (part α) :=
convergence_space.coinduced part.some

/-!
### The convergence space C(α,β)
-/

/-- Bundled continuous maps. -/
structure continuous_map (α β : Type*)
  [convergence_space α] [convergence_space β] :=
(to_fun : α → β)
(continuous_to_fun : continuous to_fun)

notation `C(` α `, ` β `)` := continuous_map α β

namespace continuous_map

variables [convergence_space α] [convergence_space β]

instance : has_coe_to_fun (C(α, β)) (λ _, α → β) := ⟨continuous_map.to_fun⟩

@[simp] lemma to_fun_eq_coe {m : C(α, β)} : m.to_fun = (m : α → β) := rfl

def eval : C(α, β) × α → β := λ ⟨m, x⟩, m x

@[simp] lemma eval_comp_prod {m : C(α, β)} : eval ∘ prod.mk m = m :=
by { apply funext, intro, apply comp_apply }

protected lemma continuous (m : C(α, β)) : continuous m := m.continuous_to_fun

lemma map_eval_eq {m : C(α, β)} {f : filter α} :
  map continuous_map.eval (pure m ×ᶠ f) = map m f :=
by simp [pure_prod, filter.map_map, eval_comp_prod]

end continuous_map

instance [convergence_space α] [convergence_space β] :
  convergence_space C(α, β) :=
{ converges := λ f m, ∀ (x : α) (g : filter α),
    converges g x → converges (map continuous_map.eval (f ×ᶠ g)) (m x),
  pure_converges := λ m x g hconv,
    by { rw continuous_map.map_eval_eq, exact m.continuous_to_fun hconv},
  le_converges := λ f g hle m hconv x f' hconv',
    le_converges (map_mono (prod_mono hle (le_refl f'))) (hconv x f' hconv') }

/-!
### Separation axioms
-/

/-- In a T₀ space, the equality of two points can be determined by checking
  if the corresponding pure filters converge to the other point. -/
class t0_space (α : Type*) [convergence_space α] : Prop :=
(t0_prop : ∀ x y : α, converges (pure x) y ∧ converges (pure y) x ↔ x = y)

abbreviation kolmogorov_space := t0_space

/-- In an R₀ space, if `pure x` converges to `y`, then `x` and `y` have the
  same convergent filters. -/
class r0_space (α : Type*) [convergence_space α] : Prop :=
(r0_prop : ∀ x y, converges (pure x) y →
∀ (f : filter α), converges f x ↔ converges f y)

/-- In a T₁ space, pure filters have exactly one limit. -/
class t1_space (α : Type*) [convergence_space α] : Prop :=
(t1_prop : ∀ x y : α, converges (pure x) y → x = y)

abbreviation frechet_space := t1_space

/-- In an R₁ space, if `x` and `y` are the limits of a non-trivial filter, then
  they share the same convergent filters. -/
class r1_space (α : Type*) [convergence_space α] : Prop :=
(r1_prop : ∀ x y, ∃ (f : filter α) [ne_bot f], converges f x ∧ converges f y →
  ∀ (g : filter α), converges g x ↔ converges g y)

/-- In a T₂ space, every non-trivial filter has exactly one limit. -/
class t2_space (α : Type*) [convergence_space α] : Prop :=
(t2_prop : ∀ x y, ∀ (f : filter α) [ne_bot f],
  converges f x ∧ converges f y → x = y)

abbreviation hausdorff_space := t2_space

/-- In an R₂ space, if a filter converges, then so does its closure. -/
class r2_space (α : Type*) [convergence_space α] : Prop :=
(r2_prop : ∀ (x : α) (f : filter α), converges f x → converges (cl f) x)

abbreviation regular_space := r2_space

/-- A T₃ space is a T₀ & R₂ space. -/
class t3_space (α : Type*) [convergence_space α] extends
  t0_space α, r2_space α.

/-!
### Compact sets/spaces
-/

def is_compact [convergence_space α] (s : set α) :=
∀ ⦃f : ultrafilter α⦄, s ∈ f → ∃ x ∈ s, converges f.to_filter x

class compact_space (α : Type*) [convergence_space α] : Prop :=
(compact_prop : is_compact (univ : set α))

theorem is_compact.image {m : α → β} {s : set α}
  [convergence_space α] [convergence_space β]
  (hcom : is_compact s) (hcont : continuous m) : is_compact (m '' s) :=
begin
  assume g hmem,
  rw ← ultrafilter.of_comap_inf_principal_eq_of_map hmem,
  obtain ⟨x, hx, hconv⟩ := hcom (ultrafilter.of_comap_inf_principal_mem hmem),
  exact ⟨m x, mem_image_of_mem m hx, hcont hconv⟩,
end

/-!
### Locally compact sets/spaces
-/

/-- A set `s` is locally compact if every convergent filter containing `s` contains
  a compact set. -/
def is_locally_compact [convergence_space α] (s : set α) :=
∀ ⦃f : filter α⦄, s ∈ f → (∃ x : α, converges f x) → ∃ t ∈ f, is_compact t

class locally_compact_space (α : Type*) [convergence_space α] : Prop :=
(locally_compact_prop : is_locally_compact (univ : set α))

/-!
### Quotient maps
-/

/-- A surjective map `m : α → β` where β has the coinduced convergence is
  called a quotient map. -/
def quotient_map [convergence_space α] [q : convergence_space β]
(m : α → β) : Prop := surjective m ∧ q = convergence_space.coinduced m

lemma quotient_map.converges [convergence_space α] [q : convergence_space β]
  {m : α → β} (hquot : quotient_map m) (g : filter β) (y : β) :
  converges g y ↔ ∃ f x, (g ≤ map m f) ∧ (m x = y) ∧ (converges f x) :=
begin
  split,
  { assume hconv, rw hquot.2 at hconv, cases hconv,
    { obtain ⟨x, heq⟩ := hquot.1 y,
      rw [← heq, ← filter.map_pure] at hconv,
      exact ⟨pure x, x, hconv, heq, pure_converges x⟩ },
    { exact hconv }},
  { rintro hexists, rw hquot.2, exact or.inr hexists }
end

lemma quotient_map_iff [convergence_space α] [q : convergence_space β]
  {m : α → β} : quotient_map m ↔ surjective m ∧ ∀ g y, converges g y ↔
  ∃ f x, (g ≤ map m f) ∧ (m x = y) ∧ (converges f x) :=
begin
  split,
  { assume hlhs, exact and.intro hlhs.1 (λ g y, quotient_map.converges hlhs g y) },
  { assume hrhs, refine and.intro hrhs.1 _, ext g y,
    change converges_ q g y ↔ g ≤ pure y ∨
      ∃ (f : filter α) (x : α), g ≤ map m f ∧ m x = y ∧ converges f x,
    refine iff.intro (λ hconv, or.inr ((hrhs.2 g y).mp hconv)) _,
    intro hconv,
    exact hconv.elim
      (λ hle, le_converges_ q hle (pure_converges_ q y))
      (λ hexists, ((hrhs.2 g y).mpr hexists)) }
end

lemma quotient_map.continuous_iff [convergence_space α] [convergence_space β]
  [convergence_space γ] {m₁ : α → β} {m₂ : β → γ} (hquot : quotient_map m₁) :
  continuous m₂ ↔ continuous (m₂ ∘ m₁) :=
by rw [continuous_iff_coinduced_le, continuous_iff_coinduced_le, hquot.right, coinduced_compose]

lemma quotient_map.id [convergence_space α] : quotient_map (@id α) :=
⟨assume a, ⟨a, rfl⟩, coinduced_id.symm⟩

lemma quotient_map.prod_map
  [convergence_space α₁] [convergence_space β₁]
  {m₁ : α₁ → β₁} (hquot₁ : quotient_map m₁)
  [convergence_space α₂] [convergence_space β₂]
  {m₂ : α₂ → β₂} (hquot₂ : quotient_map m₂) :
  quotient_map (prod.map m₁ m₂) :=
begin
  rw quotient_map_iff at *,
  refine and.intro (surjective.prod_map hquot₁.1 hquot₂.1) _,
  rintros (g : filter (β₁ × β₂)) (⟨y₁, y₂⟩ : β₁ × β₂),
  split,
  { assume hconv,
    let g₁ := map fst g,
    let g₂ := map snd g,
    have hg₁ : converges g₁ y₁, from continuous_fst hconv,
    have hg₂ : converges g₂ y₂, from continuous_snd hconv,
    obtain ⟨f₁, x₁, hle₁, heq₁, hf₁⟩ := (hquot₁.2 g₁ y₁).mp hg₁,
    obtain ⟨f₂, x₂, hle₂, heq₂, hf₂⟩ := (hquot₂.2 g₂ y₂).mp hg₂,
    let f := f₁ ×ᶠ f₂,
    let x := (x₁, x₂),
    have hle : g ≤ map (prod.map m₁ m₂) f, from calc
      g ≤ map fst g ×ᶠ map snd g : le_prod_map_fst_snd
      ... = g₁ ×ᶠ g₂ : by tauto
      ... ≤ map m₁ f₁ ×ᶠ map m₂ f₂ : prod_mono hle₁ hle₂
      ... = map (prod.map m₁ m₂) (f₁ ×ᶠ f₂) : prod_map_map_eq' m₁ m₂ f₁ f₂,
    have heq : prod.map m₁ m₂ x = (y₁, y₂),
      by { rw [prod.map_mk m₁ m₂ x₁ x₂, heq₁, heq₂] },
    have hconv' : converges f x, from prod.converges hf₁ hf₂,
    exact ⟨f, x, hle, heq, hconv'⟩ },
  { rintro ⟨f, x, hle, heq, hf⟩,
    let f₁ := map fst f,
    let f₂ := map snd f,
    simp [prod.map_mk m₁ m₂ x.1 x.2] at heq,
    let g₁ := map fst g,
    let g₂ := map snd g,
    have hle₁ : g₁ ≤ map m₁ f₁, from calc
      g₁ ≤ map fst (map (prod.map m₁ m₂) f) : map_mono hle
      ... = map (fst ∘ prod.map m₁ m₂) f : map_map
      ... = map (m₁ ∘ fst) f : by rw (prod.map_fst' m₁ m₂)
      ... = map m₁ f₁ : by simp,
    have hle₂ : g₂ ≤ map m₂ f₂, from calc
      g₂ ≤ map snd (map (prod.map m₁ m₂) f) : map_mono hle
      ... = map (snd ∘ prod.map m₁ m₂) f : map_map
      ... = map (m₂ ∘ snd) f : by rw (prod.map_snd' m₁ m₂)
      ... = map m₂ f₂ : by simp,
    have hg₁ : converges g₁ y₁,
      from (hquot₁.2 g₁ y₁).mpr ⟨f₁, x.1, hle₁, heq.1, hf.1⟩,
    have hg₂ : converges g₂ y₂,
      from (hquot₂.2 g₂ y₂).mpr ⟨f₂, x.2, hle₂, heq.2, hf.2⟩,
    exact ⟨hg₁, hg₂⟩ }
end

lemma quotient_map_quot_mk [convergence_space α] {r : α → α → Prop} :
  quotient_map (quot.mk r) :=
⟨quot.exists_rep, rfl⟩

lemma continuous_quot_mk [convergence_space α]
  {r : α → α → Prop} : continuous (quot.mk r) :=
continuous_coinduced_rng

/-!
### Category Conv of convergence spaces
-/

universe u

def Conv : Type (u+1) := bundled convergence_space


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Chris Hughes, Mario Carneiro, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.prod
import Mathlib.algebra.ring.basic
import Mathlib.data.equiv.ring
import Mathlib.PostPort

universes u_1 u_3 u_5 u_2 u_4

namespace Mathlib

/-!
# Semiring, ring etc structures on `R × S`

In this file we define two-binop (`semiring`, `ring` etc) structures on `R × S`. We also prove
trivial `simp` lemmas, and define the following operations on `ring_hom`s:

* `fst R S : R × S →+* R`, `snd R S : R × S →+* R`: projections `prod.fst` and `prod.snd`
  as `ring_hom`s;
* `f.prod g : `R →+* S × T`: sends `x` to `(f x, g x)`;
* `f.prod_map g : `R × S → R' × S'`: `prod.map f g` as a `ring_hom`,
  sends `(x, y)` to `(f x, g y)`.
-/

namespace prod

/-- Product of two semirings is a semiring. -/
protected instance semiring {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] :
    semiring (R × S) :=
  semiring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry monoid.mul sorry
    monoid.one sorry sorry sorry sorry sorry sorry

/-- Product of two commutative semirings is a commutative semiring. -/
protected instance comm_semiring {R : Type u_1} {S : Type u_3} [comm_semiring R] [comm_semiring S] :
    comm_semiring (R × S) :=
  comm_semiring.mk semiring.add sorry semiring.zero sorry sorry sorry semiring.mul sorry
    semiring.one sorry sorry sorry sorry sorry sorry sorry

/-- Product of two rings is a ring. -/
protected instance ring {R : Type u_1} {S : Type u_3} [ring R] [ring S] : ring (R × S) :=
  ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg
    add_comm_group.sub sorry sorry semiring.mul sorry semiring.one sorry sorry sorry sorry

/-- Product of two commutative rings is a commutative ring. -/
protected instance comm_ring {R : Type u_1} {S : Type u_3} [comm_ring R] [comm_ring S] :
    comm_ring (R × S) :=
  comm_ring.mk ring.add sorry ring.zero sorry sorry ring.neg ring.sub sorry sorry ring.mul sorry
    ring.one sorry sorry sorry sorry sorry

end prod

namespace ring_hom

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/
def fst (R : Type u_1) (S : Type u_3) [semiring R] [semiring S] : R × S →+* R :=
  mk prod.fst sorry sorry sorry sorry

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/
def snd (R : Type u_1) (S : Type u_3) [semiring R] [semiring S] : R × S →+* S :=
  mk prod.snd sorry sorry sorry sorry

@[simp] theorem coe_fst {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] :
    ⇑(fst R S) = prod.fst :=
  rfl

@[simp] theorem coe_snd {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] :
    ⇑(snd R S) = prod.snd :=
  rfl

/-- Combine two ring homomorphisms `f : R →+* S`, `g : R →+* T` into `f.prod g : R →+* S × T`
given by `(f.prod g) x = (f x, g x)` -/
protected def prod {R : Type u_1} {S : Type u_3} {T : Type u_5} [semiring R] [semiring S]
    [semiring T] (f : R →+* S) (g : R →+* T) : R →+* S × T :=
  mk (fun (x : R) => (coe_fn f x, coe_fn g x)) sorry sorry sorry sorry

@[simp] theorem prod_apply {R : Type u_1} {S : Type u_3} {T : Type u_5} [semiring R] [semiring S]
    [semiring T] (f : R →+* S) (g : R →+* T) (x : R) :
    coe_fn (ring_hom.prod f g) x = (coe_fn f x, coe_fn g x) :=
  rfl

@[simp] theorem fst_comp_prod {R : Type u_1} {S : Type u_3} {T : Type u_5} [semiring R] [semiring S]
    [semiring T] (f : R →+* S) (g : R →+* T) : comp (fst S T) (ring_hom.prod f g) = f :=
  ext fun (x : R) => rfl

@[simp] theorem snd_comp_prod {R : Type u_1} {S : Type u_3} {T : Type u_5} [semiring R] [semiring S]
    [semiring T] (f : R →+* S) (g : R →+* T) : comp (snd S T) (ring_hom.prod f g) = g :=
  ext fun (x : R) => rfl

theorem prod_unique {R : Type u_1} {S : Type u_3} {T : Type u_5} [semiring R] [semiring S]
    [semiring T] (f : R →+* S × T) : ring_hom.prod (comp (fst S T) f) (comp (snd S T) f) = f :=
  sorry

/-- `prod.map` as a `ring_hom`. -/
def prod_map {R : Type u_1} {R' : Type u_2} {S : Type u_3} {S' : Type u_4} [semiring R] [semiring S]
    [semiring R'] [semiring S'] (f : R →+* R') (g : S →+* S') : R × S →* R' × S' :=
  ↑(ring_hom.prod (comp f (fst R S)) (comp g (snd R S)))

theorem prod_map_def {R : Type u_1} {R' : Type u_2} {S : Type u_3} {S' : Type u_4} [semiring R]
    [semiring S] [semiring R'] [semiring S'] (f : R →+* R') (g : S →+* S') :
    prod_map f g = ↑(ring_hom.prod (comp f (fst R S)) (comp g (snd R S))) :=
  rfl

@[simp] theorem coe_prod_map {R : Type u_1} {R' : Type u_2} {S : Type u_3} {S' : Type u_4}
    [semiring R] [semiring S] [semiring R'] [semiring S'] (f : R →+* R') (g : S →+* S') :
    ⇑(prod_map f g) = prod.map ⇑f ⇑g :=
  rfl

theorem prod_comp_prod_map {R : Type u_1} {R' : Type u_2} {S : Type u_3} {S' : Type u_4}
    {T : Type u_5} [semiring R] [semiring S] [semiring R'] [semiring S'] [semiring T] (f : T →* R)
    (g : T →* S) (f' : R →* R') (g' : S →* S') :
    monoid_hom.comp (monoid_hom.prod_map f' g') (monoid_hom.prod f g) =
        monoid_hom.prod (monoid_hom.comp f' f) (monoid_hom.comp g' g) :=
  rfl

end ring_hom

namespace ring_equiv

/-- Swapping components as an equivalence of (semi)rings. -/
def prod_comm {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] : R × S ≃+* S × R :=
  mk (add_equiv.to_fun add_equiv.prod_comm) (add_equiv.inv_fun add_equiv.prod_comm) sorry sorry
    sorry sorry

@[simp] theorem coe_prod_comm {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] :
    ⇑prod_comm = prod.swap :=
  rfl

@[simp] theorem coe_prod_comm_symm {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] :
    ⇑(ring_equiv.symm prod_comm) = prod.swap :=
  rfl

@[simp] theorem fst_comp_coe_prod_comm {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] :
    ring_hom.comp (ring_hom.fst S R) ↑prod_comm = ring_hom.snd R S :=
  ring_hom.ext fun (_x : R × S) => rfl

@[simp] theorem snd_comp_coe_prod_comm {R : Type u_1} {S : Type u_3} [semiring R] [semiring S] :
    ring_hom.comp (ring_hom.snd S R) ↑prod_comm = ring_hom.fst R S :=
  ring_hom.ext fun (_x : R × S) => rfl

end Mathlib


example (α : Type*) (a b : α) (p : α → Prop) (h1 : a = b) (h2 : p a) : p b :=
eq.subst h1 h2

example (α : Type*) (a b : α) (p : α → Prop) (h1 : a = b) (h2 : p a) : p b :=
h1 ▸ h2

variable α : Type
variables a b : α
variables f g : α → ℕ
variable h₁ : a = b
variable h₂ : f = g

example : f a = f b := congr_arg f h₁
example : f a = g a := congr_fun h₂ a
example : f a = g b := congr h₂ h₁

#check congr
#check congr_fun
#check congr_arg


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/

import data.nat.multiplicity
import ring_theory.witt_vector.basic
import ring_theory.witt_vector.is_poly

/-!
## The Frobenius operator

If `R` has characteristic `p`, then there is a ring endomorphism `frobenius R p`
that raises `r : R` to the power `p`.
By applying `witt_vector.map` to `frobenius R p`, we obtain a ring endomorphism `𝕎 R →+* 𝕎 R`.
It turns out that this endomorphism can be described by polynomials over `ℤ`
that do not depend on `R` or the fact that it has characteristic `p`.
In this way, we obtain a Frobenius endomorphism `witt_vector.frobenius_fun : 𝕎 R → 𝕎 R`
for every commutative ring `R`.

Unfortunately, the aforementioned polynomials can not be obtained using the machinery
of `witt_structure_int` that was developed in `structure_polynomial.lean`.
We therefore have to define the polynomials by hand, and check that they have the required property.

In case `R` has characteristic `p`, we show in `frobenius_fun_eq_map_frobenius`
that `witt_vector.frobenius_fun` is equal to `witt_vector.map (frobenius R p)`.

### Main definitions and results

* `frobenius_poly`: the polynomials that describe the coefficients of `frobenius_fun`;
* `frobenius_fun`: the Frobenius endomorphism on Witt vectors;
* `frobenius_fun_is_poly`: the tautological assertion that Frobenius is a polynomial function;
* `frobenius_fun_eq_map_frobenius`: the fact that in characteristic `p`, Frobenius is equal to
  `witt_vector.map (frobenius R p)`.

TODO: Show that `witt_vector.frobenius_fun` is a ring homomorphism,
and bundle it into `witt_vector.frobenius`.

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

namespace witt_vector

variables {p : ℕ} {R S : Type*} [hp : fact p.prime] [comm_ring R] [comm_ring S]
local notation `𝕎` := witt_vector p -- type as `\bbW`

noncomputable theory
open mv_polynomial finset
open_locale big_operators

variables (p)
include hp

/-- The rational polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`.
These polynomials actually have integral coefficients,
see `frobenius_poly` and `map_frobenius_poly`. -/
def frobenius_poly_rat (n : ℕ) : mv_polynomial ℕ ℚ :=
bind₁ (witt_polynomial p ℚ ∘ λ n, n + 1) (X_in_terms_of_W p ℚ n)

lemma bind₁_frobenius_poly_rat_witt_polynomial (n : ℕ) :
  bind₁ (frobenius_poly_rat p) (witt_polynomial p ℚ n) = (witt_polynomial p ℚ (n+1)) :=
begin
  delta frobenius_poly_rat,
  rw [← bind₁_bind₁, bind₁_X_in_terms_of_W_witt_polynomial, bind₁_X_right],
end

/-- An auxilliary definition, to avoid an excessive amount of finiteness proofs
for `multiplicity p n`. -/
private def pnat_multiplicity (n : ℕ+) : ℕ :=
(multiplicity p n).get $ multiplicity.finite_nat_iff.mpr $ ⟨ne_of_gt hp.1.one_lt, n.2⟩

local notation `v` := pnat_multiplicity

/-- An auxilliary polynomial over the integers, that satisfies
`(frobenius_poly_aux p n - X n ^ p) / p = frobenius_poly p n`.
This makes it easy to show that `frobenius_poly p n` is congruent to `X n ^ p`
modulo `p`. -/
noncomputable def frobenius_poly_aux : ℕ → mv_polynomial ℕ ℤ
| n := X (n + 1) - ∑ i : fin n, have _ := i.is_lt,
  ∑ j in range (p ^ (n - i)),
    (X i ^ p) ^ (p ^ (n - i) - (j + 1)) *
      (frobenius_poly_aux i) ^ (j + 1) *
      C ↑((p ^ (n - i)).choose (j + 1) / (p ^ (n - i - v p ⟨j + 1, nat.succ_pos j⟩)) *
      ↑p ^ (j - v p ⟨j + 1, nat.succ_pos j⟩) : ℕ)

lemma frobenius_poly_aux_eq (n : ℕ) :
  frobenius_poly_aux p n =
  X (n + 1) - ∑ i in range n, ∑ j in range (p ^ (n - i)),
    (X i ^ p) ^ (p ^ (n - i) - (j + 1)) *
    (frobenius_poly_aux p i) ^ (j + 1) *
    C ↑((p ^ (n - i)).choose (j + 1) / (p ^ (n - i - v p ⟨j + 1, nat.succ_pos j⟩)) *
      ↑p ^ (j - v p ⟨j + 1, nat.succ_pos j⟩) : ℕ) :=
by { rw [frobenius_poly_aux, ← fin.sum_univ_eq_sum_range] }

/-- The polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`. -/
def frobenius_poly (n : ℕ) : mv_polynomial ℕ ℤ :=
X n ^ p + C ↑p * (frobenius_poly_aux p n)

/-
Our next goal is to prove
```
lemma map_frobenius_poly (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom ℚ) (frobenius_poly p n) = frobenius_poly_rat p n
```
This lemma has a rather long proof, but it mostly boils down to applying induction,
and then using the following two key facts at the right point.
-/

/-- A key divisibility fact for the proof of `witt_vector.map_frobenius_poly`. -/
lemma map_frobenius_poly.key₁ (n j : ℕ) (hj : j < p ^ (n)) :
  p ^ (n - v p ⟨j + 1, j.succ_pos⟩) ∣ (p ^ n).choose (j + 1) :=
begin
  apply multiplicity.pow_dvd_of_le_multiplicity,
  have aux : (multiplicity p ((p ^ n).choose (j + 1))).dom,
  { rw [← multiplicity.finite_iff_dom, multiplicity.finite_nat_iff],
    exact ⟨hp.1.ne_one, nat.choose_pos hj⟩, },
  rw [← enat.coe_get aux, enat.coe_le_coe, nat.sub_le_left_iff_le_add,
      ← enat.coe_le_coe, enat.coe_add, pnat_multiplicity, enat.coe_get, enat.coe_get, add_comm],
  exact (hp.1.multiplicity_choose_prime_pow hj j.succ_pos).ge,
end

/-- A key numerical identity needed for the proof of `witt_vector.map_frobenius_poly`. -/
lemma map_frobenius_poly.key₂ {n i j : ℕ} (hi : i < n) (hj : j < p ^ (n - i)) :
  j - (v p ⟨j + 1, j.succ_pos⟩) + n =
    i + j + (n - i - v p ⟨j + 1, j.succ_pos⟩) :=
begin
  generalize h : (v p ⟨j + 1, j.succ_pos⟩) = m,
  suffices : m ≤ n - i ∧ m ≤ j,
  { cases this, unfreezingI { clear_dependent p }, omega },
  split,
  { rw [← h, ← enat.coe_le_coe, pnat_multiplicity, enat.coe_get,
        ← hp.1.multiplicity_choose_prime_pow hj j.succ_pos],
    apply le_add_left, refl },
  { obtain ⟨c, hc⟩ : p ^ m ∣ j + 1,
    { rw [← h], exact multiplicity.pow_multiplicity_dvd _, },
    obtain ⟨c, rfl⟩ : ∃ k : ℕ, c = k + 1,
    { apply nat.exists_eq_succ_of_ne_zero, rintro rfl, simpa only using hc },
    rw [mul_add, mul_one] at hc,
    apply nat.le_of_lt_succ,
    calc m < p ^ m : nat.lt_pow_self hp.1.one_lt m
       ... ≤ j + 1 : by { rw ← nat.sub_eq_of_eq_add hc, apply nat.sub_le } }
end

lemma map_frobenius_poly (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom ℚ) (frobenius_poly p n) = frobenius_poly_rat p n :=
begin
  rw [frobenius_poly, ring_hom.map_add, ring_hom.map_mul, ring_hom.map_pow, map_C, map_X,
      ring_hom.eq_int_cast, int.cast_coe_nat, frobenius_poly_rat],
  apply nat.strong_induction_on n, clear n,
  intros n IH,
  rw [X_in_terms_of_W_eq],
  simp only [alg_hom.map_sum, alg_hom.map_sub, alg_hom.map_mul, alg_hom.map_pow, bind₁_C_right],
  have h1 : (↑p ^ n) * (⅟ (↑p : ℚ) ^ n) = 1 := by rw [←mul_pow, mul_inv_of_self, one_pow],
  rw [bind₁_X_right, function.comp_app, witt_polynomial_eq_sum_C_mul_X_pow, sum_range_succ,
      sum_range_succ, nat.sub_self, nat.add_sub_cancel_left, pow_zero, pow_one, pow_one, sub_mul,
      add_mul, add_mul, mul_right_comm, mul_right_comm (C (↑p ^ (n + 1))), ←C_mul, ←C_mul, pow_succ,
      mul_assoc ↑p (↑p ^ n), h1, mul_one, C_1, one_mul, add_comm _ (X n ^ p), add_assoc, ←add_sub,
      add_right_inj, frobenius_poly_aux_eq, ring_hom.map_sub, map_X, mul_sub, sub_eq_add_neg,
      add_comm _ (C ↑p * X (n + 1)), ←add_sub, add_right_inj, neg_eq_iff_neg_eq, neg_sub],
  simp only [ring_hom.map_sum, mul_sum, sum_mul, ←sum_sub_distrib],
  apply sum_congr rfl,
  intros i hi,
  rw mem_range at hi,
  rw [← IH i hi],
  clear IH,
  rw [add_comm (X i ^ p), add_pow, sum_range_succ', pow_zero, nat.sub_zero, nat.choose_zero_right,
      one_mul, nat.cast_one, mul_one, mul_add, add_mul, nat.succ_sub (le_of_lt hi),
      nat.succ_eq_add_one (n - i), pow_succ, pow_mul, add_sub_cancel, mul_sum, sum_mul],
  apply sum_congr rfl,
  intros j hj,
  rw mem_range at hj,
  rw [ring_hom.map_mul, ring_hom.map_mul, ring_hom.map_pow, ring_hom.map_pow, ring_hom.map_pow,
      ring_hom.map_pow, ring_hom.map_pow, map_C, map_X, mul_pow],
  rw [mul_comm (C ↑p ^ i), mul_comm _ ((X i ^ p) ^ _), mul_comm (C ↑p ^ (j + 1)), mul_comm (C ↑p)],
  simp only [mul_assoc],
  apply congr_arg,
  apply congr_arg,
  rw [←C_eq_coe_nat],
  simp only [←ring_hom.map_pow, ←C_mul],
  rw C_inj,
  simp only [inv_of_eq_inv, ring_hom.eq_int_cast, inv_pow', int.cast_coe_nat, nat.cast_mul],
  rw [rat.coe_nat_div _ _ (map_frobenius_poly.key₁ p (n - i) j hj)],
  simp only [nat.cast_pow, pow_add, pow_one],
  suffices : ((p ^ (n - i)).choose (j + 1) * p ^ (j - v p ⟨j + 1, j.succ_pos⟩) * p * p ^ n : ℚ) =
    p ^ j * p * ((p ^ (n - i)).choose (j + 1) * p ^ i) * p ^ (n - i - v p ⟨j + 1, j.succ_pos⟩),
  { have aux : ∀ k : ℕ, (p ^ k : ℚ) ≠ 0,
    { intro, apply pow_ne_zero, exact_mod_cast hp.1.ne_zero },
    simpa [aux, -one_div] with field_simps using this.symm },
  rw [mul_comm _ (p : ℚ), mul_assoc, mul_assoc, ← pow_add, map_frobenius_poly.key₂ p hi hj],
  ring_exp
end

lemma frobenius_poly_zmod (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom (zmod p)) (frobenius_poly p n) = X n ^ p :=
begin
  rw [frobenius_poly, ring_hom.map_add, ring_hom.map_pow, ring_hom.map_mul, map_X, map_C],
  simp only [int.cast_coe_nat, add_zero, ring_hom.eq_int_cast, zmod.nat_cast_self, zero_mul, C_0],
end

@[simp]
lemma bind₁_frobenius_poly_witt_polynomial (n : ℕ) :
  bind₁ (frobenius_poly p) (witt_polynomial p ℤ n) = (witt_polynomial p ℤ (n+1)) :=
begin
  apply mv_polynomial.map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  simp only [map_bind₁, map_frobenius_poly, bind₁_frobenius_poly_rat_witt_polynomial,
    map_witt_polynomial],
end

variables {p}

/-- `frobenius_fun` is the function underlying the ring endomorphism
`frobenius : 𝕎 R →+* frobenius 𝕎 R`. -/
def frobenius_fun (x : 𝕎 R) : 𝕎 R :=
mk p $ λ n, mv_polynomial.aeval x.coeff (frobenius_poly p n)

lemma coeff_frobenius_fun (x : 𝕎 R) (n : ℕ) :
  coeff (frobenius_fun x) n = mv_polynomial.aeval x.coeff (frobenius_poly p n) :=
by rw [frobenius_fun, coeff_mk]

variables (p)

/-- `frobenius_fun` is tautologically a polynomial function.

See also `frobenius_is_poly`. -/
@[is_poly] lemma frobenius_fun_is_poly : is_poly p (λ R _Rcr, @frobenius_fun p R _ _Rcr) :=
⟨⟨frobenius_poly p, by { introsI, funext n, apply coeff_frobenius_fun }⟩⟩

variable {p}

@[ghost_simps] lemma ghost_component_frobenius_fun (n : ℕ) (x : 𝕎 R) :
  ghost_component n (frobenius_fun x) = ghost_component (n + 1) x :=
by simp only [ghost_component_apply, frobenius_fun, coeff_mk,
    ← bind₁_frobenius_poly_witt_polynomial, aeval_bind₁]

/--
If `R` has characteristic `p`, then there is a ring endomorphism
that raises `r : R` to the power `p`.
By applying `witt_vector.map` to this endomorphism,
we obtain a ring endomorphism `frobenius R p : 𝕎 R →+* 𝕎 R`.

The underlying function of this morphism is `witt_vector.frobenius_fun`.
-/
def frobenius : 𝕎 R →+* 𝕎 R :=
{ to_fun := frobenius_fun,
  map_zero' :=
  begin
    refine is_poly.ext
      ((frobenius_fun_is_poly p).comp (witt_vector.zero_is_poly))
      ((witt_vector.zero_is_poly).comp (frobenius_fun_is_poly p)) _ _ 0,
    ghost_simp
  end,
  map_one' :=
  begin
    refine is_poly.ext
      ((frobenius_fun_is_poly p).comp (witt_vector.one_is_poly))
      ((witt_vector.one_is_poly).comp (frobenius_fun_is_poly p)) _ _ 0,
    ghost_simp
  end,
  map_add' := by ghost_calc _ _; ghost_simp,
  map_mul' := by ghost_calc _ _; ghost_simp }

lemma coeff_frobenius (x : 𝕎 R) (n : ℕ) :
  coeff (frobenius x) n = mv_polynomial.aeval x.coeff (frobenius_poly p n) :=
coeff_frobenius_fun _ _

@[ghost_simps] lemma ghost_component_frobenius (n : ℕ) (x : 𝕎 R) :
  ghost_component n (frobenius x) = ghost_component (n + 1) x :=
ghost_component_frobenius_fun _ _

variables (p)

/-- `frobenius` is tautologically a polynomial function. -/
@[is_poly] lemma frobenius_is_poly : is_poly p (λ R _Rcr, @frobenius p R _ _Rcr) :=
frobenius_fun_is_poly _

section char_p
variables [char_p R p]

@[simp]
lemma coeff_frobenius_char_p (x : 𝕎 R) (n : ℕ) :
  coeff (frobenius x) n = (x.coeff n) ^ p :=
begin
  rw [coeff_frobenius],
  -- outline of the calculation, proofs follow below
  calc aeval (λ k, x.coeff k) (frobenius_poly p n)
      = aeval (λ k, x.coeff k)
          (mv_polynomial.map (int.cast_ring_hom (zmod p)) (frobenius_poly p n)) : _
  ... = aeval (λ k, x.coeff k) (X n ^ p : mv_polynomial ℕ (zmod p)) : _
  ... = (x.coeff n) ^ p : _,
  { conv_rhs { rw [aeval_eq_eval₂_hom, eval₂_hom_map_hom] },
    apply eval₂_hom_congr (ring_hom.ext_int _ _) rfl rfl },
  { rw frobenius_poly_zmod },
  { rw [alg_hom.map_pow, aeval_X] }
end

lemma frobenius_eq_map_frobenius :
  @frobenius p R _ _ = map (_root_.frobenius R p) :=
begin
  ext x n,
  simp only [coeff_frobenius_char_p, map_coeff, frobenius_def],
end

@[simp]
lemma frobenius_zmodp (x : 𝕎 (zmod p)) :
  (frobenius x) = x :=
by simp only [ext_iff, coeff_frobenius_char_p, zmod.pow_card, eq_self_iff_true, forall_const]

end char_p

end witt_vector


/-= Chapter 10: Type classes =-/

namespace without_typeclasses

structure Add (α : Type) where
  add : α → α → α

#check @Add.add

def double (s : Add α) (x : α) : α :=
  s.add x x

#eval double { add := Nat.add } 10
#eval double { add := Nat.mul } 10
#eval double { add := Int.add } 10

end without_typeclasses

namespace with_typeclasses

class Add (α : Type) where
  add : α → α → α

#check @Add.add

instance : Add Nat where
  add := Nat.add

instance [Add α] : Add (Array α) where
  add x y := Array.zipWith x y Add.add

#eval Add.add #[1, 2] #[3, 4]

end with_typeclasses

namespace inhabited

class Inhabited (α : Type u) where
  default : α

#check @Inhabited.default

instance : Inhabited Bool where
  default := true

instance : Inhabited Nat where
  default := 0

instance : Inhabited Unit where
  default := ()

instance : Inhabited Prop where
  default := True

#eval (Inhabited.default : Nat)
#eval (Inhabited.default : Bool)

export Inhabited (default)

#eval (default : Nat)
#eval (default : Bool)

theorem defNatEq0 : (default : Nat) = 0 := rfl

constant arbitrary [Inhabited α] : α := default

-- Fails to type check
-- theorem arbitraryNatEq0 : (arbitrary : Nat) = 0 := rfl

end inhabited

/- Chaining instances -/
namespace chaining_instances

instance [Inhabited a] [Inhabited b] : Inhabited (a × b) where
  default := (arbitrary, arbitrary)

#eval (arbitrary : Nat × Bool)

instance [Inhabited b] : Inhabited (a → b) where
  default := λ _ => arbitrary

-- Exercise
instance : Inhabited (List a) where
  default := []

instance [Inhabited a] : Inhabited (a ∨ b) where
  default := Or.inl arbitrary

instance [Inhabited b] : Inhabited (a ∨ b) where
  default := Or.inr arbitrary

#check (inferInstance : Inhabited Nat)

def foo : Inhabited (Nat × Nat) := inferInstance

theorem ex : foo.default = (arbitrary, arbitrary) := rfl

#print inferInstance

end chaining_instances

/- ToString -/
namespace to_string

structure Person where
  name : String
  age : Nat

instance : ToString Person where
  toString p := p.name ++ "@" ++ toString p.age

#eval toString { name := "Leo", age := 54 : Person }
#eval toString ({ name := "Daniel", age := 18 : Person}, "hello")

end to_string

/- Numerals -/
namespace numerals

structure Rational where
  num : Int
  den : Nat
  inv : den ≠ 0

instance : OfNat Rational n where
  ofNat := { num := n, den := 1, inv := by decide }

instance : ToString Rational where
  toString r := s!"{r.num}/{r.den}"

#eval (2 : Rational)

#check (2 : Rational)
#check (2 : Nat)

#check nat_lit 2

class Monoid (α : Type u) where
  unit : α
  op   : α → α → α

instance [s : Monoid α] : OfNat α (nat_lit 1) where
  ofNat := s.unit

def getUnit [Monoid α] : α := 1

end numerals

/- Output parameters -/
namespace output_parameters

#check_failure (inferInstance : Inhabited (Nat × _))

class HMul (α : Type u) (β : Type v) (γ : outParam (Type w)) where
  hMul : α → β → γ

export HMul (hMul)

instance : HMul Nat Nat Nat where
  hMul := Nat.mul

instance : HMul Int Int Int where
  hMul := Int.mul

instance [HMul α β γ] : HMul α (Array β) (Array γ) where
  hMul a bs := bs.map (λ b => hMul a b)

#eval hMul 4 3
#eval hMul 4 #[2, 3, 4]
#eval hMul (-2) #[3, -1, 4]
#eval hMul 2 #[#[2, 3], #[0, 4]]

end output_parameters

/- Default instances -/
namespace default_instances_failure

class HMul (α : Type u) (β : Type v) (γ : outParam (Type w)) where
  hMul : α → β → γ

export HMul (hMul)

instance : HMul Int Int Int where
  hMul := Int.mul

def xs : List Int := [1, 2, 3]

#check_failure λ y => xs.map (λ x => hMul x y)

end default_instances_failure

namespace default_instances_success

class HMul (α : Type u) (β : Type v) (γ : outParam (Type w)) where
  hMul : α → β → γ

export HMul (hMul)

@[defaultInstance]
instance : HMul Int Int Int where
  hMul := Int.mul

def xs : List Int := [1, 2, 3]

#check λ y => xs.map (λ x => hMul x y)

end default_instances_success

namespace default_instance_override

structure Rational where
  num : Int
  den : Nat
  inv : den ≠ 0

@[defaultInstance]
instance : OfNat Rational n where
  ofNat := { num := n, den := 1, inv := by decide }

instance : ToString Rational where
  toString r := s!"{r.num}/{r.den}"

#check 2

end default_instance_override

/- Local instances -/
namespace local_instances

end local_instances


theorem haveWithSubgoals {a b : α} : a = b ↔ b = a := by
    apply Iff.intro
    intro h
    have h' := h.symm
    exact h'
    intro h
    exact h.symm

theorem haveWithSubgoals2 {a b : α} : a = b ↔ b = a := by {
    apply Iff.intro;
    intro h;
    have h' := h.symm;
    exact h';
    intro h; exact h.symm;
}


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.finite_products
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.category_theory.limits.preserves.shapes.products
import Mathlib.category_theory.limits.preserves.shapes.binary_products
import Mathlib.category_theory.limits.shapes.pullbacks
import Mathlib.category_theory.pempty
import Mathlib.data.equiv.fin
import Mathlib.PostPort

universes v u u'

namespace Mathlib

/-!
# Constructing finite products from binary products and terminal.

If a category has binary products and a terminal object then it has finite products.
If a functor preserves binary products and the terminal object then it preserves finite products.

# TODO

Provide the dual results.
Show the analogous results for functors which reflect or create (co)limits.
-/

namespace category_theory

/--
Given `n+1` objects of `C`, a fan for the last `n` with point `c₁.X` and a binary fan on `c₁.X` and
`f 0`, we can build a fan for all `n+1`.

In `extend_fan_is_limit` we show that if the two given fans are limits, then this fan is also a
limit.
-/
@[simp] theorem extend_fan_X {C : Type u} [category C] {n : ℕ} {f : ulift (fin (n + 1)) → C}
    (c₁ : limits.fan fun (i : ulift (fin n)) => f (ulift.up (fin.succ (ulift.down i))))
    (c₂ : limits.binary_fan (f (ulift.up 0)) (limits.cone.X c₁)) :
    limits.cone.X (extend_fan c₁ c₂) = limits.cone.X c₂ :=
  Eq.refl (limits.cone.X (extend_fan c₁ c₂))

/--
Show that if the two given fans in `extend_fan` are limits, then the constructed fan is also a
limit.
-/
def extend_fan_is_limit {C : Type u} [category C] {n : ℕ} (f : ulift (fin (n + 1)) → C)
    {c₁ : limits.fan fun (i : ulift (fin n)) => f (ulift.up (fin.succ (ulift.down i)))}
    {c₂ : limits.binary_fan (f (ulift.up 0)) (limits.cone.X c₁)} (t₁ : limits.is_limit c₁)
    (t₂ : limits.is_limit c₂) : limits.is_limit (extend_fan c₁ c₂) :=
  limits.is_limit.mk
    fun (s : limits.cone (discrete.functor f)) =>
      subtype.val
        (limits.binary_fan.is_limit.lift' t₂ (nat_trans.app (limits.cone.π s) (ulift.up 0))
          (limits.is_limit.lift t₁
            (limits.cone.mk (limits.cone.X s)
              (discrete.nat_trans
                fun (i : discrete (ulift (fin n))) =>
                  nat_trans.app (limits.cone.π s) (ulift.up (fin.succ (ulift.down i)))))))

/--
If `C` has a terminal object and binary products, then it has a product for objects indexed by
`ulift (fin n)`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
/--
If `C` has a terminal object and binary products, then it has limits of shape
`discrete (ulift (fin n))` for any `n : ℕ`.
This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general
than this.
-/
/-- If `C` has a terminal object and binary products, then it has finite products. -/
theorem has_finite_products_of_has_binary_and_terminal {C : Type u} [category C]
    [limits.has_binary_products C] [limits.has_terminal C] : limits.has_finite_products C :=
  sorry

/--
If `F` preserves the terminal object and binary products, then it preserves products indexed by
`ulift (fin n)` for any `n`.
-/
def preserves_fin_of_preserves_binary_and_terminal {C : Type u} [category C] {D : Type u'}
    [category D] (F : C ⥤ D) [limits.preserves_limits_of_shape (discrete limits.walking_pair) F]
    [limits.preserves_limits_of_shape (discrete pempty) F] [limits.has_finite_products C] (n : ℕ)
    (f : ulift (fin n) → C) : limits.preserves_limit (discrete.functor f) F :=
  sorry

/--
If `F` preserves the terminal object and binary products, then it preserves limits of shape
`discrete (ulift (fin n))`.
-/
def preserves_ulift_fin_of_preserves_binary_and_terminal {C : Type u} [category C] {D : Type u'}
    [category D] (F : C ⥤ D) [limits.preserves_limits_of_shape (discrete limits.walking_pair) F]
    [limits.preserves_limits_of_shape (discrete pempty) F] [limits.has_finite_products C] (n : ℕ) :
    limits.preserves_limits_of_shape (discrete (ulift (fin n))) F :=
  limits.preserves_limits_of_shape.mk
    fun (K : discrete (ulift (fin n)) ⥤ C) =>
      let this : discrete.functor (functor.obj K) ≅ K :=
        discrete.nat_iso
          fun (i : discrete (discrete (ulift (fin n)))) =>
            iso.refl (functor.obj (discrete.functor (functor.obj K)) i);
      limits.preserves_limit_of_iso_diagram F this

/-- If `F` preserves the terminal object and binary products then it preserves finite products. -/
def preserves_finite_products_of_preserves_binary_and_terminal {C : Type u} [category C]
    {D : Type u'} [category D] (F : C ⥤ D)
    [limits.preserves_limits_of_shape (discrete limits.walking_pair) F]
    [limits.preserves_limits_of_shape (discrete pempty) F] [limits.has_finite_products C]
    (J : Type v) [fintype J] : limits.preserves_limits_of_shape (discrete J) F :=
  trunc.rec_on_subsingleton (fintype.equiv_fin J)
    fun (e : J ≃ fin (fintype.card J)) =>
      limits.preserves_limits_of_shape_of_equiv
        (equivalence.symm (discrete.equivalence (equiv.trans e (equiv.symm equiv.ulift)))) F

end Mathlib