import ring_theory.polynomial.cyclotomic.basic
import ring_theory.polynomial.cyclotomic.eval
import algebra
import tactic
import cyclotomic
import data.fintype.units
import number_theory.multiplicity

variables {a n : ℕ}

lemma order_of_units_le_totient [ne_zero n] (h_coprime : a.coprime n) :
order_of (zmod.unit_of_coprime a h_coprime) ≤ n.totient :=
begin
  rw ←zmod.card_units_eq_totient,
  exact order_of_le_card_univ,
end

lemma order_of_units_pos [ne_zero n] (h_coprime : a.coprime n) :
0 < order_of (zmod.unit_of_coprime a h_coprime) :=
begin
  apply order_of_pos,
end

lemma nat_dvd_mul_pow_of_one_le (a b c : ℕ) : 1 ≤ c → a ∣ b * a ^ c :=
begin
  intro h_le,
  use b * a ^ (c - 1),
  rw [mul_comm a _, mul_assoc, mul_eq_mul_left_iff],
  left,
  rw [← nat.sub_add_cancel h_le, pow_add, pow_one, nat.sub_add_cancel h_le],
end

lemma mul_pow_dvd_eq_mul_pow_sub (a b c : ℕ) (h_pos : 0 < b) : 1 ≤ c
→ a * b ^ c / b = a * b ^ (c - 1) :=
begin
  intro hc,
  have h_pow_sub_add : b ^ (c - 1) * b = b ^ c,
  {
    nth_rewrite 1 ← pow_one b,
    rw [ ← pow_add, nat.sub_add_cancel hc],
  },
  have h_dvd : b ∣ b ^ c,
  {
    use b ^ (c - 1),
    rw [← h_pow_sub_add, mul_comm],
  },
  rw [nat.mul_div_assoc a h_dvd, mul_eq_mul_left_iff],
  left,
  rw [← h_pow_sub_add, nat.mul_div_cancel],
  exact h_pos,
end

lemma dvd_pow_order_mul_sub_one (a b c : ℕ) (h_coprime : a.coprime b) (ha : 1 ≤ a) :
b ∣ a ^ (order_of (zmod.unit_of_coprime a h_coprime) * c) - 1 :=
begin
  have h_a_pos : 0 < a := by linarith,
  have h_order_dvd : order_of (zmod.unit_of_coprime a h_coprime) ∣
  order_of (zmod.unit_of_coprime a h_coprime) * c := by { use c, },
  rw [order_of_dvd_iff_pow_eq_one, ← units.eq_iff, ← sub_eq_zero, units.coe_pow,
  zmod.coe_unit_of_coprime, units.coe_one, ← nat.cast_one, ← nat.cast_pow,
  ← nat.cast_sub
  (nat.one_le_pow (order_of (zmod.unit_of_coprime a h_coprime) * c) a h_a_pos),
  ← int.cast_coe_nat, zmod.int_coe_zmod_eq_zero_iff_dvd,
  int.coe_nat_dvd] at h_order_dvd,
  exact h_order_dvd,
end

