/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

Theory of univariate polynomials, represented as finsupps, ℕ →₀ α, with α a comm_semiring

mono

-/

import linear_algebra.multivariate_polynomial algebra.euclidean_domain
open finsupp finset lattice

class is_nonzero (α : Type*) [has_one α] [has_zero α] : Prop :=
(zero_ne_one : (0 : α) ≠ (1 : α))

class nonzero_comm_ring (α : Type*) extends comm_ring α, is_nonzero α

instance integral_domain.to_nonzero_ring (α : Type*) [hd : integral_domain α] : nonzero_comm_ring α :=
{ ..hd }

namespace finset

lemma sup_lt_nat : ∀ {s t : finset ℕ}, s ⊆ t → t.sup id ∉ s
  → 0 < t.sup id → s.sup id < t.sup id :=
λ s, finset.induction_on s (λ _ _ _, id) begin
  assume a s has ih t hst hsup hpos,
  rw finset.sup_insert,
  exact max_lt_iff.2 ⟨lt_of_le_of_ne (finset.le_sup (hst (finset.mem_insert_self _ _)))
      (λ h, by simpa [h.symm] using hsup),
    ih (λ a ha, hst (finset.mem_insert_of_mem ha))
      (hsup ∘ finset.mem_insert_of_mem) hpos⟩,
end

lemma sup_mem_nat {s : finset ℕ} : s ≠ ∅ → s.sup id ∈ s :=
finset.induction_on s (by simp * at *) $
begin
  assume a s has ih _,
  by_cases h₁ : s = ∅,
  { simp * },
  { cases (le_total a (s.sup id)) with h₂ h₂,
    { simp [lattice.sup_of_le_right h₂, ih h₁] },
    { simp [lattice.sup_of_le_left h₂] } }
end

end finset

namespace finsupp

lemma erase_single {α β : Type*} [decidable_eq α] [decidable_eq β] [has_zero β]
  (a : α) (b : β) : (single a b).erase a = (0 : α →₀ β) :=
ext (λ x, begin
  by_cases hxa : x = a,
  { simp [hxa, erase_same] },
  { simp [erase_ne hxa, single_apply, if_neg (ne.symm hxa)] },
end)

end finsupp

def polynomial (α : Type*) [comm_semiring α] := ℕ →₀ α

namespace polynomial
variables {α : Type*} {a b : α} {m n : ℕ}
variables [decidable_eq α]

section comm_semiring
variables [comm_semiring α] {p q : polynomial α}

instance : has_coe_to_fun (polynomial α) := finsupp.has_coe_to_fun
instance : has_zero (polynomial α) := finsupp.has_zero
instance : has_one (polynomial α) := finsupp.has_one
instance : has_add (polynomial α) := finsupp.has_add
instance : has_mul (polynomial α) := finsupp.has_mul
instance : comm_semiring (polynomial α) := finsupp.to_comm_semiring

local attribute [instance] finsupp.to_comm_semiring

/-- `monomial n a` is the polynomial `a * X^n` -/
def monomial (n : ℕ) (a : α) : polynomial α := single n a

/-- `C a` is the constant polynomial a -/
def C (a : α) : polynomial α := monomial 0 a

/-- `X` is the polynomial whose evaluation is the identity funtion -/
def X : polynomial α := monomial 1 1

@[simp] lemma C_0 : C 0 = (0 : polynomial α) := by simp [C, monomial]; refl

@[simp] lemma C_1 : C 1 = (1 : polynomial α) := rfl

@[simp] lemma C_mul_monomial : C a * monomial n b = monomial n (a * b) :=
by simp [C, monomial, single_mul_single]

@[simp] lemma C_mul_C : C a * C b = C (a * b) :=
by simp [C, monomial, single_mul_single]

@[simp] lemma monomial_mul_monomial : monomial n a * monomial m b = monomial (n + m) (a * b) :=
single_mul_single

@[simp] lemma monomial_zero_right (n : ℕ) : monomial n (0 : α) = 0 :=
finsupp.ext $ λ a, show ite _ _ _ = (0 : α), by split_ifs; simp

lemma X_pow_eq_monomial : (X : polynomial α) ^ n = monomial n (1 : α) :=
by induction n; simp [X, C_1.symm, -C_1, C, pow_succ, *] at *

lemma monomial_add_right : monomial (n + m) a = (monomial n a * X ^ m):=
by rw [X_pow_eq_monomial, monomial, monomial, monomial, single_mul_single]; simp

lemma monomial_add_left : monomial (m + n) a = (X ^ m * monomial n a):=
by rw [X_pow_eq_monomial, monomial, monomial, monomial, single_mul_single]; simp

lemma monomial_eq : monomial n a = C a * X ^ n :=
by rw [X_pow_eq_monomial, C_mul_monomial, mul_one]

lemma erase_monomial : (monomial n a).erase n = 0 := finsupp.erase_single _ _

@[elab_as_eliminator] lemma induction_on {M : polynomial α → Prop} (p : polynomial α)
  (h_C : ∀a, M (C a)) (h_add : ∀p q, M p → M q → M (p + q))
  (h_X : ∀(n : ℕ) (a : α), M (monomial n a) → M (monomial n a * X)) :
  M p :=
have ∀n a, M (monomial n a),
begin
  assume n a,
  induction n with n ih,
  { exact h_C _ },
  { rw [← nat.add_one, monomial_add_right, pow_one],
    exact h_X _ _ ih }
end,
finsupp.induction p (show M (0 : polynomial α), by rw ← C_0; exact h_C 0) $
λ n a f hfn ha ih, (show M (monomial n a + f), from h_add _ _ (this _ _) ih)

lemma monomial_apply : @coe_fn (polynomial α) polynomial.has_coe_to_fun (monomial n a) m = ite (n = m) a 0 :=
finsupp.single_apply

lemma monomial_apply_self : @coe_fn (polynomial α) polynomial.has_coe_to_fun (monomial n a) n = a :=
by simp [monomial_apply]

lemma C_apply : @coe_fn (polynomial α) polynomial.has_coe_to_fun (C a) n = ite (0 = n) a 0 := finsupp.single_apply

lemma add_apply (p q : polynomial α) (n : ℕ) : (p + q) n = p n + q n := add_apply

@[simp] lemma C_mul_apply (p : polynomial α) : (C a * p) n = a * p n :=
induction_on p (λ b, show (monomial 0 a * monomial 0 b) n = a *
  @coe_fn (polynomial α) polynomial.has_coe_to_fun (monomial 0 b) n,
  begin
    rw [monomial_mul_monomial, monomial_apply, monomial_apply],
    split_ifs; simp
  end) begin
    intros,
    rw [mul_add, add_apply, add_apply, mul_add],
    simp *,
  end begin
    intros,
    rw [X, monomial_mul_monomial, C, monomial_mul_monomial, monomial_apply, monomial_apply],
    split_ifs;
    simp * at *,
  end

@[elab_as_eliminator] lemma monomial_induction_on {M : polynomial α → Prop} (p : polynomial α)
  (h0 : M 0)
  (h : ∀ (n : ℕ) (a : α) (p : polynomial α), p n = 0 → a ≠ 0 → M p →
  M (monomial n a + p)) : M p :=
finsupp.induction p h0 (λ n a p hpn, h n a p (by rwa [mem_support_iff, ne.def, not_not] at hpn))

section eval
variable {x : α}

/-- `eval x p` is the evaluation of the polynomial x at p -/
def eval (x : α) (p : polynomial α) : α :=
p.sum (λ e a, a * x ^ e)

@[simp] lemma eval_zero : (0 : polynomial α).eval x = 0 :=
finsupp.sum_zero_index

lemma eval_add : (p + q).eval x = p.eval x + q.eval x :=
finsupp.sum_add_index (by simp) (by simp [add_mul])

lemma eval_monomial : (monomial n a).eval x = a * x ^ n :=
finsupp.sum_single_index (zero_mul _)

@[simp] lemma eval_C : (C a).eval x = a :=
by simp [eval_monomial, C, prod_zero_index]

@[simp] lemma eval_X : X.eval x = x :=
by simp [eval_monomial, X, prod_single_index, pow_one]

lemma eval_mul_monomial :
  ∀{n a}, (p * monomial n a).eval x = p.eval x * a * x ^ n :=
