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

! This file was ported from Lean 3 source module geometry.euclidean.angle.unoriented.right_angle
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Arctan
import Mathbin.Geometry.Euclidean.Angle.Unoriented.Affine

/-!
# Right-angled triangles

This file proves basic geometrical results about distances and angles in (possibly degenerate)
right-angled triangles in real inner product spaces and Euclidean affine spaces.

## Implementation notes

Results in this file are generally given in a form with only those non-degeneracy conditions
needed for the particular result, rather than requiring affine independence of the points of a
triangle unnecessarily.

## References

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

-/

noncomputable section

open BigOperators

open EuclideanGeometry

open Real

open RealInnerProductSpace

namespace InnerProductGeometry

variable {V : Type _} [NormedAddCommGroup V] [InnerProductSpace ℝ V]

/-- Pythagorean theorem, if-and-only-if vector angle form. -/
theorem norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
    ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ angle x y = π / 2 :=
  by
  rw [norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero]
  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
#align inner_product_geometry.norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two InnerProductGeometry.norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two

/-- Pythagorean theorem, vector angle form. -/
theorem norm_add_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
    ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ :=
  (norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h
#align inner_product_geometry.norm_add_sq_eq_norm_sq_add_norm_sq' InnerProductGeometry.norm_add_sq_eq_norm_sq_add_norm_sq'

/-- Pythagorean theorem, subtracting vectors, if-and-only-if vector angle form. -/
theorem norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
    ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ angle x y = π / 2 :=
  by
  rw [norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero]
  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
#align inner_product_geometry.norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two InnerProductGeometry.norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two

/-- Pythagorean theorem, subtracting vectors, vector angle form. -/
theorem norm_sub_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
    ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ :=
  (norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h
#align inner_product_geometry.norm_sub_sq_eq_norm_sq_add_norm_sq' InnerProductGeometry.norm_sub_sq_eq_norm_sq_add_norm_sq'

/-- An angle in a right-angled triangle expressed using `arccos`. -/
theorem angle_add_eq_arccos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    angle x (x + y) = Real.arccos (‖x‖ / ‖x + y‖) :=
  by
  rw [angle, inner_add_right, h, add_zero, real_inner_self_eq_norm_mul_norm]
  by_cases hx : ‖x‖ = 0; · simp [hx]
  rw [div_mul_eq_div_div, mul_self_div_self]
#align inner_product_geometry.angle_add_eq_arccos_of_inner_eq_zero InnerProductGeometry.angle_add_eq_arccos_of_inner_eq_zero

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
theorem angle_add_eq_arcsin_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
    angle x (x + y) = Real.arcsin (‖y‖ / ‖x + y‖) :=
  by
  have hxy : ‖x + y‖ ^ 2 ≠ 0 :=
    by
    rw [pow_two, norm_add_sq_eq_norm_sq_add_norm_sq_real h, ne_comm]
    refine' ne_of_lt _
    rcases h0 with (h0 | h0)
    ·
      exact
        Left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 h0)) (mul_self_nonneg _)
    ·
      exact
        Left.add_pos_of_nonneg_of_pos (mul_self_nonneg _) (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
  rw [angle_add_eq_arccos_of_inner_eq_zero h,
    Real.arccos_eq_arcsin (div_nonneg (norm_nonneg _) (norm_nonneg _)), div_pow, one_sub_div hxy]
  nth_rw 1 [pow_two]
  rw [norm_add_sq_eq_norm_sq_add_norm_sq_real h, pow_two, add_sub_cancel', ← pow_two, ← div_pow,
    Real.sqrt_sq (div_nonneg (norm_nonneg _) (norm_nonneg _))]
#align inner_product_geometry.angle_add_eq_arcsin_of_inner_eq_zero InnerProductGeometry.angle_add_eq_arcsin_of_inner_eq_zero

/-- An angle in a right-angled triangle expressed using `arctan`. -/
theorem angle_add_eq_arctan_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
    angle x (x + y) = Real.arctan (‖y‖ / ‖x‖) :=
  by
  rw [angle_add_eq_arcsin_of_inner_eq_zero h (Or.inl h0), Real.arctan_eq_arcsin, ←
    div_mul_eq_div_div, norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h]
  nth_rw 3 [← Real.sqrt_sq (norm_nonneg x)]
  rw [← Real.sqrt_mul (sq_nonneg _), div_pow, pow_two, pow_two, mul_add, mul_one, mul_div,
    mul_comm (‖x‖ * ‖x‖), ← mul_div, div_self (mul_self_pos.2 (norm_ne_zero_iff.2 h0)).ne', mul_one]
#align inner_product_geometry.angle_add_eq_arctan_of_inner_eq_zero InnerProductGeometry.angle_add_eq_arctan_of_inner_eq_zero

/-- An angle in a non-degenerate right-angled triangle is positive. -/
theorem angle_add_pos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
    0 < angle x (x + y) :=
  by
  rw [angle_add_eq_arccos_of_inner_eq_zero h, Real.arccos_pos,
    norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h]
  by_cases hx : x = 0; · simp [hx]
  rw [div_lt_one
      (Real.sqrt_pos.2
        (Left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 hx))
          (mul_self_nonneg _))),
    Real.lt_sqrt (norm_nonneg _), pow_two]
  simpa [hx] using h0
#align inner_product_geometry.angle_add_pos_of_inner_eq_zero InnerProductGeometry.angle_add_pos_of_inner_eq_zero

/-- An angle in a right-angled triangle is at most `π / 2`. -/
theorem angle_add_le_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    angle x (x + y) ≤ π / 2 :=
  by
  rw [angle_add_eq_arccos_of_inner_eq_zero h, Real.arccos_le_pi_div_two]
  exact div_nonneg (norm_nonneg _) (norm_nonneg _)
#align inner_product_geometry.angle_add_le_pi_div_two_of_inner_eq_zero InnerProductGeometry.angle_add_le_pi_div_two_of_inner_eq_zero

/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`. -/
theorem angle_add_lt_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
    angle x (x + y) < π / 2 :=
  by
  rw [angle_add_eq_arccos_of_inner_eq_zero h, Real.arccos_lt_pi_div_two,
    norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h]
  exact
    div_pos (norm_pos_iff.2 h0)
      (Real.sqrt_pos.2
        (Left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
          (mul_self_nonneg _)))
#align inner_product_geometry.angle_add_lt_pi_div_two_of_inner_eq_zero InnerProductGeometry.angle_add_lt_pi_div_two_of_inner_eq_zero

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
theorem cos_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.cos (angle x (x + y)) = ‖x‖ / ‖x + y‖ :=
  by
  rw [angle_add_eq_arccos_of_inner_eq_zero h,
    Real.cos_arccos (le_trans (by norm_num) (div_nonneg (norm_nonneg _) (norm_nonneg _)))
      (div_le_one_of_le _ (norm_nonneg _))]
  rw [mul_self_le_mul_self_iff (norm_nonneg _) (norm_nonneg _),
    norm_add_sq_eq_norm_sq_add_norm_sq_real h]
  exact le_add_of_nonneg_right (mul_self_nonneg _)
#align inner_product_geometry.cos_angle_add_of_inner_eq_zero InnerProductGeometry.cos_angle_add_of_inner_eq_zero

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
theorem sin_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
    Real.sin (angle x (x + y)) = ‖y‖ / ‖x + y‖ :=
  by
  rw [angle_add_eq_arcsin_of_inner_eq_zero h h0,
    Real.sin_arcsin (le_trans (by norm_num) (div_nonneg (norm_nonneg _) (norm_nonneg _)))
      (div_le_one_of_le _ (norm_nonneg _))]
  rw [mul_self_le_mul_self_iff (norm_nonneg _) (norm_nonneg _),
    norm_add_sq_eq_norm_sq_add_norm_sq_real h]
  exact le_add_of_nonneg_left (mul_self_nonneg _)
#align inner_product_geometry.sin_angle_add_of_inner_eq_zero InnerProductGeometry.sin_angle_add_of_inner_eq_zero

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
theorem tan_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.tan (angle x (x + y)) = ‖y‖ / ‖x‖ :=
  by
  by_cases h0 : x = 0; · simp [h0]
  rw [angle_add_eq_arctan_of_inner_eq_zero h h0, Real.tan_arctan]
#align inner_product_geometry.tan_angle_add_of_inner_eq_zero InnerProductGeometry.tan_angle_add_of_inner_eq_zero

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
theorem cos_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.cos (angle x (x + y)) * ‖x + y‖ = ‖x‖ :=
  by
  rw [cos_angle_add_of_inner_eq_zero h]
  by_cases hxy : ‖x + y‖ = 0
  · have h' := norm_add_sq_eq_norm_sq_add_norm_sq_real h
    rw [hxy, MulZeroClass.zero_mul, eq_comm,
      add_eq_zero_iff' (mul_self_nonneg ‖x‖) (mul_self_nonneg ‖y‖), mul_self_eq_zero] at h'
    simp [h'.1]
  · exact div_mul_cancel _ hxy
#align inner_product_geometry.cos_angle_add_mul_norm_of_inner_eq_zero InnerProductGeometry.cos_angle_add_mul_norm_of_inner_eq_zero

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
theorem sin_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.sin (angle x (x + y)) * ‖x + y‖ = ‖y‖ :=
  by
  by_cases h0 : x = 0 ∧ y = 0; · simp [h0]
  rw [not_and_or] at h0
  rw [sin_angle_add_of_inner_eq_zero h h0, div_mul_cancel]
  rw [← mul_self_ne_zero, norm_add_sq_eq_norm_sq_add_norm_sq_real h]
  refine' (ne_of_lt _).symm
  rcases h0 with (h0 | h0)
  · exact Left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 h0)) (mul_self_nonneg _)
  · exact Left.add_pos_of_nonneg_of_pos (mul_self_nonneg _) (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
#align inner_product_geometry.sin_angle_add_mul_norm_of_inner_eq_zero InnerProductGeometry.sin_angle_add_mul_norm_of_inner_eq_zero

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
theorem tan_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
    Real.tan (angle x (x + y)) * ‖x‖ = ‖y‖ :=
  by
  rw [tan_angle_add_of_inner_eq_zero h]
  rcases h0 with (h0 | h0) <;> simp [h0]
#align inner_product_geometry.tan_angle_add_mul_norm_of_inner_eq_zero InnerProductGeometry.tan_angle_add_mul_norm_of_inner_eq_zero

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
theorem norm_div_cos_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
    ‖x‖ / Real.cos (angle x (x + y)) = ‖x + y‖ :=
  by
  rw [cos_angle_add_of_inner_eq_zero h]
  rcases h0 with (h0 | h0)
  · rw [div_div_eq_mul_div, mul_comm, div_eq_mul_inv, mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)]
  · simp [h0]
#align inner_product_geometry.norm_div_cos_angle_add_of_inner_eq_zero InnerProductGeometry.norm_div_cos_angle_add_of_inner_eq_zero

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
theorem norm_div_sin_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
    ‖y‖ / Real.sin (angle x (x + y)) = ‖x + y‖ :=
  by
  rcases h0 with (h0 | h0); · simp [h0]
  rw [sin_angle_add_of_inner_eq_zero h (Or.inr h0), div_div_eq_mul_div, mul_comm, div_eq_mul_inv,
    mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)]
#align inner_product_geometry.norm_div_sin_angle_add_of_inner_eq_zero InnerProductGeometry.norm_div_sin_angle_add_of_inner_eq_zero

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/
theorem norm_div_tan_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
    ‖y‖ / Real.tan (angle x (x + y)) = ‖x‖ :=
  by
  rw [tan_angle_add_of_inner_eq_zero h]
  rcases h0 with (h0 | h0)
  · simp [h0]
  · rw [div_div_eq_mul_div, mul_comm, div_eq_mul_inv, mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)]
#align inner_product_geometry.norm_div_tan_angle_add_of_inner_eq_zero InnerProductGeometry.norm_div_tan_angle_add_of_inner_eq_zero

/-- An angle in a right-angled triangle expressed using `arccos`, version subtracting vectors. -/
theorem angle_sub_eq_arccos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    angle x (x - y) = Real.arccos (‖x‖ / ‖x - y‖) :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg, angle_add_eq_arccos_of_inner_eq_zero h]
#align inner_product_geometry.angle_sub_eq_arccos_of_inner_eq_zero InnerProductGeometry.angle_sub_eq_arccos_of_inner_eq_zero

/-- An angle in a right-angled triangle expressed using `arcsin`, version subtracting vectors. -/
theorem angle_sub_eq_arcsin_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
    angle x (x - y) = Real.arcsin (‖y‖ / ‖x - y‖) :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  nth_rw 2 [← neg_ne_zero] at h0
  rw [sub_eq_add_neg, angle_add_eq_arcsin_of_inner_eq_zero h h0, norm_neg]
#align inner_product_geometry.angle_sub_eq_arcsin_of_inner_eq_zero InnerProductGeometry.angle_sub_eq_arcsin_of_inner_eq_zero

/-- An angle in a right-angled triangle expressed using `arctan`, version subtracting vectors. -/
theorem angle_sub_eq_arctan_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
    angle x (x - y) = Real.arctan (‖y‖ / ‖x‖) :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg, angle_add_eq_arctan_of_inner_eq_zero h h0, norm_neg]
#align inner_product_geometry.angle_sub_eq_arctan_of_inner_eq_zero InnerProductGeometry.angle_sub_eq_arctan_of_inner_eq_zero

/-- An angle in a non-degenerate right-angled triangle is positive, version subtracting
vectors. -/
theorem angle_sub_pos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
    0 < angle x (x - y) := by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [← neg_ne_zero] at h0
  rw [sub_eq_add_neg]
  exact angle_add_pos_of_inner_eq_zero h h0
#align inner_product_geometry.angle_sub_pos_of_inner_eq_zero InnerProductGeometry.angle_sub_pos_of_inner_eq_zero

/-- An angle in a right-angled triangle is at most `π / 2`, version subtracting vectors. -/
theorem angle_sub_le_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    angle x (x - y) ≤ π / 2 :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg]
  exact angle_add_le_pi_div_two_of_inner_eq_zero h
#align inner_product_geometry.angle_sub_le_pi_div_two_of_inner_eq_zero InnerProductGeometry.angle_sub_le_pi_div_two_of_inner_eq_zero

/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`, version subtracting
vectors. -/
theorem angle_sub_lt_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
    angle x (x - y) < π / 2 :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg]
  exact angle_add_lt_pi_div_two_of_inner_eq_zero h h0