lemma four_dvd_pow_sub_one_of_two_dvd (h_coprime : a.coprime 2) :
2 ∣ n → 4 ∣ a ^ n - 1 :=
begin
  intro h_dvd,
  cases h_dvd with k hk,
  subst hk,
  cases em (k = 0) with h_k_eq_zero h_k_ne_zero,
  {
    subst h_k_eq_zero,
    simp only [mul_zero, pow_zero, dvd_zero],
  },
  {
    rw [mul_comm, pow_mul],
    set b := a ^ k with hb,
    have h_odd : odd b,
    {
      rw [hb, nat.odd_iff_not_even, nat.even_pow' h_k_ne_zero],
      intro h_even,
      cases h_even with a' ha',
      rw ← two_mul at ha',
      rw ha' at h_coprime,
      apply nat.not_coprime_of_dvd_of_dvd one_lt_two _ _ h_coprime,
      { use a', },
      { refl, }
    },
    cases h_odd with b' hb',
    use ((b - 1) / 2) * ((b + 1) / 2),
    rw [hb', add_assoc, one_add_one_eq_two],
    nth_rewrite 6 ← mul_one 2,
    simp only [nat.add_succ_sub_one, add_zero, nat.mul_div_right,
    zero_lt_bit0, nat.lt_one_iff, ← mul_add],
    ring_nf,
  }
end

lemma nat_multiplicity_self (a : ℕ) : 2 ≤ a → multiplicity a a = 1 :=
begin
  intro ha,
  apply multiplicity.multiplicity_self,
  {
    rw nat.is_unit_iff,
    linarith,
  },
  { linarith, }
end

lemma sub_one_mul_lt_pow_sub_one (a b : ℕ) (hb : 1 < b) :
1 < a → (a - 1) * b < a ^ b - 1 :=
begin
  intro ha,
  have hpos : 0 < a := by linarith,
  rw ← int.coe_nat_lt,
  simp only [algebra_map.coe_one, coe_pow, int.coe_nat_mul,
  int.coe_nat_sub (le_of_lt ha), int.coe_nat_sub (nat.one_le_pow b a hpos)],
  rw [← int.coe_nat_lt, int.coe_nat_one] at ha,
  rw ← mul_geom_sum,
  apply int.mul_lt_mul_of_pos_left,
  {
    have h_b_eq_sum : (b : ℤ) = (finset.range b).sum (λ (i : ℕ), 1) := by {
      simp only [finset.sum_const, finset.card_range, nat.smul_one_eq_coe],
    },
    rw h_b_eq_sum,
    apply finset.sum_lt_sum,
    {
      intros i hi,
      rw [← int.coe_nat_pow, ← nat.cast_one, int.coe_nat_le],
      exact nat.one_le_pow i a hpos,
    },
    {
      use 1,
      rw [finset.mem_range, pow_one],
      split,
      { exact hb, },
      { exact ha }
    }
  },
  { linarith, }
end

lemma nat_pow_le_one_iff (a b : ℕ) : a ^ b ≤ 1 ↔ a ≤ 1 ∨ b = 0 :=
begin
  split,
  {
    intro h_le_one,
    cases em (b = 0) with hb hb,
    {
      right,
      exact hb,
    },
    {
      left,
      have h_one_le_b : 1 ≤ b,
      {
        cases b,
        {
          exfalso,
          apply hb,
          refl,
        },
        {
          rw nat.succ_eq_add_one,
          linarith,
        }
      },
      rw [← one_pow b, nat.pow_le_iff_le_left h_one_le_b] at h_le_one,
      exact h_le_one,
    }
  },
  {
    intro h_or,
    cases h_or,
    {
      rw ← one_pow b,
      apply nat.pow_le_pow_of_le_left h_or,
    },
    {
      rw [h_or, pow_zero],
    }
  }
end

lemma order_of_two_mod_three_eq_two (h_coprime : (2 : ℕ).coprime 3) :
order_of (zmod.unit_of_coprime 2 h_coprime) = 2 :=
begin
  haveI : nat.prime 2,
  { exact nat.prime_two, },
  apply order_of_eq_prime,
  {
    rw [← units.eq_iff, units.coe_pow, zmod.coe_unit_of_coprime,
    units.coe_one, nat.cast_two],
    ring,
  },
  {
    intro h,
    rw [← units.eq_iff, zmod.coe_unit_of_coprime,
    units.coe_one, nat.cast_two, ← sub_eq_zero] at h,
    norm_num at h,
  }
end

lemma order_of_eq_one_in_units_two (h_coprime : a.coprime 2) :
order_of (zmod.unit_of_coprime a h_coprime) = 1 :=
begin
  simp only [order_of_eq_one_iff, eq_iff_true_of_subsingleton],
end

lemma three_mul_le_pow_sub (x : ℕ) : (2 + 1) * ((x + 5) : ℤ) ≤ 2 ^ (x + 5) - 1 :=
begin
  induction x with x hi,
  {
    norm_num,
  },
  {
    transitivity (2 ^ (x + 5) - 1 + ((2 : ℤ) + 1)),
    {
      rw [nat.cast_succ, add_assoc],
      nth_rewrite 2 add_comm,
      rw [← add_assoc, mul_add, mul_one],
      exact int.add_le_add_right hi _,
    },
    {
      rw [sub_add_add_cancel, nat.succ_eq_add_one],
      nth_rewrite 3 add_comm,
      rw [add_assoc],
      repeat { rw pow_add, },
      set two_pow := (2 : ℤ) ^ x with h_pow,
      have h_pow_nonneg: 1 ≤ two_pow,
      {
        rw [h_pow, ← nat.cast_one, ← nat.cast_bit0, ← nat.cast_pow,
        nat.cast_le],
        apply nat.one_le_pow,
        linarith,
      },
      norm_num,
      linarith,
    }
  }
end

lemma two_mul_le_pow_sub_one (x : ℤ) (a : ℕ) (hx : 2 < x) (ha : 2 ≤ a) :
2 * (x - 1) * (a : ℤ) ≤ x ^ a - 1 :=
begin
  nth_rewrite 1 mul_comm,
  rw [mul_assoc, ← mul_geom_sum, mul_le_mul_left],
  {
    cases a,
    {
      linarith,
    },
    {
      rw nat.succ_eq_add_one at ha,
      rw nat.succ_eq_add_one,
      have h_one_le_a : 1 ≤ a + 1 := by linarith,
      rw [finset.range_eq_Ico, ← finset.Ico_union_Ico_eq_Ico zero_le_one h_one_le_a,
      finset.sum_union (finset.Ico_disjoint_Ico_consecutive 0 1 (a + 1)),
      nat.cast_succ, nat.Ico_succ_singleton, finset.sum_singleton, pow_zero],
      transitivity 1 + 3 * (a : ℤ),
      { linarith, },
      {
        apply int.add_le_add_left _ 1,
        have h_mul_a_eq_sum : 3 * (a : ℤ) = (finset.Ico 1 (a + 1)).sum (λ (i : ℕ), 3),
        {
          simp only [finset.sum_const, nat.card_Ico, nat.add_succ_sub_one,
          add_zero, nsmul_eq_mul, mul_comm],
        },
        rw h_mul_a_eq_sum,
        apply finset.sum_le_sum,
        intros i hi,
        transitivity x,
        { linarith, },
        {
          nth_rewrite 0 ← pow_one x,
          apply pow_le_pow,
          { linarith, },
          {
            rw finset.mem_Ico at hi,
            exact hi.left,
          }
        }
      }
    }
  },
  { linarith, }
end

lemma part_enat_add_le_add_iff_left {x y z : part_enat} (hz : z ≠ ⊤) :
z + x ≤ z + y ↔ x ≤ y :=
begin
  repeat {rw le_iff_lt_or_eq},
  rw [part_enat.add_lt_add_iff_left hz, part_enat.add_left_cancel_iff hz],
end

lemma int_char_zero : char_zero ℤ :=
begin
  apply char_zero_of_inj_zero,
  intros n hn,
  rw ← nat.cast_zero at hn,
  exact int.coe_nat_inj hn,
end

lemma le_of_order_mul_pow_eq_order_mul_pow (p q t₁ t₂ : ℕ)
(h_p_prime : p.prime) (h_q_prime : q.prime)
(h_p_coprime : a.coprime p) (h_q_coprime : a.coprime q)
(h_one_le_first : 1 ≤ t₁) (h_one_le_second : 1 ≤ t₂) :
order_of (zmod.unit_of_coprime a h_p_coprime) * p ^ t₁
= order_of (zmod.unit_of_coprime a h_q_coprime) * q ^ t₂ → p ≤ q :=
begin
  intro h,
  cases em (p = q) with h_eq h_ne,
  { rw h_eq, },
  {
    have h_p_dvd_mul : p ∣ order_of (zmod.unit_of_coprime a h_q_coprime) * q ^ t₂,
    {
      use order_of (zmod.unit_of_coprime a h_p_coprime) * p ^ (t₁ - 1),
      rw [← h, ← mul_assoc, mul_comm p _, mul_assoc, mul_eq_mul_left_iff],
      left,
      rw [← nat.sub_add_cancel h_one_le_first, pow_add, mul_comm,
      pow_one, nat.add_succ_sub_one, add_zero],
    },
    rw nat.prime.dvd_mul h_p_prime at h_p_dvd_mul,
    cases h_p_dvd_mul with h_dvd h_dvd,
    swap,
    {
      exfalso,
      apply h_ne,
      rw ← nat.prime_dvd_prime_iff_eq h_p_prime h_q_prime,
      exact nat.prime.dvd_of_dvd_pow h_p_prime h_dvd,
    },
    {
      haveI : ne_zero q := ⟨ nat.prime.ne_zero h_q_prime, ⟩,
      transitivity order_of (zmod.unit_of_coprime a h_q_coprime),
      { exact nat.le_of_dvd (order_of_units_pos h_q_coprime) h_dvd, },
      {
        transitivity q - 1,
        {
          rw ← nat.totient_prime h_q_prime,
          exact order_of_units_le_totient h_q_coprime,
        },
        {
          exact tsub_le_self,
        }
      }
    }
  }
end

theorem exists_prime_of_order (hn : 1 < n) (ha : 1 < a)
(h_exception_1 : ¬(n = 2 ∧ (∃ (s : ℕ), a = 2 ^ s - 1)))
(h_exception_2 : ¬(n = 6 ∧ a = 2)) : ∃ (p : ℕ) (h_coprime : (a.coprime p)),
(nat.prime p) ∧ order_of(zmod.unit_of_coprime a h_coprime) = n :=
begin
  by_contra,
  simp only [not_exists, not_and] at h,
  have hpos_n : 0 < n := by {transitivity 1, exact zero_lt_one, exact hn, },
  set Φ := (polynomial.eval ↑a (polynomial.cyclotomic n ℤ)).to_nat with h_Phi_def,
  have h_one_le_a_int : 1 ≤ (a : ℤ) := by linarith,
  have h_Phi : 1 < Φ,
  {
    simp only [int.lt_to_nat, nat.cast_one],
    set a' := (a : ℤ),
    have h_one_lt_a' : 1 < a' := by linarith,
    have h_one_le : 1 ≤ (a' - 1) ^ (n.totient),
    {
      apply one_le_pow_of_one_le,
      linarith,
    },
    exact lt_of_le_of_lt h_one_le (X_sub_one_pow_lt_cyclotomic hn h_one_lt_a'),
  },
  have h_one_le : ∀ (k : ℕ), 1 ≤ a ^ k,
  {
    intro k,
    apply nat.one_le_pow,
    apply nat.pos_of_ne_zero,
    intro h,
    subst h,
    linarith,
  },
  have h_one_lt : ∀ (k : ℕ), 0 < k → 1 < a ^ k,
  {
    intros k hk,
    exact nat.one_lt_pow k a hk ha,
  },
  have h_one_lt_int : ∀ (k : ℕ), 0 < k → 1 < (a : ℤ) ^ k,
  {
    intros k hk,
    rw [← int.coe_nat_pow, ← nat.cast_one, int.coe_nat_lt],
    exact h_one_lt k hk,
  },
  cases h_primes : Φ.factors with p others,
  { rw nat.factors_eq_nil at h_primes, cases h_primes, linarith, linarith, },
  have h_p_in_factors : p ∈ Φ.factors := by { rw h_primes, exact list.mem_cons_self p _},
  have h_p_prime : p.prime := by exact nat.prime_of_mem_factors h_p_in_factors,
  have h_p_prime_fact : fact (p.prime) := by { rw fact_iff, exact h_p_prime },
  have h_coprime : ∀ (d : ℕ) (h_dvd : d ∣ Φ), a.coprime d,
  {
    intros d h_dvd,
    have h_dvd' : d ∣ a ^ n - 1,
    {
      apply nat.dvd_trans h_dvd _,
      rw ← int.coe_nat_dvd,
      have h_one_le_pow : 1 ≤ a ^ n :=
      by exact one_le_pow_of_one_le (le_of_lt ha) n,
      have h_one_lt_coe_a : 1 < (a : ℤ) := by linarith,
      have h_eq_eval : (a : ℤ) ^ n - 1 = polynomial.eval (a : ℤ) (polynomial.X ^ n - 1) :=
      by simp only [polynomial.eval_sub, polynomial.eval_pow,
      polynomial.eval_X, polynomial.eval_one],
      rw [int.coe_nat_sub h_one_le_pow, int.coe_nat_pow, nat.cast_one,
      int.to_nat_of_nonneg (polynomial.cyclotomic_nonneg n (le_of_lt h_one_lt_coe_a)),
      h_eq_eval],
      exact polynomial.eval_dvd (polynomial.cyclotomic.dvd_X_pow_sub_one n ℤ),
    },
    cases h_dvd' with t h_dvd',
    have h_pos_t : 0 < t,
    {
      apply nat.pos_of_ne_zero,
      intro h,
      subst h,
      simp only [mul_zero, tsub_eq_zero_iff_le,
      pow_le_one_iff (nat_ne_zero_of_pos hpos_n)] at h_dvd',
      linarith,
    },
    have h_dvd_t : t ∣ a ^ n - 1 := by { rw h_dvd', exact dvd_mul_left t d },
    have h_div : (a ^ n - 1) / t = d := by exact nat.div_eq_of_eq_mul_left h_pos_t h_dvd',
    rw ← h_div,
    apply nat.coprime.coprime_div_right _ h_dvd_t,
    have h_a_pow_sub_one_eq : a ^ n - 1 = (a ^ (n - 1) - 1) * a + (a - 1),
    {
      apply int.coe_nat_inj,
      rw [int.coe_nat_sub (h_one_le n), int.coe_nat_add, int.coe_nat_mul,
      int.coe_nat_sub (h_one_le (n - 1)), int.coe_nat_sub (le_of_lt ha),
      int.coe_nat_pow, int.coe_nat_pow, int.coe_nat_one, sub_mul,
      one_mul, sub_add_sub_cancel, sub_left_inj, ← nat.sub_add_cancel (le_of_lt hn),
      pow_add, pow_one, nat.add_succ_sub_one, add_zero],
    },
    have h_a_eq : a - 1 + 1 = a := by exact nat.sub_add_cancel (le_of_lt ha),
    have h_cancel : a - 1 + 1 - 1 = a - 1 :=
    by rw [nat.add_succ_sub_one, add_zero],
    rw [h_a_pow_sub_one_eq,
    nat.coprime_mul_right_add_right a (a - 1) (a ^ (n - 1) - 1),
    nat.coprime_comm, ← h_a_eq, h_cancel,
    nat.coprime_self_add_right],
    exact nat.coprime_one_right (a - 1),
  },
  have h_a_coprime_p : a.coprime p := by exact h_coprime p (nat.dvd_of_mem_factors h_p_in_factors),
  have h_order_ne_n : ∀ (p' : ℕ) (h_in_factors : p' ∈ Φ.factors), ¬order_of
  (zmod.unit_of_coprime a (h_coprime p' (nat.dvd_of_mem_factors h_in_factors))) = n :=
  by { intros p' h_in_factors,
  exact h p' (h_coprime p' (nat.dvd_of_mem_factors h_in_factors))
  (nat.prime_of_mem_factors h_in_factors), },
  have h_p_dvd : ∀ (p' : ℕ) (h_in_factors : p' ∈ Φ.factors), p' ∣ n,
  {
    intros p' h_in_factors,
    by_contra h_not_dvd,
    apply h_order_ne_n,
    have h_p'_dvd_int : ↑p' ∣ polynomial.eval ↑a (polynomial.cyclotomic n ℤ),
    {
      cases nat.dvd_of_mem_factors h_in_factors with t h_phi_eq,
      use ↑t,
      rw [← int.coe_nat_mul, ← h_phi_eq,
      int.to_nat_of_nonneg (polynomial.cyclotomic_nonneg n h_one_le_a_int)],
    },
    have h_p'_prime_fact : fact (p'.prime) :=
    by { rw fact_iff, exact nat.prime_of_mem_factors h_in_factors, },
    have h_order_is_n' : ∃ (h_coprime : a.coprime p'),
    order_of(zmod.unit_of_coprime a h_coprime) = n :=
    by exact order_of_eq_iff_is_root_of_cyclotomic
    h_p'_prime_fact h_not_dvd hpos_n (ne_of_lt ha) h_p'_dvd_int,
    cases h_order_is_n',
    exact h_order_is_n'_h,
    exact h_in_factors,
  },
  set ord := order_of (zmod.unit_of_coprime a
  h_a_coprime_p) with h_ord_def,
  have h_n_eq_ord_mul_pow : ∀ (p' : ℕ) (h_in_factors : p' ∈ Φ.factors),
   ∃ (t : ℕ), n = order_of (zmod.unit_of_coprime a
  (h_coprime p' (nat.dvd_of_mem_factors h_in_factors))) * p' ^ t ∧ 1 ≤ t,
  {
    intros p' h_in_factors,
    set a_unit := zmod.unit_of_coprime a
    (h_coprime p' (nat.dvd_of_mem_factors h_in_factors)) with h_a_def,
    have h_root : (polynomial.cyclotomic n (zmod p')).is_root a_unit,
    {
      simp only [zmod.coe_unit_of_coprime, polynomial.is_root.def],
      rw [← polynomial.map_cyclotomic_int, polynomial.eval_nat_cast_map,
      eq_int_cast, zmod.int_coe_zmod_eq_zero_iff_dvd,
      ← int.to_nat_of_nonneg (polynomial.cyclotomic_nonneg n h_one_le_a_int),
      int.coe_nat_dvd, ← h_Phi_def],
      exact nat.dvd_of_mem_factors h_in_factors,
    },
    have h_p'_prime_fact : fact (p'.prime) :=
    by { rw fact_iff, exact nat.prime_of_mem_factors h_in_factors, },
    cases prime_dvd_cyclotomic hpos_n h_p'_prime_fact h_root with t ht,
    use t,
    split,
    { exact ht, },
    {
      by_contra,
      simp only [not_le, nat.lt_one_iff] at h,
      subst h,
      simp only [pow_zero, mul_one] at ht,
      haveI : ne_zero p' := ⟨ nat.prime.ne_zero (nat.prime_of_mem_factors h_in_factors) ⟩,
      have h_order_lt_p' : order_of (zmod.unit_of_coprime a
      (h_coprime p' (nat.dvd_of_mem_factors h_in_factors))) < p',
      {
        have h_p'_sub_one_lt : p' - 1 < p' := by exact nat.sub_lt
        (nat.prime.pos (nat.prime_of_mem_factors h_in_factors)) zero_lt_one,
        have h_order_le_p'_sub_one :
        order_of (zmod.unit_of_coprime a (h_coprime p'
        (nat.dvd_of_mem_factors h_in_factors))) ≤ p' - 1 := by {
          rw ← nat.totient_prime (nat.prime_of_mem_factors h_in_factors),
          exact order_of_units_le_totient (h_coprime p'
          (nat.dvd_of_mem_factors h_in_factors)),
        },
        exact lt_of_le_of_lt h_order_le_p'_sub_one h_p'_sub_one_lt,
      },
      apply nat.not_dvd_of_pos_of_lt
      (order_of_units_pos (h_coprime p' (nat.dvd_of_mem_factors h_in_factors))) h_order_lt_p',
      rw ← ht,
      exact h_p_dvd p' h_in_factors,
    }
  },
  have h_eq_prime_pow : Φ = p ^ Φ.factors.length,
  {
    have h_Phi_pos : Φ ≠ 0 := by linarith,
    apply nat.eq_prime_pow_of_unique_prime_dvd h_Phi_pos,
    intros q h_q_prime h_q_dvd_Phi,
    have h_q_in_factors : q ∈ Φ.factors,
    {
      rw nat.mem_factors,
      split,
      { exact h_q_prime, },
      { exact h_q_dvd_Phi, },
      { linarith, }
    },
    cases h_n_eq_ord_mul_pow p h_p_in_factors with t₁ h_n_eq₁,
    cases h_n_eq₁ with h_n_eq₁ h_one_le_t₁,
    cases h_n_eq_ord_mul_pow q h_q_in_factors with t₂ h_n_eq₂,
    cases h_n_eq₂ with h_n_eq₂ h_one_le_t₂,
    rw h_n_eq₁ at h_n_eq₂,
    have h_p_le_q : p ≤ q := by
    exact le_of_order_mul_pow_eq_order_mul_pow p q t₁ t₂
    h_p_prime h_q_prime
    h_a_coprime_p
    (h_coprime q h_q_dvd_Phi)
    h_one_le_t₁ h_one_le_t₂ h_n_eq₂,
    symmetry' at h_n_eq₂,
    have h_q_le_p : q ≤ p := by
    exact le_of_order_mul_pow_eq_order_mul_pow q p t₂ t₁
    h_q_prime h_p_prime
    (h_coprime q h_q_dvd_Phi)
    h_a_coprime_p
    h_one_le_t₂ h_one_le_t₁ h_n_eq₂,
    exact has_le.le.antisymm h_q_le_p h_p_le_q,
  },
  have h_prime_square_not_dvd : p ^ 2 ∣ Φ → (p = 2 ∧ n = 2),
  {
    intro h_square_dvd,
    have h_Phi_mul_pow_sub_one_dvd : Φ * (a ^ (n / p) - 1) ∣
    (a ^ n - 1),
    {
      have h_one_lt_coe_a : 1 < (a : ℤ) := by linarith,
      have h_eq_eval : (a : ℤ) ^ n - 1 = polynomial.eval (a : ℤ) (polynomial.X ^ n - 1) :=
      by simp only [polynomial.eval_sub, polynomial.eval_pow,
      polynomial.eval_X, polynomial.eval_one],
      have h_eq_eval' : (a : ℤ) ^ (n / p) - 1 =
      polynomial.eval (a : ℤ) (polynomial.X ^ (n / p) - 1) :=
      by simp only [polynomial.eval_sub, polynomial.eval_pow,
      polynomial.eval_X, polynomial.eval_one],
      rw [← int.coe_nat_dvd, h_Phi_def, nat.cast_mul,
      int.coe_nat_sub (one_le_pow_of_one_le (le_of_lt ha) n),
      int.coe_nat_pow, nat.cast_one,
      int.to_nat_of_nonneg (polynomial.cyclotomic_nonneg n (le_of_lt h_one_lt_coe_a)),
      h_eq_eval, int.coe_nat_sub (one_le_pow_of_one_le (le_of_lt ha) (n / p)),
      int.coe_nat_pow, nat.cast_one, h_eq_eval', ← polynomial.eval_mul],
      apply polynomial.eval_dvd,
      have h_n_div_p_dvd_n : n / p ∣ n,
      {
        use p,
        symmetry,
        apply nat.div_mul_cancel,
        cases h_n_eq_ord_mul_pow p h_p_in_factors with t ht,
        rw ht.left,
        exact nat_dvd_mul_pow_of_one_le p (order_of (zmod.unit_of_coprime a _)) t ht.right,
      },
      have h_n_div_p_ne_n : n / p ≠ n,
      {
        intro h_eq,
        rw nat.div_eq_self at h_eq,
        cases h_eq,
        { subst h_eq,
        linarith, },
        have h_prime' : prime p := by { rw ← nat.prime_iff, exact h_p_prime },
        { exact prime.ne_one h_prime' h_eq, }
      },
      exact cyclotomic_dvd_X_pow_sub_one_frac ℤ h_n_div_p_dvd_n
      (nat_ne_zero_of_pos hpos_n) h_n_div_p_ne_n,
    },
    cases h_n_eq_ord_mul_pow p h_p_in_factors with t ht,
    by_contra h_not_exception,
    rw decidable.not_and_distrib at h_not_exception,
    have h_p_dvd_pow_sub_one : (p ∣ a ^ (n / p) - 1) ∧
    (p = 2 → 4 ∣ a ^ (n / p) - 1),
    {
      split,
      {
        rw [ht.left, mul_pow_dvd_eq_mul_pow_sub _ p t (nat.prime.pos h_p_prime) ht.right],
        exact dvd_pow_order_mul_sub_one _ _ _ _ (le_of_lt ha),
      },
      {
        intro h_p_eq_two,
        cases h_not_exception with h_not_p_eq h_not_n_eq,
        {
          exfalso,
          exact h_not_p_eq h_p_eq_two,
        },
        {
          subst h_p_eq_two,
          have h_order_eq_one : order_of (zmod.unit_of_coprime a _) = 1 :=
          by exact order_of_eq_one_in_units_two h_a_coprime_p,
          cases ht with h_n_eq ht,
          rw h_order_eq_one at h_n_eq,
          cases em (1 = t) with h_t_eq_one h_t_ne_one,
          {
            symmetry' at h_t_eq_one,
            subst h_t_eq_one,
            exfalso,
            simp only [pow_one, one_mul] at h_n_eq,
            exact h_not_n_eq h_n_eq,
          },
          {
            have h_two_dvd_n_div : 2 ∣ n / 2,
            {
              use 2 ^ (t - 2),
              rw [h_n_eq, one_mul],
              transitivity 2 ^ (t - 1),
              {
                rw ← nat.pow_div ht zero_lt_two,
                rw pow_one,
              },
              {
                rw [← nat.sub_add_cancel
                (nat.le_pred_of_lt (nat.lt_of_le_and_ne ht h_t_ne_one)),
                nat.sub_sub, one_add_one_eq_two, pow_add, pow_one, mul_comm],
              }
            },
            exact four_dvd_pow_sub_one_of_two_dvd h_a_coprime_p h_two_dvd_n_div,
          }
        }
      }
    },
    have h_multiplicities :
    multiplicity p Φ + multiplicity p (a ^ (n / p) - 1 ^ (n / p)) ≤
    multiplicity p (a ^ n - 1 ^ n),
    {
      rw [← multiplicity.mul
      (nat.prime.prime (nat.prime_of_mem_factors h_p_in_factors)), one_pow, one_pow],
      exact multiplicity.multiplicity_le_multiplicity_of_dvd_right
      h_Phi_mul_pow_sub_one_dvd,
    },
    have h_multiplicities' :
    multiplicity (p : ℤ) (Φ : ℤ) +
    multiplicity (p : ℤ) ((a : ℤ) ^ (n / p) - 1 ^ (n / p)) ≤
    multiplicity (p : ℤ) ((a : ℤ) ^ n - 1 ^ n),
    {
      rw [one_pow, one_pow] at h_multiplicities,
      rw [one_pow, one_pow, ← nat.cast_one, ← int.coe_nat_pow,
      ← int.coe_nat_pow,
      ← int.coe_nat_sub (h_one_le (n / p)),
      ← int.coe_nat_sub (h_one_le n)],
      repeat { rw multiplicity.int.coe_nat_multiplicity, },
      exact h_multiplicities,
    },
    have h_p_dvd_n : p ∣ n,
    {
      rw ht.left,
      exact nat_dvd_mul_pow_of_one_le p
      (order_of (zmod.unit_of_coprime a _)) t ht.right,
    },
    nth_rewrite 2 ← nat.div_mul_cancel h_p_dvd_n at h_multiplicities',
    nth_rewrite 3 ← nat.div_mul_cancel h_p_dvd_n at h_multiplicities',
    rw [pow_mul, pow_mul] at h_multiplicities',
    have h_p_not_dvd_a_pow : ¬(p : ℤ) ∣ (a : ℤ) ^ (n / p),
    {
      intro h_p_dvd_pow,
      have h_p_coprime_a : (p : ℕ).coprime a :=
      by { exact nat.coprime.symm h_a_coprime_p },
      rw nat.prime.coprime_iff_not_dvd h_p_prime at h_p_coprime_a,
      apply h_p_coprime_a,
      rw ← int.coe_nat_dvd,
      exact int.prime.dvd_pow' h_p_prime h_p_dvd_pow,
    },
    have h_ne_top : multiplicity ↑p ((a : ℤ) ^ (n / p) - 1 ^ (n / p)) ≠ has_top.top,
    {
      rw [multiplicity.ne_top_iff_finite, multiplicity.finite_int_iff],
      split,
      {
        exact nat.prime.ne_one h_p_prime,
      },
      {
        rw [one_pow, ne.def, sub_eq_zero, nat.cast_pow_eq_one a (n / p)],
        { linarith, },
        {
          apply nat_ne_zero_of_pos,
          apply nat.div_pos,
          {
            apply nat.le_of_dvd _ h_p_dvd_n,
            linarith,
          },
          {
            exact nat.prime.pos h_p_prime,
          },
        },
        { exact int_char_zero, }
      }
    },
    cases nat.prime.eq_two_or_odd' h_p_prime with h_p_eq_two h_p_odd,
    {
      subst h_p_eq_two,
      have h_four_dvd : 4 ∣ (a : ℤ) ^ (n / 2) - 1 ^ (n / 2),
      {
        rw [one_pow, ← nat.cast_one, ← int.coe_nat_pow,
        ← int.coe_nat_sub (h_one_le (n / 2)), ← coe_bit0, ← coe_bit0,
        int.coe_nat_dvd],
        apply h_p_dvd_pow_sub_one.right,
        refl,
      },
      rw [nat.cast_two,
      int.two_pow_sub_pow' 2 h_four_dvd _, add_comm] at h_multiplicities',
      nth_rewrite 7 ← nat.cast_two at h_multiplicities',
      rw [multiplicity.int.coe_nat_multiplicity,
      nat_multiplicity_self 2 (le_refl 2)] at h_multiplicities',
      rw [multiplicity.pow_dvd_iff_le_multiplicity,
      ← multiplicity.int.coe_nat_multiplicity, nat.cast_two,
      nat.cast_two] at h_square_dvd,
      {
        rw [← nat.cast_two, part_enat_add_le_add_iff_left h_ne_top,
        nat.cast_two] at h_multiplicities',
        convert le_trans h_square_dvd h_multiplicities',
        simp only [eq_iff_iff, false_iff, not_le],
        rw [← nat.cast_two, ← nat.cast_one, part_enat.coe_lt_coe],
        exact one_lt_two,
      },
      {
        rw nat.cast_two at h_p_not_dvd_a_pow,
        exact h_p_not_dvd_a_pow,
      }
    },
    {
      have h_p_dvd_pow_sub_pow : (p : ℤ) ∣ (a : ℤ) ^ (n / p) - 1 ^ (n / p),
      {
        rw [one_pow, ← nat.cast_one, ← int.coe_nat_pow,
        ← int.coe_nat_sub (h_one_le (n / p)), int.coe_nat_dvd],
        exact h_p_dvd_pow_sub_one.left,
      },
      rw [multiplicity.int.pow_sub_pow h_p_prime h_p_odd
      h_p_dvd_pow_sub_pow h_p_not_dvd_a_pow p,
      nat_multiplicity_self p (nat.prime.two_le h_p_prime), add_comm]
      at h_multiplicities',
      rw [multiplicity.pow_dvd_iff_le_multiplicity,
      ← multiplicity.int.coe_nat_multiplicity, nat.cast_two] at h_square_dvd,
      rw part_enat_add_le_add_iff_left h_ne_top at h_multiplicities',
      convert le_trans h_square_dvd h_multiplicities',
      simp only [eq_iff_iff, false_iff, not_le],
      rw [← nat.cast_two, ← nat.cast_one, part_enat.coe_lt_coe],
      exact one_lt_two,
    }
  },
  cases em (p = 2 ∧ n = 2) with h_exception h_not_exception_1,
  {
    cases h_exception,
    subst h_exception_right,
    subst h_exception_left,
    simp only [polynomial.cyclotomic_two, polynomial.eval_add,
    polynomial.eval_X, polynomial.eval_one,
    int.to_nat_coe_nat_add_one] at h_Phi_def,
    apply h_exception_1,
    split,
    { refl, },
    {
      use Φ.factors.length,
      rw h_eq_prime_pow at h_Phi_def,
      rw h_Phi_def,
      simp only [nat.add_succ_sub_one, add_zero],
    }
  },
  {
    have h_square_not_dvd : ¬ p ^ 2 ∣ Φ :=
    by { intro h_dvd, exact h_not_exception_1 (h_prime_square_not_dvd h_dvd), },
    have h_factors_length_eq_one : Φ.factors.length = 1,
    {
      cases others with p' others' h_primes',
      {
        rw [h_primes, list.length_singleton],
      },
      {
        exfalso,
        apply h_square_not_dvd,
        rw h_eq_prime_pow,
        apply pow_dvd_pow p,
        rw h_primes,
        simp only [list.length],
        rw [add_assoc, one_add_one_eq_two],
        exact nat.le_add_left 2 others'.length,
      }
    },
    rw [h_factors_length_eq_one, pow_one, h_Phi_def,
    ← int.coe_nat_eq_coe_nat_iff, int.to_nat_of_nonneg
    (polynomial.cyclotomic_nonneg n h_one_le_a_int)] at h_eq_prime_pow,
    cases h_n_eq_ord_mul_pow p h_p_in_factors with t ht,
    rw [mul_comm, ← h_ord_def] at ht,
    rw ht.left at h_eq_prime_pow,
    have h_p_not_dvd_ord : ¬ p ∣ ord,
    {
      rw h_ord_def,
      apply nat.not_dvd_of_pos_of_lt (order_of_units_pos _),
      haveI : ne_zero p := ⟨ nat.prime.ne_zero h_p_prime ⟩,
      have h_ord_le_p_sub_one : order_of (zmod.unit_of_coprime a _) ≤ p - 1 :=
      by { rw ← nat.totient_prime h_p_prime,
      exact order_of_units_le_totient h_a_coprime_p, },
      have h_p_sub_one_lt_p : p - 1 < p,
      {
        rw ← nat.sub_zero (p - 1),
        exact nat.sub_one_sub_lt (nat.prime.pos h_p_prime),
      },
      exact lt_of_le_of_lt h_ord_le_p_sub_one h_p_sub_one_lt_p,
      rw ne_zero_iff,
      exact nat.prime.ne_zero h_p_prime,
    },
    have h_expand_eq_expand_mul_p :
    polynomial.eval ↑a ((polynomial.expand ℤ (p ^ t))
    (polynomial.cyclotomic ord ℤ)) =
    polynomial.eval ↑a ((polynomial.expand ℤ (p ^ (t - 1)))
    (polynomial.cyclotomic ord ℤ)) * ↑p,
    {
      rw [cyclotomic_expand_pow_eq_cyclotomic_mul h_p_prime _ h_p_not_dvd_ord,
      polynomial.eval_mul, h_eq_prime_pow, mul_comm],
      linarith,
    },
    simp only [polynomial.expand_eval] at h_expand_eq_expand_mul_p,
    apply eq.not_gt h_expand_eq_expand_mul_p,
    cases em (ord = 1) with h_ord_eq_one h_ord_ne_one,
    {
      simp only [h_ord_eq_one, polynomial.cyclotomic_one,
      polynomial.eval_sub, polynomial.eval_X,
      polynomial.eval_one],
      nth_rewrite 1 ← nat.sub_add_cancel ht.right,
      nth_rewrite 1 ← nat.cast_one,
      nth_rewrite 4 ← nat.cast_one,
      rw [← int.coe_nat_pow,
      ← int.coe_nat_pow,
      ← int.coe_nat_sub (h_one_le (p ^ (t - 1))),
      ← int.coe_nat_sub (h_one_le (p ^ (t - 1 + 1))), pow_add,
      pow_mul, pow_one, ← int.coe_nat_mul, int.coe_nat_lt],
      apply sub_one_mul_lt_pow_sub_one
      (a ^ p ^ (t - 1)) p (nat.prime.one_lt h_p_prime),
      apply h_one_lt (p ^ (t - 1)),
      exact pow_pos (nat.prime.pos h_p_prime) (t - 1),
    },
    {
      haveI : ne_zero p := ⟨ nat.prime.ne_zero h_p_prime ⟩,
      have h_ord_pos : 0 < ord := by { rw h_ord_def,
      exact order_of_units_pos h_a_coprime_p, },
      have h_one_lt_ord : 1 < ord,
      {
        rw nat.one_lt_iff_ne_zero_and_ne_one,
        split,
        { exact nat_ne_zero_of_pos h_ord_pos, },
        { exact h_ord_ne_one, }
      },
      have h_le : ((a : ℤ) ^ p ^ (t - 1) + 1) ^ ord.totient * ↑p ≤
      ((a : ℤ) ^ p ^ t - 1) ^ ord.totient,
      {
        nth_rewrite 1 ← nat.sub_add_cancel ht.right,
        set b := (a : ℤ) ^ p ^ (t - 1) with h_b_def,
        rw [pow_add, pow_mul, pow_one, ← h_b_def],
        have h_b_nonneg : 0 ≤ b,
        {
          rw h_b_def,
          apply pow_nonneg,
          linarith,
        },
        transitivity ((b + 1) * ↑p) ^ ord.totient,
        {
          rw mul_pow,
          apply int.mul_le_mul_of_nonneg_left,
          {
            apply le_self_pow _ (nat_ne_zero_of_pos (nat.totient_pos h_ord_pos)),
            rw [← nat.cast_one, int.coe_nat_le],
            exact le_of_lt (nat.prime.one_lt h_p_prime),
          },
          {
            apply pow_nonneg,
            apply add_nonneg h_b_nonneg,
            linarith,
          }
        },
        {
          apply pow_le_pow_of_le_left,
          {
            apply mul_nonneg,
            {
              apply add_nonneg h_b_nonneg,
              linarith,
            },
            {
              linarith,
            }
          },
          {
            cases em (b ≤ 2) with h_b_le_two h_two_lt_b,
            {
              have h_pow_le_two : 2 ^ (p ^ (t - 1)) ≤ (2 : ℤ),
              {
                transitivity (↑a ^ p ^ (t - 1)),
                {
                  apply pow_le_pow_of_le_left,
                  { linarith, },
                  {
                    rw [← nat.cast_two, int.coe_nat_le],
                    linarith,
                  }
                },
                {
                  rw ← h_b_def,
                  exact h_b_le_two,
                }
              },
              nth_rewrite 1 ← pow_one (2 : ℤ) at h_pow_le_two,
              rw [pow_le_pow_iff _] at h_pow_le_two,
              {
                cases em (t - 1 = 0) with h_t_le_one h_t_ne_one,
                {
                  rw nat.sub_eq_zero_iff_le at h_t_le_one,
                  have h_t_eq_one : t = 1 := by exact le_antisymm h_t_le_one ht.right,
                  subst h_t_eq_one,
                  simp only [pow_zero, pow_one] at h_b_def,
                  rw [h_b_def, ← nat.cast_two, int.coe_nat_le] at h_b_le_two,
                  have h_a_eq_two : a = 2 := by linarith,
                  subst h_a_eq_two,
                  have h_p_ne_two : p ≠ 2,
                  {
                    intro h_p_eq_two,
                    rw [h_p_eq_two, nat.coprime_self] at h_a_coprime_p,
                    linarith,
                  },
                  cases em (p = 3) with h_p_eq_three h_p_ne_three,
                  {
                    rw h_p_eq_three at h_a_coprime_p,
                    have h_ord_eq_two : ord = 2,
                    {
                      rw h_ord_def,
                      convert order_of_two_mod_three_eq_two h_a_coprime_p,
                    },
                    rw h_p_eq_three at ht,
                    exfalso,
                    apply h_exception_2,
                    rw [eq_self_iff_true, and_true, ht.left, pow_one, h_ord_eq_two],
                    norm_num,
                  },
                  {
                    rw [h_b_def, coe_bit0, algebra_map.coe_one],
                    have h_five_le_p : 5 ≤ p := by exact
                    nat.prime.five_le_of_ne_two_of_ne_three h_p_prime h_p_ne_two h_p_ne_three,
                    convert three_mul_le_pow_sub (p - 5),
                    norm_num,
                    symmetry,
                    exact nat.sub_add_cancel h_five_le_p,
                    symmetry,
                    exact nat.sub_add_cancel h_five_le_p,
                  }
                },
                {
                  exfalso,
                  rw nat_pow_le_one_iff at h_pow_le_two,
                  cases h_pow_le_two,
                  { exact not_lt_of_le h_pow_le_two (nat.prime.one_lt h_p_prime), },
                  { exact h_t_ne_one h_pow_le_two, }
                }
              },
              {
                linarith,
              }
            },
            {
              transitivity 2 * (b - 1) * ↑p,
              {
                apply int.mul_le_mul_of_nonneg_right,
                { linarith, },
                { linarith, }
              },
              {
                apply two_mul_le_pow_sub_one b p,
                { linarith, },
                { exact nat.prime.two_le h_p_prime, }
              }
            }
          }
        }
      },
      exact lt_of_le_of_lt
      (le_trans (int.mul_le_mul_of_nonneg_right (cyclotomic_le_X_add_one_pow h_ord_pos
      (h_one_lt_int (p ^ (t - 1))
      (pow_pos (nat.prime.pos h_p_prime) (t - 1)))) (int.coe_nat_nonneg p)) h_le)
      (X_sub_one_pow_lt_cyclotomic h_one_lt_ord
      (h_one_lt_int (p ^ t) (pow_pos (nat.prime.pos h_p_prime) t))),
    }
  }
end


---

section
parameters {A : Type} {R : A → A → Prop}
parameter (irreflR : irreflexive R)
parameter (transR : transitive R)

local infix < := R

def R' (a b : A) : Prop := R a b ∨ a = b
local infix ≤ := R'

theorem reflR' (a : A) : a ≤ a := or.inr (refl a)

theorem transR' {a b c : A} (h1 : a ≤ b) (h2 : b ≤ c):
  a ≤ c :=
  or.elim h1
    (assume : a < b,
      show a ≤ c, from
        or.elim h2
          (assume : b < c, or.inl (transR ‹ a < b › ‹ b < c ›))
          (assume : b = c, or.inl (eq.subst ‹ b = c › ‹ a < b ›)))
    (assume : a = b,
      show a ≤ c, from
        or.elim h2
          (assume : b < c, or.inl (eq.symm ‹ a = b ›  ▸ ‹ b < c ›))
          (assume : b = c, or.inr (‹ b = c › ▸ ‹ a = b ›)))

theorem antisymmR' {a b : A} (h1 : a ≤ b) (h2 : b ≤ a) :
  a = b :=
    or.elim h1
      (assume : a < b,
        or.elim h2
          (assume : b < a, have false, from (irreflR a) (transR ‹ a < b › ‹ b < a ›), ‹ false ›.elim)
          (assume : b = a, eq.symm this)
      )
      (assume : a = b, eq.symm (eq.symm this))
end

---

section
parameters {A : Type} {R : A → A → Prop}
parameter (reflR : reflexive R)
parameter (transR : transitive R)

def S (a b : A) : Prop := R a b ∧ R b a

example : transitive S :=
assume a b c,
assume h1 h2,
⟨ transR h1.left h2.left , transR h2.right h1.right ⟩

end

---

section
  parameters {A : Type} {a b c : A} {R : A → A → Prop}
  parameter (Rab : R a b)
  parameter (Rbc : R b c)
  parameter (nRac : ¬ R a c)

  -- Prove one of the following two theorems:

  theorem R_is_strict_partial_order :
    irreflexive R ∧ transitive R :=
  sorry

  theorem R_is_not_strict_partial_order :
    ¬(irreflexive R ∧ transitive R) :=
  assume h : irreflexive R ∧ transitive R,
  show false, from
    nRac (h.right Rab Rbc)
end

---

open nat

example : 1 ≤ 4 :=
le_succ_of_le $ le_succ_of_le $ le_succ 1


import algebra.associated
import algebra.group_power
import ring_theory.ideal_operations
import ring_theory.ideals

universe u

variables {α : Type*}

open_locale classical

/- An element a of a ring α is a zero divisor if there exists a b ∈ α
   such that b ≠ 0 and ab = 0. -/
def is_zero_divisor [comm_ring α] (a : α) := ∃ b : α, b ≠ 0 ∧ a * b = 0

/- An element a of a ring α is nilpotent if there exists a n ∈ ℕ such
   that a^n = 0. -/
def is_nilpotent [comm_ring α] (a : α) := ∃ n : ℕ, a ^ n = 0

/- 0 is nilpotent. -/
theorem zero_is_nilpotent [comm_ring α] : is_nilpotent (0 : α) :=
  exists.intro 1 (by simp)

theorem exists_min_pow_zero_of_nilpotent [comm_ring α] :
  ∀ a : α, is_nilpotent a → ∃ m : ℕ, a^m = 0 ∧ ∀ n : ℕ, n < m → a^n ≠ 0
:=
begin
  rintros a hna,
  use nat.find hna,
  split,
  { exact nat.find_spec hna},
  { intro n,
    exact nat.find_min hna}
end

theorem eq_mul [comm_ring α] (a : α) (ha : (1 : α) = 0) : a = 0
:=
begin
  have h : (a * 1 = a * 0) := eq.subst ha rfl,
  simp at h,
  exact h
end

/- All nonzero nilpotents are zerodivisors. -/
theorem nz_nilpotent_is_zerodivisor [comm_ring α] :
  ∀ a : α, is_nilpotent a → a ≠ 0 → is_zero_divisor a
:=
begin
  intros a ha ha',
  unfold is_zero_divisor,
  unfold is_nilpotent at ha,
  have h := exists_min_pow_zero_of_nilpotent a ha,
  cases h with m hm,
  cases m with,
  { rw pow_zero at hm,
    have haz := eq_mul a hm.left,
    contradiction },
  { cases m with,
    { simp at hm,
      have haz := hm.left,
      contradiction },
    { let n := m + 1,
      use a ^ n,
      rw nat.succ_eq_add_one at hm,
      rw nat.succ_eq_add_one at hm,
      simp at hm,
      split,
      { have hn : n < m + 2,
        simp,
        exact hm.right n hn },
      { rw <- pow_succ,
        exact hm.left, },
    }
  }
end

/- Zero is a zero divisor in a nonzero ring. -/
theorem zero_zero_divisor_in_nz_ring [nonzero_comm_ring α]
  : is_zero_divisor (0 : α) :=
exists.intro 1 ⟨one_ne_zero, by simp⟩

/- All nilpotents are zero divisors in a nonzero ring. -/
theorem nonzero_ring_nilpotent_is_zerodivisor [nonzero_comm_ring α]
  : ∀ a : α, is_nilpotent a → is_zero_divisor a
:= assume a : α,
   assume ha : is_nilpotent a,
   classical.by_cases (assume hz  : a = 0, by simp[hz, zero_zero_divisor_in_nz_ring])
                      (assume hnz : a ≠ 0, nz_nilpotent_is_zerodivisor a ha hnz)

open ideal

/- The nilradical of a ring α is the radical of (0). -/
def nilradical [comm_ring α] := radical (span ({ 0 } : set α))

/- The elements of the nilradical are precisely the nilpotents of α -/
theorem elem_nilradical_nilpotent [comm_ring α] :
  ∀ a : α, a ∈ (@nilradical α).carrier ↔ is_nilpotent a
:= sorry

/- A ring is reduced if its nilradical is the trivial ideal (0) -/
class reduced_ring (α : Type u) extends comm_ring α :=
  (is_reduced : nilradical = span ({ 0 } : set α))

/- The zero ideal is prime in an integral domain. -/
theorem zero_is_prime_in_id [integral_domain α] : (span ({0} : set α)).is_prime
  :=
begin
-- Our strategy is to show that the kernel of the identity α → α is
-- (0) and then apply the ker_is_prime theorem.
let id_hom := @id α,
have ker_of_id_is_prime := ring_hom.ker_is_prime id_hom,
end

/- All integral domains are reduced. -/
theorem integral_domains_are_reduced [integral_domain α] : reduced_ring α
  := is_reduced = is_prime.radical zero_is_prime_in_id


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import number_theory.zsqrtd.basic
import data.complex.basic
import ring_theory.principal_ideal_domain
import number_theory.legendre_symbol.quadratic_reciprocity
/-!
# Gaussian integers

The Gaussian integers are complex integer, complex numbers whose real and imaginary parts are both
integers.

## Main definitions

The Euclidean domain structure on `ℤ[i]` is defined in this file.

The homomorphism `to_complex` into the complex numbers is also defined in this file.

## Main statements

`prime_iff_mod_four_eq_three_of_nat_prime`
A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`

## Notations

This file uses the local notation `ℤ[i]` for `gaussian_int`

## Implementation notes

Gaussian integers are implemented using the more general definition `zsqrtd`, the type of integers
adjoined a square root of `d`, in this case `-1`. The definition is reducible, so that properties
and definitions about `zsqrtd` can easily be used.
-/

open zsqrtd complex
open_locale complex_conjugate

/-- The Gaussian integers, defined as `ℤ√(-1)`. -/
@[reducible] def gaussian_int : Type := zsqrtd (-1)

local notation `ℤ[i]` := gaussian_int

namespace gaussian_int

instance : has_repr ℤ[i] := ⟨λ x, "⟨" ++ repr x.re ++ ", " ++ repr x.im ++ "⟩"⟩

instance : comm_ring ℤ[i] := zsqrtd.comm_ring

section
local attribute [-instance] complex.field -- Avoid making things noncomputable unnecessarily.

/-- The embedding of the Gaussian integers into the complex numbers, as a ring homomorphism. -/
def to_complex : ℤ[i] →+* ℂ :=
zsqrtd.lift ⟨I, by simp⟩
end

instance : has_coe (ℤ[i]) ℂ := ⟨to_complex⟩

lemma to_complex_def (x : ℤ[i]) : (x : ℂ) = x.re + x.im * I := rfl

lemma to_complex_def' (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ) = x + y * I := by simp [to_complex_def]

lemma to_complex_def₂ (x : ℤ[i]) : (x : ℂ) = ⟨x.re, x.im⟩ :=
by apply complex.ext; simp [to_complex_def]

@[simp] lemma to_real_re (x : ℤ[i]) : ((x.re : ℤ) : ℝ) = (x : ℂ).re := by simp [to_complex_def]
@[simp] lemma to_real_im (x : ℤ[i]) : ((x.im : ℤ) : ℝ) = (x : ℂ).im := by simp [to_complex_def]
@[simp] lemma to_complex_re (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).re = x := by simp [to_complex_def]
@[simp] lemma to_complex_im (x y : ℤ) : ((⟨x, y⟩ : ℤ[i]) : ℂ).im = y := by simp [to_complex_def]
@[simp] lemma to_complex_add (x y : ℤ[i]) : ((x + y : ℤ[i]) : ℂ) = x + y := to_complex.map_add _ _
@[simp] lemma to_complex_mul (x y : ℤ[i]) : ((x * y : ℤ[i]) : ℂ) = x * y := to_complex.map_mul _ _
@[simp] lemma to_complex_one : ((1 : ℤ[i]) : ℂ) = 1 := to_complex.map_one
@[simp] lemma to_complex_zero : ((0 : ℤ[i]) : ℂ) = 0 := to_complex.map_zero
@[simp] lemma to_complex_neg (x : ℤ[i]) : ((-x : ℤ[i]) : ℂ) = -x := to_complex.map_neg _
@[simp] lemma to_complex_sub (x y : ℤ[i]) : ((x - y : ℤ[i]) : ℂ) = x - y := to_complex.map_sub _ _
@[simp] lemma to_complex_star (x : ℤ[i]) : ((star x : ℤ[i]) : ℂ) = conj (x : ℂ) :=
begin
  rw [to_complex_def₂, to_complex_def₂],
  exact congr_arg2 _ rfl (int.cast_neg _),
end

@[simp] lemma to_complex_inj {x y : ℤ[i]} : (x : ℂ) = y ↔ x = y :=
by cases x; cases y; simp [to_complex_def₂]

@[simp] lemma to_complex_eq_zero {x : ℤ[i]} : (x : ℂ) = 0 ↔ x = 0 :=
by rw [← to_complex_zero, to_complex_inj]

@[simp] lemma nat_cast_real_norm (x : ℤ[i]) : (x.norm : ℝ) = (x : ℂ).norm_sq :=
by rw [zsqrtd.norm, norm_sq]; simp

@[simp] lemma nat_cast_complex_norm (x : ℤ[i]) : (x.norm : ℂ) = (x : ℂ).norm_sq :=
by cases x; rw [zsqrtd.norm, norm_sq]; simp

lemma norm_nonneg (x : ℤ[i]) : 0 ≤ norm x := norm_nonneg (by norm_num) _

@[simp] lemma norm_eq_zero {x : ℤ[i]} : norm x = 0 ↔ x = 0 :=
by rw [← @int.cast_inj ℝ _ _ _]; simp

lemma norm_pos {x : ℤ[i]} : 0 < norm x ↔ x ≠ 0 :=
by rw [lt_iff_le_and_ne, ne.def, eq_comm, norm_eq_zero]; simp [norm_nonneg]

lemma abs_coe_nat_norm (x : ℤ[i]) : (x.norm.nat_abs : ℤ) = x.norm :=
int.nat_abs_of_nonneg (norm_nonneg _)

@[simp] lemma nat_cast_nat_abs_norm {α : Type*} [ring α]
  (x : ℤ[i]) : (x.norm.nat_abs : α) = x.norm :=
by rw [← int.cast_coe_nat, abs_coe_nat_norm]

lemma nat_abs_norm_eq (x : ℤ[i]) : x.norm.nat_abs =
  x.re.nat_abs * x.re.nat_abs + x.im.nat_abs * x.im.nat_abs :=
int.coe_nat_inj $ begin simp, simp [zsqrtd.norm] end

instance : has_div ℤ[i] :=
⟨λ x y, let n := (norm y : ℚ)⁻¹, c := star y in
  ⟨round ((x * c).re * n : ℚ), round ((x * c).im * n : ℚ)⟩⟩

lemma div_def (x y : ℤ[i]) : x / y = ⟨round ((x * star y).re / norm y : ℚ),
  round ((x * star y).im / norm y : ℚ)⟩ :=
show zsqrtd.mk _ _ = _, by simp [div_eq_mul_inv]

lemma to_complex_div_re (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).re = round ((x / y : ℂ).re) :=
by rw [div_def, ← @rat.round_cast ℝ _ _];
  simp [-rat.round_cast, mul_assoc, div_eq_mul_inv, mul_add, add_mul]

lemma to_complex_div_im (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).im = round ((x / y : ℂ).im) :=
by rw [div_def, ← @rat.round_cast ℝ _ _, ← @rat.round_cast ℝ _ _];
  simp [-rat.round_cast, mul_assoc, div_eq_mul_inv, mul_add, add_mul]

lemma norm_sq_le_norm_sq_of_re_le_of_im_le {x y : ℂ} (hre : |x.re| ≤ |y.re|)
  (him : |x.im| ≤ |y.im|) : x.norm_sq ≤ y.norm_sq :=
by rw [norm_sq_apply, norm_sq_apply, ← _root_.abs_mul_self, _root_.abs_mul,
  ← _root_.abs_mul_self y.re, _root_.abs_mul y.re,
  ← _root_.abs_mul_self x.im, _root_.abs_mul x.im,
  ← _root_.abs_mul_self y.im, _root_.abs_mul y.im]; exact
(add_le_add (mul_self_le_mul_self (abs_nonneg _) hre)
  (mul_self_le_mul_self (abs_nonneg _) him))

lemma norm_sq_div_sub_div_lt_one (x y : ℤ[i]) :
  ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).norm_sq < 1 :=
calc ((x / y : ℂ) - ((x / y : ℤ[i]) : ℂ)).norm_sq =
    ((x / y : ℂ).re - ((x / y : ℤ[i]) : ℂ).re +
    ((x / y : ℂ).im - ((x / y : ℤ[i]) : ℂ).im) * I : ℂ).norm_sq :
      congr_arg _ $ by apply complex.ext; simp
  ... ≤ (1 / 2 + 1 / 2 * I).norm_sq :
  have |(2⁻¹ : ℝ)| = 2⁻¹, from _root_.abs_of_nonneg (by norm_num),
  norm_sq_le_norm_sq_of_re_le_of_im_le
    (by rw [to_complex_div_re]; simp [norm_sq, this];
      simpa using abs_sub_round (x / y : ℂ).re)
    (by rw [to_complex_div_im]; simp [norm_sq, this];
      simpa using abs_sub_round (x / y : ℂ).im)
  ... < 1 : by simp [norm_sq]; norm_num

instance : has_mod ℤ[i] := ⟨λ x y, x - y * (x / y)⟩

lemma mod_def (x y : ℤ[i]) : x % y = x - y * (x / y) := rfl

lemma norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) : (x % y).norm < y.norm :=
have (y : ℂ) ≠ 0, by rwa [ne.def, ← to_complex_zero, to_complex_inj],
(@int.cast_lt ℝ _ _ _ _).1 $
  calc ↑(zsqrtd.norm (x % y)) = (x - y * (x / y : ℤ[i]) : ℂ).norm_sq : by simp [mod_def]
  ... = (y : ℂ).norm_sq * (((x / y) - (x / y : ℤ[i])) : ℂ).norm_sq :
    by rw [← norm_sq_mul, mul_sub, mul_div_cancel' _ this]
  ... < (y : ℂ).norm_sq * 1 : mul_lt_mul_of_pos_left (norm_sq_div_sub_div_lt_one _ _)
    (norm_sq_pos.2 this)
  ... = zsqrtd.norm y : by simp

lemma nat_abs_norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
  (x % y).norm.nat_abs < y.norm.nat_abs :=
int.coe_nat_lt.1 (by simp [-int.coe_nat_lt, norm_mod_lt x hy])

lemma norm_le_norm_mul_left (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
  (norm x).nat_abs ≤ (norm (x * y)).nat_abs :=
by rw [zsqrtd.norm_mul, int.nat_abs_mul];
  exact le_mul_of_one_le_right (nat.zero_le _)
    (int.coe_nat_le.1 (by rw [abs_coe_nat_norm]; exact int.add_one_le_of_lt (norm_pos.2 hy)))

instance : nontrivial ℤ[i] :=
⟨⟨0, 1, dec_trivial⟩⟩

instance : euclidean_domain ℤ[i] :=
{ quotient := (/),
  remainder := (%),
  quotient_zero := by { simp [div_def], refl },
  quotient_mul_add_remainder_eq := λ _ _, by simp [mod_def],
  r := _,
  r_well_founded := measure_wf (int.nat_abs ∘ norm),
  remainder_lt := nat_abs_norm_mod_lt,
  mul_left_not_lt := λ a b hb0, not_lt_of_ge $ norm_le_norm_mul_left a hb0,
  .. gaussian_int.comm_ring,
  .. gaussian_int.nontrivial }

open principal_ideal_ring

lemma mod_four_eq_three_of_nat_prime_of_prime (p : ℕ) [hp : fact p.prime] (hpi : prime (p : ℤ[i])) :
  p % 4 = 3 :=
hp.1.eq_two_or_odd.elim
  (λ hp2, absurd hpi (mt irreducible_iff_prime.2 $
    λ ⟨hu, h⟩, begin
      have := h ⟨1, 1⟩ ⟨1, -1⟩ (hp2.symm ▸ rfl),
      rw [← norm_eq_one_iff, ← norm_eq_one_iff] at this,
      exact absurd this dec_trivial
    end))
  (λ hp1, by_contradiction $ λ hp3 : p % 4 ≠ 3,
    have hp41 : p % 4 = 1,
      begin
        rw [← nat.mod_mul_left_mod p 2 2, show 2 * 2 = 4, from rfl] at hp1,
        have := nat.mod_lt p (show 0 < 4, from dec_trivial),
        revert this hp3 hp1,
        generalize : p % 4 = m, dec_trivial!,
      end,
    let ⟨k, hk⟩ := zmod.exists_sq_eq_neg_one_iff.2 $
      by rw hp41; exact dec_trivial in
    begin
      obtain ⟨k, k_lt_p, rfl⟩ : ∃ (k' : ℕ) (h : k' < p), (k' : zmod p) = k,
      { refine ⟨k.val, k.val_lt, zmod.nat_cast_zmod_val k⟩ },
      have hpk : p ∣ k ^ 2 + 1,
        by { rw [pow_two, ← char_p.cast_eq_zero_iff (zmod p) p, nat.cast_add, nat.cast_mul,
                 nat.cast_one, ← hk, add_left_neg], },
      have hkmul : (k ^ 2 + 1 : ℤ[i]) = ⟨k, 1⟩ * ⟨k, -1⟩ :=
        by simp [sq, zsqrtd.ext],
      have hpne1 : p ≠ 1 := ne_of_gt hp.1.one_lt,
      have hkltp : 1 + k * k < p * p,
        from calc 1 + k * k ≤ k + k * k :
          add_le_add_right (nat.pos_of_ne_zero
            (λ hk0, by clear_aux_decl; simp [*, pow_succ'] at *)) _
        ... = k * (k + 1) : by simp [add_comm, mul_add]
        ... < p * p : mul_lt_mul k_lt_p k_lt_p (nat.succ_pos _) (nat.zero_le _),
      have hpk₁ : ¬ (p : ℤ[i]) ∣ ⟨k, -1⟩ :=
        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
          calc (norm (p * x : ℤ[i])).nat_abs = (zsqrtd.norm ⟨k, -1⟩).nat_abs : by rw hx
          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, zsqrtd.norm] using hkltp
          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
            (λ hx0, (show (-1 : ℤ) ≠ 0, from dec_trivial) $
              by simpa [hx0] using congr_arg zsqrtd.im hx),
      have hpk₂ : ¬ (p : ℤ[i]) ∣ ⟨k, 1⟩ :=
        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
          calc (norm (p * x : ℤ[i])).nat_abs = (zsqrtd.norm ⟨k, 1⟩).nat_abs : by rw hx
          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, zsqrtd.norm] using hkltp
          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
            (λ hx0, (show (1 : ℤ) ≠ 0, from dec_trivial) $
                by simpa [hx0] using congr_arg zsqrtd.im hx),
      have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2
        (by rw [norm_nat_cast, int.nat_abs_mul, nat.mul_eq_one_iff];
        exact λ h, (ne_of_lt hp.1.one_lt).symm h.1),
      obtain ⟨y, hy⟩ := hpk,
      have := hpi.2.2 ⟨k, 1⟩ ⟨k, -1⟩ ⟨y, by rw [← hkmul, ← nat.cast_mul p, ← hy]; simp⟩,
      clear_aux_decl, tauto
    end)

lemma sq_add_sq_of_nat_prime_of_not_irreducible (p : ℕ) [hp : fact p.prime]
  (hpi : ¬irreducible (p : ℤ[i])) : ∃ a b, a^2 + b^2 = p :=
have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2 $
  by rw [norm_nat_cast, int.nat_abs_mul, nat.mul_eq_one_iff];
    exact λ h, (ne_of_lt hp.1.one_lt).symm h.1,
have hab : ∃ a b, (p : ℤ[i]) = a * b ∧ ¬ is_unit a ∧ ¬ is_unit b,
  by simpa [irreducible_iff, hpu, not_forall, not_or_distrib] using hpi,
let ⟨a, b, hpab, hau, hbu⟩ := hab in
have hnap : (norm a).nat_abs = p, from ((hp.1.mul_eq_prime_sq_iff
    (mt norm_eq_one_iff.1 hau) (mt norm_eq_one_iff.1 hbu)).1 $
  by rw [← int.coe_nat_inj', int.coe_nat_pow, sq,
    ← @norm_nat_cast (-1), hpab];
    simp).1,
⟨a.re.nat_abs, a.im.nat_abs, by simpa [nat_abs_norm_eq, sq] using hnap⟩

lemma prime_of_nat_prime_of_mod_four_eq_three (p : ℕ) [hp : fact p.prime] (hp3 : p % 4 = 3) :
  prime (p : ℤ[i]) :=
irreducible_iff_prime.1 $ classical.by_contradiction $ λ hpi,
  let ⟨a, b, hab⟩ := sq_add_sq_of_nat_prime_of_not_irreducible p hpi in
have ∀ a b : zmod 4, a^2 + b^2 ≠ p, by erw [← zmod.nat_cast_mod p 4, hp3]; exact dec_trivial,
this a b (hab ▸ by simp)

/-- A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4` -/
lemma prime_iff_mod_four_eq_three_of_nat_prime (p : ℕ) [hp : fact p.prime] :
  prime (p : ℤ[i]) ↔ p % 4 = 3 :=
⟨mod_four_eq_three_of_nat_prime_of_prime p, prime_of_nat_prime_of_mod_four_eq_three p⟩

end gaussian_int


-- ---------------------------------------------------------------------
-- Ejercicio 1. Realizar las siguientes acciones:
-- 1. Importar la teoría de los números reales.
-- 2. Declarar f como una variable sobre las funciones de ℝ en ℝ.
-- ----------------------------------------------------------------------

import data.real.basic   -- 1
variable {f : ℝ → ℝ}     -- 2

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que f es no monótona syss existen x e y tales
-- que x ≤ y y f(x) > f(y).
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ================

example :
  ¬ monotone f ↔ ∃ x y, x ≤ y ∧ f x > f y :=
begin
  rw [monotone],
  push_neg,
end

-- Prueba
-- ======

/-
f : ℝ → ℝ
⊢ ¬monotone f ↔ ∃ (x y : ℝ), x ≤ y ∧ f x > f y
  >> rw [monotone],
⊢ (¬∀ ⦃a b : ℝ⦄, a ≤ b → f a ≤ f b) ↔ ∃ (x y : ℝ), x ≤ y ∧ f x > f y
  >> push_neg,
no goals
-/

-- Comentario: Se ha usado la definición
-- + monotone: ∀ ⦃a b : ℝ⦄, a ≤ b → f a ≤ f b

-- 2ª demostración
-- ================

lemma not_monotone_iff :
  ¬ monotone f ↔ ∃ x y, x ≤ y ∧ f x > f y :=
by { rw [monotone], push_neg }

-- ---------------------------------------------------------------------
-- Ejercicio 3. Demostrar que la función opuesta no es monótona.
-- ----------------------------------------------------------------------

example : ¬ monotone (λ x : ℝ, -x) :=
begin
  apply not_monotone_iff.mpr,
  use [2, 3],
  norm_num,
end

-- Prueba
-- ======

/-
⊢ ¬monotone (λ (x : ℝ), -x)
  >> apply not_monotone_iff.mpr,
⊢ ∃ (x y : ℝ), x ≤ y ∧ -x > -y
  >> use [2, 3],
⊢ 2 ≤ 3 ∧ -2 > -3
  >> norm_num,
no goals
-/


import sequence -- Imports sequences and their properties (convergent, bounded, monotone, etc.).

namespace my_analysis

  section subindex

    /-- A subindex is a strictly increasing map from ℕ to itself. -/
    structure subindex :=
      (φ : ℕ → ℕ)
      (mono : strict_mono φ)

    instance subindex_fun : has_coe_to_fun subindex (λ _, ℕ → ℕ) := ⟨subindex.φ⟩
    @[simp] theorem subindex_fun_eq (si : subindex) (n : ℕ) : si n = si.φ n := rfl

    /-- The strictly increasing property of subindex follows inductively from the
      function having strictly increasing consecutive terms. -/
    def subindex_mk (f : ℕ → ℕ) (h : ∀ n, f n < f n.succ) : subindex :=
      ⟨f, begin
        intros a b hab,
        have : ∀ n, n > 0 → f a < f (a + n),
          intro n,
          induction n with n ih,
          { intro h', exact absurd h' (irrefl 0) },
          { intro h', rw [nat.add_succ],
            by_cases hn : n > 0,
            { exact lt_trans (ih hn) (h (a + n)) },
            { have : n = 0, from nat.eq_zero_of_le_zero (not_lt.mp hn),
              rw [this, add_zero], exact h a } },
        rw [← nat.add_sub_of_le (le_of_lt hab)],
        exact this (b - a) (tsub_pos_of_lt hab)
      end⟩

    /-- A function used for defining subindex structures, such that each
      index is `f` applied to the previous index, beginning with `f 0`. -/
    def subindex_recursive (f : ℕ → ℕ) : ℕ → ℕ
    | 0     := f 0
    | (k+1) := f (subindex_recursive k)

    /-- A subindex formed by moving every index up by `n`. -/
    def subindex.add (si : subindex) (n : ℕ) : subindex :=
      ⟨λ k, si k + n, λ a b hab, (add_lt_add_iff_right n).mpr (si.mono hab)⟩

    /-- The `m`-th entry of a subindex is at least `m`, or in other words
      it will never fall behind the original sequence. -/
    theorem subindex.unbounded (si : subindex) : ∀ m, m ≤ si m
    | 0     := zero_le _
    | (k+1) := nat.succ_le_of_lt $ lt_of_le_of_lt (subindex.unbounded k) $ si.mono (lt_add_one k)

  end subindex

  section subseq

    /-- A sub-sequence, formed by composing a sequence and a subindex. -/
    def seq.subseq (s : seq) (si : subindex) : seq := s ∘ si

    /-- A sub-sequence inherits any upper bounds from the original sequence. -/
    theorem subseq_bounded_above {s : seq} (hb : s.bounded_above) (si : subindex) :
      (s.subseq si).bounded_above :=
    begin
      cases hb with M hM, use M,
      intro n, exact hM (si n)
    end

    /-- A sub-sequence inherits any lower bounds from the original sequence. -/
    theorem subseq_bounded_below {s : seq} (hb : s.bounded_below) (si : subindex) :
      (s.subseq si).bounded_below :=
    begin
      cases hb with m hm, use m,
      intro n, exact hm (si n)
    end

  end subseq

  /-- Every sequence has a monotone sub-sequence. -/
  theorem peak_point_lemma (s : seq) : ∃ si : subindex, (s.subseq si).monotone :=
  begin
    by_cases h : ∀ N, ∃ m, m > N ∧ ∀ n, n > N →  s m ≤ s n,
    -- Increasing case.
    { let sir := subindex_recursive (λ n, classical.some (h n)),
      let si := subindex_mk sir (λ n, (classical.some_spec (h (sir n))).left),
      use si, apply or.inl,
      intros a b hab,
      have : ∀ n, s.subseq si a ≤ s.subseq si (a + n),
        intro n,
        induction n with n ih,
        { rw [add_zero] },
        { apply ih.trans,
          rw [nat.add_succ],
          by_cases han : a + n = 0,
          { rw [han],
            cases classical.some_spec (h 0) with h₁ h₂,
            exact h₂ (classical.some (h (sir 0)))
              (lt_trans h₁ (classical.some_spec (h (sir 0))).left) },
          { cases nat.exists_eq_succ_of_ne_zero han with k hk,
            rw [hk],
            cases classical.some_spec (h (sir k)) with h₁ h₂,
            exact h₂ (classical.some (h (sir k.succ)))
              (lt_trans h₁ (classical.some_spec (h (sir k.succ))).left) } },
      rw [← nat.add_sub_of_le hab],
      exact this (b - a) },
    -- Decreasing case.
    { simp only [not_forall, not_exists, not_and, not_le, gt_iff_lt, exists_prop] at h,
      cases h with N hN,
      have h : ∀ x, ∃ y, x < y ∧ s.shift N.succ y < s.shift N.succ x,
        intro x,
        by_contradiction h,
        simp only [not_exists, not_and, not_lt] at h,
        cases finite_prefix_min (s.shift N.succ) (nat.succ_ne_zero x) with M hM,
        cases hN (M + N.succ) (nat.lt_add_left N N.succ M (lt_add_one N)) with y hy,
        by_cases hxy : x < y - N.succ,
        { have := lt_of_lt_of_le hy.right (hM.right x (lt_add_one x)),
          rw [← shift_ge s hy.left] at this,
          exact absurd (h (y - N.succ) hxy) (not_le_of_lt this) },
        { have := hM.right (y - N.succ) (nat.lt_succ_of_le (le_of_not_lt hxy)),
          rw [shift_ge s hy.left] at this,
          exact absurd this (not_le_of_lt hy.right) },
      let sir := subindex_recursive (λ n, classical.some (h n)),
      let si := (subindex_mk sir (λ n, (classical.some_spec (h (sir n))).left)).add N.succ,
      use si, apply or.inr,
      intros a b hab,
      have : ∀ n, s.subseq si (a + n) ≤ s.subseq si a,
        intro n,
        induction n with n ih,
        { rw [add_zero] },
        { refine le_trans _ ih,
          rw [nat.add_succ],
          exact le_of_lt (classical.some_spec (h (sir (a + n)))).right },
      rw [← nat.add_sub_of_le hab],
      exact this (b - a) }
  end

  /-- Every bounded sequence has a convergent subsequence. -/
  theorem bolzano_weierstrass {s : seq} (hb : s.bounded) :
    ∃ si : subindex, (s.subseq si).convergent :=
  begin
    cases peak_point_lemma s with si hm,
    cases hm with inc dec,
    { exact ⟨si, convergent_of_bounded_above_increasing (subseq_bounded_above
      (bounded_iff_above_below.mp hb).left si) inc⟩ },
    { exact ⟨si, convergent_of_bounded_below_decreasing (subseq_bounded_below
      (bounded_iff_above_below.mp hb).right si) dec⟩ }
  end

end my_analysis