begin
  apply polynomial.induction_on p,
  { assume a' s a, by simp [C_mul_monomial, eval_monomial] },
  { assume p q ih_p ih_q, simp [add_mul, eval_add, ih_p, ih_q] },
  { assume m b ih n a,
    unfold X,
    rw [mul_assoc, ih, monomial_mul_monomial, ih, pow_add],
    simp [mul_assoc, mul_comm, mul_left_comm] }
end

lemma eval_mul : ∀{p}, (p * q).eval x = p.eval x * q.eval x :=
begin
  apply polynomial.induction_on q,
  { simp [C, eval_monomial, eval_mul_monomial, prod_zero_index] },
  { simp [mul_add, eval_add] {contextual := tt} },
  { simp [X, eval_monomial, eval_mul_monomial, (mul_assoc _ _ _).symm] { contextual := tt} }
end

/-- `is_root p x` implies x is a root of p. The evaluation of p at x is zero -/
def is_root (p : polynomial α) (a : α) : Prop := p.eval a = 0

lemma is_root.def : is_root p a ↔ p.eval a = 0 := iff.rfl

lemma root_mul_left_of_is_root (q : polynomial α) : is_root p a → is_root (q * p) a :=
by simp [is_root.def, eval_mul] {contextual := tt}

lemma root_mul_right_of_is_root (q : polynomial α) : is_root p a → is_root (p * q) a :=
by simp [is_root.def, eval_mul] {contextual := tt}

end eval

/-- `degree p` gives the highest power of X that appears in `p` -/
def degree (p : polynomial α) : ℕ := p.support.sup id

/-- `leading_coeff p` gives the coefficient of the highest power of `X` in `p`-/
def leading_coeff (p : polynomial α) : α := p (degree p)

/-- a polynomial is `monic` if its leading coefficient is 1 -/
def monic (p : polynomial α) := leading_coeff p = (1 : α)

@[simp] lemma degree_zero : degree (0 : polynomial α) = 0 := rfl

@[simp] lemma degree_C (a : α) : degree (C a) = 0 :=
begin
  unfold C single monomial degree finsupp.support,
  by_cases a = 0;
  simp *;
  refl
end

lemma degree_monomial_le (n : ℕ) (a : α) : degree (monomial n a) ≤ n :=
begin
  unfold single monomial degree finsupp.support,
  by_cases a = 0;
  simp [*, sup];
  refl
end

@[simp] lemma degree_monomial (n : ℕ) (ha : a ≠ 0) : degree (monomial n a) = n :=
begin
  unfold X single monomial degree finsupp.support,
  rw if_neg ha,
  simp [sup]
end

lemma le_degree_of_ne_zero (h : p n ≠ 0) : n ≤ degree p :=
show id n ≤ p.support.sup id,
from finset.le_sup ((finsupp.mem_support_iff _ _).2 h)

lemma eq_zero_of_degree_lt (h : degree p < n) : p n = 0 :=
not_not.1 (mt le_degree_of_ne_zero (not_le_of_gt h))

lemma eq_C_of_degree_eq_zero (h : degree p = 0) : p = C (p 0) :=
ext begin
  assume n,
  cases n,
  { refl },
  { have h : degree p < nat.succ n := h.symm ▸ nat.succ_pos _,
    rw [eq_zero_of_degree_lt h, C_apply, if_neg],
    exact λ h, nat.no_confusion h }
end

lemma degree_add_le (p q : polynomial α) :
  degree (p + q) ≤ max (degree p) (degree q) :=
show _ ≤ (finset.sup (p.support) id) ⊔ (finset.sup (q.support) id),
by rw ← finset.sup_union;
  exact finset.sup_mono support_add

@[simp] lemma leading_coeff_zero : leading_coeff (0 : polynomial α) = 0 := rfl

@[simp] lemma leading_coeff_eq_zero : leading_coeff p = 0 ↔ p = 0 :=
⟨λ h, by_contradiction (λ h₁, (mem_support_iff _ _).1 (finset.sup_mem_nat (mt support_eq_empty.1 h₁)) h),
by simp { contextual := tt }⟩

lemma degree_add_eq_of_degree_lt (h : degree p < degree q) : degree (p + q) = degree q :=
le_antisymm (max_eq_right_of_lt h ▸ degree_add_le _ _)
  (le_degree_of_ne_zero begin
    rw [add_apply, eq_zero_of_degree_lt h, zero_add],
    exact mt leading_coeff_eq_zero.1 (λ h₁, by simpa [h₁, nat.not_lt_zero] using h)
  end)

lemma degree_add_eq_of_apply_ne (h : leading_coeff p + q (degree p) ≠ 0) :
  degree (p + q) = max p.degree q.degree :=
le_antisymm (degree_add_le _ _) (le_degree_of_ne_zero begin
  rw add_apply,
  unfold max,
  split_ifs,
  { cases lt_or_eq_of_le h_1 with h₁ h₁,
    { rw [not_not.1 (mt le_degree_of_ne_zero (not_le_of_gt h₁)), zero_add],
      exact mt leading_coeff_eq_zero.1 (λ h, by simpa [h, nat.not_lt_zero] using h₁) },
    { rwa ← h₁ } },
  assumption
end)

lemma degree_erase_lt (h : 0 < degree p) :
  degree (p.erase (degree p)) < degree p :=
finset.sup_lt_nat (erase_subset _ _) (not_mem_erase _ _) h

lemma degree_mul_le : ∀ (p q : polynomial α), degree (p * q) ≤ degree p + degree q :=
have hsup : ∀ {n : ℕ} {q : polynomial α} {a : α},
    sup ((sum q (λ (m : ℕ) (x : α), single (n + m) (a * x))).support) id
  ≤ n + degree q := λ n q a, sup_le (λ b hb, begin
    rcases mem_bind.1 (finsupp.support_sum hb) with ⟨x, hx₁, hx₂⟩,
    rw mem_support_iff at hx₁ hx₂,
    rw single_apply at hx₂,
    by_cases hnx : n + x = b,
    { rw [← hnx, id.def],
      exact add_le_add_left (le_degree_of_ne_zero hx₁) _ },
    { simpa [hnx] using hx₂ }
  end),
λ p, monomial_induction_on p
(by simp [nat.zero_le])
(assume n a p hpn ha ih q,
calc degree ((single n a + p) * q) ≤ max (degree (single n a * q)) (degree (p * q)) :
  by rw add_mul; exact degree_add_le _ _
  ... = max ((q.sum (λ m x, single (n + m) (a * x))).support.sup id) (degree (p * q)) :
    by rw [mul_def, sum_single_index, degree]; simp
  ... ≤ max (n + degree q) (degree p + degree q) : by exact max_le_max hsup (ih _)
  ... ≤ max n (degree p) + degree q : max_le (add_le_add_right
    (le_max_left _ _) _) (add_le_add_right (le_max_right _ _) _)
  ... = degree (monomial n a + p) + degree q :
    begin
      rw [degree_add_eq_of_apply_ne, degree_monomial _ ha],
      rwa [leading_coeff, degree_monomial _ ha, monomial_apply_self, hpn, add_zero]
    end)

lemma degree_erase_le (p : polynomial α) (n : ℕ) : degree (p.erase n) ≤ degree p :=
sup_mono (erase_subset _ _)

lemma monic.def : monic p ↔ leading_coeff p = 1 := iff.rfl

@[simp] lemma leading_coeff_monomial (a : α) (n : ℕ) : leading_coeff (monomial n a) = a :=
begin
  by_cases ha : a = 0,
  { simp [ha] },
  { simp [leading_coeff, degree_monomial _ ha, monomial_apply] },
end

@[simp] lemma leading_coeff_C (a : α) : leading_coeff (C a) = a :=
leading_coeff_monomial _ _

lemma leading_coeff_add_of_lt (h : degree p < degree q) :
  leading_coeff (p + q) = leading_coeff q :=
by unfold leading_coeff;
  rw [degree_add_eq_of_degree_lt h, add_apply, eq_zero_of_degree_lt h, zero_add]

@[simp] lemma mul_apply_degree_add_degree (p q : polynomial α) :
  (p * q) (degree p + degree q) = leading_coeff p * leading_coeff q :=
if hp : degree p = 0 then begin
  rw [eq_C_of_degree_eq_zero hp],
  simp [leading_coeff, C_apply]
end
else
have h₁ : p * q = monomial (degree p + degree q) (p (degree p) * q (degree q)) +
  erase (degree p) p * monomial (degree q) (q (degree q)) +
  (erase (degree q) q * monomial (degree p) (p (degree p)) +
  erase (degree p) p * erase (degree q) q),
begin
  unfold monomial,
  conv {to_lhs, rw [← @single_add_erase _ _ _ _ _ (degree p) p,
      ← @single_add_erase _ _ _ _ _ (degree q) q,
      mul_add, add_mul, add_mul, single_mul_single] },
  simp [mul_comm],
end,
have h₂ : ∀ {p q r : polynomial α}, degree r ≤ degree q →
  (erase (degree p) p * r) (degree p + degree q) = 0,
from λ p q r hr, if hp : degree p = 0 then
  by rw [hp, eq_C_of_degree_eq_zero hp, C, erase_monomial, zero_add, zero_mul, zero_apply]
else
eq_zero_of_degree_lt
  (calc degree (erase (degree p) p * r)
      ≤ _ : degree_mul_le _ _
  ... < _ : add_lt_add_of_lt_of_le (degree_erase_lt (nat.pos_of_ne_zero hp)) hr),
begin
  rw [h₁, add_apply, add_apply, add_apply, monomial_apply, if_pos rfl],
  rw [h₂ (degree_monomial_le _ _), h₂ (degree_erase_le _ _),
    add_comm (degree p), h₂ (degree_monomial_le _ _), add_zero, add_zero, add_zero],
  refl,
end

lemma degree_mul_eq' {p q : polynomial α} (h : leading_coeff p * leading_coeff q ≠ 0) :
  degree (p * q) = degree p + degree q :=
le_antisymm (degree_mul_le _ _) (le_degree_of_ne_zero (by rwa mul_apply_degree_add_degree))

end comm_semiring

section comm_ring
variables [comm_ring α] {p q : polynomial α}
instance : comm_ring (polynomial α) := finsupp.to_comm_ring
instance : has_scalar α (polynomial α) := finsupp.to_has_scalar
instance : module α (polynomial α) := finsupp.to_module
instance {x : α} : is_ring_hom (eval x) := ⟨λ x y, eval_add, λ x y, eval_mul, eval_C⟩

@[simp] lemma degree_neg (p : polynomial α) : degree (-p) = degree p :=
by unfold degree; rw support_neg

@[simp] lemma neg_apply (p : polynomial α) (n : ℕ) : (-p) n = - p n := neg_apply

lemma eval_neg (p : polynomial α) (x : α) : (-p).eval x = -p.eval x :=
is_ring_hom.map_neg _

lemma eval_sub (p q : polynomial α) (x : α) : (p - q).eval x = p.eval x - q.eval x :=
is_ring_hom.map_sub _

lemma degree_sub_lt (hd : degree p = degree q)
  (hpos : 0 < degree p) (hlc : leading_coeff p = leading_coeff q) :
  degree (p - q) < degree p :=
have hlc' : p (degree p) = q (degree q) := hlc,
have hp : single (degree p) (p (degree p)) + p.erase (degree p) = p :=
  finsupp.single_add_erase,
have hq : single (degree q) (q (degree q)) + q.erase (degree q) = q :=
  finsupp.single_add_erase,
begin
  conv { to_lhs, rw [← hp, ← hq, hlc', hd, add_sub_add_left_eq_sub] },
  exact calc degree (erase (degree q) p + -erase (degree q) q)
    ≤ max (degree (erase (degree q) p)) (degree (erase (degree q) q))
    : by rw ← degree_neg (erase (degree q) q);
      exact degree_add_le _ _
  ... < degree p : max_lt_iff.2
    ⟨hd ▸ degree_erase_lt hpos,
    hd.symm ▸ degree_erase_lt (hd ▸ hpos)⟩
end

lemma div_wf_lemma (h : degree q ≤ degree p ∧ 0 < degree p) (hq : monic q) :
  degree (p - monomial (degree p - degree q) (leading_coeff p) * q) < degree p :=
have hp : leading_coeff p ≠ 0, from mt leading_coeff_eq_zero.1 (λ h₁, by simpa [h₁, lt_irrefl] using h),
have hpq : leading_coeff (monomial (degree p - degree q) (leading_coeff p)) * leading_coeff q ≠ 0,
  by rwa [leading_coeff, degree_monomial _ hp, monomial_apply, if_pos rfl, monic.def.1 hq, mul_one],
have hzq : leading_coeff (monomial (degree p - degree q) (p (degree p))) * leading_coeff q ≠ 0 :=
  by rwa [monic.def.1 hq, leading_coeff_monomial, mul_one],
degree_sub_lt (by rw [degree_mul_eq' hpq, degree_monomial _ hp, nat.sub_add_cancel h.1])
h.2
(by rw [leading_coeff, leading_coeff, degree_mul_eq' hzq, mul_apply_degree_add_degree,
      leading_coeff_monomial, monic.def.1 hq, mul_one])

def div_mod_by_monic_aux : Π (p : polynomial α) {q : polynomial α},
  monic q → polynomial α × polynomial α
| p := λ q hq, if h : degree q ≤ degree p ∧ 0 < degree p then
have h : _ := div_wf_lemma h hq,
let z := monomial (degree p - degree q) (leading_coeff p) in
let dm := div_mod_by_monic_aux (p - z * q) hq in
⟨z + dm.1, dm.2⟩
else if degree p = 0 ∧ degree q = 0
  then ⟨C (leading_coeff p), 0⟩
else ⟨0, p⟩
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf degree⟩]}

/-- `div_by_monic` gives the quotient of `p` by a monic polynomial `q`. -/
def div_by_monic (p : polynomial α) {q : polynomial α} (hq : monic q) : polynomial α :=
(div_mod_by_monic_aux p hq).1

/-- `mod_by_monic` gives the remainder of `p` by a monic polynomial `q` -/
def mod_by_monic (p : polynomial α) {q : polynomial α} (hq : monic q) : polynomial α :=
(div_mod_by_monic_aux p hq).2

lemma degree_mod_by_monic_lt : ∀ (p : polynomial α) {q : polynomial α} (hq : monic q)
  (hq0 : 0 < degree q), degree (mod_by_monic p hq) < degree q
| p := λ q hq hq0, if h : degree q ≤ degree p ∧ 0 < degree p then
have wf : _ := div_wf_lemma h hq,
begin
  unfold mod_by_monic div_mod_by_monic_aux,
  rw if_pos h,
  exact degree_mod_by_monic_lt _ hq hq0,
end
else
have h₁ : ¬ (degree p = 0 ∧ degree q = 0) := λ h₁, by simpa [h₁.2, lt_irrefl] using hq0,
begin
  unfold mod_by_monic div_mod_by_monic_aux,
  rw [if_neg h, if_neg h₁],
  cases not_and_distrib.1 h with h₂ h₂,
  { exact lt_of_not_ge h₂ },
  { simpa [nat.le_zero_iff.1 (le_of_not_gt h₂)] }
end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf degree⟩]}

@[simp] lemma mod_by_monic_C_eq_zero (a : α) (hq : monic q) : mod_by_monic (C a) hq = 0 :=
begin

end

lemma mod_by_monic_eq_sub_mul_div : ∀ (p : polynomial α) {q : polynomial α} (hq :monic q),
  mod_by_monic p hq = p - q * div_by_monic p hq
| p := λ q hq, if h : degree q ≤ degree p ∧ 0 < degree p then
  have wf : _ := div_wf_lemma h hq,
  begin
  unfold mod_by_monic div_by_monic div_mod_by_monic_aux,
  rw if_pos h,
  show mod_by_monic (p - (monomial (degree p - degree q) (leading_coeff p) * q)) hq = p -
    q * (monomial (degree p - degree q) (leading_coeff p) +
    div_by_monic (p - (monomial (degree p - degree q) (leading_coeff p) * q)) hq),
  rw mod_by_monic_eq_sub_mul_div,
  simp [mul_add, add_mul, mul_comm]
end
else if h₁ : degree p = 0 ∧ degree q = 0 then
have hq0 : q 0 = 1 := h₁.2 ▸ hq,
begin
  unfold mod_by_monic div_by_monic div_mod_by_monic_aux,
  rw [if_neg h, if_pos h₁, eq_C_of_degree_eq_zero h₁.2],
  conv {to_rhs, congr, rw eq_C_of_degree_eq_zero h₁.1},
  simp [hq0, leading_coeff, h₁.1]
end
else begin
  unfold mod_by_monic div_by_monic div_mod_by_monic_aux,
  rw [if_neg h, if_neg h₁],
  simp
end
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf degree⟩]}

lemma mod_by_monic_add_div (p : polynomial α) {q : polynomial α} (hq : monic q) :
  mod_by_monic p hq + q * div_by_monic p hq = p := eq_sub_iff_add_eq.1 (mod_by_monic_eq_sub_mul_div p hq)

lemma degree_div_by_monic_lt (p : polynomial α) {q : polynomial α} (hq : monic q)
  (hq0 : 0 < degree q) (hp0 : 0 < degree p) : degree (div_by_monic p hq) < degree p :=
if hdp : div_by_monic p hq = 0 then by simpa [hdp] else
have h₁ : leading_coeff q * leading_coeff (div_by_monic p hq) ≠ 0 :=
by rw [monic.def.1 hq, one_mul];
  exact mt leading_coeff_eq_zero.1 hdp,
have h₂ : degree (mod_by_monic p hq) < degree (q * div_by_monic p hq) :=
by rw degree_mul_eq' h₁;
  exact calc degree (mod_by_monic p hq) < degree q : degree_mod_by_monic_lt p hq hq0
    ... ≤ degree q + _ : nat.le_add_right _ _,
