/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne, Kexing Ying

! This file was ported from Lean 3 source module probability.martingale.basic
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Notation
import Mathbin.Probability.Process.Stopping

/-!
# Martingales

A family of functions `f : ι → Ω → E` is a martingale with respect to a filtration `ℱ` if every
`f i` is integrable, `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
`μ[f j | ℱ i] =ᵐ[μ] f i`. On the other hand, `f : ι → Ω → E` is said to be a supermartingale
with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with resepct to `ℱ`
and for all `i ≤ j`, `μ[f j | ℱ i] ≤ᵐ[μ] f i`. Finally, `f : ι → Ω → E` is said to be a
submartingale with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with
resepct to `ℱ` and for all `i ≤ j`, `f i ≤ᵐ[μ] μ[f j | ℱ i]`.

The definitions of filtration and adapted can be found in `probability.stopping`.

### Definitions

* `measure_theory.martingale f ℱ μ`: `f` is a martingale with respect to filtration `ℱ` and
  measure `μ`.
* `measure_theory.supermartingale f ℱ μ`: `f` is a supermartingale with respect to
  filtration `ℱ` and measure `μ`.
* `measure_theory.submartingale f ℱ μ`: `f` is a submartingale with respect to filtration `ℱ` and
  measure `μ`.

### Results

* `measure_theory.martingale_condexp f ℱ μ`: the sequence `λ i, μ[f | ℱ i, ℱ.le i])` is a
  martingale with respect to `ℱ` and `μ`.

-/

open TopologicalSpace Filter

open NNReal ENNReal MeasureTheory ProbabilityTheory BigOperators

namespace MeasureTheory

variable {Ω E ι : Type _} [Preorder ι] {m0 : MeasurableSpace Ω} {μ : Measure Ω}
  [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E] {f g : ι → Ω → E} {ℱ : Filtration ι m0}

/-- A family of functions `f : ι → Ω → E` is a martingale with respect to a filtration `ℱ` if `f`
is adapted with respect to `ℱ` and for all `i ≤ j`, `μ[f j | ℱ i] =ᵐ[μ] f i`. -/
def Martingale (f : ι → Ω → E) (ℱ : Filtration ι m0)
    (μ : Measure Ω := by exact MeasureTheory.MeasureSpace.volume) : Prop :=
  Adapted ℱ f ∧ ∀ i j, i ≤ j → μ[f j|ℱ i] =ᵐ[μ] f i
#align measure_theory.martingale MeasureTheory.Martingale

/-- A family of integrable functions `f : ι → Ω → E` is a supermartingale with respect to a
filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
`μ[f j | ℱ.le i] ≤ᵐ[μ] f i`. -/
def Supermartingale [LE E] (f : ι → Ω → E) (ℱ : Filtration ι m0)
    (μ : Measure Ω := by exact MeasureTheory.MeasureSpace.volume) : Prop :=
  Adapted ℱ f ∧ (∀ i j, i ≤ j → μ[f j|ℱ i] ≤ᵐ[μ] f i) ∧ ∀ i, Integrable (f i) μ
#align measure_theory.supermartingale MeasureTheory.Supermartingale

/-- A family of integrable functions `f : ι → Ω → E` is a submartingale with respect to a
filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
`f i ≤ᵐ[μ] μ[f j | ℱ.le i]`. -/
def Submartingale [LE E] (f : ι → Ω → E) (ℱ : Filtration ι m0)
    (μ : Measure Ω := by exact MeasureTheory.MeasureSpace.volume) : Prop :=
  Adapted ℱ f ∧ (∀ i j, i ≤ j → f i ≤ᵐ[μ] μ[f j|ℱ i]) ∧ ∀ i, Integrable (f i) μ
#align measure_theory.submartingale MeasureTheory.Submartingale

theorem martingaleConst (ℱ : Filtration ι m0) (μ : Measure Ω) [IsFiniteMeasure μ] (x : E) :
    Martingale (fun _ _ => x) ℱ μ :=
  ⟨adapted_const ℱ _, fun i j hij => by rw [condexp_const (ℱ.le _)]⟩
#align measure_theory.martingale_const MeasureTheory.martingaleConst

theorem martingaleConstFun [OrderBot ι] (ℱ : Filtration ι m0) (μ : Measure Ω) [IsFiniteMeasure μ]
    {f : Ω → E} (hf : strongly_measurable[ℱ ⊥] f) (hfint : Integrable f μ) :
    Martingale (fun _ => f) ℱ μ :=
  by
  refine' ⟨fun i => hf.mono <| ℱ.mono bot_le, fun i j hij => _⟩
  rw [condexp_of_strongly_measurable (ℱ.le _) (hf.mono <| ℱ.mono bot_le) hfint]
  infer_instance
#align measure_theory.martingale_const_fun MeasureTheory.martingaleConstFun

variable (E)

theorem martingaleZero (ℱ : Filtration ι m0) (μ : Measure Ω) : Martingale (0 : ι → Ω → E) ℱ μ :=
  ⟨adapted_zero E ℱ, fun i j hij =>
    by
    rw [Pi.zero_apply, condexp_zero]
    simp⟩
#align measure_theory.martingale_zero MeasureTheory.martingaleZero

variable {E}

namespace Martingale

@[protected]
theorem adapted (hf : Martingale f ℱ μ) : Adapted ℱ f :=
  hf.1
#align measure_theory.martingale.adapted MeasureTheory.Martingale.adapted

@[protected]
theorem stronglyMeasurable (hf : Martingale f ℱ μ) (i : ι) : strongly_measurable[ℱ i] (f i) :=
  hf.Adapted i
#align measure_theory.martingale.strongly_measurable MeasureTheory.Martingale.stronglyMeasurable

theorem condexp_ae_eq (hf : Martingale f ℱ μ) {i j : ι} (hij : i ≤ j) : μ[f j|ℱ i] =ᵐ[μ] f i :=
  hf.2 i j hij
#align measure_theory.martingale.condexp_ae_eq MeasureTheory.Martingale.condexp_ae_eq

@[protected]
theorem integrable (hf : Martingale f ℱ μ) (i : ι) : Integrable (f i) μ :=
  integrableCondexp.congr (hf.condexp_ae_eq (le_refl i))
#align measure_theory.martingale.integrable MeasureTheory.Martingale.integrable

theorem set_integral_eq [SigmaFiniteFiltration μ ℱ] (hf : Martingale f ℱ μ) {i j : ι} (hij : i ≤ j)
    {s : Set Ω} (hs : measurable_set[ℱ i] s) : (∫ ω in s, f i ω ∂μ) = ∫ ω in s, f j ω ∂μ :=
  by
  rw [← @set_integral_condexp _ _ _ _ _ (ℱ i) m0 _ _ _ (ℱ.le i) _ (hf.integrable j) hs]
  refine' set_integral_congr_ae (ℱ.le i s hs) _
  filter_upwards [hf.2 i j hij]with _ heq _ using HEq.symm
#align measure_theory.martingale.set_integral_eq MeasureTheory.Martingale.set_integral_eq

theorem add (hf : Martingale f ℱ μ) (hg : Martingale g ℱ μ) : Martingale (f + g) ℱ μ :=
  by
  refine' ⟨hf.adapted.add hg.adapted, fun i j hij => _⟩
  exact (condexp_add (hf.integrable j) (hg.integrable j)).trans ((hf.2 i j hij).add (hg.2 i j hij))
#align measure_theory.martingale.add MeasureTheory.Martingale.add

theorem neg (hf : Martingale f ℱ μ) : Martingale (-f) ℱ μ :=
  ⟨hf.Adapted.neg, fun i j hij => (condexp_neg (f j)).trans (hf.2 i j hij).neg⟩
#align measure_theory.martingale.neg MeasureTheory.Martingale.neg

theorem sub (hf : Martingale f ℱ μ) (hg : Martingale g ℱ μ) : Martingale (f - g) ℱ μ :=
  by
  rw [sub_eq_add_neg]
  exact hf.add hg.neg
#align measure_theory.martingale.sub MeasureTheory.Martingale.sub

theorem smul (c : ℝ) (hf : Martingale f ℱ μ) : Martingale (c • f) ℱ μ :=
  by
  refine' ⟨hf.adapted.smul c, fun i j hij => _⟩
  refine' (condexp_smul c (f j)).trans ((hf.2 i j hij).mono fun x hx => _)
  rw [Pi.smul_apply, hx, Pi.smul_apply, Pi.smul_apply]
#align measure_theory.martingale.smul MeasureTheory.Martingale.smul

theorem supermartingale [Preorder E] (hf : Martingale f ℱ μ) : Supermartingale f ℱ μ :=
  ⟨hf.1, fun i j hij => (hf.2 i j hij).le, fun i => hf.Integrable i⟩
#align measure_theory.martingale.supermartingale MeasureTheory.Martingale.supermartingale

theorem submartingale [Preorder E] (hf : Martingale f ℱ μ) : Submartingale f ℱ μ :=
  ⟨hf.1, fun i j hij => (hf.2 i j hij).symm.le, fun i => hf.Integrable i⟩
#align measure_theory.martingale.submartingale MeasureTheory.Martingale.submartingale

end Martingale

theorem martingale_iff [PartialOrder E] :
    Martingale f ℱ μ ↔ Supermartingale f ℱ μ ∧ Submartingale f ℱ μ :=
  ⟨fun hf => ⟨hf.Supermartingale, hf.Submartingale⟩, fun ⟨hf₁, hf₂⟩ =>
    ⟨hf₁.1, fun i j hij => (hf₁.2.1 i j hij).antisymm (hf₂.2.1 i j hij)⟩⟩
#align measure_theory.martingale_iff MeasureTheory.martingale_iff

theorem martingaleCondexp (f : Ω → E) (ℱ : Filtration ι m0) (μ : Measure Ω)
    [SigmaFiniteFiltration μ ℱ] : Martingale (fun i => μ[f|ℱ i]) ℱ μ :=
  ⟨fun i => stronglyMeasurable_condexp, fun i j hij => condexp_condexp_of_le (ℱ.mono hij) (ℱ.le j)⟩
#align measure_theory.martingale_condexp MeasureTheory.martingaleCondexp

namespace Supermartingale

@[protected]
theorem adapted [LE E] (hf : Supermartingale f ℱ μ) : Adapted ℱ f :=
  hf.1
#align measure_theory.supermartingale.adapted MeasureTheory.Supermartingale.adapted

@[protected]
theorem stronglyMeasurable [LE E] (hf : Supermartingale f ℱ μ) (i : ι) :
    strongly_measurable[ℱ i] (f i) :=
  hf.Adapted i
#align measure_theory.supermartingale.strongly_measurable MeasureTheory.Supermartingale.stronglyMeasurable

@[protected]
theorem integrable [LE E] (hf : Supermartingale f ℱ μ) (i : ι) : Integrable (f i) μ :=
  hf.2.2 i
#align measure_theory.supermartingale.integrable MeasureTheory.Supermartingale.integrable

theorem condexp_ae_le [LE E] (hf : Supermartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
    μ[f j|ℱ i] ≤ᵐ[μ] f i :=
  hf.2.1 i j hij
#align measure_theory.supermartingale.condexp_ae_le MeasureTheory.Supermartingale.condexp_ae_le

theorem set_integral_le [SigmaFiniteFiltration μ ℱ] {f : ι → Ω → ℝ} (hf : Supermartingale f ℱ μ)
    {i j : ι} (hij : i ≤ j) {s : Set Ω} (hs : measurable_set[ℱ i] s) :
    (∫ ω in s, f j ω ∂μ) ≤ ∫ ω in s, f i ω ∂μ :=
  by
  rw [← set_integral_condexp (ℱ.le i) (hf.integrable j) hs]
  refine' set_integral_mono_ae integrable_condexp.integrable_on (hf.integrable i).IntegrableOn _
  filter_upwards [hf.2.1 i j hij]with _ heq using HEq
#align measure_theory.supermartingale.set_integral_le MeasureTheory.Supermartingale.set_integral_le

theorem add [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Supermartingale f ℱ μ)
    (hg : Supermartingale g ℱ μ) : Supermartingale (f + g) ℱ μ :=
  by
  refine' ⟨hf.1.add hg.1, fun i j hij => _, fun i => (hf.2.2 i).add (hg.2.2 i)⟩
  refine' (condexp_add (hf.integrable j) (hg.integrable j)).le.trans _
  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij]
  intros
  refine' add_le_add _ _ <;> assumption
#align measure_theory.supermartingale.add MeasureTheory.Supermartingale.add

theorem addMartingale [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Supermartingale f ℱ μ)
    (hg : Martingale g ℱ μ) : Supermartingale (f + g) ℱ μ :=
  hf.add hg.Supermartingale
#align measure_theory.supermartingale.add_martingale MeasureTheory.Supermartingale.addMartingale

theorem neg [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Supermartingale f ℱ μ) :
    Submartingale (-f) ℱ μ :=
  by
  refine' ⟨hf.1.neg, fun i j hij => _, fun i => (hf.2.2 i).neg⟩
  refine' eventually_le.trans _ (condexp_neg (f j)).symm.le
  filter_upwards [hf.2.1 i j hij]with _ _
  simpa
#align measure_theory.supermartingale.neg MeasureTheory.Supermartingale.neg

end Supermartingale

namespace Submartingale

@[protected]
theorem adapted [LE E] (hf : Submartingale f ℱ μ) : Adapted ℱ f :=
  hf.1
#align measure_theory.submartingale.adapted MeasureTheory.Submartingale.adapted

@[protected]
theorem stronglyMeasurable [LE E] (hf : Submartingale f ℱ μ) (i : ι) :
    strongly_measurable[ℱ i] (f i) :=
  hf.Adapted i
#align measure_theory.submartingale.strongly_measurable MeasureTheory.Submartingale.stronglyMeasurable

@[protected]
theorem integrable [LE E] (hf : Submartingale f ℱ μ) (i : ι) : Integrable (f i) μ :=
  hf.2.2 i
#align measure_theory.submartingale.integrable MeasureTheory.Submartingale.integrable

theorem ae_le_condexp [LE E] (hf : Submartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
    f i ≤ᵐ[μ] μ[f j|ℱ i] :=
  hf.2.1 i j hij
#align measure_theory.submartingale.ae_le_condexp MeasureTheory.Submartingale.ae_le_condexp

theorem add [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Submartingale f ℱ μ)
    (hg : Submartingale g ℱ μ) : Submartingale (f + g) ℱ μ :=
  by
  refine' ⟨hf.1.add hg.1, fun i j hij => _, fun i => (hf.2.2 i).add (hg.2.2 i)⟩
  refine' eventually_le.trans _ (condexp_add (hf.integrable j) (hg.integrable j)).symm.le
  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij]
  intros
  refine' add_le_add _ _ <;> assumption
#align measure_theory.submartingale.add MeasureTheory.Submartingale.add

theorem addMartingale [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Submartingale f ℱ μ)
    (hg : Martingale g ℱ μ) : Submartingale (f + g) ℱ μ :=
  hf.add hg.Submartingale
#align measure_theory.submartingale.add_martingale MeasureTheory.Submartingale.addMartingale

theorem neg [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Submartingale f ℱ μ) :
    Supermartingale (-f) ℱ μ :=
  by
  refine' ⟨hf.1.neg, fun i j hij => (condexp_neg (f j)).le.trans _, fun i => (hf.2.2 i).neg⟩
  filter_upwards [hf.2.1 i j hij]with _ _
  simpa
#align measure_theory.submartingale.neg MeasureTheory.Submartingale.neg

/-- The converse of this lemma is `measure_theory.submartingale_of_set_integral_le`. -/
theorem set_integral_le [SigmaFiniteFiltration μ ℱ] {f : ι → Ω → ℝ} (hf : Submartingale f ℱ μ)
    {i j : ι} (hij : i ≤ j) {s : Set Ω} (hs : measurable_set[ℱ i] s) :
    (∫ ω in s, f i ω ∂μ) ≤ ∫ ω in s, f j ω ∂μ :=
  by
  rw [← neg_le_neg_iff, ← integral_neg, ← integral_neg]
  exact supermartingale.set_integral_le hf.neg hij hs
#align measure_theory.submartingale.set_integral_le MeasureTheory.Submartingale.set_integral_le

theorem subSupermartingale [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)]
    (hf : Submartingale f ℱ μ) (hg : Supermartingale g ℱ μ) : Submartingale (f - g) ℱ μ :=
  by
  rw [sub_eq_add_neg]
  exact hf.add hg.neg
#align measure_theory.submartingale.sub_supermartingale MeasureTheory.Submartingale.subSupermartingale

theorem subMartingale [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Submartingale f ℱ μ)
    (hg : Martingale g ℱ μ) : Submartingale (f - g) ℱ μ :=
  hf.subSupermartingale hg.Supermartingale
#align measure_theory.submartingale.sub_martingale MeasureTheory.Submartingale.subMartingale

protected theorem sup {f g : ι → Ω → ℝ} (hf : Submartingale f ℱ μ) (hg : Submartingale g ℱ μ) :
    Submartingale (f ⊔ g) ℱ μ :=
  by
  refine'
    ⟨fun i => @strongly_measurable.sup _ _ _ _ (ℱ i) _ _ _ (hf.adapted i) (hg.adapted i),
      fun i j hij => _, fun i => integrable.sup (hf.integrable _) (hg.integrable _)⟩
  refine' eventually_le.sup_le _ _
  ·
    exact
      eventually_le.trans (hf.2.1 i j hij)
        (condexp_mono (hf.integrable _) (integrable.sup (hf.integrable j) (hg.integrable j))
          (eventually_of_forall fun x => le_max_left _ _))
  ·
    exact
      eventually_le.trans (hg.2.1 i j hij)
        (condexp_mono (hg.integrable _) (integrable.sup (hf.integrable j) (hg.integrable j))
          (eventually_of_forall fun x => le_max_right _ _))
#align measure_theory.submartingale.sup MeasureTheory.Submartingale.sup

protected theorem pos {f : ι → Ω → ℝ} (hf : Submartingale f ℱ μ) : Submartingale (f⁺) ℱ μ :=
  hf.sup (martingaleZero _ _ _).Submartingale
#align measure_theory.submartingale.pos MeasureTheory.Submartingale.pos

end Submartingale

section Submartingale

theorem submartingaleOfSetIntegralLe [IsFiniteMeasure μ] {f : ι → Ω → ℝ} (hadp : Adapted ℱ f)
    (hint : ∀ i, Integrable (f i) μ)
    (hf :
      ∀ i j : ι,
        i ≤ j → ∀ s : Set Ω, measurable_set[ℱ i] s → (∫ ω in s, f i ω ∂μ) ≤ ∫ ω in s, f j ω ∂μ) :
    Submartingale f ℱ μ := by
  refine' ⟨hadp, fun i j hij => _, hint⟩
  suffices f i ≤ᵐ[μ.trim (ℱ.le i)] μ[f j|ℱ i] by exact ae_le_of_ae_le_trim this
  suffices 0 ≤ᵐ[μ.trim (ℱ.le i)] μ[f j|ℱ i] - f i
    by
    filter_upwards [this]with x hx
    rwa [← sub_nonneg]
  refine'
    ae_nonneg_of_forall_set_integral_nonneg
      ((integrable_condexp.sub (hint i)).trim _ (strongly_measurable_condexp.sub <| hadp i))
      fun s hs h's => _
  specialize hf i j hij s hs
  rwa [← set_integral_trim _ (strongly_measurable_condexp.sub <| hadp i) hs,
    integral_sub' integrable_condexp.integrable_on (hint i).IntegrableOn, sub_nonneg,
    set_integral_condexp (ℱ.le i) (hint j) hs]
#align measure_theory.submartingale_of_set_integral_le MeasureTheory.submartingaleOfSetIntegralLe

theorem submartingaleOfCondexpSubNonneg [IsFiniteMeasure μ] {f : ι → Ω → ℝ} (hadp : Adapted ℱ f)
    (hint : ∀ i, Integrable (f i) μ) (hf : ∀ i j, i ≤ j → 0 ≤ᵐ[μ] μ[f j - f i|ℱ i]) :
    Submartingale f ℱ μ := by
  refine' ⟨hadp, fun i j hij => _, hint⟩
  rw [← condexp_of_strongly_measurable (ℱ.le _) (hadp _) (hint _), ← eventually_sub_nonneg]
  exact eventually_le.trans (hf i j hij) (condexp_sub (hint _) (hint _)).le
  infer_instance
#align measure_theory.submartingale_of_condexp_sub_nonneg MeasureTheory.submartingaleOfCondexpSubNonneg

theorem Submartingale.condexp_sub_nonneg {f : ι → Ω → ℝ} (hf : Submartingale f ℱ μ) {i j : ι}
    (hij : i ≤ j) : 0 ≤ᵐ[μ] μ[f j - f i|ℱ i] :=
  by
  by_cases h : sigma_finite (μ.trim (ℱ.le i))
  swap; · rw [condexp_of_not_sigma_finite (ℱ.le i) h]
  refine' eventually_le.trans _ (condexp_sub (hf.integrable _) (hf.integrable _)).symm.le
  rw [eventually_sub_nonneg,
    condexp_of_strongly_measurable (ℱ.le _) (hf.adapted _) (hf.integrable _)]
  · exact hf.2.1 i j hij
  · exact h
#align measure_theory.submartingale.condexp_sub_nonneg MeasureTheory.Submartingale.condexp_sub_nonneg

theorem submartingale_iff_condexp_sub_nonneg [IsFiniteMeasure μ] {f : ι → Ω → ℝ} :
    Submartingale f ℱ μ ↔
      Adapted ℱ f ∧ (∀ i, Integrable (f i) μ) ∧ ∀ i j, i ≤ j → 0 ≤ᵐ[μ] μ[f j - f i|ℱ i] :=
  ⟨fun h => ⟨h.Adapted, h.Integrable, fun i j => h.condexp_sub_nonneg⟩, fun ⟨hadp, hint, h⟩ =>
    submartingaleOfCondexpSubNonneg hadp hint h⟩
#align measure_theory.submartingale_iff_condexp_sub_nonneg MeasureTheory.submartingale_iff_condexp_sub_nonneg

end Submartingale

namespace Supermartingale

theorem subSubmartingale [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)]
    (hf : Supermartingale f ℱ μ) (hg : Submartingale g ℱ μ) : Supermartingale (f - g) ℱ μ :=
  by
  rw [sub_eq_add_neg]
  exact hf.add hg.neg
#align measure_theory.supermartingale.sub_submartingale MeasureTheory.Supermartingale.subSubmartingale

theorem subMartingale [Preorder E] [CovariantClass E E (· + ·) (· ≤ ·)] (hf : Supermartingale f ℱ μ)
    (hg : Martingale g ℱ μ) : Supermartingale (f - g) ℱ μ :=
  hf.subSubmartingale hg.Submartingale
#align measure_theory.supermartingale.sub_martingale MeasureTheory.Supermartingale.subMartingale

section

variable {F : Type _} [NormedLatticeAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F]
  [OrderedSMul ℝ F]

theorem smulNonneg {f : ι → Ω → F} {c : ℝ} (hc : 0 ≤ c) (hf : Supermartingale f ℱ μ) :
    Supermartingale (c • f) ℱ μ :=
  by
  refine' ⟨hf.1.smul c, fun i j hij => _, fun i => (hf.2.2 i).smul c⟩
  refine' (condexp_smul c (f j)).le.trans _
  filter_upwards [hf.2.1 i j hij]with _ hle
  simp
  exact smul_le_smul_of_nonneg hle hc
#align measure_theory.supermartingale.smul_nonneg MeasureTheory.Supermartingale.smulNonneg

theorem smulNonpos {f : ι → Ω → F} {c : ℝ} (hc : c ≤ 0) (hf : Supermartingale f ℱ μ) :
    Submartingale (c • f) ℱ μ :=
  by
  rw [← neg_neg c,
    (by
      ext (i x)
      simp : - -c • f = -(-c • f))]
  exact (hf.smul_nonneg <| neg_nonneg.2 hc).neg
#align measure_theory.supermartingale.smul_nonpos MeasureTheory.Supermartingale.smulNonpos

end

end Supermartingale

namespace Submartingale

section

variable {F : Type _} [NormedLatticeAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F]
  [OrderedSMul ℝ F]

theorem smulNonneg {f : ι → Ω → F} {c : ℝ} (hc : 0 ≤ c) (hf : Submartingale f ℱ μ) :
    Submartingale (c • f) ℱ μ :=
  by
  rw [← neg_neg c,
    (by
      ext (i x)
      simp : - -c • f = -(c • -f))]
  exact supermartingale.neg (hf.neg.smul_nonneg hc)
#align measure_theory.submartingale.smul_nonneg MeasureTheory.Submartingale.smulNonneg

theorem smulNonpos {f : ι → Ω → F} {c : ℝ} (hc : c ≤ 0) (hf : Submartingale f ℱ μ) :
    Supermartingale (c • f) ℱ μ :=
  by
  rw [← neg_neg c,
    (by
      ext (i x)
      simp : - -c • f = -(-c • f))]
  exact (hf.smul_nonneg <| neg_nonneg.2 hc).neg
#align measure_theory.submartingale.smul_nonpos MeasureTheory.Submartingale.smulNonpos

end

end Submartingale

section Nat

variable {𝒢 : Filtration ℕ m0}

theorem submartingaleOfSetIntegralLeSucc [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ)
    (hf :
      ∀ i, ∀ s : Set Ω, measurable_set[𝒢 i] s → (∫ ω in s, f i ω ∂μ) ≤ ∫ ω in s, f (i + 1) ω ∂μ) :
    Submartingale f 𝒢 μ :=
  by
  refine' submartingale_of_set_integral_le hadp hint fun i j hij s hs => _
  induction' hij with k hk₁ hk₂
  · exact le_rfl
  · exact le_trans hk₂ (hf k s (𝒢.mono hk₁ _ hs))
#align measure_theory.submartingale_of_set_integral_le_succ MeasureTheory.submartingaleOfSetIntegralLeSucc

theorem supermartingaleOfSetIntegralSuccLe [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ)
    (hf :
      ∀ i, ∀ s : Set Ω, measurable_set[𝒢 i] s → (∫ ω in s, f (i + 1) ω ∂μ) ≤ ∫ ω in s, f i ω ∂μ) :
    Supermartingale f 𝒢 μ := by
  rw [← neg_neg f]
  refine' (submartingale_of_set_integral_le_succ hadp.neg (fun i => (hint i).neg) _).neg
  simpa only [integral_neg, Pi.neg_apply, neg_le_neg_iff]
#align measure_theory.supermartingale_of_set_integral_succ_le MeasureTheory.supermartingaleOfSetIntegralSuccLe

theorem martingaleOfSetIntegralEqSucc [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ)
    (hf :
      ∀ i, ∀ s : Set Ω, measurable_set[𝒢 i] s → (∫ ω in s, f i ω ∂μ) = ∫ ω in s, f (i + 1) ω ∂μ) :
    Martingale f 𝒢 μ :=
  martingale_iff.2
    ⟨supermartingaleOfSetIntegralSuccLe hadp hint fun i s hs => (hf i s hs).ge,
      submartingaleOfSetIntegralLeSucc hadp hint fun i s hs => (hf i s hs).le⟩
#align measure_theory.martingale_of_set_integral_eq_succ MeasureTheory.martingaleOfSetIntegralEqSucc

theorem submartingaleNat [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ) (hf : ∀ i, f i ≤ᵐ[μ] μ[f (i + 1)|𝒢 i]) : Submartingale f 𝒢 μ :=
  by
  refine' submartingale_of_set_integral_le_succ hadp hint fun i s hs => _
  have : (∫ ω in s, f (i + 1) ω ∂μ) = ∫ ω in s, (μ[f (i + 1)|𝒢 i]) ω ∂μ :=
    (set_integral_condexp (𝒢.le i) (hint _) hs).symm
  rw [this]
  exact set_integral_mono_ae (hint i).IntegrableOn integrable_condexp.integrable_on (hf i)
#align measure_theory.submartingale_nat MeasureTheory.submartingaleNat

theorem supermartingaleNat [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ) (hf : ∀ i, μ[f (i + 1)|𝒢 i] ≤ᵐ[μ] f i) :
    Supermartingale f 𝒢 μ := by
  rw [← neg_neg f]
  refine'
    (submartingale_nat hadp.neg (fun i => (hint i).neg) fun i =>
        eventually_le.trans _ (condexp_neg _).symm.le).neg
  filter_upwards [hf i]with x hx using neg_le_neg hx
#align measure_theory.supermartingale_nat MeasureTheory.supermartingaleNat

theorem martingaleNat [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ) (hf : ∀ i, f i =ᵐ[μ] μ[f (i + 1)|𝒢 i]) : Martingale f 𝒢 μ :=
  martingale_iff.2
    ⟨supermartingaleNat hadp hint fun i => (hf i).symm.le,
      submartingaleNat hadp hint fun i => (hf i).le⟩
#align measure_theory.martingale_nat MeasureTheory.martingaleNat

theorem submartingaleOfCondexpSubNonnegNat [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ) (hf : ∀ i, 0 ≤ᵐ[μ] μ[f (i + 1) - f i|𝒢 i]) :
    Submartingale f 𝒢 μ :=
  by
  refine' submartingale_nat hadp hint fun i => _
  rw [← condexp_of_strongly_measurable (𝒢.le _) (hadp _) (hint _), ← eventually_sub_nonneg]
  exact eventually_le.trans (hf i) (condexp_sub (hint _) (hint _)).le
  infer_instance
#align measure_theory.submartingale_of_condexp_sub_nonneg_nat MeasureTheory.submartingaleOfCondexpSubNonnegNat

theorem supermartingaleOfCondexpSubNonnegNat [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ}
    (hadp : Adapted 𝒢 f) (hint : ∀ i, Integrable (f i) μ)
    (hf : ∀ i, 0 ≤ᵐ[μ] μ[f i - f (i + 1)|𝒢 i]) : Supermartingale f 𝒢 μ :=
  by
  rw [← neg_neg f]
  refine' (submartingale_of_condexp_sub_nonneg_nat hadp.neg (fun i => (hint i).neg) _).neg
  simpa only [Pi.zero_apply, Pi.neg_apply, neg_sub_neg]
#align measure_theory.supermartingale_of_condexp_sub_nonneg_nat MeasureTheory.supermartingaleOfCondexpSubNonnegNat

theorem martingaleOfCondexpSubEqZeroNat [IsFiniteMeasure μ] {f : ℕ → Ω → ℝ} (hadp : Adapted 𝒢 f)
    (hint : ∀ i, Integrable (f i) μ) (hf : ∀ i, μ[f (i + 1) - f i|𝒢 i] =ᵐ[μ] 0) :
    Martingale f 𝒢 μ :=
  by
  refine'
    martingale_iff.2
      ⟨supermartingale_of_condexp_sub_nonneg_nat hadp hint fun i => _,
        submartingale_of_condexp_sub_nonneg_nat hadp hint fun i => (hf i).symm.le⟩
  rw [← neg_sub]
  refine' (eventually_eq.trans _ (condexp_neg _).symm).le
  filter_upwards [hf i]with x hx
  simpa only [Pi.zero_apply, Pi.neg_apply, zero_eq_neg]
#align measure_theory.martingale_of_condexp_sub_eq_zero_nat MeasureTheory.martingaleOfCondexpSubEqZeroNat

-- Note that one cannot use `submartingale.zero_le_of_predictable` to prove the other two
-- corresponding lemmas without imposing more restrictions to the ordering of `E`
/-- A predictable submartingale is a.e. greater equal than its initial state. -/
theorem Submartingale.zero_le_of_predictable [Preorder E] [SigmaFiniteFiltration μ 𝒢]
    {f : ℕ → Ω → E} (hfmgle : Submartingale f 𝒢 μ) (hfadp : Adapted 𝒢 fun n => f (n + 1)) (n : ℕ) :
    f 0 ≤ᵐ[μ] f n := by
  induction' n with k ih
  · rfl
  ·
    exact
      ih.trans
        ((hfmgle.2.1 k (k + 1) k.le_succ).trans_eq <|
          germ.coe_eq.mp <|
            congr_arg coe <|
              condexp_of_strongly_measurable (𝒢.le _) (hfadp _) <| hfmgle.integrable _)
#align measure_theory.submartingale.zero_le_of_predictable MeasureTheory.Submartingale.zero_le_of_predictable

/-- A predictable supermartingale is a.e. less equal than its initial state. -/
theorem Supermartingale.le_zero_of_predictable [Preorder E] [SigmaFiniteFiltration μ 𝒢]
    {f : ℕ → Ω → E} (hfmgle : Supermartingale f 𝒢 μ) (hfadp : Adapted 𝒢 fun n => f (n + 1))
    (n : ℕ) : f n ≤ᵐ[μ] f 0 := by
  induction' n with k ih
  · rfl
  ·
    exact
      ((germ.coe_eq.mp <|
                  congr_arg coe <|
                    condexp_of_strongly_measurable (𝒢.le _) (hfadp _) <|
                      hfmgle.integrable _).symm.trans_le
            (hfmgle.2.1 k (k + 1) k.le_succ)).trans
        ih
#align measure_theory.supermartingale.le_zero_of_predictable MeasureTheory.Supermartingale.le_zero_of_predictable

/-- A predictable martingale is a.e. equal to its initial state. -/
theorem Martingale.eq_zero_of_predictable [SigmaFiniteFiltration μ 𝒢] {f : ℕ → Ω → E}
    (hfmgle : Martingale f 𝒢 μ) (hfadp : Adapted 𝒢 fun n => f (n + 1)) (n : ℕ) : f n =ᵐ[μ] f 0 :=
  by
  induction' n with k ih
  · rfl
  ·
    exact
      ((germ.coe_eq.mp
                  (congr_arg coe <|
                    condexp_of_strongly_measurable (𝒢.le _) (hfadp _)
                      (hfmgle.integrable _))).symm.trans
            (hfmgle.2 k (k + 1) k.le_succ)).trans
        ih
#align measure_theory.martingale.eq_zero_of_predictable MeasureTheory.Martingale.eq_zero_of_predictable

namespace Submartingale

@[protected]
theorem integrableStoppedValue [LE E] {f : ℕ → Ω → E} (hf : Submartingale f 𝒢 μ) {τ : Ω → ℕ}
    (hτ : IsStoppingTime 𝒢 τ) {N : ℕ} (hbdd : ∀ ω, τ ω ≤ N) : Integrable (stoppedValue f τ) μ :=
  integrableStoppedValue ℕ hτ hf.Integrable hbdd
#align measure_theory.submartingale.integrable_stopped_value MeasureTheory.Submartingale.integrableStoppedValue

end Submartingale

theorem Submartingale.sumMulSub [IsFiniteMeasure μ] {R : ℝ} {ξ f : ℕ → Ω → ℝ}
    (hf : Submartingale f 𝒢 μ) (hξ : Adapted 𝒢 ξ) (hbdd : ∀ n ω, ξ n ω ≤ R)
    (hnonneg : ∀ n ω, 0 ≤ ξ n ω) :
    Submartingale (fun n => ∑ k in Finset.range n, ξ k * (f (k + 1) - f k)) 𝒢 μ :=
  by
  have hξbdd : ∀ i, ∃ C, ∀ ω, |ξ i ω| ≤ C := fun i =>
    ⟨R, fun ω => (abs_of_nonneg (hnonneg i ω)).trans_le (hbdd i ω)⟩
  have hint : ∀ m, integrable (∑ k in Finset.range m, ξ k * (f (k + 1) - f k)) μ := fun m =>
    integrable_finset_sum' _ fun i hi =>
      integrable.bdd_mul ((hf.integrable _).sub (hf.integrable _))
        hξ.strongly_measurable.ae_strongly_measurable (hξbdd _)
  have hadp : adapted 𝒢 fun n => ∑ k in Finset.range n, ξ k * (f (k + 1) - f k) :=
    by
    intro m
    refine' Finset.stronglyMeasurable_sum' _ fun i hi => _
    rw [Finset.mem_range] at hi
    exact
      (hξ.strongly_measurable_le hi.le).mul
        ((hf.adapted.strongly_measurable_le (Nat.succ_le_of_lt hi)).sub
          (hf.adapted.strongly_measurable_le hi.le))
  refine' submartingale_of_condexp_sub_nonneg_nat hadp hint fun i => _
  simp only [← Finset.sum_Ico_eq_sub _ (Nat.le_succ _), Finset.sum_apply, Pi.mul_apply,
    Pi.sub_apply, Nat.Ico_succ_singleton, Finset.sum_singleton]
  exact
    eventually_le.trans
      (eventually_le.mul_nonneg (eventually_of_forall (hnonneg _))
        (hf.condexp_sub_nonneg (Nat.le_succ _)))
      (condexp_strongly_measurable_mul (hξ _)
            (((hf.integrable _).sub (hf.integrable _)).bddMul
              hξ.strongly_measurable.ae_strongly_measurable (hξbdd _))
            ((hf.integrable _).sub (hf.integrable _))).symm.le
#align measure_theory.submartingale.sum_mul_sub MeasureTheory.Submartingale.sumMulSub

/-- Given a discrete submartingale `f` and a predictable process `ξ` (i.e. `ξ (n + 1)` is adapted)
the process defined by `λ n, ∑ k in finset.range n, ξ (k + 1) * (f (k + 1) - f k)` is also a
submartingale. -/
theorem Submartingale.sumMulSub' [IsFiniteMeasure μ] {R : ℝ} {ξ f : ℕ → Ω → ℝ}
    (hf : Submartingale f 𝒢 μ) (hξ : Adapted 𝒢 fun n => ξ (n + 1)) (hbdd : ∀ n ω, ξ n ω ≤ R)
    (hnonneg : ∀ n ω, 0 ≤ ξ n ω) :
    Submartingale (fun n => ∑ k in Finset.range n, ξ (k + 1) * (f (k + 1) - f k)) 𝒢 μ :=
  hf.sumMulSub hξ (fun n => hbdd _) fun n => hnonneg _
#align measure_theory.submartingale.sum_mul_sub' MeasureTheory.Submartingale.sumMulSub'

end Nat

end MeasureTheory


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

! This file was ported from Lean 3 source module algebra.char_p.mixed_char_zero
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Algebra
import Mathbin.Algebra.CharP.LocalRing
import Mathbin.RingTheory.Ideal.Quotient
import Mathbin.Tactic.FieldSimp

/-!
# Equal and mixed characteristic

In commutative algebra, some statments are simpler when working over a `ℚ`-algebra `R`, in which
case one also says that the ring has "equal characteristic zero". A ring that is not a
`ℚ`-algebra has either positive characteristic or there exists a prime ideal `I ⊂ R` such that
the quotient `R ⧸ I` has positive characteristic `p > 0`. In this case one speaks of
"mixed characteristic `(0, p)`", where `p` is only unique if `R` is local.

Examples of mixed characteristic rings are `ℤ` or the `p`-adic integers/numbers.

This file provides the main theorem `split_by_characteristic` that splits any proposition `P` into
the following three cases:

1) Positive characteristic: `char_p R p` (where `p ≠ 0`)
2) Equal characteristic zero: `algebra ℚ R`
3) Mixed characteristic: `mixed_char_zero R p` (where `p` is prime)

## Main definitions

- `mixed_char_zero` : A ring has mixed characteristic `(0, p)` if it has characteristic zero
  and there exists an ideal such that the quotient `R ⧸ I` has characteristic `p`.

## Main results

- `split_equal_mixed_char` : Split a statement into equal/mixed characteristic zero.

This main theorem has the following three corollaries which include the positive
characteristic case for convenience:

- `split_by_characteristic` : Generally consider positive char `p ≠ 0`.
- `split_by_characteristic_domain` : In a domain we can assume that `p` is prime.
- `split_by_characteristic_local_ring` : In a local ring we can assume that `p` is a prime power.

## TODO

- Relate mixed characteristic in a local ring to p-adic numbers [number_theory.padics].

-/

variable (R : Type _) [CommRing R]

/-!
### Mixed characteristic
-/

/-- A ring of characteristic zero is of "mixed characteristic `(0, p)`" if there exists an ideal
such that the quotient `R ⧸ I` has caracteristic `p`.

**Remark:** For `p = 0`, `mixed_char R 0` is a meaningless definition as `R ⧸ ⊥ ≅ R` has by
definition always characteristic zero.
One could require `(I ≠ ⊥)` in the definition, but then `mixed_char R 0` would mean something
like `ℤ`-algebra of extension degree `≥ 1` and would be completely independent from
whether something is a `ℚ`-algebra or not (e.g. `ℚ[X]` would satisfy it but `ℚ` wouldn't).
-/
class MixedCharZero (p : ℕ) : Prop where
  [to_charZero : CharZero R]
  charP_quotient : ∃ I : Ideal R, I ≠ ⊤ ∧ CharP (R ⧸ I) p
#align mixed_char_zero MixedCharZero

namespace MixedCharZero

/-- Reduction to `p` prime: When proving any statement `P` about mixed characteristic rings we
can always assume that `p` is prime.
-/
theorem reduce_to_p_prime {P : Prop} :
    (∀ p > 0, MixedCharZero R p → P) ↔ ∀ p : ℕ, p.Prime → MixedCharZero R p → P :=
  by
  constructor
  · intro h q q_prime q_mixed_char
    exact h q (Nat.Prime.pos q_prime) q_mixed_char
  · intro h q q_pos q_mixed_char
    rcases q_mixed_char.char_p_quotient with ⟨I, hI_ne_top, hI_char⟩
    -- Krull's Thm: There exists a prime ideal `P` such that `I ≤ P`
    rcases Ideal.exists_le_maximal I hI_ne_top with ⟨M, hM_max, h_IM⟩
    skip
    -- make `hI_char : char_p (R ⧸ I) q` an instance.
    let r := ringChar (R ⧸ M)
    have r_pos : r ≠ 0 :=
      by
      have q_zero := congr_arg (Ideal.Quotient.factor I M h_IM) (CharP.cast_eq_zero (R ⧸ I) q)
      simp only [map_natCast, map_zero] at q_zero
      apply ne_zero_of_dvd_ne_zero (ne_of_gt q_pos)
      exact (CharP.cast_eq_zero_iff (R ⧸ M) r q).mp q_zero
    have r_prime : Nat.Prime r :=
      or_iff_not_imp_right.1 (CharP.char_is_prime_or_zero (R ⧸ M) r) r_pos
    apply h r r_prime
    haveI : CharZero R := q_mixed_char.to_char_zero
    exact ⟨⟨M, hM_max.ne_top, ringChar.of_eq rfl⟩⟩
#align mixed_char_zero.reduce_to_p_prime MixedCharZero.reduce_to_p_prime

/-- Reduction to `I` prime ideal: When proving statements about mixed characteristic rings,
after we reduced to `p` prime, we can assume that the ideal `I` in the definition is maximal.
-/
theorem reduce_to_maximal_ideal {p : ℕ} (hp : Nat.Prime p) :
    (∃ I : Ideal R, I ≠ ⊤ ∧ CharP (R ⧸ I) p) ↔ ∃ I : Ideal R, I.IsMaximal ∧ CharP (R ⧸ I) p :=
  by
  constructor
  · intro g
    rcases g with ⟨I, ⟨hI_not_top, hI⟩⟩
    -- Krull's Thm: There exists a prime ideal `M` such that `I ≤ M`.
    rcases Ideal.exists_le_maximal I hI_not_top with ⟨M, ⟨hM_max, hM⟩⟩
    use M
    constructor
    exact hM_max
    · cases' CharP.exists (R ⧸ M) with r hr
      convert hr
      skip
      -- make `hr : char_p (R ⧸ M) r` an instance.
      have r_dvd_p : r ∣ p := by
        rw [← CharP.cast_eq_zero_iff (R ⧸ M) r p]
        convert congr_arg (Ideal.Quotient.factor I M hM) (CharP.cast_eq_zero (R ⧸ I) p)
      symm
      apply (Nat.Prime.eq_one_or_self_of_dvd hp r r_dvd_p).resolve_left
      exact CharP.char_ne_one (R ⧸ M) r
  · rintro ⟨I, hI_max, hI⟩
    use I
    exact ⟨Ideal.IsMaximal.ne_top hI_max, hI⟩
#align mixed_char_zero.reduce_to_maximal_ideal MixedCharZero.reduce_to_maximal_ideal

end MixedCharZero

/-!
### Equal characteristic zero

A commutative ring `R` has "equal characteristic zero" if it satisfies one of the following
equivalent properties:

1) `R` is a `ℚ`-algebra.
2) The quotient `R ⧸ I` has characteristic zero for any proper ideal `I ⊂ R`.
3) `R` has characteristic zero and does not have mixed characteristic for any prime `p`.

We show `(1) ↔ (2) ↔ (3)`, and most of the following is concerned with constructing
an explicit algebra map `ℚ →+* R` (given by `x ↦ (x.num : R) /ₚ ↑x.pnat_denom`)
for the direction `(1) ← (2)`.

Note: Property `(2)` is denoted as `equal_char_zero` in the statement names below.
-/

section EqualCharZero

-- argument `[nontrivial R]` is used in the first line of the proof.
/-- `ℚ`-algebra implies equal characteristic.
-/
@[nolint unused_arguments]
theorem Q_algebra_to_equal_charZero [Nontrivial R] [Algebra ℚ R] :
    ∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I) :=
  by
  haveI : CharZero R := algebraRat.charZero R
  intro I hI
  constructor
  intro a b h_ab
  contrapose! hI
  -- `↑a - ↑b` is a unit contained in `I`, which contradicts `I ≠ ⊤`.
  refine' I.eq_top_of_is_unit_mem _ (IsUnit.map (algebraMap ℚ R) (IsUnit.mk0 (a - b : ℚ) _))
  · simpa only [← Ideal.Quotient.eq_zero_iff_mem, map_sub, sub_eq_zero, map_natCast]
  simpa only [Ne.def, sub_eq_zero] using (@Nat.cast_injective ℚ _ _).Ne hI
#align Q_algebra_to_equal_char_zero Q_algebra_to_equal_charZero

section ConstructionOfQAlgebra

/-- Internal: Not intended to be used outside this local construction. -/
theorem EqualCharZero.pNat_coe_isUnit [h : Fact (∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I))]
    (n : ℕ+) : IsUnit (n : R) :=
  by
  -- `n : R` is a unit iff `(n)` is not a proper ideal in `R`.
  rw [← Ideal.span_singleton_eq_top]
  -- So by contrapositive, we should show the quotient does not have characteristic zero.
  apply not_imp_comm.mp (h.elim (Ideal.span {n}))
  intro h_char_zero
  -- In particular, the image of `n` in the quotient should be nonzero.
  apply h_char_zero.cast_injective.Ne n.ne_zero
  -- But `n` generates the ideal, so its image is clearly zero.
  rw [← map_natCast (Ideal.Quotient.mk _), Nat.cast_zero, Ideal.Quotient.eq_zero_iff_mem]
  exact Ideal.subset_span (Set.mem_singleton _)
#align equal_char_zero.pnat_coe_is_unit EqualCharZero.pNat_coe_isUnit

/-- Internal: Not intended to be used outside this local construction. -/
noncomputable instance EqualCharZero.pnatHasCoeUnits
    [Fact (∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I))] : CoeTC ℕ+ Rˣ :=
  ⟨fun n => (EqualCharZero.pNat_coe_isUnit R n).Unit⟩
#align equal_char_zero.pnat_has_coe_units EqualCharZero.pnatHasCoeUnits

/-- Internal: Not intended to be used outside this local construction. -/
theorem EqualCharZero.pNat_coe_units_eq_one [Fact (∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I))] :
    ((1 : ℕ+) : Rˣ) = 1 := by
  apply Units.ext
  rw [Units.val_one]
  change ((EqualCharZero.pNat_coe_isUnit R 1).Unit : R) = 1
  rw [IsUnit.unit_spec (EqualCharZero.pNat_coe_isUnit R 1)]
  rw [coe_coe, PNat.one_coe, Nat.cast_one]
#align equal_char_zero.pnat_coe_units_eq_one EqualCharZero.pNat_coe_units_eq_one

/-- Internal: Not intended to be used outside this local construction. -/
theorem EqualCharZero.pNat_coe_units_coe_eq_coe [Fact (∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I))]
    (n : ℕ+) : ((n : Rˣ) : R) = ↑n :=
  by
  change ((EqualCharZero.pNat_coe_isUnit R n).Unit : R) = ↑n
  simp only [IsUnit.unit_spec]
#align equal_char_zero.pnat_coe_units_coe_eq_coe EqualCharZero.pNat_coe_units_coe_eq_coe

/-- Equal characteristic implies `ℚ`-algebra.
-/
noncomputable def equalCharZeroToQAlgebra (h : ∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I)) :
    Algebra ℚ R :=
  haveI : Fact (∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I)) := ⟨h⟩
  RingHom.toAlgebra
    { toFun := fun x => x.num /ₚ ↑x.pnatDen
      map_zero' := by simp [divp]
      map_one' := by simp [EqualCharZero.pNat_coe_units_eq_one]
      map_mul' := by
        intro a b
        field_simp
        repeat' rw [EqualCharZero.pNat_coe_units_coe_eq_coe R]
        trans (↑((a * b).num * a.denom * b.denom) : R)
        · simp_rw [Int.cast_mul, Int.cast_ofNat, coe_coe, Rat.coe_pnatDen]
          ring
        rw [Rat.mul_num_den' a b]
        simp
      map_add' := by
        intro a b
        field_simp
        repeat' rw [EqualCharZero.pNat_coe_units_coe_eq_coe R]
        trans (↑((a + b).num * a.denom * b.denom) : R)
        · simp_rw [Int.cast_mul, Int.cast_ofNat, coe_coe, Rat.coe_pnatDen]
          ring
        rw [Rat.add_num_den' a b]
        simp }
#align equal_char_zero_to_Q_algebra equalCharZeroToQAlgebra

end ConstructionOfQAlgebra

end EqualCharZero

/-- Not mixed characteristic implies equal characteristic.
-/
theorem not_mixed_char_to_equal_charZero [CharZero R] (h : ∀ p > 0, ¬MixedCharZero R p) :
    ∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I) :=
  by
  intro I hI_ne_top
  apply CharP.charP_to_charZero _
  cases' CharP.exists (R ⧸ I) with p hp
  cases p
  · exact hp
  · have h_mixed : MixedCharZero R p.succ := ⟨⟨I, ⟨hI_ne_top, hp⟩⟩⟩
    exact absurd h_mixed (h p.succ p.succ_pos)
#align not_mixed_char_to_equal_char_zero not_mixed_char_to_equal_charZero

/-- Equal characteristic implies not mixed characteristic.
-/
theorem equal_charZero_to_not_mixed_char (h : ∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I)) :
    ∀ p > 0, ¬MixedCharZero R p := by
  intro p p_pos
  by_contra hp_mixed_char
  rcases hp_mixed_char.char_p_quotient with ⟨I, hI_ne_top, hI_p⟩
  replace hI_zero : CharP (R ⧸ I) 0 := @CharP.ofCharZero _ _ (h I hI_ne_top)
  exact absurd (CharP.eq (R ⧸ I) hI_p hI_zero) (ne_of_gt p_pos)
#align equal_char_zero_to_not_mixed_char equal_charZero_to_not_mixed_char

/-- A ring of characteristic zero has equal characteristic iff it does not
have mixed characteristic for any `p`.
-/
theorem equal_charZero_iff_not_mixed_char [CharZero R] :
    (∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I)) ↔ ∀ p > 0, ¬MixedCharZero R p :=
  ⟨equal_charZero_to_not_mixed_char R, not_mixed_char_to_equal_charZero R⟩
#align equal_char_zero_iff_not_mixed_char equal_charZero_iff_not_mixed_char

/-- A ring is a `ℚ`-algebra iff it has equal characteristic zero.
-/
theorem Q_algebra_iff_equal_charZero [Nontrivial R] :
    Nonempty (Algebra ℚ R) ↔ ∀ I : Ideal R, I ≠ ⊤ → CharZero (R ⧸ I) :=
  by
  constructor
  · intro h_alg
    haveI h_alg' : Algebra ℚ R := h_alg.some
    apply Q_algebra_to_equal_charZero
  · intro h
    apply Nonempty.intro
    exact equalCharZeroToQAlgebra R h
#align Q_algebra_iff_equal_char_zero Q_algebra_iff_equal_charZero

/-- A ring of characteristic zero is not a `ℚ`-algebra iff it has mixed characteristic for some `p`.
-/
theorem not_Q_algebra_iff_not_equal_charZero [CharZero R] :
    IsEmpty (Algebra ℚ R) ↔ ∃ p > 0, MixedCharZero R p :=
  by
  rw [← not_iff_not]
  push_neg
  rw [not_isEmpty_iff, ← equal_charZero_iff_not_mixed_char]
  apply Q_algebra_iff_equal_charZero
#align not_Q_algebra_iff_not_equal_char_zero not_Q_algebra_iff_not_equal_charZero

/-!
# Splitting statements into different characteristic

Statements to split a proof by characteristic. There are 3 theorems here that are very
similar. They only differ in the assumptions we can make on the positive characteristic
case:
Generally we need to consider all `p ≠ 0`, but if `R` is a local ring, we can assume
that `p` is a prime power. And if `R` is a domain, we can even assume that `p` is prime.
-/

section MainStatements

variable {P : Prop}

/-- Split a `Prop` in characteristic zero into equal and mixed characteristic.
-/
theorem split_equal_mixed_char [CharZero R] (h_equal : Algebra ℚ R → P)
    (h_mixed : ∀ p : ℕ, Nat.Prime p → MixedCharZero R p → P) : P :=
  by
  by_cases h : ∃ p > 0, MixedCharZero R p
  · rcases h with ⟨p, ⟨H, hp⟩⟩
    rw [← MixedCharZero.reduce_to_p_prime] at h_mixed
    exact h_mixed p H hp
  · apply h_equal
    rw [← not_Q_algebra_iff_not_equal_charZero, not_isEmpty_iff] at h
    exact h.some
#align split_equal_mixed_char split_equal_mixed_char

example (n : ℕ) (h : n ≠ 0) : 0 < n :=
  zero_lt_iff.mpr h

/-- Split any `Prop` over `R` into the three cases:
- positive characteristic.
- equal characteristic zero.
- mixed characteristic `(0, p)`.
-/
theorem split_by_characteristic (h_pos : ∀ p : ℕ, p ≠ 0 → CharP R p → P) (h_equal : Algebra ℚ R → P)
    (h_mixed : ∀ p : ℕ, Nat.Prime p → MixedCharZero R p → P) : P :=
  by
  cases' CharP.exists R with p p_char
  by_cases p = 0
  · rw [h] at p_char
    skip
    -- make `p_char : char_p R 0` an instance.
    haveI h0 : CharZero R := CharP.charP_to_charZero R
    exact split_equal_mixed_char R h_equal h_mixed
  exact h_pos p h p_char
#align split_by_characteristic split_by_characteristic

/-- In a `is_domain R`, split any `Prop` over `R` into the three cases:
- *prime* characteristic.
- equal characteristic zero.
- mixed characteristic `(0, p)`.
-/
theorem split_by_characteristic_domain [IsDomain R] (h_pos : ∀ p : ℕ, Nat.Prime p → CharP R p → P)
    (h_equal : Algebra ℚ R → P) (h_mixed : ∀ p : ℕ, Nat.Prime p → MixedCharZero R p → P) : P :=
  by
  refine' split_by_characteristic R _ h_equal h_mixed
  intro p p_pos p_char
  have p_prime : Nat.Prime p := or_iff_not_imp_right.mp (CharP.char_is_prime_or_zero R p) p_pos
  exact h_pos p p_prime p_char
#align split_by_characteristic_domain split_by_characteristic_domain

/-- In a `local_ring R`, split any `Prop` over `R` into the three cases:
- *prime power* characteristic.
- equal characteristic zero.
- mixed characteristic `(0, p)`.
-/
theorem split_by_characteristic_localRing [LocalRing R]
    (h_pos : ∀ p : ℕ, IsPrimePow p → CharP R p → P) (h_equal : Algebra ℚ R → P)
    (h_mixed : ∀ p : ℕ, Nat.Prime p → MixedCharZero R p → P) : P :=
  by
  refine' split_by_characteristic R _ h_equal h_mixed
  intro p p_pos p_char
  have p_ppow : IsPrimePow (p : ℕ) := or_iff_not_imp_left.mp (charP_zero_or_prime_power R p) p_pos
  exact h_pos p p_ppow p_char
#align split_by_characteristic_local_ring split_by_characteristic_localRing

end MainStatements


-- La_igualdad_de_valores_es_una_relacion_de_equivalencia.lean
-- La igualdad de valores es una relación de equivalencia
-- José A. Alonso Jiménez
-- Sevilla, 19 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Sean X e Y dos conjuntos y f una función de X en Y. Se define la
-- relación R en X de forma que x está relacionado con y si f(x) = f(y).
--
-- Demostrar que R es una relación de equivalencia.
-- ---------------------------------------------------------------------

import tactic

universe u
variables {X Y : Type u}
variable  (f : X → Y)

def R (x y : X) := f x = f y

-- 1ª demostración
example : equivalence (R f) :=
begin
  unfold equivalence,
  repeat { split },
  { unfold reflexive,
    intro x,
    unfold R, },
  { unfold symmetric,
    intros x y hxy,
    unfold R,
    exact symm hxy, },
  { unfold transitive,
    unfold R,
    intros x y z hxy hyz,
    exact eq.trans hxy hyz, },
end

-- 2ª demostración
example : equivalence (R f) :=
begin
  repeat { split },
  { intro x,
    exact rfl, },
  { intros x y hxy,
    exact eq.symm hxy, },
  { intros x y z hxy hyz,
    exact eq.trans hxy hyz, },
end

-- 3ª demostración
example : equivalence (R f) :=
begin
  repeat { split },
  { exact λ x, rfl, },
  { exact λ x y hxy, eq.symm hxy, },
  { exact λ x y z hxy hyz, eq.trans hxy hyz, },
end

-- 4ª demostración
example : equivalence (R f) :=
⟨λ x, rfl,
 λ x y hxy, eq.symm hxy,
 λ x y z hxy hyz, eq.trans hxy hyz⟩


import facts.nnreal

/-!
# Explicit formulas for the constants used in Proposition 9.6 of Analytic.pdf
-/

open_locale nnreal

namespace system_of_double_complexes
namespace normed_spectral

/-- `ε m K` is a sequence of nonnegative real constants,
depending on a natural number `m` and a nonnegative real number `K`.
It is defined recursively, via `ε 0 K = (2 * K)⁻¹` and `ε (m+1) K = ε m (K^3 + K)`. -/
noncomputable def ε : Π (m : ℕ) (K : ℝ≥0), ℝ≥0
| 0     K := (2 * K)⁻¹
| (m+1) K := ε m (K * (K * K + 1))

/-- The number `ε m K` is always positive. -/
lemma ε_pos : ∀ m K [fact (0 < K)], 0 < ε m K
| 0     K hK := nnreal.inv_pos.mpr (mul_pos zero_lt_two hK.out)
| (m+1) K hK := by { dsimp [ε], exactI ε_pos m _ }

/-- `k₀ m k` is a sequence of nonnegative real constants,
depending on a natural number `m` and a nonnegative real number `k`.
It is defined recursively, via `k₀ 0 k = k` and `k₀ (m+1) k = k₀ m (k^3)`. -/
def k₀ : Π (m : ℕ) (k : ℝ≥0), ℝ≥0
| 0     k := k
| (m+1) k := k₀ m (k * k * k)

/-- We have `1 ≤ k₀ m k` whenever `1 ≤ k` holds. -/
instance one_le_k₀ : ∀ m k [fact (1 ≤ k)], fact (1 ≤ k₀ m k)
| 0     k hk := hk
| (m+1) k hk := by { dsimp [k₀], exactI one_le_k₀ m _ }

/-- `K₀ m k` is a sequence of nonnegative real constants,
depending on a natural number `m` and a nonnegative real number `K`.
It is defined recursively, via `K₀ 0 K = K` and `K₀ (m+1) K = K₀ m (K^3 + K)`. -/
def K₀ : Π (m : ℕ) (K : ℝ≥0), ℝ≥0
| 0     K := K
| (m+1) K := K₀ m (K * (K * K + 1))

/-- We have `1 ≤ K₀ m K` whenever `1 ≤ K` holds. -/
instance one_le_K₀ : ∀ m K [fact (1 ≤ K)], fact (1 ≤ K₀ m K)
| 0     K hK := hK
| (m+1) K hK := by { dsimp [K₀], exactI one_le_K₀ m _ }

end normed_spectral
end system_of_double_complexes


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

import analysis.special_functions.integrals
import analysis.special_functions.pow
import measure_theory.integral.integral_eq_improper
import measure_theory.integral.layercake
import tactic.positivity

/-!
# Japanese Bracket
In this file, we show that Japanese bracket $(1 + \|x\|^2)^{1/2}$ can be estimated from above
and below by $1 + \|x\|$.
The functions $(1 + \|x\|^2)^{-r/2}$ and $(1 + |x|)^{-r}$ are integrable provided that `r` is larger
than the dimension.
## Main statements
* `integrable_one_add_norm`: the function $(1 + |x|)^{-r}$ is integrable
* `integrable_jap` the Japanese bracket is integrable
-/

noncomputable theory

open_locale big_operators nnreal filter topological_space ennreal

open asymptotics filter set real measure_theory finite_dimensional

variables {E : Type*} [normed_add_comm_group E]

lemma sqrt_one_add_norm_sq_le (x : E) : real.sqrt (1 + ∥x∥^2) ≤ 1 + ∥x∥ := sorry

lemma one_add_norm_le_sqrt_two_mul_sqrt (x : E) : 1 + ∥x∥ ≤ (real.sqrt 2) * sqrt (1 + ∥x∥^2) := sorry

lemma rpow_neg_one_add_norm_sq_le {r : ℝ} (x : E) (hr : 0 < r) :
  (1 + ∥x∥^2)^(-r/2) ≤ 2^(r/2) * (1 + ∥x∥)^(-r) := sorry

lemma le_rpow_one_add_norm_iff_norm_le {r t : ℝ} (hr : 0 < r) (ht : 0 < t) (x : E) :
  t ≤ (1 + ∥x∥) ^ -r ↔ ∥x∥ ≤ t ^ -r⁻¹ - 1 := sorry

variables (E)

lemma closed_ball_rpow_sub_one_eq_empty_aux {r t : ℝ} (hr : 0 < r) (ht : 1 < t) :
  metric.closed_ball (0 : E) (t^(-r⁻¹) - 1) = ∅ := sorry

variables [normed_space ℝ E] [finite_dimensional ℝ E]

variables {E}

lemma finite_integral_rpow_sub_one_pow_aux {r : ℝ} (n : ℕ) (hnr : (n : ℝ) < r) :
  ∫⁻ (x : ℝ) in Ioc 0 1, ennreal.of_real ((x ^ -r⁻¹ - 1) ^ n) < ∞ := sorry

lemma finite_integral_one_add_norm [measure_space E] [borel_space E]
  [(@volume E _).is_add_haar_measure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) :
  ∫⁻ (x : E), ennreal.of_real ((1 + ∥x∥) ^ -r) < ∞ := sorry

lemma integrable_rpow_neg_one_add_norm [measure_space E] [borel_space E] [(@volume E _).is_add_haar_measure]
  {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) :
  integrable (λ (x : E), (1 + ∥x∥) ^ -r) := sorry

lemma mem_ℒp_rpow_neg_one_add_norm [measure_space E] [borel_space E]
  [(@volume E _).is_add_haar_measure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) :
  mem_ℒp (λ (x : E), (1 + ∥x∥) ^ -r) 1 :=
begin
  rw mem_ℒp_one_iff_integrable,
  exact integrable_rpow_neg_one_add_norm hnr,
end

lemma integrable_rpow_neg_one_add_norm_sq [measure_space E] [borel_space E]
  [(@volume E _).is_add_haar_measure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) :
  integrable (λ (x : E), (1 + ∥x∥^2) ^ (-r/2)) := sorry

lemma mem_ℒp_rpow_neg_one_add_norm_sq [measure_space E] [borel_space E]
  [(@volume E _).is_add_haar_measure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) :
  mem_ℒp (λ (x : E), (1 + ∥x∥^2) ^ (-r/2)) 1 :=
begin
  rw mem_ℒp_one_iff_integrable,
  exact integrable_rpow_neg_one_add_norm_sq hnr,
end


namespace xena

-- This file is for undergraduate mathematicians who want to see the
-- proof that one of the axioms that Lean uses to define a group
-- actually follows from the others!

-- Lean's definition of a group has a spare axiom and here's the proof.

-- G comes with notation * (group law) 1 (identiy) and a⁻¹ (inverse)
-- mul : G → G → G := λ g h, g * h
-- one : G := 1
-- inv : G → G := λ a, a⁻¹

constants {G : Type}
variables [has_mul G] [has_one G] [has_inv G]
-- using constants seemed to break type class inference

constants
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

-- if I use (a b c : G) I end up with _s everywhere in the calc proof
-- that I don't know how to avoid.

-- This comes out nicely
lemma mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c :=
-- term proof
λ (a b c : G) (Habac : a * b = a * c),
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw mul_left_inv
    ... = a⁻¹ * (a * b) : by rw mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw mul_assoc
    ... = 1 * c         : by rw mul_left_inv
                ... = c : by rw one_mul

-- the calc proof is explicit, and Lean's unification algorithm is
-- sufficiently smart that at each stage we just have to say which
-- axiom we're using, and now exactly how we use it.

theorem group'.mul_one : ∀ (a : G), a * 1 = a :=
-- tactic proof
begin
intro a, -- goal now a * 1 = a
 apply mul_left_cancel a⁻¹, -- goal now a⁻¹ * (a * 1) = a⁻¹ * a
 -- we could finish with a calc proof like above, but here's a tactic proof
 rw [←mul_assoc,mul_left_inv,one_mul],
end

#exit
-- thoughts about canonical isomorphism
import data.equiv
theorem group'_canonically_isomorphic_to_group (G : Type) : equiv [group' G] [group G] :=
⟨_,_,_,_⟩


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.inner_product_space.pi_L2
import combinatorics.additive.salem_spencer
import combinatorics.pigeonhole
import data.complex.exponential_bounds

/-!
# Behrend's bound on Roth numbers

This file proves Behrend's lower bound on Roth numbers. This says that we can find a subset of
`{1, ..., n}` of size `n / exp (O (sqrt (log n)))` which does not contain arithmetic progressions of
length `3`.

The idea is that the sphere (in the `n` dimensional Euclidean space) doesn't contain arithmetic
progressions (literally) because the corresponding ball is strictly convex. Thus we can take
integer points on that sphere and map them onto `ℕ` in a way that preserves arithmetic progressions
(`behrend.map`).

## Main declarations

* `behrend.sphere`: The intersection of the Euclidean sphere with the positive integer quadrant.
  This is the set that we will map on `ℕ`.
* `behrend.map`: Given a natural number `d`, `behrend.map d : ℕⁿ → ℕ` reads off the coordinates as
  digits in base `d`.
* `behrend.card_sphere_le_roth_number_nat`: Implicit lower bound on Roth numbers in terms of
  `behrend.sphere`.
* `behrend.roth_lower_bound`: Behrend's explicit lower bound on Roth numbers.

## References

* [Bryan Gillespie, *Behrend’s Construction*]
  (http://www.epsilonsmall.com/resources/behrends-construction/behrend.pdf)
* Behrend, F. A., "On sets of integers which contain no three terms in arithmetical progression"
* [Wikipedia, *Salem-Spencer set*](https://en.wikipedia.org/wiki/Salem–Spencer_set)

## Tags

Salem-Spencer, Behrend construction, arithmetic progression, sphere, strictly convex
-/

open finset nat (hiding log) real
open_locale big_operators pointwise

namespace behrend
variables {α β : Type*} {n d k N : ℕ} {x : fin n → ℕ}

/-!
### Turning the sphere into a Salem-Spencer set

We define `behrend.sphere`, the intersection of the $$L^2$$ sphere with the positive quadrant of
integer points. Because the $$L^2$$ closed ball is strictly convex, the $$L^2$$ sphere and
`behrend.sphere` are Salem-Spencer (`add_salem_spencer_sphere`). Then we can turn this set in
`fin n → ℕ` into a set in `ℕ` using `behrend.map`, which preserves `add_salem_spencer` because it is
an additive monoid homomorphism.
-/

/-- The box `{0, ..., d - 1}^n` as a finset. -/
def box (n d : ℕ) : finset (fin n → ℕ) := fintype.pi_finset $ λ _, range d

lemma mem_box : x ∈ box n d ↔ ∀ i, x i < d := by simp only [box, fintype.mem_pi_finset, mem_range]

@[simp] lemma card_box : (box n d).card = d ^ n := by simp [box]
@[simp] lemma box_zero : box (n + 1) 0 = ∅ := by simp [box]

/-- The intersection of the sphere of radius `sqrt k` with the integer points in the positive
quadrant. -/
def sphere (n d k : ℕ) : finset (fin n → ℕ) := (box n d).filter $ λ x, ∑ i, x i^2 = k

lemma sphere_zero_subset : sphere n d 0 ⊆ 0 :=
λ x, by simp [sphere, function.funext_iff] {contextual := tt}

@[simp] lemma sphere_zero_right (n k : ℕ) : sphere (n + 1) 0 k = ∅ := by simp [sphere]

lemma sphere_subset_box : sphere n d k ⊆ box n d := filter_subset _ _

lemma norm_of_mem_sphere {x : fin n → ℕ} (hx : x ∈ sphere n d k) :
  ‖(pi_Lp.equiv 2 _).symm (coe ∘ x : fin n → ℝ)‖ = sqrt k :=
begin
  rw euclidean_space.norm_eq,
  dsimp,
  simp_rw [abs_cast, ←cast_pow, ←cast_sum, (mem_filter.1 hx).2],
end

lemma sphere_subset_preimage_metric_sphere :
  (sphere n d k : set (fin n → ℕ)) ⊆
    (λ x : fin n → ℕ, (pi_Lp.equiv 2 _).symm (coe ∘ x : fin n → ℝ)) ⁻¹'
      metric.sphere (0 : pi_Lp 2 (λ _ : fin n, ℝ)) (sqrt k) :=
λ x hx, by rw [set.mem_preimage, mem_sphere_zero_iff_norm, norm_of_mem_sphere hx]

/-- The map that appears in Behrend's bound on Roth numbers. -/
@[simps] def map (d : ℕ) : (fin n → ℕ) →+ ℕ :=
{ to_fun := λ a, ∑ i, a i * d ^ (i : ℕ),
  map_zero' := by simp_rw [pi.zero_apply, zero_mul, sum_const_zero],
  map_add' := λ a b, by simp_rw [pi.add_apply, add_mul, sum_add_distrib] }

@[simp] lemma map_zero (d : ℕ) (a : fin 0 → ℕ) : map d a = 0 := by simp [map]

lemma map_succ (a : fin (n + 1) → ℕ) : map d a = a 0 + (∑ x : fin n, a x.succ * d ^ (x : ℕ)) * d :=
by simp [map, fin.sum_univ_succ, pow_succ', ←mul_assoc, ←sum_mul]

lemma map_succ' (a : fin (n + 1) → ℕ) : map d a = a 0 + map d (a ∘ fin.succ) * d := map_succ _

lemma map_monotone (d : ℕ) : monotone (map d : (fin n → ℕ) → ℕ) :=
λ x y h, by { dsimp, exact sum_le_sum (λ i _, nat.mul_le_mul_right _ $ h i) }

lemma map_mod (a : fin n.succ → ℕ) : map d a % d = a 0 % d :=
by rw [map_succ, nat.add_mul_mod_self_right]

lemma map_eq_iff {x₁ x₂ : fin n.succ → ℕ} (hx₁ : ∀ i, x₁ i < d) (hx₂ : ∀ i, x₂ i < d) :
  map d x₁ = map d x₂ ↔ x₁ 0 = x₂ 0 ∧ map d (x₁ ∘ fin.succ) = map d (x₂ ∘ fin.succ) :=
begin
  refine ⟨λ h, _, λ h, by rw [map_succ', map_succ', h.1, h.2]⟩,
  have : x₁ 0 = x₂ 0,
  { rw [←mod_eq_of_lt (hx₁ _), ←map_mod, ←mod_eq_of_lt (hx₂ _), ←map_mod, h] },
  rw [map_succ, map_succ, this, add_right_inj, mul_eq_mul_right_iff] at h,
  exact ⟨this, h.resolve_right (pos_of_gt (hx₁ 0)).ne'⟩,
end

lemma map_inj_on : {x : fin n → ℕ | ∀ i, x i < d}.inj_on (map d) :=
begin
  intros x₁ hx₁ x₂ hx₂ h,
  induction n with n ih,
  { simp },
  ext i,
  have x := (map_eq_iff hx₁ hx₂).1 h,
  refine fin.cases x.1 (congr_fun $ ih (λ _, _) (λ _, _) x.2) i,
  { exact hx₁ _ },
  { exact hx₂ _ }
end

lemma map_le_of_mem_box (hx : x ∈ box n d) :
  map (2 * d - 1) x ≤ ∑ i : fin n, (d - 1) * (2 * d - 1) ^ (i : ℕ) :=
map_monotone (2 * d - 1) $ λ _, nat.le_pred_of_lt $ mem_box.1 hx _

lemma add_salem_spencer_sphere : add_salem_spencer (sphere n d k : set (fin n → ℕ)) :=
begin
  set f : (fin n → ℕ) →+ euclidean_space ℝ (fin n) :=
  { to_fun := λ f, (coe : ℕ → ℝ) ∘ f,
    map_zero' := funext $ λ _, cast_zero,
    map_add' := λ _ _, funext $ λ _, cast_add _ _ },
  refine add_salem_spencer.of_image (f.to_add_freiman_hom (sphere n d k) 2) _ _,
  { exact cast_injective.comp_left.inj_on _ },
  refine (add_salem_spencer_sphere 0 $ sqrt k).mono (set.image_subset_iff.2 $ λ x, _),
  rw [set.mem_preimage, mem_sphere_zero_iff_norm],
  exact norm_of_mem_sphere,
end

lemma add_salem_spencer_image_sphere :
  add_salem_spencer ((sphere n d k).image (map (2 * d - 1)) : set ℕ) :=
begin
  rw coe_image,
  refine @add_salem_spencer.image _ (fin n → ℕ) ℕ _ _ (sphere n d k) _ (map (2 * d - 1))
   (map_inj_on.mono _) add_salem_spencer_sphere,
  rw set.add_subset_iff,
  rintro a ha b hb i,
  have hai := mem_box.1 (sphere_subset_box ha) i,
  have hbi := mem_box.1 (sphere_subset_box hb) i,
  rw [lt_tsub_iff_right, ←succ_le_iff, two_mul],
  exact (add_add_add_comm _ _ 1 1).trans_le (add_le_add hai hbi),
end

lemma sum_sq_le_of_mem_box (hx : x ∈ box n d) : ∑ i : fin n, (x i)^2 ≤ n * (d - 1)^2 :=
begin
  rw mem_box at hx,
  have : ∀ i, x i ^ 2 ≤ (d - 1) ^ 2 := λ i, nat.pow_le_pow_of_le_left (nat.le_pred_of_lt (hx i)) _,
  exact (sum_le_card_nsmul univ _ _ $ λ i _, this i).trans (by rw [card_fin, smul_eq_mul]),
end

lemma sum_eq : ∑ i : fin n, d * (2 * d + 1) ^ (i : ℕ) = ((2 * d + 1) ^ n - 1) / 2 :=
begin
  refine (nat.div_eq_of_eq_mul_left zero_lt_two _).symm,
  rw [←sum_range (λ i, d * (2 * d + 1) ^ (i : ℕ)), ←mul_sum, mul_right_comm,  mul_comm d,
    ←geom_sum_mul_add, add_tsub_cancel_right, mul_comm],
end

lemma sum_lt : ∑ i : fin n, d * (2 * d + 1) ^ (i : ℕ) < (2 * d + 1) ^ n :=
sum_eq.trans_lt $ (nat.div_le_self _ 2).trans_lt $ pred_lt (pow_pos (succ_pos _) _).ne'

lemma card_sphere_le_roth_number_nat (n d k : ℕ) :
  (sphere n d k).card ≤ roth_number_nat ((2 * d - 1) ^ n) :=
begin
  cases n,
  { refine (card_le_univ _).trans_eq _,
    rw pow_zero,
    exact fintype.card_unique },
  cases d,
  { simp },
  refine add_salem_spencer_image_sphere.le_roth_number_nat _ _ (card_image_of_inj_on _),
  { simp only [subset_iff, mem_image, and_imp, forall_exists_index, mem_range,
      forall_apply_eq_imp_iff₂, sphere, mem_filter],
    rintro _ x hx _ rfl,
    exact (map_le_of_mem_box hx).trans_lt sum_lt },
  refine map_inj_on.mono (λ x, _),
  simp only [mem_coe, sphere, mem_filter, mem_box, and_imp, two_mul],
  exact λ h _ i, (h i).trans_le le_self_add,
end

/-!
### Optimization

Now that we know how to turn the integer points of any sphere into a Salem-Spencer set, we find a
sphere containing many integer points by the pigeonhole principle. This gives us an implicit bound
that we then optimize by tweaking the parameters. The (almost) optimal parameters are
`behrend.n_value` and `behrend.d_value`.
-/

lemma exists_large_sphere_aux (n d : ℕ) :
  ∃ k ∈ range (n * (d - 1)^2 + 1), (↑(d ^ n) / (↑(n * (d - 1)^2) + 1) : ℝ) ≤ (sphere n d k).card :=
begin
  refine exists_le_card_fiber_of_nsmul_le_card_of_maps_to (λ x hx, _) nonempty_range_succ _,
  { rw [mem_range, lt_succ_iff],
    exact sum_sq_le_of_mem_box hx },
  { rw [card_range, _root_.nsmul_eq_mul, mul_div_assoc', cast_add_one, mul_div_cancel_left,
      card_box],
    exact (cast_add_one_pos _).ne' }
end

lemma exists_large_sphere (n d : ℕ) : ∃ k, (d ^ n / ↑(n * d^2) : ℝ) ≤ (sphere n d k).card :=
begin
  obtain ⟨k, -, hk⟩ := exists_large_sphere_aux n d,
  refine ⟨k, _⟩,
  obtain rfl | hn := n.eq_zero_or_pos,
  { simp },
  obtain rfl | hd := d.eq_zero_or_pos,
  { simp },
  rw ←cast_pow,
  refine (div_le_div_of_le_left _ _ _).trans hk,
  { exact cast_nonneg _ },
  { exact cast_add_one_pos _ },
  simp only [←le_sub_iff_add_le', cast_mul, ←mul_sub, cast_pow, cast_sub hd, sub_sq,
    one_pow, cast_one, mul_one, sub_add, sub_sub_self],
  apply one_le_mul_of_one_le_of_one_le,
  { rwa one_le_cast },
  rw le_sub_iff_add_le,
  norm_num,
  exact one_le_cast.2 hd,
end

lemma bound_aux' (n d : ℕ) : (d ^ n / ↑(n * d^2) : ℝ) ≤ roth_number_nat ((2 * d - 1)^n) :=
let ⟨k, h⟩ := exists_large_sphere n d in h.trans $ cast_le.2 $ card_sphere_le_roth_number_nat _ _ _

lemma bound_aux (hd : d  ≠ 0) (hn : 2 ≤ n) :
  (d ^ (n - 2) / n : ℝ) ≤ roth_number_nat ((2 * d - 1)^n) :=
begin
  convert bound_aux' n d using 1,
  rw [cast_mul, cast_pow, mul_comm, ←div_div, pow_sub₀ _ _ hn, ←div_eq_mul_inv],
  rwa cast_ne_zero,
end

open_locale filter topology
open real

section numerical_bounds

lemma log_two_mul_two_le_sqrt_log_eight : log 2 * 2 ≤ sqrt (log 8) :=
begin
  rw [show (8 : ℝ) = 2 ^ ((3 : ℕ) : ℝ), by norm_num1, log_rpow zero_lt_two (3:ℕ)],
  apply le_sqrt_of_sq_le,
  rw [mul_pow, sq (log 2), mul_assoc, mul_comm],
  refine mul_le_mul_of_nonneg_right _ (log_nonneg one_le_two),
  rw ←le_div_iff,
  apply log_two_lt_d9.le.trans,
  all_goals { norm_num1 }
end

lemma two_div_one_sub_two_div_e_le_eight : 2 / (1 - 2 / exp 1) ≤ 8 :=
begin
  rw [div_le_iff, mul_sub, mul_one, mul_div_assoc', le_sub_comm, div_le_iff (exp_pos _)],
  { linarith [exp_one_gt_d9] },
  rw [sub_pos, div_lt_one];
  exact exp_one_gt_d9.trans' (by norm_num),
end

lemma le_sqrt_log (hN : 4096 ≤ N) : log (2 / (1 - 2 / exp 1)) * (69 / 50) ≤ sqrt (log ↑N) :=
begin
  have : ((12 : ℕ) : ℝ) * log 2 ≤ log N,
  { rw [←log_rpow zero_lt_two, log_le_log, rpow_nat_cast],
    { norm_num1,
      exact_mod_cast hN },
    { exact rpow_pos_of_pos zero_lt_two _ },
    rw cast_pos,
    exact hN.trans_lt' (by norm_num1) },
  refine (mul_le_mul_of_nonneg_right ((log_le_log _ $ by norm_num1).2
    two_div_one_sub_two_div_e_le_eight) $ by norm_num1).trans (_),
  { refine div_pos zero_lt_two _,
    rw [sub_pos, div_lt_one (exp_pos _)],
    exact exp_one_gt_d9.trans_le' (by norm_num1) },
  have l8 : log 8 = (3 : ℕ) * log 2,
  { rw [←log_rpow zero_lt_two, rpow_nat_cast],
    norm_num },
  rw [l8, cast_bit1, cast_one],
  apply le_sqrt_of_sq_le (le_trans _ this),
  simp only [cast_bit0, cast_bit1, cast_one],
  rw [mul_right_comm, mul_pow, sq (log 2), ←mul_assoc],
  apply mul_le_mul_of_nonneg_right _ (log_nonneg one_le_two),
  rw ←le_div_iff' ,
  { exact log_two_lt_d9.le.trans (by norm_num1) },
  exact sq_pos_of_ne_zero _ (by norm_num1),
end

lemma exp_neg_two_mul_le {x : ℝ} (hx : 0 < x) : exp (-2 * x) < exp (2 - ⌈x⌉₊) / ⌈x⌉₊ :=
begin
  have h₁ := ceil_lt_add_one hx.le,
  have h₂ : 1 - x ≤ 2 - ⌈x⌉₊,
  { rw le_sub_iff_add_le,
    apply (add_le_add_left h₁.le _).trans_eq,
    rw [←add_assoc, sub_add_cancel],
    refl },
  have h₃ : exp (-(x+1)) ≤ 1 / (x + 1),
  { rw [exp_neg, inv_eq_one_div],
    refine one_div_le_one_div_of_le (add_pos hx zero_lt_one) _,
    apply le_trans _ (add_one_le_exp_of_nonneg $ add_nonneg hx.le zero_le_one),
    exact le_add_of_nonneg_right zero_le_one },
  refine lt_of_le_of_lt _ (div_lt_div_of_lt_left (exp_pos _) (cast_pos.2 $ ceil_pos.2 hx) h₁),
  refine le_trans _ (div_le_div_of_le_of_nonneg (exp_le_exp.2 h₂) $ add_nonneg hx.le zero_le_one),
  rw [le_div_iff (add_pos hx zero_lt_one), ←le_div_iff' (exp_pos _), ←exp_sub, neg_mul,
    sub_neg_eq_add, two_mul, sub_add_add_cancel, add_comm _ x],
  refine le_trans _ (add_one_le_exp_of_nonneg $ add_nonneg hx.le zero_le_one),
  exact le_add_of_nonneg_right zero_le_one,
end

lemma div_lt_floor {x : ℝ} (hx : 2 / (1 - 2 / exp 1) ≤ x) : x / exp 1 < (⌊x/2⌋₊ : ℝ) :=
begin
  apply lt_of_le_of_lt _ (sub_one_lt_floor _),
  have : 0 < 1 - 2 / exp 1,
  { rw [sub_pos, div_lt_one (exp_pos _)],
    exact lt_of_le_of_lt (by norm_num) exp_one_gt_d9 },
  rwa [le_sub_comm, div_eq_mul_one_div x, div_eq_mul_one_div x, ←mul_sub, div_sub',
    ←div_eq_mul_one_div, mul_div_assoc', one_le_div, ←div_le_iff this],
  { exact zero_lt_two },
  { exact two_ne_zero }
end

lemma ceil_lt_mul {x : ℝ} (hx : 50/19 ≤ x) : (⌈x⌉₊ : ℝ) < 1.38 * x :=
begin
  refine (ceil_lt_add_one $ hx.trans' $ by norm_num).trans_le _,
  rwa [←le_sub_iff_add_le', ←sub_one_mul, show (69/50 - 1 : ℝ) = (50/19)⁻¹, by norm_num1,
    ←div_eq_inv_mul, one_le_div],
  norm_num1,
end

end numerical_bounds

/-- The (almost) optimal value of `n` in `behrend.bound_aux`. -/
noncomputable def n_value (N : ℕ) : ℕ := ⌈sqrt (log N)⌉₊

/-- The (almost) optimal value of `d` in `behrend.bound_aux`. -/
noncomputable def d_value (N : ℕ) : ℕ := ⌊(N : ℝ)^(1 / n_value N : ℝ)/2⌋₊

lemma n_value_pos (hN : 2 ≤ N) : 0 < n_value N :=
ceil_pos.2 $ real.sqrt_pos.2 $ log_pos $ one_lt_cast.2 $ hN

lemma two_le_n_value (hN : 3 ≤ N) : 2 ≤ n_value N :=
begin
  refine succ_le_of_lt (lt_ceil.2 $ lt_sqrt_of_sq_lt _),
  rw [cast_one, one_pow, lt_log_iff_exp_lt],
  refine lt_of_lt_of_le _ (cast_le.2 hN),
  { exact exp_one_lt_d9.trans_le (by norm_num) },
  rw cast_pos,
  exact (zero_lt_succ _).trans_le hN,
end

lemma three_le_n_value (hN : 64 ≤ N) : 3 ≤ n_value N :=
begin
  rw [n_value, ←lt_iff_add_one_le, lt_ceil, cast_two],
  apply lt_sqrt_of_sq_lt,
  have : (2 : ℝ)^((6 : ℕ) : ℝ) ≤ N,
  { rw rpow_nat_cast,
    exact (cast_le.2 hN).trans' (by norm_num1) },
  apply lt_of_lt_of_le _ ((log_le_log (rpow_pos_of_pos zero_lt_two _) _).2 this),
  rw [log_rpow zero_lt_two, cast_bit0, cast_bit1, cast_one, ←div_lt_iff'],
  { exact log_two_gt_d9.trans_le' (by norm_num1) },
  { norm_num1 },
  rw cast_pos,
  exact hN.trans_lt' (by norm_num1),
end

lemma d_value_pos (hN₃ : 8 ≤ N) : 0 < d_value N :=
begin
  have hN₀ : 0 < (N : ℝ) := cast_pos.2 (succ_pos'.trans_le hN₃),
  rw [d_value, floor_pos, ←log_le_log zero_lt_one, log_one, log_div _ two_ne_zero, log_rpow hN₀,
    div_mul_eq_mul_div, one_mul, sub_nonneg, le_div_iff],
  { have : (n_value N : ℝ) ≤ 2 * sqrt (log N),
    { apply (ceil_lt_add_one $ sqrt_nonneg _).le.trans,
      rw [two_mul, add_le_add_iff_left],
      apply le_sqrt_of_sq_le,
      rw [one_pow, le_log_iff_exp_le hN₀],
      exact (exp_one_lt_d9.le.trans $ by norm_num).trans (cast_le.2 hN₃) },
    apply (mul_le_mul_of_nonneg_left this $ log_nonneg one_le_two).trans _,
    rw [←mul_assoc, ←le_div_iff (real.sqrt_pos.2 $ log_pos $ one_lt_cast.2 _), div_sqrt],
    { apply log_two_mul_two_le_sqrt_log_eight.trans,
      apply real.sqrt_le_sqrt,
      rw log_le_log _ hN₀,
      { exact_mod_cast hN₃ },
      { norm_num } },
    exact hN₃.trans_lt' (by norm_num) },
  { exact cast_pos.2 (n_value_pos $ hN₃.trans' $ by norm_num) },
  { exact (rpow_pos_of_pos hN₀ _).ne' },
  { exact div_pos (rpow_pos_of_pos hN₀ _) zero_lt_two },
end

lemma le_N (hN : 2 ≤ N) : (2 * (d_value N) - 1)^(n_value N) ≤ N :=
begin
  have : (2 * d_value N - 1)^(n_value N) ≤ (2 * d_value N)^(n_value N) :=
    nat.pow_le_pow_of_le_left (nat.sub_le _ _) _,
  apply this.trans,
  suffices : ((2 * d_value N)^n_value N : ℝ) ≤ N, by exact_mod_cast this,
  rw ←rpow_nat_cast,
  suffices i : (2 * d_value N : ℝ) ≤ (N : ℝ)^(1/n_value N : ℝ),
  { apply (rpow_le_rpow (mul_nonneg zero_le_two (cast_nonneg _)) i (cast_nonneg _)).trans,
    rw [←rpow_mul (cast_nonneg _), one_div_mul_cancel, rpow_one],
    rw cast_ne_zero,
    apply (n_value_pos hN).ne', },
  rw ←le_div_iff',
  { exact floor_le (div_nonneg (rpow_nonneg_of_nonneg (cast_nonneg _) _) zero_le_two) },
  apply zero_lt_two
end

lemma bound (hN : 4096 ≤ N) : (N : ℝ)^(1/n_value N : ℝ) / exp 1 < d_value N :=
begin
  apply div_lt_floor _,
  rw [←log_le_log, log_rpow, mul_comm, ←div_eq_mul_one_div],
  { apply le_trans _ (div_le_div_of_le_left _ _ (ceil_lt_mul _).le),
    rw [mul_comm, ←div_div, div_sqrt, le_div_iff],
    { exact le_sqrt_log hN },
    { norm_num1 },
    { apply log_nonneg,
      rw one_le_cast,
      exact hN.trans' (by norm_num1) },
    { rw [cast_pos, lt_ceil, cast_zero, real.sqrt_pos],
      refine log_pos _,
      rw one_lt_cast,
      exact hN.trans_lt' (by norm_num1) },
    apply le_sqrt_of_sq_le,
    have : ((12 : ℕ) : ℝ) * log 2 ≤ log N,
    { rw [←log_rpow zero_lt_two, log_le_log, rpow_nat_cast],
      { norm_num1,
        exact_mod_cast hN },
      { exact rpow_pos_of_pos zero_lt_two _ },
      rw cast_pos,
      exact hN.trans_lt' (by norm_num1) },
    refine le_trans _ this,
    simp only [cast_bit0, cast_bit1, cast_one],
    rw ←div_le_iff',
    { exact log_two_gt_d9.le.trans' (by norm_num1) },
    { norm_num1 } },
  { rw cast_pos,
    exact hN.trans_lt' (by norm_num1) },
  { refine div_pos zero_lt_two _,
    rw [sub_pos, div_lt_one (exp_pos _)],
    exact lt_of_le_of_lt (by norm_num1) exp_one_gt_d9 },
  apply rpow_pos_of_pos,
  rw cast_pos,
  exact hN.trans_lt' (by norm_num1),
end

lemma roth_lower_bound_explicit (hN : 4096 ≤ N) :
  (N : ℝ) * exp (-4 * sqrt (log N)) < roth_number_nat N :=
begin
  let n := n_value N,
  have hn : 0 < (n : ℝ) := cast_pos.2 (n_value_pos $ hN.trans' $ by norm_num1),
  have hd : 0 < d_value N := d_value_pos (hN.trans' $ by norm_num1),
  have hN₀ : 0 < (N : ℝ) := cast_pos.2 (hN.trans' $ by norm_num1),
  have hn₂ : 2 ≤ n := two_le_n_value (hN.trans' $ by norm_num1),
  have : (2 * d_value N - 1)^n ≤ N := le_N (hN.trans' $ by norm_num1),
  refine ((bound_aux hd.ne' hn₂).trans $ cast_le.2 $ roth_number_nat.mono this).trans_lt' _,
  refine (div_lt_div_of_lt hn $ pow_lt_pow_of_lt_left (bound hN) _ _).trans_le' _,
  { exact div_nonneg (rpow_nonneg_of_nonneg (cast_nonneg _) _) (exp_pos _).le },
  { exact tsub_pos_of_lt (three_le_n_value $ hN.trans' $ by norm_num1) },
  rw [←rpow_nat_cast, div_rpow (rpow_nonneg_of_nonneg hN₀.le _) (exp_pos _).le, ←rpow_mul hN₀.le,
    mul_comm (_ / _), mul_one_div, cast_sub hn₂, cast_two, same_sub_div hn.ne', exp_one_rpow,
    div_div, rpow_sub hN₀, rpow_one, div_div, div_eq_mul_inv],
  refine mul_le_mul_of_nonneg_left _ (cast_nonneg _),
  rw [mul_inv, mul_inv, ←exp_neg, ←rpow_neg (cast_nonneg _), neg_sub, ←div_eq_mul_inv],
  have : exp ((-4) * sqrt (log N)) = exp (-2 * sqrt (log N)) * exp (-2 * sqrt (log N)),
  { rw [←exp_add, ←add_mul],
    norm_num },
  rw this,
  refine (mul_le_mul _ (exp_neg_two_mul_le $ real.sqrt_pos.2 $ log_pos _).le (exp_pos _).le $
    rpow_nonneg_of_nonneg (cast_nonneg _) _),
  { rw [←le_log_iff_exp_le (rpow_pos_of_pos hN₀ _), log_rpow hN₀, ←le_div_iff, mul_div_assoc,
      div_sqrt, neg_mul, neg_le_neg_iff, div_mul_eq_mul_div, div_le_iff hn],
    { exact mul_le_mul_of_nonneg_left (le_ceil _) zero_le_two },
    refine real.sqrt_pos.2 (log_pos _),
    rw one_lt_cast,
    exact hN.trans_lt' (by norm_num1) },
  { rw one_lt_cast,
    exact hN.trans_lt' (by norm_num1) }
end

lemma exp_four_lt : exp 4 < 64 :=
begin
  rw [show (64 : ℝ) = 2 ^ ((6 : ℕ) : ℝ), by norm_num1,
    ←lt_log_iff_exp_lt (rpow_pos_of_pos zero_lt_two _), log_rpow zero_lt_two, ←div_lt_iff'],
  exact log_two_gt_d9.trans_le' (by norm_num1),
  norm_num
end

lemma four_zero_nine_six_lt_exp_sixteen : 4096 < exp 16 :=
begin
  rw [←log_lt_iff_lt_exp (show (0 : ℝ) < 4096, by norm_num), show (4096 : ℝ) = 2 ^ 12, by norm_num,
    ←rpow_nat_cast, log_rpow zero_lt_two, cast_bit0, cast_bit0, cast_bit1, cast_one],
  linarith [log_two_lt_d9],
end

lemma lower_bound_le_one' (hN : 2 ≤ N) (hN' : N ≤ 4096) : (N : ℝ) * exp (-4 * sqrt (log N)) ≤ 1 :=
begin
  rw [←log_le_log (mul_pos (cast_pos.2 (zero_lt_two.trans_le hN)) (exp_pos _)) zero_lt_one,
    log_one, log_mul (cast_pos.2 (zero_lt_two.trans_le hN)).ne' (exp_pos _).ne', log_exp,
    neg_mul, ←sub_eq_add_neg, sub_nonpos, ←div_le_iff (real.sqrt_pos.2 $ log_pos $
    one_lt_cast.2 $ one_lt_two.trans_le hN), div_sqrt, sqrt_le_left
    (zero_le_bit0.2 zero_le_two), log_le_iff_le_exp (cast_pos.2 (zero_lt_two.trans_le hN))],
  norm_num1,
  apply le_trans _ four_zero_nine_six_lt_exp_sixteen.le,
  exact_mod_cast hN',
end

lemma lower_bound_le_one (hN : 1 ≤ N) (hN' : N ≤ 4096) : (N : ℝ) * exp (-4 * sqrt (log N)) ≤ 1 :=
begin
  obtain rfl | hN := hN.eq_or_lt,
  { norm_num },
  { exact lower_bound_le_one' hN hN' }
end

lemma roth_lower_bound : (N : ℝ) * exp (-4 * sqrt (log N)) ≤ roth_number_nat N :=
begin
  obtain rfl | hN := nat.eq_zero_or_pos N,
  { norm_num },
  obtain h₁ | h₁ := le_or_lt 4096 N,
  { exact (roth_lower_bound_explicit h₁).le },
  { apply (lower_bound_le_one hN h₁.le).trans,
    simpa using roth_number_nat.monotone hN }
end

end behrend