import Rings.Rings
import Rings.Fields
import Rings.ToMathlib.list
import Rings.ToMathlib.nat
import Rings.ToMathlib.fol
import Rings.ToMathlib.mv_polynomial
import Rings.RealizeThings
import algebra.big_operators.finprod
import data.finset.basic

namespace AxGroth

noncomputable theory

universe u

open fol
open Rings

/-- composition by coe : fin d → ℕ -/
def monom_of_bd_monom {n d : ℕ} :
  (fin n → fin d) ↪ fin n → ℕ :=
⟨
  λ f, coe ∘ f ,
  λ f g h,
  begin
    funext i,
    have h' := congr_fun h i,
    apply fin.coe_injective h',
  end
⟩

/-- converts map from fin n to same map with finite support -/
def finsupp_of_fin_dom {A : Type*} [has_zero A] {n : ℕ} :
  (fin n → A) → fin n →₀ A :=
finsupp.equiv_fun_on_fintype.inv_fun

def finsupp_of_fin_dom_emb {A : Type*} [has_zero A] {n : ℕ} :
  (fin n → A) ↪ (fin n →₀ A) :=
equiv.to_embedding finsupp.equiv_fun_on_fintype.symm

@[simp] lemma to_fun_finsupp_of_fin_dom {A : Type*} [has_zero A] {n : ℕ}
  (f : fin n → A) : (finsupp_of_fin_dom f).to_fun = f :=
begin
  simp only [finsupp_of_fin_dom],
  funext k,
  simpa,
end

@[simp] lemma finsupp_of_fin_dom_to_fun {A : Type*} [has_zero A] {n : ℕ}
  (f : fin n →₀ A) : finsupp_of_fin_dom f.to_fun = f :=
begin
  simp only [finsupp_of_fin_dom],
  apply finsupp.ext,
  intro k,
  simpa,
end

lemma to_fun_finsupp_of_fin_dom_emb {A : Type*} [has_zero A] {n : ℕ}
  (f : fin n → A) : (finsupp_of_fin_dom_emb f).to_fun = f :=
begin
  simp only [finsupp_of_fin_dom_emb],
  exact to_fun_finsupp_of_fin_dom f,
end

/-- {f : fin n → ℕ | ∀ i, f i < d.succ }-/
@[simp] def n_var_bd_monom (n d : ℕ) : finset (fin n → ℕ) :=
finset.map (@monom_of_bd_monom n d.succ)
finset.univ

-- then convert these to maps f : fin n → ℕ
/-- { f : fin n → ℕ | sum f ≤ d } -/
@[simp] def monom_deg_le_finset (n d : ℕ) : finset (fin n → ℕ) :=
finset.filter
  (λ f : fin n → ℕ, (finsupp_of_fin_dom f).support.sum f ≤ d)
  (n_var_bd_monom n d)

/-- list of all n-variable monomials of degree ≤ d -/
def monom_deg_le (n d : ℕ) : list (fin n → ℕ) :=
(monom_deg_le_finset n d).to_list

/-- lists all n-variable monomials of degree ≤ d as finsupp maps-/
@[simp] def monom_deg_le₀ (n d : ℕ) : list (fin n →₀ ℕ) :=
list.map (finsupp_of_fin_dom) $ monom_deg_le n d

-- no restriction on degree
/-- takes a polynomial in n variables and gives a list of its coefficients-/
@[simp] def coeffs_list_of_mv_polynomial
  {K : Type*} [comm_semiring K] {n : ℕ} (d : ℕ)
  (p : mv_polynomial (fin n) K) : list K :=
list.map (λ m, mv_polynomial.coeff m p) (monom_deg_le₀ n d)

/-- there is always a monomial of degree ≤ d,
  namely the constant polynomial 0 -/
lemma monom_deg_le_length_ne_zero (n d : ℕ) :
  (monom_deg_le n d).length ≠ 0 :=
begin
  simp only [monom_deg_le,
    finset.length_to_list, finset.card_map,
    monom_deg_le_finset],
  apply finset.card_ne_zero_of_mem _,
  {exact λ i, 0},
  {
    simp only [finset.mem_univ, finset.sum_const_zero,
      finset.mem_filter, n_var_bd_monom, and_true, finset.mem_map,
      zero_le', exists_true_left],
    exact ⟨ (λ _, 0), by simp,
    (begin
      simp only [monom_of_bd_monom],
      funext,
      refl,
    end)⟩,
  },
end

lemma zero_lt_monom_deg_le_length (n d : ℕ) :
  0 < (monom_deg_le n d).length :=
  nat.pos_of_ne_zero (monom_deg_le_length_ne_zero n d)

lemma monom_deg_le₀_nth_le {n d k : ℕ}
  (hk : k < (monom_deg_le n d).length) :
  (monom_deg_le₀ n d).nth_le k (by simp [hk]) =
  finsupp_of_fin_dom_emb ((monom_deg_le n d).nth_le k hk) :=
begin
  simp only [list.length_map, list.length,
    list.nth_le, monom_deg_le₀, list.map, finsupp_of_fin_dom_emb,
    finsupp_of_fin_dom],
  simp,
end

lemma index_of_monom_deg_le_lt_length {n d : ℕ} (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le_finset n d).to_list
  < (monom_deg_le n d).length :=
list.index_of'_lt_length (zero_lt_monom_deg_le_length n d)

lemma index_of_monom_deg_le₀_lt_length {n d : ℕ} (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le_finset n d).to_list
  < (monom_deg_le₀ n d).length :=
begin
  rw monom_deg_le₀,
  rw list.length_map,
  apply list.index_of'_lt_length (zero_lt_monom_deg_le_length n d),
end

/-- the bound hndc is enough in poly_indexed_by_monoms -/
lemma poly_indexed_by_monoms_aux0 (n d s c : ℕ)
  (hndc : (monom_deg_le n d).length + s ≤ c) (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le n d) + s < c :=
begin
  apply nat.lt_of_lt_of_le _ hndc,
  apply nat.add_lt_add_right,
  apply list.index_of'_lt_length,
  apply nat.pos_of_ne_zero (monom_deg_le_length_ne_zero n d),
end

/-- if i ∈ fin n and n + p ≤ c then i + p < c -/
lemma fin_add_lt_of_add_le (n p c : ℕ) (hnpc : n + p ≤ c) (i : fin n) :
(i : ℕ) + p < c :=
begin
  apply nat.lt_of_lt_of_le _ hnpc,
  apply nat.add_lt_add_right i.2,
end

/-- ∑_{f ∈ monom_deg_le n d} xⱼ₊ₛ ∏ {0 ≤ i < n} xᵢ₊ₚᶠ⁽ⁱ⁾ in "context c"
 where j is the index of f in monom_deg_le n d
 the context should at least include the variables xⱼ₊ₛ -- this is hndc
 the context should at least include the variables xᵢ₊ₚ -- this is hpc -/
@[simp] def poly_indexed_by_monoms (n d s p c : ℕ)
  (hndsc : (monom_deg_le n d).length + s ≤ c)
  (hnpc : n + p ≤ c) :
  bounded_ring_term c :=
-- sum indexed by the n-variable monom of degree < d
list.sumr
(list.map
  (
    λ f : (fin n → ℕ),
    let
      x_js : bounded_ring_term c :=
      x_ ⟨(list.index_of' f (monom_deg_le n d) + s) ,
        poly_indexed_by_monoms_aux0 n d s c hndsc f ⟩,
      x_ip (i : fin n) : bounded_ring_term c :=
      x_ ⟨ (i : ℕ) + p , fin_add_lt_of_add_le n p c hnpc i ⟩
    in
    x_js * (n.non_comm_prod $ λ i, npow_rec (f i) (x_ip i))
  )
  (monom_deg_le n d)
)

lemma realize_poly_indexed_by_monoms
  {A : Type*} [comm_ring A] {n d s p c : ℕ}
  (hndsc : (monom_deg_le n d).length + s ≤ c)
  (hnpc : n + p ≤ c)
  {xs : dvector (struc_to_ring_struc.Structure A) c}  :
  realize_bounded_term xs
    (poly_indexed_by_monoms n d s p c hndsc hnpc) dvector.nil
  =
  list.sumr
  (list.map
    (λ f,
    (dvector.nth xs (list.index_of' f (monom_deg_le n d) + s)
      (poly_indexed_by_monoms_aux0 n d s c hndsc f))
    *
    (n.non_comm_prod $ λ i,
    ((dvector.nth xs (i + p) (fin_add_lt_of_add_le n p c hnpc i)) ^ (f i) ))
    )
  (monom_deg_le n d)
  ) :=
begin
  simp only [poly_indexed_by_monoms],
  rw realize_ring_term.sumr,
  rw ← list.comp_map,
  congr,
  funext f,
  simp only [realize_ring_term.add_zero_hom, function.comp_app],
  simp only [struc_to_ring_struc.func_map, fin.val_eq_coe, dvector.last,
    struc_to_ring_struc.binaries_map, realize_bounded_term,
    ring_signature.mul, dvector.nth],
  congr,
  rw realize_ring_term.nat_non_comm_prod,
  congr,
  funext i,
  rw realize_ring_term.pow,
  simp,
end

lemma inj_formula_aux0 {n d : ℕ} {j : fin n} :
  (monom_deg_le n d).length +
    (j * ((monom_deg_le n d).length) + n + n)
  ≤
  n * (monom_deg_le n d).length + n + n :=
begin
  let c := n * ((monom_deg_le n d).length) + n + n,
  let monom := (monom_deg_le n d).length,
  repeat {rw ← nat.add_assoc, apply nat.add_le_add_right},
  cases nat.exists_eq_succ_of_ne_zero (ne_zero_of_lt j.2) with k hk,
  have hrw : n * (monom_deg_le n d).length = (monom_deg_le n d).length + k * (monom_deg_le n d).length,
  {
    rw hk,
    rw nat.succ_mul,
    rw nat.add_comm,
  },
  rw hrw,
  apply nat.add_le_add_left,
  apply nat.mul_le_mul_of_nonneg_right,
  apply nat.le_of_lt_succ,
  rw ← hk,
  exact j.2,
end

lemma inj_formula_aux1 {n d : ℕ} :
  n + 0
  ≤
  n * (monom_deg_le n d).length + n + n :=
begin
  rw add_comm,
  apply nat.add_le_add_right,
  apply nat.zero_le,
end

lemma inj_formula_aux2 {n d : ℕ} :
  n + n
  ≤
  n * (monom_deg_le n d).length + n + n :=
begin
  rw nat.add_assoc,
  apply nat.le_add_left,
end

lemma inj_formula_aux3 {n m : ℕ} {i : fin n} :
  (i : ℕ)
  <
  n * m + n + n :=
begin
  apply nat.lt_of_lt_of_le i.2,
  apply nat.le_add_left,
end

lemma inj_formula_aux4 {n m : ℕ} {i : fin n} :
  (i : ℕ) + n < n * m + n + n :=
begin
  rw nat.add_assoc,
  apply nat.lt_add_left,
  apply nat.add_lt_add_right,
  exact i.2,
end

-- in the context of having n polynomials pⱼ indexed by
-- their monomial coefficients,
-- if for all xᵢ and all yᵢ, every polynomial satisfies pⱼ xᵢ = pⱼ yᵢ
-- then each xᵢ = yᵢ.
-- This says the polynomial map formed by the pⱼs is injective
/-- Injectivity of polynomial maps stated model-theoretically-/
def inj_formula (n d : ℕ) :
  bounded_ring_formula (n * (monom_deg_le n d).length) :=
  let monom := (monom_deg_le n d).length in
-- for all pairs in the domain x₋ ∈ Kⁿ and ...
bd_alls' n _
$
-- ... y₋ ∈ Kⁿ
bd_alls' n _
$
-- if at each pⱼ
(bd_big_and n
-- pⱼ xᵢ = pⱼ yᵢ
  (λ j,
    (poly_indexed_by_monoms n d (j * monom + n + n) n _ -- note n
      inj_formula_aux0 inj_formula_aux2)
    ≃
    (poly_indexed_by_monoms n d (j * monom + n + n) 0 _ -- note 0
      inj_formula_aux0 inj_formula_aux1)
  )
)
-- then
⟹
-- at each 0 ≤ i < n,
(bd_big_and n $ λ i,
-- xᵢ = yᵢ (where yᵢ is written as xᵢ₊ₙ₊₁)
  x_ ⟨ i , inj_formula_aux3 ⟩ ≃ x_ (⟨ i + n , inj_formula_aux4 ⟩)
)

-- in the context of having n polynomials pⱼ indexed by
-- their monomial coefficients,
-- for all z₋ ∈ Kⁿ, there exists x₋ ∈ Kⁿ such that each zⱼ = pⱼ x₋
-- This says the polynomial map formed by the pⱼs is surjective
/-- Surjectivity of polynomial maps stated model-theoretically-/
def surj_formula (n d : ℕ) :
  bounded_ring_formula (n * (monom_deg_le n d).length) :=
let monom := (monom_deg_le n d).length in
-- for all x₋ ∈ Kⁿ in the codomain
bd_alls' n _
$
-- there exists y₋ ∈ Kⁿ in the domain such that
bd_exs' n _
$
-- at each 0 ≤ j < n
bd_big_and n
$
-- pⱼ y₋ = xⱼ
λ j,
  poly_indexed_by_monoms n d (j * monom + n + n) 0 _
    inj_formula_aux0 inj_formula_aux1
  ≃
  x_ ⟨ j + n , inj_formula_aux4 ⟩

/-- Ax-Grothendieck stated model-theoretically -/
def Ax_Groth_formula (n d : ℕ) : sentence ring_signature :=
-- quantify over n many (n-variable polynomials) called ps;
-- i.e. the data of a polynomial map
-- by quantifying over (n * monom_of_bounded_degree) monomial coefficients
bd_alls (n * ((monom_deg_le n d).length))
-- if the polynomial function is injective then it is surjective
$ inj_formula n d ⟹ surj_formula n d

/-- the data of a polynomial map consists of n polynomials in n variables -/
@[simp] def poly_map_data (K : Type*) [comm_semiring K] (n : ℕ) : Type* :=
fin n → mv_polynomial (fin n) K

/-- a polynomial map evaluates those polynomials that it consists of -/
def poly_map {K : Type*} [comm_semiring K] {n : ℕ} :
  poly_map_data K n → (fin n → K) → (fin n → K) :=
λ ps as k, mv_polynomial.eval as (ps k)

/-- Any injective polynomial map over an algerbaically closed field of char p is surjective -/
axiom Ax_Groth_of_locally_finite
  {K : Type*} [field K] [is_alg_closed K]
  {p : ℕ} (hprime : prime p) (hchar : char_p K p) {n : ℕ}
  (ps : poly_map_data K n) (hinj : function.injective (poly_map ps)) :
  function.surjective (poly_map ps)
-- not the focus of the project so we take it as an axiom

section semiring

variables {A : Type*} [comm_semiring A] {n : ℕ}

/-- takes a polynomial map
  (preferably of total deg < d) and gives list of coeffs of each monomial -/
@[simp] def poly_map_data.coeffs_list
  {n : ℕ} (d : ℕ) (ps : poly_map_data A n) : list A :=
list.join (list.of_fn (λ i : fin n, coeffs_list_of_mv_polynomial d (ps i)))

/- Writes polynomial map into a dvector of its coefficients -/
def poly_map_data.coeffs_dvector
  {n : ℕ} (d : ℕ) (ps : poly_map_data A n) :
  dvector A (poly_map_data.coeffs_list d ps).length :=
dvector.of_list (poly_map_data.coeffs_list d ps)

/-- the number of coefficients of mv_polynomial = number of monomials -/
lemma coeffs_list_length_eq_monom_deg_le_length {d : ℕ}
  (p : mv_polynomial (fin n) A) :
  (coeffs_list_of_mv_polynomial d p).length
  =
  (monom_deg_le n d).length := by simp

/-- lemma for matching up lengths of contexts for mv_polynomials -/
lemma variable_bound_equal {n : ℕ} (d : ℕ) (ps : poly_map_data A n) :
  (n * (monom_deg_le n d).length)
  =
  (poly_map_data.coeffs_list d ps).length :=
begin
  simp only [poly_map_data.coeffs_list, list.length_join],
  rw list.sum_map_length_of_fn_const_length,
  intro i,
  apply coeffs_list_length_eq_monom_deg_le_length,
end

/-- Writes polynomial map into a dvector of its coefficients
  (with a replaced variable context) -/
def poly_map_data.coeffs_dvector' {n : ℕ} (d : ℕ)
  (ps : poly_map_data A n) :
  dvector A (n * (monom_deg_le n d).length) :=
dvector.cast (symm (variable_bound_equal d ps))
  (poly_map_data.coeffs_dvector d ps)

end semiring

section injectivity_and_surjectivity_from_mv_polynomial

variables {A : Type*} [comm_ring A] {n d : ℕ}
  (p : mv_polynomial (fin n) A)

/-- the support of a polynomial of degree ≤ d is contained in the set of monomials of degree ≤ d -/
lemma support_sub_monom_deg_le_finset (hdeg : p.total_degree ≤ d) :
  p.support ⊆ finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d) :=
begin
  intros f hf,
  simp only [true_and, exists_prop, finset.mem_univ,
    finset.mem_map, monom_deg_le_finset, finset.mem_filter],
  exact ⟨ f.to_fun,
  begin
    have hf_img_lt : ∀ i : fin n, f i < d.succ,
    {
      intro i,
      rw nat.lt_succ_iff,
      apply le_trans _ hdeg,
      exact mv_polynomial.support_le_total_degree i f hf,
    },
    refine ⟨ ⟨ _ , _ ⟩ , _ ⟩ ,
    {
      simp only [n_var_bd_monom, monom_of_bd_monom, finset.mem_map,
        finset.mem_univ],
      refine ⟨ λ k, ⟨ f k, hf_img_lt k⟩, _ , _ ⟩,
      {simp},
      {funext, simpa},
    },
    {
      apply le_trans _ hdeg,
      rw finsupp_of_fin_dom_to_fun,
      apply finset.le_sup hf,
    },
    {exact finsupp_of_fin_dom_to_fun f},
  end ⟩,
end

/-- the support union its complement (in monom_deg_le_finset) is equal to the whole thing-/
lemma support_union_compl_eq_monom_deg_le_finset
  [decidable_eq (mv_polynomial (fin n) A)] (hdeg : p.total_degree ≤ d) :
  p.support ∪
    (finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d)
      \ p.support) =
  finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d) :=
