/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.limits
import Mathlib.category_theory.products.basic
import Mathlib.category_theory.currying
import Mathlib.PostPort

universes v u l

namespace Mathlib

/-!
# A Fubini theorem for categorical limits

We prove that $lim_{J × K} G = lim_J (lim_K G(j, -))$ for a functor `G : J × K ⥤ C`,
when all the appropriate limits exist.

We begin working with a functor `F : J ⥤ K ⥤ C`. We'll write `G : J × K ⥤ C` for the associated
"uncurried" functor.

In the first part, given a coherent family `D` of limit cones over the functors `F.obj j`,
and a cone `c` over `G`, we construct a cone over the cone points of `D`.
We then show that if `c` is a limit cone, the constructed cone is also a limit cone.

In the second part, we state the Fubini theorem in the setting where limits are
provided by suitable `has_limit` classes.

We construct
`limit_uncurry_iso_limit_comp_lim F : limit (uncurry.obj F) ≅ limit (F ⋙ lim)`
and give simp lemmas characterising it.
For convenience, we also provide
`limit_iso_limit_curry_comp_lim G : limit G ≅ limit ((curry.obj G) ⋙ lim)`
in terms of the uncurried functor.

## Future work

The dual statement.
-/

namespace category_theory.limits

/--
A structure carrying a diagram of cones over the the functors `F.obj j`.
-/
-- We could try introducing a "dependent functor type" to handle this?

