/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Manuel Candales
-/
import analysis.inner_product_space.projection
import analysis.special_functions.trigonometric.inverse
import algebra.quadratic_discriminant
import linear_algebra.affine_space.finite_dimensional
import analysis.calculus.conformal.normed_space

/-!
# Euclidean spaces

This file makes some definitions and proves very basic geometrical
results about real inner product spaces and Euclidean affine spaces.
Results about real inner product spaces that involve the norm and
inner product but not angles generally go in
`analysis.normed_space.inner_product`.  Results with longer
proofs or more geometrical content generally go in separate files.

## Main definitions

* `inner_product_geometry.angle` is the undirected angle between two
  vectors.

* `euclidean_geometry.angle`, with notation `∠`, is the undirected
  angle determined by three points.

* `euclidean_geometry.orthogonal_projection` is the orthogonal
  projection of a point onto an affine subspace.

* `euclidean_geometry.reflection` is the reflection of a point in an
  affine subspace.

## Implementation notes

To declare `P` as the type of points in a Euclidean affine space with
`V` as the type of vectors, use `[inner_product_space ℝ V] [metric_space P]
[normed_add_torsor V P]`.  This works better with `out_param` to make
`V` implicit in most cases than having a separate type alias for
Euclidean affine spaces.

Rather than requiring Euclidean affine spaces to be finite-dimensional
(as in the definition on Wikipedia), this is specified only for those
theorems that need it.

## References

* https://en.wikipedia.org/wiki/Euclidean_space

-/

noncomputable theory
open_locale big_operators
open_locale classical
open_locale real
open_locale real_inner_product_space

namespace inner_product_geometry
/-!
### Geometrical results on real inner product spaces

This section develops some geometrical definitions and results on real
inner product spaces, where those definitions and results can most
conveniently be developed in terms of vectors and then used to deduce
corresponding results for Euclidean affine spaces.
-/

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

/-- The undirected angle between two vectors. If either vector is 0,
this is π/2. -/
def angle (x y : V) : ℝ := real.arccos (inner x y / (∥x∥ * ∥y∥))

lemma is_conformal_map.preserves_angle {E F : Type*}
  [inner_product_space ℝ E] [inner_product_space ℝ F]
  {f' : E →L[ℝ] F} (h : is_conformal_map f') (u v : E) :
  angle (f' u) (f' v) = angle u v :=
begin
  obtain ⟨c, hc, li, hcf⟩ := h,
  suffices : c * (c * inner u v) / (∥c∥ * ∥u∥ * (∥c∥ * ∥v∥)) = inner u v / (∥u∥ * ∥v∥),
  { simp [this, angle, hcf, norm_smul, inner_smul_left, inner_smul_right] },
  by_cases hu : ∥u∥ = 0,
  { simp [norm_eq_zero.mp hu] },
  by_cases hv : ∥v∥ = 0,
  { simp [norm_eq_zero.mp hv] },
  have hc : ∥c∥ ≠ 0 := λ w, hc (norm_eq_zero.mp w),
  field_simp,
  have : c * c = ∥c∥ * ∥c∥ := by simp [real.norm_eq_abs, abs_mul_abs_self],
  convert congr_arg (λ x, x * ⟪u, v⟫ * ∥u∥ * ∥v∥) this using 1; ring,
end

/-- If a real differentiable map `f` is conformal at a point `x`,
    then it preserves the angles at that point. -/
