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

/-!

# 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 topological_space filter
open_locale nnreal ennreal measure_theory probability_theory big_operators topology

namespace measure_theory

variables {Ω ι : Type*} {m0 : measurable_space Ω} {μ : 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 lower_crossing_time_aux [preorder ι] [has_Inf ι] (a : ℝ) (f : ι → Ω → ℝ) (c N : ι) : Ω → ι :=
hitting f (set.Iic a) c N

/-- `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 upper_crossing_time [preorder ι] [order_bot ι] [has_Inf ι]
  (a b : ℝ) (f : ι → Ω → ℝ) (N : ι) : ℕ → Ω → ι
| 0 := ⊥
| (n + 1) := λ ω, hitting f (set.Ici b)
    (lower_crossing_time_aux a f (upper_crossing_time n ω) N ω) N ω

/-- `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 lower_crossing_time [preorder ι] [order_bot ι] [has_Inf ι]
  (a b : ℝ) (f : ι → Ω → ℝ) (N : ι) (n : ℕ) : Ω → ι :=
λ ω, hitting f (set.Iic a) (upper_crossing_time a b f N n ω) N ω

section

variables [preorder ι] [order_bot ι] [has_Inf ι]
variables {a b : ℝ} {f : ι → Ω → ℝ} {N : ι} {n m : ℕ} {ω : Ω}

@[simp]
lemma upper_crossing_time_zero : upper_crossing_time a b f N 0 = ⊥ := rfl

@[simp]
lemma lower_crossing_time_zero : lower_crossing_time a b f N 0 = hitting f (set.Iic a) ⊥ N := rfl

lemma upper_crossing_time_succ :
  upper_crossing_time a b f N (n + 1) ω =
  hitting f (set.Ici b) (lower_crossing_time_aux a f (upper_crossing_time a b f N n ω) N ω) N ω :=
by rw upper_crossing_time

lemma upper_crossing_time_succ_eq (ω : Ω) :
  upper_crossing_time a b f N (n + 1) ω =
  hitting f (set.Ici b) (lower_crossing_time a b f N n ω) N ω :=
begin
  simp only [upper_crossing_time_succ],
  refl,
end

end

section conditionally_complete_linear_order_bot

variables [conditionally_complete_linear_order_bot ι]
variables {a b : ℝ} {f : ι → Ω → ℝ} {N : ι} {n m : ℕ} {ω : Ω}

lemma upper_crossing_time_le : upper_crossing_time a b f N n ω ≤ N :=
begin
  cases n,
  { simp only [upper_crossing_time_zero, pi.bot_apply, bot_le] },
  { simp only [upper_crossing_time_succ, hitting_le] },
end

@[simp]
lemma upper_crossing_time_zero' : upper_crossing_time a b f ⊥ n ω = ⊥ :=
eq_bot_iff.2 upper_crossing_time_le

lemma lower_crossing_time_le : lower_crossing_time a b f N n ω ≤ N :=
by simp only [lower_crossing_time, hitting_le ω]

lemma upper_crossing_time_le_lower_crossing_time :
  upper_crossing_time a b f N n ω ≤ lower_crossing_time a b f N n ω :=
by simp only [lower_crossing_time, le_hitting upper_crossing_time_le ω]

lemma lower_crossing_time_le_upper_crossing_time_succ :
  lower_crossing_time a b f N n ω ≤ upper_crossing_time a b f N (n + 1) ω :=
begin
  rw upper_crossing_time_succ,
  exact le_hitting lower_crossing_time_le ω,
end

lemma lower_crossing_time_mono (hnm : n ≤ m) :
  lower_crossing_time a b f N n ω ≤ lower_crossing_time a b f N m ω :=
begin
  suffices : monotone (λ n, lower_crossing_time a b f N n ω),
  { exact this hnm },
  exact monotone_nat_of_le_succ
    (λ n, le_trans lower_crossing_time_le_upper_crossing_time_succ
    upper_crossing_time_le_lower_crossing_time)
end

lemma upper_crossing_time_mono (hnm : n ≤ m) :
  upper_crossing_time a b f N n ω ≤ upper_crossing_time a b f N m ω :=
begin
  suffices : monotone (λ n, upper_crossing_time a b f N n ω),
  { exact this hnm },
  exact monotone_nat_of_le_succ
    (λ n, le_trans upper_crossing_time_le_lower_crossing_time
    lower_crossing_time_le_upper_crossing_time_succ),
end

end conditionally_complete_linear_order_bot

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

lemma stopped_value_lower_crossing_time (h : lower_crossing_time a b f N n ω ≠ N) :
  stopped_value f (lower_crossing_time a b f N n) ω ≤ a :=
begin
  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₂⟩,
end

lemma stopped_value_upper_crossing_time (h : upper_crossing_time a b f N (n + 1) ω ≠ N) :
  b ≤ stopped_value f (upper_crossing_time a b f N (n + 1)) ω :=
begin
  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₂⟩,
end

lemma upper_crossing_time_lt_lower_crossing_time
  (hab : a < b) (hn : lower_crossing_time a b f N (n + 1) ω ≠ N) :
  upper_crossing_time a b f N (n + 1) ω < lower_crossing_time a b f N (n + 1) ω :=
begin
  refine lt_of_le_of_ne upper_crossing_time_le_lower_crossing_time
    (λ 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),
end

lemma lower_crossing_time_lt_upper_crossing_time
  (hab : a < b) (hn : upper_crossing_time a b f N (n + 1) ω ≠ N) :
  lower_crossing_time a b f N n ω < upper_crossing_time a b f N (n + 1) ω :=
begin
  refine lt_of_le_of_ne lower_crossing_time_le_upper_crossing_time_succ
    (λ 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),
end

lemma upper_crossing_time_lt_succ (hab : a < b) (hn : upper_crossing_time a b f N (n + 1) ω ≠ N) :
  upper_crossing_time a b f N n ω < upper_crossing_time a b f N (n + 1) ω :=
lt_of_le_of_lt upper_crossing_time_le_lower_crossing_time
  (lower_crossing_time_lt_upper_crossing_time hab hn)

lemma lower_crossing_time_stabilize (hnm : n ≤ m) (hn : lower_crossing_time a b f N n ω = N) :
  lower_crossing_time a b f N m ω = N :=
le_antisymm lower_crossing_time_le (le_trans (le_of_eq hn.symm) (lower_crossing_time_mono hnm))

lemma upper_crossing_time_stabilize (hnm : n ≤ m) (hn : upper_crossing_time a b f N n ω = N) :
  upper_crossing_time a b f N m ω = N :=
le_antisymm upper_crossing_time_le (le_trans (le_of_eq hn.symm) (upper_crossing_time_mono hnm))

lemma lower_crossing_time_stabilize' (hnm : n ≤ m) (hn : N ≤ lower_crossing_time a b f N n ω) :
  lower_crossing_time a b f N m ω = N :=
lower_crossing_time_stabilize hnm (le_antisymm lower_crossing_time_le hn)

lemma upper_crossing_time_stabilize' (hnm : n ≤ m) (hn : N ≤ upper_crossing_time a b f N n ω) :
  upper_crossing_time a b f N m ω = N :=
upper_crossing_time_stabilize hnm (le_antisymm upper_crossing_time_le hn)

-- `upper_crossing_time_bound_eq` provides an explicit bound
lemma exists_upper_crossing_time_eq (f : ℕ → Ω → ℝ) (N : ℕ) (ω : Ω) (hab : a < b) :
  ∃ n, upper_crossing_time a b f N n ω = N :=
begin
  by_contra h, push_neg at h,
  have : strict_mono (λ n, upper_crossing_time a b f N n ω) :=
    strict_mono_nat_of_lt_succ (λ n, upper_crossing_time_lt_succ hab (h _)),
  obtain ⟨_, ⟨k, rfl⟩, hk⟩ :
    ∃ m (hm : m ∈ set.range (λ 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) (strict_mono.id_le this (N + 1))⟩,
  exact not_le.2 hk upper_crossing_time_le
end

lemma upper_crossing_time_lt_bdd_above (hab : a < b) :
  bdd_above {n | upper_crossing_time a b f N n ω < N} :=
begin
  obtain ⟨k, hk⟩ := exists_upper_crossing_time_eq f N ω hab,
  refine ⟨k, λ 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)
end

lemma upper_crossing_time_lt_nonempty (hN : 0 < N) :
  {n | upper_crossing_time a b f N n ω < N}.nonempty :=
⟨0, hN⟩

lemma upper_crossing_time_bound_eq (f : ℕ → Ω → ℝ) (N : ℕ) (ω : Ω) (hab : a < b) :
  upper_crossing_time a b f N N ω = N :=
begin
  by_cases hN' : N < nat.find (exists_upper_crossing_time_eq f N ω hab),
  { refine le_antisymm upper_crossing_time_le _,
    have hmono : strict_mono_on (λ n, upper_crossing_time a b f N n ω)
      (set.Iic (nat.find (exists_upper_crossing_time_eq f N ω hab)).pred),
    { refine strict_mono_on_Iic_of_lt_succ (λ m hm, upper_crossing_time_lt_succ hab _),
      rw nat.lt_pred_iff at hm,
      convert nat.find_min _ hm },
    convert strict_mono_on.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)) }
end

lemma upper_crossing_time_eq_of_bound_le (hab : a < b) (hn : N ≤ n) :
  upper_crossing_time a b f N n ω = N :=
le_antisymm upper_crossing_time_le
  ((le_trans (upper_crossing_time_bound_eq f N ω hab).symm.le (upper_crossing_time_mono hn)))

variables {ℱ : filtration ℕ m0}

lemma adapted.is_stopping_time_crossing (hf : adapted ℱ f) :
  is_stopping_time ℱ (upper_crossing_time a b f N n) ∧
  is_stopping_time ℱ (lower_crossing_time a b f N n) :=
begin
  induction n with k ih,
  { refine ⟨is_stopping_time_const _ 0, _⟩,
    simp [hitting_is_stopping_time hf measurable_set_Iic] },
  { obtain ⟨ih₁, ih₂⟩ := ih,
    have : is_stopping_time ℱ (upper_crossing_time a b f N (k + 1)),
    { intro n,
      simp_rw upper_crossing_time_succ_eq,
      exact is_stopping_time_hitting_is_stopping_time ih₂ (λ _, lower_crossing_time_le)
        measurable_set_Ici hf _ },
    refine ⟨this, _⟩,
    { intro n,
      exact is_stopping_time_hitting_is_stopping_time this (λ _, upper_crossing_time_le)
        measurable_set_Iic hf _ } }
end

lemma adapted.is_stopping_time_upper_crossing_time (hf : adapted ℱ f) :
  is_stopping_time ℱ (upper_crossing_time a b f N n) :=
hf.is_stopping_time_crossing.1

lemma adapted.is_stopping_time_lower_crossing_time (hf : adapted ℱ f) :
  is_stopping_time ℱ (lower_crossing_time a b f N n) :=
