/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne
-/
import analysis.special_functions.log.basic
import analysis.special_functions.exp_deriv

/-!
# Derivative and series expansion of real logarithm

In this file we prove that `real.log` is infinitely smooth at all nonzero `x : ℝ`. We also prove
that the series `∑' n : ℕ, x ^ (n + 1) / (n + 1)` converges to `(-real.log (1 - x))` for all
`x : ℝ`, `|x| < 1`.

## Tags

logarithm, derivative
-/

open filter finset set
open_locale topology big_operators

namespace real

variables {x : ℝ}

lemma has_strict_deriv_at_log_of_pos (hx : 0 < x) : has_strict_deriv_at log x⁻¹ x :=
have has_strict_deriv_at log (exp $ log x)⁻¹ x,
from (has_strict_deriv_at_exp $ log x).of_local_left_inverse (continuous_at_log hx.ne')
  (ne_of_gt $ exp_pos _) $ eventually.mono (lt_mem_nhds hx) @exp_log,
by rwa [exp_log hx] at this

lemma has_strict_deriv_at_log (hx : x ≠ 0) : has_strict_deriv_at log x⁻¹ x :=
begin
  cases hx.lt_or_lt with hx hx,
  { convert (has_strict_deriv_at_log_of_pos (neg_pos.mpr hx)).comp x (has_strict_deriv_at_neg x),
    { ext y, exact (log_neg_eq_log y).symm },
    { field_simp [hx.ne] } },
  { exact has_strict_deriv_at_log_of_pos hx }
end

lemma has_deriv_at_log (hx : x ≠ 0) : has_deriv_at log x⁻¹ x :=
(has_strict_deriv_at_log hx).has_deriv_at

lemma differentiable_at_log (hx : x ≠ 0) : differentiable_at ℝ log x :=
(has_deriv_at_log hx).differentiable_at

lemma differentiable_on_log : differentiable_on ℝ log {0}ᶜ :=
λ x hx, (differentiable_at_log hx).differentiable_within_at

@[simp] lemma differentiable_at_log_iff : differentiable_at ℝ log x ↔ x ≠ 0 :=
⟨λ h, continuous_at_log_iff.1 h.continuous_at, differentiable_at_log⟩

lemma deriv_log (x : ℝ) : deriv log x = x⁻¹ :=
if hx : x = 0 then
  by rw [deriv_zero_of_not_differentiable_at (mt differentiable_at_log_iff.1 (not_not.2 hx)), hx,
    inv_zero]
else (has_deriv_at_log hx).deriv

@[simp] lemma deriv_log' : deriv log = has_inv.inv := funext deriv_log

lemma cont_diff_on_log {n : ℕ∞} : cont_diff_on ℝ n log {0}ᶜ :=
begin
  suffices : cont_diff_on ℝ ⊤ log {0}ᶜ, from this.of_le le_top,
  refine (cont_diff_on_top_iff_deriv_of_open is_open_compl_singleton).2 _,
  simp [differentiable_on_log, cont_diff_on_inv]
end

lemma cont_diff_at_log {n : ℕ∞} : cont_diff_at ℝ n log x ↔ x ≠ 0 :=
⟨λ h, continuous_at_log_iff.1 h.continuous_at,
  λ hx, (cont_diff_on_log x hx).cont_diff_at $
    is_open.mem_nhds is_open_compl_singleton hx⟩

end real

section log_differentiable
open real

section deriv

variables {f : ℝ → ℝ} {x f' : ℝ} {s : set ℝ}

lemma has_deriv_within_at.log (hf : has_deriv_within_at f f' s x) (hx : f x ≠ 0) :
  has_deriv_within_at (λ y, log (f y)) (f' / (f x)) s x :=
begin
  rw div_eq_inv_mul,
  exact (has_deriv_at_log hx).comp_has_deriv_within_at x hf
end

lemma has_deriv_at.log (hf : has_deriv_at f f' x) (hx : f x ≠ 0) :
  has_deriv_at (λ y, log (f y)) (f' / f x) x :=
begin
  rw ← has_deriv_within_at_univ at *,
  exact hf.log hx
end

lemma has_strict_deriv_at.log (hf : has_strict_deriv_at f f' x) (hx : f x ≠ 0) :
  has_strict_deriv_at (λ y, log (f y)) (f' / f x) x :=
begin
  rw div_eq_inv_mul,
  exact (has_strict_deriv_at_log hx).comp x hf
end

lemma deriv_within.log (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0)
  (hxs : unique_diff_within_at ℝ s x) :
  deriv_within (λx, log (f x)) s x = (deriv_within f s x) / (f x) :=
(hf.has_deriv_within_at.log hx).deriv_within hxs

@[simp] lemma deriv.log (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) :
  deriv (λx, log (f x)) x = (deriv f x) / (f x) :=
(hf.has_deriv_at.log hx).deriv

end deriv

section fderiv

variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {x : E}
  {f' : E →L[ℝ] ℝ} {s : set E}

lemma has_fderiv_within_at.log (hf : has_fderiv_within_at f f' s x) (hx : f x ≠ 0) :
  has_fderiv_within_at (λ x, log (f x)) ((f x)⁻¹ • f') s x :=
(has_deriv_at_log hx).comp_has_fderiv_within_at x hf

lemma has_fderiv_at.log (hf : has_fderiv_at f f' x) (hx : f x ≠ 0) :
  has_fderiv_at (λ x, log (f x)) ((f x)⁻¹ • f') x :=
(has_deriv_at_log hx).comp_has_fderiv_at x hf

lemma has_strict_fderiv_at.log (hf : has_strict_fderiv_at f f' x) (hx : f x ≠ 0) :
  has_strict_fderiv_at (λ x, log (f x)) ((f x)⁻¹ • f') x :=
(has_strict_deriv_at_log hx).comp_has_strict_fderiv_at x hf

lemma differentiable_within_at.log (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0) :
  differentiable_within_at ℝ (λx, log (f x)) s x :=
(hf.has_fderiv_within_at.log hx).differentiable_within_at

@[simp] lemma differentiable_at.log (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) :
  differentiable_at ℝ (λx, log (f x)) x :=
(hf.has_fderiv_at.log hx).differentiable_at

lemma cont_diff_at.log {n} (hf : cont_diff_at ℝ n f x) (hx : f x ≠ 0) :
  cont_diff_at ℝ n (λ x, log (f x)) x :=
(cont_diff_at_log.2 hx).comp x hf

lemma cont_diff_within_at.log {n} (hf : cont_diff_within_at ℝ n f s x) (hx : f x ≠ 0) :
  cont_diff_within_at ℝ n (λ x, log (f x)) s x :=
(cont_diff_at_log.2 hx).comp_cont_diff_within_at x hf

lemma cont_diff_on.log {n} (hf : cont_diff_on ℝ n f s) (hs : ∀ x ∈ s, f x ≠ 0) :
  cont_diff_on ℝ n (λ x, log (f x)) s :=
λ x hx, (hf x hx).log (hs x hx)

lemma cont_diff.log {n} (hf : cont_diff ℝ n f) (h : ∀ x, f x ≠ 0) :
  cont_diff ℝ n (λ x, log (f x)) :=
cont_diff_iff_cont_diff_at.2 $ λ x, hf.cont_diff_at.log (h x)

lemma differentiable_on.log (hf : differentiable_on ℝ f s) (hx : ∀ x ∈ s, f x ≠ 0) :
  differentiable_on ℝ (λx, log (f x)) s :=
λx h, (hf x h).log (hx x h)

@[simp] lemma differentiable.log (hf : differentiable ℝ f) (hx : ∀ x, f x ≠ 0) :
  differentiable ℝ (λx, log (f x)) :=
λx, (hf x).log (hx x)

lemma fderiv_within.log (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0)
  (hxs : unique_diff_within_at ℝ s x) :
  fderiv_within ℝ (λx, log (f x)) s x = (f x)⁻¹ • fderiv_within ℝ f s x :=
(hf.has_fderiv_within_at.log hx).fderiv_within hxs

@[simp] lemma fderiv.log (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) :
  fderiv ℝ (λx, log (f x)) x = (f x)⁻¹ • fderiv ℝ f x :=
(hf.has_fderiv_at.log hx).fderiv

end fderiv

end log_differentiable

namespace real

/-- The function `x * log (1 + t / x)` tends to `t` at `+∞`. -/
lemma tendsto_mul_log_one_plus_div_at_top (t : ℝ) :
  tendsto (λ x, x * log (1 + t / x)) at_top (𝓝 t) :=
begin
  have h₁ : tendsto (λ h, h⁻¹ * log (1 + t * h)) (𝓝[≠] 0) (𝓝 t),
  { simpa [has_deriv_at_iff_tendsto_slope, slope_fun_def] using
      (((has_deriv_at_id (0 : ℝ)).const_mul t).const_add 1).log (by simp) },
  have h₂ : tendsto (λ x : ℝ, x⁻¹) at_top (𝓝[≠] 0) :=
    tendsto_inv_at_top_zero'.mono_right (nhds_within_mono _ (λ x hx, (set.mem_Ioi.mp hx).ne')),
  simpa only [(∘), inv_inv] using h₁.comp h₂
end

open_locale big_operators

/-- A crude lemma estimating the difference between `log (1-x)` and its Taylor series at `0`,
where the main point of the bound is that it tends to `0`. The goal is to deduce the series
expansion of the logarithm, in `has_sum_pow_div_log_of_abs_lt_1`.
-/
lemma abs_log_sub_add_sum_range_le {x : ℝ} (h : |x| < 1) (n : ℕ) :
  |((∑ i in range n, x^(i+1)/(i+1)) + log (1-x))| ≤ (|x|)^(n+1) / (1 - |x|) :=
begin
  /- For the proof, we show that the derivative of the function to be estimated is small,
  and then apply the mean value inequality. -/
  let F : ℝ → ℝ := λ x, ∑ i in range n, x^(i+1)/(i+1) + log (1-x),
  -- First step: compute the derivative of `F`
  have A : ∀ y ∈ Ioo (-1 : ℝ) 1, deriv F y = - (y^n) / (1 - y),
  { assume y hy,
    have : (∑ i in range n, (↑i + 1) * y ^ i / (↑i + 1)) = (∑ i in range n, y ^ i),
    { congr' with i,
      exact mul_div_cancel_left _ (nat.cast_add_one_pos i).ne' },
    field_simp [F, this, geom_sum_eq (ne_of_lt hy.2),
                sub_ne_zero_of_ne (ne_of_gt hy.2), sub_ne_zero_of_ne (ne_of_lt hy.2)],
    ring },
  -- second step: show that the derivative of `F` is small
  have B : ∀ y ∈ Icc (-|x|) (|x|), |deriv F y| ≤ |x|^n / (1 - |x|),
  { assume y hy,
    have : y ∈ Ioo (-(1 : ℝ)) 1 := ⟨lt_of_lt_of_le (neg_lt_neg h) hy.1, lt_of_le_of_lt hy.2 h⟩,
    calc |deriv F y| = | -(y^n) / (1 - y)| : by rw [A y this]
    ... ≤ |x|^n / (1 - |x|) :
      begin
        have : |y| ≤ |x| := abs_le.2 hy,
        have : 0 < 1 - |x|, by linarith,
        have : 1 - |x| ≤ |1 - y| := le_trans (by linarith [hy.2]) (le_abs_self _),
        simp only [← pow_abs, abs_div, abs_neg],
        apply_rules [div_le_div, pow_nonneg, abs_nonneg, pow_le_pow_of_le_left]
      end },
  -- third step: apply the mean value inequality
  have C : ‖F x - F 0‖ ≤ (|x|^n / (1 - |x|)) * ‖x - 0‖,
  { have : ∀ y ∈ Icc (- |x|) (|x|), differentiable_at ℝ F y,
    { assume y hy,
      have : 1 - y ≠ 0 := sub_ne_zero_of_ne (ne_of_gt (lt_of_le_of_lt hy.2 h)),
      simp [F, this] },
    apply convex.norm_image_sub_le_of_norm_deriv_le this B (convex_Icc _ _) _ _,
    { simp },
    { simp [le_abs_self x, neg_le.mp (neg_le_abs_self x)] } },
  -- fourth step: conclude by massaging the inequality of the third step
  simpa [F, norm_eq_abs, div_mul_eq_mul_div, pow_succ'] using C
end

/-- Power series expansion of the logarithm around `1`. -/
theorem has_sum_pow_div_log_of_abs_lt_1 {x : ℝ} (h : |x| < 1) :
  has_sum (λ (n : ℕ), x ^ (n + 1) / (n + 1)) (-log (1 - x)) :=
begin
  rw summable.has_sum_iff_tendsto_nat,
  show tendsto (λ (n : ℕ), ∑ (i : ℕ) in range n, x ^ (i + 1) / (i + 1)) at_top (𝓝 (-log (1 - x))),
  { rw [tendsto_iff_norm_tendsto_zero],
    simp only [norm_eq_abs, sub_neg_eq_add],
    refine squeeze_zero (λ n, abs_nonneg _) (abs_log_sub_add_sum_range_le h) _,
    suffices : tendsto (λ (t : ℕ), |x| ^ (t + 1) / (1 - |x|)) at_top
      (𝓝 (|x| * 0 / (1 - |x|))), by simpa,
    simp only [pow_succ],
    refine (tendsto_const_nhds.mul _).div_const _,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 (abs_nonneg _) h },
  show summable (λ (n : ℕ), x ^ (n + 1) / (n + 1)),
  { refine summable_of_norm_bounded _ (summable_geometric_of_lt_1 (abs_nonneg _) h) (λ i, _),
    calc ‖x ^ (i + 1) / (i + 1)‖
    = |x| ^ (i + 1) / (i + 1) :
      begin
        have : (0 : ℝ) ≤ i + 1 := le_of_lt (nat.cast_add_one_pos i),
        rw [norm_eq_abs, abs_div, ← pow_abs, abs_of_nonneg this],
      end
    ... ≤ |x| ^ (i + 1) / (0 + 1) :
      begin
        apply_rules [div_le_div_of_le_left, pow_nonneg, abs_nonneg, add_le_add_right,
          i.cast_nonneg],
        norm_num,
      end
    ... ≤ |x| ^ i :
      by simpa [pow_succ'] using mul_le_of_le_one_right (pow_nonneg (abs_nonneg x) i) (le_of_lt h) }
end

/-- Power series expansion of `log(1 + x) - log(1 - x)` for `|x| < 1`. -/
lemma has_sum_log_sub_log_of_abs_lt_1 {x : ℝ} (h : |x| < 1) :
  has_sum (λ k : ℕ, (2 : ℝ) * (1 / (2 * k + 1)) * x ^ (2 * k + 1)) (log (1 + x) - log(1 - x)) :=
begin
  let term := λ n : ℕ, (-1) * ((-x) ^ (n + 1) / ((n : ℝ) + 1)) + x ^ (n + 1) / (n + 1),
  have h_term_eq_goal : term ∘ (*) 2 = λ k : ℕ, 2 * (1 / (2 * k + 1)) * x ^ (2 * k + 1),
  { ext n,
    dsimp [term],
    rw [odd.neg_pow (⟨n, rfl⟩ : odd (2 * n + 1)) x],
    push_cast,
    ring_nf, },
  rw [← h_term_eq_goal, (mul_right_injective₀ (two_ne_zero' ℕ)).has_sum_iff],
  { have h₁ := (has_sum_pow_div_log_of_abs_lt_1 (eq.trans_lt (abs_neg x) h)).mul_left (-1),
    convert h₁.add (has_sum_pow_div_log_of_abs_lt_1 h),
    ring_nf },
  { intros m hm,
    rw [range_two_mul, set.mem_set_of_eq, ← nat.even_add_one] at hm,
    dsimp [term],
    rw [even.neg_pow hm, neg_one_mul, neg_add_self] },
end

/-- Expansion of `log (1 + a⁻¹)` as a series in powers of `1 / (2 * a + 1)`. -/
theorem has_sum_log_one_add_inv {a : ℝ} (h : 0 < a) :
  has_sum (λ k : ℕ, (2 : ℝ) * (1 / (2 * k + 1)) * (1 / (2 * a + 1)) ^ (2 * k + 1))
  (log (1 + a⁻¹)) :=
begin
  have h₁ : |1 / (2 * a + 1)| < 1,
  { rw [abs_of_pos, div_lt_one],
    { linarith, },
    { linarith, },
    { exact div_pos one_pos (by linarith), }, },
  convert has_sum_log_sub_log_of_abs_lt_1 h₁,
  have h₂ : (2 : ℝ) * a + 1 ≠ 0 := by linarith,
  have h₃ := h.ne',
  rw ← log_div,
  { congr,
    field_simp,
    linarith, },
  { field_simp,
    linarith } ,
  { field_simp },
end

end real


-- import data.set
import tactic

-- dEAduction imports
import structures2
import notations_definitions
import utils

-- General principles :
-- Type should be defined as parameters, in order to be implicit everywhere
-- other parameters are implicit in definitions, i.e. defined using '{}' (e.g. {A : set X} )
-- but explicit everywhere else, i.e. defined using '()' (e.g. (A : set X) )
-- each definition must be an iff statement (since it will be called with 'rw' or 'symp_rw')

---------------------
-- Course metadata --
---------------------
-- logic names ['and', 'or', 'negate', 'implicate', 'iff', 'forall', 'exists']
-- proofs names ['use_proof_methods', 'new_object', 'apply', 'assumption']
-- magic names ['compute']
-- proof methods names ['cbr', 'contrapose', 'absurdum', 'sorry']

/- dEAduction
Title
    Théorie des ensembles
Author
    Frédéric Le Roux
Institution
    Université de France
-/

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course
-- parameters {X Y Z: Type}

notation [parsing_only] P ` and ` Q := P ∧ Q
notation [parsing_only]  P ` or ` Q := P ∨ Q
notation [parsing_only]  ` not ` P := ¬ P
notation [parsing_only]  P ` implies ` Q := P → Q
notation [parsing_only]  P ` iff ` Q := P ↔ Q

notation [parsing_only]  x ` in ` A := x ∈ A
notation [parsing_only]  A ` cap ` B := A ∩ B
notation [parsing_only]  A ` cup ` B := A ∪ B
notation [parsing_only]  A ` subset ` B := A ⊆ B
notation [parsing_only]  `emptyset` := ∅

notation [parsing_only] P ` et ` Q := P ∧ Q
notation [parsing_only]  P ` ou ` Q := P ∨ Q
notation [parsing_only]  ` non ` P := ¬ P
notation [parsing_only]  P ` implique ` Q := P → Q
notation [parsing_only]  P ` ssi ` Q := P ↔ Q

notation [parsing_only]  x ` dans ` A := x ∈ A
notation [parsing_only]  x ` appartient ` A := x ∈ A
notation [parsing_only]  A ` inter ` B := A ∩ B
notation [parsing_only]  A ` intersection ` B := A ∩ B
notation [parsing_only]  A ` union ` B := A ∪ B
notation [parsing_only]  A ` inclus ` B := A ⊆ B
notation [parsing_only]  `vide` := ∅

notation f `⟮` A `⟯` := f '' A
notation f `⁻¹⟮` A `⟯` := f  ⁻¹' A
notation [parsing_only] f `inverse` A := f  ⁻¹' A
notation g `∘` f := set.composition g f
notation `∃!` P := exists_unique P

open set
parameters X Y Z: Type
------------------
-- COURSE TITLE --
------------------
namespace theorie_des_ensembles
/- dEAduction
PrettyName
    Théorie des ensembles
-/

namespace generalites
/- dEAduction
PrettyName
    Généralités
-/

------------------------
-- COURSE DEFINITIONS --
------------------------
lemma definition.inclusion {A B : set X} : A ⊆ B ↔ ∀ {x:X}, x ∈ A → x ∈ B :=
begin
    exact iff.rfl
end

lemma definition.egalite_deux_ensembles {A A' : set X} :
(A = A') ↔ ( ∀ x, x ∈ A ↔ x ∈ A' ) :=
/- dEAduction
PrettyName
    Egalité de deux ensembles
-/
begin
     exact set.ext_iff
end

lemma definition.ensemble_vide
(A: set X) :
(A = ∅) ↔ ∀ x : X, x ∉ A
:=
begin
    exact eq_empty_iff_forall_not_mem,
end

-- lemma definition.ensemble_non_vide
-- (A: set X) :
-- (A ≠ ∅) ↔ ∃ x : X, x ∈ A
-- :=
-- begin
--     sorry
-- end

-- set_option pp.all true
lemma definition.ensemble_extension {X: Type}  {P : X → Prop} {x:X} :
 x ∈ {x | P x} ↔ P x
:=
/- dEAduction
PrettyName
    Ensemble en extension
-/
begin
    refl
end

lemma theorem.double_inclusion (A A' : set X) :
(A ⊆ A' ∧ A' ⊆ A) → A = A' :=
/- dEAduction
PrettyName
    Double inclusion
-/
begin
    exact set.subset.antisymm_iff.mpr
end

lemma exercise.inclusion_transitive
(A B C : set X) :
(A ⊆ B ∧ B ⊆ C) → A ⊆ C
:=
/- dEAduction
PrettyName
    Transitivité de l'inclusion
AutoTest
    →, definition.inclusion, ∀, →,
    @P1 ∧,
    @P2 @P3 definition.inclusion,
    @P2 @P1 →,
    @P3 @P4 →,
    CQFD
-/
begin
    intro H1,
    rw definition.inclusion,
    intros x H2,
    cases H1 with H3 H4,
    rw definition.inclusion at H3 H4,
    have H5 := H3 H2,
    have H6 := H4 H5,
    assumption,
end

example (x y:X) (H : x ≠ y) : y ≠ x :=
begin
    apply ne.symm, assumption,
end

end generalites

---------------
-- SECTION 1 --
---------------
namespace unions_et_intersections
-- variables unions_et_intersections --
variables {A B C : set X}

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.intersection_deux_ensembles {A B : set X} {x : X} :
x ∈ A ∩ B ↔ ( x ∈ A ∧ x ∈ B) :=
/- dEAduction
PrettyName
    Intersection de deux ensembles
-/
begin
    exact iff.rfl
end

lemma definition.intersection_quelconque_ensembles {I : Type} {E : I → set X}  {x : X} :
(x ∈ set.Inter (λ i, E i)) ↔ (∀ i:I, x ∈ E i) :=
/- dEAduction
PrettyName
    Intersection d'une famille quelconque d'ensembles
-/
begin
    exact set.mem_Inter
end

lemma definition.union_deux_ensembles  {A : set X} {B : set X} {x : X} :
x ∈ A ∪ B ↔ ( x ∈ A ∨ x ∈ B) :=
/- dEAduction
PrettyName
    Union de deux ensembles
-/
begin
    exact iff.rfl
end

lemma definition.union_quelconque_ensembles {I : Type} {E : I → set X}  {x : X} :
(x ∈ set.Union (λ i, E i)) ↔ (∃ i:I, x ∈ E i) :=
/- dEAduction
PrettyName
    Union d'une famille quelconque d'ensembles
-/
begin
    exact set.mem_Union
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices

lemma exercise.intersection_inclus_ensemble :
A ∩ B ⊆ A
:=
/- dEAduction
PrettyName
    Un ensemble contient son intersection avec un autre
AutoTest
    definition.inclusion,  ∀, →,
    @P1 definition.intersection_deux_ensembles, @P1 ∧,
    CQFD
-/
begin
    sorry
end

lemma exercise.union_distributive_inter : A ∩ (B ∪ C)  = (A ∩ B) ∪ (A ∩ C) :=
/- dEAduction
PrettyName
    Intersection avec une union
Description
    L'intersection est distributive par rapport à l'union
AvailableLogic
    $ALL
AvailableProofs
    $ALL
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
AvailableTheorems
    double_inclusion
ExpectedVarsNumber
    X=3, A=1, B=1
-/
begin
    sorry
end

-- NB: 'ExpectedVarsNumber' is not implemented yet
-- planned to be used for naming variables

lemma exercise.inter_distributive_union : A ∪ (B ∩ C)  = (A ∪ B) ∩ (A ∪ C) :=
/- dEAduction
PrettyName
    Union avec une intersection
Description
    L'union est distributive par rapport à l'intersection
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    sorry
end

end exercices

end unions_et_intersections

---------------
-- SECTION 2 --
---------------
namespace complementaire
-- variables complementaire --
variables  {A B : set X}
variables {I : Type} {E F : I → set X}
-- notation `∁`A := set.compl A

-----------------
-- DEFINITIONS --
-----------------
lemma definition.complement {A : set X} {x : X} : x ∈ set.compl A ↔ x ∉ A :=
/- dEAduction
PrettyName
    Complémentaire
-/
begin
    finish
end

--lemma definition.difference_d_ensembles {A B : set X} {x : X} : x ∈ B \ A ↔ (x ∈ B ∧ x ∉ A) :=
-- iff.rfl

---------------
-- EXERCICES --
---------------
lemma exercise.complement_complement : (set.compl (set.compl A)) = A :=
/- dEAduction
PrettyName
    Complémentaire du complémentaire
Description
    Tout ensemble est égal au complémentaire de son complémentaire
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    sorry
end

lemma exercise.complement_union_deux :
set.compl (A ∪ B) = (set.compl A) ∩ (set.compl B) :=
/- dEAduction
PrettyName
    Complémentaire d'union I
Description
    Le complémentaire de l'union de deux ensembles égale l'intersection des complémentaires
AvailableDefinitions
    $UNTIL_NOW -union_quelconque_ensembles -intersection_quelconque_ensembles
-/
begin
    sorry
end

lemma exercise.complement_union_quelconque :
set.compl (set.Union (λ i, E i)) = set.Inter (λ i, set.compl (E i)) :=
/- dEAduction
PrettyName
    Complémentaire d'union II
Description
    Le complémentaire d'une réunion quelconque égale l'intersection des complémentaires
-/
begin
    sorry
end

lemma exercise.inclusion_complement_I :
A ⊆ B → set.compl B ⊆ set.compl A
:=
/- dEAduction
PrettyName
    Le passage au complémentaire renverse les inclusions, implication
Description
    Si A est inclus dans B, alors le complémentaire de A contient le complémentaire de B
-/
begin
    sorry
end

lemma exercise.inclusion_complement_II :
A ⊆ B ↔ set.compl B ⊆ set.compl A
:=
/- dEAduction
PrettyName
    Le passage au complémentaire renverse les inclusions, équivalence
Description
    Si A est inclus dans B, alors le complémentaire de A contient le complémentaire de B
-/
begin
    sorry
end

/- Autres : différence-/

end complementaire

-- Ajouter :  4. relations ?

namespace produits_cartesiens
/- dEAduction
PrettyName
    Produits cartésiens
-/

-- Peut-on en faire une définition ?
lemma theorem.type_produit :
∀ z:X × Y, ∃ x:X, ∃ y:Y, z = (x,y)
:=
/- dEAduction
PrettyName
    Element d'un produit cartésien de deux ensembles
-/
begin
    sorry
end

lemma definition.produit_de_parties {A : set X} {B : set Y}
{x:X} {y:Y} :
(x,y) ∈ set.prod A B ↔ x ∈ A ∧ y ∈ B
:=
/- dEAduction
PrettyName
    Produit cartésien de deux parties
-/
begin
    sorry
end

lemma exercise.produit_avec_intersection
(A : set X) (B C : set Y) :
set.prod A (B ∩ C) = (set.prod A B) ∩ (set.prod A C)
:=
begin
    sorry
end

end produits_cartesiens
---------------
-- SECTION 3 --
---------------
namespace applications_I
/- dEAduction
PrettyName
    Applications et opérations ensemblistes
-/

-- variables applications --

variables  {A A': set X}
variables {f: X → Y} {B B': set Y}
variables {I : Type} {E : I → set X} {F : I → set Y}
variables (g : Y → Z) (h : X → Z)

-- a-t-on besoin de ceci ?
-- lemma theorem.egalite_fonctions : f = f' ↔ ∀ x : X, f(x) = f'(x) :=
--  function.funext_iff

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/
lemma definition.image_directe (y : Y) : y ∈ f '' A ↔ ∃ x : X, x ∈ A ∧  f x = y :=
begin
    sorry
end

lemma definition.image_reciproque (x:X) : x ∈ f  ⁻¹' B ↔ f(x) ∈ B :=
begin
    sorry
end

lemma definition.composition {x:X}:
composition g f x = g (f x)
:=
begin
    sorry,
end

lemma definition.egalite_fonctions (f' : X → Y) :
f = f' ↔ ∀ x, f x = f' x :=
/- dEAduction
PrettyName
    Egalité de deux fonctions
-/
begin
    exact function.funext_iff,
end

lemma definition.Identite (f₀: X → X) :
f₀ = Identite ↔ ∀ x, f₀ x = x :=
/- dEAduction
PrettyName
    Application identité
-/
begin
    apply definition.egalite_fonctions,
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices
/- dEAduction
PrettyName
    Exercices
-/
open applications_I.definitions

lemma exercise.image_de_reciproque : f '' (f ⁻¹' B)  ⊆ B :=
/- dEAduction
PrettyName
    Image de l'image réciproque
-/
begin
    sorry
end

lemma exercise.reciproque_de_image : A ⊆ f ⁻¹' (f '' A) :=
/- dEAduction
PrettyName
    Image réciproque de l'image
-/
begin
    sorry
end

lemma exercise.image_reciproque_inter :  f ⁻¹'  (B∩B') = f ⁻¹'  (B) ∩ f ⁻¹'  (B') :=
/- dEAduction
PrettyName
    Image réciproque d'une intersection de deux ensembles
-/
begin
    sorry
end

lemma  exercise.image_reciproque_union  : f ⁻¹' (B ∪ B') = f ⁻¹' B ∪ f ⁻¹' B'
:=
/- dEAduction
PrettyName
    Image réciproque d'une union de deux ensembles
-/
begin
    sorry
end

-- set_option pp.width 100
lemma exercise.image_reciproque_inter_quelconque :
(f ⁻¹'  (set.Inter (λ i, F i))) = set.Inter (λ i, f ⁻¹' (F i))
:=
/- dEAduction
PrettyName
    Image réciproque d'une intersection quelconque
-/
begin
    sorry
end

lemma exercise.image_reciproque_union_quelconque :
(f ⁻¹'  (set.Union (λ i, F i))) = set.Union (λ i, f ⁻¹' (F i))
:=
/- dEAduction
PrettyName
    Image réciproque d'une union quelconque
-/
begin
    sorry
end

lemma exercise.image_inter_inclus_inter_images :
f '' (A∩A') ⊆ f '' (A) ∩ f '' (A')
:=
/- dEAduction
PrettyName
    Image d'une intersection
-/
begin
    sorry
end

lemma exercise.reciproque_complementaire_I :
f ⁻¹' (set.compl B) ⊆ set.compl (f ⁻¹' B)
:=
/- dEAduction
PrettyName
    Image réciproque du complémentaire, inclusion
-/
begin
    sorry
end

lemma exercise.reciproque_complementaire_II :
f ⁻¹' (set.compl B) = set.compl (f ⁻¹' B)
:=
/- dEAduction
PrettyName
    Image réciproque du complémentaire, égalité
-/
begin
    sorry
end

lemma exercices.image_reciproque.composition
(C: set Z)
:
((composition g f) )⁻¹' C = f ⁻¹' (g ⁻¹' C)
:=
begin
    sorry
end

end exercices
end applications_I

----------------
-- SUBSECTION --
----------------
namespace applications_II
/- dEAduction
PrettyName
    Injections et surjections
-/

-- variables injections_surjections --
variables (f: X → Y) (g : Y → Z) (h : X → Z)

-----------------
-- DEFINITIONS --
-----------------
namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

/-
def injective {X Y : Type} (f₀ : X → Y) := ∀ x y : X, (f₀ x = f₀ y → x = y)
def surjective {X Y : Type} (f₀ : X → Y) := ∀ y : Y, ∃ x : X, y = f₀ x
def composition {X Y Z : Type} (g₀ : Y → Z) (f₀ : X → Y) := λx:X, g₀ (f₀ x)
def Identite {X : Type} := λ x:X, x
-/

lemma definition.injectivite :
injective f ↔ ∀ x y : X, (f x = f y → x = y)
:=
/- dEAduction
PrettyName
    Application injective
-/
begin
    refl,
end

lemma definition.surjectivite :
surjective f ↔ ∀ y : Y, ∃ x : X, y = f x
:=
/- dEAduction
PrettyName
    Application surjective
-/
begin
    refl,
end

-- A bouger, mais à enlever de tous les exos où ça ne sert pas !
lemma definition.existe_un_unique
(P : X → Prop) :
(∃! (λx,  P x)) ↔  (∃ x : X, (P x ∧ (∀ x' : X, P x' → x' = x)))
:=
/- dEAduction
PrettyName
    ∃! : existence et unicité
-/
begin
    sorry
end

lemma definition.bijectivite :
bijective f ↔ ∀ y : Y, exists_unique (λ x, y = f x)
:=
/- dEAduction
PrettyName
    Application bijective
-/
begin
    refl,
end

end definitions

---------------
-- EXERCICES --
---------------
namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

open applications_II.definitions

lemma exercise.composition_injections
(H1 : injective f) (H2 : injective g)
:
injective (composition g f)
:=
/- dEAduction
PrettyName
    Composition d'injections
-/
begin
    sorry
end

lemma exercise.composition_surjections
(H1 : surjective f) (H2 : surjective g) :
surjective (composition g f)
:=
/- dEAduction
PrettyName
    Composition de surjections
-/
begin
    sorry
end

lemma exercise.injective_si_compo_injective
(H1 : injective (composition g f)) :
injective f
:=
/- dEAduction
PrettyName
    Injective si composition injective
-/
begin
    sorry
end

lemma exercise.surjective_si_coompo_surjective
(H1 : surjective (composition g f)) :
surjective g
:=
/- dEAduction
PrettyName
    Surjective si composition surjective
-/
begin
    intro y,
    sorry
end

lemma exercise.injective_ssi_inverse_gauche : (injective f) ↔
∃ F: Y → X, (composition F f) = Identite :=
/- dEAduction
PrettyName
    (x) Injectivité et inverse à gauche
-/
begin
    sorry
end

lemma exercise.surjective_ssi_inverse_droite : (surjective f) ↔
∃ F: Y → X, (composition f F) = Identite :=
/- dEAduction
PrettyName
    (*) Surjectivité et inverse à droite
-/
begin
    sorry
end

lemma exercise.bijective_ssi_injective_et_surjective :
(bijective f) ↔ (injective f ∧ surjective f)
:=
/- dEAduction
PrettyName
    (**) "Bijectif" équivaut à "injectif et surjectif"
-/
begin
    sorry
end

lemma exercise.bijective_ssi_inverse :
(bijective f) ↔ ∃ g : Y → X,
composition g f = Identite ∧ composition f g  = Identite
:=
/- dEAduction
PrettyName
    (**) Bijectivité et existence d'une application réciproque
-/
begin
    sorry
end

lemma exercise.unicite_inverse :
(bijective f) → exists_unique (λ g : Y → X,
composition g f = Identite)
:=
/- dEAduction
PrettyName
    (+) Unicité de la réciproque d'une application bijective
-/
begin
    sorry
end

lemma exercise.Cantor (f : X → set X):
 ¬ surjective f
:=
/- dEAduction
PrettyName
    (+) Théorème de Cantor : il n'y a pas de surjection d'un ensemble vers l'ensemble de ses parties
-/
begin
    by_contradiction H14,
    let A := {x | x ∉ f x}, have H15 : A = {x | x ∉ f x}, refl,
    rw theorie_des_ensembles.applications_II.definitions.definition.surjectivite at H14,
    have H16 := H14 A,
    cases H16 with x H17,
    cases (classical.em (x dans A)) with H22 H23,
    {
        have H22b: x ∉ A,
        rw H15 at H22,
        rw generalites.definition.ensemble_extension at H22,
        rw H17, assumption,
        contradiction,
    },
    {
        have H22b: x ∈ A,
        rw H15 at H23,
        -- simp only[ensemble_extension] at H23,
        rw generalites.definition.ensemble_extension at H23,
        push_neg at H23,
        rw H17, assumption,
        contradiction
    }
end

end exercices

end applications_II

-----------------------------------
-----------------------------------
namespace exercices_supplementaires

-- relations : rel d'eq implique classes égales ou disjointes
-- les images réciproques des singletons forment une partition
-- bijective ssi inversible à g et d et inverses coincident

lemma exercise.exercice_ensembles_1
(A B : set X) :
A ⊆ B ↔ A ∩ B = A
:=
/- dEAduction
PrettyName
    Caractérisation de l'inclusion par l'intersection
-/
begin
    sorry
end

lemma exercise.complement_intersection_2
(A B : set X):
set.compl (A ∩  B) = (set.compl A) ∪ (set.compl B)
:=
/- dEAduction
PrettyName
    Complémentaire d'une intersection
-/
begin
    sorry
end

lemma exercise.exercice_ensembles_3
(A B : set X) :
A ∩ B = A ∪ B → A = B
:=
/- dEAduction
PrettyName
    Quand l'intersection égale l'union
-/
begin
    sorry
end

lemma exercise.exercice_ensembles_4a
(A B C : set X) :
A ∩ B = A ∩ C ∧ (set.compl A) ∩ B = (set.compl A) ∩ C → B ⊆ C
:=
/- dEAduction
PrettyName
    Caractérisation par intersection avec A et son complémentaire, I
-/
begin
    sorry
end

lemma exercise.exercice_ensembles_4b
(A B C : set X) :
A ∩ B = A ∩ C ∧ (set.compl A) ∩ B = (set.compl A) ∩ C → B = C
:=
/- dEAduction
PrettyName
    Caractérisaton par intersection avec A et son complémentaire, II
-/
begin
    sorry
end

lemma exercise.exercice_ensembles_5
(A B C : set X) :
A ∩ B = A ∩ C ∧ A ∪ B = A ∪ C → B = C
:=
/- dEAduction
PrettyName
    Même union et même intersection
-/
begin
    sorry
end

--def diff {X : Type} (A B : set X) := {x ∈ A | ¬ x ∈ B}
--notation A `\\` B := diff A B

-- def symmetric_difference {X : Type} (A B : set X) := (A ∪ B) \ (A ∩ B)
-- notation A `Δ` B := symmetric_difference A B

namespace difference_et_difference_symetrique
/- dEAduction
PrettyName
    Différence et différence symétrique
-/

namespace definitions
/- dEAduction
PrettyName
    Définitions
-/

lemma definition.difference
(A B : set X) (x : X) :
x ∈ (A \ B) ↔ x ∈ A ∧ x ∉ B
:=
/- dEAduction
PrettyName
    Différence de deux ensembles
-/
begin
    refl,
end

lemma definition.difference_symetrique
(A B : set X) :
(A Δ B) =  (A ∪ B) \ (A ∩ B)
:=
/- dEAduction
PrettyName
    Différence symétrique de deux ensembles
-/
begin
    refl,
end

end definitions

namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

lemma exercise.difference_symetrique_1
(A B : set X) :
(A Δ B) = (A \ B) ∪ (B \ A)
:=
/- dEAduction
PrettyName
    Différence symétrique I
-/
begin
    sorry
end

lemma exercise.difference_symetrique_2
(A B : set X) :
(A Δ B) = (B Δ A)
:=
/- dEAduction
PrettyName
    (*) Différence symétrique II
-/
begin
    sorry
end

lemma exercise.difference_symetrique_3
(A B C : set X) :
((A Δ B) Δ C) = (A Δ (B Δ C))
:=
/- dEAduction
PrettyName
    (**) Différence symétrique III
-/
begin
    sorry
end

lemma exercise.difference_symetrique_4 :
∃! (λE : set X, ∀ A : set X, (A Δ E) = A) :=
/- dEAduction
PrettyName
    (+) Différence symétrique VI
-/
begin
    sorry
end

lemma exercise.difference_symetrique_5 (A : set X) :
exists_unique (λA' : set X, (A Δ A') = set.univ)
:=
/- dEAduction
PrettyName
    (+) Différence symétrique V
-/
begin
    sorry
end

lemma exercise.difference_symetrique_6
(A B : set X) :
(A Δ B) = ∅ ↔ A = B
:=
/- dEAduction
PrettyName
    (+) Différence symétrique VI
-/
begin
    sorry
end

end exercices

end difference_et_difference_symetrique

-- applications
variable (f: X → Y)

namespace applications

lemma exercise.exercice_applications_1
(A B : set X) :
A ⊆ B → f '' A ⊆ f '' B
:=
/- dEAduction
PrettyName
    Image directe et inclusion
-/
begin
    sorry
end

lemma exercise.exercice_applications_2
(A B : set X) :
f '' (A ∪ B)  = f '' A ∪ f '' B
:=
/- dEAduction
PrettyName
    Image d'une union
-/
begin
    sorry
end

open applications_II.definitions
lemma exercise.exercice_factorisation_I
(g : Y → Z) (h: X → Z) :
(∃ f: X → Y, h = (composition g f)) ↔ h '' set.univ ⊆ g '' set.univ
:=
/- dEAduction
PrettyName
    (+) Factorisation I
-/
begin
    sorry
end

lemma exercise.exercice_factorisation_II
(f : X → Y) (h: X → Z) :
(∃ g: Y → Z, h = (composition g f)) ↔ (∀ x y, (f x = f y → h x = h y))
:=
/- dEAduction
PrettyName
    (+) Factorisation II
-/
begin
    sorry
end

-- TODO: ajouter exoset ficall.pdf exos (140 bijections) 141 142 146

end applications

end exercices_supplementaires

end theorie_des_ensembles

end course


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.locally_finite

/-!
# Finite intervals of naturals

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

This file proves that `ℕ` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.

## TODO

Some lemmas can be generalized using `ordered_group`, `canonically_ordered_monoid` or `succ_order`
and subsequently be moved upstream to `data.finset.locally_finite`.
-/

open finset nat

instance : locally_finite_order ℕ :=
{ finset_Icc := λ a b, ⟨list.range' a (b + 1 - a), list.nodup_range' _ _⟩,
  finset_Ico := λ a b, ⟨list.range' a (b - a), list.nodup_range' _ _⟩,
  finset_Ioc := λ a b, ⟨list.range' (a + 1) (b - a), list.nodup_range' _ _⟩,
  finset_Ioo := λ a b, ⟨list.range' (a + 1) (b - a - 1), list.nodup_range' _ _⟩,
  finset_mem_Icc := λ a b x, begin
    rw [finset.mem_mk, multiset.mem_coe, list.mem_range'],
    cases le_or_lt a b,
    { rw [add_tsub_cancel_of_le (nat.lt_succ_of_le h).le, nat.lt_succ_iff] },
    { rw [tsub_eq_zero_iff_le.2 (succ_le_of_lt h), add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2)) }
  end,
  finset_mem_Ico := λ a b x, begin
    rw [finset.mem_mk, multiset.mem_coe, list.mem_range'],
    cases le_or_lt a b,
    { rw [add_tsub_cancel_of_le h] },
    { rw [tsub_eq_zero_iff_le.2 h.le, add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2.le)) }
  end,
  finset_mem_Ioc := λ a b x, begin
    rw [finset.mem_mk, multiset.mem_coe, list.mem_range'],
    cases le_or_lt a b,
    { rw [←succ_sub_succ, add_tsub_cancel_of_le (succ_le_succ h), nat.lt_succ_iff,
        nat.succ_le_iff] },
    { rw [tsub_eq_zero_iff_le.2 h.le, add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.le.trans hx.2)) }
  end,
  finset_mem_Ioo := λ a b x, begin
    rw [finset.mem_mk, multiset.mem_coe, list.mem_range', ← tsub_add_eq_tsub_tsub],
    cases le_or_lt (a + 1) b,
    { rw [add_tsub_cancel_of_le h, nat.succ_le_iff] },
    { rw [tsub_eq_zero_iff_le.2 h.le, add_zero],
      exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2)) }
  end }

variables (a b c : ℕ)

namespace nat

lemma Icc_eq_range' : Icc a b = ⟨list.range' a (b + 1 - a), list.nodup_range' _ _⟩ := rfl
lemma Ico_eq_range' : Ico a b = ⟨list.range' a (b - a), list.nodup_range' _ _⟩ := rfl
lemma Ioc_eq_range' : Ioc a b = ⟨list.range' (a + 1) (b - a), list.nodup_range' _ _⟩ := rfl
lemma Ioo_eq_range' : Ioo a b = ⟨list.range' (a + 1) (b - a - 1), list.nodup_range' _ _⟩ := rfl

lemma Iio_eq_range : Iio = range := by { ext b x, rw [mem_Iio, mem_range] }

@[simp] lemma Ico_zero_eq_range : Ico 0 = range := by rw [←bot_eq_zero, ←Iio_eq_Ico, Iio_eq_range]

lemma _root_.finset.range_eq_Ico : range = Ico 0 := Ico_zero_eq_range.symm

@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a := list.length_range' _ _
@[simp] lemma card_Ico : (Ico a b).card = b - a := list.length_range' _ _
@[simp] lemma card_Ioc : (Ioc a b).card = b - a := list.length_range' _ _
@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 := list.length_range' _ _
@[simp] lemma card_Iic : (Iic b).card = b + 1 :=
by rw [Iic_eq_Icc, card_Icc, bot_eq_zero, tsub_zero]

@[simp] lemma card_Iio : (Iio b).card = b := by rw [Iio_eq_Ico, card_Ico, bot_eq_zero, tsub_zero]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a :=
by rw [fintype.card_of_finset, card_Icc]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = b - a :=
by rw [fintype.card_of_finset, card_Ico]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = b - a :=
by rw [fintype.card_of_finset, card_Ioc]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 :=
by rw [fintype.card_of_finset, card_Ioo]

@[simp] lemma card_fintype_Iic : fintype.card (set.Iic b) = b + 1 :=
by rw [fintype.card_of_finset, card_Iic]

@[simp] lemma card_fintype_Iio : fintype.card (set.Iio b) = b :=
by rw [fintype.card_of_finset, card_Iio]

-- TODO@Yaël: Generalize all the following lemmas to `succ_order`

lemma Icc_succ_left : Icc a.succ b = Ioc a b := by { ext x, rw [mem_Icc, mem_Ioc, succ_le_iff] }

lemma Ico_succ_right : Ico a b.succ = Icc a b := by { ext x, rw [mem_Ico, mem_Icc, lt_succ_iff] }

lemma Ico_succ_left : Ico a.succ b = Ioo a b := by { ext x, rw [mem_Ico, mem_Ioo, succ_le_iff] }

lemma Icc_pred_right {b : ℕ} (h : 0 < b) : Icc a (b - 1) = Ico a b :=
by { ext x, rw [mem_Icc, mem_Ico, lt_iff_le_pred h] }

lemma Ico_succ_succ : Ico a.succ b.succ = Ioc a b :=
by { ext x, rw [mem_Ico, mem_Ioc, succ_le_iff, lt_succ_iff] }

@[simp] lemma Ico_succ_singleton : Ico a (a + 1) = {a} := by rw [Ico_succ_right, Icc_self]

@[simp] lemma Ico_pred_singleton {a : ℕ} (h : 0 < a) : Ico (a - 1) a = {a - 1} :=
by rw [←Icc_pred_right _ h, Icc_self]

@[simp] lemma Ioc_succ_singleton : Ioc b (b + 1) = {b+1} :=
by rw [← nat.Icc_succ_left, Icc_self]

variables {a b c}

lemma Ico_succ_right_eq_insert_Ico (h : a ≤ b) : Ico a (b + 1) = insert b (Ico a b) :=
by rw [Ico_succ_right, ←Ico_insert_right h]

lemma Ico_insert_succ_left (h : a < b) : insert a (Ico a.succ b) = Ico a b :=
by rw [Ico_succ_left, ←Ioo_insert_left h]

lemma image_sub_const_Ico (h : c ≤ a) : (Ico a b).image (λ x, x - c) = Ico (a - c) (b - c) :=
begin
  ext x,
  rw mem_image,
  split,
  { rintro ⟨x, hx, rfl⟩,
    rw [mem_Ico] at ⊢ hx,
    exact ⟨tsub_le_tsub_right hx.1 _, tsub_lt_tsub_right_of_le (h.trans hx.1) hx.2⟩ },
  { rintro h,
    refine ⟨x + c, _, add_tsub_cancel_right _ _⟩,
    rw mem_Ico at ⊢ h,
    exact ⟨tsub_le_iff_right.1 h.1, lt_tsub_iff_right.1 h.2⟩ }
end

lemma Ico_image_const_sub_eq_Ico (hac : a ≤ c) :
  (Ico a b).image (λ x, c - x) = Ico (c + 1 - b) (c + 1 - a) :=
begin
  ext x,
  rw [mem_image, mem_Ico],
  split,
  { rintro ⟨x, hx, rfl⟩,
    rw mem_Ico at hx,
    refine ⟨_, ((tsub_le_tsub_iff_left hac).2 hx.1).trans_lt ((tsub_lt_tsub_iff_right hac).2
      (nat.lt_succ_self _))⟩,
    cases lt_or_le c b,
    { rw tsub_eq_zero_iff_le.mpr (succ_le_of_lt h),
      exact zero_le _ },
    { rw ←succ_sub_succ c,
      exact (tsub_le_tsub_iff_left (succ_le_succ $ hx.2.le.trans h)).2 hx.2 } },
  { rintro ⟨hb, ha⟩,
    rw [lt_tsub_iff_left, lt_succ_iff] at ha,
    have hx : x ≤ c := (nat.le_add_left _ _).trans ha,
    refine ⟨c - x, _, tsub_tsub_cancel_of_le hx⟩,
    { rw mem_Ico,
      exact ⟨le_tsub_of_add_le_right ha, (tsub_lt_iff_left hx).2 $ succ_le_iff.1 $
        tsub_le_iff_right.1 hb⟩ } }
end

lemma Ico_succ_left_eq_erase_Ico : Ico a.succ b = erase (Ico a b) a :=
begin
  ext x,
  rw [Ico_succ_left, mem_erase, mem_Ico, mem_Ioo, ←and_assoc, ne_comm, and_comm (a ≠ x),
    lt_iff_le_and_ne],
end

lemma mod_inj_on_Ico (n a : ℕ) : set.inj_on (% a) (finset.Ico n (n+a)) :=
begin
  induction n with n ih,
  { simp only [zero_add, nat_zero_eq_zero, Ico_zero_eq_range],
    rintro k hk l hl (hkl : k % a = l % a),
    simp only [finset.mem_range, finset.mem_coe] at hk hl,
    rwa [mod_eq_of_lt hk, mod_eq_of_lt hl] at hkl, },
  rw [Ico_succ_left_eq_erase_Ico, succ_add, Ico_succ_right_eq_insert_Ico le_self_add],
  rintro k hk l hl (hkl : k % a = l % a),
  have ha : 0 < a,
  { by_contra ha, simp only [not_lt, nonpos_iff_eq_zero] at ha, simpa [ha] using hk },
  simp only [finset.mem_coe, finset.mem_insert, finset.mem_erase] at hk hl,
  rcases hk with ⟨hkn, (rfl|hk)⟩; rcases hl with ⟨hln, (rfl|hl)⟩,
  { refl },
  { rw add_mod_right at hkl,
    refine (hln $ ih hl _ hkl.symm).elim,
    simp only [lt_add_iff_pos_right, set.left_mem_Ico, finset.coe_Ico, ha], },
  { rw add_mod_right at hkl,
    suffices : k = n, { contradiction },
    refine ih hk _ hkl,
    simp only [lt_add_iff_pos_right, set.left_mem_Ico, finset.coe_Ico, ha], },
  { refine ih _ _ hkl; simp only [finset.mem_coe, hk, hl], },
end

/-- Note that while this lemma cannot be easily generalized to a type class, it holds for ℤ as
well. See `int.image_Ico_mod` for the ℤ version. -/
lemma image_Ico_mod (n a : ℕ) :
  (Ico n (n+a)).image (% a) = range a :=
begin
  obtain rfl | ha := eq_or_ne a 0,
  { rw [range_zero, add_zero, Ico_self, image_empty], },
  ext i,
  simp only [mem_image, exists_prop, mem_range, mem_Ico],
  split,
  { rintro ⟨i, h, rfl⟩, exact mod_lt i ha.bot_lt },
  intro hia,
  have hn := nat.mod_add_div n a,
  obtain hi | hi := lt_or_le i (n % a),
  { refine ⟨i + a * (n/a + 1), ⟨_, _⟩, _⟩,
    { rw [add_comm (n/a), mul_add, mul_one, ← add_assoc],
      refine hn.symm.le.trans (add_le_add_right _ _),
      simpa only [zero_add] using add_le_add (zero_le i) (nat.mod_lt n ha.bot_lt).le, },
    { refine lt_of_lt_of_le (add_lt_add_right hi (a * (n/a + 1))) _,
      rw [mul_add, mul_one, ← add_assoc, hn], },
    { rw [nat.add_mul_mod_self_left, nat.mod_eq_of_lt hia], } },
  { refine ⟨i + a * (n/a), ⟨_, _⟩, _⟩,
    { exact hn.symm.le.trans (add_le_add_right hi _), },
    { rw [add_comm n a],
      refine add_lt_add_of_lt_of_le hia (le_trans _ hn.le),
      simp only [zero_le, le_add_iff_nonneg_left], },
    { rw [nat.add_mul_mod_self_left, nat.mod_eq_of_lt hia], } },
end

section multiset
open multiset

lemma multiset_Ico_map_mod (n a : ℕ) : (multiset.Ico n (n+a)).map (% a) = range a :=
begin
  convert congr_arg finset.val (image_Ico_mod n a),
  refine ((nodup_map_iff_inj_on (finset.Ico _ _).nodup).2 $ _).dedup.symm,
  exact mod_inj_on_Ico _ _,
end

end multiset

end nat

namespace finset

lemma range_image_pred_top_sub (n : ℕ) : (finset.range n).image (λ j, n - 1 - j) = finset.range n :=
begin
  cases n,
  { rw [range_zero, image_empty] },
  { rw [finset.range_eq_Ico, nat.Ico_image_const_sub_eq_Ico (zero_le _)],
    simp_rw [succ_sub_succ, tsub_zero, tsub_self] }
end

lemma range_add_eq_union : range (a + b) = range a ∪ (range b).map (add_left_embedding a) :=
begin
  rw [finset.range_eq_Ico, map_eq_image],
  convert (Ico_union_Ico_eq_Ico a.zero_le le_self_add).symm,
  exact image_add_left_Ico _ _ _,
end

end finset

section induction

variables {P : ℕ → Prop} (h : ∀ n, P (n + 1) → P n)

include h

lemma nat.decreasing_induction_of_not_bdd_above (hP : ¬ bdd_above {x | P x}) (n : ℕ) : P n :=
let ⟨m, hm, hl⟩ := not_bdd_above_iff.1 hP n in decreasing_induction h hl.le hm

lemma nat.decreasing_induction_of_infinite (hP : {x | P x}.infinite) (n : ℕ) : P n :=
nat.decreasing_induction_of_not_bdd_above h (mt bdd_above.finite hP) n

lemma nat.cauchy_induction' (seed : ℕ) (hs : P seed)
  (hi : ∀ x, seed ≤ x → P x → ∃ y, x < y ∧ P y) (n : ℕ) : P n :=
begin
  apply nat.decreasing_induction_of_infinite h (λ hf, _),
  obtain ⟨m, hP, hm⟩ := hf.exists_maximal_wrt id _ ⟨seed, hs⟩,
  obtain ⟨y, hl, hy⟩ := hi m (le_of_not_lt $ λ hl, hl.ne $ hm seed hs hl.le) hP,
  exact hl.ne (hm y hy hl.le),
end

lemma nat.cauchy_induction (seed : ℕ) (hs : P seed) (f : ℕ → ℕ)
  (hf : ∀ x, seed ≤ x → P x → x < f x ∧ P (f x)) (n : ℕ) : P n :=
seed.cauchy_induction' h hs (λ x hl hx, ⟨f x, hf x hl hx⟩) n

lemma nat.cauchy_induction_mul (k seed : ℕ) (hk : 1 < k) (hs : P seed.succ)
  (hm : ∀ x, seed < x → P x → P (k * x)) (n : ℕ) : P n :=
begin
  apply nat.cauchy_induction h _ hs ((*) k) (λ x hl hP, ⟨_, hm x hl hP⟩),
  convert (mul_lt_mul_right $ seed.succ_pos.trans_le hl).2 hk,
  rw one_mul,
end

lemma nat.cauchy_induction_two_mul (seed : ℕ) (hs : P seed.succ)
  (hm : ∀ x, seed < x → P x → P (2 * x)) (n : ℕ) : P n :=
nat.cauchy_induction_mul h 2 seed one_lt_two hs hm n

end induction