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

! This file was ported from Lean 3 source module measure_theory.function.special_functions.basic
! leanprover-community/mathlib commit 468b141b14016d54b479eb7a0fff1e360b7e3cf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Pow
import Mathbin.Data.IsROrC.Lemmas
import Mathbin.MeasureTheory.Constructions.BorelSpace

/-!
# Measurability of real and complex functions

We show that most standard real and complex functions are measurable, notably `exp`, `cos`, `sin`,
`cosh`, `sinh`, `log`, `pow`, `arcsin`, `arccos`.

See also `measure_theory.function.special_functions.arctan` and
`measure_theory.function.special_functions.inner`, which have been split off to minimize imports.
-/

noncomputable section

open NNReal ENNReal

namespace Real

@[measurability]
theorem measurable_exp : Measurable exp :=
  continuous_exp.Measurable
#align real.measurable_exp Real.measurable_exp

@[measurability]
theorem measurable_log : Measurable log :=
  measurable_of_measurable_on_compl_singleton 0 <|
    Continuous.measurable <| continuousOn_iff_continuous_restrict.1 continuousOn_log
#align real.measurable_log Real.measurable_log

@[measurability]
theorem measurable_sin : Measurable sin :=
  continuous_sin.Measurable
#align real.measurable_sin Real.measurable_sin

@[measurability]
theorem measurable_cos : Measurable cos :=
  continuous_cos.Measurable
#align real.measurable_cos Real.measurable_cos

@[measurability]
theorem measurable_sinh : Measurable sinh :=
  continuous_sinh.Measurable
#align real.measurable_sinh Real.measurable_sinh

@[measurability]
theorem measurable_cosh : Measurable cosh :=
  continuous_cosh.Measurable
#align real.measurable_cosh Real.measurable_cosh

@[measurability]
theorem measurable_arcsin : Measurable arcsin :=
  continuous_arcsin.Measurable
#align real.measurable_arcsin Real.measurable_arcsin

@[measurability]
theorem measurable_arccos : Measurable arccos :=
  continuous_arccos.Measurable
#align real.measurable_arccos Real.measurable_arccos

end Real

namespace Complex

@[measurability]
theorem measurable_re : Measurable re :=
  continuous_re.Measurable
#align complex.measurable_re Complex.measurable_re

@[measurability]
theorem measurable_im : Measurable im :=
  continuous_im.Measurable
#align complex.measurable_im Complex.measurable_im

@[measurability]
theorem measurable_of_real : Measurable (coe : ℝ → ℂ) :=
  continuous_of_real.Measurable
#align complex.measurable_of_real Complex.measurable_of_real

@[measurability]
theorem measurable_exp : Measurable exp :=
  continuous_exp.Measurable
#align complex.measurable_exp Complex.measurable_exp

@[measurability]
theorem measurable_sin : Measurable sin :=
  continuous_sin.Measurable
#align complex.measurable_sin Complex.measurable_sin

@[measurability]
theorem measurable_cos : Measurable cos :=
  continuous_cos.Measurable
#align complex.measurable_cos Complex.measurable_cos

@[measurability]
theorem measurable_sinh : Measurable sinh :=
  continuous_sinh.Measurable
#align complex.measurable_sinh Complex.measurable_sinh

@[measurability]
theorem measurable_cosh : Measurable cosh :=
  continuous_cosh.Measurable
#align complex.measurable_cosh Complex.measurable_cosh

@[measurability]
theorem measurable_arg : Measurable arg :=
  have A : Measurable fun x : ℂ => Real.arcsin (x.im / x.abs) :=
    Real.measurable_arcsin.comp (measurable_im.div measurable_norm)
  have B : Measurable fun x : ℂ => Real.arcsin ((-x).im / x.abs) :=
    Real.measurable_arcsin.comp ((measurable_im.comp measurable_neg).div measurable_norm)
  Measurable.ite (isClosed_le continuous_const continuous_re).MeasurableSet A <|
    Measurable.ite (isClosed_le continuous_const continuous_im).MeasurableSet (B.AddConst _)
      (B.sub_const _)
#align complex.measurable_arg Complex.measurable_arg

@[measurability]
theorem measurable_log : Measurable log :=
  (measurable_of_real.comp <| Real.measurable_log.comp measurable_norm).add <|
    (measurable_of_real.comp measurable_arg).mul_const I
#align complex.measurable_log Complex.measurable_log

end Complex

namespace IsROrC

variable {𝕜 : Type _} [IsROrC 𝕜]

@[measurability]
theorem measurable_re : Measurable (re : 𝕜 → ℝ) :=
  continuous_re.Measurable
#align is_R_or_C.measurable_re IsROrC.measurable_re

@[measurability]
theorem measurable_im : Measurable (im : 𝕜 → ℝ) :=
  continuous_im.Measurable
#align is_R_or_C.measurable_im IsROrC.measurable_im

end IsROrC

section RealComposition

open Real

variable {α : Type _} {m : MeasurableSpace α} {f : α → ℝ} (hf : Measurable f)

@[measurability]
theorem Measurable.exp : Measurable fun x => Real.exp (f x) :=
  Real.measurable_exp.comp hf
#align measurable.exp Measurable.exp

@[measurability]
theorem Measurable.log : Measurable fun x => log (f x) :=
  measurable_log.comp hf
#align measurable.log Measurable.log

@[measurability]
theorem Measurable.cos : Measurable fun x => Real.cos (f x) :=
  Real.measurable_cos.comp hf
#align measurable.cos Measurable.cos

@[measurability]
theorem Measurable.sin : Measurable fun x => Real.sin (f x) :=
  Real.measurable_sin.comp hf
#align measurable.sin Measurable.sin

@[measurability]
theorem Measurable.cosh : Measurable fun x => Real.cosh (f x) :=
  Real.measurable_cosh.comp hf
#align measurable.cosh Measurable.cosh

@[measurability]
theorem Measurable.sinh : Measurable fun x => Real.sinh (f x) :=
  Real.measurable_sinh.comp hf
#align measurable.sinh Measurable.sinh

@[measurability]
theorem Measurable.sqrt : Measurable fun x => sqrt (f x) :=
  continuous_sqrt.Measurable.comp hf
#align measurable.sqrt Measurable.sqrt

end RealComposition

section ComplexComposition

open Complex

variable {α : Type _} {m : MeasurableSpace α} {f : α → ℂ} (hf : Measurable f)

@[measurability]
theorem Measurable.cexp : Measurable fun x => Complex.exp (f x) :=
  Complex.measurable_exp.comp hf
#align measurable.cexp Measurable.cexp

@[measurability]
theorem Measurable.ccos : Measurable fun x => Complex.cos (f x) :=
  Complex.measurable_cos.comp hf
#align measurable.ccos Measurable.ccos

@[measurability]
theorem Measurable.csin : Measurable fun x => Complex.sin (f x) :=
  Complex.measurable_sin.comp hf
#align measurable.csin Measurable.csin

@[measurability]
theorem Measurable.ccosh : Measurable fun x => Complex.cosh (f x) :=
  Complex.measurable_cosh.comp hf
#align measurable.ccosh Measurable.ccosh

@[measurability]
theorem Measurable.csinh : Measurable fun x => Complex.sinh (f x) :=
  Complex.measurable_sinh.comp hf
#align measurable.csinh Measurable.csinh

@[measurability]
theorem Measurable.carg : Measurable fun x => arg (f x) :=
  measurable_arg.comp hf
#align measurable.carg Measurable.carg

@[measurability]
theorem Measurable.clog : Measurable fun x => log (f x) :=
  measurable_log.comp hf
#align measurable.clog Measurable.clog

end ComplexComposition

section IsROrCComposition

variable {α 𝕜 : Type _} [IsROrC 𝕜] {m : MeasurableSpace α} {f : α → 𝕜} {μ : MeasureTheory.Measure α}

include m

@[measurability]
theorem Measurable.re (hf : Measurable f) : Measurable fun x => IsROrC.re (f x) :=
  IsROrC.measurable_re.comp hf
#align measurable.re Measurable.re

@[measurability]
theorem AeMeasurable.re (hf : AeMeasurable f μ) : AeMeasurable (fun x => IsROrC.re (f x)) μ :=
  IsROrC.measurable_re.compAeMeasurable hf
#align ae_measurable.re AeMeasurable.re

@[measurability]
theorem Measurable.im (hf : Measurable f) : Measurable fun x => IsROrC.im (f x) :=
  IsROrC.measurable_im.comp hf
#align measurable.im Measurable.im

@[measurability]
theorem AeMeasurable.im (hf : AeMeasurable f μ) : AeMeasurable (fun x => IsROrC.im (f x)) μ :=
  IsROrC.measurable_im.compAeMeasurable hf
#align ae_measurable.im AeMeasurable.im

omit m

end IsROrCComposition

section

variable {α 𝕜 : Type _} [IsROrC 𝕜] [MeasurableSpace α] {f : α → 𝕜} {μ : MeasureTheory.Measure α}

@[measurability]
theorem IsROrC.measurable_of_real : Measurable (coe : ℝ → 𝕜) :=
  IsROrC.continuous_of_real.Measurable
#align is_R_or_C.measurable_of_real IsROrC.measurable_of_real

theorem measurable_of_re_im (hre : Measurable fun x => IsROrC.re (f x))
    (him : Measurable fun x => IsROrC.im (f x)) : Measurable f :=
  by
  convert(is_R_or_C.measurable_of_real.comp hre).add
      ((is_R_or_C.measurable_of_real.comp him).mul_const IsROrC.i)
  · ext1 x
    exact (IsROrC.re_add_im _).symm
  all_goals infer_instance
#align measurable_of_re_im measurable_of_re_im

theorem aeMeasurableOfReIm (hre : AeMeasurable (fun x => IsROrC.re (f x)) μ)
    (him : AeMeasurable (fun x => IsROrC.im (f x)) μ) : AeMeasurable f μ :=
  by
  convert(is_R_or_C.measurable_of_real.comp_ae_measurable hre).add
      ((is_R_or_C.measurable_of_real.comp_ae_measurable him).mul_const IsROrC.i)
  · ext1 x
    exact (IsROrC.re_add_im _).symm
  all_goals infer_instance
#align ae_measurable_of_re_im aeMeasurableOfReIm

end

section PowInstances

instance Complex.hasMeasurablePow : HasMeasurablePow ℂ ℂ :=
  ⟨Measurable.ite (measurable_fst (measurableSet_singleton 0))
      (Measurable.ite (measurable_snd (measurableSet_singleton 0)) measurable_one measurable_zero)
      (measurable_fst.clog.mul measurable_snd).cexp⟩
#align complex.has_measurable_pow Complex.hasMeasurablePow

instance Real.hasMeasurablePow : HasMeasurablePow ℝ ℝ :=
  ⟨Complex.measurable_re.comp <|
      (Complex.measurable_of_real.comp measurable_fst).pow
        (Complex.measurable_of_real.comp measurable_snd)⟩
#align real.has_measurable_pow Real.hasMeasurablePow

instance NNReal.hasMeasurablePow : HasMeasurablePow ℝ≥0 ℝ :=
  ⟨(measurable_fst.coeNNRealReal.pow measurable_snd).subtype_mk⟩
#align nnreal.has_measurable_pow NNReal.hasMeasurablePow

instance ENNReal.hasMeasurablePow : HasMeasurablePow ℝ≥0∞ ℝ :=
  by
  refine' ⟨ENNReal.measurable_of_measurable_nNReal_prod _ _⟩
  · simp_rw [ENNReal.coe_rpow_def]
    refine' Measurable.ite _ measurable_const (measurable_fst.pow measurable_snd).coe_nNReal_eNNReal
    exact
      MeasurableSet.inter (measurable_fst (measurable_set_singleton 0))
        (measurable_snd measurableSet_Iio)
  · simp_rw [ENNReal.top_rpow_def]
    refine' Measurable.ite measurableSet_Ioi measurable_const _
    exact Measurable.ite (measurable_set_singleton 0) measurable_const measurable_const
#align ennreal.has_measurable_pow ENNReal.hasMeasurablePow

end PowInstances

-- Guard against import creep:
assert_not_exists inner_product_space

assert_not_exists real.arctan


/-
Copyright (c) 2021 Yury Kudriashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudriashov, Malo Jaffré
-/
import analysis.convex.function
import tactic.field_simp
import tactic.linarith

/-!
# Slopes of convex functions

This file relates convexity/concavity of functions in a linearly ordered field and the monotonicity
of their slopes.

