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

! This file was ported from Lean 3 source module algebra.quaternion_basis
! leanprover-community/mathlib commit 3aa5b8a9ed7a7cabd36e6e1d022c9858ab8a8c2d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Quaternion
import Mathbin.Tactic.Ring

/-!
# Basis on a quaternion-like algebra

## Main definitions

* `quaternion_algebra.basis A c₁ c₂`: a basis for a subspace of an `R`-algebra `A` that has the
  same algebra structure as `ℍ[R,c₁,c₂]`.
* `quaternion_algebra.basis.self R`: the canonical basis for `ℍ[R,c₁,c₂]`.
* `quaternion_algebra.basis.comp_hom b f`: transform a basis `b` by an alg_hom `f`.
* `quaternion_algebra.lift`: Define an `alg_hom` out of `ℍ[R,c₁,c₂]` by its action on the basis
  elements `i`, `j`, and `k`. In essence, this is a universal property. Analogous to `complex.lift`,
  but takes a bundled `quaternion_algebra.basis` instead of just a `subtype` as the amount of
  data / proves is non-negligeable.
-/

open Quaternion

namespace QuaternionAlgebra

/-- A quaternion basis contains the information both sufficient and necessary to construct an
`R`-algebra homomorphism from `ℍ[R,c₁,c₂]` to `A`; or equivalently, a surjective
`R`-algebra homomorphism from `ℍ[R,c₁,c₂]` to an `R`-subalgebra of `A`.

Note that for definitional convenience, `k` is provided as a field even though `i_mul_j` fully
determines it. -/
structure Basis {R : Type _} (A : Type _) [CommRing R] [Ring A] [Algebra R A] (c₁ c₂ : R) where
  (i j k : A)
  i_mul_i : i * i = c₁ • 1
  j_mul_j : j * j = c₂ • 1
  i_mul_j : i * j = k
  j_mul_i : j * i = -k
#align quaternion_algebra.basis QuaternionAlgebra.Basis

variable {R : Type _} {A B : Type _} [CommRing R] [Ring A] [Ring B] [Algebra R A] [Algebra R B]

variable {c₁ c₂ : R}

namespace Basis

/-- Since `k` is redundant, it is not necessary to show `q₁.k = q₂.k` when showing `q₁ = q₂`. -/
@[ext]
protected theorem ext ⦃q₁ q₂ : Basis A c₁ c₂⦄ (hi : q₁.i = q₂.i) (hj : q₁.j = q₂.j) : q₁ = q₂ :=
  by
  cases q₁
  cases q₂
  congr
  rw [← q₁_i_mul_j, ← q₂_i_mul_j]
  congr
#align quaternion_algebra.basis.ext QuaternionAlgebra.Basis.ext

variable (R)

/-- There is a natural quaternionic basis for the `quaternion_algebra`. -/
@[simps i j k]
protected def self : Basis ℍ[R,c₁,c₂] c₁ c₂
    where
  i := ⟨0, 1, 0, 0⟩
  i_mul_i := by ext <;> simp
  j := ⟨0, 0, 1, 0⟩
  j_mul_j := by ext <;> simp
  k := ⟨0, 0, 0, 1⟩
  i_mul_j := by ext <;> simp
  j_mul_i := by ext <;> simp
#align quaternion_algebra.basis.self QuaternionAlgebra.Basis.self

variable {R}

instance : Inhabited (Basis ℍ[R,c₁,c₂] c₁ c₂) :=
  ⟨Basis.self R⟩

variable (q : Basis A c₁ c₂)

include q

attribute [simp] i_mul_i j_mul_j i_mul_j j_mul_i

@[simp]
theorem i_mul_k : q.i * q.k = c₁ • q.j := by
  rw [← i_mul_j, ← mul_assoc, i_mul_i, smul_mul_assoc, one_mul]
#align quaternion_algebra.basis.i_mul_k QuaternionAlgebra.Basis.i_mul_k

@[simp]
theorem k_mul_i : q.k * q.i = -c₁ • q.j := by
  rw [← i_mul_j, mul_assoc, j_mul_i, mul_neg, i_mul_k, neg_smul]
#align quaternion_algebra.basis.k_mul_i QuaternionAlgebra.Basis.k_mul_i

@[simp]
theorem k_mul_j : q.k * q.j = c₂ • q.i := by
  rw [← i_mul_j, mul_assoc, j_mul_j, mul_smul_comm, mul_one]
#align quaternion_algebra.basis.k_mul_j QuaternionAlgebra.Basis.k_mul_j

@[simp]
theorem j_mul_k : q.j * q.k = -c₂ • q.i := by
  rw [← i_mul_j, ← mul_assoc, j_mul_i, neg_mul, k_mul_j, neg_smul]
#align quaternion_algebra.basis.j_mul_k QuaternionAlgebra.Basis.j_mul_k

@[simp]
theorem k_mul_k : q.k * q.k = -((c₁ * c₂) • 1) := by
  rw [← i_mul_j, mul_assoc, ← mul_assoc q.j _ _, j_mul_i, ← i_mul_j, ← mul_assoc, mul_neg, ←
    mul_assoc, i_mul_i, smul_mul_assoc, one_mul, neg_mul, smul_mul_assoc, j_mul_j, smul_smul]
#align quaternion_algebra.basis.k_mul_k QuaternionAlgebra.Basis.k_mul_k

/-- Intermediate result used to define `quaternion_algebra.basis.lift_hom`. -/
def lift (x : ℍ[R,c₁,c₂]) : A :=
  algebraMap R _ x.re + x.imI • q.i + x.imJ • q.j + x.imK • q.k
#align quaternion_algebra.basis.lift QuaternionAlgebra.Basis.lift

theorem lift_zero : q.lift (0 : ℍ[R,c₁,c₂]) = 0 := by simp [lift]
#align quaternion_algebra.basis.lift_zero QuaternionAlgebra.Basis.lift_zero

theorem lift_one : q.lift (1 : ℍ[R,c₁,c₂]) = 1 := by simp [lift]
#align quaternion_algebra.basis.lift_one QuaternionAlgebra.Basis.lift_one

theorem lift_add (x y : ℍ[R,c₁,c₂]) : q.lift (x + y) = q.lift x + q.lift y :=
  by
  simp [lift, add_smul]
  abel
#align quaternion_algebra.basis.lift_add QuaternionAlgebra.Basis.lift_add

theorem lift_mul (x y : ℍ[R,c₁,c₂]) : q.lift (x * y) = q.lift x * q.lift y :=
  by
  simp only [lift, Algebra.algebraMap_eq_smul_one]
  simp only [add_mul]
  simp only [add_mul, mul_add, smul_mul_assoc, mul_smul_comm, one_mul, mul_one, ← Algebra.smul_def,
    smul_add, smul_smul]
  simp only [i_mul_i, j_mul_j, i_mul_j, j_mul_i, i_mul_k, k_mul_i, k_mul_j, j_mul_k, k_mul_k]
  simp only [smul_smul, smul_neg, sub_eq_add_neg, add_smul, ← add_assoc, mul_neg, neg_smul]
  simp only [mul_right_comm _ _ (c₁ * c₂), mul_comm _ (c₁ * c₂)]
  simp only [mul_comm _ c₁, mul_right_comm _ _ c₁]
  simp only [mul_comm _ c₂, mul_right_comm _ _ c₂]
  simp only [← mul_comm c₁ c₂, ← mul_assoc]
  simp [sub_eq_add_neg, add_smul, ← add_assoc]
  abel
