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

! This file was ported from Lean 3 source module data.real.pi.bounds
! leanprover-community/mathlib commit 402f8982dddc1864bd703da2d6e2ee304a866973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Bounds

/-!
# Pi

This file contains lemmas which establish bounds on `real.pi`.
Notably, these include `pi_gt_sqrt_two_add_series` and `pi_lt_sqrt_two_add_series`,
which bound `π` using series;
numerical bounds on `π` such as `pi_gt_314`and `pi_lt_315` (more precise versions are given, too).

See also `data.real.pi.leibniz` and `data.real.pi.wallis` for infinite formulas for `π`.
-/

open Real

namespace Real

theorem pi_gt_sqrtTwoAddSeries (n : ℕ) : 2 ^ (n + 1) * sqrt (2 - sqrtTwoAddSeries 0 n) < π :=
  by
  have : sqrt (2 - sqrt_two_add_series 0 n) / 2 * 2 ^ (n + 2) < π :=
    by
    rw [← lt_div_iff, ← sin_pi_over_two_pow_succ]
    apply sin_lt
    apply div_pos pi_pos
    all_goals apply pow_pos; norm_num
  apply lt_of_le_of_lt (le_of_eq _) this
  rw [pow_succ _ (n + 1), ← mul_assoc, div_mul_cancel, mul_comm]
  norm_num
#align real.pi_gt_sqrt_two_add_series Real.pi_gt_sqrtTwoAddSeries

