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

import field_theory.finite.basic
import data.zmod.basic
import data.nat.parity

/-!
# Quadratic reciprocity.

This file contains results about quadratic residues modulo a prime number.

The main results are the law of quadratic reciprocity, `quadratic_reciprocity`, as well as the
interpretations in terms of existence of square roots depending on the congruence mod 4,
`exists_sq_eq_prime_iff_of_mod_four_eq_one`, and
`exists_sq_eq_prime_iff_of_mod_four_eq_three`.

Also proven are conditions for `-1` and `2` to be a square modulo a prime,
`exists_sq_eq_neg_one_iff_mod_four_ne_three` and
`exists_sq_eq_two_iff`

## Implementation notes

The proof of quadratic reciprocity implemented uses Gauss' lemma and Eisenstein's lemma
-/

open function finset nat finite_field zmod
open_locale big_operators nat

namespace zmod

variables (p q : ℕ) [fact p.prime] [fact q.prime]

/-- Euler's Criterion: A unit `x` of `zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
lemma euler_criterion_units (x : units (zmod p)) :
  (∃ y : units (zmod p), y ^ 2 = x) ↔ x ^ (p / 2) = 1 :=
begin
  cases nat.prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
  { substI p, refine iff_of_true ⟨1, _⟩ _; apply subsingleton.elim  },
  obtain ⟨g, hg⟩ := is_cyclic.exists_generator (units (zmod p)),
  obtain ⟨n, hn⟩ : x ∈ submonoid.powers g, { rw mem_powers_iff_mem_gpowers, apply hg },
  split,
  { rintro ⟨y, rfl⟩, rw [← pow_mul, two_mul_odd_div_two hp_odd, units_pow_card_sub_one_eq_one], },
  { subst x, assume h,
    have key : 2 * (p / 2) ∣ n * (p / 2),
    { rw [← pow_mul] at h,
      rw [two_mul_odd_div_two hp_odd, ← card_units, ← order_of_eq_card_of_forall_mem_gpowers hg],
      apply order_of_dvd_of_pow_eq_one h },
    have : 0 < p / 2 := nat.div_pos (fact.out (1 < p)) dec_trivial,
    obtain ⟨m, rfl⟩ := dvd_of_mul_dvd_mul_right this key,
    refine ⟨g ^ m, _⟩,
    rw [mul_comm, pow_mul], },
end

/-- Euler's Criterion: a nonzero `a : zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
lemma euler_criterion {a : zmod p} (ha : a ≠ 0) :
  (∃ y : zmod p, y ^ 2 = a) ↔ a ^ (p / 2) = 1 :=
begin
  apply (iff_congr _ (by simp [units.ext_iff])).mp (euler_criterion_units p (units.mk0 a ha)),
  simp only [units.ext_iff, sq, units.coe_mk0, units.coe_mul],
  split, { rintro ⟨y, hy⟩, exact ⟨y, hy⟩ },
  { rintro ⟨y, rfl⟩,
    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
    refine ⟨units.mk0 y hy, _⟩, simp, }
end

lemma exists_sq_eq_neg_one_iff_mod_four_ne_three :
  (∃ y : zmod p, y ^ 2 = -1) ↔ p % 4 ≠ 3 :=
begin
  cases nat.prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
  { substI p, exact dec_trivial },
  haveI := fact.mk hp_odd,
  have neg_one_ne_zero : (-1 : zmod p) ≠ 0, from mt neg_eq_zero.1 one_ne_zero,
  rw [euler_criterion p neg_one_ne_zero, neg_one_pow_eq_pow_mod_two],
  cases mod_two_eq_zero_or_one (p / 2) with p_half_even p_half_odd,
  { rw [p_half_even, pow_zero, eq_self_iff_true, true_iff],
    contrapose! p_half_even with hp,
    rw [← nat.mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp],
    exact dec_trivial },
  { rw [p_half_odd, pow_one,
        iff_false_intro (ne_neg_self p one_ne_zero).symm, false_iff, not_not],
    rw [← nat.mod_mul_right_div_self, show 2 * 2 = 4, from rfl] at p_half_odd,
    rw [← nat.mod_mul_left_mod _ 2, show 2 * 2 = 4, from rfl] at hp_odd,
    have hp : p % 4 < 4, from nat.mod_lt _ dec_trivial,
    revert hp hp_odd p_half_odd,
    generalize : p % 4 = k, dec_trivial! }
end

lemma pow_div_two_eq_neg_one_or_one {a : zmod p} (ha : a ≠ 0) :
  a ^ (p / 2) = 1 ∨ a ^ (p / 2) = -1 :=
begin
  cases nat.prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
  { substI p, revert a ha, exact dec_trivial },
  rw [← mul_self_eq_one_iff, ← pow_add, ← two_mul, two_mul_odd_div_two hp_odd],
  exact pow_card_sub_one_eq_one ha
end

/-- Wilson's Lemma: the product of `1`, ..., `p-1` is `-1` modulo `p`. -/
@[simp] lemma wilsons_lemma : ((p - 1)! : zmod p) = -1 :=
begin
  refine
  calc ((p - 1)! : zmod p) = (∏ x in Ico 1 (succ (p - 1)), x) :
    by rw [← finset.prod_Ico_id_eq_factorial, prod_nat_cast]
                               ... = (∏ x : units (zmod p), x) : _
                               ... = -1 :
    by rw [prod_hom _ (coe : units (zmod p) → zmod p),
           prod_univ_units_id_eq_neg_one, units.coe_neg, units.coe_one],
  have hp : 0 < p := (fact.out p.prime).pos,
  symmetry,
  refine prod_bij (λ a _, (a : zmod p).val) _ _ _ _,
  { intros a ha,
    rw [Ico.mem, ← nat.succ_sub hp, nat.succ_sub_one],
    split,
    { apply nat.pos_of_ne_zero, rw ← @val_zero p,
      assume h, apply units.ne_zero a (val_injective p h) },
    { exact val_lt _ } },
  { intros a ha, simp only [cast_id, nat_cast_val], },
  { intros _ _ _ _ h, rw units.ext_iff, exact val_injective p h },
  { intros b hb,
    rw [Ico.mem, nat.succ_le_iff, ← succ_sub hp, succ_sub_one, pos_iff_ne_zero] at hb,
    refine ⟨units.mk0 b _, finset.mem_univ _, _⟩,
    { assume h, apply hb.1, apply_fun val at h,
      simpa only [val_cast_of_lt hb.right, val_zero] using h },
    { simp only [val_cast_of_lt hb.right, units.coe_mk0], } }
end

@[simp] lemma prod_Ico_one_prime : (∏ x in Ico 1 p, (x : zmod p)) = -1 :=
begin
  conv in (Ico 1 p) { rw [← succ_sub_one p, succ_sub (fact.out p.prime).pos] },
  rw [← prod_nat_cast, finset.prod_Ico_id_eq_factorial, wilsons_lemma]
end

end zmod

/-- The image of the map sending a non zero natural number `x ≤ p / 2` to the absolute value
  of the element of interger in the interval `(-p/2, p/2]` congruent to `a * x` mod p is the set
  of non zero natural numbers `x` such that `x ≤ p / 2` -/
lemma Ico_map_val_min_abs_nat_abs_eq_Ico_map_id
  (p : ℕ) [hp : fact p.prime] (a : zmod p) (hap : a ≠ 0) :
  (Ico 1 (p / 2).succ).1.map (λ x, (a * x).val_min_abs.nat_abs) =
  (Ico 1 (p / 2).succ).1.map (λ a, a) :=
begin
  have he : ∀ {x}, x ∈ Ico 1 (p / 2).succ → x ≠ 0 ∧ x ≤ p / 2,
    by simp [nat.lt_succ_iff, nat.succ_le_iff, pos_iff_ne_zero] {contextual := tt},
  have hep : ∀ {x}, x ∈ Ico 1 (p / 2).succ → x < p,
    from λ x hx, lt_of_le_of_lt (he hx).2 (nat.div_lt_self hp.1.pos dec_trivial),
  have hpe : ∀ {x}, x ∈ Ico 1 (p / 2).succ → ¬ p ∣ x,
    from λ x hx hpx, not_lt_of_ge (le_of_dvd (nat.pos_of_ne_zero (he hx).1) hpx) (hep hx),
  have hmem : ∀ (x : ℕ) (hx : x ∈ Ico 1 (p / 2).succ),
    (a * x : zmod p).val_min_abs.nat_abs ∈ Ico 1 (p / 2).succ,
  { assume x hx,
    simp [hap, char_p.cast_eq_zero_iff (zmod p) p, hpe hx, lt_succ_iff, succ_le_iff,
        pos_iff_ne_zero, nat_abs_val_min_abs_le _], },
  have hsurj : ∀ (b : ℕ) (hb : b ∈ Ico 1 (p / 2).succ),
    ∃ x ∈ Ico 1 (p / 2).succ, b = (a * x : zmod p).val_min_abs.nat_abs,
  { assume b hb,
    refine ⟨(b / a : zmod p).val_min_abs.nat_abs, Ico.mem.mpr ⟨_, _⟩, _⟩,
    { apply nat.pos_of_ne_zero,
      simp only [div_eq_mul_inv, hap, char_p.cast_eq_zero_iff (zmod p) p, hpe hb, not_false_iff,
        val_min_abs_eq_zero, inv_eq_zero, int.nat_abs_eq_zero, ne.def, mul_eq_zero, or_self] },
      { apply lt_succ_of_le, apply nat_abs_val_min_abs_le },
      { rw nat_cast_nat_abs_val_min_abs,
        split_ifs,
        { erw [mul_div_cancel' _ hap, val_min_abs_def_pos, val_cast_of_lt (hep hb),
            if_pos (le_of_lt_succ (Ico.mem.1 hb).2), int.nat_abs_of_nat], },
        { erw [mul_neg_eq_neg_mul_symm, mul_div_cancel' _ hap, nat_abs_val_min_abs_neg,
            val_min_abs_def_pos, val_cast_of_lt (hep hb), if_pos (le_of_lt_succ (Ico.mem.1 hb).2),
            int.nat_abs_of_nat] } } },
  exact multiset.map_eq_map_of_bij_of_nodup _ _ (finset.nodup _) (finset.nodup _)
    (λ x _, (a * x : zmod p).val_min_abs.nat_abs) hmem (λ _ _, rfl)
    (inj_on_of_surj_on_of_card_le _ hmem hsurj (le_refl _)) hsurj
end

private lemma gauss_lemma_aux₁ (p : ℕ) [fact p.prime] [fact (p % 2 = 1)]
  {a : ℕ} (hap : (a : zmod p) ≠ 0) :
  (a^(p / 2) * (p / 2)! : zmod p) =
  (-1)^((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2)).card * (p / 2)! :=
calc (a ^ (p / 2) * (p / 2)! : zmod p) =
    (∏ x in Ico 1 (p / 2).succ, a * x) :
  by rw [prod_mul_distrib, ← prod_nat_cast, ← prod_nat_cast, prod_Ico_id_eq_factorial,
      prod_const, Ico.card, succ_sub_one]; simp
... = (∏ x in Ico 1 (p / 2).succ, (a * x : zmod p).val) : by simp
... = (∏ x in Ico 1 (p / 2).succ,
    (if (a * x : zmod p).val ≤ p / 2 then 1 else -1) *
      (a * x : zmod p).val_min_abs.nat_abs) :
  prod_congr rfl $ λ _ _, begin
    simp only [nat_cast_nat_abs_val_min_abs],
    split_ifs; simp
  end
... = (-1)^((Ico 1 (p / 2).succ).filter
      (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2)).card *
    (∏ x in Ico 1 (p / 2).succ, (a * x : zmod p).val_min_abs.nat_abs) :
  have (∏ x in Ico 1 (p / 2).succ,
        if (a * x : zmod p).val ≤ p / 2 then (1 : zmod p) else -1) =
      (∏ x in (Ico 1 (p / 2).succ).filter
        (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2), -1),
    from prod_bij_ne_one (λ x _ _, x)
      (λ x, by split_ifs; simp * at * {contextual := tt})
      (λ _ _ _ _ _ _, id)
      (λ b h _, ⟨b, by simp [-not_le, *] at *⟩)
      (by intros; split_ifs at *; simp * at *),
  by rw [prod_mul_distrib, this]; simp
... = (-1)^((Ico 1 (p / 2).succ).filter
      (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2)).card * (p / 2)! :
  by rw [← prod_nat_cast, finset.prod_eq_multiset_prod,
      Ico_map_val_min_abs_nat_abs_eq_Ico_map_id p a hap,
      ← finset.prod_eq_multiset_prod, prod_Ico_id_eq_factorial]

