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

import algebra.ne_zero
import algebra.polynomial.big_operators
import analysis.complex.roots_of_unity
import data.polynomial.lifts
import data.polynomial.splits
import data.zmod.algebra
import field_theory.ratfunc
import field_theory.separable
import number_theory.arithmetic_function
import ring_theory.roots_of_unity

/-!
# Cyclotomic polynomials.

For `n : ℕ` and an integral domain `R`, we define a modified version of the `n`-th cyclotomic
polynomial with coefficients in `R`, denoted `cyclotomic' n R`, as `∏ (X - μ)`, where `μ` varies
over the primitive `n`th roots of unity. If there is a primitive `n`th root of unity in `R` then
this the standard definition. We then define the standard cyclotomic polynomial `cyclotomic n R`
with coefficients in any ring `R`.

## Main definition

* `cyclotomic n R` : the `n`-th cyclotomic polynomial with coefficients in `R`.

## Main results

* `int_coeff_of_cycl` : If there is a primitive `n`-th root of unity in `K`, then `cyclotomic' n K`
comes from a polynomial with integer coefficients.
* `deg_of_cyclotomic` : The degree of `cyclotomic n` is `totient n`.
* `prod_cyclotomic_eq_X_pow_sub_one` : `X ^ n - 1 = ∏ (cyclotomic i)`, where `i` divides `n`.
* `cyclotomic_eq_prod_X_pow_sub_one_pow_moebius` : The Möbius inversion formula for
  `cyclotomic n R` over an abstract fraction field for `R[X]`.
* `cyclotomic.irreducible` : `cyclotomic n ℤ` is irreducible.

## Implementation details

Our definition of `cyclotomic' n R` makes sense in any integral domain `R`, but the interesting
results hold if there is a primitive `n`-th root of unity in `R`. In particular, our definition is
not the standard one unless there is a primitive `n`th root of unity in `R`. For example,
`cyclotomic' 3 ℤ = 1`, since there are no primitive cube roots of unity in `ℤ`. The main example is
`R = ℂ`, we decided to work in general since the difficulties are essentially the same.
To get the standard cyclotomic polynomials, we use `int_coeff_of_cycl`, with `R = ℂ`, to get a
polynomial with integer coefficients and then we map it to `R[X]`, for any ring `R`.
To prove `cyclotomic.irreducible`, the irreducibility of `cyclotomic n ℤ`, we show in
`cyclotomic_eq_minpoly` that `cyclotomic n ℤ` is the minimal polynomial of any `n`-th primitive root
of unity `μ : K`, where `K` is a field of characteristic `0`.
-/

open_locale classical big_operators polynomial
noncomputable theory

universe u

namespace polynomial

section cyclotomic'

section is_domain

variables {R : Type*} [comm_ring R] [is_domain R]

/-- The modified `n`-th cyclotomic polynomial with coefficients in `R`, it is the usual cyclotomic
polynomial if there is a primitive `n`-th root of unity in `R`. -/
def cyclotomic' (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] : R[X] :=
∏ μ in primitive_roots n R, (X - C μ)

/-- The zeroth modified cyclotomic polyomial is `1`. -/
@[simp] lemma cyclotomic'_zero
  (R : Type*) [comm_ring R] [is_domain R] : cyclotomic' 0 R = 1 :=
