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

import field_theory.splitting_field
import ring_theory.roots_of_unity
import algebra.polynomial.big_operators
import number_theory.arithmetic_function
import data.polynomial.lifts
import analysis.complex.roots_of_unity
import field_theory.separable

/-!
# 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 `polynomial R`.
* `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 `polynomial R`, for any ring `R`.
To prove `cyclotomic.irreducible`, the irreducibility of `cyclotomic n ℤ`, we show in
`minpoly_primitive_root_eq_cyclotomic` that `cyclotomic n ℤ` is the minimal polynomial of
any `n`-th primitive root of unity `μ : K`, where `K` is a field of characteristic `0`.
-/

open_locale classical big_operators
noncomputable theory

universe u

namespace polynomial

section cyclotomic'

section integral_domain

variables {R : Type*} [integral_domain R]

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

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

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

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

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

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

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

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

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

end integral_domain

section field

variables {K : Type*} [field K]

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

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

/-- If there is a primitive `n`-th root of unity in `K`, then `X ^ n - 1`splits. -/
lemma X_pow_sub_one_splits {ζ : K} {n : ℕ} (h : is_primitive_root ζ n) :
  splits (ring_hom.id K) (X ^ n - C (1 : K)) :=
begin
  by_cases hzero : n = 0,
  { simp only [hzero, ring_hom.map_one, splits_zero, pow_zero, sub_self] },
  rw [splits_iff_card_roots, ← nth_roots, is_primitive_root.card_nth_roots h,
    nat_degree_X_pow_sub_C],
end

/-- If there is a primitive `n`-th root of unity in `K`, then
`∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1`. -/
lemma prod_cyclotomic'_eq_X_pow_sub_one {ζ : K} {n : ℕ} (hpos : 0 < n) (h : is_primitive_root ζ n) :
  ∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1 :=
begin
  rw [X_pow_sub_one_eq_prod hpos h],
  have rwcyc : ∀ i ∈ nat.divisors n, cyclotomic' i K = ∏ μ in primitive_roots i K, (X - C μ),
  { intros i hi,
    simp only [cyclotomic'] },
  conv_lhs { apply_congr,
             skip,
             simp [rwcyc, H] },
  rw ← finset.prod_bUnion,
  { simp only [is_primitive_root.nth_roots_one_eq_bUnion_primitive_roots hpos h] },
  intros x hx y hy hdiff,
  simp only [nat.mem_divisors, and_true, ne.def, pnat.ne_zero, not_false_iff] at hx hy,
  refine is_primitive_root.disjoint _ _ hdiff,
  { exact @nat.pos_of_mem_divisors n x (nat.mem_divisors.2 hx) },
  { exact @nat.pos_of_mem_divisors n y (nat.mem_divisors.2 hy) }
end

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

/-- If there is a primitive `n`-th root of unity in `K`, then `cyclotomic' n K` comes from a
polynomial with integer coefficients. -/
lemma int_coeff_of_cyclotomic {ζ : K} {n : ℕ} (h : is_primitive_root ζ n) :
  (∃ (P : polynomial ℤ), map (int.cast_ring_hom K) P = cyclotomic' n K ∧
  P.degree = (cyclotomic' n K).degree ∧ P.monic) :=
begin
  refine lifts_and_degree_eq_and_monic _ (cyclotomic'.monic n K),
  revert h ζ,
  apply nat.strong_induction_on n,
  intros k hk z hzeta,
  cases nat.eq_zero_or_pos k with hzero hpos,
  { use 1,
    simp only [hzero, cyclotomic'_zero, set.mem_univ, subsemiring.coe_top, eq_self_iff_true,
    map_one, ring_hom.coe_of, and_self], },
  by_cases hone : k = 1,
  { use X - 1,
    simp only [hone, cyclotomic'_one K, set.mem_univ, pnat.one_coe, subsemiring.coe_top,
    eq_self_iff_true, map_X, map_one, ring_hom.coe_of, and_self, map_sub] },
  let B : polynomial K := ∏ i in nat.proper_divisors k, cyclotomic' i K,
  have Bmo : B.monic,
  { apply monic_prod_of_monic,
    intros i hi,
    exact (cyclotomic'.monic i K) },
  have Bint : B ∈ lifts (int.cast_ring_hom K),
  { refine subsemiring.prod_mem (lifts (int.cast_ring_hom K)) _,
    intros x hx,
    have xsmall := (nat.mem_proper_divisors.1 hx).2,
    obtain ⟨d, hd⟩ := (nat.mem_proper_divisors.1 hx).1,
    rw [mul_comm] at hd,
  exact hk x xsmall (is_primitive_root.pow hpos hzeta hd) },
  replace Bint := lifts_and_degree_eq_and_monic Bint Bmo,
  obtain ⟨B₁, hB₁, hB₁deg, hB₁mo⟩ := Bint,
  let Q₁ : polynomial ℤ := (X ^ k - 1) /ₘ B₁,
  have huniq : 0 + B * cyclotomic' k K = X ^ k - 1 ∧ (0 : polynomial K).degree < B.degree,
  { split,
    { rw [zero_add, mul_comm, ←(prod_cyclotomic'_eq_X_pow_sub_one hpos hzeta),
      nat.divisors_eq_proper_divisors_insert_self_of_pos hpos],
      simp only [true_and, finset.prod_insert, not_lt, nat.mem_proper_divisors, dvd_refl] },
    rw [degree_zero, bot_lt_iff_ne_bot],
    intro habs,
    exact (monic.ne_zero Bmo) (degree_eq_bot.1 habs) },
  replace huniq := div_mod_by_monic_unique (cyclotomic' k K) (0 : polynomial K) Bmo huniq,
  simp only [lifts, ring_hom.coe_of, ring_hom.mem_srange],
  use Q₁,
  rw [(map_div_by_monic (int.cast_ring_hom K) hB₁mo), hB₁, ← huniq.1],
  simp
end

/-- If `K` is of characteristic `0` and there is a primitive `n`-th root of unity in `K`,
then `cyclotomic n K` comes from a unique polynomial with integer coefficients. -/
lemma unique_int_coeff_of_cycl [char_zero K] {ζ : K} {n : ℕ+} (h : is_primitive_root ζ n) :
  (∃! (P : polynomial ℤ), map (int.cast_ring_hom K) P = cyclotomic' n K) :=
begin
  obtain ⟨P, hP⟩ := int_coeff_of_cyclotomic h,
  rw exists_unique,
  use [P, hP.1],
  intros Q hQ,
  have mapinj : function.injective (map (int.cast_ring_hom K)),
  { apply map_injective,
    simp only [int.cast_injective, int.coe_cast_ring_hom] },
  rw [function.injective] at mapinj,
  apply mapinj,
  rw [hP.1, hQ]
end

end field

end cyclotomic'

section cyclotomic

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

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

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

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

lemma int_cyclotomic_unique {n : ℕ} {P : polynomial ℤ} (h : map (int.cast_ring_hom ℂ) P =
  cyclotomic' n ℂ) : P = cyclotomic n ℤ :=
begin
  have mapinj : function.injective (map (int.cast_ring_hom ℂ)),
  { apply map_injective,
    simp only [int.cast_injective, int.coe_cast_ring_hom] },
  apply mapinj,
  rw [h, (int_cyclotomic_spec n).1]
end

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

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

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

/-- The second cyclotomic polyomial is `X + 1`. -/
@[simp] lemma cyclotomic_two (R : Type*) [ring R] : cyclotomic 2 R = X + 1 :=
begin
  have hspec : map (int.cast_ring_hom ℂ) (X + 1) = cyclotomic' 2 ℂ,
  { simp only [cyclotomic'_two ℂ 0 two_ne_zero.symm, map_add, map_X, map_one] },
  symmetry,
  rw [←map_cyclotomic_int, ←(int_cyclotomic_unique hspec)],
  simp only [map_add, map_X, map_one]
end

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

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

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

/-- The natural degree of `cyclotomic n` is `totient n`. -/
lemma nat_degree_cyclotomic (n : ℕ) (R : Type*) [ring R] [nontrivial R] :
  (cyclotomic n R).nat_degree = nat.totient n :=
begin
  have hdeg := degree_cyclotomic n R,
  rw degree_eq_nat_degree (cyclotomic_ne_zero n R) at hdeg,
  norm_cast at hdeg,
  exact hdeg
end

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

/-- `∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1`. -/
lemma prod_cyclotomic_eq_X_pow_sub_one {n : ℕ} (hpos : 0 < n) (R : Type*) [comm_ring R] :
  ∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1 :=
begin
  have integer : ∏ i in nat.divisors n, cyclotomic i ℤ = X ^ n - 1,
  { have mapinj : function.injective (map (int.cast_ring_hom ℂ)),
    { apply map_injective,
      simp only [int.cast_injective, int.coe_cast_ring_hom] },
    apply mapinj,
    rw map_prod (int.cast_ring_hom ℂ) (λ i, cyclotomic i ℤ),
    simp only [int_cyclotomic_spec, map_pow, nat.cast_id, map_X, map_one, ring_hom.coe_of, map_sub],
    exact prod_cyclotomic'_eq_X_pow_sub_one hpos
    (complex.is_primitive_root_exp n (ne_of_lt hpos).symm) },
  have coerc : X ^ n - 1 = map (int.cast_ring_hom R) (X ^ n - 1),
  { simp only [map_pow, map_X, map_one, map_sub] },
  have h : ∀ i ∈ n.divisors, cyclotomic i R = map (int.cast_ring_hom R) (cyclotomic i ℤ),
  { intros i hi,
    exact (map_cyclotomic_int i R).symm },
  rw [finset.prod_congr (refl n.divisors) h, coerc, ←map_prod (int.cast_ring_hom R)
  (λ i, cyclotomic i ℤ), integer]
end

section arithmetic_function
open nat.arithmetic_function
open_locale arithmetic_function

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

end arithmetic_function

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

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

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

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

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

/-- If `p` is prime, then `cyclotomic p R = geom_sum X p`. -/
lemma cyclotomic_eq_geom_sum {R : Type*} [comm_ring R] [nontrivial R] {p : ℕ}
  (hp : nat.prime p) : cyclotomic p R = geom_sum X p :=
begin
  symmetry,
  refine (eq_cyclotomic_iff hp.pos _).mpr _,
  simp only [nat.prime.proper_divisors hp, geom_sum_mul, finset.prod_singleton, cyclotomic_one],
end

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

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

end cyclotomic

section order

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

/-- If `(a : ℕ)` is a root of `cyclotomic n (zmod p)`, where `p` is a prime that does not divide
`n`, then the multiplicative order of `a` modulo `p` is exactly `n`. -/
lemma order_of_root_cyclotomic {n : ℕ} (hpos : 0 < n) {p : ℕ} [fact p.prime] {a : ℕ}
  (hn : ¬ p ∣ n) (hroot : is_root (cyclotomic n (zmod p)) (nat.cast_ring_hom (zmod p) a)) :
  order_of (zmod.unit_of_coprime a (coprime_of_root_cyclotomic hpos hroot)) = n :=
begin
  set m := order_of (zmod.unit_of_coprime a (coprime_of_root_cyclotomic hpos hroot)),
  have ha := coprime_of_root_cyclotomic hpos hroot,
  have hdivcycl : map (int.cast_ring_hom (zmod p)) (X - a) ∣ (cyclotomic n (zmod p)),
  { replace hrootdiv := dvd_iff_is_root.2 hroot,
    simp only [C_eq_nat_cast, ring_hom.eq_nat_cast] at hrootdiv,
    simp only [hrootdiv, map_nat_cast, map_X, map_sub] },
  by_contra hdiff,
  have hdiv : map (int.cast_ring_hom (zmod p)) (X - a) ∣
    ∏ i in nat.proper_divisors n, cyclotomic i (zmod p),
  { suffices hdivm : map (int.cast_ring_hom (zmod p)) (X - a) ∣ X ^ m - 1,
    { exact dvd_trans hdivm (X_pow_sub_one_dvd_prod_cyclotomic (zmod p) hpos
        (order_of_root_cyclotomic_dvd hpos hroot) hdiff) },
    rw [map_sub, map_X, map_nat_cast, ← C_eq_nat_cast, dvd_iff_is_root, is_root.def, eval_sub,
      eval_pow, eval_one, eval_X, sub_eq_zero, ← zmod.coe_unit_of_coprime a ha, ← units.coe_pow,
      units.coe_eq_one],
    exact pow_order_of_eq_one (zmod.unit_of_coprime a ha) },
  have habs : (map (int.cast_ring_hom (zmod p)) (X - a)) ^ 2 ∣ X ^ n - 1,
  { obtain ⟨P, hP⟩ := hdivcycl,
    obtain ⟨Q, hQ⟩ := hdiv,
    rw [← prod_cyclotomic_eq_X_pow_sub_one hpos, nat.divisors_eq_proper_divisors_insert_self_of_pos
      hpos, finset.prod_insert nat.proper_divisors.not_self_mem, hP, hQ],
    exact ⟨P * Q, by ring⟩ },
  have hnzero : ↑n ≠ (0 : (zmod p)),
  { intro ha,
    exact hn (int.coe_nat_dvd.1 ((zmod.int_coe_zmod_eq_zero_iff_dvd n p).1 ha)) },
  rw [sq] at habs,
  replace habs := squarefree_X_pow_sub_C (1 : (zmod p)) hnzero one_ne_zero
    (map (int.cast_ring_hom (zmod p)) (X - a)) habs,
  simp only [map_nat_cast, map_X, map_sub] at habs,
  replace habs := degree_eq_zero_of_is_unit habs,
  rw [← C_eq_nat_cast, degree_X_sub_C] at habs,
  norm_cast at habs
end

end order

end polynomial

section minpoly

open is_primitive_root polynomial complex

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

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

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

end minpoly


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Chris Hughes, Mario Carneiro, Yury Kudryashov
-/
import algebra.group.prod
import algebra.ring.basic
import algebra.ring.equiv

/-!
# Semiring, ring etc structures on `R × S`

In this file we define two-binop (`semiring`, `ring` etc) structures on `R × S`. We also prove
trivial `simp` lemmas, and define the following operations on `ring_hom`s:

* `fst R S : R × S →+* R`, `snd R S : R × S →+* S`: projections `prod.fst` and `prod.snd`
  as `ring_hom`s;
* `f.prod g : `R →+* S × T`: sends `x` to `(f x, g x)`;
* `f.prod_map g : `R × S → R' × S'`: `prod.map f g` as a `ring_hom`,
  sends `(x, y)` to `(f x, g y)`.
-/

variables {R : Type*} {R' : Type*} {S : Type*} {S' : Type*} {T : Type*} {T' : Type*}

namespace prod

/-- Product of two distributive types is distributive. -/
instance [distrib R] [distrib S] : distrib (R × S) :=
{ left_distrib := λ a b c, mk.inj_iff.mpr ⟨left_distrib _ _ _, left_distrib _ _ _⟩,
  right_distrib := λ a b c, mk.inj_iff.mpr ⟨right_distrib _ _ _, right_distrib _ _ _⟩,
  .. prod.has_add, .. prod.has_mul }

/-- Product of two `non_unital_non_assoc_semiring`s is a `non_unital_non_assoc_semiring`. -/
instance [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] :
  non_unital_non_assoc_semiring (R × S) :=
{ .. prod.add_comm_monoid, .. prod.mul_zero_class, .. prod.distrib }

/-- Product of two `non_unital_semiring`s is a `non_unital_semiring`. -/
instance [non_unital_semiring R] [non_unital_semiring S] :
  non_unital_semiring (R × S) :=
{ .. prod.non_unital_non_assoc_semiring, .. prod.semigroup }

/-- Product of two `non_assoc_semiring`s is a `non_assoc_semiring`. -/
instance [non_assoc_semiring R] [non_assoc_semiring S] :
  non_assoc_semiring (R × S) :=
{ .. prod.non_unital_non_assoc_semiring, .. prod.mul_one_class, .. prod.add_monoid_with_one }

/-- Product of two semirings is a semiring. -/
instance [semiring R] [semiring S] : semiring (R × S) :=
{ .. prod.add_comm_monoid, .. prod.monoid_with_zero, .. prod.distrib, .. prod.add_monoid_with_one }

/-- Product of two `non_unital_comm_semiring`s is a `non_unital_comm_semiring`. -/
instance [non_unital_comm_semiring R] [non_unital_comm_semiring S] :
  non_unital_comm_semiring (R × S) :=
{ .. prod.non_unital_semiring, .. prod.comm_semigroup }

/-- Product of two commutative semirings is a commutative semiring. -/
instance [comm_semiring R] [comm_semiring S] : comm_semiring (R × S) :=
{ .. prod.semiring, .. prod.comm_monoid }

instance [non_unital_non_assoc_ring R] [non_unital_non_assoc_ring S] :
  non_unital_non_assoc_ring (R × S) :=
{ .. prod.add_comm_group, .. prod.non_unital_non_assoc_semiring }

instance [non_unital_ring R] [non_unital_ring S] :
  non_unital_ring (R × S) :=
{ .. prod.add_comm_group, .. prod.non_unital_semiring }

instance [non_assoc_ring R] [non_assoc_ring S] :
  non_assoc_ring (R × S) :=
{ .. prod.add_comm_group, .. prod.non_assoc_semiring, .. prod.add_group_with_one }

/-- Product of two rings is a ring. -/
instance [ring R] [ring S] : ring (R × S) :=
{ .. prod.add_comm_group, .. prod.add_group_with_one, .. prod.semiring }

/-- Product of two `non_unital_comm_ring`s is a `non_unital_comm_ring`. -/
instance [non_unital_comm_ring R] [non_unital_comm_ring S] : non_unital_comm_ring (R × S) :=
{ .. prod.non_unital_ring, .. prod.comm_semigroup }

/-- Product of two commutative rings is a commutative ring. -/
instance [comm_ring R] [comm_ring S] : comm_ring (R × S) :=
{ .. prod.ring, .. prod.comm_monoid }

end prod

namespace ring_hom

variables (R S) [non_assoc_semiring R] [non_assoc_semiring S]

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/
def fst : R × S →+* R := { to_fun := prod.fst, .. monoid_hom.fst R S, .. add_monoid_hom.fst R S }

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/
def snd : R × S →+* S := { to_fun := prod.snd, .. monoid_hom.snd R S, .. add_monoid_hom.snd R S }

variables {R S}

@[simp]

section prod

variables [non_assoc_semiring T] (f : R →+* S) (g : R →+* T)

/-- Combine two ring homomorphisms `f : R →+* S`, `g : R →+* T` into `f.prod g : R →+* S × T`
given by `(f.prod g) x = (f x, g x)` -/
protected def prod (f : R →+* S) (g : R →+* T) : R →+* S × T :=
{ to_fun := λ x, (f x, g x),
  .. monoid_hom.prod (f : R →* S) (g : R →* T), .. add_monoid_hom.prod (f : R →+ S) (g : R →+ T) }

@[simp] lemma prod_apply (x) : f.prod g x = (f x, g x) := rfl

@[simp] lemma fst_comp_prod : (fst S T).comp (f.prod g) = f :=
ext $ λ x, rfl

@[simp] lemma snd_comp_prod : (snd S T).comp (f.prod g) = g :=
ext $ λ x, rfl

lemma prod_unique (f : R →+* S × T) :
  ((fst S T).comp f).prod ((snd S T).comp f) = f :=
ext $ λ x, by simp only [prod_apply, coe_fst, coe_snd, comp_apply, prod.mk.eta]

end prod

section prod_map

variables [non_assoc_semiring R'] [non_assoc_semiring S'] [non_assoc_semiring T]
variables (f : R →+* R') (g : S →+* S')

/-- `prod.map` as a `ring_hom`. -/
def prod_map : R × S →+* R' × S' := (f.comp (fst R S)).prod (g.comp (snd R S))

lemma prod_map_def : prod_map f g = (f.comp (fst R S)).prod (g.comp (snd R S)) := rfl

@[simp]
lemma coe_prod_map : ⇑(prod_map f g) = prod.map f g := rfl

lemma prod_comp_prod_map (f : T →+* R) (g : T →+* S) (f' : R →+* R') (g' : S →+* S') :
  (f'.prod_map g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
rfl

end prod_map

end ring_hom

namespace ring_equiv
variables {R S} [non_assoc_semiring R] [non_assoc_semiring S]

/-- Swapping components as an equivalence of (semi)rings. -/
def prod_comm : R × S ≃+* S × R :=
{ ..add_equiv.prod_comm, ..mul_equiv.prod_comm }

@[simp] lemma coe_prod_comm : ⇑(prod_comm : R × S ≃+* S × R) = prod.swap := rfl
@[simp] lemma coe_prod_comm_symm : ⇑((prod_comm : R × S ≃+* S × R).symm) = prod.swap := rfl

@[simp] lemma fst_comp_coe_prod_comm :
  (ring_hom.fst S R).comp ↑(prod_comm : R × S ≃+* S × R) = ring_hom.snd R S :=
ring_hom.ext $ λ _, rfl

@[simp] lemma snd_comp_coe_prod_comm :
  (ring_hom.snd S R).comp ↑(prod_comm : R × S ≃+* S × R) = ring_hom.fst R S :=
ring_hom.ext $ λ _, rfl

variables (R S) [subsingleton S]

/-- A ring `R` is isomorphic to `R × S` when `S` is the zero ring -/
@[simps] def prod_zero_ring : R ≃+* R × S :=
{ to_fun := λ x, (x, 0),
  inv_fun := prod.fst,
  map_add' := by simp,
  map_mul' := by simp,
  left_inv := λ x, rfl,
  right_inv := λ x, by cases x; simp }

/-- A ring `R` is isomorphic to `S × R` when `S` is the zero ring -/
@[simps] def zero_ring_prod : R ≃+* S × R :=
{ to_fun := λ x, (0, x),
  inv_fun := prod.snd,
  map_add' := by simp,
  map_mul' := by simp,
  left_inv := λ x, rfl,
  right_inv := λ x, by cases x; simp }

end ring_equiv

/-- The product of two nontrivial rings is not a domain -/
lemma false_of_nontrivial_of_product_domain (R S : Type*) [ring R] [ring S]
  [is_domain (R × S)] [nontrivial R] [nontrivial S] : false :=
begin
  have := is_domain.eq_zero_or_eq_zero_of_mul_eq_zero
    (show ((0 : R), (1 : S)) * (1, 0) = 0, by simp),
  rw [prod.mk_eq_zero,prod.mk_eq_zero] at this,
  rcases this with (⟨_,h⟩|⟨h,_⟩),
  { exact zero_ne_one h.symm },
  { exact zero_ne_one h.symm }
end


/-
Copyright (c) 2020 Pim Spelier, Daan van Gent. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Pim Spelier, Daan van Gent

! This file was ported from Lean 3 source module computability.encoding
! leanprover-community/mathlib commit b6395b3a5acd655b16385fa0cdbf1961d6c34b3e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Basic
import Mathbin.Data.Num.Lemmas
import Mathbin.SetTheory.Cardinal.Ordinal
import Mathbin.Tactic.DeriveFintype

/-!
# Encodings

This file contains the definition of a (finite) encoding, a map from a type to
strings in an alphabet, used in defining computability by Turing machines.
It also contains several examples:

## Examples

- `fin_encoding_nat_bool`   : a binary encoding of ℕ in a simple alphabet.
- `fin_encoding_nat_Γ'`    : a binary encoding of ℕ in the alphabet used for TM's.
- `unary_fin_encoding_nat` : a unary encoding of ℕ
- `fin_encoding_bool_bool`  : an encoding of bool.
-/

universe u v

open Cardinal

namespace Computability

/-- An encoding of a type in a certain alphabet, together with a decoding. -/
structure Encoding (α : Type u) where
  Γ : Type v
  encode : α → List Γ
  decode : List Γ → Option α
  decode_encode : ∀ x, decode (encode x) = some x
#align computability.encoding Computability.Encoding

theorem Encoding.encode_injective {α : Type u} (e : Encoding α) : Function.Injective e.encode :=
  by
  refine' fun _ _ h => Option.some_injective _ _
  rw [← e.decode_encode, ← e.decode_encode, h]
#align computability.encoding.encode_injective Computability.Encoding.encode_injective

/-- An encoding plus a guarantee of finiteness of the alphabet. -/
structure FinEncoding (α : Type u) extends Encoding.{u, 0} α where
  ΓFin : Fintype Γ
#align computability.fin_encoding Computability.FinEncoding

instance {α : Type u} (e : FinEncoding α) : Fintype e.toEncoding.Γ :=
  e.ΓFin

/-- A standard Turing machine alphabet, consisting of blank,bit0,bit1,bra,ket,comma. -/
inductive Γ'
  | blank
  | bit (b : Bool)
  | bra
  | ket
  | comma
  deriving DecidableEq, Fintype
#align computability.Γ' Computability.Γ'

instance inhabitedΓ' : Inhabited Γ' :=
  ⟨Γ'.blank⟩
#align computability.inhabited_Γ' Computability.inhabitedΓ'

/-- The natural inclusion of bool in Γ'. -/
def inclusionBoolΓ' : Bool → Γ' :=
  Γ'.bit
#align computability.inclusion_bool_Γ' Computability.inclusionBoolΓ'

/-- An arbitrary section of the natural inclusion of bool in Γ'. -/
def sectionΓ'Bool : Γ' → Bool
  | Γ'.bit b => b
  | _ => Inhabited.default Bool
#align computability.section_Γ'_bool Computability.sectionΓ'Bool

theorem leftInverse_section_inclusion : Function.LeftInverse sectionΓ'Bool inclusionBoolΓ' :=
  fun x => Bool.casesOn x rfl rfl
#align computability.left_inverse_section_inclusion Computability.leftInverse_section_inclusion

theorem inclusionBoolΓ'_injective : Function.Injective inclusionBoolΓ' :=
  Function.HasLeftInverse.injective (Exists.intro sectionΓ'Bool leftInverse_section_inclusion)
#align computability.inclusion_bool_Γ'_injective Computability.inclusionBoolΓ'_injective

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- An encoding function of the positive binary numbers in bool. -/
def encodePosNum : PosNum → List Bool
  | PosNum.one => [true]
  | PosNum.bit0 n => false::encode_pos_num n
  | PosNum.bit1 n => true::encode_pos_num n
#align computability.encode_pos_num Computability.encodePosNum

/-- An encoding function of the binary numbers in bool. -/
def encodeNum : Num → List Bool
  | Num.zero => []
  | Num.pos n => encodePosNum n
#align computability.encode_num Computability.encodeNum

/-- An encoding function of ℕ in bool. -/
def encodeNat (n : ℕ) : List Bool :=
  encodeNum n
#align computability.encode_nat Computability.encodeNat

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A decoding function from `list bool` to the positive binary numbers. -/
def decodePosNum : List Bool → PosNum
  | ff::l => PosNum.bit0 (decode_pos_num l)
  | tt::l => ite (l = []) PosNum.one (PosNum.bit1 (decode_pos_num l))
  | _ => PosNum.one
#align computability.decode_pos_num Computability.decodePosNum

/-- A decoding function from `list bool` to the binary numbers. -/
def decodeNum : List Bool → Num := fun l => ite (l = []) Num.zero <| decodePosNum l
#align computability.decode_num Computability.decodeNum

/-- A decoding function from `list bool` to ℕ. -/
def decodeNat : List Bool → Nat := fun l => decodeNum l
#align computability.decode_nat Computability.decodeNat

theorem encodePosNum_nonempty (n : PosNum) : encodePosNum n ≠ [] :=
  PosNum.casesOn n (List.cons_ne_nil _ _) (fun m => List.cons_ne_nil _ _) fun m =>
    List.cons_ne_nil _ _
#align computability.encode_pos_num_nonempty Computability.encodePosNum_nonempty

theorem decode_encodePosNum : ∀ n, decodePosNum (encodePosNum n) = n :=
  by
  intro n
  induction' n with m hm m hm <;> unfold encode_pos_num decode_pos_num
  · rfl
  · rw [hm]
    exact if_neg (encode_pos_num_nonempty m)
  · exact congr_arg PosNum.bit0 hm
#align computability.decode_encode_pos_num Computability.decode_encodePosNum

theorem decode_encodeNum : ∀ n, decodeNum (encodeNum n) = n :=
  by
  intro n
  cases n <;> unfold encode_num decode_num
  · rfl
  rw [decode_encode_pos_num n]
  rw [PosNum.cast_to_num]
  exact if_neg (encode_pos_num_nonempty n)
#align computability.decode_encode_num Computability.decode_encodeNum

theorem decode_encodeNat : ∀ n, decodeNat (encodeNat n) = n :=
  by
  intro n
  conv_rhs => rw [← Num.to_of_nat n]
  exact congr_arg coe (decode_encode_num ↑n)
#align computability.decode_encode_nat Computability.decode_encodeNat

/-- A binary encoding of ℕ in bool. -/
def encodingNatBool : Encoding ℕ where
  Γ := Bool
  encode := encodeNat
  decode n := some (decodeNat n)
  decode_encode n := congr_arg _ (decode_encodeNat n)
#align computability.encoding_nat_bool Computability.encodingNatBool

/-- A binary fin_encoding of ℕ in bool. -/
def finEncodingNatBool : FinEncoding ℕ :=
  ⟨encodingNatBool, Bool.fintype⟩
#align computability.fin_encoding_nat_bool Computability.finEncodingNatBool

/-- A binary encoding of ℕ in Γ'. -/
def encodingNatΓ' : Encoding ℕ where
  Γ := Γ'
  encode x := List.map inclusionBoolΓ' (encodeNat x)
  decode x := some (decodeNat (List.map sectionΓ'Bool x))
  decode_encode x :=
    congr_arg _ <| by
      rw [List.map_map, List.map_id' left_inverse_section_inclusion, decode_encode_nat]
#align computability.encoding_nat_Γ' Computability.encodingNatΓ'

/-- A binary fin_encoding of ℕ in Γ'. -/
def finEncodingNatΓ' : FinEncoding ℕ :=
  ⟨encodingNatΓ', Γ'.fintype⟩
#align computability.fin_encoding_nat_Γ' Computability.finEncodingNatΓ'

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A unary encoding function of ℕ in bool. -/
def unaryEncodeNat : Nat → List Bool
  | 0 => []
  | n + 1 => true::unary_encode_nat n
#align computability.unary_encode_nat Computability.unaryEncodeNat

/-- A unary decoding function from `list bool` to ℕ. -/
def unaryDecodeNat : List Bool → Nat :=
  List.length
#align computability.unary_decode_nat Computability.unaryDecodeNat

theorem unary_decode_encode_nat : ∀ n, unaryDecodeNat (unaryEncodeNat n) = n := fun n =>
  Nat.rec rfl (fun (m : ℕ) hm => (congr_arg Nat.succ hm.symm).symm) n
#align computability.unary_decode_encode_nat Computability.unary_decode_encode_nat

/-- A unary fin_encoding of ℕ. -/
def unaryFinEncodingNat : FinEncoding ℕ where
  Γ := Bool
  encode := unaryEncodeNat
  decode n := some (unaryDecodeNat n)
  decode_encode n := congr_arg _ (unary_decode_encode_nat n)
  ΓFin := Bool.fintype
#align computability.unary_fin_encoding_nat Computability.unaryFinEncodingNat

/-- An encoding function of bool in bool. -/
def encodeBool : Bool → List Bool :=
  List.ret
#align computability.encode_bool Computability.encodeBool

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- A decoding function from `list bool` to bool. -/
def decodeBool : List Bool → Bool
  | b::_ => b
  | _ => Inhabited.default Bool
#align computability.decode_bool Computability.decodeBool

theorem decode_encodeBool : ∀ b, decodeBool (encodeBool b) = b := fun b => Bool.casesOn b rfl rfl
#align computability.decode_encode_bool Computability.decode_encodeBool

/-- A fin_encoding of bool in bool. -/
def finEncodingBoolBool : FinEncoding Bool
    where
  Γ := Bool
  encode := encodeBool
  decode x := some (decodeBool x)
  decode_encode x := congr_arg _ (decode_encodeBool x)
  ΓFin := Bool.fintype
#align computability.fin_encoding_bool_bool Computability.finEncodingBoolBool

instance inhabitedFinEncoding : Inhabited (FinEncoding Bool) :=
  ⟨finEncodingBoolBool⟩
#align computability.inhabited_fin_encoding Computability.inhabitedFinEncoding

instance inhabitedEncoding : Inhabited (Encoding Bool) :=
  ⟨finEncodingBoolBool.toEncoding⟩
#align computability.inhabited_encoding Computability.inhabitedEncoding

theorem Encoding.card_le_card_list {α : Type u} (e : Encoding.{u, v} α) :
    Cardinal.lift.{v} (#α) ≤ Cardinal.lift.{u} (#List e.Γ) :=
  Cardinal.lift_mk_le'.2 ⟨⟨e.encode, e.encode_injective⟩⟩
#align computability.encoding.card_le_card_list Computability.Encoding.card_le_card_list

theorem Encoding.card_le_aleph0 {α : Type u} (e : Encoding.{u, v} α) [Encodable e.Γ] : (#α) ≤ ℵ₀ :=
  by
  refine' Cardinal.lift_le.1 (e.card_le_card_list.trans _)
  simp only [Cardinal.lift_aleph0, Cardinal.lift_le_aleph0]
  cases' isEmpty_or_nonempty e.Γ with h h
  · simp only [Cardinal.mk_le_aleph0]
  · rw [Cardinal.mk_list_eq_aleph0]
#align computability.encoding.card_le_aleph_0 Computability.Encoding.card_le_aleph0

theorem FinEncoding.card_le_aleph0 {α : Type u} (e : FinEncoding α) : (#α) ≤ ℵ₀ :=
  haveI : Encodable e.Γ := Fintype.toEncodable _
  e.to_encoding.card_le_aleph_0
#align computability.fin_encoding.card_le_aleph_0 Computability.FinEncoding.card_le_aleph0

end Computability


theorem add_right_cancel_iff (t a b : mynat) :  a + t = b + t ↔ a = b :=
begin
split,
exact add_right_cancel _ _ _,
intro h,
rwa h,
end


import mynat.definition
import world8.level3

namespace mynat

theorem eq_iff_succ_eq_succ (a b : mynat) : succ(a) = succ(b) ↔ a = b :=
begin
    split,
    {
        exact succ_inj,
    },
    {
        exact succ_eq_succ_of_eq,
    },
end

end mynat


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Mario Carneiro, Yaël Dillies
-/
import order.compare
import order.order_dual
import order.rel_classes

/-!
# Monotonicity

This file defines (strictly) monotone/antitone functions. Contrary to standard mathematical usage,
"monotone"/"mono" here means "increasing", not "increasing or decreasing". We use "antitone"/"anti"
to mean "decreasing".

## Definitions

* `monotone f`: A function `f` between two preorders is monotone if `a ≤ b` implies `f a ≤ f b`.
* `antitone f`: A function `f` between two preorders is antitone if `a ≤ b` implies `f b ≤ f a`.
* `monotone_on f s`: Same as `monotone f`, but for all `a, b ∈ s`.
* `antitone_on f s`: Same as `antitone f`, but for all `a, b ∈ s`.
* `strict_mono f` : A function `f` between two preorders is strictly monotone if `a < b` implies
  `f a < f b`.
* `strict_anti f` : A function `f` between two preorders is strictly antitone if `a < b` implies
  `f b < f a`.
* `strict_mono_on f s`: Same as `strict_mono f`, but for all `a, b ∈ s`.
* `strict_anti_on f s`: Same as `strict_anti f`, but for all `a, b ∈ s`.

## Main theorems

* `monotone_nat_of_le_succ`, `monotone_int_of_le_succ`: If `f : ℕ → α` or `f : ℤ → α` and
  `f n ≤ f (n + 1)` for all `n`, then `f` is monotone.
* `antitone_nat_of_succ_le`, `antitone_int_of_succ_le`: If `f : ℕ → α` or `f : ℤ → α` and
  `f (n + 1) ≤ f n` for all `n`, then `f` is antitone.
* `strict_mono_nat_of_lt_succ`, `strict_mono_int_of_lt_succ`: If `f : ℕ → α` or `f : ℤ → α` and
  `f n < f (n + 1)` for all `n`, then `f` is strictly monotone.
* `strict_anti_nat_of_succ_lt`, `strict_anti_int_of_succ_lt`: If `f : ℕ → α` or `f : ℤ → α` and
  `f (n + 1) < f n` for all `n`, then `f` is strictly antitone.

## Implementation notes

Some of these definitions used to only require `has_le α` or `has_lt α`. The advantage of this is
unclear and it led to slight elaboration issues. Now, everything requires `preorder α` and seems to
work fine. Related Zulip discussion:
https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Order.20diamond/near/254353352.

## TODO

The above theorems are also true in `ℕ+`, `fin n`... To make that work, we need `succ_order α`
and `succ_archimedean α`.

## Tags

monotone, strictly monotone, antitone, strictly antitone, increasing, strictly increasing,
decreasing, strictly decreasing
-/

open function

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w} {r : α → α → Prop}

section monotone_def
variables [preorder α] [preorder β]

/-- A function `f` is monotone if `a ≤ b` implies `f a ≤ f b`. -/
def monotone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f a ≤ f b

/-- A function `f` is antitone if `a ≤ b` implies `f b ≤ f a`. -/
def antitone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f b ≤ f a

/-- A function `f` is monotone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f a ≤ f b`. -/
def monotone_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f a ≤ f b

/-- A function `f` is antitone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f b ≤ f a`. -/
def antitone_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f b ≤ f a

/-- A function `f` is strictly monotone if `a < b` implies `f a < f b`. -/
def strict_mono (f : α → β) : Prop :=
∀ ⦃a b⦄, a < b → f a < f b

/-- A function `f` is strictly antitone if `a < b` implies `f b < f a`. -/
def strict_anti (f : α → β) : Prop :=
∀ ⦃a b⦄, a < b → f b < f a

/-- A function `f` is strictly monotone on `s` if, for all `a, b ∈ s`, `a < b` implies
`f a < f b`. -/
def strict_mono_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a < f b

/-- A function `f` is strictly antitone on `s` if, for all `a, b ∈ s`, `a < b` implies
`f b < f a`. -/
def strict_anti_on (f : α → β) (s : set α) : Prop :=
∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b < f a

end monotone_def

/-! ### Monotonicity on the dual order

Strictly many of the `*_on.dual` lemmas in this section should use `of_dual ⁻¹' s` instead of `s`,
but right now this is not possible as `set.preimage` is not defined yet, and importing it creates
an import cycle.
-/

section order_dual
open order_dual
variables [preorder α] [preorder β] {f : α → β} {s : set α}

protected theorem monotone.dual (hf : monotone f) : monotone (to_dual ∘ f ∘ of_dual) :=
λ a b h, hf h

protected lemma monotone.dual_left (hf : monotone f) : antitone (f ∘ of_dual) :=
λ a b h, hf h

protected lemma monotone.dual_right (hf : monotone f) : antitone (to_dual ∘ f) :=
λ a b h, hf h

protected theorem antitone.dual (hf : antitone f) : antitone (to_dual ∘ f ∘ of_dual) :=
λ a b h, hf h

protected lemma antitone.dual_left (hf : antitone f) : monotone (f ∘ of_dual) :=
λ a b h, hf h

protected lemma antitone.dual_right (hf : antitone f) : monotone (to_dual ∘ f) :=
λ a b h, hf h

protected theorem monotone_on.dual (hf : monotone_on f s) : monotone_on (to_dual ∘ f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma monotone_on.dual_left (hf : monotone_on f s) : antitone_on (f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma monotone_on.dual_right (hf : monotone_on f s) : antitone_on (to_dual ∘ f) s :=
λ a ha b hb, hf ha hb

protected theorem antitone_on.dual (hf : antitone_on f s) : antitone_on (to_dual ∘ f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma antitone_on.dual_left (hf : antitone_on f s) : monotone_on (f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma antitone_on.dual_right (hf : antitone_on f s) : monotone_on (to_dual ∘ f) s :=
λ a ha b hb, hf ha hb

protected theorem strict_mono.dual (hf : strict_mono f) : strict_mono (to_dual ∘ f ∘ of_dual) :=
λ a b h, hf h

protected lemma strict_mono.dual_left (hf : strict_mono f) : strict_anti (f ∘ of_dual) :=
λ a b h, hf h

protected lemma strict_mono.dual_right (hf : strict_mono f) : strict_anti (to_dual ∘ f) :=
λ a b h, hf h

protected theorem strict_anti.dual (hf : strict_anti f) : strict_anti (to_dual ∘ f ∘ of_dual) :=
λ a b h, hf h

protected lemma strict_anti.dual_left (hf : strict_anti f) : strict_mono (f ∘ of_dual) :=
λ a b h, hf h

protected lemma strict_anti.dual_right (hf : strict_anti f) : strict_mono (to_dual ∘ f) :=
λ a b h, hf h

protected theorem strict_mono_on.dual (hf : strict_mono_on f s) :
  strict_mono_on (to_dual ∘ f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma strict_mono_on.dual_left (hf : strict_mono_on f s) :
  strict_anti_on (f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma strict_mono_on.dual_right (hf : strict_mono_on f s) :
  strict_anti_on (to_dual ∘ f) s :=
λ a ha b hb, hf ha hb

protected theorem strict_anti_on.dual (hf : strict_anti_on f s) :
  strict_anti_on (to_dual ∘ f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma strict_anti_on.dual_left (hf : strict_anti_on f s) :
  strict_mono_on (f ∘ of_dual) s :=
λ a ha b hb, hf hb ha

protected lemma strict_anti_on.dual_right (hf : strict_anti_on f s) :
  strict_mono_on (to_dual ∘ f) s :=
λ a ha b hb, hf ha hb

end order_dual

/-! ### Monotonicity in function spaces -/

section preorder
variables [preorder α]

theorem monotone.comp_le_comp_left [preorder β]
  {f : β → α} {g h : γ → β} (hf : monotone f) (le_gh : g ≤ h) :
  has_le.le.{max w u} (f ∘ g) (f ∘ h) :=
λ x, hf (le_gh x)

variables [preorder γ]

theorem monotone_lam {f : α → β → γ} (hf : ∀ b, monotone (λ a, f a b)) : monotone f :=
λ a a' h b, hf b h

theorem monotone_app (f : β → α → γ) (b : β) (hf : monotone (λ a b, f b a)) : monotone (f b) :=
λ a a' h, hf h b

theorem antitone_lam {f : α → β → γ} (hf : ∀ b, antitone (λ a, f a b)) : antitone f :=
λ a a' h b, hf b h

theorem antitone_app (f : β → α → γ) (b : β) (hf : antitone (λ a b, f b a)) : antitone (f b) :=
λ a a' h, hf h b

end preorder

lemma function.monotone_eval {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] (i : ι) :
  monotone (function.eval i : (Π i, α i) → α i) :=
λ f g H, H i

/-! ### Monotonicity hierarchy -/

section preorder
variables [preorder α]

section preorder
variables [preorder β] {f : α → β}

protected lemma monotone.monotone_on (hf : monotone f) (s : set α) : monotone_on f s :=
λ a _ b _ h, hf h

protected lemma antitone.antitone_on (hf : antitone f) (s : set α) : antitone_on f s :=
λ a _ b _ h, hf h

lemma monotone_on_univ : monotone_on f set.univ ↔ monotone f :=
⟨λ h a b, h trivial trivial, λ h, h.monotone_on _⟩

lemma antitone_on_univ : antitone_on f set.univ ↔ antitone f :=
⟨λ h a b, h trivial trivial, λ h, h.antitone_on _⟩

protected lemma strict_mono.strict_mono_on (hf : strict_mono f) (s : set α) : strict_mono_on f s :=
λ a _ b _ h, hf h

protected lemma strict_anti.strict_anti_on (hf : strict_anti f) (s : set α) : strict_anti_on f s :=
λ a _ b _ h, hf h

lemma strict_mono_on_univ : strict_mono_on f set.univ ↔ strict_mono f :=
⟨λ h a b, h trivial trivial, λ h, h.strict_mono_on _⟩

lemma strict_anti_on_univ : strict_anti_on f set.univ ↔ strict_anti f :=
⟨λ h a b, h trivial trivial, λ h, h.strict_anti_on _⟩

end preorder

section partial_order
variables [partial_order β] {f : α → β}

lemma monotone.strict_mono_of_injective (h₁ : monotone f) (h₂ : injective f) : strict_mono f :=
λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H)

lemma antitone.strict_anti_of_injective (h₁ : antitone f) (h₂ : injective f) : strict_anti f :=
λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H.symm)

end partial_order
end preorder

section partial_order
variables [partial_order α] [preorder β] {f : α → β} {s : set α}

lemma monotone_iff_forall_lt : monotone f ↔ ∀ ⦃a b⦄, a < b → f a ≤ f b :=
forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) hf⟩

lemma antitone_iff_forall_lt : antitone f ↔ ∀ ⦃a b⦄, a < b → f b ≤ f a :=
forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) hf⟩

lemma monotone_on_iff_forall_lt :
  monotone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a ≤ f b :=
⟨λ hf a ha b hb h, hf ha hb h.le,
  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) (hf ha hb)⟩

lemma antitone_on_iff_forall_lt :
  antitone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b ≤ f a :=
⟨λ hf a ha b hb h, hf ha hb h.le,
  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) (hf ha hb)⟩

-- `preorder α` isn't strong enough: if the preorder on `α` is an equivalence relation,
-- then `strict_mono f` is vacuously true.
protected lemma strict_mono_on.monotone_on (hf : strict_mono_on f s) : monotone_on f s :=
monotone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le

protected lemma strict_anti_on.antitone_on (hf : strict_anti_on f s) : antitone_on f s :=
antitone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le

protected lemma strict_mono.monotone (hf : strict_mono f) : monotone f :=
monotone_iff_forall_lt.2 $ λ a b h, (hf h).le

protected lemma strict_anti.antitone (hf : strict_anti f) : antitone f :=
antitone_iff_forall_lt.2 $ λ a b h, (hf h).le

end partial_order

/-! ### Monotonicity from and to subsingletons -/

namespace subsingleton
variables [preorder α] [preorder β]

protected lemma monotone [subsingleton α] (f : α → β) : monotone f :=
λ a b _, (congr_arg _ $ subsingleton.elim _ _).le

protected lemma antitone [subsingleton α] (f : α → β) : antitone f :=
λ a b _, (congr_arg _ $ subsingleton.elim _ _).le

lemma monotone' [subsingleton β] (f : α → β) : monotone f := λ a b _, (subsingleton.elim _ _).le
lemma antitone' [subsingleton β] (f : α → β) : antitone f := λ a b _, (subsingleton.elim _ _).le

protected lemma strict_mono [subsingleton α] (f : α → β) : strict_mono f :=
λ a b h, (h.ne $ subsingleton.elim _ _).elim

protected lemma strict_anti [subsingleton α] (f : α → β) : strict_anti f :=
λ a b h, (h.ne $ subsingleton.elim _ _).elim

end subsingleton

/-! ### Miscellaneous monotonicity results -/

lemma monotone_id [preorder α] : monotone (id : α → α) := λ a b, id

lemma strict_mono_id [preorder α] : strict_mono (id : α → α) := λ a b, id

theorem monotone_const [preorder α] [preorder β] {c : β} : monotone (λ (a : α), c) :=
λ a b _, le_refl c

theorem antitone_const [preorder α] [preorder β] {c : β} : antitone (λ (a : α), c) :=
λ a b _, le_refl c

lemma strict_mono_of_le_iff_le [preorder α] [preorder β] {f : α → β}
  (h : ∀ x y, x ≤ y ↔ f x ≤ f y) : strict_mono f :=
λ a b, (lt_iff_lt_of_le_iff_le' (h _ _) (h _ _)).1

lemma injective_of_lt_imp_ne [linear_order α] {f : α → β} (h : ∀ x y, x < y → f x ≠ f y) :
  injective f :=
begin
  intros x y hxy,
  contrapose hxy,
  cases ne.lt_or_lt hxy with hxy hxy,
  exacts [h _ _ hxy, (h _ _ hxy).symm]
end

lemma injective_of_le_imp_le [partial_order α] [preorder β] (f : α → β)
  (h : ∀ {x y}, f x ≤ f y → x ≤ y) : injective f :=
λ x y hxy, (h hxy.le).antisymm (h hxy.ge)

section preorder
variables [preorder α] [preorder β] {f g : α → β}

protected lemma strict_mono.ite' (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → f x < g y) :
  strict_mono (λ x, if p x then f x else g x) :=
begin
  intros x y h,
  by_cases hy : p y,
  { have hx : p x := hp h hy,
    simpa [hx, hy] using hf h },
  by_cases hx : p x,
  { simpa [hx, hy] using hfg hx hy h },
  { simpa [hx, hy] using hg h}
end

protected lemma strict_mono.ite (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, f x ≤ g x) :
  strict_mono (λ x, if p x then f x else g x) :=
hf.ite' hg hp $ λ x y hx hy h, (hf h).trans_le (hfg y)

protected lemma strict_anti.ite' (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → g y < f x) :
  strict_anti (λ x, if p x then f x else g x) :=
(strict_mono.ite' hf.dual_right hg.dual_right hp hfg).dual_right

protected lemma strict_anti.ite (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, g x ≤ f x) :
  strict_anti (λ x, if p x then f x else g x) :=
hf.ite' hg hp $ λ x y hx hy h, (hfg y).trans_lt (hf h)

end preorder

/-! ### Monotonicity under composition -/

section composition
variables [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β} {s : set α}

protected lemma monotone.comp (hg : monotone g) (hf : monotone f) :
  monotone (g ∘ f) :=
λ a b h, hg (hf h)

lemma monotone.comp_antitone (hg : monotone g) (hf : antitone f) :
  antitone (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma antitone.comp (hg : antitone g) (hf : antitone f) :
  monotone (g ∘ f) :=
λ a b h, hg (hf h)

lemma antitone.comp_monotone (hg : antitone g) (hf : monotone f) :
  antitone (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma monotone.iterate {f : α → α} (hf : monotone f) (n : ℕ) : monotone (f^[n]) :=
nat.rec_on n monotone_id (λ n h, h.comp hf)

protected lemma monotone.comp_monotone_on (hg : monotone g) (hf : monotone_on f s) :
  monotone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma monotone.comp_antitone_on (hg : monotone g) (hf : antitone_on f s) :
  antitone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

protected lemma antitone.comp_antitone_on (hg : antitone g) (hf : antitone_on f s) :
  monotone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma antitone.comp_monotone_on (hg : antitone g) (hf : monotone_on f s) :
  antitone_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

protected lemma strict_mono.comp (hg : strict_mono g) (hf : strict_mono f) :
  strict_mono (g ∘ f) :=
λ a b h, hg (hf h)

lemma strict_mono.comp_strict_anti (hg : strict_mono g) (hf : strict_anti f) :
  strict_anti (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma strict_anti.comp (hg : strict_anti g) (hf : strict_anti f) :
  strict_mono (g ∘ f) :=
λ a b h, hg (hf h)

lemma strict_anti.comp_strict_mono (hg : strict_anti g) (hf : strict_mono f) :
  strict_anti (g ∘ f) :=
λ a b h, hg (hf h)

protected lemma strict_mono.iterate {f : α → α} (hf : strict_mono f) (n : ℕ) :
  strict_mono (f^[n]) :=
nat.rec_on n strict_mono_id (λ n h, h.comp hf)

protected lemma strict_mono.comp_strict_mono_on (hg : strict_mono g) (hf : strict_mono_on f s) :
  strict_mono_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma strict_mono.comp_strict_anti_on (hg : strict_mono g) (hf : strict_anti_on f s) :
  strict_anti_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

protected lemma strict_anti.comp_strict_anti_on (hg : strict_anti g) (hf : strict_anti_on f s) :
  strict_mono_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

lemma strict_anti.comp_strict_mono_on (hg : strict_anti g) (hf : strict_mono_on f s) :
  strict_anti_on (g ∘ f) s :=
λ a ha b hb h, hg (hf ha hb h)

end composition

/-! ### Monotonicity in linear orders  -/

section linear_order
variables [linear_order α]

section preorder
variables [preorder β] {f : α → β} {s : set α}

open ordering

lemma monotone.reflect_lt (hf : monotone f) {a b : α} (h : f a < f b) : a < b :=
lt_of_not_ge (λ h', h.not_le (hf h'))

lemma antitone.reflect_lt (hf : antitone f) {a b : α} (h : f a < f b) : b < a :=
lt_of_not_ge (λ h', h.not_le (hf h'))

lemma monotone_on.reflect_lt (hf : monotone_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s)
  (h : f a < f b) :
  a < b :=
lt_of_not_ge $ λ h', h.not_le $ hf hb ha h'

lemma antitone_on.reflect_lt (hf : antitone_on f s) {a b : α}  (ha : a ∈ s) (hb : b ∈ s)
  (h : f a < f b) :
  b < a :=
lt_of_not_ge $ λ h', h.not_le $ hf ha hb h'

lemma strict_mono_on.le_iff_le (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a ≤ f b ↔ a ≤ b :=
⟨λ h, le_of_not_gt $ λ h', (hf hb ha h').not_le h,
 λ h, h.lt_or_eq_dec.elim (λ h', (hf ha hb h').le) (λ h', h' ▸ le_rfl)⟩

lemma strict_anti_on.le_iff_le (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a ≤ f b ↔ b ≤ a :=
hf.dual_right.le_iff_le hb ha

lemma strict_mono_on.lt_iff_lt (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a < f b ↔ a < b :=
by rw [lt_iff_le_not_le, lt_iff_le_not_le, hf.le_iff_le ha hb, hf.le_iff_le hb ha]

lemma strict_anti_on.lt_iff_lt (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
  f a < f b ↔ b < a :=
hf.dual_right.lt_iff_lt hb ha

lemma strict_mono.le_iff_le (hf : strict_mono f) {a b : α} :
  f a ≤ f b ↔ a ≤ b :=
(hf.strict_mono_on set.univ).le_iff_le trivial trivial

lemma strict_anti.le_iff_le (hf : strict_anti f) {a b : α} :
  f a ≤ f b ↔ b ≤ a :=
(hf.strict_anti_on set.univ).le_iff_le trivial trivial

lemma strict_mono.lt_iff_lt (hf : strict_mono f) {a b : α} :
  f a < f b ↔ a < b :=
(hf.strict_mono_on set.univ).lt_iff_lt trivial trivial

lemma strict_anti.lt_iff_lt (hf : strict_anti f) {a b : α} :
  f a < f b ↔ b < a :=
(hf.strict_anti_on set.univ).lt_iff_lt trivial trivial

protected theorem strict_mono_on.compares (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s)
  (hb : b ∈ s) :
  ∀ {o : ordering}, o.compares (f a) (f b) ↔ o.compares a b
| ordering.lt := hf.lt_iff_lt ha hb
| ordering.eq := ⟨λ h, ((hf.le_iff_le ha hb).1 h.le).antisymm ((hf.le_iff_le hb ha).1 h.symm.le),
                   congr_arg _⟩
| ordering.gt := hf.lt_iff_lt hb ha

protected theorem strict_anti_on.compares (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s)
  (hb : b ∈ s) {o : ordering} :
  o.compares (f a) (f b) ↔ o.compares b a :=
order_dual.dual_compares.trans $ hf.dual_right.compares hb ha

protected theorem strict_mono.compares (hf : strict_mono f) {a b : α} {o : ordering} :
  o.compares (f a) (f b) ↔ o.compares a b :=
(hf.strict_mono_on set.univ).compares trivial trivial

protected theorem strict_anti.compares (hf : strict_anti f) {a b : α} {o : ordering} :
  o.compares (f a) (f b) ↔ o.compares b a :=
(hf.strict_anti_on set.univ).compares trivial trivial

lemma strict_mono.injective (hf : strict_mono f) : injective f :=
λ x y h, show compares eq x y, from hf.compares.1 h

lemma strict_anti.injective (hf : strict_anti f) : injective f :=
λ x y h, show compares eq x y, from hf.compares.1 h.symm

lemma strict_mono.maximal_of_maximal_image (hf : strict_mono f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
  x ≤ a :=
hf.le_iff_le.mp (hmax (f x))

lemma strict_mono.minimal_of_minimal_image (hf : strict_mono f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
  a ≤ x :=
hf.le_iff_le.mp (hmin (f x))

lemma strict_anti.minimal_of_maximal_image (hf : strict_anti f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
  a ≤ x :=
hf.le_iff_le.mp (hmax (f x))

lemma strict_anti.maximal_of_minimal_image (hf : strict_anti f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
  x ≤ a :=
hf.le_iff_le.mp (hmin (f x))

end preorder

section partial_order
variables [partial_order β] {f : α → β}

lemma monotone.strict_mono_iff_injective (hf : monotone f) :
  strict_mono f ↔ injective f :=
⟨λ h, h.injective, hf.strict_mono_of_injective⟩

lemma antitone.strict_anti_iff_injective (hf : antitone f) :
  strict_anti f ↔ injective f :=
⟨λ h, h.injective, hf.strict_anti_of_injective⟩

end partial_order
end linear_order

/-! ### Monotonicity in `ℕ` and `ℤ` -/

section preorder
variables [preorder α]

lemma nat.rel_of_forall_rel_succ_of_le_of_lt (r : β → β → Prop) [is_trans β r]
  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
  (hab : a ≤ b) (hbc : b < c) :
  r (f b) (f c) :=
begin
  induction hbc with k b_lt_k r_b_k,
  exacts [h _ hab, trans r_b_k (h _ (hab.trans_lt b_lt_k).le)]
end

lemma nat.rel_of_forall_rel_succ_of_le_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
  (hab : a ≤ b) (hbc : b ≤ c) :
  r (f b) (f c) :=
hbc.eq_or_lt.elim (λ h, h ▸ refl _) (nat.rel_of_forall_rel_succ_of_le_of_lt r h hab)

lemma nat.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a < b) : r (f a) (f b) :=
nat.rel_of_forall_rel_succ_of_le_of_lt r (λ n _, h n) le_rfl hab

lemma nat.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a ≤ b) : r (f a) (f b) :=
nat.rel_of_forall_rel_succ_of_le_of_le r (λ n _, h n) le_rfl hab

lemma monotone_nat_of_le_succ {f : ℕ → α} (hf : ∀ n, f n ≤ f (n + 1)) :
  monotone f :=
nat.rel_of_forall_rel_succ_of_le (≤) hf

lemma antitone_nat_of_succ_le {f : ℕ → α} (hf : ∀ n, f (n + 1) ≤ f n) :
  antitone f :=
@monotone_nat_of_le_succ (order_dual α) _ _ hf

lemma strict_mono_nat_of_lt_succ {f : ℕ → α} (hf : ∀ n, f n < f (n + 1)) :
  strict_mono f :=
nat.rel_of_forall_rel_succ_of_lt (<) hf

lemma strict_anti_nat_of_succ_lt {f : ℕ → α} (hf : ∀ n, f (n + 1) < f n) :
  strict_anti f :=
@strict_mono_nat_of_lt_succ (order_dual α) _ f hf

lemma int.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a < b) : r (f a) (f b) :=
begin
  rcases hab.dest with ⟨n, rfl⟩, clear hab,
  induction n with n ihn,
  { rw int.coe_nat_one, apply h },
  { rw [int.coe_nat_succ, ← int.add_assoc],
    exact trans ihn (h _) }
end

lemma int.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a ≤ b) : r (f a) (f b) :=
hab.eq_or_lt.elim (λ h, h ▸ refl _) (λ h', int.rel_of_forall_rel_succ_of_lt r h h')

lemma monotone_int_of_le_succ {f : ℤ → α} (hf : ∀ n, f n ≤ f (n + 1)) : monotone f :=
int.rel_of_forall_rel_succ_of_le (≤) hf

lemma antitone_int_of_succ_le {f : ℤ → α} (hf : ∀ n, f (n + 1) ≤ f n) : antitone f :=
int.rel_of_forall_rel_succ_of_le (≥) hf

lemma strict_mono_int_of_lt_succ {f : ℤ → α} (hf : ∀ n, f n < f (n + 1)) : strict_mono f :=
int.rel_of_forall_rel_succ_of_lt (<) hf

lemma strict_anti_int_of_succ_lt {f : ℤ → α} (hf : ∀ n, f (n + 1) < f n) : strict_anti f :=
int.rel_of_forall_rel_succ_of_lt (>) hf

-- TODO@Yael: Generalize the following four to succ orders
/-- If `f` is a monotone function from `ℕ` to a preorder such that `x` lies between `f n` and
  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
lemma monotone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : monotone f) (n : ℕ) {x : α}
  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℕ) :
  f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h1).not_le (nat.le_of_lt_succ $ hf.reflect_lt h2) }

/-- If `f` is an antitone function from `ℕ` to a preorder such that `x` lies between `f (n + 1)` and
`f n`, then `x` doesn't lie in the range of `f`. -/
lemma antitone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : antitone f)
  (n : ℕ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℕ) : f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h2).not_le (nat.le_of_lt_succ $ hf.reflect_lt h1) }

/-- If `f` is a monotone function from `ℤ` to a preorder and `x` lies between `f n` and
  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
lemma monotone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : monotone f) (n : ℤ) {x : α}
  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℤ) :
  f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h1).not_le (int.le_of_lt_add_one $ hf.reflect_lt h2) }

/-- If `f` is an antitone function from `ℤ` to a preorder and `x` lies between `f (n + 1)` and
`f n`, then `x` doesn't lie in the range of `f`. -/
lemma antitone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : antitone f)
  (n : ℤ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℤ) : f a ≠ x :=
by { rintro rfl, exact (hf.reflect_lt h2).not_le (int.le_of_lt_add_one $ hf.reflect_lt h1) }

lemma strict_mono.id_le {φ : ℕ → ℕ} (h : strict_mono φ) : ∀ n, n ≤ φ n :=
λ n, nat.rec_on n (nat.zero_le _)
  (λ n hn, nat.succ_le_of_lt (hn.trans_lt $ h $ nat.lt_succ_self n))

end preorder

lemma subtype.mono_coe [preorder α] (t : set α) : monotone (coe : (subtype t) → α) :=
λ x y, id

lemma subtype.strict_mono_coe [preorder α] (t : set α) : strict_mono (coe : (subtype t) → α) :=
λ x y, id

lemma monotone_fst {α β : Type*} [preorder α] [preorder β] : monotone (@prod.fst α β) :=
λ x y h, h.1

lemma monotone_snd {α β : Type*} [preorder α] [preorder β] : monotone (@prod.snd α β) :=
λ x y h, h.2