/-
Copyright (c) 2022 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import combinatorics.simple_graph.connectivity
import data.nat.parity

/-!

# Trails and Eulerian trails

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

This module contains additional theory about trails, including Eulerian trails (also known
as Eulerian circuits).

## Main definitions

* `simple_graph.walk.is_eulerian` is the predicate that a trail is an Eulerian trail.
* `simple_graph.walk.is_trail.even_countp_edges_iff` gives a condition on the number of edges
  in a trail that can be incident to a given vertex.
* `simple_graph.walk.is_eulerian.even_degree_iff` gives a condition on the degrees of vertices
  when there exists an Eulerian trail.
* `simple_graph.walk.is_eulerian.card_odd_degree` gives the possible numbers of odd-degree
  vertices when there exists an Eulerian trail.

## Todo

* Prove that there exists an Eulerian trail when the conclusion to
  `simple_graph.walk.is_eulerian.card_odd_degree` holds.

## Tags

Eulerian trails

-/

namespace simple_graph
variables {V : Type*} {G : simple_graph V}

namespace walk

/-- The edges of a trail as a finset, since each edge in a trail appears exactly once. -/
@[reducible] def is_trail.edges_finset {u v : V} {p : G.walk u v}
  (h : p.is_trail) : finset (sym2 V) :=
⟨p.edges, h.edges_nodup⟩

variables [decidable_eq V]

lemma is_trail.even_countp_edges_iff {u v : V} {p : G.walk u v} (ht : p.is_trail) (x : V) :
  even (p.edges.countp (λ e, x ∈ e)) ↔ (u ≠ v → x ≠ u ∧ x ≠ v) :=
begin
  induction p with u u v w huv p ih,
  { simp, },
  { rw [cons_is_trail_iff] at ht,
    specialize ih ht.1,
    simp only [list.countp_cons, ne.def, edges_cons, sym2.mem_iff],
    split_ifs with h,
    { obtain (rfl | rfl) := h,
      { rw [nat.even_add_one, ih],
        simp only [huv.ne, imp_false, ne.def, not_false_iff, true_and, not_forall, not_not,
          exists_prop, eq_self_iff_true, not_true, false_and, and_iff_right_iff_imp],
        rintro rfl rfl,
        exact G.loopless _ huv, },
      { rw [nat.even_add_one, ih, ← not_iff_not],
        simp only [huv.ne.symm, ne.def, eq_self_iff_true, not_true, false_and, not_forall,
          not_false_iff, exists_prop, and_true, not_not, true_and, iff_and_self],
        rintro rfl,
        exact huv.ne, } },
    { rw not_or_distrib at h,
      simp only [h.1, h.2, not_false_iff, true_and, add_zero, ne.def] at ih ⊢,
      rw ih,
      split;
      { rintro h' h'' rfl,
        simp only [imp_false, eq_self_iff_true, not_true, not_not] at h',
        cases h',
        simpa using h } } },
end

/-- An *Eulerian trail* (also known as an "Eulerian path") is a walk
`p` that visits every edge exactly once.  The lemma `simple_graph.walk.is_eulerian.is_trail` shows
that these are trails.

Combine with `p.is_circuit` to get an Eulerian circuit (also known as an "Eulerian cycle"). -/
def is_eulerian {u v : V} (p : G.walk u v) : Prop :=
∀ e, e ∈ G.edge_set → p.edges.count e = 1

lemma is_eulerian.mem_edges_iff {u v : V} {p : G.walk u v} (h : p.is_eulerian) {e : sym2 V} :
  e ∈ p.edges ↔ e ∈ G.edge_set :=
⟨λ h, p.edges_subset_edge_set h, λ he, by simpa using (h e he).ge⟩

/-- The edge set of an Eulerian graph is finite. -/
def is_eulerian.fintype_edge_set {u v : V} {p : G.walk u v}
  (h : p.is_eulerian) : fintype G.edge_set :=
fintype.of_finset h.is_trail.edges_finset $ λ e,
by simp only [finset.mem_mk, multiset.mem_coe, h.mem_edges_iff]

lemma is_trail.is_eulerian_of_forall_mem {u v : V} {p : G.walk u v}
  (h : p.is_trail) (hc : ∀ e, e ∈ G.edge_set → e ∈ p.edges) :
  p.is_eulerian :=
λ e he, list.count_eq_one_of_mem h.edges_nodup (hc e he)

lemma is_eulerian_iff {u v : V} (p : G.walk u v) :
  p.is_eulerian ↔ p.is_trail ∧ ∀ e, e ∈ G.edge_set → e ∈ p.edges :=
begin
  split,
  { intro h,
    exact ⟨h.is_trail, λ _, h.mem_edges_iff.mpr⟩, },
  { rintro ⟨h, hl⟩,
    exact h.is_eulerian_of_forall_mem hl, },
end

lemma is_eulerian.edges_finset_eq [fintype G.edge_set]
  {u v : V} {p : G.walk u v} (h : p.is_eulerian) :
  h.is_trail.edges_finset = G.edge_finset :=
by { ext e, simp [h.mem_edges_iff] }

lemma is_eulerian.even_degree_iff {x u v : V} {p : G.walk u v} (ht : p.is_eulerian)
  [fintype V] [decidable_rel G.adj] :
  even (G.degree x) ↔ (u ≠ v → x ≠ u ∧ x ≠ v) :=
begin
  convert ht.is_trail.even_countp_edges_iff x,
  rw [← multiset.coe_countp, multiset.countp_eq_card_filter, ← card_incidence_finset_eq_degree],
  change multiset.card _ = _,
  congr' 1,
  convert_to _ = (ht.is_trail.edges_finset.filter (has_mem.mem x)).val,
  rw [ht.edges_finset_eq, G.incidence_finset_eq_filter x],
end

lemma is_eulerian.card_filter_odd_degree [fintype V] [decidable_rel G.adj]
  {u v : V} {p : G.walk u v} (ht : p.is_eulerian)
  {s} (h : s = (finset.univ : finset V).filter (λ v, odd (G.degree v))) :
  s.card = 0 ∨ s.card = 2 :=
begin
  subst s,
  simp only [nat.odd_iff_not_even, finset.card_eq_zero],
  simp only [ht.even_degree_iff, ne.def, not_forall, not_and, not_not, exists_prop],
  obtain (rfl | hn) := eq_or_ne u v,
  { left,
    simp, },
  { right,
    convert_to _ = ({u, v} : finset V).card,
    { simp [hn], },
    { congr',
      ext x,
      simp [hn, imp_iff_not_or], } },
end

lemma is_eulerian.card_odd_degree [fintype V] [decidable_rel G.adj]
  {u v : V} {p : G.walk u v} (ht : p.is_eulerian) :
  fintype.card {v : V | odd (G.degree v)} = 0 ∨ fintype.card {v : V | odd (G.degree v)} = 2 :=
begin
  rw ← set.to_finset_card,
  apply is_eulerian.card_filter_odd_degree ht,
  ext v,
  simp,
end

end walk

end simple_graph


import .lovelib

/- # LoVe Homework 11: Logical Foundations of Mathematics

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1 (9 points): Multisets as a Quotient Type

A multiset (or bag) is a collection of elements that allows for multiple
(but finitely many) occurrences of its elements. For example, the multiset
`{2, 7}` is equal to the multiset `{7, 2}` but different from `{2, 7, 7}`.

Finite multisets can be defined as a quotient over lists. We start with the
type `list α` of finite lists and consider only the number of occurrences of
elements in the lists, ignoring the order in which elements occur. Following
this scheme, `[2, 7, 7]`, `[7, 2, 7]`, and `[7, 7, 2]` would be three equally
valid representations of the multiset `{2, 7, 7}`.

The `list.count` function returns the number of occurrences of an element in a
list. Since it uses equality on elements of type `α`, it requires `α` to belong
to the `decidable_eq` type class. For this reason, the definitions and lemmas
below all take `[decidable_eq α]` as type class argument.

1.1 (1 point). Provide the missing proof below. -/

@[instance] def multiset.rel (α : Type) [decidable_eq α] : setoid (list α) :=
{ r     := λas bs, ∀x, list.count x as = list.count x bs,
  iseqv :=
    sorry }

/- 1.2 (1 point). Define the type of multisets as the quotient over the
relation `multiset.rel`. -/

def multiset (α : Type) [decidable_eq α] : Type :=
sorry

/- 1.3 (3 points). Now we have a type `multiset α` but no operations on it.
Basic operations on multisets include the empty multiset (`∅`), the singleton
multiset (`{x} `for any element `x`), and the sum of two multisets (`A ⊎ B` for
any multisets `A` and `B`). The sum should be defined so that the multiplicities
of elements are added; thus, `{2} ⊎ {2, 2} = {2, 2, 2}`.

Fill in the `sorry` placeholders below to implement the basic multiset
operations. -/

def multiset.empty {α : Type} [decidable_eq α] : multiset α :=
sorry

def multiset.singleton {α : Type} [decidable_eq α] (a : α) : multiset α :=
sorry

def multiset.union {α : Type} [decidable_eq α] :
  multiset α → multiset α → multiset α :=
quotient.lift₂
  sorry
  sorry

/- 1.4 (4 points). Prove that `multiset.union` is commutative and associative,
and has `multiset.empty` as identity element. -/

lemma multiset.union_comm {α : Type} [decidable_eq α] (A B : multiset α) :
  multiset.union A B = multiset.union B A :=
sorry

lemma multiset.union_assoc {α : Type} [decidable_eq α] (A B C : multiset α) :
  multiset.union (multiset.union A B) C =
  multiset.union A (multiset.union B C) :=
sorry

lemma multiset.union_iden_left {α : Type} [decidable_eq α] (A : multiset α) :
  multiset.union multiset.empty A = A :=
sorry

lemma multiset.union_iden_right {α : Type} [decidable_eq α] (A : multiset α) :
  multiset.union A multiset.empty = A :=
sorry

/- ## Question 2 (2 bonus points): Nonempty Types

In the lecture, we saw the inductive predicate `nonempty` that states that a
type has at least one element: -/

#print nonempty

/- The purpose of this question is to think about what would happen if all
types had at least one element. To investigate this, we introduce this fact as
an axiom as follows. Introducing axioms should be generally avoided or done
with great care, since they can easily lead to contradictions, as we will
see. -/

axiom Sort_nonempty (α : Sort _) :
  nonempty α

/- This axiom gives us a lemma `Sort_nonempty` admitted with no proof. It
resembles a lemma proved by `sorry`, just without the warning. -/

#check Sort_nonempty

/- 2.1 (1 bonus point). Prove that this axiom leads to a contradiction, i.e.,
lets us derive `false`. -/

lemma proof_of_false :
  false :=
sorry

/- 2.2 (1 bonus point). Prove that even the following weaker axiom leads to a
contradiction. Of course, you may not use the axiom or the lemma from 3.1.

Hint: Subtypes can help. -/

axiom Type_nonempty (α : Type _) :
  nonempty α

lemma proof_of_false₂ :
  false :=
sorry

end LoVe


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

/-!
# The General Linear group $GL(n, R)$
This file defines the elements of the General Linear group `general_linear_group n R`,
consisting of all invertible `n` by `n` `R`-matrices.
## Main definitions
* `matrix.general_linear_group` is the type of matrices over R which are units in the matrix ring.
* `matrix.GL_pos` gives the subgroup of matrices with
  positive determinant (over a linear ordered ring).
## Tags
matrix group, group, matrix inverse
-/

namespace matrix
universes u v
open_locale matrix
open linear_map

/-- `GL n R` is the group of `n` by `n` `R`-matrices with unit determinant.
Defined as a subtype of matrices-/
abbreviation general_linear_group (n : Type u) (R : Type v)
  [decidable_eq n] [fintype n] [comm_ring R] : Type* := (matrix n n R)ˣ

notation `GL` := general_linear_group

namespace general_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

