/-
Copyright (c) 2021 James Arthur, Benjamin Davidson, Andrew Souther. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: James Arthur, Benjamin Davidson, Andrew Souther
-/
import measure_theory.integral.interval_integral
import analysis.special_functions.sqrt
import analysis.special_functions.trigonometric.inverse_deriv

/-!
# Freek № 9: The Area of a Circle

In this file we show that the area of a disc with nonnegative radius `r` is `π * r^2`. The main
tools our proof uses are `volume_region_between_eq_integral`, which allows us to represent the area
of the disc as an integral, and `interval_integral.integral_eq_sub_of_has_deriv_at'_of_le`, the
second fundamental theorem of calculus.

We begin by defining `disc` in `ℝ × ℝ`, then show that `disc` can be represented as the
`region_between` two functions.

Though not necessary for the main proof, we nonetheless choose to include a proof of the
measurability of the disc in order to convince the reader that the set whose volume we will be
calculating is indeed measurable and our result is therefore meaningful.

In the main proof, `area_disc`, we use `volume_region_between_eq_integral` followed by
`interval_integral.integral_of_le` to reduce our goal to a single `interval_integral`:
  `∫ (x : ℝ) in -r..r, 2 * sqrt (r ^ 2 - x ^ 2) = π * r ^ 2`.
After disposing of the trivial case `r = 0`, we show that `λ x, 2 * sqrt (r ^ 2 - x ^ 2)` is equal
to the derivative of `λ x, r ^ 2 * arcsin (x / r) + x * sqrt (r ^ 2 - x ^ 2)` everywhere on
`Ioo (-r) r` and that those two functions are continuous, then apply the second fundamental theorem
of calculus with those facts. Some simple algebra then completes the proof.

Note that we choose to define `disc` as a set of points in `ℝ × ℝ`. This is admittedly not ideal; it
would be more natural to define `disc` as a `metric.ball` in `euclidean_space ℝ (fin 2)` (as well as
to provide a more general proof in higher dimensions). However, our proof indirectly relies on a
number of theorems (particularly `measure_theory.measure.prod_apply`) which do not yet exist for
Euclidean space, thus forcing us to use this less-preferable definition. As `measure_theory.pi`
continues to develop, it should eventually become possible to redefine `disc` and extend our proof
to the n-ball.
-/

open set real measure_theory interval_integral
open_locale real nnreal

/-- A disc of radius `r` is defined as the collection of points `(p.1, p.2)` in `ℝ × ℝ` such that
  `p.1 ^ 2 + p.2 ^ 2 < r ^ 2`.
  Note that this definition is not equivalent to `metric.ball (0 : ℝ × ℝ) r`. This was done
  intentionally because `dist` in `ℝ × ℝ` is defined as the uniform norm, making the `metric.ball`
  in `ℝ × ℝ` a square, not a disc.
  See the module docstring for an explanation of why we don't define the disc in Euclidean space. -/
def disc (r : ℝ) := {p : ℝ × ℝ | p.1 ^ 2 + p.2 ^ 2 < r ^ 2}

variable (r : ℝ≥0)

/-- A disc of radius `r` can be represented as the region between the two curves
  `λ x, - sqrt (r ^ 2 - x ^ 2)` and `λ x, sqrt (r ^ 2 - x ^ 2)`. -/
lemma disc_eq_region_between :
  disc r = region_between (λ x, -sqrt (r^2 - x^2)) (λ x, sqrt (r^2 - x^2)) (Ioc (-r) r) :=
begin
  ext p,
  simp only [disc, region_between, mem_set_of_eq, mem_Ioo, mem_Ioc, pi.neg_apply],
  split;
  intro h,
  { cases abs_lt_of_sq_lt_sq' (lt_of_add_lt_of_nonneg_left h (sq_nonneg p.2)) r.2,
    rw [add_comm, ← lt_sub_iff_add_lt] at h,
    exact ⟨⟨left, right.le⟩, sq_lt.mp h⟩ },
  { rw [add_comm, ← lt_sub_iff_add_lt],
    exact sq_lt.mpr h.2 },
end

/-- The disc is a `measurable_set`. -/
theorem measurable_set_disc : measurable_set (disc r) :=
by apply measurable_set_lt; apply continuous.measurable; continuity