private lemma gauss_lemma_aux₂ (p : ℕ) [hp : fact p.prime] [fact (p % 2 = 1)]
  {a : ℕ} (hap : (a : zmod p) ≠ 0) :
  (a^(p / 2) : zmod p) = (-1)^((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card :=
(mul_left_inj'
    (show ((p / 2)! : zmod p) ≠ 0,
      by rw [ne.def, char_p.cast_eq_zero_iff (zmod p) p, hp.1.dvd_factorial, not_le];
          exact nat.div_lt_self hp.1.pos dec_trivial)).1 $
  by simpa using gauss_lemma_aux₁ p hap

private lemma eisenstein_lemma_aux₁ (p : ℕ) [fact p.prime] [hp2 : fact (p % 2 = 1)]
  {a : ℕ} (hap : (a : zmod p) ≠ 0) :
  ((∑ x in Ico 1 (p / 2).succ, a * x : ℕ) : zmod 2) =
    ((Ico 1 (p / 2).succ).filter
      ((λ x : ℕ, p / 2 < (a * x : zmod p).val))).card +
      ∑ x in Ico 1 (p / 2).succ, x
    + (∑ x in Ico 1 (p / 2).succ, (a * x) / p : ℕ) :=
have hp2 : (p : zmod 2) = (1 : ℕ), from (eq_iff_modeq_nat _).2 hp2.1,
calc ((∑ x in Ico 1 (p / 2).succ, a * x : ℕ) : zmod 2)
    = ((∑ x in Ico 1 (p / 2).succ, ((a * x) % p + p * ((a * x) / p)) : ℕ) : zmod 2) :
  by simp only [mod_add_div]
... = (∑ x in Ico 1 (p / 2).succ, ((a * x : ℕ) : zmod p).val : ℕ) +
    (∑ x in Ico 1 (p / 2).succ, (a * x) / p : ℕ) :
  by simp only [val_nat_cast];
    simp [sum_add_distrib, mul_sum.symm, nat.cast_add, nat.cast_mul, sum_nat_cast, hp2]
... = _ : congr_arg2 (+)
  (calc ((∑ x in Ico 1 (p / 2).succ, ((a * x : ℕ) : zmod p).val : ℕ) : zmod 2)
      = ∑ x in Ico 1 (p / 2).succ,
          ((((a * x : zmod p).val_min_abs +
            (if (a * x : zmod p).val ≤ p / 2 then 0 else p)) : ℤ) : zmod 2) :
        by simp only [(val_eq_ite_val_min_abs _).symm]; simp [sum_nat_cast]
  ... = ((Ico 1 (p / 2).succ).filter
        (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card +
      ((∑ x in Ico 1 (p / 2).succ, (a * x : zmod p).val_min_abs.nat_abs) : ℕ) :
    by { simp [ite_cast, add_comm, sum_add_distrib, finset.sum_ite, hp2, sum_nat_cast], }
  ... = _ : by rw [finset.sum_eq_multiset_sum,
      Ico_map_val_min_abs_nat_abs_eq_Ico_map_id p a hap,
      ← finset.sum_eq_multiset_sum];
    simp [sum_nat_cast]) rfl

private lemma eisenstein_lemma_aux₂ (p : ℕ) [fact p.prime] [fact (p % 2 = 1)]
  {a : ℕ} (ha2 : a % 2 = 1) (hap : (a : zmod p) ≠ 0) :
  ((Ico 1 (p / 2).succ).filter
    ((λ x : ℕ, p / 2 < (a * x : zmod p).val))).card
  ≡ ∑ x in Ico 1 (p / 2).succ, (x * a) / p [MOD 2] :=
have ha2 : (a : zmod 2) = (1 : ℕ), from (eq_iff_modeq_nat _).2 ha2,
(eq_iff_modeq_nat 2).1 $ sub_eq_zero.1 $
  by simpa [add_left_comm, sub_eq_add_neg, finset.mul_sum.symm, mul_comm, ha2, sum_nat_cast,
            add_neg_eq_iff_eq_add.symm, neg_eq_self_mod_two, add_assoc]
    using eq.symm (eisenstein_lemma_aux₁ p hap)

lemma div_eq_filter_card {a b c : ℕ} (hb0 : 0 < b) (hc : a / b ≤ c) : a / b =
  ((Ico 1 c.succ).filter (λ x, x * b ≤ a)).card :=
calc a / b = (Ico 1 (a / b).succ).card : by simp
... = ((Ico 1 c.succ).filter (λ x, x * b ≤ a)).card :
  congr_arg _ $ finset.ext $ λ x,
    have x * b ≤ a → x ≤ c,
      from λ h, le_trans (by rwa [le_div_iff_mul_le _ _ hb0]) hc,
    by simp [lt_succ_iff, le_div_iff_mul_le _ _ hb0]; tauto

/-- The given sum is the number of integer points in the triangle formed by the diagonal of the
  rectangle `(0, p/2) × (0, q/2)`  -/
private lemma sum_Ico_eq_card_lt {p q : ℕ} :
  ∑ a in Ico 1 (p / 2).succ, (a * q) / p =
  (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
  (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q)).card :=
if hp0 : p = 0 then by simp [hp0, finset.ext_iff]
else
  calc ∑ a in Ico 1 (p / 2).succ, (a * q) / p =
    ∑ a in Ico 1 (p / 2).succ,
      ((Ico 1 (q / 2).succ).filter (λ x, x * p ≤ a * q)).card :
    finset.sum_congr rfl $ λ x hx,
      div_eq_filter_card (nat.pos_of_ne_zero hp0)
        (calc x * q / p ≤ (p / 2) * q / p :
            nat.div_le_div_right (mul_le_mul_of_nonneg_right
              (le_of_lt_succ $ by finish)
              (nat.zero_le _))
          ... ≤ _ : nat.div_mul_div_le_div _ _ _)
  ... = _ : by rw [← card_sigma];
    exact card_congr (λ a _, ⟨a.1, a.2⟩)
      (by simp only [mem_filter, mem_sigma, and_self, forall_true_iff, mem_product]
        {contextual := tt})
      (λ ⟨_, _⟩ ⟨_, _⟩, by simp only [prod.mk.inj_iff, eq_self_iff_true, and_self, heq_iff_eq,
        forall_true_iff] {contextual := tt})
      (λ ⟨b₁, b₂⟩ h, ⟨⟨b₁, b₂⟩,
        by revert h; simp only [mem_filter, eq_self_iff_true, exists_prop_of_true, mem_sigma,
          and_self, forall_true_iff, mem_product] {contextual := tt}⟩)

/-- Each of the sums in this lemma is the cardinality of the set integer points in each of the
  two triangles formed by the diagonal of the rectangle `(0, p/2) × (0, q/2)`. Adding them
  gives the number of points in the rectangle. -/
private lemma sum_mul_div_add_sum_mul_div_eq_mul (p q : ℕ) [hp : fact p.prime]
  (hq0 : (q : zmod p) ≠ 0) :
  ∑ a in Ico 1 (p / 2).succ, (a * q) / p +
  ∑ a in Ico 1 (q / 2).succ, (a * p) / q =
  (p / 2) * (q / 2) :=
begin
  have hswap : (((Ico 1 (q / 2).succ).product (Ico 1 (p / 2).succ)).filter
    (λ x : ℕ × ℕ, x.2 * q ≤ x.1 * p)).card =
  (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
    (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p)).card :=
  card_congr (λ x _, prod.swap x)
    (λ ⟨_, _⟩, by simp only [mem_filter, and_self, prod.swap_prod_mk, forall_true_iff, mem_product]
      {contextual := tt})
    (λ ⟨_, _⟩ ⟨_, _⟩, by simp only [prod.mk.inj_iff, eq_self_iff_true, and_self, prod.swap_prod_mk,
      forall_true_iff] {contextual := tt})
    (λ ⟨x₁, x₂⟩ h, ⟨⟨x₂, x₁⟩, by revert h; simp only [mem_filter, eq_self_iff_true, and_self,
      exists_prop_of_true, prod.swap_prod_mk, forall_true_iff, mem_product] {contextual := tt}⟩),
  have hdisj : disjoint
    (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q))
    (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p)),
  { apply disjoint_filter.2 (λ x hx hpq hqp, _),
    have hxp : x.1 < p, from lt_of_le_of_lt
      (show x.1 ≤ p / 2, by simp only [*, lt_succ_iff, Ico.mem, mem_product] at *; tauto)
      (nat.div_lt_self hp.1.pos dec_trivial),
    have : (x.1 : zmod p) = 0,
      { simpa [hq0] using congr_arg (coe : ℕ → zmod p) (le_antisymm hpq hqp) },
    apply_fun zmod.val at this,
    rw [val_cast_of_lt hxp, val_zero] at this,
    simpa only [this, nonpos_iff_eq_zero, Ico.mem, one_ne_zero, false_and, mem_product] using hx },
  have hunion : ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q) ∪
    ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
      (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p) =
    ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)),
  from finset.ext (λ x, by have := le_total (x.2 * p) (x.1 * q);
    simp only [mem_union, mem_filter, Ico.mem, mem_product]; tauto),
  rw [sum_Ico_eq_card_lt, sum_Ico_eq_card_lt, hswap, ← card_disjoint_union hdisj, hunion,
    card_product],
  simp only [Ico.card, nat.sub_zero, succ_sub_succ_eq_sub]
end

variables (p q : ℕ) [fact p.prime] [fact q.prime]

namespace zmod

/-- The Legendre symbol of `a` and `p` is an integer defined as

* `0` if `a` is `0` modulo `p`;
* `1` if `a ^ (p / 2)` is `1` modulo `p`
   (by `euler_criterion` this is equivalent to “`a` is a square modulo `p`”);
* `-1` otherwise.

-/
def legendre_sym (a p : ℕ) : ℤ :=
if      (a : zmod p) = 0           then  0
else if (a : zmod p) ^ (p / 2) = 1 then  1
                                   else -1

lemma legendre_sym_eq_pow (a p : ℕ) [hp : fact p.prime] :
  (legendre_sym a p : zmod p) = (a ^ (p / 2)) :=
begin
  rw legendre_sym,
  by_cases ha : (a : zmod p) = 0,
  { simp only [if_pos, ha, zero_pow (nat.div_pos (hp.1.two_le) (succ_pos 1)), int.cast_zero] },
  cases hp.1.eq_two_or_odd with hp2 hp_odd,
  { substI p,
    generalize : (a : (zmod 2)) = b, revert b, dec_trivial, },
  { haveI := fact.mk hp_odd,
    rw if_neg ha,
    have : (-1 : zmod p) ≠ 1, from (ne_neg_self p one_ne_zero).symm,
    cases pow_div_two_eq_neg_one_or_one p ha with h h,
    { rw [if_pos h, h, int.cast_one], },
    { rw [h, if_neg this, int.cast_neg, int.cast_one], } }
end

lemma legendre_sym_eq_one_or_neg_one (a p : ℕ) (ha : (a : zmod p) ≠ 0) :
  legendre_sym a p = -1 ∨ legendre_sym a p = 1 :=
by unfold legendre_sym; split_ifs; simp only [*, eq_self_iff_true, or_true, true_or] at *

lemma legendre_sym_eq_zero_iff (a p : ℕ) :
  legendre_sym a p = 0 ↔ (a : zmod p) = 0 :=
begin
  split,
  { classical, contrapose,
    assume ha, cases legendre_sym_eq_one_or_neg_one a p ha with h h,
    all_goals { rw h, norm_num } },
  { assume ha, rw [legendre_sym, if_pos ha] }
end

/-- Gauss' lemma. The legendre symbol can be computed by considering the number of naturals less
  than `p/2` such that `(a * x) % p > p / 2` -/