/-- The determinant of a unit matrix is itself a unit. -/
@[simps]
def det : GL n R →* Rˣ :=
{ to_fun := λ A,
  { val := (↑A : matrix n n R).det,
    inv := (↑(A⁻¹) : matrix n n R).det,
    val_inv := by rw [←det_mul, ←mul_eq_mul, A.mul_inv, det_one],
    inv_val := by rw [←det_mul, ←mul_eq_mul, A.inv_mul, det_one]},
  map_one' := units.ext det_one,
  map_mul' := λ A B, units.ext $ det_mul _ _ }

/--The `GL n R` and `general_linear_group R n` groups are multiplicatively equivalent-/
def to_lin : (GL n R) ≃* (linear_map.general_linear_group R (n → R)) :=
units.map_equiv to_lin_alg_equiv'.to_mul_equiv

/--Given a matrix with invertible determinant we get an element of `GL n R`-/
def mk' (A : matrix n n R) (h : invertible (matrix.det A)) : GL n R :=
unit_of_det_invertible A

/--Given a matrix with unit determinant we get an element of `GL n R`-/
noncomputable def mk'' (A : matrix n n R) (h : is_unit (matrix.det A)) : GL n R :=
nonsing_inv_unit A h

/--Given a matrix with non-zero determinant over a field, we get an element of `GL n K`-/
def mk_of_det_ne_zero {K : Type*} [field K] (A : matrix n n K) (h : matrix.det A ≠ 0) :
  GL n K :=
mk' A (invertible_of_nonzero h)

instance coe_fun : has_coe_to_fun (GL n R) (λ _, n → n → R) :=
{ coe := λ A, A.val }

lemma ext_iff (A B : GL n R) : A = B ↔ (∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :=
units.ext_iff.trans matrix.ext_iff.symm

/-- Not marked `@[ext]` as the `ext` tactic already solves this. -/
lemma ext ⦃A B : GL n R⦄ (h : ∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :
  A = B :=
units.ext $ matrix.ext h

section coe_lemmas

variables (A B : GL n R)

@[simp] lemma coe_fn_eq_coe : ⇑A = (↑A : matrix n n R) := rfl

@[simp] lemma coe_mul : ↑(A * B) = (↑A : matrix n n R) ⬝ (↑B : matrix n n R) := rfl

@[simp] lemma coe_one : ↑(1 : GL n R) = (1 : matrix n n R) := rfl

lemma coe_inv : ↑(A⁻¹) = (↑A : matrix n n R)⁻¹ :=
begin
  letI := A.invertible,
  exact inv_of_eq_nonsing_inv (↑A : matrix n n R),
end

/-- An element of the matrix general linear group on `(n) [fintype n]` can be considered as an
element of the endomorphism general linear group on `n → R`. -/
def to_linear : general_linear_group n R ≃* linear_map.general_linear_group R (n → R) :=
units.map_equiv matrix.to_lin_alg_equiv'.to_ring_equiv.to_mul_equiv

-- Note that without the `@` and `‹_›`, lean infers `λ a b, _inst_1 a b` instead of `_inst_1` as the
-- decidability argument, which prevents `simp` from obtaining the instance by unification.
-- These `λ a b, _inst a b` terms also appear in the type of `A`, but simp doesn't get confused by
-- them so for now we do not care.
@[simp] lemma coe_to_linear :
  (@to_linear n ‹_› ‹_› _ _ A : (n → R) →ₗ[R] (n → R)) = matrix.mul_vec_lin A :=
rfl

@[simp] lemma to_linear_apply (v : n → R) :
  (@to_linear n ‹_› ‹_› _ _ A) v = matrix.mul_vec_lin A v :=
rfl

end coe_lemmas

end general_linear_group

namespace special_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]

instance has_coe_to_general_linear_group : has_coe (special_linear_group n R) (GL n R) :=
⟨λ A, ⟨↑A, ↑(A⁻¹), congr_arg coe (mul_right_inv A), congr_arg coe (mul_left_inv A)⟩⟩

end special_linear_group

section

variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]

section
variables (n R)

/-- This is the subgroup of `nxn` matrices with entries over a
linear ordered ring and positive determinant. -/
def GL_pos : subgroup (GL n R) :=
(units.pos_subgroup R).comap general_linear_group.det
end

@[simp] lemma mem_GL_pos (A : GL n R) : A ∈ GL_pos n R ↔ 0 < (A.det : R) := iff.rfl
end

section has_neg

variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]
[fact (even (fintype.card n))]