structure diagram_of_cones {J : Type v} {K : Type v} [small_category J] [small_category K]
    {C : Type u} [category C] (F : J ⥤ K ⥤ C)
    where
  obj : (j : J) → cone (functor.obj F j)
  map :
    {j j' : J} → (f : j ⟶ j') → functor.obj (cones.postcompose (functor.map F f)) (obj j) ⟶ obj j'
  id :
    autoParam (J → cone_morphism.hom (map 𝟙) = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  comp :
    autoParam
      (∀ {j₁ j₂ j₃ : J} (f : j₁ ⟶ j₂) (g : j₂ ⟶ j₃),
        cone_morphism.hom (map (f ≫ g)) = cone_morphism.hom (map f) ≫ cone_morphism.hom (map g))
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

/--
Extract the functor `J ⥤ C` consisting of the cone points and the maps between them,
from a `diagram_of_cones`.
-/
@[simp] theorem diagram_of_cones.cone_points_obj {J : Type v} {K : Type v} [small_category J]
    [small_category K] {C : Type u} [category C] {F : J ⥤ K ⥤ C} (D : diagram_of_cones F) (j : J) :
    functor.obj (diagram_of_cones.cone_points D) j = cone.X (diagram_of_cones.obj D j) :=
  Eq.refl (functor.obj (diagram_of_cones.cone_points D) j)

/--
Given a diagram `D` of limit cones over the `F.obj j`, and a cone over `uncurry.obj F`,
we can construct a cone over the diagram consisting of the cone points from `D`.
-/
def cone_of_cone_uncurry {J : Type v} {K : Type v} [small_category J] [small_category K]
    {C : Type u} [category C] {F : J ⥤ K ⥤ C} {D : diagram_of_cones F}
    (Q : (j : J) → is_limit (diagram_of_cones.obj D j)) (c : cone (functor.obj uncurry F)) :
    cone (diagram_of_cones.cone_points D) :=
  cone.mk (cone.X c)
    (nat_trans.mk
      fun (j : J) =>
        is_limit.lift (Q j)
          (cone.mk (cone.X c) (nat_trans.mk fun (k : K) => nat_trans.app (cone.π c) (j, k))))

/--
`cone_of_cone_uncurry Q c` is a limit cone when `c` is a limit cone.`
-/
def cone_of_cone_uncurry_is_limit {J : Type v} {K : Type v} [small_category J] [small_category K]
    {C : Type u} [category C] {F : J ⥤ K ⥤ C} {D : diagram_of_cones F}
    (Q : (j : J) → is_limit (diagram_of_cones.obj D j)) {c : cone (functor.obj uncurry F)}
    (P : is_limit c) : is_limit (cone_of_cone_uncurry Q c) :=
  is_limit.mk
    fun (s : cone (diagram_of_cones.cone_points D)) =>
      is_limit.lift P
        (cone.mk (cone.X s)
          (nat_trans.mk
            fun (p : J × K) =>
              nat_trans.app (cone.π s) (prod.fst p) ≫
                nat_trans.app (cone.π (diagram_of_cones.obj D (prod.fst p))) (prod.snd p)))

/--
Given a functor `F : J ⥤ K ⥤ C`, with all needed limits,
we can construct a diagram consisting of the limit cone over each functor `F.obj j`,
and the universal cone morphisms between these.
-/
def diagram_of_cones.mk_of_has_limits {J : Type v} {K : Type v} [small_category J]
    [small_category K] {C : Type u} [category C] (F : J ⥤ K ⥤ C) [has_limits_of_shape K C] :
    diagram_of_cones F :=
  diagram_of_cones.mk (fun (j : J) => limit.cone (functor.obj F j))
    fun (j j' : J) (f : j ⟶ j') => cone_morphism.mk (functor.map lim (functor.map F f))

-- Satisfying the inhabited linter.

protected instance diagram_of_cones_inhabited {J : Type v} {K : Type v} [small_category J]
    [small_category K] {C : Type u} [category C] (F : J ⥤ K ⥤ C) [has_limits_of_shape K C] :
    Inhabited (diagram_of_cones F) :=
  { default := diagram_of_cones.mk_of_has_limits F }

@[simp] theorem diagram_of_cones.mk_of_has_limits_cone_points {J : Type v} {K : Type v}
    [small_category J] [small_category K] {C : Type u} [category C] (F : J ⥤ K ⥤ C)
    [has_limits_of_shape K C] :
    diagram_of_cones.cone_points (diagram_of_cones.mk_of_has_limits F) = F ⋙ lim :=
  rfl

/--
The Fubini theorem for a functor `F : J ⥤ K ⥤ C`,
showing that the limit of `uncurry.obj F` can be computed as
the limit of the limits of the functors `F.obj j`.
-/
def limit_uncurry_iso_limit_comp_lim {J : Type v} {K : Type v} [small_category J] [small_category K]
    {C : Type u} [category C] (F : J ⥤ K ⥤ C) [has_limits_of_shape K C]
    [has_limit (functor.obj uncurry F)] [has_limit (F ⋙ lim)] :
    limit (functor.obj uncurry F) ≅ limit (F ⋙ lim) :=
  let c : cone (functor.obj uncurry F) := limit.cone (functor.obj uncurry F);
  let P : is_limit c := limit.is_limit (functor.obj uncurry F);
  let G : diagram_of_cones F := diagram_of_cones.mk_of_has_limits F;
  let Q : (j : J) → is_limit (diagram_of_cones.obj G j) :=
    fun (j : J) => limit.is_limit (functor.obj F j);
  is_limit.cone_point_unique_up_to_iso (cone_of_cone_uncurry_is_limit Q P)
    (limit.is_limit (F ⋙ lim))

@[simp] theorem limit_uncurry_iso_limit_comp_lim_hom_π_π {J : Type v} {K : Type v}
    [small_category J] [small_category K] {C : Type u} [category C] (F : J ⥤ K ⥤ C)
    [has_limits_of_shape K C] [has_limit (functor.obj uncurry F)] [has_limit (F ⋙ lim)] {j : J}
    {k : K} :
    iso.hom (limit_uncurry_iso_limit_comp_lim F) ≫
          limit.π (F ⋙ lim) j ≫ limit.π (functor.obj F j) k =
        limit.π (functor.obj uncurry F) (j, k) :=
  sorry

@[simp] theorem limit_uncurry_iso_limit_comp_lim_inv_π {J : Type v} {K : Type v} [small_category J]
    [small_category K] {C : Type u} [category C] (F : J ⥤ K ⥤ C) [has_limits_of_shape K C]
    [has_limit (functor.obj uncurry F)] [has_limit (F ⋙ lim)] {j : J} {k : K} :
    iso.inv (limit_uncurry_iso_limit_comp_lim F) ≫ limit.π (functor.obj uncurry F) (j, k) =
        limit.π (F ⋙ lim) j ≫ limit.π (functor.obj F j) k :=
  sorry

/--
The Fubini theorem for a functor `G : J × K ⥤ C`,
showing that the limit of `G` can be computed as
the limit of the limits of the functors `G.obj (j, _)`.
-/
def limit_iso_limit_curry_comp_lim {J : Type v} {K : Type v} [small_category J] [small_category K]
    {C : Type u} [category C] (G : J × K ⥤ C) [has_limits_of_shape K C] [has_limit G]
    [has_limit (functor.obj curry G ⋙ lim)] : limit G ≅ limit (functor.obj curry G ⋙ lim) :=
  has_limit.iso_of_nat_iso (iso.app (equivalence.unit_iso (equivalence.symm currying)) G) ≪≫
    limit_uncurry_iso_limit_comp_lim (functor.obj curry G)

@[simp] theorem limit_iso_limit_curry_comp_lim_hom_π_π {J : Type v} {K : Type v} [small_category J]
    [small_category K] {C : Type u} [category C] (G : J × K ⥤ C) [has_limits_of_shape K C]
    [has_limit G] [has_limit (functor.obj curry G ⋙ lim)] {j : J} {k : K} :
    iso.hom (limit_iso_limit_curry_comp_lim G) ≫
          limit.π (functor.obj curry G ⋙ lim) j ≫ limit.π (functor.obj (functor.obj curry G) j) k =
        limit.π G (j, k) :=
  sorry

@[simp] theorem limit_iso_limit_curry_comp_lim_inv_π {J : Type v} {K : Type v} [small_category J]
    [small_category K] {C : Type u} [category C] (G : J × K ⥤ C) [has_limits_of_shape K C]
    [has_limit G] [has_limit (functor.obj curry G ⋙ lim)] {j : J} {k : K} :
    iso.inv (limit_iso_limit_curry_comp_lim G) ≫ limit.π G (j, k) =
        limit.π (functor.obj curry G ⋙ lim) j ≫ limit.π (functor.obj (functor.obj curry G) j) k :=
  sorry

/--
A variant of the Fubini theorem for a functor `G : J × K ⥤ C`,
showing that $\lim_k \lim_j G(j,k) ≅ \lim_j \lim_k G(j,k)$.
-/
def limit_curry_swap_comp_lim_iso_limit_curry_comp_lim {J : Type v} {K : Type v} [small_category J]
    [small_category K] {C : Type u} [category C] (G : J × K ⥤ C) [has_limits C] :
    limit (functor.obj curry (prod.swap K J ⋙ G) ⋙ lim) ≅ limit (functor.obj curry G ⋙ lim) :=
  (iso.symm (limit_iso_limit_curry_comp_lim (prod.swap K J ⋙ G)) ≪≫
      has_limit.iso_of_equivalence (prod.braiding K J)
        (iso.refl (equivalence.functor (prod.braiding K J) ⋙ G))) ≪≫
    limit_iso_limit_curry_comp_lim G

@[simp] theorem limit_curry_swap_comp_lim_iso_limit_curry_comp_lim_hom_π_π {J : Type v} {K : Type v}
    [small_category J] [small_category K] {C : Type u} [category C] (G : J × K ⥤ C) [has_limits C]
    {j : J} {k : K} :
    iso.hom (limit_curry_swap_comp_lim_iso_limit_curry_comp_lim G) ≫
          limit.π (functor.obj curry G ⋙ lim) j ≫ limit.π (functor.obj (functor.obj curry G) j) k =
        limit.π (functor.obj curry (prod.swap K J ⋙ G) ⋙ lim) k ≫
          limit.π (functor.obj (functor.obj curry (prod.swap K J ⋙ G)) k) j :=
  sorry

@[simp] theorem limit_curry_swap_comp_lim_iso_limit_curry_comp_lim_inv_π_π {J : Type v} {K : Type v}
    [small_category J] [small_category K] {C : Type u} [category C] (G : J × K ⥤ C) [has_limits C]
    {j : J} {k : K} :
    iso.inv (limit_curry_swap_comp_lim_iso_limit_curry_comp_lim G) ≫
          limit.π (functor.obj curry (prod.swap K J ⋙ G) ⋙ lim) k ≫
            limit.π (functor.obj (functor.obj curry (prod.swap K J ⋙ G)) k) j =
        limit.π (functor.obj curry G ⋙ lim) j ≫ limit.π (functor.obj (functor.obj curry G) j) k :=
  sorry

end Mathlib


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import measure_theory.measure_space

/-!
# Typeclasses for measurability of operations

In this file we define classes `has_measurable_mul` etc and prove dot-style lemmas
(`measurable.mul`, `ae_measurable.mul` etc). For binary operations we define two typeclasses:

- `has_measurable_mul` says that both left and right multiplication are measurable;
- `has_measurable_mul₂` says that `λ p : α × α, p.1 * p.2` is measurable,

and similarly for other binary operations. The reason for introducing these classes is that in case
of topological space `α` equipped with the Borel `σ`-algebra, instances for `has_measurable_mul₂`
etc require `α` to have a second countable topology.

We define separate classes for `has_measurable_div`/`has_measurable_sub`
because on some types (e.g., `ℕ`, `ℝ≥0∞`) division and/or subtraction are not defined as `a * b⁻¹` /
`a + (-b)`.

For instances relating, e.g., `has_continuous_mul` to `has_measurable_mul` see file
`measure_theory.borel_space`.

## Tags

measurable function, arithmetic operator
-/

universes u v

open_locale big_operators
open measure_theory

variables {α : Type*} [measurable_space α]

/-!
### Binary operations: `(+)`, `(*)`, `(-)`, `(/)`
-/

/-- We say that a type `has_measurable_add` if `((+) c)` and `(+ c)` are measurable functions.
For a typeclass assuming measurability of `uncurry (+)` see `has_measurable_add₂`. -/
class has_measurable_add (M : Type*) [measurable_space M] [has_add M] : Prop :=
(measurable_const_add : ∀ c : M, measurable ((+) c))
(measurable_add_const : ∀ c : M, measurable (+ c))

/-- We say that a type `has_measurable_add` if `uncurry (+)` is a measurable functions.
For a typeclass assuming measurability of `((+) c)` and `(+ c)` see `has_measurable_add`. -/
class has_measurable_add₂ (M : Type*) [measurable_space M] [has_add M] : Prop :=
(measurable_add : measurable (λ p : M × M, p.1 + p.2))

export has_measurable_add₂ (measurable_add)
  has_measurable_add (measurable_const_add measurable_add_const)

/-- We say that a type `has_measurable_mul` if `((*) c)` and `(* c)` are measurable functions.
For a typeclass assuming measurability of `uncurry (*)` see `has_measurable_mul₂`. -/
@[to_additive]
class has_measurable_mul (M : Type*) [measurable_space M] [has_mul M] : Prop :=
(measurable_const_mul : ∀ c : M, measurable ((*) c))
(measurable_mul_const : ∀ c : M, measurable (* c))

/-- We say that a type `has_measurable_mul` if `uncurry (*)` is a measurable functions.
For a typeclass assuming measurability of `((*) c)` and `(* c)` see `has_measurable_mul`. -/
@[to_additive has_measurable_add₂]
class has_measurable_mul₂ (M : Type*) [measurable_space M] [has_mul M] : Prop :=
(measurable_mul : measurable (λ p : M × M, p.1 * p.2))

export has_measurable_mul₂ (measurable_mul)
  has_measurable_mul (measurable_const_mul measurable_mul_const)

section mul

variables {M : Type*} [measurable_space M] [has_mul M]

@[to_additive]
lemma measurable.mul [has_measurable_mul₂ M] {f g : α → M} (hf : measurable f) (hg : measurable g) :
  measurable (λ a, f a * g a) :=
measurable_mul.comp (hf.prod_mk hg)

@[to_additive]
lemma ae_measurable.mul [has_measurable_mul₂ M] {μ : measure α} {f g : α → M}
  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ a, f a * g a) μ :=
measurable_mul.comp_ae_measurable (hf.prod_mk hg)

@[priority 100, to_additive]
instance has_measurable_mul₂.to_has_measurable_mul [has_measurable_mul₂ M] :
  has_measurable_mul M :=
⟨λ c, measurable_const.mul measurable_id, λ c, measurable_id.mul measurable_const⟩

@[to_additive]
lemma measurable.const_mul [has_measurable_mul M] {f : α → M} (hf : measurable f) (c : M) :
  measurable (λ x, c * f x) :=
(measurable_const_mul c).comp hf

@[to_additive]
lemma ae_measurable.const_mul [has_measurable_mul M] {f : α → M} {μ : measure α}
  (hf : ae_measurable f μ) (c : M) :
  ae_measurable (λ x, c * f x) μ :=
(has_measurable_mul.measurable_const_mul c).comp_ae_measurable hf

@[to_additive]
lemma measurable.mul_const [has_measurable_mul M] {f : α → M} (hf : measurable f) (c : M) :
  measurable (λ x, f x * c) :=
(measurable_mul_const c).comp hf

@[to_additive]
lemma ae_measurable.mul_const [has_measurable_mul M] {f : α → M} {μ : measure α}
  (hf : ae_measurable f μ) (c : M) :
  ae_measurable (λ x, f x * c) μ :=
(measurable_mul_const c).comp_ae_measurable hf

end mul

/-- This class assumes that the map `β × γ → β` given by `(x, y) ↦ x ^ y` is measurable. -/
class has_measurable_pow (β γ : Type*) [measurable_space β] [measurable_space γ] [has_pow β γ] :=
(measurable_pow : measurable (λ p : β × γ, p.1 ^ p.2))

export has_measurable_pow (measurable_pow)

instance has_measurable_mul.has_measurable_pow (M : Type*) [monoid M] [measurable_space M]
  [has_measurable_mul₂ M] : has_measurable_pow M ℕ :=
⟨begin
  haveI : measurable_singleton_class ℕ := ⟨λ _, trivial⟩,
  refine measurable_from_prod_encodable (λ n, _),
  induction n with n ih,
  { simp [pow_zero, measurable_one] },
  { simp only [pow_succ], exact measurable_id.mul ih }
end⟩

section pow

variables {β γ : Type*} [measurable_space β] [measurable_space γ] [has_pow β γ]
  [has_measurable_pow β γ]

lemma measurable.pow {f : α → β} {g : α → γ} (hf : measurable f) (hg : measurable g) :
  measurable (λ x, f x ^ g x) :=
measurable_pow.comp (hf.prod_mk hg)

lemma ae_measurable.pow {μ : measure α} {f : α → β} {g : α → γ} (hf : ae_measurable f μ)
  (hg : ae_measurable g μ) :
  ae_measurable (λ x, f x ^ g x) μ :=
measurable_pow.comp_ae_measurable (hf.prod_mk hg)

lemma measurable.pow_const {f : α → β} (hf : measurable f) (c : γ) :
  measurable (λ x, f x ^ c) :=
hf.pow measurable_const

lemma ae_measurable.pow_const {μ : measure α} {f : α → β} (hf : ae_measurable f μ) (c : γ) :
  ae_measurable (λ x, f x ^ c) μ :=
hf.pow ae_measurable_const

lemma measurable.const_pow {f : α → γ} (hf : measurable f) (c : β) :
  measurable (λ x, c ^ f x) :=
measurable_const.pow hf

lemma ae_measurable.const_pow {μ : measure α} {f : α → γ} (hf : ae_measurable f μ) (c : β) :
  ae_measurable (λ x, c ^ f x) μ :=
ae_measurable_const.pow hf

end pow

/-- We say that a type `has_measurable_sub` if `(λ x, c - x)` and `(λ x, x - c)` are measurable
functions. For a typeclass assuming measurability of `uncurry (-)` see `has_measurable_sub₂`. -/
class has_measurable_sub (G : Type*) [measurable_space G] [has_sub G] : Prop :=
(measurable_const_sub : ∀ c : G, measurable (λ x, c - x))
(measurable_sub_const : ∀ c : G, measurable (λ x, x - c))

/-- We say that a type `has_measurable_sub` if `uncurry (-)` is a measurable functions.
For a typeclass assuming measurability of `((-) c)` and `(- c)` see `has_measurable_sub`. -/
class has_measurable_sub₂ (G : Type*) [measurable_space G] [has_sub G] : Prop :=
(measurable_sub : measurable (λ p : G × G, p.1 - p.2))

export has_measurable_sub₂ (measurable_sub)

/-- We say that a type `has_measurable_div` if `((/) c)` and `(/ c)` are measurable functions.
For a typeclass assuming measurability of `uncurry (/)` see `has_measurable_div₂`. -/
@[to_additive] class has_measurable_div (G₀: Type*) [measurable_space G₀] [has_div G₀] : Prop :=
(measurable_const_div : ∀ c : G₀, measurable ((/) c))
(measurable_div_const : ∀ c : G₀, measurable (/ c))

/-- We say that a type `has_measurable_div` if `uncurry (/)` is a measurable functions.
For a typeclass assuming measurability of `((/) c)` and `(/ c)` see `has_measurable_div`. -/
@[to_additive has_measurable_sub₂]
class has_measurable_div₂ (G₀: Type*) [measurable_space G₀] [has_div G₀] : Prop :=
(measurable_div : measurable (λ p : G₀× G₀, p.1 / p.2))

export has_measurable_div₂ (measurable_div)

section div

variables {G : Type*} [measurable_space G] [has_div G]

@[to_additive]
lemma measurable.div [has_measurable_div₂ G] {f g : α → G} (hf : measurable f) (hg : measurable g) :
  measurable (λ a, f a / g a) :=
measurable_div.comp (hf.prod_mk hg)

@[to_additive]
lemma ae_measurable.div [has_measurable_div₂ G] {f g : α → G} {μ : measure α}
  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ a, f a / g a) μ :=
measurable_div.comp_ae_measurable (hf.prod_mk hg)

@[priority 100, to_additive]
instance has_measurable_div₂.to_has_measurable_div [has_measurable_div₂ G] :
  has_measurable_div G :=
⟨λ c, measurable_const.div measurable_id, λ c, measurable_id.div measurable_const⟩

@[to_additive]
lemma measurable.const_div [has_measurable_div G] {f : α → G} (hf : measurable f) (c : G) :
  measurable (λ x, c / f x) :=
(has_measurable_div.measurable_const_div c).comp hf

@[to_additive]
lemma ae_measurable.const_div [has_measurable_div G] {f : α → G} {μ : measure α}
  (hf : ae_measurable f μ) (c : G) :
  ae_measurable (λ x, c / f x) μ :=
(has_measurable_div.measurable_const_div c).comp_ae_measurable hf

@[to_additive]
lemma measurable.div_const [has_measurable_div G] {f : α → G} (hf : measurable f) (c : G) :
  measurable (λ x, f x / c) :=
(has_measurable_div.measurable_div_const c).comp hf

@[to_additive]
lemma ae_measurable.div_const [has_measurable_div G] {f : α → G} {μ : measure α}
  (hf : ae_measurable f μ) (c : G) :
  ae_measurable (λ x, f x / c) μ :=
(has_measurable_div.measurable_div_const c).comp_ae_measurable hf

end div

/-- We say that a type `has_measurable_neg` if `x ↦ -x` is a measurable function. -/
class has_measurable_neg (G : Type*) [has_neg G] [measurable_space G] : Prop :=
(measurable_neg : measurable (has_neg.neg : G → G))

/-- We say that a type `has_measurable_inv` if `x ↦ x⁻¹` is a measurable function. -/
@[to_additive]
class has_measurable_inv (G : Type*) [has_inv G] [measurable_space G] : Prop :=
(measurable_inv : measurable (has_inv.inv : G → G))

export has_measurable_inv (measurable_inv) has_measurable_neg (measurable_neg)

@[priority 100, to_additive]
instance has_measurable_div_of_mul_inv (G : Type*) [measurable_space G]
  [div_inv_monoid G] [has_measurable_mul G] [has_measurable_inv G] :
  has_measurable_div G :=
{ measurable_const_div := λ c,
    by { convert (measurable_inv.const_mul c), ext1, apply div_eq_mul_inv },
  measurable_div_const := λ c,
    by { convert (measurable_id.mul_const c⁻¹), ext1, apply div_eq_mul_inv } }

section inv

variables {G : Type*} [has_inv G] [measurable_space G] [has_measurable_inv G]

@[to_additive] lemma measurable.inv {f : α → G} (hf : measurable f) :
  measurable (λ x, (f x)⁻¹) :=
measurable_inv.comp hf

@[to_additive] lemma ae_measurable.inv {f : α → G} {μ : measure α} (hf : ae_measurable f μ) :
  ae_measurable (λ x, (f x)⁻¹) μ :=
measurable_inv.comp_ae_measurable hf

@[simp, to_additive] lemma measurable_inv_iff {G : Type*} [group G] [measurable_space G]
  [has_measurable_inv G] {f : α → G} : measurable (λ x, (f x)⁻¹) ↔ measurable f :=
⟨λ h, by simpa only [inv_inv] using h.inv, λ h, h.inv⟩

@[simp, to_additive] lemma ae_measurable_inv_iff {G : Type*} [group G] [measurable_space G]
  [has_measurable_inv G] {f : α → G} {μ : measure α} :
  ae_measurable (λ x, (f x)⁻¹) μ ↔ ae_measurable f μ :=
⟨λ h, by simpa only [inv_inv] using h.inv, λ h, h.inv⟩

@[simp] lemma measurable_inv_iff' {G₀ : Type*} [group_with_zero G₀]
  [measurable_space G₀] [has_measurable_inv G₀] {f : α → G₀} :
  measurable (λ x, (f x)⁻¹) ↔ measurable f :=
⟨λ h, by simpa only [inv_inv'] using h.inv, λ h, h.inv⟩

@[simp] lemma ae_measurable_inv_iff' {G₀ : Type*} [group_with_zero G₀]
  [measurable_space G₀] [has_measurable_inv G₀] {f : α → G₀} {μ : measure α} :
  ae_measurable (λ x, (f x)⁻¹) μ ↔ ae_measurable f μ :=
⟨λ h, by simpa only [inv_inv'] using h.inv, λ h, h.inv⟩

end inv

/- There is something extremely strange here: copy-pasting the proof of this lemma in the proof
of `has_measurable_gpow` fails, while `pp.all` does not show any difference in the goal.
Keep it as a separate lemmas as a workaround. -/
private lemma has_measurable_gpow_aux (G : Type u) [div_inv_monoid G] [measurable_space G]
  [has_measurable_mul₂ G] [has_measurable_inv G] (k : ℕ) :
  measurable (λ (x : G), x ^(-[1+ k])) :=
begin
  simp_rw [gpow_neg_succ_of_nat],
  exact (measurable_id.pow_const (k + 1)).inv
end

instance has_measurable_gpow (G : Type u) [div_inv_monoid G] [measurable_space G]
  [has_measurable_mul₂ G] [has_measurable_inv G] :
  has_measurable_pow G ℤ :=
begin
  letI : measurable_singleton_class ℤ := ⟨λ _, trivial⟩,
  constructor,
  refine measurable_from_prod_encodable (λ n, _),
  dsimp,
  apply int.cases_on n,
  { simpa using measurable_id.pow_const },
  { exact has_measurable_gpow_aux G }
end

@[priority 100, to_additive]
instance has_measurable_div₂_of_mul_inv (G : Type*) [measurable_space G]
  [div_inv_monoid G] [has_measurable_mul₂ G] [has_measurable_inv G] :
  has_measurable_div₂ G :=
⟨by { simp only [div_eq_mul_inv], exact measurable_fst.mul measurable_snd.inv }⟩

/-- We say that the action of `M` on `α` `has_measurable_smul` if for each `c` the map `x ↦ c • x`
is a measurable function and for each `x` the map `c ↦ c • x` is a measurable function. -/
class has_measurable_smul (M α : Type*) [has_scalar M α] [measurable_space M] [measurable_space α] :
  Prop :=
(measurable_const_smul : ∀ c : M, measurable ((•) c : α → α))
(measurable_smul_const : ∀ x : α, measurable (λ c : M, c • x))

/-- We say that the action of `M` on `α` `has_measurable_smul` if the map
`(c, x) ↦ c • x` is a measurable function. -/
class has_measurable_smul₂ (M α : Type*) [has_scalar M α] [measurable_space M]
  [measurable_space α] : Prop :=
(measurable_smul : measurable (function.uncurry (•) : M × α → α))

export has_measurable_smul (measurable_const_smul measurable_smul_const)
  has_measurable_smul₂ (measurable_smul)

instance has_measurable_smul_of_mul (M : Type*) [monoid M] [measurable_space M]
  [has_measurable_mul M] :
  has_measurable_smul M M :=
⟨measurable_id.const_mul, measurable_id.mul_const⟩

instance has_measurable_smul₂_of_mul (M : Type*) [monoid M] [measurable_space M]
  [has_measurable_mul₂ M] :
  has_measurable_smul₂ M M :=
⟨measurable_mul⟩

section smul

variables {M β : Type*} [measurable_space M] [measurable_space β] [has_scalar M β]

lemma measurable.smul [has_measurable_smul₂ M β]
  {f : α → M} {g : α → β} (hf : measurable f) (hg : measurable g) :
  measurable (λ x, f x • g x) :=
measurable_smul.comp (hf.prod_mk hg)

lemma ae_measurable.smul [has_measurable_smul₂ M β]
  {f : α → M} {g : α → β} {μ : measure α} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
  ae_measurable (λ x, f x • g x) μ :=
has_measurable_smul₂.measurable_smul.comp_ae_measurable (hf.prod_mk hg)

@[priority 100]
instance has_measurable_smul₂.to_has_measurable_smul [has_measurable_smul₂ M β] :
  has_measurable_smul M β :=
⟨λ c, measurable_const.smul measurable_id, λ y, measurable_id.smul measurable_const⟩

variables [has_measurable_smul M β] {μ : measure α}

lemma measurable.smul_const {f : α → M} (hf : measurable f) (y : β) : measurable (λ x, f x • y) :=
(has_measurable_smul.measurable_smul_const y).comp hf

lemma ae_measurable.smul_const {f : α → M} (hf : ae_measurable f μ) (y : β) :
  ae_measurable (λ x, f x • y) μ :=
(has_measurable_smul.measurable_smul_const y).comp_ae_measurable hf

lemma measurable.const_smul' {f : α → β} (hf : measurable f) (c : M) :
  measurable (λ x, c • f x) :=
(has_measurable_smul.measurable_const_smul c).comp hf

lemma measurable.const_smul {f : α → β} (hf : measurable f) (c : M) :
  measurable (c • f) :=
hf.const_smul' c

lemma ae_measurable.const_smul' {f : α → β} (hf : ae_measurable f μ) (c : M) :
  ae_measurable (λ x, c • f x) μ :=
(has_measurable_smul.measurable_const_smul c).comp_ae_measurable hf

lemma ae_measurable.const_smul {f : α → β} (hf : ae_measurable f μ) (c : M) :
  ae_measurable (c • f) μ :=
hf.const_smul' c

end smul

section mul_action

variables {M β : Type*} [measurable_space M] [measurable_space β] [monoid M] [mul_action M β]
  [has_measurable_smul M β] {f : α → β} {μ : measure α}

@[simp] lemma units.measurable_const_smul_iff (u : units M) :
  measurable (λ x, (u : M) • f x) ↔ measurable f :=
⟨λ h, by simpa only [u.inv_smul_smul] using h.const_smul' ((u⁻¹ : units M) : M),
  λ h, h.const_smul ↑u⟩

@[simp] lemma units.ae_measurable_const_smul_iff (u : units M) :
  ae_measurable (λ x, (u : M) • f x) μ ↔ ae_measurable f μ :=
⟨λ h, by simpa only [u.inv_smul_smul] using h.const_smul' ((u⁻¹ : units M) : M),
  λ h, h.const_smul ↑u⟩

lemma is_unit.measurable_const_smul_iff {c : M} (hc : is_unit c) :
  measurable (λ x, c • f x) ↔ measurable f :=
let ⟨u, hu⟩ := hc in hu ▸ u.measurable_const_smul_iff

lemma is_unit.ae_measurable_const_smul_iff {c : M} (hc : is_unit c) :
  ae_measurable (λ x, c • f x) μ ↔ ae_measurable f μ :=
let ⟨u, hu⟩ := hc in hu ▸ u.ae_measurable_const_smul_iff

variables {G₀ : Type*} [group_with_zero G₀] [measurable_space G₀] [mul_action G₀ β]
  [has_measurable_smul G₀ β]

lemma measurable_const_smul_iff' {c : G₀} (hc : c ≠ 0) :
  measurable (λ x, c • f x) ↔ measurable f :=
(is_unit.mk0 c hc).measurable_const_smul_iff

lemma ae_measurable_const_smul_iff' {c : G₀} (hc : c ≠ 0) :
  ae_measurable (λ x, c • f x) μ ↔ ae_measurable f μ :=
(is_unit.mk0 c hc).ae_measurable_const_smul_iff

variables {G : Type*} [group G] [measurable_space G] [mul_action G β]
  [has_measurable_smul G β]

lemma measurable_const_smul_iff (c : G) :
  measurable (λ x, c • f x) ↔ measurable f :=
(group.is_unit c).measurable_const_smul_iff

lemma ae_measurable_const_smul_iff (c : G) :
  ae_measurable (λ x, c • f x) μ ↔ ae_measurable f μ :=
(group.is_unit c).ae_measurable_const_smul_iff

end mul_action

/-!
### Big operators: `∏` and `∑`
-/

@[to_additive]
lemma list.measurable_prod' {M : Type*} [monoid M] [measurable_space M] [has_measurable_mul₂ M]
  (l : list (α → M)) (hl : ∀ f ∈ l, measurable f) :
  measurable l.prod :=
begin
  induction l with f l ihl, { exact measurable_one },
  rw [list.forall_mem_cons] at hl,
  rw [list.prod_cons],
  exact hl.1.mul (ihl hl.2)
end

@[to_additive]
lemma list.ae_measurable_prod' {M : Type*} [monoid M] [measurable_space M] [has_measurable_mul₂ M]
  {μ : measure α} (l : list (α → M)) (hl : ∀ f ∈ l, ae_measurable f μ) :
  ae_measurable l.prod μ :=
begin
  induction l with f l ihl, { exact ae_measurable_one },
  rw [list.forall_mem_cons] at hl,
  rw [list.prod_cons],
  exact hl.1.mul (ihl hl.2)
end

@[to_additive]
lemma list.measurable_prod {M : Type*} [monoid M] [measurable_space M] [has_measurable_mul₂ M]
  (l : list (α → M)) (hl : ∀ f ∈ l, measurable f) :
  measurable (λ x, (l.map (λ f : α → M, f x)).prod) :=
by simpa only [← pi.list_prod_apply] using l.measurable_prod' hl

@[to_additive]
lemma list.ae_measurable_prod {M : Type*} [monoid M] [measurable_space M] [has_measurable_mul₂ M]
  {μ : measure α} (l : list (α → M)) (hl : ∀ f ∈ l, ae_measurable f μ) :
  ae_measurable (λ x, (l.map (λ f : α → M, f x)).prod) μ :=
by simpa only [← pi.list_prod_apply] using l.ae_measurable_prod' hl

@[to_additive]
lemma multiset.measurable_prod' {M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] (l : multiset (α → M)) (hl : ∀ f ∈ l, measurable f) :
  measurable l.prod :=
by { rcases l with ⟨l⟩, simpa using l.measurable_prod' (by simpa using hl) }

@[to_additive]
lemma multiset.ae_measurable_prod' {M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] {μ : measure α} (l : multiset (α → M)) (hl : ∀ f ∈ l, ae_measurable f μ) :
  ae_measurable l.prod μ :=
by { rcases l with ⟨l⟩, simpa using l.ae_measurable_prod' (by simpa using hl) }

@[to_additive]
lemma multiset.measurable_prod {M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] (s : multiset (α → M)) (hs : ∀ f ∈ s, measurable f) :
  measurable (λ x, (s.map (λ f : α → M, f x)).prod) :=
by simpa only [← pi.multiset_prod_apply] using s.measurable_prod' hs

@[to_additive]
lemma multiset.ae_measurable_prod {M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] {μ : measure α} (s : multiset (α → M)) (hs : ∀ f ∈ s, ae_measurable f μ) :
  ae_measurable (λ x, (s.map (λ f : α → M, f x)).prod) μ :=
by simpa only [← pi.multiset_prod_apply] using s.ae_measurable_prod' hs

@[to_additive]
lemma finset.measurable_prod' {ι M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, measurable (f i)) :
  measurable (∏ i in s, f i) :=
finset.prod_induction _ _ (λ _ _, measurable.mul) (@measurable_one M _ _ _ _) hf

@[to_additive]
lemma finset.measurable_prod {ι M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, measurable (f i)) :
  measurable (λ a, ∏ i in s, f i a) :=
by simpa only [← finset.prod_apply] using s.measurable_prod' hf

@[to_additive]
lemma finset.ae_measurable_prod' {ι M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] {μ : measure α} {f : ι → α → M} (s : finset ι)
  (hf : ∀i ∈ s, ae_measurable (f i) μ) :
  ae_measurable (∏ i in s, f i) μ :=
multiset.ae_measurable_prod' _ $
  λ g hg, let ⟨i, hi, hg⟩ := multiset.mem_map.1 hg in (hg ▸ hf _ hi)

@[to_additive]
lemma finset.ae_measurable_prod {ι M : Type*} [comm_monoid M] [measurable_space M]
  [has_measurable_mul₂ M] {f : ι → α → M} {μ : measure α} (s : finset ι)
  (hf : ∀i ∈ s, ae_measurable (f i) μ) :
  ae_measurable (λ a, ∏ i in s, f i a) μ :=
by simpa only [← finset.prod_apply] using s.ae_measurable_prod' hf


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

import data.mv_polynomial.comm_ring
import data.set.finite
import ring_theory.mv_polynomial.homogeneous
import ring_theory.polynomial.basic
import order.symm_diff

/-!
# Homogenization

## Main definitions

* `mv_polynomial.homogenization`

## Main statements

* foo_bar_unique

## Notation

## Implementation details

* We homogenize polynomials over a given ground set of variables, rather than adjoining an extra
  variable to give the user more choice in the type of the polynomials involved.

## References

* [F. Bar, *Quuxes*][]

## Tags

-/

variables {R ι : Type*} [comm_semiring R]

open polynomial finset mv_polynomial

open_locale big_operators
noncomputable theory
namespace mv_polynomial

section finsupp

-- TODO can any assumptions be weakened
-- TODO version with monoid hom?
lemma finsupp.sum_update_add {α β : Type*} [add_comm_monoid α] [add_comm_monoid β]
  (f : ι →₀ α) (i : ι) (a : α) (g : ι → α → β) (hg : ∀ i, g i 0 = 0)
  (hgg : ∀ (a : ι) (b₁ b₂ : α), g a (b₁ + b₂) = g a b₁ + g a b₂) :
  (f.update i a).sum g + g i (f i) = f.sum g + g i a :=
begin
  classical,
  simp_rw finsupp.update_eq_erase_add_single,
  rw finsupp.sum_add_index (λ i _, hg i) (λ i _, hgg i),
  conv_rhs {rw ← finsupp.update_self f i},
  rw finsupp.update_eq_erase_add_single,
  rw finsupp.sum_add_index (λ i _, hg i) (λ i _, hgg i),
  rw add_assoc,
  rw add_assoc,
  congr' 1,
  rw add_comm,
  rw finsupp.sum_single_index (hg _),
  rw finsupp.sum_single_index (hg _),
end

end finsupp

/-- The homogenization of a multivariate polynomial at a single variable. -/
def homogenization (i : ι) (p : mv_polynomial ι R) :
  mv_polynomial ι R :=
-- ∑ j in p.support, monomial (j + finsupp.single i (p.total_degree - (j i))) (p.coeff j)
finsupp.map_domain (λ j, j + finsupp.single i (p.total_degree - j.sum (λ _ m, m))) p

namespace finsupp
open finsupp

@[simp] lemma support_map_domain {α β M : Type*} [add_comm_monoid M]
  (f : α ↪ β) (v : α →₀ M) : (finsupp.map_domain f v).support ⊆ v.support.map f :=
begin
  classical,
  rw finsupp.map_domain,
  refine finset.subset.trans finsupp.support_sum _,
  simp only [finsupp.mem_support_iff, finset.bUnion_subset_iff_forall_subset, ne.def],
  intros x hx,
  apply finset.subset.trans finsupp.support_single_subset,
  simp [hx],
end

lemma map_domain_apply' {α β M : Type*} [add_comm_monoid M] (S : set α) {f : α → β} (x : α →₀ M)
  (hS : (x.support : set α) ⊆ S) (hf : set.inj_on f S) {a : α} (ha : a ∈ S) :
  finsupp.map_domain f x (f a) = x a :=
begin
  classical,
  rw finsupp.map_domain,
  simp only [finsupp.sum_apply],
  rw finsupp.sum,
  simp_rw finsupp.single_apply,
  have : ∀ (a_1 : α) (ha1 : a_1 ∈ x.support),
    (if f a_1 = f a then x a_1 else 0) = (if f a_1 = f a then x a else 0),
  { intros a_1 ha_1,
    split_ifs with hh,
    rw hf _ ha hh,
    exact hS ha_1,
    refl, },
  conv in (ite _ _ _)
  { rw [this _ H], },
  by_cases ha : a ∈ x.support,
  rw ← finset.add_sum_erase _ _ ha,
  simp only [if_true, eq_self_iff_true],
  convert add_zero _,
  have : ∀ i ∈ x.support.erase a, f i ≠ f a,
  { intros i hi,
    have hix : i ∈ x.support,
    exact finset.mem_of_mem_erase hi,
    have hia : i ≠ a,
    exact finset.ne_of_mem_erase hi,
    exact hia ∘ (hf (hS hix) (hS ha)), },
  conv in (ite _ _ _)
  { rw if_neg (this x H), },
  simp only [finset.sum_const_zero],
  simp at ha,
  simp [ha],
end

lemma map_domain_inj_on {α β M : Type*} [add_comm_monoid M] (S : set α) {f : α → β}
  (hf : set.inj_on f S) :
  set.inj_on (finsupp.map_domain f : (α →₀ M) → (β →₀ M)) {w | (w.support : set α) ⊆ S} :=
begin
  intros v₁ hv₁ v₂ hv₂ eq,
  ext a,
  have : finsupp.map_domain f v₁ (f a) = finsupp.map_domain f v₂ (f a), { rw eq },
  rw [set.mem_set_of_eq] at hv₁ hv₂,
  classical,
  have hu : (v₁.support ∪ v₂.support : set α) ⊆ S := set.union_subset hv₁ hv₂,
  by_cases h : a ∈ v₁.support ∪ v₂.support,
  { rwa [map_domain_apply' S _ hv₁ hf _,
         map_domain_apply' S _ hv₂ hf _] at this,
    { apply hu,
      exact_mod_cast h, },
    { apply hu,
      exact_mod_cast h, }, },
  { simp only [decidable.not_or_iff_and_not, mem_union, not_not, finsupp.mem_support_iff] at h,
    simp [h], },
  -- rw [finsupp.map_domain_apply hf, finsupp.map_domain_apply hf] at this,
end
end finsupp

-- lemma support_homogenization [decidable_eq ι] (i : ι) (p : mv_polynomial ι R)
--   (h : ∀ j ∈ p.support, (j : ι → ℕ) i = 0) : (p.homogenization i).support = p.support.image
--     (λ (j : ι →₀ ℕ), j + finsupp.single i (p.total_degree - j.sum (λ (_x : ι) (m : ℕ), m))) :=
-- begin
--   rw homogenization,
--   apply finsupp.support_map_domain _ _ _,
-- end

@[simp]
lemma homogenization_zero (i : ι) : (0 : mv_polynomial ι R).homogenization i = 0 :=
by simp [homogenization]

-- TODO this is probably useless
-- lemma map_domain_one {α β M : Type*} [has_zero β] [has_zero α] [has_one M]
--   [add_comm_monoid M] {f : α → β} (hf : f 0 = 0) :
--   finsupp.map_domain f (finsupp.single 0 1 : α →₀ M) = (finsupp.single 0 1 : β →₀ M) :=
-- by simp [hf]

-- TODO maybe instead prove this via is_homogeneous_one
@[simp]
lemma homogenization_one (i : ι) : (1 : mv_polynomial ι R).homogenization i = 1 :=
begin
  simp only [homogenization, total_degree_one, zero_tsub, add_zero, finsupp.single_zero],
  erw finsupp.map_domain_single,
  -- erw map_domain_one,
  refl,
end

@[simp]
lemma homogenization_C (i : ι) (c : R) : (C c : mv_polynomial ι R).homogenization i = C c :=
begin
  simp only [homogenization, total_degree_C, zero_tsub],
  convert finsupp.map_domain_single,
  rw single_eq_monomial,
  have : (0 : ι →₀ ℕ) i = 0,
  { simp only [finsupp.coe_zero, pi.zero_apply], },
  rw [← this],
  simp,
end

@[simp]
lemma homogenization_monomial (i : ι) (s : ι →₀ ℕ) (r : R) :
  (monomial s r : mv_polynomial ι R).homogenization i = monomial s r :=
begin
  by_cases hr : r = 0,
  { simp [hr], },
  erw [homogenization, finsupp.map_domain_single, single_eq_monomial, total_degree_monomial _ hr,
    tsub_self],
  simp,
end

-- TODO name this
lemma aux {i : ι} {p : mv_polynomial ι R} {x : ι →₀ ℕ} (hp : x ∈ p.support) :
  (x + finsupp.single i (p.total_degree - x.sum (λ _ m, m))).sum (λ _ m, m) = p.total_degree :=
begin
  classical,
  rw finsupp.sum_add_index,
  rw [finsupp.sum_single_index],
  rw [add_tsub_cancel_iff_le],
  exact finset.le_sup hp,
  refl,
  intros, refl,
  intros, refl,
end

lemma is_homogeneous_homogenization (i : ι) (p : mv_polynomial ι R) :
  (p.homogenization i).is_homogeneous p.total_degree :=
begin
  letI := classical.dec_eq ι,
  rw homogenization,
  intros d hd,
  rw [finsupp.map_domain, finsupp.sum, coeff_sum] at hd,
  simp_rw [single_eq_monomial, coeff_monomial] at hd,
  contrapose! hd,
  have : ∀ (x : ι →₀ ℕ) (hx : x ∈ p.support),
    ¬ x + finsupp.single i (p.total_degree - x.sum (λ (_x : ι) (m : ℕ), m)) = d,
  { intros x hx hh,
    apply hd,
    rw ← hh,
    change (x + finsupp.single i (p.total_degree - x.sum (λ _ m, m))).sum (λ _ m, m) = _,
    rw aux hx, },
  conv in (ite _ _ _)
  { rw [if_neg (this x H)], },
  simp,
end

lemma homogenization_of_is_homogeneous (n : ℕ) (i : ι) (p : mv_polynomial ι R)
  (hp : p.is_homogeneous n) : p.homogenization i = p :=
begin
  by_cases hpn : p = 0,
  { simp [hpn], },
  rw homogenization,
  have := (hp.total_degree hpn).symm,
  subst this,
  rw is_homogeneous at hp,
  have : ∀ x (hx : x ∈ p.support),
    (λ (j : ι →₀ ℕ), j + finsupp.single i (p.total_degree - j.sum (λ (_x : ι) (m : ℕ), m))) x = x,
  { intros x hx,
    simp only [add_right_eq_self, finsupp.single_eq_same, tsub_eq_zero_iff_le, finsupp.single_tsub,
      finsupp.single_le_iff],
    rw ← hp (mem_support_iff.mp hx),
    exact le_refl _, },
  rw finsupp.map_domain_congr this,
  -- simp,
  erw finsupp.map_domain_id,
  -- TODO there should be a simp lemma version of this for λ x, x so simp works
end

lemma homogenization_idempotent (i : ι) (p : mv_polynomial ι R) :
  (p.homogenization i).homogenization i = p.homogenization i :=
begin
  classical,
  apply homogenization_of_is_homogeneous p.total_degree,
  exact is_homogeneous_homogenization _ _,
end

-- TODO should these hjp assumptions be phrased using `degree_of` or `vars`?
lemma homogenization_ne_zero_of_ne_zero (i : ι) {p : mv_polynomial ι R} (hp : p ≠ 0)
  (hjp : ∀ j ∈ p.support, (j : ι → ℕ) i = 0) : p.homogenization i ≠ 0 :=
begin
  intro h,
  apply hp,
  have : set.inj_on (λ j : ι →₀ ℕ, j + finsupp.single i (p.total_degree - j.sum (λ _ m, m)))
          {w | w i = 0},
  { intros t ht y hy hh,
    simp only [set.mem_set_of_eq] at hh hy ht,
    ext a,
    have : (t + finsupp.single i (p.total_degree - t.sum (λ _ m, m))) a =
           (y + finsupp.single i (p.total_degree - y.sum (λ _ m, m))) a,
    { rw hh, },
    simp only [finsupp.coe_add, pi.add_apply] at this,
    classical,
    rw [finsupp.single_apply, finsupp.single_apply] at this,
    split_ifs at this with hia,
    { rw [← hia, ht, hy], },
    { simpa, }, },
  refine finsupp.map_domain_inj_on _ this _ (by simp) h,
  intros x hx,
  rw [set.mem_set_of_eq, hjp x hx],
  -- refine finsupp.map_domain_injective _ h,
  -- intros x y hxy,
  -- simp at hxy,
  -- -- TODO something like this but this isnt exactly true
  -- admit,
end

-- TODO this can follow from previous
lemma total_degree_homogenization (i : ι) (p : mv_polynomial ι R)
  (h : ∀ j ∈ p.support, (j : ι → ℕ) i = 0) :
  (p.homogenization i).total_degree = p.total_degree :=
begin
  classical,
  by_cases hp : p = 0,
  { simp [hp], },
  apply is_homogeneous.total_degree,
  refine is_homogeneous_homogenization _ _,
  exact homogenization_ne_zero_of_ne_zero _ hp h,
  -- rw total_degree,
  -- have : (homogenization i p).support.nonempty,
  -- { simp [homogenization],
  --   admit,
  --    },
  -- rw ← finset.sup'_eq_sup this,
  -- rw finset.nonempty.sup'_eq_cSup_image,
  -- suffices : (λ (s : ι →₀ ℕ), s.sum (λ (n : ι) (e : ℕ), e)) '' ↑((homogenization i p).support) =
  --   {p.total_degree},
  -- { simp [this], },
  -- refine set.eq_singleton_iff_unique_mem.mpr _,
  -- split,
  -- { simp, admit, },
  -- { simp, admit, },
end

section leading_terms
-- TODO is this the best def?
/-- The sum of the monomials of highest degree of a multivariate polynomial. -/
def leading_terms (p : mv_polynomial ι R) : mv_polynomial ι R :=
homogeneous_component p.total_degree p

lemma leading_terms_apply (p : mv_polynomial ι R) : p.leading_terms =
  ∑ d in p.support.filter (λ d, ∑ i in d.support, d i = p.total_degree), monomial d (coeff d p) :=
homogeneous_component_apply _ _
-- (p.support.filter (λ s : ι →₀ ℕ, s.sum (λ _ e, e) = p.total_degree)).sum $
--   λ s, monomial s (p.coeff s)

-- TODO for non-zero polys this is true that p.lead = p iff p.is_homogenous n for a fixed n
-- TODO generalize to p.homog comp = n
lemma leading_terms_eq_self_iff_is_homogeneous (p : mv_polynomial ι R) :
  p.leading_terms = p ↔ p.is_homogeneous p.total_degree :=
begin
  split; intro h,
  { rw is_homogeneous,
    contrapose! h,
    rcases h with ⟨h_w, h_h₁, h_h₂⟩,
    rw [leading_terms, ne.def, mv_polynomial.ext_iff],
    push_neg,
    use h_w,
    classical,
    change ¬ h_w.sum (λ (_x : ι) (e : ℕ), e) = p.total_degree at h_h₂,
    simp only [h_h₁.symm, coeff_homogeneous_component, exists_prop, and_true, ne.def, not_false_iff,
      not_forall, ite_eq_left_iff],
    convert h_h₂, },
  { rw [leading_terms_apply],
    rw (_ : p.support.filter (λ (s : ι →₀ ℕ), ∑ (i : ι) in s.support, s i = p.total_degree)
            = p.support),
    { rw support_sum_monomial_coeff p, },
    { rw finset.filter_eq_self,
      intros s hs,
      rw [mem_support_iff] at hs,
      rw ← h hs, }, },
end

@[simp]
lemma leading_terms_C (r : R) : (C r : mv_polynomial ι R).leading_terms = C r :=
begin
  rw leading_terms_eq_self_iff_is_homogeneous,
  convert is_homogeneous_C _ _,
  simp,
end

@[simp]
lemma leading_terms_zero : (0 : mv_polynomial ι R).leading_terms = 0 :=
by simp [leading_terms]

@[simp]
lemma leading_terms_one : (1 : mv_polynomial ι R).leading_terms = 1 :=
by simp [leading_terms]

@[simp]
lemma leading_terms_monomial (s : ι →₀ ℕ) (r : R) : (monomial s r).leading_terms = monomial s r :=
begin
  by_cases hr : r = 0,
  { simp [hr], },
  rw leading_terms_eq_self_iff_is_homogeneous,
  convert is_homogeneous_monomial _ _ _ _,
  simpa [total_degree_monomial _ hr]
end

section dangerous_instance
local attribute [instance] mv_polynomial.unique
@[simp]
lemma leading_terms_X (s : ι) : (X s : mv_polynomial ι R).leading_terms = X s :=
begin
  nontriviality R,
  rw leading_terms_eq_self_iff_is_homogeneous,
  convert is_homogeneous_X _ _,
  exact total_degree_X _,
end
end dangerous_instance

lemma is_homogeneous_leading_terms (p : mv_polynomial ι R) :
  p.leading_terms.is_homogeneous p.total_degree :=
homogeneous_component_is_homogeneous (total_degree p) p

lemma exists_coeff_ne_zero_total_degree {p : mv_polynomial ι R} (hp : p ≠ 0) :
  ∃ (v : ι →₀ ℕ), v.sum (λ _ e, e) = p.total_degree ∧ p.coeff v ≠ 0 :=
begin
  obtain ⟨b, hb₁, hb₂⟩ := p.support.exists_mem_eq_sup (finsupp.support_nonempty_iff.mpr hp)
    (λ (m : ι →₀ ℕ), m.to_multiset.card),
  use b,
  split,
  { rw ← total_degree_eq p at hb₂,
    rw hb₂,
    dsimp, -- TODO break this out as a lemma
    funext m,
    exact (finsupp.card_to_multiset _).symm, },
  { exact mem_support_iff.mp hb₁, },
end

-- TODO mathlib
@[simp] lemma support_eq_empty {f : mv_polynomial ι R} : f.support = ∅ ↔ f = 0 :=
finsupp.support_eq_empty

lemma support_add_eq [decidable_eq ι] {g₁ g₂ : mv_polynomial ι R}
  (h : disjoint g₁.support g₂.support) : (g₁ + g₂).support = g₁.support ∪ g₂.support :=
finsupp.support_add_eq h

lemma add_ne_zero_of_ne_zero_of_support_disjoint (p q : mv_polynomial ι R)
  (hp : p ≠ 0) (h : disjoint p.support q.support) : p + q ≠ 0 :=
begin
  classical,
  contrapose! hp,
  have := congr_arg support hp,
  rw [support_zero, support_add_eq h, finset.union_eq_empty_iff, -- TODO should this be simp?
    mv_polynomial.support_eq_empty] at this,
  exact this.left,
end

lemma support_sum_monomial_eq [decidable_eq R] (S : finset (ι →₀ ℕ)) (f : (ι →₀ ℕ) → R) :
  support (∑ v in S, monomial v (f v)) = S.filter (λ v, f v ≠ 0) :=
begin
  letI := classical.dec_eq ι,
  induction S using finset.induction with s S hs hsi,
  { simp, },
  rw [finset.sum_insert hs, support_add_eq],
  { rw [hsi, filter_congr_decidable, filter_insert, support_monomial],
    split_ifs with h;
    { simp [h, insert_eq], }, },
  { apply disjoint_of_subset_left support_monomial_subset,
    simp [hsi, hs], },
end

lemma support_sum_monomial_subset (S : finset (ι →₀ ℕ)) (f : (ι →₀ ℕ) → R) :
  support (∑ v in S, monomial v (f v)) ⊆ S :=
begin
  classical,
  rw support_sum_monomial_eq,
  apply filter_subset,
end

lemma sum_monomial_ne_zero_of_exists_mem_ne_zero (S : finset (ι →₀ ℕ)) (f : (ι →₀ ℕ) → R)
  (h : ∃ (s) (hs : s ∈ S), f s ≠ 0) : ∑ (s : ι →₀ ℕ) in S, monomial s (f s) ≠ 0 :=
begin
  classical,
  simp only [← support_eq_empty, support_sum_monomial_eq, filter_congr_decidable, ne.def],
  rcases h with ⟨s, h_S, h_s⟩,
  exact ne_empty_of_mem (mem_filter.mpr ⟨h_S, h_s⟩),
end

lemma leading_terms_ne_zero {p : mv_polynomial ι R} (hp : p ≠ 0) : p.leading_terms ≠ 0 :=
begin
  classical,
  rw leading_terms_apply,
  apply sum_monomial_ne_zero_of_exists_mem_ne_zero,
  simp only [exists_prop, mem_support_iff, finset.mem_filter],
  convert exists_coeff_ne_zero_total_degree hp,
  ext v,
  change v.sum (λ (_x : ι) (e : ℕ), e) with v.support.sum v,
  simp [and_comm],
end

@[simp]
lemma total_degree_homogenous_component_of_ne_zero {n : ℕ} {p : mv_polynomial ι R}
  (hp : homogeneous_component n p ≠ 0) :
  (homogeneous_component n p).total_degree = n :=
is_homogeneous.total_degree (homogeneous_component_is_homogeneous n p) hp

@[simp]
lemma total_degree_leading_terms (p : mv_polynomial ι R) :
  p.leading_terms.total_degree = p.total_degree :=
begin
  by_cases hp : p = 0,
  { simp [hp], },
  exact total_degree_homogenous_component_of_ne_zero (leading_terms_ne_zero hp),
end

-- TODO generalize this to homogeneous component idempotent?
lemma leading_terms_idempotent (p : mv_polynomial ι R) :
  p.leading_terms.leading_terms = p.leading_terms :=
begin
  rw [leading_terms_eq_self_iff_is_homogeneous, total_degree_leading_terms],
  exact is_homogeneous_leading_terms p,
end

-- TODO lol this isn't true
-- lemma homogeneous_component_mul (m n : ℕ) (p q : mv_polynomial ι R) :
--   homogeneous_component (m + n) (p * q) = homogeneous_component m p * homogeneous_component n q :=
-- begin
--   admit,
-- end

lemma coeff_leading_terms (p : mv_polynomial ι R) (d : ι →₀ ℕ) :
  coeff d p.leading_terms = if ∑ i in d.support, d i = p.total_degree then coeff d p else 0 :=
coeff_homogeneous_component _ _ _

lemma support_homogeneous_component (n : ℕ) (p : mv_polynomial ι R) :
  (homogeneous_component n p).support = p.support.filter (λ d, d.sum (λ _ m, m) = n) :=
begin
  rw homogeneous_component,
  simp only [finsupp.restrict_dom_apply, submodule.subtype_apply, function.comp_app,
    linear_map.coe_comp, set.mem_set_of_eq],
  erw ← finsupp.support_filter,
  refl,
end

lemma support_homogeneous_component_subset (n : ℕ) (p : mv_polynomial ι R) :
  (homogeneous_component n p).support ⊆ p.support :=
begin
  rw support_homogeneous_component,
  exact finset.filter_subset _ _,
end

lemma support_leading_terms (p : mv_polynomial ι R) :
  p.leading_terms.support = p.support.filter (λ d, d.sum (λ _ m, m) = p.total_degree) :=
support_homogeneous_component _ _

lemma support_leading_terms_subset (p : mv_polynomial ι R) : p.leading_terms.support ⊆ p.support :=
support_homogeneous_component_subset _ _

lemma eq_leading_terms_add (p : mv_polynomial ι R) (hp : p.total_degree ≠ 0) :
  ∃ p_rest : mv_polynomial ι R,
    p = p.leading_terms + p_rest ∧ p_rest.total_degree < p.total_degree :=
begin
  letI := classical.dec_eq ι,
  existsi (∑ (v : ι →₀ ℕ) in p.support \ p.leading_terms.support, (monomial v) (coeff v p)),
  split,
  { nth_rewrite 0 p.leading_terms.as_sum,
    have : ∀ (x : ι →₀ ℕ) (hx : x ∈ p.leading_terms.support), x.support.sum x = p.total_degree,
    { intros x hx,
      rw support_leading_terms at hx,
      simp at hx,
      exact hx.2, },
    simp_rw coeff_leading_terms,
    conv in (ite _ _ _)
    { rw [if_pos (this x H)], },
    have : p.leading_terms.support ⊆ p.support,
    from support_leading_terms_subset _,
    have : p.leading_terms.support ∩ p.support = p.leading_terms.support,
    { rw finset.inter_eq_left_iff_subset,
      exact this },
    nth_rewrite 0 ← this,
    rw [finset.inter_comm, finset.sum_inter_add_sum_diff],
    exact p.as_sum, },
  { rw [total_degree, finset.sup_lt_iff],
    intros b hb,
    rw support_leading_terms at hb,
    rw ← finset.filter_not at hb, -- TODO this was also hard to find maybe a negated version is good
    have := support_sum_monomial_subset _ _ hb,
    simp only [finset.mem_filter] at this,
    cases this,
    rw total_degree,
    exact lt_of_le_of_ne (finset.le_sup this_left) this_right,
    rw [bot_eq_zero],
    exact pos_iff_ne_zero.mpr hp, },
end

lemma leading_terms_add_of_total_degree_lt (p q : mv_polynomial ι R)
  (h : q.total_degree < p.total_degree) : (p + q).leading_terms = p.leading_terms :=
by rw [leading_terms, leading_terms, total_degree_add_eq_left_of_total_degree_lt h,
  linear_map.map_add, homogeneous_component_eq_zero _ q h, add_zero]

-- lemma C_mul_eq_smul {r : R} (p : mv_polynomial ι R) : C r * p = r • p :=
-- by rw [C_eq_smul_one, algebra.smul_mul_assoc, one_mul]

lemma no_zero_smul_divisors.smul_eq_zero_iff_eq_zero_or_eq_zero (R M : Type*) [has_zero R]
  [has_zero M] [smul_with_zero R M] [no_zero_smul_divisors R M] {c : R} {x : M} :
  c • x = 0 ↔ c = 0 ∨ x = 0 :=
begin
  split; intro h,
  exact eq_zero_or_eq_zero_of_smul_eq_zero h,
  cases h;
  simp [h],
end

--TODO this generalized lemma when distrib_mul_action_with_zero exists?
-- lemma support_smul_eq {α M R : Type*} {_ : monoid_with_zero R} [add_monoid M]
--   [distrib_mul_action_with_zero R M] [no_zero_smul_divisors R M] {b : R} (hb : b ≠ 0) {g : α →₀ M} :
--   (b • g).support = g.support :=
-- begin
--   ext a,
--   simp [finsupp.smul_apply, mem_support_iff, ne.def],
--   simp,
--   rw no_zero_smul_divisors.smul_eq_zero_iff_eq_zero_or_eq_zero,
-- end

-- haveI : no_zero_smul_divisors R (mv_polynomial ι R), --TODO add this instance
--TODO maybe this for leading terms and homog
-- lemma homogeneous_s_monomial_mul [no_zero_divisors R] (p : mv_polynomial ι R) (r : R) (x : ι →₀ ℕ) :
  -- (p * monomial x r).leading_terms = p.leading_terms * monomial x r :=
  --TODO also maybe an smul version
@[simp]
lemma leading_terms_C_mul [no_zero_smul_divisors R R] (p : mv_polynomial ι R) (r : R) :
  (C r * p).leading_terms = C r * p.leading_terms :=
begin
  by_cases hr : r = 0,
  { simp [hr], },
  have : (C r * p).support = p.support,
  { rw C_mul',
    exact finsupp.support_smul_eq hr, },
  rw [leading_terms, leading_terms, total_degree, this, homogeneous_component_C_mul],
  refl,
end

lemma eq_C_of_total_degree_zero {p : mv_polynomial ι R} (hp : p.total_degree = 0) :
  p = C (coeff 0 p) :=
begin
  letI := classical.dec_eq ι,
  erw finset.sup_eq_bot_iff at hp,
  simp only [mem_support_iff] at hp,
  ext,
  by_cases hm : m = 0,
  { simp [hm], },
  rw [coeff_C, if_neg (ne.symm hm)],
  classical,
  by_contradiction h,
  specialize hp m h,
  apply hm,
  rw finsupp.sum at hp, -- TODO this and line below could be a lemma, finsupp.sum_eq_zero_iff?
  simp only [not_imp_self, bot_eq_zero, finsupp.mem_support_iff, finset.sum_eq_zero_iff] at hp,
  ext,
  simp [hp],
end

-- TODO can things be generalized to no_zero_divisors (would require an instance for mv_poly)
-- sadly this adds some imports and requirements not needed in rest of file
@[simp]
lemma leading_terms_mul {S : Type*} [comm_ring S] [is_domain S] (p q : mv_polynomial ι S) :
  (p * q).leading_terms = p.leading_terms * q.leading_terms :=
begin
  by_cases hp : p.total_degree = 0,
  { rw [eq_C_of_total_degree_zero hp, leading_terms_C_mul, leading_terms_C], },
  by_cases hq : q.total_degree = 0,
  { rw [eq_C_of_total_degree_zero hq, mul_comm, leading_terms_C_mul, leading_terms_C, mul_comm], },
  have : (p.leading_terms * q.leading_terms).total_degree = p.total_degree + q.total_degree,
  { rw is_homogeneous.total_degree,
    apply is_homogeneous.mul (is_homogeneous_leading_terms p) (is_homogeneous_leading_terms q),
    apply mul_ne_zero;
    { apply leading_terms_ne_zero,
      rintro rfl,
      simpa, }, },
  rcases eq_leading_terms_add p hp with ⟨wp, hp, tp⟩,
  rcases eq_leading_terms_add q hq with ⟨wq, hq, tq⟩,
  rw [hp, hq],
  simp only [add_mul, mul_add],
  rw [add_assoc, leading_terms_add_of_total_degree_lt, leading_terms_add_of_total_degree_lt,
    leading_terms_add_of_total_degree_lt, leading_terms_idempotent, leading_terms_idempotent,
    leading_terms_eq_self_iff_is_homogeneous],
  { convert is_homogeneous.mul (is_homogeneous_leading_terms _) (is_homogeneous_leading_terms _), },
  { rwa total_degree_leading_terms, },
  { rwa total_degree_leading_terms, },
  { rw this,
    calc _ ≤ max (wp * q.leading_terms).total_degree (p.leading_terms * wq + wp * wq).total_degree :
              total_degree_add _ _
       ... ≤ max (wp * q.leading_terms).total_degree
              (max (p.leading_terms * wq).total_degree (wp * wq).total_degree) :
                max_le_max (le_refl _) (total_degree_add _ _)
       ... ≤ max (wp.total_degree + q.leading_terms.total_degree)
              (max (p.leading_terms * wq).total_degree (wp * wq).total_degree) :
                max_le_max (total_degree_mul _ _) (le_refl _)
       ... ≤ max (wp.total_degree + q.leading_terms.total_degree)
              (max (p.leading_terms.total_degree + wq.total_degree)
                (wp.total_degree + wq.total_degree)) :
                  max_le_max (le_refl _) (max_le_max (total_degree_mul _ _) (total_degree_mul _ _))
       ... < p.total_degree + q.total_degree : _,
    simp only [total_degree_leading_terms, max_lt_iff, add_lt_add_iff_right, add_lt_add_iff_left],
    exact ⟨tp, tq, add_lt_add tp tq⟩, },
end
--TODO reinterpret this as a hom in this case

lemma total_degree_mul_eq {S : Type*} [comm_ring S] [is_domain S] {p q : mv_polynomial ι S}
  (hp : p ≠ 0) (hq : q ≠ 0) : (p * q).total_degree = p.total_degree + q.total_degree :=
begin
  rw [← total_degree_leading_terms, ← total_degree_leading_terms p, ← total_degree_leading_terms q,
    leading_terms_mul, is_homogeneous.total_degree],
  apply is_homogeneous.mul;
  simp [is_homogeneous_leading_terms],
  apply mul_ne_zero (leading_terms_ne_zero hp) (leading_terms_ne_zero hq),
end

end leading_terms

lemma homogenization_add_of_total_degree_eq (i : ι) (p q : mv_polynomial ι R)
  (h : p.total_degree = q.total_degree) (hpq : p.total_degree = (p + q).total_degree) :
  (p + q).homogenization i = p.homogenization i + q.homogenization i :=
by simp only [homogenization, finsupp.map_domain_add, ←h, ←hpq]

lemma homogenization_mul {S : Type*} [comm_ring S] [is_domain S] (i : ι) (p q : mv_polynomial ι S) :
  -- TODO is this cond needed?
  --(hp : ∀ j ∈ p.support, (j : ι → ℕ) i = 0) (hq : ∀ j ∈ q.support, (j : ι → ℕ) i = 0) :
  (p * q).homogenization i = p.homogenization i * q.homogenization i :=
begin
  classical,
  by_cases hp : p = 0,
  { simp [hp], },
  by_cases hq : q = 0,
  { simp [hq], },
  rw [homogenization, homogenization, homogenization, total_degree_mul_eq hp hq,
    ← finsupp.sum_single p, ← finsupp.sum_single q, finsupp.map_domain_sum, finsupp.map_domain_sum],
  erw [finset.sum_mul_sum, finset.sum_mul_sum],
  simp only [finsupp.single_add, finsupp.sum_single, monomial_mul],
  rw finsupp.map_domain_finset_sum,
  apply finset.sum_congr rfl,
  intros a ha,
  simp only [finset.mem_product] at ha,
  rw [finsupp.map_domain_single, finsupp.map_domain_single],
  simp_rw [single_eq_monomial],
  simp only [finsupp.single_add, monomial_mul],
  erw finsupp.map_domain_single,
  congr' 1,
  rw finsupp.sum_add_index,
  simp only [finsupp.single_add, finsupp.single_tsub],
  ext j,
  simp only [pi.add_apply, finsupp.coe_add, finsupp.coe_tsub, pi.sub_apply],
  classical,
  have : ∀ {f s p q fs ss : ℕ} (hP : fs ≤ p) (hQ : ss ≤ q),
    f + s + (p + q - (fs + ss)) = f + (p - fs) + (s + (q - ss)),
  { intros,
    zify [add_le_add hP hQ],
    ring, },
  refine this _ _;
  rw finsupp.single_apply;
  split_ifs,
  { simp only [h, finsupp.single_eq_same],
    convert finset.le_sup ha.left,
    refl, },
  { simp, },
  { simp only [h, finsupp.single_eq_same],
      convert finset.le_sup ha.right,
      refl, },
  { simp, },
  { intros i _, refl, },
  { intro i, simp, },
end

section dangerous_instance
local attribute [instance] mv_polynomial.unique

@[simp]
lemma homogenization_X_add_C {i j : ι} (r : R) :
  (X j + C r : mv_polynomial ι R).homogenization i = X j + C r * X i :=
begin
  nontriviality R,
  have : (X j + C r).total_degree = 1,
  { rw total_degree_add_eq_left_of_total_degree_lt,
    { exact total_degree_X _, },
    { simp only [total_degree_C, total_degree_X, nat.lt_one_iff], }, },
  erw [homogenization, finsupp.map_domain_add, finsupp.map_domain_single,
    finsupp.map_domain_single],
  simp only [tsub_zero, finsupp.sum_zero_index, finsupp.sum_single_index, this, add_zero,
    finsupp.single_zero, zero_add, single_eq_monomial],
  rw [X, X],
  congr,
  rw [← C_mul_X_pow_eq_monomial, pow_one],
  refl,
end

@[simp]
lemma homogenization_X_sub_C {R : Type*} [comm_ring R] {i j : ι} (r : R) :
  (X j - C r : mv_polynomial ι R).homogenization i = X j - C r * X i :=
by rw [sub_eq_add_neg, sub_eq_add_neg, ← C_neg, homogenization_X_add_C,
  C_neg, neg_mul]

@[simp]
lemma homogenization_X_pow_add_C {i j : ι} {n : ℕ} (hn : 0 < n) (r : R) :
  (X j ^ n + C r : mv_polynomial ι R).homogenization i = X j ^ n + C r * X i ^ n :=
begin
  nontriviality R,
  have : (X j ^ n + C r).total_degree = n,
  { rw total_degree_add_eq_left_of_total_degree_lt,
    { exact total_degree_X_pow _ _, },
    { simp only [total_degree_C, total_degree_X_pow, hn], }, },
  erw [homogenization, finsupp.map_domain_add],
  erw add_monoid_algebra.single_pow,
  erw [finsupp.map_domain_single,
    finsupp.map_domain_single],
  simp only [tsub_zero, finsupp.sum_zero_index, finsupp.sum_single_index, zero_add,
    single_eq_monomial, one_pow, mul_one, finsupp.smul_single', finsupp.single_tsub],
  congr,
  { rw total_degree_add_eq_left_of_total_degree_lt,
    simp [one_ne_zero],
    simp [one_ne_zero, hn], },
  { convert C_mul_X_pow_eq_monomial.symm,
    rw ← C_mul_X_pow_eq_monomial,
    simp [this], },
end

@[simp]
lemma homogenization_X_pow_sub_C {R : Type*} [comm_ring R] {i j : ι} {n : ℕ} (hn : 0 < n) (r : R) :
  (X j ^ n - C r : mv_polynomial ι R).homogenization i = X j ^ n - C r * X i ^ n :=
by rw [sub_eq_add_neg, sub_eq_add_neg, ← C_neg, homogenization_X_pow_add_C hn,
  C_neg, neg_mul]

@[simp]
lemma homogenization_X_pow_sub_one {R : Type*} [comm_ring R] {i j : ι} {n : ℕ} (hn : 0 < n) :
  (X j ^ n - 1 : mv_polynomial ι R).homogenization i = X j ^ n - X i ^ n :=
begin
  convert homogenization_X_pow_sub_C hn _,
  simp,
end

@[simp]
lemma homogenization_X_pow_add_one {i j : ι} {n : ℕ} (hn : 0 < n) :
  (X j ^ n + 1 : mv_polynomial ι R).homogenization i = X j ^ n + X i ^ n :=
begin
  convert homogenization_X_pow_add_C hn _,
  simp,
end

end dangerous_instance

end mv_polynomial

namespace mv_polynomial
section

-- generalized version of the unprimed version
lemma support_sum_monomial_subset' [decidable_eq ι] {α : Type*} (S : finset α) (g : α → ι →₀ ℕ)
  (f : α → R) : support (∑ v in S, monomial (g v) (f v)) ⊆ S.image g :=
begin
  letI := classical.dec_eq α,
  induction S using finset.induction with s S hs hsi,
  { simp, },
  { rw finset.sum_insert hs,
    apply finset.subset.trans support_add,
    apply finset.union_subset,
    { apply finset.subset.trans support_monomial_subset _,
      rw finset.image_insert,
      convert finset.subset_union_left _ (finset.image g S), },
    { apply finset.subset.trans hsi _,
      rw finset.image_insert,
      exact finset.subset_insert (g s) (finset.image g S), }, },
end
open_locale pointwise

lemma support_mul' [decidable_eq ι] (p q : mv_polynomial ι R) :
  (p * q).support ⊆ p.support + q.support :=
begin
  -- TODO this was really hard to find, maybe needs a docstring or alias?
  rw [p.as_sum, q.as_sum, finset.sum_mul_sum],
  simp_rw [monomial_mul],
  rw [support_sum_monomial_coeff, support_sum_monomial_coeff],
  exact finset.subset.trans (support_sum_monomial_subset' _ _ _) (finset.subset.refl _),
end

section
open_locale pointwise

lemma support_one : (1 : mv_polynomial ι R).support ⊆ 0 :=
finsupp.support_single_subset

@[simp] lemma support_one_of_nontrivial [nontrivial R] : (1 : mv_polynomial ι R).support = 0 :=
finsupp.support_single_ne_zero _ one_ne_zero

end

variable [decidable_eq ι]
lemma support_prod (P : finset (mv_polynomial ι R)) : (P.prod id).support ⊆ P.sum support :=
begin
  classical,
  induction P using finset.induction with p S hS hSi,
  { simp only [prod_empty, sum_empty], exact support_one, },
  rw [finset.prod_insert hS, finset.sum_insert hS],
  simp only [id.def],
  refine finset.subset.trans (support_mul' _ _) _,
  convert finset.add_subset_add (finset.subset.refl _) hSi,
end

end

lemma degree_of_eq_zero_iff (i : ι) (p : mv_polynomial ι R) : degree_of i p = 0 ↔
  ∀ (j: ι→₀ ℕ), j ∈ p.support → j i = 0:=
begin
  rw degree_of_eq_sup,
  apply iff.intro,
  { intros h j hj,
    apply nat.eq_zero_of_le_zero,
    have t:= (finset.le_sup hj),
    rwa h at t },
  { intro h,
    apply nat.eq_zero_of_le_zero,
    apply finset.sup_le,
    intros m hm,
    rw h m hm }
end

lemma prod_contains_no (i : ι) (P : finset (mv_polynomial ι R))
  (hp : ∀ (p : mv_polynomial ι R) (hp : p ∈ P) (j) (hjp : j ∈ p.support), (j : ι → ℕ) i = 0)
  (j) (hjp : j ∈ (P.prod id).support) :
  (j : ι → ℕ) i = 0 :=
begin
  apply (degree_of_eq_zero_iff i (P.prod id)).1 _ j hjp,
  revert hp,
  apply finset.cons_induction_on P,
  { intro hp,
    simp only [prod_empty, ← C_1, degree_of_C] },
  { intros a s has hs,
    intro hp,
    rw prod_cons,
    apply nat.eq_zero_of_le_zero,
    apply le_trans (degree_of_mul_le _ _ _),
    rw hs,
    { simp only [id.def, add_zero, le_zero_iff],
      exact (degree_of_eq_zero_iff _ _).2 (hp a (mem_cons_self _ _)) },
    { intros p hps m  hmp,
      apply hp p _ m hmp,
      simp only [hps, mem_cons, or_true] } }
end

open_locale big_operators
lemma homogenization_prod {σ S : Type*} [comm_ring S] [is_domain S] (i : ι)
  (P : σ → mv_polynomial ι S) (L : finset σ) :
  (∏ l in L, P l).homogenization i = ∏ l in L, (P l).homogenization i :=
begin
  classical,
  induction L using finset.induction with p S hS hSi,
  { simp, },
  simp only [finset.prod_insert hS],
  rw homogenization_mul,
  rw hSi,
end

lemma homogenization_prod_id {S : Type*} [comm_ring S] [is_domain S] (i : ι)
  (P : finset (mv_polynomial ι S)) :
  (P.prod id).homogenization i = P.prod (λ p, p.homogenization i) :=
begin
  classical,
  induction P using finset.induction with p S hS hSi,
  { simp, },
  simp only [finset.prod_insert hS],
  rw homogenization_mul,
  rw hSi,
  rw [id.def],
end

end mv_polynomial


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.monic
import Mathlib.algebra.group_ring_action
import Mathlib.algebra.group_action_hom
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Group action on rings applied to polynomials

This file contains instances and definitions relating `mul_semiring_action` to `polynomial`.
-/

namespace polynomial

protected instance mul_semiring_action (M : Type u_1) [monoid M] (R : Type u_2) [semiring R]
    [mul_semiring_action M R] : mul_semiring_action M (polynomial R) :=
  mul_semiring_action.mk sorry sorry

protected instance faithful_mul_semiring_action (M : Type u_1) [monoid M] (R : Type u_2)
    [semiring R] [faithful_mul_semiring_action M R] :
    faithful_mul_semiring_action M (polynomial R) :=
  faithful_mul_semiring_action.mk sorry

@[simp] theorem coeff_smul' {M : Type u_1} [monoid M] {R : Type u_2} [semiring R]
    [mul_semiring_action M R] (m : M) (p : polynomial R) (n : ℕ) :
    coeff (m • p) n = m • coeff p n :=
  coeff_map (mul_semiring_action.to_semiring_hom M R m) n

@[simp] theorem smul_C {M : Type u_1} [monoid M] {R : Type u_2} [semiring R]
    [mul_semiring_action M R] (m : M) (r : R) : m • coe_fn C r = coe_fn C (m • r) :=
  map_C (mul_semiring_action.to_semiring_hom M R m)

@[simp] theorem smul_X {M : Type u_1} [monoid M] {R : Type u_2} [semiring R]
    [mul_semiring_action M R] (m : M) : m • X = X :=
  map_X (mul_semiring_action.to_semiring_hom M R m)

theorem smul_eval_smul {M : Type u_1} [monoid M] (S : Type u_3) [comm_semiring S]
    [mul_semiring_action M S] (m : M) (f : polynomial S) (x : S) :
    eval (m • x) (m • f) = m • eval x f :=
  sorry

theorem eval_smul' (S : Type u_3) [comm_semiring S] (G : Type u_4) [group G]
    [mul_semiring_action G S] (g : G) (f : polynomial S) (x : S) :
    eval (g • x) f = g • eval x (g⁻¹ • f) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (eval (g • x) f = g • eval x (g⁻¹ • f)))
        (Eq.symm (smul_eval_smul S g (g⁻¹ • f) x))))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (eval (g • x) f = eval (g • x) (g • g⁻¹ • f))) (smul_inv_smul g f)))
      (Eq.refl (eval (g • x) f)))

theorem smul_eval (S : Type u_3) [comm_semiring S] (G : Type u_4) [group G]
    [mul_semiring_action G S] (g : G) (f : polynomial S) (x : S) :
    eval x (g • f) = g • eval (g⁻¹ • x) f :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (eval x (g • f) = g • eval (g⁻¹ • x) f))
        (Eq.symm (smul_eval_smul S g f (g⁻¹ • x)))))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (eval x (g • f) = eval (g • g⁻¹ • x) (g • f))) (smul_inv_smul g x)))
      (Eq.refl (eval x (g • f))))

end polynomial

/-- the product of `(X - g • x)` over distinct `g • x`. -/
def prod_X_sub_smul (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R]
    [mul_semiring_action G R] (x : R) : polynomial R :=
  finset.prod finset.univ
    fun (g : quotient_group.quotient (mul_action.stabilizer G x)) =>
      polynomial.X - coe_fn polynomial.C (mul_action.of_quotient_stabilizer G x g)

theorem prod_X_sub_smul.monic (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R]
    [mul_semiring_action G R] (x : R) : polynomial.monic (prod_X_sub_smul G R x) :=
  sorry

theorem prod_X_sub_smul.eval (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R]
    [mul_semiring_action G R] (x : R) : polynomial.eval x (prod_X_sub_smul G R x) = 0 :=
  sorry

theorem prod_X_sub_smul.smul (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R]
    [mul_semiring_action G R] (x : R) (g : G) : g • prod_X_sub_smul G R x = prod_X_sub_smul G R x :=
  sorry

theorem prod_X_sub_smul.coeff (G : Type u_2) [group G] [fintype G] (R : Type u_3) [comm_ring R]
    [mul_semiring_action G R] (x : R) (g : G) (n : ℕ) :
    g • polynomial.coeff (prod_X_sub_smul G R x) n = polynomial.coeff (prod_X_sub_smul G R x) n :=
  sorry

namespace mul_semiring_action_hom

/-- An equivariant map induces an equivariant map on polynomials. -/
protected def polynomial {M : Type u_1} [monoid M] {P : Type u_2} [comm_semiring P]
    [mul_semiring_action M P] {Q : Type u_3} [comm_semiring Q] [mul_semiring_action M Q]
    (g : mul_semiring_action_hom M P Q) : mul_semiring_action_hom M (polynomial P) (polynomial Q) :=
  mk (polynomial.map ↑g) sorry sorry sorry sorry sorry

@[simp] theorem coe_polynomial {M : Type u_1} [monoid M] {P : Type u_2} [comm_semiring P]
    [mul_semiring_action M P] {Q : Type u_3} [comm_semiring Q] [mul_semiring_action M Q]
    (g : mul_semiring_action_hom M P Q) :
    ⇑(mul_semiring_action_hom.polynomial g) = polynomial.map ↑g :=
  rfl

end Mathlib