begin
  conv {to_rhs, rw ← mod_by_monic_add_div p hq},
  rw [degree_add_eq_of_degree_lt h₂, degree_mul_eq' h₁],
  exact (lt_add_iff_pos_left _).2 hq0,
end

lemma dvd_of_mod_by_monic_eq_zero (hq : monic q): mod_by_monic p hq = 0 → q ∣ p :=
λ h, by rw [← mod_by_monic_add_div p hq, h, zero_add];
  exact dvd_mul_right _ _

end comm_ring

section nonzero_comm_ring
variables [nonzero_comm_ring α] {p q : polynomial α}
instance : nonzero_comm_ring (polynomial α) :=
{ zero_ne_one := λ h,
    have  (1 : polynomial α).eval 0 = 1 := eval_C,
    by rw [← h, ← C_0, eval_C] at this;
    exact is_nonzero.zero_ne_one α this
  ..polynomial.comm_ring }

lemma degree_X : degree (X : polynomial α) = 1 :=
begin
  unfold X monomial degree single finsupp.support,
  rw if_neg (is_nonzero.zero_ne_one α).symm,
  simp [sup],
end

lemma degree_X_sub_C (a : α) : degree (X - C a) = 1 :=
begin
  rw [sub_eq_add_neg, add_comm, ← @degree_X α],
  exact degree_add_eq_of_degree_lt (by simp [degree_X, degree_neg, degree_C, nat.succ_pos])
end

lemma monic_X_sub_C (a : α) : monic (X - C a) :=
begin
  unfold monic leading_coeff,
  rw [degree_X_sub_C, sub_eq_add_neg, add_apply, X, C, monomial_apply, neg_apply, monomial_apply],
  split_ifs; simp * at *
end

lemma root_X_sub_C : is_root (X - C a) b ↔ a = b :=
by rw [is_root.def, eval_sub, eval_X, eval_C, sub_eq_zero_iff_eq, eq_comm]

lemma mod_by_monic_X_sub_C_eq_C_eval (p : polynomial α) (a : α) : mod_by_monic p (monic_X_sub_C a) = C (p.eval a) :=
have h : (mod_by_monic p (monic_X_sub_C a)).eval a = p.eval a :=
  by rw [mod_by_monic_eq_sub_mul_div, eval_sub, eval_mul, eval_sub, eval_X, eval_C, sub_self, zero_mul, sub_zero],
have degree (mod_by_monic p (monic_X_sub_C a)) < 1 :=
  degree_X_sub_C a ▸ degree_mod_by_monic_lt p (monic_X_sub_C a) ((degree_X_sub_C a).symm ▸ nat.succ_pos _),
have degree (mod_by_monic p (monic_X_sub_C a)) = 0 := nat.eq_zero_of_le_zero (nat.le_of_lt_succ this),
begin
  rw [eq_C_of_degree_eq_zero this, eval_C] at h,
  rw [eq_C_of_degree_eq_zero this, h]
end

lemma mul_div_eq_iff_is_root : (X - C a) * div_by_monic p (monic_X_sub_C a) = p ↔ is_root p a :=
⟨λ h, by rw [← h, is_root.def, eval_mul, eval_sub, eval_X, eval_C, sub_self, zero_mul],
λ h : p.eval a = 0,
  by conv{to_rhs, rw ← mod_by_monic_add_div p (monic_X_sub_C a)};
    rw [mod_by_monic_X_sub_C_eq_C_eval, h, C_0, zero_add]⟩

end nonzero_comm_ring

section integral_domain
variables [integral_domain α] {p q : polynomial α}

lemma degree_mul_eq (hp : p ≠ 0) (hq : q ≠ 0) : degree (p * q) = degree p + degree q :=
by rw degree_mul_eq';
  exact mul_ne_zero (mt leading_coeff_eq_zero.1 hp)
    (mt leading_coeff_eq_zero.1 hq)

lemma leading_coeff_mul (p q : polynomial α) : leading_coeff (p * q) =
  leading_coeff p * leading_coeff q :=
begin
  by_cases hp : p = 0,
  { simp [hp] },
  by_cases hq : q = 0,
  { simp [hq] },
  rw [leading_coeff, degree_mul_eq hp hq, mul_apply_degree_add_degree],
end

instance : integral_domain (polynomial α) :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b h, begin
    have : leading_coeff 0 = leading_coeff a * leading_coeff b := h ▸ leading_coeff_mul a b,
    rw [leading_coeff_zero, eq_comm] at this,
    rw [← leading_coeff_eq_zero, ← leading_coeff_eq_zero],
    exact eq_zero_or_eq_zero_of_mul_eq_zero this
  end,
  ..polynomial.nonzero_comm_ring }

lemma root_or_root_of_root_mul (h : is_root (p * q) a) : is_root p a ∨ is_root q a :=
by rw [is_root, eval_mul] at h;
  exact eq_zero_or_eq_zero_of_mul_eq_zero h

lemma exists_finset_roots : Π {p : polynomial α} (hp : p ≠ 0),
  ∃ s : finset α, s.card ≤ degree p ∧ ∀ x, x ∈ s ↔ is_root p x
| p := λ hp, by haveI := classical.prop_decidable (∃ x, is_root p x); exact
if h : ∃ x, is_root p x
then
  let ⟨x, hx⟩ := h in
  have hpd : 0 < degree p := nat.pos_of_ne_zero
    (λ h, begin
      rw [eq_C_of_degree_eq_zero h, is_root, eval_C] at hx,
      have h1 : p (degree p) ≠ 0 := mt leading_coeff_eq_zero.1 hp,
      rw h at h1,
      contradiction,
    end),
  have hd0 : div_by_monic p (monic_X_sub_C x) ≠ 0 :=
    λ h, by have := mul_div_eq_iff_is_root.2 hx;
      simp * at *,
  have wf : degree (div_by_monic p _) < degree p :=
    degree_div_by_monic_lt _ (monic_X_sub_C x)
    ((degree_X_sub_C x).symm ▸ nat.succ_pos _) hpd,
  let ⟨t, htd, htr⟩ := @exists_finset_roots (div_by_monic p (monic_X_sub_C x)) hd0 in
  ⟨insert x t, calc (insert x t).card ≤ t.card + 1 : finset.card_insert_le _ _
    ... ≤ degree (div_by_monic p (monic_X_sub_C x)) + 1 : nat.succ_le_succ htd
    ... ≤ _ : nat.succ_le_of_lt wf,
  begin
    assume y,
    rw [mem_insert, htr, eq_comm, ← root_X_sub_C],
    conv {to_rhs, rw ← mul_div_eq_iff_is_root.2 hx},
    exact ⟨λ h, or.cases_on h (root_mul_right_of_is_root _) (root_mul_left_of_is_root _),
      root_or_root_of_root_mul⟩
  end⟩
else
  ⟨∅, nat.zero_le _, by clear exists_finset_roots; finish⟩
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf degree⟩]}

noncomputable def roots (p : polynomial α) : finset α :=
if h : p = 0 then ∅ else classical.some (exists_finset_roots h)

lemma card_roots (p : polynomial α) : (roots p).card ≤ degree p :=
begin
  unfold roots,
  split_ifs,
  { exact nat.zero_le _ },
  { exact (classical.some_spec (exists_finset_roots h)).1 }
end

lemma mem_roots (hp : p ≠ 0) : a ∈ p.roots ↔ is_root p a :=
by unfold roots; rw dif_neg hp; exact (classical.some_spec (exists_finset_roots hp)).2 _

end integral_domain

section field
variables [field α] {p q : polynomial α}
instance : vector_space α (polynomial α) :=
{ ..finsupp.to_module }

lemma monic_mul_leading_coeff_inv (h : p ≠ 0) :
  monic (p * C (leading_coeff p)⁻¹) :=
by rw [monic, leading_coeff_mul, leading_coeff_C,
  mul_inv_cancel (show leading_coeff p ≠ 0, from mt leading_coeff_eq_zero.1 h)]

lemma degree_mul_leading_coeff_inv (h : p ≠ 0) :
  degree (p * C (leading_coeff p)⁻¹) = degree p :=
have C (leading_coeff p)⁻¹ ≠ 0 := mt leading_coeff_eq_zero.2
  $ by rw [leading_coeff_C];
  exact inv_ne_zero (mt leading_coeff_eq_zero.1 h),
by rw [degree_mul_eq h this, degree_C, add_zero]

def div_aux (p q : polynomial α) :=
if h : q = 0 then (0 : polynomial α) else
C (leading_coeff q)⁻¹ * div_by_monic p
  (show leading_coeff (q * C (leading_coeff q)⁻¹) = 1,
    by rw [leading_coeff_mul, leading_coeff_C,
      mul_inv_cancel (show leading_coeff q ≠ 0, from mt leading_coeff_eq_zero.1 h)])

def mod_aux (p q : polynomial α) :=
if h : q = 0 then p else
mod_by_monic p
  (show leading_coeff (q * C (leading_coeff q)⁻¹) = 1,
    by rw [leading_coeff_mul, leading_coeff_C,
      mul_inv_cancel (show leading_coeff q ≠ 0, from mt leading_coeff_eq_zero.1 h)])

instance : has_div (polynomial α) := ⟨div_aux⟩

instance : has_mod (polynomial α) := ⟨mod_aux⟩

private lemma quotient_mul_add_remainder_eq_aux (p q : polynomial α) :
  (div_aux p q) * q + (mod_aux p q) = p :=
if h : q = 0 then by simp [mod_aux, div_aux, dif_pos h]
else begin
  conv {to_rhs, rw ← mod_by_monic_add_div p (monic_mul_leading_coeff_inv h)},
  rw [mod_aux, div_aux, dif_neg h, dif_neg h, add_comm, mul_comm _ q, mul_assoc],
  refl,
end

/-- euclid_size_poly is the Euclidean size function, used in the proof that polynomials over a
field are a Euclidean domain. `euclid_size_poly 0 = 0` and `euclid_size_poly p = degree p + 1`
for `p ≠ 0`. -/
def euclid_size_poly (p : polynomial α) :=
if p = 0 then 0 else degree p + 1

@[simp] lemma euclid_size_poly_zero : euclid_size_poly (0 : polynomial α) = 0 := rfl

lemma euclid_size_poly_eq_zero (h : euclid_size_poly p = 0) : p = 0 :=
begin
  unfold euclid_size_poly at h,
  split_ifs at h,
  { assumption },
  { exact absurd h (nat.succ_ne_zero _) }
end

lemma degree_le_of_euclid_size_poly (h : euclid_size_poly p ≤ euclid_size_poly q) :
  degree p ≤ degree q :=
begin
  unfold euclid_size_poly at h,
  split_ifs at h,
  { simp * },
  { simp [*, nat.zero_le] },
  { simp [not_le_of_gt (nat.succ_pos _), nat.one_add, *] at * },
  exact nat.le_of_succ_le_succ h
end

lemma euclid_size_poly_lt_of_degree_lt (h : degree p < degree q) :
  euclid_size_poly p < euclid_size_poly q :=
begin
  unfold euclid_size_poly,
  split_ifs;
  simp [*, nat.succ_pos, -add_comm, nat.not_lt_zero,
    iff.intro nat.lt_of_succ_lt_succ nat.succ_lt_succ] at *
end

lemma valuation_remainder_lt_aux (p : polynomial α) (hq : q ≠ 0) :
  euclid_size_poly (mod_aux p q) < euclid_size_poly q :=
if h : 0 < degree q then
euclid_size_poly_lt_of_degree_lt $ begin
  unfold mod_aux,
  rw dif_neg hq,
  have := degree_mod_by_monic_lt p (monic_mul_leading_coeff_inv hq),
  rw degree_mul_leading_coeff_inv hq at this,
  exact this h,
end
else begin

end

lemma valuation_remainder_lt_aux (p : polynomial α) (hq : q ≠ 0) :
  euclid_size_poly (mod_aux p q) < euclid_size_poly q :=
if h : 0 = degree q then begin
  unfold mod_aux,
  rw eq_C_of_degree_eq_zero h.symm at *,
  rw dif_neg hq,
  unfold mod_by_monic div_mod_by_monic_aux,
  by_cases hp : (0 < degree p),
  simp [hp, nat.zero_le],
end
else if h₁ : mod_aux p q = 0 then sorry

else
have h₂ : degree (q * C (leading_coeff q)⁻¹) = degree q,
  from have C (leading_coeff q)⁻¹ ≠ 0, from mt leading_coeff_eq_zero.2
    $ by rw [leading_coeff_C]; exact inv_ne_zero (mt leading_coeff_eq_zero.1 hq),
  by rwa [degree_mul_eq hq this, degree_C, add_zero],
have degree (mod_by_monic p _) < degree (q * C (leading_coeff q)⁻¹) :=
    degree_mod_by_monic_lt p
    (monic_mul_leading_coeff_inv (mt leading_coeff_eq_zero.1 hq))
    (nat.pos_of_ne_zero $ h₂.symm ▸ ne.symm h),