finset.union_sdiff_of_subset $ support_sub_monom_deg_le_finset _ hdeg

lemma mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum
  [decidable_eq (mv_polynomial (fin n) A)]
  (hdeg : p.total_degree ≤ d)
  (as : (fin n →₀ ℕ) → A)
  :
  p.support.sum (λ (f : fin n →₀ ℕ), mv_polynomial.coeff f p * as f)
  =
  (finset.map finsupp_of_fin_dom_emb (monom_deg_le_finset n d)).sum
  (λ (f : fin n →₀ ℕ), mv_polynomial.coeff f p * as f)
  :=
begin
  rw ← support_union_compl_eq_monom_deg_le_finset p hdeg,
  rw finset.sum_union,
  {
    set LHS :=
      p.support.sum (λ (f : fin n →₀ ℕ), mv_polynomial.coeff f p * as f)
      with hLHS,
    rw ← add_zero LHS,
    rw ← hLHS,
    congr,
    symmetry,
    apply finset.sum_eq_zero,
    intros f hf,
    rw finset.mem_sdiff at hf,
    cases hf with hfl hfr,
    unfold mv_polynomial.coeff,
    rw finsupp.not_mem_support_iff.1 hfr,
    exact zero_mul _,
  },
  {exact disjoint_sdiff_self_right},
end

variables (ps : poly_map_data A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d)
  (xs ys : dvector ↥(struc_to_ring_struc.Structure A) n)

lemma eval_poly_map_data_xs_aux_prod
  {m} (f : fin n → ℕ)
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A) (n * m)) :
  n.non_comm_prod
  (λ (i : fin n),
    (ys.append (xs.append coeffs)).nth
    (i + n) inj_formula_aux4 ^ f i) =
  finset.univ.prod (λ (i : fin n), xs.nth i i.2 ^ f i) :=
begin
  rw nat.non_comm_prod_eq_prod,
  congr,
  funext i,
  rw dvector.nth_append_big
    (nat.le_add_left n _) inj_formula_aux4,
  simp only [nat.add_sub_cancel i n],
  rw dvector.nth_append_small,
end

lemma eval_poly_map_data_ys_aux_prod
  {m} (f : fin n → ℕ)
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A) (n * m)) :
  n.non_comm_prod
  (λ (i : fin n),
    (ys.append (xs.append coeffs)).nth
    (i + 0) inj_formula_aux3 ^ f i) =
  finset.univ.prod (λ (i : fin n), ys.nth i i.2 ^ f i) :=
begin
  rw nat.non_comm_prod_eq_prod,
  congr,
  funext i,
  simp only [add_zero],
  rw ← @dvector.nth_append_small _ _ _ ys,
end

lemma poly_map_data.coeffs_dvector'_nth_aux0
  (j : fin n) (f : fin n → ℕ) :
  list.index_of' f (monom_deg_le_finset n d).to_list
    + ↑j * (monom_deg_le_finset n d).to_list.length
  <
    n * (monom_deg_le n d).length :=
begin
  have h1 : (1 + ↑j) * (monom_deg_le n d).length ≤ n * (monom_deg_le n d).length,
  {
    rw [mul_le_mul_right (zero_lt_monom_deg_le_length _ _),
      nat.one_add, nat.succ_le_iff],
    exact j.2,
  },
  apply lt_of_lt_of_le _ h1,
  rw add_mul,
  apply add_lt_add_right,
  rw one_mul,
  apply list.index_of'_lt_length (zero_lt_monom_deg_le_length _ _),
end

lemma poly_map_data.coeffs_dvector'_nth_aux1
  {ps : poly_map_data A n} :
  ∀ (i : fin n),
  ((λ (i : fin n), coeffs_list_of_mv_polynomial d (ps i)) i).length
  = (monom_deg_le n d).length :=
λ i, coeffs_list_length_eq_monom_deg_le_length (ps i)

