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

! This file was ported from Lean 3 source module probability.martingale.upcrossing
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Process.HittingTime
import Mathbin.Probability.Martingale.Basic

/-!

# Doob's upcrossing estimate

Given a discrete real-valued submartingale $(f_n)_{n \in \mathbb{N}}$, denoting $U_N(a, b)$ the
number of times $f_n$ crossed from below $a$ to above $b$ before time $N$, Doob's upcrossing
estimate (also known as Doob's inequality) states that
$$(b - a) \mathbb{E}[U_N(a, b)] \le \mathbb{E}[(f_N - a)^+].$$
Doob's upcrossing estimate is an important inequality and is central in proving the martingale
convergence theorems.

## Main definitions

* `measure_theory.upper_crossing_time a b f N n`: is the stopping time corresponding to `f`
  crossing above `b` the `n`-th time before time `N` (if this does not occur then the value is
  taken to be `N`).
* `measure_theory.lower_crossing_time a b f N n`: is the stopping time corresponding to `f`
  crossing below `a` the `n`-th time before time `N` (if this does not occur then the value is
  taken to be `N`).
* `measure_theory.upcrossing_strat a b f N`: is the predictable process which is 1 if `n` is
  between a consecutive pair of lower and upper crossing and is 0 otherwise. Intuitively
  one might think of the `upcrossing_strat` as the strategy of buying 1 share whenever the process
  crosses below `a` for the first time after selling and selling 1 share whenever the process
  crosses above `b` for the first time after buying.
* `measure_theory.upcrossings_before a b f N`: is the number of times `f` crosses from below `a` to
  above `b` before time `N`.
* `measure_theory.upcrossings a b f`: is the number of times `f` crosses from below `a` to above
  `b`. This takes value in `ℝ≥0∞` and so is allowed to be `∞`.

## Main results

* `measure_theory.adapted.is_stopping_time_upper_crossing_time`: `upper_crossing_time` is a
  stopping time whenever the process it is associated to is adapted.
* `measure_theory.adapted.is_stopping_time_lower_crossing_time`: `lower_crossing_time` is a
  stopping time whenever the process it is associated to is adapted.
* `measure_theory.submartingale.mul_integral_upcrossings_before_le_integral_pos_part`: Doob's
  upcrossing estimate.
* `measure_theory.submartingale.mul_lintegral_upcrossings_le_lintegral_pos_part`: the inequality
  obtained by taking the supremum on both sides of Doob's upcrossing estimate.

### References

We mostly follow the proof from [Kallenberg, *Foundations of modern probability*][kallenberg2021]

-/

open TopologicalSpace Filter

open NNReal ENNReal MeasureTheory ProbabilityTheory BigOperators Topology

namespace MeasureTheory

variable {Ω ι : Type _} {m0 : MeasurableSpace Ω} {μ : Measure Ω}

/-!

## Proof outline

In this section, we will denote $U_N(a, b)$ the number of upcrossings of $(f_n)$ from below $a$ to
above $b$ before time $N$.

To define $U_N(a, b)$, we will construct two stopping times corresponding to when $(f_n)$ crosses
below $a$ and above $b$. Namely, we define
$$
  \sigma_n := \inf \{n \ge \tau_n \mid f_n \le a\} \wedge N;
$$
$$
  \tau_{n + 1} := \inf \{n \ge \sigma_n \mid f_n \ge b\} \wedge N.
$$
These are `lower_crossing_time` and `upper_crossing_time` in our formalization which are defined
using `measure_theory.hitting` allowing us to specify a starting and ending time.
Then, we may simply define $U_N(a, b) := \sup \{n \mid \tau_n < N\}$.

Fixing $a < b \in \mathbb{R}$, we will first prove the theorem in the special case that
$0 \le f_0$ and $a \le f_N$. In particular, we will show
$$
  (b - a) \mathbb{E}[U_N(a, b)] \le \mathbb{E}[f_N].
$$
This is `measure_theory.integral_mul_upcrossings_before_le_integral` in our formalization.

To prove this, we use the fact that given a non-negative, bounded, predictable process $(C_n)$
(i.e. $(C_{n + 1})$ is adapted), $(C \bullet f)_n := \sum_{k \le n} C_{k + 1}(f_{k + 1} - f_k)$ is
a submartingale if $(f_n)$ is.

Define $C_n := \sum_{k \le n} \mathbf{1}_{[\sigma_k, \tau_{k + 1})}(n)$. It is easy to see that
$(1 - C_n)$ is non-negative, bounded and predictable, and hence, given a submartingale $(f_n)$,
$(1 - C) \bullet f$ is also a submartingale. Thus, by the submartingale property,
$0 \le \mathbb{E}[((1 - C) \bullet f)_0] \le \mathbb{E}[((1 - C) \bullet f)_N]$ implying
$$
  \mathbb{E}[(C \bullet f)_N] \le \mathbb{E}[(1 \bullet f)_N] = \mathbb{E}[f_N] - \mathbb{E}[f_0].
$$

Furthermore,
\begin{align}
    (C \bullet f)_N & =
      \sum_{n \le N} \sum_{k \le N} \mathbf{1}_{[\sigma_k, \tau_{k + 1})}(n)(f_{n + 1} - f_n)\\
    & = \sum_{k \le N} \sum_{n \le N} \mathbf{1}_{[\sigma_k, \tau_{k + 1})}(n)(f_{n + 1} - f_n)\\
    & = \sum_{k \le N} (f_{\sigma_k + 1} - f_{\sigma_k} + f_{\sigma_k + 2} - f_{\sigma_k + 1}
      + \cdots + f_{\tau_{k + 1}} - f_{\tau_{k + 1} - 1})\\
    & = \sum_{k \le N} (f_{\tau_{k + 1}} - f_{\sigma_k})
      \ge \sum_{k < U_N(a, b)} (b - a) = (b - a) U_N(a, b)
\end{align}
where the inequality follows since for all $k < U_N(a, b)$,
$f_{\tau_{k + 1}} - f_{\sigma_k} \ge b - a$ while for all $k > U_N(a, b)$,
$f_{\tau_{k + 1}} = f_{\sigma_k} = f_N$ and
$f_{\tau_{U_N(a, b) + 1}} - f_{\sigma_{U_N(a, b)}} = f_N - a \ge 0$. Hence, we have
$$
  (b - a) \mathbb{E}[U_N(a, b)] \le \mathbb{E}[(C \bullet f)_N]
  \le \mathbb{E}[f_N] - \mathbb{E}[f_0] \le \mathbb{E}[f_N],
$$
as required.

To obtain the general case, we simply apply the above to $((f_n - a)^+)_n$.

-/

/-- `lower_crossing_time_aux a f c N` is the first time `f` reached below `a` after time `c` before
time `N`. -/
noncomputable def lowerCrossingTimeAux [Preorder ι] [InfSet ι] (a : ℝ) (f : ι → Ω → ℝ) (c N : ι) :
    Ω → ι :=
  hitting f (Set.Iic a) c N
#align measure_theory.lower_crossing_time_aux MeasureTheory.lowerCrossingTimeAux

/-- `upper_crossing_time a b f N n` is the first time before time `N`, `f` reaches
above `b` after `f` reached below `a` for the `n - 1`-th time. -/
noncomputable def upperCrossingTime [Preorder ι] [OrderBot ι] [InfSet ι] (a b : ℝ) (f : ι → Ω → ℝ)
    (N : ι) : ℕ → Ω → ι
  | 0 => ⊥
  | n + 1 => fun ω =>
    hitting f (Set.Ici b) (lowerCrossingTimeAux a f (upper_crossing_time n ω) N ω) N ω
#align measure_theory.upper_crossing_time MeasureTheory.upperCrossingTime

/-- `lower_crossing_time a b f N n` is the first time before time `N`, `f` reaches
below `a` after `f` reached above `b` for the `n`-th time. -/
noncomputable def lowerCrossingTime [Preorder ι] [OrderBot ι] [InfSet ι] (a b : ℝ) (f : ι → Ω → ℝ)
    (N : ι) (n : ℕ) : Ω → ι := fun ω => hitting f (Set.Iic a) (upperCrossingTime a b f N n ω) N ω
#align measure_theory.lower_crossing_time MeasureTheory.lowerCrossingTime

section

variable [Preorder ι] [OrderBot ι] [InfSet ι]

variable {a b : ℝ} {f : ι → Ω → ℝ} {N : ι} {n m : ℕ} {ω : Ω}

@[simp]
theorem upperCrossingTime_zero : upperCrossingTime a b f N 0 = ⊥ :=
  rfl
#align measure_theory.upper_crossing_time_zero MeasureTheory.upperCrossingTime_zero

@[simp]
theorem lowerCrossingTime_zero : lowerCrossingTime a b f N 0 = hitting f (Set.Iic a) ⊥ N :=
  rfl
#align measure_theory.lower_crossing_time_zero MeasureTheory.lowerCrossingTime_zero

theorem upperCrossingTime_succ :
    upperCrossingTime a b f N (n + 1) ω =
      hitting f (Set.Ici b) (lowerCrossingTimeAux a f (upperCrossingTime a b f N n ω) N ω) N ω :=
  by rw [upper_crossing_time]
#align measure_theory.upper_crossing_time_succ MeasureTheory.upperCrossingTime_succ

theorem upperCrossingTime_succ_eq (ω : Ω) :
    upperCrossingTime a b f N (n + 1) ω =
      hitting f (Set.Ici b) (lowerCrossingTime a b f N n ω) N ω :=
  by
  simp only [upper_crossing_time_succ]
  rfl
#align measure_theory.upper_crossing_time_succ_eq MeasureTheory.upperCrossingTime_succ_eq

end

section ConditionallyCompleteLinearOrderBot

variable [ConditionallyCompleteLinearOrderBot ι]

variable {a b : ℝ} {f : ι → Ω → ℝ} {N : ι} {n m : ℕ} {ω : Ω}

theorem upperCrossingTime_le : upperCrossingTime a b f N n ω ≤ N :=
  by
  cases n
  · simp only [upper_crossing_time_zero, Pi.bot_apply, bot_le]
  · simp only [upper_crossing_time_succ, hitting_le]
#align measure_theory.upper_crossing_time_le MeasureTheory.upperCrossingTime_le

@[simp]
theorem upperCrossingTime_zero' : upperCrossingTime a b f ⊥ n ω = ⊥ :=
  eq_bot_iff.2 upperCrossingTime_le
#align measure_theory.upper_crossing_time_zero' MeasureTheory.upperCrossingTime_zero'

theorem lowerCrossingTime_le : lowerCrossingTime a b f N n ω ≤ N := by
  simp only [lower_crossing_time, hitting_le ω]
#align measure_theory.lower_crossing_time_le MeasureTheory.lowerCrossingTime_le

theorem upperCrossingTime_le_lowerCrossingTime :
    upperCrossingTime a b f N n ω ≤ lowerCrossingTime a b f N n ω := by
  simp only [lower_crossing_time, le_hitting upper_crossing_time_le ω]
#align measure_theory.upper_crossing_time_le_lower_crossing_time MeasureTheory.upperCrossingTime_le_lowerCrossingTime

theorem lowerCrossingTime_le_upperCrossingTime_succ :
    lowerCrossingTime a b f N n ω ≤ upperCrossingTime a b f N (n + 1) ω :=
  by
  rw [upper_crossing_time_succ]
  exact le_hitting lower_crossing_time_le ω
#align measure_theory.lower_crossing_time_le_upper_crossing_time_succ MeasureTheory.lowerCrossingTime_le_upperCrossingTime_succ

theorem lowerCrossingTime_mono (hnm : n ≤ m) :
    lowerCrossingTime a b f N n ω ≤ lowerCrossingTime a b f N m ω :=
  by
  suffices Monotone fun n => lower_crossing_time a b f N n ω by exact this hnm
  exact
    monotone_nat_of_le_succ fun n =>
      le_trans lower_crossing_time_le_upper_crossing_time_succ
        upper_crossing_time_le_lower_crossing_time
#align measure_theory.lower_crossing_time_mono MeasureTheory.lowerCrossingTime_mono

theorem upperCrossingTime_mono (hnm : n ≤ m) :
    upperCrossingTime a b f N n ω ≤ upperCrossingTime a b f N m ω :=
  by
  suffices Monotone fun n => upper_crossing_time a b f N n ω by exact this hnm
  exact
    monotone_nat_of_le_succ fun n =>
      le_trans upper_crossing_time_le_lower_crossing_time
        lower_crossing_time_le_upper_crossing_time_succ
#align measure_theory.upper_crossing_time_mono MeasureTheory.upperCrossingTime_mono

end ConditionallyCompleteLinearOrderBot

variable {a b : ℝ} {f : ℕ → Ω → ℝ} {N : ℕ} {n m : ℕ} {ω : Ω}

theorem stoppedValue_lowerCrossingTime (h : lowerCrossingTime a b f N n ω ≠ N) :
    stoppedValue f (lowerCrossingTime a b f N n) ω ≤ a :=
  by
  obtain ⟨j, hj₁, hj₂⟩ :=
    (hitting_le_iff_of_lt _ (lt_of_le_of_ne lower_crossing_time_le h)).1 le_rfl
  exact stopped_value_hitting_mem ⟨j, ⟨hj₁.1, le_trans hj₁.2 lower_crossing_time_le⟩, hj₂⟩
#align measure_theory.stopped_value_lower_crossing_time MeasureTheory.stoppedValue_lowerCrossingTime

theorem stoppedValue_upperCrossingTime (h : upperCrossingTime a b f N (n + 1) ω ≠ N) :
    b ≤ stoppedValue f (upperCrossingTime a b f N (n + 1)) ω :=
  by
  obtain ⟨j, hj₁, hj₂⟩ :=
    (hitting_le_iff_of_lt _ (lt_of_le_of_ne upper_crossing_time_le h)).1 le_rfl
  exact stopped_value_hitting_mem ⟨j, ⟨hj₁.1, le_trans hj₁.2 (hitting_le _)⟩, hj₂⟩
#align measure_theory.stopped_value_upper_crossing_time MeasureTheory.stoppedValue_upperCrossingTime

theorem upperCrossingTime_lt_lowerCrossingTime (hab : a < b)
    (hn : lowerCrossingTime a b f N (n + 1) ω ≠ N) :
    upperCrossingTime a b f N (n + 1) ω < lowerCrossingTime a b f N (n + 1) ω :=
  by
  refine'
    lt_of_le_of_ne upper_crossing_time_le_lower_crossing_time fun h =>
      not_le.2 hab <| le_trans _ (stopped_value_lower_crossing_time hn)
  simp only [stopped_value]
  rw [← h]
  exact stopped_value_upper_crossing_time (h.symm ▸ hn)
#align measure_theory.upper_crossing_time_lt_lower_crossing_time MeasureTheory.upperCrossingTime_lt_lowerCrossingTime

theorem lowerCrossingTime_lt_upperCrossingTime (hab : a < b)
    (hn : upperCrossingTime a b f N (n + 1) ω ≠ N) :
    lowerCrossingTime a b f N n ω < upperCrossingTime a b f N (n + 1) ω :=
  by
  refine'
    lt_of_le_of_ne lower_crossing_time_le_upper_crossing_time_succ fun h =>
      not_le.2 hab <| le_trans (stopped_value_upper_crossing_time hn) _
  simp only [stopped_value]
  rw [← h]
  exact stopped_value_lower_crossing_time (h.symm ▸ hn)
#align measure_theory.lower_crossing_time_lt_upper_crossing_time MeasureTheory.lowerCrossingTime_lt_upperCrossingTime

theorem upperCrossingTime_lt_succ (hab : a < b) (hn : upperCrossingTime a b f N (n + 1) ω ≠ N) :
    upperCrossingTime a b f N n ω < upperCrossingTime a b f N (n + 1) ω :=
  lt_of_le_of_lt upperCrossingTime_le_lowerCrossingTime
    (lowerCrossingTime_lt_upperCrossingTime hab hn)
#align measure_theory.upper_crossing_time_lt_succ MeasureTheory.upperCrossingTime_lt_succ

theorem lowerCrossingTime_stabilize (hnm : n ≤ m) (hn : lowerCrossingTime a b f N n ω = N) :
    lowerCrossingTime a b f N m ω = N :=
  le_antisymm lowerCrossingTime_le (le_trans (le_of_eq hn.symm) (lowerCrossingTime_mono hnm))
#align measure_theory.lower_crossing_time_stabilize MeasureTheory.lowerCrossingTime_stabilize

theorem upperCrossingTime_stabilize (hnm : n ≤ m) (hn : upperCrossingTime a b f N n ω = N) :
    upperCrossingTime a b f N m ω = N :=
  le_antisymm upperCrossingTime_le (le_trans (le_of_eq hn.symm) (upperCrossingTime_mono hnm))
#align measure_theory.upper_crossing_time_stabilize MeasureTheory.upperCrossingTime_stabilize

theorem lowerCrossingTime_stabilize' (hnm : n ≤ m) (hn : N ≤ lowerCrossingTime a b f N n ω) :
    lowerCrossingTime a b f N m ω = N :=
  lowerCrossingTime_stabilize hnm (le_antisymm lowerCrossingTime_le hn)
#align measure_theory.lower_crossing_time_stabilize' MeasureTheory.lowerCrossingTime_stabilize'

theorem upperCrossingTime_stabilize' (hnm : n ≤ m) (hn : N ≤ upperCrossingTime a b f N n ω) :
    upperCrossingTime a b f N m ω = N :=
  upperCrossingTime_stabilize hnm (le_antisymm upperCrossingTime_le hn)
#align measure_theory.upper_crossing_time_stabilize' MeasureTheory.upperCrossingTime_stabilize'

-- `upper_crossing_time_bound_eq` provides an explicit bound
theorem exists_upperCrossingTime_eq (f : ℕ → Ω → ℝ) (N : ℕ) (ω : Ω) (hab : a < b) :
    ∃ n, upperCrossingTime a b f N n ω = N :=
  by
  by_contra h; push_neg  at h
  have : StrictMono fun n => upper_crossing_time a b f N n ω :=
    strictMono_nat_of_lt_succ fun n => upper_crossing_time_lt_succ hab (h _)
  obtain ⟨_, ⟨k, rfl⟩, hk⟩ :
    ∃ (m : _)(hm : m ∈ Set.range fun n => upper_crossing_time a b f N n ω), N < m :=
    ⟨upper_crossing_time a b f N (N + 1) ω, ⟨N + 1, rfl⟩,
      lt_of_lt_of_le N.lt_succ_self (StrictMono.id_le this (N + 1))⟩
  exact not_le.2 hk upper_crossing_time_le
#align measure_theory.exists_upper_crossing_time_eq MeasureTheory.exists_upperCrossingTime_eq

theorem upperCrossingTime_lt_bddAbove (hab : a < b) :
    BddAbove { n | upperCrossingTime a b f N n ω < N } :=
  by
  obtain ⟨k, hk⟩ := exists_upper_crossing_time_eq f N ω hab
  refine' ⟨k, fun n (hn : upper_crossing_time a b f N n ω < N) => _⟩
  by_contra hn'
  exact hn.ne (upper_crossing_time_stabilize (not_le.1 hn').le hk)
#align measure_theory.upper_crossing_time_lt_bdd_above MeasureTheory.upperCrossingTime_lt_bddAbove

theorem upperCrossingTime_lt_nonempty (hN : 0 < N) :
    { n | upperCrossingTime a b f N n ω < N }.Nonempty :=
  ⟨0, hN⟩
#align measure_theory.upper_crossing_time_lt_nonempty MeasureTheory.upperCrossingTime_lt_nonempty

theorem upperCrossingTime_bound_eq (f : ℕ → Ω → ℝ) (N : ℕ) (ω : Ω) (hab : a < b) :
    upperCrossingTime a b f N N ω = N :=
  by
  by_cases hN' : N < Nat.find (exists_upper_crossing_time_eq f N ω hab)
  · refine' le_antisymm upper_crossing_time_le _
    have hmono :
      StrictMonoOn (fun n => upper_crossing_time a b f N n ω)
        (Set.Iic (Nat.find (exists_upper_crossing_time_eq f N ω hab)).pred) :=
      by
      refine' strictMonoOn_Iic_of_lt_succ fun m hm => upper_crossing_time_lt_succ hab _
      rw [Nat.lt_pred_iff] at hm
      convert Nat.find_min _ hm
    convert StrictMonoOn.Iic_id_le hmono N (Nat.le_pred_of_lt hN')
  · rw [not_lt] at hN'
    exact
      upper_crossing_time_stabilize hN' (Nat.find_spec (exists_upper_crossing_time_eq f N ω hab))
#align measure_theory.upper_crossing_time_bound_eq MeasureTheory.upperCrossingTime_bound_eq

theorem upperCrossingTime_eq_of_bound_le (hab : a < b) (hn : N ≤ n) :
    upperCrossingTime a b f N n ω = N :=
  le_antisymm upperCrossingTime_le
    (le_trans (upperCrossingTime_bound_eq f N ω hab).symm.le (upperCrossingTime_mono hn))
#align measure_theory.upper_crossing_time_eq_of_bound_le MeasureTheory.upperCrossingTime_eq_of_bound_le

variable {ℱ : Filtration ℕ m0}

theorem Adapted.isStoppingTime_crossing (hf : Adapted ℱ f) :
    IsStoppingTime ℱ (upperCrossingTime a b f N n) ∧
      IsStoppingTime ℱ (lowerCrossingTime a b f N n) :=
  by
  induction' n with k ih
  · refine' ⟨is_stopping_time_const _ 0, _⟩
    simp [hitting_is_stopping_time hf measurableSet_Iic]
  · obtain ⟨ih₁, ih₂⟩ := ih
    have : is_stopping_time ℱ (upper_crossing_time a b f N (k + 1)) :=
      by
      intro n
      simp_rw [upper_crossing_time_succ_eq]
      exact
        is_stopping_time_hitting_is_stopping_time ih₂ (fun _ => lower_crossing_time_le)
          measurableSet_Ici hf _
    refine' ⟨this, _⟩
    · intro n
      exact
        is_stopping_time_hitting_is_stopping_time this (fun _ => upper_crossing_time_le)
          measurableSet_Iic hf _
#align measure_theory.adapted.is_stopping_time_crossing MeasureTheory.Adapted.isStoppingTime_crossing

theorem Adapted.isStoppingTime_upperCrossingTime (hf : Adapted ℱ f) :
    IsStoppingTime ℱ (upperCrossingTime a b f N n) :=
  hf.isStoppingTime_crossing.1
#align measure_theory.adapted.is_stopping_time_upper_crossing_time MeasureTheory.Adapted.isStoppingTime_upperCrossingTime

theorem Adapted.isStoppingTime_lowerCrossingTime (hf : Adapted ℱ f) :
    IsStoppingTime ℱ (lowerCrossingTime a b f N n) :=
  hf.isStoppingTime_crossing.2
#align measure_theory.adapted.is_stopping_time_lower_crossing_time MeasureTheory.Adapted.isStoppingTime_lowerCrossingTime

/-- `upcrossing_strat a b f N n` is 1 if `n` is between a consecutive pair of lower and upper
crossings and is 0 otherwise. `upcrossing_strat` is shifted by one index so that it is adapted
rather than predictable. -/
noncomputable def upcrossingStrat (a b : ℝ) (f : ℕ → Ω → ℝ) (N n : ℕ) (ω : Ω) : ℝ :=
  ∑ k in Finset.range N,
    (Set.Ico (lowerCrossingTime a b f N k ω) (upperCrossingTime a b f N (k + 1) ω)).indicator 1 n
#align measure_theory.upcrossing_strat MeasureTheory.upcrossingStrat

theorem upcrossingStrat_nonneg : 0 ≤ upcrossingStrat a b f N n ω :=
  Finset.sum_nonneg fun i hi => Set.indicator_nonneg (fun ω hω => zero_le_one) _
#align measure_theory.upcrossing_strat_nonneg MeasureTheory.upcrossingStrat_nonneg

theorem upcrossingStrat_le_one : upcrossingStrat a b f N n ω ≤ 1 :=
  by
  rw [upcrossing_strat, ← Set.indicator_finset_bunionᵢ_apply]
  · exact Set.indicator_le_self' (fun _ _ => zero_le_one) _
  · intro i hi j hj hij
    rw [Set.Ico_disjoint_Ico]
    obtain hij' | hij' := lt_or_gt_of_ne hij
    · rw [min_eq_left
          (upper_crossing_time_mono (Nat.succ_le_succ hij'.le) :
            upper_crossing_time a b f N _ ω ≤ upper_crossing_time a b f N _ ω),
        max_eq_right
          (lower_crossing_time_mono hij'.le :
            lower_crossing_time a b f N _ _ ≤ lower_crossing_time _ _ _ _ _ _)]
      refine'
        le_trans upper_crossing_time_le_lower_crossing_time
          (lower_crossing_time_mono (Nat.succ_le_of_lt hij'))
    · rw [gt_iff_lt] at hij'
      rw [min_eq_right
          (upper_crossing_time_mono (Nat.succ_le_succ hij'.le) :
            upper_crossing_time a b f N _ ω ≤ upper_crossing_time a b f N _ ω),
        max_eq_left
          (lower_crossing_time_mono hij'.le :
            lower_crossing_time a b f N _ _ ≤ lower_crossing_time _ _ _ _ _ _)]
      refine'
        le_trans upper_crossing_time_le_lower_crossing_time
          (lower_crossing_time_mono (Nat.succ_le_of_lt hij'))
#align measure_theory.upcrossing_strat_le_one MeasureTheory.upcrossingStrat_le_one

theorem Adapted.upcrossingStrat_adapted (hf : Adapted ℱ f) : Adapted ℱ (upcrossingStrat a b f N) :=
  by
  intro n
  change
    strongly_measurable[ℱ n] fun ω =>
      ∑ k in Finset.range N,
        ({ n | lower_crossing_time a b f N k ω ≤ n } ∩
              { n | n < upper_crossing_time a b f N (k + 1) ω }).indicator
          1 n
  refine'
    Finset.stronglyMeasurable_sum _ fun i hi =>
      strongly_measurable_const.indicator ((hf.is_stopping_time_lower_crossing_time n).inter _)
  simp_rw [← not_le]
  exact (hf.is_stopping_time_upper_crossing_time n).compl
#align measure_theory.adapted.upcrossing_strat_adapted MeasureTheory.Adapted.upcrossingStrat_adapted

theorem Submartingale.sumUpcrossingStratMul [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ) (a b : ℝ)
    (N : ℕ) :
    Submartingale
      (fun n : ℕ => ∑ k in Finset.range n, upcrossingStrat a b f N k * (f (k + 1) - f k)) ℱ μ :=
  hf.sumMulSub hf.Adapted.upcrossingStrat_adapted (fun _ _ => upcrossingStrat_le_one) fun _ _ =>
    upcrossingStrat_nonneg
#align measure_theory.submartingale.sum_upcrossing_strat_mul MeasureTheory.Submartingale.sumUpcrossingStratMul

theorem Submartingale.sumSubUpcrossingStratMul [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ)
    (a b : ℝ) (N : ℕ) :
    Submartingale
      (fun n : ℕ => ∑ k in Finset.range n, (1 - upcrossingStrat a b f N k) * (f (k + 1) - f k)) ℱ
      μ :=
  by
  refine'
    hf.sum_mul_sub (fun n => (adapted_const ℱ 1 n).sub (hf.adapted.upcrossing_strat_adapted n))
      (_ : ∀ n ω, (1 - upcrossing_strat a b f N n) ω ≤ 1) _
  · exact fun n ω => sub_le_self _ upcrossing_strat_nonneg
  · intro n ω
    simp [upcrossing_strat_le_one]
#align measure_theory.submartingale.sum_sub_upcrossing_strat_mul MeasureTheory.Submartingale.sumSubUpcrossingStratMul

theorem Submartingale.sum_mul_upcrossingStrat_le [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ) :
    μ[∑ k in Finset.range n, upcrossingStrat a b f N k * (f (k + 1) - f k)] ≤ μ[f n] - μ[f 0] :=
  by
  have h₁ :
    (0 : ℝ) ≤ μ[∑ k in Finset.range n, (1 - upcrossing_strat a b f N k) * (f (k + 1) - f k)] :=
    by
    have := (hf.sum_sub_upcrossing_strat_mul a b N).set_integral_le (zero_le n) MeasurableSet.univ
    rw [integral_univ, integral_univ] at this
    refine' le_trans _ this
    simp only [Finset.range_zero, Finset.sum_empty, integral_zero']
  have h₂ :
    μ[∑ k in Finset.range n, (1 - upcrossing_strat a b f N k) * (f (k + 1) - f k)] =
      μ[∑ k in Finset.range n, f (k + 1) - f k] -
        μ[∑ k in Finset.range n, upcrossing_strat a b f N k * (f (k + 1) - f k)] :=
    by
    simp only [sub_mul, one_mul, Finset.sum_sub_distrib, Pi.sub_apply, Finset.sum_apply,
      Pi.mul_apply]
    refine'
      integral_sub
        (integrable.sub (integrable_finset_sum _ fun i hi => hf.integrable _)
          (integrable_finset_sum _ fun i hi => hf.integrable _))
        _
    convert(hf.sum_upcrossing_strat_mul a b N).Integrable n
    ext
    simp
  rw [h₂, sub_nonneg] at h₁
  refine' le_trans h₁ _
  simp_rw [Finset.sum_range_sub, integral_sub' (hf.integrable _) (hf.integrable _)]
#align measure_theory.submartingale.sum_mul_upcrossing_strat_le MeasureTheory.Submartingale.sum_mul_upcrossingStrat_le

/-- The number of upcrossings (strictly) before time `N`. -/
noncomputable def upcrossingsBefore [Preorder ι] [OrderBot ι] [InfSet ι] (a b : ℝ) (f : ι → Ω → ℝ)
    (N : ι) (ω : Ω) : ℕ :=
  supₛ { n | upperCrossingTime a b f N n ω < N }
#align measure_theory.upcrossings_before MeasureTheory.upcrossingsBefore

@[simp]
theorem upcrossingsBefore_bot [Preorder ι] [OrderBot ι] [InfSet ι] {a b : ℝ} {f : ι → Ω → ℝ}
    {ω : Ω} : upcrossingsBefore a b f ⊥ ω = ⊥ := by simp [upcrossings_before]
#align measure_theory.upcrossings_before_bot MeasureTheory.upcrossingsBefore_bot

theorem upcrossingsBefore_zero : upcrossingsBefore a b f 0 ω = 0 := by simp [upcrossings_before]
#align measure_theory.upcrossings_before_zero MeasureTheory.upcrossingsBefore_zero

@[simp]
theorem upcrossingsBefore_zero' : upcrossingsBefore a b f 0 = 0 :=
  by
  ext ω
  exact upcrossings_before_zero
#align measure_theory.upcrossings_before_zero' MeasureTheory.upcrossingsBefore_zero'

theorem upperCrossingTime_lt_of_le_upcrossingsBefore (hN : 0 < N) (hab : a < b)
    (hn : n ≤ upcrossingsBefore a b f N ω) : upperCrossingTime a b f N n ω < N :=
  haveI : upper_crossing_time a b f N (upcrossings_before a b f N ω) ω < N :=
    (upper_crossing_time_lt_nonempty hN).cSup_mem
      ((OrderBot.bddBelow _).finite_of_bddAbove (upper_crossing_time_lt_bdd_above hab))
  lt_of_le_of_lt (upper_crossing_time_mono hn) this
#align measure_theory.upper_crossing_time_lt_of_le_upcrossings_before MeasureTheory.upperCrossingTime_lt_of_le_upcrossingsBefore

theorem upperCrossingTime_eq_of_upcrossingsBefore_lt (hab : a < b)
    (hn : upcrossingsBefore a b f N ω < n) : upperCrossingTime a b f N n ω = N :=
  by
  refine' le_antisymm upper_crossing_time_le (not_lt.1 _)
  convert not_mem_of_csupₛ_lt hn (upper_crossing_time_lt_bdd_above hab)
#align measure_theory.upper_crossing_time_eq_of_upcrossings_before_lt MeasureTheory.upperCrossingTime_eq_of_upcrossingsBefore_lt

theorem upcrossingsBefore_le (f : ℕ → Ω → ℝ) (ω : Ω) (hab : a < b) :
    upcrossingsBefore a b f N ω ≤ N := by
  by_cases hN : N = 0
  · subst hN
    rw [upcrossings_before_zero]
  · refine' csupₛ_le ⟨0, zero_lt_iff.2 hN⟩ fun n (hn : _ < _) => _
    by_contra hnN
    exact hn.ne (upper_crossing_time_eq_of_bound_le hab (not_le.1 hnN).le)
#align measure_theory.upcrossings_before_le MeasureTheory.upcrossingsBefore_le

theorem crossing_eq_crossing_of_lowerCrossingTime_lt {M : ℕ} (hNM : N ≤ M)
    (h : lowerCrossingTime a b f N n ω < N) :
    upperCrossingTime a b f M n ω = upperCrossingTime a b f N n ω ∧
      lowerCrossingTime a b f M n ω = lowerCrossingTime a b f N n ω :=
  by
  have h' : upper_crossing_time a b f N n ω < N :=
    lt_of_le_of_lt upper_crossing_time_le_lower_crossing_time h
  induction' n with k ih
  · simp only [Nat.zero_eq, upper_crossing_time_zero, bot_eq_zero', eq_self_iff_true,
      lower_crossing_time_zero, true_and_iff, eq_comm]
    refine' hitting_eq_hitting_of_exists hNM _
    simp only [lower_crossing_time, hitting_lt_iff] at h
    obtain ⟨j, hj₁, hj₂⟩ := h
    exact ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩
  · specialize
      ih (lt_of_le_of_lt (lower_crossing_time_mono (Nat.le_succ _)) h)
        (lt_of_le_of_lt (upper_crossing_time_mono (Nat.le_succ _)) h')
    have : upper_crossing_time a b f M k.succ ω = upper_crossing_time a b f N k.succ ω :=
      by
      simp only [upper_crossing_time_succ_eq, hitting_lt_iff] at h'⊢
      obtain ⟨j, hj₁, hj₂⟩ := h'
      rw [eq_comm, ih.2]
      exact hitting_eq_hitting_of_exists hNM ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩
    refine' ⟨this, _⟩
    simp only [lower_crossing_time, eq_comm, this]
    refine' hitting_eq_hitting_of_exists hNM _
    rw [lower_crossing_time, hitting_lt_iff _ le_rfl] at h
    swap
    · infer_instance
    obtain ⟨j, hj₁, hj₂⟩ := h
    exact ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩
#align measure_theory.crossing_eq_crossing_of_lower_crossing_time_lt MeasureTheory.crossing_eq_crossing_of_lowerCrossingTime_lt

theorem crossing_eq_crossing_of_upperCrossingTime_lt {M : ℕ} (hNM : N ≤ M)
    (h : upperCrossingTime a b f N (n + 1) ω < N) :
    upperCrossingTime a b f M (n + 1) ω = upperCrossingTime a b f N (n + 1) ω ∧
      lowerCrossingTime a b f M n ω = lowerCrossingTime a b f N n ω :=
  by
  have :=
    (crossing_eq_crossing_of_lower_crossing_time_lt hNM
        (lt_of_le_of_lt lower_crossing_time_le_upper_crossing_time_succ h)).2
  refine' ⟨_, this⟩
  rw [upper_crossing_time_succ_eq, upper_crossing_time_succ_eq, eq_comm, this]
  refine' hitting_eq_hitting_of_exists hNM _
  simp only [upper_crossing_time_succ_eq, hitting_lt_iff] at h
  obtain ⟨j, hj₁, hj₂⟩ := h
  exact ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩
#align measure_theory.crossing_eq_crossing_of_upper_crossing_time_lt MeasureTheory.crossing_eq_crossing_of_upperCrossingTime_lt

theorem upperCrossingTime_eq_upperCrossingTime_of_lt {M : ℕ} (hNM : N ≤ M)
    (h : upperCrossingTime a b f N n ω < N) :
    upperCrossingTime a b f M n ω = upperCrossingTime a b f N n ω :=
  by
  cases n
  · simp
  · exact (crossing_eq_crossing_of_upper_crossing_time_lt hNM h).1
#align measure_theory.upper_crossing_time_eq_upper_crossing_time_of_lt MeasureTheory.upperCrossingTime_eq_upperCrossingTime_of_lt

theorem upcrossingsBefore_mono (hab : a < b) : Monotone fun N ω => upcrossingsBefore a b f N ω :=
  by
  intro N M hNM ω
  simp only [upcrossings_before]
  by_cases hemp : { n : ℕ | upper_crossing_time a b f N n ω < N }.Nonempty
  · refine' csupₛ_le_csupₛ (upper_crossing_time_lt_bdd_above hab) hemp fun n hn => _
    rw [Set.mem_setOf_eq, upper_crossing_time_eq_upper_crossing_time_of_lt hNM hn]
    exact lt_of_lt_of_le hn hNM
  · rw [Set.not_nonempty_iff_eq_empty] at hemp
    simp [hemp, csupₛ_empty, bot_eq_zero', zero_le']
#align measure_theory.upcrossings_before_mono MeasureTheory.upcrossingsBefore_mono

theorem upcrossingsBefore_lt_of_exists_upcrossing (hab : a < b) {N₁ N₂ : ℕ} (hN₁ : N ≤ N₁)
    (hN₁' : f N₁ ω < a) (hN₂ : N₁ ≤ N₂) (hN₂' : b < f N₂ ω) :
    upcrossingsBefore a b f N ω < upcrossingsBefore a b f (N₂ + 1) ω :=
  by
  refine' lt_of_lt_of_le (Nat.lt_succ_self _) (le_csupₛ (upper_crossing_time_lt_bdd_above hab) _)
  rw [Set.mem_setOf_eq, upper_crossing_time_succ_eq, hitting_lt_iff _ le_rfl]
  swap
  · infer_instance
  · refine' ⟨N₂, ⟨_, Nat.lt_succ_self _⟩, hN₂'.le⟩
    rw [lower_crossing_time, hitting_le_iff_of_lt _ (Nat.lt_succ_self _)]
    refine' ⟨N₁, ⟨le_trans _ hN₁, hN₂⟩, hN₁'.le⟩
    by_cases hN : 0 < N
    · have : upper_crossing_time a b f N (upcrossings_before a b f N ω) ω < N :=
        Nat.supₛ_mem (upper_crossing_time_lt_nonempty hN) (upper_crossing_time_lt_bdd_above hab)
      rw [upper_crossing_time_eq_upper_crossing_time_of_lt (hN₁.trans (hN₂.trans <| Nat.le_succ _))
          this]
      exact this.le
    · rw [not_lt, le_zero_iff] at hN
      rw [hN, upcrossings_before_zero, upper_crossing_time_zero]
      rfl
#align measure_theory.upcrossings_before_lt_of_exists_upcrossing MeasureTheory.upcrossingsBefore_lt_of_exists_upcrossing

theorem lowerCrossingTime_lt_of_lt_upcrossingsBefore (hN : 0 < N) (hab : a < b)
    (hn : n < upcrossingsBefore a b f N ω) : lowerCrossingTime a b f N n ω < N :=
  lt_of_le_of_lt lowerCrossingTime_le_upperCrossingTime_succ
    (upperCrossingTime_lt_of_le_upcrossingsBefore hN hab hn)
#align measure_theory.lower_crossing_time_lt_of_lt_upcrossings_before MeasureTheory.lowerCrossingTime_lt_of_lt_upcrossingsBefore

theorem le_sub_of_le_upcrossingsBefore (hN : 0 < N) (hab : a < b)
    (hn : n < upcrossingsBefore a b f N ω) :
    b - a ≤
      stoppedValue f (upperCrossingTime a b f N (n + 1)) ω -
        stoppedValue f (lowerCrossingTime a b f N n) ω :=
  sub_le_sub
    (stoppedValue_upperCrossingTime (upperCrossingTime_lt_of_le_upcrossingsBefore hN hab hn).Ne)
    (stoppedValue_lowerCrossingTime (lowerCrossingTime_lt_of_lt_upcrossingsBefore hN hab hn).Ne)
#align measure_theory.le_sub_of_le_upcrossings_before MeasureTheory.le_sub_of_le_upcrossingsBefore

theorem sub_eq_zero_of_upcrossingsBefore_lt (hab : a < b) (hn : upcrossingsBefore a b f N ω < n) :
    stoppedValue f (upperCrossingTime a b f N (n + 1)) ω -
        stoppedValue f (lowerCrossingTime a b f N n) ω =
      0 :=
  by
  have : N ≤ upper_crossing_time a b f N n ω :=
    by
    rw [upcrossings_before] at hn
    rw [← not_lt]
    exact fun h => not_le.2 hn (le_csupₛ (upper_crossing_time_lt_bdd_above hab) h)
  simp [stopped_value, upper_crossing_time_stabilize' (Nat.le_succ n) this,
    lower_crossing_time_stabilize' le_rfl
      (le_trans this upper_crossing_time_le_lower_crossing_time)]
#align measure_theory.sub_eq_zero_of_upcrossings_before_lt MeasureTheory.sub_eq_zero_of_upcrossingsBefore_lt

theorem mul_upcrossingsBefore_le (hf : a ≤ f N ω) (hab : a < b) :
    (b - a) * upcrossingsBefore a b f N ω ≤
      ∑ k in Finset.range N, upcrossingStrat a b f N k ω * (f (k + 1) - f k) ω :=
  by
  classical
    by_cases hN : N = 0
    · simp [hN]
    simp_rw [upcrossing_strat, Finset.sum_mul, ← Set.indicator_mul_left, Pi.one_apply, Pi.sub_apply,
      one_mul]
    rw [Finset.sum_comm]
    have h₁ :
      ∀ k,
        (∑ n in Finset.range N,
            (Set.Ico (lower_crossing_time a b f N k ω)
                  (upper_crossing_time a b f N (k + 1) ω)).indicator
              (fun m => f (m + 1) ω - f m ω) n) =
          stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
            stopped_value f (lower_crossing_time a b f N k) ω :=
      by
      intro k
      rw [Finset.sum_indicator_eq_sum_filter,
        (_ :
          Finset.filter
              (fun i =>
                i ∈
                  Set.Ico (lower_crossing_time a b f N k ω) (upper_crossing_time a b f N (k + 1) ω))
              (Finset.range N) =
            Finset.Ico (lower_crossing_time a b f N k ω) (upper_crossing_time a b f N (k + 1) ω)),
        Finset.sum_Ico_eq_add_neg _ lower_crossing_time_le_upper_crossing_time_succ,
        Finset.sum_range_sub fun n => f n ω, Finset.sum_range_sub fun n => f n ω, neg_sub,
        sub_add_sub_cancel]
      · rfl
      · ext i
        simp only [Set.mem_Ico, Finset.mem_filter, Finset.mem_range, Finset.mem_Ico,
          and_iff_right_iff_imp, and_imp]
        exact fun _ h => lt_of_lt_of_le h upper_crossing_time_le
    simp_rw [h₁]
    have h₂ :
      (∑ k in Finset.range (upcrossings_before a b f N ω), b - a) ≤
        ∑ k in Finset.range N,
          stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
            stopped_value f (lower_crossing_time a b f N k) ω :=
      by
      calc
        (∑ k in Finset.range (upcrossings_before a b f N ω), b - a) ≤
            ∑ k in Finset.range (upcrossings_before a b f N ω),
              stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
                stopped_value f (lower_crossing_time a b f N k) ω :=
          by
          refine'
            Finset.sum_le_sum fun i hi => le_sub_of_le_upcrossings_before (zero_lt_iff.2 hN) hab _
          rwa [Finset.mem_range] at hi
        _ ≤
            ∑ k in Finset.range N,
              stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
                stopped_value f (lower_crossing_time a b f N k) ω :=
          by
          refine'
            Finset.sum_le_sum_of_subset_of_nonneg
              (Finset.range_subset.2 (upcrossings_before_le f ω hab)) fun i _ hi => _
          by_cases hi' : i = upcrossings_before a b f N ω
          · subst hi'
            simp only [stopped_value]
            rw [upper_crossing_time_eq_of_upcrossings_before_lt hab (Nat.lt_succ_self _)]
            by_cases heq : lower_crossing_time a b f N (upcrossings_before a b f N ω) ω = N
            · rw [HEq, sub_self]
            · rw [sub_nonneg]
              exact le_trans (stopped_value_lower_crossing_time HEq) hf
          · rw [sub_eq_zero_of_upcrossings_before_lt hab]
            rw [Finset.mem_range, not_lt] at hi
            exact lt_of_le_of_ne hi (Ne.symm hi')

    refine' le_trans _ h₂
    rw [Finset.sum_const, Finset.card_range, nsmul_eq_mul, mul_comm]
#align measure_theory.mul_upcrossings_before_le MeasureTheory.mul_upcrossingsBefore_le

theorem integral_mul_upcrossingsBefore_le_integral [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ)
    (hfN : ∀ ω, a ≤ f N ω) (hfzero : 0 ≤ f 0) (hab : a < b) :
    (b - a) * μ[upcrossingsBefore a b f N] ≤ μ[f N] :=
  calc
    (b - a) * μ[upcrossingsBefore a b f N] ≤
        μ[∑ k in Finset.range N, upcrossingStrat a b f N k * (f (k + 1) - f k)] :=
      by
      rw [← integral_mul_left]
      refine' integral_mono_of_nonneg _ ((hf.sum_upcrossing_strat_mul a b N).Integrable N) _
      · exact eventually_of_forall fun ω => mul_nonneg (sub_nonneg.2 hab.le) (Nat.cast_nonneg _)
      · refine' eventually_of_forall fun ω => _
        simpa using mul_upcrossings_before_le (hfN ω) hab
    _ ≤ μ[f N] - μ[f 0] := hf.sum_mul_upcrossingStrat_le
    _ ≤ μ[f N] := (sub_le_self_iff _).2 (integral_nonneg hfzero)

#align measure_theory.integral_mul_upcrossings_before_le_integral MeasureTheory.integral_mul_upcrossingsBefore_le_integral

theorem crossing_pos_eq (hab : a < b) :
    upperCrossingTime 0 (b - a) (fun n ω => (f n ω - a)⁺) N n = upperCrossingTime a b f N n ∧
      lowerCrossingTime 0 (b - a) (fun n ω => (f n ω - a)⁺) N n = lowerCrossingTime a b f N n :=
  by
  have hab' : 0 < b - a := sub_pos.2 hab
  have hf : ∀ ω i, b - a ≤ (f i ω - a)⁺ ↔ b ≤ f i ω :=
    by
    intro i ω
    refine' ⟨fun h => _, fun h => _⟩
    ·
      rwa [← sub_le_sub_iff_right a, ←
        LatticeOrderedCommGroup.pos_eq_self_of_pos_pos (lt_of_lt_of_le hab' h)]
    · rw [← sub_le_sub_iff_right a] at h
      rwa [LatticeOrderedCommGroup.pos_of_nonneg _ (le_trans hab'.le h)]
  have hf' : ∀ ω i, (f i ω - a)⁺ ≤ 0 ↔ f i ω ≤ a :=
    by
    intro ω i
    rw [LatticeOrderedCommGroup.pos_nonpos_iff, sub_nonpos]
  induction' n with k ih
  · refine' ⟨rfl, _⟩
    simp only [lower_crossing_time_zero, hitting, Set.mem_Icc, Set.mem_Iic]
    ext ω
    split_ifs with h₁ h₂ h₂
    · simp_rw [hf']
    · simp_rw [Set.mem_Iic, ← hf' _ _] at h₂
      exact False.elim (h₂ h₁)
    · simp_rw [Set.mem_Iic, hf' _ _] at h₁
      exact False.elim (h₁ h₂)
    · rfl
  · have :
      upper_crossing_time 0 (b - a) (fun n ω => (f n ω - a)⁺) N (k + 1) =
        upper_crossing_time a b f N (k + 1) :=
      by
      ext ω
      simp only [upper_crossing_time_succ_eq, ← ih.2, hitting, Set.mem_Ici, tsub_le_iff_right]
      split_ifs with h₁ h₂ h₂
      · simp_rw [← sub_le_iff_le_add, hf ω]
      · simp_rw [Set.mem_Ici, ← hf _ _] at h₂
        exact False.elim (h₂ h₁)
      · simp_rw [Set.mem_Ici, hf _ _] at h₁
        exact False.elim (h₁ h₂)
      · rfl
    refine' ⟨this, _⟩
    ext ω
    simp only [lower_crossing_time, this, hitting, Set.mem_Iic]
    split_ifs with h₁ h₂ h₂
    · simp_rw [hf' ω]
    · simp_rw [Set.mem_Iic, ← hf' _ _] at h₂
      exact False.elim (h₂ h₁)
    · simp_rw [Set.mem_Iic, hf' _ _] at h₁
      exact False.elim (h₁ h₂)
    · rfl
#align measure_theory.crossing_pos_eq MeasureTheory.crossing_pos_eq

theorem upcrossingsBefore_pos_eq (hab : a < b) :
    upcrossingsBefore 0 (b - a) (fun n ω => (f n ω - a)⁺) N ω = upcrossingsBefore a b f N ω := by
  simp_rw [upcrossings_before, (crossing_pos_eq hab).1]
#align measure_theory.upcrossings_before_pos_eq MeasureTheory.upcrossingsBefore_pos_eq

theorem mul_integral_upcrossingsBefore_le_integral_pos_part_aux [IsFiniteMeasure μ]
    (hf : Submartingale f ℱ μ) (hab : a < b) :
    (b - a) * μ[upcrossingsBefore a b f N] ≤ μ[fun ω => (f N ω - a)⁺] :=
  by
  refine'
    le_trans (le_of_eq _)
      (integral_mul_upcrossings_before_le_integral (hf.sub_martingale (martingale_const _ _ _)).Pos
        (fun ω => LatticeOrderedCommGroup.pos_nonneg _)
        (fun ω => LatticeOrderedCommGroup.pos_nonneg _) (sub_pos.2 hab))
  simp_rw [sub_zero, ← upcrossings_before_pos_eq hab]
  rfl
#align measure_theory.mul_integral_upcrossings_before_le_integral_pos_part_aux MeasureTheory.mul_integral_upcrossingsBefore_le_integral_pos_part_aux

/-- **Doob's upcrossing estimate**: given a real valued discrete submartingale `f` and real
values `a` and `b`, we have `(b - a) * 𝔼[upcrossings_before a b f N] ≤ 𝔼[(f N - a)⁺]` where
`upcrossings_before a b f N` is the number of times the process `f` crossed from below `a` to above
`b` before the time `N`. -/
theorem Submartingale.mul_integral_upcrossingsBefore_le_integral_pos_part [IsFiniteMeasure μ]
    (a b : ℝ) (hf : Submartingale f ℱ μ) (N : ℕ) :
    (b - a) * μ[upcrossingsBefore a b f N] ≤ μ[fun ω => (f N ω - a)⁺] :=
  by
  by_cases hab : a < b
  · exact mul_integral_upcrossings_before_le_integral_pos_part_aux hf hab
  · rw [not_lt, ← sub_nonpos] at hab
    exact
      le_trans (mul_nonpos_of_nonpos_of_nonneg hab (integral_nonneg fun ω => Nat.cast_nonneg _))
        (integral_nonneg fun ω => LatticeOrderedCommGroup.pos_nonneg _)
#align measure_theory.submartingale.mul_integral_upcrossings_before_le_integral_pos_part MeasureTheory.Submartingale.mul_integral_upcrossingsBefore_le_integral_pos_part

/-!

### Variant of the upcrossing estimate

Now, we would like to prove a variant of the upcrossing estimate obtained by taking the supremum
over $N$ of the original upcrossing estimate. Namely, we want the inequality
$$
  (b - a) \sup_N \mathbb{E}[U_N(a, b)] \le \sup_N \mathbb{E}[f_N].
$$
This inequality is central for the martingale convergence theorem as it provides a uniform bound
for the upcrossings.

We note that on top of taking the supremum on both sides of the inequality, we had also used
the monotone convergence theorem on the left hand side to take the supremum outside of the
integral. To do this, we need to make sure $U_N(a, b)$ is measurable and integrable. Integrability
is easy to check as $U_N(a, b) ≤ N$ and so it suffices to show measurability. Indeed, by
noting that
$$
  U_N(a, b) = \sum_{i = 1}^N \mathbf{1}_{\{U_N(a, b) < N\}}
$$
$U_N(a, b)$ is measurable as $\{U_N(a, b) < N\}$ is a measurable set since $U_N(a, b)$ is a
stopping time.

-/

theorem upcrossingsBefore_eq_sum (hab : a < b) :
    upcrossingsBefore a b f N ω =
      ∑ i in Finset.Ico 1 (N + 1), { n | upperCrossingTime a b f N n ω < N }.indicator 1 i :=
  by
  by_cases hN : N = 0
  · simp [hN]
  rw [←
    Finset.sum_Ico_consecutive _ (Nat.succ_le_succ zero_le')
      (Nat.succ_le_succ (upcrossings_before_le f ω hab))]
  have h₁ :
    ∀ k ∈ Finset.Ico 1 (upcrossings_before a b f N ω + 1),
      { n : ℕ | upper_crossing_time a b f N n ω < N }.indicator 1 k = 1 :=
    by
    rintro k hk
    rw [Finset.mem_Ico] at hk
    rw [Set.indicator_of_mem]
    · rfl
    ·
      exact
        upper_crossing_time_lt_of_le_upcrossings_before (zero_lt_iff.2 hN) hab
          (Nat.lt_succ_iff.1 hk.2)
  have h₂ :
    ∀ k ∈ Finset.Ico (upcrossings_before a b f N ω + 1) (N + 1),
      { n : ℕ | upper_crossing_time a b f N n ω < N }.indicator 1 k = 0 :=
    by
    rintro k hk
    rw [Finset.mem_Ico, Nat.succ_le_iff] at hk
    rw [Set.indicator_of_not_mem]
    simp only [Set.mem_setOf_eq, not_lt]
    exact (upper_crossing_time_eq_of_upcrossings_before_lt hab hk.1).symm.le
  rw [Finset.sum_congr rfl h₁, Finset.sum_congr rfl h₂, Finset.sum_const, Finset.sum_const,
    smul_eq_mul, mul_one, smul_eq_mul, MulZeroClass.mul_zero, Nat.card_Ico, Nat.add_succ_sub_one,
    add_zero, add_zero]
#align measure_theory.upcrossings_before_eq_sum MeasureTheory.upcrossingsBefore_eq_sum

theorem Adapted.measurable_upcrossingsBefore (hf : Adapted ℱ f) (hab : a < b) :
    Measurable (upcrossingsBefore a b f N) :=
  by
  have :
    upcrossings_before a b f N = fun ω =>
      ∑ i in Finset.Ico 1 (N + 1), { n | upper_crossing_time a b f N n ω < N }.indicator 1 i :=
    by
    ext ω
    exact upcrossings_before_eq_sum hab
  rw [this]
  exact
    Finset.measurable_sum _ fun i hi =>
      Measurable.indicator measurable_const <|
        ℱ.le N _ (hf.is_stopping_time_upper_crossing_time.measurable_set_lt_of_pred N)
#align measure_theory.adapted.measurable_upcrossings_before MeasureTheory.Adapted.measurable_upcrossingsBefore

theorem Adapted.integrableUpcrossingsBefore [IsFiniteMeasure μ] (hf : Adapted ℱ f) (hab : a < b) :
    Integrable (fun ω => (upcrossingsBefore a b f N ω : ℝ)) μ :=
  haveI : ∀ᵐ ω ∂μ, ‖(upcrossings_before a b f N ω : ℝ)‖ ≤ N :=
    by
    refine' eventually_of_forall fun ω => _
    rw [Real.norm_eq_abs, Nat.abs_cast, Nat.cast_le]
    refine' upcrossings_before_le _ _ hab
  ⟨Measurable.aeStronglyMeasurable
      (measurable_from_top.comp (hf.measurable_upcrossings_before hab)),
    has_finite_integral_of_bounded this⟩
#align measure_theory.adapted.integrable_upcrossings_before MeasureTheory.Adapted.integrableUpcrossingsBefore

/-- The number of upcrossings of a realization of a stochastic process (`upcrossing` takes value
in `ℝ≥0∞` and so is allowed to be `∞`). -/
noncomputable def upcrossings [Preorder ι] [OrderBot ι] [InfSet ι] (a b : ℝ) (f : ι → Ω → ℝ)
    (ω : Ω) : ℝ≥0∞ :=
  ⨆ N, (upcrossingsBefore a b f N ω : ℝ≥0∞)
#align measure_theory.upcrossings MeasureTheory.upcrossings

theorem Adapted.measurable_upcrossings (hf : Adapted ℱ f) (hab : a < b) :
    Measurable (upcrossings a b f) :=
  measurable_supᵢ fun N => measurable_from_top.comp (hf.measurable_upcrossingsBefore hab)
#align measure_theory.adapted.measurable_upcrossings MeasureTheory.Adapted.measurable_upcrossings

theorem upcrossings_lt_top_iff :
    upcrossings a b f ω < ∞ ↔ ∃ k, ∀ N, upcrossingsBefore a b f N ω ≤ k :=
  by
  have : upcrossings a b f ω < ∞ ↔ ∃ k : ℝ≥0, upcrossings a b f ω ≤ k :=
    by
    constructor
    · intro h
      lift upcrossings a b f ω to ℝ≥0 using h.ne with r hr
      exact ⟨r, le_rfl⟩
    · rintro ⟨k, hk⟩
      exact lt_of_le_of_lt hk ENNReal.coe_lt_top
  simp_rw [this, upcrossings, supᵢ_le_iff]
  constructor <;> rintro ⟨k, hk⟩
  · obtain ⟨m, hm⟩ := exists_nat_ge k
    refine' ⟨m, fun N => Nat.cast_le.1 ((hk N).trans _)⟩
    rwa [← ENNReal.coe_nat, ENNReal.coe_le_coe]
  · refine' ⟨k, fun N => _⟩
    simp only [ENNReal.coe_nat, Nat.cast_le, hk N]
#align measure_theory.upcrossings_lt_top_iff MeasureTheory.upcrossings_lt_top_iff

/-- A variant of Doob's upcrossing estimate obtained by taking the supremum on both sides. -/
theorem Submartingale.mul_lintegral_upcrossings_le_lintegral_pos_part [IsFiniteMeasure μ] (a b : ℝ)
    (hf : Submartingale f ℱ μ) :
    (ENNReal.ofReal (b - a) * ∫⁻ ω, upcrossings a b f ω ∂μ) ≤
      ⨆ N, ∫⁻ ω, ENNReal.ofReal ((f N ω - a)⁺) ∂μ :=
  by
  by_cases hab : a < b
  · simp_rw [upcrossings]
    have : ∀ N, (∫⁻ ω, ENNReal.ofReal ((f N ω - a)⁺) ∂μ) = ENNReal.ofReal (∫ ω, (f N ω - a)⁺ ∂μ) :=
      by
      intro N
      rw [of_real_integral_eq_lintegral_of_real]
      · exact (hf.sub_martingale (martingale_const _ _ _)).Pos.Integrable _
      · exact eventually_of_forall fun ω => LatticeOrderedCommGroup.pos_nonneg _
    rw [lintegral_supr']
    · simp_rw [this, ENNReal.mul_supᵢ, supᵢ_le_iff]
      intro N
      rw [(by simp :
          (∫⁻ ω, upcrossings_before a b f N ω ∂μ) = ∫⁻ ω, ↑(upcrossings_before a b f N ω : ℝ≥0) ∂μ),
        lintegral_coe_eq_integral, ← ENNReal.ofReal_mul (sub_pos.2 hab).le]
      · simp_rw [NNReal.coe_nat_cast]
        exact
          (ENNReal.ofReal_le_ofReal
                (hf.mul_integral_upcrossings_before_le_integral_pos_part a b N)).trans
            (le_supᵢ _ N)
      · simp only [NNReal.coe_nat_cast, hf.adapted.integrable_upcrossings_before hab]
    ·
      exact fun n =>
        measurable_from_top.comp_ae_measurable
          (hf.adapted.measurable_upcrossings_before hab).AeMeasurable
    · refine' eventually_of_forall fun ω N M hNM => _
      rw [Nat.cast_le]
      exact upcrossings_before_mono hab hNM ω
  · rw [not_lt, ← sub_nonpos] at hab
    rw [ENNReal.ofReal_of_nonpos hab, MulZeroClass.zero_mul]
    exact zero_le _
#align measure_theory.submartingale.mul_lintegral_upcrossings_le_lintegral_pos_part MeasureTheory.Submartingale.mul_lintegral_upcrossings_le_lintegral_pos_part

end MeasureTheory


/-
Copyright (c) 2020 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.group_with_zero.commute
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupWithZero.Semiconj
import Mathlib.Algebra.Group.Commute
import Mathlib.Tactic.Nontriviality

/-!
# Lemmas about commuting elements in a `MonoidWithZero` or a `GroupWithZero`.

-/

variable {α M₀ G₀ M₀' G₀' F F' : Type _}

variable [MonoidWithZero M₀]

namespace Ring

open Classical

theorem mul_inverse_rev' {a b : M₀} (h : Commute a b) :
    inverse (a * b) = inverse b * inverse a := by
  by_cases hab : IsUnit (a * b)
  · obtain ⟨⟨a, rfl⟩, b, rfl⟩ := h.isUnit_mul_iff.mp hab
    rw [← Units.val_mul, inverse_unit, inverse_unit, inverse_unit, ← Units.val_mul, mul_inv_rev]
  obtain ha | hb := not_and_or.mp (mt h.isUnit_mul_iff.mpr hab)
  · rw [inverse_non_unit _ hab, inverse_non_unit _ ha, mul_zero]
  · rw [inverse_non_unit _ hab, inverse_non_unit _ hb, zero_mul]
#align ring.mul_inverse_rev' Ring.mul_inverse_rev'

theorem mul_inverse_rev {M₀} [CommMonoidWithZero M₀] (a b : M₀) :
    Ring.inverse (a * b) = inverse b * inverse a :=
  mul_inverse_rev' (Commute.all _ _)
#align ring.mul_inverse_rev Ring.mul_inverse_rev

end Ring

theorem Commute.ring_inverse_ring_inverse {a b : M₀} (h : Commute a b) :
    Commute (Ring.inverse a) (Ring.inverse b) :=
  (Ring.mul_inverse_rev' h.symm).symm.trans <| (congr_arg _ h.symm.eq).trans <|
    Ring.mul_inverse_rev' h
#align commute.ring_inverse_ring_inverse Commute.ring_inverse_ring_inverse

namespace Commute

@[simp]
theorem zero_right [MulZeroClass G₀] (a : G₀) : Commute a 0 :=
  SemiconjBy.zero_right a
#align commute.zero_right Commute.zero_right

@[simp]

variable [GroupWithZero G₀] {a b c : G₀}

@[simp]
theorem inv_left_iff₀ : Commute a⁻¹ b ↔ Commute a b :=
  SemiconjBy.inv_symm_left_iff₀
#align commute.inv_left_iff₀ Commute.inv_left_iff₀

theorem inv_left₀ (h : Commute a b) : Commute a⁻¹ b :=
  inv_left_iff₀.2 h
#align commute.inv_left₀ Commute.inv_left₀

@[simp]
theorem inv_right_iff₀ : Commute a b⁻¹ ↔ Commute a b :=
  SemiconjBy.inv_right_iff₀
#align commute.inv_right_iff₀ Commute.inv_right_iff₀

theorem inv_right₀ (h : Commute a b) : Commute a b⁻¹ :=
  inv_right_iff₀.2 h
#align commute.inv_right₀ Commute.inv_right₀

@[simp]
theorem div_right (hab : Commute a b) (hac : Commute a c) : Commute a (b / c) :=
  SemiconjBy.div_right hab hac
#align commute.div_right Commute.div_right

@[simp]
theorem div_left (hac : Commute a c) (hbc : Commute b c) : Commute (a / b) c := by
  rw [div_eq_mul_inv]
  exact hac.mul_left hbc.inv_left₀
#align commute.div_left Commute.div_left

end Commute


import data.real.basic tactic.norm_num tactic.ring

namespace real
noncomputable theory

def α := (sqrt 5 + 1) / 2
def β := 1 - α

theorem root_5_squared : (sqrt 5) ^ 2 = 5 :=
  by simp [sqr_sqrt,(by norm_num : (0:ℝ) <= 5)]

lemma αβsum : α + β = 1 := begin
  unfold β,
  unfold α,
  norm_num, -- ;-)
end

lemma αβprod : α * β = -1 := begin
  unfold α β,
  ring,
  rw sqr_sqrt; norm_num
end

-- √ is \surd

--#check sqrt_prop -- ∀ (x : ℝ), 0 ≤ sqrt x ∧ sqrt x * sqrt x = max 0 x

end real


import data.real.basic

import algebra.ne_zero
import algebra.group_with_zero.basic
import algebra.ring.defs
import data.int.cast.defs

/-
 Russian Mathematical Olympiad 1998, problem 42

 A binary operation ⋆ on real numbers has the property that (a ⋆ b) ⋆ c = a + b + c.
 Prove that a ⋆ b = a + b.

-/

variable star : ℝ → ℝ → ℝ
local infixl ` ⋆ `:80 := star

theorem russia1998_q42
  (stardef : ∀ a b c, a ⋆ b ⋆ c = a + b + c) :
  (∀ a b, a ⋆ b = a + b) :=
begin
  have lemma2 : ∀ a b d, a ⋆ b = d ⋆ b → a = d,
  { intros a b d hab,
    have := calc a + b + a = a ⋆ b ⋆ a : (stardef _ _ _).symm
                       ... = d ⋆ b ⋆ a : by rw [hab]
                       ... = d + b + a : stardef _ _ _,
    have : a + b = d + b := (add_left_inj a).mp this,
    have : a = d := (add_left_inj b).mp this,
    exact this },

  have lemma3 : ∀ a b, a ⋆ b = b ⋆ a,
  { intros a b,
    let d1 := a ⋆ b,
    let d2 := b ⋆ a,
    have h1 := calc d1 ⋆ 1 = a + b + 1 : stardef _ _ _
                       ... = b + a + 1 : by rw [add_comm a b]
                       ... = d2 ⋆ 1 : (stardef _ _ _).symm,

    exact lemma2 d1 1 d2 h1 },

  have lemma4 : ∀ a, a ⋆ 0 = a,
  { intro a,
    let x := a ⋆ 0,
    have h1 := calc x ⋆ 0 = a + 0 + 0 : stardef a 0 0
                      ... = a : by rw [add_zero, add_zero],

    have h2 := calc 2 * x = x + x : two_mul x
                      ... = x + 0 + x : by rw [add_zero]
                      ... = x ⋆ 0 ⋆ x : (stardef _ _ _).symm
                      ... = a ⋆ x : by rw [h1]
                      ... = x ⋆ a : lemma3 _ _
                      ... = a ⋆ 0 ⋆ a : rfl
                      ... = a + 0 + a : stardef _ _ _
                      ... = a + a : by rw [add_zero]
                      ... = 2 * a : (two_mul a).symm,

    have h3 : (2:ℝ) ≠ 0 := two_ne_zero,
    have h4 : x = a := (mul_right_inj' h3).mp h2,
    exact h4 },

  intros a b,

  have := calc a + b = a + b + 0 : by rw [add_zero]
                 ... = a ⋆ b ⋆ 0 : (stardef _ _ _).symm
                 ... = a ⋆ b : lemma4 _,

  exact this.symm
end


import MyNat.Definition
import MyNat.Addition -- add_succ
import MyNat.Multiplication -- mul_succ
import AdvancedAdditionWorld.Level9 -- succ_ne_zero
namespace MyNat
open MyNat
/-!
# Advanced Multiplication World

## Level 1: `mul_pos`

Recall that if `b : MyNat` is a hypothesis and you do `cases b with`,
your one goal will split into two goals,
namely the cases `b = 0` and `b = succ n`. So `cases` here is like
a weaker version of induction (you don't get the inductive hypothesis).

## Tricks

1) if your goal is `⊢ X ≠ Y` then `intro h` will give you `h : X = Y` and
a goal of `⊢ false`. This is because `X ≠ Y` *means* `(X = Y) → false`.
Conversely if your goal is `false` and you have `h : X ≠ Y` as a hypothesis
then `apply h` will work backwards and turn the goal into `X = Y`.

2) if `hab : succ (3 * x + 2 * y + 1) = 0` is a hypothesis and your goal is `⊢ false`,
then `exact succ_ne_zero _ hab` will solve the goal, because Lean will figure
out that `_` is supposed to be `3 * x + 2 * y + 1`.

# Theorem
The product of two non-zero natural numbers is non-zero.
-/
theorem mul_pos (a b : MyNat) : a ≠ 0 → b ≠ 0 → a * b ≠ 0 := by
  intros ha hb
  intro hab
  cases b with
  | zero =>
    apply hb
    rfl
  | succ b' =>
    rw [mul_succ] at hab
    apply ha
    cases a with
    | zero =>
      rfl
    | succ a' =>
      rw [add_succ] at hab
      exfalso
      exact succ_ne_zero _ hab
/-!

Next up [Level 2](./Level2.lean.md)
-/


/-
Copyright (c) 2021 Matt Kempster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Matt Kempster
-/
import geometry.euclidean.triangle
import analysis.special_functions.trigonometric

/-!
# Freek № 57: Heron's Formula

This file proves Theorem 57 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/),
also known as Heron's formula, which gives the area of a triangle based only on its three sides'
lengths.

## References

* https://en.wikipedia.org/wiki/Herons_formula

-/

open real euclidean_geometry
open_locale real euclidean_geometry

local notation `√` := real.sqrt

variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
  [normed_add_torsor V P]

include V

/-- Heron's formula: The area of a triangle with side lengths `a`, `b`, and `c` is
  `√(s * (s - a) * (s - b) * (s - c))` where `s = (a + b + c) / 2` is the semiperimeter.
  We show this by equating this formula to `a * b * sin γ`, where `γ` is the angle opposite
  the side `c`.
 -/
theorem heron {p1 p2 p3 : P} (h1 : p1 ≠ p2) (h2 : p3 ≠ p2) :
  let a := dist p1 p2, b := dist p3 p2, c := dist p1 p3, s := (a + b + c) / 2 in
  1/2 * a * b * sin (∠ p1 p2 p3) = √(s * (s - a) * (s - b) * (s - c)) :=
begin
  intros a b c s,
  let γ := ∠ p1 p2 p3,
  obtain := ⟨(dist_pos.mpr h1).ne', (dist_pos.mpr h2).ne'⟩,
  have cos_rule : cos γ = (a * a + b * b - c * c) / (2 * a * b) := by field_simp [mul_comm, a,
    dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle p1 p2 p3],
  let numerator := (2*a*b)^2 - (a*a + b*b - c*c)^2,
  let denominator := (2*a*b)^2,
  have split_to_frac : 1 - cos γ ^ 2 = numerator / denominator := by field_simp [cos_rule],
  have numerator_nonneg : 0 ≤ numerator,
  { have frac_nonneg: 0 ≤ numerator / denominator := by linarith [split_to_frac, cos_sq_le_one γ],
    cases div_nonneg_iff.mp frac_nonneg,
    { exact h.left },
    { simpa [h1, h2] using le_antisymm h.right (sq_nonneg _) } },
  have ab2_nonneg : 0 ≤ (2 * a * b) := by norm_num [mul_nonneg, dist_nonneg],
  calc  1/2 * a * b * sin γ
      = 1/2 * a * b * (√numerator / √denominator) : by rw [sin_eq_sqrt_one_sub_cos_sq,
                                                          split_to_frac, sqrt_div numerator_nonneg];
                                                      simp [angle_nonneg, angle_le_pi]
  ... = 1/4 * √((2*a*b)^2 - (a*a + b*b - c*c)^2)  : by { field_simp [ab2_nonneg], ring }
  ... = 1/4 * √(s * (s-a) * (s-b) * (s-c) * 4^2)  : by { simp only [s], ring_nf }
  ... = √(s * (s-a) * (s-b) * (s-c))              : by rw [sqrt_mul', sqrt_sq, div_mul_eq_mul_div,
                                                          one_mul, mul_div_cancel];
                                                      norm_num,
end


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import representation_theory.basic

/-

# Representation theory

Homomorphisms between representations; representations as modules.

-/

-- Let ρ and σ be representations of G on V and W
variables {k : Type} [field k] {G : Type} [group G]
  {V : Type} [add_comm_group V] [module k V]
  {W : Type} [add_comm_group W] [module k W]
  (ρ : representation k G V) (σ : representation k G W)

-- According to one of my PhD students yesterday, there is no "G-linear map" class!
-- So let's make one.

/-- The G-equivariant linear maps between two representations. -/
@[ext] -- this makes the `ext` tactic work on rep_maps, i.e. it shows that two rep_maps are
-- the same if they are the same underlying function
structure rep_map (ρ : representation k G V) (σ : representation k G W) : Type :=
(to_linear_map : V →ₗ[k] W)
(map_apply : ∀ (g : G) (v : V), to_linear_map (ρ g v) = σ g (to_linear_map v))

-- What should be now prove about it?

/-

## Categories

A category is a collection of objects, and between any pair of objects there's a collection
of maps or morphisms. Technical point: these maps/morphisms *don't actually have to be functions*,
the definition is more abstract than that. But let's not dwell on this right now.

That's not the end of the definition of a category -- there is a bit more structure,
and some axioms, but let's just give some examples first:

Example: in set theory the collection of all sets is a category; the morphisms between two sets
are just the functions between the sets.

Example: In type theory the collection of all types is a category; the morphisms are again just
the functions between the types.

Example: if we fix a field `k` and a group `G` then we can make a category whose objects
are `k`-vector spaces equipped with an action of `G` (i.e. representations of `G`) and
whose morphisms are the `G`-linear maps. Note that here the morphisms are *certain* maps
between the objects, but not *all* the maps.

Let's get back to the definition of a category. I need to explain the extra
structure and the axioms of a category. The extra structure is:

S1) For every object `X` of the category, there has to be an identity morphism `id_X : X → X`
S2) If we have three objects `X`, `Y`, and `Z` in the category, and two morphisms
`f : X → Y` and `g : Y → Z` then there's a way of composing them to get `g ∘ f : X → Z`.

For example, in the representation theory example above, the category theoretic composition
is just defined to be function composition, and ensuring that this gives a valid morphism
boils down to checking that the composite of two `G`-linear maps is `G`-linear.

The axioms are:

A1) If `f : X → Y` then `id_Y ∘ f = f` and `f ∘ id_X = f`
A2) If `f : W → X`, `g : X → Y` and `h : Y → Z` then `(f ∘ g) ∘ h = f ∘ (g ∘ h)`

The reason I mention these is that they inform us about what we should be proving
about `rep_map`!

-/

namespace rep_map

def id (ρ : representation k G V) : rep_map ρ ρ :=
{ to_linear_map := linear_map.id,
  map_apply := λ g v, rfl }

variables {X : Type} [add_comm_group X] [module k X]

variables {ρ σ}

def comp {τ : representation k G X}
  (ψ : rep_map σ τ) (φ : rep_map ρ σ) : rep_map ρ τ :=
{ to_linear_map := ψ.to_linear_map.comp φ.to_linear_map,
  map_apply := begin
    intros,
    simp [φ.map_apply, ψ.map_apply],
  end }

lemma comp_id (φ : rep_map ρ σ) : φ.comp (id ρ) = φ :=
begin
  ext,
  refl,
end

lemma id_comp (φ : rep_map ρ σ) : (id σ).comp φ = φ :=
begin
  ext,
  refl,
end

lemma comp_assoc {τ : representation k G X} {Y : Type} [add_comm_group Y] [module k Y]
  {υ : representation k G Y} (ξ : rep_map τ υ) (ψ : rep_map σ τ) (φ : rep_map ρ σ) :
  (ξ.comp ψ).comp φ = ξ.comp (ψ.comp φ) :=
begin
  refl,
end

end rep_map


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

import data.nat.prime_fin
import ring_theory.polynomial.cyclotomic.eval

/-!
# Primes congruent to one

We prove that, for any positive `k : ℕ`, there are infinitely many primes `p` such that
`p ≡ 1 [MOD k]`.
-/

namespace nat

open polynomial nat filter
open_locale nat

/-- For any positive `k : ℕ` there exists an arbitrarily large prime `p` such that
`p ≡ 1 [MOD k]`. -/
lemma exists_prime_gt_modeq_one {k : ℕ} (n : ℕ) (hk0 : k ≠ 0) :
  ∃ (p : ℕ), nat.prime p ∧ n < p ∧ p ≡ 1 [MOD k] :=
begin
  rcases (one_le_iff_ne_zero.2 hk0).eq_or_lt with rfl | hk1,
  { rcases exists_infinite_primes (n + 1) with ⟨p, hnp, hp⟩,
    exact ⟨p, hp, hnp, modeq_one⟩ },
  let b := k * n!,
  have hgt : 1 < (eval ↑b (cyclotomic k ℤ)).nat_abs,
  { rcases le_iff_exists_add'.1 hk1.le with ⟨k, rfl⟩,
    have hb : 2 ≤ b := le_mul_of_le_of_one_le hk1 n.factorial_pos,
    calc 1 ≤ b - 1 : le_tsub_of_add_le_left hb
    ... < (eval (b : ℤ) (cyclotomic (k + 1) ℤ)).nat_abs :
      sub_one_lt_nat_abs_cyclotomic_eval hk1 (succ_le_iff.1 hb).ne' },
  let p := min_fac (eval ↑b (cyclotomic k ℤ)).nat_abs,
  haveI hprime : fact p.prime := ⟨min_fac_prime (ne_of_lt hgt).symm⟩,
  have hroot : is_root (cyclotomic k (zmod p)) (cast_ring_hom (zmod p) b),
  { rw [is_root.def, ← map_cyclotomic_int k (zmod p), eval_map, coe_cast_ring_hom,
      ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval₂_hom, int.coe_cast_ring_hom,
      zmod.int_coe_zmod_eq_zero_iff_dvd _ _],
    apply int.dvd_nat_abs.1,
    exact_mod_cast min_fac_dvd (eval ↑b (cyclotomic k ℤ)).nat_abs },
  have hpb : ¬(p ∣ b) :=
    hprime.1.coprime_iff_not_dvd.1 (coprime_of_root_cyclotomic hk0.bot_lt hroot).symm,
  refine ⟨p, hprime.1, not_le.1 $ λ habs, _, _⟩,
  { exact hpb (dvd_mul_of_dvd_right (dvd_factorial (min_fac_pos _) habs) _) },
  { have hdiv : order_of (b : zmod p) ∣ p - 1 :=
      zmod.order_of_dvd_card_sub_one (mt (char_p.cast_eq_zero_iff _ _ _).1 hpb),
    haveI : ne_zero (k : zmod p) :=
      ne_zero.of_not_dvd (zmod p) (λ hpk, hpb (dvd_mul_of_dvd_left hpk _)),
    have : k = order_of (b : zmod p) := (is_root_cyclotomic_iff.mp hroot).eq_order_of,
    rw [← this] at hdiv,
    exact ((modeq_iff_dvd' hprime.1.pos).2 hdiv).symm }
end

lemma frequently_at_top_modeq_one {k : ℕ} (hk0 : k ≠ 0) :
  ∃ᶠ p in at_top, nat.prime p ∧ p ≡ 1 [MOD k] :=
begin
  refine frequently_at_top.2 (λ n, _),
  obtain ⟨p, hp⟩ := exists_prime_gt_modeq_one n hk0,
  exact ⟨p, ⟨hp.2.1.le, hp.1, hp.2.2⟩⟩
end

/-- For any positive `k : ℕ` there are infinitely many primes `p` such that `p ≡ 1 [MOD k]`. -/
lemma infinite_set_of_prime_modeq_one {k : ℕ} (hk0 : k ≠ 0) :
  set.infinite {p : ℕ | nat.prime p ∧ p ≡ 1 [MOD k]} :=
frequently_at_top_iff_infinite.1 (frequently_at_top_modeq_one hk0)

end nat


import .love05_inductive_predicates_demo

/-! # LoVe Demo 12: Basic Mathematical Structures

We introduce definitions and proofs about basic mathematical structures such as
groups, fields, and linear orders. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Type Classes over a Single Binary Operator

Mathematically, a __group__ is a set `G` with a binary operator `• : G × G → G`
with the following properties, called __group axioms__:

* Associativity: For all `a, b, c ∈ G`, we have `(a • b) • c = a • (b • c)`.
* Identity element: There exists an element `e ∈ G` such that for all `a ∈ G`,
  we have `e • a = a`.
* Inverse element: For each `a ∈ G`, there exists an inverse element
  `inv(a) ∈ G` such that `inv(a) • a = e`.

Examples of groups are
* `ℤ` with `+`;
* `ℝ` with `+`;
* `ℝ \ {0}` with `*`.

In Lean, a type class for groups can be defined as follows: -/

namespace monolithic_group

@[class] structure group (α : Type) :=
(mul          : α → α → α)
(one          : α)
(inv          : α → α)
(mul_assoc    : ∀a b c, mul (mul a b) c = mul a (mul b c))
(one_mul      : ∀a, mul one a = a)
(mul_left_inv : ∀a, mul (inv a) a = one)

end monolithic_group

/-! In Lean, however, group is part of a larger hierarchy of algebraic
structures:

Type class               | Properties                               | Examples
------------------------ | -----------------------------------------|-------------------
`semigroup`              | associativity of `*`                     | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`monoid`                 | `semigroup` with unit `1`                | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`left_cancel_semigroup`  | `semigroup` with `c * a = c * b → a = b` |
`right_cancel_semigroup` | `semigroup` with `a * c = b * c → a = b` |
`group`                  | `monoid` with inverse `⁻¹`               |

Most of these structures have commutative versions: `comm_semigroup`,
`comm_monoid`, `comm_group`.

The __multiplicative__ structures (over `*`, `1`, `⁻¹`) are copied to produce
__additive__ versions (over `+`, `0`, `-`):

Type class                   | Properties                                   | Examples
---------------------------- | ---------------------------------------------|-------------------
`add_semigroup`              | associativity of `+`                         | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`add_monoid`                 | `add_semigroup` with unit `0`                | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`add_left_cancel_semigroup`  | `add_semigroup` with `c + a = c + b → a = b` | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`add_right_cancel_semigroup` | `add_semigroup` with `a + c = b + c → a = b` | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`add_group`                  | `add_monoid` with inverse `-`                | `ℝ`, `ℚ`, `ℤ` -/

#print group
#print add_group

/-! Let us define our own type, of integers modulo 2, and register it as an
additive group. -/

inductive int2 : Type
| zero
| one

def int2.add : int2 → int2 → int2
| int2.zero a         := a
| a         int2.zero := a
| int2.one  int2.one  := int2.zero

@[instance] def int2.add_group : add_group int2 :=
{ add          := int2.add,
  add_assoc    :=
    by intros a b c; cases' a; cases' b; cases' c; refl,
  zero         := int2.zero,
  zero_add     := by intro a; cases' a; refl,
  add_zero     := by intro a; cases' a; refl,
  neg          := λa, a,
  add_left_neg := by intro a; cases' a; refl }

#reduce int2.one + 0 - 0 - int2.one

lemma int2.add_right_neg:
  ∀a : int2, a + - a = 0 :=
add_right_neg

/-! Another example: Lists are an `add_monoid`: -/

@[instance] def list.add_monoid {α : Type} :
  add_monoid (list α) :=
{ zero      := [],
  add       := (++),
  add_assoc := list.append_assoc,
  zero_add  := list.nil_append,
  add_zero  := list.append_nil }

/-! ## Type Classes with Two Binary Operators

Mathematically, a __field__ is a set `F` such that

* `F` forms a commutative group under an operator `+`, called addition, with
  identity element `0`.
* `F\{0}` forms a commutative group under an operator `*`, called
  multiplication.
* Multiplication distributes over addition—i.e.,
  `a * (b + c) = a * b + a * c` for all `a, b, c ∈ F`.

In Lean, fields are also part of a larger hierarchy:

Type class       |  Properties                                         | Examples
-----------------|-----------------------------------------------------|-------------------
`semiring`       | `monoid` and `add_comm_monoid` with distributivity  | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`comm_semiring`  | `semiring` with commutativity of `*`                | `ℝ`, `ℚ`, `ℤ`, `ℕ`
`ring`           | `monoid` and `add_comm_group` with distributivity   | `ℝ`, `ℚ`, `ℤ`
`comm_ring`      | `ring` with commutativity of `*`                    | `ℝ`, `ℚ`, `ℤ`
`division_ring`  | `ring` with multiplicative inverse `⁻¹`             | `ℝ`, `ℚ`
`field`          | `division_ring` with commutativity of `*`           | `ℝ`, `ℚ`
`discrete_field` | `field` with decidable equality and `∀n, n / 0 = 0` | `ℝ`, `ℚ` -/

#print field

/-! Let us continue with our example: -/

def int2.mul : int2 → int2 → int2
| int2.one  a         := a
| a         int2.one  := a
| int2.zero int2.zero := int2.zero

@[instance] def int2.field : field int2 :=
{ one            := int2.one,
  mul            := int2.mul,
  inv            := λa, a,
  add_comm       := by intros a b; cases' a; cases' b; refl,
  exists_pair_ne :=
    by apply exists.intro int2.zero;
      apply exists.intro int2.one; finish,
  one_mul        := by intros a; cases' a; refl,
  mul_one        := by intros a; cases' a; refl,
  mul_inv_cancel := by intros a h; cases' a; finish,
  inv_zero       := by refl,
  mul_assoc      :=
    by intros a b c; cases' a; cases' b; cases' c; refl,
  mul_comm       := by intros a b; cases' a; cases' b; refl,
  left_distrib   :=
    by intros a b c; cases' a; cases' b; cases' c; refl,
  right_distrib  :=
    by intros a b c; cases' a; cases' b; cases' c; refl,
  ..int2.add_group }

#reduce (1 : int2) * 0 / (0 - 1)

#reduce (3 : int2)

lemma ring_example (a b : int2) :
  (a + b) ^ 3 = a ^ 3 + 3 * a ^ 2 * b + 3 * a * b ^ 2 + b ^ 3 :=
by ring

lemma ring_exp_example (a b : int2) (n : ℕ):
  (a + b) ^ (2 + n) =
  (a + b) ^ n * (a ^ 2 + 2 * a * b + b ^ 2) :=
by ring_exp

/-! `ring` and `ring_exp` prove equalities over commutative rings and semirings
by normalizing expressions. The `ring_exp` variant also normalizes exponents. -/

lemma abel_example (a b : ℤ) :
  a + b + 0 - (b + a + a) = - a :=
by abel

/-! `abel` proves equalities over additive commutative monoids and groups by
normalizing expressions.

## Coercions

When combining numbers form `ℕ`, `ℤ`, `ℚ`, and `ℝ`, we might want to cast from
one type to another. Lean has a mechanism to automatically introduce coercions,
represented by `coe` (syntactic sugar: `↑`). `coe` can be set up to provide
implicit coercions between arbitrary types.

Many coercions are already in place, including the following:

* `coe : ℕ → α` casts `ℕ` to another semiring `α`;
* `coe : ℤ → α` casts `ℤ` to another ring `α`;
* `coe : ℚ → α` casts `ℚ` to another division ring `α`.

For example, this works, although negation `- n` is not defined on natural
numbers: -/

lemma neg_mul_neg_nat (n : ℕ) (z : ℤ) :
  (- z) * (- n) = z * n :=
neg_mul_neg z n

/-! Notice how Lean introduced a `↑` coercion: -/

#print neg_mul_neg_nat

/-! Another example: -/

lemma neg_nat_mul_neg (n : ℕ) (z : ℤ) :
  (- n : ℤ) * (- z) = n * z :=
neg_mul_neg n z

#print neg_nat_mul_neg

/-! In proofs involving coercions, the tactic `norm_cast` can be convenient. -/

lemma norm_cast_example_1 (m n : ℕ) (h : (m : ℤ) = (n : ℤ)) :
  m = n :=
begin
  norm_cast at h,
  exact h
end

lemma norm_cast_example_2 (m n : ℕ) :
  (m : ℤ) + (n : ℤ) = ((m + n : ℕ) : ℤ) :=
by norm_cast

/-! `norm_cast` moves coercions towards the inside of expressions, as a form of
simplification. Like `simp`, it will generally produce a subgoal.

`norm_cast` relies on lemmas such as the following: -/

#check nat.cast_add
#check int.cast_add
#check rat.cast_add

/-! ### Lists, Multisets and Finite Sets

For finite collections of elements different structures are available:

* lists: order and duplicates matter;
* multisets: only duplicates matter;
* finsets: neither order nor duplicates matter. -/

lemma list_duplicates_example :
  [2, 3, 3, 4] ≠ [2, 3, 4] :=
dec_trivial

lemma list_order_example :
  [4, 3, 2] ≠ [2, 3, 4] :=
dec_trivial

lemma multiset_duplicates_example :
  ({2, 3, 3, 4} : multiset ℕ) ≠ {2, 3, 4} :=
dec_trivial

lemma multiset_order_example :
  ({2, 3, 4} : multiset ℕ) = {4, 3, 2} :=
dec_trivial

lemma finset_duplicates_example :
  ({2, 3, 3, 4} : finset ℕ) = {2, 3, 4} :=
dec_trivial

lemma finsetorder_example :
  ({2, 3, 4} : finset ℕ) = {4, 3, 2} :=
dec_trivial

/-! `dec_trivial` is a special lemma that can be used on trivial decidable
goals (e.g., true closed executable expressions). -/

def list.elems : btree ℕ → list ℕ
| btree.empty        := []
| (btree.node a l r) := a :: list.elems l ++ list.elems r

def multiset.elems : btree ℕ → multiset ℕ
| btree.empty        := ∅
| (btree.node a l r) :=
  {a} ∪ (multiset.elems l ∪ multiset.elems r)

def finset.elems : btree ℕ → finset ℕ
| btree.empty        := ∅
| (btree.node a l r) := {a} ∪ (finset.elems l ∪ finset.elems r)

#eval list.sum [2, 3, 4]                          -- result: 9
#eval multiset.sum ({2, 3, 4} : multiset ℕ)       -- result: 9
#eval finset.sum ({2, 3, 4} : finset ℕ) (λn, n)   -- result: 9

#eval list.prod [2, 3, 4]                         -- result: 24
#eval multiset.prod ({2, 3, 4} : multiset ℕ)      -- result: 24
#eval finset.prod ({2, 3, 4} : finset ℕ) (λn, n)  -- result: 24

/-! ## Order Type Classes

Many of the structures introduced above can be ordered. For example, the
well-known order on the natural numbers can be defined as follows: -/

inductive nat.le : ℕ → ℕ → Prop
| refl : ∀a : ℕ, nat.le a a
| step : ∀a b : ℕ, nat.le a b → nat.le a (b + 1)

/-! This is an example of a linear order. A __linear order__ (or
__total order__) is a binary relation `≤` such that for all `a`, `b`, `c`, the
following properties hold:

* Reflexivity: `a ≤ a`.
* Transitivity: If `a ≤ b` and `b ≤ c`, then `a ≤ c`.
* Antisymmetry: If `a ≤ b` and `b ≤ a`, then `a = b`.
* Totality: `a ≤ b` or `b ≤ a`.

If a relation has the first three properties, it is a __partial order__. An
example is `⊆` on sets, finite sets, or multisets. If a relation has the first
two properties, it is a __preorder__. An example is comparing lists by their
length.

In Lean, there are type classes for these different kinds of orders:
`linear_order`, `partial_order`, and `preorder`. The `preorder` class has the
fields

    `le       : α → α → Prop`
    `le_refl  : ∀a : α, le a a`
    `le_trans : ∀a b c : α, le a b → le b c → le a c`

The `partial_order` class also has

    `le_antisymm : ∀a b : α, le a b → le b a → a = b`

and `linear_order` also has

    `le_total : ∀a b : α, le a b ∨ le b a`

We can declare the preorder on lists that compares lists by their length as
follows: -/

@[instance] def list.length.preord {α : Type} :
  preorder (list α) :=
{ le       := λxs ys, list.length xs ≤ list.length ys,
  le_refl  := by intro xs; exact nat.le_refl _,
  le_trans := by intros xs ys zs; exact nat.le_trans }

/-! This instance introduces the infix syntax `≤` and the relations `≥`, `<`,
and `>`: -/

lemma list.length.preord_example {α : Type} (c : α) :
  [c] > [] :=
dec_trivial

/-! Complete lattices (lecture 10) are formalized as another type class,
`complete_lattice`, which inherits from `partial_order`.

Type classes combining orders and algebraic structures are also available:

    `ordered_cancel_comm_monoid`
    `ordered_comm_group ordered_semiring`
    `linear_ordered_semiring`
    `linear_ordered_comm_ring`
    `linear_ordered_field`

All these mathematical structures relate `≤` and `<` with `0`, `1`, `+`, and `*`
by monotonicity rules (e.g., `a ≤ b → c ≤ d → a + c ≤ b + d`) and cancellation
rules (e.g., `c + a ≤ c + b → a ≤ b`). -/

end LoVe


open Nat

theorem zero_add (n : Nat) : 0 + n = n :=
Nat.recOn (motive := fun x : Nat => 0 + x = x) n
(show 0 + 0 = 0 from rfl)
(fun (n : Nat) (ih : 0 + n = n) => show 0 + succ n = succ n from
calc 0 + succ n = succ (0 + n) := rfl
              _ = succ n := by rw [ih])

open List

def append (as bs : List α) : List α :=
match as with
| nil       => bs
| cons head tail => cons head (append tail bs)

theorem append_nil (as : List α) : append as nil = as :=
List.recOn (motive := fun t : List α => append t nil = t) as
(show append nil nil = nil from rfl)
(fun (head : α) (tail : List α) (ih : append tail nil = tail) => show append (cons head tail) nil = cons head tail from
calc append (cons head tail) nil = cons head (append tail nil) := rfl
    _ = cons head tail := by rw [ih])

theorem append_assoc (as bs cs : List α) : append (append as bs) cs = append as (append bs cs) :=
List.recOn (motive := fun as : List α => append (append as bs) cs = append as (append bs cs)) as
(show append (append nil bs) cs = append nil (append bs cs) from rfl)
(fun (head : α) (tail : List α) (ih : append (append tail bs) cs = append tail (append bs cs)) =>
show append (append (cons head tail) bs) cs = append (cons head tail) (append bs cs) from
calc append (append (cons head tail) bs) cs = append (cons head (append tail bs)) cs := rfl
    _ = cons head (append (append tail bs) cs) := rfl
    _ = cons head (append tail (append bs cs)) := by rw [ih])

def len (as : List α) : Nat :=
match as with
| nil => 0
| cons _ tail => succ (length tail)

theorem len_distrib (as bs : List α) : length (append as bs) = length as + length bs :=
List.recOn (motive := fun as : List α => length (append as bs) = length as + length bs) as
(show length (append nil bs) = length nil + length bs from
calc length (append nil bs) = length bs := rfl
     _ = 0 + length bs := by rw [Nat.zero_add])
(fun (head : α) (tail : List α) (ih : length (append tail bs) = length tail + length bs) =>
show length (append (cons head tail) bs) = length (cons head tail) + length bs from
calc length (append (cons head tail) bs) = length (cons head (append tail bs)) := rfl
     _ = succ (length (append tail bs)) := rfl
     _ = succ (length tail + length bs) := by rw [ih]
     _ = succ (length tail) + length bs := by rw [Nat.succ_add])

namespace Hidden

theorem trans {α : Type u} {a b c : α} (h₁ : Eq a b) (h₂ : Eq b c) : Eq a c := by rw [h₁,h₂]

theorem congr {α β : Type u} {a b : α} (f : α → β) (h : Eq a b) : Eq (f a) (f b) := by rw [h]

def subtract (n m : Nat) : Nat :=
match m with
| zero => n
| succ k => pred (subtract n k)

theorem pred_sub_eq_sub_pred : pred (subtract n k) = subtract (pred n) k :=
Nat.recOn (motive := fun x : Nat => pred (subtract n x) = subtract (pred n) x) k
(show pred (subtract n zero) = subtract (pred n) zero from rfl)
(fun (r : Nat) (ih : pred (subtract n r) = subtract (pred n) r) =>
show pred (subtract n (succ r)) = subtract (pred n) (succ r) from
by rw [subtract,ih,subtract])

theorem left_sub_cancel : subtract (n+k) n = k :=
Nat.recOn (motive := fun x : Nat => subtract (x+k) x = k) n
(show subtract (zero + k) zero = k from by rw [Nat.zero_add k,subtract])
(fun (r : Nat) (ih : subtract (r+k) r = k) =>
show subtract ((succ r)+k) (succ r) = k from
by rw [Nat.succ_add,subtract,pred_sub_eq_sub_pred, Nat.pred_succ,ih])