begin
  unfold euclid_size_poly,
  rw [if_neg hq, if_neg h₁, mod_aux, dif_neg (mt leading_coeff_eq_zero.1 hq), ← h₂],
  exact nat.succ_lt_succ this,
end

/-
instance : euclidean_domain (polynomial α) :=
{ quotient := div_aux,
  remainder := mod_aux,
  quotient_mul_add_remainder_eq := by exact quotient_mul_add_remainder_eq_aux,
  valuation := degree,
  valuation_remainder_lt := λ a b hb, begin rw [mod_aux, dif_neg], have := degree_mod_by_monic_lt a, end,  } -/

end field

end polynomial


/-
Copyright (c) 2018 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 algebra.category.Group.basic
! leanprover-community/mathlib commit 524793de15bc4c52ee32d254e7d7867c7176b3af
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Category.MonCat.Basic
import Mathlib.CategoryTheory.Endomorphism

/-!
# Category instances for group, add_group, comm_group, and add_comm_group.

We introduce the bundled categories:
* `GroupCat`
* `AddGroupCat`
* `CommGroupCat`
* `AddCommGroupCat`
along with the relevant forgetful functors between them, and to the bundled monoid categories.
-/

universe u v

open CategoryTheory

/-- The category of groups and group morphisms. -/
@[to_additive]
def GroupCat : Type (u + 1) :=
  Bundled Group
set_option linter.uppercaseLean3 false in
#align Group GroupCat
set_option linter.uppercaseLean3 false in
#align AddGroup AddGroupCat

/-- The category of additive groups and group morphisms -/
add_decl_doc AddGroupCat

namespace GroupCat

@[to_additive]
instance : BundledHom.ParentProjection
  (fun {α : Type _} (h : Group α) => h.toDivInvMonoid.toMonoid) := ⟨⟩

instance largeCategory : LargeCategory GroupCat := by
  dsimp only [GroupCat]
  infer_instance

instance concreteCategory : ConcreteCategory GroupCat := by
  dsimp only [GroupCat]
  infer_instance

attribute [to_additive] GroupCat.largeCategory GroupCat.concreteCategory

@[to_additive]
instance : CoeSort GroupCat (Type _) := by
  dsimp only [GroupCat]
  infer_instance

/-- Construct a bundled `Group` from the underlying type and typeclass. -/
@[to_additive]
def of (X : Type u) [Group X] : GroupCat :=
  Bundled.of X
set_option linter.uppercaseLean3 false in
#align Group.of GroupCat.of
set_option linter.uppercaseLean3 false in
#align AddGroup.of AddGroupCat.of

/-- Construct a bundled `AddGroup` from the underlying type and typeclass. -/
add_decl_doc AddGroupCat.of

/-- Typecheck a `MonoidHom` as a morphism in `GroupCat`. -/
@[to_additive]
def ofHom {X Y : Type u} [Group X] [Group Y] (f : X →* Y) : of X ⟶ of Y :=
  f
set_option linter.uppercaseLean3 false in
#align Group.of_hom GroupCat.ofHom
set_option linter.uppercaseLean3 false in
#align AddGroup.of_hom AddGroupCat.ofHom

/-- Typecheck a `add_monoid_hom` as a morphism in `AddGroup`. -/
add_decl_doc AddGroupCat.ofHom

-- porting note: this instance was not necessary in mathlib
@[to_additive]
instance {X Y : GroupCat} : CoeFun (X ⟶ Y) fun _ => X → Y :=
  ConcreteCategory.hasCoeToFun

-- porting note: this was added to ease automation
@[to_additive (attr := simp)]
lemma id_apply {X : GroupCat} (x : X) :
  (𝟙 X) x = x := rfl

-- porting note: this was added to ease automation
@[to_additive (attr := simp)]
lemma comp_apply {X Y Z : GroupCat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g) x = g (f x) := rfl

@[to_additive (attr := simp)]
theorem ofHom_apply {X Y : Type _} [Group X] [Group Y] (f : X →* Y) (x : X) :
    (ofHom f) x = f x :=
  rfl
set_option linter.uppercaseLean3 false in
#align Group.of_hom_apply GroupCat.ofHom_apply
set_option linter.uppercaseLean3 false in
#align AddGroup.of_hom_apply AddGroupCat.ofHom_apply

@[to_additive]
instance (G : GroupCat) : Group G :=
  G.str

-- porting note: added to make `one_apply` work
@[to_additive]
instance (G : GroupCat) : Group ((forget GroupCat).obj G) :=
  G.str

-- porting note: simp attribute was removed to please the linter
@[to_additive]
theorem coe_of (R : Type u) [Group R] : ↑(GroupCat.of R) = R :=
  rfl
set_option linter.uppercaseLean3 false in
#align Group.coe_of GroupCat.coe_of
set_option linter.uppercaseLean3 false in
#align AddGroup.coe_of AddGroupCat.coe_of

@[to_additive]
instance : Inhabited GroupCat :=
  ⟨GroupCat.of PUnit⟩

@[to_additive]
instance ofUnique (G : Type _) [Group G] [i : Unique G] : Unique (GroupCat.of G) :=
  i
set_option linter.uppercaseLean3 false in
#align Group.of_unique GroupCat.ofUnique
set_option linter.uppercaseLean3 false in
#align AddGroup.of_unique AddGroupCat.ofUnique

-- porting note: this instance was not necessary in mathlib
@[to_additive]
instance (G H : GroupCat) : One (G ⟶ H) := (inferInstance : One (MonoidHom G H))

@[to_additive (attr := simp)]
theorem one_apply (G H : GroupCat) (g : G) : ((forget GroupCat).map (1 : G ⟶ H)) g = 1 :=
  rfl
set_option linter.uppercaseLean3 false in
#align Group.one_apply GroupCat.one_apply
set_option linter.uppercaseLean3 false in
#align AddGroup.zero_apply AddGroupCat.zero_apply

@[to_additive (attr := ext)]
theorem ext (G H : GroupCat) (f₁ f₂ : G ⟶ H) (w : ∀ (x : ↑G), f₁ x = f₂ x) : f₁ = f₂ :=
  ConcreteCategory.hom_ext _ _ w
set_option linter.uppercaseLean3 false in
#align Group.ext GroupCat.ext
set_option linter.uppercaseLean3 false in
#align AddGroup.ext AddGroupCat.ext

@[to_additive hasForgetToAddMonCat]
instance hasForgetToMonCat : HasForget₂ GroupCat MonCat :=
  BundledHom.forget₂ _ _
set_option linter.uppercaseLean3 false in
#align Group.has_forget_to_Mon GroupCat.hasForgetToMonCat
set_option linter.uppercaseLean3 false in
#align AddGroup.has_forget_to_AddMon AddGroupCat.hasForgetToAddMonCat

@[to_additive]
instance : Coe GroupCat.{u} MonCat.{u} where coe := (forget₂ GroupCat MonCat).obj

-- porting note: this was added to ease the port
/-- the morphism in `GroupCat` associated to a `MonoidHom` -/
@[to_additive]
def Hom.mk {X Y : GroupCat} (f : X →* Y) : X ⟶ Y := f

/-- the morphism in `AddGroupCat` associated to a `AddMonoidHom` -/
add_decl_doc AddGroupCat.Hom.mk

@[to_additive (attr := simp)]
lemma Hom.mk_apply {X Y : GroupCat} (f : X →* Y) (x : X) :
  (Hom.mk f) x = f x := rfl

-- porting note: added to ease automation
@[to_additive (attr := simp)]
lemma Hom.map_mul {X Y : GroupCat} (f : X ⟶ Y) (x y : X) : f (x * y) = f x * f y := by
  apply MonoidHom.map_mul (show MonoidHom X Y from f)

-- porting note: added to ease automation
@[to_additive (attr := simp)]
lemma Hom.map_one {X Y : GroupCat} (f : X ⟶ Y) : f (1 : X) = 1 := by
  apply MonoidHom.map_one (show MonoidHom X Y from f)

end GroupCat

/-- The category of commutative groups and group morphisms. -/
@[to_additive]
def CommGroupCat : Type (u + 1) :=
  Bundled CommGroup
set_option linter.uppercaseLean3 false in
#align CommGroup CommGroupCat
set_option linter.uppercaseLean3 false in
#align AddCommGroup AddCommGroupCat

/-- The category of additive commutative groups and group morphisms. -/
add_decl_doc AddCommGroupCat

/-- `Ab` is an abbreviation for `AddCommGroup`, for the sake of mathematicians' sanity. -/
abbrev Ab :=
  AddCommGroupCat
set_option linter.uppercaseLean3 false in
#align Ab Ab

namespace CommGroupCat

@[to_additive]
instance : BundledHom.ParentProjection @CommGroup.toGroup :=
  ⟨⟩

instance largeCategory : LargeCategory CommGroupCat := by
  dsimp only [CommGroupCat]
  infer_instance

instance concreteCategory : ConcreteCategory CommGroupCat := by
  dsimp only [CommGroupCat]
  infer_instance

attribute [to_additive] CommGroupCat.largeCategory CommGroupCat.concreteCategory

@[to_additive]
instance : CoeSort CommGroupCat (Type _) := by
  dsimp only [CommGroupCat]
  infer_instance

/-- Construct a bundled `CommGroup` from the underlying type and typeclass. -/
@[to_additive]
def of (G : Type u) [CommGroup G] : CommGroupCat :=
  Bundled.of G
set_option linter.uppercaseLean3 false in
#align CommGroup.of CommGroupCat.of
set_option linter.uppercaseLean3 false in
#align AddCommGroup.of AddCommGroupCat.of

/-- Construct a bundled `AddCommGroup` from the underlying type and typeclass. -/
add_decl_doc AddCommGroupCat.of

/-- Typecheck a `MonoidHom` as a morphism in `CommGroup`. -/
@[to_additive]
def ofHom {X Y : Type u} [CommGroup X] [CommGroup Y] (f : X →* Y) : of X ⟶ of Y :=
  f
set_option linter.uppercaseLean3 false in
#align CommGroup.of_hom CommGroupCat.ofHom
set_option linter.uppercaseLean3 false in
#align AddCommGroup.of_hom AddCommGroupCat.ofHom

/-- Typecheck a `AddMonoidHom` as a morphism in `AddCommGroup`. -/
add_decl_doc AddCommGroupCat.ofHom

-- porting note: this instance was not necessary in mathlib
@[to_additive]
instance {X Y : CommGroupCat} : CoeFun (X ⟶ Y) fun _ => X → Y :=
  ConcreteCategory.hasCoeToFun

-- porting note: added to ease automation
@[to_additive (attr := simp)]
lemma id_apply {X : CommGroupCat} (x : X) :
  (𝟙 X) x = x := rfl

-- porting note: added to ease automation
@[to_additive (attr := simp)]
lemma comp_apply {X Y Z : CommGroupCat} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g) x = g (f x) := by apply CategoryTheory.comp_apply

@[to_additive (attr := simp)]
theorem ofHom_apply {X Y : Type _} [CommGroup X] [CommGroup Y] (f : X →* Y) (x : X) :
    (ofHom f) x = f x :=
  rfl
set_option linter.uppercaseLean3 false in
#align CommGroup.of_hom_apply CommGroupCat.ofHom_apply
set_option linter.uppercaseLean3 false in
#align AddCommGroup.of_hom_apply AddCommGroupCat.ofHom_apply

@[to_additive]
instance commGroupInstance (G : CommGroupCat) : CommGroup G :=
  G.str
set_option linter.uppercaseLean3 false in
#align CommGroup.comm_group_instance CommGroupCat.commGroupInstance
set_option linter.uppercaseLean3 false in
#align AddCommGroup.add_comm_group_instance AddCommGroupCat.addCommGroupInstance

-- porting note: simp attribute was removed to please the linter
@[to_additive]
theorem coe_of (R : Type u) [CommGroup R] : (CommGroupCat.of R : Type u) = R :=
  rfl
set_option linter.uppercaseLean3 false in
#align CommGroup.coe_of CommGroupCat.coe_of
set_option linter.uppercaseLean3 false in
#align AddCommGroup.coe_of AddCommGroupCat.coe_of

@[to_additive]
instance : Inhabited CommGroupCat :=
  ⟨CommGroupCat.of PUnit⟩

@[to_additive]
instance ofUnique (G : Type _) [CommGroup G] [i : Unique G] : Unique (CommGroupCat.of G) :=
  i
set_option linter.uppercaseLean3 false in
#align CommGroup.of_unique CommGroupCat.ofUnique
set_option linter.uppercaseLean3 false in
#align AddCommGroup.of_unique AddCommGroupCat.ofUnique

-- porting note: this instance was not necessary in mathlib
@[to_additive]
instance (G H : CommGroupCat) : One (G ⟶ H) := (inferInstance : One (MonoidHom G H))

@[to_additive (attr := simp)]
theorem one_apply (G H : CommGroupCat) (g : G) : (1 : G ⟶ H) g = 1 :=
  rfl
set_option linter.uppercaseLean3 false in
#align CommGroup.one_apply CommGroupCat.one_apply
set_option linter.uppercaseLean3 false in
#align AddCommGroup.zero_apply AddCommGroupCat.zero_apply