lemma poly_map_data.coeffs_dvector'_nth_aux2
  (j : fin n) (f : fin n → ℕ)
  (hf : f ∈ monom_deg_le n d) :
  finsupp_of_fin_dom_emb.to_fun f
  =
  (monom_deg_le₀ n d).nth_le
    (list.index_of' f (monom_deg_le_finset n d).to_list)
    (index_of_monom_deg_le₀_lt_length f) :=
begin
  rw monom_deg_le₀_nth_le (index_of_monom_deg_le_lt_length f),
  apply congr_arg,
  simp only,
  delta monom_deg_le,
  have h := @list.index_of'_nth_le _ _
    f (monom_deg_le_finset n d).to_list hf,
  funext i,
  rw ← congr_fun h i,
  congr,
end

lemma poly_map_data.coeffs_dvector'_nth
  {A : Type*} [comm_ring A] {n d : ℕ}
  {ps : poly_map_data A n} (j : fin n) (f : fin n → ℕ)
  (hf : f ∈ monom_deg_le_finset n d) :
  (ps j).to_fun (finsupp_of_fin_dom_emb f) =
    (poly_map_data.coeffs_dvector' d ps).nth
      (list.index_of' f (monom_deg_le_finset n d).to_list +
        ↑j * (monom_deg_le n d).length)
      (poly_map_data.coeffs_dvector'_nth_aux0 j f) :=
begin
  rw [poly_map_data.coeffs_dvector', dvector.nth_cast,
    poly_map_data.coeffs_dvector, dvector.nth_of_list],
  delta poly_map_data.coeffs_list,
  unfold_coes,
  rw list.nth_le_join_of_fn_const_length
    (λ (i : fin n), coeffs_list_of_mv_polynomial d (ps i))
    poly_map_data.coeffs_dvector'_nth_aux1
    j.2
    (index_of_monom_deg_le_lt_length _),
  have h :
    ((λ (i : fin n), coeffs_list_of_mv_polynomial d (ps i)) ⟨ j.1 , j.2⟩)
    =
    coeffs_list_of_mv_polynomial d (ps ⟨ j.1 , j.2 ⟩),
  {refl},
  simp only [h],
  delta coeffs_list_of_mv_polynomial,
  delta mv_polynomial.coeff,
  rw list.nth_le_map,
  have hj : (⟨ j.1, j.2 ⟩ : fin n) = j := fin.eta j j.2,
  rw [hj],
  apply congr_arg,
  have hf' : f ∈ (monom_deg_le_finset n d).to_list :=
  (finset.mem_to_list _).2 hf,
  exact poly_map_data.coeffs_dvector'_nth_aux2 j f hf',
  -- {exact index_of_monom_deg_le₀_lt_length _},
end

lemma eval_poly_map_data_xs
  [decidable_eq (mv_polynomial (fin n) A)]
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) (j : fin n) :
  mv_polynomial.eval (λ (i : fin n), xs.nth i i.2) (ps j)
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
       (ys.append (xs.append (poly_map_data.coeffs_dvector' d ps))).nth
         (list.index_of' f (monom_deg_le_finset n d).to_list +
            (j * (monom_deg_le_finset n d).to_list.length + n + n))
         (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
         *
         (n.non_comm_prod
           (λ (i : fin n),
             (ys.append (xs.append (poly_map_data.coeffs_dvector' d ps))).nth
             (i + n) inj_formula_aux4 ^ f i))
         )
    (monom_deg_le n d))
  :=
begin
  rw mv_polynomial.eval_eq',
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum (ps j) (hdeg j),
  rw finset.sum_map,
  rw list.sumr_eq_sum,
  delta monom_deg_le,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_data_xs_aux_prod xs ys f,
  congr,
  rw mv_polynomial.coeff,
  rw dvector.nth_append_big,
  {
    rw dvector.nth_append_big,
    {
      simp only [add_assoc],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list)
        (j * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list
        + j * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      exact poly_map_data.coeffs_dvector'_nth _ f hf,
    },
    {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

lemma eval_poly_map_data_ys
  [decidable_eq (mv_polynomial (fin n) ↥(struc_to_ring_struc.Structure A))]
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) (j : fin n) :
  mv_polynomial.eval (λ (i : fin n), ys.nth i i.2) (ps j)
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
      (ys.append (xs.append (poly_map_data.coeffs_dvector' d ps))).nth
        (list.index_of' f (monom_deg_le_finset n d).to_list +
           (j * (monom_deg_le_finset n d).to_list.length + n + n))
        (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
        *
        (n.non_comm_prod
          (λ (i : fin n),
            (ys.append (xs.append (poly_map_data.coeffs_dvector' d ps))).nth
            (i + 0) inj_formula_aux3 ^ f i))
        )
    (monom_deg_le_finset n d).to_list)
  :=
begin
  rw mv_polynomial.eval_eq',
  -- rw ← eval_poly_map_data_ys_aux_prod ps xs ys,
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum (ps j) (hdeg j),
  rw finset.sum_map,
  delta monom_deg_le,
  rw list.sumr_eq_sum,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_data_ys_aux_prod xs ys f,
  congr,
  rw mv_polynomial.coeff,
  rw dvector.nth_append_big,
  {
    rw dvector.nth_append_big,
    {
      simp only [add_assoc],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list)
        (j * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list
        + j * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      exact poly_map_data.coeffs_dvector'_nth _ f hf,
    },
    {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

variable [decidable_eq A]

lemma realize_inj_formula_iff_injective
  {n d : ℕ}
  (ps : poly_map_data A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) :
  @realize_bounded_formula _ (struc_to_ring_struc.Structure A)
    _ _ (@poly_map_data.coeffs_dvector' A _ n d ps)
    (inj_formula n d) dvector.nil
  ↔
  function.injective (poly_map ps) :=
begin
  -- let xs0 := poly_map_data.coeffs_dvector' d ps,
  -- open up the definition of inj_formula and what it means to realize it
  simp only [inj_formula,
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_imp,
      realize_bounded_formula_bd_big_and],
  split,
    -- forward implication
  {
  intros hInj xs ys himage,
  set xs' : dvector (struc_to_ring_struc.Structure A) n := dvector.of_fn xs with hxs',
  set ys' : dvector (struc_to_ring_struc.Structure A) n := dvector.of_fn ys with hys',
  have hImage :  ∀ (k : fin n),
    realize_bounded_formula (ys'.append (xs'.append (poly_map_data.coeffs_dvector' d ps)))
      (poly_indexed_by_monoms n d (↑k * (monom_deg_le n d).length + n + n) n (n * (monom_deg_le n d).length + n + n)
           inj_formula_aux0
           inj_formula_aux2 ≃
         poly_indexed_by_monoms n d (↑k * (monom_deg_le n d).length + n + n) 0 (n * (monom_deg_le n d).length + n + n)
           inj_formula_aux0
           inj_formula_aux1)
      dvector.nil,
  {
    intro j,
    simp only [poly_map] at himage,
    have himagej := congr_fun himage j,
    simp only [realize_bounded_formula,
      monom_deg_le, realize_poly_indexed_by_monoms],
    convert himagej,
    {
      convert symm (eval_poly_map_data_xs ps xs' ys' hdeg j),
      funext k,
      simp only [dvector.nth_of_fn, fin.eta],
    },
    {
      convert symm (eval_poly_map_data_ys ps xs' ys' hdeg j),
      funext k,
      simp only [dvector.nth_of_fn, fin.eta],
    },
  },
  funext i, -- for each input (... they are equal)
  have hPreimage := hInj xs' ys' hImage i,
  clear hInj hImage himage,
  simp only [realize_bounded_formula,
    realize_bounded_term,
    @dvector.nth_append_small _ _ _ ys' _ i i.2,
    dvector.nth_append_big (nat.le_add_left _ _),
    nat.add_sub_cancel,
    @dvector.nth_append_small _ _ _ xs' _ i i.2] at hPreimage,
  convert symm hPreimage,
  {rw [hxs', dvector.nth_of_fn, fin.eta] },
  {rw [hys', dvector.nth_of_fn, fin.eta] },
  },
  -- backward implication
  {
  intro hinj, -- assume injectivity
  intros xs ys, -- n tuples in the domain
  -- we are showing that ps xs = ps yx implies xs = ys
  intro hImage, -- assume the images are all equal (expressed model theoretically)
  -- we must translate this to the images are equal
  -- (expressed algebraically / in the ring)
  have himage : poly_map ps (λ i, dvector.nth xs i i.2)
               = poly_map ps (λ i, dvector.nth ys i i.2),
  {
    funext j, -- for each i < n (... the tuples at i are equal)
    simp only [poly_map],
    have hImagej := hImage j,
    simp only [realize_bounded_formula,
      monom_deg_le, realize_poly_indexed_by_monoms] at hImagej,
    convert hImagej,
    {rw eval_poly_map_data_xs ps xs ys hdeg j, refl },
    {rw eval_poly_map_data_ys ps xs ys hdeg j, refl },
  },
  -- by injectivity of poly_map ps we have the preimages are equal (pointwise)
  intro i, -- for each input (... they are equal)
  have hpreimage : dvector.nth xs i i.2 = dvector.nth ys i i.2,
  {apply congr_fun (hinj himage) i},
  simp only [realize_bounded_formula,
    realize_bounded_term,
    @dvector.nth_append_small _ _ _ ys _ i i.2,
    dvector.nth_append_big (nat.le_add_left _ _),
    nat.add_sub_cancel,
    @dvector.nth_append_small _ _ _ xs _ i i.2,
    hpreimage], },
end

lemma realize_surj_formula_iff_surjective
  {n d : ℕ}
  (ps : poly_map_data A n)
  (hdeg : ∀ (i : fin n), (ps i).total_degree ≤ d) :
  (@realize_bounded_formula _ (struc_to_ring_struc.Structure A)
    _ _ (@poly_map_data.coeffs_dvector' A _ n d ps)
    (surj_formula n d) dvector.nil)
  ↔
  function.surjective (poly_map ps)
  :=
begin
  simp only [surj_formula,
    realize_bounded_formula_bd_alls',
    realize_bounded_formula_bd_exs',
    realize_bounded_formula_bd_big_and,
    realize_bounded_formula],
  split,
{
  intros hSurj xs, -- for any n tuple xs in the codomain
  obtain ⟨ ys , hys ⟩ := hSurj (dvector.of_fn xs),
  use (dvector.nth' ys), -- there exists an n tuple ys in the domain
  funext k,
  have hysk := hys k,
  have hrw0 : realize_bounded_term
    (ys.append ((dvector.of_fn xs).append (poly_map_data.coeffs_dvector' d ps)))
    x_⟨ k + n , inj_formula_aux4 ⟩ dvector.nil = xs k,
  {
    simp only [realize_bounded_term, symm (fin.val_eq_coe _)],
    rw dvector.nth_append_big (nat.le_add_left _ _) _,
    rw dvector.nth_append_small,
    { simp only [nat.add_sub_cancel,
      dvector.nth_of_fn, fin.val_eq_coe, fin.eta] },
    { rw nat.add_sub_cancel, exact k.2 },
  },
  rw hrw0 at hysk,
  simp only [monom_deg_le, realize_poly_indexed_by_monoms] at hysk,
  have hrw1 := eval_poly_map_data_ys ps (dvector.of_fn xs) ys hdeg k,
  simpa only [symm (eq.trans hrw1 hysk), fin.val_eq_coe],
 },
 {
   intros hsurj xs,
   obtain ⟨ ys , hys ⟩ := hsurj xs.nth',
   use dvector.of_fn ys,
   intro k,
   simp only [monom_deg_le, realize_poly_indexed_by_monoms],
   have hrw1 :=
     symm (eval_poly_map_data_ys ps xs (dvector.of_fn ys) hdeg k),
   convert hrw1,
   simp only [realize_bounded_term, symm (fin.val_eq_coe _)],
   rw dvector.nth_append_big (nat.le_add_left _ _) _,
   rw dvector.nth_append_small,
   {
     have hysk := congr_fun hys k,
     dsimp only [poly_map, dvector.nth'] at hysk, -- remove
     simp only [nat.add_sub_cancel,
       dvector.nth_of_fn, fin.val_eq_coe, fin.eta, hysk],
   },
   { rw nat.add_sub_cancel, exact k.2 },
 },
end

end injectivity_and_surjectivity_from_mv_polynomial

section injectivity_and_surjectivity_from_coeffs

variables {A : Type*} [comm_ring A]

def mv_polynomial_of_coeffs {n d : ℕ}
  (coeffs : dvector A (monom_deg_le n d).length) :
  mv_polynomial (fin n) A :=
-- sum indexed by the n-variable monom of degree < d
list.sumr
(list.map
  (
    λ f : (fin n → ℕ),
    -- each entry of the sum is a monomial f with "index-of-f-th"
    -- coefficient from "coeff"
    mv_polynomial.monomial (finsupp_of_fin_dom f)
      (coeffs.nth (list.index_of' f (monom_deg_le n d))
        (index_of_monom_deg_le_lt_length _))
  )
  (monom_deg_le n d)
)

lemma mv_polynomial_of_coeffs_deg
  [decidable_eq A]
  {n d : ℕ}
  (coeffs : dvector A (monom_deg_le n d).length) (i : fin n) :
  (mv_polynomial_of_coeffs coeffs).total_degree ≤ d :=
begin
  simp only [mv_polynomial_of_coeffs,
    list.sumr_eq_sum, monom_deg_le, finset.sum_to_list],
  apply le_trans (mv_polynomial.total_degree_sum _ _),
  simp only [finset.sup_le_iff],
  intros f hf,
  simp only [function.comp],
  rw [mv_polynomial.total_degree_monomial],
  by_cases h :
    coeffs.nth (list.index_of' f (monom_deg_le_finset n d).to_list)
    (index_of_monom_deg_le_lt_length _) = 0,
  { simp only [if_pos h, bot_eq_zero, zero_le'] },
  { simp only [if_neg h, finsupp.sum],
    simp only [monom_deg_le_finset, finset.mem_filter] at hf,
    exact hf.2 },
  apply_instance, -- why??
end

lemma realize_surj_formula_aux {n d : ℕ}
  (coeffs : dvector A (n * (monom_deg_le n d).length))
  (xs : dvector ↥(struc_to_ring_struc.Structure A) n)
  (ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  realize_bounded_term
    (ys.append (xs.append coeffs))
    x_⟨ k + n , inj_formula_aux4 ⟩ dvector.nil
  = xs.nth' k :=
begin
    simp only [realize_bounded_term, symm (fin.val_eq_coe _)],
    rw dvector.nth_append_big (nat.le_add_left _ _) _,
    rw dvector.nth_append_small,
    { simp only [nat.add_sub_cancel,
      dvector.nth_of_fn, fin.val_eq_coe, fin.eta, dvector.nth'] },
    { rw nat.add_sub_cancel, exact k.2 },
end

variable [decidable_eq A]

lemma filter_coeff_monomial
  {n d : ℕ} (a : (fin n → ℕ) → A)
  {f : fin n → ℕ} (hf : f ∈ monom_deg_le_finset n d) :
  (finset.filter
    (λ (x : fin n → ℕ),
      mv_polynomial.coeff (finsupp_of_fin_dom_emb f)
        (mv_polynomial.monomial (finsupp_of_fin_dom x) (a x))
        ≠ 0
    )
       (monom_deg_le_finset n d))
  = if a f = 0 then ∅ else { f }
  :=
begin
  simp only [mv_polynomial.coeff_monomial],
  by_cases hf0 : a f = 0,
  {
    simp only [if_pos hf0, finset.eq_empty_iff_forall_not_mem,
      finset.eq_singleton_iff_nonempty_unique_mem,
      finset.mem_filter, exists_prop, ite_eq_right_iff, ne.def, not_forall],
    intros x hx,
    obtain ⟨ _ , hx , hne ⟩ := hx,
    apply hne,
    rw ← hf0,
    congr,
    have hx' := congr_arg finsupp.equiv_fun_on_fintype hx,
    simp only [finsupp_of_fin_dom, finsupp_of_fin_dom_emb,
      equiv.to_embedding_apply, equiv.apply_symm_apply,
      equiv.inv_fun_as_coe] at hx',
    exact hx',
  },
  {
    simp only [if_neg hf0, finset.eq_singleton_iff_nonempty_unique_mem,
      finset.mem_filter, exists_prop, ite_eq_right_iff, ne.def, not_forall],
    split,
    {
      use f,
      simp only [finset.mem_filter],
      refine ⟨ hf , rfl , hf0 ⟩,
    },
    {
      intros x hx,
      obtain ⟨ _ , hx , _ ⟩ := hx,
      have hx' := congr_arg finsupp.equiv_fun_on_fintype hx,
      simp only [finsupp_of_fin_dom, finsupp_of_fin_dom_emb,
        equiv.to_embedding_apply, equiv.apply_symm_apply,
        equiv.inv_fun_as_coe] at hx',
      exact hx',
    },
  },
end

lemma mv_polynomial_of_coeffs_eq_nth_index_of'
  {n d : ℕ}
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (f : fin n → ℕ) (hf : f ∈ monom_deg_le_finset n d) (k : fin n) :
  (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs)).coeff
    (finsupp_of_fin_dom_emb f)
  =
  coeffs.nth
    (list.index_of' f (monom_deg_le_finset n d).to_list
      + ↑k * (monom_deg_le_finset n d).to_list.length)
      (poly_map_data.coeffs_dvector'_nth_aux0 _ _) :=
begin
  simp only [mv_polynomial_of_coeffs],
  rw mv_polynomial.finsupp_coeff_sumr,
  rw list.map_map,
  simp only [function.comp, list.sumr_eq_sum,
    monom_deg_le, finset.sum_to_list],
  rw ← finset.sum_filter_ne_zero,
  rw filter_coeff_monomial _ hf,
  by_cases h :
    (dvector.ith_chunk k coeffs).nth
      (list.index_of' f (monom_deg_le_finset n d).to_list)
      (index_of_monom_deg_le_lt_length _) = 0,
  {
    simp only [if_pos h, finset.sum_empty],
    rw dvector.ith_chunk_nth at h,
    simp only [add_comm
      (list.index_of' f (monom_deg_le_finset n d).to_list)
      (↑k * (monom_deg_le_finset n d).to_list.length)],
    convert symm h,
  },
  {
    simp only [if_neg h, finset.sum_singleton,
      mv_polynomial.coeff_monomial,
      finsupp_of_fin_dom, finsupp_of_fin_dom_emb],
    rw [dvector.ith_chunk_nth, if_pos],
    { congr1, apply add_comm },
    {refl},
  },
end

lemma eval_mv_polynomial_of_coeffs_ys0
  {n d : ℕ}
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  mv_polynomial.eval ys.nth' (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
      (ys.append (xs.append coeffs)).nth
        (list.index_of' f (monom_deg_le_finset n d).to_list +
           (k * (monom_deg_le_finset n d).to_list.length + n + n))
        (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
        *
        (n.non_comm_prod
          (λ (i : fin n),
            (ys.append (xs.append coeffs)).nth
            (i + 0) inj_formula_aux3 ^ f i))
        )
    (monom_deg_le_finset n d).to_list)
  :=
begin
  rw mv_polynomial.eval_eq',
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum _
    (mv_polynomial_of_coeffs_deg (dvector.ith_chunk k coeffs) k),
  rw finset.sum_map,
  delta monom_deg_le,
  rw list.sumr_eq_sum,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_data_ys_aux_prod xs ys f,
  congr,
  rw dvector.nth_append_big,
  {
     rw dvector.nth_append_big,
     {
       simp only [add_assoc],
       simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list)
        (k * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc (list.index_of' f (monom_deg_le_finset n d).to_list
        + k * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      rw mv_polynomial_of_coeffs_eq_nth_index_of' _ _ hf,
      refl,
      {apply_instance}, --why???
     },
     {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

lemma eval_mv_polynomial_of_coeffs_xs0
  {n d : ℕ}
  (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  mv_polynomial.eval xs.nth' (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  list.sumr (list.map
    (λ (f : fin n → ℕ),
      (ys.append (xs.append coeffs)).nth
        (list.index_of' f (monom_deg_le_finset n d).to_list +
           (k * (monom_deg_le_finset n d).to_list.length + n + n))
        (poly_indexed_by_monoms_aux0 n d _ _ inj_formula_aux0 f)
        *
        (n.non_comm_prod
          (λ (i : fin n),
            (ys.append (xs.append coeffs)).nth
            (i + n) inj_formula_aux4 ^ f i))
        )
    (monom_deg_le_finset n d).to_list)
  :=
begin
  rw mv_polynomial.eval_eq',
  rw mv_polynomial_sum_eq_finset_map_monom_deg_le_finset_sum _
    (mv_polynomial_of_coeffs_deg (dvector.ith_chunk k coeffs) k),
  rw finset.sum_map,
  delta monom_deg_le,
  rw list.sumr_eq_sum,
  rw finset.sum_to_list,
  apply finset.sum_congr rfl,
  intros f hf,
  rw eval_poly_map_data_xs_aux_prod xs ys f,
  congr,
  rw dvector.nth_append_big,
  {
     rw dvector.nth_append_big,
     {
       simp only [add_assoc],
       simp only [symm (add_assoc
         (list.index_of' f (monom_deg_le_finset n d).to_list)
         (k * (monom_deg_le_finset n d).to_list.length ) (n + n))],
      simp only [symm (add_assoc
        (list.index_of' f (monom_deg_le_finset n d).to_list
        + k * (monom_deg_le_finset n d).to_list.length) n n)],
      simp only [nat.add_sub_cancel],
      rw mv_polynomial_of_coeffs_eq_nth_index_of' _ _ hf,
      refl,
      {apply_instance}, --why???
     },
     {
      rw ← add_assoc,
      rw nat.add_sub_cancel,
      rw ← add_assoc,
      apply nat.le_add_left,
    },
  },
  {
    rw ← add_assoc,
    apply nat.le_add_left,
  },
end

lemma eval_mv_polynomial_of_coeffs_ys1
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs : fin n → A)
  (ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  mv_polynomial.eval ys.nth'
    (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  realize_bounded_term (ys.append ((dvector.of_fn xs).append coeffs))
    (poly_indexed_by_monoms n d
      (↑k * (monom_deg_le n d).length + n + n) 0
      (n * (monom_deg_le n d).length + n + n)
         inj_formula_aux0
         inj_formula_aux1)
      dvector.nil :=
by simpa only [realize_poly_indexed_by_monoms,
    eval_mv_polynomial_of_coeffs_ys0 _ (dvector.of_fn xs),
    monom_deg_le]

lemma eval_mv_polynomial_of_coeffs_xs1
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs : fin n → A)
  (ys : dvector ↥(struc_to_ring_struc.Structure A) n) (k : fin n) :
  (mv_polynomial.eval xs) (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  realize_bounded_term (ys.append ((dvector.of_fn xs).append coeffs))
    (poly_indexed_by_monoms n d
      (↑k * (monom_deg_le n d).length + n + n) n
      (n * (monom_deg_le n d).length + n + n)
         inj_formula_aux0
         inj_formula_aux2)
      dvector.nil :=
begin
  rw ← dvector.nth'_of_fn1 xs,
  simp only [realize_poly_indexed_by_monoms,
    eval_mv_polynomial_of_coeffs_xs0 _ (dvector.of_fn xs) ys,
    monom_deg_le],
  simpa only [dvector.nth'_of_fn1],
end

lemma eval_mv_polynomial_of_coeffs_ys2
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length))
  (xs : dvector (struc_to_ring_struc.Structure A) n)
  (ys : fin n → (struc_to_ring_struc.Structure A)) (k : fin n) :
  (mv_polynomial.eval ys) (mv_polynomial_of_coeffs (dvector.ith_chunk k coeffs))
  =
  realize_bounded_term ((dvector.of_fn ys).append (xs.append coeffs))
      (poly_indexed_by_monoms n d (↑k * (monom_deg_le n d).length + n + n) 0 (n * (monom_deg_le n d).length + n + n)
         inj_formula_aux0
         inj_formula_aux1)
      dvector.nil :=
begin
  simp only [realize_poly_indexed_by_monoms, monom_deg_le],
  convert eval_mv_polynomial_of_coeffs_ys0 coeffs xs (dvector.of_fn ys) k,
  funext,
  rw dvector.nth'_of_fn,
end

lemma injective_iff_realize_inj_formula
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length)) :
  function.injective
    (poly_map (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs)))
  ↔
  realize_bounded_formula coeffs (inj_formula n d) dvector.nil
  :=
begin
  simp only [inj_formula,
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_bd_big_and,
      realize_bounded_formula],
  split,
  {
    intros hinj xs ys hImage k,
    have himage :
    poly_map
      (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs))
      (λ i, dvector.nth xs i i.2)
    =
    poly_map
      (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs))
      (λ i, dvector.nth ys i i.2),
   {
     funext j,
     convert hImage j,
     { simpa only [poly_map, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_xs0 coeffs xs ys j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
     { simpa only [poly_map, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_ys0 coeffs xs ys j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
   },
   have hpreimage := congr_fun (hinj himage) k,
   simp only [realize_bounded_term,
     @dvector.nth_append_small _ _ _ ys _ k k.2,
     dvector.nth_append_big (nat.le_add_left _ _),
     nat.add_sub_cancel,
     @dvector.nth_append_small _ _ _ xs _ k k.2],
   exact symm hpreimage,
  },
  {
    intros hInj xs ys himage,
    set ys' := dvector.of_fn ys with hys,
    set xs' := dvector.of_fn xs with hxs,
    have hImage : ∀ (k : fin n),
      realize_bounded_term (ys'.append (xs'.append coeffs))
        (poly_indexed_by_monoms n d (k * (monom_deg_le n d).length + n + n) n
          (n * (monom_deg_le n d).length + n + n)
          inj_formula_aux0
          inj_formula_aux2)
        dvector.nil =
      realize_bounded_term (ys'.append (xs'.append coeffs))
        (poly_indexed_by_monoms n d (k * (monom_deg_le n d).length + n + n) 0
          (n * (monom_deg_le n d).length + n + n)
          inj_formula_aux0
          inj_formula_aux1)
        dvector.nil,
    {
      intro j,
      convert congr_fun himage j,
     { simp only [poly_map, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_xs1 coeffs xs ys' j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
     {
       simp only [poly_map, dvector.nth'_eq,
         eval_mv_polynomial_of_coeffs_ys2 coeffs xs' ys j,
         realize_poly_indexed_by_monoms,
         monom_deg_le] },
    },
    funext k,
    have hPreimage := hInj xs' ys' hImage k,
    simp only [realize_bounded_term,
      @dvector.nth_append_small _ _ _ ys' _ k k.2,
      dvector.nth_append_big (nat.le_add_left _ _),
      nat.add_sub_cancel,
      @dvector.nth_append_small _ _ _ xs' _ k k.2,
      hys, hxs, dvector.nth_of_fn] at hPreimage,
    convert symm hPreimage,
    rw fin.eta k,
    rw fin.eta k,
  },
end

lemma surjective_iff_realize_surj_formula
  {n d : ℕ} (coeffs : dvector ↥(struc_to_ring_struc.Structure A)
    (n * (monom_deg_le n d).length)) :
  function.surjective
    (poly_map (λ i : fin n, mv_polynomial_of_coeffs (dvector.ith_chunk i coeffs)))
  ↔
  realize_bounded_formula coeffs (surj_formula n d) dvector.nil
  :=
begin
  simp only [surj_formula,
      realize_bounded_formula_bd_alls',
      realize_bounded_formula_bd_exs',
      realize_bounded_formula_bd_big_and,
      realize_bounded_formula],
  split,
  {
    intros hsurj xs,
    obtain ⟨ ys , hys ⟩ := hsurj (dvector.nth' xs),
    refine ⟨ dvector.of_fn ys , _ ⟩,
    intro k,
    have hysk := congr_fun hys k,
    simp only [poly_map] at hysk,
    rw realize_surj_formula_aux coeffs,
    convert hysk,
    rw eval_mv_polynomial_of_coeffs_ys2,
  },
  {
    intros hSurj xs,
    obtain ⟨ ys , hys ⟩ := hSurj (dvector.of_fn xs),
    refine ⟨ ys.nth' , _ ⟩,
    funext k,
    have hysk := hys k,
    simp only [poly_map],
    simp only [realize_surj_formula_aux coeffs (dvector.of_fn xs) ys k,
      dvector.nth'_of_fn] at hysk,
    convert hysk,
    rw [eval_mv_polynomial_of_coeffs_ys1],
  },
end

end injectivity_and_surjectivity_from_coeffs

section max_total_deg

variables {K : Type*} [comm_semiring K]

@[simp] def max_total_deg :
  Π {n m : ℕ}, (fin n → mv_polynomial (fin m) K) → ℕ
| 0 _ ps := 0
| (n + 1) _ ps :=
  max (max_total_deg (λ (i : fin n), ps i)) (mv_polynomial.total_degree (ps n))

def total_deg_le_max_total_deg :
  Π {n m : ℕ} (ps : fin n → mv_polynomial (fin m) K) (i : fin n),
  mv_polynomial.total_degree (ps i) ≤ max_total_deg ps
| 0 _ ps i := fin_zero_elim i
| (n + 1) _ ps i :=
begin
  simp only [max_total_deg],
  rw le_max_iff,
  cases fin.lt_or_eq_fin i with h,
  {
    left,
    have hlt : (i : ℕ) < n,
    {
      rw fin.lt_coe_iff_val_lt i (nat.lt_succ_self _),
      exact h,
    },
    have hind :=
    @total_deg_le_max_total_deg n _ (λ j, ps j.val.cast) ⟨ i , hlt ⟩,
    simp only [fin.coe_eq_cast_succ, fin.cast_succ_mk, fin.eta] at hind,
    rw ← fin.coe_coe_eq_self i,
    exact hind,
  },
  {
    right,
    rw h,
  },
end

end max_total_deg

section alg_closed_field
open classical
local attribute [instance] prop_decidable

variables {K : Type*} [field K] [is_alg_closed K]

open Rings.struc_to_ring_struc

lemma realize_Ax_Groth_formula_of_char_p
  {p : ℕ} (hprime : prime p) (hchar : char_p K p) (n d : ℕ) :
  Structure K ⊨ Ax_Groth_formula n d :=
begin
  simp only [Ax_Groth_formula],
  simp only [realize_sentence_bd_alls],
  intro coeffs,
  simp only [realize_bounded_formula_imp],
  intro hinj,
  rw ← surjective_iff_realize_surj_formula,
  apply Ax_Groth_of_locally_finite hprime hchar,
  rw injective_iff_realize_inj_formula,
  exact hinj,
end

open Fields

lemma ACFₚ_ssatisfied_Ax_Groth_formula (n d p : ℕ) (hp : prime p) :
  (ACFₚ hp) ⊨ Ax_Groth_formula n d :=
sorry
-- ACFₚ is complete

lemma ACF₀_ssatisfied_Ax_Groth_formula (n d : ℕ) :
  ACF₀ ⊨ Ax_Groth_formula n d :=
sorry
-- Lefschetz

/-- The main result: algebraically closed fields of characteristic zero
   satisfy Ax-Grothendieck formula; follows from soundness -/
lemma realize_Ax_Groth_formula_of_char_zero
  (h0 : char_zero K) (n d : ℕ) :
  Structure K ⊨ Ax_Groth_formula n d :=
@ACF₀_ssatisfied_Ax_Groth_formula n d (Structure K) ⟨ 0 ⟩
    is_alg_closed_to.realize_ACF₀

lemma Ax_Groth_aux
  (h0 : char_zero K) {n d : ℕ}
  (ps : poly_map_data K n)
  (hdeg : ∀ (i : fin n), mv_polynomial.total_degree (ps i) ≤ d)
  (hinj : function.injective (poly_map ps)) :
  function.surjective (poly_map ps) :=
begin
  let coeffs := poly_map_data.coeffs_dvector' d ps,
  have hAG := realize_Ax_Groth_formula_of_char_zero h0 n d,
  simp only [realize_sentence_bd_alls, Ax_Groth_formula] at hAG,
  -- injective -> realize inj_formula
  have hInj : @realize_bounded_formula _ (struc_to_ring_struc.Structure K) _ _
    (poly_map_data.coeffs_dvector' d ps) (inj_formula n d) dvector.nil,
  {rw realize_inj_formula_iff_injective ps hdeg, exact hinj},
  rw ← realize_surj_formula_iff_surjective ps hdeg,
  -- apply realize_Ax_Groth to ps, i.e. apply hAG to its coefficients
  exact hAG coeffs hInj,
end

theorem Ax_Groth
  (h0 : char_zero K) {n : ℕ}
  (ps : poly_map_data K n) (hinj : function.injective (poly_map ps)) :
  function.surjective (poly_map ps) :=
Ax_Groth_aux h0 ps (total_deg_le_max_total_deg ps) hinj

end alg_closed_field
end AxGroth


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import measure_theory.decomposition.lebesgue

/-!
# Radon-Nikodym theorem

This file proves the Radon-Nikodym theorem. The Radon-Nikodym theorem states that, given measures
`μ, ν`, if `have_lebesgue_decomposition μ ν`, then `μ` is absolutely continuous with respect to
`ν` if and only if there exists a measurable function `f : α → ℝ≥0∞` such that `μ = fν`.
In particular, we have `f = rn_deriv μ ν`.

The Radon-Nikodym theorem will allow us to define many important concepts in probability theory,
most notably probability cumulative functions. It could also be used to define the conditional
expectation of a real function, but we take a different approach (see the file
`measure_theory/function/conditional_expectation`).

## Main results

* `measure_theory.measure.absolutely_continuous_iff_with_density_rn_deriv_eq` :
  the Radon-Nikodym theorem
* `measure_theory.signed_measure.absolutely_continuous_iff_with_density_rn_deriv_eq` :
  the Radon-Nikodym theorem for signed measures

## Tags

Radon-Nikodym theorem
-/

noncomputable theory
open_locale classical measure_theory nnreal ennreal

variables {α β : Type*} {m : measurable_space α}

namespace measure_theory

namespace measure

include m

lemma with_density_rn_deriv_eq
  (μ ν : measure α) [have_lebesgue_decomposition μ ν] (h : μ ≪ ν) :
  ν.with_density (rn_deriv μ ν) = μ :=
begin
  obtain ⟨hf₁, ⟨E, hE₁, hE₂, hE₃⟩, hadd⟩:= have_lebesgue_decomposition_spec μ ν,
  have : singular_part μ ν = 0,
  { refine le_antisymm (λ A hA, _) (measure.zero_le _),
    suffices : singular_part μ ν set.univ = 0,
    { rw [measure.coe_zero, pi.zero_apply, ← this],
      exact measure_mono (set.subset_univ _) },
    rw [← measure_add_measure_compl hE₁, hE₂, zero_add],
    have : (singular_part μ ν + ν.with_density (rn_deriv μ ν)) Eᶜ = μ Eᶜ,
    { rw ← hadd },
    rw [measure.coe_add, pi.add_apply, h hE₃] at this,
    exact (add_eq_zero_iff.1 this).1 },
  rw [this, zero_add] at hadd,
  exact hadd.symm
end

/-- **The Radon-Nikodym theorem**: Given two measures `μ` and `ν`, if
`have_lebesgue_decomposition μ ν`, then `μ` is absolutely continuous to `ν` if and only if
`ν.with_density (rn_deriv μ ν) = μ`. -/
theorem absolutely_continuous_iff_with_density_rn_deriv_eq
  {μ ν : measure α} [have_lebesgue_decomposition μ ν] :
  μ ≪ ν ↔ ν.with_density (rn_deriv μ ν) = μ :=
⟨with_density_rn_deriv_eq μ ν, λ h, h ▸ with_density_absolutely_continuous _ _⟩

lemma with_density_rn_deriv_to_real_eq {μ ν : measure α} [is_finite_measure μ]
  [have_lebesgue_decomposition μ ν] (h : μ ≪ ν) {i : set α} (hi : measurable_set i) :
  ∫ x in i, (μ.rn_deriv ν x).to_real ∂ν = (μ i).to_real :=
begin
  rw [integral_to_real, ← with_density_apply _ hi,
      with_density_rn_deriv_eq μ ν h],
  { measurability },
  { refine ae_lt_top (μ.measurable_rn_deriv ν)
      (lt_of_le_of_lt (lintegral_mono_set i.subset_univ) _).ne,
    rw [← with_density_apply _ measurable_set.univ,
        with_density_rn_deriv_eq μ ν h],
    exact measure_lt_top _ _ },
end

end measure

namespace signed_measure

include m

open measure vector_measure

theorem with_densityᵥ_rn_deriv_eq
  (s : signed_measure α) (μ : measure α) [sigma_finite μ]
  (h : s ≪ᵥ μ.to_ennreal_vector_measure) :
  μ.with_densityᵥ (s.rn_deriv μ) = s :=
begin
  rw [absolutely_continuous_ennreal_iff,
      (_ : μ.to_ennreal_vector_measure.ennreal_to_measure = μ),
      total_variation_absolutely_continuous_iff] at h,
  { ext1 i hi,
    rw [with_densityᵥ_apply (integrable_rn_deriv _ _) hi,
        rn_deriv, integral_sub,
        with_density_rn_deriv_to_real_eq h.1 hi,
        with_density_rn_deriv_to_real_eq h.2 hi],
    { conv_rhs { rw ← s.to_signed_measure_to_jordan_decomposition },
      erw vector_measure.sub_apply,
      rw [to_signed_measure_apply_measurable hi, to_signed_measure_apply_measurable hi] },
    all_goals { rw ← integrable_on_univ,
      refine integrable_on.restrict _ measurable_set.univ,
      refine ⟨_, has_finite_integral_to_real_of_lintegral_ne_top _⟩,
      { apply measurable.ae_strongly_measurable,
        measurability },
      { rw set_lintegral_univ,
        exact (lintegral_rn_deriv_lt_top _ _).ne } } },
  { exact equiv_measure.right_inv μ }
end

/-- The Radon-Nikodym theorem for signed measures. -/
theorem absolutely_continuous_iff_with_densityᵥ_rn_deriv_eq
  (s : signed_measure α) (μ : measure α) [sigma_finite μ] :
  s ≪ᵥ μ.to_ennreal_vector_measure ↔
  μ.with_densityᵥ (s.rn_deriv μ) = s :=
⟨with_densityᵥ_rn_deriv_eq s μ,
 λ h, h ▸ with_densityᵥ_absolutely_continuous _ _⟩

end signed_measure

end measure_theory


/-
Copyright (c) 2021 Alex Kontorovich, Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Kontorovich, Heather Macbeth
-/
import topology.algebra.constructions
import topology.homeomorph
import group_theory.group_action.basic
/-!
# Monoid actions continuous in the second variable

In this file we define class `has_continuous_const_smul`. We say `has_continuous_const_smul Γ T` if
`Γ` acts on `T` and for each `γ`, the map `x ↦ γ • x` is continuous. (This differs from
`has_continuous_smul`, which requires simultaneous continuity in both variables.)

## Main definitions

* `has_continuous_const_smul Γ T` : typeclass saying that the map `x ↦ γ • x` is continuous on `T`;
* `properly_discontinuous_smul`: says that the scalar multiplication `(•) : Γ → T → T`
  is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely
  many `γ:Γ` move `K` to have nontrivial intersection with `L`.
* `homeomorph.smul`: scalar multiplication by an element of a group `Γ` acting on `T`
  is a homeomorphism of `T`.

## Main results

* `is_open_map_quotient_mk_mul` : The quotient map by a group action is open.
* `t2_space_of_properly_discontinuous_smul_of_t2_space` : The quotient by a discontinuous group
  action of a locally compact t2 space is t2.

## Tags

Hausdorff, discrete group, properly discontinuous, quotient space

-/

open_locale topological_space pointwise

open filter set

local attribute [instance] mul_action.orbit_rel

/-- Class `has_continuous_const_smul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of multiplicative
actions, including (semi)modules and algebras.
-/
class has_continuous_const_smul (Γ : Type*) (T : Type*) [topological_space T] [has_scalar Γ T]
 : Prop :=
(continuous_const_smul : ∀ γ : Γ, continuous (λ x : T, γ • x))

/-- Class `has_continuous_const_vadd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is continuous in the second argument. We use the same class for all kinds of additive actions,
including (semi)modules and algebras.
-/
class has_continuous_const_vadd (Γ : Type*) (T : Type*) [topological_space T]
  [has_vadd Γ T] : Prop :=
(continuous_const_vadd : ∀ γ : Γ, continuous (λ x : T, γ +ᵥ x))

attribute [to_additive] has_continuous_const_smul

export has_continuous_const_smul (continuous_const_smul)

export has_continuous_const_vadd (continuous_const_vadd)

variables {M α β : Type*}

section has_scalar
variables [topological_space α] [has_scalar M α] [has_continuous_const_smul M α]

@[to_additive]
lemma filter.tendsto.const_smul {f : β → α} {l : filter β} {a : α} (hf : tendsto f l (𝓝 a))
  (c : M) :
  tendsto (λ x, c • f x) l (𝓝 (c • a)) :=
((continuous_const_smul _).tendsto _).comp hf

variables [topological_space β] {f : β → M} {g : β → α} {b : β} {s : set β}

@[to_additive]
lemma continuous_within_at.const_smul (hg : continuous_within_at g s b) (c : M) :
  continuous_within_at (λ x, c • g x) s b :=
hg.const_smul c

@[to_additive]
lemma continuous_at.const_smul (hg : continuous_at g b) (c : M) :
  continuous_at (λ x, c • g x) b :=
hg.const_smul c

@[to_additive]
lemma continuous_on.const_smul (hg : continuous_on g s) (c : M) :
  continuous_on (λ x, c • g x) s :=
λ x hx, (hg x hx).const_smul c

@[continuity, to_additive]
lemma continuous.const_smul (hg : continuous g) (c : M) :
  continuous (λ x, c • g x) :=
(continuous_const_smul _).comp hg

/-- If a scalar is central, then its right action is continuous when its left action is. -/
instance has_continuous_const_smul.op [has_scalar Mᵐᵒᵖ α] [is_central_scalar M α] :
  has_continuous_const_smul Mᵐᵒᵖ α :=
⟨ mul_opposite.rec $ λ c, by simpa only [op_smul_eq_smul] using continuous_const_smul c ⟩

@[to_additive] instance mul_opposite.has_continuous_const_smul :
  has_continuous_const_smul M αᵐᵒᵖ :=
⟨λ c, mul_opposite.continuous_op.comp $ mul_opposite.continuous_unop.const_smul c⟩

@[to_additive]
instance [has_scalar M β] [has_continuous_const_smul M β] :
  has_continuous_const_smul M (α × β) :=
⟨λ _, (continuous_fst.const_smul _).prod_mk (continuous_snd.const_smul _)⟩

@[to_additive]
instance {ι : Type*} {γ : ι → Type*} [∀ i, topological_space (γ i)] [Π i, has_scalar M (γ i)]
  [∀ i, has_continuous_const_smul M (γ i)] : has_continuous_const_smul M (Π i, γ i) :=
⟨λ _, continuous_pi $ λ i, (continuous_apply i).const_smul _⟩

end has_scalar

section monoid

variables [topological_space α]
variables [monoid M] [mul_action M α] [has_continuous_const_smul M α]

@[to_additive] instance units.has_continuous_const_smul : has_continuous_const_smul Mˣ α :=
{ continuous_const_smul := λ m, (continuous_const_smul (m : M) : _) }

@[to_additive]
lemma smul_closure_subset (c : M) (s : set α) : c • closure s ⊆ closure (c • s) :=
((set.maps_to_image _ _).closure $ continuous_id.const_smul c).image_subset

@[to_additive]
lemma smul_closure_orbit_subset (c : M) (x : α) :
  c • closure (mul_action.orbit M x) ⊆ closure (mul_action.orbit M x) :=
(smul_closure_subset c _).trans $ closure_mono $ mul_action.smul_orbit_subset _ _

end monoid

section group

variables {G : Type*} [topological_space α] [group G] [mul_action G α]
  [has_continuous_const_smul G α]

@[to_additive]
lemma tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} (c : G) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
⟨λ h, by simpa only [inv_smul_smul] using h.const_smul c⁻¹,
  λ h, h.const_smul _⟩

variables [topological_space β] {f : β → α} {b : β}  {s : set β}

@[to_additive]
lemma continuous_within_at_const_smul_iff (c : G) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
tendsto_const_smul_iff c

@[to_additive]
lemma continuous_on_const_smul_iff (c : G) : continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
forall₂_congr $ λ b hb, continuous_within_at_const_smul_iff c

@[to_additive]
lemma continuous_at_const_smul_iff (c : G) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
tendsto_const_smul_iff c

@[to_additive]
lemma continuous_const_smul_iff (c : G) :
  continuous (λ x, c • f x) ↔ continuous f :=
by simp only [continuous_iff_continuous_at, continuous_at_const_smul_iff]

/-- The homeomorphism given by scalar multiplication by a given element of a group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
@[to_additive] def homeomorph.smul (γ : G) : α ≃ₜ α :=
{ to_equiv := mul_action.to_perm γ,
  continuous_to_fun  := continuous_const_smul γ,
  continuous_inv_fun := continuous_const_smul γ⁻¹ }

/-- The homeomorphism given by affine-addition by an element of an additive group `Γ` acting on
  `T` is a homeomorphism from `T` to itself. -/
add_decl_doc homeomorph.vadd

@[to_additive]
lemma is_open_map_smul (c : G) : is_open_map (λ x : α, c • x) :=
(homeomorph.smul c).is_open_map

@[to_additive] lemma is_open.smul {s : set α} (hs : is_open s) (c : G) : is_open (c • s) :=
is_open_map_smul c s hs

@[to_additive]
lemma is_closed_map_smul (c : G) : is_closed_map (λ x : α, c • x) :=
(homeomorph.smul c).is_closed_map

@[to_additive] lemma is_closed.smul {s : set α} (hs : is_closed s) (c : G) : is_closed (c • s) :=
is_closed_map_smul c s hs

@[to_additive] lemma closure_smul (c : G) (s : set α) : closure (c • s) = c • closure s :=
((homeomorph.smul c).image_closure s).symm

@[to_additive] lemma interior_smul (c : G) (s : set α) : interior (c • s) = c • interior s :=
((homeomorph.smul c).image_interior s).symm

end group

section group_with_zero

variables {G₀ : Type*} [topological_space α] [group_with_zero G₀] [mul_action G₀ α]
  [has_continuous_const_smul G₀ α]

lemma tendsto_const_smul_iff₀ {f : β → α} {l : filter β} {a : α} {c : G₀} (hc : c ≠ 0) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
tendsto_const_smul_iff (units.mk0 c hc)

variables [topological_space β] {f : β → α} {b : β} {c : G₀} {s : set β}

lemma continuous_within_at_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
tendsto_const_smul_iff (units.mk0 c hc)

lemma continuous_on_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
continuous_on_const_smul_iff (units.mk0 c hc)

lemma continuous_at_const_smul_iff₀ (hc : c ≠ 0) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
continuous_at_const_smul_iff (units.mk0 c hc)

lemma continuous_const_smul_iff₀ (hc : c ≠ 0) :
  continuous (λ x, c • f x) ↔ continuous f :=
continuous_const_smul_iff (units.mk0 c hc)

/-- Scalar multiplication by a non-zero element of a group with zero acting on `α` is a
homeomorphism from `α` onto itself. -/
protected def homeomorph.smul_of_ne_zero (c : G₀) (hc : c ≠ 0) : α ≃ₜ α :=
homeomorph.smul (units.mk0 c hc)

lemma is_open_map_smul₀ {c : G₀} (hc : c ≠ 0) : is_open_map (λ x : α, c • x) :=
(homeomorph.smul_of_ne_zero c hc).is_open_map

lemma is_open.smul₀ {c : G₀} {s : set α} (hs : is_open s) (hc : c ≠ 0) : is_open (c • s) :=
is_open_map_smul₀ hc s hs

lemma interior_smul₀ {c : G₀} (hc : c ≠ 0) (s : set α) : interior (c • s) = c • interior s :=
((homeomorph.smul_of_ne_zero c hc).image_interior s).symm

lemma closure_smul₀ {E} [has_zero E] [mul_action_with_zero G₀ E] [topological_space E]
  [t1_space E] [has_continuous_const_smul G₀ E] (c : G₀) (s : set E) :
  closure (c • s) = c • closure s :=
begin
  rcases eq_or_ne c 0 with rfl|hc,
  { rcases eq_empty_or_nonempty s with rfl|hs,
    { simp },
    { rw [zero_smul_set hs, zero_smul_set hs.closure], exact closure_singleton } },
  { exact ((homeomorph.smul_of_ne_zero c hc).image_closure s).symm }
end

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `is_closed_map_smul_left` in `analysis.normed_space.finite_dimension`. -/
lemma is_closed_map_smul_of_ne_zero {c : G₀} (hc : c ≠ 0) : is_closed_map (λ x : α, c • x) :=
(homeomorph.smul_of_ne_zero c hc).is_closed_map

lemma is_closed.smul_of_ne_zero {c : G₀} {s : set α} (hs : is_closed s) (hc : c ≠ 0) :
  is_closed (c • s) :=
is_closed_map_smul_of_ne_zero hc s hs

/-- `smul` is a closed map in the second argument.

The lemma that `smul` is a closed map in the first argument (for a normed space over a complete
normed field) is `is_closed_map_smul_left` in `analysis.normed_space.finite_dimension`. -/
lemma is_closed_map_smul₀ {𝕜 M : Type*} [division_ring 𝕜] [add_comm_monoid M] [topological_space M]
  [t1_space M] [module 𝕜 M] [has_continuous_const_smul 𝕜 M] (c : 𝕜) :
  is_closed_map (λ x : M, c • x) :=
begin
  rcases eq_or_ne c 0 with (rfl|hne),
  { simp only [zero_smul], exact is_closed_map_const },
  { exact (homeomorph.smul_of_ne_zero c hne).is_closed_map },
end

lemma is_closed.smul₀ {𝕜 M : Type*} [division_ring 𝕜] [add_comm_monoid M] [topological_space M]
  [t1_space M] [module 𝕜 M] [has_continuous_const_smul 𝕜 M] (c : 𝕜) {s : set M} (hs : is_closed s) :
  is_closed (c • s) :=
is_closed_map_smul₀ c s hs

end group_with_zero

namespace is_unit

variables [monoid M] [topological_space α] [mul_action M α] [has_continuous_const_smul M α]

lemma tendsto_const_smul_iff {f : β → α} {l : filter β} {a : α} {c : M} (hc : is_unit c) :
  tendsto (λ x, c • f x) l (𝓝 $ c • a) ↔ tendsto f l (𝓝 a) :=
let ⟨u, hu⟩ := hc in hu ▸ tendsto_const_smul_iff u

variables [topological_space β] {f : β → α} {b : β} {c : M} {s : set β}

lemma continuous_within_at_const_smul_iff (hc : is_unit c) :
  continuous_within_at (λ x, c • f x) s b ↔ continuous_within_at f s b :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_within_at_const_smul_iff u

lemma continuous_on_const_smul_iff (hc : is_unit c) :
  continuous_on (λ x, c • f x) s ↔ continuous_on f s :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_on_const_smul_iff u

lemma continuous_at_const_smul_iff (hc : is_unit c) :
  continuous_at (λ x, c • f x) b ↔ continuous_at f b :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_at_const_smul_iff u

lemma continuous_const_smul_iff (hc : is_unit c) :
  continuous (λ x, c • f x) ↔ continuous f :=
let ⟨u, hu⟩ := hc in hu ▸ continuous_const_smul_iff u

lemma is_open_map_smul (hc : is_unit c) : is_open_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ is_open_map_smul u

lemma is_closed_map_smul (hc : is_unit c) : is_closed_map (λ x : α, c • x) :=
let ⟨u, hu⟩ := hc in hu ▸ is_closed_map_smul u

end is_unit

/-- Class `properly_discontinuous_smul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class properly_discontinuous_smul (Γ : Type*) (T : Type*) [topological_space T]
  [has_scalar Γ T] : Prop :=
(finite_disjoint_inter_image : ∀ {K L : set T}, is_compact K → is_compact L →
  set.finite {γ : Γ | (((•) γ) '' K) ∩ L ≠ ∅ })

/-- Class `properly_discontinuous_vadd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`, only finitely many
`γ:Γ` move `K` to have nontrivial intersection with `L`.
-/
class properly_discontinuous_vadd (Γ : Type*) (T : Type*) [topological_space T]
  [has_vadd Γ T] : Prop :=
(finite_disjoint_inter_image : ∀ {K L : set T}, is_compact K → is_compact L →
  set.finite {γ : Γ | (((+ᵥ) γ) '' K) ∩ L ≠ ∅ })

attribute [to_additive] properly_discontinuous_smul

variables {Γ : Type*} [group Γ] {T : Type*} [topological_space T] [mul_action Γ T]

/-- A finite group action is always properly discontinuous
-/
@[priority 100, to_additive] instance fintype.properly_discontinuous_smul [fintype Γ] :
  properly_discontinuous_smul Γ T :=
{ finite_disjoint_inter_image := λ _ _ _ _, set.finite.of_fintype _}

export properly_discontinuous_smul (finite_disjoint_inter_image)

export properly_discontinuous_vadd (finite_disjoint_inter_image)

/-- The quotient map by a group action is open. -/
@[to_additive]
lemma is_open_map_quotient_mk_mul [has_continuous_const_smul Γ T] :
  is_open_map (quotient.mk : T → quotient (mul_action.orbit_rel Γ T)) :=
begin
  intros U hU,
  rw [is_open_coinduced, mul_action.quotient_preimage_image_eq_union_mul U],
  exact is_open_Union (λ γ, (homeomorph.smul γ).is_open_map U hU)
end

/-- The quotient by a discontinuous group action of a locally compact t2 space is t2. -/
@[priority 100, to_additive] instance t2_space_of_properly_discontinuous_smul_of_t2_space
  [t2_space T] [locally_compact_space T] [has_continuous_const_smul Γ T]
  [properly_discontinuous_smul Γ T] : t2_space (quotient (mul_action.orbit_rel Γ T)) :=
begin
  set Q := quotient (mul_action.orbit_rel Γ T),
  rw t2_space_iff_nhds,
  let f : T → Q := quotient.mk,
  have f_op : is_open_map f := is_open_map_quotient_mk_mul,
  rintros ⟨x₀⟩ ⟨y₀⟩ (hxy : f x₀ ≠ f y₀),
  show ∃ (U ∈ 𝓝 (f x₀)) (V ∈ 𝓝 (f y₀)), U ∩ V = ∅,
  have hx₀y₀ : x₀ ≠ y₀ := ne_of_apply_ne _ hxy,
  have hγx₀y₀ : ∀ γ : Γ, γ • x₀ ≠ y₀ := not_exists.mp (mt quotient.sound hxy.symm : _),
  obtain ⟨K₀, L₀, K₀_in, L₀_in, hK₀, hL₀, hK₀L₀⟩ := t2_separation_compact_nhds hx₀y₀,
  let bad_Γ_set := {γ : Γ | (((•) γ) '' K₀) ∩ L₀ ≠ ∅ },
  have bad_Γ_finite : bad_Γ_set.finite := finite_disjoint_inter_image hK₀ hL₀,
  choose u v hu hv u_v_disjoint using λ γ, t2_separation_nhds (hγx₀y₀ γ),
  let U₀₀ := ⋂ γ ∈ bad_Γ_set, ((•) γ) ⁻¹' (u γ),
  let U₀ := U₀₀ ∩ K₀,
  let V₀₀ := ⋂ γ ∈ bad_Γ_set, v γ,
  let V₀ := V₀₀ ∩ L₀,
  have U_nhds : f '' U₀ ∈ 𝓝 (f x₀),
  { apply f_op.image_mem_nhds (inter_mem ((bInter_mem bad_Γ_finite).mpr $ λ γ hγ, _) K₀_in),
    exact (continuous_const_smul _).continuous_at (hu γ) },
  have V_nhds : f '' V₀ ∈ 𝓝 (f y₀),
    from f_op.image_mem_nhds (inter_mem ((bInter_mem bad_Γ_finite).mpr $ λ γ hγ, hv γ) L₀_in),
  refine ⟨f '' U₀, U_nhds, f '' V₀, V_nhds, _⟩,
  rw mul_action.image_inter_image_iff,
  rintros x ⟨x_in_U₀₀, x_in_K₀⟩ γ,
  by_cases H : γ ∈ bad_Γ_set,
  { rintros ⟨h, -⟩,
    exact eq_empty_iff_forall_not_mem.mp (u_v_disjoint γ) (γ • x)
      ⟨(mem_Inter₂.mp x_in_U₀₀ γ H : _), mem_Inter₂.mp h γ H⟩ },
  { rintros ⟨-, h'⟩,
    simp only [image_smul, not_not, mem_set_of_eq, ne.def] at H,
    exact eq_empty_iff_forall_not_mem.mp H (γ • x) ⟨mem_image_of_mem _ x_in_K₀, h'⟩ },
end

section nhds

section mul_action

variables {G₀ : Type*} [group_with_zero G₀] [mul_action G₀ α]
  [topological_space α] [has_continuous_const_smul G₀ α]

/-- Scalar multiplication preserves neighborhoods. -/
lemma set_smul_mem_nhds_smul {c : G₀} {s : set α} {x : α} (hs : s ∈ 𝓝 x) (hc : c ≠ 0) :
  c • s ∈ 𝓝 (c • x : α) :=
begin
  rw mem_nhds_iff at hs ⊢,
  obtain ⟨U, hs', hU, hU'⟩ := hs,
  exact ⟨c • U, set.smul_set_mono hs', hU.smul₀ hc, set.smul_mem_smul_set hU'⟩,
end

lemma set_smul_mem_nhds_smul_iff {c : G₀} {s : set α} {x : α} (hc : c ≠ 0) :
  c • s ∈ 𝓝 (c • x : α) ↔ s ∈ 𝓝 x :=
begin
  refine ⟨λ h, _, λ h, set_smul_mem_nhds_smul h hc⟩,
  rw [←inv_smul_smul₀ hc x, ←inv_smul_smul₀ hc s],
  exact set_smul_mem_nhds_smul h (inv_ne_zero hc),
end

end mul_action

section distrib_mul_action

variables {G₀ : Type*} [group_with_zero G₀] [add_monoid α] [distrib_mul_action G₀ α]
  [topological_space α] [has_continuous_const_smul G₀ α]

lemma set_smul_mem_nhds_zero_iff {s : set α} {c : G₀} (hc : c ≠ 0) :
  c • s ∈ 𝓝 (0 : α) ↔ s ∈ 𝓝 (0 : α) :=
begin
  refine iff.trans _ (set_smul_mem_nhds_smul_iff hc),
  rw smul_zero,
end

end distrib_mul_action

end nhds


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

! This file was ported from Lean 3 source module topology.algebra.order.group
! leanprover-community/mathlib commit 84dc0bd6619acaea625086d6f53cb35cdd554219
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Order.Basic
import Mathlib.Topology.Algebra.Group.Basic

/-!
# Topology on a linear ordered additive commutative group

In this file we prove that a linear ordered additive commutative group with order topology is a
topological group. We also prove continuity of `abs : G → G` and provide convenience lemmas like
`ContinuousAt.abs`.
-/

open Set Filter

open Topology Filter

variable {α G : Type _} [TopologicalSpace G] [LinearOrderedAddCommGroup G] [OrderTopology G]

variable {l : Filter α} {f g : α → G}

-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedAddCommGroup.topologicalAddGroup : TopologicalAddGroup G
    where
  continuous_add := by
    refine' continuous_iff_continuousAt.2 _
    rintro ⟨a, b⟩
    refine' LinearOrderedAddCommGroup.tendsto_nhds.2 fun ε ε0 => _
    rcases dense_or_discrete 0 ε with (⟨δ, δ0, δε⟩ | ⟨_h₁, h₂⟩)
    · -- If there exists `δ ∈ (0, ε)`, then we choose `δ`-nhd of `a` and `(ε-δ)`-nhd of `b`
      filter_upwards [(eventually_abs_sub_lt a δ0).prod_nhds
          (eventually_abs_sub_lt b (sub_pos.2 δε))]
      rintro ⟨x, y⟩ ⟨hx : |x - a| < δ, hy : |y - b| < ε - δ⟩
      rw [add_sub_add_comm]
      calc
        |x - a + (y - b)| ≤ |x - a| + |y - b| := abs_add _ _
        _ < δ + (ε - δ) := add_lt_add hx hy
        _ = ε := add_sub_cancel'_right _ _

    · -- Otherwise `ε`-nhd of each point `a` is `{a}`
      have hε : ∀ {x y}, |x - y| < ε → x = y :=
        by
        intro x y h
        simpa [sub_eq_zero] using h₂ _ h
      filter_upwards [(eventually_abs_sub_lt a ε0).prod_nhds (eventually_abs_sub_lt b ε0)]
      rintro ⟨x, y⟩ ⟨hx : |x - a| < ε, hy : |y - b| < ε⟩
      simpa [hε hx, hε hy]
  continuous_neg :=
    continuous_iff_continuousAt.2 fun a =>
      LinearOrderedAddCommGroup.tendsto_nhds.2 fun ε ε0 =>
        (eventually_abs_sub_lt a ε0).mono fun x hx => by rwa [neg_sub_neg, abs_sub_comm]
#align linear_ordered_add_comm_group.topological_add_group LinearOrderedAddCommGroup.topologicalAddGroup

@[continuity]
theorem continuous_abs : Continuous (abs : G → G) :=
  continuous_id.max continuous_neg
#align continuous_abs continuous_abs

protected theorem Filter.Tendsto.abs {a : G} (h : Tendsto f l (𝓝 a)) :
    Tendsto (fun x => |f x|) l (𝓝 (|a|)) :=
  (continuous_abs.tendsto _).comp h
#align filter.tendsto.abs Filter.Tendsto.abs

theorem tendsto_zero_iff_abs_tendsto_zero (f : α → G) :
    Tendsto f l (𝓝 0) ↔ Tendsto (abs ∘ f) l (𝓝 0) := by
  refine' ⟨fun h => (abs_zero : |(0 : G)| = 0) ▸ h.abs, fun h => _⟩
  have : Tendsto (fun a => -|f a|) l (𝓝 0) := (neg_zero : -(0 : G) = 0) ▸ h.neg
  exact
    tendsto_of_tendsto_of_tendsto_of_le_of_le this h (fun x => neg_abs_le_self <| f x) fun x =>
      le_abs_self <| f x
#align tendsto_zero_iff_abs_tendsto_zero tendsto_zero_iff_abs_tendsto_zero

variable [TopologicalSpace α] {a : α} {s : Set α}

protected theorem Continuous.abs (h : Continuous f) : Continuous fun x => |f x| :=
  continuous_abs.comp h
#align continuous.abs Continuous.abs

protected theorem ContinuousAt.abs (h : ContinuousAt f a) : ContinuousAt (fun x => |f x|) a :=
  Filter.Tendsto.abs h
#align continuous_at.abs ContinuousAt.abs

protected theorem ContinuousWithinAt.abs (h : ContinuousWithinAt f s a) :
    ContinuousWithinAt (fun x => |f x|) s a :=
  Filter.Tendsto.abs h
#align continuous_within_at.abs ContinuousWithinAt.abs

protected theorem ContinuousOn.abs (h : ContinuousOn f s) : ContinuousOn (fun x => |f x|) s :=
  fun x hx => (h x hx).abs
#align continuous_on.abs ContinuousOn.abs

theorem tendsto_abs_nhdsWithin_zero : Tendsto (abs : G → G) (𝓝[≠] 0) (𝓝[>] 0) :=
  (continuous_abs.tendsto' (0 : G) 0 abs_zero).inf <|
    tendsto_principal_principal.2 fun _x => abs_pos.2
#align tendsto_abs_nhds_within_zero tendsto_abs_nhdsWithin_zero


/- Simplifier -/

example (p : Nat → Prop) : (x + 0) * (0 + y * 1 + z * 0) = x * y := by
  simp

example (p : Nat → Prop) (h : p (x * y)) : p ((x + 0) * (0 + y * 1 + z * 0)) := by
  simp; assumption

example (p : Nat → Prop) (h : p ((x + 0) * (0 + y * 1 + z * 0))) : p (x * y) := by
  simp at h; assumption

def f (m n : Nat) : Nat :=
  m + n + m

example (h : n = 1) (h' : 0 = m) : (f m n) = n := by
  simp [h, ←h', f]

example (p : Nat → Prop) (h₁ : x + 0 = x') (h₂ : y + 0 = y')
        : x + y + 0 = x' + y' := by
  simp at *
  simp [*]


variable f : ℕ → ℕ
variable h : ∀ x : ℕ, f x ≤ f (x + 1)

example : f 0 ≥ f 1 → f 0 = f 1 :=
  assume : f 0 ≥ f 1,
  show f 0 = f 1, from le_antisymm (h 0) this


import game.world8.level12 -- hide
namespace mynat -- hide

/-

# Advanced Addition World

## Level 13: `ne_succ_self`

The last level in Advanced Addition World is the statement
that $n\not=\operatorname{succ}(n)$. When you've done this
you've completed Advanced Addition World and can move on
to Advanced Multiplication World (after first doing
Multiplication World, if you didn't do it already).
-/

/- Lemma
For any natural number $n$, we have
$$ n \neq \operatorname{succ}(n). $$
-/
lemma ne_succ_self (n : mynat) : n ≠ succ n :=
begin [nat_num_game]
  induction n with d hd,
    apply zero_ne_succ,
  intro hs,
  apply hd,
  apply succ_inj,
  assumption

end

end mynat -- hide


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Ken Lee, Chris Hughes
-/
import algebra.big_operators.basic
import data.fintype.basic
import data.int.gcd
import ring_theory.coprime.basic

/-!
# Additional lemmas about elements of a ring satisfying `is_coprime`

These lemmas are in a separate file to the definition of `is_coprime` as they require more imports.

Notably, this includes lemmas about `finset.prod` as this requires importing big_operators, and
lemmas about `has_pow` since these are easiest to prove via `finset.prod`.

-/

universes u v

variables {R : Type u} {I : Type v} [comm_semiring R] {x y z : R} {s : I → R} {t : finset I}

open_locale big_operators classical

theorem nat.is_coprime_iff_coprime {m n : ℕ} : is_coprime (m : ℤ) n ↔ nat.coprime m n :=
⟨λ ⟨a, b, H⟩, nat.eq_one_of_dvd_one $ int.coe_nat_dvd.1 $ by { rw [int.coe_nat_one, ← H],
  exact dvd_add (dvd_mul_of_dvd_right (int.coe_nat_dvd.2 $ nat.gcd_dvd_left m n) _)
    (dvd_mul_of_dvd_right (int.coe_nat_dvd.2 $ nat.gcd_dvd_right m n) _) },
λ H, ⟨nat.gcd_a m n, nat.gcd_b m n, by rw [mul_comm _ (m : ℤ), mul_comm _ (n : ℤ),
    ← nat.gcd_eq_gcd_ab, show _ = _, from H, int.coe_nat_one]⟩⟩

theorem is_coprime.prod_left : (∀ i ∈ t, is_coprime (s i) x) → is_coprime (∏ i in t, s i) x :=
finset.induction_on t (λ _, is_coprime_one_left) $ λ b t hbt ih H,
by { rw finset.prod_insert hbt, rw finset.forall_mem_insert at H, exact H.1.mul_left (ih H.2) }

theorem is_coprime.prod_right : (∀ i ∈ t, is_coprime x (s i)) → is_coprime x (∏ i in t, s i) :=
by simpa only [is_coprime_comm] using is_coprime.prod_left

theorem is_coprime.prod_left_iff : is_coprime (∏ i in t, s i) x ↔ ∀ i ∈ t, is_coprime (s i) x :=
finset.induction_on t (iff_of_true is_coprime_one_left $ λ _, false.elim) $ λ b t hbt ih,
by rw [finset.prod_insert hbt, is_coprime.mul_left_iff, ih, finset.forall_mem_insert]

theorem is_coprime.prod_right_iff : is_coprime x (∏ i in t, s i) ↔ ∀ i ∈ t, is_coprime x (s i) :=
by simpa only [is_coprime_comm] using is_coprime.prod_left_iff

theorem is_coprime.of_prod_left (H1 : is_coprime (∏ i in t, s i) x) (i : I) (hit : i ∈ t) :
  is_coprime (s i) x :=
is_coprime.prod_left_iff.1 H1 i hit

theorem is_coprime.of_prod_right (H1 : is_coprime x (∏ i in t, s i)) (i : I) (hit : i ∈ t) :
  is_coprime x (s i) :=
is_coprime.prod_right_iff.1 H1 i hit

theorem finset.prod_dvd_of_coprime :
  ∀ (Hs : (t : set I).pairwise (is_coprime on s)) (Hs1 : ∀ i ∈ t, s i ∣ z),
  ∏ x in t, s x ∣ z :=
finset.induction_on t (λ _ _, one_dvd z)
begin
  intros a r har ih Hs Hs1,
  rw finset.prod_insert har,
  have aux1 : a ∈ (↑(insert a r) : set I) := finset.mem_insert_self a r,
  refine (is_coprime.prod_right $ λ i hir, Hs aux1 (finset.mem_insert_of_mem hir)
    $ by { rintro rfl, exact har hir }).mul_dvd
    (Hs1 a aux1) (ih (Hs.mono _) $ λ i hi, Hs1 i $ finset.mem_insert_of_mem hi),
  simp only [finset.coe_insert, set.subset_insert],
end

theorem fintype.prod_dvd_of_coprime [fintype I] (Hs : pairwise (is_coprime on s))
  (Hs1 : ∀ i, s i ∣ z) : ∏ x, s x ∣ z :=
finset.prod_dvd_of_coprime (Hs.set_pairwise _) (λ i _, Hs1 i)

variables {m n : ℕ}

theorem is_coprime.pow_left (H : is_coprime x y) : is_coprime (x ^ m) y :=
by { rw [← finset.card_range m, ← finset.prod_const], exact is_coprime.prod_left (λ _ _, H) }

theorem is_coprime.pow_right (H : is_coprime x y) : is_coprime x (y ^ n) :=
by { rw [← finset.card_range n, ← finset.prod_const], exact is_coprime.prod_right (λ _ _, H) }

theorem is_coprime.pow (H : is_coprime x y) : is_coprime (x ^ m) (y ^ n) :=
H.pow_left.pow_right

theorem is_coprime.pow_left_iff (hm : 0 < m) : is_coprime (x ^ m) y ↔ is_coprime x y :=
begin
  refine ⟨λ h, _, is_coprime.pow_left⟩,
  rw [← finset.card_range m, ← finset.prod_const] at h,
  exact h.of_prod_left 0 (finset.mem_range.mpr hm),
end

theorem is_coprime.pow_right_iff (hm : 0 < m) : is_coprime x (y ^ m) ↔ is_coprime x y :=
is_coprime_comm.trans $ (is_coprime.pow_left_iff hm).trans $ is_coprime_comm

theorem is_coprime.pow_iff (hm : 0 < m) (hn : 0 < n) :
  is_coprime (x ^ m) (y ^ n) ↔ is_coprime x y :=
(is_coprime.pow_left_iff hm).trans $ is_coprime.pow_right_iff hn


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.finset.basic
import data.multiset.intervals

/-!
# Intervals in ℕ as finsets

For now this only covers `Ico n m`, the "closed-open" interval containing `[n, ..., m-1]`.
-/

namespace finset
open multiset nat

/-! ### intervals -/
/- Ico (a closed open interval) -/
variables {n m l : ℕ}

/-- `Ico n m` is the set of natural numbers `n ≤ k < m`. -/
def Ico (n m : ℕ) : finset ℕ := ⟨_, Ico.nodup n m⟩

namespace Ico

@[simp] theorem val (n m : ℕ) : (Ico n m).1 = multiset.Ico n m := rfl

@[simp] theorem to_finset (n m : ℕ) : (multiset.Ico n m).to_finset = Ico n m :=
(multiset.to_finset_eq _).symm

theorem image_add (n m k : ℕ) : (Ico n m).image ((+) k) = Ico (n + k) (m + k) :=
by simp [image, multiset.Ico.map_add]

theorem image_sub (n m k : ℕ) (h : k ≤ n) : (Ico n m).image (λ x, x - k) = Ico (n - k) (m - k) :=
begin
  dsimp [image],
  rw [multiset.Ico.map_sub _ _ _ h, ←multiset.to_finset_eq],
  refl,
end

theorem zero_bot (n : ℕ) : Ico 0 n = range n :=
eq_of_veq $ multiset.Ico.zero_bot _

@[simp] theorem card (n m : ℕ) : (Ico n m).card = m - n :=
multiset.Ico.card _ _

@[simp] theorem mem {n m l : ℕ} : l ∈ Ico n m ↔ n ≤ l ∧ l < m :=
multiset.Ico.mem

@[simp, norm_cast] lemma coe_eq_Ico {n m : ℕ} : ↑(Ico n m) = set.Ico n m :=
begin
  ext,
  rw [set.mem_Ico, mem_coe, finset.Ico.mem],
end

theorem eq_empty_of_le {n m : ℕ} (h : m ≤ n) : Ico n m = ∅ :=
eq_of_veq $ multiset.Ico.eq_zero_of_le h

@[simp] theorem self_eq_empty (n : ℕ) : Ico n n = ∅ :=
eq_empty_of_le $ le_refl n

@[simp] theorem eq_empty_iff {n m : ℕ} : Ico n m = ∅ ↔ m ≤ n :=
iff.trans val_eq_zero.symm multiset.Ico.eq_zero_iff

theorem subset_iff {m₁ n₁ m₂ n₂ : ℕ} (hmn : m₁ < n₁) :
  Ico m₁ n₁ ⊆ Ico m₂ n₂ ↔ (m₂ ≤ m₁ ∧ n₁ ≤ n₂) :=
begin
  simp only [subset_iff, mem],
  refine ⟨λ h, ⟨_, _⟩, _⟩,
  { exact (h ⟨le_refl _, hmn⟩).1 },
  { refine le_of_pred_lt (@h (pred n₁) ⟨le_pred_of_lt hmn, pred_lt _⟩).2,
    exact ne_of_gt (lt_of_le_of_lt (nat.zero_le m₁) hmn) },
  { rintros ⟨hm, hn⟩ k ⟨hmk, hkn⟩,
    exact ⟨le_trans hm hmk, lt_of_lt_of_le hkn hn⟩ }
end

protected theorem subset {m₁ n₁ m₂ n₂ : ℕ} (hmm : m₂ ≤ m₁) (hnn : n₁ ≤ n₂) :
  Ico m₁ n₁ ⊆ Ico m₂ n₂ :=
begin
  simp only [finset.subset_iff, Ico.mem],
  assume x hx,
  exact ⟨le_trans hmm hx.1, lt_of_lt_of_le hx.2 hnn⟩
end

lemma union_consecutive {n m l : ℕ} (hnm : n ≤ m) (hml : m ≤ l) :
  Ico n m ∪ Ico m l = Ico n l :=
by rw [← to_finset, ← to_finset, ← multiset.to_finset_add,
  multiset.Ico.add_consecutive hnm hml, to_finset]

lemma union' {n m l k : ℕ} (hlm : l ≤ m) (hnk : n ≤ k) :
  Ico n m ∪ Ico l k = Ico (min n l) (max m k) :=
by simp [←coe_inj, set.Ico_union_Ico' hlm hnk]

lemma union {n m l k : ℕ} (h₁ : min n m ≤ max l k) (h₂ : min l k ≤ max n m) :
  Ico n m ∪ Ico l k = Ico (min n l) (max m k) :=
by simp [←coe_inj, set.Ico_union_Ico h₁ h₂]

@[simp] lemma inter_consecutive (n m l : ℕ) : Ico n m ∩ Ico m l = ∅ :=
begin
  rw [← to_finset, ← to_finset, ← multiset.to_finset_inter, multiset.Ico.inter_consecutive],
  simp,
end

lemma inter {n m l k : ℕ} : Ico n m ∩ Ico l k = Ico (max n l) (min m k) :=
by simp [←coe_inj, ←inf_eq_min, ←sup_eq_max, set.Ico_inter_Ico]

lemma disjoint_consecutive (n m l : ℕ) : disjoint (Ico n m) (Ico m l) :=
le_of_eq $ inter_consecutive n m l

@[simp] theorem succ_singleton (n : ℕ) : Ico n (n+1) = {n} :=
eq_of_veq $ multiset.Ico.succ_singleton

theorem succ_top {n m : ℕ} (h : n ≤ m) : Ico n (m + 1) = insert m (Ico n m) :=
by rw [← to_finset, multiset.Ico.succ_top h, multiset.to_finset_cons, to_finset]

theorem succ_top' {n m : ℕ} (h : n < m) : Ico n m = insert (m - 1) (Ico n (m - 1)) :=
begin
  have w : m = m - 1 + 1 := (nat.sub_add_cancel (nat.one_le_of_lt h)).symm,
  conv { to_lhs, rw w },
  rw succ_top,
  exact nat.le_pred_of_lt h
end

theorem insert_succ_bot {n m : ℕ} (h : n < m) : insert n (Ico (n + 1) m) = Ico n m :=
by rw [eq_comm, ← to_finset, multiset.Ico.eq_cons h, multiset.to_finset_cons, to_finset]

@[simp] theorem pred_singleton {m : ℕ} (h : 0 < m) : Ico (m - 1) m = {m - 1} :=
eq_of_veq $ multiset.Ico.pred_singleton h

@[simp] theorem not_mem_top {n m : ℕ} : m ∉ Ico n m :=
multiset.Ico.not_mem_top

lemma filter_lt_of_top_le {n m l : ℕ} (hml : m ≤ l) : (Ico n m).filter (λ x, x < l) = Ico n m :=
eq_of_veq $ multiset.Ico.filter_lt_of_top_le hml

lemma filter_lt_of_le_bot {n m l : ℕ} (hln : l ≤ n) : (Ico n m).filter (λ x, x < l) = ∅ :=
eq_of_veq $ multiset.Ico.filter_lt_of_le_bot hln

lemma filter_Ico_bot {n m : ℕ} (hnm : n < m) : (Ico n m).filter (λ x, x ≤ n) = {n} :=
eq_of_veq $ multiset.Ico.filter_le_of_bot hnm

lemma filter_lt_of_ge {n m l : ℕ} (hlm : l ≤ m) : (Ico n m).filter (λ x, x < l) = Ico n l :=
eq_of_veq $ multiset.Ico.filter_lt_of_ge hlm

@[simp] lemma filter_lt (n m l : ℕ) : (Ico n m).filter (λ x, x < l) = Ico n (min m l) :=
eq_of_veq $ multiset.Ico.filter_lt n m l

lemma filter_le_of_le_bot {n m l : ℕ} (hln : l ≤ n) : (Ico n m).filter (λ x, l ≤ x) = Ico n m :=
eq_of_veq $ multiset.Ico.filter_le_of_le_bot hln

lemma filter_le_of_top_le {n m l : ℕ} (hml : m ≤ l) : (Ico n m).filter (λ x, l ≤ x) = ∅ :=
eq_of_veq $ multiset.Ico.filter_le_of_top_le hml

lemma filter_le_of_le {n m l : ℕ} (hnl : n ≤ l) : (Ico n m).filter (λ x, l ≤ x) = Ico l m :=
eq_of_veq $ multiset.Ico.filter_le_of_le hnl

@[simp] lemma filter_le (n m l : ℕ) : (Ico n m).filter (λ x, l ≤ x) = Ico (max n l) m :=
eq_of_veq $ multiset.Ico.filter_le n m l

@[simp] lemma diff_left (l n m : ℕ) : (Ico n m) \ (Ico n l) = Ico (max n l) m :=
by ext k; by_cases n ≤ k; simp [h, and_comm]

@[simp] lemma diff_right (l n m : ℕ) : (Ico n m) \ (Ico l m) = Ico n (min m l) :=
have ∀k, (k < m ∧ (l ≤ k → m ≤ k)) ↔ (k < m ∧ k < l) :=
  assume k, and_congr_right $ assume hk, by rw [← not_imp_not]; simp [hk],
by ext k; by_cases n ≤ k; simp [h, this]

lemma image_const_sub {k m n : ℕ} (hkn : k ≤ n) :
  (Ico k m).image (λ j, n - j) = Ico (n + 1 - m) (n + 1 - k) :=
begin
  rw [nat.sub_add_comm hkn],
  ext j,
  simp only [mem, mem_image, exists_prop, nat.lt_iff_add_one_le, add_le_add_iff_right],
  split,
  { rintros ⟨j, ⟨hjk, hjm⟩, rfl⟩,
    split,
    { simp only [← nat.add_sub_add_right n 1 j, nat.sub_le_sub_left, hjm] },
    { exact nat.sub_le_sub_left _ hjk } },
  { rintros ⟨hm, hk⟩,
    have hj : j ≤ n := le_trans hk (nat.sub_le_self _ _),
    refine ⟨n - j, ⟨_, _⟩, _⟩,
    { apply nat.le_sub_right_of_add_le,
      rwa nat.le_sub_left_iff_add_le hkn at hk },
    { rwa [← nat.sub_add_comm hj, nat.sub_le_iff] },
    { exact nat.sub_sub_self hj } }
end

end Ico

lemma range_eq_Ico (n : ℕ) : finset.range n = finset.Ico 0 n :=
by { ext i, simp }

lemma range_image_pred_top_sub (n : ℕ) :
  (finset.range n).image (λ j, n - 1 - j) = finset.range n :=
begin
  cases n,
  { simp },
  { simp [range_eq_Ico, Ico.image_const_sub] }
end

-- TODO We don't yet attempt to reproduce the entire interface for `Ico` for `Ico_ℤ`.

/-- `Ico_ℤ l u` is the set of integers `l ≤ k < u`. -/
def Ico_ℤ (l u : ℤ) : finset ℤ :=
(finset.range (u - l).to_nat).map
  { to_fun := λ n, n + l,
    inj' := λ n m h, by simpa using h }

@[simp] lemma Ico_ℤ.mem {n m l : ℤ} : l ∈ Ico_ℤ n m ↔ n ≤ l ∧ l < m :=
begin
  dsimp [Ico_ℤ],
  simp only [int.lt_to_nat, exists_prop, mem_range, add_comm, function.embedding.coe_fn_mk,
    mem_map],
  split,
  { rintro ⟨a, ⟨h, rfl⟩⟩,
    exact ⟨int.le.intro rfl, lt_sub_iff_add_lt'.mp h⟩ },
  { rintro ⟨h₁, h₂⟩,
    use (l - n).to_nat,
    split; simp [h₁, h₂], }
end

@[simp] lemma Ico_ℤ.card (l u : ℤ) : (Ico_ℤ l u).card = (u - l).to_nat := by simp [Ico_ℤ]

end finset