#align quaternion_algebra.basis.lift_mul QuaternionAlgebra.Basis.lift_mul

theorem lift_smul (r : R) (x : ℍ[R,c₁,c₂]) : q.lift (r • x) = r • q.lift x := by
  simp [lift, mul_smul, ← Algebra.smul_def]
#align quaternion_algebra.basis.lift_smul QuaternionAlgebra.Basis.lift_smul

/-- A `quaternion_algebra.basis` implies an `alg_hom` from the quaternions. -/
@[simps]
def liftHom : ℍ[R,c₁,c₂] →ₐ[R] A :=
  AlgHom.mk'
    { toFun := q.lift
      map_zero' := q.lift_zero
      map_one' := q.lift_one
      map_add' := q.lift_add
      map_mul' := q.lift_mul } q.lift_smul
#align quaternion_algebra.basis.lift_hom QuaternionAlgebra.Basis.liftHom

/-- Transform a `quaternion_algebra.basis` through an `alg_hom`. -/
@[simps i j k]
def compHom (F : A →ₐ[R] B) : Basis B c₁ c₂
    where
  i := F q.i
  i_mul_i := by rw [← F.map_mul, q.i_mul_i, F.map_smul, F.map_one]
  j := F q.j
  j_mul_j := by rw [← F.map_mul, q.j_mul_j, F.map_smul, F.map_one]
  k := F q.k
  i_mul_j := by rw [← F.map_mul, q.i_mul_j]
  j_mul_i := by rw [← F.map_mul, q.j_mul_i, F.map_neg]
#align quaternion_algebra.basis.comp_hom QuaternionAlgebra.Basis.compHom

end Basis

/-- A quaternionic basis on `A` is equivalent to a map from the quaternion algebra to `A`. -/
@[simps]
def lift : Basis A c₁ c₂ ≃ (ℍ[R,c₁,c₂] →ₐ[R] A)
    where
  toFun := Basis.liftHom
  invFun := (Basis.self R).compHom
  left_inv q := by ext <;> simp [basis.lift]
  right_inv F := by
    ext
    dsimp [basis.lift]
    rw [← F.commutes]
    simp only [← F.commutes, ← F.map_smul, ← F.map_add, mk_add_mk, smul_mk, smul_zero,
      algebra_map_eq]
    congr
    simp
#align quaternion_algebra.lift QuaternionAlgebra.lift

end QuaternionAlgebra


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Frédéric Dupuis
-/
import analysis.normed_space.hahn_banach
import analysis.normed_space.inner_product

/-!
# The topological dual of a normed space

In this file we define the topological dual of a normed space, and the bounded linear map from
a normed space into its double dual.

We also prove that, for base field `𝕜` with `[is_R_or_C 𝕜]`, this map is an isometry.

We then consider inner product spaces, with base field over `ℝ` (the corresponding results for `ℂ`
will require the definition of conjugate-linear maps). We define `to_dual_map`, a continuous linear
map from `E` to its dual, which maps an element `x` of the space to `λ y, ⟪x, y⟫`. We check
(`to_dual_map_isometry`) that this map is an isometry onto its image, and particular is injective.
We also define `to_dual'` as the function taking taking a vector to its dual for a base field `𝕜`
with `[is_R_or_C 𝕜]`; this is a function and not a linear map.

Finally, under the hypothesis of completeness (i.e., for Hilbert spaces), we prove the Fréchet-Riesz
representation (`to_dual_map_eq_top`), which states the surjectivity: every element of the dual
of a Hilbert space `E` has the form `λ u, ⟪x, u⟫` for some `x : E`.  This permits the map
`to_dual_map` to be upgraded to an (isometric) continuous linear equivalence, `to_dual`, between a
Hilbert space and its dual.

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

## References

* [M. Einsiedler and T. Ward, *Functional Analysis, Spectral Theory, and Applications*]
  [EinsiedlerWard2017]

## Tags

dual, Fréchet-Riesz
-/

noncomputable theory
open_locale classical
universes u v

namespace normed_space

section general
variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
variables (E : Type*) [semi_normed_group E] [semi_normed_space 𝕜 E]
variables (F : Type*) [normed_group F] [normed_space 𝕜 F]

/-- The topological dual of a seminormed space `E`. -/
@[derive [has_coe_to_fun, semi_normed_group, semi_normed_space 𝕜]] def dual := E →L[𝕜] 𝕜

instance : inhabited (dual 𝕜 E) := ⟨0⟩

instance : normed_group (dual 𝕜 F) := continuous_linear_map.to_normed_group

instance : normed_space 𝕜 (dual 𝕜 F) := continuous_linear_map.to_normed_space

/-- The inclusion of a normed space in its double (topological) dual. -/
def inclusion_in_double_dual' (x : E) : (dual 𝕜 (dual 𝕜 E)) :=
linear_map.mk_continuous
  { to_fun := λ f, f x,
    map_add'    := by simp,
    map_smul'   := by simp }
  ∥x∥
  (λ f, by { rw mul_comm, exact f.le_op_norm x } )

@[simp] lemma dual_def (x : E) (f : dual 𝕜 E) :
  ((inclusion_in_double_dual' 𝕜 E) x) f = f x := rfl

lemma double_dual_bound (x : E) : ∥(inclusion_in_double_dual' 𝕜 E) x∥ ≤ ∥x∥ :=
begin
  apply continuous_linear_map.op_norm_le_bound,
  { simp },
  { intros f, rw mul_comm, exact f.le_op_norm x, }
end

/-- The inclusion of a normed space in its double (topological) dual, considered
   as a bounded linear map. -/
def inclusion_in_double_dual : E →L[𝕜] (dual 𝕜 (dual 𝕜 E)) :=
linear_map.mk_continuous
  { to_fun := λ (x : E), (inclusion_in_double_dual' 𝕜 E) x,
    map_add'    := λ x y, by { ext, simp },
    map_smul'   := λ (c : 𝕜) x, by { ext, simp } }
  1
  (λ x, by { convert double_dual_bound _ _ _, simp } )

end general

section bidual_isometry

variables {𝕜 : Type v} [is_R_or_C 𝕜]
{E : Type u} [normed_group E] [normed_space 𝕜 E]

/-- If one controls the norm of every `f x`, then one controls the norm of `x`.
    Compare `continuous_linear_map.op_norm_le_bound`. -/
lemma norm_le_dual_bound (x : E) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ (f : dual 𝕜 E), ∥f x∥ ≤ M * ∥f∥) :
  ∥x∥ ≤ M :=
begin
  classical,
  by_cases h : x = 0,
  { simp only [h, hMp, norm_zero] },
  { obtain ⟨f, hf⟩ : ∃ g : E →L[𝕜] 𝕜, _ := exists_dual_vector x h,
    calc ∥x∥ = ∥norm' 𝕜 x∥ : (norm_norm' _ _ _).symm
    ... = ∥f x∥ : by rw hf.2
    ... ≤ M * ∥f∥ : hM f
    ... = M : by rw [hf.1, mul_one] }
end

/-- The inclusion of a normed space in its double dual is an isometry onto its image.-/
lemma inclusion_in_double_dual_isometry (x : E) : ∥inclusion_in_double_dual 𝕜 E x∥ = ∥x∥ :=
begin
  apply le_antisymm,
  { exact double_dual_bound 𝕜 E x },
  { rw continuous_linear_map.norm_def,
    apply real.lb_le_Inf _ continuous_linear_map.bounds_nonempty,
    rintros c ⟨hc1, hc2⟩,
    exact norm_le_dual_bound x hc1 hc2 },
end

end bidual_isometry

end normed_space

namespace inner_product_space
open is_R_or_C continuous_linear_map

section is_R_or_C

variables (𝕜 : Type*)
variables {E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E]
local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y
local postfix `†`:90 := @is_R_or_C.conj 𝕜 _

/--
Given some `x` in an inner product space, we can define its dual as the continuous linear map
`λ y, ⟪x, y⟫`. Consider using `to_dual` or `to_dual_map` instead in the real case.
-/
def to_dual' : E →+ normed_space.dual 𝕜 E :=
{ to_fun := λ x, linear_map.mk_continuous
  { to_fun := λ y, ⟪x, y⟫,
    map_add' := λ _ _, inner_add_right,
    map_smul' := λ _ _, inner_smul_right }
  ∥x∥
  (λ y, by { rw [is_R_or_C.norm_eq_abs], exact abs_inner_le_norm _ _ }),
  map_zero' := by { ext z, simp },
  map_add' := λ x y, by { ext z, simp [inner_add_left] } }

@[simp] lemma to_dual'_apply {x y : E} : to_dual' 𝕜 x y = ⟪x, y⟫ := rfl

/-- In an inner product space, the norm of the dual of a vector `x` is `∥x∥` -/
@[simp] lemma norm_to_dual'_apply (x : E) : ∥to_dual' 𝕜 x∥ = ∥x∥ :=
begin
  refine le_antisymm _ _,
  { exact linear_map.mk_continuous_norm_le _ (norm_nonneg _) _ },
  { cases eq_or_lt_of_le (norm_nonneg x) with h h,
    { have : x = 0 := norm_eq_zero.mp (eq.symm h),
      simp [this] },
    { refine (mul_le_mul_right h).mp _,
      calc ∥x∥ * ∥x∥ = ∥x∥ ^ 2 : by ring
      ... = re ⟪x, x⟫ : norm_sq_eq_inner _
      ... ≤ abs ⟪x, x⟫ : re_le_abs _
      ... = ∥to_dual' 𝕜 x x∥ : by simp [norm_eq_abs]
      ... ≤ ∥to_dual' 𝕜 x∥ * ∥x∥ : le_op_norm (to_dual' 𝕜 x) x } }
end

variables (E)

lemma to_dual'_isometry : isometry (@to_dual' 𝕜 E _ _) :=
add_monoid_hom.isometry_of_norm _ (norm_to_dual'_apply 𝕜)

/--
Fréchet-Riesz representation: any `ℓ` in the dual of a Hilbert space `E` is of the form
`λ u, ⟪y, u⟫` for some `y : E`, i.e. `to_dual'` is surjective.
-/
lemma to_dual'_surjective [complete_space E] : function.surjective (@to_dual' 𝕜 E _ _) :=
begin
  intros ℓ,
  set Y := ker ℓ with hY,
  by_cases htriv : Y = ⊤,
  { have hℓ : ℓ = 0,
    { have h' := linear_map.ker_eq_top.mp htriv,
      rw [←coe_zero] at h',
      apply coe_injective,
      exact h' },
    exact ⟨0, by simp [hℓ]⟩ },
  { have Ycomplete := is_complete_ker ℓ,
    rw [← submodule.orthogonal_eq_bot_iff Ycomplete, ←hY] at htriv,
    change Yᗮ ≠ ⊥ at htriv,
    rw [submodule.ne_bot_iff] at htriv,
    obtain ⟨z : E, hz : z ∈ Yᗮ, z_ne_0 : z ≠ 0⟩ := htriv,
    refine ⟨((ℓ z)† / ⟪z, z⟫) • z, _⟩,
    ext x,
    have h₁ : (ℓ z) • x - (ℓ x) • z ∈ Y,
    { rw [mem_ker, map_sub, map_smul, map_smul, algebra.id.smul_eq_mul, algebra.id.smul_eq_mul,
          mul_comm],
      exact sub_self (ℓ x * ℓ z) },
    have h₂ : (ℓ z) * ⟪z, x⟫ = (ℓ x) * ⟪z, z⟫,
    { have h₃ := calc
        0    = ⟪z, (ℓ z) • x - (ℓ x) • z⟫       : by { rw [(Y.mem_orthogonal' z).mp hz], exact h₁ }
         ... = ⟪z, (ℓ z) • x⟫ - ⟪z, (ℓ x) • z⟫  : by rw [inner_sub_right]
         ... = (ℓ z) * ⟪z, x⟫ - (ℓ x) * ⟪z, z⟫  : by simp [inner_smul_right],
      exact sub_eq_zero.mp (eq.symm h₃) },
    have h₄ := calc
      ⟪((ℓ z)† / ⟪z, z⟫) • z, x⟫ = (ℓ z) / ⟪z, z⟫ * ⟪z, x⟫
            : by simp [inner_smul_left, conj_div, conj_conj]
                            ... = (ℓ z) * ⟪z, x⟫ / ⟪z, z⟫
            : by rw [←div_mul_eq_mul_div]
                            ... = (ℓ x) * ⟪z, z⟫ / ⟪z, z⟫
            : by rw [h₂]
                            ... = ℓ x
            : begin
                have : ⟪z, z⟫ ≠ 0,
                { change z = 0 → false at z_ne_0,
                  rwa ←inner_self_eq_zero at z_ne_0 },
                field_simp [this]
              end,
    exact h₄ }
end

end is_R_or_C

section real

variables {F : Type*} [inner_product_space ℝ F]

/-- In a real inner product space `F`, the function that takes a vector `x` in `F` to its dual
`λ y, ⟪x, y⟫` is a continuous linear map. If the space is complete (i.e. is a Hilbert space),
consider using `to_dual` instead. -/
-- TODO extend to `is_R_or_C` (requires a definition of conjugate linear maps)
def to_dual_map : F →L[ℝ] (normed_space.dual ℝ F) :=
linear_map.mk_continuous
  { to_fun := to_dual' ℝ,
    map_add' := λ x y, by { ext, simp [inner_add_left] },
    map_smul' := λ c x, by { ext, simp [inner_smul_left] } }
  1
  (λ x, by simp only [norm_to_dual'_apply, one_mul, linear_map.coe_mk])

@[simp] lemma to_dual_map_apply {x y : F} : to_dual_map x y = ⟪x, y⟫_ℝ := rfl

/-- In an inner product space, the norm of the dual of a vector `x` is `∥x∥` -/
@[simp] lemma norm_to_dual_map_apply (x : F) : ∥to_dual_map x∥ = ∥x∥ := norm_to_dual'_apply _ _

lemma to_dual_map_isometry : isometry (@to_dual_map F _) :=
add_monoid_hom.isometry_of_norm _ norm_to_dual_map_apply

lemma to_dual_map_injective : function.injective (@to_dual_map F _) :=
(@to_dual_map_isometry F _).injective

@[simp] lemma ker_to_dual_map : (@to_dual_map F _).ker = ⊥ :=
linear_map.ker_eq_bot.mpr to_dual_map_injective

@[simp] lemma to_dual_map_eq_iff_eq {x y : F} : to_dual_map x = to_dual_map y ↔ x = y :=
((linear_map.ker_eq_bot).mp (@ker_to_dual_map F _)).eq_iff

variables [complete_space F]

/--
Fréchet-Riesz representation: any `ℓ` in the dual of a real Hilbert space `F` is of the form
`λ u, ⟪y, u⟫` for some `y` in `F`.  See `inner_product_space.to_dual` for the continuous linear
equivalence thus induced.
-/
-- TODO extend to `is_R_or_C` (requires a definition of conjugate linear maps)
lemma range_to_dual_map : (@to_dual_map F _).range = ⊤ :=
linear_map.range_eq_top.mpr (to_dual'_surjective ℝ F)

/--
Fréchet-Riesz representation: If `F` is a Hilbert space, the function that takes a vector in `F` to
its dual is a continuous linear equivalence.  -/
def to_dual : F ≃L[ℝ] (normed_space.dual ℝ F) :=
continuous_linear_equiv.of_isometry to_dual_map.to_linear_map to_dual_map_isometry range_to_dual_map

/--
Fréchet-Riesz representation: If `F` is a Hilbert space, the function that takes a vector in `F` to
its dual is an isometry.  -/
def isometric.to_dual : F ≃ᵢ normed_space.dual ℝ F :=
{ to_equiv := to_dual.to_linear_equiv.to_equiv,
  isometry_to_fun := to_dual'_isometry ℝ F}

@[simp] lemma to_dual_apply {x y : F} : to_dual x y = ⟪x, y⟫_ℝ := rfl

@[simp] lemma to_dual_eq_iff_eq {x y : F} : to_dual x = to_dual y ↔ x = y :=
(@to_dual F _ _).injective.eq_iff

lemma to_dual_eq_iff_eq' {x x' : F} : (∀ y : F, ⟪x, y⟫_ℝ = ⟪x', y⟫_ℝ) ↔ x = x' :=
begin
  split,
  { intros h,
    have : to_dual x = to_dual x' → x = x' := to_dual_eq_iff_eq.mp,
    apply this,
    simp_rw [←to_dual_apply] at h,
    ext z,
    exact h z },
  { rintros rfl y,
    refl }
end

@[simp] lemma norm_to_dual_apply (x : F) : ∥to_dual x∥ = ∥x∥ := norm_to_dual_map_apply x

/-- In a Hilbert space, the norm of a vector in the dual space is the norm of its corresponding
primal vector. -/
lemma norm_to_dual_symm_apply (ℓ : normed_space.dual ℝ F) : ∥to_dual.symm ℓ∥ = ∥ℓ∥ :=
begin
  have : ℓ = to_dual (to_dual.symm ℓ) := by simp only [continuous_linear_equiv.apply_symm_apply],
  conv_rhs { rw [this] },
  refine eq.symm (norm_to_dual_apply _),
end

end real

end inner_product_space


/- Lecture 3.3: Programming Semantics — Denotational Semantics -/

import .x33_library

-- enables β-reduced output
set_option pp.beta true

/- Complete lattices -/

class complete_lattice (α : Type) extends partial_order α :=
(Inf    : set α → α)
(Inf_le : ∀{s a}, a ∈ s → Inf s ≤ a)
(le_Inf : ∀{s a}, (∀a', a' ∈ s → a ≤ a') → a ≤ Inf s)

notation `⨅` := complete_lattice.Inf

/- Instance for complete lattices: `set α` -/

namespace set

lemma ext {α : Type} {s t : set α} (h : ∀a, a ∈ s ↔ a ∈ t) : s = t :=
begin
  funext a,
  apply propext,
  exact (h a)
end

instance (α : Type) : complete_lattice (set α) :=
{ le          := (⊆),
  le_refl     := assume s a, id,
  le_trans    := assume s t u hst htu a has, htu $ hst $ has,
  le_antisymm := assume s t hst hts,
    begin
      apply ext,
      intro a,
      apply iff.intro,
      exact assume h, hst h,
      exact assume h, hts h
    end,
  Inf         := assume f, {a | ∀s, s ∈ f → a ∈ s},
  Inf_le      := assume f s hsf a h, begin simp at h, exact h s hsf end,
  le_Inf      := assume f s h a has t htf, h t htf has }

end set

/- Monotonicity of functions -/

def monotone {α β} [partial_order α] [partial_order β] (f : α → β) :=
∀a₁ a₂, a₁ ≤ a₂ → f a₁ ≤ f a₂

namespace monotone

lemma id {α : Type} [partial_order α] : monotone (λa : α, a) :=
assume a₁ a₂ ha, ha

lemma const {α β : Type} [partial_order α] [partial_order β] (b : β) : monotone (λa : α, b) :=
begin
intros a b c,
apply le_refl
end

lemma union {α β : Type} [partial_order α] (f g : α → set β) (hf : monotone f) (hg : monotone g) :
  monotone (λa, f a ∪ g a) :=
begin
  intros a₁ a₂ ha b hb,
  cases hb,
  { exact or.intro_left _ (hf a₁ a₂ ha hb) },
  { exact or.intro_right _ (hg a₁ a₂ ha hb) },
end

end monotone

/- Least fixpoint -/

namespace complete_lattice

variables {α : Type} [complete_lattice α]

def lfp (f : α → α) : α :=
⨅ {x | f x ≤ x}

lemma lfp_le (f : α → α) (a : α) (h : f a ≤ a) :
  lfp f ≤ a :=
Inf_le h

lemma le_lfp (f : α → α) (a : α) (h : ∀a', f a' ≤ a' → a ≤ a') :
  a ≤ lfp f :=
le_Inf h

lemma lfp_eq (f : α → α) (hf : monotone f) :
  lfp f = f (lfp f) :=
begin
  have h : f (lfp f) ≤ lfp f :=
  begin
    apply le_lfp,
    intros a' ha',
    apply @le_trans _ _ _ (f a'),
    { apply hf,
      apply lfp_le,
      assumption },
    { assumption }
  end,
  apply le_antisymm,
  { apply lfp_le,
    apply hf,
    assumption },
  { assumption }
end

end complete_lattice

/- Relations -/

namespace lecture

open complete_lattice

def Id (α : Type) : set (α × α) := { x | x.2 = x.1 }

@[simp] lemma mem_Id {α : Type} (a b : α) :
  (a, b) ∈ Id α ↔ b = a :=
iff.rfl

def comp {α : Type} (r₁ r₂ : set (α × α)) : set (α × α) :=
{ x | ∃m, (x.1, m) ∈ r₁ ∧ (m, x.2) ∈ r₂ }

infixl ` ◯ ` : 90 := comp

@[simp] lemma mem_comp {α : Type} (r₁ r₂ : set (α × α)) (a b : α) :
  (a, b) ∈ r₁ ◯ r₂ ↔ (∃c, (a, c) ∈ r₁ ∧ (c, b) ∈ r₂) :=
iff.rfl

def restrict {α : Type} (r : set (α × α)) (p : α → Prop) : set (α × α) :=
{ x | p x.1 ∧ x ∈ r }

infixl ` ⇃ ` : 90 := restrict

@[simp] lemma mem_restrict {α : Type} (r : set (α × α)) (p : α → Prop) (a b : α) :
  (a, b) ∈ r ⇃ p ↔ p a ∧ (a, b) ∈ r :=
by refl

/- We will prove the following two lemmas in the exercise. -/

lemma monotone_comp {α β : Type} [partial_order α] (f g : α → set (β × β))
  (hf : monotone f) (hg : monotone g) : monotone (λa, f a ◯ g a) :=
begin
intros a1 a2 asmallerequal,
intro b,
intros fa1,
cases fa1,
simp[comp],
apply exists.intro fa1_w,
apply and.intro,
cases fa1_h,
apply hf a1,
assumption,
assumption,
cases fa1_h,
apply hg a1,
assumption,
assumption
end

lemma monotone_restrict {α β : Type} [partial_order α] (f : α → set (β × β)) (p : β → Prop)
  (hf : monotone f) : monotone (λa, f a ⇃ p) :=
begin
intros a1 a2,
intro a1smallera2,
intro b,
intro f1,
cases f1,
simp[restrict],
apply and.intro,
assumption,
apply hf a1,
assumption,
assumption
end

/- Denotational semantics -/

open program

variables {c : state → Prop} {f : state → ℕ} {p p₀ p₁ p₂ : program}

def den : program → set (state × state)
| skip          := Id state
| (assign n f)  := {x | x.2 = x.1.update n (f x.1)}
| (seq p₁ p₂)   := den p₁ ◯ den p₂
| (ite c p₁ p₂) := (den p₁ ⇃ c) ∪ (den p₂ ⇃ (λs, ¬ c s))
| (while c p)   := lfp (λW, ((den p ◯ W) ⇃ c) ∪ (Id state ⇃ λs, ¬ c s))

notation `⟦` p `⟧`:= den p

lemma den_while (p : program) (c : state → Prop) :
  ⟦ while c p ⟧ = ⟦ ite c (p ;; while c p) skip ⟧ :=
begin
  apply lfp_eq,
  apply monotone.union,
  { apply monotone_restrict,
    apply monotone_comp,
    { exact monotone.const _ },
    { exact monotone.id } },
  { exact monotone.const _ }
end

/- Equivalence of denotational and big-step semantics -/

lemma den_of_big_step (p : program) (s t : state) :
  (p, s) ⟹ t → (s, t) ∈ ⟦ p ⟧ :=
begin
  generalize eq : (p, s) = ps,
  intro h,
  induction h generalizing eq p s;
    cases eq;
    -- simplify only if the simplifier solves the goal completely
    try { simp [den, *], done },
  { exact ⟨h_t, h_ih_h₁ _ _ rfl, h_ih_h₂ _ _ rfl⟩ },
  { rw [den_while, den],
    simp [*],
    exact ⟨h_t, h_ih_hp _ _ rfl, h_ih_hw _ _ rfl⟩ },
  { rw [den_while],
    simp [den, *] }
end

lemma big_step_of_den :
  ∀(p : program) (s t : state), (s, t) ∈ ⟦ p ⟧ → (p, s) ⟹ t
| skip s t          :=
  by simp [den] {contextual := tt}; exact _
| (assign n f) s t  :=
  by simp [den] {contextual := tt}
| (seq p₁ p₂) s t   :=
  begin
    assume h,
    cases h with u hu,
    exact big_step.seq u (big_step_of_den p₁ _ _ hu.left) (big_step_of_den p₂ _ _ hu.right)
  end
| (ite c p₁ p₂) s t :=
  assume h,
  match h with
  | or.intro_left  _ ⟨hs, hst⟩ := big_step.ite_true  hs (big_step_of_den p₁ _ _ hst)
  | or.intro_right _ ⟨hs, hst⟩ := big_step.ite_false hs (big_step_of_den p₂ _ _ hst)
  end
| (while c p) s t   :=
  begin
    have hw : ⟦while c p⟧ ≤ {x | (while c p, x.1) ⟹ x.2},
    { apply lfp_le _ _ _,
      intros x hx,
      cases x with s t,
      simp at hx,
      cases hx,
      { cases hx with hs hst,
        cases hst with u hu,
        apply big_step.while_true u hs,
        { exact big_step_of_den p _ _ hu.left },
        { exact hu.right } },
      { cases hx,
        cases hx_right,
        apply big_step.while_false hx_left } },
    exact assume h, hw h
  end

lemma den_eq_bigstep (p : program) (s t : state ) : (s, t) ∈ ⟦ p ⟧ ↔ (p, s) ⟹ t :=
iff.intro
  (big_step_of_den p s t)
  (den_of_big_step p s t)

end lecture


variables (men : Type*) (barber : men)
variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) :
show false,
from (
  have bsb_iif_bnsb: (shaves barber barber ↔ ¬ shaves barber barber), from h barber,
  have bsb_bnsb: (shaves barber barber →  ¬ shaves barber barber), from iff.elim_left bsb_iif_bnsb,

  iff.elim_left (h barber)
)


import data.nat.prime
open nat

theorem sqrt_two_irrational {a b : ℕ} (co : gcd a b = 1) :
  a^2 ≠ 2 * b^2 :=
assume h : a^2 = 2 * b^2,
have 2 ∣ a^2,
  by simp [h],
have 2 ∣ a,
  from prime.dvd_of_dvd_pow prime_two this,
exists.elim this $
assume (c : nat) (aeq : a = 2 * c),
have 2 * (2 * c^2) = 2 * b^2,
  by simp [eq.symm h, aeq];
    simp [nat.pow_succ, mul_comm, mul_assoc, mul_left_comm],
have 2 * c^2 = b^2,
  from eq_of_mul_eq_mul_left dec_trivial this,
have 2 ∣ b^2,
  by simp [eq.symm this],
have 2 ∣ b,
  from prime.dvd_of_dvd_pow prime_two this,
have 2 ∣ gcd a b,
  from dvd_gcd ‹2 ∣ a› ‹2 ∣ b›,
have 2 ∣ (1 : ℕ),
  by simp * at *,
show false, from absurd ‹2 ∣ 1› dec_trivial


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

! This file was ported from Lean 3 source module data.nat.sqrt
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Order.Basic
import Mathbin.Data.Nat.Size

/-!
# Square root of natural numbers

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

This file defines an efficient binary implementation of the square root function that returns the
unique `r` such that `r * r ≤ n < (r + 1) * (r + 1)`. It takes advantage of the binary
representation by replacing the multiplication by 2 appearing in
`(a + b)^2 = a^2 + 2 * a * b + b^2` by a bitmask manipulation.

## Reference

See [Wikipedia, *Methods of computing square roots*]
(https://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Binary_numeral_system_(base_2)).
-/

namespace Nat

/- warning: nat.sqrt_aux_dec clashes with [anonymous] -> [anonymous]
warning: nat.sqrt_aux_dec -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {b : Nat}, (Ne.{1} Nat b (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (LT.lt.{0} Nat Nat.hasLt (Nat.shiftr b (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) b)
but is expected to have type
  forall {b : Type.{u}} {h : Type.{v}}, (Nat -> b -> h) -> Nat -> (List.{u} b) -> (List.{v} h)
Case conversion may be inaccurate. Consider using '#align nat.sqrt_aux_dec [anonymous]ₓ'. -/
theorem [anonymous] {b} (h : b ≠ 0) : shiftr b 2 < b :=
  by
  simp only [shiftr_eq_div_pow]
  apply (Nat.div_lt_iff_lt_mul' (by decide : 0 < 4)).2
  have := Nat.mul_lt_mul_of_pos_left (by decide : 1 < 4) (Nat.pos_of_ne_zero h)
  rwa [mul_one] at this
#align nat.sqrt_aux_dec [anonymous]

/- warning: nat.sqrt_aux clashes with [anonymous] -> [anonymous]
warning: nat.sqrt_aux -> [anonymous] is a dubious translation:
lean 3 declaration is
  Nat -> Nat -> Nat -> Nat
but is expected to have type
  forall {ᾰ : Type.{u}} {ᾰ_1 : Type.{v}}, (Nat -> ᾰ -> ᾰ_1) -> Nat -> (List.{u} ᾰ) -> (List.{v} ᾰ_1)
Case conversion may be inaccurate. Consider using '#align nat.sqrt_aux [anonymous]ₓ'. -/
/-- Auxiliary function for `nat.sqrt`. See e.g.
<https://en.wikipedia.org/wiki/Methods_of_computing_square_roots#Binary_numeral_system_(base_2)> -/
def [anonymous] : ℕ → ℕ → ℕ → ℕ
  | b, r, n =>
    if b0 : b = 0 then r
    else
      let b' := shiftr b 2
      have : b' < b := [anonymous] b0
      match (n - (r + b : ℕ) : ℤ) with
      | (n' : ℕ) => sqrt_aux b' (div2 r + b) n'
      | _ => sqrt_aux b' (div2 r) n
#align nat.sqrt_aux [anonymous]

#print Nat.sqrt /-
/-- `sqrt n` is the square root of a natural number `n`. If `n` is not a
  perfect square, it returns the largest `k:ℕ` such that `k*k ≤ n`. -/
@[pp_nodot]
def sqrt (n : ℕ) : ℕ :=
  match size n with
  | 0 => 0
  | succ s => [anonymous] (shiftl 1 (bit0 (div2 s))) 0 n
#align nat.sqrt Nat.sqrt
-/

/- warning: nat.sqrt_aux_0 clashes with [anonymous] -> [anonymous]
warning: nat.sqrt_aux_0 -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall (r : Nat) (n : Nat), Eq.{1} Nat ([anonymous] (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero))) r n) r
but is expected to have type
  forall {r : Type.{u}} {n : Type.{v}}, (Nat -> r -> n) -> Nat -> (List.{u} r) -> (List.{v} n)
Case conversion may be inaccurate. Consider using '#align nat.sqrt_aux_0 [anonymous]ₓ'. -/
theorem [anonymous] (r n) : [anonymous] 0 r n = r := by rw [sqrt_aux] <;> simp
#align nat.sqrt_aux_0 [anonymous]

attribute [local simp] sqrt_aux_0

/- warning: nat.sqrt_aux_1 clashes with [anonymous] -> [anonymous]
warning: nat.sqrt_aux_1 -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {r : Nat} {n : Nat} {b : Nat}, (Ne.{1} Nat b (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (forall {n' : Nat}, (Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) r b) n') n) -> (Eq.{1} Nat ([anonymous] b r n) ([anonymous] (Nat.shiftr b (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Nat.div2 r) b) n')))
but is expected to have type
  forall {r : Type.{u}} {n : Type.{v}}, (Nat -> r -> n) -> Nat -> (List.{u} r) -> (List.{v} n)
Case conversion may be inaccurate. Consider using '#align nat.sqrt_aux_1 [anonymous]ₓ'. -/
theorem [anonymous] {r n b} (h : b ≠ 0) {n'} (h₂ : r + b + n' = n) :
    [anonymous] b r n = [anonymous] (shiftr b 2) (div2 r + b) n' := by
  rw [sqrt_aux] <;> simp only [h, h₂.symm, Int.ofNat_add, if_false] <;>
    rw [add_comm _ (n' : ℤ), add_sub_cancel, sqrt_aux._match_1]
#align nat.sqrt_aux_1 [anonymous]

/- warning: nat.sqrt_aux_2 clashes with [anonymous] -> [anonymous]
warning: nat.sqrt_aux_2 -> [anonymous] is a dubious translation:
lean 3 declaration is
  forall {r : Nat} {n : Nat} {b : Nat}, (Ne.{1} Nat b (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (LT.lt.{0} Nat Nat.hasLt n (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) r b)) -> (Eq.{1} Nat ([anonymous] b r n) ([anonymous] (Nat.shiftr b (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne))))) (Nat.div2 r) n))
but is expected to have type
  forall {r : Type.{u}} {n : Type.{v}}, (Nat -> r -> n) -> Nat -> (List.{u} r) -> (List.{v} n)
Case conversion may be inaccurate. Consider using '#align nat.sqrt_aux_2 [anonymous]ₓ'. -/
theorem [anonymous] {r n b} (h : b ≠ 0) (h₂ : n < r + b) :
    [anonymous] b r n = [anonymous] (shiftr b 2) (div2 r) n :=
  by
  rw [sqrt_aux] <;> simp only [h, h₂, if_false]
  cases' Int.eq_negSucc_of_lt_zero (sub_lt_zero.2 (Int.ofNat_lt_ofNat_of_lt h₂)) with k e
  rw [e, sqrt_aux._match_1]
#align nat.sqrt_aux_2 [anonymous]

private def is_sqrt (n q : ℕ) : Prop :=
  q * q ≤ n ∧ n < (q + 1) * (q + 1)
#align nat.is_sqrt nat.is_sqrt

attribute [-simp] mul_eq_mul_left_iff mul_eq_mul_right_iff

private theorem sqrt_aux_is_sqrt_lemma (m r n : ℕ) (h₁ : r * r ≤ n) (m')
    (hm : shiftr (2 ^ m * 2 ^ m) 2 = m')
    (H1 : n < (r + 2 ^ m) * (r + 2 ^ m) → IsSqrt n ([anonymous] m' (r * 2 ^ m) (n - r * r)))
    (H2 :
      (r + 2 ^ m) * (r + 2 ^ m) ≤ n →
        IsSqrt n ([anonymous] m' ((r + 2 ^ m) * 2 ^ m) (n - (r + 2 ^ m) * (r + 2 ^ m)))) :
    IsSqrt n ([anonymous] (2 ^ m * 2 ^ m) (2 * r * 2 ^ m) (n - r * r)) :=
  by
  have b0 : 2 ^ m * 2 ^ m ≠ 0 := mul_self_ne_zero.2 (pow_ne_zero m two_ne_zero)
  have lb : n - r * r < 2 * r * 2 ^ m + 2 ^ m * 2 ^ m ↔ n < (r + 2 ^ m) * (r + 2 ^ m) :=
    by
    rw [tsub_lt_iff_right h₁]
    simp [left_distrib, right_distrib, two_mul, mul_comm, mul_assoc, add_comm, add_assoc,
      add_left_comm]
  have re : div2 (2 * r * 2 ^ m) = r * 2 ^ m := by
    rw [div2_val, mul_assoc, Nat.mul_div_cancel_left _ (by decide : 2 > 0)]
  cases' lt_or_ge n ((r + 2 ^ m) * (r + 2 ^ m)) with hl hl
  · rw [sqrt_aux_2 b0 (lb.2 hl), hm, re]
    apply H1 hl
  · cases' le.dest hl with n' e
    rw [@sqrt_aux_1 (2 * r * 2 ^ m) (n - r * r) (2 ^ m * 2 ^ m) b0 (n - (r + 2 ^ m) * (r + 2 ^ m)),
      hm, re, ← right_distrib]
    · apply H2 hl
    apply Eq.symm
    apply tsub_eq_of_eq_add_rev
    rw [← add_assoc, (_ : r * r + _ = _)]
    exact (add_tsub_cancel_of_le hl).symm
    simp [left_distrib, right_distrib, two_mul, mul_comm, mul_assoc, add_assoc]
#align nat.sqrt_aux_is_sqrt_lemma nat.sqrt_aux_is_sqrt_lemma

private theorem sqrt_aux_is_sqrt (n) :
    ∀ m r,
      r * r ≤ n →
        n < (r + 2 ^ (m + 1)) * (r + 2 ^ (m + 1)) →
          IsSqrt n ([anonymous] (2 ^ m * 2 ^ m) (2 * r * 2 ^ m) (n - r * r))
  | 0, r, h₁, h₂ => by
    apply sqrt_aux_is_sqrt_lemma 0 r n h₁ 0 rfl <;> intro h <;> simp <;> [exact ⟨h₁, h⟩,
      exact ⟨h, h₂⟩]
  | m + 1, r, h₁, h₂ =>
    by
    apply
        sqrt_aux_is_sqrt_lemma (m + 1) r n h₁ (2 ^ m * 2 ^ m)
          (by
            simp [shiftr, pow_succ, div2_val, mul_comm, mul_left_comm] <;>
              repeat' rw [@Nat.mul_div_cancel_left _ 2 (by decide)]) <;>
      intro h
    · have := sqrt_aux_is_sqrt m r h₁ h
      simpa [pow_succ, mul_comm, mul_assoc]
    · rw [pow_succ', mul_two, ← add_assoc] at h₂
      have := sqrt_aux_is_sqrt m (r + 2 ^ (m + 1)) h h₂
      rwa [show (r + 2 ^ (m + 1)) * 2 ^ (m + 1) = 2 * (r + 2 ^ (m + 1)) * 2 ^ m by
          simp [pow_succ, mul_comm, mul_left_comm]]
#align nat.sqrt_aux_is_sqrt nat.sqrt_aux_is_sqrt

private theorem sqrt_is_sqrt (n : ℕ) : IsSqrt n (sqrt n) :=
  by
  generalize e : size n = s; cases' s with s <;> simp [e, sqrt]
  · rw [size_eq_zero.1 e, is_sqrt]
    exact by decide
  · have := sqrt_aux_is_sqrt n (div2 s) 0 (zero_le _)
    simp [show 2 ^ div2 s * 2 ^ div2 s = shiftl 1 (bit0 (div2 s))
        by
        generalize div2 s = x
        change bit0 x with x + x
        rw [one_shiftl, pow_add]] at
      this
    apply this
    rw [← pow_add, ← mul_two]
    apply size_le.1
    rw [e]
    apply (@div_lt_iff_lt_mul _ _ 2 (by decide)).1
    rw [div2_val]
    apply lt_succ_self
#align nat.sqrt_is_sqrt nat.sqrt_is_sqrt

#print Nat.sqrt_le /-
theorem sqrt_le (n : ℕ) : sqrt n * sqrt n ≤ n :=
  (sqrt_isSqrt n).left
#align nat.sqrt_le Nat.sqrt_le
-/

#print Nat.sqrt_le' /-
theorem sqrt_le' (n : ℕ) : sqrt n ^ 2 ≤ n :=
  Eq.trans_le (sq (sqrt n)) (sqrt_le n)
#align nat.sqrt_le' Nat.sqrt_le'
-/

#print Nat.lt_succ_sqrt /-
theorem lt_succ_sqrt (n : ℕ) : n < succ (sqrt n) * succ (sqrt n) :=
  (sqrt_isSqrt n).right
#align nat.lt_succ_sqrt Nat.lt_succ_sqrt
-/

#print Nat.lt_succ_sqrt' /-
theorem lt_succ_sqrt' (n : ℕ) : n < succ (sqrt n) ^ 2 :=
  trans_rel_left (fun i j => i < j) (lt_succ_sqrt n) (sq (succ (sqrt n))).symm
#align nat.lt_succ_sqrt' Nat.lt_succ_sqrt'
-/

#print Nat.sqrt_le_add /-
theorem sqrt_le_add (n : ℕ) : n ≤ sqrt n * sqrt n + sqrt n + sqrt n := by
  rw [← succ_mul] <;> exact le_of_lt_succ (lt_succ_sqrt n)
#align nat.sqrt_le_add Nat.sqrt_le_add
-/

#print Nat.le_sqrt /-
theorem le_sqrt {m n : ℕ} : m ≤ sqrt n ↔ m * m ≤ n :=
  ⟨fun h => le_trans (mul_self_le_mul_self h) (sqrt_le n), fun h =>
    le_of_lt_succ <| mul_self_lt_mul_self_iff.2 <| lt_of_le_of_lt h (lt_succ_sqrt n)⟩
#align nat.le_sqrt Nat.le_sqrt
-/

#print Nat.le_sqrt' /-
theorem le_sqrt' {m n : ℕ} : m ≤ sqrt n ↔ m ^ 2 ≤ n := by simpa only [pow_two] using le_sqrt
#align nat.le_sqrt' Nat.le_sqrt'
-/

#print Nat.sqrt_lt /-
theorem sqrt_lt {m n : ℕ} : sqrt m < n ↔ m < n * n :=
  lt_iff_lt_of_le_iff_le le_sqrt
#align nat.sqrt_lt Nat.sqrt_lt
-/

#print Nat.sqrt_lt' /-
theorem sqrt_lt' {m n : ℕ} : sqrt m < n ↔ m < n ^ 2 :=
  lt_iff_lt_of_le_iff_le le_sqrt'
#align nat.sqrt_lt' Nat.sqrt_lt'
-/

#print Nat.sqrt_le_self /-
theorem sqrt_le_self (n : ℕ) : sqrt n ≤ n :=
  le_trans (le_mul_self _) (sqrt_le n)
#align nat.sqrt_le_self Nat.sqrt_le_self
-/

#print Nat.sqrt_le_sqrt /-
theorem sqrt_le_sqrt {m n : ℕ} (h : m ≤ n) : sqrt m ≤ sqrt n :=
  le_sqrt.2 (le_trans (sqrt_le _) h)
#align nat.sqrt_le_sqrt Nat.sqrt_le_sqrt
-/

#print Nat.sqrt_zero /-
@[simp]
theorem sqrt_zero : sqrt 0 = 0 := by rw [sqrt, size_zero, sqrt._match_1]
#align nat.sqrt_zero Nat.sqrt_zero
-/

#print Nat.sqrt_eq_zero /-
theorem sqrt_eq_zero {n : ℕ} : sqrt n = 0 ↔ n = 0 :=
  ⟨fun h =>
    Nat.eq_zero_of_le_zero <| le_of_lt_succ <| (@sqrt_lt n 1).1 <| by rw [h] <;> exact by decide,
    by
    rintro rfl
    simp⟩
#align nat.sqrt_eq_zero Nat.sqrt_eq_zero
-/

#print Nat.eq_sqrt /-
theorem eq_sqrt {n q} : q = sqrt n ↔ q * q ≤ n ∧ n < (q + 1) * (q + 1) :=
  ⟨fun e => e.symm ▸ sqrt_isSqrt n, fun ⟨h₁, h₂⟩ =>
    le_antisymm (le_sqrt.2 h₁) (le_of_lt_succ <| sqrt_lt.2 h₂)⟩
#align nat.eq_sqrt Nat.eq_sqrt
-/

#print Nat.eq_sqrt' /-
theorem eq_sqrt' {n q} : q = sqrt n ↔ q ^ 2 ≤ n ∧ n < (q + 1) ^ 2 := by
  simpa only [pow_two] using eq_sqrt
#align nat.eq_sqrt' Nat.eq_sqrt'
-/

#print Nat.le_three_of_sqrt_eq_one /-
theorem le_three_of_sqrt_eq_one {n : ℕ} (h : sqrt n = 1) : n ≤ 3 :=
  le_of_lt_succ <| (@sqrt_lt n 2).1 <| by rw [h] <;> exact by decide
#align nat.le_three_of_sqrt_eq_one Nat.le_three_of_sqrt_eq_one
-/

#print Nat.sqrt_lt_self /-
theorem sqrt_lt_self {n : ℕ} (h : 1 < n) : sqrt n < n :=
  sqrt_lt.2 <| by have := Nat.mul_lt_mul_of_pos_left h (lt_of_succ_lt h) <;> rwa [mul_one] at this
#align nat.sqrt_lt_self Nat.sqrt_lt_self
-/

#print Nat.sqrt_pos /-
theorem sqrt_pos {n : ℕ} : 0 < sqrt n ↔ 0 < n :=
  le_sqrt
#align nat.sqrt_pos Nat.sqrt_pos
-/

#print Nat.sqrt_add_eq /-
theorem sqrt_add_eq (n : ℕ) {a : ℕ} (h : a ≤ n + n) : sqrt (n * n + a) = n :=
  le_antisymm
    (le_of_lt_succ <|
      sqrt_lt.2 <| by
        rw [succ_mul, mul_succ, add_succ, add_assoc] <;>
          exact lt_succ_of_le (Nat.add_le_add_left h _))
    (le_sqrt.2 <| Nat.le_add_right _ _)
#align nat.sqrt_add_eq Nat.sqrt_add_eq
-/

#print Nat.sqrt_add_eq' /-
theorem sqrt_add_eq' (n : ℕ) {a : ℕ} (h : a ≤ n + n) : sqrt (n ^ 2 + a) = n :=
  (congr_arg (fun i => sqrt (i + a)) (sq n)).trans (sqrt_add_eq n h)
#align nat.sqrt_add_eq' Nat.sqrt_add_eq'
-/

#print Nat.sqrt_eq /-
theorem sqrt_eq (n : ℕ) : sqrt (n * n) = n :=
  sqrt_add_eq n (zero_le _)
#align nat.sqrt_eq Nat.sqrt_eq
-/

#print Nat.sqrt_eq' /-
theorem sqrt_eq' (n : ℕ) : sqrt (n ^ 2) = n :=
  sqrt_add_eq' n (zero_le _)
#align nat.sqrt_eq' Nat.sqrt_eq'
-/

#print Nat.sqrt_one /-
@[simp]
theorem sqrt_one : sqrt 1 = 1 :=
  sqrt_eq 1
#align nat.sqrt_one Nat.sqrt_one
-/

#print Nat.sqrt_succ_le_succ_sqrt /-
theorem sqrt_succ_le_succ_sqrt (n : ℕ) : sqrt n.succ ≤ n.sqrt.succ :=
  le_of_lt_succ <|
    sqrt_lt.2 <|
      lt_succ_of_le <|
        succ_le_succ <|
          le_trans (sqrt_le_add n) <|
            add_le_add_right
              (by refine' add_le_add (Nat.mul_le_mul_right _ _) _ <;> exact Nat.le_add_right _ 2) _
#align nat.sqrt_succ_le_succ_sqrt Nat.sqrt_succ_le_succ_sqrt
-/

#print Nat.exists_mul_self /-
theorem exists_mul_self (x : ℕ) : (∃ n, n * n = x) ↔ sqrt x * sqrt x = x :=
  ⟨fun ⟨n, hn⟩ => by rw [← hn, sqrt_eq], fun h => ⟨sqrt x, h⟩⟩
#align nat.exists_mul_self Nat.exists_mul_self
-/

#print Nat.exists_mul_self' /-
theorem exists_mul_self' (x : ℕ) : (∃ n, n ^ 2 = x) ↔ sqrt x ^ 2 = x := by
  simpa only [pow_two] using exists_mul_self x
#align nat.exists_mul_self' Nat.exists_mul_self'
-/

#print Nat.sqrt_mul_sqrt_lt_succ /-
theorem sqrt_mul_sqrt_lt_succ (n : ℕ) : sqrt n * sqrt n < n + 1 :=
  lt_succ_iff.mpr (sqrt_le _)
#align nat.sqrt_mul_sqrt_lt_succ Nat.sqrt_mul_sqrt_lt_succ
-/

#print Nat.sqrt_mul_sqrt_lt_succ' /-
theorem sqrt_mul_sqrt_lt_succ' (n : ℕ) : sqrt n ^ 2 < n + 1 :=
  lt_succ_iff.mpr (sqrt_le' _)
#align nat.sqrt_mul_sqrt_lt_succ' Nat.sqrt_mul_sqrt_lt_succ'
-/

#print Nat.succ_le_succ_sqrt /-
theorem succ_le_succ_sqrt (n : ℕ) : n + 1 ≤ (sqrt n + 1) * (sqrt n + 1) :=
  le_of_pred_lt (lt_succ_sqrt _)
#align nat.succ_le_succ_sqrt Nat.succ_le_succ_sqrt
-/

#print Nat.succ_le_succ_sqrt' /-
theorem succ_le_succ_sqrt' (n : ℕ) : n + 1 ≤ (sqrt n + 1) ^ 2 :=
  le_of_pred_lt (lt_succ_sqrt' _)
#align nat.succ_le_succ_sqrt' Nat.succ_le_succ_sqrt'
-/

#print Nat.not_exists_sq /-
/-- There are no perfect squares strictly between m² and (m+1)² -/
theorem not_exists_sq {n m : ℕ} (hl : m * m < n) (hr : n < (m + 1) * (m + 1)) : ¬∃ t, t * t = n :=
  by
  rintro ⟨t, rfl⟩
  have h1 : m < t := nat.mul_self_lt_mul_self_iff.mpr hl
  have h2 : t < m + 1 := nat.mul_self_lt_mul_self_iff.mpr hr
  exact (not_lt_of_ge <| le_of_lt_succ h2) h1
#align nat.not_exists_sq Nat.not_exists_sq
-/

#print Nat.not_exists_sq' /-
theorem not_exists_sq' {n m : ℕ} (hl : m ^ 2 < n) (hr : n < (m + 1) ^ 2) : ¬∃ t, t ^ 2 = n := by
  simpa only [pow_two] using
    not_exists_sq (by simpa only [pow_two] using hl) (by simpa only [pow_two] using hr)
#align nat.not_exists_sq' Nat.not_exists_sq'
-/

end Nat