@[to_additive (attr := ext)]
theorem ext (G H : CommGroupCat) (f₁ f₂ : G ⟶ H) (w : ∀ x, f₁ x = f₂ x) : f₁ = f₂ :=
  ConcreteCategory.hom_ext _ _ w
set_option linter.uppercaseLean3 false in
#align CommGroup.ext CommGroupCat.ext
set_option linter.uppercaseLean3 false in
#align AddCommGroup.ext AddCommGroupCat.ext

@[to_additive]
instance hasForgetToGroup : HasForget₂ CommGroupCat GroupCat :=
  BundledHom.forget₂ _ _
set_option linter.uppercaseLean3 false in
#align CommGroup.has_forget_to_Group CommGroupCat.hasForgetToGroup
set_option linter.uppercaseLean3 false in
#align AddCommGroup.has_forget_to_AddGroup AddCommGroupCat.hasForgetToAddGroup

@[to_additive]
instance : Coe CommGroupCat.{u} GroupCat.{u} where coe := (forget₂ CommGroupCat GroupCat).obj

@[to_additive hasForgetToAddCommMonCat]
instance hasForgetToCommMonCat : HasForget₂ CommGroupCat CommMonCat :=
  InducedCategory.hasForget₂ fun G : CommGroupCat => CommMonCat.of G
set_option linter.uppercaseLean3 false in
#align CommGroup.has_forget_to_CommMon CommGroupCat.hasForgetToCommMonCat
set_option linter.uppercaseLean3 false in
#align AddCommGroup.has_forget_to_AddCommMon AddCommGroupCat.hasForgetToAddCommMonCat

@[to_additive]
instance : Coe CommGroupCat.{u} CommMonCat.{u} where coe := (forget₂ CommGroupCat CommMonCat).obj

-- porting note: this was added to ease the port
/-- the morphism in `CommGroupCat` associated to a `MonoidHom` -/
@[to_additive]
def Hom.mk {X Y : CommGroupCat} (f : X →* Y) : X ⟶ Y := f

/-- the morphism in `AddCommGroupCat` associated to a `AddMonoidHom` -/
add_decl_doc AddCommGroupCat.Hom.mk

@[to_additive (attr := simp)]
lemma Hom.mk_apply {X Y : CommGroupCat} (f : X →* Y) (x : X) :
  (Hom.mk f) x = f x := rfl

-- porting note: added to ease automation
@[to_additive (attr := simp)]
lemma Hom.map_mul {X Y : CommGroupCat} (f : X ⟶ Y) (x y : X) : f (x * y) = f x * f y := by
  apply MonoidHom.map_mul (show MonoidHom X Y from f)

-- porting note: added to ease automation
@[to_additive (attr := simp)]
lemma Hom.map_one {X Y : CommGroupCat} (f : X ⟶ Y) : f (1 : X) = 1 := by
  apply MonoidHom.map_one (show MonoidHom X Y from f)

-- This example verifies an improvement possible in Lean 3.8.
-- Before that, to have `monoid_hom.map_map` usable by `simp` here,
-- we had to mark all the concrete category `has_coe_to_sort` instances reducible.
-- Now, it just works.
@[to_additive]
example {R S : CommGroupCat} (i : R ⟶ S) (r : R) (h : r = 1) : i r = 1 := by simp [h]

end CommGroupCat

namespace AddCommGroupCat

-- Note that because `ℤ : Type 0`, this forces `G : AddCommGroup.{0}`,
-- so we write this explicitly to be clear.
-- TODO generalize this, requiring a `ulift_instances.lean` file
/-- Any element of an abelian group gives a unique morphism from `ℤ` sending
`1` to that element. -/
def asHom {G : AddCommGroupCat.{0}} (g : G) : AddCommGroupCat.of ℤ ⟶ G :=
  zmultiplesHom G g
set_option linter.uppercaseLean3 false in
#align AddCommGroup.as_hom AddCommGroupCat.asHom

@[simp]
theorem asHom_apply {G : AddCommGroupCat.{0}} (g : G) (i : ℤ) : (asHom g) i = i • g :=
  rfl
set_option linter.uppercaseLean3 false in
#align AddCommGroup.as_hom_apply AddCommGroupCat.asHom_apply

theorem asHom_injective {G : AddCommGroupCat.{0}} : Function.Injective (@asHom G) := fun h k w => by
  convert congr_arg (fun k : AddCommGroupCat.of ℤ ⟶ G => (k : ℤ → G) (1 : ℤ)) w <;> simp
set_option linter.uppercaseLean3 false in
#align AddCommGroup.as_hom_injective AddCommGroupCat.asHom_injective

@[ext]
theorem int_hom_ext {G : AddCommGroupCat.{0}} (f g : AddCommGroupCat.of ℤ ⟶ G)
    (w : f (1 : ℤ) = g (1 : ℤ)) : f = g :=
  @AddMonoidHom.ext_int G _ f g w
set_option linter.uppercaseLean3 false in
#align AddCommGroup.int_hom_ext AddCommGroupCat.int_hom_ext

-- TODO: this argument should be generalised to the situation where
-- the forgetful functor is representable.
theorem injective_of_mono {G H : AddCommGroupCat.{0}} (f : G ⟶ H) [Mono f] : Function.Injective f :=
  fun g₁ g₂ h => by
  have t0 : asHom g₁ ≫ f = asHom g₂ ≫ f := by
    apply int_hom_ext
    simpa using h
  have t1 : asHom g₁ = asHom g₂ := (cancel_mono _).1 t0
  apply asHom_injective t1
set_option linter.uppercaseLean3 false in
#align AddCommGroup.injective_of_mono AddCommGroupCat.injective_of_mono

end AddCommGroupCat

/-- Build an isomorphism in the category `GroupCat` from a `MulEquiv` between `Group`s. -/
@[to_additive (attr := simps)]
def MulEquiv.toGroupCatIso {X Y : GroupCat} (e : X ≃* Y) : X ≅ Y where
  hom := GroupCat.Hom.mk e.toMonoidHom
  inv := GroupCat.Hom.mk e.symm.toMonoidHom
set_option linter.uppercaseLean3 false in
#align mul_equiv.to_Group_iso MulEquiv.toGroupCatIso
set_option linter.uppercaseLean3 false in
#align add_equiv.to_AddGroup_iso AddEquiv.toAddGroupCatIso

/-- Build an isomorphism in the category `AddGroup` from an `AddEquiv` between `AddGroup`s. -/
add_decl_doc AddEquiv.toAddGroupCatIso

/-- Build an isomorphism in the category `CommGroupCat` from a `MulEquiv`
between `CommGroup`s. -/
@[to_additive (attr := simps)]
def MulEquiv.toCommGroupCatIso {X Y : CommGroupCat} (e : X ≃* Y) : X ≅ Y
    where
  hom := CommGroupCat.Hom.mk e.toMonoidHom
  inv := CommGroupCat.Hom.mk e.symm.toMonoidHom
set_option linter.uppercaseLean3 false in
#align mul_equiv.to_CommGroup_iso MulEquiv.toCommGroupCatIso
set_option linter.uppercaseLean3 false in
#align add_equiv.to_AddCommGroup_iso AddEquiv.toAddCommGroupCatIso

/-- Build an isomorphism in the category `AddCommGroupCat` from a `AddEquiv`
between `AddCommGroup`s. -/
add_decl_doc AddEquiv.toAddCommGroupCatIso

namespace CategoryTheory.Iso

/-- Build a `MulEquiv` from an isomorphism in the category `GroupCat`. -/
@[to_additive (attr := simp)]
def groupIsoToMulEquiv {X Y : GroupCat} (i : X ≅ Y) : X ≃* Y :=
  MonoidHom.toMulEquiv i.hom i.inv i.hom_inv_id i.inv_hom_id
set_option linter.uppercaseLean3 false in
#align category_theory.iso.Group_iso_to_mul_equiv CategoryTheory.Iso.groupIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align category_theory.iso.AddGroup_iso_to_add_equiv CategoryTheory.Iso.addGroupIsoToAddEquiv

/-- Build an `addEquiv` from an isomorphism in the category `AddGroup` -/
add_decl_doc addGroupIsoToAddEquiv

/-- Build a `MulEquiv` from an isomorphism in the category `CommGroup`. -/
@[to_additive (attr := simps!)]
def commGroupIsoToMulEquiv {X Y : CommGroupCat} (i : X ≅ Y) : X ≃* Y :=
  MonoidHom.toMulEquiv i.hom i.inv i.hom_inv_id i.inv_hom_id
set_option linter.uppercaseLean3 false in
#align category_theory.iso.CommGroup_iso_to_mul_equiv CategoryTheory.Iso.commGroupIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align category_theory.iso.AddCommGroup_iso_to_add_equiv CategoryTheory.Iso.addCommGroupIsoToAddEquiv

/-- Build an `AddEquiv` from an isomorphism\nin the category `AddCommGroup`. -/
add_decl_doc addCommGroupIsoToAddEquiv

end CategoryTheory.Iso

/-- multiplicative equivalences between `Group`s are the same as (isomorphic to) isomorphisms
in `GroupCat` -/
@[to_additive]
def mulEquivIsoGroupIso {X Y : GroupCat.{u}} : X ≃* Y ≅ X ≅ Y where
  hom e := e.toGroupCatIso
  inv i := i.groupIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align mul_equiv_iso_Group_iso mulEquivIsoGroupIso
set_option linter.uppercaseLean3 false in
#align add_equiv_iso_AddGroup_iso addEquivIsoAddGroupIso

/-- "additive equivalences between `add_group`s are the same
as (isomorphic to) isomorphisms in `AddGroup` -/
add_decl_doc addEquivIsoAddGroupIso

/-- multiplicative equivalences between `comm_group`s are the same as (isomorphic to) isomorphisms
in `CommGroup` -/
@[to_additive]
def mulEquivIsoCommGroupIso {X Y : CommGroupCat.{u}} : X ≃* Y ≅ X ≅ Y
    where
  hom e := e.toCommGroupCatIso
  inv i := i.commGroupIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align mul_equiv_iso_CommGroup_iso mulEquivIsoCommGroupIso
set_option linter.uppercaseLean3 false in
#align add_equiv_iso_AddCommGroup_iso addEquivIsoAddCommGroupIso

/-- additive equivalences between `AddCommGroup`s are
the same as (isomorphic to) isomorphisms in `AddCommGroup` -/
add_decl_doc addEquivIsoAddCommGroupIso

namespace CategoryTheory.Aut