by simp only [cyclotomic', finset.prod_empty, primitive_roots_zero]

/-- The first modified cyclotomic polyomial is `X - 1`. -/
@[simp] lemma cyclotomic'_one
  (R : Type*) [comm_ring R] [is_domain R] : cyclotomic' 1 R = X - 1 :=
begin
  simp only [cyclotomic', finset.prod_singleton, ring_hom.map_one,
  is_primitive_root.primitive_roots_one]
end

/-- The second modified cyclotomic polyomial is `X + 1` if the characteristic of `R` is not `2`. -/
@[simp] lemma cyclotomic'_two
  (R : Type*) [comm_ring R] [is_domain R] (p : ℕ) [char_p R p] (hp : p ≠ 2) :
  cyclotomic' 2 R = X + 1 :=
begin
  rw [cyclotomic'],
  have prim_root_two : primitive_roots 2 R = {(-1 : R)},
  { simp only [finset.eq_singleton_iff_unique_mem, mem_primitive_roots two_pos],
    exact ⟨is_primitive_root.neg_one p hp, λ x, is_primitive_root.eq_neg_one_of_two_right⟩ },
  simp only [prim_root_two, finset.prod_singleton, ring_hom.map_neg, ring_hom.map_one,
  sub_neg_eq_add]
end

/-- `cyclotomic' n R` is monic. -/
lemma cyclotomic'.monic
  (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] : (cyclotomic' n R).monic :=
monic_prod_of_monic _ _ $ λ z hz, monic_X_sub_C _

/-- `cyclotomic' n R` is different from `0`. -/
lemma cyclotomic'_ne_zero
  (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] : cyclotomic' n R ≠ 0 :=
(cyclotomic'.monic n R).ne_zero

/-- The natural degree of `cyclotomic' n R` is `totient n` if there is a primitive root of
unity in `R`. -/
lemma nat_degree_cyclotomic' {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
  (cyclotomic' n R).nat_degree = nat.totient n :=
begin
  rw [cyclotomic'],
  rw nat_degree_prod (primitive_roots n R) (λ (z : R), (X - C z)),
  simp only [is_primitive_root.card_primitive_roots h, mul_one,
  nat_degree_X_sub_C,
  nat.cast_id, finset.sum_const, nsmul_eq_mul],
  intros z hz,
  exact X_sub_C_ne_zero z
end

/-- The degree of `cyclotomic' n R` is `totient n` if there is a primitive root of unity in `R`. -/
lemma degree_cyclotomic' {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
  (cyclotomic' n R).degree = nat.totient n :=
by simp only [degree_eq_nat_degree (cyclotomic'_ne_zero n R), nat_degree_cyclotomic' h]

/-- The roots of `cyclotomic' n R` are the primitive `n`-th roots of unity. -/
lemma roots_of_cyclotomic (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] :
  (cyclotomic' n R).roots = (primitive_roots n R).val :=
by { rw cyclotomic', exact roots_prod_X_sub_C (primitive_roots n R) }

/-- If there is a primitive `n`th root of unity in `K`, then `X ^ n - 1 = ∏ (X - μ)`, where `μ`
varies over the `n`-th roots of unity. -/
lemma X_pow_sub_one_eq_prod {ζ : R} {n : ℕ} (hpos : 0 < n) (h : is_primitive_root ζ n) :
  X ^ n - 1 = ∏ ζ in nth_roots_finset n R, (X - C ζ) :=
begin
  rw [nth_roots_finset, ← multiset.to_finset_eq (is_primitive_root.nth_roots_nodup h)],
  simp only [finset.prod_mk, ring_hom.map_one],
  rw [nth_roots],
  have hmonic : (X ^ n - C (1 : R)).monic := monic_X_pow_sub_C (1 : R) (ne_of_lt hpos).symm,
  symmetry,
  apply prod_multiset_X_sub_C_of_monic_of_roots_card_eq hmonic,
  rw [@nat_degree_X_pow_sub_C R _ _ n 1, ← nth_roots],
  exact is_primitive_root.card_nth_roots h
end

end is_domain

section field

variables {K : Type*} [field K]

/-- `cyclotomic' n K` splits. -/
lemma cyclotomic'_splits (n : ℕ) : splits (ring_hom.id K) (cyclotomic' n K) :=
begin
  apply splits_prod (ring_hom.id K),
  intros z hz,
  simp only [splits_X_sub_C (ring_hom.id K)]
end

/-- If there is a primitive `n`-th root of unity in `K`, then `X ^ n - 1`splits. -/
lemma X_pow_sub_one_splits {ζ : K} {n : ℕ} (h : is_primitive_root ζ n) :
  splits (ring_hom.id K) (X ^ n - C (1 : K)) :=
by rw [splits_iff_card_roots, ← nth_roots, is_primitive_root.card_nth_roots h,
    nat_degree_X_pow_sub_C]

/-- If there is a primitive `n`-th root of unity in `K`, then
`∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1`. -/
lemma prod_cyclotomic'_eq_X_pow_sub_one {K : Type*} [comm_ring K] [is_domain K] {ζ : K} {n : ℕ}
  (hpos : 0 < n) (h : is_primitive_root ζ n) : ∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1 :=
have hd : (n.divisors : set ℕ).pairwise_disjoint (λ k, primitive_roots k K),
  from λ x hx y hy hne, is_primitive_root.disjoint hne,
by simp only [X_pow_sub_one_eq_prod hpos h, cyclotomic', ← finset.prod_bUnion hd,
    h.nth_roots_one_eq_bUnion_primitive_roots]

/-- If there is a primitive `n`-th root of unity in `K`, then
`cyclotomic' n K = (X ^ k - 1) /ₘ (∏ i in nat.proper_divisors k, cyclotomic' i K)`. -/
lemma cyclotomic'_eq_X_pow_sub_one_div {K : Type*} [comm_ring K] [is_domain K] {ζ : K} {n : ℕ}
  (hpos : 0 < n) (h : is_primitive_root ζ n) :
  cyclotomic' n K = (X ^ n - 1) /ₘ (∏ i in nat.proper_divisors n, cyclotomic' i K) :=
begin
  rw [←prod_cyclotomic'_eq_X_pow_sub_one hpos h, ← nat.cons_self_proper_divisors hpos.ne',
    finset.prod_cons],
  have prod_monic : (∏ i in nat.proper_divisors n, cyclotomic' i K).monic,
  { apply monic_prod_of_monic,
    intros i hi,
    exact cyclotomic'.monic i K },
  rw (div_mod_by_monic_unique (cyclotomic' n K) 0 prod_monic _).1,
  simp only [degree_zero, zero_add],
  refine ⟨by rw mul_comm, _⟩,
  rw [bot_lt_iff_ne_bot],
  intro h,
  exact monic.ne_zero prod_monic (degree_eq_bot.1 h)
end

/-- If there is a primitive `n`-th root of unity in `K`, then `cyclotomic' n K` comes from a
monic polynomial with integer coefficients. -/
lemma int_coeff_of_cyclotomic' {K : Type*} [comm_ring K] [is_domain K] {ζ : K} {n : ℕ}
  (h : is_primitive_root ζ n) :
  (∃ (P : ℤ[X]), map (int.cast_ring_hom K) P = cyclotomic' n K ∧
    P.degree = (cyclotomic' n K).degree ∧ P.monic) :=
begin
  refine lifts_and_degree_eq_and_monic _ (cyclotomic'.monic n K),
  induction n using nat.strong_induction_on with k ihk generalizing ζ h,
  rcases k.eq_zero_or_pos with rfl|hpos,
  { use 1,
    simp only [cyclotomic'_zero, coe_map_ring_hom, polynomial.map_one] },
  let B : K[X] := ∏ i in nat.proper_divisors k, cyclotomic' i K,
  have Bmo : B.monic,
  { apply monic_prod_of_monic,
    intros i hi,
    exact (cyclotomic'.monic i K) },
  have Bint : B ∈ lifts (int.cast_ring_hom K),
  { refine subsemiring.prod_mem (lifts (int.cast_ring_hom K)) _,
    intros x hx,
    have xsmall := (nat.mem_proper_divisors.1 hx).2,
    obtain ⟨d, hd⟩ := (nat.mem_proper_divisors.1 hx).1,
    rw [mul_comm] at hd,
    exact ihk x xsmall (h.pow hpos hd) },
  replace Bint := lifts_and_degree_eq_and_monic Bint Bmo,
  obtain ⟨B₁, hB₁, hB₁deg, hB₁mo⟩ := Bint,
  let Q₁ : ℤ[X] := (X ^ k - 1) /ₘ B₁,
  have huniq : 0 + B * cyclotomic' k K = X ^ k - 1 ∧ (0 : K[X]).degree < B.degree,
  { split,
    { rw [zero_add, mul_comm, ← prod_cyclotomic'_eq_X_pow_sub_one hpos h,
         ← nat.cons_self_proper_divisors hpos.ne', finset.prod_cons] },
    { simpa only [degree_zero, bot_lt_iff_ne_bot, ne.def, degree_eq_bot] using Bmo.ne_zero } },
  replace huniq := div_mod_by_monic_unique (cyclotomic' k K) (0 : K[X]) Bmo huniq,
  simp only [lifts, ring_hom.mem_srange],
  use Q₁,
  rw [coe_map_ring_hom, (map_div_by_monic (int.cast_ring_hom K) hB₁mo), hB₁, ← huniq.1],
  simp
end

/-- If `K` is of characteristic `0` and there is a primitive `n`-th root of unity in `K`,
then `cyclotomic n K` comes from a unique polynomial with integer coefficients. -/
lemma unique_int_coeff_of_cycl {K : Type*} [comm_ring K] [is_domain K] [char_zero K] {ζ : K}
  {n : ℕ+} (h : is_primitive_root ζ n) :
  (∃! (P : ℤ[X]), map (int.cast_ring_hom K) P = cyclotomic' n K) :=
begin
  obtain ⟨P, hP⟩ := int_coeff_of_cyclotomic' h,
  refine ⟨P, hP.1, λ Q hQ, _⟩,
  apply (map_injective (int.cast_ring_hom K) int.cast_injective),
  rw [hP.1, hQ]
end

end field

end cyclotomic'

section cyclotomic

/-- The `n`-th cyclotomic polynomial with coefficients in `R`. -/
def cyclotomic (n : ℕ) (R : Type*) [ring R] : R[X] :=
if h : n = 0 then 1 else
  map (int.cast_ring_hom R) ((int_coeff_of_cyclotomic' (complex.is_primitive_root_exp n h)).some)

lemma int_cyclotomic_rw {n : ℕ} (h : n ≠ 0) :
  cyclotomic n ℤ = (int_coeff_of_cyclotomic' (complex.is_primitive_root_exp n h)).some :=
begin
  simp only [cyclotomic, h, dif_neg, not_false_iff],
  ext i,
  simp only [coeff_map, int.cast_id, eq_int_cast]
end

/-- `cyclotomic n R` comes from `cyclotomic n ℤ`. -/
lemma map_cyclotomic_int (n : ℕ) (R : Type*) [ring R] :
  map (int.cast_ring_hom R) (cyclotomic n ℤ) = cyclotomic n R :=
begin
  by_cases hzero : n = 0,
  { simp only [hzero, cyclotomic, dif_pos, polynomial.map_one] },
  simp only [cyclotomic, int_cyclotomic_rw, hzero, ne.def, dif_neg, not_false_iff]
end

lemma int_cyclotomic_spec (n : ℕ) : map (int.cast_ring_hom ℂ) (cyclotomic n ℤ) = cyclotomic' n ℂ ∧
  (cyclotomic n ℤ).degree = (cyclotomic' n ℂ).degree ∧ (cyclotomic n ℤ).monic  :=
begin
  by_cases hzero : n = 0,
  { simp only [hzero, cyclotomic, degree_one, monic_one, cyclotomic'_zero, dif_pos,
  eq_self_iff_true, polynomial.map_one, and_self] },
  rw int_cyclotomic_rw hzero,
  exact (int_coeff_of_cyclotomic' (complex.is_primitive_root_exp n hzero)).some_spec
end

lemma int_cyclotomic_unique {n : ℕ} {P : ℤ[X]} (h : map (int.cast_ring_hom ℂ) P =
  cyclotomic' n ℂ) : P = cyclotomic n ℤ :=
begin
  apply map_injective (int.cast_ring_hom ℂ) int.cast_injective,
  rw [h, (int_cyclotomic_spec n).1]
end

/-- The definition of `cyclotomic n R` commutes with any ring homomorphism. -/
@[simp] lemma map_cyclotomic (n : ℕ) {R S : Type*} [ring R] [ring S] (f : R →+* S) :
  map f (cyclotomic n R) = cyclotomic n S :=
begin
  rw [←map_cyclotomic_int n R, ←map_cyclotomic_int n S, map_map],
  congr
end

lemma cyclotomic.eval_apply {R S : Type*} (q : R) (n : ℕ) [ring R] [ring S] (f : R →+* S) :
  eval (f q) (cyclotomic n S) = f (eval q (cyclotomic n R)) :=
by rw [← map_cyclotomic n f, eval_map, eval₂_at_apply]

/-- The zeroth cyclotomic polyomial is `1`. -/
@[simp] lemma cyclotomic_zero (R : Type*) [ring R] : cyclotomic 0 R = 1 :=
by simp only [cyclotomic, dif_pos]

/-- The first cyclotomic polyomial is `X - 1`. -/
@[simp] lemma cyclotomic_one (R : Type*) [ring R] : cyclotomic 1 R = X - 1 :=
begin
  have hspec : map (int.cast_ring_hom ℂ) (X - 1) = cyclotomic' 1 ℂ,
  { simp only [cyclotomic'_one, pnat.one_coe, map_X, polynomial.map_one, polynomial.map_sub] },
  symmetry,
  rw [←map_cyclotomic_int, ←(int_cyclotomic_unique hspec)],
  simp only [map_X, polynomial.map_one, polynomial.map_sub]
end

/-- `cyclotomic n` is monic. -/
lemma cyclotomic.monic (n : ℕ) (R : Type*) [ring R] : (cyclotomic n R).monic :=
begin
  rw ←map_cyclotomic_int,
  exact (int_cyclotomic_spec n).2.2.map _,
end

/-- `cyclotomic n` is primitive. -/
lemma cyclotomic.is_primitive (n : ℕ) (R : Type*) [comm_ring R] : (cyclotomic n R).is_primitive :=
(cyclotomic.monic n R).is_primitive

/-- `cyclotomic n R` is different from `0`. -/
lemma cyclotomic_ne_zero (n : ℕ) (R : Type*) [ring R] [nontrivial R] : cyclotomic n R ≠ 0 :=
(cyclotomic.monic n R).ne_zero

/-- The degree of `cyclotomic n` is `totient n`. -/
lemma degree_cyclotomic (n : ℕ) (R : Type*) [ring R] [nontrivial R] :
  (cyclotomic n R).degree = nat.totient n :=
begin
  rw ←map_cyclotomic_int,
  rw degree_map_eq_of_leading_coeff_ne_zero (int.cast_ring_hom R) _,
  { cases n with k,
    { simp only [cyclotomic, degree_one, dif_pos, nat.totient_zero, with_top.coe_zero]},
      rw [←degree_cyclotomic' (complex.is_primitive_root_exp k.succ (nat.succ_ne_zero k))],
      exact (int_cyclotomic_spec k.succ).2.1 },
  simp only [(int_cyclotomic_spec n).right.right, eq_int_cast, monic.leading_coeff,
  int.cast_one, ne.def, not_false_iff, one_ne_zero]
end

/-- The natural degree of `cyclotomic n` is `totient n`. -/
lemma nat_degree_cyclotomic (n : ℕ) (R : Type*) [ring R] [nontrivial R] :
  (cyclotomic n R).nat_degree = nat.totient n :=
by rw [nat_degree, degree_cyclotomic, with_bot.unbot'_coe]

/-- The degree of `cyclotomic n R` is positive. -/
lemma degree_cyclotomic_pos (n : ℕ) (R : Type*) (hpos : 0 < n) [ring R] [nontrivial R] :
  0 < (cyclotomic n R).degree := by
{ rw degree_cyclotomic n R, exact_mod_cast (nat.totient_pos hpos) }

open finset

/-- `∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1`. -/
lemma prod_cyclotomic_eq_X_pow_sub_one {n : ℕ} (hpos : 0 < n) (R : Type*) [comm_ring R] :
  ∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1 :=
begin
  have integer : ∏ i in nat.divisors n, cyclotomic i ℤ = X ^ n - 1,
  { apply map_injective (int.cast_ring_hom ℂ) int.cast_injective,
    simp only [polynomial.map_prod, int_cyclotomic_spec, polynomial.map_pow, map_X,
               polynomial.map_one, polynomial.map_sub],
    exact prod_cyclotomic'_eq_X_pow_sub_one hpos (complex.is_primitive_root_exp n hpos.ne') },
  simpa only [polynomial.map_prod, map_cyclotomic_int, polynomial.map_sub, polynomial.map_one,
    polynomial.map_pow, polynomial.map_X] using congr_arg (map (int.cast_ring_hom R)) integer
end

lemma cyclotomic.dvd_X_pow_sub_one (n : ℕ) (R : Type*) [ring R] :
  (cyclotomic n R) ∣ X ^ n - 1 :=
begin
  suffices : cyclotomic n ℤ ∣ X ^ n - 1,
  { simpa only [map_cyclotomic_int, polynomial.map_sub, polynomial.map_one, polynomial.map_pow,
      polynomial.map_X] using map_dvd (int.cast_ring_hom R) this },
  rcases n.eq_zero_or_pos with rfl | hn,
  { simp },
  rw [← prod_cyclotomic_eq_X_pow_sub_one hn],
  exact finset.dvd_prod_of_mem _ (n.mem_divisors_self hn.ne')
end

lemma prod_cyclotomic_eq_geom_sum {n : ℕ} (h : 0 < n) (R) [comm_ring R] :
  ∏ i in n.divisors.erase 1, cyclotomic i R = ∑ i in finset.range n, X ^ i :=
suffices ∏ i in n.divisors.erase 1, cyclotomic i ℤ = ∑ i in finset.range n, X ^ i,
by simpa only [polynomial.map_prod, map_cyclotomic_int, polynomial.map_sum, polynomial.map_pow,
  polynomial.map_X] using congr_arg (map (int.cast_ring_hom R)) this,
by rw [← mul_left_inj' (cyclotomic_ne_zero 1 ℤ), prod_erase_mul _ _ (nat.one_mem_divisors.2 h.ne'),
  cyclotomic_one, geom_sum_mul, prod_cyclotomic_eq_X_pow_sub_one h]

/-- If `p` is prime, then `cyclotomic p R = ∑ i in range p, X ^ i`. -/
lemma cyclotomic_prime (R : Type*) [ring R] (p : ℕ) [hp : fact p.prime] :
  cyclotomic p R = ∑ i in finset.range p, X ^ i :=
begin
  suffices : cyclotomic p ℤ = ∑ i in range p, X ^ i,
  { simpa only [map_cyclotomic_int, polynomial.map_sum, polynomial.map_pow, polynomial.map_X]
      using congr_arg (map (int.cast_ring_hom R)) this },
  rw [← prod_cyclotomic_eq_geom_sum hp.out.pos, hp.out.divisors,
    erase_insert (mem_singleton.not.2 hp.out.ne_one.symm), prod_singleton]
end

lemma cyclotomic_prime_mul_X_sub_one (R : Type*) [ring R] (p : ℕ) [hn : fact (nat.prime p)] :
  (cyclotomic p R) * (X - 1) = X ^ p - 1 :=
by rw [cyclotomic_prime, geom_sum_mul]

@[simp] lemma cyclotomic_two (R : Type*) [ring R] : cyclotomic 2 R = X + 1 :=
by simp [cyclotomic_prime]

@[simp] lemma cyclotomic_three (R : Type*) [ring R] : cyclotomic 3 R = X ^ 2 + X + 1 :=
by simp [cyclotomic_prime, sum_range_succ']

lemma cyclotomic_dvd_geom_sum_of_dvd (R) [ring R] {d n : ℕ} (hdn : d ∣ n)
  (hd : d ≠ 1) : cyclotomic d R ∣ ∑ i in finset.range n, X ^ i :=
begin
  suffices : cyclotomic d ℤ ∣ ∑ i in finset.range n, X ^ i,
  { simpa only [map_cyclotomic_int, polynomial.map_sum, polynomial.map_pow, polynomial.map_X]
      using map_dvd (int.cast_ring_hom R) this },
  rcases n.eq_zero_or_pos with rfl | hn,
  { simp },
  rw ←prod_cyclotomic_eq_geom_sum hn,
  apply finset.dvd_prod_of_mem,
  simp [hd, hdn, hn.ne']
end

lemma X_pow_sub_one_mul_prod_cyclotomic_eq_X_pow_sub_one_of_dvd (R) [comm_ring R] {d n : ℕ}
  (h : d ∈ n.proper_divisors) :
  (X ^ d - 1) * ∏ x in n.divisors \ d.divisors, cyclotomic x R = X ^ n - 1 :=
begin
  obtain ⟨hd, hdn⟩ := nat.mem_proper_divisors.mp h,
  have h0n : 0 < n := pos_of_gt hdn,
  have h0d : 0 < d := nat.pos_of_dvd_of_pos hd h0n,
  rw [←prod_cyclotomic_eq_X_pow_sub_one h0d, ←prod_cyclotomic_eq_X_pow_sub_one h0n,
      mul_comm, finset.prod_sdiff (nat.divisors_subset_of_dvd h0n.ne' hd)]
end

lemma X_pow_sub_one_mul_cyclotomic_dvd_X_pow_sub_one_of_dvd (R) [comm_ring R] {d n : ℕ}
  (h : d ∈ n.proper_divisors) : (X ^ d - 1) * cyclotomic n R ∣ X ^ n - 1 :=
begin
  have hdn := (nat.mem_proper_divisors.mp h).2,
  use ∏ x in n.proper_divisors \ d.divisors, cyclotomic x R,
  symmetry,
  convert X_pow_sub_one_mul_prod_cyclotomic_eq_X_pow_sub_one_of_dvd R h using 1,
  rw mul_assoc,
  congr' 1,
  rw [← nat.insert_self_proper_divisors hdn.ne_bot, insert_sdiff_of_not_mem, prod_insert],
  { exact finset.not_mem_sdiff_of_not_mem_left nat.proper_divisors.not_self_mem },
  { exact λ hk, hdn.not_le $ nat.divisor_le hk }
end

lemma _root_.is_root_of_unity_iff {n : ℕ} (h : 0 < n) (R : Type*) [comm_ring R] [is_domain R]
  {ζ : R} : ζ ^ n = 1 ↔ ∃ i ∈ n.divisors, (cyclotomic i R).is_root ζ :=
by rw [←mem_nth_roots h, nth_roots, mem_roots $ X_pow_sub_C_ne_zero h _,
       C_1, ←prod_cyclotomic_eq_X_pow_sub_one h, is_root_prod]; apply_instance

lemma is_root_of_unity_of_root_cyclotomic {n : ℕ} {R} [comm_ring R] {ζ : R} {i : ℕ}
  (hi : i ∈ n.divisors) (h : (cyclotomic i R).is_root ζ) : ζ ^ n = 1 :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { exact pow_zero _ },
  have := congr_arg (eval ζ) (prod_cyclotomic_eq_X_pow_sub_one hn R).symm,
  rw [eval_sub, eval_pow, eval_X, eval_one] at this,
  convert eq_add_of_sub_eq' this,
  convert (add_zero _).symm,
  apply eval_eq_zero_of_dvd_of_eval_eq_zero _ h,
  exact finset.dvd_prod_of_mem _ hi
end

section arithmetic_function
open nat.arithmetic_function
open_locale arithmetic_function

/-- `cyclotomic n R` can be expressed as a product in a fraction field of `R[X]`
  using Möbius inversion. -/
lemma cyclotomic_eq_prod_X_pow_sub_one_pow_moebius {n : ℕ} (R : Type*) [comm_ring R] [is_domain R] :
  algebra_map _ (ratfunc R) (cyclotomic n R) =
    ∏ i in n.divisors_antidiagonal, (algebra_map R[X] _ (X ^ i.snd - 1)) ^ μ i.fst :=
begin
  rcases n.eq_zero_or_pos with rfl | hpos,
  { simp },
  have h : ∀ (n : ℕ), 0 < n →
    ∏ i in nat.divisors n, algebra_map _ (ratfunc R) (cyclotomic i R) = algebra_map _ _ (X ^ n - 1),
  { intros n hn,
    rw [← prod_cyclotomic_eq_X_pow_sub_one hn R, ring_hom.map_prod] },
  rw (prod_eq_iff_prod_pow_moebius_eq_of_nonzero (λ n hn, _) (λ n hn, _)).1 h n hpos;
  rw [ne.def, is_fraction_ring.to_map_eq_zero_iff],
  { apply cyclotomic_ne_zero },
  { apply monic.ne_zero,
    apply monic_X_pow_sub_C _ (ne_of_gt hn) }
end

end arithmetic_function

/-- We have
`cyclotomic n R = (X ^ k - 1) /ₘ (∏ i in nat.proper_divisors k, cyclotomic i K)`. -/
lemma cyclotomic_eq_X_pow_sub_one_div {R : Type*} [comm_ring R] {n : ℕ}
  (hpos: 0 < n) : cyclotomic n R = (X ^ n - 1) /ₘ (∏ i in nat.proper_divisors n, cyclotomic i R) :=
begin
  nontriviality R,
  rw [←prod_cyclotomic_eq_X_pow_sub_one hpos, ← nat.cons_self_proper_divisors hpos.ne',
    finset.prod_cons],
  have prod_monic : (∏ i in nat.proper_divisors n, cyclotomic i R).monic,
  { apply monic_prod_of_monic,
    intros i hi,
    exact cyclotomic.monic i R },
  rw (div_mod_by_monic_unique (cyclotomic n R) 0 prod_monic _).1,
  simp only [degree_zero, zero_add],
  split,
  { rw mul_comm },
  rw [bot_lt_iff_ne_bot],
  intro h,
  exact monic.ne_zero prod_monic (degree_eq_bot.1 h)
end

/-- If `m` is a proper divisor of `n`, then `X ^ m - 1` divides
`∏ i in nat.proper_divisors n, cyclotomic i R`. -/
lemma X_pow_sub_one_dvd_prod_cyclotomic (R : Type*) [comm_ring R] {n m : ℕ} (hpos : 0 < n)
  (hm : m ∣ n) (hdiff : m ≠ n) : X ^ m - 1 ∣ ∏ i in nat.proper_divisors n, cyclotomic i R :=
begin
  replace hm := nat.mem_proper_divisors.2 ⟨hm, lt_of_le_of_ne (nat.divisor_le (nat.mem_divisors.2
    ⟨hm, hpos.ne'⟩)) hdiff⟩,
  rw [← finset.sdiff_union_of_subset (nat.divisors_subset_proper_divisors (ne_of_lt hpos).symm
    (nat.mem_proper_divisors.1 hm).1 (ne_of_lt (nat.mem_proper_divisors.1 hm).2)),
    finset.prod_union finset.sdiff_disjoint,
    prod_cyclotomic_eq_X_pow_sub_one (nat.pos_of_mem_proper_divisors hm)],
  exact ⟨(∏ (x : ℕ) in n.proper_divisors \ m.divisors, cyclotomic x R), by rw mul_comm⟩
end

/-- If there is a primitive `n`-th root of unity in `K`, then
`cyclotomic n K = ∏ μ in primitive_roots n R, (X - C μ)`. In particular,
`cyclotomic n K = cyclotomic' n K` -/
lemma cyclotomic_eq_prod_X_sub_primitive_roots {K : Type*} [comm_ring K] [is_domain K] {ζ : K}
  {n : ℕ} (hz : is_primitive_root ζ n) :
  cyclotomic n K = ∏ μ in primitive_roots n K, (X - C μ) :=
begin
  rw ←cyclotomic',
  induction n using nat.strong_induction_on with k hk generalizing ζ hz,
  obtain hzero | hpos := k.eq_zero_or_pos,
  { simp only [hzero, cyclotomic'_zero, cyclotomic_zero] },
  have h : ∀ i ∈ k.proper_divisors, cyclotomic i K = cyclotomic' i K,
  { intros i hi,
    obtain ⟨d, hd⟩ := (nat.mem_proper_divisors.1 hi).1,
    rw mul_comm at hd,
    exact hk i (nat.mem_proper_divisors.1 hi).2 (is_primitive_root.pow hpos hz hd) },
  rw [@cyclotomic_eq_X_pow_sub_one_div _ _ _ hpos,
      cyclotomic'_eq_X_pow_sub_one_div hpos hz, finset.prod_congr (refl k.proper_divisors) h]
end

section roots

variables {R : Type*} {n : ℕ} [comm_ring R] [is_domain R]

/-- Any `n`-th primitive root of unity is a root of `cyclotomic n K`.-/
lemma _root_.is_primitive_root.is_root_cyclotomic (hpos : 0 < n) {μ : R}
  (h : is_primitive_root μ n) : is_root (cyclotomic n R) μ :=
begin
  rw [← mem_roots (cyclotomic_ne_zero n R),
      cyclotomic_eq_prod_X_sub_primitive_roots h, roots_prod_X_sub_C, ← finset.mem_def],
  rwa [← mem_primitive_roots hpos] at h,
end

private lemma is_root_cyclotomic_iff' {n : ℕ} {K : Type*} [field K] {μ : K} [ne_zero (n : K)] :
  is_root (cyclotomic n K) μ ↔ is_primitive_root μ n :=
begin
  -- in this proof, `o` stands for `order_of μ`
  have hnpos : 0 < n := (ne_zero.of_ne_zero_coe K).out.bot_lt,
  refine ⟨λ hμ, _, is_primitive_root.is_root_cyclotomic hnpos⟩,
  have hμn : μ ^ n = 1,
  { rw is_root_of_unity_iff hnpos,
    exact ⟨n, n.mem_divisors_self hnpos.ne', hμ⟩ },
  by_contra hnμ,
  have ho : 0 < order_of μ,
  { apply order_of_pos',
    rw is_of_fin_order_iff_pow_eq_one,
    exact ⟨n, hnpos, hμn⟩ },
  have := pow_order_of_eq_one μ,
  rw is_root_of_unity_iff ho at this,
  obtain ⟨i, hio, hiμ⟩ := this,
  replace hio := nat.dvd_of_mem_divisors hio,
  rw is_primitive_root.not_iff at hnμ,
  rw ←order_of_dvd_iff_pow_eq_one at hμn,
  have key  : i < n := (nat.le_of_dvd ho hio).trans_lt ((nat.le_of_dvd hnpos hμn).lt_of_ne hnμ),
  have key' : i ∣ n := hio.trans hμn,
  rw ←polynomial.dvd_iff_is_root at hμ hiμ,
  have hni : {i, n} ⊆ n.divisors,
  { simpa [finset.insert_subset, key'] using hnpos.ne' },
  obtain ⟨k, hk⟩ := hiμ,
  obtain ⟨j, hj⟩ := hμ,
  have := prod_cyclotomic_eq_X_pow_sub_one hnpos K,
  rw [←finset.prod_sdiff hni, finset.prod_pair key.ne, hk, hj] at this,
  have hn := (X_pow_sub_one_separable_iff.mpr $ ne_zero.nat_cast_ne n K).squarefree,
  rw [←this, squarefree] at hn,
  contrapose! hn,
  refine ⟨X - C μ, ⟨(∏ x in n.divisors \ {i, n}, cyclotomic x K) * k * j, by ring⟩, _⟩,
  simp [polynomial.is_unit_iff_degree_eq_zero]
end

lemma is_root_cyclotomic_iff [ne_zero (n : R)] {μ : R} :
  is_root (cyclotomic n R) μ ↔ is_primitive_root μ n :=
begin
  have hf : function.injective _ := is_fraction_ring.injective R (fraction_ring R),
  haveI : ne_zero (n : fraction_ring R) := ne_zero.nat_of_injective hf,
  rw [←is_root_map_iff hf, ←is_primitive_root.map_iff_of_injective hf, map_cyclotomic,
      ←is_root_cyclotomic_iff']
end

lemma roots_cyclotomic_nodup [ne_zero (n : R)] : (cyclotomic n R).roots.nodup :=
begin
  obtain h | ⟨ζ, hζ⟩ := (cyclotomic n R).roots.empty_or_exists_mem,
  { exact h.symm ▸ multiset.nodup_zero },
  rw [mem_roots $ cyclotomic_ne_zero n R, is_root_cyclotomic_iff] at hζ,
  refine multiset.nodup_of_le (roots.le_of_dvd (X_pow_sub_C_ne_zero
    (ne_zero.pos_of_ne_zero_coe R) 1) $ cyclotomic.dvd_X_pow_sub_one n R) hζ.nth_roots_nodup,
end

lemma cyclotomic.roots_to_finset_eq_primitive_roots [ne_zero (n : R)] :
    (⟨(cyclotomic n R).roots, roots_cyclotomic_nodup⟩ : finset _) = primitive_roots n R :=
by { ext, simp [cyclotomic_ne_zero n R, is_root_cyclotomic_iff,
                mem_primitive_roots, ne_zero.pos_of_ne_zero_coe R] }

lemma cyclotomic.roots_eq_primitive_roots_val [ne_zero (n : R)] :
  (cyclotomic n R).roots = (primitive_roots n R).val :=
by rw ←cyclotomic.roots_to_finset_eq_primitive_roots

end roots

/-- If `R` is of characteristic zero, then `ζ` is a root of `cyclotomic n R` if and only if it is a
primitive `n`-th root of unity. -/
lemma is_root_cyclotomic_iff_char_zero {n : ℕ} {R : Type*} [comm_ring R] [is_domain R]
  [char_zero R] {μ : R} (hn : 0 < n) :
  (polynomial.cyclotomic n R).is_root μ ↔ is_primitive_root μ n :=
by { letI := ne_zero.of_gt hn, exact is_root_cyclotomic_iff }

/-- Over a ring `R` of characteristic zero, `λ n, cyclotomic n R` is injective. -/
lemma cyclotomic_injective {R : Type*} [comm_ring R] [char_zero R] :
  function.injective (λ n, cyclotomic n R) :=
begin
  intros n m hnm,
  simp only at hnm,
  rcases eq_or_ne n 0 with rfl | hzero,
  { rw [cyclotomic_zero] at hnm,
    replace hnm := congr_arg nat_degree hnm,
    rw [nat_degree_one, nat_degree_cyclotomic] at hnm,
    by_contra,
    exact (nat.totient_pos (zero_lt_iff.2 (ne.symm h))).ne hnm },
  { haveI := ne_zero.mk hzero,
    rw [← map_cyclotomic_int _ R, ← map_cyclotomic_int _ R] at hnm,
    replace hnm := map_injective (int.cast_ring_hom R) int.cast_injective hnm,
    replace hnm := congr_arg (map (int.cast_ring_hom ℂ)) hnm,
    rw [map_cyclotomic_int, map_cyclotomic_int] at hnm,
    have hprim := complex.is_primitive_root_exp _ hzero,
    have hroot := is_root_cyclotomic_iff.2 hprim,
    rw hnm at hroot,
    haveI hmzero : ne_zero m := ⟨λ h, by simpa [h] using hroot⟩,
    rw is_root_cyclotomic_iff at hroot,
    replace hprim := hprim.eq_order_of,
    rwa [← is_primitive_root.eq_order_of hroot] at hprim}
end

lemma eq_cyclotomic_iff {R : Type*} [comm_ring R] {n : ℕ} (hpos: 0 < n)
  (P : R[X]) :
  P = cyclotomic n R ↔ P * (∏ i in nat.proper_divisors n, polynomial.cyclotomic i R) = X ^ n - 1 :=
begin
  nontriviality R,
  refine ⟨λ hcycl, _, λ hP, _⟩,
  { rw [hcycl, ← prod_cyclotomic_eq_X_pow_sub_one hpos R, ← nat.cons_self_proper_divisors hpos.ne',
        finset.prod_cons] },
  { have prod_monic : (∏ i in nat.proper_divisors n, cyclotomic i R).monic,
    { apply monic_prod_of_monic,
      intros i hi,
      exact cyclotomic.monic i R },
    rw [@cyclotomic_eq_X_pow_sub_one_div R _ _ hpos,
      (div_mod_by_monic_unique P 0 prod_monic _).1],
    refine ⟨by rwa [zero_add, mul_comm], _⟩,
    rw [degree_zero, bot_lt_iff_ne_bot],
    intro h,
    exact monic.ne_zero prod_monic (degree_eq_bot.1 h) },
end

/-- If `p ^ k` is a prime power, then
`cyclotomic (p ^ (n + 1)) R = ∑ i in range p, (X ^ (p ^ n)) ^ i`. -/
lemma cyclotomic_prime_pow_eq_geom_sum {R : Type*} [comm_ring R] {p n : ℕ} (hp : p.prime) :
  cyclotomic (p ^ (n + 1)) R = ∑ i in finset.range p, (X ^ (p ^ n)) ^ i :=
begin
  have : ∀ m, cyclotomic (p ^ (m + 1)) R = ∑ i in finset.range p, (X ^ (p ^ m)) ^ i ↔
    (∑ i in finset.range p, (X ^ (p ^ m)) ^ i) * ∏ (x : ℕ) in finset.range (m + 1),
      cyclotomic (p ^ x) R = X ^ p ^ (m + 1) - 1,
  { intro m,
    have := eq_cyclotomic_iff (pow_pos hp.pos (m + 1)) _,
    rw eq_comm at this,
    rw [this, nat.prod_proper_divisors_prime_pow hp], },
  induction n with n_n n_ih,
  { haveI := fact.mk hp, simp [cyclotomic_prime], },
  rw ((eq_cyclotomic_iff (pow_pos hp.pos (n_n.succ + 1)) _).mpr _).symm,
  rw [nat.prod_proper_divisors_prime_pow hp, finset.prod_range_succ, n_ih],
  rw this at n_ih,
  rw [mul_comm _ (∑ i in _, _), n_ih, geom_sum_mul, sub_left_inj, ← pow_mul, pow_add, pow_one],
end

lemma cyclotomic_prime_pow_mul_X_pow_sub_one (R : Type*) [comm_ring R] (p k : ℕ)
  [hn : fact (nat.prime p)] :
  (cyclotomic (p ^ (k + 1)) R) * (X ^ (p ^ k) - 1) = X ^ (p ^ (k + 1)) - 1 :=
by rw [cyclotomic_prime_pow_eq_geom_sum hn.out, geom_sum_mul, ← pow_mul, pow_succ, mul_comm]

/-- The constant term of `cyclotomic n R` is `1` if `2 ≤ n`. -/
lemma cyclotomic_coeff_zero (R : Type*) [comm_ring R] {n : ℕ} (hn : 1 < n) :
  (cyclotomic n R).coeff 0 = 1 :=
begin
  induction n using nat.strong_induction_on with n hi,
  have hprod : (∏ i in nat.proper_divisors n, (polynomial.cyclotomic i R).coeff 0) = -1,
  { rw [←finset.insert_erase (nat.one_mem_proper_divisors_iff_one_lt.2
      (lt_of_lt_of_le one_lt_two hn)), finset.prod_insert (finset.not_mem_erase 1 _),
      cyclotomic_one R],
    have hleq : ∀ j ∈ n.proper_divisors.erase 1, 2 ≤ j,
    { intros j hj,
      apply nat.succ_le_of_lt,
      exact (ne.le_iff_lt ((finset.mem_erase.1 hj).1).symm).mp
              (nat.succ_le_of_lt (nat.pos_of_mem_proper_divisors (finset.mem_erase.1 hj).2)) },
    have hcongr : ∀ j ∈ n.proper_divisors.erase 1, (cyclotomic j R).coeff 0 = 1,
    { intros j hj,
      exact hi j (nat.mem_proper_divisors.1 (finset.mem_erase.1 hj).2).2 (hleq j hj) },
    have hrw : ∏ (x : ℕ) in n.proper_divisors.erase 1, (cyclotomic x R).coeff 0 = 1,
    { rw finset.prod_congr (refl (n.proper_divisors.erase 1)) hcongr,
      simp only [finset.prod_const_one] },
    simp only [hrw, mul_one, zero_sub, coeff_one_zero, coeff_X_zero, coeff_sub] },
  have heq : (X ^ n - 1).coeff 0 = -(cyclotomic n R).coeff 0,
  { rw [← prod_cyclotomic_eq_X_pow_sub_one (zero_le_one.trans_lt hn),
        ← nat.cons_self_proper_divisors hn.ne_bot, finset.prod_cons, mul_coeff_zero,
        coeff_zero_prod, hprod, mul_neg, mul_one] },
  have hzero : (X ^ n - 1).coeff 0 = (-1 : R),
  { rw coeff_zero_eq_eval_zero _,
    simp only [zero_pow (lt_of_lt_of_le zero_lt_two hn), eval_X, eval_one, zero_sub, eval_pow,
              eval_sub] },
  rw hzero at heq,
  exact neg_inj.mp (eq.symm heq)
end

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, where `p` is a prime, then `a` and `p` are
coprime. -/
lemma coprime_of_root_cyclotomic {n : ℕ} (hpos : 0 < n) {p : ℕ} [hprime : fact p.prime] {a : ℕ}
  (hroot : is_root (cyclotomic n (zmod p)) (nat.cast_ring_hom (zmod p) a)) :
  a.coprime p :=
begin
  apply nat.coprime.symm,
  rw [hprime.1.coprime_iff_not_dvd],
  intro h,
  replace h := (zmod.nat_coe_zmod_eq_zero_iff_dvd a p).2 h,
  rw [is_root.def, eq_nat_cast, h, ← coeff_zero_eq_eval_zero] at hroot,
  by_cases hone : n = 1,
  { simp only [hone, cyclotomic_one, zero_sub, coeff_one_zero, coeff_X_zero, neg_eq_zero,
    one_ne_zero, coeff_sub] at hroot,
    exact hroot },
  rw [cyclotomic_coeff_zero (zmod p) (nat.succ_le_of_lt (lt_of_le_of_ne
        (nat.succ_le_of_lt hpos) (ne.symm hone)))] at hroot,
  exact one_ne_zero hroot
end

end cyclotomic

section order

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, then the multiplicative order of `a` modulo
`p` divides `n`. -/
lemma order_of_root_cyclotomic_dvd {n : ℕ} (hpos : 0 < n) {p : ℕ} [fact p.prime]
  {a : ℕ} (hroot : is_root (cyclotomic n (zmod p)) (nat.cast_ring_hom (zmod p) a)) :
  order_of (zmod.unit_of_coprime a (coprime_of_root_cyclotomic hpos hroot)) ∣ n :=
begin
  apply order_of_dvd_of_pow_eq_one,
  suffices hpow : eval (nat.cast_ring_hom (zmod p) a) (X ^ n - 1 : (zmod p)[X]) = 0,
  { simp only [eval_X, eval_one, eval_pow, eval_sub, eq_nat_cast] at hpow,
    apply units.coe_eq_one.1,
    simp only [sub_eq_zero.mp hpow, zmod.coe_unit_of_coprime, units.coe_pow] },
  rw [is_root.def] at hroot,
  rw [← prod_cyclotomic_eq_X_pow_sub_one hpos (zmod p), ← nat.cons_self_proper_divisors hpos.ne',
    finset.prod_cons, eval_mul, hroot, zero_mul]
end

end order

section minpoly

open is_primitive_root complex

/-- The minimal polynomial of a primitive `n`-th root of unity `μ` divides `cyclotomic n ℤ`. -/
lemma _root_.is_primitive_root.minpoly_dvd_cyclotomic {n : ℕ} {K : Type*} [field K] {μ : K}
  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
  minpoly ℤ μ ∣ cyclotomic n ℤ :=
begin
  apply minpoly.is_integrally_closed_dvd (is_integral h hpos),
  simpa [aeval_def, eval₂_eq_eval_map, is_root.def] using is_root_cyclotomic hpos h
end

lemma _root_.is_primitive_root.minpoly_eq_cyclotomic_of_irreducible {K : Type*} [field K]
  {R : Type*} [comm_ring R] [is_domain R] {μ : R} {n : ℕ} [algebra K R] (hμ : is_primitive_root μ n)
  (h : irreducible $ cyclotomic n K) [ne_zero (n : K)] : cyclotomic n K = minpoly K μ :=
begin
  haveI := ne_zero.of_no_zero_smul_divisors K R n,
  refine minpoly.eq_of_irreducible_of_monic h _ (cyclotomic.monic n K),
  rwa [aeval_def, eval₂_eq_eval_map, map_cyclotomic, ←is_root.def, is_root_cyclotomic_iff]
end

/-- `cyclotomic n ℤ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
lemma cyclotomic_eq_minpoly {n : ℕ} {K : Type*} [field K] {μ : K}
  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
  cyclotomic n ℤ = minpoly ℤ μ :=
begin
  refine eq_of_monic_of_dvd_of_nat_degree_le (minpoly.monic (is_integral h hpos))
    (cyclotomic.monic n ℤ) (h.minpoly_dvd_cyclotomic hpos) _,
  simpa [nat_degree_cyclotomic n ℤ] using totient_le_degree_minpoly h
end

/-- `cyclotomic n ℚ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/

/-- `cyclotomic n ℤ` is irreducible. -/
lemma cyclotomic.irreducible {n : ℕ} (hpos : 0 < n) : irreducible (cyclotomic n ℤ) :=
begin
  rw [cyclotomic_eq_minpoly (is_primitive_root_exp n hpos.ne') hpos],
  apply minpoly.irreducible,
  exact (is_primitive_root_exp n hpos.ne').is_integral hpos,
end

/-- `cyclotomic n ℚ` is irreducible. -/
lemma cyclotomic.irreducible_rat {n : ℕ} (hpos : 0 < n) : irreducible (cyclotomic n ℚ) :=
begin
  rw [← map_cyclotomic_int],
  exact (is_primitive.irreducible_iff_irreducible_map_fraction_map (cyclotomic.is_primitive n ℤ)).1
    (cyclotomic.irreducible hpos),
end

/-- If `n ≠ m`, then `(cyclotomic n ℚ)` and `(cyclotomic m ℚ)` are coprime. -/
lemma cyclotomic.is_coprime_rat {n m : ℕ} (h : n ≠ m) :
  is_coprime (cyclotomic n ℚ) (cyclotomic m ℚ) :=
begin
  rcases n.eq_zero_or_pos with rfl | hnzero,
  { exact is_coprime_one_left },
  rcases m.eq_zero_or_pos with rfl | hmzero,
  { exact is_coprime_one_right },
  rw (irreducible.coprime_iff_not_dvd $ cyclotomic.irreducible_rat $ hnzero),
  exact (λ hdiv, h $ cyclotomic_injective $ eq_of_monic_of_associated (cyclotomic.monic n ℚ)
    (cyclotomic.monic m ℚ) $ irreducible.associated_of_dvd (cyclotomic.irreducible_rat
    hnzero) (cyclotomic.irreducible_rat hmzero) hdiv),
end

end minpoly

section expand

/-- If `p` is a prime such that `¬ p ∣ n`, then
`expand R p (cyclotomic n R) = (cyclotomic (n * p) R) * (cyclotomic n R)`. -/
@[simp] lemma cyclotomic_expand_eq_cyclotomic_mul {p n : ℕ} (hp : nat.prime p) (hdiv : ¬p ∣ n)
  (R : Type*) [comm_ring R] :
  expand R p (cyclotomic n R) = (cyclotomic (n * p) R) * (cyclotomic n R) :=
begin
  rcases nat.eq_zero_or_pos n with rfl | hnpos,
  { simp },
  haveI := ne_zero.of_pos hnpos,
  suffices : expand ℤ p (cyclotomic n ℤ) = (cyclotomic (n * p) ℤ) * (cyclotomic n ℤ),
  { rw [← map_cyclotomic_int, ← map_expand, this, polynomial.map_mul, map_cyclotomic_int] },
  refine eq_of_monic_of_dvd_of_nat_degree_le ((cyclotomic.monic _ _).mul
    (cyclotomic.monic _ _)) ((cyclotomic.monic n ℤ).expand hp.pos) _ _,
  { refine (is_primitive.int.dvd_iff_map_cast_dvd_map_cast _ _ (is_primitive.mul
      (cyclotomic.is_primitive (n * p) ℤ) (cyclotomic.is_primitive n ℤ))
      ((cyclotomic.monic n ℤ).expand hp.pos).is_primitive).2 _,
    rw [polynomial.map_mul, map_cyclotomic_int, map_cyclotomic_int, map_expand, map_cyclotomic_int],
    refine is_coprime.mul_dvd (cyclotomic.is_coprime_rat (λ h, _)) _ _,
    { replace h : n * p = n * 1 := by simp [h],
      exact nat.prime.ne_one hp (mul_left_cancel₀ hnpos.ne' h) },
    { have hpos : 0 < n * p := mul_pos hnpos hp.pos,
      have hprim := complex.is_primitive_root_exp _ hpos.ne',
      rw [cyclotomic_eq_minpoly_rat hprim hpos],
      refine @minpoly.dvd ℚ ℂ _ _ algebra_rat _ _ _,
      rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval, ← is_root.def,
        is_root_cyclotomic_iff],
      convert is_primitive_root.pow_of_dvd hprim hp.ne_zero (dvd_mul_left p n),
      rw [nat.mul_div_cancel _ (nat.prime.pos hp)] },
    { have hprim := complex.is_primitive_root_exp _ hnpos.ne.symm,
      rw [cyclotomic_eq_minpoly_rat hprim hnpos],
      refine @minpoly.dvd ℚ ℂ _ _ algebra_rat _ _ _,
      rw [aeval_def, ← eval_map, map_expand, expand_eval, ← is_root.def,
        ← cyclotomic_eq_minpoly_rat hprim hnpos, map_cyclotomic, is_root_cyclotomic_iff],
      exact is_primitive_root.pow_of_prime hprim hp hdiv,} },
  { rw [nat_degree_expand, nat_degree_cyclotomic, nat_degree_mul (cyclotomic_ne_zero _ ℤ)
      (cyclotomic_ne_zero _ ℤ), nat_degree_cyclotomic, nat_degree_cyclotomic, mul_comm n,
      nat.totient_mul ((nat.prime.coprime_iff_not_dvd hp).2 hdiv),
      nat.totient_prime hp, mul_comm (p - 1), ← nat.mul_succ, nat.sub_one,
      nat.succ_pred_eq_of_pos hp.pos] }
end

/-- If `p` is a prime such that `p ∣ n`, then
`expand R p (cyclotomic n R) = cyclotomic (p * n) R`. -/
@[simp] lemma cyclotomic_expand_eq_cyclotomic {p n : ℕ} (hp : nat.prime p) (hdiv : p ∣ n)
  (R : Type*) [comm_ring R] : expand R p (cyclotomic n R) = cyclotomic (n * p) R :=
begin
  rcases n.eq_zero_or_pos with rfl | hzero,
  { simp },
  haveI := ne_zero.of_pos hzero,
  suffices : expand ℤ p (cyclotomic n ℤ) = cyclotomic (n * p) ℤ,
  { rw [← map_cyclotomic_int, ← map_expand, this, map_cyclotomic_int] },
  refine eq_of_monic_of_dvd_of_nat_degree_le (cyclotomic.monic _ _)
    ((cyclotomic.monic n ℤ).expand hp.pos) _ _,
  { have hpos := nat.mul_pos hzero hp.pos,
    have hprim := complex.is_primitive_root_exp _ hpos.ne.symm,
    rw [cyclotomic_eq_minpoly hprim hpos],
    refine minpoly.is_integrally_closed_dvd (hprim.is_integral hpos) _,
    rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval,
        ← is_root.def, is_root_cyclotomic_iff],
    { convert is_primitive_root.pow_of_dvd hprim hp.ne_zero (dvd_mul_left p n),
      rw [nat.mul_div_cancel _ hp.pos] } },
  { rw [nat_degree_expand, nat_degree_cyclotomic, nat_degree_cyclotomic, mul_comm n,
        nat.totient_mul_of_prime_of_dvd hp hdiv, mul_comm] }
end

/-- If the `p ^ n`th cyclotomic polynomial is irreducible, so is the `p ^ m`th, for `m ≤ n`. -/
lemma cyclotomic_irreducible_pow_of_irreducible_pow {p : ℕ} (hp : nat.prime p)
  {R} [comm_ring R] [is_domain R] {n m : ℕ} (hmn : m ≤ n)
  (h : irreducible (cyclotomic (p ^ n) R)) : irreducible (cyclotomic (p ^ m) R) :=
begin
  unfreezingI
  { rcases m.eq_zero_or_pos with rfl | hm,
    { simpa using irreducible_X_sub_C (1 : R) },
    obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le hmn,
    induction k with k hk },
  { simpa using h },
  have : m + k ≠ 0 := (add_pos_of_pos_of_nonneg hm k.zero_le).ne',
  rw [nat.add_succ, pow_succ', ←cyclotomic_expand_eq_cyclotomic hp $ dvd_pow_self p this] at h,
  exact hk (by linarith) (of_irreducible_expand hp.ne_zero h)
end

/-- If `irreducible (cyclotomic (p ^ n) R)` then `irreducible (cyclotomic p R).` -/
lemma cyclotomic_irreducible_of_irreducible_pow {p : ℕ} (hp : nat.prime p) {R} [comm_ring R]
  [is_domain R] {n : ℕ} (hn : n ≠ 0) (h : irreducible (cyclotomic (p ^ n) R)) :
  irreducible (cyclotomic p R) :=
pow_one p ▸ cyclotomic_irreducible_pow_of_irreducible_pow hp hn.bot_lt h

end expand

section char_p

/-- If `R` is of characteristic `p` and `¬p ∣ n`, then
`cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1)`. -/
lemma cyclotomic_mul_prime_eq_pow_of_not_dvd (R : Type*) {p n : ℕ} [hp : fact (nat.prime p)]
  [ring R] [char_p R p] (hn : ¬p ∣ n) : cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1) :=
begin
  suffices : cyclotomic (n * p) (zmod p) = (cyclotomic n (zmod p)) ^ (p - 1),
  { rw [← map_cyclotomic _ (algebra_map (zmod p) R), ← map_cyclotomic _ (algebra_map (zmod p) R),
      this, polynomial.map_pow] },
  apply mul_right_injective₀ (cyclotomic_ne_zero n $ zmod p),
  rw [←pow_succ, tsub_add_cancel_of_le hp.out.one_lt.le, mul_comm, ← zmod.expand_card],
  nth_rewrite 2 [← map_cyclotomic_int],
  rw [← map_expand, cyclotomic_expand_eq_cyclotomic_mul hp.out hn, polynomial.map_mul,
    map_cyclotomic, map_cyclotomic]
end

/-- If `R` is of characteristic `p` and `p ∣ n`, then
`cyclotomic (n * p) R = (cyclotomic n R) ^ p`. -/
lemma cyclotomic_mul_prime_dvd_eq_pow (R : Type*) {p n : ℕ} [hp : fact (nat.prime p)] [ring R]
  [char_p R p] (hn : p ∣ n) : cyclotomic (n * p) R = (cyclotomic n R) ^ p :=
begin
  suffices : cyclotomic (n * p) (zmod p) = (cyclotomic n (zmod p)) ^ p,
  { rw [← map_cyclotomic _ (algebra_map (zmod p) R), ← map_cyclotomic _ (algebra_map (zmod p) R),
      this, polynomial.map_pow] },
  rw [← zmod.expand_card, ← map_cyclotomic_int n, ← map_expand, cyclotomic_expand_eq_cyclotomic
    hp.out hn, map_cyclotomic, mul_comm]
end

/-- If `R` is of characteristic `p` and `¬p ∣ m`, then
`cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))`. -/
lemma cyclotomic_mul_prime_pow_eq (R : Type*) {p m : ℕ} [fact (nat.prime p)]
  [ring R] [char_p R p] (hm : ¬p ∣ m) :
  ∀ {k}, 0 < k → cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))
| 1 _ := by rw [pow_one, nat.sub_self, pow_zero, mul_comm,
  cyclotomic_mul_prime_eq_pow_of_not_dvd R hm]
| (a + 2) _ :=
begin
  have hdiv : p ∣ p ^ a.succ * m := ⟨p ^ a * m, by rw [← mul_assoc, pow_succ]⟩,
  rw [pow_succ, mul_assoc, mul_comm, cyclotomic_mul_prime_dvd_eq_pow R hdiv,
      cyclotomic_mul_prime_pow_eq a.succ_pos, ← pow_mul],
  congr' 1,
  simp only [tsub_zero, nat.succ_sub_succ_eq_sub],
  rw [nat.mul_sub_right_distrib, mul_comm, pow_succ']
end

/-- If `R` is of characteristic `p` and `¬p ∣ m`, then `ζ` is a root of `cyclotomic (p ^ k * m) R`
 if and only if it is a primitive `m`-th root of unity. -/
lemma is_root_cyclotomic_prime_pow_mul_iff_of_char_p {m k p : ℕ} {R : Type*} [comm_ring R]
  [is_domain R] [hp : fact (nat.prime p)] [hchar : char_p R p] {μ : R} [ne_zero (m : R)] :
  (polynomial.cyclotomic (p ^ k * m) R).is_root μ ↔ is_primitive_root μ m :=
begin
  rcases k.eq_zero_or_pos with rfl | hk,
  { rw [pow_zero, one_mul, is_root_cyclotomic_iff] },
  refine ⟨λ h, _, λ h, _⟩,
  { rw [is_root.def, cyclotomic_mul_prime_pow_eq R (ne_zero.not_char_dvd R p m) hk, eval_pow] at h,
    replace h := pow_eq_zero h,
    rwa [← is_root.def, is_root_cyclotomic_iff] at h },
  { rw [← is_root_cyclotomic_iff, is_root.def] at h,
    rw [cyclotomic_mul_prime_pow_eq R (ne_zero.not_char_dvd R p m) hk,
        is_root.def, eval_pow, h, zero_pow],
    simp only [tsub_pos_iff_lt],
    apply pow_strict_mono_right hp.out.one_lt (nat.pred_lt hk.ne') }
end

end char_p

end polynomial


import xenalib.Ellen_Arlt_matrix_rings algebra.group algebra.group_power init.algebra data.real.basic group_theory.subgroup data.complex.basic group_theory.coset

definition is_subgroup' {G : Type} [group G] (H : set G) := (1 : G) ∈ H ∧ (∀ g1 g2 : G, g1 ∈ H → g2 ∈ H → g1 * g2 ∈ H) ∧
∀ g : G, g ∈ H → g⁻¹ ∈ H
theorem groups_Sheet1_Q1(G:Type)[group G]: ∀(x:G), x=1 ↔ x*x=x:=
begin
intro x,
split ,
intro H1,
rw[H1],
exact mul_one 1,
intro H2,
have H3 : x*x =x*1,
rw[ mul_one x],
exact H2,
exact mul_left_cancel H3,
end
theorem groups_Sheet1_Q2a (G : Type) [group G] (H1 H2 : set G) : is_subgroup' H1 → is_subgroup' H2 → is_subgroup' (H1 ∩ H2) :=
begin
intro P1,
intro P2,
split,
{ split,
  exact P1.left,
  exact P2.left,
},
split,
{ intros g1 g2 Q1 Q2,
  split,
  exact P1.right.left g1 g2 Q1.left Q2.left,
  exact P2.right.left g1 g2 Q1.right Q2.right
},
intros g Hg,
split,
exact P1.right.right g Hg.1,
exact P2.2.2 g Hg.2,
end
variables {G : Type*} [group G]
variables (H1 H2 : set G)
--theorem groups_Sheet1_Q2b  : is_subgroup' H1 → is_subgroup' H2
def Real_excluding_neg_one: Type:= {x : ℝ  //  x ≠ -1}

instance : has_coe Real_excluding_neg_one ℝ :=
by unfold Real_excluding_neg_one; apply_instance

instance Q1 (G : Type) [group G] (H1 H2 : set G) [is_subgroup H1] [is_subgroup H2] :
is_submonoid (H1 ∩ H2) :=
{ one_mem := ⟨is_submonoid.one_mem H1,is_submonoid.one_mem H2⟩,
  mul_mem := λ a b Ha Hb,⟨(is_submonoid.mul_mem Ha.1 Hb.1 : a * b ∈ H1),(is_submonoid.mul_mem Ha.2 Hb.2 : a * b ∈ H2)⟩
}

theorem Q1' (G : Type) [group G] (H1 H2 : set G) [is_subgroup H1] [is_subgroup H2] :
is_subgroup (H1 ∩ H2) :=
{
  inv_mem := λ a Ha,⟨is_subgroup.inv_mem Ha.left,is_subgroup.inv_mem Ha.right⟩
}

definition Q0 : add_group ℤ := by apply_instance

definition D : group ℤ :=
{ mul := λ x y, x + y,
  mul_assoc := add_assoc,
  one := 0,
  one_mul := zero_add,
  mul_one := add_zero,
  inv := λ x, -x,
  mul_left_inv := λ n, begin
    show -n + n = 0,
    exact neg_add_self n,
  end
}

def mulR : Real_excluding_neg_one → Real_excluding_neg_one → Real_excluding_neg_one :=
λ x y, ⟨(x : ℝ) + y + x * y, begin
assume H1: (x:ℝ) +y + x*y = -1,
rw eq_neg_iff_add_eq_zero at H1,
have H2: (x:ℝ) + x*y +y+1=0,
rw[← H1], simp,
have H3: (x:ℝ) *(1 +y) + y+1=0,
rw[left_distrib],
rw[ mul_one (x:ℝ )],
exact H2,
have H4: ((x:ℝ) +1)*(1 +y) =0 ,
rw[right_distrib],
rw[ add_assoc] at H3,
rw[add_comm (y:ℝ ) 1] at H3,
rw[one_mul ],
exact H3,
have H5: (x:ℝ)+1 =0 ∨ 1+ (y:ℝ ) =0,
exact mul_eq_zero.1 H4,
cases H5,
have H6 : (x:ℝ) =-1,
rw[add_eq_zero_iff_eq_neg.1 H5],
exact x.2 H6,
have H7 : (y:ℝ) + 1 =0,
rw[add_comm],
exact H5,
have H8 : (y:ℝ) = -1,
rw[add_eq_zero_iff_eq_neg.1 H7],
exact y.2 H8,
 end⟩
 def invR: Real_excluding_neg_one → Real_excluding_neg_one:= λ x, ⟨ -(x:ℝ )*(x+1)⁻¹, begin
assume H1: - (x:ℝ )*(x+1)⁻¹  = -1,
have H2: (x:ℝ )+1 ≠ 0,
assume A1: (x:ℝ) +1 =0,
have A2: (x:ℝ ) =-1,
rw[add_eq_zero_iff_eq_neg.1 A1],
exact x.2 A2,
rw[← domain.mul_left_inj ( show (x:ℝ) +1  ≠  0, by exact H2 )] at H1,
rw[ mul_comm (-x:ℝ )  ((x + 1)⁻¹)] at H1,
rw[← mul_assoc] at H1,
rw[← div_eq_mul_inv] at H1,
--have A3 : (x:ℝ ) ≠ -1,
--exact x.2,
rw [div_self H2] at H1,
rw[right_distrib] at H1,
rw[one_mul] at H1,
rw[one_mul] at H1,
rw[mul_neg_one] at H1,
conv at H1 {to_lhs, rw [← add_zero (-x:ℝ )]},
have H2: (0:ℝ ) = -1,
exact add_left_cancel H1,
have H3: (0 :ℝ )≠ - 1,
norm_num,
exact H3 H2,
end⟩
definition D : group Real_excluding_neg_one  :=
{ mul := mulR,
 mul_assoc:=
 begin
intros a b c,
show mulR (mulR a b) c = mulR a (mulR b c),
unfold mulR,simp,ring,
end,
one:= ⟨ 0 , by norm_num⟩,
one_mul:=
begin
intro a,
unfold mulR,
simp,
end,
mul_one:=
begin
intro a,
show mulR a ⟨0, _⟩  = a,
unfold mulR,
simp,
end,
inv:= invR,
mul_left_inv :=
begin
intro a,
show mulR (invR a) a = _,
unfold mulR,
unfold invR,
simp,
exact calc

end

}


/-

POINTS: Welcome to the first CS2102 exam. The exam has 11 questions

and one extra credit question. The first two questions are worth 5

points each. The rest (but for the extra credit) are worth 10 points

each, making a total of 100. The extra credit is worth an addition

5 points.

ORGANIZATION: The sections of the exam are labelled and organized

around the inference rules we've covered so far: rules for equality,

conjunction, implications, functions, and negations. That said,

there is some mixing of these issues across the sections.

WHAT TO DO: Complete the exam by following the instructions for

each question. Save your file then upload the completed and saved

file to Collab. You have exactly 75 minutes from the start of the

exam to the time where it must be uploaded to Collab.

OPEN NOTES: You may use the class notes for this exam, whether

provided to you by the instructors or taken by you (or for you).

STRICTLY INDIVIDUAL EFFORT: This is a strictly individual exam,

taken under the honor system. Do not communicate with anyone except

for the instructor about the content of this exam, by any means,

until you are absoluately sure that each person you are communicating

with has already completed it.

-/

/-

Write your name and UVa email ID here and acknowledge that you understand

that this exam is an individual exam and that the Honor System is in effect

for this exam (write "I acknowledge it.")

Name:

Email id:

Acknowledge that the Honor System norms and rules apply:

Now proceed to take the exam!

-/

/- ********************************** -/

/- ** PROOFS INVOLVING EQUALITY ** -/

/- ********************************** -/

/-

#1 - 5 points

Prove that for any type, T, and for any two values, a and b, of type T,

if you assume that there is a proof of a = b (or if you are given such a

proof), then you can derive a proof of b = a. To be precise, what you are to

prove is this: ∀ T : Type, ∀ a b : T, a = b → b = a.

To prove it, you will present a function that, given a type T, two values, a

and b, of type T, and a proof of a = b, returns a proof of b = a.

We give you most of such a function definition, below. Your challenge is to

write the function "body" in place of the sorry. It should be an expression

that evalutes to a proof of b = a. Hint: how do you get a proof of b = a from

a proof, pf, of a = b?

-/

def from_a_eq_b_prove_b_eq_a (T:
Type) (a b : T) (pf : a = b) : b = a
:= eq.symm pf

#check from_a_eq_b_prove_b_eq_a : ∀ (T : Type) (a b : T), a = b → b = a

/-

#2 - 5 points

Here you are asked to prove the same proposition, but now the function type

is writen as, ∀ (T : Type), ∀ (a b : T), a = b → b = a. Give your answer by

replacing the sorry with the required lambda expression.

Hint: A lambda expression is written as lambda followed immediately by the

names of one or more arguments, followed by a comma, followed by the body of

the function that is being defined.

Hint: the function you are to define has the same arguments in the same order

as the function you defined above!

-/

def from_a_eq_b_prove_b_eq_a' : ∀ (T :
Type), ∀ (a b : T), a = b → b = a :=

λ T a b pf, eq.symm pf

/- ************************************** -/

/- *** PROOFS INVOLVING CONJUNCTIONS *** -/

/- ************************************** -/

/-

For the questions that follow, assume that P, Q, and R are propositions. We

make these assumptions explicit using the following "variables" declaration.

-/

variables P Q R : Prop

/-

#3 - 10 points

Given that we've assumed and defined P, Q, and R are arbitrary propositions,

prove that P → Q → P ∧ Q. Do it by replacing the sorry with either a lambda

expression or a tactic script in the following code.

-/

theorem t1 : P → Q → P ∧ Q :=

λ p q, and.intro p q

theorem t1' : P → Q → P ∧ Q :=

begin

assume p q,

show P ∧ Q,

from and.intro p q

end

/-

#4 - 10 points

Prove that (P ∧ Q) → (Q ∧ P). This implication basically states that

conjunction is commutative. You will prove it by first assuming that you have

a proof of P ∧ Q and by then showing that you can construct a proof of Q ∧ P.

To complete the proof,replace the sorry with either a lambda expression or a

tactic script as you prefer. Hint: remember the introduction and elimination

rules for conjunctions.

-/

theorem t2 : (P ∧ Q) → (Q ∧ P) :=

λ (pf : P ∧ Q), and.intro pf.right pf.left

-- SULLIVAN: Was answer included in distributed exam?

/- ************************************** -/

/- *** PROOFS INVOLVING IMPLICATIONS *** -/

/- ************************************** -/

/-

#5 - 10 points

Prove that (P → Q) → (Q → R) → (P → R). This proposition claims that

implication is transitive (which it is).

Hint #1: assume that you have a proof of (P → Q). Then assume that you have a

proof of (Q → R). Then, in the context of these two assumptions, show that

you can construct a proof of P → R.

Hint #2: To prove P → R, assume that you have a proof of P and show that you

can construct a proof of R.

Hint #3: Proofs of implications can be used to convert proofs of premises

into proofs of conclusions. Think modus ponens.

You can use a lambda expression, tactics, or even a mixture of the two --

whatever you prefer -- to give your answer.

-/

theorem arrow_trans : (P → Q) → (Q → R) → (P → R) :=

λ pq qr,

λ p,

qr (pq p)

theorem arrow_trans' : (P → Q) → (Q → R) → (P → R) :=

begin

assume pq qr,

show P → R,

from

assume p,

show R,

from qr (pq p)

end

/- *************************** -/

/- *** DEFINING FUNCTIONS *** -/

/- *************************** -/

/-

#6 - 10 points

Complete the following definition of a function, square, that takes a natural

number as an argument and that returns the square of that argument as a

result. Give your answer by replacing sorry in the code that follows with

your code.

-/

-- Your answer goes here

def square (n : nat) : nat :=

n * n

/-

#7 - 10 points

Give an alternative implementation of square, here called square', by

replacing the sorry with a lambda expression in the following code.

-/

def square' : ℕ → ℕ :=

λ n, n * n

/-

#8 - 10 points

Write a function, quad, that takes four natural numbers, a, b, c, and x, and

that returns a * x * x + b * x + c. Thus function, quad, is thus to take the

coefficients of a general quadratic function and evaluate it at the value given by x. Use a lambda expression.

Hint, such a function takes four ℕ values as arguments and returns a fifth ℕ

value as a result. Make sure you have the right number of ℕ's when you

declare the type of quad as something like this: def quad : ℕ → ℕ → ...

-/

def quad (a b c x: ℕ) : ℕ :=

a * x^2 + b * x + c

theorem quadRight : quad = λ a b c x, a * x^2 + b * x + c := rfl

/- *********************************** -/

/- *** PROOFS INVOLVING NEGATIONS *** -/

/- *********************************** -/

/-

#9 - 10 points

Given that we've already assumed (above) that Q is some arbitrary (any)

proposition, construct a proof, call it noContra, that (Q ∧ ¬ Q) → false.

Your answer will start like this: theorem noContra : (Q ∧ ¬ Q) → false :=

-/

theorem noContra : (Q ∧ ¬ Q) → false :=

begin

assume contra,

show false,

from contra.right contra.left

end

/-

#10 - 10 points

Construct a proof, call it contraPos, that (P → Q) → (¬ Q → ¬ P).

You can make sense of this proposition using the "rain/wet" example.

If it's true that "if it's raining then the streets are wet" then its

true that if the streets are not wet it, then it is not raining.

Hint: as you can see plainly, this is an implication. Structure you proof

accordingly. What do you assume to begin and what do you then need to show?

If what you need to show is itself an implication, follow the same strategy!

Assume that you have proof of the premise and show (in the context of all of

the assumptions you've made) that you can construct a proof of the conclusion.

-/

theorem contraPos : (P → Q) → (¬ Q → ¬ P) :=

begin

assume pq,

show ¬ Q → ¬ P,

from

assume nq: ¬ Q,

show ¬ P,

from

assume p : P,

show false,

from nq (pq p)

end

/-

#11 -- 10 points

Using at most a few sentence in English, give concise answers to the

following two questions.

#11a: In a few words (within this comment block) explain the strategy of

proof by negation. Clearly state the form of the goal to be proved and how

exactly one proceeds to use proof by negation to prove it.

YOUR ANSWER HERE: Proof by negation is used to prove a proposition of the

form ¬ P. To use this strategy, one assumes P and shows that that leads to

a contradiction. (This shows that P → false which is the definition of ¬ P).

#11b:

In a few words (within this comment block) explain the strategy of proof by

contradiction. Clearly state the form of the goal to be proved and how

exactly one proceeds to use proof by contradiction to prove it. In addition,

explain why (classical) double negation elimination is essential to enabling

proof by contradiction.

YOUR ANSWER HERE: Proof by contradiction is used to prove a proposition of

the form P. To use it, one assumes ¬ P and shows that doing so leads to a

contradiction. This proves ¬ ¬ P, which, in classical logic also proves P.

-/

/-

EXTRA CREDIT -- 5 points: In Lean write an axiom, called double_negation_elim,

that tells lean to accept double negation elimination as a valid inference

rule without a proof of validity.

-/

axiom double_negation_elim : ∀ P :
Prop, ¬ ¬ P → P.


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Theory of complete Boolean algebras.
-/
import order.complete_lattice order.boolean_algebra data.set.basic

set_option old_structure_cmd true

universes u v w
variables {α : Type u} {β : Type v} {ι : Sort w}

namespace lattice

/-- A complete distributive lattice is a bit stronger than the name might
  suggest; perhaps completely distributive lattice is more descriptive,
  as this class includes a requirement that the lattice join
  distribute over *arbitrary* infima, and similarly for the dual. -/
class complete_distrib_lattice α extends complete_lattice α :=
(infi_sup_le_sup_Inf : ∀a s, (⨅ b ∈ s, a ⊔ b) ≤ a ⊔ Inf s)
(inf_Sup_le_supr_inf : ∀a s, a ⊓ Sup s ≤ (⨆ b ∈ s, a ⊓ b))

section complete_distrib_lattice
variables [complete_distrib_lattice α] {a b : α} {s t : set α}

theorem sup_Inf_eq : a ⊔ Inf s = (⨅ b ∈ s, a ⊔ b) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume h, sup_le_sup (le_refl _) (Inf_le h))
  (complete_distrib_lattice.infi_sup_le_sup_Inf _ _)

theorem Inf_sup_eq : Inf s ⊔ b = (⨅ a ∈ s, a ⊔ b) :=
by simpa [sup_comm] using @sup_Inf_eq α _ b s

theorem inf_Sup_eq : a ⊓ Sup s = (⨆ b ∈ s, a ⊓ b) :=
le_antisymm
  (complete_distrib_lattice.inf_Sup_le_supr_inf _ _)
  (supr_le $ assume i, supr_le $ assume h, inf_le_inf (le_refl _) (le_Sup h))

theorem Sup_inf_eq : Sup s ⊓ b = (⨆ a ∈ s, a ⊓ b) :=
by simpa [inf_comm] using @inf_Sup_eq α _ b s

theorem Inf_sup_Inf : Inf s ⊔ Inf t = (⨅p ∈ set.prod s t, (p : α × α).1 ⊔ p.2) :=
begin
  apply le_antisymm,
  { finish },
  { have : ∀ a ∈ s, (⨅p ∈ set.prod s t, (p : α × α).1 ⊔ p.2) ≤ a ⊔ Inf t,
    { assume a ha,
      have : (⨅p ∈ set.prod s t, ((p : α × α).1 : α) ⊔ p.2) ≤
             (⨅p ∈ prod.mk a '' t, (p : α × α).1 ⊔ p.2),
      { apply infi_le_infi_of_subset,
        rintros ⟨x, y⟩,
        simp only [and_imp, set.mem_image, prod.mk.inj_iff, set.prod_mk_mem_set_prod_eq,
                   exists_imp_distrib],
        assume x' x't ax x'y,
        rw [← x'y, ← ax],
        simp [ha, x't] },
      rw [infi_image] at this,
      simp only [] at this,
      rwa ← sup_Inf_eq at this },
    calc (⨅p ∈ set.prod s t, (p : α × α).1 ⊔ p.2) ≤ (⨅a∈s, a ⊔ Inf t) : by simp; exact this
       ... = Inf s ⊔ Inf t : Inf_sup_eq.symm }
end

theorem Sup_inf_Sup : Sup s ⊓ Sup t = (⨆p ∈ set.prod s t, (p : α × α).1 ⊓ p.2) :=
begin
  apply le_antisymm,
  { have : ∀ a ∈ s, a ⊓ Sup t ≤ (⨆p ∈ set.prod s t, (p : α × α).1 ⊓ p.2),
    { assume a ha,
      have : (⨆p ∈ prod.mk a '' t, (p : α × α).1 ⊓ p.2)
             ≤ (⨆p ∈ set.prod s t, ((p : α × α).1 : α) ⊓ p.2),
      { apply supr_le_supr_of_subset,
        rintros ⟨x, y⟩,
        simp only [and_imp, set.mem_image, prod.mk.inj_iff, set.prod_mk_mem_set_prod_eq,
                   exists_imp_distrib],
        assume x' x't ax x'y,
        rw [← x'y, ← ax],
        simp [ha, x't] },
      rw [supr_image] at this,
      simp only [] at this,
      rwa ← inf_Sup_eq at this },
    calc Sup s ⊓ Sup t = (⨆a∈s, a ⊓ Sup t) : Sup_inf_eq
      ... ≤ (⨆p ∈ set.prod s t, (p : α × α).1 ⊓ p.2) : by simp; exact this },
  { finish }
end

end complete_distrib_lattice

instance [d : complete_distrib_lattice α] : bounded_distrib_lattice α :=
{ le_sup_inf := assume x y z,
    calc (x ⊔ y) ⊓ (x ⊔ z) ≤ (⨅ b ∈ ({z, y} : set α), x ⊔ b) :
        by simp [or_imp_distrib] {contextual := tt}
      ... = x ⊔ Inf {z, y} : sup_Inf_eq.symm
      ... = x ⊔ y ⊓ z : by rw insert_of_has_insert; simp,
  ..d }

/-- A complete boolean algebra is a completely distributive boolean algebra. -/
class complete_boolean_algebra α extends boolean_algebra α, complete_distrib_lattice α

section complete_boolean_algebra
variables [complete_boolean_algebra α] {a b : α} {s : set α} {f : ι → α}

theorem neg_infi : - infi f = (⨆i, - f i) :=
le_antisymm
  (neg_le_of_neg_le $ le_infi $ assume i, neg_le_of_neg_le $ le_supr (λi, - f i) i)
  (supr_le $ assume i, neg_le_neg $ infi_le _ _)

theorem neg_supr : - supr f = (⨅i, - f i) :=
neg_eq_neg_of_eq (by simp [neg_infi])

theorem neg_Inf : - Inf s = (⨆i∈s, - i) :=
by simp [Inf_eq_infi, neg_infi]

theorem neg_Sup : - Sup s = (⨅i∈s, - i) :=
by simp [Sup_eq_supr, neg_supr]

end complete_boolean_algebra

end lattice