lemma conformal_at.preserves_angle {E F : Type*}
  [inner_product_space ℝ E] [inner_product_space ℝ F]
  {f : E → F} {x : E} {f' : E →L[ℝ] F}
  (h : has_fderiv_at f f' x) (H : conformal_at f x) (u v : E) :
  angle (f' u) (f' v) = angle u v :=
let ⟨f₁, h₁, c⟩ := H in h₁.unique h ▸ is_conformal_map.preserves_angle c u v

/-- The cosine of the angle between two vectors. -/
lemma cos_angle (x y : V) : real.cos (angle x y) = inner x y / (∥x∥ * ∥y∥) :=
real.cos_arccos (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
                (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2

/-- The angle between two vectors does not depend on their order. -/
lemma angle_comm (x y : V) : angle x y = angle y x :=
begin
  unfold angle,
  rw [real_inner_comm, mul_comm]
end

/-- The angle between the negation of two vectors. -/
@[simp] lemma angle_neg_neg (x y : V) : angle (-x) (-y) = angle x y :=
begin
  unfold angle,
  rw [inner_neg_neg, norm_neg, norm_neg]
end

/-- The angle between two vectors is nonnegative. -/
lemma angle_nonneg (x y : V) : 0 ≤ angle x y :=
real.arccos_nonneg _

/-- The angle between two vectors is at most π. -/
lemma angle_le_pi (x y : V) : angle x y ≤ π :=
real.arccos_le_pi _

/-- The angle between a vector and the negation of another vector. -/
lemma angle_neg_right (x y : V) : angle x (-y) = π - angle x y :=
begin
  unfold angle,
  rw [←real.arccos_neg, norm_neg, inner_neg_right, neg_div]
end

/-- The angle between the negation of a vector and another vector. -/
lemma angle_neg_left (x y : V) : angle (-x) y = π - angle x y :=
by rw [←angle_neg_neg, neg_neg, angle_neg_right]

/-- The angle between the zero vector and a vector. -/
@[simp] lemma angle_zero_left (x : V) : angle 0 x = π / 2 :=
begin
  unfold angle,
  rw [inner_zero_left, zero_div, real.arccos_zero]
end

/-- The angle between a vector and the zero vector. -/
@[simp] lemma angle_zero_right (x : V) : angle x 0 = π / 2 :=
begin
  unfold angle,
  rw [inner_zero_right, zero_div, real.arccos_zero]
end

/-- The angle between a nonzero vector and itself. -/
@[simp] lemma angle_self {x : V} (hx : x ≠ 0) : angle x x = 0 :=
begin
  unfold angle,
  rw [←real_inner_self_eq_norm_mul_norm, div_self (λ h, hx (inner_self_eq_zero.1 h)),
      real.arccos_one]
end

/-- The angle between a nonzero vector and its negation. -/
@[simp] lemma angle_self_neg_of_nonzero {x : V} (hx : x ≠ 0) : angle x (-x) = π :=
by rw [angle_neg_right, angle_self hx, sub_zero]

/-- The angle between the negation of a nonzero vector and that
vector. -/
@[simp] lemma angle_neg_self_of_nonzero {x : V} (hx : x ≠ 0) : angle (-x) x = π :=
by rw [angle_comm, angle_self_neg_of_nonzero hx]

/-- The angle between a vector and a positive multiple of a vector. -/
@[simp] lemma angle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
  angle x (r • y) = angle x y :=
begin
  unfold angle,
  rw [inner_smul_right, norm_smul, real.norm_eq_abs, abs_of_nonneg (le_of_lt hr), ←mul_assoc,
      mul_comm _ r, mul_assoc, mul_div_mul_left _ _ (ne_of_gt hr)]
end

/-- The angle between a positive multiple of a vector and a vector. -/
@[simp] lemma angle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
  angle (r • x) y = angle x y :=
by rw [angle_comm, angle_smul_right_of_pos y x hr, angle_comm]

/-- The angle between a vector and a negative multiple of a vector. -/
@[simp] lemma angle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
  angle x (r • y) = angle x (-y) :=
by rw [←neg_neg r, neg_smul, angle_neg_right, angle_smul_right_of_pos x y (neg_pos_of_neg hr),
       angle_neg_right]

/-- The angle between a negative multiple of a vector and a vector. -/
@[simp] lemma angle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
  angle (r • x) y = angle (-x) y :=
by rw [angle_comm, angle_smul_right_of_neg y x hr, angle_comm]

/-- The cosine of the angle between two vectors, multiplied by the
product of their norms. -/
lemma cos_angle_mul_norm_mul_norm (x y : V) : real.cos (angle x y) * (∥x∥ * ∥y∥) = inner x y :=
begin
  rw [cos_angle, div_mul_cancel_of_imp],
  simp [or_imp_distrib] { contextual := tt },
end

/-- The sine of the angle between two vectors, multiplied by the
product of their norms. -/
lemma sin_angle_mul_norm_mul_norm (x y : V) : real.sin (angle x y) * (∥x∥ * ∥y∥) =
    real.sqrt (inner x x * inner y y - inner x y * inner x y) :=
begin
  unfold angle,
  rw [real.sin_arccos (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
                      (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2,
      ←real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
      ←real.sqrt_mul' _ (mul_self_nonneg _), sq,
      real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
      real_inner_self_eq_norm_mul_norm,
      real_inner_self_eq_norm_mul_norm],
  by_cases h : (∥x∥ * ∥y∥) = 0,
  { rw [(show ∥x∥ * ∥x∥ * (∥y∥ * ∥y∥) = (∥x∥ * ∥y∥) * (∥x∥ * ∥y∥), by ring), h, mul_zero, mul_zero,
        zero_sub],
    cases eq_zero_or_eq_zero_of_mul_eq_zero h with hx hy,
    { rw norm_eq_zero at hx,
      rw [hx, inner_zero_left, zero_mul, neg_zero] },
    { rw norm_eq_zero at hy,
      rw [hy, inner_zero_right, zero_mul, neg_zero] } },
  { field_simp [h], ring_nf }
end

/-- The angle between two vectors is zero if and only if they are
nonzero and one is a positive multiple of the other. -/
lemma angle_eq_zero_iff {x y : V} : angle x y = 0 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), 0 < r ∧ y = r • x) :=
begin
  rw [angle, ← real_inner_div_norm_mul_norm_eq_one_iff, real.arccos_eq_zero, has_le.le.le_iff_eq,
    eq_comm],
  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
end

/-- The angle between two vectors is π if and only if they are nonzero
and one is a negative multiple of the other. -/
lemma angle_eq_pi_iff {x y : V} : angle x y = π ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r < 0 ∧ y = r • x) :=
begin
  rw [angle, ← real_inner_div_norm_mul_norm_eq_neg_one_iff, real.arccos_eq_pi, has_le.le.le_iff_eq],
  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
end

/-- If the angle between two vectors is π, the angles between those
vectors and a third vector add to π. -/
lemma angle_add_angle_eq_pi_of_angle_eq_pi {x y : V} (z : V) (h : angle x y = π) :
  angle x z + angle y z = π :=
begin
  rcases angle_eq_pi_iff.1 h with ⟨hx, ⟨r, ⟨hr, rfl⟩⟩⟩,
  rw [angle_smul_left_of_neg x z hr, angle_neg_left, add_sub_cancel'_right]
end

/-- Two vectors have inner product 0 if and only if the angle between
them is π/2. -/
lemma inner_eq_zero_iff_angle_eq_pi_div_two (x y : V) : ⟪x, y⟫ = 0 ↔ angle x y = π / 2 :=
iff.symm $ by simp [angle, or_imp_distrib] { contextual := tt }

/-- If the angle between two vectors is π, the inner product equals the negative product
of the norms. -/
lemma inner_eq_neg_mul_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ⟪x, y⟫ = - (∥x∥ * ∥y∥) :=
by simp [← cos_angle_mul_norm_mul_norm, h]

/-- If the angle between two vectors is 0, the inner product equals the product of the norms. -/
lemma inner_eq_mul_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ⟪x, y⟫ = ∥x∥ * ∥y∥ :=
by simp [← cos_angle_mul_norm_mul_norm, h]

/-- The inner product of two non-zero vectors equals the negative product of their norms
if and only if the angle between the two vectors is π. -/
lemma inner_eq_neg_mul_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ⟪x, y⟫ = - (∥x∥ * ∥y∥) ↔ angle x y = π :=
begin
  refine ⟨λ h, _, inner_eq_neg_mul_norm_of_angle_eq_pi⟩,
  have h₁ : (∥x∥ * ∥y∥) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
  rw [angle, h, neg_div, div_self h₁, real.arccos_neg_one],
end

/-- The inner product of two non-zero vectors equals the product of their norms
if and only if the angle between the two vectors is 0. -/
lemma inner_eq_mul_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ⟪x, y⟫ = ∥x∥ * ∥y∥ ↔ angle x y = 0 :=
begin
  refine ⟨λ h, _, inner_eq_mul_norm_of_angle_eq_zero⟩,
  have h₁ : (∥x∥ * ∥y∥) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
  rw [angle, h, div_self h₁, real.arccos_one],
end

/-- If the angle between two vectors is π, the norm of their difference equals
the sum of their norms. -/
lemma norm_sub_eq_add_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ∥x - y∥ = ∥x∥ + ∥y∥ :=
begin
  rw ← sq_eq_sq (norm_nonneg (x - y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
  rw [norm_sub_pow_two_real, inner_eq_neg_mul_norm_of_angle_eq_pi h],
  ring,
end

/-- If the angle between two vectors is 0, the norm of their sum equals
the sum of their norms. -/
lemma norm_add_eq_add_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ∥x + y∥ = ∥x∥ + ∥y∥ :=
begin
  rw ← sq_eq_sq (norm_nonneg (x + y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
  rw [norm_add_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h],
  ring,
end

/-- If the angle between two vectors is 0, the norm of their difference equals
the absolute value of the difference of their norms. -/
lemma norm_sub_eq_abs_sub_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) :
  ∥x - y∥ = |∥x∥ - ∥y∥| :=
begin
  rw [← sq_eq_sq (norm_nonneg (x - y)) (abs_nonneg (∥x∥ - ∥y∥)),
      norm_sub_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h, sq_abs (∥x∥ - ∥y∥)],
  ring,
end

/-- The norm of the difference of two non-zero vectors equals the sum of their norms
if and only the angle between the two vectors is π. -/
lemma norm_sub_eq_add_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ∥x - y∥ = ∥x∥ + ∥y∥ ↔ angle x y = π :=
begin
  refine ⟨λ h, _, norm_sub_eq_add_norm_of_angle_eq_pi⟩,
  rw ← inner_eq_neg_mul_norm_iff_angle_eq_pi hx hy,
  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x - y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
  rw [← sq_eq_sq hxy₁ hxy₂, norm_sub_pow_two_real] at h,
  calc inner x y = (∥x∥ ^ 2 + ∥y∥ ^ 2 - (∥x∥ + ∥y∥) ^ 2) / 2 : by linarith
  ...            = -(∥x∥ * ∥y∥) : by ring,
end

/-- The norm of the sum of two non-zero vectors equals the sum of their norms
if and only the angle between the two vectors is 0. -/
lemma norm_add_eq_add_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ∥x + y∥ = ∥x∥ + ∥y∥ ↔ angle x y = 0 :=
begin
  refine ⟨λ h, _, norm_add_eq_add_norm_of_angle_eq_zero⟩,
  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x + y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
  rw [← sq_eq_sq hxy₁ hxy₂, norm_add_pow_two_real] at h,
  calc inner x y = ((∥x∥ + ∥y∥) ^ 2 - ∥x∥ ^ 2 - ∥y∥ ^ 2)/ 2 : by linarith
  ...            = ∥x∥ * ∥y∥ : by ring,
end

/-- The norm of the difference of two non-zero vectors equals the absolute value
of the difference of their norms if and only the angle between the two vectors is 0. -/
lemma norm_sub_eq_abs_sub_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
  ∥x - y∥ = |∥x∥ - ∥y∥| ↔ angle x y = 0 :=
begin
  refine ⟨λ h, _, norm_sub_eq_abs_sub_norm_of_angle_eq_zero⟩,
  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
  have h1 : ∥x - y∥ ^ 2 = (∥x∥ - ∥y∥) ^ 2, { rw h, exact sq_abs (∥x∥ - ∥y∥) },
  rw norm_sub_pow_two_real at h1,
  calc inner x y = ((∥x∥ + ∥y∥) ^ 2 - ∥x∥ ^ 2 - ∥y∥ ^ 2)/ 2 : by linarith
  ...            = ∥x∥ * ∥y∥ : by ring,
end

/-- The norm of the sum of two vectors equals the norm of their difference if and only if
the angle between them is π/2. -/
lemma norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (x y : V) :
  ∥x + y∥ = ∥x - y∥ ↔ angle x y = π / 2 :=
begin
  rw [← sq_eq_sq (norm_nonneg (x + y)) (norm_nonneg (x - y)),
      ← inner_eq_zero_iff_angle_eq_pi_div_two x y, norm_add_pow_two_real, norm_sub_pow_two_real],
  split; intro h; linarith,
end

end inner_product_geometry

namespace euclidean_geometry
/-!
### Geometrical results on Euclidean affine spaces

This section develops some geometrical definitions and results on
Euclidean affine spaces.
-/
open inner_product_geometry

variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
    [normed_add_torsor V P]
local notation `⟪`x`, `y`⟫` := @inner ℝ V _ x y
include V

/-- The undirected angle at `p2` between the line segments to `p1` and
`p3`. If either of those points equals `p2`, this is π/2. Use
`open_locale euclidean_geometry` to access the `∠ p1 p2 p3`
notation. -/
def angle (p1 p2 p3 : P) : ℝ := angle (p1 -ᵥ p2 : V) (p3 -ᵥ p2)

localized "notation `∠` := euclidean_geometry.angle" in euclidean_geometry

/-- The angle at a point does not depend on the order of the other two
points. -/
lemma angle_comm (p1 p2 p3 : P) : ∠ p1 p2 p3 = ∠ p3 p2 p1 :=
angle_comm _ _

/-- The angle at a point is nonnegative. -/
lemma angle_nonneg (p1 p2 p3 : P) : 0 ≤ ∠ p1 p2 p3 :=
angle_nonneg _ _

/-- The angle at a point is at most π. -/
lemma angle_le_pi (p1 p2 p3 : P) : ∠ p1 p2 p3 ≤ π :=
angle_le_pi _ _

/-- The angle ∠AAB at a point. -/
lemma angle_eq_left (p1 p2 : P) : ∠ p1 p1 p2 = π / 2 :=
begin
  unfold angle,
  rw vsub_self,
  exact angle_zero_left _
end

/-- The angle ∠ABB at a point. -/
lemma angle_eq_right (p1 p2 : P) : ∠ p1 p2 p2 = π / 2 :=
by rw [angle_comm, angle_eq_left]

/-- The angle ∠ABA at a point. -/
lemma angle_eq_of_ne {p1 p2 : P} (h : p1 ≠ p2) : ∠ p1 p2 p1 = 0 :=
angle_self (λ he, h (vsub_eq_zero_iff_eq.1 he))

/-- If the angle ∠ABC at a point is π, the angle ∠BAC is 0. -/
lemma angle_eq_zero_of_angle_eq_pi_left {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
  ∠ p2 p1 p3 = 0 :=
begin
  unfold angle at h,
  rw angle_eq_pi_iff at h,
  rcases h with ⟨hp1p2, ⟨r, ⟨hr, hpr⟩⟩⟩,
  unfold angle,
  rw angle_eq_zero_iff,
  rw [←neg_vsub_eq_vsub_rev, neg_ne_zero] at hp1p2,
  use [hp1p2, -r + 1, add_pos (neg_pos_of_neg hr) zero_lt_one],
  rw [add_smul, ←neg_vsub_eq_vsub_rev p1 p2, smul_neg],
  simp [←hpr]
end

/-- If the angle ∠ABC at a point is π, the angle ∠BCA is 0. -/
lemma angle_eq_zero_of_angle_eq_pi_right {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
  ∠ p2 p3 p1 = 0 :=
begin
  rw angle_comm at h,
  exact angle_eq_zero_of_angle_eq_pi_left h
end

/-- If ∠BCD = π, then ∠ABC = ∠ABD. -/
lemma angle_eq_angle_of_angle_eq_pi (p1 : P) {p2 p3 p4 : P} (h : ∠ p2 p3 p4 = π) :
  ∠ p1 p2 p3 = ∠ p1 p2 p4 :=
begin
  unfold angle at *,
  rcases angle_eq_pi_iff.1 h with ⟨hp2p3, ⟨r, ⟨hr, hpr⟩⟩⟩,
  rw [eq_comm],
  convert angle_smul_right_of_pos (p1 -ᵥ p2) (p3 -ᵥ p2) (add_pos (neg_pos_of_neg hr) zero_lt_one),
  rw [add_smul, ← neg_vsub_eq_vsub_rev p2 p3, smul_neg, neg_smul, ← hpr],
  simp
end

/-- If ∠BCD = π, then ∠ACB + ∠ACD = π. -/
lemma angle_add_angle_eq_pi_of_angle_eq_pi (p1 : P) {p2 p3 p4 : P} (h : ∠ p2 p3 p4 = π) :
  ∠ p1 p3 p2 + ∠ p1 p3 p4 = π :=
begin
  unfold angle at h,
  rw [angle_comm p1 p3 p2, angle_comm p1 p3 p4],
  unfold angle,
  exact angle_add_angle_eq_pi_of_angle_eq_pi _ h
end

/-- Vertical Angles Theorem: angles opposite each other, formed by two intersecting straight
lines, are equal. -/
lemma angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi {p1 p2 p3 p4 p5 : P}
  (hapc : ∠ p1 p5 p3 = π) (hbpd : ∠ p2 p5 p4 = π) : ∠ p1 p5 p2 = ∠ p3 p5 p4 :=
by linarith [angle_add_angle_eq_pi_of_angle_eq_pi p1 hbpd, angle_comm p4 p5 p1,
             angle_add_angle_eq_pi_of_angle_eq_pi p4 hapc, angle_comm p4 p5 p3]

/-- If ∠ABC = π then dist A B ≠ 0. -/
lemma left_dist_ne_zero_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) : dist p1 p2 ≠ 0 :=
begin
  by_contra heq,
  rw [dist_eq_zero] at heq,
  rw [heq, angle_eq_left] at h,
  exact real.pi_ne_zero (by linarith),
end

/-- If ∠ABC = π then dist C B ≠ 0. -/
lemma right_dist_ne_zero_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) : dist p3 p2 ≠ 0 :=
left_dist_ne_zero_of_angle_eq_pi $ (angle_comm _ _ _).trans h

/-- If ∠ABC = π, then (dist A C) = (dist A B) + (dist B C). -/
lemma dist_eq_add_dist_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
  dist p1 p3 = dist p1 p2 + dist p3 p2 :=
begin
  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
  exact norm_sub_eq_add_norm_of_angle_eq_pi h,
end

/-- If A ≠ B and C ≠ B then ∠ABC = π if and only if (dist A C) = (dist A B) + (dist B C). -/
lemma dist_eq_add_dist_iff_angle_eq_pi {p1 p2 p3 : P} (hp1p2 : p1 ≠ p2) (hp3p2 : p3 ≠ p2) :
  dist p1 p3 = dist p1 p2 + dist p3 p2 ↔ ∠ p1 p2 p3 = π :=
begin
  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
  exact norm_sub_eq_add_norm_iff_angle_eq_pi
    ((λ he, hp1p2 (vsub_eq_zero_iff_eq.1 he))) (λ he, hp3p2 (vsub_eq_zero_iff_eq.1 he)),
end

/-- If ∠ABC = 0, then (dist A C) = abs ((dist A B) - (dist B C)). -/
lemma dist_eq_abs_sub_dist_of_angle_eq_zero {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = 0) :
  (dist p1 p3) = |(dist p1 p2) - (dist p3 p2)| :=
begin
  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
  exact norm_sub_eq_abs_sub_norm_of_angle_eq_zero h,
end

/-- If A ≠ B and C ≠ B then ∠ABC = 0 if and only if (dist A C) = abs ((dist A B) - (dist B C)). -/
lemma dist_eq_abs_sub_dist_iff_angle_eq_zero {p1 p2 p3 : P} (hp1p2 : p1 ≠ p2) (hp3p2 : p3 ≠ p2) :
  (dist p1 p3) = |(dist p1 p2) - (dist p3 p2)| ↔ ∠ p1 p2 p3 = 0 :=
begin
  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
  exact norm_sub_eq_abs_sub_norm_iff_angle_eq_zero
    ((λ he, hp1p2 (vsub_eq_zero_iff_eq.1 he))) (λ he, hp3p2 (vsub_eq_zero_iff_eq.1 he)),
end

/-- The midpoint of the segment AB is the same distance from A as it is from B. -/
lemma dist_left_midpoint_eq_dist_right_midpoint (p1 p2 : P) :
  dist p1 (midpoint ℝ p1 p2) = dist p2 (midpoint ℝ p1 p2) :=
by rw [dist_left_midpoint p1 p2, dist_right_midpoint p1 p2]

/-- If M is the midpoint of the segment AB, then ∠AMB = π. -/
lemma angle_midpoint_eq_pi (p1 p2 : P) (hp1p2 : p1 ≠ p2) : ∠ p1 (midpoint ℝ p1 p2) p2 = π :=
have p2 -ᵥ midpoint ℝ p1 p2 = -(p1 -ᵥ midpoint ℝ p1 p2), by { rw neg_vsub_eq_vsub_rev, simp },
by simp [angle, this, hp1p2, -zero_lt_one]

/-- If M is the midpoint of the segment AB and C is the same distance from A as it is from B
then ∠CMA = π / 2. -/
lemma angle_left_midpoint_eq_pi_div_two_of_dist_eq {p1 p2 p3 : P} (h : dist p3 p1 = dist p3 p2) :
  ∠ p3 (midpoint ℝ p1 p2) p1 = π / 2 :=
begin
  let m : P := midpoint ℝ p1 p2,
  have h1 : p3 -ᵥ p1 = (p3 -ᵥ m) - (p1 -ᵥ m) := (vsub_sub_vsub_cancel_right p3 p1 m).symm,
  have h2 : p3 -ᵥ p2 = (p3 -ᵥ m) + (p1 -ᵥ m),
  { rw [left_vsub_midpoint, ← midpoint_vsub_right, vsub_add_vsub_cancel] },
  rw [dist_eq_norm_vsub V p3 p1, dist_eq_norm_vsub V p3 p2, h1, h2] at h,
  exact (norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (p3 -ᵥ m) (p1 -ᵥ m)).mp h.symm,
end

/-- If M is the midpoint of the segment AB and C is the same distance from A as it is from B
then ∠CMB = π / 2. -/
lemma angle_right_midpoint_eq_pi_div_two_of_dist_eq {p1 p2 p3 : P} (h : dist p3 p1 = dist p3 p2) :
  ∠ p3 (midpoint ℝ p1 p2) p2 = π / 2 :=
by rw [midpoint_comm p1 p2, angle_left_midpoint_eq_pi_div_two_of_dist_eq h.symm]

/-- The inner product of two vectors given with `weighted_vsub`, in
terms of the pairwise distances. -/
lemma inner_weighted_vsub {ι₁ : Type*} {s₁ : finset ι₁} {w₁ : ι₁ → ℝ} (p₁ : ι₁ → P)
    (h₁ : ∑ i in s₁, w₁ i = 0) {ι₂ : Type*} {s₂ : finset ι₂} {w₂ : ι₂ → ℝ} (p₂ : ι₂ → P)
    (h₂ : ∑ i in s₂, w₂ i = 0) :
  inner (s₁.weighted_vsub p₁ w₁) (s₂.weighted_vsub p₂ w₂) =
    (-∑ i₁ in s₁, ∑ i₂ in s₂,
      w₁ i₁ * w₂ i₂ * (dist (p₁ i₁) (p₂ i₂) * dist (p₁ i₁) (p₂ i₂))) / 2 :=
begin
  rw [finset.weighted_vsub_apply, finset.weighted_vsub_apply,
      inner_sum_smul_sum_smul_of_sum_eq_zero _ h₁ _ h₂],
  simp_rw [vsub_sub_vsub_cancel_right],
  rcongr i₁ i₂; rw dist_eq_norm_vsub V (p₁ i₁) (p₂ i₂)
end

/-- The distance between two points given with `affine_combination`,
in terms of the pairwise distances between the points in that
combination. -/

/-- Suppose that `c₁` is equidistant from `p₁` and `p₂`, and the same
applies to `c₂`.  Then the vector between `c₁` and `c₂` is orthogonal
to that between `p₁` and `p₂`.  (In two dimensions, this says that the
diagonals of a kite are orthogonal.) -/
lemma inner_vsub_vsub_of_dist_eq_of_dist_eq {c₁ c₂ p₁ p₂ : P} (hc₁ : dist p₁ c₁ = dist p₂ c₁)
  (hc₂ : dist p₁ c₂ = dist p₂ c₂) : ⟪c₂ -ᵥ c₁, p₂ -ᵥ p₁⟫ = 0 :=
begin
  have h : ⟪(c₂ -ᵥ c₁) + (c₂ -ᵥ c₁), p₂ -ᵥ p₁⟫ = 0,
  { conv_lhs { congr, congr, rw ←vsub_sub_vsub_cancel_right c₂ c₁ p₁,
               skip, rw ←vsub_sub_vsub_cancel_right c₂ c₁ p₂ },
    rw [←add_sub_comm, inner_sub_left],
    conv_lhs { congr, rw ←vsub_sub_vsub_cancel_right p₂ p₁ c₂,
               skip, rw ←vsub_sub_vsub_cancel_right p₂ p₁ c₁ },
    rw [dist_comm p₁, dist_comm p₂, dist_eq_norm_vsub V _ p₁,
        dist_eq_norm_vsub V _ p₂, ←real_inner_add_sub_eq_zero_iff] at hc₁ hc₂,
    simp_rw [←neg_vsub_eq_vsub_rev c₁, ←neg_vsub_eq_vsub_rev c₂, sub_neg_eq_add,
             neg_add_eq_sub, hc₁, hc₂, sub_zero] },
  simpa [inner_add_left, ←mul_two, (by norm_num : (2 : ℝ) ≠ 0)] using h
end

/-- The squared distance between points on a line (expressed as a
multiple of a fixed vector added to a point) and another point,
expressed as a quadratic. -/
lemma dist_smul_vadd_sq (r : ℝ) (v : V) (p₁ p₂ : P) :
  dist (r • v +ᵥ p₁) p₂ * dist (r • v +ᵥ p₁) p₂ =
    ⟪v, v⟫ * r * r + 2 * ⟪v, p₁ -ᵥ p₂⟫ * r + ⟪p₁ -ᵥ p₂, p₁ -ᵥ p₂⟫ :=
begin
  rw [dist_eq_norm_vsub V _ p₂, ←real_inner_self_eq_norm_mul_norm, vadd_vsub_assoc,
    real_inner_add_add_self, real_inner_smul_left, real_inner_smul_left, real_inner_smul_right],
  ring
end

/-- The condition for two points on a line to be equidistant from
another point. -/
lemma dist_smul_vadd_eq_dist {v : V} (p₁ p₂ : P) (hv : v ≠ 0) (r : ℝ) :
  dist (r • v +ᵥ p₁) p₂ = dist p₁ p₂ ↔ (r = 0 ∨ r = -2 * ⟪v, p₁ -ᵥ p₂⟫ / ⟪v, v⟫) :=
begin
  conv_lhs { rw [←mul_self_inj_of_nonneg dist_nonneg dist_nonneg, dist_smul_vadd_sq,
                 ←sub_eq_zero, add_sub_assoc, dist_eq_norm_vsub V p₁ p₂,
                 ←real_inner_self_eq_norm_mul_norm, sub_self] },
  have hvi : ⟪v, v⟫ ≠ 0, by simpa using hv,
  have hd : discrim ⟪v, v⟫ (2 * ⟪v, p₁ -ᵥ p₂⟫) 0 =
    (2 * inner v (p₁ -ᵥ p₂)) * (2 * inner v (p₁ -ᵥ p₂)),
  { rw discrim, ring },
  rw [quadratic_eq_zero_iff hvi hd, add_left_neg, zero_div, neg_mul_eq_neg_mul,
      ←mul_sub_right_distrib, sub_eq_add_neg, ←mul_two, mul_assoc, mul_div_assoc,
      mul_div_mul_left, mul_div_assoc],
  norm_num
end

open affine_subspace finite_dimensional

/-- Distances `r₁` `r₂` of `p` from two different points `c₁` `c₂` determine at
most two points `p₁` `p₂` in a two-dimensional subspace containing those points
(two circles intersect in at most two points). -/
lemma eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two {s : affine_subspace ℝ P}
  [finite_dimensional ℝ s.direction] (hd : finrank ℝ s.direction = 2) {c₁ c₂ p₁ p₂ p : P}
  (hc₁s : c₁ ∈ s) (hc₂s : c₂ ∈ s) (hp₁s : p₁ ∈ s) (hp₂s : p₂ ∈ s) (hps : p ∈ s) {r₁ r₂ : ℝ}
  (hc : c₁ ≠ c₂) (hp : p₁ ≠ p₂) (hp₁c₁ : dist p₁ c₁ = r₁) (hp₂c₁ : dist p₂ c₁ = r₁)
  (hpc₁ : dist p c₁ = r₁) (hp₁c₂ : dist p₁ c₂ = r₂) (hp₂c₂ : dist p₂ c₂ = r₂)
  (hpc₂ : dist p c₂ = r₂) : p = p₁ ∨ p = p₂ :=
begin
  have ho : ⟪c₂ -ᵥ c₁, p₂ -ᵥ p₁⟫ = 0 :=
    inner_vsub_vsub_of_dist_eq_of_dist_eq (hp₁c₁.trans hp₂c₁.symm) (hp₁c₂.trans hp₂c₂.symm),
  have hop : ⟪c₂ -ᵥ c₁, p -ᵥ p₁⟫ = 0 :=
    inner_vsub_vsub_of_dist_eq_of_dist_eq (hp₁c₁.trans hpc₁.symm) (hp₁c₂.trans hpc₂.symm),
  let b : fin 2 → V := ![c₂ -ᵥ c₁, p₂ -ᵥ p₁],
  have hb : linear_independent ℝ b,
  { refine linear_independent_of_ne_zero_of_inner_eq_zero _ _,
    { intro i,
      fin_cases i; simp [b, hc.symm, hp.symm], },
    { intros i j hij,
      fin_cases i; fin_cases j; try { exact false.elim (hij rfl) },
      { exact ho },
      { rw real_inner_comm, exact ho } } },
  have hbs : submodule.span ℝ (set.range b) = s.direction,
  { refine eq_of_le_of_finrank_eq _ _,
    { rw [submodule.span_le, set.range_subset_iff],
      intro i,
      fin_cases i,
      { exact vsub_mem_direction hc₂s hc₁s },
      { exact vsub_mem_direction hp₂s hp₁s } },
    { rw [finrank_span_eq_card hb, fintype.card_fin, hd] } },
  have hv : ∀ v ∈ s.direction, ∃ t₁ t₂ : ℝ, v = t₁ • (c₂ -ᵥ c₁) + t₂ • (p₂ -ᵥ p₁),
  { intros v hv,
    have hr : set.range b = {c₂ -ᵥ c₁, p₂ -ᵥ p₁},
    { have hu : (finset.univ : finset (fin 2)) = {0, 1}, by dec_trivial,
      rw [←fintype.coe_image_univ, hu],
      simp,
      refl },
    rw [←hbs, hr, submodule.mem_span_insert] at hv,
    rcases hv with ⟨t₁, v', hv', hv⟩,
    rw submodule.mem_span_singleton at hv',
    rcases hv' with ⟨t₂, rfl⟩,
    exact ⟨t₁, t₂, hv⟩ },
  rcases hv (p -ᵥ p₁) (vsub_mem_direction hps hp₁s) with ⟨t₁, t₂, hpt⟩,
  simp only [hpt, inner_add_right, inner_smul_right, ho, mul_zero, add_zero, mul_eq_zero,
             inner_self_eq_zero, vsub_eq_zero_iff_eq, hc.symm, or_false] at hop,
  rw [hop, zero_smul, zero_add, ←eq_vadd_iff_vsub_eq] at hpt,
  subst hpt,
  have hp' : (p₂ -ᵥ p₁ : V) ≠ 0, { simp [hp.symm] },
  have hp₂ : dist ((1 : ℝ) • (p₂ -ᵥ p₁) +ᵥ p₁) c₁ = r₁, { simp [hp₂c₁] },
  rw [←hp₁c₁, dist_smul_vadd_eq_dist _ _ hp'] at hpc₁ hp₂,
  simp only [one_ne_zero, false_or] at hp₂,
  rw hp₂.symm at hpc₁,
  cases hpc₁; simp [hpc₁]
end

/-- Distances `r₁` `r₂` of `p` from two different points `c₁` `c₂` determine at
most two points `p₁` `p₂` in two-dimensional space (two circles intersect in at
most two points). -/
lemma eq_of_dist_eq_of_dist_eq_of_finrank_eq_two [finite_dimensional ℝ V] (hd : finrank ℝ V = 2)
  {c₁ c₂ p₁ p₂ p : P} {r₁ r₂ : ℝ} (hc : c₁ ≠ c₂) (hp : p₁ ≠ p₂) (hp₁c₁ : dist p₁ c₁ = r₁)
  (hp₂c₁ : dist p₂ c₁ = r₁) (hpc₁ : dist p c₁ = r₁) (hp₁c₂ : dist p₁ c₂ = r₂)
  (hp₂c₂ : dist p₂ c₂ = r₂) (hpc₂ : dist p c₂ = r₂) : p = p₁ ∨ p = p₂ :=
begin
  have hd' : finrank ℝ (⊤ : affine_subspace ℝ P).direction = 2,
  { rw [direction_top, finrank_top],
    exact hd },
  exact eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two hd'
    (mem_top ℝ V _) (mem_top ℝ V _) (mem_top ℝ V _) (mem_top ℝ V _) (mem_top ℝ V _)
    hc hp hp₁c₁ hp₂c₁ hpc₁ hp₁c₂ hp₂c₂ hpc₂
end

variables {V}

/-- The orthogonal projection of a point onto a nonempty affine
subspace, whose direction is complete, as an unbundled function.  This
definition is only intended for use in setting up the bundled version
`orthogonal_projection` and should not be used once that is
defined. -/
def orthogonal_projection_fn (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction]
  (p : P) : P :=
classical.some $ inter_eq_singleton_of_nonempty_of_is_compl
  (nonempty_subtype.mp ‹_›)
  (mk'_nonempty p s.directionᗮ)
  begin
    rw direction_mk' p s.directionᗮ,
    exact submodule.is_compl_orthogonal_of_complete_space,
  end

/-- The intersection of the subspace and the orthogonal subspace
through the given point is the `orthogonal_projection_fn` of that
point onto the subspace.  This lemma is only intended for use in
setting up the bundled version and should not be used once that is
defined. -/
lemma inter_eq_singleton_orthogonal_projection_fn {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  (s : set P) ∩ (mk' p s.directionᗮ) = {orthogonal_projection_fn s p} :=
classical.some_spec $ inter_eq_singleton_of_nonempty_of_is_compl
  (nonempty_subtype.mp ‹_›)
  (mk'_nonempty p s.directionᗮ)
  begin
    rw direction_mk' p s.directionᗮ,
    exact submodule.is_compl_orthogonal_of_complete_space
  end

/-- The `orthogonal_projection_fn` lies in the given subspace.  This
lemma is only intended for use in setting up the bundled version and
should not be used once that is defined. -/
lemma orthogonal_projection_fn_mem {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) : orthogonal_projection_fn s p ∈ s :=
begin
  rw [←mem_coe, ←set.singleton_subset_iff, ←inter_eq_singleton_orthogonal_projection_fn],
  exact set.inter_subset_left _ _
end

/-- The `orthogonal_projection_fn` lies in the orthogonal
subspace.  This lemma is only intended for use in setting up the
bundled version and should not be used once that is defined. -/
lemma orthogonal_projection_fn_mem_orthogonal {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection_fn s p ∈ mk' p s.directionᗮ :=
begin
  rw [←mem_coe, ←set.singleton_subset_iff, ←inter_eq_singleton_orthogonal_projection_fn],
  exact set.inter_subset_right _ _
end

/-- Subtracting `p` from its `orthogonal_projection_fn` produces a
result in the orthogonal direction.  This lemma is only intended for
use in setting up the bundled version and should not be used once that
is defined. -/
lemma orthogonal_projection_fn_vsub_mem_direction_orthogonal {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection_fn s p -ᵥ p ∈ s.directionᗮ :=
direction_mk' p s.directionᗮ ▸
  vsub_mem_direction (orthogonal_projection_fn_mem_orthogonal p) (self_mem_mk' _ _)

/-- The orthogonal projection of a point onto a nonempty affine
subspace, whose direction is complete. The corresponding linear map
(mapping a vector to the difference between the projections of two
points whose difference is that vector) is the `orthogonal_projection`
for real inner product spaces, onto the direction of the affine
subspace being projected onto. -/
def orthogonal_projection (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  P →ᵃ[ℝ] s :=
{ to_fun := λ p, ⟨orthogonal_projection_fn s p, orthogonal_projection_fn_mem p⟩,
  linear := orthogonal_projection s.direction,
  map_vadd' := λ p v, begin
    have hs : ((orthogonal_projection s.direction) v : V) +ᵥ orthogonal_projection_fn s p ∈ s :=
      vadd_mem_of_mem_direction (orthogonal_projection s.direction v).2
                                (orthogonal_projection_fn_mem p),
    have ho : ((orthogonal_projection s.direction) v : V) +ᵥ orthogonal_projection_fn s p ∈
      mk' (v +ᵥ p) s.directionᗮ,
    { rw [←vsub_right_mem_direction_iff_mem (self_mem_mk' _ _) _, direction_mk',
          vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_comm, add_sub_assoc],
      refine submodule.add_mem _ (orthogonal_projection_fn_vsub_mem_direction_orthogonal p) _,
      rw submodule.mem_orthogonal',
      intros w hw,
      rw [←neg_sub, inner_neg_left, orthogonal_projection_inner_eq_zero _ w hw, neg_zero], },
    have hm : ((orthogonal_projection s.direction) v : V) +ᵥ orthogonal_projection_fn s p ∈
      ({orthogonal_projection_fn s (v +ᵥ p)} : set P),
    { rw ←inter_eq_singleton_orthogonal_projection_fn (v +ᵥ p),
      exact set.mem_inter hs ho },
    rw set.mem_singleton_iff at hm,
    ext,
    exact hm.symm
  end }

@[simp] lemma orthogonal_projection_fn_eq {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection_fn s p = orthogonal_projection s p :=
rfl

/-- The linear map corresponding to `orthogonal_projection`. -/
@[simp] lemma orthogonal_projection_linear {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] :
  (orthogonal_projection s).linear = _root_.orthogonal_projection s.direction :=
rfl

/-- The intersection of the subspace and the orthogonal subspace
through the given point is the `orthogonal_projection` of that point
onto the subspace. -/
lemma inter_eq_singleton_orthogonal_projection {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : P) :
  (s : set P) ∩ (mk' p s.directionᗮ) = {orthogonal_projection s p} :=
begin
  rw ←orthogonal_projection_fn_eq,
  exact inter_eq_singleton_orthogonal_projection_fn p
end

/-- The `orthogonal_projection` lies in the given subspace. -/
lemma orthogonal_projection_mem {s : affine_subspace ℝ P} [nonempty s] [complete_space s.direction]
  (p : P) : ↑(orthogonal_projection s p) ∈ s :=
(orthogonal_projection s p).2

/-- The `orthogonal_projection` lies in the orthogonal subspace. -/
lemma orthogonal_projection_mem_orthogonal (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  ↑(orthogonal_projection s p) ∈ mk' p s.directionᗮ :=
orthogonal_projection_fn_mem_orthogonal p

/-- Subtracting a point in the given subspace from the
`orthogonal_projection` produces a result in the direction of the
given subspace. -/
lemma orthogonal_projection_vsub_mem_direction {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p1 : P} (p2 : P) (hp1 : p1 ∈ s) :
  ↑(orthogonal_projection s p2 -ᵥ ⟨p1, hp1⟩ : s.direction) ∈ s.direction :=
(orthogonal_projection s p2 -ᵥ ⟨p1, hp1⟩ : s.direction).2

/-- Subtracting the `orthogonal_projection` from a point in the given
subspace produces a result in the direction of the given subspace. -/
lemma vsub_orthogonal_projection_mem_direction {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p1 : P} (p2 : P) (hp1 : p1 ∈ s) :
  ↑((⟨p1, hp1⟩ : s) -ᵥ orthogonal_projection s p2 : s.direction) ∈ s.direction :=
((⟨p1, hp1⟩ : s) -ᵥ orthogonal_projection s p2 : s.direction).2

/-- A point equals its orthogonal projection if and only if it lies in
the subspace. -/
lemma orthogonal_projection_eq_self_iff {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} :
  ↑(orthogonal_projection s p) = p ↔ p ∈ s :=
begin
  split,
  { exact λ h, h ▸ orthogonal_projection_mem p },
  { intro h,
    have hp : p ∈ ((s : set P) ∩ mk' p s.directionᗮ) := ⟨h, self_mem_mk' p _⟩,
    rw [inter_eq_singleton_orthogonal_projection p] at hp,
    symmetry,
    exact hp }
end

@[simp] lemma orthogonal_projection_mem_subspace_eq_self {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] (p : s) :
  orthogonal_projection s p = p :=
begin
  ext,
  rw orthogonal_projection_eq_self_iff,
  exact p.2
end

/-- Orthogonal projection is idempotent. -/
@[simp] lemma orthogonal_projection_orthogonal_projection (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  orthogonal_projection s (orthogonal_projection s p) = orthogonal_projection s p :=
begin
  ext,
  rw orthogonal_projection_eq_self_iff,
  exact orthogonal_projection_mem p,
end

lemma eq_orthogonal_projection_of_eq_subspace {s s' : affine_subspace ℝ P} [nonempty s]
  [nonempty s'] [complete_space s.direction] [complete_space s'.direction] (h : s = s') (p : P) :
  (orthogonal_projection s p : P) = (orthogonal_projection s' p : P) :=
begin
  change orthogonal_projection_fn s p = orthogonal_projection_fn s' p,
  congr,
  exact h
end

/-- The distance to a point's orthogonal projection is 0 iff it lies in the subspace. -/
lemma dist_orthogonal_projection_eq_zero_iff {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} :
  dist p (orthogonal_projection s p) = 0 ↔ p ∈ s :=
by rw [dist_comm, dist_eq_zero, orthogonal_projection_eq_self_iff]

/-- The distance between a point and its orthogonal projection is
nonzero if it does not lie in the subspace. -/
lemma dist_orthogonal_projection_ne_zero_of_not_mem {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} (hp : p ∉ s) :
  dist p (orthogonal_projection s p) ≠ 0 :=
mt dist_orthogonal_projection_eq_zero_iff.mp hp

/-- Subtracting `p` from its `orthogonal_projection` produces a result
in the orthogonal direction. -/
lemma orthogonal_projection_vsub_mem_direction_orthogonal (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  (orthogonal_projection s p : P) -ᵥ p ∈ s.directionᗮ :=
orthogonal_projection_fn_vsub_mem_direction_orthogonal p

/-- Subtracting the `orthogonal_projection` from `p` produces a result
in the orthogonal direction. -/
lemma vsub_orthogonal_projection_mem_direction_orthogonal (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  p -ᵥ orthogonal_projection s p ∈ s.directionᗮ :=
direction_mk' p s.directionᗮ ▸
  vsub_mem_direction (self_mem_mk' _ _) (orthogonal_projection_mem_orthogonal s p)

/-- Subtracting the `orthogonal_projection` from `p` produces a result in the kernel of the linear
part of the orthogonal projection. -/
lemma orthogonal_projection_vsub_orthogonal_projection (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  _root_.orthogonal_projection s.direction (p -ᵥ orthogonal_projection s p) = 0 :=
begin
  apply orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero,
  intros c hc,
  rw [← neg_vsub_eq_vsub_rev, inner_neg_right,
    (orthogonal_projection_vsub_mem_direction_orthogonal s p c hc), neg_zero]
end

/-- Adding a vector to a point in the given subspace, then taking the
orthogonal projection, produces the original point if the vector was
in the orthogonal direction. -/
lemma orthogonal_projection_vadd_eq_self {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} (hp : p ∈ s) {v : V}
  (hv : v ∈ s.directionᗮ) :
  orthogonal_projection s (v +ᵥ p) = ⟨p, hp⟩ :=
begin
  have h := vsub_orthogonal_projection_mem_direction_orthogonal s (v +ᵥ p),
  rw [vadd_vsub_assoc, submodule.add_mem_iff_right _ hv] at h,
  refine (eq_of_vsub_eq_zero _).symm,
  ext,
  refine submodule.disjoint_def.1 s.direction.orthogonal_disjoint _ _ h,
  exact (_ : s.direction).2
end

/-- Adding a vector to a point in the given subspace, then taking the
orthogonal projection, produces the original point if the vector is a
multiple of the result of subtracting a point's orthogonal projection
from that point. -/
lemma orthogonal_projection_vadd_smul_vsub_orthogonal_projection {s : affine_subspace ℝ P}
  [nonempty s] [complete_space s.direction] {p1 : P} (p2 : P) (r : ℝ) (hp : p1 ∈ s) :
  orthogonal_projection s (r • (p2 -ᵥ orthogonal_projection s p2 : V) +ᵥ p1) = ⟨p1, hp⟩ :=
orthogonal_projection_vadd_eq_self hp
  (submodule.smul_mem _ _ (vsub_orthogonal_projection_mem_direction_orthogonal s _))

/-- The square of the distance from a point in `s` to `p2` equals the
sum of the squares of the distances of the two points to the
`orthogonal_projection`. -/
lemma dist_sq_eq_dist_orthogonal_projection_sq_add_dist_orthogonal_projection_sq
  {s : affine_subspace ℝ P} [nonempty s] [complete_space s.direction] {p1 : P}
  (p2 : P) (hp1 : p1 ∈ s) :
  dist p1 p2 * dist p1 p2 =
    dist p1 (orthogonal_projection s p2) * dist p1 (orthogonal_projection s p2) +
    dist p2 (orthogonal_projection s p2) * dist p2 (orthogonal_projection s p2) :=
begin
  rw [pseudo_metric_space.dist_comm p2 _, dist_eq_norm_vsub V p1 _, dist_eq_norm_vsub V p1 _,
    dist_eq_norm_vsub V _ p2, ← vsub_add_vsub_cancel p1 (orthogonal_projection s p2) p2,
    norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero],
  exact submodule.inner_right_of_mem_orthogonal
    (vsub_orthogonal_projection_mem_direction p2 hp1)
    (orthogonal_projection_vsub_mem_direction_orthogonal s p2),
end

/-- The square of the distance between two points constructed by
adding multiples of the same orthogonal vector to points in the same
subspace. -/
lemma dist_sq_smul_orthogonal_vadd_smul_orthogonal_vadd {s : affine_subspace ℝ P}
    {p1 p2 : P} (hp1 : p1 ∈ s) (hp2 : p2 ∈ s) (r1 r2 : ℝ) {v : V}
    (hv : v ∈ s.directionᗮ) :
  dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) * dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) =
    dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (∥v∥ * ∥v∥) :=
calc dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) * dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2)
    = ∥(p1 -ᵥ p2) + (r1 - r2) • v∥ * ∥(p1 -ᵥ p2) + (r1 - r2) • v∥
  : by { rw [dist_eq_norm_vsub V (r1 • v +ᵥ p1), vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, sub_smul],
         abel }
... = ∥p1 -ᵥ p2∥ * ∥p1 -ᵥ p2∥ + ∥(r1 - r2) • v∥ * ∥(r1 - r2) • v∥
  : norm_add_sq_eq_norm_sq_add_norm_sq_real
      (submodule.inner_right_of_mem_orthogonal (vsub_mem_direction hp1 hp2)
        (submodule.smul_mem _ _ hv))
... = ∥(p1 -ᵥ p2 : V)∥ * ∥(p1 -ᵥ p2 : V)∥ + |r1 - r2| * |r1 - r2| * ∥v∥ * ∥v∥
  : by { rw [norm_smul, real.norm_eq_abs], ring }
... = dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (∥v∥ * ∥v∥)
  : by { rw [dist_eq_norm_vsub V p1, abs_mul_abs_self, mul_assoc] }

/-- Reflection in an affine subspace, which is expected to be nonempty
and complete.  The word "reflection" is sometimes understood to mean
specifically reflection in a codimension-one subspace, and sometimes
more generally to cover operations such as reflection in a point.  The
definition here, of reflection in an affine subspace, is a more
general sense of the word that includes both those common cases. -/
def reflection (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  P ≃ᵃⁱ[ℝ] P :=
affine_isometry_equiv.mk'
  (λ p, (↑(orthogonal_projection s p) -ᵥ p) +ᵥ orthogonal_projection s p)
  (_root_.reflection s.direction)
  ↑(classical.arbitrary s)
  begin
    intros p,
    let v := p -ᵥ ↑(classical.arbitrary s),
    let a : V := _root_.orthogonal_projection s.direction v,
    let b : P := ↑(classical.arbitrary s),
    have key : a +ᵥ b -ᵥ (v +ᵥ b) +ᵥ (a +ᵥ b) = a + a - v +ᵥ (b -ᵥ b +ᵥ b),
    { rw [← add_vadd, vsub_vadd_eq_vsub_sub, vsub_vadd, vadd_vsub],
      congr' 1,
      abel },
    have : p = v +ᵥ ↑(classical.arbitrary s) := (vsub_vadd p ↑(classical.arbitrary s)).symm,
    simpa only [coe_vadd, reflection_apply, affine_map.map_vadd, orthogonal_projection_linear,
      orthogonal_projection_mem_subspace_eq_self, vadd_vsub, continuous_linear_map.coe_coe,
      continuous_linear_equiv.coe_coe, this] using key,
  end

/-- The result of reflecting. -/
lemma reflection_apply (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] (p : P) :
  reflection s p = (↑(orthogonal_projection s p) -ᵥ p) +ᵥ orthogonal_projection s p :=
rfl

lemma eq_reflection_of_eq_subspace {s s' : affine_subspace ℝ P} [nonempty s]
  [nonempty s'] [complete_space s.direction] [complete_space s'.direction] (h : s = s') (p : P) :
  (reflection s p : P) = (reflection s' p : P) :=
by unfreezingI { subst h }

/-- Reflecting twice in the same subspace. -/
@[simp] lemma reflection_reflection (s : affine_subspace ℝ P) [nonempty s]
  [complete_space s.direction] (p : P) :
  reflection s (reflection s p) = p :=
begin
  have : ∀ a : s, ∀ b : V, (_root_.orthogonal_projection s.direction) b = 0
    → reflection s (reflection s (b +ᵥ a)) = b +ᵥ a,
  { intros a b h,
    have : (a:P) -ᵥ (b +ᵥ a) = - b,
    { rw [vsub_vadd_eq_vsub_sub, vsub_self, zero_sub] },
    simp [reflection, h, this] },
  rw ← vsub_vadd p (orthogonal_projection s p),
  exact this (orthogonal_projection s p) _ (orthogonal_projection_vsub_orthogonal_projection s p),
end

/-- Reflection is its own inverse. -/
@[simp] lemma reflection_symm (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  (reflection s).symm = reflection s :=
by { ext, rw ← (reflection s).injective.eq_iff, simp }

/-- Reflection is involutive. -/
lemma reflection_involutive (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction] :
  function.involutive (reflection s) :=
reflection_reflection s

/-- A point is its own reflection if and only if it is in the
subspace. -/
lemma reflection_eq_self_iff {s : affine_subspace ℝ P} [nonempty s] [complete_space s.direction]
  (p : P) : reflection s p = p ↔ p ∈ s :=
begin
  rw [←orthogonal_projection_eq_self_iff, reflection_apply],
  split,
  { intro h,
    rw [←@vsub_eq_zero_iff_eq V, vadd_vsub_assoc,
        ←two_smul ℝ (↑(orthogonal_projection s p) -ᵥ p), smul_eq_zero] at h,
    norm_num at h,
    exact h },
  { intro h,
    simp [h] }
end

/-- Reflecting a point in two subspaces produces the same result if
and only if the point has the same orthogonal projection in each of
those subspaces. -/
lemma reflection_eq_iff_orthogonal_projection_eq (s₁ s₂ : affine_subspace ℝ P)
  [nonempty s₁] [nonempty s₂] [complete_space s₁.direction] [complete_space s₂.direction] (p : P) :
  reflection s₁ p = reflection s₂ p ↔
    (orthogonal_projection s₁ p : P) = orthogonal_projection s₂ p :=
begin
  rw [reflection_apply, reflection_apply],
  split,
  { intro h,
    rw [←@vsub_eq_zero_iff_eq V, vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_comm,
        add_sub_assoc, vsub_sub_vsub_cancel_right,
        ←two_smul ℝ ((orthogonal_projection s₁ p : P) -ᵥ orthogonal_projection s₂ p),
        smul_eq_zero] at h,
    norm_num at h,
    exact h },
  { intro h,
    rw h }
end

/-- The distance between `p₁` and the reflection of `p₂` equals that
between the reflection of `p₁` and `p₂`. -/
lemma dist_reflection (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction]
  (p₁ p₂ : P) :
  dist p₁ (reflection s p₂) = dist (reflection s p₁) p₂ :=
begin
  conv_lhs { rw ←reflection_reflection s p₁ },
  exact (reflection s).dist_map _ _
end

/-- A point in the subspace is equidistant from another point and its
reflection. -/
lemma dist_reflection_eq_of_mem (s : affine_subspace ℝ P) [nonempty s] [complete_space s.direction]
  {p₁ : P} (hp₁ : p₁ ∈ s) (p₂ : P) :
  dist p₁ (reflection s p₂) = dist p₁ p₂ :=
begin
  rw ←reflection_eq_self_iff p₁ at hp₁,
  convert (reflection s).dist_map p₁ p₂,
  rw hp₁
end

/-- The reflection of a point in a subspace is contained in any larger
subspace containing both the point and the subspace reflected in. -/
lemma reflection_mem_of_le_of_mem {s₁ s₂ : affine_subspace ℝ P} [nonempty s₁]
  [complete_space s₁.direction] (hle : s₁ ≤ s₂) {p : P}
  (hp : p ∈ s₂) : reflection s₁ p ∈ s₂ :=
begin
  rw [reflection_apply],
  have ho : ↑(orthogonal_projection s₁ p) ∈ s₂ := hle (orthogonal_projection_mem p),
  exact vadd_mem_of_mem_direction (vsub_mem_direction ho hp) ho
end

/-- Reflecting an orthogonal vector plus a point in the subspace
produces the negation of that vector plus the point. -/
lemma reflection_orthogonal_vadd {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p : P} (hp : p ∈ s) {v : V}
  (hv : v ∈ s.directionᗮ) : reflection s (v +ᵥ p) = -v +ᵥ p :=
begin
  rw [reflection_apply, orthogonal_projection_vadd_eq_self hp hv, vsub_vadd_eq_vsub_sub],
  simp
end

/-- Reflecting a vector plus a point in the subspace produces the
negation of that vector plus the point if the vector is a multiple of
the result of subtracting a point's orthogonal projection from that
point. -/
lemma reflection_vadd_smul_vsub_orthogonal_projection {s : affine_subspace ℝ P} [nonempty s]
  [complete_space s.direction] {p₁ : P} (p₂ : P) (r : ℝ) (hp₁ : p₁ ∈ s) :
  reflection s (r • (p₂ -ᵥ orthogonal_projection s p₂) +ᵥ p₁) =
    -(r • (p₂ -ᵥ orthogonal_projection s p₂)) +ᵥ p₁ :=
reflection_orthogonal_vadd hp₁
  (submodule.smul_mem _ _ (vsub_orthogonal_projection_mem_direction_orthogonal s _))

omit V

/-- A set of points is cospherical if they are equidistant from some
point.  In two dimensions, this is the same thing as being
concyclic. -/
def cospherical (ps : set P) : Prop :=
∃ (center : P) (radius : ℝ), ∀ p ∈ ps, dist p center = radius

/-- The definition of `cospherical`. -/
lemma cospherical_def (ps : set P) :
  cospherical ps ↔ ∃ (center : P) (radius : ℝ), ∀ p ∈ ps, dist p center = radius :=
iff.rfl

/-- A subset of a cospherical set is cospherical. -/
lemma cospherical_subset {ps₁ ps₂ : set P} (hs : ps₁ ⊆ ps₂) (hc : cospherical ps₂) :
  cospherical ps₁ :=
begin
  rcases hc with ⟨c, r, hcr⟩,
  exact ⟨c, r, λ p hp, hcr p (hs hp)⟩
end

include V

/-- The empty set is cospherical. -/
lemma cospherical_empty : cospherical (∅ : set P) :=
begin
  use add_torsor.nonempty.some,
  simp,
end

omit V

/-- A single point is cospherical. -/
lemma cospherical_singleton (p : P) : cospherical ({p} : set P) :=
begin
  use p,
  simp
end

include V

/-- Two points are cospherical. -/
lemma cospherical_insert_singleton (p₁ p₂ : P) : cospherical ({p₁, p₂} : set P) :=
begin
  use [(2⁻¹ : ℝ) • (p₂ -ᵥ p₁) +ᵥ p₁, (2⁻¹ : ℝ) * (dist p₂ p₁)],
  intro p,
  rw [set.mem_insert_iff, set.mem_singleton_iff],
  rintro ⟨_|_⟩,
  { rw [dist_eq_norm_vsub V p₁, vsub_vadd_eq_vsub_sub, vsub_self, zero_sub, norm_neg, norm_smul,
        dist_eq_norm_vsub V p₂],
    simp },
  { rw [H, dist_eq_norm_vsub V p₂, vsub_vadd_eq_vsub_sub, dist_eq_norm_vsub V p₂],
    conv_lhs { congr, congr, rw ←one_smul ℝ (p₂ -ᵥ p₁ : V) },
    rw [←sub_smul, norm_smul],
    norm_num }
end

/-- Any three points in a cospherical set are affinely independent. -/
lemma cospherical.affine_independent {s : set P} (hs : cospherical s) {p : fin 3 → P}
  (hps : set.range p ⊆ s) (hpi : function.injective p) :
  affine_independent ℝ p :=
begin
  rw affine_independent_iff_not_collinear,
  intro hc,
  rw collinear_iff_of_mem ℝ (set.mem_range_self (0 : fin 3)) at hc,
  rcases hc with ⟨v, hv⟩,
  rw set.forall_range_iff at hv,
  have hv0 : v ≠ 0,
  { intro h,
    have he : p 1 = p 0, by simpa [h] using hv 1,
    exact (dec_trivial : (1 : fin 3) ≠ 0) (hpi he) },
  rcases hs with ⟨c, r, hs⟩,
  have hs' := λ i, hs (p i) (set.mem_of_mem_of_subset (set.mem_range_self _) hps),
  choose f hf using hv,
  have hsd : ∀ i, dist ((f i • v) +ᵥ p 0) c = r,
  { intro i,
    rw ←hf,
    exact hs' i },
  have hf0 : f 0 = 0,
  { have hf0' := hf 0,
    rw [eq_comm, ←@vsub_eq_zero_iff_eq V, vadd_vsub, smul_eq_zero] at hf0',
    simpa [hv0] using hf0' },
  have hfi : function.injective f,
  { intros i j h,
    have hi := hf i,
    rw [h, ←hf j] at hi,
    exact hpi hi },
  simp_rw [←hsd 0, hf0, zero_smul, zero_vadd, dist_smul_vadd_eq_dist (p 0) c hv0] at hsd,
  have hfn0 : ∀ i, i ≠ 0 → f i ≠ 0 := λ i, (hfi.ne_iff' hf0).2,
  have hfn0' : ∀ i, i ≠ 0 → f i = (-2) * ⟪v, (p 0 -ᵥ c)⟫ / ⟪v, v⟫,
  { intros i hi,
    have hsdi := hsd i,
    simpa [hfn0, hi] using hsdi },
  have hf12 : f 1 = f 2, { rw [hfn0' 1 dec_trivial, hfn0' 2 dec_trivial] },
  exact (dec_trivial : (1 : fin 3) ≠ 2) (hfi hf12)
end

end euclidean_geometry


import data.rat

namespace rat

lemma mk_with_one_eq_cast (n : ℤ) : mk n 1 = n :=
 by {rw[← of_int_eq_mk n,← coe_int_eq_of_int],}

lemma mk_nat_with_one_eq_cast (n : ℤ) : mk_nat n 1 = n :=
 calc mk_nat n 1 = mk n (int.of_nat 1) : rfl
  ... = n : mk_with_one_eq_cast n

lemma mk_pnat_with_one_eq_cast (n : ℤ) : mk_pnat n 1 = n :=
 mk_nat_with_one_eq_cast n

lemma of_int_eq_cast (n : ℤ) : of_int n = n :=
 (coe_int_eq_of_int n).symm

lemma nat_mk_with_one_eq_cast (n : ℕ) : mk n 1 = n :=
 by {rw[mk_with_one_eq_cast,int.cast_coe_nat],}

lemma nat_mk_nat_with_one_eq_cast (n : ℕ) : mk_nat n 1 = n :=
 by {rw[mk_nat_with_one_eq_cast,int.cast_coe_nat],}

lemma nat_mk_pnat_with_one_eq_cast (n : ℕ) : mk_pnat n 1 = n :=
 by {rw[mk_pnat_with_one_eq_cast,int.cast_coe_nat],}

theorem num_denom'' (q : ℚ) : q = (q.num : ℚ) / (q.denom : ℚ) :=
begin
 have dnz : (q.denom : ℚ) ≠ 0 := ne_of_gt (nat.cast_pos.mpr q.pos),
 rw[eq_div_iff_mul_eq dnz],
 have : q * q.denom = (mk q.num q.denom) * q.denom :=
  by {congr' 1,exact num_denom.symm},
 rw[mk_eq_div,int.cast_coe_nat,div_mul_cancel _ dnz] at this,
 exact this,
end

end rat


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

Archimedean groups and fields.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.field_power
import Mathlib.data.rat.default
import Mathlib.PostPort

universes u_2 l u_1

namespace Mathlib

/-- An ordered additive commutative monoid is called `archimedean` if for any two elements `x`, `y`
such that `0 < y` there exists a natural number `n` such that `x ≤ n •ℕ y`. -/
class archimedean (α : Type u_2) [ordered_add_comm_monoid α] where
  arch : ∀ (x : α) {y : α}, 0 < y → ∃ (n : ℕ), x ≤ n •ℕ y

namespace linear_ordered_add_comm_group

/-- An archimedean decidable linearly ordered `add_comm_group` has a version of the floor: for
`a > 0`, any `g` in the group lies between some two consecutive multiples of `a`. -/
theorem exists_int_smul_near_of_pos {α : Type u_1} [linear_ordered_add_comm_group α] [archimedean α]
    {a : α} (ha : 0 < a) (g : α) : ∃ (k : ℤ), k •ℤ a ≤ g ∧ g < (k + 1) •ℤ a :=
  sorry

theorem exists_int_smul_near_of_pos' {α : Type u_1} [linear_ordered_add_comm_group α]
    [archimedean α] {a : α} (ha : 0 < a) (g : α) : ∃ (k : ℤ), 0 ≤ g - k •ℤ a ∧ g - k •ℤ a < a :=
  sorry

end linear_ordered_add_comm_group

theorem exists_nat_gt {α : Type u_1} [ordered_semiring α] [nontrivial α] [archimedean α] (x : α) :
    ∃ (n : ℕ), x < ↑n :=
  sorry

theorem exists_nat_ge {α : Type u_1} [ordered_semiring α] [archimedean α] (x : α) :
    ∃ (n : ℕ), x ≤ ↑n :=
  sorry

theorem add_one_pow_unbounded_of_pos {α : Type u_1} [ordered_semiring α] [nontrivial α]
    [archimedean α] (x : α) {y : α} (hy : 0 < y) : ∃ (n : ℕ), x < (y + 1) ^ n :=
  sorry

theorem pow_unbounded_of_one_lt {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α)
    {y : α} (hy1 : 1 < y) : ∃ (n : ℕ), x < y ^ n :=
  sub_add_cancel y 1 ▸ add_one_pow_unbounded_of_pos x (iff.mpr sub_pos hy1)

/-- Every x greater than or equal to 1 is between two successive
natural-number powers of every y greater than one. -/
theorem exists_nat_pow_near {α : Type u_1} [linear_ordered_ring α] [archimedean α] {x : α} {y : α}
    (hx : 1 ≤ x) (hy : 1 < y) : ∃ (n : ℕ), y ^ n ≤ x ∧ x < y ^ (n + 1) :=
  sorry

theorem exists_int_gt {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α) :
    ∃ (n : ℤ), x < ↑n :=
  sorry

theorem exists_int_lt {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α) :
    ∃ (n : ℤ), ↑n < x :=
  sorry

theorem exists_floor {α : Type u_1} [linear_ordered_ring α] [archimedean α] (x : α) :
    ∃ (fl : ℤ), ∀ (z : ℤ), z ≤ fl ↔ ↑z ≤ x :=
  sorry

/-- Every positive `x` is between two successive integer powers of
another `y` greater than one. This is the same as `exists_int_pow_near'`,
but with ≤ and < the other way around. -/
theorem exists_int_pow_near {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α}
    (hx : 0 < x) (hy : 1 < y) : ∃ (n : ℤ), y ^ n ≤ x ∧ x < y ^ (n + 1) :=
  sorry

/-- Every positive `x` is between two successive integer powers of
another `y` greater than one. This is the same as `exists_int_pow_near`,
but with ≤ and < the other way around. -/
theorem exists_int_pow_near' {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α}
    (hx : 0 < x) (hy : 1 < y) : ∃ (n : ℤ), y ^ n < x ∧ x ≤ y ^ (n + 1) :=
  sorry

/-- For any `y < 1` and any positive `x`, there exists `n : ℕ` with `y ^ n < x`. -/
theorem exists_pow_lt_of_lt_one {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α}
    {y : α} (hx : 0 < x) (hy : y < 1) : ∃ (n : ℕ), y ^ n < x :=
  sorry

/-- Given `x` and `y` between `0` and `1`, `x` is between two successive powers of `y`.
This is the same as `exists_nat_pow_near`, but for elements between `0` and `1` -/
theorem exists_nat_pow_near_of_lt_one {α : Type u_1} [linear_ordered_field α] [archimedean α]
    {x : α} {y : α} (xpos : 0 < x) (hx : x ≤ 1) (ypos : 0 < y) (hy : y < 1) :
    ∃ (n : ℕ), y ^ (n + 1) < x ∧ x ≤ y ^ n :=
  sorry

theorem sub_floor_div_mul_nonneg {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α)
    {y : α} (hy : 0 < y) : 0 ≤ x - ↑(floor (x / y)) * y :=
  sorry

theorem sub_floor_div_mul_lt {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α) {y : α}
    (hy : 0 < y) : x - ↑(floor (x / y)) * y < y :=
  sorry

protected instance nat.archimedean : archimedean ℕ :=
  archimedean.mk
    fun (n m : ℕ) (m0 : 0 < m) =>
      Exists.intro n
        (eq.mpr
          (id
            ((fun (ᾰ ᾰ_1 : ℕ) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℕ) (e_3 : ᾰ_2 = ᾰ_3) =>
                congr (congr_arg LessEq e_2) e_3)
              n n (Eq.refl n) (n •ℕ m) (n * m) (nat.nsmul_eq_mul n m)))
          (eq.mp
            ((fun (ᾰ ᾰ_1 : ℕ) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ℕ) (e_3 : ᾰ_2 = ᾰ_3) =>
                congr (congr_arg LessEq e_2) e_3)
              (n * Nat.succ 0) n (mul_one n) (n * m) (n * m) (Eq.refl (n * m)))
            (nat.mul_le_mul_left n m0)))

protected instance int.archimedean : archimedean ℤ := sorry

/-- A linear ordered archimedean ring is a floor ring. This is not an `instance` because in some
cases we have a computable `floor` function. -/
def archimedean.floor_ring (α : Type u_1) [linear_ordered_ring α] [archimedean α] : floor_ring α :=
  floor_ring.mk (fun (x : α) => classical.some (exists_floor x)) sorry

theorem archimedean_iff_nat_lt {α : Type u_1} [linear_ordered_field α] :
    archimedean α ↔ ∀ (x : α), ∃ (n : ℕ), x < ↑n :=
  sorry

theorem archimedean_iff_nat_le {α : Type u_1} [linear_ordered_field α] :
    archimedean α ↔ ∀ (x : α), ∃ (n : ℕ), x ≤ ↑n :=
  sorry

theorem exists_rat_gt {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : α) :
    ∃ (q : ℚ), x < ↑q :=
  sorry

theorem archimedean_iff_rat_lt {α : Type u_1} [linear_ordered_field α] :
    archimedean α ↔ ∀ (x : α), ∃ (q : ℚ), x < ↑q :=
  sorry

theorem archimedean_iff_rat_le {α : Type u_1} [linear_ordered_field α] :
    archimedean α ↔ ∀ (x : α), ∃ (q : ℚ), x ≤ ↑q :=
  sorry

theorem exists_rat_lt {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : α) :
    ∃ (q : ℚ), ↑q < x :=
  sorry

theorem exists_rat_btwn {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α} {y : α}
    (h : x < y) : ∃ (q : ℚ), x < ↑q ∧ ↑q < y :=
  sorry

theorem exists_nat_one_div_lt {α : Type u_1} [linear_ordered_field α] [archimedean α] {ε : α}
    (hε : 0 < ε) : ∃ (n : ℕ), 1 / (↑n + 1) < ε :=
  sorry

theorem exists_pos_rat_lt {α : Type u_1} [linear_ordered_field α] [archimedean α] {x : α}
    (x0 : 0 < x) : ∃ (q : ℚ), 0 < q ∧ ↑q < x :=
  sorry

@[simp] theorem rat.cast_floor {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : ℚ) :
    floor ↑x = floor x :=
  sorry

/-- `round` rounds a number to the nearest integer. `round (1 / 2) = 1` -/
def round {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α) : ℤ :=
  floor (x + 1 / bit0 1)

theorem abs_sub_round {α : Type u_1} [linear_ordered_field α] [floor_ring α] (x : α) :
    abs (x - ↑(round x)) ≤ 1 / bit0 1 :=
  sorry

theorem exists_rat_near {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : α) {ε : α}
    (ε0 : 0 < ε) : ∃ (q : ℚ), abs (x - ↑q) < ε :=
  sorry

protected instance rat.archimedean : archimedean ℚ :=
  iff.mpr archimedean_iff_rat_le
    fun (q : ℚ) =>
      Exists.intro q (eq.mpr (id (Eq._oldrec (Eq.refl (q ≤ ↑q)) (rat.cast_id q))) (le_refl q))

@[simp] theorem rat.cast_round {α : Type u_1} [linear_ordered_field α] [archimedean α] (x : ℚ) :
    round ↑x = round x :=
  sorry

end Mathlib


/-
  Presheaf of rings.

  https://stacks.math.columbia.edu/tag/006N
-/

import data.equiv.algebra
import topology.opens
import sheaves.presheaf

open topological_space

universes u v

-- Definition of a presheaf of rings.

structure presheaf_of_rings (α : Type u) [topological_space α]
extends presheaf α :=
(Fring           : ∀ (U), comm_ring (F U))
(res_is_ring_hom : ∀ (U V) (HVU : V ⊆ U), is_ring_hom (res U V HVU))

instance (α : Type u) [topological_space α] : has_coe_to_fun (presheaf_of_rings α) :=
{ F := λ _, opens α → Type v,
  coe := λ F, (presheaf_of_rings.to_presheaf F).F }

attribute [instance] presheaf_of_rings.Fring
attribute [instance] presheaf_of_rings.res_is_ring_hom

namespace presheaf_of_rings

variables {α : Type u} {β : Type v} [topological_space α] [topological_space β]

-- Morphism of presheaf of rings.

structure morphism (F G : presheaf_of_rings α)
extends presheaf.morphism F.to_presheaf G.to_presheaf :=
(ring_homs : ∀ (U), is_ring_hom (map U))

infix `⟶`:80 := morphism

def identity (F : presheaf_of_rings α) : F ⟶ F :=
{ ring_homs := λ U, is_ring_hom.id,
  ..presheaf.id F.to_presheaf }

-- Isomorphic presheaves of rings.

structure iso (F G : presheaf_of_rings α) :=
(mor : F ⟶ G)
(inv : G ⟶ F)
(mor_inv_id : mor.to_morphism ⊚ inv.to_morphism = presheaf.id F.to_presheaf)
(inv_mor_id : inv.to_morphism ⊚ mor.to_morphism = presheaf.id G.to_presheaf)

infix `≅`:80 := λ A B, nonempty (iso A B)

-- Equality lemma

lemma presheaf_of_rings_eq_of_subset_eq (F : presheaf_of_rings α) (U V : opens α)
: U = V → ring_equiv (F U) (F V) :=
λ h, by rw h; by apply ring_equiv.refl

end presheaf_of_rings


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.char.basic
! leanprover-community/mathlib commit f048da4c98c6105b94696a8c02392f24a7a37bba
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Nat.Basic

open Nat

@[reducible]
def IsValidChar (n : Nat) : Prop :=
  n < 55296 ∨ 57343 < n ∧ n < 1114112
#align is_valid_char IsValidChar

theorem isValidChar_range_1 (n : Nat) (h : n < 55296) : IsValidChar n :=
  Or.inl h
#align is_valid_char_range_1 isValidChar_range_1

theorem isValidChar_range_2 (n : Nat) (h₁ : 57343 < n) (h₂ : n < 1114112) : IsValidChar n :=
  Or.inr ⟨h₁, h₂⟩
#align is_valid_char_range_2 isValidChar_range_2

#print Char /-
/-- The `char` type represents an unicode scalar value.
    See http://www.unicode.org/glossary/#unicode_scalar_value). -/
structure Char where
  val : Nat
  valid : IsValidChar val
#align char Char
-/

instance : SizeOf Char :=
  ⟨fun c => c.val⟩

namespace Char

protected def Lt (a b : Char) : Prop :=
  a.val < b.val
#align char.lt Char.Lt

protected def Le (a b : Char) : Prop :=
  a.val ≤ b.val
#align char.le Char.Le

instance : LT Char :=
  ⟨Char.Lt⟩

instance : LE Char :=
  ⟨Char.Le⟩

instance decidableLt (a b : Char) : Decidable (a < b) :=
  Nat.decidableLt _ _
#align char.decidable_lt Char.decidableLt

instance decidableLe (a b : Char) : Decidable (a ≤ b) :=
  Nat.decidableLe _ _
#align char.decidable_le Char.decidableLe

/-
We cannot use tactics dec_trivial or comp_val here because the tactic framework has not been defined yet.
We also do not use `zero_lt_succ _` as a proof term because this proof may not be trivial to check by
external type checkers. See discussion at: https://github.com/leanprover/tc/issues/8
-/
theorem zero_lt_d800 : 0 < 55296 :=
  Nat.zero_lt_bit0 <|
    Nat.bit0_ne_zero <|
      Nat.bit0_ne_zero <|
        Nat.bit0_ne_zero <|
          Nat.bit0_ne_zero <|
            Nat.bit0_ne_zero <|
              Nat.bit0_ne_zero <|
                Nat.bit0_ne_zero <|
                  Nat.bit0_ne_zero <| Nat.bit0_ne_zero <| Nat.bit0_ne_zero <| Nat.bit1_ne_zero 13
#align char.zero_lt_d800 Char.zero_lt_d800

#print Char.ofNat /-
@[match_pattern]
def ofNat (n : Nat) : Char :=
  if h : IsValidChar n then
    { val := n
      valid := h }
  else
    { val := 0
      valid := Or.inl zero_lt_d800 }
#align char.of_nat Char.ofNat
-/

#print Char.toNat /-
def toNat (c : Char) : Nat :=
  c.val
#align char.to_nat Char.toNat
-/

theorem eq_of_veq : ∀ {c d : Char}, c.val = d.val → c = d
  | ⟨v, h⟩, ⟨_, _⟩, rfl => rfl
#align char.eq_of_veq Char.eq_of_veq

theorem veq_of_eq : ∀ {c d : Char}, c = d → c.val = d.val
  | _, _, rfl => rfl
#align char.veq_of_eq Char.veq_of_eq

theorem ne_of_vne {c d : Char} (h : c.val ≠ d.val) : c ≠ d := fun h' => absurd (veq_of_eq h') h
#align char.ne_of_vne Char.ne_of_vne

theorem vne_of_ne {c d : Char} (h : c ≠ d) : c.val ≠ d.val := fun h' => absurd (eq_of_veq h') h
#align char.vne_of_ne Char.vne_of_ne

end Char

instance : DecidableEq Char := fun i j =>
  decidable_of_decidable_of_iff (Nat.decidableEq i.val j.val) ⟨Char.eq_of_veq, Char.veq_of_eq⟩

instance : Inhabited Char :=
  ⟨'A'⟩


lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
    intros pq qr,
    cases pq with hpq hqp,
    cases qr with hqr hrq,
    split,
    {
        intro p,
        apply hqr,
        apply hpq,
        exact p,
    },
    {
        intro r,
        apply hqp,
        apply hrq,
        exact r,
    },
end


import Math.Algebra.Monoid.Basic
import Math.Algebra.AddGroup.Basic
-- import Math.Algebra.Group.Basic

open Algebra.Monoid
open Algebra.AddMonoid
open Algebra.AddGroup

namespace Algebra

class Ring (α : Type u) extends AddGroup α, Monoid α where
  distrib_left : ∀ (x y z : α), x * (y + z) = x * y + x * z
  distrib_right : ∀ (x y z : α), (x + y) * z = x * z + y * z

attribute [simp] Ring.distrib_left Ring.distrib_right

namespace Ring

variable {α : Type u} [R : Ring α]

theorem cancel_add_left {x y z : α} (h : x + z = y + z) : x = y := by {
  have q : x + z + (-z) = y + z + (-z) := by rw [h];
  rw [← add_assoc, ← add_assoc, add_neg, add_zero, add_zero] at q;
  exact q;
}

theorem cancel_add_right {x y z : α} (h : z + x = z + y) : x = y := by {
  have q : (-z) + z + x = (-z) + z + y := by rw [← add_assoc, ← add_assoc, h];
  rw [neg_add, zero_add, zero_add] at q;
  exact q;
}

@[simp]
theorem mul_zero (x : α) : x * 0 = 0 := by {
  let q := distrib_left x 0 0;
  rw [zero_add] at q;
  have s : x * 0 + 0 = x * 0 + x * 0 := by rw [add_zero]; exact q;
  exact Eq.symm (cancel_add_right s);
}

@[simp]
theorem zero_mul (x : α) : 0 * x = 0 := by {
  let q := distrib_right 0 0 x;
  rw [add_zero] at q;
  have s : 0 * x + 0 = 0 * x + 0 * x := by rw [add_zero]; exact q;
  exact Eq.symm (cancel_add_right s);
}

instance : AddZero α where
  add_zero := R.add_zero
  zero_add := R.zero_add

instance : MulZero α where
  mul_zero := R.mul_zero
  zero_mul := R.zero_mul

end Ring

class abbrev RingHom (f : α → β) [Ring α] [Ring β] : Prop := AddGroupHom f, MulHom f, OneHom f

end Algebra


import Aesop

namespace Hoare

abbrev Val := Nat

structure NamedVal where
  name : String
  val : Val

abbrev Env := String → Option Nat
abbrev TopM := StateT Env Option

inductive Expr
| const (n : Nat) : Expr
| var (x : String) : Expr
| add (e₁ e₂ : Expr) : Expr
| sub (e₁ e₂ : Expr) : Expr
| mul (e₁ e₂ : Expr) : Expr
| div (e₁ e₂ : Expr) : Expr

def Expr.eval (env: Env): Expr → Option Val
| (Expr.const n) => pure n
| (Expr.var x) => do
  env x
| (Expr.add e₁ e₂) => do
  let v₁ ← Expr.eval env e₁
  let v₂ ← Expr.eval env e₂
  pure (v₁ + v₂)
| (Expr.sub e₁ e₂) => do
  let v₁ ← Expr.eval env e₁
  let v₂ ← Expr.eval env e₂
  pure (v₁ - v₂)
| (Expr.mul e₁ e₂) => do
  let v₁ ← Expr.eval env e₁
  let v₂ ← Expr.eval env e₂
  pure (v₁ * v₂)
| (Expr.div e₁ e₂) => do
  let v₁ ← Expr.eval env e₁
  let v₂ ← Expr.eval env e₂
  if v₂ = 0 then
    .none
  else
    pure (v₁ / v₂)

inductive Command
| skip: Command
| assign (x : String) (e : Expr) : Command
| seq (c₁ c₂ : Command) : Command
| if_ (e : Expr) (c₁ c₂ : Command) : Command

def TopM.updateEnv (f : Env → Env) : TopM Unit := do
  let env ← get
  let env' := f env
  set env'

def Env.set (nv: NamedVal) (env: Env) : Env :=
  fun x => if x = nv.name then nv.val else env x

theorem Env.get_set_eq (env: Env) (n: String) (v: Nat): (Env.set ⟨n, v⟩ env) n = .some v :=
  by simp[Env.set]

theorem Env.get_set_neq (env: Env)
  (lookupk setk: String) (NEQ: lookupk ≠ setk)
  (v: Nat): (Env.set ⟨setk, v⟩ env) lookupk = env lookupk := by {
    simp[Env.set];
    rw[if_neg NEQ];
  }

def Command.exec : Command → TopM Unit
| Command.skip => return ()
| (Command.assign x e) => do
  let v ← Expr.eval (← get) e
  TopM.updateEnv (Env.set ⟨x, v⟩)
| (Command.seq c₁ c₂) => do
  Command.exec c₁
  (Command.exec c₂)
| (Command.if_ e c₁ c₂) => do
  let v ← Expr.eval (← get) e
  if v = 0 then Command.exec c₂ else Command.exec c₁

def assertion  := Env → Prop

/-
Hoare triple assering partial correctness.
If the environment satisfies P and then program
runs successfully, then the final environment satisfies Q.
-/
def hoare_triple (P: assertion) (c: Command) (Q: assertion) : Prop :=
  ∀ (env: Env), P env →
    match (c.exec.run env) with
    | .none => True
    | .some ((), st) => Q st

-- weakest precondition
def Command.wp (Q: assertion): Command → assertion
| Command.skip => Q
| (Command.assign x e) => fun env => ∃ v, Expr.eval env e = .some v ∧ Q (env.set ⟨x, v⟩)
| (Command.seq c₁ c₂) =>
    let wp2 := c₂.wp Q
    let wp1 := c₁.wp wp2
    wp1
| (Command.if_ e c₁ c₂) =>
  fun env => ∃ v, Expr.eval env e = .some v ∧
  (if v = 0 then Command.wp Q c₂ else Command.wp Q c₁) env

def assertion.implies (P Q: assertion) : Prop := ∀ env, P env → Q env

/-
Prove that the weakest precondition is a precondition.
-/
theorem Command.wp.skip.is_precondition:
  ∀ (Q: assertion), hoare_triple (Command.skip.wp Q) Command.skip Q := by {
    intros Q;
    simp[hoare_triple, wp, exec, pure, StateT.run, StateT.pure];
}

theorem Command.wp.assign.is_precondition:
  ∀ {c: Command} {name: String} {val: Expr} {C: c = Command.assign name val}
    {Q: assertion}, hoare_triple (c.wp Q) c Q := by {
    intros c name expr C Q;
    simp[C];
    simp[hoare_triple, wp, exec, pure, StateT.run, StateT.pure];
    intros env expr_val EXPR_VAL Qenv';
    simp[get, getThe, MonadStateOf.get, StateT.get, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
      StateT.lift];
    simp[EXPR_VAL];
    simp[TopM.updateEnv, set, StateT.set, StateT.run, StateT.pure, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
      StateT.lift, get, getThe, MonadStateOf.get, StateT.get];
    simp[Qenv'];
}

theorem Command.wp.is_precondition:
  ∀ (Q: assertion) (c: Command), hoare_triple (c.wp Q) c Q := by {

    intros Q c;
    revert Q;
    induction c;
    case skip => {
      intros Q;
      apply Command.wp.skip.is_precondition;
    }
    case assign x e => {
      intros Q;
      apply Command.wp.assign.is_precondition (C := rfl)
    }
    case seq c1 c2 IH1 IH2 => {
      simp[wp];
      intros Q;
      simp[hoare_triple, exec, pure, StateT.run, StateT.pure] at *;
      intros env Penv;
      simp[get, getThe, MonadStateOf.get, StateT.get, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
        StateT.lift];
      simp[hoare_triple] at IH1;
      specialize (IH1 _ _ Penv);
      simp[Option.bind];
      cases H: (exec c1 env);
      case none => {
        simp[H] at *;
      }
      case some unit_st => {
        have (unit, st) := unit_st;
        simp at *;
        simp[H] at IH1;
        specialize (IH2 _ _ IH1);
        exact IH2;
      }
    }
    case if_ e c1 c2 IH1 IH2 => {
      intros Q;
      simp[hoare_triple, exec, pure, StateT.run, StateT.pure] at *;
      intros env Penv;
      simp[get, getThe, MonadStateOf.get, StateT.get, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
        StateT.lift];
      simp[wp] at Penv;
      have ⟨eval, EVAL, Penv'⟩ := Penv;
      by_cases (eval = 0);
      case pos EVAL_0 => {
        simp[EVAL];
        simp[EVAL_0] at *;
        apply IH2;
        exact Penv';
      }
      case neg EVAL_0 => {
        simp[EVAL];
        simp[EVAL_0] at *;
        apply IH1;
        exact Penv';
      }
    }
  }

-- strongest postcondition
def Command.sp (P: assertion): Command → assertion
| Command.skip => P
| (Command.assign x e) => fun newenv =>
      ∃ (oldv : Option Nat),
      let oldenv : Env := fun (key :String) => if key = x
                          then oldv
                          else newenv key;
                          P oldenv /\ e.eval oldenv = newenv x
| (Command.seq c₁ c₂) =>
    let sp1 := c₁.sp P
    let sp2 := c₂.sp sp1
    sp2
| (Command.if_ e c₁ c₂) =>
  fun env => ∃ v,
    Expr.eval env e = .some v ∧ -- this is wrong, we should talk about the old environment! Jesus.
      (if v = 0 then Command.sp P c₂ env else Command.sp P c₁ env )

theorem Command.sp.skip.is_postcondition:
  ∀ (P: assertion), hoare_triple P Command.skip (Command.skip.sp P) := by {
    intros P;
    simp[hoare_triple, sp, exec, pure, StateT.run, StateT.pure];
}

theorem Command.sp.assign.is_postcondition:
  ∀ {c: Command} {name: String} {val: Expr} {C: c = Command.assign name val}
    {P: assertion}, hoare_triple P c (c.sp P) := by {
    intros c name expr C P;
    simp[C];
    simp[hoare_triple, sp, exec, pure, StateT.run, StateT.pure];
    intros env Penv;
    simp[get, getThe, MonadStateOf.get, StateT.get, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
      StateT.lift];
    simp[sp] at Penv;
    simp[TopM.updateEnv, set, StateT.set, StateT.run, StateT.pure, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
      StateT.lift, get, getThe, MonadStateOf.get, StateT.get];
    cases EXPR_VAL:(Expr.eval env expr);
    case none => {
      simp[EXPR_VAL];
    }
    case some val => {
      simp[EXPR_VAL];
      simp[Penv];
      let oldval := env name;
      exists oldval;
      suffices (fun key => if key = name then oldval else Env.set { name := name, val := val } env key) = env by {
        rw[this];
        simp[Penv, EXPR_VAL, Env.set];
      }
      funext needle;
      by_cases NEEDLE:needle = name <;> simp[Env.set, NEEDLE];
    }
}

theorem Command.sp.is_postcondition:
  ∀ (P: assertion) (c: Command), hoare_triple P c (c.sp P) := by {

    intros P c;
    revert P;
    induction c;
    case skip => {
      intros P;
      apply Command.sp.skip.is_postcondition;
    }
    case assign x e => {
      intros P;
      apply Command.sp.assign.is_postcondition (C := rfl)
    }
    /- Wow, copilot auto-generated the 'seq' case! -/
    case seq c1 c2 IH1 IH2 => {
      simp[sp];
      intros P;
      simp[hoare_triple, exec, pure, StateT.run, StateT.pure] at *;
      intros env Penv;
      simp[get, getThe, MonadStateOf.get, StateT.get, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
        StateT.lift];
      simp[hoare_triple] at IH1;
      specialize (IH1 _ _ Penv);
      simp[Option.bind];
      cases H: (exec c1 env);
      case none => {
        simp[H] at *;
      }
      case some unit_st => {
        have (unit, st) := unit_st;
        simp at *;
        simp[H] at IH1;
        specialize (IH2 _ _ IH1);
        exact IH2;
      }
    }
    case if_ e c1 c2 IH1 IH2 => {
      intros Q;
      simp[sp];
      simp[hoare_triple, exec, pure, StateT.run, StateT.pure] at *;
      intros env Qenv;
      simp[get, getThe, MonadStateOf.get, StateT.get, bind, StateT.bind, pure, liftM, monadLift, MonadLift.monadLift,
        StateT.lift];
      simp[wp] at Qenv;
      simp[Option.bind];
      cases EVAL: (Expr.eval env e) <;> simp[EVAL];
      case some val => {
        simp at *;
        by_cases (val = 0);
        case pos EVAL_0 => {
          simp[EVAL_0];
          cases C2VAL : (exec c2 env) <;> simp;
          case some unit_and_env' => {
              have (unit, env') := unit_and_env';
              specialize (IH2 _ _ Qenv);
              simp[C2VAL] at IH2;
              simp;
              exists val;
              simp[EVAL];
              sorry;
          }
        }
        case neg EVAL_1 => {
          simp[EVAL_1];
          cases C1VAL : (exec c1 env) <;> simp;
          case some unit_and_e1val => {
              have (unit, e1val) := unit_and_e1val;
              specialize (IH1 _ _ Qenv);
              simp[C1VAL] at IH1;
              simp;
              sorry;
          }
        }
    }
  }
}

structure Rewrite where
  find: Command
  replace : Command
  correct: ∀ (post: assertion), (replace.sp (find.wp post)).implies post
---
-- {???} <find> {<post>}
-- {wp(<post>)} <find> {<post>}
-- {wp(<post>)} <replace> {???}
-- {wp(<post>)} <replace> {sp(wp(<post>>))}
-- sp(wp(<post>>)) => <post>

def rewriteSubSubXEqZero : Rewrite :=
  {
    find := Command.assign "out" (Expr.sub (Expr.var "y") (Expr.var "y")),
    replace := Command.assign "out" (Expr.const 0),
    correct := fun post => by {
      simp[Command.wp, Command.sp, assertion.implies];
      intros env moutv outv E1 E2 E3;
      -- See that the proof state here is only about environments and evaluating expressions,
      -- which is what we want. We have cut out the extraneous junk of evaluating what the hell
      -- assignments are.
      simp[Expr.eval] at E1 E3;
      cases ENV_Y:(env "y") <;> simp [ENV_Y, bind, Option.bind] at E1;
      case some yval => {
        injection E1 with E1;
        simp[E1] at E3;
        simp[Expr.eval, pure] at E3;
        suffices (Env.set { name := "out", val := outv } fun key => if key = "out" then moutv else env key) = env by {
          subst E1; simp_all only
        }
        funext key; simp[Env.set];
        by_cases KEY:(key = "out") <;> simp[KEY, E3];
      }
    }
  }

end Hoare


/-
Copyright (c) 2022 Alex J. Best. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best

! This file was ported from Lean 3 source module data.finsupp.pwo
! leanprover-community/mathlib commit f16e7a22e11fc09c71f25446ac1db23a24e8a0bd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finsupp.Order
import Mathbin.Order.WellFoundedSet

/-!
# Partial well ordering on finsupps

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

This file contains the fact that finitely supported functions from a fintype are
partially well ordered when the codomain is a linear order that is well ordered.
It is in a separate file for now so as to not add imports to the file `order.well_founded_set`.

## Main statements

* `finsupp.is_pwo` - finitely supported functions from a fintype are partially well ordered when
  the codomain is a linear order that is well ordered

## Tags

Dickson, order, partial well order
-/

/- warning: finsupp.is_pwo -> Finsupp.isPwo is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {σ : Type.{u2}} [_inst_1 : Zero.{u1} α] [_inst_2 : LinearOrder.{u1} α] [_inst_3 : IsWellOrder.{u1} α (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_2))))))] [_inst_4 : Finite.{succ u2} σ] (S : Set.{max u2 u1} (Finsupp.{u2, u1} σ α _inst_1)), Set.IsPwo.{max u2 u1} (Finsupp.{u2, u1} σ α _inst_1) (Finsupp.preorder.{u2, u1} σ α _inst_1 (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_2))))) S
but is expected to have type
  forall {α : Type.{u2}} {σ : Type.{u1}} [_inst_1 : Zero.{u2} α] [_inst_2 : LinearOrder.{u2} α] [_inst_3 : IsWellOrder.{u2} α (fun (x._@.Mathlib.Data.Finsupp.Pwo._hyg.21 : α) (x._@.Mathlib.Data.Finsupp.Pwo._hyg.23 : α) => LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_2)))))) x._@.Mathlib.Data.Finsupp.Pwo._hyg.21 x._@.Mathlib.Data.Finsupp.Pwo._hyg.23)] [_inst_4 : Finite.{succ u1} σ] (S : Set.{max u2 u1} (Finsupp.{u1, u2} σ α _inst_1)), Set.IsPwo.{max u2 u1} (Finsupp.{u1, u2} σ α _inst_1) (Finsupp.preorder.{u1, u2} σ α _inst_1 (PartialOrder.toPreorder.{u2} α (SemilatticeInf.toPartialOrder.{u2} α (Lattice.toSemilatticeInf.{u2} α (DistribLattice.toLattice.{u2} α (instDistribLattice.{u2} α _inst_2)))))) S
Case conversion may be inaccurate. Consider using '#align finsupp.is_pwo Finsupp.isPwoₓ'. -/
/-- A version of **Dickson's lemma** any subset of functions `σ →₀ α` is partially well
ordered, when `σ` is `finite` and `α` is a linear well order.
This version uses finsupps on a finite type as it is intended for use with `mv_power_series`.
-/
theorem Finsupp.isPwo {α σ : Type _} [Zero α] [LinearOrder α] [IsWellOrder α (· < ·)] [Finite σ]
    (S : Set (σ →₀ α)) : S.IsPwo :=
  Finsupp.equivFunOnFinite.symm_image_image S ▸
    Set.PartiallyWellOrderedOn.image_of_monotone_on (Pi.isPwo _) fun a b ha hb => id
#align finsupp.is_pwo Finsupp.isPwo


import analysis.asymptotics.asymptotics
import order.filter.at_top_bot
import number_theory.prime_counting
import analysis.special_functions.log.base
import unit_fractions.basic_estimates
import topology.basic

noncomputable theory

open_locale nat big_operators classical filter

open asymptotics filter real nat.arithmetic_function

local notation `π` := nat.prime_counting

/-! The definition of π function in Lean is equivalent to the definition in the form of series-/

lemma pi_def (x : ℝ) : (π ⌊x⌋₊ : ℝ) = ∑ n in (finset.range (⌊x⌋₊ + 1)).filter nat.prime, 1:=
begin
  have h₁: prime_summatory (λ _, (1 : ℝ)) 1 x = ∑ n in (finset.range (⌊x⌋₊ + 1)).filter nat.prime, 1:=
    begin
    rw prime_summatory,
    rw finset.range_eq_Ico,
    rw nat.Ico_succ_right,
    congr' 1,
    simp [finset.ext_iff, nat.one_le_iff_ne_zero, nat.prime.ne_zero] {contextual := tt},
    end,
  rw prime_counting_eq_prime_summatory',
  exact h₁,
end

/-! Define the limit tends to infinity under the restriction of larger than a specific number-/

def at_top_within (s : set ℝ) : filter ℝ := at_top ⊓ 𝓟 s

local notation `⊤[>` x `] `:100 := at_top_within (set.Ioi x)

#check ⊤[>1]

/-! # Prime Number Theorem-/

theorem prime_number_theorem : is_O_with 1 ⊤[>1] (λ x, (π ⌊x⌋₊ : ℝ)) (λ x : ℝ, x / log x) := sorry

/-! # Reduction by Chebyshev Bounds-/

/-! from unit_fractions.basic_estimation-/
notation `ϑ` := chebyshev_first

lemma lift_ite {a : ℕ} : (ite (nat.prime a) 1 0 : ℝ) = (λ x : ℕ, (ite (nat.prime x) 1 0 : ℝ)) a := rfl

lemma theta_lower_bound (ε x : ℝ)(hε : 0 < ε ∧ ε ≤ 1 /2)(hx : 1 < x) : (1 - ε) * ((π ⌊x⌋₊ : ℝ) - (π ⌊x ^ (1 - ε)⌋₊ : ℝ)) * log x ≤ ϑ x :=
begin
  unfold chebyshev_first,
  -- have hle : ⌊x⌋₊ + 1 ≤ ⌊x ^ (1 - ε)⌋₊ + 1 := sorry,
  repeat {rw pi_def},
  rw [mul_comm],
  rw ←mul_assoc,
  rw ←le_div_iff',
  have h2 : ∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x⌋₊ + 1)), (1 : ℝ) - ∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x ^ (1 - ε)⌋₊ + 1)), (1 : ℝ) ≤ ∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x⌋₊ + 1)), (1 : ℝ) :=
  begin
    apply sub_le_self _,
    {
      have h : (0 : ℝ) = ∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x ^ (1 - ε)⌋₊ + 1)), 0 := by simp,
      rw h,
      apply finset.sum_le_sum,
      intros x hx,
      simp,
    },
    exact has_add.to_covariant_class_left ℝ,
    exact has_add.to_covariant_class_right ℝ,
  end,
  have h3 : ∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x⌋₊ + 1)), (1 : ℝ) ≤ ((∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x⌋₊ + 1)), real.log n) / (log x * (1 - ε))) :=
    begin
      rw finset.sum_div,
      apply finset.sum_le_sum,
      intros n hn,
      simp at hn,
      rw one_le_div _,
      repeat{sorry}
    end,
  exact le_trans h2 h3,
  have h4 : 0 < log x := log_pos hx,
  apply (zero_lt_mul_left h4).mpr,
  rw lt_sub,
  simp,
  calc
  ε ≤ 1 / 2 : hε.2
  ... < 1 : one_half_lt_one,
end

lemma range_sub_eq_Ioc {f : ℕ → ℝ}(a b : ℕ) (h: a ≤ b) : (∑ (n : ℕ) in finset.filter nat.prime (finset.range (b+1)), f n)
- (∑ (n : ℕ) in finset.filter nat.prime (finset.range (a+1)), f n)
= (∑ (n : ℕ) in finset.filter nat.prime (finset.Ioc a b), f n):=
  begin
    rw finset.range_eq_Ico,
    have h₁: finset.Ico 0 (b + 1) \ finset.Ico 0 (a + 1) = finset.Ioc a b:=
      begin
      rw finset.Ico_diff_Ico_left,
      simp,
      rw ←nat.Ico_succ_succ,
      end,
    rw ← h₁,
    rw sub_eq_iff_eq_add,
    symmetry,
    have h₂ : finset.filter nat.prime (finset.Ico 0 (a + 1)) ⊆ finset.filter nat.prime (finset.Ico 0 (b + 1)) :=
      begin
        have h₂₁: finset.Ico 0 (a + 1)⊆ finset.Ico 0 (b + 1) :=
          begin
            have h₂₁₁: 0 ≤ 0 := by simp,
            have h₂₁₂: a + 1 ≤ b + 1 := add_le_add_right hab 1,
            exact finset.Ico_subset_Ico h₂₁₁ h₂₁₂,
          end,
        exact finset.filter_subset_filter nat.prime h₂₁,
      end,
    rw ←finset.sum_sdiff h₂,
    simp,
    have h₃: finset.filter nat.prime (finset.range (b + 1) \ finset.range (a + 1))= finset.filter nat.prime (finset.range (b + 1)) \ finset.filter nat.prime (finset.range (a + 1)):=sorry,
    rw h₃,
  end

lemma theta_lower_bound_2 (ε x : ℝ)(hε : 0 < ε ∧ ε ≤ 1 /2)(hx : 1 < x) : (1 - ε) * ((π ⌊x⌋₊ : ℝ) - (π ⌊x ^ (1 - ε)⌋₊ : ℝ)) * log x ≤ ϑ x :=
begin
  unfold chebyshev_first,
  repeat {rw pi_def},
  rw [mul_comm],
  rw ←mul_assoc,
  rw ←le_div_iff',
  have x_0 : 0 < x :=
    begin
      calc
      x > 1 : hx
      ... > 0 : zero_lt_one
    end,
  have h1ε: 0 < (1 - ε):=
    begin
      simp,
      calc
        ε ≤ 1 / 2 : hε.2
        ... < 1 : one_half_lt_one,
    end,
  have hε1: 1 - ε < 1 :=
    begin
    simp,
    exact hε.1,
  end,
  have ε_0 : 0 < x ^ (1 - ε) :=
    begin
      exact rpow_pos_of_pos x_0 (1 - ε),
    end,
  have log_rpow: log (x ^ (1 - ε)) = log x * (1 - ε):=
    begin
      rw real.log_rpow x_0 (1 - ε),
      rw mul_comm,
    end,
  have pow1_ε: ⌊x ^ (1 - ε)⌋₊ ≤ ⌊x⌋₊:= begin
    have hx_ε : (x ^ (1 - ε)) < (x^(1:ℝ)) := begin
      rw real.rpow_lt_rpow_left_iff,
      exact hε1,
      exact hx,
    end,
    simp at hx_ε,
    apply nat.floor_mono,
    exact le_of_lt hx_ε,
    end,
  have h₁: 0 < log x * (1 - ε):=
    begin
    have h₁₁: 0 < log x:= log_pos hx,
    exact mul_pos h₁₁ h1ε,
    end,
  have hlog : 0 < log (x ^ (1 - ε)) :=
    begin
      rw log_rpow,
      exact h₁,
    end,
  have h₂ : (((∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x⌋₊ + 1)), real.log n) -
  (∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x ^ (1 - ε)⌋₊ + 1)), real.log n)) / (log x * (1 - ε))) ≤
  ((∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x⌋₊ + 1)), real.log n) / (log x * (1 - ε))) :=
  begin
    rw div_le_div_right,
    apply sub_le_self _,
    {
      have h : (0 : ℝ) = ∑ (n : ℕ) in finset.filter nat.prime (finset.range (⌊x ^ (1 - ε)⌋₊ + 1)), 0 := by simp,
      rw h,
      apply finset.sum_le_sum,
      intros x hx,
      exact log_nat_nonneg x,
    },
    exact has_add.to_covariant_class_left ℝ,
    exact has_add.to_covariant_class_right ℝ,
    exact h₁,
  end,
  have h₃ : ∑ (n : ℕ) in finset.filter nat.prime ((finset.Ioc (⌊x ^ (1 - ε)⌋₊) (⌊x⌋₊))), (1 : ℝ) ≤
  ((∑ (n : ℕ) in finset.filter nat.prime (finset.Ioc (⌊x ^ (1 - ε)⌋₊) (⌊x⌋₊)), real.log n) / (log x * (1 - ε))) :=
    begin
      rw ←log_rpow,
      rw finset.sum_div,
      apply finset.sum_le_sum,
      intros i hi,
      rw one_le_div,
      have h₃₁₀: i ∈ finset.Ioc (⌊x ^ (1 - ε)⌋₊) (⌊x⌋₊) :=
        begin
          apply finset.mem_of_mem_filter i hi,
        end,
      have h₃₁₁ : x ^ (1 - ε) ≤ i :=
        begin
          rw ←nat.Icc_succ_left at h₃₁₀,
          rw nat.succ_eq_add_one at h₃₁₀,
          rw ←nat.floor_add_one at h₃₁₀,
          rw finset.mem_Icc at h₃₁₀,
          have floor_bound : ⌊x ^ (1 - ε) + 1⌋₊ ≤ i := and.elim_left h₃₁₀,
          have floor_le : x ^ (1 - ε) ≤ ⌊x ^ (1 - ε) + 1⌋₊ :=
            begin
              have add_sub : x ^ (1 - ε) = (x ^ (1 - ε) + 1) - 1, {simp},
              have floor_lt : x ^ (1 - ε) < ⌊x ^ (1 - ε) + 1⌋₊ :=
                begin
                  conv
                  begin
                    to_lhs,
                    rw add_sub,
                  end,
                  exact nat.sub_one_lt_floor (x ^ (1 - ε) + 1),
                end,
              exact le_of_lt floor_lt,
            end,
          have coe_le_coe_floor : ⌊x ^ (1 - ε) + 1⌋₊ ≤ i → (⌊x ^ (1 - ε) + 1⌋₊ : ℝ) ≤ (i : ℝ) :=
            begin
              simp,
            end,
          have coe_floor_bound : (⌊x ^ (1 - ε) + 1⌋₊ : ℝ) ≤ (i : ℝ) :=
            begin
              apply coe_le_coe_floor,
              exact floor_bound,
            end,
          exact le_trans floor_le coe_floor_bound,
          have hand : (0 < x ^ (1 - ε)) ∨ (0 = x ^ (1 - ε)) := or.intro_left (0 = x ^ (1 - ε)) ε_0,
          exact le_of_lt_or_eq hand,
        end,
      have h₃₁₂: log (x ^ (1 - ε)) ≤ real.log ↑i :=
        begin
          rw real.log_le_log,
          exact h₃₁₁,
          exact ε_0,
          exact lt_of_lt_of_le ε_0 h₃₁₁,
        end,
      exact h₃₁₂,
      exact hlog,
    end,
  rw ←range_sub_eq_Ioc at h₃,
  rw ←range_sub_eq_Ioc at h₃,
  exact le_trans h₃ h₂,
  exact pow1_ε,
  exact pow1_ε,
  have h₄ : 0 < log x := log_pos hx,
  apply (zero_lt_mul_left h₄).mpr,
  rw lt_sub,
  simp,
  calc
    ε ≤ 1 / 2 : hε.2
    ... < 1 : one_half_lt_one,