/-- Formal operation of negation on general linear group on even cardinality `n` given by negating
each element. -/
instance : has_neg (GL_pos n R) :=
⟨λ g,
   ⟨- g,
  begin
    simp only [mem_GL_pos, general_linear_group.coe_det_apply, units.coe_neg],
    have := det_smul g (-1),
    simp only [general_linear_group.coe_fn_eq_coe, one_smul, coe_fn_coe_base', neg_smul] at this,
    rw this,
    simp [nat.neg_one_pow_of_even (fact.out (even (fintype.card n)))],
    have gdet := g.property,
    simp only [mem_GL_pos, general_linear_group.coe_det_apply, subtype.val_eq_coe] at gdet,
    exact gdet,
  end⟩⟩

@[simp] lemma GL_pos_coe_neg (g : GL_pos n R) : ↑(- g) = - (↑g : matrix n n R) :=
rfl

@[simp]lemma GL_pos_neg_elt (g : GL_pos n R): ∀ i j, ( ↑(-g): matrix n n R) i j= - (g i j):=
begin
  simp [coe_fn_coe_base'],
end

end has_neg

namespace special_linear_group

variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [linear_ordered_comm_ring R]

/-- `special_linear_group n R` embeds into `GL_pos n R` -/
def to_GL_pos : special_linear_group n R →* GL_pos n R :=
{ to_fun := λ A, ⟨(A : GL n R), show 0 < (↑A : matrix n n R).det, from A.prop.symm ▸ zero_lt_one⟩,
  map_one' := subtype.ext $ units.ext $ rfl,
  map_mul' := λ A₁ A₂, subtype.ext $ units.ext $ rfl }

instance : has_coe (special_linear_group n R) (GL_pos n R) := ⟨to_GL_pos⟩

lemma coe_eq_to_GL_pos : (coe : special_linear_group n R → GL_pos n R) = to_GL_pos := rfl

lemma to_GL_pos_injective :
  function.injective (to_GL_pos : special_linear_group n R → GL_pos n R) :=
(show function.injective ((coe : GL_pos n R → matrix n n R) ∘ to_GL_pos),
 from subtype.coe_injective).of_comp

end special_linear_group

section examples

/-- The matrix [a, b; -b, a] (inspired by multiplication by a complex number); it is an element of
$GL_2(R)$ if `a ^ 2 + b ^ 2` is nonzero. -/
@[simps coe {fully_applied := ff}]
def plane_conformal_matrix {R} [field R] (a b : R) (hab : a ^ 2 + b ^ 2 ≠ 0) :
  matrix.general_linear_group (fin 2) R :=
general_linear_group.mk_of_det_ne_zero ![![a, -b], ![b, a]]
  (by simpa [det_fin_two, sq] using hab)

/- TODO: Add Iwasawa matrices `n_x=![![1,x],![0,1]]`, `a_t=![![exp(t/2),0],![0,exp(-t/2)]]` and
  `k_θ==![![cos θ, sin θ],![-sin θ, cos θ]]`
-/

end examples

end matrix


import data.real.nnreal
import topology.algebra.infinite_sum
import analysis.normed_space.basic
import for_mathlib.nnreal
import for_mathlib.nnreal_int_binary -- basic binary expansion for nnreal.

open_locale nnreal

/-

# Two auxiliary lemmas.

In this file we prove two technical lemmas, needed in the proofs of parts (2) and (4)
of Proposition 7.2 of `Analytic.pdf`.

## Lemma 1 (needed in part 2)

Say `f : ℤ → ℝ` and `r : ℝ≥0` with `2⁻¹<r<1`.
Say the support of `f` is bounded below by `d` (i.e. `n < d → f n = 0`),
We think of `f` as a power series `∑ₙf(n)Tⁿ` in `ℤ⟦T⟧[T⁻¹]`.

Here's the set-up. Support that `∑' (n : ℤ), ∥f n∥₊ * r ^ n` converges and is `≤ c`
(so in particular `f(T)` converges for `∥T∥ ≤ c`). Suppose also that
`∑' (n : ℤ), f n * 2⁻¹ ^ n = 0` (so `f` has a zero at `2⁻¹`; note that the sum
converges because `0 ≤ 2⁻¹ < r`).

The conclusion is that `∑(n ≥ d) ∥∑(0≤i≤(n-d)) f(n - 1 - i)*2ⁱ∥ * r^n`
also converges and is bounded above by `c * (2 - r⁻¹)⁻¹`.

The power series `∑(n≥d) (∑(0≤i≤(n-d)) f(n - 1 - i)*2ⁱ) * Tⁱ` is the power
series of `f(T)/(T⁻¹-2)`, and the reason it behaves reasonsbly is the
assumption that T⁻¹-2 has a simple zero at 2⁻¹ and no other zeros in
the disc radius `r`.

### Implementation detail

In Lean the second sum is `∑' (n : ℤ), ∥ite (d ≤ n)`
  `((finset.range (n - d).nat_abs.succ).sum (λ (l : ℕ), f (n - 1 - ↑l) * 2 ^ l))`
  `0∥₊ * r ^ n`.

### The maths proof

  ∑(n ≥ d) ∥∑(0≤i≤(n-d)) f(n - 1 - i)*2ⁱ∥ * r^n
= ∑(n ≥ d) ∥∑(i≥0) f(n - 1 - i)2ⁱ∥ * rⁿ (as f(n-1-i) vanishes for i larger than n-d)
= ∑(n ≥ d) ∥(i<0) f(n - 1 - i)2ⁱ∥ * rⁿ (as sum f(x)2⁻ˣ=0)
= ∑(n ≥ d) ∥∑(k≥0) f(n + k) 2^(-1-k)∥ * rⁿ (set k=-1-i)
≤ ∑(n ≥ d) ∑(k≥0)∥ f(n+k)∥ 2^(-1-k) r^n (Cauchy-Schwarz)
= ∑(k≥0) ∑(n≥d) ∥f(n+k)∥2^(-1-k)r^n (turns out you can interchange the sums)
= 2⁻¹∑(k≥0) (∑(n≥d) ∥f(n+k)∥r^(n+k)) * (2r)^{-k} (rearranging)
≤ 2⁻¹∑(k≥0) c (2r)^{-k} (defining property of c)
= 2⁻¹ * c / (1-(2r)⁻¹) (sum of a GP)
= c * (2-r⁻¹)⁻¹ (rearranging)

### Comments on the maths proof

The logic in this proof is completely standard but needs a little thinking about
when formalising. Some of the manipulations we are doing in the earlier lines
of the proof (for example interchanging the sums) are only valid if the sum converges.
However ultimately the proof that the sum converges only happens on the last-but-one
line of  the computation, where we prove that it's bounded above by something finite
(the sum of a GP).

There are several ways to fix this.

* One can go through the proof twice. In the first pass one can prove that everything
is `summable`, and then in the second pass one can then prove the results about equality
or boundedness of sums. This has the disadvantage that you have to do everything twice.

* Another approach is to write the proof once, but backwards; start with the sum of a geometric
progression and then go upwards through the maths proof above to deduce convergence and boundedness
of the original sum simultaneously. This has the mild disadvantage that you have to write
the proof backwards.

* A third approach would be to work not with `tsum` and `summable` at all, but to work
with `has_sum`. This has the disadvantage that you need to stop working with
equalities `∑a(n)=∑b(n)` or inequalities `∑a(n) ≤ ∑b(n)` and to start working with more complex
statements such as `has_sum a s ↔ has_sum b s` or `has_sum a s → ∃ t, has_sum b t ∧ t ≤ s`.

* The fourth approach avoids all of this. Instead of working with sums valued in `ℝ≥0` we
can work with sums taking values in `ℝ≥0∞` a.k.a. the interval `[0,∞]`.

## TODO

Switch to ennreal and then prove 6 lemmas for the first result. All the
summability results are in `thm69` so it's simply a case of
refactoring all of them.

-/

lemma real.nnnorm_int (n : ℤ) : ∥(n : ℝ)∥₊ = ∥n∥₊ :=
subtype.ext $ by simp [coe_nnnorm, real.norm_eq_abs, int.norm_eq_abs]

lemma real.neg_nnnorm_of_neg {r : ℝ} (hr : r < 0) : -(∥r∥₊ : ℝ) = r :=
by rw [coe_nnnorm, neg_eq_iff_neg_eq, real.norm_eq_abs, abs_of_neg hr]

namespace psi_aux_lemma

/-

## The first lemma

-/

open_locale ennreal

-- line 7 ≤ line 10
lemma step7 {f : ℤ → ℝ} {d : ℤ} {r : ℝ≥0} (hr2 : 2⁻¹ < r)
  (hconv : summable (λ (n : ℤ), ∥f n∥₊ * r ^ n)) : -- do I use hconv??
  ∑' (b : ℕ),
      (∑' (i : ℕ),
           (∥f (d + ↑b + ↑i)∥₊ : ℝ≥0∞) * r ^ (d + b + i)) *
        (2 * r)⁻¹ ^ b ≤
    2 * (↑(2 - r⁻¹)⁻¹ * ∑' (a : ℤ), ∥f a∥₊ * r ^ a) :=
begin
  have bound : ∀ (z : ℤ), ∑' (i : ℕ), (∥f (z + ↑i)∥₊ : ℝ≥0∞) * r ^ (z + ↑i) ≤
    ∑' (a : ℤ), ∥f a∥₊ * r ^ a,
  { intro z,
    refine tsum_le_tsum_of_inj (λ i, z + i) _ _ _ ennreal.summable ennreal.summable,
    { intros a b h, simpa using h, },
    { intros, exact ennreal.zero_le', },
    { intros, apply le_refl _ } },
  suffices : ∑' (b : ℕ), (∑' (a : ℤ), (∥f a∥₊ : ℝ≥0∞) * r ^ a) * (2 * ↑r)⁻¹ ^ b =
  2 * (↑(2 - r⁻¹)⁻¹ * ∑' (a : ℤ), ↑∥f a∥₊ * ↑r ^ a),
  { rw ← this,
    apply ennreal.tsum_le_tsum,
    intro a,
    apply ennreal.mul_le_mul_of_right,
    apply bound },
  rw [ennreal.tsum_mul_left, mul_comm, ← mul_assoc],
  congr,
  rw ennreal.tsum_geometric,
  apply ennreal.inv_eq_of_mul_eq_one,
  rw ← mul_assoc,
  have hr : 0 < 2 - r⁻¹,
  { rw nnreal.sub_pos,
    exact nnreal.inv_lt_of_inv_lt (by norm_num) hr2, },
  rw ennreal.coe_inv hr.ne',
  apply ennreal.mul_inv_eq_of_eq_mul (by exact_mod_cast hr.ne') ennreal.coe_ne_top,
  rw [ennreal.sub_mul, one_mul, one_mul, ennreal.coe_sub],
  { congr,
    refine ennreal.mul_eq_of_mul_inv_eq (by norm_num) (by norm_num) _,
    rw [ennreal.mul_inv, mul_comm, ennreal.coe_inv],
    { refine (lt_of_le_of_lt (by norm_num) hr2).ne', },
    { left, norm_num, },
    { left, norm_num, }, },
  { intros, norm_num, }
end

-- line 5 ≤ line 10
lemma step6 {f : ℤ → ℝ} {d : ℤ} {r : ℝ≥0} (hr2 : 2⁻¹ < r) (hdf : ∀ n, n < d → f n = 0)
  (hconv : summable (λ n : ℤ, ∥f n∥₊ * r ^ n)) :
(2⁻¹ : ℝ≥0∞) * ∑' (i j : ℕ), ↑∥f (d + ↑i + ↑j) * 2⁻¹ ^ j∥₊ * ↑(r ^ (d + ↑i)) ≤
  ↑(2 - r⁻¹)⁻¹ * ∑' (a : ℤ), ↑(∥f a∥₊ * r ^ a) :=
begin
  rw ennreal.tsum_comm,
  -- woohoo, I just interchanged the sums
  simp_rw [nnnorm_mul, nnnorm_pow, ennreal.coe_mul,
    ennreal.coe_zpow (lt_of_le_of_lt zero_le' hr2).ne'],
  push_cast,
  simp only [nnnorm_inv, real.nnnorm_two, ennreal.coe_inv, ne.def, bit0_eq_zero, one_ne_zero,
    not_false_iff, ennreal.coe_bit0, ennreal.coe_one],
  have h2ne0 : (2 : ℝ≥0∞) ≠ 0 := by norm_num,
  have h2netop : (2 : ℝ≥0∞) ≠ ⊤ := by norm_num,
  have hrne0 : (r : ℝ≥0∞) ≠ 0,
  { norm_cast,
    refine (lt_of_le_of_lt _ hr2).ne',
    norm_num },
  have hrnetop : (r : ℝ≥0∞) ≠ ⊤ := ennreal.coe_ne_top,
  rw ennreal.inv_mul_le_iff h2ne0 h2netop,
  have : ∀ a b : ℕ, (∥f (d + ↑a + ↑b)∥₊ : ℝ≥0∞) * 2⁻¹ ^ b * ↑r ^ (d + ↑a) =
    ∥f (d + ↑a + ↑b)∥₊ * r ^ (d + a + b) * (2 * r)⁻¹ ^ b,
  { intros a b,
    rw [ennreal.mul_inv (or.inl h2ne0) (or.inl h2netop), mul_pow, ← zpow_coe_nat (↑r)⁻¹],
    rw ennreal.zpow_add hrne0 hrnetop _ b,
    have : (∥f (d + ↑a + ↑b)∥₊ : ℝ≥0∞) * (↑r ^ (d + ↑a) * ↑r ^ (b : ℤ)) * (2⁻¹ ^ b * (↑r)⁻¹ ^ (b : ℤ)) =
      ↑∥f (d + ↑a + ↑b)∥₊ * 2⁻¹ ^ b * ↑r ^ (d + ↑a) * (r ^ (b : ℤ) * r⁻¹ ^ (b : ℤ)),
      { ring },
    rw this,
    convert (mul_one _).symm,
    rw ← ennreal.coe_inv (by exact_mod_cast hrne0),
    norm_cast,
    rw ← mul_pow,
    rw mul_inv_cancel (by exact_mod_cast hrne0),
    apply one_pow },
  simp_rw [this, ennreal.tsum_mul_right, add_right_comm],
  exact step7 hr2 hconv,
end

-- auxiliary convergence lemma
lemma step5 {f : ℤ → ℝ} {d : ℤ} {r : ℝ≥0} (hr2 : 2⁻¹ < r) (hdf : ∀ n, n < d → f n = 0)
  (hconv : summable (λ n : ℤ, ∥f n∥₊ * r ^ n)) :
  summable (λ (x : ℤ), f x * 2⁻¹ ^ x) :=
begin
  rw ← summable_subtype_and_compl,
  change summable (λ x : {n : ℤ | n < 0}, _) ∧ _,
  split,
  { let F : finset ↥{n : ℤ | n < 0} := finset.preimage (finset.Ico d 0 : finset ℤ) coe
    (set.inj_on_of_injective subtype.coe_injective _),
    apply summable_of_ne_finset_zero,
    rintro b (hb : b ∉ F),
    convert zero_mul _,
    apply hdf,
    by_contra hbd, push_neg at hbd,
    apply hb,
    rw finset.mem_preimage,
    rw finset.mem_Ico,
    exact ⟨hbd, b.2⟩ },
  { apply summable_of_summable_nnnorm,
    have := nnreal.summable_subtype hconv {n : ℤ | n < 0}ᶜ,
    refine nnreal.summable_of_le _ this,
    rintro ⟨b, hb : ¬ b < 0⟩,
    push_neg at hb,
    rw nnnorm_mul,
    suffices : ∥f b∥₊ * (2 ^ b)⁻¹ ≤ ∥f b∥₊ * r ^ b,
    { simpa },
    apply nnreal.mul_le_mul_left,
    rw ← inv_zpow,
    apply nnreal.zpow_le_zpow' hb hr2.le, },
end
example (r : ℝ≥0) (n : ℕ) : r ^ (n : ℤ) = r ^ n := zpow_coe_nat r n
noncomputable instance xxx : div_inv_monoid ℝ≥0 := infer_instance

-- second line is third line
lemma step4 {f : ℤ → ℝ} {n d : ℤ} {r : ℝ≥0} (hr1 : r < 1) (hr2 : 2⁻¹ < r)
  (hdf : ∀ n, n < d → f n = 0)
  (hconv : summable (λ n : ℤ, ∥f n∥₊ * r ^ n)) (hzero : ∑' n, f n *  2⁻¹ ^ n = 0) :
  ∑' (l : ℕ), f (n - 1 - ↑l) * 2 ^ l =  2⁻¹ * -∑' (m : ℕ), f (n + m) * 2⁻¹ ^ m :=
begin
  have : ∀ l : ℕ, (2 : ℝ) ^ l = 2⁻¹ ^ (n - 1 - l) * (2⁻¹ * 2 ^ n),
  { intro l,
    rw [inv_zpow, ← zpow_neg, ← zpow_neg_one, ← zpow_coe_nat],
    push_cast,
    rw ← zpow_add₀ (two_ne_zero : (2 : ℝ) ≠ 0),
    rw ← zpow_add₀ (two_ne_zero : (2 : ℝ) ≠ 0),
    ring_nf, },
  conv_lhs begin
    congr,
    funext,
    rw [this, ← mul_assoc],
  end, clear this,
  rw tsum_mul_right,
  have : ∀ m : ℕ, (2⁻¹ : ℝ) ^ m = 2⁻¹ ^ (n + m) * 2 ^ n,
  { intro m,
    rw [inv_zpow, ← zpow_neg, ← zpow_coe_nat, ← zpow_add₀ (two_ne_zero : (2 : ℝ) ≠ 0),
      inv_zpow, ← zpow_neg],
    ring_nf, },
  conv_rhs begin
    congr, skip,
    congr,
    congr,
    funext,
    rw [this, ← mul_assoc],
  end, clear this,
  rw [mul_comm, mul_assoc, tsum_mul_right, ← neg_mul, mul_comm ((2 : ℝ) ^ n)],
  congr,
  rw [eq_neg_iff_add_eq_zero, add_comm, ← hzero,
    ← tsum_add_tsum_compl ((step5 hr2 hdf hconv).comp_injective subtype.coe_injective :
    summable ((_ : ℤ → ℝ) ∘ (coe : {z : ℤ | n ≤ z} → ℤ)))
    ((step5 hr2 hdf hconv).comp_injective subtype.coe_injective)],
  { congr' 1,
    { rw ← ((nat.equiv_le_int n).tsum_eq : _ → (_ : ℝ) = _),
      congr', ext b,
      rw add_comm n,
      refl, },
    { rw ← ((nat.equiv_le_int_compl n).tsum_eq : _ → (_ : ℝ) = _),
      congr', ext b,
      rw (show n - 1 - b = n - (b + 1), by ring),
      refl, } },
end

-- second line ≤ last line
lemma step3 {f : ℤ → ℝ} {r : ℝ≥0} (hr1 : r < 1) (hr2 : 2⁻¹ < r) {d : ℤ}
  (hdf : ∀ n, n < d → f n = 0) (hconv : summable (λ n : ℤ, ∥f n∥₊ * r ^ n))
  (hzero : ∑' n, f n *  2⁻¹ ^ n = 0) :
∑' (n : ℤ), ((∥ite (d ≤ n) (∑' (l : ℕ), f (n - 1 - ↑l) * 2 ^ l) 0∥₊ * r ^ n : ℝ≥0) : ℝ≥0∞) ≤
  ((2 - r⁻¹)⁻¹ * ∑' (n : ℤ), ∥f n∥₊ * r ^ n : ℝ≥0) :=
begin
  simp_rw step4 hr1 hr2 hdf hconv hzero,
  -- n - d = m
  rw tsum_eq_tsum_of_ne_zero_bij (λ m : function.support
  (λ m : ℕ, ((∥(2⁻¹ : ℝ) * (-∑' (l : ℕ), f (d + m + ↑l) * 2⁻¹ ^ l)∥₊ * r ^ (d + m) : ℝ≥0) : ℝ≥0∞)),
  d + m.1),
  { dsimp only,
    simp_rw [nnnorm_mul, nnnorm_neg],
    push_cast,
    simp only [nnnorm_inv, real.nnnorm_two, ennreal.coe_inv, ne.def, bit0_eq_zero, one_ne_zero,
      not_false_iff, ennreal.coe_bit0, ennreal.coe_one],
    have summable_half : ∀ t : ℤ, summable (λ (x : ℕ), f (t + ↑x) * 2⁻¹ ^ x),
    { intro t,
      rw summable_mul_right_iff (show (2 : ℝ)⁻¹ ^ t ≠ 0, from zpow_ne_zero _ (by norm_num)),
      simp_rw [mul_assoc, ← zpow_coe_nat],
      simp_rw [← zpow_add₀ (show (2 : ℝ)⁻¹ ≠ 0, by norm_num), add_comm _ t],
      exact (step5 hr2 hdf hconv).comp_injective (show function.injective (λ x : ℕ, t + x),
      by {intros x y hxy, simpa using hxy, }), },
    suffices :
      ∑' (m : ℕ), (2⁻¹ : ℝ≥0∞) * ↑(∑' (l : ℕ), ∥f (d + ↑m + ↑l) * (2⁻¹ ^ l)∥₊ : ℝ≥0) *
        ↑(r ^ (d + ↑m)) ≤ ↑(2 - r⁻¹)⁻¹ * ↑∑' (n : ℤ), ∥f n∥₊ * r ^ n,
    { refine le_trans _ this,
      apply ennreal.tsum_le_tsum,
      intro m,
      apply ennreal.mul_le_mul_of_right,
      apply ennreal.mul_le_mul_of_left,
      norm_cast,
      apply nnnorm_tsum_le,
      rw ← nnreal.summable_iff_summable_nnnorm,
      apply summable_half, },
    rw ennreal.coe_tsum hconv, dsimp only,
    conv_lhs begin
      congr,
      funext,
      rw ennreal.coe_tsum (show summable (λ (l : ℕ), ∥f (d + m + ↑l) * 2⁻¹ ^ l∥₊), begin
      rw ← nnreal.summable_iff_summable_nnnorm,
      apply summable_half, end),
    end,
    dsimp only,
    simp_rw mul_assoc,
    rw ennreal.tsum_mul_left,
    simp_rw ← ennreal.tsum_mul_right,
    apply step6 hr2 hdf hconv, },
  { rintro ⟨x, _⟩ ⟨y, _⟩ h,
    have hxy : x = y,
    { simpa using h },
    subst hxy },
  { rintro n hn,
    rw function.mem_support at hn,
    split_ifs at hn with hdn,
    { rw set.mem_range,
      let m := (n - d).nat_abs,
      have hm : d + m = n,
      { apply add_eq_of_eq_sub',
        rw [int.nat_abs_of_nonneg],
        exact sub_nonneg.mpr hdn, },
      refine ⟨⟨m, _⟩, hm⟩,
      rw function.mem_support,
      convert hn,
      rw hm, },
    { exfalso,
      apply hn,
      simp, } },
  { simp, },
end

-- first line equals second line
lemma step2 {f : ℤ → ℝ} {n d : ℤ} (hn : d ≤ n) (hdf : ∀ n, n < d → f n = 0) :
  (finset.range (n - d).nat_abs.succ).sum (λ (l : ℕ), f (n - 1 - ↑l) * 2 ^ l) =
  ∑' (l : ℕ), f (n - 1 - l) * 2 ^ l :=
begin
  apply (tsum_eq_sum _ : (_ : ℝ) = _).symm,
  intros b hb,
  convert zero_mul ((2 : ℝ) ^ b),
  apply hdf,
  by_contra hbd,
  push_neg at hbd,
  apply hb,
  rw [finset.mem_range, nat.lt_succ_iff],
  suffices : (b : ℤ) ≤ ((n - d).nat_abs : ℤ),
  { assumption_mod_cast, },
  rw ← int.eq_nat_abs_of_zero_le;
  linarith,
end

-- coerce to ℝ≥0∞
lemma step1 {f : ℤ → ℝ} {r : ℝ≥0} (hr1 : r < 1) (hr2 : 2⁻¹ < r) {d : ℤ}
  (hdf : ∀ n, n < d → f n = 0) (hconv : summable (λ n : ℤ, ∥f n∥₊ * r ^ n))
  (hzero : ∑' n, f n *  2⁻¹ ^ n = 0) :
∑' (n : ℤ),
    ((∥ite (d ≤ n) ((finset.range (n - d).nat_abs.succ).sum (λ (l : ℕ), f (n - 1 - ↑l) * 2 ^ l)) 0∥₊ *
      r ^ n : ℝ≥0) : ℝ≥0∞) ≤
  ((2 - r⁻¹)⁻¹ * ∑' (n : ℤ), ∥f n∥₊ * r ^ n : ℝ≥0) :=
begin
  have : ∀ n,
  ∥ite (d ≤ n) ((finset.range (n - d).nat_abs.succ).sum (λ (l : ℕ), f (n - 1 - ↑l) * 2 ^ l)) 0∥₊ * r ^ n
  =
  ∥ite (d ≤ n) (∑' (l : ℕ), f (n - 1 - l) * 2 ^ l) 0∥₊ * r ^ n,
  { intro n,
    congr' 2,
    split_ifs with hn,
    { rw step2 hn hdf },
    { refl } },
  simp_rw this,
  apply step3 hr1 hr2 hdf hconv hzero,
end

-- first line ≤ last line
lemma key_tsum_lemma (f : ℤ → ℝ) (r : ℝ≥0) (hr1 : r < 1) (hr2 : 2⁻¹ < r) (d : ℤ)
  (hdf : ∀ n, n < d → f n = 0) (hconv : summable (λ n : ℤ, ∥f n∥₊ * r ^ n))
  (hzero : ∑' n, f n *  2⁻¹ ^ n = 0) :
∑' (n : ℤ), ∥ite (d ≤ n) ((finset.range (n - d).nat_abs.succ).sum
  (λ (l : ℕ), f (n - 1 - ↑l) * 2 ^ l)) 0∥₊ * r ^ n ≤
  (2 - r⁻¹)⁻¹ * ∑' n, ∥f n∥₊ * r ^ n :=
begin
  have := step1 hr1 hr2 hdf hconv hzero,
  have this2 : ∑' (n : ℤ),
  (((∥ite (d ≤ n) ((finset.range (n - d).nat_abs.succ).sum (λ (l : ℕ), f (n - 1 - ↑l) * 2 ^ l)) 0∥₊ *
       r ^ n) : ℝ≥0) : ℝ≥0∞) < ⊤,
  { refine lt_of_le_of_lt this _,
    exact ennreal.coe_lt_top,
  },
  have this3 : summable (λ n, ((∥ite (d ≤ n) ((finset.range (n - d).nat_abs.succ).sum (λ (l : ℕ), f (n - 1 - ↑l) * 2 ^ l)) 0∥₊ *
       r ^ n) : ℝ≥0)) := ennreal.tsum_coe_ne_top_iff_summable.mp this2.ne,
  rw ← ennreal.coe_le_coe,
  convert this,
  apply ennreal.coe_tsum this3,
end

end psi_aux_lemma

/-

## The second lemma

-/

namespace theta_aux_lemma

-- Here is the fact which Clausen/Scholze need for the application to "splitting θ
-- in a bounded way".

theorem tsum_le (r : ℝ≥0) {s : ℝ≥0} (hs0 : 0 < s) (hs : s < 1) :
∑' (n : ℤ), (nnreal.int.binary r n : ℝ≥0) * s ^ n ≤
  s ^ ⌈real.log r / real.log (2⁻¹ : ℝ≥0)⌉ * (1 - s)⁻¹ :=
begin
  let d := ⌈real.log r / real.log (2⁻¹ : ℝ≥0)⌉,
  rw mul_comm,
  rw ← nnreal.int.tsum_add_tsum_compl' {n : ℤ | n < d} (nnreal.int.binary_summable r hs),
  have h0 : ∑' (x : ↥{n : ℤ | n < d}), (λ (n : ℤ), ↑(nnreal.int.binary r n) * s ^ n) ↑x = 0,
  { convert (tsum_zero : _ = (0 : ℝ≥0)), ext ⟨n, hn : n < d⟩,
    simp [nnreal.int.binary_eq_zero r n hn] },
  rw [h0, zero_add], clear h0,
  rw ← (nat.equiv_int_lt_compl d).tsum_eq, swap, apply_instance,
  simp only [nat.equiv_int_lt_compl, zpow_add₀ hs0.ne', ←mul_assoc, equiv.coe_fn_mk, subtype.coe_mk,
    zpow_coe_nat, nonneg.coe_one, nnreal.tsum_mul_right],
  rw mul_le_mul_right₀,
  { rw ← tsum_geometric_nnreal hs,
    refine nnreal.tsum_le_tsum (λ n, _) (nnreal.summable_geometric hs),
    apply mul_le_of_le_one_left',
    norm_cast,
    apply nnreal.int.binary_le_one },
  { exact zpow_ne_zero _ hs0.ne' }
end

end theta_aux_lemma

-- is `summable_subtype_and_compl` true for add_comm_monoids? Why is it stated for groups?


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

! This file was ported from Lean 3 source module ring_theory.polynomial.cyclotomic.basic
! leanprover-community/mathlib commit 2032a878972d5672e7c27c957e7a6e297b044973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.NeZero
import Mathbin.Algebra.Polynomial.BigOperators
import Mathbin.Analysis.Complex.RootsOfUnity
import Mathbin.Data.Polynomial.Lifts
import Mathbin.Data.Polynomial.Splits
import Mathbin.Data.Zmod.Algebra
import Mathbin.FieldTheory.Ratfunc
import Mathbin.FieldTheory.Separable
import Mathbin.NumberTheory.ArithmeticFunction
import Mathbin.RingTheory.RootsOfUnity

/-!
# 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 Classical BigOperators Polynomial

noncomputable section

universe u

namespace Polynomial

section Cyclotomic'

section IsDomain

variable {R : Type _} [CommRing R] [IsDomain 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 _) [CommRing R] [IsDomain R] : R[X] :=
  ∏ μ in primitiveRoots n R, X - C μ
#align polynomial.cyclotomic' Polynomial.cyclotomic'

/-- The zeroth modified cyclotomic polyomial is `1`. -/
@[simp]
theorem cyclotomic'_zero (R : Type _) [CommRing R] [IsDomain R] : cyclotomic' 0 R = 1 := by
  simp only [cyclotomic', Finset.prod_empty, primitiveRoots_zero]
#align polynomial.cyclotomic'_zero Polynomial.cyclotomic'_zero

/-- The first modified cyclotomic polyomial is `X - 1`. -/
@[simp]
theorem cyclotomic'_one (R : Type _) [CommRing R] [IsDomain R] : cyclotomic' 1 R = X - 1 := by
  simp only [cyclotomic', Finset.prod_singleton, RingHom.map_one,
    IsPrimitiveRoot.primitiveRoots_one]
#align polynomial.cyclotomic'_one Polynomial.cyclotomic'_one

/-- The second modified cyclotomic polyomial is `X + 1` if the characteristic of `R` is not `2`. -/
@[simp]
theorem cyclotomic'_two (R : Type _) [CommRing R] [IsDomain R] (p : ℕ) [CharP R p] (hp : p ≠ 2) :
    cyclotomic' 2 R = X + 1 := by
  rw [cyclotomic']
  have prim_root_two : primitiveRoots 2 R = {(-1 : R)} :=
    by
    simp only [Finset.eq_singleton_iff_unique_mem, mem_primitiveRoots two_pos]
    exact ⟨IsPrimitiveRoot.neg_one p hp, fun x => IsPrimitiveRoot.eq_neg_one_of_two_right⟩
  simp only [prim_root_two, Finset.prod_singleton, RingHom.map_neg, RingHom.map_one, sub_neg_eq_add]
#align polynomial.cyclotomic'_two Polynomial.cyclotomic'_two

/-- `cyclotomic' n R` is monic. -/
theorem cyclotomic'.monic (n : ℕ) (R : Type _) [CommRing R] [IsDomain R] :
    (cyclotomic' n R).Monic :=
  monic_prod_of_monic _ _ fun z hz => monic_X_sub_C _
#align polynomial.cyclotomic'.monic Polynomial.cyclotomic'.monic

/-- `cyclotomic' n R` is different from `0`. -/
theorem cyclotomic'_ne_zero (n : ℕ) (R : Type _) [CommRing R] [IsDomain R] : cyclotomic' n R ≠ 0 :=
  (cyclotomic'.monic n R).NeZero
#align polynomial.cyclotomic'_ne_zero Polynomial.cyclotomic'_ne_zero

/-- The natural degree of `cyclotomic' n R` is `totient n` if there is a primitive root of
unity in `R`. -/
theorem natDegree_cyclotomic' {ζ : R} {n : ℕ} (h : IsPrimitiveRoot ζ n) :
    (cyclotomic' n R).natDegree = Nat.totient n :=
  by
  rw [cyclotomic']
  rw [nat_degree_prod (primitiveRoots n R) fun z : R => X - C z]
  simp only [IsPrimitiveRoot.card_primitiveRoots h, mul_one, nat_degree_X_sub_C, Nat.cast_id,
    Finset.sum_const, nsmul_eq_mul]
  intro z hz
  exact X_sub_C_ne_zero z
#align polynomial.nat_degree_cyclotomic' Polynomial.natDegree_cyclotomic'

/-- The degree of `cyclotomic' n R` is `totient n` if there is a primitive root of unity in `R`. -/
theorem degree_cyclotomic' {ζ : R} {n : ℕ} (h : IsPrimitiveRoot ζ n) :
    (cyclotomic' n R).degree = Nat.totient n := by
  simp only [degree_eq_nat_degree (cyclotomic'_ne_zero n R), nat_degree_cyclotomic' h]
#align polynomial.degree_cyclotomic' Polynomial.degree_cyclotomic'

/-- The roots of `cyclotomic' n R` are the primitive `n`-th roots of unity. -/
theorem roots_of_cyclotomic (n : ℕ) (R : Type _) [CommRing R] [IsDomain R] :
    (cyclotomic' n R).roots = (primitiveRoots n R).val :=
  by
  rw [cyclotomic']
  exact roots_prod_X_sub_C (primitiveRoots n R)
#align polynomial.roots_of_cyclotomic Polynomial.roots_of_cyclotomic

/-- 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. -/
theorem x_pow_sub_one_eq_prod {ζ : R} {n : ℕ} (hpos : 0 < n) (h : IsPrimitiveRoot ζ n) :
    X ^ n - 1 = ∏ ζ in nthRootsFinset n R, X - C ζ :=
  by
  rw [nth_roots_finset, ← Multiset.toFinset_eq (IsPrimitiveRoot.nthRoots_nodup h)]
  simp only [Finset.prod_mk, RingHom.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
  symm
  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 IsPrimitiveRoot.card_nthRoots h
#align polynomial.X_pow_sub_one_eq_prod Polynomial.x_pow_sub_one_eq_prod

end IsDomain

section Field

variable {K : Type _} [Field K]

/-- `cyclotomic' n K` splits. -/
theorem cyclotomic'_splits (n : ℕ) : Splits (RingHom.id K) (cyclotomic' n K) :=
  by
  apply splits_prod (RingHom.id K)
  intro z hz
  simp only [splits_X_sub_C (RingHom.id K)]
#align polynomial.cyclotomic'_splits Polynomial.cyclotomic'_splits

/-- If there is a primitive `n`-th root of unity in `K`, then `X ^ n - 1`splits. -/
theorem x_pow_sub_one_splits {ζ : K} {n : ℕ} (h : IsPrimitiveRoot ζ n) :
    Splits (RingHom.id K) (X ^ n - C (1 : K)) := by
  rw [splits_iff_card_roots, ← nth_roots, IsPrimitiveRoot.card_nthRoots h, nat_degree_X_pow_sub_C]
#align polynomial.X_pow_sub_one_splits Polynomial.x_pow_sub_one_splits

/-- If there is a primitive `n`-th root of unity in `K`, then
`∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1`. -/
theorem prod_cyclotomic'_eq_x_pow_sub_one {K : Type _} [CommRing K] [IsDomain K] {ζ : K} {n : ℕ}
    (hpos : 0 < n) (h : IsPrimitiveRoot ζ n) :
    (∏ i in Nat.divisors n, cyclotomic' i K) = X ^ n - 1 :=
  by
  have hd : (n.divisors : Set ℕ).PairwiseDisjoint fun k => primitiveRoots k K :=
    fun x hx y hy hne => IsPrimitiveRoot.disjoint hne
  simp only [X_pow_sub_one_eq_prod hpos h, cyclotomic', ← Finset.prod_bunionᵢ hd,
    h.nth_roots_one_eq_bUnion_primitive_roots]
#align polynomial.prod_cyclotomic'_eq_X_pow_sub_one Polynomial.prod_cyclotomic'_eq_x_pow_sub_one

/-- 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)`. -/
theorem cyclotomic'_eq_x_pow_sub_one_div {K : Type _} [CommRing K] [IsDomain K] {ζ : K} {n : ℕ}
    (hpos : 0 < n) (h : IsPrimitiveRoot ζ n) :
    cyclotomic' n K = (X ^ n - 1) /ₘ ∏ i in Nat.properDivisors n, cyclotomic' i K :=
  by
  rw [← prod_cyclotomic'_eq_X_pow_sub_one hpos h, ← Nat.cons_self_properDivisors hpos.ne',
    Finset.prod_cons]
  have prod_monic : (∏ i in Nat.properDivisors n, cyclotomic' i K).Monic :=
    by
    apply monic_prod_of_monic
    intro 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)
#align polynomial.cyclotomic'_eq_X_pow_sub_one_div Polynomial.cyclotomic'_eq_x_pow_sub_one_div

/-- If there is a primitive `n`-th root of unity in `K`, then `cyclotomic' n K` comes from a
monic polynomial with integer coefficients. -/
theorem int_coeff_of_cyclotomic' {K : Type _} [CommRing K] [IsDomain K] {ζ : K} {n : ℕ}
    (h : IsPrimitiveRoot ζ n) :
    ∃ P : ℤ[X],
      map (Int.castRingHom K) P = cyclotomic' n K ∧ P.degree = (cyclotomic' n K).degree ∧ P.Monic :=
  by
  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.properDivisors k, cyclotomic' i K
  have Bmo : B.monic := by
    apply monic_prod_of_monic
    intro i hi
    exact cyclotomic'.monic i K
  have Bint : B ∈ lifts (Int.castRingHom K) :=
    by
    refine' Subsemiring.prod_mem (lifts (Int.castRingHom K)) _
    intro x hx
    have xsmall := (Nat.mem_properDivisors.1 hx).2
    obtain ⟨d, hd⟩ := (Nat.mem_properDivisors.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 :=
    by
    constructor
    ·
      rw [zero_add, mul_comm, ← prod_cyclotomic'_eq_X_pow_sub_one hpos h, ←
        Nat.cons_self_properDivisors 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, RingHom.mem_rangeS]
  use Q₁
  rw [coe_map_ring_hom, map_div_by_monic (Int.castRingHom K) hB₁mo, hB₁, ← huniq.1]
  simp
#align polynomial.int_coeff_of_cyclotomic' Polynomial.int_coeff_of_cyclotomic'

/-- 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. -/
theorem unique_int_coeff_of_cycl {K : Type _} [CommRing K] [IsDomain K] [CharZero K] {ζ : K}
    {n : ℕ+} (h : IsPrimitiveRoot ζ n) : ∃! P : ℤ[X], map (Int.castRingHom K) P = cyclotomic' n K :=
  by
  obtain ⟨P, hP⟩ := int_coeff_of_cyclotomic' h
  refine' ⟨P, hP.1, fun Q hQ => _⟩
  apply map_injective (Int.castRingHom K) Int.cast_injective
  rw [hP.1, hQ]
#align polynomial.unique_int_coeff_of_cycl Polynomial.unique_int_coeff_of_cycl

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.castRingHom R) (int_coeff_of_cyclotomic' (Complex.isPrimitiveRoot_exp n h)).some
#align polynomial.cyclotomic Polynomial.cyclotomic

theorem int_cyclotomic_rw {n : ℕ} (h : n ≠ 0) :
    cyclotomic n ℤ = (int_coeff_of_cyclotomic' (Complex.isPrimitiveRoot_exp n h)).some :=
  by
  simp only [cyclotomic, h, dif_neg, not_false_iff]
  ext i
  simp only [coeff_map, Int.cast_id, eq_intCast]
#align polynomial.int_cyclotomic_rw Polynomial.int_cyclotomic_rw

/-- `cyclotomic n R` comes from `cyclotomic n ℤ`. -/
theorem map_cyclotomic_int (n : ℕ) (R : Type _) [Ring R] :
    map (Int.castRingHom R) (cyclotomic n ℤ) = cyclotomic n R :=
  by
  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]
#align polynomial.map_cyclotomic_int Polynomial.map_cyclotomic_int

theorem int_cyclotomic_spec (n : ℕ) :
    map (Int.castRingHom ℂ) (cyclotomic n ℤ) = cyclotomic' n ℂ ∧
      (cyclotomic n ℤ).degree = (cyclotomic' n ℂ).degree ∧ (cyclotomic n ℤ).Monic :=
  by
  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_iff]
  rw [int_cyclotomic_rw hzero]
  exact (int_coeff_of_cyclotomic' (Complex.isPrimitiveRoot_exp n hzero)).choose_spec
#align polynomial.int_cyclotomic_spec Polynomial.int_cyclotomic_spec

theorem int_cyclotomic_unique {n : ℕ} {P : ℤ[X]} (h : map (Int.castRingHom ℂ) P = cyclotomic' n ℂ) :
    P = cyclotomic n ℤ :=
  by
  apply map_injective (Int.castRingHom ℂ) Int.cast_injective
  rw [h, (int_cyclotomic_spec n).1]
#align polynomial.int_cyclotomic_unique Polynomial.int_cyclotomic_unique

/-- The definition of `cyclotomic n R` commutes with any ring homomorphism. -/
@[simp]
theorem map_cyclotomic (n : ℕ) {R S : Type _} [Ring R] [Ring S] (f : R →+* S) :
    map f (cyclotomic n R) = cyclotomic n S :=
  by
  rw [← map_cyclotomic_int n R, ← map_cyclotomic_int n S, map_map]
  congr
#align polynomial.map_cyclotomic Polynomial.map_cyclotomic

theorem 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]
#align polynomial.cyclotomic.eval_apply Polynomial.cyclotomic.eval_apply

/-- The zeroth cyclotomic polyomial is `1`. -/
@[simp]
theorem cyclotomic_zero (R : Type _) [Ring R] : cyclotomic 0 R = 1 := by
  simp only [cyclotomic, dif_pos]
#align polynomial.cyclotomic_zero Polynomial.cyclotomic_zero

/-- The first cyclotomic polyomial is `X - 1`. -/
@[simp]
theorem cyclotomic_one (R : Type _) [Ring R] : cyclotomic 1 R = X - 1 :=
  by
  have hspec : map (Int.castRingHom ℂ) (X - 1) = cyclotomic' 1 ℂ := by
    simp only [cyclotomic'_one, PNat.one_coe, map_X, Polynomial.map_one, Polynomial.map_sub]
  symm
  rw [← map_cyclotomic_int, ← int_cyclotomic_unique hspec]
  simp only [map_X, Polynomial.map_one, Polynomial.map_sub]
#align polynomial.cyclotomic_one Polynomial.cyclotomic_one

/-- `cyclotomic n` is monic. -/
theorem cyclotomic.monic (n : ℕ) (R : Type _) [Ring R] : (cyclotomic n R).Monic :=
  by
  rw [← map_cyclotomic_int]
  exact (int_cyclotomic_spec n).2.2.map _
#align polynomial.cyclotomic.monic Polynomial.cyclotomic.monic

/-- `cyclotomic n` is primitive. -/
theorem cyclotomic.isPrimitive (n : ℕ) (R : Type _) [CommRing R] : (cyclotomic n R).IsPrimitive :=
  (cyclotomic.monic n R).IsPrimitive
#align polynomial.cyclotomic.is_primitive Polynomial.cyclotomic.isPrimitive

/-- `cyclotomic n R` is different from `0`. -/
theorem cyclotomic_ne_zero (n : ℕ) (R : Type _) [Ring R] [Nontrivial R] : cyclotomic n R ≠ 0 :=
  (cyclotomic.monic n R).NeZero
#align polynomial.cyclotomic_ne_zero Polynomial.cyclotomic_ne_zero

/-- The degree of `cyclotomic n` is `totient n`. -/
theorem degree_cyclotomic (n : ℕ) (R : Type _) [Ring R] [Nontrivial R] :
    (cyclotomic n R).degree = Nat.totient n :=
  by
  rw [← map_cyclotomic_int]
  rw [degree_map_eq_of_leading_coeff_ne_zero (Int.castRingHom R) _]
  · cases' n with k
    · simp only [cyclotomic, degree_one, dif_pos, Nat.totient_zero, WithTop.coe_zero]
    rw [← degree_cyclotomic' (Complex.isPrimitiveRoot_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_intCast, monic.leading_coeff, Int.cast_one,
    Ne.def, not_false_iff, one_ne_zero]
#align polynomial.degree_cyclotomic Polynomial.degree_cyclotomic

/-- The natural degree of `cyclotomic n` is `totient n`. -/
theorem natDegree_cyclotomic (n : ℕ) (R : Type _) [Ring R] [Nontrivial R] :
    (cyclotomic n R).natDegree = Nat.totient n := by
  rw [nat_degree, degree_cyclotomic, WithBot.unbot'_coe]
#align polynomial.nat_degree_cyclotomic Polynomial.natDegree_cyclotomic

/-- The degree of `cyclotomic n R` is positive. -/
theorem 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
#align polynomial.degree_cyclotomic_pos Polynomial.degree_cyclotomic_pos

open Finset

/-- `∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1`. -/
theorem prod_cyclotomic_eq_x_pow_sub_one {n : ℕ} (hpos : 0 < n) (R : Type _) [CommRing R] :
    (∏ i in Nat.divisors n, cyclotomic i R) = X ^ n - 1 :=
  by
  have integer : (∏ i in Nat.divisors n, cyclotomic i ℤ) = X ^ n - 1 :=
    by
    apply map_injective (Int.castRingHom ℂ) 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.isPrimitiveRoot_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.castRingHom R)) integer
#align polynomial.prod_cyclotomic_eq_X_pow_sub_one Polynomial.prod_cyclotomic_eq_x_pow_sub_one

theorem cyclotomic.dvd_x_pow_sub_one (n : ℕ) (R : Type _) [Ring R] : cyclotomic n R ∣ X ^ n - 1 :=
  by
  suffices cyclotomic n ℤ ∣ X ^ n - 1 by
    simpa only [map_cyclotomic_int, Polynomial.map_sub, Polynomial.map_one, Polynomial.map_pow,
      Polynomial.map_X] using map_dvd (Int.castRingHom 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')
#align polynomial.cyclotomic.dvd_X_pow_sub_one Polynomial.cyclotomic.dvd_x_pow_sub_one

theorem prod_cyclotomic_eq_geom_sum {n : ℕ} (h : 0 < n) (R) [CommRing R] :
    (∏ i in n.divisors.eraseₓ 1, cyclotomic i R) = ∑ i in Finset.range n, X ^ i :=
  by
  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.castRingHom R)) this
  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]
#align polynomial.prod_cyclotomic_eq_geom_sum Polynomial.prod_cyclotomic_eq_geom_sum

/-- If `p` is prime, then `cyclotomic p R = ∑ i in range p, X ^ i`. -/
theorem cyclotomic_prime (R : Type _) [Ring R] (p : ℕ) [hp : Fact p.Prime] :
    cyclotomic p R = ∑ i in Finset.range p, X ^ i :=
  by
  suffices cyclotomic p ℤ = ∑ i in range p, X ^ i by
    simpa only [map_cyclotomic_int, Polynomial.map_sum, Polynomial.map_pow, Polynomial.map_X] using
      congr_arg (map (Int.castRingHom 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]
#align polynomial.cyclotomic_prime Polynomial.cyclotomic_prime

theorem 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]
#align polynomial.cyclotomic_prime_mul_X_sub_one Polynomial.cyclotomic_prime_mul_x_sub_one

@[simp]
theorem cyclotomic_two (R : Type _) [Ring R] : cyclotomic 2 R = X + 1 := by simp [cyclotomic_prime]
#align polynomial.cyclotomic_two Polynomial.cyclotomic_two

@[simp]
theorem cyclotomic_three (R : Type _) [Ring R] : cyclotomic 3 R = X ^ 2 + X + 1 := by
  simp [cyclotomic_prime, sum_range_succ']
#align polynomial.cyclotomic_three Polynomial.cyclotomic_three

theorem 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 :=
  by
  suffices cyclotomic d ℤ ∣ ∑ i in Finset.range n, X ^ i by
    simpa only [map_cyclotomic_int, Polynomial.map_sum, Polynomial.map_pow, Polynomial.map_X] using
      map_dvd (Int.castRingHom 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']
#align polynomial.cyclotomic_dvd_geom_sum_of_dvd Polynomial.cyclotomic_dvd_geom_sum_of_dvd

theorem x_pow_sub_one_mul_prod_cyclotomic_eq_x_pow_sub_one_of_dvd (R) [CommRing R] {d n : ℕ}
    (h : d ∈ n.properDivisors) :
    ((X ^ d - 1) * ∏ x in n.divisors \ d.divisors, cyclotomic x R) = X ^ n - 1 :=
  by
  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)]
#align polynomial.X_pow_sub_one_mul_prod_cyclotomic_eq_X_pow_sub_one_of_dvd Polynomial.x_pow_sub_one_mul_prod_cyclotomic_eq_x_pow_sub_one_of_dvd

theorem x_pow_sub_one_mul_cyclotomic_dvd_x_pow_sub_one_of_dvd (R) [CommRing R] {d n : ℕ}
    (h : d ∈ n.properDivisors) : (X ^ d - 1) * cyclotomic n R ∣ X ^ n - 1 :=
  by
  have hdn := (nat.mem_proper_divisors.mp h).2
  use ∏ x in n.proper_divisors \ d.divisors, cyclotomic x R
  symm
  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_properDivisors hdn.ne_bot, insert_sdiff_of_not_mem, prod_insert]
  · exact Finset.not_mem_sdiff_of_not_mem_left Nat.properDivisors.not_self_mem
  · exact fun hk => hdn.not_le <| Nat.divisor_le hk
#align polynomial.X_pow_sub_one_mul_cyclotomic_dvd_X_pow_sub_one_of_dvd Polynomial.x_pow_sub_one_mul_cyclotomic_dvd_x_pow_sub_one_of_dvd

theorem isRoot_of_unity_iff {n : ℕ} (h : 0 < n) (R : Type _) [CommRing R] [IsDomain R] {ζ : R} :
    ζ ^ n = 1 ↔ ∃ i ∈ n.divisors, (cyclotomic i R).IsRoot ζ := 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] <;>
    infer_instance
#align is_root_of_unity_iff isRoot_of_unity_iff

theorem isRoot_of_unity_of_root_cyclotomic {n : ℕ} {R} [CommRing R] {ζ : R} {i : ℕ}
    (hi : i ∈ n.divisors) (h : (cyclotomic i R).IsRoot ζ) : ζ ^ n = 1 :=
  by
  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
#align polynomial.is_root_of_unity_of_root_cyclotomic Polynomial.isRoot_of_unity_of_root_cyclotomic

section ArithmeticFunction

open Nat.ArithmeticFunction

open ArithmeticFunction

/-- `cyclotomic n R` can be expressed as a product in a fraction field of `R[X]`
  using Möbius inversion. -/
theorem cyclotomic_eq_prod_x_pow_sub_one_pow_moebius {n : ℕ} (R : Type _) [CommRing R]
    [IsDomain R] :
    algebraMap _ (Ratfunc R) (cyclotomic n R) =
      ∏ i in n.divisorsAntidiagonal, algebraMap R[X] _ (X ^ i.snd - 1) ^ μ i.fst :=
  by
  rcases n.eq_zero_or_pos with (rfl | hpos)
  · simp
  have h :
    ∀ n : ℕ,
      0 < n →
        (∏ i in Nat.divisors n, algebraMap _ (Ratfunc R) (cyclotomic i R)) =
          algebraMap _ _ (X ^ n - 1) :=
    by
    intro n hn
    rw [← prod_cyclotomic_eq_X_pow_sub_one hn R, RingHom.map_prod]
  rw [(prod_eq_iff_prod_pow_moebius_eq_of_nonzero (fun n hn => _) fun n hn => _).1 h n hpos] <;>
    rw [Ne.def, IsFractionRing.to_map_eq_zero_iff]
  · apply cyclotomic_ne_zero
  · apply monic.ne_zero
    apply monic_X_pow_sub_C _ (ne_of_gt hn)
#align polynomial.cyclotomic_eq_prod_X_pow_sub_one_pow_moebius Polynomial.cyclotomic_eq_prod_x_pow_sub_one_pow_moebius

end ArithmeticFunction

/-- We have
`cyclotomic n R = (X ^ k - 1) /ₘ (∏ i in nat.proper_divisors k, cyclotomic i K)`. -/
theorem cyclotomic_eq_x_pow_sub_one_div {R : Type _} [CommRing R] {n : ℕ} (hpos : 0 < n) :
    cyclotomic n R = (X ^ n - 1) /ₘ ∏ i in Nat.properDivisors n, cyclotomic i R :=
  by
  nontriviality R
  rw [← prod_cyclotomic_eq_X_pow_sub_one hpos, ← Nat.cons_self_properDivisors hpos.ne',
    Finset.prod_cons]
  have prod_monic : (∏ i in Nat.properDivisors n, cyclotomic i R).Monic :=
    by
    apply monic_prod_of_monic
    intro 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]
  constructor
  · rw [mul_comm]
  rw [bot_lt_iff_ne_bot]
  intro h
  exact monic.ne_zero prod_monic (degree_eq_bot.1 h)
#align polynomial.cyclotomic_eq_X_pow_sub_one_div Polynomial.cyclotomic_eq_x_pow_sub_one_div

/-- If `m` is a proper divisor of `n`, then `X ^ m - 1` divides
`∏ i in nat.proper_divisors n, cyclotomic i R`. -/
theorem x_pow_sub_one_dvd_prod_cyclotomic (R : Type _) [CommRing R] {n m : ℕ} (hpos : 0 < n)
    (hm : m ∣ n) (hdiff : m ≠ n) : X ^ m - 1 ∣ ∏ i in Nat.properDivisors n, cyclotomic i R :=
  by
  replace hm :=
    Nat.mem_properDivisors.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_properDivisors (ne_of_lt hpos).symm (Nat.mem_properDivisors.1 hm).1
        (ne_of_lt (Nat.mem_properDivisors.1 hm).2)),
    Finset.prod_union Finset.sdiff_disjoint,
    prod_cyclotomic_eq_X_pow_sub_one (Nat.pos_of_mem_properDivisors hm)]
  exact ⟨∏ x : ℕ in n.proper_divisors \ m.divisors, cyclotomic x R, by rw [mul_comm]⟩
#align polynomial.X_pow_sub_one_dvd_prod_cyclotomic Polynomial.x_pow_sub_one_dvd_prod_cyclotomic

/-- 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` -/
theorem cyclotomic_eq_prod_x_sub_primitiveRoots {K : Type _} [CommRing K] [IsDomain K] {ζ : K}
    {n : ℕ} (hz : IsPrimitiveRoot ζ n) : cyclotomic n K = ∏ μ in primitiveRoots n K, X - C μ :=
  by
  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 :=
    by
    intro i hi
    obtain ⟨d, hd⟩ := (Nat.mem_properDivisors.1 hi).1
    rw [mul_comm] at hd
    exact hk i (Nat.mem_properDivisors.1 hi).2 (IsPrimitiveRoot.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]
#align polynomial.cyclotomic_eq_prod_X_sub_primitive_roots Polynomial.cyclotomic_eq_prod_x_sub_primitiveRoots

section Roots

variable {R : Type _} {n : ℕ} [CommRing R] [IsDomain R]

/-- Any `n`-th primitive root of unity is a root of `cyclotomic n K`.-/
theorem IsPrimitiveRoot.isRoot_cyclotomic (hpos : 0 < n) {μ : R} (h : IsPrimitiveRoot μ n) :
    IsRoot (cyclotomic n R) μ :=
  by
  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_primitiveRoots hpos] at h
#align is_primitive_root.is_root_cyclotomic IsPrimitiveRoot.isRoot_cyclotomic

private theorem is_root_cyclotomic_iff' {n : ℕ} {K : Type _} [Field K] {μ : K} [NeZero (n : K)] :
    IsRoot (cyclotomic n K) μ ↔ IsPrimitiveRoot μ n :=
  by
  -- in this proof, `o` stands for `order_of μ`
  have hnpos : 0 < n := (NeZero.of_neZero_natCast K).out.bot_lt
  refine' ⟨fun hμ => _, IsPrimitiveRoot.isRoot_cyclotomic hnpos⟩
  have hμn : μ ^ n = 1 := by
    rw [isRoot_of_unity_iff hnpos]
    exact ⟨n, n.mem_divisors_self hnpos.ne', hμ⟩
  by_contra hnμ
  have ho : 0 < orderOf μ := by
    apply orderOf_pos'
    rw [isOfFinOrder_iff_pow_eq_one]
    exact ⟨n, hnpos, hμn⟩
  have := pow_orderOf_eq_one μ
  rw [isRoot_of_unity_iff ho] at this
  obtain ⟨i, hio, hiμ⟩ := this
  replace hio := Nat.dvd_of_mem_divisors hio
  rw [IsPrimitiveRoot.not_iff] at hnμ
  rw [← orderOf_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_isRoot] at hμ hiμ
  have hni : {i, n} ⊆ n.divisors := by 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 <| NeZero.natCast_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.isUnit_iff_degree_eq_zero]
#align polynomial.is_root_cyclotomic_iff' polynomial.is_root_cyclotomic_iff'

theorem isRoot_cyclotomic_iff [NeZero (n : R)] {μ : R} :
    IsRoot (cyclotomic n R) μ ↔ IsPrimitiveRoot μ n :=
  by
  have hf : Function.Injective _ := IsFractionRing.injective R (FractionRing R)
  haveI : NeZero (n : FractionRing R) := NeZero.nat_of_injective hf
  rw [← is_root_map_iff hf, ← IsPrimitiveRoot.map_iff_of_injective hf, map_cyclotomic, ←
    is_root_cyclotomic_iff']
#align polynomial.is_root_cyclotomic_iff Polynomial.isRoot_cyclotomic_iff

theorem roots_cyclotomic_nodup [NeZero (n : R)] : (cyclotomic n R).roots.Nodup :=
  by
  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 (NeZero.pos_of_neZero_natCast R) 1) <|
        cyclotomic.dvd_X_pow_sub_one n R)
      hζ.nth_roots_nodup
#align polynomial.roots_cyclotomic_nodup Polynomial.roots_cyclotomic_nodup

theorem cyclotomic.roots_to_finset_eq_primitiveRoots [NeZero (n : R)] :
    (⟨(cyclotomic n R).roots, roots_cyclotomic_nodup⟩ : Finset _) = primitiveRoots n R :=
  by
  ext
  simp [cyclotomic_ne_zero n R, is_root_cyclotomic_iff, mem_primitiveRoots,
    NeZero.pos_of_neZero_natCast R]
#align polynomial.cyclotomic.roots_to_finset_eq_primitive_roots Polynomial.cyclotomic.roots_to_finset_eq_primitiveRoots

theorem cyclotomic.roots_eq_primitiveRoots_val [NeZero (n : R)] :
    (cyclotomic n R).roots = (primitiveRoots n R).val := by
  rw [← cyclotomic.roots_to_finset_eq_primitive_roots]
#align polynomial.cyclotomic.roots_eq_primitive_roots_val Polynomial.cyclotomic.roots_eq_primitiveRoots_val

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. -/
theorem isRoot_cyclotomic_iff_charZero {n : ℕ} {R : Type _} [CommRing R] [IsDomain R] [CharZero R]
    {μ : R} (hn : 0 < n) : (Polynomial.cyclotomic n R).IsRoot μ ↔ IsPrimitiveRoot μ n :=
  letI := NeZero.of_gt hn
  is_root_cyclotomic_iff
#align polynomial.is_root_cyclotomic_iff_char_zero Polynomial.isRoot_cyclotomic_iff_charZero

/-- Over a ring `R` of characteristic zero, `λ n, cyclotomic n R` is injective. -/
theorem cyclotomic_injective {R : Type _} [CommRing R] [CharZero R] :
    Function.Injective fun n => cyclotomic n R :=
  by
  intro 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 := NeZero.mk hzero
    rw [← map_cyclotomic_int _ R, ← map_cyclotomic_int _ R] at hnm
    replace hnm := map_injective (Int.castRingHom R) Int.cast_injective hnm
    replace hnm := congr_arg (map (Int.castRingHom ℂ)) hnm
    rw [map_cyclotomic_int, map_cyclotomic_int] at hnm
    have hprim := Complex.isPrimitiveRoot_exp _ hzero
    have hroot := is_root_cyclotomic_iff.2 hprim
    rw [hnm] at hroot
    haveI hmzero : NeZero m := ⟨fun h => by simpa [h] using hroot⟩
    rw [is_root_cyclotomic_iff] at hroot
    replace hprim := hprim.eq_order_of
    rwa [← IsPrimitiveRoot.eq_orderOf hroot] at hprim
#align polynomial.cyclotomic_injective Polynomial.cyclotomic_injective

theorem eq_cyclotomic_iff {R : Type _} [CommRing R] {n : ℕ} (hpos : 0 < n) (P : R[X]) :
    P = cyclotomic n R ↔ (P * ∏ i in Nat.properDivisors n, Polynomial.cyclotomic i R) = X ^ n - 1 :=
  by
  nontriviality R
  refine' ⟨fun hcycl => _, fun hP => _⟩
  ·
    rw [hcycl, ← prod_cyclotomic_eq_X_pow_sub_one hpos R, ← Nat.cons_self_properDivisors hpos.ne',
      Finset.prod_cons]
  · have prod_monic : (∏ i in Nat.properDivisors n, cyclotomic i R).Monic :=
      by
      apply monic_prod_of_monic
      intro 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)
#align polynomial.eq_cyclotomic_iff Polynomial.eq_cyclotomic_iff

/-- If `p ^ k` is a prime power, then
`cyclotomic (p ^ (n + 1)) R = ∑ i in range p, (X ^ (p ^ n)) ^ i`. -/
theorem cyclotomic_prime_pow_eq_geom_sum {R : Type _} [CommRing R] {p n : ℕ} (hp : p.Prime) :
    cyclotomic (p ^ (n + 1)) R = ∑ i in Finset.range p, (X ^ p ^ n) ^ i :=
  by
  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 :=
    by
    intro m
    have := eq_cyclotomic_iff (pow_pos hp.pos (m + 1)) _
    rw [eq_comm] at this
    rw [this, Nat.prod_properDivisors_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_properDivisors_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]
#align polynomial.cyclotomic_prime_pow_eq_geom_sum Polynomial.cyclotomic_prime_pow_eq_geom_sum

theorem cyclotomic_prime_pow_mul_x_pow_sub_one (R : Type _) [CommRing 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]
#align polynomial.cyclotomic_prime_pow_mul_X_pow_sub_one Polynomial.cyclotomic_prime_pow_mul_x_pow_sub_one

/-- The constant term of `cyclotomic n R` is `1` if `2 ≤ n`. -/
theorem cyclotomic_coeff_zero (R : Type _) [CommRing R] {n : ℕ} (hn : 1 < n) :
    (cyclotomic n R).coeff 0 = 1 :=
  by
  induction' n using Nat.strong_induction_on with n hi
  have hprod : (∏ i in Nat.properDivisors n, (Polynomial.cyclotomic i R).coeff 0) = -1 :=
    by
    rw [←
      Finset.insert_erase (Nat.one_mem_properDivisors_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 :=
      by
      intro 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_properDivisors (Finset.mem_erase.1 hj).2))
    have hcongr : ∀ j ∈ n.proper_divisors.erase 1, (cyclotomic j R).coeff 0 = 1 :=
      by
      intro j hj
      exact hi j (Nat.mem_properDivisors.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 :=
      by
      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 := by
    rw [← prod_cyclotomic_eq_X_pow_sub_one (zero_le_one.trans_lt hn), ←
      Nat.cons_self_properDivisors 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) :=
    by
    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)
#align polynomial.cyclotomic_coeff_zero Polynomial.cyclotomic_coeff_zero

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, where `p` is a prime, then `a` and `p` are
coprime. -/
theorem coprime_of_root_cyclotomic {n : ℕ} (hpos : 0 < n) {p : ℕ} [hprime : Fact p.Prime] {a : ℕ}
    (hroot : IsRoot (cyclotomic n (ZMod p)) (Nat.castRingHom (ZMod p) a)) : a.coprime p :=
  by
  apply Nat.coprime.symm
  rw [hprime.1.coprime_iff_not_dvd]
  intro h
  replace h := (ZMod.nat_cast_zmod_eq_zero_iff_dvd a p).2 h
  rw [is_root.def, eq_natCast, 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
#align polynomial.coprime_of_root_cyclotomic Polynomial.coprime_of_root_cyclotomic

end Cyclotomic

section Order

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, then the multiplicative order of `a` modulo
`p` divides `n`. -/
theorem orderOf_root_cyclotomic_dvd {n : ℕ} (hpos : 0 < n) {p : ℕ} [Fact p.Prime] {a : ℕ}
    (hroot : IsRoot (cyclotomic n (ZMod p)) (Nat.castRingHom (ZMod p) a)) :
    orderOf (ZMod.unitOfCoprime a (coprime_of_root_cyclotomic hpos hroot)) ∣ n :=
  by
  apply orderOf_dvd_of_pow_eq_one
  suffices hpow : eval (Nat.castRingHom (ZMod p) a) (X ^ n - 1 : (ZMod p)[X]) = 0
  · simp only [eval_X, eval_one, eval_pow, eval_sub, eq_natCast] at hpow
    apply Units.val_eq_one.1
    simp only [sub_eq_zero.mp hpow, ZMod.coe_unitOfCoprime, Units.val_pow_eq_pow_val]
  rw [is_root.def] at hroot
  rw [← prod_cyclotomic_eq_X_pow_sub_one hpos (ZMod p), ← Nat.cons_self_properDivisors hpos.ne',
    Finset.prod_cons, eval_mul, hroot, MulZeroClass.zero_mul]
#align polynomial.order_of_root_cyclotomic_dvd Polynomial.orderOf_root_cyclotomic_dvd

end Order

section minpoly

open IsPrimitiveRoot Complex

/-- The minimal polynomial of a primitive `n`-th root of unity `μ` divides `cyclotomic n ℤ`. -/
theorem IsPrimitiveRoot.minpoly_dvd_cyclotomic {n : ℕ} {K : Type _} [Field K] {μ : K}
    (h : IsPrimitiveRoot μ n) (hpos : 0 < n) [CharZero K] : minpoly ℤ μ ∣ cyclotomic n ℤ :=
  by
  apply minpoly.isIntegrallyClosed_dvd (IsIntegral h hpos)
  simpa [aeval_def, eval₂_eq_eval_map, is_root.def] using is_root_cyclotomic hpos h
#align is_primitive_root.minpoly_dvd_cyclotomic IsPrimitiveRoot.minpoly_dvd_cyclotomic

theorem IsPrimitiveRoot.minpoly_eq_cyclotomic_of_irreducible {K : Type _} [Field K] {R : Type _}
    [CommRing R] [IsDomain R] {μ : R} {n : ℕ} [Algebra K R] (hμ : IsPrimitiveRoot μ n)
    (h : Irreducible <| cyclotomic n K) [NeZero (n : K)] : cyclotomic n K = minpoly K μ :=
  by
  haveI := NeZero.of_noZeroSMulDivisors 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]
#align is_primitive_root.minpoly_eq_cyclotomic_of_irreducible IsPrimitiveRoot.minpoly_eq_cyclotomic_of_irreducible

/-- `cyclotomic n ℤ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
theorem cyclotomic_eq_minpoly {n : ℕ} {K : Type _} [Field K] {μ : K} (h : IsPrimitiveRoot μ n)
    (hpos : 0 < n) [CharZero K] : cyclotomic n ℤ = minpoly ℤ μ :=
  by
  refine'
    eq_of_monic_of_dvd_of_nat_degree_le (minpoly.monic (IsIntegral h hpos)) (cyclotomic.monic n ℤ)
      (h.minpoly_dvd_cyclotomic hpos) _
  simpa [nat_degree_cyclotomic n ℤ] using totient_le_degree_minpoly h
#align polynomial.cyclotomic_eq_minpoly Polynomial.cyclotomic_eq_minpoly

/-- `cyclotomic n ℚ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
theorem cyclotomic_eq_minpoly_rat {n : ℕ} {K : Type _} [Field K] {μ : K} (h : IsPrimitiveRoot μ n)
    (hpos : 0 < n) [CharZero K] : cyclotomic n ℚ = minpoly ℚ μ :=
  by
  rw [← map_cyclotomic_int, cyclotomic_eq_minpoly h hpos]
  exact (minpoly.isIntegrallyClosed_eq_field_fractions' _ (IsIntegral h hpos)).symm
#align polynomial.cyclotomic_eq_minpoly_rat Polynomial.cyclotomic_eq_minpoly_rat

/-- `cyclotomic n ℤ` is irreducible. -/
theorem cyclotomic.irreducible {n : ℕ} (hpos : 0 < n) : Irreducible (cyclotomic n ℤ) :=
  by
  rw [cyclotomic_eq_minpoly (is_primitive_root_exp n hpos.ne') hpos]
  apply minpoly.irreducible
  exact (is_primitive_root_exp n hpos.ne').IsIntegral hpos
#align polynomial.cyclotomic.irreducible Polynomial.cyclotomic.irreducible

/-- `cyclotomic n ℚ` is irreducible. -/
theorem cyclotomic.irreducible_rat {n : ℕ} (hpos : 0 < n) : Irreducible (cyclotomic n ℚ) :=
  by
  rw [← map_cyclotomic_int]
  exact
    (is_primitive.irreducible_iff_irreducible_map_fraction_map (cyclotomic.is_primitive n ℤ)).1
      (cyclotomic.irreducible hpos)
#align polynomial.cyclotomic.irreducible_rat Polynomial.cyclotomic.irreducible_rat

/-- If `n ≠ m`, then `(cyclotomic n ℚ)` and `(cyclotomic m ℚ)` are coprime. -/
theorem cyclotomic.isCoprime_rat {n m : ℕ} (h : n ≠ m) :
    IsCoprime (cyclotomic n ℚ) (cyclotomic m ℚ) :=
  by
  rcases n.eq_zero_or_pos with (rfl | hnzero)
  · exact isCoprime_one_left
  rcases m.eq_zero_or_pos with (rfl | hmzero)
  · exact isCoprime_one_right
  rw [Irreducible.coprime_iff_not_dvd <| cyclotomic.irreducible_rat <| hnzero]
  exact fun 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
#align polynomial.cyclotomic.is_coprime_rat Polynomial.cyclotomic.isCoprime_rat

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]
theorem cyclotomic_expand_eq_cyclotomic_mul {p n : ℕ} (hp : Nat.Prime p) (hdiv : ¬p ∣ n)
    (R : Type _) [CommRing R] :
    expand R p (cyclotomic n R) = cyclotomic (n * p) R * cyclotomic n R :=
  by
  rcases Nat.eq_zero_or_pos n with (rfl | hnpos)
  · simp
  haveI := NeZero.of_pos hnpos
  suffices expand ℤ p (cyclotomic n ℤ) = cyclotomic (n * p) ℤ * cyclotomic n ℤ by
    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).IsPrimitive).2
        _
    rw [Polynomial.map_mul, map_cyclotomic_int, map_cyclotomic_int, map_expand, map_cyclotomic_int]
    refine' IsCoprime.mul_dvd (cyclotomic.is_coprime_rat fun 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.isPrimitiveRoot_exp _ hpos.ne'
      rw [cyclotomic_eq_minpoly_rat hprim hpos]
      refine' @minpoly.dvd ℚ ℂ _ _ algebraRat _ _ _
      rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval, ← is_root.def,
        is_root_cyclotomic_iff]
      convert IsPrimitiveRoot.pow_of_dvd hprim hp.ne_zero (dvd_mul_left p n)
      rw [Nat.mul_div_cancel _ (Nat.Prime.pos hp)]
    · have hprim := Complex.isPrimitiveRoot_exp _ hnpos.ne.symm
      rw [cyclotomic_eq_minpoly_rat hprim hnpos]
      refine' @minpoly.dvd ℚ ℂ _ _ algebraRat _ _ _
      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 IsPrimitiveRoot.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]
#align polynomial.cyclotomic_expand_eq_cyclotomic_mul Polynomial.cyclotomic_expand_eq_cyclotomic_mul

/-- If `p` is a prime such that `p ∣ n`, then
`expand R p (cyclotomic n R) = cyclotomic (p * n) R`. -/
@[simp]
theorem cyclotomic_expand_eq_cyclotomic {p n : ℕ} (hp : Nat.Prime p) (hdiv : p ∣ n) (R : Type _)
    [CommRing R] : expand R p (cyclotomic n R) = cyclotomic (n * p) R :=
  by
  rcases n.eq_zero_or_pos with (rfl | hzero)
  · simp
  haveI := NeZero.of_pos hzero
  suffices expand ℤ p (cyclotomic n ℤ) = cyclotomic (n * p) ℤ by
    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.isPrimitiveRoot_exp _ hpos.ne.symm
    rw [cyclotomic_eq_minpoly hprim hpos]
    refine' minpoly.isIntegrallyClosed_dvd (hprim.is_integral hpos) _
    rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval, ← is_root.def,
      is_root_cyclotomic_iff]
    · convert IsPrimitiveRoot.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]
#align polynomial.cyclotomic_expand_eq_cyclotomic Polynomial.cyclotomic_expand_eq_cyclotomic

/-- If the `p ^ n`th cyclotomic polynomial is irreducible, so is the `p ^ m`th, for `m ≤ n`. -/
theorem cyclotomic_irreducible_pow_of_irreducible_pow {p : ℕ} (hp : Nat.Prime p) {R} [CommRing R]
    [IsDomain R] {n m : ℕ} (hmn : m ≤ n) (h : Irreducible (cyclotomic (p ^ n) R)) :
    Irreducible (cyclotomic (p ^ m) R) :=
  by
  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)
#align polynomial.cyclotomic_irreducible_pow_of_irreducible_pow Polynomial.cyclotomic_irreducible_pow_of_irreducible_pow

/-- If `irreducible (cyclotomic (p ^ n) R)` then `irreducible (cyclotomic p R).` -/
theorem cyclotomic_irreducible_of_irreducible_pow {p : ℕ} (hp : Nat.Prime p) {R} [CommRing R]
    [IsDomain 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
#align polynomial.cyclotomic_irreducible_of_irreducible_pow Polynomial.cyclotomic_irreducible_of_irreducible_pow

end Expand

section CharP

/-- If `R` is of characteristic `p` and `¬p ∣ n`, then
`cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1)`. -/
theorem cyclotomic_mul_prime_eq_pow_of_not_dvd (R : Type _) {p n : ℕ} [hp : Fact (Nat.Prime p)]
    [Ring R] [CharP R p] (hn : ¬p ∣ n) : cyclotomic (n * p) R = cyclotomic n R ^ (p - 1) :=
  by
  suffices cyclotomic (n * p) (ZMod p) = cyclotomic n (ZMod p) ^ (p - 1) by
    rw [← map_cyclotomic _ (algebraMap (ZMod p) R), ← map_cyclotomic _ (algebraMap (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_rw 3 [← map_cyclotomic_int]
  rw [← map_expand, cyclotomic_expand_eq_cyclotomic_mul hp.out hn, Polynomial.map_mul,
    map_cyclotomic, map_cyclotomic]
#align polynomial.cyclotomic_mul_prime_eq_pow_of_not_dvd Polynomial.cyclotomic_mul_prime_eq_pow_of_not_dvd

/-- If `R` is of characteristic `p` and `p ∣ n`, then
`cyclotomic (n * p) R = (cyclotomic n R) ^ p`. -/
theorem cyclotomic_mul_prime_dvd_eq_pow (R : Type _) {p n : ℕ} [hp : Fact (Nat.Prime p)] [Ring R]
    [CharP R p] (hn : p ∣ n) : cyclotomic (n * p) R = cyclotomic n R ^ p :=
  by
  suffices cyclotomic (n * p) (ZMod p) = cyclotomic n (ZMod p) ^ p by
    rw [← map_cyclotomic _ (algebraMap (ZMod p) R), ← map_cyclotomic _ (algebraMap (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]
#align polynomial.cyclotomic_mul_prime_dvd_eq_pow Polynomial.cyclotomic_mul_prime_dvd_eq_pow

/-- If `R` is of characteristic `p` and `¬p ∣ m`, then
`cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))`. -/
theorem cyclotomic_mul_prime_pow_eq (R : Type _) {p m : ℕ} [Fact (Nat.Prime p)] [Ring R] [CharP 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, _ =>
    by
    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']
#align polynomial.cyclotomic_mul_prime_pow_eq Polynomial.cyclotomic_mul_prime_pow_eq

/-- 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. -/
theorem isRoot_cyclotomic_prime_pow_mul_iff_of_charP {m k p : ℕ} {R : Type _} [CommRing R]
    [IsDomain R] [hp : Fact (Nat.Prime p)] [hchar : CharP R p] {μ : R} [NeZero (m : R)] :
    (Polynomial.cyclotomic (p ^ k * m) R).IsRoot μ ↔ IsPrimitiveRoot μ m :=
  by
  rcases k.eq_zero_or_pos with (rfl | hk)
  · rw [pow_zero, one_mul, is_root_cyclotomic_iff]
  refine' ⟨fun h => _, fun h => _⟩
  · rw [is_root.def, cyclotomic_mul_prime_pow_eq R (NeZero.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 (NeZero.not_char_dvd R p m) hk, is_root.def, eval_pow, h,
      zero_pow]
    simp only [tsub_pos_iff_lt]
    apply pow_strictMono_right hp.out.one_lt (Nat.pred_lt hk.ne')
#align polynomial.is_root_cyclotomic_prime_pow_mul_iff_of_char_p Polynomial.isRoot_cyclotomic_prime_pow_mul_iff_of_charP

end CharP

end Polynomial


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import data.list.join
import data.set.lattice

/-!
# Languages

This file contains the definition and operations on formal languages over an alphabet. Note strings
are implemented as lists over the alphabet.
The operations in this file define a [Kleene algebra](https://en.wikipedia.org/wiki/Kleene_algebra)
over the languages.
-/

open list set

universes v

variables {α β γ : Type*}

/-- A language is a set of strings over an alphabet. -/
@[derive [has_mem (list α), has_singleton (list α), has_insert (list α), complete_boolean_algebra]]
def language (α) := set (list α)

namespace language
variables {l m : language α} {a b x : list α}

local attribute [reducible] language

/-- Zero language has no elements. -/
instance : has_zero (language α) := ⟨(∅ : set _)⟩
/-- `1 : language α` contains only one element `[]`. -/
instance : has_one (language α) := ⟨{[]}⟩

instance : inhabited (language α) := ⟨0⟩

/-- The sum of two languages is their union. -/
instance : has_add (language α) := ⟨(∪)⟩

/-- The product of two languages `l` and `m` is the language made of the strings `x ++ y` where
`x ∈ l` and `y ∈ m`. -/
instance : has_mul (language α) := ⟨image2 (++)⟩

lemma zero_def : (0 : language α) = (∅ : set _) := rfl
lemma one_def : (1 : language α) = {[]} := rfl

lemma add_def (l m : language α) : l + m = l ∪ m := rfl
lemma mul_def (l m : language α) : l * m = image2 (++) l m := rfl

/-- The star of a language `L` is the set of all strings which can be written by concatenating
  strings from `L`. -/
def star (l : language α) : language α :=
{ x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l}

lemma star_def (l : language α) :
  l.star = { x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l} := rfl

@[simp] lemma not_mem_zero (x : list α) : x ∉ (0 : language α) := id
@[simp] lemma mem_one (x : list α) : x ∈ (1 : language α) ↔ x = [] := by refl
lemma nil_mem_one : [] ∈ (1 : language α) := set.mem_singleton _
@[simp] lemma mem_add (l m : language α) (x : list α) : x ∈ l + m ↔ x ∈ l ∨ x ∈ m := iff.rfl
lemma mem_mul : x ∈ l * m ↔ ∃ a b, a ∈ l ∧ b ∈ m ∧ a ++ b = x := mem_image2
lemma append_mem_mul : a ∈ l → b ∈ m → a ++ b ∈ l * m := mem_image2_of_mem
lemma mem_star : x ∈ l.star ↔ ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l := iff.rfl
lemma join_mem_star {S : list (list α)} (h : ∀ y ∈ S, y ∈ l) : S.join ∈ l.star := ⟨S, rfl, h⟩
lemma nil_mem_star (l : language α) : [] ∈ l.star := ⟨[], rfl, λ _, false.elim⟩

instance : semiring (language α) :=
{ add := (+),
  add_assoc := union_assoc,
  zero := 0,
  zero_add := empty_union,
  add_zero := union_empty,
  add_comm := union_comm,
  mul := (*),
  mul_assoc := λ _ _ _, image2_assoc append_assoc,
  zero_mul := λ _, image2_empty_left,
  mul_zero := λ _, image2_empty_right,
  one := 1,
  one_mul := λ l, by simp [mul_def, one_def],
  mul_one := λ l, by simp [mul_def, one_def],
  nat_cast := λ n, if n = 0 then 0 else 1,
  nat_cast_zero := rfl,
  nat_cast_succ := λ n, by cases n; simp [nat.cast, add_def, zero_def],
  left_distrib := λ _ _ _, image2_union_right,
  right_distrib := λ _ _ _, image2_union_left }

@[simp] lemma add_self (l : language α) : l + l = l := sup_idem

/-- Maps the alphabet of a language. -/
def map (f : α → β) : language α →+* language β :=
{ to_fun := image (list.map f),
  map_zero' := image_empty _,
  map_one' := image_singleton,
  map_add' := image_union _,
  map_mul' := λ _ _, image_image2_distrib $ map_append _ }

@[simp] lemma map_id (l : language α) : map id l = l := by simp [map]
@[simp] lemma map_map (g : β → γ) (f : α → β) (l : language α) : map g (map f l) = map (g ∘ f) l :=
by simp [map, image_image]

lemma star_def_nonempty (l : language α) :
  l.star = {x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l ∧ y ≠ []} :=
begin
  ext x,
  split,
  { rintro ⟨S, rfl, h⟩,
    refine ⟨S.filter (λ l, ¬list.empty l), by simp, λ y hy, _⟩,
    rw [mem_filter, empty_iff_eq_nil] at hy,
    exact ⟨h y hy.1, hy.2⟩ },
  { rintro ⟨S, hx, h⟩,
    exact ⟨S, hx, λ y hy, (h y hy).1⟩ }
end

lemma le_mul_congr {l₁ l₂ m₁ m₂ : language α} : l₁ ≤ m₁ → l₂ ≤ m₂ → l₁ * l₂ ≤ m₁ * m₂ :=
begin
  intros h₁ h₂ x hx,
  simp only [mul_def, exists_and_distrib_left, mem_image2, image_prod] at hx ⊢,
  tauto
end

lemma le_add_congr {l₁ l₂ m₁ m₂ : language α} : l₁ ≤ m₁ → l₂ ≤ m₂ → l₁ + l₂ ≤ m₁ + m₂ := sup_le_sup

lemma mem_supr {ι : Sort v} {l : ι → language α} {x : list α} :
  x ∈ (⨆ i, l i) ↔ ∃ i, x ∈ l i :=
mem_Union

lemma supr_mul {ι : Sort v} (l : ι → language α) (m : language α) :
  (⨆ i, l i) * m = ⨆ i, l i * m :=
image2_Union_left _ _ _

lemma mul_supr {ι : Sort v} (l : ι → language α) (m : language α) :
  m * (⨆ i, l i) = ⨆ i, m * l i :=
image2_Union_right _ _ _

lemma supr_add {ι : Sort v} [nonempty ι] (l : ι → language α) (m : language α) :
  (⨆ i, l i) + m = ⨆ i, l i + m := supr_sup

lemma add_supr {ι : Sort v} [nonempty ι] (l : ι → language α) (m : language α) :
  m + (⨆ i, l i) = ⨆ i, m + l i := sup_supr

lemma mem_pow {l : language α} {x : list α} {n : ℕ} :
  x ∈ l ^ n ↔ ∃ S : list (list α), x = S.join ∧ S.length = n ∧ ∀ y ∈ S, y ∈ l :=
begin
  induction n with n ihn generalizing x,
  { simp only [mem_one, pow_zero, length_eq_zero],
    split,
    { rintro rfl, exact ⟨[], rfl, rfl, λ y h, h.elim⟩ },
    { rintro ⟨_, rfl, rfl, _⟩, refl } },
  { simp only [pow_succ, mem_mul, ihn],
    split,
    { rintro ⟨a, b, ha, ⟨S, rfl, rfl, hS⟩, rfl⟩,
      exact ⟨a :: S, rfl, rfl, forall_mem_cons.2 ⟨ha, hS⟩⟩ },
    { rintro ⟨_|⟨a, S⟩, rfl, hn, hS⟩; cases hn,
      rw forall_mem_cons at hS,
      exact ⟨a, _, hS.1, ⟨S, rfl, rfl, hS.2⟩, rfl⟩ } }
end

lemma star_eq_supr_pow (l : language α) : l.star = ⨆ i : ℕ, l ^ i :=
begin
  ext x,
  simp only [mem_star, mem_supr, mem_pow],
  split,
  { rintro ⟨S, rfl, hS⟩, exact ⟨_, S, rfl, rfl, hS⟩ },
  { rintro ⟨_, S, rfl, rfl, hS⟩, exact ⟨S, rfl, hS⟩ }
end

@[simp] lemma map_star (f : α → β) (l : language α) : map f (star l) = star (map f l) :=
begin
  rw [star_eq_supr_pow, star_eq_supr_pow],
  simp_rw ←map_pow,
  exact image_Union,
end

lemma mul_self_star_comm (l : language α) : l.star * l = l * l.star :=
by simp only [star_eq_supr_pow, mul_supr, supr_mul, ← pow_succ, ← pow_succ']

@[simp] lemma one_add_self_mul_star_eq_star (l : language α) : 1 + l * l.star = l.star :=
begin
  simp only [star_eq_supr_pow, mul_supr, ← pow_succ, ← pow_zero l],
  exact sup_supr_nat_succ _
end

@[simp] lemma one_add_star_mul_self_eq_star (l : language α) : 1 + l.star * l = l.star :=
by rw [mul_self_star_comm, one_add_self_mul_star_eq_star]

lemma star_mul_le_right_of_mul_le_right (l m : language α) : l * m ≤ m → l.star * m ≤ m :=
begin
  intro h,
  rw [star_eq_supr_pow, supr_mul],
  refine supr_le _,
  intro n,
  induction n with n ih,
  { simp },
  rw [pow_succ', mul_assoc (l^n) l m],
  exact le_trans (le_mul_congr le_rfl h) ih,
end

lemma star_mul_le_left_of_mul_le_left (l m : language α) : m * l ≤ m → m * l.star ≤ m :=
begin
  intro h,
  rw [star_eq_supr_pow, mul_supr],
  refine supr_le _,
  intro n,
  induction n with n ih,
  { simp },
  rw [pow_succ, ←mul_assoc m l (l^n)],
  exact le_trans (le_mul_congr h le_rfl) ih
end

end language


import tuto_lib
/-
This file continues the elementary study of limits of sequences.
It can be skipped if the previous file was too easy, it won't introduce
any new tactic or trick.

Remember useful lemmas:

abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub (x y : ℝ) : |x - y| = |y - x|

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

and the definition:

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

You can also use a property proved in the previous file:

unique_limit : seq_limit u l → seq_limit u l' → l = l'

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m
-/

variable { φ : ℕ → ℕ}

/-
The next lemma is proved by an easy induction, but we haven't seen induction
in this tutorial. If you did the natural number game then you can delete
the proof below and try to reconstruct it.
-/
/-- An extraction is greater than id -/
lemma id_le_extraction' : extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

/-- Extractions take arbitrarily large values for arbitrarily large
inputs. -/
-- 0039
lemma extraction_ge : extraction φ → ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  -- sorry
  intros h N N',
  use max N N',
  split,
  apply le_max_right,
  calc
    N ≤ max N N'     : by apply le_max_left
  ... ≤ φ (max N N') : by apply id_le_extraction' h
  -- sorry
end

/-- A real number `a` is a cluster point of a sequence `u`
if `u` has a subsequence converging to `a`.

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a
-/

variables {u : ℕ → ℝ} {a l : ℝ}

/-
In the exercise, we use `∃ n ≥ N, ...` which is the abbreviation of
`∃ n, n ≥ N ∧ ...`.
Lean can read this abbreviation, but displays it as the confusing:
`∃ (n : ℕ) (H : n ≥ N)`
One gets used to it. Alternatively, one can get rid of it using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q
-/

/-- If `a` is a cluster point of `u` then there are values of
`u` arbitrarily close to `a` for arbitrarily large input. -/
-- 0040
lemma near_cluster :
  cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  -- sorry
  intros hyp ε ε_pos N,
  rcases hyp with ⟨φ, φ_extr, hφ⟩,
  cases hφ ε ε_pos with N' hN',
  rcases extraction_ge φ_extr N N' with ⟨q, hq, hq'⟩,
  exact ⟨φ q, hq', hN' _ hq⟩,
  -- sorry
end

/-
The above exercice can be done in five lines.
Hint: you can use the anonymous constructor syntax when proving
existential statements.
-/

/-- If `u` tends to `l` then its subsequences tend to `l`. -/
-- 0041
lemma subseq_tendsto_of_tendsto' (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  -- sorry
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_le_extraction' hφ n,
  -- sorry
end

/-- If `u` tends to `l` all its cluster points are equal to `l`. -/
-- 0042
lemma cluster_limit (hl : seq_limit u l) (ha : cluster_point u a) : a = l :=
begin
  -- sorry
  rcases ha with ⟨φ, φ_extr, lim_u_φ⟩,
  have lim_u_φ' : seq_limit (u ∘ φ) l,
    from subseq_tendsto_of_tendsto' hl φ_extr,
  exact unique_limit lim_u_φ lim_u_φ',
  -- sorry
end

/-- Cauchy_sequence sequence -/
def cauchy_sequence (u : ℕ → ℝ) := ∀ ε > 0, ∃ N, ∀ p q, p ≥ N → q ≥ N → |u p - u q| ≤ ε

-- 0043
example : (∃ l, seq_limit u l) → cauchy_sequence u :=
begin
  -- sorry
  intro hyp,
  cases hyp with l hl,
  intros ε ε_pos,
  cases hl (ε/2) (by linarith) with N hN,
  use N,
  intros p q hp hq,
  calc |u p - u q| = |(u p - l) + (l - u q)| : by ring
  ... ≤ |u p - l| + |l - u q| : by apply abs_add
  ... =  |u p - l| + |u q - l| : by rw abs_sub (u q) l
  ... ≤ ε : by linarith [hN p hp, hN q hq],
  -- sorry
end

/-
In the next exercise, you can reuse
 near_cluster : cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε
-/
-- 0044
example (hu : cauchy_sequence u) (hl : cluster_point u l) : seq_limit u l :=
begin
  -- sorry
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N hN,
  use N,
  have clef : ∃ N' ≥ N, |u N' - l| ≤ ε/2,
    apply near_cluster hl (ε/2) (by linarith),
  cases clef with N' h,
  cases h with hNN' hN',
  intros n hn,
  calc |u n - l| = |(u n - u N') + (u N' - l)| : by ring
  ... ≤ |u n - u N'| + |u N' - l| : by apply abs_add
  ... ≤ ε : by linarith [hN n N' (by linarith) hNN'],
  -- sorry
end