/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.constructions.prod
import measure_theory.group.measure

/-!
# Product measures

In this file we define and prove properties about finite products of measures
(and at some point, countable products of measures).

## Main definition

* `measure_theory.measure.pi`: The product of finitely many σ-finite measures.
  Given `μ : Π i : ι, measure (α i)` for `[fintype ι]` it has type `measure (Π i : ι, α i)`.

To apply Fubini along some subset of the variables, use
`measure_theory.measure.map_pi_equiv_pi_subtype_prod` to reduce to the situation of a product
of two measures: this lemma states that the bijection `equiv.pi_equiv_pi_subtype_prod p α`
between `(Π i : ι, α i)` and `(Π i : {i // p i}, α i) × (Π i : {i // ¬ p i}, α i)` maps a product
measure to a direct product of product measures, to which one can apply the usual Fubini for
direct product of measures.

## Implementation Notes

We define `measure_theory.outer_measure.pi`, the product of finitely many outer measures, as the
maximal outer measure `n` with the property that `n (pi univ s) ≤ ∏ i, m i (s i)`,
where `pi univ s` is the product of the sets `{s i | i : ι}`.

We then show that this induces a product of measures, called `measure_theory.measure.pi`.
For a collection of σ-finite measures `μ` and a collection of measurable sets `s` we show that
`measure.pi μ (pi univ s) = ∏ i, m i (s i)`. To do this, we follow the following steps:
* We know that there is some ordering on `ι`, given by an element of `[encodable ι]`.
* Using this, we have an equivalence `measurable_equiv.pi_measurable_equiv_tprod` between
  `Π ι, α i` and an iterated product of `α i`, called `list.tprod α l` for some list `l`.
* On this iterated product we can easily define a product measure `measure_theory.measure.tprod`
  by iterating `measure_theory.measure.prod`
* Using the previous two steps we construct `measure_theory.measure.pi'` on `Π ι, α i` for encodable
  `ι`.
* We know that `measure_theory.measure.pi'` sends products of sets to products of measures, and
  since `measure_theory.measure.pi` is the maximal such measure (or at least, it comes from an outer
  measure which is the maximal such outer measure), we get the same rule for
  `measure_theory.measure.pi`.

## Tags

finitary product measure

-/

noncomputable theory
open function set measure_theory.outer_measure filter measurable_space encodable
open_locale classical big_operators topological_space ennreal

universes u v