end

lemma theta_upper_bound (x : ℝ)(hx : 1 < x) : ϑ x ≤ (π ⌊x⌋₊ : ℝ) * log x :=
begin
  unfold chebyshev_first,
  rw [pi_def, finset.sum_mul],
  apply finset.sum_le_sum,
  intros i ih,
  simp at ih,
  simp,
  rw [nat.lt_succ_iff, nat.le_floor_iff] at ih,
  rw real.log_le_log,
  exact ih.1,
  simp,
  calc
  0 < 2 : by simp
  ... ≤ i : (nat.prime_def_lt.mp ih.2).1,
  exact lt_trans one_pos hx,
  apply le_of_lt,
  exact lt_trans one_pos hx,
end

#check chebyshev_first_trivial_bound

#check is_O_div_log_prime_counting

#check chebyshev_first_lower

#check chebyshev_upper_explicit

lemma chebyshev_lower_bound : ∃ (a : ℝ), ∀ᶠ (x : ℝ) in at_top, ∥x / log x∥ ≤ a * ∥(π ⌊x⌋₊ : ℝ)∥ := is_O.bound is_O_div_log_prime_counting

lemma chebyshev_upper_bound : ∃ (b : ℝ), ∀ᶠ (x : ℝ) in at_top, ∥(π ⌊x⌋₊ : ℝ)∥ ≤ b * ∥x / log x∥ := is_O.bound is_O_prime_counting_div_log