lemma gauss_lemma {a : ℕ} [fact (p % 2 = 1)] (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym a p = (-1) ^ ((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card :=
have (legendre_sym a p : zmod p) = (((-1)^((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card : ℤ) : zmod p),
  by rw [legendre_sym_eq_pow, gauss_lemma_aux₂ p ha0]; simp,
begin
  cases legendre_sym_eq_one_or_neg_one a p ha0;
  cases neg_one_pow_eq_or ℤ ((Ico 1 (p / 2).succ).filter
    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card;
  simp [*, ne_neg_self p one_ne_zero, (ne_neg_self p one_ne_zero).symm] at *
end

lemma legendre_sym_eq_one_iff {a : ℕ} (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym a p = 1 ↔ (∃ b : zmod p, b ^ 2 = a) :=
begin
  rw [euler_criterion p ha0, legendre_sym, if_neg ha0],
  split_ifs,
  { simp only [h, eq_self_iff_true] },
  finish -- this is quite slow. I'm actually surprised that it can close the goal at all!
end

lemma eisenstein_lemma [fact (p % 2 = 1)] {a : ℕ} (ha1 : a % 2 = 1) (ha0 : (a : zmod p) ≠ 0) :
  legendre_sym a p = (-1)^∑ x in Ico 1 (p / 2).succ, (x * a) / p :=
by rw [neg_one_pow_eq_pow_mod_two, gauss_lemma p ha0, neg_one_pow_eq_pow_mod_two,
    show _ = _, from eisenstein_lemma_aux₂ p ha1 ha0]

theorem quadratic_reciprocity [hp1 : fact (p % 2 = 1)] [hq1 : fact (q % 2 = 1)] (hpq : p ≠ q) :
  legendre_sym p q * legendre_sym q p = (-1) ^ ((p / 2) * (q / 2)) :=
have hpq0 : (p : zmod q) ≠ 0, from prime_ne_zero q p hpq.symm,
have hqp0 : (q : zmod p) ≠ 0, from prime_ne_zero p q hpq,
by rw [eisenstein_lemma q hp1.1 hpq0, eisenstein_lemma p hq1.1 hqp0,
  ← pow_add, sum_mul_div_add_sum_mul_div_eq_mul q p hpq0, mul_comm]

-- move this
local attribute [instance]
lemma fact_prime_two : fact (nat.prime 2) := ⟨nat.prime_two⟩

lemma legendre_sym_two [hp1 : fact (p % 2 = 1)] : legendre_sym 2 p = (-1) ^ (p / 4 + p / 2) :=
have hp2 : p ≠ 2, from mt (congr_arg (% 2)) (by simpa using hp1.1),
have hp22 : p / 2 / 2 = _ := div_eq_filter_card (show 0 < 2, from dec_trivial)
  (nat.div_le_self (p / 2) 2),
have hcard : (Ico 1 (p / 2).succ).card = p / 2, by simp,
have hx2 : ∀ x ∈ Ico 1 (p / 2).succ, (2 * x : zmod p).val = 2 * x,
  from λ x hx, have h2xp : 2 * x < p,
      from calc 2 * x ≤ 2 * (p / 2) : mul_le_mul_of_nonneg_left
        (le_of_lt_succ $ by finish) dec_trivial
      ... < _ : by conv_rhs {rw [← div_add_mod p 2, hp1.1]}; exact lt_succ_self _,
    by rw [← nat.cast_two, ← nat.cast_mul, val_cast_of_lt h2xp],
have hdisj : disjoint
    ((Ico 1 (p / 2).succ).filter (λ x, p / 2 < ((2 : ℕ) * x : zmod p).val))
    ((Ico 1 (p / 2).succ).filter (λ x, x * 2 ≤ p / 2)),
  from disjoint_filter.2 (λ x hx, by simp [hx2 _ hx, mul_comm]),
have hunion :
    ((Ico 1 (p / 2).succ).filter (λ x, p / 2 < ((2 : ℕ) * x : zmod p).val)) ∪
    ((Ico 1 (p / 2).succ).filter (λ x, x * 2 ≤ p / 2)) =
    Ico 1 (p / 2).succ,
  begin
    rw [filter_union_right],
    conv_rhs {rw [← @filter_true _ (Ico 1 (p / 2).succ)]},
    exact filter_congr (λ x hx, by simp [hx2 _ hx, lt_or_le, mul_comm])
  end,
begin
  rw [gauss_lemma p (prime_ne_zero p 2 hp2),
    neg_one_pow_eq_pow_mod_two, @neg_one_pow_eq_pow_mod_two _ _ (p / 4 + p / 2)],
  refine congr_arg2 _ rfl ((eq_iff_modeq_nat 2).1 _),
  rw [show 4 = 2 * 2, from rfl, ← nat.div_div_eq_div_mul, hp22, nat.cast_add,
    ← sub_eq_iff_eq_add', sub_eq_add_neg, neg_eq_self_mod_two,
    ← nat.cast_add, ← card_disjoint_union hdisj, hunion, hcard]
end

lemma exists_sq_eq_two_iff [hp1 : fact (p % 2 = 1)] :
  (∃ a : zmod p, a ^ 2 = 2) ↔ p % 8 = 1 ∨ p % 8 = 7 :=
have hp2 : ((2 : ℕ) : zmod p) ≠ 0,
  from prime_ne_zero p 2 (λ h, by simpa [h] using hp1.1),
have hpm4 : p % 4 = p % 8 % 4, from (nat.mod_mul_left_mod p 2 4).symm,
have hpm2 : p % 2 = p % 8 % 2, from (nat.mod_mul_left_mod p 4 2).symm,
begin
  rw [show (2 : zmod p) = (2 : ℕ), by simp, ← legendre_sym_eq_one_iff p hp2,
    legendre_sym_two p, neg_one_pow_eq_one_iff_even (show (-1 : ℤ) ≠ 1, from dec_trivial),
    even_add, even_div, even_div],
  have := nat.mod_lt p (show 0 < 8, from dec_trivial),
  resetI, rw fact_iff at hp1,
  revert this hp1,
  erw [hpm4, hpm2],
  generalize hm : p % 8 = m, unfreezingI {clear_dependent p},
  dec_trivial!,
end

lemma exists_sq_eq_prime_iff_of_mod_four_eq_one (hp1 : p % 4 = 1) [hq1 : fact (q % 2 = 1)] :
  (∃ a : zmod p, a ^ 2 = q) ↔ ∃ b : zmod q, b ^ 2 = p :=
if hpq : p = q then by substI hpq else
have h1 : ((p / 2) * (q / 2)) % 2 = 0,
  from (dvd_iff_mod_eq_zero _ _).1
    (dvd_mul_of_dvd_left ((dvd_iff_mod_eq_zero _ _).2 $
    by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp1]; refl) _),
begin
  haveI hp_odd : fact (p % 2 = 1) := ⟨odd_of_mod_four_eq_one hp1⟩,
  have hpq0 : (p : zmod q) ≠ 0 := prime_ne_zero q p (ne.symm hpq),
  have hqp0 : (q : zmod p) ≠ 0 := prime_ne_zero p q hpq,
  have := quadratic_reciprocity p q hpq,
  rw [neg_one_pow_eq_pow_mod_two, h1, legendre_sym, legendre_sym,
    if_neg hqp0, if_neg hpq0] at this,
  rw [euler_criterion q hpq0, euler_criterion p hqp0],
  split_ifs at this; simp *; contradiction,
end

lemma exists_sq_eq_prime_iff_of_mod_four_eq_three (hp3 : p % 4 = 3)
  (hq3 : q % 4 = 3) (hpq : p ≠ q) : (∃ a : zmod p, a ^ 2 = q) ↔ ¬∃ b : zmod q, b ^ 2 = p :=
have h1 : ((p / 2) * (q / 2)) % 2 = 1,
  from nat.odd_mul_odd
    (by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp3]; refl)
    (by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hq3]; refl),
begin
  haveI hp_odd : fact (p % 2 = 1) := ⟨odd_of_mod_four_eq_three hp3⟩,
  haveI hq_odd : fact (q % 2 = 1) := ⟨odd_of_mod_four_eq_three hq3⟩,
  have hpq0 : (p : zmod q) ≠ 0 := prime_ne_zero q p (ne.symm hpq),
  have hqp0 : (q : zmod p) ≠ 0 := prime_ne_zero p q hpq,
  have := quadratic_reciprocity p q hpq,
  rw [neg_one_pow_eq_pow_mod_two, h1, legendre_sym, legendre_sym,
    if_neg hpq0, if_neg hqp0] at this,
  rw [euler_criterion q hpq0, euler_criterion p hqp0],
  split_ifs at this; simp *; contradiction
end

end zmod


/-
Copyright (c) 2022 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck, David Loeffler
-/
import algebra.module.submodule.basic
import topology.algebra.monoid
import analysis.asymptotics.asymptotics

/-!
# Zero and Bounded at filter

Given a filter `l` we define the notion of a function being `zero_at_filter` as well as being
`bounded_at_filter`. Alongside this we construct the `submodule`, `add_submonoid` of functions
that are `zero_at_filter`. Similarly, we construct the `submodule` and `subalgebra` of functions
that are `bounded_at_filter`.

-/

namespace filter

variables {α β : Type*}

open_locale topology

/-- If `l` is a filter on `α`, then a function `f : α → β` is `zero_at_filter l`
  if it tends to zero along `l`. -/
def zero_at_filter [has_zero β] [topological_space β] (l : filter α) (f : α → β) : Prop :=
filter.tendsto f l (𝓝 0)

lemma zero_at_filter.add [topological_space β] [add_zero_class β] [has_continuous_add β]
  {l : filter α} {f g : α → β} (hf : zero_at_filter l f) (hg : zero_at_filter l g) :
  zero_at_filter l (f + g) :=
by simpa using hf.add hg

lemma zero_at_filter.neg [topological_space β] [add_group β] [has_continuous_neg β] {l : filter α}
  {f : α → β} (hf : zero_at_filter l f) :
  zero_at_filter l (-f) :=
by simpa using hf.neg

lemma zero_at_filter.smul {𝕜 : Type*} [topological_space 𝕜] [topological_space β] [has_zero 𝕜]
  [has_zero β] [smul_with_zero 𝕜 β] [has_continuous_smul 𝕜 β]
   {l : filter α} {f : α → β} (c : 𝕜) (hf : zero_at_filter l f) :
  zero_at_filter l (c • f) :=
by simpa using hf.const_smul c

/-- `zero_at_filter_submodule l` is the submodule of `f : α → β` which
tend to zero along `l`. -/
def zero_at_filter_submodule [topological_space β] [semiring β]
  [has_continuous_add β] [has_continuous_mul β] (l : filter α) : submodule β (α → β) :=
{ carrier := zero_at_filter l,
  zero_mem' := zero_zero_at_filter l,
  add_mem' := λ a b ha hb, ha.add hb,
  smul_mem' := λ c f hf, hf.smul c }

/-- `zero_at_filter_add_submonoid l` is the additive submonoid of `f : α → β`
which tend to zero along `l`. -/
def zero_at_filter_add_submonoid [topological_space β]
  [add_zero_class β] [has_continuous_add β] (l : filter α) : add_submonoid (α → β) :=
{ carrier := zero_at_filter l,
  add_mem' := λ a b ha hb, ha.add hb,
  zero_mem' := zero_zero_at_filter l, }

/-- If `l` is a filter on `α`, then a function `f: α → β` is `bounded_at_filter l`
if `f =O[l] 1`. -/
def bounded_at_filter [has_norm β] (l : filter α) (f : α → β) : Prop :=
asymptotics.is_O l f (1 : α → ℝ)

lemma zero_at_filter.bounded_at_filter [normed_add_comm_group β] {l : filter α} {f : α → β}
  (hf : zero_at_filter l f) : bounded_at_filter l f :=
begin
  rw [zero_at_filter, ← asymptotics.is_o_const_iff (one_ne_zero' ℝ)] at hf,
  exact hf.is_O,
end

lemma const_bounded_at_filter [normed_field β] (l : filter α) (c : β) :
  bounded_at_filter l (function.const α c : α → β) :=
asymptotics.is_O_const_const c one_ne_zero l

lemma bounded_at_filter.add [normed_add_comm_group β] {l : filter α} {f g : α → β}
  (hf : bounded_at_filter l f) (hg : bounded_at_filter l g) :
  bounded_at_filter l (f + g) :=
by simpa using hf.add hg

lemma bounded_at_filter.neg [normed_add_comm_group β] {l : filter α} {f : α → β}
  (hf : bounded_at_filter l f) :
  bounded_at_filter l (-f) :=
hf.neg_left

lemma bounded_at_filter.smul {𝕜 : Type*} [normed_field 𝕜] [normed_add_comm_group β]
  [normed_space 𝕜 β] {l : filter α} {f : α → β} (c : 𝕜) (hf : bounded_at_filter l f) :
  bounded_at_filter l (c • f) :=
hf.const_smul_left c

lemma bounded_at_filter.mul [normed_field β] {l : filter α} {f g : α → β}
  (hf : bounded_at_filter l f) (hg : bounded_at_filter l g) :
  bounded_at_filter l (f * g) :=
begin
  refine (hf.mul hg).trans _,
  convert asymptotics.is_O_refl _ l,
  ext x,
  simp,
end

/-- The submodule of functions that are bounded along a filter `l`. -/
def bounded_filter_submodule [normed_field β] (l : filter α) : submodule β (α → β) :=
{ carrier := bounded_at_filter l,
  zero_mem' := const_bounded_at_filter l 0,
  add_mem' := λ f g hf hg, hf.add hg,
  smul_mem' := λ c f hf, hf.smul c }

/-- The subalgebra of functions that are bounded along a filter `l`. -/
def bounded_filter_subalgebra [normed_field β] (l : filter α) :
  subalgebra β (α → β) :=
begin
  refine submodule.to_subalgebra (bounded_filter_submodule l) _ (λ f g hf hg, _),
  { exact const_bounded_at_filter l (1:β) },
  { simpa only [pi.one_apply, mul_one, norm_mul] using hf.mul hg, },

end

end filter


/-
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, Yury Kudryashov, Sébastien Gouëzel, Chris Hughes
-/
import data.fin.basic
import data.pi.lex

/-!
# Operation on tuples

We interpret maps `Π i : fin n, α i` as `n`-tuples of elements of possibly varying type `α i`,
`(α 0, …, α (n-1))`. A particular case is `fin n → α` of elements with all the same type.
In this case when `α i` is a constant map, then tuples are isomorphic (but not definitionally equal)
to `vector`s.

We define the following operations:

* `fin.tail` : the tail of an `n+1` tuple, i.e., its last `n` entries;
* `fin.cons` : adding an element at the beginning of an `n`-tuple, to get an `n+1`-tuple;
* `fin.init` : the beginning of an `n+1` tuple, i.e., its first `n` entries;
* `fin.snoc` : adding an element at the end of an `n`-tuple, to get an `n+1`-tuple. The name `snoc`
  comes from `cons` (i.e., adding an element to the left of a tuple) read in reverse order.
* `fin.insert_nth` : insert an element to a tuple at a given position.
* `fin.find p` : returns the first index `n` where `p n` is satisfied, and `none` if it is never
  satisfied.

-/
universes u v

namespace fin

variables {m n : ℕ}
open function

section tuple

/-- There is exactly one tuple of size zero. -/
example (α : fin 0 → Sort u) : unique (Π i : fin 0, α i) :=
by apply_instance

@[simp] lemma tuple0_le {α : Π i : fin 0, Type*} [Π i, preorder (α i)] (f g : Π i, α i) : f ≤ g :=
fin_zero_elim

variables {α : fin (n+1) → Type u} (x : α 0) (q : Πi, α i) (p : Π(i : fin n), α (i.succ))
  (i : fin n) (y : α i.succ) (z : α 0)

/-- The tail of an `n+1` tuple, i.e., its last `n` entries. -/
def tail (q : Πi, α i) : (Π(i : fin n), α (i.succ)) := λ i, q i.succ

lemma tail_def {n : ℕ} {α : fin (n+1) → Type*} {q : Π i, α i} :
  tail (λ k : fin (n+1), q k) = (λ k : fin n, q k.succ) := rfl

/-- Adding an element at the beginning of an `n`-tuple, to get an `n+1`-tuple. -/
def cons (x : α 0) (p : Π(i : fin n), α (i.succ)) : Πi, α i :=
λ j, fin.cases x p j

@[simp] lemma tail_cons : tail (cons x p) = p :=
by simp [tail, cons]

@[simp] lemma cons_succ : cons x p i.succ = p i :=
by simp [cons]

@[simp] lemma cons_zero : cons x p 0 = x :=
by simp [cons]

/-- Updating a tuple and adding an element at the beginning commute. -/
@[simp] lemma cons_update : cons x (update p i y) = update (cons x p) i.succ y :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, simp [ne.symm (succ_ne_zero i)] },
  { let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, cons_succ],
    by_cases h' : j' = i,
    { rw h', simp },
    { have : j'.succ ≠ i.succ, by rwa [ne.def, succ_inj],
      rw [update_noteq h', update_noteq this, cons_succ] } }
end

/-- As a binary function, `fin.cons` is injective. -/
lemma cons_injective2 : function.injective2 (@cons n α) :=
λ x₀ y₀ x y h, ⟨congr_fun h 0, funext $ λ i, by simpa using congr_fun h (fin.succ i)⟩

@[simp] lemma cons_eq_cons {x₀ y₀ : α 0} {x y : Π i : fin n, α (i.succ)} :
  cons x₀ x = cons y₀ y ↔ x₀ = y₀ ∧ x = y :=
cons_injective2.eq_iff

lemma cons_left_injective (x : Π i : fin n, α (i.succ)) : function.injective (λ x₀, cons x₀ x) :=
cons_injective2.left _

lemma cons_right_injective (x₀ : α 0) : function.injective (cons x₀) :=
cons_injective2.right _

/-- Adding an element at the beginning of a tuple and then updating it amounts to adding it
directly. -/
lemma update_cons_zero : update (cons x p) 0 z = cons z p :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, simp },
  { simp only [h, update_noteq, ne.def, not_false_iff],
    let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, cons_succ, cons_succ] }
end

/-- Concatenating the first element of a tuple with its tail gives back the original tuple -/
@[simp] lemma cons_self_tail : cons (q 0) (tail q) = q :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, simp },
  { let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, tail, cons_succ] }
end

/-- Recurse on an `n+1`-tuple by splitting it into a single element and an `n`-tuple. -/
@[elab_as_eliminator]
def cons_induction {P : (Π i : fin n.succ, α i) → Sort v}
  (h : ∀ x₀ x, P (fin.cons x₀ x)) (x : (Π i : fin n.succ, α i)) : P x :=
_root_.cast (by rw cons_self_tail) $ h (x 0) (tail x)

@[simp] lemma cons_induction_cons {P : (Π i : fin n.succ, α i) → Sort v}
  (h : Π x₀ x, P (fin.cons x₀ x)) (x₀ : α 0) (x : Π i : fin n, α i.succ) :
  @cons_induction _ _ _ h (cons x₀ x) = h x₀ x :=
begin
  rw [cons_induction, cast_eq],
  congr',
  exact tail_cons _ _
end

/-- Updating the first element of a tuple does not change the tail. -/
@[simp] lemma tail_update_zero : tail (update q 0 z) = tail q :=
by { ext j, simp [tail, fin.succ_ne_zero] }

/-- Updating a nonzero element and taking the tail commute. -/
@[simp] lemma tail_update_succ :
  tail (update q i.succ y) = update (tail q) i y :=
begin
  ext j,
  by_cases h : j = i,
  { rw h, simp [tail] },
  { simp [tail, (fin.succ_injective n).ne h, h] }
end

lemma comp_cons {α : Type*} {β : Type*} (g : α → β) (y : α) (q : fin n → α) :
  g ∘ (cons y q) = cons (g y) (g ∘ q) :=
begin
  ext j,
  by_cases h : j = 0,
  { rw h, refl },
  { let j' := pred j h,
    have : j'.succ = j := succ_pred j h,
    rw [← this, cons_succ, comp_app, cons_succ] }
end

lemma comp_tail {α : Type*} {β : Type*} (g : α → β) (q : fin n.succ → α) :
  g ∘ (tail q) = tail (g ∘ q) :=
by { ext j, simp [tail] }

lemma le_cons [Π i, preorder (α i)] {x : α 0} {q : Π i, α i} {p : Π i : fin n, α i.succ} :
  q ≤ cons x p ↔ q 0 ≤ x ∧ tail q ≤ p :=
forall_fin_succ.trans $ and_congr iff.rfl $ forall_congr $ λ j, by simp [tail]

lemma cons_le [Π i, preorder (α i)] {x : α 0} {q : Π i, α i} {p : Π i : fin n, α i.succ} :
  cons x p ≤ q ↔ x ≤ q 0 ∧ p ≤ tail q :=
@le_cons  _ (λ i, (α i)ᵒᵈ) _ x q p

lemma cons_le_cons [Π i, preorder (α i)] {x₀ y₀ : α 0} {x y : Π i : fin n, α (i.succ)} :
  cons x₀ x ≤ cons y₀ y ↔ x₀ ≤ y₀ ∧ x ≤ y :=
forall_fin_succ.trans $ and_congr_right' $ by simp only [cons_succ, pi.le_def]

lemma pi_lex_lt_cons_cons {x₀ y₀ : α 0} {x y : Π i : fin n, α (i.succ)}
  (s : Π {i : fin n.succ}, α i → α i → Prop) :
  pi.lex (<) @s (fin.cons x₀ x) (fin.cons y₀ y) ↔
    s x₀ y₀ ∨ x₀ = y₀ ∧ pi.lex (<) (λ i : fin n, @s i.succ) x y :=
begin
  simp_rw [pi.lex, fin.exists_fin_succ, fin.cons_succ, fin.cons_zero, fin.forall_fin_succ],
  simp [and_assoc, exists_and_distrib_left],
end

@[simp]
lemma range_cons {α : Type*} {n : ℕ} (x : α) (b : fin n → α) :
  set.range (fin.cons x b : fin n.succ → α) = insert x (set.range b) :=
begin
  ext y,
  simp only [set.mem_range, set.mem_insert_iff],
  split,
  { rintros ⟨i, rfl⟩,
    refine cases (or.inl (cons_zero _ _)) (λ i, or.inr ⟨i, _⟩) i,
    rw cons_succ },
  { rintros (rfl | ⟨i, hi⟩),
    { exact ⟨0, fin.cons_zero _ _⟩ },
    { refine ⟨i.succ, _⟩,
      rw [cons_succ, hi] } }
end

/-- `fin.append ho u v` appends two vectors of lengths `m` and `n` to produce
one of length `o = m + n`.  `ho` provides control of definitional equality
for the vector length. -/
def append {α : Type*} {o : ℕ} (ho : o = m + n) (u : fin m → α) (v : fin n → α) : fin o → α :=
λ i, if h : (i : ℕ) < m
  then u ⟨i, h⟩
  else v ⟨(i : ℕ) - m, (tsub_lt_iff_left (le_of_not_lt h)).2 (ho ▸ i.property)⟩

@[simp] lemma fin_append_apply_zero {α : Type*} {o : ℕ} (ho : (o + 1) = (m + 1) + n)
  (u : fin (m + 1) → α) (v : fin n → α) :
  fin.append ho u v 0 = u 0 := rfl

end tuple

section tuple_right
/-! In the previous section, we have discussed inserting or removing elements on the left of a
tuple. In this section, we do the same on the right. A difference is that `fin (n+1)` is constructed
inductively from `fin n` starting from the left, not from the right. This implies that Lean needs
more help to realize that elements belong to the right types, i.e., we need to insert casts at
several places. -/

variables {α : fin (n+1) → Type u} (x : α (last n)) (q : Πi, α i) (p : Π(i : fin n), α i.cast_succ)
(i : fin n) (y : α i.cast_succ) (z : α (last n))

/-- The beginning of an `n+1` tuple, i.e., its first `n` entries -/
def init (q : Πi, α i) (i : fin n) : α i.cast_succ :=
q i.cast_succ

lemma init_def {n : ℕ} {α : fin (n+1) → Type*} {q : Π i, α i} :
  init (λ k : fin (n+1), q k) = (λ k : fin n, q k.cast_succ) := rfl

/-- Adding an element at the end of an `n`-tuple, to get an `n+1`-tuple. The name `snoc` comes from
`cons` (i.e., adding an element to the left of a tuple) read in reverse order. -/
def snoc (p : Π(i : fin n), α i.cast_succ) (x : α (last n)) (i : fin (n+1)) : α i :=
if h : i.val < n
then _root_.cast (by rw fin.cast_succ_cast_lt i h) (p (cast_lt i h))
else _root_.cast (by rw eq_last_of_not_lt h) x

@[simp] lemma init_snoc : init (snoc p x) = p :=
begin
  ext i,
  have h' := fin.cast_lt_cast_succ i i.is_lt,
  simp [init, snoc, i.is_lt, h'],
  convert cast_eq rfl (p i)
end

@[simp] lemma snoc_cast_succ : snoc p x i.cast_succ = p i :=
begin
  have : i.cast_succ.val < n := i.is_lt,
  have h' := fin.cast_lt_cast_succ i i.is_lt,
  simp [snoc, this, h'],
  convert cast_eq rfl (p i)
end

@[simp] lemma snoc_comp_cast_succ {n : ℕ} {α : Sort*} {a : α} {f : fin n → α} :
  (snoc f a : fin (n + 1) → α) ∘ cast_succ = f :=
funext (λ i, by rw [function.comp_app, snoc_cast_succ])

@[simp] lemma snoc_last : snoc p x (last n) = x :=
by { simp [snoc] }

@[simp] lemma snoc_comp_nat_add {n m : ℕ} {α : Sort*} (f : fin (m + n) → α) (a : α) :
  (snoc f a : fin _ → α) ∘ (nat_add m : fin (n + 1) → fin (m + n + 1)) = snoc (f ∘ nat_add m) a :=
begin
  ext i,
  refine fin.last_cases _ (λ i, _) i,
  { simp only [function.comp_app],
    rw [snoc_last, nat_add_last, snoc_last] },
  { simp only [function.comp_app],
    rw [snoc_cast_succ, nat_add_cast_succ, snoc_cast_succ] }
end

@[simp] lemma snoc_cast_add {α : fin (n + m + 1) → Type*}
  (f : Π i : fin (n + m), α (cast_succ i)) (a : α (last (n + m)))
  (i : fin n) :
  (snoc f a) (cast_add (m + 1) i) = f (cast_add m i) :=
dif_pos _

@[simp] lemma snoc_comp_cast_add {n m : ℕ} {α : Sort*} (f : fin (n + m) → α) (a : α) :
  (snoc f a : fin _ → α) ∘ cast_add (m + 1) = f ∘ cast_add m :=
funext (snoc_cast_add f a)

/-- Updating a tuple and adding an element at the end commute. -/
@[simp] lemma snoc_update : snoc (update p i y) x = update (snoc p x) i.cast_succ y :=
begin
  ext j,
  by_cases h : j.val < n,
  { simp only [snoc, h, dif_pos],
    by_cases h' : j = cast_succ i,
    { have C1 : α i.cast_succ = α j, by rw h',
      have E1 : update (snoc p x) i.cast_succ y j = _root_.cast C1 y,
      { have : update (snoc p x) j (_root_.cast C1 y) j = _root_.cast C1 y, by simp,
        convert this,
        { exact h'.symm },
        { exact heq_of_cast_eq (congr_arg α (eq.symm h')) rfl } },
      have C2 : α i.cast_succ = α (cast_succ (cast_lt j h)),
        by rw [cast_succ_cast_lt, h'],
      have E2 : update p i y (cast_lt j h) = _root_.cast C2 y,
      { have : update p (cast_lt j h) (_root_.cast C2 y) (cast_lt j h) = _root_.cast C2 y,
          by simp,
        convert this,
        { simp [h, h'] },
        { exact heq_of_cast_eq C2 rfl } },
      rw [E1, E2],
      exact eq_rec_compose _ _ _ },
    { have : ¬(cast_lt j h = i),
        by { assume E, apply h', rw [← E, cast_succ_cast_lt] },
      simp [h', this, snoc, h] } },
  { rw eq_last_of_not_lt h,
    simp [ne.symm (ne_of_lt (cast_succ_lt_last i))] }
end

/-- Adding an element at the beginning of a tuple and then updating it amounts to adding it
directly. -/
lemma update_snoc_last : update (snoc p x) (last n) z = snoc p z :=
begin
  ext j,
  by_cases h : j.val < n,
  { have : j ≠ last n := ne_of_lt h,
    simp [h, update_noteq, this, snoc] },
  { rw eq_last_of_not_lt h,
    simp }
end

/-- Concatenating the first element of a tuple with its tail gives back the original tuple -/
@[simp] lemma snoc_init_self : snoc (init q) (q (last n)) = q :=
begin
  ext j,
  by_cases h : j.val < n,
  { have : j ≠ last n := ne_of_lt h,
    simp [h, update_noteq, this, snoc, init, cast_succ_cast_lt],
    have A : cast_succ (cast_lt j h) = j := cast_succ_cast_lt _ _,
    rw ← cast_eq rfl (q j),
    congr' 1; rw A },
  { rw eq_last_of_not_lt h,
    simp }
end

/-- Updating the last element of a tuple does not change the beginning. -/
@[simp] lemma init_update_last : init (update q (last n) z) = init q :=
by { ext j, simp [init, ne_of_lt, cast_succ_lt_last] }

/-- Updating an element and taking the beginning commute. -/
@[simp] lemma init_update_cast_succ :
  init (update q i.cast_succ y) = update (init q) i y :=
begin
  ext j,
  by_cases h : j = i,
  { rw h, simp [init] },
  { simp [init, h] }
end

/-- `tail` and `init` commute. We state this lemma in a non-dependent setting, as otherwise it
would involve a cast to convince Lean that the two types are equal, making it harder to use. -/
lemma tail_init_eq_init_tail {β : Type*} (q : fin (n+2) → β) :
  tail (init q) = init (tail q) :=
by { ext i, simp [tail, init, cast_succ_fin_succ] }

/-- `cons` and `snoc` commute. We state this lemma in a non-dependent setting, as otherwise it
would involve a cast to convince Lean that the two types are equal, making it harder to use. -/
lemma cons_snoc_eq_snoc_cons {β : Type*} (a : β) (q : fin n → β) (b : β) :
  @cons n.succ (λ i, β) a (snoc q b) = snoc (cons a q) b :=
begin
  ext i,
  by_cases h : i = 0,
  { rw h, refl },
  set j := pred i h with ji,
  have : i = j.succ, by rw [ji, succ_pred],
  rw [this, cons_succ],
  by_cases h' : j.val < n,
  { set k := cast_lt j h' with jk,
    have : j = k.cast_succ, by rw [jk, cast_succ_cast_lt],
    rw [this, ← cast_succ_fin_succ],
    simp },
  rw [eq_last_of_not_lt h', succ_last],
  simp
end

lemma comp_snoc {α : Type*} {β : Type*} (g : α → β) (q : fin n → α) (y : α) :
  g ∘ (snoc q y) = snoc (g ∘ q) (g y) :=
begin
  ext j,
  by_cases h : j.val < n,
  { have : j ≠ last n := ne_of_lt h,
    simp [h, this, snoc, cast_succ_cast_lt] },
  { rw eq_last_of_not_lt h,
    simp }
end

lemma comp_init {α : Type*} {β : Type*} (g : α → β) (q : fin n.succ → α) :
  g ∘ (init q) = init (g ∘ q) :=
by { ext j, simp [init] }

end tuple_right

section insert_nth

variables {α : fin (n+1) → Type u} {β : Type v}

/-- Define a function on `fin (n + 1)` from a value on `i : fin (n + 1)` and values on each
`fin.succ_above i j`, `j : fin n`. This version is elaborated as eliminator and works for
propositions, see also `fin.insert_nth` for a version without an `@[elab_as_eliminator]`
attribute. -/
@[elab_as_eliminator]
def succ_above_cases {α : fin (n + 1) → Sort u} (i : fin (n + 1)) (x : α i)
  (p : Π j : fin n, α (i.succ_above j)) (j : fin (n + 1)) : α j :=
if hj : j = i then eq.rec x hj.symm
else if hlt : j < i then eq.rec_on (succ_above_cast_lt hlt) (p _)
else eq.rec_on (succ_above_pred $ (ne.lt_or_lt hj).resolve_left hlt) (p _)

lemma forall_iff_succ_above {p : fin (n + 1) → Prop} (i : fin (n + 1)) :
  (∀ j, p j) ↔ p i ∧ ∀ j, p (i.succ_above j) :=
⟨λ h, ⟨h _, λ j, h _⟩, λ h, succ_above_cases i h.1 h.2⟩

/-- Insert an element into a tuple at a given position. For `i = 0` see `fin.cons`,
for `i = fin.last n` see `fin.snoc`. See also `fin.succ_above_cases` for a version elaborated
as an eliminator. -/
def insert_nth (i : fin (n + 1)) (x : α i) (p : Π j : fin n, α (i.succ_above j)) (j : fin (n + 1)) :
  α j :=
succ_above_cases i x p j

@[simp] lemma insert_nth_apply_same (i : fin (n + 1)) (x : α i) (p : Π j, α (i.succ_above j)) :
  insert_nth i x p i = x :=
by simp [insert_nth, succ_above_cases]

@[simp] lemma insert_nth_apply_succ_above (i : fin (n + 1)) (x : α i) (p : Π j, α (i.succ_above j))
  (j : fin n) :
  insert_nth i x p (i.succ_above j) = p j :=
begin
  simp only [insert_nth, succ_above_cases, dif_neg (succ_above_ne _ _)],
  by_cases hlt : j.cast_succ < i,
  { rw [dif_pos ((succ_above_lt_iff _ _).2 hlt)],
    apply eq_of_heq ((eq_rec_heq _ _).trans _),
    rw [cast_lt_succ_above hlt] },
  { rw [dif_neg (mt (succ_above_lt_iff _ _).1 hlt)],
    apply eq_of_heq ((eq_rec_heq _ _).trans _),
    rw [pred_succ_above (le_of_not_lt hlt)] }
end

@[simp] lemma succ_above_cases_eq_insert_nth :
  @succ_above_cases.{u + 1} = @insert_nth.{u} := rfl

@[simp] lemma insert_nth_comp_succ_above (i : fin (n + 1)) (x : β) (p : fin n → β) :
  insert_nth i x p ∘ i.succ_above = p :=
funext $ insert_nth_apply_succ_above i x p

lemma insert_nth_eq_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  i.insert_nth x p = q ↔ q i = x ∧ p = (λ j, q (i.succ_above j)) :=
by simp [funext_iff, forall_iff_succ_above i, eq_comm]

lemma eq_insert_nth_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  q = i.insert_nth x p ↔ q i = x ∧ p = (λ j, q (i.succ_above j)) :=
eq_comm.trans insert_nth_eq_iff

lemma insert_nth_apply_below {i j : fin (n + 1)} (h : j < i) (x : α i)
  (p : Π k, α (i.succ_above k)) :
  i.insert_nth x p j = eq.rec_on (succ_above_cast_lt h) (p $ j.cast_lt _) :=
by rw [insert_nth, succ_above_cases, dif_neg h.ne, dif_pos h]

lemma insert_nth_apply_above {i j : fin (n + 1)} (h : i < j) (x : α i)
  (p : Π k, α (i.succ_above k)) :
  i.insert_nth x p j = eq.rec_on (succ_above_pred h) (p $ j.pred _) :=
by rw [insert_nth, succ_above_cases, dif_neg h.ne', dif_neg h.not_lt]

lemma insert_nth_zero (x : α 0) (p : Π j : fin n, α (succ_above 0 j)) :
  insert_nth 0 x p = cons x (λ j, _root_.cast (congr_arg α (congr_fun succ_above_zero j)) (p j)) :=
begin
  refine insert_nth_eq_iff.2 ⟨by simp, _⟩,
  ext j,
  convert (cons_succ _ _ _).symm
end

@[simp] lemma insert_nth_zero' (x : β) (p : fin n → β) :
  @insert_nth _ (λ _, β) 0 x p = cons x p :=
by simp [insert_nth_zero]

lemma insert_nth_last (x : α (last n)) (p : Π j : fin n, α ((last n).succ_above j)) :
  insert_nth (last n) x p =
    snoc (λ j, _root_.cast (congr_arg α (succ_above_last_apply j)) (p j)) x :=
begin
  refine insert_nth_eq_iff.2 ⟨by simp, _⟩,
  ext j,
  apply eq_of_heq,
  transitivity snoc (λ j, _root_.cast (congr_arg α (succ_above_last_apply j)) (p j)) x j.cast_succ,
  { rw [snoc_cast_succ], exact (cast_heq _ _).symm },
  { apply congr_arg_heq,
    rw [succ_above_last] }
end

@[simp] lemma insert_nth_last' (x : β) (p : fin n → β) :
  @insert_nth _ (λ _, β) (last n) x p = snoc p x :=
by simp [insert_nth_last]

@[simp] lemma insert_nth_zero_right [Π j, has_zero (α j)] (i : fin (n + 1)) (x : α i) :
  i.insert_nth x 0 = pi.single i x :=
insert_nth_eq_iff.2 $ by simp [succ_above_ne, pi.zero_def]

lemma insert_nth_binop (op : Π j, α j → α j → α j) (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (op i x y) (λ j, op _ (p j) (q j)) =
    λ j, op j (i.insert_nth x p j) (i.insert_nth y q j) :=
insert_nth_eq_iff.2 $ by simp

@[simp] lemma insert_nth_mul [Π j, has_mul (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x * y) (p * q) = i.insert_nth x p * i.insert_nth y q :=
insert_nth_binop (λ _, (*)) i x y p q

@[simp] lemma insert_nth_add [Π j, has_add (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x + y) (p + q) = i.insert_nth x p + i.insert_nth y q :=
insert_nth_binop (λ _, (+)) i x y p q

@[simp] lemma insert_nth_div [Π j, has_div (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x / y) (p / q) = i.insert_nth x p / i.insert_nth y q :=
insert_nth_binop (λ _, (/)) i x y p q

@[simp] lemma insert_nth_sub [Π j, has_sub (α j)] (i : fin (n + 1))
  (x y : α i) (p q : Π j, α (i.succ_above j)) :
  i.insert_nth (x - y) (p - q) = i.insert_nth x p - i.insert_nth y q :=
insert_nth_binop (λ _, has_sub.sub) i x y p q

@[simp] lemma insert_nth_sub_same [Π j, add_group (α j)] (i : fin (n + 1))
  (x y : α i) (p : Π j, α (i.succ_above j)) :
  i.insert_nth x p - i.insert_nth y p = pi.single i (x - y) :=
by simp_rw [← insert_nth_sub, ← insert_nth_zero_right, pi.sub_def, sub_self, pi.zero_def]

variables [Π i, preorder (α i)]

lemma insert_nth_le_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  i.insert_nth x p ≤ q ↔ x ≤ q i ∧ p ≤ (λ j, q (i.succ_above j)) :=
by simp [pi.le_def, forall_iff_succ_above i]

lemma le_insert_nth_iff {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)} {q : Π j, α j} :
  q ≤ i.insert_nth x p ↔ q i ≤ x ∧ (λ j, q (i.succ_above j)) ≤ p :=
by simp [pi.le_def, forall_iff_succ_above i]

open set

lemma insert_nth_mem_Icc {i : fin (n + 1)} {x : α i} {p : Π j, α (i.succ_above j)}
  {q₁ q₂ : Π j, α j} :
  i.insert_nth x p ∈ Icc q₁ q₂ ↔
    x ∈ Icc (q₁ i) (q₂ i) ∧ p ∈ Icc (λ j, q₁ (i.succ_above j)) (λ j, q₂ (i.succ_above j)) :=
by simp only [mem_Icc, insert_nth_le_iff, le_insert_nth_iff, and.assoc, and.left_comm]

lemma preimage_insert_nth_Icc_of_mem {i : fin (n + 1)} {x : α i} {q₁ q₂ : Π j, α j}
  (hx : x ∈ Icc (q₁ i) (q₂ i)) :
  i.insert_nth x ⁻¹' (Icc q₁ q₂) = Icc (λ j, q₁ (i.succ_above j)) (λ j, q₂ (i.succ_above j)) :=
set.ext $ λ p, by simp only [mem_preimage, insert_nth_mem_Icc, hx, true_and]

lemma preimage_insert_nth_Icc_of_not_mem {i : fin (n + 1)} {x : α i} {q₁ q₂ : Π j, α j}
  (hx : x ∉ Icc (q₁ i) (q₂ i)) :
  i.insert_nth x ⁻¹' (Icc q₁ q₂) = ∅ :=
set.ext $ λ p, by simp only [mem_preimage, insert_nth_mem_Icc, hx, false_and, mem_empty_eq]

end insert_nth

section find

/-- `find p` returns the first index `n` where `p n` is satisfied, and `none` if it is never
satisfied. -/
def find : Π {n : ℕ} (p : fin n → Prop) [decidable_pred p], option (fin n)
| 0     p _ := none
| (n+1) p _ := by resetI; exact option.cases_on
  (@find n (λ i, p (i.cast_lt (nat.lt_succ_of_lt i.2))) _)
  (if h : p (fin.last n) then some (fin.last n) else none)
  (λ i, some (i.cast_lt (nat.lt_succ_of_lt i.2)))

/-- If `find p = some i`, then `p i` holds -/

/-- `find p` does not return `none` if and only if `p i` holds at some index `i`. -/
lemma is_some_find_iff : Π {n : ℕ} {p : fin n → Prop} [decidable_pred p],
  by exactI (find p).is_some ↔ ∃ i, p i
| 0     p _ := iff_of_false (λ h, bool.no_confusion h) (λ ⟨i, _⟩, fin_zero_elim i)
| (n+1) p _ := ⟨λ h, begin
  rw [option.is_some_iff_exists] at h,
  cases h with i hi,
  exactI ⟨i, find_spec _ hi⟩
end, λ ⟨⟨i, hin⟩, hi⟩,
begin
  resetI,
  dsimp [find],
  cases h : find (λ i : fin n, (p (i.cast_lt (nat.lt_succ_of_lt i.2)))) with j,
  { split_ifs with hl hl,
    { exact option.is_some_some },
    { have := (@is_some_find_iff n (λ x, p (x.cast_lt (nat.lt_succ_of_lt x.2))) _).2
        ⟨⟨i, lt_of_le_of_ne (nat.le_of_lt_succ hin)
        (λ h, by clear_aux_decl; cases h; exact hl hi)⟩, hi⟩,
      rw h at this,
      exact this } },
  { simp }
end⟩

/-- `find p` returns `none` if and only if `p i` never holds. -/
lemma find_eq_none_iff {n : ℕ} {p : fin n → Prop} [decidable_pred p] :
  find p = none ↔ ∀ i, ¬ p i :=
by rw [← not_exists, ← is_some_find_iff]; cases (find p); simp

/-- If `find p` returns `some i`, then `p j` does not hold for `j < i`, i.e., `i` is minimal among
the indices where `p` holds. -/
lemma find_min : Π {n : ℕ} {p : fin n → Prop} [decidable_pred p] {i : fin n}
  (hi : i ∈ by exactI fin.find p) {j : fin n} (hj : j < i), ¬ p j
| 0     p _ i hi j hj hpj := option.no_confusion hi
| (n+1) p _ i hi ⟨j, hjn⟩ hj hpj := begin
  resetI,
  dsimp [find] at hi,
  cases h : find (λ i : fin n, (p (i.cast_lt (nat.lt_succ_of_lt i.2)))) with k,
  { rw [h] at hi,
    split_ifs at hi with hl hl,
    { subst hi,
      rw [find_eq_none_iff] at h,
      exact h ⟨j, hj⟩ hpj },
    { exact hi.elim } },
  { rw h at hi,
    dsimp at hi,
    obtain rfl := option.some_inj.1 hi,
    exact find_min h (show (⟨j, lt_trans hj k.2⟩ : fin n) < k, from hj) hpj }
end

lemma find_min' {p : fin n → Prop} [decidable_pred p] {i : fin n}
  (h : i ∈ fin.find p) {j : fin n} (hj : p j) : i ≤ j :=
le_of_not_gt (λ hij, find_min h hij hj)

lemma nat_find_mem_find {p : fin n → Prop} [decidable_pred p]
  (h : ∃ i, ∃ hin : i < n, p ⟨i, hin⟩) :
  (⟨nat.find h, (nat.find_spec h).fst⟩ : fin n) ∈ find p :=
let ⟨i, hin, hi⟩ := h in
begin
  cases hf : find p with f,
  { rw [find_eq_none_iff] at hf,
    exact (hf ⟨i, hin⟩ hi).elim },
  { refine option.some_inj.2 (le_antisymm _ _),
    { exact find_min' hf (nat.find_spec h).snd },
    { exact nat.find_min' _ ⟨f.2, by convert find_spec p hf;
        exact fin.eta _ _⟩ } }
end

lemma mem_find_iff {p : fin n → Prop} [decidable_pred p] {i : fin n} :
  i ∈ fin.find p ↔ p i ∧ ∀ j, p j → i ≤ j :=
⟨λ hi, ⟨find_spec _ hi, λ _, find_min' hi⟩,
  begin
    rintros ⟨hpi, hj⟩,
    cases hfp : fin.find p,
    { rw [find_eq_none_iff] at hfp,
      exact (hfp _ hpi).elim },
    { exact option.some_inj.2 (le_antisymm (find_min' hfp hpi) (hj _ (find_spec _ hfp))) }
  end⟩

lemma find_eq_some_iff {p : fin n → Prop} [decidable_pred p] {i : fin n} :
  fin.find p = some i ↔ p i ∧ ∀ j, p j → i ≤ j :=
 mem_find_iff

lemma mem_find_of_unique {p : fin n → Prop} [decidable_pred p]
  (h : ∀ i j, p i → p j → i = j) {i : fin n} (hi : p i) : i ∈ fin.find p :=
mem_find_iff.2 ⟨hi, λ j hj, le_of_eq $ h i j hi hj⟩

end find

end fin


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

! This file was ported from Lean 3 source module group_theory.double_coset
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Setoid.Basic
import Mathlib.GroupTheory.Subgroup.Basic
import Mathlib.GroupTheory.Coset
import Mathlib.GroupTheory.Subgroup.Pointwise
import Mathlib.Data.Set.Basic

/-!
# Double cosets

This file defines double cosets for two subgroups `H K` of a group `G` and the quotient of `G` by
the double coset relation, i.e. `H \ G / K`. We also prove that `G` can be writen as a disjoint
union of the double cosets and that if one of `H` or `K` is the trivial group (i.e. `⊥` ) then
this is the usual left or right quotient of a group by a subgroup.

## Main definitions

* `rel`: The double coset relation defined by two subgroups `H K` of `G`.
* `Doset.quotient`: The quotient of `G` by the double coset relation, i.e, ``H \ G / K`.
-/
-- porting note: removed import
-- import Mathlib.Tactic.Group

variable {G : Type _} [Group G] {α : Type _} [Mul α] (J : Subgroup G) (g : G)

namespace Doset

open Pointwise

/-- The double coset as an element of `Set α` corresponding to `s a t` -/
def doset (a : α) (s t : Set α) : Set α :=
  s * {a} * t
#align doset Doset.doset

theorem mem_doset {s t : Set α} {a b : α} : b ∈ doset a s t ↔ ∃ x ∈ s, ∃ y ∈ t, b = x * a * y :=
  ⟨fun ⟨_, y, ⟨x, _, hx, rfl, rfl⟩, hy, h⟩ => ⟨x, hx, y, hy, h.symm⟩, fun ⟨x, hx, y, hy, h⟩ =>
    ⟨x * a, y, ⟨x, a, hx, rfl, rfl⟩, hy, h.symm⟩⟩
#align doset.mem_doset Doset.mem_doset

theorem mem_doset_self (H K : Subgroup G) (a : G) : a ∈ doset a H K :=
  mem_doset.mpr ⟨1, H.one_mem, 1, K.one_mem, (one_mul a).symm.trans (mul_one (1 * a)).symm⟩
#align doset.mem_doset_self Doset.mem_doset_self

theorem doset_eq_of_mem {H K : Subgroup G} {a b : G} (hb : b ∈ doset a H K) :
    doset b H K = doset a H K := by
  obtain ⟨_, k, ⟨h, a, hh, rfl : _ = _, rfl⟩, hk, rfl⟩ := hb
  rw [doset, doset, ← Set.singleton_mul_singleton, ← Set.singleton_mul_singleton, mul_assoc,
    mul_assoc, Subgroup.singleton_mul_subgroup hk, ← mul_assoc, ← mul_assoc,
    Subgroup.subgroup_mul_singleton hh]
#align doset.doset_eq_of_mem Doset.doset_eq_of_mem

theorem mem_doset_of_not_disjoint {H K : Subgroup G} {a b : G}
    (h : ¬Disjoint (doset a H K) (doset b H K)) : b ∈ doset a H K := by
  rw [Set.not_disjoint_iff] at h
  simp only [mem_doset] at *
  obtain ⟨x, ⟨l, hl, r, hr, hrx⟩, y, hy, ⟨r', hr', rfl⟩⟩ := h
  refine' ⟨y⁻¹ * l, H.mul_mem (H.inv_mem hy) hl, r * r'⁻¹, K.mul_mem hr (K.inv_mem hr'), _⟩
  rwa [mul_assoc, mul_assoc, eq_inv_mul_iff_mul_eq, ← mul_assoc, ← mul_assoc, eq_mul_inv_iff_mul_eq]
#align doset.mem_doset_of_not_disjoint Doset.mem_doset_of_not_disjoint

theorem eq_of_not_disjoint {H K : Subgroup G} {a b : G}
    (h : ¬Disjoint (doset a H K) (doset b H K)) : doset a H K = doset b H K := by
  rw [disjoint_comm] at h
  have ha : a ∈ doset b H K := mem_doset_of_not_disjoint h
  apply doset_eq_of_mem ha
#align doset.eq_of_not_disjoint Doset.eq_of_not_disjoint

/-- The setoid defined by the double_coset relation -/
def setoid (H K : Set G) : Setoid G :=
  Setoid.ker fun x => doset x H K
#align doset.setoid Doset.setoid

/-- Quotient of `G` by the double coset relation, i.e. `H \ G / K` -/
def Quotient (H K : Set G) : Type _ :=
  _root_.Quotient (setoid H K)
#align doset.quotient Doset.Quotient

theorem rel_iff {H K : Subgroup G} {x y : G} :
    (setoid ↑H ↑K).Rel x y ↔ ∃ a ∈ H, ∃ b ∈ K, y = a * x * b :=
  Iff.trans
    ⟨fun hxy => (congr_arg _ hxy).mpr (mem_doset_self H K y), fun hxy => (doset_eq_of_mem hxy).symm⟩
    mem_doset
#align doset.rel_iff Doset.rel_iff

theorem bot_rel_eq_leftRel (H : Subgroup G) :
    (setoid ↑(⊥ : Subgroup G) ↑H).Rel = (QuotientGroup.leftRel H).Rel := by
  ext (a b)
  rw [rel_iff, Setoid.Rel, QuotientGroup.leftRel_apply]
  constructor
  · rintro ⟨a, rfl : a = 1, b, hb, rfl⟩
    change a⁻¹ * (1 * a * b) ∈ H
    rwa [one_mul, inv_mul_cancel_left]
  · rintro (h : a⁻¹ * b ∈ H)
    exact ⟨1, rfl, a⁻¹ * b, h, by rw [one_mul, mul_inv_cancel_left]⟩
#align doset.bot_rel_eq_left_rel Doset.bot_rel_eq_leftRel

theorem rel_bot_eq_right_group_rel (H : Subgroup G) :
    (setoid ↑H ↑(⊥ : Subgroup G)).Rel = (QuotientGroup.rightRel H).Rel := by
  ext (a b)
  rw [rel_iff, Setoid.Rel, QuotientGroup.rightRel_apply]
  constructor
  · rintro ⟨b, hb, a, rfl : a = 1, rfl⟩
    change b * a * 1 * a⁻¹ ∈ H
    rwa [mul_one, mul_inv_cancel_right]
  · rintro (h : b * a⁻¹ ∈ H)
    exact ⟨b * a⁻¹, h, 1, rfl, by rw [mul_one, inv_mul_cancel_right]⟩
#align doset.rel_bot_eq_right_group_rel Doset.rel_bot_eq_right_group_rel

/-- Create a doset out of an element of `H \ G / K`-/
def quotToDoset (H K : Subgroup G) (q : Quotient (H : Set G) K) : Set G :=
  doset q.out' H K
#align doset.quot_to_doset Doset.quotToDoset

/-- Map from `G` to `H \ G / K`-/
abbrev mk (H K : Subgroup G) (a : G) : Quotient (H : Set G) K :=
  Quotient.mk'' a
#align doset.mk Doset.mk

instance (H K : Subgroup G) : Inhabited (Quotient (H : Set G) K) :=
  ⟨mk H K (1 : G)⟩

theorem eq (H K : Subgroup G) (a b : G) : mk H K a = mk H K b ↔ ∃ h ∈ H, ∃ k ∈ K, b = h * a * k :=
  by
  rw [Quotient.eq'']
  apply rel_iff
#align doset.eq Doset.eq

theorem out_eq' (H K : Subgroup G) (q : Quotient ↑H ↑K) : mk H K q.out' = q :=
  Quotient.out_eq' q
#align doset.out_eq' Doset.out_eq'

theorem mk_out'_eq_mul (H K : Subgroup G) (g : G) :
    ∃ h k : G, h ∈ H ∧ k ∈ K ∧ (mk H K g : Quotient ↑H ↑K).out' = h * g * k := by
  have := eq H K (mk H K g : Quotient ↑H ↑K).out' g
  rw [out_eq'] at this
  obtain ⟨h, h_h, k, hk, T⟩ := this.1 rfl
  refine' ⟨h⁻¹, k⁻¹, H.inv_mem h_h, K.inv_mem hk, eq_mul_inv_of_mul_eq (eq_inv_mul_of_mul_eq _)⟩
  rw [← mul_assoc, ← T]
#align doset.mk_out'_eq_mul Doset.mk_out'_eq_mul

theorem mk_eq_of_doset_eq {H K : Subgroup G} {a b : G} (h : doset a H K = doset b H K) :
    mk H K a = mk H K b := by
  rw [eq]
  exact mem_doset.mp (h.symm ▸ mem_doset_self H K b)
#align doset.mk_eq_of_doset_eq Doset.mk_eq_of_doset_eq

theorem disjoint_out' {H K : Subgroup G} {a b : Quotient H.1 K} :
    a ≠ b → Disjoint (doset a.out' H K) (doset b.out' (H : Set G) K) := by
  contrapose!
  intro h
  simpa [out_eq'] using mk_eq_of_doset_eq (eq_of_not_disjoint h)
#align doset.disjoint_out' Doset.disjoint_out'

theorem union_quotToDoset (H K : Subgroup G) : (⋃ q, quotToDoset H K q) = Set.univ := by
  ext x
  simp only [Set.mem_unionᵢ, quotToDoset, mem_doset, SetLike.mem_coe, exists_prop, Set.mem_univ,
    iff_true_iff]
  use mk H K x
  obtain ⟨h, k, h3, h4, h5⟩ := mk_out'_eq_mul H K x
  refine' ⟨h⁻¹, H.inv_mem h3, k⁻¹, K.inv_mem h4, _⟩
  simp only [h5, Subgroup.coe_mk, ← mul_assoc, one_mul, mul_left_inv, mul_inv_cancel_right]
#align doset.union_quot_to_doset Doset.union_quotToDoset

theorem doset_union_rightCoset (H K : Subgroup G) (a : G) :
    (⋃ k : K, rightCoset (↑H) (a * k)) = doset a H K := by
  ext x
  simp only [mem_rightCoset_iff, exists_prop, mul_inv_rev, Set.mem_unionᵢ, mem_doset,
    Subgroup.mem_carrier, SetLike.mem_coe]
  constructor
  · rintro ⟨y, h_h⟩
    refine' ⟨x * (y⁻¹ * a⁻¹), h_h, y, y.2, _⟩
    simp only [← mul_assoc, Subgroup.coe_mk, inv_mul_cancel_right, SubgroupClass.coe_inv]
  · rintro ⟨x, hx, y, hy, hxy⟩
    refine' ⟨⟨y, hy⟩, _⟩
    simp only [hxy, ← mul_assoc, hx, mul_inv_cancel_right, Subgroup.coe_mk]
#align doset.doset_union_right_coset Doset.doset_union_rightCoset

theorem doset_union_leftCoset (H K : Subgroup G) (a : G) :
    (⋃ h : H, leftCoset (h * a : G) K) = doset a H K := by
  ext x
  simp only [mem_leftCoset_iff, mul_inv_rev, Set.mem_unionᵢ, mem_doset]
  constructor
  · rintro ⟨y, h_h⟩
    refine' ⟨y, y.2, a⁻¹ * y⁻¹ * x, h_h, _⟩
    simp only [← mul_assoc, one_mul, mul_right_inv, mul_inv_cancel_right, SubgroupClass.coe_inv]
  · rintro ⟨x, hx, y, hy, hxy⟩
    refine' ⟨⟨x, hx⟩, _⟩
    simp only [hxy, ← mul_assoc, hy, one_mul, mul_left_inv, Subgroup.coe_mk, inv_mul_cancel_right]
#align doset.doset_union_left_coset Doset.doset_union_leftCoset

theorem right_bot_eq_right_quot (H : Subgroup G) :
    Quotient (H.1 : Set G) (⊥ : Subgroup G) = _root_.Quotient (QuotientGroup.rightRel H) := by
  unfold Quotient
  congr
  ext
  simp_rw [← rel_bot_eq_right_group_rel H]
  rfl
#align doset.right_bot_eq_right_quot Doset.right_bot_eq_right_quot

end Doset


import data.complex.basic
import linear_algebra.basic
import linear_algebra.determinant
import analysis.complex.polynomial
import data.polynomial
import linear_algebra.tools_for_carac_poly
open finset
universes u v w w'
variables
          {R : Type u}[nonzero_comm_ring R]
          {A : Type v} [fintype A][decidable_eq A]
          (M : matrix A A R)
          (N : matrix A A (polynomial R))
open polynomial open matrix
open with_bot tools
open_locale big_operators

/-
  unfold car_matrix, split_ifs, rw eval_add, rw eval_C, rw eval_X, rw h, rw add_val, rw smul_val, rw one_val, rw mul_ite,
     rw mul_one, rw mul_zero,simp, rw eval_C,rw add_val, rw smul_val, rw one_val, rw mul_ite,split_ifs, rw mul_zero,rw add_zero,
-/

lemma eval_ite (r : R) (P Q : polynomial R) (φ : Prop) [decidable φ]:
    eval r  (if  φ  then P  else Q)  = if φ then eval r P else eval r Q :=
    by split_ifs; exact rfl

#check if_congr
#check if_true

noncomputable def car_matrix :
      matrix A A (polynomial R) := λ x y, if x=y then  C (M x y) + X else C (M x y)

namespace car_matrix
lemma eval (r : R) (i j : A): eval r (car_matrix M i j) = (M + r • 1) i j :=
begin
    unfold car_matrix,  rw eval_ite, rw eval_add, rw eval_C, rw eval_X,
    rw add_val, rw smul_val, rw one_val, rw mul_ite, rw mul_one, rw mul_zero,
    rw add_ite, rw add_zero,
end

noncomputable def car_pol : polynomial R :=  det (car_matrix M)

lemma degree_coeff (x  : A) : degree(car_matrix M x x) = 1  :=
begin
    unfold car_matrix, split_ifs,  let g := @degree_C_le R  (M x x) _,
    rw degree_add_eq_of_degree_lt,
    exact degree_X, rw degree_X,refine (lt_iff_not_ge (degree (C (M x x))) 1).mpr _, intro,
     let tr := le_trans a g,  let g := zero_le_one,
        have : 0 = 1,
            apply le_antisymm,
            exact g, exact (with_bot.coe_le rfl).mp tr, trivial, trivial,
end

lemma degree_coeff_ne {x y : A} (hyp : x ≠ y) : degree(car_matrix M x y) ≤ 0 := begin
    unfold car_matrix, split_ifs, trivial, exact degree_C_le,
end
lemma degree_coef_lt_one {x y : A} (hyp : x ≠ y) : degree(car_matrix M x y) < 1 :=
begin
    let g := degree_coeff_ne M hyp,
    refine lt_of_le_of_lt g _,apply  coe_lt_coe.mpr,
    exact zero_lt_one,
end
lemma  zero_le_one :  (0 : with_bot ℕ )  ≤ 1 :=
        begin     apply coe_le_coe.mpr,
            exact zero_le_one,
end
lemma degree_le_one (x y : A) : degree(car_matrix M x y) ≤ 1 :=
begin
    by_cases x = y,
        {let g := degree_coeff M x, rw ← h, rw g, exact le_refl 1},
        {let g := degree_coeff_ne M h,exact le_trans g (zero_le_one)},
end

/--

-/
lemma leading_coef (x : A) :  leading_coeff (car_matrix M x x) = 1 :=
begin
        apply (monic.def).mp ,
        unfold car_matrix,
        split_ifs, rw add_comm, apply monic_X_add_C, trivial,
end
/--
      Technical lemma
-/

lemma car_monic (x : A) : monic (car_matrix M x x) := begin
    unfold monic, exact leading_coef M x,
end

end car_matrix

namespace car_pol
open car_matrix equiv.perm

/-!
    Now we reconstruct the coeffcient of det_car the
        ` Σ (σ ∈ perm A), sign σ  ×  ∏ (ℓ ∈ A) car_matrix M σ ℓ ℓ

-/

lemma eval_sum  (φ : A → polynomial R) (r : R)  : eval r (Σ   φ ) =  Σ (λ a : A,(eval r (φ a))) :=
begin
    rw finset.sum_hom finset.univ (polynomial.eval r),
end

lemma eval_prod (φ : A → polynomial R) (r : R) : eval r (finset.prod finset.univ φ) =
finset.prod finset.univ (λ a : A,(eval r (φ a))) :=
begin
    rw finset.prod_hom finset.univ (polynomial.eval r),
end

lemma   test (a : ℤ )(r : R) : eval r (a : polynomial R) = (a : R) :=
begin
    rw int_cast_eq_C, rw eval_C,
end

theorem eval_car_poly ( r : R) : eval r (car_pol M) = det (M+ r • 1) := begin
    unfold det, unfold car_pol, unfold det,
    erw eval_sum, congr, ext σ ,
    rw eval_mul,
    rw eval_prod,
    rw int_cast_eq_C, rw eval_C, congr, ext,
    rw car_matrix.eval,
end
lemma perm_mul (σ : equiv.perm A) (P : polynomial R) : degree ((sign σ : polynomial R) * P) = degree P := begin
    rcases int.units_eq_one_or (sign σ), congr,
     rw h, erw int.cast_one, rw one_mul,
     rw h,
     erw int.cast_neg, erw int.cast_one,
     norm_cast,simp,
end

lemma equiv_not_id (σ  : equiv.perm A) (hyp : σ ≠ 1) : ∃ x : A, σ x ≠ x := begin
    refine not_forall.mp _,
        intro, have : σ =1,
            ext, exact a x, trivial,
end

lemma exists_le_one (σ  : equiv.perm A) (hyp : σ ≠ 1) : ∃ ℓ0 : A,  degree( car_matrix M (σ ℓ0 ) ℓ0 ) < 1:= begin
    rcases (equiv_not_id σ hyp) with ⟨ℓ0,hyp_l ⟩,
    use ℓ0,
    let r := degree_coeff_ne M  hyp_l,
    refine lt_of_le_of_lt r _,
    apply  coe_lt_coe.mpr,
    exact zero_lt_one,
end

noncomputable def term_wihout  (σ : equiv.perm A) :=
     finset.prod univ (λ (x : A), car_matrix M (σ x) x)

noncomputable def term  (σ : equiv.perm A) :=
    ((equiv.perm.sign σ) : polynomial R ) * finset.prod univ (λ (x : A), car_matrix M (σ x) x)

lemma degree_term_eq_degree_term_without  (σ : equiv.perm A ) : degree (term M σ ) = degree (term_wihout M σ ) :=  perm_mul _ _

lemma degree_term_wihout (σ : equiv.perm A) : if σ = 1 then  degree (term_wihout M σ) = fintype.card A else  degree (term_wihout M σ) < fintype.card A
:= begin
    split_ifs, rw h, {
            unfold term_wihout,
            exact prod_monic_one (finset.univ) (λ ℓ, car_matrix M  ℓ ℓ )(degree_coeff M ) (car_monic M),
        },
        {
            unfold term_wihout,
            apply degree_prod_le_one_lt_card((λ ℓ, car_matrix M  (σ ℓ) ℓ )),
            intros ℓ, refine degree_le_one M _ _,
            rcases equiv_not_id (σ ) h with ⟨ℓ0 ,hyp_l0 ⟩ ,
            use ℓ0,
            exact degree_coef_lt_one M hyp_l0,
        },
end
lemma degree_term (σ : equiv.perm A) :
if σ = 1 then  degree (term M σ) = fintype.card A else  degree (term M σ) < fintype.card A :=
begin
    rw degree_term_eq_degree_term_without, exact degree_term_wihout M σ,
end
lemma degree_term_id :  degree (term M (1 : equiv.perm A)) = fintype.card A :=
begin
    let g := degree_term M (1 : equiv.perm A),
    split_ifs at g, exact g, trivial,

end
lemma degree_term_ne (σ : equiv.perm A) (hyp : 1 ≠ σ ) : degree (term M σ) < fintype.card A :=
begin
    let g :=  degree_term M σ ,
    split_ifs at g, rw h at hyp,trivial, exact g,
end
lemma degree_car : degree (car_pol M) = fintype.card A :=
begin
    unfold car_pol, unfold det,
    rw ← degree_term_id M,
    apply  proof_strategy.car_pol_degree(term M),
    rw degree_term_id M,
    exact degree_term_ne M,
    rw degree_term_id, exact bot_lt_some _,
end

theorem eigen_values_exist_mat (hyp : 0 < fintype.card A  ):  ∀ M : matrix A A ℂ ,  ∃ t : ℂ, det ( M + t •(1 : matrix A A ℂ )) = 0
:= begin
    intros M,
    let χ := car_pol M,
    let FTOA := @complex.exists_root χ,
    have : 0 < degree χ,
        erw  degree_car, apply coe_lt_coe.mpr,exact hyp,
    specialize FTOA this,
    rcases FTOA with ⟨ ζ,hyp⟩ ,
    use ζ,
    rw ←  eval_car_poly M ζ ,
    exact hyp,
end
end car_pol


import set_theory.cardinal_ordinal

inductive buchholz_on : Type
| leaf -- 0
| add (v : ℕ) (b₁ b₂ : buchholz_on) -- Ψᵥ(b₁) + b₂

namespace buchholz_on

instance : has_zero buchholz_on := ⟨leaf⟩

def psi (v : ℕ) (α : buchholz_on) := add v α 0

instance : has_one buchholz_on := ⟨psi 0 0⟩

def lt' : buchholz_on → buchholz_on → Prop
| 0 α                        := α ≠ 0
| _ 0                        := ff
| (add v α β) (add v' α' β') := v < v' ∨ (v = v' ∧ (lt' α α' ∨ (α = α' ∧ lt' β β')))

instance : has_lt buchholz_on := ⟨lt'⟩

instance : has_le buchholz_on := ⟨λ a b, a < b ∨ a = b⟩

def built_from_below (v : ℕ) (α : buchholz_on) : buchholz_on → Prop
| 0             := tt
| (add v' α' β) := built_from_below β ∧ (v' < v ∨ (built_from_below α' ∧ α' < α))

def normal_form : buchholz_on → Prop
| 0                     := tt
| (add v α 0)           := normal_form α ∧ built_from_below v α α
| (add v α (add u β γ)) := normal_form α ∧ built_from_below v α α ∧ normal_form (add u β γ) ∧ β ≤ α

end buchholz_on

universes u v

namespace ordinal

/-- An initial segment of the ordinals. -/
def init_segment (α : ordinal.{u}) : set ordinal.{u} := λ x, x < α

/-- The Ωᵥ function as defined by Buchholz. -/
noncomputable def Omega : ℕ → ordinal.{u}
| 0 := 1
| v := (cardinal.aleph v).ord

/-- Ωᵥ is positive. -/
theorem Omega_pos {v : ℕ} : 0 < Omega v :=
begin
  induction v,
  { exact zero_lt_one },
  apply lt_of_lt_of_le omega_pos,
  rw ←cardinal.ord_omega,
  exact cardinal.ord_le_ord.mpr (cardinal.omega_le_aleph _),
end

/-- Ωᵥ < ℵ_ω. -/
theorem Omega_lt_aleph_omega {v : ℕ} : Omega v < (cardinal.aleph omega).ord :=
begin
  induction v with v hv,
  { apply lt_of_lt_of_le one_lt_omega,
    rw [←cardinal.ord_omega, ←cardinal.aleph_zero, cardinal.ord_le_ord, cardinal.aleph_le],
    exact ordinal.zero_le _ },
  show (cardinal.aleph v.succ).ord < (cardinal.aleph omega).ord,
  rw [cardinal.ord_lt_ord, cardinal.aleph_lt],
  exact nat_lt_omega _
end

/-- Ordinals less than ℵₙ. -/
def lt_aleph (n : ℕ) : set ordinal.{u} := (cardinal.aleph.{u} n).ord.init_segment

/-- Ordinals less than ℵ_ω. -/
def lt_aleph_omega : set ordinal.{u} := (cardinal.aleph omega.{u}).ord.init_segment

/-- ℵₙ < ℵ_ω. -/
lemma aleph_n_lt_aleph_omega {n : ℕ} :
  (cardinal.aleph.{u} n).ord < (cardinal.aleph.{u} omega.{u}).ord :=
by { rw [cardinal.ord_lt_ord, cardinal.aleph_lt], exact nat_lt_omega _ }

instance (n : ℕ) : has_lift (lt_aleph n) lt_aleph_omega :=
⟨λ α, ⟨α.val, have _ < _, from α.prop, lt_trans this aleph_n_lt_aleph_omega⟩⟩

/-- ω ^ ℵₙ = ℵₙ. -/
theorem omega_pow_aleph_eq_self (α : ordinal.{u}) :
  (cardinal.aleph.{u} α).ord = omega.{u} ^ (cardinal.aleph.{u} α).ord :=
sorry

/-- Minimum excluded ordinal of a family of ordinals. -/
noncomputable def mex (S : set ordinal.{u}) {α : ordinal} (hα : α ∉ S) : ordinal.{u} :=
omin (λ α, α ∉ S) ⟨α, hα⟩

/-- The minimum excluded ordinal is excluded. -/
theorem not_mex_mem (S : set ordinal.{u}) {α : ordinal} (hα : α ∉ S) : mex S hα ∉ S :=
omin_mem (λ α, α ∉ S) _

/-- The minimum excluded ordinal is less or equal to any excluded ordinal. -/
theorem mex_le_not_mem (S : set ordinal.{u}) {α : ordinal} (hα : α ∉ S) : mex S hα ≤ α :=
by { apply omin_le, exact hα }

/-- Any ordinal less than the minimum excluded one is included. -/
theorem mem_of_lt_mex (S : set ordinal.{u}) {α β : ordinal} (hα : α ∉ S) (hβ : β < mex S hα) :
  β ∈ S :=
by { by_contra hβ', exact not_le_of_gt hβ (omin_le hβ') }

theorem mex_lt_of_card (S : set ordinal.{u}) {α : ordinal} (hα : α ∉ S) :
  lift.{u + 1} (mex S hα) < (cardinal.mk S).succ.ord :=
sorry

end ordinal

/-- A Ψ-family is an ordered sequence of functions, the v-th of which maps the ordinals less than
α to ℵ_(v+1). Buchholz Ψ functions form a Ψ-family. -/
def psi_family (α : ordinal.{u}) : Type (u + 1) :=
α.init_segment → Π v : ℕ, ordinal.lt_aleph.{u} (v + 1)

/-- `C v α Ψ` consists of all the ordinals that may be built from
* ordinals up to `Ωᵥ`,
* additions,
* application of the `Ψ` functions on inputs less than `α`.
-/
inductive C (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) : set ordinal.{u}
| low {β : ordinal.{u}} (hβ : β < ordinal.Omega.{u} v) : C β
| add {β γ : ordinal.{u}} (hβ : C β) (hγ : C γ) : C (β + γ)
| psi (v : ℕ) {β : α.init_segment} (hβ : C β.val) : C (Ψ β v).val

/-- `0` always belongs to `C v α Ψ`. -/
theorem zero_mem_C (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) : C v α Ψ 0 :=
C.low ordinal.Omega_pos

/-- The sets `C` are bounded above by `ℵ_ω`. -/
theorem lt_aleph_omega_of_mem_C (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) {β : ordinal.{u}} :
  C v α Ψ β → β < (cardinal.aleph ordinal.omega).ord :=
begin
  intro h,
  induction h with β hβ β γ hβ hγ hβ' hγ' v β,
  { exact lt_trans hβ ordinal.Omega_lt_aleph_omega },
  { rw ordinal.omega_pow_aleph_eq_self ordinal.omega at *,
    exact ordinal.add_lt_omega_power hβ' hγ' },
  { exact lt_trans (Ψ β v).prop ordinal.aleph_n_lt_aleph_omega }
end

/-- `ℵ_ω` does not belong to any set `C`. -/
theorem aleph_nmem_C (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) :
  ¬ C v α Ψ (cardinal.aleph ordinal.omega).ord :=
λ h, (lt_irrefl _) (lt_aleph_omega_of_mem_C v α Ψ h)

theorem C_card (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) :
  cardinal.mk (C v α Ψ) = cardinal.aleph.{u + 1} v :=
sorry

/-- Minimum excluded ordinal of `C v α Ψ`. -/
noncomputable def C_mex' (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) : ordinal.{u} :=
ordinal.mex (C v α Ψ) (aleph_nmem_C v α Ψ)

theorem cardinal.aleph_lift (α : ordinal.{u}) :
  cardinal.aleph (ordinal.lift.{max v u} α) = cardinal.lift.{max v u} (cardinal.aleph.{u} α) :=
begin
  sorry
end

theorem C_mex_lt_aleph' (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) :
  ∃ β : ordinal.lt_aleph.{u} (v + 1), ¬ C v α Ψ β.val :=
begin
  refine ⟨⟨C_mex' v α Ψ, _⟩, ordinal.not_mex_mem _ _⟩,
  show C_mex' v α Ψ < (cardinal.aleph (v + 1)).ord,
  rw ←ordinal.lift_lt,
  suffices : (cardinal.aleph v).succ.ord = ordinal.lift (cardinal.aleph (v + 1)).ord,
  { rw ←this,
    have := ordinal.mex_lt_of_card (C v α Ψ) (aleph_nmem_C v α Ψ),
    rwa C_card v α Ψ at this },
  have : cardinal.aleph (v + 1) = (cardinal.aleph v).succ := cardinal.aleph_succ,
  rw [←this, cardinal.lift_ord, ←(cardinal.aleph_lift.{u (u + 1)} (↑v + 1))],
  simp,
end

theorem C_mex_lt_aleph (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) :
  C_mex' v α Ψ < (cardinal.aleph (v + 1)).ord :=
begin
  --apply lt_of_le_of_lt (ordinal.mex_le_not_mem),
 -- have := ordinal.mex (C v α Ψ) (@classical.some_spec _ (λ β, ¬ C v α Ψ β ) (C_mex_lt_aleph' v α Ψ)),
 -- cases C_mex_lt_aleph' v α Ψ with β hβ,
 sorry
end

/-- Minimum excluded ordinal of `C v α Ψ`. -/
noncomputable def C_mex (v : ℕ) (α : ordinal.{u}) (Ψ : psi_family α) : ordinal.lt_aleph.{u} (v + 1) :=
sorry
--⟨C_mex' v α Ψ, C_mex_lt_aleph v α Ψ⟩

noncomputable def buchholz_psi' : ordinal.{u} → Π v, ordinal.lt_aleph (v + 1) :=
well_founded.fix ordinal.wf (λ α Ψ v, C_mex v α (λ ⟨β, hβ⟩, Ψ β hβ))

/-- The Buchholz `Ψ` function. -/
noncomputable def buchholz_psi (v : ℕ) (α : ordinal.{u}) : ordinal.{u} := buchholz_psi' α v


theorem ex : Not (1 = 2) :=
ofDecideEqFalse rfl


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

import ring_theory.polynomial.cyclotomic.basic

/-!
# Not all coefficients of cyclotomic polynomials are -1, 0, or 1

We show that not all coefficients of cyclotomic polynomials are equal to `0`, `-1` or `1`, in the
theorem `not_forall_coeff_cyclotomic_neg_one_zero_one`. We prove this with the counterexample
`coeff_cyclotomic_105 : coeff (cyclotomic 105 ℤ) 7 = -2`.
-/

section computation

lemma prime_3 : nat.prime 3 := by norm_num

lemma prime_5 : nat.prime 5 := by norm_num

lemma prime_7 : nat.prime 7 := by norm_num

lemma proper_divisors_15 : nat.proper_divisors 15 = {1, 3, 5} := rfl

lemma proper_divisors_21 : nat.proper_divisors 21 = {1, 3, 7} := rfl

lemma proper_divisors_35 : nat.proper_divisors 35 = {1, 5, 7} := rfl

lemma proper_divisors_105 : nat.proper_divisors 105 = {1, 3, 5, 7, 15, 21, 35} := rfl

end computation

open polynomial

lemma cyclotomic_3 : cyclotomic 3 ℤ = 1 + X + X ^ 2 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 3, by norm_num) _).2 _).symm,
  rw nat.prime.proper_divisors prime_3,
  simp only [finset.prod_singleton, cyclotomic_one],
  ring
end

lemma cyclotomic_5 : cyclotomic 5 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 :=
begin
  refine ((eq_cyclotomic_iff (nat.prime.pos prime_5) _).2 _).symm,
  rw nat.prime.proper_divisors prime_5,
  simp only [finset.prod_singleton, cyclotomic_one],
  ring
end

lemma cyclotomic_7 : cyclotomic 7 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 + X ^ 5 + X ^ 6 :=
begin
  refine ((eq_cyclotomic_iff (nat.prime.pos prime_7) _).2 _).symm,
  rw nat.prime.proper_divisors prime_7,
  simp only [finset.prod_singleton, cyclotomic_one],
  ring
end

lemma cyclotomic_15 : cyclotomic 15 ℤ = 1 - X + X ^ 3 - X ^ 4 + X ^ 5 - X ^ 7 + X ^ 8 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 15, by norm_num) _).2 _).symm,
  rw [proper_divisors_15, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_3, cyclotomic_5],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_21 : cyclotomic 21 ℤ =
  1 - X + X ^ 3 - X ^ 4 + X ^ 6 - X ^ 8 + X ^ 9 - X ^ 11 + X ^ 12 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 21, by norm_num) _).2 _).symm,
  rw [proper_divisors_21, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_3, cyclotomic_7],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_35 : cyclotomic 35 ℤ =
  1 - X + X ^ 5 - X ^ 6 + X ^ 7 - X ^ 8 + X ^ 10 - X ^ 11 + X ^ 12 - X ^ 13 + X ^ 14 - X ^ 16 +
  X ^ 17 - X ^ 18 + X ^ 19 - X ^ 23 + X ^ 24 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 35, by norm_num) _).2 _).symm,
  rw [proper_divisors_35, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton,
    cyclotomic_one, cyclotomic_5, cyclotomic_7],
  ring,
  repeat { norm_num }
end

lemma cyclotomic_105 : cyclotomic 105 ℤ =
  1 + X + X ^ 2 - X ^ 5 - X ^ 6 - 2 * X ^ 7 - X ^ 8 - X ^ 9 + X ^ 12 + X ^ 13 + X ^ 14 + X ^ 15
  + X ^ 16 + X ^ 17 - X ^ 20 - X ^ 22 - X ^ 24 - X ^ 26 - X ^ 28 + X ^ 31 + X ^ 32 + X ^ 33 +
  X ^ 34 + X ^ 35 + X ^ 36 - X ^ 39 - X ^ 40 - 2 * X ^ 41 - X ^ 42 - X ^ 43 + X ^ 46 + X ^ 47 +
  X ^ 48 :=
begin
  refine ((eq_cyclotomic_iff (show 0 < 105, by norm_num) _).2 _).symm,
  rw proper_divisors_105,
  repeat {rw finset.prod_insert _},
  rw [finset.prod_singleton, cyclotomic_one, cyclotomic_3, cyclotomic_5, cyclotomic_7,
    cyclotomic_15, cyclotomic_21, cyclotomic_35],
  ring,
  repeat { norm_num }
end

lemma coeff_cyclotomic_105 : coeff (cyclotomic 105 ℤ) 7 = -2 :=
begin
  simp [cyclotomic_105, coeff_X_pow, coeff_one, coeff_X_of_ne_one, coeff_bit0_mul, coeff_bit1_mul]
end

lemma not_forall_coeff_cyclotomic_neg_one_zero_one :
  ¬∀ n i, coeff (cyclotomic n ℤ) i ∈ ({-1, 0, 1} : set ℤ) :=
begin
  intro h,
  replace h := h 105 7,
  rw coeff_cyclotomic_105 at h,
  norm_num at h
end


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import data.nat.cast.basic
import algebra.order.ring.defs
import algebra.order.ring.inj_surj
import algebra.group_power.order
import order.complete_lattice_intervals
import order.lattice_intervals

/-!
# The type of nonnegative elements

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

This file defines instances and prove some properties about the nonnegative elements
`{x : α // 0 ≤ x}` of an arbitrary type `α`.

Currently we only state instances and states some `simp`/`norm_cast` lemmas.

When `α` is `ℝ`, this will give us some properties about `ℝ≥0`.

## Main declarations

* `{x : α // 0 ≤ x}` is a `canonically_linear_ordered_add_monoid` if `α` is a `linear_ordered_ring`.

## Implementation Notes

Instead of `{x : α // 0 ≤ x}` we could also use `set.Ici (0 : α)`, which is definitionally equal.
However, using the explicit subtype has a big advantage: when writing and element explicitly
with a proof of nonnegativity as `⟨x, hx⟩`, the `hx` is expected to have type `0 ≤ x`. If we would
use `Ici 0`, then the type is expected to be `x ∈ Ici 0`. Although these types are definitionally
equal, this often confuses the elaborator. Similar problems arise when doing cases on an element.

The disadvantage is that we have to duplicate some instances about `set.Ici` to this subtype.
-/

open set

variables {α : Type*}

namespace nonneg

/-- This instance uses data fields from `subtype.partial_order` to help type-class inference.
The `set.Ici` data fields are definitionally equal, but that requires unfolding semireducible
definitions, so type-class inference won't see this. -/
instance order_bot [preorder α] {a : α} : order_bot {x : α // a ≤ x} :=
{ ..set.Ici.order_bot }

lemma bot_eq [preorder α] {a : α} : (⊥ : {x : α // a ≤ x}) = ⟨a, le_rfl⟩ := rfl

instance no_max_order [partial_order α] [no_max_order α] {a : α} : no_max_order {x : α // a ≤ x} :=
set.Ici.no_max_order

instance semilattice_sup [semilattice_sup α] {a : α} : semilattice_sup {x : α // a ≤ x} :=
set.Ici.semilattice_sup

instance semilattice_inf [semilattice_inf α] {a : α} : semilattice_inf {x : α // a ≤ x} :=
set.Ici.semilattice_inf

instance distrib_lattice [distrib_lattice α] {a : α} : distrib_lattice {x : α // a ≤ x} :=
set.Ici.distrib_lattice

instance densely_ordered [preorder α] [densely_ordered α] {a : α} :
  densely_ordered {x : α // a ≤ x} :=
show densely_ordered (Ici a), from set.densely_ordered

/-- If `Sup ∅ ≤ a` then `{x : α // a ≤ x}` is a `conditionally_complete_linear_order`. -/
@[reducible]
protected noncomputable def conditionally_complete_linear_order
  [conditionally_complete_linear_order α] {a : α} :
  conditionally_complete_linear_order {x : α // a ≤ x} :=
{ .. @ord_connected_subset_conditionally_complete_linear_order α (set.Ici a) _ ⟨⟨a, le_rfl⟩⟩ _ }

/-- If `Sup ∅ ≤ a` then `{x : α // a ≤ x}` is a `conditionally_complete_linear_order_bot`.

This instance uses data fields from `subtype.linear_order` to help type-class inference.
The `set.Ici` data fields are definitionally equal, but that requires unfolding semireducible
definitions, so type-class inference won't see this. -/
@[reducible]
protected noncomputable def conditionally_complete_linear_order_bot
  [conditionally_complete_linear_order α] {a : α} (h : Sup ∅ ≤ a) :
  conditionally_complete_linear_order_bot {x : α // a ≤ x} :=
{ cSup_empty := (function.funext_iff.1
    (@subset_Sup_def α (set.Ici a) _ ⟨⟨a, le_rfl⟩⟩) ∅).trans $ subtype.eq $
      by { rw bot_eq, cases h.lt_or_eq with h2 h2, { simp [h2.not_le] }, simp [h2] },
  ..nonneg.order_bot,
  ..nonneg.conditionally_complete_linear_order }

instance inhabited [preorder α] {a : α} : inhabited {x : α // a ≤ x} :=
⟨⟨a, le_rfl⟩⟩

instance has_zero [has_zero α] [preorder α] : has_zero {x : α // 0 ≤ x} :=
⟨⟨0, le_rfl⟩⟩

@[simp, norm_cast]
protected lemma coe_zero [has_zero α] [preorder α] : ((0 : {x : α // 0 ≤ x}) : α) = 0 := rfl

@[simp] lemma mk_eq_zero [has_zero α] [preorder α] {x : α} (hx : 0 ≤ x) :
  (⟨x, hx⟩ : {x : α // 0 ≤ x}) = 0 ↔ x = 0 :=
subtype.ext_iff

instance has_add [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] :
  has_add {x : α // 0 ≤ x} :=
⟨λ x y, ⟨x + y, add_nonneg x.2 y.2⟩⟩

@[simp] lemma mk_add_mk [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] {x y : α}
  (hx : 0 ≤ x) (hy : 0 ≤ y) : (⟨x, hx⟩ : {x : α // 0 ≤ x}) + ⟨y, hy⟩ = ⟨x + y, add_nonneg hx hy⟩ :=
rfl

@[simp, norm_cast]
protected lemma coe_add [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)]
  (a b : {x : α // 0 ≤ x}) : ((a + b : {x : α // 0 ≤ x}) : α) = a + b := rfl

instance has_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] :
  has_smul ℕ {x : α // 0 ≤ x} :=
⟨λ n x, ⟨n • x, nsmul_nonneg x.prop n⟩⟩

@[simp] lemma nsmul_mk [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] (n : ℕ)
  {x : α} (hx : 0 ≤ x) : (n • ⟨x, hx⟩ : {x : α // 0 ≤ x}) = ⟨n • x, nsmul_nonneg hx n⟩ :=
rfl

@[simp, norm_cast]
protected lemma coe_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)]
  (n : ℕ) (a : {x : α // 0 ≤ x}) : ((n • a : {x : α // 0 ≤ x}) : α) = n • a := rfl

instance ordered_add_comm_monoid [ordered_add_comm_monoid α] :
  ordered_add_comm_monoid {x : α // 0 ≤ x} :=
subtype.coe_injective.ordered_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl)

instance linear_ordered_add_comm_monoid [linear_ordered_add_comm_monoid α] :
  linear_ordered_add_comm_monoid {x : α // 0 ≤ x} :=
subtype.coe_injective.linear_ordered_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl)
  (λ _ _, rfl)

instance ordered_cancel_add_comm_monoid [ordered_cancel_add_comm_monoid α] :
  ordered_cancel_add_comm_monoid {x : α // 0 ≤ x} :=
subtype.coe_injective.ordered_cancel_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl)

instance linear_ordered_cancel_add_comm_monoid [linear_ordered_cancel_add_comm_monoid α] :
  linear_ordered_cancel_add_comm_monoid {x : α // 0 ≤ x} :=
subtype.coe_injective.linear_ordered_cancel_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl)
  (λ _ _, rfl) (λ _ _, rfl)

/-- Coercion `{x : α // 0 ≤ x} → α` as a `add_monoid_hom`. -/
def coe_add_monoid_hom [ordered_add_comm_monoid α] : {x : α // 0 ≤ x} →+ α :=
⟨coe, nonneg.coe_zero, nonneg.coe_add⟩

@[norm_cast]
lemma nsmul_coe [ordered_add_comm_monoid α] (n : ℕ) (r : {x : α // 0 ≤ x}) :
  ↑(n • r) = n • (r : α) :=
nonneg.coe_add_monoid_hom.map_nsmul _ _

instance has_one [ordered_semiring α] : has_one {x : α // 0 ≤ x} :=
{ one := ⟨1, zero_le_one⟩ }

@[simp, norm_cast]
protected lemma coe_one [ordered_semiring α] : ((1 : {x : α // 0 ≤ x}) : α) = 1 := rfl

@[simp] lemma mk_eq_one [ordered_semiring α] {x : α} (hx : 0 ≤ x) :
  (⟨x, hx⟩ : {x : α // 0 ≤ x}) = 1 ↔ x = 1 :=
subtype.ext_iff

instance has_mul [ordered_semiring α] : has_mul {x : α // 0 ≤ x} :=
{ mul := λ x y, ⟨x * y, mul_nonneg x.2 y.2⟩ }

@[simp, norm_cast]
protected lemma coe_mul [ordered_semiring α] (a b : {x : α // 0 ≤ x}) :
  ((a * b : {x : α // 0 ≤ x}) : α) = a * b := rfl

@[simp] lemma mk_mul_mk [ordered_semiring α] {x y : α} (hx : 0 ≤ x) (hy : 0 ≤ y) :
  (⟨x, hx⟩ : {x : α // 0 ≤ x}) * ⟨y, hy⟩ = ⟨x * y, mul_nonneg hx hy⟩ :=
rfl

instance add_monoid_with_one [ordered_semiring α] : add_monoid_with_one {x : α // 0 ≤ x} :=
{ nat_cast := λ n, ⟨n, nat.cast_nonneg n⟩,
  nat_cast_zero := by simp [nat.cast],
  nat_cast_succ := λ _, by simp [nat.cast]; refl,
  .. nonneg.has_one, .. nonneg.ordered_add_comm_monoid }

@[simp, norm_cast]
protected lemma coe_nat_cast [ordered_semiring α] (n : ℕ) : ((↑n : {x : α // 0 ≤ x}) : α) = n := rfl

@[simp]

instance has_pow [ordered_semiring α] : has_pow {x : α // 0 ≤ x} ℕ :=
{ pow := λ x n, ⟨x ^ n, pow_nonneg x.2 n⟩ }

@[simp, norm_cast]
protected lemma coe_pow [ordered_semiring α] (a : {x : α // 0 ≤ x}) (n : ℕ) :
  (↑(a ^ n) : α) = a ^ n := rfl

@[simp] lemma mk_pow [ordered_semiring α] {x : α} (hx : 0 ≤ x) (n : ℕ) :
  (⟨x, hx⟩ : {x : α // 0 ≤ x}) ^ n = ⟨x ^ n, pow_nonneg hx n⟩ := rfl

instance ordered_semiring [ordered_semiring α] : ordered_semiring {x : α // 0 ≤ x} :=
subtype.coe_injective.ordered_semiring _
  rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

instance strict_ordered_semiring [strict_ordered_semiring α] :
  strict_ordered_semiring {x : α // 0 ≤ x} :=
subtype.coe_injective.strict_ordered_semiring _
  rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

instance ordered_comm_semiring [ordered_comm_semiring α] : ordered_comm_semiring {x : α // 0 ≤ x} :=
subtype.coe_injective.ordered_comm_semiring _
  rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

instance strict_ordered_comm_semiring [strict_ordered_comm_semiring α] :
  strict_ordered_comm_semiring {x : α // 0 ≤ x} :=
subtype.coe_injective.strict_ordered_comm_semiring _
  rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)

-- These prevent noncomputable instances being found, as it does not require `linear_order` which
-- is frequently non-computable.
instance monoid_with_zero [ordered_semiring α] : monoid_with_zero {x : α // 0 ≤ x} :=
by apply_instance

instance comm_monoid_with_zero [ordered_comm_semiring α] : comm_monoid_with_zero {x : α // 0 ≤ x} :=
by apply_instance

instance semiring [ordered_semiring α] : semiring {x : α // 0 ≤ x} := infer_instance
instance comm_semiring [ordered_comm_semiring α] : comm_semiring {x : α // 0 ≤ x} := infer_instance

instance nontrivial [linear_ordered_semiring α] : nontrivial {x : α // 0 ≤ x} :=
⟨ ⟨0, 1, λ h, zero_ne_one (congr_arg subtype.val h)⟩ ⟩

instance linear_ordered_semiring [linear_ordered_semiring α] :
  linear_ordered_semiring {x : α // 0 ≤ x} :=
subtype.coe_injective.linear_ordered_semiring _
  rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)(λ _ _, rfl) (λ _ _, rfl)

instance linear_ordered_comm_monoid_with_zero [linear_ordered_comm_ring α] :
  linear_ordered_comm_monoid_with_zero {x : α // 0 ≤ x} :=
{ mul_le_mul_left := λ a b h c, mul_le_mul_of_nonneg_left h c.2,
  ..nonneg.linear_ordered_semiring,
  ..nonneg.ordered_comm_semiring }

/-- Coercion `{x : α // 0 ≤ x} → α` as a `ring_hom`. -/
def coe_ring_hom [ordered_semiring α] : {x : α // 0 ≤ x} →+* α :=
⟨coe, nonneg.coe_one, nonneg.coe_mul, nonneg.coe_zero, nonneg.coe_add⟩

instance canonically_ordered_add_monoid [ordered_ring α] :
  canonically_ordered_add_monoid {x : α // 0 ≤ x} :=
{ le_self_add := λ a b, le_add_of_nonneg_right b.2,
  exists_add_of_le := λ a b h,
    ⟨⟨b - a, sub_nonneg_of_le h⟩, subtype.ext (add_sub_cancel'_right _ _).symm⟩,
  ..nonneg.ordered_add_comm_monoid,
  ..nonneg.order_bot }

instance canonically_ordered_comm_semiring [ordered_comm_ring α] [no_zero_divisors α] :
  canonically_ordered_comm_semiring {x : α // 0 ≤ x} :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := by { rintro ⟨a, ha⟩ ⟨b, hb⟩, simp },
  ..nonneg.canonically_ordered_add_monoid,
  ..nonneg.ordered_comm_semiring }

instance canonically_linear_ordered_add_monoid [linear_ordered_ring α] :
  canonically_linear_ordered_add_monoid {x : α // 0 ≤ x} :=
{ ..subtype.linear_order _, ..nonneg.canonically_ordered_add_monoid }

section linear_order

variables [has_zero α] [linear_order α]

/-- The function `a ↦ max a 0` of type `α → {x : α // 0 ≤ x}`. -/
def to_nonneg (a : α) : {x : α // 0 ≤ x} :=
⟨max a 0, le_max_right _ _⟩

@[simp]
lemma coe_to_nonneg {a : α} : (to_nonneg a : α) = max a 0 := rfl

@[simp]
lemma to_nonneg_of_nonneg {a : α} (h : 0 ≤ a) : to_nonneg a = ⟨a, h⟩ :=
by simp [to_nonneg, h]

@[simp]
lemma to_nonneg_coe {a : {x : α // 0 ≤ x}} : to_nonneg (a : α) = a :=
by { cases a with a ha, exact to_nonneg_of_nonneg ha }

@[simp]
lemma to_nonneg_le {a : α} {b : {x : α // 0 ≤ x}} : to_nonneg a ≤ b ↔ a ≤ b :=
by { cases b with b hb, simp [to_nonneg, hb] }

@[simp]
lemma to_nonneg_lt {a : {x : α // 0 ≤ x}} {b : α} : a < to_nonneg b ↔ ↑a < b :=
by { cases a with a ha, simp [to_nonneg, ha.not_lt] }

instance has_sub [has_sub α] : has_sub {x : α // 0 ≤ x} :=
⟨λ x y, to_nonneg (x - y)⟩

@[simp] lemma mk_sub_mk [has_sub α] {x y : α}
  (hx : 0 ≤ x) (hy : 0 ≤ y) : (⟨x, hx⟩ : {x : α // 0 ≤ x}) - ⟨y, hy⟩ = to_nonneg (x - y) :=
rfl

end linear_order

instance has_ordered_sub [linear_ordered_ring α] : has_ordered_sub {x : α // 0 ≤ x} :=
⟨by { rintro ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, simp only [sub_le_iff_le_add, subtype.mk_le_mk, mk_sub_mk,
  mk_add_mk, to_nonneg_le, subtype.coe_mk]}⟩

end nonneg


-- Section 8.1: pattern matching
namespace s81
open nat

def sub1 : ℕ → ℕ
| zero     := zero
| (succ x) := x

def is_zero : ℕ → Prop
| zero     := true
| (succ x) := false

example : sub1 0 = 0 := rfl
example (x : ℕ) : sub1 (succ x) = x := rfl

example : is_zero 0 = true := rfl
example (x : ℕ) : is_zero (succ x) = false := rfl

example : sub1 7 = 6 := rfl
example (x : ℕ) : ¬ is_zero (x + 3) := not_false

end s81
-- Section 8.2: wildcards/overlapping patterns
namespace s82
end s82
-- Section 8.3: structural recursion
namespace s83
end s83
-- Section 8.4: Well-founded recursion
namespace s84
end s84
-- Section 8.5: Mutual recursion
namespace s85
end s85
-- Section 8.6: Dependent pattern matching
namespace s86
end s86
-- Section 8.7: Inaccessible terms
namespace s87
end s87
-- Section 8.8: Match expressions
namespace s88
end s88
-- Exercises
namespace s8x
end s8x