/-- The (bundled) group of automorphisms of a type is isomorphic to the (bundled) group
of permutations. -/
def isoPerm {α : Type u} : GroupCat.of (Aut α) ≅ GroupCat.of (Equiv.Perm α) where
  hom := GroupCat.Hom.mk
    { toFun := fun g => g.toEquiv
      map_one' := by aesop
      map_mul' := by aesop }
  inv := GroupCat.Hom.mk
    { toFun := fun g => g.toIso
      map_one' := by aesop
      map_mul' := by aesop }
set_option linter.uppercaseLean3 false in
#align category_theory.Aut.iso_perm CategoryTheory.Aut.isoPerm

/-- The (unbundled) group of automorphisms of a type is `mul_equiv` to the (unbundled) group
of permutations. -/
def mulEquivPerm {α : Type u} : Aut α ≃* Equiv.Perm α :=
  isoPerm.groupIsoToMulEquiv
set_option linter.uppercaseLean3 false in
#align category_theory.Aut.mul_equiv_perm CategoryTheory.Aut.mulEquivPerm

end CategoryTheory.Aut

@[to_additive]
instance GroupCat.forget_reflects_isos : ReflectsIsomorphisms (forget GroupCat.{u}) where
  reflects {X Y} f _ := by
    let i := asIso ((forget GroupCat).map f)
    let e : X ≃* Y := MulEquiv.mk i.toEquiv (by apply GroupCat.Hom.map_mul)
    exact IsIso.of_iso e.toGroupCatIso
set_option linter.uppercaseLean3 false in
#align Group.forget_reflects_isos GroupCat.forget_reflects_isos
set_option linter.uppercaseLean3 false in
#align AddGroup.forget_reflects_isos AddGroupCat.forget_reflects_isos

@[to_additive]
instance CommGroupCat.forget_reflects_isos : ReflectsIsomorphisms (forget CommGroupCat.{u}) where
  reflects {X Y} f _ := by
    let i := asIso ((forget CommGroupCat).map f)
    let e : X ≃* Y := MulEquiv.mk i.toEquiv (by apply CommGroupCat.Hom.map_mul)
    exact IsIso.of_iso e.toCommGroupCatIso
set_option linter.uppercaseLean3 false in
#align CommGroup.forget_reflects_isos CommGroupCat.forget_reflects_isos
set_option linter.uppercaseLean3 false in
#align AddCommGroup.forget_reflects_isos AddCommGroupCat.forget_reflects_isos


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.arrow
import Mathlib.PostPort

universes v u l

namespace Mathlib

/-!
# Strong epimorphisms

In this file, we define strong epimorphisms. A strong epimorphism is an epimorphism `f`, such
that for every commutative square with `f` at the top and a monomorphism at the bottom, there is
a diagonal morphism making the two triangles commute. This lift is necessarily unique (as shown in
`comma.lean`).

## Main results

Besides the definition, we show that
* the composition of two strong epimorphisms is a strong epimorphism,
* if `f ≫ g` is a strong epimorphism, then so is `g`,
* if `f` is both a strong epimorphism and a monomorphism, then it is an isomorphism

## Future work

There is also the dual notion of strong monomorphism.

## References

* [F. Borceux, *Handbook of Categorical Algebra 1*][borceux-vol1]
-/

namespace category_theory

/-- A strong epimorphism `f` is an epimorphism such that every commutative square with `f` at the
    top and a monomorphism at the bottom has a lift. -/
class strong_epi {C : Type u} [category C] {P : C} {Q : C} (f : P ⟶ Q) where
  epi : epi f
  has_lift :
    ∀ {X Y : C} {u : P ⟶ X} {v : Q ⟶ Y} {z : X ⟶ Y} [_inst_2 : mono z] (h : u ≫ z = f ≫ v),
      arrow.has_lift (arrow.hom_mk' h)

protected instance epi_of_strong_epi {C : Type u} [category C] {P : C} {Q : C} (f : P ⟶ Q)
    [strong_epi f] : epi f :=
  strong_epi.epi

/-- The composition of two strong epimorphisms is a strong epimorphism. -/
theorem strong_epi_comp {C : Type u} [category C] {P : C} {Q : C} {R : C} (f : P ⟶ Q) (g : Q ⟶ R)
    [strong_epi f] [strong_epi g] : strong_epi (f ≫ g) :=
  sorry

/-- If `f ≫ g` is a strong epimorphism, then so is g. -/
theorem strong_epi_of_strong_epi {C : Type u} [category C] {P : C} {Q : C} {R : C} (f : P ⟶ Q)
    (g : Q ⟶ R) [strong_epi (f ≫ g)] : strong_epi g :=
  sorry

/-- An isomorphism is in particular a strong epimorphism. -/
protected instance strong_epi_of_is_iso {C : Type u} [category C] {P : C} {Q : C} (f : P ⟶ Q)
    [is_iso f] : strong_epi f :=
  sorry

/-- A strong epimorphism that is a monomorphism is an isomorphism. -/
def is_iso_of_mono_of_strong_epi {C : Type u} [category C] {P : C} {Q : C} (f : P ⟶ Q) [mono f]
    [strong_epi f] : is_iso f :=
  is_iso.mk (arrow.lift (arrow.hom_mk' sorry))

end Mathlib


/-
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.martingale.convergence
import probability.martingale.optional_stopping
import probability.martingale.centering

/-!

# Generalized Borel-Cantelli lemma

This file proves Lévy's generalized Borel-Cantelli lemma which is a generalization of the
Borel-Cantelli lemmas. With this generalization, one can easily deduce the Borel-Cantelli lemmas
by choosing appropriate filtrations. This file also contains the one sided martingale bound which
is required to prove the generalized Borel-Cantelli.

## Main results

- `measure_theory.submartingale.bdd_above_iff_exists_tendsto`: the one sided martingale bound: given
  a submartingale `f` with uniformly bounded differences, the set for which `f` converges is almost
  everywhere equal to the set for which it is bounded.
- `measure_theory.ae_mem_limsup_at_top_iff`: Lévy's generalized Borel-Cantelli:
  given a filtration `ℱ` and a sequence of sets `s` such that `s n ∈ ℱ n` for all `n`,
  `limsup at_top s` is almost everywhere equal to the set for which `∑ ℙ[s (n + 1)∣ℱ n] = ∞`.

-/

open filter
open_locale nnreal ennreal measure_theory probability_theory big_operators topology

namespace measure_theory

variables {Ω : Type*} {m0 : measurable_space Ω} {μ : measure Ω}
  {ℱ : filtration ℕ m0} {f : ℕ → Ω → ℝ} {ω : Ω}

/-!
### One sided martingale bound
-/

-- TODO: `least_ge` should be defined taking values in `with_top ℕ` once the `stopped_process`
-- refactor is complete
/-- `least_ge f r n` is the stopping time corresponding to the first time `f ≥ r`. -/
noncomputable
def least_ge (f : ℕ → Ω → ℝ) (r : ℝ) (n : ℕ) := hitting f (set.Ici r) 0 n

lemma adapted.is_stopping_time_least_ge (r : ℝ) (n : ℕ) (hf : adapted ℱ f) :
  is_stopping_time ℱ (least_ge f r n) :=
hitting_is_stopping_time hf measurable_set_Ici

lemma least_ge_le {i : ℕ} {r : ℝ} (ω : Ω) : least_ge f r i ω ≤ i :=
hitting_le ω

-- The following four lemmas shows `least_ge` behaves like a stopped process. Ideally we should
-- define `least_ge` as a stopping time and take its stopped process. However, we can't do that
-- with our current definition since a stopping time takes only finite indicies. An upcomming
-- refactor should hopefully make it possible to have stopping times taking infinity as a value
lemma least_ge_mono {n m : ℕ} (hnm : n ≤ m) (r : ℝ) (ω : Ω) :
  least_ge f r n ω ≤ least_ge f r m ω :=
hitting_mono hnm

lemma least_ge_eq_min (π : Ω → ℕ) (r : ℝ) (ω : Ω)
  {n : ℕ} (hπn : ∀ ω, π ω ≤ n) :
  least_ge f r (π ω) ω = min (π ω) (least_ge f r n ω) :=
begin
  classical,
  refine le_antisymm (le_min (least_ge_le _) (least_ge_mono (hπn ω) r ω)) _,
  by_cases hle : π ω ≤ least_ge f r n ω,
  { rw [min_eq_left hle, least_ge],
    by_cases h : ∃ j ∈ set.Icc 0 (π ω), f j ω ∈ set.Ici r,
    { refine hle.trans (eq.le _),
      rw [least_ge, ← hitting_eq_hitting_of_exists (hπn ω) h] },
    { simp only [hitting, if_neg h] } },
  { rw [min_eq_right (not_le.1 hle).le, least_ge, least_ge,
      ← hitting_eq_hitting_of_exists (hπn ω) _],
    rw [not_le, least_ge, hitting_lt_iff _ (hπn ω)] at hle,
    exact let ⟨j, hj₁, hj₂⟩ := hle in ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩ }
end

lemma stopped_value_stopped_value_least_ge (f : ℕ → Ω → ℝ) (π : Ω → ℕ) (r : ℝ)
  {n : ℕ} (hπn : ∀ ω, π ω ≤ n) :
  stopped_value (λ i, stopped_value f (least_ge f r i)) π
    = stopped_value (stopped_process f (least_ge f r n)) π :=
by { ext1 ω, simp_rw [stopped_process, stopped_value], rw least_ge_eq_min _ _ _ hπn, }

lemma submartingale.stopped_value_least_ge [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (r : ℝ) :
  submartingale (λ i, stopped_value f (least_ge f r i)) ℱ μ :=
begin
  rw submartingale_iff_expected_stopped_value_mono,
  { intros σ π hσ hπ hσ_le_π hπ_bdd,
    obtain ⟨n, hπ_le_n⟩ := hπ_bdd,
    simp_rw stopped_value_stopped_value_least_ge f σ r (λ i, (hσ_le_π i).trans (hπ_le_n i)),
    simp_rw stopped_value_stopped_value_least_ge f π r hπ_le_n,
    refine hf.expected_stopped_value_mono _ _ _ (λ ω, (min_le_left _ _).trans (hπ_le_n ω)),
    { exact hσ.min (hf.adapted.is_stopping_time_least_ge _ _), },
    { exact hπ.min (hf.adapted.is_stopping_time_least_ge _ _), },
    { exact λ ω, min_le_min (hσ_le_π ω) le_rfl, }, },
  { exact λ i, strongly_measurable_stopped_value_of_le hf.adapted.prog_measurable_of_discrete
      (hf.adapted.is_stopping_time_least_ge _ _) least_ge_le, },
  { exact λ i, integrable_stopped_value _ ((hf.adapted.is_stopping_time_least_ge _ _))
      (hf.integrable) least_ge_le, },
end

variables {r : ℝ} {R : ℝ≥0}

lemma norm_stopped_value_least_ge_le (hr : 0 ≤ r) (hf0 : f 0 = 0)
  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) (i : ℕ) :
  ∀ᵐ ω ∂μ, stopped_value f (least_ge f r i) ω ≤ r + R :=
begin
  filter_upwards [hbdd] with ω hbddω,
  change f (least_ge f r i ω) ω ≤ r + R,
  by_cases heq : least_ge f r i ω = 0,
  { rw [heq, hf0, pi.zero_apply],
    exact add_nonneg hr R.coe_nonneg },
  { obtain ⟨k, hk⟩ := nat.exists_eq_succ_of_ne_zero heq,
    rw [hk, add_comm, ← sub_le_iff_le_add],
    have := not_mem_of_lt_hitting (hk.symm ▸ k.lt_succ_self : k < least_ge f r i ω) (zero_le _),
    simp only [set.mem_union, set.mem_Iic, set.mem_Ici, not_or_distrib, not_le] at this,
    exact (sub_lt_sub_left this _).le.trans ((le_abs_self _).trans (hbddω _)) }
end

lemma submartingale.stopped_value_least_ge_snorm_le [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (hr : 0 ≤ r) (hf0 : f 0 = 0)
  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) (i : ℕ) :
  snorm (stopped_value f (least_ge f r i)) 1 μ ≤ 2 * μ set.univ * ennreal.of_real (r + R) :=
begin
  refine snorm_one_le_of_le' ((hf.stopped_value_least_ge r).integrable _) _
    (norm_stopped_value_least_ge_le hr hf0 hbdd i),
  rw ← integral_univ,
  refine le_trans _ ((hf.stopped_value_least_ge r).set_integral_le (zero_le _)
    measurable_set.univ),
  simp_rw [stopped_value, least_ge, hitting_of_le le_rfl, hf0, integral_zero']
end

lemma submartingale.stopped_value_least_ge_snorm_le' [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (hr : 0 ≤ r) (hf0 : f 0 = 0)
  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) (i : ℕ) :
  snorm (stopped_value f (least_ge f r i)) 1 μ ≤
    ennreal.to_nnreal (2 * μ set.univ * ennreal.of_real (r + R)) :=
begin
  refine (hf.stopped_value_least_ge_snorm_le hr hf0 hbdd i).trans _,
  simp [ennreal.coe_to_nnreal (measure_ne_top μ _), ennreal.coe_to_nnreal],
end

/-- This lemma is superceded by `submartingale.bdd_above_iff_exists_tendsto`. -/
lemma submartingale.exists_tendsto_of_abs_bdd_above_aux [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (hf0 : f 0 = 0)
  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
  ∀ᵐ ω ∂μ, bdd_above (set.range $ λ n, f n ω) → ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
begin
  have ht : ∀ᵐ ω ∂μ, ∀ i : ℕ, ∃ c, tendsto (λ n, stopped_value f (least_ge f i n) ω) at_top (𝓝 c),
  { rw ae_all_iff,
    exact λ i, submartingale.exists_ae_tendsto_of_bdd (hf.stopped_value_least_ge i)
      (hf.stopped_value_least_ge_snorm_le' i.cast_nonneg hf0 hbdd) },
  filter_upwards [ht] with ω hω hωb,
  rw bdd_above at hωb,
  obtain ⟨i, hi⟩ := exists_nat_gt hωb.some,
  have hib : ∀ n, f n ω < i,
  { intro n,
    exact lt_of_le_of_lt ((mem_upper_bounds.1 hωb.some_mem) _ ⟨n, rfl⟩) hi },
  have heq : ∀ n, stopped_value f (least_ge f i n) ω = f n ω,
  { intro n,
    rw [least_ge, hitting, stopped_value],
    simp only,
    rw if_neg,
    simp only [set.mem_Icc, set.mem_union, set.mem_Ici],
    push_neg,
    exact λ j _, hib j },
  simp only [← heq, hω i],
end

lemma submartingale.bdd_above_iff_exists_tendsto_aux [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (hf0 : f 0 = 0)
  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
  ∀ᵐ ω ∂μ, bdd_above (set.range $ λ n, f n ω) ↔ ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
by filter_upwards [hf.exists_tendsto_of_abs_bdd_above_aux hf0 hbdd] with ω hω using
  ⟨hω, λ ⟨c, hc⟩, hc.bdd_above_range⟩

/-- One sided martingale bound: If `f` is a submartingale which has uniformly bounded differences,
then for almost every `ω`, `f n ω` is bounded above (in `n`) if and only if it converges. -/
lemma submartingale.bdd_above_iff_exists_tendsto [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
  ∀ᵐ ω ∂μ, bdd_above (set.range $ λ n, f n ω) ↔ ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
begin
  set g : ℕ → Ω → ℝ := λ n ω, f n ω - f 0 ω with hgdef,
  have hg : submartingale g ℱ μ :=
    hf.sub_martingale (martingale_const_fun _ _ (hf.adapted 0) (hf.integrable 0)),
  have hg0 : g 0 = 0,
  { ext ω,
    simp only [hgdef, sub_self, pi.zero_apply] },
  have hgbdd : ∀ᵐ ω ∂μ, ∀ (i : ℕ), |g (i + 1) ω - g i ω| ≤ ↑R,
  { simpa only [sub_sub_sub_cancel_right] },
  filter_upwards [hg.bdd_above_iff_exists_tendsto_aux hg0 hgbdd] with ω hω,
  convert hω using 1; rw eq_iff_iff,
  { simp only [hgdef],
    refine ⟨λ h, _, λ h, _⟩;
    obtain ⟨b, hb⟩ := h;
    refine ⟨b + |f 0 ω|, λ y hy, _⟩;
    obtain ⟨n, rfl⟩ := hy,
    { simp_rw [sub_eq_add_neg],
      exact add_le_add (hb ⟨n, rfl⟩) (neg_le_abs_self _) },
    { exact sub_le_iff_le_add.1 (le_trans (sub_le_sub_left (le_abs_self _) _) (hb ⟨n, rfl⟩)) } },
  { simp only [hgdef],
    refine ⟨λ h, _, λ h, _⟩;
    obtain ⟨c, hc⟩ := h,
    { exact ⟨c - f 0 ω, hc.sub_const _⟩ },
    { refine ⟨c + f 0 ω, _⟩,
      have := hc.add_const (f 0 ω),
      simpa only [sub_add_cancel] } }
end

/-!
### Lévy's generalization of the Borel-Cantelli lemma

Lévy's generalization of the Borel-Cantelli lemma states that: given a natural number indexed
filtration $(\mathcal{F}_n)$, and a sequence of sets $(s_n)$ such that for all
$n$, $s_n \in \mathcal{F}_n$, $limsup_n s_n$ is almost everywhere equal to the set for which
$\sum_n \mathbb{P}[s_n \mid \mathcal{F}_n] = \infty$.

The proof strategy follows by constructing a martingale satisfying the one sided martingale bound.
In particular, we define
$$
  f_n := \sum_{k < n} \mathbf{1}_{s_{n + 1}} - \mathbb{P}[s_{n + 1} \mid \mathcal{F}_n].
$$
Then, as a martingale is both a sub and a super-martingale, the set for which it is unbounded from
above must agree with the set for which it is unbounded from below almost everywhere. Thus, it
can only converge to $\pm \infty$ with probability 0. Thus, by considering
$$
  \limsup_n s_n = \{\sum_n \mathbf{1}_{s_n} = \infty\}
$$
almost everywhere, the result follows.
-/

lemma martingale.bdd_above_range_iff_bdd_below_range [is_finite_measure μ]
  (hf : martingale f ℱ μ) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
  ∀ᵐ ω ∂μ, bdd_above (set.range (λ n, f n ω)) ↔ bdd_below (set.range (λ n, f n ω)) :=
begin
  have hbdd' : ∀ᵐ ω ∂μ, ∀ i, |(-f) (i + 1) ω - (-f) i ω| ≤ R,
  { filter_upwards [hbdd] with ω hω i,
    erw [← abs_neg, neg_sub, sub_neg_eq_add, neg_add_eq_sub],
    exact hω i },
  have hup := hf.submartingale.bdd_above_iff_exists_tendsto hbdd,
  have hdown := hf.neg.submartingale.bdd_above_iff_exists_tendsto hbdd',
  filter_upwards [hup, hdown] with ω hω₁ hω₂,
  have : (∃ c, tendsto (λ n, f n ω) at_top (𝓝 c)) ↔ ∃ c, tendsto (λ n, (-f) n ω) at_top (𝓝 c),
  { split; rintro ⟨c, hc⟩,
    { exact ⟨-c, hc.neg⟩ },
    { refine ⟨-c, _⟩,
      convert hc.neg,
      simp only [neg_neg, pi.neg_apply] } },
  rw [hω₁, this, ← hω₂],
  split; rintro ⟨c, hc⟩; refine ⟨-c, λ ω hω, _⟩,
  { rw mem_upper_bounds at hc,
    refine neg_le.2 (hc _ _),
    simpa only [pi.neg_apply, set.mem_range, neg_inj] },
  { rw mem_lower_bounds at hc,
    simp_rw [set.mem_range, pi.neg_apply, neg_eq_iff_eq_neg] at hω,
    refine le_neg.1 (hc _ _),
    simpa only [set.mem_range] }
end

lemma martingale.ae_not_tendsto_at_top_at_bot [is_finite_measure μ]
  (hf : martingale f ℱ μ) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
  ∀ᵐ ω ∂μ, ¬ tendsto (λ n, f n ω) at_top at_bot :=
by filter_upwards [hf.bdd_above_range_iff_bdd_below_range hbdd] with ω hω htop using
    unbounded_of_tendsto_at_bot htop (hω.1 $ bdd_above_range_of_tendsto_at_top_at_bot htop)

namespace borel_cantelli

/-- Auxiliary definition required to prove Lévy's generalization of the Borel-Cantelli lemmas for
which we will take the martingale part. -/
noncomputable
def process (s : ℕ → set Ω) (n : ℕ) : Ω → ℝ :=
∑ k in finset.range n, (s (k + 1)).indicator 1

variables {s : ℕ → set Ω}

lemma process_zero : process s 0 = 0 :=
by rw [process, finset.range_zero, finset.sum_empty]

lemma adapted_process (hs : ∀ n, measurable_set[ℱ n] (s n)) :
  adapted ℱ (process s) :=
λ n, finset.strongly_measurable_sum' _ $ λ k hk, strongly_measurable_one.indicator $
  ℱ.mono (finset.mem_range.1 hk) _ $ hs _

lemma martingale_part_process_ae_eq (ℱ : filtration ℕ m0) (μ : measure Ω) (s : ℕ → set Ω) (n : ℕ) :
  martingale_part (process s) ℱ μ n =
  ∑ k in finset.range n, ((s (k + 1)).indicator 1 - μ[(s (k + 1)).indicator 1 | ℱ k]) :=
begin
  simp only [martingale_part_eq_sum, process_zero, zero_add],
  refine finset.sum_congr rfl (λ k hk, _),
  simp only [process, finset.sum_range_succ_sub_sum],
end

lemma predictable_part_process_ae_eq (ℱ : filtration ℕ m0) (μ : measure Ω) (s : ℕ → set Ω) (n : ℕ) :
  predictable_part (process s) ℱ μ n =
  ∑ k in finset.range n, μ[(s (k + 1)).indicator (1 : Ω → ℝ) | ℱ k] :=
begin
  have := martingale_part_process_ae_eq ℱ μ s n,
  simp_rw [martingale_part, process, finset.sum_sub_distrib] at this,
  exact sub_right_injective this,
end

lemma process_difference_le (s : ℕ → set Ω) (ω : Ω) (n : ℕ) :
  |process s (n + 1) ω - process s n ω| ≤ (1 : ℝ≥0) :=
begin
  rw [nonneg.coe_one, process, process, finset.sum_apply, finset.sum_apply,
    finset.sum_range_succ_sub_sum, ← real.norm_eq_abs, norm_indicator_eq_indicator_norm],
  refine set.indicator_le' (λ _ _, _) (λ _ _, zero_le_one) _,
  rw [pi.one_apply, norm_one]
end

lemma integrable_process (μ : measure Ω) [is_finite_measure μ]
  (hs : ∀ n, measurable_set[ℱ n] (s n)) (n : ℕ) :
  integrable (process s n) μ :=
integrable_finset_sum' _ $ λ k hk,
  integrable_on.integrable_indicator (integrable_const 1) $ ℱ.le _ _ $ hs _

end borel_cantelli

open borel_cantelli

/-- An a.e. monotone adapted process `f` with uniformly bounded differences converges to `+∞` if
and only if its predictable part also converges to `+∞`. -/
lemma tendsto_sum_indicator_at_top_iff [is_finite_measure μ]
  (hfmono : ∀ᵐ ω ∂μ, ∀ n, f n ω ≤ f (n + 1) ω)
  (hf : adapted ℱ f) (hint : ∀ n, integrable (f n) μ)
  (hbdd : ∀ᵐ ω ∂μ, ∀ n, |f (n + 1) ω - f n ω| ≤ R) :
  ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top at_top ↔
    tendsto (λ n, predictable_part f ℱ μ n ω) at_top at_top :=
begin
  have h₁ := (martingale_martingale_part hf hint).ae_not_tendsto_at_top_at_top
    (martingale_part_bdd_difference ℱ hbdd),
  have h₂ := (martingale_martingale_part hf hint).ae_not_tendsto_at_top_at_bot
    (martingale_part_bdd_difference ℱ hbdd),
  have h₃ : ∀ᵐ ω ∂μ, ∀ n, 0 ≤ μ[f (n + 1) - f n | ℱ n] ω,
  { refine ae_all_iff.2 (λ n, condexp_nonneg _),
    filter_upwards [ae_all_iff.1 hfmono n] with ω hω using sub_nonneg.2 hω },
  filter_upwards [h₁, h₂, h₃, hfmono] with ω hω₁ hω₂ hω₃ hω₄,
  split; intro ht,
  { refine tendsto_at_top_at_top_of_monotone' _ _,
    { intros n m hnm,
      simp only [predictable_part, finset.sum_apply],
      refine finset.sum_mono_set_of_nonneg hω₃ (finset.range_mono hnm) },
    rintro ⟨b, hbdd⟩,
    rw ← tendsto_neg_at_bot_iff at ht,
    simp only [martingale_part, sub_eq_add_neg] at hω₁,
    exact hω₁ (tendsto_at_top_add_right_of_le _ (-b)
      (tendsto_neg_at_bot_iff.1 ht) $ λ n, neg_le_neg (hbdd ⟨n, rfl⟩)) },
  { refine tendsto_at_top_at_top_of_monotone' (monotone_nat_of_le_succ hω₄) _,
    rintro ⟨b, hbdd⟩,
    exact hω₂ (tendsto_at_bot_add_left_of_ge _ b (λ n, hbdd ⟨n, rfl⟩) $
      tendsto_neg_at_bot_iff.2 ht) },
end

open borel_cantelli

lemma tendsto_sum_indicator_at_top_iff' [is_finite_measure μ]
  {s : ℕ → set Ω} (hs : ∀ n, measurable_set[ℱ n] (s n)) :
  ∀ᵐ ω ∂μ,
    tendsto (λ n, ∑ k in finset.range n, (s (k + 1)).indicator (1 : Ω → ℝ) ω) at_top at_top ↔
    tendsto (λ n, ∑ k in finset.range n, μ[(s (k + 1)).indicator (1 : Ω → ℝ) | ℱ k] ω)
      at_top at_top :=
begin
  have := tendsto_sum_indicator_at_top_iff (eventually_of_forall $ λ ω n, _) (adapted_process hs)
    (integrable_process μ hs) (eventually_of_forall $ process_difference_le s),
  swap,
  { rw [process, process, ← sub_nonneg, finset.sum_apply, finset.sum_apply,
      finset.sum_range_succ_sub_sum],
    exact set.indicator_nonneg (λ _ _, zero_le_one) _ },
  simp_rw [process, predictable_part_process_ae_eq] at this,
  simpa using this,
end

/-- **Lévy's generalization of the Borel-Cantelli lemma**: given a sequence of sets `s` and a
filtration `ℱ` such that for all `n`, `s n` is `ℱ n`-measurable, `at_top.limsup s` is almost
everywhere equal to the set for which `∑ k, ℙ(s (k + 1) | ℱ k) = ∞`. -/
theorem ae_mem_limsup_at_top_iff (μ : measure Ω) [is_finite_measure μ]
  {s : ℕ → set Ω} (hs : ∀ n, measurable_set[ℱ n] (s n)) :
  ∀ᵐ ω ∂μ, ω ∈ limsup s at_top ↔
    tendsto (λ n, ∑ k in finset.range n, μ[(s (k + 1)).indicator (1 : Ω → ℝ) | ℱ k] ω)
      at_top at_top :=
(limsup_eq_tendsto_sum_indicator_at_top ℝ s).symm ▸ tendsto_sum_indicator_at_top_iff' hs

end measure_theory


/- An implementation of key-value maps
   using functions

  Includes a dependent map, allowing for mappings into multiple types,
  as well as a non-dependent map, with only a single value tyep
-/

universes u v w

namespace option

structure has_value {V : Type u} (x : option V) :=
  (value : V)
  (value_ok : x = some value)

def check_has_value {V : Type u} (x : option V) : option (has_value x) :=
begin
destruct x; intros,
{ exact none },
{ apply some, constructor, assumption }
end

end option

/--
The type of Dependent maps. Takes a total mapping from keys to type and
represents a partial mapping from keys of type K to values of type defined by V
-/
def mapd {K : Type u} (V : K → Type v) : Type (max u v)
  := ∀ k, option (V k)

/--
A non-dependent map type with a single value type.
-/
@[reducible]
def map (K : Type u) (V : Type v) : Type (max u v)
   := mapd (λ _ : K, V)

namespace mapd

section
/- We parameterize the key type and require decidable equality on it -/
parameter {K : Type u}
parameter [decidable_eq K]
parameter {V : K → Type v}

/-- An empty map, all lookups return none-/
def empty : mapd V := fun _, none

/-- Function to make finds explicit.-/
def find (k : K) (m : mapd V) : option (V k) := m k

/-- All empty lookups are none -/
lemma empty_char (k : K) : find k empty = none := rfl

/-- Put an item into the map, shadowing any previous definitions-/
def insert (k : K) (v : V k) (m : mapd V) : mapd V :=
  λ k' : K, if H : k = k'
       then some (eq.rec_on H v)
       else find k' m

/--
Relationship between find and insert
-/
lemma insert_char (k : K) (v : V k) (m : mapd V) (k' : K) :
  find k' (insert k v m) = if H : k = k'
       then some (eq.rec_on H v)
       else find k' m
:= rfl

-- perhaps this is lazy, it should fail if not already there?
def update := insert

/-- Remove a mapping -/
def remove (k : K) (m : mapd V) : mapd V :=
  λ k' : K, if H : k = k'
       then none
       else m k'

/-- Relationship between remove and find-/
lemma remove_char (k : K) (m : mapd V) (k' : K) :
     find k' (remove k m) = if H : k = k'
       then none
       else find k' m
:= rfl

/-- Extensionality for maps-/
lemma eq_rel (m m' : mapd V) (H : ∀ k, find k m = find k m') : m = m'
:= funext H

/-- Map over all values contained in the map-/
def fmapd {V' : K → Type w} (f : ∀ k : K, V k → V' k) (m : mapd V) : mapd V'
:= λ k, option.map (f k) (find k m)
end

/--
Interaction between fmapd and find
-/
lemma fmapd_char {K : Type u} [decidable_eq K] {V : K → Type v}
  {V' : K → Type w} (f : ∀ k : K, V k → V' k) (m : mapd V)
  (k : K) : find k (fmapd f m) = option.map (f k) (find k m)
  := rfl

/-- Map over non-dependent maps-/
def fmap {K : Type u} [decidable_eq K] {V : Type v}
  {V' : Type w} (f : V → V') (m : map K V) : map K V'
:= λ k, option.map f (find k m)

/--
Interaction between fmap and find
-/
lemma fmap_char {K : Type u} [decidable_eq K] {V : Type v}
  {V' : Type w} (f : V → V') (m : map K V)
  (k : K) : find k (fmap f m) = option.map f (find k m)
  := rfl

attribute [irreducible] mapd
attribute [irreducible] find
attribute [irreducible] insert
attribute [irreducible] remove

section
parameter {K : Type u}
parameter [decidable_eq K]
parameter {V : K → Type v}

/--
Update the value already contained at key k by function f.
Has no effect if there is no existing mapping for k
-/
def updatef (k : K) (f : V k → V k) (m : mapd V) : mapd V
  :=
  match find k m with
  | none := m
  | some v := insert k (f v) m
  end

/-- Definition of functions over maps that can be reordered, assuming they
     are about distinct keys
-/
def permutable (f : ∀ k : K, V k → mapd V → mapd V) :=
  ∀ (m : mapd V) (k k' : K) (v : V k) (v' : V k'),
     k ≠ k' → f k v (f k' v' m) = f k' v' (f k v m)

lemma neq_symm {A : Type u} {x y : A}
  (H : x ≠ y) : y ≠ x
:= begin
intros contra,
apply H, symmetry, assumption
end

/-- We can reorder inserts over distinct keys -/
lemma insert_permutable : permutable insert
:= begin
unfold permutable, intros m k k' v v' Hne,
apply eq_rel,
intros z,
repeat {rw insert_char},
apply (if Hkz : k = z then _ else _),
{ rw (dif_pos Hkz),
  subst z,
  rw (dif_neg (neq_symm Hne)),
  rw (dif_pos (eq.refl k)) },
{ repeat {rw (dif_neg Hkz)},
}
end

/--
Relationship between find and insert with the same key
-/
lemma find_insert_refl (m : mapd V)
  (k : K) (v : V k) : find k (insert k v m) = some v
:= begin
rw insert_char,
rw (dif_pos (eq.refl k))
end

lemma find_insert_neq {m : mapd V}
  {k k' : K} (H : k ≠ k') (v : V k) : find k' (insert k v m) = find k' m
:= begin
rw insert_char,
rw (dif_neg H)
end

/--
A membership structure to allow lookups that
come with a proof of membership
-/
structure member (m : mapd V) :=
  (key : K)
  (value : V key)
  (in_map : find key m = some value)

inductive is_member (k : K) (m : mapd V) : Prop
  | mk : ∀ value : V k, find k m = some value → is_member

def has_value_to_member {m : mapd V} {k : K} (x : (find k m).has_value)
  : member m
:= { key := k, value := x.value, in_map := x.value_ok  }

/--
Get the member, if there is a member at k
-/
def check_member (m : mapd V) (k : K) : option (member m) :=
  option.map has_value_to_member (find k m).check_has_value

def check_member_same_key {m : mapd V} {k : K} {v : m.member}
(H : check_member m k = some v)
  : v.key = k :=
begin
dsimp [check_member] at H,
destruct ((find k m).check_has_value); intros,
{ rw a at H, contradiction },
{ rw a_1 at H,
  simp [option.map, option.bind, function.comp] at H,
  injection H with H', clear H,
  subst v, simp [has_value_to_member], }
end

lemma member_eq_value {m : mapd V} {k : K} {v v' : V k}
  (H : v = v')
  {in1 : find k m = some v} {in2 : find k m = some v'}
  : member.mk k v in1 = member.mk k v' in2 :=
begin
induction H,
trivial
end

lemma check_member_same {m : mapd V} {x x' : m.member}
  (H : check_member m (x.key) = some x')
  : x = x'
:= begin
dsimp [check_member] at H,
destruct ((find x.key m).check_has_value); intros,
{ rw a at H, contradiction },
{ rw a_1 at H,
  simp [option.map, option.bind, function.comp] at H,
  injection H with H', clear H, subst x',
  simp [has_value_to_member],
  have H2 := a.value_ok,
  have H3 := x.in_map, rw H2 at H3, clear H2,
  injection H3 with H, clear H3,
  induction x, dsimp, dsimp at H,
  apply member_eq_value, symmetry, assumption }
end

def mfind (k : K) (m : mapd V) (mem : is_member k m) : V k
:= begin
destruct (find k m); intros,
{ exfalso, induction mem,
  rw a at a_1,
  contradiction },
{ assumption }
end

instance member_decidable (m : mapd V)
  : decidable_eq (member m)
:= begin
unfold decidable_eq, unfold decidable_rel,
intros k k', cases k with k v kv,
cases k' with k' v' kv',
apply (if H : k = k' then _ else _),
{ apply decidable.is_true,
  induction H,
  rw kv at kv',
  injection kv' with h,
  induction h,
  apply congr_arg, apply proof_irrel,
},
{ apply decidable.is_false,
  intros contra, injection contra, contradiction }
end

end

namespace is_member
def value {K : Type u} [decidable_eq K] {V : K → Type v}
   {k : K} {m : mapd V} (H : is_member k m)
   : V k :=
   begin
   destruct (mapd.find k m); intros,
   { exfalso, destruct H; intros,
    rw a at a_1, contradiction
   },
   { assumption }
   end

lemma update {K : Type u} [decidable_eq K] {V : K → Type v}
  {k : K} {m : mapd V} (H : is_member k m)
  (k' : K) (v' : V k')
  : is_member k (update k' v' m)
:= begin
induction H,
unfold update,
apply (if H : k' = k then _ else _),
{ induction H,
  existsi v', rw find_insert_refl },
{ apply (is_member.mk value),
  rw insert_char,
  rw (dif_neg H), assumption
}
end

end is_member

def member_unfmap {K : Type u}
  [decidable_eq K]
  {V : K → Type v}
  {V' : K → Type w} {f : ∀ k : K, V k → V' k}
  (m : mapd V)
  (x : member (fmapd f m)) : member m
  :=
begin
cases x,
destruct (find key m); intros,
{ unfold fmapd at in_map,
  unfold find at in_map, unfold find at a,
  unfold option.map at in_map,
  rw a at in_map,
  simp [option.bind] at in_map,
  contradiction },
{ constructor, assumption }
end

def member_fmap {K : Type u}
  [decidable_eq K]
  {V : K → Type v}
  {V' : K → Type w}
  (m : mapd V)
  (x : member m)
  (f : ∀ k : K, V k → V' k) : member (fmapd f m)
  :=
begin
constructor, rw fmapd_char,
rw x.in_map, simp [option.map],
simp [option.bind],
end

def depv {K : Type u} [decidable_eq K] {V : Type v}
  (m : map K V) (B : V → Type w)
  := ∀ x : m.member, B x.value

namespace depv
section
parameters {K : Type u} [decidable_eq K] {V : Type v}
           {B : V → Type w}

def lookup_empty : depv (empty : map K V) B :=
begin
intros x, cases x, rw empty_char at in_map,
contradiction
end

inductive liftProp (P : Prop) : Type
  | mk : P → liftProp

@[reducible]
def insert_member_invert {m : map K V}
  {k : K} {v : V}
  (x : (insert k v m).member)
  : (liftProp (k = x.key)) ⊕
  ((find x.key m).has_value × liftProp (¬ k = x.key))
:= begin
apply (if H : k = x.key then _ else _),
{ apply sum.inl, constructor, assumption },
{ apply sum.inr,
  constructor, constructor,
  have H' := x.in_map,
  rw insert_char at H',
  rw (dif_neg H) at H', assumption,
  constructor, assumption
}
end

def lookup_insert {m : map K V}
  (k : K) (v : V) (b : B v) (f : depv m B)
  : depv (insert k v m) B
:= begin
intros x,
have H := insert_member_invert x,
induction H with H H,
{ induction H with H,
  induction x,
  dsimp, dsimp at H, induction H,
  rw mapd.insert_char at in_map,
  rw (dif_pos (eq.refl k)) at in_map,
  injection in_map with h, clear in_map,
  subst h, apply b,
},
{ induction H with H H1,
  induction H1 with H1,
  induction x,
  let H' := member.mk key H.value H.value_ok,
  dsimp, dsimp at H, dsimp at H1,
  rw (find_insert_neq H1) at in_map,
  rename in_map in_map',
  have H' := H.value_ok,
  rw H' at in_map',
  injection in_map' with H2,
  clear H1 H' in_map', subst value,
  apply (f H'),
 }
end

end
end depv

end mapd


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.indicator_function
import Mathlib.analysis.normed_space.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Indicator function and norm

This file contains a few simple lemmas about `set.indicator` and `norm`.

## Tags
indicator, norm
-/

theorem norm_indicator_eq_indicator_norm {α : Type u_1} {E : Type u_2} [normed_group E] {s : set α}
    (f : α → E) (a : α) :
    norm (set.indicator s f a) = set.indicator s (fun (a : α) => norm (f a)) a :=
  flip congr_fun a (Eq.symm (set.indicator_comp_of_zero norm_zero))

theorem nnnorm_indicator_eq_indicator_nnnorm {α : Type u_1} {E : Type u_2} [normed_group E]
    {s : set α} (f : α → E) (a : α) :
    nnnorm (set.indicator s f a) = set.indicator s (fun (a : α) => nnnorm (f a)) a :=
  flip congr_fun a (Eq.symm (set.indicator_comp_of_zero nnnorm_zero))

theorem norm_indicator_le_of_subset {α : Type u_1} {E : Type u_2} [normed_group E] {s : set α}
    {t : set α} (h : s ⊆ t) (f : α → E) (a : α) :
    norm (set.indicator s f a) ≤ norm (set.indicator t f a) :=
  sorry

theorem indicator_norm_le_norm_self {α : Type u_1} {E : Type u_2} [normed_group E] {s : set α}
    (f : α → E) (a : α) : set.indicator s (fun (a : α) => norm (f a)) a ≤ norm (f a) :=
  set.indicator_le_self' (fun (_x : α) (_x : ¬_x ∈ s) => norm_nonneg (f a)) a

theorem norm_indicator_le_norm_self {α : Type u_1} {E : Type u_2} [normed_group E] {s : set α}
    (f : α → E) (a : α) : norm (set.indicator s f a) ≤ norm (f a) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (norm (set.indicator s f a) ≤ norm (f a)))
        (norm_indicator_eq_indicator_norm f a)))
    (indicator_norm_le_norm_self (fun (a : α) => f a) a)

end Mathlib


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_245
  (x : ℝ)
  (h₀ : x ≠ 0) :
  (4 / x)⁻¹ * ((3 * x^3) / x)^2 * ((1 / (2 * x))⁻¹)^3 = 18 * x^8 :=
begin
  field_simp [h₀]; ring,
end