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

import linear_algebra.matrix.bilinear_form
import linear_algebra.matrix.charpoly.minpoly
import linear_algebra.determinant
import linear_algebra.vandermonde
import linear_algebra.trace
import field_theory.is_alg_closed.algebraic_closure
import field_theory.primitive_element
import ring_theory.power_basis

/-!
# Trace for (finite) ring extensions.

Suppose we have an `R`-algebra `S` with a finite basis. For each `s : S`,
the trace of the linear map given by multiplying by `s` gives information about
the roots of the minimal polynomial of `s` over `R`.

## Main definitions

 * `algebra.trace R S x`: the trace of an element `s` of an `R`-algebra `S`
 * `algebra.trace_form R S`: bilinear form sending `x`, `y` to the trace of `x * y`
 * `algebra.trace_matrix R b`: the matrix whose `(i j)`-th element is the trace of `b i * b j`.
 * `algebra.embeddings_matrix A C b : matrix κ (B →ₐ[A] C) C` is the matrix whose
   `(i, σ)` coefficient is `σ (b i)`.
 * `algebra.embeddings_matrix_reindex A C b e : matrix κ κ C` is the matrix whose `(i, j)`
   coefficient is `σⱼ (b i)`, where `σⱼ : B →ₐ[A] C` is the embedding corresponding to `j : κ`
   given by a bijection `e : κ ≃ (B →ₐ[A] C)`.

## Main results

 * `trace_algebra_map_of_basis`, `trace_algebra_map`: if `x : K`, then `Tr_{L/K} x = [L : K] x`
 * `trace_trace_of_basis`, `trace_trace`: `Tr_{L/K} (Tr_{F/L} x) = Tr_{F/K} x`
 * `trace_eq_sum_roots`: the trace of `x : K(x)` is the sum of all conjugate roots of `x`
 * `trace_eq_sum_embeddings`: the trace of `x : K(x)` is the sum of all embeddings of `x` into an
   algebraically closed field
 * `trace_form_nondegenerate`: the trace form over a separable extension is a nondegenerate
   bilinear form

## Implementation notes

Typically, the trace is defined specifically for finite field extensions.
The definition is as general as possible and the assumption that we have
fields or that the extension is finite is added to the lemmas as needed.

We only define the trace for left multiplication (`algebra.left_mul_matrix`,
i.e. `algebra.lmul_left`).
For now, the definitions assume `S` is commutative, so the choice doesn't matter anyway.

## References

 * https://en.wikipedia.org/wiki/Field_trace

-/

universes u v w z

