/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.finset.sort
import algebra.big_operators.order
import algebra.big_operators.fin

/-!
# Compositions

A composition of a natural number `n` is a decomposition `n = i₀ + ... + i_{k-1}` of `n` into a sum
of positive integers. Combinatorially, it corresponds to a decomposition of `{0, ..., n-1}` into
non-empty blocks of consecutive integers, where the `iⱼ` are the lengths of the blocks.
This notion is closely related to that of a partition of `n`, but in a composition of `n` the
order of the `iⱼ`s matters.

We implement two different structures covering these two viewpoints on compositions. The first
one, made of a list of positive integers summing to `n`, is the main one and is called
`composition n`. The second one is useful for combinatorial arguments (for instance to show that
the number of compositions of `n` is `2^(n-1)`). It is given by a subset of `{0, ..., n}`
containing `0` and `n`, where the elements of the subset (other than `n`) correspond to the leftmost
points of each block. The main API is built on `composition n`, and we provide an equivalence
between the two types.

## Main functions

* `c : composition n` is a structure, made of a list of integers which are all positive and
  add up to `n`.
* `composition_card` states that the cardinality of `composition n` is exactly
  `2^(n-1)`, which is proved by constructing an equiv with `composition_as_set n` (see below), which
  is itself in bijection with the subsets of `fin (n-1)` (this holds even for `n = 0`, where `-` is
  nat subtraction).

Let `c : composition n` be a composition of `n`. Then
* `c.blocks` is the list of blocks in `c`.
* `c.length` is the number of blocks in the composition.
* `c.blocks_fun : fin c.length → ℕ` is the realization of `c.blocks` as a function on
  `fin c.length`. This is the main object when using compositions to understand the composition of
    analytic functions.
* `c.size_up_to : ℕ → ℕ` is the sum of the size of the blocks up to `i`.;
* `c.embedding i : fin (c.blocks_fun i) → fin n` is the increasing embedding of the `i`-th block in
  `fin n`;
* `c.index j`, for `j : fin n`, is the index of the block containing `j`.

* `composition.ones n` is the composition of `n` made of ones, i.e., `[1, ..., 1]`.
* `composition.single n (hn : 0 < n)` is the composition of `n` made of a single block of size `n`.

Compositions can also be used to split lists. Let `l` be a list of length `n` and `c` a composition
of `n`.
* `l.split_wrt_composition c` is a list of lists, made of the slices of `l` corresponding to the
  blocks of `c`.
* `join_split_wrt_composition` states that splitting a list and then joining it gives back the
  original list.
* `split_wrt_composition_join` states that joining a list of lists, and then splitting it back
  according to the right composition, gives back the original list of lists.

We turn to the second viewpoint on compositions, that we realize as a finset of `fin (n+1)`.
`c : composition_as_set n` is a structure made of a finset of `fin (n+1)` called `c.boundaries`
and proofs that it contains `0` and `n`. (Taking a finset of `fin n` containing `0` would not
make sense in the edge case `n = 0`, while the previous description works in all cases).
The elements of this set (other than `n`) correspond to leftmost points of blocks.
Thus, there is an equiv between `composition n` and `composition_as_set n`. We
only construct basic API on `composition_as_set` (notably `c.length` and `c.blocks`) to be able
to construct this equiv, called `composition_equiv n`. Since there is a straightforward equiv
between `composition_as_set n` and finsets of `{1, ..., n-1}` (obtained by removing `0` and `n`
from a `composition_as_set` and called `composition_as_set_equiv n`), we deduce that
`composition_as_set n` and `composition n` are both fintypes of cardinality `2^(n - 1)`
(see `composition_as_set_card` and `composition_card`).

## Implementation details

The main motivation for this structure and its API is in the construction of the composition of
formal multilinear series, and the proof that the composition of analytic functions is analytic.

The representation of a composition as a list is very handy as lists are very flexible and already
have a well-developed API.

## Tags

Composition, partition

## References

<https://en.wikipedia.org/wiki/Composition_(combinatorics)>
-/

open list
open_locale big_operators

variable {n : ℕ}

/-- A composition of `n` is a list of positive integers summing to `n`. -/
@[ext] structure composition (n : ℕ) :=
(blocks : list ℕ)
(blocks_pos : ∀ {i}, i ∈ blocks → 0 < i)
(blocks_sum : blocks.sum = n)

/-- Combinatorial viewpoint on a composition of `n`, by seeing it as non-empty blocks of
consecutive integers in `{0, ..., n-1}`. We register every block by its left end-point, yielding
a finset containing `0`. As this does not make sense for `n = 0`, we add `n` to this finset, and
get a finset of `{0, ..., n}` containing `0` and `n`. This is the data in the structure
`composition_as_set n`. -/
@[ext] structure composition_as_set (n : ℕ) :=
(boundaries : finset (fin n.succ))
(zero_mem   : (0 : fin n.succ) ∈ boundaries)
(last_mem   : fin.last n ∈ boundaries)

instance {n : ℕ} : inhabited (composition_as_set n) :=
⟨⟨finset.univ, finset.mem_univ _, finset.mem_univ _⟩⟩

/-!
### Compositions

A composition of an integer `n` is a decomposition `n = i₀ + ... + i_{k-1}` of `n` into a sum of
positive integers.
-/

namespace composition

variables (c : composition n)

instance (n : ℕ) : has_to_string (composition n) :=
⟨λ c, to_string c.blocks⟩

/-- The length of a composition, i.e., the number of blocks in the composition. -/
@[reducible] def length : ℕ := c.blocks.length

lemma blocks_length : c.blocks.length = c.length := rfl

/-- The blocks of a composition, seen as a function on `fin c.length`. When composing analytic
functions using compositions, this is the main player. -/
def blocks_fun : fin c.length → ℕ := λ i, nth_le c.blocks i i.2

lemma of_fn_blocks_fun : of_fn c.blocks_fun = c.blocks :=
of_fn_nth_le _

lemma sum_blocks_fun : ∑ i, c.blocks_fun i = n :=
by conv_rhs { rw [← c.blocks_sum, ← of_fn_blocks_fun, sum_of_fn] }

lemma blocks_fun_mem_blocks (i : fin c.length) : c.blocks_fun i ∈ c.blocks :=
nth_le_mem _ _ _

@[simp] lemma one_le_blocks {i : ℕ} (h : i ∈ c.blocks) : 1 ≤ i :=
c.blocks_pos h

@[simp] lemma one_le_blocks' {i : ℕ} (h : i < c.length) : 1 ≤ nth_le c.blocks i h:=
c.one_le_blocks (nth_le_mem (blocks c) i h)

@[simp] lemma blocks_pos' (i : ℕ) (h : i < c.length) : 0 < nth_le c.blocks i h:=
c.one_le_blocks' h

lemma one_le_blocks_fun (i : fin c.length) : 1 ≤ c.blocks_fun i :=
c.one_le_blocks (c.blocks_fun_mem_blocks i)

lemma length_le : c.length ≤ n :=
begin
  conv_rhs { rw ← c.blocks_sum },
  exact length_le_sum_of_one_le _ (λ i hi, c.one_le_blocks hi)
end

lemma length_pos_of_pos (h : 0 < n) : 0 < c.length :=
begin
  apply length_pos_of_sum_pos,
  convert h,
  exact c.blocks_sum
end

/-- The sum of the sizes of the blocks in a composition up to `i`. -/
def size_up_to (i : ℕ) : ℕ := (c.blocks.take i).sum

@[simp] lemma size_up_to_zero : c.size_up_to 0 = 0 := by simp [size_up_to]

lemma size_up_to_of_length_le (i : ℕ) (h : c.length ≤ i) : c.size_up_to i = n :=
begin
  dsimp [size_up_to],
  convert c.blocks_sum,
  exact take_all_of_le h
end

@[simp] lemma size_up_to_length : c.size_up_to c.length = n :=
c.size_up_to_of_length_le c.length le_rfl

lemma size_up_to_le (i : ℕ) : c.size_up_to i ≤ n :=
begin
  conv_rhs { rw [← c.blocks_sum, ← sum_take_add_sum_drop _ i] },
  exact nat.le_add_right _ _
end

lemma size_up_to_succ {i : ℕ} (h : i < c.length) :
  c.size_up_to (i+1) = c.size_up_to i + c.blocks.nth_le i h :=
by { simp only [size_up_to], rw sum_take_succ _ _ h }

lemma size_up_to_succ' (i : fin c.length) :
  c.size_up_to ((i : ℕ) + 1) = c.size_up_to i + c.blocks_fun i :=
c.size_up_to_succ i.2

lemma size_up_to_strict_mono {i : ℕ} (h : i < c.length) : c.size_up_to i < c.size_up_to (i+1) :=
by { rw c.size_up_to_succ h, simp }

lemma monotone_size_up_to : monotone c.size_up_to :=
monotone_sum_take _

/-- The `i`-th boundary of a composition, i.e., the leftmost point of the `i`-th block. We include
a virtual point at the right of the last block, to make for a nice equiv with
`composition_as_set n`. -/
def boundary : fin (c.length + 1) ↪o fin (n+1) :=
order_embedding.of_strict_mono (λ i, ⟨c.size_up_to i, nat.lt_succ_of_le (c.size_up_to_le i)⟩) $
 fin.strict_mono_iff_lt_succ.2 $ λ ⟨i, hi⟩, c.size_up_to_strict_mono hi

@[simp] lemma boundary_zero : c.boundary 0 = 0 :=
by simp [boundary, fin.ext_iff]

@[simp] lemma boundary_last : c.boundary (fin.last c.length) = fin.last n :=
by simp [boundary, fin.ext_iff]

/-- The boundaries of a composition, i.e., the leftmost point of all the blocks. We include
a virtual point at the right of the last block, to make for a nice equiv with
`composition_as_set n`. -/
def boundaries : finset (fin (n+1)) :=
finset.univ.map c.boundary.to_embedding

lemma card_boundaries_eq_succ_length : c.boundaries.card = c.length + 1 :=
by simp [boundaries]

/-- To `c : composition n`, one can associate a `composition_as_set n` by registering the leftmost
point of each block, and adding a virtual point at the right of the last block. -/
def to_composition_as_set : composition_as_set n :=
{ boundaries := c.boundaries,
  zero_mem := begin
    simp only [boundaries, finset.mem_univ, exists_prop_of_true, finset.mem_map],
    exact ⟨0, rfl⟩,
  end,
  last_mem := begin
    simp only [boundaries, finset.mem_univ, exists_prop_of_true, finset.mem_map],
    exact ⟨fin.last c.length, c.boundary_last⟩,
  end }

/-- The canonical increasing bijection between `fin (c.length + 1)` and `c.boundaries` is
exactly `c.boundary`. -/
lemma order_emb_of_fin_boundaries :
  c.boundaries.order_emb_of_fin c.card_boundaries_eq_succ_length = c.boundary :=