#check real.norm_of_nonneg

lemma chebyshev_lower_bound' (ε : ℝ)(hε : 0 < ε ∧ ε ≤ 1 /2): ∃ (b : ℝ), ∀ᶠ (x : ℝ) in ⊤[>1], (1 - ε) * (π ⌊x⌋₊ : ℝ) ≤ (π ⌊x⌋₊ : ℝ) - 2 * b * x ^ (1 - ε)/ log x :=
begin
  cases chebyshev_lower_bound with a ha,
  cases chebyshev_upper_bound with b hb,
  existsi b,
  sorry
end

lemma chebyshev_upper_bound' (ε : ℝ)(hε : 0 < ε ∧ ε ≤ 1 /2): ∃ (b : ℝ), ∀ᶠ (x : ℝ) in ⊤[>1], (π ⌊x⌋₊ : ℝ) - 2 * b * x ^ (1 - ε)/ log x ≤ (π ⌊x⌋₊ : ℝ) - (π ⌊x ^ (1 - ε)⌋₊ : ℝ) :=
begin
  have chebyshev_upper_bound_1 : ∃ (b : ℝ), ∀ᶠ (x : ℝ) in ⊤[>1], (π ⌊x ^ (1 - ε)⌋₊ : ℝ) ≤ b * x ^ (1 - ε)/ log (x ^ (1 - ε)) := sorry,
  have chebyshev_upper_bound_2 : ∃ (b : ℝ), ∀ᶠ (x : ℝ) in ⊤[>1], (π ⌊x ^ (1 - ε)⌋₊ : ℝ) ≤ 2 * b * x ^ (1 - ε)/ log x := sorry,
  sorry,