hf.is_stopping_time_crossing.2

/-- `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 upcrossing_strat (a b : ℝ) (f : ℕ → Ω → ℝ) (N n : ℕ) (ω : Ω) : ℝ :=
∑ k in finset.range N,
  (set.Ico (lower_crossing_time a b f N k ω) (upper_crossing_time a b f N (k + 1) ω)).indicator 1 n

lemma upcrossing_strat_nonneg : 0 ≤ upcrossing_strat a b f N n ω :=
finset.sum_nonneg (λ i hi, set.indicator_nonneg (λ ω hω, zero_le_one) _)

lemma upcrossing_strat_le_one : upcrossing_strat a b f N n ω ≤ 1 :=
begin
  rw [upcrossing_strat, ← set.indicator_finset_bUnion_apply],
  { exact set.indicator_le_self' (λ _ _, zero_le_one) _ },
  { intros 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')) } }
end

lemma adapted.upcrossing_strat_adapted (hf : adapted ℱ f) :
  adapted ℱ (upcrossing_strat a b f N) :=
begin
  intro n,
  change strongly_measurable[ℱ n] (λ ω, ∑ 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.strongly_measurable_sum _ (λ 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,
end

lemma submartingale.sum_upcrossing_strat_mul [is_finite_measure μ] (hf : submartingale f ℱ μ)
  (a b : ℝ) (N : ℕ) :
  submartingale
    (λ n : ℕ, ∑ k in finset.range n, upcrossing_strat a b f N k * (f (k + 1) - f k)) ℱ μ :=
hf.sum_mul_sub hf.adapted.upcrossing_strat_adapted
  (λ _ _, upcrossing_strat_le_one) (λ _ _, upcrossing_strat_nonneg)

lemma submartingale.sum_sub_upcrossing_strat_mul [is_finite_measure μ] (hf : submartingale f ℱ μ)
  (a b : ℝ) (N : ℕ) :
  submartingale
    (λ n : ℕ, ∑ k in finset.range n, (1 - upcrossing_strat a b f N k) * (f (k + 1) - f k)) ℱ μ :=
begin
  refine hf.sum_mul_sub (λ n, (adapted_const ℱ 1 n).sub (hf.adapted.upcrossing_strat_adapted n))
    (_ : ∀ n ω, (1 - upcrossing_strat a b f N n) ω ≤ 1) _,
  { exact λ n ω, sub_le_self _ upcrossing_strat_nonneg },
  { intros n ω,
    simp [upcrossing_strat_le_one] }
end

lemma submartingale.sum_mul_upcrossing_strat_le [is_finite_measure μ] (hf : submartingale f ℱ μ) :
  μ[∑ k in finset.range n, upcrossing_strat a b f N k * (f (k + 1) - f k)] ≤
  μ[f n] - μ[f 0] :=
begin
  have h₁ : (0 : ℝ) ≤
    μ[∑ k in finset.range n, (1 - upcrossing_strat a b f N k) * (f (k + 1) - f k)],
  { have := (hf.sum_sub_upcrossing_strat_mul a b N).set_integral_le (zero_le n) measurable_set.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)],
  { 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 _ (λ i hi, hf.integrable _))
      (integrable_finset_sum _ (λ 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 _)],
end

/-- The number of upcrossings (strictly) before time `N`. -/
noncomputable
def upcrossings_before [preorder ι] [order_bot ι] [has_Inf ι]
  (a b : ℝ) (f : ι → Ω → ℝ) (N : ι) (ω : Ω) : ℕ :=
Sup {n | upper_crossing_time a b f N n ω < N}

@[simp]
lemma upcrossings_before_bot [preorder ι] [order_bot ι] [has_Inf ι]
  {a b : ℝ} {f : ι → Ω → ℝ} {ω : Ω} :
  upcrossings_before a b f ⊥ ω = ⊥ :=
by simp [upcrossings_before]

lemma upcrossings_before_zero :
  upcrossings_before a b f 0 ω = 0 :=
by simp [upcrossings_before]

@[simp] lemma upcrossings_before_zero' :
  upcrossings_before a b f 0 = 0 :=
by { ext ω, exact upcrossings_before_zero }

lemma upper_crossing_time_lt_of_le_upcrossings_before
  (hN : 0 < N) (hab : a < b) (hn : n ≤ upcrossings_before a b f N ω) :
  upper_crossing_time a b f N n ω < N :=
begin
  have : upper_crossing_time a b f N (upcrossings_before a b f N ω) ω < N :=
    (upper_crossing_time_lt_nonempty hN).cSup_mem
    ((order_bot.bdd_below _).finite_of_bdd_above (upper_crossing_time_lt_bdd_above hab)),
  exact lt_of_le_of_lt (upper_crossing_time_mono hn) this,
end

lemma upper_crossing_time_eq_of_upcrossings_before_lt
  (hab : a < b) (hn : upcrossings_before a b f N ω < n) :
  upper_crossing_time a b f N n ω = N :=
begin
  refine le_antisymm upper_crossing_time_le (not_lt.1 _),
  convert not_mem_of_cSup_lt hn (upper_crossing_time_lt_bdd_above hab),
end

lemma upcrossings_before_le (f : ℕ → Ω → ℝ) (ω : Ω) (hab : a < b) :
  upcrossings_before a b f N ω ≤ N :=
begin
  by_cases hN : N = 0,
  { subst hN,
    rw upcrossings_before_zero },
  { refine cSup_le ⟨0, zero_lt_iff.2 hN⟩ (λ n (hn : _ < _), _),
    by_contra hnN,
    exact hn.ne (upper_crossing_time_eq_of_bound_le hab (not_le.1 hnN).le) },
end

lemma crossing_eq_crossing_of_lower_crossing_time_lt {M : ℕ} (hNM : N ≤ M)
  (h : lower_crossing_time a b f N n ω < N) :
  upper_crossing_time a b f M n ω = upper_crossing_time a b f N n ω ∧
  lower_crossing_time a b f M n ω = lower_crossing_time a b f N n ω :=
begin
  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.nat_zero_eq_zero, upper_crossing_time_zero, bot_eq_zero', eq_self_iff_true,
      lower_crossing_time_zero, true_and, 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 ω,
    { 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, { apply_instance },
    obtain ⟨j, hj₁, hj₂⟩ := h,
    exact ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩ }
end

lemma crossing_eq_crossing_of_upper_crossing_time_lt {M : ℕ} (hNM : N ≤ M)
  (h : upper_crossing_time a b f N (n + 1) ω < N) :
  upper_crossing_time a b f M (n + 1) ω = upper_crossing_time a b f N (n + 1) ω ∧
  lower_crossing_time a b f M n ω = lower_crossing_time a b f N n ω :=
begin
  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₂⟩
end

lemma upper_crossing_time_eq_upper_crossing_time_of_lt {M : ℕ} (hNM : N ≤ M)
  (h : upper_crossing_time a b f N n ω < N) :
  upper_crossing_time a b f M n ω = upper_crossing_time a b f N n ω :=
begin
  cases n,
  { simp },
  { exact (crossing_eq_crossing_of_upper_crossing_time_lt hNM h).1 }
end

lemma upcrossings_before_mono (hab : a < b) :
  monotone (λ N ω, upcrossings_before a b f N ω) :=
begin
  intros 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 (λ n hn, _),
    rw [set.mem_set_of_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'] }
end

lemma upcrossings_before_lt_of_exists_upcrossing (hab : a < b) {N₁ N₂ : ℕ}
  (hN₁: N ≤ N₁) (hN₁': f N₁ ω < a) (hN₂: N₁ ≤ N₂) (hN₂': b < f N₂ ω) :
  upcrossings_before a b f N ω < upcrossings_before a b f (N₂ + 1) ω :=
begin
  refine lt_of_lt_of_le (nat.lt_succ_self _) (le_cSup (upper_crossing_time_lt_bdd_above hab) _),
  rw [set.mem_set_of_eq, upper_crossing_time_succ_eq, hitting_lt_iff _ le_rfl],
  swap,
  { apply_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],
      refl } },
end

lemma lower_crossing_time_lt_of_lt_upcrossings_before
  (hN : 0 < N) (hab : a < b) (hn : n < upcrossings_before a b f N ω) :
  lower_crossing_time a b f N n ω < N :=
lt_of_le_of_lt lower_crossing_time_le_upper_crossing_time_succ
  (upper_crossing_time_lt_of_le_upcrossings_before hN hab hn)

lemma le_sub_of_le_upcrossings_before
  (hN : 0 < N) (hab : a < b) (hn : n < upcrossings_before a b f N ω) :
  b - a ≤
  stopped_value f (upper_crossing_time a b f N (n + 1)) ω -
  stopped_value f (lower_crossing_time a b f N n) ω :=
sub_le_sub (stopped_value_upper_crossing_time
  (upper_crossing_time_lt_of_le_upcrossings_before hN hab hn).ne)
  (stopped_value_lower_crossing_time (lower_crossing_time_lt_of_lt_upcrossings_before hN hab hn).ne)

lemma sub_eq_zero_of_upcrossings_before_lt (hab : a < b) (hn : upcrossings_before a b f N ω < n) :
  stopped_value f (upper_crossing_time a b f N (n + 1)) ω -
  stopped_value f (lower_crossing_time a b f N n) ω = 0 :=
begin
  have : N ≤ upper_crossing_time a b f N n ω,
  { rw upcrossings_before at hn,
    rw ← not_lt,
    exact λ 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)]
end

lemma mul_upcrossings_before_le (hf : a ≤ f N ω) (hab : a < b) :
  (b - a) * upcrossings_before a b f N ω ≤
  ∑ k in finset.range N, upcrossing_strat a b f N k ω * (f (k + 1) - f k) ω :=
begin
  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
    (λ 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) ω,
  { intro k,
    rw [finset.sum_indicator_eq_sum_filter, (_ : (finset.filter
      (λ 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 (λ n, f n ω), finset.sum_range_sub (λ n, f n ω), neg_sub,
      sub_add_sub_cancel],
    { refl },
    { ext i,
      simp only [set.mem_Ico, finset.mem_filter, finset.mem_range, finset.mem_Ico,
        and_iff_right_iff_imp, and_imp],
      exact λ _ 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) ω),
  { 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) ω) :
    begin
      refine finset.sum_le_sum (λ i hi, le_sub_of_le_upcrossings_before (zero_lt_iff.2 hN) hab _),
      rwa finset.mem_range at hi,
    end
    ...≤ ∑ 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) ω) :
    begin
      refine finset.sum_le_sum_of_subset_of_nonneg
        (finset.range_subset.2 (upcrossings_before_le f ω hab)) (λ 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') },
    end },
  refine le_trans _ h₂,
  rw [finset.sum_const, finset.card_range, nsmul_eq_mul, mul_comm],
end

lemma integral_mul_upcrossings_before_le_integral [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (hfN : ∀ ω, a ≤ f N ω) (hfzero : 0 ≤ f 0)  (hab : a < b) :
  (b - a) * μ[upcrossings_before a b f N] ≤ μ[f N] :=
calc (b - a) * μ[upcrossings_before a b f N]
    ≤ μ[∑ k in finset.range N, upcrossing_strat a b f N k * (f (k + 1) - f k)] :
begin
  rw ← integral_mul_left,
  refine integral_mono_of_nonneg _ ((hf.sum_upcrossing_strat_mul a b N).integrable N) _,
  { exact eventually_of_forall (λ ω, mul_nonneg (sub_nonneg.2 hab.le) (nat.cast_nonneg _)) },
  { refine eventually_of_forall (λ ω, _),
    simpa using mul_upcrossings_before_le (hfN ω) hab },
end
  ...≤ μ[f N] - μ[f 0] : hf.sum_mul_upcrossing_strat_le
  ...≤ μ[f N] : (sub_le_self_iff _).2 (integral_nonneg hfzero)

lemma crossing_pos_eq (hab : a < b) :
  upper_crossing_time 0 (b - a) (λ n ω, (f n ω - a)⁺) N n = upper_crossing_time a b f N n ∧
  lower_crossing_time 0 (b - a) (λ n ω, (f n ω - a)⁺) N n = lower_crossing_time a b f N n :=
begin
  have hab' : 0 < b - a := sub_pos.2 hab,
  have hf : ∀ ω i, b - a ≤ (f i ω - a)⁺ ↔ b ≤ f i ω,
  { intros i ω,
    refine ⟨λ h, _, λ h, _⟩,
    { rwa [← sub_le_sub_iff_right a,
        ← lattice_ordered_comm_group.pos_eq_self_of_pos_pos (lt_of_lt_of_le hab' h)] },
    { rw ← sub_le_sub_iff_right a at h,
      rwa lattice_ordered_comm_group.pos_of_nonneg _ (le_trans hab'.le h) } },
  have hf' : ∀ ω i, (f i ω - a)⁺ ≤ 0 ↔ f i ω ≤ a,
  { intros ω i,
    rw [lattice_ordered_comm_group.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₂) },
    { refl } },
  { have : upper_crossing_time 0 (b - a) (λ n ω, (f n ω - a)⁺) N (k + 1) =
      upper_crossing_time a b f N (k + 1),
    { 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₂) },
      { refl } },
    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₂) },
    { refl } }
end

lemma upcrossings_before_pos_eq (hab : a < b) :
  upcrossings_before 0 (b - a) (λ n ω, (f n ω - a)⁺) N ω = upcrossings_before a b f N ω :=
by simp_rw [upcrossings_before, (crossing_pos_eq hab).1]

lemma mul_integral_upcrossings_before_le_integral_pos_part_aux [is_finite_measure μ]
  (hf : submartingale f ℱ μ) (hab : a < b) :
  (b - a) * μ[upcrossings_before a b f N] ≤ μ[λ ω, (f N ω - a)⁺] :=
begin
  refine le_trans (le_of_eq _) (integral_mul_upcrossings_before_le_integral
    (hf.sub_martingale (martingale_const _ _ _)).pos
    (λ ω, lattice_ordered_comm_group.pos_nonneg _)
    (λ ω, lattice_ordered_comm_group.pos_nonneg _) (sub_pos.2 hab)),
  simp_rw [sub_zero, ← upcrossings_before_pos_eq hab],
  refl,
end

/-- **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_upcrossings_before_le_integral_pos_part [is_finite_measure μ]
  (a b : ℝ) (hf : submartingale f ℱ μ) (N : ℕ) :
  (b - a) * μ[upcrossings_before a b f N] ≤ μ[λ ω, (f N ω - a)⁺] :=
begin
  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 (λ ω, nat.cast_nonneg _)))
      (integral_nonneg (λ ω, lattice_ordered_comm_group.pos_nonneg _)) }
end

/-!

### 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.

-/

lemma upcrossings_before_eq_sum (hab : a < b) :
  upcrossings_before a b f N ω =
  ∑ i in finset.Ico 1 (N + 1), {n | upper_crossing_time a b f N n ω < N}.indicator 1 i :=
begin
  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,
  { rintro k hk,
    rw finset.mem_Ico at hk,
    rw set.indicator_of_mem,
    { refl },
    { 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,
  { rintro k hk,
    rw [finset.mem_Ico, nat.succ_le_iff] at hk,
    rw set.indicator_of_not_mem,
    simp only [set.mem_set_of_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, mul_zero, nat.card_Ico, nat.add_succ_sub_one,
    add_zero, add_zero],
end

lemma adapted.measurable_upcrossings_before (hf : adapted ℱ f) (hab : a < b) :
  measurable (upcrossings_before a b f N) :=
begin
  have : upcrossings_before a b f N =
    λ ω, ∑ i in finset.Ico 1 (N + 1), {n | upper_crossing_time a b f N n ω < N}.indicator 1 i,
  { ext ω,
    exact upcrossings_before_eq_sum hab },
  rw this,
  exact finset.measurable_sum _ (λ i hi, measurable.indicator measurable_const $
    ℱ.le N _ (hf.is_stopping_time_upper_crossing_time.measurable_set_lt_of_pred N))
end

lemma adapted.integrable_upcrossings_before [is_finite_measure μ]
  (hf : adapted ℱ f) (hab : a < b) :
  integrable (λ ω, (upcrossings_before a b f N ω : ℝ)) μ :=
begin
  have : ∀ᵐ ω ∂μ, ‖(upcrossings_before a b f N ω : ℝ)‖ ≤ N,
  { refine eventually_of_forall (λ ω, _),
    rw [real.norm_eq_abs, nat.abs_cast, nat.cast_le],
    refine upcrossings_before_le _ _ hab },
  exact ⟨measurable.ae_strongly_measurable
    (measurable_from_top.comp (hf.measurable_upcrossings_before hab)),
    has_finite_integral_of_bounded this⟩
end

/-- 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 ι] [order_bot ι] [has_Inf ι]
  (a b : ℝ) (f : ι → Ω → ℝ) (ω : Ω) : ℝ≥0∞ :=
⨆ N, (upcrossings_before a b f N ω : ℝ≥0∞)

lemma adapted.measurable_upcrossings (hf : adapted ℱ f) (hab : a < b) :
  measurable (upcrossings a b f) :=
measurable_supr (λ N, measurable_from_top.comp (hf.measurable_upcrossings_before hab))

lemma upcrossings_lt_top_iff :
  upcrossings a b f ω < ∞ ↔ ∃ k, ∀ N, upcrossings_before a b f N ω ≤ k :=
begin
  have : upcrossings a b f ω < ∞ ↔ ∃ k : ℝ≥0, upcrossings a b f ω ≤ k,
  { split,
    { 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, supr_le_iff],
  split; rintro ⟨k, hk⟩,
  { obtain ⟨m, hm⟩ := exists_nat_ge k,
    refine ⟨m, λ N, nat.cast_le.1 ((hk N).trans _)⟩,
    rwa [← ennreal.coe_nat, ennreal.coe_le_coe] },
  { refine ⟨k, λ N, _⟩,
    simp only [ennreal.coe_nat, nat.cast_le, hk N] }
end

/-- A variant of Doob's upcrossing estimate obtained by taking the supremum on both sides. -/
lemma submartingale.mul_lintegral_upcrossings_le_lintegral_pos_part [is_finite_measure μ]
  (a b : ℝ) (hf : submartingale f ℱ μ) :
  ennreal.of_real (b - a) * ∫⁻ ω, upcrossings a b f ω ∂μ ≤
  ⨆ N, ∫⁻ ω, ennreal.of_real ((f N ω - a)⁺) ∂μ :=
begin
  by_cases hab : a < b,
  { simp_rw [upcrossings],
    have : ∀ N, ∫⁻ ω, ennreal.of_real ((f N ω - a)⁺) ∂μ = ennreal.of_real (∫ ω, (f N ω - a)⁺ ∂μ),
    { intro N,
      rw of_real_integral_eq_lintegral_of_real,
      { exact (hf.sub_martingale (martingale_const _ _ _)).pos.integrable _ },
      { exact eventually_of_forall (λ ω, lattice_ordered_comm_group.pos_nonneg _) } },
    rw lintegral_supr',
    { simp_rw [this, ennreal.mul_supr, supr_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.of_real_mul (sub_pos.2 hab).le],
      { simp_rw [nnreal.coe_nat_cast],
        exact (ennreal.of_real_le_of_real
          (hf.mul_integral_upcrossings_before_le_integral_pos_part a b N)).trans (le_supr _ N) },
      { simp only [nnreal.coe_nat_cast, hf.adapted.integrable_upcrossings_before hab] } },
    { exact λ n, measurable_from_top.comp_ae_measurable
        (hf.adapted.measurable_upcrossings_before  hab).ae_measurable },
    { refine eventually_of_forall (λ ω N M hNM, _),
      rw nat.cast_le,
      exact upcrossings_before_mono hab hNM ω } },
  { rw [not_lt, ← sub_nonpos] at hab,
    rw [ennreal.of_real_of_nonpos hab, zero_mul],
    exact zero_le _ }
end

end measure_theory


import algebra.big_operators.basic

/-!
# The four functions theorem and FKG inequality

-/

open_locale big_operators

variables {α β : Type*}

section lattice
variables [lattice α] [has_mul β] [has_le β]

def log_super_modular (f : α → β) : Prop := ∀ a b, f a * f b ≤ f (a ⊔ b) * f (a ⊓ b)

end lattice

protected lemma linear_order.log_super_modular [linear_order α] [comm_semigroup β] [preorder β]
  (f : α → β) :
  log_super_modular f :=
λ a b, by cases le_total a b; simp [h, mul_comm]

section finset
variables [decidable_eq α] [ordered_semiring β] {f f₁ f₂ f₃ f₄ g μ : finset α → β}

/-- The **four functions theorem** -/
lemma four_functions_theorem' {u : finset α}  (h₁ : ∀ s ⊆ u, 0 ≤ f₁ s) (h₂ : ∀ s ⊆ u, 0 ≤ f₂ s)
  (h₃ : ∀ s ⊆ u, 0 ≤ f₃ s) (h₄ : ∀ s ⊆ u, 0 ≤ f₄ s)
  (h : ∀ a b, f₁ a * f₂ b ≤ f₃ (a ⊔ b) * f₄ (a ⊓ b)) {s t : finset (finset α)} (hs : s ⊆ u.powerset) (ht : t ⊆ u.powerset) :
  (∑ a in s, f₁ a) * (∑ b in t, f₂ b) ≤ (∑ a in s ∪ t, f₃ a) * (∑ b in s ∩ t, f₄ b) :=
begin
  induction u using finset.induction with a u h9 ih generalizing f₁ f₂ f₃ f₄,
  { simp only [finset.powerset_empty, finset.subset_singleton_iff] at hs ht,
    obtain rfl | rfl := hs; obtain rfl | rfl := ht; simpa using h ∅ ∅ <|> simp
  },

end

end finset

variables [distrib_lattice α] [decidable_eq α] [ordered_semiring β]
  {f f₁ f₂ f₃ f₄ g μ : α → β}

/-- The **four functions theorem** -/
lemma four_functions_theorem {s t u : finset α} (h₁ : ∀ a ∈ u, 0 ≤ f₁ a) (h₂ : ∀ a ∈ u,  0 ≤ f₂)
  (h₃ : ∀ a ∈ u,  0 ≤ f₃) (h₄ : ∀ a ∈ u,  0 ≤ f₄)
  (h : ∀ a b, f₁ a * f₂ b ≤ f₃ (a ⊔ b) * f₄ (a ⊓ b)) (hs : s ⊆ u) (ht : t ⊆ u) :
  (∑ a in s, f₁ a) * (∑ b in t, f₂ b) ≤ (∑ a in s ∪ t, f₃ a) * (∑ b in s ∩ t, f₄ b) :=
begin
  sorry,
end

protected lemma log_super_modular.sum (hf : 0 ≤ f) :
  log_super_modular f → log_super_modular (λ s, ∑ a in s, f a) :=
four_functions_theorem hf hf hf hf

lemma fkg (hμ : 0 ≤ μ) (hf : monotone f) (hg : monotone g) :
  (∑ a, f a * μ a) * (∑ a, g a * μ a) ≤ (∑ a, f a * g a * μ a) * (∑ a, μ a) :=
begin
  sorry
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad
-/
import data.finset.image
import tactic.by_contra

/-!
# Cardinality of a finite set

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

This defines the cardinality of a `finset` and provides induction principles for finsets.

## Main declarations

* `finset.card`: `s.card : ℕ` returns the cardinality of `s : finset α`.

### Induction principles

* `finset.strong_induction`: Strong induction
* `finset.strong_induction_on`
* `finset.strong_downward_induction`
* `finset.strong_downward_induction_on`
* `finset.case_strong_induction_on`

## TODO

Should we add a noncomputable version?
-/

open function multiset nat

variables {α β : Type*}

namespace finset
variables {s t : finset α} {a b : α}

/-- `s.card` is the number of elements of `s`, aka its cardinality. -/
def card (s : finset α) : ℕ := s.1.card

lemma card_def (s : finset α) : s.card = s.1.card := rfl

@[simp] lemma card_mk {m nodup} : (⟨m, nodup⟩ : finset α).card = m.card := rfl

@[simp] lemma card_empty : card (∅ : finset α) = 0 := rfl

lemma card_le_of_subset : s ⊆ t → s.card ≤ t.card := multiset.card_le_of_le ∘ val_le_iff.mpr

@[mono] lemma card_mono : monotone (@card α) := by apply card_le_of_subset

@[simp] lemma card_eq_zero : s.card = 0 ↔ s = ∅ := card_eq_zero.trans val_eq_zero

lemma card_pos : 0 < s.card ↔ s.nonempty :=
pos_iff_ne_zero.trans $ (not_congr card_eq_zero).trans nonempty_iff_ne_empty.symm

alias card_pos ↔ _ nonempty.card_pos

lemma card_ne_zero_of_mem (h : a ∈ s) : s.card ≠ 0 := (not_congr card_eq_zero).2 $ ne_empty_of_mem h

@[simp] lemma card_singleton (a : α) : card ({a} : finset α) = 1 := card_singleton _

lemma card_singleton_inter [decidable_eq α] : ({a} ∩ s).card ≤ 1 :=
begin
  cases (finset.decidable_mem a s),
  { simp [finset.singleton_inter_of_not_mem h] },
  { simp [finset.singleton_inter_of_mem h] }
end

@[simp] lemma card_cons (h : a ∉ s) : (s.cons a h).card = s.card + 1 := card_cons _ _

section insert_erase
variables [decidable_eq α]

@[simp] lemma card_insert_of_not_mem (h : a ∉ s) : (insert a s).card = s.card + 1 :=
by rw [←cons_eq_insert _ _ h, card_cons]

lemma card_insert_of_mem (h : a ∈ s) : card (insert a s) = s.card := by rw insert_eq_of_mem h

lemma card_insert_le (a : α) (s : finset α) : card (insert a s) ≤ s.card + 1 :=
by by_cases a ∈ s; [{rw insert_eq_of_mem h, exact nat.le_succ _ }, rw card_insert_of_not_mem h]

/-- If `a ∈ s` is known, see also `finset.card_insert_of_mem` and `finset.card_insert_of_not_mem`.
-/
lemma card_insert_eq_ite : card (insert a s) = if a ∈ s then s.card else s.card + 1 :=
begin
  by_cases h : a ∈ s,
  { rw [card_insert_of_mem h, if_pos h] },
  { rw [card_insert_of_not_mem h, if_neg h] }
end

@[simp] lemma card_doubleton (h : a ≠ b) : ({a, b} : finset α).card = 2 :=
by rw [card_insert_of_not_mem (not_mem_singleton.2 h), card_singleton]

@[simp] lemma card_erase_of_mem : a ∈ s → (s.erase a).card = s.card - 1 := card_erase_of_mem
@[simp] lemma card_erase_add_one : a ∈ s → (s.erase a).card + 1 = s.card := card_erase_add_one

lemma card_erase_lt_of_mem : a ∈ s → (s.erase a).card < s.card := card_erase_lt_of_mem

lemma card_erase_le : (s.erase a).card ≤ s.card := card_erase_le

lemma pred_card_le_card_erase : s.card - 1 ≤ (s.erase a).card :=
begin
  by_cases h : a ∈ s,
  { exact (card_erase_of_mem h).ge },
  { rw erase_eq_of_not_mem h,
    exact nat.sub_le _ _ }
end

/-- If `a ∈ s` is known, see also `finset.card_erase_of_mem` and `finset.erase_eq_of_not_mem`. -/
lemma card_erase_eq_ite : (s.erase a).card = if a ∈ s then s.card - 1 else s.card :=
card_erase_eq_ite

end insert_erase

@[simp] lemma card_range (n : ℕ) : (range n).card = n := card_range n

@[simp] lemma card_attach : s.attach.card = s.card := multiset.card_attach

end finset

section to_list_multiset
variables [decidable_eq α] (m : multiset α) (l : list α)

lemma multiset.card_to_finset : m.to_finset.card = m.dedup.card := rfl

lemma multiset.to_finset_card_le : m.to_finset.card ≤ m.card := card_le_of_le $ dedup_le _

lemma multiset.to_finset_card_of_nodup {m : multiset α} (h : m.nodup) : m.to_finset.card = m.card :=
congr_arg card $ multiset.dedup_eq_self.mpr h

lemma list.card_to_finset : l.to_finset.card = l.dedup.length := rfl

lemma list.to_finset_card_le : l.to_finset.card ≤ l.length := multiset.to_finset_card_le ⟦l⟧

lemma list.to_finset_card_of_nodup {l : list α} (h : l.nodup) : l.to_finset.card = l.length :=
multiset.to_finset_card_of_nodup h

end to_list_multiset

namespace finset
variables {s t : finset α} {f : α → β} {n : ℕ}

@[simp] lemma length_to_list (s : finset α) : s.to_list.length = s.card :=
by { rw [to_list, ←multiset.coe_card, multiset.coe_to_list], refl }

lemma card_image_le [decidable_eq β] : (s.image f).card ≤ s.card :=
by simpa only [card_map] using (s.1.map f).to_finset_card_le

lemma card_image_of_inj_on [decidable_eq β] (H : set.inj_on f s) : (s.image f).card = s.card :=
by simp only [card, image_val_of_inj_on H, card_map]

lemma inj_on_of_card_image_eq [decidable_eq β] (H : (s.image f).card = s.card) : set.inj_on f s :=
begin
  change (s.1.map f).dedup.card = s.1.card at H,
  have : (s.1.map f).dedup = s.1.map f,
  { refine multiset.eq_of_le_of_card_le (multiset.dedup_le _) _,
    rw H,
    simp only [multiset.card_map] },
  rw multiset.dedup_eq_self at this,
  exact inj_on_of_nodup_map this,
end

lemma card_image_iff [decidable_eq β] : (s.image f).card = s.card ↔ set.inj_on f s :=
⟨inj_on_of_card_image_eq, card_image_of_inj_on⟩

lemma card_image_of_injective [decidable_eq β] (s : finset α) (H : injective f) :
  (s.image f).card = s.card :=
card_image_of_inj_on $ λ x _ y _ h, H h

@[simp] lemma card_map (f : α ↪ β) : (s.map f).card = s.card := multiset.card_map _ _

@[simp] lemma card_subtype (p : α → Prop) [decidable_pred p] (s : finset α) :
  (s.subtype p).card = (s.filter p).card :=
by simp [finset.subtype]

lemma card_filter_le (s : finset α) (p : α → Prop) [decidable_pred p] :
  (s.filter p).card ≤ s.card :=
card_le_of_subset $ filter_subset _ _

lemma eq_of_subset_of_card_le {s t : finset α} (h : s ⊆ t) (h₂ : t.card ≤ s.card) : s = t :=
eq_of_veq $ multiset.eq_of_le_of_card_le (val_le_iff.mpr h) h₂

lemma eq_of_superset_of_card_ge (hst : s ⊆ t) (hts : t.card ≤ s.card) : t = s :=
(eq_of_subset_of_card_le hst hts).symm

lemma subset_iff_eq_of_card_le (h : t.card ≤ s.card) : s ⊆ t ↔ s = t :=
⟨λ hst, eq_of_subset_of_card_le hst h, eq.subset'⟩

lemma map_eq_of_subset {f : α ↪ α} (hs : s.map f ⊆ s) : s.map f = s :=
eq_of_subset_of_card_le hs (card_map _).ge

lemma filter_card_eq {p : α → Prop} [decidable_pred p] (h : (s.filter p).card = s.card) (x : α)
  (hx : x ∈ s) :
  p x :=
begin
  rw [←eq_of_subset_of_card_le (s.filter_subset p) h.ge, mem_filter] at hx,
  exact hx.2,
end

lemma card_lt_card (h : s ⊂ t) : s.card < t.card := card_lt_of_lt $ val_lt_iff.2 h

lemma card_eq_of_bijective (f : ∀ i, i < n → α) (hf : ∀ a ∈ s, ∃ i, ∃ h : i < n, f i h = a)
  (hf' : ∀ i (h : i < n), f i h ∈ s) (f_inj : ∀ i j (hi : i < n)
  (hj : j < n), f i hi = f j hj → i = j) :
  s.card = n :=
begin
  classical,
  have : ∀ (a : α), a ∈ s ↔ ∃ i (hi : i ∈ range n), f i (mem_range.1 hi) = a,
    from λ a, ⟨λ ha, let ⟨i, hi, eq⟩ := hf a ha in ⟨i, mem_range.2 hi, eq⟩,
      λ ⟨i, hi, eq⟩, eq ▸ hf' i (mem_range.1 hi)⟩,
  have : s = ((range n).attach.image $ λi, f i.1 (mem_range.1 i.2)),
    by simpa only [ext_iff, mem_image, exists_prop, subtype.exists, mem_attach, true_and],
  calc s.card = card ((range n).attach.image $ λ i, f i.1 (mem_range.1 i.2)) :
      by rw this
    ... = card ((range n).attach) :
      card_image_of_injective _ $ λ ⟨i, hi⟩ ⟨j, hj⟩ eq,
        subtype.eq $ f_inj i j (mem_range.1 hi) (mem_range.1 hj) eq
    ... = card (range n) : card_attach
    ... = n : card_range n
end

lemma card_congr {t : finset β} (f : Π a ∈ s, β) (h₁ : ∀ a ha, f a ha ∈ t)
  (h₂ : ∀ a b ha hb, f a ha = f b hb → a = b) (h₃ : ∀ b ∈ t, ∃ a ha, f a ha = b) :
  s.card = t.card :=
by classical;
calc s.card = s.attach.card : card_attach.symm
... = (s.attach.image (λ (a : {a // a ∈ s}), f a.1 a.2)).card
    : eq.symm (card_image_of_injective _ $ λ a b h, subtype.eq $ h₂ _ _ _ _ h)
... = t.card : congr_arg card (finset.ext $ λ b,
    ⟨λ h, let ⟨a, ha₁, ha₂⟩ := mem_image.1 h in ha₂ ▸ h₁ _ _,
      λ h, let ⟨a, ha₁, ha₂⟩ := h₃ b h in mem_image.2 ⟨⟨a, ha₁⟩, by simp [ha₂]⟩⟩)

lemma card_le_card_of_inj_on {t : finset β} (f : α → β) (hf : ∀ a ∈ s, f a ∈ t)
  (f_inj : ∀ a₁ ∈ s, ∀ a₂ ∈ s, f a₁ = f a₂ → a₁ = a₂) :
  s.card ≤ t.card :=
by classical;
  calc s.card = (s.image f).card : (card_image_of_inj_on f_inj).symm
    ... ≤ t.card : card_le_of_subset $ image_subset_iff.2 hf

/-- If there are more pigeons than pigeonholes, then there are two pigeons in the same pigeonhole.
-/
lemma exists_ne_map_eq_of_card_lt_of_maps_to {t : finset β} (hc : t.card < s.card)
  {f : α → β} (hf : ∀ a ∈ s, f a ∈ t) :
  ∃ (x ∈ s) (y ∈ s), x ≠ y ∧ f x = f y :=
begin
  classical,
  by_contra' hz,
  refine hc.not_le (card_le_card_of_inj_on f hf _),
  intros x hx y hy, contrapose, exact hz x hx y hy,
end

lemma le_card_of_inj_on_range (f : ℕ → α) (hf : ∀ i < n, f i ∈ s)
  (f_inj : ∀ (i < n) (j < n), f i = f j → i = j) :
  n ≤ s.card :=
calc n = card (range n) : (card_range n).symm
  ... ≤ s.card : card_le_card_of_inj_on f (by simpa only [mem_range]) (by simpa only [mem_range])

lemma surj_on_of_inj_on_of_card_le {t : finset β} (f : Π a ∈ s, β) (hf : ∀ a ha, f a ha ∈ t)
  (hinj : ∀ a₁ a₂ ha₁ ha₂, f a₁ ha₁ = f a₂ ha₂ → a₁ = a₂) (hst : t.card ≤ s.card) :
  ∀ b ∈ t, ∃ a ha, b = f a ha :=
begin
  classical,
  intros b hb,
  have h : (s.attach.image $ λ (a : {a // a ∈ s}), f a a.prop).card = s.card,
  { exact @card_attach _ s ▸ card_image_of_injective _
      (λ ⟨a₁, ha₁⟩ ⟨a₂, ha₂⟩ h, subtype.eq $ hinj _ _ _ _ h) },
  have h' : image (λ a : {a // a ∈ s}, f a a.prop) s.attach = t,
  { exact eq_of_subset_of_card_le (λ b h, let ⟨a, ha₁, ha₂⟩ := mem_image.1 h in
      ha₂ ▸ hf _ _) (by simp [hst, h]) },
  rw ←h' at hb,
  obtain ⟨a, ha₁, ha₂⟩ := mem_image.1 hb,
  exact ⟨a, a.2, ha₂.symm⟩,
end

lemma inj_on_of_surj_on_of_card_le {t : finset β} (f : Π a ∈ s, β) (hf : ∀ a ha, f a ha ∈ t)
  (hsurj : ∀ b ∈ t, ∃ a ha, b = f a ha) (hst : s.card ≤ t.card) ⦃a₁ a₂⦄ (ha₁ : a₁ ∈ s)
  (ha₂ : a₂ ∈ s) (ha₁a₂: f a₁ ha₁ = f a₂ ha₂) :
  a₁ = a₂ :=
by haveI : inhabited {x // x ∈ s} := ⟨⟨a₁, ha₁⟩⟩; exact
let f' : {x // x ∈ s} → {x // x ∈ t} := λ x, ⟨f x.1 x.2, hf x.1 x.2⟩ in
let g : {x // x ∈ t} → {x // x ∈ s} :=
  @surj_inv _ _ f'
    (λ x, let ⟨y, hy₁, hy₂⟩ := hsurj x.1 x.2 in ⟨⟨y, hy₁⟩, subtype.eq hy₂.symm⟩) in
have hg : injective g, from injective_surj_inv _,
have hsg : surjective g, from λ x,
  let ⟨y, hy⟩ := surj_on_of_inj_on_of_card_le (λ (x : {x // x ∈ t}) (hx : x ∈ t.attach), g x)
    (λ x _, show (g x) ∈ s.attach, from mem_attach _ _)
    (λ x y _ _ hxy, hg hxy) (by simpa) x (mem_attach _ _) in
  ⟨y, hy.snd.symm⟩,
have hif : injective f',
  from (left_inverse_of_surjective_of_right_inverse hsg
      (right_inverse_surj_inv _)).injective,
subtype.ext_iff_val.1 (@hif ⟨a₁, ha₁⟩ ⟨a₂, ha₂⟩ (subtype.eq ha₁a₂))

@[simp] lemma card_disj_union (s t : finset α) (h) : (s.disj_union t h).card = s.card + t.card :=
multiset.card_add _ _

/-! ### Lattice structure -/

section lattice
variables [decidable_eq α]

lemma card_union_add_card_inter (s t : finset α) : (s ∪ t).card + (s ∩ t).card = s.card + t.card :=
finset.induction_on t (by simp) $ λ a r har, by by_cases a ∈ s; simp *; cc

lemma card_inter_add_card_union (s t : finset α) : (s ∩ t).card + (s ∪ t).card = s.card + t.card :=
by rw [add_comm, card_union_add_card_inter]

lemma card_union_le (s t : finset α) : (s ∪ t).card ≤ s.card + t.card :=
card_union_add_card_inter s t ▸ nat.le_add_right _ _

lemma card_union_eq (h : disjoint s t) : (s ∪ t).card = s.card + t.card :=
by rw [←disj_union_eq_union s t h, card_disj_union _ _ _]

@[simp] lemma card_disjoint_union (h : disjoint s t) : card (s ∪ t) = s.card + t.card :=
card_union_eq h

lemma card_sdiff (h : s ⊆ t) : card (t \ s) = t.card - s.card :=
suffices card (t \ s) = card ((t \ s) ∪ s) - s.card, by rwa sdiff_union_of_subset h at this,
by rw [card_disjoint_union sdiff_disjoint, add_tsub_cancel_right]

lemma card_sdiff_add_card_eq_card {s t : finset α} (h : s ⊆ t) : card (t \ s) + card s = card t :=
((nat.sub_eq_iff_eq_add (card_le_of_subset h)).mp (card_sdiff h).symm).symm

lemma le_card_sdiff (s t : finset α) : t.card - s.card ≤ card (t \ s) :=
calc card t - card s
      ≤ card t - card (s ∩ t) : tsub_le_tsub_left (card_le_of_subset (inter_subset_left s t)) _
  ... = card (t \ (s ∩ t)) : (card_sdiff (inter_subset_right s t)).symm
  ... ≤ card (t \ s) : by rw sdiff_inter_self_right t s

lemma card_le_card_sdiff_add_card : s.card ≤ (s \ t).card + t.card :=
tsub_le_iff_right.1 $ le_card_sdiff _ _

lemma card_sdiff_add_card : (s \ t).card + t.card = (s ∪ t).card :=
by rw [←card_disjoint_union sdiff_disjoint, sdiff_union_self_eq_union]

end lattice

lemma filter_card_add_filter_neg_card_eq_card (p : α → Prop) [decidable_pred p] :
  (s.filter p).card + (s.filter (not ∘ p)).card = s.card :=
by { classical, simp [←card_union_eq, filter_union_filter_neg_eq, disjoint_filter] }

/-- Given a set `A` and a set `B` inside it, we can shrink `A` to any appropriate size, and keep `B`
inside it. -/
lemma exists_intermediate_set {A B : finset α} (i : ℕ) (h₁ : i + card B ≤ card A) (h₂ : B ⊆ A) :
  ∃ (C : finset α), B ⊆ C ∧ C ⊆ A ∧ card C = i + card B :=
begin
  classical,
  rcases nat.le.dest h₁ with ⟨k, _⟩,
  clear h₁,
  induction k with k ih generalizing A,
  { exact ⟨A, h₂, subset.refl _, h.symm⟩ },
  have : (A \ B).nonempty,
  { rw [←card_pos, card_sdiff h₂, ←h, nat.add_right_comm,
        add_tsub_cancel_right, nat.add_succ],
    apply nat.succ_pos },
  rcases this with ⟨a, ha⟩,
  have z : i + card B + k = card (erase A a),
  { rw [card_erase_of_mem (mem_sdiff.1 ha).1, ←h],
    refl },
  rcases ih _ z with ⟨B', hB', B'subA', cards⟩,
  { exact ⟨B', hB', trans B'subA' (erase_subset _ _), cards⟩ },
  { rintro t th,
    apply mem_erase_of_ne_of_mem _ (h₂ th),
    rintro rfl,
    exact not_mem_sdiff_of_mem_right th ha }
end

/-- We can shrink `A` to any smaller size. -/
lemma exists_smaller_set (A : finset α) (i : ℕ) (h₁ : i ≤ card A) :
  ∃ (B : finset α), B ⊆ A ∧ card B = i :=
let ⟨B, _, x₁, x₂⟩ := exists_intermediate_set i (by simpa) (empty_subset A) in ⟨B, x₁, x₂⟩

lemma exists_subset_or_subset_of_two_mul_lt_card [decidable_eq α] {X Y : finset α} {n : ℕ}
  (hXY : 2 * n < (X ∪ Y).card) :
  ∃ C : finset α, n < C.card ∧ (C ⊆ X ∨ C ⊆ Y) :=
begin
  have h₁ : (X ∩ (Y \ X)).card = 0 := finset.card_eq_zero.mpr (finset.inter_sdiff_self X Y),
  have h₂ : (X ∪ Y).card = X.card + (Y \ X).card,
  { rw [←card_union_add_card_inter X (Y \ X), finset.union_sdiff_self_eq_union, h₁, add_zero] },
  rw [h₂, two_mul] at hXY,
  rcases lt_or_lt_of_add_lt_add hXY with h|h,
  { exact ⟨X, h, or.inl (finset.subset.refl X)⟩ },
  { exact ⟨Y \ X, h, or.inr (finset.sdiff_subset Y X)⟩ }
end

/-! ### Explicit description of a finset from its card -/

lemma card_eq_one : s.card = 1 ↔ ∃ a, s = {a} :=
by cases s; simp only [multiset.card_eq_one, finset.card, ←val_inj, singleton_val]

lemma exists_eq_insert_iff [decidable_eq α] {s t : finset α} :
  (∃ a ∉ s, insert a s = t) ↔ s ⊆ t ∧ s.card + 1 = t.card :=
begin
  split,
  { rintro ⟨a, ha, rfl⟩,
    exact ⟨subset_insert _ _, (card_insert_of_not_mem ha).symm⟩ },
  { rintro ⟨hst, h⟩,
    obtain ⟨a, ha⟩ : ∃ a, t \ s = {a},
    { exact card_eq_one.1 (by rw [card_sdiff hst, ←h, add_tsub_cancel_left]) },
    refine ⟨a, λ hs, (_ : a ∉ {a}) $ mem_singleton_self _,
      by rw [insert_eq, ←ha, sdiff_union_of_subset hst]⟩,
    rw ←ha,
    exact not_mem_sdiff_of_mem_right hs }
end

lemma card_le_one : s.card ≤ 1 ↔ ∀ (a ∈ s) (b ∈ s), a = b :=
begin
  obtain rfl | ⟨x, hx⟩ := s.eq_empty_or_nonempty,
  { simp },
  refine (nat.succ_le_of_lt (card_pos.2 ⟨x, hx⟩)).le_iff_eq.trans (card_eq_one.trans ⟨_, _⟩),
  { rintro ⟨y, rfl⟩,
    simp },
  { exact λ h, ⟨x, eq_singleton_iff_unique_mem.2 ⟨hx, λ y hy, h _ hy _ hx⟩⟩ }
end

lemma card_le_one_iff : s.card ≤ 1 ↔ ∀ {a b}, a ∈ s → b ∈ s → a = b := by { rw card_le_one, tauto }

lemma card_le_one_iff_subset_singleton [nonempty α] : s.card ≤ 1 ↔ ∃ (x : α), s ⊆ {x} :=
begin
  refine ⟨λ H, _, _⟩,
  { obtain rfl | ⟨x, hx⟩ := s.eq_empty_or_nonempty,
    { exact ⟨classical.arbitrary α, empty_subset _⟩ },
    { exact ⟨x, λ y hy, by rw [card_le_one.1 H y hy x hx, mem_singleton]⟩ } },
  { rintro ⟨x, hx⟩,
    rw ←card_singleton x,
    exact card_le_of_subset hx }
end

/-- A `finset` of a subsingleton type has cardinality at most one. -/
lemma card_le_one_of_subsingleton [subsingleton α] (s : finset α) : s.card ≤ 1 :=
finset.card_le_one_iff.2 $ λ _ _ _ _, subsingleton.elim _ _

lemma one_lt_card : 1 < s.card ↔ ∃ (a ∈ s) (b ∈ s), a ≠ b :=
by { rw ←not_iff_not, push_neg, exact card_le_one }

lemma one_lt_card_iff : 1 < s.card ↔ ∃ a b, a ∈ s ∧ b ∈ s ∧ a ≠ b :=
by { rw one_lt_card, simp only [exists_prop, exists_and_distrib_left] }

lemma two_lt_card_iff : 2 < s.card ↔ ∃ a b c, a ∈ s ∧ b ∈ s ∧ c ∈ s ∧ a ≠ b ∧ a ≠ c ∧ b ≠ c :=
begin
  classical,
  refine ⟨λ h, _, _⟩,
  { obtain ⟨c, hc⟩ := card_pos.mp (zero_lt_two.trans h),
    have : 1 < (s.erase c).card := by rwa [←add_lt_add_iff_right 1, card_erase_add_one hc],
    obtain ⟨a, b, ha, hb, hab⟩ := one_lt_card_iff.mp this,
    exact ⟨a, b, c, mem_of_mem_erase ha, mem_of_mem_erase hb, hc,
      hab, ne_of_mem_erase ha, ne_of_mem_erase hb⟩ },
  { rintros ⟨a, b, c, ha, hb, hc, hab, hac, hbc⟩,
    rw [←card_erase_add_one hc, ←card_erase_add_one (mem_erase_of_ne_of_mem hbc hb),
        ←card_erase_add_one (mem_erase_of_ne_of_mem hab (mem_erase_of_ne_of_mem hac ha))],
    apply nat.le_add_left },
end

lemma two_lt_card : 2 < s.card ↔ ∃ (a ∈ s) (b ∈ s) (c ∈ s), a ≠ b ∧ a ≠ c ∧ b ≠ c :=
by simp_rw [two_lt_card_iff, exists_prop, exists_and_distrib_left]

lemma exists_ne_of_one_lt_card (hs : 1 < s.card) (a : α) : ∃ b, b ∈ s ∧ b ≠ a :=
begin
  obtain ⟨x, hx, y, hy, hxy⟩ := finset.one_lt_card.mp hs,
  by_cases ha : y = a,
  { exact ⟨x, hx, ne_of_ne_of_eq hxy ha⟩ },
  { exact ⟨y, hy, ha⟩ }
end

lemma card_eq_succ [decidable_eq α] : s.card = n + 1 ↔ ∃ a t, a ∉ t ∧ insert a t = s ∧ t.card = n :=
⟨λ h,
  let ⟨a, has⟩ := card_pos.mp (h.symm ▸ nat.zero_lt_succ _ : 0 < s.card) in
    ⟨a, s.erase a, s.not_mem_erase a, insert_erase has,
      by simp only [h, card_erase_of_mem has, add_tsub_cancel_right]⟩,
  λ ⟨a, t, hat, s_eq, n_eq⟩, s_eq ▸ n_eq ▸ card_insert_of_not_mem hat⟩

lemma card_eq_two [decidable_eq α] : s.card = 2 ↔ ∃ x y, x ≠ y ∧ s = {x, y} :=
begin
  split,
  { rw card_eq_succ,
    simp_rw [card_eq_one],
    rintro ⟨a, _, hab, rfl, b, rfl⟩,
    exact ⟨a, b, not_mem_singleton.1 hab, rfl⟩ },
  { rintro ⟨x, y, h, rfl⟩,
    exact card_doubleton h }
end

lemma card_eq_three [decidable_eq α] :
  s.card = 3 ↔ ∃ x y z, x ≠ y ∧ x ≠ z ∧ y ≠ z ∧ s = {x, y, z} :=
begin
  split,
  { rw card_eq_succ,
    simp_rw [card_eq_two],
    rintro ⟨a, _, abc, rfl, b, c, bc, rfl⟩,
    rw [mem_insert, mem_singleton, not_or_distrib] at abc,
    exact ⟨a, b, c, abc.1, abc.2, bc, rfl⟩ },
  { rintro ⟨x, y, z, xy, xz, yz, rfl⟩,
    simp only [xy, xz, yz, mem_insert, card_insert_of_not_mem, not_false_iff, mem_singleton,
      or_self, card_singleton] }
end

/-! ### Inductions -/

/-- Suppose that, given objects defined on all strict subsets of any finset `s`, one knows how to
define an object on `s`. Then one can inductively define an object on all finsets, starting from
the empty set and iterating. This can be used either to define data, or to prove properties. -/
def strong_induction {p : finset α → Sort*} (H : ∀ s, (∀ t ⊂ s, p t) → p s) :
  ∀ (s : finset α), p s
| s := H s (λ t h, have t.card < s.card, from card_lt_card h, strong_induction t)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf card⟩]}

lemma strong_induction_eq {p : finset α → Sort*} (H : ∀ s, (∀ t ⊂ s, p t) → p s) (s : finset α) :
  strong_induction H s = H s (λ t h, strong_induction H t) :=
by rw strong_induction

/-- Analogue of `strong_induction` with order of arguments swapped. -/
@[elab_as_eliminator] def strong_induction_on {p : finset α → Sort*} (s : finset α) :
  (∀ s, (∀ t ⊂ s, p t) → p s) → p s :=
λ H, strong_induction H s

lemma strong_induction_on_eq {p : finset α → Sort*} (s : finset α) (H : ∀ s, (∀ t ⊂ s, p t) → p s) :
  s.strong_induction_on H = H s (λ t h, t.strong_induction_on H) :=
by { dunfold strong_induction_on, rw strong_induction }

@[elab_as_eliminator] lemma case_strong_induction_on [decidable_eq α] {p : finset α → Prop}
  (s : finset α) (h₀ : p ∅) (h₁ : ∀ a s, a ∉ s → (∀ t ⊆ s, p t) → p (insert a s)) :
  p s :=
finset.strong_induction_on s $ λ s,
finset.induction_on s (λ _, h₀) $ λ a s n _ ih, h₁ a s n $
λ t ss, ih _ (lt_of_le_of_lt ss (ssubset_insert n) : t < _)

/-- Suppose that, given that `p t` can be defined on all supersets of `s` of cardinality less than
`n`, one knows how to define `p s`. Then one can inductively define `p s` for all finsets `s` of
cardinality less than `n`, starting from finsets of card `n` and iterating. This
can be used either to define data, or to prove properties. -/
def strong_downward_induction {p : finset α → Sort*} {n : ℕ} (H : ∀ t₁, (∀ {t₂ : finset α},
  t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁) :
  ∀ (s : finset α), s.card ≤ n → p s
| s := H s (λ t ht h, have n - t.card < n - s.card,
     from (tsub_lt_tsub_iff_left_of_le ht).2 (finset.card_lt_card h),
  strong_downward_induction t ht)
using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ (t : finset α), n - t.card)⟩]}

lemma strong_downward_induction_eq {p : finset α → Sort*}
  (H : ∀ t₁, (∀ {t₂ : finset α}, t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁)
  (s : finset α) :
  strong_downward_induction H s = H s (λ t ht hst, strong_downward_induction H t ht) :=
by rw strong_downward_induction

/-- Analogue of `strong_downward_induction` with order of arguments swapped. -/
@[elab_as_eliminator] def strong_downward_induction_on {p : finset α → Sort*} (s : finset α)
  (H : ∀ t₁, (∀ {t₂ : finset α}, t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁) :
  s.card ≤ n → p s :=
strong_downward_induction H s

lemma strong_downward_induction_on_eq {p : finset α → Sort*} (s : finset α) (H : ∀ t₁,
  (∀ {t₂ : finset α}, t₂.card ≤ n → t₁ ⊂ t₂ → p t₂) → t₁.card ≤ n → p t₁) :
  s.strong_downward_induction_on H = H s (λ t ht h, t.strong_downward_induction_on H ht) :=
by { dunfold strong_downward_induction_on, rw strong_downward_induction }

lemma lt_wf {α} : well_founded (@has_lt.lt (finset α) _) :=
have H : subrelation (@has_lt.lt (finset α) _)
    (inv_image ( < ) card),
  from λ x y hxy, card_lt_card hxy,
subrelation.wf H $ inv_image.wf _ $ nat.lt_wf

end finset


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.subgroup.basic
import group_theory.submonoid.pointwise

/-! # Pointwise instances on `subgroup` and `add_subgroup`s

This file provides the actions

* `subgroup.pointwise_mul_action`
* `add_subgroup.pointwise_mul_action`

which matches the action of `mul_action_set`.

These actions are available in the `pointwise` locale.

## Implementation notes

This file is almost identical to `group_theory/submonoid/pointwise.lean`. Where possible, try to
keep them in sync.
-/

variables {α : Type*} {G : Type*} {A : Type*} [group G] [add_group A]

namespace subgroup

section monoid
variables [monoid α] [mul_distrib_mul_action α G]

/-- The action on a subgroup corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (subgroup G) :=
{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] subgroup.pointwise_mul_action" in pointwise
open_locale pointwise

lemma pointwise_smul_def {a : α} (S : subgroup G) :
  a • S = S.map (mul_distrib_mul_action.to_monoid_End _ _ a) := rfl

@[simp] lemma coe_pointwise_smul (a : α) (S : subgroup G) : ↑(a • S) = a • (S : set G) := rfl

@[simp] lemma pointwise_smul_to_submonoid (a : α) (S : subgroup G) :
  (a • S).to_submonoid = a • S.to_submonoid := rfl

lemma smul_mem_pointwise_smul (m : G) (a : α) (S : subgroup G) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set G))

end monoid

section group
variables [group α] [mul_distrib_mul_action α G]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : subgroup G} {x : G} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : subgroup G} {x : G} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : subgroup G} {x : G} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : subgroup G} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : α} {S T : subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : α} {S T : subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

/-- Applying a `mul_distrib_mul_action` results in an isomorphic subgroup -/
@[simps] def equiv_smul (a : α) (H : subgroup G) : H ≃* (a • H : subgroup G) :=
(mul_distrib_mul_action.to_mul_equiv G a).subgroup_equiv_map H

end group

section group_with_zero
variables [group_with_zero α] [mul_distrib_mul_action α G]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : subgroup G)
  (x : G) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set G) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : subgroup G) (x : G) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set G) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : subgroup G) (x : G) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set G) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end subgroup

namespace add_subgroup

section monoid
variables [monoid α] [distrib_mul_action α A]

/-- The action on an additive subgroup corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action α (add_subgroup A) :=
{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ _ a),
  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}

localized "attribute [instance] add_subgroup.pointwise_mul_action" in pointwise
open_locale pointwise

@[simp] lemma coe_pointwise_smul (a : α) (S : add_subgroup A) : ↑(a • S) = a • (S : set A) := rfl

@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : add_subgroup A) :
  (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl

lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_subgroup A) : m ∈ S → a • m ∈ a • S :=
(set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))

end monoid

section group
variables [group α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : α} {S : add_subgroup A} {x : A} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_subgroup A} {x : A} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : α} {S : add_subgroup A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : α} {S T : add_subgroup A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_le_iff {a : α} {S T : add_subgroup A} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma le_pointwise_smul_iff {a : α} {S T : add_subgroup A} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

end group

section group_with_zero
variables [group_with_zero α] [distrib_mul_action α A]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A)
  (x : A) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set A) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A) (x : A) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set A) x

lemma mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : add_subgroup A) (x : A) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set A) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : add_subgroup A} :
  S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end add_subgroup


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.basic
import data.list.range

/-! # `multiset.range n` gives `{0, 1, ..., n-1}` as a multiset.

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

open list nat

namespace multiset

/- range -/

/-- `range n` is the multiset lifted from the list `range n`,
  that is, the set `{0, 1, ..., n-1}`. -/
def range (n : ℕ) : multiset ℕ := range n

@[simp] theorem range_zero : range 0 = 0 := rfl

@[simp] theorem range_succ (n : ℕ) : range (succ n) = n ::ₘ range n :=
by rw [range, range_succ, ← coe_add, add_comm]; refl

@[simp] theorem card_range (n : ℕ) : card (range n) = n := length_range _

theorem range_subset {m n : ℕ} : range m ⊆ range n ↔ m ≤ n := range_subset

@[simp] theorem mem_range {m n : ℕ} : m ∈ range n ↔ m < n := mem_range

@[simp] theorem not_mem_range_self {n : ℕ} : n ∉ range n := not_mem_range_self

theorem self_mem_range_succ (n : ℕ) : n ∈ range (n + 1) := list.self_mem_range_succ n

lemma range_add (a b : ℕ) : range (a + b) = range a + (range b).map (λ x, a + x) :=
congr_arg coe (list.range_add _ _)

lemma range_disjoint_map_add (a : ℕ) (m : multiset ℕ) :
  (range a).disjoint (m.map (λ x, a + x)) :=
begin
  intros x hxa hxb,
  rw [range, mem_coe, list.mem_range] at hxa,
  obtain ⟨c, _, rfl⟩ := mem_map.1 hxb,
  exact (self_le_add_right _ _).not_lt hxa,
end

lemma range_add_eq_union (a b : ℕ) : range (a + b) = range a ∪ (range b).map (λ x, a + x) :=
by { rw [range_add, add_eq_union_iff_disjoint], apply range_disjoint_map_add }

end multiset


/-
Copyright (c) 2017 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Mario Carneiro

The complex numbers, modelled as R^2 in the obvious way.
-/
import data.real.basic tactic.ring algebra.field

structure complex : Type :=
(re : ℝ) (im : ℝ)

notation `ℂ` := complex

namespace complex

local attribute [pp_using_anonymous_constructor] complex

@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨a, b⟩ := rfl

theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

def of_real (r : ℝ) : ℂ := ⟨r, 0⟩
instance : has_coe ℝ ℂ := ⟨of_real⟩
@[simp] lemma of_real_eq_coe (r : ℝ) : of_real r = r := rfl

@[simp] lemma of_real_re (r : ℝ) : (r : ℂ).re = r := rfl
@[simp] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl

@[simp] theorem of_real_inj {z w : ℝ} : (z : ℂ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

instance : has_zero ℂ := ⟨(0 : ℝ)⟩
instance : inhabited ℂ := ⟨0⟩

@[simp] lemma zero_re : (0 : ℂ).re = 0 := rfl
@[simp] lemma zero_im : (0 : ℂ).im = 0 := rfl
lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℂ) = 0 ↔ z = 0 := of_real_inj
@[simp] theorem of_real_ne_zero {z : ℝ} : (z : ℂ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

instance : has_one ℂ := ⟨(1 : ℝ)⟩

@[simp] lemma one_re : (1 : ℂ).re = 1 := rfl
@[simp] lemma one_im : (1 : ℂ).im = 0 := rfl
@[simp] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

def I : ℂ := ⟨0, 1⟩

@[simp] lemma I_re : I.re = 0 := rfl
@[simp] lemma I_im : I.im = 1 := rfl

instance : has_add ℂ := ⟨λ z w, ⟨z.re + w.re, z.im + w.im⟩⟩

@[simp] lemma add_def (a b c d : ℝ) : (⟨a, b⟩ : ℂ) + ⟨c, d⟩ = ⟨a + c, b + d⟩ := rfl
@[simp] lemma add_re (z w : ℂ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℂ) : (z + w).im = z.im + w.im := rfl
@[simp] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s := rfl

@[simp] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r := rfl
@[simp] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r := rfl

instance : has_neg ℂ := ⟨λ z, ⟨-z.re, -z.im⟩⟩

@[simp] lemma neg_def (a b : ℝ) : -(⟨a, b⟩ : ℂ) = ⟨-a, -b⟩ := rfl
@[simp] lemma neg_re (z : ℂ) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℂ) : (-z).im = -z.im := rfl
@[simp] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r := ext_iff.2 $ by simp

instance : has_mul ℂ := ⟨λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩⟩

@[simp] lemma mul_def (a b c d : ℝ) : (⟨a, b⟩ : ℂ) * ⟨c, d⟩ = ⟨a * c - b * d, a * d + b * c⟩ := rfl
@[simp] lemma mul_re (z w : ℂ) : (z * w).re = z.re * w.re - z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℂ) : (z * w).im = z.re * w.im + z.im * w.re := rfl
@[simp] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s := ext_iff.2 $ by simp

lemma mk_eq_add_mul_I (a b : ℝ) : complex.mk a b = a + b * I :=
ext_iff.2 $ by simp

@[simp] lemma re_add_im (z : ℂ) : (z.re : ℂ) + z.im * I = z :=
ext_iff.2 $ by simp

def conj (z : ℂ) : ℂ := ⟨z.re, -z.im⟩

@[simp] lemma conj_def (a b : ℝ) : conj ⟨a, b⟩ = ⟨a, -b⟩ := rfl
@[simp] lemma conj_re (z : ℂ) : (conj z).re = z.re := rfl
@[simp] lemma conj_im (z : ℂ) : (conj z).im = -z.im := rfl

@[simp] lemma conj_of_real (r : ℝ) : conj r = r :=
ext_iff.2 $ by simp

@[simp] lemma conj_zero : conj 0 = 0 := conj_of_real 0
@[simp] lemma conj_one : conj 1 = 1 := conj_of_real 1
@[simp] lemma conj_I : conj I = -I := ext_iff.2 $ by simp

@[simp] lemma conj_add (z w : ℂ) : conj (z + w) = conj z + conj w :=
ext_iff.2 $ by simp

@[simp] lemma conj_neg (z : ℂ) : conj (-z) = -conj z :=
ext_iff.2 $ by simp

@[simp] lemma conj_mul (z w : ℂ) : conj (z * w) = conj z * conj w :=
ext_iff.2 $ by simp

@[simp] lemma conj_conj (z : ℂ) : conj (conj z) = z :=
ext_iff.2 $ by simp

lemma conj_bijective : function.bijective conj :=
⟨function.injective_of_has_left_inverse ⟨conj, conj_conj⟩,
 function.surjective_of_has_right_inverse ⟨conj, conj_conj⟩⟩

lemma conj_inj {z w : ℂ} : conj z = conj w ↔ z = w :=
conj_bijective.1.eq_iff

@[simp] lemma conj_eq_zero {z : ℂ} : conj z = 0 ↔ z = 0 :=
by simpa using @conj_inj z 0

@[simp] lemma eq_conj_iff_real (z : ℂ) : conj z = z ↔ ∃ r : ℝ, z = r :=
⟨λ h, ⟨z.re, ext rfl $ eq_zero_of_neg_eq (congr_arg im h)⟩,
 λ ⟨h, e⟩, e.symm ▸ rfl⟩

def norm_sq (z : ℂ) : ℝ := z.re * z.re + z.im * z.im

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
by simp [norm_sq]

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := by simp [norm_sq]
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := by simp [norm_sq]
@[simp] lemma norm_sq_I : norm_sq I = 1 := by simp [norm_sq]

lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z :=
add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)

@[simp] lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 :=
⟨λ h, ext
  (eq_zero_of_mul_self_add_mul_self_eq_zero h)
  (eq_zero_of_mul_self_add_mul_self_eq_zero $ (add_comm _ _).trans h),
 λ h, h.symm ▸ norm_sq_zero⟩

@[simp] lemma norm_sq_pos {z : ℂ} : 0 < norm_sq z ↔ z ≠ 0 :=
by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [norm_sq_nonneg]

@[simp] lemma norm_sq_neg (z : ℂ) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_conj (z : ℂ) : norm_sq (conj z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_mul (z w : ℂ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
by dsimp [norm_sq]; ring

lemma norm_sq_add (z w : ℂ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
by dsimp [norm_sq]; ring

lemma re_sq_le_norm_sq (z : ℂ) : z.re * z.re ≤ norm_sq z :=
le_add_of_nonneg_right (mul_self_nonneg _)

lemma im_sq_le_norm_sq (z : ℂ) : z.im * z.im ≤ norm_sq z :=
le_add_of_nonneg_left (mul_self_nonneg _)

theorem mul_conj (z : ℂ) : z * conj z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm]

theorem add_conj (z : ℂ) : z + conj z = (2 * z.re : ℝ) :=
ext_iff.2 $ by simp [two_mul]

instance : comm_ring ℂ :=
by refine { zero := 0, add := (+), neg := has_neg.neg, one := 1, mul := (*), ..};
   { intros, apply ext_iff.2; split; simp; ring }

lemma sub_def (a b c d : ℝ) : (⟨a, b⟩ : ℂ) - ⟨c, d⟩ = ⟨a - c, b - d⟩ := rfl
@[simp] lemma sub_re (z w : ℂ) : (z - w).re = z.re - w.re := rfl
@[simp] lemma sub_im (z w : ℂ) : (z - w).im = z.im - w.im := rfl
@[simp] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : ℂ) = r - s := rfl

theorem sub_conj (z : ℂ) : z - conj z = (2 * z.im : ℝ) * I :=
ext_iff.2 $ by simp [two_mul]

lemma norm_sq_sub (z w : ℂ) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * (z * conj w).re :=
by rw [sub_eq_add_neg, norm_sq_add]; simp [-mul_re]

noncomputable instance : has_inv ℂ := ⟨λ z, conj z * ((norm_sq z)⁻¹:ℝ)⟩

theorem inv_def (z : ℂ) : z⁻¹ = conj z * ((norm_sq z)⁻¹:ℝ) := rfl
@[simp] lemma inv_re (z : ℂ) : (z⁻¹).re = z.re / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_im (z : ℂ) : (z⁻¹).im = -z.im / norm_sq z := by simp [inv_def, division_def]

lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : ℂ) = r⁻¹ :=
ext_iff.2 $ begin
  simp,
  by_cases r = 0, {simp [h]},
  rw [← div_div_eq_div_mul, div_self h, one_div_eq_inv]
end

lemma inv_zero : (0⁻¹ : ℂ) = 0 :=
by rw [← of_real_zero, ← of_real_inv, inv_zero]

theorem mul_inv_cancel {z : ℂ} (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul,
  mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

noncomputable instance : discrete_field ℂ :=
{ inv := has_inv.inv,
  zero_ne_one := mt (congr_arg re) zero_ne_one,
  mul_inv_cancel := @mul_inv_cancel,
  inv_mul_cancel := λ z h, by rw [mul_comm, mul_inv_cancel h],
  inv_zero := inv_zero,
  has_decidable_eq := classical.dec_eq _,
  ..complex.comm_ring }

@[simp] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : ℂ) = r ^ n :=
by induction n; simp [pow_succ, *]

@[simp] lemma of_real_div (r s : ℝ) : ((r / s : ℝ) : ℂ) = r / s :=
by rw [division_def, of_real_mul, division_def, of_real_inv]

@[simp] theorem of_real_int_cast : ∀ n : ℤ, ((n : ℝ) : ℂ) = n :=
int.eq_cast (λ n, ((n : ℝ) : ℂ)) rfl (by simp)

@[simp] theorem of_real_nat_cast (n : ℕ) : ((n : ℝ) : ℂ) = n :=
by rw [← int.cast_coe_nat, of_real_int_cast]; refl

@[simp] lemma conj_inv (z : ℂ) : conj z⁻¹ = (conj z)⁻¹ :=
if h : z = 0 then by simp [h] else
(domain.mul_left_inj (mt conj_eq_zero.1 h)).1 $
by rw [← conj_mul]; simp [h, -conj_mul]

@[simp] lemma conj_div (z w : ℂ) : conj (z / w) = conj z / conj w :=
by rw [division_def, conj_mul, conj_inv]; refl

@[simp] lemma norm_sq_inv (z : ℂ) : norm_sq z⁻¹ = (norm_sq z)⁻¹ :=
if h : z = 0 then by simp [h] else
(domain.mul_left_inj (mt norm_sq_eq_zero.1 h)).1 $
by rw [← norm_sq_mul]; simp [h, -norm_sq_mul]

@[simp] lemma norm_sq_div (z w : ℂ) : norm_sq (z / w) = norm_sq z / norm_sq w :=
by rw [division_def, norm_sq_mul, norm_sq_inv]; refl

instance char_zero_complex : char_zero ℂ :=
add_group.char_zero_of_inj_zero $ λ n h,
by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h

@[simp] theorem of_real_rat_cast : ∀ n : ℚ, ((n : ℝ) : ℂ) = n :=
by apply rat.eq_cast (λ n, ((n : ℝ) : ℂ)); simp

theorem re_eq_add_conj (z : ℂ) : (z.re : ℂ) = (z + conj z) / 2 :=
by rw [add_conj]; simp; rw [mul_div_cancel_left (z.re:ℂ) two_ne_zero']

noncomputable def abs (z : ℂ) : ℝ := (norm_sq z).sqrt

local notation `abs'` := _root_.abs