begin
  refine (finset.order_emb_of_fin_unique' _ _).symm,
  exact λ i, (finset.mem_map' _).2 (finset.mem_univ _)
end

/-- Embedding the `i`-th block of a composition (identified with `fin (c.blocks_fun i)`) into
`fin n` at the relevant position. -/
def embedding (i : fin c.length) : fin (c.blocks_fun i) ↪o fin n :=
(fin.nat_add $ c.size_up_to i).trans $ fin.cast_le $
calc c.size_up_to i + c.blocks_fun i = c.size_up_to (i + 1) : (c.size_up_to_succ _).symm
... ≤ c.size_up_to c.length : monotone_sum_take _ i.2
... = n : c.size_up_to_length

@[simp] lemma coe_embedding (i : fin c.length) (j : fin (c.blocks_fun i)) :
  (c.embedding i j : ℕ) = c.size_up_to i + j := rfl

/--
`index_exists` asserts there is some `i` with `j < c.size_up_to (i+1)`.
In the next definition `index` we use `nat.find` to produce the minimal such index.
-/
lemma index_exists {j : ℕ} (h : j < n) :
  ∃ i : ℕ, j < c.size_up_to i.succ ∧ i < c.length :=
begin
  have n_pos : 0 < n := lt_of_le_of_lt (zero_le j) h,
  have : 0 < c.blocks.sum, by rwa [← c.blocks_sum] at n_pos,
  have length_pos : 0 < c.blocks.length := length_pos_of_sum_pos (blocks c) this,
  refine ⟨c.length.pred, _, nat.pred_lt (ne_of_gt length_pos)⟩,
  have : c.length.pred.succ = c.length := nat.succ_pred_eq_of_pos length_pos,
  simp [this, h]
end

/-- `c.index j` is the index of the block in the composition `c` containing `j`. -/
def index (j : fin n) : fin c.length :=
⟨nat.find (c.index_exists j.2), (nat.find_spec (c.index_exists j.2)).2⟩

lemma lt_size_up_to_index_succ (j : fin n) : (j : ℕ) < c.size_up_to (c.index j).succ :=
(nat.find_spec (c.index_exists j.2)).1

lemma size_up_to_index_le (j : fin n) : c.size_up_to (c.index j) ≤ j :=
begin
  by_contradiction H,
  set i := c.index j with hi,
  push_neg at H,
  have i_pos : (0 : ℕ) < i,
  { by_contra' i_pos,
    revert H, simp [nonpos_iff_eq_zero.1 i_pos, c.size_up_to_zero] },
  let i₁ := (i : ℕ).pred,
  have i₁_lt_i : i₁ < i := nat.pred_lt (ne_of_gt i_pos),
  have i₁_succ : i₁.succ = i := nat.succ_pred_eq_of_pos i_pos,
  have := nat.find_min (c.index_exists j.2) i₁_lt_i,
  simp [lt_trans i₁_lt_i (c.index j).2, i₁_succ] at this,
  exact nat.lt_le_antisymm H this
end

/-- Mapping an element `j` of `fin n` to the element in the block containing it, identified with
`fin (c.blocks_fun (c.index j))` through the canonical increasing bijection. -/
def inv_embedding (j : fin n) : fin (c.blocks_fun (c.index j)) :=
⟨j - c.size_up_to (c.index j),
begin
  rw [tsub_lt_iff_right, add_comm, ← size_up_to_succ'],
  { exact lt_size_up_to_index_succ _ _ },
  { exact size_up_to_index_le _ _ }
end⟩

@[simp] lemma coe_inv_embedding (j : fin n) :
  (c.inv_embedding j : ℕ) = j - c.size_up_to (c.index j) := rfl

lemma embedding_comp_inv (j : fin n) :
  c.embedding (c.index j) (c.inv_embedding j) = j :=
begin
  rw fin.ext_iff,
  apply add_tsub_cancel_of_le (c.size_up_to_index_le j),
end

lemma mem_range_embedding_iff {j : fin n} {i : fin c.length} :
  j ∈ set.range (c.embedding i) ↔
  c.size_up_to i ≤ j ∧ (j : ℕ) < c.size_up_to (i : ℕ).succ :=
begin
  split,
  { assume h,
    rcases set.mem_range.2 h with ⟨k, hk⟩,
    rw fin.ext_iff at hk,
    change c.size_up_to i + k = (j : ℕ) at hk,
    rw ← hk,
    simp [size_up_to_succ', k.is_lt] },
  { assume h,
    apply set.mem_range.2,
    refine ⟨⟨j - c.size_up_to i, _⟩, _⟩,
    { rw [tsub_lt_iff_left, ← size_up_to_succ'],
      { exact h.2 },
      { exact h.1 } },
    { rw fin.ext_iff,
      exact add_tsub_cancel_of_le h.1 } }
end

/-- The embeddings of different blocks of a composition are disjoint. -/
lemma disjoint_range {i₁ i₂ : fin c.length} (h : i₁ ≠ i₂) :
  disjoint (set.range (c.embedding i₁)) (set.range (c.embedding i₂)) :=
begin
  classical,
  wlog h' : i₁ ≤ i₂ using i₁ i₂,
  swap, exact (this h.symm).symm,
  by_contradiction d,
  obtain ⟨x, hx₁, hx₂⟩ :
    ∃ x : fin n, (x ∈ set.range (c.embedding i₁) ∧ x ∈ set.range (c.embedding i₂)) :=
  set.not_disjoint_iff.1 d,
  have : i₁ < i₂ := lt_of_le_of_ne h' h,
  have A : (i₁ : ℕ).succ ≤ i₂ := nat.succ_le_of_lt this,
  apply lt_irrefl (x : ℕ),
  calc (x : ℕ) < c.size_up_to (i₁ : ℕ).succ : (c.mem_range_embedding_iff.1 hx₁).2
  ... ≤ c.size_up_to (i₂ : ℕ) : monotone_sum_take _ A
  ... ≤ x : (c.mem_range_embedding_iff.1 hx₂).1
end

lemma mem_range_embedding (j : fin n) :
  j ∈ set.range (c.embedding (c.index j)) :=
begin
  have : c.embedding (c.index j) (c.inv_embedding j)
    ∈ set.range (c.embedding (c.index j)) := set.mem_range_self _,
  rwa c.embedding_comp_inv j at this
end

lemma mem_range_embedding_iff' {j : fin n} {i : fin c.length} :
  j ∈ set.range (c.embedding i) ↔ i = c.index j :=
begin
  split,
  { rw ← not_imp_not,
    assume h,
    exact set.disjoint_right.1 (c.disjoint_range h) (c.mem_range_embedding j) },
  { assume h,
    rw h,
    exact c.mem_range_embedding j }
end

lemma index_embedding (i : fin c.length) (j : fin (c.blocks_fun i)) :
  c.index (c.embedding i j) = i :=
begin
  symmetry,
  rw ← mem_range_embedding_iff',
  apply set.mem_range_self
end

lemma inv_embedding_comp (i : fin c.length) (j : fin (c.blocks_fun i)) :
  (c.inv_embedding (c.embedding i j) : ℕ) = j :=
by simp_rw [coe_inv_embedding, index_embedding, coe_embedding, add_tsub_cancel_left]

/-- Equivalence between the disjoint union of the blocks (each of them seen as
`fin (c.blocks_fun i)`) with `fin n`. -/
def blocks_fin_equiv : (Σ i : fin c.length, fin (c.blocks_fun i)) ≃ fin n :=
{ to_fun := λ x, c.embedding x.1 x.2,
  inv_fun := λ j, ⟨c.index j, c.inv_embedding j⟩,
  left_inv := λ x, begin
    rcases x with ⟨i, y⟩,
    dsimp,
    congr, { exact c.index_embedding _ _ },
    rw fin.heq_ext_iff,
    { exact c.inv_embedding_comp _ _ },
    { rw c.index_embedding }
  end,
  right_inv := λ j, c.embedding_comp_inv j }

lemma blocks_fun_congr {n₁ n₂ : ℕ} (c₁ : composition n₁) (c₂ : composition n₂)
  (i₁ : fin c₁.length) (i₂ : fin c₂.length) (hn : n₁ = n₂)
  (hc : c₁.blocks = c₂.blocks) (hi : (i₁ : ℕ) = i₂) :
  c₁.blocks_fun i₁ = c₂.blocks_fun i₂ :=
by { cases hn, rw ← composition.ext_iff at hc, cases hc, congr, rwa fin.ext_iff }

/-- Two compositions (possibly of different integers) coincide if and only if they have the
same sequence of blocks. -/
lemma sigma_eq_iff_blocks_eq {c : Σ n, composition n} {c' : Σ n, composition n} :
  c = c' ↔ c.2.blocks = c'.2.blocks :=
begin
  refine ⟨λ H, by rw H, λ H, _⟩,
  rcases c with ⟨n, c⟩,
  rcases c' with ⟨n', c'⟩,
  have : n = n', by { rw [← c.blocks_sum, ← c'.blocks_sum, H] },
  induction this,
  simp only [true_and, eq_self_iff_true, heq_iff_eq],
  ext1,
  exact H
end

/-! ### The composition `composition.ones` -/

/-- The composition made of blocks all of size `1`. -/
def ones (n : ℕ) : composition n :=
⟨repeat (1 : ℕ) n, λ i hi, by simp [list.eq_of_mem_repeat hi], by simp⟩

instance {n : ℕ} : inhabited (composition n) :=
⟨composition.ones n⟩

@[simp] lemma ones_length (n : ℕ) : (ones n).length = n :=
list.length_repeat 1 n

@[simp] lemma ones_blocks (n : ℕ) : (ones n).blocks = repeat (1 : ℕ) n := rfl

@[simp] lemma ones_blocks_fun (n : ℕ) (i : fin (ones n).length) :
  (ones n).blocks_fun i = 1 :=
by simp [blocks_fun, ones, blocks, i.2]

@[simp] lemma ones_size_up_to (n : ℕ) (i : ℕ) : (ones n).size_up_to i = min i n :=
by simp [size_up_to, ones_blocks, take_repeat]

@[simp] lemma ones_embedding (i : fin (ones n).length) (h : 0 < (ones n).blocks_fun i) :
  (ones n).embedding i ⟨0, h⟩ = ⟨i, lt_of_lt_of_le i.2 (ones n).length_le⟩ :=
by { ext, simpa using i.2.le }

lemma eq_ones_iff {c : composition n} :
  c = ones n ↔ ∀ i ∈ c.blocks, i = 1 :=
begin
  split,
  { rintro rfl,
    exact λ i, eq_of_mem_repeat },
  { assume H,
    ext1,
    have A : c.blocks = repeat 1 c.blocks.length := eq_repeat_of_mem H,
    have : c.blocks.length = n, by { conv_rhs { rw [← c.blocks_sum, A] }, simp },
    rw [A, this, ones_blocks] },
end

lemma ne_ones_iff {c : composition n} :
  c ≠ ones n ↔ ∃ i ∈ c.blocks, 1 < i :=
begin
  refine (not_congr eq_ones_iff).trans _,
  have : ∀ j ∈ c.blocks, j = 1 ↔ j ≤ 1 := λ j hj, by simp [le_antisymm_iff, c.one_le_blocks hj],
  simp [this] {contextual := tt}
end

lemma eq_ones_iff_length {c : composition n} :
  c = ones n ↔ c.length = n :=
begin
  split,
  { rintro rfl,
    exact ones_length n },
  { contrapose,
    assume H length_n,
    apply lt_irrefl n,
    calc
      n = ∑ (i : fin c.length), 1 : by simp [length_n]
      ... < ∑ (i : fin c.length), c.blocks_fun i :
      begin
        obtain ⟨i, hi, i_blocks⟩ : ∃ i ∈ c.blocks, 1 < i := ne_ones_iff.1 H,
        rw [← of_fn_blocks_fun, mem_of_fn c.blocks_fun, set.mem_range] at hi,
        obtain ⟨j : fin c.length, hj : c.blocks_fun j = i⟩ := hi,
        rw ← hj at i_blocks,
        exact finset.sum_lt_sum (λ i hi, by simp [blocks_fun]) ⟨j, finset.mem_univ _, i_blocks⟩,
      end
      ... = n : c.sum_blocks_fun }
end

lemma eq_ones_iff_le_length {c : composition n} :
  c = ones n ↔ n ≤ c.length :=
by simp [eq_ones_iff_length, le_antisymm_iff, c.length_le]

/-! ### The composition `composition.single` -/

/-- The composition made of a single block of size `n`. -/
def single (n : ℕ) (h : 0 < n) : composition n :=
⟨[n], by simp [h], by simp⟩

@[simp] lemma single_length {n : ℕ} (h : 0 < n) : (single n h).length = 1 := rfl

@[simp] lemma single_blocks {n : ℕ} (h : 0 < n) : (single n h).blocks = [n] := rfl

@[simp] lemma single_blocks_fun {n : ℕ} (h : 0 < n) (i : fin (single n h).length) :
  (single n h).blocks_fun i = n :=
by simp [blocks_fun, single, blocks, i.2]

@[simp] lemma single_embedding {n : ℕ} (h : 0 < n) (i : fin n) :
  (single n h).embedding ⟨0, single_length h ▸ zero_lt_one⟩ i = i :=
by { ext, simp }

lemma eq_single_iff_length {n : ℕ} (h : 0 < n) {c : composition n} :
  c = single n h ↔ c.length = 1 :=
begin
  split,
  { assume H,
    rw H,
    exact single_length h },
  { assume H,
    ext1,
    have A : c.blocks.length = 1 := H ▸ c.blocks_length,
    have B : c.blocks.sum = n := c.blocks_sum,
    rw eq_cons_of_length_one A at B ⊢,
    simpa [single_blocks] using B }
end

lemma ne_single_iff {n : ℕ} (hn : 0 < n) {c : composition n} :
  c ≠ single n hn ↔ ∀ i, c.blocks_fun i < n :=
begin
  rw ← not_iff_not,
  push_neg,
  split,
  { rintros rfl,
    exact ⟨⟨0, by simp⟩, by simp⟩ },
  { rintros ⟨i, hi⟩,
    rw eq_single_iff_length,
    have : ∀ j : fin c.length, j = i,
    { intros j,
      by_contradiction ji,
      apply lt_irrefl ∑ k, c.blocks_fun k,
      calc ∑ k, c.blocks_fun k ≤ c.blocks_fun i      : by simp only [c.sum_blocks_fun, hi]
                           ... < ∑ k, c.blocks_fun k :
        finset.single_lt_sum ji (finset.mem_univ _) (finset.mem_univ _) (c.one_le_blocks_fun j)
          (λ _ _ _, zero_le _) },
    simpa using fintype.card_eq_one_of_forall_eq this }
end

end composition

/-!
### Splitting a list

Given a list of length `n` and a composition `c` of `n`, one can split `l` into `c.length` sublists
of respective lengths `c.blocks_fun 0`, ..., `c.blocks_fun (c.length-1)`. This is inverse to the
join operation.
-/
namespace list
variable {α : Type*}

/-- Auxiliary for `list.split_wrt_composition`. -/
def split_wrt_composition_aux : list α → list ℕ → list (list α)
| l [] := []
| l (n :: ns) :=
  let (l₁, l₂) := l.split_at n in
  l₁ :: split_wrt_composition_aux l₂ ns

/-- Given a list of length `n` and a composition `[i₁, ..., iₖ]` of `n`, split `l` into a list of
`k` lists corresponding to the blocks of the composition, of respective lengths `i₁`, ..., `iₖ`.
This makes sense mostly when `n = l.length`, but this is not necessary for the definition. -/
def split_wrt_composition (l : list α) (c : composition n) : list (list α) :=
split_wrt_composition_aux l c.blocks

local attribute [simp] split_wrt_composition_aux.equations._eqn_1

local attribute [simp]
lemma split_wrt_composition_aux_cons (l : list α) (n ns) :
  l.split_wrt_composition_aux (n :: ns) = take n l :: (drop n l).split_wrt_composition_aux ns :=
by simp [split_wrt_composition_aux]

lemma length_split_wrt_composition_aux (l : list α) (ns) :
  length (l.split_wrt_composition_aux ns) = ns.length :=
by induction ns generalizing l; simp *

/-- When one splits a list along a composition `c`, the number of sublists thus created is
`c.length`. -/
@[simp] lemma length_split_wrt_composition (l : list α) (c : composition n) :
  length (l.split_wrt_composition c) = c.length :=
length_split_wrt_composition_aux _ _

lemma map_length_split_wrt_composition_aux {ns : list ℕ} :
  ∀ {l : list α}, ns.sum ≤ l.length → map length (l.split_wrt_composition_aux ns) = ns :=
begin
  induction ns with n ns IH; intros l h; simp at h ⊢,
  have := le_trans (nat.le_add_right _ _) h,
  rw IH, {simp [this]},
  rwa [length_drop, le_tsub_iff_left this]
end

/-- When one splits a list along a composition `c`, the lengths of the sublists thus created are
given by the block sizes in `c`. -/
lemma map_length_split_wrt_composition (l : list α) (c : composition l.length) :
  map length (l.split_wrt_composition c) = c.blocks :=
map_length_split_wrt_composition_aux (le_of_eq c.blocks_sum)

lemma length_pos_of_mem_split_wrt_composition {l l' : list α} {c : composition l.length}
  (h : l' ∈ l.split_wrt_composition c) : 0 < length l' :=
begin
  have : l'.length ∈ (l.split_wrt_composition c).map list.length :=
    list.mem_map_of_mem list.length h,
  rw map_length_split_wrt_composition at this,
  exact c.blocks_pos this
end

lemma sum_take_map_length_split_wrt_composition
  (l : list α) (c : composition l.length) (i : ℕ) :
  (((l.split_wrt_composition c).map length).take i).sum = c.size_up_to i :=
by { congr, exact map_length_split_wrt_composition l c }

lemma nth_le_split_wrt_composition_aux (l : list α) (ns : list ℕ) {i : ℕ} (hi) :
  nth_le (l.split_wrt_composition_aux ns) i hi =
  (l.take (ns.take (i+1)).sum).drop (ns.take i).sum :=
begin
  induction ns with n ns IH generalizing l i, {cases hi},
  cases i; simp [IH],
  rw [add_comm n, drop_add, drop_take],
end

/-- The `i`-th sublist in the splitting of a list `l` along a composition `c`, is the slice of `l`
between the indices `c.size_up_to i` and `c.size_up_to (i+1)`, i.e., the indices in the `i`-th
block of the composition. -/
lemma nth_le_split_wrt_composition (l : list α) (c : composition n)
  {i : ℕ} (hi : i < (l.split_wrt_composition c).length) :
  nth_le (l.split_wrt_composition c) i hi = (l.take (c.size_up_to (i+1))).drop (c.size_up_to i) :=
nth_le_split_wrt_composition_aux _ _ _

theorem join_split_wrt_composition_aux {ns : list ℕ} :
  ∀ {l : list α}, ns.sum = l.length → (l.split_wrt_composition_aux ns).join = l :=
begin
  induction ns with n ns IH; intros l h; simp at h ⊢,
  { exact (length_eq_zero.1 h.symm).symm },
  rw IH, {simp},
  rwa [length_drop, ← h, add_tsub_cancel_left]
end

/-- If one splits a list along a composition, and then joins the sublists, one gets back the
original list. -/
@[simp] theorem join_split_wrt_composition (l : list α) (c : composition l.length) :
  (l.split_wrt_composition c).join = l :=
join_split_wrt_composition_aux c.blocks_sum

/-- If one joins a list of lists and then splits the join along the right composition, one gets
back the original list of lists. -/
@[simp] theorem split_wrt_composition_join (L : list (list α)) (c : composition L.join.length)
  (h : map length L = c.blocks) : split_wrt_composition (join L) c = L :=
by simp only [eq_self_iff_true, and_self, eq_iff_join_eq, join_split_wrt_composition,
              map_length_split_wrt_composition, h]

end list

/-!
### Compositions as sets

Combinatorial viewpoints on compositions, seen as finite subsets of `fin (n+1)` containing `0` and
`n`, where the points of the set (other than `n`) correspond to the leftmost points of each block.
-/

/-- Bijection between compositions of `n` and subsets of `{0, ..., n-2}`, defined by
considering the restriction of the subset to `{1, ..., n-1}` and shifting to the left by one. -/
def composition_as_set_equiv (n : ℕ) : composition_as_set n ≃ finset (fin (n - 1)) :=
{ to_fun := λ c, {i : fin (n-1) |
    (⟨1 + (i : ℕ), begin
       apply (add_lt_add_left i.is_lt 1).trans_le,
       rw [nat.succ_eq_add_one, add_comm],
       exact add_le_add (nat.sub_le n 1) (le_refl 1)
    end ⟩ : fin n.succ) ∈ c.boundaries}.to_finset,
  inv_fun := λ s,
    { boundaries := {i : fin n.succ | (i = 0) ∨ (i = fin.last n)
        ∨ (∃ (j : fin (n-1)) (hj : j ∈ s), (i : ℕ) = j + 1)}.to_finset,
      zero_mem   := by simp,
      last_mem   := by simp },
  left_inv := begin
    assume c,
    ext i,
    simp only [exists_prop, add_comm, set.mem_to_finset, true_or, or_true, set.mem_set_of_eq],
    split,
    { rintro (rfl | rfl | ⟨j, hj1, hj2⟩),
      { exact c.zero_mem },
      { exact c.last_mem },
      { convert hj1, rwa fin.ext_iff } },
    { simp only [or_iff_not_imp_left],
      assume i_mem i_ne_zero i_ne_last,
      simp [fin.ext_iff] at i_ne_zero i_ne_last,
      have A : (1 + (i-1) : ℕ) = (i : ℕ),
        by { rw add_comm, exact nat.succ_pred_eq_of_pos (pos_iff_ne_zero.mpr i_ne_zero) },
      refine ⟨⟨i - 1, _⟩, _, _⟩,
      { have : (i : ℕ) < n + 1 := i.2,
        simp [nat.lt_succ_iff_lt_or_eq, i_ne_last] at this,
        exact nat.pred_lt_pred i_ne_zero this },
      { convert i_mem,
        rw fin.ext_iff,
        simp only [fin.coe_mk, A] },
      { simp [A] } },
  end,
  right_inv := begin
    assume s,
    ext i,
    have : 1 + (i : ℕ) ≠ n,
    { apply ne_of_lt,
      convert add_lt_add_left i.is_lt 1,
      rw add_comm,
      apply (nat.succ_pred_eq_of_pos _).symm,
      exact (zero_le i.val).trans_lt (i.2.trans_le (nat.sub_le n 1)) },
    simp only [fin.ext_iff, exists_prop, fin.coe_zero, add_comm,
      set.mem_to_finset, set.mem_set_of_eq, fin.coe_last],
    erw [set.mem_set_of_eq],
    simp only [this, false_or, add_right_inj, add_eq_zero_iff, one_ne_zero, false_and, fin.coe_mk],
    split,
    { rintros ⟨j, js, hj⟩, convert js, exact (fin.ext_iff _ _).2 hj },
    { assume h, exact ⟨i, h, rfl⟩ }
  end }

instance composition_as_set_fintype (n : ℕ) : fintype (composition_as_set n) :=
fintype.of_equiv _ (composition_as_set_equiv n).symm

lemma composition_as_set_card (n : ℕ) : fintype.card (composition_as_set n) = 2 ^ (n - 1) :=
begin
  have : fintype.card (finset (fin (n-1))) = 2 ^ (n - 1), by simp,
  rw ← this,
  exact fintype.card_congr (composition_as_set_equiv n)
end

namespace composition_as_set

variables (c : composition_as_set n)

lemma boundaries_nonempty : c.boundaries.nonempty :=
⟨0, c.zero_mem⟩

lemma card_boundaries_pos : 0 < finset.card c.boundaries :=
finset.card_pos.mpr c.boundaries_nonempty

/-- Number of blocks in a `composition_as_set`. -/
def length : ℕ := finset.card c.boundaries - 1

lemma card_boundaries_eq_succ_length : c.boundaries.card = c.length + 1 :=
(tsub_eq_iff_eq_add_of_le (nat.succ_le_of_lt c.card_boundaries_pos)).mp rfl

lemma length_lt_card_boundaries : c.length < c.boundaries.card :=
by { rw c.card_boundaries_eq_succ_length, exact lt_add_one _ }

lemma lt_length (i : fin c.length) : (i : ℕ) + 1 < c.boundaries.card :=
lt_tsub_iff_right.mp i.2

lemma lt_length' (i : fin c.length) : (i : ℕ) < c.boundaries.card :=
lt_of_le_of_lt (nat.le_succ i) (c.lt_length i)

/-- Canonical increasing bijection from `fin c.boundaries.card` to `c.boundaries`. -/
def boundary : fin c.boundaries.card ↪o fin (n + 1) := c.boundaries.order_emb_of_fin rfl

@[simp] lemma boundary_zero : (c.boundary ⟨0, c.card_boundaries_pos⟩ : fin (n + 1)) = 0 :=
begin
  rw [boundary, finset.order_emb_of_fin_zero rfl c.card_boundaries_pos],
  exact le_antisymm (finset.min'_le _ _ c.zero_mem) (fin.zero_le _),
end

@[simp] lemma boundary_length : c.boundary ⟨c.length, c.length_lt_card_boundaries⟩ = fin.last n :=
begin
  convert finset.order_emb_of_fin_last rfl c.card_boundaries_pos,
  exact le_antisymm (finset.le_max' _ _ c.last_mem) (fin.le_last _)
end

/-- Size of the `i`-th block in a `composition_as_set`, seen as a function on `fin c.length`. -/
def blocks_fun (i : fin c.length) : ℕ :=
(c.boundary ⟨(i : ℕ) + 1, c.lt_length i⟩) - (c.boundary ⟨i, c.lt_length' i⟩)

lemma blocks_fun_pos (i : fin c.length) : 0 < c.blocks_fun i :=
begin
  have : (⟨i, c.lt_length' i⟩ : fin c.boundaries.card) < ⟨i + 1, c.lt_length i⟩ :=
    nat.lt_succ_self _,
  exact lt_tsub_iff_left.mpr ((c.boundaries.order_emb_of_fin rfl).strict_mono this)
end

/-- List of the sizes of the blocks in a `composition_as_set`. -/
def blocks (c : composition_as_set n) : list ℕ :=
of_fn c.blocks_fun

@[simp] lemma blocks_length : c.blocks.length = c.length :=
length_of_fn _

lemma blocks_partial_sum {i : ℕ} (h : i < c.boundaries.card) :
  (c.blocks.take i).sum = c.boundary ⟨i, h⟩ :=
begin
  induction i with i IH, { simp },
  have A : i < c.blocks.length,
  { rw c.card_boundaries_eq_succ_length at h,
    simp [blocks, nat.lt_of_succ_lt_succ h] },
  have B : i < c.boundaries.card := lt_of_lt_of_le A (by simp [blocks, length, nat.sub_le]),
  rw [sum_take_succ _ _ A, IH B],
  simp only [blocks, blocks_fun, nth_le_of_fn'],
  apply add_tsub_cancel_of_le,
  simp
end

lemma mem_boundaries_iff_exists_blocks_sum_take_eq {j : fin (n+1)} :
  j ∈ c.boundaries ↔ ∃ i < c.boundaries.card, (c.blocks.take i).sum = j :=
begin
  split,
  { assume hj,
    rcases (c.boundaries.order_iso_of_fin rfl).surjective ⟨j, hj⟩ with ⟨i, hi⟩,
    rw [subtype.ext_iff, subtype.coe_mk] at hi,
    refine ⟨i.1, i.2, _⟩,
    rw [← hi, c.blocks_partial_sum i.2],
    refl },
  { rintros ⟨i, hi, H⟩,
    convert (c.boundaries.order_iso_of_fin rfl ⟨i, hi⟩).2,
    have : c.boundary ⟨i, hi⟩ = j, by rwa [fin.ext_iff, ← c.blocks_partial_sum hi],
    exact this.symm }
end

/-- Associating a `composition n` to a `composition_as_set n`, by registering the sizes of the
blocks as a list of positive integers. -/
def to_composition : composition n :=
{ blocks     := c.blocks,
  blocks_pos := by simp only [blocks, forall_mem_of_fn_iff, blocks_fun_pos c, forall_true_iff],
  blocks_sum := c.blocks_sum }

end composition_as_set

/-!
### Equivalence between compositions and compositions as sets

In this section, we explain how to go back and forth between a `composition` and a
`composition_as_set`, by showing that their `blocks` and `length` and `boundaries` correspond to
each other, and construct an equivalence between them called `composition_equiv`.
-/

@[simp] lemma composition.to_composition_as_set_length (c : composition n) :
  c.to_composition_as_set.length = c.length :=
by simp [composition.to_composition_as_set, composition_as_set.length,
         c.card_boundaries_eq_succ_length]

@[simp] lemma composition_as_set.to_composition_length (c : composition_as_set n) :
  c.to_composition.length = c.length :=
by simp [composition_as_set.to_composition, composition.length, composition.blocks]

@[simp] lemma composition.to_composition_as_set_blocks (c : composition n) :
  c.to_composition_as_set.blocks = c.blocks :=
begin
  let d := c.to_composition_as_set,
  change d.blocks = c.blocks,
  have length_eq : d.blocks.length = c.blocks.length,
  { convert c.to_composition_as_set_length,
    simp [composition_as_set.blocks] },
  suffices H : ∀ (i ≤ d.blocks.length), (d.blocks.take i).sum = (c.blocks.take i).sum,
    from eq_of_sum_take_eq length_eq H,
  assume i hi,
  have i_lt : i < d.boundaries.card,
  { convert nat.lt_succ_iff.2 hi,
    convert d.card_boundaries_eq_succ_length,
    exact length_of_fn _ },
  have i_lt' : i < c.boundaries.card := i_lt,
  have i_lt'' : i < c.length + 1, by rwa c.card_boundaries_eq_succ_length at i_lt',
  have A : d.boundaries.order_emb_of_fin rfl ⟨i, i_lt⟩
    = c.boundaries.order_emb_of_fin c.card_boundaries_eq_succ_length ⟨i, i_lt''⟩ := rfl,
  have B : c.size_up_to i = c.boundary ⟨i, i_lt''⟩ := rfl,
  rw [d.blocks_partial_sum i_lt, composition_as_set.boundary, ← composition.size_up_to, B,
    A, c.order_emb_of_fin_boundaries]
end

@[simp] lemma composition_as_set.to_composition_blocks (c : composition_as_set n) :
  c.to_composition.blocks = c.blocks := rfl

@[simp] lemma composition_as_set.to_composition_boundaries (c : composition_as_set n) :
  c.to_composition.boundaries = c.boundaries :=
begin
  ext j,
  simp [c.mem_boundaries_iff_exists_blocks_sum_take_eq, c.card_boundaries_eq_succ_length,
    composition.boundary, fin.ext_iff, composition.size_up_to, exists_prop, finset.mem_univ,
    take, exists_prop_of_true, finset.mem_image, composition_as_set.to_composition_blocks,
    composition.boundaries],
  split,
  { rintros ⟨i, hi⟩,
    refine ⟨i.1, _, hi⟩,
    convert i.2,
    simp },
  { rintros ⟨i, i_lt, hi⟩,
    have : i < c.to_composition.length + 1, by simpa using i_lt,
    exact ⟨⟨i, this⟩, hi⟩ }
end

@[simp] lemma composition.to_composition_as_set_boundaries (c : composition n) :
  c.to_composition_as_set.boundaries = c.boundaries := rfl

/-- Equivalence between `composition n` and `composition_as_set n`. -/
def composition_equiv (n : ℕ) : composition n ≃ composition_as_set n :=
{ to_fun    := λ c, c.to_composition_as_set,
  inv_fun   := λ c, c.to_composition,
  left_inv  := λ c, by { ext1, exact c.to_composition_as_set_blocks },
  right_inv := λ c, by { ext1, exact c.to_composition_boundaries } }

instance composition_fintype (n : ℕ) : fintype (composition n) :=
fintype.of_equiv _ (composition_equiv n).symm

lemma composition_card (n : ℕ) : fintype.card (composition n) = 2 ^ (n - 1) :=
begin
  rw ← composition_as_set_card n,
  exact fintype.card_congr (composition_equiv n)
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Lebesgue measure on the real line
-/
import measure_theory.measure_space measure_theory.borel_space
noncomputable theory
open classical set lattice filter
open nnreal (of_real)

namespace measure_theory

/-- Length of an interval. This is the largest monotonic function which correctly
  measures all intervals. -/
def lebesgue_length (s : set ℝ) : ennreal := ⨅a b (h : s ⊆ Ico a b), of_real (b - a)

@[simp] lemma lebesgue_length_empty : lebesgue_length ∅ = 0 :=
le_zero_iff_eq.1 $ infi_le_of_le 0 $ infi_le_of_le 0 $ by simp

@[simp] lemma lebesgue_length_Ico (a b : ℝ) :
  lebesgue_length (Ico a b) = of_real (b - a) :=
begin
  refine le_antisymm (infi_le_of_le a $ infi_le_of_le b $ infi_le _ (by refl))
    (le_infi $ λ a', le_infi $ λ b', le_infi $ λ h, ennreal.coe_le_coe.2 _),
  cases le_or_lt b a with ab ab,
  { rw nnreal.of_real_of_nonpos (sub_nonpos.2 ab), simp },
  cases (Ico_subset_Ico_iff ab).1 h with h₁ h₂,
  exact nnreal.of_real_le_of_real (sub_le_sub h₂ h₁)
end

lemma lebesgue_length_mono {s₁ s₂ : set ℝ} (h : s₁ ⊆ s₂) : lebesgue_length s₁ ≤ lebesgue_length s₂ :=
infi_le_infi $ λ a, infi_le_infi $ λ b, infi_le_infi2 $ λ h', ⟨subset.trans h h', le_refl _⟩

lemma lebesgue_length_eq_infi_Ioo (s) : lebesgue_length s = ⨅a b (h : s ⊆ Ioo a b), of_real (b - a) :=
begin
  refine le_antisymm
    (infi_le_infi $ λ a, infi_le_infi $ λ b, infi_le_infi2 $ λ h,
      ⟨subset.trans h Ioo_subset_Ico_self, le_refl _⟩) _,
  refine le_infi (λ a, le_infi $ λ b, le_infi $ λ h, _),
  refine ennreal.le_of_forall_epsilon_le (λ ε ε0 _, _),
  refine infi_le_of_le (a - ε) (infi_le_of_le b $ infi_le_of_le
    (subset.trans h $ Ico_subset_Ioo_left $ (sub_lt_self_iff _).2 ε0) _),
  rw [← sub_add, ← ennreal.coe_add, ennreal.coe_le_coe],
  apply le_trans nnreal.of_real_add_le _,
  simp,
end

@[simp] lemma lebesgue_length_Ioo (a b : ℝ) :
  lebesgue_length (Ioo a b) = of_real (b - a) :=
begin
  rw ← lebesgue_length_Ico,
  refine le_antisymm (lebesgue_length_mono Ioo_subset_Ico_self) _,
  rw lebesgue_length_eq_infi_Ioo (Ioo a b),
  refine (le_infi $ λ a', le_infi $ λ b', le_infi $ λ h, _),
  cases le_or_lt b a with ab ab, {simp [ab]},
  cases (Ioo_subset_Ioo_iff ab).1 h with h₁ h₂,
  rw [lebesgue_length_Ico, ennreal.coe_le_coe],
  exact nnreal.of_real_le_of_real (sub_le_sub h₂ h₁)
end

lemma lebesgue_length_eq_infi_Icc (s) : lebesgue_length s = ⨅a b (h : s ⊆ Icc a b), of_real (b - a) :=
begin
  refine le_antisymm _
    (infi_le_infi $ λ a, infi_le_infi $ λ b, infi_le_infi2 $ λ h,
      ⟨subset.trans h Ico_subset_Icc_self, le_refl _⟩),
  refine le_infi (λ a, le_infi $ λ b, le_infi $ λ h, _),
  refine ennreal.le_of_forall_epsilon_le (λ ε ε0 _, _),
  refine infi_le_of_le a (infi_le_of_le (b + ε) $ infi_le_of_le
    (subset.trans h $ Icc_subset_Ico_right $ (lt_add_iff_pos_right _).2 ε0) _),
  rw [sub_eq_add_neg, add_right_comm, ←ennreal.coe_add, ennreal.coe_le_coe],
  apply le_trans nnreal.of_real_add_le,
  simp
end

@[simp] lemma lebesgue_length_Icc (a b : ℝ) :
  lebesgue_length (Icc a b) = of_real (b - a) :=
begin
  rw ← lebesgue_length_Ico,
  refine le_antisymm _ (lebesgue_length_mono Ico_subset_Icc_self),
  rw lebesgue_length_eq_infi_Icc (Icc a b),
  exact infi_le_of_le a (infi_le_of_le b $ infi_le_of_le (by refl) (by simp))
end

/-- The Lebesgue outer measure, as an outer measure of ℝ. -/
def lebesgue_outer : outer_measure ℝ :=
outer_measure.of_function lebesgue_length lebesgue_length_empty

lemma lebesgue_outer_le_length (s : set ℝ) : lebesgue_outer s ≤ lebesgue_length s :=
outer_measure.of_function_le _ _ _

lemma lebesgue_length_subadditive {a b : ℝ} {c d : ℕ → ℝ}
  (ss : Icc a b ⊆ ⋃i, Ioo (c i) (d i)) :
  (of_real (b - a) : ennreal) ≤ ∑ i, of_real (d i - c i) :=
begin
  suffices : ∀ (s:finset ℕ) b
    (cv : Icc a b ⊆ ⋃ i ∈ (↑s:set ℕ), Ioo (c i) (d i)),
    (of_real (b - a) : ennreal) ≤ s.sum (λ i, of_real (d i - c i)),
  { rcases @compact_elim_finite_subcover_image _ _
      _ (Icc a b) univ (λ i, Ioo (c i) (d i)) compact_Icc
      (λ i _, is_open_Ioo) (by simpa using ss) with ⟨s, su, hf, hs⟩,
    have e : (⋃ i ∈ (↑hf.to_finset:set ℕ),
      Ioo (c i) (d i)) = (⋃ i ∈ s, Ioo (c i) (d i)), {simp [set.ext_iff]},
    rw ennreal.tsum_eq_supr_sum,
    refine le_trans _ (le_supr _ hf.to_finset),
    exact this hf.to_finset _ (by simpa [e]) },
  clear ss b,
  refine λ s, finset.strong_induction_on s (λ s IH b cv, _),
  cases le_total b a with ab ab,
  { rw nnreal.of_real_of_nonpos (sub_nonpos.2 ab), simp },
  have := cv ⟨ab, le_refl _⟩, simp at this,
  rcases this with ⟨i, is, cb, bd⟩,
  rw [← finset.insert_erase is] at cv ⊢,
  rw [finset.coe_insert, bUnion_insert] at cv,
  rw [finset.sum_insert (finset.not_mem_erase _ _)],
  refine le_trans _ (add_le_add_left' (IH _ (finset.erase_ssubset is) (c i) _)),
  { rw [← ennreal.coe_add, ennreal.coe_le_coe],
    refine le_trans (nnreal.of_real_le_of_real _) nnreal.of_real_add_le,
    rw sub_add_sub_cancel,
    exact sub_le_sub_right (le_of_lt bd) _ },
  { rintro x ⟨h₁, h₂⟩,
    refine (cv ⟨h₁, le_trans h₂ (le_of_lt cb)⟩).resolve_left
      (mt and.left (not_lt_of_le h₂)) }
end

@[simp] lemma lebesgue_outer_Icc (a b : ℝ) :
  lebesgue_outer (Icc a b) = of_real (b - a) :=
begin
  refine le_antisymm (by rw ← lebesgue_length_Icc; apply lebesgue_outer_le_length)
    (le_infi $ λ f, le_infi $ λ hf,
    ennreal.le_of_forall_epsilon_le $ λ ε ε0 h, _),
  rcases ennreal.exists_pos_sum_of_encodable
    (ennreal.zero_lt_coe_iff.2 ε0) ℕ with ⟨ε', ε'0, hε⟩,
  refine le_trans _ (add_le_add_left' (le_of_lt hε)),
  rw ← ennreal.tsum_add,
  choose g hg using show
    ∀ i, ∃ p:ℝ×ℝ, f i ⊆ Ioo p.1 p.2 ∧ (of_real (p.2 - p.1) : ennreal) < lebesgue_length (f i) + ε' i,
  { intro i,
    have := (ennreal.lt_add_right (lt_of_le_of_lt (ennreal.le_tsum i) h)
        (ennreal.zero_lt_coe_iff.2 (ε'0 i))),
    conv at this {to_lhs, rw lebesgue_length_eq_infi_Ioo},
    simpa [infi_lt_iff] },
  refine le_trans _ (ennreal.tsum_le_tsum $ λ i, le_of_lt (hg i).2),
  exact lebesgue_length_subadditive (subset.trans hf $
    Union_subset_Union $ λ i, (hg i).1)
end

@[simp] lemma lebesgue_outer_singleton (a : ℝ) : lebesgue_outer {a} = 0 :=
by simpa using lebesgue_outer_Icc a a

@[simp] lemma lebesgue_outer_Ico (a b : ℝ) :
  lebesgue_outer (Ico a b) = of_real (b - a) :=
begin
  refine le_antisymm (by rw ← lebesgue_length_Ico; apply lebesgue_outer_le_length)
    (ennreal.le_of_forall_epsilon_le $ λ ε ε0 h, _),
  have := @nnreal.of_real_add_le (b - a - ε) ε,
  rw [← ennreal.coe_le_coe, ennreal.coe_add, sub_add_cancel, sub_right_comm,
    ← lebesgue_outer_Icc a (b-ε), nnreal.of_real_coe] at this,
  exact le_trans this (add_le_add_right' $ lebesgue_outer.mono $
    Icc_subset_Ico_right $ (sub_lt_self_iff _).2 ε0)
end

@[simp] lemma lebesgue_outer_Ioo (a b : ℝ) :
  lebesgue_outer (Ioo a b) = of_real (b - a) :=
begin
  refine le_antisymm (by rw ← lebesgue_length_Ioo; apply lebesgue_outer_le_length)
    (ennreal.le_of_forall_epsilon_le $ λ ε ε0 h, _),
  have := @nnreal.of_real_add_le (b - a - ε) ε,
  rw [← ennreal.coe_le_coe, ennreal.coe_add, sub_add_cancel, sub_sub,
    ← lebesgue_outer_Ico (a+ε) b, nnreal.of_real_coe] at this,
  exact le_trans this (add_le_add_right' $ lebesgue_outer.mono $
    Ico_subset_Ioo_left $ (lt_add_iff_pos_right _).2 ε0)
end

lemma is_lebesgue_measurable_Iio {c : ℝ} :
  lebesgue_outer.caratheodory.is_measurable (Iio c) :=
outer_measure.caratheodory_is_measurable $ λ t,
le_infi $ λ a, le_infi $ λ b, le_infi $ λ h, begin
  refine le_trans (add_le_add'
    (lebesgue_length_mono $ inter_subset_inter_left _ h)
    (lebesgue_length_mono $ diff_subset_diff_left h)) _,
  cases le_total a c with hac hca; cases le_total b c with hbc hcb;
    simp [*, -sub_eq_add_neg, sub_add_sub_cancel'];
    rw [← ennreal.coe_add, ennreal.coe_le_coe],
  { simp [*, -nnreal.of_real_add, nnreal.of_real_add_of_real,
      -sub_eq_add_neg, sub_add_sub_cancel'] },
  { rw nnreal.of_real_of_nonpos,
    { simp },
    exact sub_nonpos.2 (le_trans hbc hca) }
end

theorem lebesgue_outer_trim : lebesgue_outer.trim = lebesgue_outer :=
begin
  refine le_antisymm (λ s, _) (outer_measure.trim_ge _),
  rw outer_measure.trim_eq_infi,
  refine le_infi (λ f, le_infi $ λ hf,
    ennreal.le_of_forall_epsilon_le $ λ ε ε0 h, _),
  rcases ennreal.exists_pos_sum_of_encodable
    (ennreal.zero_lt_coe_iff.2 ε0) ℕ with ⟨ε', ε'0, hε⟩,
  refine le_trans _ (add_le_add_left' (le_of_lt hε)),
  rw ← ennreal.tsum_add,
  choose g hg using show
    ∀ i, ∃ s, f i ⊆ s ∧ is_measurable s ∧ lebesgue_outer s ≤ lebesgue_length (f i) + of_real (ε' i),
  { intro i,
    have := (ennreal.lt_add_right (lt_of_le_of_lt (ennreal.le_tsum i) h)
        (ennreal.zero_lt_coe_iff.2 (ε'0 i))),
    conv at this {to_lhs, rw lebesgue_length},
    simp only [infi_lt_iff] at this,
    rcases this with ⟨a, b, h₁, h₂⟩,
    rw ← lebesgue_outer_Ico at h₂,
    exact ⟨_, h₁, is_measurable_Ico, le_of_lt $ by simpa using h₂⟩ },
  simp at hg,
  apply infi_le_of_le (Union g) _,
  apply infi_le_of_le (subset.trans hf $ Union_subset_Union (λ i, (hg i).1)) _,
  apply infi_le_of_le (is_measurable.Union (λ i, (hg i).2.1)) _,
  exact le_trans (lebesgue_outer.Union _) (ennreal.tsum_le_tsum $ λ i, (hg i).2.2)
end

/-- Lebesgue measure on the Borel sets

The outer Lebesgue measure is the completion of this measure. (TODO: proof this)
-/
instance : measure_space ℝ :=
⟨{to_outer_measure := lebesgue_outer,
  m_Union :=
    have borel ℝ ≤ lebesgue_outer.caratheodory,
    by rw real.borel_eq_generate_from_Iio_rat;
       refine measurable_space.generate_from_le _;
       simp [is_lebesgue_measurable_Iio] {contextual := tt},
    λ f hf, lebesgue_outer.Union_eq_of_caratheodory (λ i, this _ (hf i)),
  trimmed := lebesgue_outer_trim }⟩

@[simp] theorem lebesgue_to_outer_measure :
  (measure_space.μ : measure ℝ).to_outer_measure = lebesgue_outer := rfl

theorem real.volume_val (s) : volume s = lebesgue_outer s := rfl
local attribute [simp] real.volume_val

@[simp] lemma real.volume_Ico {a b : ℝ} : volume (Ico a b) = of_real (b - a) := by simp
@[simp] lemma real.volume_Icc {a b : ℝ} : volume (Icc a b) = of_real (b - a) := by simp
@[simp] lemma real.volume_Ioo {a b : ℝ} : volume (Ioo a b) = of_real (b - a) := by simp
@[simp] lemma real.volume_singleton {a : ℝ} : volume ({a} : set ℝ) = 0 := by simp

/-
section vitali

def vitali_aux_h (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) :
  ∃ y ∈ Icc (0:ℝ) 1, ∃ q:ℚ, ↑q = x - y :=
⟨x, h, 0, by simp⟩

def vitali_aux (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) : ℝ :=
classical.some (vitali_aux_h x h)

theorem vitali_aux_mem (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) : vitali_aux x h ∈ Icc (0:ℝ) 1 :=
Exists.fst (classical.some_spec (vitali_aux_h x h):_)

theorem vitali_aux_rel (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) :
 ∃ q:ℚ, ↑q = x - vitali_aux x h :=
Exists.snd (classical.some_spec (vitali_aux_h x h):_)

def vitali : set ℝ := {x | ∃ h, x = vitali_aux x h}

theorem vitali_nonmeasurable : ¬ is_null_measurable measure_space.μ vitali :=
sorry

end vitali
-/

end measure_theory


variables {a b c: ℤ}

constant divides: ℤ → ℤ → Prop

axiom divides_expand: divides a b → ∃(d: ℤ), a * d = b
axiom divides_conclude: (∃(d: ℤ), a * d = b) → divides a b

theorem divides_trans (hab: divides a b) (hbc: divides b c):
divides a c :=
  have h1: ∃m, a * m = b, from divides_expand hab,
  have h2: ∃n, b * n = c, from divides_expand hbc,
  exists.elim h1 (assume m: ℤ, assume hamb: a * m = b,
    exists.elim h2 (assume n: ℤ, assume hbnc: b * n = c,
      have c = a * (m * n) , from calc
           c = b * n       : hbnc.symm
         ... = (a * m) * n : congr_arg _ hamb.symm
         ... = a * (m * n) : mul_assoc _ _ _,
      have a * (m * n) = c, from this.symm,
      have ∃mn, a * mn = c, from ⟨m * n, this⟩,
      divides_conclude this
  ))

theorem two_divides_four: divides 2 4 :=
  have 2 * 2 = (4: ℤ), from refl _,
  have ∃(d: ℤ), 2 * d = 4, from ⟨2, this⟩,
  divides_conclude this

axiom four_divides_twenty: divides 4 20 -- same as above

theorem two_divides_twenty: divides 2 20 :=
  divides_trans two_divides_four four_divides_twenty

#check divides
#check divides 2 4
#check divides_conclude

#check divides_expand two_divides_four


import Lean

syntax "{" " // " term " }" : term

macro_rules
  | `({ // $e}) => do
    let e' := (← Lean.Elab.Term.expandCDot? e).getD e
    ``(Subtype $e')

----------
#check { // 1 ≤ · } -- is Subtype (1 ≤ ·)

def Nat.even (n : Nat) : Prop := n % 2 == 0
#check { // Nat.even } -- is Subtype Nat.even

example : { // 3 + · ≤ 11 }=Subtype (3 + · ≤ 11) := rfl

---------------


/-
Copyright (c) 2021 Vladimir Goryachev. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Vladimir Goryachev, Kyle Miller, Scott Morrison, Eric Rodriguez
-/
import data.nat.count
import order.order_iso_nat

/-!
# The `n`th Number Satisfying a Predicate

This file defines a function for "what is the `n`th number that satisifies a given predicate `p`",
and provides lemmas that deal with this function and its connection to `nat.count`.

## Main definitions

* `nth p n`: The `n`-th natural `k` (zero-indexed) such that `p k`. If there is no
  such natural (that is, `p` is true for at most `n` naturals), then `nth p n = 0`.

## Main results

* `nat.nth_set_card`: For a fintely-often true `p`, gives the cardinality of the set of numbers
  satisfying `p` above particular values of `nth p`
* `nat.count_nth_gc`: Establishes a Galois connection between `nth p` and `count p`.
* `nat.nth_eq_order_iso_of_nat`: For an infinitely-ofter true predicate, `nth` agrees with the
  order-isomorphism of the subtype to the natural numbers.

There has been some discussion on the subject of whether both of `nth` and
`nat.subtype.order_iso_of_nat` should exist. See discussion
[here](https://github.com/leanprover-community/mathlib/pull/9457#pullrequestreview-767221180).
Future work should address how lemmas that use these should be written.

-/

open finset

namespace nat
variable (p : ℕ → Prop)

/-- Find the `n`-th natural number satisfying `p` (indexed from `0`, so `nth p 0` is the first
natural number satisfying `p`), or `0` if there is no such number. See also
`subtype.order_iso_of_nat` for the order isomorphism with ℕ when `p` is infinitely often true. -/
noncomputable def nth : ℕ → ℕ
| n := Inf { i : ℕ | p i ∧ ∀ k < n, nth k < i }

lemma nth_zero : nth p 0 = Inf { i : ℕ | p i } := by { rw nth, simp }

@[simp] lemma nth_zero_of_zero (h : p 0) : nth p 0 = 0 :=
by simp [nth_zero, h]

lemma nth_zero_of_exists [decidable_pred p] (h : ∃ n, p n) : nth p 0 = nat.find h :=
by { rw [nth_zero], convert nat.Inf_def h }

lemma nth_set_card_aux {n : ℕ} (hp : (set_of p).finite)
  (hp' : {i : ℕ | p i ∧ ∀ t < n, nth p t < i}.finite) (hle : n ≤ hp.to_finset.card) :
  hp'.to_finset.card = hp.to_finset.card - n :=
begin
  unfreezingI { induction n with k hk },
  { congr,
    simp only [forall_false_left, nat.not_lt_zero, forall_const, and_true] },
  have hp'': {i : ℕ | p i ∧ ∀ t, t < k → nth p t < i}.finite,
  { refine hp.subset (λ x hx, _),
    rw set.mem_set_of_eq at hx,
    exact hx.left },
  have hle' := nat.sub_pos_of_lt hle,
  specialize hk hp'' (k.le_succ.trans hle),
  rw [nat.sub_succ', ←hk],
  convert_to (finset.erase hp''.to_finset (nth p k)).card = _,
  { congr,
    ext a,
    simp only [set.finite.mem_to_finset, ne.def, set.mem_set_of_eq, finset.mem_erase],
    refine ⟨λ ⟨hp, hlt⟩,
              ⟨(hlt _ (lt_add_one k)).ne', ⟨hp, λ n hn, hlt n (hn.trans_le k.le_succ)⟩⟩, _⟩,
    rintro ⟨hak : _ ≠ _, hp, hlt⟩,
    refine ⟨hp, λ n hn, _⟩,
    rw lt_succ_iff at hn,
    obtain hnk | rfl := hn.lt_or_eq,
    { exact hlt _ hnk },
    { refine lt_of_le_of_ne _ (ne.symm hak),
      rw nth,
      apply nat.Inf_le,
      simpa [hp] using hlt } },
  apply finset.card_erase_of_mem,
  rw [nth, set.finite.mem_to_finset],
  apply Inf_mem,
  rwa [←hp''.nonempty_to_finset, ←finset.card_pos, hk],
end

lemma nth_set_card {n : ℕ} (hp : (set_of p).finite)
  (hp' : {i : ℕ | p i ∧ ∀ k < n, nth p k < i}.finite) :
  hp'.to_finset.card = hp.to_finset.card - n :=
begin
  obtain hn | hn := le_or_lt n hp.to_finset.card,
  { exact nth_set_card_aux p hp _ hn },
  rw nat.sub_eq_zero_of_le hn.le,
  simp only [finset.card_eq_zero, set.finite_to_finset_eq_empty_iff, ←set.subset_empty_iff],
  convert_to _ ⊆ {i : ℕ | p i ∧ ∀ (k : ℕ), k < hp.to_finset.card → nth p k < i},
  { symmetry,
    rw [←set.finite_to_finset_eq_empty_iff, ←finset.card_eq_zero,
        ←nat.sub_self hp.to_finset.card],
    { apply nth_set_card_aux p hp _ le_rfl },
    { exact hp.subset (λ x hx, hx.1) } },
  exact λ x hx, ⟨hx.1, λ k hk, hx.2 _ (hk.trans hn)⟩,
end

lemma nth_set_nonempty_of_lt_card {n : ℕ} (hp : (set_of p).finite) (hlt: n < hp.to_finset.card) :
  {i : ℕ | p i ∧ ∀ k < n, nth p k < i}.nonempty :=
begin
  have hp': {i : ℕ | p i ∧ ∀ (k : ℕ), k < n → nth p k < i}.finite,
  { exact hp.subset (λ x hx, hx.1) },
  rw [←hp'.nonempty_to_finset, ←finset.card_pos, nth_set_card p hp],
  exact nat.sub_pos_of_lt hlt,
end

lemma nth_mem_of_lt_card_finite_aux (n : ℕ) (hp : (set_of p).finite) (hlt : n < hp.to_finset.card) :
  nth p n ∈ {i : ℕ | p i ∧ ∀ k < n, nth p k < i} :=
begin
  rw nth,
  apply Inf_mem,
  exact nth_set_nonempty_of_lt_card _ _ hlt,
end

lemma nth_mem_of_lt_card_finite {n : ℕ} (hp : (set_of p).finite) (hlt : n < hp.to_finset.card) :
  p (nth p n) := (nth_mem_of_lt_card_finite_aux p n hp hlt).1

lemma nth_strict_mono_of_finite {m n : ℕ} (hp : (set_of p).finite)
  (hlt : n < hp.to_finset.card) (hmn : m < n) : nth p m < nth p n :=
(nth_mem_of_lt_card_finite_aux p _ hp hlt).2 _ hmn

lemma nth_mem_of_infinite_aux (hp : (set_of p).infinite) (n : ℕ) :
  nth p n ∈ { i : ℕ | p i ∧ ∀ k < n, nth p k < i } :=
begin
  rw nth,
  apply Inf_mem,
  let s : set ℕ := ⋃ (k < n), { i : ℕ | nth p k ≥ i },
  convert_to ((set_of p) \ s).nonempty,
  { ext i,
    simp },
  refine (hp.diff $ (set.finite_lt_nat _).bUnion _).nonempty,
  exact λ k h, set.finite_le_nat _,
end

lemma nth_mem_of_infinite (hp : (set_of p).infinite) (n : ℕ) : p (nth p n) :=
(nth_mem_of_infinite_aux p hp n).1

lemma nth_strict_mono (hp : (set_of p).infinite) : strict_mono (nth p) :=
λ a b, (nth_mem_of_infinite_aux p hp b).2 _

lemma nth_injective_of_infinite (hp : (set_of p).infinite) : function.injective (nth p) :=
begin
  intros m n h,
  wlog h' : m ≤ n,
  rw le_iff_lt_or_eq at h',
  obtain (h' | rfl) := h',
  { simpa [h] using nth_strict_mono p hp h' },
  { refl },
end

lemma nth_monotone (hp : (set_of p).infinite) : monotone (nth p) :=
(nth_strict_mono p hp).monotone

lemma nth_mono_of_finite {a b : ℕ} (hp : (set_of p).finite) (hb : b < hp.to_finset.card)
  (hab : a ≤ b) : nth p a ≤ nth p b :=
begin
  obtain rfl | h := hab.eq_or_lt,
  { exact le_rfl },
  { exact (nth_strict_mono_of_finite p hp hb h).le }
end

lemma le_nth_of_lt_nth_succ_finite {k a : ℕ} (hp : (set_of p).finite)
  (hlt : k.succ < hp.to_finset.card) (h : a < nth p k.succ) (ha : p a) :
  a ≤ nth p k :=
begin
  by_contra' hak,
  refine h.not_le _,
  rw nth,
  apply nat.Inf_le,
  refine ⟨ha, λ n hn, lt_of_le_of_lt _ hak⟩,
  exact nth_mono_of_finite p hp (k.le_succ.trans_lt hlt) (le_of_lt_succ hn),
end

lemma le_nth_of_lt_nth_succ_infinite {k a : ℕ} (hp : (set_of p).infinite)
  (h : a < nth p k.succ) (ha : p a) :
  a ≤ nth p k :=
begin
  by_contra' hak,
  refine h.not_le _,
  rw nth,
  apply nat.Inf_le,
  exact ⟨ha, λ n hn, (nth_monotone p hp (le_of_lt_succ hn)).trans_lt hak⟩,
end

section count
variables [decidable_pred p]

@[simp] lemma count_nth_zero : count p (nth p 0) = 0 :=
begin
  rw [count_eq_card_filter_range, finset.card_eq_zero, nth_zero],
  ext a,
  simp_rw [not_mem_empty, mem_filter, mem_range, iff_false],
  rintro ⟨ha, hp⟩,
  exact ha.not_le (nat.Inf_le hp),
end

lemma filter_range_nth_eq_insert_of_finite (hp : (set_of p).finite) {k : ℕ}
  (hlt : k.succ < hp.to_finset.card) :
  finset.filter p (finset.range (nth p k.succ)) =
    insert (nth p k) (finset.filter p (finset.range (nth p k))) :=
begin
  ext a,
  simp_rw [mem_insert, mem_filter, mem_range],
  split,
  { rintro ⟨ha, hpa⟩,
    refine or_iff_not_imp_left.mpr (λ h, ⟨lt_of_le_of_ne _ h, hpa⟩),
    exact le_nth_of_lt_nth_succ_finite p hp hlt ha hpa },
  { rintro (ha | ⟨ha, hpa⟩),
    { rw ha,
      refine ⟨nth_strict_mono_of_finite p hp hlt (lt_add_one _), _⟩,
      apply nth_mem_of_lt_card_finite p hp,
      exact (k.le_succ).trans_lt hlt },
    refine ⟨ha.trans _, hpa⟩,
    exact nth_strict_mono_of_finite p hp hlt (lt_add_one _) }
end

lemma count_nth_of_lt_card_finite {n : ℕ} (hp : (set_of p).finite)
  (hlt : n < hp.to_finset.card) : count p (nth p n) = n :=
begin
  induction n with k hk,
  { exact count_nth_zero _ },
  { rw [count_eq_card_filter_range, filter_range_nth_eq_insert_of_finite p hp hlt,
      finset.card_insert_of_not_mem, ←count_eq_card_filter_range, hk (lt_of_succ_lt hlt)],
    simp, },
end

lemma filter_range_nth_eq_insert_of_infinite (hp : (set_of p).infinite) (k : ℕ) :
  (finset.range (nth p k.succ)).filter p = insert (nth p k) ((finset.range (nth p k)).filter p) :=
begin
  ext a,
  simp_rw [mem_insert, mem_filter, mem_range],
  split,
  { rintro ⟨ha, hpa⟩,
    rw nth at ha,
    refine or_iff_not_imp_left.mpr (λ hne, ⟨(le_of_not_lt $ λ h, _).lt_of_ne hne, hpa⟩),
    exact ha.not_le (nat.Inf_le ⟨hpa, λ b hb, (nth_monotone p hp (le_of_lt_succ hb)).trans_lt h⟩) },
  { rintro (rfl | ⟨ha, hpa⟩),
    { exact ⟨nth_strict_mono p hp (lt_succ_self k), nth_mem_of_infinite p hp _⟩ },
    { exact ⟨ha.trans (nth_strict_mono p hp (lt_succ_self k)), hpa⟩ } }
end

lemma count_nth_of_infinite (hp : (set_of p).infinite) (n : ℕ) : count p (nth p n) = n :=
begin
  induction n with k hk,
  { exact count_nth_zero _ },
  { rw [count_eq_card_filter_range, filter_range_nth_eq_insert_of_infinite p hp,
      finset.card_insert_of_not_mem, ←count_eq_card_filter_range, hk],
    simp, },
end

@[simp] lemma nth_count {n : ℕ} (hpn : p n) : nth p (count p n) = n :=
begin
  obtain hp | hp := em (set_of p).finite,
  { refine count_injective _ hpn _,
    { apply nth_mem_of_lt_card_finite p hp,
      exact count_lt_card hp hpn },
    { exact count_nth_of_lt_card_finite _ _ (count_lt_card hp hpn) } },
  { apply count_injective (nth_mem_of_infinite _ hp _) hpn,
  apply count_nth_of_infinite p hp }
end

lemma nth_count_eq_Inf {n : ℕ} : nth p (count p n) = Inf {i : ℕ | p i ∧ n ≤ i} :=
begin
  rw nth,
  congr,
  ext a,
  simp only [set.mem_set_of_eq, and.congr_right_iff],
  intro hpa,
  refine ⟨λ h, _, λ hn k hk, lt_of_lt_of_le _ hn⟩,
  { by_contra ha,
    simp only [not_le] at ha,
    have hn : nth p (count p a) < a := h _ (count_strict_mono hpa ha),
    rwa [nth_count p hpa, lt_self_iff_false] at hn },
  { apply (count_monotone p).reflect_lt,
    convert hk,
    obtain hp | hp : (set_of p).finite ∨ (set_of p).infinite := em (set_of p).finite,
    { rw count_nth_of_lt_card_finite _ hp,
      exact hk.trans ((count_monotone _ hn).trans_lt (count_lt_card hp hpa)) },
    { apply count_nth_of_infinite p hp } }
end

lemma nth_count_le (hp : (set_of p).infinite) (n : ℕ) : n ≤ nth p (count p n) :=
begin
  rw nth_count_eq_Inf,
  suffices h : Inf {i : ℕ | p i ∧ n ≤ i} ∈ {i : ℕ | p i ∧ n ≤ i},
  { exact h.2 },
  apply Inf_mem,
  obtain ⟨m, hp, hn⟩ := hp.exists_nat_lt n,
  exact ⟨m, hp, hn.le⟩
end

lemma count_nth_gc (hp : (set_of p).infinite) : galois_connection (count p) (nth p) :=
begin
  rintro x y,
  rw [nth, le_cInf_iff ⟨0, λ _ _, nat.zero_le _⟩ ⟨nth p y, nth_mem_of_infinite_aux p hp y⟩],
  dsimp,
  refine ⟨_, λ h, _⟩,
  { rintro hy n ⟨hn, h⟩,
    obtain hy' | rfl := hy.lt_or_eq,
    { exact (nth_count_le p hp x).trans (h (count p x) hy').le },
    { specialize h (count p n),
      replace hn : nth p (count p n) = n := nth_count _ hn,
      replace h : count p x ≤ count p n := by rwa [hn, lt_self_iff_false, imp_false, not_lt] at h,
      refine (nth_count_le p hp x).trans _,
      rw ← hn,
      exact nth_monotone p hp h }, },
  { rw ←count_nth_of_infinite p hp y,
    exact count_monotone _ (h (nth p y) ⟨nth_mem_of_infinite p hp y,
      λ k hk, nth_strict_mono p hp hk⟩) }
end

lemma count_le_iff_le_nth (hp : (set_of p).infinite) {a b : ℕ} :
  count p a ≤ b ↔ a ≤ nth p b := count_nth_gc p hp _ _

lemma lt_nth_iff_count_lt (hp : (set_of p).infinite) {a b : ℕ} :
  a < count p b ↔ nth p a < b := lt_iff_lt_of_le_iff_le $ count_le_iff_le_nth p hp

lemma nth_lt_of_lt_count (n k : ℕ) (h : k < count p n) : nth p k < n :=
begin
  obtain hp | hp := em (set_of p).finite,
  { refine (count_monotone p).reflect_lt _,
    rwa count_nth_of_lt_card_finite p hp,
    refine h.trans_le _,
    rw count_eq_card_filter_range,
    exact finset.card_le_of_subset (λ x hx, hp.mem_to_finset.2 (mem_filter.1 hx).2) },
  { rwa ← lt_nth_iff_count_lt _ hp }
end

lemma le_nth_of_count_le (n k : ℕ) (h: n ≤ nth p k) : count p n ≤ k :=
begin
  by_contra hc,
  apply not_lt.mpr h,
  apply nth_lt_of_lt_count,
  simpa using hc
end

end count

lemma nth_zero_of_nth_zero (h₀ : ¬p 0) {a b : ℕ} (hab : a ≤ b) (ha : nth p a = 0) :
  nth p b = 0 :=
begin
  rw [nth, Inf_eq_zero] at ⊢ ha,
  cases ha,
  { exact (h₀ ha.1).elim },
  { refine or.inr (set.eq_empty_of_subset_empty $ λ x hx, _),
    rw ←ha,
    exact ⟨hx.1, λ k hk, hx.2 k $ hk.trans_le hab⟩ }
end

/-- When `p` is true infinitely often, `nth` agrees with `nat.subtype.order_iso_of_nat`. -/
lemma nth_eq_order_iso_of_nat [decidable_pred p] (i : infinite (set_of p)) (n : ℕ) :
  nth p n = nat.subtype.order_iso_of_nat (set_of p) n :=
begin
  have hi := set.infinite_coe_iff.mp i,
  induction n with k hk;
  simp only [subtype.order_iso_of_nat_apply, subtype.of_nat, nat_zero_eq_zero],
  { rw [nat.subtype.coe_bot, nth_zero_of_exists], },
  { simp only [nat.subtype.succ, set.mem_set_of_eq, subtype.coe_mk, subtype.val_eq_coe],
    rw [subtype.order_iso_of_nat_apply] at hk,
    set b := nth p k.succ - nth p k - 1 with hb,
    replace hb : p (↑(subtype.of_nat (set_of p) k) + b + 1),
    { rw [hb, ←hk, tsub_right_comm],
      have hn11: nth p k.succ - 1 + 1 = nth p k.succ,
      { rw tsub_add_cancel_iff_le,
        exact succ_le_of_lt (pos_of_gt (nth_strict_mono p hi (lt_add_one k))), },
      rw add_tsub_cancel_of_le,
      { rw hn11,
        apply nth_mem_of_infinite p hi },
      { rw [← lt_succ_iff, ← nat.add_one, hn11],
        apply nth_strict_mono p hi,
        exact lt_add_one k } },
    have H : (∃ n: ℕ , p (↑(subtype.of_nat (set_of p) k) + n + 1)) := ⟨b, hb⟩,
    set t := nat.find H with ht,
    obtain ⟨hp, hmin⟩ := (nat.find_eq_iff _).mp ht,
    rw [←ht, ←hk] at hp hmin ⊢,
    rw [nth, Inf_def ⟨_, nth_mem_of_infinite_aux p hi k.succ⟩, nat.find_eq_iff],
    refine ⟨⟨by convert hp, λ r hr, _⟩, λ n hn, _⟩,
    { rw lt_succ_iff at ⊢ hr,
      exact (nth_monotone p hi hr).trans (by simp) },
    simp only [exists_prop, not_and, not_lt, set.mem_set_of_eq, not_forall],
    refine λ hpn, ⟨k, lt_add_one k, _⟩,
    by_contra' hlt,
    replace hn : n - nth p k - 1 < t,
    { rw tsub_lt_iff_left,
      { rw tsub_lt_iff_left hlt.le,
        convert hn using 1,
        ac_refl },
      exact le_tsub_of_add_le_left (succ_le_of_lt hlt) },
    refine hmin (n - nth p k - 1) hn _,
    convert hpn,
    have hn11 : n - 1 + 1 = n := nat.sub_add_cancel (pos_of_gt hlt),
    rwa [tsub_right_comm, add_tsub_cancel_of_le],
    rwa [←hn11, lt_succ_iff] at hlt },
end

end nat


import linear_algebra.special_linear_group
import data.zmod.basic

open matrix

lemma det_2x2 (M : matrix (fin 2) (fin 2) ℤ) : M.det = M 0 0 * M 1 1 - M 1 0 * M 0 1 :=
calc M.det = ((1 : units ℤ) * (_ * (_ * 1))) + (((-1 : units ℤ) * (_ * (_ * 1))) + 0) : refl M.det
... = M 0 0 * M 1 1 - M 1 0 * M 0 1 : by { simp, ring }

local notation `SL₂`(R) := special_linear_group (fin 2) R

section basic_matrix_lemmas

    variable M: SL₂(ℤ)
    open matrix

    lemma inverse₀₀ : M⁻¹ 0 0 = M 1 1 :=
    calc M⁻¹ 0 0  =  (1 * (1 * _)) + ( (-1) * (0 * (_ * _)) + 0):  refl _
    --calc M⁻¹ 0 0 = (1 * ( 1* _)) + ( (-1)*( 0 * _ ) + 0) : refl _
             ... = M 1 1 : by  simp

    lemma inverse₀₁ : M⁻¹ 0 1 = - M 0 1 :=
    calc M⁻¹ 0 1 = (1 * (_ * 0) : ℤ) + ((-1)* (_ * 1) + 0) : refl _
             ... = - M 0 1 : by simp

    lemma inverse₁₀ : M⁻¹ 1 0 = - M 1 0 :=
    calc M⁻¹ 1 0 = (1 * (0 * _) : ℤ) + ((-1)* (_ * _) + 0) : refl _
             ... = - M 1 0 : by simp

end basic_matrix_lemmas

section congruence_subgroups
parameters {N : ℕ}[fact (0 < N)]
namespace special_linear_group

    structure mem_principal_subgroup (M: SL₂(ℤ)): Prop :=
    ( cond₀₀ : M 0 0  ≡ 1 [ZMOD N])
    ( cond₀₁ : M 0 1  ≡ 0 [ZMOD N])
    ( cond₁₀ : M 1 0  ≡ 0 [ZMOD N])

    lemma principal_condition₁₁ (M : SL₂ (ℤ)) : mem_principal_subgroup M  → M 1 1 ≡ 1 [ZMOD N]:=
            begin
                rintro ⟨M₁, M₂, M₃⟩,
                cases M,
                rw det_2x2 at M_property,
                have M_prop_mod_N : M_val 0 0 * M_val 1 1 - M_val 1 0 * M_val 0 1 ≡ 1 [ZMOD N]:= by tauto,
                have P₁: M_val 1 0 * M_val 0 1 ≡ 0 * 0 [ZMOD N],
                    apply int.modeq.modeq_mul;
                    assumption,
                have P₂: M_val 0 0 * M_val 1 1 ≡ 1 * M_val 1 1 [ZMOD N],
                    apply int.modeq.modeq_mul,
                    assumption,
                    refl,
                have P₃ : M_val 0 0 * M_val 1 1 - M_val 1 0 * M_val 0 1 ≡ M_val 0 0 * M_val 1 1 - 0 [ZMOD ↑N],
                    apply int.modeq.modeq_sub,
                    refl,
                    convert P₁,
                apply int.modeq.trans,
                rotate,
                exact M_prop_mod_N,
                simp at P₂,
                simp at P₃,
                apply int.modeq.trans,
                exact P₂.symm,
                apply int.modeq.trans,
                exact P₃.symm,
                refl,
            end

open int.modeq
    /--
        The principal congruence subgroup of level N (N>1) is
                        Γ(N)={γ ∈ SL₂(ℤ) | γ ≅ id (mod N)}
    -/
    definition principal_congurence_subgroup: subgroup SL₂(ℤ) :=
    {
        carrier := λ M , mem_principal_subgroup M,
        one_mem' :=
           rfl.mpr ⟨int.modeq.refl _, int.modeq.refl _, int.modeq.refl _⟩,
        mul_mem' :=
            begin
                rintros A B ⟨ A₀₀, A₀₁, A₁₀⟩ ⟨ B₀₀, B₀₁ , B₁₀ ⟩,

                have h : mem_principal_subgroup (A*B) :=
                begin
                    split,
                    {
                        show (A 0 0 * B 0 0) + (A 0 1 * B 1 0 + 0) ≡ 1 [ZMOD N],
                        ring,
                        rw (show (1 : ℤ) = 1 * 1 + 0 * 0, by ring),
                        apply int.modeq.modeq_add;
                        apply int.modeq.modeq_mul;
                        try {assumption};
                        refl,
                    },
                    {
                       show (A 0 0 * B 0 1) + (A 0 1 * B 1 1 + 0) ≡ 0 [ZMOD N],
                       ring,
                       rw (show (0 : ℤ) = A 0 0 * 0 + 0 * B 1 1, by ring),
                        apply int.modeq.modeq_add;
                        apply int.modeq.modeq_mul;
                        try {assumption};
                        refl,
                    },

                     show (A 1 0 * B 0 0) + (A 1 1 * B 1 0 + 0) ≡ 0 [ZMOD N],
                        ring,
                        rw (show (0 : ℤ) = 0 * B 0 0 + A 1 1 * 0, by ring),
                        apply int.modeq.modeq_add;
                        apply int.modeq.modeq_mul;
                        try {assumption};
                        refl,
                end,
                tauto,
            end,
        inv_mem' :=
            begin
                rintros A ⟨ _ , A₀₁ , A₁₀ ⟩,
                split,
                {
                    rw inverse₀₀,
                    apply principal_condition₁₁,
                    split;
                    assumption,
                },
                {
                    rw inverse₀₁,
                    have := modeq_mul_left (-1:ℤ) A₀₁ ,
                    norm_num at this,
                    finish,
                },
                    rw inverse₁₀,
                    have := modeq_mul_left (-1:ℤ) A₁₀ ,
                    norm_num at this,
                    finish,
            end,
    }

end special_linear_group

end congruence_subgroups


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

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers
import solutions.section02reals.sheet5 -- import a bunch of previous stuff

/-

# Harder questions

Here are some harder questions. Don't feel like you have
to do them. We've seen enough techniques to be able to do
all of these, but the truth is that we've seen a ton of stuff
in this course already, so probably you're not on top of all of
it yet, and furthermore we have not seen
some techniques which will enable you to cut corners. If you
want to become a real Lean expert then see how many of these
you can do. I will go through them all in a solutions video,
so if you like you can try some of them and then watch me
solving them.

Good luck!
-/

/-- If `a(n)` tends to `t` then `37 * a(n)` tends to `37 * t`-/
theorem tendsto_thirtyseven_mul (a : ℕ → ℝ) (t : ℝ) (h : tendsto a t) :
  tendsto (λ n, 37 * a n) (37 * t) :=
begin
  intros ε hε,
  obtain ⟨X, hX⟩ := h (ε/37) (by linarith),
  use X,
  intros n hn,
  specialize hX n hn,
  simp,
  rw [← mul_sub, abs_mul, abs_of_nonneg];
  linarith,
end

/-- If `a(n)` tends to `t` and `c` is a positive constant then
`c * a(n)` tends to `c * t`. -/
theorem tendsto_pos_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tendsto a t)
  {c : ℝ} (hc : 0 < c) : tendsto (λ n, c * a n) (c * t) :=
begin
  intros ε hε,
  obtain ⟨X, hX⟩ := h (ε/c) (div_pos hε hc),
  use X,
  intros n hn,
  specialize hX n hn,
  simp,
  rw [← mul_sub, abs_mul, abs_of_pos hc],
  exact (lt_div_iff' hc).mp hX,
end

/-- If `a(n)` tends to `t` and `c` is a negative constant then
`c * a(n)` tends to `c * t`. -/
theorem tendsto_neg_const_mul {a : ℕ → ℝ} {t : ℝ} (h : tendsto a t)
  {c : ℝ} (hc : c < 0) : tendsto (λ n, c * a n) (c * t) :=
begin
  have hc' : 0 < -c := neg_pos.mpr hc,
  intros ε hε,
  obtain ⟨X, hX⟩ := h (ε/(-c)) (div_pos hε hc'),
  use X,
  intros n hn,
  specialize hX n hn,
  simp,
  rw [← mul_sub, abs_mul, abs_of_neg hc],
  exact (lt_div_iff' hc').mp hX,
end

/-- If `a(n)` tends to `t` and `c` is a constant then `c * a(n)` tends
to `c * t`. -/
theorem tendsto_const_mul {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tendsto a t) :
  tendsto (λ n, c * a n) (c * t) :=
begin
  obtain (hc | rfl | hc) := lt_trichotomy 0 c,
  { exact tendsto_pos_const_mul h hc },
  { simpa using tendsto_const 0 },
  { exact tendsto_neg_const_mul h hc }
end

/-- If `a(n)` tends to `t` and `c` is a constant then `a(n) * c` tends
to `t * c`. -/
theorem tendsto_mul_const {a : ℕ → ℝ} {t : ℝ} (c : ℝ) (h : tendsto a t) :
  tendsto (λ n, a n * c) (t * c) :=
by simpa [mul_comm] using tendsto_const_mul c h

-- another proof of this result, showcasing some tactics
-- which I've not covered yet.
theorem tendsto_neg' {a : ℕ → ℝ} {t : ℝ} (ha : tendsto a t) :
  tendsto (λ n, - a n) (-t) :=
begin
  simpa using tendsto_const_mul (-1) ha,
end

/-- If `a(n)-b(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)` tends to `t + u`. -/
theorem tendsto_of_tendsto_sub {a b : ℕ → ℝ} {t u : ℝ}
  (h1 : tendsto (λ n, a n - b n) t) (h2 : tendsto b u) :
  tendsto a (t+u) :=
begin
  simpa using tendsto_add h1 h2,
end

/-- If `a(n)` tends to `t` then `a(n)-t` tends to `0`. -/
theorem tendsto_sub_lim_iff {a : ℕ → ℝ} {t : ℝ} :
  tendsto a t ↔ tendsto (λ n, a n - t) 0 :=
begin
  split,
  { intro h,
    simpa using tendsto_sub h (tendsto_const t) },
  { intro h,
    simpa using tendsto_add h (tendsto_const t) },
end

/-- If `a(n)` and `b(n)` both tend to zero, then their product tends
to zero. -/
theorem tendsto_zero_mul_tendsto_zero
  {a b : ℕ → ℝ} (ha : tendsto a 0) (hb : tendsto b 0) :
  tendsto (λ n, a n * b n) 0 :=
begin
  intros ε hε,
  obtain ⟨X, hX⟩ := ha ε hε,
  obtain ⟨Y, hY⟩ := hb 1 zero_lt_one,
  use max X Y,
  intros n hn,
  specialize hX n (le_of_max_le_left hn),
  specialize hY n (le_of_max_le_right hn),
  simpa [abs_mul] using mul_lt_mul'' hX hY _ _;
  exact abs_nonneg _,
end

/-- If `a(n)` tends to `t` and `b(n)` tends to `u` then
`a(n)*b(n)` tends to `t*u`. -/
theorem tendsto_mul (a b : ℕ → ℝ) (t u : ℝ) (ha : tendsto a t)
  (hb : tendsto b u) : tendsto (λ n, a n * b n) (t * u) :=
begin
  -- suffices a(n)b(n)-tu -> 0
  rw tendsto_sub_lim_iff at *,
  -- rewrite as (a(n)-t)*(b(n)-u)+t(b(n)-u)+(a(n)-t)u ->0
  have h : ∀ n, a n * b n - t * u =
    (a n - t) * (b n - u) + t * (b n - u) + (a n - t) * u,
  { intro n, ring },
  simp [h],
  rw (show (0 : ℝ) = 0 + (t * 0) + (0 * u), by simp),
  refine tendsto_add (tendsto_add _ _) _,
  { exact tendsto_zero_mul_tendsto_zero ha hb },
  { exact tendsto_const_mul t hb },
  { exact tendsto_mul_const u ha },
end

-- something we never used!
/-- A sequence has at most one limit. -/
theorem tendsto_unique (a : ℕ → ℝ) (s t : ℝ)
  (hs : tendsto a s) (ht : tendsto a t) : s = t :=
begin
  by_contra h,
  wlog h2 : s < t,
  { exact ne.lt_or_lt h },
  set ε := t - s with hε,
  have hε : 0 < ε := sub_pos.mpr h2,
  obtain ⟨X, hX⟩ := hs (ε/2) (by linarith),
  obtain ⟨Y, hY⟩ := ht (ε/2) (by linarith),
  specialize hX (max X Y) (le_max_left X Y),
  specialize hY (max X Y) (le_max_right X Y),
  rw abs_lt at hX hY,
  linarith,
end

-- bonus solution: another proof of tendsto_unique inspired
-- by a comment on YT!

-- If |r|<ε for all ε>0 then r=0
lemma eq_zero_of_abs_lt_eps {r : ℝ} (h : ∀ ε > 0, |r| < ε) : r = 0 :=
begin
  -- Proof by contradiction. Say r ≠ 0.
  by_contra h2,
  -- Then let ε be |r|, and we must have ε > 0.
  specialize h (|r|) (abs_pos.mpr h2),
  -- Deduce |r|<|r|, a contradiction.
  linarith,
end

-- Second proof
theorem tendsto_unique' (a : ℕ → ℝ) (s t : ℝ)
  (hs : tendsto a s) (ht : tendsto a t) : s = t :=
begin
  -- We know a - a tends to s - t because of `tendsto_sub`
  have h := tendsto_sub hs ht,
  -- We want to prove s = t; by previous result suffices to
  -- show |t - s|<ε for all ε>0
  suffices : ∀ ε > 0, |t - s| < ε,
  { linarith [eq_zero_of_abs_lt_eps this] },
  -- Let ε be positive.
  intros ε hε,
  -- There exists X such that for n>=X, |a(n) - a(n) - (s - t)| < ε
  obtain ⟨X, hX⟩ := h ε hε,
  specialize hX X (by refl),
  -- and the simplifier can now reduce that to the goal |t-s|<ε.
  simpa using hX,
end


import data.real.basic
open classical
attribute [instance] prop_decidable

/-
  Rigorous definition of a limit
  For a sequence x_n, we say that \lim_{n \to \infty} x_n = l if
    ∀ ε > 0, ∃ N, n ≥ N → |x_n - l| < ε
-/

def lim_to_inf (x : ℕ → ℝ) (l : ℝ) :=
  ∀ ε > 0, ∃ N, ∀ n ≥ N, abs (x n - l) < ε

/-
  Bounded sequences
  A sequence is bounded if |x_n| \leq B for some constant B
  and all n
-/

-- Lean's mathlib already defines bounded so we rename our
-- predicate as bounded' to avoid name clashes
def bounded' (x : ℕ → ℝ) :=
  ∃ B, ∀ n, abs (x n) ≤ B

theorem exercise_1p13 (x y : ℕ → ℝ) (h₁ : lim_to_inf x 0)
  (h₂ : bounded' y) : lim_to_inf (λ n, x n * y n) 0 :=
begin
    intros ε ε_pos,
    rcases h₂ with ⟨B, hB⟩,
    let ε' := ε / ((abs B) + 1),
    have key : 0 < (abs B) + 1,
        exact add_pos_of_nonneg_of_pos (abs_nonneg B) zero_lt_one,
    have ε'_pos : ε' > 0,
        exact div_pos ε_pos key,
    rcases h₁ ε' ε'_pos with ⟨N, hN⟩,
    use N,
    intros n hn,
end