#align inner_product_geometry.angle_sub_lt_pi_div_two_of_inner_eq_zero InnerProductGeometry.angle_sub_lt_pi_div_two_of_inner_eq_zero

/-- The cosine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
theorem cos_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.cos (angle x (x - y)) = ‖x‖ / ‖x - y‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg, cos_angle_add_of_inner_eq_zero h]
#align inner_product_geometry.cos_angle_sub_of_inner_eq_zero InnerProductGeometry.cos_angle_sub_of_inner_eq_zero

/-- The sine of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
theorem sin_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
    Real.sin (angle x (x - y)) = ‖y‖ / ‖x - y‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  nth_rw 2 [← neg_ne_zero] at h0
  rw [sub_eq_add_neg, sin_angle_add_of_inner_eq_zero h h0, norm_neg]
#align inner_product_geometry.sin_angle_sub_of_inner_eq_zero InnerProductGeometry.sin_angle_sub_of_inner_eq_zero

/-- The tangent of an angle in a right-angled triangle as a ratio of sides, version subtracting
vectors. -/
theorem tan_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.tan (angle x (x - y)) = ‖y‖ / ‖x‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg, tan_angle_add_of_inner_eq_zero h, norm_neg]
#align inner_product_geometry.tan_angle_sub_of_inner_eq_zero InnerProductGeometry.tan_angle_sub_of_inner_eq_zero

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side, version subtracting vectors. -/
theorem cos_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.cos (angle x (x - y)) * ‖x - y‖ = ‖x‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg, cos_angle_add_mul_norm_of_inner_eq_zero h]
#align inner_product_geometry.cos_angle_sub_mul_norm_of_inner_eq_zero InnerProductGeometry.cos_angle_sub_mul_norm_of_inner_eq_zero

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side, version subtracting vectors. -/
theorem sin_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
    Real.sin (angle x (x - y)) * ‖x - y‖ = ‖y‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [sub_eq_add_neg, sin_angle_add_mul_norm_of_inner_eq_zero h, norm_neg]
#align inner_product_geometry.sin_angle_sub_mul_norm_of_inner_eq_zero InnerProductGeometry.sin_angle_sub_mul_norm_of_inner_eq_zero

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side, version subtracting vectors. -/
theorem tan_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
    Real.tan (angle x (x - y)) * ‖x‖ = ‖y‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [← neg_eq_zero] at h0
  rw [sub_eq_add_neg, tan_angle_add_mul_norm_of_inner_eq_zero h h0, norm_neg]
#align inner_product_geometry.tan_angle_sub_mul_norm_of_inner_eq_zero InnerProductGeometry.tan_angle_sub_mul_norm_of_inner_eq_zero

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse, version subtracting vectors. -/
theorem norm_div_cos_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
    ‖x‖ / Real.cos (angle x (x - y)) = ‖x - y‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [← neg_eq_zero] at h0
  rw [sub_eq_add_neg, norm_div_cos_angle_add_of_inner_eq_zero h h0]
#align inner_product_geometry.norm_div_cos_angle_sub_of_inner_eq_zero InnerProductGeometry.norm_div_cos_angle_sub_of_inner_eq_zero

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse, version subtracting vectors. -/
theorem norm_div_sin_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
    ‖y‖ / Real.sin (angle x (x - y)) = ‖x - y‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [← neg_ne_zero] at h0
  rw [sub_eq_add_neg, ← norm_neg, norm_div_sin_angle_add_of_inner_eq_zero h h0]
#align inner_product_geometry.norm_div_sin_angle_sub_of_inner_eq_zero InnerProductGeometry.norm_div_sin_angle_sub_of_inner_eq_zero

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side, version subtracting vectors. -/
theorem norm_div_tan_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
    ‖y‖ / Real.tan (angle x (x - y)) = ‖x‖ :=
  by
  rw [← neg_eq_zero, ← inner_neg_right] at h
  rw [← neg_ne_zero] at h0
  rw [sub_eq_add_neg, ← norm_neg, norm_div_tan_angle_add_of_inner_eq_zero h h0]
#align inner_product_geometry.norm_div_tan_angle_sub_of_inner_eq_zero InnerProductGeometry.norm_div_tan_angle_sub_of_inner_eq_zero

end InnerProductGeometry

namespace EuclideanGeometry

open InnerProductGeometry

variable {V : Type _} {P : Type _} [NormedAddCommGroup V] [InnerProductSpace ℝ V] [MetricSpace P]
  [NormedAddTorsor V P]

include V

/-- **Pythagorean theorem**, if-and-only-if angle-at-point form. -/
theorem dist_sq_eq_dist_sq_add_dist_sq_iff_angle_eq_pi_div_two (p1 p2 p3 : P) :
    dist p1 p3 * dist p1 p3 = dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 ↔
      ∠ p1 p2 p3 = π / 2 :=
  by
  erw [dist_comm p3 p2, dist_eq_norm_vsub V p1 p3, dist_eq_norm_vsub V p1 p2,
    dist_eq_norm_vsub V p2 p3, ← norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two,
    vsub_sub_vsub_cancel_right p1, ← neg_vsub_eq_vsub_rev p2 p3, norm_neg]
#align euclidean_geometry.dist_sq_eq_dist_sq_add_dist_sq_iff_angle_eq_pi_div_two EuclideanGeometry.dist_sq_eq_dist_sq_add_dist_sq_iff_angle_eq_pi_div_two

/-- An angle in a right-angled triangle expressed using `arccos`. -/
theorem angle_eq_arccos_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
    ∠ p₂ p₃ p₁ = Real.arccos (dist p₃ p₂ / dist p₁ p₃) :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, angle_add_eq_arccos_of_inner_eq_zero h]
#align euclidean_geometry.angle_eq_arccos_of_angle_eq_pi_div_two EuclideanGeometry.angle_eq_arccos_of_angle_eq_pi_div_two

/-- An angle in a right-angled triangle expressed using `arcsin`. -/
theorem angle_eq_arcsin_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₁ ≠ p₂ ∨ p₃ ≠ p₂) : ∠ p₂ p₃ p₁ = Real.arcsin (dist p₁ p₂ / dist p₁ p₃) :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [← @vsub_ne_zero V, @ne_comm _ p₃, ← @vsub_ne_zero V _ _ _ p₂, or_comm'] at h0
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, angle_add_eq_arcsin_of_inner_eq_zero h h0]
#align euclidean_geometry.angle_eq_arcsin_of_angle_eq_pi_div_two EuclideanGeometry.angle_eq_arcsin_of_angle_eq_pi_div_two

/-- An angle in a right-angled triangle expressed using `arctan`. -/
theorem angle_eq_arctan_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₃ ≠ p₂) : ∠ p₂ p₃ p₁ = Real.arctan (dist p₁ p₂ / dist p₃ p₂) :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [ne_comm, ← @vsub_ne_zero V] at h0
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, angle_add_eq_arctan_of_inner_eq_zero h h0]
#align euclidean_geometry.angle_eq_arctan_of_angle_eq_pi_div_two EuclideanGeometry.angle_eq_arctan_of_angle_eq_pi_div_two