variables {ι ι' : Type*} {α : ι → Type*}

/-! We start with some measurability properties -/

/-- Boxes formed by π-systems form a π-system. -/
lemma is_pi_system.pi {C : Π i, set (set (α i))} (hC : ∀ i, is_pi_system (C i)) :
  is_pi_system (pi univ '' pi univ C) :=
begin
  rintro _ ⟨s₁, hs₁, rfl⟩ _ ⟨s₂, hs₂, rfl⟩ hst,
  rw [← pi_inter_distrib] at hst ⊢, rw [univ_pi_nonempty_iff] at hst,
  exact mem_image_of_mem _ (λ i _, hC i _ (hs₁ i (mem_univ i)) _ (hs₂ i (mem_univ i)) (hst i))
end

/-- Boxes form a π-system. -/
lemma is_pi_system_pi [Π i, measurable_space (α i)] :
  is_pi_system (pi univ '' pi univ (λ i, {s : set (α i) | measurable_set s})) :=
is_pi_system.pi (λ i, is_pi_system_measurable_set)

variables [fintype ι] [fintype ι']

/-- Boxes of countably spanning sets are countably spanning. -/
lemma is_countably_spanning.pi {C : Π i, set (set (α i))}
  (hC : ∀ i, is_countably_spanning (C i)) :
  is_countably_spanning (pi univ '' pi univ C) :=
begin
  choose s h1s h2s using hC,
  haveI := fintype.encodable ι,
  let e : ℕ → (ι → ℕ) := λ n, (decode (ι → ℕ) n).iget,
  refine ⟨λ n, pi univ (λ i, s i (e n i)), λ n, mem_image_of_mem _ (λ i _, h1s i _), _⟩,
  simp_rw [(surjective_decode_iget (ι → ℕ)).Union_comp (λ x, pi univ (λ i, s i (x i))),
      Union_univ_pi s, h2s, pi_univ]
end

/-- The product of generated σ-algebras is the one generated by boxes, if both generating sets
  are countably spanning. -/
lemma generate_from_pi_eq {C : Π i, set (set (α i))}
  (hC : ∀ i, is_countably_spanning (C i)) :
  @measurable_space.pi _ _ (λ i, generate_from (C i)) = generate_from (pi univ '' pi univ C) :=
begin
  haveI := fintype.encodable ι,
  apply le_antisymm,
  { refine supr_le _, intro i, rw [comap_generate_from],
    apply generate_from_le, rintro _ ⟨s, hs, rfl⟩, dsimp,
    choose t h1t h2t using hC,
    simp_rw [eval_preimage, ← h2t],
    rw [← @Union_const _ ℕ _ s],
    have : (pi univ (update (λ (i' : ι), Union (t i')) i (⋃ (i' : ℕ), s))) =
      (pi univ (λ k, ⋃ j : ℕ, @update ι (λ i', set (α i')) _ (λ i', t i' j) i s k)),
    { ext, simp_rw [mem_univ_pi], apply forall_congr, intro i',
      by_cases (i' = i), { subst h, simp }, { rw [← ne.def] at h, simp [h] }},
    rw [this, ← Union_univ_pi],
    apply measurable_set.Union,
    intro n, apply measurable_set_generate_from,
    apply mem_image_of_mem, intros j _, dsimp only,
    by_cases h: j = i, subst h, rwa [update_same], rw [update_noteq h], apply h1t },
  { apply generate_from_le, rintro _ ⟨s, hs, rfl⟩,
    rw [univ_pi_eq_Inter], apply measurable_set.Inter, intro i, apply measurable_pi_apply,
    exact measurable_set_generate_from (hs i (mem_univ i)) }
end

/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
  generate the σ-algebra on `α × β`. -/
lemma generate_from_eq_pi [h : Π i, measurable_space (α i)]
  {C : Π i, set (set (α i))} (hC : ∀ i, generate_from (C i) = h i)
  (h2C : ∀ i, is_countably_spanning (C i)) :
  generate_from (pi univ '' pi univ C) = measurable_space.pi :=
by rw [← funext hC, generate_from_pi_eq h2C]

/-- The product σ-algebra is generated from boxes, i.e. `s ×ˢ t` for sets `s : set α` and
  `t : set β`. -/
lemma generate_from_pi [Π i, measurable_space (α i)] :
  generate_from (pi univ '' pi univ (λ i, { s : set (α i) | measurable_set s})) =
  measurable_space.pi :=
generate_from_eq_pi (λ i, generate_from_measurable_set) (λ i, is_countably_spanning_measurable_set)

namespace measure_theory

variables {m : Π i, outer_measure (α i)}

/-- An upper bound for the measure in a finite product space.
  It is defined to by taking the image of the set under all projections, and taking the product
  of the measures of these images.
  For measurable boxes it is equal to the correct measure. -/
@[simp] def pi_premeasure (m : Π i, outer_measure (α i)) (s : set (Π i, α i)) : ℝ≥0∞ :=
∏ i, m i (eval i '' s)

lemma pi_premeasure_pi {s : Π i, set (α i)} (hs : (pi univ s).nonempty) :
  pi_premeasure m (pi univ s) = ∏ i, m i (s i) :=
by simp [hs]

lemma pi_premeasure_pi' [nonempty ι] {s : Π i, set (α i)} :
  pi_premeasure m (pi univ s) = ∏ i, m i (s i) :=
begin
  cases (pi univ s).eq_empty_or_nonempty with h h,
  { rcases univ_pi_eq_empty_iff.mp h with ⟨i, hi⟩,
    have : ∃ i, m i (s i) = 0 := ⟨i, by simp [hi]⟩,
    simpa [h, finset.card_univ, zero_pow (fintype.card_pos_iff.mpr ‹_›),
      @eq_comm _ (0 : ℝ≥0∞), finset.prod_eq_zero_iff] },
  { simp [h] }
end

lemma pi_premeasure_pi_mono {s t : set (Π i, α i)} (h : s ⊆ t) :
  pi_premeasure m s ≤ pi_premeasure m t :=
finset.prod_le_prod' (λ i _, (m i).mono' (image_subset _ h))

lemma pi_premeasure_pi_eval [nonempty ι] {s : set (Π i, α i)} :
  pi_premeasure m (pi univ (λ i, eval i '' s)) = pi_premeasure m s :=
by simp [pi_premeasure_pi']

namespace outer_measure

/-- `outer_measure.pi m` is the finite product of the outer measures `{m i | i : ι}`.
  It is defined to be the maximal outer measure `n` with the property that
  `n (pi univ s) ≤ ∏ i, m i (s i)`, where `pi univ s` is the product of the sets
  `{s i | i : ι}`. -/
protected def pi (m : Π i, outer_measure (α i)) : outer_measure (Π i, α i) :=
bounded_by (pi_premeasure m)

lemma pi_pi_le (m : Π i, outer_measure (α i)) (s : Π i, set (α i)) :
  outer_measure.pi m (pi univ s) ≤ ∏ i, m i (s i) :=
by { cases (pi univ s).eq_empty_or_nonempty with h h, simp [h],
     exact (bounded_by_le _).trans_eq (pi_premeasure_pi h) }

lemma le_pi {m : Π i, outer_measure (α i)} {n : outer_measure (Π i, α i)} :
  n ≤ outer_measure.pi m ↔ ∀ (s : Π i, set (α i)), (pi univ s).nonempty →
    n (pi univ s) ≤ ∏ i, m i (s i) :=
begin
  rw [outer_measure.pi, le_bounded_by'], split,
  { intros h s hs, refine (h _ hs).trans_eq (pi_premeasure_pi hs) },
  { intros h s hs, refine le_trans (n.mono $ subset_pi_eval_image univ s) (h _ _),
    simp [univ_pi_nonempty_iff, hs] }
end

end outer_measure

namespace measure

variables [Π i, measurable_space (α i)] (μ : Π i, measure (α i))

section tprod

open list
variables {δ : Type*} {π : δ → Type*} [∀ x, measurable_space (π x)]

/-- A product of measures in `tprod α l`. -/
-- for some reason the equation compiler doesn't like this definition
protected def tprod (l : list δ) (μ : Π i, measure (π i)) : measure (tprod π l) :=
by { induction l with i l ih, exact dirac punit.star, exact (μ i).prod ih }

@[simp] lemma tprod_nil (μ : Π i, measure (π i)) : measure.tprod [] μ = dirac punit.star := rfl

@[simp] lemma tprod_cons (i : δ) (l : list δ) (μ : Π i, measure (π i)) :
  measure.tprod (i :: l) μ = (μ i).prod (measure.tprod l μ) := rfl

instance sigma_finite_tprod (l : list δ) (μ : Π i, measure (π i)) [∀ i, sigma_finite (μ i)] :
  sigma_finite (measure.tprod l μ) :=
begin
  induction l with i l ih,
  { rw [tprod_nil], apply_instance },
  { rw [tprod_cons], resetI, apply_instance }
end

lemma tprod_tprod (l : list δ) (μ : Π i, measure (π i)) [∀ i, sigma_finite (μ i)]
  (s : Π i, set (π i)) :
  measure.tprod l μ (set.tprod l s) = (l.map (λ i, (μ i) (s i))).prod :=
begin
  induction l with i l ih, { simp },
  rw [tprod_cons, set.tprod, prod_prod, map_cons, prod_cons, ih]
end

end tprod

section encodable

open list measurable_equiv
variables [encodable ι]

/-- The product measure on an encodable finite type, defined by mapping `measure.tprod` along the
  equivalence `measurable_equiv.pi_measurable_equiv_tprod`.
  The definition `measure_theory.measure.pi` should be used instead of this one. -/
def pi' : measure (Π i, α i) :=
measure.map (tprod.elim' mem_sorted_univ) (measure.tprod (sorted_univ ι) μ)

lemma pi'_pi [∀ i, sigma_finite (μ i)] (s : Π i, set (α i)) : pi' μ (pi univ s) = ∏ i, μ i (s i) :=
by rw [pi', ← measurable_equiv.pi_measurable_equiv_tprod_symm_apply, measurable_equiv.map_apply,
  measurable_equiv.pi_measurable_equiv_tprod_symm_apply, elim_preimage_pi, tprod_tprod _ μ,
  ← list.prod_to_finset, sorted_univ_to_finset]; exact sorted_univ_nodup ι

end encodable

lemma pi_caratheodory :
  measurable_space.pi ≤ (outer_measure.pi (λ i, (μ i).to_outer_measure)).caratheodory :=
begin
  refine supr_le _,
  intros i s hs,
  rw [measurable_space.comap] at hs,
  rcases hs with ⟨s, hs, rfl⟩,
  apply bounded_by_caratheodory,
  intro t,
  simp_rw [pi_premeasure],
  refine finset.prod_add_prod_le' (finset.mem_univ i) _ _ _,
  { simp [image_inter_preimage, image_diff_preimage, measure_inter_add_diff _ hs, le_refl] },
  { rintro j - hj, apply mono', apply image_subset, apply inter_subset_left },
  { rintro j - hj, apply mono', apply image_subset, apply diff_subset }
end

/-- `measure.pi μ` is the finite product of the measures `{μ i | i : ι}`.
  It is defined to be measure corresponding to `measure_theory.outer_measure.pi`. -/
@[irreducible] protected def pi : measure (Π i, α i) :=
to_measure (outer_measure.pi (λ i, (μ i).to_outer_measure)) (pi_caratheodory μ)

lemma pi_pi_aux [∀ i, sigma_finite (μ i)] (s : Π i, set (α i)) (hs : ∀ i, measurable_set (s i)) :
  measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
begin
  refine le_antisymm _ _,
  { rw [measure.pi, to_measure_apply _ _ (measurable_set.pi_fintype (λ i _, hs i))],
    apply outer_measure.pi_pi_le },
  { haveI : encodable ι := fintype.encodable ι,
    rw [← pi'_pi μ s],
    simp_rw [← pi'_pi μ s, measure.pi,
      to_measure_apply _ _ (measurable_set.pi_fintype (λ i _, hs i)), ← to_outer_measure_apply],
    suffices : (pi' μ).to_outer_measure ≤ outer_measure.pi (λ i, (μ i).to_outer_measure),
    { exact this _ },
    clear hs s,
    rw [outer_measure.le_pi],
    intros s hs,
    simp_rw [to_outer_measure_apply],
    exact (pi'_pi μ s).le }
end

variable {μ}

/-- `measure.pi μ` has finite spanning sets in rectangles of finite spanning sets. -/
def finite_spanning_sets_in.pi {C : Π i, set (set (α i))}
  (hμ : ∀ i, (μ i).finite_spanning_sets_in (C i)) :
  (measure.pi μ).finite_spanning_sets_in (pi univ '' pi univ C) :=
begin
  haveI := λ i, (hμ i).sigma_finite,
  haveI := fintype.encodable ι,
  refine ⟨λ n, pi univ (λ i, (hμ i).set ((decode (ι → ℕ) n).iget i)), λ n, _, λ n, _, _⟩;
  -- TODO (kmill) If this let comes before the refine, while the noncomputability checker
  -- correctly sees this definition is computable, the Lean VM fails to see the binding is
  -- computationally irrelevant. The `noncomputable theory` doesn't help because all it does
  -- is insert `noncomputable` for you when necessary.
  let e : ℕ → (ι → ℕ) := λ n, (decode (ι → ℕ) n).iget,
  { refine mem_image_of_mem _ (λ i _, (hμ i).set_mem _) },
  { calc measure.pi μ (pi univ (λ i, (hμ i).set (e n i)))
        ≤ measure.pi μ (pi univ (λ i, to_measurable (μ i) ((hμ i).set (e n i)))) :
      measure_mono (pi_mono $ λ i hi, subset_to_measurable _ _)
    ... = ∏ i, μ i (to_measurable (μ i) ((hμ i).set (e n i))) :
      pi_pi_aux μ _ (λ i, measurable_set_to_measurable _ _)
    ... = ∏ i, μ i ((hμ i).set (e n i)) :
      by simp only [measure_to_measurable]
    ... < ∞ : ennreal.prod_lt_top (λ i hi, ((hμ i).finite _).ne) },
  { simp_rw [(surjective_decode_iget (ι → ℕ)).Union_comp (λ x, pi univ (λ i, (hμ i).set (x i))),
      Union_univ_pi (λ i, (hμ i).set), (hμ _).spanning, set.pi_univ] }
end

/-- A measure on a finite product space equals the product measure if they are equal on rectangles
  with as sides sets that generate the corresponding σ-algebras. -/
lemma pi_eq_generate_from {C : Π i, set (set (α i))}
  (hC : ∀ i, generate_from (C i) = _inst_3 i)
  (h2C : ∀ i, is_pi_system (C i))
  (h3C : ∀ i, (μ i).finite_spanning_sets_in (C i))
  {μν : measure (Π i, α i)}
  (h₁ : ∀ s : Π i, set (α i), (∀ i, s i ∈ C i) → μν (pi univ s) = ∏ i, μ i (s i)) :
    measure.pi μ = μν :=
begin
  have h4C : ∀ i (s : set (α i)), s ∈ C i → measurable_set s,
  { intros i s hs, rw [← hC], exact measurable_set_generate_from hs },
  refine (finite_spanning_sets_in.pi h3C).ext
    (generate_from_eq_pi hC (λ i, (h3C i).is_countably_spanning)).symm
    (is_pi_system.pi h2C) _,
  rintro _ ⟨s, hs, rfl⟩,
  rw [mem_univ_pi] at hs,
  haveI := λ i, (h3C i).sigma_finite,
  simp_rw [h₁ s hs, pi_pi_aux μ s (λ i, h4C i _ (hs i))]
end

variables [∀ i, sigma_finite (μ i)]

/-- A measure on a finite product space equals the product measure if they are equal on
  rectangles. -/
lemma pi_eq {μ' : measure (Π i, α i)}
  (h : ∀ s : Π i, set (α i), (∀ i, measurable_set (s i)) → μ' (pi univ s) = ∏ i, μ i (s i)) :
  measure.pi μ = μ' :=
pi_eq_generate_from (λ i, generate_from_measurable_set)
  (λ i, is_pi_system_measurable_set)
  (λ i, (μ i).to_finite_spanning_sets_in) h

variables (μ)

lemma pi'_eq_pi [encodable ι] : pi' μ = measure.pi μ :=
eq.symm $ pi_eq $ λ s hs, pi'_pi μ s

@[simp] lemma pi_pi (s : Π i, set (α i)) : measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
begin
  haveI : encodable ι := fintype.encodable ι,
  rw [← pi'_eq_pi, pi'_pi]
end

lemma pi_univ : measure.pi μ univ = ∏ i, μ i univ := by rw [← pi_univ, pi_pi μ]

lemma pi_ball [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ}
  (hr : 0 < r) :
  measure.pi μ (metric.ball x r) = ∏ i, μ i (metric.ball (x i) r) :=
by rw [ball_pi _ hr, pi_pi]

lemma pi_closed_ball [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ}
  (hr : 0 ≤ r) :
  measure.pi μ (metric.closed_ball x r) = ∏ i, μ i (metric.closed_ball (x i) r) :=
by rw [closed_ball_pi _ hr, pi_pi]

instance pi.sigma_finite : sigma_finite (measure.pi μ) :=
(finite_spanning_sets_in.pi (λ i, (μ i).to_finite_spanning_sets_in)).sigma_finite

lemma pi_of_empty {α : Type*} [is_empty α] {β : α → Type*} {m : Π a, measurable_space (β a)}
  (μ : Π a : α, measure (β a)) (x : Π a, β a := is_empty_elim) :
  measure.pi μ = dirac x :=
begin
  haveI : ∀ a, sigma_finite (μ a) := is_empty_elim,
  refine pi_eq (λ s hs, _),
  rw [fintype.prod_empty, dirac_apply_of_mem],
  exact is_empty_elim
end

lemma pi_eval_preimage_null {i : ι} {s : set (α i)} (hs : μ i s = 0) :
  measure.pi μ (eval i ⁻¹' s) = 0 :=
begin
  /- WLOG, `s` is measurable -/
  rcases exists_measurable_superset_of_null hs with ⟨t, hst, htm, hμt⟩,
  suffices : measure.pi μ (eval i ⁻¹' t) = 0,
    from measure_mono_null (preimage_mono hst) this,
  clear_dependent s,
  /- Now rewrite it as `set.pi`, and apply `pi_pi` -/
  rw [← univ_pi_update_univ, pi_pi],
  apply finset.prod_eq_zero (finset.mem_univ i),
  simp [hμt]
end

lemma pi_hyperplane (i : ι) [has_no_atoms (μ i)] (x : α i) :
  measure.pi μ {f : Π i, α i | f i = x} = 0 :=
show measure.pi μ (eval i ⁻¹' {x}) = 0,
from pi_eval_preimage_null _ (measure_singleton x)

lemma ae_eval_ne (i : ι) [has_no_atoms (μ i)] (x : α i) :
  ∀ᵐ y : Π i, α i ∂measure.pi μ, y i ≠ x :=
compl_mem_ae_iff.2 (pi_hyperplane μ i x)

variable {μ}

lemma tendsto_eval_ae_ae {i : ι} : tendsto (eval i) (measure.pi μ).ae (μ i).ae :=
λ s hs, pi_eval_preimage_null μ hs

lemma ae_pi_le_pi : (measure.pi μ).ae ≤ filter.pi (λ i, (μ i).ae) :=
le_infi $ λ i, tendsto_eval_ae_ae.le_comap

lemma ae_eq_pi {β : ι → Type*} {f f' : Π i, α i → β i} (h : ∀ i, f i =ᵐ[μ i] f' i) :
  (λ (x : Π i, α i) i, f i (x i)) =ᵐ[measure.pi μ] (λ x i, f' i (x i)) :=
(eventually_all.2 (λ i, tendsto_eval_ae_ae.eventually (h i))).mono $ λ x hx, funext hx

lemma ae_le_pi {β : ι → Type*} [Π i, preorder (β i)] {f f' : Π i, α i → β i}
  (h : ∀ i, f i ≤ᵐ[μ i] f' i) :
  (λ (x : Π i, α i) i, f i (x i)) ≤ᵐ[measure.pi μ] (λ x i, f' i (x i)) :=
(eventually_all.2 (λ i, tendsto_eval_ae_ae.eventually (h i))).mono $ λ x hx, hx

lemma ae_le_set_pi {I : set ι} {s t : Π i, set (α i)} (h : ∀ i ∈ I, s i ≤ᵐ[μ i] t i) :
  (set.pi I s) ≤ᵐ[measure.pi μ] (set.pi I t) :=
((eventually_all_finite (finite.of_fintype I)).2
  (λ i hi, tendsto_eval_ae_ae.eventually (h i hi))).mono $
    λ x hst hx i hi, hst i hi $ hx i hi

lemma ae_eq_set_pi {I : set ι} {s t : Π i, set (α i)} (h : ∀ i ∈ I, s i =ᵐ[μ i] t i) :
  (set.pi I s) =ᵐ[measure.pi μ] (set.pi I t) :=
(ae_le_set_pi (λ i hi, (h i hi).le)).antisymm (ae_le_set_pi (λ i hi, (h i hi).symm.le))

section intervals

variables {μ} [Π i, partial_order (α i)] [∀ i, has_no_atoms (μ i)]

lemma pi_Iio_ae_eq_pi_Iic {s : set ι} {f : Π i, α i} :
  pi s (λ i, Iio (f i)) =ᵐ[measure.pi μ] pi s (λ i, Iic (f i)) :=
ae_eq_set_pi $ λ i hi, Iio_ae_eq_Iic

lemma pi_Ioi_ae_eq_pi_Ici {s : set ι} {f : Π i, α i} :
  pi s (λ i, Ioi (f i)) =ᵐ[measure.pi μ] pi s (λ i, Ici (f i)) :=
ae_eq_set_pi $ λ i hi, Ioi_ae_eq_Ici

lemma univ_pi_Iio_ae_eq_Iic {f : Π i, α i} :
  pi univ (λ i, Iio (f i)) =ᵐ[measure.pi μ] Iic f :=
by { rw ← pi_univ_Iic, exact pi_Iio_ae_eq_pi_Iic }

lemma univ_pi_Ioi_ae_eq_Ici {f : Π i, α i} :
  pi univ (λ i, Ioi (f i)) =ᵐ[measure.pi μ] Ici f :=
by { rw ← pi_univ_Ici, exact pi_Ioi_ae_eq_pi_Ici }

lemma pi_Ioo_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioo_ae_eq_Icc

lemma pi_Ioo_ae_eq_pi_Ioc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Ioc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioo_ae_eq_Ioc

lemma univ_pi_Ioo_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ioo_ae_eq_pi_Icc }

lemma pi_Ioc_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioc (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioc_ae_eq_Icc

lemma univ_pi_Ioc_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ioc (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ioc_ae_eq_pi_Icc }

lemma pi_Ico_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ico (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ico_ae_eq_Icc

lemma univ_pi_Ico_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ico (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ico_ae_eq_pi_Icc }

end intervals

/-- If one of the measures `μ i` has no atoms, them `measure.pi µ`
has no atoms. The instance below assumes that all `μ i` have no atoms. -/
lemma pi_has_no_atoms (i : ι) [has_no_atoms (μ i)] :
  has_no_atoms (measure.pi μ) :=
⟨λ x, flip measure_mono_null (pi_hyperplane μ i (x i)) (singleton_subset_iff.2 rfl)⟩

instance [h : nonempty ι] [∀ i, has_no_atoms (μ i)] : has_no_atoms (measure.pi μ) :=
h.elim $ λ i, pi_has_no_atoms i

instance [Π i, topological_space (α i)] [∀ i, is_locally_finite_measure (μ i)] :
  is_locally_finite_measure (measure.pi μ) :=
begin
  refine ⟨λ x, _⟩,
  choose s hxs ho hμ using λ i, (μ i).exists_is_open_measure_lt_top (x i),
  refine ⟨pi univ s, set_pi_mem_nhds finite_univ (λ i hi, is_open.mem_nhds (ho i) (hxs i)), _⟩,
  rw [pi_pi],
  exact ennreal.prod_lt_top (λ i _, (hμ i).ne)
end

variable (μ)

/-- Separating the indices into those that satisfy a predicate `p` and those that don't maps
a product measure to a product of product measures. This is useful to apply Fubini to some subset
of the variables. The converse is `measure_theory.measure.map_pi_equiv_pi_subtype_prod`. -/
lemma map_pi_equiv_pi_subtype_prod_symm (p : ι → Prop) [decidable_pred p] :
  map (equiv.pi_equiv_pi_subtype_prod p α).symm
    (measure.prod (measure.pi (λ i, μ i)) (measure.pi (λ i, μ i))) = measure.pi μ :=
begin
  refine (measure.pi_eq (λ s hs, _)).symm,
  have A : (equiv.pi_equiv_pi_subtype_prod p α).symm ⁻¹' (set.pi set.univ (λ (i : ι), s i)) =
    (set.pi set.univ (λ i : {i // p i}, s i)) ×ˢ (set.pi set.univ (λ i : {i // ¬p i}, s i)),
  { ext x,
    simp only [equiv.pi_equiv_pi_subtype_prod_symm_apply, mem_prod, mem_univ_pi, mem_preimage,
      subtype.forall],
    split,
    { exact λ h, ⟨λ i hi, by simpa [dif_pos hi] using h i,
                  λ i hi, by simpa [dif_neg hi] using h i⟩ },
    { assume h i,
      by_cases hi : p i,
      { simpa only [dif_pos hi] using h.1 i hi },
      {simpa only [dif_neg hi] using h.2 i hi } } },
  rw [measure.map_apply (measurable_pi_equiv_pi_subtype_prod_symm _ p)
        (measurable_set.univ_pi_fintype hs), A,
      measure.prod_prod, pi_pi, pi_pi, ← fintype.prod_subtype_mul_prod_subtype p (λ i, μ i (s i))],
end

lemma map_pi_equiv_pi_subtype_prod (p : ι → Prop) [decidable_pred p] :
  map (equiv.pi_equiv_pi_subtype_prod p α) (measure.pi μ) =
    measure.prod (measure.pi (λ i, μ i)) (measure.pi (λ i, μ i)) :=
begin
  rw [← map_pi_equiv_pi_subtype_prod_symm μ p, measure.map_map
      (measurable_pi_equiv_pi_subtype_prod _ p) (measurable_pi_equiv_pi_subtype_prod_symm _ p)],
  simp only [equiv.self_comp_symm, map_id]
end

@[to_additive] instance pi.is_mul_left_invariant [∀ i, group (α i)] [∀ i, has_measurable_mul (α i)]
  [∀ i, is_mul_left_invariant (μ i)] : is_mul_left_invariant (measure.pi μ) :=
begin
  refine ⟨λ x, (measure.pi_eq (λ s hs, _)).symm⟩,
  have h : has_mul.mul x ⁻¹' (pi univ s) = set.pi univ (λ i, (λ y, x i * y) ⁻¹' s i),
  { ext, simp },
  simp_rw [measure.map_apply (measurable_const_mul x) (measurable_set.univ_pi_fintype hs), h,
    pi_pi, measure_preimage_mul]
end

@[to_additive] instance pi.is_inv_invariant [∀ i, group (α i)] [∀ i, has_measurable_inv (α i)]
  [∀ i, is_inv_invariant (μ i)] : is_inv_invariant (measure.pi μ) :=
begin
  refine ⟨(measure.pi_eq (λ s hs, _)).symm⟩,
  have A : has_inv.inv ⁻¹' (pi univ s) = set.pi univ (λ i, has_inv.inv ⁻¹' s i),
  { ext, simp },
  simp_rw [measure.inv, measure.map_apply measurable_inv (measurable_set.univ_pi_fintype hs), A,
    pi_pi, measure_preimage_inv]
end

end measure
instance measure_space.pi [Π i, measure_space (α i)] : measure_space (Π i, α i) :=
⟨measure.pi (λ i, volume)⟩

lemma volume_pi [Π i, measure_space (α i)] :
  (volume : measure (Π i, α i)) = measure.pi (λ i, volume) :=
rfl

lemma volume_pi_pi [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  (s : Π i, set (α i)) :
  volume (pi univ s) = ∏ i, volume (s i) :=
measure.pi_pi (λ i, volume) s

lemma volume_pi_ball [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ} (hr : 0 < r) :
  volume (metric.ball x r) = ∏ i, volume (metric.ball (x i) r) :=
measure.pi_ball _ _ hr

lemma volume_pi_closed_ball [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ} (hr : 0 ≤ r) :
  volume (metric.closed_ball x r) = ∏ i, volume (metric.closed_ball (x i) r) :=
measure.pi_closed_ball _ _ hr

open measure
/-- We intentionally restrict this only to the nondependent function space, since type-class
inference cannot find an instance for `ι → ℝ` when this is stated for dependent function spaces. -/
@[to_additive]
instance pi.is_mul_left_invariant_volume {α} [group α] [measure_space α]
  [sigma_finite (volume : measure α)]
  [has_measurable_mul α] [is_mul_left_invariant (volume : measure α)] :
  is_mul_left_invariant (volume : measure (ι → α)) :=
pi.is_mul_left_invariant _

/-- We intentionally restrict this only to the nondependent function space, since type-class
inference cannot find an instance for `ι → ℝ` when this is stated for dependent function spaces. -/
@[to_additive]
instance pi.is_inv_invariant_volume {α} [group α] [measure_space α]
  [sigma_finite (volume : measure α)]
  [has_measurable_inv α] [is_inv_invariant (volume : measure α)] :
  is_inv_invariant (volume : measure (ι → α)) :=
pi.is_inv_invariant _

/-!
### Measure preserving equivalences

In this section we prove that some measurable equivalences (e.g., between `fin 1 → α` and `α` or
between `fin 2 → α` and `α × α`) preserve measure or volume. These lemmas can be used to prove that
measures of corresponding sets (images or preimages) have equal measures and functions `f ∘ e` and
`f` have equal integrals, see lemmas in the `measure_theory.measure_preserving` prefix.
-/

section measure_preserving

lemma measure_preserving_fun_unique {β : Type u} {m : measurable_space β} (μ : measure β)
  (α : Type v) [unique α] :
  measure_preserving (measurable_equiv.fun_unique α β) (measure.pi (λ a : α, μ)) μ :=
begin
  set e := measurable_equiv.fun_unique α β,
  have : pi_premeasure (λ _ : α, μ.to_outer_measure) = measure.map e.symm μ,
  { ext1 s,
    rw [pi_premeasure, fintype.prod_unique, to_outer_measure_apply, e.symm.map_apply],
    congr' 1, exact e.to_equiv.image_eq_preimage s },
  simp only [measure.pi, outer_measure.pi, this, bounded_by_measure, to_outer_measure_to_measure],
  exact ((measurable_equiv.fun_unique α β).symm.measurable.measure_preserving _).symm
end

lemma volume_preserving_fun_unique (α : Type u) (β : Type v) [unique α] [measure_space β] :
  measure_preserving (measurable_equiv.fun_unique α β) volume volume :=
measure_preserving_fun_unique volume α

lemma measure_preserving_pi_fin_two {α : fin 2 → Type u} {m : Π i, measurable_space (α i)}
  (μ : Π i, measure (α i)) [∀ i, sigma_finite (μ i)] :
  measure_preserving (measurable_equiv.pi_fin_two α) (measure.pi μ) ((μ 0).prod (μ 1)) :=
begin
  refine ⟨measurable_equiv.measurable _, (measure.prod_eq $ λ s t hs ht, _).symm⟩,
  rw [measurable_equiv.map_apply, measurable_equiv.pi_fin_two_apply, fin.preimage_apply_01_prod,
    measure.pi_pi, fin.prod_univ_two],
  refl
end

lemma volume_preserving_pi_fin_two (α : fin 2 → Type u) [Π i, measure_space (α i)]
  [∀ i, sigma_finite (volume : measure (α i))] :
  measure_preserving (measurable_equiv.pi_fin_two α) volume volume :=
measure_preserving_pi_fin_two _

lemma measure_preserving_fin_two_arrow_vec {α : Type u} {m : measurable_space α}
  (μ ν : measure α) [sigma_finite μ] [sigma_finite ν] :
  measure_preserving measurable_equiv.fin_two_arrow (measure.pi ![μ, ν]) (μ.prod ν) :=
begin
  haveI : ∀ i, sigma_finite (![μ, ν] i) := fin.forall_fin_two.2 ⟨‹_›, ‹_›⟩,
  exact measure_preserving_pi_fin_two _
end

lemma measure_preserving_fin_two_arrow {α : Type u} {m : measurable_space α}
  (μ : measure α) [sigma_finite μ] :
  measure_preserving measurable_equiv.fin_two_arrow (measure.pi (λ _, μ)) (μ.prod μ) :=
by simpa only [matrix.vec_single_eq_const, matrix.vec_cons_const]
  using measure_preserving_fin_two_arrow_vec μ μ

lemma volume_preserving_fin_two_arrow (α : Type u) [measure_space α]
  [sigma_finite (volume : measure α)] :
  measure_preserving (@measurable_equiv.fin_two_arrow α _) volume volume :=
measure_preserving_fin_two_arrow volume

lemma measure_preserving_pi_empty {ι : Type u} {α : ι → Type v} [is_empty ι]
  {m : Π i, measurable_space (α i)} (μ : Π i, measure (α i)) :
  measure_preserving (measurable_equiv.of_unique_of_unique (Π i, α i) unit)
    (measure.pi μ) (measure.dirac ()) :=
begin
  set e := (measurable_equiv.of_unique_of_unique (Π i, α i) unit),
  refine ⟨e.measurable, _⟩,
  rw [measure.pi_of_empty, measure.map_dirac e.measurable], refl
end

lemma volume_preserving_pi_empty {ι : Type u} (α : ι → Type v) [is_empty ι]
  [Π i, measure_space (α i)] :
  measure_preserving (measurable_equiv.of_unique_of_unique (Π i, α i) unit) volume volume :=
measure_preserving_pi_empty (λ _, volume)

end measure_preserving

end measure_theory


import .love06_monads_demo

/-! # LoVe Exercise 6: Monads -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: A State Monad with Failure

We introduce a richer notion of lawful monad that provides an `orelse`
operator `<|>` satisfying some laws, given below. `emp` denotes failure.
`x <|> y` tries `x` first, falling back on `y` on failure. -/

@[class] structure lawful_monad_with_orelse (m : Type → Type)
  extends lawful_monad m, has_orelse m : Type 1 :=
(emp {α : Type} : m α)
(emp_orelse {α : Type} (a : m α) :
  (emp <|> a) = a)
(orelse_emp {α : Type} (a : m α) :
  (a <|> emp) = a)
(orelse_assoc {α : Type} (a b c : m α) :
  ((a <|> b) <|> c) = (a <|> (b <|> c)))
(emp_bind {α β : Type} (f : α → m β) :
  (emp >>= f) = emp)
(bind_emp {α β : Type} (f : m α) :
  (f >>= (λa, emp : α → m β)) = emp)

/-! 1.1. We set up the `option` type constructor to be a
`lawful_monad_with_orelse`. Complete the proofs.

Hint: Use `simp [(>>=)]` to unfold the definition of the bind operator and
`simp [(<|>)]` to unfold the definition of the `orelse` operator. -/

def option.orelse {α : Type} : option α → option α → option α
| option.none     ma' := ma'
| (option.some a) _   := option.some a

@[instance] def lawful_monad_with_orelse_option :
  lawful_monad_with_orelse option :=
{ emp          := λα, option.none,
  orelse       := @option.orelse,
  emp_orelse   :=
    sorry,
  orelse_emp   :=
    begin
      intros α a,
      simp [(<|>)],
      cases' a,
      { refl },
      { refl }
    end,
  orelse_assoc :=
    sorry,
  emp_bind     :=
    begin
      intros α β f,
      simp [(>>=)],
      refl
    end,
  bind_emp     :=
    sorry,
  .. option.lawful_monad }

@[simp] lemma option.some_bind {α β : Type} (a : α) (g : α → option β) :
  (option.some a >>= g) = g a :=
sorry

/-! Let us enable some convenient pattern matching syntax, by instantiating
Lean's `monad_fail` type class. (Do not worry if you do not understand what
we are referring to.) -/

@[instance] def lawful_monad_with_orelse.monad_fail {m : Type → Type}
  [lawful_monad_with_orelse m] : monad_fail m :=
{ fail := λα msg, lawful_monad_with_orelse.emp }

/-! Now we can write definitions such as the following: -/

def first_of_three {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  [n, _, _] ← c,
  pure n

#eval first_of_three (option.some [1])
#eval first_of_three (option.some [1, 2, 3])
#eval first_of_three (option.some [1, 2, 3, 4])

/-! Using `lawful_monad_with_orelse` and the `monad_fail` syntax, we can give a
concise definition for the `sum_2_5_7` function seen in the lecture. -/

def sum_2_5_7₇ {m : Type → Type} [lawful_monad_with_orelse m]
  (c : m (list ℕ)) : m ℕ :=
do
  (_ :: n2 :: _ :: _ :: n5 :: _ :: n7 :: _) ← c,
  pure (n2 + n5 + n7)

/-! 1.2. Now we are ready to define `faction σ` ("eff action"): a monad with an
internal state of type `σ` that can fail (unlike `action σ`).

We start with defining `faction σ α`, where `σ` is the type of the internal
state, and `α` is the type of the value stored in the monad. We use `option` to
model failure. This means we can also use the monad operations of `option` when
defining the monad operations on `faction`.

Hints:

* Remember that `faction σ α` is an alias for a function type, so you can use
  pattern matching and `λs, …` to define values of type `faction σ α`.

* `faction` is very similar to `action` from the lecture's demo. You can look
  there for inspiration. -/

def faction (σ : Type) (α : Type) : Type :=
sorry

/-! 1.3. Define the `get` and `set` function for `faction`, where `get` returns
the state passed along the state monad and `set s` changes the state to `s`. -/

def get {σ : Type} : faction σ σ :=
sorry

def set {σ : Type} (s : σ) : faction σ unit :=
sorry

/-! We set up the `>>=` syntax on `faction`: -/

def faction.bind {σ α β : Type} (f : faction σ α) (g : α → faction σ β) :
  faction σ β
| s := f s >>= (λas, g (prod.fst as) (prod.snd as))

@[instance] def faction.has_bind {σ : Type} : has_bind (faction σ) :=
{ bind := @faction.bind σ }

lemma faction.bind_apply {σ α β : Type} (f : faction σ α) (g : α → faction σ β)
    (s : σ) :
  (f >>= g) s = (f s >>= (λas, g (prod.fst as) (prod.snd as))) :=
by refl

/-! 1.4. Define the operator `pure` for `faction`, in such a way that it will
satisfy the three laws. -/

def faction.pure {σ α : Type} (a : α) : faction σ α :=
sorry

/-! We set up the syntax for `pure` on `faction`: -/

@[instance] def faction.has_pure {σ : Type} : has_pure (faction σ) :=
{ pure := @faction.pure σ }

lemma faction.pure_apply {σ α : Type} (a : α) (s : σ) :
  (pure a : faction σ α) s = option.some (a, s) :=
by refl

/-! 1.3. Register `faction` as a monad.

Warning: The last goal is difficult.

Hints:

* The `funext` lemma is useful when you need to prove equality between two
  functions.

* `cases' f s` only works when `f s` appears in your goal, so you may need to
  unfold some constants before you can invoke `cases'`.

* The lemma `faction.pure_apply` or `faction.bind_apply` might prove useful. -/

@[instance] def faction.lawful_monad {σ : Type} : lawful_monad (faction σ) :=
{ pure_bind  :=
    begin
    sorry,
    end,
  bind_pure  :=
    begin
      intros α ma,
      apply funext,
      intro s,
      simp [faction.bind_apply, faction.pure_apply],
      apply lawful_monad.bind_pure
    end,
  bind_assoc :=
    sorry,
  ..faction.has_bind,
  ..faction.has_pure }

/-! ## Question 2: Kleisli Operator

The Kleisli operator `>=>` (not to be confused with `>>=`) is useful for
pipelining effectful functions. Note that `λa, f a >>= g` is to be parsed as
`λa, (f a >>= g)`, not as `(λa, f a) >>= g`. -/

def kleisli {m : Type → Type} [lawful_monad m] {α β γ : Type} (f : α → m β)
  (g : β → m γ) : α → m γ :=
λa, f a >>= g

infixr ` >=> ` : 90 := kleisli

/-! 2.1. Prove that `pure` is a left and right unit for the Kleisli operator. -/

lemma pure_kleisli {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (pure >=> f) = f :=
sorry

lemma kleisli_pure {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  (f >=> pure) = f :=
sorry

/-! 2.2. Prove that the Kleisli operator is associative. -/

lemma kleisli_assoc {m : Type → Type} [lawful_monad m] {α β γ δ : Type}
    (f : α → m β) (g : β → m γ) (h : γ → m δ) :
  ((f >=> g) >=> h) = (f >=> (g >=> h)) :=
sorry

end LoVe


/-
Copyright (c) 2022 Jiale Miao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jiale Miao
-/
import basic
import mul_ring_norm_rat
import rationals

/-!
# Formaliszing Ostrowski's theorem in Lean

This is for presentation only.

-/

section absolute_value

-- Firstly let's look at "absolute value" in Lean.
-- Note that we can't sovle these sorrys as f is very "random".
def my_absolute_value (R : Type) [ring R] (f : R → ℝ) : mul_ring_norm R :=
{ to_fun := f,
  map_zero' := sorry,
  add_le' := sorry,
  neg' := sorry,
  map_one' := sorry,
  map_mul' := sorry,
  eq_zero_of_map_eq_zero' := sorry }

-- Let's look at some examples we mentioned early.

--This is the usual absolute value on ℚ, these `sorrys` are doable.
def my_mul_ring_norm.real : mul_ring_norm ℚ :=
{ to_fun := λ x, |x|,
  map_zero' := by simp only [algebra_map.coe_zero, abs_zero],
  add_le' := sorry,
  neg' := sorry,
  map_one' := sorry,
  map_mul' := sorry,
  eq_zero_of_map_eq_zero' := sorry }

-- This is the p-adic norm on ℚ, these `sorrys` are doable as well.
def my_mul_ring_norm.padic (p : ℕ) [hp : fact (nat.prime p)] : mul_ring_norm ℚ :=
{ to_fun    := λ x : ℚ, (padic_norm p x: ℝ),
  map_zero' := sorry,
  add_le'   := sorry,
  neg'      := sorry,
  eq_zero_of_map_eq_zero' := sorry,
  map_one' := sorry,
  map_mul' := sorry,
}

end absolute_value

section equiv

-- Here is how do we define the equivalance of two valuations.
def my_equiv {R : Type*} [ring R] (f : mul_ring_norm R) (g : mul_ring_norm R) :=
  ∃ c : ℝ, 0 < c ∧ (λ x : R, (f x) ^ c) = g

-- This is actually an equivalance relation.

lemma my_equiv_refl {R : Type*} [ring R] (f : mul_ring_norm R) :
  my_equiv f f := sorry

lemma my_equiv_symm {R : Type*} [ring R] (f g : mul_ring_norm R) (hfg : my_equiv f g) :
  my_equiv g f := sorry

lemma my_equiv_trans {R : Type*} [ring R] (f g k : mul_ring_norm R)
  (hfg : my_equiv f g) (hgk : my_equiv g k) :
    my_equiv f k := sorry

end equiv

section nonarchimedean

/-- A function `f : α → β` is nonarchimedean if it satisfies the inequality
  `f (a + b) ≤ max (f a) (f b)` for all `a, b ∈ α`. -/
def my_is_nonarchimedean {α : Type*} [has_add α] {β : Type*} [linear_order β] (f : α → β) : Prop :=
∀ r s, f (r + s) ≤ max (f r) (f s)

lemma my_is_nonarchimedean_def {α : Type*} [has_add α] {β : Type*} [linear_order β] (f : α → β) :
  my_is_nonarchimedean f ↔ ∀ r s, f (r + s) ≤ max (f r) (f s) := iff.rfl

end nonarchimedean

variable {f : mul_ring_norm ℚ}

section nonarchimedean_proof

-- Firstly, we want to show it's bounded on all ℤ
-- but it suffices to consider it's bounded on all ℕ since |-x| = |x|
-- |n| = |1 + 1 + ...| ≤ |1| = 1 by the nonarchimedean property
lemma my_int_norm_le_one (harc : my_is_nonarchimedean f) (z : ℤ) : f z ≤ 1 := sorry

-- There is a prime number p such that f p < 1
-- because, if not, unique prime factorization
-- would imply f x = 1 for all x in ℚ*.
lemma my_ex_prime_norm_lt_one (harc : my_is_nonarchimedean f)
  (h_nontriv : f ≠ 1) : ∃ (p : ℕ) [hp : fact (nat.prime p)], f p < 1 := sorry

def my_α (harc : my_is_nonarchimedean f) : ideal ℤ :=
{ carrier := {a : ℤ | f a < 1},
  add_mem' := sorry,
  zero_mem' := sorry,
  smul_mem' := sorry, }

lemma my_a_contains_prime_ideal (harc : my_is_nonarchimedean f) (h_nontriv : f ≠ 1) :
  ∃ (p : ℕ) [hp : fact (nat.prime p)], 𝔞 harc ≥ ideal.span {p} := sorry

lemma my_a_proper (harc : my_is_nonarchimedean f) : 𝔞 harc ≠ (⊤ : ideal ℤ) := sorry

-- Since pℤ is a maximal ideal.
lemma my_a_eq_prime_ideal (harc : my_is_nonarchimedean f) (h_nontriv : f ≠ 1) :
  ∃ (p : ℕ) [hp : fact (nat.prime p)], 𝔞 harc = ideal.span {p} := sorry

-- if now a ∈ ℤ and a = bpᵐ with p ∤ b so thta b ∈ α,
-- then f b = 1 and hence
-- f a = (f p) ^ m = (padic_norm a) ^ s
-- where s = - log (f p) / log p
lemma my_int_val_eq (harc : my_is_nonarchimedean f) (h_nontriv : f ≠ 1) :
  ∃ (p : ℕ) [hp : fact (nat.prime p)] (s : ℝ) [hs : s > 0],
    ∀ (a : ℤ), f a = (@mul_ring_norm.padic p hp a) ^ s := sorry

-- f (p / q) = f p / f q
lemma my_rat_val_eq (harc : my_is_nonarchimedean f) (h_nontriv : f ≠ 1) :
  ∃ (p : ℕ) [hp : fact (nat.prime p)] (s : ℝ) (hs : s > 0),
    ∀ (a : ℚ), f a = (@mul_ring_norm.padic p hp a) ^ s := sorry

lemma my_nonarchimedean_case (harc : is_nonarchimedean f) (h_nontriv : f ≠ 1) :
 ∃ (p : ℕ) [hp : fact (nat.prime p)],
  mul_ring_norm.equiv f (@mul_ring_norm.padic p hp) := sorry

end nonarchimedean_proof

section archimedean_proof

-- ∃ n : ℕ, f n > 1
lemma my_non_archimedean_iff_nat_norm_bound :
  is_nonarchimedean f ↔ (∀ n : ℕ, f n ≤ 1) := sorry

-- Let n₀ = min{n : ℕ | f n > 1}
variables (hf : ∃ n : ℕ, 1 < f n) {n₀ : ℕ} (dn₀ : n₀ = nat.find hf)

-- f 1 = 1
lemma one_lt_n₀ : 1 < n₀ := sorry

variables {α : ℝ} (dα : α = real.log (f n₀) / real.log n₀)

-- 1 < n₀ and 1 < f n₀
lemma α_pos : 0 < α := sorry

lemma lemma1 {n₀ : ℕ} {α : ℝ} (hf : ∃ n : ℕ, 1 < f n)
  (dn₀ : n₀ = nat.find hf) (dα : α = real.log (f n₀) / real.log n₀) :
    ∀ n : ℕ, f n ≤ n ^ α := sorry

lemma lemma2 {n₀ : ℕ} {α : ℝ} (hf : ∃ n : ℕ, 1 < f n)
  (dn₀ : n₀ = nat.find hf) (dα : α = real.log (f n₀) / real.log n₀) :
    ∀ n : ℕ, (n ^ α : ℝ) ≤ f n := sorry

lemma my_archimedean_case (hf : ¬ is_nonarchimedean f) :
  mul_ring_norm.equiv f mul_ring_norm.real := sorry

end archimedean_proof

/-- Ostrowski's Theorem -/
theorem ostrowski (f : mul_ring_norm ℚ) (hf_nontriv : f ≠ 1) :
  (mul_ring_norm.equiv f mul_ring_norm.real) ∨
  ∃ (p : ℕ) [hp : fact (nat.prime p)],
    mul_ring_norm.equiv f (@mul_ring_norm.padic p hp) :=
begin
    by_cases bdd : ∀ z : ℕ, f z ≤ 1,
    { right, /- p-adic case -/
      rw ← my_non_archimedean_iff_nat_norm_bound at bdd,
      exact my_nonarchimedean_case bdd hf_nontriv },
    { left,
      rw ← my_non_archimedean_iff_nat_norm_bound at bdd,
      exact my_archimedean_case bdd, /- Euclidean case -/ }
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fin.fin2
import data.pfun
import data.vector3
import number_theory.pell_matiyasevic

/-!
# Diophantine functions and Matiyasevic's theorem

Hilbert's tenth problem asked whether there exists an algorithm which for a given integer polynomial
determines whether this polynomial has integer solutions. It was answered in the negative in 1970,
the final step being completed by Matiyasevic who showed that the power function is Diophantine.

Here a function is called Diophantine if its graph is Diophantine as a set. A subset `S ⊆ ℕ ^ α` in
turn is called Diophantine if there exists an integer polynomial on `α ⊕ β` such that `v ∈ S` iff
there exists `t : ℕ^β` with `p (v, t) = 0`.

## Main definitions

* `is_poly`: a predicate stating that a function is a multivariate integer polynomial.
* `poly`: the type of multivariate integer polynomial functions.
* `dioph`: a predicate stating that a set is Diophantine, i.e. a set `S ⊆ ℕ^α` is
  Diophantine if there exists a polynomial on `α ⊕ β` such that `v ∈ S` iff there
  exists `t : ℕ^β` with `p (v, t) = 0`.
* `dioph_fn`: a predicate on a function stating that it is Diophantine in the sense that its graph
  is Diophantine as a set.

## Main statements

* `pell_dioph` states that solutions to Pell's equation form a Diophantine set.
* `pow_dioph` states that the power function is Diophantine, a version of Matiyasevic's theorem.

## References

* [M. Carneiro, _A Lean formalization of Matiyasevic's theorem_][carneiro2018matiyasevic]
* [M. Davis, _Hilbert's tenth problem is unsolvable_][MR317916]

## Tags

Matiyasevic's theorem, Hilbert's tenth problem

## TODO

* Finish the solution of Hilbert's tenth problem.
* Connect `poly` to `mv_polynomial`
-/

open fin2 function nat sum

local infixr ` ::ₒ `:67 := option.elim
local infixr ` ⊗ `:65 := sum.elim

universe u

/-!
### Multivariate integer polynomials

Note that this duplicates `mv_polynomial`.
-/

section polynomials
variables {α β γ : Type*}

/-- A predicate asserting that a function is a multivariate integer polynomial.
  (We are being a bit lazy here by allowing many representations for multiplication,
  rather than only allowing monomials and addition, but the definition is equivalent
  and this is easier to use.) -/
inductive is_poly : ((α → ℕ) → ℤ) → Prop
| proj : ∀ i, is_poly (λ x : α → ℕ, x i)
| const : Π (n : ℤ), is_poly (λ x : α → ℕ, n)
| sub : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λ x, f x - g x)
| mul : Π {f g : (α → ℕ) → ℤ}, is_poly f → is_poly g → is_poly (λ x, f x * g x)

lemma is_poly.neg {f : (α → ℕ) → ℤ} : is_poly f → is_poly (-f) :=
by { rw ←zero_sub, exact (is_poly.const 0).sub }

lemma is_poly.add {f g : (α → ℕ) → ℤ} (hf : is_poly f) (hg : is_poly g) : is_poly (f + g) :=
by { rw ←sub_neg_eq_add, exact hf.sub hg.neg }

/-- The type of multivariate integer polynomials -/
def poly (α : Type u) := {f : (α → ℕ) → ℤ // is_poly f}

namespace poly
section

instance fun_like : fun_like (poly α) (α → ℕ) (λ _, ℤ) := ⟨subtype.val, subtype.val_injective⟩

/-- Helper instance for when there are too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (poly α) (λ _, (α → ℕ) → ℤ) := fun_like.has_coe_to_fun

/-- The underlying function of a `poly` is a polynomial -/
protected lemma is_poly (f : poly α) : is_poly f := f.2

/-- Extensionality for `poly α` -/
@[ext] lemma ext {f g : poly α} : (∀ x, f x = g x) →  f = g := fun_like.ext _ _

/-- The `i`th projection function, `x_i`. -/
def proj (i) : poly α := ⟨_, is_poly.proj i⟩
@[simp] lemma proj_apply (i : α) (x) : proj i x = x i := rfl

/-- The constant function with value `n : ℤ`. -/
def const (n) : poly α := ⟨_, is_poly.const n⟩
@[simp] lemma const_apply (n) (x : α → ℕ) : const n x = n := rfl

instance : has_zero (poly α) := ⟨const 0⟩
instance : has_one (poly α) := ⟨const 1⟩
instance : has_neg (poly α) := ⟨λ f, ⟨-f, f.2.neg⟩⟩
instance : has_add (poly α) := ⟨λ f g, ⟨f + g, f.2.add g.2⟩⟩
instance : has_sub (poly α) := ⟨λ f g, ⟨f - g, f.2.sub g.2⟩⟩
instance : has_mul (poly α) := ⟨λ f g, ⟨f * g, f.2.mul g.2⟩⟩

@[simp] lemma coe_zero : ⇑(0 : poly α) = const 0 := rfl
@[simp]

@[simp] lemma zero_apply (x) : (0 : poly α) x = 0 := rfl
@[simp] lemma one_apply (x) : (1 : poly α) x = 1 := rfl
@[simp] lemma neg_apply (f : poly α) (x) : (-f) x = -f x := rfl
@[simp] lemma add_apply (f g : poly α) (x : α → ℕ) : (f + g) x = f x + g x := rfl
@[simp] lemma sub_apply (f g : poly α) (x : α → ℕ) : (f - g) x = f x - g x := rfl
@[simp] lemma mul_apply (f g : poly α) (x : α → ℕ) : (f * g) x = f x * g x := rfl

instance (α : Type*) : inhabited (poly α) := ⟨0⟩

instance : add_comm_group (poly α) := by refine_struct
{ add   := ((+) : poly α → poly α → poly α),
  neg   := (has_neg.neg : poly α → poly α),
  sub   := (has_sub.sub),
  zero  := 0,
  zsmul := @zsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩ ⟨has_neg.neg⟩,
  nsmul := @nsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩ };
intros; try { refl }; refine ext (λ _, _);
simp [sub_eq_add_neg, add_comm, add_assoc]

instance : add_group_with_one (poly α) :=
{ one := 1,
  nat_cast := λ n, poly.const n,
  int_cast := poly.const,
  .. poly.add_comm_group }

instance : comm_ring (poly α) := by refine_struct
{ add   := ((+) : poly α → poly α → poly α),
  zero  := 0,
  mul   := (*),
  one   := 1,
  npow  := @npow_rec _ ⟨(1 : poly α)⟩ ⟨(*)⟩,
  .. poly.add_group_with_one, .. poly.add_comm_group };
intros; try { refl }; refine ext (λ _, _);
simp [sub_eq_add_neg, mul_add, mul_left_comm, mul_comm, add_comm, add_assoc]

lemma induction {C : poly α → Prop}
  (H1 : ∀i, C (proj i)) (H2 : ∀n, C (const n))
  (H3 : ∀f g, C f → C g → C (f - g))
  (H4 : ∀f g, C f → C g → C (f * g)) (f : poly α) : C f :=
begin
  cases f with f pf,
  induction pf with i n f g pf pg ihf ihg f g pf pg ihf ihg,
  apply H1, apply H2, apply H3 _ _ ihf ihg, apply H4 _ _ ihf ihg
end

/-- The sum of squares of a list of polynomials. This is relevant for
  Diophantine equations, because it means that a list of equations
  can be encoded as a single equation: `x = 0 ∧ y = 0 ∧ z = 0` is
  equivalent to `x^2 + y^2 + z^2 = 0`. -/
def sumsq : list (poly α) → poly α
| []      := 0
| (p::ps) := p*p + sumsq ps

lemma sumsq_nonneg (x : α → ℕ) : ∀ l, 0 ≤ sumsq l x
| []      := le_refl 0
| (p::ps) := by rw sumsq; simp [-add_comm];
                exact add_nonneg (mul_self_nonneg _) (sumsq_nonneg ps)

lemma sumsq_eq_zero (x) : ∀ l, sumsq l x = 0 ↔ l.all₂ (λ a : poly α, a x = 0)
| []      := eq_self_iff_true _
| (p::ps) := by rw [list.all₂_cons, ← sumsq_eq_zero ps]; rw sumsq; simp [-add_comm]; exact
  ⟨λ (h : p x * p x + sumsq ps x = 0),
   have p x = 0, from eq_zero_of_mul_self_eq_zero $ le_antisymm
     (by rw ← h; have t := add_le_add_left (sumsq_nonneg x ps) (p x * p x); rwa [add_zero] at t)
     (mul_self_nonneg _),
   ⟨this, by simp [this] at h; exact h⟩,
  λ ⟨h1, h2⟩, by rw [h1, h2]; refl⟩

end

/-- Map the index set of variables, replacing `x_i` with `x_(f i)`. -/
def map {α β} (f : α → β) (g : poly α) : poly β :=
⟨λ v, g $ v ∘ f, g.induction
  (λ i, by simp; apply is_poly.proj)
  (λ n, by simp; apply is_poly.const)
  (λ f g pf pg, by simp; apply is_poly.sub pf pg)
  (λ f g pf pg, by simp; apply is_poly.mul pf pg)⟩
@[simp] lemma map_apply {α β} (f : α → β) (g : poly α) (v) : map f g v = g (v ∘ f) := rfl

end poly
end polynomials

/-! ### Diophantine sets -/

/-- A set `S ⊆ ℕ^α` is Diophantine if there exists a polynomial on
  `α ⊕ β` such that `v ∈ S` iff there exists `t : ℕ^β` with `p (v, t) = 0`. -/
def dioph {α : Type u} (S : set (α → ℕ)) : Prop :=
∃ {β : Type u} (p : poly (α ⊕ β)), ∀ v, S v ↔ ∃ t, p (v ⊗ t) = 0

namespace dioph
section
variables {α β γ : Type u} {S S' : set (α → ℕ)}

lemma ext (d : dioph S) (H : ∀ v, v ∈  S ↔ v ∈ S') : dioph S' := by rwa ←set.ext H

lemma of_no_dummies (S : set (α → ℕ)) (p : poly α) (h : ∀ v, S v ↔ p v = 0) : dioph S :=
⟨pempty, p.map inl, λ v, (h v).trans ⟨λ h, ⟨pempty.rec _, h⟩, λ ⟨t, ht⟩, ht⟩⟩

lemma inject_dummies_lem (f : β → γ) (g : γ → option β) (inv : ∀ x, g (f x) = some x)
  (p : poly (α ⊕ β)) (v : α → ℕ) :
  (∃ t, p (v ⊗ t) = 0) ↔ ∃ t, p.map (inl ⊗ inr ∘ f) (v ⊗ t) = 0 :=
begin
  dsimp, refine ⟨λ t, _, λ t, _⟩; cases t with t ht,
  { have : (v ⊗ (0 ::ₒ t) ∘ g) ∘ (inl ⊗ inr ∘ f) = v ⊗ t :=
    funext (λ s, by cases s with a b; dsimp [(∘)]; try {rw inv}; refl),
    exact ⟨(0 ::ₒ t) ∘ g, by rwa this⟩ },
  { have : v ⊗ t ∘ f = (v ⊗ t) ∘ (inl ⊗ inr ∘ f) :=
    funext (λ s, by cases s with a b; refl),
    exact ⟨t ∘ f, by rwa this⟩ }
end

lemma inject_dummies (f : β → γ) (g : γ → option β) (inv : ∀ x, g (f x) = some x) (p : poly (α ⊕ β))
  (h : ∀ v, S v ↔ ∃ t, p (v ⊗ t) = 0) :
  ∃ q : poly (α ⊕ γ), ∀ v, S v ↔ ∃ t, q (v ⊗ t) = 0 :=
⟨p.map (inl ⊗ (inr ∘ f)), λ v, (h v).trans $ inject_dummies_lem f g inv _ _⟩

variables (β)

lemma reindex_dioph (f : α → β) : Π (d : dioph S), dioph {v | v ∘ f ∈ S}
| ⟨γ, p, pe⟩ := ⟨γ, p.map ((inl ∘ f) ⊗ inr), λ v, (pe _).trans $ exists_congr $ λ t,
  suffices v ∘ f ⊗ t = (v ⊗ t) ∘ (inl ∘ f ⊗ inr), by simp [this],
  funext $ λ s, by cases s with a b; refl⟩

variables {β}

lemma dioph_list.all₂ (l : list (set $ α → ℕ)) (d : l.all₂ dioph) :
  dioph {v | l.all₂ (λ S : set (α → ℕ), v ∈ S)} :=
suffices ∃ β (pl : list (poly (α ⊕ β))), ∀ v,
  list.all₂ (λ S : set _, S v) l ↔ ∃ t, list.all₂ (λ p : poly (α ⊕ β), p (v ⊗ t) = 0) pl,
from let ⟨β, pl, h⟩ := this
  in ⟨β, poly.sumsq pl, λ v, (h v).trans $ exists_congr $ λ t, (poly.sumsq_eq_zero _ _).symm⟩,
begin
  induction l with S l IH,
  exact ⟨ulift empty, [], λ v, by simp; exact ⟨λ ⟨t⟩, empty.rec _ t, trivial⟩⟩,
  simp at d,
  exact let ⟨⟨β, p, pe⟩, dl⟩ := d, ⟨γ, pl, ple⟩ := IH dl in
  ⟨β ⊕ γ, p.map (inl ⊗ inr ∘ inl) :: pl.map (λ q, q.map (inl ⊗ (inr ∘ inr))), λ v,
    by simp; exact iff.trans (and_congr (pe v) (ple v))
    ⟨λ ⟨⟨m, hm⟩, ⟨n, hn⟩⟩,
      ⟨m ⊗ n, by rw [
        show (v ⊗ m ⊗ n) ∘ (inl ⊗ inr ∘ inl) = v ⊗ m,
        from funext $ λ s, by cases s with a b; refl]; exact hm,
      by { refine list.all₂.imp (λ q hq, _) hn, dsimp [(∘)],
           rw [show (λ (x : α ⊕ γ), (v ⊗ m ⊗ n) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ n,
               from funext $ λ s, by cases s with a b; refl]; exact hq }⟩,
    λ ⟨t, hl, hr⟩,
      ⟨⟨t ∘ inl, by rwa [
        show (v ⊗ t) ∘ (inl ⊗ inr ∘ inl) = v ⊗ t ∘ inl,
        from funext $ λ s, by cases s with a b; refl] at hl⟩,
      ⟨t ∘ inr, by
      { refine list.all₂.imp (λ q hq, _) hr, dsimp [(∘)] at hq,
        rwa [show (λ (x : α ⊕ γ), (v ⊗ t) ((inl ⊗ λ (x : γ), inr (inr x)) x)) = v ⊗ t ∘ inr,
             from funext $ λ s, by cases s with a b; refl] at hq }⟩⟩⟩⟩
end

lemma inter (d : dioph S) (d' : dioph S') : dioph (S ∩ S') := dioph_list.all₂ [S, S'] ⟨d, d'⟩

lemma union : ∀ (d : dioph S) (d' : dioph S'), dioph (S ∪ S')
| ⟨β, p, pe⟩ ⟨γ, q, qe⟩ := ⟨β ⊕ γ, p.map (inl ⊗ inr ∘ inl) * q.map (inl ⊗ inr ∘ inr), λ v,
  begin
    refine iff.trans (or_congr ((pe v).trans _) ((qe v).trans _))
      (exists_or_distrib.symm.trans (exists_congr $ λ t,
      (@mul_eq_zero _ _ _ (p ((v ⊗ t) ∘ (inl ⊗ inr ∘ inl)))
        (q ((v ⊗ t) ∘ (inl ⊗ inr ∘ inr)))).symm)),
    exact inject_dummies_lem _ (some ⊗ (λ _, none)) (λ x, rfl) _ _,
    exact inject_dummies_lem _ ((λ _, none) ⊗ some) (λ x, rfl) _ _,
  end⟩

/-- A partial function is Diophantine if its graph is Diophantine. -/
def dioph_pfun (f : (α → ℕ) →. ℕ) : Prop := dioph {v : option α → ℕ | f.graph (v ∘ some, v none)}

/-- A function is Diophantine if its graph is Diophantine. -/
def dioph_fn (f : (α → ℕ) → ℕ) : Prop := dioph {v : option α → ℕ | f (v ∘ some) = v none}

lemma reindex_dioph_fn {f : (α → ℕ) → ℕ} (g : α → β) (d : dioph_fn f) : dioph_fn (λ v, f (v ∘ g)) :=
by convert reindex_dioph (option β) (option.map g) d

lemma ex_dioph {S : set (α ⊕ β → ℕ)} : dioph S → dioph {v | ∃ x, v ⊗ x ∈ S}
| ⟨γ, p, pe⟩ := ⟨β ⊕ γ, p.map ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr), λ v,
  ⟨λ ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x ⊗ t, by simp; rw [
    show (v ⊗ x ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ x) ⊗ t,
    from funext $ λ s, by cases s with a b; try {cases a}; refl]; exact ht⟩,
  λ ⟨t, ht⟩, ⟨t ∘ inl, (pe _).2 ⟨t ∘ inr, by simp at ht; rwa [
    show (v ⊗ t) ∘ ((inl ⊗ inr ∘ inl) ⊗ inr ∘ inr) = (v ⊗ t ∘ inl) ⊗ t ∘ inr,
    from funext $ λ s, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

lemma ex1_dioph {S : set (option α → ℕ)} : dioph S → dioph {v | ∃ x, x ::ₒ v ∈ S}
| ⟨β, p, pe⟩ := ⟨option β, p.map (inr none ::ₒ inl ⊗ inr ∘ some), λ v,
  ⟨λ ⟨x, hx⟩, let ⟨t, ht⟩ := (pe _).1 hx in ⟨x ::ₒ t, by simp; rw [
    show (v ⊗ x ::ₒ t) ∘ (inr none ::ₒ inl ⊗ inr ∘ some) = x ::ₒ v ⊗ t,
    from funext $ λ s, by cases s with a b; try {cases a}; refl]; exact ht⟩,
  λ ⟨t, ht⟩, ⟨t none, (pe _).2 ⟨t ∘ some, by simp at ht; rwa [
    show (v ⊗ t) ∘ (inr none ::ₒ inl ⊗ inr ∘ some) = t none ::ₒ v ⊗ t ∘ some,
    from funext $ λ s, by cases s with a b; try {cases a}; refl] at ht⟩⟩⟩⟩

theorem dom_dioph {f : (α → ℕ) →. ℕ} (d : dioph_pfun f) : dioph f.dom :=
cast (congr_arg dioph $ set.ext $ λ v, (pfun.dom_iff_graph _ _).symm) (ex1_dioph d)

theorem dioph_fn_iff_pfun (f : (α → ℕ) → ℕ) : dioph_fn f = @dioph_pfun α f :=
by refine congr_arg dioph (set.ext $ λ v, _); exact pfun.lift_graph.symm

lemma abs_poly_dioph (p : poly α) : dioph_fn (λ v, (p v).nat_abs) :=
of_no_dummies _ ((p.map some - poly.proj none) * (p.map some + poly.proj none)) $ λ v,
 by { dsimp, exact int.eq_nat_abs_iff_mul_eq_zero }

theorem proj_dioph (i : α) : dioph_fn (λ v, v i) :=
abs_poly_dioph (poly.proj i)

theorem dioph_pfun_comp1 {S : set (option α → ℕ)} (d : dioph S) {f} (df : dioph_pfun f) :
  dioph {v :  α → ℕ | ∃ h : f.dom v, f.fn v h ::ₒ v ∈ S} :=
ext (ex1_dioph (d.inter df)) $ λ v,
⟨λ ⟨x, hS, (h: Exists _)⟩, by
  rw [show (x ::ₒ v) ∘ some = v, from funext $ λ s, rfl] at h;
  cases h with hf h; refine ⟨hf, _⟩; rw [pfun.fn, h]; exact hS,
λ ⟨x, hS⟩, ⟨f.fn v x, hS, show Exists _,
  by rw [show (f.fn v x ::ₒ v) ∘ some = v, from funext $ λ s, rfl]; exact ⟨x, rfl⟩⟩⟩

theorem dioph_fn_comp1 {S : set (option α → ℕ)} (d : dioph S) {f : (α → ℕ) → ℕ} (df : dioph_fn f) :
  dioph {v | f v ::ₒ v ∈ S} :=
ext (dioph_pfun_comp1 d $ cast (dioph_fn_iff_pfun f) df) $ λ v,
⟨λ ⟨_, h⟩, h, λ h, ⟨trivial, h⟩⟩

end

section
variables {α β : Type} {n : ℕ}

open vector3
open_locale vector3

local attribute [reducible] vector3

lemma dioph_fn_vec_comp1 {S : set (vector3 ℕ (succ n))} (d : dioph S) {f : vector3 ℕ n → ℕ}
  (df : dioph_fn f) :
  dioph {v : vector3 ℕ n | f v :: v ∈ S} :=
ext (dioph_fn_comp1 (reindex_dioph _ (none :: some) d) df) $ λ v,
  by { dsimp, congr', ext x, cases x; refl }

theorem vec_ex1_dioph (n) {S : set (vector3 ℕ (succ n))} (d : dioph S) :
  dioph {v : fin2 n → ℕ | ∃ x, x :: v ∈ S} :=
ext (ex1_dioph $ reindex_dioph _ (none :: some) d) $ λ v, exists_congr $ λ x, by { dsimp,
  rw [show option.elim x v ∘ cons none some = x :: v,
  from funext $ λ s, by cases s with a b; refl] }

lemma dioph_fn_vec (f : vector3 ℕ n → ℕ) : dioph_fn f ↔ dioph {v | f (v ∘ fs) = v fz} :=
⟨reindex_dioph _ (fz ::ₒ fs), reindex_dioph _ (none :: some)⟩

lemma dioph_pfun_vec (f : vector3 ℕ n →. ℕ) : dioph_pfun f ↔ dioph {v | f.graph (v ∘ fs, v fz)} :=
⟨reindex_dioph _ (fz ::ₒ fs), reindex_dioph _ (none :: some)⟩

lemma dioph_fn_compn : ∀ {n} {S : set (α ⊕ fin2 n → ℕ)} (d : dioph S)
  {f : vector3 ((α → ℕ) → ℕ) n} (df : vector_allp dioph_fn f),
  dioph {v : α → ℕ | v ⊗ (λ i, f i v) ∈ S}
| 0 S d f := λ df, ext (reindex_dioph _ (id ⊗ fin2.elim0) d) $ λ v,
  by { dsimp, congr', ext x, obtain (_ | _ | _) := x, refl }
| (succ n) S d f := f.cons_elim $ λ f fl, by simp; exact λ df dfl,
  have dioph {v |v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr ∈ S},
  from ext (dioph_fn_comp1 (reindex_dioph _ (some ∘ inl ⊗ none :: some ∘ inr) d) $
    reindex_dioph_fn inl df) $ λ v,
  by { dsimp, congr', ext x, obtain (_ | _ | _) := x; refl },
  have dioph {v | v ⊗ f v :: (λ (i : fin2 n), fl i v) ∈ S},
  from @dioph_fn_compn n (λ v, S (v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr)) this _ dfl,
  ext this $ λ v, by { dsimp, congr', ext x, obtain _ | _ | _ := x; refl }

lemma dioph_comp {S : set (vector3 ℕ n)} (d : dioph S) (f : vector3 ((α → ℕ) → ℕ) n)
  (df : vector_allp dioph_fn f) : dioph {v | (λ i, f i v) ∈ S} :=
dioph_fn_compn (reindex_dioph _ inr d) df

lemma dioph_fn_comp {f : vector3 ℕ n → ℕ} (df : dioph_fn f) (g : vector3 ((α → ℕ) → ℕ) n)
  (dg : vector_allp dioph_fn g) : dioph_fn (λ v, f (λ i, g i v)) :=
dioph_comp ((dioph_fn_vec _).1 df) ((λ v, v none) :: λ i v, g i (v ∘ some)) $
by simp; exact ⟨proj_dioph none, (vector_allp_iff_forall _ _).2 $ λ i,
  reindex_dioph_fn _ $ (vector_allp_iff_forall _ _).1 dg _⟩

localized "notation (name := dioph.inter) x ` D∧ `:35 y := dioph.inter x y" in dioph
localized "notation (name := dioph.union) x ` D∨ `:35 y := dioph.union x y" in dioph

localized "notation (name := dioph.vec_ex1_dioph) `D∃`:30 := dioph.vec_ex1_dioph" in dioph

localized "prefix (name := fin2.of_nat') `&`:max := fin2.of_nat'" in dioph
theorem proj_dioph_of_nat {n : ℕ} (m : ℕ) [is_lt m n] : dioph_fn (λ v : vector3 ℕ n, v &m) :=
proj_dioph &m
localized "prefix (name := proj_dioph_of_nat) `D&`:100 := dioph.proj_dioph_of_nat" in dioph

theorem const_dioph (n : ℕ) : dioph_fn (const (α → ℕ) n) :=
abs_poly_dioph (poly.const n)
localized "prefix (name := const_dioph) `D.`:100 := dioph.const_dioph" in dioph

variables {f g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g)
include df dg

lemma dioph_comp2 {S : ℕ → ℕ → Prop} (d : dioph (λ v:vector3 ℕ 2, S (v &0) (v &1))) :
  dioph (λ v, S (f v) (g v)) :=
dioph_comp d [f, g] (by exact ⟨df, dg⟩)

lemma dioph_fn_comp2 {h : ℕ → ℕ → ℕ} (d : dioph_fn (λ v:vector3 ℕ 2, h (v &0) (v &1))) :
  dioph_fn (λ v, h (f v) (g v)) :=
dioph_fn_comp d [f, g] (by exact ⟨df, dg⟩)

lemma eq_dioph : dioph (λ v, f v = g v) :=
dioph_comp2 df dg $ of_no_dummies _ (poly.proj &0 - poly.proj &1)
  (λ v, (int.coe_nat_eq_coe_nat_iff _ _).symm.trans
  ⟨@sub_eq_zero_of_eq ℤ _ (v &0) (v &1), eq_of_sub_eq_zero⟩)
localized "infix (name := eq_dioph) ` D= `:50 := dioph.eq_dioph" in dioph

lemma add_dioph : dioph_fn (λ v, f v + g v) :=
dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 + poly.proj &1)
localized "infix (name := add_dioph) ` D+ `:80 := dioph.add_dioph" in dioph

lemma mul_dioph : dioph_fn (λ v, f v * g v) :=
dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 * poly.proj &1)
localized "infix (name := mul_dioph) ` D* `:90 := dioph.mul_dioph" in dioph

lemma le_dioph : dioph {v | f v ≤ g v} :=
dioph_comp2 df dg $ ext (D∃2 $ D&1 D+ D&0 D= D&2) (λ v, ⟨λ ⟨x, hx⟩, le.intro hx, le.dest⟩)
localized "infix (name := le_dioph) ` D≤ `:50 := dioph.le_dioph" in dioph

lemma lt_dioph : dioph {v | f v < g v} := df D+ (D. 1) D≤ dg
localized "infix (name := lt_dioph) ` D< `:50 := dioph.lt_dioph" in dioph

lemma ne_dioph : dioph {v | f v ≠ g v} :=
ext (df D< dg D∨ dg D< df) $ λ v, by { dsimp, exact lt_or_lt_iff_ne }
localized "infix (name := ne_dioph) ` D≠ `:50 := dioph.ne_dioph" in dioph

lemma sub_dioph : dioph_fn (λ v, f v - g v) :=
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $
ext (D&1 D= D&0 D+ D&2 D∨ D&1 D≤ D&2 D∧ D&0 D= D.0) $ (vector_all_iff_forall _).1 $ λ x y z,
show (y = x + z ∨ y ≤ z ∧ x = 0) ↔ y - z = x, from
⟨λ o, begin
  rcases o with ae | ⟨yz, x0⟩,
  { rw [ae, add_tsub_cancel_right] },
  { rw [x0, tsub_eq_zero_iff_le.mpr yz] }
end, begin
  rintro rfl,
  cases le_total y z with yz zy,
  { exact or.inr ⟨yz, tsub_eq_zero_iff_le.mpr yz⟩ },
  { exact or.inl (tsub_add_cancel_of_le zy).symm },
end⟩
localized "infix (name := sub_dioph) ` D- `:80 := dioph.sub_dioph" in dioph

lemma dvd_dioph : dioph (λ v, f v ∣ g v) :=
dioph_comp (D∃2 $ D&2 D= D&1 D* D&0) [f, g] (by exact ⟨df, dg⟩)
localized "infix (name := dvd_dioph) ` D∣ `:50 := dioph.dvd_dioph" in dioph

lemma mod_dioph : dioph_fn (λ v, f v % g v) :=
have dioph (λ v : vector3 ℕ 3, (v &2 = 0 ∨ v &0 < v &2) ∧ ∃ (x : ℕ), v &0 + v &2 * x = v &1),
from (D&2 D= D.0 D∨ D&0 D< D&2) D∧ (D∃3 $ D&1 D+ D&3 D* D&0 D= D&2),
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λ z x y,
show ((y = 0 ∨ z < y) ∧ ∃ c, z + y * c = x) ↔ x % y = z, from
⟨λ ⟨h, c, hc⟩, begin rw ← hc; simp; cases h with x0 hl, rw [x0, mod_zero],
  exact mod_eq_of_lt hl end,
λ e, by rw ← e; exact ⟨or_iff_not_imp_left.2 $ λ h, mod_lt _ (nat.pos_of_ne_zero h), x / y,
  mod_add_div _ _⟩⟩

localized "infix (name := mod_dioph) ` D% `:80 := dioph.mod_dioph" in dioph

lemma modeq_dioph {h : (α → ℕ) → ℕ} (dh : dioph_fn h) : dioph (λ v, f v ≡ g v [MOD h v]) :=
df D% dh D= dg D% dh
localized "notation (name := modeq_dioph) ` D≡ ` := dioph.modeq_dioph" in dioph

lemma div_dioph : dioph_fn (λ v, f v / g v) :=
have dioph (λ v : vector3 ℕ 3, v &2 = 0 ∧ v &0 = 0 ∨ v &0 * v &2 ≤ v &1 ∧ v &1 < (v &0 + 1) * v &2),
from (D&2 D= D.0 D∧ D&0 D= D.0) D∨ D&0 D* D&2 D≤ D&1 D∧ D&1 D< (D&0 D+ D.1) D* D&2,
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ ext this $ (vector_all_iff_forall _).1 $ λ z x y,
show y = 0 ∧ z = 0 ∨ z * y ≤ x ∧ x < (z + 1) * y ↔ x / y = z,
by refine iff.trans _ eq_comm; exact y.eq_zero_or_pos.elim
  (λ y0, by rw [y0, nat.div_zero]; exact
    ⟨λ o, (o.resolve_right $ λ ⟨_, h2⟩, nat.not_lt_zero _ h2).right, λ z0, or.inl ⟨rfl, z0⟩⟩)
  (λ ypos, iff.trans ⟨λ o, o.resolve_left $ λ ⟨h1, _⟩, ne_of_gt ypos h1, or.inr⟩
    (le_antisymm_iff.trans $ and_congr (nat.le_div_iff_mul_le ypos) $
      iff.trans ⟨lt_succ_of_le, le_of_lt_succ⟩ (div_lt_iff_lt_mul ypos)).symm)
localized "infix (name := div_dioph) ` D/ `:80 := dioph.div_dioph" in dioph

omit df dg
open pell

lemma pell_dioph : dioph (λ v:vector3 ℕ 4, ∃ h : 1 < v &0,
  xn h (v &1) = v &2 ∧ yn h (v &1) = v &3) :=
have dioph {v : vector3 ℕ 4 |
1 < v &0 ∧ v &1 ≤ v &3 ∧
(v &2 = 1 ∧ v &3 = 0 ∨
∃ (u w s t b : ℕ),
  v &2 * v &2 - (v &0 * v &0 - 1) * v &3 * v &3 = 1 ∧
  u * u - (v &0 * v &0 - 1) * w * w = 1 ∧
  s * s - (b * b - 1) * t * t = 1 ∧
  1 < b ∧ (b ≡ 1 [MOD 4 * v &3]) ∧ (b ≡ v &0 [MOD u]) ∧
  0 < w ∧ v &3 * v &3 ∣ w ∧
  (s ≡ v &2 [MOD u]) ∧
  (t ≡ v &1 [MOD 4 * v &3]))}, from
D.1 D< D&0 D∧ D&1 D≤ D&3 D∧
((D&2 D= D.1 D∧ D&3 D= D.0) D∨
 (D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $
  D&7 D* D&7 D- (D&5 D* D&5 D- D.1) D* D&8 D* D&8 D= D.1 D∧
  D&4 D* D&4 D- (D&5 D* D&5 D- D.1) D* D&3 D* D&3 D= D.1 D∧
  D&2 D* D&2 D- (D&0 D* D&0 D- D.1) D* D&1 D* D&1 D= D.1 D∧
  D.1 D< D&0 D∧ (D≡ (D&0) (D.1) (D.4 D* D&8)) D∧ (D≡ (D&0) (D&5) D&4) D∧
  D.0 D< D&3 D∧ D&8 D* D&8 D∣ D&3 D∧
  (D≡ (D&2) (D&7) D&4) D∧
  (D≡ (D&1) (D&6) (D.4 D* D&8)))),
dioph.ext this $ λ v, matiyasevic.symm

lemma xn_dioph : dioph_pfun (λ v:vector3 ℕ 2, ⟨1 < v &0, λ h, xn h (v &1)⟩) :=
have dioph (λ v:vector3 ℕ 3, ∃ y, ∃ h : 1 < v &1, xn h (v &2) = v &0 ∧ yn h (v &2) = y), from
let D_pell := pell_dioph.reindex_dioph (fin2 4) [&2, &3, &1, &0] in D∃3 D_pell,
(dioph_pfun_vec _).2 $ dioph.ext this $ λ v, ⟨λ ⟨y, h, xe, ye⟩, ⟨h, xe⟩, λ ⟨h, xe⟩, ⟨_, h, xe, rfl⟩⟩

include df dg
/-- A version of **Matiyasevic's theorem** -/
theorem pow_dioph : dioph_fn (λ v, f v ^ g v) :=
have dioph {v : vector3 ℕ 3 |
v &2 = 0 ∧ v &0 = 1 ∨ 0 < v &2 ∧
(v &1 = 0 ∧ v &0 = 0 ∨ 0 < v &1 ∧
∃ (w a t z x y : ℕ),
  (∃ (a1 : 1 < a), xn a1 (v &2) = x ∧ yn a1 (v &2) = y) ∧
  (x ≡ y * (a - v &1) + v &0 [MOD t]) ∧
  2 * a * v &1 = t + (v &1 * v &1 + 1) ∧
  v &0 < t ∧ v &1 ≤ w ∧ v &2 ≤ w ∧
  a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)}, from
let D_pell := pell_dioph.reindex_dioph (fin2 9) [&4, &8, &1, &0] in
(D&2 D= D.0 D∧ D&0 D= D.1) D∨ (D.0 D< D&2 D∧
((D&1 D= D.0 D∧ D&0 D= D.0) D∨ (D.0 D< D&1 D∧
 (D∃3 $ D∃4 $ D∃5 $ D∃6 $ D∃7 $ D∃8 $ D_pell D∧
  (D≡ (D&1) (D&0 D* (D&4 D- D&7) D+ D&6) (D&3)) D∧
  D.2 D* D&4 D* D&7 D= D&3 D+ (D&7 D* D&7 D+ D.1) D∧
  D&6 D< D&3 D∧ D&7 D≤ D&5 D∧ D&8 D≤ D&5 D∧
  D&4 D* D&4 D- ((D&5 D+ D.1) D* (D&5 D+ D.1) D- D.1) D* (D&5 D* D&2) D* (D&5 D* D&2) D= D.1)))),
dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $ dioph.ext this $ λ v, iff.symm $
eq_pow_of_pell.trans $ or_congr iff.rfl $ and_congr iff.rfl $ or_congr iff.rfl $ and_congr iff.rfl $
⟨λ ⟨w, a, t, z, a1, h⟩, ⟨w, a, t, z, _, _, ⟨a1, rfl, rfl⟩, h⟩,
 λ ⟨w, a, t, z, ._, ._, ⟨a1, rfl, rfl⟩, h⟩, ⟨w, a, t, z, a1, h⟩⟩

end
end dioph


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro

! This file was ported from Lean 3 source module data.mv_polynomial.variables
! leanprover-community/mathlib commit 5120cf49cb659e2499edd7e4d336a04efd598f2f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Order
import Mathlib.Data.MvPolynomial.Rename

/-!
# Degrees and variables of polynomials

This file establishes many results about the degree and variable sets of a multivariate polynomial.

The *variable set* of a polynomial $P \in R[X]$ is a `Finset` containing each $x \in X$
that appears in a monomial in $P$.

The *degree set* of a polynomial $P \in R[X]$ is a `Multiset` containing, for each $x$ in the
variable set, $n$ copies of $x$, where $n$ is the maximum number of copies of $x$ appearing in a
monomial of $P$.

## Main declarations

* `MvPolynomial.degrees p` : the multiset of variables representing the union of the multisets
  corresponding to each non-zero monomial in `p`.
  For example if `7 ≠ 0` in `R` and `p = x²y+7y³` then `degrees p = {x, x, y, y, y}`

* `MvPolynomial.vars p` : the finset of variables occurring in `p`.
  For example if `p = x⁴y+yz` then `vars p = {x, y, z}`

* `MvPolynomial.degreeOf n p : ℕ` : the total degree of `p` with respect to the variable `n`.
  For example if `p = x⁴y+yz` then `degreeOf y p = 1`.

* `MvPolynomial.totalDegree p : ℕ` :
  the max of the sizes of the multisets `s` whose monomials `X^s` occur in `p`.
  For example if `p = x⁴y+yz` then `totalDegree p = 5`.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ τ : Type _` (indexing the variables)

+ `R : Type _` `[CommSemiring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `MvPolynomial σ R` which mathematicians might call `X^s`

+ `r : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : MvPolynomial σ R`

-/

noncomputable section

open Classical BigOperators

open Set Function Finsupp AddMonoidAlgebra

open BigOperators

universe u v w

variable {R : Type u} {S : Type v}

namespace MvPolynomial

variable {σ τ : Type _} {r : R} {e : ℕ} {n m : σ} {s : σ →₀ ℕ}

section CommSemiring

variable [CommSemiring R] {p q : MvPolynomial σ R}

section Degrees

/-! ### `degrees` -/

/-- The maximal degrees of each variable in a multi-variable polynomial, expressed as a multiset.

(For example, `degrees (x^2 * y + y^3)` would be `{x, x, y, y, y}`.)
-/
def degrees (p : MvPolynomial σ R) : Multiset σ :=
  p.support.sup fun s : σ →₀ ℕ => toMultiset s
#align mv_polynomial.degrees MvPolynomial.degrees

theorem degrees_monomial (s : σ →₀ ℕ) (a : R) : degrees (monomial s a) ≤ toMultiset s :=
  Finset.sup_le fun t h => by
    have := Finsupp.support_single_subset h
    rw [Finset.mem_singleton] at this
    rw [this]
    exact le_refl _
#align mv_polynomial.degrees_monomial MvPolynomial.degrees_monomial

theorem degrees_monomial_eq (s : σ →₀ ℕ) (a : R) (ha : a ≠ 0) :
    degrees (monomial s a) = toMultiset s :=
  le_antisymm (degrees_monomial s a) <|
    Finset.le_sup <| by rw [support_monomial, if_neg ha, Finset.mem_singleton]
#align mv_polynomial.degrees_monomial_eq MvPolynomial.degrees_monomial_eq

theorem degrees_C (a : R) : degrees (C a : MvPolynomial σ R) = 0 :=
  Multiset.le_zero.1 <| degrees_monomial _ _
set_option linter.uppercaseLean3 false in
#align mv_polynomial.degrees_C MvPolynomial.degrees_C

theorem degrees_X' (n : σ) : degrees (X n : MvPolynomial σ R) ≤ {n} :=
  le_trans (degrees_monomial _ _) <| le_of_eq <| toMultiset_single _ _
set_option linter.uppercaseLean3 false in
#align mv_polynomial.degrees_X' MvPolynomial.degrees_X'

@[simp]
theorem degrees_X [Nontrivial R] (n : σ) : degrees (X n : MvPolynomial σ R) = {n} :=
  (degrees_monomial_eq _ (1 : R) one_ne_zero).trans (toMultiset_single _ _)
set_option linter.uppercaseLean3 false in
#align mv_polynomial.degrees_X MvPolynomial.degrees_X

@[simp]
theorem degrees_zero : degrees (0 : MvPolynomial σ R) = 0 := by
  rw [← C_0]
  exact degrees_C 0
#align mv_polynomial.degrees_zero MvPolynomial.degrees_zero

@[simp]
theorem degrees_one : degrees (1 : MvPolynomial σ R) = 0 :=
  degrees_C 1
#align mv_polynomial.degrees_one MvPolynomial.degrees_one

theorem degrees_add (p q : MvPolynomial σ R) : (p + q).degrees ≤ p.degrees ⊔ q.degrees := by
  refine' Finset.sup_le fun b hb => _
  have := Finsupp.support_add hb; rw [Finset.mem_union] at this
  cases' this with h h
  · exact le_sup_of_le_left (Finset.le_sup h)
  · exact le_sup_of_le_right (Finset.le_sup h)
#align mv_polynomial.degrees_add MvPolynomial.degrees_add

theorem degrees_sum {ι : Type _} (s : Finset ι) (f : ι → MvPolynomial σ R) :
    (∑ i in s, f i).degrees ≤ s.sup fun i => (f i).degrees := by
  refine' s.induction _ _
  · simp only [Finset.sum_empty, Finset.sup_empty, degrees_zero]
    exact le_rfl
  · intro i s his ih
    rw [Finset.sup_insert, Finset.sum_insert his]
    exact le_trans (degrees_add _ _) (sup_le_sup_left ih _)
#align mv_polynomial.degrees_sum MvPolynomial.degrees_sum

theorem degrees_mul (p q : MvPolynomial σ R) : (p * q).degrees ≤ p.degrees + q.degrees := by
  refine' Finset.sup_le fun b hb => _
  have := support_mul p q hb
  simp only [Finset.mem_bunionᵢ, Finset.mem_singleton] at this
  rcases this with ⟨a₁, h₁, a₂, h₂, rfl⟩
  rw [Finsupp.toMultiset_add]
  exact add_le_add (Finset.le_sup h₁) (Finset.le_sup h₂)
#align mv_polynomial.degrees_mul MvPolynomial.degrees_mul

theorem degrees_prod {ι : Type _} (s : Finset ι) (f : ι → MvPolynomial σ R) :
    (∏ i in s, f i).degrees ≤ ∑ i in s, (f i).degrees := by
  refine' s.induction _ _
  · simp only [Finset.prod_empty, Finset.sum_empty, degrees_one, le_refl]
  · intro i s his ih
    rw [Finset.prod_insert his, Finset.sum_insert his]
    exact le_trans (degrees_mul _ _) (add_le_add_left ih _)
#align mv_polynomial.degrees_prod MvPolynomial.degrees_prod

theorem degrees_pow (p : MvPolynomial σ R) : ∀ n : ℕ, (p ^ n).degrees ≤ n • p.degrees
  | 0 => by rw [pow_zero, degrees_one]; exact Multiset.zero_le _
  | n + 1 => by
    rw [pow_succ, add_smul, add_comm, one_smul]
    exact le_trans (degrees_mul _ _) (add_le_add_left (degrees_pow _ n) _)
#align mv_polynomial.degrees_pow MvPolynomial.degrees_pow

theorem mem_degrees {p : MvPolynomial σ R} {i : σ} :
    i ∈ p.degrees ↔ ∃ d, p.coeff d ≠ 0 ∧ i ∈ d.support := by
  simp only [degrees, Multiset.mem_sup, ← mem_support_iff, Finsupp.mem_toMultiset, exists_prop]
#align mv_polynomial.mem_degrees MvPolynomial.mem_degrees

theorem le_degrees_add {p q : MvPolynomial σ R} (h : p.degrees.Disjoint q.degrees) :
    p.degrees ≤ (p + q).degrees := by
  apply Finset.sup_le
  intro d hd
  rw [Multiset.disjoint_iff_ne] at h
  rw [Multiset.le_iff_count]
  intro i
  rw [degrees, Multiset.count_finset_sup]
  simp only [Finsupp.count_toMultiset]
  by_cases h0 : d = 0
  · simp only [h0, zero_le, Finsupp.zero_apply]
  · refine' @Finset.le_sup _ _ _ _ (p + q).support (fun a => a i) d _
    rw [mem_support_iff, coeff_add]
    suffices q.coeff d = 0 by rwa [this, add_zero, coeff, ← Finsupp.mem_support_iff]
    rw [← Finsupp.support_eq_empty, ← Ne.def, ← Finset.nonempty_iff_ne_empty] at h0
    obtain ⟨j, hj⟩ := h0
    contrapose! h
    rw [mem_support_iff] at hd
    refine' ⟨j, _, j, _, rfl⟩
    all_goals rw [mem_degrees]; refine' ⟨d, _, hj⟩; assumption
#align mv_polynomial.le_degrees_add MvPolynomial.le_degrees_add

theorem degrees_add_of_disjoint {p q : MvPolynomial σ R}
    (h : Multiset.Disjoint p.degrees q.degrees) : (p + q).degrees = p.degrees ∪ q.degrees := by
  apply le_antisymm
  · apply degrees_add
  · apply Multiset.union_le
    · apply le_degrees_add h
    · rw [add_comm]
      apply le_degrees_add h.symm
#align mv_polynomial.degrees_add_of_disjoint MvPolynomial.degrees_add_of_disjoint

theorem degrees_map [CommSemiring S] (p : MvPolynomial σ R) (f : R →+* S) :
    (map f p).degrees ⊆ p.degrees := by
  dsimp only [degrees]
  apply Multiset.subset_of_le
  apply Finset.sup_mono
  apply MvPolynomial.support_map_subset
#align mv_polynomial.degrees_map MvPolynomial.degrees_map

theorem degrees_rename (f : σ → τ) (φ : MvPolynomial σ R) :
    (rename f φ).degrees ⊆ φ.degrees.map f := by
  intro i
  rw [mem_degrees, Multiset.mem_map]
  rintro ⟨d, hd, hi⟩
  obtain ⟨x, rfl, hx⟩ := coeff_rename_ne_zero _ _ _ hd
  simp only [Finsupp.mapDomain, Finsupp.mem_support_iff] at hi
  rw [sum_apply, Finsupp.sum] at hi
  contrapose! hi
  rw [Finset.sum_eq_zero]
  intro j hj
  simp only [exists_prop, mem_degrees] at hi
  specialize hi j ⟨x, hx, hj⟩
  rw [Finsupp.single_apply, if_neg hi]
#align mv_polynomial.degrees_rename MvPolynomial.degrees_rename

theorem degrees_map_of_injective [CommSemiring S] (p : MvPolynomial σ R) {f : R →+* S}
    (hf : Injective f) : (map f p).degrees = p.degrees := by
  simp only [degrees, MvPolynomial.support_map_of_injective _ hf]
#align mv_polynomial.degrees_map_of_injective MvPolynomial.degrees_map_of_injective

theorem degrees_rename_of_injective {p : MvPolynomial σ R} {f : σ → τ} (h : Function.Injective f) :
    degrees (rename f p) = (degrees p).map f := by
  simp only [degrees, Multiset.map_finset_sup p.support Finsupp.toMultiset f h,
    support_rename_of_injective h, Finset.sup_image]
  refine' Finset.sup_congr rfl fun x _ => _
  exact (Finsupp.toMultiset_map _ _).symm
#align mv_polynomial.degrees_rename_of_injective MvPolynomial.degrees_rename_of_injective

end Degrees

section Vars

/-! ### `vars` -/

/-- `vars p` is the set of variables appearing in the polynomial `p` -/
def vars (p : MvPolynomial σ R) : Finset σ :=
  p.degrees.toFinset
#align mv_polynomial.vars MvPolynomial.vars

@[simp]
theorem vars_0 : (0 : MvPolynomial σ R).vars = ∅ := by
  rw [vars, degrees_zero, Multiset.toFinset_zero]
#align mv_polynomial.vars_0 MvPolynomial.vars_0

@[simp]
theorem vars_monomial (h : r ≠ 0) : (monomial s r).vars = s.support := by
  rw [vars, degrees_monomial_eq _ _ h, Finsupp.toFinset_toMultiset]
#align mv_polynomial.vars_monomial MvPolynomial.vars_monomial

@[simp]
theorem vars_C : (C r : MvPolynomial σ R).vars = ∅ := by
  rw [vars, degrees_C, Multiset.toFinset_zero]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.vars_C MvPolynomial.vars_C

@[simp]
theorem vars_X [Nontrivial R] : (X n : MvPolynomial σ R).vars = {n} := by
  rw [X, vars_monomial (one_ne_zero' R), Finsupp.support_single_ne_zero _ (one_ne_zero' ℕ)]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.vars_X MvPolynomial.vars_X

theorem mem_vars (i : σ) : i ∈ p.vars ↔ ∃ (d : σ →₀ ℕ) (_ : d ∈ p.support), i ∈ d.support := by
  simp only [vars, Multiset.mem_toFinset, mem_degrees, mem_support_iff, exists_prop]
#align mv_polynomial.mem_vars MvPolynomial.mem_vars

theorem mem_support_not_mem_vars_zero {f : MvPolynomial σ R} {x : σ →₀ ℕ} (H : x ∈ f.support)
    {v : σ} (h : v ∉ vars f) : x v = 0 := by
  rw [vars, Multiset.mem_toFinset] at h
  rw [← Finsupp.not_mem_support_iff]
  contrapose! h
  unfold degrees
  rw [show f.support = insert x f.support from Eq.symm <| Finset.insert_eq_of_mem H]
  rw [Finset.sup_insert]
  simp only [Multiset.mem_union, Multiset.sup_eq_union]
  left
  rwa [← toFinset_toMultiset, Multiset.mem_toFinset] at h
#align mv_polynomial.mem_support_not_mem_vars_zero MvPolynomial.mem_support_not_mem_vars_zero

theorem vars_add_subset (p q : MvPolynomial σ R) : (p + q).vars ⊆ p.vars ∪ q.vars := by
  intro x hx
  simp only [vars, Finset.mem_union, Multiset.mem_toFinset] at hx⊢
  simpa using Multiset.mem_of_le (degrees_add _ _) hx
#align mv_polynomial.vars_add_subset MvPolynomial.vars_add_subset

theorem vars_add_of_disjoint (h : Disjoint p.vars q.vars) : (p + q).vars = p.vars ∪ q.vars := by
  apply Finset.Subset.antisymm (vars_add_subset p q)
  intro x hx
  simp only [vars, Multiset.disjoint_toFinset] at h hx⊢
  rw [degrees_add_of_disjoint h, Multiset.toFinset_union]
  exact hx
#align mv_polynomial.vars_add_of_disjoint MvPolynomial.vars_add_of_disjoint

section Mul

theorem vars_mul (φ ψ : MvPolynomial σ R) : (φ * ψ).vars ⊆ φ.vars ∪ ψ.vars := by
  intro i
  simp only [mem_vars, Finset.mem_union]
  rintro ⟨d, hd, hi⟩
  rw [mem_support_iff, coeff_mul] at hd
  contrapose! hd
  cases hd
  rw [Finset.sum_eq_zero]
  rintro ⟨d₁, d₂⟩ H
  rw [Finsupp.mem_antidiagonal] at H
  subst H
  obtain H | H : i ∈ d₁.support ∨ i ∈ d₂.support := by
    simpa only [Finset.mem_union] using Finsupp.support_add hi
  · suffices coeff d₁ φ = 0 by simp [this]
    rw [coeff, ← Finsupp.not_mem_support_iff]
    intro
    solve_by_elim
  · suffices coeff d₂ ψ = 0 by simp [this]
    rw [coeff, ← Finsupp.not_mem_support_iff]
    intro
    solve_by_elim
#align mv_polynomial.vars_mul MvPolynomial.vars_mul

@[simp]
theorem vars_one : (1 : MvPolynomial σ R).vars = ∅ :=
  vars_C
#align mv_polynomial.vars_one MvPolynomial.vars_one

theorem vars_pow (φ : MvPolynomial σ R) (n : ℕ) : (φ ^ n).vars ⊆ φ.vars := by
  induction' n with n ih
  · simp
  · rw [pow_succ]
    apply Finset.Subset.trans (vars_mul _ _)
    exact Finset.union_subset (Finset.Subset.refl _) ih
#align mv_polynomial.vars_pow MvPolynomial.vars_pow

/-- The variables of the product of a family of polynomials
are a subset of the union of the sets of variables of each polynomial.
-/
theorem vars_prod {ι : Type _} {s : Finset ι} (f : ι → MvPolynomial σ R) :
    (∏ i in s, f i).vars ⊆ s.bunionᵢ fun i => (f i).vars := by
  induction s using Finset.induction_on with
  | empty => simp
  | insert hs hsub =>
    simp only [hs, Finset.bunionᵢ_insert, Finset.prod_insert, not_false_iff]
    apply Finset.Subset.trans (vars_mul _ _)
    exact Finset.union_subset_union (Finset.Subset.refl _) hsub
#align mv_polynomial.vars_prod MvPolynomial.vars_prod

section IsDomain

variable {A : Type _} [CommRing A] [IsDomain A]

theorem vars_C_mul (a : A) (ha : a ≠ 0) (φ : MvPolynomial σ A) :
    (C a * φ : MvPolynomial σ A).vars = φ.vars := by
  ext1 i
  simp only [mem_vars, exists_prop, mem_support_iff]
  apply exists_congr
  intro d
  apply and_congr _ Iff.rfl
  rw [coeff_C_mul, mul_ne_zero_iff, eq_true ha, true_and_iff]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.vars_C_mul MvPolynomial.vars_C_mul

end IsDomain

end Mul

section Sum

variable {ι : Type _} (t : Finset ι) (φ : ι → MvPolynomial σ R)

theorem vars_sum_subset : (∑ i in t, φ i).vars ⊆ Finset.bunionᵢ t fun i => (φ i).vars := by
  induction t using Finset.induction_on with
  | empty => simp
  | insert has hsum =>
    rw [Finset.bunionᵢ_insert, Finset.sum_insert has]
    refine'
      Finset.Subset.trans (vars_add_subset _ _) (Finset.union_subset_union (Finset.Subset.refl _) _)
    assumption
#align mv_polynomial.vars_sum_subset MvPolynomial.vars_sum_subset

theorem vars_sum_of_disjoint (h : Pairwise <| (Disjoint on fun i => (φ i).vars)) :
    (∑ i in t, φ i).vars = Finset.bunionᵢ t fun i => (φ i).vars := by
  induction t using Finset.induction_on with
  | empty => simp
  | insert has hsum =>
    rw [Finset.bunionᵢ_insert, Finset.sum_insert has, vars_add_of_disjoint, hsum]
    unfold Pairwise onFun at h
    rw [hsum]
    simp only [Finset.disjoint_iff_ne] at h⊢
    intro v hv v2 hv2
    rw [Finset.mem_bunionᵢ] at hv2
    rcases hv2 with ⟨i, his, hi⟩
    refine' h _ _ hv _ hi
    rintro rfl
    contradiction
#align mv_polynomial.vars_sum_of_disjoint MvPolynomial.vars_sum_of_disjoint

end Sum

section Map

variable [CommSemiring S] (f : R →+* S)

variable (p)

theorem vars_map : (map f p).vars ⊆ p.vars := by simp [vars, degrees_map]
#align mv_polynomial.vars_map MvPolynomial.vars_map

variable {f}

theorem vars_map_of_injective (hf : Injective f) : (map f p).vars = p.vars := by
  simp [vars, degrees_map_of_injective _ hf]
#align mv_polynomial.vars_map_of_injective MvPolynomial.vars_map_of_injective

theorem vars_monomial_single (i : σ) {e : ℕ} {r : R} (he : e ≠ 0) (hr : r ≠ 0) :
    (monomial (Finsupp.single i e) r).vars = {i} := by
  rw [vars_monomial hr, Finsupp.support_single_ne_zero _ he]
#align mv_polynomial.vars_monomial_single MvPolynomial.vars_monomial_single

theorem vars_eq_support_bunionᵢ_support : p.vars = p.support.bunionᵢ Finsupp.support := by
  ext i
  rw [mem_vars, Finset.mem_bunionᵢ]
  simp
#align mv_polynomial.vars_eq_support_bUnion_support MvPolynomial.vars_eq_support_bunionᵢ_support

end Map

end Vars

section DegreeOf

/-! ### `degreeOf` -/

/-- `degreeOf n p` gives the highest power of X_n that appears in `p` -/
def degreeOf (n : σ) (p : MvPolynomial σ R) : ℕ :=
  p.degrees.count n
#align mv_polynomial.degree_of MvPolynomial.degreeOf

theorem degreeOf_eq_sup (n : σ) (f : MvPolynomial σ R) :
    degreeOf n f = f.support.sup fun m => m n := by
  rw [degreeOf, degrees, Multiset.count_finset_sup]
  congr
  ext
  simp
#align mv_polynomial.degree_of_eq_sup MvPolynomial.degreeOf_eq_sup

theorem degreeOf_lt_iff {n : σ} {f : MvPolynomial σ R} {d : ℕ} (h : 0 < d) :
    degreeOf n f < d ↔ ∀ m : σ →₀ ℕ, m ∈ f.support → m n < d := by
  rwa [degreeOf_eq_sup n f, Finset.sup_lt_iff]
#align mv_polynomial.degree_of_lt_iff MvPolynomial.degreeOf_lt_iff

@[simp]
theorem degreeOf_zero (n : σ) : degreeOf n (0 : MvPolynomial σ R) = 0 := by
  simp only [degreeOf, degrees_zero, Multiset.count_zero]
#align mv_polynomial.degree_of_zero MvPolynomial.degreeOf_zero

@[simp]
theorem degreeOf_C (a : R) (x : σ) : degreeOf x (C a : MvPolynomial σ R) = 0 := by
  simp [degreeOf, degrees_C]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.degree_of_C MvPolynomial.degreeOf_C

theorem degreeOf_X (i j : σ) [Nontrivial R] :
    degreeOf i (X j : MvPolynomial σ R) = if i = j then 1 else 0 := by
  by_cases c : i = j
  · simp only [c, if_true, eq_self_iff_true, degreeOf, degrees_X, Multiset.count_singleton]
  simp [c, if_false, degreeOf, degrees_X]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.degree_of_X MvPolynomial.degreeOf_X

theorem degreeOf_add_le (n : σ) (f g : MvPolynomial σ R) :
    degreeOf n (f + g) ≤ max (degreeOf n f) (degreeOf n g) := by
  repeat' rw [degreeOf]
  apply (Multiset.count_le_of_le n (degrees_add f g)).trans
  dsimp
  rw [Multiset.count_union]
#align mv_polynomial.degree_of_add_le MvPolynomial.degreeOf_add_le

theorem monomial_le_degreeOf (i : σ) {f : MvPolynomial σ R} {m : σ →₀ ℕ} (h_m : m ∈ f.support) :
    m i ≤ degreeOf i f := by
  rw [degreeOf_eq_sup i]
  apply Finset.le_sup h_m
#align mv_polynomial.monomial_le_degree_of MvPolynomial.monomial_le_degreeOf

-- TODO we can prove equality here if R is a domain
theorem degreeOf_mul_le (i : σ) (f g : MvPolynomial σ R) :
    degreeOf i (f * g) ≤ degreeOf i f + degreeOf i g := by
  repeat' rw [degreeOf]
  convert Multiset.count_le_of_le i (degrees_mul f g)
  rw [Multiset.count_add]
#align mv_polynomial.degree_of_mul_le MvPolynomial.degreeOf_mul_le

theorem degreeOf_mul_X_ne {i j : σ} (f : MvPolynomial σ R) (h : i ≠ j) :
    degreeOf i (f * X j) = degreeOf i f := by
  repeat' rw [degreeOf_eq_sup (R:=R) i]
  rw [support_mul_X]
  simp only [Finset.sup_map]
  congr
  ext
  simp only [Finsupp.single, Nat.one_ne_zero, add_right_eq_self, addRightEmbedding_apply, coe_mk,
    Pi.add_apply, comp_apply, ite_eq_right_iff, Finsupp.coe_add, Pi.single_eq_of_ne h]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.degree_of_mul_X_ne MvPolynomial.degreeOf_mul_X_ne

-- TODO in the following we have equality iff f ≠ 0
theorem degreeOf_mul_X_eq (j : σ) (f : MvPolynomial σ R) :
    degreeOf j (f * X j) ≤ degreeOf j f + 1 := by
  repeat' rw [degreeOf]
  apply (Multiset.count_le_of_le j (degrees_mul f (X j))).trans
  simp only [Multiset.count_add, add_le_add_iff_left]
  convert Multiset.count_le_of_le j (degrees_X' (R:=R) j)
  rw [Multiset.count_singleton_self]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.degree_of_mul_X_eq MvPolynomial.degreeOf_mul_X_eq

theorem degreeOf_rename_of_injective {p : MvPolynomial σ R} {f : σ → τ} (h : Function.Injective f)
    (i : σ) : degreeOf (f i) (rename f p) = degreeOf i p := by
  simp only [degreeOf, degrees_rename_of_injective h, Multiset.count_map_eq_count' f p.degrees h]
#align mv_polynomial.degree_of_rename_of_injective MvPolynomial.degreeOf_rename_of_injective

end DegreeOf

section TotalDegree

/-! ### `totalDegree` -/

/-- `totalDegree p` gives the maximum |s| over the monomials X^s in `p` -/
def totalDegree (p : MvPolynomial σ R) : ℕ :=
  p.support.sup fun s => s.sum fun _ e => e
#align mv_polynomial.total_degree MvPolynomial.totalDegree

theorem totalDegree_eq (p : MvPolynomial σ R) :
    p.totalDegree = p.support.sup fun m => Multiset.card (toMultiset m) := by
  rw [totalDegree]
  congr ; funext m
  exact (Finsupp.card_toMultiset _).symm
#align mv_polynomial.total_degree_eq MvPolynomial.totalDegree_eq

theorem le_totalDegree {p : MvPolynomial σ R} {s : σ →₀ ℕ} (h : s ∈ p.support) :
    (s.sum fun _ e => e) ≤ totalDegree p :=
  Finset.le_sup (α := ℕ) (f := fun s => sum s fun _ e => e) h

theorem totalDegree_le_degrees_card (p : MvPolynomial σ R) :
    p.totalDegree ≤ Multiset.card p.degrees := by
  rw [totalDegree_eq]
  exact Finset.sup_le fun s hs => Multiset.card_le_of_le <| Finset.le_sup hs
#align mv_polynomial.total_degree_le_degrees_card MvPolynomial.totalDegree_le_degrees_card

@[simp]
theorem totalDegree_C (a : R) : (C a : MvPolynomial σ R).totalDegree = 0 :=
  Nat.eq_zero_of_le_zero <|
    Finset.sup_le fun n hn => by
      have := Finsupp.support_single_subset hn
      rw [Finset.mem_singleton] at this
      subst this
      exact le_rfl
set_option linter.uppercaseLean3 false in
#align mv_polynomial.total_degree_C MvPolynomial.totalDegree_C

@[simp]
theorem totalDegree_zero : (0 : MvPolynomial σ R).totalDegree = 0 := by
  rw [← C_0]; exact totalDegree_C (0 : R)
#align mv_polynomial.total_degree_zero MvPolynomial.totalDegree_zero

@[simp]
theorem totalDegree_one : (1 : MvPolynomial σ R).totalDegree = 0 :=
  totalDegree_C (1 : R)
#align mv_polynomial.total_degree_one MvPolynomial.totalDegree_one

@[simp]
theorem totalDegree_X {R} [CommSemiring R] [Nontrivial R] (s : σ) :
    (X s : MvPolynomial σ R).totalDegree = 1 := by
  rw [totalDegree, support_X]
  simp only [Finset.sup, Finsupp.sum_single_index, Finset.fold_singleton, sup_bot_eq]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.total_degree_X MvPolynomial.totalDegree_X

theorem totalDegree_add (a b : MvPolynomial σ R) :
    (a + b).totalDegree ≤ max a.totalDegree b.totalDegree :=
  Finset.sup_le fun n hn => by
    have := Finsupp.support_add hn
    rw [Finset.mem_union] at this
    cases' this with h h
    · exact le_max_of_le_left (le_totalDegree h)
    · exact le_max_of_le_right (le_totalDegree h)
#align mv_polynomial.total_degree_add MvPolynomial.totalDegree_add

theorem totalDegree_add_eq_left_of_totalDegree_lt {p q : MvPolynomial σ R}
    (h : q.totalDegree < p.totalDegree) : (p + q).totalDegree = p.totalDegree := by
  classical
    apply le_antisymm
    · rw [← max_eq_left_of_lt h]
      exact totalDegree_add p q
    by_cases hp : p = 0
    · simp [hp]
    obtain ⟨b, hb₁, hb₂⟩ :=
      p.support.exists_mem_eq_sup (Finsupp.support_nonempty_iff.mpr hp) fun m : σ →₀ ℕ =>
        Multiset.card (toMultiset m)
    have hb : ¬b ∈ q.support := by
      contrapose! h
      rw [totalDegree_eq p, hb₂, totalDegree_eq]
      apply Finset.le_sup h
    have hbb : b ∈ (p + q).support :=
      by
      apply support_sdiff_support_subset_support_add
      rw [Finset.mem_sdiff]
      exact ⟨hb₁, hb⟩
    rw [totalDegree_eq, hb₂, totalDegree_eq]
    exact Finset.le_sup (f := fun m => Multiset.card (Finsupp.toMultiset m)) hbb
#align mv_polynomial.total_degree_add_eq_left_of_total_degree_lt MvPolynomial.totalDegree_add_eq_left_of_totalDegree_lt

theorem totalDegree_add_eq_right_of_totalDegree_lt {p q : MvPolynomial σ R}
    (h : q.totalDegree < p.totalDegree) : (q + p).totalDegree = p.totalDegree := by
  rw [add_comm, totalDegree_add_eq_left_of_totalDegree_lt h]
#align mv_polynomial.total_degree_add_eq_right_of_total_degree_lt MvPolynomial.totalDegree_add_eq_right_of_totalDegree_lt

theorem totalDegree_mul (a b : MvPolynomial σ R) :
    (a * b).totalDegree ≤ a.totalDegree + b.totalDegree :=
  Finset.sup_le fun n hn => by
    have := AddMonoidAlgebra.support_mul a b hn
    simp only [Finset.mem_bunionᵢ, Finset.mem_singleton] at this
    rcases this with ⟨a₁, h₁, a₂, h₂, rfl⟩
    rw [Finsupp.sum_add_index']
    · dsimp [totalDegree]
      exact add_le_add (le_totalDegree h₁) (le_totalDegree h₂)
    · intro _
      rfl
    · intro _ b₁ b₂
      rfl
#align mv_polynomial.total_degree_mul MvPolynomial.totalDegree_mul

theorem totalDegree_smul_le [CommSemiring S] [DistribMulAction R S] (a : R) (f : MvPolynomial σ S) :
    (a • f).totalDegree ≤ f.totalDegree :=
  Finset.sup_mono support_smul
#align mv_polynomial.total_degree_smul_le MvPolynomial.totalDegree_smul_le

theorem totalDegree_pow (a : MvPolynomial σ R) (n : ℕ) : (a ^ n).totalDegree ≤ n * a.totalDegree :=
  by
  induction' n with n ih
  · simp only [Nat.zero_eq, MulZeroClass.zero_mul, pow_zero, totalDegree_one]
  rw [pow_succ]
  calc
    totalDegree (a * a ^ n) ≤ a.totalDegree + (a ^ n).totalDegree := totalDegree_mul _ _
    _ ≤ a.totalDegree + n * a.totalDegree := (add_le_add_left ih _)
    _ = (n + 1) * a.totalDegree := by rw [add_mul, one_mul, add_comm]

#align mv_polynomial.total_degree_pow MvPolynomial.totalDegree_pow

@[simp]
theorem totalDegree_monomial (s : σ →₀ ℕ) {c : R} (hc : c ≠ 0) :
    (monomial s c : MvPolynomial σ R).totalDegree = s.sum fun _ e => e := by
  simp [totalDegree, support_monomial, if_neg hc]
#align mv_polynomial.total_degree_monomial MvPolynomial.totalDegree_monomial

@[simp]
theorem totalDegree_X_pow [Nontrivial R] (s : σ) (n : ℕ) :
    (X s ^ n : MvPolynomial σ R).totalDegree = n := by simp [X_pow_eq_monomial, one_ne_zero]
set_option linter.uppercaseLean3 false in
#align mv_polynomial.total_degree_X_pow MvPolynomial.totalDegree_X_pow

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem totalDegree_list_prod :
    ∀ s : List (MvPolynomial σ R), s.prod.totalDegree ≤ (s.map MvPolynomial.totalDegree).sum
  | [] => by rw [@List.prod_nil (MvPolynomial σ R) _, totalDegree_one]; rfl
  | p::ps => by
    rw [@List.prod_cons (MvPolynomial σ R) _, List.map, List.sum_cons]
    exact le_trans (totalDegree_mul _ _) (add_le_add_left (totalDegree_list_prod ps) _)
#align mv_polynomial.total_degree_list_prod MvPolynomial.totalDegree_list_prod

theorem totalDegree_multiset_prod (s : Multiset (MvPolynomial σ R)) :
    s.prod.totalDegree ≤ (s.map MvPolynomial.totalDegree).sum := by
  refine' Quotient.inductionOn s fun l => _
  rw [Multiset.quot_mk_to_coe, Multiset.coe_prod, Multiset.coe_map, Multiset.coe_sum]
  exact totalDegree_list_prod l
#align mv_polynomial.total_degree_multiset_prod MvPolynomial.totalDegree_multiset_prod

theorem totalDegree_finset_prod {ι : Type _} (s : Finset ι) (f : ι → MvPolynomial σ R) :
    (s.prod f).totalDegree ≤ ∑ i in s, (f i).totalDegree := by
  refine' le_trans (totalDegree_multiset_prod _) _
  rw [Multiset.map_map]
  rfl
#align mv_polynomial.total_degree_finset_prod MvPolynomial.totalDegree_finset_prod

theorem exists_degree_lt [Fintype σ] (f : MvPolynomial σ R) (n : ℕ)
    (h : f.totalDegree < n * Fintype.card σ) {d : σ →₀ ℕ} (hd : d ∈ f.support) : ∃ i, d i < n := by
  contrapose! h
  calc
    n * Fintype.card σ = ∑ _s : σ, n := by
      rw [Finset.sum_const, Nat.nsmul_eq_mul, mul_comm, Finset.card_univ]
    _ ≤ ∑ s, d s := (Finset.sum_le_sum fun s _ => h s)
    _ ≤ d.sum fun _ e => e := by
      rw [Finsupp.sum_fintype]
      intros
      rfl
    _ ≤ f.totalDegree := le_totalDegree hd

#align mv_polynomial.exists_degree_lt MvPolynomial.exists_degree_lt

theorem coeff_eq_zero_of_totalDegree_lt {f : MvPolynomial σ R} {d : σ →₀ ℕ}
    (h : f.totalDegree < ∑ i in d.support, d i) : coeff d f = 0 := by
  classical
    rw [totalDegree, Finset.sup_lt_iff] at h
    · specialize h d
      rw [mem_support_iff] at h
      refine' not_not.mp (mt h _)
      exact lt_irrefl _
    · exact lt_of_le_of_lt (Nat.zero_le _) h
#align mv_polynomial.coeff_eq_zero_of_total_degree_lt MvPolynomial.coeff_eq_zero_of_totalDegree_lt

theorem totalDegree_rename_le (f : σ → τ) (p : MvPolynomial σ R) :
    (rename f p).totalDegree ≤ p.totalDegree :=
  Finset.sup_le fun b => by
    intro h
    rw [rename_eq] at h
    have h' := Finsupp.mapDomain_support h
    rw [Finset.mem_image] at h'
    rcases h' with ⟨s, hs, rfl⟩
    rw [Finsupp.sum_mapDomain_index]
    exact le_trans le_rfl (le_totalDegree hs)
    exact fun _ => rfl
    exact fun _ _ _ => rfl
#align mv_polynomial.total_degree_rename_le MvPolynomial.totalDegree_rename_le

end TotalDegree

section EvalVars

/-! ### `vars` and `eval` -/

variable [CommSemiring S]

theorem eval₂Hom_eq_constantCoeff_of_vars (f : R →+* S) {g : σ → S} {p : MvPolynomial σ R}
    (hp : ∀ i ∈ p.vars, g i = 0) : eval₂Hom f g p = f (constantCoeff p) := by
  conv_lhs => rw [p.as_sum]
  simp only [map_sum, eval₂Hom_monomial]
  by_cases h0 : constantCoeff p = 0
  on_goal 1 =>
    rw [h0, f.map_zero, Finset.sum_eq_zero]
    intro d hd
  on_goal 2 =>
    rw [Finset.sum_eq_single (0 : σ →₀ ℕ)]
    · rw [Finsupp.prod_zero_index, mul_one]
      rfl
    intro d hd hd0
  on_goal 3 =>
    rw [constantCoeff_eq, coeff, ← Ne.def, ← Finsupp.mem_support_iff] at h0
    intro
    contradiction
  repeat'
    obtain ⟨i, hi⟩ : Finset.Nonempty (Finsupp.support d) :=
      by
      rw [constantCoeff_eq, coeff, ← Finsupp.not_mem_support_iff] at h0
      rw [Finset.nonempty_iff_ne_empty, Ne.def, Finsupp.support_eq_empty]
      rintro rfl
      contradiction
    rw [Finsupp.prod, Finset.prod_eq_zero hi, MulZeroClass.mul_zero]
    rw [hp, zero_pow (Nat.pos_of_ne_zero <| Finsupp.mem_support_iff.mp hi)]
    rw [mem_vars]
    exact ⟨d, hd, hi⟩
#align mv_polynomial.eval₂_hom_eq_constant_coeff_of_vars MvPolynomial.eval₂Hom_eq_constantCoeff_of_vars

theorem aeval_eq_constantCoeff_of_vars [Algebra R S] {g : σ → S} {p : MvPolynomial σ R}
    (hp : ∀ i ∈ p.vars, g i = 0) : aeval g p = algebraMap _ _ (constantCoeff p) :=
  eval₂Hom_eq_constantCoeff_of_vars _ hp
#align mv_polynomial.aeval_eq_constant_coeff_of_vars MvPolynomial.aeval_eq_constantCoeff_of_vars

theorem eval₂Hom_congr' {f₁ f₂ : R →+* S} {g₁ g₂ : σ → S} {p₁ p₂ : MvPolynomial σ R} :
    f₁ = f₂ →
      (∀ i, i ∈ p₁.vars → i ∈ p₂.vars → g₁ i = g₂ i) →
        p₁ = p₂ → eval₂Hom f₁ g₁ p₁ = eval₂Hom f₂ g₂ p₂ := by
  rintro rfl h rfl
  rw [p₁.as_sum]
  simp only [map_sum, eval₂Hom_monomial]
  apply Finset.sum_congr rfl
  intro d hd
  congr 1
  simp only [Finsupp.prod]
  apply Finset.prod_congr rfl
  intro i hi
  have : i ∈ p₁.vars := by
    rw [mem_vars]
    exact ⟨d, hd, hi⟩
  rw [h i this this]
#align mv_polynomial.eval₂_hom_congr' MvPolynomial.eval₂Hom_congr'

/-- If `f₁` and `f₂` are ring homs out of the polynomial ring and `p₁` and `p₂` are polynomials,
  then `f₁ p₁ = f₂ p₂` if `p₁ = p₂` and `f₁` and `f₂` are equal on `R` and on the variables
  of `p₁`.  -/
theorem hom_congr_vars {f₁ f₂ : MvPolynomial σ R →+* S} {p₁ p₂ : MvPolynomial σ R}
    (hC : f₁.comp C = f₂.comp C) (hv : ∀ i, i ∈ p₁.vars → i ∈ p₂.vars → f₁ (X i) = f₂ (X i))
    (hp : p₁ = p₂) : f₁ p₁ = f₂ p₂ :=
  calc
    f₁ p₁ = eval₂Hom (f₁.comp C) (f₁ ∘ X) p₁ := RingHom.congr_fun (by ext <;> simp) _
    _ = eval₂Hom (f₂.comp C) (f₂ ∘ X) p₂ := (eval₂Hom_congr' hC hv hp)
    _ = f₂ p₂ := RingHom.congr_fun (by ext <;> simp) _
#align mv_polynomial.hom_congr_vars MvPolynomial.hom_congr_vars

theorem exists_rename_eq_of_vars_subset_range (p : MvPolynomial σ R) (f : τ → σ) (hfi : Injective f)
    (hf : ↑p.vars ⊆ Set.range f) : ∃ q : MvPolynomial τ R, rename f q = p :=
  ⟨aeval (fun i : σ => Option.elim' 0 X <| partialInv f i) p,
    by
    show (rename f).toRingHom.comp _ p = RingHom.id _ p
    refine' hom_congr_vars _ _ _
    · ext1
      simp [algebraMap_eq]
    · intro i hip _
      rcases hf hip with ⟨i, rfl⟩
      simp [partialInv_left hfi]
    · rfl⟩
#align mv_polynomial.exists_rename_eq_of_vars_subset_range MvPolynomial.exists_rename_eq_of_vars_subset_range

theorem vars_rename (f : σ → τ) (φ : MvPolynomial σ R) : (rename f φ).vars ⊆ φ.vars.image f := by
  intro i hi
  simp only [vars, exists_prop, Multiset.mem_toFinset, Finset.mem_image] at hi⊢
  simpa only [Multiset.mem_map] using degrees_rename _ _ hi
#align mv_polynomial.vars_rename MvPolynomial.vars_rename

theorem mem_vars_rename (f : σ → τ) (φ : MvPolynomial σ R) {j : τ} (h : j ∈ (rename f φ).vars) :
    ∃ i : σ, i ∈ φ.vars ∧ f i = j := by
  simpa only [exists_prop, Finset.mem_image] using vars_rename f φ h
#align mv_polynomial.mem_vars_rename MvPolynomial.mem_vars_rename

end EvalVars

end CommSemiring

end MvPolynomial