end

lemma pi_lower_bound (ε : ℝ)(hε : 0 < ε ∧ ε ≤ 1 /2) : ∀ᶠ (x : ℝ) in ⊤[>1], (1 - ε) * (π ⌊x⌋₊ : ℝ) ≤ (π ⌊x⌋₊ : ℝ) - (π ⌊x ^ (1 - ε)⌋₊ : ℝ) := sorry

lemma theta_lower_bound' (ε : ℝ)(hε : 0 < ε ∧ ε ≤ 1 /2): ∀ᶠ (x : ℝ) in ⊤[>1], (1 - ε) * (π ⌊x⌋₊ : ℝ) * log x ≤ ϑ x := sorry

lemma theta_upper_bound' : ∀ᶠ (x : ℝ) in ⊤[>1], ϑ x ≤ (π ⌊x⌋₊ : ℝ) * log x := sorry

theorem pi_theta : is_O_with 1 ⊤[>1] ϑ id → is_O_with 1 at_top (λ x, (π ⌊x⌋₊ : ℝ)) (λ x : ℝ, x / log x) := sorry


open nat

example : ∃ x : ℕ, x > 0 :=
  ⟨1, zero_lt_succ 0⟩
example (x : ℕ) (h : x > 0) : ∃ y, y < x :=
  ⟨0, h⟩
example (x y z : ℕ) (hxy : x < y) (hyz : y < z) : ∃ w, x < w ∧ w < z :=
  ⟨y, hxy, hyz⟩


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 2 : `true` and `false`

We learn about the `true` and `false` propositions.

## Tactics you will need

To solve the levels on this sheet you will need to know all previous
tactics, plus the following two new ones:

* `trivial`
* `exfalso`

### The `trivial` tactic

If your goal is `⊢ true` then `trivial,` will solve it.

### The `exfalso` tactic

The tactic `exfalso,` turns any goal `⊢ P` into `⊢ false`.
This is mathematically valid because `false` implies any goal.

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : true :=
begin
  sorry
end

example : true → true :=
begin
  sorry
end

example : false → true :=
begin
  sorry
end

example : false → false :=
begin
  sorry
end

example : (true → false) → false :=
begin
  sorry
end

example : false → P :=
begin
  sorry
end

example : true → false → true → false → true → false :=
begin
  sorry
end

example : P → ((P → false) → false) :=
begin
  sorry
end

example : (P → false) → P → Q :=
begin
  sorry
end

example : (true → false) → P :=
begin
  sorry
end