/-- An angle in a non-degenerate right-angled triangle is positive. -/
theorem angle_pos_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : 0 < ∠ p₂ p₃ p₁ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [← @vsub_ne_zero V, eq_comm, ← @vsub_eq_zero_iff_eq V, or_comm'] at h0
  rw [angle, ← vsub_add_vsub_cancel p₁ p₂ p₃, add_comm]
  exact angle_add_pos_of_inner_eq_zero h h0
#align euclidean_geometry.angle_pos_of_angle_eq_pi_div_two EuclideanGeometry.angle_pos_of_angle_eq_pi_div_two

/-- An angle in a right-angled triangle is at most `π / 2`. -/
theorem angle_le_pi_div_two_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
    ∠ p₂ p₃ p₁ ≤ π / 2 :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [angle, ← vsub_add_vsub_cancel p₁ p₂ p₃, add_comm]
  exact angle_add_le_pi_div_two_of_inner_eq_zero h
#align euclidean_geometry.angle_le_pi_div_two_of_angle_eq_pi_div_two EuclideanGeometry.angle_le_pi_div_two_of_angle_eq_pi_div_two

/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`. -/
theorem angle_lt_pi_div_two_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₃ ≠ p₂) : ∠ p₂ p₃ p₁ < π / 2 :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [ne_comm, ← @vsub_ne_zero V] at h0
  rw [angle, ← vsub_add_vsub_cancel p₁ p₂ p₃, add_comm]
  exact angle_add_lt_pi_div_two_of_inner_eq_zero h h0
#align euclidean_geometry.angle_lt_pi_div_two_of_angle_eq_pi_div_two EuclideanGeometry.angle_lt_pi_div_two_of_angle_eq_pi_div_two

/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
theorem cos_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
    Real.cos (∠ p₂ p₃ p₁) = dist p₃ p₂ / dist p₁ p₃ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, cos_angle_add_of_inner_eq_zero h]
#align euclidean_geometry.cos_angle_of_angle_eq_pi_div_two EuclideanGeometry.cos_angle_of_angle_eq_pi_div_two

/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
theorem sin_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₁ ≠ p₂ ∨ p₃ ≠ p₂) : Real.sin (∠ p₂ p₃ p₁) = dist p₁ p₂ / dist p₁ p₃ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [← @vsub_ne_zero V, @ne_comm _ p₃, ← @vsub_ne_zero V _ _ _ p₂, or_comm'] at h0
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, sin_angle_add_of_inner_eq_zero h h0]
#align euclidean_geometry.sin_angle_of_angle_eq_pi_div_two EuclideanGeometry.sin_angle_of_angle_eq_pi_div_two

/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
theorem tan_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
    Real.tan (∠ p₂ p₃ p₁) = dist p₁ p₂ / dist p₃ p₂ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, tan_angle_add_of_inner_eq_zero h]
#align euclidean_geometry.tan_angle_of_angle_eq_pi_div_two EuclideanGeometry.tan_angle_of_angle_eq_pi_div_two

/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
adjacent side. -/
theorem cos_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
    Real.cos (∠ p₂ p₃ p₁) * dist p₁ p₃ = dist p₃ p₂ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, cos_angle_add_mul_norm_of_inner_eq_zero h]
#align euclidean_geometry.cos_angle_mul_dist_of_angle_eq_pi_div_two EuclideanGeometry.cos_angle_mul_dist_of_angle_eq_pi_div_two

/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
opposite side. -/
theorem sin_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
    Real.sin (∠ p₂ p₃ p₁) * dist p₁ p₃ = dist p₁ p₂ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, sin_angle_add_mul_norm_of_inner_eq_zero h]
#align euclidean_geometry.sin_angle_mul_dist_of_angle_eq_pi_div_two EuclideanGeometry.sin_angle_mul_dist_of_angle_eq_pi_div_two

/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
the opposite side. -/
theorem tan_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₁ = p₂ ∨ p₃ ≠ p₂) : Real.tan (∠ p₂ p₃ p₁) * dist p₃ p₂ = dist p₁ p₂ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [ne_comm, ← @vsub_ne_zero V, ← @vsub_eq_zero_iff_eq V, or_comm'] at h0
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, tan_angle_add_mul_norm_of_inner_eq_zero h h0]
#align euclidean_geometry.tan_angle_mul_dist_of_angle_eq_pi_div_two EuclideanGeometry.tan_angle_mul_dist_of_angle_eq_pi_div_two

/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
hypotenuse. -/
theorem dist_div_cos_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₁ = p₂ ∨ p₃ ≠ p₂) : dist p₃ p₂ / Real.cos (∠ p₂ p₃ p₁) = dist p₁ p₃ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [ne_comm, ← @vsub_ne_zero V, ← @vsub_eq_zero_iff_eq V, or_comm'] at h0
  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, norm_div_cos_angle_add_of_inner_eq_zero h h0]
#align euclidean_geometry.dist_div_cos_angle_of_angle_eq_pi_div_two EuclideanGeometry.dist_div_cos_angle_of_angle_eq_pi_div_two

/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
hypotenuse. -/
theorem dist_div_sin_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : dist p₁ p₂ / Real.sin (∠ p₂ p₃ p₁) = dist p₁ p₃ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [eq_comm, ← @vsub_ne_zero V, ← @vsub_eq_zero_iff_eq V, or_comm'] at h0
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, norm_div_sin_angle_add_of_inner_eq_zero h h0]
#align euclidean_geometry.dist_div_sin_angle_of_angle_eq_pi_div_two EuclideanGeometry.dist_div_sin_angle_of_angle_eq_pi_div_two

/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
adjacent side. -/
theorem dist_div_tan_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
    (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : dist p₁ p₂ / Real.tan (∠ p₂ p₃ p₁) = dist p₃ p₂ :=
  by
  rw [angle, ← inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ← neg_eq_zero, ←
    inner_neg_left, neg_vsub_eq_vsub_rev] at h
  rw [eq_comm, ← @vsub_ne_zero V, ← @vsub_eq_zero_iff_eq V, or_comm'] at h0
  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂, ← vsub_add_vsub_cancel p₁ p₂ p₃,
    add_comm, norm_div_tan_angle_add_of_inner_eq_zero h h0]
#align euclidean_geometry.dist_div_tan_angle_of_angle_eq_pi_div_two EuclideanGeometry.dist_div_tan_angle_of_angle_eq_pi_div_two

end EuclideanGeometry


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

import tactic.apply
import control.fix
import order.omega_complete_partial_order

/-!
# Lawful fixed point operators

This module defines the laws required of a `has_fix` instance, using the theory of
omega complete partial orders (ωCPO). Proofs of the lawfulness of all `has_fix` instances in
`control.fix` are provided.

## Main definition

 * class `lawful_fix`
-/

universes u v

open_locale classical
variables {α : Type*} {β : α → Type*}

open omega_complete_partial_order

/-- Intuitively, a fixed point operator `fix` is lawful if it satisfies `fix f = f (fix f)` for all
`f`, but this is inconsistent / uninteresting in most cases due to the existence of "exotic"
functions `f`, such as the function that is defined iff its argument is not, familiar from the
halting problem. Instead, this requirement is limited to only functions that are `continuous` in the
sense of `ω`-complete partial orders, which excludes the example because it is not monotone
(making the input argument less defined can make `f` more defined). -/
class lawful_fix (α : Type*) [omega_complete_partial_order α] extends has_fix α :=
(fix_eq : ∀ {f : α →ₘ α}, continuous f → has_fix.fix f = f (has_fix.fix f))

lemma lawful_fix.fix_eq' {α} [omega_complete_partial_order α] [lawful_fix α]
  {f : α → α} (hf : continuous' f) :
  has_fix.fix f = f (has_fix.fix f) :=
lawful_fix.fix_eq (continuous.to_bundled _ hf)

namespace roption

open roption nat nat.upto

namespace fix

variables (f : (Π a, roption $ β a) →ₘ (Π a, roption $ β a))

lemma approx_mono' {i : ℕ} : fix.approx f i ≤ fix.approx f (succ i) :=
begin
  induction i, dsimp [approx], apply @bot_le _ _ (f ⊥),
  intro, apply f.monotone, apply i_ih
end

lemma approx_mono ⦃i j : ℕ⦄ (hij : i ≤ j) : approx f i ≤ approx f j :=
begin
  induction j, cases hij, refine @le_refl _ _ _,
  cases hij, apply @le_refl _ _ _,
  apply @le_trans _ _ _ (approx f j_n) _ (j_ih ‹_›),
  apply approx_mono' f
end

lemma mem_iff (a : α) (b : β a) : b ∈ roption.fix f a ↔ ∃ i, b ∈ approx f i a :=
begin
  by_cases h₀ : ∃ (i : ℕ), (approx f i a).dom,
  { simp only [roption.fix_def f h₀],
    split; intro hh, exact ⟨_,hh⟩,
    have h₁ := nat.find_spec h₀,
    rw [dom_iff_mem] at h₁,
    cases h₁ with y h₁,
    replace h₁ := approx_mono' f _ _ h₁,
    suffices : y = b, subst this, exact h₁,
    cases hh with i hh,
    revert h₁, generalize : (succ (nat.find h₀)) = j, intro,
    wlog : i ≤ j := le_total i j using [i j b y,j i y b],
    replace hh := approx_mono f case _ _ hh,
    apply roption.mem_unique h₁ hh },
  { simp only [fix_def' ⇑f h₀, not_exists, false_iff, not_mem_none],
    simp only [dom_iff_mem, not_exists] at h₀,
    intro, apply h₀ }
end

lemma approx_le_fix (i : ℕ) : approx f i ≤ roption.fix f :=
assume a b hh,
by { rw [mem_iff f], exact ⟨_,hh⟩ }

lemma exists_fix_le_approx (x : α) : ∃ i, roption.fix f x ≤ approx f i x :=
begin
  by_cases hh : ∃ i b, b ∈ approx f i x,
  { rcases hh with ⟨i,b,hb⟩, existsi i,
    intros b' h',
    have hb' := approx_le_fix f i _ _ hb,
    have hh := roption.mem_unique h' hb',
    subst hh, exact hb },
  { simp only [not_exists] at hh, existsi 0,
    intros b' h',
    simp only [mem_iff f] at h',
    cases h' with i h',
    cases hh _ _ h' }
end

include f

/-- The series of approximations of `fix f` (see `approx`) as a `chain` -/
def approx_chain : chain (Π a, roption $ β a) := ⟨approx f, approx_mono f⟩

lemma le_f_of_mem_approx {x} (hx : x ∈ approx_chain f) : x ≤ f x :=
begin
  revert hx, simp [(∈)],
  intros i hx, subst x,
  apply approx_mono'
end

lemma approx_mem_approx_chain {i} : approx f i ∈ approx_chain f :=
stream.mem_of_nth_eq rfl

end fix

open fix

variables {α}
variables (f : (Π a, roption $ β a) →ₘ (Π a, roption $ β a))

open omega_complete_partial_order

open roption (hiding ωSup) nat
open nat.upto omega_complete_partial_order

lemma fix_eq_ωSup : roption.fix f = ωSup (approx_chain f) :=
begin
  apply le_antisymm,
  { intro x, cases exists_fix_le_approx f x with i hx,
    transitivity' approx f i.succ x,
    { transitivity', apply hx, apply approx_mono' f },
    apply' le_ωSup_of_le i.succ,
    dsimp [approx], refl', },
  { apply ωSup_le _ _ _,
    simp only [fix.approx_chain, preorder_hom.coe_fun_mk],
    intros y x, apply approx_le_fix f },
end

lemma fix_le {X : Π a, roption $ β a} (hX : f X ≤ X) : roption.fix f ≤ X :=
begin
  rw fix_eq_ωSup f,
  apply ωSup_le _ _ _,
  simp only [fix.approx_chain, preorder_hom.coe_fun_mk],
  intros i,
  induction i, dsimp [fix.approx], apply' bot_le,
  transitivity' f X, apply f.monotone i_ih,
  apply hX
end

variables {f} (hc : continuous f)
include hc

lemma fix_eq : roption.fix f = f (roption.fix f) :=
begin
  rw [fix_eq_ωSup f,hc],
  apply le_antisymm,
  { apply ωSup_le_ωSup_of_le _,
    intros i, existsi [i], intro x, -- intros x y hx,
    apply le_f_of_mem_approx _ ⟨i, rfl⟩, },
  { apply ωSup_le_ωSup_of_le _,
    intros i, existsi i.succ, refl', }
end

end roption

namespace roption

/-- `to_unit` as a monotone function -/
@[simps]
def to_unit_mono (f : roption α →ₘ roption α) : (unit → roption α) →ₘ (unit → roption α) :=
{ to_fun := λ x u, f (x u),
  monotone' := λ x y (h : x ≤ y) u, f.monotone $ h u }

lemma to_unit_cont (f : roption α →ₘ roption α) (hc : continuous f) : continuous (to_unit_mono f)
| c := begin
  ext ⟨⟩ : 1,
  dsimp [omega_complete_partial_order.ωSup],
  erw [hc, chain.map_comp], refl
end

noncomputable instance : lawful_fix (roption α) :=
⟨λ f hc, show roption.fix (to_unit_mono f) () = _, by rw roption.fix_eq (to_unit_cont f hc); refl⟩

end roption

open sigma

namespace pi

noncomputable instance {β} : lawful_fix (α → roption β) := ⟨λ f, roption.fix_eq⟩

variables {γ : Π a : α, β a → Type*}

section monotone

variables (α β γ)

/-- `sigma.curry` as a monotone function. -/
@[simps]
def monotone_curry [∀ x y, preorder $ γ x y] :
  (Π x : Σ a, β a, γ x.1 x.2) →ₘ (Π a (b : β a), γ a b) :=
{ to_fun := curry,
  monotone' := λ x y h a b, h ⟨a,b⟩ }

/-- `sigma.uncurry` as a monotone function. -/
@[simps]
def monotone_uncurry [∀ x y, preorder $ γ x y] :
  (Π a (b : β a), γ a b) →ₘ (Π x : Σ a, β a, γ x.1 x.2) :=
{ to_fun := uncurry,
  monotone' := λ x y h a, h a.1 a.2 }

variables [∀ x y, omega_complete_partial_order $ γ x y]

open omega_complete_partial_order.chain

lemma continuous_curry : continuous $ monotone_curry α β γ :=
λ c, by { ext x y, dsimp [curry,ωSup], rw [map_comp,map_comp], refl }

lemma continuous_uncurry : continuous $ monotone_uncurry α β γ :=
λ c, by { ext x y, dsimp [uncurry,ωSup], rw [map_comp,map_comp], refl }

end monotone

open has_fix

instance [has_fix $ Π x : sigma β, γ x.1 x.2] : has_fix (Π x (y : β x), γ x y) :=
⟨ λ f, curry (fix $ uncurry ∘ f ∘ curry) ⟩

variables [∀ x y, omega_complete_partial_order $ γ x y]

section curry

variables {f : (Π x (y : β x), γ x y) →ₘ (Π x (y : β x), γ x y)}
variables (hc : continuous f)

lemma uncurry_curry_continuous :
  continuous $ (monotone_uncurry α β γ).comp $ f.comp $ monotone_curry α β γ :=
continuous_comp _ _
  (continuous_comp _ _ (continuous_curry _ _ _) hc)
  (continuous_uncurry _ _ _)

end curry

instance pi.lawful_fix' [lawful_fix $ Π x : sigma β, γ x.1 x.2] : lawful_fix (Π x y, γ x y) :=
{ fix_eq := λ f hc,
    begin
      dsimp [fix],
      conv { to_lhs, erw [lawful_fix.fix_eq (uncurry_curry_continuous hc)] },
      refl,
    end, }

end pi


import data.nat.gcd
import data.nat.modeq
import data.nat.prime
import tactic.norm_num
import data.nat.gcd

--import data.set
open classical

namespace int
/-
  Mathlib work in progress
-/

theorem gcd_mul_left_mine (i j k : ℤ) : gcd (i * j) (i * k) = nat_abs i * gcd j k :=
begin
  unfold gcd,
  rw [nat_abs_mul, nat_abs_mul],
  exact nat.gcd_mul_left (nat_abs i) (nat_abs j) (nat_abs k),
end

end int

namespace nat

-- Show that for a, b, d integers, we have (da, db) = d(a,b).
theorem q1a (a b d : ℤ) : int.gcd (d*a) (d*b) = int.nat_abs d * int.gcd a b := int.gcd_mul_left_mine d a b

-- Let a, b, n integers, and suppose that n|ab. Show that n/(a,b) divides b.
theorem q1b (a b n : ℕ) (ha : a > 0) (hn : n > 0) : n ∣ (a*b) → (n / gcd a n) ∣ b := λ h,
have n / gcd n a ∣ b * (a / gcd n a) := dvd_of_mul_dvd_mul_right (gcd_pos_of_pos_left a hn)
begin
  rw ← nat.mul_div_assoc _ (gcd_dvd_right n a),
  rw nat.div_mul_cancel (gcd_dvd_left n a),
  rw mul_comm b,
  rwa nat.div_mul_cancel (dvd_trans (gcd_dvd_left n a) h),
end,
begin
  cases exists_eq_mul_left_of_dvd h with c hc,
  have := coprime.dvd_of_dvd_mul_right
    (coprime_div_gcd_div_gcd (gcd_pos_of_pos_left a hn)) this,
  rwa gcd_comm,
end

-- Express 18 as an integer linear combination of 327 and 120.
theorem q2a : ∃ x y : ℤ, 18 = 327*x + 120*y :=
    ⟨-66, 180, by norm_num⟩

-- Find, with proof, all solutions to the linear diophantine equation 110x + 68y = 14.
theorem q2b : ∃ A : set (ℤ×ℤ), ∀ x y : ℤ, (110*x + 68*y = 14 ↔ (x,y) ∈ A ):=
begin
apply exists.intro ∅,  --the answer is not ∅
assume x y,
apply iff.intro,
{
    sorry,
},
{
  intro h,
  exact false.elim ‹(x, y) ∈ (∅ : set (ℤ×ℤ))›,
}
end

-- Find a multiplicative inverse of 31 modulo 132.
theorem q2c : ∃ x : ℤ, 31*x % 132 = 1 :=
    ⟨115, by norm_num⟩

-- Find an integer congruent to 3 mod 9 and congruent to 1 mod 49.
theorem q2d : ∃ x : ℤ, x % 9 = 3 → x % 49 = 1 :=
    ⟨-195, by norm_num⟩

-- Find, with proof, the smallest nonnegative integer n such that n = 1 (mod 3), n = 4 (mod 5), and n = 3 (mod 7).
theorem extended_chinese_remainder {p q r : ℕ} (co : coprime p q ∧ coprime q r ∧ coprime r p) (a b c: ℕ) :
    {k // k ≡ a [MOD p] ∧ k ≡ b [MOD q] ∧ k ≡ c[MOD r]} := sorry

theorem q2e : ∃ n : ℕ, ∀ n₂ : ℕ, n % 3 = 1 ∧ n % 5 = 4 ∧ n % 7 = 3
                            → n₂ % 3 = 1 ∧ n₂ % 5 = 4 ∧ n₂ % 7 = 3 → n ≤ n₂
                            :=
begin
  --@extended_chinese_remainder 3 5 7 dec_trivial 1 4 3
  let n := 94,
  let p := λ n, n % 3 = 1 ∧ n % 5 = 4 ∧ n % 7 = 3,
  have h : ∃ n : ℕ, p n, from  ⟨94, dec_trivial⟩,
  apply exists.intro (nat.find h),
  assume n₂ hn hn₂,
  exact nat.find_min' h hn₂,
end

-- Let m and n be integers. Show that the greatest common divisor of m and n is the unique positive integer d such that:
--      - d divides both m and n, and
--      - if x divides both m and n, then x divides d.
theorem q3 : ∀ m n : ℕ, ∃! d : ℕ, ∀ x : ℕ, gcd m n = d → d ∣ m → d ∣ n → x ∣ m → x ∣ n → x ∣ d
                                    :=
begin
  intros m n,
  apply exists_unique.intro (gcd m n),
  {
    intros x h1 h2 h3 h4 h5,

    sorry
  },
  intros y x,
  sorry
end

-- Let a and b be nonzero integers. Show that there is a unique positive integer m with the following two properties:
--      - a and b divide m, and
--      - if n is any number divisible by both a and b, then m|n.
-- The number m is called the least common multiple of a and b.
theorem gcd_dvd_trans {a b c : ℤ} : a ∣ b → b ∣ c → a ∣ c :=
begin
  intro Hab,
  intro Hbc,
  cases Hab with e He,
  cases Hbc with f Hf,
  existsi e * f,
  rw Hf,
  rw He,
  exact mul_assoc _ _ _,
end

-- TODO: to find in mathlib
-- theorem gcd_eq_pair_number (a b : ℕ) : ∃ x y : ℤ,  gcd a b = x*a + b*y := sorry
-- theorem gcd_iff_pair_number (a b d : ℕ) : gcd a b = d ↔ ∃ x y : ℤ, x*a + b*y = d := sorry
theorem coprime_dvd_of_dvd_mul {a b c : ℕ} (h1 : a ∣ c) (h2 : b ∣ c) (h3 : coprime a b) :
    a*b ∣ c := sorry

theorem lcm_def (m : ℕ) : ∀ a b : ℕ, (∀ n : ℕ, a ≠ 0 ∧ b ≠ 0 ∧
                                a ∣ m ∧ b ∣ m ∧ a ∣ n ∧ b ∣ n → m ∣ n) → m = lcm a b
                                :=
begin
  intros ha hb h,
  unfold lcm,
  let p := ha ≠ 0 ∧ hb ≠ 0 ∧ ha ∣ m ∧ hb ∣ m ∧ ha ∣ ha * hb / gcd ha hb ∧ hb ∣ ha * hb / gcd ha hb,
  have h2 :  p → m ∣ ha * hb / gcd ha hb, from h (ha*hb/gcd ha hb),
  have m_dvd_def : m ∣ ha*hb/gcd ha hb,
  {
    /-
    by_cases
      (assume h3 : p, h2 h3)
      (assume h3 : ¬p, sorry)
    -/
    sorry,
  },
  have def_dvd_m : (ha*hb/gcd ha hb) ∣ m,
  {
    sorry,
  },
  exact dvd_antisymm m_dvd_def def_dvd_m,
end

theorem q4a : ∀ a b : ℕ, ∃! m : ℕ, ∀ n : ℕ, a ≠ 0 ∧ b ≠ 0 ∧
                                a ∣ m ∧ b ∣ m ∧ a ∣ n ∧ b ∣ n → m ∣ n
                                :=
begin
intro a, intro b,
let m := a*b/(gcd a b),
have m_def : m = a*b/(gcd a b), by simp,
apply exists_unique.intro m,
{

  assume n,
  assume h,
  have a_dvd_n : a ∣ n, from h.right.right.right.right.left,
  have b_dvd_n : b ∣ n, from h.right.right.right.right.right,
  let a' := a/(gcd a b),
  have ap_eq : a/(gcd a b) = a', by simp,
  have gcd_dvd_a : (gcd a b) ∣ a, from gcd_dvd_left _ _,
  have gcd_dvd_b : (gcd a b) ∣ b, from gcd_dvd_right _ _,
  let b':= b/(gcd a b),
  have bp_eq : b' = b/(gcd a b), by simp,
  let d := gcd a b,
  have d_eq : d = gcd a b, by simp,
  have eq2 : (b / (gcd a b)) * gcd a b = b, from nat.div_mul_cancel gcd_dvd_b,

  have eq_a : d*a' = a,
      {
        calc
           d*a' =  gcd a b * a' : by rw d_eq
           ...  =  gcd a b * (a / (gcd a b))  : by rw ap_eq
           ...  =   a / gcd a b * gcd a b  : by rw nat.mul_comm
           ...  =  a  : by rw nat.div_mul_cancel gcd_dvd_a
      },
  have eq_b : d*b' = b,
   {
        calc
           d*b' =  b : by rw [nat.mul_comm,d_eq, bp_eq, eq2]
   },
  have da'_dvd_n: d*a' ∣ n, from eq.subst (eq.symm eq_a) a_dvd_n,
  have db'_dvd_n: d*b' ∣ n, from eq.subst (eq.symm eq_b) b_dvd_n,
  have gcd_pos: gcd a b > 0, from gcd_pos_of_pos_left b ((nat.pos_iff_ne_zero).mpr h.left),
  have middlestep: a' * gcd a b ∣ n / d * gcd a b,
  {
    rw mul_comm,
    rw ← d_eq,
    have d_dvd_n: d ∣ n, from dvd_of_mul_right_dvd da'_dvd_n,
    rwa nat.div_mul_cancel d_dvd_n,

  },
  have a'_dvd_n_dvd_d: a' ∣ n/d, from dvd_of_mul_dvd_mul_right gcd_pos middlestep,
  have middlestep2: b' * gcd a b ∣ n / d * gcd a b,
  {
    rw mul_comm,
    rw ← d_eq,
    have d_dvd_n: d ∣ n, from dvd_of_mul_right_dvd db'_dvd_n,
    rwa nat.div_mul_cancel d_dvd_n,

  },
  have b'_dvd_n_dvd_d: b' ∣ n/d, from dvd_of_mul_dvd_mul_right gcd_pos middlestep2,
  have capbp : coprime a' b',
    {
        have b_gr_0 : b > 0,
        {
            rw pos_iff_ne_zero,
            exact h.right.left,
        },
        have gcd_gr_0 : gcd a b > 0, from nat.gcd_pos_of_pos_right a b_gr_0,
        have cop_fractions : coprime (a / gcd a b) (b /gcd a b), from nat.coprime_div_gcd_div_gcd gcd_gr_0,
        have cop_fractions_2 : coprime a' (b / gcd a b), from eq.subst ap_eq cop_fractions,
        exact eq.subst bp_eq cop_fractions_2,

    },
  have apbp_dvd_n_dvd_d: a'*b' ∣ n/d, from coprime_dvd_of_dvd_mul a'_dvd_n_dvd_d b'_dvd_n_dvd_d capbp,
  have : a'*b'*d ∣ n,
  {
    have d_gr_zero : d > 0, from (eq.subst (eq.symm d_eq) gcd_pos),

    rw ← nat.mul_div_cancel n d_gr_zero,
    have : a' * b' * d ∣ (n / d) * d, from mul_dvd_mul_right apbp_dvd_n_dvd_d d,
    have : a' * b' * d ∣ d * (n / d), from eq.subst (mul_comm (n / d) d) this,
    have d_dvd_n: d ∣ n, from dvd_of_mul_right_dvd da'_dvd_n,
    have : a' * b' * d ∣ d * n / d, from  eq.subst (eq.symm (nat.mul_div_assoc d d_dvd_n)) this,
    exact eq.subst (mul_comm d n) this,
  },
have  eq3 : a'*b'*d = m,
      {
        calc
           a'*b'*d    =  (a/gcd a b) * ((b/gcd a b) * gcd a b) : by rw [mul_assoc,ap_eq, bp_eq, d_eq]
               ... = (a/gcd a b) * (gcd a b * (b/gcd a b)) : by rw nat.mul_comm (gcd a b) (b/gcd a b)
               ... = (a/gcd a b) * (gcd a b * b/gcd a b) : by rw ←nat.mul_div_assoc (gcd a b) gcd_dvd_b
               ... =  (a/gcd a b) * (b * gcd a b /gcd a b) :  by rw nat.mul_comm (gcd a b) b
               ... = (a/gcd a b) * b : by rw nat.mul_div_cancel b gcd_pos
               ... =  b * (a / gcd a b) : by rw nat.mul_comm
               ... =  b * a / gcd a b : by rw nat.mul_div_assoc b gcd_dvd_a
               ... = m : by rw [mul_comm,m_def]
      },
  rwa ←eq3,

},
{
  intros y hn,
  have m_lcm : m = lcm a b, by unfold lcm,
  have y_lcm : y = lcm a b, from lcm_def y a b hn ,
  exact by rw  [m_lcm, y_lcm],
}
end

def int_lcm (i j : ℤ) : ℕ := int.nat_abs(i * j) / (int.gcd i j)

-- Show that the least common multiple of a and b is given by |ab|/(a,b)
theorem q4b : ∀ a b : ℤ, int_lcm a b = int.nat_abs (a*b) /(int.gcd a b) :=
begin
  intros a b,
  refl,
end

-- Let m and n be positive integers, and let K be the kernel of the map:
--      ℤ/mnℤ → ℤ/mℤ x ℤ/nℤ
-- that takes a class mod mn to the corresponding classes modulo m and n.
-- Show that K has (m, n) elements. What are they?
-- theorem q5 :

-- -- Show that the equation ax = b (mod n) has no solutions if b is not divisible by (a, n), and exactly (a, n) solutions in ℤ/n otherwise.
-- theorem q6 :
-- Show that the equation ax = b (mod n) has no solutions if b is not divisible by (a, n), and exactly (a, n) solutions in ℤ/n otherwise.

--theorem q6 :  ¬(gcd a n ∣ b) → ¬(∃ x, a*x ≡ b [MOD n])

-- -- For n a positive integer, let σ(n) denote the sum Σ d for d∣n and d>0, of the positive divisors of n.
-- -- Show that the function n ↦ σ(n) is multiplicative.
-- theorem q7 :

-- Let p be a prime, and a be any integer. Show that a^(p²+p+1) is congruent to a^3 modulo p.
lemma nat.pow_mul (a b c : ℕ) : a ^ (b * c) = (a ^ b) ^ c :=
begin
  induction c with c ih,
  simp,
  rw [nat.mul_succ, nat.pow_add, nat.pow_succ, ih],
end

lemma nat.pow.mul (a b p q: ℕ) : a ≡ b [MOD q] → a ^ p ≡ b ^ p [MOD q] :=
begin
  intro h,
  induction p with p ih,
  simp,
  rw [nat.pow_succ, nat.pow_succ],
  apply nat.modeq.modeq_mul ih h,
end

theorem fermat_little_theorem : ∀ a p : ℕ, prime p → a ^ p ≡ a [MOD p] := sorry

theorem q8 : ∀ a p : ℕ, prime p →  a^(p^2+p+1) ≡ a^3 [MOD p] :=
begin
  assume a p hp,
  rw [nat.pow_add, nat.pow_one, nat.pow_add, nat.pow_succ, nat.pow_one, nat.pow_succ, nat.pow_succ, nat.pow_one],
  apply nat.modeq.modeq_mul,
  apply nat.modeq.modeq_mul,
  rw nat.pow_mul,
  have middle_step : (a ^ p) ^ p ≡ a ^ p [MOD p],
  let b := a ^ p,
  exact fermat_little_theorem b p hp,

  exact modeq.trans middle_step (fermat_little_theorem a p hp),
  exact fermat_little_theorem a p hp,
  exact modeq.refl a,
end

-- Let n be a squarefree positive integer, and suppose that for all primes p dividing n, we have (p-1)∣(n - 1).
-- Show that for all integers a with (a, n) = 1, we have a^n = a (mod n).

def square_free_int (n : ℕ) := ∀ p : ℕ, prime p ∧ (p ∣ n → ¬ (p^2 ∣ n))
theorem fermat_little_theorem_extension:  ∀ a p : ℕ, prime p → a ^ (p-1) ≡ 1 [MOD p] := sorry

theorem q9 : ∀ n p a : ℕ , n ≠ 0 ∧ square_free_int n ∧ prime p ∧ p ∣ n → (p-1)∣(n - 1) → gcd a n = 1 → a^n ≡ a [MOD n] := sorry
--begin
--intros n p a,
--intro hn,
--intro hp,
--let l:= factors n,
--have n_gr_0: n > 0, from pos_iff_ne_zero.mpr hn.left,
--have p_in_list: p ∈ l, from mem_factors_of_dvd n_gr_0 hn.right.right.left hn.right.right.right,
--let d := l.count p,
--have d_eq_1: d=1, sorry

--end

lemma pos_of_square_free (n : ℕ) : square_free_int n → n > 0 :=
begin
  intro H,
  apply nat.pos_of_ne_zero,
  intro Hn,
  rw square_free_int at H,
  rw Hn at H,
  have h3 : ¬2 ^ 2 ∣ 0, from (H 2).right (dvd_zero 2),
  norm_num at h3,
  exact h3,
end

lemma list.div_prod_of_mem (l : list ℕ) (d : ℕ) (Hd : d ∈ l) : d ∣ list.prod l :=
begin
  induction l with a m IH,
    cases Hd,
    rw list.prod_cons,
  cases ((list.mem_cons_iff _ _ _).1 Hd) with H H,
    rw H,
    apply dvd_mul_right,
  exact dvd_mul_of_dvd_right (IH H) _,
end

lemma prod_list_count_2 (l : list ℕ) (d : ℕ) : list.count d l ≥ 2 → d * d ∣ list.prod l :=
begin
  intro Hdl,
  induction l with a m IH,
    cases Hdl,
  by_cases (d = a),
  { rw list.prod_cons,
    rw h,
    apply mul_dvd_mul (dvd_refl a),
    apply list.div_prod_of_mem,
    rw ←h,
    rw ←list.count_pos,
    apply nat.pos_of_ne_zero,
    intro H0,
    rw list.count_cons at Hdl,
    rw if_pos h at Hdl,
    rw H0 at Hdl,
    revert Hdl,
    exact dec_trivial
  },
  { rw list.count_cons at Hdl,
    rw if_neg h at Hdl,
    have H := IH Hdl,      rw list.prod_cons,
    exact dvd_mul_of_dvd_right H _,
  }
end

lemma nat.prime_mul (n : ℕ) (p : ℕ) (Hp : prime p) (Hs : square_free_int n) : p ∈ factors n → (factors n).count p = 1 :=
begin
  intro Hpn,
  have Hge1 : list.count p (factors n) ≥ 1,
    exact list.count_pos.2 Hpn,
  cases (le_iff_lt_or_eq.1 Hge1) with H2 H2,
  { exfalso,
    /-
    apply Hs p Hp,
    { rw ←(nat.prod_factors (pos_of_square_free n Hs)),
      apply list.div_prod_of_mem,
      assumption
    },

    show (1 * p) * p ∣ n,
    rw one_mul,
    rw ←(nat.prod_factors (pos_of_square_free n Hs)),
    exact prod_list_count_2 (factors n) p H2,
    -/
    sorry,
  },
  exact H2.symm
end

-- Let n be a positive integer. Show that Σ Φ(d) for d∣n and d>0 = n.
-- [Hint: First show that the number of integers a with a ≤ 0 < n and (a, n) = n/d is equal to Φ(d).]
--theorem q10 :
end nat


import incidence_world.level04 --hide
open IncidencePlane --hide

/-
Using the lemma we have just proved, we can now prove that
a single point never determines a line. That is, that there are
always at least two lines passing through any given point.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma :
There are at least two different lines passing through a given point.
-/
lemma point_exists_two_lines (P : Ω) : ∃ (r s: Line Ω), P ∈ s ∧ P ∈ r ∧ s ≠ r :=
begin
  rcases (point_existence_postulate P) with ⟨Q, R, ⟨hPQ, hPR, hQR,H⟩⟩,
  use line_through P Q,
  use line_through P R,
  split,
  {
    exact line_through_left P R,
  },
  split,
  {
    exact line_through_left P Q,
  },
  {
    exact ne_of_not_share_point (line_through_right P R) H,
  }

end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.nat.prime data.nat.modeq data.zsqrtd.basic

namespace pell
open nat

section
  parameters {a : ℕ} (a1 : a > 1)

  include a1
  private def d := a*a - 1

  @[simp] theorem d_pos : 0 < d := nat.sub_pos_of_lt (mul_lt_mul a1 (le_of_lt a1) dec_trivial dec_trivial : 1*1<a*a)

  /-- The Pell sequences, defined together in mutual recursion. -/
  def pell : ℕ → ℕ × ℕ :=
  λn, nat.rec_on n (1, 0) (λn xy, (xy.1*a + d*xy.2, xy.1 + xy.2*a))

  /-- The Pell `x` sequence. -/
  def xn (n : ℕ) : ℕ := (pell n).1
  /-- The Pell `y` sequence. -/
  def yn (n : ℕ) : ℕ := (pell n).2

  @[simp] theorem pell_val (n : ℕ) : pell n = (xn n, yn n) :=
  show pell n = ((pell n).1, (pell n).2), from match pell n with (a, b) := rfl end

  @[simp] theorem xn_zero : xn 0 = 1 := rfl
  @[simp] theorem yn_zero : yn 0 = 0 := rfl

  @[simp] theorem xn_succ (n : ℕ) : xn (n+1) = xn n * a + d * yn n := rfl
  @[simp] theorem yn_succ (n : ℕ) : yn (n+1) = xn n + yn n * a := rfl

  @[simp] theorem xn_one : xn 1 = a := by simp
  @[simp] theorem yn_one : yn 1 = 1 := by simp

  def xz (n : ℕ) : ℤ := xn n
  def yz (n : ℕ) : ℤ := yn n
  def az : ℤ := a

  theorem asq_pos : 0 < a*a :=
  le_trans (le_of_lt a1) (by have := @nat.mul_le_mul_left 1 a a (le_of_lt a1); rwa mul_one at this)

  theorem dz_val : ↑d = az*az - 1 :=
  have 1 ≤ a*a, from asq_pos,
  show ↑(a*a - 1) = _, by rw int.coe_nat_sub this; refl

  @[simp] theorem xz_succ (n : ℕ) : xz (n+1) = xz n * az + ↑d * yz n := rfl
  @[simp] theorem yz_succ (n : ℕ) : yz (n+1) = xz n + yz n * az := rfl

  /-- The Pell sequence can also be viewed as an element of `ℤ√d` -/
  def pell_zd (n : ℕ) : ℤ√d := ⟨xn n, yn n⟩
  @[simp] theorem pell_zd_re (n : ℕ) : (pell_zd n).re = xn n := rfl
  @[simp] theorem pell_zd_im (n : ℕ) : (pell_zd n).im = yn n := rfl

  /-- The property of being a solution to the Pell equation, expressed
    as a property of elements of `ℤ√d`. -/
  def is_pell : ℤ√d → Prop | ⟨x, y⟩ := x*x - d*y*y = 1

  theorem is_pell_nat {x y : ℕ} : is_pell ⟨x, y⟩ ↔ x*x - d*y*y = 1 :=
  ⟨λh, int.coe_nat_inj (by rw int.coe_nat_sub (int.le_of_coe_nat_le_coe_nat $ int.le.intro_sub h); exact h),
  λh, show ((x*x : ℕ) - (d*y*y:ℕ) : ℤ) = 1, by rw [← int.coe_nat_sub $ le_of_lt $ nat.lt_of_sub_eq_succ h, h]; refl⟩

  theorem is_pell_norm : Π {b : ℤ√d}, is_pell b ↔ b * b.conj = 1
  | ⟨x, y⟩ := by simp [zsqrtd.ext, is_pell, mul_comm]

  theorem is_pell_mul {b c : ℤ√d} (hb : is_pell b) (hc : is_pell c) : is_pell (b * c) :=
  is_pell_norm.2 (by simp [mul_comm, mul_left_comm,
    zsqrtd.conj_mul, pell.is_pell_norm.1 hb, pell.is_pell_norm.1 hc])

  theorem is_pell_conj : ∀ {b : ℤ√d}, is_pell b ↔ is_pell b.conj | ⟨x, y⟩ :=
  by simp [is_pell, zsqrtd.conj]

  @[simp] theorem pell_zd_succ (n : ℕ) : pell_zd (n+1) = pell_zd n * ⟨a, 1⟩ :=
  by simp [zsqrtd.ext]

  theorem is_pell_one : is_pell ⟨a, 1⟩ :=
  show az*az-d*1*1=1, by simp [dz_val]

  theorem is_pell_pell_zd : ∀ (n : ℕ), is_pell (pell_zd n)
  | 0     := rfl
  | (n+1) := let o := is_pell_one in by simp; exact pell.is_pell_mul (is_pell_pell_zd n) o

  @[simp] theorem pell_eqz (n : ℕ) : xz n * xz n - d * yz n * yz n = 1 := is_pell_pell_zd n

  @[simp] theorem pell_eq (n : ℕ) : xn n * xn n - d * yn n * yn n = 1 :=
  let pn := pell_eqz n in
  have h : (↑(xn n * xn n) : ℤ) - ↑(d * yn n * yn n) = 1,
    by repeat {rw int.coe_nat_mul}; exact pn,
  have hl : d * yn n * yn n ≤ xn n * xn n, from
    int.le_of_coe_nat_le_coe_nat $ int.le.intro $ add_eq_of_eq_sub' $ eq.symm h,
  int.coe_nat_inj (by rw int.coe_nat_sub hl; exact h)

  instance dnsq : zsqrtd.nonsquare d := ⟨λn h,
    have n*n + 1 = a*a, by rw ← h; exact nat.succ_pred_eq_of_pos (asq_pos a1),
    have na : n < a, from nat.mul_self_lt_mul_self_iff.2 (by rw ← this; exact nat.lt_succ_self _),
    have (n+1)*(n+1) ≤ n*n + 1, by rw this; exact nat.mul_self_le_mul_self na,
    have n+n ≤ 0, from @nat.le_of_add_le_add_right (n*n + 1) _ _ (by simpa [mul_add, mul_comm, mul_left_comm]),
    ne_of_gt d_pos $ by rw nat.eq_zero_of_le_zero (le_trans (nat.le_add_left _ _) this) at h; exact h⟩

  theorem xn_ge_a_pow : ∀ (n : ℕ), a^n ≤ xn n
  | 0     := le_refl 1
  | (n+1) := by simp [nat.pow_succ]; exact le_trans
    (nat.mul_le_mul_right _ (xn_ge_a_pow n)) (nat.le_add_right _ _)

  theorem n_lt_a_pow : ∀ (n : ℕ), n < a^n
  | 0     := nat.le_refl 1
  | (n+1) := begin have IH := n_lt_a_pow n,
    have : a^n + a^n ≤ a^n * a,
    { rw ← mul_two, exact nat.mul_le_mul_left _ a1 },
    simp [nat.pow_succ], refine lt_of_lt_of_le _ this,
    exact add_lt_add_of_lt_of_le IH (lt_of_le_of_lt (nat.zero_le _) IH)
  end

  theorem n_lt_xn (n) : n < xn n :=
  lt_of_lt_of_le (n_lt_a_pow n) (xn_ge_a_pow n)

  theorem x_pos (n) : xn n > 0 :=
  lt_of_le_of_lt (nat.zero_le n) (n_lt_xn n)

  lemma eq_pell_lem : ∀n (b:ℤ√d), 1 ≤ b → is_pell b → pell_zd n ≥ b → ∃n, b = pell_zd n
  | 0     b := λh1 hp hl, ⟨0, @zsqrtd.le_antisymm _ dnsq _ _ hl h1⟩
  | (n+1) b := λh1 hp h,
    have a1p : (0:ℤ√d) ≤ ⟨a, 1⟩, from trivial,
    have am1p : (0:ℤ√d) ≤ ⟨a, -1⟩, from show (_:nat) ≤ _, by simp; exact nat.pred_le _,
    have a1m : (⟨a, 1⟩ * ⟨a, -1⟩ : ℤ√d) = 1, from is_pell_norm.1 is_pell_one,
    if ha : b ≥ ⟨↑a, 1⟩ then
      let ⟨m, e⟩ := eq_pell_lem n (b * ⟨a, -1⟩)
        (by rw ← a1m; exact mul_le_mul_of_nonneg_right ha am1p)
        (is_pell_mul hp (is_pell_conj.1 is_pell_one))
        (by have t := mul_le_mul_of_nonneg_right h am1p; rwa [pell_zd_succ, mul_assoc, a1m, mul_one] at t) in
      ⟨m+1, by rw [show b = b * ⟨a, -1⟩ * ⟨a, 1⟩, by rw [mul_assoc, eq.trans (mul_comm _ _) a1m]; simp, pell_zd_succ, e]⟩
    else
      suffices ¬1 < b, from ⟨0, show b = 1, from (or.resolve_left (lt_or_eq_of_le h1) this).symm⟩, λh1l,
      by cases b with x y; exact
      have bm : (_*⟨_,_⟩ :ℤ√(d a1)) = 1, from pell.is_pell_norm.1 hp,
      have y0l : (0:ℤ√(d a1)) < ⟨x - x, y - -y⟩, from sub_lt_sub h1l $ λ(hn : (1:ℤ√(d a1)) ≤ ⟨x, -y⟩),
        by have t := mul_le_mul_of_nonneg_left hn (le_trans zero_le_one h1); rw [bm, mul_one] at t; exact h1l t,
      have yl2 : (⟨_, _⟩ : ℤ√_) < ⟨_, _⟩, from
        show (⟨x, y⟩ - ⟨x, -y⟩ : ℤ√(d a1)) < ⟨a, 1⟩ - ⟨a, -1⟩, from
        sub_lt_sub (by exact ha) $ λ(hn : (⟨x, -y⟩ : ℤ√(d a1)) ≤ ⟨a, -1⟩),
        by have t := mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left hn (le_trans zero_le_one h1)) a1p;
           rw [bm, one_mul, mul_assoc, eq.trans (mul_comm _ _) a1m, mul_one] at t; exact ha t,
      by simp at y0l; simp at yl2; exact
      match y, y0l, (yl2 : (⟨_, _⟩ : ℤ√_) < ⟨_, _⟩) with
      | 0, y0l, yl2 := y0l (le_refl 0)
      | (y+1 : ℕ), y0l, yl2 := yl2 (zsqrtd.le_of_le_le (le_refl 0)
          (let t := int.coe_nat_le_coe_nat_of_le (nat.succ_pos y) in add_le_add t t))
      | -[1+y], y0l, yl2 := y0l trivial
      end

  theorem eq_pell_zd (b : ℤ√d) (b1 : 1 ≤ b) (hp : is_pell b) : ∃n, b = pell_zd n :=
  let ⟨n, h⟩ := @zsqrtd.le_arch d b in
  eq_pell_lem n b b1 hp $ zsqrtd.le_trans h $ by rw zsqrtd.coe_nat_val; exact
  zsqrtd.le_of_le_le
    (int.coe_nat_le_coe_nat_of_le $ le_of_lt $ n_lt_xn _ _) (int.coe_zero_le _)

  theorem eq_pell {x y : ℕ} (hp : x*x - d*y*y = 1) : ∃n, x = xn n ∧ y = yn n :=
  have (1:ℤ√d) ≤ ⟨x, y⟩, from match x, hp with
  | 0,    (hp : 0 - _ = 1) := by rw nat.zero_sub at hp; contradiction
  | (x+1), hp := zsqrtd.le_of_le_le (int.coe_nat_le_coe_nat_of_le $ nat.succ_pos x) (int.coe_zero_le _)
  end,
  let ⟨m, e⟩ := eq_pell_zd ⟨x, y⟩ this (is_pell_nat.2 hp) in
  ⟨m, match x, y, e with ._, ._, rfl := ⟨rfl, rfl⟩ end⟩

  theorem pell_zd_add (m) : ∀ n, pell_zd (m + n) = pell_zd m * pell_zd n
  | 0     := (mul_one _).symm
  | (n+1) := by rw[← add_assoc, pell_zd_succ, pell_zd_succ, pell_zd_add n, ← mul_assoc]

  theorem xn_add (m n) : xn (m + n) = xn m * xn n + d * yn m * yn n :=
  by injection (pell_zd_add _ m n) with h _;
     repeat {rw ← int.coe_nat_add at h <|> rw ← int.coe_nat_mul at h};
     exact int.coe_nat_inj h

  theorem yn_add (m n) : yn (m + n) = xn m * yn n + yn m * xn n :=
  by injection (pell_zd_add _ m n) with _ h;
     repeat {rw ← int.coe_nat_add at h <|> rw ← int.coe_nat_mul at h};
     exact int.coe_nat_inj h

  theorem pell_zd_sub {m n} (h : n ≤ m) : pell_zd (m - n) = pell_zd m * (pell_zd n).conj :=
  let t := pell_zd_add n (m - n) in
  by rw [nat.add_sub_of_le h] at t;
     rw [t, mul_comm (pell_zd _ n) _, mul_assoc, (is_pell_norm _).1 (is_pell_pell_zd _ _), mul_one]

  theorem xz_sub {m n} (h : n ≤ m) : xz (m - n) = xz m * xz n - d * yz m * yz n :=
  by injection (pell_zd_sub _ h) with h _; repeat {rw ← neg_mul_eq_mul_neg at h}; exact h

  theorem yz_sub {m n} (h : n ≤ m) : yz (m - n) = xz n * yz m - xz m * yz n :=
  by injection (pell_zd_sub a1 h) with _ h; repeat {rw ← neg_mul_eq_mul_neg at h}; rw [add_comm, mul_comm] at h; exact h

  theorem xy_coprime (n) : (xn n).coprime (yn n) :=
  nat.coprime_of_dvd' $ λk kx ky,
  let p := pell_eq n in by rw ← p; exact
  nat.dvd_sub (le_of_lt $ nat.lt_of_sub_eq_succ p)
    (dvd_mul_of_dvd_right kx _) (dvd_mul_of_dvd_right ky _)

  theorem y_increasing {m} : Π {n}, m < n → yn m < yn n
  | 0     h := absurd h $ nat.not_lt_zero _
  | (n+1) h :=
    have yn m ≤ yn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
      (λhl, le_of_lt $ y_increasing hl) (λe, by rw e),
    by simp; refine lt_of_le_of_lt _ (nat.lt_add_of_pos_left $ x_pos a1 n);
       rw ← mul_one (yn a1 m);
       exact mul_le_mul this (le_of_lt a1) (nat.zero_le _) (nat.zero_le _)

  theorem x_increasing {m} : Π {n}, m < n → xn m < xn n
  | 0     h := absurd h $ nat.not_lt_zero _
  | (n+1) h :=
    have xn m ≤ xn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
      (λhl, le_of_lt $ x_increasing hl) (λe, by rw e),
    by simp; refine lt_of_lt_of_le (lt_of_le_of_lt this _) (nat.le_add_right _ _);
       have t := nat.mul_lt_mul_of_pos_left a1 (x_pos a1 n); rwa mul_one at t

  theorem yn_ge_n : Π n, n ≤ yn n
  | 0 := nat.zero_le _
  | (n+1) := show n < yn (n+1), from lt_of_le_of_lt (yn_ge_n n) (y_increasing $ nat.lt_succ_self n)

  theorem y_mul_dvd (n) : ∀k, yn n ∣ yn (n * k)
  | 0     := dvd_zero _
  | (k+1) := by rw [nat.mul_succ, yn_add]; exact
    dvd_add (dvd_mul_left _ _) (dvd_mul_of_dvd_left (y_mul_dvd k) _)

  theorem y_dvd_iff (m n) : yn m ∣ yn n ↔ m ∣ n :=
  ⟨λh, nat.dvd_of_mod_eq_zero $ (nat.eq_zero_or_pos _).resolve_right $ λhp,
    have co : nat.coprime (yn m) (xn (m * (n / m))), from nat.coprime.symm $
      (xy_coprime _).coprime_dvd_right (y_mul_dvd m (n / m)),
    have m0 : m > 0, from m.eq_zero_or_pos.resolve_left $
      λe, by rw [e, nat.mod_zero] at hp; rw [e] at h; exact
      have 0 < yn a1 n, from y_increasing _ hp,
      ne_of_lt (y_increasing a1 hp) (eq_zero_of_zero_dvd h).symm,
    by rw [← nat.mod_add_div n m, yn_add] at h; exact
    not_le_of_gt (y_increasing _ $ nat.mod_lt n m0)
     (nat.le_of_dvd (y_increasing _ hp) $ co.dvd_of_dvd_mul_right $
      (nat.dvd_add_iff_right $ dvd_mul_of_dvd_right (y_mul_dvd _ _ _) _).2 h),
  λ⟨k, e⟩, by rw e; apply y_mul_dvd⟩

  theorem xy_modeq_yn (n) :
    ∀k, xn (n * k) ≡ (xn n)^k [MOD (yn n)^2]
      ∧ yn (n * k) ≡ k * (xn n)^(k-1) * yn n [MOD (yn n)^3]
  | 0     := by constructor; simp
  | (k+1) :=
    let ⟨hx, hy⟩ := xy_modeq_yn k in
    have L : xn (n * k) * xn n + d * yn (n * k) * yn n ≡ xn n^k * xn n + 0 [MOD yn n^2], from
    modeq.modeq_add (modeq.modeq_mul_right _ hx) $ modeq.modeq_zero_iff.2 $
      by rw nat.pow_succ; exact
      mul_dvd_mul_right (dvd_mul_of_dvd_right (modeq.modeq_zero_iff.1 $
        (hy.modeq_of_dvd_of_modeq $ by simp [nat.pow_succ]).trans $ modeq.modeq_zero_iff.2 $
        by simp [-mul_comm, -mul_assoc]) _) _,
    have R : xn (n * k) * yn n + yn (n * k) * xn n ≡
             xn n^k * yn n + k * xn n^k * yn n [MOD yn n^3], from
    modeq.modeq_add (by rw nat.pow_succ; exact modeq.modeq_mul_right' _ hx) $
      have k * xn n^(k - 1) * yn n * xn n = k * xn n^k * yn n,
        by clear _let_match; cases k with k; simp [nat.pow_succ, mul_comm, mul_left_comm],
      by rw ← this; exact modeq.modeq_mul_right _ hy,
    by rw [nat.add_sub_cancel, nat.mul_succ, xn_add, yn_add, nat.pow_succ (xn _ n),
           nat.succ_mul, add_comm (k * xn _ n^k) (xn _ n^k), right_distrib];
       exact ⟨L, R⟩

  theorem ysq_dvd_yy (n) : yn n * yn n ∣ yn (n * yn n) :=
  modeq.modeq_zero_iff.1 $
    ((xy_modeq_yn n (yn n)).right.modeq_of_dvd_of_modeq $ by simp [nat.pow_succ]).trans
    (modeq.modeq_zero_iff.2 $ by simp [mul_dvd_mul_left, mul_assoc])

  theorem dvd_of_ysq_dvd {n t} (h : yn n * yn n ∣ yn t) : yn n ∣ t :=
  have nt : n ∣ t, from (y_dvd_iff n t).1 $ dvd_of_mul_left_dvd h,
  n.eq_zero_or_pos.elim (λn0, by rw n0; rw n0 at nt; exact nt) $ λ(n0l : n > 0),
  let ⟨k, ke⟩ := nt in
  have yn n ∣ k * (xn n)^(k-1), from
  nat.dvd_of_mul_dvd_mul_right (y_increasing n0l) $ modeq.modeq_zero_iff.1 $
    by have xm := (xy_modeq_yn a1 n k).right; rw ← ke at xm; exact
    (xm.modeq_of_dvd_of_modeq $ by simp [nat.pow_succ]).symm.trans
      (modeq.modeq_zero_iff.2 h),
  by rw ke; exact dvd_mul_of_dvd_right
    (((xy_coprime _ _).pow_left _).symm.dvd_of_dvd_mul_right this) _

  theorem pell_zd_succ_succ (n) : pell_zd (n + 2) + pell_zd n = (2 * a : ℕ) * pell_zd (n + 1) :=
  have (1:ℤ√d) + ⟨a, 1⟩ * ⟨a, 1⟩ = ⟨a, 1⟩ * (2 * a),
  by rw zsqrtd.coe_nat_val; change (⟨_,_⟩:ℤ√(d a1))=⟨_,_⟩;
     rw dz_val; change az a1 with a; simp [mul_add, add_mul],
  by simpa [mul_add, mul_comm, mul_left_comm] using congr_arg (* pell_zd a1 n) this

  theorem xy_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) ∧
                             yn (n + 2) + yn n = (2 * a) * yn (n + 1) := begin
    have := pell_zd_succ_succ a1 n, unfold pell_zd at this,
    rw [← int.cast_coe_nat, zsqrtd.smul_val] at this,
    injection this with h₁ h₂,
    split; apply int.coe_nat_inj; [simpa using h₁, simpa using h₂]
  end

  theorem xn_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) := (xy_succ_succ n).1
  theorem yn_succ_succ (n) : yn (n + 2) + yn n = (2 * a) * yn (n + 1) := (xy_succ_succ n).2

  theorem xz_succ_succ (n) : xz (n + 2) = (2 * a : ℕ) * xz (n + 1) - xz n :=
  eq_sub_of_add_eq $ by delta xz; rw [← int.coe_nat_add, ← int.coe_nat_mul, xn_succ_succ]

  theorem yz_succ_succ (n) : yz (n + 2) = (2 * a : ℕ) * yz (n + 1) - yz n :=
  eq_sub_of_add_eq $ by delta yz; rw [← int.coe_nat_add, ← int.coe_nat_mul, yn_succ_succ]

  theorem yn_modeq_a_sub_one : ∀ n, yn n ≡ n [MOD a-1]
  | 0 := by simp
  | 1 := by simp
  | (n+2) := modeq.modeq_add_cancel_right (yn_modeq_a_sub_one n) $
    have 2*(n+1) = n+2+n, by simp [two_mul],
    by rw [yn_succ_succ, ← this];
    refine modeq.modeq_mul (modeq.modeq_mul_left 2 (_ : a ≡ 1 [MOD a-1])) (yn_modeq_a_sub_one (n+1));
    exact (modeq.modeq_of_dvd $ by rw [int.coe_nat_sub $ le_of_lt a1]; apply dvd_refl).symm

  theorem yn_modeq_two : ∀ n, yn n ≡ n [MOD 2]
  | 0 := by simp
  | 1 := by simp
  | (n+2) := modeq.modeq_add_cancel_right (yn_modeq_two n) $
    have 2*(n+1) = n+2+n, by simp [two_mul],
    by rw [yn_succ_succ, ← this];
    refine modeq.modeq_mul _ (yn_modeq_two (n+1));
    exact modeq.trans
      (modeq.modeq_zero_iff.2 $ by simp)
      (modeq.modeq_zero_iff.2 $ by simp).symm

  -- TODO(Mario): Hopefully a tactic will be able to dispense this lemma
  lemma x_sub_y_dvd_pow_lem (y2 y1 y0 yn1 yn0 xn1 xn0 ay a2 : ℤ) :
    (a2 * yn1 - yn0) * ay + y2 - (a2 * xn1 - xn0) =
      y2 - a2 * y1 + y0 + a2 * (yn1 * ay + y1 - xn1) - (yn0 * ay + y0 - xn0) :=
  calc  (a2 * yn1 - yn0) * ay + y2 - (a2 * xn1 - xn0)
      = a2 * yn1 * ay - yn0 * ay + y2 - (a2 * xn1 - xn0) : by rw [mul_sub_right_distrib]
  ... = y2 + a2 * (yn1 * ay) - a2 * xn1 - yn0 * ay + xn0 : by simp [mul_comm, mul_left_comm]
  ... = y2 + a2 * (yn1 * ay) - a2 * y1 + a2 * y1 - a2 * xn1 - yn0 * ay + y0 - y0 + xn0 : by rw [add_sub_cancel, sub_add_cancel]
  ... = y2 - a2 * y1 + y0 + a2 * (yn1 * ay + y1 - xn1) - (yn0 * ay + y0 - xn0) : by simp [mul_add]

  theorem x_sub_y_dvd_pow (y : ℕ) :
    ∀ n, (2*a*y - y*y - 1 : ℤ) ∣ yz n * (a - y) + ↑(y^n) - xz n
  | 0 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
  | 1 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
  | (n+2) :=
    have (2*a*y - y*y - 1 : ℤ) ∣ ↑(y^(n + 2)) - ↑(2 * a) * ↑(y^(n + 1)) + ↑(y^n), from
    ⟨-↑(y^n), by simp [nat.pow_succ, mul_add, int.coe_nat_mul,
        show ((2:ℕ):ℤ) = 2, from rfl, mul_comm, mul_left_comm]⟩,
    by rw [xz_succ_succ, yz_succ_succ, x_sub_y_dvd_pow_lem a1 ↑(y^(n+2)) ↑(y^(n+1)) ↑(y^n)]; exact
    dvd_sub (dvd_add this $ dvd_mul_of_dvd_right (x_sub_y_dvd_pow (n+1)) _) (x_sub_y_dvd_pow n)

  theorem xn_modeq_x2n_add_lem (n j) : xn n ∣ d * yn n * (yn n * xn j) + xn j :=
  have h1 : d * yn n * (yn n * xn j) + xn j = (d * yn n * yn n + 1) * xn j,
    by simp [add_mul, mul_assoc],
  have h2 : d * yn n * yn n + 1 = xn n * xn n, by apply int.coe_nat_inj;
    repeat {rw int.coe_nat_add <|> rw int.coe_nat_mul}; exact
    add_eq_of_eq_sub' (eq.symm $ pell_eqz _ _),
  by rw h2 at h1; rw [h1, mul_assoc]; exact dvd_mul_right _ _

  theorem xn_modeq_x2n_add (n j) : xn (2 * n + j) + xn j ≡ 0 [MOD xn n] :=
  by rw [two_mul, add_assoc, xn_add, add_assoc]; exact
  show _ ≡ 0+0 [MOD xn a1 n], from modeq.modeq_add (modeq.modeq_zero_iff.2 $ dvd_mul_right (xn a1 n) (xn a1 (n + j))) $
  by rw [yn_add, left_distrib, add_assoc]; exact
  show _ ≡ 0+0 [MOD xn a1 n], from modeq.modeq_add (modeq.modeq_zero_iff.2 $ dvd_mul_of_dvd_right (dvd_mul_right _ _) _) $
  modeq.modeq_zero_iff.2 $ xn_modeq_x2n_add_lem _ _ _

  lemma xn_modeq_x2n_sub_lem {n j} (h : j ≤ n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
  have h1 : xz n ∣ ↑d * yz n * yz (n - j) + xz j, by rw [yz_sub _ h, mul_sub_left_distrib, sub_add_eq_add_sub]; exact
  dvd_sub
    (by delta xz; delta yz;
        repeat {rw ← int.coe_nat_add <|> rw ← int.coe_nat_mul}; rw mul_comm (xn a1 j) (yn a1 n);
        exact int.coe_nat_dvd.2 (xn_modeq_x2n_add_lem _ _ _))
    (dvd_mul_of_dvd_right (dvd_mul_right _ _) _),
  by rw [two_mul, nat.add_sub_assoc h, xn_add, add_assoc]; exact
  show _ ≡ 0+0 [MOD xn a1 n], from modeq.modeq_add (modeq.modeq_zero_iff.2 $ dvd_mul_right _ _) $
  modeq.modeq_zero_iff.2 $ int.coe_nat_dvd.1 $ by simpa [xz, yz] using h1

  theorem xn_modeq_x2n_sub {n j} (h : j ≤ 2 * n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
  (le_total j n).elim xn_modeq_x2n_sub_lem
    (λjn, have 2 * n - j + j ≤ n + j, by rw [nat.sub_add_cancel h, two_mul]; exact nat.add_le_add_left jn _,
      let t := xn_modeq_x2n_sub_lem (nat.le_of_add_le_add_right this) in by rwa [nat.sub_sub_self h, add_comm] at t)

  theorem xn_modeq_x4n_add (n j) : xn (4 * n + j) ≡ xn j [MOD xn n] :=
  modeq.modeq_add_cancel_right (modeq.refl $ xn (2 * n + j)) $
  by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_add _ _ _).symm);
     rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, add_assoc]; apply xn_modeq_x2n_add

  theorem xn_modeq_x4n_sub {n j} (h : j ≤ 2 * n) : xn (4 * n - j) ≡ xn j [MOD xn n] :=
  have h' : j ≤ 2*n, from le_trans h (by rw nat.succ_mul; apply nat.le_add_left),
  modeq.modeq_add_cancel_right (modeq.refl $ xn (2 * n - j)) $
  by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_sub _ h).symm);
     rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, nat.add_sub_assoc h']; apply xn_modeq_x2n_add

  theorem eq_of_xn_modeq_lem1 {i n} (npos : n > 0) : Π {j}, i < j → j < n → xn i % xn n < xn j % xn n
  | 0     ij _  := absurd ij (nat.not_lt_zero _)
  | (j+1) ij jn :=
     suffices xn j % xn n < xn (j + 1) % xn n, from
     (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
        (λh, lt_trans (eq_of_xn_modeq_lem1 h (le_of_lt jn)) this)
        (λh, by rw h; exact this),
    by rw [nat.mod_eq_of_lt (x_increasing _ (nat.lt_of_succ_lt jn)), nat.mod_eq_of_lt (x_increasing _ jn)];
       exact x_increasing _ (nat.lt_succ_self _)

  theorem eq_of_xn_modeq_lem2 {n} (h : 2 * xn n = xn (n + 1)) : a = 2 ∧ n = 0 :=
  by rw [xn_succ, mul_comm] at h; exact
  have n = 0, from n.eq_zero_or_pos.resolve_right $ λnp,
    ne_of_lt (lt_of_le_of_lt (nat.mul_le_mul_left _ a1)
      (nat.lt_add_of_pos_right $ mul_pos (d_pos a1) (y_increasing a1 np))) h,
  by cases this; simp at h; exact ⟨h.symm, rfl⟩

  theorem eq_of_xn_modeq_lem3 {i n} (npos : n > 0) :
    Π {j}, i < j → j ≤ 2 * n → j ≠ n → ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2) → xn i % xn n < xn j % xn n
  | 0     ij _   _   _     := absurd ij (nat.not_lt_zero _)
  | (j+1) ij j2n jnn ntriv :=
    have lem2 : ∀k > n, k ≤ 2*n → (↑(xn k % xn n) : ℤ) = xn n - xn (2 * n - k), from λk kn k2n,
      let k2nl := lt_of_add_lt_add_right $ show 2*n-k+k < n+k, by
        {rw nat.sub_add_cancel, rw two_mul; exact (add_lt_add_left kn n), exact k2n } in
      have xle : xn (2 * n - k) ≤ xn n, from le_of_lt $ x_increasing k2nl,
      suffices xn k % xn n = xn n - xn (2 * n - k), by rw [this, int.coe_nat_sub xle],
      by {
        rw ← nat.mod_eq_of_lt (nat.sub_lt (x_pos a1 n) (x_pos a1 (2 * n - k))),
        apply modeq.modeq_add_cancel_right (modeq.refl (xn a1 (2 * n - k))),
        rw [nat.sub_add_cancel xle],
        have t := xn_modeq_x2n_sub_lem a1 (le_of_lt k2nl),
        rw nat.sub_sub_self k2n at t,
        exact t.trans (modeq.modeq_zero_iff.2 $ dvd_refl _).symm },
    (lt_trichotomy j n).elim
    (λ (jn : j < n), eq_of_xn_modeq_lem1 npos ij (lt_of_le_of_ne jn jnn)) $ λo, o.elim
    (λ (jn : j = n), by {
      cases jn,
      apply int.lt_of_coe_nat_lt_coe_nat,
      rw [lem2 (n+1) (nat.lt_succ_self _) j2n,
          show 2 * n - (n + 1) = n - 1, by rw[two_mul, ← nat.sub_sub, nat.add_sub_cancel]],
      refine lt_sub_left_of_add_lt (int.coe_nat_lt_coe_nat_of_lt _),
      cases (lt_or_eq_of_le $ nat.le_of_succ_le_succ ij) with lin ein,
      { rw nat.mod_eq_of_lt (x_increasing _ lin),
        have ll : xn a1 (n-1) + xn a1 (n-1) ≤ xn a1 n,
        { rw [← two_mul, mul_comm, show xn a1 n = xn a1 (n-1+1), by rw [nat.sub_add_cancel npos], xn_succ],
          exact le_trans (nat.mul_le_mul_left _ a1) (nat.le_add_right _ _) },
        have npm : (n-1).succ = n := nat.succ_pred_eq_of_pos npos,
        have il : i ≤ n - 1 := by apply nat.le_of_succ_le_succ; rw npm; exact lin,
        cases lt_or_eq_of_le il with ill ile,
        { exact lt_of_lt_of_le (nat.add_lt_add_left (x_increasing a1 ill) _) ll },
        { rw ile,
          apply lt_of_le_of_ne ll,
          rw ← two_mul,
          exact λe, ntriv $
            let ⟨a2, s1⟩ := @eq_of_xn_modeq_lem2 _ a1 (n-1) (by rw[nat.sub_add_cancel npos]; exact e) in
            have n1 : n = 1, from le_antisymm (nat.le_of_sub_eq_zero s1) npos,
            by rw [ile, a2, n1]; exact ⟨rfl, rfl, rfl, rfl⟩ } },
      { rw [ein, nat.mod_self, add_zero],
        exact x_increasing _ (nat.pred_lt $ ne_of_gt npos) } })
    (λ (jn : j > n),
      have lem1 : j ≠ n → xn j % xn n < xn (j + 1) % xn n → xn i % xn n < xn (j + 1) % xn n, from λjn s,
      (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
        (λh, lt_trans (eq_of_xn_modeq_lem3 h (le_of_lt j2n) jn $ λ⟨a1, n1, i0, j2⟩,
          by rw [n1, j2] at j2n; exact absurd j2n dec_trivial) s)
        (λh, by rw h; exact s),
      lem1 (ne_of_gt jn) $ int.lt_of_coe_nat_lt_coe_nat $ by {
        rw [lem2 j jn (le_of_lt j2n), lem2 (j+1) (nat.le_succ_of_le jn) j2n],
        refine sub_lt_sub_left (int.coe_nat_lt_coe_nat_of_lt $ x_increasing _ _) _,
        rw [nat.sub_succ],
        exact nat.pred_lt (ne_of_gt $ nat.sub_pos_of_lt j2n) })

  theorem eq_of_xn_modeq_le {i j n} (npos : n > 0) (ij : i ≤ j) (j2n : j ≤ 2 * n) (h : xn i ≡ xn j [MOD xn n])
    (ntriv : ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2)) : i = j :=
  (lt_or_eq_of_le ij).resolve_left $ λij',
  if jn : j = n then by {
    refine ne_of_gt _ h,
    rw [jn, nat.mod_self],
    have x0 : xn a1 0 % xn a1 n > 0 := by rw [nat.mod_eq_of_lt (x_increasing a1 npos)]; exact dec_trivial,
    cases i with i, exact x0,
    rw jn at ij',
    exact lt_trans x0 (eq_of_xn_modeq_lem3 _ npos (nat.succ_pos _) (le_trans ij j2n) (ne_of_lt ij') $
      λ⟨a1, n1, _, i2⟩, by rw [n1, i2] at ij'; exact absurd ij' dec_trivial)
  } else ne_of_lt (eq_of_xn_modeq_lem3 npos ij' j2n jn ntriv) h

  theorem eq_of_xn_modeq {i j n} (npos : n > 0) (i2n : i ≤ 2 * n) (j2n : j ≤ 2 * n) (h : xn i ≡ xn j [MOD xn n])
    (ntriv : a = 2 → n = 1 → (i = 0 → j ≠ 2) ∧ (i = 2 → j ≠ 0)) : i = j :=
  (le_total i j).elim
    (λij, eq_of_xn_modeq_le npos ij j2n h $ λ⟨a2, n1, i0, j2⟩, (ntriv a2 n1).left i0 j2)
    (λij, (eq_of_xn_modeq_le npos ij i2n h.symm $ λ⟨a2, n1, j0, i2⟩, (ntriv a2 n1).right i2 j0).symm)

  theorem eq_of_xn_modeq' {i j n} (ipos : i > 0) (hin : i ≤ n) (j4n : j ≤ 4 * n) (h : xn j ≡ xn i [MOD xn n]) :
    j = i ∨ j + i = 4 * n :=
  have i2n : i ≤ 2*n, by apply le_trans hin; rw two_mul; apply nat.le_add_left,
  have npos : n > 0, from lt_of_lt_of_le ipos hin,
  (le_or_gt j (2 * n)).imp
    (λj2n : j ≤ 2*n, eq_of_xn_modeq npos j2n i2n h $
      λa2 n1, ⟨λj0 i2, by rw [n1, i2] at hin; exact absurd hin dec_trivial,
               λj2 i0, ne_of_gt ipos i0⟩)
    (λj2n : j > 2*n, suffices i = 4*n - j, by rw [this, nat.add_sub_of_le j4n],
     have j42n : 4*n - j ≤ 2*n, from @nat.le_of_add_le_add_right j _ _ $
     by rw [nat.sub_add_cancel j4n, show 4*n = 2*n + 2*n, from right_distrib 2 2 n];
        exact nat.add_le_add_left (le_of_lt j2n) _,
     eq_of_xn_modeq npos i2n j42n
       (h.symm.trans $ let t := xn_modeq_x4n_sub j42n in by rwa [nat.sub_sub_self j4n] at t)
       (λa2 n1, ⟨λi0, absurd i0 (ne_of_gt ipos), λi2, by rw[n1, i2] at hin; exact absurd hin dec_trivial⟩))

  theorem modeq_of_xn_modeq {i j n} (ipos : i > 0) (hin : i ≤ n) (h : xn j ≡ xn i [MOD xn n]) :
    j ≡ i [MOD 4 * n] ∨ j + i ≡ 0 [MOD 4 * n] :=
  let j' := j % (4 * n) in
  have n4 : 4 * n > 0, from mul_pos dec_trivial (lt_of_lt_of_le ipos hin),
  have jl : j' < 4 * n, from nat.mod_lt _ n4,
  have jj : j ≡ j' [MOD 4 * n], by delta modeq; rw nat.mod_eq_of_lt jl,
  have ∀j q, xn (j + 4 * n * q) ≡ xn j [MOD xn n], begin
    intros j q, induction q with q IH, { simp },
    rw[nat.mul_succ, ← add_assoc, add_comm],
    exact modeq.trans (xn_modeq_x4n_add _ _ _) IH
  end,
  or.imp
    (λ(ji : j' = i), by rwa ← ji)
    (λ(ji : j' + i = 4 * n), (modeq.modeq_add jj (modeq.refl _)).trans $
      by rw ji; exact modeq.modeq_zero_iff.2 (dvd_refl _))
    (eq_of_xn_modeq' ipos hin (le_of_lt jl) $
      (modeq.symm (by rw ← nat.mod_add_div j (4*n); exact this j' _)).trans h)
end

theorem xy_modeq_of_modeq {a b c} (a1 : a > 1) (b1 : b > 1) (h : a ≡ b [MOD c]) :
  ∀ n, xn a1 n ≡ xn b1 n [MOD c] ∧ yn a1 n ≡ yn b1 n [MOD c]
| 0 := by constructor; refl
| 1 := by simp; exact ⟨h, modeq.refl 1⟩
| (n+2) := ⟨
  modeq.modeq_add_cancel_right (xy_modeq_of_modeq n).left $
    by rw [xn_succ_succ a1, xn_succ_succ b1]; exact
    modeq.modeq_mul (modeq.modeq_mul_left _ h) (xy_modeq_of_modeq (n+1)).left,
  modeq.modeq_add_cancel_right (xy_modeq_of_modeq n).right $
    by rw [yn_succ_succ a1, yn_succ_succ b1]; exact
    modeq.modeq_mul (modeq.modeq_mul_left _ h) (xy_modeq_of_modeq (n+1)).right⟩

theorem matiyasevic {a k x y} : (∃ a1 : a > 1, xn a1 k = x ∧ yn a1 k = y) ↔
a > 1 ∧ k ≤ y ∧
(x = 1 ∧ y = 0 ∨
∃ (u v s t b : ℕ),
  x * x - (a * a - 1) * y * y = 1 ∧
  u * u - (a * a - 1) * v * v = 1 ∧
  s * s - (b * b - 1) * t * t = 1 ∧
  b > 1 ∧ b ≡ 1 [MOD 4 * y] ∧ b ≡ a [MOD u] ∧
  v > 0 ∧ y * y ∣ v ∧
  s ≡ x [MOD u] ∧
  t ≡ k [MOD 4 * y]) :=
⟨λ⟨a1, hx, hy⟩, by rw [← hx, ← hy];
  refine ⟨a1, (nat.eq_zero_or_pos k).elim
    (λk0, by rw k0; exact ⟨le_refl _, or.inl ⟨rfl, rfl⟩⟩) (λkpos, _)⟩; exact
  let x := xn a1 k, y := yn a1 k,
      m := 2 * (k * y),
      u := xn a1 m, v := yn a1 m in
  have ky : k ≤ y, from yn_ge_n a1 k,
  have yv : y * y ∣ v, from dvd_trans (ysq_dvd_yy a1 k) $
      (y_dvd_iff _ _ _).2 $ dvd_mul_left _ _,
  have uco : nat.coprime u (4 * y), from
    have 2 ∣ v, from modeq.modeq_zero_iff.1 $ (yn_modeq_two _ _).trans $
      modeq.modeq_zero_iff.2 (dvd_mul_right _ _),
    have nat.coprime u 2, from
      (xy_coprime a1 m).coprime_dvd_right this,
    (this.mul_right this).mul_right $
      (xy_coprime _ _).coprime_dvd_right (dvd_of_mul_left_dvd yv),
  let ⟨b, ba, bm1⟩ := modeq.chinese_remainder uco a 1 in
  have m1 : 1 < m, from
    have 0 < k * y, from mul_pos kpos (y_increasing a1 kpos),
    nat.mul_le_mul_left 2 this,
  have vp : v > 0, from y_increasing a1 (lt_trans zero_lt_one m1),
  have b1 : b > 1, from
    have u > xn a1 1, from x_increasing a1 m1,
    have u > a, by simp at this; exact this,
    lt_of_lt_of_le a1 $ by delta modeq at ba;
      rw nat.mod_eq_of_lt this at ba; rw ← ba; apply nat.mod_le,
  let s := xn b1 k, t := yn b1 k in
  have sx : s ≡ x [MOD u], from (xy_modeq_of_modeq b1 a1 ba k).left,
  have tk : t ≡ k [MOD 4 * y], from
      have 4 * y ∣ b - 1, from int.coe_nat_dvd.1 $
        by rw int.coe_nat_sub (le_of_lt b1);
           exact modeq.dvd_of_modeq bm1.symm,
      modeq.modeq_of_dvd_of_modeq this $ yn_modeq_a_sub_one _ _,
  ⟨ky, or.inr ⟨u, v, s, t, b,
    pell_eq _ _, pell_eq _ _, pell_eq _ _, b1, bm1, ba, vp, yv, sx, tk⟩⟩,
λ⟨a1, ky, o⟩, ⟨a1, match o with
| or.inl ⟨x1, y0⟩ := by rw y0 at ky; rw [nat.eq_zero_of_le_zero ky, x1, y0]; exact ⟨rfl, rfl⟩
| or.inr ⟨u, v, s, t, b, xy, uv, st, b1, rem⟩ :=
  match x, y, eq_pell a1 xy, u, v, eq_pell a1 uv, s, t, eq_pell b1 st, rem, ky with
  | ._, ._, ⟨i, rfl, rfl⟩, ._, ._, ⟨n, rfl, rfl⟩, ._, ._, ⟨j, rfl, rfl⟩,
    ⟨(bm1 : b ≡ 1 [MOD 4 * yn a1 i]),
     (ba : b ≡ a [MOD xn a1 n]),
     (vp : yn a1 n > 0),
     (yv : yn a1 i * yn a1 i ∣ yn a1 n),
     (sx : xn b1 j ≡ xn a1 i [MOD xn a1 n]),
     (tk : yn b1 j ≡ k [MOD 4 * yn a1 i])⟩,
     (ky : k ≤ yn a1 i) :=
    (nat.eq_zero_or_pos i).elim
      (λi0, by simp [i0] at ky; rw [i0, ky]; exact ⟨rfl, rfl⟩) $ λipos,
    suffices i = k, by rw this; exact ⟨rfl, rfl⟩,
    by clear _x o rem xy uv st _match _match _fun_match; exact
    have iln : i ≤ n, from le_of_not_gt $ λhin,
    not_lt_of_ge (nat.le_of_dvd vp (dvd_of_mul_left_dvd yv)) (y_increasing a1 hin),
    have yd : 4 * yn a1 i ∣ 4 * n, from mul_dvd_mul_left _ $ dvd_of_ysq_dvd a1 yv,
    have jk : j ≡ k [MOD 4 * yn a1 i], from
      have 4 * yn a1 i ∣ b - 1, from int.coe_nat_dvd.1 $
        by rw int.coe_nat_sub (le_of_lt b1); exact modeq.dvd_of_modeq bm1.symm,
      (modeq.modeq_of_dvd_of_modeq this (yn_modeq_a_sub_one b1 _)).symm.trans tk,
    have ki : k + i < 4 * yn a1 i, from
      lt_of_le_of_lt (add_le_add ky (yn_ge_n a1 i)) $
      by rw ← two_mul; exact nat.mul_lt_mul_of_pos_right dec_trivial (y_increasing a1 ipos),
    have ji : j ≡ i [MOD 4 * n], from
      have xn a1 j ≡ xn a1 i [MOD xn a1 n], from (xy_modeq_of_modeq b1 a1 ba j).left.symm.trans sx,
      (modeq_of_xn_modeq a1 ipos iln this).resolve_right $ λ (ji : j + i ≡ 0 [MOD 4 * n]),
      not_le_of_gt ki $ nat.le_of_dvd (lt_of_lt_of_le ipos $ nat.le_add_left _ _) $
      modeq.modeq_zero_iff.1 $ (modeq.modeq_add jk.symm (modeq.refl i)).trans $
      modeq.modeq_of_dvd_of_modeq yd ji,
    by have : i % (4 * yn a1 i) = k % (4 * yn a1 i) :=
         (modeq.modeq_of_dvd_of_modeq yd ji).symm.trans jk;
       rwa [nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_left _ _) ki),
            nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_right _ _) ki)] at this
  end
end⟩⟩

lemma eq_pow_of_pell_lem {a y k} (a1 : 1 < a) (ypos : y > 0) : k > 0 → a > y^k →
  (↑(y^k) : ℤ) < 2*a*y - y*y - 1 :=
have y < a → 2*a*y ≥ a + (y*y + 1), begin
  intro ya, induction y with y IH, exact absurd ypos (lt_irrefl _),
  cases nat.eq_zero_or_pos y with y0 ypos,
  { rw y0, simp [two_mul], apply add_le_add_left, exact a1 },
  { rw [nat.mul_succ, nat.mul_succ, nat.succ_mul y],
    have : 2 * a ≥ y + nat.succ y,
    { change y + y < 2 * a, rw ← two_mul,
      exact mul_lt_mul_of_pos_left (nat.lt_of_succ_lt ya) dec_trivial },
    have := add_le_add (IH ypos (nat.lt_of_succ_lt ya)) this,
    simp at this, simp, exact this }
end, λk0 yak,
lt_of_lt_of_le (int.coe_nat_lt_coe_nat_of_lt yak) $
by rw sub_sub; apply le_sub_right_of_add_le;
   apply int.coe_nat_le_coe_nat_of_le;
   have y1 := nat.pow_le_pow_of_le_right ypos k0; simp at y1;
   exact this (lt_of_le_of_lt y1 yak)

theorem eq_pow_of_pell {m n k} : (n^k = m ↔
k = 0 ∧ m = 1 ∨ k > 0 ∧
(n = 0 ∧ m = 0 ∨ n > 0 ∧
∃ (w a t z : ℕ) (a1 : a > 1),
  xn a1 k ≡ yn a1 k * (a - n) + m [MOD t] ∧
  2 * a * n = t + (n * n + 1) ∧
  m < t ∧ n ≤ w ∧ k ≤ w ∧
  a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)) :=
⟨λe, by rw ← e;
  refine (nat.eq_zero_or_pos k).elim
    (λk0, by rw k0; exact or.inl ⟨rfl, rfl⟩)
    (λkpos, or.inr ⟨kpos, _⟩);
  refine (nat.eq_zero_or_pos n).elim
    (λn0, by rw [n0, nat.zero_pow kpos]; exact or.inl ⟨rfl, rfl⟩)
    (λnpos, or.inr ⟨npos, _⟩); exact
  let w := _root_.max n k in
  have nw : n ≤ w, from le_max_left _ _,
  have kw : k ≤ w, from le_max_right _ _,
  have wpos : w > 0, from lt_of_lt_of_le npos nw,
  have w1 : w + 1 > 1, from nat.succ_lt_succ wpos,
  let a := xn w1 w in
  have a1 : a > 1, from x_increasing w1 wpos,
  let x := xn a1 k, y := yn a1 k in
  let ⟨z, ze⟩ := show w ∣ yn w1 w, from modeq.modeq_zero_iff.1 $
    modeq.trans (yn_modeq_a_sub_one w1 w) (modeq.modeq_zero_iff.2 $ dvd_refl _) in
  have nt : (↑(n^k) : ℤ) < 2 * a * n - n * n - 1, from
    eq_pow_of_pell_lem a1 npos kpos $ calc
      n^k ≤ n^w       : nat.pow_le_pow_of_le_right npos kw
      ... < (w + 1)^w : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) wpos
      ... ≤ a         : xn_ge_a_pow w1 w,
  let ⟨t, te⟩ := int.eq_coe_of_zero_le $
    le_trans (int.coe_zero_le _) $ le_of_lt nt in
  have na : n ≤ a, from le_trans nw $ le_of_lt $ n_lt_xn w1 w,
  have tm : x ≡ y * (a - n) + n^k [MOD t], begin
    apply modeq.modeq_of_dvd,
    rw [int.coe_nat_add, int.coe_nat_mul, int.coe_nat_sub na, ← te],
    exact x_sub_y_dvd_pow a1 n k
  end,
  have ta : 2 * a * n = t + (n * n + 1), from int.coe_nat_inj $
    by rw [int.coe_nat_add, ← te, sub_sub];
       repeat {rw int.coe_nat_add <|> rw int.coe_nat_mul};
       rw [int.coe_nat_one, sub_add_cancel]; refl,
  have mt : n^k < t, from int.lt_of_coe_nat_lt_coe_nat $
    by rw ← te; exact nt,
  have zp : a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1,
    by rw ← ze; exact pell_eq w1 w,
  ⟨w, a, t, z, a1, tm, ta, mt, nw, kw, zp⟩,
λo, match o with
| or.inl ⟨k0, m1⟩ := by rw [k0, m1]; refl
| or.inr ⟨kpos, or.inl ⟨n0, m0⟩⟩ := by rw [n0, m0, nat.zero_pow kpos]
| or.inr ⟨kpos, or.inr ⟨npos, w, a, t, z,
   (a1 : a > 1),
   (tm : xn a1 k ≡ yn a1 k * (a - n) + m [MOD t]),
   (ta : 2 * a * n = t + (n * n + 1)),
   (mt : m < t),
   (nw : n ≤ w),
   (kw : k ≤ w),
   (zp : a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)⟩⟩ :=
  have wpos : w > 0, from lt_of_lt_of_le npos nw,
  have w1 : w + 1 > 1, from nat.succ_lt_succ wpos,
  let ⟨j, xj, yj⟩ := eq_pell w1 zp in
  by clear _match o _let_match; exact
  have jpos : j > 0, from (nat.eq_zero_or_pos j).resolve_left $ λj0,
    have a1 : a = 1, by rw j0 at xj; exact xj,
    have 2 * n = t + (n * n + 1), by rw a1 at ta; exact ta,
    have n1 : n = 1, from
      have n * n < n * 2, by rw [mul_comm n 2, this]; apply nat.le_add_left,
      have n ≤ 1, from nat.le_of_lt_succ $ lt_of_mul_lt_mul_left this (nat.zero_le _),
      le_antisymm this npos,
    by rw n1 at this;
      rw ← @nat.add_right_cancel 0 2 t this at mt;
      exact nat.not_lt_zero _ mt,
  have wj : w ≤ j, from nat.le_of_dvd jpos $ modeq.modeq_zero_iff.1 $
    (yn_modeq_a_sub_one w1 j).symm.trans $
    modeq.modeq_zero_iff.2 ⟨z, yj.symm⟩,
  have nt : (↑(n^k) : ℤ) < 2 * a * n - n * n - 1, from
    eq_pow_of_pell_lem a1 npos kpos $ calc
      n^k ≤ n^j       : nat.pow_le_pow_of_le_right npos (le_trans kw wj)
      ... < (w + 1)^j : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) jpos
      ... ≤ xn w1 j   : xn_ge_a_pow w1 j
      ... = a         : xj.symm,
  have na : n ≤ a, by rw xj; exact
    le_trans (le_trans nw wj) (le_of_lt $ n_lt_xn _ _),
  have te : (t : ℤ) = 2 * ↑a * ↑n - ↑n * ↑n - 1, by
    rw sub_sub; apply eq_sub_of_add_eq; apply (int.coe_nat_eq_coe_nat_iff _ _).2;
    exact ta.symm,
  have xn a1 k ≡ yn a1 k * (a - n) + n^k [MOD t],
    by have := x_sub_y_dvd_pow a1 n k;
       rw [← te, ← int.coe_nat_sub na] at this; exact modeq.modeq_of_dvd this,
  have n^k % t = m % t, from
    modeq.modeq_add_cancel_left (modeq.refl _) (this.symm.trans tm),
  by rw ← te at nt;
     rwa [nat.mod_eq_of_lt (int.lt_of_coe_nat_lt_coe_nat nt), nat.mod_eq_of_lt mt] at this
end⟩

end pell


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_432
  (x : ℝ) :
  (x + 3) * (2 * x - 6) = 2 * x^2 - 18 :=
begin
  linarith,
end