/-- **Area of a Circle**: The area of a disc with radius `r` is `π * r ^ 2`. -/
theorem area_disc : volume (disc r) = nnreal.pi * r ^ 2 :=
begin
  let f := λ x, sqrt (r ^ 2 - x ^ 2),
  let F := λ x, (r:ℝ) ^ 2 * arcsin (r⁻¹ * x) + x * sqrt (r ^ 2 - x ^ 2),
  have hf : continuous f := by continuity,
  suffices : ∫ x in -r..r, 2 * f x = nnreal.pi * r ^ 2,
  { have h : integrable_on f (Ioc (-r) r) :=
      hf.integrable_on_Icc.mono_set Ioc_subset_Icc_self,
    calc  volume (disc r)
        = volume (region_between (λ x, -f x) f (Ioc (-r) r)) : by rw disc_eq_region_between
    ... = ennreal.of_real (∫ x in Ioc (-r:ℝ) r, (f - has_neg.neg ∘ f) x) :
          volume_region_between_eq_integral
            h.neg h measurable_set_Ioc (λ x hx, neg_le_self (sqrt_nonneg _))
    ... = ennreal.of_real (∫ x in (-r:ℝ)..r, 2 * f x) : by simp [two_mul, integral_of_le]
    ... = nnreal.pi * r ^ 2 : by rw_mod_cast [this, ← ennreal.coe_nnreal_eq], },
  obtain ⟨hle, (heq | hlt)⟩ := ⟨nnreal.coe_nonneg r, hle.eq_or_lt⟩, { simp [← heq] },
  have hderiv : ∀ x ∈ Ioo (-r:ℝ) r, has_deriv_at F (2 * f x) x,
  { rintros x ⟨hx1, hx2⟩,
    convert ((has_deriv_at_const x ((r:ℝ)^2)).mul ((has_deriv_at_arcsin _ _).comp x
      ((has_deriv_at_const x (r:ℝ)⁻¹).mul (has_deriv_at_id' x)))).add
        ((has_deriv_at_id' x).mul ((((has_deriv_at_id' x).pow 2).const_sub ((r:ℝ)^2)).sqrt _)),
    { have h : sqrt (1 - x ^ 2 / r ^ 2) * r = sqrt (r ^ 2 - x ^ 2),
      { rw [← sqrt_sq hle, ← sqrt_mul, sub_mul, sqrt_sq hle, mul_comm_div,
            div_self (pow_ne_zero 2 hlt.ne'), one_mul, mul_one],
        simpa [sqrt_sq hle, div_le_one (pow_pos hlt 2)] using sq_le_sq' hx1.le hx2.le },
      field_simp,
      rw [h, mul_left_comm, ← sq, neg_mul_eq_mul_neg, mul_div_mul_left (-x^2) _ two_ne_zero,
          add_left_comm, div_add_div_same, tactic.ring.add_neg_eq_sub, div_sqrt, two_mul] },
    { suffices : -(1:ℝ) < r⁻¹ * x, by exact this.ne',
      calc -(1:ℝ) = r⁻¹ * -r : by simp [hlt.ne']
              ... < r⁻¹ * x : by nlinarith [inv_pos.mpr hlt] },
    { suffices : (r:ℝ)⁻¹ * x < 1, by exact this.ne,
      calc (r:ℝ)⁻¹ * x < r⁻¹ * r : by nlinarith [inv_pos.mpr hlt]
                   ... = 1 : inv_mul_cancel hlt.ne' },
    { nlinarith } },
  have hcont := (by continuity : continuous F).continuous_on,
  calc  ∫ x in -r..r, 2 * f x
      = F r - F (-r) : integral_eq_sub_of_has_deriv_at_of_le (neg_le_self r.2)
                         hcont hderiv (continuous_const.mul hf).continuous_on.interval_integrable
  ... = nnreal.pi * r ^ 2 : by norm_num [F, inv_mul_cancel hlt.ne', ← mul_div_assoc, mul_comm π],
end


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov

! This file was ported from Lean 3 source module data.real.conjugate_exponents
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Real.ENNReal

/-!
# Real conjugate exponents

`p.IsConjugateExponent q` registers the fact that the real numbers `p` and `q` are `> 1` and
satisfy `1/p + 1/q = 1`. This property shows up often in analysis, especially when dealing with
`L^p` spaces.

We make several basic facts available through dot notation in this situation.

We also introduce `p.conjugateExponent` for `p / (p-1)`. When `p > 1`, it is conjugate to `p`.
-/

noncomputable section

namespace Real

/-- Two real exponents `p, q` are conjugate if they are `> 1` and satisfy the equality
`1/p + 1/q = 1`. This condition shows up in many theorems in analysis, notably related to `L^p`
norms. -/
structure IsConjugateExponent (p q : ℝ) : Prop where
  one_lt : 1 < p
  inv_add_inv_conj : 1 / p + 1 / q = 1
#align real.is_conjugate_exponent Real.IsConjugateExponent

/-- The conjugate exponent of `p` is `q = p/(p-1)`, so that `1/p + 1/q = 1`. -/
def conjugateExponent (p : ℝ) : ℝ := p / (p - 1)
#align real.conjugate_exponent Real.conjugateExponent

namespace IsConjugateExponent

variable {p q : ℝ} (h : p.IsConjugateExponent q)

/- Register several non-vanishing results following from the fact that `p` has a conjugate exponent
`q`: many computations using these exponents require clearing out denominators, which can be done
with `field_simp` given a proof that these denominators are non-zero, so we record the most usual
ones. -/
theorem pos : 0 < p := lt_trans zero_lt_one h.one_lt
#align real.is_conjugate_exponent.pos Real.IsConjugateExponent.pos

theorem nonneg : 0 ≤ p := le_of_lt h.pos
#align real.is_conjugate_exponent.nonneg Real.IsConjugateExponent.nonneg

theorem ne_zero : p ≠ 0 := ne_of_gt h.pos
#align real.is_conjugate_exponent.ne_zero Real.IsConjugateExponent.ne_zero

theorem sub_one_pos : 0 < p - 1 := sub_pos.2 h.one_lt
#align real.is_conjugate_exponent.sub_one_pos Real.IsConjugateExponent.sub_one_pos

theorem sub_one_ne_zero : p - 1 ≠ 0 := ne_of_gt h.sub_one_pos
#align real.is_conjugate_exponent.sub_one_ne_zero Real.IsConjugateExponent.sub_one_ne_zero

theorem one_div_pos : 0 < 1 / p := _root_.one_div_pos.2 h.pos
#align real.is_conjugate_exponent.one_div_pos Real.IsConjugateExponent.one_div_pos

theorem one_div_nonneg : 0 ≤ 1 / p := le_of_lt h.one_div_pos
#align real.is_conjugate_exponent.one_div_nonneg Real.IsConjugateExponent.one_div_nonneg

theorem one_div_ne_zero : 1 / p ≠ 0 := ne_of_gt h.one_div_pos
#align real.is_conjugate_exponent.one_div_ne_zero Real.IsConjugateExponent.one_div_ne_zero

theorem conj_eq : q = p / (p - 1) := by
  have := h.inv_add_inv_conj
  rw [← eq_sub_iff_add_eq', one_div, inv_eq_iff_eq_inv] at this
  field_simp [this, h.ne_zero]
#align real.is_conjugate_exponent.conj_eq Real.IsConjugateExponent.conj_eq

theorem conjugate_eq : conjugateExponent p = q := h.conj_eq.symm
#align real.is_conjugate_exponent.conjugate_eq Real.IsConjugateExponent.conjugate_eq

theorem sub_one_mul_conj : (p - 1) * q = p :=
  mul_comm q (p - 1) ▸ (eq_div_iff h.sub_one_ne_zero).1 h.conj_eq
#align real.is_conjugate_exponent.sub_one_mul_conj Real.IsConjugateExponent.sub_one_mul_conj

theorem mul_eq_add : p * q = p + q := by
  simpa only [sub_mul, sub_eq_iff_eq_add, one_mul] using h.sub_one_mul_conj
#align real.is_conjugate_exponent.mul_eq_add Real.IsConjugateExponent.mul_eq_add

@[symm]
protected theorem symm : q.IsConjugateExponent p :=
  { one_lt := by
      rw [h.conj_eq]
      exact (one_lt_div h.sub_one_pos).mpr (sub_one_lt p)
    inv_add_inv_conj := by simpa [add_comm] using h.inv_add_inv_conj }
#align real.is_conjugate_exponent.symm Real.IsConjugateExponent.symm

theorem div_conj_eq_sub_one : p / q = p - 1 := by
  field_simp [h.symm.ne_zero]
  rw [h.sub_one_mul_conj]
#align real.is_conjugate_exponent.div_conj_eq_sub_one Real.IsConjugateExponent.div_conj_eq_sub_one

theorem one_lt_nNReal : 1 < Real.toNNReal p := by
  rw [← Real.toNNReal_one, Real.toNNReal_lt_toNNReal_iff h.pos]
  exact h.one_lt
#align real.is_conjugate_exponent.one_lt_nnreal Real.IsConjugateExponent.one_lt_nNReal

theorem inv_add_inv_conj_nNReal : 1 / Real.toNNReal p + 1 / Real.toNNReal q = 1 := by
  rw [← Real.toNNReal_one, ← Real.toNNReal_div' h.nonneg, ← Real.toNNReal_div' h.symm.nonneg,
      ← Real.toNNReal_add h.one_div_nonneg h.symm.one_div_nonneg, h.inv_add_inv_conj]
#align real.is_conjugate_exponent.inv_add_inv_conj_nnreal Real.IsConjugateExponent.inv_add_inv_conj_nNReal

theorem inv_add_inv_conj_ennreal : 1 / ENNReal.ofReal p + 1 / ENNReal.ofReal q = 1 := by
  rw [← ENNReal.ofReal_one, ← ENNReal.ofReal_div_of_pos h.pos,
      ← ENNReal.ofReal_div_of_pos h.symm.pos,
      ← ENNReal.ofReal_add h.one_div_nonneg h.symm.one_div_nonneg, h.inv_add_inv_conj]
#align real.is_conjugate_exponent.inv_add_inv_conj_ennreal Real.IsConjugateExponent.inv_add_inv_conj_ennreal

end IsConjugateExponent

theorem isConjugateExponent_iff {p q : ℝ} (h : 1 < p) : p.IsConjugateExponent q ↔ q = p / (p - 1) :=
  ⟨fun H => H.conj_eq, fun H => ⟨h, by field_simp [H, ne_of_gt (lt_trans zero_lt_one h)] ⟩⟩
#align real.is_conjugate_exponent_iff Real.isConjugateExponent_iff

theorem isConjugateExponent_conjugateExponent {p : ℝ} (h : 1 < p) :
    p.IsConjugateExponent (conjugateExponent p) := (isConjugateExponent_iff h).2 rfl
#align real.is_conjugate_exponent_conjugate_exponent Real.isConjugateExponent_conjugateExponent

theorem isConjugateExponent_one_div {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) :
    (1 / a).IsConjugateExponent (1 / b) :=
  ⟨by rw [lt_div_iff ha, one_mul]; linarith,
   by simp_rw [one_div_one_div]; exact hab⟩
#align real.is_conjugate_exponent_one_div Real.isConjugateExponent_one_div

end Real


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Isometries of emetric and metric spaces
Authors: Sébastien Gouëzel
-/
import topology.metric_space.antilipschitz

/-!
# Isometries

We define isometries, i.e., maps between emetric spaces that preserve
the edistance (on metric spaces, these are exactly the maps that preserve distances),
and prove their basic properties. We also introduce isometric bijections.

Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the
theory for `pseudo_metric_space` and we specialize to `metric_space` when needed.
-/

noncomputable theory

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

open function set
open_locale topological_space ennreal

/-- An isometry (also known as isometric embedding) is a map preserving the edistance
between pseudoemetric spaces, or equivalently the distance between pseudometric space.  -/
def isometry [pseudo_emetric_space α] [pseudo_emetric_space β] (f : α → β) : Prop :=
∀x1 x2 : α, edist (f x1) (f x2) = edist x1 x2

/-- On pseudometric spaces, a map is an isometry if and only if it preserves distances. -/
lemma isometry_emetric_iff_metric [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β} :
  isometry f ↔ (∀x y, dist (f x) (f y) = dist x y) :=
⟨assume H x y, by simp [dist_edist, H x y],
assume H x y, by simp [edist_dist, H x y]⟩

/-- An isometry preserves edistances. -/
theorem isometry.edist_eq [pseudo_emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (hf : isometry f) (x y : α) : edist (f x) (f y) = edist x y :=
hf x y

/-- An isometry preserves distances. -/
theorem isometry.dist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
  (hf : isometry f) (x y : α) : dist (f x) (f y) = dist x y :=
by rw [dist_edist, dist_edist, hf]

section pseudo_emetric_isometry

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {f : α → β} {x y z : α}  {s : set α}

lemma isometry.lipschitz (h : isometry f) : lipschitz_with 1 f :=
lipschitz_with.of_edist_le $ λ x y, le_of_eq (h x y)

lemma isometry.antilipschitz (h : isometry f) : antilipschitz_with 1 f :=
λ x y, by simp only [h x y, ennreal.coe_one, one_mul, le_refl]

/-- An isometry from an emetric space is injective -/
lemma isometry.injective {α : Type u} [emetric_space α] {f : α → β} (h : isometry f) :
  injective f := h.antilipschitz.injective

/-- Any map on a subsingleton is an isometry -/
theorem isometry_subsingleton [subsingleton α] : isometry f :=
λx y, by rw subsingleton.elim x y; simp

/-- The identity is an isometry -/
lemma isometry_id : isometry (id : α → α) :=
λx y, rfl

/-- The composition of isometries is an isometry -/
theorem isometry.comp {g : β → γ} {f : α → β} (hg : isometry g) (hf : isometry f) :
  isometry (g ∘ f) :=
assume x y, calc
  edist ((g ∘ f) x) ((g ∘ f) y) = edist (f x) (f y) : hg _ _
                            ... = edist x y : hf _ _

/-- An isometry from a metric space is a uniform inducing map -/
theorem isometry.uniform_inducing (hf : isometry f) :
  uniform_inducing f :=
hf.antilipschitz.uniform_inducing hf.lipschitz.uniform_continuous

lemma isometry.tendsto_nhds_iff {ι : Type*} {f : α → β}
  {g : ι → α} {a : filter ι} {b : α} (hf : isometry f) :
  filter.tendsto g a (𝓝 b) ↔ filter.tendsto (f ∘ g) a (𝓝 (f b)) :=
hf.uniform_inducing.inducing.tendsto_nhds_iff

/-- An isometry is continuous. -/
lemma isometry.continuous (hf : isometry f) : continuous f :=
hf.lipschitz.continuous

/-- The right inverse of an isometry is an isometry. -/
lemma isometry.right_inv {f : α → β} {g : β → α} (h : isometry f) (hg : right_inverse g f) :
  isometry g :=
λ x y, by rw [← h, hg _, hg _]

/-- Isometries preserve the diameter in pseudoemetric spaces. -/
lemma isometry.ediam_image (hf : isometry f) (s : set α) :
  emetric.diam (f '' s) = emetric.diam s :=
eq_of_forall_ge_iff $ λ d,
by simp only [emetric.diam_le_iff, ball_image_iff, hf.edist_eq]

lemma isometry.ediam_range (hf : isometry f) :
  emetric.diam (range f) = emetric.diam (univ : set α) :=
by { rw ← image_univ, exact hf.ediam_image univ }

lemma isometry.maps_to_emetric_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
  maps_to f (emetric.ball x r) (emetric.ball (f x) r) :=
λ y hy, by rwa [emetric.mem_ball, hf]

lemma isometry.maps_to_emetric_closed_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
  maps_to f (emetric.closed_ball x r) (emetric.closed_ball (f x) r) :=
λ y hy, by rwa [emetric.mem_closed_ball, hf]

/-- The injection from a subtype is an isometry -/
lemma isometry_subtype_coe {s : set α} : isometry (coe : s → α) :=
λx y, rfl

lemma isometry.comp_continuous_on_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α}
  {s : set γ} :
  continuous_on (f ∘ g) s ↔ continuous_on g s :=
hf.uniform_inducing.inducing.continuous_on_iff.symm

lemma isometry.comp_continuous_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α} :
  continuous (f ∘ g) ↔ continuous g :=
hf.uniform_inducing.inducing.continuous_iff.symm

end pseudo_emetric_isometry --section

section emetric_isometry
variables [emetric_space α]

/-- An isometry from a metric space is a uniform embedding -/
theorem isometry.uniform_embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
  uniform_embedding f :=
hf.antilipschitz.uniform_embedding hf.lipschitz.uniform_continuous

/-- An isometry from a metric space is an embedding -/
theorem isometry.embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
  embedding f :=
hf.uniform_embedding.embedding

/-- An isometry from a complete emetric space is a closed embedding -/
theorem isometry.closed_embedding [complete_space α] [emetric_space β]
  {f : α → β} (hf : isometry f) : closed_embedding f :=
hf.antilipschitz.closed_embedding hf.lipschitz.uniform_continuous

end emetric_isometry --section

namespace isometry

variables [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}

/-- An isometry preserves the diameter in pseudometric spaces. -/
lemma diam_image (hf : isometry f) (s : set α) : metric.diam (f '' s) = metric.diam s :=
by rw [metric.diam, metric.diam, hf.ediam_image]

lemma diam_range (hf : isometry f) : metric.diam (range f) = metric.diam (univ : set α) :=
by { rw ← image_univ, exact hf.diam_image univ }

lemma maps_to_ball (hf : isometry f) (x : α) (r : ℝ) :
  maps_to f (metric.ball x r) (metric.ball (f x) r) :=
λ y hy, by rwa [metric.mem_ball, hf.dist_eq]

lemma maps_to_sphere (hf : isometry f) (x : α) (r : ℝ) :
  maps_to f (metric.sphere x r) (metric.sphere (f x) r) :=
λ y hy, by rwa [metric.mem_sphere, hf.dist_eq]

lemma maps_to_closed_ball (hf : isometry f) (x : α) (r : ℝ) :
  maps_to f (metric.closed_ball x r) (metric.closed_ball (f x) r) :=
λ y hy, by rwa [metric.mem_closed_ball, hf.dist_eq]

end isometry

/-- `α` and `β` are isometric if there is an isometric bijection between them. -/
@[nolint has_inhabited_instance] -- such a bijection need not exist
structure isometric (α : Type*) (β : Type*) [pseudo_emetric_space α] [pseudo_emetric_space β]
  extends α ≃ β :=
(isometry_to_fun  : isometry to_fun)

infix ` ≃ᵢ `:25 := isometric

namespace isometric

section pseudo_emetric_space
variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]

instance : has_coe_to_fun (α ≃ᵢ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩

lemma coe_eq_to_equiv (h : α ≃ᵢ β) (a : α) : h a = h.to_equiv a := rfl

@[simp] lemma coe_to_equiv (h : α ≃ᵢ β) : ⇑h.to_equiv = h := rfl

protected lemma isometry (h : α ≃ᵢ β) : isometry h := h.isometry_to_fun

protected lemma bijective (h : α ≃ᵢ β) : bijective h := h.to_equiv.bijective
protected lemma injective (h : α ≃ᵢ β) : injective h := h.to_equiv.injective
protected lemma surjective (h : α ≃ᵢ β) : surjective h := h.to_equiv.surjective

protected lemma edist_eq (h : α ≃ᵢ β) (x y : α) : edist (h x) (h y) = edist x y :=
h.isometry.edist_eq x y

protected lemma dist_eq {α β : Type*} [pseudo_metric_space α] [pseudo_metric_space β] (h : α ≃ᵢ β)
  (x y : α) : dist (h x) (h y) = dist x y :=
h.isometry.dist_eq x y

protected lemma continuous (h : α ≃ᵢ β) : continuous h := h.isometry.continuous

@[simp] lemma ediam_image (h : α ≃ᵢ β) (s : set α) : emetric.diam (h '' s) = emetric.diam s :=
h.isometry.ediam_image s

lemma to_equiv_inj : ∀ ⦃h₁ h₂ : α ≃ᵢ β⦄, (h₁.to_equiv = h₂.to_equiv) → h₁ = h₂
| ⟨e₁, h₁⟩ ⟨e₂, h₂⟩ H := by { dsimp at H, subst e₁ }

@[ext] lemma ext ⦃h₁ h₂ : α ≃ᵢ β⦄ (H : ∀ x, h₁ x = h₂ x) : h₁ = h₂ :=
to_equiv_inj $ equiv.ext H

/-- Alternative constructor for isometric bijections,
taking as input an isometry, and a right inverse. -/
def mk' {α : Type u} [emetric_space α] (f : α → β) (g : β → α) (hfg : ∀ x, f (g x) = x)
  (hf : isometry f) : α ≃ᵢ β :=
{ to_fun := f,
  inv_fun := g,
  left_inv := λ x, hf.injective $ hfg _,
  right_inv := hfg,
  isometry_to_fun := hf }

/-- The identity isometry of a space. -/
protected def refl (α : Type*) [pseudo_emetric_space α] : α ≃ᵢ α :=
{ isometry_to_fun := isometry_id, .. equiv.refl α }

/-- The composition of two isometric isomorphisms, as an isometric isomorphism. -/
protected def trans (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) : α ≃ᵢ γ :=
{ isometry_to_fun  := h₂.isometry_to_fun.comp h₁.isometry_to_fun,
  .. equiv.trans h₁.to_equiv h₂.to_equiv }

@[simp] lemma trans_apply (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : α) : h₁.trans h₂ x = h₂ (h₁ x) := rfl

/-- The inverse of an isometric isomorphism, as an isometric isomorphism. -/
protected def symm (h : α ≃ᵢ β) : β ≃ᵢ α :=
{ isometry_to_fun  := h.isometry.right_inv h.right_inv,
  to_equiv := h.to_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ᵢ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ᵢ β) : β → α := h.symm

initialize_simps_projections isometric
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply)

@[simp] lemma symm_symm (h : α ≃ᵢ β) : h.symm.symm = h := to_equiv_inj h.to_equiv.symm_symm

@[simp] lemma apply_symm_apply (h : α ≃ᵢ β) (y : β) : h (h.symm y) = y :=
h.to_equiv.apply_symm_apply y

@[simp] lemma symm_apply_apply (h : α ≃ᵢ β) (x : α) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

lemma symm_apply_eq (h : α ≃ᵢ β) {x : α} {y : β} :
  h.symm y = x ↔ y = h x :=
h.to_equiv.symm_apply_eq

lemma eq_symm_apply (h : α ≃ᵢ β) {x : α} {y : β} :
  x = h.symm y ↔ h x = y :=
h.to_equiv.eq_symm_apply

lemma symm_comp_self (h : α ≃ᵢ β) : ⇑h.symm ∘ ⇑h = id :=
funext $ assume a, h.to_equiv.left_inv a

lemma self_comp_symm (h : α ≃ᵢ β) : ⇑h ∘ ⇑h.symm = id :=
funext $ assume a, h.to_equiv.right_inv a

@[simp] lemma range_eq_univ (h : α ≃ᵢ β) : range h = univ :=
h.to_equiv.range_eq_univ

lemma image_symm (h : α ≃ᵢ β) : image h.symm = preimage h :=
image_eq_preimage_of_inverse h.symm.to_equiv.left_inv h.symm.to_equiv.right_inv

lemma preimage_symm (h : α ≃ᵢ β) : preimage h.symm = image h :=
(image_eq_preimage_of_inverse h.to_equiv.left_inv h.to_equiv.right_inv).symm

@[simp] lemma symm_trans_apply (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : γ) :
  (h₁.trans h₂).symm x = h₁.symm (h₂.symm x) := rfl

lemma ediam_univ (h : α ≃ᵢ β) : emetric.diam (univ : set α) = emetric.diam (univ : set β) :=
by rw [← h.range_eq_univ, h.isometry.ediam_range]

@[simp] lemma ediam_preimage (h : α ≃ᵢ β) (s : set β) : emetric.diam (h ⁻¹' s) = emetric.diam s :=
by rw [← image_symm, ediam_image]

@[simp] lemma preimage_emetric_ball (h : α ≃ᵢ β) (x : β) (r : ℝ≥0∞) :
  h ⁻¹' (emetric.ball x r) = emetric.ball (h.symm x) r :=
by { ext y, simp [← h.edist_eq] }

@[simp] lemma preimage_emetric_closed_ball (h : α ≃ᵢ β) (x : β) (r : ℝ≥0∞) :
  h ⁻¹' (emetric.closed_ball x r) = emetric.closed_ball (h.symm x) r :=
by { ext y, simp [← h.edist_eq] }

@[simp] lemma image_emetric_ball (h : α ≃ᵢ β) (x : α) (r : ℝ≥0∞) :
  h '' (emetric.ball x r) = emetric.ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_emetric_ball, symm_symm]

@[simp] lemma image_emetric_closed_ball (h : α ≃ᵢ β) (x : α) (r : ℝ≥0∞) :
  h '' (emetric.closed_ball x r) = emetric.closed_ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_emetric_closed_ball, symm_symm]

/-- The (bundled) homeomorphism associated to an isometric isomorphism. -/
@[simps to_equiv] protected def to_homeomorph (h : α ≃ᵢ β) : α ≃ₜ β :=
{ continuous_to_fun  := h.continuous,
  continuous_inv_fun := h.symm.continuous,
  to_equiv := h.to_equiv }

@[simp] lemma coe_to_homeomorph (h : α ≃ᵢ β) : ⇑(h.to_homeomorph) = h := rfl

@[simp] lemma coe_to_homeomorph_symm (h : α ≃ᵢ β) : ⇑(h.to_homeomorph.symm) = h.symm := rfl

@[simp] lemma comp_continuous_on_iff {γ} [topological_space γ] (h : α ≃ᵢ β)
  {f : γ → α} {s : set γ} :
  continuous_on (h ∘ f) s ↔ continuous_on f s :=
h.to_homeomorph.comp_continuous_on_iff _ _

@[simp] lemma comp_continuous_iff {γ} [topological_space γ] (h : α ≃ᵢ β) {f : γ → α} :
  continuous (h ∘ f) ↔ continuous f :=
h.to_homeomorph.comp_continuous_iff

@[simp] lemma comp_continuous_iff' {γ} [topological_space γ] (h : α ≃ᵢ β) {f : β → γ} :
  continuous (f ∘ h) ↔ continuous f :=
h.to_homeomorph.comp_continuous_iff'

/-- The group of isometries. -/
instance : group (α ≃ᵢ α) :=
  { one := isometric.refl _,
    mul := λ e₁ e₂, e₂.trans e₁,
    inv := isometric.symm,
    mul_assoc := λ e₁ e₂ e₃, rfl,
    one_mul := λ e, ext $ λ _, rfl,
    mul_one := λ e, ext $ λ _, rfl,
    mul_left_inv := λ e, ext e.symm_apply_apply }

@[simp] lemma coe_one : ⇑(1 : α ≃ᵢ α) = id := rfl

@[simp] lemma coe_mul (e₁ e₂ : α ≃ᵢ α) : ⇑(e₁ * e₂) = e₁ ∘ e₂ := rfl

lemma mul_apply (e₁ e₂ : α ≃ᵢ α) (x : α) : (e₁ * e₂) x = e₁ (e₂ x) := rfl

@[simp] lemma inv_apply_self (e : α ≃ᵢ α) (x: α) : e⁻¹ (e x) = x := e.symm_apply_apply x

@[simp] lemma apply_inv_self (e : α ≃ᵢ α) (x: α) : e (e⁻¹ x) = x := e.apply_symm_apply x

protected lemma complete_space [complete_space β] (e : α ≃ᵢ β) : complete_space α :=
complete_space_of_is_complete_univ $ is_complete_of_complete_image e.isometry.uniform_inducing $
  by rwa [set.image_univ, isometric.range_eq_univ, ← complete_space_iff_is_complete_univ]

lemma complete_space_iff (e : α ≃ᵢ β) : complete_space α ↔ complete_space β :=
by { split; introI H, exacts [e.symm.complete_space, e.complete_space] }

end pseudo_emetric_space

section pseudo_metric_space

variables [pseudo_metric_space α] [pseudo_metric_space β] (h : α ≃ᵢ β)

@[simp] lemma diam_image (s : set α) : metric.diam (h '' s) = metric.diam s :=
h.isometry.diam_image s

@[simp] lemma diam_preimage (s : set β) : metric.diam (h ⁻¹' s) = metric.diam s :=
by rw [← image_symm, diam_image]

lemma diam_univ : metric.diam (univ : set α) = metric.diam (univ : set β) :=
congr_arg ennreal.to_real h.ediam_univ

@[simp] lemma preimage_ball (h : α ≃ᵢ β) (x : β) (r : ℝ) :
  h ⁻¹' (metric.ball x r) = metric.ball (h.symm x) r :=
by { ext y, simp [← h.dist_eq] }

@[simp] lemma preimage_sphere (h : α ≃ᵢ β) (x : β) (r : ℝ) :
  h ⁻¹' (metric.sphere x r) = metric.sphere (h.symm x) r :=
by { ext y, simp [← h.dist_eq] }

@[simp] lemma preimage_closed_ball (h : α ≃ᵢ β) (x : β) (r : ℝ) :
  h ⁻¹' (metric.closed_ball x r) = metric.closed_ball (h.symm x) r :=
by { ext y, simp [← h.dist_eq] }

@[simp] lemma image_ball (h : α ≃ᵢ β) (x : α) (r : ℝ) :
  h '' (metric.ball x r) = metric.ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_ball, symm_symm]

@[simp] lemma image_sphere (h : α ≃ᵢ β) (x : α) (r : ℝ) :
  h '' (metric.sphere x r) = metric.sphere (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_sphere, symm_symm]

@[simp] lemma image_closed_ball (h : α ≃ᵢ β) (x : α) (r : ℝ) :
  h '' (metric.closed_ball x r) = metric.closed_ball (h x) r :=
by rw [← h.preimage_symm, h.symm.preimage_closed_ball, symm_symm]

end pseudo_metric_space

end isometric

/-- An isometry induces an isometric isomorphism between the source space and the
range of the isometry. -/
@[simps to_equiv apply { simp_rhs := tt }]
def isometry.isometric_on_range [emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (h : isometry f) : α ≃ᵢ range f :=
{ isometry_to_fun := λx y, by simpa [subtype.edist_eq] using h x y,
  to_equiv := equiv.of_injective f h.injective }


/-
# References

1. Avigad, Jeremy. ‘Theorem Proving in Lean’, n.d.
-/

-- Exercise 1
--
-- Open a namespace `Hidden` to avoid naming conflicts, and use the equation
-- compiler to define addition, multiplication, and exponentiation on the
-- natural numbers. Then use the equation compiler to derive some of their basic
-- properties.
namespace ex1

def add : Nat → Nat → Nat
  | m, Nat.zero   => m
  | m, Nat.succ n => Nat.succ (add m n)

def mul : Nat → Nat → Nat
  | _, Nat.zero => 0
  | m, Nat.succ n => add m (mul m n)

def exp : Nat → Nat → Nat
  | _, Nat.zero => 1
  | m, Nat.succ n => mul m (exp m n)

end ex1

-- Exercise 2
--
-- Similarly, use the equation compiler to define some basic operations on lists
-- (like the reverse function) and prove theorems about lists by induction (such
-- as the fact that `reverse (reverse xs) = xs` for any list `xs`).
namespace ex2

variable {α : Type _}

def reverse : List α → List α
  | [] => []
  | (head :: tail) => reverse tail ++ [head]

-- Proof of `reverse (reverse xs) = xs` shown in previous exercise.

end ex2

-- Exercise 3
--
-- Define your own function to carry out course-of-value recursion on the
-- natural numbers. Similarly, see if you can figure out how to define
-- `WellFounded.fix` on your own.
namespace ex3

def below {motive : Nat → Type} : Nat → Type
  | Nat.zero => PUnit
  | Nat.succ n => PProd (PProd (motive n) (@below motive n)) (PUnit : Type)

-- TODO: Sort out how to write `brecOn` and `WellFounded.fix`.

end ex3

-- Exercise 4
--
-- Following the examples in Section Dependent Pattern Matching, define a
-- function that will append two vectors. This is tricky; you will have to
-- define an auxiliary function.
namespace ex4

inductive Vector (α : Type u) : Nat → Type u
  | nil  : Vector α 0
  | cons : α → {n : Nat} → Vector α n → Vector α (n + 1)

namespace Vector

-- TODO: Sort out how to write `append`.

end Vector

end ex4

-- Exercise 5
--
-- Consider the following type of arithmetic expressions. The idea is that
-- `var n` is a variable, `vₙ`, and `const n` is the constant whose value is
-- `n`.
namespace ex5

inductive Expr where
  | const : Nat → Expr
  | var : Nat → Expr
  | plus : Expr → Expr → Expr
  | times : Expr → Expr → Expr
  deriving Repr

open Expr

def sampleExpr : Expr :=
  plus (times (var 0) (const 7)) (times (const 2) (var 1))

-- Here `sampleExpr` represents `(v₀ * 7) + (2 * v₁)`. Write a function that
-- evaluates such an expression, evaluating each `var n` to `v n`.

def eval (v : Nat → Nat) : Expr → Nat
  | const n     => sorry
  | var n       => v n
  | plus e₁ e₂  => sorry
  | times e₁ e₂ => sorry

def sampleVal : Nat → Nat
  | 0 => 5
  | 1 => 6
  | _ => 0

-- Try it out. You should get 47 here.
-- #eval eval sampleVal sampleExpr

-- Implement "constant fusion," a procedure that simplifies subterms like
-- `5 + 7` to `12`. Using the auxiliary function `simpConst`, define a function
-- "fuse": to simplify a plus or a times, first simplify the arguments
-- recursively, and then apply `simpConst` to try to simplify the result.

def simpConst : Expr → Expr
  | plus (const n₁) (const n₂)  => const (n₁ + n₂)
  | times (const n₁) (const n₂) => const (n₁ * n₂)
  | e                           => e

def fuse : Expr → Expr := sorry

theorem simpConst_eq (v : Nat → Nat)
        : ∀ e : Expr, eval v (simpConst e) = eval v e :=
  sorry

theorem fuse_eq (v : Nat → Nat)
        : ∀ e : Expr, eval v (fuse e) = eval v e :=
  sorry

-- The last two theorems show that the definitions preserve the value.

end ex5


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import group_theory.order_of_element
import algebra.punit_instances
import algebra.gcd_monoid.finset
import tactic.by_contra
import number_theory.padics.padic_norm

/-!
# Exponent of a group

This file defines the exponent of a group, or more generally a monoid. For a group `G` it is defined
to be the minimal `n≥1` such that `g ^ n = 1` for all `g ∈ G`. For a finite group `G`,
it is equal to the lowest common multiple of the order of all elements of the group `G`.

## Main definitions

* `monoid.exponent_exists` is a predicate on a monoid `G` saying that there is some positive `n`
  such that `g ^ n = 1` for all `g ∈ G`.
* `monoid.exponent` defines the exponent of a monoid `G` as the minimal positive `n` such that
  `g ^ n = 1` for all `g ∈ G`, by convention it is `0` if no such `n` exists.
* `add_monoid.exponent_exists` the additive version of `monoid.exponent_exists`.
* `add_monoid.exponent` the additive version of `monoid.exponent`.

## Main results

* `monoid.lcm_order_eq_exponent`: For a finite left cancel monoid `G`, the exponent is equal to the
  `finset.lcm` of the order of its elements.
* `monoid.exponent_eq_supr_order_of(')`: For a commutative cancel monoid, the exponent is
  equal to `⨆ g : G, order_of g` (or zero if it has any order-zero elements).

## TODO
* Refactor the characteristic of a ring to be the exponent of its underlying additive group.
-/

universe u

variable {G : Type u}

open_locale classical

namespace monoid

section monoid

variables (G) [monoid G]

/--A predicate on a monoid saying that there is a positive integer `n` such that `g ^ n = 1`
  for all `g`.-/
@[to_additive "A predicate on an additive monoid saying that there is a positive integer `n` such
  that `n • g = 0` for all `g`."]
def exponent_exists  := ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1

/--The exponent of a group is the smallest positive integer `n` such that `g ^ n = 1` for all
  `g ∈ G` if it exists, otherwise it is zero by convention.-/
@[to_additive "The exponent of an additive group is the smallest positive integer `n` such that
  `n • g = 0` for all `g ∈ G` if it exists, otherwise it is zero by convention."]
noncomputable def exponent :=
if h : exponent_exists G then nat.find h else 0

variable {G}

@[to_additive]
lemma exponent_eq_zero_iff : exponent G = 0 ↔ ¬ exponent_exists G :=
begin
  rw [exponent],
  split_ifs,
  { simp [h, @not_lt_zero' ℕ] }, --if this isn't done this way, `to_additive` freaks
  { tauto }
end

@[to_additive]
lemma exponent_eq_zero_of_order_zero {g : G} (hg : order_of g = 0) : exponent G = 0 :=
exponent_eq_zero_iff.mpr $ λ ⟨n, hn, hgn⟩, order_of_eq_zero_iff'.mp hg n hn $ hgn g

@[to_additive exponent_nsmul_eq_zero]
lemma pow_exponent_eq_one (g : G) : g ^ exponent G = 1 :=
begin
  by_cases exponent_exists G,
  { simp_rw [exponent, dif_pos h],
    exact (nat.find_spec h).2 g },
  { simp_rw [exponent, dif_neg h, pow_zero] }
end

@[to_additive nsmul_eq_mod_exponent]
lemma pow_eq_mod_exponent {n : ℕ} (g : G): g ^ n = g ^ (n % exponent G) :=
calc g ^ n = g ^ (n % exponent G + exponent G * (n / exponent G)) : by rw [nat.mod_add_div]
  ... = g ^ (n % exponent G) : by simp [pow_add, pow_mul, pow_exponent_eq_one]

@[to_additive]
lemma exponent_pos_of_exists (n : ℕ) (hpos : 0 < n) (hG : ∀ g : G, g ^ n = 1) :
  0 < exponent G :=
begin
  have h : ∃ n, 0 < n ∧ ∀ g : G, g ^ n = 1 := ⟨n, hpos, hG⟩,
  rw [exponent, dif_pos],
  exact (nat.find_spec h).1,
end

@[to_additive]

@[to_additive]
lemma exponent_min (m : ℕ) (hpos : 0 < m) (hm : m < exponent G) : ∃ g : G, g ^ m ≠ 1 :=
begin
  by_contra' h,
  have hcon : exponent G ≤ m := exponent_min' m hpos h,
  linarith,
end

@[simp, to_additive]
lemma exp_eq_one_of_subsingleton [subsingleton G] : exponent G = 1 :=
begin
  apply le_antisymm,
  { apply exponent_min' _ nat.one_pos,
    simp },
  { apply nat.succ_le_of_lt,
    apply exponent_pos_of_exists 1 (nat.one_pos),
    simp },
end

@[to_additive add_order_dvd_exponent]
lemma order_dvd_exponent (g : G) : (order_of g) ∣ exponent G :=
order_of_dvd_of_pow_eq_one $ pow_exponent_eq_one g

variable (G)

@[to_additive exponent_dvd_of_forall_nsmul_eq_zero]
lemma exponent_dvd_of_forall_pow_eq_one (G) [monoid G] (n : ℕ) (hG : ∀ g : G, g ^ n = 1) :
  exponent G ∣ n :=
begin
  rcases n.eq_zero_or_pos with rfl | hpos,
  { exact dvd_zero _ },
  apply nat.dvd_of_mod_eq_zero,
  by_contradiction h,
  have h₁ := nat.pos_of_ne_zero h,
  have h₂ : n % exponent G < exponent G := nat.mod_lt _ (exponent_pos_of_exists n hpos hG),
  have h₃ : exponent G ≤ n % exponent G,
  { apply exponent_min' _ h₁,
    simp_rw ←pow_eq_mod_exponent,
    exact hG },
  linarith,
end

@[to_additive lcm_add_order_of_dvd_exponent]
lemma lcm_order_of_dvd_exponent [fintype G] : (finset.univ : finset G).lcm order_of ∣ exponent G :=
begin
  apply finset.lcm_dvd,
  intros g hg,
  exact order_dvd_exponent g
end

@[to_additive exists_order_of_eq_pow_padic_val_nat_add_exponent]
lemma _root_.nat.prime.exists_order_of_eq_pow_padic_val_nat_exponent {p : ℕ} (hp : p.prime) :
  ∃ g : G, order_of g = p ^ padic_val_nat p (exponent G) :=
begin
  haveI := fact.mk hp,
  rcases (padic_val_nat p $ exponent G).eq_zero_or_pos with h | h,
  { refine ⟨1, by rw [h, pow_zero, order_of_one]⟩ },
  have he : 0 < exponent G := ne.bot_lt (λ ht, by {rw ht at h, exact h.ne' (padic_val_nat_zero _)}),
  obtain ⟨g, hg⟩ : ∃ (g : G), g ^ (exponent G / p) ≠ 1,
  { suffices key : ¬ exponent G ∣ exponent G / p,
    { by simpa using mt (exponent_dvd_of_forall_pow_eq_one G (exponent G / p)) key },
    exact λ hd, hp.one_lt.not_le ((mul_le_iff_le_one_left he).mp $
                nat.le_of_dvd he $ nat.mul_dvd_of_dvd_div (dvd_of_one_le_padic_val_nat h) hd) },
  obtain ⟨k, hk : exponent G = p ^ _ * k⟩ := pow_padic_val_nat_dvd; try {apply_instance},
  obtain ⟨t, ht⟩ := nat.exists_eq_succ_of_ne_zero h.ne',
  refine ⟨g ^ k, _⟩,
  rw ht,
  apply order_of_eq_prime_pow,
  { rwa [hk, mul_comm, ht, pow_succ', ←mul_assoc, nat.mul_div_cancel _ hp.pos, pow_mul] at hg },
  { rw [←nat.succ_eq_add_one, ←ht, ←pow_mul, mul_comm, ←hk],
    exact pow_exponent_eq_one g },
end

variable {G}

@[to_additive] lemma exponent_ne_zero_iff_range_order_of_finite (h : ∀ g : G, 0 < order_of g) :
  exponent G ≠ 0 ↔ (set.range (order_of : G → ℕ)).finite :=
begin
  refine ⟨λ he, _, λ he, _⟩,
  { by_contra h,
    obtain ⟨m, ⟨t, rfl⟩, het⟩ := set.infinite.exists_nat_lt h (exponent G),
    exact pow_ne_one_of_lt_order_of' he het (pow_exponent_eq_one t) },
  { lift (set.range order_of) to finset ℕ using he with t ht,
    have htpos : 0 < t.prod id,
    { refine finset.prod_pos (λ a ha, _),
      rw [←finset.mem_coe, ht] at ha,
      obtain ⟨k, rfl⟩ := ha,
      exact h k },
    suffices : exponent G ∣ t.prod id,
    { intro h,
      rw [h, zero_dvd_iff] at this,
      exact htpos.ne' this },
    refine exponent_dvd_of_forall_pow_eq_one _ _ (λ g, _),
    rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd, pow_zero g],
    apply finset.dvd_prod_of_mem,
    rw [←finset.mem_coe, ht],
    exact set.mem_range_self g },
end

@[to_additive] lemma exponent_eq_zero_iff_range_order_of_infinite (h : ∀ g : G, 0 < order_of g) :
  exponent G = 0 ↔ (set.range (order_of : G → ℕ)).infinite :=
have _ := exponent_ne_zero_iff_range_order_of_finite h,
by rwa [ne.def, not_iff_comm, iff.comm] at this

end monoid

section left_cancel_monoid

variable [left_cancel_monoid G]

@[to_additive lcm_add_order_eq_exponent]
lemma lcm_order_eq_exponent [fintype G] : (finset.univ : finset G).lcm order_of = exponent G :=
begin
  apply nat.dvd_antisymm (lcm_order_of_dvd_exponent G),
  refine exponent_dvd_of_forall_pow_eq_one G _ (λ g, _),
  obtain ⟨m, hm⟩ : order_of g ∣ finset.univ.lcm order_of := finset.dvd_lcm (finset.mem_univ g),
  rw [hm, pow_mul, pow_order_of_eq_one, one_pow]
end

@[to_additive]
lemma exponent_ne_zero_of_fintype [fintype G] : exponent G ≠ 0 :=
by simpa [←lcm_order_eq_exponent, finset.lcm_eq_zero_iff] using λ x, (order_of_pos x).ne'

end left_cancel_monoid

section comm_monoid

variable [cancel_comm_monoid G]

@[to_additive] lemma exponent_eq_supr_order_of (h : ∀ g : G, 0 < order_of g) :
  exponent G = ⨆ g : G, order_of g :=
begin
  rw supr,
  rcases eq_or_ne (exponent G) 0 with he | he,
  { rw [he, set.infinite.nat.Sup_eq_zero $ (exponent_eq_zero_iff_range_order_of_infinite h).1 he] },
  have hne : (set.range (order_of : G → ℕ)).nonempty := ⟨1, 1, order_of_one⟩,
  have hfin : (set.range (order_of : G → ℕ)).finite,
  { rwa [← exponent_ne_zero_iff_range_order_of_finite h] },
  obtain ⟨t, ht⟩ := hne.cSup_mem hfin,
  apply nat.dvd_antisymm _,
  { rw ←ht,
    apply order_dvd_exponent },
  refine nat.dvd_of_factors_subperm he _,
  rw list.subperm_ext_iff,
  by_contra' h,
  obtain ⟨p, hp, hpe⟩ := h,
  haveI hp := fact.mk (nat.prime_of_mem_factors hp),
  simp only [←padic_val_nat_eq_factors_count p] at hpe,
  set k := padic_val_nat p (order_of t) with hk,
  obtain ⟨g, hg⟩ := hp.1.exists_order_of_eq_pow_padic_val_nat_exponent G,
  suffices : order_of t < order_of (t ^ (p ^ k) * g),
  { rw ht at this,
    exact this.not_le (le_cSup hfin.bdd_above $ set.mem_range_self _) },
  have hpk  : p ^ k ∣ order_of t := pow_padic_val_nat_dvd,
  have hpk' : order_of (t ^ p ^ k) = order_of t / p ^ k,
  { rw [order_of_pow' t (pow_ne_zero k hp.1.ne_zero), nat.gcd_eq_right hpk] },
  obtain ⟨a, ha⟩ := nat.exists_eq_add_of_lt hpe,
  have hcoprime : (order_of (t ^ p ^ k)).coprime (order_of g),
  { rw [hg, nat.coprime_pow_right_iff (pos_of_gt hpe), nat.coprime_comm],
    apply or.resolve_right (nat.coprime_or_dvd_of_prime hp.1 _),
    nth_rewrite 0 ←pow_one p,
    convert pow_succ_padic_val_nat_not_dvd (h $ t ^ p ^ k),
    rw [hpk', padic_val_nat.div_pow hpk, hk, nat.sub_self],
    apply_instance },
  rw [(commute.all _ g).order_of_mul_eq_mul_order_of_of_coprime hcoprime, hpk', hg, ha, ←ht, ←hk,
      pow_add, pow_add, pow_one, ←mul_assoc, ←mul_assoc, nat.div_mul_cancel, mul_assoc,
      lt_mul_iff_one_lt_right $ h t, ←pow_succ'],
  exact one_lt_pow hp.1.one_lt a.succ_ne_zero,
  exact hpk
end

@[to_additive] lemma exponent_eq_supr_order_of' :
  exponent G = if ∃ g : G, order_of g = 0 then 0 else ⨆ g : G, order_of g :=
begin
  split_ifs,
  { obtain ⟨g, hg⟩ := h,
    exact exponent_eq_zero_of_order_zero hg },
  { have := not_exists.mp h,
    exact exponent_eq_supr_order_of (λ g, ne.bot_lt $ this g) }
end

@[to_additive] lemma exponent_eq_max'_order_of [fintype G] :
  exponent G = ((@finset.univ G _).image order_of).max' ⟨1, by simp⟩ :=
begin
  rw [←finset.nonempty.cSup_eq_max', finset.coe_image, finset.coe_univ, set.image_univ, ← supr],
  exact exponent_eq_supr_order_of order_of_pos
end

end comm_monoid

end monoid


/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.complex.module
import data.complex.exponential
import data.is_R_or_C.basic
import topology.algebra.infinite_sum.module
import topology.instances.real_vector_space

/-!
# Normed space structure on `ℂ`.

This file gathers basic facts on complex numbers of an analytic nature.

## Main results

This file registers `ℂ` as a normed field, expresses basic properties of the norm, and gives
tools on the real vector space structure of `ℂ`. Notably, in the namespace `complex`,
it defines functions:

* `re_clm`
* `im_clm`
* `of_real_clm`
* `conj_cle`

They are bundled versions of the real part, the imaginary part, the embedding of `ℝ` in `ℂ`, and
the complex conjugate as continuous `ℝ`-linear maps. The last two are also bundled as linear
isometries in `of_real_li` and `conj_lie`.

We also register the fact that `ℂ` is an `is_R_or_C` field.
-/

assert_not_exists absorbs

noncomputable theory

namespace complex

open_locale complex_conjugate topology

instance : has_norm ℂ := ⟨abs⟩

@[simp] lemma norm_eq_abs (z : ℂ) : ‖z‖ = abs z := rfl

lemma norm_exp_of_real_mul_I (t : ℝ) : ‖exp (t * I)‖ = 1 :=
by simp only [norm_eq_abs, abs_exp_of_real_mul_I]

instance : normed_add_comm_group ℂ :=
add_group_norm.to_normed_add_comm_group
{ map_zero' := map_zero abs,
  neg' := abs.map_neg,
  eq_zero_of_map_eq_zero' := λ _, abs.eq_zero.1,
  ..abs }

instance : normed_field ℂ :=
{ norm := abs,
  dist_eq := λ _ _, rfl,
  norm_mul' := map_mul abs,
  .. complex.field, .. complex.normed_add_comm_group }

instance : densely_normed_field ℂ :=
{ lt_norm_lt := λ r₁ r₂ h₀ hr, let ⟨x, h⟩ := normed_field.exists_lt_norm_lt ℝ h₀ hr in
    have this : ‖(‖x‖ : ℂ)‖ = ‖(‖x‖)‖, by simp only [norm_eq_abs, abs_of_real, real.norm_eq_abs],
    ⟨‖x‖, by rwa [this, norm_norm]⟩ }

instance {R : Type*} [normed_field R] [normed_algebra R ℝ] : normed_algebra R ℂ :=
{ norm_smul_le := λ r x, begin
    rw [norm_eq_abs, norm_eq_abs, ←algebra_map_smul ℝ r x, algebra.smul_def, map_mul,
        ←norm_algebra_map' ℝ r, coe_algebra_map, abs_of_real],
    refl,
  end,
  to_algebra := complex.algebra }

variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E]

/-- The module structure from `module.complex_to_real` is a normed space. -/
@[priority 900] -- see Note [lower instance priority]
instance _root_.normed_space.complex_to_real : normed_space ℝ E :=
normed_space.restrict_scalars ℝ ℂ E

lemma dist_eq (z w : ℂ) : dist z w = abs (z - w) := rfl

lemma dist_eq_re_im (z w : ℂ) : dist z w = real.sqrt ((z.re - w.re) ^ 2 + (z.im - w.im) ^ 2) :=
by { rw [sq, sq], refl }

@[simp] lemma dist_mk (x₁ y₁ x₂ y₂ : ℝ) :
  dist (mk x₁ y₁) (mk x₂ y₂) = real.sqrt ((x₁ - x₂) ^ 2 + (y₁ - y₂) ^ 2) :=
dist_eq_re_im _ _

lemma dist_of_re_eq {z w : ℂ} (h : z.re = w.re) : dist z w = dist z.im w.im :=
by rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, zero_add, real.sqrt_sq_eq_abs, real.dist_eq]

lemma nndist_of_re_eq {z w : ℂ} (h : z.re = w.re) : nndist z w = nndist z.im w.im :=
nnreal.eq $ dist_of_re_eq h

lemma edist_of_re_eq {z w : ℂ} (h : z.re = w.re) : edist z w = edist z.im w.im :=
by rw [edist_nndist, edist_nndist, nndist_of_re_eq h]

lemma dist_of_im_eq {z w : ℂ} (h : z.im = w.im) : dist z w = dist z.re w.re :=
by rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, add_zero, real.sqrt_sq_eq_abs, real.dist_eq]

lemma nndist_of_im_eq {z w : ℂ} (h : z.im = w.im) : nndist z w = nndist z.re w.re :=
nnreal.eq $ dist_of_im_eq h

lemma edist_of_im_eq {z w : ℂ} (h : z.im = w.im) : edist z w = edist z.re w.re :=
by rw [edist_nndist, edist_nndist, nndist_of_im_eq h]

lemma dist_conj_self (z : ℂ) : dist (conj z) z = 2 * |z.im| :=
by rw [dist_of_re_eq (conj_re z), conj_im, dist_comm, real.dist_eq, sub_neg_eq_add, ← two_mul,
  _root_.abs_mul, abs_of_pos (zero_lt_two' ℝ)]

lemma nndist_conj_self (z : ℂ) : nndist (conj z) z = 2 * real.nnabs z.im :=
nnreal.eq $ by rw [← dist_nndist, nnreal.coe_mul, nnreal.coe_two, real.coe_nnabs, dist_conj_self]

lemma dist_self_conj (z : ℂ) : dist z (conj z) = 2 * |z.im| :=
by rw [dist_comm, dist_conj_self]

lemma nndist_self_conj (z : ℂ) : nndist z (conj z) = 2 * real.nnabs z.im :=
by rw [nndist_comm, nndist_conj_self]

@[simp] lemma comap_abs_nhds_zero : filter.comap abs (𝓝 0) = 𝓝 0 := comap_norm_nhds_zero

lemma norm_real (r : ℝ) : ‖(r : ℂ)‖ = ‖r‖ := abs_of_real _

@[simp] lemma norm_rat (r : ℚ) : ‖(r : ℂ)‖ = |(r : ℝ)| :=
by { rw ← of_real_rat_cast, exact norm_real _ }

@[simp] lemma norm_nat (n : ℕ) : ‖(n : ℂ)‖ = n := abs_of_nat _

@[simp] lemma norm_int {n : ℤ} : ‖(n : ℂ)‖ = |n| :=
by simp [← rat.cast_coe_int] {single_pass := tt}

lemma norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : ‖(n : ℂ)‖ = n :=
by simp [hn]

@[continuity] lemma continuous_abs : continuous abs := continuous_norm

@[continuity] lemma continuous_norm_sq : continuous norm_sq :=
by simpa [← norm_sq_eq_abs] using continuous_abs.pow 2

@[simp, norm_cast] lemma nnnorm_real (r : ℝ) : ‖(r : ℂ)‖₊ = ‖r‖₊ :=
subtype.ext $ norm_real r

@[simp, norm_cast] lemma nnnorm_nat (n : ℕ) : ‖(n : ℂ)‖₊ = n :=
subtype.ext $ by simp

@[simp, norm_cast] lemma nnnorm_int (n : ℤ) : ‖(n : ℂ)‖₊ = ‖n‖₊ :=
subtype.ext $ by simp only [coe_nnnorm, norm_int, int.norm_eq_abs]

lemma nnnorm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) :
  ‖ζ‖₊ = 1 :=
begin
  refine (@pow_left_inj nnreal _ _ _ _ zero_le' zero_le' hn.bot_lt).mp _,
  rw [←nnnorm_pow, h, nnnorm_one, one_pow],
end

lemma norm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) :
  ‖ζ‖ = 1 :=
congr_arg coe (nnnorm_eq_one_of_pow_eq_one h hn)

lemma equiv_real_prod_apply_le (z : ℂ) : ‖equiv_real_prod z‖ ≤ abs z :=
by simp [prod.norm_def, abs_re_le_abs, abs_im_le_abs]

lemma equiv_real_prod_apply_le' (z : ℂ) : ‖equiv_real_prod z‖ ≤ 1 * abs z :=
by simpa using equiv_real_prod_apply_le z

lemma lipschitz_equiv_real_prod : lipschitz_with 1 equiv_real_prod :=
by simpa using
  add_monoid_hom_class.lipschitz_of_bound equiv_real_prod_lm 1 equiv_real_prod_apply_le'

lemma antilipschitz_equiv_real_prod : antilipschitz_with (nnreal.sqrt 2) equiv_real_prod :=
by simpa using
  add_monoid_hom_class.antilipschitz_of_bound equiv_real_prod_lm abs_le_sqrt_two_mul_max

lemma uniform_embedding_equiv_real_prod : uniform_embedding equiv_real_prod :=
antilipschitz_equiv_real_prod.uniform_embedding lipschitz_equiv_real_prod.uniform_continuous

instance : complete_space ℂ :=
(complete_space_congr uniform_embedding_equiv_real_prod).mpr infer_instance

/-- The natural `continuous_linear_equiv` from `ℂ` to `ℝ × ℝ`. -/
@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }]
def equiv_real_prod_clm : ℂ ≃L[ℝ] ℝ × ℝ :=
equiv_real_prod_lm.to_continuous_linear_equiv_of_bounds 1 (real.sqrt 2)
equiv_real_prod_apply_le'
(λ p, abs_le_sqrt_two_mul_max (equiv_real_prod.symm p))

instance : proper_space ℂ :=
(id lipschitz_equiv_real_prod : lipschitz_with 1 equiv_real_prod_clm.to_homeomorph).proper_space

/-- The `abs` function on `ℂ` is proper. -/
lemma tendsto_abs_cocompact_at_top : filter.tendsto abs (filter.cocompact ℂ) filter.at_top :=
tendsto_norm_cocompact_at_top

/-- The `norm_sq` function on `ℂ` is proper. -/
lemma tendsto_norm_sq_cocompact_at_top :
  filter.tendsto norm_sq (filter.cocompact ℂ) filter.at_top :=
by simpa [mul_self_abs] using
  tendsto_abs_cocompact_at_top.at_top_mul_at_top tendsto_abs_cocompact_at_top

open continuous_linear_map

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def re_clm : ℂ →L[ℝ] ℝ := re_lm.mk_continuous 1 (λ x, by simp [abs_re_le_abs])

@[continuity] lemma continuous_re : continuous re := re_clm.continuous

@[simp] lemma re_clm_coe : (coe (re_clm) : ℂ →ₗ[ℝ] ℝ) = re_lm := rfl

@[simp]

/-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/
def im_clm : ℂ →L[ℝ] ℝ := im_lm.mk_continuous 1 (λ x, by simp [abs_im_le_abs])

@[continuity] lemma continuous_im : continuous im := im_clm.continuous

@[simp] lemma im_clm_coe : (coe (im_clm) : ℂ →ₗ[ℝ] ℝ) = im_lm := rfl

@[simp] lemma im_clm_apply (z : ℂ) : (im_clm : ℂ → ℝ) z = z.im := rfl

lemma restrict_scalars_one_smul_right' (x : E) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] E) =
    re_clm.smul_right x + I • im_clm.smul_right x :=
by { ext ⟨a, b⟩, simp [mk_eq_add_mul_I, add_smul, mul_smul, smul_comm I] }

lemma restrict_scalars_one_smul_right (x : ℂ) :
  continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] ℂ) = x • 1 :=
by { ext1 z, dsimp, apply mul_comm }

/-- The complex-conjugation function from `ℂ` to itself is an isometric linear equivalence. -/
def conj_lie : ℂ ≃ₗᵢ[ℝ] ℂ := ⟨conj_ae.to_linear_equiv, abs_conj⟩

@[simp] lemma conj_lie_apply (z : ℂ) : conj_lie z = conj z := rfl

@[simp] lemma conj_lie_symm : conj_lie.symm = conj_lie := rfl

lemma isometry_conj : isometry (conj : ℂ → ℂ) := conj_lie.isometry

@[simp] lemma dist_conj_conj (z w : ℂ) : dist (conj z) (conj w) = dist z w :=
isometry_conj.dist_eq z w

@[simp] lemma nndist_conj_conj (z w : ℂ) : nndist (conj z) (conj w) = nndist z w :=
isometry_conj.nndist_eq z w

lemma dist_conj_comm (z w : ℂ) : dist (conj z) w = dist z (conj w) :=
by rw [← dist_conj_conj, conj_conj]

lemma nndist_conj_comm (z w : ℂ) : nndist (conj z) w = nndist z (conj w) :=
subtype.ext $ dist_conj_comm _ _

instance : has_continuous_star ℂ := ⟨conj_lie.continuous⟩

@[continuity] lemma continuous_conj : continuous (conj : ℂ → ℂ) := continuous_star

/-- The only continuous ring homomorphisms from `ℂ` to `ℂ` are the identity and the complex
conjugation. -/
lemma ring_hom_eq_id_or_conj_of_continuous {f : ℂ →+* ℂ} (hf : continuous f) :
  f = ring_hom.id ℂ ∨ f = conj :=
begin
  refine (real_alg_hom_eq_id_or_conj $ alg_hom.mk' f $ map_real_smul f hf).imp (λ h, _) (λ h, _),
  all_goals { convert congr_arg alg_hom.to_ring_hom h, ext1, refl, },
end

/-- Continuous linear equiv version of the conj function, from `ℂ` to `ℂ`. -/
def conj_cle : ℂ ≃L[ℝ] ℂ := conj_lie

@[simp] lemma conj_cle_coe : conj_cle.to_linear_equiv = conj_ae.to_linear_equiv := rfl

@[simp] lemma conj_cle_apply (z : ℂ) : conj_cle z = conj z := rfl

/-- Linear isometry version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_li : ℝ →ₗᵢ[ℝ] ℂ := ⟨of_real_am.to_linear_map, norm_real⟩

lemma isometry_of_real : isometry (coe : ℝ → ℂ) := of_real_li.isometry

@[continuity] lemma continuous_of_real : continuous (coe : ℝ → ℂ) := of_real_li.continuous

/-- The only continuous ring homomorphism from `ℝ` to `ℂ` is the identity. -/
lemma ring_hom_eq_of_real_of_continuous {f : ℝ →+* ℂ} (h : continuous f) :
  f = complex.of_real :=
begin
  convert congr_arg alg_hom.to_ring_hom
    (subsingleton.elim (alg_hom.mk' f $ map_real_smul f h) $ algebra.of_id ℝ ℂ),
  ext1, refl,
end

/-- Continuous linear map version of the canonical embedding of `ℝ` in `ℂ`. -/
def of_real_clm : ℝ →L[ℝ] ℂ := of_real_li.to_continuous_linear_map

@[simp] lemma of_real_clm_coe : (of_real_clm : ℝ →ₗ[ℝ] ℂ) = of_real_am.to_linear_map := rfl

@[simp] lemma of_real_clm_apply (x : ℝ) : of_real_clm x = x := rfl

noncomputable instance : is_R_or_C ℂ :=
{ re := ⟨complex.re, complex.zero_re, complex.add_re⟩,
  im := ⟨complex.im, complex.zero_im, complex.add_im⟩,
  I := complex.I,
  I_re_ax := by simp only [add_monoid_hom.coe_mk, complex.I_re],
  I_mul_I_ax := by simp only [complex.I_mul_I, eq_self_iff_true, or_true],
  re_add_im_ax := λ z, by simp only [add_monoid_hom.coe_mk, complex.re_add_im,
                                     complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_re_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_re,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  of_real_im_ax := λ r, by simp only [add_monoid_hom.coe_mk, complex.of_real_im,
                                      complex.coe_algebra_map, complex.of_real_eq_coe],
  mul_re_ax := λ z w, by simp only [complex.mul_re, add_monoid_hom.coe_mk],
  mul_im_ax := λ z w, by simp only [add_monoid_hom.coe_mk, complex.mul_im],
  conj_re_ax := λ z, rfl,
  conj_im_ax := λ z, rfl,
  conj_I_ax := by simp only [complex.conj_I, ring_hom.coe_mk],
  norm_sq_eq_def_ax := λ z, by simp only [←complex.norm_sq_eq_abs, ←complex.norm_sq_apply,
    add_monoid_hom.coe_mk, complex.norm_eq_abs],
  mul_im_I_ax := λ z, by simp only [mul_one, add_monoid_hom.coe_mk, complex.I_im],
  inv_def_ax := λ z, by simp only [complex.inv_def, complex.norm_sq_eq_abs, complex.coe_algebra_map,
    complex.of_real_eq_coe, complex.norm_eq_abs],
  div_I_ax := complex.div_I }

lemma _root_.is_R_or_C.re_eq_complex_re : ⇑(is_R_or_C.re : ℂ →+ ℝ) = complex.re := rfl
lemma _root_.is_R_or_C.im_eq_complex_im : ⇑(is_R_or_C.im : ℂ →+ ℝ) = complex.im := rfl

section complex_order
open_locale complex_order

lemma eq_coe_norm_of_nonneg {z : ℂ} (hz : 0 ≤ z) : z = ↑‖z‖ :=
by rw [eq_re_of_real_le hz, is_R_or_C.norm_of_real, real.norm_of_nonneg (complex.le_def.2 hz).1]

end complex_order

end complex

namespace is_R_or_C

open_locale complex_conjugate

local notation `reC` := @is_R_or_C.re ℂ _
local notation `imC` := @is_R_or_C.im ℂ _
local notation `IC` := @is_R_or_C.I ℂ _
local notation `absC` := @is_R_or_C.abs ℂ _
local notation `norm_sqC` := @is_R_or_C.norm_sq ℂ _

@[simp] lemma re_to_complex {x : ℂ} : reC x = x.re := rfl
@[simp] lemma im_to_complex {x : ℂ} : imC x = x.im := rfl
@[simp] lemma I_to_complex : IC = complex.I := rfl
@[simp] lemma norm_sq_to_complex {x : ℂ} : norm_sqC x = complex.norm_sq x :=
by simp [is_R_or_C.norm_sq, complex.norm_sq]
@[simp] lemma abs_to_complex {x : ℂ} : absC x = complex.abs x :=
by simp [is_R_or_C.abs, complex.abs]

section tsum
variables {α : Type*} (𝕜 : Type*) [is_R_or_C 𝕜]

@[simp] lemma has_sum_conj {f : α → 𝕜} {x : 𝕜} :
  has_sum (λ x, conj (f x)) x ↔ has_sum f (conj x) :=
conj_cle.has_sum

lemma has_sum_conj' {f : α → 𝕜} {x : 𝕜} : has_sum (λ x, conj (f x)) (conj x) ↔ has_sum f x :=
conj_cle.has_sum'

@[simp] lemma summable_conj {f : α → 𝕜} : summable (λ x, conj (f x)) ↔ summable f :=
summable_star_iff

variables {𝕜}

lemma conj_tsum (f : α → 𝕜) : conj (∑' a, f a) = ∑' a, conj (f a) :=
tsum_star

variables (𝕜)

@[simp, norm_cast] lemma has_sum_of_real {f : α → ℝ} {x : ℝ} :
  has_sum (λ x, (f x : 𝕜)) x ↔ has_sum f x :=
⟨λ h, by simpa only [is_R_or_C.re_clm_apply, is_R_or_C.of_real_re] using re_clm.has_sum h,
  of_real_clm.has_sum⟩

@[simp, norm_cast] lemma summable_of_real {f : α → ℝ} : summable (λ x, (f x : 𝕜)) ↔ summable f :=
⟨λ h, by simpa only [is_R_or_C.re_clm_apply, is_R_or_C.of_real_re] using re_clm.summable h,
  of_real_clm.summable⟩

@[norm_cast] lemma of_real_tsum (f : α → ℝ) : (↑(∑' a, f a) : 𝕜) = ∑' a, f a :=
begin
  by_cases h : summable f,
  { exact continuous_linear_map.map_tsum of_real_clm h },
  { rw [tsum_eq_zero_of_not_summable h,
    tsum_eq_zero_of_not_summable ((summable_of_real _).not.mpr h), of_real_zero] }
end

lemma has_sum_re {f : α → 𝕜} {x : 𝕜} (h : has_sum f x) : has_sum (λ x, re (f x)) (re x) :=
re_clm.has_sum h

lemma has_sum_im {f : α → 𝕜} {x : 𝕜} (h : has_sum f x) : has_sum (λ x, im (f x)) (im x) :=
im_clm.has_sum h

lemma re_tsum {f : α → 𝕜} (h : summable f) : re (∑' a, f a) = ∑' a, re (f a) :=
re_clm.map_tsum h

lemma im_tsum {f : α → 𝕜} (h : summable f) : im (∑' a, f a) = ∑' a, im (f a) :=
im_clm.map_tsum h

variables {𝕜}

lemma has_sum_iff (f : α → 𝕜) (c : 𝕜) :
  has_sum f c ↔ has_sum (λ x, re (f x)) (re c) ∧ has_sum (λ x, im (f x)) (im c) :=
begin
  refine ⟨λ h, ⟨has_sum_re _ h, has_sum_im _ h⟩, _⟩,
  rintro ⟨h₁, h₂⟩,
  rw ←is_R_or_C.re_add_im c,
  convert ((has_sum_of_real 𝕜).mpr h₁).add (((has_sum_of_real 𝕜).mpr h₂).mul_right I),
  simp_rw is_R_or_C.re_add_im,
end

end tsum

end is_R_or_C

namespace complex
/-!
We have to repeat the lemmas about `is_R_or_C.re` and `is_R_or_C.im` as they are not syntactic
matches for `complex.re` and `complex.im`.

We do not have this problem with `of_real` and `conj`, although we repeat them anyway for
discoverability and to avoid the need to unify `𝕜`.
-/
section tsum
variables {α : Type*}

open_locale complex_conjugate

@[simp] lemma has_sum_conj {f : α → ℂ} {x : ℂ} :
  has_sum (λ x, conj (f x)) x ↔ has_sum f (conj x) :=
is_R_or_C.has_sum_conj _

lemma has_sum_conj' {f : α → ℂ} {x : ℂ} : has_sum (λ x, conj (f x)) (conj x) ↔ has_sum f x :=
is_R_or_C.has_sum_conj' _

@[simp] lemma summable_conj {f : α → ℂ} : summable (λ x, conj (f x)) ↔ summable f :=
is_R_or_C.summable_conj _

lemma conj_tsum (f : α → ℂ) : conj (∑' a, f a) = ∑' a, conj (f a) :=
is_R_or_C.conj_tsum _

@[simp, norm_cast] lemma has_sum_of_real {f : α → ℝ} {x : ℝ} :
  has_sum (λ x, (f x : ℂ)) x ↔ has_sum f x :=
is_R_or_C.has_sum_of_real _

@[simp, norm_cast] lemma summable_of_real {f : α → ℝ} : summable (λ x, (f x : ℂ)) ↔ summable f :=
is_R_or_C.summable_of_real _

@[norm_cast] lemma of_real_tsum (f : α → ℝ) : (↑(∑' a, f a) : ℂ) = ∑' a, f a :=
is_R_or_C.of_real_tsum _ _

lemma has_sum_re {f : α → ℂ} {x : ℂ} (h : has_sum f x) : has_sum (λ x, (f x).re) x.re :=
is_R_or_C.has_sum_re _ h

lemma has_sum_im {f : α → ℂ} {x : ℂ} (h : has_sum f x) : has_sum (λ x, (f x).im) x.im :=
is_R_or_C.has_sum_im _ h

lemma re_tsum {f : α → ℂ} (h : summable f) : (∑' a, f a).re = ∑' a, (f a).re :=
is_R_or_C.re_tsum _ h

lemma im_tsum {f : α → ℂ} (h : summable f) : (∑' a, f a).im = ∑' a, (f a).im :=
is_R_or_C.im_tsum _ h

lemma has_sum_iff (f : α → ℂ) (c : ℂ) :
  has_sum f c ↔ has_sum (λ x, (f x).re) c.re ∧ has_sum (λ x, (f x).im) c.im :=
is_R_or_C.has_sum_iff _ _

end tsum

end complex


/-
Copyright (c) 2015 Joseph Hua. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Hua
-/
import data.W.basic

/-!
# Examples of W-types

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

We take the view of W types as inductive types.
Given `α : Type` and `β : α → Type`, the W type determined by this data, `W_type β`, is the
inductively with constructors from `α` and arities of each constructor `a : α` given by `β a`.

This file contains `nat` and `list` as examples of W types.

## Main results
* `W_type.equiv_nat`: the construction of the naturals as a W-type is equivalent
  to `nat`
* `W_type.equiv_list`: the construction of lists on a type `γ` as a W-type is equivalent to
  `list γ`
-/

universes u v

namespace W_type

section nat

/-- The constructors for the naturals -/
inductive nat_α : Type
| zero : nat_α
| succ : nat_α

instance : inhabited nat_α := ⟨ nat_α.zero ⟩

/-- The arity of the constructors for the naturals, `zero` takes no arguments, `succ` takes one -/
def nat_β : nat_α → Type
| nat_α.zero := empty
| nat_α.succ := unit

instance : inhabited (nat_β nat_α.succ) := ⟨ () ⟩

/-- The isomorphism from the naturals to its corresponding `W_type` -/
@[simp] def of_nat : ℕ → W_type nat_β
| nat.zero := ⟨ nat_α.zero , empty.elim ⟩
| (nat.succ n) := ⟨ nat_α.succ , λ _ , of_nat n ⟩

/-- The isomorphism from the `W_type` of the naturals to the naturals -/
@[simp] def to_nat : W_type nat_β → ℕ
| (W_type.mk nat_α.zero f) := 0
| (W_type.mk nat_α.succ f) := (to_nat (f ())).succ

lemma left_inv_nat : function.left_inverse of_nat to_nat
| (W_type.mk nat_α.zero f) := by { simp, tidy }
| (W_type.mk nat_α.succ f) := by { simp, tidy }

lemma right_inv_nat : function.right_inverse of_nat to_nat
| nat.zero := rfl
| (nat.succ n) := by rw [of_nat, to_nat, right_inv_nat n]

/-- The naturals are equivalent to their associated `W_type` -/
def equiv_nat : W_type nat_β ≃ ℕ :=
{ to_fun := to_nat,
  inv_fun := of_nat,
  left_inv := left_inv_nat,
  right_inv := right_inv_nat }

open sum punit

/--
`W_type.nat_α` is equivalent to `punit ⊕ punit`.
This is useful when considering the associated polynomial endofunctor.
-/
@[simps] def nat_α_equiv_punit_sum_punit : nat_α ≃ punit.{u + 1} ⊕ punit :=
{ to_fun := λ c, match c with | nat_α.zero := inl star | nat_α.succ := inr star end,
  inv_fun := λ b, match b with | inl x := nat_α.zero | inr x := nat_α.succ end,
  left_inv := λ c, match c with | nat_α.zero := rfl | nat_α.succ := rfl end,
  right_inv := λ b, match b with | inl star := rfl | inr star := rfl end }

end nat

section list

variable (γ : Type u)

/--
The constructors for lists.
There is "one constructor `cons x` for each `x : γ`",
since we view `list γ` as
```
| nil : list γ
| cons x₀ : list γ → list γ
| cons x₁ : list γ → list γ
|   ⋮      γ many times
```
-/
inductive list_α : Type u
| nil : list_α
| cons : γ → list_α

instance : inhabited (list_α γ) := ⟨ list_α.nil ⟩

/-- The arities of each constructor for lists, `nil` takes no arguments, `cons hd` takes one -/
def list_β : list_α γ → Type u
| list_α.nil := pempty
| (list_α.cons hd) := punit

instance (hd : γ) : inhabited (list_β γ (list_α.cons hd)) := ⟨ punit.star ⟩

/-- The isomorphism from lists to the `W_type` construction of lists -/
@[simp] def of_list : list γ → W_type (list_β γ)
| list.nil := ⟨ list_α.nil, pempty.elim ⟩
| (list.cons hd tl) := ⟨ list_α.cons hd, λ _ , of_list tl ⟩

/-- The isomorphism from the `W_type` construction of lists to lists -/
@[simp] def to_list : W_type (list_β γ) → list γ
| (W_type.mk list_α.nil f) := []
| (W_type.mk (list_α.cons hd) f) := hd :: to_list (f punit.star)

lemma left_inv_list : function.left_inverse (of_list γ) (to_list _)
| (W_type.mk list_α.nil f) := by { simp, tidy }
| (W_type.mk (list_α.cons x) f) := by { simp, tidy }

lemma right_inv_list : function.right_inverse (of_list γ) (to_list _)
| list.nil := rfl
| (list.cons hd tl) := by simp [right_inv_list tl]

/-- Lists are equivalent to their associated `W_type` -/
def equiv_list : W_type (list_β γ) ≃ list γ :=
{ to_fun := to_list _,
  inv_fun := of_list _,
  left_inv := left_inv_list _,
  right_inv := right_inv_list _ }

/--
`W_type.list_α` is equivalent to `γ` with an extra point.
This is useful when considering the associated polynomial endofunctor
-/
def list_α_equiv_punit_sum : list_α γ ≃ punit.{v + 1} ⊕ γ :=
{ to_fun := λ c, match c with | list_α.nil := sum.inl punit.star | list_α.cons x := sum.inr x end,
  inv_fun := sum.elim (λ _, list_α.nil) (λ x, list_α.cons x),
  left_inv := λ c, match c with | list_α.nil := rfl | list_α.cons x := rfl end,
  right_inv := λ x, match x with | sum.inl punit.star := rfl | sum.inr x := rfl end, }

end list

end W_type


opaque f : Nat → Nat
opaque q : Nat → Prop
opaque r : Nat → Prop

@[simp] axiom ax1 (p : Prop) : (p ∧ True) ↔ p
@[simp] axiom ax2 (x : Nat) : q (f x)
@[simp] axiom ax3 (x : Nat) : ¬ r (f x)
@[simp] axiom ax4 (p : Prop) : (p ∨ False) ↔ p

theorem ex1 (x : Nat) (h : q x) : q x ∧ q (f x) := by
  simp [h]

theorem ex2 (x : Nat) : q (f x) ∨ r (f x) := by
  simp

@[simp] axiom ax5 (x : Nat) : 0 + x = x

theorem ex3 (h : 0 + x = y) : f x = f y := by
  simp at h
  simp [h]

theorem ex4 (x y z : Nat) (h : (x, z).1 = y) : f x = f y := by
  simp at h
  simp [h]

theorem ex5
    (f  : Nat → Nat → Nat)
    (g  : Nat → Nat)
    (h₁ : ∀ x, f x x = x)
    (h₂ : ∀ x, g (g x) = x)
    : f (g (g x)) (f x x) = x :=
  by simp [h₁, h₂]

@[simp] axiom ax6 (x : Nat) : x + 0 = x

theorem ex6
  (f : Nat → Nat)
  (x y : Nat)
  : (fun (h : y = 0) => y + x) = (fun _ => x + 0) := by
 simp (config := { contextual := true })

theorem ex7 (x : Nat) : (let y := x + 0; y + y) = x + x := by
  simp

@[simp] theorem impTrue (p : Sort u) : (p → True) = True :=
  propext <| Iff.intro (fun _ => trivial) (fun _ _ => trivial)

theorem ex8 (y x : Nat) : y = 0 → x + y = 0 → x = 0 := by
  simp (config := { contextual := true })

theorem ex9 (y x : Nat) : y = 0 → x + y = 0 → x = 0 := by
  simp
  intro h₁ h₂
  simp [h₁] at h₂
  simp [h₂]

theorem ex10 (y x : Nat) : y = 0 → x + 0 = 0 → x = 0 := by
  simp
  intro h₁ h₂
  simp [h₂]

theorem ex11 : ∀ x : Nat, 0 + x + 0 = x := by
  simp


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro

! This file was ported from Lean 3 source module algebra.field.power
! leanprover-community/mathlib commit 1e05171a5e8cf18d98d9cf7b207540acb044acae
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Field.Defs
import Mathlib.Algebra.GroupWithZero.Power
import Mathlib.Algebra.Parity

/-!
# Results about powers in fields or division rings.

This file exists to ensure we can define `Field` with minimal imports,
so contains some lemmas about powers of elements which need imports
beyond those needed for the basic definition.
-/

variable {α : Type _}

section DivisionRing

variable [DivisionRing α] {n : ℤ}

set_option linter.deprecated false in
@[simp]
theorem zpow_bit1_neg (a : α) (n : ℤ) : (-a) ^ bit1 n = -a ^ bit1 n := by
  rw [zpow_bit1', zpow_bit1', neg_mul_neg, neg_mul_eq_mul_neg]
#align zpow_bit1_neg zpow_bit1_neg

theorem Odd.neg_zpow (h : Odd n) (a : α) : (-a) ^ n = -a ^ n := by
  obtain ⟨k, rfl⟩ := h.exists_bit1
  exact zpow_bit1_neg _ _
#align odd.neg_zpow Odd.neg_zpow

theorem Odd.neg_one_zpow (h : Odd n) : (-1 : α) ^ n = -1 := by rw [h.neg_zpow, one_zpow]
#align odd.neg_one_zpow Odd.neg_one_zpow

end DivisionRing


import data.nat.basic

theorem T2
  (a b c d : ℕ)
  (h1 : a = b)
  (h2 : b ≤ c)
  (h3 : c + 1 < d) : a < d :=
calc
  a   = b     : h1
  ... < b + 1 : nat.lt_succ_self b
  ... ≤ c + 1 : nat.succ_le_succ h2
  ... < d     : h3

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
calc
  (x + y) * (x + y) = (x + y) * x + (x + y) * y : by rw mul_add
  ... = x * x + y * x + (x + y) * y             : by rw add_mul
  ... = x * x + y * x + (x * y + y * y)         : by rw add_mul
  ... = x * x + y * x + x * y + y * y           : by rw ←add_assoc

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
by rw [mul_add, add_mul, add_mul, ←add_assoc]

example (x y : ℕ) :
  (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
by simp [mul_add, add_mul, add_assoc, add_left_comm]


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.list.lattice
import data.list.range

/-!
# Intervals in ℕ

This file defines intervals of naturals. `list.Ico m n` is the list of integers greater than `m`
and strictly less than `n`.

## TODO
- Define `Ioo` and `Icc`, state basic lemmas about them.
- Also do the versions for integers?
- One could generalise even further, defining 'locally finite partial orders', for which
  `set.Ico a b` is `[finite]`, and 'locally finite total orders', for which there is a list model.
- Once the above is done, get rid of `data.int.range` (and maybe `list.range'`?).
-/

open nat

namespace list
/--
`Ico n m` is the list of natural numbers `n ≤ x < m`.
(Ico stands for "interval, closed-open".)

See also `data/set/intervals.lean` for `set.Ico`, modelling intervals in general preorders, and
`multiset.Ico` and `finset.Ico` for `n ≤ x < m` as a multiset or as a finset.
 -/
def Ico (n m : ℕ) : list ℕ := range' n (m - n)

namespace Ico

theorem zero_bot (n : ℕ) : Ico 0 n = range n :=
by rw [Ico, tsub_zero, range_eq_range']

@[simp] theorem length (n m : ℕ) : length (Ico n m) = m - n :=
by { dsimp [Ico], simp only [length_range'] }

theorem pairwise_lt (n m : ℕ) : pairwise (<) (Ico n m) :=
by { dsimp [Ico], simp only [pairwise_lt_range'] }

theorem nodup (n m : ℕ) : nodup (Ico n m) :=
by { dsimp [Ico], simp only [nodup_range'] }

@[simp] theorem mem {n m l : ℕ} : l ∈ Ico n m ↔ n ≤ l ∧ l < m :=
suffices n ≤ l ∧ l < n + (m - n) ↔ n ≤ l ∧ l < m, by simp [Ico, this],
begin
  cases le_total n m with hnm hmn,
  { rw [add_tsub_cancel_of_le hnm] },
  { rw [tsub_eq_zero_iff_le.mpr hmn, add_zero],
    exact and_congr_right (assume hnl, iff.intro
      (assume hln, (not_le_of_gt hln hnl).elim)
      (assume hlm, lt_of_lt_of_le hlm hmn)) }
end

theorem eq_nil_of_le {n m : ℕ} (h : m ≤ n) : Ico n m = [] :=
by simp [Ico, tsub_eq_zero_iff_le.mpr h]

theorem map_add (n m k : ℕ) : (Ico n m).map ((+) k) = Ico (n + k) (m + k) :=
by rw [Ico, Ico, map_add_range', add_tsub_add_eq_tsub_right, add_comm n k]

theorem map_sub (n m k : ℕ) (h₁ : k ≤ n) : (Ico n m).map (λ x, x - k) = Ico (n - k) (m - k) :=
by rw [Ico, Ico, tsub_tsub_tsub_cancel_right h₁, map_sub_range' _ _ _ h₁]

@[simp] theorem self_empty {n : ℕ} : Ico n n = [] :=
eq_nil_of_le (le_refl n)

@[simp] theorem eq_empty_iff {n m : ℕ} : Ico n m = [] ↔ m ≤ n :=
iff.intro (assume h, tsub_eq_zero_iff_le.mp $ by rw [← length, h, list.length]) eq_nil_of_le

lemma append_consecutive {n m l : ℕ} (hnm : n ≤ m) (hml : m ≤ l) :
  Ico n m ++ Ico m l = Ico n l :=
begin
  dunfold Ico,
  convert range'_append _ _ _,
  { exact (add_tsub_cancel_of_le hnm).symm },
  { rwa [← add_tsub_assoc_of_le hnm, tsub_add_cancel_of_le] }
end

@[simp] lemma inter_consecutive (n m l : ℕ) : Ico n m ∩ Ico m l = [] :=
begin
  apply eq_nil_iff_forall_not_mem.2,
  intro a,
  simp only [and_imp, not_and, not_lt, list.mem_inter, list.Ico.mem],
  intros h₁ h₂ h₃,
  exfalso,
  exact not_lt_of_ge h₃ h₂
end

@[simp] lemma bag_inter_consecutive (n m l : ℕ) : list.bag_inter (Ico n m) (Ico m l) = [] :=
(bag_inter_nil_iff_inter_nil _ _).2 (inter_consecutive n m l)

@[simp] theorem succ_singleton {n : ℕ} : Ico n (n+1) = [n] :=
by { dsimp [Ico], simp [add_tsub_cancel_left] }

theorem succ_top {n m : ℕ} (h : n ≤ m) : Ico n (m + 1) = Ico n m ++ [m] :=
by { rwa [← succ_singleton, append_consecutive], exact nat.le_succ _ }

theorem eq_cons {n m : ℕ} (h : n < m) : Ico n m = n :: Ico (n + 1) m :=
by { rw [← append_consecutive (nat.le_succ n) h, succ_singleton], refl }

@[simp] theorem pred_singleton {m : ℕ} (h : 0 < m) : Ico (m - 1) m = [m - 1] :=
by { dsimp [Ico], rw tsub_tsub_cancel_of_le (succ_le_of_lt h), simp }

theorem chain'_succ (n m : ℕ) : chain' (λa b, b = succ a) (Ico n m) :=
begin
  by_cases n < m,
  { rw [eq_cons h], exact chain_succ_range' _ _ },
  { rw [eq_nil_of_le (le_of_not_gt h)], trivial }
end

@[simp] theorem not_mem_top {n m : ℕ} : m ∉ Ico n m :=
by simp

lemma filter_lt_of_top_le {n m l : ℕ} (hml : m ≤ l) : (Ico n m).filter (λ x, x < l) = Ico n m :=
filter_eq_self.2 $ assume k hk, lt_of_lt_of_le (mem.1 hk).2 hml

lemma filter_lt_of_ge {n m l : ℕ} (hlm : l ≤ m) : (Ico n m).filter (λ x, x < l) = Ico n l :=
begin
  cases le_total n l with hnl hln,
  { rw [← append_consecutive hnl hlm, filter_append,
      filter_lt_of_top_le (le_refl l), filter_lt_of_le_bot (le_refl l), append_nil] },
  { rw [eq_nil_of_le hln, filter_lt_of_le_bot hln] }
end

@[simp] lemma filter_lt (n m l : ℕ) : (Ico n m).filter (λ x, x < l) = Ico n (min m l) :=
begin
  cases le_total m l with hml hlm,
  { rw [min_eq_left hml, filter_lt_of_top_le hml] },
  { rw [min_eq_right hlm, filter_lt_of_ge hlm] }
end

lemma filter_le_of_le_bot {n m l : ℕ} (hln : l ≤ n) : (Ico n m).filter (λ x, l ≤ x) = Ico n m :=
filter_eq_self.2 $ assume k hk, le_trans hln (mem.1 hk).1

lemma filter_le_of_top_le {n m l : ℕ} (hml : m ≤ l) : (Ico n m).filter (λ x, l ≤ x) = [] :=
filter_eq_nil.2 $ assume k hk, not_le_of_gt (lt_of_lt_of_le (mem.1 hk).2 hml)

lemma filter_le_of_le {n m l : ℕ} (hnl : n ≤ l) : (Ico n m).filter (λ x, l ≤ x) = Ico l m :=
begin
  cases le_total l m with hlm hml,
  { rw [← append_consecutive hnl hlm, filter_append,
      filter_le_of_top_le (le_refl l), filter_le_of_le_bot (le_refl l), nil_append] },
  { rw [eq_nil_of_le hml, filter_le_of_top_le hml] }
end

@[simp] lemma filter_le (n m l : ℕ) : (Ico n m).filter (λ x, l ≤ x) = Ico (max n l) m :=
begin
  cases le_total n l with hnl hln,
  { rw [max_eq_right hnl, filter_le_of_le hnl] },
  { rw [max_eq_left hln, filter_le_of_le_bot hln] }
end

lemma filter_lt_of_succ_bot {n m : ℕ} (hnm : n < m) : (Ico n m).filter (λ x, x < n + 1) = [n] :=
begin
  have r : min m (n + 1) = n + 1 := (@inf_eq_right _ _ m (n + 1)).mpr hnm,
  simp [filter_lt n m (n + 1), r],
end

@[simp] lemma filter_le_of_bot {n m : ℕ} (hnm : n < m) : (Ico n m).filter (λ x, x ≤ n) = [n] :=
begin
  rw ←filter_lt_of_succ_bot hnm,
  exact filter_congr' (λ _ _, lt_succ_iff.symm),
end

/--
For any natural numbers n, a, and b, one of the following holds:
1. n < a
2. n ≥ b
3. n ∈ Ico a b
-/
lemma trichotomy (n a b : ℕ) : n < a ∨ b ≤ n ∨ n ∈ Ico a b :=
begin
  by_cases h₁ : n < a,
  { left, exact h₁ },
  { right,
    by_cases h₂ : n ∈ Ico a b,
    { right, exact h₂ },
    { left,  simp only [Ico.mem, not_and, not_lt] at *, exact h₂ h₁ }}
end

end Ico
end list


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.multiset.finset_ops
import data.multiset.fold

/-!
# Lattice operations on multisets
-/

namespace multiset
variables {α : Type*}

/-! ### sup -/
section sup
-- can be defined with just `[has_bot α]` where some lemmas hold without requiring `[order_bot α]`
variables [semilattice_sup α] [order_bot α]

/-- Supremum of a multiset: `sup {a, b, c} = a ⊔ b ⊔ c` -/
def sup (s : multiset α) : α := s.fold (⊔) ⊥

@[simp] lemma sup_zero : (0 : multiset α).sup = ⊥ :=
fold_zero _ _

@[simp] lemma sup_cons (a : α) (s : multiset α) :
  (a ::ₘ s).sup = a ⊔ s.sup :=
fold_cons_left _ _ _ _

@[simp] lemma sup_singleton {a : α} : ({a} : multiset α).sup = a :=
sup_bot_eq

@[simp] lemma sup_add (s₁ s₂ : multiset α) : (s₁ + s₂).sup = s₁.sup ⊔ s₂.sup :=
eq.trans (by simp [sup]) (fold_add _ _ _ _ _)

lemma sup_le {s : multiset α} {a : α} : s.sup ≤ a ↔ (∀b ∈ s, b ≤ a) :=
multiset.induction_on s (by simp)
  (by simp [or_imp_distrib, forall_and_distrib] {contextual := tt})

lemma le_sup {s : multiset α} {a : α} (h : a ∈ s) : a ≤ s.sup :=
sup_le.1 le_rfl _ h

lemma sup_mono {s₁ s₂ : multiset α} (h : s₁ ⊆ s₂) : s₁.sup ≤ s₂.sup :=
sup_le.2 $ assume b hb, le_sup (h hb)

variables [decidable_eq α]

@[simp] lemma sup_dedup (s : multiset α) : (dedup s).sup = s.sup :=
fold_dedup_idem _ _ _

@[simp] lemma sup_ndunion (s₁ s₂ : multiset α) :
  (ndunion s₁ s₂).sup = s₁.sup ⊔ s₂.sup :=
by rw [← sup_dedup, dedup_ext.2, sup_dedup, sup_add]; simp

@[simp] lemma sup_union (s₁ s₂ : multiset α) :
  (s₁ ∪ s₂).sup = s₁.sup ⊔ s₂.sup :=
by rw [← sup_dedup, dedup_ext.2, sup_dedup, sup_add]; simp

@[simp] lemma sup_ndinsert (a : α) (s : multiset α) :
  (ndinsert a s).sup = a ⊔ s.sup :=
by rw [← sup_dedup, dedup_ext.2, sup_dedup, sup_cons]; simp

lemma nodup_sup_iff {α : Type*} [decidable_eq α] {m : multiset (multiset α) } :
  m.sup.nodup ↔ ∀ (a : multiset α), a ∈ m → a.nodup :=
begin
  apply m.induction_on,
  { simp },
  { intros a s h,
    simp [h] }
end

end sup

/-! ### inf -/
section inf
-- can be defined with just `[has_top α]` where some lemmas hold without requiring `[order_top α]`
variables [semilattice_inf α] [order_top α]

/-- Infimum of a multiset: `inf {a, b, c} = a ⊓ b ⊓ c` -/
def inf (s : multiset α) : α := s.fold (⊓) ⊤

@[simp] lemma inf_zero : (0 : multiset α).inf = ⊤ :=
fold_zero _ _

@[simp]

@[simp] lemma inf_singleton {a : α} : ({a} : multiset α).inf = a :=
inf_top_eq

@[simp] lemma inf_add (s₁ s₂ : multiset α) : (s₁ + s₂).inf = s₁.inf ⊓ s₂.inf :=
eq.trans (by simp [inf]) (fold_add _ _ _ _ _)

lemma le_inf {s : multiset α} {a : α} : a ≤ s.inf ↔ (∀b ∈ s, a ≤ b) :=
multiset.induction_on s (by simp)
  (by simp [or_imp_distrib, forall_and_distrib] {contextual := tt})

lemma inf_le {s : multiset α} {a : α} (h : a ∈ s) : s.inf ≤ a :=
le_inf.1 le_rfl _ h

lemma inf_mono {s₁ s₂ : multiset α} (h : s₁ ⊆ s₂) : s₂.inf ≤ s₁.inf :=
le_inf.2 $ assume b hb, inf_le (h hb)

variables [decidable_eq α]

@[simp] lemma inf_dedup (s : multiset α) : (dedup s).inf = s.inf :=
fold_dedup_idem _ _ _

@[simp] lemma inf_ndunion (s₁ s₂ : multiset α) :
  (ndunion s₁ s₂).inf = s₁.inf ⊓ s₂.inf :=
by rw [← inf_dedup, dedup_ext.2, inf_dedup, inf_add]; simp

@[simp] lemma inf_union (s₁ s₂ : multiset α) :
  (s₁ ∪ s₂).inf = s₁.inf ⊓ s₂.inf :=
by rw [← inf_dedup, dedup_ext.2, inf_dedup, inf_add]; simp

@[simp] lemma inf_ndinsert (a : α) (s : multiset α) :
  (ndinsert a s).inf = a ⊓ s.inf :=
by rw [← inf_dedup, dedup_ext.2, inf_dedup, inf_cons]; simp

end inf

end multiset


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, David Renshaw
-/
import Mathlib.Tactic.Tauto

section tauto₀
variable (p q r : Prop)
variable (h : p ∧ q ∨ p ∧ r)

example : p ∧ p :=
by tauto

end tauto₀

section tauto₁
variable (α : Type)
variable (p q r : α → Prop)
variable (h : (∃ x, p x ∧ q x) ∨ (∃ x, p x ∧ r x))

example : ∃ x, p x :=
by tauto

end tauto₁

section tauto₂
variable (α : Type)
variable (x : α)
variable (p q r : α → Prop)
variable (h₀ : (∀ x, p x → q x → r x) ∨ r x)
variable (h₁ : p x)
variable (h₂ : q x)

example : ∃ x, r x :=
by tauto

end tauto₂

section tauto₃

example (p : Prop) : p ∧ True ↔ p := by tauto
example (p : Prop) : p ∨ False ↔ p := by tauto

example (p q : Prop) (h : p ≠ q) : ¬ p ↔ q := by tauto
example (p q : Prop) (h : ¬ p = q) : ¬ p ↔ q := by tauto

example (p q r : Prop) : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (r ∨ p ∨ r) :=
  by tauto
example (p q r : Prop) : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (r ∨ p ∨ r) :=
  by tauto

example (p q : Prop) (h : ¬ (p ↔ q)) (h' : ¬ p) : q := by tauto
example (p q : Prop) (h : ¬ (p ↔ q)) (h' : p) : ¬ q := by tauto
example (p q : Prop) (h : ¬ (p ↔ q)) (h' : q) : ¬ p := by tauto
example (p q : Prop) (h : ¬ (p ↔ q)) (h' : ¬ q) : p := by tauto

example (p q : Prop) (h : ¬ (p ↔ q)) (h' : ¬ q) (h'' : ¬ p) : False :=
by tauto

example (p q r : Prop) (h : p ↔ q) (h' : r ↔ q) (h'' : ¬ r) : ¬ p :=
by tauto

example (p q r : Prop) (h : p ↔ q) (h' : r ↔ q) : p ↔ r :=
by tauto

example (p q r : Prop) (h : ¬ p = q) (h' : r = q) : p ↔ ¬ r := by tauto

example (p : Prop) : p → ¬ (p → ¬ p) := by tauto
example (p : Prop) (em : p ∨ ¬ p) : ¬ (p ↔ ¬ p) := by tauto

example (P : Nat → Prop) (n : Nat) : P n → n = 7 ∨ n = 0 ∨ ¬ (n = 7 ∨ n = 0) ∧ P n :=
by tauto

section implementation_detail_ldecl
variable (a b c : Nat)

/--
Mathlib.Tactic.Tauto.distribNot must ignore any LocalDecl where isImplementationDetail
is true. Otherwise, this example yields an error saying "well-founded recursion cannot
be used".
-/
example : ¬(¬a ≤ b ∧ a ≤ c ∨ ¬a ≤ c ∧ a ≤ b) ↔ a ≤ b ∧ a ≤ c ∨ ¬a ≤ c ∧ ¬a ≤ b :=
by tauto

end implementation_detail_ldecl

section modulo_symmetry
variable {p q r : Prop} {α : Type} {x y : α}
variable (h : x = y)
variable (h'' : (p ∧ q ↔ q ∨ r) ↔ (r ∧ p ↔ r ∨ q))

-- Currently this hits a "failed to show termination error"
-- because it erroneously used a recursive hypothesis.
-- See https://github.com/leanprover-community/mathlib4/issues/1061 and
-- https://github.com/leanprover/lean4/issues/1963
-- example (h' : ¬ y = x) : p ∧ q := by tauto

/-
example (h' : p ∧ ¬ y = x) : p ∧ q := by tauto
example : y = x := by tauto
example (h' : ¬ x = y) : p ∧ q := by tauto
example : x = y := by tauto
-/
end modulo_symmetry

section pair_eq_pair_iff

variable (α : Type)
variable (x y z w : α)

-- This example is taken from pair_eq_pair_iff in Data.Set.Basic.
-- It currently doesn't work because `tauto` does not apply `symm`.
--example : ((x = z ∨ x = w) ∧ (y = z ∨ y = w)) ∧
--           (z = x ∨ z = y) ∧ (w = x ∨ w = y) → x = z ∧ y = w ∨ x = w ∧ y = z :=
--by tauto

end pair_eq_pair_iff

end tauto₃

/-
section closer

example {α : Type _} {β : Type _} (a : α)
  {s_1 : set α} :
  (∃ (a_1 : α), a_1 = a ∨ a_1 ∈ s_1) :=
begin
  tauto {closer := `[simp]}
end

variables {p q r : Prop} {α : Type} {x y z w : α}
variables (h : x = y) (h₁ : y = z) (h₂ : z = w)
variables (h'' : (p ∧ q ↔ q ∨ r) ↔ (r ∧ p ↔ r ∨ q))
include h h₁ h₂ h''

example : (((r ∧ p ↔ r ∨ q) ∧ (q ∨ r)) → (p ∧ (x = w) ∧ (¬ x = w → p ∧ q ∧ r))) :=
begin
  tauto {closer := `[cc]}
end

end closer
-/

/-  Zulip discussion:
https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/tauto!.20fails.20on.20ne
-/
example {x y : Nat} (h : ¬x ≠ y) : x = y :=
by tauto