/-
Author: Adrián Doña Mateo
-/

import data.int.gcd
import data.nat.totient
import data.list.forall2
import ring_theory.polynomial.homogeneous
import field_theory.finite.basic
import algebra.module.basic
import tactic
import .int .mv_polynomial .finset .homogeneous .zmod .coprime .prime .modeq .bezout .multiset

/-!
# IMO 2017 Q6

An ordered pair `(x,y)` of integers is a primitive root if the greatest common divisor of
`x` and `y` is `1`. Given a finite set S of primitive points, prove that there exists a positive
integer `n` and integers `a₀, a₁, ..., aₙ` such that, for each `(x,y)` in `S`, we have:

  `a₀xⁿ + a₁xⁿ⁻¹y + a₂xⁿ⁻²y² + ⋯ + aₙ₋₁xyⁿ⁻¹ + aₙyⁿ = 1.α`
-/

noncomputable theory

open mv_polynomial (hiding X) int (hiding range)
open_locale big_operators

/-- An ordered pair `(x,y)` of integers is a primitive root of the greatest commond divisor
of `x` and `y` is `1` -/
def primitive_root (p : ℤ × ℤ) : Prop := int.gcd p.fst p.snd = 1

attribute [instance] semiring.to_semimodule
namespace primitive_root

lemma neg {p : ℤ × ℤ} (h : primitive_root p) : primitive_root (-p) :=
by { unfold primitive_root at *, simp, unfold int.gcd at *, simpa }

/-- If two primitive are multiples of each other they must either be the same primitive root
or the negation of each other -/
lemma of_mul_primitive {p : ℤ × ℤ} {n : ℤ} (h : primitive_root (n • p)) :
  primitive_root p ∧ (n = 1 ∨ n = -1) :=
begin
  have hn : n = 1 ∨ n = -1,
  { simp [primitive_root] at h,
    have hn : n ∣ ↑1 := by { rw [← h], apply int.dvd_gcd; apply dvd_mul_right },
    exact dvd_one hn },
  split, swap, { exact hn },
  cases hn with h1 hn1,
  {	rwa [h1, one_smul] at h },
  rw [hn1, neg_smul, one_smul] at h,
  rw [←neg_neg p], exact neg h,
end

end primitive_root

local notation `polyℤ` := mv_polynomial (fin 2) ℤ

lemma sq_eq_one {φ : polyℤ} {xy : fin 2 → ℤ} :
  eval xy φ = 1 ∨ eval xy φ = -1 → eval xy (φ * φ) = 1 :=
λ h, by rwa [eval_mul, mul_self_eq_one_iff]

/-- In a homogeneous polynomial `φ`, all monomials have the same degree -/
theorem monomial_deg {φ : polyℤ} {n : ℕ} (hφ : is_homogeneous φ n) :
  ∀ ⦃d⦄, coeff d φ ≠ 0 → d 0 + d 1 = n :=
begin
  intros d hcoeff,
  rw ← hφ hcoeff,
  show _ = d.sum (λ _ x, x),
  rw finsupp.sum_fintype,
  {	refl },
  intro, refl,
end

lemma even_iff_eq_zero_mod_two {n : ℕ} : even n ↔ n % 2 = 0 :=
by rw [even_iff_two_dvd, nat.dvd_iff_mod_eq_zero]

lemma not_even_iff_eq_one_mod_two {n : ℕ} : ¬ even n ↔ n % 2 = 1 :=
begin
  rw [not_iff_comm, even_iff_eq_zero_mod_two],
  split, swap,
  { intros h hn, rw h at hn, contradiction },
  intro h,
  have : n % 2 < 2 := nat.mod_lt _ (by norm_num),
  interval_cases (n % 2), { assumption }, contradiction,
end

/-- If a homogeneous polynomial `φ` evaluates to an integer a at some `(x, y)`, then it evaluates
to `±a` at `(-x, -y)`. This shows that it is enough to consider a set `S` where no two primitive
roots are multiples of each other -/
lemma eval_pm_of_homogeneous_at_neg {φ : polyℤ} {n : ℕ} (xy : fin 2 → ℤ)
  (hφ : is_homogeneous φ n) :
  eval (λ i, - xy i) φ = eval xy φ ∨ eval (λ i, - xy i) φ = - eval xy φ :=
begin
  rw [eval_eq', eval_eq'],
  have h : ∀ {d : fin 2 →₀ ℕ}, ∏ i, (-xy i) ^ d i = (-1) ^ (d 0 + d 1) * ∏ i, xy i ^ d i,
  {	intro d,
    show ((-xy 0) ^ _) * ((-xy 1) ^ _ * 1) = _ * (((xy 0) ^ _) * ((xy 1) ^ _ * 1)),
    set x := xy 0, set y := xy 1, simp,
    calc (-x) ^ d 0 * (-y) ^ d 1
        = (-1 * x) ^ d 0 * (-1 * y) ^ d 1          : by simp
    ... = (-1) ^ (d 0 + d 1) * (x ^ d 0 * y ^ d 1) : by ring_exp },
  by_cases hn : even n,
  {	left,	congr, ext d,
    by_cases hc : coeff d φ = 0, { simp [hc] },
    congr' 1,
    have hd : (d 0 + d 1) % 2 = 0 :=
      by rwa [monomial_deg hφ hc, ← even_iff_eq_zero_mod_two],
    rw [h, neg_one_pow_eq_pow_mod_two, hd, pow_zero, one_mul] },
  right,
  rw ← finset.sum_neg_distrib,
  congr, ext d,
  by_cases hc : coeff d φ = 0, { simp [hc] },
  rw neg_mul_eq_mul_neg, congr,
  have hd : (d 0 + d 1) % 2 = 1 :=
    by rwa [monomial_deg hφ hc, ← not_even_iff_eq_one_mod_two],
  rw [h, neg_one_pow_eq_pow_mod_two, hd, pow_one, ← neg_eq_neg_one_mul],
end

def to_val (p : ℤ × ℤ) : fin 2 → ℤ
| ⟨0, _⟩   := p.1
| ⟨1, _⟩   := p.2
| ⟨n+2, h⟩ := absurd h (by simp)

lemma to_val_neg (p : ℤ × ℤ) : to_val (-p) = λ i, -to_val p i :=
begin
  ext i, fin_cases i,
  {	show (-p).1 = -p.1, simp },
  show (-p).2 = -p.2, simp,
end

def solution_of_minimal_set_solution {S T : finset (ℤ × ℤ)} (hS : ∀ s ∈ S, primitive_root s)
  (hT : ∀ s ∈ S, ∃ (t ∈ T) (n : ℤ), s = n • t) :
  { φn : polyℤ × ℕ // 0 < φn.2 ∧ φn.1.is_homogeneous φn.2 ∧
    ∀ t ∈ T, eval (to_val t) φn.1 = 1 } →
  { φn : polyℤ × ℕ // 0 < φn.2 ∧ φn.1.is_homogeneous φn.2 ∧
    ∀ s ∈ S, eval (to_val s) φn.1 = 1 } :=
λ ⟨φn, h⟩, ⟨⟨φn.1 ^ 2, φn.2 * 2⟩,
  nat.mul_pos h.1 (nat.succ_pos 1),
  by apply h.2.1.pow 2,
  λ s hs,
begin
  rcases hT s hs with ⟨t, ht, n, rfl⟩,
  rcases primitive_root.of_mul_primitive (hS _ hs) with ⟨htprim, rfl | rfl⟩,
  {	rw [one_smul, eval_pow, h.2.2 t ht, one_pow] },
  rw [neg_one_smul, to_val_neg, eval_pow],
  rcases eval_pm_of_homogeneous_at_neg (to_val t) h.2.1 with h1 | hn1,
  { rw [h1, h.2.2 t ht, one_pow] },
  simp [hn1, h.2.2 t ht],
end⟩

section finset

open finset

theorem minimal_primitive_root_set {S : finset (ℤ × ℤ)} (hS : ∀ s ∈ S, primitive_root s) :
  { T : finset (ℤ × ℤ) // T ⊆ S ∧ (∀ t ∈ T, primitive_root t) ∧
  (∀ t₁ t₂ ∈ T, (∃ n : ℤ, t₂ = n • t₁) → t₂ = t₁) ∧ (∀ s ∈ S, ∃ (t ∈ T) (n : ℤ), s = n • t) } :=