@[simp] lemma abs_of_real (r : ℝ) : abs r = abs' r :=
by simp [abs, norm_sq_of_real, real.sqrt_mul_self_eq_abs]

lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : abs r = r :=
(abs_of_real _).trans (abs_of_nonneg h)

lemma mul_self_abs (z : ℂ) : abs z * abs z = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

@[simp] lemma abs_zero : abs 0 = 0 := by simp [abs]
@[simp] lemma abs_one : abs 1 = 1 := by simp [abs]
@[simp] lemma abs_I : abs I = 1 := by simp [abs]

lemma abs_nonneg (z : ℂ) : 0 ≤ abs z :=
real.sqrt_nonneg _

@[simp] lemma abs_eq_zero {z : ℂ} : abs z = 0 ↔ z = 0 :=
(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero

@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z :=
by simp [abs]

@[simp] lemma abs_mul (z w : ℂ) : abs (z * w) = abs z * abs w :=
by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl

lemma abs_re_le_abs (z : ℂ) : abs' z.re ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.re) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply re_sq_le_norm_sq

lemma abs_im_le_abs (z : ℂ) : abs' z.im ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.im) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply im_sq_le_norm_sq

lemma re_le_abs (z : ℂ) : z.re ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

lemma im_le_abs (z : ℂ) : z.im ≤ abs z :=
(abs_le.1 (abs_im_le_abs _)).2

lemma abs_add (z w : ℂ) : abs (z + w) ≤ abs z + abs w :=
(mul_self_le_mul_self_iff (abs_nonneg _)
  (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $
begin
  rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs,
      add_right_comm, norm_sq_add, add_le_add_iff_left,
      mul_assoc, mul_le_mul_left (@two_pos ℝ _)],
  simpa [-mul_re] using re_le_abs (z * conj w)
end

instance : is_absolute_value abs :=
{ abv_nonneg  := abs_nonneg,
  abv_eq_zero := λ _, abs_eq_zero,
  abv_add     := abs_add,
  abv_mul     := abs_mul }
open is_absolute_value

@[simp] lemma abs_abs (z : ℂ) : abs' (abs z) = abs z :=
_root_.abs_of_nonneg (abs_nonneg _)

@[simp] lemma abs_pos {z : ℂ} : 0 < abs z ↔ z ≠ 0 := abv_pos abs
@[simp] lemma abs_neg : ∀ z, abs (-z) = abs z := abv_neg abs
lemma abs_sub : ∀ z w, abs (z - w) = abs (w - z) := abv_sub abs
lemma abs_sub_le : ∀ a b c, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs
@[simp] theorem abs_inv : ∀ z, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs
@[simp] theorem abs_div : ∀ z w, abs (z / w) = abs z / abs w := abv_div abs
lemma abs_abs_sub_le_abs_sub : ∀ z w, abs' (abs z - abs w) ≤ abs (z - w) := abs_abv_sub_le_abv_sub abs

lemma abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ abs' z.re + abs' z.im :=
by simpa [re_add_im] using abs_add z.re (z.im * I)

noncomputable def lim (f : ℕ → ℂ) : ℂ :=
⟨real.lim (λ n, (f n).re), real.lim (λ n, (f n).im)⟩

theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).re) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij)

theorem is_cau_seq_im (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).im) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij)

theorem equiv_lim (f : cau_seq ℂ abs) : f ≈ cau_seq.const abs (lim f) :=
λ ε ε0, (exists_forall_ge_and
  (real.equiv_lim ⟨_, is_cau_seq_re f⟩ _ (half_pos ε0))
  (real.equiv_lim ⟨_, is_cau_seq_im f⟩ _ (half_pos ε0))).imp $
λ i H j ij, begin
  cases H _ ij with H₁ H₂,
  apply lt_of_le_of_lt (abs_le_abs_re_add_abs_im _),
  simpa using add_lt_add H₁ H₂
end

end complex