theorem pi_lt_sqrtTwoAddSeries (n : ℕ) :
    π < 2 ^ (n + 1) * sqrt (2 - sqrtTwoAddSeries 0 n) + 1 / 4 ^ n :=
  by
  have : π < (sqrt (2 - sqrt_two_add_series 0 n) / 2 + 1 / (2 ^ n) ^ 3 / 4) * 2 ^ (n + 2) :=
    by
    rw [← div_lt_iff, ← sin_pi_over_two_pow_succ]
    refine' lt_of_lt_of_le (lt_add_of_sub_right_lt (sin_gt_sub_cube _ _)) _
    · apply div_pos pi_pos
      apply pow_pos
      norm_num
    · rw [div_le_iff']
      · refine' le_trans pi_le_four _
        simp only [show (4 : ℝ) = 2 ^ 2 by norm_num, mul_one]
        apply pow_le_pow
        norm_num
        apply le_add_of_nonneg_left
        apply Nat.zero_le
      · apply pow_pos
        norm_num
    apply add_le_add_left
    rw [div_le_div_right]
    rw [le_div_iff, ← mul_pow]
    refine' le_trans _ (le_of_eq (one_pow 3))
    apply pow_le_pow_of_le_left
    · apply le_of_lt
      apply mul_pos
      apply div_pos pi_pos
      apply pow_pos
      norm_num
      apply pow_pos
      norm_num
    rw [← le_div_iff]
    refine' le_trans ((div_le_div_right _).mpr pi_le_four) _
    apply pow_pos
    norm_num
    rw [pow_succ, pow_succ, ← mul_assoc, ← div_div]
    convert le_rfl
    all_goals repeat' apply pow_pos; norm_num
  apply lt_of_lt_of_le this (le_of_eq _)
  rw [add_mul]
  congr 1
  · rw [pow_succ _ (n + 1), ← mul_assoc, div_mul_cancel, mul_comm]
    norm_num
  rw [pow_succ, ← pow_mul, mul_comm n 2, pow_mul, show (2 : ℝ) ^ 2 = 4 by norm_num, pow_succ,
    pow_succ, ← mul_assoc (2 : ℝ), show (2 : ℝ) * 2 = 4 by norm_num, ← mul_assoc, div_mul_cancel,
    mul_comm ((2 : ℝ) ^ n), ← div_div, div_mul_cancel]
  apply pow_ne_zero
  norm_num
  norm_num
#align real.pi_lt_sqrt_two_add_series Real.pi_lt_sqrtTwoAddSeries

/-- From an upper bound on `sqrt_two_add_series 0 n = 2 cos (π / 2 ^ (n+1))` of the form
`sqrt_two_add_series 0 n ≤ 2 - (a / 2 ^ (n + 1)) ^ 2)`, one can deduce the lower bound `a < π`
thanks to basic trigonometric inequalities as expressed in `pi_gt_sqrt_two_add_series`. -/
theorem pi_lower_bound_start (n : ℕ) {a}
    (h : sqrtTwoAddSeries ((0 : ℕ) / (1 : ℕ)) n ≤ 2 - (a / 2 ^ (n + 1)) ^ 2) : a < π :=
  by
  refine' lt_of_le_of_lt _ (pi_gt_sqrt_two_add_series n); rw [mul_comm]
  refine' (div_le_iff (pow_pos (by norm_num) _ : (0 : ℝ) < _)).mp (le_sqrt_of_sq_le _)
  rwa [le_sub_comm, show (0 : ℝ) = (0 : ℕ) / (1 : ℕ) by rw [Nat.cast_zero, zero_div]]
#align real.pi_lower_bound_start Real.pi_lower_bound_start

theorem sqrtTwoAddSeries_step_up (c d : ℕ) {a b n : ℕ} {z : ℝ} (hz : sqrtTwoAddSeries (c / d) n ≤ z)
    (hb : 0 < b) (hd : 0 < d) (h : (2 * b + a) * d ^ 2 ≤ c ^ 2 * b) :
    sqrtTwoAddSeries (a / b) (n + 1) ≤ z :=
  by
  refine' le_trans _ hz; rw [sqrt_two_add_series_succ]; apply sqrt_two_add_series_monotone_left
  have hb' : 0 < (b : ℝ) := Nat.cast_pos.2 hb
  have hd' : 0 < (d : ℝ) := Nat.cast_pos.2 hd
  rw [sqrt_le_left (div_nonneg c.cast_nonneg d.cast_nonneg), div_pow,
    add_div_eq_mul_add_div _ _ (ne_of_gt hb'), div_le_div_iff hb' (pow_pos hd' _)]
  exact_mod_cast h
#align real.sqrt_two_add_series_step_up Real.sqrtTwoAddSeries_step_up

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Create a proof of `a < π` for a fixed rational number `a`, given a witness, which is a
sequence of rational numbers `sqrt 2 < r 1 < r 2 < ... < r n < 2` satisfying the property that
`sqrt (2 + r i) ≤ r(i+1)`, where `r 0 = 0` and `sqrt (2 - r n) ≥ a/2^(n+1)`. -/
unsafe def pi_lower_bound (l : List ℚ) : tactic Unit := do
  let n := l.length
  tactic.apply q(@pi_lower_bound_start $(reflect n))
  l fun r => do
      let a := r
      let b := r
      andthen (() <$ tactic.apply q(@sqrtTwoAddSeries_step_up $(reflect a) $(reflect b)))
          [tactic.skip, sorry, sorry, sorry]
  sorry
  sorry
#align real.pi_lower_bound real.pi_lower_bound

/-- From a lower bound on `sqrt_two_add_series 0 n = 2 cos (π / 2 ^ (n+1))` of the form
`2 - ((a - 1 / 4 ^ n) / 2 ^ (n + 1)) ^ 2 ≤ sqrt_two_add_series 0 n`, one can deduce the upper bound
`π < a` thanks to basic trigonometric formulas as expressed in `pi_lt_sqrt_two_add_series`. -/
theorem pi_upper_bound_start (n : ℕ) {a}
    (h : 2 - ((a - 1 / 4 ^ n) / 2 ^ (n + 1)) ^ 2 ≤ sqrtTwoAddSeries ((0 : ℕ) / (1 : ℕ)) n)
    (h₂ : 1 / 4 ^ n ≤ a) : π < a :=
  by
  refine' lt_of_lt_of_le (pi_lt_sqrt_two_add_series n) _
  rw [← le_sub_iff_add_le, ← le_div_iff', sqrt_le_left, sub_le_comm]
  · rwa [Nat.cast_zero, zero_div] at h
  · exact div_nonneg (sub_nonneg.2 h₂) (pow_nonneg (le_of_lt zero_lt_two) _)
  · exact pow_pos zero_lt_two _
#align real.pi_upper_bound_start Real.pi_upper_bound_start

theorem sqrtTwoAddSeries_step_down (a b : ℕ) {c d n : ℕ} {z : ℝ}
    (hz : z ≤ sqrtTwoAddSeries (a / b) n) (hb : 0 < b) (hd : 0 < d)
    (h : a ^ 2 * d ≤ (2 * d + c) * b ^ 2) : z ≤ sqrtTwoAddSeries (c / d) (n + 1) :=
  by
  apply le_trans hz; rw [sqrt_two_add_series_succ]; apply sqrt_two_add_series_monotone_left
  apply le_sqrt_of_sq_le
  have hb' : 0 < (b : ℝ) := Nat.cast_pos.2 hb
  have hd' : 0 < (d : ℝ) := Nat.cast_pos.2 hd
  rw [div_pow, add_div_eq_mul_add_div _ _ (ne_of_gt hd'), div_le_div_iff (pow_pos hb' _) hd']
  exact_mod_cast h
#align real.sqrt_two_add_series_step_down Real.sqrtTwoAddSeries_step_down

/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/- ./././Mathport/Syntax/Translate/Expr.lean:330:4: warning: unsupported (TODO): `[tacs] -/
/-- Create a proof of `π < a` for a fixed rational number `a`, given a witness, which is a
sequence of rational numbers `sqrt 2 < r 1 < r 2 < ... < r n < 2` satisfying the property that
`sqrt (2 + r i) ≥ r(i+1)`, where `r 0 = 0` and `sqrt (2 - r n) ≥ (a - 1/4^n) / 2^(n+1)`. -/
unsafe def pi_upper_bound (l : List ℚ) : tactic Unit := do
  let n := l.length
  andthen (() <$ tactic.apply q(@pi_upper_bound_start $(reflect n))) [pure (), sorry]
  l fun r => do
      let a := r
      let b := r
      andthen (() <$ tactic.apply q(@sqrtTwoAddSeries_step_down $(reflect a) $(reflect b)))
          [pure (), sorry, sorry, sorry]
  sorry
  sorry
#align real.pi_upper_bound real.pi_upper_bound

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic real.pi_lower_bound -/
theorem pi_gt_three : 3 < π := by
  run_tac
    pi_lower_bound [23 / 16]
#align real.pi_gt_three Real.pi_gt_three

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic real.pi_lower_bound -/
theorem pi_gt_314 : 3.14 < π := by
  run_tac
    pi_lower_bound [99 / 70, 874 / 473, 1940 / 989, 1447 / 727]
#align real.pi_gt_314 Real.pi_gt_314

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic real.pi_upper_bound -/
theorem pi_lt_315 : π < 3.15 := by
  run_tac
    pi_upper_bound [140 / 99, 279 / 151, 51 / 26, 412 / 207]
#align real.pi_lt_315 Real.pi_lt_315

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic real.pi_lower_bound -/
theorem pi_gt_31415 : 3.1415 < π := by
  run_tac
    pi_lower_bound
        [11482 / 8119, 5401 / 2923, 2348 / 1197, 11367 / 5711, 25705 / 12868, 23235 / 11621]
#align real.pi_gt_31415 Real.pi_gt_31415

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic real.pi_upper_bound -/
theorem pi_lt_31416 : π < 3.1416 := by
  run_tac
    pi_upper_bound
        [4756 / 3363, 101211 / 54775, 505534 / 257719, 83289 / 41846, 411278 / 205887,
          438142 / 219137, 451504 / 225769, 265603 / 132804, 849938 / 424971]
#align real.pi_lt_31416 Real.pi_lt_31416

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic real.pi_lower_bound -/
theorem pi_gt_3141592 : 3.141592 < π := by
  run_tac
    pi_lower_bound
        [11482 / 8119, 7792 / 4217, 54055 / 27557, 949247 / 476920, 3310126 / 1657059,
          2635492 / 1318143, 1580265 / 790192, 1221775 / 610899, 3612247 / 1806132, 849943 / 424972]
#align real.pi_gt_3141592 Real.pi_gt_3141592

/- ./././Mathport/Syntax/Translate/Tactic/Builtin.lean:69:18: unsupported non-interactive tactic real.pi_upper_bound -/
theorem pi_lt_3141593 : π < 3.141593 := by
  run_tac
    pi_upper_bound
        [27720 / 19601, 56935 / 30813, 49359 / 25163, 258754 / 130003, 113599 / 56868,
          1101994 / 551163, 8671537 / 4336095, 3877807 / 1938940, 52483813 / 26242030,
          56946167 / 28473117, 23798415 / 11899211]
#align real.pi_lt_3141593 Real.pi_lt_3141593

end Real


import data.finset.basic
import tactic

variables {X : Type*} [fintype X] [decidable_eq X]

namespace finset

open finset

lemma card_erase_of_mem' {A : finset X} {x} (h : x ∈ A) : (A.erase x).card + 1 = A.card :=
begin
  rw [card_erase_of_mem h, nat.add_one, nat.succ_pred_eq_of_pos],
  rw [gt_iff_lt, pos_iff_ne_zero],
  exact card_ne_zero_of_mem h,
end

lemma sdiff_subset_erase_of_mem {A B : finset X} {x} : x ∈ B → A \ B ⊆ A.erase x :=
begin
  intros xB,
  rw [← sdiff_singleton_eq_erase x A],
  apply sdiff_subset_sdiff (subset.refl _) _,
  rwa singleton_subset_iff,
end

lemma eq_or_ssubset_of_subset {A B : finset X} (h : A ⊆ B) : A = B ∨ A ⊂ B :=
begin
  rwa [← le_iff_subset, le_iff_eq_or_lt] at h,
end

lemma union_singleton {A : finset X} {x : X} : {x} ∪ A  = insert x A :=
begin
  exact (insert_eq x A).symm,
end

lemma card_succ_iff_erase_mem {A B : finset X} (h : A ⊆ B) :
  B.card = A.card + 1 ↔ ∃ x ∈ B, A = B.erase x :=
begin
  split, {
    intro h_card,
    have hC : (B \ A).card = 1, from by {
      rw [card_sdiff h],
      exact nat.sub_eq_of_eq_add h_card,
    },
    obtain ⟨x, h_sing⟩ := card_eq_one.1 hC,
    use x,
    have hx : x ∈ B \ A, by simp only [h_sing, mem_singleton],
    rw mem_sdiff at hx,
    use hx.1,
    rw [←sdiff_union_of_subset h, h_sing, ←insert_eq, erase_insert hx.2],
  }, {
    rintro ⟨x, xB, rfl⟩,
    exact (card_erase_of_mem' xB).symm,
  }
end

lemma very_important_lemma {A B S : finset X} :
  (A ∩ B) ⊆ S → S ⊆ (A ∪ B) → (A ∪ B).card = S.card + 1 → (A ⊆ S ∨ B ⊆ S) :=
begin
  intros ABS SAB Scard,
  obtain ⟨x, xUnion, rfl⟩ := (card_succ_iff_erase_mem SAB).1 Scard,
  rw mem_union at xUnion,
  wlog xA : x ∈ A := xUnion using [A B, B A],
  right,
  have xInter : x ∉ A ∩ B := λ h, not_mem_erase _ _ (ABS h),
  have xB : x ∉ B := λ h, xInter $ mem_inter_of_mem xA h,
  nth_rewrite 0 ← (erase_eq_of_not_mem xB),
  exact erase_subset_erase _ (subset_union_right _ _),
end

lemma eq_or_eq_succ_of_le_and_le_succ {x y : ℕ}: x ≤ y → y ≤ x + 1 → x = y ∨ x + 1 = y :=
begin
  intros hxy hyx1,
  cases le_iff_lt_or_eq.1 hxy, {
    right,
    linarith,
  }, {
    left, exact h,
  }
end

lemma not_mem_sdiff_iff {x : X} {A B : finset X} : x ∉ A \ B ↔ x ∉ A ∨ x ∈ B :=
begin
  rw not_iff_comm,
  push_neg,
  simp only [mem_sdiff, iff_self],
end

lemma card_sdiff_ℤ {A B : finset X} (hAB : A ⊆ B) : ((B \ A).card : ℤ) = (B.card : ℤ) - (A.card : ℤ) :=
begin
  suffices h : (B \ A).card + A.card = B.card, {
    linarith,
  },
  rw [card_sdiff hAB, nat.sub_add_cancel (card_le_of_subset hAB)],
end

end finset


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.associated
import ring_theory.int.basic
import tactic.ring

/-! # ℤ[√d]

The ring of integers adjoined with a square root of `d : ℤ`.

After defining the norm, we show that it is a linearly ordered commutative ring,
as well as an integral domain.

We provide the universal property, that ring homomorphisms `ℤ√d →+* R` correspond
to choices of square roots of `d` in `R`.

-/

/-- The ring of integers adjoined with a square root of `d`.
  These have the form `a + b √d` where `a b : ℤ`. The components
  are called `re` and `im` by analogy to the negative `d` case. -/
structure zsqrtd (d : ℤ) :=
(re : ℤ)
(im : ℤ)

prefix `ℤ√`:100 := zsqrtd

namespace zsqrtd
section
parameters {d : ℤ}

instance : decidable_eq ℤ√d :=
by tactic.mk_dec_eq_instance

theorem ext : ∀ {z w : ℤ√d}, z = w ↔ z.re = w.re ∧ z.im = w.im
| ⟨x, y⟩ ⟨x', y'⟩ := ⟨λ h, by injection h; split; assumption,
                      λ ⟨h₁, h₂⟩, by congr; assumption⟩

/-- Convert an integer to a `ℤ√d` -/
def of_int (n : ℤ) : ℤ√d := ⟨n, 0⟩
theorem of_int_re (n : ℤ) : (of_int n).re = n := rfl
theorem of_int_im (n : ℤ) : (of_int n).im = 0 := rfl

/-- The zero of the ring -/
instance : has_zero ℤ√d := ⟨of_int 0⟩
@[simp] theorem zero_re : (0 : ℤ√d).re = 0 := rfl
@[simp] theorem zero_im : (0 : ℤ√d).im = 0 := rfl

instance : inhabited ℤ√d := ⟨0⟩

/-- The one of the ring -/
instance : has_one ℤ√d := ⟨of_int 1⟩
@[simp] theorem one_re : (1 : ℤ√d).re = 1 := rfl
@[simp] theorem one_im : (1 : ℤ√d).im = 0 := rfl

/-- The representative of `√d` in the ring -/
def sqrtd : ℤ√d := ⟨0, 1⟩
@[simp] theorem sqrtd_re : (sqrtd : ℤ√d).re = 0 := rfl
@[simp] theorem sqrtd_im : (sqrtd : ℤ√d).im = 1 := rfl

/-- Addition of elements of `ℤ√d` -/
instance : has_add ℤ√d := ⟨λ z w, ⟨z.1 + w.1, z.2 + w.2⟩⟩
@[simp] lemma add_def (x y x' y' : ℤ) : (⟨x, y⟩ + ⟨x', y'⟩ : ℤ√d) = ⟨x + x', y + y'⟩ := rfl
@[simp] lemma add_re (z w : ℤ√d) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℤ√d) : (z + w).im = z.im + w.im := rfl

@[simp] lemma bit0_re (z) : (bit0 z : ℤ√d).re = bit0 z.re := rfl
@[simp] lemma bit0_im (z) : (bit0 z : ℤ√d).im = bit0 z.im := rfl

@[simp] theorem bit1_re (z) : (bit1 z : ℤ√d).re = bit1 z.re := rfl
@[simp] theorem bit1_im (z) : (bit1 z : ℤ√d).im = bit0 z.im := by simp [bit1]

/-- Negation in `ℤ√d` -/
instance : has_neg ℤ√d := ⟨λ z, ⟨-z.1, -z.2⟩⟩
@[simp] lemma neg_re (z : ℤ√d) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℤ√d) : (-z).im = -z.im := rfl

/-- Multiplication in `ℤ√d` -/
instance : has_mul ℤ√d := ⟨λ z w, ⟨z.1 * w.1 + d * z.2 * w.2, z.1 * w.2 + z.2 * w.1⟩⟩
@[simp] lemma mul_re (z w : ℤ√d) : (z * w).re = z.re * w.re + d * z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℤ√d) : (z * w).im = z.re * w.im + z.im * w.re := rfl

instance : add_comm_group ℤ√d :=
by refine_struct
{ add            := (+),
  zero           := (0 : ℤ√d),
  sub            := λ a b, a + -b,
  neg            := has_neg.neg,
  zsmul          := @zsmul_rec (ℤ√d) ⟨0⟩ ⟨(+)⟩ ⟨has_neg.neg⟩,
  nsmul          := @nsmul_rec (ℤ√d) ⟨0⟩ ⟨(+)⟩ };
intros; try { refl }; simp [ext, add_comm, add_left_comm]

instance : add_group_with_one ℤ√d :=
{ nat_cast := λ n, of_int n,
  int_cast := of_int,
  one := 1,
  .. zsqrtd.add_comm_group }

instance : comm_ring ℤ√d :=
by refine_struct
{ add            := (+),
  zero           := (0 : ℤ√d),
  mul            := (*),
  one            := 1,
  npow           := @npow_rec (ℤ√d) ⟨1⟩ ⟨(*)⟩,
  .. zsqrtd.add_group_with_one };
intros; try { refl }; simp [ext, add_mul, mul_add, add_comm, add_left_comm, mul_comm, mul_left_comm]

instance : add_monoid ℤ√d         := by apply_instance
instance : monoid ℤ√d             := by apply_instance
instance : comm_monoid ℤ√d        := by apply_instance
instance : comm_semigroup ℤ√d     := by apply_instance
instance : semigroup ℤ√d          := by apply_instance
instance : add_comm_semigroup ℤ√d := by apply_instance
instance : add_semigroup ℤ√d      := by apply_instance
instance : comm_semiring ℤ√d      := by apply_instance
instance : semiring ℤ√d           := by apply_instance
instance : ring ℤ√d               := by apply_instance
instance : distrib ℤ√d            := by apply_instance

/-- Conjugation in `ℤ√d`. The conjugate of `a + b √d` is `a - b √d`. -/
def conj (z : ℤ√d) : ℤ√d := ⟨z.1, -z.2⟩
@[simp] lemma conj_re (z : ℤ√d) : (conj z).re = z.re := rfl
@[simp] lemma conj_im (z : ℤ√d) : (conj z).im = -z.im := rfl

/-- `conj` as an `add_monoid_hom`. -/
def conj_hom : ℤ√d →+ ℤ√d :=
{ to_fun := conj,
  map_add' := λ ⟨a, ai⟩ ⟨b, bi⟩, ext.mpr ⟨rfl, neg_add _ _⟩,
  map_zero' := ext.mpr ⟨rfl, neg_zero⟩ }

@[simp] lemma conj_zero : conj (0 : ℤ√d) = 0 :=
conj_hom.map_zero

@[simp] lemma conj_one : conj (1 : ℤ√d) = 1 :=
by simp only [zsqrtd.ext, zsqrtd.conj_re, zsqrtd.conj_im, zsqrtd.one_im, neg_zero, eq_self_iff_true,
  and_self]

@[simp] lemma conj_neg (x : ℤ√d) : (-x).conj = -x.conj := rfl

@[simp] lemma conj_add (x y : ℤ√d) : (x + y).conj = x.conj + y.conj :=
conj_hom.map_add x y

@[simp] lemma conj_sub (x y : ℤ√d) : (x - y).conj = x.conj - y.conj :=
conj_hom.map_sub x y

@[simp] lemma conj_conj {d : ℤ} (x : ℤ√d) : x.conj.conj = x :=
by simp only [ext, true_and, conj_re, eq_self_iff_true, neg_neg, conj_im]

instance : nontrivial ℤ√d :=
⟨⟨0, 1, dec_trivial⟩⟩

@[simp] theorem coe_nat_re (n : ℕ) : (n : ℤ√d).re = n := rfl
@[simp] theorem coe_nat_im (n : ℕ) : (n : ℤ√d).im = 0 := rfl
theorem coe_nat_val (n : ℕ) : (n : ℤ√d) = ⟨n, 0⟩ := rfl

@[simp] theorem coe_int_re (n : ℤ) : (n : ℤ√d).re = n :=
by cases n; refl
@[simp] theorem coe_int_im (n : ℤ) : (n : ℤ√d).im = 0 :=
by cases n; refl
theorem coe_int_val (n : ℤ) : (n : ℤ√d) = ⟨n, 0⟩ :=
by simp [ext]

instance : char_zero ℤ√d :=
{ cast_injective := λ m n, by simp [ext] }

@[simp] theorem of_int_eq_coe (n : ℤ) : (of_int n : ℤ√d) = n :=
by simp [ext, of_int_re, of_int_im]

@[simp] theorem smul_val (n x y : ℤ) : (n : ℤ√d) * ⟨x, y⟩ = ⟨n * x, n * y⟩ :=
by simp [ext]

theorem smul_re (a : ℤ) (b : ℤ√d) : (↑a * b).re = a * b.re := by simp
theorem smul_im (a : ℤ) (b : ℤ√d) : (↑a * b).im = a * b.im := by simp

@[simp] theorem muld_val (x y : ℤ) : sqrtd * ⟨x, y⟩ = ⟨d * y, x⟩ :=
by simp [ext]

@[simp] theorem dmuld : sqrtd * sqrtd = d :=
by simp [ext]

@[simp] theorem smuld_val (n x y : ℤ) : sqrtd * (n : ℤ√d) * ⟨x, y⟩ = ⟨d * n * y, n * x⟩ :=
by simp [ext]

theorem decompose {x y : ℤ} : (⟨x, y⟩ : ℤ√d) = x + sqrtd * y :=
by simp [ext]

theorem mul_conj {x y : ℤ} : (⟨x, y⟩ * conj ⟨x, y⟩ : ℤ√d) = x * x - d * y * y :=
by simp [ext, sub_eq_add_neg, mul_comm]

theorem conj_mul {a b : ℤ√d} : conj (a * b) = conj a * conj b :=
by { simp [ext], ring }

protected lemma coe_int_add (m n : ℤ) : (↑(m + n) : ℤ√d) = ↑m + ↑n :=
(int.cast_ring_hom _).map_add _ _
protected lemma coe_int_sub (m n : ℤ) : (↑(m - n) : ℤ√d) = ↑m - ↑n :=
(int.cast_ring_hom _).map_sub _ _
protected lemma coe_int_mul (m n : ℤ) : (↑(m * n) : ℤ√d) = ↑m * ↑n :=
(int.cast_ring_hom _).map_mul _ _
protected lemma coe_int_inj {m n : ℤ} (h : (↑m : ℤ√d) = ↑n) : m = n :=
by simpa using congr_arg re h

@[simp, norm_cast]
lemma coe_int_dvd_coe_int (a b : ℤ) : (a : ℤ√d) ∣ b ↔ a ∣ b :=
begin
  rw coe_int_dvd_iff,
  split,
  { rintro ⟨hre, -⟩,
    rwa [coe_int_re] at hre },
  { rw [coe_int_re, coe_int_im],
    exact λ hc, ⟨hc, dvd_zero a⟩ },
end

protected lemma eq_of_smul_eq_smul_left {a : ℤ} {b c : ℤ√d}
  (ha : a ≠ 0) (h : ↑a * b = a * c) : b = c :=
begin
  rw ext at h ⊢,
  apply and.imp _ _ h;
  { simp only [smul_re, smul_im],
    exact int.eq_of_mul_eq_mul_left ha },
end

section gcd

lemma gcd_eq_zero_iff (a : ℤ√d) : int.gcd a.re a.im = 0 ↔ a = 0 :=
by simp only [int.gcd_eq_zero_iff, ext, eq_self_iff_true, zero_im, zero_re]

lemma gcd_pos_iff (a : ℤ√d) : 0 < int.gcd a.re a.im ↔ a ≠ 0 :=
pos_iff_ne_zero.trans $ not_congr a.gcd_eq_zero_iff

lemma coprime_of_dvd_coprime {a b : ℤ√d} (hcoprime : is_coprime a.re a.im) (hdvd : b ∣ a) :
  is_coprime b.re b.im :=
begin
  apply is_coprime_of_dvd,
  { rintro ⟨hre, him⟩,
    obtain rfl : b = 0,
    { simp only [ext, hre, eq_self_iff_true, zero_im, him, and_self, zero_re] },
    rw zero_dvd_iff at hdvd,
    simpa only [hdvd, zero_im, zero_re, not_coprime_zero_zero] using hcoprime },
  { intros z hz hznezero hzdvdu hzdvdv,
    apply hz,
    obtain ⟨ha, hb⟩ : z ∣ a.re ∧ z ∣ a.im,
    { rw ←coe_int_dvd_iff,
      apply dvd_trans _ hdvd,
      rw coe_int_dvd_iff,
      exact ⟨hzdvdu, hzdvdv⟩ },
    exact hcoprime.is_unit_of_dvd' ha hb },
end

lemma exists_coprime_of_gcd_pos {a : ℤ√d} (hgcd : 0 < int.gcd a.re a.im) :
  ∃ b : ℤ√d, a = ((int.gcd a.re a.im : ℤ) : ℤ√d) * b ∧ is_coprime b.re b.im :=
begin
  obtain ⟨re, im, H1, Hre, Him⟩ := int.exists_gcd_one hgcd,
  rw [mul_comm] at Hre Him,
  refine ⟨⟨re, im⟩, _, _⟩,
  { rw [smul_val, ext, ←Hre, ←Him], split; refl },
  { rw [←int.gcd_eq_one_iff_coprime, H1] }
end

end gcd

/-- Read `sq_le a c b d` as `a √c ≤ b √d` -/
def sq_le (a c b d : ℕ) : Prop := c*a*a ≤ d*b*b

theorem sq_le_of_le {c d x y z w : ℕ} (xz : z ≤ x) (yw : y ≤ w) (xy : sq_le x c y d) :
  sq_le z c w d :=
le_trans (mul_le_mul (nat.mul_le_mul_left _ xz) xz (nat.zero_le _) (nat.zero_le _)) $
  le_trans xy (mul_le_mul (nat.mul_le_mul_left _ yw) yw (nat.zero_le _) (nat.zero_le _))

theorem sq_le_add_mixed {c d x y z w : ℕ} (xy : sq_le x c y d) (zw : sq_le z c w d) :
  c * (x * z) ≤ d * (y * w) :=
nat.mul_self_le_mul_self_iff.2 $
by simpa [mul_comm, mul_left_comm] using
   mul_le_mul xy zw (nat.zero_le _) (nat.zero_le _)

theorem sq_le_add {c d x y z w : ℕ} (xy : sq_le x c y d) (zw : sq_le z c w d) :
  sq_le (x + z) c (y + w) d :=
begin
  have xz := sq_le_add_mixed xy zw,
  simp [sq_le, mul_assoc] at xy zw,
  simp [sq_le, mul_add, mul_comm, mul_left_comm, add_le_add, *]
end

theorem sq_le_cancel {c d x y z w : ℕ} (zw : sq_le y d x c) (h : sq_le (x + z) c (y + w) d) :
  sq_le z c w d :=
begin
  apply le_of_not_gt,
  intro l,
  refine not_le_of_gt _ h,
  simp [sq_le, mul_add, mul_comm, mul_left_comm, add_assoc],
  have hm := sq_le_add_mixed zw (le_of_lt l),
  simp [sq_le, mul_assoc] at l zw,
  exact lt_of_le_of_lt (add_le_add_right zw _)
    (add_lt_add_left (add_lt_add_of_le_of_lt hm (add_lt_add_of_le_of_lt hm l)) _)
end

theorem sq_le_smul {c d x y : ℕ} (n : ℕ) (xy : sq_le x c y d) : sq_le (n * x) c (n * y) d :=
by simpa [sq_le, mul_left_comm, mul_assoc] using
   nat.mul_le_mul_left (n * n) xy

theorem sq_le_mul {d x y z w : ℕ} :
  (sq_le x 1 y d → sq_le z 1 w d → sq_le (x * w + y * z) d (x * z + d * y * w) 1) ∧
  (sq_le x 1 y d → sq_le w d z 1 → sq_le (x * z + d * y * w) 1 (x * w + y * z) d) ∧
  (sq_le y d x 1 → sq_le z 1 w d → sq_le (x * z + d * y * w) 1 (x * w + y * z) d) ∧
  (sq_le y d x 1 → sq_le w d z 1 → sq_le (x * w + y * z) d (x * z + d * y * w) 1) :=
by refine ⟨_, _, _, _⟩;
{ intros xy zw,
  have := int.mul_nonneg (sub_nonneg_of_le (int.coe_nat_le_coe_nat_of_le xy))
                         (sub_nonneg_of_le (int.coe_nat_le_coe_nat_of_le zw)),
  refine int.le_of_coe_nat_le_coe_nat (le_of_sub_nonneg _),
  convert this,
  simp only [one_mul, int.coe_nat_add, int.coe_nat_mul],
  ring }

/-- "Generalized" `nonneg`. `nonnegg c d x y` means `a √c + b √d ≥ 0`;
  we are interested in the case `c = 1` but this is more symmetric -/
def nonnegg (c d : ℕ) : ℤ → ℤ → Prop
| (a : ℕ) (b : ℕ) := true
| (a : ℕ) -[1+ b] := sq_le (b+1) c a d
| -[1+ a] (b : ℕ) := sq_le (a+1) d b c
| -[1+ a] -[1+ b] := false

theorem nonnegg_comm {c d : ℕ} {x y : ℤ} : nonnegg c d x y = nonnegg d c y x :=
by induction x; induction y; refl

theorem nonnegg_neg_pos {c d} : Π {a b : ℕ}, nonnegg c d (-a) b ↔ sq_le a d b c
| 0     b := ⟨by simp [sq_le, nat.zero_le], λa, trivial⟩
| (a+1) b := by rw ← int.neg_succ_of_nat_coe; refl

theorem nonnegg_pos_neg {c d} {a b : ℕ} : nonnegg c d a (-b) ↔ sq_le b c a d :=
by rw nonnegg_comm; exact nonnegg_neg_pos

theorem nonnegg_cases_right {c d} {a : ℕ} :
  Π {b : ℤ}, (Π x : ℕ, b = -x → sq_le x c a d) → nonnegg c d a b
| (b:nat) h := trivial
| -[1+ b] h := h (b+1) rfl

theorem nonnegg_cases_left {c d} {b : ℕ} {a : ℤ} (h : Π x : ℕ, a = -x → sq_le x d b c) :
  nonnegg c d a b :=
cast nonnegg_comm (nonnegg_cases_right h)

section norm

/-- The norm of an element of `ℤ[√d]`. -/
def norm (n : ℤ√d) : ℤ := n.re * n.re - d * n.im * n.im
lemma norm_def (n : ℤ√d) : n.norm = n.re * n.re - d * n.im * n.im := rfl

@[simp] lemma norm_zero : norm 0 = 0 := by simp [norm]

@[simp] lemma norm_one : norm 1 = 1 := by simp [norm]

@[simp] lemma norm_int_cast (n : ℤ) : norm n = n * n := by simp [norm]

@[simp] lemma norm_nat_cast (n : ℕ) : norm n = n * n := norm_int_cast n

@[simp] lemma norm_mul (n m : ℤ√d) : norm (n * m) = norm n * norm m :=
by { simp only [norm, mul_im, mul_re], ring }

/-- `norm` as a `monoid_hom`. -/
def norm_monoid_hom : ℤ√d →* ℤ :=
{ to_fun := norm,
  map_mul' := norm_mul,
  map_one' := norm_one }

lemma norm_eq_mul_conj (n : ℤ√d) : (norm n : ℤ√d) = n * n.conj :=
by cases n; simp [norm, conj, zsqrtd.ext, mul_comm, sub_eq_add_neg]

@[simp] lemma norm_neg (x : ℤ√d) : (-x).norm = x.norm :=
coe_int_inj $ by simp only [norm_eq_mul_conj, conj_neg, neg_mul,
  mul_neg, neg_neg]

@[simp] lemma norm_conj (x : ℤ√d) : x.conj.norm = x.norm :=
coe_int_inj $ by simp only [norm_eq_mul_conj, conj_conj, mul_comm]

lemma norm_nonneg (hd : d ≤ 0) (n : ℤ√d) : 0 ≤ n.norm :=
add_nonneg (mul_self_nonneg _)
  (by rw [mul_assoc, neg_mul_eq_neg_mul];
    exact (mul_nonneg (neg_nonneg.2 hd) (mul_self_nonneg _)))

lemma norm_eq_one_iff {x : ℤ√d} : x.norm.nat_abs = 1 ↔ is_unit x :=
⟨λ h, is_unit_iff_dvd_one.2 $
  (le_total 0 (norm x)).cases_on
    (λ hx, show x ∣ 1, from ⟨x.conj,
      by rwa [← int.coe_nat_inj', int.nat_abs_of_nonneg hx,
        ← @int.cast_inj (ℤ√d) _ _, norm_eq_mul_conj, eq_comm] at h⟩)
    (λ hx, show x ∣ 1, from ⟨- x.conj,
      by rwa [← int.coe_nat_inj', int.of_nat_nat_abs_of_nonpos hx,
        ← @int.cast_inj (ℤ√d) _ _, int.cast_neg, norm_eq_mul_conj, neg_mul_eq_mul_neg,
        eq_comm] at h⟩),
λ h, let ⟨y, hy⟩ := is_unit_iff_dvd_one.1 h in begin
  have := congr_arg (int.nat_abs ∘ norm) hy,
  rw [function.comp_app, function.comp_app, norm_mul, int.nat_abs_mul,
    norm_one, int.nat_abs_one, eq_comm, nat.mul_eq_one_iff] at this,
  exact this.1
end⟩

lemma is_unit_iff_norm_is_unit {d : ℤ} (z : ℤ√d) : is_unit z ↔ is_unit z.norm :=
by rw [int.is_unit_iff_nat_abs_eq, norm_eq_one_iff]

lemma norm_eq_one_iff' {d : ℤ} (hd : d ≤ 0) (z : ℤ√d) : z.norm = 1 ↔ is_unit z :=
by rw [←norm_eq_one_iff, ←int.coe_nat_inj', int.nat_abs_of_nonneg (norm_nonneg hd z),
  int.coe_nat_one]

lemma norm_eq_zero_iff {d : ℤ} (hd : d < 0) (z : ℤ√d) : z.norm = 0 ↔ z = 0 :=
begin
  split,
  { intro h,
    rw [ext, zero_re, zero_im],
    rw [norm_def, sub_eq_add_neg, mul_assoc] at h,
    have left := mul_self_nonneg z.re,
    have right := neg_nonneg.mpr (mul_nonpos_of_nonpos_of_nonneg hd.le (mul_self_nonneg z.im)),
    obtain ⟨ha, hb⟩ := (add_eq_zero_iff' left right).mp h,
    split; apply eq_zero_of_mul_self_eq_zero,
    { exact ha },
    { rw [neg_eq_zero, mul_eq_zero] at hb,
      exact hb.resolve_left hd.ne } },
  { rintro rfl, exact norm_zero }
end

lemma norm_eq_of_associated {d : ℤ} (hd : d ≤ 0) {x y : ℤ√d} (h : associated x y) :
  x.norm = y.norm :=
begin
  obtain ⟨u, rfl⟩ := h,
  rw [norm_mul, (norm_eq_one_iff' hd _).mpr u.is_unit, mul_one],
end

end norm

end

section
parameter {d : ℕ}

/-- Nonnegativity of an element of `ℤ√d`. -/
def nonneg : ℤ√d → Prop | ⟨a, b⟩ := nonnegg d 1 a b

instance : has_le ℤ√d := ⟨λ a b, nonneg (b - a)⟩
instance : has_lt ℤ√d := ⟨λ a b, ¬ b ≤ a⟩

instance decidable_nonnegg (c d a b) : decidable (nonnegg c d a b) :=
by cases a; cases b; repeat {rw int.of_nat_eq_coe}; unfold nonnegg sq_le; apply_instance

instance decidable_nonneg : Π (a : ℤ√d), decidable (nonneg a)
| ⟨a, b⟩ := zsqrtd.decidable_nonnegg _ _ _ _

instance decidable_le : @decidable_rel (ℤ√d) (≤) := λ _ _, decidable_nonneg _

theorem nonneg_cases : Π {a : ℤ√d}, nonneg a → ∃ x y : ℕ, a = ⟨x, y⟩ ∨ a = ⟨x, -y⟩ ∨ a = ⟨-x, y⟩
| ⟨(x : ℕ), (y : ℕ)⟩ h := ⟨x, y, or.inl rfl⟩
| ⟨(x : ℕ), -[1+ y]⟩ h := ⟨x, y+1, or.inr $ or.inl rfl⟩
| ⟨-[1+ x], (y : ℕ)⟩ h := ⟨x+1, y, or.inr $ or.inr rfl⟩
| ⟨-[1+ x], -[1+ y]⟩ h := false.elim h

lemma nonneg_add_lem {x y z w : ℕ} (xy : nonneg ⟨x, -y⟩) (zw : nonneg ⟨-z, w⟩) :
  nonneg (⟨x, -y⟩ + ⟨-z, w⟩) :=
have nonneg ⟨int.sub_nat_nat x z, int.sub_nat_nat w y⟩, from int.sub_nat_nat_elim x z
  (λm n i, sq_le y d m 1 → sq_le n 1 w d → nonneg ⟨i, int.sub_nat_nat w y⟩)
  (λj k, int.sub_nat_nat_elim w y
    (λm n i, sq_le n d (k + j) 1 → sq_le k 1 m d → nonneg ⟨int.of_nat j, i⟩)
    (λm n xy zw, trivial)
    (λm n xy zw, sq_le_cancel zw xy))
  (λj k, int.sub_nat_nat_elim w y
    (λm n i, sq_le n d k 1 → sq_le (k + j + 1) 1 m d → nonneg ⟨-[1+ j], i⟩)
    (λm n xy zw, sq_le_cancel xy zw)
    (λm n xy zw, let t := nat.le_trans zw (sq_le_of_le (nat.le_add_right n (m+1)) le_rfl xy) in
      have k + j + 1 ≤ k, from nat.mul_self_le_mul_self_iff.2 (by repeat{rw one_mul at t}; exact t),
      absurd this (not_le_of_gt $ nat.succ_le_succ $ nat.le_add_right _ _))) (nonnegg_pos_neg.1 xy)
        (nonnegg_neg_pos.1 zw),
show nonneg ⟨_, _⟩, by rw [neg_add_eq_sub];
  rwa [int.sub_nat_nat_eq_coe,int.sub_nat_nat_eq_coe] at this

lemma nonneg.add {a b : ℤ√d} (ha : nonneg a) (hb : nonneg b) : nonneg (a + b) :=
begin
  rcases nonneg_cases ha with ⟨x, y, rfl|rfl|rfl⟩;
  rcases nonneg_cases hb with ⟨z, w, rfl|rfl|rfl⟩,
  { trivial },
  { refine nonnegg_cases_right (λi h, sq_le_of_le _ _ (nonnegg_pos_neg.1 hb)),
    { exact int.coe_nat_le.1 (le_of_neg_le_neg (@int.le.intro _ _ y (by simp [add_comm, *]))) },
    { apply nat.le_add_left } },
  { refine nonnegg_cases_left (λi h, sq_le_of_le _ _ (nonnegg_neg_pos.1 hb)),
    { exact int.coe_nat_le.1 (le_of_neg_le_neg (@int.le.intro _ _ x (by simp [add_comm, *]))) },
    { apply nat.le_add_left } },
  { refine nonnegg_cases_right (λi h, sq_le_of_le _ _ (nonnegg_pos_neg.1 ha)),
    { exact int.coe_nat_le.1 (le_of_neg_le_neg (@int.le.intro _ _ w (by simp *))) },
    { apply nat.le_add_right } },
  { simpa [add_comm] using
      nonnegg_pos_neg.2 (sq_le_add (nonnegg_pos_neg.1 ha) (nonnegg_pos_neg.1 hb)) },
  { exact nonneg_add_lem ha hb },
  { refine nonnegg_cases_left (λi h, sq_le_of_le _ _ (nonnegg_neg_pos.1 ha)),
    { exact int.coe_nat_le.1 (le_of_neg_le_neg (int.le.intro h)) },
    { apply nat.le_add_right } },
  { dsimp, rw [add_comm, add_comm ↑y], exact nonneg_add_lem hb ha },
  { simpa [add_comm] using
      nonnegg_neg_pos.2 (sq_le_add (nonnegg_neg_pos.1 ha) (nonnegg_neg_pos.1 hb)) },
end

theorem nonneg_iff_zero_le {a : ℤ√d} : nonneg a ↔ 0 ≤ a := show _ ↔ nonneg _, by simp

theorem le_of_le_le {x y z w : ℤ} (xz : x ≤ z) (yw : y ≤ w) : (⟨x, y⟩ : ℤ√d) ≤ ⟨z, w⟩ :=
show nonneg ⟨z - x, w - y⟩, from
match z - x, w - y, int.le.dest_sub xz, int.le.dest_sub yw with ._, ._, ⟨a, rfl⟩, ⟨b, rfl⟩ :=
  trivial end

protected theorem nonneg_total : Π (a : ℤ√d), nonneg a ∨ nonneg (-a)
| ⟨(x : ℕ), (y : ℕ)⟩ := or.inl trivial
| ⟨-[1+ x], -[1+ y]⟩ := or.inr trivial
| ⟨0,       -[1+ y]⟩ := or.inr trivial
| ⟨-[1+ x], 0⟩       := or.inr trivial
| ⟨(x+1:ℕ), -[1+ y]⟩ := nat.le_total
| ⟨-[1+ x], (y+1:ℕ)⟩ := nat.le_total

protected theorem le_total (a b : ℤ√d) : a ≤ b ∨ b ≤ a :=
begin
  have t := (b - a).nonneg_total,
  rwa neg_sub at t,
end

instance : preorder ℤ√d :=
{ le               := (≤),
  le_refl          := λ a, show nonneg (a - a), by simp only [sub_self],
  le_trans         := λ a b c hab hbc, by simpa [sub_add_sub_cancel'] using hab.add hbc,
  lt               := (<),
  lt_iff_le_not_le := λ a b,
    (and_iff_right_of_imp (zsqrtd.le_total _ _).resolve_left).symm }

theorem le_arch (a : ℤ√d) : ∃n : ℕ, a ≤ n :=
let ⟨x, y, (h : a ≤ ⟨x, y⟩)⟩ := show ∃x y : ℕ, nonneg (⟨x, y⟩ + -a), from match -a with
| ⟨int.of_nat x, int.of_nat y⟩ := ⟨0, 0, trivial⟩
| ⟨int.of_nat x, -[1+ y]⟩      := ⟨0, y+1, by simp [int.neg_succ_of_nat_coe, add_assoc]⟩
| ⟨-[1+ x],      int.of_nat y⟩ := ⟨x+1, 0, by simp [int.neg_succ_of_nat_coe, add_assoc]⟩
| ⟨-[1+ x],      -[1+ y]⟩      := ⟨x+1, y+1, by simp [int.neg_succ_of_nat_coe, add_assoc]⟩
end in begin
  refine ⟨x + d*y, h.trans _⟩,
  change nonneg ⟨(↑x + d*y) - ↑x, 0-↑y⟩,
  cases y with y,
  { simp },
  have h : ∀y, sq_le y d (d * y) 1 := λ y,
    by simpa [sq_le, mul_comm, mul_left_comm] using
       nat.mul_le_mul_right (y * y) (nat.le_mul_self d),
  rw [show (x:ℤ) + d * nat.succ y - x = d * nat.succ y, by simp],
  exact h (y+1)
end

protected theorem add_le_add_left (a b : ℤ√d) (ab : a ≤ b) (c : ℤ√d) : c + a ≤ c + b :=
show nonneg _, by rw add_sub_add_left_eq_sub; exact ab

protected theorem le_of_add_le_add_left (a b c : ℤ√d) (h : c + a ≤ c + b) : a ≤ b :=
by simpa using zsqrtd.add_le_add_left _ _ h (-c)

protected theorem add_lt_add_left (a b : ℤ√d) (h : a < b) (c) : c + a < c + b :=
λ h', h (zsqrtd.le_of_add_le_add_left _ _ _ h')

theorem nonneg_smul {a : ℤ√d} {n : ℕ} (ha : nonneg a) : nonneg (n * a) :=
by simp only [← int.cast_coe_nat] {single_pass := tt}; exact
match a, nonneg_cases ha, ha with
| ._, ⟨x, y, or.inl rfl⟩,          ha := by rw smul_val; trivial
| ._, ⟨x, y, or.inr $ or.inl rfl⟩, ha := by rw smul_val; simpa using
  nonnegg_pos_neg.2 (sq_le_smul n $ nonnegg_pos_neg.1 ha)
| ._, ⟨x, y, or.inr $ or.inr rfl⟩, ha := by rw smul_val; simpa using
  nonnegg_neg_pos.2 (sq_le_smul n $ nonnegg_neg_pos.1 ha)
end

theorem nonneg_muld {a : ℤ√d} (ha : nonneg a) : nonneg (sqrtd * a) :=
by refine match a, nonneg_cases ha, ha with
| ._, ⟨x, y, or.inl rfl⟩,          ha := trivial
| ._, ⟨x, y, or.inr $ or.inl rfl⟩, ha := by simp; apply nonnegg_neg_pos.2;
  simpa [sq_le, mul_comm, mul_left_comm] using
    nat.mul_le_mul_left d (nonnegg_pos_neg.1 ha)
| ._, ⟨x, y, or.inr $ or.inr rfl⟩, ha := by simp; apply nonnegg_pos_neg.2;
  simpa [sq_le, mul_comm, mul_left_comm] using
    nat.mul_le_mul_left d (nonnegg_neg_pos.1 ha)
end

theorem nonneg_mul_lem {x y : ℕ} {a : ℤ√d} (ha : nonneg a) : nonneg (⟨x, y⟩ * a) :=
have (⟨x, y⟩ * a : ℤ√d) = x * a + sqrtd * (y * a), by rw [decompose, right_distrib, mul_assoc];
  refl,
by rw this; exact (nonneg_smul ha).add (nonneg_muld $ nonneg_smul ha)

theorem nonneg_mul {a b : ℤ√d} (ha : nonneg a) (hb : nonneg b) : nonneg (a * b) :=
match a, b, nonneg_cases ha, nonneg_cases hb, ha, hb with
| ._, ._, ⟨x, y, or.inl rfl⟩,          ⟨z, w, or.inl rfl⟩,          ha, hb := trivial
| ._, ._, ⟨x, y, or.inl rfl⟩,          ⟨z, w, or.inr $ or.inr rfl⟩, ha, hb := nonneg_mul_lem hb
| ._, ._, ⟨x, y, or.inl rfl⟩,          ⟨z, w, or.inr $ or.inl rfl⟩, ha, hb := nonneg_mul_lem hb
| ._, ._, ⟨x, y, or.inr $ or.inr rfl⟩, ⟨z, w, or.inl rfl⟩,          ha, hb :=
  by rw mul_comm; exact nonneg_mul_lem ha
| ._, ._, ⟨x, y, or.inr $ or.inl rfl⟩, ⟨z, w, or.inl rfl⟩,          ha, hb :=
  by rw mul_comm; exact nonneg_mul_lem ha
| ._, ._, ⟨x, y, or.inr $ or.inr rfl⟩, ⟨z, w, or.inr $ or.inr rfl⟩, ha, hb :=
  by rw [calc (⟨-x, y⟩ * ⟨-z, w⟩ : ℤ√d) = ⟨_, _⟩ : rfl
      ... = ⟨x * z + d * y * w, -(x * w + y * z)⟩ : by simp [add_comm]]; exact
  nonnegg_pos_neg.2 (sq_le_mul.left (nonnegg_neg_pos.1 ha) (nonnegg_neg_pos.1 hb))
| ._, ._, ⟨x, y, or.inr $ or.inr rfl⟩, ⟨z, w, or.inr $ or.inl rfl⟩, ha, hb :=
  by rw [calc (⟨-x, y⟩ * ⟨z, -w⟩ : ℤ√d) = ⟨_, _⟩ : rfl
      ... = ⟨-(x * z + d * y * w), x * w + y * z⟩ : by simp [add_comm]]; exact
  nonnegg_neg_pos.2 (sq_le_mul.right.left (nonnegg_neg_pos.1 ha) (nonnegg_pos_neg.1 hb))
| ._, ._, ⟨x, y, or.inr $ or.inl rfl⟩, ⟨z, w, or.inr $ or.inr rfl⟩, ha, hb :=
  by rw [calc (⟨x, -y⟩ * ⟨-z, w⟩ : ℤ√d) = ⟨_, _⟩ : rfl
      ... = ⟨-(x * z + d * y * w), x * w + y * z⟩ : by simp [add_comm]]; exact
  nonnegg_neg_pos.2 (sq_le_mul.right.right.left (nonnegg_pos_neg.1 ha) (nonnegg_neg_pos.1 hb))
| ._, ._, ⟨x, y, or.inr $ or.inl rfl⟩, ⟨z, w, or.inr $ or.inl rfl⟩, ha, hb :=
  by rw [calc (⟨x, -y⟩ * ⟨z, -w⟩ : ℤ√d) = ⟨_, _⟩ : rfl
      ... = ⟨x * z + d * y * w, -(x * w + y * z)⟩ : by simp [add_comm]]; exact
  nonnegg_pos_neg.2 (sq_le_mul.right.right.right (nonnegg_pos_neg.1 ha) (nonnegg_pos_neg.1 hb))
end

protected theorem mul_nonneg (a b : ℤ√d) : 0 ≤ a → 0 ≤ b → 0 ≤ a * b :=
by repeat {rw ← nonneg_iff_zero_le}; exact nonneg_mul

theorem not_sq_le_succ (c d y) (h : 0 < c) : ¬sq_le (y + 1) c 0 d :=
not_le_of_gt $ mul_pos (mul_pos h $ nat.succ_pos _) $ nat.succ_pos _

/-- A nonsquare is a natural number that is not equal to the square of an
  integer. This is implemented as a typeclass because it's a necessary condition
  for much of the Pell equation theory. -/
class nonsquare (x : ℕ) : Prop := (ns [] : ∀n : ℕ, x ≠ n*n)

parameter [dnsq : nonsquare d]
include dnsq

theorem d_pos : 0 < d := lt_of_le_of_ne (nat.zero_le _) $ ne.symm $ (nonsquare.ns d 0)

theorem divides_sq_eq_zero {x y} (h : x * x = d * y * y) : x = 0 ∧ y = 0 :=
let g := x.gcd y in or.elim g.eq_zero_or_pos
  (λH, ⟨nat.eq_zero_of_gcd_eq_zero_left H, nat.eq_zero_of_gcd_eq_zero_right H⟩)
  (λgpos, false.elim $
    let ⟨m, n, co, (hx : x = m * g), (hy : y = n * g)⟩ := nat.exists_coprime gpos in
    begin
      rw [hx, hy] at h,
      have : m * m = d * (n * n) := nat.eq_of_mul_eq_mul_left (mul_pos gpos gpos)
        (by simpa [mul_comm, mul_left_comm] using h),
      have co2 := let co1 := co.mul_right co in co1.mul co1,
      exact nonsquare.ns d m (nat.dvd_antisymm (by rw this; apply dvd_mul_right) $
        co2.dvd_of_dvd_mul_right $ by simp [this])
    end)

theorem divides_sq_eq_zero_z {x y : ℤ} (h : x * x = d * y * y) : x = 0 ∧ y = 0 :=
by rw [mul_assoc, ← int.nat_abs_mul_self, ← int.nat_abs_mul_self, ← int.coe_nat_mul, ← mul_assoc]
  at h;
exact let ⟨h1, h2⟩ := divides_sq_eq_zero (int.coe_nat_inj h) in
⟨int.eq_zero_of_nat_abs_eq_zero h1, int.eq_zero_of_nat_abs_eq_zero h2⟩

theorem not_divides_sq (x y) : (x + 1) * (x + 1) ≠ d * (y + 1) * (y + 1) :=
λe, by have t := (divides_sq_eq_zero e).left; contradiction

theorem nonneg_antisymm : Π {a : ℤ√d}, nonneg a → nonneg (-a) → a = 0
| ⟨0,         0⟩         xy yx := rfl
| ⟨-[1+ x],   -[1+ y]⟩   xy yx := false.elim xy
| ⟨(x+1:nat), (y+1:nat)⟩ xy yx := false.elim yx
| ⟨-[1+ x],   0⟩         xy yx := absurd xy (not_sq_le_succ _ _ _ dec_trivial)
| ⟨(x+1:nat), 0⟩         xy yx := absurd yx (not_sq_le_succ _ _ _ dec_trivial)
| ⟨0,         -[1+ y]⟩   xy yx := absurd xy (not_sq_le_succ _ _ _ d_pos)
| ⟨0,         (y+1:nat)⟩ _  yx := absurd yx (not_sq_le_succ _ _ _ d_pos)
| ⟨(x+1:nat), -[1+ y]⟩   (xy : sq_le _ _ _ _) (yx : sq_le _ _ _ _) :=
  let t := le_antisymm yx xy in by rw[one_mul] at t; exact absurd t (not_divides_sq _ _)
| ⟨-[1+ x],   (y+1:nat)⟩ (xy : sq_le _ _ _ _) (yx : sq_le _ _ _ _) :=
  let t := le_antisymm xy yx in by rw[one_mul] at t; exact absurd t (not_divides_sq _ _)

theorem le_antisymm {a b : ℤ√d} (ab : a ≤ b) (ba : b ≤ a) : a = b :=
eq_of_sub_eq_zero $ nonneg_antisymm ba (by rw neg_sub; exact ab)

instance : linear_order ℤ√d :=
{ le_antisymm     := @zsqrtd.le_antisymm,
  le_total        := zsqrtd.le_total,
  decidable_le    := zsqrtd.decidable_le,
  ..zsqrtd.preorder }

protected theorem eq_zero_or_eq_zero_of_mul_eq_zero : Π {a b : ℤ√d}, a * b = 0 → a = 0 ∨ b = 0
| ⟨x, y⟩ ⟨z, w⟩ h := by injection h with h1 h2; exact
  have h1 : x*z = -(d*y*w), from eq_neg_of_add_eq_zero_left h1,
  have h2 : x*w = -(y*z), from eq_neg_of_add_eq_zero_left h2,
  have fin : x*x = d*y*y → (⟨x, y⟩:ℤ√d) = 0, from
  λe, match x, y, divides_sq_eq_zero_z e with ._, ._, ⟨rfl, rfl⟩ := rfl end,
  if z0 : z = 0 then if w0 : w = 0 then
    or.inr (match z, w, z0, w0 with ._, ._, rfl, rfl := rfl end)
  else
     or.inl $ fin $ mul_right_cancel₀ w0 $ calc
       x * x * w = -y * (x * z) : by simp [h2, mul_assoc, mul_left_comm]
             ... = d * y * y * w : by simp [h1, mul_assoc, mul_left_comm]
  else
     or.inl $ fin $ mul_right_cancel₀ z0 $ calc
       x * x * z = d * -y * (x * w) : by simp [h1, mul_assoc, mul_left_comm]
             ... = d * y * y * z : by simp [h2, mul_assoc, mul_left_comm]

instance : is_domain ℤ√d :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := @zsqrtd.eq_zero_or_eq_zero_of_mul_eq_zero,
  .. zsqrtd.comm_ring, .. zsqrtd.nontrivial }

protected theorem mul_pos (a b : ℤ√d) (a0 : 0 < a) (b0 : 0 < b) : 0 < a * b := λab,
or.elim (eq_zero_or_eq_zero_of_mul_eq_zero
         (le_antisymm ab (mul_nonneg _ _ (le_of_lt a0) (le_of_lt b0))))
  (λe, ne_of_gt a0 e)
  (λe, ne_of_gt b0 e)

instance : linear_ordered_comm_ring ℤ√d :=
{ add_le_add_left := @zsqrtd.add_le_add_left,
  mul_pos         := @zsqrtd.mul_pos,
  zero_le_one     := dec_trivial,
  .. zsqrtd.comm_ring, .. zsqrtd.linear_order, .. zsqrtd.nontrivial }

instance : linear_ordered_ring ℤ√d := by apply_instance
instance : ordered_ring ℤ√d        := by apply_instance

end

lemma norm_eq_zero {d : ℤ} (h_nonsquare : ∀ n : ℤ, d ≠ n*n) (a : ℤ√d) :
  norm a = 0 ↔ a = 0 :=
begin
  refine ⟨λ ha, ext.mpr _, λ h, by rw [h, norm_zero]⟩,
  delta norm at ha,
  rw sub_eq_zero at ha,
  by_cases h : 0 ≤ d,
  { obtain ⟨d', rfl⟩ := int.eq_coe_of_zero_le h,
    haveI : nonsquare d' := ⟨λ n h, h_nonsquare n $ by exact_mod_cast h⟩,
    exact divides_sq_eq_zero_z ha, },
  { push_neg at h,
    suffices : a.re * a.re = 0,
    { rw eq_zero_of_mul_self_eq_zero this at ha ⊢,
      simpa only [true_and, or_self_right, zero_re, zero_im, eq_self_iff_true,
        zero_eq_mul, mul_zero, mul_eq_zero, h.ne, false_or, or_self] using ha },
    apply _root_.le_antisymm _ (mul_self_nonneg _),
    rw [ha, mul_assoc],
    exact mul_nonpos_of_nonpos_of_nonneg h.le (mul_self_nonneg _) }
end

variables {R : Type}

@[ext] lemma hom_ext [ring R] {d : ℤ} (f g : ℤ√d →+* R) (h : f sqrtd = g sqrtd) : f = g :=
begin
  ext ⟨x_re, x_im⟩,
  simp [decompose, h],
end

variables [comm_ring R]

/-- The unique `ring_hom` from `ℤ√d` to a ring `R`, constructed by replacing `√d` with the provided
root. Conversely, this associates to every mapping `ℤ√d →+* R` a value of `√d` in `R`. -/
@[simps]
def lift {d : ℤ} : {r : R // r * r = ↑d} ≃ (ℤ√d →+* R) :=
{ to_fun := λ r,
  { to_fun := λ a, a.1 + a.2*(r : R),
    map_zero' := by simp,
    map_add' := λ a b, by { simp, ring, },
    map_one' := by simp,
    map_mul' := λ a b, by
    { have : (a.re + a.im * r : R) * (b.re + b.im * r) =
              a.re * b.re + (a.re * b.im + a.im * b.re) * r + a.im * b.im * (r * r) := by ring,
      simp [this, r.prop],
      ring, } },
  inv_fun := λ f, ⟨f sqrtd, by rw [←f.map_mul, dmuld, ring_hom.map_int_cast]⟩,
  left_inv := λ r, by { ext, simp },
  right_inv := λ f, by { ext, simp } }

/-- `lift r` is injective if `d` is non-square, and R has characteristic zero (that is, the map from
`ℤ` into `R` is injective). -/
lemma lift_injective [char_zero R] {d : ℤ} (r : {r : R // r * r = ↑d}) (hd : ∀ n : ℤ, d ≠ n*n) :
  function.injective (lift r) :=
(injective_iff_map_eq_zero (lift r)).mpr $ λ a ha,
begin
  have h_inj : function.injective (coe : ℤ → R) := int.cast_injective,
  suffices : lift r a.norm = 0,
  { simp only [coe_int_re, add_zero, lift_apply_apply, coe_int_im, int.cast_zero, zero_mul] at this,
    rwa [← int.cast_zero, h_inj.eq_iff, norm_eq_zero hd] at this },
  rw [norm_eq_mul_conj, ring_hom.map_mul, ha, zero_mul]
end

end zsqrtd


/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ordered_ring
import Mathlib.tactic.monotonicity.basic
import Mathlib.deprecated.group
import Mathlib.PostPort

universes u y v z u₁ w u₂ u_1

namespace Mathlib

/-!
# Power operations on monoids and groups

The power operation on monoids and groups.
We separate this from group, because it depends on `ℕ`,
which in turn depends on other parts of algebra.

This module contains the definitions of `monoid.pow` and `group.pow`
and their additive counterparts `nsmul` and `gsmul`, along with a few lemmas.
Further lemmas can be found in `algebra.group_power.lemmas`.

## Notation

The class `has_pow α β` provides the notation `a^b` for powers.
We define instances of `has_pow M ℕ`, for monoids `M`, and `has_pow G ℤ` for groups `G`.

We also define infix operators `•ℕ` and `•ℤ` for scalar multiplication by a natural and an integer
numbers, respectively.

## Implementation details

We adopt the convention that `0^0 = 1`.

This module provides the instance `has_pow ℕ ℕ` (via `monoid.has_pow`)
and is imported by `data.nat.basic`, so it has to live low in the import hierarchy.
Not all of its imports are needed yet; the intent is to move more lemmas here from `.lemmas`
so that they are available in `data.nat.basic`, and the imports will be required then.
-/

/-- The power operation in a monoid. `a^n = a*a*...*a` n times. -/
def monoid.pow {M : Type u} [Mul M] [HasOne M] (a : M) : ℕ → M := sorry

/-- The scalar multiplication in an additive monoid.
`n •ℕ a = a+a+...+a` n times. -/
def nsmul {A : Type y} [Add A] [HasZero A] (n : ℕ) (a : A) : A := monoid.pow a n

infixl:70 " •ℕ " => Mathlib.nsmul

protected instance monoid.has_pow {M : Type u} [monoid M] : has_pow M ℕ := has_pow.mk monoid.pow

@[simp] theorem monoid.pow_eq_has_pow {M : Type u} [monoid M] (a : M) (n : ℕ) :
    monoid.pow a n = a ^ n :=
  rfl

/-!
### Commutativity

First we prove some facts about `semiconj_by` and `commute`. They do not require any theory about
`pow` and/or `nsmul` and will be useful later in this file.
-/

namespace semiconj_by

@[simp] theorem pow_right {M : Type u} [monoid M] {a : M} {x : M} {y : M} (h : semiconj_by a x y)
    (n : ℕ) : semiconj_by a (x ^ n) (y ^ n) :=
  nat.rec_on n (one_right a) fun (n : ℕ) (ihn : semiconj_by a (x ^ n) (y ^ n)) => mul_right h ihn

end semiconj_by

namespace commute

@[simp] theorem pow_right {M : Type u} [monoid M] {a : M} {b : M} (h : commute a b) (n : ℕ) :
    commute a (b ^ n) :=
  semiconj_by.pow_right h n

@[simp] theorem pow_left {M : Type u} [monoid M] {a : M} {b : M} (h : commute a b) (n : ℕ) :
    commute (a ^ n) b :=
  commute.symm (pow_right (commute.symm h) n)

@[simp] theorem pow_pow {M : Type u} [monoid M] {a : M} {b : M} (h : commute a b) (m : ℕ) (n : ℕ) :
    commute (a ^ m) (b ^ n) :=
  pow_right (pow_left h m) n

@[simp] theorem self_pow {M : Type u} [monoid M] (a : M) (n : ℕ) : commute a (a ^ n) :=
  pow_right (commute.refl a) n

@[simp] theorem pow_self {M : Type u} [monoid M] (a : M) (n : ℕ) : commute (a ^ n) a :=
  pow_left (commute.refl a) n

@[simp] theorem pow_pow_self {M : Type u} [monoid M] (a : M) (m : ℕ) (n : ℕ) :
    commute (a ^ m) (a ^ n) :=
  pow_pow (commute.refl a) m n

end commute

@[simp] theorem pow_zero {M : Type u} [monoid M] (a : M) : a ^ 0 = 1 := rfl

@[simp] theorem zero_nsmul {A : Type y} [add_monoid A] (a : A) : 0 •ℕ a = 0 := rfl

theorem pow_succ {M : Type u} [monoid M] (a : M) (n : ℕ) : a ^ (n + 1) = a * a ^ n := rfl

theorem succ_nsmul {A : Type y} [add_monoid A] (a : A) (n : ℕ) : (n + 1) •ℕ a = a + n •ℕ a := rfl

theorem pow_two {M : Type u} [monoid M] (a : M) : a ^ bit0 1 = a * a :=
  (fun (this : a * (a * 1) = a * a) => this)
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (a * 1) = a * a)) (mul_one a))) (Eq.refl (a * a)))

theorem two_nsmul {A : Type y} [add_monoid A] (a : A) : bit0 1 •ℕ a = a + a := pow_two a

theorem pow_mul_comm' {M : Type u} [monoid M] (a : M) (n : ℕ) : a ^ n * a = a * a ^ n :=
  commute.pow_self a n

theorem nsmul_add_comm' {A : Type y} [add_monoid A] (a : A) (n : ℕ) : n •ℕ a + a = a + n •ℕ a :=
  pow_mul_comm'

theorem pow_succ' {M : Type u} [monoid M] (a : M) (n : ℕ) : a ^ (n + 1) = a ^ n * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n + 1) = a ^ n * a)) (pow_succ a n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * a ^ n = a ^ n * a)) (pow_mul_comm' a n)))
      (Eq.refl (a * a ^ n)))

theorem succ_nsmul' {A : Type y} [add_monoid A] (a : A) (n : ℕ) : (n + 1) •ℕ a = n •ℕ a + a :=
  pow_succ' a n

theorem pow_add {M : Type u} [monoid M] (a : M) (m : ℕ) (n : ℕ) : a ^ (m + n) = a ^ m * a ^ n :=
  sorry

theorem add_nsmul {A : Type y} [add_monoid A] (a : A) (m : ℕ) (n : ℕ) :
    (m + n) •ℕ a = m •ℕ a + n •ℕ a :=
  pow_add

@[simp] theorem pow_one {M : Type u} [monoid M] (a : M) : a ^ 1 = a := mul_one a

@[simp] theorem one_nsmul {A : Type y} [add_monoid A] (a : A) : 1 •ℕ a = a :=
  add_zero (coe_fn multiplicative.to_add a)

@[simp] theorem pow_ite {M : Type u} [monoid M] (P : Prop) [Decidable P] (a : M) (b : ℕ) (c : ℕ) :
    a ^ ite P b c = ite P (a ^ b) (a ^ c) :=
  sorry

@[simp] theorem ite_pow {M : Type u} [monoid M] (P : Prop) [Decidable P] (a : M) (b : M) (c : ℕ) :
    ite P a b ^ c = ite P (a ^ c) (b ^ c) :=
  sorry

@[simp] theorem pow_boole {M : Type u} [monoid M] (P : Prop) [Decidable P] (a : M) :
    a ^ ite P 1 0 = ite P a 1 :=
  sorry

@[simp] theorem one_pow {M : Type u} [monoid M] (n : ℕ) : 1 ^ n = 1 := sorry

@[simp] theorem nsmul_zero {A : Type y} [add_monoid A] (n : ℕ) : n •ℕ 0 = 0 := sorry

theorem pow_mul {M : Type u} [monoid M] (a : M) (m : ℕ) (n : ℕ) : a ^ (m * n) = (a ^ m) ^ n := sorry

theorem mul_nsmul' {A : Type y} [add_monoid A] (a : A) (m : ℕ) (n : ℕ) :
    m * n •ℕ a = n •ℕ (m •ℕ a) :=
  pow_mul

theorem pow_mul' {M : Type u} [monoid M] (a : M) (m : ℕ) (n : ℕ) : a ^ (m * n) = (a ^ n) ^ m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (m * n) = (a ^ n) ^ m)) (nat.mul_comm m n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n * m) = (a ^ n) ^ m)) (pow_mul a n m)))
      (Eq.refl ((a ^ n) ^ m)))

theorem mul_nsmul {A : Type y} [add_monoid A] (a : A) (m : ℕ) (n : ℕ) :
    m * n •ℕ a = m •ℕ (n •ℕ a) :=
  pow_mul' a m n

theorem pow_mul_pow_sub {M : Type u} [monoid M] (a : M) {m : ℕ} {n : ℕ} (h : m ≤ n) :
    a ^ m * a ^ (n - m) = a ^ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ m * a ^ (n - m) = a ^ n)) (Eq.symm (pow_add a m (n - m)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (m + (n - m)) = a ^ n)) (nat.add_comm m (n - m))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n - m + m) = a ^ n)) (nat.sub_add_cancel h)))
        (Eq.refl (a ^ n))))

theorem nsmul_add_sub_nsmul {A : Type y} [add_monoid A] (a : A) {m : ℕ} {n : ℕ} (h : m ≤ n) :
    m •ℕ a + (n - m) •ℕ a = n •ℕ a :=
  pow_mul_pow_sub a h

theorem pow_sub_mul_pow {M : Type u} [monoid M] (a : M) {m : ℕ} {n : ℕ} (h : m ≤ n) :
    a ^ (n - m) * a ^ m = a ^ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n - m) * a ^ m = a ^ n)) (Eq.symm (pow_add a (n - m) m))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n - m + m) = a ^ n)) (nat.sub_add_cancel h)))
      (Eq.refl (a ^ n)))

theorem sub_nsmul_nsmul_add {A : Type y} [add_monoid A] (a : A) {m : ℕ} {n : ℕ} (h : m ≤ n) :
    (n - m) •ℕ a + m •ℕ a = n •ℕ a :=
  pow_sub_mul_pow a h

theorem pow_bit0 {M : Type u} [monoid M] (a : M) (n : ℕ) : a ^ bit0 n = a ^ n * a ^ n :=
  pow_add a n n

theorem bit0_nsmul {A : Type y} [add_monoid A] (a : A) (n : ℕ) : bit0 n •ℕ a = n •ℕ a + n •ℕ a :=
  add_nsmul a n n

theorem pow_bit1 {M : Type u} [monoid M] (a : M) (n : ℕ) : a ^ bit1 n = a ^ n * a ^ n * a := sorry

theorem bit1_nsmul {A : Type y} [add_monoid A] (a : A) (n : ℕ) :
    bit1 n •ℕ a = n •ℕ a + n •ℕ a + a :=
  pow_bit1

theorem pow_mul_comm {M : Type u} [monoid M] (a : M) (m : ℕ) (n : ℕ) :
    a ^ m * a ^ n = a ^ n * a ^ m :=
  commute.pow_pow_self a m n

theorem nsmul_add_comm {A : Type y} [add_monoid A] (a : A) (m : ℕ) (n : ℕ) :
    m •ℕ a + n •ℕ a = n •ℕ a + m •ℕ a :=
  pow_mul_comm

@[simp] theorem monoid_hom.map_pow {M : Type u} {N : Type v} [monoid M] [monoid N] (f : M →* N)
    (a : M) (n : ℕ) : coe_fn f (a ^ n) = coe_fn f a ^ n :=
  sorry

@[simp] theorem add_monoid_hom.map_nsmul {A : Type y} {B : Type z} [add_monoid A] [add_monoid B]
    (f : A →+ B) (a : A) (n : ℕ) : coe_fn f (n •ℕ a) = n •ℕ coe_fn f a :=
  monoid_hom.map_pow (coe_fn add_monoid_hom.to_multiplicative f) a n

theorem is_monoid_hom.map_pow {M : Type u} {N : Type v} [monoid M] [monoid N] (f : M → N)
    [is_monoid_hom f] (a : M) (n : ℕ) : f (a ^ n) = f a ^ n :=
  monoid_hom.map_pow (monoid_hom.of f) a

theorem is_add_monoid_hom.map_nsmul {A : Type y} {B : Type z} [add_monoid A] [add_monoid B]
    (f : A → B) [is_add_monoid_hom f] (a : A) (n : ℕ) : f (n •ℕ a) = n •ℕ f a :=
  add_monoid_hom.map_nsmul (add_monoid_hom.of f) a n

theorem commute.mul_pow {M : Type u} [monoid M] {a : M} {b : M} (h : commute a b) (n : ℕ) :
    (a * b) ^ n = a ^ n * b ^ n :=
  sorry

theorem neg_pow {R : Type u₁} [ring R] (a : R) (n : ℕ) : (-a) ^ n = (-1) ^ n * a ^ n :=
  neg_one_mul a ▸ commute.mul_pow (commute.neg_one_left a) n

theorem pow_bit0' {M : Type u} [monoid M] (a : M) (n : ℕ) : a ^ bit0 n = (a * a) ^ n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ bit0 n = (a * a) ^ n)) (pow_bit0 a n)))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (a ^ n * a ^ n = (a * a) ^ n)) (commute.mul_pow (commute.refl a) n)))
      (Eq.refl (a ^ n * a ^ n)))

theorem bit0_nsmul' {A : Type y} [add_monoid A] (a : A) (n : ℕ) : bit0 n •ℕ a = n •ℕ (a + a) :=
  pow_bit0' a n

theorem pow_bit1' {M : Type u} [monoid M] (a : M) (n : ℕ) : a ^ bit1 n = (a * a) ^ n * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ bit1 n = (a * a) ^ n * a)) (bit1.equations._eqn_1 n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (bit0 n + 1) = (a * a) ^ n * a)) (pow_succ' a (bit0 n))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ bit0 n * a = (a * a) ^ n * a)) (pow_bit0' a n)))
        (Eq.refl ((a * a) ^ n * a))))

theorem bit1_nsmul' {A : Type y} [add_monoid A] (a : A) (n : ℕ) : bit1 n •ℕ a = n •ℕ (a + a) + a :=
  pow_bit1'

@[simp] theorem neg_pow_bit0 {R : Type u₁} [ring R] (a : R) (n : ℕ) : (-a) ^ bit0 n = a ^ bit0 n :=
  eq.mpr (id (Eq._oldrec (Eq.refl ((-a) ^ bit0 n = a ^ bit0 n)) (pow_bit0' (-a) n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl ((-a * -a) ^ n = a ^ bit0 n)) (neg_mul_neg a a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl ((a * a) ^ n = a ^ bit0 n)) (pow_bit0' a n)))
        (Eq.refl ((a * a) ^ n))))

@[simp] theorem neg_pow_bit1 {R : Type u₁} [ring R] (a : R) (n : ℕ) : (-a) ^ bit1 n = -a ^ bit1 n :=
  sorry

/-!
### Commutative (additive) monoid
-/

theorem mul_pow {M : Type u} [comm_monoid M] (a : M) (b : M) (n : ℕ) :
    (a * b) ^ n = a ^ n * b ^ n :=
  commute.mul_pow (commute.all a b) n

theorem nsmul_add {A : Type y} [add_comm_monoid A] (a : A) (b : A) (n : ℕ) :
    n •ℕ (a + b) = n •ℕ a + n •ℕ b :=
  mul_pow

protected instance pow.is_monoid_hom {M : Type u} [comm_monoid M] (n : ℕ) :
    is_monoid_hom fun (_x : M) => _x ^ n :=
  is_monoid_hom.mk (one_pow n)

protected instance nsmul.is_add_monoid_hom {A : Type y} [add_comm_monoid A] (n : ℕ) :
    is_add_monoid_hom (nsmul n) :=
  is_add_monoid_hom.mk (nsmul_zero n)

theorem dvd_pow {M : Type u} [comm_monoid M] {x : M} {y : M} {n : ℕ} (hxy : x ∣ y) (hn : n ≠ 0) :
    x ∣ y ^ n :=
  sorry

/--
The power operation in a group. This extends `monoid.pow` to negative integers
with the definition `a^(-n) = (a^n)⁻¹`.
-/
def gpow {G : Type w} [group G] (a : G) : ℤ → G := sorry

/--
The scalar multiplication by integers on an additive group.
This extends `nsmul` to negative integers
with the definition `(-n) •ℤ a = -(n •ℕ a)`.
-/
def gsmul {A : Type y} [add_group A] (n : ℤ) (a : A) : A := gpow a n

protected instance group.has_pow {G : Type w} [group G] : has_pow G ℤ := has_pow.mk gpow

infixl:70 " •ℤ " => Mathlib.gsmul

@[simp] theorem group.gpow_eq_has_pow {G : Type w} [group G] (a : G) (n : ℤ) : gpow a n = a ^ n :=
  rfl

@[simp] theorem inv_pow {G : Type w} [group G] (a : G) (n : ℕ) : a⁻¹ ^ n = (a ^ n⁻¹) := sorry

@[simp] theorem neg_nsmul {A : Type y} [add_group A] (a : A) (n : ℕ) : n •ℕ -a = -(n •ℕ a) :=
  inv_pow

theorem pow_sub {G : Type w} [group G] (a : G) {m : ℕ} {n : ℕ} (h : n ≤ m) :
    a ^ (m - n) = a ^ m * (a ^ n⁻¹) :=
  sorry

theorem nsmul_sub {A : Type y} [add_group A] (a : A) {m : ℕ} {n : ℕ} :
    n ≤ m → (m - n) •ℕ a = m •ℕ a - n •ℕ a :=
  sorry

theorem pow_inv_comm {G : Type w} [group G] (a : G) (m : ℕ) (n : ℕ) :
    a⁻¹ ^ m * a ^ n = a ^ n * a⁻¹ ^ m :=
  commute.pow_pow (commute.inv_left (commute.refl a)) m n

theorem nsmul_neg_comm {A : Type y} [add_group A] (a : A) (m : ℕ) (n : ℕ) :
    m •ℕ -a + n •ℕ a = n •ℕ a + m •ℕ -a :=
  pow_inv_comm

@[simp] theorem gpow_coe_nat {G : Type w} [group G] (a : G) (n : ℕ) : a ^ ↑n = a ^ n := rfl

@[simp] theorem gsmul_coe_nat {A : Type y} [add_group A] (a : A) (n : ℕ) : ↑n •ℤ a = n •ℕ a := rfl

theorem gpow_of_nat {G : Type w} [group G] (a : G) (n : ℕ) : a ^ Int.ofNat n = a ^ n := rfl

theorem gsmul_of_nat {A : Type y} [add_group A] (a : A) (n : ℕ) : Int.ofNat n •ℤ a = n •ℕ a := rfl

@[simp] theorem gpow_neg_succ_of_nat {G : Type w} [group G] (a : G) (n : ℕ) :
    a ^ Int.negSucc n = (a ^ Nat.succ n⁻¹) :=
  rfl

@[simp] theorem gsmul_neg_succ_of_nat {A : Type y} [add_group A] (a : A) (n : ℕ) :
    Int.negSucc n •ℤ a = -(Nat.succ n •ℕ a) :=
  rfl

@[simp] theorem gpow_zero {G : Type w} [group G] (a : G) : a ^ 0 = 1 := rfl

@[simp] theorem zero_gsmul {A : Type y} [add_group A] (a : A) : 0 •ℤ a = 0 := rfl

@[simp] theorem gpow_one {G : Type w} [group G] (a : G) : a ^ 1 = a := pow_one a

@[simp] theorem one_gsmul {A : Type y} [add_group A] (a : A) : 1 •ℤ a = a :=
  add_zero (coe_fn multiplicative.to_add a)

@[simp] theorem one_gpow {G : Type w} [group G] (n : ℤ) : 1 ^ n = 1 := sorry

@[simp] theorem gsmul_zero {A : Type y} [add_group A] (n : ℤ) : n •ℤ 0 = 0 := one_gpow

@[simp] theorem gpow_neg {G : Type w} [group G] (a : G) (n : ℤ) : a ^ (-n) = (a ^ n⁻¹) := sorry

theorem mul_gpow_neg_one {G : Type w} [group G] (a : G) (b : G) :
    (a * b) ^ (-1) = b ^ (-1) * a ^ (-1) :=
  sorry

@[simp] theorem neg_gsmul {A : Type y} [add_group A] (a : A) (n : ℤ) : -n •ℤ a = -(n •ℤ a) :=
  gpow_neg

theorem gpow_neg_one {G : Type w} [group G] (x : G) : x ^ (-1) = (x⁻¹) :=
  congr_arg has_inv.inv (pow_one x)

theorem neg_one_gsmul {A : Type y} [add_group A] (x : A) : -1 •ℤ x = -x :=
  congr_arg Neg.neg (one_nsmul x)

theorem inv_gpow {G : Type w} [group G] (a : G) (n : ℤ) : a⁻¹ ^ n = (a ^ n⁻¹) :=
  int.cases_on n (fun (n : ℕ) => idRhs (a⁻¹ ^ n = (a ^ n⁻¹)) (inv_pow a n))
    fun (n : ℕ) =>
      idRhs (a⁻¹ ^ (n + 1)⁻¹ = (a ^ (n + 1)⁻¹⁻¹)) (congr_arg has_inv.inv (inv_pow a (n + 1)))

theorem gsmul_neg {A : Type y} [add_group A] (a : A) (n : ℤ) : n •ℤ -a = -(n •ℤ a) := inv_gpow a n

theorem commute.mul_gpow {G : Type w} [group G] {a : G} {b : G} (h : commute a b) (n : ℤ) :
    (a * b) ^ n = a ^ n * b ^ n :=
  sorry

theorem mul_gpow {G : Type w} [comm_group G] (a : G) (b : G) (n : ℤ) :
    (a * b) ^ n = a ^ n * b ^ n :=
  commute.mul_gpow (commute.all a b) n

theorem gsmul_add {A : Type y} [add_comm_group A] (a : A) (b : A) (n : ℤ) :
    n •ℤ (a + b) = n •ℤ a + n •ℤ b :=
  mul_gpow

theorem gsmul_sub {A : Type y} [add_comm_group A] (a : A) (b : A) (n : ℤ) :
    n •ℤ (a - b) = n •ℤ a - n •ℤ b :=
  sorry

protected instance gpow.is_group_hom {G : Type w} [comm_group G] (n : ℤ) :
    is_group_hom fun (_x : G) => _x ^ n :=
  is_group_hom.mk

protected instance gsmul.is_add_group_hom {A : Type y} [add_comm_group A] (n : ℤ) :
    is_add_group_hom (gsmul n) :=
  is_add_group_hom.mk

theorem zero_pow {R : Type u₁} [monoid_with_zero R] {n : ℕ} : 0 < n → 0 ^ n = 0 := sorry

namespace ring_hom

@[simp] theorem map_pow {R : Type u₁} {S : Type u₂} [semiring R] [semiring S] (f : R →+* S) (a : R)
    (n : ℕ) : coe_fn f (a ^ n) = coe_fn f a ^ n :=
  monoid_hom.map_pow (to_monoid_hom f) a

end ring_hom

theorem neg_one_pow_eq_or {R : Type u₁} [ring R] (n : ℕ) : (-1) ^ n = 1 ∨ (-1) ^ n = -1 := sorry

theorem pow_dvd_pow {R : Type u₁} [monoid R] (a : R) {m : ℕ} {n : ℕ} (h : m ≤ n) : a ^ m ∣ a ^ n :=
  sorry

theorem pow_dvd_pow_of_dvd {R : Type u₁} [comm_monoid R] {a : R} {b : R} (h : a ∣ b) (n : ℕ) :
    a ^ n ∣ b ^ n :=
  sorry

theorem pow_two_sub_pow_two {R : Type u_1} [comm_ring R] (a : R) (b : R) :
    a ^ bit0 1 - b ^ bit0 1 = (a + b) * (a - b) :=
  sorry

theorem eq_or_eq_neg_of_pow_two_eq_pow_two {R : Type u₁} [integral_domain R] (a : R) (b : R)
    (h : a ^ bit0 1 = b ^ bit0 1) : a = b ∨ a = -b :=
  sorry

theorem sq_sub_sq {R : Type u₁} [comm_ring R] (a : R) (b : R) :
    a ^ bit0 1 - b ^ bit0 1 = (a + b) * (a - b) :=
  sorry

theorem pow_eq_zero {R : Type u₁} [monoid_with_zero R] [no_zero_divisors R] {x : R} {n : ℕ}
    (H : x ^ n = 0) : x = 0 :=
  sorry

@[simp] theorem pow_eq_zero_iff {R : Type u₁} [monoid_with_zero R] [no_zero_divisors R] {a : R}
    {n : ℕ} (hn : 0 < n) : a ^ n = 0 ↔ a = 0 :=
  { mp := pow_eq_zero, mpr := fun (ᾰ : a = 0) => Eq._oldrec (zero_pow hn) (Eq.symm ᾰ) }

theorem pow_ne_zero {R : Type u₁} [monoid_with_zero R] [no_zero_divisors R] {a : R} (n : ℕ)
    (h : a ≠ 0) : a ^ n ≠ 0 :=
  mt pow_eq_zero h

theorem pow_abs {R : Type u₁} [linear_ordered_comm_ring R] (a : R) (n : ℕ) :
    abs a ^ n = abs (a ^ n) :=
  Eq.symm (monoid_hom.map_pow (monoid_with_zero_hom.to_monoid_hom abs_hom) a n)

theorem abs_neg_one_pow {R : Type u₁} [linear_ordered_comm_ring R] (n : ℕ) : abs ((-1) ^ n) = 1 :=
  sorry

theorem nsmul_nonneg {A : Type y} [ordered_add_comm_monoid A] {a : A} (H : 0 ≤ a) (n : ℕ) :
    0 ≤ n •ℕ a :=
  sorry

theorem nsmul_pos {A : Type y} [ordered_add_comm_monoid A] {a : A} (ha : 0 < a) {k : ℕ}
    (hk : 0 < k) : 0 < k •ℕ a :=
  sorry

theorem nsmul_le_nsmul {A : Type y} [ordered_add_comm_monoid A] {a : A} {n : ℕ} {m : ℕ} (ha : 0 ≤ a)
    (h : n ≤ m) : n •ℕ a ≤ m •ℕ a :=
  sorry

theorem nsmul_le_nsmul_of_le_right {A : Type y} [ordered_add_comm_monoid A] {a : A} {b : A}
    (hab : a ≤ b) (i : ℕ) : i •ℕ a ≤ i •ℕ b :=
  sorry

theorem gsmul_nonneg {A : Type y} [ordered_add_comm_group A] {a : A} (H : 0 ≤ a) {n : ℤ}
    (hn : 0 ≤ n) : 0 ≤ n •ℤ a :=
  sorry

theorem nsmul_lt_nsmul {A : Type y} [ordered_cancel_add_comm_monoid A] {a : A} {n : ℕ} {m : ℕ}
    (ha : 0 < a) (h : n < m) : n •ℕ a < m •ℕ a :=
  sorry

theorem min_pow_dvd_add {R : Type u₁} [semiring R] {n : ℕ} {m : ℕ} {a : R} {b : R} {c : R}
    (ha : c ^ n ∣ a) (hb : c ^ m ∣ b) : c ^ min n m ∣ a + b :=
  dvd_add (dvd.trans (pow_dvd_pow c (min_le_left n m)) ha)
    (dvd.trans (pow_dvd_pow c (min_le_right n m)) hb)

theorem add_pow_two {R : Type u₁} [comm_semiring R] (a : R) (b : R) :
    (a + b) ^ bit0 1 = a ^ bit0 1 + bit0 1 * a * b + b ^ bit0 1 :=
  sorry

namespace canonically_ordered_semiring

theorem pow_pos {R : Type u₁} [canonically_ordered_comm_semiring R] {a : R} (H : 0 < a) (n : ℕ) :
    0 < a ^ n :=
  sorry

theorem pow_le_pow_of_le_left {R : Type u₁} [canonically_ordered_comm_semiring R] {a : R} {b : R}
    (hab : a ≤ b) (i : ℕ) : a ^ i ≤ b ^ i :=
  sorry

theorem one_le_pow_of_one_le {R : Type u₁} [canonically_ordered_comm_semiring R] {a : R} (H : 1 ≤ a)
    (n : ℕ) : 1 ≤ a ^ n :=
  sorry

theorem pow_le_one {R : Type u₁} [canonically_ordered_comm_semiring R] {a : R} (H : a ≤ 1) (n : ℕ) :
    a ^ n ≤ 1 :=
  sorry

end canonically_ordered_semiring

@[simp] theorem pow_pos {R : Type u₁} [ordered_semiring R] {a : R} (H : 0 < a) (n : ℕ) :
    0 < a ^ n :=
  sorry

@[simp] theorem pow_nonneg {R : Type u₁} [ordered_semiring R] {a : R} (H : 0 ≤ a) (n : ℕ) :
    0 ≤ a ^ n :=
  sorry

theorem pow_lt_pow_of_lt_left {R : Type u₁} [ordered_semiring R] {x : R} {y : R} {n : ℕ}
    (Hxy : x < y) (Hxpos : 0 ≤ x) (Hnpos : 0 < n) : x ^ n < y ^ n :=
  sorry

theorem strict_mono_incr_on_pow {R : Type u₁} [ordered_semiring R] {n : ℕ} (hn : 0 < n) :
    strict_mono_incr_on (fun (x : R) => x ^ n) (set.Ici 0) :=
  fun (x : R) (hx : x ∈ set.Ici 0) (y : R) (hy : y ∈ set.Ici 0) (h : x < y) =>
    pow_lt_pow_of_lt_left h hx hn

theorem one_le_pow_of_one_le {R : Type u₁} [ordered_semiring R] {a : R} (H : 1 ≤ a) (n : ℕ) :
    1 ≤ a ^ n :=
  sorry

theorem pow_mono {R : Type u₁} [ordered_semiring R] {a : R} (h : 1 ≤ a) :
    monotone fun (n : ℕ) => a ^ n :=
  monotone_of_monotone_nat
    fun (n : ℕ) => le_mul_of_one_le_left (pow_nonneg (has_le.le.trans zero_le_one h) n) h

theorem pow_le_pow {R : Type u₁} [ordered_semiring R] {a : R} {n : ℕ} {m : ℕ} (ha : 1 ≤ a)
    (h : n ≤ m) : a ^ n ≤ a ^ m :=
  pow_mono ha h

theorem strict_mono_pow {R : Type u₁} [ordered_semiring R] {a : R} (h : 1 < a) :
    strict_mono fun (n : ℕ) => a ^ n :=
  sorry

theorem pow_lt_pow {R : Type u₁} [ordered_semiring R] {a : R} {n : ℕ} {m : ℕ} (h : 1 < a)
    (h2 : n < m) : a ^ n < a ^ m :=
  strict_mono_pow h h2

theorem pow_lt_pow_iff {R : Type u₁} [ordered_semiring R] {a : R} {n : ℕ} {m : ℕ} (h : 1 < a) :
    a ^ n < a ^ m ↔ n < m :=
  strict_mono.lt_iff_lt (strict_mono_pow h)

theorem pow_le_pow_of_le_left {R : Type u₁} [ordered_semiring R] {a : R} {b : R} (ha : 0 ≤ a)
    (hab : a ≤ b) (i : ℕ) : a ^ i ≤ b ^ i :=
  sorry

theorem pow_left_inj {R : Type u₁} [linear_ordered_semiring R] {x : R} {y : R} {n : ℕ}
    (Hxpos : 0 ≤ x) (Hypos : 0 ≤ y) (Hnpos : 0 < n) (Hxyn : x ^ n = y ^ n) : x = y :=
  strict_mono_incr_on.inj_on (strict_mono_incr_on_pow Hnpos) Hxpos Hypos Hxyn

theorem lt_of_pow_lt_pow {R : Type u₁} [linear_ordered_semiring R] {a : R} {b : R} (n : ℕ)
    (hb : 0 ≤ b) (h : a ^ n < b ^ n) : a < b :=
  lt_of_not_ge fun (hn : a ≥ b) => not_lt_of_ge (pow_le_pow_of_le_left hb hn n) h

theorem le_of_pow_le_pow {R : Type u₁} [linear_ordered_semiring R] {a : R} {b : R} (n : ℕ)
    (hb : 0 ≤ b) (hn : 0 < n) (h : a ^ n ≤ b ^ n) : a ≤ b :=
  le_of_not_lt fun (h1 : b < a) => not_le_of_lt (pow_lt_pow_of_lt_left h1 hb hn) h

theorem pow_bit0_nonneg {R : Type u₁} [linear_ordered_ring R] (a : R) (n : ℕ) : 0 ≤ a ^ bit0 n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ a ^ bit0 n)) (pow_bit0 a n))) (mul_self_nonneg (a ^ n))

theorem pow_two_nonneg {R : Type u₁} [linear_ordered_ring R] (a : R) : 0 ≤ a ^ bit0 1 :=
  pow_bit0_nonneg a 1

theorem pow_bit0_pos {R : Type u₁} [linear_ordered_ring R] {a : R} (h : a ≠ 0) (n : ℕ) :
    0 < a ^ bit0 n :=
  has_le.le.lt_of_ne (pow_bit0_nonneg a n) (ne.symm (pow_ne_zero (bit0 n) h))

theorem pow_two_pos_of_ne_zero {R : Type u₁} [linear_ordered_ring R] (a : R) (h : a ≠ 0) :
    0 < a ^ bit0 1 :=
  pow_bit0_pos h 1

@[simp] theorem eq_of_pow_two_eq_pow_two {R : Type u₁} [linear_ordered_comm_ring R] {a : R} {b : R}
    (ha : 0 ≤ a) (hb : 0 ≤ b) : a ^ bit0 1 = b ^ bit0 1 ↔ a = b :=
  sorry

@[simp] theorem neg_square {α : Type u_1} [ring α] (z : α) : (-z) ^ bit0 1 = z ^ bit0 1 := sorry

theorem of_add_nsmul {A : Type y} [add_monoid A] (x : A) (n : ℕ) :
    coe_fn multiplicative.of_add (n •ℕ x) = coe_fn multiplicative.of_add x ^ n :=
  rfl

theorem of_add_gsmul {A : Type y} [add_group A] (x : A) (n : ℤ) :
    coe_fn multiplicative.of_add (n •ℤ x) = coe_fn multiplicative.of_add x ^ n :=
  rfl

@[simp] theorem semiconj_by.gpow_right {G : Type w} [group G] {a : G} {x : G} {y : G}
    (h : semiconj_by a x y) (m : ℤ) : semiconj_by a (x ^ m) (y ^ m) :=
  sorry

namespace commute

@[simp] theorem gpow_right {G : Type w} [group G] {a : G} {b : G} (h : commute a b) (m : ℤ) :
    commute a (b ^ m) :=
  semiconj_by.gpow_right h m

@[simp] theorem gpow_left {G : Type w} [group G] {a : G} {b : G} (h : commute a b) (m : ℤ) :
    commute (a ^ m) b :=
  commute.symm (gpow_right (commute.symm h) m)

theorem gpow_gpow {G : Type w} [group G] {a : G} {b : G} (h : commute a b) (m : ℤ) (n : ℤ) :
    commute (a ^ m) (b ^ n) :=
  gpow_right (gpow_left h m) n

@[simp] theorem self_gpow {G : Type w} [group G] (a : G) (n : ℕ) : commute a (a ^ n) :=
  gpow_right (commute.refl a) ↑n

@[simp] theorem gpow_self {G : Type w} [group G] (a : G) (n : ℕ) : commute (a ^ n) a :=
  gpow_left (commute.refl a) ↑n

@[simp] theorem gpow_gpow_self {G : Type w} [group G] (a : G) (m : ℕ) (n : ℕ) :
    commute (a ^ m) (a ^ n) :=
  gpow_gpow (commute.refl a) ↑m ↑n

end Mathlib


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import linear_algebra.clifford_algebra.basic
import algebra.module.opposites

/-!
# Conjugations

This file defines the grade reversal and grade involution functions on multivectors, `reverse` and
`involute`.
Together, these operations compose to form the "Clifford conjugate", hence the name of this file.

https://en.wikipedia.org/wiki/Clifford_algebra#Antiautomorphisms

## Main definitions

* `clifford_algebra.involute`: the grade involution, negating each basis vector
* `clifford_algebra.reverse`: the grade reversion, reversing the order of a product of vectors

## Main statements

* `clifford_algebra.involute_involutive`
* `clifford_algebra.reverse_involutive`
* `clifford_algebra.reverse_involute_commute`
-/

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {Q : quadratic_form R M}

namespace clifford_algebra

section involute

/-- Grade involution, inverting the sign of each basis vector. -/
def involute : clifford_algebra Q →ₐ[R] clifford_algebra Q :=
clifford_algebra.lift Q ⟨-(ι Q), λ m, by simp⟩

@[simp] lemma involute_ι (m : M) : involute (ι Q m) = -ι Q m :=
lift_ι_apply _ _ m

@[simp] lemma involute_comp_involute : involute.comp involute = alg_hom.id R (clifford_algebra Q) :=
by { ext, simp }

lemma involute_involutive : function.involutive (involute : _ → clifford_algebra Q) :=
alg_hom.congr_fun involute_comp_involute

@[simp] lemma involute_involute : ∀ a : clifford_algebra Q, involute (involute a) = a :=
involute_involutive

end involute

section reverse
open mul_opposite

/-- Grade reversion, inverting the multiplication order of basis vectors.
Also called *transpose* in some literature. -/
def reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q :=
(op_linear_equiv R).symm.to_linear_map.comp (
  clifford_algebra.lift Q ⟨(mul_opposite.op_linear_equiv R).to_linear_map.comp (ι Q),
    λ m, unop_injective $ by simp⟩).to_linear_map

@[simp] lemma reverse_ι (m : M) : reverse (ι Q m) = ι Q m :=
by simp [reverse]

@[simp] lemma reverse.commutes (r : R) :
  reverse (algebra_map R (clifford_algebra Q) r) = algebra_map R _ r :=
by simp [reverse]

@[simp] lemma reverse.map_one : reverse (1 : clifford_algebra Q) = 1 :=
by convert reverse.commutes (1 : R); simp

@[simp] lemma reverse.map_mul (a b : clifford_algebra Q) :
  reverse (a * b) = reverse b * reverse a :=
by simp [reverse]

@[simp] lemma reverse_comp_reverse :
  reverse.comp reverse = (linear_map.id : _ →ₗ[R] clifford_algebra Q) :=
begin
  ext m,
  simp only [linear_map.id_apply, linear_map.comp_apply],
  induction m using clifford_algebra.induction,
  -- simp can close these goals, but is slow
  case h_grade0 : { rw [reverse.commutes, reverse.commutes] },
  case h_grade1 : { rw [reverse_ι, reverse_ι] },
  case h_mul : a b ha hb { rw [reverse.map_mul, reverse.map_mul, ha, hb], },
  case h_add : a b ha hb { rw [reverse.map_add, reverse.map_add, ha, hb], },
end

@[simp] lemma reverse_involutive : function.involutive (reverse : _ → clifford_algebra Q) :=
linear_map.congr_fun reverse_comp_reverse

@[simp] lemma reverse_reverse : ∀ a : clifford_algebra Q, reverse (reverse a) = a :=
reverse_involutive

lemma reverse_comp_involute :
  reverse.comp involute.to_linear_map =
    (involute.to_linear_map.comp reverse : _ →ₗ[R] clifford_algebra Q) :=
begin
  ext,
  simp only [linear_map.comp_apply, alg_hom.to_linear_map_apply],
  induction x using clifford_algebra.induction,
  case h_grade0 : { simp },
  case h_grade1 : { simp },
  case h_mul : a b ha hb { simp only [ha, hb, reverse.map_mul, alg_hom.map_mul], },
  case h_add : a b ha hb { simp only [ha, hb, reverse.map_add, alg_hom.map_add], },
end

/-- `clifford_algebra.reverse` and `clifford_algebra.inverse` commute. Note that the composition
is sometimes referred to as the "clifford conjugate". -/
lemma reverse_involute_commute : function.commute (reverse : _ → clifford_algebra Q) involute :=
linear_map.congr_fun reverse_comp_involute

lemma reverse_involute : ∀ a : clifford_algebra Q, reverse (involute a) = involute (reverse a) :=
reverse_involute_commute

end reverse

/-!
### Statements about conjugations of products of lists
-/

section list

/-- Taking the reverse of the product a list of $n$ vectors lifted via `ι` is equivalent to
taking the product of the reverse of that list. -/
lemma reverse_prod_map_ι : ∀ (l : list M), reverse (l.map $ ι Q).prod = (l.map $ ι Q).reverse.prod
| [] := by simp
| (x :: xs) := by simp [reverse_prod_map_ι xs]

/-- Taking the involute of the product a list of $n$ vectors lifted via `ι` is equivalent to
premultiplying by ${-1}^n$. -/
lemma involute_prod_map_ι : ∀ l : list M,
  involute (l.map $ ι Q).prod = ((-1 : R)^l.length) • (l.map $ ι Q).prod
| [] := by simp
| (x :: xs) := by simp [pow_add, involute_prod_map_ι xs]

end list

end clifford_algebra