variables {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
variables [algebra R S] [algebra R T]
variables {K L : Type*} [field K] [field L] [algebra K L]
variables {ι κ : Type w} [fintype ι]

open finite_dimensional
open linear_map
open matrix

open_locale big_operators
open_locale matrix

namespace algebra

variables (b : basis ι R S)

variables (R S)

/-- The trace of an element `s` of an `R`-algebra is the trace of `(*) s`,
as an `R`-linear map. -/
noncomputable def trace : S →ₗ[R] R :=
(linear_map.trace R S).comp (lmul R S).to_linear_map

variables {S}

-- Not a `simp` lemma since there are more interesting ways to rewrite `trace R S x`,
-- for example `trace_trace`
lemma trace_apply (x) : trace R S x = linear_map.trace R S (lmul R S x) := rfl

lemma trace_eq_zero_of_not_exists_basis
  (h : ¬ ∃ (s : finset S), nonempty (basis s R S)) : trace R S = 0 :=
by { ext s, simp [trace_apply, linear_map.trace, h] }

include b

variables {R}

-- Can't be a `simp` lemma because it depends on a choice of basis
lemma trace_eq_matrix_trace [decidable_eq ι] (b : basis ι R S) (s : S) :
  trace R S s = matrix.trace (algebra.left_mul_matrix b s) :=
by rw [trace_apply, linear_map.trace_eq_matrix_trace _ b, to_matrix_lmul_eq]

/-- If `x` is in the base field `K`, then the trace is `[L : K] * x`. -/
lemma trace_algebra_map_of_basis (x : R) :
  trace R S (algebra_map R S x) = fintype.card ι • x :=
begin
  haveI := classical.dec_eq ι,
  rw [trace_apply, linear_map.trace_eq_matrix_trace R b, matrix.trace],
  convert finset.sum_const _,
  ext i,
  simp,
end
omit b

/-- If `x` is in the base field `K`, then the trace is `[L : K] * x`.

(If `L` is not finite-dimensional over `K`, then `trace` and `finrank` return `0`.)
-/
@[simp]
lemma trace_algebra_map (x : K) : trace K L (algebra_map K L x) = finrank K L • x :=
begin
  by_cases H : ∃ (s : finset L), nonempty (basis s K L),
  { rw [trace_algebra_map_of_basis H.some_spec.some, finrank_eq_card_basis H.some_spec.some] },
  { simp [trace_eq_zero_of_not_exists_basis K H, finrank_eq_zero_of_not_exists_basis_finset H] }
end

lemma trace_trace_of_basis [algebra S T] [is_scalar_tower R S T]
  {ι κ : Type*} [fintype ι] [fintype κ]
  (b : basis ι R S) (c : basis κ S T) (x : T) :
  trace R S (trace S T x) = trace R T x :=
begin
  haveI := classical.dec_eq ι,
  haveI := classical.dec_eq κ,
  rw [trace_eq_matrix_trace (b.smul c), trace_eq_matrix_trace b, trace_eq_matrix_trace c,
      matrix.trace, matrix.trace, matrix.trace,
      ← finset.univ_product_univ, finset.sum_product],
  refine finset.sum_congr rfl (λ i _, _),
  simp only [alg_hom.map_sum, smul_left_mul_matrix, finset.sum_apply, matrix.diag,
      -- The unifier is not smart enough to apply this one by itself:
      finset.sum_apply i _ (λ y, left_mul_matrix b (left_mul_matrix c x y y))]
end

lemma trace_comp_trace_of_basis [algebra S T] [is_scalar_tower R S T]
  {ι κ : Type*} [fintype ι] [fintype κ]
  (b : basis ι R S) (c : basis κ S T) :
  (trace R S).comp ((trace S T).restrict_scalars R) = trace R T :=
by { ext, rw [linear_map.comp_apply, linear_map.restrict_scalars_apply, trace_trace_of_basis b c] }

@[simp]
lemma trace_trace [algebra K T] [algebra L T] [is_scalar_tower K L T]
  [finite_dimensional K L] [finite_dimensional L T] (x : T) :
  trace K L (trace L T x) = trace K T x :=
trace_trace_of_basis (basis.of_vector_space K L) (basis.of_vector_space L T) x

@[simp]
lemma trace_comp_trace [algebra K T] [algebra L T] [is_scalar_tower K L T]
  [finite_dimensional K L] [finite_dimensional L T] :
  (trace K L).comp ((trace L T).restrict_scalars K) = trace K T :=
by { ext, rw [linear_map.comp_apply, linear_map.restrict_scalars_apply, trace_trace] }

section trace_form

variables (R S)

/-- The `trace_form` maps `x y : S` to the trace of `x * y`.
It is a symmetric bilinear form and is nondegenerate if the extension is separable. -/
noncomputable def trace_form : bilin_form R S :=
(linear_map.compr₂ (lmul R S).to_linear_map (trace R S)).to_bilin

variables {S}

-- This is a nicer lemma than the one produced by `@[simps] def trace_form`.
@[simp] lemma trace_form_apply (x y : S) : trace_form R S x y = trace R S (x * y) := rfl

lemma trace_form_is_symm : (trace_form R S).is_symm :=
λ x y, congr_arg (trace R S) (mul_comm _ _)

lemma trace_form_to_matrix [decidable_eq ι] (i j) :
  bilin_form.to_matrix b (trace_form R S) i j = trace R S (b i * b j) :=
by rw [bilin_form.to_matrix_apply, trace_form_apply]

lemma trace_form_to_matrix_power_basis (h : power_basis R S) :
  bilin_form.to_matrix h.basis (trace_form R S) = λ i j, (trace R S (h.gen ^ (i + j : ℕ))) :=
by { ext, rw [trace_form_to_matrix, pow_add, h.basis_eq_pow, h.basis_eq_pow] }

end trace_form

end algebra

section eq_sum_roots

open algebra polynomial

variables {F : Type*} [field F]
variables [algebra K S] [algebra K F]

/-- Given `pb : power_basis K S`, the trace of `pb.gen` is `-(minpoly K pb.gen).next_coeff`. -/
lemma power_basis.trace_gen_eq_next_coeff_minpoly [nontrivial S] (pb : power_basis K S) :
  algebra.trace K S pb.gen = -(minpoly K pb.gen).next_coeff :=
begin
  have d_pos : 0 < pb.dim := power_basis.dim_pos pb,
  have d_pos' : 0 < (minpoly K pb.gen).nat_degree, { simpa },
  haveI : nonempty (fin pb.dim) := ⟨⟨0, d_pos⟩⟩,
  rw [trace_eq_matrix_trace pb.basis, trace_eq_neg_charpoly_coeff, charpoly_left_mul_matrix,
      ← pb.nat_degree_minpoly, fintype.card_fin, ← next_coeff_of_pos_nat_degree _ d_pos']
end

/-- Given `pb : power_basis K S`, then the trace of `pb.gen` is
`((minpoly K pb.gen).map (algebra_map K F)).roots.sum`. -/
lemma power_basis.trace_gen_eq_sum_roots [nontrivial S] (pb : power_basis K S)
  (hf : (minpoly K pb.gen).splits (algebra_map K F)) :
  algebra_map K F (trace K S pb.gen) =
    ((minpoly K pb.gen).map (algebra_map K F)).roots.sum :=
begin
  rw [power_basis.trace_gen_eq_next_coeff_minpoly, ring_hom.map_neg, ← next_coeff_map
    (algebra_map K F).injective, sum_roots_eq_next_coeff_of_monic_of_split
      ((minpoly.monic (power_basis.is_integral_gen _)).map _)
      ((splits_id_iff_splits _).2 hf), neg_neg]
end

namespace intermediate_field.adjoin_simple

open intermediate_field

lemma trace_gen_eq_zero {x : L} (hx : ¬ is_integral K x) :
  algebra.trace K K⟮x⟯ (adjoin_simple.gen K x) = 0 :=
begin
  rw [trace_eq_zero_of_not_exists_basis, linear_map.zero_apply],
  contrapose! hx,
  obtain ⟨s, ⟨b⟩⟩ := hx,
  refine is_integral_of_mem_of_fg (K⟮x⟯).to_subalgebra _ x _,
  { exact (submodule.fg_iff_finite_dimensional _).mpr (finite_dimensional.of_finset_basis b) },
  { exact subset_adjoin K _ (set.mem_singleton x) }
end

lemma trace_gen_eq_sum_roots (x : L)
  (hf : (minpoly K x).splits (algebra_map K F)) :
  algebra_map K F (trace K K⟮x⟯ (adjoin_simple.gen K x)) =
    ((minpoly K x).map (algebra_map K F)).roots.sum :=
begin
  have injKxL := (algebra_map K⟮x⟯ L).injective,
  by_cases hx : is_integral K x, swap,
  { simp [minpoly.eq_zero hx, trace_gen_eq_zero hx], },
  have hx' : is_integral K (adjoin_simple.gen K x),
  { rwa [← is_integral_algebra_map_iff injKxL, adjoin_simple.algebra_map_gen],
    apply_instance },
  rw [← adjoin.power_basis_gen hx, (adjoin.power_basis hx).trace_gen_eq_sum_roots];
    rw [adjoin.power_basis_gen hx, minpoly.eq_of_algebra_map_eq injKxL hx'];
    try { simp only [adjoin_simple.algebra_map_gen _ _] },
  exact hf
end

end intermediate_field.adjoin_simple

open intermediate_field

variables (K)

lemma trace_eq_trace_adjoin [finite_dimensional K L] (x : L) :
  algebra.trace K L x = finrank K⟮x⟯ L • trace K K⟮x⟯ (adjoin_simple.gen K x) :=
begin
  rw ← @trace_trace _ _ K K⟮x⟯ _ _ _ _ _ _ _ _ x,
  conv in x { rw ← intermediate_field.adjoin_simple.algebra_map_gen K x },
  rw [trace_algebra_map, linear_map.map_smul_of_tower],
end

variables {K}

lemma trace_eq_sum_roots [finite_dimensional K L]
  {x : L} (hF : (minpoly K x).splits (algebra_map K F)) :
  algebra_map K F (algebra.trace K L x) =
    finrank K⟮x⟯ L • ((minpoly K x).map (algebra_map K _)).roots.sum :=
by rw [trace_eq_trace_adjoin K x, algebra.smul_def, ring_hom.map_mul, ← algebra.smul_def,
    intermediate_field.adjoin_simple.trace_gen_eq_sum_roots _ hF, is_scalar_tower.algebra_map_smul]

end eq_sum_roots

variables {F : Type*} [field F]
variables [algebra R L] [algebra L F] [algebra R F] [is_scalar_tower R L F]

open polynomial

lemma algebra.is_integral_trace [finite_dimensional L F] {x : F} (hx : _root_.is_integral R x) :
  _root_.is_integral R (algebra.trace L F x) :=
begin
  have hx' : _root_.is_integral L x := is_integral_of_is_scalar_tower _ hx,
  rw [← is_integral_algebra_map_iff (algebra_map L (algebraic_closure F)).injective,
      trace_eq_sum_roots],
  { refine (is_integral.multiset_sum _).nsmul _,
    intros y hy,
    rw mem_roots_map (minpoly.ne_zero hx') at hy,
    use [minpoly R x, minpoly.monic hx],
    rw ← aeval_def at ⊢ hy,
    exact minpoly.aeval_of_is_scalar_tower R x y hy },
  { apply is_alg_closed.splits_codomain },
  { apply_instance }
end

section eq_sum_embeddings

variables [algebra K F] [is_scalar_tower K L F]

open algebra intermediate_field

variables (F) (E : Type*) [field E] [algebra K E]

lemma trace_eq_sum_embeddings_gen
  (pb : power_basis K L)
  (hE : (minpoly K pb.gen).splits (algebra_map K E)) (hfx : (minpoly K pb.gen).separable) :
  algebra_map K E (algebra.trace K L pb.gen) =
    (@@finset.univ (power_basis.alg_hom.fintype pb)).sum (λ σ, σ pb.gen) :=
begin
  letI := classical.dec_eq E,
  rw [pb.trace_gen_eq_sum_roots hE, fintype.sum_equiv pb.lift_equiv', finset.sum_mem_multiset,
      finset.sum_eq_multiset_sum, multiset.to_finset_val,
      multiset.dedup_eq_self.mpr _, multiset.map_id],
  { exact nodup_roots ((separable_map _).mpr hfx) },
  { intro x, refl },
  { intro σ, rw [power_basis.lift_equiv'_apply_coe, id.def] }
end

variables [is_alg_closed E]

lemma sum_embeddings_eq_finrank_mul [finite_dimensional K F] [is_separable K F]
  (pb : power_basis K L) :
  ∑ σ : F →ₐ[K] E, σ (algebra_map L F pb.gen) =
    finrank L F • (@@finset.univ (power_basis.alg_hom.fintype pb)).sum
      (λ σ : L →ₐ[K] E, σ pb.gen) :=
begin
  haveI : finite_dimensional L F := finite_dimensional.right K L F,
  haveI : is_separable L F := is_separable_tower_top_of_is_separable K L F,
  letI : fintype (L →ₐ[K] E) := power_basis.alg_hom.fintype pb,
  letI : ∀ (f : L →ₐ[K] E), fintype (@@alg_hom L F E _ _ _ _ f.to_ring_hom.to_algebra) :=
    _, -- will be solved by unification
  rw [fintype.sum_equiv alg_hom_equiv_sigma (λ (σ : F →ₐ[K] E), _) (λ σ, σ.1 pb.gen),
      ← finset.univ_sigma_univ, finset.sum_sigma, ← finset.sum_nsmul],
  refine finset.sum_congr rfl (λ σ _, _),
  { letI : algebra L E := σ.to_ring_hom.to_algebra,
    simp only [finset.sum_const, finset.card_univ],
    rw alg_hom.card L F E },
  { intros σ,
    simp only [alg_hom_equiv_sigma, equiv.coe_fn_mk, alg_hom.restrict_domain, alg_hom.comp_apply,
         is_scalar_tower.coe_to_alg_hom'] }
end

lemma trace_eq_sum_embeddings [finite_dimensional K L] [is_separable K L]
  {x : L} : algebra_map K E (algebra.trace K L x) = ∑ σ : L →ₐ[K] E, σ x :=
begin
  have hx := is_separable.is_integral K x,
  rw [trace_eq_trace_adjoin K x, algebra.smul_def, ring_hom.map_mul, ← adjoin.power_basis_gen hx,
      trace_eq_sum_embeddings_gen E (adjoin.power_basis hx) (is_alg_closed.splits_codomain _),
      ← algebra.smul_def, algebra_map_smul],
  { exact (sum_embeddings_eq_finrank_mul L E (adjoin.power_basis hx)).symm },
  { haveI := is_separable_tower_bot_of_is_separable K K⟮x⟯ L,
    exact is_separable.separable K _ }
end

end eq_sum_embeddings

section det_ne_zero

namespace algebra

variables (A : Type u) {B : Type v} (C : Type z)
variables [comm_ring A] [comm_ring B] [algebra A B] [comm_ring C] [algebra A C]

open finset

/-- Given an `A`-algebra `B` and `b`, an `κ`-indexed family of elements of `B`, we define
`trace_matrix A b` as the matrix whose `(i j)`-th element is the trace of `b i * b j`. -/
@[simp] noncomputable
def trace_matrix (b : κ → B) : matrix κ κ A
| i j := trace_form A B (b i) (b j)

lemma trace_matrix_def (b : κ → B) : trace_matrix A b = λ i j, trace_form A B (b i) (b j) := rfl

lemma trace_matrix_reindex {κ' : Type*} (b : basis κ A B) (f : κ ≃ κ') :
  trace_matrix A (b.reindex f) = reindex f f (trace_matrix A b) :=
by {ext x y, simp}

variables {A}

lemma trace_matrix_of_matrix_vec_mul [fintype κ] (b : κ → B) (P : matrix κ κ A) :
  trace_matrix A ((P.map (algebra_map A B)).vec_mul b) = Pᵀ ⬝ (trace_matrix A b) ⬝ P :=
begin
  ext α β,
  rw [trace_matrix, vec_mul, dot_product, vec_mul, dot_product, matrix.mul_apply,
    bilin_form.sum_left, fintype.sum_congr _ _ (λ (i : κ), @bilin_form.sum_right _ _ _ _ _ _ _ _
    (b i * P.map (algebra_map A B) i α) (λ (y : κ), b y * P.map (algebra_map A B) y β)), sum_comm],
  congr, ext x,
  rw [matrix.mul_apply, sum_mul],
  congr, ext y,
  rw [map_apply, trace_form_apply, mul_comm (b y), ← smul_def],
  simp only [id.smul_eq_mul, ring_hom.id_apply, map_apply, transpose_apply, linear_map.map_smulₛₗ,
    trace_form_apply, algebra.smul_mul_assoc],
  rw [mul_comm (b x), ← smul_def],
  ring_nf,
  simp,
end

lemma trace_matrix_of_matrix_mul_vec [fintype κ] (b : κ → B) (P : matrix κ κ A) :
  trace_matrix A ((P.map (algebra_map A B)).mul_vec b) = P ⬝ (trace_matrix A b) ⬝ Pᵀ :=
begin
  refine add_equiv.injective transpose_add_equiv _,
  rw [transpose_add_equiv_apply, transpose_add_equiv_apply, ← vec_mul_transpose,
    ← transpose_map, trace_matrix_of_matrix_vec_mul, transpose_transpose, transpose_mul,
    transpose_transpose, transpose_mul]
end

lemma trace_matrix_of_basis [fintype κ] [decidable_eq κ] (b : basis κ A B) :
  trace_matrix A b = bilin_form.to_matrix b (trace_form A B) :=
begin
  ext i j,
  rw [trace_matrix, trace_form_apply, trace_form_to_matrix]
end

lemma trace_matrix_of_basis_mul_vec (b : basis ι A B) (z : B) :
  (trace_matrix A b).mul_vec (b.equiv_fun z) = (λ i, trace A B (z * (b i))) :=
begin
  ext i,
  rw [← col_apply ((trace_matrix A b).mul_vec (b.equiv_fun z)) i unit.star, col_mul_vec,
    matrix.mul_apply, trace_matrix_def],
  simp only [col_apply, trace_form_apply],
  conv_lhs
  { congr, skip, funext,
    rw [mul_comm _ (b.equiv_fun z _), ← smul_eq_mul, ← linear_map.map_smul] },
    rw [← linear_map.map_sum],
    congr,
    conv_lhs
    { congr, skip, funext,
      rw [← mul_smul_comm] },
    rw [← finset.mul_sum, mul_comm z],
    congr,
    rw [b.sum_equiv_fun ]
end

variable (A)
/-- `embeddings_matrix A C b : matrix κ (B →ₐ[A] C) C` is the matrix whose `(i, σ)` coefficient is
  `σ (b i)`. It is mostly useful for fields when `fintype.card κ = finrank A B` and `C` is
  algebraically closed. -/
@[simp] def embeddings_matrix (b : κ → B) : matrix κ (B →ₐ[A] C) C
| i σ := σ (b i)

/-- `embeddings_matrix_reindex A C b e : matrix κ κ C` is the matrix whose `(i, j)` coefficient
  is `σⱼ (b i)`, where `σⱼ : B →ₐ[A] C` is the embedding corresponding to `j : κ` given by a
  bijection `e : κ ≃ (B →ₐ[A] C)`. It is mostly useful for fields and `C` is algebraically closed.
  In this case, in presence of `h : fintype.card κ = finrank A B`, one can take
  `e := equiv_of_card_eq ((alg_hom.card A B C).trans h.symm)`. -/
def embeddings_matrix_reindex (b : κ → B) (e : κ ≃ (B →ₐ[A] C)) :=
reindex (equiv.refl κ) e.symm (embeddings_matrix A C b)

variable {A}

lemma embeddings_matrix_reindex_eq_vandermonde (pb : power_basis A B)
  (e : fin pb.dim ≃ (B →ₐ[A] C)) :
  embeddings_matrix_reindex A C pb.basis e = (vandermonde (λ i, e i pb.gen))ᵀ :=
by { ext i j, simp [embeddings_matrix_reindex, embeddings_matrix] }

section field

variables (K) {L} (E : Type z) [field E]
variables [algebra K E]
variables [module.finite K L] [is_separable K L] [is_alg_closed E]
variables (b : κ → L) (pb : power_basis K L)

lemma trace_matrix_eq_embeddings_matrix_mul_trans :
  (trace_matrix K b).map (algebra_map K E) =
  (embeddings_matrix K E b) ⬝ (embeddings_matrix K E b)ᵀ :=
by { ext i j, simp [trace_eq_sum_embeddings, embeddings_matrix, matrix.mul_apply] }

lemma trace_matrix_eq_embeddings_matrix_reindex_mul_trans [fintype κ]
  (e : κ ≃ (L →ₐ[K] E)) : (trace_matrix K b).map (algebra_map K E) =
  (embeddings_matrix_reindex K E b e) ⬝ (embeddings_matrix_reindex K E b e)ᵀ :=
by rw [trace_matrix_eq_embeddings_matrix_mul_trans, embeddings_matrix_reindex, reindex_apply,
  transpose_minor, ← minor_mul_transpose_minor, ← equiv.coe_refl, equiv.refl_symm]

end field

end algebra

open algebra

variables (pb : power_basis K L)

lemma det_trace_matrix_ne_zero' [is_separable K L] :
  det (trace_matrix K pb.basis) ≠ 0 :=
begin
  suffices : algebra_map K (algebraic_closure L) (det (trace_matrix K pb.basis)) ≠ 0,
  { refine mt (λ ht, _) this,
    rw [ht, ring_hom.map_zero] },
  haveI : finite_dimensional K L := pb.finite_dimensional,
  let e : fin pb.dim ≃ (L →ₐ[K] algebraic_closure L) := (fintype.equiv_fin_of_card_eq _).symm,
  rw [ring_hom.map_det, ring_hom.map_matrix_apply,
      trace_matrix_eq_embeddings_matrix_reindex_mul_trans K _ _ e,
      embeddings_matrix_reindex_eq_vandermonde, det_mul, det_transpose],
  refine mt mul_self_eq_zero.mp _,
  { simp only [det_vandermonde, finset.prod_eq_zero_iff, not_exists, sub_eq_zero],
    intros i _ j hij h,
    exact (finset.mem_filter.mp hij).2.ne' (e.injective $ pb.alg_hom_ext h) },
  { rw [alg_hom.card, pb.finrank] }
end

lemma det_trace_form_ne_zero [is_separable K L] [decidable_eq ι] (b : basis ι K L) :
  det (bilin_form.to_matrix b (trace_form K L)) ≠ 0 :=
begin
  haveI : finite_dimensional K L := finite_dimensional.of_fintype_basis b,
  let pb : power_basis K L := field.power_basis_of_finite_of_separable _ _,
  rw [← bilin_form.to_matrix_mul_basis_to_matrix pb.basis b,
      ← det_comm' (pb.basis.to_matrix_mul_to_matrix_flip b) _,
      ← matrix.mul_assoc, det_mul],
  swap, { apply basis.to_matrix_mul_to_matrix_flip },
  refine mul_ne_zero
    (is_unit_of_mul_eq_one _ ((b.to_matrix pb.basis)ᵀ ⬝ b.to_matrix pb.basis).det _).ne_zero
    _,
  { calc (pb.basis.to_matrix b ⬝ (pb.basis.to_matrix b)ᵀ).det *
        ((b.to_matrix pb.basis)ᵀ ⬝ b.to_matrix pb.basis).det
        = (pb.basis.to_matrix b ⬝ (b.to_matrix pb.basis ⬝ pb.basis.to_matrix b)ᵀ ⬝
          b.to_matrix pb.basis).det
        : by simp only [← det_mul, matrix.mul_assoc, matrix.transpose_mul]
    ... = 1 : by simp only [basis.to_matrix_mul_to_matrix_flip, matrix.transpose_one,
                            matrix.mul_one, matrix.det_one] },
  simpa only [trace_matrix_of_basis] using det_trace_matrix_ne_zero' pb
end

variables (K L)

theorem trace_form_nondegenerate [finite_dimensional K L] [is_separable K L] :
  (trace_form K L).nondegenerate :=
bilin_form.nondegenerate_of_det_ne_zero (trace_form K L) _
  (det_trace_form_ne_zero (finite_dimensional.fin_basis K L))

end det_ne_zero


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro

-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.sqrt
import Mathlib.data.nat.gcd
import Mathlib.algebra.group_power.default
import Mathlib.tactic.wlog
import Mathlib.tactic.norm_num
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Prime numbers

This file deals with prime numbers: natural numbers `p ≥ 2` whose only divisors are `p` and `1`.

## Important declarations

All the following declarations exist in the namespace `nat`.

- `prime`: the predicate that expresses that a natural number `p` is prime
- `primes`: the subtype of natural numbers that are prime
- `min_fac n`: the minimal prime factor of a natural number `n ≠ 1`
- `exists_infinite_primes`: Euclid's theorem that there exist infinitely many prime numbers
- `factors n`: the prime factorization of `n`
- `factors_unique`: uniqueness of the prime factorisation

-/

namespace nat

/-- `prime p` means that `p` is a prime number, that is, a natural number
  at least 2 whose only divisors are `p` and `1`. -/
def prime (p : ℕ) :=
  bit0 1 ≤ p ∧ ∀ (m : ℕ), m ∣ p → m = 1 ∨ m = p

theorem prime.two_le {p : ℕ} : prime p → bit0 1 ≤ p :=
  and.left

theorem prime.one_lt {p : ℕ} : prime p → 1 < p :=
  prime.two_le

protected instance prime.one_lt' (p : ℕ) [hp : fact (prime p)] : fact (1 < p) :=
  prime.one_lt hp

theorem prime.ne_one {p : ℕ} (hp : prime p) : p ≠ 1 :=
  ne.symm (ne_of_lt (prime.one_lt hp))

theorem prime_def_lt {p : ℕ} : prime p ↔ bit0 1 ≤ p ∧ ∀ (m : ℕ), m < p → m ∣ p → m = 1 := sorry

theorem prime_def_lt' {p : ℕ} : prime p ↔ bit0 1 ≤ p ∧ ∀ (m : ℕ), bit0 1 ≤ m → m < p → ¬m ∣ p := sorry

theorem prime_def_le_sqrt {p : ℕ} : prime p ↔ bit0 1 ≤ p ∧ ∀ (m : ℕ), bit0 1 ≤ m → m ≤ sqrt p → ¬m ∣ p := sorry

/--
  This instance is slower than the instance `decidable_prime` defined below,
  but has the advantage that it works in the kernel.

  If you need to prove that a particular number is prime, in any case
  you should not use `dec_trivial`, but rather `by norm_num`, which is
  much faster.
  -/
def decidable_prime_1 (p : ℕ) : Decidable (prime p) :=
  decidable_of_iff' (bit0 1 ≤ p ∧ ∀ (m : ℕ), bit0 1 ≤ m → m < p → ¬m ∣ p) prime_def_lt'

theorem prime.ne_zero {n : ℕ} (h : prime n) : n ≠ 0 :=
  id fun (ᾰ : n = 0) => Eq._oldrec (fun (h : prime 0) => of_as_true trivial h) (Eq.symm ᾰ) h

theorem prime.pos {p : ℕ} (pp : prime p) : 0 < p :=
  lt_of_succ_lt (prime.one_lt pp)

theorem not_prime_zero : ¬prime 0 :=
  of_as_true trivial

theorem not_prime_one : ¬prime 1 :=
  of_as_true trivial

theorem prime_two : prime (bit0 1) :=
  of_as_true trivial

theorem prime_three : prime (bit1 1) :=
  of_as_true trivial

theorem prime.pred_pos {p : ℕ} (pp : prime p) : 0 < Nat.pred p :=
  iff.mpr lt_pred_iff (prime.one_lt pp)

theorem succ_pred_prime {p : ℕ} (pp : prime p) : Nat.succ (Nat.pred p) = p :=
  succ_pred_eq_of_pos (prime.pos pp)

theorem dvd_prime {p : ℕ} {m : ℕ} (pp : prime p) : m ∣ p ↔ m = 1 ∨ m = p := sorry

theorem dvd_prime_two_le {p : ℕ} {m : ℕ} (pp : prime p) (H : bit0 1 ≤ m) : m ∣ p ↔ m = p :=
  iff.trans (dvd_prime pp) (or_iff_right_of_imp (not.elim (ne_of_gt H)))

theorem prime_dvd_prime_iff_eq {p : ℕ} {q : ℕ} (pp : prime p) (qp : prime q) : p ∣ q ↔ p = q :=
  dvd_prime_two_le qp (prime.two_le pp)

theorem prime.not_dvd_one {p : ℕ} (pp : prime p) : ¬p ∣ 1 :=
  fun (ᾰ : p ∣ 1) => idRhs False (not_le_of_gt (prime.one_lt pp) (le_of_dvd (of_as_true trivial) ᾰ))

theorem not_prime_mul {a : ℕ} {b : ℕ} (a1 : 1 < a) (b1 : 1 < b) : ¬prime (a * b) := sorry

theorem not_prime_mul' {a : ℕ} {b : ℕ} {n : ℕ} (h : a * b = n) (h₁ : 1 < a) (h₂ : 1 < b) : ¬prime n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (¬prime n)) (Eq.symm h))) (not_prime_mul h₁ h₂)

def min_fac_aux (n : ℕ) : ℕ → ℕ :=
  sorry

def min_fac : ℕ → ℕ :=
  sorry

@[simp] theorem min_fac_zero : min_fac 0 = bit0 1 :=
  rfl

@[simp] theorem min_fac_one : min_fac 1 = 1 :=
  rfl

theorem min_fac_eq (n : ℕ) : min_fac n = ite (bit0 1 ∣ n) (bit0 1) (min_fac_aux n (bit1 1)) := sorry

theorem min_fac_aux_has_prop {n : ℕ} (n2 : bit0 1 ≤ n) (nd2 : ¬bit0 1 ∣ n) (k : ℕ) (i : ℕ) : k = bit0 1 * i + bit1 1 → (∀ (m : ℕ), bit0 1 ≤ m → m ∣ n → k ≤ m) → min_fac_prop n (min_fac_aux n k) := sorry

theorem min_fac_has_prop {n : ℕ} (n1 : n ≠ 1) : min_fac_prop n (min_fac n) := sorry

theorem min_fac_dvd (n : ℕ) : min_fac n ∣ n :=
  dite (n = 1) (fun (n1 : n = 1) => Eq.symm n1 ▸ of_as_true trivial)
    fun (n1 : ¬n = 1) => and.left (and.right (min_fac_has_prop n1))

theorem min_fac_prime {n : ℕ} (n1 : n ≠ 1) : prime (min_fac n) := sorry

theorem min_fac_le_of_dvd {n : ℕ} {m : ℕ} : bit0 1 ≤ m → m ∣ n → min_fac n ≤ m :=
  dite (n = 1) (fun (n1 : n = 1) (m : ℕ) (m2 : bit0 1 ≤ m) (d : m ∣ n) => Eq.symm n1 ▸ le_trans (of_as_true trivial) m2)
    fun (n1 : ¬n = 1) => and.right (and.right (min_fac_has_prop n1))

theorem min_fac_pos (n : ℕ) : 0 < min_fac n :=
  dite (n = 1) (fun (n1 : n = 1) => Eq.symm n1 ▸ of_as_true trivial) fun (n1 : ¬n = 1) => prime.pos (min_fac_prime n1)

theorem min_fac_le {n : ℕ} (H : 0 < n) : min_fac n ≤ n :=
  le_of_dvd H (min_fac_dvd n)

theorem prime_def_min_fac {p : ℕ} : prime p ↔ bit0 1 ≤ p ∧ min_fac p = p := sorry

protected instance decidable_prime (p : ℕ) : Decidable (prime p) :=
  decidable_of_iff' (bit0 1 ≤ p ∧ min_fac p = p) prime_def_min_fac

theorem not_prime_iff_min_fac_lt {n : ℕ} (n2 : bit0 1 ≤ n) : ¬prime n ↔ min_fac n < n :=
  iff.trans (not_congr (iff.trans prime_def_min_fac (and_iff_right n2)))
    (iff.symm (iff.trans lt_iff_le_and_ne (and_iff_right (min_fac_le (le_of_succ_le n2)))))

theorem min_fac_le_div {n : ℕ} (pos : 0 < n) (np : ¬prime n) : min_fac n ≤ n / min_fac n := sorry

theorem min_fac_sq_le_self {n : ℕ} (w : 0 < n) (h : ¬prime n) : min_fac n ^ bit0 1 ≤ n := sorry

@[simp] theorem min_fac_eq_one_iff {n : ℕ} : min_fac n = 1 ↔ n = 1 := sorry

@[simp] theorem min_fac_eq_two_iff (n : ℕ) : min_fac n = bit0 1 ↔ bit0 1 ∣ n := sorry

theorem exists_dvd_of_not_prime {n : ℕ} (n2 : bit0 1 ≤ n) (np : ¬prime n) : ∃ (m : ℕ), m ∣ n ∧ m ≠ 1 ∧ m ≠ n := sorry

theorem exists_dvd_of_not_prime2 {n : ℕ} (n2 : bit0 1 ≤ n) (np : ¬prime n) : ∃ (m : ℕ), m ∣ n ∧ bit0 1 ≤ m ∧ m < n :=
  Exists.intro (min_fac n)
    { left := min_fac_dvd n,
      right := { left := prime.two_le (min_fac_prime (ne_of_gt n2)), right := iff.mp (not_prime_iff_min_fac_lt n2) np } }

theorem exists_prime_and_dvd {n : ℕ} (n2 : bit0 1 ≤ n) : ∃ (p : ℕ), prime p ∧ p ∣ n :=
  Exists.intro (min_fac n) { left := min_fac_prime (ne_of_gt n2), right := min_fac_dvd n }

/-- Euclid's theorem. There exist infinitely many prime numbers.
Here given in the form: for every `n`, there exists a prime number `p ≥ n`. -/
theorem exists_infinite_primes (n : ℕ) : ∃ (p : ℕ), n ≤ p ∧ prime p := sorry

theorem prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = bit0 1 ∨ p % bit0 1 = 1 := sorry

theorem coprime_of_dvd {m : ℕ} {n : ℕ} (H : ∀ (k : ℕ), prime k → k ∣ m → ¬k ∣ n) : coprime m n := sorry

theorem coprime_of_dvd' {m : ℕ} {n : ℕ} (H : ∀ (k : ℕ), prime k → k ∣ m → k ∣ n → k ∣ 1) : coprime m n :=
  coprime_of_dvd
    fun (k : ℕ) (kp : prime k) (km : k ∣ m) (kn : k ∣ n) =>
      not_le_of_gt (prime.one_lt kp) (le_of_dvd zero_lt_one (H k kp km kn))

theorem factors_lemma {k : ℕ} : (k + bit0 1) / min_fac (k + bit0 1) < k + bit0 1 :=
  div_lt_self (of_as_true trivial) (prime.one_lt (min_fac_prime (of_as_true trivial)))

/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
def factors : ℕ → List ℕ :=
  sorry

theorem mem_factors {n : ℕ} {p : ℕ} : p ∈ factors n → prime p := sorry

theorem prod_factors {n : ℕ} : 0 < n → list.prod (factors n) = n := sorry

theorem factors_prime {p : ℕ} (hp : prime p) : factors p = [p] := sorry

/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/
theorem factors_add_two (n : ℕ) : factors (n + bit0 1) = min_fac (n + bit0 1) :: factors ((n + bit0 1) / min_fac (n + bit0 1)) :=
  rfl

theorem prime.coprime_iff_not_dvd {p : ℕ} {n : ℕ} (pp : prime p) : coprime p n ↔ ¬p ∣ n := sorry

theorem prime.dvd_iff_not_coprime {p : ℕ} {n : ℕ} (pp : prime p) : p ∣ n ↔ ¬coprime p n :=
  iff.mpr iff_not_comm (prime.coprime_iff_not_dvd pp)

theorem prime.not_coprime_iff_dvd {m : ℕ} {n : ℕ} : ¬coprime m n ↔ ∃ (p : ℕ), prime p ∧ p ∣ m ∧ p ∣ n := sorry

theorem prime.dvd_mul {p : ℕ} {m : ℕ} {n : ℕ} (pp : prime p) : p ∣ m * n ↔ p ∣ m ∨ p ∣ n := sorry

theorem prime.not_dvd_mul {p : ℕ} {m : ℕ} {n : ℕ} (pp : prime p) (Hm : ¬p ∣ m) (Hn : ¬p ∣ n) : ¬p ∣ m * n := sorry

theorem prime.dvd_of_dvd_pow {p : ℕ} {m : ℕ} {n : ℕ} (pp : prime p) (h : p ∣ m ^ n) : p ∣ m :=
  Nat.rec (fun (h : p ∣ m ^ 0) => not.elim (prime.not_dvd_one pp) h)
    (fun (n : ℕ) (IH : p ∣ m ^ n → p ∣ m) (h : p ∣ m ^ Nat.succ n) => or.elim (iff.mp (prime.dvd_mul pp) h) id IH) n h

theorem prime.pow_not_prime {x : ℕ} {n : ℕ} (hn : bit0 1 ≤ n) : ¬prime (x ^ n) := sorry

theorem prime.mul_eq_prime_pow_two_iff {x : ℕ} {y : ℕ} {p : ℕ} (hp : prime p) (hx : x ≠ 1) (hy : y ≠ 1) : x * y = p ^ bit0 1 ↔ x = p ∧ y = p := sorry

theorem prime.dvd_factorial {n : ℕ} {p : ℕ} (hp : prime p) : p ∣ factorial n ↔ p ≤ n := sorry

theorem prime.coprime_pow_of_not_dvd {p : ℕ} {m : ℕ} {a : ℕ} (pp : prime p) (h : ¬p ∣ a) : coprime a (p ^ m) :=
  coprime.pow_right m (coprime.symm (iff.mpr (prime.coprime_iff_not_dvd pp) h))

theorem coprime_primes {p : ℕ} {q : ℕ} (pp : prime p) (pq : prime q) : coprime p q ↔ p ≠ q :=
  iff.trans (prime.coprime_iff_not_dvd pp) (not_congr (dvd_prime_two_le pq (prime.two_le pp)))

theorem coprime_pow_primes {p : ℕ} {q : ℕ} (n : ℕ) (m : ℕ) (pp : prime p) (pq : prime q) (h : p ≠ q) : coprime (p ^ n) (q ^ m) :=
  coprime.pow n m (iff.mpr (coprime_primes pp pq) h)

theorem coprime_or_dvd_of_prime {p : ℕ} (pp : prime p) (i : ℕ) : coprime p i ∨ p ∣ i :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coprime p i ∨ p ∣ i)) (propext (prime.dvd_iff_not_coprime pp)))) (em (coprime p i))

theorem dvd_prime_pow {p : ℕ} (pp : prime p) {m : ℕ} {i : ℕ} : i ∣ p ^ m ↔ ∃ (k : ℕ), ∃ (H : k ≤ m), i = p ^ k := sorry

/--
If `p` is prime,
and `a` doesn't divide `p^k`, but `a` does divide `p^(k+1)`
then `a = p^(k+1)`.
-/
theorem eq_prime_pow_of_dvd_least_prime_pow {a : ℕ} {p : ℕ} {k : ℕ} (pp : prime p) (h₁ : ¬a ∣ p ^ k) (h₂ : a ∣ p ^ (k + 1)) : a = p ^ (k + 1) := sorry

theorem mem_list_primes_of_dvd_prod {p : ℕ} (hp : prime p) {l : List ℕ} : (∀ (p : ℕ), p ∈ l → prime p) → p ∣ list.prod l → p ∈ l := sorry

theorem mem_factors_iff_dvd {n : ℕ} {p : ℕ} (hn : 0 < n) (hp : prime p) : p ∈ factors n ↔ p ∣ n :=
  { mp := fun (h : p ∈ factors n) => prod_factors hn ▸ list.dvd_prod h,
    mpr := fun (h : p ∣ n) => mem_list_primes_of_dvd_prod hp mem_factors (Eq.symm (prod_factors hn) ▸ h) }

theorem perm_of_prod_eq_prod {l₁ : List ℕ} {l₂ : List ℕ} : list.prod l₁ = list.prod l₂ → (∀ (p : ℕ), p ∈ l₁ → prime p) → (∀ (p : ℕ), p ∈ l₂ → prime p) → l₁ ~ l₂ := sorry

theorem factors_unique {n : ℕ} {l : List ℕ} (h₁ : list.prod l = n) (h₂ : ∀ (p : ℕ), p ∈ l → prime p) : l ~ factors n := sorry

theorem succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : prime p) {m : ℕ} {n : ℕ} {k : ℕ} {l : ℕ} (hpm : p ^ k ∣ m) (hpn : p ^ l ∣ n) (hpmn : p ^ (k + l + 1) ∣ m * n) : p ^ (k + 1) ∣ m ∨ p ^ (l + 1) ∣ n := sorry

/-- The type of prime numbers -/
def primes :=
  Subtype fun (p : ℕ) => prime p

namespace primes

protected instance has_repr : has_repr primes :=
  has_repr.mk fun (p : primes) => repr (subtype.val p)

protected instance inhabited : Inhabited primes :=
  { default := { val := bit0 1, property := prime_two } }

protected instance coe_nat : has_coe primes ℕ :=
  has_coe.mk subtype.val

theorem coe_nat_inj (p : primes) (q : primes) : ↑p = ↑q → p = q :=
  fun (h : ↑p = ↑q) => subtype.eq h

end primes

protected instance monoid.prime_pow {α : Type u_1} [monoid α] : has_pow α primes :=
  has_pow.mk fun (x : α) (p : primes) => x ^ subtype.val p

end nat

/-! ### Primality prover -/

namespace tactic

namespace norm_num

theorem is_prime_helper (n : ℕ) (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n :=
  iff.mpr nat.prime_def_min_fac { left := h₁, right := h₂ }

theorem min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = bit0 1 := sorry

/-- A predicate representing partial progress in a proof of `min_fac`. -/
def min_fac_helper (n : ℕ) (k : ℕ) :=
  0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n)

theorem min_fac_helper.n_pos {n : ℕ} {k : ℕ} (h : min_fac_helper n k) : 0 < n := sorry

theorem min_fac_ne_bit0 {n : ℕ} {k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k := sorry

theorem min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 := sorry

theorem min_fac_helper_1 {n : ℕ} {k : ℕ} {k' : ℕ} (e : k + 1 = k') (np : nat.min_fac (bit1 n) ≠ bit1 k) (h : min_fac_helper n k) : min_fac_helper n k' := sorry

theorem min_fac_helper_2 (n : ℕ) (k : ℕ) (k' : ℕ) (e : k + 1 = k') (np : ¬nat.prime (bit1 k)) (h : min_fac_helper n k) : min_fac_helper n k' := sorry

theorem min_fac_helper_3 (n : ℕ) (k : ℕ) (k' : ℕ) (c : ℕ) (e : k + 1 = k') (nc : bit1 n % bit1 k = c) (c0 : 0 < c) (h : min_fac_helper n k) : min_fac_helper n k' := sorry

theorem min_fac_helper_4 (n : ℕ) (k : ℕ) (hd : bit1 n % bit1 k = 0) (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 k := sorry

theorem min_fac_helper_5 (n : ℕ) (k : ℕ) (k' : ℕ) (e : bit1 k * bit1 k = k') (hd : bit1 n < k') (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n := sorry


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro
-/
import algebra.associated
import linear_algebra.basic
import order.zorn
import order.atoms
import order.compactly_generated
import tactic.abel
import data.nat.choose.sum
import linear_algebra.finsupp
/-!

# Ideals over a ring

This file defines `ideal R`, the type of ideals over a commutative ring `R`.

## Implementation notes

`ideal R` is implemented using `submodule R R`, where `•` is interpreted as `*`.

## TODO

Support one-sided ideals, and ideals over non-commutative rings.
-/

universes u v w
variables {α : Type u} {β : Type v}
open set function

open_locale classical big_operators pointwise

/-- A (left) ideal in a semiring `R` is an additive submonoid `s` such that
`a * b ∈ s` whenever `b ∈ s`. If `R` is a ring, then `s` is an additive subgroup.  -/
@[reducible] def ideal (R : Type u) [semiring R] := submodule R R

section semiring

namespace ideal
variables [semiring α] (I : ideal α) {a b : α}

protected lemma zero_mem : (0 : α) ∈ I := I.zero_mem

protected lemma add_mem : a ∈ I → b ∈ I → a + b ∈ I := I.add_mem

variables (a)
lemma mul_mem_left : b ∈ I → a * b ∈ I := I.smul_mem a
variables {a}

@[ext] lemma ext {I J : ideal α} (h : ∀ x, x ∈ I ↔ x ∈ J) : I = J :=
submodule.ext h

theorem eq_top_of_unit_mem
  (x y : α) (hx : x ∈ I) (h : y * x = 1) : I = ⊤ :=
eq_top_iff.2 $ λ z _, calc
    z = z * (y * x) : by simp [h]
  ... = (z * y) * x : eq.symm $ mul_assoc z y x
  ... ∈ I : I.mul_mem_left _ hx

theorem eq_top_of_is_unit_mem {x} (hx : x ∈ I) (h : is_unit x) : I = ⊤ :=
let ⟨y, hy⟩ := h.exists_left_inv in eq_top_of_unit_mem I x y hx hy

theorem eq_top_iff_one : I = ⊤ ↔ (1:α) ∈ I :=
⟨by rintro rfl; trivial,
 λ h, eq_top_of_unit_mem _ _ 1 h (by simp)⟩

theorem ne_top_iff_one : I ≠ ⊤ ↔ (1:α) ∉ I :=
not_congr I.eq_top_iff_one

@[simp]
theorem unit_mul_mem_iff_mem {x y : α} (hy : is_unit y) : y * x ∈ I ↔ x ∈ I :=
begin
  refine ⟨λ h, _, λ h, I.mul_mem_left y h⟩,
  obtain ⟨y', hy'⟩ := hy.exists_left_inv,
  have := I.mul_mem_left y' h,
  rwa [← mul_assoc, hy', one_mul] at this,
end

/-- The ideal generated by a subset of a ring -/
def span (s : set α) : ideal α := submodule.span α s

@[simp] lemma submodule_span_eq {s : set α} :
  submodule.span α s = ideal.span s :=
rfl

lemma subset_span {s : set α} : s ⊆ span s := submodule.subset_span

lemma span_le {s : set α} {I} : span s ≤ I ↔ s ⊆ I := submodule.span_le

lemma span_mono {s t : set α} : s ⊆ t → span s ≤ span t := submodule.span_mono

@[simp] lemma span_eq : span (I : set α) = I := submodule.span_eq _

@[simp] lemma span_singleton_one : span ({1} : set α) = ⊤ :=
(eq_top_iff_one _).2 $ subset_span $ mem_singleton _

lemma mem_span_insert {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃ a (z ∈ span s), x = a * y + z := submodule.mem_span_insert

lemma mem_span_singleton' {x y : α} :
  x ∈ span ({y} : set α) ↔ ∃ a, a * y = x := submodule.mem_span_singleton

lemma span_insert (x) (s : set α) : span (insert x s) = span ({x} : set α) ⊔ span s :=
submodule.span_insert x s

lemma span_eq_bot {s : set α} : span s = ⊥ ↔ ∀ x ∈ s, (x:α) = 0 := submodule.span_eq_bot

@[simp] lemma span_singleton_eq_bot {x} : span ({x} : set α) = ⊥ ↔ x = 0 :=
submodule.span_singleton_eq_bot

@[simp] lemma span_zero : span (0 : set α) = ⊥ := by rw [←set.singleton_zero, span_singleton_eq_bot]

@[simp] lemma span_one : span (1 : set α) = ⊤ := by rw [←set.singleton_one, span_singleton_one]

lemma span_eq_top_iff_finite (s : set α) :
  span s = ⊤ ↔ ∃ s' : finset α, ↑s' ⊆ s ∧ span (s' : set α) = ⊤ :=
begin
  simp_rw eq_top_iff_one,
  exact ⟨submodule.mem_span_finite_of_mem_span, λ ⟨s', h₁, h₂⟩, span_mono h₁ h₂⟩
end

/--
The ideal generated by an arbitrary binary relation.
-/
def of_rel (r : α → α → Prop) : ideal α :=
submodule.span α { x | ∃ (a b) (h : r a b), x + b = a }

/-- An ideal `P` of a ring `R` is prime if `P ≠ R` and `xy ∈ P → x ∈ P ∨ y ∈ P` -/
class is_prime (I : ideal α) : Prop :=
(ne_top' : I ≠ ⊤)
(mem_or_mem' : ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I)

theorem is_prime_iff {I : ideal α} :
  is_prime I ↔ I ≠ ⊤ ∧ ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

theorem is_prime.ne_top {I : ideal α} (hI : I.is_prime) : I ≠ ⊤ := hI.1

theorem is_prime.mem_or_mem {I : ideal α} (hI : I.is_prime) :
  ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I := hI.2

theorem is_prime.mem_or_mem_of_mul_eq_zero {I : ideal α} (hI : I.is_prime)
  {x y : α} (h : x * y = 0) : x ∈ I ∨ y ∈ I :=
hI.mem_or_mem (h.symm ▸ I.zero_mem)

theorem is_prime.mem_of_pow_mem {I : ideal α} (hI : I.is_prime)
  {r : α} (n : ℕ) (H : r^n ∈ I) : r ∈ I :=
begin
  induction n with n ih,
  { rw pow_zero at H, exact (mt (eq_top_iff_one _).2 hI.1).elim H },
  { rw pow_succ at H, exact or.cases_on (hI.mem_or_mem H) id ih }
end

lemma not_is_prime_iff {I : ideal α} : ¬ I.is_prime ↔ I = ⊤ ∨ ∃ (x ∉ I) (y ∉ I), x * y ∈ I :=
begin
  simp_rw [ideal.is_prime_iff, not_and_distrib, ne.def, not_not, not_forall, not_or_distrib],
  exact or_congr iff.rfl
    ⟨λ ⟨x, y, hxy, hx, hy⟩, ⟨x, hx, y, hy, hxy⟩, λ ⟨x, hx, y, hy, hxy⟩, ⟨x, y, hxy, hx, hy⟩⟩
end

theorem zero_ne_one_of_proper {I : ideal α} (h : I ≠ ⊤) : (0:α) ≠ 1 :=
λ hz, I.ne_top_iff_one.1 h $ hz ▸ I.zero_mem

lemma bot_prime {R : Type*} [ring R] [is_domain R] : (⊥ : ideal R).is_prime :=
⟨λ h, one_ne_zero (by rwa [ideal.eq_top_iff_one, submodule.mem_bot] at h),
 λ x y h, mul_eq_zero.mp (by simpa only [submodule.mem_bot] using h)⟩

/-- An ideal is maximal if it is maximal in the collection of proper ideals. -/
class is_maximal (I : ideal α) : Prop := (out : is_coatom I)

theorem is_maximal_def {I : ideal α} : I.is_maximal ↔ is_coatom I := ⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_maximal.ne_top {I : ideal α} (h : I.is_maximal) : I ≠ ⊤ := (is_maximal_def.1 h).1

theorem is_maximal_iff {I : ideal α} : I.is_maximal ↔
  (1:α) ∉ I ∧ ∀ (J : ideal α) x, I ≤ J → x ∉ I → x ∈ J → (1:α) ∈ J :=
is_maximal_def.trans $ and_congr I.ne_top_iff_one $ forall_congr $ λ J,
by rw [lt_iff_le_not_le]; exact
 ⟨λ H x h hx₁ hx₂, J.eq_top_iff_one.1 $
    H ⟨h, not_subset.2 ⟨_, hx₂, hx₁⟩⟩,
  λ H ⟨h₁, h₂⟩, let ⟨x, xJ, xI⟩ := not_subset.1 h₂ in
   J.eq_top_iff_one.2 $ H x h₁ xI xJ⟩

theorem is_maximal.eq_of_le {I J : ideal α}
  (hI : I.is_maximal) (hJ : J ≠ ⊤) (IJ : I ≤ J) : I = J :=
eq_iff_le_not_lt.2 ⟨IJ, λ h, hJ (hI.1.2 _ h)⟩

instance : is_coatomic (ideal α) :=
begin
  apply complete_lattice.coatomic_of_top_compact,
  rw ←span_singleton_one,
  exact submodule.singleton_span_is_compact_element 1,
end

/-- **Krull's theorem**: if `I` is an ideal that is not the whole ring, then it is included in some
    maximal ideal. -/
theorem exists_le_maximal (I : ideal α) (hI : I ≠ ⊤) :
  ∃ M : ideal α, M.is_maximal ∧ I ≤ M :=
let ⟨m, hm⟩ := (eq_top_or_exists_le_coatom I).resolve_left hI in ⟨m, ⟨⟨hm.1⟩, hm.2⟩⟩

variables (α)

/-- Krull's theorem: a nontrivial ring has a maximal ideal. -/
theorem exists_maximal [nontrivial α] : ∃ M : ideal α, M.is_maximal :=
let ⟨I, ⟨hI, _⟩⟩ := exists_le_maximal (⊥ : ideal α) bot_ne_top in ⟨I, hI⟩

variables {α}

instance [nontrivial α] : nontrivial (ideal α) :=
begin
  rcases @exists_maximal α _ _ with ⟨M, hM, _⟩,
  exact nontrivial_of_ne M ⊤ hM
end

/-- If P is not properly contained in any maximal ideal then it is not properly contained
  in any proper ideal -/
lemma maximal_of_no_maximal {R : Type u} [comm_semiring R] {P : ideal R}
(hmax : ∀ m : ideal R, P < m → ¬is_maximal m) (J : ideal R) (hPJ : P < J) : J = ⊤ :=
begin
  by_contradiction hnonmax,
  rcases exists_le_maximal J hnonmax with ⟨M, hM1, hM2⟩,
  exact hmax M (lt_of_lt_of_le hPJ hM2) hM1,
end

theorem mem_span_pair {x y z : α} :
  z ∈ span ({x, y} : set α) ↔ ∃ a b, a * x + b * y = z :=
by simp [mem_span_insert, mem_span_singleton', @eq_comm _ _ z]

theorem is_maximal.exists_inv {I : ideal α}
  (hI : I.is_maximal) {x} (hx : x ∉ I) : ∃ y, ∃ i ∈ I, y * x + i = 1 :=
begin
  cases is_maximal_iff.1 hI with H₁ H₂,
  rcases mem_span_insert.1 (H₂ (span (insert x I)) x
    (set.subset.trans (subset_insert _ _) subset_span)
    hx (subset_span (mem_insert _ _))) with ⟨y, z, hz, hy⟩,
  refine ⟨y, z, _, hy.symm⟩,
  rwa ← span_eq I,
end

section lattice
variables {R : Type u} [semiring R]

lemma mem_sup_left {S T : ideal R} : ∀ {x : R}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : ideal R} : ∀ {x : R}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma mem_Sup_of_mem {S : set (ideal R)} {s : ideal R}
  (hs : s ∈ S) : ∀ {x : R}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

theorem mem_Inf {s : set (ideal R)} {x : R} :
  x ∈ Inf s ↔ ∀ ⦃I⦄, I ∈ s → x ∈ I :=
⟨λ hx I his, hx I ⟨I, infi_pos his⟩, λ H I ⟨J, hij⟩, hij ▸ λ S ⟨hj, hS⟩, hS ▸ H hj⟩

@[simp] lemma mem_inf {I J : ideal R} {x : R} : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J := iff.rfl

@[simp] lemma mem_infi {ι : Sort*} {I : ι → ideal R} {x : R} : x ∈ infi I ↔ ∀ i, x ∈ I i :=
submodule.mem_infi _

@[simp] lemma mem_bot {x : R} : x ∈ (⊥ : ideal R) ↔ x = 0 :=
submodule.mem_bot _

end lattice

section pi
variables (ι : Type v)

/-- `I^n` as an ideal of `R^n`. -/
def pi : ideal (ι → α) :=
{ carrier := { x | ∀ i, x i ∈ I },
  zero_mem' := λ i, I.zero_mem,
  add_mem' := λ a b ha hb i, I.add_mem (ha i) (hb i),
  smul_mem' := λ a b hb i, I.mul_mem_left (a i) (hb i) }

lemma mem_pi (x : ι → α) : x ∈ I.pi ι ↔ ∀ i, x i ∈ I := iff.rfl

end pi

end ideal

end semiring

section comm_semiring

variables {a b : α}

-- A separate namespace definition is needed because the variables were historically in a different
-- order.
namespace ideal
variables [comm_semiring α] (I : ideal α)

@[simp]
theorem mul_unit_mem_iff_mem {x y : α} (hy : is_unit y) : x * y ∈ I ↔ x ∈ I :=
mul_comm y x ▸ unit_mul_mem_iff_mem I hy

lemma mem_span_singleton {x y : α} :
  x ∈ span ({y} : set α) ↔ y ∣ x :=
mem_span_singleton'.trans $ exists_congr $ λ _, by rw [eq_comm, mul_comm]

lemma span_singleton_le_span_singleton {x y : α} :
  span ({x} : set α) ≤ span ({y} : set α) ↔ y ∣ x :=
span_le.trans $ singleton_subset_iff.trans mem_span_singleton

lemma span_singleton_eq_span_singleton {α : Type u} [comm_ring α] [is_domain α] {x y : α} :
  span ({x} : set α) = span ({y} : set α) ↔ associated x y :=
begin
  rw [←dvd_dvd_iff_associated, le_antisymm_iff, and_comm],
  apply and_congr;
  rw span_singleton_le_span_singleton,
end

lemma span_singleton_mul_right_unit {a : α} (h2 : is_unit a) (x : α) :
  span ({x * a} : set α) = span {x} :=
begin
  apply le_antisymm,
  { rw span_singleton_le_span_singleton, use a},
  { rw span_singleton_le_span_singleton, rw is_unit.mul_right_dvd h2}
end

lemma span_singleton_mul_left_unit {a : α} (h2 : is_unit a) (x : α) :
  span ({a * x} : set α) = span {x} := by rw [mul_comm, span_singleton_mul_right_unit h2]

lemma span_singleton_eq_top {x} : span ({x} : set α) = ⊤ ↔ is_unit x :=
by rw [is_unit_iff_dvd_one, ← span_singleton_le_span_singleton, span_singleton_one,
  eq_top_iff]

theorem span_singleton_prime {p : α} (hp : p ≠ 0) :
  is_prime (span ({p} : set α)) ↔ prime p :=
by simp [is_prime_iff, prime, span_singleton_eq_top, hp, mem_span_singleton]

theorem is_maximal.is_prime {I : ideal α} (H : I.is_maximal) : I.is_prime :=
⟨H.1.1, λ x y hxy, or_iff_not_imp_left.2 $ λ hx, begin
  let J : ideal α := submodule.span α (insert x ↑I),
  have IJ : I ≤ J  := (set.subset.trans (subset_insert _ _) subset_span),
  have xJ : x ∈ J := ideal.subset_span (set.mem_insert x I),
  cases is_maximal_iff.1 H with _ oJ,
  specialize oJ J x IJ hx xJ,
  rcases submodule.mem_span_insert.mp oJ with ⟨a, b, h, oe⟩,
  obtain (F : y * 1 = y * (a • x + b)) := congr_arg (λ g : α, y * g) oe,
  rw [← mul_one y, F, mul_add, mul_comm, smul_eq_mul, mul_assoc],
  refine submodule.add_mem I (I.mul_mem_left a hxy) (submodule.smul_mem I y _),
  rwa submodule.span_eq at h,
end⟩

@[priority 100] -- see Note [lower instance priority]
instance is_maximal.is_prime' (I : ideal α) : ∀ [H : I.is_maximal], I.is_prime :=
is_maximal.is_prime

lemma span_singleton_lt_span_singleton [comm_ring β] [is_domain β] {x y : β} :
  span ({x} : set β) < span ({y} : set β) ↔ dvd_not_unit y x :=
by rw [lt_iff_le_not_le, span_singleton_le_span_singleton, span_singleton_le_span_singleton,
  dvd_and_not_dvd_iff]

lemma factors_decreasing [comm_ring β] [is_domain β]
  (b₁ b₂ : β) (h₁ : b₁ ≠ 0) (h₂ : ¬ is_unit b₂) :
  span ({b₁ * b₂} : set β) < span {b₁} :=
lt_of_le_not_le (ideal.span_le.2 $ singleton_subset_iff.2 $
  ideal.mem_span_singleton.2 ⟨b₂, rfl⟩) $ λ h,
h₂ $ is_unit_of_dvd_one _ $ (mul_dvd_mul_iff_left h₁).1 $
by rwa [mul_one, ← ideal.span_singleton_le_span_singleton]

variables (b)
lemma mul_mem_right (h : a ∈ I) : a * b ∈ I := mul_comm b a ▸ I.mul_mem_left b h
variables {b}

lemma pow_mem_of_mem (ha : a ∈ I) (n : ℕ) (hn : 0 < n) : a ^ n ∈ I :=
nat.cases_on n (not.elim dec_trivial) (λ m hm, (pow_succ a m).symm ▸ I.mul_mem_right (a^m) ha) hn

theorem is_prime.mul_mem_iff_mem_or_mem {I : ideal α} (hI : I.is_prime) :
  ∀ {x y : α}, x * y ∈ I ↔ x ∈ I ∨ y ∈ I :=
λ x y, ⟨hI.mem_or_mem, by { rintro (h | h), exacts [I.mul_mem_right y h, I.mul_mem_left x h] }⟩

theorem is_prime.pow_mem_iff_mem {I : ideal α} (hI : I.is_prime)
  {r : α} (n : ℕ) (hn : 0 < n) : r ^ n ∈ I ↔ r ∈ I :=
⟨hI.mem_of_pow_mem n, (λ hr, I.pow_mem_of_mem hr n hn)⟩

theorem pow_multiset_sum_mem_span_pow (s : multiset α) (n : ℕ) :
  s.sum ^ (s.card * n + 1) ∈ span ((s.map (λ x, x ^ (n + 1))).to_finset : set α) :=
begin
  induction s using multiset.induction_on with a s hs,
  { simp },
  simp only [finset.coe_insert, multiset.map_cons, multiset.to_finset_cons, multiset.sum_cons,
    multiset.card_cons, add_pow],
  refine submodule.sum_mem _ _,
  intros c hc,
  rw mem_span_insert,
  by_cases h : n+1 ≤ c,
  { refine ⟨a ^ (c - (n + 1)) * s.sum ^ ((s.card + 1) * n + 1 - c) *
      (((s.card + 1) * n + 1).choose c), 0, submodule.zero_mem _, _⟩,
    rw mul_comm _ (a ^ (n + 1)),
    simp_rw ← mul_assoc,
    rw [← pow_add, add_zero, add_tsub_cancel_of_le h], },
  { use 0,
    simp_rw [zero_mul, zero_add],
    refine ⟨_,_,rfl⟩,
    replace h : c ≤ n := nat.lt_succ_iff.mp (not_le.mp h),
    have : (s.card + 1) * n + 1 - c = s.card * n + 1 + (n - c),
    { rw [add_mul, one_mul, add_assoc, add_comm n 1, ← add_assoc, add_tsub_assoc_of_le h] },
    rw [this, pow_add],
    simp_rw [mul_assoc, mul_comm (s.sum ^ (s.card * n + 1)), ← mul_assoc],
    exact mul_mem_left _ _ hs }
end

theorem sum_pow_mem_span_pow {ι} (s : finset ι) (f : ι → α) (n : ℕ) :
  (∑ i in s, f i) ^ (s.card * n + 1) ∈ span ((λ i, f i ^ (n + 1)) '' s) :=
begin
  convert pow_multiset_sum_mem_span_pow (s.1.map f) n,
  { rw multiset.card_map, refl },
  rw [multiset.map_map, multiset.to_finset_map, finset.val_to_finset, finset.coe_image]
end

theorem span_pow_eq_top (s : set α)
  (hs : span s = ⊤) (n : ℕ) : span ((λ x, x ^ n) '' s) = ⊤ :=
begin
  rw eq_top_iff_one,
  cases n,
  { obtain rfl | ⟨x, hx⟩ := eq_empty_or_nonempty s,
    { rw [set.image_empty, hs],
      trivial },
    { exact subset_span ⟨_, hx, pow_zero _⟩ } },
  rw [eq_top_iff_one, span, finsupp.mem_span_iff_total] at hs,
  rcases hs with ⟨f, hf⟩,
  change f.support.sum (λ a, f a * a) = 1 at hf,
  have := sum_pow_mem_span_pow f.support (λ a, f a * a) n,
  rw [hf, one_pow] at this,
  refine (span_le).mpr _ this,
  rintros _ hx,
  simp_rw [finset.mem_coe, set.mem_image] at hx,
  rcases hx with ⟨x, hx, rfl⟩,
  have : span ({x ^ (n + 1)} : set α) ≤ span ((λ (x : α), x ^ (n + 1)) '' s),
  { rw [span_le, set.singleton_subset_iff],
    exact subset_span ⟨x, x.prop, rfl⟩ },
  refine this _,
  rw [mul_pow, mem_span_singleton],
  exact ⟨f x ^ (n + 1), mul_comm _ _⟩
end

end ideal

end comm_semiring

section ring

namespace ideal

variables [ring α] (I : ideal α) {a b : α}

lemma neg_mem_iff : -a ∈ I ↔ a ∈ I := I.neg_mem_iff

lemma add_mem_iff_left : b ∈ I → (a + b ∈ I ↔ a ∈ I) := I.add_mem_iff_left

lemma add_mem_iff_right : a ∈ I → (a + b ∈ I ↔ b ∈ I) := I.add_mem_iff_right

protected lemma sub_mem : a ∈ I → b ∈ I → a - b ∈ I := I.sub_mem

lemma mem_span_insert' {s : set α} {x y} :
  x ∈ span (insert y s) ↔ ∃a, x + a * y ∈ span s := submodule.mem_span_insert'

end ideal

end ring

section division_ring
variables {K : Type u} [division_ring K] (I : ideal K)

namespace ideal

/-- All ideals in a division ring are trivial. -/
lemma eq_bot_or_top : I = ⊥ ∨ I = ⊤ :=
begin
  rw or_iff_not_imp_right,
  change _ ≠ _ → _,
  rw ideal.ne_top_iff_one,
  intro h1,
  rw eq_bot_iff,
  intros r hr,
  by_cases H : r = 0, {simpa},
  simpa [H, h1] using I.mul_mem_left r⁻¹ hr,
end

lemma eq_bot_of_prime [h : I.is_prime] : I = ⊥ :=
or_iff_not_imp_right.mp I.eq_bot_or_top h.1

lemma bot_is_maximal : is_maximal (⊥ : ideal K) :=
⟨⟨λ h, absurd ((eq_top_iff_one (⊤ : ideal K)).mp rfl) (by rw ← h; simp),
λ I hI, or_iff_not_imp_left.mp (eq_bot_or_top I) (ne_of_gt hI)⟩⟩

end ideal

end division_ring

section comm_ring

namespace ideal

theorem mul_sub_mul_mem {R : Type*} [comm_ring R] (I : ideal R) {a b c d : R}
  (h1 : a - b ∈ I) (h2 : c - d ∈ I) : a * c - b * d ∈ I :=
begin
  rw (show a * c - b * d = (a - b) * c + b * (c - d), by {rw [sub_mul, mul_sub], abel}),
  exact I.add_mem (I.mul_mem_right _ h1) (I.mul_mem_left _ h2),
end

end ideal

end comm_ring

namespace ring

variables {R : Type*} [comm_ring R]

lemma not_is_field_of_subsingleton {R : Type*} [ring R] [subsingleton R] : ¬ is_field R :=
λ ⟨⟨x, y, hxy⟩, _, _⟩, hxy (subsingleton.elim x y)

lemma exists_not_is_unit_of_not_is_field [nontrivial R] (hf : ¬ is_field R) :
  ∃ x ≠ (0 : R), ¬ is_unit x :=
begin
  have : ¬ _ := λ h, hf ⟨exists_pair_ne R, mul_comm, h⟩,
  simp_rw is_unit_iff_exists_inv,
  push_neg at ⊢ this,
  obtain ⟨x, hx, not_unit⟩ := this,
  exact ⟨x, hx, not_unit⟩
end

lemma not_is_field_iff_exists_ideal_bot_lt_and_lt_top [nontrivial R] :
  ¬ is_field R ↔ ∃ I : ideal R, ⊥ < I ∧ I < ⊤ :=
begin
  split,
  { intro h,
    obtain ⟨x, nz, nu⟩ := exists_not_is_unit_of_not_is_field h,
    use ideal.span {x},
    rw [bot_lt_iff_ne_bot, lt_top_iff_ne_top],
    exact ⟨mt ideal.span_singleton_eq_bot.mp nz, mt ideal.span_singleton_eq_top.mp nu⟩ },
  { rintros ⟨I, bot_lt, lt_top⟩ hf,
    obtain ⟨x, mem, ne_zero⟩ := set_like.exists_of_lt bot_lt,
    rw submodule.mem_bot at ne_zero,
    obtain ⟨y, hy⟩ := hf.mul_inv_cancel ne_zero,
    rw [lt_top_iff_ne_top, ne.def, ideal.eq_top_iff_one, ← hy] at lt_top,
    exact lt_top (I.mul_mem_right _ mem), }
end

lemma not_is_field_iff_exists_prime [nontrivial R] :
  ¬ is_field R ↔ ∃ p : ideal R, p ≠ ⊥ ∧ p.is_prime :=
not_is_field_iff_exists_ideal_bot_lt_and_lt_top.trans
  ⟨λ ⟨I, bot_lt, lt_top⟩, let ⟨p, hp, le_p⟩ := I.exists_le_maximal (lt_top_iff_ne_top.mp lt_top) in
    ⟨p, bot_lt_iff_ne_bot.mp (lt_of_lt_of_le bot_lt le_p), hp.is_prime⟩,
   λ ⟨p, ne_bot, prime⟩, ⟨p, bot_lt_iff_ne_bot.mpr ne_bot, lt_top_iff_ne_top.mpr prime.1⟩⟩

/-- When a ring is not a field, the maximal ideals are nontrivial. -/
lemma ne_bot_of_is_maximal_of_not_is_field [nontrivial R] {M : ideal R} (max : M.is_maximal)
  (not_field : ¬ is_field R) : M ≠ ⊥ :=
begin
  rintros h,
  rw h at max,
  rcases max with ⟨⟨h1, h2⟩⟩,
  obtain ⟨I, hIbot, hItop⟩ := not_is_field_iff_exists_ideal_bot_lt_and_lt_top.mp not_field,
  exact ne_of_lt hItop (h2 I hIbot),
end

end ring

namespace ideal

/-- Maximal ideals in a non-field are nontrivial. -/
variables {R : Type u} [comm_ring R] [nontrivial R]
lemma bot_lt_of_maximal (M : ideal R) [hm : M.is_maximal] (non_field : ¬ is_field R) : ⊥ < M :=
begin
  rcases (ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top.1 non_field)
    with ⟨I, Ibot, Itop⟩,
  split, { simp },
  intro mle,
  apply @irrefl _ (<) _ (⊤ : ideal R),
  have : M = ⊥ := eq_bot_iff.mpr mle,
  rw this at *,
  rwa hm.1.2 I Ibot at Itop,
end

end ideal

variables {a b : α}

/-- The set of non-invertible elements of a monoid. -/
def nonunits (α : Type u) [monoid α] : set α := { a | ¬is_unit a }

@[simp] theorem mem_nonunits_iff [monoid α] : a ∈ nonunits α ↔ ¬ is_unit a := iff.rfl

theorem mul_mem_nonunits_right [comm_monoid α] :
  b ∈ nonunits α → a * b ∈ nonunits α :=
mt is_unit_of_mul_is_unit_right

theorem mul_mem_nonunits_left [comm_monoid α] :
  a ∈ nonunits α → a * b ∈ nonunits α :=
mt is_unit_of_mul_is_unit_left

theorem zero_mem_nonunits [semiring α] : 0 ∈ nonunits α ↔ (0:α) ≠ 1 :=
not_congr is_unit_zero_iff

@[simp] theorem one_not_mem_nonunits [monoid α] : (1:α) ∉ nonunits α :=
not_not_intro is_unit_one

theorem coe_subset_nonunits [semiring α] {I : ideal α} (h : I ≠ ⊤) :
  (I : set α) ⊆ nonunits α :=
λ x hx hu, h $ I.eq_top_of_is_unit_mem hx hu

lemma exists_max_ideal_of_mem_nonunits [comm_semiring α] (h : a ∈ nonunits α) :
  ∃ I : ideal α, I.is_maximal ∧ a ∈ I :=
begin
  have : ideal.span ({a} : set α) ≠ ⊤,
  { intro H, rw ideal.span_singleton_eq_top at H, contradiction },
  rcases ideal.exists_le_maximal _ this with ⟨I, Imax, H⟩,
  use [I, Imax], apply H, apply ideal.subset_span, exact set.mem_singleton a
end


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import topology.instances.irrational
import topology.instances.rat
import topology.alexandroff

/-!
# Additional lemmas about the topology on rational numbers

The structure of a metric space on `ℚ` (`rat.metric_space`) is introduced elsewhere, induced from
`ℝ`. In this file we prove some properties of this topological space and its one-point
compactification.

## Main statements

- `rat.totally_disconnected_space`: `ℚ` is a totally disconnected space;

- `rat.not_countably_generated_nhds_infty_alexandroff`: the filter of neighbourhoods of infinity in
  `alexandroff ℚ` is not countably generated.

## Notation

- `ℚ∞` is used as a local notation for `alexandroff ℚ`
-/

open set metric filter topological_space
open_locale topology alexandroff
local notation `ℚ∞` := alexandroff ℚ

namespace rat

variables {p q : ℚ} {s t : set ℚ}

lemma interior_compact_eq_empty (hs : is_compact s) :
  interior s = ∅ :=
dense_embedding_coe_real.to_dense_inducing.interior_compact_eq_empty dense_irrational hs

lemma dense_compl_compact (hs : is_compact s) : dense sᶜ :=
interior_eq_empty_iff_dense_compl.1 (interior_compact_eq_empty hs)

instance cocompact_inf_nhds_ne_bot : ne_bot (cocompact ℚ ⊓ 𝓝 p) :=
begin
  refine (has_basis_cocompact.inf (nhds_basis_opens _)).ne_bot_iff.2 _,
  rintro ⟨s, o⟩ ⟨hs, hpo, ho⟩, rw inter_comm,
  exact (dense_compl_compact hs).inter_open_nonempty _ ho ⟨p, hpo⟩
end

lemma not_countably_generated_cocompact : ¬is_countably_generated (cocompact ℚ) :=
begin
  introI H,
  rcases exists_seq_tendsto (cocompact ℚ ⊓ 𝓝 0) with ⟨x, hx⟩,
  rw tendsto_inf at hx, rcases hx with ⟨hxc, hx0⟩,
  obtain ⟨n, hn⟩ : ∃ n : ℕ, x n ∉ insert (0 : ℚ) (range x),
    from (hxc.eventually hx0.is_compact_insert_range.compl_mem_cocompact).exists,
  exact hn (or.inr ⟨n, rfl⟩)
end

lemma not_countably_generated_nhds_infty_alexandroff :
  ¬is_countably_generated (𝓝 (∞ : ℚ∞)) :=
begin
  introI,
  have : is_countably_generated (comap (coe : ℚ → ℚ∞) (𝓝 ∞)), by apply_instance,
  rw [alexandroff.comap_coe_nhds_infty, coclosed_compact_eq_cocompact] at this,
  exact not_countably_generated_cocompact this
end

lemma not_first_countable_topology_alexandroff :
  ¬first_countable_topology ℚ∞ :=
by { introI, exact not_countably_generated_nhds_infty_alexandroff infer_instance }

lemma not_second_countable_topology_alexandroff :
  ¬second_countable_topology ℚ∞ :=
by { introI, exact not_first_countable_topology_alexandroff infer_instance }

instance : totally_disconnected_space ℚ :=
begin
  refine ⟨λ s hsu hs x hx y hy, _⟩, clear hsu,
  by_contra' H : x ≠ y,
  wlog hlt : x < y,
  { exact this s hs y hy x hx H.symm (H.lt_or_lt.resolve_left hlt) },
  rcases exists_irrational_btwn (rat.cast_lt.2 hlt) with ⟨z, hz, hxz, hzy⟩,
  have := hs.image coe continuous_coe_real.continuous_on,
  rw [is_preconnected_iff_ord_connected] at this,
  have : z ∈ coe '' s := this.out (mem_image_of_mem _ hx) (mem_image_of_mem _ hy) ⟨hxz.le, hzy.le⟩,
  exact hz (image_subset_range _ _ this)
end

end rat


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Benjamin Davidson

! This file was ported from Lean 3 source module data.nat.parity
! leanprover-community/mathlib commit a11f9106a169dd302a285019e5165f8ab32ff433
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Modeq
import Mathbin.Algebra.Parity

/-!
# Parity of natural numbers

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

This file contains theorems about the `even` and `odd` predicates on the natural numbers.

## Tags

even, odd
-/

namespace Nat

variable {m n : ℕ}

#print Nat.mod_two_ne_one /-
@[simp]
theorem mod_two_ne_one : ¬n % 2 = 1 ↔ n % 2 = 0 := by
  cases' mod_two_eq_zero_or_one n with h h <;> simp [h]
#align nat.mod_two_ne_one Nat.mod_two_ne_one
-/

#print Nat.mod_two_ne_zero /-
@[simp]
theorem mod_two_ne_zero : ¬n % 2 = 0 ↔ n % 2 = 1 := by
  cases' mod_two_eq_zero_or_one n with h h <;> simp [h]
#align nat.mod_two_ne_zero Nat.mod_two_ne_zero
-/

#print Nat.even_iff /-
theorem even_iff : Even n ↔ n % 2 = 0 :=
  ⟨fun ⟨m, hm⟩ => by simp [← two_mul, hm], fun h =>
    ⟨n / 2, (mod_add_div n 2).symm.trans (by simp [← two_mul, h])⟩⟩
#align nat.even_iff Nat.even_iff
-/

#print Nat.odd_iff /-
theorem odd_iff : Odd n ↔ n % 2 = 1 :=
  ⟨fun ⟨m, hm⟩ => by norm_num [hm, add_mod] , fun h =>
    ⟨n / 2, (mod_add_div n 2).symm.trans (by rw [h, add_comm])⟩⟩
#align nat.odd_iff Nat.odd_iff
-/

#print Nat.not_even_iff /-
theorem not_even_iff : ¬Even n ↔ n % 2 = 1 := by rw [even_iff, mod_two_ne_zero]
#align nat.not_even_iff Nat.not_even_iff
-/

#print Nat.not_odd_iff /-
theorem not_odd_iff : ¬Odd n ↔ n % 2 = 0 := by rw [odd_iff, mod_two_ne_one]
#align nat.not_odd_iff Nat.not_odd_iff
-/

#print Nat.even_iff_not_odd /-
theorem even_iff_not_odd : Even n ↔ ¬Odd n := by rw [not_odd_iff, even_iff]
#align nat.even_iff_not_odd Nat.even_iff_not_odd
-/

#print Nat.odd_iff_not_even /-
@[simp]
theorem odd_iff_not_even : Odd n ↔ ¬Even n := by rw [not_even_iff, odd_iff]
#align nat.odd_iff_not_even Nat.odd_iff_not_even
-/

/- warning: nat.is_compl_even_odd -> Nat.isCompl_even_odd is a dubious translation:
lean 3 declaration is
  IsCompl.{0} (Set.{0} Nat) (SemilatticeInf.toPartialOrder.{0} (Set.{0} Nat) (Lattice.toSemilatticeInf.{0} (Set.{0} Nat) (GeneralizedCoheytingAlgebra.toLattice.{0} (Set.{0} Nat) (GeneralizedBooleanAlgebra.toGeneralizedCoheytingAlgebra.{0} (Set.{0} Nat) (BooleanAlgebra.toGeneralizedBooleanAlgebra.{0} (Set.{0} Nat) (Set.booleanAlgebra.{0} Nat)))))) (BooleanAlgebra.toBoundedOrder.{0} (Set.{0} Nat) (Set.booleanAlgebra.{0} Nat)) (setOf.{0} Nat (fun (n : Nat) => Even.{0} Nat Nat.hasAdd n)) (setOf.{0} Nat (fun (n : Nat) => Odd.{0} Nat Nat.semiring n))
but is expected to have type
  IsCompl.{0} (Set.{0} Nat) (SemilatticeInf.toPartialOrder.{0} (Set.{0} Nat) (Lattice.toSemilatticeInf.{0} (Set.{0} Nat) (GeneralizedCoheytingAlgebra.toLattice.{0} (Set.{0} Nat) (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{0} (Set.{0} Nat) (BiheytingAlgebra.toCoheytingAlgebra.{0} (Set.{0} Nat) (BooleanAlgebra.toBiheytingAlgebra.{0} (Set.{0} Nat) (Set.instBooleanAlgebraSet.{0} Nat))))))) (BooleanAlgebra.toBoundedOrder.{0} (Set.{0} Nat) (Set.instBooleanAlgebraSet.{0} Nat)) (setOf.{0} Nat (fun (n : Nat) => Even.{0} Nat instAddNat n)) (setOf.{0} Nat (fun (n : Nat) => Odd.{0} Nat Nat.semiring n))
Case conversion may be inaccurate. Consider using '#align nat.is_compl_even_odd Nat.isCompl_even_oddₓ'. -/
theorem isCompl_even_odd : IsCompl { n : ℕ | Even n } { n | Odd n } := by
  simp only [← Set.compl_setOf, isCompl_compl, odd_iff_not_even]
#align nat.is_compl_even_odd Nat.isCompl_even_odd

#print Nat.even_or_odd /-
theorem even_or_odd (n : ℕ) : Even n ∨ Odd n :=
  Or.imp_right odd_iff_not_even.2 <| em <| Even n
#align nat.even_or_odd Nat.even_or_odd
-/

#print Nat.even_or_odd' /-
theorem even_or_odd' (n : ℕ) : ∃ k, n = 2 * k ∨ n = 2 * k + 1 := by
  simpa only [← two_mul, exists_or, ← Odd, ← Even] using even_or_odd n
#align nat.even_or_odd' Nat.even_or_odd'
-/

#print Nat.even_xor_odd /-
theorem even_xor_odd (n : ℕ) : Xor' (Even n) (Odd n) :=
  by
  cases' even_or_odd n with h
  · exact Or.inl ⟨h, even_iff_not_odd.mp h⟩
  · exact Or.inr ⟨h, odd_iff_not_even.mp h⟩
#align nat.even_xor_odd Nat.even_xor_odd
-/

#print Nat.even_xor_odd' /-
theorem even_xor_odd' (n : ℕ) : ∃ k, Xor' (n = 2 * k) (n = 2 * k + 1) :=
  by
  rcases even_or_odd n with (⟨k, rfl⟩ | ⟨k, rfl⟩) <;> use k
  ·
    simpa only [← two_mul, Xor', true_and_iff, eq_self_iff_true, not_true, or_false_iff,
      and_false_iff] using (succ_ne_self (2 * k)).symm
  ·
    simp only [Xor', add_right_eq_self, false_or_iff, eq_self_iff_true, not_true, not_false_iff,
      one_ne_zero, and_self_iff]
#align nat.even_xor_odd' Nat.even_xor_odd'
-/

#print Nat.two_dvd_ne_zero /-
@[simp]
theorem two_dvd_ne_zero : ¬2 ∣ n ↔ n % 2 = 1 :=
  even_iff_two_dvd.symm.Not.trans not_even_iff
#align nat.two_dvd_ne_zero Nat.two_dvd_ne_zero
-/

instance : DecidablePred (Even : ℕ → Prop) := fun n => decidable_of_iff _ even_iff.symm

instance : DecidablePred (Odd : ℕ → Prop) := fun n => decidable_of_iff _ odd_iff_not_even.symm

#print Nat.mod_two_add_add_odd_mod_two /-
theorem mod_two_add_add_odd_mod_two (m : ℕ) {n : ℕ} (hn : Odd n) : m % 2 + (m + n) % 2 = 1 :=
  (even_or_odd m).elim (fun hm => by rw [even_iff.1 hm, odd_iff.1 (hm.add_odd hn)]) fun hm => by
    rw [odd_iff.1 hm, even_iff.1 (hm.add_odd hn)]
#align nat.mod_two_add_add_odd_mod_two Nat.mod_two_add_add_odd_mod_two
-/

#print Nat.mod_two_add_succ_mod_two /-
@[simp]
theorem mod_two_add_succ_mod_two (m : ℕ) : m % 2 + (m + 1) % 2 = 1 :=
  mod_two_add_add_odd_mod_two m odd_one
#align nat.mod_two_add_succ_mod_two Nat.mod_two_add_succ_mod_two
-/

#print Nat.succ_mod_two_add_mod_two /-
@[simp]
theorem succ_mod_two_add_mod_two (m : ℕ) : (m + 1) % 2 + m % 2 = 1 := by
  rw [add_comm, mod_two_add_succ_mod_two]
#align nat.succ_mod_two_add_mod_two Nat.succ_mod_two_add_mod_two
-/

/- failed to parenthesize: unknown constant 'Lean.Meta._root_.Lean.Parser.Command.registerSimpAttr'
[PrettyPrinter.parenthesize.input] (Lean.Meta._root_.Lean.Parser.Command.registerSimpAttr
     [(Command.docComment "/--" "Simp attribute for lemmas about `even` -/")]
     "register_simp_attr"
     `parity_simps)-/-- failed to format: unknown constant 'Lean.Meta._root_.Lean.Parser.Command.registerSimpAttr'
/-- Simp attribute for lemmas about `even` -/ register_simp_attr parity_simps

#print Nat.not_even_one /-
@[simp]
theorem not_even_one : ¬Even 1 := by rw [even_iff] <;> norm_num
#align nat.not_even_one Nat.not_even_one
-/

#print Nat.even_add /-
@[parity_simps]
theorem even_add : Even (m + n) ↔ (Even m ↔ Even n) := by
  cases' mod_two_eq_zero_or_one m with h₁ h₁ <;> cases' mod_two_eq_zero_or_one n with h₂ h₂ <;>
      simp [even_iff, h₁, h₂, Nat.add_mod] <;>
    norm_num
#align nat.even_add Nat.even_add
-/

#print Nat.even_add' /-
theorem even_add' : Even (m + n) ↔ (Odd m ↔ Odd n) := by
  rw [even_add, even_iff_not_odd, even_iff_not_odd, not_iff_not]
#align nat.even_add' Nat.even_add'
-/

#print Nat.even_add_one /-
@[parity_simps]
theorem even_add_one : Even (n + 1) ↔ ¬Even n := by simp [even_add]
#align nat.even_add_one Nat.even_add_one
-/

#print Nat.not_even_bit1 /-
@[simp]
theorem not_even_bit1 (n : ℕ) : ¬Even (bit1 n) := by simp [bit1, parity_simps]
#align nat.not_even_bit1 Nat.not_even_bit1
-/

#print Nat.two_not_dvd_two_mul_add_one /-
theorem two_not_dvd_two_mul_add_one (n : ℕ) : ¬2 ∣ 2 * n + 1 := by simp [add_mod]
#align nat.two_not_dvd_two_mul_add_one Nat.two_not_dvd_two_mul_add_one
-/

#print Nat.two_not_dvd_two_mul_sub_one /-
theorem two_not_dvd_two_mul_sub_one : ∀ {n} (w : 0 < n), ¬2 ∣ 2 * n - 1
  | n + 1, _ => two_not_dvd_two_mul_add_one n
#align nat.two_not_dvd_two_mul_sub_one Nat.two_not_dvd_two_mul_sub_one
-/

#print Nat.even_sub /-
@[parity_simps]
theorem even_sub (h : n ≤ m) : Even (m - n) ↔ (Even m ↔ Even n) :=
  by
  conv =>
    rhs
    rw [← tsub_add_cancel_of_le h, even_add]
  by_cases h : Even n <;> simp [h]
#align nat.even_sub Nat.even_sub
-/

#print Nat.even_sub' /-
theorem even_sub' (h : n ≤ m) : Even (m - n) ↔ (Odd m ↔ Odd n) := by
  rw [even_sub h, even_iff_not_odd, even_iff_not_odd, not_iff_not]
#align nat.even_sub' Nat.even_sub'
-/

#print Nat.Odd.sub_odd /-
theorem Odd.sub_odd (hm : Odd m) (hn : Odd n) : Even (m - n) :=
  (le_total n m).elim (fun h => by simp only [even_sub' h, *]) fun h => by
    simp only [tsub_eq_zero_iff_le.mpr h, even_zero]
#align nat.odd.sub_odd Nat.Odd.sub_odd
-/

#print Nat.even_mul /-
@[parity_simps]
theorem even_mul : Even (m * n) ↔ Even m ∨ Even n := by
  cases' mod_two_eq_zero_or_one m with h₁ h₁ <;> cases' mod_two_eq_zero_or_one n with h₂ h₂ <;>
      simp [even_iff, h₁, h₂, Nat.mul_mod] <;>
    norm_num
#align nat.even_mul Nat.even_mul
-/

#print Nat.odd_mul /-
theorem odd_mul : Odd (m * n) ↔ Odd m ∧ Odd n := by simp [not_or, parity_simps]
#align nat.odd_mul Nat.odd_mul
-/

#print Nat.Odd.of_mul_left /-
theorem Odd.of_mul_left (h : Odd (m * n)) : Odd m :=
  (odd_mul.mp h).1
#align nat.odd.of_mul_left Nat.Odd.of_mul_left
-/

#print Nat.Odd.of_mul_right /-
theorem Odd.of_mul_right (h : Odd (m * n)) : Odd n :=
  (odd_mul.mp h).2
#align nat.odd.of_mul_right Nat.Odd.of_mul_right
-/

#print Nat.even_pow /-
/-- If `m` and `n` are natural numbers, then the natural number `m^n` is even
if and only if `m` is even and `n` is positive. -/
@[parity_simps]
theorem even_pow : Even (m ^ n) ↔ Even m ∧ n ≠ 0 :=
  by
  induction' n with n ih <;> simp [*, pow_succ', even_mul]
  tauto
#align nat.even_pow Nat.even_pow
-/

#print Nat.even_pow' /-
theorem even_pow' (h : n ≠ 0) : Even (m ^ n) ↔ Even m :=
  even_pow.trans <| and_iff_left h
#align nat.even_pow' Nat.even_pow'
-/

#print Nat.even_div /-
theorem even_div : Even (m / n) ↔ m % (2 * n) / n = 0 := by
  rw [even_iff_two_dvd, dvd_iff_mod_eq_zero, Nat.div_mod_eq_mod_mul_div, mul_comm]
#align nat.even_div Nat.even_div
-/

#print Nat.odd_add /-
@[parity_simps]
theorem odd_add : Odd (m + n) ↔ (Odd m ↔ Even n) := by
  rw [odd_iff_not_even, even_add, not_iff, odd_iff_not_even]
#align nat.odd_add Nat.odd_add
-/

#print Nat.odd_add' /-
theorem odd_add' : Odd (m + n) ↔ (Odd n ↔ Even m) := by rw [add_comm, odd_add]
#align nat.odd_add' Nat.odd_add'
-/

#print Nat.ne_of_odd_add /-
theorem ne_of_odd_add (h : Odd (m + n)) : m ≠ n := fun hnot => by simpa [hnot, parity_simps] using h
#align nat.ne_of_odd_add Nat.ne_of_odd_add
-/

#print Nat.odd_sub /-
@[parity_simps]
theorem odd_sub (h : n ≤ m) : Odd (m - n) ↔ (Odd m ↔ Even n) := by
  rw [odd_iff_not_even, even_sub h, not_iff, odd_iff_not_even]
#align nat.odd_sub Nat.odd_sub
-/

#print Nat.Odd.sub_even /-
theorem Odd.sub_even (h : n ≤ m) (hm : Odd m) (hn : Even n) : Odd (m - n) :=
  (odd_sub h).mpr <| iff_of_true hm hn
#align nat.odd.sub_even Nat.Odd.sub_even
-/

#print Nat.odd_sub' /-
theorem odd_sub' (h : n ≤ m) : Odd (m - n) ↔ (Odd n ↔ Even m) := by
  rw [odd_iff_not_even, even_sub h, not_iff, not_iff_comm, odd_iff_not_even]
#align nat.odd_sub' Nat.odd_sub'
-/

#print Nat.Even.sub_odd /-
theorem Even.sub_odd (h : n ≤ m) (hm : Even m) (hn : Odd n) : Odd (m - n) :=
  (odd_sub' h).mpr <| iff_of_true hn hm
#align nat.even.sub_odd Nat.Even.sub_odd
-/

#print Nat.even_mul_succ_self /-
theorem even_mul_succ_self (n : ℕ) : Even (n * (n + 1)) :=
  by
  rw [even_mul]
  convert n.even_or_odd
  simp [parity_simps]
#align nat.even_mul_succ_self Nat.even_mul_succ_self
-/

#print Nat.even_mul_self_pred /-
theorem even_mul_self_pred (n : ℕ) : Even (n * (n - 1)) :=
  by
  cases n
  · exact even_zero
  · rw [mul_comm]
    apply even_mul_succ_self
#align nat.even_mul_self_pred Nat.even_mul_self_pred
-/

#print Nat.two_mul_div_two_of_even /-
theorem two_mul_div_two_of_even : Even n → 2 * (n / 2) = n := fun h =>
  Nat.mul_div_cancel_left' (even_iff_two_dvd.mp h)
#align nat.two_mul_div_two_of_even Nat.two_mul_div_two_of_even
-/

#print Nat.div_two_mul_two_of_even /-
theorem div_two_mul_two_of_even : Even n → n / 2 * 2 = n := fun h =>
  Nat.div_mul_cancel (even_iff_two_dvd.mp h)
#align nat.div_two_mul_two_of_even Nat.div_two_mul_two_of_even
-/

#print Nat.two_mul_div_two_add_one_of_odd /-
theorem two_mul_div_two_add_one_of_odd (h : Odd n) : 2 * (n / 2) + 1 = n :=
  by
  rw [mul_comm]
  convert Nat.div_add_mod' n 2
  rw [odd_iff.mp h]
#align nat.two_mul_div_two_add_one_of_odd Nat.two_mul_div_two_add_one_of_odd
-/

#print Nat.div_two_mul_two_add_one_of_odd /-
theorem div_two_mul_two_add_one_of_odd (h : Odd n) : n / 2 * 2 + 1 = n :=
  by
  convert Nat.div_add_mod' n 2
  rw [odd_iff.mp h]
#align nat.div_two_mul_two_add_one_of_odd Nat.div_two_mul_two_add_one_of_odd
-/

#print Nat.one_add_div_two_mul_two_of_odd /-
theorem one_add_div_two_mul_two_of_odd (h : Odd n) : 1 + n / 2 * 2 = n :=
  by
  rw [add_comm]
  convert Nat.div_add_mod' n 2
  rw [odd_iff.mp h]
#align nat.one_add_div_two_mul_two_of_odd Nat.one_add_div_two_mul_two_of_odd
-/

#print Nat.bit0_div_two /-
theorem bit0_div_two : bit0 n / 2 = n := by
  rw [← Nat.bit0_eq_bit0, bit0_eq_two_mul, two_mul_div_two_of_even (even_bit0 n)]
#align nat.bit0_div_two Nat.bit0_div_two
-/

#print Nat.bit1_div_two /-
theorem bit1_div_two : bit1 n / 2 = n := by
  rw [← Nat.bit1_eq_bit1, bit1, bit0_eq_two_mul, Nat.two_mul_div_two_add_one_of_odd (odd_bit1 n)]
#align nat.bit1_div_two Nat.bit1_div_two
-/

#print Nat.bit0_div_bit0 /-
@[simp]
theorem bit0_div_bit0 : bit0 n / bit0 m = n / m := by
  rw [bit0_eq_two_mul m, ← Nat.div_div_eq_div_mul, bit0_div_two]
#align nat.bit0_div_bit0 Nat.bit0_div_bit0
-/

#print Nat.bit1_div_bit0 /-
@[simp]
theorem bit1_div_bit0 : bit1 n / bit0 m = n / m := by
  rw [bit0_eq_two_mul, ← Nat.div_div_eq_div_mul, bit1_div_two]
#align nat.bit1_div_bit0 Nat.bit1_div_bit0
-/

#print Nat.bit0_mod_bit0 /-
@[simp]
theorem bit0_mod_bit0 : bit0 n % bit0 m = bit0 (n % m) := by
  rw [bit0_eq_two_mul n, bit0_eq_two_mul m, bit0_eq_two_mul (n % m), Nat.mul_mod_mul_left]
#align nat.bit0_mod_bit0 Nat.bit0_mod_bit0
-/

#print Nat.bit1_mod_bit0 /-
@[simp]
theorem bit1_mod_bit0 : bit1 n % bit0 m = bit1 (n % m) :=
  by
  have h₁ := congr_arg bit1 (Nat.div_add_mod n m)
  -- `∀ m n : ℕ, bit0 m * n = bit0 (m * n)` seems to be missing...
  rw [bit1_add, bit0_eq_two_mul, ← mul_assoc, ← bit0_eq_two_mul] at h₁
  have h₂ := Nat.div_add_mod (bit1 n) (bit0 m)
  rw [bit1_div_bit0] at h₂
  exact add_left_cancel (h₂.trans h₁.symm)
#align nat.bit1_mod_bit0 Nat.bit1_mod_bit0
-/

-- Here are examples of how `parity_simps` can be used with `nat`.
example (m n : ℕ) (h : Even m) : ¬Even (n + 3) ↔ Even (m ^ 2 + m + n) := by
  simp [*, (by decide : ¬2 = 0), parity_simps]

example : ¬Even 25394535 := by simp

end Nat

open Nat

namespace Function

namespace Involutive

variable {α : Type _} {f : α → α} {n : ℕ}

#print Function.Involutive.iterate_bit0 /-
theorem iterate_bit0 (hf : Involutive f) (n : ℕ) : f^[bit0 n] = id := by
  rw [bit0, ← two_mul, iterate_mul, involutive_iff_iter_2_eq_id.1 hf, iterate_id]
#align function.involutive.iterate_bit0 Function.Involutive.iterate_bit0
-/

#print Function.Involutive.iterate_bit1 /-
theorem iterate_bit1 (hf : Involutive f) (n : ℕ) : f^[bit1 n] = f := by
  rw [bit1, iterate_succ, hf.iterate_bit0, comp.left_id]
#align function.involutive.iterate_bit1 Function.Involutive.iterate_bit1
-/

#print Function.Involutive.iterate_even /-
theorem iterate_even (hf : Involutive f) (hn : Even n) : f^[n] = id :=
  let ⟨m, hm⟩ := hn
  hm.symm ▸ hf.iterate_bit0 m
#align function.involutive.iterate_even Function.Involutive.iterate_even
-/

#print Function.Involutive.iterate_odd /-
theorem iterate_odd (hf : Involutive f) (hn : Odd n) : f^[n] = f :=
  let ⟨m, hm⟩ := odd_iff_exists_bit1.mp hn
  hm.symm ▸ hf.iterate_bit1 m
#align function.involutive.iterate_odd Function.Involutive.iterate_odd
-/

#print Function.Involutive.iterate_eq_self /-
theorem iterate_eq_self (hf : Involutive f) (hne : f ≠ id) : f^[n] = f ↔ Odd n :=
  ⟨fun H => odd_iff_not_even.2 fun hn => hne <| by rwa [hf.iterate_even hn, eq_comm] at H,
    hf.iterate_odd⟩
#align function.involutive.iterate_eq_self Function.Involutive.iterate_eq_self
-/

#print Function.Involutive.iterate_eq_id /-
theorem iterate_eq_id (hf : Involutive f) (hne : f ≠ id) : f^[n] = id ↔ Even n :=
  ⟨fun H => even_iff_not_odd.2 fun hn => hne <| by rwa [hf.iterate_odd hn] at H, hf.iterate_even⟩
#align function.involutive.iterate_eq_id Function.Involutive.iterate_eq_id
-/

end Involutive

end Function

variable {R : Type _} [Monoid R] [HasDistribNeg R] {n : ℕ}

/- warning: neg_one_pow_eq_one_iff_even -> neg_one_pow_eq_one_iff_even is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Monoid.{u1} R] [_inst_2 : HasDistribNeg.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1))] {n : Nat}, (Ne.{succ u1} R (Neg.neg.{u1} R (InvolutiveNeg.toHasNeg.{u1} R (HasDistribNeg.toHasInvolutiveNeg.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) _inst_2)) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (MulOneClass.toHasOne.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)))))) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (MulOneClass.toHasOne.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)))))) -> (Iff (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) (Neg.neg.{u1} R (InvolutiveNeg.toHasNeg.{u1} R (HasDistribNeg.toHasInvolutiveNeg.{u1} R (MulOneClass.toHasMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) _inst_2)) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (MulOneClass.toHasOne.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)))))) n) (OfNat.ofNat.{u1} R 1 (OfNat.mk.{u1} R 1 (One.one.{u1} R (MulOneClass.toHasOne.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)))))) (Even.{0} Nat Nat.hasAdd n))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Monoid.{u1} R] [_inst_2 : HasDistribNeg.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1))] {n : Nat}, (Ne.{succ u1} R (Neg.neg.{u1} R (InvolutiveNeg.toNeg.{u1} R (HasDistribNeg.toInvolutiveNeg.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) _inst_2)) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (Monoid.toOne.{u1} R _inst_1)))) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (Monoid.toOne.{u1} R _inst_1)))) -> (Iff (Eq.{succ u1} R (HPow.hPow.{u1, 0, u1} R Nat R (instHPow.{u1, 0} R Nat (Monoid.Pow.{u1} R _inst_1)) (Neg.neg.{u1} R (InvolutiveNeg.toNeg.{u1} R (HasDistribNeg.toInvolutiveNeg.{u1} R (MulOneClass.toMul.{u1} R (Monoid.toMulOneClass.{u1} R _inst_1)) _inst_2)) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (Monoid.toOne.{u1} R _inst_1)))) n) (OfNat.ofNat.{u1} R 1 (One.toOfNat1.{u1} R (Monoid.toOne.{u1} R _inst_1)))) (Even.{0} Nat instAddNat n))
Case conversion may be inaccurate. Consider using '#align neg_one_pow_eq_one_iff_even neg_one_pow_eq_one_iff_evenₓ'. -/
theorem neg_one_pow_eq_one_iff_even (h : (-1 : R) ≠ 1) : (-1 : R) ^ n = 1 ↔ Even n :=
  ⟨fun h' => of_not_not fun hn => h <| (Odd.neg_one_pow <| odd_iff_not_even.mpr hn).symm.trans h',
    Even.neg_one_pow⟩
#align neg_one_pow_eq_one_iff_even neg_one_pow_eq_one_iff_even

#print Odd.mod_even_iff /-
/-- If `a` is even, then `n` is odd iff `n % a` is odd. -/
theorem Odd.mod_even_iff {n a : ℕ} (ha : Even a) : Odd (n % a) ↔ Odd n :=
  ((even_sub' <| mod_le n a).mp <|
      even_iff_two_dvd.mpr <| (even_iff_two_dvd.mp ha).trans <| dvd_sub_mod n).symm
#align odd.mod_even_iff Odd.mod_even_iff
-/

#print Even.mod_even_iff /-
/-- If `a` is even, then `n` is even iff `n % a` is even. -/
theorem Even.mod_even_iff {n a : ℕ} (ha : Even a) : Even (n % a) ↔ Even n :=
  ((even_sub <| mod_le n a).mp <|
      even_iff_two_dvd.mpr <| (even_iff_two_dvd.mp ha).trans <| dvd_sub_mod n).symm
#align even.mod_even_iff Even.mod_even_iff
-/

#print Odd.mod_even /-
/-- If `n` is odd and `a` is even, then `n % a` is odd. -/
theorem Odd.mod_even {n a : ℕ} (hn : Odd n) (ha : Even a) : Odd (n % a) :=
  (Odd.mod_even_iff ha).mpr hn
#align odd.mod_even Odd.mod_even
-/

#print Even.mod_even /-
/-- If `n` is even and `a` is even, then `n % a` is even. -/
theorem Even.mod_even {n a : ℕ} (hn : Even n) (ha : Even a) : Even (n % a) :=
  (Even.mod_even_iff ha).mpr hn
#align even.mod_even Even.mod_even
-/

#print Odd.of_dvd_nat /-
theorem Odd.of_dvd_nat {m n : ℕ} (hn : Odd n) (hm : m ∣ n) : Odd m :=
  odd_iff_not_even.2 <| mt hm.Even (odd_iff_not_even.1 hn)
#align odd.of_dvd_nat Odd.of_dvd_nat
-/

#print Odd.ne_two_of_dvd_nat /-
/-- `2` is not a factor of an odd natural number. -/
theorem Odd.ne_two_of_dvd_nat {m n : ℕ} (hn : Odd n) (hm : m ∣ n) : m ≠ 2 :=
  by
  rintro rfl
  exact absurd (hn.of_dvd_nat hm) (by decide)
#align odd.ne_two_of_dvd_nat Odd.ne_two_of_dvd_nat
-/


import data.real.basic

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
begin
  use 5 / 2,
  norm_num
end

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
begin
  have h : 2 < (5 : ℝ) / 2 ∧ (5 : ℝ) / 2 < 3,
    by norm_num,
  exact ⟨5 / 2, h⟩
end

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
⟨5 / 2, by norm_num⟩

def fn_ub (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a
def fn_lb (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x

def fn_has_ub (f : ℝ → ℝ) := ∃ a, fn_ub f a
def fn_has_lb (f : ℝ → ℝ) := ∃ a, fn_lb f a

theorem fn_ub_add {f g : ℝ → ℝ} {a b : ℝ}
    (hfa : fn_ub f a) (hgb : fn_ub g b) :
  fn_ub (λ x, f x + g x) (a + b) :=
λ x, add_le_add (hfa x) (hgb x)

section
variables {f g : ℝ → ℝ}

example (ubf : fn_has_ub f) (ubg : fn_has_ub g) :
  fn_has_ub (λ x, f x + g x) :=
begin
  cases ubf with a ubfa,
  cases ubg with b ubfb,
  use a + b,
  apply fn_ub_add ubfa ubfb
end

example (lbf : fn_has_lb f) (lbg : fn_has_lb g) :
  fn_has_lb (λ x, f x + g x) :=
sorry

example {c : ℝ} (ubf : fn_has_ub f) (h : c ≥ 0):
  fn_has_ub (λ x, c * f x) :=
sorry

example (ubf : fn_has_ub f) (ubg : fn_has_ub g) :
  fn_has_ub (λ x, f x + g x) :=
begin
  rcases ubf with ⟨a, ubfa⟩,
  rcases ubg with ⟨b, ubfb⟩,
  exact ⟨a + b, fn_ub_add ubfa ubfb⟩
end

example : fn_has_ub f → fn_has_ub g →
  fn_has_ub (λ x, f x + g x) :=
begin
  rintros ⟨a, ubfa⟩ ⟨b, ubfb⟩,
  exact ⟨a + b, fn_ub_add ubfa ubfb⟩
end

example : fn_has_ub f → fn_has_ub g →
  fn_has_ub (λ x, f x + g x) :=
λ ⟨a, ubfa⟩ ⟨b, ubfb⟩, ⟨a + b, fn_ub_add ubfa ubfb⟩

end

section
variables {α : Type*} [comm_ring α]

def sum_of_squares (x : α) := ∃ a b, x = a^2 + b^2

theorem sum_of_squares_mul {x y : α}
    (sosx : sum_of_squares x) (sosy : sum_of_squares y) :
  sum_of_squares (x * y) :=
begin
  rcases sosx with ⟨a, b, xeq⟩,
  rcases sosy with ⟨c, d, yeq⟩,
  rw [xeq, yeq],
  use [a*c - b*d, a*d + b*c],
  ring
end
theorem sum_of_squares_mul' {x y : α}
    (sosx : sum_of_squares x) (sosy : sum_of_squares y) :
  sum_of_squares (x * y) :=
begin
  rcases sosx with ⟨a, b, rfl⟩,
  rcases sosy with ⟨c, d, rfl⟩,
  use [a*c - b*d, a*d + b*c],
  ring
end

end
section
variables {a b c : ℕ}

example (divab : a ∣ b) (divbc : b ∣ c) : a ∣ c :=
begin
  cases divab with d beq,
  cases divbc with e ceq,
  rw [ceq, beq],
  use (d * e), ring
end

example (divab : a ∣ b) (divac : a ∣ c) : a ∣ (b + c) :=
sorry

end

section
open function

example {c : ℝ} : surjective (λ x, x + c) :=
begin
  intro x,
  use x - c,
  dsimp, ring
end

example {c : ℝ} (h : c ≠ 0) : surjective (λ x, c * x) :=
sorry

example (x y : ℝ) (h : x - y ≠ 0) : (x^2 - y^2) / (x - y) = x + y :=
by { field_simp [h], ring }

example {f : ℝ → ℝ} (h : surjective f) : ∃ x, (f x)^2 = 4 :=
begin
  cases h 2 with x hx,
  use x,
  rw hx,
  norm_num
end

end

section
open function
variables {α : Type*} {β : Type*} {γ : Type*}
variables {g : β → γ} {f : α → β}

example (surjg : surjective g) (surjf : surjective f) :
  surjective (λ x, g (f x)) :=
begin
  intro x,
  rcases surjg x with ⟨w,rfl⟩,
  rcases surjf w with ⟨v,rfl⟩,
  use v,
end

end


namespace z3

inductive List (α : Type)
| emp {} : List
| ap     : α → List → List

open List
notation {} := emp
notation x :: y := ap x y

definition append : Π {α:Type}, List α → List α → List α
| α emp L := L
| α (x::L₁) L₂ := x::(append L₁ L₂)

definition repeat : Π {α:Type}, α → ℕ → List α
| α _ 0 := emp
| α x (nat.succ n) := append (x::{}) (repeat x (n))

definition len : Π {α:Type}, List α → ℕ
| α emp := 0
| α (_::L) := len L + 1

--todo : {} for append

theorem list_app_eq : ∀ α : Type, ∀ L₁ L₂ : List α,
len (append L₁ L₂) = len L₁ + len L₂ := begin
intro α,
intros L₁ L₂,
induction L₁ with new L_shorter H,{unfold append, unfold len, simp},
{
    unfold append,
    unfold len,
    rw H,
    simp
}end

-------------- products -----------------

inductive prodd (α β : Type)
| pair : α → β → prodd
open prodd

def fst : Π {α β : Type}, prodd α β → α
| _ _ (pair x y) := x

def snd : Π {α β : Type}, prodd α β → β
| _ _ (pair x y) := y

def zip : Π {α β : Type}, List α → List β → List (prodd α β)
| α β {} {} := {}
| α β (A::L₁) (B::L₂) := ap (pair A B) (zip L₁ L₂)
-- if different lengths, give up
| _ _ _ _ := {}

def unzip : Π {α β : Type}, List (prodd α β) → prodd (List α) (List β)
| α β {} := pair {} {}
| α β (x::L) := pair (ap (fst x) (fst (unzip L)) ) (ap (snd x) (snd (unzip L)) )

theorem A : ∀ α β:Type, ∀ L₁ L₂:List α, len L₁ = len L₁ → pair L₁ L₂ = unzip (zip L₁ L₂) := begin

intros α β,
intros L₁ L₂,
intro H,
admit

end

inductive option (α : Type)
| None : option
| Some : α → option

def get_nth {α : Type}: List α → ℕ → option α
| {} _ := option.None α
| (x::_) 0 := option.Some x
| (_::y) (nat.succ n) := get_nth y n

def filter : Π {α : Type}, List α → (α → bool) → List α
| α {} _ := {}
| α (x::L) F := if F x = tt then ap x (filter L F) else filter L F

def nat_even : ℕ → bool
| 0 := tt
| 1 := ff
| (nat.succ (nat.succ n)) := nat_even n

def bool_and : bool → bool → bool
| tt tt := tt
| _ _ := ff

def bool_inv : bool → bool
| tt := ff
| _ := tt

def gt (a b : ℕ) : bool := if a > b then tt else ff
def task (L₁ : List ℕ) : List ℕ := filter L₁ (λ n, bool_and (nat_even n) (gt n 7)  )

def inverse_func : Π {α : Type}, (α → bool) → (α → bool) :=
--λ α F, λ b, bool_inv (F b)
λ α F, bool_inv ∘ F

-- f ∘ g = λ b, f (g b)

def partition : Π {α : Type}, (α → bool) → List α → prodd (List α) (List α) :=
λ α F L, pair (filter L F) (filter L (inverse_func F))

def fold {α β : Type} : (α → β → β) → List α → β → β
| _ {} st := st
| F (a::L) st := F a (fold F L st)

def map : Π {α β : Type}, (α → β) → List α → List β
| α β _ {} := {}
| α β F (a::L) := ap (F a) (map F L)

definition fold_map : Π{α β:Type}, (α → β) → List α → List β :=
λ α β F L, fold (λ a b, ap (F a) b) L {}

-- ∀ n : (α → β), ∀ L : List α, fold_map n L = map n L

def reverse : Π {α : Type}, List α → List α
| α {} := {}
| α (ap n L) := append (reverse L) (n::{})

def flatten_list : Π {α : Type}, List (List α) → List α
| α {} := {}
| α (a::L) := append a (flatten_list L)

def flat_map : Π {α β : Type}, (α → List β) → List α → List β := λ α β F L, flatten_list (map F L)

definition fold_length : Π {α : Type}, List α → ℕ :=
  λ α L, fold (λ _ n, nat.succ n) L 0

definition prod_curry {X Y Z : Type} (f : prodd X Y → Z) (x : X) (y : Y) : Z :=
f (pair x y)

definition prod_uncurry {X Y Z : Type} : (X → Y → Z) → (prodd X Y) → Z
| f p := f (fst p) (snd p)

#check (λ a b, a+b) 5 6
#check prod_curry (prod_uncurry (λ a b, a+b) (pair 1 2))

#reduce prod_curry (λ pair (a:ℕ) (b:ℕ), a+1) 50 6

@[simp]theorem map_app : Π {α β : Type}, ∀ F : α → β, ∀ L : List α, ∀ a : α,
  map F (append L (a::{})) = append (map F L) ((F a)::{}) := begin

intros α β F L a,
induction L with new L_sh H,{refl},
{
    unfold map,
    unfold append,

    rw ←H,
    unfold map
}

end

theorem map_rev : Π {α β : Type}, ∀ F : α → β, ∀ L : List α,
  map F (reverse L) = reverse (map F L) := begin

intros α β,
intro F,
intro L,

induction L with new L_sh H₁,
{
    unfold reverse,
    unfold map,
    refl
},
{
    unfold map reverse,
    simp,
    rw H₁
    --apply map_app F (reverse L_sh) new,
}

end

theorem fold_length_eq : Π {α : Type}, ∀ L : List α, fold_length L = len L := begin

intros α L,
induction L with new L_sh prev, {refl},
{
    unfold len,
    rw ←prev,
    unfold fold_length,
    refl
}

end

theorem curry {α β γ : Type} : ∀ F : (α → β → γ),
F = prod_curry (prod_uncurry F) := begin
intro F,
apply funext,
intro a,
apply funext,
intro b,
unfold prod_curry,
unfold prod_uncurry,
refl
end

theorem a : ∀ X n L, len L = n → @get_nth X L n = option.None X :=begin

intros X n L,
revert n,
induction L with new Lh H₂,
{
    unfold get_nth,
    intros a b,
    refl
},
{
    unfold len get_nth,
    have H₃ := H₂ (len Lh) rfl,
    intro n,
    intro H₄,
    rw ←H₄,
    clear H₂,
    unfold get_nth,
    rw H₃
}

end

end z3


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module analysis.convex.measure
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Topology
import Mathbin.Analysis.NormedSpace.AddTorsorBases
import Mathbin.MeasureTheory.Measure.HaarLebesgue

/-!
# Convex sets are null-measurable

Let `E` be a finite dimensional real vector space, let `μ` be a Haar measure on `E`, let `s` be a
convex set in `E`. Then the frontier of `s` has measure zero (see `convex.add_haar_frontier`), hence
`s` is a `measure_theory.null_measurable_set` (see `convex.null_measurable_set`).
-/

open MeasureTheory MeasureTheory.Measure Set Metric Filter

open FiniteDimensional (finrank)

open Topology NNReal ENNReal

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [MeasurableSpace E] [BorelSpace E]
  [FiniteDimensional ℝ E] (μ : Measure E) [IsAddHaarMeasure μ] {s : Set E}

namespace Convex

/-- Haar measure of the frontier of a convex set is zero. -/
theorem add_haar_frontier (hs : Convex ℝ s) : μ (frontier s) = 0 :=
  by
  /- If `s` is included in a hyperplane, then `frontier s ⊆ closure s` is included in the same
    hyperplane, hence it has measure zero. -/
  cases' ne_or_eq (affineSpan ℝ s) ⊤ with hspan hspan
  · refine' measure_mono_null _ (add_haar_affine_subspace _ _ hspan)
    exact
      frontier_subset_closure.trans
        (closure_minimal (subset_affineSpan _ _) (affineSpan ℝ s).closed_of_finiteDimensional)
  rw [← hs.interior_nonempty_iff_affine_span_eq_top] at hspan
  rcases hspan with ⟨x, hx⟩
  /- Without loss of generality, `s` is bounded. Indeed, `∂s ⊆ ⋃ n, ∂(s ∩ ball x (n + 1))`, hence it
    suffices to prove that `∀ n, μ (s ∩ ball x (n + 1)) = 0`; the latter set is bounded.
    -/
  suffices H : ∀ t : Set E, Convex ℝ t → x ∈ interior t → bounded t → μ (frontier t) = 0
  · set B : ℕ → Set E := fun n => ball x (n + 1)
    have : μ (⋃ n : ℕ, frontier (s ∩ B n)) = 0 :=
      by
      refine'
        measure_Union_null fun n =>
          H _ (hs.inter (convex_ball _ _)) _ (bounded_ball.mono (inter_subset_right _ _))
      rw [interior_inter, is_open_ball.interior_eq]
      exact ⟨hx, mem_ball_self (add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one)⟩
    refine' measure_mono_null (fun y hy => _) this
    clear this
    set N : ℕ := ⌊dist y x⌋₊
    refine' mem_Union.2 ⟨N, _⟩
    have hN : y ∈ B N := by
      simp only [B, N]
      simp [Nat.lt_floor_add_one]
    suffices : y ∈ frontier (s ∩ B N) ∩ B N
    exact this.1
    rw [frontier_inter_open_inter is_open_ball]
    exact ⟨hy, hN⟩
  clear hx hs s
  intro s hs hx hb
  /- Since `s` is bounded, we have `μ (interior s) ≠ ∞`, hence it suffices to prove
    `μ (closure s) ≤ μ (interior s)`. -/
  replace hb : μ (interior s) ≠ ∞
  exact (hb.mono interior_subset).measure_lt_top.Ne
  suffices μ (closure s) ≤ μ (interior s) by
    rwa [frontier, measure_diff interior_subset_closure is_open_interior.measurable_set hb,
      tsub_eq_zero_iff_le]
  /- Due to `convex.closure_subset_image_homothety_interior_of_one_lt`, for any `r > 1` we have
    `closure s ⊆ homothety x r '' interior s`, hence `μ (closure s) ≤ r ^ d * μ (interior s)`,
    where `d = finrank ℝ E`. -/
  set d : ℕ := FiniteDimensional.finrank ℝ E
  have : ∀ r : ℝ≥0, 1 < r → μ (closure s) ≤ ↑(r ^ d) * μ (interior s) :=
    by
    intro r hr
    refine'
      (measure_mono <| hs.closure_subset_image_homothety_interior_of_one_lt hx r hr).trans_eq _
    rw [add_haar_image_homothety, ← NNReal.coe_pow, NNReal.abs_eq, ENNReal.ofReal_coe_nnreal]
  have : ∀ᶠ r in 𝓝[>] (1 : ℝ≥0), μ (closure s) ≤ ↑(r ^ d) * μ (interior s) :=
    mem_of_superset self_mem_nhdsWithin this
  -- Taking the limit as `r → 1`, we get `μ (closure s) ≤ μ (interior s)`.
  refine' ge_of_tendsto _ this
  refine'
    (((ENNReal.continuous_mul_const hb).comp
              (ennreal.continuous_coe.comp (continuous_pow d))).tendsto'
          _ _ _).mono_left
      nhdsWithin_le_nhds
  simp
#align convex.add_haar_frontier Convex.add_haar_frontier

/-- A convex set in a finite dimensional real vector space is null measurable with respect to an
additive Haar measure on this space. -/
protected theorem nullMeasurableSet (hs : Convex ℝ s) : NullMeasurableSet s μ :=
  nullMeasurableSetOfNullFrontier (hs.add_haar_frontier μ)
#align convex.null_measurable_set Convex.nullMeasurableSet

end Convex