begin
  apply classical.subtype_of_exists, apply S.induction_on',
  {	use ∅, simp },
  rintros a R haS hR hanR ⟨T, hTR, hTprim, hTmul, hT⟩,
  by_cases h : ∃ (r ∈ R) (n : ℤ), a = n • r,
  {	use [T, subset.trans hTR (subset_insert _ _), hTprim, hTmul],
    intros a ha,
    rcases finset.mem_insert.mp ha with rfl | ha, swap,
    {	exact hT a ha },
    rcases h with ⟨r, hr, n, hn⟩,
    rcases hT r hr with ⟨t, ht, m, hm⟩,
    use [t, ht, n * m], rw [hn, hm, mul_smul] },
  use [insert a T, insert_subset_insert a hTR],
  repeat { split },
  { intros t ht,
    rcases mem_insert.mp ht with rfl | ht,
    {	exact hS t haS },
    exact hTprim t ht }, swap,
  {	intros s hs,
    rcases mem_insert.mp hs with rfl | hs,
    {	use [s, mem_insert_self _ _, 1, by simp] },
    rcases hT s hs with ⟨t, ht, n, hn⟩,
    use [t, mem_insert_of_mem ht, n, hn] },
  intros t₁ t₂ ht₁ ht₂ hn,
  rcases mem_insert.mp ht₁ with rfl | ht₁', swap,
  { rcases mem_insert.mp ht₂ with rfl | ht₂',
    { exfalso, apply h, use [t₁, mem_of_subset hTR ht₁'], exact hn },
    exact hTmul t₁ t₂ ht₁' ht₂' hn },
  rcases mem_insert.mp ht₂ with rfl | ht₂',
  { refl },
  exfalso,
  rcases hn with ⟨n, rfl⟩,
  apply h,
  use [n • t₁, mem_of_subset hTR ht₂', n],
  rw ← mul_smul,
  rcases primitive_root.of_mul_primitive (hTprim _ ht₂') with ⟨_, rfl | rfl⟩; simp,
end

end finset

/- From the past two theorems, we deduce that there is no harm in assuming that `S` has no
primitive roots that are multiples of another primitive root in `S`. Moreover, it suffices
to find a polynomial that evaluates to `1` or `-1` at each point in `S`. The next theorem lets
us extract such a subset from any `S`. -/

/-- Convenient names for the two variables in an xy_poly -/
def X : polyℤ := mv_polynomial.X 0
def Y : polyℤ := mv_polynomial.X 1

section reduced

open finset

variable S : finset (ℤ × ℤ)
variable hSprim : ∀ s ∈ S, primitive_root s
variable hSmul : ∀ s₁ s₂ ∈ S, (∃ n : ℤ, s₂ = n • s₁) → s₂ = s₁

def l (p : ℤ × ℤ) : polyℤ := C p.2 * X - C p.1 * Y
def g (p : ℤ × ℤ) : polyℤ := ∏ s in S.erase p, l s

lemma l_eval (p q : ℤ × ℤ) : eval (to_val q) (l p) = p.2 * q.1 - p.1 * q.2 :=
begin
  unfold l, simp [eval_monomial],
  congr; { simp [X, Y], refl },
end

lemma l_is_homogeneous (p : ℤ × ℤ) : is_homogeneous (l p) 1 :=
begin
  unfold l,	rw sub_eq_add_neg,
  apply is_homogeneous.add,
  { unfold X mv_polynomial.X,
    rw C_mul_monomial,
    apply is_homogeneous_monomial,
    rw [finsupp.support_single_ne_zero (nat.one_ne_zero), sum_singleton], simp },
  unfold Y mv_polynomial.X,
  convert @is_homogeneous_monomial (fin 2) ℤ _ (finsupp.single 1 1) (-p.1) 1 _,
  { conv_rhs { rw [← mul_one (-p.1), ← C_mul_monomial] }, simp },
  rw [finsupp.support_single_ne_zero (nat.one_ne_zero), sum_singleton], simp,
end

lemma g_is_homogeneous {s : ℤ × ℤ} : s ∈ S → is_homogeneous (g S s) (S.card - 1) :=
begin
  intro hs,
  rw [← nat.pred_eq_sub_one, ← card_erase_of_mem hs],
  unfold g,
  convert is_homogeneous.prod (S.erase s) (λ s, l s) (λ _, 1) (λ s _, l_is_homogeneous s),
  simp,
end

lemma exists_eval_one {p : ℤ × ℤ} (h : primitive_root p) :
  ∃ φ : polyℤ, is_homogeneous φ 1 ∧ eval (to_val p) φ = 1 :=
begin
  rcases exists_mul_eq_gcd p.1 p.2 with ⟨a, b, hab⟩,
  unfold primitive_root at h, simp [h] at hab,
  use C a * X + C b * Y, split, swap,
  { simp [eval_monomial],
    rw [mul_comm a, mul_comm b, ← hab],
    congr; { unfold X Y, simp, refl } },
  apply is_homogeneous.add;
  { unfold X Y mv_polynomial.X,
    rw C_mul_monomial,
    apply is_homogeneous_monomial,
    rw [finsupp.support_single_ne_zero (nat.one_ne_zero), sum_singleton], simp },
end

include hSprim hSmul
lemma l_zero_iff {s t : ℤ × ℤ} (hs : s ∈ S) (ht : t ∈ S) : eval (to_val t) (l s) = 0 ↔ t = s :=
begin
  split, swap,
  { rintro rfl, rw [l_eval], ring },
  intro heval,
  rw [l_eval, sub_eq_zero] at heval,
  rcases mul_of_coprime_mul (hSprim s hs) heval.symm with ⟨n, h2, h1⟩,
  apply hSmul s t hs ht,
  use n,
  rw prod.eq_iff_fst_eq_snd_eq, simp, use [h1, h2],
end

lemma g_zero_iff {s t : ℤ × ℤ} (hs : s ∈ S) (ht : t ∈ S) : eval (to_val t) (g S s) = 0 ↔ t ≠ s :=
begin
  unfold g,
  rw [eval_prod, prod_eq_zero_iff],
  split,
  {	rintro ⟨t', ht', heval⟩ rfl,
    rw l_zero_iff S hSprim hSmul (mem_of_mem_erase ht') ht at heval,
    rw heval at ht', exact not_mem_erase t' S ht' },
  intro hts,
  use [t, mem_erase_of_ne_of_mem hts ht],
  rw l_zero_iff S hSprim hSmul ht ht,
end

lemma g_degree_ge {s : ℤ × ℤ} (hs : s ∈ S) {n : ℕ} (hn : S.card - 1 ≤ n) :
  { φ : polyℤ // φ.is_homogeneous n ∧ ∀ t ∈ S, eval (to_val t) φ = eval (to_val t) (g S s) } :=
begin
  apply classical.subtype_of_exists,
  rcases exists_eval_one (hSprim s hs) with ⟨ψ, hψhom, hψeval⟩,
  use ψ ^ (n - (S.card - 1)) * g S s,
  split,
  {	convert @is_homogeneous.mul _ _ _ _ _ (n - (S.card - 1)) (S.card - 1) _ (g_is_homogeneous S hs),
    { rw nat.sub_add_cancel hn },
    conv { congr, skip, rw ← nat.one_mul (n - _)},
    apply is_homogeneous.pow hψhom },
  intros t ht, rw [eval_mul, eval_pow],
  by_cases hts : t = s,
  {	rw [hts, hψeval, one_pow, one_mul] },
  rw [(g_zero_iff S hSprim hSmul hs ht).mpr hts, mul_zero],
end
omit hSprim hSmul

local notation `ϕ` := nat.totient

def homogeneous_one_at_coprime_of_prime_power (p k : ℕ) (hp : p.prime) :
  { φn : polyℤ × ℕ // 0 < φn.2 ∧ φn.1.is_homogeneous φn.2 ∧
  ∀ t, primitive_root t → eval (to_val t) φn.1 ≡ 1 [ZMOD ↑(p ^ k)] } :=
begin
  apply classical.subtype_of_exists,
  rcases nat.prime.eq_two_or_odd hp with rfl | hodd,
  {	have two_pos : 0 < 2 := by norm_num,
    use ⟨(X ^ 2 + X * Y + Y ^ 2) ^ (ϕ (2 ^ k)), 2 * ϕ (2 ^ k)⟩, split,
    { exact nat.mul_pos two_pos (nat.totient_pos $ pow_pos two_pos k) }, split,
    { have hhom : (X ^ 2 + X * Y + Y ^ 2).is_homogeneous 2,
      { rw [pow_two, pow_two],
        repeat { apply is_homogeneous.add };
        { apply is_homogeneous.mul; { unfold X Y, apply is_homogeneous_X } } },
      apply is_homogeneous.pow hhom },
    intros t ht,
    rw eval_pow,
    apply modeq.pow_totient,
    conv { congr, simp [X, Y], change t.1 ^ 2 + t.1 * t.2 + t.2 ^ 2, skip, simp },
    apply is_coprime.pow_right,
    rcases @modeq.exists_unique_equiv t.1 2 (by norm_num) with ⟨x, hx1, hx2, hx⟩,
    rcases @modeq.exists_unique_equiv t.2 2 (by norm_num) with ⟨y, hy1, hy2, hy⟩,
    interval_cases x,
    { interval_cases y,
      { have := int.dvd_gcd (modeq.modeq_zero_iff.mp hx.symm) (modeq.modeq_zero_iff.mp hy.symm),
        unfold primitive_root at ht, simp [ht] at this,
        cases dvd_one this; linarith },
      change is_coprime _ ↑2,
      rw int.is_coprime_prime nat.prime_two,
      intro hdvd,
      rw ← modeq.modeq_zero_iff at hdvd,
      change _ ≡ _ [ZMOD ↑2] at hx,
      change _ ≡ _ [ZMOD ↑2] at hy,
      rw ← zmod.int_coe_eq_int_coe_iff at *,
      simp [← hx, ← hy, zero_pow] at hdvd,
      exact hdvd },
    interval_cases y,
    {	change is_coprime _ ↑2,
      rw int.is_coprime_prime nat.prime_two,
      intro hdvd,
      rw ← modeq.modeq_zero_iff at hdvd,
      change _ ≡ _ [ZMOD ↑2] at hx,
      change _ ≡ _ [ZMOD ↑2] at hy,
      rw ← zmod.int_coe_eq_int_coe_iff at *,
      simp [← hx, ← hy, zero_pow] at hdvd,
      exact hdvd },
    change is_coprime _ ↑2,
    rw int.is_coprime_prime nat.prime_two,
    intro hdvd,
    rw ← modeq.modeq_zero_iff at hdvd,
    change _ ≡ _ [ZMOD ↑2] at hx,
    change _ ≡ _ [ZMOD ↑2] at hy,
    rw ← zmod.int_coe_eq_int_coe_iff at *,
    simp [← hx, ← hy] at hdvd,
    have : (1 : zmod 2) + 1 = 0 := by ring,
    simp [this] at hdvd,
    exact hdvd },
  have p_gt_two : 2 < p,
  { by_contradiction h,
    have := le_of_not_gt h,
    interval_cases p,
    { exact nat.not_prime_zero hp },
    { exact nat.not_prime_one hp },
    simp at hodd, exact hodd },
  use ⟨(X ^ (p - 1) + Y ^ (p - 1)) ^ (ϕ (p ^ k)), (p - 1) * ϕ (p ^ k)⟩, split,
  { apply mul_pos (lt_trans nat.zero_lt_one _) (nat.totient_pos $ pow_pos _ _),
    { rw ← nat.pred_eq_sub_one, change nat.pred 2 < p.pred,
      apply nat.pred_lt_pred _ p_gt_two, norm_num },
    exact lt_trans (by norm_num) p_gt_two }, split,
  { apply is_homogeneous.pow (is_homogeneous.add _ _);
    { conv { congr, skip, rw ← nat.one_mul (p - 1) },
      apply is_homogeneous.pow, unfold X Y, apply is_homogeneous_X } },
  intros t ht,
  rw eval_pow,
  apply modeq.pow_totient,
  conv { congr, simp [X, Y], change t.1 ^ (p - 1) + t.2 ^ (p - 1), skip, simp },
  apply is_coprime.pow_right,
  rw is_coprime_prime hp,
  rw [← modeq.modeq_zero_iff, ← nat.totient_prime hp],
  by_cases hx : ↑p ∣ t.1,
  { by_cases hy : ↑p ∣ t.2,
    {	exfalso, apply nat.prime.not_dvd_one hp (coe_nat_dvd.mp _),
      unfold primitive_root at ht, rw ← ht,
      apply int.dvd_gcd hx hy },
    have : t.1 ^ p.totient ≡ 0 [ZMOD p] := modeq.modeq_zero_iff.mpr (dvd_pow hx $
      ne_of_gt (nat.totient_pos $ lt_trans (by norm_num) p_gt_two)),
    simp [← zmod.int_coe_eq_int_coe_iff] at *,
    rw [this, zero_add, ← cast_pow, ← cast_zero, zmod.int_coe_eq_int_coe_iff],
    have h1 : t.2 ^ p.totient ≡ 1 [ZMOD p] := modeq.pow_totient ((is_coprime_prime hp).mpr hy),
    intro h0,
    apply nat.prime.not_dvd_one hp,
    simp [← coe_nat_dvd, ← modeq.modeq_zero_iff],
    exact modeq.trans h1.symm h0 },
  have hx1 : t.1 ^ p.totient ≡ 1 [ZMOD p] := modeq.pow_totient ((is_coprime_prime hp).mpr hx),
  by_cases hy : ↑p ∣ t.2,
  { have : t.2 ^ p.totient ≡ 0 [ZMOD p] := modeq.modeq_zero_iff.mpr (dvd_pow hy $
      ne_of_gt (nat.totient_pos $ lt_trans (by norm_num) p_gt_two)),
    simp [← zmod.int_coe_eq_int_coe_iff] at this,
    simp [← zmod.int_coe_eq_int_coe_iff],
    rw [this, add_zero, ← cast_pow, ← cast_zero, zmod.int_coe_eq_int_coe_iff],
    intro h0,
    apply nat.prime.not_dvd_one hp,
    simp [← coe_nat_dvd, ← modeq.modeq_zero_iff],
    exact modeq.trans hx1.symm h0 },
  have hy1 : t.2 ^ p.totient ≡ 1 [ZMOD p] := modeq.pow_totient ((is_coprime_prime hp).mpr hy),
  simp [← zmod.int_coe_eq_int_coe_iff] at *,
  simp [hx1, hy1],
  convert_to ¬ (↑2 : zmod p) = ↑0, { simp, ring_nf },
  rw zmod.eq_iff_modeq_nat,
  apply (nat.modeq.not_modeq_lt_iff p_gt_two (nat.prime.pos hp)).mpr,
  norm_num,
end

def homogeneous_one_at_coprime {a : ℕ} (ha : 0 < a) :
  { φn : polyℤ × ℕ // 0 < φn.2 ∧ φn.1.is_homogeneous φn.2 ∧
  ∀ t, primitive_root t → eval (to_val t) φn.1 ≡ 1 [ZMOD a] } :=
begin
  apply classical.subtype_of_exists,
  by_cases ha1 : a ≤ 1,
  {	have : a = 1 := by linarith, rw this at *,
    use [⟨X + Y, 1⟩, by simp], split,
    {	apply is_homogeneous.add; { unfold X Y, apply is_homogeneous_X } },
    intros t ht, unfold int.modeq, simp },
  let factors := nat.factors a,
  let primes : list (ℕ × ℕ) := factors.erase_dup.map (λ p, ⟨p, list.count p factors⟩),
  have hprimes : ∀ {pk : ℕ × ℕ}, pk ∈ primes → nat.prime pk.1,
  { rintro ⟨p, k⟩ hpk, simp,
    simp [primes, list.mem_map] at hpk,
    rcases hpk with ⟨a, ha, rfl, _⟩,
    exact nat.mem_factors ha },
  let removepowers : list ℤ := primes.map (λ pk, a / pk.1 ^ pk.2),
  have hdvdra : ∀ x ∈ removepowers, x ∣ ↑a,
  { intros x hx, simp [removepowers, primes, factors] at hx,
    rcases hx with ⟨p, hp, hx⟩,
    use p ^ list.count p a.factors,
    rw [← hx, int.div_mul_cancel _],
    norm_cast, apply nat.pow_count_factors_dvd },
  have hcoprime : (removepowers.foldr euclidean_domain.gcd 0).nat_abs = 1,
  {	by_contradiction h,
    cases list.exists_mem_of_ne_nil (nat.factors_ne_nil $ lt_of_not_ge ha1) with p hmem,
    have h1 : 1 < (removepowers.foldr euclidean_domain.gcd 0).nat_abs,
    {	by_contradiction hn1, have := le_of_not_gt hn1,
      interval_cases (list.foldr euclidean_domain.gcd 0 removepowers).nat_abs, swap,
      {	exact h h_1 },
      rw [nat_abs_eq_zero, list_gcd_eq_zero] at h_1,
      simp [removepowers, primes, factors] at h_1,
      apply nat.div_factor_ne_zero a p hmem,
      apply_mod_cast h_1 p hmem },
    have hdvdr : ∀ x ∈ removepowers, ↑((list.foldr euclidean_domain.gcd 0 removepowers).nat_abs) ∣ x,
    {	intros x hx, rw nat_abs_dvd, apply list_gcd_dvd _ _ hx },
    have hdvd : ((list.foldr euclidean_domain.gcd 0 removepowers).nat_abs : ℤ) ∣ a,
    { cases @list.exists_mem_of_ne_nil _ removepowers _ with x hx, swap,
      { simp [removepowers, primes, factors, nat.factors_ne_nil (lt_of_not_ge ha1)] },
      apply dvd.trans (hdvdr x hx) (hdvdra x hx) },
    norm_cast at hdvd,
    cases list.exists_mem_of_ne_nil (nat.factors_ne_nil $ h1) with p hp,
    have hpa := (nat.mem_factors_iff_dvd ha (nat.mem_factors hp)).mpr
      (dvd.trans (nat.mem_factors_dvd p hp) hdvd),
    have hpr : ↑a / ↑p ^ list.count p a.factors ∈ removepowers,
    { simp [removepowers, primes, factors],
      use [p, hpa], },
    apply nat.pow_gt_count_factors_not_dvd ha (nat.mem_factors hp)
      (list.count p a.factors).succ (nat.lt_succ_self _),
    have hpp : (p : ℤ) ∣ ↑a / ↑p ^ list.count p a.factors,
    {	apply dvd.trans _ (hdvdr _ hpr),
      norm_cast, apply nat.mem_factors_dvd _ hp },
    cases hpp with u hu,
    rw ← coe_nat_dvd,
    use u,
    rw [pow_succ, nat.mul_comm, int.coe_nat_mul, mul_assoc, ← hu, mul_comm],
    norm_cast,
    rw [nat.div_mul_cancel (nat.pow_count_factors_dvd _ _)] },
  let bezout := abs_bezout_factors removepowers,
  let φs : list (polyℤ × ℕ) :=
    primes.pmap (λ pk hp, homogeneous_one_at_coprime_of_prime_power pk.1 pk.2 hp) @hprimes,
  let K : ℕ := list.foldr nat.lcm 1 (φs.map prod.snd),
  let coeffs : list polyℤ := list.zip_with (*) (bezout.map C) (removepowers.map C),
  let ψs : list polyℤ := φs.map (λ φn, φn.1 ^ (K / φn.2)),
  use [(list.zip_with (*) coeffs ψs).sum, K], split,
  { -- Show that 0 < n
    apply nat.list_lcm_pos, intros n hn,
    simp at hn, rcases hn with ⟨φ, p, k, hpk, hφn⟩,
    rcases subtype.coe_eq_iff.mp hφn with ⟨⟨hpos, _⟩, _⟩,
    exact hpos },
  split,
  { -- Show that the constructed polynomial is homogeneous
    convert is_homogeneous.zip_with_mul_sum_homogeneous coeffs ψs 0 K _ _, { simp },
    {	intros xy hxy, dsimp [coeffs] at hxy,
      simp only [list.mem_iff_nth, list.nth_zip_with_eq_some] at hxy,
      rcases hxy with ⟨n, x, y, hx, hy, rfl⟩,
      rcases list.mem_map.mp (list.mem_iff_nth.mpr ⟨n, hx⟩) with ⟨_, _, rfl⟩,
      rcases list.mem_map.mp (list.mem_iff_nth.mpr ⟨n, hy⟩) with ⟨_, _, rfl⟩,
      rw [← nat.add_zero 0],
      apply is_homogeneous.mul; apply is_homogeneous_C },
    intros φ' hφ',
    simp only [ψs, φs, list.pmap, list.mem_pmap, list.mem_map, prod.mk.inj_iff,
      list.mem_erase_dup, list.map, prod.exists] at hφ',
    rcases hφ' with ⟨φ, n, ⟨p, k, hpk, hφ⟩, rfl⟩,
    rcases subtype.coe_eq_iff.mp hφ with ⟨⟨_, hhom, _⟩, _⟩,
    convert @is_homogeneous.pow _ _ _ φ n hhom _,
    rw [nat.mul_comm, nat.div_mul_cancel _],
    convert nat.list_dvd_lcm _ n _,
    simp only [list.mem_pmap, list.mem_map, exists_eq_right, prod.exists],
    use [φ, p, k, hpk, hφ] },
  intros t ht, dsimp [coeffs],
  have hmod :
    ((removepowers.zip_with (*) (ψs.map (eval (to_val t)))).map coe : list (zmod a)) =
    removepowers.map coe,
  {	rw [← list.forall₂_eq_eq_eq, list.forall₂_iff_zip], split, { simp },
    intros qψ q h, dsimp [removepowers, ψs, φs] at h,
    conv at h
    { congr, skip, congr, congr, skip, congr, skip,
      rw [← list.pmap_eq_map (λ _, true) _ _ (λ _ _, trivial), list.pmap_eq_map_attach], skip,
      rw [list.map_map, list.pmap_eq_map_attach, list.map_map], skip, congr, skip,
      rw [← list.pmap_eq_map (λ _, true) _ _ (λ _ _, trivial), list.pmap_eq_map_attach] },
    rw [list.zip_with_map', list.map_map, list.map_map, list.zip_map'] at h,
    simp at h, rcases h with ⟨p, k, ⟨hpk, rfl⟩, rfl⟩,
    rw [← cast_pow, ← cast_mul, zmod.int_coe_eq_int_coe_iff],
    have hdvd : (p : ℤ) ^ k ∣ ↑a,
    { rcases hpk with ⟨p, hp, rfl, rfl⟩, norm_cast, apply nat.pow_count_factors_dvd },
    conv { congr, rw [← int.div_mul_cancel hdvd], skip, skip,
      rw ← int.mul_one (↑a / ↑p ^ k) },
    apply modeq.modeq_mul_left', { norm_cast, apply zero_le },
    apply modeq.pow_modeq_one,
    rcases (homogeneous_one_at_coprime_of_prime_power p k
      (@hprimes ⟨p, k⟩ (by simp [hpk]))).property with ⟨_, _, h⟩,
    change eval (to_val t) (homogeneous_one_at_coprime_of_prime_power p k _).val.fst ≡ 1 [ZMOD ↑p ^ k],
    convert h t ht, norm_cast },
  rw [eval_list_sum, eval_zip_with_mul, eval_zip_with_mul, list.map_map, list.map_map],
  conv in (bezout.map _)
  { change bezout.map (λ x, eval (to_val t) (C x)),
    simp only [eval_C], change bezout.map id, rw [list.map_id] },
  conv in (removepowers.map _)
  { change removepowers.map (λ x, eval (to_val t) (C x)),
    simp only [eval_C], change removepowers.map id, rw [list.map_id] },
  rw [list.zip_with_assoc mul_assoc, ← zmod.int_coe_eq_int_coe_iff, ← coe_cast_ring_hom,
    ring_hom.map_list_sum, list.map_zip_with],
  simp only [ring_hom.map_mul],
  rw [← list.zip_with_map'', coe_cast_ring_hom, hmod, ← coe_cast_ring_hom],
  simp only [← ring_hom.map_mul, list.zip_with_map'', ← ring_hom.map_mul, ← list.map_zip_with],
  rw [← ring_hom.map_list_sum, list.zip_with_comm mul_comm],
  dsimp [bezout], rw [abs_bezout_eq_gcd], congr, rw [abs_eq_nat_abs, hcoprime, int.coe_nat_one],
end

end reduced

open multiset

def imo2017q6 (S : finset (ℤ × ℤ)) (hS : ∀ t ∈ S, primitive_root t) :
  { φn : polyℤ × ℕ // 0 < φn.2 ∧ φn.1.is_homogeneous φn.2 ∧
    ∀ t ∈ S, eval (to_val t) φn.1 = 1 } :=
begin
  rcases minimal_primitive_root_set hS with ⟨T, hTS, hT, hTind, hTspan⟩,
  apply solution_of_minimal_set_solution hS hTspan,
  let a := (T.val.map (λ t, eval (to_val t) (g T t))).lcm.nat_abs,
  have ha : ∀ t ∈ T, eval (to_val t) (g T t) ∣ a :=
    λ t ht, dvd_nat_abs.mpr (dvd_lcm $ mem_map.mpr ⟨t, finset.mem_def.mp ht, rfl⟩),
  -- ψn.val.1 is a homogeneous polynomial that evaluates to 1 [ZMOD a] at any primitive root
  let ψm := @homogeneous_one_at_coprime a _, swap,
  {	apply nat_abs_pos_of_ne_zero, rw lcm_ne_zero_iff,
    intros x hx hg, rw mem_map at hx,
    rcases hx with ⟨y, hy, rfl⟩,
    rw g_zero_iff T hT hTind hy hy at hg, exact hg (eq.refl y) },
  let k := T.card / ψm.val.2 + 1,
  have hk : ψm.val.2 * k ≥ T.card - 1,
  {	apply nat.le_of_lt (nat.lt_of_le_of_lt (nat.pred_le T.card) _), rw mul_comm,
    exact nat.lt_mul_of_div_lt (nat.lt_succ_self _) ψm.property.1, },
  -- we construct our polynomial by subtracting the appropriate multiples of the g's from ψn.1
  -- ψn.1 - map
  use ψm.val.1 ^ k +
    (T.val.pmap
      (λ t ht, C
        ((1 - eval (to_val t) (ψm.val.1 ^ k)) / eval (to_val t) (g T t)) *
        (@g_degree_ge T hT hTind t ht _ hk).val )
      (λ _ x, x)).sum,
  use ψm.val.2 * k, split,
  {	exact nat.mul_pos ψm.property.1 (nat.succ_pos _) }, split,
  { apply is_homogeneous.add (is_homogeneous.pow ψm.property.2.1 _),
    apply is_homogeneous.multiset_sum, intros φ hφ,
    rcases mem_pmap.mp hφ with ⟨t, ht, rfl⟩,
    convert is_homogeneous.mul
      (is_homogeneous_C _ _)
      (@g_degree_ge T hT hTind t ht _ hk).property.1,
    rw zero_add },
  intros t ht, rw [eval_add, eval_multiset_sum, map_pmap],
  simp only [eval_mul, eval_C],
  conv in (T.val) { rw ← cons_erase (finset.mem_def.mp ht) },
  rw [pmap_cons, sum_cons, ← add_assoc, (@g_degree_ge T hT hTind t ht _ hk).property.2 t ht],
  rw [int.div_mul_cancel _, add_sub_cancel'_right], swap,
  { apply dvd.trans (ha _ ht) (modeq.modeq_iff_dvd.mp _), rw [eval_pow],
    apply modeq.pow_modeq_one (ψm.property.2.2 _ (hT _ ht)) },
  convert int.add_zero 1, apply sum_eq_zero_of_all_zero,
  intros x hx, rcases mem_pmap.mp hx with ⟨s, hs, rfl⟩,
  have hsT := finset.mem_def.mpr (mem_of_mem_erase hs),
  convert mul_zero _,
  rw [(@g_degree_ge T hT hTind _ hsT _ hk).property.2 t ht, g_zero_iff T hT hTind hsT ht],
  symmetry, apply finset.ne_of_mem_erase hs,
end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import algebra.order.archimedean
import order.filter.at_top_bot

/-!
# `at_top` filter and archimedean (semi)rings/fields

In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
the function `coe ∘ f : α → R` tends to `at_top` along a filter `l` if and only if so does `f`.
We also prove that `coe : ℕ → R` tends to `at_top` along `at_top`, as well as version of these
two results for `ℤ` (and a ring `R`) and `ℚ` (and a field `R`).
-/

variables {α R : Type*}

open filter set

@[simp] lemma nat.comap_coe_at_top [ordered_semiring R] [nontrivial R] [archimedean R] :
  comap (coe : ℕ → R) at_top = at_top :=
comap_embedding_at_top (λ _ _, nat.cast_le) exists_nat_ge

lemma tendsto_coe_nat_at_top_iff [ordered_semiring R] [nontrivial R] [archimedean R]
  {f : α → ℕ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, nat.cast_le) exists_nat_ge

lemma tendsto_coe_nat_at_top_at_top [ordered_semiring R] [archimedean R] :
  tendsto (coe : ℕ → R) at_top at_top :=
nat.mono_cast.tendsto_at_top_at_top exists_nat_ge

@[simp] lemma int.comap_coe_at_top [ordered_ring R] [nontrivial R] [archimedean R] :
  comap (coe : ℤ → R) at_top = at_top :=
comap_embedding_at_top (λ _ _, int.cast_le) $ λ r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨n, hn⟩

@[simp] lemma int.comap_coe_at_bot [ordered_ring R] [nontrivial R] [archimedean R] :
  comap (coe : ℤ → R) at_bot = at_bot :=
comap_embedding_at_bot (λ _ _, int.cast_le) $ λ r,
  let ⟨n, hn⟩ := exists_nat_ge (-r) in ⟨-n, by simpa [neg_le] using hn⟩

lemma tendsto_coe_int_at_top_iff [ordered_ring R] [nontrivial R] [archimedean R]
  {f : α → ℤ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
by rw [← tendsto_comap_iff, int.comap_coe_at_top]

lemma tendsto_coe_int_at_bot_iff [ordered_ring R] [nontrivial R] [archimedean R]
  {f : α → ℤ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_bot ↔ tendsto f l at_bot :=
by rw [← tendsto_comap_iff, int.comap_coe_at_bot]

lemma tendsto_coe_int_at_top_at_top [ordered_ring R] [archimedean R] :
  tendsto (coe : ℤ → R) at_top at_top :=
int.cast_mono.tendsto_at_top_at_top $ λ b,
  let ⟨n, hn⟩ := exists_nat_ge b in ⟨n, hn⟩

@[simp] lemma rat.comap_coe_at_top [linear_ordered_field R] [archimedean R] :
  comap (coe : ℚ → R) at_top = at_top :=
comap_embedding_at_top (λ _ _, rat.cast_le) $ λ r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨n, by simpa⟩

@[simp] lemma rat.comap_coe_at_bot [linear_ordered_field R] [archimedean R] :
  comap (coe : ℚ → R) at_bot = at_bot :=
comap_embedding_at_bot (λ _ _, rat.cast_le) $ λ r, let ⟨n, hn⟩ := exists_nat_ge (-r)
  in ⟨-n, by simpa [neg_le]⟩

lemma tendsto_coe_rat_at_top_iff [linear_ordered_field R] [archimedean R]
  {f : α → ℚ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
by rw [← tendsto_comap_iff, rat.comap_coe_at_top]

lemma tendsto_coe_rat_at_bot_iff [linear_ordered_field R] [archimedean R]
  {f : α → ℚ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_bot ↔ tendsto f l at_bot :=
by rw [← tendsto_comap_iff, rat.comap_coe_at_bot]

lemma at_top_countable_basis_of_archimedean [linear_ordered_semiring R] [archimedean R] :
  (at_top : filter R).has_countable_basis (λ n : ℕ, true) (λ n, Ici n) :=
{ countable := countable_encodable _,
  to_has_basis := at_top_basis.to_has_basis
    (λ x hx, let ⟨n, hn⟩ := exists_nat_ge x in ⟨n, trivial, Ici_subset_Ici.2 hn⟩)
    (λ n hn, ⟨n, trivial, subset.rfl⟩) }

lemma at_bot_countable_basis_of_archimedean [linear_ordered_ring R] [archimedean R] :
  (at_bot : filter R).has_countable_basis (λ m : ℤ, true) (λ m, Iic m) :=
{ countable := countable_encodable _,
  to_has_basis := at_bot_basis.to_has_basis
    (λ x hx, let ⟨m, hm⟩ := exists_int_lt x in ⟨m, trivial, Iic_subset_Iic.2 hm.le⟩)
    (λ m hm, ⟨m, trivial, subset.rfl⟩) }

@[priority 100]
instance at_top_countably_generated_of_archimedean [linear_ordered_semiring R] [archimedean R] :
  (at_top : filter R).is_countably_generated :=
at_top_countable_basis_of_archimedean.is_countably_generated

@[priority 100]
instance at_bot_countably_generated_of_archimedean [linear_ordered_ring R] [archimedean R] :
  (at_bot : filter R).is_countably_generated :=
at_bot_countable_basis_of_archimedean.is_countably_generated

variables [linear_ordered_semiring R] [archimedean R]
variables {l : filter α} {f : α → R} {r : R}

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the left) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.const_mul_at_top`). -/
lemma filter.tendsto.const_mul_at_top' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, r * f x) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  rw nsmul_eq_mul' at hn,
  filter_upwards [tendsto_at_top.1 hf (n * max b 0)] with x hx,
  calc b ≤ 1 * max b 0 : by { rw [one_mul], exact le_max_left _ _ }
  ... ≤ (r * n) * max b 0 : mul_le_mul_of_nonneg_right hn (le_max_right _ _)
  ... = r * (n * max b 0) : by rw [mul_assoc]
  ... ≤ r * f x : mul_le_mul_of_nonneg_left hx (le_of_lt hr)
end

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the right) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.at_top_mul_const`). -/
lemma filter.tendsto.at_top_mul_const' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, f x * r) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  have hn' : 1 ≤ (n : R) * r, by rwa nsmul_eq_mul at hn,
  filter_upwards [tendsto_at_top.1 hf (max b 0 * n)] with x hx,
  calc b ≤ max b 0 * 1 : by { rw [mul_one], exact le_max_left _ _ }
  ... ≤ max b 0 * (n * r) : mul_le_mul_of_nonneg_left hn' (le_max_right _ _)
  ... = (max b 0 * n) * r : by rw [mul_assoc]
  ... ≤ f x * r : mul_le_mul_of_nonneg_right hx (le_of_lt hr)
end


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import probability.process.hitting_time
import probability.martingale.basic

/-! # Optional stopping theorem (fair game theorem)

The optional stopping theorem states that an adapted integrable process `f` is a submartingale if
and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`.

This file also contains Doob's maximal inequality: given a non-negative submartingale `f`, for all
`ε : ℝ≥0`, we have `ε • μ {ε ≤ f* n} ≤ ∫ ω in {ε ≤ f* n}, f n` where `f* n ω = max_{k ≤ n}, f k ω`.

### Main results

* `measure_theory.submartingale_iff_expected_stopped_value_mono`: the optional stopping theorem.
* `measure_theory.submartingale.stopped_process`: the stopped process of a submartingale with
  respect to a stopping time is a submartingale.
* `measure_theory.maximal_ineq`: Doob's maximal inequality.

 -/

open_locale nnreal ennreal measure_theory probability_theory

namespace measure_theory

variables {Ω : Type*} {m0 : measurable_space Ω} {μ : measure Ω} {𝒢 : filtration ℕ m0}
  {f : ℕ → Ω → ℝ} {τ π : Ω → ℕ}

-- We may generalize the below lemma to functions taking value in a `normed_lattice_add_comm_group`.
-- Similarly, generalize `(super/)submartingale.set_integral_le`.

/-- Given a submartingale `f` and bounded stopping times `τ` and `π` such that `τ ≤ π`, the
expectation of `stopped_value f τ` is less than or equal to the expectation of `stopped_value f π`.
This is the forward direction of the optional stopping theorem. -/
lemma submartingale.expected_stopped_value_mono [sigma_finite_filtration μ 𝒢]
  (hf : submartingale f 𝒢 μ) (hτ : is_stopping_time 𝒢 τ) (hπ : is_stopping_time 𝒢 π) (hle : τ ≤ π)
  {N : ℕ} (hbdd : ∀ ω, π ω ≤ N) :
  μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
begin
  rw [← sub_nonneg, ← integral_sub', stopped_value_sub_eq_sum' hle hbdd],
  { simp only [finset.sum_apply],
    have : ∀ i, measurable_set[𝒢 i] {ω : Ω | τ ω ≤ i ∧ i < π ω},
    { intro i,
      refine (hτ i).inter _,
      convert (hπ i).compl,
      ext x,
      simpa },
    rw integral_finset_sum,
    { refine finset.sum_nonneg (λ i hi, _),
      rw [integral_indicator (𝒢.le _ _ (this _)), integral_sub', sub_nonneg],
      { exact hf.set_integral_le (nat.le_succ i) (this _) },
      { exact (hf.integrable _).integrable_on },
      { exact (hf.integrable _).integrable_on } },
    intros i hi,
    exact integrable.indicator (integrable.sub (hf.integrable _) (hf.integrable _))
      (𝒢.le _ _ (this _)) },
  { exact hf.integrable_stopped_value hπ hbdd },
  { exact hf.integrable_stopped_value hτ (λ ω, le_trans (hle ω) (hbdd ω)) }
end

/-- The converse direction of the optional stopping theorem, i.e. an adapted integrable process `f`
is a submartingale if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
lemma submartingale_of_expected_stopped_value_mono [is_finite_measure μ]
  (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
  (hf : ∀ τ π : Ω → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ ω, π ω ≤ N) →
    μ[stopped_value f τ] ≤ μ[stopped_value f π]) :
  submartingale f 𝒢 μ :=
begin
  refine submartingale_of_set_integral_le hadp hint (λ i j hij s hs, _),
  classical,
  specialize hf (s.piecewise (λ _, i) (λ _, j)) _
    (is_stopping_time_piecewise_const hij hs)
    (is_stopping_time_const 𝒢 j) (λ x, (ite_le_sup _ _ _).trans (max_eq_right hij).le)
    ⟨j, λ x, le_rfl⟩,
  rwa [stopped_value_const, stopped_value_piecewise_const,
    integral_piecewise (𝒢.le _ _ hs) (hint _).integrable_on (hint _).integrable_on,
    ← integral_add_compl (𝒢.le _ _ hs) (hint j), add_le_add_iff_right] at hf,
end

/-- **The optional stopping theorem** (fair game theorem): an adapted integrable process `f`
is a submartingale if and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
lemma submartingale_iff_expected_stopped_value_mono [is_finite_measure μ]
  (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ) :
  submartingale f 𝒢 μ ↔
  ∀ τ π : Ω → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ x, π x ≤ N) →
    μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
⟨λ hf _ _ hτ hπ hle ⟨N, hN⟩, hf.expected_stopped_value_mono hτ hπ hle hN,
 submartingale_of_expected_stopped_value_mono hadp hint⟩

/-- The stopped process of a submartingale with respect to a stopping time is a submartingale. -/
@[protected]
lemma submartingale.stopped_process [is_finite_measure μ]
  (h : submartingale f 𝒢 μ) (hτ : is_stopping_time 𝒢 τ) :
  submartingale (stopped_process f τ) 𝒢 μ :=
begin
  rw submartingale_iff_expected_stopped_value_mono,
  { intros σ π hσ hπ hσ_le_π hπ_bdd,
    simp_rw stopped_value_stopped_process,
    obtain ⟨n, hπ_le_n⟩ := hπ_bdd,
    exact h.expected_stopped_value_mono (hσ.min hτ) (hπ.min hτ)
      (λ ω, min_le_min (hσ_le_π ω) le_rfl) (λ ω, (min_le_left _ _).trans (hπ_le_n ω)), },
  { exact adapted.stopped_process_of_discrete h.adapted hτ, },
  { exact λ i, h.integrable_stopped_value ((is_stopping_time_const _ i).min hτ)
    (λ ω, min_le_left _ _), },
end

section maximal

open finset

lemma smul_le_stopped_value_hitting [is_finite_measure μ]
  (hsub : submartingale f 𝒢 μ) {ε : ℝ≥0} (n : ℕ) :
  ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)} ≤
  ennreal.of_real (∫ ω in {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)},
    stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ) :=
begin
  have hn : set.Icc 0 n = {k | k ≤ n},
  { ext x, simp },
  have : ∀ ω, ((ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) →
    (ε : ℝ) ≤ stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω,
  { intros x hx,
    simp_rw [le_sup'_iff, mem_range, nat.lt_succ_iff] at hx,
    refine stopped_value_hitting_mem _,
    simp only [set.mem_set_of_eq, exists_prop, hn],
    exact let ⟨j, hj₁, hj₂⟩ := hx in ⟨j, hj₁, hj₂⟩ },
  have h := set_integral_ge_of_const_le (measurable_set_le measurable_const
    (finset.measurable_range_sup'' (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))))
    (measure_ne_top _ _) this
    (integrable.integrable_on (hsub.integrable_stopped_value
      (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le)),
  rw [ennreal.le_of_real_iff_to_real_le, ennreal.to_real_smul],
  { exact h },
  { exact ennreal.mul_ne_top (by simp) (measure_ne_top _ _) },
  { exact le_trans (mul_nonneg ε.coe_nonneg ennreal.to_real_nonneg) h }
end

/-- **Doob's maximal inequality**: Given a non-negative submartingale `f`, for all `ε : ℝ≥0`,
we have `ε • μ {ε ≤ f* n} ≤ ∫ ω in {ε ≤ f* n}, f n` where `f* n ω = max_{k ≤ n}, f k ω`.

In some literature, the Doob's maximal inequality refers to what we call Doob's Lp inequality
(which is a corollary of this lemma and will be proved in an upcomming PR). -/
lemma maximal_ineq [is_finite_measure μ]
  (hsub : submartingale f 𝒢 μ) (hnonneg : 0 ≤ f) {ε : ℝ≥0} (n : ℕ) :
  ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)} ≤
  ennreal.of_real (∫ ω in {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)},
    f n ω ∂μ) :=
begin
  suffices : ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)} +
    ennreal.of_real (∫ ω in {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ε},
      f n ω ∂μ) ≤ ennreal.of_real (μ[f n]),
  { have hadd : ennreal.of_real (∫ ω, f n ω ∂μ) =
      ennreal.of_real (∫ ω in
        {ω | ↑ε ≤ ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω))}, f n ω ∂μ) +
      ennreal.of_real (∫ ω in
        {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ↑ε}, f n ω ∂μ),
    { rw [← ennreal.of_real_add, ← integral_union],
      { conv_lhs { rw ← integral_univ },
        convert rfl,
        ext ω,
        change (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ) ↔ _,
        simp only [le_or_lt, true_iff] },
      { rw disjoint_iff_inf_le,
        rintro ω ⟨hω₁ : _ ≤ _, hω₂ : _ < _⟩,
        exact (not_le.2 hω₂) hω₁ },
      { exact (measurable_set_lt (finset.measurable_range_sup''
          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) },
      exacts [(hsub.integrable _).integrable_on, (hsub.integrable _).integrable_on,
        integral_nonneg (hnonneg _), integral_nonneg (hnonneg _)] },
    rwa [hadd, ennreal.add_le_add_iff_right ennreal.of_real_ne_top] at this },
  calc ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)}
    + ennreal.of_real (∫ ω in {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ε},
        f n ω ∂μ)
    ≤ ennreal.of_real (∫ ω in {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)},
        stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ)
    + ennreal.of_real (∫ ω in {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ε},
        stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ) :
    begin
      refine add_le_add (smul_le_stopped_value_hitting hsub _)
        (ennreal.of_real_le_of_real (set_integral_mono_on (hsub.integrable n).integrable_on
        (integrable.integrable_on (hsub.integrable_stopped_value
          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le))
        (measurable_set_lt (finset.measurable_range_sup''
          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) _)),
      intros ω hω,
      rw set.mem_set_of_eq at hω,
      have : hitting f {y : ℝ | ↑ε ≤ y} 0 n ω = n,
      { simp only [hitting, set.mem_set_of_eq, exists_prop, pi.coe_nat, nat.cast_id,
          ite_eq_right_iff, forall_exists_index, and_imp],
        intros m hm hεm,
        exact false.elim ((not_le.2 hω)
          ((le_sup'_iff _).2 ⟨m, mem_range.2 (nat.lt_succ_of_le hm.2), hεm⟩)) },
      simp_rw [stopped_value, this],
    end
    ... = ennreal.of_real (∫ ω, stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ) :
    begin
      rw [← ennreal.of_real_add, ← integral_union],
      { conv_rhs { rw ← integral_univ },
        convert rfl,
        ext ω,
        change _ ↔ (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ),
        simp only [le_or_lt, iff_true] },
      { rw disjoint_iff_inf_le,
        rintro ω ⟨hω₁ : _ ≤ _, hω₂ : _ < _⟩,
        exact (not_le.2 hω₂) hω₁ },
      { exact (measurable_set_lt (finset.measurable_range_sup''
          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) },
      { exact (integrable.integrable_on (hsub.integrable_stopped_value
          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le)) },
      { exact (integrable.integrable_on (hsub.integrable_stopped_value
          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le)) },
      exacts [integral_nonneg (λ x, hnonneg _ _), integral_nonneg (λ x, hnonneg _ _)],
    end
    ... ≤ ennreal.of_real (μ[f n]) :
    begin
      refine ennreal.of_real_le_of_real _,
      rw ← stopped_value_const f n,
      exact hsub.expected_stopped_value_mono
        (hitting_is_stopping_time hsub.adapted measurable_set_Ici)
        (is_stopping_time_const _ _) (λ ω, hitting_le ω) (λ ω, le_rfl : ∀ ω, n ≤ n),
    end
end

end maximal

end measure_theory


import data.vector
import data.vector.zip
import data.multiset.basic

variables {n m : ℕ} {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α → β)

@[simp] def multiset.sym_diff (x y : multiset α) : multiset α
  := (x - y) + (y - x)
infix ` Δ `:51 := multiset.sym_diff

@[simp] def multiset.sym_dist (x y : multiset α) : ℕ := (x Δ y).card
infix ` |Δ| `:51 := multiset.sym_dist

@[simp] def list.sym_dist (x y : list α) : ℕ
  := (x : multiset α) |Δ| (y : multiset α)
infix ` |ΔL| `:52 := list.sym_dist

@[simp] def vector.sym_dist (x y : vector α n)
  := (x.to_list : multiset α) |Δ| (y.to_list : multiset α)
infix ` |ΔV| `:52 := vector.sym_dist

@[simp] def vec_neighbors (x y : vector α n) : bool := (x |ΔV| y) ≤ 1
infix ` ~ `:53 := vec_neighbors

lemma neighbor_diff_equiv :
∀ (v₁ : vector α n) (v₂ : vector α n), v₁ ~ v₂ ↔ v₁ |ΔV| v₂ ≤ 1 := by simp

/-
The proofs for the two lemmas below (map_diff_subset) are taken from a comment by Junyan Xu on
https://leanprover-community.github.io/archive/stream/113489-new-members/topic/
Generalization.20of.20map_diff.html
-/
theorem multiset.map_diff_subset (s₁ s₂ : multiset α) :
  s₁.map f - s₂.map f ≤ (s₁ - s₂).map f :=
begin
  rw [tsub_le_iff_right, multiset.le_iff_count],
  intro, simp only [multiset.count_add, multiset.count_map,
                    ← multiset.card_add, ← multiset.filter_add],
  exact multiset.card_le_of_le (multiset.filter_le_filter _ $ tsub_le_iff_right.1 le_rfl),
end

theorem list.map_diff_subset (l₁ l₂ : list α) :
  (l₁.map f).diff (l₂.map f) ⊆ (l₁.diff l₂).map f :=
begin
  simp only [← multiset.coe_subset, ← multiset.coe_sub, ← multiset.coe_map],
  exact multiset.subset_of_le (multiset.map_diff_subset f _ _),
end
/- end community contribution -/

theorem multiset.map_sym_diff_subset (s₁ s₂ : multiset α) :
  (s₁.map f) Δ (s₂.map f) ≤ (s₁ Δ s₂).map f :=
begin
  simp only [multiset.sym_diff],
  have h₁ : s₁.map f - s₂.map f ≤ (s₁ - s₂).map f
    := by { exact multiset.map_diff_subset _ _ _ },
  have h₂ : s₂.map f - s₁.map f ≤ (s₂ - s₁).map f
    := by { exact multiset.map_diff_subset _ _ _ },
  have h₃ : (s₁.map f - s₂.map f) + (s₂.map f - s₁.map f)
    ≤ (s₁ - s₂).map f + (s₂ - s₁).map f
    := by { exact add_le_add h₁ h₂ },
  have h₄ : (s₁ - s₂).map f + (s₂ - s₁).map f
    ≤ ((s₁ - s₂) + (s₂ - s₁)).map f
    := by { simp },
  exact le_trans h₃ h₄
end

lemma multiset.map_sym_dist_le_map_sym_dist (s₁ s₂ : multiset α) :
  (s₁.map f) |Δ| (s₂.map f) ≤ ((s₁ Δ s₂).map f).card :=
begin
    have h : (s₁.map f) Δ (s₂.map f) ≤ (s₁ Δ s₂).map f
      := by { exact multiset.map_sym_diff_subset _ _ _ },
    exact multiset.card_le_of_le h
end

/-- Row transform stability. --/
theorem multiset.map_sym_dist_le_sym_dist (s₁ s₂ : multiset α) :
  (s₁.map f) |Δ| (s₂.map f) ≤ s₁ |Δ| s₂ :=
begin
  have h₁ : (s₁.map f) |Δ| (s₂.map f) ≤ ((s₁ Δ s₂).map f).card
    := by { exact multiset.map_sym_dist_le_map_sym_dist _ _ _ },
  have h₂ : ((s₁ Δ s₂).map f).card ≤ (s₁ Δ s₂).card
    := by { simp },
  exact le_trans h₁ h₂
end

@[simp] def nat_of_fin (v : fin (n + 1)) : ℕ := v


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.fully_faithful
import Mathlib.PostPort

universes v u₁ u₂ u_1

namespace Mathlib

namespace category_theory

/- Induced categories.

  Given a category D and a function F : C → D from a type C to the
  objects of D, there is an essentially unique way to give C a
  category structure such that F becomes a fully faithful functor,
  namely by taking Hom_C(X, Y) = Hom_D(FX, FY). We call this the
  category induced from D along F.

  As a special case, if C is a subtype of D, this produces the full
  subcategory of D on the objects belonging to C. In general the
  induced category is equivalent to the full subcategory of D on the
  image of F.

-/

/-
It looks odd to make D an explicit argument of `induced_category`,
when it is determined by the argument F anyways. The reason to make D
explicit is in order to control its syntactic form, so that instances
like `induced_category.has_forget₂` (elsewhere) refer to the correct
form of D. This is used to set up several algebraic categories like

  def CommMon : Type (u+1) := induced_category Mon (bundled.map @comm_monoid.to_monoid)
  -- not `induced_category (bundled monoid) (bundled.map @comm_monoid.to_monoid)`,
  -- even though `Mon = bundled monoid`!
-/

/--
`induced_category D F`, where `F : C → D`, is a typeclass synonym for `C`,
which provides a category structure so that the morphisms `X ⟶ Y` are the morphisms
in `D` from `F X` to `F Y`.
-/
def induced_category {C : Type u₁} (D : Type u₂) [category D] (F : C → D) := C

protected instance induced_category.has_coe_to_sort {C : Type u₁} {D : Type u₂} [category D]
    (F : C → D) [has_coe_to_sort D] : has_coe_to_sort (induced_category D F) :=
  has_coe_to_sort.mk (has_coe_to_sort.S D) fun (c : induced_category D F) => ↥(F c)

protected instance induced_category.category {C : Type u₁} {D : Type u₂} [category D] (F : C → D) :
    category (induced_category D F) :=
  category.mk

/--
The forgetful functor from an induced category to the original category,
forgetting the extra data.
-/
@[simp] theorem induced_functor_obj {C : Type u₁} {D : Type u₂} [category D] (F : C → D) :
    ∀ (ᾰ : C), functor.obj (induced_functor F) ᾰ = F ᾰ :=
  fun (ᾰ : C) => Eq.refl (functor.obj (induced_functor F) ᾰ)

protected instance induced_category.full {C : Type u₁} {D : Type u₂} [category D] (F : C → D) :
    full (induced_functor F) :=
  full.mk
    fun (x y : induced_category D F)
      (f : functor.obj (induced_functor F) x ⟶ functor.obj (induced_functor F) y) => f

protected instance induced_category.faithful {C : Type u₁} {D : Type u₂} [category D] (F : C → D) :
    faithful (induced_functor F) :=
  faithful.mk

/- A full subcategory is the special case of an induced category with F = subtype.val. -/

/--
The category structure on a subtype; morphisms just ignore the property.

See https://stacks.math.columbia.edu/tag/001D. We do not define 'strictly full' subcategories.
-/
protected instance full_subcategory {C : Type u₂} [category C] (Z : C → Prop) :
    category (Subtype fun (X : C) => Z X) :=
  induced_category.category subtype.val

/--
The forgetful functor from a full subcategory into the original category
("forgetting" the condition).
-/
def full_subcategory_inclusion {C : Type u₂} [category C] (Z : C → Prop) :
    (Subtype fun (X : C) => Z X) ⥤ C :=
  induced_functor subtype.val

@[simp] theorem full_subcategory_inclusion.obj {C : Type u₂} [category C] (Z : C → Prop)
    {X : Subtype fun (X : C) => Z X} :
    functor.obj (full_subcategory_inclusion Z) X = subtype.val X :=
  rfl

@[simp] theorem full_subcategory_inclusion.map {C : Type u₂} [category C] (Z : C → Prop)
    {X : Subtype fun (X : C) => Z X} {Y : Subtype fun (X : C) => Z X} {f : X ⟶ Y} :
    functor.map (full_subcategory_inclusion Z) f = f :=
  rfl

protected instance full_subcategory.full {C : Type u₂} [category C] (Z : C → Prop) :
    full (full_subcategory_inclusion Z) :=
  induced_category.full subtype.val

protected instance full_subcategory.faithful {C : Type u₂} [category C] (Z : C → Prop) :
    faithful (full_subcategory_inclusion Z) :=
  induced_category.faithful subtype.val

end Mathlib


/-
Copyright (c) 2018 Ellen Arlt. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ellen Arlt, Blair Shi, Sean Leather, Mario Carneiro, Johan Commelin

Matrices
-/

import algebra.module data.fintype algebra.pi_instances

universes u v

def matrix (m n : Type u) [fintype m] [fintype n] (α : Type v) : Type (max u v) :=
m → n → α

namespace matrix
variables {l m n o : Type u} [fintype l] [fintype m] [fintype n] [fintype o]
variables {α : Type v}

section ext
variables {M N : matrix m n α}

theorem ext_iff : (∀ i j, M i j = N i j) ↔ M = N :=
⟨λ h, funext $ λ i, funext $ h i, λ h, by simp [h]⟩

@[extensionality] theorem ext : (∀ i j, M i j = N i j) → M = N :=
ext_iff.mp

end ext

instance [has_add α] : has_add (matrix m n α) := pi.has_add
instance [add_semigroup α] : add_semigroup (matrix m n α) := pi.add_semigroup
instance [add_comm_semigroup α] : add_comm_semigroup (matrix m n α) := pi.add_comm_semigroup
instance [has_zero α] : has_zero (matrix m n α) := pi.has_zero
instance [add_monoid α] : add_monoid (matrix m n α) := pi.add_monoid
instance [add_comm_monoid α] : add_comm_monoid (matrix m n α) := pi.add_comm_monoid
instance [has_neg α] : has_neg (matrix m n α) := pi.has_neg
instance [add_group α] : add_group (matrix m n α) := pi.add_group
instance [add_comm_group α] : add_comm_group (matrix m n α) := pi.add_comm_group

@[simp] theorem zero_val [has_zero α] (i j) : (0 : matrix m n α) i j = 0 := rfl
@[simp] theorem neg_val [has_neg α] (M : matrix m n α) (i j) : (- M) i j = - M i j := rfl
@[simp] theorem add_val [has_add α] (M N : matrix m n α) (i j) : (M + N) i j = M i j + N i j := rfl

section diagonal
variables [decidable_eq n]

def diagonal [has_zero α] (d : n → α) : matrix n n α := λ i j, if i = j then d i else 0

@[simp] theorem diagonal_val_eq [has_zero α] {d : n → α} (i : n) : (diagonal d) i i = d i :=
by simp [diagonal]

@[simp] theorem diagonal_val_ne [has_zero α] {d : n → α} {i j : n} (h : i ≠ j) :
  (diagonal d) i j = 0 := by simp [diagonal, h]

theorem diagonal_val_ne' [has_zero α] {d : n → α} {i j : n} (h : j ≠ i) :
  (diagonal d) i j = 0 := diagonal_val_ne h.symm

@[simp] theorem diagonal_zero [has_zero α] : (diagonal (λ _, 0) : matrix n n α) = 0 :=
by simp [diagonal]; refl

section one
variables [has_zero α] [has_one α]

instance : has_one (matrix n n α) := ⟨diagonal (λ _, 1)⟩

@[simp] theorem diagonal_one : (diagonal (λ _, 1) : matrix n n α) = 1 := rfl

theorem one_val {i j} : (1 : matrix n n α) i j = if i = j then 1 else 0 := rfl

@[simp] theorem one_val_eq (i) : (1 : matrix n n α) i i = 1 := diagonal_val_eq i

@[simp] theorem one_val_ne {i j} : i ≠ j → (1 : matrix n n α) i j = 0 :=
diagonal_val_ne

theorem one_val_ne' {i j} : j ≠ i → (1 : matrix n n α) i j = 0 :=
diagonal_val_ne'

end one
end diagonal

@[simp] theorem diagonal_add [decidable_eq n] [add_monoid α] (d₁ d₂ : n → α) :
  diagonal d₁ + diagonal d₂ = diagonal (λ i, d₁ i + d₂ i) :=
by ext i j; by_cases i = j; simp [h]

protected def mul [has_mul α] [add_comm_monoid α] (M : matrix l m α) (N : matrix m n α) :
  matrix l n α :=
λ i k, finset.univ.sum (λ j, M i j * N j k)

theorem mul_val [has_mul α] [add_comm_monoid α] {M : matrix l m α} {N : matrix m n α} {i k} :
  (M.mul N) i k = finset.univ.sum (λ j, M i j * N j k) := rfl

local attribute [simp] mul_val

instance [has_mul α] [add_comm_monoid α] : has_mul (matrix n n α) := ⟨matrix.mul⟩

@[simp] theorem mul_eq_mul [has_mul α] [add_comm_monoid α] (M N : matrix n n α) :
  M * N = M.mul N := rfl

theorem mul_val' [has_mul α] [add_comm_monoid α] {M N : matrix n n α} {i k} :
  (M * N) i k = finset.univ.sum (λ j, M i j * N j k) := rfl

section semigroup
variables [decidable_eq m] [decidable_eq n] [semiring α]

protected theorem mul_assoc (L : matrix l m α) (M : matrix m n α) (N : matrix n o α) :
  (L.mul M).mul N = L.mul (M.mul N) :=
by funext i k;
   simp [finset.mul_sum, finset.sum_mul, mul_assoc];
   rw finset.sum_comm

instance : semigroup (matrix n n α) :=
{ mul_assoc := matrix.mul_assoc, ..matrix.has_mul }

end semigroup

@[simp] theorem diagonal_neg [decidable_eq n] [add_group α] (d : n → α) :
  -diagonal d = diagonal (λ i, -d i) :=
by ext i j; by_cases i = j; simp [h]

section semiring
variables [semiring α]

theorem mul_zero (M : matrix m n α) : M.mul (0 : matrix n n α) = 0 :=
by ext i j; simp

theorem zero_mul (M : matrix m n α) : (0 : matrix m m α).mul M = 0 :=
by ext i j; simp

theorem mul_add (L : matrix m n α) (M N : matrix n n α) : L.mul (M + N) = L.mul M + L.mul N :=
by ext i j; simp [finset.sum_add_distrib, mul_add]

theorem add_mul (L M : matrix m m α) (N : matrix m n α) : (L + M).mul N = L.mul N + M.mul N :=
by ext i j; simp [finset.sum_add_distrib, add_mul]

@[simp] theorem diagonal_mul [decidable_eq m]
  (d : m → α) (M : matrix m n α) (i j) : (diagonal d).mul M i j = d i * M i j :=
by simp; rw finset.sum_eq_single i; simp [diagonal_val_ne'] {contextual := tt}

@[simp] theorem mul_diagonal [decidable_eq n]
  (d : n → α) (M : matrix m n α) (i j) : M.mul (diagonal d) i j = M i j * d j :=
by simp; rw finset.sum_eq_single j; simp {contextual := tt}

protected theorem one_mul [decidable_eq m] (M : matrix m n α) : (1 : matrix m m α).mul M = M :=
by ext i j; rw [← diagonal_one, diagonal_mul, one_mul]

protected theorem mul_one [decidable_eq n] (M : matrix m n α) : M.mul (1 : matrix n n α) = M :=
by ext i j; rw [← diagonal_one, mul_diagonal, mul_one]

instance [decidable_eq n] : monoid (matrix n n α) :=
{ one_mul := matrix.one_mul,
  mul_one := matrix.mul_one,
  ..matrix.has_one, ..matrix.semigroup }

instance [decidable_eq n] : semiring (matrix n n α) :=
{ mul_zero := mul_zero,
  zero_mul := zero_mul,
  left_distrib := mul_add,
  right_distrib := add_mul,
  ..matrix.add_comm_monoid,
  ..matrix.monoid }

@[simp] theorem diagonal_mul_diagonal' [decidable_eq n] (d₁ d₂ : n → α) :
  (diagonal d₁).mul (diagonal d₂) = diagonal (λ i, d₁ i * d₂ i) :=
by ext i j; by_cases i = j; simp [h]

theorem diagonal_mul_diagonal [decidable_eq n] (d₁ d₂ : n → α) :
  diagonal d₁ * diagonal d₂ = diagonal (λ i, d₁ i * d₂ i) :=
diagonal_mul_diagonal' _ _

end semiring

instance [decidable_eq n] [ring α] : ring (matrix n n α) :=
{ ..matrix.add_comm_group, ..matrix.semiring }

instance [has_mul α] : has_scalar α (matrix m n α) := ⟨λ a M i j, a * M i j⟩

instance [ring α] : module α (matrix m n α) :=
{ smul_add := λ a M N, ext $ λ i j, _root_.mul_add a (M i j) (N i j),
  add_smul := λ a b M, ext $ λ i j, _root_.add_mul a b (M i j),
  mul_smul := λ a b M, ext $ λ i j, mul_assoc a b (M i j),
  one_smul := λ M, ext $ λ i j, one_mul (M i j) }

end matrix


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton, Simon Hudon, Kenny Lau
-/
import logic.equiv.defs

/-!
# Opposites

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

In this file we define a type synonym `opposite α := α`, denoted by `αᵒᵖ` and two synonyms for the
identity map, `op : α → αᵒᵖ` and `unop : αᵒᵖ → α`. If `α` is a category, then `αᵒᵖ` is the opposite
category, with all arrows reversed.
-/

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

variable (α : Sort u)

/-- The type of objects of the opposite of `α`; used to define the opposite category.

  In order to avoid confusion between `α` and its opposite type, we
  set up the type of objects `opposite α` using the following pattern,
  which will be repeated later for the morphisms.

  1. Define `opposite α := α`.
  2. Define the isomorphisms `op : α → opposite α`, `unop : opposite α → α`.
  3. Make the definition `opposite` irreducible.

  This has the following consequences.

  * `opposite α` and `α` are distinct types in the elaborator, so you
    must use `op` and `unop` explicitly to convert between them.
  * Both `unop (op X) = X` and `op (unop X) = X` are definitional
    equalities. Notably, every object of the opposite category is
    definitionally of the form `op X`, which greatly simplifies the
    definition of the structure of the opposite category, for example.

  (If Lean supported definitional eta equality for records, we could
  achieve the same goals using a structure with one field.)
-/
def opposite : Sort u := α

-- Use a high right binding power (like that of postfix ⁻¹) so that, for example,
-- `presheaf Cᵒᵖ` parses as `presheaf (Cᵒᵖ)` and not `(presheaf C)ᵒᵖ`.
notation α `ᵒᵖ`:std.prec.max_plus := opposite α

namespace opposite

variables {α}
/-- The canonical map `α → αᵒᵖ`. -/
@[pp_nodot]
def op : α → αᵒᵖ := id
/-- The canonical map `αᵒᵖ → α`. -/
@[pp_nodot]
def unop : αᵒᵖ → α := id

lemma op_injective : function.injective (op : α → αᵒᵖ) := λ _ _, id
lemma unop_injective : function.injective (unop : αᵒᵖ → α) := λ _ _, id

@[simp] lemma op_unop (x : αᵒᵖ) : op (unop x) = x := rfl
@[simp] lemma unop_op (x : α) : unop (op x) = x := rfl

attribute [irreducible] opposite

-- We could prove these by `iff.rfl`, but that would make these eligible for `dsimp`. That would be
-- a bad idea because `opposite` is irreducible.
@[simp] lemma op_inj_iff (x y : α) : op x = op y ↔ x = y := op_injective.eq_iff
@[simp] lemma unop_inj_iff (x y : αᵒᵖ) : unop x = unop y ↔ x = y := unop_injective.eq_iff

/-- The type-level equivalence between a type and its opposite. -/
def equiv_to_opposite : α ≃ αᵒᵖ :=
{ to_fun := op,
  inv_fun := unop,
  left_inv := unop_op,
  right_inv := op_unop }

@[simp]

lemma op_eq_iff_eq_unop {x : α} {y} : op x = y ↔ x = unop y :=
equiv_to_opposite.apply_eq_iff_eq_symm_apply

lemma unop_eq_iff_eq_op {x} {y : α} : unop x = y ↔ x = op y :=
equiv_to_opposite.symm.apply_eq_iff_eq_symm_apply

instance [inhabited α] : inhabited αᵒᵖ := ⟨op default⟩

/-- A recursor for `opposite`. Use as `induction x using opposite.rec`. -/
@[simp]
protected def rec {F : Π (X : αᵒᵖ), Sort v} (h : Π X, F (op X)) : Π X, F X :=
λ X, h (unop X)

end opposite

namespace tactic

open opposite

namespace op_induction

/-- Test if `e : expr` is of type `opposite α` for some `α`. -/
meta def is_opposite (e : expr) : tactic bool :=
do t ← infer_type e,
   `(opposite _) ← whnf t | return ff,
   return tt

/-- Find the first hypothesis of type `opposite _`. Fail if no such hypothesis exist in the local
context. -/
meta def find_opposite_hyp : tactic name :=
do lc ← local_context,
   h :: _ ← lc.mfilter $ is_opposite | fail "No hypotheses of the form Xᵒᵖ",
   return h.local_pp_name

end op_induction

open op_induction

/-- A version of `induction x using opposite.rec` which finds the appropriate hypothesis
automatically, for use with `local attribute [tidy] op_induction'`. This is necessary because
`induction x` is not able to deduce that `opposite.rec` should be used. -/
meta def op_induction' : tactic unit :=
do h ← find_opposite_hyp,
   h' ← tactic.get_local h,
   tactic.induction' h' [] `opposite.rec

end tactic


import tactic

open_locale classical

open set

namespace xena

variables {X : Type} (a : X) {x : X} {A B : set X}

/-- Humans want these in levels 1-6 -/
lemma mem_union_iff : x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B := iff.rfl
lemma mem_inter_iff : x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B := iff.rfl
lemma mem_sdiff_iff : x ∈ A \ B ↔ x ∈ A ∧ x ∉ B := iff.rfl
lemma mem_neg_iff : x ∈ Aᶜ ↔ x ∉ A := iff.rfl

lemma ext_iff : A = B ↔ ∀ x : X, x ∈ A ↔ x ∈ B := ext_iff
lemma subset_iff : A ⊆ B ↔ ∀ x : X, x ∈ A → x ∈ B := iff.rfl

/-- Humans want these in level 7 -/
--lemma mem_univ (a : X) : a ∈ (univ : set X) := mem_univ a
lemma mem_empty_iff (a : X) : a ∈ (∅ : set X) ↔ false := iff.rfl
--lemma not_mem_empty (a : X) : ¬ (a ∈ (∅ : set X)) := not_false
--lemma mem_set_iff (a : X) (P : X → Prop) : a ∈ {b : X | P b} ↔ P a := iff.rfl

variables (ι : Type) (f : ι → set X)

/-- Humans might want these but we don't use them yet -/
lemma mem_Union_iff : (x ∈ ⋃(i : ι), f i) ↔ ∃ (i : ι), x ∈ f i := mem_Union
lemma mem_Inter_iff : (x ∈ ⋂(i : ι), f i) ↔ ∀ (i : ι), x ∈ f i := mem_Inter

end xena


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

! This file was ported from Lean 3 source module analysis.normed.group.completion
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Group.Basic
import Mathbin.Topology.Algebra.GroupCompletion
import Mathbin.Topology.MetricSpace.Completion

/-!
# Completion of a normed group

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

In this file we prove that the completion of a (semi)normed group is a normed group.

## Tags

normed group, completion
-/

noncomputable section

namespace UniformSpace

namespace Completion

variable (E : Type _)

instance [UniformSpace E] [Norm E] : Norm (Completion E)
    where norm := Completion.extension Norm.norm

/- warning: uniform_space.completion.norm_coe -> UniformSpace.Completion.norm_coe is a dubious translation:
lean 3 declaration is
  forall {E : Type.{u1}} [_inst_1 : SeminormedAddCommGroup.{u1} E] (x : E), Eq.{1} Real (Norm.norm.{u1} (UniformSpace.Completion.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1))) (UniformSpace.Completion.hasNorm.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1)) (SeminormedAddCommGroup.toHasNorm.{u1} E _inst_1)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) E (UniformSpace.Completion.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1))) (HasLiftT.mk.{succ u1, succ u1} E (UniformSpace.Completion.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1))) (CoeTCₓ.coe.{succ u1, succ u1} E (UniformSpace.Completion.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1))) (UniformSpace.Completion.hasCoeT.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1))))) x)) (Norm.norm.{u1} E (SeminormedAddCommGroup.toHasNorm.{u1} E _inst_1) x)
but is expected to have type
  forall {E : Type.{u1}} [_inst_1 : SeminormedAddCommGroup.{u1} E] (x : E), Eq.{1} Real (Norm.norm.{u1} (UniformSpace.Completion.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1))) (UniformSpace.Completion.instNormCompletion.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1)) (SeminormedAddCommGroup.toNorm.{u1} E _inst_1)) (UniformSpace.Completion.coe'.{u1} E (PseudoMetricSpace.toUniformSpace.{u1} E (SeminormedAddCommGroup.toPseudoMetricSpace.{u1} E _inst_1)) x)) (Norm.norm.{u1} E (SeminormedAddCommGroup.toNorm.{u1} E _inst_1) x)
Case conversion may be inaccurate. Consider using '#align uniform_space.completion.norm_coe UniformSpace.Completion.norm_coeₓ'. -/
@[simp]
theorem norm_coe {E} [SeminormedAddCommGroup E] (x : E) : ‖(x : Completion E)‖ = ‖x‖ :=
  Completion.extension_coe uniformContinuous_norm x
#align uniform_space.completion.norm_coe UniformSpace.Completion.norm_coe

instance [SeminormedAddCommGroup E] : NormedAddCommGroup (Completion E) :=
  { Completion.addCommGroup, Completion.metricSpace with
    dist_eq := by
      intro x y
      apply completion.induction_on₂ x y <;> clear x y
      · refine' isClosed_eq (completion.uniform_continuous_extension₂ _).Continuous _
        exact Continuous.comp completion.continuous_extension continuous_sub
      · intro x y
        rw [← completion.coe_sub, norm_coe, completion.dist_eq, dist_eq_norm] }

end Completion

end UniformSpace


import analysis.complex.circle
import data.real.pi

noncomputable theory

def X_pos : set circle := { z | complex.re z > 0 }
def X_neg : set circle := { z | complex.re z < 0 }
def Y_pos : set circle := { z | complex.im z > 0 }
def Y_neg : set circle := { z | complex.im z < 0 }

open complex
open_locale real

lemma cos_pos_iff (t : ℝ) : real.cos t > 0 ↔ t ∈ ⋃ (n : ℤ), set.Ioo ((n-1/4) * 2 * π : ℝ) ((n + 1/4) * 2 * π) :=
begin
  refine ⟨λ ht, _, _⟩,
  { by_contra,
     }
end

-- example : exp_map_circle ⁻¹' X_pos = ⋃ (n : ℤ), set.Ioo ((n-1/4) * 2 * π) ((n + 1/4) * 2 * π) :=
-- begin
--   ext1 t, refine ⟨_, _⟩,
--   { rintro ht,
--     rw set.mem_preimage at ht,
--     sorry },
--   { rintro ⟨u, ⟨n, rfl⟩, htu⟩,
--     rw set.mem_preimage,
--     change complex.re (complex.exp _) > 0,
--     rw exp_re,
--     simp,
--     sorry
--     -- rw mul_I_im
--     -- squeeze_simp,
--      }
-- end

/-
Prop : Each point z ∈ S^1 has a nbhd U whith the following property:

ε⁻¹(U) is a countable union of disjoint open intervals (U_n) such that ε restricts to a
homeomorphism from U_n onto U
-/


import Complexes.Structures.Quiver

/-- The definition of a `CategoryStruct`, a barebones structure for a category containing none of the axioms (following `mathlib`). -/
class CategoryStruct (Obj : Sort _) extends Quiver Obj where
  id : (X : Obj) → (X ⟶ X)
  comp : {X Y Z : Obj} → (X ⟶ Y) → (Y ⟶ Z) → (X ⟶ Z)

attribute [reducible] CategoryStruct.id
attribute [reducible] CategoryStruct.comp

notation "𝟙" => CategoryStruct.id -- type as `\b1`
infixr:80 " ≫ " => CategoryStruct.comp -- type as `\gg`
infixl:80 " ⊚ " => λ f g => CategoryStruct.comp g f

/-- The definition of a Category. -/
class Category (Obj : Sort _) extends CategoryStruct Obj where
  id_comp : {X Y : Obj} → (f : X ⟶ Y) → 𝟙 X ≫ f = f
  comp_id : {X Y : Obj} → (f : X ⟶ Y) → f ≫ 𝟙 Y = f
  comp_assoc : {W X Y Z : Obj} → (f : W ⟶ X) → (g : X ⟶ Y) → (h : Y ⟶ Z) →
    (f ≫ g) ≫ h = f ≫ (g ≫ h)

attribute [simp] Category.id_comp
attribute [simp] Category.comp_id
attribute [simp] Category.comp_assoc

/-- A functor is a morphism of categories. -/
structure Category.Functor {C D : Sort _} (𝓒 : Category C) (𝓓 : Category D)
    extends Quiver.PreFunctor 𝓒.toQuiver 𝓓.toQuiver where
  map_id : (X : C) → map (𝟙 X) = 𝟙 (obj X)
  map_comp : {X Y Z : C} → (f : X ⟶ Y) → (g : Y ⟶ Z) →
      map (f ≫ g) = map f ≫ map g

namespace Category.Functor

infixr:26 " ⥤ " => Functor -- type as `\func`

attribute [simp] map_id
attribute [simp] map_comp

@[simp] protected def id (C : Sort _) [𝓒 : Category C] : 𝓒 ⥤ 𝓒 :=
-- TODO Use `..` notation : { .. , mapId := λ _ => rfl, mapComp := λ _ _ => rfl }
 { obj := id, map := id, map_id := λ _ => rfl, map_comp := λ _ _ => rfl }

@[simp] def comp {C D E : Sort _} {𝓒 : Category C} {𝓓 : Category D} {𝓔 : Category E}
    (F : 𝓒 ⥤ 𝓓) (G : 𝓓 ⥤ 𝓔) : 𝓒 ⥤ 𝓔 :=
-- TODO Use `..` notation
  { obj := G.obj ∘ F.obj, map := G.map ∘ F.map, map_id := by intro; simp, map_comp := by intros; simp }

infix:80 " ⋙ " => comp

@[simp] theorem comp_obj : (Φ.obj ∘ Ψ.obj) = (Ψ ⋙ Φ).obj := rfl

@[simp] theorem comp_obj' : ∀ x, (Φ.obj (Ψ.obj x)) = (Ψ ⋙ Φ).obj x := λ _ => rfl

end Category.Functor

namespace Path

variable {C : Sort _} [𝓒 : Category C]

def compose {X Y : C} : @Path C 𝓒.toQuiver X Y → (X ⟶ Y)
  | .nil => 𝟙 _
  | .cons e p => e ≫ p.compose

@[simp] theorem compose_nil {X : C} : (Path.nil' X).compose = 𝟙 X := rfl

def compose_append {X Y Z : C} : {p : Path X Y} → {q : Path Y Z} → (append p q).compose = p.compose ≫ q.compose
  | .nil, _ => by simp
  | .cons _ _, _ => by
    dsimp [append, compose]
    rw [compose_append, Category.comp_assoc]

end Path

/-- Paths in a quiver form a category under concatenation. -/
instance (priority := low) Quiver.PathCategory {V : Sort _} (_ : Quiver V) : Category V where
  hom := Path
  id := Path.nil'
  comp := Path.append

  id_comp := Path.nil_append
  comp_id := Path.append_nil
  comp_assoc := Path.append_assoc

/-- Embedding of a `Quiver` into its category of paths. -/
instance {V : Sort _} [Q : Quiver V] : Quiver.PreFunctor Q Q.PathCategory.toQuiver where
  obj := id
  map := Quiver.toPath


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

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

/-!
# Rational numbers are dense in a linear ordered archimedean field

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

In this file we prove that coercion from `ℚ` to a linear ordered archimedean field has dense range.
This lemma is in a separate file because `topology.order.basic` does not import
`algebra.order.archimedean`.
-/

variable {𝕜 : Type _} [LinearOrderedField 𝕜] [TopologicalSpace 𝕜] [OrderTopology 𝕜] [Archimedean 𝕜]

/- warning: rat.dense_range_cast -> Rat.denseRange_cast is a dubious translation:
lean 3 declaration is
  forall {𝕜 : Type.{u1}} [_inst_1 : LinearOrderedField.{u1} 𝕜] [_inst_2 : TopologicalSpace.{u1} 𝕜] [_inst_3 : OrderTopology.{u1} 𝕜 _inst_2 (PartialOrder.toPreorder.{u1} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u1} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1))))))] [_inst_4 : Archimedean.{u1} 𝕜 (OrderedSemiring.toOrderedAddCommMonoid.{u1} 𝕜 (StrictOrderedSemiring.toOrderedSemiring.{u1} 𝕜 (StrictOrderedRing.toStrictOrderedSemiring.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1))))))], DenseRange.{u1, 0} 𝕜 _inst_2 Rat ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Rat 𝕜 (HasLiftT.mk.{1, succ u1} Rat 𝕜 (CoeTCₓ.coe.{1, succ u1} Rat 𝕜 (Rat.castCoe.{u1} 𝕜 (DivisionRing.toHasRatCast.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))
but is expected to have type
  forall {𝕜 : Type.{u1}} [_inst_1 : LinearOrderedField.{u1} 𝕜] [_inst_2 : TopologicalSpace.{u1} 𝕜] [_inst_3 : OrderTopology.{u1} 𝕜 _inst_2 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1)))))] [_inst_4 : Archimedean.{u1} 𝕜 (OrderedSemiring.toOrderedAddCommMonoid.{u1} 𝕜 (OrderedCommSemiring.toOrderedSemiring.{u1} 𝕜 (StrictOrderedCommSemiring.toOrderedCommSemiring.{u1} 𝕜 (LinearOrderedCommSemiring.toStrictOrderedCommSemiring.{u1} 𝕜 (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} 𝕜 (LinearOrderedField.toLinearOrderedSemifield.{u1} 𝕜 _inst_1))))))], DenseRange.{u1, 0} 𝕜 _inst_2 Rat (Rat.cast.{u1} 𝕜 (LinearOrderedField.toRatCast.{u1} 𝕜 _inst_1))
Case conversion may be inaccurate. Consider using '#align rat.dense_range_cast Rat.denseRange_castₓ'. -/
/-- Rational numbers are dense in a linear ordered archimedean field. -/
theorem Rat.denseRange_cast : DenseRange (coe : ℚ → 𝕜) :=
  dense_of_exists_between fun a b h => Set.exists_range_iff.2 <| exists_rat_btwn h
#align rat.dense_range_cast Rat.denseRange_cast


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland

This file sets up a framework for convolution.  The first ingredient
is an additive monoid `M` with the property that for any `m ∈ M`, the
set `{⟨x,y⟩ : x + y = m}` is finite.  If `M` has this property and `R`
is a ring and `f,g : M → R` then we can define `(f * g) m` to be the
sum of `(f x) * (g y)` for all pairs `⟨x,y⟩` with `x + y = m`.  If
`M = ℕ` then this rule gives us the power series ring `R[[x]]`.

The first part of this file defines a typeclass `sum_set M` for
additive monoids `M` with the finiteness property mentioned above,
and derives some additional properties of such monoids.

We then define convolution.  In order to cover some additional
applications, we work in a context slightly more general than outlined
above.  First, we define `convolution.map M P := M → P`, and attach
the convolution structure to the name `convolution.map`.  This is
intended to accomodate the fact that we might want to use pointwise
products on `M → P` in some other contexts.  I am not sure whether
this is the best way to address that issue.  Also, we will assume
that we have a biadditive map `m₁₂ : P₁ → P₂ → P₁₂` of additive
commutative monoids, and we will use it to define a convolution
operation `map M P₁ → map M P₂ → map M P₁₂`.  We can recover the
ring structure on `map M R` by taking `P₁ = P₂ = P₁₂ = R`.
-/

import data.fintype.basic data.finsupp algebra.big_operators data.pi.algebra
import data.list_extra
import algebra.biadditive
import algebra.prod_equiv
import tactic.pi_instances
import tactic.squeeze

namespace convolution

open finset

class sum_set (M : Type*) [add_monoid M] :=
 (els : M → finset (M × M))
 (mem_els : forall (m : M) (xy : M × M), xy ∈ els m ↔ xy.1 + xy.2 = m)

namespace sum_set

variables {M : Type*} [add_monoid M] [decidable_eq M] [sum_set M]
variable (m : M)

def incl (x : M) : (M × M) ↪ (M × M × M) :=
 ⟨prod.mk x,λ yz₀ yz₁ e, by {injection e}⟩

def incr (z : M) : (M × M) ↪ (M × M × M) :=
 ⟨λ xy, ⟨xy.1,xy.2,z⟩,λ ⟨x₀,y₀⟩ ⟨x₁,y₁⟩ e,
  by {injection e with ex eyz,injection eyz with ey ez,
      change x₀ = x₁ at ex,change y₀ = y₁ at ey,rw[ex,ey],}⟩

variable (M)
def twist : M × M ↪ M × M :=
 ⟨λ xy, ⟨xy.2,xy.1⟩,
  λ ⟨x₀,y₀⟩ ⟨x₁,y₁⟩ e,
   by {injection e with hy hx,
       change x₀ = x₁ at hx, change y₀ = y₁ at hy, rw[hx,hy],}⟩
variable {M}

def els3 : finset (M × M × M) :=
 (els m).bUnion (λ xv,(els xv.2).map (incl xv.1))

def els3' : finset (M × M × M) :=
 (els m).bUnion (λ uz,(els uz.1).map (incr uz.2))

lemma els3_disjoint (m : M)
 (xv₁ : M × M) (h₁ : xv₁ ∈ els m) (xv₂ : M × M) (h₂ : xv₂ ∈ els m)
 (h : xv₁ ≠ xv₂) :
  disjoint ((els xv₁.2).map (incl xv₁.1)) ((els xv₂.2).map (incl xv₂.1)) :=
begin
 rcases xv₁ with ⟨x₁,v₁⟩,
 rcases xv₂ with ⟨x₂,v₂⟩,
 dsimp [disjoint], rw[subset_empty],
 apply eq_empty_iff_forall_not_mem.mpr,intros w hw,apply h,
 rcases (mem_inter.mp hw) with ⟨hw₁,hw₂⟩,
 rcases mem_map.mp hw₁ with ⟨yz₁,⟨w_sum₁,w_eq₁⟩⟩,
 rcases mem_map.mp hw₂ with ⟨yz₂,⟨w_sum₂,w_eq₂⟩⟩,
 injection (w_eq₁.trans w_eq₂.symm) with ex eyz,
 change x₁ = x₂ at ex,
 replace w_sum₁ := (mem_els v₁ _).mp w_sum₁,
 replace w_sum₂ := (mem_els v₂ _).mp w_sum₂,
 rw[eyz] at w_sum₁,
 have ev : v₁ = v₂ := w_sum₁.symm.trans w_sum₂,
 rw[ex,ev],
end

lemma els3'_disjoint (m : M)
 (uz₁ : M × M) (h₁ : uz₁ ∈ els m) (uz₂ : M × M) (h₂ : uz₂ ∈ els m)
 (h : uz₁ ≠ uz₂) :
  disjoint ((els uz₁.1).map (incr uz₁.2)) ((els uz₂.1).map (incr uz₂.2)) :=
begin
 rcases uz₁ with ⟨u₁,z₁⟩,
 rcases uz₂ with ⟨u₂,z₂⟩,
 dsimp [disjoint], rw[subset_empty],
 apply eq_empty_iff_forall_not_mem.mpr,intros w hw,apply h,
 rcases (mem_inter.mp hw) with ⟨hw₁,hw₂⟩,
 rcases mem_map.mp hw₁ with ⟨xy₁,⟨w_sum₁,w_eq₁⟩⟩,
 rcases mem_map.mp hw₂ with ⟨xy₂,⟨w_sum₂,w_eq₂⟩⟩,
 injection (w_eq₁.trans w_eq₂.symm) with ex eyz,
 injection eyz with ey ez,
 change z₁ = z₂ at ez,
 replace w_sum₁ := (mem_els u₁ _).mp w_sum₁,
 replace w_sum₂ := (mem_els u₂ _).mp w_sum₂,
 rw[ex,ey] at w_sum₁,
 have eu : u₁ = u₂ := w_sum₁.symm.trans w_sum₂,
 rw[eu,ez],
end

lemma mem_els3 (xyz : M × M × M) :
 xyz ∈ els3 m ↔ xyz.1 + xyz.2.1 + xyz.2.2 = m :=
begin
 rcases xyz with ⟨x,y,z⟩,
 change (⟨x,y,z⟩ : M × M × M) ∈ els3 m ↔ x + y + z = m,
 split,
 {intro hw,
  rcases mem_bUnion.mp hw with ⟨xv,⟨hxv,h⟩⟩,
  replace hxv := (mem_els m xv).mp hxv,
  rcases mem_map.mp h with ⟨yz,⟨hyz,h'⟩⟩,
  replace hyz := (mem_els _ yz).mp hyz,
  injection h' with ex eyz, rw[eyz] at hyz,
  rw[← hyz,ex,← add_assoc] at hxv,exact hxv,
 },
 {intro e,
  apply mem_bUnion.mpr,
  use ⟨x,y + z⟩,
  have : x + (y + z) = m := by {rw[← add_assoc,e]},
  use (mem_els m ⟨x,y + z⟩).mpr this,
  apply mem_map.mpr,
  use ⟨y,z⟩, use (mem_els _ _).mpr rfl,refl,
 }
end

lemma els3_assoc : els3 m = els3' m :=
begin
 ext ⟨x,y,z⟩,rw[mem_els3],
 change x + y + z = m ↔ (⟨x,y,z⟩ : M × M × M) ∈ els3' m,
 split,
 {intro e,
  apply mem_bUnion.mpr,use ⟨x + y,z⟩,use (mem_els m _).mpr e,
  apply mem_map.mpr,
  use ⟨x,y⟩, use (mem_els _ _).mpr rfl,refl,
 },
 {intro hw,
  rcases mem_bUnion.mp hw with ⟨uz,⟨huz,h⟩⟩,
  replace huz := (mem_els m uz).mp huz,
  rcases mem_map.mp h with ⟨xy,⟨hxy,h'⟩⟩,
  replace hxy := (mem_els _ xy).mp hxy,
  injection h' with hx hyz,injection hyz with hy hz,
  rw[hx,hy] at hxy, rw[← hxy,hz] at huz,
  exact huz,
 }
end

lemma els_zero_left :
 (els m).filter (λ xy, 0 = xy.1) = singleton ⟨0,m⟩ :=
begin
 ext ⟨x,y⟩,
 rw[mem_filter,mem_els,mem_singleton],
 split,
 {rintro ⟨h,h'⟩,change x + y = m at h, change 0 = x at h',
  rw[← h'] at h ⊢,rw[zero_add] at h,rw[h],
 },{
  intro e,injection e with ex ey,rw[ex,ey],
  split,{change 0 + m = m,rw[zero_add],},{refl}
 }
end

lemma els_zero_right :
 (els m).filter (λ xy, 0 = xy.2) = singleton ⟨m,0⟩ :=
begin
 ext ⟨x,y⟩,
 rw[mem_filter,mem_els,mem_singleton],
 split,
 {rintro ⟨h,h'⟩,change x + y = m at h, change 0 = y at h',
  rw[← h'] at h ⊢,rw[add_zero] at h,rw[h],
 },{
  intro e,injection e with ex ey,rw[ex,ey],
  split,{change m + 0 = m,rw[add_zero],},{refl}
 }
end

instance : sum_set ℕ := {
  els := λ m, (range m.succ).image (λ i, ⟨i,m - i⟩),
  mem_els := λ m ⟨x,y⟩, begin
   split,
   {intro h,rcases mem_image.mp h with ⟨i,⟨i_is_le,e⟩⟩,
    replace i_is_le : i ≤ m := mem_range_succ.mp i_is_le,
    injection e with ex ey,rw[← ex,← ey],
    exact nat.add_sub_of_le i_is_le,
   },
   {intro e,rw[mem_image],use x,
    use mem_range_succ.mpr (e ▸ (nat.le_add_right x y)),congr,
    exact norm_num.sub_nat_pos _ _ _ e,
   }
  end
}

def shuffle (M₁ : Type*) (M₂ : Type*) :
 (M₁ × M₁) × (M₂ × M₂) ↪ (M₁ × M₂) × (M₁ × M₂) := {
 to_fun := λ x, ⟨⟨x.1.1,x.2.1⟩,⟨x.1.2,x.2.2⟩⟩,
 inj' := begin
  rintros ⟨⟨x₁,x₂⟩,⟨x₃,x₄⟩⟩ ⟨⟨y₁,y₂⟩,⟨y₃,y₄⟩⟩ e,
  injection e with e₁₃ e₂₄,
  injection e₁₃ with e₁ e₃, injection e₂₄ with e₂ e₄,
  change x₁ = y₁ at e₁, change x₂ = y₂ at e₂,
  change x₃ = y₃ at e₃, change x₄ = y₄ at e₄,
  rw[e₁,e₂,e₃,e₄],
 end
}

instance product
         (M₁ : Type*) [add_monoid M₁] [sum_set M₁]
         (M₂ : Type*) [add_monoid M₂] [sum_set M₂] : sum_set (M₁ × M₂) := {
 els := λ m, (finset.product (els m.1) (els m.2)).map (shuffle M₁ M₂),
 mem_els := begin
  rintros ⟨m₁,m₂⟩ ⟨⟨x₁,x₃⟩,⟨x₂,x₄⟩⟩,
  simp only[],split,
  {intro h₁,rcases (mem_map.mp h₁) with ⟨⟨⟨y₁,y₂⟩,⟨y₃,y₄⟩⟩,⟨h₂,e⟩⟩,
   dsimp[shuffle] at e,injection e with e₁₃ e₂₄,
   injection e₁₃ with e₁ e₃, injection e₂₄ with e₂ e₄,
   rw[← e₁,← e₂,← e₃,← e₄],
   change prod.mk (y₁ + y₂) (y₃ + y₄) = prod.mk m₁ m₂,
   rcases mem_product.mp h₂ with ⟨h₃,h₄⟩,
   replace h₃ : y₁ + y₂ = m₁ := (mem_els _ _).mp h₃,
   replace h₄ : y₃ + y₄ = m₂ := (mem_els _ _).mp h₄,
   rw[h₃,h₄],
  },{
   intro e,injection e with e₁ e₂,
   apply mem_map.mpr, use ⟨⟨x₁,x₂⟩,⟨x₃,x₄⟩⟩,
   have h₁ : (prod.mk x₁ x₂) ∈ els m₁ := (mem_els _ _).mpr e₁,
   have h₂ : (prod.mk x₃ x₄) ∈ els m₂ := (mem_els _ _).mpr e₂,
   use mem_product.mpr ⟨h₁,h₂⟩,refl,
  }
 end
}

end sum_set

namespace sum_set

variables {M : Type*} [add_comm_monoid M] [decidable_eq M] [sum_set M]
variable (m : M)

lemma els_twist :
 (els m).map (twist M) = els m :=
begin
 ext ⟨x,y⟩,rw[mem_els],split,
 {intro h,rcases mem_map.mp h with ⟨⟨y',x'⟩,⟨yx_sum,e⟩⟩,
  change (⟨x',y'⟩ : M × M) = ⟨x,y⟩ at e,injection e with ex ey,
  replace yx_sum : y' + x' = m := (mem_els _ _).mp yx_sum,
  rw[ex,ey,add_comm y x] at yx_sum,exact yx_sum,
 },{
  intro e,rw[add_comm] at e,change y + x = m at e,
  apply mem_map.mpr,use ⟨y,x⟩,
  use (mem_els _ _).mpr e,refl,
 }
end

end sum_set

def map (M : Type*) (P : Type*) := M → P

namespace map

variables (M : Type*) (P : Type*)

instance : has_coe_to_fun (map M P) (λ _, M → P) := ⟨ id ⟩

variables {M} {P}

instance [has_zero P] : has_zero (map M P) :=
 by {dsimp[map],apply_instance}

@[simp]
lemma zero_apply [has_zero P] {m : M} :
 (0 : map M P) m = 0 := rfl

instance [has_add P] : has_add (map M P) :=
 by {dsimp[map],apply_instance}

@[simp]
lemma add_apply [has_add P] {a₁ a₂ : map M P} {m : M} :
 (a₁ + a₂) m = a₁ m + a₂ m := rfl

instance [add_semigroup P] : add_semigroup (map M P) :=
 by {dsimp[map],apply_instance}

instance [add_comm_semigroup P] : add_comm_semigroup (map M P) :=
 by {dsimp[map],apply_instance}

instance [add_monoid P] : add_monoid (map M P) :=
 by {dsimp[map],apply_instance}

instance [add_comm_monoid P] : add_comm_monoid (map M P) :=
 by {dsimp[map],apply_instance}

instance [add_group P] : add_group (map M P) :=
 by {dsimp[map],apply_instance}

instance [add_comm_group P] : add_comm_group (map M P) :=
 by {dsimp[map],apply_instance}

instance [has_zero M] [decidable_eq M] [has_zero P] [has_one P] : has_one (map M P) :=
 ⟨λ m, ite (m = 0) 1 0⟩

@[simp]
lemma one_apply [has_zero M] [decidable_eq M] [has_zero P] [has_one P] (m : M) :
 (1 : map M P) m = ite (m = 0) 1 0 := rfl

@[simp]
lemma one_apply_zero [has_zero M] [decidable_eq M] [has_zero P] [has_one P] :
 (1 : map M P) 0 = 1 := by { dsimp[has_one.one],rw[if_pos rfl] }

lemma one_apply_nz [has_zero M] [decidable_eq M] [has_zero P] [has_one P]
 {m : M} (h : m ≠ 0) : (1 : map M P) m = 0 :=
  by { dsimp[has_one.one],rw[if_neg h] }

@[ext]
lemma ext : ∀ {a₁ a₂ : map M P}, (∀ m, a₁ m = a₂ m) → a₁ = a₂ := @funext _ _

section single

variables [decidable_eq M]

def single [has_zero P] (m : M) (p : P) : (map M P) :=
 λ x, ite (m = x) p (0 : P)

lemma single_apply [has_zero P] {m : M} {p : P} (x : M) :
 (single m p) x = ite (m = x) p 0 := rfl

@[simp] lemma single_eq_same [has_zero P] {m : M} {p : P} :
 (single m p) m = p := if_pos rfl

@[simp] lemma single_eq_of_ne [has_zero P] {m x : M} {p : P} (h : m ≠ x) :
 (single m p) x = 0 := if_neg h

@[simp] lemma single_zero [has_zero P] {m : M} : single m (0 : P) = 0 :=
 by {ext x,dsimp[single],split_ifs; refl}

lemma single_add [add_monoid P] {m : M} {p₁ p₂ : P} :
 single m (p₁ + p₂) = single m p₁ + single m p₂ :=
  by {ext x,dsimp[single],split_ifs,refl,rw[zero_add],}

def delta [has_zero P] [has_zero M] (p : P) : map M P := single (0 : M) p

lemma delta_apply [has_zero P] [has_zero M] {p : P} {x : M} :
 (delta p) x = ite ((0 : M) = x) p (0 : P) := rfl

lemma delta_eq_zero [has_zero P] [has_zero M] {p : P} :
 (delta p) (0 : M) = p := if_pos rfl

lemma delta_eq_of_ne [has_zero P] [has_zero M] {p : P} {x : M} (h : 0 ≠ x) :
 (delta p) x = 0 := single_eq_of_ne h

lemma delta_zero [has_zero P] [has_zero M] :
 ((delta (0 : P)) : map M P) = 0 := single_zero

lemma delta_add [add_monoid P] [has_zero M] {p₁ p₂ : P} :
 (delta (p₁ + p₂) : map M P) = delta p₁ + delta p₂ := single_add

end single

end map

section convolve

variables {M : Type*} [add_monoid M] [decidable_eq M] [sum_set M]

open sum_set
open map

variables {P₁ : Type*} {P₂ : Type*} {P₃ : Type*}
variables {P₁₂ : Type*} {P₂₃ : Type*} {P₁₂₃ : Type*}
variables [add_comm_monoid P₁] [add_comm_monoid P₂] [add_comm_monoid P₃]
variables [add_comm_monoid P₁₂] [add_comm_monoid P₂₃] [add_comm_monoid P₁₂₃]

variables (m₁₂ : P₁ → P₂ → P₁₂) [is_biadditive m₁₂]
variables (m₂₃ : P₂ → P₃ → P₂₃) [is_biadditive m₂₃]
variables (m₁₂₃  : P₁₂ → P₃ → P₁₂₃) [is_biadditive m₁₂₃]
variables (m'₁₂₃ : P₁ → P₂₃ → P₁₂₃) [is_biadditive m'₁₂₃]

def convolve (u₁ : map M P₁) (u₂ : map M P₂) : (map M P₁₂) :=
 λ m, (els m).sum (λ x, m₁₂ (u₁ x.1) (u₂ x.2))

lemma zero_convolve (p₂ : map M P₂) : convolve m₁₂ 0 p₂ = 0 := begin
 ext m,dsimp[convolve],
 have : (els m).sum (λ x, (0 : P₁₂)) = 0 := sum_const_zero,
 rw[← this],congr,funext x,rw[is_biadditive.zero_mul m₁₂]
end

lemma convolve_zero (p₁ : map M P₁) : convolve m₁₂ p₁ 0 = 0 := begin
 ext m,dsimp[convolve],
 have : (els m).sum (λ x, (0 : P₁₂)) = 0 := sum_const_zero,
 rw[← this],congr,funext x,rw[is_biadditive.mul_zero m₁₂],
end

lemma add_convolve (p₁ q₁ : map M P₁) (p₂ : map M P₂) :
 convolve m₁₂ (p₁ + q₁) p₂ = convolve m₁₂ p₁ p₂ + convolve m₁₂ q₁ p₂ := begin
 ext m,
 dsimp[convolve],rw[← sum_add_distrib],congr,funext x,
 rw[is_biadditive.add_mul m₁₂],
end

lemma convolve_add (p₁ : map M P₁) (p₂ q₂ : map M P₂) :
 convolve m₁₂ p₁ (p₂ + q₂) = convolve m₁₂ p₁ p₂ + convolve m₁₂ p₁ q₂ := begin
 ext m,
 dsimp[convolve],rw[← sum_add_distrib],congr,funext x,
 rw[is_biadditive.mul_add m₁₂],
end

instance biadditive_convolve:
 is_biadditive (convolve m₁₂ : (map M P₁) → (map M P₂) → (map M P₁₂)) := {
  zero_mul' := zero_convolve m₁₂,
  add_mul'  := add_convolve  m₁₂,
  mul_zero' := convolve_zero m₁₂,
  mul_add'  := convolve_add  m₁₂,
}

lemma convolve_assoc (p₁ : map M P₁) (p₂ : map M P₂) (p₃ : map M P₃)
 (m_assoc : ∀ (p₁ : P₁) (p₂ : P₂) (p₃ : P₃), m₁₂₃ (m₁₂ p₁ p₂) p₃ = m'₁₂₃ p₁ (m₂₃ p₂ p₃)) :
 convolve m₁₂₃ (convolve m₁₂ p₁ p₂) p₃ =
 convolve m'₁₂₃ p₁ (convolve m₂₃ p₂ p₃) :=
begin
 ext m,
 let f' : M × M × M → P₁₂₃ := λ x, m₁₂₃  (m₁₂ (p₁ x.1) (p₂ x.2.1)) (p₃ x.2.2),
 let f  : M × M × M → P₁₂₃ := λ x, m'₁₂₃ (p₁ x.1) (m₂₃ (p₂ x.2.1) (p₃ x.2.2)),
 have ef : f' = f := by {funext x,apply m_assoc},
 have em' : (els3' m).sum f' = (convolve m₁₂₃ (convolve m₁₂ p₁ p₂) p₃) m :=
 begin
  dsimp[convolve,els3'],
  have hh := els3'_disjoint m,
  have hhh := @sum_bUnion (M × M),
  let ee := els m,
  rw[sum_bUnion (els3'_disjoint m)],
  congr,ext ⟨x,v⟩,
  rw[is_biadditive.sum_mul m₁₂₃,sum_map],congr,
 end,
 have em : (els3 m).sum f    = (convolve m'₁₂₃ p₁ (convolve m₂₃ p₂ p₃)) m :=
 begin
  dsimp[convolve,els3],
  rw[sum_bUnion (els3_disjoint m)],congr,ext ⟨u,z⟩,
  rw[is_biadditive.mul_sum m'₁₂₃,sum_map],congr,
 end,
 rw[← em,← em',ef,els3_assoc],
end

lemma delta_convolve (p₁ : P₁) (u₂ : map M P₂) (m : M) :
 (convolve m₁₂ (delta p₁) u₂) m = m₁₂ p₁ (u₂ m) :=
begin
 dsimp[convolve],
 let f  : M × M → P₁₂ := λ x, m₁₂ (delta p₁ x.1) (u₂ x.2),
 let f' : M × M → P₁₂ := λ x, ite (0 = x.1) (f x) 0,
 have ef : f = f' :=
  by {ext x,dsimp[f,f'],
      split_ifs with hx,{refl},{rw[delta_eq_of_ne hx,is_biadditive.zero_mul m₁₂]}},
 change (els m).sum f = m₁₂ p₁ (u₂ m),
 rw[ef],
 have : ((els m).filter (λ (x : M × M), 0 = x.1)).sum f = (els m).sum f' :=
  sum_filter (λ (x : M × M), 0 = x.1) f,
 rw[← this],rw[els_zero_left,sum_singleton],
 dsimp[f],rw[delta_eq_zero],
end

lemma convolve_delta (u₁ : M → P₁) (p₂ : P₂) (m : M) :
 (convolve m₁₂ u₁ (delta p₂)) m = m₁₂ (u₁ m) p₂ :=
begin
 dsimp[convolve],
 let f  : M × M → P₁₂ := λ x, m₁₂ (u₁ x.1) (delta p₂ x.2),
 let f' : M × M → P₁₂ := λ x, ite (0 = x.2) (f x) 0,
 have ef : f = f' :=
  by {ext x,dsimp[f,f'],
      split_ifs with hx,{refl},{rw[delta_eq_of_ne hx,is_biadditive.mul_zero m₁₂]}},
 change (els m).sum f = m₁₂ (u₁ m) p₂,
 rw[ef],
 have : ((els m).filter (λ (x : M × M), 0 = x.2)).sum f = (els m).sum f' :=
  sum_filter (λ x, 0 = x.2) f,
 rw[← this,els_zero_right,sum_singleton],
 dsimp[f],rw[delta_eq_zero],
end

lemma delta_convolve_delta (p₁ : P₁) (p₂ : P₂) :
 (convolve m₁₂ (delta p₁) (delta p₂) : map M P₁₂) = delta (m₁₂ p₁ p₂) :=
by { ext m, rw[delta_convolve,delta_apply,delta_apply],
     split_ifs,refl,rw[is_biadditive.mul_zero m₁₂]}

end convolve

namespace map

variables {M : Type*} [add_monoid M] [decidable_eq M] [sum_set M]

instance to_semiring {R : Type*} [semiring R] : semiring (map M R) := {
  one := delta (1 : R),
  mul := convolve ((*) : R → R → R),
  zero_mul := λ a, zero_convolve (*) a,
  mul_zero := λ a, convolve_zero (*) a,
  one_mul := λ a, begin
   ext m,
   change convolve (*) (delta (1 : R)) a m = a m,
   rw[delta_convolve,one_mul],
  end,
  mul_one := λ a, begin
   ext m,
   change convolve (*) a (delta (1 : R)) m = a m,
   rw[convolve_delta,mul_one],
  end,
  mul_assoc := λ a b c, convolve_assoc (*) (*) (*) (*) a b c (mul_assoc),
  left_distrib  := λ a b c, convolve_add (*) a b c,
  right_distrib := λ a b c, add_convolve (*) a b c,
  .. (by apply_instance : add_comm_monoid (map M R))
}

instance to_ring {R : Type*} [ring R] : ring (map M R) := {
  .. (by apply_instance : add_comm_group (map M R)),
  .. (by apply_instance : semiring (map M R))
}

end map

namespace map

open sum_set

variables {M : Type*} [add_comm_monoid M] [decidable_eq M] [sum_set M]

instance to_comm_semiring {R : Type*} [comm_semiring R] : comm_semiring (map M R) := {
 mul_comm := λ a₁ a₂, begin
  let f  : M × M → R := λ x, (a₁ x.1) * (a₂ x.2),
  let f' : M × M → R := λ x, (a₂ x.1) * (a₁ x.2),
  have ef : (λ x, f (twist M x)) = f' := by {
   ext x,dsimp[f,f',twist],rw[mul_comm],
  },
  ext m, change (els m).sum f = (els m).sum f',
  rw[← ef, ← sum_map (els m) (twist M) f,els_twist],
 end,
 .. map.to_semiring
}

instance to_comm_ring {R : Type*} [comm_ring R] : comm_ring (map M R) := {
  .. (by apply_instance : add_comm_group (map M R)),
  .. (by apply_instance : comm_semiring (map M R))
}

end map

end convolution


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.preserves.limits
import category_theory.limits.shapes

/-!
# Preserving terminal object

Constructions to relate the notions of preserving terminal objects and reflecting terminal objects
to concrete objects.

In particular, we show that `terminal_comparison G` is an isomorphism iff `G` preserves terminal
objects.
-/

universes v u₁ u₂

noncomputable theory

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)

namespace category_theory.limits

variables (X : C)

/--
The map of an empty cone is a limit iff the mapped object is terminal.
-/
def is_limit_map_cone_empty_cone_equiv :
  is_limit (G.map_cone (as_empty_cone X)) ≃ is_terminal (G.obj X) :=
(is_limit.postcompose_hom_equiv (functor.empty_ext _ _) _).symm.trans
  (is_limit.equiv_iso_limit (cones.ext (iso.refl _) (by tidy)))

/-- The property of preserving terminal objects expressed in terms of `is_terminal`. -/
def is_terminal_obj_of_is_terminal [preserves_limit (functor.empty C) G]
  (l : is_terminal X) : is_terminal (G.obj X) :=
is_limit_map_cone_empty_cone_equiv G X (preserves_limit.preserves l)

/-- The property of reflecting terminal objects expressed in terms of `is_terminal`. -/
def is_terminal_of_is_terminal_obj [reflects_limit (functor.empty C) G]
  (l : is_terminal (G.obj X)) : is_terminal X :=
reflects_limit.reflects ((is_limit_map_cone_empty_cone_equiv G X).symm l)

variables [has_terminal C]
/--
If `G` preserves the terminal object and `C` has a terminal object, then the image of the terminal
object is terminal.
-/
def is_limit_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty C) G] :
  is_terminal (G.obj (⊤_ C)) :=
is_terminal_obj_of_is_terminal G (⊤_ C) terminal_is_terminal

/--
If `C` has a terminal object and `G` preserves terminal objects, then `D` has a terminal object
also.
Note this property is somewhat unique to (co)limits of the empty diagram: for general `J`, if `C`
has limits of shape `J` and `G` preserves them, then `D` does not necessarily have limits of shape
`J`.
-/
lemma has_terminal_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty C) G] :
  has_terminal D :=
⟨λ F,
begin
  haveI := has_limit.mk ⟨_, is_limit_of_has_terminal_of_preserves_limit G⟩,
  apply has_limit_of_iso F.unique_from_empty.symm,
end⟩

variable [has_terminal D]
/--
If the terminal comparison map for `G` is an isomorphism, then `G` preserves terminal objects.
-/
def preserves_terminal.of_iso_comparison
  [i : is_iso (terminal_comparison G)] : preserves_limit (functor.empty C) G :=
begin
  apply preserves_limit_of_preserves_limit_cone terminal_is_terminal,
  apply (is_limit_map_cone_empty_cone_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (functor.empty D)),
  apply i,
end

/-- If there is any isomorphism `G.obj ⊤ ⟶ ⊤`, then `G` preserves terminal objects. -/
def preserves_terminal_of_is_iso
  (f : G.obj (⊤_ C) ⟶ ⊤_ D) [i : is_iso f] : preserves_limit (functor.empty C) G :=
begin
  rw subsingleton.elim f (terminal_comparison G) at i,
  exactI preserves_terminal.of_iso_comparison G,
end

/-- If there is any isomorphism `G.obj ⊤ ≅ ⊤`, then `G` preserves terminal objects. -/
def preserves_terminal_of_iso
  (f : G.obj (⊤_ C) ≅ ⊤_ D) : preserves_limit (functor.empty C) G :=
preserves_terminal_of_is_iso G f.hom

variables [preserves_limit (functor.empty C) G]

/-- If `G` preserves terminal objects, then the terminal comparison map for `G` an isomorphism. -/
def preserves_terminal.iso : G.obj (⊤_ C) ≅ ⊤_ D :=
(is_limit_of_has_terminal_of_preserves_limit G).cone_point_unique_up_to_iso (limit.is_limit _)

@[simp]
lemma preserves_terminal.iso_hom : (preserves_terminal.iso G).hom = terminal_comparison G :=
rfl

instance : is_iso (terminal_comparison G) :=
begin
  rw ← preserves_terminal.iso_hom,
  apply_instance,
end

end category_theory.limits


/-
Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pierre-Alexandre Bazin
-/
import linear_algebra.dfinsupp
import ring_theory.ideal.operations

/-!
# An additional lemma about coprime ideals

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

This lemma generalises `exists_sum_eq_one_iff_pairwise_coprime` to the case of non-principal ideals.
It is on a separate file due to import requirements.
-/

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

/--A finite family of ideals is pairwise coprime (that is, any two of them generate the whole ring)
iff when taking all the possible intersections of all but one of these ideals, the resulting family
of ideals still generate the whole ring.

For example with three ideals : `I ⊔ J = I ⊔ K = J ⊔ K = ⊤ ↔ (I ⊓ J) ⊔ (I ⊓ K) ⊔ (J ⊓ K) = ⊤`.

When ideals are all of the form `I i = R ∙ s i`, this is equivalent to the
`exists_sum_eq_one_iff_pairwise_coprime` lemma.-/
lemma supr_infi_eq_top_iff_pairwise {t : finset ι} (h : t.nonempty) (I : ι → ideal R) :
  (⨆ i ∈ t, ⨅ j (hj : j ∈ t) (ij : j ≠ i), I j) = ⊤ ↔
    (t : set ι).pairwise (λ i j, I i ⊔ I j = ⊤) :=
begin
  haveI : decidable_eq ι := classical.dec_eq ι,
  rw [eq_top_iff_one, submodule.mem_supr_finset_iff_exists_sum],
  refine h.cons_induction _ _; clear' t h,
  { simp only [finset.sum_singleton, finset.coe_singleton, set.pairwise_singleton, iff_true],
    refine λ a, ⟨λ i, if h : i = a then ⟨1, _⟩ else 0, _⟩,
    { rw h, simp only [finset.mem_singleton, ne.def, infi_infi_eq_left, eq_self_iff_true,
        not_true, infi_false]},
    { simp only [dif_pos, dif_ctx_congr, submodule.coe_mk, eq_self_iff_true] } },
  intros a t hat h ih,
  rw [finset.coe_cons,
    set.pairwise_insert_of_symmetric (λ i j (h : I i ⊔ I j = ⊤), sup_comm.trans h)],
  split,
  { rintro ⟨μ, hμ⟩, rw finset.sum_cons at hμ,
    refine ⟨ih.mp ⟨pi.single h.some ⟨μ a, _⟩ + λ i, ⟨μ i, _⟩, _⟩, λ b hb ab, _⟩,
    { have := submodule.coe_mem (μ a), rw mem_infi at this ⊢,
      --for some reason `simp only [mem_infi]` times out
      intro i, specialize this i, rw [mem_infi, mem_infi] at this ⊢,
      intros hi _, apply this (finset.subset_cons _ hi),
      rintro rfl, exact hat hi },
    { have := submodule.coe_mem (μ i), simp only [mem_infi] at this ⊢,
      intros j hj ij, exact this _ (finset.subset_cons _ hj) ij },
    { rw [← @if_pos _ _ h.some_spec R (μ a) 0, ← finset.sum_pi_single',
        ← finset.sum_add_distrib] at hμ,
      convert hμ, ext i, rw [pi.add_apply, submodule.coe_add, submodule.coe_mk],
      by_cases hi : i = h.some,
      { rw [hi, pi.single_eq_same, pi.single_eq_same, submodule.coe_mk] },
      { rw [pi.single_eq_of_ne hi, pi.single_eq_of_ne hi, submodule.coe_zero] } },
    { rw [eq_top_iff_one, submodule.mem_sup],
      rw add_comm at hμ, refine ⟨_, _, _, _, hμ⟩,
      { refine sum_mem _ (λ x hx, _),
        have := submodule.coe_mem (μ x), simp only [mem_infi] at this,
        apply this _ (finset.mem_cons_self _ _), rintro rfl, exact hat hx },
      { have := submodule.coe_mem (μ a), simp only [mem_infi] at this,
        exact this _ (finset.subset_cons _ hb) ab.symm } } },
  { rintro ⟨hs, Hb⟩,
    obtain ⟨μ, hμ⟩ := ih.mpr hs,
    have := sup_infi_eq_top (λ b hb, Hb b hb (ne_of_mem_of_not_mem hb hat).symm),
    rw [eq_top_iff_one, submodule.mem_sup] at this,
    obtain ⟨u, hu, v, hv, huv⟩ := this,
    refine ⟨λ i, if hi : i = a then ⟨v, _⟩ else ⟨u * μ i, _⟩, _⟩,
    { simp only [mem_infi] at hv ⊢,
      intros j hj ij, rw [finset.mem_cons, ← hi] at hj,
      exact hv _ (hj.resolve_left ij) },
    { have := submodule.coe_mem (μ i), simp only [mem_infi] at this ⊢,
      intros j hj ij,
      rcases finset.mem_cons.mp hj with rfl | hj,
      { exact mul_mem_right _ _ hu },
      { exact mul_mem_left _ _ (this _ hj ij) } },
    { rw [finset.sum_cons, dif_pos rfl, add_comm],
      rw ← mul_one u at huv, rw [← huv, ← hμ, finset.mul_sum],
      congr' 1, apply finset.sum_congr rfl, intros j hj,
      rw dif_neg, refl,
      rintro rfl, exact hat hj } }
end

end ideal