The main use is to show convexity/concavity from monotonicity of the derivative.
-/

variables {𝕜 : Type*} [linear_ordered_field 𝕜] {s : set 𝕜} {f : 𝕜 → 𝕜}

/-- If `f : 𝕜 → 𝕜` is convex, then for any three points `x < y < z` the slope of the secant line of
`f` on `[x, y]` is less than the slope of the secant line of `f` on `[x, z]`. -/
lemma convex_on.slope_mono_adjacent (hf : convex_on 𝕜 s f)
  {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f y - f x) / (y - x) ≤ (f z - f y) / (z - y) :=
begin
  have hxz := hxy.trans hyz,
  rw ←sub_pos at hxy hxz hyz,
  suffices : f y / (y - x) + f y / (z - y) ≤ f x / (y - x) + f z / (z - y),
  { ring_nf at this ⊢, linarith },
  set a := (z - y) / (z - x),
  set b := (y - x) / (z - x),
  have hy : a • x + b • z = y, by { field_simp, rw div_eq_iff; [ring, linarith] },
  have key, from
    hf.2 hx hz
      (show 0 ≤ a, by apply div_nonneg; linarith)
      (show 0 ≤ b, by apply div_nonneg; linarith)
      (show a + b = 1, by { field_simp, rw div_eq_iff; [ring, linarith] }),
  rw hy at key,
  replace key := mul_le_mul_of_nonneg_left key hxz.le,
  field_simp [hxy.ne', hyz.ne', hxz.ne', mul_comm (z - x) _] at key ⊢,
  rw div_le_div_right,
  { linarith },
  { nlinarith }
end

/-- If `f : 𝕜 → 𝕜` is concave, then for any three points `x < y < z` the slope of the secant line of
`f` on `[x, y]` is greater than the slope of the secant line of `f` on `[x, z]`. -/
lemma concave_on.slope_anti_adjacent (hf : concave_on 𝕜 s f) {x y z : 𝕜} (hx : x ∈ s)
  (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f z - f y) / (z - y) ≤ (f y - f x) / (y - x) :=
begin
  rw [←neg_le_neg_iff, ←neg_sub_neg (f x), ←neg_sub_neg (f y)],
  simp_rw [←pi.neg_apply, ←neg_div, neg_sub],
  exact convex_on.slope_mono_adjacent hf.neg hx hz hxy hyz,
end

/-- If `f : 𝕜 → 𝕜` is strictly convex, then for any three points `x < y < z` the slope of the
secant line of `f` on `[x, y]` is strictly less than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_convex_on.slope_strict_mono_adjacent (hf : strict_convex_on 𝕜 s f)
  {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f y - f x) / (y - x) < (f z - f y) / (z - y) :=
begin
  have hxz := hxy.trans hyz,
  have hxz' := hxz.ne,
  rw ←sub_pos at hxy hxz hyz,
  suffices : f y / (y - x) + f y / (z - y) < f x / (y - x) + f z / (z - y),
  { ring_nf at this ⊢, linarith },
  set a := (z - y) / (z - x),
  set b := (y - x) / (z - x),
  have hy : a • x + b • z = y, by { field_simp, rw div_eq_iff; [ring, linarith] },
  have key, from
    hf.2 hx hz hxz' (div_pos hyz hxz) (div_pos hxy hxz)
      (show a + b = 1, by { field_simp, rw div_eq_iff; [ring, linarith] }),
  rw hy at key,
  replace key := mul_lt_mul_of_pos_left key hxz,
  field_simp [hxy.ne', hyz.ne', hxz.ne', mul_comm (z - x) _] at key ⊢,
  rw div_lt_div_right,
  { linarith },
  { nlinarith }
end

/-- If `f : 𝕜 → 𝕜` is strictly concave, then for any three points `x < y < z` the slope of the
secant line of `f` on `[x, y]` is strictly greater than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_concave_on.slope_anti_adjacent (hf : strict_concave_on 𝕜 s f)
  {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) :
  (f z - f y) / (z - y) < (f y - f x) / (y - x) :=
begin
  rw [←neg_lt_neg_iff, ←neg_sub_neg (f x), ←neg_sub_neg (f y)],
  simp_rw [←pi.neg_apply, ←neg_div, neg_sub],
  exact strict_convex_on.slope_strict_mono_adjacent hf.neg hx hz hxy hyz,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
less than the slope of the secant line of `f` on `[x, z]`, then `f` is convex. -/
lemma convex_on_of_slope_mono_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f y - f x) / (y - x) ≤ (f z - f y) / (z - y)) :
  convex_on 𝕜 s f :=
linear_order.convex_on_of_lt hs $ λ x hx z hz hxz a b ha hb hab,
begin
  let y := a * x + b * z,
  have hxy : x < y,
  { rw [← one_mul x, ← hab, add_mul],
    exact add_lt_add_left ((mul_lt_mul_left hb).2 hxz) _ },
  have hyz : y < z,
  { rw [← one_mul z, ← hab, add_mul],
    exact add_lt_add_right ((mul_lt_mul_left ha).2 hxz) _ },
  have : (f y - f x) * (z - y) ≤ (f z - f y) * (y - x),
    from (div_le_div_iff (sub_pos.2 hxy) (sub_pos.2 hyz)).1 (hf hx hz hxy hyz),
  have hxz : 0 < z - x, from sub_pos.2 (hxy.trans hyz),
  have ha : (z - y) / (z - x) = a,
  { rw [eq_comm, ← sub_eq_iff_eq_add'] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  have hb : (y - x) / (z - x) = b,
  { rw [eq_comm, ← sub_eq_iff_eq_add] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  rwa [sub_mul, sub_mul, sub_le_iff_le_add', ← add_sub_assoc, le_sub_iff_add_le, ← mul_add,
    sub_add_sub_cancel, ← le_div_iff hxz, add_div, mul_div_assoc, mul_div_assoc, mul_comm (f x),
    mul_comm (f z), ha, hb] at this,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
greater than the slope of the secant line of `f` on `[x, z]`, then `f` is concave. -/
lemma concave_on_of_slope_anti_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f z - f y) / (z - y) ≤ (f y - f x) / (y - x)) : concave_on 𝕜 s f :=
begin
  rw ←neg_convex_on_iff,
  refine convex_on_of_slope_mono_adjacent hs (λ x y z hx hz hxy hyz, _),
  rw ←neg_le_neg_iff,
  simp_rw [←neg_div, neg_sub, pi.neg_apply, neg_sub_neg],
  exact hf hx hz hxy hyz,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
strictly less than the slope of the secant line of `f` on `[x, z]`, then `f` is strictly convex. -/
lemma strict_convex_on_of_slope_strict_mono_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f y - f x) / (y - x) < (f z - f y) / (z - y)) :
  strict_convex_on 𝕜 s f :=
linear_order.strict_convex_on_of_lt hs $ λ x hx z hz hxz a b ha hb hab,
begin
  let y := a * x + b * z,
  have hxy : x < y,
  { rw [← one_mul x, ← hab, add_mul],
    exact add_lt_add_left ((mul_lt_mul_left hb).2 hxz) _ },
  have hyz : y < z,
  { rw [← one_mul z, ← hab, add_mul],
    exact add_lt_add_right ((mul_lt_mul_left ha).2 hxz) _ },
  have : (f y - f x) * (z - y) < (f z - f y) * (y - x),
    from (div_lt_div_iff (sub_pos.2 hxy) (sub_pos.2 hyz)).1 (hf hx hz hxy hyz),
  have hxz : 0 < z - x, from sub_pos.2 (hxy.trans hyz),
  have ha : (z - y) / (z - x) = a,
  { rw [eq_comm, ← sub_eq_iff_eq_add'] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  have hb : (y - x) / (z - x) = b,
  { rw [eq_comm, ← sub_eq_iff_eq_add] at hab,
    simp_rw [div_eq_iff hxz.ne', y, ←hab], ring },
  rwa [sub_mul, sub_mul, sub_lt_iff_lt_add', ← add_sub_assoc, lt_sub_iff_add_lt, ← mul_add,
    sub_add_sub_cancel, ← lt_div_iff hxz, add_div, mul_div_assoc, mul_div_assoc, mul_comm (f x),
    mul_comm (f z), ha, hb] at this,
end

/-- If for any three points `x < y < z`, the slope of the secant line of `f : 𝕜 → 𝕜` on `[x, y]` is
strictly greater than the slope of the secant line of `f` on `[x, z]`, then `f` is strictly concave.
-/
lemma strict_concave_on_of_slope_strict_anti_adjacent (hs : convex 𝕜 s)
  (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z →
    (f z - f y) / (z - y) < (f y - f x) / (y - x)) : strict_concave_on 𝕜 s f :=
begin
  rw ←neg_strict_convex_on_iff,
  refine strict_convex_on_of_slope_strict_mono_adjacent hs (λ x y z hx hz hxy hyz, _),
  rw ←neg_lt_neg_iff,
  simp_rw [←neg_div, neg_sub, pi.neg_apply, neg_sub_neg],
  exact hf hx hz hxy hyz,
end

/-- A function `f : 𝕜 → 𝕜` is convex iff for any three points `x < y < z` the slope of the secant
line of `f` on `[x, y]` is less than the slope of the secant line of `f` on `[x, z]`. -/
lemma convex_on_iff_slope_mono_adjacent :
  convex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f y - f x) / (y - x) ≤ (f z - f y) / (z - y) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_mono_adjacent⟩, λ h, convex_on_of_slope_mono_adjacent h.1 h.2⟩

/-- A function `f : 𝕜 → 𝕜` is concave iff for any three points `x < y < z` the slope of the secant
line of `f` on `[x, y]` is greater than the slope of the secant line of `f` on `[x, z]`. -/
lemma concave_on_iff_slope_anti_adjacent :
  concave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f z - f y) / (z - y) ≤ (f y - f x) / (y - x) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_anti_adjacent⟩, λ h, concave_on_of_slope_anti_adjacent h.1 h.2⟩

/-- A function `f : 𝕜 → 𝕜` is strictly convex iff for any three points `x < y < z` the slope of
the secant line of `f` on `[x, y]` is strictly less than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_convex_on_iff_slope_strict_mono_adjacent :
  strict_convex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f y - f x) / (y - x) < (f z - f y) / (z - y) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_strict_mono_adjacent⟩,
  λ h, strict_convex_on_of_slope_strict_mono_adjacent h.1 h.2⟩

/-- A function `f : 𝕜 → 𝕜` is strictly concave iff for any three points `x < y < z` the slope of
the secant line of `f` on `[x, y]` is strictly greater than the slope of the secant line of `f` on
`[x, z]`. -/
lemma strict_concave_on_iff_slope_strict_anti_adjacent :
  strict_concave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y z : 𝕜⦄, x ∈ s → z ∈ s → x < y → y < z →
      (f z - f y) / (z - y) < (f y - f x) / (y - x) :=
⟨λ h, ⟨h.1, λ x y z, h.slope_anti_adjacent⟩,
  λ h, strict_concave_on_of_slope_strict_anti_adjacent h.1 h.2⟩

/-- If `f` is convex on a set `s` in a linearly ordered field, and `f x < f y` for two points
`x < y` in `s`, then `f` is strictly monotone on `s ∩ [y, ∞)`. -/
lemma convex_on.strict_mono_of_lt (hf : convex_on 𝕜 s f)
  {x y : 𝕜} (hx : x ∈ s) (hxy : x < y) (hxy' : f x < f y) :
  strict_mono_on f (s ∩ set.Ici y) :=
begin
  intros u hu v hv huv,
  have step1 : ∀ {z : 𝕜}, z ∈ s ∩ set.Ioi y → f y < f z,
  { refine λ z hz, hf.lt_right_of_left_lt hx hz.1 _ hxy',
    rw open_segment_eq_Ioo (hxy.trans hz.2),
    exact ⟨hxy, hz.2⟩ },
  rcases eq_or_lt_of_le hu.2 with rfl | hu2,
  { exact step1 ⟨hv.1, huv⟩ },
  { refine hf.lt_right_of_left_lt _ hv.1 _ (step1 ⟨hu.1, hu2⟩),
    { apply hf.1.segment_subset hx hu.1,
      rw segment_eq_Icc (hxy.le.trans hu.2),
      exact ⟨hxy.le, hu.2⟩ },
    { rw open_segment_eq_Ioo (hu2.trans huv),
      exact ⟨hu2, huv⟩ } },
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.set.intervals.basic
import data.set.lattice

/-!
# Intervals in `pi`-space

In this we prove various simple lemmas about intervals in `Π i, α i`. Closed intervals (`Ici x`,
`Iic x`, `Icc x y`) are equal to products of their projections to `α i`, while (semi-)open intervals
usually include the corresponding products as proper subsets.
-/

variables {ι : Type*} {α : ι → Type*}

namespace set

section pi_preorder

variables [Π i, preorder (α i)] (x y : Π i, α i)

@[simp] lemma pi_univ_Ici : pi univ (λ i, Ici (x i)) = Ici x :=
ext $ λ y, by simp [pi.le_def]

@[simp] lemma pi_univ_Iic : pi univ (λ i, Iic (x i)) = Iic x :=
ext $ λ y, by simp [pi.le_def]

@[simp] lemma pi_univ_Icc : pi univ (λ i, Icc (x i) (y i)) = Icc x y :=
ext $ λ y, by simp [pi.le_def, forall_and_distrib]

lemma piecewise_mem_Icc {s : set ι} [Π j, decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : Π i, α i}
  (h₁ : ∀ i ∈ s, f₁ i ∈ Icc (g₁ i) (g₂ i)) (h₂ : ∀ i ∉ s, f₂ i ∈ Icc (g₁ i) (g₂ i)) :
  s.piecewise f₁ f₂ ∈ Icc g₁ g₂ :=
⟨le_piecewise (λ i hi, (h₁ i hi).1) (λ i hi, (h₂ i hi).1),
  piecewise_le (λ i hi, (h₁ i hi).2) (λ i hi, (h₂ i hi).2)⟩

lemma piecewise_mem_Icc' {s : set ι} [Π j, decidable (j ∈ s)] {f₁ f₂ g₁ g₂ : Π i, α i}
  (h₁ : f₁ ∈ Icc g₁ g₂) (h₂ : f₂ ∈ Icc g₁ g₂) :
  s.piecewise f₁ f₂ ∈ Icc g₁ g₂ :=
piecewise_mem_Icc (λ i hi, ⟨h₁.1 _, h₁.2 _⟩) (λ i hi, ⟨h₂.1 _, h₂.2 _⟩)

section nonempty

variable [nonempty ι]

lemma pi_univ_Ioi_subset : pi univ (λ i, Ioi (x i)) ⊆ Ioi x :=
λ z hz, ⟨λ i, le_of_lt $ hz i trivial,
  λ h, nonempty.elim ‹nonempty ι› $ λ i, (h i).not_lt (hz i trivial)⟩

lemma pi_univ_Iio_subset : pi univ (λ i, Iio (x i)) ⊆ Iio x :=
@pi_univ_Ioi_subset ι (λ i, (α i)ᵒᵈ) _ x _

lemma pi_univ_Ioo_subset : pi univ (λ i, Ioo (x i) (y i)) ⊆ Ioo x y :=
λ x hx, ⟨pi_univ_Ioi_subset _ $ λ i hi, (hx i hi).1, pi_univ_Iio_subset _ $ λ i hi, (hx i hi).2⟩

lemma pi_univ_Ioc_subset : pi univ (λ i, Ioc (x i) (y i)) ⊆ Ioc x y :=
λ x hx, ⟨pi_univ_Ioi_subset _ $ λ i hi, (hx i hi).1, λ i, (hx i trivial).2⟩

lemma pi_univ_Ico_subset : pi univ (λ i, Ico (x i) (y i)) ⊆ Ico x y :=
λ x hx, ⟨λ i, (hx i trivial).1, pi_univ_Iio_subset _ $ λ i hi, (hx i hi).2⟩

end nonempty

variable [decidable_eq ι]

open function (update)

lemma pi_univ_Ioc_update_left {x y : Π i, α i} {i₀ : ι} {m : α i₀} (hm : x i₀ ≤ m) :
  pi univ (λ i, Ioc (update x i₀ m i) (y i)) = {z | m < z i₀} ∩ pi univ (λ i, Ioc (x i) (y i)) :=
begin
  have : Ioc m (y i₀) = Ioi m ∩ Ioc (x i₀) (y i₀),
    by rw [← Ioi_inter_Iic, ← Ioi_inter_Iic, ← inter_assoc,
      inter_eq_self_of_subset_left (Ioi_subset_Ioi hm)],
  simp_rw [univ_pi_update i₀ _ _ (λ i z, Ioc z (y i)), ← pi_inter_compl ({i₀} : set ι),
    singleton_pi', ← inter_assoc, this],
  refl
end

lemma pi_univ_Ioc_update_right {x y : Π i, α i} {i₀ : ι} {m : α i₀} (hm : m ≤ y i₀) :
  pi univ (λ i, Ioc (x i) (update y i₀ m i)) = {z | z i₀ ≤ m} ∩ pi univ (λ i, Ioc (x i) (y i)) :=
begin
  have : Ioc (x i₀) m = Iic m ∩ Ioc (x i₀) (y i₀),
    by rw [← Ioi_inter_Iic, ← Ioi_inter_Iic, inter_left_comm,
      inter_eq_self_of_subset_left (Iic_subset_Iic.2 hm)],
  simp_rw [univ_pi_update i₀ y m (λ i z, Ioc (x i) z), ← pi_inter_compl ({i₀} : set ι),
    singleton_pi', ← inter_assoc, this],
  refl
end

lemma disjoint_pi_univ_Ioc_update_left_right {x y : Π i, α i} {i₀ : ι} {m : α i₀} :
  disjoint (pi univ (λ i, Ioc (x i) (update y i₀ m i)))
    (pi univ (λ i, Ioc (update x i₀ m i) (y i))) :=
begin
  rintro z ⟨h₁, h₂⟩,
  refine (h₁ i₀ (mem_univ _)).2.not_lt _,
  simpa only [function.update_same] using (h₂ i₀ (mem_univ _)).1
end

end pi_preorder

variables [decidable_eq ι] [Π i, linear_order (α i)]

open function (update)

lemma pi_univ_Ioc_update_union (x y : Π i, α i) (i₀ : ι) (m : α i₀) (hm : m ∈ Icc (x i₀) (y i₀)) :
  pi univ (λ i, Ioc (x i) (update y i₀ m i)) ∪ pi univ (λ i, Ioc (update x i₀ m i) (y i)) =
    pi univ (λ i, Ioc (x i) (y i)) :=
by simp_rw [pi_univ_Ioc_update_left hm.1, pi_univ_Ioc_update_right hm.2,
  ← union_inter_distrib_right, ← set_of_or, le_or_lt, set_of_true, univ_inter]

/-- If `x`, `y`, `x'`, and `y'` are functions `Π i : ι, α i`, then
the set difference between the box `[x, y]` and the product of the open intervals `(x' i, y' i)`
is covered by the union of the following boxes: for each `i : ι`, we take
`[x, update y i (x' i)]` and `[update x i (y' i), y]`.

E.g., if `x' = x` and `y' = y`, then this lemma states that the difference between a closed box
`[x, y]` and the corresponding open box `{z | ∀ i, x i < z i < y i}` is covered by the union
of the faces of `[x, y]`. -/
lemma Icc_diff_pi_univ_Ioo_subset (x y x' y' : Π i, α i) :
  Icc x y \ pi univ (λ i, Ioo (x' i) (y' i)) ⊆
    (⋃ i : ι, Icc x (update y i (x' i))) ∪ ⋃ i : ι, Icc (update x i (y' i)) y :=
begin
  rintros a ⟨⟨hxa, hay⟩, ha'⟩,
  simpa [le_update_iff, update_le_iff, hxa, hay, hxa _, hay _, ← exists_or_distrib,
    not_and_distrib] using ha'
end

/-- If `x`, `y`, `z` are functions `Π i : ι, α i`, then
the set difference between the box `[x, z]` and the product of the intervals `(y i, z i]`
is covered by the union of the boxes `[x, update z i (y i)]`.

E.g., if `x = y`, then this lemma states that the difference between a closed box
`[x, y]` and the product of half-open intervals `{z | ∀ i, x i < z i ≤ y i}` is covered by the union
of the faces of `[x, y]` adjacent to `x`. -/
lemma Icc_diff_pi_univ_Ioc_subset (x y z : Π i, α i) :
  Icc x z \ pi univ (λ i, Ioc (y i) (z i)) ⊆ ⋃ i : ι, Icc x (update z i (y i)) :=
begin
  rintros a ⟨⟨hax, haz⟩, hay⟩,
  simpa [not_and_distrib, hax, le_update_iff, haz _] using hay
end

end set


/-
If P is a proposition, then so is ¬P.
We judge ¬P to be true when P is false:
when there is no proof of it at all.
-/

#check not

/-
def not (a : Prop) := a → false
prefix `¬` := not
-/

lemma not_false' : ¬ false := λ f, f

/-
For any proposition, P, to prove ¬P,
assume that P is true and show that
that leads to a contradiction (in the
form of a proof of false). This is
called "proof by negation." Remember:
¬P means P → false.
-/

-- neg elimination is not constructively valid

theorem neg_elim : ∀ (P : Prop), ¬(¬P) → P :=
λ P h, _  -- have proof of this "(P → false) → false", how to get to a proof of P?

-- not constructively valid
-- law excluded middle

/-
  P
¬ P → false
¬ (¬ P) → P   -- negation elimination
              -- aka double negation elimination
-/

/-
¬ P means (is defined as) P → false
-/

#check false

axiom P : Prop
axiom func : P → false
/-
This proves ¬P!
This is a definition: ¬P means P → false
-/

#check not

#check string.length
#check (string.length "hello")

-- impossibility elimination
example : ¬ 1 = 0 :=
λ h,
  match h with
  -- secret sauce: there are no cases
  end

example : ¬ 1 = 0 :=  -- 1=0 → false
begin
  assume h,           -- assume 1=0
                      -- show false in all cases
                      -- but there are no cases
                      -- so that is all of them
  cases h,
end

/-
Contradictions are impossible.
-/
lemma no_contra : ¬ (P ∧ ¬ P) :=
λ h,
  (h.right h.left)

/-
Nonsense implies nonsense.
-/
example : 1 = 0 → 2 = 3 :=
begin
  assume h,
  cases h,
end


/-
This file is intended for Lean beginners. The goal is to demonstrate what it feels like to prove
things using Lean and mathlib. Complicated definitions and theory building are not covered.
Everything is covered again more slowly and with exercises in the next files.
-/

-- We want real numbers and their basic properties
import data.real.basic

-- We want to be able to use Lean's built-in "help" functionality
import tactic.suggest

-- We want to be able to define functions using the law of excluded middle
noncomputable theory
open_locale classical

/-
Our first goal is to define the set of upper bounds of a set of real numbers.
This is already defined in mathlib (in a more general context), but we repeat
it for the sake of exposition. Right-click "upper_bounds" below to get offered
to jump to mathlib's version
-/
#check upper_bounds

/-- The set of upper bounds of a set of real numbers ℝ -/
def up_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, a ≤ x}

/-- Predicate `is_max a A` means `a` is a maximum of `A` -/
def is_max (a : ℝ) (A : set ℝ) := a ∈ A ∧ a ∈ up_bounds A

/-
In the above definition, the symbol `∧` means "and". We also see the most
visible difference between set theoretic foundations and type theoretic ones
(used by almost all proof assistants). In set theory, everything is a set, and the
only relation you get from foundations are `=` and `∈`. In type theory, there is
a meta-theoretic relation of "typing": `a : ℝ` reads "`a` is a real number" or,
more precisely, "the type of `a` is `ℝ`". Here "meta-theoretic" means this is not a
statement you can prove or disprove inside the theory, it's a fact that is true or
not. Here we impose this fact, in other circumstances, it would be checked by the
Lean kernel.
By contrast, `a ∈ A` is a statement inside the theory. Here it's part of the
definition, in other circumstances it could be something proven inside Lean.
-/

/- For illustrative purposes, we now define an infix version of the above predicate.
It will allow us to write `a is_a_max_of A`, which is closer to a sentence.
-/
infix ` is_a_max_of `:55 := is_max

/-
Let's prove something now! A set of real numbers has at most one maximum. Here
everything left of the final `:` is introducing the objects and assumption. The equality
`x = y` right of the colon is the conclusion.
-/
lemma unique_max (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
begin
  -- We first break our assumptions in their two constituent pieces.
  -- We are free to choose the name following `with`
  cases hx with x_in x_up,
  cases hy with y_in y_up,
  -- Assumption `x_up` means x isn't less than elements of A, let's apply this to y
  specialize x_up y,
  -- Assumption `x_up` now needs the information that `y` is indeed in `A`.
  specialize x_up y_in,
  -- Let's do this quicker with roles swapped
  specialize y_up x x_in,
  -- We explained to Lean the idea of this proof.
  -- Now we know `x ≤ y` and `y ≤ x`, and Lean shouldn't need more help.
  -- `linarith` proves equalities and inequalities that follow linearly from
  -- the assumption we have.
  linarith,
end

/-
The above proof is too long, even if you remove comments. We don't really need the
unpacking steps at the beginning; we can access both parts of the assumption
`hx : x is_a_max_of A` using shortcuts `h.1` and `h.2`. We can also improve
readability without assistance from the tactic state display, clearly announcing
intermediate goals using `have`. This way we get to the following version of the
same proof.
-/

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
begin
  have : x ≤ y, from hy.2 x hx.1,
  have : y ≤ x, from hx.2 y hy.1,
  linarith,
end

/-
Notice how mathematics based on type theory treats the assumption
`∀ a ∈ A, a ≤ y` as a function turning an element `a` of `A` into the statement
`a ≤ y`. More precisely, this assumption is the abbreviation of
`∀ a : ℝ, a ∈ A → a ≤ y`. The expression `hy.2 x` appearing in the above proof
is then the statement `x ∈ A → x ≤ y`, which itself is a function turning a
statement `x ∈ A` into `x ≤ y` so that the full expression `hy.2 x hx.1` is
indeed a proof of `x ≤ y`.

One could argue a three-line-long proof of this lemma is still two lines too long.
This is debatable, but mathlib's style is to write very short proofs for trivial
lemmas. Those proofs are not easy to read but they are meant to indicate that the
proof is probably not worth reading.

In order to reach this stage, we need to know what `linarith` did for us. It invoked
the lemma `le_antisymm` which says: `x ≤ y → y ≤ x → x = y`. This arrow, which
is used both for function and implication, is right associative. So the statement is
`x ≤ y → (y ≤ x → x = y)` which reads: I will send a proof `p` of `x ≤ y` to a function
sending a proof `q'` of `y ≤ x` to a proof of `x = y`. Hence `le_antisymm p q'` is a
proof of `x = y`.

Using this we can get our one-line proof:
-/

example (A : set ℝ) (x y : ℝ) (hx : x is_a_max_of A) (hy : y is_a_max_of A) : x = y :=
le_antisymm (hy.2 x hx.1) (hx.2 y hy.1)

/-
Such a proof is called a proof term (or a "term mode" proof). Notice it has no `begin`
and `end`. It is directly the kind of low level proof that the Lean kernel is
consuming. Commands like `cases`, `specialize` or `linarith` are called tactics, they
help users constructing proof terms that could be very tedious to write directly.
The most efficient proof style combines tactics with proof terms like our previous
`have : x ≤ y, from hy.2 x hx.1` where `hy.2 x hx.1` is a proof term embeded inside
a tactic mode proof.

In the remaining of this file, we'll be characterizing infima of sets of real numbers
in term of sequences.
-/

/-- The set of lower bounds of a set of real numbers ℝ -/
def low_bounds (A : set ℝ) := { x : ℝ | ∀ a ∈ A, x ≤ a}

/-
We now define `a` is an infimum of `A`. Again there is already a more general version
in mathlib.
-/
def is_inf (x : ℝ) (A : set ℝ) := x is_a_max_of (low_bounds A)
infix ` is_an_inf_of `:55 := is_inf

/-
We need to prove that any number which is greater than the infimum of A is greater
than some element of A.
-/

lemma inf_lt {A : set ℝ} {x : ℝ} (hx : x is_an_inf_of A) :
  ∀ y, x < y → ∃ a ∈ A, a < y :=
begin
  -- Let `y` be any real number.
  intro y,
  -- Let's prove the contrapositive
  contrapose,
  -- The symbol `¬` means negation. Let's ask Lean to rewrite the goal without negation,
  -- pushing negation through quantifiers and inequalities
  push_neg,
  -- Let's assume the premise, calling the assumption `h`
  intro h,
  -- `h` is exactly saying `y` is a lower bound of `A` so the second part of
  -- the infimum assumption `hx` applied to `y` and `h` is exactly what we want.
  exact hx.2 y h
end

/-
In the above proof, the sequence `contrapose, push_neg` is so common that it can be
abbreviated to `contrapose!`. With these commands, we enter the gray zone between
proof checking and proof finding. Practical computer proof checking crucially needs
the computer to handle tedious proof steps. In the next proof, we'll start using
`linarith` a bit more seriously, going one step further into automation.

Our next real goal is to prove inequalities for limits of sequences. We extract the
following lemma: if `y ≤ x + ε` for all positive `ε` then `y ≤ x`.
-/

lemma le_of_le_add_eps {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  -- Let's prove the contrapositive, asking Lean to push negations right away.
  contrapose!,
  -- Assume `h : x < y`.
  intro h,
  -- We need to find `ε` such that `ε` is positive and `x + ε < y`.
  -- Let's use `(y-x)/2`
  use ((y-x)/2),
  -- we now have two properties to prove. Let's do both in turn, using `linarith`
  split,
  linarith,
  linarith,
end

/-
Note how `linarith` was used for both sub-goals at the end of the above proof.
We could have shortened that using the semi-colon combinator instead of comma,
writing `split ; linarith`.

Next we will study a compressed version of that proof:
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  exact assume h, ⟨(y-x)/2, by linarith, by linarith⟩,
end

/-
The angle brackets `⟨` and `⟩` introduce compound data or proofs. A proof
of a `∃ z, P z` statemement is composed of a witness `z₀` and a proof `h` of
`P z₀`. The compound is denoted by `⟨z₀, h⟩`. In the example above, the predicate is
itself compound, it is a conjunction `P z ∧ Q z`. So the proof term should read
`⟨z₀, ⟨h₁, h₂⟩⟩` where `h₁` (resp. `h₂`) is a proof of `P z₀` (resp. `Q z₀`).
But these so-called "anonymous constructor" brackets are right-associative, so we can
get rid of the nested brackets.

The keyword `by` introduces tactic mode inside term mode, it is a shorter version
of the `begin`/`end` pair, which is more convenient for single tactic blocks.
In this example, `begin` enters tactic mode, `exact` leaves it, `by` re-enters it.

Going all the way to a proof term would make the proof much longer, because we
crucially use automation with `contrapose!` and `linarith`. We can still get a one-line
proof using curly braces to gather several tactic invocations, and the `by` abbreviation
instead of `begin`/`end`:
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
by { contrapose!, exact assume h, ⟨(y-x)/2, by linarith, by linarith⟩ }

/-
One could argue that the above proof is a bit too terse, and we are relying too much
on linarith. Let's have more `linarith` calls for smaller steps. For the sake
of (tiny) variation, we will also assume the premise and argue by contradiction
instead of contraposing.
-/

example {x y : ℝ} : (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  intro h,
  -- Assume the conclusion is false, and call this assumption H.
  by_contradiction H,
  push_neg at H,
  -- Now let's compute.
  have key := calc
  -- Each line must end with a colon followed by a proof term
  -- We want to specialize our assumption `h` to `ε = (y-x)/2` but this is long to
  -- type, so let's put a hole `_` that Lean will fill in by comparing the
  -- statement we want to prove and our proof term with a hole. As usual,
  -- positivity of `(y-x)/2` is proved by `linarith`
    y   ≤ x + (y-x)/2 : h _ (by linarith)
    ... = x/2 + y/2   : by ring
    ... < y           : by linarith,
  -- our key now says `y < y` (notice how the sequence `≤`, `=`, `<` was correctly
  -- merged into a `<`). Let `linarith` find the desired contradiction now.
  linarith,
  -- alternatively, we could have provided the proof term
  -- `exact lt_irrefl y key`
end

/-
Now we are ready for some analysis. Let's set up notation for absolute value
-/

local notation `|`x`|` := abs x

/-
And let's define convergence of sequences of real numbers (of course there is
a much more general definition in mathlib).
-/

/-- The sequence `u` tends to `l` -/
def limit (u : ℕ → ℝ) (l : ℝ) := ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

/-
In the above definition, `u n` denotes the n-th term of the sequence. We can
add parentheses to get `u(n)` but we try to avoid parentheses because they pile up
very quickly
-/

-- If y ≤ u n for all n and u n goes to x then y ≤ x
lemma le_lim {x y : ℝ} {u : ℕ → ℝ} (hu : limit u x) (ineq : ∀ n, y ≤ u n) : y ≤ x :=
begin
  -- Let's apply our previous lemma
  apply le_of_le_add_eps,
  -- We need to prove y ≤ x + ε for all positive ε.
  -- Let ε be any positive real
  intros ε ε_pos,
  -- we now specialize our limit assumption to this `ε`, and immediately
  -- fix a `N` as promised by the definition.
  cases hu ε ε_pos with N HN,
  -- Now we only need to compute until reaching the conclusion
  calc
  y ≤ u N             : ineq N
  ... = x + (u N - x) : by linarith
    -- We'll need `add_le_add` which says `a ≤ b` and `c ≤ d` implies `a + c ≤ b + d`
    -- We need a lemma saying `z ≤ |z|`. Because we don't know the name of this lemma,
    -- let's use `library_search`. Because searching thourgh the library is slow,
    -- Lean will write what it found in the Lean message window when cursor is on
    -- that line, so that we can replace it by the lemma. We see `le_max_self`, which
    -- says `a ≤ |a|`, exactly what we're looking for.
  ... ≤ x + |u N - x| : add_le_add (by linarith) (le_abs_self (u N - x))
  ... ≤ x + ε         : add_le_add (by linarith) (HN N (by linarith)),
end

/-
The next lemma has been extracted from the main proof in order to discuss numbers.
In ordinary maths, we know that ℕ is *not* contained in `ℝ`, whatever the
construction of real numbers that we use. For instance a natural number is not
an equivalence class of Cauchy sequences. But it's very easy to
pretend otherwise. Formal maths requires slightly more care. In the statement below,
the "type ascription" `(n + 1 : ℝ)` forces Lean to convert the natural number
`n+1` into a real number.  The "inclusion" map will be displayed in tactic state
as `↑`. There are various lemmas asserting this map is compatible with addition and
monotone, but we don't want to bother writing their names. The `norm_cast`
tactic is designed to wisely apply those lemmas for us.
-/

lemma inv_succ_pos : ∀ n : ℕ, 1/(n+1 : ℝ) > 0 :=
begin
  -- Let `n` be any integer
  intro n,
  -- Since we don't know the name of the relevant lemma, asserting that the inverse of
  -- a positive number is positive, let's state that is suffices
  -- to prove that `n+1`, seen as a real number, is positive, and ask `library_search`
  suffices : (n + 1 : ℝ) > 0,
  { library_search },
  -- Now we want to reduce to a statement about natural numbers, not real numbers
  -- coming from natural numbers.
  norm_cast,
  -- and then get the usual help from `linarith`
  linarith,
end

/-
That was a pretty long proof for an obvious fact. And stating it as a lemma feels
stupid, so let's find a way to write it on one line in case we want to include it
in some other proof without stating a lemma. First the `library_search` call
above displays the name of the relevant lemma: `one_div_pos`. We can also
replace the `linarith` call on the last line by `library_search` to learn the name
of the lemma `nat.succ_pos` asserting that the successor of a natural number is
positive. There is also a variant on `norm_cast` that combines it with `exact`.
The term mode analogue of `intro` is `λ`. We get down to:
-/

example : ∀ n : ℕ, 1/(n+1 : ℝ) > 0 :=
λ n, one_div_pos.mpr (by exact_mod_cast nat.succ_pos n)

/-
The next proof uses mostly known things, so we will commment only new aspects.
-/

lemma limit_inv_succ : ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  intros ε ε_pos,
  suffices : ∃ N : ℕ, 1/ε ≤ N,
  { -- Because we didn't provide a name for the above statement, Lean called it `this`.
    -- Let's fix an `N` that works.
    cases this with N HN,
    use N,
    intros n Hn,
    -- Now we want to rewrite the goal using lemmas
    -- `div_le_iff' : 0 < b →  (a / b ≤ c ↔ a ≤ b * c)`
    -- `div_le_iff : 0 < b →  (a / b ≤ c ↔ a ≤ c * b)`
    -- the second one will be rewritten from right to left, as indicated by `←`.
    -- Lean will create a side goal for the required positivity assumption that
    -- we don't provide for `div_le_iff'`.
    rw [div_le_iff', ← div_le_iff ε_pos],
    -- We want to replace assumption `Hn` by its real counter-part so that
    -- linarith can find what it needs.
    replace Hn : (N : ℝ) ≤ n, exact_mod_cast Hn,
    linarith,
    -- we are still left with the positivity assumption, but already discussed
    -- how to prove it in the preceding lemma
    exact_mod_cast nat.succ_pos n },
  -- Now we need to prove that sufficient statement.
  -- We want to use that `ℝ` is archimedean. So we start typing
  -- `exact archimedean_` and hit Ctrl-space to see what completion Lean proposes
  -- the lemma `archimedean_iff_nat_le` sounds promising. We select the left to
  -- right implication using `.1`. This a generic lemma for fields equiped with
  -- a linear (ie total) order. We need to provide a proof that `ℝ` is indeed
  -- archimedean. This is done using the `apply_instance` tactic that will be
  -- covered elsewhere.
  exact archimedean_iff_nat_le.1 (by apply_instance) (1/ε),
end

/-
We can now put all pieces together, with almost no new things to explain.
-/

lemma inf_seq (A : set ℝ) (x : ℝ) :
  (x is_an_inf_of A) ↔ (x ∈ low_bounds A ∧ ∃ u : ℕ → ℝ, limit u x ∧ ∀ n, u n ∈ A ) :=
begin
  split,
  { intro h,
    split,
    { exact h.1 },
    -- On the next line, we don't need to tell Lean to treat `n+1` as a real number because
    -- we add `x` to it, so Lean knows there is only one way to make sense of this expression.
    have key : ∀ n : ℕ, ∃ a ∈ A, a < x + 1/(n+1),
    { intro n,
      -- we can use the lemma we proved above
      apply inf_lt h,
      -- and another one we proved!
      have : 0 < 1/(n+1 : ℝ), from inv_succ_pos n,
      linarith },
    -- Now we need to use axiom of (countable) choice
    choose u hu using key,
    use u,
    split,
    { intros ε ε_pos,
      -- again we use a lemma we proved, specializing it to our fixed `ε`, and fixing a `N`
      cases limit_inv_succ ε ε_pos with N H,
      use N,
      intros n hn,
      have : x ≤ u n, from h.1 _ (hu n).1,
      have := calc
        u n < x + 1/(n + 1) : (hu n).2
        ... ≤ x + ε         : add_le_add (le_refl x) (H n hn),
      rw abs_of_nonneg ; linarith },
    { intro n,
      exact (hu n).1 } },
  { intro h,
    -- Assumption `h` is made of nested compound statements. We can use the
    -- recursive version of `cases` to unpack it in one go.
    rcases h with ⟨x_min, u, lim, huA⟩,
    split,
    exact x_min,
    intros y y_mino,
    apply le_lim lim,
    intro n,
    exact y_mino (u n) (huA n) },
end


namespace Proposition
constant and : Prop -> Prop -> Prop
constant or : Prop -> Prop -> Prop
constant not : Prop -> Prop
constant imply : Prop -> Prop -> Prop

variables p q r : Prop
#check and p q
#check or p (and p q)

constant Proof : Prop -> Type
 constant and_comm : Π p q : Prop,
 Proof (implies (and p q) (and q p))
#check and_comm p q
constant modus_ponens :
Π p q : Prop, Proof (implies p q) -> Proof p -> Proof q

theorem t1 : p -> q -> p := fun hp : p, fun hq : q, hp
#print t1

theorem t2 : p -> q -> p :=
assume hp : p,
assume hq : q,
show p, from hp


import algebra.group
import data.equiv.basic
import array_group

open equiv

section perm_array

  parameters {n : ℕ} {α : Type*}

  @[simp] private lemma array.read_def {f : fin n → α} {i : fin n} : array.read { data := f } i = f i := rfl

  def perm_array (a : array n α) (p : perm (fin n)) : array n α := ⟨a.read ∘ p.inv_fun⟩

  lemma perm_array_def (a : array n α) (p : perm (fin n)) : perm_array a p = ⟨a.read ∘ p.inv_fun⟩ := rfl

  @[simp] lemma perm_array_array_one {p : perm (fin n)} [group α] : perm_array 1 p = 1 :=
  begin
    apply array.ext,
    intros i,
    refl,
  end

  @[simp] lemma perm_array_perm_one {a : array n α} : perm_array a 1 = a :=
  begin
    apply array.ext,
    intros i,
    refl,
  end

  @[simp] lemma perm_array_comp {a : array n α} {p₁ p₂ : perm (fin n)} : perm_array (perm_array a p₁) p₂ = perm_array a (p₂ * p₁) :=
  begin
    apply array.ext,
    simp [perm_array_def, perm.mul_def],
  end

end perm_array

section

parameters {n : ℕ} {α : Type*} [group α]

def array_perm (n : ℕ) (α : Type*) := array n α × perm (fin n)

@[reducible] private def ap := array_perm n α

variables (a b c : ap)

private def mul : ap := (perm_array a.fst b.snd * b.fst, b.snd * a.snd)
private def inv : ap := (perm_array a.fst⁻¹ a.snd⁻¹, a.snd⁻¹)

instance array_perm.has_mul : has_mul ap := ⟨mul⟩
instance array_perm.has_one : has_one ap := ⟨(mk_array n 1, 1)⟩
instance array_perm.has_inv : has_inv ap := ⟨inv⟩

@[simp] private lemma mul_def : a * b = (perm_array a.fst b.snd * b.fst, b.snd * a.snd) := rfl
@[simp] private lemma one_def : (1 : ap) = (mk_array n 1, 1) := rfl
@[simp] private lemma inv_def : a⁻¹ = (perm_array a.fst⁻¹ a.snd⁻¹, a.snd⁻¹) := rfl

private lemma mul_assoc : a * b * c = a * (b * c) :=
begin
  dsimp,
  congr' 1,
  apply array.ext,
  intros i,
  simp only [perm_array_def, function.comp, array.read_mul, array.read_def, mul_assoc],
  refl,
end

private lemma one_mul : 1 * a = a :=
begin
  dsimp,
  change (perm_array 1 a.snd * a.fst, a.snd * 1) = a,
  rw perm_array_array_one,
  simp,
end

private lemma mul_one : a * 1 = a :=
begin
  dsimp,
  rw perm_array_perm_one,
  change (a.fst * 1, 1 * a.snd) = a,
  simp,
end

private lemma mul_left_inv : a⁻¹ * a = 1 :=
begin
  dsimp,
  rw perm_array_comp,
  simp,
  refl,
end

instance array_perm_group : group ap :=
{
  mul := (*),
  mul_assoc := mul_assoc,
  one := 1,
  one_mul := one_mul,
  mul_one := mul_one,
  inv := has_inv.inv,
  mul_left_inv := mul_left_inv,
}

end


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
-/
import algebra.algebra.tower
import ring_theory.localization.basic

/-!
# Fraction ring / fraction field Frac(R) as localization

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

## Main definitions

 * `is_fraction_ring R K` expresses that `K` is a field of fractions of `R`, as an abbreviation of
   `is_localization (non_zero_divisors R) K`

## Main results

 * `is_fraction_ring.field`: a definition (not an instance) stating the localization of an integral
   domain `R` at `R \ {0}` is a field
 * `rat.is_fraction_ring` is an instance stating `ℚ` is the field of fractions of `ℤ`

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/
variables (R : Type*) [comm_ring R] {M : submonoid R} (S : Type*) [comm_ring S]
variables [algebra R S] {P : Type*} [comm_ring P]
variables {A : Type*} [comm_ring A] [is_domain A] (K : Type*)

/-- `is_fraction_ring R K` states `K` is the field of fractions of an integral domain `R`. -/
-- TODO: should this extend `algebra` instead of assuming it?
abbreviation is_fraction_ring [comm_ring K] [algebra R K] := is_localization (non_zero_divisors R) K

/-- The cast from `int` to `rat` as a `fraction_ring`. -/
instance rat.is_fraction_ring : is_fraction_ring ℤ ℚ :=
{ map_units :=
  begin
    rintro ⟨x, hx⟩,
    rw mem_non_zero_divisors_iff_ne_zero at hx,
    simpa only [eq_int_cast, is_unit_iff_ne_zero, int.cast_eq_zero,
                ne.def, subtype.coe_mk] using hx,
    end,
  surj :=
  begin
    rintro ⟨n, d, hd, h⟩,
    refine ⟨⟨n, ⟨d, _⟩⟩, rat.mul_denom_eq_num⟩,
    rwa [mem_non_zero_divisors_iff_ne_zero, int.coe_nat_ne_zero_iff_pos]
  end,
  eq_iff_exists :=
  begin
    intros x y,
    rw [eq_int_cast, eq_int_cast, int.cast_inj],
    refine ⟨by { rintro rfl, use 1 }, _⟩,
    rintro ⟨⟨c, hc⟩, h⟩,
    apply mul_left_cancel₀ _ h,
    rwa mem_non_zero_divisors_iff_ne_zero at hc,
  end }

namespace is_fraction_ring

open is_localization

variables {R K}

section comm_ring

variables [comm_ring K] [algebra R K] [is_fraction_ring R K] [algebra A K] [is_fraction_ring A K]

lemma to_map_eq_zero_iff {x : R} :
  algebra_map R K x = 0 ↔ x = 0 :=
to_map_eq_zero_iff _ (le_of_eq rfl)

variables (R K)

protected theorem injective : function.injective (algebra_map R K) :=
is_localization.injective _ (le_of_eq rfl)

variables {R K}

@[norm_cast, simp] lemma coe_inj {a b : R} : (↑a : K) = ↑b ↔ a = b :=
(is_fraction_ring.injective R K).eq_iff

@[priority 100] instance [no_zero_divisors K] : no_zero_smul_divisors R K :=
no_zero_smul_divisors.of_algebra_map_injective $ is_fraction_ring.injective R K

variables {R K}

protected lemma to_map_ne_zero_of_mem_non_zero_divisors [nontrivial R]
  {x : R} (hx : x ∈ non_zero_divisors R) : algebra_map R K x ≠ 0 :=
is_localization.to_map_ne_zero_of_mem_non_zero_divisors _ le_rfl hx

variables (A)

/-- A `comm_ring` `K` which is the localization of an integral domain `R` at `R - {0}` is an
integral domain. -/
protected theorem is_domain : is_domain K :=
is_domain_of_le_non_zero_divisors _ (le_refl (non_zero_divisors A))

local attribute [instance] classical.dec_eq

/-- The inverse of an element in the field of fractions of an integral domain. -/
@[irreducible]
protected noncomputable def inv (z : K) : K :=
if h : z = 0 then 0 else
mk' K ↑(sec (non_zero_divisors A) z).2
  ⟨(sec _ z).1,
   mem_non_zero_divisors_iff_ne_zero.2 $ λ h0, h $
    eq_zero_of_fst_eq_zero (sec_spec (non_zero_divisors A) z) h0⟩

protected lemma mul_inv_cancel (x : K) (hx : x ≠ 0) :
  x * is_fraction_ring.inv A x = 1 :=
begin
  rw [is_fraction_ring.inv, dif_neg hx, ←is_unit.mul_left_inj
    (map_units K ⟨(sec _ x).1, mem_non_zero_divisors_iff_ne_zero.2 $
      λ h0, hx $ eq_zero_of_fst_eq_zero (sec_spec (non_zero_divisors A) x) h0⟩),
    one_mul, mul_assoc],
  rw [mk'_spec, ←eq_mk'_iff_mul_eq],
  exact (mk'_sec _ x).symm
end

/-- A `comm_ring` `K` which is the localization of an integral domain `R` at `R - {0}` is a field.
See note [reducible non-instances]. -/
@[reducible]
noncomputable def to_field : field K :=
{ inv := is_fraction_ring.inv A,
  mul_inv_cancel := is_fraction_ring.mul_inv_cancel A,
  inv_zero := begin
    change is_fraction_ring.inv A (0 : K) = 0,
    rw [is_fraction_ring.inv],
    exact dif_pos rfl
  end,
  .. is_fraction_ring.is_domain A,
  .. show comm_ring K, by apply_instance }

end comm_ring

variables {B : Type*} [comm_ring B] [is_domain B] [field K] {L : Type*} [field L]
  [algebra A K] [is_fraction_ring A K] {g : A →+* L}

lemma mk'_mk_eq_div {r s} (hs : s ∈ non_zero_divisors A) :
  mk' K r ⟨s, hs⟩ = algebra_map A K r / algebra_map A K s :=
mk'_eq_iff_eq_mul.2 $ (div_mul_cancel (algebra_map A K r)
    (is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors hs)).symm

@[simp] lemma mk'_eq_div {r} (s : non_zero_divisors A) :
  mk' K r s = algebra_map A K r / algebra_map A K s :=
mk'_mk_eq_div s.2

lemma div_surjective (z : K) : ∃ (x y : A) (hy : y ∈ non_zero_divisors A),
  algebra_map _ _ x / algebra_map _ _ y = z :=
let ⟨x, ⟨y, hy⟩, h⟩ := mk'_surjective (non_zero_divisors A) z
in ⟨x, y, hy, by rwa mk'_eq_div at h⟩

lemma is_unit_map_of_injective (hg : function.injective g)
  (y : non_zero_divisors A) : is_unit (g y) :=
is_unit.mk0 (g y) $ show g.to_monoid_with_zero_hom y ≠ 0,
  from map_ne_zero_of_mem_non_zero_divisors g hg y.2

@[simp] lemma mk'_eq_zero_iff_eq_zero [algebra R K] [is_fraction_ring R K] {x : R}
  {y : non_zero_divisors R} : mk' K x y = 0 ↔ x = 0 :=
begin
  refine ⟨λ hxy, _, λ h, by rw [h, mk'_zero]⟩,
  { simp_rw [mk'_eq_zero_iff, mul_left_coe_non_zero_divisors_eq_zero_iff] at hxy,
    exact (exists_const _).mp hxy },
end

lemma mk'_eq_one_iff_eq {x : A} {y : non_zero_divisors A} : mk' K x y = 1 ↔ x = y :=
begin
  refine ⟨_, λ hxy, by rw [hxy, mk'_self']⟩,
  { intro hxy, have hy : (algebra_map A K) ↑y ≠ (0 : K) :=
    is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors y.property,
    rw [is_fraction_ring.mk'_eq_div, div_eq_one_iff_eq hy] at hxy,
    exact is_fraction_ring.injective A K hxy }
end

open function

/-- Given an integral domain `A` with field of fractions `K`,
and an injective ring hom `g : A →+* L` where `L` is a field, we get a
field hom sending `z : K` to `g x * (g y)⁻¹`, where `(x, y) : A × (non_zero_divisors A)` are
such that `z = f x * (f y)⁻¹`. -/
noncomputable def lift (hg : injective g) : K →+* L :=
lift $ λ (y : non_zero_divisors A), is_unit_map_of_injective hg y

/-- Given an integral domain `A` with field of fractions `K`,
and an injective ring hom `g : A →+* L` where `L` is a field,
the field hom induced from `K` to `L` maps `x` to `g x` for all
`x : A`. -/
@[simp]

/-- Given an integral domain `A` with field of fractions `K`,
and an injective ring hom `g : A →+* L` where `L` is a field,
field hom induced from `K` to `L` maps `f x / f y` to `g x / g y` for all
`x : A, y ∈ non_zero_divisors A`. -/
lemma lift_mk' (hg : injective g) (x) (y : non_zero_divisors A) :
  lift hg (mk' K x y) = g x / g y :=
by simp only [mk'_eq_div, map_div₀, lift_algebra_map]

/-- Given integral domains `A, B` with fields of fractions `K`, `L`
and an injective ring hom `j : A →+* B`, we get a field hom
sending `z : K` to `g (j x) * (g (j y))⁻¹`, where `(x, y) : A × (non_zero_divisors A)` are
such that `z = f x * (f y)⁻¹`. -/
noncomputable def map {A B K L : Type*} [comm_ring A] [comm_ring B] [is_domain B]
  [comm_ring K] [algebra A K] [is_fraction_ring A K] [comm_ring L] [algebra B L]
  [is_fraction_ring B L] {j : A →+* B} (hj : injective j) :
  K →+* L :=
map L j (show non_zero_divisors A ≤ (non_zero_divisors B).comap j,
         from non_zero_divisors_le_comap_non_zero_divisors_of_injective j hj)

/-- Given integral domains `A, B` and localization maps to their fields of fractions
`f : A →+* K, g : B →+* L`, an isomorphism `j : A ≃+* B` induces an isomorphism of
fields of fractions `K ≃+* L`. -/
noncomputable def field_equiv_of_ring_equiv [algebra B L] [is_fraction_ring B L] (h : A ≃+* B) :
  K ≃+* L :=
ring_equiv_of_ring_equiv K L h
begin
  ext b,
  show b ∈ h.to_equiv '' _ ↔ _,
  erw [h.to_equiv.image_eq_preimage, set.preimage, set.mem_set_of_eq,
       mem_non_zero_divisors_iff_ne_zero, mem_non_zero_divisors_iff_ne_zero],
  exact h.symm.map_ne_zero_iff
end

variables (S)

lemma is_fraction_ring_iff_of_base_ring_equiv (h : R ≃+* P) :
  is_fraction_ring R S ↔
    @@is_fraction_ring P _ S _ ((algebra_map R S).comp h.symm.to_ring_hom).to_algebra :=
begin
  delta is_fraction_ring,
  convert is_localization_iff_of_base_ring_equiv _ _ h,
  ext x,
  erw submonoid.map_equiv_eq_comap_symm,
  simp only [mul_equiv.coe_to_monoid_hom,
    ring_equiv.to_mul_equiv_eq_coe, submonoid.mem_comap],
  split,
  { rintros hx z (hz : z * h.symm x = 0),
    rw ← h.map_eq_zero_iff,
    apply hx,
    simpa only [h.map_zero, h.apply_symm_apply, h.map_mul] using congr_arg h hz },
  { rintros (hx : h.symm x ∈ _) z hz,
    rw ← h.symm.map_eq_zero_iff,
    apply hx,
    rw [← h.symm.map_mul, hz, h.symm.map_zero] }
end

protected
lemma nontrivial (R S : Type*) [comm_ring R] [nontrivial R] [comm_ring S] [algebra R S]
  [is_fraction_ring R S] : nontrivial S :=
begin
  apply nontrivial_of_ne,
  intro h,
  apply @zero_ne_one R,
  exact is_localization.injective S (le_of_eq rfl)
    (((algebra_map R S).map_zero.trans h).trans (algebra_map R S).map_one.symm),
end

end is_fraction_ring

variables (R A)

/-- The fraction ring of a commutative ring `R` as a quotient type.

We instantiate this definition as generally as possible, and assume that the
commutative ring `R` is an integral domain only when this is needed for proving.
-/
@[reducible] def fraction_ring := localization (non_zero_divisors R)

namespace fraction_ring

instance unique [subsingleton R] : unique (fraction_ring R) :=
localization.unique

instance [nontrivial R] : nontrivial (fraction_ring R) :=
⟨⟨(algebra_map R _) 0, (algebra_map _ _) 1,
  λ H, zero_ne_one (is_localization.injective _ le_rfl H)⟩⟩

variables {A}

noncomputable instance : field (fraction_ring A) :=
{ add := (+),
  mul := (*),
  neg := has_neg.neg,
  sub := has_sub.sub,
  one := 1,
  zero := 0,
  nsmul := add_monoid.nsmul,
  zsmul := sub_neg_monoid.zsmul,
  npow := localization.npow _,
  .. localization.comm_ring,
  .. is_fraction_ring.to_field A }

@[simp] lemma mk_eq_div {r s} : (localization.mk r s : fraction_ring A) =
  (algebra_map _ _ r / algebra_map A _ s : fraction_ring A) :=
by rw [localization.mk_eq_mk', is_fraction_ring.mk'_eq_div]

noncomputable instance [is_domain R] [field K] [algebra R K] [no_zero_smul_divisors R K] :
  algebra (fraction_ring R) K :=
ring_hom.to_algebra (is_fraction_ring.lift (no_zero_smul_divisors.algebra_map_injective R _))

instance [is_domain R] [field K] [algebra R K] [no_zero_smul_divisors R K] :
  is_scalar_tower R (fraction_ring R) K :=
is_scalar_tower.of_algebra_map_eq (λ x, (is_fraction_ring.lift_algebra_map _ x).symm)

variables (A)

/-- Given an integral domain `A` and a localization map to a field of fractions
`f : A →+* K`, we get an `A`-isomorphism between the field of fractions of `A` as a quotient
type and `K`. -/
noncomputable def alg_equiv (K : Type*) [field K] [algebra A K] [is_fraction_ring A K] :
  fraction_ring A ≃ₐ[A] K :=
localization.alg_equiv (non_zero_divisors A) K

instance [algebra R A] [no_zero_smul_divisors R A] : no_zero_smul_divisors R (fraction_ring A) :=
no_zero_smul_divisors.of_algebra_map_injective
  begin
    rw [is_scalar_tower.algebra_map_eq R A],
    exact function.injective.comp
      (no_zero_smul_divisors.algebra_map_injective _ _)
      (no_zero_smul_divisors.algebra_map_injective _ _)
  end

end fraction_ring


import ground_zero.HITs.colimit ground_zero.HITs.generalized
import ground_zero.structures
open ground_zero.support (renaming truncation -> hint)
open ground_zero.types.equiv (subst path_over_subst apd pathover_from_trans)
open ground_zero.types.eq (cong)
open ground_zero.structures (prop contr lem_contr)

namespace ground_zero.HITs
hott theory

universes u v

/-
  Propositional truncation is colimit of a following sequence:
    α → {α} → {{α}} → ...

  * https://github.com/fpvandoorn/leansnippets/blob/master/truncation.hlean
  * https://github.com/fpvandoorn/leansnippets/blob/master/cpp.hlean
    (we use this proof here)
  * https://homotopytypetheory.org/2015/07/28/constructing-the-propositional-truncation-using-nonrecursive-hits/
  * https://homotopytypetheory.org/2016/01/08/colimits-in-hott/
  * https://arxiv.org/pdf/1512.02274
-/
def truncation (α : Sort u) :=
colimit (generalized.repeat α) (generalized.dep α)

notation `∥` α `∥` := truncation α

namespace truncation
  def elem {α : Sort u} (x : α) : ∥α∥ :=
  colimit.inclusion 0 x

  notation `|` a `|` := elem a

  def ind {α : Sort u} {π : ∥α∥ → Sort v}
    (elemπ : Π x, π (elem x))
    (uniqπ : Π x, prop (π x)) : Π x, π x := begin
    fapply colimit.ind,
    { intros, induction n with n ih,
      { apply elemπ },
      { refine generalized.ind _ _ x,
        { clear x, intro x,
          apply subst (colimit.glue x)⁻¹ (ih x) },
        { intros, apply path_over_subst,
          apply uniqπ } } },
    { intros, apply path_over_subst, apply uniqπ }
  end

  def rec {α : Sort u} {β : Sort v} (h : prop β)
    (f : α → β) : ∥α∥ → β :=
  ind f (λ _, h)

  def weak_uniq {α : Sort u} (x y : α) : elem x = elem y :> ∥α∥ := begin
    transitivity, { symmetry, apply colimit.glue }, symmetry,
    transitivity, { symmetry, apply colimit.glue },
    apply ground_zero.types.eq.map, apply generalized.glue
  end

  abbreviation incl {α : Sort u} {n : ℕ} :=
  @colimit.incl (generalized.repeat α) (generalized.dep α) n

  abbreviation glue {α : Sort u} {n : ℕ} {x : generalized.repeat α n} :
    incl (generalized.dep α n x) = incl x :=
  colimit.glue x

  def exact_nth {α : Sort u} (a : α) : Π n, generalized.repeat α n
  | 0 := a
  | (n + 1) := generalized.dep α n (exact_nth n)

  def nth_glue {α : Sort u} (a : α) : Π n,
    incl (exact_nth a n) = @incl α 0 a
  | 0 := by reflexivity
  | (n + 1) := colimit.glue (exact_nth a n) ⬝ nth_glue n

  def incl_uniq {α : Sort u} {n : ℕ} (a b : generalized.repeat α n) :
    incl a = incl b :=
  calc incl a = incl (generalized.dep α n a) : glue⁻¹
          ... = incl (generalized.dep α n b) : incl # (generalized.glue a b)
          ... = incl b : glue

  def incl_zero_eq_incl {α : Sort u} {n : ℕ} (x : α)
    (y : generalized.repeat α n) : @incl α 0 x = incl y :=
  calc @incl α 0 x = incl (exact_nth x n) : (nth_glue x n)⁻¹
               ... = incl y : incl_uniq (exact_nth x n) y

  def weakly_constant_ap {α : Sort u} {β : Sort v} (f : α → β)
    {a b : α} (p q : a = b) (H : Π (a b : α), f a = f b) : f # p = f # q :=
  let L : Π {u v : α} {r : u = v}, (H a u)⁻¹ ⬝ H a v = f # r :=
  begin intros, induction r, apply ground_zero.types.eq.inv_comp end in
  L⁻¹ ⬝ L

  def cong_close {α : Sort u} {n : ℕ} {a b : generalized.repeat α n} (p : a = b) :
    glue⁻¹ ⬝ incl # (generalized.dep α n # p) ⬝ glue = incl # p := begin
    induction p,
    rw ←hint (ground_zero.types.eq.assoc _ _ _),
    apply ground_zero.types.equiv.rewrite_comp, symmetry,
    apply ground_zero.types.eq.refl_right
  end

  def cong_over_path {α : Sort u} {n : ℕ} {a b : generalized.repeat α n}
    (p q : a = b) : incl # p = incl # q :=
  weakly_constant_ap incl p q incl_uniq

  def glue_close {α : Sort u} {n : ℕ} {a b : generalized.repeat α n} :
    glue⁻¹ ⬝ incl # (generalized.glue (generalized.dep α n a)
                                      (generalized.dep α n b)) ⬝ glue =
    incl # (generalized.glue a b) := begin
    symmetry, transitivity,
    { symmetry, exact cong_close (generalized.glue a b) },
    apply cong (λ p, p ⬝ glue), apply cong,
    apply cong_over_path
  end

  def incl_uniq_close {α : Sort u} {n : ℕ} (a b : generalized.repeat α n) :
    glue⁻¹ ⬝ incl_uniq (generalized.dep α n a) (generalized.dep α n b) ⬝ glue =
    incl_uniq a b := begin
    unfold incl_uniq, apply cong (λ p, p ⬝ glue), apply cong,
    apply glue_close
  end

  def uniq {α : Sort u} : prop ∥α∥ := begin
    apply lem_contr, fapply ind,
    { intro x, existsi elem x, fapply colimit.ind; intros n y,
      { apply incl_zero_eq_incl },
      { simp, unfold incl_zero_eq_incl, unfold nth_glue,
        apply pathover_from_trans,
        symmetry, transitivity,
        { symmetry, apply cong, apply incl_uniq_close },
        rw hint (ground_zero.types.eq.explode_inv _ _),
        repeat { rw ←hint (ground_zero.types.eq.assoc _ _ _) },
        apply cong (λ p, (nth_glue x n)⁻¹ ⬝ p),
        unfold incl_uniq, trivial } },
    { intro x, apply ground_zero.structures.contr_is_prop }
  end

  def lift {α β : Type u} (f : α → β) : ∥α∥ → ∥β∥ :=
  rec uniq (elem ∘ f)

  theorem equiv_iff_trunc {α β : Type u}
    (f : α → β) (g : β → α) : ∥α∥ ≃ ∥β∥ := begin
    existsi lift f, split; existsi lift g;
    { intro x, apply uniq }
  end

  def double {α : Type u} (a : α) : α × α := ⟨a, a⟩
  theorem product_identity {α : Type u} :
    ∥α∥ ≃ ∥α × α∥ := begin
    apply equiv_iff_trunc, exact double,
    intro x, cases x with u v, exact u
  end

  def uninhabited_implies_trunc_uninhabited {α : Sort u}
    (p : α → empty) : ∥α∥ → empty :=
  rec ground_zero.structures.empty_is_prop p
end truncation

def surj {α : Sort u} {β : Sort v} (f : α → β) :=
Π (b : β), ∥ground_zero.types.fib f b∥

def embedding {α : Sort u} {β : Sort v} (f : α → β) :=
Π (x y : α), ground_zero.types.equiv.biinv (λ (p : x = y), f # p)

end ground_zero.HITs


import week_3.Part_A_limits

import topology.instances.real

open filter

open_locale topological_space

namespace xena

-- `is_limit` is equivalent to a `filter.tendsto`
lemma is_limit_iff_tendsto (a : ℕ → ℝ) (l : ℝ) :
  is_limit a l ↔ tendsto a at_top (𝓝 l) :=
begin
  rw metric.tendsto_at_top,
  congr',
end

-- this is `is_limit_add`
example (a b : ℕ → ℝ) (l m : ℝ) : is_limit a l → is_limit b m → is_limit (a + b) (l + m) :=
begin
  repeat {rw is_limit_iff_tendsto},
  exact tendsto.add,
end

-- this is `is_limit_mul`
example (a b : ℕ → ℝ) (l m : ℝ) : is_limit a l → is_limit b m → is_limit (a * b) (l * m) :=
begin
  repeat {rw is_limit_iff_tendsto},
  exact tendsto.mul,
end

end xena


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Reid Barton

! This file was ported from Lean 3 source module topology.shrinking_lemma
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Separation

/-!
# The shrinking lemma

In this file we prove a few versions of the shrinking lemma. The lemma says that in a normal
topological space a point finite open covering can be “shrunk”: for a point finite open covering
`u : ι → Set X` there exists a refinement `v : ι → Set X` such that `closure (v i) ⊆ u i`.

For finite or countable coverings this lemma can be proved without the axiom of choice, see
[ncatlab](https://ncatlab.org/nlab/show/shrinking+lemma) for details. We only formalize the most
general result that works for any covering but needs the axiom of choice.

We prove two versions of the lemma:

* `exists_subset_unionᵢ_closure_subset` deals with a covering of a closed set in a normal space;
* `exists_unionᵢ_eq_closure_subset` deals with a covering of the whole space.

## Tags

normal space, shrinking lemma
-/

open Set Function

open scoped Classical

noncomputable section

variable {ι X : Type _} [TopologicalSpace X] [NormalSpace X]

namespace ShrinkingLemma

-- the trivial refinement needs `u` to be a covering
/-- Auxiliary definition for the proof of the shrinking lemma. A partial refinement of a covering
`⋃ i, u i` of a set `s` is a map `v : ι → Set X` and a set `carrier : Set ι` such that

* `s ⊆ ⋃ i, v i`;
* all `v i` are open;
* if `i ∈ carrier v`, then `closure (v i) ⊆ u i`;
* if `i ∉ carrier`, then `v i = u i`.

This type is equipped with the folowing partial order: `v ≤ v'` if `v.carrier ⊆ v'.carrier`
and `v i = v' i` for `i ∈ v.carrier`. We will use Zorn's lemma to prove that this type has
a maximal element, then show that the maximal element must have `carrier = univ`. -/
-- porting note: @[nolint has_nonempty_instance] is not here yet
@[ext] structure PartialRefinement (u : ι → Set X) (s : Set X) where
  /-- A family of sets that form a partial refinement of `u`. -/
  toFun : ι → Set X
  /-- The set of indexes `i` such that `i`-th set is already shrunk. -/
  carrier : Set ι
  /-- Each set from the partially refined family is open. -/
  protected isOpen : ∀ i, IsOpen (toFun i)
  /-- The partially refined family still covers the set. -/
  subset_unionᵢ : s ⊆ ⋃ i, toFun i
  /-- For each `i ∈ carrier`, the original set includes the closure of the refined set. -/
  closure_subset : ∀ {i}, i ∈ carrier → closure (toFun i) ⊆ u i
  /-- Sets that correspond to `i ∉ carrier` are not modified. -/
  apply_eq : ∀ {i}, i ∉ carrier → toFun i = u i
#align shrinking_lemma.partial_refinement ShrinkingLemma.PartialRefinement

namespace PartialRefinement

variable {u : ι → Set X} {s : Set X}

instance : CoeFun (PartialRefinement u s) fun _ => ι → Set X := ⟨toFun⟩

#align shrinking_lemma.partial_refinement.subset_Union ShrinkingLemma.PartialRefinement.subset_unionᵢ
#align shrinking_lemma.partial_refinement.closure_subset ShrinkingLemma.PartialRefinement.closure_subset
#align shrinking_lemma.partial_refinement.apply_eq ShrinkingLemma.PartialRefinement.apply_eq
#align shrinking_lemma.partial_refinement.is_open ShrinkingLemma.PartialRefinement.isOpen

protected theorem subset (v : PartialRefinement u s) (i : ι) : v i ⊆ u i :=
  if h : i ∈ v.carrier then subset_closure.trans (v.closure_subset h) else (v.apply_eq h).le
#align shrinking_lemma.partial_refinement.subset ShrinkingLemma.PartialRefinement.subset

instance : PartialOrder (PartialRefinement u s) where
  le v₁ v₂ := v₁.carrier ⊆ v₂.carrier ∧ ∀ i ∈ v₁.carrier, v₁ i = v₂ i
  le_refl v := ⟨Subset.refl _, fun _ _ => rfl⟩
  le_trans v₁ v₂ v₃ h₁₂ h₂₃ :=
    ⟨Subset.trans h₁₂.1 h₂₃.1, fun i hi => (h₁₂.2 i hi).trans (h₂₃.2 i <| h₁₂.1 hi)⟩
  le_antisymm v₁ v₂ h₁₂ h₂₁ :=
    have hc : v₁.carrier = v₂.carrier := Subset.antisymm h₁₂.1 h₂₁.1
    PartialRefinement.ext _ _
      (funext fun x =>
        if hx : x ∈ v₁.carrier then h₁₂.2 _ hx
        else (v₁.apply_eq hx).trans (Eq.symm <| v₂.apply_eq <| hc ▸ hx))
      hc

/-- If two partial refinements `v₁`, `v₂` belong to a chain (hence, they are comparable)
and `i` belongs to the carriers of both partial refinements, then `v₁ i = v₂ i`. -/
theorem apply_eq_of_chain {c : Set (PartialRefinement u s)} (hc : IsChain (· ≤ ·) c) {v₁ v₂}
    (h₁ : v₁ ∈ c) (h₂ : v₂ ∈ c) {i} (hi₁ : i ∈ v₁.carrier) (hi₂ : i ∈ v₂.carrier) :
    v₁ i = v₂ i :=
  (hc.total h₁ h₂).elim (fun hle => hle.2 _ hi₁) (fun hle => (hle.2 _ hi₂).symm)
#align shrinking_lemma.partial_refinement.apply_eq_of_chain ShrinkingLemma.PartialRefinement.apply_eq_of_chain

/-- The carrier of the least upper bound of a non-empty chain of partial refinements is the union of
their carriers. -/
def chainSupCarrier (c : Set (PartialRefinement u s)) : Set ι :=
  ⋃ v ∈ c, carrier v
#align shrinking_lemma.partial_refinement.chain_Sup_carrier ShrinkingLemma.PartialRefinement.chainSupCarrier

/-- Choice of an element of a nonempty chain of partial refinements. If `i` belongs to one of
`carrier v`, `v ∈ c`, then `find c ne i` is one of these partial refinements. -/
def find (c : Set (PartialRefinement u s)) (ne : c.Nonempty) (i : ι) : PartialRefinement u s :=
  if hi : ∃ v ∈ c, i ∈ carrier v then hi.choose else ne.some
#align shrinking_lemma.partial_refinement.find ShrinkingLemma.PartialRefinement.find

theorem find_mem {c : Set (PartialRefinement u s)} (i : ι) (ne : c.Nonempty) : find c ne i ∈ c := by
  rw [find]
  split_ifs with h
  exacts [h.choose_spec.1, ne.some_mem]
#align shrinking_lemma.partial_refinement.find_mem ShrinkingLemma.PartialRefinement.find_mem

theorem mem_find_carrier_iff {c : Set (PartialRefinement u s)} {i : ι} (ne : c.Nonempty) :
    i ∈ (find c ne i).carrier ↔ i ∈ chainSupCarrier c := by
  rw [find]
  split_ifs with h
  · have := h.choose_spec
    exact iff_of_true this.2 (mem_unionᵢ₂.2 ⟨_, this.1, this.2⟩)
  · push_neg at h
    refine iff_of_false (h _ ne.some_mem) ?_
    simpa only [chainSupCarrier, mem_unionᵢ₂, not_exists]
#align shrinking_lemma.partial_refinement.mem_find_carrier_iff ShrinkingLemma.PartialRefinement.mem_find_carrier_iff

theorem find_apply_of_mem {c : Set (PartialRefinement u s)} (hc : IsChain (· ≤ ·) c)
    (ne : c.Nonempty) {i v} (hv : v ∈ c) (hi : i ∈ carrier v) : find c ne i i = v i :=
  apply_eq_of_chain hc (find_mem _ _) hv ((mem_find_carrier_iff _).2 <| mem_unionᵢ₂.2 ⟨v, hv, hi⟩)
    hi
#align shrinking_lemma.partial_refinement.find_apply_of_mem ShrinkingLemma.PartialRefinement.find_apply_of_mem

/-- Least upper bound of a nonempty chain of partial refinements. -/
def chainSup (c : Set (PartialRefinement u s)) (hc : IsChain (· ≤ ·) c) (ne : c.Nonempty)
    (hfin : ∀ x ∈ s, { i | x ∈ u i }.Finite) (hU : s ⊆ ⋃ i, u i) : PartialRefinement u s where
  toFun i := find c ne i i
  carrier := chainSupCarrier c
  isOpen i := (find _ _ _).isOpen i
  subset_unionᵢ x hxs := mem_unionᵢ.2 <| by
    rcases em (∃ i, i ∉ chainSupCarrier c ∧ x ∈ u i) with (⟨i, hi, hxi⟩ | hx)
    · use i
      simpa only [(find c ne i).apply_eq (mt (mem_find_carrier_iff _).1 hi)]
    · simp_rw [not_exists, not_and, not_imp_not, chainSupCarrier, mem_unionᵢ₂] at hx
      haveI : Nonempty (PartialRefinement u s) := ⟨ne.some⟩
      choose! v hvc hiv using hx
      rcases(hfin x hxs).exists_maximal_wrt v _ (mem_unionᵢ.1 (hU hxs)) with
        ⟨i, hxi : x ∈ u i, hmax : ∀ j, x ∈ u j → v i ≤ v j → v i = v j⟩
      rcases mem_unionᵢ.1 ((v i).subset_unionᵢ hxs) with ⟨j, hj⟩
      use j
      have hj' : x ∈ u j := (v i).subset _ hj
      have : v j ≤ v i := (hc.total (hvc _ hxi) (hvc _ hj')).elim (fun h => (hmax j hj' h).ge) id
      simpa only [find_apply_of_mem hc ne (hvc _ hxi) (this.1 <| hiv _ hj')]
  closure_subset hi := (find c ne _).closure_subset ((mem_find_carrier_iff _).2 hi)
  apply_eq hi := (find c ne _).apply_eq (mt (mem_find_carrier_iff _).1 hi)
#align shrinking_lemma.partial_refinement.chain_Sup ShrinkingLemma.PartialRefinement.chainSup

/-- `chainSup hu c hc ne hfin hU` is an upper bound of the chain `c`. -/
theorem le_chainSup {c : Set (PartialRefinement u s)} (hc : IsChain (· ≤ ·) c) (ne : c.Nonempty)
    (hfin : ∀ x ∈ s, { i | x ∈ u i }.Finite) (hU : s ⊆ ⋃ i, u i) {v} (hv : v ∈ c) :
    v ≤ chainSup c hc ne hfin hU :=
  ⟨fun _ hi => mem_bunionᵢ hv hi, fun _ hi => (find_apply_of_mem hc _ hv hi).symm⟩
#align shrinking_lemma.partial_refinement.le_chain_Sup ShrinkingLemma.PartialRefinement.le_chainSup

/-- If `s` is a closed set, `v` is a partial refinement, and `i` is an index such that
`i ∉ v.carrier`, then there exists a partial refinement that is strictly greater than `v`. -/
theorem exists_gt (v : PartialRefinement u s) (hs : IsClosed s) (i : ι) (hi : i ∉ v.carrier) :
    ∃ v' : PartialRefinement u s, v < v' := by
  have I : (s ∩ ⋂ (j) (_hj : j ≠ i), v jᶜ) ⊆ v i := by
    simp only [subset_def, mem_inter_iff, mem_interᵢ, and_imp]
    intro x hxs H
    rcases mem_unionᵢ.1 (v.subset_unionᵢ hxs) with ⟨j, hj⟩
    exact (em (j = i)).elim (fun h => h ▸ hj) fun h => (H j h hj).elim
  have C : IsClosed (s ∩ ⋂ (j) (_hj : j ≠ i), v jᶜ) :=
    IsClosed.inter hs (isClosed_binterᵢ fun _ _ => isClosed_compl_iff.2 <| v.isOpen _)
  rcases normal_exists_closure_subset C (v.isOpen i) I with ⟨vi, ovi, hvi, cvi⟩
  refine' ⟨⟨update v i vi, insert i v.carrier, _, _, _, _⟩, _, _⟩
  · intro j
    rcases eq_or_ne j i with (rfl| hne) <;> simp [*, v.isOpen]
  · refine' fun x hx => mem_unionᵢ.2 _
    rcases em (∃ (j : _)(_ : j ≠ i), x ∈ v j) with (⟨j, hji, hj⟩ | h)
    · use j
      rwa [update_noteq hji]
    · push_neg  at h
      use i
      rw [update_same]
      exact hvi ⟨hx, mem_binterᵢ h⟩
  · rintro j (rfl | hj)
    · rwa [update_same, ← v.apply_eq hi]
    · rw [update_noteq (ne_of_mem_of_not_mem hj hi)]
      exact v.closure_subset hj
  · intro j hj
    rw [mem_insert_iff, not_or] at hj
    rw [update_noteq hj.1, v.apply_eq hj.2]
  · refine' ⟨subset_insert _ _, fun j hj => _⟩
    exact (update_noteq (ne_of_mem_of_not_mem hj hi) _ _).symm
  · exact fun hle => hi (hle.1 <| mem_insert _ _)
#align shrinking_lemma.partial_refinement.exists_gt ShrinkingLemma.PartialRefinement.exists_gt

end PartialRefinement

end ShrinkingLemma

open ShrinkingLemma

variable {u : ι → Set X} {s : Set X}

/-- **Shrinking lemma**. A point-finite open cover of a closed subset of a normal space can be
"shrunk" to a new open cover so that the closure of each new open set is contained in the
corresponding original open set. -/
theorem exists_subset_unionᵢ_closure_subset (hs : IsClosed s) (uo : ∀ i, IsOpen (u i))
    (uf : ∀ x ∈ s, { i | x ∈ u i }.Finite) (us : s ⊆ ⋃ i, u i) :
    ∃ v : ι → Set X, s ⊆ unionᵢ v ∧ (∀ i, IsOpen (v i)) ∧ ∀ i, closure (v i) ⊆ u i := by
  haveI : Nonempty (PartialRefinement u s) := ⟨⟨u, ∅, uo, us, False.elim, fun _ => rfl⟩⟩
  have : ∀ c : Set (PartialRefinement u s),
      IsChain (· ≤ ·) c → c.Nonempty → ∃ ub, ∀ v ∈ c, v ≤ ub :=
    fun c hc ne => ⟨.chainSup c hc ne uf us, fun v hv => PartialRefinement.le_chainSup _ _ _ _ hv⟩
  rcases zorn_nonempty_partialOrder this with ⟨v, hv⟩
  suffices : ∀ i, i ∈ v.carrier
  exact ⟨v, v.subset_unionᵢ, fun i => v.isOpen _, fun i => v.closure_subset (this i)⟩
  contrapose! hv
  rcases hv with ⟨i, hi⟩
  rcases v.exists_gt hs i hi with ⟨v', hlt⟩
  exact ⟨v', hlt.le, hlt.ne'⟩
#align exists_subset_Union_closure_subset exists_subset_unionᵢ_closure_subset

/-- **Shrinking lemma**. A point-finite open cover of a closed subset of a normal space can be
"shrunk" to a new closed cover so that each new closed set is contained in the corresponding
original open set. See also `exists_subset_unionᵢ_closure_subset` for a stronger statement. -/
theorem exists_subset_unionᵢ_closed_subset (hs : IsClosed s) (uo : ∀ i, IsOpen (u i))
    (uf : ∀ x ∈ s, { i | x ∈ u i }.Finite) (us : s ⊆ ⋃ i, u i) :
    ∃ v : ι → Set X, s ⊆ unionᵢ v ∧ (∀ i, IsClosed (v i)) ∧ ∀ i, v i ⊆ u i :=
  let ⟨v, hsv, _, hv⟩ := exists_subset_unionᵢ_closure_subset hs uo uf us
  ⟨fun i => closure (v i), Subset.trans hsv (unionᵢ_mono fun _ => subset_closure),
    fun _ => isClosed_closure, hv⟩
#align exists_subset_Union_closed_subset exists_subset_unionᵢ_closed_subset

/-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
to a new open cover so that the closure of each new open set is contained in the corresponding
original open set. -/
theorem exists_unionᵢ_eq_closure_subset (uo : ∀ i, IsOpen (u i)) (uf : ∀ x, { i | x ∈ u i }.Finite)
    (uU : (⋃ i, u i) = univ) :
    ∃ v : ι → Set X, unionᵢ v = univ ∧ (∀ i, IsOpen (v i)) ∧ ∀ i, closure (v i) ⊆ u i :=
  let ⟨v, vU, hv⟩ := exists_subset_unionᵢ_closure_subset isClosed_univ uo (fun x _ => uf x) uU.ge
  ⟨v, univ_subset_iff.1 vU, hv⟩
#align exists_Union_eq_closure_subset exists_unionᵢ_eq_closure_subset

/-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
to a new closed cover so that each of the new closed sets is contained in the corresponding
original open set. See also `exists_unionᵢ_eq_closure_subset` for a stronger statement. -/
theorem exists_unionᵢ_eq_closed_subset (uo : ∀ i, IsOpen (u i)) (uf : ∀ x, { i | x ∈ u i }.Finite)
    (uU : (⋃ i, u i) = univ) :
    ∃ v : ι → Set X, unionᵢ v = univ ∧ (∀ i, IsClosed (v i)) ∧ ∀ i, v i ⊆ u i :=
  let ⟨v, vU, hv⟩ := exists_subset_unionᵢ_closed_subset isClosed_univ uo (fun x _ => uf x) uU.ge
  ⟨v, univ_subset_iff.1 vU, hv⟩
#align exists_Union_eq_closed_subset exists_unionᵢ_eq_closed_subset


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Eric Wieser
-/

import algebra.char_p.basic
import ring_theory.ideal.quotient

/-!
# Characteristic of quotients rings
-/

universes u v

namespace char_p

theorem quotient (R : Type u) [comm_ring R] (p : ℕ) [hp1 : fact p.prime] (hp2 : ↑p ∈ nonunits R) :
  char_p (R ⧸ (ideal.span {p} : ideal R)) p :=
have hp0 : (p : R ⧸ (ideal.span {p} : ideal R)) = 0,
  from map_nat_cast (ideal.quotient.mk (ideal.span {p} : ideal R)) p ▸
    ideal.quotient.eq_zero_iff_mem.2 (ideal.subset_span $ set.mem_singleton _),
ring_char.of_eq $ or.resolve_left ((nat.dvd_prime hp1.1).1 $ ring_char.dvd hp0) $ λ h1,
hp2 $ is_unit_iff_dvd_one.2 $ ideal.mem_span_singleton.1 $ ideal.quotient.eq_zero_iff_mem.1 $
@@subsingleton.elim (@@char_p.subsingleton _ $ ring_char.of_eq h1) _ _

/-- If an ideal does not contain any coercions of natural numbers other than zero, then its quotient
inherits the characteristic of the underlying ring. -/
lemma quotient' {R : Type*} [comm_ring R] (p : ℕ) [char_p R p] (I : ideal R)
  (h : ∀ x : ℕ, (x : R) ∈ I → (x : R) = 0) :
  char_p (R ⧸ I) p :=
⟨λ x, begin
  rw [←cast_eq_zero_iff R p x, ←map_nat_cast (ideal.quotient.mk I)],
  refine ideal.quotient.eq.trans (_ : ↑x - 0 ∈ I ↔ _),
  rw sub_zero,
  exact ⟨h x, λ h', h'.symm ▸ I.zero_mem⟩,
end⟩

end char_p

lemma ideal.quotient.index_eq_zero {R : Type*} [comm_ring R] (I : ideal R) :
  (I.to_add_subgroup.index : R ⧸ I) = 0 :=
begin
  rw [add_subgroup.index, nat.card_eq],
  split_ifs with hq, swap, simp,
  by_contra h,
  -- TODO: can we avoid rewriting the `I.to_add_subgroup` here?
  letI : fintype (R ⧸ I) := @fintype.of_finite _ hq,
  have h : (fintype.card (R ⧸ I) : R ⧸ I) ≠ 0 := h,
  simpa using h
end